gearman/send_file.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4
   5 use Data::Dump qw(dump);
   6 use File::Path qw(make_path remove_tree);
   7
   8 sub home_dir {
   9         my $login = shift;
  10         my ( undef, undef, $uid, $gid, undef, undef, $email, $dir, $shell ) = getpwnam $login;
  11         return $dir;
  12 }
  13
  14 use Gearman::Worker;
  15 my $worker = Gearman::Worker->new;
  16 $worker->job_servers('127.0.0.1:4730');
  17
  18 open(my $log, '>>', '/rsync1/s1/log/send_file.log');
  19 select($log); $|++;
  20
  21 $worker->register_function( send_file => sub {
  22         my ($job) = @_;
  23
  24         my $work = $job->arg;
  25         chomp $work;
  26         warn "# send_file [$work]\n";
  27
  28         my ( $from, $to ) = split(/#/,$work,2);
  29
  30         my $f_dir = home_dir($1) if $from =~ s/~(\w+)//;
  31         my $t_dir = home_dir($1) if $to   =~ s/~(\w+)//;
  32
  33         warn "send_file $f_dir $from -> $t_dir $to\n";
  34
  35         my $t_basedir = $t_dir . $to;
  36         $t_basedir =~ s{/[^/]+$}{};
  37         make_path $t_basedir unless -d $t_basedir;
  38         link $f_dir . $from => $t_dir . $to;
  39
  40         print "send#$work#", -s $t_dir.$to, "#$!\n";
  41
  42         die "ERROR: $!" if $!;
  43
  44         return "send_file $f_dir $from -> $t_dir $to";
  45 });
  46
  47 $worker->register_function( rename_file => sub {
  48         my ($job) = @_;
  49
  50         my $work = $job->arg;
  51         chomp $work;
  52         warn "# rename_file [$work]\n";
  53
  54         my ( $from, $to ) = split(/#/,$work,2);
  55
  56         my $dir = home_dir($1) if $from =~ s/~(\w+)//;
  57
  58         warn "rename_file $dir $from -> $to\n";
  59
  60         rename $dir . $from => $dir . $to;
  61
  62         print "rename#$work#", -s $dir.$to, "#$!\n";
  63
  64         die "ERROR: $!" if $!;
  65
  66         return "rename_file $dir $from -> $to";
  67 });
  68
  69 $worker->register_function( delete => sub {
  70         my ($job) = @_;
  71         my $work = $job->arg;
  72         chomp $work;
  73         warn "# delete [$work]\n";
  74
  75         my $dir = home_dir($1) if $work =~ s/~(\w+)//;
  76         my $login = $1;
  77         my $full = $dir . $work;
  78
  79         if ( -d $full ) {
  80                 print "delete_tree#$work\n";
  81                 warn "remove_tree $full\n";
  82                 remove_tree $full;
  83         } else {
  84                 print "delete_file#$work#", -s $full, "\n";
  85                 warn "unlink $full\n";
  86                 unlink $full;
  87         }
  88         if ( $! ) {
  89                 warn "ERROR: $!";
  90                 return "$full: $!\n";
  91         } else {
  92                 return "$full: OK\n";
  93         }
  94
  95 });
  96
  97 warn "$0 pid $$ waitng for jobs\n";
  98
  99 if ( $ENV{SLICE} ) {
 100         chroot $ENV{SLICE} || die "can't chroot $ENV{SLICE}: $!";
 101 } else {
 102         warn "WARNING: not running under chroot SLICE=/hostname/sx\n";
 103 }
 104
 105 $worker->work while 1;
 106