From 971c1aa26fd538f41b65faf9b33f7faaed9df7a2 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Thu, 29 May 2014 14:19:39 -0600 Subject: [PATCH 01/54] Import File::NFSLock 1.21 stock from CPAN --- .gitignore | 16 +++++++++ Changes | 14 ++++++++ File-NFSLock.spec | 2 +- lib/File/NFSLock.pm | 86 ++++++++++++++++++++++----------------------- 4 files changed, 74 insertions(+), 44 deletions(-) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..8bdb07e --- /dev/null +++ b/.gitignore @@ -0,0 +1,16 @@ +blib/ +.build/ +_build/ +cover_db/ +inc/ +Build +Build.bat +.last_cover_stats +Makefile +Makefile.old +MANIFEST.bak +META.yml +MYMETA.yml +nytprof.out +pm_to_blib +*.tar.gz diff --git a/Changes b/Changes index 9d18164..5f0a954 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,19 @@ Revision history for Perl extension File::NFSLock. +1.21 Jul 13 17:00 2011 + - Various patches by Chorny at cpan dot org + and fREW frioux at gmail dot com: + - Windows NTFS compatibility fixes. + - Allow PID to be negative. + - Lexically scope temp file handles to + reduce changes of memory leak and + avoid unintentional glob clobberation. + - Security fix: 3 arg open(). + - Repair test suites logics. + - Fixed infinite freezing on Strawberry Perl v5.10.0. + - Fixed infinite freezing on ActiveState Perl v5.12.1. + - Sorry for the past 8 years of suffering. + 1.20 May 13 12:00 2003 - Avoid double reverting signal handlers when unlock() is explicitly called instead of diff --git a/File-NFSLock.spec b/File-NFSLock.spec index 44e1c30..abcf4c9 100644 --- a/File-NFSLock.spec +++ b/File-NFSLock.spec @@ -1,7 +1,7 @@ # Automatically generated by File-NFSLock.spec.PL %define class File %define subclass NFSLock -%define version 1.20 +%define version 1.21 %define release 1 %define defperlver 5.6.1 diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index cc5604d..9dea38a 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -25,25 +25,25 @@ package File::NFSLock; use strict; -use Exporter (); -use vars qw(@ISA @EXPORT_OK $VERSION $TYPES - $LOCK_EXTENSION $SHARE_BIT $HOSTNAME $errstr - $graceful_sig @CATCH_SIGS); -use Carp qw(croak confess); +use warnings; -@ISA = qw(Exporter); -@EXPORT_OK = qw(uncache); +use Carp qw(croak confess); +our $errstr; +use base 'Exporter'; +our @EXPORT_OK = qw(uncache); -$VERSION = '1.20'; +our $VERSION = '1.21'; #Get constants, but without the bloat of #use Fcntl qw(LOCK_SH LOCK_EX LOCK_NB); -sub LOCK_SH {1} -sub LOCK_EX {2} -sub LOCK_NB {4} +use constant { + LOCK_SH => 1, + LOCK_EX => 2, + LOCK_NB => 4, +}; ### Convert lock_type to a number -$TYPES = { +our $TYPES = { BLOCKING => LOCK_EX, BL => LOCK_EX, EXCLUSIVE => LOCK_EX, @@ -53,9 +53,9 @@ $TYPES = { SHARED => LOCK_SH, SH => LOCK_SH, }; -$LOCK_EXTENSION = '.NFSLock'; # customizable extension -$HOSTNAME = undef; -$SHARE_BIT = 1; +our $LOCK_EXTENSION = '.NFSLock'; # customizable extension +our $HOSTNAME = undef; +our $SHARE_BIT = 1; ###----------------------------------------------------------------### @@ -66,7 +66,7 @@ my $graceful_sig = sub { exit; }; -@CATCH_SIGS = qw(TERM INT); +our @CATCH_SIGS = qw(TERM INT); sub new { $errstr = undef; @@ -107,7 +107,7 @@ sub new { ### need the hostname if( !$HOSTNAME ){ require Sys::Hostname; - $HOSTNAME = &Sys::Hostname::hostname(); + $HOSTNAME = Sys::Hostname::hostname(); } ### quick usage check @@ -160,8 +160,9 @@ sub new { ### If lock exists and is readable, see who is mooching on the lock + my $fh; if ( -e $self->{lock_file} && - open (_FH,"+<$self->{lock_file}") ){ + open ($fh,'+<', $self->{lock_file}) ){ my @mine = (); my @them = (); @@ -170,8 +171,8 @@ sub new { my $has_lock_exclusive = !((stat _)[2] & $SHARE_BIT); my $try_lock_exclusive = !($self->{lock_type} & LOCK_SH); - while(defined(my $line=<_FH>)){ - if ($line =~ /^$HOSTNAME (\d+) /) { + while(defined(my $line=<$fh>)){ + if ($line =~ /^$HOSTNAME (-?\d+) /) { my $pid = $1; if ($pid == $$) { # This is me. push @mine, $line; @@ -198,10 +199,10 @@ sub new { ### Rescan in case lock contents were modified between time stale lock ### was discovered and lockfile lock was acquired. - seek (_FH, 0, 0); + seek ($fh, 0, 0); my $content = ''; - while(defined(my $line=<_FH>)){ - if ($line =~ /^$HOSTNAME (\d+) /) { + while(defined(my $line=<$fh>)){ + if ($line =~ /^$HOSTNAME (-?\d+) /) { my $pid = $1; next if (!kill 0, $pid); # Skip dead locks from this host } @@ -210,18 +211,18 @@ sub new { ### Save any valid locks or wipe file. if( length($content) ){ - seek _FH, 0, 0; - print _FH $content; - truncate _FH, length($content); - close _FH; + seek $fh, 0, 0; + print $fh $content; + truncate $fh, length($content); + close $fh; }else{ - close _FH; + close $fh; unlink $self->{lock_file}; } ### No "dead" or stale locks found. } else { - close _FH; + close $fh; } ### If attempting to acquire the same type of lock @@ -308,10 +309,9 @@ sub create_magic ($;$) { my $self = shift; my $append_file = shift || $self->{rand_file}; $self->{lock_line} ||= "$HOSTNAME $self->{lock_pid} ".time()." ".int(rand()*10000)."\n"; - local *_FH; - open (_FH,">>$append_file") or do { $errstr = "Couldn't open \"$append_file\" [$!]"; return undef; }; - print _FH $self->{lock_line}; - close _FH; + open (my $fh,'>>', $append_file) or do { $errstr = "Couldn't open \"$append_file\" [$!]"; return undef; }; + print $fh $self->{lock_line}; + close $fh; return 1; } @@ -394,8 +394,8 @@ sub do_unlock_shared ($) { my $lock = new File::NFSLock ($lock_file,LOCK_EX,62,60); ### get the handle on the lock file - local *_FH; - if( ! open (_FH,"+<$lock_file") ){ + my $fh; + if( ! open ($fh,'+<', $lock_file) ){ if( ! -e $lock_file ){ return 1; }else{ @@ -405,21 +405,21 @@ sub do_unlock_shared ($) { ### read existing file my $content = ''; - while(defined(my $line=<_FH>)){ + while(defined(my $line=<$fh>)){ next if $line eq $lock_line; $content .= $line; } ### other shared locks exist if( length($content) ){ - seek _FH, 0, 0; - print _FH $content; - truncate _FH, length($content); - close _FH; + seek $fh, 0, 0; + print $fh $content; + truncate $fh, length($content); + close $fh; ### only I exist }else{ - close _FH; + close $fh; unlink $lock_file; } @@ -478,8 +478,8 @@ sub newpid { $self->do_unlock_shared; # Create signal file to notify parent that # the lock_line entry has been delegated. - open (_FH, ">$self->{lock_file}.fork"); - close(_FH); + open (my $fh, '>', "$self->{lock_file}.fork"); + close($fh); } } From 227773035c85c1d7c64a7aa9ef4af0941a26fae7 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Mon, 9 Jun 2014 16:35:06 -0600 Subject: [PATCH 02/54] Update test files to match version 1.21 --- t/100_load.t | 19 +++------- t/110_compare.t | 16 ++++----- t/120_single.t | 29 +++++++-------- t/200_bl_ex.t | 34 +++++++++++------- t/210_nb_ex.t | 59 ++++++++++++++++--------------- t/220_ex_scope.t | 85 +++++++++++++++++++++++++------------------- t/230_double.t | 29 +++++++-------- t/240_fork.t | 9 ++--- t/300_bl_sh.t | 92 ++++++++++++++++++++++++++---------------------- t/400_kill.t | 60 ++++++++++++++++--------------- t/410_die.t | 60 ++++++++++++++++--------------- t/420_crash.t | 60 ++++++++++++++++--------------- 12 files changed, 289 insertions(+), 263 deletions(-) diff --git a/t/100_load.t b/t/100_load.t index 1e335e8..8c0ed61 100644 --- a/t/100_load.t +++ b/t/100_load.t @@ -2,20 +2,9 @@ # `make test'. After `make install' it should work as `perl test.t' ######################### We start with some black magic to print on failure. +use strict; +use warnings; -use Test; -BEGIN { plan tests => 1; $loaded = 0} -END { ok $loaded;} +use Test::More tests => 1; -# Just make sure everything compiles -use File::NFSLock; -use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); -#use POSIX qw(tmpnam); - -$loaded = 1; - -######################### End of black magic. - -# Insert your test code below (better if it prints "ok 13" -# (correspondingly "not ok 13") depending on the success of chunk 13 -# of the test code): +use_ok 'File::NFSLock'; diff --git a/t/110_compare.t b/t/110_compare.t index 17a6393..0661c19 100644 --- a/t/110_compare.t +++ b/t/110_compare.t @@ -1,14 +1,12 @@ -use Test; +use strict; +use warnings; + +use Test::More tests => 3; use File::NFSLock; use Fcntl; -plan tests => 4; - -# Everything loaded fine -ok (1); - # Make sure File::NFSLock has the correct # constants according to Fcntl -ok (&File::NFSLock::LOCK_SH(),&Fcntl::LOCK_SH()); -ok (&File::NFSLock::LOCK_EX(),&Fcntl::LOCK_EX()); -ok (&File::NFSLock::LOCK_NB(),&Fcntl::LOCK_NB()); +is (&File::NFSLock::LOCK_SH(),&Fcntl::LOCK_SH()); +is (&File::NFSLock::LOCK_EX(),&Fcntl::LOCK_EX()); +is (&File::NFSLock::LOCK_NB(),&Fcntl::LOCK_NB()); diff --git a/t/120_single.t b/t/120_single.t index 90eb9a8..b3fb2b2 100644 --- a/t/120_single.t +++ b/t/120_single.t @@ -1,19 +1,14 @@ # Blocking Exclusive test within a single process (no fork) -use Test; +use Test::More tests => 2; use File::NFSLock; use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); -plan tests => 3; - -# Everything loaded fine -ok (1); - my $datafile = "testfile.dat"; # Create a blank file -sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC ); -close (FH); +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); ok (-e $datafile && !-s _); # Wipe any old stale locks unlink "$datafile$File::NFSLock::LOCK_EXTENSION"; @@ -26,26 +21,26 @@ for (my $i = 0; $i < $n ; $i++) { file => $datafile, lock_type => LOCK_EX, }; - sysopen(FH, $datafile, O_RDWR); + sysopen(my $fh, $datafile, O_RDWR); # Read the current value - my $count = ; + my $count = <$fh>; # Increment it $count ++; # And put it back - seek (FH,0,0); - print FH "$count\n"; - close FH; + seek ($fh,0,0); + print $fh "$count\n"; + close $fh; } # Load up whatever the file says now -sysopen(FH, $datafile, O_RDONLY); -$_ = ; -close FH; +sysopen($fh, $datafile, O_RDONLY); +$_ = <$fh>; +close $fh; chomp; # It should be the same as the number of times it looped -ok $n, $_; +is $n, $_; # Wipe the temporary file unlink $datafile; diff --git a/t/200_bl_ex.t b/t/200_bl_ex.t index 70378d9..1160cd6 100644 --- a/t/200_bl_ex.t +++ b/t/200_bl_ex.t @@ -1,6 +1,15 @@ # Blocking Exclusive Lock Test -use Test; +use strict; +use warnings; + +use Test::More; +if( $^O eq 'MSWin32' ) { + plan skip_all => 'Tests fail on Win32 due to forking'; +} +else { + plan tests => 20+2; +} use File::NFSLock; use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); @@ -9,13 +18,12 @@ my $m = 20; my $n = 50; $| = 1; # Buffer must be autoflushed because of fork() below. -plan tests => ($m+2); my $datafile = "testfile.dat"; # Create a blank file -sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC ); -close (FH); +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); ok (-e $datafile && !-s _); for (my $i = 0; $i < $m ; $i++) { @@ -27,15 +35,15 @@ for (my $i = 0; $i < $m ; $i++) { file => $datafile, lock_type => LOCK_EX, }; - sysopen(FH, $datafile, O_RDWR); + sysopen(my $fh, $datafile, O_RDWR); # Read the current value - my $count = ; + my $count = <$fh>; # Increment it $count ++; # And put it back - seek (FH,0,0); - print FH "$count\n"; - close FH; + seek ($fh,0,0); + print $fh "$count\n"; + close $fh; } exit; } @@ -48,12 +56,12 @@ for (my $i = 0; $i < $m ; $i++) { } # Load up whatever the file says now -sysopen(FH, $datafile, O_RDONLY); -$_ = ; -close FH; +sysopen(my $fh2, $datafile, O_RDONLY); +$_ = <$fh2>; +close $fh2; chomp; # It should be $m processes time $n each -ok $n*$m, $_; +is $n*$m, $_; # Wipe the temporary file unlink $datafile; diff --git a/t/210_nb_ex.t b/t/210_nb_ex.t index 4e8c9bb..55e9fac 100644 --- a/t/210_nb_ex.t +++ b/t/210_nb_ex.t @@ -1,72 +1,75 @@ +use strict; +use warnings; + # Non-Blocking Exclusive Lock Test -use Test; +use Test::More tests => 8; use File::NFSLock; use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -plan tests => 8; my $datafile = "testfile.dat"; # Create a blank file -sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC ); -close (FH); +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); ok (-e $datafile && !-s _); - -ok (pipe(RD1,WR1)); # Connected pipe for child1 +my ($rd1,$wr1); +ok (pipe($rd1,$wr1)); # Connected pipe for child1 if (!fork) { # Child #1 process my $lock = new File::NFSLock { file => $datafile, lock_type => LOCK_EX | LOCK_NB, }; - print WR1 !!$lock; # Send boolean success status down pipe - close(WR1); # Signal to parent that the Non-Blocking lock is done - close(RD1); + print $wr1 !!$lock; # Send boolean success status down pipe + close($wr1); # Signal to parent that the Non-Blocking lock is done + close($rd1); if ($lock) { sleep 2; # hold the lock for a moment - sysopen(FH, $datafile, O_RDWR); + sysopen(my $fh, $datafile, O_RDWR); # now put a magic word into the file - print FH "child1\n"; - close FH; + print $fh "child1\n"; + close $fh; } exit; } ok 1; # Fork successful -close (WR1); +close ($wr1); # Waiting for child1 to finish its lock status -my $child1_lock = ; -close (RD1); +my $child1_lock = <$rd1>; +close ($rd1); # Report status of the child1_lock. # It should have been successful ok ($child1_lock); -ok (pipe(RD2,WR2)); # Connected pipe for child2 +my ($rd2, $wr2); +ok (pipe($rd2,$wr2)); # Connected pipe for child2 if (!fork) { # Child #2 process my $lock = new File::NFSLock { file => $datafile, lock_type => LOCK_EX | LOCK_NB, }; - print WR2 !!$lock; # Send boolean success status down pipe - close(WR2); # Signal to parent that the Non-Blocking lock is done - close(RD2); + print $wr2 !!$lock; # Send boolean success status down pipe + close($wr2); # Signal to parent that the Non-Blocking lock is done + close($rd2); if ($lock) { - sysopen(FH, $datafile, O_RDWR); + sysopen(my $fh, $datafile, O_RDWR); # now put a magic word into the file - print FH "child2\n"; - close FH; + print $fh "child2\n"; + close $fh; } exit; } ok 1; # Fork successful -close (WR2); +close ($wr2); # Waiting for child2 to finish its lock status -my $child2_lock = ; -close (RD2); +my $child2_lock = <$rd2>; +close ($rd2); # Report status of the child2_lock. # This lock should not have been obtained since # the child1 lock should still have been established. @@ -76,9 +79,9 @@ ok (!$child2_lock); wait; wait; # Load up whatever the file says now -sysopen(FH, $datafile, O_RDONLY); -$_ = ; -close FH; +sysopen(my $fh2, $datafile, O_RDONLY); +$_ = <$fh2>; +close $fh2; # It should be child1 if it was really nonblocking # since it got the lock first. diff --git a/t/220_ex_scope.t b/t/220_ex_scope.t index 695fec1..43be1c4 100644 --- a/t/220_ex_scope.t +++ b/t/220_ex_scope.t @@ -9,101 +9,112 @@ # If a process has some file locked (say exclusively although it doesn't matter) and another process attempts to get a lock, if it fails it deletes the lock file - whether or not the first (locking process) has finished with its lock. This means any subsequent process that comes along that attempts to lock the file succeeds - even if the first process thinks it still has a lock. # -use Test; +use strict; +use warnings; + +use Test::More; +if( $^O eq 'MSWin32' ) { + plan skip_all => 'Tests fail on Win32 due to forking'; +} +else { + plan tests => 11; +} use File::NFSLock; use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -plan tests => 11; my $datafile = "testfile.dat"; # Create a blank file -sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC ); -close (FH); +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); ok (-e $datafile && !-s _); -ok (pipe(RD1,WR1)); # Connected pipe for child1 +my ($rd1, $wr1); +ok (pipe($rd1, $wr1)); # Connected pipe for child1 if (!fork) { # Child #1 process my $lock = new File::NFSLock { file => $datafile, lock_type => LOCK_EX | LOCK_NB, }; - print WR1 !!$lock; # Send boolean success status down pipe - close(WR1); # Signal to parent that the Non-Blocking lock is done - close(RD1); + print $wr1 !!$lock; # Send boolean success status down pipe + close($wr1); # Signal to parent that the Non-Blocking lock is done + close($rd1); if ($lock) { sleep 2; # hold the lock for a moment - sysopen(FH, $datafile, O_RDWR); + sysopen(my $fh, $datafile, O_RDWR); # now put a magic word into the file - print FH "child1\n"; - close FH; + print $fh "child1\n"; + close $fh; } exit; } ok 1; # Fork successful -close (WR1); +close ($wr1); # Waiting for child1 to finish its lock status -my $child1_lock = ; -close (RD1); +my $child1_lock = <$rd1>; +close ($rd1); # Report status of the child1_lock. # It should have been successful ok ($child1_lock); -ok (pipe(RD2,WR2)); # Connected pipe for child2 +my ($rd2, $wr2); +ok (pipe($rd2, $wr2)); # Connected pipe for child2 if (!fork) { # Child #2 process my $lock = new File::NFSLock { file => $datafile, lock_type => LOCK_EX | LOCK_NB, }; - print WR2 !!$lock; # Send boolean success status down pipe - close(WR2); # Signal to parent that the Non-Blocking lock is done - close(RD2); + print $wr2 !!$lock; # Send boolean success status down pipe + close($wr2); # Signal to parent that the Non-Blocking lock is done + close($rd2); if ($lock) { - sysopen(FH, $datafile, O_RDWR); + sysopen(my $fh, $datafile, O_RDWR); # now put a magic word into the file - print FH "child2\n"; - close FH; + print $fh "child2\n"; + close $fh; } exit; } ok 1; # Fork successful -close (WR2); +close ($wr2); # Waiting for child2 to finish its lock status -my $child2_lock = ; -close (RD2); +my $child2_lock = <$rd2>; +close ($rd2); # Report status of the child2_lock. # This lock should not have been obtained since # the child1 lock should still have been established. ok (!$child2_lock); -ok (pipe(RD3,WR3)); # Connected pipe for child3 +my ($rd3, $wr3); +ok (pipe($rd3, $wr3)); # Connected pipe for child3 if (!fork) { # Child #3 process my $lock = new File::NFSLock { file => $datafile, lock_type => LOCK_EX | LOCK_NB, }; - print WR3 !!$lock; # Send boolean success status down pipe - close(WR3); # Signal to parent that the Non-Blocking lock is done - close(RD3); + print $wr3 !!$lock; # Send boolean success status down pipe + close($wr3); # Signal to parent that the Non-Blocking lock is done + close($wr3); if ($lock) { - sysopen(FH, $datafile, O_RDWR); + sysopen(my $fh, $datafile, O_RDWR); # now put a magic word into the file - print FH "child3\n"; - close FH; + print $fh "child3\n"; + close $fh; } exit; } ok 1; # Fork successful -close (WR3); +close ($wr3); # Waiting for child2 to finish its lock status -my $child3_lock = ; -close (RD3); +my $child3_lock = <$rd3>; +close ($rd3); # Report status of the child3_lock. # This lock should also fail since the child1 # lock should still have been established. @@ -113,9 +124,9 @@ ok (!$child3_lock); wait; wait; wait; # Load up whatever the file says now -sysopen(FH, $datafile, O_RDONLY); -$_ = ; -close FH; +sysopen(my $fh2, $datafile, O_RDONLY); +$_ = <$fh2>; +close $fh2; # It should be child1 if it was really nonblocking # since it got the lock first. diff --git a/t/230_double.t b/t/230_double.t index 362fe61..42016e1 100644 --- a/t/230_double.t +++ b/t/230_double.t @@ -4,12 +4,13 @@ # an exclusive lock multiple times for the same file. use strict; -use Test; +use warnings; + +use Test::More tests => 5; use File::NFSLock; use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); $| = 1; -plan tests => 5; my $datafile = "testfile.dat"; @@ -17,8 +18,8 @@ my $datafile = "testfile.dat"; unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); # Create a blank file -sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC ); -close (FH); +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); ok (-e $datafile && !-s _); @@ -30,9 +31,9 @@ my $lock1 = new File::NFSLock { ok ($lock1); -sysopen(FH, $datafile, O_RDWR | O_APPEND); -print FH "lock1\n"; -close FH; +sysopen(my $fh2, $datafile, O_RDWR | O_APPEND); +print $fh2 "lock1\n"; +close $fh2; my $lock2 = new File::NFSLock { file => $datafile, @@ -42,17 +43,17 @@ my $lock2 = new File::NFSLock { ok ($lock2); -sysopen(FH, $datafile, O_RDWR | O_APPEND); -print FH "lock2\n"; -close FH; +sysopen(my $fh3, $datafile, O_RDWR | O_APPEND); +print $fh3 "lock2\n"; +close $fh3; # Load up whatever the file says now -sysopen(FH, $datafile, O_RDONLY); -$_ = ; +sysopen(my $fh4, $datafile, O_RDONLY); +$_ = <$fh4>; ok /lock1/; -$_ = ; +$_ = <$fh4>; ok /lock2/; -close FH; +close $fh4; # Wipe the temporary file unlink $datafile; diff --git a/t/240_fork.t b/t/240_fork.t index 12a9ba1..b0f01ff 100644 --- a/t/240_fork.t +++ b/t/240_fork.t @@ -4,12 +4,13 @@ # allow a parent to delegate the lock to its child. use strict; -use Test; +use warnings; + +use Test::More tests => 5; use File::NFSLock; use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -plan tests => 5; my $datafile = "testfile.dat"; @@ -17,8 +18,8 @@ my $datafile = "testfile.dat"; unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); # Create a blank file -sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC ); -close (FH); +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); ok (-e $datafile && !-s _); if (1) { diff --git a/t/300_bl_sh.t b/t/300_bl_sh.t index 52c3797..1609cdd 100644 --- a/t/300_bl_sh.t +++ b/t/300_bl_sh.t @@ -1,6 +1,14 @@ # Blocking Shared Lock Test +use strict; +use warnings; -use Test; +use Test::More; +if( $^O eq 'MSWin32' ) { + plan skip_all => 'Tests fail on Win32 due to forking'; +} +else { + plan tests => 13+3*20; +} use File::NFSLock; use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_NB LOCK_SH); @@ -9,19 +17,18 @@ my $m = 20; my $shared_delay = 5; $| = 1; # Buffer must be autoflushed because of fork() below. -plan tests => (13 + 3*$m); my $datafile = "testfile.dat"; # Create a blank file -sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC ); -close (FH); +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); # test 1 ok (-e $datafile && !-s _); -# test 2 -ok (pipe(RD1,WR1)); # Connected pipe for child1 +my ($rd1, $wr1); +ok (pipe($rd1, $wr1)); # Connected pipe for child1 if (!fork) { # Child #1 process # Obtain exclusive lock to block the shared attempt later @@ -29,32 +36,32 @@ if (!fork) { file => $datafile, lock_type => LOCK_EX, }; - print WR1 !!$lock; # Send boolean success status down pipe - close(WR1); # Signal to parent that the Blocking lock is done - close(RD1); + print $wr1 !!$lock; # Send boolean success status down pipe + close($wr1); # Signal to parent that the Blocking lock is done + close($rd1); if ($lock) { sleep 2; # hold the lock for a moment - sysopen(FH, $datafile, O_RDWR | O_TRUNC); + sysopen(my $fh, $datafile, O_RDWR | O_TRUNC); # And then put a magic word into the file - print FH "exclusive\n"; - close FH; + print $fh "exclusive\n"; + close $fh; } exit; } # test 3 ok 1; # Fork successful -close (WR1); +close ($wr1); # Waiting for child1 to finish its lock status -my $child1_lock = ; -close (RD1); +my $child1_lock = <$rd1>; +close ($rd1); # Report status of the child1_lock. # It should have been successful # test 4 ok ($child1_lock); -# test 5 -ok (pipe(RD2,WR2)); # Connected pipe for child2 +my ($rd2, $wr2); +ok (pipe($rd2, $wr2)); # Connected pipe for child2 if (!fork) { # This should block until the exclusive lock is done my $lock = new File::NFSLock { @@ -62,11 +69,11 @@ if (!fork) { lock_type => LOCK_SH, }; if ($lock) { - sysopen(FH, $datafile, O_RDWR | O_TRUNC); + sysopen(my $fh, $datafile, O_RDWR | O_TRUNC); # Immediately put the magic word into the file - print FH "shared\n"; - truncate (FH, tell FH); - close FH; + print $fh "shared\n"; + truncate ($fh, tell $fh); + close $fh; # Normally shared locks never modify the contents because # of the race condition. (The last one to write wins.) # But in this case, the parent will wait until the lock @@ -76,9 +83,9 @@ if (!fork) { # This is also a good test to make sure that other shared # locks can still be obtained simultaneously. } - print WR2 !!$lock; # Send boolean success status down pipe - close(WR2); # Signal to parent that the Blocking lock is done - close(RD2); + print $wr2 !!$lock; # Send boolean success status down pipe + close($wr2); # Signal to parent that the Blocking lock is done + close($rd2); # Then hold this shared lock for a moment # while other shared locks are attempted sleep($shared_delay*2); @@ -86,10 +93,10 @@ if (!fork) { } # test 6 ok 1; # Fork successful -close (WR2); +close ($wr2); # Waiting for child2 to finish its lock status -my $child2_lock = ; -close (RD2); +my $child2_lock = <$rd2>; +close ($rd2); # Report status of the child2_lock. # This should have eventually been successful. # test 7 @@ -110,7 +117,8 @@ $SIG{ALRM} = sub { # Use pipe to read lock success status from children # test 8 -ok (pipe(RD3,WR3)); +my ($rd3, $wr3); +ok (pipe($rd3, $wr3)); # Wait a few seconds less than if all locks were # aquired asyncronously to ensure that they overlap. @@ -125,15 +133,15 @@ for (my $i = 0; $i < $m ; $i++) { lock_type => LOCK_SH, }; # Send boolean success status down pipe - print WR3 !!$lock,"\n"; - close(WR3); + print $wr3 !!$lock,"\n"; + close($wr3); if ($lock) { sleep $shared_delay; # Hold the shared lock for a moment # Appending should always be safe across NFS - sysopen(FH, $datafile, O_RDWR | O_APPEND); + sysopen(my $fh, $datafile, O_RDWR | O_APPEND); # Put one line to signal the lock was successful. - print FH "1\n"; - close FH; + print $fh "1\n"; + close $fh; $lock->unlock(); } else { warn "Lock [$i] failed!"; @@ -143,22 +151,22 @@ for (my $i = 0; $i < $m ; $i++) { } # Parent process never writes to pipe -close(WR3); +close($wr3); # There were $m children attempting the shared locks. for (my $i = 0; $i < $m ; $i++) { # Report status of each lock attempt. - my $got_shared_lock = ; + my $got_shared_lock = <$rd3>; # test 9 .. 8+$m ok $got_shared_lock; } # There should not be anything left in the pipe. -my $extra = ; +my $extra = <$rd3>; # test 9 + $m ok !$extra; -close (RD3); +close ($rd3); # If we made it here, then it must have been faster # than the timeout. So reset the timer. @@ -176,21 +184,21 @@ for (my $i = 0; $i < $m + 2 ; $i++) { } # Load up whatever the file says now -sysopen(FH, $datafile, O_RDONLY); +sysopen(my $fh2, $datafile, O_RDONLY); # The first line should say "shared" if child2 really # waited for child1's exclusive lock to finish. -$_ = ; +$_ = <$fh2>; # test 13 + 2*$m ok /shared/; for (my $i = 0; $i < $m ; $i++) { - $_ = ; + $_ = <$fh2>; chomp; # test 14+2*$m .. 13+3*$m - ok $_, 1; + is $_, 1; } -close FH; +close $fh2; # Wipe the temporary file unlink $datafile; diff --git a/t/400_kill.t b/t/400_kill.t index 3926f2d..66d1502 100644 --- a/t/400_kill.t +++ b/t/400_kill.t @@ -1,11 +1,13 @@ # Lock Test with graceful termination (SIGTERM or SIGINT) -use Test; +use strict; +use warnings; + +use Test::More tests => 10; use File::NFSLock; use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); $| = 1; # Buffer must be autoflushed because of fork() below. -plan tests => 10; my $datafile = "testfile.dat"; @@ -13,14 +15,15 @@ my $datafile = "testfile.dat"; unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); # Create a blank file -sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC ); -close (FH); +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); # test 1 ok (-e $datafile && !-s _); # test 2 -ok (pipe(RD1,WR1)); # Connected pipe for child1 +my ($rd1, $wr1); +ok (pipe($rd1, $wr1)); # Connected pipe for child1 my $pid = fork; if (!$pid) { @@ -31,25 +34,25 @@ if (!$pid) { lock_type => LOCK_EX, }; open(STDERR,">/dev/null"); - print WR1 !!$lock; # Send boolean success status down pipe - close(WR1); # Signal to parent that the Blocking lock is done - close(RD1); + print $wr1 !!$lock; # Send boolean success status down pipe + close($wr1); # Signal to parent that the Blocking lock is done + close($rd1); if ($lock) { sleep 10; # hold the lock for a moment - sysopen(FH, $datafile, O_RDWR | O_TRUNC); + sysopen(my $fh, $datafile, O_RDWR | O_TRUNC); # And then put a magic word into the file - print FH "exclusive\n"; - close FH; + print $fh "exclusive\n"; + close $fh; } exit; } # test 3 ok 1; # Fork successful -close (WR1); +close ($wr1); # Waiting for child1 to finish its lock status -my $child1_lock = ; -close (RD1); +my $child1_lock = <$rd1>; +close ($rd1); # Report status of the child1_lock. # It should have been successful # test 4 @@ -64,7 +67,8 @@ ok (kill "INT", $pid); ok (wait); # test 7 -ok (pipe(RD2,WR2)); # Connected pipe for child2 +my ($rd2, $wr2); +ok (pipe($rd2, $wr2)); # Connected pipe for child2 if (!fork) { # The last lock died, so this should aquire fine. my $lock = new File::NFSLock { @@ -73,36 +77,36 @@ if (!fork) { blocking_timeout => 10, }; if ($lock) { - sysopen(FH, $datafile, O_RDWR | O_TRUNC); + sysopen(my $fh, $datafile, O_RDWR | O_TRUNC); # Immediately put the magic word into the file - print FH "lock2\n"; - truncate (FH, tell FH); - close FH; + print $fh "lock2\n"; + truncate ($fh, tell $fh); + close $fh; } - print WR2 !!$lock; # Send boolean success status down pipe - close(WR2); # Signal to parent that the Blocking lock is done - close(RD2); + print $wr2 !!$lock; # Send boolean success status down pipe + close($wr2); # Signal to parent that the Blocking lock is done + close($rd2); exit; # Release this new lock } # test 8 ok 1; # Fork successful -close (WR2); +close ($wr2); # Waiting for child2 to finish its lock status -my $child2_lock = ; -close (RD2); +my $child2_lock = <$rd2>; +close ($rd2); # Report status of the child2_lock. # This should have been successful. # test 9 ok ($child2_lock); # Load up whatever the file says now -sysopen(FH, $datafile, O_RDONLY); +sysopen(my $fh2, $datafile, O_RDONLY); -$_ = ; +$_ = <$fh2>; # test 10 ok /lock2/; -close FH; +close $fh2; # Wipe the temporary file unlink $datafile; diff --git a/t/410_die.t b/t/410_die.t index f964f5d..abb4e3f 100644 --- a/t/410_die.t +++ b/t/410_die.t @@ -1,11 +1,13 @@ # Lock Test with fatal error (die) -use Test; +use strict; +use warnings; + +use Test::More tests => 9; use File::NFSLock; use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); $| = 1; # Buffer must be autoflushed because of fork() below. -plan tests => 9; my $datafile = "testfile.dat"; @@ -13,14 +15,15 @@ my $datafile = "testfile.dat"; unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); # Create a blank file -sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC ); -close (FH); +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); # test 1 ok (-e $datafile && !-s _); # test 2 -ok (pipe(RD1,WR1)); # Connected pipe for child1 +my ($rd1, $wr1); +ok (pipe($rd1, $wr1)); # Connected pipe for child1 my $pid = fork; if (!$pid) { @@ -30,14 +33,14 @@ if (!$pid) { file => $datafile, lock_type => LOCK_EX, }; - print WR1 !!$lock; # Send boolean success status down pipe - close(WR1); # Signal to parent that the Blocking lock is done - close(RD1); + print $wr1 !!$lock; # Send boolean success status down pipe + close($wr1); # Signal to parent that the Blocking lock is done + close($wr1); if ($lock) { - sysopen(FH, $datafile, O_RDWR | O_TRUNC); + sysopen(my $fh, $datafile, O_RDWR | O_TRUNC); # And then put a magic word into the file - print FH "exclusive\n"; - close FH; + print $fh "exclusive\n"; + close $fh; open(STDERR,">/dev/null"); die "I will die while lock is still aquired"; } @@ -46,10 +49,10 @@ if (!$pid) { # test 3 ok 1; # Fork successful -close (WR1); +close ($wr1); # Waiting for child1 to finish its lock status -my $child1_lock = ; -close (RD1); +my $child1_lock = <$rd1>; +close ($rd1); # Report status of the child1_lock. # It should have been successful # test 4 @@ -60,7 +63,8 @@ ok ($child1_lock); ok (wait); # test 6 -ok (pipe(RD2,WR2)); # Connected pipe for child2 +my ($rd2, $wr2); +ok (pipe($rd2, $wr2)); # Connected pipe for child2 if (!fork) { # The last lock died, so this should aquire fine. my $lock = new File::NFSLock { @@ -69,36 +73,36 @@ if (!fork) { blocking_timeout => 10, }; if ($lock) { - sysopen(FH, $datafile, O_RDWR | O_TRUNC); + sysopen(my $fh, $datafile, O_RDWR | O_TRUNC); # Immediately put the magic word into the file - print FH "lock2\n"; - truncate (FH, tell FH); - close FH; + print $fh "lock2\n"; + truncate ($fh, tell $fh); + close $fh; } - print WR2 !!$lock; # Send boolean success status down pipe - close(WR2); # Signal to parent that the Blocking lock is done - close(RD2); + print $wr2 !!$lock; # Send boolean success status down pipe + close($wr2); # Signal to parent that the Blocking lock is done + close($rd2); exit; # Release this new lock } # test 7 ok 1; # Fork successful -close (WR2); +close ($wr2); # Waiting for child2 to finish its lock status -my $child2_lock = ; -close (RD2); +my $child2_lock = <$rd2>; +close ($rd2); # Report status of the child2_lock. # This should have been successful. # test 8 ok ($child2_lock); # Load up whatever the file says now -sysopen(FH, $datafile, O_RDONLY); +sysopen(my $fh2, $datafile, O_RDONLY); -$_ = ; +$_ = <$fh2>; # test 9 ok /lock2/; -close FH; +close $fh2; # Wipe the temporary file unlink $datafile; diff --git a/t/420_crash.t b/t/420_crash.t index 2238f70..9559fb3 100644 --- a/t/420_crash.t +++ b/t/420_crash.t @@ -1,11 +1,13 @@ # Lock Test with abnormal or abrupt termination (System crash or SIGKILL) -use Test; +use strict; +use warnings; + +use Test::More tests => 10; use File::NFSLock; use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); $| = 1; # Buffer must be autoflushed because of fork() below. -plan tests => 10; my $datafile = "testfile.dat"; @@ -13,14 +15,15 @@ my $datafile = "testfile.dat"; unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); # Create a blank file -sysopen ( FH, $datafile, O_CREAT | O_RDWR | O_TRUNC ); -close (FH); +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); # test 1 ok (-e $datafile && !-s _); # test 2 -ok (pipe(RD1,WR1)); # Connected pipe for child1 +my ($rd1, $wr1); +ok (pipe($rd1, $wr1)); # Connected pipe for child1 my $pid = fork; if (!$pid) { @@ -31,25 +34,25 @@ if (!$pid) { lock_type => LOCK_EX, }; open(STDERR,">/dev/null"); - print WR1 !!$lock; # Send boolean success status down pipe - close(WR1); # Signal to parent that the Blocking lock is done - close(RD1); + print $wr1 !!$lock; # Send boolean success status down pipe + close($wr1); # Signal to parent that the Blocking lock is done + close($rd1); if ($lock) { sleep 10; # hold the lock for a moment - sysopen(FH, $datafile, O_RDWR | O_TRUNC); + sysopen(my $fh, $datafile, O_RDWR | O_TRUNC); # And then put a magic word into the file - print FH "exclusive\n"; - close FH; + print $fh "exclusive\n"; + close $fh; } exit; } # test 3 ok 1; # Fork successful -close (WR1); +close ($wr1); # Waiting for child1 to finish its lock status -my $child1_lock = ; -close (RD1); +my $child1_lock = <$rd1>; +close ($rd1); # Report status of the child1_lock. # It should have been successful # test 4 @@ -64,7 +67,8 @@ ok (kill "KILL", $pid); ok (wait); # test 7 -ok (pipe(RD2,WR2)); # Connected pipe for child2 +my ($rd2, $wr2); +ok (pipe($rd2, $wr2)); # Connected pipe for child2 if (!fork) { # The last lock died, so this should aquire fine. my $lock = new File::NFSLock { @@ -73,36 +77,36 @@ if (!fork) { blocking_timeout => 10, }; if ($lock) { - sysopen(FH, $datafile, O_RDWR | O_TRUNC); + sysopen(my $fh, $datafile, O_RDWR | O_TRUNC); # Immediately put the magic word into the file - print FH "lock2\n"; - truncate (FH, tell FH); - close FH; + print $fh "lock2\n"; + truncate ($fh, tell $fh); + close $fh; } - print WR2 !!$lock; # Send boolean success status down pipe - close(WR2); # Signal to parent that the Blocking lock is done - close(RD2); + print $wr2 !!$lock; # Send boolean success status down pipe + close($wr2); # Signal to parent that the Blocking lock is done + close($rd2); exit; # Release this new lock } # test 8 ok 1; # Fork successful -close (WR2); +close ($wr2); # Waiting for child2 to finish its lock status -my $child2_lock = ; -close (RD2); +my $child2_lock = <$rd2>; +close ($rd2); # Report status of the child2_lock. # This should have been successful. # test 9 ok ($child2_lock); # Load up whatever the file says now -sysopen(FH, $datafile, O_RDONLY); +sysopen(my $fh2, $datafile, O_RDONLY); -$_ = ; +$_ = <$fh2>; # test 10 ok /lock2/; -close FH; +close $fh2; # Wipe the temporary file unlink $datafile; From 02b16d3fcba186e756eee561d66c9d0d4e47164f Mon Sep 17 00:00:00 2001 From: rob Date: Mon, 9 Jun 2014 16:37:32 -0600 Subject: [PATCH 03/54] Bump to version 1.22 --- lib/File/NFSLock.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index 9dea38a..991e33c 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -32,7 +32,7 @@ our $errstr; use base 'Exporter'; our @EXPORT_OK = qw(uncache); -our $VERSION = '1.21'; +our $VERSION = '1.22'; #Get constants, but without the bloat of #use Fcntl qw(LOCK_SH LOCK_EX LOCK_NB); From db8929ca2ddb48107401d336b725899bf2638f04 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Fri, 25 Jul 2014 15:24:44 -0600 Subject: [PATCH 04/54] Cosmetic changes to pod - README - lib/File/NFSLock.pm --- README | 168 +++++++++++++++++++++----------------------- lib/File/NFSLock.pm | 4 ++ 2 files changed, 83 insertions(+), 89 deletions(-) diff --git a/README b/README index b684529..229b82b 100644 --- a/README +++ b/README @@ -119,127 +119,117 @@ PARAMETERS seconds). METHODS - After the $lock object is instantiated with new, as outlined above, - some methods may be used for additional functionality. + After the $lock object is instantiated with new, as outlined above, some + methods may be used for additional functionality. unlock + $lock->unlock; - $lock->unlock; - - This method may be used to explicitly release a lock that is - aquired. In most cases, it is not necessary to call unlock directly - since it will implicitly be called when the object leaves whatever - scope it is in. + This method may be used to explicitly release a lock that is aquired. In + most cases, it is not necessary to call unlock directly since it will + implicitly be called when the object leaves whatever scope it is in. uncache + $lock->uncache; + $lock->uncache("otherfile1"); + uncache("otherfile2"); - $lock->uncache; - $lock->uncache("otherfile1"); - uncache("otherfile2"); - - This method is used to freshen up the contents of a file across NFS, - ignoring what is contained in the NFS client cache. It is always - called from within the new constructor on the file that the lock is - being attempted. uncache may be used as either an object method or - as a stand alone subroutine. + This method is used to freshen up the contents of a file across NFS, + ignoring what is contained in the NFS client cache. It is always called + from within the new constructor on the file that the lock is being + attempted. uncache may be used as either an object method or as a stand + alone subroutine. newpid + my $pid = fork; + if (defined $pid) { + # Fork Failed + } elsif ($pid) { + $lock->newpid; # Parent + } else { + $lock->newpid; # Child + } - my $pid = fork; - if (defined $pid) { - # Fork Failed - } elsif ($pid) { - $lock->newpid; # Parent - } else { - $lock->newpid; # Child - } - - If fork() is called after a lock has been aquired, then when the - lock object leaves scope in either the parent or child, it will be - released. This behavior may be inappropriate for your application. - To delegate ownership of the lock from the parent to the child, both - the parent and child process must call the newpid() method after a - successful fork() call. This will prevent the parent from releasing - the lock when unlock is called or when the lock object leaves scope. - This is also useful to allow the parent to fail on subsequent lock - attempts if the child lock is still aquired. + If fork() is called after a lock has been aquired, then when the lock + object leaves scope in either the parent or child, it will be released. + This behavior may be inappropriate for your application. To delegate + ownership of the lock from the parent to the child, both the parent and + child process must call the newpid() method after a successful fork() + call. This will prevent the parent from releasing the lock when unlock + is called or when the lock object leaves scope. This is also useful to + allow the parent to fail on subsequent lock attempts if the child lock + is still aquired. FAILURE - On failure, a global variable, $File::NFSLock::errstr, should be set - and should contain the cause for the failure to get a lock. Useful - primarily for debugging. + On failure, a global variable, $File::NFSLock::errstr, should be set and + should contain the cause for the failure to get a lock. Useful primarily + for debugging. LOCK_EXTENSION - By default File::NFSLock will use a lock file extenstion of - ".NFSLock". This is in a global variable - $File::NFSLock::LOCK_EXTENSION that may be changed to suit other - purposes (such as compatibility in mail systems). + By default File::NFSLock will use a lock file extenstion of ".NFSLock". + This is in a global variable $File::NFSLock::LOCK_EXTENSION that may be + changed to suit other purposes (such as compatibility in mail systems). BUGS - Notify paul@seamons.com or bbb@cpan.org if you spot anything. + Notify paul@seamons.com or bbb@cpan.org if you spot anything. FIFO - - Locks are not necessarily obtained on a first come first serve - basis. Not only does this not seem fair to new processes trying to - obtain a lock, but it may cause a process starvation condition on - heavily locked files. + Locks are not necessarily obtained on a first come first serve basis. + Not only does this not seem fair to new processes trying to obtain a + lock, but it may cause a process starvation condition on heavily locked + files. DIRECTORIES - - Locks cannot be obtained on directory nodes, nor can a directory - node be uncached with the uncache routine because hard links do not - work with directory nodes. Some other algorithm might be used to - uncache a directory, but I am unaware of the best way to do it. The - biggest use I can see would be to avoid NFS cache of directory - modified and last accessed timestamps. + Locks cannot be obtained on directory nodes, nor can a directory node be + uncached with the uncache routine because hard links do not work with + directory nodes. Some other algorithm might be used to uncache a + directory, but I am unaware of the best way to do it. The biggest use I + can see would be to avoid NFS cache of directory modified and last + accessed timestamps. INSTALL - Download and extract tarball before running these commands in its - base directory: + Download and extract tarball before running these commands in its base + directory: - perl Makefile.PL - make - make test - make install + perl Makefile.PL + make + make test + make install - For RPM installation, download tarball before running these commands - in your _topdir: + For RPM installation, download tarball before running these commands in + your _topdir: - rpm -ta SOURCES/File-NFSLock-*.tar.gz - rpm -ih RPMS/noarch/perl-File-NFSLock-*.rpm + rpm -ta SOURCES/File-NFSLock-*.tar.gz + rpm -ih RPMS/noarch/perl-File-NFSLock-*.rpm AUTHORS - Paul T Seamons (paul@seamons.com) - Performed majority of the - programming with copious amounts of input from Rob Brown. + Paul T Seamons (paul@seamons.com) - Performed majority of the + programming with copious amounts of input from Rob Brown. - Rob B Brown (bbb@cpan.org) - In addition to helping in the - programming, Rob Brown provided most of the core testing to make - sure implementation worked properly. He is now the current - maintainer. + Rob B Brown (bbb@cpan.org) - In addition to helping in the programming, + Rob Brown provided most of the core testing to make sure implementation + worked properly. He is now the current maintainer. - Also Mark Overmeer (mark@overmeer.net) - Author of - Mail::Box::Locker, from which some key concepts for File::NFSLock - were taken. + Also Mark Overmeer (mark@overmeer.net) - Author of Mail::Box::Locker, + from which some key concepts for File::NFSLock were taken. - Also Kevin Johnson (kjj@pobox.com) - Author of - Mail::Folder::Maildir, from which Mark Overmeer based - Mail::Box::Locker. + Also Kevin Johnson (kjj@pobox.com) - Author of Mail::Folder::Maildir, + from which Mark Overmeer based Mail::Box::Locker. COPYRIGHT - Copyright (C) 2001 - Paul T Seamons - paul@seamons.com - http://seamons.com/ + Copyright (C) 2001 + Paul T Seamons + paul@seamons.com + http://seamons.com/ - Copyright (C) 2002-2003, - Rob B Brown - bbb@cpan.org + Copyright (C) 2002-2003, + Rob B Brown + bbb@cpan.org - This package may be distributed under the terms of either the - GNU General Public License - or the - Perl Artistic License + This package may be distributed under the terms of either the + GNU General Public License + or the + Perl Artistic License - All rights reserved. + All rights reserved. diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index 9dea38a..a0f180b 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -486,6 +486,8 @@ sub newpid { 1; +=pod + =head1 NAME File::NFSLock - perl module to do NFS (or not) locking @@ -621,6 +623,8 @@ recursion load could exist so do_lock will only recurse 10 times (this is only a problem if the stale_lock_timeout is set too low -- on the order of one or two seconds). +=back + =head1 METHODS After the $lock object is instantiated with new, From c953c71bbb3ebaa3ff28cd1ee00f0690d8282146 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Sat, 26 Jul 2014 09:42:15 -0600 Subject: [PATCH 05/54] Version 1.22 Fix RT#86125 --- Changes | 5 +++++ File-NFSLock.spec | 2 +- t/100_load.t | 1 + t/120_single.t | 3 ++- t/200_bl_ex.t | 3 ++- t/210_nb_ex.t | 3 ++- t/220_ex_scope.t | 3 ++- t/230_double.t | 3 ++- t/240_fork.t | 3 ++- t/300_bl_sh.t | 3 ++- t/400_kill.t | 3 ++- t/410_die.t | 3 ++- t/420_crash.t | 3 ++- 13 files changed, 27 insertions(+), 11 deletions(-) diff --git a/Changes b/Changes index 5f0a954..e834d34 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,10 @@ Revision history for Perl extension File::NFSLock. +1.22 Jul 26 09:00 2014 + - Use File::Temp for concurrency compatibility + in test suite, such as HARNESS_OPTIONS=j20 + - Patch RT#86125 and RT#91546 + 1.21 Jul 13 17:00 2011 - Various patches by Chorny at cpan dot org and fREW frioux at gmail dot com: diff --git a/File-NFSLock.spec b/File-NFSLock.spec index abcf4c9..776a21c 100644 --- a/File-NFSLock.spec +++ b/File-NFSLock.spec @@ -1,7 +1,7 @@ # Automatically generated by File-NFSLock.spec.PL %define class File %define subclass NFSLock -%define version 1.21 +%define version 1.22 %define release 1 %define defperlver 5.6.1 diff --git a/t/100_load.t b/t/100_load.t index 8c0ed61..7b2461a 100644 --- a/t/100_load.t +++ b/t/100_load.t @@ -6,5 +6,6 @@ use strict; use warnings; use Test::More tests => 1; +use File::Temp qw(tempfile); use_ok 'File::NFSLock'; diff --git a/t/120_single.t b/t/120_single.t index b3fb2b2..3f29a70 100644 --- a/t/120_single.t +++ b/t/120_single.t @@ -3,8 +3,9 @@ use Test::More tests => 2; use File::NFSLock; use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); +use File::Temp qw(tempfile); -my $datafile = "testfile.dat"; +my $datafile = tempfile(); # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/200_bl_ex.t b/t/200_bl_ex.t index 1160cd6..3b812c1 100644 --- a/t/200_bl_ex.t +++ b/t/200_bl_ex.t @@ -2,6 +2,7 @@ use strict; use warnings; +use File::Temp qw(tempfile); use Test::More; if( $^O eq 'MSWin32' ) { @@ -19,7 +20,7 @@ my $n = 50; $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = "testfile.dat"; +my $datafile = tempfile(); # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/210_nb_ex.t b/t/210_nb_ex.t index 55e9fac..31ae71d 100644 --- a/t/210_nb_ex.t +++ b/t/210_nb_ex.t @@ -1,5 +1,6 @@ use strict; use warnings; +use File::Temp qw(tempfile); # Non-Blocking Exclusive Lock Test @@ -9,7 +10,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = "testfile.dat"; +my $datafile = tempfile(); # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/220_ex_scope.t b/t/220_ex_scope.t index 43be1c4..07cfc55 100644 --- a/t/220_ex_scope.t +++ b/t/220_ex_scope.t @@ -11,6 +11,7 @@ use strict; use warnings; +use File::Temp qw(tempfile); use Test::More; if( $^O eq 'MSWin32' ) { @@ -24,7 +25,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = "testfile.dat"; +my $datafile = tempfile(); # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/230_double.t b/t/230_double.t index 42016e1..e626325 100644 --- a/t/230_double.t +++ b/t/230_double.t @@ -5,6 +5,7 @@ use strict; use warnings; +use File::Temp qw(tempfile); use Test::More tests => 5; use File::NFSLock; @@ -12,7 +13,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); $| = 1; -my $datafile = "testfile.dat"; +my $datafile = tempfile(); # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/240_fork.t b/t/240_fork.t index b0f01ff..d1748c8 100644 --- a/t/240_fork.t +++ b/t/240_fork.t @@ -5,6 +5,7 @@ use strict; use warnings; +use File::Temp qw(tempfile); use Test::More tests => 5; use File::NFSLock; @@ -12,7 +13,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = "testfile.dat"; +my $datafile = tempfile(); # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/300_bl_sh.t b/t/300_bl_sh.t index 1609cdd..27388cb 100644 --- a/t/300_bl_sh.t +++ b/t/300_bl_sh.t @@ -1,6 +1,7 @@ # Blocking Shared Lock Test use strict; use warnings; +use File::Temp qw(tempfile); use Test::More; if( $^O eq 'MSWin32' ) { @@ -18,7 +19,7 @@ my $shared_delay = 5; $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = "testfile.dat"; +my $datafile = tempfile(); # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/400_kill.t b/t/400_kill.t index 66d1502..8f522fe 100644 --- a/t/400_kill.t +++ b/t/400_kill.t @@ -2,6 +2,7 @@ use strict; use warnings; +use File::Temp qw(tempfile); use Test::More tests => 10; use File::NFSLock; @@ -9,7 +10,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = "testfile.dat"; +my $datafile = tempfile(); # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/410_die.t b/t/410_die.t index abb4e3f..8595e00 100644 --- a/t/410_die.t +++ b/t/410_die.t @@ -2,6 +2,7 @@ use strict; use warnings; +use File::Temp qw(tempfile); use Test::More tests => 9; use File::NFSLock; @@ -9,7 +10,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = "testfile.dat"; +my $datafile = tempfile(); # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/420_crash.t b/t/420_crash.t index 9559fb3..81ef9f2 100644 --- a/t/420_crash.t +++ b/t/420_crash.t @@ -2,6 +2,7 @@ use strict; use warnings; +use File::Temp qw(tempfile); use Test::More tests => 10; use File::NFSLock; @@ -9,7 +10,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = "testfile.dat"; +my $datafile = tempfile(); # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); From 1c004cc20c04fce85ed995eb4fd4392cd36ddcb9 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Mon, 28 Jul 2014 09:49:34 -0600 Subject: [PATCH 06/54] Bump version 1.23 --- lib/File/NFSLock.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index cf223a9..9ee4b3d 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -32,7 +32,7 @@ our $errstr; use base 'Exporter'; our @EXPORT_OK = qw(uncache); -our $VERSION = '1.22'; +our $VERSION = '1.23'; #Get constants, but without the bloat of #use Fcntl qw(LOCK_SH LOCK_EX LOCK_NB); From 9f52f963376074803ff7aa857fcbbf99bdf8f788 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Mon, 28 Jul 2014 09:53:41 -0600 Subject: [PATCH 07/54] More graceful handle crazy hostnames with weird regex meta characters in it. --- lib/File/NFSLock.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index 9ee4b3d..10def23 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -172,7 +172,7 @@ sub new { my $try_lock_exclusive = !($self->{lock_type} & LOCK_SH); while(defined(my $line=<$fh>)){ - if ($line =~ /^$HOSTNAME (-?\d+) /) { + if ($line =~ /^\Q$HOSTNAME\E (-?\d+) /) { my $pid = $1; if ($pid == $$) { # This is me. push @mine, $line; @@ -202,7 +202,7 @@ sub new { seek ($fh, 0, 0); my $content = ''; while(defined(my $line=<$fh>)){ - if ($line =~ /^$HOSTNAME (-?\d+) /) { + if ($line =~ /^\Q$HOSTNAME\E (-?\d+) /) { my $pid = $1; next if (!kill 0, $pid); # Skip dead locks from this host } From c81fad8b3f6ab17e3360ae840e9fc669c4b3b785 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Mon, 28 Jul 2014 11:08:24 -0600 Subject: [PATCH 08/54] RT#84658 discovered and reported and patch by Yann Rouillard: Avoid gleefully double removing possibly valid lockfile when ->unlock is explicitly called and then DESTROY is implicity called. --- lib/File/NFSLock.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index 10def23..57ca254 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -273,9 +273,9 @@ sub unlock ($) { if (!$self->{unlocked}) { unlink( $self->{rand_file} ) if -e $self->{rand_file}; if( $self->{lock_type} & LOCK_SH ){ - return $self->do_unlock_shared; + $self->do_unlock_shared; }else{ - return $self->do_unlock; + $self->do_unlock; } $self->{unlocked} = 1; foreach my $signal (@CATCH_SIGS) { From f570006dd8826fe558fa023512dea1d767f84d3a Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Mon, 28 Jul 2014 11:13:12 -0600 Subject: [PATCH 09/54] Patch RT#84658 by Yann Rouillard: Avoid gleefully double removing valid lockfile when ->unlock is explicitly called. --- lib/File/NFSLock.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index 57ca254..d878cb7 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -63,7 +63,7 @@ my $graceful_sig = sub { print STDERR "Received SIG$_[0]\n" if @_; # Perl's exit should safely DESTROY any objects # still "alive" before calling the real _exit(). - exit; + exit 1; }; our @CATCH_SIGS = qw(TERM INT); From 69ffbb6901d8784237a0633913c6bd290348c654 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Mon, 28 Jul 2014 11:13:52 -0600 Subject: [PATCH 10/54] Revision 1.23 --- Changes | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/Changes b/Changes index e834d34..714f807 100644 --- a/Changes +++ b/Changes @@ -1,9 +1,19 @@ Revision history for Perl extension File::NFSLock. +1.23 Jul 28 11:00 2014 + - More gracefully handle arbitrary hostnames. + - Patch RT#84658 by Yann Rouillard: + - Avoid gleefully double removing valid lockfile + when ->unlock is explicitly called. + - Patch RT# by cpan at danonline.net: + - Fixed $graceful_sig to exit with non-zero to + more closely match stock signal handlers. + 1.22 Jul 26 09:00 2014 + - Reported by Kent Fredric and Karen Etheridge: + - Patch RT#86125 and RT#91546 - Use File::Temp for concurrency compatibility in test suite, such as HARNESS_OPTIONS=j20 - - Patch RT#86125 and RT#91546 1.21 Jul 13 17:00 2011 - Various patches by Chorny at cpan dot org From fa7d019314a3c5a622492ec34f7a70e936f0ec42 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Mon, 28 Jul 2014 11:19:37 -0600 Subject: [PATCH 11/54] Version 1.23 --- File-NFSLock.spec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/File-NFSLock.spec b/File-NFSLock.spec index 776a21c..3d4be0a 100644 --- a/File-NFSLock.spec +++ b/File-NFSLock.spec @@ -1,7 +1,7 @@ # Automatically generated by File-NFSLock.spec.PL %define class File %define subclass NFSLock -%define version 1.22 +%define version 1.23 %define release 1 %define defperlver 5.6.1 From 7dcabaa4113dc778f7e12b36339ddfca3c3e7f54 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Mon, 28 Jul 2014 11:44:52 -0600 Subject: [PATCH 12/54] Bump version 1.24 --- lib/File/NFSLock.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index d878cb7..9a4b8ff 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -32,7 +32,7 @@ our $errstr; use base 'Exporter'; our @EXPORT_OK = qw(uncache); -our $VERSION = '1.23'; +our $VERSION = '1.24'; #Get constants, but without the bloat of #use Fcntl qw(LOCK_SH LOCK_EX LOCK_NB); From f8b5f3ca4957ea5eec7bb164a897d7333c027932 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Mon, 28 Jul 2014 11:49:30 -0600 Subject: [PATCH 13/54] Bump version 1.24 --- File-NFSLock.spec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/File-NFSLock.spec b/File-NFSLock.spec index 3d4be0a..179ae1b 100644 --- a/File-NFSLock.spec +++ b/File-NFSLock.spec @@ -1,7 +1,7 @@ # Automatically generated by File-NFSLock.spec.PL %define class File %define subclass NFSLock -%define version 1.23 +%define version 1.24 %define release 1 %define defperlver 5.6.1 From 84d5f8d03f03d8f355da7a35b27684b4ecf000f7 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Mon, 28 Jul 2014 11:50:04 -0600 Subject: [PATCH 14/54] RT#88520 Thanks David Steinbrunner: Fix typos --- README | 10 +++++----- lib/File/NFSLock.pm | 10 +++++----- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/README b/README index 229b82b..001c8cf 100644 --- a/README +++ b/README @@ -125,8 +125,8 @@ METHODS unlock $lock->unlock; - This method may be used to explicitly release a lock that is aquired. In - most cases, it is not necessary to call unlock directly since it will + This method may be used to explicitly release a lock that is acquired. + In most cases, it is not necessary to call unlock directly since it will implicitly be called when the object leaves whatever scope it is in. uncache @@ -150,7 +150,7 @@ METHODS $lock->newpid; # Child } - If fork() is called after a lock has been aquired, then when the lock + If fork() is called after a lock has been acquired, then when the lock object leaves scope in either the parent or child, it will be released. This behavior may be inappropriate for your application. To delegate ownership of the lock from the parent to the child, both the parent and @@ -158,7 +158,7 @@ METHODS call. This will prevent the parent from releasing the lock when unlock is called or when the lock object leaves scope. This is also useful to allow the parent to fail on subsequent lock attempts if the child lock - is still aquired. + is still acquired. FAILURE On failure, a global variable, $File::NFSLock::errstr, should be set and @@ -166,7 +166,7 @@ FAILURE for debugging. LOCK_EXTENSION - By default File::NFSLock will use a lock file extenstion of ".NFSLock". + By default File::NFSLock will use a lock file extension of ".NFSLock". This is in a global variable $File::NFSLock::LOCK_EXTENSION that may be changed to suit other purposes (such as compatibility in mail systems). diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index 9a4b8ff..ed2c11c 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -258,7 +258,7 @@ sub new { ### clear up the NFS cache $self->uncache; - ### Yes, the lock has been aquired. + ### Yes, the lock has been acquired. delete $self->{unlocked}; return $self; @@ -636,7 +636,7 @@ additional functionality. $lock->unlock; This method may be used to explicitly release a lock -that is aquired. In most cases, it is not necessary +that is acquired. In most cases, it is not necessary to call unlock directly since it will implicitly be called when the object leaves whatever scope it is in. @@ -664,7 +664,7 @@ object method or as a stand alone subroutine. $lock->newpid; # Child } -If fork() is called after a lock has been aquired, +If fork() is called after a lock has been acquired, then when the lock object leaves scope in either the parent or child, it will be released. This behavior may be inappropriate for your application. @@ -675,7 +675,7 @@ fork() call. This will prevent the parent from releasing the lock when unlock is called or when the lock object leaves scope. This is also useful to allow the parent to fail on subsequent -lock attempts if the child lock is still aquired. +lock attempts if the child lock is still acquired. =head1 FAILURE @@ -684,7 +684,7 @@ contain the cause for the failure to get a lock. Useful primarily for debugging =head1 LOCK_EXTENSION -By default File::NFSLock will use a lock file extenstion of ".NFSLock". This is +By default File::NFSLock will use a lock file extension of ".NFSLock". This is in a global variable $File::NFSLock::LOCK_EXTENSION that may be changed to suit other purposes (such as compatibility in mail systems). From dab7a163afec7fd51b8a4c01515d6612badbf3fa Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Mon, 28 Jul 2014 12:37:30 -0600 Subject: [PATCH 15/54] RT#88520 Thanks David Steinbrunner: Fix typos --- t/230_double.t | 2 +- t/300_bl_sh.t | 2 +- t/400_kill.t | 2 +- t/410_die.t | 4 ++-- t/420_crash.t | 4 ++-- 5 files changed, 7 insertions(+), 7 deletions(-) diff --git a/t/230_double.t b/t/230_double.t index e626325..38bb6c2 100644 --- a/t/230_double.t +++ b/t/230_double.t @@ -1,6 +1,6 @@ # Exclusive Double Lock Test # -# This tests to make sure the same process can aquire +# This tests to make sure the same process can acquire # an exclusive lock multiple times for the same file. use strict; diff --git a/t/300_bl_sh.t b/t/300_bl_sh.t index 27388cb..5b6b7ab 100644 --- a/t/300_bl_sh.t +++ b/t/300_bl_sh.t @@ -122,7 +122,7 @@ my ($rd3, $wr3); ok (pipe($rd3, $wr3)); # Wait a few seconds less than if all locks were -# aquired asyncronously to ensure that they overlap. +# acquired asyncronously to ensure that they overlap. alarm($m*$shared_delay-2); for (my $i = 0; $i < $m ; $i++) { diff --git a/t/400_kill.t b/t/400_kill.t index 8f522fe..03d8bd9 100644 --- a/t/400_kill.t +++ b/t/400_kill.t @@ -71,7 +71,7 @@ ok (wait); my ($rd2, $wr2); ok (pipe($rd2, $wr2)); # Connected pipe for child2 if (!fork) { - # The last lock died, so this should aquire fine. + # The last lock died, so this should acquire fine. my $lock = new File::NFSLock { file => $datafile, lock_type => LOCK_EX, diff --git a/t/410_die.t b/t/410_die.t index 8595e00..89ead20 100644 --- a/t/410_die.t +++ b/t/410_die.t @@ -43,7 +43,7 @@ if (!$pid) { print $fh "exclusive\n"; close $fh; open(STDERR,">/dev/null"); - die "I will die while lock is still aquired"; + die "I will die while lock is still acquired"; } die "Lock failed!"; } @@ -67,7 +67,7 @@ ok (wait); my ($rd2, $wr2); ok (pipe($rd2, $wr2)); # Connected pipe for child2 if (!fork) { - # The last lock died, so this should aquire fine. + # The last lock died, so this should acquire fine. my $lock = new File::NFSLock { file => $datafile, lock_type => LOCK_EX, diff --git a/t/420_crash.t b/t/420_crash.t index 81ef9f2..ccc88a5 100644 --- a/t/420_crash.t +++ b/t/420_crash.t @@ -59,7 +59,7 @@ close ($rd1); # test 4 ok ($child1_lock); -# Pretend like the box crashed rudely while the lock is aquired +# Pretend like the box crashed rudely while the lock is acquired # test 5 ok (kill "KILL", $pid); @@ -71,7 +71,7 @@ ok (wait); my ($rd2, $wr2); ok (pipe($rd2, $wr2)); # Connected pipe for child2 if (!fork) { - # The last lock died, so this should aquire fine. + # The last lock died, so this should acquire fine. my $lock = new File::NFSLock { file => $datafile, lock_type => LOCK_EX, From 280b5a9b38c6810af19820116421a068c20537eb Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Wed, 30 Jul 2014 11:00:04 -0600 Subject: [PATCH 16/54] Fix RT#61258 --- Changes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Changes b/Changes index 714f807..9a60d6a 100644 --- a/Changes +++ b/Changes @@ -5,7 +5,7 @@ Revision history for Perl extension File::NFSLock. - Patch RT#84658 by Yann Rouillard: - Avoid gleefully double removing valid lockfile when ->unlock is explicitly called. - - Patch RT# by cpan at danonline.net: + - Patch RT#61258 by cpan at danonline.net: - Fixed $graceful_sig to exit with non-zero to more closely match stock signal handlers. From e567d53b3dce6676c9c9997e189ed8c36e1cd0e9 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Wed, 30 Jul 2014 14:00:38 -0600 Subject: [PATCH 17/54] Fixed race condition to prevent a newly acquired lock from being prematurely released by the crashed lock detection cleanup process. --- lib/File/NFSLock.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index ed2c11c..3527ac4 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -216,8 +216,8 @@ sub new { truncate $fh, length($content); close $fh; }else{ - close $fh; unlink $self->{lock_file}; + close $fh; } ### No "dead" or stale locks found. From 0a0c16625536b070b735592e715b9868791dea8b Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Thu, 31 Jul 2014 07:04:06 -0600 Subject: [PATCH 18/54] Version 1.24 --- Changes | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Changes b/Changes index 9a60d6a..5926726 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,9 @@ Revision history for Perl extension File::NFSLock. +1.24 Jul 30 14:00 2014 + - Fixed a race condition in crash recovery. + - RT#88520 Thanks David Steinbrunner: Fix typos + 1.23 Jul 28 11:00 2014 - More gracefully handle arbitrary hostnames. - Patch RT#84658 by Yann Rouillard: From 425bce5be6babfae3c5eb3d959f5dc2367975bc7 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Thu, 31 Jul 2014 07:13:49 -0600 Subject: [PATCH 19/54] Bump version to 1.25 --- lib/File/NFSLock.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index 3527ac4..515fb80 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -32,7 +32,7 @@ our $errstr; use base 'Exporter'; our @EXPORT_OK = qw(uncache); -our $VERSION = '1.24'; +our $VERSION = '1.25'; #Get constants, but without the bloat of #use Fcntl qw(LOCK_SH LOCK_EX LOCK_NB); From ffbd0428cf24a547f90864a9b3c83b461d17faa4 Mon Sep 17 00:00:00 2001 From: Christian Walde Date: Sat, 1 Nov 2014 16:31:13 +0100 Subject: [PATCH 20/54] fix tempfile usage in tests to actually get the temp filename, instead of writing to "GLOB(...)" in CWD --- t/120_single.t | 2 +- t/200_bl_ex.t | 2 +- t/210_nb_ex.t | 2 +- t/220_ex_scope.t | 2 +- t/230_double.t | 2 +- t/240_fork.t | 2 +- t/300_bl_sh.t | 2 +- t/400_kill.t | 2 +- t/410_die.t | 2 +- t/420_crash.t | 2 +- 10 files changed, 10 insertions(+), 10 deletions(-) diff --git a/t/120_single.t b/t/120_single.t index 3f29a70..df3eac9 100644 --- a/t/120_single.t +++ b/t/120_single.t @@ -5,7 +5,7 @@ use File::NFSLock; use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); use File::Temp qw(tempfile); -my $datafile = tempfile(); +my ( undef, $datafile ) = tempfile(); # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/200_bl_ex.t b/t/200_bl_ex.t index 3b812c1..9fd94d4 100644 --- a/t/200_bl_ex.t +++ b/t/200_bl_ex.t @@ -20,7 +20,7 @@ my $n = 50; $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = tempfile(); +my ( undef, $datafile ) = tempfile(); # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/210_nb_ex.t b/t/210_nb_ex.t index 31ae71d..fb85d37 100644 --- a/t/210_nb_ex.t +++ b/t/210_nb_ex.t @@ -10,7 +10,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = tempfile(); +my ( undef, $datafile ) = tempfile(); # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/220_ex_scope.t b/t/220_ex_scope.t index 07cfc55..e30678c 100644 --- a/t/220_ex_scope.t +++ b/t/220_ex_scope.t @@ -25,7 +25,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = tempfile(); +my ( undef, $datafile ) = tempfile(); # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/230_double.t b/t/230_double.t index 38bb6c2..cb3fb8c 100644 --- a/t/230_double.t +++ b/t/230_double.t @@ -13,7 +13,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); $| = 1; -my $datafile = tempfile(); +my ( undef, $datafile ) = tempfile(); # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/240_fork.t b/t/240_fork.t index d1748c8..02c5ae6 100644 --- a/t/240_fork.t +++ b/t/240_fork.t @@ -13,7 +13,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = tempfile(); +my ( undef, $datafile ) = tempfile(); # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/300_bl_sh.t b/t/300_bl_sh.t index 5b6b7ab..5a2028b 100644 --- a/t/300_bl_sh.t +++ b/t/300_bl_sh.t @@ -19,7 +19,7 @@ my $shared_delay = 5; $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = tempfile(); +my ( undef, $datafile ) = tempfile(); # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/400_kill.t b/t/400_kill.t index 03d8bd9..880c73c 100644 --- a/t/400_kill.t +++ b/t/400_kill.t @@ -10,7 +10,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = tempfile(); +my ( undef, $datafile ) = tempfile(); # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/410_die.t b/t/410_die.t index 89ead20..e7982f8 100644 --- a/t/410_die.t +++ b/t/410_die.t @@ -10,7 +10,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = tempfile(); +my ( undef, $datafile ) = tempfile(); # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/420_crash.t b/t/420_crash.t index ccc88a5..61bf51a 100644 --- a/t/420_crash.t +++ b/t/420_crash.t @@ -10,7 +10,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = tempfile(); +my ( undef, $datafile ) = tempfile(); # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); From 296f663ff2d076c35ba9b838be3a128b8cfe50c7 Mon Sep 17 00:00:00 2001 From: Christian Walde Date: Sat, 1 Nov 2014 16:31:56 +0100 Subject: [PATCH 21/54] on windows files open by a process have mandatory locks, so they cannot be deleted before the handles are closed --- lib/File/NFSLock.pm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index 515fb80..8286168 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -215,6 +215,9 @@ sub new { print $fh $content; truncate $fh, length($content); close $fh; + }elsif($^O eq "MSWin32"){ + close $fh; + unlink $self->{lock_file}; }else{ unlink $self->{lock_file}; close $fh; From d416c251500d66b167a8e699726296e60458b755 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Fri, 7 Nov 2014 11:35:18 -0700 Subject: [PATCH 22/54] Fix tempfile syntax --- t/120_single.t | 2 +- t/200_bl_ex.t | 2 +- t/210_nb_ex.t | 2 +- t/220_ex_scope.t | 2 +- t/230_double.t | 2 +- t/240_fork.t | 2 +- t/300_bl_sh.t | 2 +- t/400_kill.t | 2 +- t/410_die.t | 2 +- t/420_crash.t | 2 +- 10 files changed, 10 insertions(+), 10 deletions(-) diff --git a/t/120_single.t b/t/120_single.t index df3eac9..1628fd6 100644 --- a/t/120_single.t +++ b/t/120_single.t @@ -5,7 +5,7 @@ use File::NFSLock; use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); use File::Temp qw(tempfile); -my ( undef, $datafile ) = tempfile(); +my $datafile = (tempfile)[1]; # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/200_bl_ex.t b/t/200_bl_ex.t index 9fd94d4..2109c22 100644 --- a/t/200_bl_ex.t +++ b/t/200_bl_ex.t @@ -20,7 +20,7 @@ my $n = 50; $| = 1; # Buffer must be autoflushed because of fork() below. -my ( undef, $datafile ) = tempfile(); +my $datafile = (tempfile)[1]; # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/210_nb_ex.t b/t/210_nb_ex.t index fb85d37..2915782 100644 --- a/t/210_nb_ex.t +++ b/t/210_nb_ex.t @@ -10,7 +10,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my ( undef, $datafile ) = tempfile(); +my $datafile = (tempfile)[1]; # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/220_ex_scope.t b/t/220_ex_scope.t index e30678c..173484f 100644 --- a/t/220_ex_scope.t +++ b/t/220_ex_scope.t @@ -25,7 +25,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my ( undef, $datafile ) = tempfile(); +my $datafile = (tempfile)[1]; # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/230_double.t b/t/230_double.t index cb3fb8c..3a63433 100644 --- a/t/230_double.t +++ b/t/230_double.t @@ -13,7 +13,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); $| = 1; -my ( undef, $datafile ) = tempfile(); +my $datafile = (tempfile)[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/240_fork.t b/t/240_fork.t index 02c5ae6..7b9678b 100644 --- a/t/240_fork.t +++ b/t/240_fork.t @@ -13,7 +13,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my ( undef, $datafile ) = tempfile(); +my $datafile = (tempfile)[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/300_bl_sh.t b/t/300_bl_sh.t index 5a2028b..920a9ae 100644 --- a/t/300_bl_sh.t +++ b/t/300_bl_sh.t @@ -19,7 +19,7 @@ my $shared_delay = 5; $| = 1; # Buffer must be autoflushed because of fork() below. -my ( undef, $datafile ) = tempfile(); +my $datafile = (tempfile)[1]; # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/400_kill.t b/t/400_kill.t index 880c73c..c39340d 100644 --- a/t/400_kill.t +++ b/t/400_kill.t @@ -10,7 +10,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); $| = 1; # Buffer must be autoflushed because of fork() below. -my ( undef, $datafile ) = tempfile(); +my $datafile = (tempfile)[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/410_die.t b/t/410_die.t index e7982f8..6e9bfee 100644 --- a/t/410_die.t +++ b/t/410_die.t @@ -10,7 +10,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); $| = 1; # Buffer must be autoflushed because of fork() below. -my ( undef, $datafile ) = tempfile(); +my $datafile = (tempfile)[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/420_crash.t b/t/420_crash.t index 61bf51a..9fee6a5 100644 --- a/t/420_crash.t +++ b/t/420_crash.t @@ -10,7 +10,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); $| = 1; # Buffer must be autoflushed because of fork() below. -my ( undef, $datafile ) = tempfile(); +my $datafile = (tempfile)[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); From f3922e6098a9b42f304bc4bb09922583c8b0fc04 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Fri, 7 Nov 2014 11:36:13 -0700 Subject: [PATCH 23/54] It's fairly safe to close the file handle before removing since the lock_file has been already exclusive locked using File::NFSLock This allows it to be more compatible with Win32 perl. --- lib/File/NFSLock.pm | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index 8286168..a06a970 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -215,12 +215,9 @@ sub new { print $fh $content; truncate $fh, length($content); close $fh; - }elsif($^O eq "MSWin32"){ - close $fh; - unlink $self->{lock_file}; }else{ - unlink $self->{lock_file}; close $fh; + unlink $self->{lock_file}; } ### No "dead" or stale locks found. From 34ce86313859da4da26b48905376b9fd72e3a756 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Fri, 7 Nov 2014 11:56:06 -0700 Subject: [PATCH 24/54] RT#42122 Add tests with TAINT enabled. --- t/130_taint.t | 49 +++++++++++++++++++++ t/430_taint.t | 115 ++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 164 insertions(+) create mode 100644 t/130_taint.t create mode 100644 t/430_taint.t diff --git a/t/130_taint.t b/t/130_taint.t new file mode 100644 index 0000000..e561123 --- /dev/null +++ b/t/130_taint.t @@ -0,0 +1,49 @@ +#!/usr/bin/perl -T -w + +# Blocking Exclusive test within a single process with Taint enabled + +use Test::More tests => 2; +use File::NFSLock; +use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); +use File::Temp qw(tempfile); + +my $datafile = (tempfile)[1]; + +# Create a blank file +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); +ok (-e $datafile && !-s _); +# Wipe any old stale locks +unlink "$datafile$File::NFSLock::LOCK_EXTENSION"; + +# Single process trying to count to $n +my $n = 20; + +for (my $i = 0; $i < $n ; $i++) { + my $lock = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX, + }; + sysopen(my $fh, $datafile, O_RDWR); + + # Read the current value + my $count = <$fh>; + # Increment it + $count ++; + + # And put it back + seek ($fh,0,0); + print $fh "$count\n"; + close $fh; +} + +# Load up whatever the file says now +sysopen($fh, $datafile, O_RDONLY); +$_ = <$fh>; +close $fh; +chomp; +# It should be the same as the number of times it looped +is $n, $_; + +# Wipe the temporary file +unlink $datafile; diff --git a/t/430_taint.t b/t/430_taint.t new file mode 100644 index 0000000..30ecf90 --- /dev/null +++ b/t/430_taint.t @@ -0,0 +1,115 @@ +#!/usr/bin/perl -T -w + +# Lock Test with abnormal or abrupt termination (System crash or SIGKILL) with Taint + +use strict; +use warnings; +use File::Temp qw(tempfile); + +use Test::More tests => 10; +use File::NFSLock; +use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); + +$| = 1; # Buffer must be autoflushed because of fork() below. + +my $datafile = (tempfile)[1]; + +# Wipe lock file in case it exists +unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); + +# Create a blank file +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); +# test 1 +ok (-e $datafile && !-s _); + + +# test 2 +my ($rd1, $wr1); +ok (pipe($rd1, $wr1)); # Connected pipe for child1 + +my $pid = fork; +if (!$pid) { + # Child #1 process + # Obtain exclusive lock + my $lock = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX, + }; + open(STDERR,">/dev/null"); + print $wr1 !!$lock; # Send boolean success status down pipe + close($wr1); # Signal to parent that the Blocking lock is done + close($rd1); + if ($lock) { + sleep 10; # hold the lock for a moment + sysopen(my $fh, $datafile, O_RDWR | O_TRUNC); + # And then put a magic word into the file + print $fh "exclusive\n"; + close $fh; + } + exit; +} + +# test 3 +ok 1; # Fork successful +close ($wr1); +# Waiting for child1 to finish its lock status +my $child1_lock = <$rd1>; +close ($rd1); +# Report status of the child1_lock. +# It should have been successful +# test 4 +ok ($child1_lock); + +# Pretend like the box crashed rudely while the lock is acquired +# test 5 +ok (kill "KILL", $pid); + +# Clear the zombie +# test 6 +ok (wait); + +# test 7 +my ($rd2, $wr2); +ok (pipe($rd2, $wr2)); # Connected pipe for child2 +if (!fork) { + # The last lock died, so this should acquire fine. + my $lock = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX, + blocking_timeout => 10, + }; + if ($lock) { + sysopen(my $fh, $datafile, O_RDWR | O_TRUNC); + # Immediately put the magic word into the file + print $fh "lock2\n"; + truncate ($fh, tell $fh); + close $fh; + } + print $wr2 !!$lock; # Send boolean success status down pipe + close($wr2); # Signal to parent that the Blocking lock is done + close($rd2); + exit; # Release this new lock +} +# test 8 +ok 1; # Fork successful +close ($wr2); + +# Waiting for child2 to finish its lock status +my $child2_lock = <$rd2>; +close ($rd2); +# Report status of the child2_lock. +# This should have been successful. +# test 9 +ok ($child2_lock); + +# Load up whatever the file says now +sysopen(my $fh2, $datafile, O_RDONLY); + +$_ = <$fh2>; +# test 10 +ok /lock2/; +close $fh2; + +# Wipe the temporary file +unlink $datafile; From 54e7a09e68dcc2b43ac2adf173ea902b369ec95d Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Fri, 7 Nov 2014 12:05:32 -0700 Subject: [PATCH 25/54] RT#48102 Testing fork()ing with a Shared Lock. --- t/250_fork_sh.t | 84 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 84 insertions(+) create mode 100644 t/250_fork_sh.t diff --git a/t/250_fork_sh.t b/t/250_fork_sh.t new file mode 100644 index 0000000..60d4570 --- /dev/null +++ b/t/250_fork_sh.t @@ -0,0 +1,84 @@ +# Shared Fork Test +# +# This tests the capabilities of fork after lock to +# ensure both parent and child retain the shared lock. + +use strict; +use warnings; +use File::Temp qw(tempfile); + +use Test::More tests => 5; +use File::NFSLock; +use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); + +$| = 1; # Buffer must be autoflushed because of fork() below. + +my $datafile = (tempfile)[1]; + +# Wipe lock file in case it exists +unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); + +# Create a blank file +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); +ok (-e $datafile && !-s _); + +if (1) { + # Forced dummy scope + my $lock1 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_SH, + }; + + ok ($lock1); + + my $pid = fork; + if (!defined $pid) { + die "fork failed!"; + } elsif (!$pid) { + # Child process + + # Test possible race condition + # by making parent reach newpid() + # and attempt relock before child + # even calls newpid() the first time. + sleep 2; + $lock1->newpid; + + # Act busy for a while + sleep 5; + + # Now release lock + exit; + } else { + # Fork worked + ok 1; + # Both parent and child must unlock + # before the lock is truly released. + $lock1->newpid; + } +} +# Lock is out of scope, but +# should still be acquired. + +#sysopen(FH, $datafile, O_RDWR | O_APPEND); +#print FH "lock1\n"; +#close FH; + +# Try to get a non-blocking lock. +# Yes, it is the same process, +# but it should have been delegated +# to the child process. +# This lock should fail. +my $lock2 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX|LOCK_NB, +}; + +ok (!$lock2); + +# Wait for child to finish +ok(wait); + +# Wipe the temporary file +unlink $datafile; From 6d174ff6579fc18ce7375613c6026c1a548d4991 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Fri, 7 Nov 2014 13:02:09 -0700 Subject: [PATCH 26/54] RT#42122 Add tests with TAINT enabled. --- MANIFEST | 2 ++ 1 file changed, 2 insertions(+) diff --git a/MANIFEST b/MANIFEST index cb44dc5..fd70bbf 100644 --- a/MANIFEST +++ b/MANIFEST @@ -9,6 +9,7 @@ examples/lock_test Script used to test on live system t/100_load.t t/110_compare.t t/120_single.t +t/130_taint.t t/200_bl_ex.t t/210_nb_ex.t t/220_ex_scope.t @@ -18,3 +19,4 @@ t/300_bl_sh.t t/400_kill.t t/410_die.t t/420_crash.t +t/430_taint.t From be84831cbb4ac9a2ad76b631e12e7d20cfc242a5 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Fri, 7 Nov 2014 13:04:06 -0700 Subject: [PATCH 27/54] RT#48102 Update tests to reflect new fork behavior. --- MANIFEST | 3 ++- t/{240_fork.t => 240_fork_ex.t} | 37 +++++++++++++++++++++------------ t/250_fork_sh.t | 37 +++++++++++++++++++++------------ 3 files changed, 50 insertions(+), 27 deletions(-) rename t/{240_fork.t => 240_fork_ex.t} (75%) diff --git a/MANIFEST b/MANIFEST index fd70bbf..0dfa375 100644 --- a/MANIFEST +++ b/MANIFEST @@ -14,7 +14,8 @@ t/200_bl_ex.t t/210_nb_ex.t t/220_ex_scope.t t/230_double.t -t/240_fork.t +t/240_fork_ex.t +t/250_fork_sh.t t/300_bl_sh.t t/400_kill.t t/410_die.t diff --git a/t/240_fork.t b/t/240_fork_ex.t similarity index 75% rename from t/240_fork.t rename to t/240_fork_ex.t index 7b9678b..3ab1d32 100644 --- a/t/240_fork.t +++ b/t/240_fork_ex.t @@ -1,13 +1,13 @@ -# Fork Test +# Exclusive Fork Test # # This tests the capabilities of fork after lock to -# allow a parent to delegate the lock to its child. +# ensure both parent and child retain the exclusive lock. use strict; use warnings; use File::Temp qw(tempfile); -use Test::More tests => 5; +use Test::More tests => 6; use File::NFSLock; use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); @@ -23,7 +23,7 @@ sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); close ($fh); ok (-e $datafile && !-s _); -if (1) { +{ # Forced dummy scope my $lock1 = new File::NFSLock { file => $datafile, @@ -61,24 +61,35 @@ if (1) { # Lock is out of scope, but # should still be acquired. -#sysopen(FH, $datafile, O_RDWR | O_APPEND); -#print FH "lock1\n"; -#close FH; - # Try to get a non-blocking lock. # Yes, it is the same process, # but it should have been delegated # to the child process. # This lock should fail. -my $lock2 = new File::NFSLock { - file => $datafile, - lock_type => LOCK_EX|LOCK_NB, -}; +{ + # Forced dummy scope + my $lock2 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX|LOCK_NB, + }; -ok (!$lock2); + ok (!$lock2); +} # Wait for child to finish ok(wait); +# Try again now that the child is done. +# This time it should work. +{ + # Forced dummy scope + my $lock2 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX|LOCK_NB, + }; + + ok($lock2); +} + # Wipe the temporary file unlink $datafile; diff --git a/t/250_fork_sh.t b/t/250_fork_sh.t index 60d4570..e090e6a 100644 --- a/t/250_fork_sh.t +++ b/t/250_fork_sh.t @@ -7,7 +7,7 @@ use strict; use warnings; use File::Temp qw(tempfile); -use Test::More tests => 5; +use Test::More tests => 6; use File::NFSLock; use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); @@ -23,7 +23,7 @@ sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); close ($fh); ok (-e $datafile && !-s _); -if (1) { +{ # Forced dummy scope my $lock1 = new File::NFSLock { file => $datafile, @@ -58,27 +58,38 @@ if (1) { $lock1->newpid; } } -# Lock is out of scope, but -# should still be acquired. - -#sysopen(FH, $datafile, O_RDWR | O_APPEND); -#print FH "lock1\n"; -#close FH; +# Lock is out of scope, but should +# still be acquired by the child. # Try to get a non-blocking lock. # Yes, it is the same process, # but it should have been delegated # to the child process. # This lock should fail. -my $lock2 = new File::NFSLock { - file => $datafile, - lock_type => LOCK_EX|LOCK_NB, -}; +{ + # Forced dummy scope + my $lock2 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX|LOCK_NB, + }; -ok (!$lock2); + ok (!$lock2); +} # Wait for child to finish ok(wait); +# Try again now that the child is done. +# This time it should work. +{ + # Forced dummy scope + my $lock2 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX|LOCK_NB, + }; + + ok($lock2); +} + # Wipe the temporary file unlink $datafile; From a57ed39787dcfc23946a358b7b57f216c11194c4 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Fri, 7 Nov 2014 13:07:00 -0700 Subject: [PATCH 28/54] RT#48102 Update documentation to reflect the new newpid() behavior for fork() Mention github repo --- README | 19 +++++++++++++------ lib/File/NFSLock.pm | 23 +++++++++++++++-------- 2 files changed, 28 insertions(+), 14 deletions(-) diff --git a/README b/README index 001c8cf..05be346 100644 --- a/README +++ b/README @@ -152,10 +152,10 @@ METHODS If fork() is called after a lock has been acquired, then when the lock object leaves scope in either the parent or child, it will be released. - This behavior may be inappropriate for your application. To delegate - ownership of the lock from the parent to the child, both the parent and - child process must call the newpid() method after a successful fork() - call. This will prevent the parent from releasing the lock when unlock + This behavior may be inappropriate for your application. To ensure both + processes maintain ownership of the lock, both the parent and child + process must call the newpid() method after a successful fork() call. + This will prevent the parent from releasing the child's lock when unlock is called or when the lock object leaves scope. This is also useful to allow the parent to fail on subsequent lock attempts if the child lock is still acquired. @@ -170,8 +170,15 @@ LOCK_EXTENSION This is in a global variable $File::NFSLock::LOCK_EXTENSION that may be changed to suit other purposes (such as compatibility in mail systems). +REPO + The source is now on github: + + git clone https://github.com/hookbot/File-NFSLock + BUGS - Notify paul@seamons.com or bbb@cpan.org if you spot anything. + If you spot anything, please submit a pull request on github and/or + submit a ticket with RT: + https://rt.cpan.org/Dist/Display.html?Queue=File-NFSLock FIFO Locks are not necessarily obtained on a first come first serve basis. @@ -222,7 +229,7 @@ COPYRIGHT paul@seamons.com http://seamons.com/ - Copyright (C) 2002-2003, + Copyright (C) 2002-2014, Rob B Brown bbb@cpan.org diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index a06a970..cc9a184 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -668,11 +668,11 @@ If fork() is called after a lock has been acquired, then when the lock object leaves scope in either the parent or child, it will be released. This behavior may be inappropriate for your application. -To delegate ownership of the lock from the parent -to the child, both the parent and child process -must call the newpid() method after a successful -fork() call. This will prevent the parent from -releasing the lock when unlock is called or when +To ensure both processes maintain ownership of the +lock, both the parent and child process must call +the newpid() method after a successful fork() call. +This will prevent the parent from releasing the +child's lock when unlock is called or when the lock object leaves scope. This is also useful to allow the parent to fail on subsequent lock attempts if the child lock is still acquired. @@ -688,9 +688,17 @@ By default File::NFSLock will use a lock file extension of ".NFSLock". This is in a global variable $File::NFSLock::LOCK_EXTENSION that may be changed to suit other purposes (such as compatibility in mail systems). +=head1 REPO + +The source is now on github: + +git clone https://github.com/hookbot/File-NFSLock + =head1 BUGS -Notify paul@seamons.com or bbb@cpan.org if you spot anything. +If you spot anything, please submit a pull request on +github and/or submit a ticket with RT: +https://rt.cpan.org/Dist/Display.html?Queue=File-NFSLock =head2 FIFO @@ -698,7 +706,6 @@ Locks are not necessarily obtained on a first come first serve basis. Not only does this not seem fair to new processes trying to obtain a lock, but it may cause a process starvation condition on heavily locked files. - =head2 DIRECTORIES Locks cannot be obtained on directory nodes, nor can a directory node be @@ -746,7 +753,7 @@ from which Mark Overmeer based Mail::Box::Locker. paul@seamons.com http://seamons.com/ - Copyright (C) 2002-2003, + Copyright (C) 2002-2014, Rob B Brown bbb@cpan.org From ac1d82f4a521ddf87846c1cac3a1a70da4e4ac89 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Fri, 7 Nov 2014 13:07:32 -0700 Subject: [PATCH 29/54] Close Version 1.25 --- Changes | 11 +++++++++++ File-NFSLock.spec | 2 +- 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/Changes b/Changes index 5926726..2a1b3ed 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,16 @@ Revision history for Perl extension File::NFSLock. +1.25 Nov 07 13:00 2014 + - RT#99431 Report by Nathan Glenn: + - Fixed tempfile syntax by Christian Walde. + - Fixed Win32 Shared Lock by Christian Walde. + - RT#42122 Report by converter at cpan.org: + - Add tests to help debug Taint issues + - RT#48102 Report by Todd Foggoa: + - More gracefully handle fork() to behave like + Linux by sharing the lock between both parent + and child processes when ->newpid() is called. + 1.24 Jul 30 14:00 2014 - Fixed a race condition in crash recovery. - RT#88520 Thanks David Steinbrunner: Fix typos diff --git a/File-NFSLock.spec b/File-NFSLock.spec index 179ae1b..0520f27 100644 --- a/File-NFSLock.spec +++ b/File-NFSLock.spec @@ -1,7 +1,7 @@ # Automatically generated by File-NFSLock.spec.PL %define class File %define subclass NFSLock -%define version 1.24 +%define version 1.25 %define release 1 %define defperlver 5.6.1 From b2190c94bb8a534d09058b3ff89aa1a623662109 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Fri, 7 Nov 2014 13:15:08 -0700 Subject: [PATCH 30/54] Bump to version 1.26 --- lib/File/NFSLock.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index cc9a184..1a3479b 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -32,7 +32,7 @@ our $errstr; use base 'Exporter'; our @EXPORT_OK = qw(uncache); -our $VERSION = '1.25'; +our $VERSION = '1.26'; #Get constants, but without the bloat of #use Fcntl qw(LOCK_SH LOCK_EX LOCK_NB); From 644fbaa1a7aa1155b4e7b5711d2dea31d6cac9df Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Sat, 8 Nov 2014 20:05:14 -0700 Subject: [PATCH 31/54] Implement #1 and #2 suggestions explained in RT#48102 Make ->newpid method convert itself into a Shared Lock within both parent and child. --- lib/File/NFSLock.pm | 38 +++++++++++++++++++++++++++----------- 1 file changed, 27 insertions(+), 11 deletions(-) diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index 1a3479b..ad2d71a 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -456,26 +456,42 @@ sub newpid { select(undef,undef,undef,0.1); } - # Fake the parent into thinking it is already - # unlocked because the child will take care of it. - $self->{unlocked} = 1; + # Child finished running newpid() and acquired shared lock + # So now we're safe to continue without risk of + # blowing away the lock prematurely. + unless ( $self->{lock_type} & LOCK_SH ) { + # If it's not already a SHared lock, then + # just switch it from EXclusive to SHared + # from this process's point of view. + # Then the child will still hold the lock + # if the parent releases it first. + # (Don't chmod the lock file.) + $self->{lock_type} |= LOCK_SH; + } } else { # This is the new child - # The lock_line found in the lock_file contents - # must be modified to reflect the new pid. - # Fix lock_pid to the new pid. $self->{lock_pid} = $$; - # Backup the old lock_line. - my $old_line = $self->{lock_line}; + + # We can leave the old lock_line in the lock_file + # But we need to add the new lock_line for this pid. + # Clear lock_line to create a fresh one. delete $self->{lock_line}; # Append a new lock_line to the lock_file. $self->create_magic($self->{lock_file}); - # Remove the old lock_line from lock_file. - local $self->{lock_line} = $old_line; - $self->do_unlock_shared; + + unless ( $self->{lock_type} & LOCK_SH ) { + # If it's not already a SHared lock, then + # just switch it from EXclusive to SHared + # from this process's point of view. + # Then the parent will still hold the lock + # if this child releases it first. + # (Don't chmod the lock file.) + $self->{lock_type} |= LOCK_SH; + } + # Create signal file to notify parent that # the lock_line entry has been delegated. open (my $fh, '>', "$self->{lock_file}.fork"); From feeb53e7597160e1a4e317d5992156b3addbc1a2 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Sat, 8 Nov 2014 20:19:35 -0700 Subject: [PATCH 32/54] Add tests to ensure parent still holds the lock after fork()ing for RT#48102. --- MANIFEST | 2 + t/240_fork_ex.t | 10 ++--- t/241_fork_ex.t | 114 ++++++++++++++++++++++++++++++++++++++++++++++++ t/250_fork_sh.t | 2 +- t/251_fork_sh.t | 114 ++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 236 insertions(+), 6 deletions(-) create mode 100644 t/241_fork_ex.t create mode 100644 t/251_fork_sh.t diff --git a/MANIFEST b/MANIFEST index 0dfa375..19207bf 100644 --- a/MANIFEST +++ b/MANIFEST @@ -15,7 +15,9 @@ t/210_nb_ex.t t/220_ex_scope.t t/230_double.t t/240_fork_ex.t +t/241_fork_ex.t t/250_fork_sh.t +t/251_fork_sh.t t/300_bl_sh.t t/400_kill.t t/410_die.t diff --git a/t/240_fork_ex.t b/t/240_fork_ex.t index 3ab1d32..d6d58e9 100644 --- a/t/240_fork_ex.t +++ b/t/240_fork_ex.t @@ -1,7 +1,7 @@ # Exclusive Fork Test # # This tests the capabilities of fork after lock to -# ensure both parent and child retain the exclusive lock. +# ensure child retains exclusive lock even if parent releases it. use strict; use warnings; @@ -53,13 +53,13 @@ ok (-e $datafile && !-s _); } else { # Fork worked ok 1; - # Avoid releasing lock - # because child should do it. + # Both parent and child must unlock + # before the lock is truly released. $lock1->newpid; } } -# Lock is out of scope, but -# should still be acquired. +# Lock is out of scope, but should +# still be acquired by the child. # Try to get a non-blocking lock. # Yes, it is the same process, diff --git a/t/241_fork_ex.t b/t/241_fork_ex.t new file mode 100644 index 0000000..269c9e5 --- /dev/null +++ b/t/241_fork_ex.t @@ -0,0 +1,114 @@ +# Exclusive Fork Test +# +# This tests the capabilities of fork after lock to +# ensure parent retains exclusive lock even if child releases it. + +use strict; +use warnings; +use File::Temp qw(tempfile); + +use Test::More tests => 6; +use File::NFSLock; +use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); + +$| = 1; # Buffer must be autoflushed because of fork() below. + +my $datafile = (tempfile)[1]; + +# Wipe lock file in case it exists +unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); + +# Create a blank file +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); +ok (-e $datafile && !-s _); + +pipe(my $dad_rd, my $dad_wr); +{ + # Forced dummy scope + my $lock1 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX, + }; + + ok ($lock1); + + my $pid = fork; + if (!defined $pid) { + die "fork failed!"; + } elsif (!$pid) { + # Child process + + # Fork worked + ok 1; + + # Let go of the other side $dad_rd + close $dad_wr; + + # Test possible race condition + # by making parent reach newpid() + # and attempt relock before child + # even calls newpid() the first time. + sleep 2; + $lock1->newpid; + + # Child continues on while parent holds onto the lock... + } else { + # Parent process + + # Notify lock that we've forked. + $lock1->newpid; + + # Parent hangs onto the lock for a bit + sleep 5; + + # Parent finally releases the lock + undef $lock1; + + # And releases $dad_rd to signal the child + # that's the lock should be free. + close $dad_wr; + + # Clear the Child Zombie + wait; + + # Avoid normal "exit" checking plan counts. + require POSIX; + POSIX::_exit(0); + # Don't continue on since the child should have already done the tests. + } +} +# Lock is out of scope, but should +# still be acquired by the parent. + +# Try to get a non-blocking lock. +# Quickly, before the parent releases it. +# This lock should fail. +{ + # Forced dummy scope + my $lock2 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX|LOCK_NB, + }; + + ok(!$lock2); +} + +# Wait for the parent process to release the lock +scalar <$dad_rd>; +ok(1); + +# Try again now that the parent is done. +# This time it should work. +{ + # Forced dummy scope + my $lock2 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX|LOCK_NB, + }; + + ok($lock2); +} + +# Wipe the temporary file +unlink $datafile; diff --git a/t/250_fork_sh.t b/t/250_fork_sh.t index e090e6a..ec14e4b 100644 --- a/t/250_fork_sh.t +++ b/t/250_fork_sh.t @@ -1,7 +1,7 @@ # Shared Fork Test # # This tests the capabilities of fork after lock to -# ensure both parent and child retain the shared lock. +# ensure child retains shared lock even if parent releases it. use strict; use warnings; diff --git a/t/251_fork_sh.t b/t/251_fork_sh.t new file mode 100644 index 0000000..88fa107 --- /dev/null +++ b/t/251_fork_sh.t @@ -0,0 +1,114 @@ +# Shared Fork Test +# +# This tests the capabilities of fork after lock to +# ensure parent retains shared lock even if child releases it. + +use strict; +use warnings; +use File::Temp qw(tempfile); + +use Test::More tests => 6; +use File::NFSLock; +use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); + +$| = 1; # Buffer must be autoflushed because of fork() below. + +my $datafile = (tempfile)[1]; + +# Wipe lock file in case it exists +unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); + +# Create a blank file +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); +ok (-e $datafile && !-s _); + +pipe(my $dad_rd, my $dad_wr); +{ + # Forced dummy scope + my $lock1 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_SH, + }; + + ok ($lock1); + + my $pid = fork; + if (!defined $pid) { + die "fork failed!"; + } elsif (!$pid) { + # Child process + + # Fork worked + ok 1; + + # Let go of the other side $dad_rd + close $dad_wr; + + # Test possible race condition + # by making parent reach newpid() + # and attempt relock before child + # even calls newpid() the first time. + sleep 2; + $lock1->newpid; + + # Child continues on while parent holds onto the lock... + } else { + # Parent process + + # Notify lock that we've forked. + $lock1->newpid; + + # Parent hangs onto the lock for a bit + sleep 5; + + # Parent finally releases the lock + undef $lock1; + + # And releases $dad_rd to signal the child + # that's the lock should be free. + close $dad_wr; + + # Clear the Child Zombie + wait; + + # Avoid normal "exit" checking plan counts. + require POSIX; + POSIX::_exit(0); + # Don't continue on since the child should have already done the tests. + } +} +# Lock is out of scope, but should +# still be acquired by the parent. + +# Try to get a non-blocking lock. +# Quickly, before the parent releases it. +# This lock should fail. +{ + # Forced dummy scope + my $lock2 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX|LOCK_NB, + }; + + ok (!$lock2); +} + +# Wait for the parent process to release the lock +scalar <$dad_rd>; +ok(1); + +# Try again now that the parent is done. +# This time it should work. +{ + # Forced dummy scope + my $lock2 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX|LOCK_NB, + }; + + ok($lock2); +} + +# Wipe the temporary file +unlink $datafile; From 9e3b965542d7807f6eadc325e5ce177572ddf7c3 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Sat, 8 Nov 2014 21:36:25 -0700 Subject: [PATCH 33/54] Add File::NFSLock->fork() convenience method. --- README | 40 +++++++++++++++++++++--------- lib/File/NFSLock.pm | 59 +++++++++++++++++++++++++++++++++------------ 2 files changed, 72 insertions(+), 27 deletions(-) diff --git a/README b/README index 05be346..547e44f 100644 --- a/README +++ b/README @@ -140,25 +140,41 @@ METHODS attempted. uncache may be used as either an object method or as a stand alone subroutine. + fork + my $pid = $lock->fork; + if (!defined $pid) { + # Fork Failed + } elsif ($pid) { + # Parent ... + } else { + # Child ... + } + + fork() is a convenience method that acts just like the normal + CORE::fork() except it safely ensures the lock is retained within both + parent and child processes. WITHOUT this, then when either the parent or + child process releases the lock, then the entire lock will be lost, + allowing external processes to re-acquire a lock on the same file, even + if the other process still has the lock object in scope. This can cause + corruption since both processes might think they have exclusive access + to the file. + newpid my $pid = fork; - if (defined $pid) { + if (!defined $pid) { # Fork Failed } elsif ($pid) { - $lock->newpid; # Parent + $lock->newpid; + # Parent ... } else { - $lock->newpid; # Child + $lock->newpid; + # Child ... } - If fork() is called after a lock has been acquired, then when the lock - object leaves scope in either the parent or child, it will be released. - This behavior may be inappropriate for your application. To ensure both - processes maintain ownership of the lock, both the parent and child - process must call the newpid() method after a successful fork() call. - This will prevent the parent from releasing the child's lock when unlock - is called or when the lock object leaves scope. This is also useful to - allow the parent to fail on subsequent lock attempts if the child lock - is still acquired. + The newpid() synopsis shown above is equivalent to the one used for the + fork() method, but it's not intended to be called directly. It is called + internally by the fork() method. To be safe, it is recommended to use + $lock->fork() from now on. FAILURE On failure, a global variable, $File::NFSLock::errstr, should be set and diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index ad2d71a..169de8d 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -499,6 +499,19 @@ sub newpid { } } +sub fork { + my $self = shift; + # Store fork response. + my $pid = CORE::fork(); + if (defined $pid and !$self->{unlocked}) { + # Fork worked and we really have a lock to deal with + # So upgrade to shared lock across both parent and child + $self->newpid; + } + # Return original fork response + return $pid; +} + 1; @@ -669,29 +682,45 @@ the new constructor on the file that the lock is being attempted. uncache may be used as either an object method or as a stand alone subroutine. +=head2 fork + + my $pid = $lock->fork; + if (!defined $pid) { + # Fork Failed + } elsif ($pid) { + # Parent ... + } else { + # Child ... + } + +fork() is a convenience method that acts just like the normal +CORE::fork() except it safely ensures the lock is retained +within both parent and child processes. WITHOUT this, then when +either the parent or child process releases the lock, then the +entire lock will be lost, allowing external processes to +re-acquire a lock on the same file, even if the other process +still has the lock object in scope. This can cause corruption +since both processes might think they have exclusive access to +the file. + =head2 newpid my $pid = fork; - if (defined $pid) { + if (!defined $pid) { # Fork Failed } elsif ($pid) { - $lock->newpid; # Parent + $lock->newpid; + # Parent ... } else { - $lock->newpid; # Child + $lock->newpid; + # Child ... } -If fork() is called after a lock has been acquired, -then when the lock object leaves scope in either -the parent or child, it will be released. This -behavior may be inappropriate for your application. -To ensure both processes maintain ownership of the -lock, both the parent and child process must call -the newpid() method after a successful fork() call. -This will prevent the parent from releasing the -child's lock when unlock is called or when -the lock object leaves scope. This is also -useful to allow the parent to fail on subsequent -lock attempts if the child lock is still acquired. +The newpid() synopsis shown above is equivalent to the +one used for the fork() method, but it's not intended +to be called directly. It is called internally by the +fork() method. To be safe, it is recommended to use +$lock->fork() from now on. =head1 FAILURE From 0fc13c259ec51392519d040fc274ea663899e17b Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Sat, 8 Nov 2014 21:37:13 -0700 Subject: [PATCH 34/54] Add tests to test the new ->fork() method functionality. --- t/242_fork_ex.t | 88 ++++++++++++++++++++++++++++++++++++++++ t/243_fork_ex.t | 105 ++++++++++++++++++++++++++++++++++++++++++++++++ t/252_fork_sh.t | 88 ++++++++++++++++++++++++++++++++++++++++ t/253_fork_sh.t | 105 ++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 386 insertions(+) create mode 100644 t/242_fork_ex.t create mode 100644 t/243_fork_ex.t create mode 100644 t/252_fork_sh.t create mode 100644 t/253_fork_sh.t diff --git a/t/242_fork_ex.t b/t/242_fork_ex.t new file mode 100644 index 0000000..66c364d --- /dev/null +++ b/t/242_fork_ex.t @@ -0,0 +1,88 @@ +# Exclusive Fork Test +# +# This tests the capabilities of fork after lock to +# ensure child retains exclusive lock even if parent releases it. +# This test uses ->fork() instead of ->newpid() + +use strict; +use warnings; +use File::Temp qw(tempfile); + +use Test::More tests => 6; +use File::NFSLock; +use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); + +$| = 1; # Buffer must be autoflushed because of fork() below. + +my $datafile = (tempfile)[1]; + +# Wipe lock file in case it exists +unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); + +# Create a blank file +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); +ok (-e $datafile && !-s _); + +{ + # Forced dummy scope + my $lock1 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX, + }; + + ok ($lock1); + + my $pid = $lock1->fork; + if (!defined $pid) { + die "fork failed!"; + } elsif (!$pid) { + # Child process + + # Act busy for a while + sleep 5; + + # Now release lock + exit; + } else { + # Fork worked + ok 1; + + # Leaving scope should release only the parent side + } +} +# Lock is out of scope, but should +# still be acquired by the child. + +# Try to get a non-blocking lock. +# Yes, it is the same process, +# but it should have been delegated +# to the child process. +# This lock should fail. +{ + # Forced dummy scope + my $lock2 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX|LOCK_NB, + }; + + ok (!$lock2); +} + +# Wait for child to finish +ok(wait); + +# Try again now that the child is done. +# This time it should work. +{ + # Forced dummy scope + my $lock2 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX|LOCK_NB, + }; + + ok($lock2); +} + +# Wipe the temporary file +unlink $datafile; diff --git a/t/243_fork_ex.t b/t/243_fork_ex.t new file mode 100644 index 0000000..77236de --- /dev/null +++ b/t/243_fork_ex.t @@ -0,0 +1,105 @@ +# Exclusive Fork Test +# +# This tests the capabilities of fork after lock to +# ensure parent retains exclusive lock even if child releases it. +# This test uses ->fork() instead of ->newpid() + +use strict; +use warnings; +use File::Temp qw(tempfile); + +use Test::More tests => 6; +use File::NFSLock; +use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); + +$| = 1; # Buffer must be autoflushed because of fork() below. + +my $datafile = (tempfile)[1]; + +# Wipe lock file in case it exists +unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); + +# Create a blank file +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); +ok (-e $datafile && !-s _); + +pipe(my $dad_rd, my $dad_wr); +{ + # Forced dummy scope + my $lock1 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX, + }; + + ok ($lock1); + + my $pid = $lock1->fork; + if (!defined $pid) { + die "fork failed!"; + } elsif (!$pid) { + # Child process + + # Fork worked + ok 1; + + # Let go of the other side $dad_rd + close $dad_wr; + + # Child continues on while parent holds onto the lock... + } else { + # Parent process + + # Parent hangs onto the lock for a bit + sleep 5; + + # Parent finally releases the lock + undef $lock1; + + # And releases $dad_rd to signal the child + # that's the lock should be free. + close $dad_wr; + + # Clear the Child Zombie + wait; + + # Avoid normal "exit" checking plan counts. + require POSIX; + POSIX::_exit(0); + # Don't continue on since the child should have already done the tests. + } +} +# Lock is out of scope, but should +# still be acquired by the parent. + +# Try to get a non-blocking lock. +# Quickly, before the parent releases it. +# This lock should fail. +{ + # Forced dummy scope + my $lock2 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX|LOCK_NB, + }; + + ok(!$lock2); +} + +# Wait for the parent process to release the lock +scalar <$dad_rd>; +ok(1); + +# Try again now that the parent is done. +# This time it should work. +{ + # Forced dummy scope + my $lock2 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX|LOCK_NB, + }; + + ok($lock2); +} + +# Wipe the temporary file +unlink $datafile; diff --git a/t/252_fork_sh.t b/t/252_fork_sh.t new file mode 100644 index 0000000..30a903f --- /dev/null +++ b/t/252_fork_sh.t @@ -0,0 +1,88 @@ +# Shared Fork Test +# +# This tests the capabilities of fork after lock to +# ensure child retains shared lock even if parent releases it. +# This test uses ->fork() instead of ->newpid() + +use strict; +use warnings; +use File::Temp qw(tempfile); + +use Test::More tests => 6; +use File::NFSLock; +use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); + +$| = 1; # Buffer must be autoflushed because of fork() below. + +my $datafile = (tempfile)[1]; + +# Wipe lock file in case it exists +unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); + +# Create a blank file +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); +ok (-e $datafile && !-s _); + +{ + # Forced dummy scope + my $lock1 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_SH, + }; + + ok ($lock1); + + my $pid = $lock1->fork; + if (!defined $pid) { + die "fork failed!"; + } elsif (!$pid) { + # Child process + + # Act busy for a while + sleep 5; + + # Now release lock + exit; + } else { + # Fork worked + ok 1; + + # Leaving scope should release only the parent side + } +} +# Lock is out of scope, but should +# still be acquired by the child. + +# Try to get a non-blocking lock. +# Yes, it is the same process, +# but it should have been delegated +# to the child process. +# This lock should fail. +{ + # Forced dummy scope + my $lock2 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX|LOCK_NB, + }; + + ok (!$lock2); +} + +# Wait for child to finish +ok(wait); + +# Try again now that the child is done. +# This time it should work. +{ + # Forced dummy scope + my $lock2 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX|LOCK_NB, + }; + + ok($lock2); +} + +# Wipe the temporary file +unlink $datafile; diff --git a/t/253_fork_sh.t b/t/253_fork_sh.t new file mode 100644 index 0000000..7da36ab --- /dev/null +++ b/t/253_fork_sh.t @@ -0,0 +1,105 @@ +# Shared Fork Test +# +# This tests the capabilities of fork after lock to +# ensure parent retains shared lock even if child releases it. +# This test uses ->fork() instead of ->newpid() + +use strict; +use warnings; +use File::Temp qw(tempfile); + +use Test::More tests => 6; +use File::NFSLock; +use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); + +$| = 1; # Buffer must be autoflushed because of fork() below. + +my $datafile = (tempfile)[1]; + +# Wipe lock file in case it exists +unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); + +# Create a blank file +sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); +close ($fh); +ok (-e $datafile && !-s _); + +pipe(my $dad_rd, my $dad_wr); +{ + # Forced dummy scope + my $lock1 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_SH, + }; + + ok ($lock1); + + my $pid = $lock1->fork; + if (!defined $pid) { + die "fork failed!"; + } elsif (!$pid) { + # Child process + + # Fork worked + ok 1; + + # Let go of the other side $dad_rd + close $dad_wr; + + # Child continues on while parent holds onto the lock... + } else { + # Parent process + + # Parent hangs onto the lock for a bit + sleep 5; + + # Parent finally releases the lock + undef $lock1; + + # And releases $dad_rd to signal the child + # that's the lock should be free. + close $dad_wr; + + # Clear the Child Zombie + wait; + + # Avoid normal "exit" checking plan counts. + require POSIX; + POSIX::_exit(0); + # Don't continue on since the child should have already done the tests. + } +} +# Lock is out of scope, but should +# still be acquired by the parent. + +# Try to get a non-blocking lock. +# Quickly, before the parent releases it. +# This lock should fail. +{ + # Forced dummy scope + my $lock2 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX|LOCK_NB, + }; + + ok (!$lock2); +} + +# Wait for the parent process to release the lock +scalar <$dad_rd>; +ok(1); + +# Try again now that the parent is done. +# This time it should work. +{ + # Forced dummy scope + my $lock2 = new File::NFSLock { + file => $datafile, + lock_type => LOCK_EX|LOCK_NB, + }; + + ok($lock2); +} + +# Wipe the temporary file +unlink $datafile; From 51ec138f93acd818887182216649852cadcc0613 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Sat, 8 Nov 2014 21:38:54 -0700 Subject: [PATCH 35/54] Version 1.26 --- Changes | 13 ++++++++----- File-NFSLock.spec | 2 +- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/Changes b/Changes index 2a1b3ed..29d9aef 100644 --- a/Changes +++ b/Changes @@ -1,15 +1,18 @@ Revision history for Perl extension File::NFSLock. -1.25 Nov 07 13:00 2014 +1.26 Nov 07 16:00 2014 + - Add File::NFSLock->fork() convenience method. + - RT#48102 Report by Todd Foggoa: + - More gracefully handle fork() to behave like + Linux by sharing the lock between both parent + and child processes when ->newpid() is called. + +1.25 Jul 30 14:00 2014 - RT#99431 Report by Nathan Glenn: - Fixed tempfile syntax by Christian Walde. - Fixed Win32 Shared Lock by Christian Walde. - RT#42122 Report by converter at cpan.org: - Add tests to help debug Taint issues - - RT#48102 Report by Todd Foggoa: - - More gracefully handle fork() to behave like - Linux by sharing the lock between both parent - and child processes when ->newpid() is called. 1.24 Jul 30 14:00 2014 - Fixed a race condition in crash recovery. diff --git a/File-NFSLock.spec b/File-NFSLock.spec index 0520f27..a76ee04 100644 --- a/File-NFSLock.spec +++ b/File-NFSLock.spec @@ -1,7 +1,7 @@ # Automatically generated by File-NFSLock.spec.PL %define class File %define subclass NFSLock -%define version 1.25 +%define version 1.26 %define release 1 %define defperlver 5.6.1 From d6bc157810572364e794d41552bd68e16942c6db Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Mon, 10 Nov 2014 08:34:01 -0700 Subject: [PATCH 36/54] Bump to Version 1.27 --- lib/File/NFSLock.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index 169de8d..23cecc9 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -2,7 +2,7 @@ # # File::NFSLock - bdpO - NFS compatible (safe) locking utility # -# $Id: NFSLock.pm,v 1.34 2003/05/13 18:06:41 hookbot Exp $ +# $Id: NFSLock.pm,v 1.27 2014/11/10 14:00:00 hookbot Exp $ # # Copyright (C) 2002, Paul T Seamons # paul@seamons.com @@ -32,7 +32,7 @@ our $errstr; use base 'Exporter'; our @EXPORT_OK = qw(uncache); -our $VERSION = '1.26'; +our $VERSION = '1.27'; #Get constants, but without the bloat of #use Fcntl qw(LOCK_SH LOCK_EX LOCK_NB); From f55b020bb07b9621cda806b10a096a8cdb63bfd0 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Mon, 10 Nov 2014 09:33:54 -0700 Subject: [PATCH 37/54] Bump to version 1.27 --- File-NFSLock.spec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/File-NFSLock.spec b/File-NFSLock.spec index a76ee04..19366c5 100644 --- a/File-NFSLock.spec +++ b/File-NFSLock.spec @@ -1,7 +1,7 @@ # Automatically generated by File-NFSLock.spec.PL %define class File %define subclass NFSLock -%define version 1.26 +%define version 1.27 %define release 1 %define defperlver 5.6.1 From 63d38d6413751583959ebed337b3440d450edc9a Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Mon, 10 Nov 2014 09:35:10 -0700 Subject: [PATCH 38/54] RT#99431 Compatibility fixes in test suite for Win32 Perl. --- t/120_single.t | 2 +- t/130_taint.t | 2 +- t/200_bl_ex.t | 2 +- t/210_nb_ex.t | 2 +- t/220_ex_scope.t | 2 +- t/230_double.t | 2 +- t/240_fork_ex.t | 2 +- t/241_fork_ex.t | 2 +- t/242_fork_ex.t | 2 +- t/243_fork_ex.t | 2 +- t/250_fork_sh.t | 2 +- t/251_fork_sh.t | 2 +- t/252_fork_sh.t | 2 +- t/253_fork_sh.t | 2 +- t/300_bl_sh.t | 2 +- t/400_kill.t | 2 +- t/410_die.t | 2 +- t/420_crash.t | 2 +- t/430_taint.t | 2 +- 19 files changed, 19 insertions(+), 19 deletions(-) diff --git a/t/120_single.t b/t/120_single.t index 1628fd6..3c1112e 100644 --- a/t/120_single.t +++ b/t/120_single.t @@ -5,7 +5,7 @@ use File::NFSLock; use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); use File::Temp qw(tempfile); -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/130_taint.t b/t/130_taint.t index e561123..8ddbb98 100644 --- a/t/130_taint.t +++ b/t/130_taint.t @@ -7,7 +7,7 @@ use File::NFSLock; use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); use File::Temp qw(tempfile); -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/200_bl_ex.t b/t/200_bl_ex.t index 2109c22..3e80fa8 100644 --- a/t/200_bl_ex.t +++ b/t/200_bl_ex.t @@ -20,7 +20,7 @@ my $n = 50; $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/210_nb_ex.t b/t/210_nb_ex.t index 2915782..59f91e1 100644 --- a/t/210_nb_ex.t +++ b/t/210_nb_ex.t @@ -10,7 +10,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/220_ex_scope.t b/t/220_ex_scope.t index 173484f..f4acc0b 100644 --- a/t/220_ex_scope.t +++ b/t/220_ex_scope.t @@ -25,7 +25,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/230_double.t b/t/230_double.t index 3a63433..b324f69 100644 --- a/t/230_double.t +++ b/t/230_double.t @@ -13,7 +13,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); $| = 1; -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/240_fork_ex.t b/t/240_fork_ex.t index d6d58e9..e5cd525 100644 --- a/t/240_fork_ex.t +++ b/t/240_fork_ex.t @@ -13,7 +13,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/241_fork_ex.t b/t/241_fork_ex.t index 269c9e5..e53ba78 100644 --- a/t/241_fork_ex.t +++ b/t/241_fork_ex.t @@ -13,7 +13,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/242_fork_ex.t b/t/242_fork_ex.t index 66c364d..9c79c03 100644 --- a/t/242_fork_ex.t +++ b/t/242_fork_ex.t @@ -14,7 +14,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/243_fork_ex.t b/t/243_fork_ex.t index 77236de..b856e7a 100644 --- a/t/243_fork_ex.t +++ b/t/243_fork_ex.t @@ -14,7 +14,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/250_fork_sh.t b/t/250_fork_sh.t index ec14e4b..52428dc 100644 --- a/t/250_fork_sh.t +++ b/t/250_fork_sh.t @@ -13,7 +13,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/251_fork_sh.t b/t/251_fork_sh.t index 88fa107..32569a6 100644 --- a/t/251_fork_sh.t +++ b/t/251_fork_sh.t @@ -13,7 +13,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/252_fork_sh.t b/t/252_fork_sh.t index 30a903f..3b78fb3 100644 --- a/t/252_fork_sh.t +++ b/t/252_fork_sh.t @@ -14,7 +14,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/253_fork_sh.t b/t/253_fork_sh.t index 7da36ab..05a553e 100644 --- a/t/253_fork_sh.t +++ b/t/253_fork_sh.t @@ -14,7 +14,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC O_APPEND LOCK_EX LOCK_SH LOCK_NB); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/300_bl_sh.t b/t/300_bl_sh.t index 920a9ae..4c6d6c5 100644 --- a/t/300_bl_sh.t +++ b/t/300_bl_sh.t @@ -19,7 +19,7 @@ my $shared_delay = 5; $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Create a blank file sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC ); diff --git a/t/400_kill.t b/t/400_kill.t index c39340d..1045fa7 100644 --- a/t/400_kill.t +++ b/t/400_kill.t @@ -10,7 +10,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/410_die.t b/t/410_die.t index 6e9bfee..67d937c 100644 --- a/t/410_die.t +++ b/t/410_die.t @@ -10,7 +10,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/420_crash.t b/t/420_crash.t index 9fee6a5..3867923 100644 --- a/t/420_crash.t +++ b/t/420_crash.t @@ -10,7 +10,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); diff --git a/t/430_taint.t b/t/430_taint.t index 30ecf90..3a00e72 100644 --- a/t/430_taint.t +++ b/t/430_taint.t @@ -12,7 +12,7 @@ use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX); $| = 1; # Buffer must be autoflushed because of fork() below. -my $datafile = (tempfile)[1]; +my $datafile = (tempfile 'XXXXXXXXXX')[1]; # Wipe lock file in case it exists unlink ("$datafile$File::NFSLock::LOCK_EXTENSION"); From 43134e549f6f7c0e324b1401238259ebeae3c9dd Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Mon, 10 Nov 2014 16:33:12 -0700 Subject: [PATCH 39/54] RT#48102 Add tests to test the new ->fork() method functionality. --- MANIFEST | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/MANIFEST b/MANIFEST index 19207bf..6f5a584 100644 --- a/MANIFEST +++ b/MANIFEST @@ -16,8 +16,12 @@ t/220_ex_scope.t t/230_double.t t/240_fork_ex.t t/241_fork_ex.t +t/242_fork_ex.t +t/243_fork_ex.t t/250_fork_sh.t t/251_fork_sh.t +t/252_fork_sh.t +t/253_fork_sh.t t/300_bl_sh.t t/400_kill.t t/410_die.t From 6791f2f87e4f3bfa26181adb5bd9062f35404b36 Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Wed, 12 Nov 2014 13:11:48 -0700 Subject: [PATCH 40/54] Version 1.27 --- Changes | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Changes b/Changes index 29d9aef..501cf81 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,11 @@ Revision history for Perl extension File::NFSLock. +1.27 Nov 12 13:00 2014 + - RT#99431: + - More Win32 compatibility fixes in test suite. + - RT#48102: + - Add tests for new ->fork() method. + 1.26 Nov 07 16:00 2014 - Add File::NFSLock->fork() convenience method. - RT#48102 Report by Todd Foggoa: From 70b5a4b20008ead12e892b7b5bb7643630661f2a Mon Sep 17 00:00:00 2001 From: Rob Brown Date: Wed, 12 Nov 2014 13:15:53 -0700 Subject: [PATCH 41/54] Bump to Version 1.28 --- lib/File/NFSLock.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index 23cecc9..0f504d2 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -2,7 +2,7 @@ # # File::NFSLock - bdpO - NFS compatible (safe) locking utility # -# $Id: NFSLock.pm,v 1.27 2014/11/10 14:00:00 hookbot Exp $ +# $Id: NFSLock.pm,v 1.28 2014/11/10 14:00:00 hookbot Exp $ # # Copyright (C) 2002, Paul T Seamons # paul@seamons.com @@ -32,7 +32,7 @@ our $errstr; use base 'Exporter'; our @EXPORT_OK = qw(uncache); -our $VERSION = '1.27'; +our $VERSION = '1.28'; #Get constants, but without the bloat of #use Fcntl qw(LOCK_SH LOCK_EX LOCK_NB); From 89b87e2be73ab6aac005e93b2a4e67e238c50a25 Mon Sep 17 00:00:00 2001 From: Hook Bot Date: Thu, 1 Nov 2018 09:37:28 -0600 Subject: [PATCH 42/54] Ignore MYMETA.json generated file. --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 8bdb07e..2cd8582 100644 --- a/.gitignore +++ b/.gitignore @@ -11,6 +11,7 @@ Makefile.old MANIFEST.bak META.yml MYMETA.yml +MYMETA.json nytprof.out pm_to_blib *.tar.gz From 4a4be6b684827bfee61b259cacac8e5115431451 Mon Sep 17 00:00:00 2001 From: Hook Bot Date: Thu, 1 Nov 2018 10:01:58 -0600 Subject: [PATCH 43/54] Handle "." not in @INC on new-fangled Perl versions. --- Makefile.PL | 1 + 1 file changed, 1 insertion(+) diff --git a/Makefile.PL b/Makefile.PL index abc3381..6e95b14 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -31,6 +31,7 @@ sub processPL { # "Version:" in spec needs to match # "$VERSION" from VERSION_FROM $block =~ s%(spec.PL\s*)$%$1 \$\(VERSION_FROM\)%m; + $block =~ s[(\$\(PERLRUNINST\)\s+)][PERL_USE_UNSAFE_INC=1 $1]gm; $block; } From 8fd46c70caec46f7f8a10c4562ec7bd31bbe5574 Mon Sep 17 00:00:00 2001 From: Hook Bot Date: Thu, 1 Nov 2018 10:02:30 -0600 Subject: [PATCH 44/54] Version 1.28 --- Changes | 4 ++++ File-NFSLock.spec | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/Changes b/Changes index 501cf81..0b3facf 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,9 @@ Revision history for Perl extension File::NFSLock. +1.28 Nov 01 10:00 2018 + - Patch RT#130467 and RT#120088: + - Handle "." not in @INC + 1.27 Nov 12 13:00 2014 - RT#99431: - More Win32 compatibility fixes in test suite. diff --git a/File-NFSLock.spec b/File-NFSLock.spec index 19366c5..edce004 100644 --- a/File-NFSLock.spec +++ b/File-NFSLock.spec @@ -1,7 +1,7 @@ # Automatically generated by File-NFSLock.spec.PL %define class File %define subclass NFSLock -%define version 1.27 +%define version 1.28 %define release 1 %define defperlver 5.6.1 From d555bc5f6ca7a6b2aeccf6e520e3f691cbc514fb Mon Sep 17 00:00:00 2001 From: Todd Rinaldo Date: Thu, 1 Nov 2018 11:46:15 -0500 Subject: [PATCH 45/54] Add travis-ci to File-NFSLock commits. --- .travis.yml | 24 ++++++++++++++++++++++++ MANIFEST.SKIP | 17 +++++++++++++++++ 2 files changed, 41 insertions(+) create mode 100644 .travis.yml create mode 100644 MANIFEST.SKIP diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..187a4e1 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,24 @@ +branches: + except: + - /^issue\d+/ + - /^gh\d+/ +language: perl +env: + global: + - PERL_USE_UNSAFE_INC=0 + - AUTHOR_TESTING=1 + - AUTOMATED_TESTING=1 + - RELEASE_TESTING=1 +perl: + - "5.28" + - "5.26" + - "5.24" + - "5.22" + - "5.20" + - "5.18" + - "5.16" + - "5.14" + - "5.12" + - "5.10" +script: + - perl Makefile.PL && make test diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..e6d8ea0 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,17 @@ +\.DS_Store +\bdiffs?\b +^MANIFEST\. +^MYMETA +^Makefile$ +~$ +\.old$ +\.bak$ +\.orig$ +\.gz$ +^\.git +^benchmark/ +^cover_db/ +^blib/ +^pm_to_blib$ +^\.travis.yml$ +^File-NFSLock-\d\.\d+/ From 75a68092d8981b0b851fecbcbbf6da4eba063b40 Mon Sep 17 00:00:00 2001 From: Hook Bot Date: Thu, 1 Nov 2018 12:48:45 -0600 Subject: [PATCH 46/54] Bump to Version 1.29 to signify PAUSE --- lib/File/NFSLock.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index 0f504d2..ef30941 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -2,7 +2,7 @@ # # File::NFSLock - bdpO - NFS compatible (safe) locking utility # -# $Id: NFSLock.pm,v 1.28 2014/11/10 14:00:00 hookbot Exp $ +# $Id: NFSLock.pm,v 1.29 2018/11/01 14:00:00 bbb Exp $ # # Copyright (C) 2002, Paul T Seamons # paul@seamons.com @@ -32,7 +32,7 @@ our $errstr; use base 'Exporter'; our @EXPORT_OK = qw(uncache); -our $VERSION = '1.28'; +our $VERSION = '1.29'; #Get constants, but without the bloat of #use Fcntl qw(LOCK_SH LOCK_EX LOCK_NB); From f9bb80d9d43f1ef7c578a16ff198a843ec302556 Mon Sep 17 00:00:00 2001 From: Hook Bot Date: Thu, 1 Nov 2018 12:56:27 -0600 Subject: [PATCH 47/54] Hiding PERL_USE_UNSAFE_INC to test Travis-CI --- Makefile.PL | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/Makefile.PL b/Makefile.PL index 6e95b14..3819569 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -26,23 +26,23 @@ WriteMakefile package MY; sub processPL { - my $self = shift; - my $block = $self->SUPER::processPL(@_); - # "Version:" in spec needs to match - # "$VERSION" from VERSION_FROM - $block =~ s%(spec.PL\s*)$%$1 \$\(VERSION_FROM\)%m; - $block =~ s[(\$\(PERLRUNINST\)\s+)][PERL_USE_UNSAFE_INC=1 $1]gm; - $block; + my $self = shift; + my $block = $self->SUPER::processPL(@_); + # "Version:" in spec needs to match + # "$VERSION" from VERSION_FROM + $block =~ s%(spec.PL\s*)$%$1 \$\(VERSION_FROM\)%m; + #$block =~ s[(\$\(PERLRUNINST\)\s+)][PERL_USE_UNSAFE_INC=1 $1]gm; + $block; } sub libscan { - my $self = shift; - my $path = shift; - ($path =~ / \bCVS\b | \~$ /x) ? undef : $path; + my $self = shift; + my $path = shift; + ($path =~ / \bCVS\b | \~$ /x) ? undef : $path; } sub postamble { - return qq^ + return qq^ pm_to_blib: README From 9b539ec224c5cf2a9c2e6e30e6fb10f05966c8af Mon Sep 17 00:00:00 2001 From: Hook Bot Date: Thu, 1 Nov 2018 22:05:51 +0300 Subject: [PATCH 48/54] Get rid of crusty old deprecated PERL_USE_UNSAFE_INC setting. --- Makefile.PL | 1 - 1 file changed, 1 deletion(-) diff --git a/Makefile.PL b/Makefile.PL index 3819569..cf871ef 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -31,7 +31,6 @@ sub processPL { # "Version:" in spec needs to match # "$VERSION" from VERSION_FROM $block =~ s%(spec.PL\s*)$%$1 \$\(VERSION_FROM\)%m; - #$block =~ s[(\$\(PERLRUNINST\)\s+)][PERL_USE_UNSAFE_INC=1 $1]gm; $block; } From 0500977f3a76af087ffd7065e76a17f952fce445 Mon Sep 17 00:00:00 2001 From: Hook Bot Date: Thu, 1 Nov 2018 13:04:34 -0600 Subject: [PATCH 49/54] For Perl 2.26 and higher, prevent this crashing spewage: do "Makefile.PL" failed, '.' is no longer in @INC; did you mean do "./Makefile.PL"? at File-NFSLock.spec.PL line 32. Makefile.PL: Missing WriteMakefile at File-NFSLock.spec.PL line 36. make: *** [File-NFSLock.spec] Error 2 --- File-NFSLock.spec.PL | 40 +++++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 19 deletions(-) diff --git a/File-NFSLock.spec.PL b/File-NFSLock.spec.PL index fdf9fdf..cebe564 100644 --- a/File-NFSLock.spec.PL +++ b/File-NFSLock.spec.PL @@ -11,29 +11,31 @@ my $name; my $version; $INC{"ExtUtils/MakeMaker.pm"} = 1; sub WriteMakefile { - my %props = @_; - $name = $props{NAME} || die "Makefile.PL: Missing NAME"; - if ($version = $props{VERSION}) { - # done - } elsif (my $version_from = $props{VERSION_FROM}) { - $@ = ""; - $version = eval qq{ - do "$version_from"; - \$$name\::VERSION || die "$version_from: Missing VERSION"; - }; - die $@ if $@; - if (!defined $version) { - die "$version_from: Missing VERSION"; + my %props = @_; + $name = $props{NAME} || die "Makefile.PL: Missing NAME"; + if ($version = $props{VERSION}) { + # done + } + elsif (my $version_from = $props{VERSION_FROM}) { + $@ = ""; + $version = eval qq{ + do "$version_from"; + \$$name\::VERSION || die "$version_from: Missing VERSION"; + }; + die $@ if $@; + if (!defined $version) { + die "$version_from: Missing VERSION"; + } + } + else { + die "Makefile.PL: Could not determine version!"; } - } else { - die "Makefile.PL: Could not determine version!"; - } } -do "Makefile.PL"; +do "./Makefile.PL"; if ($name) { - $name =~ s/::/-/g; + $name =~ s/::/-/g; } else { - die "Makefile.PL: Missing WriteMakefile"; + die "Makefile.PL: Missing WriteMakefile"; } $version || die "No version!"; From 1bb8b857e481532b1922c3ade510f02d2ea80808 Mon Sep 17 00:00:00 2001 From: Hook Bot Date: Thu, 1 Nov 2018 13:12:59 -0600 Subject: [PATCH 50/54] For Perl 2.26 and higher, prevent this crashing spewage: do "lib/File/NFSLock.pm" failed, '.' is no longer in @INC; did you mean do "./lib/File/NFSLock.pm"? at (eval 1) line 2. No version! at File-NFSLock.spec.PL line 41. make: *** [File-NFSLock.spec] Error 2 --- File-NFSLock.spec.PL | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/File-NFSLock.spec.PL b/File-NFSLock.spec.PL index cebe564..8a3f58b 100644 --- a/File-NFSLock.spec.PL +++ b/File-NFSLock.spec.PL @@ -19,7 +19,7 @@ sub WriteMakefile { elsif (my $version_from = $props{VERSION_FROM}) { $@ = ""; $version = eval qq{ - do "$version_from"; + do "./$version_from"; \$$name\::VERSION || die "$version_from: Missing VERSION"; }; die $@ if $@; From f48b0f8ad698a3b311c74fb7d5dcae933d092ffd Mon Sep 17 00:00:00 2001 From: Hook Bot Date: Thu, 1 Nov 2018 13:36:17 -0600 Subject: [PATCH 51/54] Version 1.29 --- Changes | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Changes b/Changes index 0b3facf..054d8a9 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,8 @@ Revision history for Perl extension File::NFSLock. +1.29 Nov 01 14:00 2018 + - Avoid deprecated PERL_USE_UNSAFE_INC + 1.28 Nov 01 10:00 2018 - Patch RT#130467 and RT#120088: - Handle "." not in @INC From 6efd61586b115afebd4137936411ef9384bba9ce Mon Sep 17 00:00:00 2001 From: Hook Bot Date: Thu, 1 Nov 2018 13:40:42 -0600 Subject: [PATCH 52/54] Version 1.29 --- File-NFSLock.spec | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/File-NFSLock.spec b/File-NFSLock.spec index edce004..fb5659b 100644 --- a/File-NFSLock.spec +++ b/File-NFSLock.spec @@ -1,7 +1,7 @@ # Automatically generated by File-NFSLock.spec.PL %define class File %define subclass NFSLock -%define version 1.28 +%define version 1.29 %define release 1 %define defperlver 5.6.1 From 83bf81cd8ac9db17349426bb075d96faed437412 Mon Sep 17 00:00:00 2001 From: Hook Bot Date: Thu, 1 Nov 2018 13:55:28 -0600 Subject: [PATCH 53/54] Happy New Year --- lib/File/NFSLock.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/File/NFSLock.pm b/lib/File/NFSLock.pm index ef30941..cb2f4ca 100644 --- a/lib/File/NFSLock.pm +++ b/lib/File/NFSLock.pm @@ -798,7 +798,7 @@ from which Mark Overmeer based Mail::Box::Locker. paul@seamons.com http://seamons.com/ - Copyright (C) 2002-2014, + Copyright (C) 2002-2018, Rob B Brown bbb@cpan.org From ee115a2f3c36b9579f9cd41b08049494a173daf1 Mon Sep 17 00:00:00 2001 From: Hook Bot Date: Thu, 1 Nov 2018 13:57:15 -0600 Subject: [PATCH 54/54] Happy New Year --- README | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README b/README index 547e44f..0962448 100644 --- a/README +++ b/README @@ -245,7 +245,7 @@ COPYRIGHT paul@seamons.com http://seamons.com/ - Copyright (C) 2002-2014, + Copyright (C) 2002-2018, Rob B Brown bbb@cpan.org