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         unlink "$lock_directory/$file";
  94         exit;
  95       }
  96       #next if ($retry-1) > ((time-$retrytime)/3600);
  97       exit if ($retry-1) > ((time-$retrytime)/3600);
  98
  99       if ( $file =~ /^([\d\-]+)\.\w+$/ ) {
 100         my $sku;
 101         if ( $sku = new Digitiz_It::SKU $1 ) {
 102           docopy($file, $sku);
 103         } else {
 104           logfail($file, "can't parse SKU: $1: $Digitiz_It::SKU::ERROR");
 105           failed($file);
 106         }
 107       } else {
 108         logfail($file, "can't parse filename for SKU");
 109         failed($file);
 110       }
 111
 112       if ( $retry ) {
 113         $retrytime ||= time;
 114         #why doesn't this work? seek($lock, 0, 0);
 115         my $newlock = new IO::File ">$lock_directory/$file.tmp";
 116         print $newlock "$retry\n$retrytime\n$overwrite\n";
 117         close $newlock;
 118         rename "$lock_directory/$file.tmp", "$lock_directory/$file";
 119       } else {
 120         unlink "$lock_directory/$file";
 121       }
 122       flock($lock, LOCK_UN);
 123       exit;
 124       #end-of-kid
 125     }
 126     sleep 2; #don't spawn too fast!
 127
 128   } #readdir
 129   sleep 10;
 130 }
 131
 132 sub daemonize {
 133     chdir "$source_directory" or die "Can't chdir to $source_directory: $!";
 134     open STDIN, '/dev/null'   or die "Can't read /dev/null: $!";
 135 #    open STDOUT, '>/dev/null'
 136 #                              or die "Can't write to /dev/null: $!";
 137     defined(my $pid = fork) or die "Can't fork: $!";
 138     if ( $pid ) {
 139       print "digitiz-xfer started with pid $pid; logging to $log_file\n";
 140       warn "digitiz-xfer parent started with pid $pid\n";
 141       exit unless $pid_file;
 142       my $pidfh = new IO::File ">$pid_file" or exit;
 143       print $pidfh "$pid\n";
 144       exit;
 145     }
 146     open STDOUT, '>/dev/null'
 147                               or die "Can't write to /dev/null: $!";
 148     setsid                  or die "Can't start a new session: $!";
 149     open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
 150 }
 151
 152 sub archive { #archives a file
 153   my ( $file ) = @_;
 154   my $d = &datestamp();
 155   _logmsg("archiving $source_directory/$file in $archive_directory/$d/$file");
 156   movefile($file, "$archive_directory/$d" );
 157 }
 158
 159 sub failed { #failed files
 160   my( $file ) = @_;
 161   _logmsg("moving $source_directory/$file to $failed_directory/$file");
 162   movefile($file, "$failed_directory");
 163 }
 164
 165 sub movefile {
 166   my( $file, $dir ) = @_;
 167   -d $dir
 168     or mkdir $dir, 04755
 169       or die "fatal: can't mkdir $dir: $!";
 170   rename "$source_directory/$file", "$dir/$file"
 171     or die "fatal: cant't rename $source_directory/$file to $dir/$file: $!";
 172 }
 173
 174 sub docopy { #copies a file to the remote host
 175   my($file, $sku) = @_;
 176
 177   my $xfer;
 178   if ( $protocol eq 'scp' ) {
 179     $xfer = Net::SCP->new($destination_host);
 180   } elsif ( $protocol eq 'ftp' ) {
 181     $xfer = Net::FTP->new($destination_host);
 182   } else {
 183     die "unknown transfer protocol $protocol";
 184   }
 185
 186   unless ( $xfer ) {
 187     if ( $retry ) {
 188       logrepeatfail($file, "can't attempt transfer: $@");
 189     } else {
 190       logfail($file, "can't attempt transfer: $@");
 191     }
 192     $retry++;
 193     return;
 194   }
 195
 196   $xfer->login($user, $password) or do {
 197     if ( $retry ) {
 198       logrepeatfail($file, "can't login");
 199     } else {
 200       logfail($file, "can't login");
 201     }
 202     $retry++;
 203     return;
 204   };
 205
 206   $xfer->binary or do {
 207     if ( $retry ) {
 208       logrepeatfail($file, "can't set binary mode");
 209     } else {
 210       logfail($file, "can't set binary mode");
 211     }
 212   };
 213
 214   my $dest_path =
 215     "$destination_root/". $sku->account. '/'. $sku->library. '/';
 216   $dest_path .= 'Thumbnails/' if $sku->thumbnail;
 217
 218   my $dest_file = $dest_path. $file;
 219
 220   if ( $xfer->size($dest_file) && ! $overwrite ) {
 221     logfail($file, "file $dest_file already exists on remote host");
 222     failed($file);
 223     return;
 224   }
 225
 226   _logmsg("copying $source_directory/$file to ".
 227           "$destination_host:$dest_file with $protocol");
 228
 229   #so close
 230   if ( $protocol eq 'ftp' ) { #so close
 231     $xfer->cwd(dirname($dest_file));
 232     $dest_file = basename($dest_file);
 233   }
 234   $xfer->put("$source_directory/$file", $dest_file);
 235
 236   my $localsize = -s "$source_directory/$file";
 237   my $remotesize = $xfer->size($dest_file);
 238
 239   if ( $localsize && ( $localsize == $remotesize ) ) {
 240     logsuccess($file);
 241     archive($file);
 242   } else {
 243     if ( $retry ) {
 244       logrepeatfail($file,
 245         "verification failed: local $localsize, remote $remotesize"
 246       );
 247     } else {
 248       logfail($file,
 249         "verification failed: local $localsize, remote $remotesize"
 250       );
 251     }
 252     $retry++;
 253     $overwrite = 1;
 254   }
 255
 256 }
 257
 258 sub logsuccess {
 259   my $file = shift;
 260   warn "transfer of $file successful\n";
 261   email('Delivered','', $file);
 262 }
 263
 264 sub logfail {
 265   my ($file, $err) = @_;
 266   warn "[$file] $err\n";
 267   email('Error', $err, $file);
 268 }
 269
 270 sub logrepeatfail {
 271   my ($file, $err) = @_;
 272   warn "[$file] $err\n";
 273 }
 274
 275 sub email {
 276   my ( $status, $error, $file ) = @_;
 277   my $mail = new Mail::Mailer @mail_command;
 278   $mail->open( {
 279     'From'    => $mail_from,
 280     'To'      => [ @mail_to ],
 281     'Subject' => "$file transfer status",
 282   } );
 283   my $now = time;
 284   my $date = time2str($date_format, $now);
 285   my $time = time2str($time_format, $now);
 286   print $mail <<END;
 287 Type: Status
 288 Filename: $file
 289 Date: $date
 290 Time: $time
 291 Status: $status
 292 END
 293   print $mail "Error: $error\n" if $error;
 294   $mail->close;
 295 }
 296
 297 sub datestamp {
 298   time2str("%m%d%Y", time);
 299 }
 300
 301 sub _die {
 302   my $msg = shift;
 303   email('Fatal', $msg, "Fatal");
 304   _logmsg($msg);
 305 }
 306
 307 sub _logmsg {
 308   chomp( my $msg = shift );
 309   my $log = new IO::File ">>$log_file";
 310   flock($log, LOCK_EX);
 311   seek($log, 0, 2);
 312   print $log "[". time2str("%a %b %e %T %Y",time). "] [$$] $msg\n";
 313   flock($log, LOCK_UN);
 314 }
 315