implement send_file md5sum handling
[cloudstore.git] / 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         die "user_info $login: $@" if $@;
44         my $user;
45         $user->{$_} = shift @p foreach @n;
46         return $user;
47 }
48
49 sub create_user {
50         my ( $self, $new_email, $new_passwd, $new_quota ) = @_;
51
52         my $max_uid = 0;
53         my $found = 0;
54
55         open(my $fh, '<', $self->{passwd});
56         while(<$fh>) {
57                 my ( $login, $passwd, $uid, $gid, $email, $dir, $shell ) = split(/:/,$_);
58                 $max_uid = $uid if $uid > $max_uid;
59                 $found = $uid if $email eq $new_email;
60         }
61         close($fh);
62
63         if ( ! $found ) {
64                 $max_uid++;
65                 my $dir = "$self->{SLICE}/$max_uid";
66                 warn "# create_user $new_email $new_quota = $max_uid $dir";
67                 open(my $fh, '>>', $self->{passwd});
68                 print $fh "u$max_uid:$new_passwd:$max_uid:$self->{PORT}:$new_email:$dir:/bin/true\n";
69                 close($fh);
70                 $found = $max_uid;
71
72                 mkdir $dir;
73                 chown $max_uid, $self->{PORT}, $dir;
74
75                 my $path = "$dir/.meta/secrets";
76                 $self->mkbasepath($path);
77                 open($fh, '>', $path);
78                 print $fh "u$max_uid:$new_passwd\n";
79                 close $fh;
80         }
81
82         # FIXME update quota only on create?
83         $self->gearman_do( 'narada_s1_quota_set' => "$found $new_quota" );
84
85         return $found;
86 }
87
88 sub mkbasepath {
89         my ($self,$path,$opts) = @_;
90         $path =~ s{/[^/]+$}{};
91         make_path $path unless -d $path;
92 }
93
94 sub user_dir {
95         my ( $self,$user, $dir ) = @_;
96         $user = $self->user_info($user) unless ref $user eq 'HASH';
97         my $path;
98         if ( exists $user->{dir} ) {
99                 $path = $user->{dir} . '/.meta/' . $dir;
100         } else {
101                 die "no dir in ", dump $user;
102         }
103         $path =~ s{//+}{/}g;
104
105         if ( ! -e $path ) {
106                 $self->mkbasepath( $path, { uid => $user->{uid} } );
107                 open(my $fh, '>', $path);
108                 close $fh;
109                 chown $user->{uid}, $user->{gid}, $path;
110                 warn "# user_dir created $path\n";
111         }
112
113         #warn "### user_dir $path";
114         return $path;
115 }
116
117 sub append {
118         my $self = shift @_;
119         $self->append_meta( 'usage', @_ );
120 }
121
122 sub append_meta {
123         my $self = shift @_;
124         my $log  = shift @_;
125         my $user = shift @_;
126         my $path = $self->user_dir( $user => $log );
127         my $delimiter = '#';
128            $delimiter = '  ' if $log =~ m/md5sum$/;
129         my $line = join($delimiter,@_);
130         open(my $fh, '>>', $path);
131         print $fh "$line\n";
132         close $fh;
133         warn "## $path $line\n";
134 }
135
136 sub usage {
137         my ( $self, $user ) = @_;
138         $user = $self->user_info($user) unless ref $user eq 'HASH';
139         my $path = $self->user_dir( $user => 'usage');
140         my $sum;
141         open(my $fh, '<', $path);
142         while(<$fh>) {
143                 chomp;
144                 my @v = split(/#/,$_);
145                 $sum->{ $v[0] } += $v[1];
146                 $sum->{_usage}  += $v[1];
147         }
148         my ( $usage, $quota ) = split(/ /,
149                 $self->gearman_do( 'narada_s1_quota_get' => $user->{uid} )
150         );
151         $sum->{_usage} += $usage;
152         $sum->{_quota} = $quota;
153         warn "## usage ",dump($user, $sum), $/;
154         return $sum;
155 }
156
157 sub send_file {
158         my ( $self, $f_uid,$f_path, $t_uid,$t_path ) = @_;
159
160         my $f = $self->user_info($f_uid);
161         die "FIXME not on current slice" if $f->{dir} !~ m/^$self->{SLICE}/;
162         my $t = $self->user_info($t_uid);
163
164         my $f_full = "$f->{dir}/$f_path";
165         my $t_full = "$t->{dir}/$t_path";
166
167         $self->mkbasepath( $t_full, { uid => $t->{uid} } );
168
169         my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat $f_full;
170         if ( $uid == $f->{uid} ) {
171                 warn "# send_file - move $f_uid $f_path to pool\n";
172                 chown $self->{md5}->{uid}, $self->{md5}->{gid}, $f_full;
173                 chmod oct("0444"), $f_full;
174                 $self->append( $f, 'sent', -s $f_full, $t->{uid}, $f_path );
175         } elsif ( $uid == $self->{md5}->{uid} ) {
176                 warn "# send_file - shared $f_full\n";
177         }
178
179         $self->delete( $t, $t_path ) if -e $t_full;
180
181         my $ok = link $f_full, $t_full; 
182         $self->append( $t, 'recv', -s $t_full, $f->{uid}, $t_path );
183
184         my $md5 = $self->md5sum($f)->get( $f_path );
185         if ( ! $md5 ) {
186                 warn "ERROR: no md5 for $f_path";
187                 return $ok;
188         }
189
190         $self->md5sum($t)->put( $t_path => $md5 );
191         $self->md5sum_close($f);
192         $self->md5sum_close($t);
193
194         $self->append_meta('md5sum', $t, $md5 => $t_path ); # md5sum for received files!
195
196         return $ok;
197 }
198
199 sub rename_file {
200         my ( $self, $user, $from, $to ) = @_;
201         $user = $self->user_info($user) unless ref $user eq 'HASH';
202
203         $self->append( $user, 'rename', $from, $to );
204 }
205
206
207 sub delete {
208         my ( $self, $user, $path ) = @_;
209         $user = $self->user_info($user) unless ref $user eq 'HASH';
210
211         my $deleted_size = 0;
212         my $full_path = "$user->{dir}/$path";
213
214         if ( -d $full_path ) {
215
216                 find({ 
217                 no_chdir => 1,
218                 wanted => sub {
219                         return if -d $_;
220                         my ($uid,$size) = (stat($_))[4,7];
221                         warn "## find $uid $size $_\n";
222                         if ( $uid == $self->{md5}->{uid} ) {
223                                 $deleted_size += $size;
224                         }
225                 }}, $full_path);
226
227                 remove_tree $full_path;
228         } else {
229                 $deleted_size += -s $full_path;
230                 unlink $full_path;
231         }
232
233         warn "delete $deleted_size bytes shared\n";
234
235         $self->append( $user, 'delete', -$deleted_size, $user->{uid}, $path );
236         $self->append_meta('md5sum', $user, 'delete', $path );
237
238         $self->md5sum($user)->out( $path );
239         $self->md5sum_close($user);
240
241         return $full_path;
242 }
243
244 1;