10 use Data::Dump qw(dump);
14 my $dir = '/srv/cloudstore/var';
15 my $log_fifo = "$dir/rsyncd.log";
16 my $pid_file = "$dir/rsyncd.pid";
17 my $cfg_file = "$dir/rsyncd.conf";
20 mkdir $dir if ! -e $dir;
22 mkfifo $log_fifo, 0700 unless -p $log_fifo;
40 my $rsync_config = qq{
48 lock file = $dir/rsyncd.lock
50 #syslog facility = local5
53 transfer logging = yes
54 log format = transfer-log:} . join('|',values %$transfer_log) . qq{
59 # don't check secrets file permission (uid)
62 pre-xfer exec = /srv/cloudstore/pre-xfer.sh
63 post-xfer exec = /srv/cloudstore/post-xfer.sh
66 path = /srv/cloudstore/users/dpavlin/blob
68 secrets file = /srv/cloudstore/secrets/dpavlin
73 write_file $cfg_file, $rsync_config;
74 warn "created $cfg_file ", -s $cfg_file, " bytes\n";
77 my $pid = read_file $pid_file;
80 warn "found rsync pid $pid";
86 if ( ! -e $pid_file ) {
87 my $exec = "rsync --daemon --config $cfg_file --no-detach --port=6501";
90 die "could not fork\n" unless defined(my $pid = fork);
92 warn "start server with $exec\n";
96 warn "wait for pid file";
97 while ( ! -e $pid_file ) {
104 my $client = Gearman::Client->new;
105 $client->job_servers('127.0.0.1:4730');
108 warn "# reading log output from $log_fifo\n";
109 open(my $log, '<', $log_fifo);
110 while( my $line = <$log> ) {
112 if ( $line =~ /transfer-log:(.+\|.+)/ ) {
114 my @k = keys %$transfer_log;
115 my @v = split(/\|/,$1);
116 @data{@k} = @v ; # FIXME validate?
119 $data{mtime} =~ s|^(\d\d\d\d)/(\d\d)/(\d\d)-(\d\d:\d\d:\d\d)|$1-$2-$3 $4| && warn "fixed mtime ISO $data{mtime}\n";
121 print "transfer-log:",dump(\%data),$/;
123 my $json = encode_json \%data;
125 my $path = sprintf "users/%s/data/%.5f-%d",
126 $data{login}, Time::HiRes::time(), $data{pid};
127 open(my $fh, '>', $path);
130 print $path, " ", -s $path, " bytes\n";
132 $client->dispatch_background( 'log' => $json );