#!/usr/bin/perl

if (shift(@ARGV) ne '-f') {
    print "Call it with option -f, but don't fear loosing all your data, this command is dangerous!";
    print "
usage: /etc/oem -f [options]
where [options] are:
    server                          : allow server installalation
    boot_entries=entry1,...,entryN  : set boot entries to use,
                                      the first one is the default one
    no<option>                      : disable options <option>
";
    exit 1;
}
my (%options, $yes, $hd, $cd);

#- avoid globing as it is not available in rescue ramdisk.
foreach my $device (split ' ', `/bin/ls -d /proc/ide/hd*`) {
    open F, "$device/media" or next;
    foreach (<F>) {
	/disk/  and do { $hd ||= $device; $hd =~ s,/proc/ide/,,; };
	/cdrom/ and do { $cd ||= $device; $cd =~ s,/proc/ide/,,; };
    }
    close F;
}
#- examine available SCSI devices (avoid SCSI floppies like LS-120 or ZIP disk or generic floppies).
eval {
    system "/usr/bin/drvinst"; #- load scsi drivers else it wont do anything.

    my ($driveNum, $cdromNum) = (0, 0);
    open F, "/proc/scsi/scsi" or die "no scsi available";
    local $_ = <F>; /^Attached devices:/ or die "to attached devices found";
    while ($_ = <F>) {
	my ($id) = /^Host:.*?Id: (\d+)/ or die "no host found";
	$_ = <F>; my ($vendor, $model) = /^\s*Vendor:\s*(.*?)\s+Model:\s*(.*?)\s+Rev:/ or die "no vendor nor model found";
	$_ = <F>; my ($type) = /^\s*Type:\s*(.*)/;
	if ($type =~ /Direct-Access/ && $model !~ /ZIP\s+\d+|LS-?120|144MB|[Ff]loppy/) {
	    $hd ||= "sd" . chr($driveNum++ + ord('a'));
	} elsif ($type =~ /CD-ROM/) {
	    $cd ||= "scd" . $cdromNum++;
	}
    }
};
-e "/dev/$hd" or die "unable to access hard disk";
print "hd: $hd\ncd: $cd\n";

#- try to free any reference to hard disk which will be used (as in rescue mode it has already loaded
#- existing partition in /mnt.
open F, "/proc/mounts";
while (<F>) {
    /$hd(\d*)\s+(\S+)/ and $already_mounted{$2} = "$hd$1";
}
foreach (sort { $b cmp $a } keys %already_mounted) {
    print "umounting $already_mounted{$_} from $_\n"; 
    system "umount", $_;
}
    
#- find a cdrom (like) image, normally a true cdrom but if nfs install is running, use it instead.
mkdir "/cdrom";
open F, "/proc/cmdline";
while (<F>) {
    /automatic=method:nfs,.*server:([^\s,]*),.*directory:([^\s,]*)/
      and system "mount", "-r", "-t", "nfs", "$1:$2", "/cdrom", "-o", "nolock";
}
close F;
unless (-e "/cdrom/VERSION") {
    -e "/dev/$cd" or die "unable to access local cdrom";
    system "mount", "-r", "-t", "iso9660", "/dev/$cd", "/cdrom";
}

#- detect language used and default options.
my ($lang, $flang);
open F, "/cdrom/VERSION" or die "no installation cdrom found on $cd";
while (<F>) {
    /[\s-]fr/ and ($lang, $flang) = ('fr', 'fr_FR@euro');
    /\[server\]/ and $options{server} = '';
    /\[boot_entries[=:]([^]]*)\]/ and $options{boot_entries} = $1;
}
close F;
foreach (@ARGV) { /^([^=:]*)[=:]?(.*)/ and $options{$1} = $2; /^no([^=:]*)/ and delete $options{$1} }

#- default language fall to english ?
$lang or ($lang, $flang) = ("en", "en_US");
print "Found lang $lang\n";
foreach (keys %options) {
    print "Using option [$_" . ($options{$_} && "=$options{$_}") . "]\n";
}

