- move lock functions to a full blown module

- handle get_exclusive and release_exclusive on existing lock, 
  *but* don't use it for now! (not useful)
- remove urpmi_db locking from add_medium and update_media
- move rpm_db locking into _read_cachedir_pubkey
- update_media: restrict rpm_db exclusive locking to parse_pubkeys
- urpmi: move locking rpm_db near its use
- handle lock directly in urpmi.addmedia, urpmi.update, urpme, urpmf
- log locking/unlocking

3 files changed, 94 insertions, 55 deletions

diff --git a/urpm/lock.pm b/urpm/lock.pm
new file mode 100644
index 00000000..e59e3faa
--- /dev/null
+++ b/urpm/lock.pm
@@ -0,0 +1,89 @@
+package urpm::lock;
+
+# $Id$
+
+use urpm::msg;
+
+
+#- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base).
+my ($LOCK_SH, $LOCK_EX, $LOCK_NB, $LOCK_UN) = (1, 2, 4, 8);
+
+
+################################################################################
+#- class functions
+
+#- lock policy concerning chroot :
+#  - lock rpm db in chroot
+#  - lock urpmi db in /
+sub rpm_db {
+    my ($urpm, $b_exclusive) = @_;
+    urpm::lock->new($urpm, "$urpm->{root}/$urpm->{statedir}/.RPMLOCK", 'rpm', $b_exclusive);
+}
+sub urpmi_db {
+    my ($urpm, $b_exclusive, $b_nofatal) = @_;
+    urpm::lock->new($urpm, "$urpm->{statedir}/.LOCK", 'urpmi', $b_exclusive, $b_nofatal);
+}
+
+
+################################################################################
+#- methods
+
+sub new {
+    my ($_class, $urpm, $file, $db_name, $b_exclusive, $b_nofatal) = @_;
+    
+    my $fh;
+    #- we don't care what the mode is. ">" allow creating the file, but can't be done as user
+    open($fh, '>', $file) or open($fh, '<', $file) or return;
+
+    my $lock = bless { 
+	fh => $fh, db_name => $db_name, 
+	fatal => $b_nofatal ? $urpm->{error} : sub { $urpm->{fatal}(7, $_[0]) }, 
+	log => $urpm->{log},
+    };
+    _lock($lock, $b_exclusive);
+    $lock;
+}
+
+sub _flock_failed {
+    my ($lock) = @_;
+    $lock->{fatal}(N("%s database locked", $lock->{db_name}));
+}
+
+sub _lock {
+    my ($lock, $b_exclusive) = @_;
+    $b_exclusive ||= '';
+    if ($lock->{log}) {
+	my $action = $lock->{exclusive} && !$b_exclusive ? 'releasing exclusive' : $b_exclusive ? 'getting exclusive' : 'getting';
+	$lock->{log}("$action lock on $lock->{db_name}");
+    }
+    my $mode = $b_exclusive ? $LOCK_EX : $LOCK_SH;
+    flock $lock->{fh}, $mode|$LOCK_NB or _flock_failed($lock);
+    $lock->{locked} = 1;
+    $lock->{exclusive} = $b_exclusive;
+}
+
+sub get_exclusive {
+    my ($lock) = @_;
+    _lock($lock, 'exclusive');
+}
+sub release_exclusive {
+    my ($lock) = @_;
+    _lock($lock);
+}
+
+sub unlock {
+    my ($lock) = @_;
+    $lock->{fh} or warn "lock $lock->{db_name} already release\n", return;
+
+    if ($lock->{locked}) {
+	$lock->{log} and $lock->{log}("unlocking $lock->{db_name} database");
+	flock $lock->{fh}, $LOCK_UN;
+    }
+    close $lock->{fh};
+    delete $lock->{fh};
+}
+
+sub DESTROY { 
+    my ($lock) = @_;
+    unlock($lock) if $lock->{fh};
+}
diff --git a/urpm/media.pm b/urpm/media.pm
index c55fb786..48687bfd 100644
--- a/urpm/media.pm
+++ b/urpm/media.pm
@@ -6,6 +6,7 @@ use urpm 'file_from_local_url';
 use urpm::msg;
 use urpm::util;
 use urpm::removable;
