pass slice group name to new

[cloudstore.git] / lib / CloudStore / API.pm

diff --git a/lib/CloudStore/API.pm b/lib/CloudStore/API.pm
index 89c6f1b..7913d36 100644 (file)
--- a/lib/CloudStore/API.pm
+++ b/lib/CloudStore/API.pm
@@ -3,18 +3,39 @@ use warnings;
 use strict;
 use autodie;
 
+use lib 'lib';
+use base qw(CloudStore::Gearman);
+
+use File::Path qw(make_path remove_tree);
+use File::Find;
+use Data::Dump qw(dump);
+
 sub new {
-       my $class = shift;
-       my $self = {@_};
+       my ($class,$group) = @_;
+
+       my ( undef, $dir, $port, undef ) = getgrnam($group) || die "can't find group $group: $!";
+       my $self = {
+               passwd => '/var/lib/extrausers/passwd',
+               PORT => $port,
+               SLICE => $dir,
+       };
        bless $self, $class;
 
-       $self->{passwd} ||= '/var/lib/extrausers/passwd';
-       $self->{PORT}   ||= $ENV{PORT}  || die "no PORT in env";
-       $self->{SLICE}  ||= $ENV{SLICE} || die "no SLICE in env";
+       $self->{md5} = $self->user_info('md5');
 
        return $self;
 }
 
+sub user_info {
+       my ($self,$login) = @_;
+
+       my @n = qw/ login passwd uid gid quota comment gecos dir shell expire /;
+       my @p = $login =~ m/^\d+$/ ? getpwuid $login : getpwnam $login;
+       my $user;
+       $user->{$_} = shift @p foreach @n;
+       return $user;
+}
+
 sub create_user {
        my ( $self, $new_email, $new_passwd, $new_quota ) = @_;
 
@@ -40,30 +61,132 @@ sub create_user {
 
                mkdir $dir;
                chown $max_uid, $self->{PORT}, $dir;
+
        }
 
+       # FIXME update quota only on create?
+       $self->gearman_do( 'narada_s1_quota_set' => "$found $new_quota" );
+
        return $found;
 }
 
+sub mkbasepath {
+       my ($path,$opts) = @_;
+       $path =~ s{/[^/]+$}{};
+       make_path $path unless -d $path;
+}
+
+sub user_dir {
+       my ( $self,$user, $dir ) = @_;
+       $user = $self->user_info($user) unless ref $user eq 'HASH';
+       my $path;
+       if ( exists $user->{dir} ) {
+               $path = $user->{dir} . '/' . $dir;
+       } else {
+               die "no dir in ", dump $user;
+       }
+       $path =~ s{//+}{/}g;
+#      warn "## user_dir $path";
+       return $path;
+}
+
+sub append {
+       my $self = shift @_;
+       my $user = shift @_;
+       my $path = $self->user_dir( $user => '.log');
+       my $line = join('#',@_);
+       open(my $fh, '>>', $path);
+       print $fh "$line\n";
+       close $fh;
+       warn "## $path $line\n";
+       $user = $self->user_info($user) unless ref $user eq 'HASH';
+}
+
+sub usage {
+       my ( $self, $user ) = @_;
+       $user = $self->user_info($user) unless ref $user eq 'HASH';
+       my $path = $self->user_dir( $user => '.log');
+       my $sum;
+       open(my $fh, '<', $path);
+       while(<$fh>) {
+               chomp;
+               my @v = split(/#/,$_);
+               $sum->{ $v[0] } += $v[1];
+               $sum->{_usage}  += $v[1];
+       }
+       my ( $usage, $quota ) = split(/ /,
+               $self->gearman_do( 'narada_s1_quota_get' => $user->{uid} )
+       );
+       $sum->{_usage} += $usage;
+       $sum->{_quota} = $quota;
+       warn "## usage ",dump($user, $sum), $/;
+       return $sum;
+}
+
 sub send_file {
-       my ( $f_uid,$f_path, $t_uid,$t_path ) = @_;
+       my ( $self, $f_uid,$f_path, $t_uid,$t_path ) = @_;
 
-       
+       my $f = $self->user_info($f_uid);
+       my $t = $self->user_info($t_uid);
+
+       my $f_full = "$f->{dir}/$f_path";
+       my $t_full = "$t->{dir}/$t_path";
+
+       mkbasepath $t_full, { uid => $t->{uid} };
+
+       my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat $f_full;
+       if ( $uid == $f->{uid} ) {
+               warn "# send_file - move $f_uid $f_path to pool\n";
+               chown $self->{md5}->{uid}, $self->{md5}->{gid}, $f_full;
+               chmod oct("0444"), $f_full;
+               $self->append( $f, 'sent', -s $f_full, $t->{uid}, $f_path );
+       } elsif ( $uid == $self->{md5}->{uid} ) {
+               warn "# send_file - shared $f_full\n";
+       }
+
+       $self->delete( $t, $t_path ) if -e $t_full;
+
+       link $f_full, $t_full; 
+       $self->append( $t, 'recv', -s $t_full, $f->{uid}, $t_path );
 }
 
 sub rename_file {
-       my ( $uid, $from, $to ) = @_;
+       my ( $self, $user, $from, $to ) = @_;
+       $user = $self->user_info($user) unless ref $user eq 'HASH';
+
+       $self->append( $user, 'rename', $from, $to );
 }
 
 
 sub delete {
-       my ( $uid, $path ) = @_;
-
-}
+       my ( $self, $user, $path ) = @_;
+       $user = $self->user_info($user) unless ref $user eq 'HASH';
+
+       my $deleted_size = 0;
+       my $full_path = "$user->{dir}/$path";
+
+       if ( -d $full_path ) {
+
+               find({ 
+               no_chdir => 1,
+               wanted => sub {
+                       return if -d $_;
+                       my ($uid,$size) = (stat($_))[4,7];
+                       warn "## find $uid $size $_\n";
+                       if ( $uid == $self->{md5}->{uid} ) {
+                               $deleted_size += $size;
+                       }
+               }}, $full_path);
+
+               remove_tree $full_path;
+       } else {
+               $deleted_size += -s $full_path;
+               unlink $full_path;
+       }
 
-sub usage {
-       my ( $uid ) = @_;
+       warn "delete $deleted_size bytes shared\n";
 
+       $self->append( $user, 'delete', -$deleted_size, $user->{uid}, $path );
 }
 
 1;