summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--perl-install/crypto.pm11
-rw-r--r--perl-install/ftp.pm4
-rw-r--r--perl-install/http.pm2
-rw-r--r--perl-install/install_any.pm42
-rw-r--r--perl-install/install_interactive.pm2
-rw-r--r--perl-install/install_steps.pm14
-rw-r--r--perl-install/install_steps_interactive.pm7
-rw-r--r--perl-install/partition_table.pm8
-rw-r--r--perl-install/pkgs.pm13
9 files changed, 50 insertions, 53 deletions
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');
generated by cgit v1.2.1 (git 2.21.0) at 2024-06-23 13:10:04 +0000