1 package CloudStore::Store;
7 use File::Path qw(make_path);
9 use Digest::MD5 qw(md5_base64);
10 use Data::Dump qw(dump);
22 die "no dir" unless $self->{dir};
23 $self->{md5pool} = $self->{dir} . '/md5';
25 warn "# new ",dump $self if $ENV{DEBUG};
31 my ( $self,$data ) = @_;
35 my ( $self,$data ) = @_;
39 my ( $self,$data ) = @_;
41 if ( $data->{file} =~ m{^(.*/).sync/send/([^/]+)$} ) {
43 warn "SEND $2 from $from_dir";
45 open(my $send, '<', $self->blob_path($data) );
49 my ( $to, $file ) = split(/\s+/,$_,2);
50 my ( undef, undef, $uid, $gid, undef, undef, $email, $dir, $shell ) =
54 $from->{file} = $from_dir . $file;
55 my $from_path = $self->blob_path($from);
57 if ( ! -r $from_path ) {
58 warn "ERROR: $from_path: $!";
62 my $to_path = "$dir/received/$file";
63 my $to_dir = $to_path;
64 $to_dir =~ s{/[^/]+$}{};
65 mkdir $to_dir unless -e $to_dir;
67 warn "SEND $from_path -> $to_path";
68 $sent_files->{$to} += link $from_path, $to_path;
72 warn "SENT ",dump $sent_files;
74 return 0; # skip dedup
77 #return $file->{size} > 4096 ? 1 : 0; # FIXME
81 # never called by rsync directly!
83 my ( $self,$data ) = @_;
84 # $self->file_set($data);
88 my ( $self, $data ) = @_;
90 my $md5sum = $self->md5sum($data);
91 my $md5 = $md5sum->{ $data->{file} } || return; # directories don't have md5sums
92 my $path = $self->{md5pool} . '/' . $md5;
93 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
94 $atime,$mtime,$ctime,$blksize,$blocks)
97 my $id = getpwnam 'md5';
98 chown $id,$gid, $path;
99 warn "# chown $id $gid $path";
104 my ( $self, $data ) = @_;
109 my ( $self, $data ) = @_;
111 warn "# new_link ",dump $data;
113 if ( $data->{file} =~ m{^(.*/?)\.send/([^/]+)/(.+)$} ) {
114 my ( $dir, $to, $name ) = ( $1, $2, $3 );
115 my $path = $self->blob_path($data);
116 my $link_to = readlink $path;
118 if ( $link_to =~ s{^\Q/rsyncd-munged/\E}{/} ) {
121 $s =~ s{/[^/]+$}{}; # strip filename
122 while ( $link_to =~ s{/../}{/} ) {
123 $s =~ s{/[^/]+$}{} || die "can't strip $s";
124 warn "## simplify $s $link_to\n";
128 my $d = $self->blob_path({
133 # $name can contain directories so we must create them
135 $to_dir =~ s{/[^/]+$}{};
136 make_path $to_dir if ! -e $to_dir;
139 warn "ERROR: can't find source $s";
142 warn "link $s -> $d\n";
145 my ($l,$f) = ($1,$2) if $s =~ m{users/([^/]+)/blob/(.+)};
147 # my $origin = $self->file_get({
151 # $self->new_file($origin);
152 warn "INFO: sent file ",dump($l,$f);
153 my $md5sum = $self->md5sum($data);
155 my $md5 = $md5sum->{$s} || die "no md5 for $s";
156 $md5sum->{$d} = $md5; # FIXME broken!
161 warn "ERROR: can't SEND To:$to Name:$name Link:$link_to";
168 my ( $self, $data ) = @_;
170 if ( exists $md5_login->{$data->{login}} ) {
171 return $md5_login->{$data->{login}};
172 } elsif ( my $login = $data->{login} ) {
174 my $md5_path = $self->{dir} || die "no dir?";
176 $md5_path .= "/$login/.md5.db";
179 my $db = tie %md5, 'BerkeleyDB::Hash',
180 -Filename => $md5_path,
184 return $md5_login->{$login} = \%md5;
186 confess "can't open md5sum";
191 my ( $self, $data ) = @_;
192 if ( $data =~ m/\[(\d+)\] rsync \w+ (\S+) \w+ (\S+)/ ) {
193 my ( $pid, $module, $login ) = ( $1, $2, $3 );
196 my ( undef, undef, $uid, $gid, undef, undef, $email, $dir, $shell ) =
199 $self->{pid}->{$pid} = {
210 } elsif ( $data =~ m/\[(\d+)\] sent \S+ bytes\s+received \S+ bytes/ ) {
212 untie $md5_login->{ $self->{$pid}->{login} } && warn "untie $pid";
213 delete $self->{pid}->{$pid};
216 # warn "## rsync_log $data";
221 my ( $self, $data ) = @_;
222 my $blob = $self->{pid}->{ $data->{pid} }->{dir} || die "no dir for $data->{pid} in ",dump( $self->{pid} );
223 $blob .= '/' . $data->{file};
229 my ( $self,$data ) = @_;
231 my $path = $self->blob_path($data);
233 if ( $data->{itemize} =~ m/^[c>]([fdL])/ ) { # received change/create
236 if ( $type eq 'f' ) {
237 $self->modify_file( $data ) && # selective dedup
238 $self->dedup( $data, $path );
239 } elsif ( $type eq 'd' ) {
240 $self->make_dir( $data );
241 } elsif ( $type eq 'L' ) {
242 $self->new_link( $data );
244 die "unknown type $type ", dump $data;
246 } elsif ( $data->{itemize} =~ m/\*deleting/ ) {
247 $self->remove_file($data);
253 my ( $self, $data ) = @_;
255 my $pool = $self->{md5pool} || die "no md5pool in ",dump $self;
256 mkdir $pool unless -e $pool;
258 my $md5 = $data->{md5} || die "no md5 in ",dump $data;
259 my $path = $self->blob_path($data);
261 if ( -e "$pool/$md5" ) {
262 warn "dedup hit $md5 $path\n";
263 my $dedup = $path . '.dedup';
264 rename $path, $dedup;
265 link "$pool/$md5", $path;
269 link $path, "$pool/$md5";
272 my $md5sum = $self->md5sum($data);
273 $md5sum->{ $data->{file} } = $md5;
276 my $empty_md5 = " " x 32;
279 my ( $self, $data, $path ) = @_;
281 if ( $data->{file} =~ /^(.+\/)?md5sum$/ ) {
284 warn "IMPORT ", $data->{file}, "\n";
285 open(my $md5sum, '<', $path);
288 my ( $md5, $file ) = split(/\s+/,$_,2);
289 if ( ! -e "$self->{md5path}/$md5" ) {
290 warn "MISSING $md5 $file\n";
298 my $new_path = $self->blob_path($new);
299 if ( ! -e $new_path ) {
300 # create path from md5sum file
301 my $only_dir = $1 if $new =~ m{^(.+)/[^/]+$};
302 make_path $only_dir unless -d $only_dir;
303 $imported += link "$self->{md5path}/$md5", $new_path;
304 $self->new_file($new);
305 warn "import from $path ",dump($new);
306 $self->md5pool( $new );
308 $self->md5pool( $new );
311 print "INFO imported $imported files from ",dump($data);
314 if ( $data->{md5} ne $empty_md5 ) {
315 $self->md5pool( $data );
317 warn "empty md5", dump $data;