File Coverage

blib/script/plockf

Criterion	Covered	Total	%
statement	116	147	78.9
branch	47	74	63.5
condition	30	63	47.6
subroutine	23	26	88.4
pod			n/a
total	216	310	69.6

#!/usr/local/bin/perl -w
# -*- perl -*-

#
# Author: Slaven Rezic
#
# Copyright (C) 2016,2017,2026 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# WWW:  https://github.com/eserte/app-plockf
#

use strict;
use Errno;
use Fcntl ();
use Getopt::Long;

use vars qw($VERSION);
$VERSION = "0.05";

# sysexits(3) constants
use constant EX_USAGE       => 64;
use constant EX_UNAVAILABLE => 69;
use constant EX_SOFTWARE    => 70;
use constant EX_OSERR       => 71;
use constant EX_CANTCREAT   => 73;
use constant EX_TEMPFAIL    => 75;

sub set_impl ();
sub handle_error ($);
sub progname ();

sub usage (;$) {
    my $msg = shift;
    if ($msg) {
	warn $msg, "\n";
    }
    warn "usage: " . progname . " [-kns] [-t seconds] file command [arguments]\n";
    exit EX_USAGE;
}

my $timeout;
my $keep;
my $silent;
my $nocreat;

Getopt::Long::Configure('require_order');
GetOptions(
	   'help|h|?' => sub { usage },
	   'k'        => \$keep,
	   'n'        => \$nocreat,
	   's'        => \$silent,
	   't=f'      => \$timeout,
	   'v|version'            => sub {
	       print "plockf version $VERSION\n";
	       exit 0;
	   },
	  );

if (defined $timeout && $timeout < 0) {
    usage "Timeout must be positive";
}

my $lock_file = shift
    or usage "Lock file is not specified";
my $cmd = shift
    or usage "Command is not specified";

set_impl;

my $timed_out;
my $alarm;
if (defined $timeout && $timeout > 0) {
    $SIG{ALRM} = sub { $timed_out = 1 };
    if ($timeout !~ m{^\d+$} && eval { require Time::HiRes; Time::HiRes->VERSION(1.9716); Time::HiRes->import('ualarm'); 1 }) { # do we need and can we do floating point timeouts?
	$alarm = \&Time::HiRes::alarm;
    } else {
	if ($timeout < 1) { $timeout = 1 }
	$alarm = sub { alarm($_[0]) };
    }
    $alarm->($timeout);
}

my $lock_fh = acquire_lock(0);
while (!$lock_fh && !$timed_out && (!defined $timeout || $timeout > 0)) {
    if ($^O eq 'MSWin32') {
	# systems where alarm() does not work with blocking syscalls
	wait_for_lock_nonblocking();
	$lock_fh = acquire_lock(0);
    } elsif ($keep) {
	$lock_fh = acquire_lock(1);
    } else {
	wait_for_lock();
	$lock_fh = acquire_lock(0);
    }
}

if ($alarm) {
    $alarm->(0);
}

if (!$lock_fh) {
    handle_error EX_TEMPFAIL;
}

my $do_cleanup = !$keep;

$SIG{TERM} = sub { exit }; # would run END block

system { $cmd } $cmd, @ARGV;
if ($? == -1) {
    warn progname . ": calling '$cmd @ARGV' failed: $!\n";
    exit EX_OSERR;
} elsif ($? & 127) {
    exit EX_SOFTWARE;
} else {
    my $exit_code = $? >> 8;
    exit $exit_code;
}

END {
    if ($do_cleanup) {
	unlink $lock_file;
    }
}

sub set_impl () {
    my($block) = @_;
    if      (   ($] <  5.010 && eval { &Fcntl::O_EXLOCK } && eval { &Fcntl::O_NONBLOCK })
	     || ($] >= 5.010 && defined &Fcntl::O_EXLOCK && defined &Fcntl::O_NONBLOCK)) {
	*acquire_lock  = \&acquire_lock_bsd;
	*wait_for_lock = \&wait_for_lock_bsd;
    } elsif (   ($] <  5.010 && eval { &Fcntl::LOCK_EX } && eval { &Fcntl::LOCK_NB })
	     || ($] >= 5.010 && defined &Fcntl::LOCK_EX && defined &Fcntl::LOCK_NB)) {
	*acquire_lock  = \&acquire_lock_other;
	*wait_for_lock = \&wait_for_lock_other;
    } else {
	die "Can't lock on this operating system";
    }
}

sub acquire_lock_bsd {
    my($block) = @_;
    my $lock_fh;
    if (!sysopen $lock_fh, $lock_file, &Fcntl::O_RDONLY|($block ? 0 : &Fcntl::O_NONBLOCK)|&Fcntl::O_EXLOCK|($nocreat ? 0 : &Fcntl::O_CREAT), 0666) {
	if ($!{EAGAIN} || $!{EINTR}) {
	    return undef;
	}
	if ($nocreat && $!{ENOENT}) {
	    handle_error EX_UNAVAILABLE;
	} else {
	    handle_error EX_CANTCREAT;
	}
    }
    return $lock_fh;
}

sub wait_for_lock_bsd {
    sysopen my $fh, $lock_file, &Fcntl::O_EXLOCK;
    # no error handling needed; probably same failure will happen in acquire_lock_bsd
}

sub acquire_lock_other {
    my($block) = @_;
    my $lock_fh;
    if (!sysopen $lock_fh, $lock_file, &Fcntl::O_RDONLY|($nocreat ? 0 : &Fcntl::O_CREAT), 0666) {
	if ($!{EAGAIN} || $!{EINTR}) {
	    return undef;
	}
	if ($nocreat && $!{ENOENT}) {
	    handle_error EX_UNAVAILABLE;
	} else {
	    handle_error EX_CANTCREAT;
	}
    }
    if (!flock $lock_fh, ($block ? 0 : &Fcntl::LOCK_NB)|&Fcntl::LOCK_EX) {
	return undef;
    }
    if (!$keep) {
	my @stat_file = stat $lock_file;
	if (!@stat_file) {
	    # file was unlinked in the meantime
	    return undef;
	}
	if ($^O ne 'MSWin32') { # ino+dev are not meaningful on Windows systems
	    my @stat_fh = stat $lock_fh;
	    if ($stat_fh[1] != $stat_file[1] || $stat_fh[0] != $stat_file[0]) {
		# file was unlinked in the meantime and another plockf process was faster
		return undef;
	    }
	}
    }
    return $lock_fh;
}

sub wait_for_lock_other {
    if (sysopen my $fh, $lock_file, &Fcntl::O_RDONLY) {
	flock $fh, &Fcntl::LOCK_EX;
    }
}

sub wait_for_lock_nonblocking {
    while () {
	last if $timed_out;
	if (sysopen my $fh, $lock_file, &Fcntl::O_RDONLY) {
	    return if flock $fh, &Fcntl::LOCK_EX|&Fcntl::LOCK_NB;
	}
	sleep 1;
    }
}

sub handle_error ($) {
    my $exit = shift;
    unless ($silent) {
	if ($exit == EX_UNAVAILABLE) {
	    warn progname . ": cannot open $lock_file: $!\n";
	} else {
	    warn progname . ": $lock_file: already locked\n";
	}
    }
    exit $exit;
}

sub progname () {
    require File::Basename;
    File::Basename::basename($0);
}

__END__