From 3600a1fd1e9398fad208e3e94c6def2a8e84314a Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Sun, 26 Mar 2000 21:30:07 +0000 Subject: no_comment --- perl-install/ChangeLog | 11 +++++++++ perl-install/detect_devices.pm | 2 +- perl-install/fs.pm | 3 ++- perl-install/ftp.pm | 3 ++- perl-install/install2.pm | 1 + perl-install/install_any.pm | 37 ++++++++++++++++--------------- perl-install/install_steps.pm | 10 ++++----- perl-install/install_steps_interactive.pm | 3 +-- perl-install/loopback.pm | 3 +++ perl-install/my_gtk.pm | 1 + perl-install/pkgs.pm | 26 ++++++++++++++++------ 11 files changed, 65 insertions(+), 35 deletions(-) (limited to 'perl-install') diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog index 0a3ed269b..213efd090 100644 --- a/perl-install/ChangeLog +++ b/perl-install/ChangeLog @@ -1,3 +1,14 @@ +2000-03-26 Pixel + + * install_any.pm (install_urpmi): full support for multi-hdlist's + + * pkgs.pm (extractHeaders): look for hdlist in /tmp instead of + $prefix/var/lib/urpmi + * pkgs.pm (psUsingHdlists): put hdlist's in /var/lib/urpmi with a + fake name. Access via /tmp/$hdlist is given for non-fake name + + * detect_devices.pm (hasHPT): return undef if no htp (silly me :-/) + 2000-03-25 Pixel * lilo.pm: updated to the new format of entries. It was an hash. diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm index f5e2efa89..15db77742 100644 --- a/perl-install/detect_devices.pm +++ b/perl-install/detect_devices.pm @@ -202,7 +202,7 @@ sub hasHPT { cat_("/proc/cmdline") =~ /(ide2=(\S+)(\s+ide3=(\S+))?)/ and return $1; require pci_probing::main; - my @l = map { $_->[0] } grep { $_->[1] =~ /(HPT|Ultra66)/ } pci_probing::main::probe('STORAGE_OTHER', 'more'); + my @l = map { $_->[0] } grep { $_->[1] =~ /(HPT|Ultra66)/ } pci_probing::main::probe('STORAGE_OTHER', 'more') or return; my $ide = sprintf "ide2=0x%x,0x%x ide3=0x%x,0x%x", map_index { hex($_) + (odd($::i) ? 1 : -1) } do { if (@l == 2) { diff --git a/perl-install/fs.pm b/perl-install/fs.pm index c1352146f..88734a3e4 100644 --- a/perl-install/fs.pm +++ b/perl-install/fs.pm @@ -349,7 +349,8 @@ sub write_fstab($;$$) { local $_->{mntpoint} = do { $passno = 0; - "/initrd/loopfs" } if loopback::carryRootLoopback($_); + "/initrd/loopfs"; + } if loopback::carryRootLoopback($_); add_options($options, "loop") if isLoopback($_) && !isSwap($_); #- no need for loop option for swap files diff --git a/perl-install/ftp.pm b/perl-install/ftp.pm index d1a7ac241..014fe7237 100644 --- a/perl-install/ftp.pm +++ b/perl-install/ftp.pm @@ -54,7 +54,8 @@ sub getFile { my $f = shift; my ($ftp, $retr) = new(@_ ? @_ : fromEnv); $$retr->close if $$retr; - $$retr = $ftp->retr(install_any::relGetFile($f)); + $$retr = $ftp->retr(install_any::relGetFile($f)) or rewindGetFile(); + $$retr ||= $ftp->retr(install_any::relGetFile($f)); } sub rewindGetFile() { diff --git a/perl-install/install2.pm b/perl-install/install2.pm index 3130eff8c..1622b9cf0 100644 --- a/perl-install/install2.pm +++ b/perl-install/install2.pm @@ -423,6 +423,7 @@ sub configureTimezone { #- can't be done in install cuz' timeconfig %post creates funny things add2hash($o->{timezone}, { timezone::read($f) }); } + $o->{timezone}{timezone} ||= timezone::bestTimezone(lang::lang2text($o->{lang})); $o->{timezone}{UTC} = !$::beginner && !grep { isFat($_) } @{$o->{fstab}} unless exists $o->{timezone}{UTC}; $o->timeConfig($f, $clicked); } diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm index f268fb81d..4c462f48d 100644 --- a/perl-install/install_any.pm +++ b/perl-install/install_any.pm @@ -112,8 +112,11 @@ sub rewindGetFile() { #- Functions #-###################################################################################### sub kernelVersion { - local $_ = readlink("$::o->{prefix}/boot/vmlinuz") || $::testing && "vmlinuz-2.2.testversion" or die "I couldn't find the kernel package!"; - first(/vmlinuz-(.*)/); + my ($o) = @_; + local $_ = readlink("$::o->{prefix}/boot/vmlinuz") and return first(/vmlinuz-(.*)/); + + my $p = pkgs::packageByName($o->{packages}, "kernel") or die "I couldn't find the kernel package!"; + pkgs::packageVersion($p) . "-" . pkgs::packageRelease($p); } @@ -170,7 +173,7 @@ sub setPackages($) { require pkgs; if (!$o->{packages} || is_empty_hash_ref($o->{packages}[0])) { - $o->{packages} = pkgs::psUsingHdlists($o->{prefix}); + $o->{packages} = pkgs::psUsingHdlists($o->{prefix}, $o->{method}); push @{$o->{default_packages}}, "nfs-utils-clients" if $o->{method} eq "nfs"; push @{$o->{default_packages}}, "numlock" if $o->{miscellaneous}{numlock}; @@ -458,7 +461,7 @@ sub setupFB { } } } - if (lilo::add_kernel($o->{prefix}, $o->{bootloader}, kernelVersion(), 'fb', + if (lilo::add_kernel($o->{prefix}, $o->{bootloader}, kernelVersion($o), 'fb', { label => 'linux-fb', root => lilo::get("/boot/vmlinuz", $o->{bootloader})->{root}, @@ -548,34 +551,32 @@ sub fsck_option() { } sub install_urpmi { - my ($prefix, $method) = @_; - - (my $name = _("installation")) =~ s/\s/_/g; #- in case translators are too good :-/ - - my $hdlist = "$prefix/var/lib/urpmi/hdlist"; - symlink "$hdlist.cz2", "hdlist.$name.cz2" or log::l("symlink failed " . __FILE__ . " " . __LINE__); + my ($prefix, $method, $mediums) = @_; { local *F = getFile("depslist"); output("$prefix/var/lib/urpmi/depslist", ); } - { + my @cfg = map_index { + my $name = $_->{fakemedium}; + local *LIST; open LIST, ">$prefix/var/lib/urpmi/list.$name" or log::l("failed to write list.$name"), return; my $dir = ${{ nfs => "file://mnt/nfs", - hd => "file:/" . hdInstallPath, + hd => "file:/" . hdInstallPath(), ftp => $ENV{URLPREFIX}, http => $ENV{URLPREFIX}, - cdrom => "removable_cdrom_1://mnt/cdrom" }}{$method}; + cdrom => "removable_cdrom_$::i://mnt/cdrom" }}{$method} . "/Mandrake/RPMS$_->{medium}"; - local *FILES; open FILES, "bzip2 -dc $hdlist.cz2 2>/dev/null | hdlist2names - |"; - chop, print LIST "$dir/Mandrake/RPMS/$_\n" foreach ; + local *FILES; open FILES, "bzip2 -dc /tmp/$_->{hdlist} 2>/dev/null | hdlist2names - |"; + chop, print LIST "$dir/$_\n" foreach ; close FILES or log::l("hdlist2names failed"), return; - $dir .= "/Mandrake/RPMS with ../base/hdlist.cz2" if $method =~ /ftp|http/; - eval { output "$prefix/etc/urpmi/urpmi.cfg", "$name $dir\n" }; - } + $dir .= " with ../base/$_->{hdlist}" if $method =~ /ftp|http/; + "$name $dir\n"; + } values %$mediums; + eval { output "$prefix/etc/urpmi/urpmi.cfg", @cfg }; } sub list_passwd() { diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm index ab9c4ab24..3bef8b6bf 100644 --- a/perl-install/install_steps.pm +++ b/perl-install/install_steps.pm @@ -293,7 +293,7 @@ Consoles 1,3,4,7 may also contain interesting information"; my $pkg = pkgs::packageByName($o->{packages}, 'urpmi'); if ($pkg && pkgs::packageFlagSelected($pkg)) { - install_any::install_urpmi($o->{prefix}, $o->{method}); + install_any::install_urpmi($o->{prefix}, $o->{method}, $o->{packages}[2]); substInFile { s/^urpmi\n//; $_ .= "urpmi\n" if eof } "$msec/group.conf" if -d $msec; } @@ -584,10 +584,10 @@ sub createBootdisk($) { if (arch() =~ /^sparc/) { require silo; - silo::mkbootdisk($o->{prefix}, install_any::kernelVersion(), $dev, $o->{bootloader}{perImageAppend}); + silo::mkbootdisk($o->{prefix}, install_any::kernelVersion($o), $dev, $o->{bootloader}{perImageAppend}); } else { require lilo; - lilo::mkbootdisk($o->{prefix}, install_any::kernelVersion(), $dev, $o->{bootloader}{perImageAppend}); + lilo::mkbootdisk($o->{prefix}, install_any::kernelVersion($o), $dev, $o->{bootloader}{perImageAppend}); } $o->{mkbootdisk} = $dev; } @@ -637,10 +637,10 @@ sub setupBootloaderBefore { } } elsif (arch() =~ /^sparc/) { require silo; - silo::suggest($o->{prefix}, $o->{bootloader}, $o->{hds}, $o->{fstab}, install_any::kernelVersion()); + silo::suggest($o->{prefix}, $o->{bootloader}, $o->{hds}, $o->{fstab}, install_any::kernelVersion($o)); } else { require lilo; - lilo::suggest($o->{prefix}, $o->{bootloader}, $o->{hds}, $o->{fstab}, install_any::kernelVersion()); + lilo::suggest($o->{prefix}, $o->{bootloader}, $o->{hds}, $o->{fstab}, install_any::kernelVersion($o)); lilo::suggest_floppy($o->{bootloader}) if $o->{security} <= 3; $o->{bootloader}{keytable} ||= keyboard::keyboard2kmap($o->{keyboard}); } diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm index 59aa06e70..6b907da0f 100644 --- a/perl-install/install_steps_interactive.pm +++ b/perl-install/install_steps_interactive.pm @@ -544,10 +544,9 @@ sub timeConfig { my ($o, $f, $clicked) = @_; require timezone; - $o->{timezone}{timezone} ||= timezone::bestTimezone(lang::lang2text($o->{lang})); $o->{timezone}{timezone} = $o->ask_from_treelist('', _("Which is your timezone?"), '/', [ timezone::getTimeZones($::g_auto_install ? '' : $o->{prefix}) ], $o->{timezone}{timezone}); $o->{timezone}{UTC} = $o->ask_yesorno('', _("Is your hardware clock set to GMT?"), $o->{timezone}{UTC}) if $::expert || $clicked; - install_steps::timeConfig($o,$f); + install_steps::timeConfig($o, $f); } #------------------------------------------------------------------------------ diff --git a/perl-install/loopback.pm b/perl-install/loopback.pm index 8fd9c8748..b7073d5f5 100644 --- a/perl-install/loopback.pm +++ b/perl-install/loopback.pm @@ -39,6 +39,9 @@ sub carryRootCreateSymlink { eval { commands::mkdir_("-p", dirname($mntpoint)) }; #- do non-relative link for install, should be changed to relative link before rebooting symlink "/initrd/loopfs", $mntpoint; + + mkdir "/initrd/loopfs/boot", 0755; + symlink "/initrd/loopfs/boot", "$prefix/boot"; } #- indicate kernel to keep initrd mkdir "$prefix/initrd", 0755; diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm index 5970a1e7c..40f82f4cd 100644 --- a/perl-install/my_gtk.pm +++ b/perl-install/my_gtk.pm @@ -219,6 +219,7 @@ sub createScrolledWindow($) { member(ref $W, qw(Gtk::CList Gtk::CTree Gtk::Text)) ? $w->add($W) : $w->add_with_viewport($W); + $W->can("set_focus_vadjustment") and $W->set_focus_vadjustment($w->get_vadjustment); $W->show; $w } diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index 409bca76c..270272a1f 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -128,7 +128,7 @@ sub extractHeaders($$$) { cleanHeaders($prefix); run_program::run("extract_archive", - "$prefix/var/lib/urpmi/$medium->{hdlist}", + "/tmp/$medium->{hdlist}", "$prefix/tmp/headers", map { packageHeaderFile($_) } @$pkgs); @@ -269,8 +269,8 @@ sub skipSetWithProvides { packageSetFlagSkip($_, 1) foreach grep { $_ } map { $_, packageProvides($_) } map { packageByName($packages, $_) } @l; } -sub psUsingHdlists($) { - my ($prefix) = @_; +sub psUsingHdlists { + my ($prefix, $method) = @_; my $listf = install_any::getFile('hdlists') or die "no hdlists found"; my @packages = ({}, [], {}); my @hdlists; @@ -288,21 +288,25 @@ sub psUsingHdlists($) { my ($hdlist, $medium) = @$_; my $f = install_any::getFile($hdlist) or die "no $hdlist found"; + my $fakemedium = $method . ($medium || 1); $packages[2]{$medium} = { hdlist => $hdlist, medium => $medium, #- default medium is ''. + fakemedium => $fakemedium, min => scalar keys %{$packages[0]}, max => -1, #- will be updated after reading current hdlist. }; #- copy hdlist file directly to $prefix/var/lib/urpmi, this will be used #- for getting header of package during installation or after by urpmi. - my $newf = "$prefix/var/lib/urpmi/$hdlist"; + my $newf = "$prefix/var/lib/urpmi/hdlist.$fakemedium.cz2"; -e $newf and do { unlink $newf or die "cannot remove $newf: $!"; }; local *F; open F, ">$newf" or die "cannot create $newf: $!"; my ($buf, $sz); while (($sz = sysread($f, $buf, 16384))) { syswrite(F, $buf) } close F; + symlinkf $newf, "/tmp/$hdlist"; + #- extract filename from archive, this take advantage of verifying #- the archive too. open F, "extract_archive $newf |" or die "unable to parse $newf"; @@ -724,6 +728,9 @@ sub install($$$;$$) { return if $::g_auto_install || !scalar(@$toInstall); + #- for root loopback'ed /boot + my $loop_boot = readlink "$prefix/boot"; unlink "$prefix/boot"; mkdir "$prefix/boot", 0755; + #- first stage to extract some important informations #- about the packages selected. this is used to select #- one or many transaction. @@ -746,8 +753,7 @@ sub install($$$;$$) { my $callbackOpen = sub { my $f = packageFile($packages{$_[0]}); print LOG "$f\n"; - my $fd = install_any::getFile($f) or install_any::rewindGetFile(); - $fd ||= install_any::getFile($f) or log::l("ERROR: bad file $f"); + my $fd = install_any::getFile($f); $fd ? fileno $fd : -1; }; my $callbackClose = sub { packageSetFlagInstalled(delete $packages{$_[0]}, 1) }; @@ -827,7 +833,13 @@ sub install($$$;$$) { log::l("rpm database closed"); cleanHeaders($prefix); - install_any::rewindGetFile(); #- make sure to reopen the connection, usefull for ftp. + + if ($loop_boot) { + my @files = glob_("$prefix/boot/*"); + commands::cp("-f", @files, $loop_boot) if @files; + commands::rm("-rf", "$prefix/boot"); + symlink $loop_boot, "$prefix/boot"; + } } sub remove($$) { -- cgit v1.2.1