no_comment

33 files changed, 928 insertions, 461 deletions

diff --git a/perl-install/Makefile b/perl-install/Makefile
index 71e122a49..b85b2d198 100644
--- a/perl-install/Makefile
+++ b/perl-install/Makefile
@@ -1,17 +1,20 @@
-VERSION = 2.2.11-1mdkBOOT
+VERSION = 2.2.10-BOOT
 SO_FILES = c/blib/arch/auto/c/c.so
-PMS = *.pm c/*.pm resize_fat/*.pm po/*.pm pci_probing/*.pm commands install2 diskdrake
+PMS = *.pm c/*.pm resize_fat/*.pm po/*.pm pci_probing/*.pm commands install2 diskdrake XFdrake
 ROOTDEST = /export
-DEST = $(ROOTDEST)/Mandrake/instimage
+DEST = $(ROOTDEST)/Mandrake/mdkinst
 DESTREP4PMS = $(DEST)/usr/bin/perl-install
 PERL = perl
 LOCALFILES = $(PERL) mouseconfig
 DIRS = po pci_probing
 EXCLUDE = $(LOCALFILES) boot.img keymaps xmodmaps consolefonts install
 
-.PHONY: all $(DIRS) tags install clean verify_c
+CFLAGS	= -Wall
+override CFLAGS  += -pipe
 
-all: $(SO_FILES) $(DIRS) install1_hd
+.PHONY: all $(DIRS) tags install clean stage2 full_stage2 verify_c
+
+all: $(SO_FILES) $(DIRS)
 
 tags:
 	etags -o - $(PMS) | perl2etags > TAGS
@@ -19,16 +22,14 @@ tags:
 clean:
 	test ! -e c/Makefile || $(MAKE) -C c clean
 	for i in $(DIRS); do $(MAKE) -C $$i clean; done
-	rm -f c/c.xs install1_hd gendepslist
+	rm -f c/c.xs gendepslist
 	find . -name "*~" -o -name "TAGS" -o -name "*.old" | xargs rm -f
 
 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
+floppy:
+	dd if=/dev/zero of=/tmp/initrd bs=1k count=2000 ; echo y | mke2fs /tmp/initrd ; mount /tmp/initrd /mnt/disk/ -o loop ; cp -a ../install1/* /mnt/disk/ ; umount /mnt/disk ; gzip -c /tmp/initrd > /tmp/initrd.img ; mcopy -o /tmp/initrd.img a:
 
 tar-diskdrake: clean
 	cd .. ; rm -rf diskdrake ; cp -af perl-install diskdrake
@@ -51,9 +52,6 @@ $(SO_FILES): c/c.xs
 	test -e c/Makefile || (cd c; export C_RPM=1 ; perl Makefile.PL)
 	$(MAKE) -C c
 
-install1_hd: install1_hd.c
-	$(CC) -static -Wall -o $@ $<
-
 $(DIRS):
 	$(MAKE) -C $@
 
@@ -80,7 +78,7 @@ install_pms: all
 		perl -ne 'print #unless /^use (diagnostics|vars|strict)/' $$i > $(DESTREP4PMS)/$$i; \
 	done
 
-	cp diskdrake.rc install.rc $(DESTREP4PMS)
+	cp *.rc $(DESTREP4PMS)
 	ln -sf perl-install/install2 $(DEST)/usr/bin
 	ln -sf perl-install/commands $(DEST)/usr/bin
 	chmod a+x $(DESTREP4PMS)/install2
@@ -111,7 +109,7 @@ get_needed_files: $(SO_FILES)
 		  d=`echo $(DEST)/$$i | sed 's/\/usr\/local\//\/usr\//'`; \
 		  install -d `dirname $$d` && \
 		  if (echo $$i | grep -q "\.pm"); then \
-		     perl -pe '$$_ eq "__END__" and exit(0);' $$i > $$d; \
+		     perl -pe '$$_ =~ /^__END__/ and exit(0);' $$i > $$d; \
 		  else \
 		  	  cp -f $$i $$d; \
 			  strip $$d 2>/dev/null || true; \
@@ -122,21 +120,21 @@ get_needed_files: $(SO_FILES)
 	mv -f $(DEST)/bin/* $(DEST)/sbin/* $(DEST)/usr/bin
 	rmdir $(DEST)/bin $(DEST)/sbin
 
-	ln -s ash $(DEST)/usr/bin/sh
+	ln -sf ash $(DEST)/usr/bin/sh
 
-	install -d $(DEST)/usr/X11R6/lib/X11/fonts/
-	cp -a /usr/X11R6/lib/X11/fonts/misc $(DEST)/usr/X11R6/lib/X11/fonts/
+	install -d $(DEST)/usr/X11R6/lib/X11/fonts/75dpi
+	install -d $(DEST)/usr/X11R6/lib/X11/fonts/misc
+	cd /usr/X11R6/lib/X11/fonts/75dpi ; cp -a fonts.* helvR* $(DEST)/usr/X11R6/lib/X11/fonts/75dpi
+	cd /usr/X11R6/lib/X11/fonts/misc ; cp -a fonts.* cursor.pcf.gz 6x13.pcf.gz $(DEST)/usr/X11R6/lib/X11/fonts/misc
 
 	cp -a xmodmaps $(DEST)/usr/share
 	cp -a keymaps $(DEST)/usr/share
 	cp -a consolefonts $(DEST)/usr/share
 	cp MonitorsDB $(DEST)/usr/share
+	cp logo-mandrake.xpm $(DEST)/usr/share
 	cp compss $(ROOTDEST)/Mandrake/base
 
-	install -d $(DEST)/lib/modules
-	(cd /lib/modules/$(VERSION) ; \
-	 cp `find -name "*.o"` $(DEST)/lib/modules ; \
-	 /sbin/depmod -m /boot/System.map-$(VERSION) -i -e *.o | grep ': ' | sed 's/\.o//g' > $(DEST)/lib/modules/modules.dep)
+	cp -f ../modules/modules.cpio.bz2 $(DEST)/lib/
 
 	ln -s install2 $(DEST)/usr/bin/runinstall2
 #	echo -e "#!/bin/sh\n\nexec '/usr/bin/sh'" > $(DEST)/usr/bin/runinstall2
@@ -158,7 +156,7 @@ full_stage2:
 stage2:
 	$(MAKE) install_pms
 #	cd $(ROOTDEST) ; tar cfz /tmp/instimage-full.tgz Mandrake
-#	cd $(ROOTDEST) ; tar cfz /tmp/instimage-light.tgz Mandrake/base/compss Mandrake/instimage/usr/[bl]*
+#	cd $(ROOTDEST) ; tar cfz /tmp/instimage-light.tgz Mandrake/base/compss Mandrake/mdkinst/usr/[bl]*
 
 	@#rm -rf /mnt/initrd/*
 	@#cp -a $(DEST)/* /mnt/initrd
@@ -167,6 +165,7 @@ stage2:
 
 # function f() { grep "$*" /usr/include/*.h /usr/include/*/*.h; }
 
-# dd if=/dev/zero of=/tmp/initrd bs=1k count=2000 ; echo y | mke2fs /tmp/initrd ; mount /tmp/initrd /mnt/disk/ -o loop ; cd ~pixel/gi/perl-install ; install -s install/install install1/bin/install ; install -s installinit/init install1/bin/ ; cp -a install1/* /mnt/disk/ ; umount /mnt/disk ; gzip -c /tmp/initrd > /tmp/initrd.img ; mcopy -o /tmp/initrd.img a:
+# 
+# install -s install/install install1/bin/install ; install -s installinit/init install1/bin/init
 # mount /tmp/initrd /mnt/disk/ -o loop ;  ; umount /mnt/disk ; gzip -c /tmp/initrd > /tmp/initrd.img ; mcopy -o /tmp/initrd.img a:
 
