How do I lock a file in Perl? - perl

What is the best way to create a lock on a file in Perl?
Is it best to flock on the file or to create a lock file to place a lock on and check for a lock on the lock file?

If you end up using flock, here's some code to do it:
use Fcntl ':flock'; # Import LOCK_* constants
# We will use this file path in error messages and function calls.
# Don't type it out more than once in your code. Use a variable.
my $file = '/path/to/some/file';
# Open the file for appending. Note the file path is quoted
# in the error message. This helps debug situations where you
# have a stray space at the start or end of the path.
open(my $fh, '>>', $file) or die "Could not open '$file' - $!";
# Get exclusive lock (will block until it does)
flock($fh, LOCK_EX) or die "Could not lock '$file' - $!";
# Do something with the file here...
# Do NOT use flock() to unlock the file if you wrote to the
# file in the "do something" section above. This could create
# a race condition. The close() call below will unlock the
# file for you, but only after writing any buffered data.
# In a world of buffered i/o, some or all of your data may not
# be written until close() completes. Always, always, ALWAYS
# check the return value of close() if you wrote to the file!
close($fh) or die "Could not write '$file' - $!";
Some useful links:
PerlMonks file locking tutorial (somewhat old)
flock() documentation
In response to your added question, I'd say either place the lock on the file or create a file that you call 'lock' whenever the file is locked and delete it when it is no longer locked (and then make sure your programs obey those semantics).

The other answers cover Perl flock locking pretty well, but on many Unix/Linux systems there are actually two independent locking systems: BSD flock() and POSIX fcntl()-based locks.
Unless you provide special options to configure when building Perl, its flock will use flock() if available. This is generally fine and probably what you want if you just need locking within your application (running on a single system). However, sometimes you need to interact with another application that uses fcntl() locks (like Sendmail, on many systems) or perhaps you need to do file locking across NFS-mounted filesystems.
In those cases, you might want to look at File::FcntlLock or File::lockf. It is also possible to do fcntl()-based locking in pure Perl (with some hairy and non-portable bits of pack()).
Quick overview of flock/fcntl/lockf differences:
lockf is almost always implemented on top of fcntl, has file-level locking only. If implemented using fcntl, limitations below also apply to lockf.
fcntl provides range-level locking (within a file) and network locking over NFS, but locks are not inherited by child processes after a fork(). On many systems, you must have the filehandle open read-only to request a shared lock, and read-write to request an exclusive lock.
flock has file-level locking only, locking is only within a single machine (you can lock an NFS-mounted file, but only local processes will see the lock). Locks are inherited by children (assuming that the file descriptor is not closed).
Sometimes (SYSV systems) flock is emulated using lockf, or fcntl; on some BSD systems lockf is emulated using flock. Generally these sorts of emulation work poorly and you are well advised to avoid them.

CPAN to the rescue: IO::LockedFile.

Ryan P wrote:
In this case the file is actually unlocked for a short period of time while the file is reopened.
So don’t do that. Instead, open the file for read/write:
open my $fh, '+<', 'test.dat'
or die "Couldn’t open test.dat: $!\n";
When you are ready to write the counter, just seek back to the start of the file. Note that if you do that, you should truncate just before close, so that the file isn’t left with trailing garbage if its new contents are shorter than its previous ones. (Usually, the current position in the file is at its end, so you can just write truncate $fh, tell $fh.)
Also, note that I used three-argument open and a lexical file handle, and I also checked the success of the operation. Please avoid global file handles (global variables are bad, mmkay?) and magic two-argument open (which has been a source of many a(n exploitable) bug in Perl code), and always test whether your opens succeed.

I think it would be much better to show this with lexical variables as file handlers
and error handling.
It is also better to use the constants from the Fcntl module than hard code the magic number 2 which might not be the right number on all operating systems.
use Fcntl ':flock'; # import LOCK_* constants
# open the file for appending
open (my $fh, '>>', 'test.dat') or die $!;
# try to lock the file exclusively, will wait till you get the lock
flock($fh, LOCK_EX);
# do something with the file here (print to it in our case)
# actually you should not unlock the file
# close the file will unlock it
close($fh) or warn "Could not close file $!";
Check out the full documentation of flock and the File locking tutorial on PerlMonks even though that also uses the old style of file handle usage.
Actually I usually skip the error handling on close() as there is not
much I can do if it fails anyway.
Regarding what to lock, if you are working in a single file then lock that file. If you need to lock several files at once then - in order to avoid dead locks - it is better to pick one file that you are locking. Does not really matter if that is one of the several files you really need to lock or a separate file you create just for the locking purpose.

