summaryrefslogtreecommitdiffstats
path: root/perl-install/fs
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install/fs')
-rw-r--r--perl-install/fs/any.pm66
-rw-r--r--perl-install/fs/dmraid.pm26
-rw-r--r--perl-install/fs/format.pm16
-rw-r--r--perl-install/fs/get.pm12
-rw-r--r--perl-install/fs/mount.pm72
-rw-r--r--perl-install/fs/mount_options.pm8
-rw-r--r--perl-install/fs/mount_point.pm130
-rw-r--r--perl-install/fs/partitioning.pm82
-rw-r--r--perl-install/fs/partitioning_wizard.pm283
-rw-r--r--perl-install/fs/proc_partitions.pm23
-rw-r--r--perl-install/fs/remote.pm45
-rw-r--r--perl-install/fs/remote/nfs.pm68
-rw-r--r--perl-install/fs/remote/smb.pm217
-rw-r--r--perl-install/fs/type.pm16
-rw-r--r--perl-install/fs/wild_device.pm25
15 files changed, 1011 insertions, 78 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
index 54c6532f1..2e67ba669 100644
--- a/perl-install/fs/dmraid.pm
+++ b/perl-install/fs/dmraid.pm
@@ -75,11 +75,16 @@ sub _sets() {
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) {
- log::l("ERROR: multiple match for set $name: " . join(' ', map { $_->{vg} } @l)) if @l > 1;
- my ($raid) = @l;
- add2hash($_, $raid);
- $_->{status} = $raid->{status} if $_->{status} eq 'ok' && $::isInstall;
+ 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");
}
@@ -180,7 +185,18 @@ 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 {
diff --git a/perl-install/fs/format.pm b/perl-install/fs/format.pm
index f342be09f..c1b6dc05b 100644
--- a/perl-install/fs/format.pm
+++ b/perl-install/fs/format.pm
@@ -2,6 +2,7 @@ package fs::format; # $Id$
use diagnostics;
use strict;
+use String::ShellQuote;
use run_program;
use common;
@@ -20,6 +21,7 @@ my %cmds = (
dos => [ 'dosfstools', 'mkdosfs' ],
vfat => [ 'dosfstools', 'mkdosfs', '-F', '32' ],
swap => [ 'util-linux', 'mkswap' ],
+ ntfs => [ 'ntfsprogs', 'mkntfs' ],
);
my %LABELs = ( #- option, length, handled_by_mount
@@ -119,7 +121,7 @@ sub part_raw {
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 => 60 * 60 }, @args) or die N("%s formatting of %s failed", $fs_type, $dev);
+ run_program::raw({ timeout => 'never' }, @args) or die N("%s formatting of %s failed", $fs_type, $dev);
}
if ($fs_type eq 'ext3') {
@@ -132,7 +134,9 @@ sub part_raw {
sub mkfs_ext2 {
my ($wait_message, @args) = @_;
- open(my $F, "@args |");
+ my $cmd = shell_quote_best_effort(@args);
+ log::l("running: $cmd");
+ open(my $F, "$cmd |");
local $/ = "\b";
local $_;
@@ -160,6 +164,14 @@ sub formatMount_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);
}
diff --git a/perl-install/fs/get.pm b/perl-install/fs/get.pm
index 02e18fed5..0cdb55969 100644
--- a/perl-install/fs/get.pm
+++ b/perl-install/fs/get.pm
@@ -26,13 +26,14 @@ sub really_all_fstab {
}
sub fstab_and_holes {
- my ($all_hds) = @_;
- hds_fstab_and_holes(hds($all_hds)), @{$all_hds->{raids}}, @{$all_hds->{loopbacks}};
+ 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) = @_;
- grep { isEmpty($_) } fstab_and_holes($all_hds);
+ 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(@_);
@@ -141,8 +142,7 @@ sub is_same_hd {
my ($s2) = $hd2->{device} =~ m|https?://(.+?)/*$|;
$s1 eq $s2;
} else {
- $hd1->{devfs_device} && $hd2->{devfs_device} && $hd1->{devfs_device} eq $hd2->{devfs_device}
- || $hd1->{device_LABEL} && $hd2->{device_LABEL} && $hd1->{device_LABEL} eq $hd2->{device_LABEL}
+ $hd1->{device_LABEL} && $hd2->{device_LABEL} && $hd1->{device_LABEL} eq $hd2->{device_LABEL}
|| $hd1->{device} && $hd2->{device} && $hd1->{device} eq $hd2->{device};
}
}
diff --git a/perl-install/fs/mount.pm b/perl-install/fs/mount.pm
index 0d59de1cc..baf1ce837 100644
--- a/perl-install/fs/mount.pm
+++ b/perl-install/fs/mount.pm
@@ -11,6 +11,7 @@ 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+)/);
}
@@ -37,7 +38,7 @@ sub mount {
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', 'davfs' if !$::isInstall;
+ push @types, 'smb', 'smbfs', 'davfs2' if !$::isInstall;
if (!member($fs, @types) && !$::move) {
log::l("skipping mounting $dev partition ($fs)");
@@ -56,6 +57,11 @@ sub mount {
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') {
@@ -70,7 +76,6 @@ sub mount {
push @mount_opt, 'ro' if $b_rdonly;
- log::l("calling mount -t $fs $dev $where @mount_opt");
$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);
}
@@ -108,9 +113,9 @@ sub umount {
$mntpoint =~ s|/$||;
log::l("calling umount($mntpoint)");
- syscall_('umount2', $mntpoint, 0) or do {
+ run_program::run('umount', $mntpoint) or do {
kill 15, fuzzy_pidofs('^fam\b');
- syscall_('umount2', $mntpoint, 0) or die N("error unmounting %s: %s", $mntpoint, $!);
+ 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)
@@ -120,35 +125,37 @@ sub part {
my ($part, $b_rdonly, $o_wait_message) = @_;
log::l("mount_part: " . join(' ', map { "$_=$part->{$_}" } 'device', 'mntpoint', 'isMounted', 'real_mntpoint'));
- if ($part->{isMounted} && $part->{real_mntpoint} && $part->{mntpoint}) {
- log::l("remounting partition on " . fs::get::mntpoint_prefixed($part) . " instead of $part->{real_mntpoint}");
- if ($::isInstall) { #- ensure partition will not be busy.
- require install_any;
- install_any::getFile('XXX');
- }
- eval {
- umount($part->{real_mntpoint});
- rmdir $part->{real_mntpoint};
- symlinkf fs::get::mntpoint_prefixed($part), $part->{real_mntpoint};
- delete $part->{real_mntpoint};
- $part->{isMounted} = 0;
- };
- }
- return if $part->{isMounted};
+ 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 (isLoopback($part) || $part->{encrypt_key}) {
+ if ($part->{encrypt_key}) {
set_loop($part);
- $options = join(',', grep { !/^(encryption=|encrypted$)/ } split(',', $options)); #- we take care of this, don't let it mount see it
+ $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;
@@ -156,7 +163,19 @@ sub part {
$mntpoint = "/initrd/loopfs";
}
my $dev = $part->{real_device} || fs::wild_device::from_part('', $part);
- mount($dev, $mntpoint, $part->{fs_type}, $b_rdonly, $options, $o_wait_message);
+ 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;
@@ -166,7 +185,7 @@ sub part {
sub umount_part {
my ($part) = @_;
- $part->{isMounted} || $part->{real_mntpoint} or return;
+ $part->{isMounted} or return;
unless ($::testing) {
if (isSwap($part)) {
@@ -174,7 +193,7 @@ sub umount_part {
} elsif (fs::type::carry_root_loopback($part)) {
umount("/initrd/loopfs");
} else {
- umount(fs::get::mntpoint_prefixed($part) || devices::make($part->{device}));
+ umount($part->{real_mntpoint} || fs::get::mntpoint_prefixed($part) || devices::make($part->{device}));
devices::del_loop(delete $part->{real_device}) if $part->{real_device};
}
}
@@ -186,8 +205,9 @@ sub umount_all {
log::l("unmounting all filesystems");
- foreach (sort { $b->{mntpoint} cmp $a->{mntpoint} } @$fstab) {
- $_->{mntpoint} and umount_part($_);
+ foreach (sort { $b->{mntpoint} cmp $a->{mntpoint} }
+ grep { $_->{mntpoint} && !$_->{real_mntpoint} } @$fstab) {
+ umount_part($_);
}
}
diff --git a/perl-install/fs/mount_options.pm b/perl-install/fs/mount_options.pm
index 71f05d129..596c3378d 100644
--- a/perl-install/fs/mount_options.pm
+++ b/perl-install/fs/mount_options.pm
@@ -31,7 +31,7 @@ sub unpack {
ntfs => [ qw(umask=0 umask=0022) ],
nfs => [ qw(rsize=8192 wsize=8192) ],
smbfs => [ qw(username= password=) ],
- davfs => [ qw(username= password= uid= gid=) ],
+ davfs2 => [ qw(username= password= uid= gid=) ],
reiserfs => [ 'notail' ],
);
push @{$per_fs{$_}}, 'usrquota', 'grpquota' foreach 'ext2', 'ext3', 'xfs';
@@ -136,11 +136,13 @@ have suidperl(1) installed.)"),
'supermount' => '',
- 'users' => N("Allow an ordinary user to mount the file system."),
+ '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"),
+ 'user_xattr' => N("Support \"user.\" extended attributes"),
'umask=0' => N("Give write access to ordinary users"),
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
index 1cb3acfd1..b65ff747a 100644
--- a/perl-install/fs/proc_partitions.pm
+++ b/perl-install/fs/proc_partitions.pm
@@ -19,30 +19,17 @@ sub read {
my ($hds) = @_;
my @all = read_raw();
- my ($parts, $disks) = partition { $_->{dev} =~ /\d$/ && $_->{dev} !~ /^(sr|scd)/ } @all;
-
- my $devfs_like = any { $_->{dev} =~ m|/disc$| } @$disks;
+ my ($parts, $_disks) = partition { $_->{dev} =~ /\d$/ && $_->{dev} !~ /^(sr|scd)/ } @all;
fs::get_major_minor($hds);
- my %devfs2normal = map {
- my $hd = $_;
- my $disk = find { $_->{major} == $hd->{major} && $_->{minor} == $hd->{minor} } @$disks;
- $disk->{dev} => $_->{device};
- } @$hds;
-
my $prev_part;
foreach my $part (@$parts) {
- my $dev;
- if ($devfs_like) {
- $dev = -e "/dev/$part->{dev}" ? $part->{dev} : sprintf("0x%x%02x", $part->{major}, $part->{minor});
- $part->{rootDevice} = $devfs2normal{dirname($part->{dev}) . '/disc'};
- } else {
- $dev = $part->{dev};
- if (my $hd = find { $part->{dev} =~ /^\Q$_->{device}\E./ } @$hds) {
- put_in_hash($part, partition_table::hd2minimal_part($hd));
- }
+ 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;
diff --git a/perl-install/fs/remote.pm b/perl-install/fs/remote.pm
new file mode 100644
index 000000000..ea22a04af
--- /dev/null
+++ b/perl-install/fs/remote.pm
@@ -0,0 +1,45 @@
+package fs::remote; # $Id$
+
+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..f946a4323
--- /dev/null
+++ b/perl-install/fs/remote/nfs.pm
@@ -0,0 +1,68 @@
+package fs::remote::nfs; # $Id$
+
+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..933941326
--- /dev/null
+++ b/perl-install/fs/remote/smb.pm
@@ -0,0 +1,217 @@
+package fs::remote::smb; # $Id$
+
+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
index 807da7712..3cf99f307 100644
--- a/perl-install/fs/type.pm
+++ b/perl-install/fs/type.pm
@@ -26,11 +26,13 @@ my (%type_name2pt_type, %type_name2fs_type, %fs_type2pt_type, %pt_type2fs_type,
if_(arch() =~ /ppc|i.86|ia64|x86_64/,
0x83 => 'xfs', 'Journalised FS: XFS',
),
-if_(arch() =~ /ppc|i.86/,
+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',
@@ -78,7 +80,6 @@ if_(arch() =~ /ppc/,
0x03 => '', 'XENIX usr',
0x04 => 'vfat', 'FAT16 <32M',
0x06 => 'vfat', 'FAT16',
- 0x07 => 'ntfs', 'NTFS',
0x07 => 'hpfs', 'HPFS',
0x08 => '', 'AIX',
),
@@ -123,7 +124,9 @@ if_(arch() !~ /ppc/,
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 ',
@@ -182,9 +185,10 @@ if_(arch() !~ /ppc/,
}
-sub type_names() {
+sub type_names {
+ my ($expert) = @_;
my @l = @{$type_names{important}};
- push @l, @{$type_names{less_important}}, sort @{$type_names{other}} if $::expert;
+ push @l, @{$type_names{less_important}}, sort @{$type_names{other}} if $expert;
@l;
}
@@ -276,7 +280,7 @@ sub type_subpart_from_magic {
my ($part) = @_;
my $ids = call_vol_id($part);
- $part->{LABEL_from_magic} = $ids->{ID_FS_LABEL_SAFE} if $ids->{ID_FS_LABEL_SAFE};
+ $part->{LABEL_from_magic} = $ids->{ID_FS_LABEL} if $ids->{ID_FS_LABEL};
my $p;
if ($ids->{ID_FS_USAGE} eq 'raid') {
@@ -307,7 +311,7 @@ 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') }
+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} }
diff --git a/perl-install/fs/wild_device.pm b/perl-install/fs/wild_device.pm
index 8fd38b0ce..dea15a4d3 100644
--- a/perl-install/fs/wild_device.pm
+++ b/perl-install/fs/wild_device.pm
@@ -43,17 +43,20 @@ sub to_subpart {
my $symlink = readlink("$::prefix$dev");
$dev =~ s!/u?dev/!!;
- if ($symlink && $symlink =~ m|^[^/]+$|) {
- $part{device_alias} = $dev;
- $dev = $symlink;
+ 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 (undef, $part_number) = $dev =~ m!/(disc|part(\d+))$!) {
- $part{part_number} = $part_number if $part_number;
- $part{devfs_device} = $dev;
- } else {
- my $part_number = devices::part_number(\%part);
- $part{part_number} = $part_number if $part_number;
+ if (my $part_number = devices::part_number(\%part)) {
+ $part{part_number} = $part_number;
}
$part{device} = $dev;
return \%part;
@@ -73,8 +76,6 @@ sub from_part {
if ($part->{prefer_device_LABEL}) {
'LABEL=' . $part->{device_LABEL};
- } elsif ($part->{prefer_devfs_name}) {
- "/dev/$part->{devfs_device}";
} elsif ($part->{device_alias}) {
"/dev/$part->{device_alias}";
} else {
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-01 12:01:44 +0000