no_comment

9 files changed, 72 insertions, 88 deletions

diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm
index 37b2d66c1..5714fcc28 100644
--- a/perl-install/Xconfigurator.pm
+++ b/perl-install/Xconfigurator.pm
@@ -4,12 +4,11 @@ use diagnostics;
 use strict;
 use vars qw($in $install $isLaptop @window_managers @depths @monitorSize2resolution @hsyncranges %min_hsync4wres @vsyncranges %depths @resolutions %serversdriver @svgaservers @accelservers @allbutfbservers @allservers %vgamodes %videomemory @ramdac_name @ramdac_id @clockchip_name @clockchip_id %keymap_translate %standard_monitors $XF86firstchunk_text $keyboardsection_start $keyboardsection_start_v4 $keyboardsection_part2 $keyboardsection_part3 $keyboardsection_part3_v4 $keyboardsection_end $pointersection_text $pointersection_text_v4 $monitorsection_text1 $monitorsection_text2 $monitorsection_text3 $monitorsection_text4 $modelines_text_Trident_TG_96xx $modelines_text $devicesection_text $devicesection_text_v4 $screensection_text1 %lines @options %xkb_options $default_monitor $layoutsection_v4);
 
-use pci_probing::main;
 use common qw(:common :file :functional :system);
 use log;
+use detect_devices;
 use run_program;
 use Xconfigurator_consts;
-use sbus_probing::main;
 use my_gtk qw(:wrappers);
 
 my $tmpconfig = "/tmp/Xconfig";
