From 7507023403933bbd0d851a250a474f85ba6a89d2 Mon Sep 17 00:00:00 2001 From: Mystery Man Date: Mon, 11 Jun 2001 11:44:34 +0000 Subject: This commit was manufactured by cvs2svn to create branch 'ppp'. --- perl-install/install_any.pm | 969 -------------------------------------------- 1 file changed, 969 deletions(-) delete mode 100644 perl-install/install_any.pm (limited to 'perl-install/install_any.pm') diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm deleted file mode 100644 index 9bba376cb..000000000 --- a/perl-install/install_any.pm +++ /dev/null @@ -1,969 +0,0 @@ -package install_any; # $Id$ - -use diagnostics; -use strict; - -use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @needToCopy @needToCopyIfRequiresSatisfied $boot_medium @advertising_images); - -@ISA = qw(Exporter); -%EXPORT_TAGS = ( - all => [ qw(getNextStep spawnShell addToBeDone) ], -); -@EXPORT_OK = map { @$_ } values %EXPORT_TAGS; - -#-###################################################################################### -#- misc imports -#-###################################################################################### -use common qw(:common :system :functional :file); -use run_program; -use partition_table qw(:types); -use partition_table_raw; -use devices; -use fsedit; -use modules; -use detect_devices; -use lang; -use any; -use log; -use fs; - -#- 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 XFree86-glide-module Device3Dfx Glide_V3-DRI Glide_V5 Mesa -dhcpcd pump dhcpxd dhcp-client isdn4net isdn4k-utils dev pptp-adsl-fr rp-pppoe ppp ypbind -rhs-printfilters lpr cups cups-drivers samba ncpfs ghostscript-utils autologin -); -#- package that have to be copied only if all their requires are satisfied. -@needToCopyIfRequiresSatisfied = qw( -Mesa-common xpp libqtcups2 qtcups kups -); - -#- boot medium (the first medium to take into account). -$boot_medium = 1; - -#-###################################################################################### -#- Media change variables&functions -#-###################################################################################### -my $postinstall_rpms = ''; -my $current_medium = $boot_medium; -my $asked_medium = $boot_medium; -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}); - - $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|\.rpm$| ? "$::o->{packages}{mediums}{$asked_medium}{rpmsdir}/$_" : $_; -} -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 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 for worying about. - - my $max = 32; #- always refuse after $max tries. - if ($::o->{method} eq "cdrom") { - cat_("/proc/mounts") =~ m,(/(?:dev|tmp)/\S+)\s+(?:/mnt/cdrom|/tmp/image), 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/image", "iso9660", 'readonly') }; - my $getFile = getFile($file); - $getFile && @advertising_images and copy_advertising($::o); - $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}{mediums}{$asked_medium}{selected} = undef; - - #- on cancel, we can expect the current medium to be undefined too, - #- this enable remounting if selecting a package back. - $current_medium = 'unknown'; - - return; -} -sub getFile { - my ($f, $method) = @_; - log::l("getFile $f:$method"); - my $rel = relGetFile($f); - do { - if ($method =~ /crypto/i) { - require crypto; - crypto::getFile($f); - } elsif ($::o->{method} eq "ftp") { - require ftp; - ftp::getFile($rel); - } elsif ($::o->{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... - my $f2 = "$postinstall_rpms/$f"; - $f2 = "/tmp/image/$rel" unless $postinstall_rpms && -e $f2; - open GETFILE, $f2 and *GETFILE; - } - } || errorOpeningFile($f); -} -sub getAndSaveFile { - my ($file, $local) = @_ == 1 ? ("Mandrake/mdkinst$_[0]", $_[0]) : @_; - local *F; open F, ">$local" or return; - local $/ = \ (16 * 1024); - my $f = ref($file) ? $file : getFile($file) or return; - local $_; - while (<$f>) { syswrite F, $_ } - 1; -} - - -#-###################################################################################### -#- Post installation RPMS from cdrom only, functions -#-###################################################################################### -sub setup_postinstall_rpms($$) { - my ($prefix, $packages) = @_; - - $postinstall_rpms and return; - $postinstall_rpms = "$prefix/usr/postinstall-rpm"; - - require pkgs; - require commands; - - log::l("postinstall rpms directory set to $postinstall_rpms"); - clean_postinstall_rpms(); #- make sure in case of previous upgrade problem. - commands::mkdir_('-p', $postinstall_rpms); - - #- 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; - } - @toCopy{@needToCopyIfRequiresSatisfied} = (); - - my @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->{mediums}{1}); - commands::cp((map { "/tmp/image/" . relGetFile(pkgs::packageFile($_)) } @toCopy), $postinstall_rpms); -} -sub clean_postinstall_rpms() { - require commands; - $postinstall_rpms and -d $postinstall_rpms and commands::rm('-rf', $postinstall_rpms); -} - - -#-###################################################################################### -#- Specific Hardware to take into account and associated rpms to install -#-###################################################################################### -sub allowNVIDIA_rpms { - my ($packages) = @_; - require pkgs; - if (pkgs::packageByName($packages, "NVIDIA_GLX")) { - #- at this point, we can allow using NVIDIA 3D acceleration packages. - my @rpms; - foreach (qw(kernel kernel-smp kernel-entreprise kernel22 kernel22-smp kernel22-secure)) { - my $p = pkgs::packageByName($packages, $_); - pkgs::packageSelectedOrInstalled($p) or next; - my $name = "NVIDIA_kernel-" . pkgs::packageVersion($p) . "-" . pkgs::packageRelease($p) . (/(-.*)/ && $1); - pkgs::packageByName($packages, $name) or return; - push @rpms, $name; - } - @rpms > 0 or return; - return [ @rpms, "NVIDIA_GLX" ]; - } -} - -#-###################################################################################### -#- Functions -#-###################################################################################### -sub kernelVersion { - my ($o) = @_; - require pkgs; - my $p = pkgs::packageByName($o->{packages}, "kernel"); - $p ||= pkgs::packageByName($o->{packages}, "kernel22"); - $p or die "I couldn't find the kernel package!"; - pkgs::packageVersion($p) . "-" . pkgs::packageRelease($p); -} - - -sub getNextStep { - my ($s) = $::o->{steps}{first}; - $s = $::o->{steps}{$s}{next} while $::o->{steps}{$s}{done} || !$::o->{steps}{$s}{reachable}; - $s; -} - -sub spawnShell { - return if $::o->{localInstall} || $::testing; - - -x "/bin/sh" or die "cannot open shell - /bin/sh doesn't exist"; - - fork and return; - - $ENV{DISPLAY} ||= ":0"; #- why not :pp - - 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 ''; - close F; - - print any::drakx_version(), "\n"; - - c::setsid(); - - ioctl(STDIN, c::TIOCSCTTY(), 0) or warn "could not set new controlling tty: $!"; - - exec {"/bin/sh"} "-/bin/sh" or log::l("exec of /bin/sh failed: $!"); -} - -sub fsck_option { - my ($o) = @_; - my $y = $o->{security} < 3 && !$::expert && "-y "; - substInFile { s/^(\s*fsckoptions="?)(-y )?/$1$y/ } "$o->{prefix}/etc/rc.d/rc.sysinit"; #- " help po, DONT REMOVE -} - -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!). - #- 65mb may be a good choice to avoid almost all problem of insuficient space left... - my $minAvailableSize = 65 * sqr(1024); - - my $n = !$::testing && getAvailableSpace_mounted($o->{prefix}) || - getAvailableSpace_raw($o->{fstab}) * 512 / 1.07; - $n - max(0.1 * $n, $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 KB"); - $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 preConfigureTimezone { - my ($o) = @_; - require timezone; - - #- can't be done in install cuz' timeconfig %post creates funny things - add2hash($o->{timezone}, { timezone::read($o->{prefix}) }) if $o->{isUpgrade}; - - $o->{timezone}{timezone} ||= timezone::bestTimezone(lang::lang2text($o->{lang})); - add2hash_($o->{timezone}, { UTC => $::expert && !grep { isFat($_) || isNT($_) } @{$o->{fstab}} }); -} - -sub setPackages { - my ($o) = @_; - - require pkgs; - if (!$o->{packages} || is_empty_hash_ref($o->{packages}{names})) { - $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}}, "kernel22" if c::kernel_version() =~ /^\Q2.2/; - push @{$o->{default_packages}}, "kernel22-secure" if $o->{security} > 3; - push @{$o->{default_packages}}, "kernel-smp" if detect_devices::hasSMP(); - push @{$o->{default_packages}}, "kernel-pcmcia-cs" if $o->{pcmcia}; - push @{$o->{default_packages}}, "raidtools" if $o->{raid} && !is_empty_array_ref($o->{raid}{raid}); - push @{$o->{default_packages}}, "lvm" if -e '/etc/lvmtab'; - push @{$o->{default_packages}}, "usbd" if modules::get_alias("usb-interface"); - push @{$o->{default_packages}}, "reiserfsprogs" if grep { isReiserfs($_) } @{$o->{fstab}}; - push @{$o->{default_packages}}, "xfsprogs" if grep { isXfs($_) } @{$o->{fstab}}; - push @{$o->{default_packages}}, "alsa", "alsa-utils" if modules::get_alias("sound-slot-0") =~ /^snd-card-/; - push @{$o->{default_packages}}, "imwheel" if $o->{mouse}{nbuttons} > 3; - - 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}); - - #- must be done after getProvides - pkgs::read_rpmsrate($o->{packages}, getFile("Mandrake/base/rpmsrate")); - ($o->{compssUsers}, $o->{compssUsersSorted}) = pkgs::readCompssUsers($o->{meta_class}); - - if ($::auto_install && !$o->{compssUsersChoice}) { - $o->{compssUsersChoice}{$_} = 1 foreach map { @{$o->{compssUsers}{$_}{flags}} } @{$o->{compssUsersSorted}}; - } - if (!$::auto_install && !$o->{isUpgrade}) { - #- by default, choose: - $o->{compssUsersChoice}{$_} = 1 foreach 'GNOME', 'KDE', 'CONFIG'; - $o->{compssUsersChoice}{$_} = 1 - foreach map { @{$o->{compssUsers}{$_}{flags}} } 'Workstation|Office Workstation', 'Workstation|Internet station'; - } - $o->{compssUsersChoice}{uc($_)} = 1 foreach grep { modules::get_that_type($_) } ('tv', 'scanner', 'photo', 'sound'); - $o->{compssUsersChoice}{uc($_)} = 1 foreach map { $_->{driver} =~ /Flag:(.*)/ } detect_devices::probeall(); - $o->{compssUsersChoice}{SYSTEM} = 1; - $o->{compssUsersChoice}{BURNER} = 1 if detect_devices::burners(); - $o->{compssUsersChoice}{DVD} = 1 if detect_devices::dvdroms(); - $o->{compssUsersChoice}{PCMCIA} = 1 if detect_devices::hasPCMCIA(); - $o->{compssUsersChoice}{'3D'} = 1 if - detect_devices::matching_desc('Matrox.* G[24]00') || - detect_devices::matching_desc('Riva.*128') || - detect_devices::matching_desc('Rage X[CL]') || - detect_devices::matching_desc('Rage Mobility (?:P\/M|L) ') || - detect_devices::matching_desc('3D Rage (?:LT|Pro)') || - detect_devices::matching_desc('Voodoo [35]') || - detect_devices::matching_desc('Voodoo Banshee') || - detect_devices::matching_desc('8281[05].* CGC') || - detect_devices::matching_desc('Rage 128') || - detect_devices::matching_desc('[nN]Vidia.*T[nN]T2') || #- TNT2 cards - detect_devices::matching_desc('[nN]Vidia.*NV[56]') || - detect_devices::matching_desc('[nN]Vidia.*Vanta') || - detect_devices::matching_desc('[nN]Vidia.*GeForce') || #- GeForce cards - detect_devices::matching_desc('[nN]Vidia.*NV1[15]') || - detect_devices::matching_desc('[nN]Vidia.*Quadro'); - - - foreach (map { substr($_, 0, 2) } lang::langs($o->{langs})) { - pkgs::packageByName($o->{packages}, "locales-$_") or next; - push @{$o->{default_packages}}, "locales-$_"; - } - foreach (lang::langsLANGUAGE($o->{langs})) { - $o->{compssUsersChoice}{qq(LOCALES"$_")} = 1; - } - } else { - #- this has to be done to make sure necessary files for urpmi are - #- present. - pkgs::psUpdateHdlistsDeps($o->{prefix}, $o->{method}); - } -} - -sub unselectMostPackages { - my ($o) = @_; - pkgs::unselectAllPackages($o->{packages}); - pkgs::selectPackage($o->{packages}, pkgs::packageByName($o->{packages}, $_) || next) foreach @{$o->{default_packages}}; -} - -sub warnAboutNaughtyServers { - my ($o) = @_; - my @naughtyServers = pkgs::naughtyServers($o->{packages}) or return 1; - if (!$o->ask_yesorno('', -formatAlaTeX(_("You have selected the following server(s): %s - - -These servers are activated by default. They don't have any known security -issues, but some new could be found. In that case, you must make sure to upgrade -as soon as possible. - - -Do you really want to install these servers? -", join(", ", @naughtyServers))), 1)) { - pkgs::unselectPackage($o->{packages}, pkgs::packageByName($o->{packages}, $_)) foreach @naughtyServers; - } -} - -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"; - require network; - 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/image") =~ m|^/tmp/hdimage/(.*)|); -} - -sub unlockCdrom(;$) { - my ($cdrom) = @_; - $cdrom or cat_("/proc/mounts") =~ m,(/(?:dev|tmp)/\S+)\s+(?:/mnt/cdrom|/tmp/image), 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,(/(?:dev|tmp)/\S+)\s+(?:/mnt/cdrom|/tmp/image), and $cdrom = $1; - my $f = eval { $cdrom && detect_devices::tryOpen($cdrom) } or return; - getFile("XXX"); #- close still opened filehandle - eval { fs::umount("/tmp/image") }; - ioctl $f, c::CDROMEJECT(), 1; -} - -sub setupFB { - my ($o, $vga) = @_; - - $vga ||= 785; #- assume at least 640x480x16. - - require bootloader; - #- update bootloader entries with vga, all kernel are now framebuffer. - foreach (qw(vmlinuz vmlinuz-secure vmlinuz-smp vmlinuz-hack)) { - if (my $e = bootloader::get("/boot/$_", $o->{bootloader})) { - $e->{vga} = $vga; - } - } - 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}; - - #- build synthesis file at install, this will improve performance greatly. - run_program::rooted($prefix, "parsehdlist", ">", "/var/lib/urpmi/synthesis.hdlist.$name", - "--compact", "--provides", "--requires", "/var/lib/urpmi/hdlist.$name.cz"); - run_program::rooted($prefix, "gzip", "-S", ".cz", "/var/lib/urpmi/synthesis.hdlist.$name"); - #- safe guard correct generation of synthesis file. - -s "$prefix/var/lib/urpmi/synthesis.hdlist.$name.cz" > 24 or unlink "$prefix/var/lib/urpmi/synthesis.hdlist.$name.cz"; - - local *LIST; - my $mask = umask 077; - open LIST, ">$prefix/var/lib/urpmi/list.$name" or log::l("failed to write list.$name"); - umask $mask; - - 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, "$ENV{LD_LOADER} parsehdlist /tmp/$_->{hdlist} |"; - chop, print LIST "$dir/$_\n" foreach ; - close FILES or log::l("parsehdlist failed"), return; - close LIST; - - $name =~ s/(\s)/\\$1/g; $dir =~ s/(\s)/\\$1/g; #- necessary to change protect white char, for urpmi >= 1.40 - $dir .= " with ../base/$_->{hdlist}"; - "$name $dir\n"; - } values %$mediums; - eval { output "$prefix/etc/urpmi/urpmi.cfg", @cfg }; -} - - -#-############################################################################### -#- kde stuff -#-############################################################################### -sub kderc_largedisplay { - my ($prefix) = @_; - - update_userkderc($_, 'KDE', - Contrast => 7, - kfmIconStyle => "Large", - kpanelIconStyle => "Normal", #- to change to Large when icons looks better - KDEIconStyle => "Large") foreach list_skels($prefix, '.kderc'); - - 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; - } - - # 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 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')) { - renamef("$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 report_bug { - my ($prefix) = @_; - - sub header { " -******************************************************************************** -* $_[0] -********************************************************************************"; - } - - join '', map { chomp; "$_\n" } - header("lspci"), detect_devices::stringlist(), - header("pci_devices"), cat_("/proc/bus/pci/devices"), - header("fdisk"), arch() =~ /ppc/ ? `$ENV{LD_LOADER} pdisk -l` : `$ENV{LD_LOADER} fdisk -l`, - header("scsi"), cat_("/proc/scsi/scsi"), - header("lsmod"), cat_("/proc/modules"), - header("cmdline"), cat_("/proc/cmdline"), - header("pcmcia: stab"), cat_("/var/run/stab"), - header("usb"), cat_("/proc/bus/usb/devices"), - header("partitions"), cat_("/proc/partitions"), - header("cpuinfo"), cat_("/proc/cpuinfo"), - header("syslog"), cat_("/tmp/syslog"), - header("ddcxinfos"), `$ENV{LD_LOADER} ddcxinfos`, - header("ddebug.log"), cat_("/tmp/ddebug.log"), - header("install.log"), cat_("$prefix/root/install.log"), - header("fstab"), cat_("$prefix/etc/fstab"), - header("auto_inst"), g_auto_install(), - ; -} - -sub g_auto_install { - my ($replay) = @_; - my $o = {}; - - require pkgs; - $o->{default_packages} = pkgs::selected_leaves($::o->{packages}); - - 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 authentication printer mouse wacom netc timezone superuser intf keyboard users partitioning isUpgrade manualFstab nomouseprobe crypto security netcnx 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} = !$replay; - local $o->{autoExitInstall} = !$replay; - - #- deep copy because we're modifying it below - $o->{users} = [ @{$o->{users} || []} ]; - - $_ = { %{$_ || {}} }, delete @$_{qw(oldu oldg password password2)} foreach $o->{superuser}, @{$o->{users} || []}; - - require Data::Dumper; - join('', -"#!/usr/bin/perl -cw -# -# You should check the syntax of this file before using it in an auto-install. You -# can do this with 'perl -cw auto_inst.cfg.pl' or by executing this file (note the -# '#!/usr/bin/perl -cw' on the first line). -", - Data::Dumper->Dump([$o], ['$o']), if_($replay, -qq(\npackage install_steps_auto_install;), q( -$graphical = 1; -push @graphical_steps, 'doPartitionDisks', 'choosePartitionsToFormat', 'formatMountPartitions'; -)), "\0"); -} - - -sub g_default_packages { - my ($o) = @_; - - my $floppy = detect_devices::floppy(); - - while (1) { - $o->ask_okcancel('', _("Insert a FAT formatted floppy in drive %s", $floppy), 1) or return; - - eval { fs::mount(devices::make($floppy), "/floppy", "vfat", 0) }; - last if !$@; - $o->ask_warn('', _("This floppy is not FAT formatted")); - } - - require Data::Dumper; - output('/floppy/auto_inst.cfg', - "# You should always check the syntax with 'perl -cw auto_inst.cfg.pl' before testing\n", - "# To use it, boot with ``linux defcfg=floppy''\n", - Data::Dumper->Dump([ { default_packages => pkgs::selected_leaves($o->{packages}) } ], ['$o']), "\0"); - fs::umount("/floppy"); - - $o->ask_warn('', _("To use this saved packages selection, boot installation with ``linux defcfg=floppy''")); -} - -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(detect_devices::floppy()), "/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_automatic_stage1_params { - my ($o) = @_; - - my $ks = "automatic="; - - if ($o->{method} =~ /hd/) { - $ks .= "method:disk,"; - } else { - $ks .= "method:" . $o->{method} . ","; - } - - if ($o->{method} =~ /http/) { - "$ENV{URLPREFIX}" =~ m|http://(.*)/(.*)| or die; - $ks .= "server:$1,directory:$2,"; - } elsif ($o->{method} =~ /ftp/) { - $ks .= "server:$ENV{HOST},directory:$ENV{PREFIX},user:$ENV{LOGIN},pass:$ENV{PASSWORD},"; - } elsif ($o->{method} =~ /nfs/) { - cat_("/proc/mounts") =~ m|(\S+):(\S+)\s+/tmp/image nfs| or die; - $ks .= "server:$1,directory:$2,"; - } - - my ($intf) = values %{$o->{intf}}; - if ($intf->{BOOTPROTO} =~ /dhcp/) { - $ks .= "network:dhcp,"; - } else { - require network; - $ks .= "network:static,ip:$intf->{IPADDR},netmask:$intf->{NETMASK},gateway:$o->{netc}{GATEWAY},"; - my @dnss = network::dnsServers($o->{netc}); - $ks .= "dns:$dnss[0]," if @dnss; - } - $ks; -} - -sub guess_mount_point { - my ($part, $prefix, $user) = @_; - - my %l = ( - '/' => 'etc/fstab', - '/boot' => 'vmlinuz', - '/tmp' => '.X11-unix', - '/usr' => 'X11R6', - '/var' => 'catman', - ); - - my $handle = any::inspect($part, $prefix) or return; - my $d = $handle->{dir}; - my ($mnt) = grep { -e "$d/$l{$_}" } keys %l; - $mnt ||= (stat("$d/.bashrc"))[4] ? '/root' : '/home/user' . ++$$user if -e "$d/.bashrc"; - $mnt ||= (grep { -d $_ && (stat($_))[4] >= 500 && -e "$_/.bashrc" } glob_("$d")) ? '/home' : ''; - ($mnt, $handle); -} - -sub suggest_mount_points { - my ($fstab, $prefix, $uniq) = @_; - - my $user; - foreach my $part (grep { isTrueFS($_) } @$fstab) { - $part->{mntpoint} && !$part->{unsafeMntpoint} and next; #- if already found via an fstab - - my ($mnt, $handle) = guess_mount_point($part, $prefix, \$user) or next; - - next if $uniq && fsedit::mntpoint2part($mnt, $fstab); - $part->{mntpoint} = $mnt; delete $part->{unsafeMntpoint}; - - #- try to find other mount points via fstab - fs::get_mntpoints_from_fstab($fstab, $handle->{dir}, $uniq) if $mnt eq '/'; - } - $_->{mntpoint} and log::l("suggest_mount_points: $_->{device} -> $_->{mntpoint}") foreach @$fstab; -} - -#- mainly for finding the root partitions for upgrade -sub find_root_parts { - my ($fstab, $prefix) = @_; - log::l("find_root_parts"); - my $user; - grep { - my ($mnt) = guess_mount_point($_, $prefix, \$user); - $mnt eq '/'; - } @$fstab; -} -sub use_root_part { - my ($fstab, $part, $prefix) = @_; - { - my $handle = any::inspect($part, $prefix) or die; - fs::get_mntpoints_from_fstab($fstab, $handle->{dir}, 'uniq'); - } - map { $_->{mntpoint} = 'swap' } grep { isSwap($_) } @$fstab; #- use all available swap. -} - -sub getHds { - my ($o, $f_err) = @_; - my $ok = 1; - my $try_scsi = !$::expert; - my $flags = $o->{partitioning}; - - my @drives = detect_devices::hds(); -# add2hash_($o->{partitioning}, { readonly => 1 }) if partition_table_raw::typeOfMBR($drives[0]{device}) eq 'system_commander'; - - getHds: - my ($hds, $lvms) = catch_cdie { fsedit::hds(\@drives, $flags) } - sub { - $ok = 0; - my $err = $@; $err =~ s/ at (.*?)$//; - log::l("error reading partition table: $err"); - !$flags->{readonly} && $f_err and $f_err->($err); - }; - - if (is_empty_array_ref($hds) && $try_scsi) { - $try_scsi = 0; - $o->setupSCSI; #- ask for an unautodetected scsi card - goto getHds; - } - $::testing or partition_table_raw::test_for_bad_drives($_) foreach @$hds; - - $ok = fsedit::verifyHds($hds, $flags->{readonly}, $ok) - unless $flags->{clearall} || $flags->{clear}; - - #- try to figure out if the same number of hds is available, use them if ok. - $ok && $hds && @$hds > 0 && @{$o->{hds} || []} == @$hds and return $ok; - - $o->{hds} = $hds; - $o->{lvms} = $lvms; - $o->{fstab} = [ fsedit::get_fstab(@$hds, @$lvms) ]; - fs::check_mounted($o->{fstab}); - fs::merge_fstabs($o->{fstab}, $o->{manualFstab}); - - my @win = grep { isFat($_) && isFat({ type => fsedit::typeOfPart($_->{device}) }) } @{$o->{fstab}}; - log::l("win parts: ", join ",", map { $_->{device} } @win) if @win; - if (@win == 1) { - $win[0]{mntpoint} = "/mnt/windows"; - } else { - my %w; foreach (@win) { - my $v = $w{$_->{device_windobe}}++; - $_->{mntpoint} = $_->{unsafeMntpoint} = "/mnt/win_" . lc($_->{device_windobe}) . ($v ? $v+1 : ''); #- lc cuz of StartOffice(!) cf dadou - } - } - - my @sunos = grep { isSunOS($_) && type2name($_->{type}) =~ /root/i } @{$o->{fstab}}; #- take only into account root partitions. - if (@sunos) { - my $v = ''; - map { $_->{mntpoint} = $_->{unsafeMntpoint} = "/mnt/sunos" . ($v && ++$v) } @sunos; - } - #- a good job is to mount SunOS root partition, and to use mount point described here in /etc/vfstab. - - $ok; -} - -sub log_sizes { - my ($o) = @_; - my @df = common::df($o->{prefix}); - log::l(sprintf "Installed: %s(df), %s(rpm)", - formatXiB($df[0] - $df[1], 1024), - formatXiB(sum(`$ENV{LD_LOADER} rpm --root $o->{prefix}/ -qa --queryformat "%{size}\n"`))) if -x "$o->{prefix}/bin/rpm"; -} - -sub copy_advertising { - my ($o) = @_; - - return if $::rootwidth < 800; - - my $f; - my $source_dir = "Mandrake/share/advertising"; - foreach ("." . $o->{lang}, "." . substr($o->{lang},0,2), '') { - $f = getFile("$source_dir$_/list") or next; - $source_dir = "$source_dir$_"; - } - if (my @files = <$f>) { - my $dir = "$o->{prefix}/tmp/drakx-images"; - mkdir $dir; - unlink glob_("$dir/*"); - foreach (@files) { - chomp; - getAndSaveFile("$source_dir/$_", "$dir/$_"); - } - @advertising_images = map { "$dir/$_" } @files; - } -} -sub remove_advertising { - my ($o) = @_; - unlink @advertising_images; - rmdir "$o->{prefix}/tmp/drakx-images"; - @advertising_images = (); -} - -sub disable_user_view { - my ($prefix) = @_; - substInFile { s/^UserView=.*/UserView=true/ } "$prefix/usr/share/config/kdmrc"; - substInFile { s/^Browser=.*/Browser=0/ } "$prefix/etc/X11/gdm/gdm.conf"; -} - -sub write_fstab { - my ($o) = @_; - fs::write($o->{prefix}, $o->{fstab}, $o->{manualFstab}, $o->{useSupermount}, lang::fs_options($o->{lang})) - if !$::live; -} - -my @bigseldom_used_groups = ( - [ qw(pvcreate pvdisplay vgchange vgcreate vgdisplay vgextend vgremove vgscan lvcreate lvdisplay lvremove /lib/liblvm.so) ], -); - -sub check_prog { - my ($f) = @_; - - my @l = $f !~ m|^/| ? - map { "$_/$f" } split(":", $ENV{PATH}) : - $f; - return if grep { -x $_ } @l; - - my ($f_) = map { m|^/| ? $_ : "/usr/bin/$_" } $f; - remove_bigseldom_used(); - foreach (@bigseldom_used_groups) { - my (@l) = map { m|^/| ? $_ : "/usr/bin/$_" } @$_; - if (member($f_, @l)) { - foreach (@l) { - getAndSaveFile($_); - chmod 0755, $_; - } - return; - } - } - getAndSaveFile($f_); - chmod 0755, $f_; -} - -sub remove_bigseldom_used { - log::l("remove_bigseldom_used"); - $::testing and return; - unlink glob_("/usr/share/gtk/themes/$_*") foreach qw(DarkMarble marble3d); - if (ref($::o) =~ /gtk/) { - unlink glob_("/lib/lib$_*") foreach qw(slang newt); - unlink "/usr/bin/perl-install/auto/Newt/Newt.so"; - } else { - unlink glob_("/usr/X11R6/bin/XF*"); - } - unlink(m|^/| ? $_ : "/usr/bin/$_") foreach - ((map { @$_ } @bigseldom_used_groups), - qw(mkreiserfs resize_reiserfs), - ); -} - -1; -- cgit v1.2.1