From d72ca1a8a0f612a09077266f510bc53642d1513a Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 26 Aug 2000 06:01:05 +0000 Subject: [PATCH 1/1] import --- README | 33 ++++++ digitiz-xfer | 307 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ digitiz-xfer.conf | 53 ++++++++++ 3 files changed, 393 insertions(+) create mode 100644 README create mode 100755 digitiz-xfer create mode 100644 digitiz-xfer.conf diff --git a/README b/README new file mode 100644 index 0000000..56774b8 --- /dev/null +++ b/README @@ -0,0 +1,33 @@ +digitiz-xfer package + +Copyright (c) 2000 Ivan Kohler +Copyright (c) 2000 Digitiz-it! +All rights reserved. +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +Installation instructions: + +Install Mail::Mailer, Date::Format, Net::FTP and String::ShellQuote from CPAN. +Install Net::SSH, Net::SCP and Digitiz_It::SKU supplied with this distribution. + +Copy digitiz-xfer.conf to the /etc directory, and edit the values to taste. + +Run digitiz-xfer. + +Important note on usage: While digitiz-xfer is running, make sure to place +files in the $source_directory atomicly; in other words, *don't do: + + cp /some/file /opt/media/staging # NO! + +but instead do: + + cp /some/file /opt/media/tmpdir + mv /opt/media/tmpdir/file /opt/media/staging/ + +(important: /opt/media/tmpdir and /opt/media/staging must be on the *same +filesystem*) + +`mv' on the same filesystem is an atomic operation, but a `cp' or `mv' from +a different filesystem isn't. + 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 <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); +} + diff --git a/digitiz-xfer.conf b/digitiz-xfer.conf new file mode 100644 index 0000000..15a92ec --- /dev/null +++ b/digitiz-xfer.conf @@ -0,0 +1,53 @@ + +#$source_directory = "/opt/media/staging"; +$source_directory = "/home/ivan/digitiz/media"; + +#$destination_host = ""; +$destination_host = "localhost"; + +#$destination_root="/Libraries"; +$destination_root = "/home/ivan/digitiz/Libraries"; + +#need to create and specify a lock directory +$lock_directory = "/home/ivan/digitiz/lock"; + +#optional pidfile +#$pid_file = "/var/run/digitiz-xfer.pid"; +$pid_file = "/home/ivan/digitiz/digitiz-xfer.pid"; + +#$archive_directory = "/opt/media/archive/"; +$archive_directory = "/home/ivan/digitiz/archive"; + +#$failed_directory = "/opt/media/failed"; +$failed_directory = "/home/ivan/digitiz/failed"; + +#$log_file = "/var/logs/mediaxfer"; +$log_file = "/home/ivan/digitiz/mediaxfer"; + +$protocol = 'scp'; +#$protocol = 'ftp'; + +#for either protocol +$user = "ivan"; + +#password is for ftp only, *not* scp. for scp, use keys - see ssh-keygen(1) +$password = ""; + +$mail_from = 'ivan-digitiz-from@420.am'; + +@mail_to = ( +# 'mom@digitiz-it.com', + 'ivan-digitiz-to@420.am', +# 'ivan-digitiz-to22@420.am', +); + +#see Mail::Mailer for details +@mail_command = 'mail'; #mailx, Mail or mail +#@mail_command = 'sendmail'; +#@mail_command = qw( smtp Server cleanwhisker.420.am ); #smtp + +#see Date::Format for details +#$date_format = ""%m/%e/%Y"; +$date_format = "%A, %B %o, %Y"; +#$time_format = "%T"; +$time_format = "%r %Z"; -- 2.11.0