move lock functions to urpm::sys

1 files changed, 70 insertions, 21 deletions

diff --git a/urpm/sys.pm b/urpm/sys.pm
index 9defc2f5..313cf730 100644
--- a/urpm/sys.pm
+++ b/urpm/sys.pm
@@ -4,6 +4,8 @@ package urpm::sys;
 
 use strict;
 use warnings;
+use urpm::util;
+use urpm::msg;
 use POSIX ();
 
 (our $VERSION) = q($Revision$) =~ /(\d+)/;
@@ -13,10 +15,9 @@ use POSIX ();
 sub find_mntpoints {
     my ($dir, $infos) = @_;
     my (%fstab, @mntpoints);
-    local ($_);
+
     #- read /etc/fstab and check for existing mount point.
-    open my $f, "/etc/fstab" or return ();
-    while (<$f>) {
+    foreach (cat_("/etc/fstab")) {
 	next if /^\s*#/;
 	my ($device, $mntpoint, $fstype, $options) = m!^\s*(\S+)\s+(/\S+)\s+(\S+)\s+(\S+)!
 	    or next;
@@ -35,9 +36,7 @@ sub find_mntpoints {
 	    }
 	}
     }
-    close $f;
-    open $f, "/etc/mtab" or return ();
-    while (<$f>) {
+    foreach (cat_("/etc/mtab")) {
 	my ($device, $mntpoint, $fstype, $options) = m!^\s*(\S+)\s+(/\S+)\s+(\S+)\s+(\S+)!
 	    or next;
 	$mntpoint =~ s,/+,/,g; $mntpoint =~ s,/$,,;
@@ -55,11 +54,12 @@ sub find_mntpoints {
 	    }
 	}
     }
-    close $f;
+
     #- try to follow symlink, too complex symlink graph may not be seen.
     #- check the possible mount point.
     my @paths = split '/', $dir;
     my $pdir = '';
+    local $_;
     while (defined ($_ = shift @paths)) {
 	length($_) or next;
 	$pdir .= "/$_";
@@ -93,25 +93,25 @@ sub find_mntpoints {
     @mntpoints;
 }
 
+sub proc_mounts() {
+    my @l = cat_('/proc/mounts') or warn "Can't read /proc/mounts: $!\n";
+    @l;
+}
+
 #- returns the first unused loop device, or an empty string if none is found.
 sub first_free_loopdev () {
-    open my $mounts, '/proc/mounts' or do { warn "Can't read /proc/mounts: $!\n"; return 1 };
     my %loopdevs = map { $_ => 1 } grep { ! -d $_ } glob('/dev/loop*');
-    local *_;
-    while (<$mounts>) {
+    foreach (proc_mounts()) {
 	(our $dev) = split ' ';
 	delete $loopdevs{$dev} if $dev =~ m!^/dev/loop!;
     }
-    close $mounts;
     my @l = keys %loopdevs;
     @l ? $l[0] : '';
 }
 
 sub trim_until_d {
     my ($dir) = @_;
-    open my $mounts, '/proc/mounts' or do { warn "Can't read /proc/mounts: $!\n"; return $dir };
-    local $_;
-    while (<$mounts>) {
+    foreach (proc_mounts()) {
 	#- fail if an iso is already mounted
 	m!^/dev/loop! and return $dir;
     }
@@ -121,9 +121,7 @@ sub trim_until_d {
 
 #- checks if the main filesystems are writeable for urpmi to install files in
 sub check_fs_writable () {
-    open my $mounts, '/proc/mounts' or do { warn "Can't read /proc/mounts: $!\n"; return 1 };
-    local *_;
-    while (<$mounts>) {
+    foreach (proc_mounts()) {
 	(undef, our $mountpoint, undef, my $opts) = split ' ';
 	if ($opts =~ /(?:^|,)ro(?:,|$)/ && $mountpoint =~ m!^(/|/usr|/s?bin)\z!) {
 	    return 0;
@@ -147,7 +145,7 @@ sub apply_delta_rpm {
     if ($o_pkg) {
 	$rpm = $o_pkg->name . '-' . $o_pkg->version . '-' . $o_pkg->release . '.' . $o_pkg->arch . '.rpm';
     } else {
-	$rpm = qx(rpm -qp --qf '%{name}-%{version}-%{release}.%{arch}.rpm' '$deltarpm');
+	$rpm = `rpm -qp --qf '%{name}-%{version}-%{release}.%{arch}.rpm' '$deltarpm'`;
     }
     $rpm or return 0;
     $rpm = $o_dir . '/' . $rpm;
@@ -157,12 +155,12 @@ sub apply_delta_rpm {
 }
 
 our $tempdir_template = '/tmp/urpm.XXXXXX';
-sub mktempdir {
+sub mktempdir() {
     my $tmpdir;
     eval { require File::Temp };
     if ($@) {
 	#- fall back to external command (File::Temp not in perl-base)
-	$tmpdir = qx(mktemp -d $tempdir_template);
+	$tmpdir = `mktemp -d $tempdir_template`;
 	chomp $tmpdir;
     } else {
 	$tmpdir = File::Temp::tempdir($tempdir_template);
@@ -175,7 +173,7 @@ sub fix_fd_leak() {
     opendir my $dirh, "/proc/$$/fd" or return undef;
     my @fds = grep { /^(\d+)$/ && $1 > 2 } readdir $dirh;
     closedir $dirh;
-    for (@fds) {
+    foreach (@fds) {
 	my $link = readlink("/proc/$$/fd/$_");
 	$link or next;
 	next if $link =~ m!^/(usr|dev)/! || $link !~ m!^/!;
@@ -183,6 +181,57 @@ sub fix_fd_leak() {
     }
 }
 
+#- lock policy concerning chroot :
+#  - lock rpm db in chroot
+#  - lock urpmi db in /
+sub _lock {
+    my ($urpm, $fh_ref, $file, $b_exclusive) = @_;
+    #- 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 $$fh_ref, $sense, $file or return;
+    flock $$fh_ref, $mode|$LOCK_NB or $urpm->{fatal}(7, N("urpmi database locked"));
+}
+
+
+my $RPMLOCK_FILE;
+my $LOCK_FILE;
+
+sub lock_rpm_db { 
+    my ($urpm, $b_exclusive) = @_;
+    _lock($urpm, \$RPMLOCK_FILE, "$urpm->{root}/$urpm->{statedir}/.RPMLOCK", $b_exclusive);
+}
+sub lock_urpmi_db {
+    my ($urpm, $b_exclusive) = @_;
+    _lock($urpm, \$LOCK_FILE, "$urpm->{statedir}/.LOCK", $b_exclusive);
+}
+
+sub _unlock {
+    my ($fh_ref) = @_;
+    #- 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_ref, $LOCK_UN;
+    close $$fh_ref;
+}
+sub unlock_rpm_db {
+    my ($_urpm) = @_;
+    _unlock(\$RPMLOCK_FILE);
+}
+sub unlock_urpmi_db {
+    my ($_urpm) = @_;
+    _unlock(\$LOCK_FILE);
+}
+
 1;
 __END__