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         warn "## 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         die "getgrnam $slice: $!" if $!;
  40         warn "# slice_dir_port $slice = $dir $port\n";
  41         return ( $dir, $port );
  42 }
  43
  44 sub dir2gearman {
  45         my $self = shift;
  46         my $dir  = shift;
  47         $dir =~ s/\W+/_/g;
  48         $dir =~ s/^_+//;
  49         $dir =~ s{_\d+$}{};
  50         return join('_', $dir, @_);
  51 }
  52
  53 sub user_info {
  54         my ($self,$login) = @_;
  55
  56         confess "need login" unless $login;
  57
  58         my @n = qw/ login passwd uid gid quota comment gecos dir shell expire /;
  59         my @p = $login =~ m/^\d+$/ ? getpwuid $login : getpwnam $login;
  60         die "user_info $login: $@" if $@;
  61         my $user;
  62         $user->{$_} = shift @p foreach @n;
  63         return $user;
  64 }
  65
  66 sub create_user {
  67         my ( $self, $new_email, $new_passwd, $new_quota ) = @_;
  68
  69         my $max_uid = 0;
  70         my $found = 0;
  71
  72         open(my $fh, '<', $self->{passwd});
  73         while(<$fh>) {
  74                 my ( $login, $passwd, $uid, $gid, $email, $dir, $shell ) = split(/:/,$_);
  75                 $max_uid = $uid if $uid > $max_uid;
  76                 $found = $login if $email eq $new_email;
  77         }
  78         close($fh);
  79
  80         my $slice = $ENV{SLICE} || 's1';
  81         $slice =~ s{/.+/(\w+)$}{$1};
  82         my ( $dir, $port ) = $self->slice_dir_port( $slice );
  83
  84         $dir ||= $ENV{SLICE};
  85         $port ||= 6501;
  86
  87         if ( ! $found ) {
  88                 $max_uid++;
  89                 $dir .= "/$max_uid";
  90                 warn "# create_user $slice $new_email $new_quota = $max_uid $dir";
  91                 open(my $fh, '>>', $self->{passwd});
  92                 print $fh "u$max_uid:$new_passwd:$max_uid:$port:$new_email:$dir:/bin/true\n";
  93                 close($fh);
  94                 $found = "u$max_uid";
  95
  96                 mkdir $dir;
  97                 chown $max_uid, $port, $dir;
  98
  99                 my $path = "$dir/.meta/secrets";
 100                 $self->mkbasepath($path);
 101                 open($fh, '>', $path);
 102                 print $fh "u$max_uid:$new_passwd\n";
 103                 close $fh;
 104         }
 105
 106         # FIXME update quota only on create?
 107         $self->gearman_do( $self->dir2gearman( $dir, 'quota', 'set' ) => "$found $new_quota" );
 108
 109         return $found;
 110 }
 111
 112 sub mkbasepath {
 113         my ($self,$path,$opts) = @_;
 114         cluck "ERROR: mkbasepath called without opts, so user is root!" unless $opts;
 115         if ( $ENV{DEBUG} ) {
 116                 warn "# mkbasepath $path ",dump($opts);
 117                 $opts->{verbose} ||= 1;
 118         }
 119         $path =~ s{/[^/]+$}{};
 120         if ( ! -d $path ) {
 121                 make_path $path, $opts;
 122         }
 123 }
 124
 125 sub user_dir {
 126         my ( $self, $user, $dir ) = @_;
 127         $user = $self->user_info($user) unless ref $user eq 'HASH';
 128         my $path;
 129         if ( exists $user->{dir} ) {
 130                 $path = $user->{dir} . '/.meta/' . $dir;
 131         } else {
 132                 die "no dir in ", dump $user;
 133         }
 134         $path =~ s{//+}{/}g;
 135
 136         if ( ! -e $path ) {
 137                 $self->mkbasepath( $path, { uid => $user->{uid} } );
 138                 open(my $fh, '>', $path);
 139                 close $fh;
 140                 chown $user->{uid}, $user->{gid}, $path;
 141                 warn "# user_dir created $path\n";
 142         }
 143
 144         #warn "### user_dir $path";
 145         return $path;
 146 }
 147
 148 sub append {
 149         my $self = shift @_;
 150         $self->append_meta( 'usage', @_ );
 151 }
 152
 153 sub append_meta {
 154         my $self = shift @_;
 155         my $log  = shift @_;
 156         my $user = shift @_;
 157         my $path = $self->user_dir( $user => $log );
 158         my $delimiter = '#';
 159            $delimiter = '  ' if $log =~ m/md5sum$/;
 160         my $line = join($delimiter,@_);
 161         open(my $fh, '>>', $path);
 162         print $fh "$line\n";
 163         close $fh;
 164         warn "## $path $line\n";
 165 }
 166
 167 sub usage {
 168         my ( $self, $user ) = @_;
 169         $user = $self->user_info($user) unless ref $user eq 'HASH';
 170
 171         my $usage_path = $user->{dir} . '/.meta/files.usage';
 172         $self->mkbasepath( $usage_path, { uid => $user->{uid} } );
 173         if ( ! -e $usage_path ) {
 174                 warn "# usage $usage_path missing";
 175                 $self->list_files($user);
 176         }
 177
 178         open(my $fh, '<', $usage_path);
 179         my $size = <$fh>;
 180         chomp $size;
 181
 182         warn "# usage $user->{login} $size bytes\n";
 183         return $size;
 184
 185 =for slow and broken
 186
 187         my $path = $self->user_dir( $user => 'usage');
 188         my $sum;
 189         open(my $fh, '<', $path);
 190         while(<$fh>) {
 191                 chomp;
 192                 my @v = split(/#/,$_);
 193                 $sum->{ $v[0] } += $v[1];
 194                 $sum->{_usage}  += $v[1];
 195         }
 196         my ( $usage, $quota ) = split(/ /,
 197                 $self->gearman_do( $self->dir2gearman( $user->{dir}, 'quota', 'get' ) => $user->{uid} )
 198         );
 199         $sum->{_usage} += $usage;
 200         $sum->{_quota} = $quota;
 201         warn "## usage ",dump($user, $sum), $/;
 202         return $sum;
 203
 204 =cut
 205
 206 }
 207
 208 sub send_file {
 209         my ( $self, $f_uid,$f_path, $t_uid,$t_path ) = @_;
 210
 211         my $f = $self->user_info($f_uid);
 212         die "FIXME not on current slice" if $f->{dir} !~ m/^$ENV{SLICE}/;
 213         my $t = $self->user_info($t_uid);
 214
 215         my $f_full = "$f->{dir}/$f_path";
 216         my $t_full = "$t->{dir}/$t_path";
 217
 218         $self->mkbasepath( $t_full, { uid => $t->{uid} } );
 219
 220         my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat $f_full;
 221         if ( $uid == $f->{uid} ) {
 222                 warn "# send_file - move $f_uid $f_path to pool\n";
 223                 chown $self->{md5}->{uid}, $self->{md5}->{gid}, $f_full;
 224                 chmod oct("0444"), $f_full;
 225                 $self->append( $f, 'sent', -s $f_full, $t->{uid}, $f_path );
 226         } elsif ( $uid == $self->{md5}->{uid} ) {
 227                 warn "# send_file - shared $f_full\n";
 228         }
 229
 230         $self->delete( $t, $t_path ) if -e $t_full;
 231
 232         my $size = -s $f_full;
 233         my $md5;
 234
 235         my $ok;
 236         {
 237                 no autodie qw(link);
 238                 $ok = link $f_full, $t_full
 239         };
 240         if ( ! $ok || $! =~ m/cross-link/ ) {
 241                 $ok = symlink $f_full, $t_full;
 242         } else {
 243                 $size = -s $t_full;
 244
 245                 if ( $f->{uid} == $self->{md5}->{uid} ) {
 246                         $md5 = $f_path; # we don't have local md5sum db for md5 user!
 247                 } else {
 248                         $md5 = $self->md5_get($f_full);
 249                 }
 250
 251         }
 252
 253         if ( $ok ) {
 254                 $self->append( $t, 'recv', $size, $f->{uid}, $t_path );
 255                 $self->append_meta('md5sum', $t, $md5 => $t_path ) if $md5; # md5sum for received files! FIXME -- cross-slice md5
 256                 $self->refresh_file_list( $t );
 257         } else {
 258                 warn "ERROR: send_file $f_full -> $t_full: $!";
 259         }
 260
 261         return $size;
 262 }
 263
 264 sub rename_file {
 265         my ( $self, $user, $from, $to ) = @_;
 266         $user = $self->user_info($user) unless ref $user eq 'HASH';
 267
 268         my $f_full = "$user->{dir}/$from";
 269         my $t_full = "$user->{dir}/$to";
 270
 271         $self->mkbasepath( $t_full, { uid => $user->{uid}, gid => $user->{gid} } );
 272         my $ok = rename $f_full, $t_full;
 273
 274         $self->refresh_file_list( $user );
 275
 276         my $md5 = $self->md5_get($t_full);
 277         if ( ! $md5 ) {
 278                 warn "ERROR: no md5sum for $from";
 279                 return $ok; # XXX our internal error
 280         }
 281
 282         $self->append_meta('md5sum', $user, 'rename' => $from );
 283         $self->append_meta('md5sum', $user, $md5 => $from );
 284
 285         return $ok;
 286 }
 287
 288
 289 sub delete {
 290         my ( $self, $user, $path ) = @_;
 291         $user = $self->user_info($user) unless ref $user eq 'HASH';
 292
 293         my $deleted_size = 0;
 294         my $full_path = "$user->{dir}/$path";
 295
 296         if ( -d $full_path ) {
 297
 298                 find({
 299                 no_chdir => 1,
 300                 wanted => sub {
 301                         return if -d $_;
 302                         my ($uid,$size) = (stat($_))[4,7];
 303                         warn "## find $uid $size $_\n";
 304                         if ( $uid == $self->{md5}->{uid} ) {
 305                                 $deleted_size += $size;
 306                         }
 307                 }}, $full_path);
 308
 309                 remove_tree $full_path;
 310         } else {
 311                 $deleted_size += -s $full_path;
 312                 unlink $full_path;
 313         }
 314
 315         warn "delete $deleted_size bytes shared\n";
 316
 317         $self->append( $user, 'delete', -$deleted_size, $user->{uid}, $path );
 318         $self->append_meta('md5sum', $user, 'delete', $path );
 319
 320         $self->refresh_file_list( $user );
 321
 322         return $full_path;
 323 }
 324
 325 sub file_size {
 326         my ( $self, $user, $path ) = @_;
 327         $user = $self->user_info($user) unless ref $user eq 'HASH';
 328
 329         my $full_path = "$user->{dir}/$path";
 330         my $size = -s $full_path;
 331         warn "# file_size $full_path = $size bytes\n";
 332         return $size;
 333 }
 334
 335 sub list_files {
 336         my ( $self, $user, $path ) = @_;
 337
 338         $user =~ s{/+$}{} && warn "cleanup list_files arg [$user]";
 339
 340         $user = $self->user_info($user) unless ref $user eq 'HASH';
 341
 342         die "no dir for ",dump($user) unless exists $user->{dir};
 343
 344         my $files = $user->{dir} . '/.meta/files';
 345         $self->mkbasepath( $files, { uid => $user->{uid} } );
 346         if ( -e $files && -s $files > 0 && -e "$files.usage") {
 347                 local $/ = undef;
 348                 open(my $fh, '<', $files);
 349                 my $list = <$fh>;
 350                 close($fh);
 351                 warn "# list_files $user->{login} from cache ", length($list), " bytes\n";
 352                 return $list;
 353         }
 354
 355         my $dir = $user->{dir};
 356         open(my $pipe, '-|', qq|find -L $dir -printf "%y %s %p\n"|);
 357         open(my $fh, '>', "$files.new");
 358         my $total_usage = 0;
 359         my $list_txt;
 360         while(<$pipe>) {
 361                 chomp;
 362                 my ( $type, $size, $name ) = split(/\s/, $_, 3);
 363                 $name =~ s{$dir}{./};
 364                 $name =~ s{//+}{/}g;
 365                 my $line = "$type $size $name\n";
 366                 print $fh $line;
 367                 $list_txt .= $line;
 368                 $total_usage += $size;
 369         }
 370         close($pipe);
 371         close($fh);
 372         rename "$files.new", $files;
 373
 374         open(my $usage, '>', "$files.usage.new");
 375         print $usage $total_usage;
 376         close($usage);
 377         rename "$files.usage.new", "$files.usage";
 378
 379         warn "# list_files $dir usage: $total_usage\n";
 380
 381         return $list_txt;
 382 }
 383
 384 sub refresh_file_list {
 385         my ( $self, $user ) = @_;
 386         $user = $self->user_info($user) unless ref $user eq 'HASH';
 387         my $full_path = "$user->{dir}/.meta/files";
 388         if ( -e $full_path ) {
 389                 warn "## refresh_file_list $full_path";
 390                 unlink $full_path || warn "unlink $full_path: $!";
 391         } else {
 392                 warn "## refresh_file_list $full_path missing";
 393         }
 394
 395         unlink "$full_path.usage" if -e "$full_path.usage";
 396 }
 397
 398 1;