1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
package urpm::lock;
# $Id: lock.pm 261997 2009-10-15 17:44:35Z cfergeau $
use strict;
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 /
# (options: nofatal, wait)
sub rpm_db {
my ($urpm, $b_exclusive, %options) = @_;
my $f = ($urpm->{root} ? "$urpm->{root}/" : '') . "/var/lib/rpm/.RPMLOCK";
urpm::lock->new($urpm, $f, 'rpm', $b_exclusive, %options);
}
# (options: nofatal, wait)
sub urpmi_db {
my ($urpm, $b_exclusive, %options) = @_;
urpm::lock->new($urpm, "$urpm->{statedir}/.LOCK", 'urpmi', $b_exclusive, %options);
}
################################################################################
#- methods
# (options: nofatal, wait)
sub new {
my ($_class, $urpm, $file, $db_name, $b_exclusive, %options) = @_;
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 => $options{nofatal} ? $urpm->{error} : sub { $urpm->{fatal}(7, $_[0]) },
info => $urpm->{info},
log => $urpm->{log},
};
_lock($lock, $b_exclusive, $options{wait});
$lock;
}
sub get_lock_pid {
my ($fh) = @_;
my ($dev,$ino,undef) = stat($fh);
my $major = int($dev/256);
my $minor = $dev % 256;
my $fileid = sprintf("%02x:%02x:%d",$major,$minor,$ino);
open(LOCKS, "/proc/locks") || return;
my @locks = <LOCKS>;
close(LOCKS);
foreach (@locks) { /FLOCK.*WRITE\s*(\d+)\s*$fileid\s/ && return $1 };
}
sub _lock {
my ($lock, $b_exclusive, $b_wait) = @_;
$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;
if (!flock($lock->{fh}, $mode | $LOCK_NB)) {
if ($b_wait) {
$lock->{info}(N("%s database is locked. Waiting...", $lock->{db_name}));
flock($lock->{fh}, $mode) or $lock->{fatal}(N("aborting"));
} else {
my $pid = get_lock_pid($lock->{fh});
if($pid) {
my $name = urpm::util::cat_("/proc/$pid/cmdline");
$name =~ tr/\0/ /;
$name =~ s/ *$//;
$lock->{fatal}(N("%s database is locked, process %d is already using it", $lock->{db_name}, $pid).($name?" ($name)":""));
} else {
$lock->{fatal}(N("%s database is locked (another program is already using it)", $lock->{db_name}));
}
}
}
$lock->{locked} = 1;
$lock->{exclusive} = $b_exclusive;
}
sub unlock {
my ($lock) = @_;
$lock->{fh} or warn "lock $lock->{db_name} already released\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};
}
|
