*** empty log message ***

17 files changed, 381 insertions, 165 deletions

diff --git a/perl-install/Makefile b/perl-install/Makefile
index c4567e638..9f3a9e6d7 100644
--- a/perl-install/Makefile
+++ b/perl-install/Makefile
@@ -1,5 +1,5 @@
 SO_FILES = c/blib/arch/auto/c/c.so
-PMS = *.pm c/*.pm resize_fat/*.pm po/*.pm commands install2 diskdrake
+PMS = *.pm c/*.pm resize_fat/*.pm po/*.pm pci_probing/*.pm commands install2 diskdrake
 ROOTDEST = /tmp/t
 DEST = $(ROOTDEST)/Mandrake/instimage
 DESTREP4PMS = $(DEST)/usr/bin/perl-install
@@ -24,12 +24,23 @@ clean:
 tar: clean
 	cd .. ; tar cfy perl-install.tar.bz2 $(EXCLUDE:%=--exclude %) perl-install
 
+floppy: tar
+	mcopy -o ../perl-install.tar.bz2 a:
+	mcopy -o ../perl-install.tar.bz2 a:a
+	mcopy -o ../perl-install.tar.bz2 a:aa
+
 tar-diskdrake: clean
 	cd .. ; rm -rf diskdrake ; cp -af perl-install diskdrake
 
-	l=`perl2fcalls -uses -excludec diskdrake | sort | uniq | sed -e 's/::/\//' -e 's/^/diskdrake\//' -e 's/$$/.pm/'` ; \
+	l=`./perl2fcalls -uses -excludec diskdrake | sort | uniq | sed -e 's/::/\//' -e 's/^/diskdrake\//' -e 's/$$/.pm/'` ; \
 	cd .. ; tar cfz diskdrake.tgz --exclude CVS $(patsubst %,diskdrake/%,c po diskdrake*) $$l
 
+tar-XFdrake: clean
+	cd .. ; rm -rf XFdrake ; cp -af perl-install XFdrake
+
+	l=`./perl2fcalls -uses -excludec -excludepci_probing::ids XFdrake | sort | uniq | sed -e 's/::/\//' -e 's/^/XFdrake\//' -e 's/$$/.pm/'` ; \
+	cd .. ; tar cfz XFdrake.tgz --exclude CVS $(patsubst %,XFdrake/%,c MonitorsDB po pci_probing XFdrake*) $$l
+
 c/c.xs: c/c.xs.pm
 	rm -f $@
 	export C_RPM=1 ; perl $< > $@
@@ -46,7 +57,7 @@ $(DIRS):
 	$(MAKE) -C $@
 
 test_pms: verify_c
-	perl2fcalls -excludec install2
+	./perl2fcalls -excludec install2
 	(for i in $(PMS); do perl -cw -I. -Ic -Ic/blib/arch $$i || exit 1 ; done)
 
 verify_c:
@@ -118,6 +129,7 @@ get_needed_files: $(SO_FILES)
 	cp -a xmodmaps $(DEST)/usr/share
 	cp -a keymaps $(DEST)/usr/share
 	cp -a consolefonts $(DEST)/usr/share
+	cp MonitorsDB $(DEST)/usr/share
 	cp compss $(ROOTDEST)/Mandrake/base
 
 	ln -s install2 $(DEST)/usr/bin/runinstall2
diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm
index 751efeebd..d39e58238 100644
--- a/perl-install/Xconfigurator.pm
+++ b/perl-install/Xconfigurator.pm
@@ -13,7 +13,7 @@ use my_gtk qw(:wrappers);
 
 my $tmpconfig = "/tmp/Xconfig";
 
-my (%cards, %monitors);
+my ($prefix, %cards, %monitors);
 
 1;
 
@@ -84,7 +84,7 @@ sub readMonitorsDB {
     %monitors and return;
 
     local *F;
-    open F, $file or die "can't open monitors database ($file): ?!";
+    open F, $file or die "can't open monitors database ($file): $!";
     my $lineno = 0; foreach (<F>) {
 	$lineno++;
 	s/\s+$//;
@@ -109,15 +109,15 @@ sub rewriteInittab {
     my ($runlevel) = @_;
     {
 	local (*F, *G);
-	open F, "/etc/inittab" or die "cannot open /etc/inittab: $!";
-	open G, "> /etc/inittab-" or die "cannot write in /etc/inittab-: $!";
+	open F, "$prefix/etc/inittab" or die "cannot open $prefix/etc/inittab: $!";
+	open G, "> $prefix/etc/inittab-" or die "cannot write in $prefix/etc/inittab-: $!";
     
 	foreach (<F>) {
-	    print G /^(id:)[35](:initdefault:)\s*$/ ? "$1$runlevel$2\n" : $_;
+	    print G /^(id:)[35](:initdefault:)\s*$/ ? "$1$runlevel$2\n" : $_; # **
 	}
     }
-    unlink("/etc/inittab");
-    rename("/etc/inittab-", "/etc/inittab");
+    unlink("$prefix/etc/inittab");
+    rename("$prefix/etc/inittab-", "$prefix/etc/inittab");
 }
 
 sub keepOnlyLegalModes {
@@ -144,21 +144,25 @@ sub cardConfiguration(;$$) {
     my ($card, $noauto) = @_;
     $card ||= {};
 
-    readCardsDB("/usr/X11R6/lib/X11/Cards");
+    readCardsDB("$prefix/usr/X11R6/lib/X11/Cards");
 
-    add2hash($card, cardConfigurationAuto()) unless $card->{type} || $card->{server} || $noauto;
+    add2hash($card, $cards{$card->{type}}) if $card->{type}; # try to get info from given type
+    $card->{type} = undef unless $card->{server}; # bad type as we can't find the server
+	
+    add2hash($card, cardConfigurationAuto()) unless $card->{server} || $noauto;
     add2hash($card, { type => $in->ask_from_list('', _("Choose a graphic card"), [keys %cards]) }) unless $card->{type} || $card->{server};
+
     add2hash($card, $cards{$card->{type}}) if $card->{type};
     add2hash($card, { vendor => "Unknown", board => "Unknown" });
 
     $card->{prog} = "/usr/X11R6/bin/XF86_$card->{server}";
-
-    -x $card->{prog} or !defined $install or &$install($card->{server});
-    -x $card->{prog} or die "server $card->{server} is not available (should be in $card->{prog})";
-
+    
+    -x "$prefix$card->{prog}" or !defined $install or &$install($card->{server});
+    -x "$prefix$card->{prog}" or die "server $card->{server} is not available (should be in $prefix$card->{prog})";
+	
     unless ($::testing) {
-	unlink("/etc/X11/X");
-	symlink("../../$card->{prog}", "/etc/X11/X");
+	unlink("$prefix/etc/X11/X");
+	symlink("../..$card->{prog}", "$prefix/etc/X11/X");
     }
 
     unless ($card->{type}) {
@@ -177,11 +181,13 @@ sub cardConfiguration(;$$) {
 sub monitorConfiguration(;$) {
     my $monitor = shift || {};
 
-    readMonitorsDB("MonitorsDB");
+    $monitor->{hsyncrange} && $monitor->{vsyncrange} and return $monitor;
+
+    readMonitorsDB(-e "MonitorsDB" ? "MonitorsDB" : "/usr/share/MonitorsDB");
 
     add2hash($monitor, { type => $in->ask_from_list('', _("Choose a monitor"), [keys %monitors]) }) unless $monitor->{type};
     add2hash($monitor, $monitors{$monitor->{type}});
-    add2hash($monitor, { vendor => "Unknown", model => "Unknown" });
+    add2hash($monitor, { type => "Unknown", vendor => "Unknown", model => "Unknown" });
     $monitor;
 }
 
@@ -192,7 +198,7 @@ sub testConfig($) {
     write_XF86Config($o, $tmpconfig);
 
     local *F;
-    open F, "$o->{card}->{prog} :9 -probeonly -pn -xf86config $tmpconfig 2>&1 |";
+    open F, "$prefix$o->{card}->{prog} :9 -probeonly -pn -xf86config $tmpconfig 2>&1 |";
     foreach (<F>) {
 	$o->{card}->{memory} ||= $2 if /(videoram|Video RAM):\s*(\d*)/;
 
@@ -219,9 +225,9 @@ sub testFinalConfig($;$) {
     $o->{card}->{depth} or
       $in->ask_warn('', _("Resolutions not chosen yet")), return;
 
-    rename("/etc/X11/XF86Config", "/etc/X11/XF86Config.old") || die "unable to make a backup of XF86Config" unless $::testing;
+    rename("$prefix/etc/X11/XF86Config", "$prefix/etc/X11/XF86Config.old") || die "unable to make a backup of XF86Config" unless $::testing;
 
-    write_XF86Config($o, $::testing ? $tmpconfig : "/etc/X11/XF86Config");
+    write_XF86Config($o, $::testing ? $tmpconfig : "$prefix/etc/X11/XF86Config");
 
     $auto 
       or $in->ask_yesorno(_("Test configuration"), _("Do you want to test configuration?"))
@@ -230,10 +236,16 @@ sub testFinalConfig($;$) {
     my $pid; unless ($pid = fork) {
 	my @l = "X";
 	@l = ($o->{card}->{prog}, "-xf86config", $tmpconfig) if $::testing;
+	chroot $prefix if $prefix;
 	exec @l, ":9" or exit 1;
     }
     do { sleep 1; } until (c::Xtest(':0'));
 
+    # create a link from the non-prefixed /tmp/.X11-unix/X9 to the prefixed one
+    # that way, you can talk to :9 without doing a chroot
+    unlink "/tmp/.X11-unix/X9" if $prefix;
+    symlink "$prefix/tmp/.X11-unix/X9", "/tmp/.X11-unix/X9" if $prefix;
+
     local *F;
     open F, "|perl" or die;
     print F "use lib qw(", join(' ', @INC), ");\n";
@@ -242,7 +254,7 @@ sub testFinalConfig($;$) {
         use my_gtk qw(:wrappers);
 
 	$ENV{DISPLAY} = ":9";
-        gtkset_mousecursor(2);
+        gtkset_mousecursor(68);
         gtkset_background(200, 210, 210);
         my ($h, $w) = Gtk::Gdk::Window->new_foreign(Gtk::Gdk->ROOT_WINDOW)->get_size;
         $my_gtk::force_position = [ $w / 3, $h / 2.4 ];
@@ -259,10 +271,11 @@ sub testFinalConfig($;$) {
     };
     my $rc = close F;
     my $err = $?;
+
+    unlink "/tmp/.X11-unix/X9" if $prefix;
     kill 2, $pid;
 
     $rc || $err == 222 << 8 or $in->ask_warn('', _("An error occured, try changing some parameters"));
-
     $rc;
 }
 
@@ -378,11 +391,6 @@ sub resolutionsConfiguration($$) {
     my $nowarning = $auto || $option eq 'nowarning';
     my $noauto = $option eq 'noauto';
 
-    unless ($card->{depth}) {
-	$card->{depth}->{$_} = [ map { [ split "x" ] } @resolutions ] 
-	  foreach @depths;
-    }
-
     # For the mono and vga16 server, no further configuration is required.
     return if member($card->{server}, "Mono", "VGA16");
 
@@ -411,15 +419,25 @@ sub resolutionsConfiguration($$) {
     #$unknown and $manual ||= !$in->ask_okcancel('', [ _("I can try to autodetect information about graphic card, but it may freeze :("),
     #						       _("Do you want to try?") ]);
     
-    if ($nowarning || (!$noauto && $in->ask_okcancel(_("Automatic resolutions"), 
+    unless ($card->{depth}) {
+	$card->{depth}->{$_} = [ map { [ split "x" ] } @resolutions ] 
+	  foreach @depths;
+
+	if ($nowarning || (!$noauto && $in->ask_okcancel(_("Automatic resolutions"), 
 _("I can try to find the available resolutions (eg: 800x600).
 Alas it can freeze sometimes
 Do you want to try?")))) {
-	autoResolutions($o, $nowarning);
+	    autoResolutions($o, $nowarning);
+	}
     }
 
     # sort resolutions in each depth
-    @$_ = sort { $b->[0] <=> $a->[0] } @$_ foreach values %{$card->{depth}};
+    { 
+	my $i;
+	@$_ = grep { first($i != $_->[0], $i = $_->[0]) }
+	      sort { $b->[0] <=> $a->[0] } @$_ 
+		foreach values %{$card->{depth}};
+    } 
 
     # remove unusable resolutions (based on the video memory size)
     keepOnlyLegalModes($card);
@@ -462,11 +480,11 @@ sub write_XF86Config {
     # Write pointer section.     
     $O = $o->{mouse};
     print F $pointersection_text1;
-    print F qq(    Protocol    "$O->{type}"\n);
+    print F qq(    Protocol    "$O->{xtype}"\n);
     print F qq(    Device      "$O->{device}"\n);
     # this will enable the "wheel" or "knob" functionality if the mouse supports it 
     print F "    ZAxisMapping 4 5\n" if
-      member($O->{type}, qw(IntelliMouse IMPS/2 ThinkingMousePS/2 NetScrollPS/2 NetMousePS/2 MouseManPlusPS/2));
+      member($O->{xtype}, qw(IntelliMouse IMPS/2 ThinkingMousePS/2 NetScrollPS/2 NetMousePS/2 MouseManPlusPS/2));
 
     print F $pointersection_text2;
     print F "#" unless $O->{emulate3buttons};
@@ -538,9 +556,7 @@ Section "Screen"
 	print F "    DefaultColorDepth $defdepth\n" if $defdepth;
 
         foreach (ikeys(%$depths)) {
-	    my $m = join(" ", 
-			 map { '"' . join("x", @$_) . '"' }
-			 sort { $b->[0] <=> $a->[0] } @{$depths->{$_}});
+	    my $m = join(" ", map { qq("$_->[0]x$_->[1]") } @{$depths->{$_}});
 	    print F qq(    Subsection "Display"\n);
 	    print F qq(        Depth       $_\n) if $_;
 	    print F qq(        Modes       $m\n);
@@ -575,10 +591,10 @@ Section "Screen"
 sub XF86check_link {
     my ($void) = @_;
 
-    my $f = "/etc/X11/XF86Config";
+    my $f = "$prefix/etc/X11/XF86Config";
     touch($f);
 
-    my $l = "/usr/X11R6/lib/X11/XF86Config";
+    my $l = "$prefix/usr/X11R6/lib/X11/XF86Config";
 
     if (-e $l && (stat($f))[1] != (stat($l))[1]) { # compare the inode, must be the sames
 	-e $l and unlink($l) || die "can't remove bad $l";
@@ -589,10 +605,9 @@ sub XF86check_link {
 
 # * Program entry point. 
 sub main {
-    my ($default, $interact, $install_pkg) = @_;
-    my $o = $default;
-    $in = $interact;
-    $install = $install_pkg;
+    my $o;
+    ($prefix, $o, $in, $install) = @_;
+    $o ||= {};
 
     XF86check_link();
 
@@ -611,7 +626,10 @@ sub main {
 	   __("Change Monitor") => sub { $o->{monitor} = monitorConfiguration() },
            __("Change Graphic card") => sub { $o->{card} = cardConfiguration('', 'noauto') },
 	   __("Change Resolution") => sub { resolutionsConfiguration($o, 'noauto') },
-	   __("Automaticall resolutions search") => sub { resolutionsConfiguration($o, 'nowarning') },
+	   __("Automaticall resolutions search") => sub { 
+	       delete $o->{card}->{depth};
+	       resolutionsConfiguration($o, 'nowarning');
+	   },
 	   __("Test again") => sub { $ok = testFinalConfig($o, 1) },
 	   __("Quit") => sub { $quit = 1 },
         );
diff --git a/perl-install/common.pm b/perl-install/common.pm
index 2fee51d59..9a21b7b57 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -6,10 +6,10 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int
 
 @ISA = qw(Exporter);
 %EXPORT_TAGS = (
-    common => [ qw(_ __ min max sum product bool ikeys member divide is_empty_array_ref add2hash set_new set_add round_up round_down first second top uniq translate untranslate) ],
-    functional => [ qw(fold_left) ],
-    file => [ qw(dirname basename touch all glob_ cat_ chop_ mode getVarsFromSh) ],
-    system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_) ],
+    common => [ qw(__ min max sum sign product bool ikeys member divide is_empty_array_ref add2hash set_new set_add round_up round_down first second top uniq translate untranslate) ],
+    functional => [ qw(fold_left difference2) ],
+    file => [ qw(dirname basename touch all glob_ cat_ chop_ mode) ],
+    system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_ getVarsFromSh) ],
     constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE) ],
 );
 @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
@@ -22,10 +22,12 @@ $SECTORSIZE = 512;
 1;
 
 sub _ { my $s = shift @_; sprintf translate($s), @_ }
+#delete $main::{'_'};
 sub __ { $_[0] }
 sub min { fold_left(sub { $a < $b ? $a : $b }, @_) }
 sub max { fold_left(sub { $a > $b ? $a : $b }, @_) }
 sub sum { fold_left(sub { $a + $b }, @_) }
+sub sign { $_[0] <=> 0 }
 sub product { fold_left(sub { $a * $b }, @_) }
 sub first { $_[0] }
 sub second { $_[1] }
@@ -44,6 +46,7 @@ sub divide { my $d = int $_[0] / $_[1]; wantarray ? ($d, $_[0] % $_[1]) : $d }
 sub round_up { my ($i, $r) = @_; $i += $r - ($i + $r - 1) % $r - 1; }
 sub round_down { my ($i, $r) = @_; $i -= $i % $r; }
 sub is_empty_array_ref { my $a = shift; !defined $a || @$a == 0 }
+sub difference2 { my %l; @l{@{$_[1]}} = (); grep { !exists $l{$_} } @{$_[0]} }
 
 sub set_new(@) { my %l; @l{@_} = undef; { list => [ @_ ], hash => \%l } }
 sub set_add($@) { my $o = shift; foreach (@_) { exists $o->{hash}->{$_} and next; push @{$o->{list}}, $_; $o->{hash}->{$_} = undef } }
diff --git a/perl-install/fs.pm b/perl-install/fs.pm
index 0b08c0775..8d3995aa4 100644
--- a/perl-install/fs.pm
+++ b/perl-install/fs.pm
@@ -79,7 +79,7 @@ sub format_part($;$) {
 
     $part->{isFormatted} and return;
 
-    log::l("formatting device $part->{device} (type ", type2name($_->{type}), ")");
+    log::l("formatting device $part->{device} (type ", type2name($part->{type}), ")");
 
     if (isExt2($part)) {
 	format_ext2($part->{device}, $bad_blocks);
@@ -151,7 +151,7 @@ sub umount_part($;$) {
 
     isSwap($part) ?
       swap::swapoff($part->{device}) :
-      umount(($prefix || '') . ($part->{mntpoint} || "/dev/$part->{device}"));
+      umount(($prefix || '') . ($part->{mntpoint} || devices::make($part->{device})));
     $part->{isMounted} = 0;
 }
 
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index df2ae8e7d..ca613be3c 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -3,9 +3,10 @@ package fsedit;
 use diagnostics;
 use strict;
 
-use common qw(:common);
+use common qw(:common :constant);
 use partition_table qw(:types);
 use partition_table_raw;
+use Data::Dumper;
 use devices;
 use log;
 
@@ -45,12 +46,14 @@ sub hds($$) {
 	# for RAID arrays of format c0d0p1 
 	$hd->{prefix} .= "p" if $hd->{prefix} =~ m,(rd|ida)/,;
 
-	eval { $rc = partition_table::read($hd, $flags->{clearall}) }; 
+	eval { partition_table::read($hd, $flags->{clearall}) }; 
 	if ($@) {
-	    $@ =~ /bad magic number/ or die;
-	    partition_table_raw::zero_MBR($hd) if $flags->{eraseBadPartitions};
+#	    $@ =~ /bad magic number/ or die;
+	    $flags->{eraseBadPartitions} ?
+	      partition_table_raw::zero_MBR($hd) :
+	      die;
 	}
-	$rc ? push @hds, $hd : log::l("An error occurred reading the partition table for the block device $_->{device}");
+	push @hds, $hd;
     }
     [ @hds ];
 }
@@ -114,7 +117,7 @@ sub has_mntpoint($$) {
 sub check_mntpoint {
     my ($mntpoint, $hd, $part, $hds) = @_;
 
-    $mntpoint eq '' and return;
+    $mntpoint eq '' || isSwap($part) and return;
 
     local $_ = $mntpoint;
     m|^/| or die _("Mount points must begin with a leading /");
@@ -122,20 +125,20 @@ sub check_mntpoint {
 
     has_mntpoint($mntpoint, $hds) and die _("There is already a partition with mount point %s", $mntpoint);
 
-    if ($part->{start} + $part->{size} > 124 * partition_table::cylinder_size($hd)) {
+    if ($part->{start} + $part->{size} > 1024 * partition_table::cylinder_size($hd)) {
 	die "/boot ending on cylinder > 1024" if $mntpoint eq "/boot";
 	die     "/ ending on cylinder > 1024" if $mntpoint eq "/" && !has_mntpoint("/boot", $hds);
     }
 }
 
 sub add($$$;$) {
-    my ($hd, $part, $hds, $force) = @_;
+    my ($hd, $part, $hds, $options) = @_;
 
     isSwap($part) ?
       ($part->{mntpoint} = 'swap') :
-      $force || check_mntpoint($part->{mntpoint}, $hd, $part, $hds);
+      $options->{force} || check_mntpoint($part->{mntpoint}, $hd, $part, $hds);
 
-    partition_table::add($hd, $part);
+    partition_table::add($hd, $part, $options->{want_primary});
 }
 
 sub removeFromList($$$) {
@@ -204,3 +207,89 @@ sub auto_allocate($;$) {
 			     ]);
     map { partition_table::assign_device_numbers($_) } @$hds;
 }
+
+sub undo_prepare($) {
+    my ($hds) = @_;
+    $Data::Dumper::Purity = 1;
+    foreach (@$hds) {
+	my @h = @{$_}{@partition_table::fields2save};
+	push @{$_->{undo}}, Data::Dumper->Dump([\@h], ['$h']);
+    }
+}
+
+sub undo($) {
+    my ($hds) = @_;
+    foreach (@$hds) {
+	my $h; eval pop @{$_->{undo}} || next;
+	@{$_}{@partition_table::fields2save} = @$h;
+	
+	$_->{isDirty} = $_->{needKernelReread} = 1;
+    }
+}
+
+sub verify_room {
+    my ($part, $hd2, $sector2) = @_;
+    my $free_sectors = [ 1, $hd2->{totalsectors} ]; # first sector is always occupied by the MBR
+    my $remove = sub { removeFromList($_[0]->{start}, $_[0]->{start} + $_[0]->{size}, $free_sectors) };
+
+    $_ eq $part or &$remove($_) foreach get_fstab($hd2);
+
+    for (my $i = 0; $i < @$free_sectors; $i += 2) {
+	$sector2 < $free_sectors->[$i] && $sector2 < $free_sectors->[$i + 1] or next;
+	$sector2 + $part->{size} < $free_sectors->[$i + 1] or die
+_("Not enough place to move (%dGb, should be %dGb)", ($free_sectors->[$i + 1] - $free_sectors->[$i]), $part->{size} >> 11);
+	return;
+    }
+    die _("There is already a partition there");
+}
+
+sub move {
+    my ($hd, $part, $hd2, $sector2) = @_;
+
+    my $part2 = { %$part };
+    $part2->{start} = $sector2;
+    partition_table::remove($hd, $part);
+    {
+    local ($part2->{notFormatted}, $part2->{isFormatted}); # do not allow partition::add to change this
+    partition_table::add($hd2, $part2);
+    }
+    verify_room($part, $hd2, $part2->{start});
+
+    return if $part2->{notFormatted} && !$part2->{isFormatted} || $::testing;
+
+    local (*F, *G);
+    sysopen F, $hd->{file}, 0 or die;
+    sysopen G, $hd2->{file}, 2 or die _("Error opening %s for writing: %s", $hd2->{file}, "$!");
+
+    my $base = $part->{start};
+    my $base2 = $part2->{start};
+    my $step = 1 << 10;
+    if ($hd eq $hd2) {
+	$part->{start} == $part2->{start} and return;
+	$step = min($step, abs($part->{start} - $part2->{start}));
+
+	if ($part->{start} < $part2->{start}) {
+	    $base  += $part->{size} - $step;
+	    $base2 += $part->{size} - $step;
+	    $step = -$step;
+	}
+    }
+
+    my $f = sub {
+	c::lseek_sector(fileno(F), $base,  0) or die "seeking to sector $base failed on drive $hd->{device}";
+	c::lseek_sector(fileno(G), $base2, 0) or die "seeking to sector $base2 failed on drive $hd2->{device}";
+    
+	my $buf;
+	sysread F, $buf, $SECTORSIZE * abs($_[0]) or die;
+	syswrite G, $buf;
+    };
+
+    for (my $i = 0; $i < $part->{size} / abs($step); $i++, $base += $step, $base2 += $step) {
+	&$f($step);
+    }
+    if (my $v = $part->{size} % abs($step) * sign($step)) {
+	$base += $v;
+	$base2 += $v;
+	&$f($v);
+    }
+}
diff --git a/perl-install/install2 b/perl-install/install2
index 5076029b0..7d9c4a278 100755
--- a/perl-install/install2
+++ b/perl-install/install2
@@ -23,5 +23,7 @@ use strict;
 use lib qw(/usr/bin/perl-install . c c/blib/arch);
 use install2;
 
+$::testing = $ENV{PERL_INSTALL_TEST};
+
 install2::main(@ARGV);
  
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 3c70564df..a1645d07a 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -2,7 +2,7 @@ package install2;
 
 use diagnostics;
 use strict;
-use vars qw($testing $INSTALL_VERSION $o);
+use vars qw($o);
 
 use common qw(:common :file :system);
 use install_any qw(:all);
@@ -19,9 +19,6 @@ use pkgs;
 use smp;
 use lang;
 
-$::testing = $ENV{PERL_INSTALL_TEST};
-$INSTALL_VERSION = 0;
-
 my @installStepsFields = qw(text help skipOnCancel skipOnLocal prev next);
 my @installSteps = (
   selectLanguage => [ __("Choose your language"), "help", 0, 0 ],
@@ -42,7 +39,7 @@ my @installSteps = (
   addUser => [ __("Add a user"), __("help"), 0, 0 ],
   createBootdisk => [ __("Create bootdisk"), __("help"), 0, 1 ],
   setupBootloader => [ __("Install bootloader"), __("help"), 0, 1 ],
-#  configureX => [ __("Configure X"), __("help"), 0, 0 ],
+  configureX => [ __("Configure X"), __("help"), 0, 0 ],
   exitInstall => [ __("Exit install"), __("help"), 0, 0, undef, 'done' ],
 );
 
@@ -97,10 +94,10 @@ my $default = {
     rootPassword => 'toto',
     lang => 'fr',
     isUpgrade => 0,
-    installClass => 'Server',
+    installClass => 'newbie',
     bootloader => { onmbr => 1, linear => 0 },
     mkbootdisk => 0,
-    base => [ qw(basesystem console-tools mkbootdisk linuxconf anacron linux_logo rhs-hwdiag utempter ldconfig chkconfig ntsysv mktemp setup setuptool filesystem MAKEDEV SysVinit ash at authconfig bash bdflush binutils console-tools crontabs dev e2fsprogs ed etcskel file fileutils findutils getty_ps gpm grep groff gzip hdparm info initscripts isapnptools kbdconfig kernel less ldconfig lilo logrotate losetup man mkinitrd mingetty modutils mount net-tools passwd procmail procps psmisc mandrake-release rootfiles rpm sash sed setconsole setserial shadow-utils sh-utils slocate stat sysklogd tar termcap textutils time timeconfig tmpwatch util-linux vim-minimal vixie-cron which) ],
+    base => [ qw(basesystem initscripts console-tools mkbootdisk linuxconf anacron linux_logo rhs-hwdiag utempter ldconfig chkconfig ntsysv mktemp setup setuptool filesystem MAKEDEV SysVinit ash at authconfig bash bdflush binutils console-tools crontabs dev e2fsprogs ed etcskel file fileutils findutils getty_ps gpm grep groff gzip hdparm info initscripts isapnptools kbdconfig kernel less ldconfig lilo logrotate losetup man mkinitrd mingetty modutils mount net-tools passwd procmail procps psmisc mandrake-release rootfiles rpm sash sed setconsole setserial shadow-utils sh-utils slocate stat sysklogd tar termcap textutils time timeconfig tmpwatch util-linux vim-minimal vixie-cron which) ],
     packages => [ qw() ],
     partitionning => { clearall => $::testing, eraseBadPartitions => 1, autoformat => 1 },
     partitions => [
@@ -128,6 +125,7 @@ sub selectPath {
 
 sub selectInstallClass {
     $o->{installClass} = $o->selectInstallClass(@install_classes);
+    $::expert = $o->{installClass} eq "expert";
 }
 
 sub setupSCSI {
@@ -220,7 +218,7 @@ sub setupBootloader {
     $o->{isUpgrade} or modules::read_conf("$o->{prefix}/etc/conf.modules");
     $o->setupBootloader;
 }
-sub configureX { $o->setupXfree }
+sub configureX { $o->setupXfree if $o->{packages}->{XFree86}->{installed} }
 sub exitInstall { $o->exitInstall }
 
 
@@ -232,7 +230,7 @@ sub main {
 
     print STDERR "in second stage install\n";
     log::openLog(($::testing || $o->{localInstall}) && 'debug.log');
-    log::l("second stage install running (version $INSTALL_VERSION)");
+    log::l("second stage install running");
     log::ld("extra log messages are enabled");
 
     $o->{prefix} = $::testing ? "/tmp/test-perl-install" : "/mnt";
@@ -245,6 +243,9 @@ sub main {
     spawnSync();
     eval { spawnShell() };
 
+    # needed very early for install_steps_graphical
+    @{$o->{mouse}}{"xtype", "device"} = install_any::mouse_detect() unless $::testing;
+
     $o = install_steps_graphical->new($o);
 
     $o->{netc} = net::readNetConfig("/tmp");
@@ -258,17 +259,15 @@ sub main {
 
     for (my $step = $o->{steps}->{first}; $step ne 'done'; $step = getNextStep($step)) {
 	$o->enteringStep($step);
-	#eval { 
+	eval { 
 	    &{$install2::{$step}}();
-	#};
+	};
 	$o->errorInStep($@) if $@;
 	$o->leavingStep($step);
     }
     killCardServices();
 
     log::l("installation complete, leaving");
-
-    <STDIN> unless $::testing;
 }
 
 sub killCardServices { 
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index dd9bcd4de..d299b8bfc 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -86,10 +86,15 @@ sub spawnShell {
 }
 
 sub mouse_detect() {
-    my ($type, $dev) = split("\n", `./mouseconfig --nointeractive 2>/dev/null`) or die "mouseconfig failed";
+    my ($type, $dev) = split("\n", `mouseconfig --nointeractive 2>/dev/null`) or die "mouseconfig failed";
     $type, $dev;
 }
 
+sub shells($) {
+    my ($o) = @_;
+    grep { -x "$o->{prefix}$_" } @{$o->{default}->{shells}};
+}
+
 sub upgrFindInstall {
 #    int rc;
 #
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index a80807c1b..827039c41 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -198,13 +198,6 @@ sub setupBootloader($) {
 
 sub setupXfree {
     my ($o) = @_;
-    my $x = $o->{default}->{Xserver} or return;
-    $o->{packages}->{$x} or die "can't find X server $x";
-
-    log::l("I will install the $x package");
-    pkgs::install($o->{prefix}, $o->{packages}->{$x}, $o->{isUpgrade}, 0);
-
-    #TODO
 }
 
 sub exitInstall {}
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index f3fabc985..2ea2d84b8 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -33,13 +33,13 @@ use lang;
 use log;
 
 1;
+=cut
 
 sub errorInStep($$) {
     my ($o, $err) = @_;
     $o->ask_warn(_("Error"), [ _("An error occured"), $err ]);
 }
 
-=cut
 sub chooseLanguage($) {
     my ($o) = @_;
     lang::text2lang($o->ask_from_list("Language",
@@ -79,20 +79,6 @@ sub choosePartitionsToFormat($$) {
     }
 }
 
-sub installPackages {
-    my $o = shift;
-
-    my $old = \&log::ld;
-    local *log::ld = sub { 
-	my $m = shift;
-	if ($m =~ /^starting installing/) {
-	    my $name = first($_[0] =~ m|([^/]*)-.+?-|);
-	    print("installing package $name");
-	} else { goto $old }
-    };    
-    $o->SUPER::installPackages(@_);
-}
-
 sub createBootdisk($) {
     my ($o) = @_;
     
@@ -114,7 +100,7 @@ sub setupBootloader($) {
     
     $o->SUPER::setupBootloader;
 }
-=cut
+
 sub exitInstall { 
     my ($o) = @_;
     $o->ask_warn('',
@@ -126,3 +112,4 @@ Information on configuring your system is available in the post
 install chapter of the Official Linux Mandrake User's Guide.");
 }
 
+=cut
diff --git a/perl-install/install_steps_stdio.pm b/perl-install/install_steps_stdio.pm
index 908d14080..f5b05a0f1 100644
--- a/perl-install/install_steps_stdio.pm
+++ b/perl-install/install_steps_stdio.pm
@@ -66,7 +66,7 @@ sub addUser($) {
     } until ($w{password} eq $o->readln());
     print "Real name: "; $w{realname} = $o->readln();
     
-    $w{shell} = $o->ask_from_list('', 'Shell', $o->{default}->{shells}, "/bin/bash");
+    $w{shell} = $o->ask_from_list('', 'Shell', [ install_any::shells($o) ], "/bin/bash");
     
     $o->{default}->{user} = { map { $_ => $w{$_}->get_text } qw(name password realname shell) };
     $o->SUPER::addUser;
diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm
index 65b3c895b..76ed30345 100644
--- a/perl-install/interactive.pm
+++ b/perl-install/interactive.pm
@@ -49,5 +49,10 @@ sub ask_many_from_list($$$$;$) {
     $o->ask_many_from_listW($title, $message, $l, $def);
 }
 
+sub ask_from_entry($$$;$) {
+    my ($o, $title, $message, $def) = @_;
 
+    $message = ref $message ? $message : [ $message ];
 
+    $o->ask_from_entryW($title, $message, $def);
+}
diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm
index e83e161cb..de58e765d 100644
--- a/perl-install/interactive_gtk.pm
+++ b/perl-install/interactive_gtk.pm
@@ -12,6 +12,11 @@ use my_gtk qw(:helpers :wrappers);
 
 1;
 
+sub ask_from_entryW {
+    my ($o, $title, $messages, $def) = @_;
+    my_gtk::ask_from_entry($title, @$messages);
+}
+
 sub ask_from_listW {
     my ($o, $title, $messages, $l, $def) = @_;
 
diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm
index fbd5a57df..11d29f981 100644
--- a/perl-install/partition_table.pm
+++ b/perl-install/partition_table.pm
@@ -2,7 +2,7 @@ package partition_table;
 
 use diagnostics;
 use strict;
-use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @important_types);
+use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @important_types @fields2save);
 
 @ISA = qw(Exporter);
 %EXPORT_TAGS = (
@@ -18,6 +18,9 @@ use Data::Dumper;
 
 @important_types = ("Linux native", "Linux swap", "DOS FAT16", "Win98 FAT32");
 
+@fields2save = qw(primary extended totalsectors);
+
+
 my %types = (
   0 => "Empty",
   1 => "DOS 12-bit FAT",
@@ -76,8 +79,6 @@ my %type2fs = (
 my %types_rev = reverse %types;
 my %fs2type = reverse %type2fs;
 
-my @fields2save = qw(primary extended totalsectors);
-
 
 1;
 
@@ -135,28 +136,74 @@ sub verifyInside($$) {
     $b->{start} <= $a->{start} && $a->{start} + $a->{size} <= $b->{start} + $b->{size};
 }
 
+sub verifyPrimary($) {
+    my ($pt) = @_;
+    my @l = (@{$pt->{normal}}, $pt->{extended});
+    foreach my $i (@l) { foreach (@l) {
+	$i != $_ and verifyNotOverlap($i, $_) || die "partitions $i->{start} $i->{size} and $_->{start} $_->{size} are overlapping!";
+    }}
+}
+
 sub assign_device_numbers($) {
     my ($hd) = @_;
 
-    my $i = 1; foreach (@{$hd->{primary}->{raw}}, map { $_->{normal} } @{$hd->{extended}}) { 
-	$_->{device} = $hd->{prefix} . $i++;
-    }
+    my $i = 1; 
+    $_->{device} = $hd->{prefix} . $i++ foreach @{$hd->{primary}->{raw}}, 
+                                                map { $_->{normal} } @{$hd->{extended} || []};
 
     # try to figure what the windobe drive letter could be!
     #
     # first verify there's at least one primary dos partition, otherwise it
     # means it is a secondary disk and all will be false :(
-    my ($c, @others) = grep { isDos($_) || isWin($_) } @{$hd->{primary}->{raw}};
+    my ($c, @others) = grep { isDos($_) || isWin($_) } @{$hd->{primary}->{normal}};
     $c or return;
 
     $i = ord 'D';
-    foreach (grep { isDos($_) || isWin($_) } @{$hd->{extended}}) {
+    foreach (grep { isDos($_) || isWin($_) } map { $_->{normal} } @{$hd->{extended}}) {
 	$_->{device_windobe} = chr($i++);
     }
     $c->{device_windobe} = 'C';
     $_->{device_windobe} = chr($i++) foreach @others;
 }
 
+sub remove_empty_extended($) {
+    my ($hd) = @_;
+    my $last = $hd->{primary}->{extended} or return;
+    @{$hd->{extended}} = grep {
+	if ($_->{normal}) {
+	    $last = $_;
+	} else {
+	    %{$last->{extended}} = $_->{extended} ? %{$_->{extended}} : ();
+	}
+	$_->{normal};
+    } @{$hd->{extended}};
+    adjust_main_extended($hd);
+}
+
+sub adjust_main_extended($) {
+    my ($hd) = @_;
+
+    if (!is_empty_array_ref $hd->{extended}) {
+	my ($l, @l) = @{$hd->{extended}};
+
+	# the first is a special case, must recompute its real size
+	my $start = round_down($l->{normal}->{start} - 1, cylinder_size($hd));
+	my $end = $l->{normal}->{start} + $l->{normal}->{size};
+	foreach (map $_->{normal}, @l) {
+	    $start = min($start, $_->{start});
+	    $end = max($end, $_->{start} + $_->{size});
+	}
+	$l->{start} = $hd->{primary}->{extended}->{start} = $start;
+	$l->{size} = $hd->{primary}->{extended}->{size} = $end - $start;
+    }
+    unless (@{$hd->{extended}} || !$hd->{primary}->{extended}) {
+	%{$hd->{primary}->{extended}} = (); # modify the raw entry
+	delete $hd->{primary}->{extended};
+    }
+    verifyPrimary($hd->{primary}); # verify everything is all right
+}
+
+
 sub get_normal_parts($) {
     my ($hd) = @_;
 
@@ -180,21 +227,20 @@ sub read_one($$) {
 
 sub read($;$) {
     my ($hd, $clearall) = @_;
-    my $pt = $clearall ? { raw => [ {}, {}, {}, {} ] } : read_one($hd, 0) || return 0;
+    my $pt = $clearall ? 
+      partition_table_raw::clear_raw() : 
+      read_one($hd, 0) || return 0;
 
     $hd->{primary} = $pt;
     $hd->{extended} = undef;
     $clearall and return $hd->{isDirty} = $hd->{needKernelReread} = 1;
-
-    my @l = (@{$pt->{normal}}, $pt->{extended});
-    foreach my $i (@l) { foreach (@l) {
-	$i != $_ and verifyNotOverlap($i, $_) || die "partitions $i->{device} and $_->{device} are overlapping!";
-    }}
+    verifyPrimary($pt);
 
     eval {
 	$pt->{extended} and read_extended($hd, $pt->{extended}) || return 0;
     }; die "extended partition: $@" if $@;
     assign_device_numbers($hd);
+    remove_empty_extended($hd);
     1;
 }
 
@@ -222,7 +268,7 @@ sub read_extended($$) {
     1;
 }
 
-# give a hard drive hd, write the partition data 
+# write the partition table
 sub write($) {
     my ($hd) = @_;
 
@@ -266,67 +312,105 @@ sub remove($$) {
     $i = 0; foreach (@{$hd->{primary}->{normal}}) {
 	if ($_ eq $part) {
 	    splice(@{$hd->{primary}->{normal}}, $i, 1);
-	    %$_ = ();
+	    %$_ = (); # blank it
 
 	    return $hd->{isDirty} = $hd->{needKernelReread} = 1;
 	}
 	$i++;
     }
     # otherwise search it in extended partitions
-    my $last = $hd->{primary}->{extended};
-    $i = 0; foreach (@{$hd->{extended}}) {
-	if ($_->{normal} eq $part) {
-	    %{$last->{extended}} = $_->{extended} ? %{$_->{extended}} : ();
-	    splice(@{$hd->{extended}}, $i, 1);
-	    
-	    unless (@{$hd->{extended}}) {
-		%{$hd->{primary}->{extended}} = ();
-		delete $hd->{primary}->{extended};
-	    }
+    foreach (@{$hd->{extended}}) {
+	$_->{normal} eq $part or next;
 
-	    return $hd->{isDirty} = $hd->{needKernelReread} = 1;
-	}
-	$last = $_;
-	$i++;
+	delete $_->{normal}; # remove it
+	remove_empty_extended($hd);
+
+	return $hd->{isDirty} = $hd->{needKernelReread} = 1;
     }
     0;
 }
 
 # create of partition at starting at `start', of size `size' and of type `type' (nice comment, uh?)
-# !be carefull!, no verification is done (start -> start+size must be free)
-sub add($$) {
+sub add_primary($$) {
     my ($hd, $part) = @_;
 
-    $part->{notFormatted} = 1;
-    $part->{isFormatted} = 0;
-    $part->{rootDevice} = $hd->{device};
-    $hd->{isDirty} = $hd->{needKernelReread} = 1;
-    adjustStartAndEnd($hd, $part);
-
-    if (is_empty_array_ref($hd->{primary}->{normal})) {
+    {
+	local $hd->{primary}->{normal}; # save it to fake an addition of $part, that way add_primary do not modify $hd if it fails
+	push @{$hd->{primary}->{normal}}, $part;
+	adjust_main_extended($hd); # verify
 	raw_add($hd->{primary}->{raw}, $part);
-	@{$hd->{primary}->{normal}} = $part;
-    } else {
-	$hd->{primary}->{extended} && !verifyInside($part, $hd->{primary}->{extended})
-	  and die "sorry, can't add outside the main extended partition";
-
-	foreach (@{$hd->{extended}}) {
-	    $_->{normal} and next;
-	    raw_add($_->{raw}, $part);
-	    $_->{normal} = $part;
-	    return;
+    }
+    push @{$hd->{primary}->{normal}}, $part; # really do it
+}
+
+sub add_extended($$) {
+    my ($hd, $part) = @_;
+
+    my $e = $hd->{primary}->{extended};
+
+    if ($e && !verifyInside($part, $e)) {
+	#ie "sorry, can't add outside the main extended partition" unless $::unsafe;
+	my $end = $e->{start} + $e->{size};
+	my $start = min($e->{start}, $part->{start});
+	$end = max($end, $part->{start} + $part->{size}) - $start;
+	
+	{ # faking a resizing of the main extended partition to test for problems
+	    local $e->{start} = $start;
+	    local $e->{size} = $end - $start;
+	    eval { verifyPrimary($hd->{primary}) };
+	    $@ and die
+_("You have a hole in your partition table but I can't use it.
+The only solution is to move your primary partitions to have the hole next to the extended partitions");
 	}
+    }
+
+    if ($e && $part->{start} < $e->{start}) {
+
+	my $l = first (@{$hd->{extended}});
+
+	# the first is a special case, must recompute its real size
+	$l->{start} = round_down($l->{normal}->{start} - 1, cylinder_size($hd));
+	$l->{size} = $l->{normal}->{start} + $l->{normal}->{size} - $l->{start};
+	my $ext = { %$l };
+	unshift @{$hd->{extended}}, { type => 5, raw => [ $part, $ext, {}, {} ], normal => $part, extended => $ext };
+	# size will be autocalculated :)
+    } else {
+
 	my ($ext, $ext_size) = is_empty_array_ref($hd->{extended}) ?
-	  ($hd->{primary}, $hd->{totalsectors} - $part->{start}) :
+	  ($hd->{primary}, -1) : # -1 size will be computed by adjust_main_extended
 	  (top(@{$hd->{extended}}), $part->{size});
 	my %ext = ( type => 5, start => $part->{start}, size => $ext_size );
-	
+    
 	raw_add($ext->{raw}, \%ext);
 	$ext->{extended} = \%ext;
 	push @{$hd->{extended}}, { %ext, raw => [ $part, {}, {}, {} ], normal => $part };
+    }
+    $part->{start}++; $part->{size}--; # let it start after the extended partition sector
+    adjustStartAndEnd($hd, $part);
 
-	$part->{start}++; $part->{size}--; # let it start after the extended partition sector
-	adjustStartAndEnd($hd, $part);
+    adjust_main_extended($hd);
+}
+
+sub add($$;$) {
+    my ($hd, $part, $want_primary) = @_;
+
+    $part->{notFormatted} = 1;
+    $part->{isFormatted} = 0;
+    $part->{rootDevice} = $hd->{device};
+    $hd->{isDirty} = $hd->{needKernelReread} = 1;
+    $part->{start} ||= 1; # starting at sector 0 is not allowed
+    adjustStartAndEnd($hd, $part);
+
+    my $e = $hd->{primary}->{extended};
+
+    if (is_empty_array_ref($hd->{primary}->{normal}) || $want_primary) {
+	eval { add_primary($hd, $part) };
+	return unless $@;
+    }
+    eval { add_extended($hd, $part) }; # try adding extended
+    if (my $err = $@) {
+	eval { add_primary($hd, $part) };
+	die $@ if $@; # send the add extended error which should be better
     }
 }
 
@@ -366,30 +450,30 @@ sub load($$;$) {
 
     my $h;
     {
-	no strict 'vars';
-	$h = eval join '', <F>;
+	local $/ = "\0";
+	eval <F>;
     }
     $@ and die _("Restoring from file %s failed: %s", $file, $@);
 
-    ref $h eq 'HASH' or die _("Bad backup file");
+    ref $h eq 'ARRAY' or die _("Bad backup file");
 
-    $h->{totalsectors} == $hd->{totalsectors} or $force 
-      or die "Bad totalsectors";
+    my %h; @h{@fields2save} = @$h;
+
+    $h{totalsectors} == $hd->{totalsectors} or $force or die "Bad totalsectors";
 
     # unsure we don't modify totalsectors
-    $h->{totalsectors} = $hd->{totalsectors} if $force;
+    local $hd->{totalsectors};
 
-    @{$hd}{@fields2save} = @{$h}{@fields2save};
+    @{$hd}{@fields2save} = @$h;
 
     $hd->{isDirty} = $hd->{needKernelReread} = 1;
 }
 
-
 sub save($$) {
     my ($hd, $file) = @_;
-    my %h; @h{@fields2save} = @{$hd}{@fields2save};
+    my @h = @{$hd}{@fields2save};
     local *F;
     open F, ">$file"
-      and print F Dumper(\%h) 
+      and print F Data::Dumper->Dump([\@h], ['$h']), "\0" 
       or die _("Error writing to file %s", $file);
 }
diff --git a/perl-install/partition_table_raw.pm b/perl-install/partition_table_raw.pm
index 973961f5a..67223e392 100644
--- a/perl-install/partition_table_raw.pm
+++ b/perl-install/partition_table_raw.pm
@@ -98,4 +98,10 @@ sub write($$$) {
     syswrite F, $magic, length $magic or return 0;
     1;
 }
-sub zero_MBR($) { &write($_[0], 0, [ {} x $nb_primary ]); }
+
+sub clear_raw { { raw => [ ({}) x $nb_primary ] } }
+
+sub zero_MBR($) { 
+    $_[0]->{primary} = clear_raw();
+    delete $_[0]->{extended};
+}
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 0ad16d1b0..22256af4e 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -34,7 +34,7 @@ sub select($$;$) {
 	my $n = shift @l;
 	$n =~ /|/ and $n = first(split '\|', $n); #TODO better handling of choice
 	my $i = Package($packages, $n);
-	$i->{base} = $base;
+	$i->{base} ||= $base;
 	$i->{deps} or log::l("missing deps for $n");
 	push @l, @{$i->{deps} || []} unless $i->{selected};
 	$i->{selected}++ unless $i->{selected} == -1;
@@ -42,6 +42,7 @@ sub select($$;$) {
 }
 sub unselect($$) {
     my ($packages, $p) = @_;
+    $p->{base} and return;
     my $set = set_new($p->{name});
     my $l = $set->{list};
 
@@ -57,7 +58,7 @@ sub unselect($$) {
 	my $n = shift @$l;
 	my $i = Package($packages, $n);
 
-	$i->{selected} <= 0 and next;
+	$i->{selected} <= 0 || $i->{base} and next;
 	if (--$i->{selected} == 0) {
 	    push @$l, @{$i->{deps} || []};
 	}
@@ -121,6 +122,7 @@ sub getDeps($) {
     open F, install_any::imageGetFile("depslist") or die "can't find dependencies list";
     foreach (<F>) {
 	my ($name, $size, @deps) = split;
+	$packages->{$name} or next;
 	$packages->{$name}->{size} = $size;
 	$packages->{$name}->{deps} = \@deps;
 	map { push @{$packages->{$_}->{provides}}, $name } @deps;
@@ -160,6 +162,7 @@ sub setCompssSelected($$$) {
     my $L = uc $l;
 
     my $verif_lang = sub {
+	local $SIG{__DIE__} = 'none';
 	$_[0] =~ /-([^-]*)$/;
 	$1 eq $ENV{LANG} || eval { lang::text2lang($1) eq $ENV{LANG} } && !$@;
     };
@@ -252,6 +255,7 @@ sub install {
     my ($total, $nb);
 
     foreach my $p (@$toInstall) {
+	$p->{installed} = 1;
 	c::rpmtransAddPackage($trans, getHeader($p), $p->{file}, $isUpgrade);
 	$nb++;
 	$total += $p->{size};
diff --git a/perl-install/share/list b/perl-install/share/list
index 83ca02797..2a5c7f5d3 100644
--- a/perl-install/share/list
+++ b/perl-install/share/list
@@ -14,11 +14,14 @@
 /usr/lib/perl5/5.00503/SelfLoader.pm
 /usr/lib/perl5/5.00503/Term/Cap.pm
 /usr/lib/perl5/5.00503/Term/ReadLine.pm
+/usr/lib/perl5/5.00503/Data/Dumper.pm
 /usr/lib/perl5/5.00503/diagnostics.pm
 /usr/lib/perl5/5.00503/dumpvar.pl
 /usr/lib/perl5/5.00503/i386-linux/Config.pm
 /usr/lib/perl5/5.00503/i386-linux/DynaLoader.pm
 /usr/lib/perl5/5.00503/i386-linux/Socket.pm
+/usr/lib/perl5/5.00503/i386-linux/auto/Data/Dumper/Dumper.bs
+/usr/lib/perl5/5.00503/i386-linux/auto/Data/Dumper/Dumper.so
 /usr/lib/perl5/5.00503/i386-linux/auto/Socket/Socket.bs
 /usr/lib/perl5/5.00503/i386-linux/auto/Socket/Socket.so
 /usr/lib/perl5/5.00503/i386-linux/bits/syscall.ph
@@ -29,6 +32,7 @@
 /usr/lib/perl5/5.00503/lib.pm
 /usr/lib/perl5/5.00503/perl5db.pl
 /usr/lib/perl5/5.00503/pod/perldiag.pod
+/usr/lib/perl5/5.00503/overload.pm
 /usr/lib/perl5/5.00503/strict.pm
 /usr/lib/perl5/5.00503/vars.pm
 /usr/lib/perl5/site_perl/5.005/i386-linux/Gtk.pm