diff options
Diffstat (limited to 'perl-install/pkgs.pm')
| -rw-r--r-- | perl-install/pkgs.pm | 161 |
1 files changed, 114 insertions, 47 deletions
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index f6626d312..d03b3be9f 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -1,6 +1,5 @@ package pkgs; # $Id$ -use diagnostics; use strict; use MDK::Common::System; @@ -47,7 +46,7 @@ sub packageMedium { my ($packages, $p) = @_; $p or die "invalid package from\n" defined $_->{start} && defined $_->{end} or next; $p->id >= $_->{start} && $p->id <= $_->{end} and return $_; } - return } + return {} } sub cleanHeaders { my ($prefix) = @_; @@ -85,6 +84,11 @@ sub extractHeaders { } } +sub isSupplCDMedium($) { + my ($medium) = @_; + $medium->{method} eq 'cdrom' && $medium->{medium} =~ /^\d+s$/; +} + #- TODO BEFORE TODO #- size and correction size functions for packages. my $B = 1.20873; @@ -224,8 +228,8 @@ sub allMediums { sort { $a <=> $b } keys %{$packages->{mediums}}; } sub mediumDescr { - my ($packages, $medium) = @_; - $packages->{mediums}{$medium}{descr}; + my ($packages, $medium_name) = @_; + $packages->{mediums}{$medium_name}{descr}; } sub packageRequest { @@ -339,14 +343,21 @@ sub unselectAllPackages($) { callback_choices => \&packageCallbackChoices); } +sub urpmidir { + my ($prefix) = @_; + my $v = "$prefix/var/lib/urpmi"; + -l $v && !-e _ and unlink $v and mkdir $v, 0755; #- dangling symlink + -w $v ? $v : '/tmp'; +} + sub psUpdateHdlistsDeps { my ($prefix, $_method, $packages) = @_; my $need_copy = 0; + my $urpmidir = urpmidir($prefix); #- check if current configuration is still up-to-date and do not need to be updated. foreach (values %{$packages->{mediums}}) { $_->{selected} || $_->{ignored} or next; - my $urpmidir = -w "$prefix/var/lib/urpmi" ? "$prefix/var/lib/urpmi" : "/tmp"; my $hdlistf = "$urpmidir/hdlist.$_->{fakemedium}.cz" . ($_->{hdlist} =~ /\.cz2/ && "2"); my $synthesisf = "$urpmidir/synthesis.hdlist.$_->{fakemedium}.cz" . ($_->{hdlist} =~ /\.cz2/ && "2"); if (-s $hdlistf != $_->{hdlist_size}) { @@ -362,52 +373,62 @@ sub psUpdateHdlistsDeps { if ($need_copy) { #- this is necessary for urpmi. - my $urpmidir = -w "$prefix/var/lib/urpmi" ? "$prefix/var/lib/urpmi" : "/tmp"; install_any::getAndSaveFile("Mandrake/base/$_", "$urpmidir/$_") foreach qw(rpmsrate); } } sub psUsingHdlists { - my ($prefix, $method) = @_; - my $listf = install_any::getFile('Mandrake/base/hdlists') or die "no hdlists found"; - my $packages = new URPM; - - #- add additional fields used by DrakX. - @$packages{qw(count mediums)} = (0, {}); + my ($o, $method, $o_hdlistsprefix, $o_packages, $o_initialmedium) = @_; + my $prefix = $o->{prefix}; + my $listf = install_any::getFile($o_hdlistsprefix ? "$o_hdlistsprefix/Mandrake/base/hdlists" : 'Mandrake/base/hdlists') + or die "no hdlists found"; + my $suppl_CDs = 0; + if (!$o_packages) { + $o_packages = new URPM; + #- add additional fields used by DrakX. + @$o_packages{qw(count mediums)} = (0, {}); + } #- parse hdlists file. - my $medium = 1; + my $medium_name = $o_initialmedium || 1; + my @hdlists; foreach (<$listf>) { chomp; s/\s*#.*$//; /^\s*$/ and next; + #- we'll ask afterwards for supplementary CDs, if the hdlists file contains + #- a line that begins with "suppl" + if (/^suppl/) { $suppl_CDs = 1; next } + my $cdsuppl = index($medium_name, 's') >= 0; m/^\s*(noauto:)?(hdlist\S*\.cz2?)\s+(\S+)\s*(.*)$/ or die qq(invalid hdlist description "$_" in hdlists file); + push @hdlists, [ $2, $medium_name, $3, $4, !$1, + #- hdlist path, suppl CDs are mounted on /mnt/cdrom : + $o_hdlistsprefix ? "$o_hdlistsprefix/Mandrake/base/$2" : undef, + ]; + $cdsuppl ? ($medium_name = ($medium_name + 1) . 's') : ++$medium_name; + } + foreach my $h (@hdlists) { #- make sure the first medium is always selected! #- by default select all image. - psUsingHdlist($prefix, $method, $packages, $2, $medium, $3, $4, !$1); - - ++$medium; + my $supplmedium = psUsingHdlist($prefix, $method, $o_packages, @$h); } - log::l("psUsingHdlists read " . int(@{$packages->{depslist}}) . - " headers on " . int(keys %{$packages->{mediums}}) . " hdlists"); + log::l("psUsingHdlists read " . int(@{$o_packages->{depslist}}) . + " headers on " . int(keys %{$o_packages->{mediums}}) . " hdlists"); - $packages; + return $o_packages, $suppl_CDs; } sub psUsingHdlist { - my ($prefix, $method, $packages, $hdlist, $medium, $rpmsdir, $descr, $selected, $o_fhdlist, $o_pubkey) = @_; - my $fakemedium = "$descr ($method$medium)"; - my $urpmidir = -w "$prefix/var/lib/urpmi" ? "$prefix/var/lib/urpmi" : "/tmp"; - log::l("trying to read $hdlist for medium $medium"); - - #- if the medium already exist, use it. - $packages->{mediums}{$medium} and return $packages->{mediums}{$medium}; + my ($prefix, $method, $packages, $hdlist, $medium_name, $rpmsdir, $descr, $selected, $o_fhdlist, $o_pubkey) = @_; + my $fakemedium = "$descr ($method$medium_name)"; + my $urpmidir = urpmidir($prefix); + log::l("trying to read $hdlist for medium $medium_name"); my $m = { hdlist => $hdlist, method => $method, - medium => $medium, + medium => $medium_name, rpmsdir => $rpmsdir, #- where is RPMS directory. descr => $descr, fakemedium => $fakemedium, @@ -424,11 +445,17 @@ sub psUsingHdlist { $m->{hdlist_size} = -s $newf; #- keep track of size for post-check. symlinkf $newf, "/tmp/$hdlist"; - #- if $o_fhdlist is defined, this is preferable not to try to find the associated synthesis. my $newsf = "$urpmidir/synthesis.hdlist.$fakemedium.cz" . ($hdlist =~ /\.cz2/ && "2"); - unless ($o_fhdlist) { + #- if $o_fhdlist is a filehandle, it's preferable not to try to find the associated synthesis. + if (!ref $o_fhdlist) { #- copy existing synthesis file too. - install_any::getAndSaveFile("Mandrake/base/synthesis.$hdlist", $newsf); + my $synth; + if ($o_fhdlist) { + $synth = $o_fhdlist; + $synth =~ s/hdlist/synthesis.hdlist/ or $synth = undef; + } + $synth ||= "Mandrake/base/synthesis.$hdlist"; + install_any::getAndSaveFile($synth, $newsf); $m->{synthesis_hdlist_size} = -s $newsf; #- keep track of size for post-check. -s $newsf > 0 or unlink $newsf; } @@ -444,31 +471,46 @@ sub psUsingHdlist { } #- integrate medium in media list, only here to avoid download error (update) to be propagated. - $packages->{mediums}{$medium} = $m; + $packages->{mediums}{$medium_name} = $m; #- avoid using more than one medium if Cd is not ejectable. #- but keep all medium here so that urpmi has the whole set. - $m->{ignored} ||= $method eq 'cdrom' && $medium > 1 && !common::usingRamdisk(); + $m->{ignored} ||= ( + install_any::method_allows_medium_change($method) && $medium_name > 1 #- first cdrom + && $medium_name !~ /^\d+s/ #- not a suppl. CD + && !common::usingRamdisk()); #- parse synthesis (if available) of directly hdlist (with packing). if ($m->{ignored}) { log::l("ignoring packages in $hdlist"); } else { + my $nb_suppl_pkg_skipped = 0; + my $callback = sub { + my (undef, $p) = @_; + our %uniq_pkg_seen; + if ($uniq_pkg_seen{$p->fullname}++) { + log::l("skipping " . scalar $p->fullname); + ++$nb_suppl_pkg_skipped; + return 0; + } else { + return 1; + } + }; if (-s $newsf) { - ($m->{start}, $m->{end}) = $packages->parse_synthesis($newsf); + ($m->{start}, $m->{end}) = $packages->parse_synthesis($newsf, callback => $callback); } elsif (-s $newf) { - ($m->{start}, $m->{end}) = $packages->parse_hdlist($newf, 1); + ($m->{start}, $m->{end}) = $packages->parse_hdlist($newf, callback => $callback); } else { - delete $packages->{mediums}{$medium}; + delete $packages->{mediums}{$medium_name}; unlink $newf; $o_fhdlist or unlink $newsf; die "fatal: no hdlist nor synthesis to read for $fakemedium"; } - $m->{start} > $m->{end} and do { delete $packages->{mediums}{$medium}; + $m->{start} > $m->{end} and do { delete $packages->{mediums}{$medium_name}; unlink $newf; $o_fhdlist or unlink $newsf; die "fatal: nothing read in hdlist or synthesis for $fakemedium" }; - log::l("read " . ($m->{end} - $m->{start} + 1) . " packages in $hdlist"); + log::l("read " . ($m->{end} - $m->{start} + 1) . " packages in $hdlist, $nb_suppl_pkg_skipped skipped"); } $m; } @@ -560,9 +602,9 @@ sub read_rpmsrate { } sub readCompssUsers { - my ($meta_class) = @_; + my ($meta_class, $file) = @_; - my $file = 'Mandrake/base/compssUsers'; + $file = 'Mandrake/base/compssUsers' if !$file; my $f = $meta_class && install_any::getFile("$file.$meta_class") || install_any::getFile($file) or die "can't find $file"; readCompssUsers_raw($f); } @@ -607,19 +649,19 @@ sub saveCompssUsers { } } } - my $urpmidir = -w "$prefix/var/lib/urpmi" ? "$prefix/var/lib/urpmi" : "/tmp"; + my $urpmidir = urpmidir($prefix); output "$urpmidir/compssUsers.flat", $flat; } sub setSelectedFromCompssList { - my ($packages, $compssUsersChoice, $min_level, $max_size) = @_; - $compssUsersChoice->{TRUE} = 1; #- ensure TRUE is set + my ($packages, $rpmsrate_flags_chosen, $min_level, $max_size) = @_; + $rpmsrate_flags_chosen->{TRUE} = 1; #- ensure TRUE is set my $nb = selectedSize($packages); foreach my $p (sort { $b->rate <=> $a->rate } @{$packages->{depslist}}) { my @flags = $p->rflags; next if !$p->rate || $p->rate < $min_level || - any { !any { /^!(.*)/ ? !$compssUsersChoice->{$1} : $compssUsersChoice->{$_} } split('\|\|') } @flags; + any { !any { /^!(.*)/ ? !$rpmsrate_flags_chosen->{$1} : $rpmsrate_flags_chosen->{$_} } split('\|\|') } @flags; #- determine the packages that will be selected when #- selecting $p. the packages are not selected. @@ -885,6 +927,8 @@ sub selectPackagesToUpgrade { sub allowedToUpgrade { $_[0] !~ /^(kernel|kernel22|kernel2.2|kernel-secure|kernel-smp|kernel-linus|kernel-linus2.2|hackkernel|kernel-enterprise)$/ } +sub supplCDMountPoint { $::o->{mainmethod} eq 'cdrom' ? "/tmp/image" : "/mnt/cdrom" } + sub installTransactionClosure { my ($packages, $id2pkg) = @_; my ($id, %closure, @l, $medium, $min_id, $max_id); @@ -920,13 +964,29 @@ sub installTransactionClosure { $medium or return (); #- no more medium usable -> end of installation by returning empty list. ($min_id, $max_id) = ($medium->{start}, $medium->{end}); + #- Supplementary CD : switch temporarily to "cdrom" method + my $suppl_CD = isSupplCDMedium($medium); + $::o->{mainmethod} = $::o->{method}; + local $::o->{method} = do { + my $cdrom; + cat_("/proc/mounts") =~ m,(/(?:dev|tmp)/\S+)\s+(?:/mnt/cdrom|/tmp/image), and $cdrom = $1; + if (!defined $cdrom) { + (my $cdromdev) = detect_devices::cdroms(); + $cdrom = $cdromdev->{device}; + log::l("cdrom redetected at $cdrom"); + devices::make($cdrom); + install_any::ejectCdrom($cdrom) if $::o->{method} eq 'cdrom'; + install_any::mountCdrom(supplCDMountPoint(), $cdrom); + } else { log::l("cdrom already found at $cdrom") } + 'cdrom'; + } if $suppl_CD; #- it is sure at least one package will be installed according to medium chosen. install_any::useMedium($medium->{medium}); - if ($medium->{method} eq 'cdrom') { + if (install_any::method_allows_medium_change($medium->{method})) { my $pkg = $packages->{depslist}[$l[0]]; #- force changeCD callback to be called from main process. - install_any::getFile($pkg->filename, $medium->{descr}); + install_any::getFile($pkg->filename, $medium->{descr}, $suppl_CD ? supplCDMountPoint() : undef); #- close opened handle above. install_any::getFile('XXX'); } @@ -1062,7 +1122,8 @@ sub install($$$;$$) { my $trans = $db->create_transaction($prefix); if ($retry_pkg) { log::l("opened rpm database for retry transaction of 1 package only"); - $trans->add($retry_pkg, $isUpgrade && allowedToUpgrade($retry_pkg->name)); + $trans->add($retry_pkg, $isUpgrade && allowedToUpgrade($retry_pkg->name)) + or log::l("add failed for ".$retry_pkg->fullname); } else { log::l("opened rpm database for transaction of " . int(@transToInstall) . " new packages, still $nb after that to do"); @@ -1082,7 +1143,11 @@ sub install($$$;$$) { my $medium = packageMedium($packages, $pkg); my $f = $pkg && $pkg->filename; print $LOG "$f\n"; - $fd = install_any::getFile($f, $medium->{descr}); + if (isSupplCDMedium($medium)) { + $fd = install_any::getFile($f, $medium->{descr}, supplCDMountPoint()); + } else { + $fd = install_any::getFile($f, $medium->{descr}, $medium->{prefix}); + } $fd ? fileno $fd : -1; }, callback_close => sub { my ($data, $_type, $id) = @_; @@ -1092,6 +1157,7 @@ sub install($$$;$$) { my ($p) = @_; $check_installed ||= $pkg->compare_pkg($p) == 0; }); + $check_installed or log::l($pkg->name . " not installed, " . c::rpmErrorString()); $check_installed and print OUTPUT "close:$id\n"; }, callback_inst => sub { my ($_data, $type, $id, $subtype, $amount, $total) = @_; @@ -1176,6 +1242,7 @@ sub install($$$;$$) { log::l("closing install.log file"); close $LOG; + eval { fs::umount("/mnt/cdrom") }; cleanHeaders($prefix); |