From 1a996ceb744f490f0183099640e7a1eb3ad039c1 Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Tue, 22 Aug 2000 01:10:13 +0000 Subject: no_comment --- perl-install/crypto.pm | 11 ++++---- perl-install/ftp.pm | 4 +-- perl-install/http.pm | 2 +- perl-install/install_any.pm | 42 ++++++++++++++++++------------- perl-install/install_interactive.pm | 2 +- perl-install/install_steps.pm | 14 ----------- perl-install/install_steps_interactive.pm | 7 +++--- perl-install/partition_table.pm | 8 ++++-- perl-install/pkgs.pm | 13 +++++----- 9 files changed, 50 insertions(+), 53 deletions(-) (limited to 'perl-install') diff --git a/perl-install/crypto.pm b/perl-install/crypto.pm index ac0904ce1..8d225c828 100644 --- a/perl-install/crypto.pm +++ b/perl-install/crypto.pm @@ -34,6 +34,7 @@ sub ftp($) { ftp::new($_[0], dir($_[0])) } sub getFile($$) { my ($file, $host) = @_; + $host ||= $crypto::host; log::l("getting crypto file $file on directory " . dir($host) . " with login $mirrors{$host}[2]"); my ($ftp, $retr) = ftp::new($host, dir($host), $mirrors{$host}[2] ? $mirrors{$host}[2] : (), @@ -44,16 +45,16 @@ sub getFile($$) { $$retr ||= $ftp->retr($file); } -sub getDepslist($) { getFile("depslist-crypto", $_[0]) or die "unable to get depslist-crypto" } -sub getHdlist($) { getFile("hdlist-crypto.cz2", $_[0]) or die "unable to get hdlist-crypto.cz2" } +sub getDepslist { getFile("depslist-crypto", $_[0]) or die "unable to get depslist-crypto" } -#sub packages($) { ftp($_[0])->ls } -sub getPackages($) { +sub getPackages { my ($prefix, $packages, $mirror) = @_; + $crypto::host = $mirror; + #- extract hdlist of crypto, then depslist. require pkgs; - pkgs::psUsingHdlist($prefix, '', $packages, getHdlist($mirror), "hdlistCrypto.cz2", "Crypto", '', "Crytographic site", 1) and + pkgs::psUsingHdlist($prefix, '', $packages, "hdlist-crypto.cz2", "crypto.cz2", "Crypto", "Cryptographic site", 1, getFile("hdlist-crypto.cz2", $mirror)) and pkgs::getOtherDeps($packages, getDepslist($mirror)); #- produce an output suitable for visualization. diff --git a/perl-install/ftp.pm b/perl-install/ftp.pm index 36b99b560..6bbd6cbae 100644 --- a/perl-install/ftp.pm +++ b/perl-install/ftp.pm @@ -54,8 +54,8 @@ sub getFile { my $f = shift; my ($ftp, $retr) = new(@_ ? @_ : fromEnv); $$retr->close if $$retr; - $$retr = $ftp->retr(install_any::relGetFile($f)) or rewindGetFile(); - $$retr ||= $ftp->retr(install_any::relGetFile($f)); + $$retr = $ftp->retr($f) or rewindGetFile(); + $$retr ||= $ftp->retr($f); } #-sub closeFiles() { diff --git a/perl-install/http.pm b/perl-install/http.pm index 8797b9e39..ce1b5430a 100644 --- a/perl-install/http.pm +++ b/perl-install/http.pm @@ -13,7 +13,7 @@ sub getFile { my ($host, $port, $path) = $ENV{URLPREFIX} =~ m,^http://([^/:]+)(?::(\d+))?(/\S*)?$,; $host = network::resolv($host); - $path .= "/" . install_any::relGetFile($_[0]); + $path .= "/$_[0]"; $sock->close if $sock; $sock = IO::Socket::INET->new(PeerAddr => $host, diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm index 16e32b465..3c5c6801c 100644 --- a/perl-install/install_any.pm +++ b/perl-install/install_any.pm @@ -112,32 +112,38 @@ sub errorOpeningFile($) { return; } sub getFile { - local $^W = 0; - if ($::o->{method} && $::o->{method} eq "ftp") { - require ftp; - *install_any::getFile = sub { ftp::getFile($_[0]) or errorOpeningFile($_[0]) }; - } elsif ($::o->{method} && $::o->{method} eq "http") { - require http; - *install_any::getFile = sub { http::getFile($_[0]) or errorOpeningFile($_[0]) }; - } else { - *install_any::getFile = sub { + my ($f, $method) = @_; + my $rel = install_any::relGetFile($f); + log::l("getFile $f ($method) relGetFile $rel"); + do { + if ($method =~ /crypto/i) { + require crypto; + log::l("crypto::getFile $f"); + crypto::getFile($f); + } elsif ($method eq "ftp") { + require ftp; + ftp::getFile($rel); + } elsif ($method eq "http") { + require http; + http::getFile($rel); + } else { #- try to open the file, but examine if it is present in the repository, this allow #- handling changing a media when some of the file on the first CD has been copied #- to other to avoid media change... - log::l("getFile /tmp/rhimage/" . relGetFile($_[0])); - open GETFILE, "/tmp/rhimage/" . relGetFile($_[0]) or - $postinstall_rpms and open GETFILE, "$postinstall_rpms/$_[0]" or return errorOpeningFile($_[0]); + my $f2 = "$postinstall_rpms/$f"; + $f2 = "/tmp/rhimage/$rel" unless -e $f2; + log::l("local getFile $f2"); + open GETFILE, $f2; *GETFILE; - }; - } - goto &getFile; + } + } or errorOpeningFile($f); } sub getAndSaveFile { my ($file, $local) = @_; log::l("getAndSaveFile $file $local"); local *F; open F, ">$local" or return; local $/ = \ (16 * 1024); - my $f = getFile($file) or return; + my $f = ref($file) ? $file : getFile($file) or return; local $_; while (<$f>) { syswrite F, $_ } 1; @@ -621,10 +627,10 @@ sub suggest_mount_points { next if $uniq && fsedit::mntpoint2part($mnt, \@parts); $part->{mntpoint} = $mnt; - # try to find other mount points via fstab + #- try to find other mount points via fstab fs::get_mntpoints_from_fstab(\@parts, $d) if $mnt eq '/'; } - $_->{mntpoint} || fsedit::suggest_part($_, $hds) foreach @parts; +#- $_->{mntpoint} || fsedit::suggest_part($_, $hds) foreach @parts; $_->{mntpoint} and log::l("suggest_mount_points: $_->{device} -> $_->{mntpoint}") foreach @parts; } diff --git a/perl-install/install_interactive.pm b/perl-install/install_interactive.pm index e7c7e625a..62cd9858c 100644 --- a/perl-install/install_interactive.pm +++ b/perl-install/install_interactive.pm @@ -29,7 +29,7 @@ sub partitionWizard { # each solution is a [ score, text, function ], where the function retunrs true if succeeded - if (fsedit::free_space(@$hds) > $min_linux and !$readonly) { + if (fsedit::free_space(grep { partition_table::can_raw_add($_) } @$hds) > $min_linux and !$readonly) { $solutions{free_space} = [ 20, _("Use free space"), sub { fsedit::auto_allocate($hds, $o->{partitions}); 1 } ] } else { push @wizlog, _("Not enough free space to allocate new partitions"); diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm index 06d24c232..cb2211abf 100644 --- a/perl-install/install_steps.pm +++ b/perl-install/install_steps.pm @@ -613,20 +613,6 @@ sub installCrypto { $o->upNetwork; require crypto; my @crypto_packages = crypto::getPackages($o->{prefix}, $o->{packages}, $u->{mirror}); - - my $oldGetFile = \&install_any::getFile; - local *install_any::getFile = sub { - my ($rpmfile) = @_; - if ($rpmfile =~ /^(.*)-[^-]*-[^-]*$/ && member($1, @crypto_packages)) { - log::l("crypto::getFile $rpmfile"); - crypto::getFile($rpmfile, $u->{mirror}); - } else { - #- use previous getFile typically if non cryptographic packages - #- have been selected by dependancies. - log::l("normal getFile $rpmfile"); - &$oldGetFile($rpmfile); - } - }; $o->pkg_install(@{$u->{packages}}); } diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm index 494c61d34..b4b4a122e 100644 --- a/perl-install/install_steps_interactive.pm +++ b/perl-install/install_steps_interactive.pm @@ -17,13 +17,13 @@ use install_steps; use install_interactive; use install_any; use detect_devices; +use netconnect; use run_program; use commands; use devices; use fsedit; use network; use raid; -use netconnect; use mouse; use modules; use lang; @@ -517,7 +517,7 @@ such as ``mybox.mylab.myco.com''."), #- (dam's) if (!$::beginner && $o->ask_yesorno([ _("Modem Configuration") ], _("Do you want to configure a ISDN connection for your system?"), 0)) { - Netconnect::detect_isdn($o->{prefix}, $o->{isdn}, $o, bool($o->{pcmcia})); +# netconnect::detect_isdn($o->{prefix}, $o->{isdn}, $o, bool($o->{pcmcia})); } } @@ -657,8 +657,7 @@ USA")) || return; my %h; $h{$_} = 1 foreach @{$u->{packages} || []}; $o->ask_many_from_list_ref('', _("Please choose the packages you want to install."), \@packages, [ map { \$h{$_} } @packages ]) or return; - $u->{packages} = [ grep { $h{$_} } @packages ]; - install_steps::installCrypto($o); + $o->pkg_install(@{$u->{packages} = [ grep { $h{$_} } @packages ]}); #- stop interface using ppp only. $o->downNetwork('pppOnly'); diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm index 547c1b8e1..feecaa33f 100644 --- a/perl-install/partition_table.pm +++ b/perl-install/partition_table.pm @@ -630,8 +630,12 @@ sub next_start($$) { $next ? $next->{start} : $hd->{totalsectors}; } - -sub raw_add($$) { +sub can_raw_add { + my ($hd) = @_; + $_->{size} || $_->{type} or return foreach @{$hd->{primary}{raw}}; + 1; +} +sub raw_add { my ($raw, $part) = @_; foreach (@$raw) { diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index cb1d42006..0b8339e5f 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -443,7 +443,7 @@ sub psUsingHdlists { } sub psUsingHdlist { - my ($prefix, $method, $packages, $hdlist, $medium, $rpmsdir, $descr, $selected) = @_; + my ($prefix, $method, $packages, $hdlist, $medium, $rpmsdir, $descr, $selected, $fhdlist) = @_; #- if the medium already exist, use it. $packages->[2]{$medium} and return; @@ -463,7 +463,7 @@ sub psUsingHdlist { #- for getting header of package during installation or after by urpmi. my $newf = "$prefix/var/lib/urpmi/hdlist.$fakemedium.cz2"; -e $newf and do { unlink $newf or die "cannot remove $newf: $!"; }; - install_any::getAndSaveFile($hdlist, $newf) or die "no $hdlist found"; + install_any::getAndSaveFile($fhdlist || $hdlist, $newf) or die "no $hdlist found"; symlinkf $newf, "/tmp/$hdlist"; #- extract filename from archive, this take advantage of verifying @@ -1021,9 +1021,10 @@ sub install($$$;$$) { log::l("\tdone"); my $callbackOpen = sub { - my $f = packageFile($packages{$_[0]}); - print LOG "$f\n"; - my $fd = install_any::getFile($f); + my $p = $packages{$_[0]}; + my $f = packageFile($p); + print LOG "$f $p->{medium}{descr}\n"; + my $fd = install_any::getFile($f, $p->{medium}{descr}); $fd ? fileno $fd : -1; }; my $callbackClose = sub { packageSetFlagInstalled(delete $packages{$_[0]}, 1) }; @@ -1081,7 +1082,7 @@ sub install($$$;$$) { #- reset file descriptor open for main process but #- make sure error trying to change from hdlist are #- trown from main process too. - install_any::getFile(packageFile($transToInstall[0])); + install_any::getFile(packageFile($transToInstall[0]), $transToInstall[0]{medium}{descr}); #- and make sure there are no staling open file descriptor too! install_any::getFile('XXX'); -- cgit v1.2.1