diff options
| -rw-r--r-- | perl-install/ChangeLog | 15 | ||||
| -rw-r--r-- | perl-install/any.pm | 2 | ||||
| -rw-r--r-- | perl-install/detect_devices.pm | 7 | ||||
| -rw-r--r-- | perl-install/help.pm | 7 | ||||
| -rw-r--r-- | perl-install/install2.pm | 17 | ||||
| -rw-r--r-- | perl-install/mouse.pm | 16 | ||||
| -rw-r--r-- | perl-install/network.pm | 187 | ||||
| -rw-r--r-- | perl-install/printer.pm | 2 | ||||
| -rw-r--r-- | perl-install/printerdrake.pm | 10 |
9 files changed, 149 insertions, 114 deletions
diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog index a0bf0add5..53f26243f 100644 --- a/perl-install/ChangeLog +++ b/perl-install/ChangeLog @@ -1,3 +1,18 @@ +2000-09-12 François Pons <fpons@mandrakesoft.com> + + * detect_devices.pm, mouse.pm: moved probing serial port before to + detect a wacom tablet (even if a PS/2 or USB mouse is found). + * help.pm: corrected reference to previous version of LM (jloup). + * install2.pm: removed duplicate code for getting network + configuration, using network module. + * netconnect.pm: intf is now a hash and no more an array. + * network.pm: changed nature of intf to hash from array, reworked + write_resolv_conf function to keep old code in comment but only + when not used anymore (to make it easier by hand modification). + * printer.pm: SOCKET accessible to expert only (jloup). + * printerdrake.pm: local port only available for expert if a + printer has been detected (jloup). + 2000-09-11 François Pons <fpons@mandrakesoft.com> * Xconfigurator.pm: reorganized choices of 3D optimizations, added diff --git a/perl-install/any.pm b/perl-install/any.pm index a81fece57..476b1b2ef 100644 --- a/perl-install/any.pm +++ b/perl-install/any.pm @@ -400,7 +400,7 @@ END } sub miscellaneousNetwork { - my ($in, $prefix) = @_; + my ($prefix) = @_; setVarsInSh ("$prefix/etc/profile.d/proxy.sh", $::o->{miscellaneous}, qw(http_proxy ftp_proxy)); setVarsInCsh("$prefix/etc/profile.d/proxy.csh", $::o->{miscellaneous}, qw(http_proxy ftp_proxy)); } diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm index b8bad956c..768569bac 100644 --- a/perl-install/detect_devices.pm +++ b/perl-install/detect_devices.pm @@ -283,13 +283,14 @@ sub probeSerialDevices { -l "/dev/mouse" and $serialprobe{"/dev/" . readlink "/dev/mouse"} = undef; foreach (keys %serialprobe) { m|^/dev/(.*)| and touch "/var/lock/LCK..$1" } - #- start probing all serial ports... really faster than before :-) + print STDERR "Please wait while probing serial ports...\n"; + #- start probing all serial ports... really faster than before ... + #- ... but still take some time :-) local *F; open F, "serial_probe 2>/dev/null |"; my %current = (); foreach (<F>) { - chomp; $serialprobe{$current{DEVICE}} = { %current } and %current = () if /^\s*$/ && $current{DEVICE}; - $current{$1} = $2 if /^([^=]+)=(.*)$/; + $current{$1} = $2 if /^([^=]+)=(.*?)\s*$/; } close F; diff --git a/perl-install/help.pm b/perl-install/help.pm index 273c7a30c..026a38113 100644 --- a/perl-install/help.pm +++ b/perl-install/help.pm @@ -11,12 +11,11 @@ __("Choose preferred language for install and system usage."), selectKeyboard => __("Choose the layout corresponding to your keyboard from the list above"), -selectInstallClass => [ +selectInstallClass => __("Choose \"Install\" if there are no previous versions of GNU/Linux installed, or if you wish to use multiple distributions or versions. -Choose \"Rescue\" if you wish to rescue a previous version of Mandrake Linux: -%s or %s. +Choose \"Rescue\" if you wish to rescue a version of Linux-Mandrake already installed. Select: @@ -30,7 +29,7 @@ Select: perform a highly customized installation. As for a \"Customized\" installation class, you will be able to select the usage for your system. But please, please, DO NOT CHOOSE THIS UNLESS YOU KNOW WHAT YOU ARE DOING! -"), '5.1 (Venice), 5.2 (Leloo), 5.3 (Festen), 6.0 (Venus), 6.1 (Helios), Gold 2000', '7.0 (Air)' ], +"), #-'5.1 (Venice), 5.2 (Leloo), 5.3 (Festen), 6.0 (Venus), 6.1 (Helios), Gold 2000', '7.0 (Air)' ], selectInstallClassCorpo => __("Select: diff --git a/perl-install/install2.pm b/perl-install/install2.pm index 8dcfb8aa0..b3545e3b1 100644 --- a/perl-install/install2.pm +++ b/perl-install/install2.pm @@ -180,7 +180,7 @@ $o = $::o = { orderedSteps => \@orderedInstallSteps, #- for the list of fields available for user and superuser, see @etc_pass_fields in install_steps.pm -#- intf => [ { DEVICE => "eth0", IPADDR => '1.2.3.4', NETMASK => '255.255.255.128' } ], +#- intf => { eth0 => { DEVICE => "eth0", IPADDR => '1.2.3.4', NETMASK => '255.255.255.128' } }, #-step : the current one #-prefix @@ -373,18 +373,7 @@ STORAGE= sub configureNetwork { $::live and return; #- get current configuration of network device. - eval { - $o->{netc} ||= {}; $o->{intf} ||= []; - add2hash($o->{netc}, network::read_conf("$o->{prefix}/etc/sysconfig/network")) if -r "$o->{prefix}/etc/sysconfig/network"; - add2hash($o->{netc}, network::read_resolv_conf("$o->{prefix}/etc/resolv.conf")) if -r "$o->{prefix}/etc/resolv.conf"; - foreach (all("$o->{prefix}/etc/sysconfig/network-scripts")) { - if (/ifcfg-(\w+)/ && $1 ne 'lo' && $1 !~ /ppp/) { - my $intf = network::findIntf($o->{intf}, $1); - add2hash($intf, { getVarsFromSh("$o->{prefix}/etc/sysconfig/network-scripts/$_") }); - } - } - }; - + eval { network::read_all_conf($o->{prefix}, $o->{netc} ||= {}, $o->{intf} ||= {}) }; $o->configureNetwork($_[1] == 1); } #------------------------------------------------------------------------------ @@ -658,7 +647,7 @@ sub main { if (my ($file) = glob_('/tmp/ifcfg-*')) { log::l("found network config file $file"); my $l = network::read_interface_conf($file); - add2hash(network::findIntf($o->{intf} ||= [], $l->{DEVICE}), $l); + add2hash(network::findIntf($o->{intf} ||= {}, $l->{DEVICE}), $l); } #-the main cycle diff --git a/perl-install/mouse.pm b/perl-install/mouse.pm index cb3dd3d9c..c011519ff 100644 --- a/perl-install/mouse.pm +++ b/perl-install/mouse.pm @@ -167,22 +167,30 @@ sub detect() { return name2mouse("Apple ADB Mouse"); } - detect_devices::hasMousePS2 and return { %{name2mouse("Generic Mouse (PS/2)")}, unsafe => 1 }; + #- probe serial device to make sure a wacom has been detected. + eval { commands::modprobe("serial") }; + my ($r, $wacom) = mouseconfig(); return ($r, $wacom) if $r; + + detect_devices::hasMousePS2 and return { %{name2mouse("Generic Mouse (PS/2)")}, unsafe => 1 }, $wacom; if (modules::get_alias("usb-interface") && detect_devices::hasUsbMouse()) { eval { modules::load("usbmouse"); modules::load("mousedev"); }; - !$@ && detect_devices::tryOpen("usbmouse") and return name2mouse("USB Mouse"); + !$@ && detect_devices::tryOpen("usbmouse") and return name2mouse("USB Mouse"), $wacom; eval { modules::unload("mousedev"); modules::unload("usbmouse"); } } - eval { commands::modprobe("serial") }; - my ($r, $wacom) = mouseconfig(); return ($r, $wacom) if $r; + #- in case only a wacom has been found, assume an inexistant mouse (necessary). + $wacom and return { CLASS => 'MOUSE', + nbuttons => 2, + device => "nothing", + MOUSETYPE => "Microsoft", + XMOUSETYPE => "Microsoft"}, $wacom; #- defaults to generic serial mouse on ttyS0. #- Oops? using return let return a hash ref, if not using it, it return a list directly :-) diff --git a/perl-install/network.pm b/perl-install/network.pm index 2bf55a448..4ec01e5fb 100644 --- a/perl-install/network.pm +++ b/perl-install/network.pm @@ -20,22 +20,20 @@ use log; sub read_conf { my ($file) = @_; my %netc = getVarsFromSh($file); - $netc{dnsServer} = delete $netc{NS0}; + foreach (0..2) { + exists $netc{"NS$_"} and $netc{dnsServers}{delete $netc{"NS$_"}} = $_ + 1; + } \%netc; } sub read_resolv_conf { my ($file) = @_; - my %netc; - my @l; + my ($i, %netc); - local *F; - open F, $file or die "cannot open $file: $!"; + local *F; open F, $file or die "cannot open $file: $!"; foreach (<F>) { - push @l, $1 if (/^\s*nameserver\s+([^\s]+)/); + /^\s*nameserver\s+(\S+)/ and $netc{dnsServers}{$1} = ++$i; } - - $netc{$_} = shift @l foreach qw(dnsServer dnsServer2 dnsServer3); \%netc; } @@ -51,15 +49,15 @@ sub read_interface_conf { sub up_it { my ($prefix, $intfs) = @_; - $_->{isUp} and return foreach @$intfs; + $_->{isUp} and return foreach values %$intfs; my $f = "/etc/resolv.conf"; symlink "$prefix/$f", $f; run_program::rooted($prefix, "/etc/rc.d/init.d/network", "start"); - $_->{isUp} = 1 foreach @$intfs; + $_->{isUp} = 1 foreach values %$intfs; } sub down_it { my ($prefix, $intfs) = @_; run_program::rooted($prefix, "/etc/rc.d/init.d/network", "stop"); - $_->{isUp} = 1 foreach @$intfs; + $_->{isUp} = 1 foreach values %$intfs; } sub write_conf { @@ -78,20 +76,27 @@ sub write_conf { sub write_resolv_conf { my ($file, $netc) = @_; - #- We always write these, even if they were autoconfigured. Otherwise, the reverse name lookup in the install doesn't work. unless ($netc->{DOMAINNAME} || dnsServers($netc)) { unlink($file); log::l("neither domain name nor dns server are configured"); return 0; } - substInFile { - s/^([^#].*\n)/\#$1/; - if (eof) { - $_ .= "search $netc->{DOMAINNAME}\n" if $netc->{DOMAINNAME}; - $_ .= "nameserver $_\n" foreach dnsServers($netc); - } - } $file; + my (%search, %dns, @unknown); + local *F; open F, $file; + foreach (<F>) { + /^\s*search\s+(.*?)\s*$/ and $search{$1} = $., next; + /^\s*nameserver\s+(.*?)\s*$/ and $dns{$1} = $., next; + /^[#\s]*(\S.*?)\s*$/ and push @unknown, $1; + } + + close F; open F, ">$file" or die "cannot write $file: $!"; + print F "# search $_\n" foreach grep { $_ ne $netc->{DOMAINNAME} } sort { $search{$a} <=> $search{$b} } keys %search; + print F "search $netc->{DOMAINNAME}\n\n" if $netc->{DOMAINNAME}; + print F "# nameserver $_\n" foreach grep { ! exists $netc->{dnsServers}{$_} } sort { $dns{$a} <=> $dns{$b} } keys %dns; + print F "nameserver $_\n" foreach dnsServers($netc); + print F "\n"; + print F "# $_\n" foreach @unknown; #-res_init(); # reinit the resolver so DNS changes take affect 1; @@ -172,14 +177,12 @@ sub resolv($) { sub dnsServers { my ($netc) = @_; - grep { $_ } map { $netc->{$_} } qw(dnsServer dnsServer2 dnsServer3); + sort { $netc->{dnsServers}{$a} <=> $netc->{dnsServers}{$b} } grep { $_ } keys %{$netc->{dnsServers} || {}}; } sub findIntf { my ($intf, $device) = @_; - my ($l) = grep { $_->{DEVICE} eq $device } @$intf; - push @$intf, $l = { DEVICE => $device } unless $l; - $l; + $intf->{$device} ||= { DEVICE => $device }; } #PAD \s* a la fin my $ip_regexp = qr/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/; @@ -242,14 +245,12 @@ sub configureNetwork { my @l = detect_devices::getNet() or die _("no network card found"); my $last; foreach ($::beginner ? $l[0] : @l) { - my $intf2 = findIntf($intf ||= [], $_); + my $intf2 = findIntf($intf ||= {}, $_); add2hash($intf2, $last); add2hash($intf2, { NETMASK => '255.255.255.0' }); configureNetworkIntf($in, $intf2) or last; $netc ||= {}; - delete $netc->{dnsServer}; - delete $netc->{GATEWAY}; $last = $intf2; } #- { @@ -262,13 +263,71 @@ _("Please enter your host name if you know it. Some DHCP servers require the hostname to work. Your host name should be a fully-qualified host name, such as ``mybox.mylab.myco.com''."), - [_("Host name:")], [ \$netc->{HOSTNAME} ]); + [_("Host name")], [ \$netc->{HOSTNAME} ]); } else { configureNetworkNet($in, $netc, $last ||= {}, @l); } miscellaneousNetwork($in); } + +sub configureNetworkIntf { + my ($in, $intf) = @_; + my $pump = $intf->{BOOTPROTO} =~ /^(dhcp|bootp)$/; + delete $intf->{NETWORK}; + delete $intf->{BROADCAST}; + my @fields = qw(IPADDR NETMASK); + $::isStandalone or $in->set_help('configureNetworkIP'); + $in->ask_from_entries_ref(_("Configuring network device %s", $intf->{DEVICE}), +($::isStandalone ? '' : _("Configuring network device %s", $intf->{DEVICE}) . "\n\n") . +_("Please enter the IP configuration for this machine. +Each item should be entered as an IP address in dotted-decimal +notation (for example, 1.2.3.4)."), + [ _("IP address"), _("Netmask"), _("Automatic IP") ], + [ \$intf->{IPADDR}, \$intf->{NETMASK}, { val => \$pump, type => "bool", text => _("(bootp/dhcp)") } ], + complete => sub { + $intf->{BOOTPROTO} = $pump ? "dhcp" : "static"; + return 0 if $pump; + for (my $i = 0; $i < @fields; $i++) { + unless (is_ip($intf->{$fields[$i]})) { + $in->ask_warn('', _("IP address should be in format 1.2.3.4")); + return (1,$i); + } + return 0; + } + }, + focus_out => sub { + $intf->{NETMASK} ||= netmask($intf->{IPADDR}) unless $_[0] + } + ); +} + +sub configureNetworkNet { + my ($in, $netc, $intf, @devices) = @_; + + my ($dns1, $dns2) = dnsServers($netc); + my ($lvl_dns1, $lvl_dns2) = (delete $netc->{dnsServers}{$dns1}, delete $netc->{dnsServers}{$dns2}); + $dns1 ||= dns($intf->{IPADDR}); + $netc->{GATEWAY} ||= gateway($intf->{IPADDR}); + + $in->ask_from_entries_refH(_("Configuring network"), +_("Please enter your host name. +Your host name should be a fully-qualified host name, +such as ``mybox.mylab.myco.com''. +You may also enter the IP address of the gateway if you have one"), + [ _("Host name") => \$netc->{HOSTNAME}, + _("First DNS server") => \$dns1, + _("Second DNS server") => \$dns2, + _("Gateway") => \$netc->{GATEWAY}, + $::expert ? (_("Gateway device") => {val => \$netc->{GATEWAYDEV}, list => \@devices }) : (), + ], + ) or return; + + my ($old_dns1, $old_dns2) = dnsServers($netc); + $netc->{dnsServers}{$dns1} = $lvl_dns1 || 1; + $netc->{dnsServers}{$dns2} = $lvl_dns2 || $lvl_dns1 + 1 || 2; +} + sub miscellaneousNetwork { my ($in, $clicked) = @_; my $u = $::o->{miscellaneous} ||= {}; @@ -289,73 +348,35 @@ sub miscellaneousNetwork { ) || return; } -sub configureNetworkNet { - my ($in, $netc, $intf, @devices) = @_; - - $netc->{dnsServer} ||= dns($intf->{IPADDR}); - $netc->{GATEWAY} ||= gateway($intf->{IPADDR}); - - $in->ask_from_entries_ref(_("Configuring network"), -_("Please enter your host name. -Your host name should be a fully-qualified host name, -such as ``mybox.mylab.myco.com''. -You may also enter the IP address of the gateway if you have one"), - [_("Host name:"), _("DNS server:"), _("Gateway:"), $::expert ? _("Gateway device:") : ()], - [(map { \$netc->{$_} } qw(HOSTNAME dnsServer GATEWAY)), - {val => \$netc->{GATEWAYDEV}, list => \@devices}] - ); +sub read_all_conf { + my ($prefix, $netc, $intf) = @_; + $netc ||= {}; $intf ||= {}; + add2hash($netc, read_conf("$prefix/etc/sysconfig/network")) if -r "$prefix/etc/sysconfig/network"; + add2hash($netc, read_resolv_conf("$prefix/etc/resolv.conf")) if -r "$prefix/etc/resolv.conf"; + foreach (all("$prefix/etc/sysconfig/network-scripts")) { + if (/ifcfg-(\w+)/ && $1 ne 'lo' && $1 !~ /ppp/) { + my $intf = findIntf($intf, $1); + add2hash($intf, { getVarsFromSh("$prefix/etc/sysconfig/network-scripts/$_") }); + } + } } - sub configureNetwork2 { - my ($in, $prefix, $netc, $intf) = @_; + my ($prefix, $netc, $intf, $install) = @_; my $etc = "$prefix/etc"; write_conf("$etc/sysconfig/network", $netc); write_resolv_conf("$etc/resolv.conf", $netc); - write_interface_conf("$etc/sysconfig/network-scripts/ifcfg-$_->{DEVICE}", $_) foreach @{$intf}; - add2hosts("$etc/hosts", $netc->{HOSTNAME}, map { $_->{IPADDR} } @{$intf}); + write_interface_conf("$etc/sysconfig/network-scripts/ifcfg-$_->{DEVICE}", $_) foreach values %$intf; + add2hosts("$etc/hosts", $netc->{HOSTNAME}, map { $_->{IPADDR} } values %$intf); sethostname($netc) unless $::testing; addDefaultRoute($netc) unless $::testing; - - grep { $_->{BOOTPROTO} =~ /^(dhcp)$/ } @{$intf} and $::isStandalone ? system("urpmi --auto dhcpd") : $in->pkg_install("dhcpcd"); - # Handle also pump (this is still in initscripts no?) - grep { $_->{BOOTPROTO} =~ /^(pump|bootp)$/ } @{$intf} and $::isStandalone ? system("urpmi --auto pump") : $in->pkg_install("pump"); + + grep { $_->{BOOTPROTO} =~ /^(dhcp)$/ } values %$intf and $install && $install->('dhcpd'); + grep { $_->{BOOTPROTO} =~ /^(pump|bootp)$/ } values %$intf and $install && $install->('pump'); #-res_init(); #- reinit the resolver so DNS changes take affect - any::miscellaneousNetwork($in, $prefix); -} - - -sub configureNetworkIntf { - my ($in, $intf) = @_; - my $pump = $intf->{BOOTPROTO} =~ /^(dhcp|bootp)$/; - delete $intf->{NETWORK}; - delete $intf->{BROADCAST}; - my @fields = qw(IPADDR NETMASK); - $::isStandalone or $in->set_help('configureNetworkIP'); - $in->ask_from_entries_ref(_("Configuring network device %s", $intf->{DEVICE}), -($::isStandalone ? '' : _("Configuring network device %s", $intf->{DEVICE}) . "\n\n") . -_("Please enter the IP configuration for this machine. -Each item should be entered as an IP address in dotted-decimal -notation (for example, 1.2.3.4)."), - [ _("IP address:"), _("Netmask:"), _("Automatic IP") ], - [ \$intf->{IPADDR}, \$intf->{NETMASK}, { val => \$pump, type => "bool", text => _("(bootp/dhcp)") } ], - complete => sub { - $intf->{BOOTPROTO} = $pump ? "dhcp" : "static"; - return 0 if $pump; - for (my $i = 0; $i < @fields; $i++) { - unless (is_ip($intf->{$fields[$i]})) { - $in->ask_warn('', _("IP address should be in format 1.2.3.4")); - return (1,$i); - } - return 0; - } - }, - focus_out => sub { - $intf->{NETMASK} ||= netmask($intf->{IPADDR}) unless $_[0] - } - ); + any::miscellaneousNetwork($prefix); } diff --git a/perl-install/printer.pm b/perl-install/printer.pm index 8784c95e2..173939656 100644 --- a/perl-install/printer.pm +++ b/perl-install/printer.pm @@ -44,7 +44,7 @@ sub default_spooldir($) { "/var/spool/lpd/" . default_queue($_[0]) } sub default_printer_type($) { "LOCAL" } sub printer_type($) { for ($_[0]{mode}) { - /cups/ && return @printer_type_inv{qw(LOCAL REMOTE SMB SOCKET), $::expert ? qw(URI) : ()}; + /cups/ && return @printer_type_inv{qw(LOCAL REMOTE SMB), $::expert ? qw(SOCKET URI) : ()}; /lpr/ && return @printer_type_inv{qw(LOCAL REMOTE SMB NCP)}; } } diff --git a/perl-install/printerdrake.pm b/perl-install/printerdrake.pm index fc9743ba6..e99c69f1b 100644 --- a/perl-install/printerdrake.pm +++ b/perl-install/printerdrake.pm @@ -36,17 +36,19 @@ sub setup_local($$$) { $_->{val}{DESCRIPTION}) . $_->{port}; } if (@str) { - @port = map { $_->{port} } @parport; + @port = map { $_->{port} } grep { $_->{val}{DESCRIPTION} } @parport; + #- in such case for a beginner, do not ask the port, get the first one. + !$::expert && @port > 0 and $in = undef; } else { @port = detect_devices::whatPrinterPort(); } $printer->{DEVICE} = $port[0] if $port[0]; - return if !$in->ask_from_entries_refH(_("Local Printer Device"), - _("What device is your printer connected to + $in and return if !$in->ask_from_entries_refH(_("Local Printer Device"), + _("What device is your printer connected to (note that /dev/lp0 is equivalent to LPT1:)?\n") . (join "\n", @str), [ _("Printer Device") => {val => \$printer->{DEVICE}, list => \@port } ], - ); + ); #- make the DeviceURI from DEVICE. $printer->{DeviceURI} = ($printer->{DEVICE} =~ /usb/ ? "usb:" : "parallel:") . $printer->{DEVICE}; |