use LWP::Simple;
use Carp qw(confess);
+use WarnColor;
+
my $buckets = {
users => 5800,
files => 5801,
my $port = $buckets->{$bucket};
my $server = new Cache::Memcached {
'servers' => [ "127.0.0.1:$port" ],
- 'debug' => $ENV{DEBUG},
+ 'debug' => defined $ENV{DEBUG} && $ENV{DEBUG} > 3,
# 'compress_threshold' => 10_000,
};
#$server->set_servers($array_ref);
confess "data not ref ",dump($data) unless ref $data;
my $json = encode_json $data;
$self->{$bucket}->set( $key => $json );
- warn "## $bucket set $key $json\n";
+ warn "## json_set $bucket $key $json\n";
return $json;
}
sub json_get {
my ($self,$bucket,$key,$data) = @_;
if ( my $json = $self->{$bucket}->get($key) ) {
- warn "## $bucket get $key $json\n";
+ warn "## json_get $bucket $key $json\n";
return decode_json $json;
}
}
$login = $login->{login} if ref $login;
if ( $message ) {
$self->{session}->set( "$login:status" => $message );
+ return $message;
} else {
$self->{session}->get( "$login:status" );
}
if ( $data->{file} =~ m{^(.*/?)\.send/([^/]+)/(.+)$} ) {
my ( $dir, $to, $name ) = ( $1, $2, $3 );
my $path = "users/$data->{login}/blob/" . $data->{file};
- my $file = readlink $path;
- warn "## $path -> $file";
- if ( $file =~ s{^\Q/rsyncd-munged/../../\E}{$dir} ) {
- warn "SEND To:$to Name:$name File:$file\n";
- my $s = "users/$data->{login}/blob/$file";
+ my $link_to = readlink $path;
+ warn "$link_to";
+ if ( $link_to =~ s{^\Q/rsyncd-munged/\E}{/} ) {
+
+ my $s = $path;
+ $s =~ s{/[^/]+$}{}; # strip filename
+ while ( $link_to =~ s{/../}{/} ) {
+ $s =~ s{/[^/]+$}{} || die "can't strip $s";
+ warn "## simplify $s $link_to\n";
+ }
+ $s .= $link_to;
+
my $d = "users/$to/blob";
- die "no user $to" unless -e $d;
+ if ( ! -e $d ) {
+ warn "ERROR: no to user $to in $d";
+ return;
+ }
$d .= "/$name";
- # since $name can contain directories we must create them
+ # $name can contain directories so we must create them
my $to_dir = $d;
$to_dir =~ s{/[^/]+$}{};
make_path $to_dir if ! -e $to_dir;
- warn "link $s -> $d\n";
- link $s, $d;
+ if ( ! -e $s ) {
+ warn "ERROR: can't find source $s";
+ } else {
+
+ warn "link $s -> $d\n";
+ link $s, $d;
+
+ my ($l,$f) = ($1,$2) if $s =~ m{users/([^/]+)/blob/(.+)};
+
+ my $origin = $self->file_get({
+ login => $l,
+ file => $f,
+ });
+ $self->new_file($origin);
+ warn "INFO: sent file ",dump($origin);
+ }
+
+
} else {
- warn "ERROR: can't SEND To:$to Name:$name File:$file";
+ warn "ERROR: can't SEND To:$to Name:$name Link:$link_to";
}
}
}
size => -s $new,
};
$self->new_file($fake);
- warn "fake ",dump($fake);
+ warn "import from $path ",dump($fake);
} else {
md5pool $new => $md5;
}