--- /dev/null
+#!/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);
+}
+
--- /dev/null
+
+#$source_directory = "/opt/media/staging";
+$source_directory = "/home/ivan/digitiz/media";
+
+#$destination_host = "<To Be Specified>";
+$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";
projects / Digitiz.git / commitdiff