# Blocking Shared Lock Test
use strict;
use warnings;
use File::Temp qw(tempfile);

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);

# $m simultaneous processes trying to obtain a shared lock
my $m = 20;
my $shared_delay = 5;

$| = 1; # Buffer must be autoflushed because of fork() below.

my $datafile = (tempfile 'XXXXXXXXXX')[1];

# Create a blank file
sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC );
close ($fh);
# test 1
ok (-e $datafile && !-s _);


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
  my $lock = new File::NFSLock {
    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);
  if ($lock) {
    sleep 2;  # 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);


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 {
    file => $datafile,
    lock_type => LOCK_SH,
  };
  if ($lock) {
    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;
    # 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
    # status is reported (close RD2) so it defines execution
    # sequence will be correct.  Hopefully the shared lock
    # will not happen until the exclusive lock has been released.
    # 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);
  # Then hold this shared lock for a moment
  # while other shared locks are attempted
  sleep($shared_delay*2);
  exit; # Release the shared lock
}
# test 6
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 eventually been successful.
# test 7
ok ($child2_lock);

# If all these processes take longer than $shared_delay seconds,
# then they are probably not running synronously
# and the shared lock is not working correctly.
# But if all the children obatin the lock simultaneously,
# like they're supposed to, then it shouldn't take
# much longer than the maximum delay of any of the
# shared locks (at least 5 seconds set above).
$SIG{ALRM} = sub {
  # test (unknown)
  ok 0;
  die "Shared locks not running simultaneously";
};

# Use pipe to read lock success status from children
# test 8
my ($rd3, $wr3);
ok (pipe($rd3, $wr3));

# Wait a few seconds less than if all locks were
# acquired asyncronously to ensure that they overlap.
alarm($m*$shared_delay-2);

for (my $i = 0; $i < $m ; $i++) {
  if (!fork) {
    # All of these locks should immediately be successful since
    # there already exist a shared lock.
    my $lock = new File::NFSLock {
      file => $datafile,
      lock_type => LOCK_SH,
    };
    # Send boolean success status down pipe
    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(my $fh, $datafile, O_RDWR | O_APPEND);
      # Put one line to signal the lock was successful.
      print $fh "1\n";
      close $fh;
      $lock->unlock();
    } else {
      warn "Lock [$i] failed!";
    }
    exit;
  }
}

# Parent process never writes to pipe
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 = <$rd3>;
  # test 9 .. 8+$m
  ok $got_shared_lock;
}

# There should not be anything left in the pipe.
my $extra = <$rd3>;
# test 9 + $m
ok !$extra;
close ($rd3);

# If we made it here, then it must have been faster
# than the timeout.  So reset the timer.
alarm(0);
# test 10 + $m
ok 1;

# There are $m children plus the child1 exclusive locker
# and the child2 obtaining the first shared lock.
for (my $i = 0; $i < $m + 2 ; $i++) {
  # Wait until all the children are finished.
  wait;
  # test 11+$m .. 12+2*$m
  ok 1;
}

# Load up whatever the file says now
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
  is $_, 1;
}
close $fh2;

# Wipe the temporary file
unlink $datafile;