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 ( my $old = $self->file_get( $data ) ) {
42 # $self->usage_decr( $data );
45 $self->new_file($data);
49 my ( $self,$data ) = @_;
50 # $self->file_set($data);
51 # $self->usage_incr($data);
55 my ( $self, $data ) = @_;
56 # $self->usage_decr( $data );
60 my ( $self, $data ) = @_;
65 my ( $self, $data ) = @_;
67 warn "# new_link ",dump $data;
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;
74 if ( $link_to =~ s{^\Q/rsyncd-munged/\E}{/} ) {
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";
84 my $d = $self->blob_path({
89 # $name can contain directories so we must create them
91 $to_dir =~ s{/[^/]+$}{};
92 make_path $to_dir if ! -e $to_dir;
95 warn "ERROR: can't find source $s";
98 warn "link $s -> $d\n";
101 my ($l,$f) = ($1,$2) if $s =~ m{users/([^/]+)/blob/(.+)};
103 # my $origin = $self->file_get({
107 # $self->new_file($origin);
108 warn "INFO: sent file ",dump($l,$f);
109 # my $md5 = $self->{md5}->{$s} || die "no md5 for $s";
110 # $self->{md5}->{$d} = $md5;
115 warn "ERROR: can't SEND To:$to Name:$name Link:$link_to";
121 my ( $self, $data ) = @_;
122 if ( $data =~ m/\[(\d+)\] rsync \w+ (\S+) \w+ (\S+)/ ) {
123 my ( $pid, $module, $login ) = ( $1, $2, $3 );
125 my ( undef, undef, $uid, $gid, undef, undef, $email, $dir, $shell ) =
129 my $db = tie %md5, 'BerkeleyDB::Hash',
130 -Filename => "$dir/.md5.db",
134 $self->{pid}->{$pid} = {
144 } elsif ( $data =~ m/\[(\d+)\] sent \d+ bytes\s+received \d+ bytes/ ) {
146 untie $self->{pid}->{$pid}->{md5} && warn "md5 hash untied";
147 warn "removed ", dump
148 delete $self->{pid}->{$pid};
150 warn "## rsync_log $data";
155 my ( $self, $data ) = @_;
156 my $blob = $self->{pid}->{ $data->{pid} }->{dir} || die "no dir for $data->{pid} in ",dump( $self->{pid} );
157 $blob .= '/' . $data->{file};
163 my ( $self,$data ) = @_;
165 my $path = $self->blob_path($data);
167 if ( $data->{itemize} =~ m/^[c>]([fdL])/ ) { # received change/create
170 if ( $type eq 'f' ) {
171 $self->modify_file( $data );
172 $self->dedup( $data, $path );
173 } elsif ( $type eq 'd' ) {
174 $self->make_dir( $data );
175 } elsif ( $type eq 'L' ) {
176 $self->new_link( $data );
178 die "unknown type $type ", dump $data;
180 } elsif ( $data->{itemize} =~ m/\*deleting/ ) {
181 $self->remove_file($data);
187 my ( $self, $data ) = @_;
189 my $pool = $self->{md5pool} || die "no md5pool in ",dump $self;
190 mkdir $pool unless -e $pool;
192 my $md5 = $data->{md5} || die "no md5 in ",dump $data;
193 my $path = $self->blob_path($data);
195 if ( -e "$pool/$md5" ) {
196 warn "dedup hit $md5 $path\n";
197 my $dedup = $path . '.dedup';
198 rename $path, $dedup;
199 link "$pool/$md5", $path;
203 link $path, "$pool/$md5";
206 my $md5hash = $self->{pid}->{ $data->{pid} }->{md5} || die "no md5 for $data->{pid} in ",dump( $self->{pid} );
207 $md5hash->{ $data->{file} } = $md5;
210 my $empty_md5 = " " x 32;
213 my ( $self, $data, $path ) = @_;
215 if ( $data->{file} =~ /^(.+\/)?md5sum$/ ) {
218 warn "IMPORT ", $data->{file}, "\n";
219 open(my $md5sum, '<', $path);
222 my ( $md5, $file ) = split(/\s+/,$_,2);
223 if ( ! -e "$self->{md5path}/$md5" ) {
224 warn "MISSING $md5 $file\n";
232 my $new_path = $self->blob_path($new);
233 if ( ! -e $new_path ) {
234 # create path from md5sum file
235 my $only_dir = $1 if $new =~ m{^(.+)/[^/]+$};
236 make_path $only_dir unless -d $only_dir;
237 $imported += link "$self->{md5path}/$md5", $new_path;
238 $self->new_file($new);
239 warn "import from $path ",dump($new);
240 $self->md5pool( $new );
242 $self->md5pool( $new );
245 print "INFO imported $imported files from ",dump($data);
248 if ( $data->{md5} ne $empty_md5 ) {
249 $self->md5pool( $data );
251 warn "empty md5", dump $data;