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
24 $SIG{__DIE__} = \&_die;
25 $SIG{__WARN__} = \&_logmsg;
27 $SIG{CHLD} = 'IGNORE'; #zombie prevention
30 $SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $sigterm++; };
32 #require "/etc/digitiz-xfer.conf";
33 require "/home/ivan/digitiz/digitiz-xfer.conf";
39 opendir(DIR, $source_directory)
40 || die "can't opendir $source_directory: $!";
41 while ( my $file = readdir DIR ) {
43 warn "parent process exiting (transfers in progress will finish)\n";
46 next if $file =~ /^\.\.?/;
50 # my $lock = new IO::File ">>$lock_directory/$file"
51 # or die "Couldn't open lockfile $lock_directory/$file: $!";
52 # next unless flock($lock, LOCK_EX|LOCK_NB);
53 # unless ( -e "$source_directory/$file" ) { #make sure file's still here
54 # unlink "$lock_directory/$file";
55 # flock($lock, LOCK_UN);
59 #fork a kid for the rest (can't be sure locks will get inherited -
62 defined( my $pid = fork ) or die "can't fork: $!";
65 local $SIG{HUP} = 'IGNORE';
66 local $SIG{INT} = 'IGNORE';
67 local $SIG{QUIT} = 'IGNORE';
68 local $SIG{TERM} = 'IGNORE';
69 local $SIG{TSTP} = 'IGNORE';
70 local $SIG{PIPE} = 'IGNORE';
72 #locking foo, here instead
73 my $lock = new IO::File "+>>$lock_directory/$file" #touch
74 or die "Couldn't open lockfile $lock_directory/$file: $!";
75 #next unless flock($lock, LOCK_EX|LOCK_NB);
76 exit unless flock($lock, LOCK_EX|LOCK_NB);
77 unless ( -e "$source_directory/$file" ) { #make sure file's still here
78 unlink "$lock_directory/$file";
79 flock($lock, LOCK_UN);
85 chomp( $retry = <$lock> || 0 );
86 chomp( $retrytime = <$lock> || 0 );
87 chomp( $overwrite = <$lock> || 0 );
89 if ( $retrytime && (time-$retrytime)/3600 >= 48 ) {
90 logfail($file, "still can't transfer $file after 48 hours");
93 #next if ($retry-1) > ((time-$retrytime)/3600);
94 exit if ($retry-1) > ((time-$retrytime)/3600);
96 if ( $file =~ /^([\d\-]+)\.\w+$/ ) {
98 if ( $sku = new Digitiz_It::SKU $1 ) {
101 logfail($file, "can't parse SKU: $1: $Digitiz_It::SKU::ERROR");
105 logfail($file, "can't parse filename for SKU");
111 #why doesn't this work? seek($lock, 0, 0);
112 my $newlock = new IO::File ">$lock_directory/$file.tmp";
113 print $newlock "$retry\n$retrytime\n$overwrite\n";
115 rename "$lock_directory/$file.tmp", "$lock_directory/$file";
117 unlink "$lock_directory/$file";
119 flock($lock, LOCK_UN);
123 sleep 2; #don't spawn too fast!
130 chdir "$source_directory" or die "Can't chdir to $source_directory: $!";
131 open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
132 # open STDOUT, '>/dev/null'
133 # or die "Can't write to /dev/null: $!";
134 defined(my $pid = fork) or die "Can't fork: $!";
136 print "digitiz-xfer started with pid $pid; logging to $log_file\n";
137 warn "digitiz-xfer parent started with pid $pid\n";
138 exit unless $pid_file;
139 my $pidfh = new IO::File ">$pid_file" or exit;
140 print $pidfh "$pid\n";
143 open STDOUT, '>/dev/null'
144 or die "Can't write to /dev/null: $!";
145 setsid or die "Can't start a new session: $!";
146 open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
149 sub archive { #archives a file
151 my $d = &datestamp();
152 _logmsg("archiving $source_directory/$file in $archive_directory/$d/$file");
153 movefile($file, "$archive_directory/$d" );
156 sub failed { #failed files
158 _logmsg("moving $source_directory/$file to $failed_directory/$file");
159 movefile($file, "$failed_directory");
163 my( $file, $dir ) = @_;
166 or die "fatal: can't mkdir $dir: $!";
167 rename "$source_directory/$file", "$dir/$file"
168 or die "fatal: cant't rename $source_directory/$file to $dir/$file: $!";
171 sub docopy { #copies a file to the remote host
172 my($file, $sku) = @_;
175 if ( $protocol eq 'scp' ) {
176 $xfer = Net::SCP->new($destination_host);
177 } elsif ( $protocol eq 'ftp' ) {
178 $xfer = Net::FTP->new($destination_host);
180 die "unknown transfer protocol $protocol";
185 logrepeatfail($file, "can't attempt transfer: $@");
187 logfail($file, "can't attempt transfer: $@");
193 $xfer->login($user, $password) or do {
195 logrepeatfail($file, "can't login");
197 logfail($file, "can't login");
203 $xfer->binary or do {
205 logrepeatfail($file, "can't set binary mode");
207 logfail($file, "can't set binary mode");
212 "$destination_root/". $sku->account. '/'. $sku->library. '/';
213 $dest_path .= 'Thumbnails/' if $sku->thumbnail;
215 my $dest_file = $dest_path. $file;
217 if ( $xfer->size($dest_file) && ! $overwrite ) {
218 logfail($file, "file $dest_file already exists on remote host");
223 _logmsg("copying $source_directory/$file to ".
224 "$destination_host:$dest_file with $protocol");
227 if ( $protocol eq 'ftp' ) { #so close
228 $xfer->cwd(dirname($dest_file));
229 $dest_file = basename($dest_file);
231 $xfer->put("$source_directory/$file", $dest_file);
233 my $localsize = -s "$source_directory/$file";
234 my $remotesize = $xfer->size($dest_file);
236 if ( $localsize && ( $localsize == $remotesize ) ) {
242 "verification failed: local $localsize, remote $remotesize"
246 "verification failed: local $localsize, remote $remotesize"
257 warn "transfer of $file successful\n";
258 email('Delivered','', $file);
262 my ($file, $err) = @_;
263 warn "[$file] $err\n";
264 email('Error', $err, $file);
268 my ($file, $err) = @_;
269 warn "[$file] $err\n";
273 my ( $status, $error, $file ) = @_;
274 my $mail = new Mail::Mailer @mail_command;
276 'From' => $mail_from,
277 'To' => [ @mail_to ],
278 'Subject' => "$file transfer status",
281 my $date = time2str($date_format, $now);
282 my $time = time2str($time_format, $now);
290 print $mail "Error: $error\n" if $error;
295 time2str("%m%d%Y", time);
300 email('Fatal', $msg, "Fatal");
305 chomp( my $msg = shift );
306 my $log = new IO::File ">>$log_file";
307 flock($log, LOCK_EX);
309 print $log "[". time2str("%a %b %e %T %Y",time). "] [$$] $msg\n";
310 flock($log, LOCK_UN);