diff options
Diffstat (limited to 'perl-install')
| -rw-r--r-- | perl-install/crypto.pm | 2 | ||||
| -rw-r--r-- | perl-install/install_any.pm | 48 | ||||
| -rw-r--r-- | perl-install/install_steps_gtk.pm | 4 | ||||
| -rw-r--r-- | perl-install/install_steps_interactive.pm | 19 | ||||
| -rw-r--r-- | perl-install/pkgs.pm | 129 |
5 files changed, 132 insertions, 70 deletions
diff --git a/perl-install/crypto.pm b/perl-install/crypto.pm index c07556f9f..3e362fdf8 100644 --- a/perl-install/crypto.pm +++ b/perl-install/crypto.pm @@ -199,7 +199,7 @@ sub getPackages { $update_medium->{prefix} = "ftp://$mirror" . dir($mirror); #- (re-)enable the medium to allow install of package, #- make it an update medium (for install_any::install_urpmi). - $update_medium->{selected} = 1; + $update_medium->select; $update_medium->{update} = 1; $install_any::global_ftp_prefix = [ $mirror, dir($mirror) ]; #- host, dir (for install_any::getFile) diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm index dec369cdc..c33c65d19 100644 --- a/perl-install/install_any.pm +++ b/perl-install/install_any.pm @@ -24,6 +24,7 @@ use detect_devices; use lang; use any; use log; +use pkgs; #- boot medium (the first medium to take into account). our $boot_medium = 1; @@ -68,7 +69,7 @@ sub changeMedium($$) { sub relGetFile($) { local $_ = $_[0]; if (my ($arch) = m|\.([^\.]*)\.rpm$|) { - $_ = "$::o->{packages}{mediums}{$asked_medium}{rpmsdir}/$_"; + $_ = install_medium::by_id($asked_medium)->{rpmsdir} . "/$_"; s/%{ARCH}/$arch/g; s,^/+,,g; } @@ -85,22 +86,6 @@ sub askChangeMedium($$) { $allow; } -#- guess the CD number from a media description. -#- XXX lots of heuristics here, must design this properly -sub getCDNumber { - my ($description) = @_; - (my $cd) = $description =~ /\b(?:CD|DVD) ?(\d+)\b/i; - if (!$cd) { #- test for single unnumbered DVD - $cd = 1 if $description =~ /\bDVD\b/i; - } - if (!$cd) { #- test for mini-ISO - $cd = 1 if $description =~ /\bmini.?cd\b/i; - } - #- don't mix suppl. cds with regular ones - if ($description =~ /suppl/i) { $cd += 100 } - $cd; -} - sub method_is_from_ISO_images($) { my ($method) = @_; $method eq "disk-iso" || $method eq "nfs-iso"; @@ -170,8 +155,8 @@ sub errorOpeningFile($) { my ($file) = @_; $file eq 'XXX' and return; #- special case to force closing file after rpmlib transaction. $current_medium eq $asked_medium and log::l("errorOpeningFile $file"), return; #- nothing to do in such case. - $::o->{packages}{mediums}{$asked_medium}{selected} or return; #- not selected means no need to worry about. - my $current_method = $::o->{packages}{mediums}{$asked_medium}{method} || $::o->{method}; + install_medium::by_id($asked_medium)->selected or return; #- not selected means no need to worry about. + my $current_method = install_medium::by_id($asked_medium)->method || $::o->{method}; my $max = 32; #- always refuse after $max tries. if ($current_method eq "cdrom") { @@ -203,7 +188,7 @@ sub errorOpeningFile($) { #- keep in mind the asked medium has been refused on this way. #- this means it is no more selected. - $::o->{packages}{mediums}{$asked_medium}{selected} = undef; + install_medium::by_id($asked_medium)->refuse; #- on cancel, we can expect the current medium to be undefined too, #- this enables remounting if selecting a package back. @@ -213,7 +198,7 @@ sub errorOpeningFile($) { } sub getFile { my ($f, $o_method, $o_altroot) = @_; - my $current_method = ($asked_medium ? $::o->{packages}{mediums}{$asked_medium}{method} : '') || $::o->{method}; + my $current_method = ($asked_medium ? install_medium::by_id($asked_medium)->method : '') || $::o->{method}; log::l("getFile $f:$o_method ($asked_medium:$current_method)"); my $rel = relGetFile($f); do { @@ -225,7 +210,7 @@ sub getFile { crypto::getFile($f); } elsif ($current_method eq "ftp") { require ftp; - ftp::getFile($rel, @{ $::o->{packages}{mediums}{$asked_medium}{ftp_prefix} || $global_ftp_prefix || [] }); + ftp::getFile($rel, @{ install_medium::by_id($asked_medium)->{ftp_prefix} || $global_ftp_prefix || [] }); } elsif ($current_method eq "http") { require http; http::getFile(($ENV{URLPREFIX} || $o_altroot) . "/$rel"); @@ -494,7 +479,7 @@ sub selectSupplMedia { eval { pkgs::psUsingHdlists($o, $suppl_method, "/mnt/cdrom", $o->{packages}, $medium_name, sub { my ($supplmedium) = @_; - $supplmedium->{issuppl} = 1; + $supplmedium->mark_suppl; }); }; log::l("psUsingHdlists failed: $@") if $@; @@ -591,10 +576,10 @@ sub setup_suppl_medium { $url =~ m!^ftp://(?:(.*?)(?::(.*?))?\@)?([^/]+)/(.*)! and $supplmedium->{ftp_prefix} = [ $3, $4, $1, $2 ]; #- for getFile } - $supplmedium->{selected} = 1; + $supplmedium->select; $supplmedium->{method} = $suppl_method; $supplmedium->{with_hdlist} = 'media_info/hdlist.cz'; #- for install_urpmi - $supplmedium->{issuppl} = 1; #- remember it's a suppl medium + $supplmedium->mark_suppl; } sub _media_rank { @@ -730,14 +715,14 @@ Please insert the Cd-Rom labelled \"%s\" in your drive and press Ok when done.", } }; foreach my $k (pkgs::allMediums($o->{packages})) { - my $m = $o->{packages}{mediums}{$k}; + my $m = install_medium::by_id($k, $o->{packages}); #- don't copy rpms of supplementary media - next if $m->{issuppl};#- && $m->{medium} !~ /^\d+s$/; XXX handle suppl CDs + next if $m->is_suppl; my ($wait_w, $wait_message) = fs::format::wait_message($o); #- nb, this is only called when interactive $wait_message->(N("Copying in progress") . "\n($m->{descr})"); #- XXX to be translated if ($k != $current_medium) { - my $cd_k = getCDNumber($m->{descr}); - my $cd_cur = getCDNumber($o->{packages}{mediums}{$current_medium}{descr}); + my $cd_k = $m->get_cd_number; + my $cd_cur = install_medium::by_id($current_medium, $o->{packages})->get_cd_number; $cd_k ne $cd_cur and do { askChangeMedium($o->{method}, $k) or next; @@ -1008,8 +993,8 @@ sub install_urpmi { my @cfg; foreach (sort { $a->{medium} <=> $b->{medium} } values %$mediums) { my $name = $_->{fakemedium}; - if ($_->{ignored} || $_->{selected}) { - my $curmethod = $_->{method} || $::o->{method}; + if ($_->ignored || $_->selected) { + my $curmethod = $_->method || $::o->{method}; my $dir = (($copied_rpms_on_disk ? "/var/ftp/pub/Mandrivalinux" : '') || $_->{prefix} || ${{ nfs => "file://mnt/nfs", disk => "file:/" . $hdInstallPath, @@ -1865,5 +1850,4 @@ sub configure_pcmcia { modules::read_already_loaded($modules_conf); } - 1; diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm index 762581b38..158c63717 100644 --- a/perl-install/install_steps_gtk.pm +++ b/perl-install/install_steps_gtk.pm @@ -250,7 +250,7 @@ sub choosePackagesTree { }, node_state => sub { my $p = pkgs::packageByName($packages, $_[0]) or return; - pkgs::packageMedium($packages, $p)->{selected} or return; + pkgs::packageMedium($packages, $p)->selected or return; $p->arch eq 'src' and return; $p->flag_base and return 'base'; $p->flag_installed && !$p->flag_upgrade and return 'installed'; @@ -640,7 +640,7 @@ sub deselectFoundMedia { my $i = 0; my $totalsize = 0; foreach (@$hdlists) { - my $cd = install_any::getCDNumber($_->[3]); + my $cd = install_medium->new(descr => $_->[3])->get_cd_number; if (!$cd || !@{$cdlist{$cd} || []}) { push @hdlist2, $_; $corresp[$i] = [ $i ]; diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm index f2a420239..1d5189fdb 100644 --- a/perl-install/install_steps_interactive.pm +++ b/perl-install/install_steps_interactive.pm @@ -657,13 +657,13 @@ sub chooseCD { #- the boot medium is already selected. $mediumsDescr{pkgs::mediumDescr($packages, $install_any::boot_medium)} = 1; - #- build mediumDescr according to mediums, this avoid asking multiple times - #- all the medium grouped together on only one CD. + #- build mediumDescr according to mediums, this avoids asking multiple times + #- all the media grouped together on only one CD. foreach (@mediums) { my $descr = pkgs::mediumDescr($packages, $_); - $packages->{mediums}{$_}{ignored} and next; + $packages->{mediums}{$_}->ignored and next; exists $mediumsDescr{$descr} or push @mediumsDescr, $descr; - $mediumsDescr{$descr} ||= $packages->{mediums}{$_}{selected}; + $mediumsDescr{$descr} ||= $packages->{mediums}{$_}->selected; } if (install_any::method_is_from_ISO_images($o->{method})) { @@ -691,9 +691,13 @@ If only some CDs are missing, unselect them, then click Ok."), #- restore true selection of medium (which may have been grouped together) foreach (@mediums) { + $packages->{mediums}{$_}->ignored and next; my $descr = pkgs::mediumDescr($packages, $_); - $packages->{mediums}{$_}{ignored} and next; - $packages->{mediums}{$_}{selected} = $mediumsDescr{$descr}; + if ($mediumsDescr{$descr}) { + $packages->{mediums}{$_}->select; + } else { + $packages->{mediums}{$_}->refuse; + } log::l("select status of medium $_ is $packages->{mediums}{$_}{selected}"); } } @@ -850,7 +854,8 @@ Do you want to install the updates?")), } else { #- make sure to not try to install the packages (which are automatically selected by getPackage above). #- this is possible by deselecting the medium (which can be re-selected above). - delete $update_medium->{selected}; + #- delete $update_medium->{selected}; + $update_medium->refuse; } #- update urpmi even, because there is an hdlist available and everything is good, #- this will allow user to update the medium but update his machine later. diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index 8106be9e5..d793ae87d 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -15,7 +15,6 @@ use fs; use loopback; use c; - our %preferred = map { $_ => undef } qw(lilo perl-base gstreamer-oss openjade ctags glibc curl sane-backends postfix mdkkdm gcc gcc-cpp gcc-c++ proftpd ghostscript-X vim-minimal kernel db1 db2 libxpm4 zlib1 libncurses5 harddrake cups apache); #- lower bound on the left ( aka 90 means [90-100[ ) @@ -85,11 +84,6 @@ 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; @@ -229,7 +223,7 @@ sub packagesToInstall { my ($packages) = @_; my @packages; foreach (values %{$packages->{mediums}}) { - $_->{selected} or next; + $_->selected or next; log::l("examining packagesToInstall of medium $_->{descr}"); push @packages, grep { $_->flag_selected } packagesOfMedium($packages, $_); } @@ -262,7 +256,7 @@ sub packageRequest { #- check for medium selection, if the medium has not been #- selected, the package cannot be selected. foreach (values %{$packages->{mediums}}) { - !$_->{selected} && $pkg->id >= $_->{start} && $pkg->id <= $_->{end} and return; + !$_->selected && $pkg->id >= $_->{start} && $pkg->id <= $_->{end} and return; } return { $pkg->id => 1 }; @@ -376,7 +370,7 @@ sub psUpdateHdlistsDeps { #- check if current configuration is still up-to-date and do not need to be updated. foreach (values %{$packages->{mediums}}) { - $_->{selected} || $_->{ignored} or next; + $_->selected || $_->ignored or next; my $hdlistf = "$urpmidir/hdlist.$_->{fakemedium}.cz" . ($_->{hdlist} =~ /\.cz2/ && "2"); my $synthesisf = "$urpmidir/synthesis.hdlist.$_->{fakemedium}.cz" . ($_->{hdlist} =~ /\.cz2/ && "2"); if (-s $hdlistf != $_->{hdlist_size}) { @@ -446,8 +440,8 @@ sub psUsingHdlists { foreach my $h (@hdlists) { #- make sure the first medium is always selected! #- by default select all image. - my $supplmedium = psUsingHdlist($method, $o_packages, @$h); - $o_callback and $o_callback->($supplmedium, $o_hdlistsprefix, $method); + my $medium = psUsingHdlist($method, $o_packages, @$h); + $o_callback and $o_callback->($medium, $o_hdlistsprefix, $method); } log::l("psUsingHdlists read " . int(@{$o_packages->{depslist}}) . @@ -462,16 +456,17 @@ sub psUsingHdlist { my $urpmidir = urpmidir(); log::l("trying to read $hdlist for medium $medium_name"); - my $m = { hdlist => $hdlist, - method => $method, - medium => $medium_name, - rpmsdir => $rpmsdir, #- where is RPMS directory. - descr => $descr, - fakemedium => $fakemedium, - selected => $selected, #- default value is only CD1, it is really the minimal. - ignored => !$selected, #- keep track of ignored medium by DrakX. - pubkey => [], #- all pubkey block here - }; + my $m = install_medium->new( + hdlist => $hdlist, + method => $method, + medium => $medium_name, + rpmsdir => $rpmsdir, #- where is RPMS directory. + descr => $descr, + fakemedium => $fakemedium, + selected => $selected, #- default value is only CD1, it is really the minimal. + ignored => !$selected, #- keep track of ignored medium by DrakX. + pubkey => [], #- all pubkey blocks here + ); #- copy hdlist file directly to urpmi directory, this will be used #- for getting header of package during installation or after by urpmi. @@ -517,7 +512,7 @@ sub psUsingHdlist { $packages->{mediums}{$medium_name} = $m; #- parse synthesis (if available) of directly hdlist (with packing). - if ($m->{ignored}) { + if ($m->ignored) { log::l("ignoring packages in $hdlist"); } else { my $nb_suppl_pkg_skipped = 0; @@ -980,7 +975,7 @@ sub installTransactionClosure { #- search first usable medium (sorted by medium ordering). foreach (sort { $a->{start} <=> $b->{start} } values %{$packages->{mediums}}) { - unless ($_->{selected}) { + unless ($_->selected) { #- this medium is not selected, but we have to make sure no package are left #- in $id2pkg. if (defined $_->{start} && defined $_->{end}) { @@ -1008,7 +1003,7 @@ sub installTransactionClosure { ($min_id, $max_id) = ($medium->{start}, $medium->{end}); #- Supplementary CD : switch temporarily to "cdrom" method - my $suppl_CD = isSupplCDMedium($medium); + my $suppl_CD = $medium->is_suppl_cd; $::o->{mainmethod} = $::o->{method}; local $::o->{method} = do { my $cdrom; @@ -1025,7 +1020,7 @@ sub installTransactionClosure { } if $suppl_CD; #- it is sure at least one package will be installed according to medium chosen. install_any::useMedium($medium->{medium}); - if (install_any::method_allows_medium_change($medium->{method})) { + if (install_any::method_allows_medium_change($medium->method)) { my $pkg = $packages->{depslist}[$l[0]]; #- force changeCD callback to be called from main process. @@ -1185,7 +1180,7 @@ sub install { my $medium = packageMedium($packages, $pkg); my $f = $pkg && $pkg->filename; print $LOG "$f\n"; - if (isSupplCDMedium($medium)) { + if ($medium->is_suppl_cd) { $fd = install_any::getFile($f, $::o->{method}, supplCDMountPoint()); } else { $fd = install_any::getFile($f, $::o->{method}, $medium->{prefix}); @@ -1241,7 +1236,7 @@ sub install { if (!$retry_pkg) { my @badPackages; foreach (@transToInstall) { - if (!$_->flag_installed && packageMedium($packages, $_)->{selected} && !exists($ignoreBadPkg{$_->name})) { + if (!$_->flag_installed && packageMedium($packages, $_)->selected && !exists($ignoreBadPkg{$_->name})) { push @badPackages, $_; log::l("bad package " . $_->fullname); } else { @@ -1254,7 +1249,7 @@ sub install { $retry_count = 3; } else { my $name; - if (!$retry_pkg->flag_installed && packageMedium($packages, $retry_pkg)->{selected} && !exists($ignoreBadPkg{$retry_pkg->name})) { + if (!$retry_pkg->flag_installed && packageMedium($packages, $retry_pkg)->selected && !exists($ignoreBadPkg{$retry_pkg->name})) { if ($retry_count) { log::l("retrying installing package " . $retry_pkg->fullname . " alone in a transaction"); --$retry_count; @@ -1457,4 +1452,82 @@ sub hashtree2list { @l; } +package install_medium; + +use strict; + +#- list of fields : +#- descr (text description) +#- end (last rpm id) +#- fakemedium ("$descr ($method$medium_name)", used locally by urpmi) +#- hdlist +#- hdlist_size +#- ignored +#- issuppl (is a supplementary media) +#- key_ids (hashref, values are key ids) +#- medium (number of the medium) +#- method +#- prefix (for install_urpmi) +#- pubkey +#- rpmsdir +#- selected +#- start (first rpm id) +#- synthesis_hdlist_size +#- update (for install_urpmi) +#- with_hdlist (for install_urpmi) + +#- create a new medium +sub new { my ($class, %h) = @_; bless \%h, $class } + +#- retrieve medium by id (usually a number) or an empty placeholder +sub by_id { + my ($medium_id, $packages) = @_; + $packages = $::o->{packages} unless defined $packages; + log::l("select $medium_id among ".join(",",keys%{$packages->{mediums}})); + defined $packages->{mediums}{$medium_id} + ? $packages->{mediums}{$medium_id} + : bless { invalid => 1 }; +} + +#- is this medium a supplementary medium ? +sub is_suppl { + my ($self) = @_; + $self->{issuppl} || $self->{medium} =~ /^\d+s$/; #- XXX remove medium name kludge +} + +sub mark_suppl { my ($self) = @_; $self->{issuppl} = 1 } + +#- is this medium a supplementary CD ? +sub is_suppl_cd { my ($self) = @_; $self->{method} eq 'cdrom' && $self->is_suppl } + +sub method { + my ($self) = @_; + $self->{method}; +} + +sub selected { my ($self) = @_; $self->{selected} } +sub select { my ($self) = @_; $self->{selected} = 1 } +#- unselect, keep it mind it was unselected +sub refuse { my ($self) = @_; $self->{selected} = undef } + +#- XXX this function seems to be obsolete +sub ignored { my ($self) = @_; $self->{ignored} } + +#- guess the CD number for this media. +#- XXX lots of heuristics here, must design this properly +sub get_cd_number { + my ($self) = @_; + my $description = $self->{descr}; + (my $cd) = $description =~ /\b(?:CD|DVD) ?(\d+)\b/i; + if (!$cd) { #- test for single unnumbered DVD + $cd = 1 if $description =~ /\bDVD\b/i; + } + if (!$cd) { #- test for mini-ISO + $cd = 1 if $description =~ /\bmini.?cd\b/i; + } + #- don't mix suppl. cds with regular ones + if ($description =~ /suppl/i) { $cd += 100 } + $cd; +} + 1; |