summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-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 }
ass="hl kwb">$m{$m} and die _("Duplicate mount point %s", $m); $m{$m} = 1; #- in case the type does not correspond, force it to ext2 $_->{type} = 0x83 if $m =~ m|^/| && !isFat($_); } } sub rebootNeeded($) { my ($o) = @_; log::l("Rebooting..."); c::_exit(0); } sub choosePartitionsToFormat($$) { my ($o, $fstab) = @_; foreach (@$fstab) { $_->{mntpoint} = "swap" if isSwap($_); $_->{mntpoint} or next; add2hash_($_, { toFormat => $_->{notFormatted} }); if (!$_->{toFormat}) { my $t = isLoopback($_) ? eval { fsedit::typeOfPart($o->{prefix} . loopback::file($_)) } : fsedit::typeOfPart($_->{device}); $_->{toFormatUnsure} = $_->{mntpoint} eq "/" || #- if detected dos/win, it's not precise enough to just compare the types (too many of them) (isFat({ type => $t }) ? !isFat($_) : $t != $_->{type}); } } } sub formatMountPartitions { my ($o) = @_; fs::formatMount_all($o->{raid}, $o->{fstab}, $o->{prefix}); } #------------------------------------------------------------------------------ sub setPackages { my ($o) = @_; install_any::setPackages($o); } sub selectPackagesToUpgrade { my ($o) = @_; install_any::selectPackagesToUpgrade($o); } sub choosePackages { my ($o, $packages, $compss, $compssUsers, $compssUsersSorted, $first_time) = @_; #- now for upgrade, package that must be upgraded are #- selected first, after is used the same scheme as install. #- make sure we kept some space left for available else the system may #- not be able to start (xfs at least). my $available = install_any::getAvailableSpace($o); my $availableCorrected = pkgs::invCorrectSize($available / sqr(1024)) * sqr(1024); log::l("available size $available (corrected $availableCorrected)"); foreach (values %{$packages->[0]}) { pkgs::packageSetFlagSkip($_, 0); pkgs::packageSetFlagUnskip($_, 0); } pkgs::unselectAllPackages($packages); pkgs::selectPackage($o->{packages}, pkgs::packageByName($o->{packages}, $_) || next) foreach @{$o->{default_packages}}; add2hash_($o, { compssListLevel => $::expert ? 90 : 80 }) unless $::auto_install; pkgs::setSelectedFromCompssList($o->{compssListLevels}, $packages, $o->{compssListLevel}, $availableCorrected, $o->{installClass}) if exists $o->{compssListLevel}; $availableCorrected; } sub beforeInstallPackages { my ($o) = @_; #- save these files in case of upgrade failure. if ($o->{isUpgrade}) { foreach (@filesToSaveForUpgrade) { unlink "$o->{prefix}/$_.mdkgisave"; if (-e "$o->{prefix}/$_") { eval { commands::cp("$o->{prefix}/$_", "$o->{prefix}/$_.mdkgisave") }; } } } #- some packages need such files for proper installation. install_any::write_ldsoconf($o->{prefix}); fs::write($o->{prefix}, $o->{fstab}, $o->{manualFstab}, $o->{useSupermount}); network::add2hosts("$o->{prefix}/etc/hosts", "localhost.localdomain", "127.0.0.1"); require pkgs; pkgs::init_db($o->{prefix}, $o->{isUpgrade}); } sub pkg_install { my ($o, @l) = @_; require pkgs; pkgs::selectPackage($o->{packages}, pkgs::packageByName($o->{packages}, $_) || die "$_ rpm not found") foreach @l; $o->installPackages; } sub installPackages($$) { #- complete REWORK, TODO and TOCHECK! my ($o) = @_; my $packages = $o->{packages}; if (@{$o->{toRemove} || []}) { #- hack to ensure proper upgrade of packages from other distribution, #- as release number are not mandrake based. this causes save of #- important files and restore them after. foreach (@{$o->{toSave} || []}) { if (-e "$o->{prefix}/$_") { unlink "$o->{prefix}/$_.mdkgisave"; eval { commands::cp("$o->{prefix}/$_", "$o->{prefix}/$_.mdkgisave") }; } } pkgs::remove($o->{prefix}, $o->{toRemove}); foreach (@{$o->{toSave} || []}) { if (-e "$o->{prefix}/$_.mdkgisave") { unlink "$o->{prefix}/$_"; rename "$o->{prefix}/$_.mdkgisave", "$o->{prefix}/$_"; } } $o->{toSave} = []; #- hack for compat-glibc to upgrade properly :-( if (pkgs::packageFlagSelected(pkgs::packageByName($packages, 'compat-glibc')) && !pkgs::packageFlagInstalled(pkgs::packageByName($packages, 'compat-glibc'))) { rename "$o->{prefix}/usr/i386-glibc20-linux", "$o->{prefix}/usr/i386-glibc20-linux.mdkgisave"; } } #- small transaction will be built based on this selection and depslist. my @toInstall = pkgs::packagesToInstall($packages); $ENV{DURING_INSTALL} = 1; pkgs::install($o->{prefix}, $o->{isUpgrade}, \@toInstall, $packages->[1], $packages->[2]); delete $ENV{DURING_INSTALL}; } sub afterInstallPackages($) { my ($o) = @_; return if $::g_auto_install; die _("Some important packages didn't get installed properly. Either your cdrom drive or your cdrom is defective. Check the cdrom on an installed computer using \"rpm -qpl Mandrake/RPMS/*.rpm\" ") if grep { m|read failed: Input/output error| } cat_("$o->{prefix}/root/install.log"); if (arch() !~ /^sparc/) { #- TODO restore it as may be needed for sparc -x "$o->{prefix}/usr/bin/dumpkeys" or $::testing or die "Some important packages didn't get installed properly. Please switch to console 2 (using ctrl-alt-f2) and look at the log file /tmp/ddebug.log Consoles 1,3,4,7 may also contain interesting information"; } pkgs::done_db(); #- why not? cuz weather is nice today :-) [pixel] sync(); sync(); $o->pcmciaConfig(); #- for mandrake_firstime output "$o->{prefix}/var/lock/TMP_1ST", ""; #- remove the nasty acon... run_program::rooted($o->{prefix}, "chkconfig", "--del", "acon") unless $ENV{LANGUAGE} =~ /ar/; #- make the mdk fonts last in available fonts for buggy kde run_program::rooted($o->{prefix}, "chkfontpath", "--remove", "/usr/X11R6/lib/X11/fonts/mdk"); run_program::rooted($o->{prefix}, "chkfontpath", "--add", "/usr/X11R6/lib/X11/fonts/mdk"); #- call update-menus at the end of package installation run_program::rooted($o->{prefix}, "update-menus"); #- mainly for auto_install's run_program::rooted($o->{prefix}, "sh", "-c", $o->{postInstall}) if $o->{postInstall}; #- create /etc/sysconfig/desktop file according to user choice and presence of /usr/bin/kdm or /usr/bin/gdm. my $f = "$o->{prefix}/etc/sysconfig/desktop"; if ($o->{compssUsersChoice}{KDE} && -x "$o->{prefix}/usr/bin/kdm") { output($f, "KDE\n"); } elsif ($o->{compssUsersChoice}{Gnome} && -x "$o->{prefix}/usr/bin/gdm") { output($f, "GNOME\n"); } if ($o->{pcmcia}) { substInFile { s/.*(TaskBarShowAPMStatus).*/$1=1/ } "$o->{prefix}/usr/lib/X11/icewm/preferences"; eval { commands::cp("$o->{prefix}/usr/share/applnk/System/kapm.kdelnk", "$o->{prefix}/etc/skel/Desktop/Autostart/kapm.kdelnk") }; } my $msec = "$o->{prefix}/etc/security/msec"; substInFile { s/^audio\n//; $_ .= "audio\n" if eof } "$msec/group.conf" if -d $msec; substInFile { s/^cdrom\n//; $_ .= "cdrom\n" if eof } "$msec/group.conf" if -d $msec; substInFile { s/^xgrp\n//; $_ .= "xgrp\n" if eof } "$msec/group.conf" if -d $msec; my $pkg = pkgs::packageByName($o->{packages}, 'urpmi'); if ($pkg && pkgs::packageFlagSelected($pkg)) { install_any::install_urpmi($o->{prefix}, $o->{method}, $o->{packages}[2]); substInFile { s/^urpmi\n//; $_ .= "urpmi\n" if eof } "$msec/group.conf" if -d $msec; } #- update language and icons for KDE. log::l("updating language for kde"); install_any::kdelang_postinstall($o->{prefix}); log::l("updating kde icons according to available devices"); install_any::kdeicons_postinstall($o->{prefix}); my $welcome = _("Welcome to %s", "[HOSTNAME]"); substInFile { s/^(GreetString)=.*/$1=$welcome/ } "$o->{prefix}/usr/share/config/kdmrc"; substInFile { s/^(UserView)=false/$1=true/ } "$o->{prefix}/usr/share/config/kdmrc" if $o->{security} < 3; run_program::rooted($o->{prefix}, "kdeDesktopCleanup"); #- konsole and gnome-terminal are lamers in exotic languages, link them to something better if ($o->{lang} =~ /ja|ko|zh/) { foreach ("konsole", "gnome-terminal") { my $f = "$o->{prefix}/usr/bin/$_"; symlinkf("X11/rxvt.sh", $f) if -e $f; } } #- my $hasttf; #- my $dest = "/usr/X11R6/lib/X11/fonts/drakfont"; #- foreach my $d (map { $_->{mntpoint} } grep { isFat($_) } @{$o->{fstab}}) { #- foreach my $D (map { "$d/$_" } grep { m|^win|i } all("$o->{prefix}$d")) { #- $D .= "/fonts"; #- -d "$o->{prefix}$D" or next; #- log::l("found win font dir $D"); #- if (!$hasttf) { #- $hasttf = $o->ask_okcancel('', #-_("Some true type fonts from windows have been found on your computer. #-Do you want to use them? Be sure you have the right to use them under Linux."), 1) or goto nottf; #- mkdir "$o->{prefix}$dest", 0755; #- } #- /(.*)\.ttf/i and symlink "$D/$_", "$o->{prefix}$dest/$1.ttf" foreach grep { /\.ttf/i } all("$o->{prefix}$D"); #- } #- } #- nottf: #- if ($hasttf) { #- run_program::rooted($o->{prefix}, "ttmkfdir", "-d", $dest, "-o", "$dest/fonts.dir"); #- run_program::rooted($o->{prefix}, "chkfontpath", "--add", $dest); #- } foreach (install_any::list_skels()) { my $found; substInFile { $found ||= /KFM Misc Defaults/; $_ .= "[KFM Misc Defaults] GridWidth=85 GridHeight=70 " if eof && !$found; } "$o->{prefix}$_/.kde/share/config/kfmrc" } #- move some file after an upgrade that may be seriously annoying. #- and rename saved files to .mdkgiorig. if ($o->{isUpgrade}) { log::l("moving previous desktop files that have been updated to Trash of each user"); install_any::move_desktop_file($o->{prefix}); foreach (@filesToSaveForUpgrade) { if (-e "$o->{prefix}$_.mdkgisave") { unlink "$o->{prefix}$_.mdkgiorig"; rename "$o->{prefix}/$_.mdkgisave", "$o->{prefix}/$_.mdkgiorig"; } } } } #------------------------------------------------------------------------------ sub selectMouse($) { my ($o) = @_; } #------------------------------------------------------------------------------ sub configureNetwork($) { my ($o) = @_; my $etc = "$o->{prefix}/etc"; network::write_conf("$etc/sysconfig/network", $o->{netc}); network::write_resolv_conf("$etc/resolv.conf", $o->{netc}); network::write_interface_conf("$etc/sysconfig/network-scripts/ifcfg-$_->{DEVICE}", $_) foreach @{$o->{intf}}; network::add2hosts("$etc/hosts", $o->{netc}{HOSTNAME}, map { $_->{IPADDR} } @{$o->{intf}}); network::sethostname($o->{netc}) unless $::testing; network::addDefaultRoute($o->{netc}) unless $::testing; $o->pkg_install("dhcpcd") if grep { $_->{BOOTPROTO} =~ /^(dhcp)$/ } @{$o->{intf}}; # Handle also pump (this is still in initscripts no?) $o->pkg_install("pump") if grep { $_->{BOOTPROTO} =~ /^(pump|bootp)$/ } @{$o->{intf}}; #-res_init(); #- reinit the resolver so DNS changes take affect miscellaneousNetwork($o); } #------------------------------------------------------------------------------ sub pppConfig { my ($o) = @_; $o->{modem} or return; symlinkf($o->{modem}{device}, "$o->{prefix}/dev/modem") or log::l("creation of $o->{prefix}/dev/modem failed"); $o->pkg_install("ppp") unless $::testing; my %toreplace; $toreplace{$_} = $o->{modem}{$_} foreach qw(connection phone login passwd auth domain dns1 dns2); $toreplace{kpppauth} = ${{ 'Script-based' => 0, 'PAP' => 1, 'Terminal-based' => 2, 'CHAP' => 3, }}{$o->{modem}{auth}}; $toreplace{phone} =~ s/\D//g; $toreplace{dnsserver} = join ',', map { $o->{modem}{$_} } "dns1", "dns2"; $toreplace{dnsserver} .= $toreplace{dnsserver} && ','; #- using peerdns or dns1,dns2 avoid writing a /etc/resolv.conf file. $toreplace{peerdns} = "yes"; $toreplace{connection} ||= 'DialupConnection'; $toreplace{domain} ||= 'localdomain'; $toreplace{intf} ||= 'ppp0'; $toreplace{papname} = $o->{modem}{auth} eq 'PAP' && $toreplace{login}; #- build ifcfg-ppp0. my $ifcfg = "$o->{prefix}/etc/sysconfig/network-scripts/ifcfg-ppp0"; local *IFCFG; open IFCFG, ">$ifcfg" or die "Can't open $ifcfg"; print IFCFG <<END; DEVICE="$toreplace{intf}" ONBOOT="no" USERCTL="no" MODEMPORT="/dev/modem" LINESPEED="115200" PERSIST="yes" DEFABORT="yes" DEBUG="yes" INITSTRING="ATZ" DEFROUTE="yes" HARDFLOWCTL="yes" ESCAPECHARS="no" PPPOPTIONS="" PAPNAME="$toreplace{papname}" REMIP="" NETMASK="" IPADDR="" MRU="" MTU="" DISCONNECTTIMEOUT="5" RETRYTIMEOUT="60" BOOTPROTO="none" PEERDNS="$toreplace{peerdns}" END foreach (1..2) { if ($toreplace{"dns$_"}) { print IFCFG <<END; DNS$_=$toreplace{"dns$_"} END } } close IFCFG; #- build chat-ppp0. my $chat = "$o->{prefix}/etc/sysconfig/network-scripts/chat-ppp0"; local *CHAT; open CHAT, ">$chat" or die "Can't open $chat"; print CHAT <<END; 'ABORT' 'BUSY' 'ABORT' 'ERROR' 'ABORT' 'NO CARRIER' 'ABORT' 'NO DIALTONE' 'ABORT' 'Invalid Login' 'ABORT' 'Login incorrect' '' 'ATZ' 'OK' 'ATDT$toreplace{phone}' 'CONNECT' '' END if ($o->{modem}{auth} eq 'Terminal-based' || $o->{modem}{auth} eq 'Script-based') { print CHAT <<END; 'ogin:' '$toreplace{login}' 'ord:' '$toreplace{passwd}' END } print CHAT <<END; 'TIMEOUT' '5' '~--' '' END close CHAT; if ($o->{modem}{auth} eq 'PAP') { #- need to create a secrets file for the connection. my $secrets = "$o->{prefix}/etc/ppp/" . lc($o->{modem}{auth}) . "-secrets"; my @l = cat_($secrets); my $replaced = 0; do { $replaced ||= 1 if s/^\s*"?$toreplace{login}"?\s+ppp0\s+(\S+)/"$toreplace{login}" ppp0 "$toreplace{passwd}"/; } foreach @l; if ($replaced) { local *F; open F, ">$secrets" or die "Can't open $secrets: $!"; print F @l; } else { local *F; open F, ">>$secrets" or die "Can't open $secrets: $!"; print F "$toreplace{login} ppp0 \"$toreplace{passwd}\"\n"; } #- restore access right to secrets file, just in case. chmod 0600, $secrets; } #- CHAP is not supported by initscripts, need patching before doing more on that here! #-install_any::template2userfile($o->{prefix}, "$ENV{SHARE_PATH}/kppprc.in", ".kde/share/config/kppprc", 1, %toreplace); commands::mkdir_("-p", "$o->{prefix}/usr/share/config"); template2file("$ENV{SHARE_PATH}/kppprc.in", "$o->{prefix}/usr/share/config/kppprc", %toreplace); miscellaneousNetwork($o); } #------------------------------------------------------------------------------ sub installCrypto { my ($o) = @_; my $u = $o->{crypto} or return; $u->{mirror} && $u->{packages} or return; $o->upNetwork; require crypto; my @crypto_packages = crypto::getPackages($o->{prefix}, $o->{packages}, $u->{mirror}); my $oldGetFile = \&install_any::getFile; local *install_any::getFile = sub { my ($rpmfile) = @_; if ($rpmfile =~ /^(.*)-[^-]*-[^-]*$/ && member($1, @crypto_packages)) { log::l("crypto::getFile $rpmfile"); crypto::getFile($rpmfile, $u->{mirror}); } else { #- use previous getFile typically if non cryptographic packages #- have been selected by dependancies. log::l("normal getFile $rpmfile"); &$oldGetFile($rpmfile); } }; $o->pkg_install(@{$u->{packages}}); } #------------------------------------------------------------------------------ sub pcmciaConfig($) { my ($o) = @_; my $t = $o->{pcmcia}; #- should be set after installing the package above else the file will be renamed. setVarsInSh("$o->{prefix}/etc/sysconfig/pcmcia", { PCMCIA => $t ? "yes" : "no", PCIC => $t, PCIC_OPTS => "", CORE_OPTS => "", }); } #------------------------------------------------------------------------------ sub timeConfig { my ($o, $f) = @_; require timezone; timezone::write($o->{prefix}, $o->{timezone}, $f); } #------------------------------------------------------------------------------ sub servicesConfig {} #------------------------------------------------------------------------------ sub printerConfig { my($o) = @_; if ($o->{printer}{configured}) { require pkgs; pkgs::selectPackage($o->{packages}, pkgs::packageByName($o->{packages}, 'rhs-printfilters')); $o->installPackages($o->{packages}); require printer; foreach (keys %{$o->{printer}{configured} || {}}) { log::l("configuring printer queue $_->{queue}"); printer::copy_printer_params($_, $o->{printer}); #- setup all configured queues, which is not the case interactively where #- only the working queue is setup on configuration. printer::configure_queue($o->{printer}); } } } #------------------------------------------------------------------------------ my @etc_pass_fields = qw(name pw uid gid realname home shell); sub setRootPassword($) { my ($o) = @_; my $p = $o->{prefix}; my $u = $o->{superuser} ||= {}; $u->{pw} ||= $u->{password} && install_any::crypt($u->{password}); my @lines = cat_(my $f = "$p/etc/passwd") or log::l("missing passwd file"), return; local *F; open F, "> $f" or die "failed to write file $f: $!\n"; foreach (@lines) { if (/^root:/) { chomp; my %l; @l{@etc_pass_fields} = split ':'; add2hash($u, \%l); $_ = join(':', @$u{@etc_pass_fields}) . "\n"; } print F $_; } } #------------------------------------------------------------------------------ sub addUser($) { my ($o) = @_; my $p = $o->{prefix}; my (%uids, %gids); foreach (glob_("$p/home")) { my ($u, $g) = (stat($_))[4,5]; $uids{$u} = 1; $gids{$g} = 1; } my %done; my @l = grep { if (!$_->{name} || getpwnam($_->{name}) || $done{$_->{name}}) { 0; } else { $_->{home} ||= "/home/$_->{name}"; my $u = $_->{uid} || ($_->{oldu} = (stat("$p$_->{home}"))[4]); my $g = $_->{gid} || ($_->{oldg} = (stat("$p$_->{home}"))[5]); #- search for available uid above 501 else initscripts may fail to change language for KDE. if (!$u || getpwuid($u)) { for ($u = 501; getpwuid($u) || $uids{$u}; $u++) {} } if (!$g || getgrgid($g)) { for ($g = 501; getgrgid($g) || $gids{$g}; $g++) {} } $_->{uid} = $u; $uids{$u} = 1; $_->{gid} = $g; $gids{$g} = 1; $_->{pw} ||= $_->{password} && install_any::crypt($_->{password}); $_->{shell} ||= "/bin/bash"; $done{$_->{name}} = 1; } } @{$o->{users} || []}; my @passwd = cat_("$p/etc/passwd");; local *F; open F, ">> $p/etc/passwd" or die "can't append to passwd file: $!"; print F join(':', @$_{@etc_pass_fields}), "\n" foreach @l; open F, ">> $p/etc/group" or die "can't append to group file: $!"; print F "$_->{name}:x:$_->{gid}:\n" foreach @l; foreach my $u (@l) { if (! -d "$p$u->{home}") { my $mode = $o->{security} < 2 ? 0755 : 0750; eval { commands::cp("-f", "$p/etc/skel", "$p$u->{home}") }; if ($@) { log::l("copying of skel failed: $@"); mkdir("$p$u->{home}", $mode); } else { chmod $mode, "$p$u->{home}"; } } eval { commands::chown_("-r", "$u->{uid}.$u->{gid}", "$p$u->{home}") } if $u->{uid} != $u->{oldu} || $u->{gid} != $u->{oldg}; } require any; any::addUsers($o->{prefix}, @l); } #------------------------------------------------------------------------------ sub createBootdisk($) { my ($o) = @_; my $dev = $o->{mkbootdisk} or return; my @l = detect_devices::floppies(); $dev = shift @l || die _("No floppy drive available") if $dev eq "1"; #- special case meaning autochoose return if $::testing; if (arch() =~ /^sparc/) { require silo; silo::mkbootdisk($o->{prefix}, install_any::kernelVersion($o), $dev, $o->{bootloader}{perImageAppend}); } else { require lilo; lilo::mkbootdisk($o->{prefix}, install_any::kernelVersion($o), $dev, $o->{bootloader}{perImageAppend}); } $o->{mkbootdisk} = $dev; } #------------------------------------------------------------------------------ sub readBootloaderConfigBeforeInstall { my ($o) = @_; my ($image, $v); if (arch() =~ /^sparc/) { require silo; add2hash($o->{bootloader} ||= {}, silo::read($o->{prefix}, "/etc/silo.conf")); } else { require lilo; add2hash($o->{bootloader} ||= {}, lilo::read($o->{prefix}, "/etc/lilo.conf")); } #- since kernel or kernel-smp may not be upgraded, it should be checked #- if there is a need to update existing lilo.conf entries by using that #- hash. my %ofpkgs = ( 'vmlinuz' => pkgs::packageByName($o->{packages}, 'kernel'), 'vmlinuz-smp' => pkgs::packageByName($o->{packages}, 'kernel-smp'), ); #- change the /boot/vmlinuz or /boot/vmlinuz-smp entries to follow symlink. foreach $image (keys %ofpkgs) { pkgs::packageFlagSelected($ofpkgs{$image}) or next; if (my $v = readlink "$o->{prefix}/boot/$image") { $v = "/boot/$v" if $v !~ m|^/|; if (-e "$o->{prefix}$v") { my $e = lilo::get("/boot/$image", $o->{bootloader}) or next; $e->{kernel_or_dev} = $v; log::l("renaming /boot/$image entry by $v"); } } } } sub setupBootloaderBefore { my ($o) = @_; if (arch() =~ /alpha/) { if (my $dev = fsedit::get_root($o->{fstab})) { $o->{bootloader}{boot} ||= "/dev/$dev->{rootDevice}"; $o->{bootloader}{root} ||= "/dev/$dev->{device}"; $o->{bootloader}{part_nb} ||= first($dev->{device} =~ /(\d+)/); } } elsif (arch() =~ /^sparc/) { require silo; silo::suggest($o->{prefix}, $o->{bootloader}, $o->{hds}, $o->{fstab}, install_any::kernelVersion($o)); } else { require lilo; lilo::suggest($o->{prefix}, $o->{bootloader}, $o->{hds}, $o->{fstab}, install_any::kernelVersion($o)); if ($o->{miscellaneous}{profiles}) { my $e = lilo::get_label("linux", $o->{bootloader}); push @{$o->{bootloader}{entries}}, { %$e, label => "office", append => "$e->{append} prof=Office" }; $e->{append} .= " prof=Home"; } lilo::suggest_floppy($o->{bootloader}) if $o->{security} <= 3; $o->{bootloader}{keytable} ||= keyboard::keyboard2kmap($o->{keyboard}); } } sub setupBootloader($) { my ($o) = @_; return if $::g_auto_install; if (arch() =~ /alpha/) { return if $::testing; my $b = $o->{bootloader}; $b->{boot} or $o->ask_warn('', "Can't install aboot, not a bsd disklabel"), return; run_program::rooted($o->{prefix}, "swriteboot", $b->{boot}, "/boot/bootlx") or do { cdie "swriteboot failed"; run_program::rooted($o->{prefix}, "swriteboot", "-f1", $b->{boot}, "/boot/bootlx"); }; run_program::rooted($o->{prefix}, "abootconf", $b->{boot}, $b->{part_nb}); output "$o->{prefix}/etc/aboot.conf", map_index { "$::i:$b->{part_nb}$_ root=$b->{root} $b->{perImageAppend}\n" } map { /$o->{prefix}(.*)/ } eval { glob_("$o->{prefix}/boot/vmlinux*") }; } elsif (arch() =~ /^sparc/) { silo::install($o->{prefix}, $o->{bootloader}); } else { lilo::install($o->{prefix}, $o->{bootloader}, $o->{fstab}, $o->{hds}); } } #------------------------------------------------------------------------------ sub setupXfreeBefore { my ($o) = @_; my $xkb = $o->{X}{keyboard}{xkb_keymap} || keyboard::keyboard2xkb($o->{keyboard}); if (!-e "$o->{prefix}/usr/X11R6/lib/X11/xkb/symbols/$xkb" && (my $f = keyboard::xmodmap_file($o->{keyboard}))) { commands::cp("-f", $f, "$o->{prefix}/etc/X11/xinit/Xmodmap"); $xkb = ''; } $o->{X}{keyboard}{xkb_keymap} = $xkb; $o->{X}{mouse} = $o->{mouse}; $o->{X}{wacom} = $o->{wacom}; require Xconfig; Xconfig::getinfoFromDDC($o->{X}); #- keep this here if the package has to be updated. $o->pkg_install("XFree86"); } sub setupXfree { my ($o) = @_; $o->setupXfreeBefore; require Xconfigurator; require class_discard; { local $::testing = 0; #- unset testing local $::auto = 1; local $::skiptest = 1; Xconfigurator::main($o->{prefix}, $o->{X}, class_discard->new, $o->{allowFB}, bool($o->{pcmcia}), sub { $o->pkg_install("XFree86-$_[0]"); }); } $o->setupXfreeAfter; } sub setupXfreeAfter { my ($o) = @_; if ($o->{X}{card}{server} eq 'FBDev') { unless (install_any::setupFB($o, Xconfigurator::getVGAMode($o->{X}))) { log::l("disabling automatic start-up of X11 if any as setup framebuffer failed"); Xconfigurator::rewriteInittab(3) unless $::testing; #- disable automatic start-up of X11 on error. } } if ($o->{X}{default_depth} >= 16 && $o->{X}{card}{default_wres} >= 1024) { log::l("setting large icon style for kde"); install_any::kderc_largedisplay($o->{prefix}); } } #------------------------------------------------------------------------------ sub miscellaneousNetwork { my ($o) = @_; setVarsInSh ("$o->{prefix}/etc/profile.d/proxy.sh", $o->{miscellaneous}, qw(http_proxy ftp_proxy)); setVarsInCsh("$o->{prefix}/etc/profile.d/proxy.csh", $o->{miscellaneous}, qw(http_proxy ftp_proxy)); } #------------------------------------------------------------------------------ sub miscellaneous { my ($o) = @_; my %s = getVarsFromSh("$o->{prefix}/etc/sysconfig/system"); $o->{miscellaneous}{HDPARM} ||= $s{HDPARM} if exists $s{HDPARM}; $o->{miscellaneous}{CLEAN_TMP} ||= $s{CLEAN_TMP} if exists $s{CLEAN_TMP}; $o->{security} ||= $s{SECURITY} if exists $s{SECURITY}; $ENV{SECURE_LEVEL} = $o->{security}; add2hash_ $o, { useSupermount => $o->{security} < 4 && $o->{installClass} !~ /corporate|server/ }; cat_("/proc/cmdline") =~ /mem=(\S+)/; add2hash_($o->{miscellaneous} ||= {}, { numlock => !$o->{pcmcia}, $1 ? (memsize => $1) : () }); local $_ = $o->{bootloader}{perImageAppend}; if (my $ramsize = $o->{miscellaneous}{memsize} and !/mem=/) { $_ .= " mem=$ramsize"; } if (my @l = detect_devices::getIDEBurners() and !/ide-scsi/) { $_ .= " " . join(" ", (map { "$_=ide-scsi" } @l), map { "$_->{device}=ide-floppy" } detect_devices::ide_zips()); } if (my $m = detect_devices::hasUltra66()) { $_ .= " $m" if !/ide.=/; } #- keep some given parameters #-TODO log::l("perImageAppend: $_"); $o->{bootloader}{perImageAppend} = $_; } #------------------------------------------------------------------------------ sub generateAutoInstFloppy($) { my ($o) = @_; } #------------------------------------------------------------------------------ sub hasNetwork { my ($o) = @_; $o->{intf} && $o->{netc}{NETWORKING} ne 'false' || $o->{modem}; } #------------------------------------------------------------------------------ sub upNetwork { my ($o, $pppAvoided) = @_; foreach (qw(resolv.conf protocols services)) { symlinkf("$o->{prefix}/etc/$_", "/etc/$_"); } modules::write_conf("$o->{prefix}/etc/conf.modules"); if ($o->{intf} && $o->{netc}{NETWORKING} ne 'false') { network::up_it($o->{prefix}, $o->{intf}); } elsif (!$pppAvoided && $o->{modem} && !$o->{modem}{isUp}) { eval { modules::load_multi(qw(serial ppp bsd_comp ppp_deflate)) }; run_program::rooted($o->{prefix}, "/etc/rc.d/init.d/syslog", "start"); run_program::rooted($o->{prefix}, "ifup", "ppp0"); $o->{modem}{isUp} = 1; } else { $::testing or return; } 1; } #------------------------------------------------------------------------------ sub downNetwork { my ($o, $pppOnly) = @_; modules::write_conf("$o->{prefix}/etc/conf.modules"); if (!$pppOnly && $o->{intf} && $o->{netc}{NETWORKING} ne 'false') { network::down_it($o->{prefix}, $o->{intf}); } elsif ($o->{modem} && $o->{modem}{isUp}) { run_program::rooted($o->{prefix}, "ifdown", "ppp0"); run_program::rooted($o->{prefix}, "/etc/rc.d/init.d/syslog", "stop"); eval { modules::unload($_) foreach qw(ppp_deflate bsd_comp ppp serial) }; $o->{modem}{isUp} = 0; } else { $::testing or return; } 1; } #------------------------------------------------------------------------------ sub cleanIfFailedUpgrade($) { my ($o) = @_; #- if an upgrade has failed, there should be .mdkgisave files around. if ($o->{isUpgrade}) { foreach (@filesToSaveForUpgrade) { if (-e "$o->{prefix}/$_" && -e "$o->{prefix}/$_.mdkgisave") { rename "$o->{prefix}/$_", "$o->{prefix}/$_.mdkginew"; #- keep new files around in case ! rename "$o->{prefix}/$_.mdkgisave", "$o->{prefix}/$_"; } } } } #-###################################################################################### #- Wonderful perl :( #-###################################################################################### 1;