File Coverage

blib/lib/urpm/cdrom.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::cdrom;
2              
3              
4 1     1   1407 use strict;
  1         2  
  1         23  
5 1     1   26 use urpm::msg;
  0            
  0            
6             use urpm::sys;
7             use urpm::util qw(basename copy_and_own difference2 remove_internal_name);
8             use urpm::get_pkgs;
9             use urpm::removable;
10             use urpm 'file_from_local_medium';
11              
12              
13              
14             =head1 NAME
15              
16             urpm::cdrom - Retrieving packages from removable media
17              
18             =head1 SYNOPSIS
19              
20             =head1 DESCRIPTION
21              
22             =over
23              
24             =cut
25              
26              
27             #- side-effects: $blists->[_]{medium}{mntpoint}
28             sub _find_blist_matching {
29             my ($urpm, $blists, $mntpoint) = @_;
30              
31             my @l;
32             foreach my $blist (@$blists) {
33             $blist->{medium}{mntpoint} and next;
34              
35             # set it, then verify
36             $blist->{medium}{mntpoint} = $mntpoint;
37             if (-r urpm::removable::file_or_synthesis_dir_from_blist($blist)) {
38             $urpm->{log}("found cdrom $blist->{medium}{name} mounted in $mntpoint");
39             push @l, $blist;
40             } else {
41             delete $blist->{medium}{mntpoint};
42             }
43             }
44             @l;
45             }
46              
47             #- side-effects: none
48             sub _look_for_mounted_cdrom_in_mtab() {
49              
50             map { $_->{mntpoint} }
51             grep { $_->{fs} eq 'iso9660' || $_->{fs} eq 'udf' } urpm::sys::read_mtab();
52             }
53              
54             #- side-effects:
55             #- + those of _try_mounting_cdrom_using_udisks ($urpm->{cdrom_mounted}, "hal_mount")
56             #- + those of _find_blist_matching ($blists->[_]{medium}{mntpoint})
57             sub try_mounting_cdrom {
58             my ($urpm, $blists) = @_;
59              
60             my @blists;
61              
62             # first try without UDisks, it allows users where UDisks fails to work (with one CD only)
63             my @mntpoints = _look_for_mounted_cdrom_in_mtab();
64             @blists = map { _find_blist_matching($urpm, $blists, $_) } @mntpoints;
65              
66             if (!@blists) {
67             @mntpoints = _try_mounting_cdrom_using_udisks($urpm);
68             @blists = map { _find_blist_matching($urpm, $blists, $_) } @mntpoints;
69             }
70             @blists;
71             }
72              
73             #- side-effects: $urpm->{cdrom_mounted}, "hal_mount"
74             sub _try_mounting_cdrom_using_udisks {
75             my ($urpm) = @_;
76              
77             $urpm->{cdrom_mounted} = {}; # reset
78              
79             eval { require Hal::Cdroms; 1 } or $urpm->{error}(10, N("You must mount CD-ROM yourself (or install perl-Hal-Cdroms to have it done automatically)")), return();
80              
81             my $cdroms = eval { Hal::Cdroms->new } or $urpm->{fatal}(10, N("Udisks daemon (udisks-daemon) is not running or not ready"));
82              
83             foreach my $udisks_path ($cdroms->list) {
84             my $mntpoint = $cdroms->get_mount_point($udisks_path);
85             if (!$mntpoint) {
86             $urpm->{log}("trying to mount $udisks_path");
87             $mntpoint = $cdroms->ensure_mounted($udisks_path)
88             or $urpm->{error}("failed to mount $udisks_path: $cdroms->{error}"), next;
89             }
90             $urpm->{cdrom_mounted}{$udisks_path} = $mntpoint;
91             }
92             values %{$urpm->{cdrom_mounted}};
93             }
94              
95             #- side-effects:
96             #- + those of try_mounting_cdrom ($urpm->{cdrom_mounted}, $blists->[_]{medium}{mntpoint}, "hal_mount")
97             sub _mount_cdrom_and_check {
98             my ($urpm, $blists) = @_;
99              
100             my @matching_blists = try_mounting_cdrom($urpm, $blists) or return;
101             grep { !_check_notfound($_) } @matching_blists;
102             }
103              
104             #- side-effects: none
105             sub _check_notfound {
106             my ($blist) = @_;
107              
108             $blist->{medium}{mntpoint} or return;
109              
110             foreach (values %{$blist->{pkgs}}) {
111             my $dir_ = _filepath($blist, $_) or next;
112             -r $dir_ or return 1;
113             }
114             0;
115             }
116              
117             #- side-effects:
118             #- + those of _eject_cdrom ($urpm->{cdrom_mounted}, "hal_umount", "hal_eject")
119             sub _may_eject_cdrom {
120             my ($urpm) = @_;
121              
122             my @paths = keys %{$urpm->{cdrom_mounted}};
123             @paths == 1 or return;
124              
125             # only one cdrom mounted, we know it is the one to umount/eject
126             _eject_cdrom($urpm, $paths[0]);
127             }
128              
129              
130             #- side-effects: $urpm->{cdrom_mounted}, "hal_umount", "hal_eject"
131             sub _eject_cdrom {
132             my ($urpm, $udisks_path) = @_;
133              
134             my $mntpoint = delete $urpm->{cdrom_mounted}{$udisks_path};
135             $urpm->{debug} and $urpm->{debug}("umounting and ejecting $mntpoint (cdrom $udisks_path)");
136              
137             eval { require Hal::Cdroms; 1 } or return;
138              
139             my $cdroms = Hal::Cdroms->new;
140             $cdroms->unmount($udisks_path) or do {
141             my $mntpoint = $cdroms->get_mount_point($udisks_path);
142             #- trying harder. needed when the cdrom was not mounted by UDisks
143             $mntpoint && system("umount '$mntpoint' 2>/dev/null") == 0
144             or $urpm->{error}("failed to umount $udisks_path: $cdroms->{error}");
145             };
146             $cdroms->eject($udisks_path);
147             1;
148             }
149              
150             #- side-effects: "eject"
151             #- + those of _mount_cdrom_and_check ($urpm->{cdrom_mounted}, $blists->[_]{medium}{mntpoint}, "hal_mount")
152             #- + those of _may_eject_cdrom ($urpm->{cdrom_mounted}, "hal_umount", "hal_eject")
153             sub _mount_cdrom {
154             my ($urpm, $blists, $ask_for_medium) = @_;
155              
156             my $retry;
157              
158             #- the directory given does not exist and may be accessible
159             #- by mounting some other directory. Try to figure it out and mount
160             #- everything that might be necessary.
161             while (1) {
162              
163             if (my @blists = _mount_cdrom_and_check($urpm, $blists)) {
164             return @blists;
165             }
166              
167             # ask for the first one, it's ok if the user insert another wanted cdrom
168             my $medium = $blists->[0]{medium};
169              
170             $retry++ and $urpm->{log}("wrong CDROM, wanted $medium->{name}");
171              
172             $ask_for_medium
173             or $urpm->{fatal}(4, N("medium \"%s\" is not available", $medium->{name}));
174              
175             _may_eject_cdrom($urpm);
176              
177             $ask_for_medium->(remove_internal_name($medium->{name}))
178             or $urpm->{fatal}(4, N("medium \"%s\" is not available", $medium->{name}));
179             }
180             }
181              
182             #- side-effects: none
183             sub _filepath {
184             my ($blist, $pkg) = @_;
185              
186             my $filepath = file_from_local_medium($blist->{medium}) or return;
187             $filepath . '/' . $pkg->filename;
188             }
189              
190             #- side-effects: "copy-move-files"
191             sub _do_the_copy {
192             my ($urpm, $filepath) = @_;
193              
194             #- we should assume a possibly buggy removable device...
195             #- First, copy in partial cache, and if the package is still good,
196             #- transfer it to the rpms cache.
197             my $filename = basename($filepath);
198             unlink "$urpm->{cachedir}/partial/$filename";
199             $urpm->{log}("copying $filepath");
200             copy_and_own($filepath, "$urpm->{cachedir}/partial/$filename") or return;
201             my $f = urpm::get_pkgs::verify_partial_rpm_and_move($urpm, $urpm->{cachedir}, $filename) or return;
202             $f;
203             }
204              
205             #- side-effects: $sources
206             #- + those of _do_the_copy: "copy-move-files"
207             sub _copy_from_cdrom__if_needed {
208             my ($urpm, $blist, $sources, $want_copy) = @_;
209              
210             while (my ($id, $pkg) = each %{$blist->{pkgs}}) {
211             my $filepath = _filepath($blist, $pkg) or next;
212              
213             if (-r $filepath) {
214             $sources->{$id} = $want_copy ? _do_the_copy($urpm, $filepath) : $filepath;
215             } else {
216             #- fallback to use other method for retrieving the file later.
217             $urpm->{error}(N("unable to read rpm file [%s] from medium \"%s\"", $filepath, $blist->{medium}{name}));
218             }
219             }
220             }
221              
222              
223             =item copy_packages_of_removable_media($urpm, $blists, $sources, $o_ask_for_medium)
224              
225             =cut
226              
227              
228             #- side-effects:
229             #- + those of _may_eject_cdrom ($urpm->{cdrom_mounted}, "hal_umount", "hal_eject")
230             #- + those of _mount_cdrom ($urpm->{cdrom_mounted}, $blists->[_]{medium}{mntpoint}, "hal_mount", "hal_eject")
231             #- + those of _copy_from_cdrom__if_needed ("copy-move-files")
232             sub copy_packages_of_removable_media {
233             my ($urpm, $blists, $sources, $o_ask_for_medium) = @_;
234              
235             my @blists = grep { urpm::is_cdrom_url($_->{medium}{url}) } @$blists;
236              
237             # we prompt for CDs used less first, since the last CD will be used directly
238             @blists = sort { values(%{$a->{pkgs}}) <=> values(%{$b->{pkgs}}) } @blists;
239              
240             my $prev_medium;
241             while (@blists) {
242             $prev_medium and delete $prev_medium->{mntpoint};
243             _may_eject_cdrom($urpm);
244              
245             my @blists_mounted = _mount_cdrom($urpm, \@blists, $o_ask_for_medium);
246             @blists = difference2(\@blists, \@blists_mounted);
247             foreach my $blist (@blists_mounted) {
248             _copy_from_cdrom__if_needed($urpm, $blist, $sources, @blists > 0);
249             $prev_medium = $blist->{medium};
250             }
251             }
252              
253             1;
254             }
255              
256             1;
257              
258             =back
259              
260             =head1 COPYRIGHT
261              
262             Copyright (C) 1999-2005 MandrakeSoft SA
263              
264             Copyright (C) 2005-2010 Mandriva SA
265              
266             Copyright (C) 2011-2017 Mageia
267              
268             =cut