+use urpm::lock;
 
 
 our @PER_MEDIA_OPT = qw(
@@ -600,7 +601,6 @@ sub add_medium {
 
     #- make sure configuration has been read.
     $urpm->{media} or die "caller should have used ->read_config or ->configure first";
-    my $lock = urpm::sys::lock_urpmi_db($urpm, 'exclusive');
 
     #- if a medium with that name has already been found, we have to exit now
     my $medium;
@@ -643,7 +643,6 @@ sub add_medium {
     $urpm->{log}(N("added medium %s", $name));
     $urpm->{modified} = 1;
 
-    $lock and urpm::sys::unlock($lock);
     $name;
 }
 
@@ -1475,6 +1474,8 @@ sub _read_cachedir_pubkey {
 
     $urpm->{log}(N("examining pubkey file of \"%s\"...", $medium->{name}));
 
+    my $_rpm_lock = urpm::lock::rpm_db($urpm, 'exclusive');
+
     my %key_ids;
     $urpm->import_needed_pubkeys(
 	[ $urpm->parse_armored_file("$urpm->{cachedir}/partial/pubkey") ],
@@ -1698,7 +1699,6 @@ sub _update_media__handle_some_flags {
 #-   force       : try to force rebuilding base files
 #-   force_building_hdlist
 #-   noclean     : keep old files in the header cache directory
-#-   nolock      : don't lock the urpmi database
 #-   nomd5sum    : don't verify MD5SUM of retrieved files
 #-   nopubkey    : don't use rpm pubkeys
 #-   probe_with  : probe synthesis or hdlist (or none)
@@ -1709,14 +1709,11 @@ sub update_media {
     $urpm->{media} or return; # verify that configuration has been read
 
     $options{nopubkey} ||= $urpm->{options}{nopubkey};
-    #- get gpg-pubkey signature.
-    my $rpm_lock;
     if (!$options{nopubkey}) {
-	$rpm_lock = urpm::sys::lock_rpm_db($urpm, 'exclusive');
+	#- get gpg-pubkey signature.
+	my $_rpm_lock = urpm::lock::rpm_db($urpm);
 	$urpm->{keys} or $urpm->parse_pubkeys(root => $urpm->{root});
     }
-    #- lock database if allowed.
-    my $urpmi_lock = urpm::sys::lock_urpmi_db($urpm, 'exclusive') if !$options{nolock};
 
     #- examine each medium to see if one of them needs to be updated.
     #- if this is the case and if not forced, try to use a pre-calculated
@@ -1766,9 +1763,6 @@ sub update_media {
 	#- NB: in case of $urpm->{modified}, write_MD5SUM is called in write_config above
 	write_MD5SUM($urpm);
     }
-
-    $urpmi_lock and urpm::sys::unlock($urpmi_lock);
-    $rpm_lock and urpm::sys::unlock($rpm_lock);
 }
 
 #- clean params and depslist computation zone.
diff --git a/urpm/sys.pm b/urpm/sys.pm
index a6fb4fa7..2a35b3af 100644
--- a/urpm/sys.pm
+++ b/urpm/sys.pm
@@ -190,50 +190,6 @@ sub clean_dir {
     mkdir $dir, 0755;
 }
 
-#- lock policy concerning chroot :
-#  - lock rpm db in chroot
-#  - lock urpmi db in /
-sub _lock {
-    my ($urpm, $file, $msg, $b_exclusive) = @_;
-#    warn "locking $file $b_exclusive\n";
-    #- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base).
-    my ($LOCK_SH, $LOCK_EX, $LOCK_NB) = (1, 2, 4);
-    if ($b_exclusive) {
-	#- lock urpmi database, but keep lock to wait for an urpmi.update to finish.
-    } else {
-	#- create the .LOCK file if needed (and if possible)
-	-e $file or open(my $_f, ">", $file);
-
-	#- lock urpmi database, if the LOCK file doesn't exists no share lock.
-    }
-    my ($sense, $mode) = $b_exclusive ? ('>', $LOCK_EX) : ('<', $LOCK_SH);
-    open(my $fh, $sense, $file) or return;
-    flock $fh, $mode|$LOCK_NB or $urpm->{fatal}(7, $msg);
-#    warn "locked $file $b_exclusive ($fh)\n";
-    $fh;
-}
-
-
-sub lock_rpm_db {
-    my ($urpm, $b_exclusive) = @_;
-    _lock($urpm, "$urpm->{root}/$urpm->{statedir}/.RPMLOCK", N("rpm database locked"), $b_exclusive);
-}
-sub lock_urpmi_db {
-    my ($urpm, $b_exclusive) = @_;
-    _lock($urpm, "$urpm->{statedir}/.LOCK", N("urpmi database locked"), $b_exclusive);
-}
-
-sub unlock {
-    my ($fh) = @_;
-#    warn "unlocking $fh\n";
-    #- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base).
-    my $LOCK_UN = 8;
-    #- now everything is finished.
-    #- release lock on database.
-    flock $fh, $LOCK_UN;
-    close $fh;
-}
-
 sub syserror { 
     my ($urpm, $msg, $info) = @_;
     $urpm->{error}("$msg [$info] [$!]");