path: root/digitiz-xfer

#!/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 File::Basename;
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);
        unlink "$lock_directory/$file";
        exit;
      }
      #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");

  #so close
  if ( $protocol eq 'ftp' ) { #so close
    $xfer->cwd(dirname($dest_file));
    $dest_file = basename($dest_file);
  }
  $xfer->put("$source_directory/$file", $dest_file);

  my $localsize = -s "$source_directory/$file";
  my $remotesize = $xfer->size($dest_file);

  if ( $localsize && ( $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);
}