diff options
author | Pascal Rigaux <pixel@mandriva.com> | 1999-08-25 09:47:06 +0000 |
---|---|---|
committer | Pascal Rigaux <pixel@mandriva.com> | 1999-08-25 09:47:06 +0000 |
commit | 9b8dddbc720899a7872d82e39405997ab6949df4 (patch) | |
tree | e294bf4db32549a4592ce398b694d4a9cd389006 /perl-install | |
parent | 9062c92ba51a7170424f825c60e5ff5ec46c85dd (diff) | |
download | drakx-backup-do-not-use-9b8dddbc720899a7872d82e39405997ab6949df4.tar drakx-backup-do-not-use-9b8dddbc720899a7872d82e39405997ab6949df4.tar.gz drakx-backup-do-not-use-9b8dddbc720899a7872d82e39405997ab6949df4.tar.bz2 drakx-backup-do-not-use-9b8dddbc720899a7872d82e39405997ab6949df4.tar.xz drakx-backup-do-not-use-9b8dddbc720899a7872d82e39405997ab6949df4.zip |
no_comment
Diffstat (limited to 'perl-install')
-rw-r--r-- | perl-install/common.pm | 43 | ||||
-rw-r--r-- | perl-install/detect_devices.pm | 8 | ||||
-rw-r--r-- | perl-install/install2.pm | 39 | ||||
-rw-r--r-- | perl-install/install_steps.pm | 22 | ||||
-rw-r--r-- | perl-install/install_steps_interactive.pm | 12 | ||||
-rw-r--r-- | perl-install/my_gtk.pm | 36 | ||||
-rw-r--r-- | perl-install/network.pm | 33 | ||||
-rw-r--r-- | perl-install/resize_fat/directory.pm | 2 |
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 |