diff options
Diffstat (limited to 'digitiz-xfer')
| -rwxr-xr-x | digitiz-xfer | 307 |
1 files changed, 307 insertions, 0 deletions
diff --git a/digitiz-xfer b/digitiz-xfer new file mode 100755 index 0000000..e5b79d3 --- /dev/null +++ b/digitiz-xfer @@ -0,0 +1,307 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( $source_directory $destination_host $destination_root + $lock_directory $archive_directory $failed_directory + $pid_file + $log_file $protocol $user $password + $mail_from @mail_to @mail_command + $date_format $time_format + ); #config +use vars qw ( $retry $retrytime $overwrite ); #per-process globals, yuck +use subs qw( daemonize archive failed movefile docopy logsuccess logfail + email datestamp _logmsg + ); +use Fcntl ':flock'; +use POSIX 'setsid'; +use IO::File; +use Date::Format; +use Mail::Mailer; +use Net::FTP; +use Net::SCP qw(scp); +use Digitiz_It::SKU; + +$SIG{__DIE__} = \&_die; +$SIG{__WARN__} = \&_logmsg; + +$SIG{CHLD} = 'IGNORE'; #zombie prevention + +my $sigterm = 0; +$SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $sigterm++; }; + +#require "/etc/digitiz-xfer.conf"; +require "/home/ivan/digitiz/digitiz-xfer.conf"; + +&daemonize; + +#main loop +while (1) { + opendir(DIR, $source_directory) + || die "can't opendir $source_directory: $!"; + while ( my $file = readdir DIR ) { + if ( $sigterm ) { + warn "parent process exiting (transfers in progress will finish)\n"; + exit; + } + next if $file =~ /^\.\.?/; + +# #locking foo +# my $file = $_; +# my $lock = new IO::File ">>$lock_directory/$file" +# or die "Couldn't open lockfile $lock_directory/$file: $!"; +# next unless flock($lock, LOCK_EX|LOCK_NB); +# unless ( -e "$source_directory/$file" ) { #make sure file's still here +# unlink "$lock_directory/$file"; +# flock($lock, LOCK_UN); +# next; +# } + + #fork a kid for the rest (can't be sure locks will get inherited - + # OS dependant) + + defined( my $pid = fork ) or die "can't fork: $!"; + unless ( $pid ) { + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + #locking foo, here instead + my $lock = new IO::File "+>>$lock_directory/$file" #touch + or die "Couldn't open lockfile $lock_directory/$file: $!"; + #next unless flock($lock, LOCK_EX|LOCK_NB); + exit unless flock($lock, LOCK_EX|LOCK_NB); + unless ( -e "$source_directory/$file" ) { #make sure file's still here + unlink "$lock_directory/$file"; + flock($lock, LOCK_UN); + #next; + exit; + } + + seek($lock, 0, 0); + chomp( $retry = <$lock> || 0 ); + chomp( $retrytime = <$lock> || 0 ); + chomp( $overwrite = <$lock> || 0 ); + + if ( $retrytime && (time-$retrytime)/3600 >= 48 ) { + logfail($file, "still can't transfer $file after 48 hours"); + failed($file); + } + #next if ($retry-1) > ((time-$retrytime)/3600); + exit if ($retry-1) > ((time-$retrytime)/3600); + + if ( $file =~ /^([\d\-]+)\.\w+$/ ) { + my $sku; + if ( $sku = new Digitiz_It::SKU $1 ) { + docopy($file, $sku); + } else { + logfail($file, "can't parse SKU: $1: $Digitiz_It::SKU::ERROR"); + failed($file); + } + } else { + logfail($file, "can't parse filename for SKU"); + failed($file); + } + + if ( $retry ) { + $retrytime ||= time; + #why doesn't this work? seek($lock, 0, 0); + my $newlock = new IO::File ">$lock_directory/$file.tmp"; + print $newlock "$retry\n$retrytime\n$overwrite\n"; + close $newlock; + rename "$lock_directory/$file.tmp", "$lock_directory/$file"; + } else { + unlink "$lock_directory/$file"; + } + flock($lock, LOCK_UN); + exit; + #end-of-kid + } + sleep 2; #don't spawn too fast! + + } #readdir + sleep 10; +} + +sub daemonize { + chdir "$source_directory" or die "Can't chdir to $source_directory: $!"; + open STDIN, '/dev/null' or die "Can't read /dev/null: $!"; +# open STDOUT, '>/dev/null' +# or die "Can't write to /dev/null: $!"; + defined(my $pid = fork) or die "Can't fork: $!"; + if ( $pid ) { + print "digitiz-xfer started with pid $pid; logging to $log_file\n"; + warn "digitiz-xfer parent started with pid $pid\n"; + exit unless $pid_file; + my $pidfh = new IO::File ">$pid_file" or exit; + print $pidfh "$pid\n"; + exit; + } + open STDOUT, '>/dev/null' + or die "Can't write to /dev/null: $!"; + setsid or die "Can't start a new session: $!"; + open STDERR, '>&STDOUT' or die "Can't dup stdout: $!"; +} + +sub archive { #archives a file + my ( $file ) = @_; + my $d = &datestamp(); + _logmsg("archiving $source_directory/$file in $archive_directory/$d/$file"); + movefile($file, "$archive_directory/$d" ); +} + +sub failed { #failed files + my( $file ) = @_; + _logmsg("moving $source_directory/$file to $failed_directory/$file"); + movefile($file, "$failed_directory"); +} + +sub movefile { + my( $file, $dir ) = @_; + -d $dir + or mkdir $dir, 04755 + or die "fatal: can't mkdir $dir: $!"; + rename "$source_directory/$file", "$dir/$file" + or die "fatal: cant't rename $source_directory/$file to $dir/$file: $!"; +} + +sub docopy { #copies a file to the remote host + my($file, $sku) = @_; + + my $xfer; + if ( $protocol eq 'scp' ) { + $xfer = Net::SCP->new($destination_host); + } elsif ( $protocol eq 'ftp' ) { + $xfer = Net::FTP->new($destination_host); + } else { + die "unknown transfer protocol $protocol"; + } + + unless ( $xfer ) { + if ( $retry ) { + logrepeatfail($file, "can't attempt transfer: $@"); + } else { + logfail($file, "can't attempt transfer: $@"); + } + $retry++; + return; + } + + $xfer->login($user, $password) or do { + if ( $retry ) { + logrepeatfail($file, "can't login"); + } else { + logfail($file, "can't login"); + } + $retry++; + return; + }; + + $xfer->binary or do { + if ( $retry ) { + logrepeatfail($file, "can't set binary mode"); + } else { + logfail($file, "can't set binary mode"); + } + }; + + my $dest_path = + "$destination_root/". $sku->account. '/'. $sku->library. '/'; + $dest_path .= 'Thumbnails/' if $sku->thumbnail; + + my $dest_file = $dest_path. $file; + + if ( $xfer->size($dest_file) && ! $overwrite ) { + logfail($file, "file $dest_file already exists on remote host"); + failed($file); + return; + } + + _logmsg("copying $source_directory/$file to ". + "$destination_host:$dest_file with $protocol"); + + $xfer->put("$source_directory/$file", $dest_file); + + my $localsize = -s "$source_directory/$file"; + my $remotesize = $xfer->size($dest_file); + + if ( $localsize == $remotesize ) { + logsuccess($file); + archive($file); + } else { + if ( $retry ) { + logrepeatfail($file, + "verification failed: local $localsize, remote $remotesize" + ); + } else { + logfail($file, + "verification failed: local $localsize, remote $remotesize" + ); + } + $retry++; + $overwrite = 1; + } + +} + +sub logsuccess { + my $file = shift; + warn "transfer of $file successful\n"; + email('Delivered','', $file); +} + +sub logfail { + my ($file, $err) = @_; + warn "[$file] $err\n"; + email('Error', $err, $file); +} + +sub logrepeatfail { + my ($file, $err) = @_; + warn "[$file] $err\n"; +} + +sub email { + my ( $status, $error, $file ) = @_; + my $mail = new Mail::Mailer @mail_command; + $mail->open( { + 'From' => $mail_from, + 'To' => [ @mail_to ], + 'Subject' => "$file transfer status", + } ); + my $now = time; + my $date = time2str($date_format, $now); + my $time = time2str($time_format, $now); + print $mail <<END; +Type: Status +Filename: $file +Date: $date +Time: $time +Status: $status +END + print $mail "Error: $error\n" if $error; + $mail->close; +} + +sub datestamp { + time2str("%m%d%Y", time); +} + +sub _die { + my $msg = shift; + email('Fatal', $msg, "Fatal"); + _logmsg($msg); +} + +sub _logmsg { + chomp( my $msg = shift ); + my $log = new IO::File ">>$log_file"; + flock($log, LOCK_EX); + seek($log, 0, 2); + print $log "[". time2str("%a %b %e %T %Y",time). "] [$$] $msg\n"; + flock($log, LOCK_UN); +} + |