4 use vars qw( $source_directory $destination_host $destination_root
5 $lock_directory $archive_directory $failed_directory
7 $log_file $protocol $user $password
8 $mail_from @mail_to @mail_command
9 $date_format $time_format
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
25 $SIG{__DIE__} = \&_die;
26 $SIG{__WARN__} = \&_logmsg;
28 $SIG{CHLD} = 'IGNORE'; #zombie prevention
31 $SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $sigterm++; };
33 #require "/etc/digitiz-xfer.conf";
34 require "/home/ivan/digitiz/digitiz-xfer.conf";
40 opendir(DIR, $source_directory)
41 || die "can't opendir $source_directory: $!";
42 while ( my $file = readdir DIR ) {
44 warn "parent process exiting (transfers in progress will finish)\n";
47 next if $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);
60 #fork a kid for the rest (can't be sure locks will get inherited -
63 defined( my $pid = fork ) or die "can't fork: $!";
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';
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);
86 chomp( $retry = <$lock> || 0 );
87 chomp( $retrytime = <$lock> || 0 );
88 chomp( $overwrite = <$lock> || 0 );
90 if ( $retrytime && (time-$retrytime)/3600 >= 48 ) {
91 logfail($file, "still can't transfer $file after 48 hours");
93 unlink "$lock_directory/$file";
96 #next if ($retry-1) > ((time-$retrytime)/3600);
97 exit if ($retry-1) > ((time-$retrytime)/3600);
99 if ( $file =~ /^([\d\-]+)\.\w+$/ ) {
101 if ( $sku = new Digitiz_It::SKU $1 ) {
104 logfail($file, "can't parse SKU: $1: $Digitiz_It::SKU::ERROR");
108 logfail($file, "can't parse filename for SKU");
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";
118 rename "$lock_directory/$file.tmp", "$lock_directory/$file";
120 unlink "$lock_directory/$file";
122 flock($lock, LOCK_UN);
126 sleep 2; #don't spawn too fast!
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: $!";
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";
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: $!";
152 sub archive { #archives a file
154 my $d = &datestamp();
155 _logmsg("archiving $source_directory/$file in $archive_directory/$d/$file");
156 movefile($file, "$archive_directory/$d" );
159 sub failed { #failed files
161 _logmsg("moving $source_directory/$file to $failed_directory/$file");
162 movefile($file, "$failed_directory");
166 my( $file, $dir ) = @_;
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: $!";
174 sub docopy { #copies a file to the remote host
175 my($file, $sku) = @_;
178 if ( $protocol eq 'scp' ) {
179 $xfer = Net::SCP->new($destination_host);
180 } elsif ( $protocol eq 'ftp' ) {
181 $xfer = Net::FTP->new($destination_host);
183 die "unknown transfer protocol $protocol";
188 logrepeatfail($file, "can't attempt transfer: $@");
190 logfail($file, "can't attempt transfer: $@");
196 $xfer->login($user, $password) or do {
198 logrepeatfail($file, "can't login");
200 logfail($file, "can't login");
206 $xfer->binary or do {
208 logrepeatfail($file, "can't set binary mode");
210 logfail($file, "can't set binary mode");
215 "$destination_root/". $sku->account. '/'. $sku->library. '/';
216 $dest_path .= 'Thumbnails/' if $sku->thumbnail;
218 my $dest_file = $dest_path. $file;
220 if ( $xfer->size($dest_file) && ! $overwrite ) {
221 logfail($file, "file $dest_file already exists on remote host");
226 _logmsg("copying $source_directory/$file to ".
227 "$destination_host:$dest_file with $protocol");
230 if ( $protocol eq 'ftp' ) { #so close
231 $xfer->cwd(dirname($dest_file));
232 $dest_file = basename($dest_file);
234 $xfer->put("$source_directory/$file", $dest_file);
236 my $localsize = -s "$source_directory/$file";
237 my $remotesize = $xfer->size($dest_file);
239 if ( $localsize && ( $localsize == $remotesize ) ) {
245 "verification failed: local $localsize, remote $remotesize"
249 "verification failed: local $localsize, remote $remotesize"
260 warn "transfer of $file successful\n";
261 email('Delivered','', $file);
265 my ($file, $err) = @_;
266 warn "[$file] $err\n";
267 email('Error', $err, $file);
271 my ($file, $err) = @_;
272 warn "[$file] $err\n";
276 my ( $status, $error, $file ) = @_;
277 my $mail = new Mail::Mailer @mail_command;
279 'From' => $mail_from,
280 'To' => [ @mail_to ],
281 'Subject' => "$file transfer status",
284 my $date = time2str($date_format, $now);
285 my $time = time2str($time_format, $now);
293 print $mail "Error: $error\n" if $error;
298 time2str("%m%d%Y", time);
303 email('Fatal', $msg, "Fatal");
308 chomp( my $msg = shift );
309 my $log = new IO::File ">>$log_file";
310 flock($log, LOCK_EX);
312 print $log "[". time2str("%a %b %e %T %Y",time). "] [$$] $msg\n";
313 flock($log, LOCK_UN);