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 cluck);
  13
  14 sub new {
  15         my ($class,$slice) = @_;
  16
  17         cluck "DEPRICIATED $slice specified" if $slice;
  18
  19         my $self = {
  20                 passwd => '/var/lib/extrausers/passwd',
  21         };
  22         bless $self, $class;
  23
  24         $self->{md5} = $self->user_info("md5") || die "can't find user md5";
  25 =for removed
  26         $self->{md5}->{dir} = "$dir/md5";
  27         if ( ! -e $self->{md5}->{dir} ) {
  28                 make_path $self->{md5}->{dir}, { uid => $self->{md5}->{uid}, gid => $self->{md5}->{gid} };
  29                 warn "## CREATED md5pool $self->{md5}->{dir}\n";
  30         }
  31 =cut
  32
  33         return $self;
  34 }
  35
  36 sub slice_dir_port {
  37         my ($self,$slice) = @_;
  38         my ( undef, $dir, $port, undef ) = getgrnam($slice);
  39         warn "# slice_dir_port $slice = $dir $port\n";
  40         return ( $dir, $port );
  41 }
  42
  43 sub dir2gearman {
  44         my $self = shift;
  45         my $dir  = shift;
  46         $dir =~ s/\W+/_/g;
  47         $dir =~ s/^_+//;
  48         $dir =~ s{_\d+$}{};
  49         return join('_', $dir, @_);
  50 }
  51
  52 sub user_info {
  53         my ($self,$login) = @_;
  54
  55         confess "need login" unless $login;
  56
  57         my @n = qw/ login passwd uid gid quota comment gecos dir shell expire /;
  58         my @p = $login =~ m/^\d+$/ ? getpwuid $login : getpwnam $login;
  59         die "user_info $login: $@" if $@;
  60         my $user;
  61         $user->{$_} = shift @p foreach @n;
  62         return $user;
  63 }
  64
  65 sub create_user {
  66         my ( $self, $new_email, $new_passwd, $new_quota ) = @_;
  67
  68         my $max_uid = 0;
  69         my $found = 0;
  70
  71         open(my $fh, '<', $self->{passwd});
  72         while(<$fh>) {
  73                 my ( $login, $passwd, $uid, $gid, $email, $dir, $shell ) = split(/:/,$_);
  74                 $max_uid = $uid if $uid > $max_uid;
  75                 $found = $uid if $email eq $new_email;
  76         }
  77         close($fh);
  78
  79         my $slice = $ENV{SLICE} || 's1';
  80         my ( $dir, $port ) = $self->slice_dir_port( $slice );
  81
  82         if ( ! $found ) {
  83                 $max_uid++;
  84                 $dir .= "/$max_uid";
  85                 warn "# create_user $slice $new_email $new_quota = $max_uid $dir";
  86                 open(my $fh, '>>', $self->{passwd});
  87                 print $fh "u$max_uid:$new_passwd:$max_uid:$port:$new_email:$dir:/bin/true\n";
  88                 close($fh);
  89                 $found = $max_uid;
  90
  91                 mkdir $dir;
  92                 chown $max_uid, $port, $dir;
  93
  94                 my $path = "$dir/.meta/secrets";
  95                 $self->mkbasepath($path);
  96                 open($fh, '>', $path);
  97                 print $fh "u$max_uid:$new_passwd\n";
  98                 close $fh;
  99         }
 100
 101         # FIXME update quota only on create?
 102         $self->gearman_do( $self->dir2gearman( $dir, 'quota', 'set' ) => "$found $new_quota" );
 103
 104         return $found;
 105 }
 106
 107 sub mkbasepath {
 108         my ($self,$path,$opts) = @_;
 109         $path =~ s{/[^/]+$}{};
 110         make_path $path unless -d $path;
 111 }
 112
 113 sub user_dir {
 114         my ( $self,$user, $dir ) = @_;
 115         $user = $self->user_info($user) unless ref $user eq 'HASH';
 116         my $path;
 117         if ( exists $user->{dir} ) {
 118                 $path = $user->{dir} . '/.meta/' . $dir;
 119         } else {
 120                 die "no dir in ", dump $user;
 121         }
 122         $path =~ s{//+}{/}g;
 123
 124         if ( ! -e $path ) {
 125                 $self->mkbasepath( $path, { uid => $user->{uid} } );
 126                 open(my $fh, '>', $path);
 127                 close $fh;
 128                 chown $user->{uid}, $user->{gid}, $path;
 129                 warn "# user_dir created $path\n";
 130         }
 131
 132         #warn "### user_dir $path";
 133         return $path;
 134 }
 135
 136 sub append {
 137         my $self = shift @_;
 138         $self->append_meta( 'usage', @_ );
 139 }
 140
 141 sub append_meta {
 142         my $self = shift @_;
 143         my $log  = shift @_;
 144         my $user = shift @_;
 145         my $path = $self->user_dir( $user => $log );
 146         my $delimiter = '#';
 147            $delimiter = '  ' if $log =~ m/md5sum$/;
 148         my $line = join($delimiter,@_);
 149         open(my $fh, '>>', $path);
 150         print $fh "$line\n";
 151         close $fh;
 152         warn "## $path $line\n";
 153 }
 154
 155 sub usage {
 156         my ( $self, $user ) = @_;
 157         $user = $self->user_info($user) unless ref $user eq 'HASH';
 158         my $path = $self->user_dir( $user => 'usage');
 159         my $sum;
 160         open(my $fh, '<', $path);
 161         while(<$fh>) {
 162                 chomp;
 163                 my @v = split(/#/,$_);
 164                 $sum->{ $v[0] } += $v[1];
 165                 $sum->{_usage}  += $v[1];
 166         }
 167         my ( $usage, $quota ) = split(/ /,
 168                 $self->gearman_do( $self->dir2gearman( $user->{dir}, 'quota', 'get' ) => $user->{uid} )
 169         );
 170         $sum->{_usage} += $usage;
 171         $sum->{_quota} = $quota;
 172         warn "## usage ",dump($user, $sum), $/;
 173         return $sum;
 174 }
 175
 176 sub send_file {
 177         my ( $self, $f_uid,$f_path, $t_uid,$t_path ) = @_;
 178
 179         my $f = $self->user_info($f_uid);
 180         die "FIXME not on current slice" if $f->{dir} !~ m/^$ENV{SLICE}/;
 181         my $t = $self->user_info($t_uid);
 182
 183         my $f_full = "$f->{dir}/$f_path";
 184         my $t_full = "$t->{dir}/$t_path";
 185
 186         $self->mkbasepath( $t_full, { uid => $t->{uid} } );
 187
 188         my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat $f_full;
 189         if ( $uid == $f->{uid} ) {
 190                 warn "# send_file - move $f_uid $f_path to pool\n";
 191                 chown $self->{md5}->{uid}, $self->{md5}->{gid}, $f_full;
 192                 chmod oct("0444"), $f_full;
 193                 $self->append( $f, 'sent', -s $f_full, $t->{uid}, $f_path );
 194         } elsif ( $uid == $self->{md5}->{uid} ) {
 195                 warn "# send_file - shared $f_full\n";
 196         }
 197
 198         $self->delete( $t, $t_path ) if -e $t_full;
 199
 200         my $size = -s $f_full;
 201         my $md5;
 202
 203         my $ok;
 204         {
 205                 no autodie qw(link);
 206                 $ok = link $f_full, $t_full
 207         };
 208         if ( ! $ok || $! =~ m/cross-link/ ) {
 209                 $ok = symlink $f_full, $t_full;
 210         } else {
 211                 $size = -s $t_full;
 212
 213                 if ( $f->{uid} == $self->{md5}->{uid} ) {
 214                         $md5 = $f_path; # we don't have local md5sum db for md5 user!
 215                 } else {
 216                         $md5 = $self->md5_get($f_full);
 217                 }
 218
 219         }
 220
 221         if ( $ok ) {
 222                 $self->append( $t, 'recv', $size, $f->{uid}, $t_path );
 223                 $self->append_meta('md5sum', $t, $md5 => $t_path ) if $md5; # md5sum for received files! FIXME -- cross-slice md5
 224         }
 225
 226         return $size;
 227 }
 228
 229 sub rename_file {
 230         my ( $self, $user, $from, $to ) = @_;
 231         $user = $self->user_info($user) unless ref $user eq 'HASH';
 232
 233         my $f_full = "$user->{dir}/$from";
 234         my $t_full = "$user->{dir}/$to";
 235
 236         $self->mkbasepath( $t_full, { uid => $user->{uid}, gid => $user->{gid} } );
 237         my $ok = rename $f_full, $t_full;
 238
 239         my $md5 = $self->md5_get($t_full);
 240         if ( ! $md5 ) {
 241                 warn "ERROR: no md5sum for $from";
 242                 return $ok; # XXX our internal error
 243         }
 244
 245         $self->append_meta('md5sum', $user, 'rename' => $from );
 246         $self->append_meta('md5sum', $user, $md5 => $from );
 247
 248         return $ok;
 249 }
 250
 251
 252 sub delete {
 253         my ( $self, $user, $path ) = @_;
 254         $user = $self->user_info($user) unless ref $user eq 'HASH';
 255
 256         my $deleted_size = 0;
 257         my $full_path = "$user->{dir}/$path";
 258
 259         if ( -d $full_path ) {
 260
 261                 find({
 262                 no_chdir => 1,
 263                 wanted => sub {
 264                         return if -d $_;
 265                         my ($uid,$size) = (stat($_))[4,7];
 266                         warn "## find $uid $size $_\n";
 267                         if ( $uid == $self->{md5}->{uid} ) {
 268                                 $deleted_size += $size;
 269                         }
 270                 }}, $full_path);
 271
 272                 remove_tree $full_path;
 273         } else {
 274                 $deleted_size += -s $full_path;
 275                 unlink $full_path;
 276         }
 277
 278         warn "delete $deleted_size bytes shared\n";
 279
 280         $self->append( $user, 'delete', -$deleted_size, $user->{uid}, $path );
 281         $self->append_meta('md5sum', $user, 'delete', $path );
 282
 283         return $full_path;
 284 }
 285
 286 sub file_size {
 287         my ( $self, $user, $path ) = @_;
 288         $user = $self->user_info($user) unless ref $user eq 'HASH';
 289
 290         my $full_path = "$user->{dir}/$path";
 291         return -s $full_path;
 292 }
 293
 294 1;