diff options
Diffstat (limited to 'perl-install')
| -rw-r--r-- | perl-install/Xconfigurator.pm | 9 | ||||
| -rw-r--r-- | perl-install/commands.pm | 14 | ||||
| -rw-r--r-- | perl-install/detect_devices.pm | 37 | ||||
| -rw-r--r-- | perl-install/install_any.pm | 16 | ||||
| -rw-r--r-- | perl-install/install_steps_interactive.pm | 7 | ||||
| -rw-r--r-- | perl-install/modules.pm | 29 | ||||
| -rw-r--r-- | perl-install/network.pm | 2 | ||||
| -rw-r--r-- | perl-install/pkgs.pm | 18 | ||||
| -rw-r--r-- | perl-install/sbus_probing/main.pm | 28 |
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('.'); } |