@@ -143,12 +142,12 @@ sub keepOnlyLegalModes {
 
 sub cardConfigurationAuto() {
     my $card;
-    if (my (@c) = (pci_probing::main::probe("DISPLAY"), sbus_probing::main::probe("DISPLAY"))) {
-	local $_;
-	($card->{identifier}, $_) = @{$c[-1]};
+    if (my ($c) = (detect_devices::matching_type("DISPLAY"))) {
+	local $_ = $c->{driver};
 	$card->{type} = $1 if /Card:(.*)/;
 	$card->{server} = $1 if /Server:(.*)/;
 	$card->{flags}{needVideoRam} &&= /86c368/;
+	$card->{identifier} = $c->{description};
 	push @{$card->{lines}}, @{$lines{$card->{identifier}} || []};
     }
     #- take a default on sparc if nothing has been found.
diff --git a/perl-install/commands.pm b/perl-install/commands.pm
index 467cdfa4b..f2ec0d154 100644
--- a/perl-install/commands.pm
+++ b/perl-install/commands.pm
@@ -514,13 +514,11 @@ sub kill {
 }
 
 sub lspci {
-    require pci_probing::main;
-    print join "\n", pci_probing::main::list (), '';
-}
-sub lssbus {
-    require sbus_probing::main;
-    print join "\n", sbus_probing::main::list (), '';
+    require detect_devices;
+    print join "\n", detect_devices::stringlist(), '';
 }
+*lssbus = *lspci;
+
 sub dmesg { print cat_("/tmp/syslog"); }
 
 sub sort {
@@ -575,11 +573,11 @@ sub bug {
 * $_[0]
 ********************************************************************************";
     }
-    require pci_probing::main;
+    require detect_devices;
 
     local $\ = "\n";
     output "/fd0/report.bug", map { chomp; $_ }
-      header("lspci"), pci_probing::main::list(),
+      header("lspci"), detect_devices::stringlist(),
       header("pci_devices"), cat_("/proc/bus/pci/devices"),
       header("fdisk"), `fdisk -l`,
       header("scsi"), cat_("/proc/scsi/scsi"),
diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm
index eb451923f..26d124d25 100644
--- a/perl-install/detect_devices.pm
+++ b/perl-install/detect_devices.pm
@@ -189,6 +189,37 @@ sub hasEthernet() { hasNetDevice("eth0"); }
 sub hasTokenRing() { hasNetDevice("tr0"); }
 sub hasNetDevice($) { c::hasNetDevice($_[0]) }
 
+# probe_type true means detect the type of hardware, this is unsafe for pci! (bug in kernel&hardware)
+# get_pcmcia_devices provides field "device", used in network.pm
+sub probeall {
+    my ($probe_type, $pcic) = @_;
+    require pci_probing::main;
+    require sbus_probing::main;
+    pci_probing::main::probe($probe_type), sbus_probing::main::probe(), modules::get_pcmcia_devices($pcic);
+}
+sub matching_type {
+    my ($type, $pcic) = @_;
+    grep { 
+	my $ok = $_->{driver} !~ /(unknown|ignore)/;
+	$ok or log::l("skipping $_->{description}, no module available (if you know one, please mail pixel\@linux-mandrake.com)");
+	$ok
+    } grep { $_->{type} =~ /$type/i } probeall($type, $pcic);
+}
+sub matching_desc {
+    my ($regexp) = @_;
+    grep { $_->{description} =~ /$regexp/i } probeall();
+}
+sub stringlist { 
+    map { " $_->{description} ($_->{class} $_->{driver})" } probeall(1); 
+}
+sub check {
+    my ($l) = @_;
+    my $ok = $l->{driver} !~ /(unknown|ignore)/;
+    $ok or log::l("skipping $l->{description}, no module available (if you know one, please mail bugs\@linux-mandrake.com)");
+    $ok
+}
+
+
 sub tryOpen($) {
     local *F;
     sysopen F, devices::make($_[0]), c::O_NONBLOCK() and *F;
@@ -212,8 +243,7 @@ sub hasUltra66 {
 #    #- disable hasUltra66 (now included in kernel)
 #    return;
 
-    require pci_probing::main;
-    my @l = map { $_->[0] } pci_probing::main::matching_desc('(HPT|Ultra66)') or return;
+    my @l = map { $_->{verbatim} } matching_desc('(HPT|Ultra66)') or return;
     
     my $ide = sprintf "ide2=0x%x,0x%x ide3=0x%x,0x%x",
       @l == 2 ?
@@ -251,11 +281,10 @@ sub whatPrinterPort() {
 }
 
 sub probeUSB {
-    require pci_probing::main;
     require modules;
     defined($usb_interface) and return $usb_interface;
     arch() =~ /sparc/ and return $usb_interface = '';
-    if (($usb_interface) = grep { /usb-/ } map { $_->[1] } pci_probing::main::probe('')) {
+    if (($usb_interface) = grep { /usb-/ } map { $_->{driver} } probeall()) {
 	eval { modules::load($usb_interface, "SERIAL_USB") };
 	if ($@) {
 	    $usb_interface = '';
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index 73680fb12..1f9782140 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -76,7 +76,7 @@ sub askChangeMedium($$) {
 sub errorOpeningFile($) {
     my ($file) = @_;
     $file eq 'XXX' and return; #- special case to force closing file after rpmlib transaction.
-    $current_medium eq $asked_medium and return; #- nothing to do in such case.
+    $current_medium eq $asked_medium and log::l("errorOpeningFile $file"), return; #- nothing to do in such case.
     $::o->{packages}[2]{$asked_medium}{selected} or return; #- not selected means no need for worying about.
 
     my $max = 32; #- always refuse after $max tries.
@@ -124,19 +124,22 @@ sub getFile {
 	    #- try to open the file, but examine if it is present in the repository, this allow
 	    #- handling changing a media when some of the file on the first CD has been copied
 	    #- to other to avoid media change...
-	    open getFile, "/tmp/rhimage/" . relGetFile($_[0]) or
-	      $postinstall_rpms and open getFile, "$postinstall_rpms/$_[0]" or return errorOpeningFile($_[0]);
-	    *getFile;
+	    log::l("getFile /tmp/rhimage/" . relGetFile($_[0]));
+	    open GETFILE, "/tmp/rhimage/" . relGetFile($_[0]) or
+	      $postinstall_rpms and open GETFILE, "$postinstall_rpms/$_[0]" or return errorOpeningFile($_[0]);
+	    *GETFILE;
 	};
     }
     goto &getFile;
 }
 sub getAndSaveFile {
     my ($file, $local) = @_;
+    log::l("getAndSaveFile $file $local");
     local *F; open F, ">$local" or return;
     local $/ = \ (16 * 1024);
     my $f = getFile($file) or return;
-    syswrite F, $_ foreach <$f>;
+    local $_;
+    while (<$f>) { syswrite F, $_ }
     1;
 }
 
@@ -289,8 +292,7 @@ sub setPackages($) {
 
 	my @l = ();
 	push @l, "kapm", "kcmlaptop" if $o->{pcmcia};
-	require pci_probing::main;
-	push @l, "Device3Dfx", "Glide_V3", "XFree86-glide-module" if pci_probing::main::matching_desc('Voodoo');
+	push @l, "Device3Dfx", "Glide_V3", "XFree86-glide-module" if detect_devices::matching_desc('Voodoo');
 	require timezone;
 	require lang;
 	push @l, "isdn4k-utils" if ($o->{timezone}{timezone} || timezone::bestTimezone(lang::lang2text($o->{lang}))) =~ /Europe/;
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index 38dff712e..2ae0d2f4c 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -906,6 +906,9 @@ _("beware: IN THIS SECURITY LEVEL, ROOT LOGIN AT CONSOLE IS NOT ALLOWED!
 If you want to be root, you have to login as a user and then use \"su\".
 More generally, do not expect to use your machine for anything but as a server.
 You have been warned.")) || return;
+	    $u->{numlock} && $o->{pcmcia} and $o->ask_okcancel('',
+_("Be carefull, having numlock enabled causes a lot of keystrokes to
+give digits instead of normal letters (eg: pressing `p' gives `6')")) || return;
 	    0; }
     ) || return;
 }
@@ -1151,9 +1154,7 @@ sub setup_thiskind {
 	    push @l, $o->load_module($type) || next;
 	} else {
 	    #-eval { commands::modprobe("isapnp") };
-	    require pci_probing::main;
-	    require sbus_probing::main;
-	    $o->ask_warn('', [ pci_probing::main::list(), sbus_probing::main::list() ]); #-, scalar cat_("/proc/isapnp") ]);
+	    $o->ask_warn('', [ detect_devices::stringlist() ]); #-, scalar cat_("/proc/isapnp") ]);
 	}
     }
 }
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
index bb6cd2216..88852a039 100644
--- a/perl-install/modules.pm
+++ b/perl-install/modules.pm
@@ -533,22 +533,11 @@ sub load_thiskind($;&$) {
     my ($type, $f, $pcic) = @_;
     my %loaded_text;
 
-    require pci_probing::main;
-    my @pcidevs = pci_probing::main::probe($type);
-    log::l("pci probe found " . scalar @pcidevs . " $type devices");
-
-    require sbus_probing::main;
-    my @sbusdevs = sbus_probing::main::probe($type);
-    log::l("sbus probe found " . scalar @sbusdevs . " $type devices");
-
-    my @pcmciadevs = get_pcmcia_devices($type, $pcic);
-    log::l("pcmcia probe found " . scalar @pcmciadevs . " $type devices");
-
-    my @devs = (@pcidevs, @sbusdevs, @pcmciadevs);
+    my @devs = detect_devices::matching_type($type, $pcic);
+    log::l("probe found " . scalar @devs . " $type devices");
 
     my %devs; foreach (@devs) {
-	my ($text, $mod) = @$_;
-	pci_probing::main::check($mod) or next;
+	my ($text, $mod) = ($_->{description}, $_->{driver});
 	$devs{$mod}++ and log::l("multiple $mod devices found"), next;
 	log::l("found driver for $mod");
 	&$f($text, $mod) if $f;
@@ -571,8 +560,8 @@ sub load_thiskind($;&$) {
 		last if !$@;
 	    }
 	}
-	if (my ($c) = (pci_probing::main::probe('AUDIO'), sbus_probing::main::probe('AUDIO'))) {
-	    add_alias("sound", $c->[1]) if pci_probing::main::check($c->[1]);
+	if (my ($c) = (detect_devices::matching_type('AUDIO'))) {
+	    add_alias("sound", $c->{driver});
 	}
     }
     my @loaded = map { $loaded_text{$_} || $_ } @{$loaded{$type} || []};
@@ -585,8 +574,8 @@ sub pcmcia_need_config($) {
 }
 
 sub get_pcmcia_devices($$) {
-    my ($type, $pcic) = @_;
-    my (@devs, $module, $desc);
+    my ($pcic) = @_;
+    my (@devs, $module, $desc, $type, $device);
 
     #- try to setup pcmcia if cardmgr is not running.
     if (pcmcia_need_config($pcic)) {
@@ -611,9 +600,9 @@ sub get_pcmcia_devices($$) {
 
     foreach (cat_("/var/run/stab")) {
 	$desc = $1 if /^Socket\s+\d+:\s+(.*)/;
-	$module = $1 if /^\d+\s+$type[^\s]*\s+([^\s]+)/;
+	($type, $module, $device) = ($1, $2, $3) if /^\d+\s+(\S+)\s+(\S+)\s+\S+\s+(\S+)/;
 	if ($desc && $module) {
-	    push @devs, [ $desc, $module ];
+	    push @devs, { description => $desc, driver => $module, type => $type, device => $device };
 	    $desc = $module = undef;
 	}
     }
diff --git a/perl-install/network.pm b/perl-install/network.pm
index 7c5ca5056..2c118222a 100644
--- a/perl-install/network.pm
+++ b/perl-install/network.pm
@@ -103,7 +103,7 @@ sub write_interface_conf {
     add2hash($intf, {
 		     BROADCAST => join('.', mapn { int $_[0] | ~int $_[1] & 255 } \@ip, \@mask),
 		     NETWORK   => join('.', mapn { int $_[0] &      $_[1]       } \@ip, \@mask),
-		     ONBOOT => bool2yesno(!$::o->{pcmcia}),
+		     ONBOOT => bool2yesno(!member($intf->{DEVICE}, map { $_->{device} } detect_devices::probeall())),
 		    });
     setVarsInSh($file, $intf, qw(DEVICE BOOTPROTO IPADDR NETMASK NETWORK BROADCAST ONBOOT));
 }
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 2001a507f..d4d8f9493 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -377,21 +377,15 @@ sub psUpdateHdlistsDeps {
 	s/\s*#.*$//;
 	/^\s*$/ and next;
 	m/^\s*(hdlist\S*\.cz2?)\s+(\S+)\s*(.*)$/ or die "invalid hdlist description \"$_\" in hdlists file";
-
 	my ($hdlist, $rpmsdir, $descr) = ($1, $2, $3);
-	my $f = install_any::getFile($hdlist) or die "no $hdlist found";
 
 	#- copy hdlist file directly to $prefix/var/lib/urpmi, this will be used
 	#- for getting header of package during installation or after by urpmi.
 	my $fakemedium = $method . $medium;
 	my $newf = "$prefix/var/lib/urpmi/hdlist.$fakemedium.cz2";
 	-e $newf and do { unlink $newf or die "cannot remove $newf: $!"; };
-	local *F;
-	open F, ">$newf" or die "cannot create $newf: $!";
-	my ($buf, $sz); while (($sz = sysread($f, $buf, 16384))) { syswrite(F, $buf) }
-	close F;
+	install_any::getAndSaveFile($hdlist, $newf) or die "no $hdlist found";
 	symlinkf $newf, "/tmp/$hdlist";
-
 	++$medium;
     }
 
@@ -419,11 +413,10 @@ sub psUsingHdlists {
 
     foreach (@hdlists) {
 	my ($hdlist, $medium, $rpmsdir, $descr) = @$_;
-	my $f = install_any::getFile($hdlist) or die "no $hdlist found";
 
 	#- make sure the first medium is always selected!
 	#- by default select all image.
-	psUsingHdlist($prefix, $method, \@packages, $f, $hdlist, $medium, $rpmsdir, $descr, 1);
+	psUsingHdlist($prefix, $method, \@packages, $hdlist, $medium, $rpmsdir, $descr, 1);
     }
 
     log::l("psUsingHdlists read " . scalar keys(%{$packages[0]}) . " headers on " . scalar keys(%{$packages[2]}) . " hdlists");
@@ -432,7 +425,7 @@ sub psUsingHdlists {
 }
 
 sub psUsingHdlist {
-    my ($prefix, $method, $packages, $f, $hdlist, $medium, $rpmsdir, $descr, $selected) = @_;
+    my ($prefix, $method, $packages, $hdlist, $medium, $rpmsdir, $descr, $selected) = @_;
 
     #- if the medium already exist, use it.
     $packages->[2]{$medium} and return;
@@ -452,10 +445,7 @@ sub psUsingHdlist {
     #- for getting header of package during installation or after by urpmi.
     my $newf = "$prefix/var/lib/urpmi/hdlist.$fakemedium.cz2";
     -e $newf and do { unlink $newf or die "cannot remove $newf: $!"; };
-    local *F;
-    open F, ">$newf" or die "cannot create $newf: $!";
-    my ($buf, $sz); while (($sz = sysread($f, $buf, 16384))) { syswrite(F, $buf) }
-    close F;
+    install_any::getAndSaveFile($hdlist, $newf) or die "no $hdlist found";
     symlinkf $newf, "/tmp/$hdlist";
 
     #- extract filename from archive, this take advantage of verifying
diff --git a/perl-install/sbus_probing/main.pm b/perl-install/sbus_probing/main.pm
index baf385819..f226eeea8 100644
--- a/perl-install/sbus_probing/main.pm
+++ b/perl-install/sbus_probing/main.pm
@@ -126,36 +126,12 @@ sub prom_walk($$$$) {
     $nextnode = c::prom_getsibling($node) and prom_walk($sbus_probed, $nextnode, $sbus, $ebus);
 }
 
-sub check {
-    my $ok = $_[0] !~ /unknown/;
-    $ok or log::l("skipping $text, no module available (if you know one, please mail bugs\@linux-mandrake.com)");
-    $ok
-}
-
-sub probe($) {
-    my ($type) = @_;
-
+sub probe {
     eval { modules::load("openprom") };
     my $root_node = c::prom_open();
     my @l;
 
     prom_walk(\@l, $root_node, 0, 0);
     c::prom_close();
-
-    $type eq '.' ? @l : map { [ @$_[1..$#$_] ] } grep { !$type || $_->[0] =~ /$type/i } @l;
+    map { my %l; @l{qw(type description drivers)} = @$_ } @l;
 }
-
-sub matching_desc($;$) {
-    my ($regexp) = @_;
-
-    eval { modules::load("openprom") };
-    my $root_node = c::prom_open();
-    my @l;
-
-    prom_walk(\@l, $root_node, 0, 0);
-    c::prom_close();
-
-    grep { !$type || $_->[1] =~ /$regexp/ } @l;
-}
-
-sub list { map { "$_->[1] ($_->[0] $_->[2])" } probe('.'); }