#!/usr/bin/perl
##
## util-linux flock(1) clone
## Copyright (c) 2011 SATOH Fumiyasu @ OSS Technology Corp.
##               <http://www.osstech.co.jp/>
##
## License: GNU General Public License version 3 or later
## Date: 2011-12-17, since 2011-12-17
##

use strict;
use warnings;
use English qw(-no_match_vars);
use Getopt::Long qw(:config gnu_getopt no_ignore_case no_auto_abbrev no_permute);
use IO::File;
use Fcntl qw(:flock);
use POSIX;
use Errno;

use constant true => 1;
use constant false => 0;

eval { require 'sysexits.ph'; };
if ($EVAL_ERROR) {
  sub EX_USAGE { return 64; };
  sub EX_DATAERR { return 65; };
  sub EX_NOINPUT { return 66; };
  sub EX_UNAVAILABLE { return 69; };
  sub EX_OSERR { return 71; };
  sub EX_CANTCREAT { return 73; };
}

sub perr {
  print STDERR "$0: ERROR: $_[0]\n";
}

sub pdie {
  perr($_[0]);
  exit(defined($_[1]) ? $_[1] : 1);
}

## ======================================================================

my $lock_mode = LOCK_EX;
my $lock_nonblock = false;
my $lock_timeout = -1;
my $do_close = false;

my $cmd_usage = <<EOT_CMD_USAGE;
Usage: $0 [OPTIONS] LOCKFILE [-c] COMMAND [ARG ...]

Optoins:
 -s, --shared
    Get a shared lock
 -x, --exclusive
    Get an exclusive lock (default)
 -u, --unlock
    Remove a lock
 -n, --nonblock
    Fail rather than wait
 -w, --timeout SECOND
    Wait for a limited amount of time
 -o, --close
    Close file descriptor of the lock file before running the command
 -c, --command
    Run a single command string through the shell
EOT_CMD_USAGE

{
  ## Trap warning messages from Getopt::Long
  local($SIG{'__WARN__'}) = sub {
    my ($msg) = shift(@_);
    chomp($msg);
    perr $msg;
  };
  GetOptions(
    'h|help' =>			sub { print $cmd_usage; exit(&EX_USAGE); },
    's|shared' =>		sub { $lock_mode = LOCK_SH; },
    'x|e|exclude' =>		sub { $lock_mode = LOCK_EX; },
    'u|unlock' =>		sub { $lock_mode = LOCK_UN; },
    'n|nb|nonblock' =>		\$lock_nonblock,
    'w|wait|timeout=i' =>	\$lock_timeout,
    'o|close' =>		\$do_close,
  ) || exit(&EX_USAGE);
}

if (@ARGV < 2) {
  print $cmd_usage;
  exit(1);
}

my $lock_fname = shift(@ARGV);
my $command = shift(@ARGV);
my @args = @ARGV;

if ($command eq '-c' || $command eq '--command') {
  if (@args != 1) {
    pdie "$command requires exactly one command argument";
  }

  $command = $ENV{SHELL} || '/bin/sh';
  unshift(@args, '-c');
}

my $open_mode = ($lock_mode == LOCK_EX) ? O_RDWR : O_RDONLY;
$open_mode |= O_CREAT | O_NOCTTY;

$lock_mode |= LOCK_NB if $lock_nonblock;

my $lock_fh = IO::File->new($lock_fname, $open_mode, 0666);
if (!defined($lock_fh) && $ERRNO == Errno::EISDIR) {
  $lock_fh = IO::File->new($lock_fname, O_RDONLY | O_NOCTTY);
}
if (!defined($lock_fh)) {
  my $ex =
    (grep {$_} @ERRNO{Errno::ENOMEM, Errno::EMFILE, Errno::ENFILE}) ? &EX_OSERR :
    (grep {$_} @ERRNO{Errno::EROFS, Errno::ENOSPC}) ? &EX_CANTCREAT :
    &EX_NOINPUT;
  pdie "Cannot open lock file: $lock_fname: $!", $ex;
}

my $lock_timeout_expired = false;
$SIG{ALRM} = sub { $lock_timeout_expired = true; };
alarm($lock_timeout) if ($lock_timeout >= 0);

if (!flock($lock_fh, $lock_mode)) {
  if ($ERRNO == Errno::EAGAIN && $lock_mode & LOCK_NB) {
    ## $lock_mode has LOCK_NB and failed to lock
    exit(1);
  }
  if ($ERRNO == Errno::EINTR && $lock_timeout_expired) {
    exit(1);
  }
  my $ex =
    (grep {$_} @ERRNO{Errno::ENOLCK, Errno::ENOMEM}) ? &EX_OSERR : &EX_DATAERR;
  pdie "Cannot lock file: $lock_fname: $!", $ex;
}

if (!defined($command)) {
  exit(0);
}

my $command_pid = fork;
if ($command_pid < 0) {
  pdie "fork failed: $!", &EX_OSERR;
}

if ($command_pid == 0) {
  ## Child process
  close($lock_fh) if ($do_close);
  local $SIG{'__WARN__'} = sub {}; ## Suppress Perl's warning on exec failed
  if (!exec {$command} $command, @args) {
    perr "Cannot execute command: $command: $!";
    (POSIX::_exit($ERRNO == Errno::ENOMEM) ? &EX_OSERR : &EX_UNAVAILABLE);
  }
}

if (waitpid($command_pid, 0) < 0) {
  pdie "waitpid failed: $!";
}

exit(POSIX::WIFSIGNALED($?) ? POSIX::WTERMSIG($?) + 128 : POSIX::WEXITSTATUS($?));

