summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--perl-install/Xconfig/main.pm1
-rw-r--r--perl-install/Xconfig/resolution_and_depth.pm2
-rw-r--r--perl-install/any.pm1
-rw-r--r--perl-install/authentication.pm1
-rw-r--r--perl-install/bootloader.pm6
-rw-r--r--perl-install/detect_devices.pm2
-rw-r--r--perl-install/devices.pm12
-rw-r--r--perl-install/diskdrake/hd_gtk.pm4
-rw-r--r--perl-install/diskdrake/interactive.pm26
-rw-r--r--perl-install/diskdrake/smbnfs_gtk.pm1
-rw-r--r--perl-install/fs/mount_options.pm1
-rw-r--r--perl-install/fs/proc_partitions.pm82
-rw-r--r--perl-install/fsedit.pm96
-rw-r--r--perl-install/harddrake/autoconf.pm3
-rw-r--r--perl-install/harddrake/data.pm1
-rw-r--r--perl-install/harddrake/sound.pm1
-rw-r--r--perl-install/harddrake/v4l.pm2
-rw-r--r--perl-install/http.pm1
-rw-r--r--perl-install/modules/interactive.pm4
-rw-r--r--perl-install/mygtk2.pm1
-rw-r--r--perl-install/network/adsl.pm1
-rw-r--r--perl-install/network/dhcpd.pm1
-rw-r--r--perl-install/network/ethernet.pm4
-rw-r--r--perl-install/network/ipsec.pm2
-rw-r--r--perl-install/network/isdn.pm1
-rw-r--r--perl-install/network/modem.pm2
-rw-r--r--perl-install/network/network.pm1
-rw-r--r--perl-install/network/nfs.pm1
-rw-r--r--perl-install/network/smb.pm2
-rw-r--r--perl-install/network/smbnfs.pm2
-rw-r--r--perl-install/partition_table/dos.pm1
-rw-r--r--perl-install/raid.pm1
32 files changed, 125 insertions, 142 deletions
diff --git a/perl-install/Xconfig/main.pm b/perl-install/Xconfig/main.pm
index 8c46c3600..bf6d6d88a 100644
--- a/perl-install/Xconfig/main.pm
+++ b/perl-install/Xconfig/main.pm
@@ -11,7 +11,6 @@ use Xconfig::screen;
use Xconfig::test;
use Xconfig::xfree;
use common;
-use any;
sub configure_monitor {
diff --git a/perl-install/Xconfig/resolution_and_depth.pm b/perl-install/Xconfig/resolution_and_depth.pm
index 7179186ec..bc4a0d784 100644
--- a/perl-install/Xconfig/resolution_and_depth.pm
+++ b/perl-install/Xconfig/resolution_and_depth.pm
@@ -3,8 +3,6 @@ package Xconfig::resolution_and_depth; # $Id$
use diagnostics;
use strict;
-use Xconfig::card;
-use Xconfig::monitor;
use common;
diff --git a/perl-install/any.pm b/perl-install/any.pm
index 0cd403bd9..97953f608 100644
--- a/perl-install/any.pm
+++ b/perl-install/any.pm
@@ -12,7 +12,6 @@ use partition_table;
use fs::type;
use lang;
use run_program;
-use keyboard;
use devices;
use modules;
use log;
diff --git a/perl-install/authentication.pm b/perl-install/authentication.pm
index b67e46159..ce9ac04d6 100644
--- a/perl-install/authentication.pm
+++ b/perl-install/authentication.pm
@@ -1,7 +1,6 @@
package authentication; # $Id$
use common;
-use any;
sub kinds {
my $no_para = @_ == 0;
diff --git a/perl-install/bootloader.pm b/perl-install/bootloader.pm
index 0d886f4cb..27a129fac 100644
--- a/perl-install/bootloader.pm
+++ b/perl-install/bootloader.pm
@@ -7,13 +7,13 @@ use strict;
#- misc imports
#-######################################################################################
use common;
-use partition_table;
use fs::type;
use fs::get;
+use fs::loopback;
+use fs::proc_partitions;
use log;
use any;
use devices;
-use fs::loopback;
use detect_devices;
use partition_table::raw;
use run_program;
@@ -255,7 +255,7 @@ sub read_grub {
sub yaboot2dev {
my ($of_path) = @_;
- find { dev2yaboot($_) eq $of_path } map { "/dev/$_->{dev}" } devices::read_proc_partitions_raw();
+ find { dev2yaboot($_) eq $of_path } map { "/dev/$_->{dev}" } fs::proc_partitions::read_raw();
}
# assumes file is in /boot
diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm
index 15f671670..fad553daf 100644
--- a/perl-install/detect_devices.pm
+++ b/perl-install/detect_devices.pm
@@ -369,7 +369,7 @@ sub getIDE() {
sub block_devices() {
-d '/sys/block'
? map { s|!|/|; $_ } all('/sys/block')
- : map { $_->{dev} } devices::read_proc_partitions_raw();
+ : map { $_->{dev} } do { require fs::proc_partitions; fs::proc_partitions::read_raw() };
}
sub getCompaqSmartArray() {
diff --git a/perl-install/devices.pm b/perl-install/devices.pm
index c5ee94c04..9404481a8 100644
--- a/perl-install/devices.pm
+++ b/perl-install/devices.pm
@@ -205,18 +205,6 @@ sub to_devfs {
readlink("/dev/" . $dev);
}
-sub read_proc_partitions_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 simple_partition_scan {
my ($part) = @_;
$part->{device} =~ /([hs]d[a-z])(\d+)$/;
diff --git a/perl-install/diskdrake/hd_gtk.pm b/perl-install/diskdrake/hd_gtk.pm
index 95860d7e5..7de290b89 100644
--- a/perl-install/diskdrake/hd_gtk.pm
+++ b/perl-install/diskdrake/hd_gtk.pm
@@ -11,8 +11,6 @@ use detect_devices;
use diskdrake::interactive;
use run_program;
use devices;
-use raid;
-use any;
use log;
use fsedit;
@@ -108,7 +106,7 @@ sub try {
sub try_ {
my ($name, $f, @args) = @_;
- fsedit::undo_prepare($all_hds) if $name ne 'Undo';
+ diskdrake::interactive::undo_prepare($all_hds) if $name ne 'Undo';
my $v = eval { $f->($in, @args, $all_hds) };
if (my $err = $@) {
diff --git a/perl-install/diskdrake/interactive.pm b/perl-install/diskdrake/interactive.pm
index 080bb375d..ca5b8f4d4 100644
--- a/perl-install/diskdrake/interactive.pm
+++ b/perl-install/diskdrake/interactive.pm
@@ -7,6 +7,7 @@ use common;
use fs::type;
use fs::loopback;
use fs::format;
+use fs::mount_options;
use fs;
use partition_table;
use partition_table::raw;
@@ -258,7 +259,7 @@ sub general_possible_actions {
sub Undo {
my ($_in, $all_hds) = @_;
- fsedit::undo($all_hds);
+ undo($all_hds);
}
sub Wizard {
@@ -1313,3 +1314,26 @@ sub update_bootloader_for_renumbered_partitions {
require bootloader;
bootloader::update_for_renumbered_partitions($in, \@renumbering, $all_hds);
}
+
+sub undo_prepare {
+ my ($all_hds) = @_;
+ require Data::Dumper;
+ $Data::Dumper::Purity = 1;
+ foreach (@{$all_hds->{hds}}) {
+ my @h = @$_{@partition_table::fields2save};
+ push @{$_->{undo}}, Data::Dumper->Dump([\@h], ['$h']);
+ }
+}
+sub undo {
+ my ($all_hds) = @_;
+ foreach (@{$all_hds->{hds}}) {
+ my $code = pop @{$_->{undo}} or next;
+ my $h; eval $code;
+ @$_{@partition_table::fields2save} = @$h;
+
+ if ($_->{hasBeenDirty}) {
+ partition_table::will_tell_kernel($_, 'force_reboot'); #- next action needing write_partitions will force it. We can not do it now since more undo may occur, and we must not needReboot now
+ }
+ }
+
+}
diff --git a/perl-install/diskdrake/smbnfs_gtk.pm b/perl-install/diskdrake/smbnfs_gtk.pm
index 69c9517a6..f30857ce0 100644
--- a/perl-install/diskdrake/smbnfs_gtk.pm
+++ b/perl-install/diskdrake/smbnfs_gtk.pm
@@ -3,7 +3,6 @@ package diskdrake::smbnfs_gtk; # $Id$
use diagnostics;
use strict;
-use any;
use fs::get;
use diskdrake::interactive;
use common;
diff --git a/perl-install/fs/mount_options.pm b/perl-install/fs/mount_options.pm
index f59a083f7..358f01e01 100644
--- a/perl-install/fs/mount_options.pm
+++ b/perl-install/fs/mount_options.pm
@@ -5,6 +5,7 @@ use strict;
use common;
use fs::type;
+use fs::get;
use log;
sub list() {
diff --git a/perl-install/fs/proc_partitions.pm b/perl-install/fs/proc_partitions.pm
new file mode 100644
index 000000000..3e1e31b32
--- /dev/null
+++ b/perl-install/fs/proc_partitions.pm
@@ -0,0 +1,82 @@
+package fs::proc_partitions; # $Id$
+
+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;
+
+ my $devfs_like = any { $_->{dev} =~ m|/disc$| } @$disks;
+
+ my %devfs2normal = map {
+ my (undef, $major, $minor) = devices::entry($_->{device});
+ my $disk = find { $_->{major} == $major && $_->{minor} == $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));
+ }
+ }
+ 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]) ] };
+}
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index a92b670e8..6b10c9503 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -10,8 +10,10 @@ use vars qw(%suggestions);
use common;
use partition_table;
use partition_table::raw;
+use fs::get;
use fs::type;
use fs::loopback;
+use fs::proc_partitions;
use detect_devices;
use devices;
use log;
@@ -132,7 +134,7 @@ sub get_hds {
my $handle_die_and_cdie = sub {
if ($hd->{readonly}) {
log::l("using /proc/partitions since diskdrake failed :(");
- use_proc_partitions($hd);
+ fs::proc_partitions::use_($hd);
1;
} elsif (my $type = fs::type::type_subpart_from_magic($hd)) {
#- non partitioned drive?
@@ -163,7 +165,7 @@ sub get_hds {
if (listlength(partition_table::get_normal_parts($hd)) == 0) {
$handled = 1 if $handle_die_and_cdie->();
} else {
- compare_with_proc_partitions($hd) if $::isInstall;
+ fs::proc_partitions::compare($hd) if $::isInstall;
}
} sub {
my $err = $@;
@@ -191,7 +193,7 @@ Do you agree to lose all the partitions?
} else {
#- using it readonly
log::l("using /proc/partitions since diskdrake failed :(");
- use_proc_partitions($hd);
+ fs::proc_partitions::use_($hd);
}
}
$hd or next;
@@ -242,44 +244,6 @@ Do you agree to lose all the partitions?
$all_hds;
}
-sub read_proc_partitions {
- my ($hds) = @_;
-
- my @all = devices::read_proc_partitions_raw();
- my ($parts, $disks) = partition { $_->{dev} =~ /\d$/ && $_->{dev} !~ /^(sr|scd)/ } @all;
-
- my $devfs_like = any { $_->{dev} =~ m|/disc$| } @$disks;
-
- my %devfs2normal = map {
- my (undef, $major, $minor) = devices::entry($_->{device});
- my $disk = find { $_->{major} == $major && $_->{minor} == $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));
- }
- }
- 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;
- put_in_hash($part, fs::type::type_subpart_from_magic($part));
- $prev_part = $part;
- delete $part->{dev}; # cleanup
- }
- @$parts;
-}
-
sub is_same_hd {
my ($hd1, $hd2) = @_;
if ($hd1->{major} && $hd2->{major}) {
@@ -540,29 +504,6 @@ sub auto_allocate_vgs {
1;
}
-sub undo_prepare {
- my ($all_hds) = @_;
- require Data::Dumper;
- $Data::Dumper::Purity = 1;
- foreach (@{$all_hds->{hds}}) {
- my @h = @$_{@partition_table::fields2save};
- push @{$_->{undo}}, Data::Dumper->Dump([\@h], ['$h']);
- }
-}
-sub undo {
- my ($all_hds) = @_;
- foreach (@{$all_hds->{hds}}) {
- my $code = pop @{$_->{undo}} or next;
- my $h; eval $code;
- @$_{@partition_table::fields2save} = @$h;
-
- if ($_->{hasBeenDirty}) {
- partition_table::will_tell_kernel($_, 'force_reboot'); #- next action needing write_partitions will force it. We can not do it now since more undo may occur, and we must not needReboot now
- }
- }
-
-}
-
sub change_type {
my ($type, $hd, $part) = @_;
$type->{pt_type} != $part->{pt_type} || $type->{fs_type} ne $part->{fs_type} or return;
@@ -608,31 +549,4 @@ sub rescuept($) {
}
}
-sub compare_with_proc_partitions {
- my ($hd) = @_;
-
- my @l1 = partition_table::get_normal_parts($hd);
- my @l2 = grep { $_->{rootDevice} eq $hd->{device} } read_proc_partitions([$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_proc_partitions {
- 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_proc_partitions([$hd]) ] };
-}
-
1;
diff --git a/perl-install/harddrake/autoconf.pm b/perl-install/harddrake/autoconf.pm
index 8cbbb9b4c..7f2c105d9 100644
--- a/perl-install/harddrake/autoconf.pm
+++ b/perl-install/harddrake/autoconf.pm
@@ -1,7 +1,6 @@
package harddrake::autoconf;
use common;
-use any;
sub xconf {
my ($modules_conf, $o) = @_;
@@ -9,10 +8,10 @@ sub xconf {
log::l('automatic XFree configuration');
require Xconfig::default;
+ require do_pkgs;
$o->{raw_X} = Xconfig::default::configure(do_pkgs_standalone->new);
require Xconfig::main;
- require do_pkgs;
Xconfig::main::configure_everything_auto_install($o->{raw_X}, do_pkgs_standalone->new, {}, { allowFB => 1 });
modules::load_category($modules_conf, 'various/agpgart');
diff --git a/perl-install/harddrake/data.pm b/perl-install/harddrake/data.pm
index 2e3506bae..c58b83aca 100644
--- a/perl-install/harddrake/data.pm
+++ b/perl-install/harddrake/data.pm
@@ -267,7 +267,6 @@ our @tree =
configurator => "$sbindir/drakconnect",
detector => sub {
require list_modules;
- require network::ethernet;
my @net_modules = list_modules::category2modules(list_modules::ethernet_categories());
f(grep {
$_->{media_type} && $_->{media_type} =~ /^NETWORK/
diff --git a/perl-install/harddrake/sound.pm b/perl-install/harddrake/sound.pm
index e1651f23c..4adb6e341 100644
--- a/perl-install/harddrake/sound.pm
+++ b/perl-install/harddrake/sound.pm
@@ -16,7 +16,6 @@ package harddrake::sound;
use strict;
use common;
-use interactive;
use run_program;
use modules;
use list_modules;
diff --git a/perl-install/harddrake/v4l.pm b/perl-install/harddrake/v4l.pm
index aa005b664..8e2231a05 100644
--- a/perl-install/harddrake/v4l.pm
+++ b/perl-install/harddrake/v4l.pm
@@ -3,9 +3,7 @@ package harddrake::v4l;
use strict;
use common;
-use interactive;
use detect_devices;
-use lang;
use log;
use modules;
diff --git a/perl-install/http.pm b/perl-install/http.pm
index dec3773a8..e35d8d221 100644
--- a/perl-install/http.pm
+++ b/perl-install/http.pm
@@ -1,7 +1,6 @@
package http; # $Id$
use IO::Socket;
-use network::network;
my $sock;
diff --git a/perl-install/modules/interactive.pm b/perl-install/modules/interactive.pm
index fb4bcfda2..ead9e7b71 100644
--- a/perl-install/modules/interactive.pm
+++ b/perl-install/modules/interactive.pm
@@ -1,5 +1,5 @@
-package modules::interactive;
-use interactive;
+package modules::interactive; # $Id$
+
use modules;
use common;
diff --git a/perl-install/mygtk2.pm b/perl-install/mygtk2.pm
index 65221d0b2..891c20635 100644
--- a/perl-install/mygtk2.pm
+++ b/perl-install/mygtk2.pm
@@ -2,7 +2,6 @@ package mygtk2;
use diagnostics;
use strict;
-use lang;
our @ISA = qw(Exporter);
our @EXPORT = qw(gtknew gtkset gtkadd gtkval_register gtkval_modify);
diff --git a/perl-install/network/adsl.pm b/perl-install/network/adsl.pm
index 9da5a3f7c..ca0b0e272 100644
--- a/perl-install/network/adsl.pm
+++ b/perl-install/network/adsl.pm
@@ -3,7 +3,6 @@ package network::adsl; # $Id$
use common;
use run_program;
use network::tools;
-use network::ethernet;
use modules;
use vars qw(@ISA @EXPORT);
diff --git a/perl-install/network/dhcpd.pm b/perl-install/network/dhcpd.pm
index d91df441f..8cf30d5fc 100644
--- a/perl-install/network/dhcpd.pm
+++ b/perl-install/network/dhcpd.pm
@@ -2,7 +2,6 @@ package network::dhcpd;
use strict;
use common;
-use network::network;
my $sysconf_dhcpd = "$::prefix/etc/sysconfig/dhcpd";
my $dhcpd_conf_file = "$::prefix/etc/dhcpd.conf";
diff --git a/perl-install/network/ethernet.pm b/perl-install/network/ethernet.pm
index dcda7b643..29e2b5d10 100644
--- a/perl-install/network/ethernet.pm
+++ b/perl-install/network/ethernet.pm
@@ -1,13 +1,9 @@
package network::ethernet; # $Id$
use c;
-use network::network;
-use modules;
-use modules::interactive;
use detect_devices;
use common;
use run_program;
-use network::tools;
our @dhcp_clients = qw(dhclient dhcpcd pump dhcpxd);
diff --git a/perl-install/network/ipsec.pm b/perl-install/network/ipsec.pm
index c0ee6e2fb..b40e6c79b 100644
--- a/perl-install/network/ipsec.pm
+++ b/perl-install/network/ipsec.pm
@@ -3,11 +3,9 @@ package network::ipsec;
use detect_devices;
-use network::netconnect;
use run_program;
use common;
use log;
-use Data::Dumper;
#- debugg functions ----------
sub recreate_ipsec_conf {
diff --git a/perl-install/network/isdn.pm b/perl-install/network/isdn.pm
index 11068828b..35c287d2c 100644
--- a/perl-install/network/isdn.pm
+++ b/perl-install/network/isdn.pm
@@ -3,7 +3,6 @@ package network::isdn; # $Id$
use strict;
use network::isdn_consts;
use common;
-use any;
use modules;
use run_program;
use log;
diff --git a/perl-install/network/modem.pm b/perl-install/network/modem.pm
index f600db844..8c5adf523 100644
--- a/perl-install/network/modem.pm
+++ b/perl-install/network/modem.pm
@@ -5,7 +5,7 @@ use common;
use any;
use modules;
use detect_devices;
-use mouse;
+use network::network;
use network::tools;
sub get_user_home() {
diff --git a/perl-install/network/network.pm b/perl-install/network/network.pm
index 9eca1b4b4..c702d7a61 100644
--- a/perl-install/network/network.pm
+++ b/perl-install/network/network.pm
@@ -11,7 +11,6 @@ use common;
use detect_devices;
use run_program;
use network::tools;
-use any;
use vars qw(@ISA @EXPORT);
use log;
diff --git a/perl-install/network/nfs.pm b/perl-install/network/nfs.pm
index 37dd954e5..194a9c678 100644
--- a/perl-install/network/nfs.pm
+++ b/perl-install/network/nfs.pm
@@ -4,7 +4,6 @@ use strict;
use diagnostics;
use common;
-use network::network;
use network::smbnfs;
use log;
diff --git a/perl-install/network/smb.pm b/perl-install/network/smb.pm
index ef98f6945..7fca6d65c 100644
--- a/perl-install/network/smb.pm
+++ b/perl-install/network/smb.pm
@@ -4,7 +4,7 @@ use strict;
use diagnostics;
use common;
-use fs;
+use fs::mount_options;
use network::network;
use network::smbnfs;
diff --git a/perl-install/network/smbnfs.pm b/perl-install/network/smbnfs.pm
index c38903028..bc5b92b60 100644
--- a/perl-install/network/smbnfs.pm
+++ b/perl-install/network/smbnfs.pm
@@ -3,7 +3,7 @@ package network::smbnfs; # $Id$
use strict;
use diagnostics;
-use fs;
+use fs::mount_options;
sub new {
diff --git a/perl-install/partition_table/dos.pm b/perl-install/partition_table/dos.pm
index 8d8109723..90b86b9c2 100644
--- a/perl-install/partition_table/dos.pm
+++ b/perl-install/partition_table/dos.pm
@@ -9,6 +9,7 @@ use vars qw(@ISA);
use common;
use partition_table::raw;
use partition_table;
+use fs::type;
use c;
my @fields = qw(active start_head start_sec start_cyl pt_type end_head end_sec end_cyl start size);
diff --git a/perl-install/raid.pm b/perl-install/raid.pm
index c16f82378..68abe51fc 100644
--- a/perl-install/raid.pm
+++ b/perl-install/raid.pm
@@ -11,7 +11,6 @@ use fs::type;
use run_program;
use devices;
use modules;
-use fs;
sub max_nb() { 31 }
generated by cgit v1.2.1 (git 2.21.0) at 2024-12-14 20:50:11 +0000
ass="hl kwa">exit; }; } #------------------------------------------------------------------------------ sub selectKeyboard { my ($o, $clicked) = @_; my $from_usb = keyboard::from_usb(); my $l = keyboard::lang2keyboards(lang::langs($o->{locale}{langs})); if ($::expert || $clicked || !($from_usb || @$l && $l->[0][1] >= 90) || listlength(lang::langs($o->{locale}{langs})) > 1) { add2hash($o->{keyboard}, $from_usb); my @best = uniq($from_usb ? $from_usb->{KEYBOARD} : (), (map { $_->[0] } @$l), 'us_intl'); my $format = sub { translate(keyboard::KEYBOARD2text($_[0])) }; my $other; my $ext_keyboard = my $KEYBOARD = $o->{keyboard}{KEYBOARD}; $o->ask_from_( { title => N("Keyboard"), messages => N("Please choose your keyboard layout."), interactive_help_id => 'selectKeyboard', advanced_messages => N("Here is the full list of available keyboards"), advanced_label => N("More"), callbacks => { changed => sub { $other = $_[0] == 1 } }, }, [ if_(@best > 1, { val => \$KEYBOARD, type => 'list', format => $format, sort => 1, list => [ @best ] }), { val => \$ext_keyboard, type => 'list', format => $format, list => [ difference2([ keyboard::KEYBOARDs() ], \@best) ], advanced => @best > 1 } ]); $o->{keyboard}{KEYBOARD} = $other ? $ext_keyboard : $KEYBOARD; delete $o->{keyboard}{unsafe}; } keyboard::group_toggle_choose($o, $o->{keyboard}) or goto &selectKeyboard; install_steps::selectKeyboard($o); } #------------------------------------------------------------------------------ sub selectInstallClass { my ($o) = @_; if (my @l = install_any::find_root_parts($o->{fstab}, $o->{prefix})) { log::l("proposing to upgrade partitions " . join(" ", map { $_->{part}{device} } @l)); my @releases = uniq(map { $_->{release} } @l); if (@releases != @l) { #- same release name so adding the device to differentiate them: $_->{release} .= " ($_->{part}{device})" foreach @l; } my $p; $o->ask_from_({ title => N("Install/Upgrade"), messages => N("Is this an install or an upgrade?"), interactive_help_id => 'selectInstallClass', }, [ { val => \$p, list => [ @l, N_("Install") ], type => 'list', format => sub { ref($_[0]) ? N("Upgrade %s", $_[0]{release}) : translate($_[0]) } } ]); if (ref $p) { my $part = $p->{part}; log::l("choosing to upgrade partition $part->{device}"); install_any::use_root_part($o->{all_hds}, $part, $o->{prefix}); foreach (grep { $_->{mntpoint} } @{$o->{fstab}}) { my ($options, $_unknown) = fs::mount_options_unpack($_); $options->{encrypted} or next; $o->ask_from_({ focus_first => 1 }, [ { label => N("Encryption key for %s", $_->{mntpoint}), hidden => 1, val => \$_->{encrypt_key} } ]); } $o->{isUpgrade} = 1; } } } #------------------------------------------------------------------------------ sub selectMouse { my ($o, $force) = @_; $force ||= $o->{mouse}{unsafe}; if ($force) { my $prev = $o->{mouse}{type} . '|' . $o->{mouse}{name}; $o->ask_from_({ messages => N("Please choose your type of mouse."), interactive_help_id => 'selectMouse', }, [ { list => [ mouse::fullnames() ], separator => '|', val => \$prev, format => sub { join('|', map { translate($_) } split('\|', $_[0])) } } ]); $o->{mouse} = mouse::fullname2mouse($prev); } if ($force && $o->{mouse}{type} eq 'serial') { $o->{mouse}{device} = $o->ask_from_listf_raw({ title => N("Mouse Port"), messages => N("Please choose which serial port your mouse is connected to."), interactive_help_id => 'selectSerialPort', }, \&mouse::serial_port2text, [ mouse::serial_ports() ]) or return &selectMouse; } if (arch() =~ /ppc/ && $o->{mouse}{nbuttons} == 1) { #- set a sane default F11/F12 $o->{mouse}{button2_key} = 87; $o->{mouse}{button3_key} = 88; $o->ask_from('', N("Buttons emulation"), [ { label => N("Button 2 Emulation"), val => \$o->{mouse}{button2_key}, list => [ mouse::ppc_one_button_keys() ], format => \&mouse::ppc_one_button_key2text }, { label => N("Button 3 Emulation"), val => \$o->{mouse}{button3_key}, list => [ mouse::ppc_one_button_keys() ], format => \&mouse::ppc_one_button_key2text }, ]) or return; } if ($o->{mouse}{device} eq "usbmouse") { modules::interactive::load_category($o, 'bus/usb', 1, 1); eval { devices::make("usbmouse"); modules::load(qw(hid mousedev usbmouse)); }; } $o->SUPER::selectMouse; 1; } #------------------------------------------------------------------------------ sub setupSCSI { my ($o) = @_; if (!$::noauto && arch() =~ /i.86/) { if ($o->{pcmcia} ||= !$::testing && c::pcmcia_probe()) { my $w = $o->wait_message(N("PCMCIA"), N("Configuring PCMCIA cards...")); my $results = modules::configure_pcmcia($o->{pcmcia}); undef $w; $results and $o->ask_warn('', $results); } } { my $_w = $o->wait_message(N("IDE"), N("Configuring IDE")); modules::load(modules::category2modules('disk/cdrom')); } modules::interactive::load_category($o, 'bus/firewire', 1); my $have_non_scsi = detect_devices::hds(); #- at_least_one scsi device if we have no disks modules::interactive::load_category($o, 'disk/scsi|hardware_raid|firewire', 1, !$have_non_scsi); modules::interactive::load_category($o, 'disk/scsi|hardware_raid|firewire') if !detect_devices::hds(); #- we really want a disk! install_interactive::tellAboutProprietaryModules($o); install_any::getHds($o, $o); } sub ask_mntpoint_s { #- }{} my ($o, $fstab) = @_; 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 = $o->wait_message('', N("Scanning partitions to find mount points")); install_any::suggest_mount_points($fstab, $o->{prefix}, 'uniq'); log::l("default mntpoint $_->{mntpoint} $_->{device}") foreach @fstab; } if (@fstab == 1) { $fstab[0]{mntpoint} = '/'; } else { $o->ask_from_({ messages => N("Choose the mount points"), interactive_help_id => 'ask_mntpoint_s', }, [ map { { label => partition_table::description($_), val => \$_->{mntpoint}, not_edit => 0, list => [ '', fsedit::suggestions_mntpoint(fsedit::empty_all_hds()) ] } } grep { !$_->{real_mntpoint} || common::usingRamdisk() } @fstab ]) or return; } $o->SUPER::ask_mntpoint_s($fstab); } #------------------------------------------------------------------------------ sub doPartitionDisks { my ($o) = @_; if (arch() =~ /ppc/ && detect_devices::get_mac_generation() =~ /NewWorld/) { #- need to make bootstrap part if NewWorld machine - thx Pixel ;^) if (defined $partition_table::mac::bootstrap_part) { #- don't do anything if we've got the bootstrap setup #- otherwise, go ahead and create one somewhere in the drive free space } else { undef = $partition_table::mac::freepart; #- please "perl -w" my $freepart = $partition_table::mac::freepart; if ($freepart && $freepart->{size} >= 1) { log::l("creating bootstrap partition on drive /dev/$freepart->{hd}{device}, block $freepart->{start}"); $partition_table::mac::bootstrap_part = $freepart->{part}; log::l("bootstrap now at $partition_table::mac::bootstrap_part"); fsedit::add($freepart->{hd}, { start => $freepart->{start}, size => 1 << 11, type => 0x401, mntpoint => '' }, $o->{all_hds}, { force => 1, primaryOrExtended => 'Primary' }); $new_bootstrap = 1; } else { $o->ask_warn('', N("No free space for 1MB bootstrap! Install will continue, but to boot your system, you'll need to create the bootstrap partition in DiskDrake")); } } } if (!$o->{isUpgrade}) { install_interactive::partitionWizard($o); } } #------------------------------------------------------------------------------ sub rebootNeeded { my ($o) = @_; $o->ask_warn('', N("You need to reboot for the partition table modifications to take place")); install_steps::rebootNeeded($o); } #------------------------------------------------------------------------------ sub choosePartitionsToFormat { my ($o, $fstab) = @_; $o->SUPER::choosePartitionsToFormat($fstab); my @l = grep { !$_->{isMounted} && $_->{mntpoint} && (!isSwap($_) || $::expert) && (!isFat_or_NTFS($_) || $_->{notFormatted} || $::expert) && (!isOtherAvailableFS($_) || $::expert || $_->{toFormat}) } @$fstab; $_->{toFormat} = 1 foreach grep { isSwap($_) && !$::expert } @$fstab; return if @l == 0 || !$::expert && every { $_->{toFormat} } @l; #- keep it temporary until the guy has accepted $_->{toFormatTmp} = $_->{toFormat} || $_->{toFormatUnsure} foreach @l; $o->ask_from_( { messages => N("Choose the partitions you want to format"), 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($_) && !isThisFs("reiserfs", $_) && !isThisFs("xfs", $_) && !isThisFs("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}; $_->{isFormatted} = 0; } } sub formatMountPartitions { my ($o, $_fstab) = @_; my $w; catch_cdie { fs::formatMount_all($o->{all_hds}{raids}, $o->{fstab}, $o->{prefix}, sub { my ($msg) = @_; $w ||= $o->wait_message('', $msg); $w->set($msg); }); } sub { $@ =~ /fsck failed on (\S+)/ or return; $o->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 newt) die N("Not enough swap space to fulfill installation, please add some") if availableMemory() < 40 * 1024; } #------------------------------------------------------------------------------ sub setPackages { my ($o, $rebuild_needed) = @_; my $w = $o->wait_message('', $rebuild_needed ? N("Looking for available packages and rebuilding rpm database...") : N("Looking for available packages...")); install_any::setPackages($o, $rebuild_needed); $w->set(N("Looking at packages already installed...")); pkgs::selectPackagesAlreadyInstalled($o->{packages}, $o->{prefix}); if ($rebuild_needed) { $w->set(N("Finding packages to upgrade...")); pkgs::selectPackagesToUpgrade($o->{packages}, $o->{prefix}); } } #------------------------------------------------------------------------------ sub choosePackages { my ($o, $packages, $compssUsers, $_first_time) = @_; #- this is done at the very beginning to take into account #- selection of CD by user if using a cdrom. $o->chooseCD($packages) if $o->{method} eq 'cdrom' && !$::oem; my $w = $o->wait_message('', N("Looking for available packages...")); my $availableC = &install_steps::choosePackages; my $individual; require pkgs; my $min_size = pkgs::selectedSize($packages); unless ($min_size < $availableC) { undef $w; $o->ask_warn('', N("Your system does not have enough space left for installation or upgrade (%d > %d)", $min_size, $availableC)); install_steps::rebootNeeded($o); } my $min_mark = 4; my $b = pkgs::saveSelected($packages); my $_level = pkgs::setSelectedFromCompssList($packages, { map { $_ => 1 } map { @{$compssUsers->{$_}{flags}} } @{$o->{compssUsersSorted}} }, $min_mark, 0); my $max_size = pkgs::selectedSize($packages) + 1; #- avoid division by zero. log::l("max size (level $min_mark) is : " . formatXiB($max_size)); pkgs::restoreSelected($b); undef $w; chooseGroups: $o->chooseGroups($packages, $compssUsers, $min_mark, \$individual, $max_size) if !$o->{isUpgrade} && !$::corporate && $o->{meta_class} ne 'desktop'; ($o->{packages_}{ind}) = pkgs::setSelectedFromCompssList($packages, $o->{compssUsersChoice}, $min_mark, $availableC); $o->choosePackagesTree($packages) or goto chooseGroups if $individual; install_any::warnAboutRemovedPackages($o, $o->{packages}); install_any::warnAboutNaughtyServers($o) or goto chooseGroups if !$o->{isUpgrade}; } sub choosePackagesTree { my ($o, $packages, $o_limit_to_medium) = @_; $o->ask_many_from_list('', N("Choose the packages you want to install"), { list => [ grep { !$o_limit_to_medium || pkgs::packageMedium($packages, $_) == $o_limit_to_medium } @{$packages->{depslist}} ], value => \&URPM::Package::flag_selected, label => \&URPM::Package::name, sort => 1, }); } sub loadSavePackagesOnFloppy { my ($o, $packages) = @_; $o->ask_from('', N("Please choose load or save package selection on floppy. The format is the same as auto_install generated floppies."), [ { val => \ (my $choice), list => [ N_("Load from floppy"), N_("Save on floppy") ], format => \&translate, type => 'list' } ]) or return; if ($choice eq 'Load from floppy') { while (1) { my $w = $o->wait_message(N("Package selection"), N("Loading from floppy")); log::l("load package selection from floppy"); my $O = eval { install_any::loadO(undef, 'floppy') }; if ($@) { undef $w; #- close wait message. $o->ask_okcancel('', N("Insert a floppy containing package selection")) or return; } else { install_any::unselectMostPackages($o); foreach (@{$O->{default_packages} || []}) { my $pkg = pkgs::packageByName($packages, $_); pkgs::selectPackage($packages, $pkg) if $pkg; } return 1; } } } else { log::l("save package selection to floppy"); install_any::g_default_packages($o, 'quiet'); } } sub chooseGroups { my ($o, $packages, $compssUsers, $min_level, $individual, $max_size) = @_; #- for all groups available, determine package which belongs to each one. #- this will enable getting the size of each groups more quickly due to #- limitation of current implementation. #- use an empty state for each one (no flag update should be propagated). #- OLD VERSION my $b = pkgs::saveSelected($packages); install_any::unselectMostPackages($o); pkgs::setSelectedFromCompssList($packages, {}, $min_level, $max_size); my $system_size = pkgs::selectedSize($packages); my ($sizes, $pkgs) = pkgs::computeGroupSize($packages, $min_level); pkgs::restoreSelected($b); log::l("system_size: $system_size"); my @groups = @{$o->{compssUsersSorted}}; my %stable_flags = grep_each { $::b } %{$o->{compssUsersChoice}}; delete $stable_flags{$_} foreach map { @{$compssUsers->{$_}{flags}} } @groups; my $compute_size = sub { my %pkgs; my %flags = %stable_flags; @flags{@_} = (); my $total_size; A: while (my ($k, $size) = each %$sizes) { Or: foreach (split "\t", $k) { foreach (split "&&") { exists $flags{$_} or next Or; } $total_size += $size; $pkgs{$_} = 1 foreach @{$pkgs->{$k}}; next A; } } log::l("computed size $total_size"); log::l("chooseGroups: ", join(" ", sort keys %pkgs)); int $total_size; }; my %val = map { $_ => every { $o->{compssUsersChoice}{$_} } @{$compssUsers->{$_}{flags}} } @groups; # @groups = grep { $size{$_} = round_down($size{$_} / sqr(1024), 10) } @groups; #- don't display the empty or small one (eg: because all packages are below $min_level) my ($size, $unselect_all); my $available_size = install_any::getAvailableSpace($o) / sqr(1024); my $size_to_display = sub { my $lsize = $system_size + $compute_size->(map { @{$compssUsers->{$_}{flags}} } grep { $val{$_} } @groups); #- if a profile is deselected, deselect everything (easier than deselecting the profile packages) $unselect_all ||= $size > $lsize; $size = $lsize; N("Total size: %d / %d MB", pkgs::correctSize($size / sqr(1024)), $available_size); }; while (1) { if ($available_size < 140) { # too small to choose anything. Defaulting to no group chosen $val{$_} = 0 foreach %val; last; } $o->reallyChooseGroups($size_to_display, $individual, \%val) or return; last if $::testing || pkgs::correctSize($size / sqr(1024)) < $available_size; $o->ask_warn('', N("Selected size is larger than available space")); } $o->{compssUsersChoice}{$_} = 0 foreach map { @{$compssUsers->{$_}{flags}} } grep { !$val{$_} } keys %val; $o->{compssUsersChoice}{$_} = 1 foreach map { @{$compssUsers->{$_}{flags}} } grep { $val{$_} } keys %val; log::l("compssUsersChoice: " . (!$val{$_} && "not ") . "selected [$_] as [$o->{compssUsers}{$_}{label}]") foreach keys %val; #- do not try to deselect package (by default no groups are selected). $o->{isUpgrade} or $unselect_all and install_any::unselectMostPackages($o); #- if no group have been chosen, ask for using base system only, or no X, or normal. if (!$o->{isUpgrade} && !any { $_ } values %val) { my $docs = !$o->{excludedocs}; my $minimal = !any { $_ } values %{$o->{compssUsersChoice}}; $o->ask_from(N("Type of install"), N("You haven't selected any group of packages. Please choose the minimal installation you want:"), [ { val => \$o->{compssUsersChoice}{X}, type => 'bool', text => N("With X"), disabled => sub { $minimal } }, { val => \$docs, type => 'bool', text => N("With basic documentation (recommended!)"), disabled => sub { $minimal } }, { val => \$minimal, type => 'bool', text => N("Truly minimal install (especially no urpmi)") }, ], changed => sub { $o->{compssUsersChoice}{X} = $docs = 0 if $minimal }, ) or return &chooseGroups; $o->{excludedocs} = !$docs || $minimal; #- reselect according to user selection. if ($minimal) { $o->{compssUsersChoice}{$_} = 0 foreach keys %{$o->{compssUsersChoice}}; } else { my $X = $o->{compssUsersChoice}{X}; #- don't let setDefaultPackages modify this one install_any::setDefaultPackages($o, 'clean'); $o->{compssUsersChoice}{X} = $X; } install_any::unselectMostPackages($o); } 1; } sub reallyChooseGroups { my ($o, $size_to_display, $individual, $val) = @_; my $size_text = &$size_to_display; my ($path, $all); $o->ask_from_({ messages => N("Package Group Selection"), interactive_help_id => 'choosePackages', callbacks => { changed => sub { $size_text = &$size_to_display } }, }, [ { val => \$size_text, type => 'label' }, {}, (map { my $old = $path; $path = $o->{compssUsers}{$_}{path}; if_($old ne $path, { val => translate($path) }), { val => \$val->{$_}, type => 'bool', disabled => sub { $all }, text => translate($o->{compssUsers}{$_}{label}), help => translate($o->{compssUsers}{$_}{descr}), } } @{$o->{compssUsersSorted}}), if_($o->{meta_class} eq 'desktop', { text => N("All"), val => \$all, type => 'bool' }), if_($individual, { text => N("Individual package selection"), val => $individual, advanced => 1, type => 'bool' }), ]); if ($all) { $val->{$_} = 1 foreach keys %$val; } 1; } sub chooseCD { my ($o, $packages) = @_; my @mediums = grep { $_ != $install_any::boot_medium } pkgs::allMediums($packages); my @mediumsDescr; my %mediumsDescr; if (!common::usingRamdisk()) { #- mono-cd in case of no ramdisk foreach (@mediums) { pkgs::mediumDescr($packages, $install_any::boot_medium) eq pkgs::mediumDescr($packages, $_) and next; undef $packages->{mediums}{$_}{selected}; } log::l("low memory install, using single CD installation (as it is not ejectable)"); return; } #- the boot medium is already selected. $mediumsDescr{pkgs::mediumDescr($packages, $install_any::boot_medium)} = 1; #- build mediumDescr according to mediums, this avoid asking multiple times #- all the medium grouped together on only one CD. foreach (@mediums) { my $descr = pkgs::mediumDescr($packages, $_); $packages->{mediums}{$_}{ignored} and next; exists $mediumsDescr{$descr} or push @mediumsDescr, $descr; $mediumsDescr{$descr} ||= $packages->{mediums}{$_}{selected}; } #- if no other medium available or a poor beginner, we are choosing for him! #- note first CD is always selected and should not be unselected! return if @mediumsDescr == () || !$::expert; # $o->set_help('chooseCD'); $o->ask_many_from_list('', N("If you have all the CDs in the list below, click Ok. If you have none of those CDs, click Cancel. If only some CDs are missing, unselect them, then click Ok."), { list => \@mediumsDescr, label => sub { N("Cd-Rom labeled \"%s\"", $_[0]) }, val => sub { \$mediumsDescr{$_[0]} }, }) or do { $mediumsDescr{$_} = 0 foreach @mediumsDescr; #- force unselection of other CDs. }; #- restore true selection of medium (which may have been grouped together) foreach (@mediums) { my $descr = pkgs::mediumDescr($packages, $_); $packages->{mediums}{$_}{ignored} and next; $packages->{mediums}{$_}{selected} = $mediumsDescr{$descr}; log::l("select status of medium $_ is $packages->{mediums}{$_}{selected}"); } } #------------------------------------------------------------------------------ sub installPackages { my ($o, $packages) = @_; my ($current, $total) = (0, 0); my $w = $o->wait_message(N("Installing"), N("Preparing installation")); my $old = \&pkgs::installCallback; local *pkgs::installCallback = sub { my ($data, $type, $id, $subtype, $_amount, $total_) = @_; if ($type eq 'user' && $subtype eq 'install') { $total = $total_; } elsif ($type eq 'inst' && $subtype eq 'start') { my $p = $data->{depslist}[$id]; $w->set(N("Installing package %s\n%d%%", $p->name, $total && 100 * $current / $total)); $current += $p->size; } else { goto $old } }; #- the modification is not local as the box should be living for other package installation. #- BEWARE this is somewhat duplicated (but not exactly from gtk code). undef *install_any::changeMedium; *install_any::changeMedium = sub { my ($method, $medium) = @_; #- if not using a cdrom medium, always abort. $method eq 'cdrom' && !$::oem and do { my $name = pkgs::mediumDescr($o->{packages}, $medium); local $| = 1; print "\a"; my $r = $name !~ /commercial/i || ($o->{useless_thing_accepted2} ||= $o->ask_from_list_('', formatAlaTeX(install_messages::com_license()), [ N_("Accept"), N_("Refuse") ], "Accept") eq "Accept"); $r &&= $o->ask_okcancel('', N("Change your Cd-Rom! Please insert the Cd-Rom labelled \"%s\" in your drive and press Ok when done. If you don't have it, press Cancel to avoid installation from this Cd-Rom.", $name), 1); return $r; }; }; my $install_result; catch_cdie { $install_result = $o->install_steps::installPackages($packages) } sub { if ($@ =~ /^error ordering package list: (.*)/) { $o->ask_yesorno('', [ N("There was an error ordering packages:"), $1, N("Go on anyway?") ], 1) and return 1; ${$_[0]} = "already displayed"; } elsif ($@ =~ /^error installing package list: (.*)/) { $o->ask_yesorno('', [ N("There was an error installing packages:"), $1, N("Go on anyway?") ], 1) and return 1; ${$_[0]} = "already displayed"; } 0; }; if ($pkgs::cancel_install) { $pkgs::cancel_install = 0; die "setstep choosePackages\n"; } $install_result; } sub afterInstallPackages($) { my ($o) = @_; my $_w = $o->wait_message('', N("Post-install configuration")); $o->SUPER::afterInstallPackages; } sub copyKernelFromFloppy { my ($o) = @_; $o->ask_okcancel('', N("Please insert the Boot floppy used in drive %s", $o->{blank}), 1) or return; $o->SUPER::copyKernelFromFloppy; } sub updateModulesFromFloppy { my ($o) = @_; $o->ask_okcancel('', N("Please insert the Update Modules floppy in drive %s", $o->{updatemodules}), 1) or return; $o->SUPER::updateModulesFromFloppy; } #------------------------------------------------------------------------------ sub configureNetwork { my ($o) = @_; require network::network; network::network::easy_dhcp($o->{netc}, $o->{intf}) and $o->{netcnx}{type} = 'lan'; $o->SUPER::configureNetwork; } #------------------------------------------------------------------------------ sub installUpdates { my ($o) = @_; my $u = $o->{updates} ||= {}; $o->hasNetwork or return; if (is_empty_hash_ref($u)) { $o->ask_yesorno_({ messages => formatAlaTeX( N("You now have the opportunity to download updated packages. These packages have been updated after the distribution was released. They may contain security or bug fixes. To download these packages, you will need to have a working Internet connection. Do you want to install the updates ?")), interactive_help_id => 'installUpdates', }) or return; } #- bring all interface up for installing crypto packages. install_interactive::upNetwork($o); #- update medium available and working. my $update_medium; do { require crypto; eval { my @mirrors = do { my $_w = $o->wait_message('', N("Contacting Mandrakelinux web site to get the list of available mirrors...")); crypto::mirrors($o->{distro_type}); }; #- if no mirror have been found, use current time zone and propose among available. $u->{mirror} ||= crypto::bestMirror($o->{timezone}{timezone}, $o->{distro_type}); $o->ask_from_({ messages => N("Choose a mirror from which to get the packages"), cancel => N("Cancel"), }, [ { separator => '|', format => \&crypto::mirror2text, list => \@mirrors, val => \$u->{mirror}, }, ], ) or $u->{mirror} = ''; }; return if $@ || !$u->{mirror}; eval { if ($u->{mirror}) { my $_w = $o->wait_message('', N("Contacting the mirror to get the list of available packages...")); $update_medium = crypto::getPackages($o->{prefix}, $o->{packages}, $u->{mirror}); } }; } while $@ || !$update_medium && $o->ask_yesorno('', N("Unable to contact mirror %s", $u->{mirror}) . ($@ ? " :\n$@" : "") . "\n\n" . N("Would you like to try again?")); if ($update_medium) { if ($o->choosePackagesTree($o->{packages}, $update_medium)) { $o->{isUpgrade} = 1; #- now force upgrade mode, else update will be installed instead of upgraded. $o->pkg_install; } else { #- make sure to not try to install the packages (which are automatically selected by getPackage above). #- this is possible by deselecting the medium (which can be re-selected above). delete $update_medium->{selected}; } #- update urpmi even, because there is an hdlist available and everything is good, #- this will allow user to update the medium but update his machine later. $o->install_urpmi; } #- stop interface using ppp only. FIXME REALLY TOCHECK isdn (costly network) ? # FIXME damien install_interactive::downNetwork($o, 'pppOnly'); } #------------------------------------------------------------------------------ sub configureTimezone { my ($o, $clicked) = @_; require timezone; $o->{timezone}{timezone} = $o->ask_from_treelist('', N("Which is your timezone?"), '/', [ timezone::getTimeZones() ], $o->{timezone}{timezone}) || return; my $ntp = to_bool($o->{timezone}{ntp}); $o->ask_from_({ interactive_help_id => 'configureTimezoneGMT' }, [ { text => N("Hardware clock set to GMT"), val => \$o->{timezone}{UTC}, type => 'bool' }, { text => N("Automatic time synchronization (using NTP)"), val => \$ntp, type => 'bool' }, ]) or goto &configureTimezone if $::expert || $clicked; if ($ntp) { my $servers = timezone::ntp_servers(); $o->{timezone}{ntp} ||= 'pool.ntp.org'; $o->ask_from_({}, [ { label => N("NTP Server"), val => \$o->{timezone}{ntp}, list => [ keys %$servers ], not_edit => 0, format => sub { $servers->{$_[0]} ? "$servers->{$_[0]} ($_[0])" : $_[0] } } ] ) or goto &configureTimezone; } else { $o->{timezone}{ntp} = ''; } install_steps::configureTimezone($o); 1; } #------------------------------------------------------------------------------ sub configureServices { my ($o, $clicked) = @_; require services; $o->{services} = services::ask($o) if $::expert || $clicked; install_steps::configureServices($o); } sub summaryBefore { my ($o) = @_; #- auto-detection $o->configurePrinter(0); install_any::preConfigureTimezone($o); #- get back network configuration. require network::network; eval { network::network::read_all_conf($o->{prefix}, $o->{netc} ||= {}, $o->{intf} ||= {}, $o->{netcnx} ||= {}); }; log::l("summaryBefore: network configuration: ", formatError($@)) if $@; } sub summary_prompt { my ($o, $l, $check_complete) = @_; foreach (@$l) { my $val = $_->{val}; ($_->{format}, $_->{val}) = (sub { $val->() || N("not configured") }, ''); } $o->ask_from_({ messages => N("Summary"), interactive_help_id => 'summary', cancel => '', callbacks => { complete => sub { !$check_complete->() } }, }, $l); } sub summary { my ($o) = @_; my @l; push @l, { group => N("System"), label => N("Keyboard"), val => sub { $o->{keyboard} && translate(keyboard::keyboard2text($o->{keyboard})) }, clicked => sub { $o->selectKeyboard(1) }, }; my $timezone_manually_set; push @l, { group => N("System"), label => N("Country / Region"), val => sub { lang::c2name($o->{locale}{country}) }, clicked => sub { any::selectCountry($o, $o->{locale}) or return; my $pkg_locale = substr(lang::getlocale_for_country($o->{locale}{lang}, $o->{locale}{country}), 0, 2); my @pkgs = pkgs::packagesProviding($o->{packages}, "locales-$pkg_locale"); $o->pkg_install(map { $_->name } @pkgs) if @pkgs; lang::write($o->{prefix}, $o->{locale}); if (!$timezone_manually_set) { delete $o->{timezone}; install_any::preConfigureTimezone($o); #- now we can precise the timezone thanks to the country } }, }; push @l, { group => N("System"), label => N("Timezone"), val => sub { $o->{timezone}{timezone} }, clicked => sub { $timezone_manually_set = $o->configureTimezone(1) || $timezone_manually_set }, }; push @l, { group => N("System"), label => N("Mouse"), val => sub { translate($o->{mouse}{type}) . ' ' . translate($o->{mouse}{name}) }, clicked => sub { $o->selectMouse(1); mouse::write($o, $o->{mouse}) }, }; push @l, { group => N("Hardware"), label => N("Printer"), val => sub { if (is_empty_hash_ref($o->{printer}{configured})) { require pkgs; my $p = pkgs::packageByName($o->{packages}, 'cups'); $p && $p->flag_installed ? N("Remote CUPS server") : N("No printer"); } elsif (defined($o->{printer}{configured}{$o->{printer}{DEFAULT}}) && (my $p = find { $_ && ($_->{make} || $_->{model}) } $o->{printer}{configured}{$o->{printer}{DEFAULT}}{queuedata})) { "$p->{make} $p->{model}"; } elsif ($p = find { $_ && ($_->{make} || $_->{model}) } map { $_->{queuedata} } (values %{$o->{printer}{configured}})) { "$p->{make} $p->{model}"; } else { N("Remote CUPS server"); #- fall back in case of something wrong. } }, clicked => sub { $o->configurePrinter(1) }, }; my @sound_cards = detect_devices::getSoundDevices(); my $sound_index = 0; foreach my $device (@sound_cards) { $device->{sound_slot_index} = $sound_index; push @l, { group => N("Hardware"), label => N("Sound card"), val => sub { $device->{driver} && modules::module2description($device->{driver}) || $device->{description}; }, clicked => sub { require harddrake::sound; harddrake::sound::config($o, $device); }, }; $sound_index++; } if (!@sound_cards && ($o->{compssUsersChoice}{GAMES} || $o->{compssUsersChoice}{AUDIO})) { #- if no sound card are detected AND the user selected things needing a sound card, #- propose a special case for ISA cards push @l, { group => N("Hardware"), label => N("Sound card"), val => sub {}, clicked => sub { if ($o->ask_yesorno('', N("Do you have an ISA sound card?"))) { $o->do_pkgs->install(qw(alsaconf sndconfig)); $o->ask_warn('', N("Run \"alsaconf\" or \"sndconfig\" after installation to configure your sound card")); } else { $o->ask_warn('', N("No sound card detected. Try \"harddrake\" after installation")); } }, }; } foreach my $tv (detect_devices::getTVcards()) { push @l, { group => N("Hardware"), label => N("TV card"), val => sub { $tv->{description} }, clicked => sub { require harddrake::v4l; harddrake::v4l::config($o, $tv->{driver}); } }; } push @l, { group => N("Hardware"), label => N("Graphical interface"), val => sub { $o->{raw_X} ? Xconfig::various::to_string($o->{raw_X}) : '' }, clicked => sub { configureX($o, 'expert') }, }; push @l, { group => N("Network & Internet"), label => N("Network"), val => sub { $o->{netcnx}{type} }, clicked => sub { local $::expert = $::expert; require network::netconnect; network::netconnect::main($o->{prefix}, $o->{netcnx} ||= {}, $o, $o->{netc}, $o->{mouse}, $o->{intf}, 0, 1); #- in case netcnx type is not updated. require network::network; network::network::probe_netcnx_type($o->{prefix}, $o->{netc}, $o->{intf}, $o->{netcnx}); }, }; $::o->{miscellaneous} ||= {}; push @l, { group => N("Network & Internet"), label => N("Proxies"), val => sub { $::o->{miscellaneous}{http_proxy} || $::o->{miscellaneous}{ftp_proxy} ? N("configured") : N("not configured") }, clicked => sub { require network::network; network::network::miscellaneous_choose($o, $::o->{miscellaneous}); network::network::proxy_configure($::o->{miscellaneous}) if !$::testing; }, }; push @l, { group => N("Security"), label => N("Security Level"), val => sub { require security::level; security::level::to_string($o->{security}); }, clicked => sub { require security::level; security::level::level_choose($o, \$o->{security}, \$o->{libsafe}, \$o->{security_user}) and install_any::set_security($o); }, }; push @l, { group => N("Security"), label => N("Firewall"), val => sub { require network::shorewall; my $shorewall = network::shorewall::read($o, 'silent'); $shorewall && !$shorewall->{disabled} ? N("activated") : N("disabled"); }, clicked => sub { require network::drakfirewall; network::drakfirewall::main($o, $o->{security} <= 3); }, } if detect_devices::getNet(); push @l, { group => N("Boot"), label => N("Bootloader"), val => sub { #-PO: example: lilo-graphic on /dev/hda1 N("%s on %s", $o->{bootloader}{method}, $o->{bootloader}{boot}) }, clicked => sub { any::setupBootloader($o, $o->{bootloader}, $o->{all_hds}, $o->{fstab}, $o->{security}) }, }; push @l, { group => N("System"), label => N("Services"), val => sub { require services; my ($l, $activated) = services::services(); N("Services: %d activated for %d registered", int(@$activated), int(@$l)); }, clicked => sub { require services; $o->{services} = services::ask($o) and services::doit($o, $o->{services}); }, }; my $check_complete = sub { $o->{raw_X} || !$::testing && !pkgs::packageByName($o->{packages}, 'XFree86')->flag_installed || $o->ask_yesorno('', N("You have not configured X. Are you sure you really want this?")); }; $o->summary_prompt(\@l, $check_complete); $o->cleanupPrinter; install_steps::configureTimezone($o) if !$timezone_manually_set; #- do not forget it. } #------------------------------------------------------------------------------ sub configurePrinter { my ($o, $clicked) = @_; require printer::main; require printer::printerdrake; require printer::detect; #- $clicked = 0: Preparation of "Summary" step, check whether there are #- are local printers. Continue for automatically setting up print #- queues if so, return otherwise #- $clicked = 1: User clicked "Configure" button in "Summary", enter #- Printerdrake for manual configuration my $go_on = $clicked ? 2 : $o && printer::detect::local_detect(); $go_on-- or return; #- install packages needed for printer::getinfo() $::testing or $o->do_pkgs->install('foomatic-db-engine'); #- take default configuration, this include choosing the right spooler #- currently used by the system. my $printer = $o->{printer} ||= {}; eval { add2hash($printer, printer::main::getinfo($o->{prefix})) }; $printer->{PAPERSIZE} = $o->{locale}{lang} eq 'en_US' || $o->{locale}{country} eq 'CA' ? 'Letter' : 'A4'; printer::printerdrake::main($printer, $o, $clicked, sub { install_interactive::upNetwork($o, 'pppAvoided') }); } sub cleanupPrinter { my ($o) = @_; #- Clean up $o->{printer} so that the records for an auto-installation #- contain only the important stuff return if !defined($o->{printer}); require printer::printerdrake; printer::printerdrake::final_cleanup($o->{printer}); } #------------------------------------------------------------------------------ sub setRootPassword { my ($o, $clicked) = @_; my $sup = $o->{superuser} ||= {}; $sup->{password2} ||= $sup->{password} ||= ""; if ($o->{security} >= 1 || $clicked) { require authentication; my $authentication_kind = authentication::to_kind($o->{authentication} ||= {}); $o->ask_from_({ title => N("Set root password and network authentication methods"), messages => N("Set root password"), interactive_help_id => "setRootPassword", cancel => ($o->{security} <= 2 && !$::corporate ? #-PO: keep this short or else the buttons will not fit in the window N("No password") : ''), focus_first => 1, callbacks => { complete => sub { $sup->{password} eq $sup->{password2} or $o->ask_warn('', [ N("The passwords do not match"), N("Please try again") ]), return 1,0; length $sup->{password} < 2 * $o->{security} and $o->ask_warn('', N("This password is too short (it must be at least %d characters long)", 2 * $o->{security})), return 1,0; return 0 } } }, [ { label => N("Password"), val => \$sup->{password}, hidden => 1 }, { label => N("Password (again)"), val => \$sup->{password2}, hidden => 1 }, { label => N("Authentication"), val => \$authentication_kind, list => [ authentication::kinds() ], format => \&authentication::kind2description, advanced => 1 }, ]) or delete $sup->{password}; authentication::ask_parameters($o, $o->{netc}, $o->{authentication}, $authentication_kind) or goto &setRootPassword; } install_steps::setRootPassword($o); } #------------------------------------------------------------------------------ #-addUser #------------------------------------------------------------------------------ sub addUser { my ($o, $clicked) = @_; $o->{users} ||= []; if ($o->{security} < 1) { push @{$o->{users}}, { password => 'mandrake', realname => 'default', icon => 'automagic' } if !member('mandrake', map { $_->{name} } @{$o->{users}}); } if ($o->{security} >= 1 || $clicked) { any::ask_users($o, $o->{users}, $o->{security}); } add2hash($o, any::get_autologin()); any::autologin($o, $o); install_steps::addUser($o); } #------------------------------------------------------------------------------ sub setupBootloaderBefore { my ($o) = @_; my $_w = $o->wait_message('', N("Preparing bootloader...")); $o->SUPER::setupBootloaderBefore; } #------------------------------------------------------------------------------ sub setupBootloader { my ($o, $ent_number) = @_; if (arch() =~ /ppc/) { my $machtype = detect_devices::get_mac_generation(); if ($machtype !~ /NewWorld/) { $o->ask_warn('', N("You appear to have an OldWorld or Unknown\n machine, the yaboot bootloader will not work for you.\nThe install will continue, but you'll\n need to use BootX or some other means to boot your machine")); log::l("OldWorld or Unknown Machine - no yaboot setup"); return; } } if (arch() =~ /^alpha/) { $o->ask_yesorno('', N("Do you want to use aboot?"), 1) or return; catch_cdie { $o->SUPER::setupBootloader } sub { $o->ask_yesorno('', N("Error installing aboot, try to force installation even if that destroys the first partition?")); }; } else { if ($ent_number == 1) { any::setupBootloader_simple($o, $o->{bootloader}, $o->{all_hds}, $o->{fstab}, $o->{security}) or return; } else { any::setupBootloader($o, $o->{bootloader}, $o->{all_hds}, $o->{fstab}, $o->{security}) or return; } { my $_w = $o->wait_message('', N("Installing bootloader")); eval { $o->SUPER::setupBootloader }; } if (my $err = $@) { $err =~ s/^\w+ failed// or die; $err = formatError($err); while ($err =~ s/^Warning:.*//m) {} $o->ask_warn('', [ N("Installation of bootloader failed. The following error occured:"), $err ]); die "already displayed"; } elsif (arch() =~ /ppc/) { my $of_boot = cat_("$o->{prefix}/tmp/of_boot_dev") || die "Can't open $o->{prefix}/tmp/of_boot_dev"; chop($of_boot); $o->ask_warn('', N("You may need to change your Open Firmware boot-device to\n enable the bootloader. If you don't see the bootloader prompt at\n reboot, hold down Command-Option-O-F at reboot and enter:\n setenv boot-device %s,\\\\:tbxi\n Then type: shut-down\nAt your next boot you should see the bootloader prompt.", $of_boot)); } } } sub miscellaneous { my ($o, $_clicked) = @_; if ($o->{meta_class} ne 'desktop' && !$o->{isUpgrade}) { require security::level; security::level::level_choose($o, \$o->{security}, \$o->{libsafe}, \$o->{security_user}); if ($o->{security} > 2 && find { isFat($_) } @{$o->{fstab}}) { $o->ask_okcancel('', N("In this security level, access to the files in the Windows partition is restricted to the administrator.")) or goto &miscellaneous; } } install_steps::miscellaneous($o); } #------------------------------------------------------------------------------ sub configureX { my ($o, $expert) = @_; install_steps::configureXBefore($o); symlink "$o->{prefix}/etc/gtk", "/etc/gtk"; my $options = { allowFB => $o->{allowFB}, }; require Xconfig::main; if (my $raw_X = Xconfig::main::configure_everything_or_configure_chooser($o, $options, !$expert, $o->{keyboard}, $o->{mouse})) { $o->{raw_X} = $raw_X; install_steps::configureXAfter($o); } } #------------------------------------------------------------------------------ sub generateAutoInstFloppy { my ($o, $replay) = @_; my @imgs = install_any::getAndSaveAutoInstallFloppies($o, $replay) or return; my $floppy = detect_devices::floppy(); $o->ask_okcancel('', N("Insert a blank floppy in drive %s", $floppy), 1) or return; my $i; foreach (@imgs) { if ($i++) { $o->ask_okcancel('', N("Please insert another floppy for drivers disk"), 1) or return; } my $_w = $o->wait_message('', N("Creating auto install floppy...")); require commands; commands::dd("if=$_", 'of=' . devices::make($floppy)); common::sync(); } } #------------------------------------------------------------------------------ sub exitInstall { my ($o, $alldone) = @_; return $o->{step} = '' if !$alldone && !$o->ask_yesorno('', N("Some steps are not completed. Do you really want to quit now?"), 0); install_steps::exitInstall($o); $o->exit unless $alldone; $o->ask_from_no_check( { messages => formatAlaTeX(install_messages::install_completed()),