diff -u -r /home/eedmja/subversion/par/trunk/lib/PAR/Heavy.pm lib/PAR/Heavy.pm --- /home/eedmja/subversion/par/trunk/lib/PAR/Heavy.pm 2015-06-26 18:00:44.134089289 +0200 +++ lib/PAR/Heavy.pm 2015-07-01 15:32:28.263406000 +0200 @@ -1,5 +1,5 @@ package PAR::Heavy; -$PAR::Heavy::VERSION = '0.12'; +$PAR::Heavy::VERSION = '0.12_001'; =head1 NAME @@ -159,6 +159,8 @@ $member->extractToFileHandle($fh); close $fh; chmod 0750, $filename; + my $cur_time = time(); + utime($cur_time, $cur_time, $filename); } return $filename; diff -u -r /home/eedmja/subversion/par/trunk/lib/PAR.pm lib/PAR.pm --- /home/eedmja/subversion/par/trunk/lib/PAR.pm 2015-06-26 18:00:44.154089460 +0200 +++ lib/PAR.pm 2015-07-01 17:43:37.103558000 +0200 @@ -1,5 +1,5 @@ package PAR; -$PAR::VERSION = '1.010'; +$PAR::VERSION = '1.009_001'; use 5.006; use strict; @@ -16,6 +16,7 @@ prefork->import($_) for qw/ Archive::Zip File::Glob + File::Find File::Spec File::Temp LWP::Simple @@ -258,6 +259,23 @@ that causes trouble, you can turn this off by setting the environment variable C to C<1>. +Since version 1.010, PAR employs an internal canary file inside the file cache +as a countermeasure against deterioration caused by tmpwatch or similar +cleanup helpers. +Long-term PAR based server processes may call PAR::refresh_file_cache() +at least once a day to prevent tmpwatch based problems. +The default canary file assumption is that tmpwatch runs on a daily basis, +and cleans up files in the temporary space which are older than 7 days. +In case the canary file is older than $PAR::MaxSecondsInTemp, a file cache +refresh is performed, unless the value is set to 0. +Adjustments to the canary file handling can be done with the following code +(the values below are the default ones): + + use PAR; + $PAR::MaxSecondsInTemp = 601200; # auto-refresh after 7 days minus 1 hour + $PAR::CanaryMtimeDiff = 90000; # canary file is 25 hours older + PAR::refresh_file_cache(1); # run a check with the adjusted values + =head2 import options When you "use PAR {...}" or call PAR->import({...}), the following @@ -323,6 +341,18 @@ # Layout: # $FileCache{$ZipObj}{$FileName} = $Member use vars qw(%ArchivesExtracted); # Associates archive-zip-object => full extraction path +use vars qw($ImportTime); # Epoch when import() or refresh_file_cache() was called last time +use vars qw($CanaryFileName); # Canary File name +use vars qw($CanaryMtimeDiff); # Canary File creation mtime difference +use vars qw($MaxSecondsInTemp); # Canary File maximum age for auto refresh + +# The default canary file assumption is that tmpwatch cleans up files in /tmp which are older than 7 days, +# and runs once a day. +# In case the canary file is older than $MaxSecondsInTemp, a file cache refresh is performed, +# unless the value is set to 0. +my $default_canary_file_name = '.canary_file'; +my $default_canary_mtime_diff = 90000; # 25 hours, to handle even time shifts +my $default_max_seconds_in_temp = 601200; # 7 days minus 1 hour, to prevent race conditions my $ver = $Config{version}; my $arch = $Config{archname}; @@ -339,6 +369,10 @@ # called on "use PAR" sub import { my $class = shift; + $ImportTime = time(); + $CanaryFileName = $default_canary_file_name if ( ! defined $CanaryFileName || $CanaryFileName eq '' ); + $CanaryMtimeDiff = $default_canary_mtime_diff if ( ! defined $CanaryMtimeDiff ); + $MaxSecondsInTemp = $default_max_seconds_in_temp if ( ! defined $MaxSecondsInTemp ); PAR::SetupProgname::set_progname(); PAR::SetupTemp::set_par_temp_env(); @@ -604,6 +638,7 @@ print $fh "#line 1 \"$file\"\n"; $member->extractToFileHandle($fh); seek ($fh, 0, 0); + utime($ImportTime, $ImportTime, $filename); } $ENV{PAR_0} = $filename; # for Pod::Usage @@ -628,6 +663,7 @@ print $fh "#line 1 \"$file\"\n"; $member->extractToFileHandle($fh); seek ($fh, 0, 0); + utime($ImportTime, $ImportTime, $filename); } unshift @INC, sub { shift @INC; return $fh }; @@ -678,10 +714,11 @@ my $dlext = defined($Config{dlext}) ? $Config::Config{dlext} : ''; my $inc_exists = -d $inc; my $is_handle = ref($file_or_azip_handle) && $file_or_azip_handle->isa('Archive::Zip::Archive'); + my $canary_file_existed = refresh_file_cache(1); # best case: only check the canary file require File::Spec; - if (!$inc_exists or $force_extract) { + if (!$inc_exists or ! $canary_file_existed or $force_extract) { for (1 .. 10) { mkdir("$inc.lock", 0755) and last; sleep 1 } undef $@; @@ -725,6 +762,7 @@ my $outfile = File::Spec->catfile($inc, $_); next if -e $outfile and not -w _; $zip->extractMember($_, $outfile); + utime($ImportTime, $ImportTime, $outfile); } } @@ -893,6 +931,45 @@ return; } +sub refresh_file_cache { + my $only_check_canary_file = shift @_ || 0; + $ImportTime = time(); + my $canary_file_existed = 1; + my $auto_refresh = 0; + + my $canary_file = File::Spec->catfile($PAR::SetupTemp::PARTemp, $CanaryFileName); + if ( -f $canary_file ) { + my ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, + $atime, $mtime, $ctime, $blksize, $blocks ) + = stat(_); + $auto_refresh++ if ( $MaxSecondsInTemp > 0 && $mtime < $ImportTime - $MaxSecondsInTemp ); + } + else { + $canary_file_existed = 0; + open my $fh, '>', $canary_file; + binmode($fh); + print $fh "$ImportTime\n"; + close($fh); + } + + if ( ! $only_check_canary_file || ! $canary_file_existed || $auto_refresh ) { + utime ($ImportTime - $CanaryMtimeDiff, $ImportTime - $CanaryMtimeDiff, $canary_file); + + require File::Find; + File::Find::find( + { + wanted => sub { + utime($ImportTime, $ImportTime, $File::Find::name) + if ( $File::Find::name ne $canary_file ); + }, + }, + $PAR::SetupTemp::PARTemp + ); + } + + return $canary_file_existed; +} + sub par_handle { my $par = pop; return $LibCache{$par}; @@ -901,7 +978,7 @@ my %escapes; sub unpar { my ($par, $file, $member_only, $allow_other_ext) = @_; - return if not defined $par; + return if not defined $par; my $zip = $LibCache{$par}; my @rv = $par; @@ -1016,8 +1093,10 @@ my $dest_name = File::Spec->catfile($ENV{PAR_TEMP}, $extract_name); # but don't extract it if we've already got one - $member->extractToFileNamed($dest_name) - unless(-e $dest_name); + unless(-e $dest_name) { + $member->extractToFileNamed($dest_name); + utime($ImportTime, $ImportTime, $dest_name); + } } } @@ -1067,6 +1146,7 @@ if ($is_new) { $member->extractToFileHandle($fh); seek ($fh, 0, 0); + utime($ImportTime, $ImportTime, $LastTempFile); } return $fh;