diff --git a/perl-install/Xconfig.pm b/perl-install/Xconfig.pm
index 042388e85..248cf125f 100644
--- a/perl-install/Xconfig.pm
+++ b/perl-install/Xconfig.pm
@@ -18,15 +18,16 @@ sub keymap_translate {
 
 sub getinfo {
     my $o = {};
-    getinfoFromXF86Config($o);
+#    getinfoFromXF86Config($o);
     getinfoFromSysconfig($o);
 
-    unless ($o->{mouse}->{xtype}) {
+    unless ($o->{mouse}{xtype}) {
 	my ($type, $dev) = split("\n", `mouseconfig --nointeractive 2>/dev/null`) or die "mouseconfig failed";
-	$o->{mouse}->{xtype} ||= $type;
-	$o->{mouse}->{device} ||= "/dev/$dev";
+	$o->{mouse}{emulate3buttons} = 1;
+	$o->{mouse}{xtype} ||= $type;
+	$o->{mouse}{device} ||= "/dev/$dev";
     }
-    $o->{mouse}->{device} ||= "/dev/mouse" if -e "/dev/mouse";
+    $o->{mouse}{device} ||= "/dev/mouse" if -e "/dev/mouse";
     $o;
 }
 
@@ -34,16 +35,16 @@ sub getinfoFromXF86Config {
     my $o = shift || {};
     my (%c, $depth);
 
-    $o->{card}->{server} ||= $1 if readlink("/etc/X11/X") =~ /XF86_ (\w+)$/x; # /x for perl2fcalls
+    $o->{card}{server} ||= $1 if readlink("/etc/X11/X") =~ /XF86_ (\w+)$/x; # /x for perl2fcalls
     
     local *F;
     open F, "/etc/X11/XF86Config" or return {};
     foreach (<F>) {
 	if (/^Section "Keyboard"/ .. /^EndSection/) {
-	    $o->{keyboard}->{xkb_keymap} ||= $1 if /^\s*XkbLayout\s+"(.*?)"/;
+	    $o->{keyboard}{xkb_keymap} ||= $1 if /^\s*XkbLayout\s+"(.*?)"/;
 	} elsif (/^Section "Pointer"/ .. /^EndSection/) {
-	    $o->{mouse}->{xtype} ||= $1 if /^\s*Protocol\s+"(.*?)"/;
-	    $o->{mouse}->{device} ||= $1 if /^\s*Device\s+"(.*?)"/;
+	    $o->{mouse}{xtype} ||= $1 if /^\s*Protocol\s+"(.*?)"/;
+	    $o->{mouse}{device} ||= $1 if /^\s*Device\s+"(.*?)"/;
 	} elsif (my $i = /^Section "Device"/ .. /^EndSection/) {
 	    if ($i = 1 && $c{type} && $c{type} ne "Generic VGA") {
 		add2hash($o->{card} ||= {}, \%c);
@@ -56,19 +57,19 @@ sub getinfoFromXF86Config {
 		
 	    push @{$c{lines}}, $_ unless /(Section|Identifier|VideoRam|VendorName|BoardName)/;
 	} elsif (/^Section "Monitor"/ .. /^EndSection/) {
-	    $o->{monitor}->{type} ||= $1 if /^\s*Identifier\s+"(.*?)"/;
-	    $o->{monitor}->{hsyncrange} ||= $1 if /^\s*HorizSync\s+(.*)/;
-	    $o->{monitor}->{vsyncrange} ||= $1 if /^\s*VertRefresh\s+(.*)/;
-	    $o->{monitor}->{vendor} ||= $1 if /^\s*VendorName\s+"(.*?)"/;
-	    $o->{monitor}->{model} ||= $1 if /^\s*ModelName\s+"(.*?)"/;
+	    $o->{monitor}{type} ||= $1 if /^\s*Identifier\s+"(.*?)"/;
+	    $o->{monitor}{hsyncrange} ||= $1 if /^\s*HorizSync\s+(.*)/;
+	    $o->{monitor}{vsyncrange} ||= $1 if /^\s*VertRefresh\s+(.*)/;
+	    $o->{monitor}{vendor} ||= $1 if /^\s*VendorName\s+"(.*?)"/;
+	    $o->{monitor}{model} ||= $1 if /^\s*ModelName\s+"(.*?)"/;
 	} elsif (/^Section "Screen"/ .. /^EndSection/) {
-	    $o->{card}->{default_depth} ||= $1 if /^\s*DefaultColorDepth\s+(\d+)/;
+	    $o->{card}{default_depth} ||= $1 if /^\s*DefaultColorDepth\s+(\d+)/;
 	    if (my $i = /^\s*Subsection\s+"Display"/ .. /^\s*EndSubsection/) {
 		$depth = undef if $i == 1;
 		$depth = $1 if /^\s*Depth\s+(\d*)/;
 		if (/^\s*Modes\s+(.*)/) {
 		    my $a = 0;
-		    push @{$o->{card}->{depth}->{$depth || 8}},
+		    push @{$o->{card}{depth}{$depth || 8}},
 		        grep { $_->[0] >= 640 } map { [ /"(\d+)x(\d+)"/ ] } split ' ', $1;
 		}
 	    }
@@ -80,10 +81,10 @@ sub getinfoFromXF86Config {
 sub getinfoFromSysconfig {
     my $o = shift || {};
     if (my %mouse = getVarsFromSh "/etc/sysconfig/mouse") {
-	$o->{mouse}->{xtype} ||= $mouse{XMOUSETYPE};
+	$o->{mouse}{xtype} ||= $mouse{XMOUSETYPE};
     }
     if (my %keyboard = getVarsFromSh "/etc/sysconfig/keyboard") {
 	$keyboard{KEYTABLE} or last;
-	$o->{keyboard}->{xkb_keymap} ||= keymap_translate($keyboard{KEYTABLE});
+	$o->{keyboard}{xkb_keymap} ||= keymap_translate($keyboard{KEYTABLE});
     }
 }
diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm
index d39e58238..16ecde778 100644
--- a/perl-install/Xconfigurator.pm
+++ b/perl-install/Xconfigurator.pm
@@ -36,46 +36,50 @@ sub readCardsDB {
     local *F;
     open F, $file or die "file $file not found";
 
-    my $lineno = 0; foreach (<F>) { $lineno++;
+    my ($lineno, $cmd, $val) = 0;
+    my $fs = { 
+        LINE => sub { push @{$card->{lines}}, $val unless $val eq "VideoRam" },
+	NAME => sub {
+	    $cards{$card->{type}} = $card if $card;
+	    $card = { type => $val };
+	},
+	SEE => sub {
+	    my $c = $cards{$val} or die "Error in database, invalid reference $val at line $lineno";
+	    
+	    push @{$card->{lines}}, @{$c->{lines} || []};
+	    add2hash($card->{flags}, $c->{flags});
+	    add2hash($card, $c);
+	},
+	CHIPSET => sub { 
+	    $card->{chipset} = $val; 
+	    $card->{flags}{needVideoRam} = 1 if member($val, qw(mgag10 mgag200 RIVA128));
+	},
+	SERVER => sub { $card->{server} = $val; },
+	RAMDAC => sub { $card->{ramdac} = $val; },
+	DACSPEED => sub { $card->{dacspeed} = $val; },
+	CLOCKCHIP => sub { $card->{clockchip} = $val; $card->{flags}{noclockprobe} = 1; },
+	NOCLOCKPROBE => sub { $card->{flags}{noclockprobe} = 1 },
+	UNSUPPORTED => sub { $card->{flags}{unsupported} = 1 },
+	COMMENT => sub {},
+    };
+
+    foreach (<F>) { $lineno++;
 	s/\s+$//;
 	/^#/ and next;
 	/^$/ and next;
 	/^END/ and last;
 
-	my ($cmd, $val) = /(\S+)\s*(.*)/ or log::l("bad line $lineno ($_)"), next;
+	($cmd, $val) = /(\S+)\s*(.*)/ or log::l("bad line $lineno ($_)"), next;
 
-	my $f = $ {{ 
-	    LINE => sub { push @{$card->{lines}}, $val unless $val eq "VideoRam" },
-	    NAME => sub {
-		$cards{$card->{type}} = $card if $card;
-		$card = { type => $val };
-	    },
-	    SEE => sub {
-		my $c = $cards{$val} or die "Error in database, invalid reference $val at line $lineno";
-    
-		push @{$card->{lines}}, @{$c->{lines} || []};
-		add2hash($card->{flags}, $c->{flags});
-		add2hash($card, $c);
-	    },
-	    CHIPSET => sub { $card->{chipset} = $val; 
-			     $card->{flags}->{needVideoRam} = 1 if member($val, qw(mgag10 mgag200 RIVA128));
-			 },
-	    SERVER => sub { $card->{server} = $val; },
-	    RAMDAC => sub { $card->{ramdac} = $val; },
-	    DACSPEED => sub { $card->{dacspeed} = $val; },
-	    CLOCKCHIP => sub { $card->{clockchip} = $val; $card->{flags}->{noclockprobe} = 1; },
-	    NOCLOCKPROBE => sub { $card->{flags}->{noclockprobe} = 1 },
-	    UNSUPPORTED => sub { $card->{flags}->{unsupported} = 1 },
-	    COMMENT => sub {},
-	}}{$cmd};
+	my $f = $fs->{$cmd};
 
 	$f ? &$f() : log::l("unknown line $lineno ($_)");
     }
-    push @{$cards{S3}->{lines}}, $s3_comment;
-    push @{$cards{'CL-GD'}->{lines}}, $cirrus_comment;
+    push @{$cards{S3}{lines}}, $s3_comment;
+    push @{$cards{'CL-GD'}{lines}}, $cirrus_comment;
 
     # this entry is broken in X11R6 cards db 
-    $cards{I128}->{flags}->{noclockprobe} = 1;
+    $cards{I128}{flags}{noclockprobe} = 1;
 }
 
 sub readMonitorsDB {
@@ -156,7 +160,7 @@ sub cardConfiguration(;$$) {
     add2hash($card, { vendor => "Unknown", board => "Unknown" });
 
     $card->{prog} = "/usr/X11R6/bin/XF86_$card->{server}";
-    
+
     -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})";
 	
@@ -166,10 +170,10 @@ sub cardConfiguration(;$$) {
     }
 
     unless ($card->{type}) {
-	$card->{flags}->{noclockprobe} = member($card->{server}, qw(I128 S3 S3V Mach64));
+	$card->{flags}{noclockprobe} = member($card->{server}, qw(I128 S3 S3V Mach64));
     }
 
-    $card->{flags}->{needVideoRam} and
+    $card->{flags}{needVideoRam} and
       $card->{memory} ||= 
 	$videomemory{$in->ask_from_list_('', 
 					 _("Give your graphic card memory size"), 
@@ -198,9 +202,9 @@ sub testConfig($) {
     write_XF86Config($o, $tmpconfig);
 
     local *F;
-    open F, "$prefix$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*)/;
+	$o->{card}{memory} ||= $2 if /(videoram|Video RAM):\s*(\d*)/;
 
 	# look for clocks
 	push @$clocklines, $1 if /clocks: (.*)/ && !/(pixel |num)clocks:/;
@@ -216,13 +220,13 @@ sub testConfig($) {
 sub testFinalConfig($;$) {
     my ($o, $auto) = @_;
 
-    $o->{monitor}->{hsyncrange} && $o->{monitor}->{vsyncrange} or
+    $o->{monitor}{hsyncrange} && $o->{monitor}{vsyncrange} or
       $in->ask_warn('', _("Monitor not configured yet")), return;
 
-    $o->{card}->{server} or
+    $o->{card}{server} or
       $in->ask_warn('', _("Graphic card not configured yet")), return;
 
-    $o->{card}->{depth} or
+    $o->{card}{depth} or
       $in->ask_warn('', _("Resolutions not chosen yet")), return;
 
     rename("$prefix/etc/X11/XF86Config", "$prefix/etc/X11/XF86Config.old") || die "unable to make a backup of XF86Config" unless $::testing;
@@ -235,7 +239,7 @@ sub testFinalConfig($;$) {
 
     my $pid; unless ($pid = fork) {
 	my @l = "X";
-	@l = ($o->{card}->{prog}, "-xf86config", $tmpconfig) if $::testing;
+	@l = ($o->{card}{prog}, "-xf86config", $tmpconfig) if $::testing;
 	chroot $prefix if $prefix;
 	exec @l, ":9" or exit 1;
     }
@@ -266,8 +270,7 @@ sub testFinalConfig($;$) {
 	    $time-- or Gtk->main_quit;
 	});
 
-	exit (interactive_gtk->new->ask_yesorno('', [ _("Is this ok?"), $text ], 1) 
-                ? 0 : 222);
+	exit (interactive_gtk->new->ask_yesorno('', [ _("Is this ok?"), $text ], 1) ? 0 : 222);
     };
     my $rc = close F;
     my $err = $?;
@@ -298,10 +301,10 @@ You can switch if off if you want, you'll hear a beep when it's over")) or retur
 
 	my ($resolutions, $clocklines) = eval { testConfig($o) };
 	if ($@ || !$resolutions) {
-	    delete $card->{depth}->{$_};
+	    delete $card->{depth}{$_};
 	} else {
-	    $card->{clocklines} ||= $clocklines unless $card->{flags}->{noclockprobe};
-	    $card->{depth}->{$_} = [ @$resolutions ];
+	    $card->{clocklines} ||= $clocklines unless $card->{flags}{noclockprobe};
+	    $card->{depth}{$_} = [ @$resolutions ];
 	}
     }
 
@@ -373,7 +376,7 @@ sub chooseResolutions($$) {
     $depth_combo->set_popdown_strings(map { translate($depths{$_}) } ikeys(%{$card->{depth}}));
     $depth_combo->entry->signal_connect(changed => sub {
        $chosen_depth = $txt2depth{untranslate($depth_combo->entry->get_text, keys %txt2depth)};
-       my $w = $card->{depth}->{$chosen_depth}->[0][0];
+       my $w = $card->{depth}{$chosen_depth}[0][0];
        $chosen_w > $w and &$set($w2widget{$chosen_w = $w});
     });
     &$set_depth();
@@ -420,7 +423,7 @@ sub resolutionsConfiguration($$) {
     #						       _("Do you want to try?") ]);
     
     unless ($card->{depth}) {
-	$card->{depth}->{$_} = [ map { [ split "x" ] } @resolutions ] 
+	$card->{depth}{$_} = [ map { [ split "x" ] } @resolutions ] 
 	  foreach @depths;
 
 	if ($nowarning || (!$noauto && $in->ask_okcancel(_("Automatic resolutions"), 
@@ -432,12 +435,11 @@ Do you want to try?")))) {
     }
 
     # sort resolutions in each depth
-    { 
+    foreach (values %{$card->{depth}}) {
 	my $i;
 	@$_ = grep { first($i != $_->[0], $i = $_->[0]) }
-	      sort { $b->[0] <=> $a->[0] } @$_ 
-		foreach values %{$card->{depth}};
-    } 
+	  sort { $b->[0] <=> $a->[0] } @$_;
+    }
 
     # remove unusable resolutions (based on the video memory size)
     keepOnlyLegalModes($card);
@@ -448,11 +450,11 @@ Do you want to try?")))) {
     $auto or ($depth, $res) = chooseResolutions($card, $depth) or return;
 
     # needed in auto mode when all has been provided by the user
-    $card->{depth}->{$depth} or die "you fixed an unusable depth";
+    $card->{depth}{$depth} or die "you fixed an unusable depth";
 
     # remove all biggest resolution (keep the small ones for ctl-alt-+)
     # otherwise there'll be a virtual screen :(
-    $card->{depth}->{$depth} = [ grep { $_->[0] <= $res } @{$card->{depth}->{$depth}} ];
+    $card->{depth}{$depth} = [ grep { $_->[0] <= $res } @{$card->{depth}{$depth}} ];
     $card->{default_depth} = $depth;
     1;
 }
@@ -512,7 +514,7 @@ sub write_XF86Config {
     print F qq(    VertRefresh $O->{vsyncrange}\n);
     print F "\n";
     print F $monitorsection_text4;
-    print F ($o->{card}->{type} eq "TG 96" ? 
+    print F ($o->{card}{type} eq "TG 96" ? 
 	     $modelines_text_Trident_TG_96xx :
 	     $modelines_text);
     print F "EndSection\n\n\n";
@@ -525,7 +527,7 @@ sub write_XF86Config {
     print F qq(    VendorName  "$O->{vendor}"\n);
     print F qq(    BoardName   "$O->{board}"\n);
 
-    print F "#" if $O->{memory} && !$O->{flags}->{needVideoRam};
+    print F "#" if $O->{memory} && !$O->{flags}{needVideoRam};
     print F "    VideoRam    $O->{memory}\n" if $O->{memory};
 
     print F map { "    $_\n" } @{$O->{lines} || []};
@@ -551,7 +553,7 @@ sub write_XF86Config {
 Section "Screen"
     Driver "$server"
     Device      "$device"
-    Monitor     "$o->{monitor}->{type}"
+    Monitor     "$o->{monitor}{type}"
 );
 	print F "    DefaultColorDepth $defdepth\n" if $defdepth;
 
@@ -627,7 +629,7 @@ sub main {
            __("Change Graphic card") => sub { $o->{card} = cardConfiguration('', 'noauto') },
 	   __("Change Resolution") => sub { resolutionsConfiguration($o, 'noauto') },
 	   __("Automaticall resolutions search") => sub { 
-	       delete $o->{card}->{depth};
+	       delete $o->{card}{depth};
 	       resolutionsConfiguration($o, 'nowarning');
 	   },
 	   __("Test again") => sub { $ok = testFinalConfig($o, 1) },
diff --git a/perl-install/commands.pm b/perl-install/commands.pm
index 9b06743fa..4a4340f2f 100644
--- a/perl-install/commands.pm
+++ b/perl-install/commands.pm
@@ -246,25 +246,29 @@ sub cp {
     &$cp(@_);
 }
 
-#sub ps {
-#    @_ and die "usage: ps\n";
-#    my ($pid, $cmd);
-#
-#    local (*STDOUT_TOP, *STDOUT);
-#    format STDOUT_TOP =
-#  PID   CMD
-#.
-#    format =
-#@>>>>  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-#$pid, $cmd
-#.
-#
-#    foreach $pid (sort {$a <=> $b} grep { /\d+/ } all('/proc')) {
-#	 (($cmd) = cat_("/proc/$pid/cmdline")) =~ s/\0/ /g;
-#	 $cmd ||= (split ' ', (cat_("/proc/$pid/stat"))[0])[1];
-#	 write STDOUT
-#    }
-#}
+sub ps {
+    @_ and die "usage: ps\n";
+    my ($pid, $cpu, $cmd);
+    my $uptime = int first(cat_("/proc/uptime"));
+    my $hertz = 100;
+
+    local (*STDOUT_TOP);
+    format STDOUT_TOP =
+  PID   CMD
+.
+    format =
+@>>>>  @>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+$pid, $cpu, $cmd
+.
+
+    foreach $pid (sort {$a <=> $b} grep { /\d+/ } all('/proc')) {
+	 my @l = split(' ', cat_("/proc/$pid/stat"));
+	 $cpu = sprintf "%2.1f", max(0, min(99, ($l[13] + $l[14]) * 100 / $hertz / ($uptime - $l[21] / $hertz)));
+	 (($cmd) = cat_("/proc/$pid/cmdline")) =~ s/\0/ /g;
+	 $cmd ||= (split ' ', (cat_("/proc/$pid/stat"))[0])[1];
+	 write STDOUT;
+    }
+}
 
 
 sub dd {
diff --git a/perl-install/common.pm b/perl-install/common.pm
index 449efb922..90b02b82a 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -7,9 +7,9 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int
 @ISA = qw(Exporter);
 %EXPORT_TAGS = (
     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 warp_text) ],
-    functional => [ qw(fold_left difference2) ],
+    functional => [ qw(fold_left difference2 before_leaving catch_cdie cdie) ],
     file => [ qw(dirname basename touch all glob_ cat_ chop_ mode) ],
-    system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_ getVarsFromSh) ],
+    system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_ getVarsFromSh setVarsInSh) ],
     constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE) ],
 );
 @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
@@ -49,7 +49,7 @@ 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 } }
+sub set_add($@) { my $o = shift; foreach (@_) { exists $o->{hash}{$_} and next; push @{$o->{list}}, $_; $o->{hash}{$_} = undef } }
 
 sub sync { syscall_('sync') }
 sub gettimeofday { my $t = pack "LL"; syscall_('gettimeofday', $t, 0) or die "gettimeofday failed: $!\n"; unpack("LL", $t) }
@@ -75,6 +75,50 @@ sub fold_left(&$@) {
     $a
 }
 
+sub add_f4before_leaving {
+    my ($f, $b, $name) = @_;
+
+#    print "add_f4before_leaving\n";
+    unless ($common::before_leaving::{$name}) {
+	no strict 'refs';
+	${"common::before_leaving::$name"} = 1;
+	${"common::before_leaving::list"} = 1;
+    }
+    local *N = *{$common::before_leaving::{$name}};
+    my $list = *common::before_leaving::list;
+    $list->{$b}{$name} = $f;
+    *N = sub {
+	my $f = $list->{$_[0]}{$name} or die;
+	$name eq 'DESTROY' and delete $list->{$_[0]};
+	goto $f;
+    } unless defined &{*N};
+
+}
+
+# ! the functions are not called in the order wanted, in case of multiple before_leaving :(
+sub before_leaving(&) {
+    my ($f) = @_;
+    my $b = bless {}, 'common::before_leaving';
+    add_f4before_leaving($f, $b, 'DESTROY');
+    $b;
+}
+
+sub catch_cdie(&&) {
+    my ($f, $catch) = @_;
+
+    unshift @common::cdie_catches, $catch;
+    &$f();
+    shift @common::cdie_catches;
+}
+
+sub cdie {
+    $@ = join '', @_;
+    foreach (@common::cdie_catches) {
+	print;
+	&{$_}(@_) and return;
+    }
+    die @_;
+}
 
 sub all {
     my $d = shift;
@@ -164,3 +208,10 @@ sub getVarsFromSh($) {
     }
     %l;
 }
+
+sub setVarsInSh {
+    my ($file, $l, @fields) = @_;
+    local *F;
+    open F, "> $_[0]" or die "cannot create config file $file";
+    $l->{$_} and print F "$_=$l->{$_}\n" foreach @fields;
+}
diff --git a/perl-install/fs.pm b/perl-install/fs.pm
index 74b9f5448..860ab4ebd 100644
--- a/perl-install/fs.pm
+++ b/perl-install/fs.pm
@@ -12,6 +12,7 @@ use nfs;
 use swap;
 use detect_devices;
 use commands;
+use modules;
 
 1;
 
@@ -23,7 +24,7 @@ sub read_fstab($) {
     open F, $file or return;
     
     map {
-	my ($dev, $mntpoint, @l) = split ' ';
+	my ($dev, $mntpoint, @l) = split;
 	$dev =~ s,/(tmp|dev)/,,;
 	while (@l > 4) { $mntpoint .= " " . shift @l; }
 	{ device => $dev, mntpoint => $mntpoint, type => $l[0], options => $l[1] }
@@ -111,7 +112,13 @@ sub mount($$$;$) {
 
 	my $flag = 0;#c::MS_MGC_VAL();
 	$flag |= c::MS_RDONLY() if $rdonly;
-	my $mount_opt = $fs eq 'vfat' ? "check=relaxed" : "";
+	my $mount_opt = "";
+
+	if ($fs eq 'vfat') {
+	    $mount_opt = "check=relaxed";
+	    eval { modules::load('vfat') }; # try using vfat
+	    eval { modules::load('msdos') } if $@; # otherwise msdos...
+	}
   
 	log::l("calling mount($dev, $where, $fs, $flag, $mount_opt)");
 	syscall_('mount', $dev, $where, $fs, $flag, $mount_opt) or die _("mount failed: ") . "$!";
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index ac2126339..1cde1f847 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -174,7 +174,7 @@ sub removeFromList($$$) {
 sub allocatePartitions($$) {
     my ($hds, $to_add) = @_;
     my %free_sectors = map { $_->{device} => [1, $_->{totalsectors} ] } @$hds; # first sector is always occupied by the MBR
-    my $remove = sub { removeFromList($_[0]->{start}, $_[0]->{start} + $_[0]->{size}, $free_sectors{$_[0]->{rootDevice}}) };
+    my $remove = sub { removeFromList($_[0]{start}, $_[0]->{start} + $_[0]->{size}, $free_sectors{$_[0]->{rootDevice}}) };
     my $success = 0;
 
     foreach (get_fstab(@$hds)) { &$remove($_); }
@@ -217,6 +217,10 @@ sub undo_prepare($) {
 	push @{$_->{undo}}, Data::Dumper->Dump([\@h], ['$h']);
     }
 }
+sub undo_forget($) {
+    my ($hds) = @_;
+    pop @{$_->{undo}} foreach @$hds;
+}
 
 sub undo($) {
     my ($hds) = @_;
@@ -233,12 +237,12 @@ sub move {
 
     my $part2 = { %$part };
     $part2->{start} = $sector2;
-    $part2->{size} += partition_table::cylinder_size($hd2);
+    $part2->{size} += partition_table::cylinder_size($hd2) - 1;
     partition_table::remove($hd, $part);
     {
 	local ($part2->{notFormatted}, $part2->{isFormatted}); # do not allow partition::add to change this
 	partition_table::add($hd2, $part2);
-    }
+    }    
 
     return if $part2->{notFormatted} && !$part2->{isFormatted} || $::testing;
 
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 5a771acb7..98bf55d1b 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -7,7 +7,7 @@ use vars qw($o);
 use common qw(:common :file :system);
 use install_any qw(:all);
 use log;
-use net;
+use network;
 use keyboard;
 use fs;
 use fsedit;
@@ -20,64 +20,40 @@ use smp;
 use lang;
 use run_program;
 
-my @installStepsFields = qw(text help skipOnCancel skipOnLocal prev next);
+my @installStepsFields = qw(text help redoable onError needs);
 my @installSteps = (
-  selectLanguage => [ __("Choose your language"), "help", 0, 0 ],
+  selectLanguage => [ __("Choose your language"), "help", 1, 1 ],
   selectPath => [ __("Choose install or upgrade"), __("help"), 0, 0 ],
-  selectInstallClass => [ __("Select installation class"), __("help"), 0, 0 ],
-  setupSCSI => [ __("Setup SCSI"), __("help"), 0, 1 ],	
-  partitionDisks => [ __("Setup filesystems"), __("help"), 0, 1 ],
-  formatPartitions => [ __("Format partitions"), __("help"), 0, 1 ],
-  findInstallFiles => [ __("Find installation files"), __("help"), 1, 0 ],
-  choosePackages => [ __("Choose packages to install"), __("help"), 0, 0 ],
-  doInstallStep => [ __("Install system"), __("help"), 0, 0 ],
+  selectInstallClass => [ __("Select installation class"), __("help"), 1, 1 ],
+  setupSCSI => [ __("Setup SCSI"), __("help"), 1, 0 ],	
+  partitionDisks => [ __("Setup filesystems"), __("help"), 1, 0 ],
+  formatPartitions => [ __("Format partitions"), __("help"), 1, -1, "partitionDisks" ],
+  choosePackages => [ __("Choose packages to install"), __("help"), 1, 1 ],
+  doInstallStep => [ __("Install system"), __("help"), 1, -1, ["formatPartitions", "selectPath"] ],
 #  configureMouse => [ __("Configure mouse"), __("help"), 0, 0 ],
-  finishNetworking => [ __("Configure networking"), __("help"), 0, 0 ],
+  finishNetworking => [ __("Configure networking"), __("help"), 1, 1, "formatPartitions" ],
 #  configureTimezone => [ __("Configure timezone"), __("help"), 0, 0 ],
 #  configureServices => [ __("Configure services"), __("help"), 0, 0 ],
 #  configurePrinter => [ __("Configure printer"), __("help"), 0, 0 ],
-  setRootPassword => [ __("Set root password"), __("help"), 0, 0 ],
-  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 ],
-  exitInstall => [ __("Exit install"), __("help"), 0, 0, undef, 'done' ],
-);
-
-# this table is translated at run time
-my @upgradeSteps = (
-  selectLanguage => [ "Choose your language", "help", 0, 0 ],
-  selectPath => [ __("Choose install or upgrade"), __("help"), 0, 0 ],
-  selectInstallClass => [ __("Select installation class"), __("help"), 0, 0 ],
-  setupSCSI => [ __("Setup SCSI"), __("help"), 0, 0 ],
-  upgrFindInstall => [ __("Find current installation"), __("help"), 0, 0 ],
-  findInstallFiles => [ __("Find installation files"), __("help"), 1, 0 ],
-  upgrChoosePackages => [ __("Choose packages to upgrade"), __("help"), 0, 0 ],
-  doInstallStep => [ __("Upgrade system"), __("help"), 0, 0 ],
-  createBootdisk => [ __("Create bootdisk"), __("help"), 0, 0 , 'none' ],
-  setupBootloader => [ __("Install bootloader"), __("help"), 0, 0 ],
-  exitInstall => [ __("Exit install"), __("help"), 0, 0 , undef, 'done' ],
+  setRootPassword => [ __("Set root password"), __("help"), 1, 0, "formatPartitions" ],
+  addUser => [ __("Add a user"), __("help"), 1, 0, "formatPartitions" ],
+  createBootdisk => [ __("Create bootdisk"), __("help"), 1, 0, "doInstallStep" ],
+  setupBootloader => [ __("Install bootloader"), __("help"), 1, 1, "doInstallStep" ],
+  configureX => [ __("Configure X"), __("help"), 1, 0, "formatPartitions" ],
+  exitInstall => [ __("Exit install"), __("help"), 0, 0, "alldone" ],
 );
 my (%installSteps, %upgradeSteps, @orderedInstallSteps, @orderedUpgradeSteps);
 for (my $i = 0; $i < @installSteps; $i += 2) {
     my %h; @h{@installStepsFields} = @{ $installSteps[$i + 1] };
-    $h{prev} ||= $installSteps[$i - 2];
-    $h{next} ||= $installSteps[$i + 2];
+    $h{next} = $installSteps[$i + 2];
+    $h{onError} = $installSteps[$i + 2 * $h{onError}];
     $installSteps{ $installSteps[$i] } = \%h;
     push @orderedInstallSteps, $installSteps[$i];
 }
 $installSteps{first} = $installSteps[0];
-for (my $i = 0; $i < @upgradeSteps; $i += 2) {
-    my %h; @h{@installStepsFields} = @{ $upgradeSteps[$i + 1] };
-    $h{prev} ||= $upgradeSteps[$i - 2];
-    $h{next} ||= $upgradeSteps[$i + 2];
-    $upgradeSteps{ $upgradeSteps[$i] } = \%h;
-    push @orderedUpgradeSteps, $installSteps[$i];
-}
-$upgradeSteps{first} = $upgradeSteps[0];
 
 
-my @install_classes = (__("newbie"), __("developer"), __("server"), __("expert"));
+my @install_classes = (__("beginner"), __("developer"), __("server"), __("expert"));
 
 # partition layout for a server
 my @serverPartitioning = (
@@ -91,16 +67,20 @@ my @serverPartitioning = (
 
 my $default = {
 #    display => "192.168.1.9:0",
-    user => { name => 'foo', password => 'foo', shell => '/bin/bash', realname => 'really, it is foo' },
-    rootPassword => 'toto',
-    lang => 'fr',
-    isUpgrade => 0,
-    installClass => 'newbie',
+
+    # for the list of fields available for user and superuser, see @etc_pass_fields in install_steps.pm
+#    user => { name => 'foo', password => 'bar', home => '/home/foo', shell => '/bin/bash', realname => 'really, it is foo' },
+#    superuser => { password => 'a', shell => '/bin/bash', realname => 'God' },
+
+#    lang => 'fr',
+#    isUpgrade => 0,
+#    installClass => 'beginner',
     bootloader => { onmbr => 1, linear => 0 },
+    autoSCSI => 0,
     mkbootdisk => 0,
     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 },
+    partitionning => { clearall => $::testing, eraseBadPartitions => 1, auto_allocate => 0, autoformat => 1 },
     partitions => [
 		   { mntpoint => "/boot", size =>  16 << 11, type => 0x83 }, 
 		   { mntpoint => "/",     size => 300 << 11, type => 0x83 }, 
@@ -116,6 +96,13 @@ sub selectLanguage {
     $o->{lang} = $o->chooseLanguage;
     lang::set($o->{lang});
     $o->{keyboard} = keyboard::setup();
+
+    addToBeDone {
+	unless ($o->{isUpgrade}) {
+	    keyboard::write($o->{prefix}, $o->{keyboard});
+	    lang::write($o->{prefix});
+	} 
+    } 'doInstallStep';
 }
 
 sub selectPath {
@@ -127,16 +114,23 @@ sub selectPath {
 sub selectInstallClass {
     $o->{installClass} = $o->selectInstallClass(@install_classes);
     $::expert = $o->{installClass} eq "expert";
+    $o->{autoSCSI} = $o->default("autoSCSI") || $o->{installClass} eq "beginner";
 }
 
 sub setupSCSI { $o->setupSCSI }
 
 sub partitionDisks {
     $o->{drives} = [ detect_devices::hds() ];
-    $o->{hds} = fsedit::hds($o->{drives}, $o->{default}->{partitionning});
-    @{$o->{hds}} > 0 or die _("An error has occurred - no valid devices were found on which to create new filesystems. Please check your hardware for the cause of this problem");
+    $o->{hds} = fsedit::hds($o->{drives}, $o->{default}{partitionning});
+    unless (@{$o->{hds}} > 0) {
+	$o->setupSCSI if $o->{autoSCSI}; # ask for an unautodetected scsi card
+    }
+    unless (@{$o->{hds}} > 0) { # no way
+	die _("An error has occurred - no valid devices were found on which to create new filesystems. Please check your hardware for the cause of this problem");
+    }
 
     unless ($o->{isUpgrade}) {
+	eval { fsedit::auto_allocate($o->{hds}, $o->{partitions}) } if $o->{default}{partitionning}{auto_allocate};
 	$o->doPartitionDisks($o->{hds});
 
 	unless ($::testing) {
@@ -162,29 +156,26 @@ sub formatPartitions {
 
     $::testing and return;
 
-    foreach (@{$o->{fstab}}) {
-	fs::format_part($_) if $_->{toFormat};
-    }
+    $o->formatPartitions(@{$o->{fstab}});
+
     fs::mount_all([ grep { isExt2($_) || isSwap($_) } @{$o->{fstab}} ], $o->{prefix});
 }
 
-sub findInstallFiles {
+sub choosePackages {
     $o->{packages} = pkgs::psUsingDirectory();
     pkgs::getDeps($o->{packages});
 
     $o->{compss} = pkgs::readCompss($o->{packages});
-}
- 
-sub choosePackages {
-    my @p = @{$o->{default}->{base}};
+
+    my @p = @{$o->{default}{base}};
     push @p, "kernel-smp" if smp::detect();
 
-    foreach (@p) { $o->{packages}->{$_}->{base} = 1 }
+    foreach (@p) { $o->{packages}{$_}{base} = 1 }
 
     pkgs::setCompssSelected($o->{compss}, $o->{packages}, $o->{installClass});
     $o->choosePackages($o->{packages}, $o->{compss}); 
 
-    foreach (@p) { $o->{packages}->{$_}->{selected} = 1 }
+    foreach (@p) { $o->{packages}{$_}{selected} = 1 }
 }
 
 sub doInstallStep {
@@ -213,7 +204,7 @@ sub setupBootloader {
     $o->{isUpgrade} or modules::read_conf("$o->{prefix}/etc/conf.modules");
     $o->setupBootloader;
 }
-sub configureX { $o->setupXfree if $o->{packages}->{XFree86}->{installed} }
+sub configureX { $o->setupXfree if $o->{packages}{XFree86}{installed} }
 sub exitInstall { $o->exitInstall }
 
 
@@ -244,22 +235,32 @@ sub main {
 
     $o = install_steps_graphical->new($o);
 
-    $o->{netc} = net::readNetConfig("/tmp");
+    $o->{netc} = network::read_conf("/tmp/network");
     if (my ($file) = glob_('/tmp/ifcfg-*')) {
 	log::l("found network config file $file");
-	$o->{intf} = net::readNetInterfaceConfig($file);
+	$o->{intf} = network::read_interface_conf($file);
     }
 
-    modules::load_deps("/lib/modules/modules.dep");
+    modules::load_deps("/modules/modules.dep");
     modules::read_conf("/tmp/conf.modules");
 
-    for (my $step = $o->{steps}->{first}; $step ne 'done'; $step = getNextStep($step)) {
-	$o->enteringStep($step);
+    for ($o->{step} = $o->{steps}{first};; $o->{step} = getNextStep()) {
+	$o->enteringStep($o->{step});
+	$o->{steps}{$o->{step}}{entered} = 1;
 	eval { 
-	    &{$install2::{$step}}();
+	    &{$install2::{$o->{step}}}();
 	};
-	$o->errorInStep($@), redo if $@;
-	$o->leavingStep($step);
+	$@ =~ /^setstep (.*)/ and $o->{step} = $1, redo;
+	$@ =~ /^theme_changed$/ and redo;
+	if ($@) {
+	    $o->errorInStep($@);
+	    $o->{step} = $o->{steps}{$o->{step}}{onError};
+	    redo;
+	}
+	$o->leavingStep($o->{step});
+	$o->{steps}{$o->{step}}{done} = 1;
+
+	last if $o->{step} eq 'exitInstall';
     }
     killCardServices();
 
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index 1233b6e9e..9cf68eb7b 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -6,7 +6,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK);
 
 @ISA = qw(Exporter);
 %EXPORT_TAGS = (
-    all => [ qw(versionString getNextStep doSuspend spawnSync spawnShell) ],
+    all => [ qw(versionString getNextStep doSuspend spawnSync spawnShell addToBeDone) ],
 );
 @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
 
@@ -26,7 +26,7 @@ sub imageGetFile {
 }
 
 sub versionString {
-    my $kernel = $::o->{packages}->{kernel};
+    my $kernel = $::o->{packages}{kernel};
     $kernel && $kernel->{header} or die "I couldn't find the kernel package!";
     
     c::headerGetEntry($kernel->{header}, 'version') . "-" .
@@ -35,11 +35,9 @@ sub versionString {
 
 
 sub getNextStep {
-    my ($lastStep) = @_;
-
-    $::o->{direction} = 1;
-
-    return $::o->{lastChoice} = $::o->{steps}->{$lastStep}->{next};
+    my ($s) = $::o->{steps}{first};
+    $s = $::o->{steps}{$s}{next} while $::o->{steps}{$s}{done};
+    $s;
 }
 
 sub doSuspend {
@@ -92,11 +90,17 @@ sub mouse_detect() {
 
 sub shells($) {
     my ($o) = @_;
-    my @l = grep { -x "$o->{prefix}$_" } @{$o->{default}->{shells}};
+    my @l = grep { 1 || -x "$o->{prefix}$_" } @{$o->{default}{shells}};
     @l or die "no shell available";
     @l;
 }
 
+sub addToBeDone(&$) {
+    my ($f, $step) = @_;
+
+    push @{$::o->{steps}{$step}{toBeDone}}, $f;
+}
+
 sub upgrFindInstall {
 #    int rc;
 #
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index 64854e6e3..422c3657a 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -3,9 +3,10 @@ package install_steps;
 use diagnostics;
 use strict;
 
-use common qw(:file :system);
+use common qw(:file :system :common);
 use install_any qw(:all);
 use partition_table qw(:types);
+use modules;
 use run_program;
 use lilo;
 use lang;
@@ -15,6 +16,11 @@ use cpio;
 use log;
 use fsedit;
 use commands;
+use network;
+use fs;
+
+
+my @etc_pass_fields = qw(name password uid gid realname home shell);
 
 
 my $o;
@@ -28,25 +34,55 @@ sub new($$) {
     $o = bless $o_, ref $type || $type;
 }
 
+sub default {
+    my ($o, $field) = @_;
+    $o->{$field} || $o->{default}{$field};
+}
+
 sub enteringStep($$) {
     my ($o, $step) = @_;
     log::l("starting step `$step'");
+    $o->kill;
+
+    for (my $s = $o->{steps}{first}; $s; $s = $o->{steps}{$s}{next}) {
+
+	next if $o->{steps}{$s}{done} && !$o->{steps}{$s}{redoable};
+
+	my $reachable = 1;
+	if (my $needs = $o->{steps}{$s}{needs}) {
+	    my @l = ref $needs ? @$needs : $needs;
+	    $reachable = min(map { $o->{steps}{$_}{done} } @l);
+	}
+	if ($reachable && !$o->{steps}{$s}{reachable}) {
+	    $o->{steps}{$s}{reachable} = 1;
+	    $o->step_set_reachable($s);
+	}
+    }
 }
 sub leavingStep($$) {
     my ($o, $step) = @_;
     log::l("step `$step' finished");
+
+    unless ($o->{steps}{$step}{redoable}) {
+	$o->{steps}{$step}{reachable} = 0;
+	$o->step_set_unreachable($step);
+    }
+
+    while (my $f = shift @{$o->{steps}{$step}{toBeDone} || []}) {
+	&$f();
+    }
 }
 
 sub errorInStep($$) {}
 
 sub chooseLanguage($) {
-    $o->{default}->{lang};
+    $o->default("lang");
 }
 sub selectInstallOrUpgrade($) {
-    $o->{default}->{isUpgrade} || 0;
+    $o->default("isUpgrade") || 0;
 }
 sub selectInstallClass($@) {
-    $o->{default}->{installClass} || $_[1];
+    $o->default("installClass") || $_[1];
 }
 sub setupSCSI {
     modules::load_thiskind('scsi');
@@ -54,7 +90,7 @@ sub setupSCSI {
 
 sub doPartitionDisks($$) {
     my ($o, $hds) = @_;
-    fsedit::auto_allocate($hds, $o->{default}->{partitions});
+    fsedit::auto_allocate($hds, $o->{default}{partitions});
 }
 sub rebootNeeded($) {
     my ($o) = @_;
@@ -66,8 +102,15 @@ sub choosePartitionsToFormat($$) {
     my ($o, $fstab) = @_;
 
     foreach (@$fstab) { 
-	$_->{toFormat} = $_->{mntpoint} && (isExt2($_) || isSwap($_)) &&
-	  ($_->{notFormatted} || $o->{default}->{partitionning}->{autoformat});
+	$_->{toFormat} = ($_->{mntpoint} && isExt2($_) || isSwap($_)) &&
+	  ($_->{notFormatted} || $o->{default}{partitionning}{autoformat});
+    }
+}
+
+sub formatPartitions {
+    my $o = shift;
+    foreach (@_) {
+	fs::format_part($_) if $_->{toFormat};
     }
 }
 
@@ -76,17 +119,8 @@ sub choosePackages($$$) {
 }
 
 sub beforeInstallPackages($) {
-
-    foreach (qw(dev etc home mnt tmp var var/tmp var/lib var/lib/rpm)) {
-	mkdir "$o->{prefix}/$_", 0755;
-    }
-
-    unless ($o->{isUpgrade}) {
-	local *F;
-	open F, "> $o->{prefix}/etc/hosts" or die "Failed to create etc/hosts: $!";
-	print F "127.0.0.1		localhost localhost.localdomain\n";
-    }
-
+    mkdir "$o->{prefix}/$_", 0755 foreach qw(dev etc home mnt tmp var var/tmp var/lib var/lib/rpm);
+    network::add2hosts("$o->{prefix}/etc/hosts", "127.0.0.1", "localhost.localdomain");
     pkgs::init_db($o->{prefix}, $o->{isUpgrade});
 }
 
@@ -99,10 +133,6 @@ sub installPackages($$) {
 sub afterInstallPackages($) {
     my ($o) = @_;
 
-    unless ($o->{isUpgrade}) {
-        keyboard::write($o->{prefix}, $o->{keyboard});
-        lang::write($o->{prefix});
-    }
     #  why not? 
     sync(); sync();
 
@@ -115,25 +145,16 @@ sub mouseConfig($) {
 
 sub finishNetworking($) {
     my ($o) = @_;
+    my $etc = "$o->{prefix}/etc";
 #
 #    rc = checkNetConfig(&$o->{intf}, &$o->{netc}, &$o->{intfFinal},
 #			 &$o->{netcFinal}, &$o->{driversLoaded}, $o->{direction});
-#
-#    if (rc) return rc;
-#
-#    sprintf(path, "%s/etc/sysconfig", $o->{rootPath});
-#    writeNetConfig(path, &$o->{netcFinal}, 
-#		    &$o->{intfFinal}, 0);
-#    strcat(path, "/network-scripts");
-#    writeNetInterfaceConfig(path, &$o->{intfFinal});
-#    sprintf(path, "%s/etc", $o->{rootPath});
-#    writeResolvConf(path, &$o->{netcFinal});
-#
-#    #  this is a bit of a hack 
-#    writeHosts(path, &$o->{netcFinal}, 
-#		&$o->{intfFinal}, !$o->{isUpgrade});
-#
-#    return 0;
+    network::write_conf("$etc/sysconfig/network", $o->{netc});
+    network::write_interface_conf("$etc/sysconfig/network-scripts/ifcfg-$o->{intf}{DEVICE}", $o->{intf});
+    network::write_resolv_conf("$etc/resolv.conf", $o->{netc});
+    network::add2hosts("$etc/hosts", $o->{intf}{IPADDR}, $o->{netc}{HOSTNAME});
+#    syscall_('sethostname', $hostname, length $hostname) or warn "sethostname failed: $!";
+    #res_init();		# reinit the resolver so DNS changes take affect     
 }
 
 sub timeConfig {}
@@ -141,9 +162,10 @@ sub servicesConfig {}
 
 sub setRootPassword($) {
     my ($o) = @_;
+    my %u = %{$o->default("superuser")};
     my $p = $o->{prefix};
-    my $pw = $o->{default}->{rootPassword};
-    $pw = crypt_($pw);
+
+    $u{password} = crypt_($u{password}) if $u{password};
 
     my $f = "$p/etc/passwd";
     my @lines = cat_($f, "failed to open file $f");
@@ -151,49 +173,55 @@ sub setRootPassword($) {
     local *F;
     open F, "> $f" or die "failed to write file $f: $!\n";
     foreach (@lines) {
-	s/^root:.*?:/root:$pw:/;
+	if (/^root:/) {
+	    chomp;
+	    my %l; @l{@etc_pass_fields} = split ':';
+	    add2hash(\%u, \%l);
+	    $_ = join(':', @u{@etc_pass_fields}) . "\n";
+	}
 	print F $_;
     }
 }
 
 sub addUser($) {
     my ($o) = @_;
-    my %u = %{$o->{default}->{user}};
+    my %u = %{$o->default("user")};
     my $p = $o->{prefix};
+    my @passwd = cat_("$p/etc/passwd");;
 
-    my $new_uid;
-    #my @uids = map { (split)[2] } cat__("$p/etc/passwd");
-    #for ($new_uid = 500; member($new_uid, @uids); $new_uid++) {}
-    for ($new_uid = 500; getpwuid($new_uid); $new_uid++) {}
+    !$u{name} || member($u{name}, map { (split ':')[0] } @passwd) and return;
 
-    my $new_gid;
-    #my @gids = map { (split)[2] } cat__("$p/etc/group");
-    #for ($new_gid = 500; member($new_gid, @gids); $new_gid++) {}
-    for ($new_gid = 500; getgrgid($new_gid); $new_gid++) {}
-
-    my $homedir = "$p/home/$u{name}";
+    unless ($u{uid}) {
+	my @uids = map { (split ':')[2] } @passwd;
+	for ($u{uid} = 500; member($u{uid}, @uids); $u{uid}++) {}    
+    }    
+    unless ($u{gid}) {
+	my @gids = map { (split ':')[2] } cat_("$p/etc/group");
+	for ($u{gid} = 500; member($u{gid}, @gids); $u{gid}++) {}
+    }
+    $u{home} ||= "/home/$u{name}";
 
-    my $pw = crypt_($u{password});
+    $u{password} = crypt_($u{password}) if $u{password};
 
     local *F;
     open F, ">> $p/etc/passwd" or die "can't append to passwd file: $!";
-    print F "$u{name}:$pw:$new_uid:$new_gid:$u{realname}:/home/$u{name}:$u{shell}\n";
-	    
+    print F join(':', @u{@etc_pass_fields}), "\n";
+
     open F, ">> $p/etc/group" or die "can't append to group file: $!";
-    print F "$u{name}::$new_gid:\n";
+    print F "$u{name}::$u{gid}:\n";
 
-    eval { commands::cp("-f", "$p/etc/skel", $homedir) }; $@ and log::l("copying of skel failed: $@"), mkdir($homedir, 0750);
-    commands::chown_("-r", "$new_uid.$new_gid", $homedir);    
+    eval { commands::cp("-f", "$p/etc/skel", "$p$u{home}") }; $@ and log::l("copying of skel failed: $@"), mkdir("$p$u{home}", 0750);
+    commands::chown_("-r", "$u{uid}.$u{gid}", "$p$u{home}");
 }
 
 sub createBootdisk($) {
-    lilo::mkbootdisk($o->{prefix}, versionString()) if $o->{default}->{mkbootdisk} && !$::testing;
+    lilo::mkbootdisk($o->{prefix}, versionString()) if $o->default("mkbootdisk") && !$::testing;
 }
 
 sub setupBootloader($) {
     my ($o) = @_;
     my $versionString = versionString();
-    lilo::install($o->{prefix}, $o->{hds}, $o->{fstab}, $versionString, $o->{default}->{bootloader});
+    lilo::install($o->{prefix}, $o->{hds}, $o->{fstab}, $versionString, $o->default("bootloader"));
 }
 
 sub setupXfree {
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index e34a82d83..8f640d649 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -31,21 +31,22 @@ use partition_table qw(:types);
 use install_steps;
 use modules;
 use lang;
+use fs;
 use log;
 
 1;
 
-
 sub errorInStep($$) {
     my ($o, $err) = @_;
     $o->ask_warn(_("Error"), [ _("An error occured"), $err ]);
 }
 
+
 sub chooseLanguage($) {
     my ($o) = @_;
     lang::text2lang($o->ask_from_list("Language",
 				      __("Which language do you want?"), # the translation may be used for the help
-				      [ lang::list() ]));
+				      [ lang::list() ], lang::lang2text($o->default("lang"))));
 }
 
 sub selectInstallOrUpgrade($) {
@@ -53,25 +54,34 @@ sub selectInstallOrUpgrade($) {
     $o->ask_from_list_(_("Install/Upgrade"), 
 		       _("Is it an install or an updgrade?"),
 		       [ __("Install"), __("Upgrade") ], 
-		       "Install") eq "Upgrade";
+		       $o->default("isUpgrade") ? "Upgrade" : "Install") eq "Upgrade";
 }
 
 sub selectInstallClass($@) {
     my ($o, @classes) = @_;
     $o->ask_from_list_(_("Install Class"),
 		       _("What type of user will you have?"),
-		       [ @classes ]);
+		       [ @classes ], $o->default("installClass"));
 }
 
 sub setupSCSI {
     my ($o) = @_;
-    my @l = modules::load_thiskind('scsi');
+    my $w;
+    my @l = modules::load_thiskind('scsi', sub { 
+        $w = $o->wait_message('', 
+			      [ _("Installing driver for scsi card %s", $_->[0]),
+				$o->{installClass} ne "beginner" ? _("(module %s)", $_->[1]) : () 
+			      ]);
+    });
+    undef $w; # kill wait_message
+
+    $o->default("autoSCSI") and return;
     while (1) {
 	@l ?
 	  $o->ask_yesorno('', 
 			  [ _("Found ") . join(", ", map { $_->[0] } @l) . _(" scsi interfaces"),
-			    _("Do you have another one?") ]) :
-	  $o->ask_yesorno('', _("Do you have an scsi interface?")) or return;
+			    _("Do you have another one?") ], "No") :
+	  $o->ask_yesorno('', _("Do you have an scsi interface?"), "No") or return;
 
 	my $l = $o->ask_from_list('', _("What scsi card have you?"), [ modules::text_of_type('scsi') ]) or return;
 	my $m = modules::text2driver($l);
@@ -88,39 +98,54 @@ sub rebootNeeded($) {
 
 sub choosePartitionsToFormat($$) {
     my ($o, $fstab) = @_;
-    my @l = grep { $_->{mntpoint} && (isExt2($_) || isSwap($_)) } @$fstab;
+
+    my @l = grep { $_->{mntpoint} && isExt2($_) || isSwap($_) } @$fstab;
     my @r = $o->ask_many_from_list('', _("Choose the partitions you want to format"), 
-				   [ map { $_->{mntpoint} } @l ], 
+				   [ map { $_->{mntpoint} || type2name($_->{type}) . " ($_->{device})" } @l ],
 				   [ map { $_->{notFormatted} } @l ]);
-    for (my $i = 0; $i < @l; $i++) {
-	$l[$i]->{toFormat} = $r[$i];
+    defined @r or die "cancel";
+    my $i = 0;
+    $_->{toFormat} = $r[$i++] foreach @l;
+}
+
+sub formatPartitions {
+    my $o = shift;
+    my $w = $o->wait_message('', '');
+    foreach (@_) {
+	if ($_->{toFormat}) {
+	    $w->set(_("Formatting partition %s", $_->{device}));
+	    fs::format_part($_);
+	}
     }
 }
 
 sub createBootdisk($) {
     my ($o) = @_;
     
-    if ($o->{default}->{mkbootdisk} = $o->ask_yesorno('',
+    if ($o->{mkbootdisk} = $o->ask_yesorno('',
  _("A custom bootdisk provides a way of booting into your Linux system without
 depending on the normal bootloader. This is useful if you don't want to install
 lilo on your system, or another operating system removes lilo, or lilo doesn't
 work with your hardware configuration. A custom bootdisk can also be used with
 the Mandrake rescue image, making it much easier to recover from severe system
-failures. Would you like to create a bootdisk for your system?"))) {
-
-	$o->ask_warn('',
-_("Insert a floppy in drive fd0 (aka A:)"));
+failures. Would you like to create a bootdisk for your system?"), !$o->default("mkbootdisk"))) {
 
+	$o->ask_warn('', _("Insert a floppy in drive fd0 (aka A:)"));
+	my $w = $o->wait_message('', _("Creating bootdisk"));
 	$o->SUPER::createBootdisk;
     }
 }
 
 sub setupBootloader($) {
     my ($o) = @_;
-
-    my $where = $o->ask_from_list(_("Lilo Installation"), _("Where do you want to install the bootloader?"), [ _("First sector of drive"), _("First sector of boot partition") ]);
-    $o->{default}->{bootloader}->{onmbr} = $where eq _("First sector of drive");
-    
+    my @l = (__("First sector of drive"), __("First sector of boot partition"));
+
+    $o->{bootloader}{onmbr} = 
+      $o->ask_from_list_(_("Lilo Installation"), 
+			 _("Where do you want to install the bootloader?"), 
+			 \@l, 
+			 $l[!$o->default("bootloader")->{onmbr}]
+			) eq $l[0];
     $o->SUPER::setupBootloader;
 }
 
@@ -134,3 +159,5 @@ consult the Errata available from http://www.linux-mandrake.com/.
 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 f5b05a0f1..8122c3ba2 100644
--- a/perl-install/install_steps_stdio.pm
+++ b/perl-install/install_steps_stdio.pm
@@ -18,7 +18,7 @@ use log;
 
 sub enteringStep($$$) {
     my ($o, $step) = @_;
-    print _("Starting step `%s'\n", $o->{steps}->{$step}->{text});
+    print _("Starting step `%s'\n", $o->{steps}{$step}{text});
 }
 sub leavingStep {
     my ($o) = @_;
@@ -50,7 +50,7 @@ sub setRootPassword($) {
 	print "Password (again for confirmation): "; 
     } until ($w{password} eq $o->readln());
 
-    $o->{default}->{rootPassword} = $w{password};
+    $o->{default}{rootPassword} = $w{password};
     $o->SUPER::setRootPassword;
 }
 
@@ -68,6 +68,6 @@ sub addUser($) {
     
     $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->{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 76ed30345..b0bd6bb7d 100644
--- a/perl-install/interactive.pm
+++ b/perl-install/interactive.pm
@@ -3,7 +3,7 @@ package interactive;
 use diagnostics;
 use strict;
 
-use common qw(:common);
+use common qw(:common :functional);
 
 1;
 
@@ -18,11 +18,11 @@ sub ask_warn($$$) {
     my ($o, $title, $message) = @_;
     ask_from_list($o, $title, $message, [ _("Ok") ]);
 }
-sub ask_yesorno($$$) {
+sub ask_yesorno($$$;$) {
     my ($o, $title, $message, $def) = @_;
     ask_from_list_($o, $title, $message, [ __("Yes"), __("No") ], $def ? "No" : "Yes") eq "Yes";
 }
-sub ask_okcancel($$$) {
+sub ask_okcancel($$$;$) {
     my ($o, $title, $message, $def) = @_;
     ask_from_list_($o, $title, $message, [ __("Ok"), __("Cancel") ], $def ? "Cancel" : "Ok") eq "Ok";
 }
@@ -56,3 +56,25 @@ sub ask_from_entry($$$;$) {
 
     $o->ask_from_entryW($title, $message, $def);
 }
+
+sub wait_message($$$) {
+    my ($o, $title, $message) = @_;
+
+    $message = ref $message ? $message : [ $message ];
+
+    my $w = $o->wait_messageW($title, [ _("Please wait"), @$message ]);
+    my $b = before_leaving { $o->wait_message_endW($w) };
+
+    # enable access through set
+    common::add_f4before_leaving(sub { $o->wait_message_nextW($_[1], $w) }, $b, 'set');
+    $b;
+}
+
+sub kill {
+    my ($o) = @_;
+    while ($o->{before_killing} && @interactive::objects > $o->{before_killing}) {
+	my $w = pop @interactive::objects;
+	$w->destroy;
+    }
+    $o->{before_killing} = @interactive::objects;
+}
diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm
index de58e765d..7c52e0d97 100644
--- a/perl-install/interactive_gtk.pm
+++ b/perl-install/interactive_gtk.pm
@@ -12,19 +12,28 @@ use my_gtk qw(:helpers :wrappers);
 
 1;
 
+# redefine ask_warn
+sub ask_warn {
+    my $o = shift;
+    local $my_gtk::grab = 1;
+    $o->SUPER::ask_warn(@_);
+}
+
 sub ask_from_entryW {
     my ($o, $title, $messages, $def) = @_;
-    my_gtk::ask_from_entry($title, @$messages);
+    my $w = my_gtk->new($title, %$o);
+    $w->_ask_from_entry(@$messages);
+    $w->main;
 }
 
 sub ask_from_listW {
     my ($o, $title, $messages, $l, $def) = @_;
 
     if (@$l < 5 && sum(map { length $_ } @$l) < 70) {
-	my $w = my_gtk->new($title);
+	my $w = my_gtk->new($title, %$o);
 	my $f = sub { $w->{retval} = $_[1]; Gtk->main_quit };
 	gtkadd($w->{window},
-	       gtkpack(create_box_with_title($o, @$messages),
+	       gtkpack(create_box_with_title($w, @$messages),
 		       gtkadd((@$l < 3 ? create_hbox() : create_vbox()),
 			      map {
 				  my $b = new Gtk::Button($_);
@@ -37,6 +46,53 @@ sub ask_from_listW {
 	$def->grab_focus if $def;
 	$w->main;
     } else {
-	my_gtk::ask_from_list($title, $messages, $l, $def);
+	my $w = my_gtk->new($title);
+	$w->_ask_from_list($messages, $l, $def);
+	$w->main;
     }
 }
+
+sub ask_many_from_listW {
+    my ($o, $title, $messages, $list, $default) = @_;
+    my @rr = @$default;
+    my $n = 0;
+    my $w = my_gtk->new('', %$o);
+    gtkadd($w->{window}, 
+	   gtkpack(create_box_with_title($w, @$messages),
+		   gtkpack(new Gtk::VBox(0,0),
+			   map { 
+			       my $nn = $n++; 
+			       my $o = Gtk::CheckButton->new($_);
+			       $o->set_active($rr[$nn]);
+			       $o->signal_connect(clicked => sub { $rr[$nn] = !$rr[$nn] });
+			       $o;
+			   } @$list),
+		   $w->create_okcancel,
+		  )
+	  );
+    $w->{ok}->grab_focus;
+    $w->main or return;
+    @rr;
+}
+
+sub wait_messageW($$$) {
+    my ($o, $title, $message) = @_;
+
+    my $w = my_gtk->new(_("Resizing"), %$o, grab => 1);
+    my $W = pop @$message;
+    gtkadd($w->{window}, 
+	   gtkpack(new Gtk::VBox(0,0), 
+		   @$message, 
+		   $w->{wait_messageW} = new Gtk::Label($W)));
+    $w->sync;
+    $w;
+}
+sub wait_message_nextW {
+    my ($o, $message, $w) = @_;
+    $w->{wait_messageW}->set($message);
+    $w->sync;
+}
+sub wait_message_endW {
+    my ($o, $w) = @_;
+    $w->destroy;
+}
diff --git a/perl-install/interactive_stdio.pm b/perl-install/interactive_stdio.pm
index 40dcdbb7c..de848b9e6 100644
--- a/perl-install/interactive_stdio.pm
+++ b/perl-install/interactive_stdio.pm
@@ -78,3 +78,9 @@ sub ask_many_from_listW {
 }
 
 
+sub wait_messageW {
+    my ($o, $title, $message) = @_;
+    print map { "$_\n" } @$message;
+}
+sub wait_message_nextW { print "$_[1]\n" }
+sub wait_message_endW { print "Done\n" }
diff --git a/perl-install/lang.pm b/perl-install/lang.pm
index fe03cf72d..9a30749a7 100644
--- a/perl-install/lang.pm
+++ b/perl-install/lang.pm
@@ -29,6 +29,7 @@ my %languages = (
 1;
 
 sub list { map { $_->[0] } values %languages }
+sub lang2text { $languages{$_[0]} && $languages{$_[0]}[0] }
 sub text2lang {
     my ($t) = @_;
     while (my ($k, $v) = each %languages) {
@@ -42,8 +43,8 @@ sub set {
 
     if ($lang) {
 	$ENV{LANG} = $ENV{LINGUAS} = $lang;
-	$ENV{LC_ALL} = $languages{$lang}->[3];
-	#if (my $f = $languages{$lang}->[1]) { load_font($f) }
+	$ENV{LC_ALL} = $languages{$lang}[3];
+	#if (my $f = $languages{$lang}[1]) { load_font($f) }
     } else {
 	# stick with the default (English) */
 	delete $ENV{LANG};
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
index 8c59b3431..e1e735e1b 100644
--- a/perl-install/modules.pm
+++ b/perl-install/modules.pm
@@ -4,11 +4,11 @@ use diagnostics;
 use strict;
 use vars qw(%loaded);
 
-use common qw(:file);
+use common qw(:common :file);
+use pci_probing::main;
 use log;
 use detect_devices;
 use run_program;
-use pci;
 
 %loaded = ();
 
@@ -231,11 +231,11 @@ sub load_raw($$$@) {
     my ($name, $type, $minor, @options) = @_;
 
 #    @options or @options = guiGetModuleOptions($name);
-    my $m = "/modules/$name.o";
-    -r $m or $m = "/lib$m";
-    -r $m or die "can't find module $name";
-
-    run_program::run("insmod", $m, @options) or die("insmod $name failed");
+    my $f = "/tmp/$name.o";
+    run_program::run("cd /tmp ; bzip2 -cd /lib/modules.cpio.bz2 | cpio -i $name.o");
+    -r $f or die "can't find module $name";
+    run_program::run("insmod", $f, @options) or die("insmod $name failed");
+    unlink $f;
 
     # this is a hack to make plip go
     if ($name eq "parport_pc") {
@@ -259,7 +259,6 @@ sub load_deps($) {
 	my ($f, $deps) = split ':';
 	push @{$deps{$f}}, split ' ', $deps;
     }
-    1;
 }
 
 sub read_conf {
@@ -271,43 +270,36 @@ sub read_conf {
     foreach (<F>) {
 	/^alias\s+eth0\s+(\S+)/             and $loaded{$1} = { type => 'net', minor => 'ethernet' };
 	/^alias\s+scsi_hostadapter\s+(\S+)/ and $loaded{$1} = { type => 'scsi' };
-	/^option\s+(\S+)\s+(.*)/            and $loaded{$1} = { type => 'other', options => [ split ' ', $2 ] };
+	/^options\s+(\S+)\s+(.*)/           and add2hash($loaded{$1} || {}, { type => 'other', options => [ split ' ', $2 ] });
     }
-    1;
 }
 
 sub write_conf {
     my ($file, $append) = @_;
     my ($tr, $eth, $scsi) = (0, 0, 0);
 
-    $append or rename($file, "$file.orig"), log::l("backing up old conf.modules");
+    $append or rename($file, "$file.orig"), log::l("backing up old $file");
 
     local *F;
     open F, ($append ? ">" : "") . "> $file" or die("cannot write module config file $file: $!\n");
 
     while (my ($k, $v) = each %loaded) {
-	unless ($append && $v->{persistFlags}->{alias}) {
-	    if ($v->{type} eq 'net') {
-		$v->{minor} eq 'tr' and print F "alias tr", $tr++, " $k\n";
-		$v->{minor} eq 'ethernet' and print F "alias eth", $eth++, " $k\n";
-	    } elsif ($v->{type} eq 'scsi') {
-		print F "alias scsi_hostadapter", $scsi++, " $k\n";
-	    }
-	}
-	unless ($append && $v->{persistFlags}->{options} || !$v->{options}) {
-	    print F "options $k ", join(' ', @{$v->{options}}), "\n";
+	if ($v->{type} eq 'net') {
+	    $v->{minor} eq 'tr' and print F "alias tr", $tr++, " $k\n";
+	    $v->{minor} eq 'ethernet' and print F "alias eth", $eth++, " $k\n";
+	} elsif ($v->{type} eq 'scsi') {
+	    print F "alias scsi_hostadapter", $scsi++, " $k\n";
 	}
+	print F "options $k ", join(' ', @{$v->{options}}), "\n" unless is_empty_array_ref($v->{options});
     }
-
     print F "alias parport_lowlevel parport_pc\n";
     print F "pre-install pcmcia_core /etc/rc.d/init.d/pcmcia start\n";
-    1;
 }
 
 
 
-sub load_thiskind($) {
-    my ($type) = @_;
+sub load_thiskind($;&) {
+    my ($type, $f) = @_;
     my @devs;
     my $found;
 
@@ -315,14 +307,14 @@ sub load_thiskind($) {
 	 @devs = pci_probing::main::probe($type);
 	 log::l("pci probe found " . scalar @devs . " $type devices");
     }
-
     my %devs;
-    foreach (map { $_->[1] } @devs) {
-	 $devs{$_}++ and log::l("multiple $_ devices found"), next;
-	 $drivers{$_} or log::l("module $_ not in install table"), next;
-	 log::l("found driver for $_");
-	 load($_);
-	 $found = $_;
+    foreach (@devs) {
+	my ($text, $mod) = @$_;
+	$devs{$mod}++ and log::l("multiple $mod devices found"), next;
+	$drivers{$mod} or log::l("module $mod not in install table"), next;
+	log::l("found driver for $mod");
+	&$f($text, $mod) if $f; 
+	load($mod);
     }
     @devs;
 }
@@ -331,7 +323,7 @@ sub load_thiskind($) {
 sub removeDeviceDriver {
 #    my ($type) = @_;
 #
-#    my @m = grep { $loaded{$_}->{type} eq $type } keys %loaded;
+#    my @m = grep { $loaded{$_}{type} eq $type } keys %loaded;
 #    @m or return 0;
 #    @m > 1 and log::l("removeDeviceDriver assume only one of each driver type is loaded, which is not the case (" . join(' ', @m) . ")");
 #    removeModule($m[0]);
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index 2fdfdda19..b530034fd 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -2,7 +2,7 @@ package my_gtk;
 
 use diagnostics;
 use strict;
-use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK);
+use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $border);
 
 @ISA = qw(Exporter);
 %EXPORT_TAGS = (
@@ -18,7 +18,7 @@ use c;
 use common qw(:common);
 
 my $forgetTime = 1000; # in milli-seconds
-my $border = 10;
+$border = 5;
 
 1;
 
@@ -26,20 +26,23 @@ my $border = 10;
 # OO stuff
 ################################################################################
 sub new {
-    my ($type, $title, @opts) = @_;
+    my ($type, $title, %opts) = @_;
 
     Gtk->init;
-    my $o = bless { @opts }, $type;
+    my $o = bless { %opts }, $type;
     $o->_create_window($title);
+    push @interactive::objects, $o unless $opts{no_interactive_objects};
     $o;
 }
 sub main($;$) {
     my ($o, $f) = @_;
     $o->show;
 
-    $o->{rwindow}->grab_add;
-    do { Gtk->main } while ($o->{retval} && $f && !&$f());
-    $o->{rwindow}->grab_remove;
+    $o->{rwindow}->grab_add if $my_gtk::grab || $o->{grab};
+    do { 
+	Gtk->main 
+    } while ($o->{retval} && $f && !&$f());
+    $o->{rwindow}->grab_remove if $my_gtk::grab || $o->{grab};
     $o->destroy;
     $o->{retval}
 }
@@ -53,6 +56,7 @@ sub destroy($) {
     $o->{rwindow}->destroy;
     flush();
 }
+sub DESTROY { goto &destroy }
 sub sync($) {
     my ($o) = @_;
     $o->show;
@@ -65,7 +69,7 @@ sub flush(;$) {
     Gtk->main_iteration while Gtk::Gdk->events_pending;
 }
 sub bigsize($) { 
-    $_[0]->{rwindow}->set_usize(600,400); 
+    $_[0]{rwindow}->set_usize(600,400); 
 }
 
 
@@ -141,7 +145,7 @@ sub gtkset_mousecursor($) {
     gtkroot()->set_cursor(Gtk::Gdk::Cursor->new($type));
 }
 
-sub gtkset_background($$$) {
+sub gtkset_background {
     my ($r, $g, $b) = @_;
 
     my $root = gtkroot();
@@ -152,7 +156,6 @@ sub gtkset_background($$$) {
     $root->set_background($color);
     
     my ($h, $w) = $root->get_size;
-    
     $root->draw_rectangle($gc, 1, 0, 0, $w, $h);
 }
 
@@ -176,7 +179,7 @@ sub create_okcancel($;$$) {
 sub create_box_with_title($@) {
     my $o = shift;
 
-    @_ = map { warp_text($_) } @_;
+    @_ = map { ref $_ ? $_ : warp_text($_) } @_;
     $o->{box} = gtkpack_(new Gtk::VBox(0,0),
 			 map({
 			      my $w = ref $_ ? $_ : new Gtk::Label($_);
@@ -285,9 +288,15 @@ sub _create_window($$) {
     }
 
     $w->set_title($title);
-    $w->signal_connect("expose_event" => sub { c::XSetInputFocus($w->window->XWINDOW) }) if $my_gtk::force_focus;
+    $w->signal_connect("expose_event" => sub { c::XSetInputFocus($w->window->XWINDOW) }) if $my_gtk::force_focus || $o->{force_focus};
     $w->signal_connect("delete_event" => sub { $o->{retval} = undef; Gtk->main_quit });
-    $w->set_uposition(@$my_gtk::force_position) if $my_gtk::force_position;
+    $w->set_uposition(@{$my_gtk::force_position || $o->{force_position}}) if $my_gtk::force_position || $o->{force_position};
+
+    $w->signal_connect(size_allocate => sub {
+	my ($wi, $he) = @{$_[1]}[2,3]; 
+	my ($X, $Y, $Wi, $He) = @{$my_gtk::force_center || $o->{force_center}};
+        $w->set_uposition(max(0, $X + ($Wi - $wi) / 2), max(0, $Y + ($He - $he) / 2));
+    }) if ($my_gtk::force_center || $o->{force_center}) && !($my_gtk::force_position || $o->{force_position}) ;
 
     $o->{window} = $f;
     $o->{rwindow} = $w;
@@ -399,7 +408,7 @@ sub _ask_okcancel($@) {
 
 sub _ask_file($$) {
     my ($o, $title) = @_;
-    my $f = $o->{window} = new Gtk::FileSelection $title;
+    my $f = $o->{rwindow} = new Gtk::FileSelection $title;
     $f->ok_button->signal_connect(clicked => sub { $o->{retval} = $f->get_filename ; Gtk->main_quit });
     $f->cancel_button->signal_connect(clicked => sub { Gtk->main_quit });
     $f->hide_fileop_buttons;
diff --git a/perl-install/network.pm b/perl-install/network.pm
new file mode 100644
index 000000000..29edb4ff3
--- /dev/null
+++ b/perl-install/network.pm
@@ -0,0 +1,129 @@
+package network;
+
+use diagnostics;
+use strict;
+
+use Socket;
+
+use common qw(:common :file :system);
+use detect_devices;
+use modules;
+use log;
+
+1;
+
+
+sub read_conf {
+    my ($file) = @_;
+    my %netc = getVarsFromSh($file);
+    \%netc;
+}
+
+sub read_interface_conf {
+    my ($file) = @_;
+    my %intf = getVarsFromSh($file) or die "cannot open file $file: $!";
+
+    $intf{BOOTPROTO} ||= 'static';
+    $intf{isPtp} = $intf{NETWORK} eq '255.255.255.255';
+    $intf{isUp} = 1;
+    \%intf;
+}
+
+sub write_conf {
+    my ($file, $netc) = @_;
+
+    add2hash($netc, {
+		     NETWORKING => "yes", 
+		     FORWARD_IPV4 => "false", 
+		     HOSTNAME => "localhost.localdomain",
+		     DOMAINNAME => "localdomain",
+		     });
+		     
+    setVarsInSh($file, $netc, qw(NETWORKING FORWARD_IPV4 HOSTNAME DOMAINNAME GATEWAY GATEWAYDEV));
+}
+
+sub add2hosts {
+    my ($file, $ip, $hostname) = @_;
+    my %l = ($ip => $hostname);
+
+    local *F;
+    if (-e $file) {
+	open F, $file or die "cannot open $file: $!";
+	/\s*(\S+)(.*)/ and $l{$1} = $2 foreach <F>;
+    }
+    log::l("writing host information to $file");
+    open F, ">$file" or die "cannot write $file: $!";
+    while (my ($ip, $v) = each %l) {
+	print F "$ip";
+	if ($v =~ /^\s/) {
+	    print F $v;
+	} else {
+	    print F "\t\t$v";
+	    print F " $1" if $v =~ /(.*?)\./;
+	}
+	print F "\n";
+    }
+}
+
+sub write_resolv_conf {
+    my ($file, $netc) = @_;
+
+    # We always write these, even if they were autoconfigured. Otherwise, the reverse name lookup in the install doesn't work. 
+    unless ($netc->{DOMAINNAME} || $netc->{dnsServers}) {
+	unlink($file);
+	log::l("neither domain name nor dns server are configured");
+	return 0;
+    }
+    my @l = cat_($file);
+
+    local *F;
+    open F, "> $file" or die "cannot write $file: $!";
+    print F "search $netc->{DOMAINNAME}\n" if $netc->{DOMAINNAME};
+    print F "nameserver $_\n" foreach @{$netc->{dnsServers}};
+    print F "#$_" foreach @l;
+
+    #res_init();		# reinit the resolver so DNS changes take affect 
+    1;
+}
+
+sub write_interface_conf {
+    my ($file, $intf) = @_;
+
+    add2hash($intf, { ONBOOT => "yes" });
+    setVarsInSh($file, $intf, qw(DEVICE BOOTPROTO IPADDR NETMASK NETWORK BROADCAST ONBOOT));
+}
+
+
+# The interface/gateway needs to be configured before this will work! 
+sub guessHostname {
+    my ($prefix, $netc, $intf) = @_;
+
+    $intf->{isUp} && $netc->{dnsServers} or return 0;
+    $netc->{HOSTNAME} && $netc->{DOMAINNAME} and return 1;
+
+    write_resolv_conf("$prefix/etc/resolv.conf", $netc);
+
+#    winStatus(40, 3, _("Hostname"), _("Determining host name and domain..."));
+    my $name = gethostbyaddr(Socket::inet_aton($intf->{IPADDR}), AF_INET) or log::l("reverse name lookup failed"), return 0;
+
+    log::l("reverse name lookup worked");
+
+    add2hash($netc, { HOSTNAME => $name, DOMAINNAME => $name =~ /\.(.*)/ });
+    1;
+}
+
+sub addDefaultRoute {
+    my ($netc) = @_;
+    c::addDefaultRoute($netc->{gateway}) if $netc->{gateway} || !$::testing;
+}
+
+sub getAvailableNetDevice {
+    my $device = detect_devices::getNet();
+
+    unless ($device) {
+	modules::load_thiskind('net') or return;
+	$device = detect_devices::getNet();
+    }
+    $device;
+}
+
diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm
index 861c657e2..5ef63bc65 100644
--- a/perl-install/partition_table.pm
+++ b/perl-install/partition_table.pm
@@ -11,7 +11,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @important_types @fields2save);
 @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
 
 
-use common qw(:common :system);
+use common qw(:common :system :functional);
 use partition_table_raw;
 use Data::Dumper;
 
@@ -88,22 +88,22 @@ sub type2fs($) { $type2fs{$_[0]} }
 sub name2type($) { $types_rev{$_[0]} }
 sub fs2type($) { $fs2type{$_[0]} }
 
-sub isExtended($) { $_[0]->{type} == 5 }
-sub isSwap($) { $type2fs{$_[0]->{type}} eq 'swap' }
-sub isExt2($) { $type2fs{$_[0]->{type}} eq 'ext2' }
-sub isDos($) { $ {{ 1=>1, 4=>1, 6=>1 }}{$_[0]->{type}} }
-sub isWin($) { $ {{ 0xb=>1, 0xc=>1, 0xe=>1 }}{$_[0]->{type}} }
-sub isNfs($) { $_[0]->{type} eq 'nfs' } # small hack
+sub isExtended($) { $_[0]{type} == 5 }
+sub isSwap($) { $type2fs{$_[0]{type}} eq 'swap' }
+sub isExt2($) { $type2fs{$_[0]{type}} eq 'ext2' }
+sub isDos($) { $ {{ 1=>1, 4=>1, 6=>1 }}{$_[0]{type}} }
+sub isWin($) { $ {{ 0xb=>1, 0xc=>1, 0xe=>1 }}{$_[0]{type}} }
+sub isNfs($) { $_[0]{type} eq 'nfs' } # small hack
 
 sub isPrimary($$) {
     my ($part, $hd) = @_;
-    foreach (@{$hd->{primary}->{raw}}) { $part eq $_ and return 1; }
+    foreach (@{$hd->{primary}{raw}}) { $part eq $_ and return 1; }
     0;
 }
 
 sub cylinder_size($) { 
     my ($hd) = @_;
-    $hd->{geom}->{sectors} * $hd->{geom}->{heads};
+    $hd->{geom}{sectors} * $hd->{geom}{heads};
 }
 
 sub adjustStart($$) {
@@ -111,8 +111,8 @@ sub adjustStart($$) {
     my $end = $part->{start} + $part->{size};
 
     $part->{start} = round_up($part->{start}, 
-			       $part->{start} % cylinder_size($hd) < 2 * $hd->{geom}->{sectors} ?
-			       $hd->{geom}->{sectors} : cylinder_size($hd));
+			       $part->{start} % cylinder_size($hd) < 2 * $hd->{geom}{sectors} ?
+			       $hd->{geom}{sectors} : cylinder_size($hd));
     $part->{size} = $end - $part->{start};
 }
 sub adjustEnd($$) {
@@ -138,26 +138,32 @@ 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) {
+sub verifyParts_ {
+    foreach my $i (@_) { foreach (@_) {
 	$i != $_ and verifyNotOverlap($i, $_) || die "partitions $i->{start} $i->{size} and $_->{start} $_->{size} are overlapping!";
     }}
 }
+sub verifyParts($) {
+    my ($hd) = @_;
+    verifyParts_(get_normal_parts($hd));
+}
+sub verifyPrimary($) {
+    my ($pt) = @_;
+    verifyParts_(@{$pt->{normal}}, $pt->{extended});
+}
 
 sub assign_device_numbers($) {
     my ($hd) = @_;
 
     my $i = 1; 
-    $_->{device} = $hd->{prefix} . $i++ foreach @{$hd->{primary}->{raw}}, 
+    $_->{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}->{normal}};
+    my ($c, @others) = grep { isDos($_) || isWin($_) } @{$hd->{primary}{normal}};
     $c or return;
 
     $i = ord 'D';
@@ -170,7 +176,7 @@ sub assign_device_numbers($) {
 
 sub remove_empty_extended($) {
     my ($hd) = @_;
-    my $last = $hd->{primary}->{extended} or return;
+    my $last = $hd->{primary}{extended} or return;
     @{$hd->{extended}} = grep {
 	if ($_->{normal}) {
 	    $last = $_;
@@ -189,27 +195,27 @@ sub adjust_main_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};
+	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;
+	$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};
+    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
+    verifyParts($hd); # verify everything is all right
 }
 
 
 sub get_normal_parts($) {
     my ($hd) = @_;
 
-    @{$hd->{primary}->{normal} || []}, map { $_->{normal} } @{$hd->{extended} || []}
+    @{$hd->{primary}{normal} || []}, map { $_->{normal} } @{$hd->{extended} || []}
 }
 
 
@@ -257,14 +263,14 @@ sub read_extended($$) {
 
     @{$pt->{normal}} <= 1 or die "more than one normal partition in extended partition";
     @{$pt->{normal}} >= 1 or die "no normal partition in extended partition";
-    $pt->{normal} = $pt->{normal}->[0];
+    $pt->{normal} = $pt->{normal}[0];
     # in case of extended partitions, the start sector is local to the partition or to the first extended_part!
-    $pt->{normal}->{start} += $pt->{start};
+    $pt->{normal}{start} += $pt->{start};
 
-    verifyInside($pt->{normal}, $extended) or die "partition $pt->{normal}->{device} is not inside its extended partition";
+    verifyInside($pt->{normal}, $extended) or die "partition $pt->{normal}{device} is not inside its extended partition";
 
     if ($pt->{extended}) {
-	$pt->{extended}->{start} += $hd->{primary}->{extended}->{start};
+	$pt->{extended}{start} += $hd->{primary}{extended}{start};
 	read_extended($hd, $pt->{extended}) or return 0;
     }
     1;
@@ -275,15 +281,15 @@ sub write($) {
     my ($hd) = @_;
 
     # set first primary partition active if no primary partitions are marked as active.
-    for ($hd->{primary}->{raw}) {
-	(grep { $_->{local_start} = $_->{start}; $_->{active} ||= 0 } @$_) or $_->[0]->{active} = 0x80;
+    for ($hd->{primary}{raw}) {
+	(grep { $_->{local_start} = $_->{start}; $_->{active} ||= 0 } @$_) or $_->[0]{active} = 0x80;
     }
-    partition_table_raw::write($hd, 0, $hd->{primary}->{raw}) or die "writing of partition table failed";
+    partition_table_raw::write($hd, 0, $hd->{primary}{raw}) or die "writing of partition table failed";
 
     foreach (@{$hd->{extended}}) {
 	# in case of extended partitions, the start sector must be local to the partition
-	$_->{normal}->{local_start} = $_->{normal}->{start} - $_->{start};
-	$_->{extended} and $_->{extended}->{local_start} = $_->{extended}->{start} - $hd->{primary}->{extended}->{start};
+	$_->{normal}{local_start} = $_->{normal}{start} - $_->{start};
+	$_->{extended} and $_->{extended}{local_start} = $_->{extended}{start} - $hd->{primary}{extended}{start};
 
 	partition_table_raw::write($hd, $_->{start}, $_->{raw}) or die "writing of partition table failed";
     }
@@ -300,7 +306,7 @@ sub write($) {
 sub active($$) {
     my ($hd, $part) = @_;
 
-    $_->{active} = 0 foreach @{$hd->{primary}->{normal}};
+    $_->{active} = 0 foreach @{$hd->{primary}{normal}};
     $part->{active} = 0x80;   
 }
 
@@ -311,9 +317,9 @@ sub remove($$) {
     my $i;
 
     # first search it in the primary partitions
-    $i = 0; foreach (@{$hd->{primary}->{normal}}) {
+    $i = 0; foreach (@{$hd->{primary}{normal}}) {
 	if ($_ eq $part) {
-	    splice(@{$hd->{primary}->{normal}}, $i, 1);
+	    splice(@{$hd->{primary}{normal}}, $i, 1);
 	    %$_ = (); # blank it
 
 	    return $hd->{isDirty} = $hd->{needKernelReread} = 1;
@@ -337,18 +343,18 @@ sub add_primary($$) {
     my ($hd, $part) = @_;
 
     {
-	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;
+	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);
+	raw_add($hd->{primary}{raw}, $part);
     }
-    push @{$hd->{primary}->{normal}}, $part; # really do it
+    push @{$hd->{primary}{normal}}, $part; # really do it
 }
 
 sub add_extended($$) {
     my ($hd, $part) = @_;
 
-    my $e = $hd->{primary}->{extended};
+    my $e = $hd->{primary}{extended};
 
     if ($e && !verifyInside($part, $e)) {
 	#ie "sorry, can't add outside the main extended partition" unless $::unsafe;
@@ -371,8 +377,8 @@ The only solution is to move your primary partitions to have the hole next to th
 	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};
+	$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 :)
@@ -403,9 +409,9 @@ sub add($$;$) {
     $part->{start} ||= 1; # starting at sector 0 is not allowed
     adjustStartAndEnd($hd, $part);
 
-    my $e = $hd->{primary}->{extended};
+    my $e = $hd->{primary}{extended};
 
-    if (is_empty_array_ref($hd->{primary}->{normal}) || $want_primary) {
+    if (is_empty_array_ref($hd->{primary}{normal}) || $want_primary) {
 	eval { add_primary($hd, $part) };
 	return unless $@;
     }
@@ -461,7 +467,7 @@ sub load($$;$) {
 
     my %h; @h{@fields2save} = @$h;
 
-    $h{totalsectors} == $hd->{totalsectors} or $force or die "Bad totalsectors";
+    $h{totalsectors} == $hd->{totalsectors} or $force or cdie("Bad totalsectors");
 
     # unsure we don't modify totalsectors
     local $hd->{totalsectors};
diff --git a/perl-install/partition_table_raw.pm b/perl-install/partition_table_raw.pm
index 67223e392..aa25321a2 100644
--- a/perl-install/partition_table_raw.pm
+++ b/perl-install/partition_table_raw.pm
@@ -34,8 +34,8 @@ sub CHS2rawCHS($$$) {
 sub sector2CHS($$) {
     my ($hd, $start) = @_;
     my ($s, $h);
-    ($start, $s) = divide($start, $hd->{geom}->{sectors});
-    ($start, $h) = divide($start, $hd->{geom}->{heads});
+    ($start, $s) = divide($start, $hd->{geom}{sectors});
+    ($start, $h) = divide($start, $hd->{geom}{heads});
     ($start, $h, $s + 1);
 }
 
@@ -51,7 +51,7 @@ sub get_geometry($) {
     { geom => \%geom, totalsectors => $geom{heads} * $geom{sectors} * $geom{cylinders} };
 }
 
-sub openit($$;$) { sysopen $_[1], $_[0]->{file}, $_[2] || 0; }
+sub openit($$;$) { sysopen $_[1], $_[0]{file}, $_[2] || 0; }
 
 # cause kernel to re-read partition table 
 sub kernel_read($) {
@@ -102,6 +102,6 @@ sub write($$$) {
 sub clear_raw { { raw => [ ({}) x $nb_primary ] } }
 
 sub zero_MBR($) { 
-    $_[0]->{primary} = clear_raw();
-    delete $_[0]->{extended};
+    $_[0]{primary} = clear_raw();
+    delete $_[0]{extended};
 }
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 340036fc9..970fa2209 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -92,16 +92,6 @@ sub set($$$) {
     $val ? &select($packages, $p) : unselect($packages, $p);
 }
 
-sub addInfosFromHeader($$;$) {
-    my ($packages, $header, $file) = @_;
-
-    my $name = c::headerGetEntry($header, 'name');
-    $packages->{$name} = {
-        name => $name, file => $file, selected => 0, deps => [],
-	header => $header, size => c::headerGetEntry($header, 'size'),
-    };
-}
-
 sub psUsingDirectory(;$) {
     my ($dirname) = @_;
     my %packages;
@@ -119,6 +109,10 @@ sub psUsingDirectory(;$) {
     \%packages;
 }
 
+sub chop_version($) { 
+    first($_[0] =~ /(.*)-[^-]+-[^-.]+/) || $_[0];
+}
+
 sub getDeps($) {
     my ($packages) = @_;
 
@@ -126,10 +120,11 @@ sub getDeps($) {
     open F, install_any::imageGetFile("depslist") or die "can't find dependencies list";
     foreach (<F>) {
 	my ($name, $size, @deps) = split;
+	($name, @deps) = map { chop_version($_) } ($name, @deps);
 	$packages->{$name} or next;
-	$packages->{$name}->{size} = $size;
-	$packages->{$name}->{deps} = \@deps;
-	map { push @{$packages->{$_}->{provides}}, $name if $packages->{$_} } @deps;
+	$packages->{$name}{size} = $size;
+	$packages->{$name}{deps} = \@deps;
+	map { push @{$packages->{$_}{provides}}, $name if $packages->{$_} } @deps;
     }
 }
 
@@ -186,24 +181,26 @@ sub setCompssSelected($$$) {
     }
 }
 
-sub psFromHeaderListDesc {
+sub addHdlistInfos {
     my ($fd, $noSeek) = @_;
     my %packages;
     my $end;
+    my $file;
+    local *F;
+    sysopen F, $file, 0 or die "error opening header file $file: $!";
 
-    unless ($noSeek) {
-	my $current = sysseek $fd, 0, 1 or die "seek failed";
-	$end = sysseek $fd, 0, 2 or die "seek failed";
-	sysseek $fd, $current, 0 or die "seek failed";
-    }
+    $end = sysseek $fd, 0, 2 or die "seek failed";
+    sysseek $fd, 0, 0 or die "seek failed";
 
-    while (1) {
+    while (sysseek($fd, 0, 1) <= $end) {
 	my $header = c::headerRead(fileno($fd), 1);
 	unless ($header) {
 	    $noSeek and last;
 	    die "error reading header at offset ", sysseek($fd, 0, 1);
 	}
-	addInfosFromHeader(\%packages, $header);
+
+	c::headerGetEntry($header, 'name');
+
 	$noSeek or $end <= sysseek($fd, 0, 1) and last; 
     }
 
@@ -212,13 +209,6 @@ sub psFromHeaderListDesc {
     \%packages;
 }
 
-sub psFromHeaderListFile {
-    my ($file) = @_;
-    local *F;
-    sysopen F, $file, 0 or die "error opening header file $file: $!";
-    psFromHeaderListDesc(\*F, 0);
-}
-
 sub init_db {
     my ($prefix, $isUpgrade) = @_;
 
diff --git a/perl-install/resize_fat/any.pm b/perl-install/resize_fat/any.pm
index 8c57eb6b0..e4747dc87 100644
--- a/perl-install/resize_fat/any.pm
+++ b/perl-install/resize_fat/any.pm
@@ -33,7 +33,7 @@ sub max_cluster_count($) {
 # calculates the minimum size of a partition, in physical sectors
 sub min_size($) {
     my ($fs) = @_;
-    my $count = $fs->{clusters}->{count};
+    my $count = $fs->{clusters}{count};
 
     # directories are both in `used' and `dirs', so are counted twice
     # It's done on purpose since we're moving all directories. So at the worse
@@ -71,12 +71,12 @@ sub flag_clusters {
 
 	for (; !resize_fat::fat::is_eof($cluster); $cluster = resize_fat::fat::next($fs, $cluster)) {
 	    $cluster == 0 and die "Bad FAT: unterminated chain for $entry->{name}\n";
-	    $fs->{fat_flag_map}->[$cluster] and die "Bad FAT: cluster $cluster is cross-linked for $entry->{name}\n";
-	    $fs->{fat_flag_map}->[$cluster] = $type;
-	    $fs->{clusters}->{count}->{dirs}++ if $type == $DIRECTORY;
+	    $fs->{fat_flag_map}[$cluster] and die "Bad FAT: cluster $cluster is cross-linked for $entry->{name}\n";
+	    $fs->{fat_flag_map}[$cluster] = $type;
+	    $fs->{clusters}{count}{dirs}++ if $type == $DIRECTORY;
 	}
     };
     $fs->{fat_flag_map} = [ ($FREE) x ($fs->{nb_clusters} + 2) ];
-    $fs->{clusters}->{count}->{dirs} = 0;
+    $fs->{clusters}{count}{dirs} = 0;
     resize_fat::directory::traverse_all($fs, $f);
 }
diff --git a/perl-install/resize_fat/fat.pm b/perl-install/resize_fat/fat.pm
index 371e90feb..87ce2af71 100644
--- a/perl-install/resize_fat/fat.pm
+++ b/perl-install/resize_fat/fat.pm
@@ -18,7 +18,7 @@ sub read($) {
 	$fat;
     } (0 .. $fs->{nb_fats} - 1);
 
-    $fs->{fat} = $fs->{fats}->[0];
+    $fs->{fat} = $fs->{fats}[0];
 
     my ($free, $bad, $used) = (0, 0, 0);
 
@@ -28,7 +28,7 @@ sub read($) {
 	elsif ($cluster == $resize_fat::bad_cluster_value) { $bad++; }
 	else { $used++; }
     }
-    @{$fs->{clusters}->{count}}{qw(free bad used)} = ($free, $bad, $used);
+    @{$fs->{clusters}{count}}{qw(free bad used)} = ($free, $bad, $used);
 }
 
 sub write($) {
@@ -49,7 +49,7 @@ sub write($) {
 sub allocate_remap {
     my ($fs, $cut_point) = @_;
     my ($cluster, $new_cluster);
-    my $remap = sub { $fs->{fat_remap}->[$cluster] = $new_cluster; };
+    my $remap = sub { $fs->{fat_remap}[$cluster] = $new_cluster; };
     my $get_new = sub {
 	$new_cluster = get_free($fs);
 	0 < $new_cluster && $new_cluster < $cut_point or die "no free clusters";
@@ -57,11 +57,11 @@ sub allocate_remap {
 	#log::ld("resize_fat: [$cluster,", &next($fs, $cluster), "...]->$new_cluster...");
     };
 
-    $fs->{fat_remap}->[0] = 0;
+    $fs->{fat_remap}[0] = 0;
     $fs->{last_free_cluster} = 2;
     for ($cluster = 2; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
 	if ($cluster < $cut_point) {
-	    if ($fs->{fat_flag_map}->[$cluster] == $resize_fat::any::DIRECTORY) {
+	    if ($fs->{fat_flag_map}[$cluster] == $resize_fat::any::DIRECTORY) {
 		&$get_new();
 	    } else {
 		$new_cluster = $cluster;
@@ -80,10 +80,10 @@ sub update {
     my ($fs) = @_;
 
     for (my $cluster = 2; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
-	 if ($fs->{fat_flag_map}->[$cluster]) {
+	 if ($fs->{fat_flag_map}[$cluster]) {
 	     my $old_next = &next($fs, $cluster);
-	     my $new      = $fs->{fat_remap}->[$cluster];
-	     my $new_next = $fs->{fat_remap}->[$old_next];
+	     my $new      = $fs->{fat_remap}[$cluster];
+	     my $new_next = $fs->{fat_remap}[$old_next];
 
 	     set_available($fs, $cluster);
 
@@ -101,7 +101,7 @@ sub update {
 sub check($) {
     my ($fs) = @_;
     foreach (@{$fs->{fats}}) {
-	$_ eq $fs->{fats}->[0] or die "FAT tables do not match";
+	$_ eq $fs->{fats}[0] or die "FAT tables do not match";
     }
 }
 
diff --git a/perl-install/resize_fat/info_sector.pm b/perl-install/resize_fat/info_sector.pm
index 5b92501ea..2eacf58ca 100644
--- a/perl-install/resize_fat/info_sector.pm
+++ b/perl-install/resize_fat/info_sector.pm
@@ -22,13 +22,13 @@ sub read($) {
     my ($fs) = @_;
     my $info = resize_fat::io::read($fs, $fs->{info_offset}, psizeof($format));
     @{$fs->{info_sector}}{@fields} = unpack $format, $info;
-    $fs->{info_sector}->{signature} == 0x61417272 or die "Invalid information sector signature\n";
+    $fs->{info_sector}{signature} == 0x61417272 or die "Invalid information sector signature\n";
 }
 
 sub write($) {
     my ($fs) = @_;
-    $fs->{info_sector}->{free_clusters} = $fs->{clusters}->{count}->{free};
-    $fs->{info_sector}->{next_cluster} = 2;
+    $fs->{info_sector}{free_clusters} = $fs->{clusters}->{count}->{free};
+    $fs->{info_sector}{next_cluster} = 2;
 
     my $info = pack $format, @{$fs->{info_sector}}{@fields};
 
diff --git a/perl-install/resize_fat/main.pm b/perl-install/resize_fat/main.pm
index 6239e6075..55cc34d7b 100644
--- a/perl-install/resize_fat/main.pm
+++ b/perl-install/resize_fat/main.pm
@@ -64,8 +64,8 @@ sub copy_clusters {
 	}
     };
     for (; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
-	$fs->{fat_flag_map}->[$cluster] == $resize_fat::any::FILE or next;
-	push @buffer, $fs->{fat_remap}->[$cluster], resize_fat::io::read_cluster($fs, $cluster);
+	$fs->{fat_flag_map}[$cluster] == $resize_fat::any::FILE or next;
+	push @buffer, $fs->{fat_remap}[$cluster], resize_fat::io::read_cluster($fs, $cluster);
 	@buffer > 50 and &$flush();
     }
     &$flush();
@@ -78,14 +78,14 @@ sub construct_dir_tree {
     if ($resize_fat::isFAT32) { 
 	# fat32's root must remain in the first 64k clusters
 	# so don't set it as DIRECTORY, it will be specially handled
-	$fs->{fat_flag_map}->[$fs->{fat32_root_dir_cluster}] = $resize_fat::any::FREE;
+	$fs->{fat_flag_map}[$fs->{fat32_root_dir_cluster}] = $resize_fat::any::FREE;
     }
 
     for (my $cluster = 2; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
-	$fs->{fat_flag_map}->[$cluster] == $resize_fat::any::DIRECTORY or next;
+	$fs->{fat_flag_map}[$cluster] == $resize_fat::any::DIRECTORY or next;
 
       resize_fat::io::write_cluster($fs, 
-				    $fs->{fat_remap}->[$cluster], 
+				    $fs->{fat_remap}[$cluster], 
 				  resize_fat::directory::remap($fs, resize_fat::io::read_cluster($fs, $cluster)));
     }
 
@@ -101,7 +101,7 @@ sub construct_dir_tree {
 	my $cluster = $fs->{fat32_root_dir_cluster};
 
 	resize_fat::io::write_cluster($fs, 
-		      $fs->{fat_remap}->[$cluster], 
+		      $fs->{fat_remap}[$cluster], 
 		      resize_fat::directory::remap($fs, resize_fat::io::read_cluster($fs, $cluster)));
     } else {
 	resize_fat::io::write($fs, $fs->{root_dir_offset}, $fs->{root_dir_size},
@@ -147,8 +147,8 @@ sub resize {
 
     $fs->{nb_sectors} = $size;
     $fs->{nb_clusters} = $new_nb_clusters;
-    $fs->{clusters}->{count}->{free} = 
-	$fs->{nb_clusters} - $fs->{clusters}->{count}->{used} - $fs->{clusters}->{count}->{bad} - 2;
+    $fs->{clusters}{count}->{free} = 
+	$fs->{nb_clusters} - $fs->{clusters}{count}->{used} - $fs->{clusters}->{count}->{bad} - 2;
 
     $fs->{system_id} = 'was here!';
     $fs->{small_nb_sectors} = 0;
diff --git a/perl-install/share/diskdrake.rc b/perl-install/share/diskdrake.rc
index 6d315056e..e92a089b4 100644
--- a/perl-install/share/diskdrake.rc
+++ b/perl-install/share/diskdrake.rc
@@ -21,6 +21,7 @@ style "blue" = "font"
 style "white" = "font"
 {
   bg[NORMAL] = { 1.0, 1.0, 1.0 }
+  bg[PRELIGHT] = { 0.67, 0.67, 0.67 }
 }
 
 widget "*Linux*" style "red" 
diff --git a/perl-install/share/install.rc b/perl-install/share/install.rc
index aa893579d..44e808c66 100644
--- a/perl-install/share/install.rc
+++ b/perl-install/share/install.rc
@@ -1,22 +1,14 @@
-
-
-style "border"
-{
-  bg[NORMAL] = { 0, 0, 0 }
-}
-
 style "steps"
 {
   bg[NORMAL] = { 0, 0, 0 }
   fg[NORMAL] = { 1.0, 1.0, 1.0 }
+  font = "-adobe-helvetica-medium-r-normal-*-*-80-*-*-p-*-iso8859-1"	
 }
 
-style "title"
+style "logo"
 {
-  bg[NORMAL] = { 0, 0.66, 1.0 }
-#  fg[NORMAL] = { 1.0, 1.0, 1.0 }
+  bg[NORMAL] = { 1.0, 1.0, 1.0 }
 }
 
-
-widget "*Title" style "title"
-widget "*Steps" style "steps"
+widget "*Steps*" style "steps"
+widget "*logo*" style "logo"
\ No newline at end of file
diff --git a/perl-install/share/list b/perl-install/share/list
index 301cbb4a7..3ab0eed94 100644
--- a/perl-install/share/list
+++ b/perl-install/share/list
@@ -1,6 +1,8 @@
 /bin/ash
+/bin/cpio
 /sbin/insmod
 /sbin/mke2fs
+/usr/bin/bzip2
 /usr/lib/rpm/rpmrc
 /usr/X11R6/bin/xmodmap
 /usr/X11R6/bin/XF86_VGA16
diff --git a/perl-install/share/themes-blackwhite.rc b/perl-install/share/themes-blackwhite.rc
new file mode 100644
index 000000000..bc94df9aa
--- /dev/null
+++ b/perl-install/share/themes-blackwhite.rc
@@ -0,0 +1,40 @@
+style "any"
+{
+  font = "-adobe-helvetica-medium-r-normal-*-*-100-*-*-p-*-iso8859-1"
+
+  bg[NORMAL]      = { 0.67, 0.67, 0.67 }
+  bg[ACTIVE]      = { 0, 0, 0 }
+  bg[PRELIGHT]    = { 0, 0, 0 }
+  bg[INSENSITIVE] = { 0, 0, 0 }
+  
+  fg[NORMAL]  	  = { 1.0, 1.0, 1.0 }
+  fg[ACTIVE]  	  = { 1.0, 1.0, 1.0 }
+  fg[PRELIGHT]    = { 1.0, 1.0, 1.0 }
+  fg[INSENSITIVE] = { 1.0, 1.0, 1.0 }
+}
+
+style "entry"
+{
+  base[NORMAL] = { 1.0, 1.0, 1.0 }
+  fg[NORMAL] = { 0.67, 0.67, 0.67 }
+}
+
+style "button"
+{
+  bg[NORMAL] = { 1.0, 1.0, 1.0 }
+  fg[NORMAL] = { 0, 0, 0 }
+  bg[PRELIGHT] = { 1.0, 1.0, 1.0 }
+  fg[PRELIGHT] = { 0.67, 0.67, 0.67 }
+}
+
+style "background"
+{
+  bg[NORMAL] = { 0.67, 0.67, 0.67 }
+}
+
+widget_class "*" style "any"
+widget_class "*GtkEntry*" style "entry"
+widget_class "*GtkSpin*" style "entry"
+widget_class "*Gtk*List*" style "entry"
+widget "*GtkButton*" style "button"
+widget "*background*" style "background"
diff --git a/perl-install/share/themes-blue.rc b/perl-install/share/themes-blue.rc
new file mode 100644
index 000000000..1404d4dce
--- /dev/null
+++ b/perl-install/share/themes-blue.rc
@@ -0,0 +1,36 @@
+style "any"
+{
+  font = "-adobe-helvetica-medium-r-normal-*-*-100-*-*-p-*-iso8859-1"
+
+  bg[NORMAL]      = { 0, 0, 0.67 }
+  bg[ACTIVE]      = { 0, 0.67, 1.0 }
+  bg[PRELIGHT]    = { 0, 0, 1.0 }
+  bg[INSENSITIVE] = { 1.0, 0, 0.67 }
+  
+  fg[NORMAL]  	  = { 1.0, 1.0, 1.0 }
+  fg[ACTIVE]  	  = { 1.0, 1.0, 1.0 }
+  fg[PRELIGHT]    = { 1.0, 1.0, 1.0 }
+  fg[INSENSITIVE] = { 1.0, 1.0, 1.0 }
+}
+
+style "entry"
+{
+  base[NORMAL] = { 0, 1.0, 1.0 }
+  fg[NORMAL] = { 0.67, 0, 0.67 }
+}
+
+style "button" = "any"
+{
+}
+
+style "background"
+{
+  bg[NORMAL] = { 0, 0.67, 1.0 }
+}
+
+widget_class "*" style "any"
+widget_class "*GtkEntry*" style "entry"
+widget_class "*GtkSpin*" style "entry"
+widget_class "*Gtk*List*" style "entry"
+widget "*GtkButton*" style "button"
+widget "*background*" style "background"
diff --git a/perl-install/share/themes-savane.rc b/perl-install/share/themes-savane.rc
new file mode 100644
index 000000000..43e67583c
--- /dev/null
+++ b/perl-install/share/themes-savane.rc
@@ -0,0 +1,39 @@
+style "any"
+{
+  font = "-adobe-helvetica-medium-r-normal-*-*-100-*-*-p-*-iso8859-1"
+
+  bg[NORMAL]      = { 0.67, 0.33, 0 }
+  bg[PRELIGHT]      = { 1.0, 1.0, 0 }
+  bg[INSENSITIVE] = { 1.0, 0, 0.67 }
+  
+  fg[NORMAL] = { 1.0, 1.0, 1.0 }
+  fg[ACTIVE] = { 1.0, 1.0, 1.0 }
+  fg[PRELIGHT] = { 1.0, 1.0, 1.0 }
+  fg[INSENSITIVE]   = { 1.0, 1.0, 1.0 }
+}
+
+style "entry"
+{
+  base[NORMAL] = { 1.0, 1.0, 1.0 }
+  fg[NORMAL] = { 0, 0, 0 }
+}
+
+style "button"
+{
+  bg[NORMAL] = { 1.0, 0.67, 0 }
+  fg[NORMAL] = { 0, 0, 0 }
+  bg[PRELIGHT] = { 1.0, 1.0, 0 }
+  fg[PRELIGHT] = { 0, 0, 0 }
+}
+
+style "background"
+{
+  bg[NORMAL] = { 0, 0.67, 0 }
+}
+
+widget_class "*" style "any"
+widget_class "*GtkEntry*" style "entry"
+widget_class "*GtkSpin*" style "entry"
+widget_class "*Gtk*List*" style "entry"
+widget "*GtkButton*" style "button"
+widget "*background*" style "background"
diff --git a/perl-install/share/themes.rc b/perl-install/share/themes.rc
new file mode 100644
index 000000000..5d8db5b90
--- /dev/null
+++ b/perl-install/share/themes.rc
@@ -0,0 +1,18 @@
+style "savane"
+{
+  bg[NORMAL] = { 1.0, 0.67, 0 }
+  bg[PRELIGHT] = { 0.67, 0.33, 0 }
+}
+style "blackwhite"
+{
+  bg[NORMAL] = { 0.67, 0.67, 0.67 }
+  bg[PRELIGHT] = { 1.0, 1.0, 1.0 }
+}
+style "blue"
+{
+  bg[NORMAL] = { 0, 0, 0.67 }
+  bg[PRELIGHT] = { 0, 0, 1.0 }
+}
+widget "*savane*" style "savane"
+widget "*blackwhite*" style "blackwhite"
+widget "*blue*" style "blue"