lib/CloudStore/Store.pm

   1 package CloudStore::Store;
   2 use warnings;
   3 use strict;
   4
   5 use autodie;
   6 use JSON::XS;
   7 use File::Path qw(make_path);
   8 use File::Slurp qw();
   9 use Digest::MD5 qw(md5_base64);
  10 use Data::Dump qw(dump);
  11 use Carp qw(confess);
  12 use BerkeleyDB;
  13
  14 use WarnColor;
  15
  16 sub new {
  17         my $class = shift;
  18
  19         my $self = {@_};
  20         bless $self, $class;
  21
  22         die "no dir" unless $self->{dir};
  23         $self->{md5pool} = $self->{dir} . '/md5';
  24
  25         warn "# new ",dump $self if $ENV{DEBUG};
  26
  27         return $self;
  28 }
  29
  30 sub user_set {
  31         my ( $self,$data ) = @_;
  32 }
  33
  34 sub user_get {
  35         my ( $self,$data ) = @_;
  36 }
  37
  38 sub modify_file {
  39         my ( $self,$data ) = @_;
  40
  41 #       if ( my $old = $self->file_get( $data ) ) {
  42 #               $self->usage_decr( $data );
  43 #       }
  44
  45         $self->new_file($data);
  46 }
  47
  48 sub new_file {
  49         my ( $self,$data ) = @_;
  50 #       $self->file_set($data);
  51 #       $self->usage_incr($data);
  52 }
  53
  54 sub remove_file {
  55         my ( $self, $data ) = @_;
  56 #       $self->usage_decr( $data );
  57 }
  58
  59 sub make_dir {
  60         my ( $self, $data ) = @_;
  61
  62 }
  63
  64 sub new_link {
  65         my ( $self, $data ) = @_;
  66
  67         warn "# new_link ",dump $data;
  68
  69         if ( $data->{file} =~ m{^(.*/?)\.send/([^/]+)/(.+)$} ) {
  70                 my ( $dir, $to, $name ) = ( $1, $2, $3 );
  71                 my $path = $self->blob_path($data);
  72                 my $link_to = readlink $path;
  73                 warn "$link_to";
  74                 if ( $link_to =~ s{^\Q/rsyncd-munged/\E}{/} ) {
  75
  76                         my $s = $path;
  77                         $s =~ s{/[^/]+$}{}; # strip filename
  78                         while ( $link_to =~ s{/../}{/} ) {
  79                                 $s =~ s{/[^/]+$}{} || die "can't strip $s";
  80                                 warn "## simplify $s $link_to\n";
  81                         }
  82                         $s .= $link_to;
  83
  84                         my $d = $self->blob_path({
  85                                 pid => $data->{pid},
  86                                 file => $name
  87                         });
  88
  89                         # $name can contain directories so we must create them
  90                         my $to_dir = $d;
  91                         $to_dir =~ s{/[^/]+$}{};
  92                         make_path $to_dir if ! -e $to_dir;
  93
  94                         if ( ! -e $s ) {
  95                                 warn "ERROR: can't find source $s";
  96                         } else {
  97
  98                                 warn "link $s -> $d\n";
  99                                 link $s, $d;
 100
 101                                 my ($l,$f) = ($1,$2) if $s =~ m{users/([^/]+)/blob/(.+)};
 102
 103 #                               my $origin = $self->file_get({
 104 #                                       login => $l,
 105 #                                       file  => $f,
 106 #                               });
 107 #                               $self->new_file($origin);
 108                                 warn "INFO: sent file ",dump($l,$f);
 109                                 my $md5sum = $self->md5sum($data);
 110
 111                                 my $md5 = $md5sum->{$s} || die "no md5 for $s";
 112                                 $md5sum->{$d} = $md5; # FIXME broken!
 113                         }
 114
 115
 116                 } else {
 117                         warn "ERROR: can't SEND To:$to Name:$name Link:$link_to";
 118                 }
 119         }
 120 }
 121
 122 our $md5_login;
 123 sub md5sum {
 124         my ( $self, $data ) = @_;
 125
 126         if ( exists $md5_login->{$data->{login}} ) {
 127                 return $md5_login->{$data->{login}};
 128         } elsif ( my $login = $data->{login} ) {
 129
 130                 my $md5_path = $self->{dir} || die "no dir?";
 131                 $login =~ s/^u//;
 132                 $md5_path .= "/$login/.md5.db";
 133
 134                 my %md5;
 135                 my $db = tie %md5, 'BerkeleyDB::Hash',
 136                         -Filename => $md5_path,
 137                         -Flags => DB_CREATE,
 138                 ;
 139
 140                 return $md5_login->{$login} = \%md5;
 141         } else {
 142                 confess "can't open md5sum";
 143         }
 144 }
 145
 146 sub rsync_log {
 147         my ( $self, $data ) = @_;
 148         if ( $data =~ m/\[(\d+)\] rsync \w+ (\S+) \w+ (\S+)/ ) {
 149                 my ( $pid, $module, $login ) = ( $1, $2, $3 );
 150
 151                 $login =~ s/\@.+//;
 152                 my ( undef, undef, $uid, $gid, undef, undef, $email, $dir, $shell ) =
 153                         getpwnam $login;
 154
 155                 $self->{pid}->{$pid} = {
 156                         login => $login,
 157                         uid => $uid,
 158                         gid => $gid,
 159                         email => $email,
 160                         dir => $dir,
 161                         shell => $shell,
 162                 };
 163
 164                 warn "created $pid";
 165
 166         } elsif ( $data =~ m/\[(\d+)\] sent \S+ bytes\s+received \S+ bytes/ ) {
 167                 my $pid = $1;
 168                 untie $md5_login->{ $self->{$pid}->{login} } && warn "untie $pid";
 169                 delete $self->{pid}->{$pid};
 170                 warn "removed $pid";
 171         } else {
 172 #               warn "## rsync_log $data";
 173         }
 174 }
 175
 176 sub blob_path {
 177         my ( $self, $data ) = @_;
 178         my $blob = $self->{pid}->{ $data->{pid} }->{dir} || die "no dir for $data->{pid} in ",dump( $self->{pid} );
 179         $blob .= '/' . $data->{file};
 180         return $blob;
 181 }
 182
 183
 184 sub rsync_transfer {
 185         my ( $self,$data ) = @_;
 186
 187         my $path = $self->blob_path($data);
 188
 189         if ( $data->{itemize} =~ m/^[c>]([fdL])/ ) { # received change/create
 190                 my $type = $1;
 191
 192                 if ( $type eq 'f' ) {
 193                         $self->modify_file( $data );
 194                         $self->dedup( $data, $path );
 195                 } elsif ( $type eq 'd' ) {
 196                         $self->make_dir( $data );
 197                 } elsif ( $type eq 'L' ) {
 198                         $self->new_link( $data );
 199                 } else {
 200                         die "unknown type $type ", dump $data;
 201                 }
 202         } elsif ( $data->{itemize} =~ m/\*deleting/ ) {
 203                 $self->remove_file($data);
 204         }
 205         return $data;
 206 }
 207
 208 sub md5pool {
 209         my ( $self, $data ) = @_;
 210
 211         my $pool = $self->{md5pool} || die "no md5pool in ",dump $self;
 212         mkdir $pool unless -e $pool;
 213
 214         my $md5 = $data->{md5} || die "no md5 in ",dump $data;
 215         my $path = $self->blob_path($data);
 216
 217         if ( -e "$pool/$md5" ) {
 218                 warn "dedup hit $md5 $path\n";
 219                 my $dedup = $path . '.dedup';
 220                 rename $path, $dedup;
 221                 link "$pool/$md5", $path;
 222                 unlink $dedup;
 223                 # FIXME fix perms?
 224         } else {
 225                 link $path, "$pool/$md5";
 226         }
 227
 228         my $md5sum = $self->md5sum($data);
 229         $md5sum->{ $data->{file} } = $md5;
 230 }
 231
 232 my $empty_md5 = " " x 32;
 233
 234 sub dedup {
 235         my ( $self, $data, $path ) = @_;
 236
 237         if ( $data->{file} =~ /^(.+\/)?md5sum$/ ) {
 238                 my $dir = $1;
 239                 my $imported = 0;
 240                 warn "IMPORT ", $data->{file}, "\n";
 241                 open(my $md5sum, '<', $path);
 242                 while(<$md5sum>) {
 243                         chomp;
 244                         my ( $md5, $file ) = split(/\s+/,$_,2);
 245                         if ( ! -e "$self->{md5path}/$md5" ) {
 246                                 warn "MISSING $md5 $file\n";
 247                                 next;
 248                         }
 249                         my $new = {
 250                                 pid => $data->{pid},
 251                                 file => "$dir$file",
 252                                 md5 => $md5,
 253                         };
 254                         my $new_path = $self->blob_path($new);
 255                         if ( ! -e $new_path ) {
 256                                 # create path from md5sum file
 257                                 my $only_dir = $1 if $new =~ m{^(.+)/[^/]+$};
 258                                 make_path $only_dir unless -d $only_dir;
 259                                 $imported += link "$self->{md5path}/$md5", $new_path;
 260                                 $self->new_file($new);
 261                                 warn "import from $path ",dump($new);
 262                                 $self->md5pool( $new );
 263                         } else {
 264                                 $self->md5pool( $new );
 265                         }
 266                 }
 267                 print "INFO imported $imported files from ",dump($data);
 268         }
 269
 270         if ( $data->{md5} ne $empty_md5 ) {
 271                 $self->md5pool( $data );
 272         } else {
 273                 warn "empty md5", dump $data;
 274         }
 275 }
 276
 277 1;