#- check for already existing partition table, if none are found
#- create 3 partitions (one for install, one for swap and one for root).
#- if only a fat partition is found, resize it do include the above partition.
#- other combination are really dangerous and are not supported, ask
#- the user that all data on the disk will be erased and go on.
my ($heads, $sectors, $cylinders, $hd_size, @hd_parts);
sub correct_start_end {
    my ($rstart, $end, $keep_start) = @_;
    my ($cylinder_size, $c_start, $c_end) = ($sectors*$heads*512/1024/1024, undef, undef);
    if (abs($cylinder_size*$cylinders-$hd_size)/$hd_size < 0.01) {
	$c_start = $$rstart+($keep_start ? 0 : $cylinder_size/$heads);
	$c_end = $cylinder_size*int(1/2+$end/$cylinder_size);
	$c_end > $hd_size and $c_end = $hd_size;
	$$rstart = $c_end;
    } else {
	$c_start = $$rstart;
	$c_end = $end;
	$c_end > $hd_size and $c_end = $hd_size;
	$$rstart = $c_end+5; #- fall back to use a problable safe method.
    }
    $c_start >= $c_end and die "no space left for partitionning\n";
    ($c_start, $c_end);
}
open F, "fdisk -l /dev/$hd |";
while (<F>) {
    /(\d+)\s*heads/ and $heads = $1;
    /(\d+)\s*sectors/ and $sectors = $1;
    /(\d+)\s*cylinders/ and $cylinders = $1;
}
close F;
for (1..2) {
    open F, "parted /dev/$hd -s print |";
    while (<F>) {
	/^Disk geometry [^:]*:\s*([\d\.]+)-([\d\.]+)/ and do { $hd_size = $2 - $1 };
	#/^Disk label type:\s*msdos/ and do { $hd_type = 'msdos' };
	/^(\d+)\s+([\d\.]+)\s+([\d\.]+)\s+(primary|logical|extended)\s*(\S*)/ and do {
	    #- this automatically drops extended partition here!
	    push @hd_parts, { minor => $1, start => $2, end => $3, type => $4, fstype => $5 };
	};
    }
    close F;
    $hd_size and last;
    print "Unable to detect partition on disk, trying with new label\n";
    do {
	print "

I'm going to install the OEM version on your hard drive
!!ALL DATA WILL BE LOST!!

Type \`\`yes'' and [enter] to go on\n"
    } while (($yes = <STDIN>) !~ /^\s*yes\s*$/i);
    system "parted", "/dev/$hd", "mklabel", "msdos";
}
my ($min_size, $def_size, $trigger_size, $inst_size, $swap_size) = (2100, 2700, 4000, 200, 128);
$hd_size > $min_size or die "hard disk is too small to contain oem install (${hd_size}MB found, need $min_size at least)";

my ($fat_pos, $resize_fat_size, $root_size);
if (@hd_parts == 1 && $hd_parts[$fat_pos = 0]{fstype} eq 'FAT' ||
    @hd_parts == 2 && $hd_parts[0]{type} eq 'primary' && $hd_parts[$fat_pos = 1]{fstype} eq 'FAT' ||
    @hd_parts == 3 && $hd_parts[0]{type} eq 'primary' && $hd_parts[1]{type} eq 'primary' && $hd_parts[$fat_pos = 2]{fstype} eq 'FAT' ||
    @hd_parts == 2 && $hd_parts[0]{type} eq 'extended' && $hd_parts[$fat_pos = 1]{fstype} eq 'FAT' ||
    @hd_parts == 3 && $hd_parts[0]{type} eq 'extended' && $hd_parts[1]{type} eq 'primary' && $hd_parts[$fat_pos = 5]{fstype} eq 'FAT') {
    if ($hd_size - $hd_parts[$fat_pos]{end} > $min_size) {
	#- check first if there are some available space left on the disk.
	#- so we are using it, root_size is fixed to match hard disk size.
	$resize_fat_size = 0;
	$root_size = $hd_size - $hd_parts[$fat_pos]{end} - $inst_size - $swap_size;
	$root_size > $trigger_size and $root_size = $def_size;
    } elsif ($hd_size > 2*$min_size) {
	#- resize this fat partition.
	$resize_fat_size = 0.5 * $hd_size;
	$root_size = $hd_size - $resize_fat_size - $inst_size - $swap_size;
	$root_size > $trigger_size and $root_size = $def_size;
    }
}
unless ($root_size) {
    #- there have not been defined above, so remove everything and start from
    #- a blank partition.
    $resize_fat_size = undef;
    $root_size = $hd_size - $resize_fat_size - $inst_size - $swap_size;
    $root_size > $trigger_size and $root_size = $def_size;
}

#- launch parted to edit partition table, start at minor.
#- point define where we start.
my $minor = defined $resize_fat_size && $hd_parts[0]{type} eq 'extended' ? 6 : 5;
my $point = 0.0;

if (defined $resize_fat_size) {
    do {
	print "

!!An existing Windows partition has been found and will be kept.
Additional Linux partitions will be created!!

Type \`\`yes'' and [enter] to go on\n"
    } while (($yes = <STDIN>) !~ /^\s*yes\s*$/i);
    #- keep the current partition table, and try to resize the fat partition
    #- if the size is not 0.
    #- KEEP IN MIND there is only one partition defined.
    open F, "| parted -s /dev/$hd";
    if ($resize_fat_size) {
	$point = $hd_parts[$fat_pos]{start};
	printf F "resize %d %s %s\n", $hd_parts[$fat_pos]{minor}, correct_start_end(\$point, $point+$resize_fat_size, 'keepstart');
    } else {
	$point = $hd_parts[$fat_pos]{end};
    }
    $point+=9; #- keep blank space between partitions if parted cannot handle partition table correctly.
} else {
    unless (defined $yes) {
	do {
	    print "

I'm going to install the OEM version on your hard drive
!!ALL DATA WILL BE LOST!!

Type \`\`yes'' and [enter] to go on\n"
        } while (($yes = <STDIN>) !~ /^\s*yes\s*$/i);
    }
    #- build a new disk label here.
    open F, "| parted -s /dev/$hd";
    print F "mklabel msdos\n";
}

#- at this point, the partition are created.
my ($instz, $inst, $swap, $root, $var, $home) = ($minor-1, $minor, $minor+1, $minor+2, undef, undef);

#- all linux partition are stored inside an extended partition, this is easier to manipulate after.
if ($minor == 5) {
    print F "mkpart extended $point $hd_size\n";
} else {
    $hd_parts[0]{type} eq 'extended' or die "first partition assumed to be extended";
    $point = $hd_parts[0]{start};
    print F "resize $hd_parts[0]{minor} $point $hd_size\n";
}
printf F "mkpart logical ext2 %s %s\n", correct_start_end(\$point, $point+$inst_size);
printf F "mkpart logical linux-swap %s %s\n", correct_start_end(\$point, $point+$swap_size);
printf F "mkpart logical ext2 %s %s\n", correct_start_end(\$point, $point+$root_size);
if (exists $options{server}) {
    my $var_size = ($hd_size - $point) / 2;
    if ($var_size > 1500) {
	$var = $root+1;
	printf F "mkpart logical ext2 %s %s\n", correct_start_end(\$point, $point+$var_size);
    }
}
if ($hd_size - $point > 100) {
    $home = ($var || $root) + 1;
    printf F "mkpart logical ext2 %s %s\n", correct_start_end(\$point, $hd_size);
}
print F "quit\n";
close F or die "unable to partition the disk $hd";

#- we have to build swap and mount it.
print "Setting swap\n";
system "mkswap", "/dev/$hd$swap";
system "swapon", "/dev/$hd$swap";

#- we have 
print "Formatting /dev/$hd$inst partition\n";
system "mkfs.ext2", "/dev/$hd$inst";
print "Formatting /dev/$hd$root partition\n";
system "mkfs.ext2", "/dev/$hd$root";
if ($var) {
    print "Formatting /dev/$hd$var partition\n";
    system "mkfs.ext2", "/dev/$hd$var";
}
if ($home) {
    print "Formatting /dev/$hd$home partition\n";
    system "mkfs.ext2", "/dev/$hd$home";
}

print "Mounting partitions\n";
mkdir "/hd";
system "mount", "-t", "ext2", "/dev/$hd$inst", "/hd";
mkdir "/mnt";
system "mount", "-t", "ext2", "/dev/$hd$root", "/mnt";
if ($var) {
    mkdir "/mnt/var";
    system "mount", "-t", "ext2", "/dev/$hd$var", "/mnt/var";
}
if ($home) {
    mkdir "/mnt/home";
    system "mount", "-t", "ext2", "/dev/$hd$home", "/mnt/home";
}

print "Copying installation on hard drive\n";
if (-e "/boot/vmlinuz" && -e "/boot/hd.rdz" || -e "/cdrom/boot/vmlinuz" && -e "/cdrom/boot/hd.rdz") {
    system "cp", "-a", "/boot", "/cdrom/boot", "/hd";
} else {
    mkdir "/hd/boot";
    unless (-e "/tmp/hd/vmlinuz" && -e "/tmp/hd/hd.rdz") {
	system "cp", "/cdrom/images/hd.img", "/hd/hd.img";
	mkdir "/tmp/hd";
	system "modprobe", "loop";
	system "mount", "/hd/hd.img", "/tmp/hd", "-o", "loop";
    }
    system "cp", "-a", "/tmp/hd/vmlinuz", "/tmp/hd/hd.rdz", "/hd/boot";
}

mkdir "/hd/Mandrake";
mkdir "/hd/Mandrake/RPMS";
system "cp", "-a", "/cdrom/VERSION", "/hd";
system "cp", "-a", "/cdrom/Mandrake/base", "/cdrom/Mandrake/mdkinst", "/hd/Mandrake";

if (open F, ">/hd/Mandrake/oem_patch.pl") {
    print "Setting OEM specific extension to DrakX\n";
    if (exists $options{server}) {
	print F q{
	    use install_steps;
	    package install_steps;
	    undef *choosePackages;
	    *choosePackages = sub {
		my ($o, $packages, $compssUsers, $first_time) = @_;

		#- make sure we kept some space left for available else the system may
		#- not be able to start (xfs at least).
		my $available = install_any::getAvailableSpace($o);
		my $availableCorrected = pkgs::invCorrectSize($available / sqr(1024)) * sqr(1024);

		#- avoid destroying user selection of packages but only
		#- for expert, as they may have done individual selection before.
	        install_any::unselectMostPackages($o);

		#- use specific OEM packages selection, go to level 5
		#- and disable some extension.
		$o->{compssUsersChoice}{$_} = 0 foreach 'GNOME';
		$o->{compssUsersChoice}{$_} = 0 
		    foreach map { @{$o->{compssUsers}{$_}{flags}} } 'Workstation|Office Workstation', 'Workstation|Internet station';
		$o->{compssListLevel} = 5;
	        pkgs::setSelectedFromCompssList($packages, $o->{compssUsersChoice}, $o->{compssListLevel}, $availableCorrected);

		$availableCorrected;
	    };
	};
    } else {
	print F q{
	    use install_steps;
	    package install_steps;
	    undef *choosePackages;
	    *choosePackages = sub {
		my ($o, $packages, $compssUsers, $first_time) = @_;

		#- make sure we kept some space left for available else the system may
		#- not be able to start (xfs at least).
		my $available = install_any::getAvailableSpace($o);
		my $availableCorrected = pkgs::invCorrectSize($available / sqr(1024)) * sqr(1024);

		#- avoid destroying user selection of packages but only
		#- for expert, as they may have done individual selection before.
	        install_any::unselectMostPackages($o);

		#- use specific OEM packages selection, go to level 4.
		#- and select at least GAMES group, everything else has
		#- already be selected during master preparation.
		$o->{compssListLevel} = 4;
		$o->{compssUsersChoice}{GAMES} = 1;
	        pkgs::setSelectedFromCompssList($packages, $o->{compssUsersChoice}, $o->{compssListLevel}, $availableCorrected);

		$availableCorrected;
	    };
	};
    }
    if ($options{boot_entries}) {
	print "Setting OEM specific extension for boot entries\n";
	print F q{
	    my $sorted_entries = q(} . $options{boot_entries} . q{); #- insert boot_entries options here as string q(...).
	    my $old_setupBootloaderBefore = \&setupBootloaderBefore;
	    undef *setupBootloaderBefore;
	    *setupBootloaderBefore = sub {
		$old_setupBootloaderBefore->(@_);
		my @entries = split ',', $sorted_entries;
		my @result_entries;
		foreach my $p (@entries) {
		    foreach (@{$_[0]{bootloader}{entries}}) {
			$_->{label} eq $p and push @result_entries, $_;
		    }
		}
		if (@result_entries) {
		    $_[0]{bootloader}{entries} = \@result_entries;
		    $_[0]{bootloader}{default} = $result_entries[0]{label}; #- first image is default.
		}
	    };
	};
    }
    close F;
}

print "Setting bootloader\n";
mkdir "/hd/boot/grub";
foreach (1..2) {
    -e "/hd/boot/grub/stage$_" or system "cp", "-a", "/boot/grub/stage$_", "/hd/boot/grub";
}
open F, ">/hd/boot/grub/menu.lst";
if (defined $resize_fat_size) {
    print F "timeout 5\n";
    print F "color black/cyan yellow/cyan\n\n";
    print F "title linux\n";
} else {
    print F "timeout 0\n\n";
    print F "title oem\n";
}
print F "kernel (hd0,$instz)/boot/vmlinuz ramdisk_size=32000 automatic=method:disk,disk:$hd,partition:$hd$inst,directory:/ hd vga=788 fbeginner flang=$flang oem defcfg=/tmp/hdimage/Mandrake/oem_patch.pl\n";
print F "initrd (hd0,$instz)/boot/hd.rdz\n";
#- if a windows partition is available, add an entrie for it.
if (defined $resize_fat_size) {
    print F "\ntitle windows\n";
    printf F "rootnoverify (hd0,%s)\n", $hd_parts[$fat_pos]{minor}-1;
    print F "makeactive\n";
    print F "chainloader +1\n";
}
close F;
open F, "| grub --device-map=/hd/boot/grub/device.map --batch";
print F "install (hd0,$instz)/boot/grub/stage1 d (hd0) (hd0,$instz)/boot/grub/stage2 p (hd0,$instz)/boot/grub/menu.lst\n";
print F "quit\n";
close F or die "error while executing grub";

my $packages = select_packages("/cdrom", $lang);

my @media;
open F, "/cdrom/Mandrake/base/hdlists";
foreach (<F>) {
    chomp;
    s/\s*#.*$//;
    /^\s*$/ and next;
    m/^\s*(hdlist\S*\.cz2?)\s+(\S+)\s*(.*)$/ or die "invalid hdlist description \"$_\" in hdlists file";

    push @media, { rpmsdir => $2, descr => $3 };
}
close F;

#- initialize installation.
$ENV{DURING_INSTALL} = 1;
$ENV{RPM_INSTALL_LANG} = "$flang:$lang";
$ENV{LD_LIBRARY_PATH} = "/usr/X11R6/lib";
$ENV{SECURE_LEVEL} = 2;
foreach (qw(/etc /etc/sysconfig /etc/rpm /var /var/lib /var/lib/rpm /proc)) {
    mkdir "/mnt/$_";
}
system "mount", "-t", "proc", "proc", "/mnt/proc";
open F, ">/mnt/etc/fstab";
print F "/dev/$hd$root / ext2 defaults 1 1\n";
if ($var) {
    print F "/dev/$hd$var /var ext2 defaults 1 2\n";
}
if ($home) {
    print F "/dev/$hd$home /home ext2 defaults 1 2\n";
}
close F;
open F, ">/mnt/etc/sysconfig/i18n";
print F "LANG=$lang\n";
print F "LANGUAGE=$flang:$lang\n";
print F "LC_MESSAGES=$flang\n";
close F;
open F, ">/mnt/etc/rpm/macros";
print F "%_install_langs $flang:$lang\n";
close F;
system "rpm", "--root", "/mnt", "--initdb";

#- hack for rpm bug, copy environment of rpm before an throw install from that.
#system "tar cvf - /lib/l* /usr/lib/librpm* /bin/rpm /usr/bin/rpm* /usr/lib/rpm/* | tar xvf - -C /mnt";

#- copy and install from each cd image.
foreach my $medium (@media) {
    while ($cd && ! -d "/cdrom/$medium->{rpmsdir}") {
	system "unmount", "/dev/$cd";
	system "eject", "/dev/$cd";
	print "Please insert the cdrom labeled \"$medium->{descr}\"\n  and press [enter] when done\n";
	$yes = <STDIN>;
	system "mount", "-r", "-t", "iso9660", "/dev/$cd", "/cdrom";
    }

    print "Copying packages from medium labeled \"$medium->{descr}\" to hard disk\n";
    system "mkdir", "-p", "/hd/$medium->{rpmsdir}";
    foreach my $pkg (@{$packages->{depslist}}) {
	$pkg->{closure} && !$pkg->{selected} or next;
	my $file = "/cdrom/$medium->{rpmsdir}/" . rpm_filename($pkg);
	if (-e $file) {
	    print "  copying $pkg->{name}.$_.rpm\n";
	    system "cp", "-a", $file, "/hd/$medium->{rpmsdir}";
	    delete $pkg->{closure};
	}
    }

    print "Installing packages from medium labeled \"$medium->{descr}\"\n";
    if (my $pkg = pkgs::packageByName($packages, 'glibc')) { #- HACK FOR GLIBC
	if (delete $pkg->{selected}) {
	    my $file = "/cdrom/$medium->{rpmsdir}/" . rpm_filename($pkg);
	    if (-e $file) {
		system "rpm", "-ivh", "--root", "/mnt", "--nodeps", "--force", "--noscripts", $file;
		#system "cp", $file, "/mnt";
		#system "chroot", "/mnt", "rpm", "--nodeps", "--force", "--noscripts", "-ivh", rpm_filename($pkg);
		#system "rm", ("/mnt" . rpm_filename($pkg));
	    }
	}
    } else {
	die "no glibc package found";
    }
    my @files;
    foreach my $pkg (@{$packages->{depslist}}) {
	$pkg->{selected} or next;
	my $file = "/cdrom/$medium->{rpmsdir}/" . rpm_filename($pkg);
	if (-e $file) {
	    push @files, $file;
	    delete $pkg->{selected};
	}
    }
    system "rpm", "-ivh", "--root", "/mnt", "--nodeps", "--force", @files;
    print "Installed " . scalar(@files) . " packages\n";

    scalar(grep { $_->{selected} || $_->{closure} } @{$packages->{depslist}}) == 0 and last;
}

#- try to figure out if a oem-message-graphic already exists.
#- if this is the case, rename it to /mnt/boot/message-graphic
if (-e "/cdrom/Mandrake/base/oem-message-graphic") {
    print "Using specific oem graphic image\n";
    if (-e "/mnt/boot/message-graphic") {
	rename "/mnt/boot/message-graphic", "/mnt/boot/message-graphic.old";
	system "cp", "-a", "/cdrom/Mandrake/base/oem-message-graphic", "/mnt/boot/message-graphic";
    } elsif (-e "/mnt/boot/lilo-graphic/message") {
	rename "/mnt/boot/lilo-graphic/message", "/mnt/boot/lilo-graphic/message.old";
	system "cp", "-a", "/cdrom/Mandrake/base/oem-message-graphic", "/mnt/boot/lilo-graphic/message";
    }
}

system "umount", "/mnt/proc";
system "umount", "-a", "-f", "-t", "noproc";
$cd and system "eject", "/dev/$cd";

print "
Done. OEM hard drive ready!
The hard drive is now ready for a customer.
System is now halted.\n\n";

system "halt";

#- provide package fullname that have to be installed and copied.
sub select_packages {
    my ($dir, $lang) = @_;
    my $o = { packages => read_depslist("$dir/Mandrake/base/depslist.ordered") };

    #- DO NOT FORGET TO UPDATE HERE ACCORDING TO gi/perl-install/install_any.pm
    my @pkgs = qw(XFree86 XFree86-server XFree86-glide-module Device3Dfx Glide_V3-DRI Glide_V5 Mesa
		  dhcpcd pump dhcpxd dhcp-client isdn-light isdn4net isdn4k-utils dev pptp-adsl rp-pppoe ppp ypbind
		  autologin
		  foomatic printer-utils printer-testpages gimpprint rlpr samba-client ncpfs nc
		  cups xpp qtcups kups cups-drivers lpr LPRng pdq ImageMagick

		  kernel-pcmcia-cs apmd cdrecord rio500 grio500
                 );
    push @pkgs, "XFree86-$_" foreach qw(3DLabs 3dfx 8514 AGX FBDev I128 Mach8 Mach32 Mach64 Mono P9000 Rage128 S3 S3V SVGA VGA16 W32);
    foreach (@pkgs) {
	my $pkg = pkgs::packageByName($o->{packages}, $_);
	$pkg and pkgs::selectPackage($o->{packages}, $pkg);
    }
    foreach my $pkg (@{$o->{packages}{depslist}}) {
	$pkg->{name} =~ /NVIDIA/ and pkgs::selectPackage($o->{packages}, $pkg);
    }
    foreach my $pkg (@{$o->{packages}{depslist}}) {
	delete $pkg->{selected} and $pkg->{closure} = 1;
    }
    foreach (qw(Mesa-common xpp libqtcups2 qtcups kups)) {
	my $pkg = pkgs::packageByName($o->{packages}, $_);
	$pkg and $pkg->{closure} = 1;
    }

    #- act as DrakX will do to select packages.
    pkgs::selectPackage($o->{packages}, pkgs::packageByName($o->{packages}, 'basesystem') || die "no basesystem package found");
    pkgs::read_rpmsrate($o->{packages}, install_any::getFile("Mandrake/base/rpmsrate") || die "unable to read rpmsrate");
    ($o->{compssUsers}, $o->{compssUsersSorted}, $o->{compssUsersIcons}, $o->{compssUsersDescr}) = 
      pkgs::readCompssUsers($o->{packages}, $o->{meta_class});
    eval { install_any::getFile("XXX") }; #- close out any still opened filehandle..

    if (!$o->{compssUsersChoice}) {
	#- by default, choose:
	$o->{compssUsersChoice}{$_} = 1 foreach 'GNOME', 'KDE', 'CONFIG';
	$o->{compssUsersChoice}{$_} = 1 
	    foreach map { @{$o->{compssUsers}{$_}{flags}} } 'Workstation|Office Workstation', 'Workstation|Internet station';
    }
    if (exists $options{server}) {
	foreach (qw(KDE ACCESSIBILITY PUBLISHING CUPS EDITORS TEXT_TOOLS COMMUNICATIONS TERMINALS
		    NETWORKING_FILE_TRANSFER NETWORKING_OTHER
		    NETWORKING_FILE_TRANSFER_SERVER NETWORKING_FIREWALLING_SERVER
		    NETWORKING_MAIL_SERVER NETWORKING_OTHER_SERVER
		    NETWORKING_REMOTE_ACCESS NETWORKING_REMOTE_ACCESS_SERVER NETWORKING_DNS
		    NETWORKING_FILE NETWORKING_FILE_SERVER NETWORKING_WWW NETWORKING_WWW_SERVER
		    ARCHIVING DEVELOPMENT MONITORING FILE_TOOLS CONFIG BOOKS SYSTEM X)) {
	    $o->{compssUsersChoice}{$_} = 1;
	}
	#- additional packages to be selected for server, databases with MySQL (avoid rpmsrate modifications).
	foreach (qw(MySQL-client MySQL-shared MySQL perl-Mysql)) {
	    my $pkg = pkgs::packageByName($o->{packages}, $_);
	    $pkg and pkgs::selectPackage($o->{packages}, $pkg);
	}
    } else {
	$o->{compssUsersChoice}{$_} = 1 foreach map { @{$o->{compssUsers}{$_}} } @{$o->{compssUsersSorted}};
	$o->{compssUsersChoice}{$_} = 1 foreach qw(SYSTEM X);
	@{$o->{compssUsersChoice}}{grep { /SERVER|DATABASES/ } keys %{$o->{compssUsersChoice}}} = ();
    }

    my $lang_pkg = $lang && pkgs::packageByName($o->{packages}, "locales-$lang");
    if ($lang_pkg) {
	pkgs::selectPackage($o->{packages}, $lang_pkg);
	$o->{compssUsersChoice}{qq(LOCALES"$lang")} = 1;
	$o->{compssUsersChoice}{qq(LOCALES"$flang")} = 1;
    }

    pkgs::setSelectedFromCompssList($o->{packages}, $o->{compssUsersChoice}, 4, 0);

    #- package that have to selected here as a bonus for oem install.
    foreach (qw(cups cups-drivers drakprofile draksync numlock raidtools reiserfsprogs xfsprogs jfsprogs icewm-light
		Mesa Mesa-demos alsa alsa-utils xawtv kwintv xscreensaver-gl Mesa-demos xmms-mesa 
		bzflag csmash gltron spacecup chromium tuxracer FlightGear armagetron 
                glibc vim-minimal kernel kernel22
		sox aumix xawtv gatos kwintv sane-frontends gphoto gnome-toaster gcombust xcdroast apmd cdlabelgen
               )) {
	my $pkg = pkgs::packageByName($o->{packages}, $_);
	$pkg and pkgs::selectPackage($o->{packages}, $pkg);
    }

    #- special packages that are to be move to closure always ...
    foreach (qw(kernel-smp kernel-linus kernel-secure hackkernel-smp hackkernel-linus hackkernel-secure
		xawtv kwintv xscreensaver-gl xmms-mesa 
		bzflag csmash gltron spacecup chromium tuxracer FlightGear armagetron 
		kernel22-smp kernel22-secure alsa imwheel nfs-utils-clients lvm usbd hotplug reiserfsprogs
		sox aumix xawtv gatos kwintv sane-frontends gphoto gnome-toaster gcombust xcdroast apmd cdlabelgen
		), exists $options{server} ? qw(Aurora Aurora-Monitor-NewStyle-Categorizing-WsLib) : ()) {
	my $pkg = pkgs::packageByName($o->{packages}, $_);
	$pkg and $pkg->{closure} = 1, delete $pkg->{selected};
    }

    $o->{packages};
}

sub chop_version {
    ($_[0] =~ /^([^:\s]*)-[^:\-\s]+-[^:\-\s]+\.[^:\.\-\s]*(?::\S*)?/)[0] || die "unable to parse $_[0]";
}
sub rpm_filename {
    (($_[0]{name} =~ /^([^:\s]*-[^:\-\s]+-[^:\-\s]+\.[^:\.\-\s]*)(?::\S*)?/)[0] || die "unable to parse $_[0]") . ".rpm";
}

sub read_depslist {
    my ($file) = @_;
    my $packages = { depslist => [], names => {} };

    #- read depslist.oredered file.
    my $id = 0;

    open F, "$file" or die "unable to open ordered dependencies list file";
    while (<F>) {
	my ($name, $size, @deps) = split;
	push @{$packages->{depslist}}, { id => $id++, name => $name, size => $size, deps => \@deps };
    }
    close F;

    foreach (@{$packages->{depslist}}) {
	$packages->{names}{chop_version($_->{name})} = $_;
    }

    print "read " . scalar(@{$packages->{depslist}}) . " package dependancies\n";
    $packages;
}

#- compability method for the below ones, wrap DrakX code extracted.
package log;
sub l {}

package detect_devices;
sub matching_desc { 0 }

package install_any;
sub getFile { open FILE, "/cdrom/$_[0]" or return; \*FILE }

package pkgs;
sub if_ { my $b = shift; $b or return (); wantarray ? @_ : $_[0] }
sub formatXiB { $_[0] } #- NOP
sub packageName { ::chop_version($_[0]{name}) }
sub packageFlagSelected { $_[0]{selected} }
sub packageSize { $_[0]{size} }
sub packageDepsId { @{$_[0]{deps}} }
sub packageRate { $_[0]{values}[0] }
sub packageRateRFlags { @{$_[0]{values}} }
sub packageSetRateRFlags {
    my ($pkg, @rate_rflags) = @_;
    $pkg->{values} = [ @rate_rflags ];
}
sub packageByName {
    my ($packages, $name) = @_;
    $packages->{names}{$name};
}
sub packageById {
    my ($packages, $id) = @_;
    $packages->{depslist}[$id];
}
sub selectedSize {
    my ($packages) = @_;
    my $size = 0;
    foreach (@{$packages->{depslist}}) {
	$_->{selected} and $size += $_->{size};
    }
    $size;
}
my @preferred = qw(perl-GTK postfix wu-ftpd ghostscript-X vim-minimal kernel ispell-en);
sub selectPackage {
    my ($packages, $pkg, $base, $otherOnly, $check_recursion) = @_;

    #- avoid infinite recursion (mainly against badly generated depslist.ordered).
    $check_recursion ||= {}; exists $check_recursion->{$pkg->{name}} and return; $check_recursion->{$pkg->{name}} = undef;

    #- make sure base package are set even if already selected.
    $base and $pkg->{base} = 1;

    #- select package and dependancies, otherOnly may be a reference
    #- to a hash to indicate package that will strictly be selected
    #- when value is true, may be selected when value is false (this
    #- is only used for unselection, not selection)
    unless ($pkg->{selected}) {
	foreach (@{$pkg->{deps}}) {
	    my $preferred;	    
	    if (/\|/) {
		#- choice deps should be reselected recursively as no
		#- closure on them is computed, this code is exactly the
		#- same as pixel's one.
		my %preferred; @preferred{@preferred} = ();
		foreach (split '\|') {
		    my $dep = $packages->{depslist}[$_] or next;
		    $preferred ||= $dep;
		    $dep->{selected} and $preferred = $dep, last;
		    exists $preferred{::chop_version($dep->{name})} and $preferred = $dep;
		}
		selectPackage($packages, $preferred, $base, $otherOnly, $check_recursion) if $preferred;
	    } else {
		#- deps have been closed except for choices, so no need to
		#- recursively apply selection, expand base on it.
		my $dep = $packages->{depslist}[$_];
		$base and $dep->{base} = 1;
		$otherOnly and !$dep->{selected} and $otherOnly->{::chop_version($dep->{name})} = 1;
		$otherOnly or $dep->{selected} += 1;
	    }
	}
    }
    $otherOnly and !$pkg->{selected} and $otherOnly->{::chop_version($pkg->{name})} = 1;
    $otherOnly or $pkg->{selected} += 1;
    1;
}

#- this code is extracted from DrakX and SHOULD NOT BE MODIFIED, wrapper method exists above to provide a good choice.
sub read_rpmsrate {
    my ($packages, $f) = @_;
    my $line_nb = 0;
    my $fatal_error;
    my (@l);
    while (<$f>) {
	$line_nb++;
	/\t/ and die "tabulations not allowed at line $line_nb\n";
	s/#.*//; # comments

	my ($indent, $data) = /(\s*)(.*)/;
	next if !$data; # skip empty lines

	@l = grep { $_->[0] < length $indent } @l;

	my @m = @l ? @{$l[$#l][1]} : ();
	my ($t, $flag, @l2);
	while ($data =~ 
	       /^((
                   [1-5]
                   |
                   (?:            (?: !\s*)? [0-9A-Z_]+(?:".*?")?)
                   (?: \s*\|\|\s* (?: !\s*)? [0-9A-Z_]+(?:".*?")?)*
                  )
                  (?:\s+|$)
                 )(.*)/x) { #@")) {
	    ($t, $flag, $data) = ($1,$2,$3);
	    while ($flag =~ s,^\s*(("[^"]*"|[^"\s]*)*)\s+,$1,) {}
	    my $ok = 0;
	    $flag = join('||', grep { 
		if (my ($inv, $p) = /^(!)?HW"(.*)"/) {
		    ($inv xor detect_devices::matching_desc($p)) and $ok = 1;
		    0;
		} else {
		    1;
		}
	    } split '\|\|', $flag);
	    push @m, $ok ? 'TRUE' : $flag || 'FALSE';
	    push @l2, [ length $indent, [ @m ] ];
	    $indent .= $t;
	}
	if ($data) {
	    # has packages on same line
	    my ($rate) = grep { /^\d$/ } @m or die sprintf qq(missing rate for "%s" at line %d (flags are %s)\n), $data, $line_nb, join('&&', @m);
	    foreach (split ' ', $data) {
		if ($packages) {
		    my $p = packageByName($packages, $_) or next;
		    
		    my @m2 = 
		      map { if_($_ && packageName($_) =~ /locales-(.*)/, qq(LOCALES"$1")) }
		      map { packageById($packages, $_) } packageDepsId($p);

		    my @m3 = ((grep { !/^\d$/ } @m), @m2);
		    if (packageRate($p)) {
			next if @m3 == 1 && $m3[0] eq 'INSTALL';

			my ($rate2, @m4) = packageRateRFlags($p);
			if (@m3 > 1 || @m4 > 1) {
			    log::l("can't handle complicate flags for packages appearing twice ($_)");
			    $fatal_error++;
			}
			log::l("package $_ appearing twice with different rates ($rate != $rate2)") if $rate != $rate2;
			packageSetRateRFlags($p, $rate, "$m3[0]||$m4[0]");
		    } else {
			packageSetRateRFlags($p, $rate, @m3);
		    }
		} else {
		    print "$_ = ", join(" && ", @m), "\n";
		}
	    }
	    push @l, @l2;
	} else {
	    push @l, [ $l2[0][0], $l2[$#l2][1] ];
	}
    }
    $fatal_error and die "$fatal_error fatal errors in rpmsrate";
}

sub readCompssUsers {
    my ($packages, $meta_class) = @_;
    my (%compssUsers, %compssUsersIcons, , %compssUsersDescr, @sorted, $l);
    my (%compss); 

    my $file = 'Mandrake/base/compssUsers';
    my $f = $meta_class && install_any::getFile("$file.$meta_class") || install_any::getFile($file) or die "can't find $file";
    local $_;
    while (<$f>) {
	/^\s*$/ || /^#/ and next;
	s/#.*//;

	if (/^(\S.*)/) {
	    my ($icon, $descr);
	    /^(.*?)\s*\[icon=(.*?)\](.*)/  and $_ = "$1$3", $icon  = $2;
	    /^(.*?)\s*\[descr=(.*?)\](.*)/ and $_ = "$1$3", $descr = $2;
	    $compssUsersIcons{$_} = $icon; 
	    $compssUsersDescr{$_} = $descr; 
	    push @sorted, $_;
	    $compssUsers{$_} = $l = [];
	} elsif (/^\s+(.*?)\s*$/) {
	    push @$l, $1;
	}
    }
    \%compssUsers, \@sorted, \%compssUsersIcons, \%compssUsersDescr;
}

sub setSelectedFromCompssList {
    my ($packages, $compssUsersChoice, $min_level, $max_size) = @_;
    $compssUsersChoice->{TRUE} = 1; #- ensure TRUE is set
    my $nb = selectedSize($packages);
    foreach my $p (sort { packageRate($b) <=> packageRate($a) } values %{$packages->{names}}) {
	my ($rate, @flags) = packageRateRFlags($p);
	next if 
	  !$rate || $rate < $min_level || 
	  grep { !grep { /^!(.*)/ ? !$compssUsersChoice->{$1} : $compssUsersChoice->{$_} } split('\|\|') } @flags;

	#- determine the packages that will be selected when
	#- selecting $p. the packages are not selected.
	my %newSelection;
	selectPackage($packages, $p, 0, \%newSelection);

	#- this enable an incremental total size.
	my $old_nb = $nb;
	foreach (grep { $newSelection{$_} } keys %newSelection) {
	    $nb += packageSize($packages->{names}{$_});
	}
	if ($max_size && $nb > $max_size) {
	    $nb = $old_nb;
	    $min_level = packageRate($p);
	    last;
	}

	#- at this point the package can safely be selected.
	selectPackage($packages, $p);
    }
    log::l("setSelectedFromCompssList: reached size ", formatXiB($nb), ", up to indice $min_level (less than ", formatXiB($max_size), ")");
    log::l("setSelectedFromCompssList: ", join(" ", sort map { packageName($_) } grep { packageFlagSelected($_) } @{$packages->{depslist}}));
    $min_level;
}