Have you considered using the LockFile::Simple module? It does most of the work for you already.
In my past experience, I have found it very easy to use and sturdy.

use strict;
use Fcntl ':flock'; # Import LOCK_* constants
# We will use this file path in error messages and function calls.
# Don't type it out more than once in your code. Use a variable.
my $file = '/path/to/some/file';
# Open the file for appending. Note the file path is in quoted
# in the error message. This helps debug situations where you
# have a stray space at the start or end of the path.
open(my $fh, '>>', $file) or die "Could not open '$file' - $!";
# Get exclusive lock (will block until it does)
flock($fh, LOCK_EX);
# Do something with the file here...
# Do NOT use flock() to unlock the file if you wrote to the
# file in the "do something" section above. This could create
# a race condition. The close() call below will unlock it
# for you, but only after writing any buffered data.
# In a world of buffered i/o, some or all of your data will not
# be written until close() completes. Always, always, ALWAYS
# check the return value on close()!
close($fh) or die "Could not write '$file' - $!";

My goal in this question was to lock a file being used as a data store for several scripts. In the end I used similar code to the following (from Chris):
open (FILE, '>>', test.dat') ; # open the file
flock FILE, 2; # try to lock the file
# do something with the file here
close(FILE); # close the file
In his example I removed the flock FILE, 8 as the close(FILE) performs this action as well. The real problem was when the script starts it has to hold the current counter, and when it ends it has to update the counter. This is where Perl has a problem, to read the file you:
open (FILE, '<', test.dat');
flock FILE, 2;
Now I want to write out the results and since i want to overwrite the file I need to reopen and truncate which results in the following:
open (FILE, '>', test.dat'); #single arrow truncates double appends
flock FILE, 2;
In this case the file is actually unlocked for a short period of time while the file is reopened. This demonstrates the case for the external lock file. If you are going to be changing contexts of the file, use a lock file. The modified code:
open (LOCK_FILE, '<', test.dat.lock') or die "Could not obtain lock";
flock LOCK_FILE, 2;
open (FILE, '<', test.dat') or die "Could not open file";
# read file
# ...
open (FILE, '>', test.dat') or die "Could not reopen file";
#write file
close (FILE);
close (LOCK_FILE);

Developed off of http://metacpan.org/pod/File::FcntlLock
use Fcntl qw(:DEFAULT :flock :seek :Fcompat);
use File::FcntlLock;
sub acquire_lock {
my $fn = shift;
my $justPrint = shift || 0;
confess "Too many args" if defined shift;
confess "Not enough args" if !defined $justPrint;
my $rv = TRUE;
my $fh;
sysopen($fh, $fn, O_RDWR | O_CREAT) or LOGDIE "failed to open: $fn: $!";
$fh->autoflush(1);
ALWAYS "acquiring lock: $fn";
my $fs = new File::FcntlLock;
$fs->l_type( F_WRLCK );
$fs->l_whence( SEEK_SET );
$fs->l_start( 0 );
$fs->lock( $fh, F_SETLKW ) or LOGDIE "failed to get write lock: $fn:" . $fs->error;
my $num = <$fh> || 0;
return ($fh, $num);
}
sub release_lock {
my $fn = shift;
my $fh = shift;
my $num = shift;
my $justPrint = shift || 0;
seek($fh, 0, SEEK_SET) or LOGDIE "seek failed: $fn: $!";
print $fh "$num\n" or LOGDIE "write failed: $fn: $!";
truncate($fh, tell($fh)) or LOGDIE "truncate failed: $fn: $!";
my $fs = new File::FcntlLock;
$fs->l_type(F_UNLCK);
ALWAYS "releasing lock: $fn";
$fs->lock( $fh, F_SETLK ) or LOGDIE "unlock failed: $fn: " . $fs->error;
close($fh) or LOGDIE "close failed: $fn: $!";
}

One alternative to the lock file approach is to use a lock socket. See Lock::Socket on CPAN for such an implementation. Usage is as simple as the following:
use Lock::Socket qw/lock_socket/;
my $lock = lock_socket(5197); # raises exception if lock already taken
There are a couple of advantages to using a socket:
guaranteed (through the operating system) that no two applications will hold the same lock: there is no race condition.
guaranteed (again through the operating system) to clean up neatly when your process exits, so there are no stale locks to deal with.
relies on functionality that is well supported by anything that Perl runs on: no issues with flock(2) support on Win32 for example.
The obvious disadvantage is of course that the lock namespace is global. It is possible for a kind of denial-of-service if another process decides to lock the port you need.
[disclosure: I am the author of the afor-mentioned module]

Use the flock Luke.
Edit: This is a good explanation.

flock creates Unix-style file locks, and is available on most OS's Perl runs on. However flock's locks are advisory only.
edit: emphasized that flock is portable

Here's my solution to reading and writing in one lock...
open (TST,"+< readwrite_test.txt") or die "Cannot open file\n$!";
flock(TST, LOCK_EX);
# Read the file:
#LINES=<TST>;
# Wipe the file:
seek(TST, 0, 0); truncate(TST, 0);
# Do something with the contents here:
push #LINES,"grappig, he!\n";
$LINES[3]="Gekke henkie!\n";
# Write the file:
foreach $l (#LINES)
{
print TST $l;
}
close(TST) or die "Cannot close file\n$!";

Flock is probably the best but requires you to write all the supporting code around it - timeouts, stale locks, non-existant files etc.
I trued LockFile::Simple but found it started setting the default umask to readonly and not cleaning this up. Resulting in random permissions problems on a multi process/multi-threaded application on modperl
I've settled on wrapping up NFSLock with some empty file handling.

Related

Perl: `die` did not work upon opening a nonexistent gz file using gzip

The following script creates a gziped file named "input.gz". Then the script attempts to open "input.gz" using gzip -dc. Intuitively, die should be triggered if a wrong input file name is provided. However, as in the following script, the program will not die even if a wrong input file name is provided ("inputx.gz"):
use warnings;
use strict;
system("echo PASS | gzip -c > input.gz");
open(IN,"-|","gzip -dc inputx.gz") || die "can't open input.gz!";
print STDOUT "die statment was not triggered!\n";
close IN;
The output of the script above was
die statment was not triggered!
gzip: inputx.gz: No such file or directory
My questions is: why wasn't die statement triggered even though gzip quit with error? And how can I make die statement triggered when a wrong file name is given?
It's buried in perlipc, but this seems relevant (emphasis added):
Be careful to check the return values from both open() and close(). If you're writing to a pipe, you should also trap SIGPIPE. Otherwise, think of what happens when you start up a pipe to a command that doesn't exist: the open() will in all likelihood succeed (it only reflects the fork()'s success), but then your output will fail--spectacularly. Perl can't know whether the command worked, because your command is actually running in a separate process whose exec() might have failed. Therefore, while readers of bogus commands return just a quick EOF, writers to bogus commands will get hit with a signal, which they'd best be prepared to handle.
Use IO::Uncompress::Gunzip to read gzipped files instead.
The open documentation is explicit about open-ing a process since that is indeed different
If you open a pipe on the command - (that is, specify either |- or -| with the one- or two-argument forms of open), an implicit fork is done, so open returns twice: in the parent process it returns the pid of the child process, and in the child process it returns (a defined) 0. Use defined($pid) or // to determine whether the open was successful.
For example, use either
my $child_pid = open(my $from_kid, "-|") // die "Can't fork: $!";
or
my $child_pid = open(my $to_kid, "|-") // die "Can't fork: $!";
(with code following that shows one use of this, which you don't need) The main point is to check for defined -- by design we get undef if open for a process fails, not just any "false."
While this should be corrected, keep in mind that the open call fails if fork itself fails, what is rare; in most cases when a "command fails" the fork was successful but something later wasn't. So in such cases we just cannot get the // die message, but end up seeing messages from the shell or command or OS, hopefully.
This is alright though, if informative messages indeed get emitted by some part of the process. Wrap the whole thing in eval and you'll have manageable error reporting.
But it is in general difficult to ensure to get all the right messages, and in some cases not possible. One good approach is to use a module for running and managing external commands. Among the many other advantages they also usually handle errors much more nicely. If you need to handle process's output right as it is emitted I recommend IPC::Run (which i'd recommend otherwise as well).
Read on what linked docs say, for specific examples on what you need and for much useful insight.
In your case
# Check input, depending on how it is given,
# consider String::ShellQuote if needed
my $file = ...;
my #cmd = ('gzip', '-dc', $file);
my $child_pid = open my $in, '-|', #cmd
// die "Can't fork for '#cmd': $!";
while (<$in>) {
...
}
close $in or die "Error closing pipe: $!";
Note a few other points
the "list form" of the command bypasses the shell
lexical filehandle (my $fh) is much better than typeglobs (IN)
print the actual error in the die statement, in $! variable
check close for a good final check on how it all went

Flock in Perl doesnt work

I have a Perl file. The user opens a file, reads data and displays the data in grid. user edits it and saves it back to the file.
I am trying to use flock so that when the user reads the file, the file gets locked. I tried below code but it didnt work.
Referring to the accepted answer of this post. How do I lock a file in Perl?
use Fcntl ':flock'; #added this at the start
$filename= dsfs.com/folder1/test.txt; #location of my file
open(my $fh, '<', $filename) or die $!; #file open
flock($fh, LOCK_EX) or die "Could not lock '$file' - $!"; #inserted flock before reading starts so that no other user can use this file
#reading of file starts here
#once read, user saves file.
close($fh) or die "Could not write '$file' - $!"; #release lock after user writes.
I guess this is a normal operation without any race around conditions but this doesnot work for me.I am not sure if the perl script is able to detect flock or not.
For testing purposes, i try to open the file before my writing and saving function gets completed. when i try to open the same file before saving gets completed, it means that the lock is not released yet. in this situation if i open the file at backend and edit the file, i am still able to save changes. In practical case, it should not be able to edit anything once the file is locked.
can anyone please suggest me any troubleshooting for this or is my procedure of using flock incorrect ??
There's another problem if your flock implementation is based on lockf(3) or fcntl(2), which it probably is. Namely, LOCK_EX should be used with "write intent", on a file opened for output.
For lockf(3), perldoc -f flock says
Note that the emulation built with lockf(3) doesn't provide shared locks, and it requires that FILEHANDLE be open with write intent.
and for fcntl(2):
Note that the fcntl(2) emulation of flock(3) requires that FILEHANDLE be open with read intent to use LOCK_SH and requires that it be open with write intent to use LOCK_EX.
A workaround for input files or for more complicated synchronized operations is for all processes to sync on a trivial lock file, like:
open my $lock, '>>', "$filename.lock";
flock $lock, LOCK_EX;
# can't get here until our process has the lock ...
open(my $fh, '<', $filename) or die $!; #file open
... read file, manipulate ...
close $fh;
open my $fh2, '>', $filename;
... rewrite file ...
close $fh2;
# done with this operation, can release the lock and let another
# process access the file
close $lock;
There's two problems:
flock will block until it can lock. You therefore need flock ( $file, LOCK_EX | LOCK_NB ) or die $!;
flock (on Unix) is advisory. It won't stop them accessing it unless they also check for a lock.

How to read and write a file, syntax wrong

I end up having my script appending the new changes that I wanted to make to the end of the file instead of in the actual file.
open (INCONFIG, "+<$text") or die $!;
#config = <INCONFIG>;
foreach(#config)
{
if ( $_ =~ m/$checker/ )
{
$_ = $somethingnew;
}
print INCONFIG $_;
}
close INCONFIG or die;
Ultimately I wanted to rewrite the whole text again, but with certain strings modified if it matched the search criterion. But so far it only appends ANOTHER COPY of the entire file(with changes) to the bottom of the old file.
I know that I can just close the file, and use another write file -handle and parse it in. But was hoping to be able to learn what I did wrong, and how to fix it.
As I understand open, using read/write access for a text file isn't a good idea. After all a file just is a byte stream: Updating a part of the file with something of a different length is the stuff headaches are made of ;-)
Here is my approach: Try to emulate the -i "inplace" switch of perl. So essentially we write to a backup file, which we will later rename. (On *nix system, there is some magic with open filehandles keeping deleted files available, so we don't have to create a new file. Lets do it anyway.)
my $filename = ...;
my $tempfile = "$filename.tmp";
open my $inFile, '<', $filename or die $!;
open my $outFile, '>', $tempfile or die $!;
while (my $line = <$inFile>) {
$line = doWeirdSubstitutions($line);
print $outFile $line;
}
close $inFile or die $!;
close $outFile or die $!;
rename $tempfile, $filename
or die "rename failed: $!"; # will break under weird circumstances.
# delete temp file
unlink $tempfile or die $!;
Untested, but obvious code. Does this help with your problem?
Your problem is a misunderstanding of what <+ "open for update" does. It is discussed in the Perl Tutorial at
Mixing Reads and Writes.
What you really want to do is copy the old file to a new file and then rename it after the fact. This is discussed in the perlfaq5 mentioned by daxim. Plus there are entire modules dedicated to doing this safely, such as File::AtomicWrite. These help with the issue of your program aborting and leaving you with a clobbered file.
As others pointed out, there are better ways :)
But if you really want to read and write using +<, you should remember that, after reading the file, you're at the end of the file... That explains that your output is appended after the original content.
What you need to do is reset the file-pointer to the beginning of the file, using seek:
seek(INCONFIG ,0,0);
Then start writing...
perlopentut says this about mixing reads and writes
In fact, when it comes to updating a file, unless you're working on a
binary file as in the WTMP case above, you probably don't want to use
this approach for updating. Instead, Perl's -i flag comes to the
rescue.
Another way is to use the Tie::File module. The code reduces to just this:
tie my #config, 'Tie::File', $text or die $!;
s/$checker/$somethingnew/g for #config;
But remember to back the file up before you modify it until you have debugged your program.

How do I give parallel write access to a file without collisions?

I have some child processes which should write some logs into a common file. I am wondering if this code work so that the processes will write into the common file without collisions:
sub appendLogs {
open FILE, "+>>", $DMP or die "$!";
flock FILE, LOCK_EX or die "$!";
print FILE "xyz\n";
close FILE;
}
If not, could you give me any hints, how I could fix or improve it?
For logging purpose, I would use Log4perl instead of reinventing the wheel. It has a support for what you are looking.
How can I synchronize access to an appender?
Log4Perl bundling logging from several programs into one log
Yes, as long as every process that tries to write to file uses flock, they will go without collisions.
If you would like your code to be portable, you should seek to the end of the file after you lock the filehandle but before you write to it. See the "mailbox appender" example in perldoc -f flock, which is similar to what you are doing.
sub appendLogs {
open FILE, "+>>", $DMP or die "$!";
flock FILE, LOCK_EX or die "$!";
seek FILE, 0, 2; # <--- after lock, move cursor to end of file
print FILE "xyz\n";
close FILE;
}
The seek may be necessary because another process could append the file (and move the position of the end of the file) after you open the file handle but before you acquire the lock.

PERL CGI program

I was trying out an elementary Perl/CGI script to keep track of visitors coming to a web page. The Perl code looks like this:
#!/usr/bin/perl
#KEEPING COUNT OF VISITORS IN A FILE
use CGI':standard';
print "content-type:text/html\n\n";
#opening file in read mode
open (FILE,"<count.dat");
$cnt= <FILE>;
close(FILE);
$cnt=$cnt+1;
#opening file to write
open(FILE,">count.dat");
print FILE $cnt;
close(FILE);
print "Visitor count: $cnt";
The problem is that the web page does not increment the count of visitors on each refresh. The count remains at the initital value of $cnt , ie 1. Any ideas where the problem lies?
You never test if the attempt to open the file handle works. Given a file which I had permission to read from and write to that contained a single number and nothing else, the code behaved as intended. If the file did not exist then the count would always be 1, if it was read-only then it would remain at whatever the file started at.
More general advice:
use strict; and use warnings; (and correct code based on their complaints)
Use the three argument call to open as per the first example in the documentation
When you open a file always || handle_the_error_in($!);
Don't use a file to store data like this, you have potential race conditions.
Get the name of the language correct
Here's an alternate solution that uses only one open() and creates the file if it doesn't already exist. Locking eliminates a potential race condition among multiple up-daters.
#!/usr/bin/env perl
use strict;
use warnings;
use Fcntl qw(:DEFAULT :flock);
my $file = 'mycount';
sysopen(my $fh, $file, O_RDWR|O_CREAT) or die "Can't open '$file' $!\n";
flock($fh, LOCK_EX) or die "Can't lock $file: $!\n";
my $cnt = <$fh>;
$cnt=0 unless $cnt;
$cnt++;
seek $fh, 0, 0;
print ${fh} $cnt;
close $fh or die "Can't close $file: $\n";
print "Visitor count: $cnt\n";
A few potential reasons:
'count.dat' is not being opened for reading. Always test with or die $!; at minimum to check if the file opened or not
The code is not being executed and you think it is
The most obvious thing that you would have forgotten is to change permissions of the file count.dat
Do this :
sudo chmod 777 count.dat
That should do the trick
You will need to close the webpage and reopen it again. Just refreshing the page won't increment the count.