Slightly revised install-info fcntl patch

[Nathanael Nerode <neroden@fastmail.fm>]

This is only slightly revised from the previous version;
I accidentally deleted the lines which create the backup file in /var/backups.
Those are restored in this version of the patch.

--- install-info.pl.orig	2006-06-07 00:58:26.000000000 -0400
+++ install-info.pl	2006-06-07 02:48:22.000000000 -0400
@@ -1,6 +1,8 @@
 #!/usr/bin/perl --
 
 use Text::Wrap;
+use Fcntl ':flock';
+use Fcntl ':seek';
 
 my $dpkglibdir = "."; # This line modified by Makefile
 push (@INC, $dpkglibdir);
@@ -301,18 +303,28 @@
     }
 }
 
-if (!$nowrite && !link($dirfile, "$dirfile.lock")) {
-    printf( STDERR _g("%s: failed to lock dir for editing! %s")."\n",
-	    $name, $! );
-    printf( STDERR _g("try deleting %s?")."\n", "$dirfile.lock")
-	if $!{EEXIST};
+# Handle (sort of) being run concurrently with older versions.
+if (!$nowrite && -e "$dirfile.lock") {
+    printf( STDERR _g("%s: old lockfile still present! ")."\n",
+	    $name);
+    printf( STDERR _g("try deleting %s?")."\n", "$dirfile.lock");
     exit 1;
 }
 
-open(OLD,$dirfile) || &ulquit(sprintf(_g("open %s: %s"), $dirfile, $!));
-@work= <OLD>;
-eof(OLD) || &ulquit(sprintf(_g("read %s: %s"), $dirfile, $!));
-close(OLD) || &ulquit(sprintf(_g("close %s after read: %s"), $dirfile, $!));
+if (!$nowrite) {
+    # Open for reading and writing, and lock it.
+    open(DIRFILE,"+<",$dirfile) || &ulquit(sprintf(_g("open %s: %s"), $dirfile, $!));
+    flock(DIRFILE, LOCK_EX);
+    # Back it up.  Since we'll be erasing the original, this is crucial.
+    unlink("$dirfile.old");
+    system ('cp', $dirfile, "$dirfile.old") &&
+	&ulquit(sprintf(_g("cannot backup old %s, giving up: %s"), $dirfile, $!));
+} else {
+    open(DIRFILE,"<",$dirfile) || &ulquit(sprintf(_g("open %s: %s"), $dirfile, $!));
+}
+
+@work= <DIRFILE>;
+eof(DIRFILE) || &ulquit(sprintf(_g("read %s: %s"), $dirfile, $!));
 
 while (($#work >= 0) && ($work[$#work] !~ m/\S/)) { $#work--; }
 
@@ -478,27 +490,23 @@
 }
 
 if (!$nowrite) {
-    open(NEW,"> $dirfile.new") || &ulquit(sprintf(_g("create %s: %s"), "$dirfile.new", $!));
-    print(NEW @head,join("\n",@newwork)) ||
-	&ulquit(sprintf(_g("write %s: %s"), "$dirfile.new", $!));
-    close(NEW) || &ulquit(sprintf(_g("close %s: %s"), "$dirfile.new", $!));
-
-    unlink("$dirfile.old");
-    link($dirfile, "$dirfile.old") ||
-	&ulquit(sprintf(_g("cannot backup old %s, giving up: %s"), $dirfile, $!));
-    rename("$dirfile.new", $dirfile) ||
-	&ulquit(sprintf(_g("install new %s: %s"), $dirfile, $!));
+    # Switch from reading to writing, still holding the same lock on the same file
+    seek(DIRFILE,0,SEEK_SET)
+      || &ulquit(sprintf(_g("seeking start of %s: %s"), $dirfile, $!));
+    truncate(DIRFILE, 0)
+      || &ulquit(sprintf(_g("truncating %s: %s"), $dirfile, $!));
+    print(DIRFILE @head,join("\n",@newwork)) ||
+	&ulquit(sprintf(_g("writing new %s: %s"), $dirfile, $!));
+    flock(DIRFILE, LOCK_UN);
+}
+close(DIRFILE) || &ulquit(sprintf(_g("close %s: %s"), $dirfile, $!));
 
-    unlink("$dirfile.lock") ||
-	die sprintf(_g("%s: unlock %s: %s"), $name, $dirfile, $!)."\n";
+if (!$nowrite) {
     system ('cp', $dirfile, $backup) &&
-	warn sprintf(_g("%s: couldn't backup %s in %s: %s"), $name, $dirfile, $backup, $!)."\n";
+  warn sprintf(_g("%s: couldn't backup %s in %s: %s"), $name, $dirfile, $backup, $!)."\n";
 }
 
 sub ulquit {
-    unlink("$dirfile.lock") ||
-	warn sprintf(_g("%s: warning - unable to unlock %s: %s"),
-		     $name, $dirfile, $!)."\n";
     die "$name: $_[0]\n";
 }
 

-- 
Nathanael Nerode  <neroden@fastmail.fm>

[Insert famous quote here]