lib/CloudStore/API.pm

   1 package CloudStore::API;
   2 use warnings;
   3 use strict;
   4 use autodie;
   5
   6 use lib 'lib';
   7 use base qw(CloudStore::Gearman CloudStore::MD5sum);
   8
   9 use File::Path qw(make_path remove_tree);
  10 use File::Find;
  11 use Data::Dump qw(dump);
  12 use Carp qw(confess);
  13
  14 sub new {
  15         my ($class,$slice) = @_;
  16
  17         my ( undef, $dir, $port, undef ) = getgrnam($slice);
  18         die "can't find group $slice: $!" unless $dir && $port;
  19         my $self = {
  20                 passwd => '/var/lib/extrausers/passwd',
  21                 PORT => $port,
  22                 SLICE => $dir,
  23         };
  24         bless $self, $class;
  25
  26         $self->{md5} = $self->user_info("md5") || die "can't find user md5";
  27         $self->{md5}->{dir} = "$dir/md5";
  28         if ( ! -e $self->{md5}->{dir} ) {
  29                 make_path $self->{md5}->{dir}, { uid => $self->{md5}->{uid}, gid => $self->{md5}->{gid} };
  30                 warn "## CREATED md5pool $self->{md5}->{dir}\n";
  31         }
  32
  33         return $self;
  34 }
  35
  36 sub user_info {
  37         my ($self,$login) = @_;
  38
  39         confess "need login" unless $login;
  40
  41         my @n = qw/ login passwd uid gid quota comment gecos dir shell expire /;
  42         my @p = $login =~ m/^\d+$/ ? getpwuid $login : getpwnam $login;
  43         my $user;
  44         $user->{$_} = shift @p foreach @n;
  45         return $user;
  46 }
  47
  48 sub create_user {
  49         my ( $self, $new_email, $new_passwd, $new_quota ) = @_;
  50
  51         my $max_uid = 0;
  52         my $found = 0;
  53
  54         open(my $fh, '<', $self->{passwd});
  55         while(<$fh>) {
  56                 my ( $login, $passwd, $uid, $gid, $email, $dir, $shell ) = split(/:/,$_);
  57                 $max_uid = $uid if $uid > $max_uid;
  58                 $found = $uid if $email eq $new_email;
  59         }
  60         close($fh);
  61
  62         if ( ! $found ) {
  63                 $max_uid++;
  64                 my $dir = "$self->{SLICE}/$max_uid";
  65                 warn "# create_user $new_email $new_quota = $max_uid $dir";
  66                 open(my $fh, '>>', $self->{passwd});
  67                 print $fh "u$max_uid:$new_passwd:$max_uid:$self->{PORT}:$new_email:$dir:/bin/true\n";
  68                 close($fh);
  69                 $found = $max_uid;
  70
  71                 mkdir $dir;
  72                 chown $max_uid, $self->{PORT}, $dir;
  73
  74                 my $path = "$dir/.meta/secrets";
  75                 $self->mkbasepath($path);
  76                 open($fh, '>', $path);
  77                 print $fh "u$max_uid:$new_passwd\n";
  78                 close $fh;
  79         }
  80
  81         # FIXME update quota only on create?
  82         $self->gearman_do( 'narada_s1_quota_set' => "$found $new_quota" );
  83
  84         return $found;
  85 }
  86
  87 sub mkbasepath {
  88         my ($self,$path,$opts) = @_;
  89         $path =~ s{/[^/]+$}{};
  90         make_path $path unless -d $path;
  91 }
  92
  93 sub user_dir {
  94         my ( $self,$user, $dir ) = @_;
  95         $user = $self->user_info($user) unless ref $user eq 'HASH';
  96         my $path;
  97         if ( exists $user->{dir} ) {
  98                 $path = $user->{dir} . '/.meta/' . $dir;
  99         } else {
 100                 die "no dir in ", dump $user;
 101         }
 102         $path =~ s{//+}{/}g;
 103
 104         if ( ! -e $path ) {
 105                 $self->mkbasepath( $path, { uid => $user->{uid} } );
 106                 open(my $fh, '>', $path);
 107                 close $fh;
 108                 chown $user->{uid}, $user->{gid}, $path;
 109                 warn "# user_dir created $path\n";
 110         }
 111
 112         warn "## user_dir $path";
 113         return $path;
 114 }
 115
 116 sub append {
 117         my $self = shift @_;
 118         $self->append_meta( 'usage', @_ );
 119 }
 120
 121 sub append_meta {
 122         my $self = shift @_;
 123         my $log  = shift @_;
 124         my $user = shift @_;
 125         my $path = $self->user_dir( $user => $log );
 126         my $delimiter = '#';
 127            $delimiter = '  ' if $log =~ m/md5sum$/;
 128         my $line = join($delimiter,@_);
 129         open(my $fh, '>>', $path);
 130         print $fh "$line\n";
 131         close $fh;
 132         warn "## $path $line\n";
 133 }
 134
 135 sub usage {
 136         my ( $self, $user ) = @_;
 137         $user = $self->user_info($user) unless ref $user eq 'HASH';
 138         my $path = $self->user_dir( $user => 'usage');
 139         my $sum;
 140         open(my $fh, '<', $path);
 141         while(<$fh>) {
 142                 chomp;
 143                 my @v = split(/#/,$_);
 144                 $sum->{ $v[0] } += $v[1];
 145                 $sum->{_usage}  += $v[1];
 146         }
 147         my ( $usage, $quota ) = split(/ /,
 148                 $self->gearman_do( 'narada_s1_quota_get' => $user->{uid} )
 149         );
 150         $sum->{_usage} += $usage;
 151         $sum->{_quota} = $quota;
 152         warn "## usage ",dump($user, $sum), $/;
 153         return $sum;
 154 }
 155
 156 sub send_file {
 157         my ( $self, $f_uid,$f_path, $t_uid,$t_path ) = @_;
 158
 159         my $f = $self->user_info($f_uid);
 160         die "FIXME not on current slice" if $f->{dir} !~ m/^$self->{SLICE}/;
 161         my $t = $self->user_info($t_uid);
 162
 163         my $f_full = "$f->{dir}/$f_path";
 164         my $t_full = "$t->{dir}/$t_path";
 165
 166         $self->mkbasepath( $t_full, { uid => $t->{uid} } );
 167
 168         my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat $f_full;
 169         if ( $uid == $f->{uid} ) {
 170                 warn "# send_file - move $f_uid $f_path to pool\n";
 171                 chown $self->{md5}->{uid}, $self->{md5}->{gid}, $f_full;
 172                 chmod oct("0444"), $f_full;
 173                 $self->append( $f, 'sent', -s $f_full, $t->{uid}, $f_path );
 174         } elsif ( $uid == $self->{md5}->{uid} ) {
 175                 warn "# send_file - shared $f_full\n";
 176         }
 177
 178         $self->delete( $t, $t_path ) if -e $t_full;
 179
 180         link $f_full, $t_full;
 181         $self->append( $t, 'recv', -s $t_full, $f->{uid}, $t_path );
 182 }
 183
 184 sub rename_file {
 185         my ( $self, $user, $from, $to ) = @_;
 186         $user = $self->user_info($user) unless ref $user eq 'HASH';
 187
 188         $self->append( $user, 'rename', $from, $to );
 189 }
 190
 191
 192 sub delete {
 193         my ( $self, $user, $path ) = @_;
 194         $user = $self->user_info($user) unless ref $user eq 'HASH';
 195
 196         my $deleted_size = 0;
 197         my $full_path = "$user->{dir}/$path";
 198
 199         if ( -d $full_path ) {
 200
 201                 find({
 202                 no_chdir => 1,
 203                 wanted => sub {
 204                         return if -d $_;
 205                         my ($uid,$size) = (stat($_))[4,7];
 206                         warn "## find $uid $size $_\n";
 207                         if ( $uid == $self->{md5}->{uid} ) {
 208                                 $deleted_size += $size;
 209                         }
 210                 }}, $full_path);
 211
 212                 remove_tree $full_path;
 213         } else {
 214                 $deleted_size += -s $full_path;
 215                 unlink $full_path;
 216         }
 217
 218         warn "delete $deleted_size bytes shared\n";
 219
 220         $self->append( $user, 'delete', -$deleted_size, $user->{uid}, $path );
 221         $self->append_meta('md5sum', $user, 'delete', $path );
 222
 223         $self->md5sum($user)->out( $path );
 224         $self->md5sum_close($user);
 225
 226         return $full_path;
 227 }
 228
 229 1;