summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2000-07-23 22:15:54 +0000
committerPascal Rigaux <pixel@mandriva.com>2000-07-23 22:15:54 +0000
commitd97b226e3049c136401416aaceaba39587cd0605 (patch)
treefa094813196f6d3f8615c3f999d116cf1566ca08 /perl-install
parentf01f53d988172e9d5bf52e969dd404dc48458000 (diff)
downloaddrakx-d97b226e3049c136401416aaceaba39587cd0605.tar
drakx-d97b226e3049c136401416aaceaba39587cd0605.tar.gz
drakx-d97b226e3049c136401416aaceaba39587cd0605.tar.bz2
drakx-d97b226e3049c136401416aaceaba39587cd0605.tar.xz
drakx-d97b226e3049c136401416aaceaba39587cd0605.zip
no_comment
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/Xconfigurator.pm9
-rw-r--r--perl-install/commands.pm14
-rw-r--r--perl-install/detect_devices.pm37
-rw-r--r--perl-install/install_any.pm16
-rw-r--r--perl-install/install_steps_interactive.pm7
-rw-r--r--perl-install/modules.pm29
-rw-r--r--perl-install/network.pm2
-rw-r--r--perl-install/pkgs.pm18
-rw-r--r--perl-install/sbus_probing/main.pm28
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('.'); }