digitiz-xfer

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use vars qw( $source_directory $destination_host $destination_root
   5              $lock_directory $archive_directory $failed_directory
   6              $pid_file
   7              $log_file $protocol $user $password
   8              $mail_from @mail_to @mail_command
   9              $date_format $time_format
  10            ); #config
  11 use vars qw ( $retry $retrytime $overwrite ); #per-process globals, yuck
  12 use subs qw( daemonize archive failed movefile docopy logsuccess logfail
  13              email datestamp _logmsg
  14            );
  15 use Fcntl ':flock';
  16 use POSIX 'setsid';
  17 use IO::File;
  18 use Date::Format;
  19 use Mail::Mailer;
  20 use Net::FTP;
  21 use Net::SCP qw(scp);
  22 use Digitiz_It::SKU;
  23
  24 $SIG{__DIE__} = \&_die;
  25 $SIG{__WARN__} = \&_logmsg;
  26
  27 $SIG{CHLD} = 'IGNORE'; #zombie prevention
  28
  29 my $sigterm = 0;
  30 $SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $sigterm++; };
  31
  32 #require "/etc/digitiz-xfer.conf";
  33 require "/home/ivan/digitiz/digitiz-xfer.conf";
  34
  35 &daemonize;
  36
  37 #main loop
  38 while (1) {
  39   opendir(DIR, $source_directory)
  40     || die "can't opendir $source_directory: $!";
  41   while ( my $file = readdir DIR ) {
  42     if ( $sigterm ) {
  43       warn "parent process exiting (transfers in progress will finish)\n";
  44       exit;
  45     }
  46     next if $file =~ /^\.\.?/;
  47
  48 #    #locking foo
  49 #    my $file = $_;
  50 #    my $lock = new IO::File ">>$lock_directory/$file"
  51 #      or die "Couldn't open lockfile $lock_directory/$file: $!";
  52 #    next unless flock($lock, LOCK_EX|LOCK_NB);
  53 #    unless ( -e "$source_directory/$file" ) { #make sure file's still here
  54 #      unlink "$lock_directory/$file";
  55 #      flock($lock, LOCK_UN);
  56 #      next;
  57 #    }
  58
  59     #fork a kid for the rest (can't be sure locks will get inherited -
  60     # OS dependant)
  61
  62     defined( my $pid = fork ) or die "can't fork: $!";
  63     unless ( $pid ) {
  64
  65       local $SIG{HUP} = 'IGNORE';
  66       local $SIG{INT} = 'IGNORE';
  67       local $SIG{QUIT} = 'IGNORE';
  68       local $SIG{TERM} = 'IGNORE';
  69       local $SIG{TSTP} = 'IGNORE';
  70       local $SIG{PIPE} = 'IGNORE';
  71
  72       #locking foo, here instead
  73       my $lock = new IO::File "+>>$lock_directory/$file" #touch
  74         or die "Couldn't open lockfile $lock_directory/$file: $!";
  75       #next unless flock($lock, LOCK_EX|LOCK_NB);
  76       exit unless flock($lock, LOCK_EX|LOCK_NB);
  77       unless ( -e "$source_directory/$file" ) { #make sure file's still here
  78         unlink "$lock_directory/$file";
  79         flock($lock, LOCK_UN);
  80         #next;
  81         exit;
  82       }
  83
  84       seek($lock, 0, 0);
  85       chomp( $retry     = <$lock> || 0 );
  86       chomp( $retrytime = <$lock> || 0 );
  87       chomp( $overwrite = <$lock> || 0 );
  88
  89       if ( $retrytime && (time-$retrytime)/3600 >= 48 ) {
  90         logfail($file, "still can't transfer $file after 48 hours");
  91         failed($file);
  92       }
  93       #next if ($retry-1) > ((time-$retrytime)/3600);
  94       exit if ($retry-1) > ((time-$retrytime)/3600);
  95
  96       if ( $file =~ /^([\d\-]+)\.\w+$/ ) {
  97         my $sku;
  98         if ( $sku = new Digitiz_It::SKU $1 ) {
  99           docopy($file, $sku);
 100         } else {
 101           logfail($file, "can't parse SKU: $1: $Digitiz_It::SKU::ERROR");
 102           failed($file);
 103         }
 104       } else {
 105         logfail($file, "can't parse filename for SKU");
 106         failed($file);
 107       }
 108
 109       if ( $retry ) {
 110         $retrytime ||= time;
 111         #why doesn't this work? seek($lock, 0, 0);
 112         my $newlock = new IO::File ">$lock_directory/$file.tmp";
 113         print $newlock "$retry\n$retrytime\n$overwrite\n";
 114         close $newlock;
 115         rename "$lock_directory/$file.tmp", "$lock_directory/$file";
 116       } else {
 117         unlink "$lock_directory/$file";
 118       }
 119       flock($lock, LOCK_UN);
 120       exit;
 121       #end-of-kid
 122     }
 123     sleep 2; #don't spawn too fast!
 124
 125   } #readdir
 126   sleep 10;
 127 }
 128
 129 sub daemonize {
 130     chdir "$source_directory" or die "Can't chdir to $source_directory: $!";
 131     open STDIN, '/dev/null'   or die "Can't read /dev/null: $!";
 132 #    open STDOUT, '>/dev/null'
 133 #                              or die "Can't write to /dev/null: $!";
 134     defined(my $pid = fork) or die "Can't fork: $!";
 135     if ( $pid ) {
 136       print "digitiz-xfer started with pid $pid; logging to $log_file\n";
 137       warn "digitiz-xfer parent started with pid $pid\n";
 138       exit unless $pid_file;
 139       my $pidfh = new IO::File ">$pid_file" or exit;
 140       print $pidfh "$pid\n";
 141       exit;
 142     }
 143     open STDOUT, '>/dev/null'
 144                               or die "Can't write to /dev/null: $!";
 145     setsid                  or die "Can't start a new session: $!";
 146     open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
 147 }
 148
 149 sub archive { #archives a file
 150   my ( $file ) = @_;
 151   my $d = &datestamp();
 152   _logmsg("archiving $source_directory/$file in $archive_directory/$d/$file");
 153   movefile($file, "$archive_directory/$d" );
 154 }
 155
 156 sub failed { #failed files
 157   my( $file ) = @_;
 158   _logmsg("moving $source_directory/$file to $failed_directory/$file");
 159   movefile($file, "$failed_directory");
 160 }
 161
 162 sub movefile {
 163   my( $file, $dir ) = @_;
 164   -d $dir
 165     or mkdir $dir, 04755
 166       or die "fatal: can't mkdir $dir: $!";
 167   rename "$source_directory/$file", "$dir/$file"
 168     or die "fatal: cant't rename $source_directory/$file to $dir/$file: $!";
 169 }
 170
 171 sub docopy { #copies a file to the remote host
 172   my($file, $sku) = @_;
 173
 174   my $xfer;
 175   if ( $protocol eq 'scp' ) {
 176     $xfer = Net::SCP->new($destination_host);
 177   } elsif ( $protocol eq 'ftp' ) {
 178     $xfer = Net::FTP->new($destination_host);
 179   } else {
 180     die "unknown transfer protocol $protocol";
 181   }
 182
 183   unless ( $xfer ) {
 184     if ( $retry ) {
 185       logrepeatfail($file, "can't attempt transfer: $@");
 186     } else {
 187       logfail($file, "can't attempt transfer: $@");
 188     }
 189     $retry++;
 190     return;
 191   }
 192
 193   $xfer->login($user, $password) or do {
 194     if ( $retry ) {
 195       logrepeatfail($file, "can't login");
 196     } else {
 197       logfail($file, "can't login");
 198     }
 199     $retry++;
 200     return;
 201   };
 202
 203   $xfer->binary or do {
 204     if ( $retry ) {
 205       logrepeatfail($file, "can't set binary mode");
 206     } else {
 207       logfail($file, "can't set binary mode");
 208     }
 209   };
 210
 211   my $dest_path =
 212     "$destination_root/". $sku->account. '/'. $sku->library. '/';
 213   $dest_path .= 'Thumbnails/' if $sku->thumbnail;
 214
 215   my $dest_file = $dest_path. $file;
 216
 217   if ( $xfer->size($dest_file) && ! $overwrite ) {
 218     logfail($file, "file $dest_file already exists on remote host");
 219     failed($file);
 220     return;
 221   }
 222
 223   _logmsg("copying $source_directory/$file to ".
 224           "$destination_host:$dest_file with $protocol");
 225
 226   $xfer->put("$source_directory/$file", $dest_file);
 227
 228   my $localsize = -s "$source_directory/$file";
 229   my $remotesize = $xfer->size($dest_file);
 230
 231   if ( $localsize == $remotesize ) {
 232     logsuccess($file);
 233     archive($file);
 234   } else {
 235     if ( $retry ) {
 236       logrepeatfail($file,
 237         "verification failed: local $localsize, remote $remotesize"
 238       );
 239     } else {
 240       logfail($file,
 241         "verification failed: local $localsize, remote $remotesize"
 242       );
 243     }
 244     $retry++;
 245     $overwrite = 1;
 246   }
 247
 248 }
 249
 250 sub logsuccess {
 251   my $file = shift;
 252   warn "transfer of $file successful\n";
 253   email('Delivered','', $file);
 254 }
 255
 256 sub logfail {
 257   my ($file, $err) = @_;
 258   warn "[$file] $err\n";
 259   email('Error', $err, $file);
 260 }
 261
 262 sub logrepeatfail {
 263   my ($file, $err) = @_;
 264   warn "[$file] $err\n";
 265 }
 266
 267 sub email {
 268   my ( $status, $error, $file ) = @_;
 269   my $mail = new Mail::Mailer @mail_command;
 270   $mail->open( {
 271     'From'    => $mail_from,
 272     'To'      => [ @mail_to ],
 273     'Subject' => "$file transfer status",
 274   } );
 275   my $now = time;
 276   my $date = time2str($date_format, $now);
 277   my $time = time2str($time_format, $now);
 278   print $mail <<END;
 279 Type: Status
 280 Filename: $file
 281 Date: $date
 282 Time: $time
 283 Status: $status
 284 END
 285   print $mail "Error: $error\n" if $error;
 286   $mail->close;
 287 }
 288
 289 sub datestamp {
 290   time2str("%m%d%Y", time);
 291 }
 292
 293 sub _die {
 294   my $msg = shift;
 295   email('Fatal', $msg, "Fatal");
 296   _logmsg($msg);
 297 }
 298
 299 sub _logmsg {
 300   chomp( my $msg = shift );
 301   my $log = new IO::File ">>$log_file";
 302   flock($log, LOCK_EX);
 303   seek($log, 0, 2);
 304   print $log "[". time2str("%a %b %e %T %Y",time). "] [$$] $msg\n";
 305   flock($log, LOCK_UN);
 306 }
 307