#! /bin/sh /usr/share/dpatch/dpatch-run
## 10mbox-locking.dpatch by Niko Tyni <ntyni@iki.fi>
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: Policy-compliant mbox locking (hopefully).

@DPATCH@
--- a/lib/Email/LocalDelivery/Mbox.pm
+++ b/lib/Email/LocalDelivery/Mbox.pm
@@ -12,7 +12,7 @@
 use File::Path;
 use File::Basename;
 use Email::Simple 1.998;  # needed for ->header_obj
-use Fcntl ':flock';
+use Fcntl qw(:DEFAULT :seek);
 use Symbol qw(gensym);
 
 sub deliver {
@@ -42,7 +42,7 @@
     # This will make streaming a bit more annoying. -- rjbs, 2007-05-25
     print $fh "\n" unless $email->as_string =~ /\n$/;
 
-    $class->_close_fh($fh) || next;
+    $class->_close_fh($fh, $file) || next;
     push @rv, $file;
   }
   return @rv;
@@ -55,14 +55,14 @@
 
   my $fh = gensym;
   open $fh, ">> $file" or return;
-  $class->getlock($fh) || return;
+  $class->getlock($fh, $file) || return;
   seek $fh, 0, 2;
   return $fh;
 }
 
 sub _close_fh {
-  my ($class, $fh) = @_;
-  $class->unlock($fh) || return;
+  my ($class, $fh, $file) = @_;
+  $class->unlock($fh, $file) || return;
   close $fh or return;
   return 1;
 }
@@ -103,17 +103,69 @@
 }
 
 sub getlock {
+  my ($class, $fh, $file) = @_;
+  for (1..10) {
+    return 0 unless $class->getlock_fcntl($fh);
+    return 1 if $class->getlock_dotlock($file);
+    sleep int(rand(10 * $_));
+  }
+  $class->unlock_fcntl($fh);
+  return 0;
+
+}
+
+sub getlock_fcntl {
   my ($class, $fh) = @_;
-  for (1 .. 10) {
-    return 1 if flock($fh, LOCK_EX | LOCK_NB);
+  my $lock = pack('ss@256', F_WRLCK, SEEK_SET);
+  for (1..10) {
+    return 1 if fcntl($fh, F_SETLK, $lock);
     sleep $_;
   }
+  return 0 ;
+}
+
+sub getlock_dotlock {
+  my ($class, $file) = @_;
+  my $lockfile = $file . ".lock";
+  my $cmd = "/usr/bin/dotlockfile";
+  system($cmd, $lockfile);
+  return 1 unless $?;
+  if ($? == -1) {
+    die("Couldn't exec $cmd: $!");
+  }
+  if ($? & 127) {
+    warn("$cmd exited with signal " . ($? & 127));
+  }
   return 0;
 }
 
 sub unlock {
+  my ($class,$fh, $file) = @_;
+  return 0 unless $class->unlock_dotlock($file);
+  return 0 unless $class->unlock_fcntl($fh);
+  return 1;
+}
+
+sub unlock_fcntl {
   my ($class, $fh) = @_;
-  flock($fh, LOCK_UN);
+  my $lock = pack('ss@256', F_UNLCK, SEEK_SET);
+  return 1 if fcntl($fh, F_SETLK, $lock);
+  return 0;
+}
+
+sub unlock_dotlock {
+  my ($class, $file) = @_;
+  my $lockfile = $file . ".lock";
+  my $cmd = "/usr/bin/dotlockfile";
+  system($cmd, "-u", $lockfile);
+  return 1 unless $?;
+  if ($? == -1) {
+    die("Couldn't exec $cmd: $!");
+  }
+  if ($? & 127) {
+    warn("$cmd exited with signal " . ($? & 127));
+  }
+  return 0;
 }
 
 1;