summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/common.pm43
-rw-r--r--perl-install/detect_devices.pm8
-rw-r--r--perl-install/install2.pm39
-rw-r--r--perl-install/install_steps.pm22
-rw-r--r--perl-install/install_steps_interactive.pm12
-rw-r--r--perl-install/my_gtk.pm36
-rw-r--r--perl-install/network.pm33
-rw-r--r--perl-install/resize_fat/directory.pm2
8 files changed, 119 insertions, 76 deletions
diff --git a/perl-install/common.pm b/perl-install/common.pm
index 78533befc..e1b44ac2d 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -7,7 +7,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int
@ISA = qw(Exporter);
%EXPORT_TAGS = (
common => [ qw(__ min max sum sign product bool ikeys member divide is_empty_array_ref add2hash set_new set_add round_up round_down first second top uniq translate untranslate warp_text) ],
- functional => [ qw(fold_left difference2 before_leaving catch_cdie cdie) ],
+ functional => [ qw(fold_left map_index mapn mapn_ difference2 before_leaving catch_cdie cdie) ],
file => [ qw(dirname basename touch all glob_ cat_ chop_ mode) ],
system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_ getVarsFromSh setVarsInSh) ],
constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE) ],
@@ -21,14 +21,21 @@ $SECTORSIZE = 512;
1;
+sub fold_left(&@) {
+ my $f = shift;
+ local $a = shift;
+ foreach $b (@_) { $a = &$f() }
+ $a
+}
+
sub _ { my $s = shift @_; sprintf translate($s), @_ }
#delete $main::{'_'};
sub __ { $_[0] }
-sub min { fold_left(sub { $a < $b ? $a : $b }, @_) }
-sub max { fold_left(sub { $a > $b ? $a : $b }, @_) }
-sub sum { fold_left(sub { $a + $b }, @_) }
+sub min { fold_left { $a < $b ? $a : $b } @_ }
+sub max { fold_left { $a > $b ? $a : $b } @_ }
+sub sum { fold_left { $a + $b } @_ }
sub sign { $_[0] <=> 0 }
-sub product { fold_left(sub { $a * $b }, @_) }
+sub product { fold_left { $a * $b } @_ }
sub first { $_[0] }
sub second { $_[1] }
sub top { $_[$#_] }
@@ -68,13 +75,31 @@ sub touch {
utime $now, $now, $f;
}
-sub fold_left(&$@) {
+sub map_index(&@) {
my $f = shift;
- local $a = shift;
- foreach $b (@_) { $a = &$f() }
- $a
+ my @l;
+ local $::i = 0;
+ foreach (@_) { push @l, &$f($::i); $::i++; }
+ @l;
}
+sub smapn {
+ my $f = shift;
+ my $n = shift;
+ my @r = ();
+ for (my $i = 0; $i < $n; $i++) { push @r, &$f(map { $_->[$i] } @_); }
+ @r
+}
+sub mapn(&@) {
+ my $f = shift;
+ smapn($f, min(map { scalar @$_ } @_), @_);
+}
+sub mapn_(&@) {
+ my $f = shift;
+ smapn($f, max(map { scalar @$_ } @_), @_);
+}
+
+
sub add_f4before_leaving {
my ($f, $b, $name) = @_;
diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm
index d226d033b..327f12754 100644
--- a/perl-install/detect_devices.pm
+++ b/perl-install/detect_devices.pm
@@ -128,12 +128,8 @@ sub getDAC960() {
}
-sub getNet() {
- # I should probably ask which device to use if multiple ones are available -- oh well :-(
- foreach (qw(eth0 tr0 plip0 plip1 plip2 fddi0)) {
- hasNetDevice($_) and log::l("$_ is available -- using it for networking"), return $_;
- }
- undef;
+sub getNet() {
+ grep { hasNetDevice($_) } qw(eth0 tr0 plip0 plip1 plip2 fddi0);
}
sub getPlip() {
foreach (0..2) {
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 90b8d8b2d..457b5bf83 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -100,15 +100,15 @@ appropriate to you."),
my @installStepsFields = qw(text redoable onError needs);
my @installSteps = (
-# selectLanguage => [ __("Choose your language"), 1, 1 ],
-# selectPath => [ __("Choose install or upgrade"), 0, 0 ],
-# selectInstallClass => [ __("Select installation class"), 1, 1, "selectPath" ],
-# setupSCSI => [ __("Setup SCSI"), 1, 0 ],
-# partitionDisks => [ __("Setup filesystems"), 1, 0 ],
-# formatPartitions => [ __("Format partitions"), 1, -1, "partitionDisks" ],
-# choosePackages => [ __("Choose packages to install"), 1, 1, "selectInstallClass" ],
-# doInstallStep => [ __("Install system"), 1, -1, ["formatPartitions", "selectPath"] ],
-## configureMouse => [ __("Configure mouse"), 0, 0 ],
+ selectLanguage => [ __("Choose your language"), 1, 1 ],
+ selectPath => [ __("Choose install or upgrade"), 0, 0 ],
+ selectInstallClass => [ __("Select installation class"), 1, 1, "selectPath" ],
+ setupSCSI => [ __("Setup SCSI"), 1, 0 ],
+ partitionDisks => [ __("Setup filesystems"), 1, 0 ],
+ formatPartitions => [ __("Format partitions"), 1, -1, "partitionDisks" ],
+ choosePackages => [ __("Choose packages to install"), 1, 1, "selectInstallClass" ],
+ doInstallStep => [ __("Install system"), 1, -1, ["formatPartitions", "selectPath"] ],
+# configureMouse => [ __("Configure mouse"), 0, 0 ],
configureNetwork => [ __("Configure networking"), 1, 1, "formatPartitions" ],
# configureTimezone => [ __("Configure timezone"), 0, 0 ],
# configureServices => [ __("Configure services"), 0, 0 ],
@@ -168,6 +168,7 @@ $o = $::o = {
# isUpgrade => 0,
# installClass => 'beginner',
+ intf => [ { DEVICE => "eth0", IPADDR => '1.2.3.4', NETMASK => '255.255.255.128' } ],
default => $default,
steps => \%installSteps,
orderedSteps => \@orderedInstallSteps,
@@ -243,16 +244,12 @@ sub partitionDisks {
sub formatPartitions {
$o->choosePartitionsToFormat($o->{fstab});
- $::testing and return;
-
- $o->formatPartitions(@{$o->{fstab}});
-
- fs::mount_all([ grep { isExt2($_) || isSwap($_) } @{$o->{fstab}} ], $o->{prefix});
-
+ unless ($::testing) {
+ $o->formatPartitions(@{$o->{fstab}});
+ fs::mount_all([ grep { isExt2($_) || isSwap($_) } @{$o->{fstab}} ], $o->{prefix});
+ }
mkdir "$o->{prefix}/$_", 0755 foreach qw(dev etc etc/sysconfig etc/sysconfig/network-scripts
home mnt tmp var var/tmp var/lib var/lib/rpm);
- network::add2hosts("$o->{prefix}/etc/hosts", "127.0.0.1", "localhost.localdomain");
- pkgs::init_db($o->{prefix}, $o->{isUpgrade});
}
sub choosePackages {
@@ -272,12 +269,13 @@ sub choosePackages {
}
sub doInstallStep {
+ $o->beforeInstallPackages;
$o->installPackages($o->{packages});
$o->afterInstallPackages;
}
sub configureMouse { $o->mouseConfig }
-sub configureNetwork { $o->configureNetwork }
+sub configureNetwork { $o->configureNetwork($o->{steps}{$o->{step}}{entered} == 1 && !$_[0]) }
sub configureTimezone { $o->timeConfig }
sub configureServices { $o->servicesConfig }
sub setRootPassword { $o->setRootPassword }
@@ -331,11 +329,10 @@ sub main {
$o = install_steps_graphical->new($o);
- # all information is put in {intf}, but don't let network be aware of this :)
- $o->{intf} = network::read_conf("/tmp/network");
+ $o->{netc} = network::read_conf("/tmp/network");
if (my ($file) = glob_('/tmp/ifcfg-*')) {
log::l("found network config file $file");
- $o->{intf} = network::read_interface_conf($file);
+ push @{$o->{intf}}, network::read_interface_conf($file);
}
modules::load_deps("/modules/modules.dep");
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index a42cb57bd..af02ae1d6 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -69,7 +69,10 @@ sub leavingStep($$) {
}
while (my $f = shift @{$o->{steps}{$step}{toBeDone} || []}) {
- &$f();
+ eval { &$f() };
+ $o->ask_warn(_("Error"), [
+_("An error occured, i don't know how to handle it nicely,
+so continue at your own risk :("), $@ ]) if $@;
}
}
@@ -118,6 +121,13 @@ sub choosePackages($$$) {
my ($o, $packages, $compss) = @_;
}
+sub beforeInstallPackages {
+ my ($o) = @_;
+
+ network::add2hosts("$o->{prefix}/etc/hosts", "localhost.localdomain", "127.0.0.1");
+ pkgs::init_db($o->{prefix}, $o->{isUpgrade});
+}
+
sub installPackages($$) {
my ($o, $packages) = @_;
my $toInstall = [ grep { $_->{selected} && !$_->{installed} } values %$packages ];
@@ -140,15 +150,13 @@ sub mouseConfig($) {
sub configureNetwork($) {
my ($o) = @_;
my $etc = "$o->{prefix}/etc";
-
- # all information is in {intf}, but don't let network be aware of this :)
#
# rc = checkNetConfig(&$o->{intf}, &$o->{netc}, &$o->{intfFinal},
# &$o->{netcFinal}, &$o->{driversLoaded}, $o->{direction});
- network::write_conf("$etc/sysconfig/network", $o->{intf});
- network::write_interface_conf("$etc/sysconfig/network-scripts/ifcfg-$o->{intf}{DEVICE}", $o->{intf});
- network::write_resolv_conf("$etc/resolv.conf", $o->{intf});
- network::add2hosts("$etc/hosts", $o->{intf}{IPADDR}, $o->{intf}{HOSTNAME});
+ 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}});
# syscall_('sethostname', $hostname, length $hostname) or warn "sethostname failed: $!";
#res_init(); # reinit the resolver so DNS changes take affect
}
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index dca0255d0..1ad5d3e2a 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -10,6 +10,7 @@ use vars qw(@ISA);
use common qw(:common);
use partition_table qw(:types);
use install_steps;
+use network;
use modules;
use lang;
use fs;
@@ -122,7 +123,16 @@ sub configureNetwork($) {
}
if ($r !~ /^Keep/) {
- $o->configureNetworkAsk or return;
+ my @l = first(network::getNet());
+ @l = ($l[0]) unless $::expert; # keep only one
+
+ foreach my $dev (@l) {
+ my ($l) = grep { $_->{DEVICE} eq $dev } @{$o->{intf}};
+
+ push @{$o->{intf}}, $l = { DEVICE => $dev } unless $l;
+ $o->configureNetworkIntf($l);
+ }
+ $o->configureNetworkNet($o->{netc} ||= {});
}
$o->SUPER::configureNetwork;
}
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index 469f4c2d4..887bc3e0f 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -15,7 +15,7 @@ $EXPORT_TAGS{all} = [ map { @$_ } values %EXPORT_TAGS ];
use Gtk;
use c;
-use common qw(:common);
+use common qw(:common :functional);
my $forgetTime = 1000; # in milli-seconds
$border = 5;
@@ -229,17 +229,17 @@ sub create_adjustment($$$) {
sub create_packtable($@) {
my $options = shift;
my $w = new Gtk::Table(0, 0, $options->{homogeneous} || 0);
- my $i = 0; foreach (@_) {
- for (my $j = 0; $j < @$_; $j++) {
- if (defined $_->[$j]) {
- my $l = $_->[$j];
- ref $l or $l = new Gtk::Label($l);
- $w->attach_defaults($l, $j, $j + 1, $i, $i + 1);
- $l->show;
+ map_index {
+ my ($i) = @_;
+ map_index {
+ my ($j) = @_;
+ if (defined $_) {
+ ref $_ or $_ = new Gtk::Label($_);
+ $w->attach_defaults($_, $j, $j + 1, $i, $i + 1);
+ $_->show;
}
- }
- $i++;
- }
+ } @$_;
+ } @_;
$w->set_col_spacings($options->{col_spacings} || 0);
$w->set_row_spacings($options->{row_spacings} || 0);
$w
@@ -341,10 +341,10 @@ sub _ask_from_list($$$$) {
$o->{retval} = $l->[$list->child_position($_[1])];
Gtk->main_quit;
});
- for (my $i = 0; $i < @$l; $i++) {
- my $focused = $i;
- $def = $i if $l->[$i] eq $def;
- my $w = new Gtk::ListItem($l->[$i]);
+ map_index {
+ my ($i) = @_;
+ $def = $i if $_ eq $def;
+ my $w = new Gtk::ListItem($_);
my $id = $w->signal_connect(key_press_event => sub {
my ($w, $e) = @_;
my $c = chr $e->{keyval};
@@ -353,11 +353,11 @@ sub _ask_from_list($$$$) {
if ($e->{keyval} >= 0x100) {
if ($c eq "\r" || $c eq "\x8d") {
- $list->select_item($focused);
+ $list->select_item($i);
}
$starting_word = '';
} else {
- my $curr = $focused + bool($starting_word eq '' || $starting_word eq $c);
+ my $curr = $i + bool($starting_word eq '' || $starting_word eq $c);
$starting_word .= $c unless $starting_word eq $c;
my $j; for ($j = 0; $j < @$l; $j++) {
@@ -373,7 +373,7 @@ sub _ask_from_list($$$$) {
});
push @::ask_from_list_widgets, $w; # hack!! to not get SIGSEGV
push @widgets, $w;
- }
+ } @$l;
gtkadd($list, @widgets);
gtkadd($o->{window},
gtkpack($o->create_box_with_title(@$messages),
diff --git a/perl-install/network.pm b/perl-install/network.pm
index b97a043ed..bce10e35a 100644
--- a/perl-install/network.pm
+++ b/perl-install/network.pm
@@ -5,7 +5,7 @@ use strict;
use Socket;
-use common qw(:common :file :system);
+use common qw(:common :file :system :functional);
use detect_devices;
use modules;
use log;
@@ -66,13 +66,20 @@ sub write_resolv_conf {
sub write_interface_conf {
my ($file, $intf) = @_;
- add2hash($intf, { ONBOOT => "yes" });
+ my @ip = split '\.', $intf->{IPADDR};
+ my @mask = split '\.', $intf->{NETMASK};
+ add2hash($intf, {
+ BROADCAST => join('.', mapn { int $_[0] | ~int $_[1] & 255 } \@ip, \@mask),
+ NETWORK => join('.', mapn { int $_[0] & $_[1] } \@ip, \@mask),
+ ONBOOT => "yes",
+ });
setVarsInSh($file, $intf, qw(DEVICE BOOTPROTO IPADDR NETMASK NETWORK BROADCAST ONBOOT));
}
sub add2hosts {
- my ($file, $ip, $hostname) = @_;
- my %l = ($ip => $hostname);
+ my ($file, $hostname, @ips) = @_;
+ my %l;
+ $l{$_} = $hostname foreach @ips;
local *F;
if (-e $file) {
@@ -116,17 +123,17 @@ sub addDefaultRoute {
c::addDefaultRoute($netc->{gateway}) if $netc->{gateway} || !$::testing;
}
-sub getAvailableNetDevice {
- my $device = detect_devices::getNet();
+sub dnsServers {
+ my ($netc) = @_;
+ map { $netc->{$_} } qw(dnsServer dnsServer2 dnsServer3);
+}
- unless ($device) {
+sub getNet() {
+ my @l = detect_devices::getNet();
+ unless (@l) {
modules::load_thiskind('net') or return;
- $device = detect_devices::getNet();
+ @l = detect_devices::getNet();
}
- $device;
+ @l;
}
-sub dnsServers {
- my ($netc) = @_;
- map { $netc->{$_} } qw(dnsServer dnsServer2 dnsServer3);
-}
diff --git a/perl-install/resize_fat/directory.pm b/perl-install/resize_fat/directory.pm
index ab8ec5328..00ae6a870 100644
--- a/perl-install/resize_fat/directory.pm
+++ b/perl-install/resize_fat/directory.pm
@@ -34,7 +34,7 @@ sub entry_size { psizeof($format) }
sub traverse($$$) {
my ($fs, $directory, $f) = @_;
- for (my $i = 0; 1; $i++) {
+ for (my $i = 0;; $i++) {
my $raw = \substr($directory, $i * psizeof($format), psizeof($format));
# empty entry means end of directory
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-01 19:05:15 +0000