diff options
author | Mystery Man <unknown@mandriva.org> | 2000-11-08 00:01:16 +0000 |
---|---|---|
committer | Mystery Man <unknown@mandriva.org> | 2000-11-08 00:01:16 +0000 |
commit | d5c526273db473a7d87a26000585900fc10dda7d (patch) | |
tree | 0fdaabe7a00921b6cc556601b103d344fc7ac781 /perl-install/install_any.pm | |
parent | 9c164312d4bfff6d93e1c4529de6b992f2bebc44 (diff) | |
download | drakx-backup-do-not-use-d5c526273db473a7d87a26000585900fc10dda7d.tar drakx-backup-do-not-use-d5c526273db473a7d87a26000585900fc10dda7d.tar.gz drakx-backup-do-not-use-d5c526273db473a7d87a26000585900fc10dda7d.tar.bz2 drakx-backup-do-not-use-d5c526273db473a7d87a26000585900fc10dda7d.tar.xz drakx-backup-do-not-use-d5c526273db473a7d87a26000585900fc10dda7d.zip |
This commit was manufactured by cvs2svn to create branch
'unlabeled-1.1.1'.
Diffstat (limited to 'perl-install/install_any.pm')
-rw-r--r-- | perl-install/install_any.pm | 663 |
1 files changed, 112 insertions, 551 deletions
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm index 25fbdbf79..514b940e7 100644 --- a/perl-install/install_any.pm +++ b/perl-install/install_any.pm @@ -2,200 +2,54 @@ package install_any; use diagnostics; use strict; - -use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @needToCopy); +use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK); @ISA = qw(Exporter); %EXPORT_TAGS = ( - all => [ qw(getNextStep spawnShell addToBeDone) ], + all => [ qw(versionString getNextStep doSuspend spawnSync spawnShell) ], ); @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; -#-###################################################################################### -#- misc imports -#-###################################################################################### -use common qw(:common :system :functional :file); -use commands; -use run_program; -use partition_table qw(:types); -use partition_table_raw; -use devices; -use fsedit; -use network; -use modules; -use detect_devices; -use fs; -use any; +use common qw(:system); use log; -#- package that have to be copied for proper installation (just to avoid changing cdrom) -#- here XFree86 is copied entirey if not already installed, maybe better to copy only server. -@needToCopy = qw( -XFree86-8514 XFree86-AGX XFree86-Mach32 XFree86-Mach64 XFree86-Mach8 XFree86-Mono -XFree86-P9000 XFree86-S3 XFree86-S3V XFree86-SVGA XFree86-W32 XFree86-I128 -XFree86-Sun XFree86-SunMono XFree86-Sun24 XFree86-3DLabs XFree86-FBDev XFree86-server -XFree86 dhcpcd pump ppp ypbind rhs-printfilters pnm2ppa samba ncpfs kernel-fb -); - -#-###################################################################################### -#- Media change variables&functions -#-###################################################################################### -my $postinstall_rpms = ''; -my $current_medium = 1; -my $asked_medium = 1; -my $cdrom = undef; -sub useMedium($) { - #- before ejecting the first CD, there are some files to copy! - #- does nothing if the function has already been called. - $_[0] > 1 and $::o->{method} eq 'cdrom' and setup_postinstall_rpms($::o->{prefix}, $::o->{packages}); +1; - $asked_medium eq $_[0] or log::l("selecting new medium '$_[0]'"); - $asked_medium = $_[0]; -} -sub changeMedium($$) { - my ($method, $medium) = @_; - log::l("change to medium $medium for method $method (refused by default)"); - 0; -} -sub relGetFile($) { - local $_ = $_[0]; - m,^(Mandrake|lnx4win)/, and return $_; - /\.img$/ and return "images/$_"; - my $dir = m|/| ? "Mandrake/mdkinst" : /^(?:compss|compssList|compssUsers|filelist|depslist.*|hdlist.*|auto_inst.*)$/ ? - "Mandrake/base/": "$::o->{packages}[2]{$asked_medium}{rpmsdir}/"; - "$dir$_"; -} -sub askChangeMedium($$) { - my ($method, $medium) = @_; - my $allow; - do { - eval { $allow = changeMedium($method, $medium) }; - } while ($@); #- really it is not allowed to die in changeMedium!!! or install will cores with rpmlib!!! - $allow; +sub versionString { + my $kernel = $::o->{packages}->{kernel} or die "I couldn't find the kernel package!"; + + c::headerGetEntry($kernel->{header}, 'version') . "-" . + c::headerGetEntry($kernel->{header}, 'release'); } -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}[2]{$asked_medium}{selected} or return; #- not selected means no need for worying about. - my $max = 32; #- always refuse after $max tries. - if ($::o->{method} eq "cdrom") { - cat_("/proc/mounts") =~ m|(/tmp/\S+)\s+/tmp/rhimage| and $cdrom = $1; - return unless $cdrom; - ejectCdrom($cdrom); - while ($max > 0 && askChangeMedium($::o->{method}, $asked_medium)) { - $current_medium = $asked_medium; - eval { fs::mount($cdrom, "/tmp/rhimage", "iso9660", 'readonly') }; - my $getFile = getFile($file); $getFile and return $getFile; - $current_medium = 'unknown'; #- don't know what CD is inserted now. - ejectCdrom($cdrom); - --$max; - } - } else { - while ($max > 0 && askChangeMedium($::o->{method}, $asked_medium)) { - $current_medium = $asked_medium; - my $getFile = getFile($file); $getFile and return $getFile; - $current_medium = 'unknown'; #- don't know what CD image has been copied. - --$max; - } - } - #- keep in mind the asked medium has been refused on this way. - #- this means it is no more selected. - $::o->{packages}[2]{$asked_medium}{selected} = undef; +sub getNextStep { + my ($lastStep) = @_; - #- on cancel, we can expect the current medium to be undefined too, - #- this enable remounting if selecting a package back. - $current_medium = 'unknown'; + $::o->{direction} = 1; - 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 { - #- 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]); - *GETFILE; - }; - } - goto &getFile; + return $::o->{lastChoice} = $::o->{steps}->{$lastStep}->{next}; } -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; - local $_; - while (<$f>) { syswrite F, $_ } - 1; -} - -#-###################################################################################### -#- Post installation RPMS from cdrom only, functions -#-###################################################################################### -sub setup_postinstall_rpms($$) { - my ($prefix, $packages) = @_; +sub doSuspend { + exit 1 if $::o->{localInstall} || $::testing; - $postinstall_rpms and return; - $postinstall_rpms = "$prefix/usr/postinstall-rpm"; - - log::l("postinstall rpms directory set to $postinstall_rpms"); - commands::mkdir_('-p', $postinstall_rpms); - - require pkgs; - - #- compute closure of unselected package that may be copied, - #- don't complain if package does not exists as it may happen - #- for the various architecture taken into account (X servers). - my %toCopy; - foreach (@needToCopy) { - my $pkg = pkgs::packageByName($packages, $_); - pkgs::selectPackage($packages, $pkg, 0, \%toCopy) if $pkg; + if (my $pid = fork) { + waitpid $pid, 0; + } else { + print "\n\nType <exit> to return to the install program.\n\n"; + exec {"/bin/sh"} "-/bin/sh"; + warn "error execing /bin/sh"; + sleep 5; + exit 1; } - - my @toCopy; push @toCopy, map { pkgs::packageByName($packages, $_) } keys %toCopy; - - #- extract headers of package, this is necessary for getting - #- the complete filename of each package. - #- copy the package files in the postinstall RPMS directory. - #- last arg is default medium '' known as the CD#1. - pkgs::extractHeaders($prefix, \@toCopy, $packages->[2]{1}); - commands::cp((map { "/tmp/rhimage/" . relGetFile(pkgs::packageFile($_)) } @toCopy), $postinstall_rpms); -} -sub clean_postinstall_rpms() { - $postinstall_rpms and -d $postinstall_rpms and commands::rm('-rf', $postinstall_rpms); -} - -#-###################################################################################### -#- Functions -#-###################################################################################### -sub kernelVersion { - 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); } +sub spawnSync { + return if $::o->{localInstall} || $::testing; -sub getNextStep { - my ($s) = $::o->{steps}{first}; - $s = $::o->{steps}{$s}{next} while $::o->{steps}{$s}{done} || !$::o->{steps}{$s}{reachable}; - $s; + fork and return; + while (1) { sleep(30); sync(); } } sub spawnShell { @@ -208,9 +62,9 @@ sub spawnShell { local *F; sysopen F, "/dev/tty2", 2 or die "cannot open /dev/tty2 -- no shell will be provided"; - open STDIN, "<&F" or die ''; - open STDOUT, ">&F" or die ''; - open STDERR, ">&F" or die ''; + open STDIN, "<&F" or die; + open STDOUT, ">&F" or die; + open STDERR, ">&F" or die; close F; c::setsid(); @@ -220,381 +74,88 @@ sub spawnShell { exec {"/bin/sh"} "-/bin/sh" or log::l("exec of /bin/sh failed: $!"); } -sub fsck_option() { - my ($o) = @_; - my $y = $o->{security} < 3 && $::beginner ? "-y " : ""; - substInFile { s/^(\s*fsckoptions="?)(-y )?/$1$y/ } "$o->{prefix}/etc/rc.d/rc.sysinit"; -} - -sub getAvailableSpace { - my ($o) = @_; - - #- make sure of this place to be available for installation, this could help a lot. - #- currently doing a very small install use 36Mb of postinstall-rpm, but installing - #- these packages may eat up to 90Mb (of course not all the server may be installed!). - #- 50mb may be a good choice to avoid almost all problem of insuficient space left... - my $minAvailableSize = 50 * sqr(1024); - - int ((!$::testing && - getAvailableSpace_mounted($o->{prefix}) || - getAvailableSpace_raw($o->{fstab}) * 512 / 1.07) - $minAvailableSize); -} - -sub getAvailableSpace_mounted { - my ($prefix) = @_; - my $dir = -d "$prefix/usr" ? "$prefix/usr" : "$prefix"; - my (undef, $free) = common::df($dir) or return; - log::l("getAvailableSpace_mounted $free"); - $free * 1024 || 1; -} -sub getAvailableSpace_raw { - my ($fstab) = @_; - - do { $_->{mntpoint} eq '/usr' and return $_->{size} } foreach @$fstab; - do { $_->{mntpoint} eq '/' and return $_->{size} } foreach @$fstab; - - if ($::testing) { - my $nb = 450; - log::l("taking ${nb}MB for testing"); - return $nb << 11; - } - die "missing root partition"; -} - -sub setPackages($) { - my ($o) = @_; - - require pkgs; - if (!$o->{packages} || is_empty_hash_ref($o->{packages}[0])) { - $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}; - push @{$o->{default_packages}}, "kernel-secure" if $o->{security} > 3; - push @{$o->{default_packages}}, "kernel-smp" if $o->{security} <= 3 && detect_devices::hasSMP(); #- no need for kernel-smp if we have kernel-secure which is smp - push @{$o->{default_packages}}, "kernel-pcmcia-cs" if $o->{pcmcia}; - push @{$o->{default_packages}}, "apmd" if $o->{pcmcia}; - push @{$o->{default_packages}}, "raidtools" if $o->{raid} && !is_empty_array_ref($o->{raid}{raid}); - push @{$o->{default_packages}}, "reiserfs-utils" if grep { isReiserfs($_) } @{$o->{fstab}}; - push @{$o->{default_packages}}, "cdrecord" if detect_devices::getIDEBurners(); - push @{$o->{default_packages}}, "alsa", "alsa-utils" if modules::get_alias("sound") =~ /^snd-card-/; - - pkgs::getDeps($o->{prefix}, $o->{packages}); - pkgs::selectPackage($o->{packages}, pkgs::packageByName($o->{packages}, 'basesystem') || die("missing basesystem package"), 1); - - #- must be done after selecting base packages (to save memory) - pkgs::getProvides($o->{packages}); - - $o->{compss} = pkgs::readCompss($o->{packages}); - #- must be done after getProvides - $o->{compssListLevels} = pkgs::readCompssList($o->{packages}); - ($o->{compssUsers}, $o->{compssUsersSorted}) = pkgs::readCompssUsers($o->{packages}, $o->{compss}); - - my @l = (); - push @l, "kapm", "kcmlaptop" if $o->{pcmcia}; - push @l, "Device3Dfx", "Glide_V3", "XFree86-glide-module" if detect_devices::matching_desc('Voodoo'); - require timezone; - require lang; - push @l, "isdn4k-utils" if ($o->{timezone}{timezone} || timezone::bestTimezone(lang::lang2text($o->{lang}))) =~ /Europe/; - $_->{values} = [ map { $_ + 50 } @{$_->{values}} ] foreach grep {$_} map { pkgs::packageByName($o->{packages}, $_) } @l; - - } else { - #- this has to be done to make sure the hdlist files and depslist file are present. - pkgs::psUpdateHdlistsDeps($o->{prefix}, $o->{method}); - - #- remove upgrade flag with selection one. TOCHECK - #pkgs::unselectAllPackagesIncludingUpgradable($o->{packages}); - } -} - -sub addToBeDone(&$) { - my ($f, $step) = @_; - - return &$f() if $::o->{steps}{$step}{done}; - - push @{$::o->{steps}{$step}{toBeDone}}, $f; -} - -sub setAuthentication { - my ($o) = @_; - my ($shadow, $md5, $nis) = @{$o->{authentication} || {}}{qw(shadow md5 NIS)}; - my $p = $o->{prefix}; - any::enableMD5Shadow($p, $shadow, $md5); - any::enableShadow($p) if $shadow; - if ($nis) { - $o->pkg_install("ypbind"); - my $domain = $o->{netc}{NISDOMAIN}; - $domain || $nis ne "broadcast" or die _("Can't use broadcast with no NIS domain"); - my $t = $domain ? "domain $domain" . ($nis ne "broadcast" && " server") - : "ypserver"; - substInFile { - $_ = "#~$_" unless /^#/; - $_ .= "$t $nis\n" if eof; - } "$p/etc/yp.conf"; - network::write_conf("$p/etc/sysconfig/network", $o->{netc}); - } -} - -sub killCardServices { - my $pid = chop_(cat_("/tmp/cardmgr.pid")); - $pid and kill(15, $pid); #- send SIGTERM -} - -sub hdInstallPath() { - cat_("/proc/mounts") =~ m|/\w+/(\S+)\s+/tmp/hdimage| or return; - my ($part) = grep { $_->{device} eq $1 } @{$::o->{fstab}}; - $part->{mntpoint} or grep { $_->{mntpoint} eq "/mnt/hd" } @{$::o->{fstab}} and return; - $part->{mntpoint} ||= "/mnt/hd"; - $part->{mntpoint} . first(readlink("/tmp/rhimage") =~ m|^/tmp/hdimage/(.*)|); -} - -sub unlockCdrom(;$) { - my ($cdrom) = @_; - $cdrom or cat_("/proc/mounts") =~ m|(/tmp/\S+)\s+/tmp/rhimage| and $cdrom = $1; - eval { $cdrom and ioctl detect_devices::tryOpen($1), c::CDROM_LOCKDOOR(), 0 }; -} -sub ejectCdrom(;$) { - my ($cdrom) = @_; - $cdrom or cat_("/proc/mounts") =~ m|(/tmp/\S+)\s+/tmp/rhimage| and $cdrom = $1; - my $f = eval { $cdrom && detect_devices::tryOpen($cdrom) } or return; - getFile("XXX"); #- close still opened filehandle - eval { fs::umount("/tmp/rhimage") }; - ioctl $f, c::CDROMEJECT(), 1; -} - -sub setupFB { - my ($o, $vga) = @_; - - #- install needed packages for frame buffer. - $o->pkg_install(qw(kernel-fb XFree86-FBDev)); - - $vga ||= 785; #- assume at least 640x480x16. - - require bootloader; - #- update bootloader entries with a new fb label. a bit hack unless - #- a frame buffer kernel is used, in such case we use it instead - #- with the right mode, nothing more to do. - foreach (qw(secure smp)) { - if (my $e = bootloader::get("/boot/vmlinuz-$_", $o->{bootloader})) { - if ($_ eq 'secure') { - log::l("warning: kernel-secure is not fb, using a kernel-fb instead"); - #- nothing done, fall through linux-fb. - } else { - $e->{vga} = $vga; - goto ok; - } - } - } - if (bootloader::add_kernel($o->{prefix}, $o->{bootloader}, kernelVersion($o), 'fb', - { - label => 'linux-fb', - root => bootloader::get("/boot/vmlinuz", $o->{bootloader})->{root}, - vga => $vga, - })) { - $o->{bootloader}{default} = 'linux-fb'; - } else { - log::l("unable to install kernel with frame buffer support, disabling"); - return 0; - } - ok: - bootloader::install($o->{prefix}, $o->{bootloader}, $o->{fstab}, $o->{hds}); - 1; -} - -sub install_urpmi { - my ($prefix, $method, $mediums) = @_; - - 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(), - ftp => $ENV{URLPREFIX}, - http => $ENV{URLPREFIX}, - cdrom => "removable_cdrom_$::i://mnt/cdrom" }}{$method} . "/$_->{rpmsdir}"; - - local *FILES; open FILES, "bzip2 -dc /tmp/$_->{hdlist} 2>/dev/null | hdlist2names - |"; - chop, print LIST "$dir/$_\n" foreach <FILES>; - close FILES or log::l("hdlist2names failed"), return; - close LIST; - - $dir .= " with ../base/$_->{hdlist}" if $method =~ /ftp|http/; - "$name $dir\n"; - } values %$mediums; - eval { output "$prefix/etc/urpmi/urpmi.cfg", @cfg }; -} - - -#-############################################################################### -#- kde stuff -#-############################################################################### -sub kderc_largedisplay { - my ($prefix) = @_; - - update_userkderc($prefix, 'KDE', - Contrast => 7, - kfmIconStyle => "Large", - kpanelIconStyle => "Normal", #- to change to Large when icons looks better - KDEIconStyle => "Large"); - substInFile { - s/^(GridWidth)=85/$1=100/; - s/^(GridHeight)=70/$1=75/; - } $_ foreach list_skels($prefix, '.kde/share/config/kfmrc'); -} - -sub kdeicons_postinstall { - my ($prefix) = @_; - - #- parse etc/fstab file to search for dos/win, floppy, zip, cdroms icons. - #- handle both supermount and fsdev usage. - my %l = ( - 'cdrom' => [ 'cdrom', 'Cd-Rom' ], - 'zip' => [ 'zip', 'Zip' ], - 'floppy-ls' => [ 'floppy', 'LS-120' ], - 'floppy' => [ 'floppy', 'Floppy' ], - ); - foreach (fs::read_fstab("$prefix/etc/fstab")) { - my ($name_, $nb) = $_->{mntpoint} =~ m|.*/(\S+?)(\d*)$/|; - my ($name, $text) = @{$l{$name_} || []}; - my $f = ${{ - supermount => sub { $name .= '.fsdev' if $name }, - vfat => sub { $name = 'Dos_'; $text = $name_ }, - }}{$_->{type}}; - &$f if $f; - - template2userfile($prefix, - "$ENV{SHARE_PATH}/$name.kdelnk.in", - "Desktop/$text" . ($nb && " $nb"). ".kdelnk", - 1, %$_) if $name; - } - - my @l = list_skels($prefix, 'Desktop/Doc.kdelnk'); - if (my ($lang) = eval { all("$prefix/usr/doc/mandrake") }) { - substInFile { s|^(URL=.*?)/?$|$1/$lang/index.html| } @l; - substInFile { s|^(url=/usr/doc/mandrake/)$|$1$lang/index.html| } "$prefix/usr/lib/desktop-links/mandrake.links"; - } else { - unlink @l; - substInFile { $_ = '' if /^\[MDKsupport\]$/ .. /^\s*$/ } "$prefix/usr/lib/desktop-links/mandrake.links"; - } - - # rename the .kdelnk to the name found in the .kdelnk as kde doesn't use it - # for displaying - foreach my $dir (grep { -d $_ } list_skels($prefix, 'Desktop')) { - foreach (grep { /\.kdelnk$/ } all($dir)) { - cat_("$dir/$_") =~ /^Name\[\Q$ENV{LANG}\E\]=(.{2,14})$/m - and rename "$dir/$_", "$dir/$1.kdelnk"; - } - } +sub upgrFindInstall { +# int rc; +# +# if (!$::o->{table}.parts) { +# rc = findAllPartitions(NULL, &$::o->{table}); +# if (rc) return rc; +# } +# +# umountFilesystems(&$::o->{fstab}); +# +# # rootpath upgrade support +# if (strcmp($::o->{rootPath} ,"/mnt")) +# return INST_OKAY; +# +# # this also turns on swap for us +# rc = readMountTable($::o->{table}, &$::o->{fstab}); +# if (rc) return rc; +# +# if (!testing) { +# mountFilesystems(&$::o->{fstab}); +# +# if ($::o->{method}->prepareMedia) { +# rc = $::o->{method}->prepareMedia($::o->{method}, &$::o->{fstab}); +# if (rc) { +# umountFilesystems(&$::o->{fstab}); +# return rc; +# } +# } +# } +# +# return 0; +} + +sub upgrChoosePackages { +# static int firstTime = 1; +# char * rpmconvertbin; +# int rc; +# char * path; +# char * argv[] = { NULL, NULL }; +# char buf[128]; +# +# if (testing) +# path = "/"; +# else +# path = $::o->{rootPath}; +# +# if (firstTime) { +# snprintf(buf, sizeof(buf), "%s%s", $::o->{rootPath}, +# "/var/lib/rpm/packages.rpm"); +# if (access(buf, R_OK)) { +# snprintf(buf, sizeof(buf), "%s%s", $::o->{rootPath}, +# "/var/lib/rpm/packages"); +# if (access(buf, R_OK)) { +# errorWindow("No RPM database exists!"); +# return INST_ERROR; +# } +# +# if ($::o->{method}->getFile($::o->{method}, "rpmconvert", +# &rpmconvertbin)) { +# return INST_ERROR; +# } +# +# symlink("/mnt/var", "/var"); +# winStatus(35, 3, _("Upgrade"), _("Converting RPM database...")); +# chmod(rpmconvertbin, 0755); +# argv[0] = rpmconvertbin; +# rc = runProgram(RUN_LOG, rpmconvertbin, argv); +# if ($::o->{method}->rmFiles) +# unlink(rpmconvertbin); +# +# newtPopWindow(); +# if (rc) return INST_ERROR; +# } +# winStatus(35, 3, "Upgrade", _("Finding packages to upgrade...")); +# rc = ugFindUpgradePackages(&$::o->{packages}, path); +# newtPopWindow(); +# if (rc) return rc; +# firstTime = 0; +# psVerifyDependencies(&$::o->{packages}, 1); +# } +# +# return psSelectPackages(&$::o->{packages}, &$::o->{comps}, NULL, 0, 1); } - -sub kdemove_desktop_file { - my ($prefix) = @_; - my @toMove = qw(doc.kdelnk news.kdelnk updates.kdelnk home.kdelnk printer.kdelnk floppy.kdelnk cdrom.kdelnk FLOPPY.kdelnk CDROM.kdelnk); - - #- remove any existing save in Trash of each user and - #- move appropriate file there after an upgrade. - foreach my $dir (grep { -d $_ } list_skels($prefix, 'Desktop')) { - unlink("$dir/Trash/$_") && rename("$dir/$_", "$dir/Trash/$_") - foreach grep { -e "$dir/$_" } @toMove, grep { /\.rpmorig$/ } all($dir) - } -} - - -#-############################################################################### -#- auto_install stuff -#-############################################################################### -sub auto_inst_file() { ($::g_auto_install ? "/tmp" : "$::o->{prefix}/root") . "/auto_inst.cfg.pl" } - -sub g_auto_install(;$) { - my ($f) = @_; $f ||= auto_inst_file; - my $o = {}; - - $o->{default_packages} = [ map { pkgs::packageName($_) } grep { pkgs::packageFlagSelected($_) && !pkgs::packageFlagBase($_) } values %{$::o->{packages}[0]} ]; - - my @fields = qw(mntpoint type size); - $o->{partitions} = [ map { my %l; @l{@fields} = @$_{@fields}; \%l } grep { $_->{mntpoint} } @{$::o->{fstab}} ]; - - exists $::o->{$_} and $o->{$_} = $::o->{$_} foreach qw(lang autoSCSI authentication printer mouse wacom netc timezone superuser intf keyboard mkbootdisk users installClass partitioning isUpgrade manualFstab nomouseprobe crypto security modem useSupermount autoExitInstall); #- TODO modules bootloader - - if (my $card = $::o->{X}{card}) { - $o->{X}{$_} = $::o->{X}{$_} foreach qw(default_depth resolution_wanted); - if ($o->{X}{default_depth} and my $depth = $card->{depth}{$o->{X}{default_depth}}) { - $depth ||= []; - $o->{X}{resolution_wanted} ||= join "x", @{$depth->[0]} unless is_empty_array_ref($depth->[0]); - $o->{X}{monitor} = $::o->{X}{monitor} if $::o->{X}{monitor}{manual}; - } - } - - local $o->{partitioning}{auto_allocate} = 1; - local $o->{autoExitInstall} = 1; - - $_ = { %{$_ || {}} }, delete @$_{qw(oldu oldg password password2)} foreach $o->{superuser}, @{$o->{users} || []}; - - local *F; - open F, ">$f" or log::l("can't output the auto_install script in $f"), return; - print F "# You should always check the syntax with 'perl -cw auto_inst.cfg.pl' before testing\n"; - print F Data::Dumper->Dump([$o], ['$o']), "\0"; -} - -sub loadO { - my ($O, $f) = @_; $f ||= auto_inst_file; - my $o; - if ($f =~ /^(floppy|patch)$/) { - my $f = $f eq "floppy" ? "auto_inst.cfg" : "patch"; - unless ($::testing) { - fs::mount(devices::make("fd0"), "/mnt", (arch() =~ /sparc/ ? "romfs" : "vfat"), 'readonly'); - $f = "/mnt/$f"; - } - -e $f or $f .= '.pl'; - - my $b = before_leaving { - fs::umount("/mnt") unless $::testing; - modules::unload($_) foreach qw(vfat fat); - }; - $o = loadO($O, $f); - } else { - -e "$f.pl" and $f .= ".pl" unless -e $f; - - my $fh = -e $f ? do { local *F; open F, $f; *F } : getFile($f) or die _("Error reading file $f"); - { - local $/ = "\0"; - no strict; - eval <$fh>; - close $fh; - $@ and log::l("Bad kickstart file $f (failed $@)"); - } - add2hash_($o ||= {}, $O); - } - bless $o, ref $O; -} - -sub generate_ks_cfg { - my ($o) = @_; - - return if $o->{method} =~ /hd|cdrom/; - - my $ks; - if ($o->{method} =~ /ftp|http/) { - $ks .= "url --url $ENV{URLPREFIX}\n"; - } elsif ($o->{method} =~ /nfs/) { - cat_("/proc/mounts") =~ m|(\S+):(\S+)\s+/tmp/rhimage nfs| or die; - $ks .= "nfs --server $1 --dir $2\n"; - } - my %intf = %{$o->{intf}[0]}; - if ($intf{BOOTPROTO} =~ /^(dhcp|bootp)$/) { - $ks .= "network --bootproto $intf{BOOTPROTO}\n"; - } else { - my %l = (ip => $intf{IPADDR}, netmask => $intf{NETMASK}, gateway => $o->{netc}{GATEWAY}); - $ks .= "network " . join(" ", map_each { $::b && "--$::a $::b" } %l); - $ks .= " --nameserver $_" foreach network::dnsServers($o->{netc}); - $ks .= "\n"; - } - $ks; -} - -1; |