| Subject: | [PATCH] Reinstate files to inc dir if deleted by external process |
As discussed on the PAR mailing list ( https://groups.google.com/forum/#!topic/perl.par/_obYvAgHeEc ), external processes can sometimes delete the files in the inc folder, but not the entire folder. Their absence then causes issues in packed scripts.
The attached patch adds a "canary" file to the inc directory and checks for its existence each time the part executable is called. If the canary file is missing then the files in the inc directory are re-extracted as needed.
The patch also:
1. Decreases the verbosity threshold for packing files into inc, as previously they needed double verbosity flags in pp to trigger.
2. Adds the files in inc to the manifest.
3. Corrects some quoting errors in the generated manifest.yml file (although I don't think that file is used anywhere?)
I can separate the additional points into their own patches if that's more appropriate.
Regards,
Shawn.
| Subject: | canary.patch |
Index: PAR-Packer/trunk/lib/PAR/Packer.pm
===================================================================
--- PAR-Packer/trunk/lib/PAR/Packer.pm (revision 1533)
+++ PAR-Packer/trunk/lib/PAR/Packer.pm (working copy)
@@ -459,6 +459,7 @@
$self->_add_pack_manifest();
$self->_add_add_manifest();
+ $self->_add_canary_file();
$self->_make_manifest();
$self->_write_zip();
@@ -521,6 +522,33 @@
}
}
+# Allows PAR to detect if an external process has
+# deleted unlocked files in /inc
+sub _add_canary_file {
+ my ($self) = @_;
+
+ my $opt = $self->{options};
+ my $par_file = $self->{par_file};
+
+ my $canary_file_name = PAR::get_canary_file_name();
+ my $canary_dir = File::Temp::tempdir(TMPDIR => 1, CLEANUP => 1);
+ my $canary_file = File::Spec->catdir ($canary_dir, $canary_file_name);
+
+ $self->_vprint(0, "Writing canary file $canary_file_name to $par_file");
+ $self->{zip} ||= Archive::Zip->new;
+ my $zip = $self->{zip};
+
+ my $canary_existed = -e $canary_file;
+ if (!$canary_existed) {
+ open(my $fh, '>', $canary_file) or die "Could not open $canary_file";
+ print {$fh} "This is a file to detect if an external process has incompletely cleared the PAR cache\n";
+ close $fh;
+ }
+
+ my $value = ['file', "$canary_file;$canary_file_name"];
+ $self->_add_file($zip, $canary_file_name, $value);
+}
+
sub _add_add_manifest {
my ($self) = @_;
@@ -528,7 +556,7 @@
my $add_manifest = $self->add_manifest_hash();
my $par_file = $self->{par_file};
- $self->_vprint(1, "Writing extra files to $par_file") if (%$add_manifest);
+ $self->_vprint(0, "Writing extra files to $par_file") if (%$add_manifest);
$self->{zip} ||= Archive::Zip->new;
my $zip = $self->{zip};
@@ -543,6 +571,7 @@
my ($self) = @_;
my $full_manifest = $self->{full_manifest};
+ my $add_manifest = $self->{add_manifest};
my $opt = $self->{options};
my $par_file = $self->{par_file};
@@ -555,6 +584,8 @@
my $manifest = join("\n",
' <!-- accessible as jar:file:///NAME.par!/MANIFEST in compliant browsers -->',
(sort keys %$full_manifest),
+ (sort keys %$add_manifest),
+ PAR::get_canary_file_name(),
q( # <html><body onload="var X=document.body.innerHTML.split(/\n/);var Y='<iframe src="META.yml" style="float:right;height:40%;width:40%"></iframe><ul>';for(var x in X){if(!X[x].match(/^\s*#/)&&X[x].length)Y+='<li><a href="'+X[x]+'">'+X[x]+'</a>'}document.body.innerHTML=Y">)
);
@@ -565,7 +596,7 @@
dist_name: $dist_name
distribution_type: par
dynamic_config: 0
-generated_by: '$class version $version
+generated_by: '$class version $version'
license: unknown
par:
clean: $clean
Index: PAR-Packer/trunk/t/21-pp_reinstate_cached_files.t
===================================================================
--- PAR-Packer/trunk/t/21-pp_reinstate_cached_files.t (revision 0)
+++ PAR-Packer/trunk/t/21-pp_reinstate_cached_files.t (working copy)
@@ -0,0 +1,212 @@
+#!/usr/bin/perl
+
+# Test that added files (via -a flag) are re-extracted
+# if deleted by some other process.
+# Much of this is a copy of 20-pp.t but seems to be
+# needed if we retain the sanity checks at the top.
+
+use strict;
+use warnings;
+use Cwd;
+use Config;
+use FindBin;
+use File::Spec;
+use File::Temp ();
+use ExtUtils::MakeMaker;
+use File::Path qw /remove_tree/;
+use PAR ();
+
+use Test::More;
+
+$ENV{PAR_TMPDIR} = File::Temp::tempdir(TMPDIR => 1, CLEANUP => 1);
+
+sub samefiles {
+ my ($f1, $f2) = @_;
+ $f1 eq $f2 and return 1;
+ -e $f1 && -e $f2 or return 0;
+ -s $f1 == -s $f2 or return 0;
+ local $/ = \65536;
+ open my $fh1, '<', $f1 or return 0;
+ open my $fh2, '<', $f2 or return 0;
+ while (1) {
+ my $c1 = <$fh1>;
+ my $c2 = <$fh2>;
+ last if !defined $c1 and !defined $c2;
+ return 0 if !defined $c1 or !defined $c2;
+ return 0 if $c1 ne $c2;
+ }
+ return 1;
+}
+
+chdir File::Spec->catdir($FindBin::Bin, File::Spec->updir);
+
+my $cwd = getcwd();
+#my $test_dir = File::Spec->catdir($cwd, 'contrib', 'automated_pp_test');
+my $test_dir = File::Temp::tempdir(TMPDIR => 1, CLEANUP => 1);
+
+my $parl = File::Spec->catfile($cwd, 'blib', 'script', "parl$Config{_exe}");
+my $startperl = $Config{startperl};
+$startperl =~ s/^#!//;
+
+my $orig_X = $^X;
+my $orig_startperl = $startperl;
+
+if (!-e $parl) {
+ print "1..0 # Skip 'parl' not found\n";
+ exit;
+}
+elsif (!($^X = main->can_run($^X))) {
+ print "1..0 # Skip '$orig_X' not found\n";
+ exit;
+}
+elsif (!($startperl = main->can_run($startperl))) {
+ print "1..0 # Skip '$orig_startperl' not found\n";
+ exit;
+}
+
+# NOTE: Win32::GetShortPathName exists on cygwin, too
+if ($^O eq 'MSWin32' && defined &Win32::GetShortPathName) {
+ $^X = lc(Win32::GetShortPathName($^X));
+ $startperl = lc(Win32::GetShortPathName($startperl));
+}
+
+if (!samefiles($startperl, $^X)) {
+ print "1..0 # Skip '$^X' is not the same as '$startperl'\n";
+ exit;
+}
+
+#unshift @INC, File::Spec->catdir($cwd, 'inc');
+#unshift @INC, File::Spec->catdir($cwd, 'blib', 'lib');
+#unshift @INC, File::Spec->catdir($cwd, 'blib', 'script');
+
+$ENV{PAR_GLOBAL_CLEAN} = 1;
+
+#$ENV{PATH} = join(
+# $Config{path_sep},
+# grep length,
+# File::Spec->catdir($cwd, 'blib', 'script'),
+# $ENV{PATH},
+#);
+#$ENV{PERL5LIB} = join(
+# $Config{path_sep},
+# grep length,
+# File::Spec->catdir($cwd, 'blib', 'lib'),
+# $test_dir,
+# $ENV{PERL5LIB},
+#);
+
+chdir $test_dir;
+
+$ENV{PAR_TMPDIR} = $test_dir;
+
+my $tmpfile1 = File::Spec->catfile($test_dir, 'check1.txt');
+my $tmpdir1 = File::Spec->catfile($test_dir, 'checkdir1');
+my $tmpfile2 = File::Spec->catfile($tmpdir1, 'check2.txt');
+
+mkdir $tmpdir1 if !-d $tmpdir1;
+foreach my $file ($tmpfile1, $tmpfile2) {
+ open(my $fh, '>', $file) or die "Cannot open $file to write to";
+ print {$fh} "$file\n$file\n"; # contents don't matter for this test
+ close ($fh);
+}
+
+
+my $script = File::Spec->catfile('script.pl');
+open(my $fh, '>', $script) or die "Cannot open $script";
+print {$fh} <<'END_OF_SCRIPT'
+use File::Spec;
+my $inc = File::Spec->catdir($ENV{PAR_TEMP}, 'inc');
+print "$inc\n";
+#print join ' ', '@INC:', @INC, "\n";
+my $fname = File::Spec->catfile($inc, 'check1.txt');
+open my $fh1, '<', $fname
+ or die "Cannot open $fname";
+$fname = File::Spec->catfile($inc, 'checkdir1', 'check2.txt');
+open my $fh2, '<', $fname
+ or die "Cannot open $fname";
+exit;
+END_OF_SCRIPT
+ ;
+close ($fh);
+
+my $osname = $^O;
+my $exe_file = 'tester' . $Config{_exe};
+
+# Not using script approach, as pp->go() allows for debugger step-through
+#my $pp_script = File::Spec->catdir($cwd, 'blib', 'script', 'pp');
+
+my @cmd = (
+ #$pp_script,
+ '-o' => $exe_file,
+ '-a' => "$tmpfile1;check1.txt",
+ '-a' => "$tmpdir1;checkdir1",
+ #'-v',
+ $script,
+);
+#print join ' ', @cmd, "\n";
+#system @cmd;
+my $opts = join ' ', @cmd;
+$opts =~ s'\\'\\\\'g; # CLUNKY, but quotemeta is overzealous and also escapes dashes and spaces
+$ENV{PP_OPTS} = $opts;
+print "\$ENV{PP_OPTS} = $ENV{PP_OPTS}\n";
+use pp;
+pp->go();
+
+# now run it
+$ENV{PAR_GLOBAL_CLEAN} = 0;
+print "...First run...\n";
+my $feedback = `$exe_file`;
+my @feedback = split "\n", $feedback;
+my $inc_dir = $feedback[0];
+
+# Now delete the files we packed into the exe using -a
+# These are in the par temp inc folder
+print "Deleting inc files\n";
+my $success;
+my $file1 = File::Spec->catfile($inc_dir, 'check1.txt');
+my $dir1 = File::Spec->catfile($inc_dir, 'checkdir1');
+my $canary1 = File::Spec->catfile($inc_dir, PAR::get_canary_file_name());
+
+$success = unlink $file1;
+$success = remove_tree $dir1;
+$success = unlink $canary1;
+# If the whole inc directory is deleted then it all gets re-extracted
+# and thus there are no failures to test.
+#$success = remove_tree $inc_dir;
+
+# A couple of sanity checks.
+# If these files are not deleted then subsequent tests will fail,
+# so this way we get a better indication as to why.
+for my $file ($file1, $dir1, $canary1) {
+ use File::Basename;
+ my $basename = basename($file);
+ ok (!-e $file, "inc/$basename was deleted");
+}
+
+# Now run the PAR binary again. We should get 0 on success.
+print "...Second run...\n";
+my $error = system $exe_file;
+
+ok (!$error, "Packed script runs after -a packed files deleted from par/inc");
+
+# go back to the start dir so the File::Temp cleanup will work
+chdir $cwd;
+
+done_testing();
+
+
+sub can_run {
+ my ($self, $cmd) = @_;
+
+ my $_cmd = $cmd;
+ return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
+
+ for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
+ my $abs = File::Spec->catfile($dir, $_[1]);
+ return $abs if (-x $abs or $abs = MM->maybe_command($abs));
+ }
+
+ return;
+}
+
+__END__
Index: trunk/lib/PAR.pm
===================================================================
--- trunk/lib/PAR.pm (revision 1533)
+++ trunk/lib/PAR.pm (working copy)
@@ -668,6 +668,12 @@
}
}
+# canary file name could perhaps use CRC string or similar
+# to make it more unique
+sub get_canary_file_name {
+ return '_PAR_CANARY.txt';
+}
+
# extract the contents of a .par (or .exe) or any
# Archive::Zip handle to the PAR_TEMP/inc directory.
# returns that directory.
@@ -674,14 +680,17 @@
sub _extract_inc {
my $file_or_azip_handle = shift;
my $force_extract = shift;
- my $inc = "$PAR::SetupTemp::PARTemp/inc";
+ my $inc = File::Spec->catdir ($PAR::SetupTemp::PARTemp, 'inc');
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 $is_handle = ref($file_or_azip_handle) && $file_or_azip_handle->isa('Archive::Zip::Archive');
+ my $inc_canary = File::Spec->catdir($inc, get_canary_file_name());
+ my $inc_canary_exists = -e $inc_canary;
+
require File::Spec;
- if (!$inc_exists or $force_extract) {
+ if (!$inc_exists or $force_extract or !$inc_canary_exists) {
for (1 .. 10) { mkdir("$inc.lock", 0755) and last; sleep 1 }
undef $@;