- 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

11 files changed, 112 insertions, 78 deletions

diff --git a/gurpmi2 b/gurpmi2
index 300034aa..737e92d1 100755
--- a/gurpmi2
+++ b/gurpmi2
@@ -121,9 +121,8 @@ sub configure_urpm() {
 	$w->run;
 	$w->destroy;
     };
-    $rpm_lock = urpm::sys::lock_rpm_db($urpm, 'exclusive');
-    $urpmi_lock = urpm::sys::lock_urpmi_db($urpm);
-    urpm::media::configure($urpm,
+    $rpm_lock = urpm::lock::rpm_db($urpm, 'exclusive');
+    $urpmi_lock = urpm::media::configure($urpm,
 	root	    => $gurpmi::options{root},
 	media	    => $gurpmi::options{media},
 	searchmedia => $gurpmi::options{searchmedia},
@@ -339,7 +338,7 @@ sub do_install_3 () {
     } else {
 	$progress_label->set_label(N("Installation finished"));
     }
-    urpm::sys::unlock($urpmi_lock);
-    urpm::sys::unlock($rpm_lock);
+    $urpmi_lock->unlock;
+    $rpm_lock->unlock;
     urpm::removable::try_umounting_removables($urpm);
 }
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] [$!]");
diff --git a/urpme b/urpme
index 6938a543..cc8c1f3f 100644
--- a/urpme
+++ b/urpme
@@ -82,6 +82,7 @@ unless ($test) {
 }
 
 #- just configure parallel mode if available.
+my $_urpmi_lock = urpm::lock::urpmi_db($urpm);
 urpm::media::configure($urpm,
     synthesis => ($parallel ? 'none' : ''),
     root => $root,
diff --git a/urpmf b/urpmf
index 7feb8b90..4605ca39 100755
--- a/urpmf
+++ b/urpmf
@@ -190,12 +190,7 @@ if ($env) {
     $urpm->{statedir} = $env;
 }
 
-my $lock = do {
-    #- lock to avoid concurrent media updates,
-    #- but don't die if it doesn't work
-    local $urpm->{fatal} = sub { printf STDERR "%s\n", $_[1] };
-    urpm::sys::lock_urpmi_db($urpm);
-};
+my $lock = urpm::lock::urpmi_db($urpm, '', 'nofatal');
 my $need_hdlist = grep { $usedtags{$_} } qw(
     buildhost
     buildtime
@@ -219,7 +214,6 @@ urpm::media::configure($urpm,
     callback => $callback,
     need_hdlist => $need_hdlist,
 );
-urpm::sys::unlock($lock);
 
 if ($need_hdlist) {
     # @hdmedia is the list of all media searched that use hdlists
diff --git a/urpmi b/urpmi
index 767de487..4e66aaf4 100755
--- a/urpmi
+++ b/urpmi
@@ -334,11 +334,7 @@ if (exists $urpm->{options}{'priority-upgrade'} && $urpm->{options}{'priority-up
     unlink glob('/var/lib/rpm/__db.*') unless $root;
 }
 
-my ($rpm_lock, $urpmi_lock);
-unless ($env || $nolock) {
-    $rpm_lock = urpm::sys::lock_rpm_db($urpm, 'exclusive');
-    $urpmi_lock = urpm::sys::lock_urpmi_db($urpm);
-}
+my $urpmi_lock = !$env && !$nolock && urpm::lock::urpmi_db($urpm);
 
 #- should we ignore arch compatibility
 if ($urpm->{options}{ignorearch}) { urpm::shunt_ignorearch() }
@@ -402,6 +398,8 @@ if ($bug) {
     urpm::bug_report::copy_requested($urpm, $bug, \%requested);
 }
 
+my $rpm_lock = !$env && !$nolock && urpm::lock::rpm_db($urpm, 'exclusive');
+
 #- search the packages according to the selection given by the user.
 my $search_result;
 if (@names) {
@@ -826,8 +824,8 @@ if ($nok) {
 }
 
 unless ($env || $nolock) {
-    urpm::sys::unlock($urpmi_lock);
-    urpm::sys::unlock($rpm_lock);
+    $urpmi_lock->unlock;
+    $rpm_lock->unlock;
 
     #- try to umount removable device which may have been mounted.
     urpm::removable::try_umounting_removables($urpm);
diff --git a/urpmi.addmedia b/urpmi.addmedia
index 1fbded3b..29fe3170 100755
--- a/urpmi.addmedia
+++ b/urpmi.addmedia
@@ -123,6 +123,7 @@ if (!-e $urpm->{config}) {
     $urpm->{error}(N("Will create config file [%s]", $urpm->{config}));
     open my $_f, '>', $urpm->{config} or $urpm->{fatal}(6, N("Can't create config file [%s]", $urpm->{config}));
 }
+my $_urpmi_lock = urpm::lock::urpmi_db($urpm, 'exclusive');
 urpm::media::read_config($urpm);
 
 if ($options{distrib}) {
diff --git a/urpmi.removemedia b/urpmi.removemedia
index 25e43ab6..0bf7d7db 100755
--- a/urpmi.removemedia
+++ b/urpmi.removemedia
@@ -73,6 +73,7 @@ if ($< != 0) {
 
 $options{verbose} > 0 or $urpm->{log} = sub {};
 
+my $_urpmi_lock = urpm::lock::urpmi_db($urpm, 'exclusive');
 urpm::media::read_config($urpm);
 urpm::download::set_cmdline_proxy();
 my @entries = map { $_->{name} } @{$urpm->{media}};
diff --git a/urpmi.update b/urpmi.update
index e86f4013..fac9cd8d 100755
--- a/urpmi.update
+++ b/urpmi.update
@@ -68,6 +68,7 @@ $options{verbose} > 0 or $urpm->{log} = sub {};
 if ($< != 0) {
     $urpm->{fatal}(1, N("Only superuser is allowed to update media"));
 }
+my $_urpmi_lock = urpm::lock::urpmi_db($urpm, 'exclusive');
 urpm::media::read_config($urpm);
 
 my @entries = map { $_->{name} } @{$urpm->{media}};
diff --git a/urpmq b/urpmq
index f4b4c78d..c8aeffd9 100755
--- a/urpmq
+++ b/urpmq
@@ -140,8 +140,8 @@ if ($urpm::args::options{ignorearch}) { urpm::shunt_ignorearch() }
 
 my $rpm_lock = 
   $urpm::args::options{upgrade} && !$urpm::args::options{env} && !$urpm::args::options{nolock}
-  && urpm::sys::lock_rpm_db($urpm);
-my $urpmi_lock = !$urpm::args::options{nolock} && urpm::sys::lock_urpmi_db($urpm);
+  && urpm::lock::rpm_db($urpm);
+my $urpmi_lock = !$urpm::args::options{nolock} && urpm::lock::urpmi_db($urpm);
 urpm::media::configure($urpm,
     nocheck_access => 1,
     nodepslist => $urpm::args::options{nodepslist},
@@ -428,8 +428,8 @@ if ($urpm::args::options{list_aliases}) {
 	exit 0;
     }
 }
-$urpmi_lock and urpm::sys::unlock($urpmi_lock);
-$rpm_lock and urpm::sys::unlock($rpm_lock);
+$urpmi_lock and $urpmi_lock->unlock;
+$rpm_lock and $rpm_lock->unlock;
 
 #- print sub for query.
 my $query_sub = sub {