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) || die "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         $slice =~ s{/.+/(\w+)$}{$1};
  81         my ( $dir, $port ) = $self->slice_dir_port( $slice );
  82
  83         $dir ||= $ENV{SLICE};
  84         $port ||= 6501;
  85
  86         if ( ! $found ) {
  87                 $max_uid++;
  88                 $dir .= "/$max_uid";
  89                 warn "# create_user $slice $new_email $new_quota = $max_uid $dir";
  90                 open(my $fh, '>>', $self->{passwd});
  91                 print $fh "u$max_uid:$new_passwd:$max_uid:$port:$new_email:$dir:/bin/true\n";
  92                 close($fh);
  93                 $found = $max_uid;
  94
  95                 mkdir $dir;
  96                 chown $max_uid, $port, $dir;
  97
  98                 my $path = "$dir/.meta/secrets";
  99                 $self->mkbasepath($path);
 100                 open($fh, '>', $path);
 101                 print $fh "u$max_uid:$new_passwd\n";
 102                 close $fh;
 103         }
 104
 105         # FIXME update quota only on create?
 106         $self->gearman_do( $self->dir2gearman( $dir, 'quota', 'set' ) => "$found $new_quota" );
 107
 108         return 'u' . $found;
 109 }
 110
 111 sub mkbasepath {
 112         my ($self,$path,$opts) = @_;
 113         $path =~ s{/[^/]+$}{};
 114         make_path $path unless -d $path;
 115 }
 116
 117 sub user_dir {
 118         my ( $self,$user, $dir ) = @_;
 119         $user = $self->user_info($user) unless ref $user eq 'HASH';
 120         my $path;
 121         if ( exists $user->{dir} ) {
 122                 $path = $user->{dir} . '/.meta/' . $dir;
 123         } else {
 124                 die "no dir in ", dump $user;
 125         }
 126         $path =~ s{//+}{/}g;
 127
 128         if ( ! -e $path ) {
 129                 $self->mkbasepath( $path, { uid => $user->{uid} } );
 130                 open(my $fh, '>', $path);
 131                 close $fh;
 132                 chown $user->{uid}, $user->{gid}, $path;
 133                 warn "# user_dir created $path\n";
 134         }
 135
 136         #warn "### user_dir $path";
 137         return $path;
 138 }
 139
 140 sub append {
 141         my $self = shift @_;
 142         $self->append_meta( 'usage', @_ );
 143 }
 144
 145 sub append_meta {
 146         my $self = shift @_;
 147         my $log  = shift @_;
 148         my $user = shift @_;
 149         my $path = $self->user_dir( $user => $log );
 150         my $delimiter = '#';
 151            $delimiter = '  ' if $log =~ m/md5sum$/;
 152         my $line = join($delimiter,@_);
 153         open(my $fh, '>>', $path);
 154         print $fh "$line\n";
 155         close $fh;
 156         warn "## $path $line\n";
 157 }
 158
 159 sub usage {
 160         my ( $self, $user ) = @_;
 161         $user = $self->user_info($user) unless ref $user eq 'HASH';
 162         my $path = $self->user_dir( $user => 'usage');
 163         my $sum;
 164         open(my $fh, '<', $path);
 165         while(<$fh>) {
 166                 chomp;
 167                 my @v = split(/#/,$_);
 168                 $sum->{ $v[0] } += $v[1];
 169                 $sum->{_usage}  += $v[1];
 170         }
 171         my ( $usage, $quota ) = split(/ /,
 172                 $self->gearman_do( $self->dir2gearman( $user->{dir}, 'quota', 'get' ) => $user->{uid} )
 173         );
 174         $sum->{_usage} += $usage;
 175         $sum->{_quota} = $quota;
 176         warn "## usage ",dump($user, $sum), $/;
 177         return $sum;
 178 }
 179
 180 sub send_file {
 181         my ( $self, $f_uid,$f_path, $t_uid,$t_path ) = @_;
 182
 183         my $f = $self->user_info($f_uid);
 184         die "FIXME not on current slice" if $f->{dir} !~ m/^$ENV{SLICE}/;
 185         my $t = $self->user_info($t_uid);
 186
 187         my $f_full = "$f->{dir}/$f_path";
 188         my $t_full = "$t->{dir}/$t_path";
 189
 190         $self->mkbasepath( $t_full, { uid => $t->{uid} } );
 191
 192         my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat $f_full;
 193         if ( $uid == $f->{uid} ) {
 194                 warn "# send_file - move $f_uid $f_path to pool\n";
 195                 chown $self->{md5}->{uid}, $self->{md5}->{gid}, $f_full;
 196                 chmod oct("0444"), $f_full;
 197                 $self->append( $f, 'sent', -s $f_full, $t->{uid}, $f_path );
 198         } elsif ( $uid == $self->{md5}->{uid} ) {
 199                 warn "# send_file - shared $f_full\n";
 200         }
 201
 202         $self->delete( $t, $t_path ) if -e $t_full;
 203
 204         my $size = -s $f_full;
 205         my $md5;
 206
 207         my $ok;
 208         {
 209                 no autodie qw(link);
 210                 $ok = link $f_full, $t_full
 211         };
 212         if ( ! $ok || $! =~ m/cross-link/ ) {
 213                 $ok = symlink $f_full, $t_full;
 214         } else {
 215                 $size = -s $t_full;
 216
 217                 if ( $f->{uid} == $self->{md5}->{uid} ) {
 218                         $md5 = $f_path; # we don't have local md5sum db for md5 user!
 219                 } else {
 220                         $md5 = $self->md5_get($f_full);
 221                 }
 222
 223         }
 224
 225         if ( $ok ) {
 226                 $self->append( $t, 'recv', $size, $f->{uid}, $t_path );
 227                 $self->append_meta('md5sum', $t, $md5 => $t_path ) if $md5; # md5sum for received files! FIXME -- cross-slice md5
 228                 $self->refresh_file_list( $t );
 229         }
 230
 231         return $size;
 232 }
 233
 234 sub rename_file {
 235         my ( $self, $user, $from, $to ) = @_;
 236         $user = $self->user_info($user) unless ref $user eq 'HASH';
 237
 238         my $f_full = "$user->{dir}/$from";
 239         my $t_full = "$user->{dir}/$to";
 240
 241         $self->mkbasepath( $t_full, { uid => $user->{uid}, gid => $user->{gid} } );
 242         my $ok = rename $f_full, $t_full;
 243
 244         my $md5 = $self->md5_get($t_full);
 245         if ( ! $md5 ) {
 246                 warn "ERROR: no md5sum for $from";
 247                 return $ok; # XXX our internal error
 248         }
 249
 250         $self->append_meta('md5sum', $user, 'rename' => $from );
 251         $self->append_meta('md5sum', $user, $md5 => $from );
 252
 253         $self->refresh_file_list( $user );
 254
 255         return $ok;
 256 }
 257
 258
 259 sub delete {
 260         my ( $self, $user, $path ) = @_;
 261         $user = $self->user_info($user) unless ref $user eq 'HASH';
 262
 263         my $deleted_size = 0;
 264         my $full_path = "$user->{dir}/$path";
 265
 266         if ( -d $full_path ) {
 267
 268                 find({
 269                 no_chdir => 1,
 270                 wanted => sub {
 271                         return if -d $_;
 272                         my ($uid,$size) = (stat($_))[4,7];
 273                         warn "## find $uid $size $_\n";
 274                         if ( $uid == $self->{md5}->{uid} ) {
 275                                 $deleted_size += $size;
 276                         }
 277                 }}, $full_path);
 278
 279                 remove_tree $full_path;
 280         } else {
 281                 $deleted_size += -s $full_path;
 282                 unlink $full_path;
 283         }
 284
 285         warn "delete $deleted_size bytes shared\n";
 286
 287         $self->append( $user, 'delete', -$deleted_size, $user->{uid}, $path );
 288         $self->append_meta('md5sum', $user, 'delete', $path );
 289
 290         $self->refresh_file_list( $user );
 291
 292         return $full_path;
 293 }
 294
 295 sub file_size {
 296         my ( $self, $user, $path ) = @_;
 297         $user = $self->user_info($user) unless ref $user eq 'HASH';
 298
 299         my $full_path = "$user->{dir}/$path";
 300         return -s $full_path;
 301 }
 302
 303 sub refresh_file_list {
 304         my ( $self, $user ) = @_;
 305         $user = $self->user_info($user) unless ref $user eq 'HASH';
 306         my $full_path = "$user->{dir}/.meta/files";
 307         if ( -e $full_path ) {
 308                 warn "## refresh_file_list $full_path";
 309                 unlink $full_path;
 310         }
 311 }
 312
 313 1;