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