create branch 2007.1 from drakx-installer-* tarballs

(needed after the big svn loss)

16 files changed, 2622 insertions, 0 deletions

diff --git a/perl-install/fs/any.pm b/perl-install/fs/any.pm
new file mode 100644
index 000000000..53e526ba1
--- /dev/null
+++ b/perl-install/fs/any.pm
@@ -0,0 +1,66 @@
+package fs::any; # $Id$
+
+use diagnostics;
+use strict;
+
+use common;
+use fsedit;
+use fs::mount_point;
+
+sub get_hds {
+    my ($all_hds, $fstab, $manual_fstab, $partitioning_flags, $skip_mtab, $o_in) = @_;
+
+    my $probed_all_hds = fsedit::get_hds($partitioning_flags, $o_in);
+    my $hds = $probed_all_hds->{hds};
+
+    if (is_empty_array_ref($hds) && !$::move) { #- no way
+	die N("An error occurred - no valid devices were found on which to create new filesystems. Please check your hardware for the cause of this problem");
+    }
+
+    #- try to figure out if the same number of hds is available, use them if ok.
+    @{$all_hds->{hds} || []} == @$hds and return 1;
+
+    fs::get_raw_hds('', $probed_all_hds);
+    fs::add2all_hds($probed_all_hds, @$manual_fstab);
+
+    %$all_hds = %$probed_all_hds;
+    @$fstab = fs::get::really_all_fstab($all_hds);
+
+    if (!$skip_mtab) {
+        #- do not mount the windows partition
+        fs::merge_info_from_mtab($fstab);
+        fs::mount_point::suggest_mount_points_always($fstab);
+    }
+
+    1;
+}
+
+sub write_hds {
+    my ($all_hds, $fstab, $set_mount_defaults, $on_reboot_needed, $opts) = @_;
+    if (!$::testing) {
+	my $hds = $all_hds->{hds};
+	partition_table::write($_) foreach @$hds;
+	$_->{rebootNeeded} and $on_reboot_needed->() foreach @$hds;
+    }
+
+    fs::set_removable_mntpoints($all_hds);
+    fs::mount_options::set_all_default($all_hds, %$opts, lang::fs_options($opts->{locale}))
+	if $set_mount_defaults;
+
+    @$fstab = fs::get::fstab($all_hds);
+}
+
+sub check_hds_boot_and_root {
+    my ($all_hds, $fstab) = @_;
+    fs::get::root_($fstab) or die "Oops, no root partition";
+
+    if (arch() =~ /ppc/ && detect_devices::get_mac_generation() =~ /NewWorld/) {
+	die "Need bootstrap partition to boot system!" if !(defined $partition_table::mac::bootstrap_part);
+    }
+
+    if (arch() =~ /ia64/ && !fs::get::has_mntpoint("/boot/efi", $all_hds)) {
+	die N("You must have a FAT partition mounted in /boot/efi");
+    }
+}
+
+1;
diff --git a/perl-install/fs/dmraid.pm b/perl-install/fs/dmraid.pm
new file mode 100644
index 000000000..6f440e5b6
--- /dev/null
+++ b/perl-install/fs/dmraid.pm
@@ -0,0 +1,214 @@
+package fs::dmraid; # $Id: dmraid.pm 58508 2006-08-28 17:25:09Z pixel $
+
+use diagnostics;
+use strict;
+
+#-######################################################################################
+#- misc imports
+#-######################################################################################
+use common;
+use modules;
+use devices;
+use fs::type;
+use fs::wild_device;
+use run_program;
+
+
+sub init() {
+    whereis_binary('dmraid') or die "dmraid not installed";
+
+    eval { modules::load('dm-mirror') };
+    devices::init_device_mapper();
+    if ($::isInstall) {
+	call_dmraid('-ay');
+    }
+    1;
+}
+
+#- call_dmraid is overloaded when debugging, see the end of this file
+sub call_dmraid {
+    my ($option, @args) = @_;
+    run_program::get_stdout('dmraid', $option, @args);
+}
+
+sub check {
+    my ($in) = @_;
+
+    $in->do_pkgs->ensure_binary_is_installed('dmraid', 'dmraid') or return;
+    init();
+    1;
+}
+
+sub _raid_devices_raw() {
+    map {
+	chomp;
+	log::l("got: $_");
+	my %l; @l{qw(pv format vg level status size)} = split(':');
+	if_(defined $l{size}, \%l);
+    } call_dmraid('-r', '-c', '-c');
+}
+
+sub _raid_devices() {
+    my @l = _raid_devices_raw();
+    my %vg2pv; push @{$vg2pv{$_->{vg}}}, delete $_->{pv} foreach @l;
+    my %vg2status; push @{$vg2status{$_->{vg}}}, delete $_->{status} foreach @l;
+    map {
+	delete $_->{size}; #- now irrelevant
+	$_->{disks} = $vg2pv{$_->{vg}};
+	$_->{status} = (every { $_ eq 'ok' } @{$vg2status{$_->{vg}}}) ? 'ok' : join(' ', @{$vg2status{$_->{vg}}});
+	$_;
+    } uniq_ { $_->{vg} } @l;
+}
+
+sub _sets_raw() {
+    map {
+	chomp;
+	log::l("got: $_");
+	my %l; @l{qw(name size stride level status subsets devs spares)} = split(':');
+	if_(defined $l{spares}, \%l);
+    } call_dmraid('-s', '-c', '-c');
+}
+
+sub _sets() {
+    my @sets = _sets_raw();
+    my @raid_devices = _raid_devices();
+    foreach (@sets) {
+	my $name = $_->{name};
+	my @l = grep { begins_with($name, $_->{vg}) } @raid_devices;
+	log::l("ERROR: multiple match for set $name: " . join(' ', map { $_->{vg} } @l)) if @l > 1;
+
+	@l = grep { begins_with($_->{vg}, $name) } @raid_devices if !@l;
+	
+	if (@l) {
+	    foreach my $raid (@l) {
+		push @{$_->{disks}}, @{$raid->{disks}};
+		add2hash($_, $raid);
+		$_->{status} = $raid->{status} if $_->{status} eq 'ok' && $::isInstall;
+	    }
+	} else {
+	    log::l("ERROR: no matching raid devices for set $name");
+	}
+    }
+    @sets;
+}
+
+sub vgs() {
+    map {
+	my $dev = "mapper/$_->{name}";
+	my $vg = fs::wild_device::to_subpart("/dev/$dev");
+	add2hash($vg, { media_type => 'hd', prefix => $dev, bus => "dmraid_$_->{format}", disks => $_->{disks} });
+
+	#- device should exist, created by dmraid(8) using libdevmapper
+	#- if it doesn't, we suppose it's not in use
+	if_(-e "/dev/$dev", $vg); 
+
+    } grep { 
+	if ($_->{status} eq 'ok') {
+	    1;
+	} else {
+	    call_dmraid('-an', $_->{vg}) if $::isInstall; #- for things like bad_sil below, deactivating half activated dmraid
+	    0;
+	}
+    } _sets();
+}
+
+if ($ENV{DRAKX_DEBUG_DMRAID}) {
+    eval(<<'EOF');
+    my %debug_data = (
+    
+     isw => {
+    
+      # dmraid -s ####################
+      # *** Group superset isw_ffafgbdhi
+      # --> Active Subset
+      # name   : isw_ffafgbdhi_toto
+      # size   : 234441216
+      # stride : 256
+      # type   : mirror
+      # status : ok
+      # subsets: 0
+      # devs   : 2
+      # spares : 0
+    
+      '-s' => "isw_ffafgbdhi_toto:234441216:256:mirror:ok:0:2:0\n",
+    
+      # dmraid -r ####################
+      #/dev/sda: isw, "isw_ffafgbdhi", GROUP, ok, 488397166 sectors, data@ 0
+      #/dev/sdb: isw, "isw_ffafgbdhi", GROUP, ok, 234441646 sectors, data@ 0
+    
+      '-r' => "/dev/sda:isw:isw_ffafgbdhi:GROUP:ok:488397166:0\n" .
+              "/dev/sdb:isw:isw_ffafgbdhi:GROUP:ok:234441646:0\n",
+     },
+    
+     pdc => {
+      # dmraid -s ####################
+      # *** Active Set
+      # name   : pdc_bcefbiigfg
+      # size   : 80043200
+      # stride : 128
+      # type   : mirror
+      # status : ok
+      # subsets: 0
+      # devs   : 2
+      # spares : 0
+    
+      '-s' => "pdc_bcefbiigfg:80043200:128:mirror:ok:0:2:0\n",
+    
+      # dmraid -r ####################
+      # /dev/sda: pdc, "pdc_bcefbiigfg", mirror, ok, 80043200 sectors, data@ 0
+      # /dev/sdb: pdc, "pdc_bcefbiigfg", mirror, ok, 80043200 sectors, data@ 0
+    
+      '-r' => "/dev/sda:pdc:pdc_bcefbiigfg:mirror:ok:80043200:0\n" .
+                "/dev/sdb:pdc:pdc_bcefbiigfg:mirror:ok:80043200:0\n",
+     },
+    
+     bad_sil => {
+      '-s' => "sil_aeacdidecbcb:234439600:0:mirror:ok:0:1:0\n",
+                # ERROR: sil: only 3/4 metadata areas found on /dev/sdb, electing...
+
+      '-r' => "/dev/sdb:sil:sil_aeacdidecbcb:mirror:broken:234439600:0\n",
+                # ERROR: sil: only 3/4 metadata areas found on /dev/sdb, electing...
+     },
+
+     weird_nvidia =>  {
+      '-s' => <<'EO',
+/dev/sda: "sil" and "nvidia" formats discovered (using nvidia)!
+/dev/sdb: "sil" and "nvidia" formats discovered (using nvidia)!
+nvidia_bcjdbjfa:586114702:128:mirror:ok:0:2:0
+EO
+       '-r' => <<'EO',
+/dev/sda: "sil" and "nvidia" formats discovered (using nvidia)!
+/dev/sdb: "sil" and "nvidia" formats discovered (using nvidia)!
+/dev/sda:nvidia:nvidia_bcjdbjfa:mirror:ok:586114702:0
+/dev/sdb:nvidia:nvidia_bcjdbjfa:mirror:ok:586114702:0
+EO
+	 # ERROR: multiple match for set nvidia_bcjdbjfa:  nvidia_bcjdbjfa
+     },
+
+     nvidia_with_subsets => {
+      '-s' => <<'EO',
+nvidia_bfcciffh:625163520:128:raid10:ok:2:4:0
+EO
+       '-r' => <<'EO',
+/dev/sda:nvidia:nvidia_bfcciffh-0:stripe:ok:312581806:0
+/dev/sdb:nvidia:nvidia_bfcciffh-0:stripe:ok:312581806:0
+/dev/sdc:nvidia:nvidia_bfcciffh-1:stripe:ok:312581806:0
+/dev/sdd:nvidia:nvidia_bfcciffh-1:stripe:ok:312581806:0
+EO
+	 # ERROR: multiple match for set nvidia_bcjdbjfa:  nvidia_bcjdbjfa
+     },
+    );
+    
+    *call_dmraid = sub {
+        my ($option, @args) = @_;
+        if (my $s = $debug_data{$ENV{DRAKX_DEBUG_DMRAID}}{$option}) {
+            split("\n", $s);
+	} else {
+            warn "dmraid $option @args\n";
+        }
+    };
+EOF
+    $@ and die;
+}
+
+1;
diff --git a/perl-install/fs/format.pm b/perl-install/fs/format.pm
new file mode 100644
index 000000000..63eeb2d77
--- /dev/null
+++ b/perl-install/fs/format.pm
@@ -0,0 +1,195 @@
+package fs::format; # $Id: format.pm 150513 2007-04-03 08:49:37Z pixel $
+
+use diagnostics;
+use strict;
+use String::ShellQuote;
+
+use run_program;
+use common;
+use fs::type;
+use fs::loopback;
+use log;
+
+my %cmds = (
+    ext2     => [ 'e2fsprogs', 'mkfs.ext2', '-F' ],
+    ext3     => [ 'e2fsprogs', 'mkfs.ext2', '-F', '-j' ],
+    reiserfs => [ 'reiserfsprogs', 'mkfs.reiserfs', '-ff' ],
+    reiser4  => [ 'reiser4progs', 'mkfs.reiser4', '-f', '-y' ],
+    xfs      => [ 'xfsprogs', 'mkfs.xfs', '-f', '-q' ],
+    jfs      => [ 'jfsprogs', 'mkfs.jfs', '-f' ],
+    hfs      => [ 'hfsutils', 'hformat' ],
+    dos      => [ 'dosfstools', 'mkdosfs' ],
+    vfat     => [ 'dosfstools', 'mkdosfs', '-F', '32' ],
+    swap     => [ 'util-linux', 'mkswap' ],
+    ntfs     => [ 'ntfsprogs', 'mkntfs' ],
+);
+
+my %LABELs = ( #- option, length, handled_by_mount
+    ext2     => [ '-L', 16, 1 ],
+    ext3     => [ '-L', 16, 1 ],
+    reiserfs => [ '-l', 16, 1 ],
+    xfs      => [ '-L', 12, 1 ],
+    jfs      => [ '-L', 16, 1 ],
+    hfs      => [ '-l', 27, 0 ],
+    dos      => [ '-n', 11, 0 ],
+    vfat     => [ '-n', 11, 0 ],
+    swap     => [ '-L', 15, 1 ],
+);
+
+sub package_needed_for_partition_type {
+    my ($part) = @_;
+    my $l = $cmds{$part->{fs_type}} or return;
+    $l->[0];
+}
+
+sub known_type {
+    my ($part) = @_;
+    to_bool($cmds{$part->{fs_type}});
+}
+
+sub check_package_is_installed {
+    my ($do_pkgs, $fs_type) = @_;
+
+    my ($pkg, $binary) = @{$cmds{$fs_type} || return};
+    whereis_binary($binary) || $do_pkgs->ensure_binary_is_installed($pkg, $binary); #- ensure_binary_is_installed checks binary chrooted, whereas we run the binary non-chrooted (pb for Mandriva One)
+}
+
+sub part {
+    my ($all_hds, $part, $wait_message) = @_;
+    if (isRAID($part)) {
+	$wait_message->(N("Formatting partition %s", $part->{device})) if $wait_message;
+	require raid;
+	raid::format_part($all_hds->{raids}, $part);
+    } elsif (isLoopback($part)) {
+	$wait_message->(N("Creating and formatting file %s", $part->{loopback_file})) if $wait_message;
+	fs::loopback::format_part($part);
+    } else {
+	$wait_message->(N("Formatting partition %s", $part->{device})) if $wait_message;
+	part_raw($part, $wait_message);
+    }
+}
+
+sub part_raw {
+    my ($part, $wait_message) = @_;
+
+    $part->{isFormatted} and return;
+
+    if ($part->{encrypt_key}) {
+	fs::mount::set_loop($part);
+    }
+
+    my $dev = $part->{real_device} || $part->{device};
+
+    my @options = if_($part->{toFormatCheck}, "-c");
+    log::l("formatting device $dev (type $part->{fs_type})");
+
+    my $fs_type = $part->{fs_type};
+
+    if ($fs_type eq 'ext2' || $fs_type eq 'ext3') {
+	push @options, "-m", "0" if $part->{mntpoint} =~ m|^/home|;
+    } elsif (isDos($part)) {
+	$fs_type = 'dos';
+    } elsif ($fs_type eq 'hfs') {
+        push @options, '-l', "Untitled";
+    } elsif (isAppleBootstrap($part)) {
+	push @options, '-l', 'bootstrap';
+    }
+
+    if ($part->{device_LABEL}) {
+	if ($LABELs{$fs_type}) {
+	    my ($option, $length, $handled_by_mount) = @{$LABELs{$fs_type}};
+	    if (length $part->{device_LABEL} > $length) {
+		my $short = substr($part->{device_LABEL}, 0, $length);
+		log::l("shortening LABEL $part->{device_LABEL} to $short");
+		$part->{device_LABEL} = $short;
+	    }
+	    delete $part->{prefer_device_LABEL}
+	      if !$handled_by_mount || $part->{mntpoint} eq '/' && !member($fs_type, 'ext2', 'ext3');
+
+	    push @options, $option, $part->{device_LABEL};
+	} else {
+	    log::l("dropping LABEL=$part->{device_LABEL} since we don't know how to set labels for fs_type $part->{fs_type}");
+	    delete $part->{device_LABEL};
+	    delete $part->{prefer_device_LABEL};
+	}
+    }
+
+    my ($_pkg, $cmd, @first_options) = @{$cmds{$fs_type} || die N("I do not know how to format %s in type %s", $part->{device}, $part->{fs_type})};
+
+    my @args = ($cmd, @first_options, @options, devices::make($dev));
+
+    if ($cmd eq 'mkfs.ext2' && $wait_message) {
+	mkfs_ext2($wait_message, @args) or die N("%s formatting of %s failed", $fs_type, $dev);
+    } else {
+	run_program::raw({ timeout => 'never' }, @args) or die N("%s formatting of %s failed", $fs_type, $dev);
+    }
+
+    if ($fs_type eq 'ext3') {
+	disable_forced_fsck($dev);
+    }
+
+    set_isFormatted($part, 1);
+}
+
+sub mkfs_ext2 {
+    my ($wait_message, @args) = @_;
+
+    my $cmd = shell_quote_best_effort(@args);
+    log::l("running: $cmd");
+    open(my $F, "$cmd |");
+
+    local $/ = "\b";
+    local $_;
+    while (<$F>) {
+	#- even if it still takes some time when format is over, we don't want the progress bar to stay at 85%
+	$wait_message->('', $1, $2) if m!^\s*(\d+)/(\d+)\b!;
+    }
+    return close($F);
+}
+
+sub disable_forced_fsck {
+    my ($dev) = @_;
+    run_program::run("tune2fs", "-c0", "-i0", devices::make($dev));
+}
+
+sub formatMount_part {
+    my ($part, $all_hds, $fstab, $wait_message) = @_;
+
+    if (isLoopback($part)) {
+	formatMount_part($part->{loopback_device}, $all_hds, $fstab, $wait_message);
+    }
+    if (my $p = fs::get::up_mount_point($part->{mntpoint}, $fstab)) {
+	formatMount_part($p, $all_hds, $fstab, $wait_message) if !fs::type::carry_root_loopback($part);
+    }
+    if ($part->{toFormat}) {
+	fs::format::part($all_hds, $part, $wait_message);
+    }
+
+    #- setting user_xattr on /home (or "/" if no /home)
+    if (!$part->{isMounted} && $part->{fs_type} eq 'ext3' 
+	  && ($part->{mntpoint} eq '/home' ||
+		!fs::get::has_mntpoint('/home', $all_hds) && $part->{mntpoint} eq '/')) {
+	run_program::run('tune2fs', '-o', 'user_xattr', devices::make($part->{real_device} || $part->{device}));
+    }
+
+    fs::mount::part($part, 0, $wait_message);
+}
+
+sub formatMount_all {
+    my ($all_hds, $fstab, $wait_message) = @_;
+    formatMount_part($_, $all_hds, $fstab, $wait_message) 
+      foreach sort { isLoopback($a) ? 1 : isSwap($a) ? -1 : 0 } grep { $_->{mntpoint} } @$fstab;
+
+    #- ensure the link is there
+    fs::loopback::carryRootCreateSymlink($_) foreach @$fstab;
+
+    #- for fun :)
+    #- that way, when install exits via ctrl-c, it gives hand to partition
+    eval {
+	my ($_type, $major, $minor) = devices::entry(fs::get::root($fstab)->{device});
+	output "/proc/sys/kernel/real-root-dev", makedev($major, $minor);
+    };
+}
+
+
+1;
diff --git a/perl-install/fs/get.pm b/perl-install/fs/get.pm
new file mode 100644
index 000000000..72727c253
--- /dev/null
+++ b/perl-install/fs/get.pm
@@ -0,0 +1,155 @@
+package fs::get; # $Id: get.pm 54943 2006-08-09 17:41:26Z pixel $
+
+use diagnostics;
+use strict;
+
+use partition_table;
+use fs::type;
+use fs::loopback;
+use fs::wild_device;
+use fs;
+use common;
+use log;
+
+sub empty_all_hds() {
+    { hds => [], lvms => [], raids => [], loopbacks => [], raw_hds => [], nfss => [], smbs => [], davs => [], special => [] };
+}
+sub fstab {
+    my ($all_hds) = @_;
+    my @parts = map { partition_table::get_normal_parts($_) } hds($all_hds);
+    @parts, @{$all_hds->{raids}}, @{$all_hds->{loopbacks}};
+}
+sub really_all_fstab {
+    my ($all_hds) = @_;
+    my @l = fstab($all_hds);
+    @l, @{$all_hds->{raw_hds}}, @{$all_hds->{nfss}}, @{$all_hds->{smbs}}, @{$all_hds->{davs}};
+}
+
+sub fstab_and_holes {
+    my ($all_hds, $b_non_readonly) = @_;
+    my @hds = grep { !($b_non_readonly && $_->{readonly}) } hds($all_hds);
+    hds_fstab_and_holes(@hds), @{$all_hds->{raids}}, @{$all_hds->{loopbacks}};
+}
+
+sub holes {
+    my ($all_hds, $b_non_readonly) = @_;
+    grep { isEmpty($_) } fstab_and_holes($all_hds, $b_non_readonly);
+}
+sub hds_holes {
+    grep { isEmpty($_) } hds_fstab_and_holes(@_);
+}
+sub free_space {
+    my ($all_hds) = @_;
+    sum map { $_->{size} } holes($all_hds);
+}
+sub hds_free_space {
+    sum map { $_->{size} } hds_holes(@_);
+}
+
+sub hds {
+    my ($all_hds) = @_;
+    (@{$all_hds->{hds}}, @{$all_hds->{lvms}});
+}
+
+#- get all normal partition including special ones as found on sparc.
+sub hds_fstab {
+    map { partition_table::get_normal_parts($_) } @_;
+}
+
+sub vg_free_space {
+    my ($hd) = @_;
+    my @parts = partition_table::get_normal_parts($hd);
+    $hd->{totalsectors} - sum map { $_->{size} } @parts;
+}
+
+sub hds_fstab_and_holes {
+    map {
+	if (isLVM($_)) {
+	    my @parts = partition_table::get_normal_parts($_);
+	    my $free = vg_free_space($_);
+	    my $free_part = { start => 0, size => $free, pt_type => 0, rootDevice => $_->{VG_name} };
+	    @parts, if_($free >= $_->cylinder_size, $free_part);
+	} else {
+	    partition_table::get_normal_parts_and_holes($_);
+	}
+    } @_;
+}
+
+
+sub device2part {
+    my ($dev, $fstab) = @_;
+    my $subpart = fs::wild_device::to_subpart($dev);
+    my $part = find { is_same_hd($subpart, $_) } @$fstab;
+    log::l("fs::get::device2part: unknown device <<$dev>>") if !$part;
+    $part;
+}
+
+sub part2hd {
+    my ($part, $all_hds) = @_;
+    my $hd = find { $part->{rootDevice} eq ($_->{device} || $_->{VG_name}) } hds($all_hds);
+    $hd;
+}
+
+sub file2part {
+    my ($fstab, $file, $b_keep_simple_symlinks) = @_;    
+    my $part;
+
+    $file = $b_keep_simple_symlinks ? common::expand_symlinks_but_simple("$::prefix$file") : expand_symlinks("$::prefix$file");
+    unless ($file =~ s/^$::prefix//) {
+	my $part = find { fs::type::carry_root_loopback($_) } @$fstab or die;
+	log::l("found $part->{mntpoint}");
+	$file =~ s|/initrd/loopfs|$part->{mntpoint}|;
+    }
+    foreach (@$fstab) {
+	my $m = $_->{mntpoint};
+	$part = $_ if 
+	  $file =~ /^\Q$m/ && 
+	    (!$part || length $part->{mntpoint} < length $m);
+    }
+    $part or die "file2part: not found $file";
+    $file =~ s|$part->{mntpoint}/?|/|;
+    ($part, $file);
+}
+
+sub mntpoint2part {
+    my ($mntpoint, $fstab) = @_;
+    find { $mntpoint eq $_->{mntpoint} } @$fstab;
+}
+sub has_mntpoint {
+    my ($mntpoint, $all_hds) = @_;
+    mntpoint2part($mntpoint, [ really_all_fstab($all_hds) ]);
+}
+sub root_ {
+    my ($fstab, $o_boot) = @_;
+    $o_boot && mntpoint2part("/boot", $fstab) || mntpoint2part("/", $fstab);
+}
+sub root { &root_ || {} }
+
+sub up_mount_point {
+    my ($mntpoint, $fstab) = @_;
+    while (1) {
+	$mntpoint = dirname($mntpoint);
+	$mntpoint ne "." or return;
+	$_->{mntpoint} eq $mntpoint and return $_ foreach @$fstab;
+    }
+}
+
+sub is_same_hd {
+    my ($hd1, $hd2) = @_;
+    if ($hd1->{major} && $hd2->{major}) {
+	$hd1->{major} == $hd2->{major} && $hd1->{minor} == $hd2->{minor};
+    } elsif (my ($s1) = $hd1->{device} =~ m|https?://(.+?)/*$|) {
+	my ($s2) = $hd2->{device} =~ m|https?://(.+?)/*$|;
+	$s1 eq $s2;
+    } else {
+	$hd1->{device_LABEL} && $hd2->{device_LABEL} && $hd1->{device_LABEL} eq $hd2->{device_LABEL}
+	  || $hd1->{device} && $hd2->{device} && $hd1->{device} eq $hd2->{device};
+    }
+}
+
+sub mntpoint_prefixed {
+    my ($part) = @_;
+    $::prefix . $part->{mntpoint};
+}
+
+1;
diff --git a/perl-install/fs/loopback.pm b/perl-install/fs/loopback.pm
new file mode 100644
index 000000000..3c7f79c04
--- /dev/null
+++ b/perl-install/fs/loopback.pm
@@ -0,0 +1,119 @@
+package fs::loopback; # $Id: loopback.pm 23142 2005-06-28 09:12:16Z prigaux $
+
+use diagnostics;
+use strict;
+
+#-######################################################################################
+#- misc imports
+#-######################################################################################
+use common;
+use fs::type;
+use fs;
+use log;
+
+
+sub check_circular_mounts {
+    my ($part, $all_hds) = @_;
+
+    my $fstab = [ fs::get::fstab($all_hds), $part ]; # no pb if $part is already in $all_hds
+
+    my $base_mntpoint = $part->{mntpoint};
+    my $check; $check = sub {
+	my ($part, @seen) = @_;
+	push @seen, $part->{mntpoint} || return;
+	@seen > 1 && $part->{mntpoint} eq $base_mntpoint and die N("Circular mounts %s\n", join(", ", @seen));
+	if (my $part = fs::get::up_mount_point($part->{mntpoint}, $fstab)) {
+	    #- '/' carrier is a special case, it will be mounted first
+	    $check->($part, @seen) if !fs::type::carry_root_loopback($part);
+	}
+	if (isLoopback($part)) {
+	    $check->($part->{loopback_device}, @seen);
+	}
+    };
+    $check->($part) if !($base_mntpoint eq '/' && isLoopback($part)); #- '/' is a special case, no loop check
+}
+
+sub carryRootCreateSymlink {
+    my ($part) = @_;
+
+    fs::type::carry_root_loopback($part) or return;
+
+    my $mntpoint = fs::get::mntpoint_prefixed($part);
+    unless (-e $mntpoint) {
+	eval { mkdir_p(dirname($mntpoint)) };
+	#- do non-relative link for install, should be changed to relative link before rebooting
+	symlink "/initrd/loopfs", $mntpoint;
+
+	mkdir_p("/initrd/loopfs/lnx4win/boot");
+	symlink "/initrd/loopfs/lnx4win/boot", "$::prefix/boot";
+    }
+    #- indicate kernel to keep initrd
+    mkdir_p("$::prefix/initrd");
+}
+
+
+sub format_part {
+    my ($part) = @_;
+    fs::mount::part($part->{loopback_device});
+    create($part);
+    fs::format::part_raw($part, undef);
+}
+
+sub create {
+    my ($part) = @_;
+    my $f = $part->{device} = fs::get::mntpoint_prefixed($part->{loopback_device}) . $part->{loopback_file};
+    return if -e $f;
+
+    eval { mkdir_p(dirname($f)) };
+
+    log::l("creating loopback file $f ($part->{size} sectors)");
+
+    my $block_size = 128;
+    my $s = "\0" x (512 * $block_size);
+    sysopen(my $F, $f, 2 | c::O_CREAT()) or die "failed to create loopback file";
+    for (my $i = 0; $i < $part->{size}; $i += $block_size) {
+	syswrite $F, $s or die "failed to create loopback file";
+    }
+}
+
+sub getFree {
+    my ($dir, $part) = @_;
+    my $freespace = $dir ? 
+      2 * (MDK::Common::System::df($dir))[1] : #- df in KiB
+      $part->{size};
+
+    $freespace - sum map { $_->{size} } @{$part->{loopback} || []};
+}
+
+#- returns the size of the loopback file if it already exists
+#- returns -1 is the loopback file can not be used
+sub verifFile {
+    my ($dir, $file, $part) = @_;
+    -e "$dir$file" and return -s "$dir$file";
+
+    $_->{loopback_file} eq $file and return -1 foreach @{$part->{loopback} || []};
+
+    undef;
+}
+
+sub prepare_boot() {
+    my $r = readlink "$::prefix/boot"; 
+    unlink "$::prefix/boot"; 
+    mkdir_p("$::prefix/boot");
+    [$r, $::prefix];
+}
+
+sub save_boot {
+    my ($loop_boot, $prefix) = @{$_[0]};
+    
+    $loop_boot or return;
+
+    my @files = glob_("$prefix/boot/*");
+    cp_af(@files, $loop_boot) if @files;
+    rm_rf("$prefix/boot");
+    symlink $loop_boot, "$prefix/boot";
+}
+
+
+1;
+
diff --git a/perl-install/fs/mount.pm b/perl-install/fs/mount.pm
new file mode 100644
index 000000000..44cda7c64
--- /dev/null
+++ b/perl-install/fs/mount.pm
@@ -0,0 +1,221 @@
+package fs::mount; # $Id: mount.pm 38787 2006-07-11 18:41:38Z pixel $
+
+use diagnostics;
+use strict;
+
+use run_program;
+use common;
+use fs::type;
+use log;
+
+
+sub set_loop {
+    my ($part) = @_;
+    $part->{device} ||= fs::get::mntpoint_prefixed($part->{loopback_device}) . $part->{loopback_file};
+    $part->{real_device} ||= devices::set_loop(devices::make($part->{device}), $part->{encrypt_key}, $part->{options} =~ /encryption=(\w+)/);
+}
+
+sub swapon {
+    my ($dev) = @_;
+    log::l("swapon called with $dev");
+    syscall_('swapon', devices::make($dev), 0) or die "swapon($dev) failed: $!";
+}
+
+sub swapoff {
+    my ($dev) = @_;
+    syscall_('swapoff', devices::make($dev)) or die "swapoff($dev) failed: $!";
+}
+
+sub mount {
+    my ($dev, $where, $fs, $b_rdonly, $o_options, $o_wait_message) = @_;
+    log::l("mounting $dev on $where as type $fs, options $o_options");
+
+    mkdir_p($where);
+
+    $fs or log::l("not mounting $dev partition"), return;
+
+    {
+	my @fs_modules = qw(ext3 hfs jfs nfs ntfs romfs reiserfs ufs xfs vfat);
+	my @types = (qw(ext2 proc sysfs usbfs usbdevfs iso9660 devfs devpts), @fs_modules);
+
+	push @types, 'smb', 'smbfs', 'davfs2' if !$::isInstall;
+
+	if (!member($fs, @types) && !$::move) {
+	    log::l("skipping mounting $dev partition ($fs)");
+	    return;
+	}
+	if ($::isInstall) {
+	    if (member($fs, @fs_modules)) {
+		eval { modules::load($fs) };
+	    } elsif ($fs eq 'iso9660') {
+		eval { modules::load('isofs') };
+	    }
+	}
+    }
+
+    $where =~ s|/$||;
+
+    my @mount_opt = split(',', $o_options || '');
+
+    if ($::isInstall) {
+	#- those options need nls_XXX modules, and we don't this at install
+	@mount_opt = grep { $_ ne 'utf8' && !/^iocharset=/ } @mount_opt;
+    }
+
+    if ($fs eq 'vfat') {
+	@mount_opt = 'check=relaxed';
+    } elsif ($fs eq 'ntfs') {
+	@mount_opt = () if $::isInstall; # esp. drop nls=xxx option so that we don't need kernel module nls_xxx
+    } elsif ($fs eq 'nfs') {
+	push @mount_opt, 'nolock', 'soft', 'intr' if $::isInstall;
+    } elsif ($fs eq 'jfs' && !$b_rdonly) {
+	fsck_jfs($dev, $o_wait_message);
+    } elsif ($fs eq 'ext2' && !$b_rdonly) {
+	fsck_ext2($dev, $o_wait_message);
+    }
+
+    push @mount_opt, 'ro' if $b_rdonly;
+
+    $o_wait_message->(N("Mounting partition %s", $dev)) if $o_wait_message;
+    run_program::run('mount', '-t', $fs, $dev, $where, if_(@mount_opt, '-o', join(',', @mount_opt))) or die N("mounting partition %s in directory %s failed", $dev, $where);
+}
+
+sub fsck_ext2 {
+    my ($dev, $o_wait_message) = @_;
+    $o_wait_message->(N("Checking %s", $dev)) if $o_wait_message;
+    foreach ('-a', '-y') {
+	run_program::raw({ timeout => 60 * 60 }, "fsck.ext2", $_, $dev);
+	my $err = $?;
+	if ($err & 0x0100) {
+	    log::l("fsck corrected partition $dev");
+	}
+	if ($err & 0xfeff) {
+	    my $txt = sprintf("fsck failed on %s with exit code %d or signal %d", $dev, $err >> 8, $err & 255);
+	    $_ eq '-y' ? die($txt) : cdie($txt);
+	} else {
+	    last;
+	}
+    }
+}
+sub fsck_jfs {
+    my ($dev, $o_wait_message) = @_;
+    $o_wait_message->(N("Checking %s", $dev)) if $o_wait_message;
+    #- needed if the system is dirty otherwise mounting read-write simply fails
+    run_program::raw({ timeout => 60 * 60 }, "fsck.jfs", $dev) or do {
+	my $err = $?;
+	die "fsck.jfs failed" if $err & 0xfc00;
+    };
+}
+
+#- takes the mount point to umount (can also be the device)
+sub umount {
+    my ($mntpoint) = @_;
+    $mntpoint =~ s|/$||;
+    log::l("calling umount($mntpoint)");
+
+    run_program::run('umount', $mntpoint) or do {
+	kill 15, fuzzy_pidofs('^fam\b');
+	run_program::run('umount', $mntpoint) or die N("error unmounting %s: %s", $mntpoint, $!);
+    };
+
+    substInFile { $_ = '' if /(^|\s)$mntpoint\s/ } '/etc/mtab'; #- do not care about error, if we can not read, we will not manage to write... (and mess mtab)
+}
+
+sub part {
+    my ($part, $b_rdonly, $o_wait_message) = @_;
+
+    log::l("mount_part: " . join(' ', map { "$_=$part->{$_}" } 'device', 'mntpoint', 'isMounted', 'real_mntpoint'));
+
+    return if $part->{isMounted} && !($part->{real_mntpoint} && $part->{mntpoint});
+
+    unless ($::testing) {
+	if (isSwap($part)) {
+	    $o_wait_message->(N("Enabling swap partition %s", $part->{device})) if $o_wait_message;
+	    swapon($part->{device});
+	} elsif ($part->{real_mntpoint}) {
+	    my $mntpoint = fs::get::mntpoint_prefixed($part);
+
+	    mkdir_p($mntpoint);
+	    run_program::run_or_die('mount', '--move', $part->{real_mntpoint}, $mntpoint);
+
+	    rmdir $part->{real_mntpoint};
+	    symlinkf $mntpoint, $part->{real_mntpoint};
+	    delete $part->{real_mntpoint};
+
+	    my $dev = $part->{real_device} || fs::wild_device::from_part('', $part);
+	    run_program::run_or_die('mount', $dev, $mntpoint, '-o', join(',', 'remount', $b_rdonly ? 'ro' : 'rw'));
+	} else {
+	    $part->{mntpoint} or die "missing mount point for partition $part->{device}";
+
+	    my $mntpoint = fs::get::mntpoint_prefixed($part);
+	    my $options = $part->{options};
+	    if ($part->{encrypt_key}) {
+		set_loop($part);
+		$options = join(',', grep { !/^(encryption=|encrypted$|loop$)/ } split(',', $options)); #- we take care of this, don't let it mount see it
+	    } elsif (isLoopback($part)) {
+		#- mount will take care, but we must help it
+		devices::make("loop$_") foreach 0 .. 7;
+		$options = join(',', uniq('loop', split(',', $options))); #- ensure the loop options is used
+	    } elsif ($part->{options} =~ /encrypted/) {
+		log::l("skip mounting $part->{device} since we do not have the encrypt_key");
+		return;
+	    } elsif (fs::type::carry_root_loopback($part)) {
+		$mntpoint = "/initrd/loopfs";
+	    }
+	    my $dev = $part->{real_device} || fs::wild_device::from_part('', $part);
+	    my $fs_type = $part->{fs_type};
+	    if ($fs_type eq 'auto' && $part->{media_type} eq 'cdrom' && $::isInstall) {
+		$fs_type = 'iso9660';
+	    }
+	    mount($dev, $mntpoint, $fs_type, $b_rdonly, $options, $o_wait_message);
+
+	    if ($options =~ /usrquota|grpquota/ && $part->{fs_type} eq 'ext3') {
+		if (! find { -e "$mntpoint/$_" } qw(aquota.user aquota.group quota.user quota.group)) {
+		    #- quotacheck will create aquota.user and/or aquota.group,
+		    #- needed for quotas on ext3.
+		    run_program::run('quotacheck', $mntpoint);
+		}		
+	    }
+	}
+    }
+    $part->{isMounted} = 1;
+    set_isFormatted($part, 1); #- assume that if mount works, partition is formatted
+}
+
+sub umount_part {
+    my ($part) = @_;
+
+    $part->{isMounted} or return;
+
+    unless ($::testing) {
+	if (isSwap($part)) {
+	    swapoff($part->{device});
+	} elsif (fs::type::carry_root_loopback($part)) {
+	    umount("/initrd/loopfs");
+	} else {
+	    umount($part->{real_mntpoint} || fs::get::mntpoint_prefixed($part) || devices::make($part->{device}));
+	    devices::del_loop(delete $part->{real_device}) if $part->{real_device};
+	}
+    }
+    $part->{isMounted} = 0;
+}
+
+sub umount_all {
+    my ($fstab) = @_;
+
+    log::l("unmounting all filesystems");
+
+    foreach (sort { $b->{mntpoint} cmp $a->{mntpoint} } 
+	       grep { $_->{mntpoint} && !$_->{real_mntpoint} } @$fstab) {
+	umount_part($_);
+    }
+}
+
+sub usbfs {
+    my ($prefix) = @_;
+    
+    my $fs = cat_('/proc/filesystems') =~ /usbfs/ ? 'usbfs' : 'usbdevfs';
+    mount('none', "$prefix/proc/bus/usb", $fs);
+}
+
+1;
diff --git a/perl-install/fs/mount_options.pm b/perl-install/fs/mount_options.pm
new file mode 100644
index 000000000..207242268
--- /dev/null
+++ b/perl-install/fs/mount_options.pm
@@ -0,0 +1,268 @@
+package fs::mount_options; # $Id: mount_options.pm 56696 2006-08-17 21:06:04Z tv $
+
+use diagnostics;
+use strict;
+
+use common;
+use fs::type;
+use fs::get;
+use log;
+
+sub list() {
+    my %non_defaults = (
+			sync => 'async', noatime => 'atime', noauto => 'auto', ro => 'rw', 
+			user => 'nouser', nodev => 'dev', noexec => 'exec', nosuid => 'suid',
+			user_xattr => 'nouser_xattr',
+		       );
+    my @user_implies = qw(noexec nodev nosuid);
+    \%non_defaults, \@user_implies;
+}
+
+sub unpack {
+    my ($part) = @_;
+    my $packed_options = $part->{options};
+
+    my ($non_defaults, $user_implies) = list();
+
+    my @auto_fs = fs::type::guessed_by_mount();
+    my %per_fs = (
+		  iso9660 => [ qw(unhide) ],
+		  vfat => [ qw(umask=0 umask=0022) ],
+		  ntfs => [ qw(umask=0 umask=0022) ],
+		  nfs => [ qw(rsize=8192 wsize=8192) ],
+		  smbfs => [ qw(username= password=) ],
+		  davfs2 => [ qw(username= password= uid= gid=) ],
+		  reiserfs => [ 'notail' ],
+		 );
+    push @{$per_fs{$_}}, 'usrquota', 'grpquota' foreach 'ext2', 'ext3', 'xfs';
+
+    while (my ($fs, $l) = each %per_fs) {
+	$part->{fs_type} eq $fs || $part->{fs_type} eq 'auto' && member($fs, @auto_fs) or next;
+	$non_defaults->{$_} = 1 foreach @$l;
+    }
+
+    $non_defaults->{encrypted} = 1;
+
+    $non_defaults->{supermount} = 1 if $part->{fs_type} =~ /:/ || member($part->{fs_type}, 'auto', @auto_fs);
+
+    my $defaults = { reverse %$non_defaults };
+    my %options = map { $_ => '' } keys %$non_defaults;
+    my @unknown;
+    foreach (split(",", $packed_options)) {
+	if (member($_, 'user', 'users')) {
+	    $options{$_} = 1 foreach $_, @$user_implies;
+	} elsif (exists $non_defaults->{$_}) {
+	    $options{$_} = 1;
+	} elsif ($defaults->{$_}) {
+	    $options{$defaults->{$_}} = 0;
+	} elsif (/(.*?=)(.*)/) {
+	    $options{$1} = $2;
+	} else {
+	    push @unknown, $_;
+	}
+    }
+    # merge those, for cleaner help
+    $options{'rsize=8192,wsize=8192'} = delete $options{'rsize=8192'} && delete $options{'wsize=8192'}
+      if exists $options{'rsize=8192'};
+
+    my $unknown = join(",", @unknown);
+    \%options, $unknown;
+}
+
+sub pack_ {
+    my ($_part, $options, $unknown) = @_;
+
+    my ($non_defaults, $user_implies) = list();
+    my @l;
+
+    my @umasks = map {
+	if (/^umask=/) {
+	    my $v = delete $options->{$_};
+	    /^umask=(.+)/ ? if_($v, $1) : $v;
+	} else { () }
+    } keys %$options;
+    if (@umasks) {
+	push @l, 'umask=' . min(@umasks);
+    }
+
+    if (my $user = find { delete $options->{$_} } 'users', 'user') {
+	push @l, $user;
+	delete $options->{user};
+	foreach (@$user_implies) {
+	    if (!delete $options->{$_}) {
+		# overriding
+		$options->{$non_defaults->{$_}} = 1;
+	    }
+	}
+    }
+    push @l, map_each { if_($::b, $::a =~ /=$/ ? "$::a$::b" : $::a) } %$options;
+    push @l, $unknown;
+
+    join(",", uniq(grep { $_ } @l));
+}
+sub pack {
+    my ($part, $options, $unknown) = @_;
+    $part->{options} = pack_($part, $options, $unknown);
+    noreturn();
+}
+
+# update me on each util-linux new release:
+sub help() {
+    (
+
+	'encrypted' => N("Use an encrypted file system"),
+
+	'grpquota' => N("Enable group disk quota accounting and optionally enforce limits"),
+
+	'noatime' => N("Do not update inode access times on this file system
+(e.g, for faster access on the news spool to speed up news servers)."),
+
+	'noauto' => N("Can only be mounted explicitly (i.e.,
+the -a option will not cause the file system to be mounted)."),
+
+	'nodev' => N("Do not interpret character or block special devices on the file system."),
+
+	'noexec' => N("Do not allow execution of any binaries on the mounted
+file system. This option might be useful for a server that has file systems
+containing binaries for architectures other than its own."),
+
+	'nosuid' => N("Do not allow set-user-identifier or set-group-identifier
+bits to take effect. (This seems safe, but is in fact rather unsafe if you
+have suidperl(1) installed.)"),
+
+	'ro' => N("Mount the file system read-only."),
+
+	'sync' => N("All I/O to the file system should be done synchronously."),
+
+	'supermount' => '',
+
+	'users' => N("Allow every user to mount and umount the file system."),         
+
+	'user' => N("Allow an ordinary user to mount the file system."),         
+
+	'usrquota' => N("Enable user disk quota accounting, and optionally enforce limits"),
+
+        'user_xattr' => N("Support \"user.\" extended attributes"),
+
+        'umask=0' => N("Give write access to ordinary users"),
+
+        'umask=0022' => N("Give read-only access to ordinary users"),
+    );
+}
+
+
+sub rationalize {
+    my ($part) = @_;
+
+    my ($options, $unknown) = &unpack($part);
+
+    if ($part->{fs_type} ne 'reiserfs') {
+	$options->{notail} = 0;
+    }
+    if (!fs::type::can_be_one_of_those_fs_types($part, 'vfat', 'smbfs', 'iso9660', 'udf')) {
+	delete $options->{'codepage='};
+    }
+    if (member($part->{mntpoint}, fs::type::directories_needed_to_boot())) {
+	foreach (qw(users user noauto supermount)) {
+	    if ($options->{$_}) {
+		$options->{$_} = 0;
+		$options->{$_} = 0 foreach qw(nodev noexec nosuid);
+	    }
+	}
+    }
+
+    &pack($part, $options, $unknown);
+}
+
+sub set_default {
+    my ($part, %opts) = @_;
+    #- opts are: useSupermount security iocharset codepage ignore_is_removable
+
+    my ($options, $unknown) = &unpack($part);
+
+    if (!$opts{ignore_is_removable} && $part->{is_removable} 
+	  && !member($part->{mntpoint}, fs::type::directories_needed_to_boot()) 
+	  && (!$part->{fs_type} || $part->{fs_type} eq 'auto' || $part->{fs_type} =~ /:/)) {
+	$options->{supermount} = $opts{useSupermount} && !($opts{useSupermount} eq 'magicdev' && $part->{media_type} eq 'cdrom');
+	$part->{fs_type} = !$options->{supermount} ? 'auto' :
+		    $part->{media_type} eq 'cdrom' ? 'udf:iso9660' : 'ext2:vfat';
+	$options->{sync} = 1 if $part->{media_type} ne 'cdrom';
+    }
+
+    if ($part->{media_type} eq 'cdrom') {
+	$options->{ro} = 1;
+    }
+
+    if ($part->{media_type} eq 'fd') {
+	# slow device so do not loose time, write now!
+	$options->{sync} = 1;
+    }
+
+    if (isTrueFS($part)) {
+	#- noatime on laptops (do not wake up the hd)
+	#- Do  not  update  inode  access times on this
+	#- file system (e.g, for faster access  on  the
+	#- news spool to speed up news servers).
+	$options->{noatime} = detect_devices::isLaptop();
+    }
+    if ($part->{fs_type} eq 'nfs') {
+	put_in_hash($options, { 
+			       nosuid => 1, 'rsize=8192,wsize=8192' => 1, soft => 1,
+			      });
+    }
+    if ($part->{fs_type} eq 'smbfs') {
+	add2hash($options, { 'username=' => '%' }) if !$options->{'credentials='};
+    }
+    if (fs::type::can_be_this_fs_type($part, 'vfat')) {
+
+	put_in_hash($options, {
+			       users => 1, noexec => 0,
+			      }) if $part->{is_removable};
+
+	put_in_hash($options, {
+			       'umask=0' => $opts{security} < 3, 'umask=0022' => $opts{security} < 4,
+			       'iocharset=' => $opts{iocharset}, 'codepage=' => $opts{codepage},
+			      });
+    }
+    if ($part->{fs_type} eq 'ntfs') {
+	put_in_hash($options, { ro => 1, 'nls=' => $opts{iocharset},
+				'umask=0' => $opts{security} < 3, 'umask=0022' => $opts{security} < 4,
+			      });
+    }
+    if (fs::type::can_be_this_fs_type($part, 'iso9660')) {
+	put_in_hash($options, { users => 1, noexec => 0, 'iocharset=' => $opts{iocharset} });
+    }
+    if ($part->{fs_type} eq 'reiserfs') {
+	$options->{notail} = 1;
+    }
+    if (isLoopback($part) && !isSwap($part)) { #- no need for loop option for swap files
+	$options->{loop} = 1;
+    }
+
+    # rationalize: no need for user
+    if ($options->{autofs} || $options->{supermount}) {
+	$options->{users} = $options->{user} = 0;
+    }
+
+    if ($options->{user} || $options->{users}) {
+        # have noauto when we have user
+        $options->{noauto} = 1;
+	# ensure security  (user_implies - noexec as noexec is not a security matter)
+	$options->{$_} = 1 foreach 'nodev', 'nosuid';
+    }
+
+    &pack($part, $options, $unknown);
+
+    rationalize($part);
+}
+
+sub set_all_default {
+    my ($all_hds, %opts) = @_;
+    #- opts are: useSupermount security iocharset codepage
+
+    foreach my $part (fs::get::really_all_fstab($all_hds)) {
+	set_default($part, %opts);
+    }
+}
+
+1;
diff --git a/perl-install/fs/mount_point.pm b/perl-install/fs/mount_point.pm
new file mode 100644
index 000000000..b21a37b62
--- /dev/null
+++ b/perl-install/fs/mount_point.pm
@@ -0,0 +1,130 @@
+package fs::mount_point; # $Id$
+
+use diagnostics;
+use strict;
+
+use common;
+use any;
+use fs::type;
+
+sub guess_mount_point {
+    my ($part, $prefix, $user) = @_;
+
+    my %l = (
+	     '/'     => 'etc/fstab',
+	     '/boot' => 'vmlinuz',
+	     '/tmp'  => '.X11-unix',
+	     '/usr'  => 'src',
+	     '/var'  => 'catman',
+	    );
+
+    my $handle = any::inspect($part, $prefix) or return;
+    my $d = $handle->{dir};
+    my $mnt = find { -e "$d/$l{$_}" } keys %l;
+    $mnt ||= (stat("$d/.bashrc"))[4] ? '/root' : '/home/user' . ++$$user if -e "$d/.bashrc";
+    $mnt ||= (any { -d $_ && (stat($_))[4] >= 500 && -e "$_/.bashrc" } glob_($d)) ? '/home' : '';
+    ($mnt, $handle);
+}
+
+sub suggest_mount_points {
+    my ($fstab, $prefix, $uniq) = @_;
+
+    my $user;
+    foreach my $part (grep { isTrueFS($_) } @$fstab) {
+	$part->{mntpoint} && !$part->{unsafeMntpoint} and next; #- if already found via an fstab
+
+	my ($mnt, $handle) = guess_mount_point($part, $prefix, \$user) or next;
+
+	next if $uniq && fs::get::mntpoint2part($mnt, $fstab);
+	$part->{mntpoint} = $mnt; delete $part->{unsafeMntpoint};
+
+	#- try to find other mount points via fstab
+	fs::merge_info_from_fstab($fstab, $handle->{dir}, $uniq, 'loose') if $mnt eq '/';
+    }
+    $_->{mntpoint} and log::l("suggest_mount_points: $_->{device} -> $_->{mntpoint}") foreach @$fstab;
+}
+
+sub suggest_mount_points_always {
+    my ($fstab) = @_;
+
+    my @win = grep { isFat_or_NTFS($_) && maybeFormatted($_) && !$_->{is_removable} } @$fstab;
+    log::l("win parts: ", join ",", map { $_->{device} } @win) if @win;
+    if (@win == 1) {
+	#- Suggest /boot/efi on ia64.
+	$win[0]{mntpoint} = arch() =~ /ia64/ ? "/boot/efi" : "/mnt/windows";
+    } else {
+	my %w; foreach (@win) {
+	    my $v = $w{$_->{device_windobe}}++;
+	    $_->{mntpoint} = $_->{unsafeMntpoint} = "/mnt/win_" . lc($_->{device_windobe}) . ($v ? $v+1 : ''); #- lc cuz of StartOffice(!) cf dadou
+	}
+    }
+
+    my @sunos = grep { $_->{pt_type} == 2 } @$fstab; #- take only into account root partitions.
+    if (@sunos) {
+	my $v = '';
+	map { $_->{mntpoint} = $_->{unsafeMntpoint} = "/mnt/sunos" . ($v && ++$v) } @sunos;
+    }
+    #- a good job is to mount SunOS root partition, and to use mount point described here in /etc/vfstab.
+}
+
+sub validate_mount_points {
+    my ($fstab) = @_;
+
+    #- TODO: set the mntpoints
+
+    my %m; foreach (@$fstab) {
+	my $m = $_->{mntpoint};
+
+	$m && $m =~ m!^/! or next; #- there may be a lot of swaps or "none"
+
+	$m{$m} and die N("Duplicate mount point %s", $m);
+	$m{$m} = 1;
+
+	#- in case the type does not correspond, force it to ext3
+	fs::type::set_fs_type($_, 'ext3') if !isTrueFS($_) && !isOtherAvailableFS($_);
+    }
+    1;
+}
+
+sub ask_mount_points {
+    my ($in, $fstab, $all_hds) = @_;
+
+    my @fstab = grep { isTrueFS($_) } @$fstab;
+    @fstab = grep { isSwap($_) } @$fstab if @fstab == 0;
+    @fstab = @$fstab if @fstab == 0;
+    die N("No partition available") if @fstab == 0;
+
+    {
+	my $_w = $in->wait_message('', N("Scanning partitions to find mount points"));
+	suggest_mount_points($fstab, $::prefix, 'uniq');
+	log::l("default mntpoint $_->{mntpoint} $_->{device}") foreach @fstab;
+    }
+    if (@fstab == 1) {
+	$fstab[0]{mntpoint} = '/';
+    } else {
+	$in->ask_from_({ messages => N("Choose the mount points"),
+			title => N("Partitioning"),
+			icon => 'banner-part',
+			interactive_help_id => 'ask_mntpoint_s',
+			callbacks => {
+			    complete => sub {
+				require diskdrake::interactive;
+				eval { 1, find_index {
+				    !diskdrake::interactive::check_mntpoint($in, $_->{mntpoint}, $_, $all_hds);
+				} @fstab };
+			    },
+			},
+		      },
+		      [ map { 
+			  { 
+			      label => partition_table::description($_), 
+			      val => \$_->{mntpoint},
+			      not_edit => 0,
+			      list => [ '', fsedit::suggestions_mntpoint(fs::get::empty_all_hds()) ],
+			  };
+		        } @fstab ]) or return;
+    }
+    validate_mount_points($fstab);
+}
+
+1;
diff --git a/perl-install/fs/partitioning.pm b/perl-install/fs/partitioning.pm
new file mode 100644
index 000000000..16a07cb5b
--- /dev/null
+++ b/perl-install/fs/partitioning.pm
@@ -0,0 +1,82 @@
+package fs::partitioning; # $Id$
+
+use diagnostics;
+use strict;
+
+use common;
+use fs::format;
+use fs::type;
+
+sub guess_partitions_to_format {
+    my ($fstab) = @_;
+    foreach (@$fstab) {
+	$_->{mntpoint} = "swap" if isSwap($_);
+	$_->{mntpoint} or next;
+	
+	add2hash_($_, { toFormat => $_->{notFormatted} }) if $_->{fs_type}; #- eg: do not set toFormat for isRawRAID (0xfd)
+        $_->{toFormatUnsure} ||= member($_->{mntpoint}, '/', '/usr');
+
+	if (!$_->{toFormat}) {
+	    my $fs_type = fs::type::fs_type_from_magic($_);
+	    if (!$fs_type || $fs_type ne $_->{fs_type}) {
+		log::l("setting toFormatUnsure for $_->{device} because <$_->{fs_type}> ne <$fs_type>");
+		$_->{toFormatUnsure} = 1;
+	    }
+	}
+    }
+}
+
+sub choose_partitions_to_format {
+    my ($in, $fstab) = @_;
+
+    guess_partitions_to_format($fstab);
+
+    my @l = grep { !$_->{isMounted} && $_->{mntpoint} && !isSwap($_) &&
+		   (!isFat_or_NTFS($_) || $_->{notFormatted}) &&
+		   (!isOtherAvailableFS($_) || $_->{toFormat});
+	       } @$fstab;
+    $_->{toFormat} = 1 foreach grep { isSwap($_) } @$fstab;
+
+    return if @l == 0 || every { $_->{toFormat} } @l;
+
+    #- keep it temporary until the guy has accepted
+    $_->{toFormatTmp} = $_->{toFormat} || $_->{toFormatUnsure} foreach @l;
+
+    $in->ask_from_(
+        { messages => N("Choose the partitions you want to format"),
+	  icon => 'banner-part',
+	  interactive_help_id => 'formatPartitions',
+          advanced_messages => N("Check bad blocks?"),
+        },
+        [ map { 
+	    my $e = $_;
+	    ({
+	      text => partition_table::description($e), type => 'bool',
+	      val => \$e->{toFormatTmp}
+	     }, if_(!isLoopback($_) && !member($_->{fs_type}, 'reiserfs', 'xfs', 'jfs'), {
+	      text => partition_table::description($e), type => 'bool', advanced => 1, 
+	      disabled => sub { !$e->{toFormatTmp} },
+	      val => \$e->{toFormatCheck}
+        })) } @l ]
+    ) or die 'already displayed';
+    #- ok now we can really set toFormat
+    foreach (@l) {
+	$_->{toFormat} = delete $_->{toFormatTmp};
+	set_isFormatted($_, 0);
+    }
+}
+
+sub format_mount_partitions {
+    my ($in, $all_hds, $fstab) = @_;
+    my ($w, $wait_message) = $in->wait_message_with_progress_bar;
+    catch_cdie {
+        fs::format::formatMount_all($all_hds, $fstab, $wait_message);
+    } sub { 
+	$@ =~ /fsck failed on (\S+)/ or return;
+	$in->ask_yesorno('', N("Failed to check filesystem %s. Do you want to repair the errors? (beware, you can lose data)", $1), 1);
+    };
+    undef $w; #- help perl (otherwise wait_message stays forever in curses)
+    die N("Not enough swap space to fulfill installation, please add some") if availableMemory() < 40 * 1024;
+}
+
+1;
diff --git a/perl-install/fs/partitioning_wizard.pm b/perl-install/fs/partitioning_wizard.pm
new file mode 100644
index 000000000..d833f5b26
--- /dev/null
+++ b/perl-install/fs/partitioning_wizard.pm
@@ -0,0 +1,283 @@
+package fs::partitioning_wizard; # $Id$
+
+use diagnostics;
+use strict;
+use utf8;
+
+use common;
+use devices;
+use fsedit;
+use fs::type;
+use fs::mount_point;
+use partition_table;
+use partition_table::raw;
+
+#- unit of $mb is mega bytes, min and max are in sectors, this
+#- function is used to convert back to sectors count the size of
+#- a partition ($mb) given from the interface (on Resize or Create).
+#- modified to take into account a true bounding with min and max.
+sub from_Mb {
+    my ($mb, $min, $max) = @_;
+    $mb <= $min >> 11 and return $min;
+    $mb >= $max >> 11 and return $max;
+    $mb * 2048;
+}
+
+sub partition_with_diskdrake {
+    my ($in, $all_hds, $fstab, $manual_fstab, $partitions, $partitioning_flags, $skip_mtab) = @_;
+    my $ok; 
+
+    do {
+	$ok = 1;
+	my $do_force_reload = sub {
+            my $new_hds = fs::get::empty_all_hds();
+            fs::any::get_hds($new_hds, $fstab, $manual_fstab, $partitioning_flags, $skip_mtab, $in);
+            %$all_hds = %$new_hds;
+            $all_hds;
+	};
+	require diskdrake::interactive;
+	{
+	    local $::expert = 0;
+	    diskdrake::interactive::main($in, $all_hds, $do_force_reload);
+	}
+	my @fstab = fs::get::fstab($all_hds);
+	
+	unless (fs::get::root_(\@fstab)) {
+	    $ok = 0;
+	    $in->ask_okcancel(N("Partitioning"), N("You must have a root partition.
+For this, create a partition (or click on an existing one).
+Then choose action ``Mount point'' and set it to `/'"), 1, 'banner-part') or return;
+	}
+	if (!any { isSwap($_) } @fstab) {
+	    $ok &&= $in->ask_okcancel('', N("You do not have a swap partition.\n\nContinue anyway?"));
+	}
+	if (arch() =~ /ia64/ && !fs::get::has_mntpoint("/boot/efi", $all_hds)) {
+	    $in->ask_warn('', N("You must have a FAT partition mounted in /boot/efi"));
+	    $ok = '';
+	}
+    } until $ok;
+    1;
+}
+
+sub partitionWizardSolutions {
+    my ($in, $all_hds, $all_fstab, $manual_fstab, $partitions, $partitioning_flags, $skip_mtab) = @_;
+    my $hds = $all_hds->{hds};
+    my $fstab = [ fs::get::fstab($all_hds) ];
+    my @wizlog;
+    my (%solutions);
+
+    my $min_linux = 400 << 11;
+    my $max_linux = 2000 << 11;
+    my $min_swap = 50 << 11;
+    my $max_swap = 300 << 11;
+    my $min_freewin = 100 << 11;
+
+    # each solution is a [ score, text, function ], where the function retunrs true if succeeded
+
+    my @hds_rw = grep { !$_->{readonly} } @$hds;
+    my @hds_can_add = grep { $_->can_raw_add } @hds_rw;
+    if (fs::get::hds_free_space(@hds_can_add) > $min_linux) {
+	$solutions{free_space} = [ 20, N("Use free space"), sub { fsedit::auto_allocate($all_hds, $partitions); 1 } ];
+    } else { 
+	push @wizlog, N("Not enough free space to allocate new partitions") . ": " .
+	  (@hds_can_add ? 
+	   fs::get::hds_free_space(@hds_can_add) . " < $min_linux" :
+	   "no harddrive on which partitions can be added");
+    }
+
+    if (my @truefs = grep { isTrueLocalFS($_) } @$fstab) {
+	#- value twice the ext2 partitions
+	$solutions{existing_part} = [ 6 + @truefs + @$fstab, N("Use existing partitions"), sub { fs::mount_point::ask_mount_points($in, $fstab, $all_hds) } ];
+    } else {
+	push @wizlog, N("There is no existing partition to use");
+    }
+
+    my @fats = grep { $_->{fs_type} eq 'vfat' } @$fstab;
+    fs::df($_) foreach @fats;
+    if (my @ok_forloopback = sort { $b->{free} <=> $a->{free} } grep { $_->{free} > $min_linux + $min_swap + $min_freewin } @fats) {
+	$solutions{loopback} = 
+	  [ -10 - @fats, N("Use the Microsoft Windows® partition for loopback"), 
+	    sub { 
+		my ($s_root, $s_swap);
+		my $part = $in->ask_from_listf('', N("Which partition do you want to use for Linux4Win?"), \&partition_table::description, \@ok_forloopback) or return;
+		$max_swap = $min_swap + 1 if $part->{free} - $max_swap < $min_linux;
+		$in->ask_from('', N("Choose the sizes"), [ 
+		   { label => N("Root partition size in MB: "), val => \$s_root, min => $min_linux >> 11, max => min($part->{free} - $max_swap, $max_linux) >> 11, type => 'range' },
+		   { label => N("Swap partition size in MB: "), val => \$s_swap, min => $min_swap >> 11,  max => $max_swap >> 11, type => 'range' },
+		]) or return;
+		push @{$part->{loopback}}, 
+		  { fs_type => 'ext3', loopback_file => '/lnx4win/linuxsys.img', mntpoint => '/',    size => $s_root << 11, loopback_device => $part, notFormatted => 1 },
+		  { fs_type => 'swap', loopback_file => '/lnx4win/swapfile',     mntpoint => 'swap', size => $s_swap << 11, loopback_device => $part, notFormatted => 1 };
+		fsedit::recompute_loopbacks($all_hds);
+		1;
+	    } ];
+    } else {
+	push @wizlog, N("There is no FAT partition to use as loopback (or not enough space left)") .
+	  (@fats ? "\nFAT partitions:" . join('', map { "\n  $_->{device} $_->{free} (" . ($min_linux + $min_swap + $min_freewin) . ")" } @fats) : '');
+    }
+
+    
+    if (my @ok_for_resize_fat = grep { isFat_or_NTFS($_) && !fs::get::part2hd($_, $all_hds)->{readonly} } @$fstab) {
+	$solutions{resize_fat} = 
+	  [ 6 - @ok_for_resize_fat, N("Use the free space on the Microsoft Windows® partition"),
+	    sub {
+		my $part = $in->ask_from_listf_raw({ messages => N("Which partition do you want to resize?"),
+						    interactive_help_id => 'resizeFATChoose',
+						  }, \&partition_table::description, \@ok_for_resize_fat) or return;
+		my $hd = fs::get::part2hd($part, $all_hds);
+		my $resize_fat = eval {
+		    my $pkg = $part->{fs_type} eq 'vfat' ? do { 
+			require resize_fat::main;
+			'resize_fat::main';
+		    } : do {
+			require diskdrake::resize_ntfs;
+			'diskdrake::resize_ntfs';
+		    };
+		    $pkg->new($part->{device}, devices::make($part->{device}));
+		};
+		$@ and die N("The FAT resizer is unable to handle your partition, 
+the following error occurred: %s", formatError($@));
+		my $min_win = do {
+		    my $_w = $in->wait_message(N("Resizing"), N("Computing the size of the Microsoft Windows® partition"));
+		    $resize_fat->min_size;
+		};
+		#- make sure that even after normalizing the size to cylinder boundaries, the minimun will be saved,
+		#- this save at least a cylinder (less than 8Mb).
+		$min_win += partition_table::raw::cylinder_size($hd);
+
+		$part->{size} > $min_linux + $min_swap + $min_freewin + $min_win or die N("Your Microsoft Windows® partition is too fragmented. Please reboot your computer under Microsoft Windows®, run the ``defrag'' utility, then restart the Mandriva Linux installation.");
+		$in->ask_okcancel('', formatAlaTeX(
+                                            #-PO: keep the double empty lines between sections, this is formatted a la LaTeX
+                                            N("WARNING!
+
+
+Your Microsoft Windows® partition will be now resized.
+
+
+Be careful: this operation is dangerous. If you have not already done so, you first need to exit the installation, run \"chkdsk c:\" from a Command Prompt under Microsoft Windows® (beware, running graphical program \"scandisk\" is not enough, be sure to use \"chkdsk\" in a Command Prompt!), optionally run defrag, then restart the installation. You should also backup your data.
+
+
+When sure, press %s.", N("Next")))) or return;
+
+		my $mb_size = $part->{size} >> 11;
+		$in->ask_from('', N("Which size do you want to keep for Microsoft Windows® on partition %s?", partition_table::description($part)), [
+                   { label => N("Size"), val => \$mb_size, min => $min_win >> 11, max => ($part->{size} - $min_linux - $min_swap) >> 11, type => 'range' },
+                ]) or return;
+
+		my $oldsize = $part->{size};
+		$part->{size} = from_Mb($mb_size, $min_win, $part->{size});
+
+		$hd->adjustEnd($part);
+
+		eval { 
+		    my $_w = $in->wait_message(N("Resizing"), N("Resizing Microsoft Windows® partition"));
+		    $resize_fat->resize($part->{size});
+		};
+		if (my $err = $@) {
+		    $part->{size} = $oldsize;
+		    die N("FAT resizing failed: %s", formatError($err));
+		}
+
+		$in->ask_warn('', N("To ensure data integrity after resizing the partition(s), 
+filesystem checks will be run on your next boot into Microsoft Windows®")) if $part->{fs_type} ne 'vfat';
+
+		set_isFormatted($part, 1);
+		partition_table::will_tell_kernel($hd, resize => $part); #- down-sizing, write_partitions is not needed
+		partition_table::adjust_local_extended($hd, $part);
+		partition_table::adjust_main_extended($hd);
+
+		fsedit::auto_allocate($all_hds, $partitions);
+		1;
+	    } ];
+    } else {
+	push @wizlog, N("There is no FAT partition to resize (or not enough space left)");
+    }
+
+    if (@$fstab && @hds_rw) {
+	$solutions{wipe_drive} =
+	  [ 10, fsedit::is_one_big_fat_or_NT($hds) ? N("Remove Microsoft Windows®") : N("Erase and use entire disk"), 
+	    sub {
+		my $hd = $in->ask_from_listf_raw({ messages => N("You have more than one hard drive, which one do you install linux on?"),
+						  title => N("Partitioning"),
+						  icon => 'banner-part',
+						  interactive_help_id => 'takeOverHdChoose',
+						},
+						\&partition_table::description, \@hds_rw) or return;
+		$in->ask_okcancel_({ messages => N("ALL existing partitions and their data will be lost on drive %s", partition_table::description($hd)),
+				    title => N("Partitioning"),
+				    icon => 'banner-part',
+				    interactive_help_id => 'takeOverHdConfirm' }) or return;
+		partition_table::raw::zero_MBR($hd);
+		fsedit::auto_allocate($all_hds, $partitions);
+		1;
+	    } ];
+    }
+
+    if (@hds_rw) {
+	$solutions{diskdrake} = [ 0, N("Custom disk partitioning"), sub {
+	    partition_with_diskdrake($in, $all_hds, $all_fstab, $manual_fstab, $partitions, $partitioning_flags, $skip_mtab);
+        } ];
+    }
+
+    $solutions{fdisk} =
+      [ -10, N("Use fdisk"), sub { 
+	    $in->enter_console;
+	    foreach (@$hds) {
+		print "\n" x 10, N("You can now partition %s.
+When you are done, do not forget to save using `w'", partition_table::description($_));
+		print "\n\n";
+		my $pid = 0;
+		if (arch() =~ /ppc/) {
+			$pid = fork() or exec "pdisk", devices::make($_->{device});
+		} else {
+			$pid = fork() or exec "fdisk", devices::make($_->{device});
+		}			
+		waitpid($pid, 0);
+	    }
+	    $in->leave_console;
+	    0;
+	} ] if $partitioning_flags->{fdisk};
+
+    log::l("partitioning wizard log:\n", (map { ">>wizlog>>$_\n" } @wizlog));
+    %solutions;
+}
+
+sub warn_reboot_needed {
+    my ($in) = @_;
+    $in->ask_warn(N("Partitioning"), N("You need to reboot for the partition table modifications to take place"), icon => 'banner-part');
+}
+
+sub main {
+    my ($o, $all_hds, $fstab, $manual_fstab, $partitions, $partitioning_flags, $skip_mtab, $b_nodiskdrake) = @_;
+
+    my %solutions = partitionWizardSolutions($o, $all_hds, $fstab, $manual_fstab, $partitions, $partitioning_flags, $skip_mtab);
+
+    delete $solutions{diskdrake} if $b_nodiskdrake;
+
+    my @solutions = sort { $b->[0] <=> $a->[0] } values %solutions;
+
+    my @sol = grep { $_->[0] >= 0 } @solutions;
+
+    log::l(''  . "solutions found: " . join('', map { $_->[1] } @sol) . 
+	   " (all solutions found: " . join('', map { $_->[1] } @solutions) . ")");
+
+    @solutions = @sol if @sol > 1;
+    log::l("solutions: ", int @solutions);
+    @solutions or $o->ask_warn(N("Partitioning"), N("I can not find any room for installing"), icon => 'banner-part'), die 'already displayed';
+
+    log::l('HERE: ', join(',', map { $_->[1] } @solutions));
+    my $sol;
+    $o->ask_from_({ messages => N("The DrakX Partitioning wizard found the following solutions:"),
+		    title => N("Partitioning"),
+		    icon => 'banner-part',
+		    interactive_help_id => 'doPartitionDisks',
+		  }, 
+		  [ { val => \$sol, list => \@solutions, format => sub { $_[0][1] }, type => 'list' } ]);
+    log::l("partitionWizard calling solution $sol->[1]");
+    my $ok = eval { $sol->[2]->() };
+    $@ and $o->ask_warn('', N("Partitioning failed: %s", formatError($@)));
+    $ok or goto &main;
+    1;
+}
+
+1;
diff --git a/perl-install/fs/proc_partitions.pm b/perl-install/fs/proc_partitions.pm
new file mode 100644
index 000000000..f789b1862
--- /dev/null
+++ b/perl-install/fs/proc_partitions.pm
@@ -0,0 +1,73 @@
+package fs::proc_partitions; # $Id: proc_partitions.pm 37644 2006-06-20 08:38:59Z pixel $
+
+use common;
+
+
+sub read_raw() {
+    my (undef, undef, @all) = cat_("/proc/partitions");
+    grep {
+	$_->{size} != 1 &&	  # skip main extended partition
+	$_->{size} != 0x3fffffff; # skip cdroms (otherwise stops cd-audios)
+    } map { 
+	my %l; 
+	@l{qw(major minor size dev)} = split; 
+	\%l;
+    } @all;
+}
+
+sub read {
+    my ($hds) = @_;
+
+    my @all = read_raw();
+    my ($parts, $_disks) = partition { $_->{dev} =~ /\d$/ && $_->{dev} !~ /^(sr|scd)/ } @all;
+
+    fs::get_major_minor($hds);
+
+    my $prev_part;
+    foreach my $part (@$parts) {
+	my $dev = $part->{dev};
+	if (my $hd = find { $part->{dev} =~ /^\Q$_->{device}\E./ } @$hds) {
+	    put_in_hash($part, partition_table::hd2minimal_part($hd));
+	}
+	
+	undef $prev_part if $prev_part && ($prev_part->{rootDevice} || '') ne ($part->{rootDevice} || '');
+
+	$part->{device} = $dev;
+	$part->{size} *= 2;	# from KB to sectors
+	$part->{start} = $prev_part ? $prev_part->{start} + $prev_part->{size} : 0;
+	require fs::type;
+	put_in_hash($part, fs::type::type_subpart_from_magic($part));
+	$prev_part = $part;
+	delete $part->{dev}; # cleanup
+    }
+    @$parts;
+}
+
+sub compare {
+    my ($hd) = @_;
+
+    my @l1 = partition_table::get_normal_parts($hd);
+    my @l2 = grep { $_->{rootDevice} eq $hd->{device} } &read([$hd]);
+
+    #- /proc/partitions includes partition with type "empty" and a non-null size
+    #- so add them for comparison
+    my ($len1, $len2) = (int(@l1) + $hd->{primary}{nb_special_empty}, int(@l2));
+
+    if ($len1 != $len2 && arch() ne 'ppc') {
+	die sprintf(
+		    "/proc/partitions does not agree with drakx %d != %d:\n%s\n", $len1, $len2,
+		    "/proc/partitions: " . join(", ", map { "$_->{device} ($_->{rootDevice})" } @l2));
+    }
+    $len2;
+}
+
+sub use_ {
+    my ($hd) = @_;
+    
+    partition_table::raw::zero_MBR($hd);
+    $hd->{readonly} = 1;
+    $hd->{getting_rid_of_readonly_allowed} = 1;
+    $hd->{primary} = { normal => [ grep { $_->{rootDevice} eq $hd->{device} } &read([$hd]) ] };
+}
+
+1;
diff --git a/perl-install/fs/remote.pm b/perl-install/fs/remote.pm
new file mode 100644
index 000000000..f59a79605
--- /dev/null
+++ b/perl-install/fs/remote.pm
@@ -0,0 +1,45 @@
+package fs::remote; # $Id: remote.pm 88802 2006-11-29 21:37:52Z blino $
+
+use strict;
+use diagnostics;
+
+use fs::mount_options;
+
+
+sub new { 
+    my ($class, $o_v) = @_;
+    bless($o_v || {}, $class);
+}
+
+sub server_to_string {
+    my ($_class, $server) = @_;
+    $server->{name} || $server->{ip};
+}
+sub comment_to_string {
+    my ($_class, $comment) = @_;
+    $comment;
+}
+sub to_dev {
+    my ($class, $e) = @_;
+    $class->to_dev_raw($class->server_to_string($e->{server}), $e->{name} || $e->{ip});
+}
+sub to_string {
+    my ($class, $e) = @_;
+    my $comment = $class->comment_to_string($e->{comment});
+    ($e->{name} || $e->{ip}) . ($comment ? " ($comment)" : '');
+}
+
+sub to_fullstring {
+    my ($class, $e) = @_;
+    my $comment = $class->comment_to_string($e->{comment});
+    $class->to_dev($e) . ($comment ? " ($comment)" : '');
+}
+sub to_fstab_entry_raw {
+    my ($class, $e, $fs_type) = @_;
+    my $fs_entry = { device => $class->to_dev($e), fs_type => $fs_type };
+    fs::mount_options::set_default($fs_entry);
+    $fs_entry;
+}
+
+1;
+
diff --git a/perl-install/fs/remote/nfs.pm b/perl-install/fs/remote/nfs.pm
new file mode 100644
index 000000000..1faa5f80e
--- /dev/null
+++ b/perl-install/fs/remote/nfs.pm
@@ -0,0 +1,68 @@
+package fs::remote::nfs; # $Id: nfs.pm 88802 2006-11-29 21:37:52Z blino $
+
+use strict;
+use diagnostics;
+
+use common;
+use fs::remote;
+use log;
+
+our @ISA = 'fs::remote';
+
+sub to_fstab_entry {
+    my ($class, $e) = @_;
+    $class->to_fstab_entry_raw($e, 'nfs');
+}
+sub comment_to_string {
+    my ($_class, $comment) = @_;
+    member($comment, qw(* 0.0.0.0/0.0.0.0 (everyone))) ? '' : $comment;
+}
+sub from_dev { 
+    my ($_class, $dev) = @_;
+    $dev =~ m|(.*?):(.*)|;
+}
+sub to_dev_raw {
+    my ($_class, $server, $name) = @_;
+    $server . ':' . $name;
+}
+
+sub check {
+    my ($_class, $in) = @_;
+    $in->do_pkgs->ensure_binary_is_installed('nfs-utils-clients', 'showmount') or return;
+    system('/etc/init.d/portmap start') if system('/etc/init.d/portmap status') != 0;
+    1;
+}
+
+sub find_servers {
+    open(my $F2, "rpcinfo-flushed -b mountd 2 |");
+    open(my $F3, "rpcinfo-flushed -b mountd 3 |");
+
+    common::nonblock($F2);
+    common::nonblock($F3);
+    my $domain = chomp_(`domainname`);
+    my ($s, %servers);
+    my $quit;
+    while (!$quit) {
+	$quit = 1;
+	sleep 1;
+	while ($s = <$F2> || <$F3>) {
+	    $quit = 0;
+	    my ($ip, $name) = $s =~ /(\S+)\s+(\S+)/ or log::explanations("bad line in rpcinfo output"), next;
+	    $name =~ s/\.$//;
+	    $name =~ s/\Q.$domain\E$//;
+	    $servers{$ip} ||= { ip => $ip, if_($name ne '(unknown)', name => $name) };
+	}
+    }
+    values %servers;
+}
+
+sub find_exports {
+    my ($_class, $server) = @_;
+
+    my @l;
+    run_program::raw({ timeout => 1 }, "showmount", '>', \@l, "--no-headers", "-e", $server->{ip} || $server->{name});
+
+    map { if_(/(\S+(\s*\S+)*)\s+(\S+)/, { name => $1, comment => $3, server => $server }) } @l;
+}
+
+1;
diff --git a/perl-install/fs/remote/smb.pm b/perl-install/fs/remote/smb.pm
new file mode 100644
index 000000000..1ba0e61b7
--- /dev/null
+++ b/perl-install/fs/remote/smb.pm
@@ -0,0 +1,217 @@
+package fs::remote::smb; # $Id: smb.pm 88802 2006-11-29 21:37:52Z blino $
+
+use strict;
+use diagnostics;
+
+use common;
+use fs::mount_options;
+use network::network;
+use fs::remote;
+
+
+our @ISA = 'fs::remote';
+
+sub to_fstab_entry {
+    my ($class, $e) = @_;
+    my $part = $class->to_fstab_entry_raw($e, 'smbfs');
+    if ($e->{server}{username}) {
+	my ($options, $unknown) = fs::mount_options::unpack($part);
+	$options->{"$_="} = $e->{server}{$_} foreach qw(username password domain);
+	fs::mount_options::pack($part, $options, $unknown);
+    }
+    $part;
+}
+sub from_dev { 
+    my ($_class, $dev) = @_;
+    $dev =~ m|//(.*?)/(.*)|;
+}
+sub to_dev_raw {
+    my ($_class, $server, $name) = @_;
+    '//' . $server . '/' . $name;
+}
+
+sub check {
+    my ($_class, $in) = @_;
+    $in->do_pkgs->ensure_binary_is_installed('samba-client', 'nmblookup');
+}
+
+sub smbclient {
+    my ($server) = @_;
+    my $name  = $server->{name} || $server->{ip};
+    my $ip    = $server->{ip} ? "-I $server->{ip}" : '';
+    my $group = $server->{group} ? qq( -W "$server->{group}") : '';
+
+    my $U = $server->{username} ? sprintf("%s/%s%%%s", @$server{'domain', 'username', 'password'}) : '%';
+    my %h;
+    foreach (`smbclient -g -U "$U" -L "$name" $ip$group 2>/dev/null`) {
+	if (my ($type, $v1, $v2) = /(.*)\|(.*)\|(.*)/) {
+	    push @{$h{$type}}, [ $v1, $v2 ];
+	} elsif (/^Error returning browse list/) {
+	    push @{$h{Error}}, $_;
+	}
+    }
+    \%h;
+}
+
+sub find_servers {
+    my (undef, @l) = `nmblookup "*"`;
+    s/\s.*\n// foreach @l;
+    my @servers = grep { network::network::is_ip($_) } @l;
+    my %servers;
+    $servers{$_}{ip} = $_ foreach @servers;
+    my ($ip, $browse);
+    foreach (`nmblookup -A @servers`) {
+	my $nb = /^Looking up status of (\S+)/ .. /^$/ or next;
+	if ($nb == 1) {
+	    $ip = $1;
+	} elsif (/<00>/) {
+	    $servers{$ip}{/<GROUP>/ ? 'group' : 'name'} ||= lc first(/(\S+)/);
+	} elsif (/__MSBROWSE__/) {
+	    $browse ||= $servers{$ip};
+	}
+    }
+    if ($browse) {
+	my %l;
+	my $workgroups = smbclient($browse)->{Workgroup} || [];
+	foreach (@$workgroups) {
+	    my ($group, $name) = map { lc($_) } @$_;
+
+	    # already done
+	    next if any { $group eq $_->{group} } values %servers;
+
+	    $l{$name} = $group;
+	}
+	if (my @l = keys %l) {
+	    foreach (`nmblookup @l`) {
+		$servers{$1} = { name => $2, group => $l{$2} } if /(\S+)\s+([^<]+)<00>/;
+	    }
+	}
+    }
+    values %servers;
+}
+
+sub find_exports {
+    my ($_class, $server) = @_;
+    my @l;
+
+    my $browse = smbclient($server);
+    if (my $err = find { /NT_STATUS_/ } @{$browse->{Error} || []}) {
+	die $err;
+    }
+    foreach (@{$browse->{Disk} || []}) {
+	my ($name, $comment) = @$_;
+	push @l, { name => $name, type => 'Disk', comment => $comment, server => $server }
+	  if $name !~ /\$$/ && $name !~ /netlogon|NETLOGON|SYSVOL/;
+    }
+    @l;
+}
+
+sub authentications_available {
+    my ($server) = @_;
+    map { if_(/^auth.\Q$server->{name}.\E(.*)/, $1) } all("/etc/samba");
+}
+
+sub to_credentials {
+    my ($server_name, $username) = @_;
+    $username or die 'to_credentials';
+    "/etc/samba/auth.$server_name.$username";
+}
+
+sub fstab_entry_to_credentials {
+    my ($part) = @_;    
+
+    my ($server_name) = fs::remote::smb->from_dev($part->{device}) or return;
+
+    my ($options, $unknown) = fs::mount_options::unpack($part);
+    $options->{'username='} && $options->{'password='} or return;
+    my %h = map { $_ => delete $options->{"$_="} } qw(username domain password);
+    $h{file} = $options->{'credentials='} = to_credentials($server_name, $h{username});
+    fs::mount_options::pack_($part, $options, $unknown), \%h;
+}
+
+sub remove_bad_credentials {
+    my ($server) = @_;
+    unlink to_credentials($server->{name}, $server->{username});
+}
+
+sub save_credentials {
+    my ($credentials) = @_;
+    my $file = $credentials->{file};
+    output_with_perm("$::prefix$file", 0640, map { "$_ = $credentials->{$_}\n" } qw(username domain password));
+}
+
+
+sub read_credentials_raw {
+    my ($file) = @_;
+    my %h = map { /(.*?)\s*=\s*(.*)/ } cat_("$::prefix$file");
+    \%h;
+}
+
+sub read_credentials {
+    my ($server, $username) = @_;
+    put_in_hash($server, read_credentials_raw(to_credentials($server->{name}, $username)));
+}
+
+
+sub write_smb_conf {
+    my ($domain) = @_;
+
+    #- was going to just have a canned config in samba-winbind
+    #- and replace the domain, but sylvestre/buchan did not bless it yet
+
+    my $f = "$::prefix/etc/samba/smb.conf";
+    rename $f, "$f.orig";
+    output($f, "
+[global]
+	workgroup = $domain  
+	server string = Samba Server %v
+	security = domain  
+	encrypt passwords = Yes
+	password server = *
+	log file = /var/log/samba/log.%m
+	max log size = 50
+	socket options = TCP_NODELAY SO_RCVBUF=8192 SO_SNDBUF=8192
+	unix charset = ISO8859-15
+	os level = 18
+	local master = No
+	dns proxy = No
+	idmap uid = 10000-20000
+	idmap gid = 10000-20000
+	winbind separator = +
+	template homedir = /home/%D/%U
+	template shell = /bin/bash
+	winbind use default domain = yes
+");
+}
+
+sub write_smb_ads_conf {
+    my ($domain, $realm) = @_;
+
+    #- was going to just have a canned config in samba-winbind
+    #- and replace the domain, but sylvestre/buchan did not bless it yet
+
+    my $f = "$::prefix/etc/samba/smb.conf";
+    rename $f, "$f.orig";
+    output($f, "
+[global]
+        workgroup = $domain
+        realm  = $realm
+        server string = Samba Member %v
+        security = ads
+        encrypt passwords = Yes
+        password server = *
+        log file = /var/log/samba/log.%m
+        max log size = 50
+        socket options = TCP_NODELAY SO_RCVBUF=8192 SO_SNDBUF=8192
+        os level = 18
+        local master = No
+        dns proxy = No
+        winbind uid = 10000-20000
+        winbind gid = 10000-20000
+        winbind separator = +
+        template homedir = /home/%D/%U
+        template shell = /bin/bash
+        winbind use default domain = yes
+");
+}
+1;
diff --git a/perl-install/fs/type.pm b/perl-install/fs/type.pm
new file mode 100644
index 000000000..ea9b14f82
--- /dev/null
+++ b/perl-install/fs/type.pm
@@ -0,0 +1,384 @@
+package fs::type; # $Id: type.pm 147413 2007-03-21 16:50:10Z pixel $
+
+use diagnostics;
+use strict;
+
+use common;
+use devices;
+
+
+our @ISA = qw(Exporter);
+our @EXPORT = qw(
+   isEmpty isExtended isTrueLocalFS isTrueFS isDos isSwap isOtherAvailableFS isRawLVM isRawRAID isRAID isLVM isMountableRW isNonMountable isPartOfLVM isPartOfRAID isPartOfLoopback isLoopback isMounted isBusy isSpecial isApple isAppleBootstrap isWholedisk isFat_or_NTFS
+   maybeFormatted set_isFormatted
+);
+
+
+my (%type_name2pt_type, %type_name2fs_type, %fs_type2pt_type, %pt_type2fs_type, %type_names);
+
+{
+    my @list_types = (
+	important => [
+  0x82 => 'swap',     'Linux swap',
+  0x83 => 'ext2',     'Linux native',
+  0x83 => 'ext3',     'Journalised FS: ext3',
+  0x83 => 'reiserfs', 'Journalised FS: ReiserFS',
+if_(arch() =~ /ppc|i.86|ia64|x86_64/, 
+  0x83 => 'xfs',      'Journalised FS: XFS',
+),
+if_(arch() =~ /ppc|i.86|x86_64/, 
+  0x83 => 'jfs',      'Journalised FS: JFS',
+),
+if_(arch() =~ /i.86|ia64|x86_64/,
+  0x0b => 'vfat',     'FAT32',
+  0x07 => 'ntfs',     'NTFS',
+  0x07 => 'ntfs-3g',  'NTFS-3G',
+),
+if_(arch() =~ /ppc/,
+  0x401	=> '',         'Apple Bootstrap',
+  0x402	=> 'hfs',      'Apple HFS Partition',
+  0x41  => '',         'PPC PReP Boot',
+),
+	],
+
+        less_important => [
+  0x8e => '',         'Linux Logical Volume Manager',
+  0xfd => '',         'Linux RAID',
+	],
+
+	special => [
+  0x0  => '',         'Empty',
+  0x05 => '',         'Extended',
+  0x0f => '',         'W95 Extended (LBA)',
+  0x85 => '',         'Linux extended',
+	],
+
+        backward_compatibility => [
+  0x183 => 'reiserfs', 'reiserfs (deprecated)',
+  0x283 => 'xfs',      'xfs (deprecated)',
+  0x383 => 'jfs',      'jfs (deprecated)',
+  0x483 => 'ext3',     'ext3 (deprecated)',
+	],
+
+	other => [
+ if_(arch() =~ /^ia64/,
+  0x100 => '',         'Various',
+), if_(arch() =~ /^ppc/,
+  0x401	=> 'apple',    'Apple Partition',
+), if_(arch() =~ /^sparc/,
+  0x01 => 'ufs',      'SunOS boot',
+  0x02 => 'ufs',      'SunOS root',
+  0x03 => '',      'SunOS swap',
+  0x04 => 'ufs',      'SunOS usr',
+  0x05 => '',      'Whole disk',
+  0x06 => 'ufs',      'SunOS stand',
+  0x07 => 'ufs',      'SunOS var',
+  0x08 => 'ufs',      'SunOS home',
+), if_(arch() =~ /^i.86|x86_64/,
+  0x01 => 'vfat',     'FAT12',
+  0x02 => '',         'XENIX root',
+  0x03 => '',         'XENIX usr',
+  0x04 => 'vfat',     'FAT16 <32M',
+  0x06 => 'vfat',     'FAT16',
+  0x07 => 'hpfs',     'HPFS',
+  0x08 => '',         'AIX',
+),
+  0x09 => '',         'AIX bootable',
+  0x0a => '',         'OS/2 Boot Manager',
+  0x0c => 'vfat',     'W95 FAT32 (LBA)',
+  0x0e => 'vfat',     'W95 FAT16 (LBA)',
+  0x10 => '',         'OPUS',
+  0x11 => '',         'Hidden FAT12',
+  0x12 => '',         'Compaq diagnostics',
+  0x14 => '',         'Hidden FAT16 <32M',
+  0x16 => '',         'Hidden FAT16',
+  0x17 => 'ntfs',     'Hidden HPFS/NTFS',
+  0x18 => '',         'AST SmartSleep',
+  0x1b => 'vfat',     'Hidden W95 FAT32',
+  0x1c => 'vfat',     'Hidden W95 FAT32 (LBA)',
+  0x1e => 'vfat',     'Hidden W95 FAT16 (LBA)',
+  0x24 => '',         'NEC DOS',
+  0x39 => '',         'Plan 9',
+  0x3c => '',         'PartitionMagic recovery',
+  0x40 => '',         'Venix 80286',
+if_(arch() !~ /ppc/,
+  0x41 => '',         'PPC PReP Boot',
+),
+  0x42 => '',         'SFS',
+  0x4d => '',         'QNX4.x',
+  0x4e => '',         'QNX4.x 2nd part',
+  0x4f => '',         'QNX4.x 3rd part',
+  0x50 => '',         'OnTrack DM',
+  0x51 => '',         'OnTrack DM6 Aux1',
+  0x52 => '',         'CP/M',
+  0x53 => '',         'OnTrack DM6 Aux3',
+  0x54 => '',         'OnTrackDM6',
+  0x55 => '',         'EZ-Drive',
+  0x56 => '',         'Golden Bow',
+  0x5c => '',         'Priam Edisk',
+  0x61 => '',         'SpeedStor',
+  0x63 => '',         'GNU HURD or SysV',
+  0x64 => '',         'Novell Netware 286',
+  0x65 => '',         'Novell Netware 386',
+  0x70 => '',         'DiskSecure Multi-Boot',
+  0x75 => '',         'PC/IX',
+  0x80 => '',         'Old Minix',
+  0x81 => '',         'Minix / old Linux',
+ if_(!$::isInstall,
+  0x83 => 'reiser4',  'Journalised FS: Reiser4',
+ ),
+  0x84 => '',         'OS/2 hidden C: drive',
+  0x86 => '',         'NTFS volume set',
+  0x87 => '',         'NTFS volume set ',
+  0x93 => '',         'Amoeba',
+  0x94 => '',         'Amoeba BBT',
+  0x9f => '',         'BSD/OS',
+  0xa0 => '',         'IBM Thinkpad hibernation',
+  0xa5 => '',         'FreeBSD',
+  0xa6 => '',         'OpenBSD',
+  0xa7 => '',         'NeXTSTEP',
+  0xa8 => '',         'Darwin UFS',
+  0xa9 => '',         'NetBSD',
+  0xab => '',         'Darwin boot',
+  0xb7 => '',         'BSDI fs',
+  0xb8 => '',         'BSDI swap',
+  0xbb => '',         'Boot Wizard hidden',
+  0xbe => '',         'Solaris boot',
+  0xbf => '',         'Microsoft XBox OS Partitions',
+  0xc1 => '',         'DRDOS/sec (FAT-12)',
+  0xc4 => '',         'DRDOS/sec (FAT-16 < 32M)',
+  0xc6 => '',         'DRDOS/sec (FAT-16)',
+  0xc7 => '',         'Syrinx',
+  0xda => '',         'Non-FS data',
+  0xdb => '',         'CP/M / CTOS / ...',
+  0xde => '',         'Dell Utility',
+  0xdf => '',         'BootIt',
+  0xe1 => '',         'SpeedStor (FAT-12)',
+  0xe3 => '',         'DOS R/O',
+  0xe4 => '',         'SpeedStor (FAT-16)',
+  0xeb => 'befs',     'BeOS fs',
+  0xee => '',         'EFI GPT',
+  0xef => 'vfat',     'EFI (FAT-12/16/32)',
+  0xf0 => '',         'Linux/PA-RISC boot',
+  0xf4 => '',         'SpeedStor (large part.)',
+  0xf2 => '',         'DOS secondary',
+  0xfe => '',         'LANstep',
+  0xff => '',         'BBT',
+	],
+    );
+
+    foreach (group_by2(@list_types)) {
+	my ($name, $l) = @$_;
+	for (my $i = 0; defined $l->[$i]; $i += 3) {
+	    my $pt_type   = $l->[$i];
+	    my $fs_type   = $l->[$i + 1];
+	    my $type_name = $l->[$i + 2];
+	    !exists $type_name2fs_type{$type_name} or internal_error("'$type_name' is not unique");
+	    $type_name2fs_type{$type_name} = $fs_type;
+	    $type_name2pt_type{$type_name} = $pt_type;
+
+	    $fs_type2pt_type{$fs_type} ||= $pt_type;
+	    $pt_type2fs_type{$pt_type} ||= $fs_type;
+	    push @{$type_names{$name}}, $type_name;
+	}
+    }
+}
+
+
+sub type_names { 
+    my ($expert) = @_;
+    my @l = @{$type_names{important}};
+    push @l, @{$type_names{less_important}}, sort @{$type_names{other}} if $expert;
+    @l;
+}
+
+sub type_name2subpart {
+    my ($name) = @_;
+    exists $type_name2fs_type{$name} && 
+      { fs_type => $type_name2fs_type{$name}, pt_type => $type_name2pt_type{$name} };
+}
+
+sub part2type_name { 
+    my ($part) = @_;
+    my @names = keys %type_name2fs_type;
+   
+    my $pt_type = defined $part->{pt_type} ? $part->{pt_type} : $part->{fs_type} && $fs_type2pt_type{$part->{fs_type}};
+    if (defined $pt_type) {
+	@names = grep { $pt_type eq $type_name2pt_type{$_} } @names;
+    }
+    if (my $fs_type = $part->{fs_type} || $part->{pt_type} && $pt_type2fs_type{$part->{pt_type}}) {
+	@names = grep { $fs_type eq $type_name2fs_type{$_} } @names;
+    }
+    if (@names > 1) {
+	log::l("ERROR: (part2type_name) multiple match for $part->{pt_type} $part->{fs_type}");
+    }
+    first(@names);
+}
+sub type_name2pt_type { 
+    local ($_) = @_;
+    /0x(.*)/ ? hex $1 : $type_name2pt_type{$_} || $_;
+}
+
+
+sub pt_type2subpart {
+    my ($pt_type) = @_;
+    my $fs_type = $pt_type2fs_type{$pt_type};
+    { pt_type => $pt_type, if_($fs_type, fs_type => $fs_type) };
+}
+sub fs_type2subpart {
+    my ($fs_type) = @_;
+    my $pt_type = $fs_type2pt_type{$fs_type};
+    { fs_type => $fs_type, if_($pt_type, pt_type => $pt_type) };
+}
+sub set_fs_type {
+    my ($part, $fs_type) = @_;
+    put_in_hash($part, fs_type2subpart($fs_type));
+}
+sub set_pt_type {
+    my ($part, $pt_type) = @_;
+    put_in_hash($part, pt_type2subpart($pt_type));
+}
+sub suggest_fs_type {
+    my ($part, $fs_type) = @_;
+    set_fs_type($part, $fs_type) if !$part->{pt_type} && !$part->{fs_type};
+}
+sub set_type_subpart {
+    my ($part, $subpart) = @_;
+    if (exists $subpart->{pt_type} && exists $subpart->{fs_type}) {
+	$part->{fs_type} = $subpart->{fs_type};
+	$part->{pt_type} = $subpart->{pt_type};
+    } elsif (exists $subpart->{pt_type}) {
+	set_pt_type($part, $subpart->{pt_type});
+    } elsif (exists $subpart->{fs_type}) {
+	set_fs_type($part, $subpart->{fs_type});
+    } else {
+	log::l("ERROR: (set_type_subpart) subpart has no type");
+    }
+}
+
+sub fs_type_from_magic {
+    my ($part) = @_;
+    if (exists $part->{fs_type_from_magic}) {
+	$part->{fs_type_from_magic};
+    } else {
+	my $type = type_subpart_from_magic($part);
+	$type && $type->{fs_type};
+    }
+}
+
+sub call_vol_id {
+    my ($part) = @_;
+
+    my %h = map {
+	if_(/(.*?)=(.*)/, $1 => $2);
+    } run_program::get_stdout('vol_id', devices::make($part->{device}));
+
+    \%h;
+}
+
+sub type_subpart_from_magic { 
+    my ($part) = @_;
+    my $ids = call_vol_id($part);
+
+    $part->{LABEL_from_magic} = $ids->{ID_FS_LABEL} if $ids->{ID_FS_LABEL};
+
+    my $p;
+    if ($ids->{ID_FS_USAGE} eq 'raid') {
+	my $name = {
+	    linux_raid_member => "Linux RAID",
+	    LVM1_member => 'Linux Logical Volume Manager',
+	    LVM2_member => 'Linux Logical Volume Manager',
+	}->{$ids->{ID_FS_TYPE}};
+
+	$p = type_name2subpart($name) if $name;
+    } elsif ($ids->{ID_FS_TYPE}) {
+	$p = fs_type2subpart($ids->{ID_FS_TYPE}) or log::l("unknown filesystem $ids->{ID_FS_TYPE} returned by vol_id");
+    }
+
+    if ($p) {
+	$part->{fs_type_from_magic} = $p->{fs_type};
+    }
+    $p;
+}
+
+sub true_local_fs_types() { qw(ext3 ext2 reiserfs reiser4 xfs jfs) }
+
+sub isEmpty { !$_[0]{fs_type} && $_[0]{pt_type} == 0 }
+sub isEfi { arch() =~ /ia64/ && $_[0]{pt_type} == 0xef }
+sub isWholedisk { arch() =~ /^sparc/ && $_[0]{pt_type} == 5 }
+sub isExtended { arch() !~ /^sparc/ && ($_[0]{pt_type} == 5 || $_[0]{pt_type} == 0xf || $_[0]{pt_type} == 0x85) }
+sub isRawLVM { $_[0]{pt_type} == 0x8e }
+sub isRawRAID { $_[0]{pt_type} == 0xfd }
+sub isSwap { $_[0]{fs_type} eq 'swap' }
+sub isDos { arch() !~ /^sparc/ && ${{ 1 => 1, 4 => 1, 6 => 1 }}{$_[0]{pt_type}} }
+sub isFat_or_NTFS { member($_[0]{fs_type}, 'vfat', 'ntfs', 'ntfs-3g') }
+sub isApple { $_[0]{pt_type} == 0x401 && defined $_[0]{isDriver} }
+sub isAppleBootstrap { $_[0]{pt_type} == 0x401 && defined $_[0]{isBoot} }
+
+sub isTrueFS { isTrueLocalFS($_[0]) || member($_[0]{fs_type}, qw(nfs)) }
+sub isTrueLocalFS { member($_[0]{fs_type}, true_local_fs_types()) }
+
+sub isOtherAvailableFS { isEfi($_[0]) || isFat_or_NTFS($_[0]) || member($_[0]{fs_type}, 'ufs', 'hfs', 'iso9660') } #- other OS that linux can access its filesystem
+sub isMountableRW { (isTrueFS($_[0]) || isOtherAvailableFS($_[0])) && $_[0]{fs_type} ne 'ntfs' }
+sub isNonMountable { 
+    my ($part) = @_;
+    isRawRAID($part) || isRawLVM($part) || $part->{fs_type} eq 'ntfs' && !$part->{isFormatted} && $part->{notFormatted};
+}
+
+sub isPartOfLVM { defined $_[0]{lvm} }
+sub isPartOfRAID { defined $_[0]{raid} }
+sub isPartOfLoopback { defined $_[0]{loopback} }
+sub isRAID { $_[0]{device} =~ /^md/ }
+sub isUBD { $_[0]{device} =~ /^ubd/ } #- should be always true during an $::uml_install
+sub isLVM { $_[0]{VG_name} || $_[0]{lv_name} }
+sub isLoopback { defined $_[0]{loopback_file} }
+sub isMounted { $_[0]{isMounted} }
+sub isBusy { isMounted($_[0]) || isPartOfRAID($_[0]) || isPartOfLVM($_[0]) || isPartOfLoopback($_[0]) }
+sub isSpecial { isRAID($_[0]) || isLVM($_[0]) || isLoopback($_[0]) || isUBD($_[0]) }
+
+#- not for partitions, but for hds:
+sub is_dmraid { $_[0]{bus} =~ /^dmraid_/ }
+
+sub can_be_this_fs_type {
+    my ($part, $fs_type) = @_;
+    can_be_one_of_those_fs_types($part, $fs_type);
+}
+sub can_be_one_of_those_fs_types {
+    my ($part, @fs_types) = @_;
+    $part->{fs_type} or return;
+    $part->{fs_type} eq 'auto' || listlength(intersection(\@fs_types, [ split(':', $part->{fs_type}) ]));
+}
+
+sub maybeFormatted { 
+    my ($part) = @_;
+    $part->{isFormatted} || !$part->{notFormatted} && (!$part->{bad_fs_type_magic} || $part->{options} =~ /encrypted/);
+}
+sub set_isFormatted {
+    my ($part, $val) = @_;
+    $part->{isFormatted} = $val;
+    $part->{notFormatted} = !$val;
+    delete $part->{bad_fs_type_magic};
+    delete $part->{fs_type_from_magic};
+}
+
+#- do this before modifying $part->{fs_type}
+sub check {
+    my ($fs_type, $_hd, $part) = @_;
+    $fs_type eq "jfs" && $part->{size} < 16 << 11 and die N("You can not use JFS for partitions smaller than 16MB");
+    $fs_type eq "reiserfs" && $part->{size} < 32 << 11 and die N("You can not use ReiserFS for partitions smaller than 32MB");
+}
+
+sub guessed_by_mount() {
+    grep { $_ && !/nodev/ } chomp_(cat_('/etc/filesystems'));
+}
+
+sub directories_needed_to_boot() { 
+    qw(/ /usr /var /boot /tmp);
+}
+
+sub carry_root_loopback {
+    my ($part) = @_;
+    any { $_->{mntpoint} eq '/' } @{$part->{loopback} || []};
+}
+
+1;
diff --git a/perl-install/fs/wild_device.pm b/perl-install/fs/wild_device.pm
new file mode 100644
index 000000000..f95c552ba
--- /dev/null
+++ b/perl-install/fs/wild_device.pm
@@ -0,0 +1,102 @@
+package fs::wild_device; # $Id: wild_device.pm 56211 2006-08-15 14:55:42Z pixel $
+
+use diagnostics;
+use strict;
+
+use common;
+
+
+sub analyze {
+    my ($dev) = @_;
+
+    if ($dev =~ m!^/u?dev/(.*)!) {
+	'dev', $dev;
+    } elsif ($dev !~ m!^/! && (-e "/dev/$dev" || -e "$::prefix/dev/$dev")) {
+	'dev', "/dev/$dev";
+    } elsif ($dev =~ /^LABEL=(.*)/) {
+	'label', $1;
+    } elsif ($dev eq 'none' || $dev eq 'rootfs') {
+	'virtual';
+    } elsif ($dev =~ m!^(\S+):/\w!) {
+	'nfs';
+    } elsif ($dev =~ m!^//\w!) {
+	'smb';
+    } elsif ($dev =~ m!^http://!) {
+	'dav';
+    }
+}
+
+sub to_subpart {
+    my ($dev) = @_;
+
+    my $part = { device => $dev, faked_device => 1 }; #- default
+
+    if (my ($kind, $val) = analyze($dev)) {
+	if ($kind eq 'label') {	    
+	    $part->{device_LABEL} = $val;
+	} elsif ($kind eq 'dev') {
+	    my %part = (faked_device => 0);
+	    if (my $rdev = (stat "$::prefix$dev")[6]) {
+		($part{major}, $part{minor}) = unmakedev($rdev);
+	    }
+
+	    my $symlink = readlink("$::prefix$dev");
+	    $dev =~ s!/u?dev/!!;
+
+	    if ($symlink && $symlink !~ m!^/!) {
+		my $keep = 1;
+		if ($symlink =~ m!/!) {
+		    $symlink = MDK::Common::File::concat_symlink("/dev/" . dirname($dev), $symlink);
+		    $symlink =~ s!^/dev/!! or $keep = 0;
+		}
+		if ($keep) {
+		    $part{device_LABEL} = $1 if $dev =~  m!^disk/by-label/(.*)!;
+		    $part{device_alias} = $dev;
+		    $dev = $symlink;
+		}
+	    }
+	    if (my $part_number = devices::part_number(\%part)) {
+		$part{part_number} = $part_number;
+	    }
+	    $part{device} = $dev;
+	    return \%part;
+	}
+    } else {
+	if ($dev =~ m!^/! && -f "$::prefix$dev") {
+	    #- it must be a loopback file or directory to bind
+	} else {
+	    log::l("part_from_wild_device_name: unknown device $dev");
+	}
+    }
+    $part;
+}
+
+sub from_part {
+    my ($prefix, $part) = @_;
+
+    if ($part->{prefer_device_LABEL}) {
+	'LABEL=' . $part->{device_LABEL};
+    } elsif ($part->{device_alias}) {
+	"/dev/$part->{device_alias}";
+    } else {
+	my $faked_device = exists $part->{faked_device} ? 
+	    $part->{faked_device} : 
+	    do {
+		#- in case $part has been created without using fs::wild_device::to_subpart()
+		my ($kind) = analyze($part->{device});
+		$kind ? $kind ne 'dev' : $part->{device} =~ m!^/!;
+	    };
+	if ($faked_device) {
+	    $part->{device};
+	} elsif ($part->{device} =~ m!^/dev/!) {
+	    log::l("ERROR: i have a full device $part->{device}, this should not happen. use fs::wild_device::to_subpart() instead of creating bad part data-structures!");
+	    $part->{device};
+	} else {
+	    my $dev = "/dev/$part->{device}";
+	    eval { devices::make("$prefix$dev") };
+	    $dev;
+	}
+    }
+}
+
+1;