"See_The_Changelog"

38 files changed, 4718 insertions, 0 deletions

diff --git a/perl-install/Makefile b/perl-install/Makefile
new file mode 100644
index 000000000..68fe70782
--- /dev/null
+++ b/perl-install/Makefile
@@ -0,0 +1,114 @@
+SO_FILES = c/blib/arch/auto/c/c.so
+PMS = *.pm resize_fat/*.pm commands diskdrake
+DEST = /tmp/t
+DESTREP4PMS = $(DEST)/usr/bin/perl-install
+PERL = ./perl
+BINS = /bin/ash /sbin/mke2fs $(PERL)
+
+.PHONY: all tags install clean verify_c
+
+all: $(SO_FILES)
+
+tags:
+	etags -o - $(PMS) | perl2etags > TAGS
+
+clean:
+	test ! -e c/Makefile || $(MAKE) -C c clean
+	find . -name "*~" -name "TAGS" -name "*.old" | xargs rm -f
+
+tar: clean
+	cd .. ; tar cfy perl-install.tar.bz2 --exclude perl-install/perl perl-install
+
+c/c.xs: c/c.xs.pm
+	chmod u+w $@
+	perl $< > $@
+	chmod a-w $@
+
+$(SO_FILES): c/c.xs
+	test -e c/Makefile || (cd c; perl Makefile.PL)
+	$(MAKE) -C c
+
+test_pms: verify_c
+	perl2fcalls -excludec install2.pm
+	(for i in $(PMS); do perl -cw -I. -Ic -Ic/blib/arch $$i || exit 1 ; done)
+
+verify_c:
+	./verify_c $(PMS)
+
+install_pms: $(SO_FILES)
+	for i in `perl -ne 's/sub (\w+?)_? {.*/$$1/ and print' commands.pm`; do ln -sf commands $(DEST)/usr/bin/$$i; done
+
+	install -d $(DESTREP4PMS)
+	for i in $(PMS); do \
+		dest=$(DESTREP4PMS)/`dirname $$i`; \
+		install -d $$dest; \
+		perl -ne 'print #unless /^use (diagnostics|vars|strict)/' $$i > $(DESTREP4PMS)/$$i; \
+	done
+	@#	cp -f $$i $$dest; \
+	cp diskdrake.rc $(DESTREP4PMS)
+	ln -sf perl-install/install2.pm $(DEST)/usr/bin/install2
+	ln -sf perl-install/commands $(DEST)/usr/bin/commands
+	chmod a+x $(DESTREP4PMS)/install2.pm
+	chmod a+x $(DESTREP4PMS)/commands
+
+	cp -af */blib/arch/auto $(DESTREP4PMS)
+	find $(DESTREP4PMS) -name "*.so" | xargs strip
+
+full_tar:
+	cp -af /usr/lib/perl5/site_perl/5.005/i386-linux/Gtk* $(DESTREP4PMS)
+	cp -af /usr/lib/perl5/site_perl/5.005/i386-linux/auto/Gtk $(DESTREP4PMS)/auto
+	find $(DESTREP4PMS) -name "*.so" | xargs strip
+	cd $(DESTREP4PMS)/.. ; tar cfz /tmp/perl-install.tgz perl-install
+
+get_needed_files: $(SO_FILES)
+	export PERL_INSTALL_TEST=1 ; strace -f -e trace=file -o '| grep -v "(No such file or directory)" | sed -e "s/[^\"]*\"//" -e "s/\".*//" | grep "^/" | grep -v -e "^/tmp" -e "^/home" -e "^/proc" -e "^/var" -e "^/dev" -e "^/etc" -e "^/usr/lib/rpm" > /tmp/list ' $(PERL) -d install2.pm < /dev/null
+
+	install -d $(DEST)/bin
+	install -d $(DEST)/usr/bin
+	for i in $(BINS) `grep "\.so" /tmp/list`; do \
+		install -s $$i $(DEST)/usr/bin; \
+		ldd $$i | sed -e 's/.*=> //' -e 's/ .*//' >> /tmp/list; \
+	done
+	for i in `sort /tmp/list | uniq`; do \
+		install -d $(DEST)/`dirname $$i` && \
+		if (echo $$i | grep "\.pm"); then \
+		   perl -pe '$$_ eq "__END__" and exit(0);' $$i > $(DEST)/$$i; \
+		else \
+			cp -f $$i $(DEST)/$$i; \
+		fi && \
+		strip $(DEST)/$$i 2>/dev/null || true; \
+	done
+	mv $(DEST)/usr/lib/*.so* $(DEST)/lib
+
+	ln -sf ../usr/bin/sh $(DEST)/bin/sh
+	ln -sf ../usr/bin/tr $(DEST)/bin/tr
+	ln -sf sh $(DEST)/bin/bash
+	ln -sf ash $(DEST)/usr/bin/sh
+
+	echo -e "#!/usr/bin/perl\n\nsymlink '/tmp/rhimage/usr/lib/perl5', '/usr/lib/perl5';\nexec '/bin/sh'" > $(DEST)/usr/bin/runinstall2
+	chmod a+x $(DEST)/usr/bin/runinstall2
+
+as_root:
+	/bin/dd if=/dev/zero of=/tmp/initrd bs=1k count=4000
+	echo y | /sbin/mke2fs /tmp/initrd
+	losetup /dev/loop0 /tmp/initrd
+	mount /dev/loop0 /mnt/initrd
+	chmod a+w /mnt/initrd
+
+full_stage2:
+	rm -rf $(DEST)/[^M]*
+	@#mkdir -p $(DEST)/Mandrake/base
+	@#ln -s .. $(DEST)/Mandrake/instimage
+	$(MAKE) get_needed_files 
+	$(MAKE) stage2
+
+stage2:
+	$(MAKE) install_pms
+
+	@#rm -rf /mnt/initrd/*
+	@#cp -a $(DEST)/* /mnt/initrd
+	@#sync
+	@#dd if=/dev/loop0 | gzip -9 > /tmp/t/Mandrake/base/stage2.img
+
+
+# function f() { grep "$*" /usr/include/*.h /usr/include/*/*.h; }
diff --git a/perl-install/c.pm b/perl-install/c.pm
new file mode 100644
index 000000000..d1da19f2d
--- /dev/null
+++ b/perl-install/c.pm
@@ -0,0 +1,25 @@
+package c;
+
+use strict;
+use vars qw($VERSION @ISA);
+
+require DynaLoader;
+
+@ISA = qw(DynaLoader);
+$VERSION = '0.01';
+
+bootstrap c $VERSION;
+
+1;
+
+sub headerGetEntry {
+    my ($h, $q) = @_;
+
+    $q eq 'name' and return headerGetEntry_string($h, RPMTAG_NAME());
+    $q eq 'group' and return headerGetEntry_string($h, RPMTAG_GROUP());
+    $q eq 'version' and return headerGetEntry_string($h, RPMTAG_VERSION());
+    $q eq 'release' and return headerGetEntry_string($h, RPMTAG_RELEASE());
+    $q eq 'arch' and return headerGetEntry_string($h, RPMTAG_ARCH());
+    $q eq 'size' and return headerGetEntry_int($h, RPMTAG_SIZE());
+}
+
diff --git a/perl-install/c/Makefile.PL b/perl-install/c/Makefile.PL
new file mode 100644
index 000000000..bb7eed0d1
--- /dev/null
+++ b/perl-install/c/Makefile.PL
@@ -0,0 +1,11 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    'NAME'	=> 'c',
+    'VERSION_FROM' => 'c.pm', # finds $VERSION
+    'LIBS'	=> ['-ldb1 -lz'],   # e.g., '-lm' 
+#    'OBJECT'    => 'c.o librpm.a',
+    'DEFINE'	=> '',     # e.g., '-DHAVE_SOMETHING' 
+    'INC'	=> '-Wall',     # e.g., '-I/usr/include/other' 
+);
diff --git a/perl-install/commands b/perl-install/commands
new file mode 100755
index 000000000..66574c7dc
--- /dev/null
+++ b/perl-install/commands
@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+
+use diagnostics;
+use strict;
+
+use lib qw(/usr/bin/perl-install /home/pixel/perl-install . c c/blib/arch);
+use common qw(:file);
+use commands;
+
+my $progname = basename($0);
+
+# hack as some functions are defined by perl... so chmod -> chmod_
+&{$commands::{$progname} || $commands::{$progname . "_"} || \&err}(@ARGV), exit 0;
+
+sub err { die "$0: unknown program (unimplemented)\n"; }
diff --git a/perl-install/commands.pm b/perl-install/commands.pm
new file mode 100644
index 000000000..8448a9f24
--- /dev/null
+++ b/perl-install/commands.pm
@@ -0,0 +1,381 @@
+package commands;
+
+use diagnostics;
+use strict;
+use vars qw($printable_chars);
+
+use common qw(:common :file :system :constant);
+
+my $BUFFER_SIZE = 1024;
+
+1;
+
+
+sub getopts {
+    my $o = shift;
+    my @r = map { '' } (@_ = split //, $_[0]);
+    while (1) {
+	local $_ = $o->[0];
+	$_ && /^-/ or return @r;
+	for (my $i = 0; $i < @_; $i++) { /$_[$i]/ and $r[$i] = $_[$i]; }
+	shift @$o;
+    }
+    @r;
+}
+
+sub cat { @ARGV = @_; print while <> }
+sub which { ARG: foreach (@_) { foreach my $c (split /:/, $ENV{PATH}) { -x "$c/$_" and print("$c/$_\n"), next ARG; }}}
+sub dirname_ { print dirname(@_), "\n" }
+sub basename_ { print basename(@_), "\n" }
+sub rmdir_ { foreach (@_) { rmdir $_ or die "rmdir: can't remove $_\n" } }
+sub lsmod { print "Module                  Size  Used by\n"; cat("/proc/modules"); }
+
+sub grep_ { 
+    my ($h, $v) = getopts(\@_, qw(hv));
+    my $r = shift and !$h or die "usage: grep <regexp> [files...]\n"; 
+    @ARGV = @_; (/$r/ ? $v || print : $v && print) while <> 
+}
+
+sub tr_ { 
+    my ($s, $c, $d) = getopts(\@_, qw(s c d));
+    @_ >= 1 + (!$d || $s) or die "usage: tr [-c] [-s [-d]] <set1> <set2> [files...]\n    or tr [-c] -d <set1> [files...]\n";
+    my $set1 = shift;
+    my $set2; !$d || $s and $set2 = shift;
+    @ARGV = @_;
+    eval "(tr/$set1/$set2/$s$d$c, print) while <>";
+}
+
+sub mount {
+    @_ or return cat("/proc/mounts");
+    my ($t) = getopts(\@_, qw(t));
+    my $fs = $t ? shift : $_[0] =~ /:/ ? "nfs" : "ext2";
+
+    @_ == 2 or die "usage: mount [-t <fs>] <device> <dir>\n",
+    "       (if /dev/ is left off the device name, a temporary node will be created)\n";
+
+    require 'fs.pm';
+    fs::mount(@_, $fs, 0, 1);
+}
+
+sub umount {
+    @_ == 1 or die "umount expects a single argument\n";
+
+    require 'fs.pm';
+    fs::umount($_[0]);
+}
+
+sub mkdir_ { 
+    my $rec; $_[0] eq '-p' and $rec = shift;
+
+    my $mkdir; $mkdir = sub {
+	my $root = dirname $_[0];
+	if (-e $root) {
+	    -d $root or die "mkdir: error creating directory $_[0]: $root is a file and i won't delete it\n";
+	} else {
+	    $rec or die "mkdir: $root does not exist (try option -p)\n";
+	    &$mkdir($root);
+	}
+	mkdir $_[0], 0755 or die "mkdir: error creating directory $_: $!\n";
+    };
+    foreach (@_) { &$mkdir($_); }
+}
+
+
+sub mknod {
+    if (@_ == 1) {
+	require 'devices.pm';
+	eval { devices::make($_[0]) }; $@ and die "mknod: failed to create $_[0]\n";
+    } elsif (@_ == 4) {
+	require 'c.pm';
+	my $mode = $ {{"b" => c::S_IFBLK(), "c" => c::S_IFCHR()}}{$_[1]} or die "unknown node type $_[1]\n";
+	syscall_('mknod', my $a = $_[0], $mode | 0600, makedev($_[2], $_[3])) or die "mknod failed: $!\n";
+    } else { die "usage: mknod <path> [b|c] <major> <minor> or mknod <path>\n"; }
+}
+
+sub ln {
+    my ($force, $soft, $i);
+
+    while ($i = shift) {
+	if ($i eq '-f') { $force = 1; }
+	elsif ($i eq '-s') { $soft = 1; }
+	elsif ($i eq '-fs' || $i eq '-sf') { $force = $soft = 1; }
+	else { last }
+    }
+
+    my $source = $i or die "usage: ln [-s] [-f] <source> [<dest>]\n";
+    my $dest = shift || basename($source);
+
+    $force and unlink $dest;
+
+
+    ($soft ? symlink($source, $dest) : link($source, $dest)) or die "ln failed: $!\n";
+}
+
+sub rm { 
+    my $rec; $_[0] eq '-r' and $rec = shift;
+    
+    my $rm; $rm = sub {
+	foreach (@_) {
+	    if (-d $_) {
+		$rec or die "$_ is a directory\n";
+		&$rm(glob_($_));
+		rmdir $_ or die "can't remove directory $_: $!\n";
+	    } else { unlink $_ or die "rm of $_ failed: $!\n" }
+	}
+    };
+    &$rm(@_);
+}
+
+sub chmod_ { 
+    @_ >= 2 or die "usage: chmod <mode> <files>\n";
+
+    my $mode = shift;
+    $mode =~ /^[0-7]+$/ or die "illegal mode $mode\n";
+
+    foreach (@_) { chmod oct($mode), $_ or die "chmod failed $_: $!\n" }
+}
+
+sub chown_ {
+    my $rec; $_[0] eq '-r' and $rec = shift;
+    local $_ = shift or die "usage: chown [-r] name[.group] <files>\n";
+
+    my ($name, $group) = (split('\.'), $_);
+
+    my ($uid, $gid) = (getpwnam($name) || $name, getgrnam($group) || $group);
+
+    my $chown; $chown = sub {
+	foreach (@_) {
+	    chown $uid, $gid, $_ or die "chown of file $_ failed: $!\n";
+	    -d $_ && $rec and &$chown(glob_($_));
+	}
+    };
+    &$chown(@_);
+}
+
+sub mkswap {
+    @_ == 1 or die "mkswap <device>\n";
+
+    require 'swap.pm';
+    swap::enable($_[0], 0);
+}
+
+sub swapon {
+    @_ == 1 or die "swapon <file>\n";
+
+    require 'swap.pm';
+    swap::swapon($_[0]);
+}
+sub swapoff {
+    @_ == 1 or die "swapoff <file>\n";
+    require 'swap.pm';
+    swap::swapoff($_[0]);
+}
+
+sub uncpio {
+    @_ and die "uncpio reads from stdin\n";
+
+#    cpioInstallArchive(gzdopen(0, "r"), NULL, 0, NULL, NULL, &fail);
+}
+
+
+sub rights {
+    my $r = '-' x 9;
+    my @rights = (qw(x w r x w r x w r), ['t', 0], ['s', 3], ['s', 6]);
+    for (my $i = 0; $i < @rights; $i++) {
+	if (vec(pack("S", $_[0]), $i, 1)) {
+	    my ($val, $place) = $i >= 9 ? @{$rights[$i]} : ($rights[$i], $i);
+	    my $old = \substr($r, 8 - $place, 1);
+	    $$old = ($$old eq '-' && $i >= 9) ? uc $val : $val;
+	}
+    }
+    my @types = split //, "_pc_d_b_-_l_s";
+    $types[$_[0] >> 12 & 0xf] . $r;
+}
+
+sub ls {
+    my ($l , $h) = getopts(\@_, qw(lh));
+    $h and die "usage: ls [-l] <files...>\n";
+
+    @_ or @_ = '.';
+    @_ == 1 && -d $_[0] and @_ = glob_($_[0]);
+    foreach (sort @_) { 
+	if ($l) {
+	    my @s = lstat or warn("can't stat file $_\n"), next;
+	    formline(
+"@<<<<<<<<< @<<<<<<< @<<<<<<< @>>>>>>>> @>>>>>>>>>>>>>>> @*\n",
+		     rights($s[2]), getpwuid $s[4] || $s[4], getgrgid $s[5] || $s[5],
+		     $s[6] ? join ", ", unmakedev($s[6]) : $s[7], 
+		     scalar localtime $s[9], -l $_ ? "$_ -> " . readlink $_ : $_); 
+	    print $^A; $^A = '';
+	} else { print "$_\n"; }
+    }
+}
+
+sub cp {
+    my ($force) = getopts(\@_, qw(f));
+    @_ >= 2 or die "usage: cp [-f] <sources> <dest>\n(this cp does -Rl by default)\n";
+
+    my $cp; $cp = sub {
+	my $dest = pop @_;
+
+	@_ or return;
+	@_ == 1 || -d $dest or die "cp: copying multiple files, but last argument ($dest) is not a directory\n";
+
+	foreach my $src (@_) {
+	    my $dest = $dest;
+	    -d $dest and $dest .= "/" . basename($src);
+
+	    if (-e $dest) {
+		$force ? unlink $dest : die "file $dest already exist\n";
+	    }
+
+	    if (-d $src) {
+		-d $dest or mkdir $dest, mode($src) or die "mkdir: can't create directory $dest: $!\n";
+		&$cp(glob_($src), $dest);
+	    } elsif (-l $src) {
+		symlink((readlink($src) || die "readlink failed: $!"), $dest) or die "symlink: can't create symlink $dest: $!\n";
+	    } else {
+		local (*F, *G);
+		open F, $src or die "can't open $src for reading: $!\n";
+		open G, "> $dest" or $force or die "can't create $dest : $!\n";
+		foreach (<F>) { print G $_ }
+		chmod mode($src), $dest;
+	    }
+	}
+    };
+    &$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 dd {
+    my $u = "usage: dd [-h] [if=<file>] [of=<file>] [bs=<number>] [count=<number>]\n";
+    (getopts(\@_, qw(h)))[0] and die $u;
+    my %h = (if => \*STDIN, of => \*STDOUT, bs => 512, count => undef);
+    foreach (@_) {
+	/(.*?)=(.*)/ && exists $h{$1} or die $u;
+	$h{$1} = $2;
+    }
+    local (*IF, *OF); my ($tmp, $nb, $read);
+    ref $h{if} eq 'GLOB' ? *IF = $h{if} : sysopen(IF, $h{if}, 0   ) || die "error: can't open file $h{if}\n";
+    ref $h{of} eq 'GLOB' ? *OF = $h{of} : sysopen(OF, $h{of}, 0x41) || die "error: can't open file $h{of}\n";
+
+    $h{bs} =~ /(\d+)k$/ and $h{bs} = $1 * 1024;
+    $h{bs} =~ /(\d+)M$/ and $h{bs} = $1 * 1024 * 1024;
+    $h{bs} =~ /(\d+)G$/ and $h{bs} = $1 * 1024 * 1024 * 1024;
+
+    for ($nb = 0; !$h{count} || $nb < $h{count}; $nb++) {
+	$read = sysread(IF, $tmp, $h{bs}) or $h{count} ? die "error: can't read block $nb\n" : last;
+	syswrite(OF, $tmp) or die "error: can't write block $nb\n";
+	$read < $h{bs} and $read = 1, last;
+    }
+    print STDERR "$nb+$read records in\n";
+    print STDERR "$nb+$read records out\n";
+}
+
+sub head_tail {
+    my ($h, $n) = getopts(\@_, qw(hn));
+    $h || @_ > 1 + bool($n) and die "usage: $0 [-h] [-n lines] [<file>]\n";
+    $n = $n ? shift : 10;
+    local *F; @_ ? open(F, $_[0]) || die "error: can't open file $_[0]\n" : (*F = \*STDIN);
+
+    if ($0 eq 'head') {
+	foreach (<F>) { $n-- or return; print }
+    } else {
+	@_ = (); foreach (<F>) { push @_, $_; @_ > $n and shift; }
+	print @_;
+    }
+}
+sub head { $0 = 'head'; &head_tail }
+sub tail { $0 = 'tail'; &head_tail }
+
+sub strings {
+    my ($h, $o, $n) = getopts(\@_, qw(hon));
+    $h and die "usage: strings [-o] [-n min-length] [<files>]\n";
+    $n = $n ? shift : 4;
+    $/ = "\0"; @ARGV = @_; my $l = 0; while (<>) {
+	while (/[$printable_chars]\{$n,}/og) {
+	    printf "%07d ", ($l + length $') if $o;
+	    print "$&\n" ;
+	}
+	$l += length;
+    } continue { $l = 0 if eof }
+}
+
+sub hexdump {
+    my $i = 0; $/ = \16; @ARGV = @_; while (<>) {
+	printf "%08lX  ", $i; $i += 16;
+	print join(" ", map({ sprintf "%02X", $_ } unpack("C*", $_)), 
+		   ($_ =~ s/[^$printable_chars]/./og, $_)[1]), "\n"; 
+    }
+}
+
+sub more { 
+    @ARGV = @_;
+    require 'devices.pm';
+    my $tty = devices::make('tty');
+    local *IN; open IN, "<$tty" or die "can't open $tty\n"; 
+    my $n = 0; while (<>) { 
+	++$n == 25 and $n = <IN>, $n = 0; 
+	print 
+    } 
+}
+
+sub pack_ {
+    my $t;
+    foreach (@_) {
+	if (-d $_) {
+	    pack_(glob_($_));
+	} else {
+	    print -s $_, "\n";
+	    print $_, "\n";
+
+	    local *F;
+	    open F, $_ or die "can't read file $_: $!\n";
+	    while (read F, $t, $BUFFER_SIZE) { print $t; }    
+	}
+    }
+}
+
+sub unpack_ {
+    my $t;
+    @_ == 1 or die "give me one and only one file to unpack\n";
+    local *F;
+    open F, $_[0] or die "can't open file $_: $!\n";
+    while (1) {
+	my ($size) = chop_(scalar <F>);
+	defined $size or last;
+	$size =~ /^\d+$/ or die "bad format (can't find file size)\n";
+	my ($filename) = chop_(scalar <F>) or die "expecting filename\n";
+
+	print "$filename\n";
+	my $dir = dirname($filename);
+	-d $dir or mkdir_('-p', $dir);
+	
+	local *G;
+	open G, "> $filename" or die "can't write file $filename: $!\n";
+	while ($size) {
+	    $size -= read(F, $t, min($size, $BUFFER_SIZE)) || die "data for file $filename is missing\n";
+	    print G $t or die "error writing to file $filename: $!\n";
+	}
+    }
+}
diff --git a/perl-install/common.pm b/perl-install/common.pm
new file mode 100644
index 000000000..6c12961ef
--- /dev/null
+++ b/perl-install/common.pm
@@ -0,0 +1,84 @@
+package common;
+
+use diagnostics;
+use strict;
+use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int $error $cancel $SECTORSIZE);
+
+@ISA = qw(Exporter);
+%EXPORT_TAGS = (
+    common => [ qw(min max bool member divide error cancel is_empty_array_ref round_up round_down first top) ],
+    file => [ qw(dirname basename all glob_ cat_ chop_ mode) ],
+    system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_) ],
+    constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE) ],
+);
+@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
+
+$printable_chars = "\x20-\x7E";
+$sizeof_int = psizeof("i");
+$bitof_int = $sizeof_int * 8;
+$error = 0;
+$cancel = 0;
+$SECTORSIZE = 512;
+
+1;
+
+sub min { my $min = shift; grep { $_ < $min and $min = $_; } @_; $min }
+sub max { my $max = shift; grep { $_ > $max and $max = $_; } @_; $max }
+sub first { $_[0] }
+sub top { $_[$#_] }
+sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 }
+sub dirname { @_ == 1 or die "usage: dirname <name>\n"; local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' }
+sub basename { @_ == 1 or die "usage: basename <name>\n"; local $_ = shift; s|/*\s*$||; s|.*/||; $_ }
+sub error { $error = 1; 0 }
+sub cancel { $cancel = 1; 0 }
+sub bool { $_[0] ? 1 : 0 }
+sub strcpy { substr($_[0], $_[2] || 0, length $_[1]) = $_[1] }
+sub cat_ { local *F; open F, $_[0] or $_[1] ? die "cat of file $_[0] failed: $!\n" : return; my @l = <F>; @l }
+sub chop_ { map { my $l = $_; chomp $l; $l } @_ }
+sub divide { my $d = int $_[0] / $_[1]; wantarray ? ($d, $_[0] % $_[1]) : $d }
+sub round_up { my ($i, $r) = @_; $i += $r - ($i + $r - 1) % $r - 1; }
+sub round_down { my ($i, $r) = @_; $i -= $i % $r; }
+sub is_empty_array_ref { my $a = shift; !defined $a || @$a == 0 }
+
+sub sync { syscall_('sync') }
+sub gettimeofday { my $t = pack "LL"; syscall_('gettimeofday', $t, 0) or die "gettimeofday: $!\n"; unpack("LL", $t) }
+
+sub remove_spaces { local $_ = shift; s/^ +//; s/ +$//; $_ }
+sub mode { my @l = stat $_[0] or die "unable to get mode of file $_[0]: $!\n"; $l[2] }
+sub psizeof { length pack $_[0] }
+
+sub all {
+    my $d = shift;
+
+    local *F;
+    opendir F, $d or die "all: can't opendir $d: $!\n";
+    grep { $_ ne '.' && $_ ne '..' } readdir F;
+}
+
+sub glob_ {
+    my ($d, $f) = ($_[0] =~ /\*/) ? (dirname($_[0]), basename($_[0])) : ($_[0], '*');
+
+    $d =~ /\*/ and die "glob_: wildcard in directory not handled ($_[0])\n";
+    ($f = quotemeta $f) =~ s/\\\*/.*/g;
+
+    $d =~ m|/$| or $d .= '/';
+    map { $d eq './' ? $_ : "$d$_" } grep { /$f/ } all($d);
+}
+
+
+sub syscall_ {
+    my $f = shift;
+
+    require 'syscall.ph';
+    syscall(&{$common::{"SYS_$f"}}, @_) == 0;
+}
+
+
+sub crypt_ {
+    local $_ = (gettimeofday())[1] % 0x40;
+    tr [\0-\x3f] [0-9a-zA-Z./];
+    crypt($_[0], $_)
+}
+
+sub makedev { ($_[0] << 8) | $_[1] }
+sub unmakedev { $_[0] >> 8, $_[0] & 0xff }
diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm
new file mode 100644
index 000000000..8f1fac97d
--- /dev/null
+++ b/perl-install/detect_devices.pm
@@ -0,0 +1,151 @@
+package detect_devices;
+
+use diagnostics;
+use strict;
+
+use log;
+use common qw(:common :file);
+use c;
+
+
+my $scsiDeviceAvailable;
+my $CSADeviceAvailable;
+
+1;
+
+sub get {
+    # Detect the default BIOS boot harddrive is kind of tricky. We may have IDE,
+    # SCSI and RAID devices on the same machine. From what I see so far, the default
+    # BIOS boot harddrive will be
+    # 1. The first IDE device if IDE exists. Or 
+    # 2. The first SCSI device if SCSI exists. Or
+    # 3. The first RAID device if RAID exists.
+
+    map { &{$_->[0]}() ? &{$_->[1]}() : () }
+    [ \&hasIDE, \&getIDE ],
+    [ \&hasSCSI, \&getSCSI ],
+    [ \&hasDAC960, \&getDAC960 ],
+    [ \&hasCompaqSmartArray, \&getCompaqSmartArray ];
+}
+sub hds() { grep { $_->{type} eq 'hd' } get(); }
+sub cdroms() { grep { $_->{type} eq 'cdrom' } get(); }
+
+sub hasSCSI() {
+    defined $scsiDeviceAvailable and return $scsiDeviceAvailable;
+    local *F;
+    open F, "/proc/scsi/scsi" or log::l("failed to open /proc/scsi/scsi: $!"), return 0;
+    foreach (<F>) {
+	/devices: none/ and log::l("no scsi devices are available"), return $scsiDeviceAvailable = 0;
+    }
+    log::l("scsi devices are available");
+    $scsiDeviceAvailable = 1;
+}
+sub hasIDE() { 1 }
+sub hasDAC960() { 1 }
+
+sub hasCompaqSmartArray() {
+    defined $CSADeviceAvailable and return $CSADeviceAvailable;
+    -r "/proc/array/ida0" or log::l("failed to open /proc/array/ida0: $!"), return $CSADeviceAvailable = 0;
+    log::l("Compaq Smart Array controllers available");
+    $CSADeviceAvailable = 1;
+}
+
+sub getSCSI() {
+    my @drives;
+    my ($driveNum, $cdromNum, $tapeNum) = qw(0 0 0);
+    my $err = sub { chop; log::l("unexpected line in /proc/scsi/scsi: $_"); error() };
+    local $_;
+
+    local *F;
+    open F, "/proc/scsi/scsi" or return &$err();
+    $_ = <F>; /^Attached devices:/ or return &$err();
+    while ($_ = <F>) {
+	my ($id) = /^Host:.*?Id: (\d+)/ or return &$err();
+	$_ = <F>; my ($vendor, $model) = /^\s*Vendor:\s*(.*?)\s+Model:\s*(.*?)\s+Rev:/ or return &$err();
+	$_ = <F>; my ($type) = /^\s*Type:\s*(.*)/ or &$err();
+	my $device;
+	if ($type =~ /Direct-Access/) {
+	    $type = 'hd';
+	    $device = "sd" . chr($driveNum++ + ord('a'));
+	} elsif ($type =~ /Sequential-Access/) {
+	    $type = 'tape';
+	    $device = "st" . $tapeNum++;
+	} elsif ($type =~ /CD-ROM/) {
+	    $type = 'cdrom';
+	    $device = "scd" . $cdromNum++;
+	}
+	$device and push @drives, { device => $device, type => $type, info => "$vendor $model", id => $id, bus => 0 };
+    }
+    @drives;
+}
+
+sub getIDE() {
+    my @idi;
+
+    -r "/proc/ide" or die "sorry, /proc/ide not available, seems like you have a pre-2.2 kernel\n => not handled yet :(";
+
+    # Great. 2.2 kernel, things are much easier and less error prone. 
+    foreach my $d (glob_('/proc/ide/hd*')) {
+	my ($t) = chop_(cat_("$d/media"));
+	my $type = $ {{disk => 'hd', cdrom => 'cdrom', tape => 'tape', floppy => 'fd'}}{$t} or next;
+	my ($info) = chop_(cat_("$d/model")); $info ||= "(none)";
+
+	my $num = ord (($d =~ /(.)$/)[0]) - ord 'a';
+	push @idi, { type => $type, device => basename($d), info => $info, bus => $num/2, id => $num%2 };
+    }
+    @idi;
+}
+
+
+sub getCompaqSmartArray() {
+    my @idi;
+    my $f;
+
+    for (my $i = 0; -r ($f = "/proc/array/ida$i"); $i++) {
+	local *F;
+	open F, $f or die;
+	local $_ = <F>;
+	my ($name) = m|ida/(.*?):| or next;
+	push @idi, { device => $name, info => "Compaq RAID logical disk", type => 'hd' };
+    }
+    @idi;
+}
+
+sub getDAC960() {
+    my @idi;
+    my $file = "/var/log/dmesg";
+    -r $file or $file = "/tmp/syslog";
+
+    local *F;
+    open F, $file or die "Failed to open $file: $!";
+
+    # We are looking for lines of this format:DAC960#0:
+    # /dev/rd/c0d0: RAID-7, Online, 17928192 blocks, Write Thru0123456790123456789012    
+    foreach (<F>) {
+	my ($devicename, $info) = m|/dev/rd/(.*?): (.*?),| or next;
+	push @idi, { info => $info, type => 'hd', devicename => $devicename }; 
+	log::l("DAC960: $devicename: $info");
+    }
+    @idi;
+}
+
+
+sub getNet() {
+    # I should probably ask which device to use if multiple ones are available -- oh well :-( 
+    foreach (qw(eth0 tr0 plip0 plip1 plip2 fddi0)) {
+	hasNetDevice($_) and log::l("$_ is available -- using it for networking"), return $_;
+    }
+    undef;
+}
+sub getPlip() {
+    foreach (0..2) {
+	hasNetDevice("plip$_") and log::l("plip$_ will be used for PLIP"), return "plip$_";
+    }
+    undef;
+}
+
+sub hasNet() { goto &getNet }
+sub hasPlip() { goto &getPlip }
+sub hasEthernet() { hasNetDevice("eth0"); }
+sub hasTokenRing() { hasNetDevice("tr0"); }
+sub hasNetDevice($) { c::hasNetDevice($_[0]) }
diff --git a/perl-install/devices.pm b/perl-install/devices.pm
new file mode 100644
index 000000000..704b3d40d
--- /dev/null
+++ b/perl-install/devices.pm
@@ -0,0 +1,107 @@
+package devices;
+
+use diagnostics;
+use strict;
+
+use common qw(:system :file);
+use run_program;
+use log;
+use c;
+
+1;
+
+
+sub size($) {
+    local *F;
+    sysopen F, $_[0], 0 or log::l("open $_[0]: $!"), return 0;
+
+    my $valid_offset = sub { sysseek(F, $_[0], 0) && sysread(F, my $a, 1) };
+
+    # first try getting the size nicely
+    my $size = 0;
+    ioctl(F, c::BLKGETSIZE(), $size) and return unpack("i", $size) * $common::SECTORSIZE;
+
+    # sad it didn't work, well searching the size using the dichotomy algorithm!
+    my $low = 0;
+    my ($high, $mid);
+
+    # first find n where 2^n < size <= 2^n+1
+    for ($high = 1; $high > 0 && &$valid_offset($high); $high *= 2) { $low = $high; }
+
+    while ($low < $high - 1) {
+	$mid = int ($low + $high) / 2;
+	&$valid_offset($mid) ? $low : $high = $mid;
+    }
+    $low + 1;
+}
+
+sub make($) {
+    local $_ = my $file = $_[0];
+    my ($type, $major, $minor);
+
+    unless (s,^/(dev|tmp)/,,) {
+	$file = -e "/dev/$file" ? "/dev/$file" : "/tmp/$file";
+    }
+
+    -e $file and return $file; # assume nobody takes fun at creating files named as device
+
+    if (/^sd(.)(\d\d)/) {
+	$type = c::S_IFBLK();
+	$major = 8;
+	$minor = ord($1) - ord('a') + $2;
+    } elsif (/^hd(.)(\d{0,2})/) {
+	$type = c::S_IFBLK();
+	($major, $minor) = 
+	    @{ $ {{'a' => [3, 0], 'b' => [3, 64],
+		   'c' => [22,0], 'd' => [22,64],
+		   'e' => [33,0], 'f' => [33,64],
+		   'g' => [34,0], 'h' => [34,64],
+	       }}{$1} or die "unknown device $_" };
+	$minor += $2 || 0;
+    } elsif (/^ram(.)/) {
+	$type = c::S_IFBLK();
+	$major = 1;
+	$minor = $1 eq '' ? 1 : $1;
+    } elsif (m|^rd/c(\d+)d(\d+)(p(\d+))?|) {
+	# dac 960 "/rd/cXdXXpX"
+        $type = c::S_IFBLK();
+	$major = 48 + $1;
+	$minor = 8 * $2 + $4;
+    } elsif (m|ida/c(\d+)d(\d+)(p(\d+))|) {
+	# Compaq Smart Array "ida/c0d0{p1}"
+	$type = c::S_IFBLK();
+	$major = 72 + $1;
+	$minor = 16 * $2 + $4;
+    } else {
+	($type, $major, $minor) = 
+	    @{ $ {{"aztcd"   => [ c::S_IFBLK(), 29, 0 ],
+		   "bpcd"    => [ c::S_IFBLK(), 41, 0 ],
+		   "cdu31a"  => [ c::S_IFBLK(), 15, 0 ],
+		   "cdu535"  => [ c::S_IFBLK(), 24, 0 ],
+		   "cm206cd" => [ c::S_IFBLK(), 32, 0 ],
+		   "tty"     => [ c::S_IFCHR(), 5, 0 ],
+		   "fd0"     => [ c::S_IFBLK(), 2, 0 ],
+		   "fd1"     => [ c::S_IFBLK(), 2, 1 ],
+		   "gscd"    => [ c::S_IFBLK(), 16, 0 ],
+		   "lp0"     => [ c::S_IFCHR(), 6, 0 ],
+		   "lp1"     => [ c::S_IFCHR(), 6, 1 ],
+		   "lp2"     => [ c::S_IFCHR(), 6, 2 ],
+		   "mcd"     => [ c::S_IFBLK(), 23, 0 ],
+		   "mcdx"    => [ c::S_IFBLK(), 20, 0 ],
+		   "nst0"    => [ c::S_IFCHR(), 9, 128 ],
+		   "optcd"   => [ c::S_IFBLK(), 17, 0 ],
+		   "sbpcd"   => [ c::S_IFBLK(), 25, 0 ],
+		   "scd0"    => [ c::S_IFBLK(), 11, 0 ],
+		   "scd1"    => [ c::S_IFBLK(), 11, 1 ],
+		   "sjcd"    => [ c::S_IFBLK(), 18, 0 ],
+	       }}{$_} or die "unknown device $type" };
+    }
+    
+    # make a directory for this inode if needed.
+    mkdir dirname($file), 0755;   
+    
+    syscall_('mknod', $file, $type | 0600, makedev($major, $minor)) or die "mknod failed (dev:$_): $!";
+
+    $file;
+}
+
diff --git a/perl-install/fs.pm b/perl-install/fs.pm
new file mode 100644
index 000000000..cf29fe014
--- /dev/null
+++ b/perl-install/fs.pm
@@ -0,0 +1,245 @@
+package fs;
+
+use diagnostics;
+use strict;
+
+use common qw(:common :file :system);
+use log;
+use devices;
+use partition_table qw(:types);
+use run_program;
+use nfs;
+use swap;
+use detect_devices;
+use commands;
+
+1;
+
+
+sub read_fstab($) {
+    my ($file) = @_;
+
+    local *F;
+    open F, $file or return;
+    
+    map {
+	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] }
+    } <F>;
+}
+
+sub check_mounted($) {
+    my ($fstab) = @_;
+
+    local (*F, *G, *H);
+    open F, "/etc/mtab";
+    open G, "/proc/mounts";
+    open H, "/proc/swaps";
+    foreach (<F>, <G>, <H>) {
+	foreach my $p (@$fstab) {
+	    /$p->{device}\s/ and $p->{isMounted} = 1;
+	}
+    }
+}
+
+sub get_mntpoints_from_fstab($) {
+    my ($fstab) = @_;
+
+    foreach (read_fstab('/etc/fstab')) {
+	foreach my $p (@$fstab) {
+	    $p->{device} eq $_->{device} or next;
+	    $p->{mntpoint} ||= $_->{mntpoint};
+	    $p->{options} ||= $_->{options};
+	    $_->{type} ne 'auto' && $_->{type} ne type2fs($p->{type}) and 
+		log::l("err, fstab and partition table do not agree for $_->{device} type: " . (type2fs($p->{type}) || type2name($p->{type})) . " vs $_->{type}");
+	}
+    }
+}
+
+sub format_ext2($;$) {
+    my ($dev, $bad_blocks) = @_;
+    my @options;
+
+    $dev =~ m,(rd|ida)/, and push @options, qw(-b 4096 -R stride=16); # For RAID only. 
+    $bad_blocks and push @options, "-c";
+
+    run_program::run("mke2fs", devices::make($dev), @options) or die "ext2 formatting of $dev failed";
+}
+
+sub format_dos($;$) {
+    my ($dev, $bad_blocks) = @_;
+
+    run_program::run("mkdosfs", devices::make($dev), $bad_blocks ? "-c" : ()) or die "dos formatting of $dev failed";
+}
+
+sub format_part($;$) {
+    my ($part, $bad_blocks) = @_;
+
+    $part->{isFormatted} and return;
+
+    if (isExt2($part)) {
+	format_ext2($part->{device}, $bad_blocks);
+    } elsif (isDos($part)) {
+        format_dos($part->{device}, $bad_blocks);
+    } elsif (isSwap($part)) {
+        swap::make($part->{device}, $bad_blocks);
+    } else {
+	die "don't know how to format $_->{device} in type " . type2name($_->{type});
+    }
+    $part->{isFormatted} = 1;
+}
+
+sub mount($$$;$) {
+    my ($dev, $where, $fs, $rdonly) = @_; 
+    log::l("mounting $dev on $where as type $fs");
+  
+    $::testing and return;
+    
+    -d $where or commands::mkdir_('-p', $where);
+    
+    if ($fs eq 'nfs') {
+	log::l("calling nfs::mount($dev, $where)");
+	nfs::mount($dev, $where) or die "nfs mount failed";
+    } elsif ($fs eq 'smb') {
+	die "no smb yet...";
+    }
+    $dev = devices::make($dev);
+  
+    my $flag = 0;#c::MS_MGC_VAL();
+    $flag |= c::MS_RDONLY() if $rdonly;
+    my $mount_opt = $fs eq 'vfat' ? "check=relaxed" : "";
+  
+    log::l("calling mount($dev, $where, $fs, $flag, $mount_opt)");
+    syscall_('mount', $dev, $where, $fs, $flag, $mount_opt) or die "mount failed: $!";
+
+    local *F;
+    open F, ">>/etc/mtab" or return; # fail silently, must be read-only /etc
+    print F "$dev $where $fs defaults 0 0\n";
+}
+
+# takes the mount point to umount (can also be the device)
+sub umount($) { 
+    my ($mntpoint) = @_;
+    syscall_('umount', $mntpoint) or die "error unmounting $mntpoint: $!";;
+
+    my @mtab = cat_('/etc/mtab'); # don't care about error, if we can't read, we won't manage to write... (and mess mtab)
+    local *F;
+    open F, ">/etc/mtab" or return;
+    foreach (@mtab) { print F $_ unless /(^|\s)$mntpoint\s/; }
+}
+
+sub mount_part($;$) {
+    my ($part, $prefix) = @_;
+    
+    $part->{isMounted} and return;
+    $part->{mntpoint} or die "missing mount point";
+    
+    isSwap($part) ?
+	swap::swapon($part->{device}) :
+	mount(devices::make($part->{device}), ($prefix || '') . $part->{mntpoint}, type2fs($part->{type}), 0);
+    $part->{isMounted} = 1;
+}
+
+sub umount_part($;$) {
+    my ($part, $prefix) = @_;
+
+    $part->{isMounted} or return;
+
+    isSwap($part) ?
+      swap::swapoff($part->{device}) :
+      umount(($prefix || '') . ($part->{mntpoint} || "/dev/$part->{device}"));
+    $part->{isMounted} = 0;
+}
+
+sub mount_all($;$) {
+    my ($fstab, $prefix) = @_;
+
+    log::l("mounting all filesystems");
+
+    # order mount by alphabetical ordre, that way / < /home < /home/httpd...
+    foreach (sort { $a->{mntpoint} cmp $b->{mntpoint} } @$fstab) {
+	$_->{mntpoint} and mount_part($_, $prefix);
+    }
+}
+
+sub umount_all($;$) {
+    my ($fstab, $prefix) = @_;
+
+    log::l("unmounting all filesystems");
+
+    foreach (sort { $b->{mntpoint} cmp $a->{mntpoint} } @$fstab) {
+	$_->{mntpoint} and umount_part($_, $prefix);
+    }
+}
+
+# do some stuff before calling write_fstab
+sub write($$) {
+    my ($prefix, $fstab) = @_;
+    my @cd_drives = detect_devices::cdroms();
+
+    log::l("scanning /proc/mounts for iso9660 filesystems");
+    unshift @cd_drives, grep { $_->{type} eq 'iso9660' } read_fstab("/proc/mounts");
+    log::l("found cdrom drive(s) " . join(', ', map { $_->{device} } @cd_drives));
+
+    # cd-rom rooted installs have the cdrom mounted on /dev/root which 
+    # is not what we want to symlink to /dev/cdrom.                    
+    my $cddev = first(grep { $_ ne 'root' } map { $_->{device} } @cd_drives);
+
+    $::testing and return 1;
+
+    log::l("resetting /etc/mtab");
+    local *F;
+    open F, "> $prefix/etc/mtab" or die "error resetting $prefix/etc/mtab";
+
+    if ($cddev) {
+	mkdir "$prefix/mnt/cdrom", 0755 or log::l("failed to mkdir $prefix/mnt/cdrom: $!");
+	symlink $cddev, "$prefix/dev/cdrom" or log::l("failed to symlink $prefix/dev/cdrom: $!");
+    }
+    write_fstab($fstab, $prefix, $cddev);
+}
+
+
+sub write_fstab($;$$) {
+    my ($fstab, $prefix, $cddev) = @_;
+    $prefix ||= '';
+
+    my @to_add = 
+      map {
+	  my ($dir, $options, $freq, $passno) = qw(/dev/ defaults 0 0);
+	  $options ||= $_->{options};
+
+	  isExt2($_) and ($freq, $passno) = (1, ($_->{mntpoint} eq '/') ? 1 : 2);
+	  isNfs($_) and ($dir, $options) = ('', 'ro');
+	  
+	  [ "$dir$_->{device}", $_->{mntpoint}, type2fs($_->{type}), $options, $freq, $passno ];
+
+      } grep { $_->{mntpoint} && type2fs($_->{type}) } @$fstab;
+
+    {
+      push @to_add, [ split ' ', '/dev/fd0 /mnt/floppy auto sync,user,noauto,nosuid,nodev,unhide 0 0' ];
+      push @to_add, [ split ' ', '/dev/cdrom /mnt/cdrom auto user,noauto,nosuid,exec,nodev,ro 0 0' ] if $cddev;
+      push @to_add, [ split ' ', 'none /proc proc defaults 0 0' ];
+      push @to_add, [ split ' ', 'none /dev/pts devpts mode=0620 0 0' ];
+    }
+
+    # get the list of devices and mntpoint
+    my @new = grep { $_ ne 'none' } map { @$_[0,1] } @to_add;
+    my %new; @new{@new} = undef;
+
+    my @current = cat_("$prefix/etc/fstab");
+
+    log::l("writing $prefix/etc/fstab");
+    local *F;
+    open F, "> $prefix/etc/fstab" or die "error writing $prefix/etc/fstab";
+    foreach (@current) {
+	my ($a, $b) = split;
+	# if we find one line of fstab containing either the same device or mntpoint, do not write it
+	exists $new{$a} || exists $new{$b} and next;
+	print F $_;
+    }
+    foreach (@to_add) {
+	print F join(" ", @$_), "\n";
+    }
+}
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
new file mode 100644
index 000000000..fb2703e8f
--- /dev/null
+++ b/perl-install/fsedit.pm
@@ -0,0 +1,187 @@
+package fsedit;
+
+use diagnostics;
+use strict;
+
+use common qw(:common);
+use partition_table qw(:types);
+use partition_table_raw;
+use devices;
+use log;
+
+1;
+
+my @suggestions = (
+  { mntpoint => "/boot",    minsize =>  10 << 11, size =>  16 << 11, type => 0x83 }, 
+  { mntpoint => "/",        minsize =>  50 << 11, size => 100 << 11, type => 0x83 }, 
+  { mntpoint => "swap",     minsize =>  30 << 11, size =>  60 << 11, type => 0x82 },
+  { mntpoint => "/usr",     minsize => 200 << 11, size => 500 << 11, type => 0x83 }, 
+  { mntpoint => "/home",    minsize =>  50 << 11, size => 200 << 11, type => 0x83 }, 
+  { mntpoint => "/var",     minsize => 200 << 11, size => 250 << 11, type => 0x83 }, 
+  { mntpoint => "/tmp",     minsize =>  50 << 11, size => 100 << 11, type => 0x83 }, 
+  { mntpoint => "/mnt/iso", minsize => 700 << 11, size => 800 << 11, type => 0x83 }, 
+);
+
+
+1;
+
+sub hds($$) {
+    my ($drives, $flags) = @_;
+    my @hds;
+    my $rc;
+
+    foreach (@$drives) {
+	my $file = devices::make($_->{device});
+
+	my $hd = partition_table_raw::get_geometry($file) or die "An error occurred while getting the geometry of block device $file: $!";
+	$hd->{file} = $file;
+	$hd->{prefix} = $hd->{device} = $_->{device};
+	# for RAID arrays of format c0d0p1 
+	$hd->{prefix} .= "p" if $hd->{prefix} =~ m,(rd|ida)/,;
+
+	eval { $rc = partition_table::read($hd, $flags->{clearall}) }; 
+	if ($@) {
+	    $@ =~ /bad magic number/ or die;
+	    $flags->{forcezero} && !$::testing ? partition_table_raw::zero_MBR($hd) : die;
+	}
+	$rc ? push @hds, $hd : log::l("An error occurred reading the partition table for the block device $_->{device}");
+    }
+    [ @hds ];
+}
+
+sub get_fstab(@) {
+    map { partition_table::get_normal_parts($_) } @_;
+}
+
+sub suggest_part($$$;$) {
+    my ($hd, $part, $hds, $suggestions) = @_;
+    $suggestions ||= \@suggestions;
+    foreach (@$suggestions) { $_->{minsize} ||= $_->{size} }
+
+    my $has_swap;
+    my @mntpoints = map { $has_swap ||= isSwap($_); $_->{mntpoint} } get_fstab(@$hds);
+    my %mntpoints; @mntpoints{@mntpoints} = undef;
+
+    my ($best, $second) = 
+      grep { $part->{size} >= $_->{minsize} }
+      grep { !exists $mntpoints{$_->{mntpoint}} || isSwap($_) && !$has_swap }
+	@$suggestions or return;
+
+    $best = $second if 
+      $best->{mntpoint} eq '/boot' && 
+      $part->{start} + $best->{minsize} > 1024 * partition_table::cylinder_size($hd); # if the empty slot is beyond the 1024th cylinder, no use having /boot
+
+    defined $best or return; # sorry no suggestion :(
+
+    $part->{mntpoint} = $best->{mntpoint};
+    $part->{type} = $best->{type};
+    $part->{size} = min($part->{size}, $best->{size});
+    1;
+}
+
+
+#sub partitionDrives {
+#
+#    my $cmd = "/sbin/fdisk";
+#    -x $cmd or $cmd = "/usr/bin/fdisk";
+#
+#    my $drives = findDrivesPresent() or die "You don't have any hard drives available! You probably forgot to configure a SCSI controller.";
+#
+#    foreach (@$drives) {
+#	 my $text = "/dev/" . $_->{device};
+#	 $text .= " - SCSI ID " . $_->{id} if $_->{device} =~ /^sd/;
+#	 $text .= " - Model " . $_->{info};
+#	 $text .= " array" if $_->{device} =~ /^c.d/;
+#
+#	 # truncate at 50 columns for now 
+#	 $text = substr $text, 0, 50;
+#    }
+#    #TODO TODO
+#}
+
+
+
+sub checkMountPoint($$) {
+#    my $type = shift;
+#    local $_ = shift;
+#
+#    m|^/| or die "The mount point $_ is illegal.\nMount points must begin with a leading /";
+#    m|(.)/$| and die "The mount point $_ is illegal.\nMount points may not end with a /";
+#    c::isprint($_) or die "The mount point $_ is illegal.\nMount points must be made of printable characters (no accents...)";
+#
+#    foreach my $dev (qw(/dev /bin /sbin /etc /lib)) {
+#	 /^$dev/ and die "The $_ directory must be on the root filesystem.",
+#    }
+#
+#    if ($type eq 'linux_native') {
+#	 $_ eq '/'; and return 1;
+#	 foreach my $r (qw(/var /tmp /boot /root)) {
+#	     /^$r/ and return 1;
+#	 }
+#	 die "The mount point $_ is illegal.\nSystem partitions must be on Linux Native partitions";
+#    }
+#    1;
+}
+
+sub removeFromList($$$) {
+    my ($start, $end, $list) = @_;
+    my $err = "error in removeFromList: removing an non-free block";
+
+    for (my $i = 0; $i < @$list; $i += 2) {
+	$start < $list->[$i] and die $err;
+	$start > $list->[$i + 1] and next;
+
+	if ($start == $list->[$i]) {
+	    $end > $list->[$i + 1] and die $err;
+	    if ($end == $list->[$i + 1]) {
+		# the free block is just the same size, removing it
+		splice(@$list, 0, 2);
+	    } else {
+		# the free block now start just after this block
+		$list->[$i] = $end;
+	    }
+	} else {
+	    $end <= $list->[$i + 1] or die $err;
+	    if ($end < $list->[$i + 1]) {
+		splice(@$list, $i + 2, 0, $end, $list->[$i + 1]);
+	    }
+	    $list->[$i + 1] = $start; # shorten the free block
+	}
+	return;
+    }
+}
+
+
+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($_->{start}, $_->{start} + $_->{size}, $free_sectors{$_->{rootDevice}}) };
+    my $success = 0;
+
+    foreach (get_fstab(@$hds)) { &$remove(); }
+
+    FSTAB: foreach (@$to_add) {
+	foreach my $hd (@$hds) {
+	    my $v = $free_sectors{$hd->{device}};
+	    for (my $i = 0; $i < @$v; $i += 2) {
+		my $size = $v->[$i + 1] - $v->[$i];
+		$_->{size} > $size and next;
+		$_->{start} = $v->[$i];
+		$_->{rootDevice} = $hd->{device};
+		partition_table::adjustStartAndEnd($hd, $_);
+		&$remove();
+		partition_table::add($hd, $_);
+		$success++;
+		next FSTAB;
+	    }
+	}
+	log::ld("can't allocate partition $_->{mntpoint} of size $_->{size}, not enough room");
+    }
+    $success;
+}
+
+sub auto_allocate($;$) {
+    my ($hds, $suggestions) = @_;
+    allocatePartitions($hds, $suggestions || \@suggestions);
+    map { partition_table::assign_device_numbers($_) } @$hds;
+}
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
new file mode 100644
index 000000000..5d2bd900b
--- /dev/null
+++ b/perl-install/install2.pm
@@ -0,0 +1,469 @@
+#!/usr/bin/perl
+
+# $o->{hints}->{component} *was* 'Workstation' or 'Server' or NULL
+
+use diagnostics;
+use strict;
+use vars qw($testing $error $cancel $INSTALL_VERSION);
+
+use lib qw(/usr/bin/perl-install . c/blib/arch);
+use c;
+use common qw(:common :file :system);
+use devices;
+use log;
+use net;
+use keyboard;
+use pkgs;
+use smp;
+use fs;
+use setup;
+use fsedit;
+use install_methods;
+use lilo;
+use swap;
+use install_steps_graphical;
+use modules;
+use partition_table qw(:types);
+use detect_devices;
+use commands;
+
+$error = 0;
+$cancel = 0;
+$testing = $ENV{PERL_INSTALL_TEST};
+$INSTALL_VERSION = 0;
+
+my @installStepsFields = qw(text skipOnCancel skipOnLocal prev next);
+my @installSteps = (
+  selectPath => [ "Select installation path", 0, 0, 'none' ],
+  selectInstallClass => [ "Select installation class", 0, 0 ],
+  setupSCSI => [ "Setup SCSI", 0, 1 ],	
+  partitionDisks => [ "Setup filesystems", 0, 1 ],
+  findInstallFiles => [ "Find installation files", 1, 0 ],
+  choosePackages => [ "Choose packages to install", 0, 0 ],
+  doInstallStep => [ "Install system", 0, 0 ],
+#  configureMouse => [ "Configure mouse", 0, 0 ],
+  finishNetworking => [ "Configure networking", 0, 0 ],
+#  configureTimezone => [ "Configure timezone", 0, 0 ],
+#  configureServices => [ "Configure services", 0, 0 ],
+#  configurePrinter => [ "Configure printer", 0, 0 ],
+  setRootPassword => [ "Set root password", 0, 0 ],
+  addUser => [ "Add a user", 0, 0 ],
+  configureAuth => [ "Configure authentication", 0, 0 ],
+  createBootdisk => [ "Create bootdisk", 0, 1 ],
+  setupBootloader => [ "Install bootloader", 0, 1 ],
+#  configureX => [ "Configure X", 0, 0 ],
+  exitInstall => [ "Exit install", 0, 0, undef, 'done' ],
+);
+
+# this table is translated at run time
+my %upgradeSteps = (
+  selectPath => [ "Select installation path", 0, 0 , 'none' ],
+  setupSCSI => [ "Setup SCSI", 0, 0 ],
+  upgrFindInstall => [ "Find current installation", 0, 0 ],
+  findInstallFiles => [ "Find installation files", 1, 0 ],
+  upgrChoosePackages => [ "Choose packages to upgrade", 0, 0 ],
+  doInstallStep => [ "Upgrade system", 0, 0 ],
+  createBootdisk => [ "Create bootdisk", 0, 0 , 'none' ],
+  setupBootloader => [ "Install bootloader", 0, 0 ],
+  exitInstall => [ "Exit install", 0, 0 , undef, 'done' ],
+);
+
+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];
+    $installSteps{ $installSteps[$i] } = \%h;
+}
+$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;
+}
+$upgradeSteps{first} = $upgradeSteps[0];
+
+
+# partition layout for a server
+my @serverPartitioning = (
+		     { mntpoint => "/boot", size =>  16 << 11, type => 0x83 }, 
+		     { mntpoint => "/",     size => 256 << 11, type => 0x83 }, 
+		     { mntpoint => "/usr",  size => 512 << 11, type => 0x83, growable => 1 }, 
+		     { mntpoint => "/var",  size => 256 << 11, type => 0x83 }, 
+		     { mntpoint => "/home", size => 512 << 11, type => 0x83, growable => 1 }, 
+		     { mntpoint => "swap",  size =>  64 << 11, type => 0x82 }
+);
+
+my $o = {};
+my $default = {
+    display => "129.104.42.9:0",
+    user => { name => 'foo', password => 'foo', shell => '/bin/bash', realname => 'really, it is foo' },
+    rootPassword => 'toto',
+    keyboard => 'us',
+    isUpgrade => 0,
+    installClass => 'Server',
+    bootloader => { onmbr => 1,
+		    linear => 1,
+		},
+    mkbootdisk => 0,
+    comps => [ qw() ],
+    packages => [ qw() ],
+    partitions => [
+		   { mntpoint => "/boot", size =>  16 << 11, type => 0x83 }, 
+		   { mntpoint => "/",     size => 300 << 11, type => 0x83 }, 
+		   { mntpoint => "/usr",  size => 400 << 11, type => 0x83, growable => 1 }, 
+		   { mntpoint => "swap",  size =>  64 << 11, type => 0x82 }
+	     ],
+};
+
+
+
+sub selectPath {
+    $o->{steps} = $o->{isUpgrade} ? \%upgradeSteps : \%installSteps;
+}
+
+sub selectInstallClass {
+#    my @choices = qw(Workstation Server Custom);
+
+    $o->{installClass} eq 'Custom' and return;
+
+    $o->{bootloader}->{onmbr} = 1;
+    $o->{bootloader}->{uselinear} = 1;
+
+    foreach (qw(skipntsysv autoformat nologmessage auth autoswap skipbootloader forceddruid)) {
+	$o->{hints}->{flags}->{$_} = 1;
+    }
+    $o->{hints}->{auth}->{shadow} = 1;
+    $o->{hints}->{auth}->{md5} = 1;
+
+    if ($o->{installClass} eq 'Server') {
+	$o->{hints}->{flags}->{skipprinter} = 1;
+	$o->{hints}->{flags}->{skipresize} = 1;
+	$o->{hints}->{partitioning}->{flags}->{clearall} = 1; 
+	$o->{hints}->{partitioning}->{attempts} = 'serverPartitioning';
+    } else { #  workstation 
+	$o->{hints}->{flags}->{autoscsi} = 1;
+	$o->{hints}->{partitioning}->{flags}->{clearlinux} = 1; 
+    }
+}
+
+sub setupSCSI {
+    $o->{direction} < 0 && detect_devices::hasSCSI() and return cancel();
+
+    # If we have any scsi adapters configured from earlier, then don't bother asking again
+    while (my ($k, $v) = each %modules::loaded) {
+	$v->{type} eq 'scsi' and return;
+    }
+    #setupSCSIInterfaces(0, \%modules::loaded, $o->{hints}->{flags}->{autoscsi}, $o->{direction});
+}
+
+sub partitionDisks {
+    $o->{drives} = [ detect_devices::hds() ];
+    $o->{hds} = fsedit::hds($o->{drives}, $o->{hints}->{partitioning}->{flags});
+    @{$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";
+
+    unless ($o->{isUpgrade}) {
+	$o->{install}->doPartitionDisks($o->{hds}, $o->{fstab_wanted});
+
+	# Write partitions to disk 
+	foreach (@{$o->{hds}}) { partition_table::write($_); }
+    }
+
+    $o->{fstab} = [ fsedit::get_fstab(@{$o->{hds}}) ];
+
+    my $root_fs; map { $_->{mntpoint} eq '/' and $root_fs = $_ } @{$o->{fstab}};                  
+    $root_fs or die "partitionning failed: no root filesystem";
+
+    if ($o->{hints}->{flags}->{autoformat}) {
+	log::l("formatting all filesystems");
+
+	foreach (@{$o->{fstab}}) {
+	    fs::format_part($_) if $_->{mntpoint} && isExt2($_) || isSwap($_);
+	}
+    }
+    fs::mount_all($o->{fstab}, '/mnt');
+}
+
+sub findInstallFiles {
+    $o->{packages} = $o->{method}->getPackageSet() and
+	$o->{comps} = $o->{method}->getComponentSet($o->{packages});
+}
+ 
+sub choosePackages {
+#    $o->{hints}->{component} && $o->{direction} < 0 and return cancel();
+
+    $o->{install}->choosePackages($o->{packages}, $o->{comps}, $o->{isUpgrade});
+}
+
+sub doInstallStep {
+    $testing and return 0;
+
+    $o->{install}->beforeInstallPackages($o->{method}, $o->{fstab});
+    $o->{install}->installPackages($o->{rootPath}, $o->{method}, $o->{packages}, $o->{isUpgrade});
+    $o->{install}->afterInstallPackages($o->{rootPath}, $o->{keyboard}, $o->{isUpgrade});
+}
+
+sub configureMouse { setup::mouseConfig($o->{rootPath}); }
+
+sub finishNetworking {
+#
+#    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;
+}
+
+sub configureTimezone { setup::timeConfig($o->{rootPath}) }
+sub configureServices { setup::servicesConfig($o->{rootPath}) }
+
+sub setRootPassword {
+    $testing and return 0;
+
+    $o->{install}->setRootPassword($o->{rootPath});
+}
+
+sub addUser {
+    $o->{install}->addUser($o->{rootPath});
+}
+
+sub createBootdisk {
+    $o->{isUpgrade} or fs::write('mnt', $o->{fstab});
+    modules::write_conf("/mnt/etc/conf.modules", 'append');
+
+    $o->{mkbootdisk} and lilo::mkbootdisk("/mnt", versionString());
+}
+
+sub setupBootloader {
+    my $versionString = versionString();
+    log::l("installed kernel version $versionString");
+    
+    $o->{isUpgrade} or modules::read_conf("/mnt/etc/conf.modules");
+   
+    lilo::install("/mnt", $o->{hds}, $o->{fstab}, $versionString, $o->{bootloader});
+}
+
+sub configureX { $o->{install}->setupXfree($o->{method}, $o->{rootPath}, $o->{packages}); }
+
+sub exitInstall { 1 }
+
+sub upgrFindInstall {
+#    int rc;
+#
+#    if (!$o->{table}.parts) { 
+#	 rc = findAllPartitions(NULL, &$o->{table});
+#	 if (rc) return rc;
+#    }
+#
+#    umountFilesystems(&$o->{fstab});
+#    
+#    #  rootpath upgrade support 
+#    if (strcmp($o->{rootPath} ,"/mnt"))
+#	 return INST_OKAY;
+#    
+#    #  this also turns on swap for us 
+#    rc = readMountTable($o->{table}, &$o->{fstab});
+#    if (rc) return rc;
+#
+#    if (!testing) {
+#	 mountFilesystems(&$o->{fstab});
+#
+#	 if ($o->{method}->prepareMedia) {
+#	     rc = $o->{method}->prepareMedia($o->{method}, &$o->{fstab});
+#	     if (rc) {
+#		 umountFilesystems(&$o->{fstab});
+#		 return rc;
+#	     }
+#	 }
+#    }
+#
+#    return 0;
+}
+
+sub upgrChoosePackages {
+#    static int firstTime = 1;
+#    char * rpmconvertbin;
+#    int rc;
+#    char * path;
+#    char * argv[] = { NULL, NULL };
+#    char buf[128];
+#
+#    if (testing)
+#	 path = "/";
+#    else
+#	 path = $o->{rootPath};
+#
+#    if (firstTime) {
+#	 snprintf(buf, sizeof(buf), "%s%s", $o->{rootPath},
+#		  "/var/lib/rpm/packages.rpm");
+#	 if (access(buf, R_OK)) {
+#	 snprintf(buf, sizeof(buf), "%s%s", $o->{rootPath},
+#		  "/var/lib/rpm/packages");
+#	     if (access(buf, R_OK)) {
+#		 errorWindow("No RPM database exists!");
+#		 return INST_ERROR;
+#	     }
+#
+#	     if ($o->{method}->getFile($o->{method}, "rpmconvert", 
+#		     &rpmconvertbin)) {
+#		 return INST_ERROR;
+#	     }
+#
+#	     symlink("/mnt/var", "/var");
+#	     winStatus(35, 3, _("Upgrade"), _("Converting RPM database..."));
+#	     chmod(rpmconvertbin, 0755);
+#	     argv[0] = rpmconvertbin;
+#	     rc = runProgram(RUN_LOG, rpmconvertbin, argv);
+#	     if ($o->{method}->rmFiles)
+#		 unlink(rpmconvertbin);
+#
+#	     newtPopWindow();
+#	     if (rc) return INST_ERROR;
+#	 }
+#	 winStatus(35, 3, "Upgrade", _("Finding packages to upgrade..."));
+#	 rc = ugFindUpgradePackages(&$o->{packages}, path);
+#	 newtPopWindow();
+#	 if (rc) return rc;
+#	 firstTime = 0;
+#	 psVerifyDependencies(&$o->{packages}, 1);
+#    }
+#
+#    return psSelectPackages(&$o->{packages}, &$o->{comps}, NULL, 0, 1);
+}
+
+
+sub versionString {
+    my $kernel = $o->{packages}->{kernel} or die "I couldn't find the kernel package!";
+    
+    c::headerGetEntry($kernel->{header}, 'version') . "-" .
+    c::headerGetEntry($kernel->{header}, 'release');
+}
+
+sub getNextStep {
+    my ($lastStep) = @_;
+
+    $error and die "an error occured in step $lastStep";
+    $cancel and die "cancel called in step $lastStep";
+
+    $o->{direction} = 1;
+
+    return $o->{lastChoice} = $o->{steps}->{$lastStep}->{next};
+}
+
+sub doSuspend {
+    $o->{exitOnSuspend} and exit(1);
+
+    if (my $pid = fork) {
+	waitpid $pid, 0;
+    } else {
+	print "\n\nType <exit> to return to the install program.\n\n";
+	exec {"/bin/sh"} "-/bin/sh";
+	warn "error execing /bin/sh";
+	sleep 5;
+	exit 1;
+    }
+}
+
+
+sub spawnShell {
+    $testing and return;
+
+    -x "/bin/sh" or log::l("cannot open shell - /usr/bin/sh doesn't exist"), return;
+
+    fork and return;
+
+    local *F;
+    sysopen F, "/dev/tty2", 2 or log::l("cannot open /dev/tty2 -- no shell will be provided"), return;
+
+    open STDIN, "<&F" or die;
+    open STDOUT, ">&F" or die;
+    open STDERR, ">&F" or die;
+    close F;
+
+    c::setsid();
+
+    ioctl(STDIN, c::TIOCSCTTY(), 0) or warn "could not set new controlling tty: $!";
+
+    exec {"/bin/sh"} "-/bin/sh" or log::l("exec of /bin/sh failed: $!");
+}
+
+sub main {
+
+    #  if this fails, it's okay -- it might help with free space though 
+    unlink "/sbin/install";
+
+    print STDERR "in second stage install\n";
+
+    $o->{rootPath} = "/mnt";
+
+    $o->{method} = install_methods->new('cdrom');
+    $o->{install} = install_steps_graphical->new($o);
+
+    unless ($testing || $o->{localInstall}) {
+	if (fork == 0) {
+	    while (1) { sleep(30); sync(); }
+	}
+    }
+    $o->{exitOnSuspend} = $o->{localInstall} || $testing;
+
+    log::openLog(($testing || $o->{localInstall}) && 'debug.log');
+
+    log::l("second stage install running (version $INSTALL_VERSION)");
+
+    log::ld("extra log messages are enabled");
+
+    $o->{rootPath} eq '/mnt' and spawnShell();
+
+#    chooseLanguage('fr');
+
+    $o->{netc} = net::readNetConfig("/tmp");
+
+    if (my ($file) = glob_('/tmp/ifcfg-*')) {
+	log::l("found network config file $file");
+	$o->{intf} = net::readNetInterfaceConfig($file);
+    }
+
+    log::l("reading /usr/lib/rpm/rpmrc");
+    c::rpmReadConfigFiles_();
+    log::l("\tdone");
+
+    modules::load_deps("/modules/modules.dep");
+    modules::read_conf("/tmp/conf.modules");
+
+    #  make sure we don't pick up any gunk from the outside world 
+    $ENV{PATH} = "/usr/bin:/bin:/sbin:/usr/sbin";
+    $ENV{LD_LIBRARY_PATH} = "";
+
+    $o->{keyboard} = keyboard::read("/tmp/keyboard") || $default->{keyboard};
+
+    for (my $step = $o->{steps}->{first}; $step ne 'done'; $step = getNextStep($step)) {
+	log::l("entering step $step");
+	&{$main::{$step}}() and $o->{steps}->{completed} = 1;
+	log::l("step $step finished");
+    }
+    killCardServices();
+
+    log::l("installation complete, leaving");
+
+    <STDIN> unless $testing;
+}
+
+sub killCardServices { 
+    my $pid = cat_("/tmp/cardmgr.pid");
+    $pid and kill(15, chop_($pid)); # send SIGTERM
+}
+
+main(@ARGV);
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
new file mode 100644
index 000000000..123507929
--- /dev/null
+++ b/perl-install/install_steps.pm
@@ -0,0 +1,220 @@
+package install_steps;
+
+use diagnostics;
+use strict;
+
+use lang;
+use keyboard;
+use pkgs;
+use cpio;
+use log;
+use fsedit;
+
+
+
+1;
+
+
+sub new($) {
+    my ($type, $I) = @_;
+
+    bless $I, ref $type || $type;
+}
+
+
+sub doPartitionDisks($$$) {
+    my ($I, $hds) = @_;
+    fsedit::auto_allocate($hds, $I->{partitions});
+}
+
+sub choosePackages($$$$) {
+    my ($I, $packages, $comps, $isUpgrade) = @_;
+
+    foreach ('base', @{$I->{comps}}) {
+	$comps->{$_}->{selected} = 1;
+	foreach (@{$_->{packages}}) { $_->{selected} = 1; }
+    }
+    foreach (@{$I->{packages}}) { $_->{selected} = 1; }
+
+    smp::detect() and $packages->{"kernel-smp"}->{selected} = 1;
+}
+
+sub beforeInstallPackages($$$) {
+    my ($I, $method, $fstab, $isUpgrade) = @_;
+
+    $method->prepareMedia($fstab);
+
+    foreach (qw(dev etc home mnt tmp var var/tmp var/lib var/lib/rpm)) {
+	mkdir "$prefix/$_", 0755;
+    }
+
+    unless ($isUpgrade) {
+	local *F;
+	open F, "> $prefix/etc/hosts" or die "Failed to create etc/hosts: $!";
+	print F "127.0.0.1		localhost localhost.localdomain\n";
+    }
+}
+
+sub installPackages($$$$$) {
+    my ($I, $prefix, $method, $packages, $isUpgrade) = @_;
+
+    pkgs::install($prefix, $method, $packages, $isUpgrade, 0);
+}
+
+sub afterInstallPackages($$$$) {
+    my ($prefix, $keymap, $isUpgrade) = @_;
+
+    unless ($isUpgrade) {
+        keyboard::write($prefix, $keymap);
+        lang::write($prefix);
+    }
+    #  why not? 
+    sync(); sync();
+
+#    configPCMCIA($o->{rootPath}, $o->{pcmcia});
+}
+
+sub addUser($$) {
+    my ($I, $prefix) = @_;
+
+    my $new_uid;
+    #my @uids = map { (split)[2] } cat__("$prefix/etc/passwd");
+    #for ($new_uid = 500; member($new_uid, @uids); $new_uid++) {}
+    for ($new_uid = 500; getpwuid($new_uid); $new_uid++) {}
+
+    my $new_gid;
+    #my @gids = map { (split)[2] } cat__("$prefix/etc/group");
+    #for ($new_gid = 500; member($new_gid, @gids); $new_gid++) {}
+    for ($new_gid = 500; getgrgid($new_gid); $new_gid++) {}
+
+    my $homedir = "$prefix/home/$default->{user}->{name}";
+
+    my $pw = crypt_($default->{user}->{password});
+
+    unless ($testing) {
+	{
+	    local *F;
+	    open F, ">> $prefix/etc/passwd" or die "can't append to passwd file: $!";
+	    print F "$default->{user}->{name}:$pw:$new_uid:$new_gid:$default->{user}->{realname}:/home/$default->{user}->{name}:$default->{user}->{shell}\n";
+	    
+	    open F, ">> $prefix/etc/group" or die "can't append to group file: $!";
+	    print F "$default->{user}->{name}::$new_gid:\n";
+	}
+	eval { commands::cp("-f", "$prefix/etc/skel", $homedir) }; $@ and log::l("copying of skel failed: $@"), mkdir($homedir, 0750);
+	commands::chown_("-r", "$new_uid.$new_gid", $homedir);
+    }
+}
+
+sub setRootPassword($$) {
+    my ($I, $prefix) = @_;
+
+    my $pw = $default->{rootPassword};
+    $pw = crypt_($pw);
+
+    my @lines = cat_("$prefix/etc/passwd", 'die');
+    local *F;
+    open F, "> $prefix/etc/passwd" or die "can't write in passwd: $!\n";
+    foreach (@lines) {
+	s/^root:.*?:/root:$pw:/;
+	print F $_;
+    }
+}
+
+
+sub setupXfree {
+#    my ($method, $prefix, $psp) = @_;
+#    int fd, i;
+#    char buf[200], * chptr;
+#    char server[50];
+#    int rc;
+#    char * path;
+#    char * procPath;
+#    rpmdb db;
+#    rpmTransactionSet trans;
+#    struct callbackInfo cbi;
+#    rpmProblemSet probs;
+#
+#    if (rpmdbOpen(prefix, &db, O_RDWR | O_CREAT, 0644)) {
+#	 errorWindow(_("Fatal error reopening RPM database"));
+#	 return INST_ERROR;
+#    }
+#    log::l("reopened rpm database");
+#
+#    path = alloca(strlen(prefix) + 200);
+#    procPath = alloca(strlen(prefix) + 50);
+#    sprintf(path, "%s/usr/X11R6/bin/Xconfigurator", prefix);
+#
+#    # This is a cheap trick to see if our X component was installed 
+#    if (access(path, X_OK)) {
+#	 log::l("%s cannot be run", path);
+#	 return INST_OKAY;
+#    }
+#
+#    # need proc to do pci probing 
+#    sprintf(procPath, "%s/proc", prefix);
+#    umount(procPath);
+#    if ((rc = doMount("/proc", procPath, "proc", 0, 0))) {
+#	 return INST_ERROR;
+#    }
+#
+#    # this handles kickstart and normal/expert modes 
+#    if ((rc=xfree86Config(prefix, "--pick")))
+#	 return INST_ERROR;
+#    
+#    sprintf(path, "%s/tmp/SERVER", prefix);
+#    if ((fd = open(path, O_RDONLY)) < 0) {
+#	 log::l("failed to open %s: %s", path, strerror(errno));
+#	 return INST_ERROR;
+#    }
+# 
+#    buf[0] = '\0';
+#    read(fd, buf, sizeof(buf));
+#    close(fd);
+#    chptr = buf;
+#    while (chptr < (buf + sizeof(buf) - 1) && *chptr && *chptr != ' ')
+#	 chptr++;
+#
+#    if (chptr >= (buf + sizeof(buf) - 1) || *chptr != ' ') {
+#	 log::l("couldn't find ' ' in %s", path);
+#	 return INST_ERROR;
+#    }
+#
+#    *chptr = '\0';
+#    strcpy(server, "XFree86-");
+#    strcat(server, buf);
+#
+#    log::l("I will install the %s package", server);
+#
+#    for (i = 0; i < psp->numPackages; i++) {
+#	 if (!strcmp(psp->packages[i]->name, server)) {
+#	     log::l("\tfound package: %s", psp->packages[i]->name);
+#	     swOpen(1, psp->packages[i]->size);
+#	     trans = rpmtransCreateSet(db, prefix);
+#	     rpmtransAddPackage(trans, psp->packages[i]->h, NULL,
+#				psp->packages[i], 0, NULL);
+#	     
+#	     cbi.method = method;
+#	     cbi.upgrade = 0;
+#	     
+#	     rpmRunTransactions(trans, swCallback, &cbi, NULL, &probs, 0, 
+#				 0xffffffff);
+#	     
+#	     swClose();
+#	     break;
+#	 }
+#    }
+#
+#    # this handles kickstart and normal/expert modes 
+#    if ((rc=xfree86Config(prefix, "--continue")))
+#	 return INST_ERROR;
+#
+#    # done with proc now 
+#    umount(procPath);
+#
+#    rpmdbClose(db);
+#
+#    log::l("rpm database closed");
+#
+#    return INST_OKAY;
+}
+
diff --git a/perl-install/keyboard.pm b/perl-install/keyboard.pm
new file mode 100644
index 000000000..233aafda1
--- /dev/null
+++ b/perl-install/keyboard.pm
@@ -0,0 +1,128 @@
+package keyboard;
+
+use diagnostics;
+use strict;
+use vars qw($KMAP_MAGIC %defaultKeyboards %loadKeymap);
+
+use common qw(:system :file);
+use log;
+
+
+$KMAP_MAGIC = 0x8B39C07F;
+
+%defaultKeyboards = (
+  "de" => "de-latin1",
+  "fi" => "fi-latin1",
+  "se" => "se-latin1",
+  "no" => "no-latin1",
+  "cs" => "cz-lat2",
+  "tr" => "trq",
+);
+
+1;
+
+
+sub load($) {
+    my ($keymap_raw) = @_;
+
+    my ($magic, @keymaps) = unpack "i i" . c::MAX_NR_KEYMAPS() . "a*", $keymap_raw;
+    $keymap_raw = pop @keymaps;
+
+    $magic != $KMAP_MAGIC and die "failed to read kmap magic: $!";
+
+    local *F;
+    sysopen F, "/dev/console", 2 or die "failed to open /dev/console: $!";
+
+    my $count = 0;
+    foreach (0 .. c::MAX_NR_KEYMAPS() - 1) {
+	$keymaps[$_] or next;
+
+	my @keymap = unpack "s" . c::NR_KEYS() . "a*", $keymap_raw;
+	$keymap_raw = pop @keymap;
+
+	my $key = 0;
+	foreach my $value (@keymap) {
+	    c::KTYP($value) != c::KT_SPEC() or next;
+	    ioctl(F, c::KDSKBENT(), pack("CCS", $_, $key++, $value)) or log::l("keymap ioctl failed: $!");
+	    $key++;
+	 }
+	$count++;
+    }
+    log::l("loaded $count keymap tables");
+    1;
+}
+
+sub setup($) {
+    my ($defkbd) = @_;
+    my $t; 
+
+    #$::testing and return 1;
+
+    $defkbd ||= $defaultKeyboards{$ENV{LANG}} || "us";
+
+    local *F;
+    open F, "/etc/keymaps" or die "cannot open /etc/keymaps: $!";
+
+    my $format = "i2";
+    read F, $t, psizeof($format) or die "failed to read keymaps header: $!";
+    my ($magic, $numEntries) = unpack $format, $t;
+
+    log::l("%d keymaps are available", $numEntries);
+
+    my @infoTable;
+    my $format2 = "i Z40";
+    foreach (1..$numEntries) {
+	read F, $t, psizeof($format2) or die "failed to read keymap information: $!";
+	push @infoTable, [ unpack $format2, $t ];
+    }
+
+    foreach (@infoTable) {
+	read F, $t, $_->[0] or log::l("error reading $_->[0] bytes from file: $!"), return;
+
+	if ($defkbd eq $_->[1]) {
+	    log::l("using keymap $_->[1]");
+	    load($t) or return;
+	    &write("/tmp", $_->[1]) or log::l("write keyboard config failed");
+	    return $_->[1];
+	}
+    }
+    undef;
+}
+
+sub write($$) {
+    my ($prefix, $keymap) = @_;
+
+    $keymap or return 1;
+    $::testing and return 1;
+
+    local *F;
+    open F, ">$prefix/etc/sysconfig/keyboard" or die "failed to create keyboard configuration: $!";
+    print F "KEYTABLE=$keymap\n" or die "failed to write keyboard configuration: $!";
+
+    # write default keymap 
+    if (fork) {
+	wait;
+	$? == 0 or log::l('dumpkeys failed');
+    } else  {
+	chroot $prefix;
+	CORE::system("/usr/bin/dumpkeys > /etc/sysconfig/console/default.kmap 2>/dev/null");
+	exit($?);
+    }
+}
+
+sub read($) {
+    my ($file) = @_;
+
+    local *F;
+    open F, "$file" or # fail silently -- old bootdisks won't create this 
+	log::l("failed to read keyboard configuration (probably ok)"), return;
+
+    foreach (<F>) {
+	($_) = /^KEYTABLE=(.*)/ or die "unrecognized entry in keyboard configuration file";
+	s/\"//g; 
+	s/\.[^.]*//; # remove extension
+	return basename($_);
+    }
+    log::l("empty keyboard configuration file");
+    undef;
+}
diff --git a/perl-install/lang.pm b/perl-install/lang.pm
new file mode 100644
index 000000000..708a6b5da
--- /dev/null
+++ b/perl-install/lang.pm
@@ -0,0 +1,72 @@
+package lang;
+
+use diagnostics;
+use strict;
+
+use common qw(:file);
+use commands;
+use cpio;
+use log;
+
+my %languages = (
+  "en" => [ "English",   undef,		undef,		"en_US" ],
+  "fr" => [ "French",    "lat0-sun16",	"iso15",	"fr_FR" ],
+  "de" => [ "German",    "lat0-sun16",	"iso15",	"de_DE" ],
+  "hu" => [ "Hungarian", "lat2-sun16",  "iso02",	"hu_HU" ],
+  "is" => [ "Icelandic", "lat0-sun16",	"iso15",	"is_IS" ],
+  "it" => [ "Italian",   "lat0-sun16",	"iso15",	"it_IT" ],
+  "no" => [ "Norwegian", "lat0-sun16",	"iso15",	"no_NO" ],
+  "ro" => [ "Romanian",  "lat2-sun16",	"iso02",	"ro_RO" ],
+  "sk" => [ "Slovak",    "lat2-sun16",	"iso02",	"sk_SK" ],
+  "ru" => [ "Russian",   "Cyr_a8x16", 	"koi2alt",	"ru_SU" ],
+"uk_UA"=> [ "Ukrainian", "RUSCII_8x16",	"koi2alt",	"uk_UA" ],
+);
+
+1;
+
+sub set {
+    my $lang = shift;
+
+    if ($lang) {
+	$ENV{LANG} = $ENV{LINGUAS} = $lang;
+	$ENV{LC_ALL} = $languages{$lang}->[3];
+	my $f = $languages{$lang}->[1]; $f and load_font($f);
+    } else {
+	# stick with the default (English) */
+	delete $ENV{LANG};
+	delete $ENV{LC_ALL};
+	delete $ENV{LINGUAS};
+    }
+}
+
+sub write {
+    my ($prefix) = @_;
+    my $lang = $ENV{LANG};
+
+    $::testing || !$lang and return 0;
+    local *F;
+    open F, "> $prefix/etc/sysconfig/i18n";
+
+    my $f = sub { $_[1] and print F "$_[0]=$_[1]\n"; };
+    &$f("LANG", $lang);
+    &$f("LINGUAS", $lang);
+    if (my $l = $languages{$lang}) {
+	&$f("LC_ALL", $l->{lc_all});
+	&$f("SYSFONT", $l->{font});
+	&$f("SYSFONTACM", $l->{map});
+
+	my $p = "$prefix/usr/lib/kbd";
+	commands::cp("-f", 
+		     "$p/consolefonts/$l->{font}.psf.gz", 
+		     glob_("$p/consoletrans/$l->{map}*"), 
+		     "$prefix/etc/sysconfig/console");
+    }
+    1;
+}
+
+sub load_font {
+    my ($fontFile) = @_;
+    cpio::installCpioFile("/etc/fonts.cgz", $fontFile, "/tmp/font", 1) or die "error extracting $fontFile from /etc/fonts.cfz";
+    c::loadFont('/tmp/font') or log::l("error in loadFont: one of PIO_FONT PIO_UNIMAPCLR PIO_UNIMAP PIO_UNISCRNMAP failed: $!");
+    print STDERR "\033(K";
+}
diff --git a/perl-install/log.pm b/perl-install/log.pm
new file mode 100644
index 000000000..0fe696f07
--- /dev/null
+++ b/perl-install/log.pm
@@ -0,0 +1,34 @@
+use diagnostics;
+use strict;
+
+package log;
+
+my $logOpen = 0;
+my $logDebugMessages = 0;
+
+1;
+
+sub fd() { fileno LOG }
+
+sub l { 
+    $logOpen or openLog();
+    print LOG "* ", @_, "\n"; 
+    print LOG2 "* ", @_, "\n"; 
+}
+sub ld { $logDebugMessages and &l }
+sub w { &l }
+
+sub openLog(;$) {
+    if ($_[0]) { # useLocal
+	open LOG, "> $_[0]" or die "no log possible :(";
+    } else {
+	open LOG, "> /dev/tty3" or open LOG, ">> /tmp/install.log" or die "no log possible :(";
+    } 
+    open LOG2, ">> /tmp/ddebug.log" or die "no log possible :(";
+    select((select(LOG), $| = 1)[0]);
+    select((select(LOG2), $| = 1)[0]);
+    exists $ENV{DEBUG} and $logDebugMessages = 1;
+    $logOpen = 1;
+}
+
+sub closeLog() { close LOG; close LOG2; }
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
new file mode 100644
index 000000000..b6e2ebd9b
--- /dev/null
+++ b/perl-install/modules.pm
@@ -0,0 +1,330 @@
+package modules;
+
+use diagnostics;
+use strict;
+use vars qw(%loaded);
+
+use common qw(:file);
+use log;
+use detect_devices;
+use run_program;
+use pci;
+
+%loaded = ();
+
+my %deps = ();
+
+
+my @neOptions = (
+  [ "io=", "Base IO port:", "0x300:0x280:0x320:0x340:0x360" ],
+  [ "irq=", "IRQ level:", "" ],
+);
+
+my @de4x5Options = (
+  [ "io=", "Base IO port:", "0x0b" ],
+);
+
+my @cdu31aOptions = (
+  [ "cdu31a_port=", "Base IO port:", "" ],
+  [ "cdu31a_irq=", "IRQ level:", "" ],
+);
+
+my @cm206Options = (
+  [ "cm206=", "IO base, IRQ:", "" ],
+);
+
+my @mcdOptions = (
+  [ "mcd=", "Base IO port:", "" ],
+);
+
+my @optcdOptions = (
+  [ "optcd=", "Base IO port:", "" ],
+);
+
+my @fdomainOptions = (
+  [ "setup_called=", "Use other options", "1" ],
+  [ "port_base=", "Base IO port:", "0xd800" ],
+  [ "interrupt_level=", "Interrupt level (IRQ):", "10" ],
+);
+
+my @sbpcdOptions = (
+  [ "sbpcd=", "IO base, IRQ, label:", "" ],
+);
+
+my @parportPcOptions = (
+  [ "io=", "Base IO port:", "0x378" ],
+  [ "irq=", "IRQ level:", "7" ],
+);
+
+my %modules = (
+  "8390" => [ 1, undef, 0, '' ],
+  "cdu31a" => [ 0, \@cdu31aOptions, 0, '' ],
+  "cm206" => [ 0, \@cm206Options, 0, '' ],
+  "de4x5" => [ 1, \@de4x5Options, 'AUTOPROBE', "io=0" ],
+  "ds" => [ 1, undef, 0, '' ],
+  "fdomain" => [ 1, \@fdomainOptions, 0, '' ],
+  "i82365" => [ 1, undef, 0, '' ],
+  "isofs" => [ 1, undef, 0, '' ],
+  "loop" => [ 1, undef, 0, '' ],
+  "lp" => [ 1, undef, 0, '' ],
+  "parport" => [ 1, undef, 0, '' ],
+  "parport_pc" => [ 1, \@parportPcOptions, 0, "irq=7" ],
+  "mcd" => [ 0, \@mcdOptions, 0, '' ],
+  "ne" => [ 0, \@neOptions, 'FAKEAUTOPROBE', "io=0x300" ],
+  "nfs" => [ 1, undef, 0, '' ],
+  "optcd" => [ 0, \@optcdOptions, 0, '' ],
+  "pcmcia_core" => [ 1, undef, 0, '' ],
+  "sbpcd" => [ 1, \@sbpcdOptions, 0, '' ],
+  "smbfs" => [ 1, undef, 0, '' ],
+  "tcic" => [ 1, undef, 0, '' ],
+  "vfat" => [ 1, undef, 0, '' ],
+);
+
+my @drivers_by_category = (
+[ 0, \&detect_devices::hasEthernet, 'net', 'ethernet', {
+  "3c509" => "3com 3c509",
+  "3c501" => "3com 3c501",
+  "3c503" => "3com 3c503",
+  "3c505" => "3com 3c505",
+  "3c507" => "3com 3c507",
+  "3c515" => "3com 3c515",
+  "3c59x" => "3com 3c59x (Vortex)",
+  "3c59x" => "3com 3c90x (Boomerang)",
+  "at1700" => "Allied Telesis AT1700",
+  "ac3200" => "Ansel Communication AC3200",
+  "pcnet32" => "AMD PC/Net 32",
+  "apricot" => "Apricot 82596",
+  "atp" => "ATP",
+  "e2100" => "Cabletron E2100",
+  "tlan" => "Compaq Netelligent",
+  "de4x5" => "Digital 425,434,435,450,500",
+  "depca" => "Digital DEPCA and EtherWORKS",
+  "ewrk3" => "Digital EtherWORKS 3",
+  "tulip" => "Digital 21040 (Tulip)",
+  "de600" => "D-Link DE-600 pocket adapter",
+  "de620" => "D-Link DE-620 pocket adapter",
+  "epic100" => "EPIC 100",
+  "hp100" => "HP10/100VG any LAN ",
+  "hp" => "HP LAN/AnyLan",
+  "hp-plus" => "HP PCLAN/plus",
+  "eth16i" => "ICL EtherTeam 16i",
+  "eexpress" => "Intel EtherExpress",
+  "eepro" => "Intel EtherExpress Pro",
+  "eepro100" => "Intel EtherExpress Pro 100",
+  "lance" => "Lance",
+  "lne390" => "Mylex LNE390",
+  "ne" => "NE2000 and compatible",
+  "ne2k-pci" => "NE2000 PCI",
+  "ne3210" => "NE3210",
+  "ni5010" => "NI 5010",
+  "ni52" => "NI 5210",
+  "ni65" => "NI 6510",
+  "rtl8139" => "RealTek RTL8129/8139",
+  "es3210" => "Racal-Interlan ES3210",
+  "rcpci45" => "RedCreek PCI45 LAN",
+  "epic100" => "SMC 83c170 EPIC/100",
+  "smc9194" => "SMC 9000 series",
+  "smc-ultra" => "SMC Ultra",
+  "smc-ultra32" => "SMC Ultra 32",
+  "via-rhine" => "VIA Rhine",
+  "wd" => "WD8003, WD8013 and compatible",
+}],
+[ 0, \&detect_devices::hasSCSI, 'scsi', undef, {
+  "aha152x" => "Adaptec 152x",
+  "aha1542" => "Adaptec 1542",
+  "aha1740" => "Adaptec 1740",
+  "aic7xxx" => "Adaptec 2740, 2840, 2940",
+  "advansys" => "AdvanSys Adapters",
+  "in2000" => "Always IN2000",
+  "AM53C974" => "AMD SCSI",
+  "megaraid" => "AMI MegaRAID",
+  "BusLogic" => "BusLogic Adapters",
+  "dtc" => "DTC 3180/3280",
+  "eata_dma" => "EATA DMA Adapters",
+  "eata_pio" => "EATA PIO Adapters",
+  "seagate" => "Future Domain TMC-885, TMC-950",
+  "fdomain" => "Future Domain TMC-16x0",
+  "gdth" => "ICP Disk Array Controller",
+  "ppa" => "Iomega PPA3 (parallel port Zip)",
+  "g_NCR5380" => "NCR 5380",
+  "NCR53c406a" => "NCR 53c406a",
+  "53c7,8xx" => "NCR 53c7xx",
+  "ncr53c8xx" => "NCR 53C8xx PCI",
+  "pci2000" => "Perceptive Solutions PCI-2000",
+  "pas16" => "Pro Audio Spectrum/Studio 16",
+  "qlogicfas" => "Qlogic FAS",
+  "qlogicisp" => "Qlogic ISP",
+  "seagate" => "Seagate ST01/02",
+  "t128" => "Trantor T128/T128F/T228",
+  "u14-34f" => "UltraStor 14F/34F",
+  "ultrastor" => "UltraStor 14F/24F/34F",
+  "wd7000" => "Western Digital wd7000",
+}],
+[ 0, undef, 'cdrom', 'none', {
+  "sbpcd" => "SoundBlaster/Panasonic",
+  "aztcd" => "Aztech CD",
+  "bpcd" => "Backpack CDROM",
+  "gscd" => "Goldstar R420",
+  "mcd" => "Mitsumi",
+  "mcdx" => "Mitsumi (alternate)",
+  "optcd" => "Optics Storage 8000",
+  "cm206" => "Phillips CM206/CM260",
+  "sjcd" => "Sanyo",
+  "cdu31a" => "Sony CDU-31A",
+  "sonycd535" => "Sony CDU-5xx",
+}]
+);
+
+my %drivers = (
+  "plip" => [ "PLIP (parallel port)", 0, \&detect_devices::hasPlip, 'net', 'plip' ],
+  "ibmtr" => [ "Token Ring", 0, \&detect_devices::hasTokenRing, 'net', 'tr' ],
+  "DAC960" => [ "Mylex DAC960", 0, undef, 'scsi', undef ],
+  "pcmcia_core" => [ "PCMCIA core support", 0, undef, 'pcmcia', undef ],
+  "ds" => [ "PCMCIA card support", 0, undef, 'pcmcia', undef ],
+  "i82365" => [ "PCMCIA i82365 controller", 0, undef, 'pcmcia', undef ],
+  "tcic" => [ "PCMCIA tcic controller", 0, undef, 'pcmcia', undef ],
+  "isofs" => [ "iso9660", 0, undef, 'fs', undef ],
+  "nfs" => [ "Network File System (nfs)", 0, undef, 'fs', undef ],
+  "smbfs" => [ "Windows SMB", 0, undef, 'fs', undef ],
+  "loop" => [ "Loopback device", 0, undef, 'other', undef ],
+  "lp" => [ "Parallel Printer", 0, undef, 'other', undef ],
+);
+foreach (@drivers_by_category) {
+    my @l = @$_;
+    my $l = pop @l;
+    foreach (keys %$l) { $drivers{$_} = [ $l->{$_}, @l ]; }
+}
+
+
+1;
+
+
+sub load($;$$) {
+    my ($name, $type, $minor) = @_;
+
+    $loaded{$name} and return;
+
+    $type or ($type, $minor) = @{$drivers{$name}}[3,4];
+
+    foreach (@{$deps{$name}}) { load($_, 'prereq', $minor) }
+    load_raw($name, $type, $minor);
+}
+
+sub unload($) { run_program::run("/bin/rmmod", $_[0]); }
+
+sub load_raw($$$@) {
+    my ($name, $type, $minor, @options) = @_;
+
+#    @options or @options = guiGetModuleOptions($name);
+
+    run_program::run("/usr/bin/insmod", "/modules/$name.o", @options) or die("insmod module $name");
+
+    # this is a hack to make plip go
+    if ($name eq "parport_pc") {
+	foreach (@options) {
+	    /^irq=(\d+)/ or next;
+	    log::l("writing to /proc/parport/0/irq");
+	    local *F;
+	    open F, "> /proc/parport/0/irq" or last;
+	    print F $1;
+	}
+    }
+    $loaded{$name} = { type => $type, minor => $minor, options => \@options };
+}
+
+sub load_deps($) {
+    my ($file) = @_;
+
+    local *F;
+    open F, $file or log::l("error opening $file: $!"), return 0;
+    foreach (<F>) {
+	my ($f, $deps) = split ':';
+	push @{$deps{$f}}, split ' ', $deps;
+    }
+    1;
+}
+
+sub read_conf {
+    my ($file) = @_;
+
+    local *F;
+    open F, $file or log::l("failed to open $file for module information"), return 0;
+
+    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 ] };
+    }
+    1;
+}
+
+sub write_conf {
+    my ($file, $append) = @_;
+    my ($tr, $eth, $scsi) = (0, 0, 0);
+
+    $::testing and return 1;
+
+    $append or rename($file, "$file.orig"), log::l("backing up old conf.modules");
+
+    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";
+	}
+    }
+
+    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) = @_;
+    my @devs;
+    my $found;
+
+    log::l("in load_thiskind, type = $type");
+
+    unless ($type eq 'scsi' || $type eq 'net') {
+	 log::l("pci probing for $type devices");
+	 @devs = pci::probe($type);
+	 log::l("pci probe found " . scalar @devs . "$type devices");
+    }
+
+    my %devs;
+    foreach (@devs) {
+	 my $m = $_->{module};
+	 $devs{$m}++ and log::l("multiple $m devices found"), next;
+	 $drivers{$m} or log::l("module $m not in install table"), next;
+	 log::l("found driver for $m");
+	 load($m);
+	 $found = 1;
+    }
+    pci::free(@devs);
+    $found;
+}
+
+# This assumes only one of each driver type is loaded
+sub removeDeviceDriver {
+#    my ($type) = @_;
+#
+#    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]);
+#    1;
+}
+
+
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
new file mode 100644
index 000000000..a6f1101d5
--- /dev/null
+++ b/perl-install/my_gtk.pm
@@ -0,0 +1,261 @@
+package my_gtk;
+
+use diagnostics;
+use strict;
+use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK);
+
+@ISA = qw(Exporter);
+%EXPORT_TAGS = (
+    all => [ qw(create_window create_yesorno createScrolledWindow create_menu create_notebook create_packtable create_hbox create_adjustment mymain my_signal_connect mypack mypack_ myappend myadd label_align myset_usize myset_justify myshow mysync myflush mydestroy) ],
+);
+@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
+
+use Gtk;
+
+1;
+
+
+sub new {
+    my ($type, $title, @opts) = @_;
+
+    Gtk->init;
+    parse Gtk::Rc "$ENV{HOME}/etc/any/Gtkrc";
+    my $o = bless { @opts }, $type;
+    $o->{window} = $o->create_window($title);
+    $o;
+}
+sub destroy($) { 
+    my ($o) = @_;
+    $o->{window}->destroy;
+    myflush();
+}
+
+sub ask_from_entry($$@) {
+    my ($o, @msgs) = @_;
+    my $entry = new Gtk::Entry;
+    my $f = sub { $o->{retval} = $entry->get_text; Gtk->main_quit };
+
+    myadd($o->{window},
+	  mypack($o->create_box_with_title(@msgs),
+		 my_signal_connect($entry, 'activate' => $f),
+		 ($o->{hide_buttons} ? () : mypack(new Gtk::HBox(0,0),
+			my_signal_connect(new Gtk::Button('Ok'), 'clicked' => $f),
+			my_signal_connect(new Gtk::Button('Cancel'), 'clicked' => sub { $o->{retval} = undef; Gtk->main_quit }),
+			)),
+		 ),
+	  );
+    $entry->grab_focus();
+    mymain($o);
+}
+
+
+sub ask_from_list($\@$@) {
+    my ($o, $l, @msgs) = @_;
+    my $f = sub { $o->{retval} = $_[1]; Gtk->main_quit };
+    my @l = map { my_signal_connect(new Gtk::Button($_), "clicked" => $f, $_) } @$l;
+
+#    myadd($o->{window}, 
+#	   mypack_(myset_usize(new Gtk::VBox(0,0), 0, 200),
+#		   0, $o->create_box_with_title(@msgs), 
+#		   1, createScrolledWindow(mypack(new Gtk::VBox(0,0), @l))));
+    myadd($o->{window}, 
+	  mypack($o->create_box_with_title(@msgs), @l));
+   $l[0]->grab_focus();
+    mymain($o)
+}
+
+
+sub ask_warn($@) {
+    my ($o, @msgs) = @_;
+
+    myadd($o->{window},
+	  mypack($o->create_box_with_title(@msgs),
+		 my_signal_connect(my $w = new Gtk::Button("Ok"), "clicked" => sub { Gtk->main_quit }),
+		 ),
+	  );
+    $w->grab_focus();
+    mymain($o)
+}
+
+sub ask_yesorno($@) {
+    my ($o, @msgs) = @_;
+
+    myadd($o->{window},
+	  mypack(create_box_with_title($o, @msgs),
+		 create_yesorno($o),
+		 )
+	 );
+    $o->{ok}->grab_focus();
+    mymain($o)
+}
+
+sub create_window($$) {
+    my ($o, $title) = @_;
+    $o->{window} = new Gtk::Window;
+    $o->{window}->set_title($title);
+    $o->{window}->signal_connect("delete_event" => sub { $o->{retval} = undef; Gtk->main_quit });
+    $o->{window}
+}
+
+sub create_yesorno($) {
+    my ($w) = @_;
+
+    myadd(create_hbox(),
+	  my_signal_connect($w->{ok} = new Gtk::Button("Ok"), "clicked" => sub { $w->{retval} = 1; Gtk->main_quit }),
+	  my_signal_connect(new Gtk::Button("Cancel"), "clicked" => sub { $w->{retval} = 0; Gtk->main_quit }),
+	 );
+}
+
+sub create_box_with_title($@) {
+    my $o = shift;
+    $o->{box} = mypack(new Gtk::VBox(0,0),
+		       map({ new Gtk::Label("  $_  ") } @_),
+		       new Gtk::HSeparator,
+		       )
+}
+
+sub createScrolledWindow($) {
+    my $w = new Gtk::ScrolledWindow(undef, undef);
+    $w->set_policy('automatic', 'automatic');
+    $w->add_with_viewport($_[0]);
+    $_[0]->show;
+    $w
+}
+
+sub create_menu($@) {
+    my $title = shift;
+    my $w = new Gtk::MenuItem($title);
+    $w->set_submenu(myshow(myappend(new Gtk::Menu, @_)));
+    $w
+}
+
+sub create_notebook(@) {
+    my $n = new Gtk::Notebook;
+    while (@_) {
+	my $title = shift;
+	my $book = shift;
+
+	my ($w1, $w2) = map { new Gtk::Label($_) } $title, $title;
+	$n->append_page_menu($book, $w1, $w2);
+	$book->show;
+	$w1->show;
+	$w2->show;
+    }
+    $n
+}
+
+sub create_adjustment($$$) {
+    my ($val, $min, $max) = @_;
+    new Gtk::Adjustment($val, $min, $max + 1, 1, ($max - $min + 1) / 10, 1);
+}
+
+sub create_packtable($@) {
+    my $options = shift;
+    my $w = new Gtk::Table(0, 0, $options->{homogeneous} || 0);
+    my $i = 0; foreach (@_) {
+	for (my $j = 0; $j < @$_; $j++) {
+	    if (defined $_->[$j]) {
+		my $l = $_->[$j]; 
+		ref $l or $l = new Gtk::Label($l);
+		$w->attach_defaults($l, $j, $j + 1, $i, $i + 1);
+		$l->show;
+	    }
+	}
+	$i++;
+    }
+    $w->set_col_spacings($options->{col_spacings} || 0);
+    $w->set_row_spacings($options->{row_spacings} || 0);
+    $w
+}
+
+sub create_hbox {
+    my $w = new Gtk::HButtonBox;
+    $w->set_layout(-spread);
+    $w;
+}
+
+sub mymain($) {
+    my $o = shift;
+
+    $o->{window}->show;
+    Gtk->main;
+    $o->{window}->destroy;
+    myflush();
+    $o->{retval}
+}
+
+sub my_signal_connect($@) {
+    my $w = shift;
+    $w->signal_connect(@_);
+    $w
+}
+
+sub mypack($@) {
+    my $box = shift;
+    foreach (@_) {
+	my $l = $_; 
+	ref $l or $l = new Gtk::Label($l);
+	$box->pack_start($l, 1, 1, 0);
+	$l->show;
+    }
+    $box
+}
+
+sub mypack_($@) {
+    my $box = shift;
+    for (my $i = 0; $i < @_; $i += 2) {
+	my $l = $_[$i + 1]; 
+	ref $l or $l = new Gtk::Label($l);
+	$box->pack_start($l, $_[$i], 1, 0);
+	$_[$i + 1]->show;
+    }
+    $box
+}
+
+sub myappend($@) {
+    my $w = shift;
+    foreach (@_) { 
+	my $l = $_; 
+	ref $l or $l = new Gtk::Label($l);
+	$w->append($l); 
+	$l->show;
+    }
+    $w
+}
+sub myadd($@) {
+    my $w = shift;
+    foreach (@_) {
+	my $l = $_; 
+	ref $l or $l = new Gtk::Label($l);
+	$w->add($l);
+	$l->show;
+    }
+    $w
+}
+sub myshow($) { $_[0]->show; $_[0] }
+
+sub mysync(;$) {
+    my ($o) = @_;
+    $o and $o->{window}->show;
+
+    my $h = Gtk->idle_add(sub { Gtk->main_quit; 1 });
+    map { Gtk->main } (1..4);
+    Gtk->idle_remove($h);
+}
+sub myflush(;$) {
+    Gtk->main_iteration while Gtk::Gdk->events_pending;
+}
+
+
+
+sub bigsize($) { $_[0]->{window}->set_usize(600,400); }
+sub myset_usize($$$) { $_[0]->set_usize($_[1],$_[2]); $_[0] }
+sub myset_justify($$) { $_[0]->set_justify($_[1]); $_[0] }
+sub mydestroy($) { $_[0] and $_[0]->destroy }
+
+sub label_align($$) {
+    my $w = shift;
+    local $_ = shift;
+    $w->set_alignment(!/W/i, !/N/i);
+    $w
+}
diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm
new file mode 100644
index 000000000..a7d06fb21
--- /dev/null
+++ b/perl-install/partition_table.pm
@@ -0,0 +1,333 @@
+package partition_table;
+
+use diagnostics;
+use strict;
+use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @important_types);
+
+@ISA = qw(Exporter);
+%EXPORT_TAGS = (
+    types => [ qw(type2name type2fs name2type fs2type isExtended isExt2 isSwap isDos isWin isPrimary isNfs) ],
+);
+@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
+
+
+use common qw(:common :system);
+use partition_table_raw;
+
+
+@important_types = ("Linux native", "Linux swap", "DOS FAT16");
+
+my %types = (
+  0 => "Empty",
+  1 => "DOS 12-bit FAT",
+  2 => "XENIX root",
+  3 => "XENIX usr",
+  4 => "DOS 16-bit <32M",
+  5 => "Extended",
+  6 => "DOS FAT16",
+  7 => "OS/2 HPFS",               # or QNX? 
+  8 => "AIX",
+  9 => "AIX bootable",
+  10 => "OS/2 Boot Manager",
+  0xb => "Win98 FAT32",
+  0xc => "Win98 FAT32 0xb",
+  0xe => "Win98 FAT32 0xc",
+  0x12 => "Compaq setup",
+  0x40 => "Venix 80286",
+  0x51 => "Novell?",
+  0x52 => "Microport",            # or CPM? 
+  0x63 => "GNU HURD",             # or System V/386? 
+  0x64 => "Novell Netware 286",
+  0x65 => "Novell Netware 386",
+  0x75 => "PC/IX",
+  0x80 => "Old MINIX",            # Minix 1.4a and earlier 
+  
+  0x81 => "Linux/MINIX", # Minix 1.4b and later 
+  0x82 => "Linux swap",
+  0x83 => "Linux native",
+  
+  0x93 => "Amoeba",
+  0x94 => "Amoeba BBT",           # (bad block table) 
+  0xa5 => "BSD/386",
+  0xb7 => "BSDI fs",
+  0xb8 => "BSDI swap",
+  0xc7 => "Syrinx",
+  0xdb => "CP/M",                 # or Concurrent DOS? 
+  0xe1 => "DOS access",
+  0xe3 => "DOS R/O",
+  0xf2 => "DOS secondary",
+  0xff => "BBT"                   # (bad track table) 
+);
+
+my %type2fs = (
+  0x01 => 'vfat',
+  0x04 => 'vfat',
+  0x05 => 'ignore',
+  0x06 => 'vfat',
+  0x07 => 'hpfs',
+  0x0b => 'vfat',
+  0x0c => 'vfat',
+  0x0e => 'vfat',
+  0x82 => 'swap',
+  0x83 => 'ext2',
+  nfs  => 'nfs', # hack
+);
+my %types_rev = reverse %types;
+my %fs2type = reverse %type2fs;
+
+
+1;
+
+sub type2name($) { $types{$_[0]} }
+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 isPrimary($$) {
+    my ($part, $hd) = @_;
+    foreach (@{$hd->{primary}->{raw}}) { $part eq $_ and return 1; }
+    0;
+}
+
+sub cylinder_size($) { 
+    my ($hd) = @_;
+    $hd->{geom}->{sectors} * $hd->{geom}->{heads};
+}
+
+sub adjustStart($$) {
+    my ($hd, $part) = @_;
+    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->{size} = $end - $part->{start};
+}
+sub adjustEnd($$) {
+    my ($hd, $part) = @_;
+    my $end = $part->{start} + $part->{size};
+
+    $end = round_down($end, cylinder_size($hd));
+    $part->{size} = $end - $part->{start};
+}
+sub adjustStartAndEnd($$) {
+    &adjustStart;
+    &adjustEnd;
+}
+
+sub verifyNotOverlap($$) {
+    my ($a, $b) = @_;
+    $a->{start} + $a->{size} <= $b->{start} || $b->{start} + $b->{size} <= $a->{start};
+}
+sub verifyInside($$) {
+    my ($a, $b) = @_;
+    $b->{start} <= $a->{start} && $a->{start} + $a->{size} <= $b->{start} + $b->{size};
+}
+
+sub assign_device_numbers($) {
+    my ($hd) = @_;
+
+    my $i = 1; foreach (@{$hd->{primary}->{raw}}, map { $_->{normal} } @{$hd->{extended}}) { 
+	$_->{device} = $hd->{prefix} . $i++;
+    }
+}
+
+sub get_normal_parts($) {
+    my ($hd) = @_;
+
+    @{$hd->{primary}->{normal} || []}, map { $_->{normal} } @{$hd->{extended} || []}
+}
+
+
+sub read_one($$) {
+    my ($hd, $sector) = @_;
+
+    my $pt = partition_table_raw::read($hd, $sector) or return;
+
+    my @extended = grep { isExtended($_) } @$pt;
+    my @normal = grep { $_->{size} && $_->{type} && !isExtended($_) } @$pt;
+
+    @extended > 1 and die "more than one extended partition";
+
+    foreach (@normal, @extended) {
+	$_->{rootDevice} = $hd->{device};
+    }
+    { raw => $pt, extended => $extended[0], normal => \@normal };
+}
+
+sub read($;$) {
+    my ($hd, $clearall) = @_;
+    my $pt = $clearall ? { raw => [ {}, {}, {}, {} ] } : read_one($hd, 0) || return 0;
+
+    $hd->{primary} = $pt;
+    $hd->{extended} = undef;
+    $clearall and return $hd->{isDirty} = 1;
+
+    my @l = (@{$pt->{normal}}, $pt->{extended});
+    foreach my $i (@l) { foreach (@l) {
+	$i != $_ and verifyNotOverlap($i, $_) || die "partitions $i->{device} and $_->{device} are overlapping!";
+    }}
+
+    eval {
+	$pt->{extended} and read_extended($hd, $pt->{extended}) || return 0;
+    }; die "extended partition: $@" if $@;
+    assign_device_numbers($hd);
+    1;
+}
+
+sub read_extended($$) {
+    my ($hd, $extended) = @_;
+
+    my $pt = read_one($hd, $extended->{start}) or return 0;
+    $pt = { %$extended, %$pt };
+
+    push @{$hd->{extended}}, $pt;
+    @{$hd->{extended}} > 100 and die "oops, seems like we're looping here :(  (or you have more than 100 extended partitions!)";
+
+    @{$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];
+    # in case of extended partitions, the start sector is local to the partition or to the first extended_part!
+    $pt->{normal}->{start} += $pt->{start};
+
+    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};
+	read_extended($hd, $pt->{extended}) or return 0;
+    }
+    1;
+}
+
+# give a hard drive hd, write the partition data 
+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;
+    }
+    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};
+
+	partition_table_raw::write($hd, $_->{start}, $_->{raw}) or die "writing of partition table failed";
+    }
+    $hd->{isDirty} = 0;
+
+    # now sync disk and re-read the partition table 
+    sync();
+    partition_table_raw::kernel_read($hd);
+}
+
+sub active($$) {
+    my ($hd, $part) = @_;
+
+    foreach (@{$hd->{primary}->{normal}}) { $_->{active} = 0; }
+    $part->{active} = 0x80;   
+}
+
+
+# remove a normal partition from hard drive hd
+sub remove($$) {
+    my ($hd, $part) = @_;
+    my $i;
+
+    # first search it in the primary partitions
+    $i = 0; foreach (@{$hd->{primary}->{normal}}) {
+	if ($_ eq $part) {
+	    splice(@{$hd->{primary}->{normal}}, $i, 1);
+	    %$_ = ();
+
+	    return $hd->{isDirty} = 1;
+	}
+	$i++;
+    }
+    # otherwise search it in extended partitions
+    my $last = $hd->{primary}->{extended};
+    $i = 0; foreach (@{$hd->{extended}}) {
+	if ($_->{normal} eq $part) {
+	    %{$last->{extended}} = $_->{extended} ? %{$_->{extended}} : ();
+	    splice(@{$hd->{extended}}, $i, 1);
+	    
+	    return $hd->{isDirty} = 1;
+	}
+	$last = $_;
+	$i++;
+    }
+    0;
+}
+
+# create of partition at starting at `start', of size `size' and of type `type' (nice comment, uh?)
+# !be carefull!, no verification is done (start -> start+size must be free)
+sub add($$) {
+    my ($hd, $part) = @_;
+
+    $part->{notFormatted} = 1;
+    $part->{isFormatted} = 0;
+    $part->{rootDevice} = $hd->{device};
+    $hd->{isDirty} = 1;
+    adjustStartAndEnd($hd, $part);
+
+    if (is_empty_array_ref($hd->{primary}->{normal})) {
+	raw_add($hd->{primary}->{raw}, $part);
+	@{$hd->{primary}->{normal}} = $part;
+    } else {
+	foreach (@{$hd->{extended}}) {
+	    $_->{normal} and next;
+	    raw_add($_->{raw}, $part);
+	    $_->{normal} = $part;
+	    return;
+	}
+	my ($ext, $ext_size) = is_empty_array_ref($hd->{extended}) ?
+	  ($hd->{primary}, $hd->{totalsectors} - $part->{start}) :
+	  (top(@{$hd->{extended}}), $part->{size});
+	my %ext = ( type => 5, start => $part->{start}, size => $ext_size );
+	
+	raw_add($ext->{raw}, \%ext);
+	$ext->{extended} = \%ext;
+	push @{$hd->{extended}}, { %ext, raw => [ $part, {}, {}, {} ], normal => $part };
+
+	$part->{start}++; $part->{size}--; # let it start after the extended partition sector
+	adjustStartAndEnd($hd, $part);
+    }
+}
+
+# search for the next partition
+sub next($$) {
+    my ($hd, $part) = @_;
+
+    first(
+	  sort { $a->{start} <=> $b->{start} } 
+	  grep { $_->{start} >= $part->{start} + $part->{size} }
+	  get_normal_parts($hd)
+	 );
+}
+sub next_start($$) {
+    my ($hd, $part) = @_;
+    my $next = &next($hd, $part);
+    $next ? $next->{start} : $hd->{totalsectors};
+}
+
+
+sub raw_add($$) {
+    my ($raw, $part) = @_;
+
+    foreach (@$raw) {
+	$_->{size} || $_->{type} and next;
+	$_ = $part;
+	return;
+    }
+    die "raw_add: partition table already full";
+}
+
diff --git a/perl-install/partition_table_raw.pm b/perl-install/partition_table_raw.pm
new file mode 100644
index 000000000..d85789a50
--- /dev/null
+++ b/perl-install/partition_table_raw.pm
@@ -0,0 +1,101 @@
+package partition_table_raw;
+
+use diagnostics;
+use strict;
+
+use common qw(:common :system);
+use c;
+
+my @fields = qw(active start_head start_sec start_cyl type end_head end_sec end_cyl start size);
+my $format = "C8 I2";
+my $magic = "\x55\xAA";
+my $nb_primary = 4;
+
+my $offset = $common::SECTORSIZE - length($magic) - $nb_primary * common::psizeof($format);
+
+1;
+
+
+sub compute_CHS($$) {
+    my ($hd, $e) = @_;
+    my @l = qw(cyl head sec);
+    @$e{map { "start_$_" } @l} = $e->{start} || $e->{type} ? CHS2rawCHS(sector2CHS($hd, $e->{start})) : (0,0,0);
+    @$e{map { "end_$_"   } @l} = $e->{start} || $e->{type} ? CHS2rawCHS(sector2CHS($hd, $e->{start} + $e->{size} - 1)) : (0,0,0);
+    1;
+}
+
+sub CHS2rawCHS($$$) {
+    my ($c, $h, $s) = @_;
+    $c = min($c, 1023); # no way to have a #cylinder >= 1024
+    ($c & 0xff, $h, $s | ($c >> 2 & 0xc0));
+}
+
+# returns (cylinder, head, sector)
+sub sector2CHS($$) {
+    my ($hd, $start) = @_;
+    my ($s, $h);
+    ($start, $s) = divide($start, $hd->{geom}->{sectors});
+    ($start, $h) = divide($start, $hd->{geom}->{heads});
+    ($start, $h, $s + 1);
+}
+
+sub get_geometry($) {
+    my ($dev) = @_;
+    my $g = "";
+   
+    local *F; sysopen F, $dev, 0 or return;
+    ioctl(F, c::HDIO_GETGEO(), $g) or return;
+
+    my %geom; @geom{qw(heads sectors cylinders start)} = unpack "CCSL", $g;
+
+    { geom => \%geom, totalsectors => $geom{heads} * $geom{sectors} * $geom{cylinders} };
+}
+
+sub openit($$;$) { sysopen $_[1], $_[0]->{file}, $_[2] || 0; }
+
+# cause kernel to re-read partition table 
+sub kernel_read($) {
+    my ($hd) = @_;
+    local *F; openit($hd, \*F) or return 0;
+    ioctl(F, c::BLKRRPART(), 0) or die "kernel_read failed: need to reboot";
+}
+
+sub read($$) {
+    my ($hd, $sector) = @_;
+    my $tmp;
+
+    local *F; openit($hd, \*F) or return;
+    c::lseek_sector(fileno(F), $sector, $offset) or die "reading of partition in sector $sector failed";
+
+    my @pt = map {
+	sysread F, $tmp, psizeof($format) or return "error while reading partition table in sector $sector";
+	my %h; @h{@fields} = unpack $format, $tmp;
+	\%h;
+    } (1..$nb_primary);
+
+    # check magic number
+    sysread F, $tmp, length $magic or die "error reading magic number";
+    $tmp eq $magic or die "bad magic number";
+
+    [ @pt ];
+}
+
+# write the partition table (and extended ones)
+# for each entry, it uses fields: start, size, type, active
+sub write($$$) {
+    my ($hd, $sector, $pt) = @_;
+
+    local *F; openit($hd, \*F, 2) or die "error opening device $hd->{device} for writing";
+    c::lseek_sector(fileno(F), $sector, $offset) or return 0;
+
+    @$pt == $nb_primary or die "partition table does not have $nb_primary entries";
+    foreach (@$pt) {
+	compute_CHS($hd, $_);
+	local $_->{start} = $_->{local_start} || 0;
+	$_->{active} ||= 0; $_->{type} ||= 0; $_->{size} ||= 0; # for no warning
+	syswrite F, pack($format, @$_{@fields}) or return 0;
+    }
+    syswrite F, $magic or return 0;
+    1;
+}
+sub zero_MBR($) { &write($_[0], 0, [ {} x $nb_primary ]); }
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
new file mode 100644
index 000000000..1f4764d22
--- /dev/null
+++ b/perl-install/pkgs.pm
@@ -0,0 +1,211 @@
+package pkgs;
+
+use diagnostics;
+use strict;
+
+use common qw(:common :file);
+use log;
+use smp;
+use fs;
+
+my @skipList = qw(XFree86-8514 XFree86-AGX XFree86-Mach32 XFree86-Mach64 XFree86-Mach8 XFree86-Mono
+		  XFree86-P9000 XFree86-S3 XFree86-S3V XFree86-SVGA XFree86-W32 XFree86-I128
+		  XFree86-Sun XFree86-SunMono XFree86-Sun24 XFree86-3DLabs kernel-boot
+		  metroess metrotmpl);
+
+1;
+
+
+sub psUsingDirectory {
+    my ($dirname) = @_;
+    my %packages;
+
+    log::l("scanning $dirname for packages");
+    foreach (glob_("$dirname/*.rpm")) {
+	my $basename = basename($_);
+	local *F;
+	open F, $_ or log::l("failed to open package $_: $!");
+	my $header = c::rpmReadPackageHeader($_) or log::l("failed to rpmReadPackageHeader $basename: $!");
+	my $name = c::headerGetEntry($header, 'name');
+
+	$packages{lc $name} = { 
+	    header => $header, selected => 0, manuallySelected => 0, name => $name,
+	    size => c::headerGetEntry($header, 'size'),
+	    group => c::headerGetEntry($header, 'group') || "(unknown group)",
+	    inmenu => skipPackage($name),
+	};
+    }
+    \%packages;
+}
+
+sub psReadComponentsFile {
+    my ($compsfile, $packages) = @_;
+    my (%comps, %current);
+
+    local *F;
+    open F, $compsfile or die "Cannot open components file: $!";
+
+    <F> =~ /^0(\.1)?$/ or die "Comps file is not version 0.1 as expected";
+
+    my $inComp = 0;
+    my $n = 0;
+    foreach (<F>) { $n++;
+	chomp;
+	s/^ +//;
+	/^#/ and next;
+	/^$/ and next;
+
+	if ($inComp) { if (/^end$/) {
+		$inComp = 0;
+		$comps{lc $current{name}} = { %current };
+	    } else {
+		push @{$current{packages}}, $packages->{lc $_} || log::w "package $_ does not exist (line $n of comps file)";
+	    }
+	} else {
+	    my ($selected, $hidden, $name) = /^([01])\s*(--hide)?\s*(.*)/ or die "bad comps file at line $n";
+	    %current = (selected => $selected, inmenu => !$hidden, name => $name);
+	    $inComp = 1;
+	}
+    }
+    log::l("read " . (scalar keys %comps) . " comps");
+    \%comps;
+}
+
+
+
+sub psVerifyDependencies {
+#    my ($packages, $fixup) = @_;
+#
+#    -r "/mnt/var/lib/rpm/packages.rpm" or die "can't find packages.rpm";
+#
+#    my $db = rpmdbOpenRWCreate("/mnt");
+#    my $rpmdeps = rpmtransCreateSet($db, undef);
+#
+#    foreach (values %$packages) {
+#	 $_->{selected} ?
+#	     c::rpmtransAddPackage($rpmdeps, $_->{header}, undef, $_, 0, undef) :
+#	     c::rpmtransAvailablePackage($rpmdeps, $_->{header}, $_);
+#    }
+#    my @conflicts = c::rpmdepCheck($rpmdeps);
+#
+#    rpmtransFree($rpmdeps);
+#    rpmdbClose($db);
+#
+#    if ($fixup) {
+#	 foreach (@conflicts) {
+#	     $_->{suggestedPackage}->{selected} = 1;
+#	 }
+#	 rpmdepFreeConflicts(@conflicts);
+#    }
+#
+#    1;
+}
+
+sub selectComponents {
+    my ($csp, $psp, $doIndividual) = @_;
+
+    return 0;
+}
+
+sub psFromHeaderListDesc {
+    my ($fd, $noSeek) = @_;
+    my %packages;
+    my $end;
+
+    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";
+    }
+
+    while (1) {
+	my $header = c::headerRead(fileno($fd), 1);
+	unless ($header) {
+	    $noSeek and last;
+	    die "error reading header at offset ", sysseek($fd, 0, 1);
+	}
+	
+	my $name = c::headerGetEntry($header, 'name');
+
+	$packages{lc $name} = { 
+	    header => $header, size => c::headerGetEntry($header, 'size'),
+	    inmenu => skipPackage($name), name => $name, 
+	    group => c::headerGetEntry($header, 'group') || "(unknown group)",
+	};
+
+	$noSeek or $end <= sysseek($fd, 0, 1) and last; 
+    }
+
+    log::l("psFromHeaderListDesc read " . scalar keys(%packages) . " headers");
+    
+    \%packages;
+}
+
+sub psFromHeaderListFile {
+    my ($file) = @_;
+    local *F;
+    sysopen F, $file, 0 or die "error opening header file: $!";
+    psFromHeaderListDesc(\*F, 0);
+}
+
+sub skipPackage { member($_[0], @skipList) }
+
+sub printSize { } 
+sub printGroup { } 
+sub printPkg { } 
+sub selectPackagesByGroup { } 
+sub showPackageInfo { }
+sub queryIndividual { }
+
+
+sub install {
+    my ($rootPath, $method, $packages, $isUpgrade, $force) = @_;
+
+    my $f = "$rootPath/tmp/" . ($isUpgrade ? "upgrade" : "install") . ".log";
+    local *F;
+    open(F, "> $f") ? log::l("opened $f") : log::l("Failed to open $f. No upgrade log will be kept.");
+    my $fd = fileno(F) || log::fd() || 2;
+    c::rpmErrorSetCallback($fd);
+#    c::rpmSetVeryVerbose();
+    
+    # FIXME: we ought to read /mnt/us/lib/rpmrc if we're in the midst of an upgrade, but it's not obvious how to get RPM to do that. 
+    # if we set netshared path to "" then we get no files installed 
+    # addMacro(&globalMacroContext, "_netsharedpath", NULL, netSharedPath ? netSharedPath : "" , RMIL_RPMRC);    
+    
+    $isUpgrade ? c::rpmdbRebuild($rootPath) : c::rpmdbInit($rootPath, 0644) or die "creation/rebuilding of rpm database failed: ", c::rpmErrorString();
+
+    my $db = c::rpmdbOpen($rootPath) or die "error opening RPM database: ", c::rpmErrorString();
+    log::l("opened rpm database");
+
+    my $trans = c::rpmtransCreateSet($db, $rootPath);
+
+    my ($total, $nb);
+
+    foreach my $p ($packages->{basesystem}, 
+	     grep { $_->{selected} && $_->{name} ne "basesystem" } values %$packages) {
+	my $fullname = sprintf "%s-%s-%s.%s.rpm", 
+	                       $p->{name},
+	                       map { c::headerGetEntry($p->{header}, $_) } qw(version release arch);
+	c::rpmtransAddPackage($trans, $p->{header}, $method->getFile($fullname) , $isUpgrade);
+	$nb++;
+	$total += $p->{size};
+    }
+
+    c::rpmdepOrder($trans) or c::rpmdbClose($db), c::rpmtransFree($trans), die "error ordering package list: ", c::rpmErrorString();
+    c::rpmtransSetScriptFd($trans, $fd);
+
+    eval { fs::mount("/proc", "$rootPath/proc", "proc", 0) };
+
+    log::ld("starting installation: ", $nb, " packages, ", $total, " bytes");
+
+    # !! do not translate these messages, they are used when catched (cf install_steps_graphical)
+    my $callbackStart = sub { log::ld("starting installing package ", $_[0]) };
+    my $callbackProgress = sub { log::ld("progressing installation ", $_[0], "/", $_[1]) };
+
+    if (my @probs = c::rpmRunTransactions($trans, $callbackStart, $callbackProgress, $force)) {
+	die "installation of rpms failed:\n  ", join("\n  ", @probs);
+    }
+    c::rpmtransFree($trans); 
+    c::rpmdbClose($db);
+    log::l("rpm database closed");
+}
diff --git a/perl-install/resize_fat/Makefile b/perl-install/resize_fat/Makefile
new file mode 100644
index 000000000..34c257a4e
--- /dev/null
+++ b/perl-install/resize_fat/Makefile
@@ -0,0 +1,12 @@
+PRODUCT = libresize
+TARSOURCE = $(PRODUCT).tar.bz2
+
+.PHONY: clean tar
+
+clean:
+	rm -f *~ TAGS $(TARSOURCE)
+
+tar: clean
+	cp -f ../common.pm .
+	cd .. ; tar cfy $(TARSOURCE) $(PRODUCT) ; mv $(TARSOURCE) $(PRODUCT)
+	rm -f common.pm
diff --git a/perl-install/resize_fat/README b/perl-install/resize_fat/README
new file mode 100644
index 000000000..2910c06c3
--- /dev/null
+++ b/perl-install/resize_fat/README
@@ -0,0 +1,6 @@
+just do ./resize.pm and look at usage.
+
+
+BUGS:
+no known bugs :)
+if you found one, please mail pixel@linux-mandrake.com !!
diff --git a/perl-install/resize_fat/any.pm b/perl-install/resize_fat/any.pm
new file mode 100644
index 000000000..d78a342be
--- /dev/null
+++ b/perl-install/resize_fat/any.pm
@@ -0,0 +1,82 @@
+package resize_fat::any;
+
+use diagnostics;
+use strict;
+use vars qw($FREE $FILE $DIRECTORY);
+
+use common qw(:common :constant);
+use resize_fat::fat;
+use resize_fat::directory;
+use resize_fat::dir_entry;
+
+
+$FREE      = 0;
+$FILE      = 1;
+$DIRECTORY = 2;
+
+
+1;
+
+
+# returns the number of clusters for a given filesystem type
+sub min_cluster_count($) {
+    my ($fs) = @_;
+    (1 << $ {{ FAT16 => 12, FAT32 => 16 }}{$fs->{fs_type}}) - 12;
+}
+sub max_cluster_count($) {
+    my ($fs) = @_;
+    $resize_fat::bad_cluster_value - 2;
+}
+
+
+
+# calculates the minimum size of a partition, in physical sectors
+sub min_size($) {
+    my ($fs) = @_;
+    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
+    # moment, 2 directories are there, but that way nothing wrong can happen :)
+    my $min_cluster_count = max(2 + $count->{used} + $count->{bad} + $count->{dirs}, min_cluster_count($fs));
+
+    $min_cluster_count * divide($fs->{cluster_size}, $SECTORSIZE) + 
+	divide($fs->{cluster_offset}, $SECTORSIZE);
+}
+# calculates the maximum size of a partition, in physical sectors
+sub max_size($) {
+    my ($fs) = @_;
+
+    my $max_cluster_count = min($fs->{nb_fat_entries} - 2, max_cluster_count($fs));
+
+    $max_cluster_count * divide($fs->{cluster_size}, $SECTORSIZE) +
+	divide($fs->{cluster_offset}, $SECTORSIZE);
+}
+
+# fills in $fs->{fat_flag_map}. 
+# Each FAT entry is flagged as either FREE, FILE or DIRECTORY.
+sub flag_clusters {
+    my ($fs) = @_;
+    my ($cluster, $entry, $type);
+
+    my $f = sub {
+	($entry) = @_;
+	$cluster = resize_fat::dir_entry::get_cluster($entry);
+
+	if (resize_fat::dir_entry::is_file($entry)) {
+	    $type = $FILE;
+	} elsif (resize_fat::dir_entry::is_directory($entry)) {
+	    $type = $DIRECTORY;
+	} else { return }
+
+	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} = [ ($FREE) x ($fs->{nb_clusters} + 2) ];
+    $fs->{clusters}->{count}->{dirs} = 0;
+    resize_fat::directory::traverse_all($fs, $f);
+}
diff --git a/perl-install/resize_fat/boot_sector.pm b/perl-install/resize_fat/boot_sector.pm
new file mode 100644
index 000000000..c236b1617
--- /dev/null
+++ b/perl-install/resize_fat/boot_sector.pm
@@ -0,0 +1,106 @@
+package resize_fat::boot_sector;
+
+use diagnostics;
+use strict;
+
+use common qw(:common :system :constant);
+use resize_fat::io;
+use resize_fat::any;
+use resize_fat::directory;
+
+
+my $format = "a3 a8 S C S C S S C S S S I I I S S I S S a458 S";
+my @fields = (
+    'boot_jump',		# boot strap short or near jump
+    'system_id',		# Name - can be used to special case partition manager volumes
+    'sector_size',		# bytes per logical sector
+    'cluster_size_in_sectors',	# sectors/cluster
+    'nb_reserved',		# reserved sectors
+    'nb_fats',			# number of FATs
+    'nb_root_dir_entries',	# number of root directory entries
+    'small_nb_sectors',		# number of sectors: big_nb_sectors supersedes
+    'media',			# media code
+    'fat16_fat_length',		# sectors/FAT for FAT12/16
+    'sectors_per_track',
+    'nb_heads',
+    'nb_hidden',		# (unused)
+    'big_nb_sectors',		# number of sectors (if small_nb_sectors == 0)
+
+# FAT32-only entries
+    'fat32_fat_length',		# size of FAT in sectors
+    'fat32_flags',		# bit8: fat mirroring,
+				# low4: active fat
+    'fat32_version',		# minor * 256 + major
+    'fat32_root_dir_cluster',
+    'info_offset_in_sectors',
+    'fat32_backup_sector',
+
+# Common again...
+    'boot_code',		# Boot code (or message)
+    'boot_sign',		# 0xAA55
+);
+
+1;
+
+
+# trimfs_init_boot_sector() - reads in the boot sector - gets important info out
+# of boot sector, and puts in main structure - performs sanity checks - returns 1
+# on success, 0 on failureparameters: filesystem an empty structure to fill.
+sub read($) {
+    my ($fs) = @_;
+    
+    my $boot = eval { resize_fat::io::read($fs, 0, $SECTORSIZE) }; $@ and die "reading boot sector failed on device $fs->{fs_name}";
+    @{$fs}{@fields} = unpack $format, $boot;
+
+    $fs->{nb_sectors} = $fs->{small_nb_sectors} || $fs->{big_nb_sectors};
+    $fs->{cluster_size} = $fs->{cluster_size_in_sectors} * $fs->{sector_size}; 
+
+    $fs->{boot_sign} == 0xAA55 or die "Invalid signature for a MS-based filesystem.";
+    $fs->{nb_fats} == 2 or die "Weird number of FATs: $fs->{nb_fats}, not 2.",
+    $fs->{nb_sectors} < 32 and die "Too few sectors for viable file system\n";
+
+    if ($fs->{fat16_fat_length}) {
+	# asserting FAT16, will be verified later on
+        $fs->{fs_type} = 'FAT16';
+	$fs->{fs_type_size} = 16;
+	$fs->{fat_length} = $fs->{fat16_fat_length};
+    } else {
+	$resize_fat::isFAT32 = 1;
+        $fs->{fs_type} = 'FAT32';
+        $fs->{fs_type_size} = 32;
+	$fs->{fat_length} = $fs->{fat32_fat_length};
+
+	$fs->{nb_root_dir_entries} = 0;
+	$fs->{info_offset} = $fs->{info_offset_in_sectors} * $fs->{sector_size};
+    }
+    $resize_fat::bad_cluster_value = (1 << $fs->{fs_type_size}) - 9;
+    
+    $fs->{fat_offset} = $fs->{nb_reserved} * $fs->{sector_size};
+    $fs->{fat_size} = $fs->{fat_length} * $fs->{sector_size};
+    $fs->{root_dir_offset} = $fs->{fat_offset} + $fs->{fat_size} * $fs->{nb_fats};
+    $fs->{root_dir_size} = $fs->{nb_root_dir_entries} * resize_fat::directory::entry_size();
+    $fs->{cluster_offset} = $fs->{root_dir_offset} + $fs->{root_dir_size} - 2 * $fs->{cluster_size};
+
+    $fs->{nb_fat_entries} = divide($fs->{fat_size}, $fs->{fs_type_size} / 8);
+
+    # - 2 because clusters 0 & 1 doesn't exist 
+    $fs->{nb_clusters} = divide($fs->{nb_sectors} * $fs->{sector_size} - $fs->{cluster_offset}, $fs->{cluster_size}) - 2;
+
+    $fs->{dir_entries_per_cluster} = divide($fs->{cluster_size}, psizeof($format));
+
+    $fs->{nb_clusters} >= resize_fat::any::min_cluster_count($fs) or die "error: not enough sectors for a $fs->{fs_type}\n";
+    $fs->{nb_clusters} <  resize_fat::any::max_cluster_count($fs) or die "error: too many sectors for a $fs->{fs_type}\n";
+}
+
+sub write($) {
+    my ($fs) = @_;
+    my $boot = pack($format, @{$fs}{@fields});
+
+    eval { resize_fat::io::write($fs, 0, $SECTORSIZE, $boot) }; $@ and die "writing the boot sector failed on device $fs->{fs_name}";
+
+    if ($resize_fat::isFAT32) {
+	# write backup
+	eval { resize_fat::io::write($fs, $fs->{fat32_backup_sector} * $SECTORSIZE, $SECTORSIZE, $boot) };
+	$@ and die "writing the backup boot sector (#$fs->{fat32_backup_sector}) failed on device $fs->{fs_name}";
+    }
+}
diff --git a/perl-install/resize_fat/dir_entry.pm b/perl-install/resize_fat/dir_entry.pm
new file mode 100644
index 000000000..fa5ebb344
--- /dev/null
+++ b/perl-install/resize_fat/dir_entry.pm
@@ -0,0 +1,72 @@
+package resize_fat::dir_entry;
+
+use diagnostics;
+use strict;
+
+
+my $DELETED_FLAG      = 0xe5;
+my $VOLUME_LABEL_ATTR = 0x08;
+my $VFAT_ATTR         = 0x0f;
+my $DIRECTORY_ATTR    = 0x10;
+
+1;
+
+sub get_cluster($) {
+    my ($entry) = @_;
+    $entry->{first_cluster} + ($resize_fat::isFAT32 ? $entry->{first_cluster_high} * 65536 : 0);
+}
+sub set_cluster($$) {
+    my ($entry, $val) = @_;
+    $entry->{first_cluster} = $val & (1 << 16) - 1;
+    $entry->{first_cluster_high} = $val >> 16 if $resize_fat::isFAT32;
+}
+
+sub is_directory_raw($) {
+    my ($entry) = @_;
+    !is_special_entry($entry) && $entry->{attributes} & $DIRECTORY_ATTR;
+}
+
+sub is_directory($) {
+    my ($entry) = @_;
+    is_directory_raw($entry) && $entry->{name} !~ /^\.\.? /;
+}
+
+sub is_volume($) {
+    my ($entry) = @_;
+    !is_special_entry($entry) && $entry->{attributes} & $VOLUME_LABEL_ATTR;
+}
+
+sub is_file($) {
+    my ($entry) = @_;
+    !is_special_entry($entry) && !is_directory($entry) && !is_volume($entry) && $entry->{length};
+}
+
+
+sub is_special_entry($) {
+    my ($entry) = @_;
+    my ($c) = unpack "C", $entry->{name};
+
+    # skip empty slots, deleted files, and 0xF6?? (taken from kernel)
+    $c == 0 || $c == $DELETED_FLAG || $c == 0xF6 and return 1;
+
+    $entry->{attributes} == $VFAT_ATTR and return 1;
+    0;
+}
+
+
+# return true if entry has been modified
+sub remap {
+    my ($fat_remap, $entry) = @_;
+	
+    is_special_entry($entry) and return;
+
+    my $cluster = get_cluster($entry);
+    my $new_cluster = $fat_remap->[$cluster];
+
+    #print "remapping cluster ", get_first_cluster($fs, $entry), " to $new_cluster";
+
+    $new_cluster == $cluster and return; # no need to modify
+
+    set_cluster($entry, $new_cluster);
+    1;
+}
diff --git a/perl-install/resize_fat/directory.pm b/perl-install/resize_fat/directory.pm
new file mode 100644
index 000000000..ab8ec5328
--- /dev/null
+++ b/perl-install/resize_fat/directory.pm
@@ -0,0 +1,78 @@
+package resize_fat::directory;
+
+use diagnostics;
+use strict;
+
+use common qw(:system);
+use resize_fat::dir_entry;
+use resize_fat::io;
+
+
+my $format = "a8 a3 C C C S7 I";
+my @fields = (
+    'name',
+    'extension',
+    'attributes',
+    'is_upper_case_name',
+    'creation_time_low',	# milliseconds
+    'creation_time_high',
+    'creation_date',
+    'access_date',
+    'first_cluster_high',	# for FAT32
+    'time',
+    'date',
+    'first_cluster',
+    'length',
+);
+
+1;
+
+sub entry_size { psizeof($format) }
+
+# call `f' for each entry of the directory
+# if f return true, then modification in the entry are taken back
+sub traverse($$$) {
+    my ($fs, $directory, $f) = @_;
+
+    for (my $i = 0; 1; $i++) {
+	my $raw = \substr($directory, $i * psizeof($format), psizeof($format));
+
+	# empty entry means end of directory
+	$$raw =~ /^\0*$/ and return $directory;
+
+	my $entry; @{$entry}{@fields} = unpack $format, $$raw;
+
+	&$f($entry) 
+	    and	$$raw = pack $format, @{$entry}{@fields};
+    }
+    $directory;
+}
+
+sub traverse_all($$) {
+    my ($fs, $f) = @_;
+
+    my $traverse_all; $traverse_all = sub {
+	my ($entry) = @_;
+
+	&$f($entry);
+
+        resize_fat::dir_entry::is_directory($entry) 
+	    and traverse($fs, resize_fat::io::read_file($fs, resize_fat::dir_entry::get_cluster($entry)), $traverse_all);
+
+	undef; # no need to write back (cf traverse)
+    };
+
+    my $directory = $resize_fat::isFAT32 ?
+	resize_fat::io::read_file($fs, $fs->{fat32_root_dir_cluster}) :
+	resize_fat::io::read($fs, $fs->{root_dir_offset}, $fs->{root_dir_size});
+    traverse($fs, $directory, $traverse_all);
+}
+
+
+# function used by construct_dir_tree to translate the `cluster' fields in each
+# directory entry
+sub remap {
+    my ($fs, $directory) = @_;
+
+    traverse($fs->{fat_remap}, $directory, sub { resize_fat::dir_entry::remap($fs->{fat_remap}, $_[0]) });
+}
diff --git a/perl-install/resize_fat/fat.pm b/perl-install/resize_fat/fat.pm
new file mode 100644
index 000000000..2b64bd6f7
--- /dev/null
+++ b/perl-install/resize_fat/fat.pm
@@ -0,0 +1,167 @@
+package resize_fat::fat;
+
+use diagnostics;
+use strict;
+
+use resize_fat::any;
+use resize_fat::io;
+
+1;
+
+sub read($) {
+    my ($fs) = @_;
+
+    @{$fs->{fats}} = map {
+	my $fat = eval { resize_fat::io::read($fs, $fs->{fat_offset} + $_ * $fs->{fat_size}, $fs->{fat_size}) };
+	$@ and die "reading fat #$_ failed";
+	vec($fat, 0, 8) == $fs->{media} or die "FAT $_ has invalid signature";
+	$fat;
+    } (0 .. $fs->{nb_fats} - 1);
+
+    $fs->{fat} = $fs->{fats}->[0];
+
+    my ($free, $bad, $used) = (0, 0, 0);
+
+    for (my $i = 2; $i < $fs->{nb_clusters} + 2; $i++) {
+	my $cluster = &next($fs, $i);
+	if ($cluster == 0) { $free++; }
+	elsif ($cluster == $resize_fat::bad_cluster_value) { $bad++; }
+	else { $used++; }
+    }
+    @{$fs->{clusters}->{count}}{qw(free bad used)} = ($free, $bad, $used);
+}
+
+sub write($) {
+    my ($fs) = @_;
+
+    sysseek $fs->{fd}, $fs->{fat_offset}, 0 or die "write_fat: seek failed";
+    foreach (1..$fs->{nb_fats}) {
+	syswrite $fs->{fd}, $fs->{fat}, $fs->{fat_size} or die "write_fat: write failed";
+    }
+}
+
+
+
+# allocates where all the clusters will be moved to. Clusters before cut_point
+# remain in the same position, however cluster that are part of a directory are
+# moved regardless (this is a mechanism to prevent data loss) (cut_point is the
+# first cluster that won't occur in the new fs)
+sub allocate_remap {
+    my ($fs, $cut_point) = @_;
+    my ($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";
+	set_eof($fs, $new_cluster); # mark as used
+	#log::ld("resize_fat: [$cluster,", &next($fs, $cluster), "...]->$new_cluster...");
+    };
+
+    $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) {
+		&$get_new();
+	    } else {
+		$new_cluster = $cluster;
+	    }
+	    &$remap();
+	} elsif (!is_empty(&next($fs, $cluster))) {
+	    &$get_new();
+	    &$remap();
+	 }
+    }
+}
+
+
+# updates the fat for the resized filesystem
+sub update {
+    my ($fs) = @_;
+
+    for (my $cluster = 2; $cluster < $fs->{nb_clusters} + 2; $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];
+
+	     set_available($fs, $cluster);
+
+	     is_eof($old_next) ?
+		 set_eof($fs, $new) :
+		 set_next($fs, $new, $new_next);
+	 }
+    }
+}
+
+
+# - compares the two FATs (one's a backup that should match) - skips first entry
+# - its just a signature (already checked above) NOTE: checks for cross-linking
+# are done in count.c
+sub check($) {
+    my ($fs) = @_;
+    foreach (@{$fs->{fats}}) {
+	$_ eq $fs->{fats}->[0] or die "FAT tables do not match";
+    }
+}
+
+sub endianness16($) { (($_[0] & 0xff) << 8) + ($_[0] >> 8); }
+sub endianness($$) {
+    my ($val, $nb_bits) = @_;
+    my $r = 0;
+    for (; $nb_bits > 0; $nb_bits -= 8) {
+	$r <<= 8;
+	$r += $val & 0xff;
+	$val >>= 8;
+    }
+    $nb_bits < 0 and die "error: endianness only handle numbers divisible by 8";
+    $r;
+}
+
+sub next($$) {
+    my ($fs, $cluster) = @_;
+    $cluster > $fs->{nb_clusters} + 2 and die "fat::next: cluster $cluster outside filesystem";
+    endianness(vec($fs->{fat}, $cluster, $fs->{fs_type_size}), $fs->{fs_type_size});
+
+}
+sub set_next($$$) { 
+    my ($fs, $cluster, $new_v) = @_;
+    $cluster > $fs->{nb_clusters} + 2 and die "fat::set_next: cluster $cluster outside filesystem";
+    vec($fs->{fat}, $cluster, $fs->{fs_type_size}) = endianness($new_v, $fs->{fs_type_size});
+}
+
+
+sub get_free($) {
+    my ($fs) = @_;
+    foreach (my $i = 0; $i < $fs->{nb_clusters}; $i++) {
+        my $cluster = ($i + $fs->{last_free_cluster} - 2) % $fs->{nb_clusters} + 2;
+        is_available(&next($fs, $cluster)) and return $fs->{last_free_cluster} = $cluster;
+    }
+    die "no free clusters";
+}
+
+#    returns true if <cluster> represents an EOF marker
+sub is_eof($) {
+    my ($cluster) = @_;
+    $cluster >= $resize_fat::bad_cluster_value;
+}
+sub set_eof($$) {
+    my ($fs, $cluster) = @_;
+    set_next($fs, $cluster, $resize_fat::bad_cluster_value + 1);
+}
+
+#    returns true if <cluster> is empty.  Note that this includes bad clusters.
+sub is_empty($) {
+    my ($cluster) = @_;
+    $cluster == 0 || $cluster == $resize_fat::bad_cluster_value;
+}
+
+#    returns true if <cluster> is available.
+sub is_available($) {
+    my ($cluster) = @_;
+    $cluster == 0;
+}
+sub set_available($$) {
+    my ($fs, $cluster) = @_;
+    set_next($fs, $cluster, 0);
+}
diff --git a/perl-install/resize_fat/info_sector.pm b/perl-install/resize_fat/info_sector.pm
new file mode 100644
index 000000000..c46ae15fc
--- /dev/null
+++ b/perl-install/resize_fat/info_sector.pm
@@ -0,0 +1,36 @@
+package resize_fat::info_sector;
+
+use diagnostics;
+use strict;
+
+use common qw(:system);
+use resize_fat::io;
+
+my $format = "a484 I I I a16";
+my @fields = (
+    'unused',
+    'signature',		# should be 0x61417272
+    'free_clusters',		# -1 for unknown
+    'next_cluster',		# most recently allocated cluster
+    'unused2',
+);
+
+1;
+
+
+sub read($) {
+    my ($fs) = @_;
+    my $info = resize_fat::io::read($fs, $fs->{offset}, psizeof($format));
+    @{$fs->{info_sector}}{@fields} = unpack $format, $info;
+    $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;
+
+    my $info = pack $format, @{$fs->{info_sector}}{@fields};
+
+    resize_fat::io::write($fs, $fs->{info_offset}, psizeof($format), $info);
+}
diff --git a/perl-install/resize_fat/io.pm b/perl-install/resize_fat/io.pm
new file mode 100644
index 000000000..8ffaa8355
--- /dev/null
+++ b/perl-install/resize_fat/io.pm
@@ -0,0 +1,74 @@
+package resize_fat::io;
+
+use diagnostics;
+use strict;
+
+use resize_fat::fat;
+
+1;
+
+
+sub read($$$) {
+    my ($fs, $pos, $size) = @_;
+    my $buf;
+    sysseek $fs->{fd}, $pos, 0 or die "seeking to byte #$pos failed on device $fs->{fs_name}";
+    sysread $fs->{fd}, $buf, $size or die "reading at byte #$pos failed on device $fs->{fs_name}";
+    $buf;
+}
+sub write($$$$) {
+    my ($fs, $pos, $size, $buf) = @_;
+    sysseek $fs->{fd}, $pos, 0 or die "seeking to byte #$pos failed on device $fs->{fs_name}";
+    syswrite $fs->{fd}, $buf, $size or die "writing at byte #$pos failed on device $fs->{fs_name}";
+}
+
+sub read_cluster($$) {
+    my ($fs, $cluster) = @_;
+    my $buf;
+
+    eval {
+	$buf = &read($fs, 
+		     $fs->{cluster_offset} + $cluster * $fs->{cluster_size},
+		     $fs->{cluster_size});
+    }; @$ and die "reading cluster #$cluster failed on device $fs->{fs_name}";
+    $buf;
+}
+sub write_cluster($$$) {
+    my ($fs, $cluster, $buf) = @_;
+
+    eval {
+    &write($fs, 
+	   $fs->{cluster_offset} + $cluster * $fs->{cluster_size},
+	   $fs->{cluster_size}, 
+	   $buf);
+    }; @$ and die "writing cluster #$cluster failed on device $fs->{fs_name}";
+}
+
+sub read_file($$) {
+    my ($fs, $cluster) = @_;
+    my $buf = '';
+
+    for (; !resize_fat::fat::is_eof($cluster); $cluster = resize_fat::fat::next($fs, $cluster)) {
+	$cluster == 0 and die "Bad FAT: unterminated chain\n";
+	$buf .= read_cluster($fs, $cluster);
+    }
+    $buf;
+}
+
+sub check_mounted($) {
+    my ($f) = @_;
+
+    local *F;
+    open F, "/proc/mounts" or die "error opening /proc/mounts\n";
+    foreach (<F>) {
+	/^$f\s/ and die "device is mounted";
+    }
+}
+
+sub open($) {
+    my ($fs) = @_;
+
+    check_mounted($fs->{device});
+
+    sysopen F, $fs->{fs_name}, 2 or sysopen F, $fs->{fs_name}, 0 or die "error opening device $fs->{fs_name} for writing\n";
+    $fs->{fd} = \*F;
+}
diff --git a/perl-install/resize_fat/main.pm b/perl-install/resize_fat/main.pm
new file mode 100644
index 000000000..2d5f4f969
--- /dev/null
+++ b/perl-install/resize_fat/main.pm
@@ -0,0 +1,152 @@
+#!/usr/bin/perl
+
+package resize_fat::main;
+
+use diagnostics;
+use strict;
+
+use log;
+use common qw(:common :system :constant);
+use resize_fat::boot_sector;
+use resize_fat::info_sector;
+use resize_fat::directory;
+use resize_fat::io;
+use resize_fat::fat;
+use resize_fat::any;
+
+
+#@ARGV == 2 or die "usage: fatresize <device> <size>\n  <size> = 100 means `resize to 100Mb'\n  <size> = +10 means `keep 10Mb of free space'\n";
+#
+#my $fs = init($ARGV[0]);
+#resize($fs, $ARGV[1]);
+
+1;
+
+# - reads in the boot sector/partition info., and tries to make some sense of it
+sub new($$$) {
+    my ($type, $device, $fs_name) = @_;
+    my $fs = { device => $device, fs_name => $fs_name } ;
+
+    resize_fat::io::open($fs);
+    resize_fat::boot_sector::read($fs);
+    $resize_fat::isFAT32 and eval { resize_fat::info_sector::read($fs) };
+    resize_fat::fat::read($fs);
+    resize_fat::fat::check($fs);
+    resize_fat::any::flag_clusters($fs);
+
+    bless $fs, $type;
+}
+
+# copy all clusters >= <start_cluster> to a new place on the partition, less
+# than <start_cluster>. Only copies files, not directories.
+# (use of buffer needed because the seeks slow like hell the hard drive)
+sub copy_clusters {
+    my ($fs, $cluster) = @_;
+    my @buffer;
+    my $flush = sub { 
+	while (@buffer) { 
+	    my $cluster = shift @buffer;
+	    resize_fat::io::write_cluster($fs, $cluster, shift @buffer);
+	}
+    };
+    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);
+	@buffer > 50 and &$flush();
+    }
+    &$flush();
+}
+
+# Constructs the new directory tree to match the new file locations.
+sub construct_dir_tree {
+    my ($fs) = @_;
+
+    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;
+    }
+
+    for (my $cluster = 2; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
+	$fs->{fat_flag_map}->[$cluster] == $resize_fat::any::DIRECTORY or next;
+
+      resize_fat::io::write_cluster($fs, 
+				    $fs->{fat_remap}->[$cluster], 
+				  resize_fat::directory::remap($fs, resize_fat::io::read_cluster($fs, $cluster)));
+    }
+
+    sync();
+
+    # until now, only free clusters have been written. it's a null operation if we stop here.
+    # it means no corruption :)
+    #
+    # now we must be as fast as possible!
+
+    # remapping non movable root directory
+    if ($resize_fat::isFAT32) {
+	my $cluster = $fs->{fat32_root_dir_cluster};
+
+	resize_fat::io::write_cluster($fs, 
+		      $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},
+			      resize_fat::directory::remap($fs, resize_fat::io::read($fs, $fs->{root_dir_offset}, $fs->{root_dir_size})));
+    }
+}
+
+sub min_size($) { &resize_fat::any::min_size }
+sub max_size($) { &resize_fat::any::max_size }
+
+# resize
+# - size is in sectors
+# - checks boundaries before starting 
+# - copies all data beyond new_cluster_count behind the frontier
+sub resize {
+    my ($fs, $size) = @_;
+
+    my ($min, $max) = (min_size($fs), max_size($fs));
+
+
+    $size += $min if $size =~ /^\+/;
+
+    $size >= $min or die "Minimum filesystem size is $min sectors";
+    $size <= $max or die "Maximum filesystem size is $max sectors";
+
+    log::l("resize_fat: Partition size fill be ", $size * $SECTORSIZE >> 20, "Mb (well exactly ${size} sectors)");
+
+    my $new_data_size = $size * $SECTORSIZE - $fs->{cluster_offset};
+    my $new_nb_clusters = divide($new_data_size, $fs->{cluster_size});
+
+    log::l("resize_fat: Allocating new clusters");
+    resize_fat::fat::allocate_remap($fs, $new_nb_clusters);
+
+    log::l("resize_fat: Copying files"); 
+    copy_clusters($fs, $new_nb_clusters);
+
+    log::l("resize_fat: Copying directories");
+    construct_dir_tree($fs);
+
+    log::l("Writing new FAT...");
+    resize_fat::fat::update($fs);
+    resize_fat::fat::write($fs);
+
+    $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};
+
+    $fs->{system_id} = 'was here!';
+    $fs->{small_nb_sectors} = 0;
+    $fs->{big_nb_sectors} = $size;
+
+    log::l("resize_fat: Writing new boot sector...");
+
+    resize_fat::boot_sector::write($fs);
+
+    $resize_fat::isFAT32 and eval { resize_fat::info_sector::write($fs) }; # doesn't matter if this fails - its pretty useless!
+
+    sync();
+    log::l("resize_fat: done");
+}
+
diff --git a/perl-install/run_program.pm b/perl-install/run_program.pm
new file mode 100644
index 000000000..e4f2a7ef8
--- /dev/null
+++ b/perl-install/run_program.pm
@@ -0,0 +1,30 @@
+package run_program;
+
+use diagnostics;
+use strict;
+
+use log;
+
+1;
+
+sub run($@) { rooted('', @_) }
+
+sub rooted($$@) {
+    my ($root, $name, @args) = @_;
+
+    log::l("running: $name @args" . ($root ? " with root $root" : ""));
+    $root ? $root .= '/' : ($root = '');
+
+    fork and wait, return $? == 0;
+    {
+	open STDIN, "/dev/null" or die "can't open /dev/null as stdin";
+
+	open STDERR, ">> /dev/tty5" or open STDERR, ">> /tmp/exec.log" or die "runProgramRoot can't log :(";
+	open STDOUT, ">> /dev/tty5" or open STDOUT, ">> /tmp/exec.log" or die "runProgramRoot can't log :(";
+
+	$root and chroot $root;
+	chdir "/";
+
+	exec $name, @args or log::l("exec of $name failed: $!"), exit(-1);
+    }
+}
diff --git a/perl-install/share/diskdrake.rc b/perl-install/share/diskdrake.rc
new file mode 100644
index 000000000..ffbf762b1
--- /dev/null
+++ b/perl-install/share/diskdrake.rc
@@ -0,0 +1,39 @@
+binding "bind"
+{
+  bind "m" {
+     "clicked" ("Mount")
+  }
+}
+
+style "font"
+{
+  font = "-adobe-helvetica-medium-r-normal--*-80-*-*-*-*-*-*"
+}
+
+
+
+style "red" = "font"
+{
+  bg[NORMAL] = { 1.0, 0, 0 }
+  bg[PRELIGHT] = { 0.9, 0, 0 }
+}
+style "green" = "font"
+{
+  bg[NORMAL] = { 0, 1.0, 0 }
+  bg[PRELIGHT] = { 0, 0.9, 0 }
+}
+style "blue" = "font"
+{
+  bg[NORMAL] = { 0, 0, 1.0 }
+  bg[PRELIGHT] = { 0, 0, 0.9 }
+}
+style "white" = "font"
+{
+  bg[NORMAL] = { 1.0, 1.0, 1.0 }
+}
+
+widget "*PART_*" binding "bind"
+widget "*Linux*" style "red" 
+widget "*Linux swap" style "green"
+widget "*DOS*" style "blue"
+widget "*Empty*" style "white"
diff --git a/perl-install/swap.pm b/perl-install/swap.pm
new file mode 100644
index 000000000..675c521a7
--- /dev/null
+++ b/perl-install/swap.pm
@@ -0,0 +1,136 @@
+package swap;
+
+use diagnostics;
+use strict;
+
+use common qw(:common :system :constant);
+use log;
+use devices;
+use c;
+
+
+my $pagesize = c::getpagesize();
+my $signature_page = "\0" x $pagesize;
+
+# Maximum allowable number of pages in one swap.
+# From 2.2.0 onwards, this depends on how many offset bits
+# the architectures can actually store into the page tables
+# and on 32bit architectures it is limited to 2GB at the
+# same time.
+# Old swap format keeps the limit of 8*pagesize*(pagesize - 10) 
+
+my $V0_MAX_PAGES = 8 * $pagesize - 10;
+my $V1_OLD_MAX_PAGES = int 0x7fffffff / $pagesize - 1;
+my $V1_MAX_PAGES = $V1_OLD_MAX_PAGES; # (1 << 24) - 1;
+my $MAX_BADPAGES = int ($pagesize - 1024 - 128 * $common::sizeof_int - 10) / $common::sizeof_int;
+my $signature_format_v1 = "x1024 I I I I125"; # bootbits, version, last_page, nr_badpages, padding
+
+1;
+
+sub kernel_greater_or_equal($$$) {
+    c::kernel_version() =~ /(\d*)\.(\d*)\.(\d*)/;
+    ($1 <=> $_[0] || $2 <=> $_[1] || $3 <=> $_[2]) >= 0;
+}
+
+sub check_blocks {
+    my ($fd, $version, $nbpages) = @_;
+    my ($last_read_ok, $badpages) = (0, 0);
+    my ($buffer);
+    my $badpages_field_v1 = \substr($signature_page, psizeof($signature_format_v1));
+
+    for (my $i = 0; $i < $nbpages; $i++) {
+	
+	$last_read_ok || sysseek($fd, $i * $pagesize, 0) or die "seek failed";
+
+	unless ($last_read_ok = sysread($fd, $buffer, $pagesize)) {
+	    if ($version == 1) {
+		$badpages == $MAX_BADPAGES and die "too many bad pages";
+		vec($$badpages_field_v1, $badpages, $bitof_int) = $i;
+	    }
+	    $badpages++;
+	}
+	vec($signature_page, $i, 1) = bool($last_read_ok) if $version == 0;
+    }
+
+    # TODO: add interface
+    
+    $badpages and log::l("$badpages bad pages\n");
+    return $badpages;
+}
+
+sub make($;$) {
+    my ($devicename, $checkBlocks) = @_;
+    my $tmpdev = 0;
+    my $badpages = 0;
+    my ($version, $maxpages);
+
+    $devicename or die "nowhere to set up swap on?";
+    $::testing and return;
+
+    $devicename = devices::make($devicename);
+
+    my $nbpages = divide(devices::size($devicename), $pagesize);
+
+    if ($nbpages <= $V0_MAX_PAGES || kernel_greater_or_equal(2,1,117) || $pagesize < 2048) {
+	$version = 0;
+    } else {
+	$version = 1;
+    }
+
+    $nbpages >= 10 or die "swap area needs to be at least " . 10 * $pagesize >> 10 . "kB";
+
+    -b $devicename or $checkBlocks = 0;
+    my $rdev = (stat $devicename)[6];# or log::l("stat of $devicename failed: $!");
+    $rdev == 0x300 || $rdev == 0x340 and die "$devicename is not a good device for swap";
+
+    sysopen F, $devicename, 2 or die "opening $devicename for writing failed: $!";
+
+    if ($version == 0) { $maxpages = $V0_MAX_PAGES; }
+    elsif (kernel_greater_or_equal(2,2,1)) { $maxpages = $V1_MAX_PAGES; }
+    else { $maxpages = min($V1_OLD_MAX_PAGES, $V1_MAX_PAGES); }
+
+    if ($nbpages > $maxpages) {
+	$nbpages = $maxpages;
+	log::l("warning: truncating swap area to " . ($nbpages * $pagesize >> 10) . "kB");
+    }
+
+    if ($checkBlocks) {
+	$badpages = check_blocks(\*F, $version, $nbpages);
+    } elsif ($version == 0) {
+	for (my $i = 0; $i < $nbpages; $i++) { vec($signature_page, $i, 1) = 1; }
+    }
+	
+    $version == 0 and !vec($signature_page, 0, 1) and die "bad block on first page";
+    vec($signature_page, 0, 1) = 0;
+
+    $version == 1 and strcpy($signature_page, pack($signature_format_v1, $version, $nbpages - 1, $badpages));
+
+    my $goodpages = $nbpages - $badpages - 1;
+    $goodpages > 0 or die "all blocks are bad";
+
+    log::l("Setting up swapspace on $devicename version $version, size = " . $goodpages * $pagesize . " bytes");
+    
+    strcpy($signature_page, $version == 0 ? "SWAP-SPACE" : "SWAPSPACE2", $pagesize - 10);
+
+    my $offset = ($version == 0) ? 0 : 1024;
+    sysseek(F, $offset, 0) or die "unable to rewind swap-device: $!";
+
+    syswrite(F, substr($signature_page, $offset)) or die "unable to write signature page: $!";
+
+    # A subsequent swapon() will fail if the signature is not actually on disk. (This is a kernel bug.)
+    syscall_('fsync', fileno(F)) or die "fsync failed: $!";
+    close F;
+}
+
+sub enable($;$) {
+    my ($devicename, $checkBlocks) = @_;
+    make($devicename, $checkBlocks);
+    swapon($devicename);
+}
+
+sub swapon($) {
+    syscall_('swapon', devices::make($_[0]), 0) or die "swapon($_[0]) failed: $!";
+}
+sub swapoff($) {
+    syscall_('swapoff', devices::make($_[0])) or die "swapoff($_[0]) failed: $!"; 
+}
diff --git a/perl-install/unused/cdrom.pm b/perl-install/unused/cdrom.pm
new file mode 100644
index 000000000..46bb4fc3f
--- /dev/null
+++ b/perl-install/unused/cdrom.pm
@@ -0,0 +1,41 @@
+package cdrom;
+
+use diagnostics;
+use strict;
+
+use detect_devices;
+
+
+my %transTable = ( cm206 => 'cm206cd', sonycd535 => 'cdu535');
+
+1;
+
+
+sub setupCDdevicePanel {
+    my ($type) = @_;
+}
+
+sub findAtapi {
+    my $ide = ideGetDevices();
+    foreach (@$ide) { $_->{type} eq 'cdrom' and return $_->{device} }
+    error();
+}
+
+sub findSCSIcdrom {
+    detect_devices::isSCSI() or return error();
+    my $scsi = detect_devices::getSCSI();
+    foreach (@$scsi) { $_->{type} eq 'cdrom' and return $_->{device} }
+    error();
+}
+
+sub setupCDdevice {
+    my ($cddev, $dl) = @_;
+    #TODO
+}
+
+sub removeCDmodule {
+    # this wil fail silently if no CD module has been loaded 
+    removeDeviceDriver('cdrom');
+    1;
+}
+
diff --git a/perl-install/unused/dns.pm b/perl-install/unused/dns.pm
new file mode 100644
index 000000000..baad57f9e
--- /dev/null
+++ b/perl-install/unused/dns.pm
@@ -0,0 +1,64 @@
+use diagnostics;
+use strict;
+
+# This is dumb, but glibc doesn't like to do hostname lookups w/o libc.so 
+
+
+#TODO TODO
+sub doQuery {
+#    my ($query, $queryType, $domainName, $ipNum) = @_;
+#
+#    _res.retry = 2;
+#
+#    len = res_search(query, C_IN, queryType, (void *) &response, 
+#		     sizeof(response));
+#    if (len <= 0) return -1;
+#
+#    if (ntohs(response.hdr.rcode) != NOERROR) return -1;
+#    ancount = ntohs(response.hdr.ancount);
+#    if (ancount < 1) return -1;
+#
+#    data = response.buf + sizeof(HEADER);
+#    end = response.buf + len;
+#    
+#    # skip the question 
+#    data += dn_skipname(data, end) + QFIXEDSZ;
+#
+#    # parse the answer(s) 
+#    while (--ancount >= 0 && data < end) {
+#
+#      # skip the domain name portion of the RR record 
+#      data += dn_skipname(data, end);
+#
+#      # get RR information 
+#      GETSHORT(type, data);
+#      data += INT16SZ; # skipp class 
+#      data += INT32SZ; # skipp TTL 
+#      GETSHORT(len,  data);
+#
+#      if (type == T_PTR) {
+#	 # we got a pointer 
+#	 len = dn_expand(response.buf, end, data, name, sizeof(name));
+#	 if (len <= 0) return -1;
+#	 if (queryType == T_PTR && domainName) {
+#	   # we wanted a pointer 
+#	   *domainName = malloc(strlen(name) + 1);
+#	   strcpy(*domainName, name);
+#	   return 0;
+#	 }
+#      } else if (type == T_A) {
+#	 # we got an address 
+#	 if (queryType == T_A && ipNum) {
+#	   # we wanted an address 
+#	   memcpy(ipNum, data, sizeof(*ipNum));
+#	   return 0;
+#	 }
+#      }
+#
+#      # move ahead to next RR 
+#      data += len;
+#    } 
+#
+#    return -1;
+}
+
diff --git a/perl-install/unused/otherinsmod.pm b/perl-install/unused/otherinsmod.pm
new file mode 100644
index 000000000..fb62ff945
--- /dev/null
+++ b/perl-install/unused/otherinsmod.pm
@@ -0,0 +1,26 @@
+use diagnostics;
+use strict;
+
+sub insmod {
+
+    @_ or die "usage: insmod <module>.o [params]\n";
+
+    my $file = shift;
+    my $tmpname;
+
+    unless (-r $file) {
+	local *F;
+	open F, "/modules/modules.cgz" or die "error opening /modules/modules.cgz";
+
+	$tmpname = "/tmp/" . basename($file);
+
+	installCpioFile(\*F, $file, $tmpname, 0) or die "error extracting file";
+    }
+
+    my $rc = insmod_main($tmpname || $file, @_);
+   
+    unlink($tmpname);
+
+    return $rc;
+}
+sub modprobe { &insmod }
diff --git a/perl-install/unused/scsi.pm b/perl-install/unused/scsi.pm
new file mode 100644
index 000000000..77fe8fe44
--- /dev/null
+++ b/perl-install/unused/scsi.pm
@@ -0,0 +1,104 @@
+use diagnostics;
+use strict;
+
+my $scsiDeviceAvailable;
+my $CSADeviceAvailable;
+
+1;
+
+sub scsiDeviceAvailable {
+    defined $scsiDeviceAvailable and return $scsiDeviceAvailable;
+    local *F;
+    open F, "/proc/scsi/scsi" or log::l("failed to open /proc/scsi/scsi: $!"), return 0;
+    foreach (<F>) {
+	/devices: none/ and log::l("no scsi devices are available"), return $scsiDeviceAvailable = 0;
+    }
+    log::l("scsi devices are available");
+    $scsiDeviceAvailable = 1;
+}
+
+sub CompaqSmartArrayDeviceAvailable {
+    defined $CSADeviceAvailable and return $CSADeviceAvailable;
+    -r "/proc/array/ida0" or log::l("failed to open /proc/array/ida0: $!"), return $CSADeviceAvailable = 0;
+    log::l("Compaq Smart Array controllers available");
+    $CSADeviceAvailable = 1;
+}
+
+sub scsiGetDevices {
+    my @drives;
+    my ($driveNum, $cdromNum, $tapeNum) = qw(0 0 0);
+    my $err = sub { chop; log::l("unexpected line in /proc/scsi/scsi: $_"); error() };
+    local $_;
+
+    local *F;
+    open F, "/proc/scsi/scsi" or return &$err();
+    $_ = <F>; /^Attached devices:/ or return &$err();
+    while ($_ = <F>) {
+	my ($id) = /^Host:.*?Id: (\d+)/ or return &$err();
+	$_ = <F>; my ($vendor, $model) = /^\s*Vendor:\s*(.*?)\s+Model:\s*(.*?)\s+Rev:/ or return &$err();
+	$_ = <F>; my ($type) = /^\s*Type:\s*(.*)/ or &$err();
+	my $device;
+	if ($type =~ /Direct-Access/) {
+	    $type = 'hd';
+	    $device = "sd" . chr($driveNum++ + ord('a'));
+	} elsif ($type =~ /Sequential-Access/) {
+	    $type = 'tape';
+	    $device = "st" . $tapeNum++;
+	} elsif ($type =~ /CD-ROM/) {
+	    $type = 'cdrom';
+	    $device = "scd" . $cdromNum++;
+	}
+	$device and push @drives, { device => $device, type => $type, info => "$vendor $model", id => $id, bus => 0 };
+    }
+    [ @drives ];
+}
+
+sub ideGetDevices {
+    my @idi;
+
+    -r "/proc/ide" or die "sorry, /proc/ide not available, seems like you have a pre-2.2 kernel\n => not handled yet :(";
+
+    # Great. 2.2 kernel, things are much easier and less error prone. 
+    foreach my $d (glob_('/proc/ide/hd*')) {
+	my ($t) = chop_(cat_("$d/media"));
+	my $type = $ {{disk => 'hd', cdrom => 'cdrom', tape => 'tape', floppy => 'fd'}}{$t} or next;
+	my ($info) = chop_(cat_("$d/model")); $info ||= "(none)";
+
+	my $num = ord (($d =~ /(.)$/)[0]) - ord 'a';
+	push @idi, { type => $type, device => basename($d), info => $info, bus => $num/2, id => $num%2 };
+    }
+    [ @idi ];
+}
+
+
+sub CompaqSmartArrayGetDevices {
+    my @idi;
+    my $f;
+
+    for (my $i = 0; -r ($f = "/proc/array/ida$i"); $i++) {
+	local *F;
+	open F, $f or die;
+	local $_ = <F>;
+	my ($name) = m|ida/(.*?):| or next;
+	push @idi, { device => $name, info => "Compaq RAID logical disk", type => 'hd' };
+    }
+    [ @idi ];
+}
+
+sub dac960GetDevices {
+    my @idi;
+    my $file = "/var/log/dmesg";
+    -r $file or $file = "/tmp/syslog";
+
+    local *F;
+    open F, $file or die "Failed to open $file: $!";
+
+    # We are looking for lines of this format:DAC960#0:
+    # /dev/rd/c0d0: RAID-7, Online, 17928192 blocks, Write Thru0123456790123456789012    
+    foreach (<F>) {
+	my ($devicename, $info) = m|/dev/rd/(.*?): (.*?),| or next;
+	push @idi, { info => $info, type => 'hd', devicename => $devicename }; 
+	log::l("DAC960: $devicename: $info");
+    }
+    [ @idi ];
+}
diff --git a/perl-install/verify_c b/perl-install/verify_c
new file mode 100755
index 000000000..a306348dd
--- /dev/null
+++ b/perl-install/verify_c
@@ -0,0 +1,14 @@
+#!/usr/bin/perl -n
+
+/^#/ and next;
+/c::(\w+)/ and push @c, [ $1, $ARGV, $. ] ;
+
+eof && close ARGV;
+
+END {
+    $_ = join '', `cat c/c.xs.pm`; 
+    foreach $c (@c) {
+	/$c->[0]/ or $err = print "$c->[1]:$c->[2]: $c->[0] not in c.xs\n";
+    }
+    exit $err;
+}