perl-install/harddrake/autoconf.pm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86

package harddrake::autoconf;

use common;

sub xconf {
    my ($modules_conf, $o) = @_;

    log::l('automatic XFree configuration');
    
    require Xconfig::default;
    require do_pkgs;
    my $do_pkgs = do_pkgs_standalone->new;
    $o->{raw_X} = Xconfig::default::configure($do_pkgs);
    
    require Xconfig::main;
    Xconfig::main::configure_everything_auto_install($o->{raw_X}, $do_pkgs, {}, { allowFB => 1 });

    #- always disable compositing desktop effects when configuring a new video card
    require Xconfig::glx;
    Xconfig::glx::write({});

    modules::load_category($modules_conf, 'various/agpgart'); 
}

sub network_conf {
    my ($obj) = @_;
    require network::network;
    network::network::easy_dhcp($obj->{net}, $obj->{modules_conf});
}

sub mouse_conf {
    my ($modules_conf) = @_;
    require do_pkgs;
    require mouse;
    mouse::write_conf(do_pkgs_standalone->new, $modules_conf, my $mouse = mouse::detect($modules_conf), 1);
    mouse::load_modules($mouse);
}

sub pcmcia {
    my ($pcic) = @_;
    require modules;
    modules::set_preload_modules("pcmcia", if_($pcic, $pcic));
}

sub bluetooth {
    my ($enable) = @_;
#- FIXME: make sure these packages are installed when needed
#     if ($enable) {
#         require do_pkgs;
#         my $do_pkgs = do_pkgs_standalone->new;
#         $do_pkgs->ensure_is_installed("bluez-utils", "/usr/bin/rfcomm");
#     }
    require services;
    services::set_status("bluetooth", $enable);
    my $kbluetoothd_cfg = '/etc/kde/kbluetoothdrc';
    update_gnomekderc($kbluetoothd_cfg,
                      'General',
                      'AutoStart' => bool2text($enable)) if -f $kbluetoothd_cfg;
}

sub laptop {
    my ($on_laptop) = @_;
#- FIXME: make sure these packages are installed when needed
#     require do_pkgs;
#     my $do_pkgs = do_pkgs_standalone->new;
#     if ($on_laptop) {
#         $do_pkgs->ensure_is_installed("cpufreq", "/etc/rc.d/init.d/cpufreq");
#         $do_pkgs->ensure_is_installed("apmd", "/usr/bin/apm");
#         $do_pkgs->ensure_is_installed("hotkeys", "/usr/bin/hotkeys");
#         $do_pkgs->ensure_is_installed("laptop-mode-tools", "/usr/sbin/laptop_mode");
#     } else {
#         $do_pkgs->ensure_is_installed("numlock", "/etc/rc.d/init.d/numlock");
#     }
    require services;
    services::set_status("cpufreq", $on_laptop);
    services::set_status("apmd", $on_laptop);
    services::set_status("laptop-mode", $on_laptop);
    services::set_status("numlock", !$on_laptop);
}

sub cpufreq() {
    require cpufreq;
    modules::set_preload_modules("cpufreq", cpufreq::get_modules());
}

1;
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 MDK::Common::System;
use common;
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: $!";

    my $busybox = "/usr/bin/busybox";
    exec {-e $busybox ? $busybox : "/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) = MDK::Common::System::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}));

    my $utc = $::expert && !grep { isFat($_) || isNT($_) } @{$o->{fstab}};
    my $ntp = timezone::ntp_server($o->{prefix});
    add2hash_($o->{timezone}, { UTC => $utc, ntp => $ntp });
}

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}}, "kernel-enterprise" if (availableRamMB() > 800) && (arch() !~ /ia64/);
	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 !is_empty_array_ref($o->{all_hds}{raids});
	push @{$o->{default_packages}}, "lvm" if !is_empty_array_ref($o->{all_hds}{lvms});
	push @{$o->{default_packages}}, "usbd" if modules::get_alias("usb-interface");
	push @{$o->{default_packages}}, "reiserfsprogs" if grep { isThisFs("reiserfs", $_) } @{$o->{fstab}};
	push @{$o->{default_packages}}, "xfsprogs" if grep { isThisFs("xfs", $_) } @{$o->{fstab}};
	push @{$o->{default_packages}}, "jfsprogs" if grep { isThisFs("jfs", $_) } @{$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->{interactive} && !$o->{compssUsersChoice}) {
	    $o->{compssUsersChoice}{$_} = 1 foreach map { @{$o->{compssUsers}{$_}{flags}} } @{$o->{compssUsersSorted}};
	}
	if ($o->{interactive} && !$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}{X} = 1 if $o->{interactive};
	$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][05]0') ||
	    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, $ldap, $nis) = @{$o->{authentication} || {}}{qw(shadow md5 LDAP NIS)};
    my $p = $o->{prefix};
    #- obsoleted always enabled (in /etc/pam.d/system-auth furthermore) #any::enableMD5Shadow($p, $shadow, $md5);
    any::enableShadow($p) if $shadow;
    if ($ldap) {
	$o->pkg_install(qw(chkauth openldap-clients nss_ldap pam_ldap));
	run_program::rooted($o->{prefix}, "/usr/sbin/chkauth", "ldap", "-D", $o->{netc}{LDAPDOMAIN}, "-s", $ldap);
    } elsif ($nis) {
	#$o->pkg_install(qw(chkauth ypbind yp-tools net-tools));
	#run_program::rooted($o->{prefix}, "/usr/sbin/chkauth", "yp", $domain, "-s", $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 = chomp_(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) = @_;
    getFile("XXX"); #- close still opened filehandle
    $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;
    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->{all_hds}{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} |";
	print LIST "$dir/$_\n" foreach chomp_(<FILES>);
	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_gnomekderc($_, '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) = @_;
    any::report_bug($prefix, 'auto_inst' => g_auto_install());
}

sub g_auto_install {