tags 2531 +patch
thanks
This patch converts install-info to use perl's flock for locking. I have been
told that this uses the system's fcntl in Debian's perl installation. (It is
written to tolerate any implementation of flock which perl may supply, however.)
As part of this change, it now operates directly on the dir file rather than
creating a new dir file and then relocating it. (This is the cleanest way to
make the locking actually work right.) Accordingly the creation of the backup
dir file is moved *before* the actual work rather than after it.
This has been tested (by hand-invocation). It works.
It *might* require that dpkg acquire a dependency on a version of perl-base
newer
than something or other. I'm not sure because I'm not sure when exactly the
necessary functionality arrived in perl. I doubt that it requires such a
dependency; I believe all the necessary functionality is present in 5.8.4
(which
is in 'stable'); I'm just not 100% sure.
This is copyright-worthy content, so here's my copyright notice for
debian/copyright
(should you choose to apply this patch):
Copyright 2006 Nathanael Nerode <[EMAIL PROTECTED]>
--- install-info.pl.orig 2006-06-07 00:58:26.000000000 -0400
+++ install-info.pl 2006-06-07 02:27:38.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, $!));
[EMAIL PROTECTED] <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,
$!));
+}
+
[EMAIL PROTECTED] <DIRFILE>;
+eof(DIRFILE) || &ulquit(sprintf(_g("read %s: %s"), $dirfile, $!));
while (($#work >= 0) && ($work[$#work] !~ m/\S/)) { $#work--; }
@@ -478,27 +490,18 @@
}
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, $!));
-
- unlink("$dirfile.lock") ||
- die sprintf(_g("%s: unlock %s: %s"), $name, $dirfile, $!)."\n";
- system ('cp', $dirfile, $backup) &&
- warn sprintf(_g("%s: couldn't backup %s in %s: %s"), $name, $dirfile,
$backup, $!)."\n";
+ # 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, $!));
sub ulquit {
- unlink("$dirfile.lock") ||
- warn sprintf(_g("%s: warning - unable to unlock %s: %s"),
- $name, $dirfile, $!)."\n";
die "$name: $_[0]\n";
}
--
Nathanael Nerode <[EMAIL PROTECTED]>
[Insert famous quote here]
--
To UNSUBSCRIBE, email to [EMAIL PROTECTED]
with a subject of "unsubscribe". Trouble? Contact [EMAIL PROTECTED]
