File Coverage

blib/lib/urpm/lock.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             package urpm::lock;
2              
3              
4 1     1   1362 use strict;
  1         1  
  1         23  
5 1     1   26 use urpm::msg;
  0            
  0            
6             use urpm::util 'cat_';
7              
8             #- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base).
9             my ($LOCK_SH, $LOCK_EX, $LOCK_NB, $LOCK_UN) = (1, 2, 4, 8);
10              
11              
12              
13             =head1 NAME
14              
15             urpm::lock - urpm/rpm DB locking related routines for urpmi
16              
17             =head1 SYNOPSIS
18              
19             =head1 DESCRIPTION
20              
21             =over
22              
23             =cut
24              
25              
26             ################################################################################
27             #- class functions
28              
29              
30             =item rpm_db($urpm, $b_exclusive, %options)
31              
32             Lock urpmi DB.
33              
34             Lock policy concerning chroot : lock rpm db in chroot
35              
36             Options: nofatal, wait
37              
38             =cut
39              
40             sub rpm_db {
41             my ($urpm, $b_exclusive, %options) = @_;
42             my $f = ($urpm->{root} ? "$urpm->{root}/" : '') . "/var/lib/rpm/.RPMLOCK";
43             urpm::lock->new($urpm, $f, 'rpm', $b_exclusive, %options);
44             }
45              
46             =item urpmi_db($urpm, $b_exclusive, %options)
47              
48             Lock urpmi DB.
49              
50             Lock policy concerning chroot : lock urpmi db in /
51              
52             Options: nofatal, wait
53              
54             =cut
55              
56             sub urpmi_db {
57             my ($urpm, $b_exclusive, %options) = @_;
58             urpm::lock->new($urpm, "$urpm->{statedir}/.LOCK", 'urpmi', $b_exclusive, %options);
59             }
60              
61              
62             ################################################################################
63             #- methods
64              
65             # (options: nofatal, wait)
66             sub new {
67             my ($_class, $urpm, $file, $db_name, $b_exclusive, %options) = @_;
68            
69             my $fh;
70             #- we don't care what the mode is. ">" allow creating the file, but can't be done as user
71             open($fh, '>', $file) or open($fh, '<', $file) or return;
72              
73             my $lock = bless {
74             fh => $fh, db_name => $db_name,
75             fatal => $options{nofatal} ? $urpm->{error} : sub { $urpm->{fatal}(7, $_[0]) },
76             info => $urpm->{info},
77             log => $urpm->{log},
78             };
79             _lock($lock, $b_exclusive, $options{wait});
80             $lock;
81             }
82              
83             sub get_lock_pid {
84             my ($fh) = @_;
85             my ($dev, $ino, undef) = stat($fh);
86             my $major = int($dev/256);
87             my $minor = $dev % 256;
88             my $fileid = sprintf("%02x:%02x:%d",$major,$minor,$ino);
89             foreach (urpm::util::cat_('/proc/locks')) { /FLOCK.*WRITE\s*(\d+)\s*$fileid\s/ && return $1 }
90             }
91              
92             sub warn_about_locker {
93             my ($lock) = @_;
94             if (my $pid = get_lock_pid($lock->{fh})) {
95             my $name = urpm::util::cat_("/proc/$pid/cmdline");
96             $name =~ tr/\0/ /;
97             $name =~ s/ *$//;
98             $lock->{fatal}(N("%s database is locked, process %d is already using it", $lock->{db_name}, $pid) . ($name ? " ($name)" : ""));
99             } else {
100             $lock->{fatal}(N("%s database is locked (another program is already using it)", $lock->{db_name}));
101             }
102             }
103              
104             sub _lock {
105             my ($lock, $b_exclusive, $b_wait) = @_;
106             $b_exclusive ||= '';
107             if ($lock->{log}) {
108             my $action = $lock->{exclusive} && !$b_exclusive ? 'releasing exclusive' : $b_exclusive ? 'getting exclusive' : 'getting';
109             $lock->{log}("$action lock on $lock->{db_name}");
110             }
111             my $mode = $b_exclusive ? $LOCK_EX : $LOCK_SH;
112             if (!flock($lock->{fh}, $mode | $LOCK_NB)) {
113             if ($b_wait) {
114             $lock->{info}(N("%s database is locked. Waiting...", $lock->{db_name}));
115             flock($lock->{fh}, $mode) or $lock->{fatal}(N("aborting"));
116             } else {
117             warn_about_locker($lock);
118             }
119             }
120             $lock->{locked} = 1;
121             $lock->{exclusive} = $b_exclusive;
122             }
123              
124             sub unlock {
125             my ($lock) = @_;
126             $lock->{fh} or warn "lock $lock->{db_name} already released\n", return;
127              
128             if ($lock->{locked}) {
129             $lock->{log} and $lock->{log}("unlocking $lock->{db_name} database");
130             flock $lock->{fh}, $LOCK_UN;
131             }
132             close $lock->{fh};
133             delete $lock->{fh};
134             }
135              
136             sub DESTROY {
137             my ($lock) = @_;
138             unlock($lock) if $lock->{fh};
139             }
140              
141             =back
142              
143             =head1 COPYRIGHT
144              
145             Copyright (C) 2005 MandrakeSoft SA
146              
147             Copyright (C) 2005-2010 Mandriva SA
148              
149             Copyright (C) 2011-2017 Mageia
150              
151             =cut