perl-install/pixmaps/pause-16.png

package detect_devices; # $Id$

use diagnostics;
use strict;
use vars qw($pcitable_addons $usbtable_addons);

#-######################################################################################
#- misc imports
#-######################################################################################
use log;
use common;
use devices;
use run_program;
use c;

#-#####################################################################################
#- Globals
#-#####################################################################################
my %serialprobe;

#-######################################################################################
#- Functions
#-######################################################################################
sub dev_is_devfs() { -e "/dev/.devfsd" } #- no $::prefix, returns false during install and that's nice :)


sub get() {
    #- Detect the default BIOS boot harddrive is kind of tricky. We may have IDE,
    #- SCSI and RAID devices on the same machine. From what I see so far, the default
    #- BIOS boot harddrive will be
    #- 1. The first IDE device if IDE exists. Or
    #- 2. The first SCSI device if SCSI exists. Or
    #- 3. The first RAID device if RAID exists.

    getIDE(), getSCSI(), getDAC960(), getCompaqSmartArray(), getATARAID();
}
sub hds()         { grep { may_be_a_hd($_) } get() }
sub tapes()       { grep { $_->{media_type} eq 'tape' } get() }
sub cdroms()      { grep { $_->{media_type} eq 'cdrom' } get() }
sub burners()     { grep { isBurner($_) } cdroms() }
sub dvdroms()     { grep { isDvdDrive($_) } cdroms() }
sub raw_zips()    { grep { member($_->{media_type}, 'fd', 'hd') && isZipDrive($_) } get() }
#-sub jazzs     { grep { member($_->{media_type}, 'fd', 'hd') && isJazzDrive($_) } get() }
sub ls120s()      { grep { member($_->{media_type}, 'fd', 'hd') && isLS120Drive($_) } get() }
sub zips()        {
    map { 
	$_->{device} .= 4; 
	$_->{devfs_device} = $_->{devfs_prefix} . '/part4'; 
	$_;
    } raw_zips();
}

sub floppies() {
    require modules;
    my @fds;
    my @dmis = dmidecode();
    # do not try to load floppy if there's no floppy drive:
    if ($::isInstall || !@dmis || find { $_->{'Internal Reference Designator'} =~ /^(FLOPPY|FDD)$/ && $_->{name} eq 'Port Connector' } @dmis) {
        eval { modules::load("floppy") if $::isInstall };
        if (!$@) {
            @fds = map {
                my $info = (!dev_is_devfs() || -e "/dev/fd$_") && c::floppy_info(devices::make("fd$_"));
                if_($info && $info ne '(null)', { device => "fd$_", devfs_device => "floppy/$_", media_type => 'fd', info => $info });
            } qw(0 1);
        }
    }
        
    my @ide = ls120s() and eval { modules::load("ide-floppy") };

    eval { modules::load("usb-storage") } if usbStorage();
    my @scsi = grep { $_->{media_type} eq 'fd' } getSCSI();
    @ide, @scsi, @fds;
}
sub floppies_dev() { map { $_->{device} } floppies() }
sub floppy() { first(floppies_dev()) }
#- example ls120, model = "LS-120 SLIM 02 UHD Floppy"

sub removables() {
    floppies(), cdroms(), zips();
}

sub get_sys_cdrom_info {
    my (@drives) = @_;

    my @drives_order;
    foreach (cat_("/proc/sys/dev/cdrom/info")) {
	my ($t, $l) = split ':';
	my @l;
	@l = split(' ', $l) if $l;
	if ($t eq 'drive name') {
	    @drives_order = map {
		my $dev = $_;
		find { $_->{device} eq $dev } @drives;
	    } @l;
	} else {
	    my $capacity;
	    if ($t eq 'Can write CD-R') {
		$capacity = 'burner';
	    } elsif ($t eq 'Can read DVD') {
		$capacity = 'DVD';
	    }
	    if ($capacity) {
		each_index {
		    ($drives_order[$::i] || {})->{capacity} .= "$capacity " if $_;
		} @l;
	    }
	}
    }
}

sub get_usb_storage_info_24 {
    my (@l) = @_;

    my %usbs = map {
	my $s = cat_(glob_("$_/*"));
	my ($host) = $s =~ /^\s*Host scsi(\d+):/m; #-#
	my ($vendor_name) = $s =~ /^\s*Vendor: (.*)/m;
	my ($vendor, $id) = $s =~ /^\s*GUID: (....)(....)/m;
	if_(defined $host, $host => { vendor_name => $vendor_name, usb_vendor => hex $vendor, usb_id => hex $id });
    } glob_('/proc/scsi/usb-storage-*') or return;

    #- only the entries matching the following conditions can be usb-storage devices
    @l = grep { $_->{channel} == 0 && $_->{id} == 0 && $_->{lun} == 0 } @l;
    my %l; push @{$l{$_->{host}}}, $_ foreach @l;

    foreach my $host (keys %usbs) {
	my @choices = @{$l{$host} || []} or log::l("weird, host$host from /proc/scsi/usb-storage-*/* is not in /proc/scsi/scsi"), next;
	if (@choices > 1) {
	    @choices = grep { $_->{info} =~ /^\Q$usbs{$host}{vendor_name}/ } @choices;
	    @choices or log::l("weird, can not find the good entry host$host from /proc/scsi/usb-storage-*/* in /proc/scsi/scsi"), next;
	    @choices == 1 or log::l("argh, can not determine the good entry host$host from /proc/scsi/usb-storage-*/* in /proc/scsi/scsi"), next;
	}
	add2hash($choices[0], $usbs{$host});
    }
    complete_usb_storage_info(@l);

    @l;
}

sub complete_usb_storage_info {
    my (@l) = @_;

    my @usb = grep { exists $_->{usb_vendor} } @l;

    foreach my $usb (usb_probe()) {
	if (my $e = find { $_->{usb_vendor} == $usb->{vendor} && $_->{usb_id} == $usb->{id} } @usb) {
	    $e->{"usb_$_"} = $usb->{$_} foreach keys %$usb;
	}
    }
}

sub get_devfs_devices {
    my (@l) = @_;

    my %h = (cdrom => 'cd', hd => 'disc');

    foreach (@l) {
	$_->{devfs_prefix} = sprintf('scsi/host%d/bus%d/target%d/lun%d', $_->{host}, $_->{channel}, $_->{id}, $_->{lun})
	  if $_->{bus} eq 'SCSI';

	my $t = $h{$_->{media_type}} or next;
	$_->{devfs_device} = $_->{devfs_prefix} . '/' . $t;
    }
}

sub isBurner { 
    my ($e) = @_;
    $e->{capacity} =~ /burner/ and return 1;
      
    #- do not work for SCSI
    my $f = tryOpen($e->{device}); #- SCSI burner are not detected this way.
    $f && c::isBurner(fileno($f));
}
sub isDvdDrive {
    my ($e) = @_;
    $e->{capacity} =~ /DVD/ || $e->{info} =~ /DVD/ and return 1;

    #- do not work for SCSI
    my $f = tryOpen($e->{device});
    $f && c::isDvdDrive(fileno($f));
}
sub isZipDrive { $_[0]{info} =~ /ZIP\s+\d+/ } #- accept ZIP 100, untested for bigger ZIP drive.
sub isJazzDrive { $_[0]{info} =~ /\bJAZZ?\b/i } #- accept "iomega jaz 1GB"
sub isLS120Drive { $_[0]{info} =~ /LS-?120|144MB/ }
sub isRemovableUsb { begins_with($_[0]{usb_media_type} || '', 'Mass Storage') && usb2removable($_[0]) }
sub isKeyUsb { begins_with($_[0]{usb_media_type} || '', 'Mass Storage') && $_[0]{media_type} eq 'hd' }
sub isFloppyUsb { $_[0]{usb_driver} && $_[0]{usb_driver} eq 'Removable:floppy' }
sub may_be_a_hd { 
    my ($e) = @_;
    $e->{media_type} eq 'hd' && !(
	isZipDrive($e) 
           || isLS120Drive($e)
           || begins_with($e->{usb_media_type} || '', 'Mass Storage|Floppy (UFI)')
    );
}

sub get_scsi_driver {
    my (@l) = @_;
    my %host2driver = map { if_(m!.*/(.*)/(.*)!, $2, $1) } glob("/proc/scsi/*/*");
    foreach (@l) {
	if (my $driver = $host2driver{$_->{host}}) {
	    $_->{driver} = $driver;
	}
    }
}

sub getSCSI_24() {
    my $err = sub { log::l("ERROR: unexpected line in /proc/scsi/scsi: $_[0]") };

    my ($first, @l) = common::join_lines(cat_("/proc/scsi/scsi")) or return;
    $first =~ /^Attached devices:/ or $err->($first);

    @l = map_index {
	my ($host, $channel, $id, $lun) = m/^Host: scsi(\d+) Channel: (\d+) Id: (\d+) Lun: (\d+)/ or $err->($_);
	my ($vendor, $model) = /^\s*Vendor:\s*(.*?)\s+Model:\s*(.*?)\s+Rev:/m or $err->($_);
	my ($type) = /^\s*Type:\s*(.*)/m or $err->($_);
	{ info => "$vendor $model", host => $host, channel => $channel, id => $id, lun => $lun, 
	  device => "sg$::i", raw_type => $type, bus => 'SCSI' };
    } @l;

    get_usb_storage_info_24(@l);

    each_index {
	my $dev = "sd" . chr($::i + ord('a'));
	put_in_hash $_, { device => $dev, media_type => isFloppyUsb($_) ? 'fd' : 'hd' };
    } grep { $_->{raw_type} =~ /Direct-Access|Optical Device/ } @l;

    each_index {
	put_in_hash $_, { device => "st$::i", media_type => 'tape' };
    } grep { $_->{raw_type} =~ /Sequential-Access/ } @l;

    each_index {
	put_in_hash $_, { device => "sr$::i", media_type => 'cdrom' };
    } grep { $_->{raw_type} =~ /CD-ROM|WORM/ } @l;

    # Old hp scanners report themselves as "Processor"s
    # (see linux/include/scsi/scsi.h and sans-find-scanner.1)
    each_index {
	put_in_hash $_, { media_type => 'scanner' };
    } grep { $_->{raw_type} =~ /Scanner/ || $_->{raw_type} =~ /Processor / } @l;

    delete $_->{raw_type} foreach @l;

    get_devfs_devices(@l);
    get_sys_cdrom_info(@l);
    get_scsi_driver(@l);
    @l;
}

sub getSCSI_26() {
    my $dev_dir = '/sys/bus/scsi/devices';

    my @scsi_types = (
	"Direct-Access",
	"Sequential-Access",
	"Printer",
	"Processor",
	"WORM",
	"CD-ROM",
	"Scanner",
	"Optical Device",
	"Medium Changer",
	"Communications",
    );

    my @l = map {
	my ($host, $channel, $id, $lun) = split ':' or log::l("bad entry in $dev_dir: $_"), next;

	my $dir = "$dev_dir/$_";
	my $get = sub {
	    my $s = cat_("$dir/$_[0]");
	    $s =~ s/\s+$//;
	    $s;
	};

	my $usb_dir = readlink("$dir/block/device") =~ m!/usb! && "$dir/block/device/../../..";
	my $get_usb = sub { chomp_(cat_("$usb_dir/$_[0]")) };

	my ($device) = readlink("$dir/block") =~ m!/block/(.*)!;

	my $media_type = ${{ st => 'tape', sr => 'cdrom', sd => 'hd' }}{substr($device, 0, 2)};
	# Old hp scanners report themselves as "Processor"s
	# (see linux/include/scsi/scsi.h and sans-find-scanner.1)
	my $raw_type = $scsi_types[$get->('type')];
	$media_type ||= 'scanner' if $raw_type =~ /Scanner|Processor/;

	{ info =>  $get->('vendor') . ' ' . $get->('model'), host => $host, channel => $channel, id => $id, lun => $lun, 
	  bus => 'SCSI', media_type => $media_type, device => $device,
	    $usb_dir ? (
	  usb_vendor => hex($get_usb->('idVendor')), usb_id => hex($get_usb->('idProduct')),
	    ) : (),
        };
    } all($dev_dir);

    @l = sort { $a->{host} <=> $b->{host} || $a->{channel} <=> $b->{channel} || $a->{id} <=> $b->{id} || $a->{lun} <=> $b->{lun} } @l;

    complete_usb_storage_info(@l);

    foreach (@l) {
	$_->{media_type} = 'fd' if $_->{media_type} eq 'hd' && isFloppyUsb($_);
    }

    get_devfs_devices(@l);
    get_sys_cdrom_info(@l);
    get_scsi_driver(@l);
    @l;
}
sub getSCSI() { c::kernel_version() =~ /^\Q2.6/ ? getSCSI_26() : getSCSI_24() }


my %eide_hds = (
    "ASUS" => "Asus",
    "CD-ROM CDU" => "Sony",
    "CD-ROM Drive/F5D" => "ASUSTeK",
    "Compaq" => "Compaq",
    "CONNER" => "Conner Peripherals",
    "IBM" => "IBM",
    "FUJITSU" => "Fujitsu",
    "HITACHI" => "Hitachi",
    "Lite-On" => "Lite-On Technology Corp.",
    "LITE-ON" => "Lite-On Technology Corp.",
    "LTN" => "Lite-On Technology Corp.",
    "IOMEGA" => "Iomega",
    "MAXTOR" => "Maxtor",
    "Maxtor" => "Maxtor",
    "Micropolis" => "Micropolis",
    "Pioneer" => "Pioneer",
    "PLEXTOR" => "Plextor",
    "QUANTUM" => "Quantum", 
    "SAMSUNG" => "Samsung",
    "Seagate " => "Seagate Technology",
    "ST3" => "Seagate Technology",
    "TEAC" => "Teac",
    "TOSHIBA" => "Toshiba",
    "WDC" => "Western Digital Corp.",
);


sub getIDE() {
    my @idi;

    #- what about a system with absolutely no IDE on it, like some sparc machine.
    -e "/proc/ide" or return ();

    #- Great. 2.2 kernel, things are much easier and less error prone.
    foreach my $d (sort @{[glob_('/proc/ide/hd*')]}) {
	cat_("$d/driver") =~ /ide-scsi/ and next; #- already appears in /proc/scsi/scsi
	my $t = chomp_(cat_("$d/media"));
	my $type = ${{ disk => 'hd', cdrom => 'cdrom', tape => 'tape', floppy => 'fd' }}{$t} or next;
	my $info = chomp_(cat_("$d/model")) || "(none)";

	my $num = ord(($d =~ /(.)$/)[0]) - ord 'a';
	my ($vendor, $model) = map { 
	    if_($info =~ /^$_(-|\s)*(.*)/, $eide_hds{$_}, $2);
	} keys %eide_hds;

	my $host = $num;
	($host, my $id) = divide($host, 2);
	($host, my $channel) = divide($host, 2);
	my $devfs_prefix = sprintf('ide/host%d/bus%d/target%d/lun0', $host, $channel, $id);

	push @idi, { media_type => $type, device => basename($d), 
		     devfs_prefix => $devfs_prefix,
		     info => $info, host => $host, channel => $channel, id => $id, bus => 'ide', 
		     if_($vendor, Vendor => $vendor), if_($model, Model => $model) };
    }
    get_devfs_devices(@idi);
    get_sys_cdrom_info(@idi);
    @idi;
}

sub block_devices() {
    -d '/sys/block' 
      ? map { s|!|/|; $_ } all('/sys/block') 
      : map { $_->{dev} } devices::read_proc_partitions_raw();
}

sub getCompaqSmartArray() {
    my (@idi, $f);

    foreach ('array/ida', 'cpqarray/ida', 'cciss/cciss') {
	my $prefix = "/proc/driver/$_"; #- kernel 2.4 places it here
	$prefix = "/proc/$_" if !-e "${prefix}0"; #- kernel 2.2

	my ($name) = m|/(.*)|;
	for (my $i = 0; -r ($f = "${prefix}$i"); $i++) {
	    my @raw_devices = cat_($f) =~ m|^\s*($name/.*?):|gm;
	    @raw_devices or @raw_devices = grep { m!^$name/! } block_devices();

	    foreach my $raw_device (@raw_devices) {
		my $device = -d "/dev/$raw_device" ? "$raw_device/disc" : $raw_device;
		push @idi, { device => $device, prefix => $raw_device . 'p', 
			     info => "Compaq RAID logical disk",
			     media_type => 'hd', bus => $name };
	    }
	}
    }
    @idi;
}

sub getDAC960() {
    my %idi;

    #- We are looking for lines of this format:DAC960#0:
    #- /dev/rd/c0d0: RAID-7, Online, 17928192 blocks, Write Thru0123456790123456789012
    foreach (syslog()) {
	my ($device, $info) = m|/dev/(rd/.*?): (.*?),| or next;
	$idi{$device} = { info => $info, media_type => 'hd', device => $device, prefix => $device . 'p', bus => 'dac960' };
    }
    values %idi;
}

sub getATARAID() {
    my %l;
    foreach (syslog()) {
	my ($device) = m|^\s*(ataraid/d\d+):| or next;
	$l{$device} = { info => 'ATARAID block device', media_type => 'hd', device => $device, prefix => $device . 'p', bus => 'ataraid' };
	log::l("ATARAID: $device");
    }
    values %l;
}


# cpu_name : arch() =~ /^alpha/ ? "cpu	" :
# arch() =~ /^ppc/ ? "processor" : "vendor_id"

# cpu_model : arch() =~ /^alpha/ ? "cpu model" :
# arch() =~ /^ppc/ ? "cpu  " : "model name"

# cpu_freq = arch() =~ /^alpha/ ? "cycle frequency [Hz]" :
# arch() =~ /^ppc/ ? "clock" : "cpu MHz"

sub getCPUs() { 
    my (@cpus, $cpu);
    foreach (cat_("/proc/cpuinfo")) {
	   if (/^processor/) { # ix86 specific
		  push @cpus, $cpu if $cpu;
		  $cpu = {};
	   }
	   $cpu->{$1} = $2 if /^([^\t]+).*:\s(.*)$/;
	   $cpu->{processor}++ if $1 eq "processor";
    }
    push @cpus, $cpu;
    @cpus;
}

sub getSoundDevices() {
    modules::probe_category('multimedia/sound');
}

sub isTVcard { member($_[0]{driver}, qw(bttv cx8800 saa7134 usbvision)) }

sub getTVcards() { 
    grep { isTVcard($_) } detect_devices::probeall();
}

sub getInputDevices() {
    my (@devices, $device);
    foreach (cat_('/proc/bus/input/devices')) {
        if (/^I:/) {
            push @devices, $device if $device;
            $device = {};
            $device->{vendor} = $1 if /Vendor=([0-9a-f]+)/;
            $device->{id} = $1 if /Product=([0-9a-f]+)/;
        }
        $device->{description} = "|$1" if /N: Name="(.*)"/;
        $device->{driver} = $1 if /H: Handlers=(\w+)/;
        if (/P: Phys=(.*)/) {
            $device->{location} = $1;
            $device->{bus} = 'isa' if $device->{location} =~ /^isa/;
            $device->{bus} = 'usb' if $device->{location} =~ /^usb/i;
        }
    }
    push @devices, $device if $device;
    @devices;
}

sub getSerialModem {
    my ($modules_conf, $o_mouse) = @_;
    my $mouse = $o_mouse || {};
    $mouse->{device} = readlink "/dev/mouse";
    my $serdev = arch() =~ /ppc/ ? "macserial" : "serial";
    eval { modules::load($serdev) };

    my @modems;

    probeSerialDevices();
    foreach my $port (map { "ttyS$_" } (0..7)) {
	next if $mouse->{device} =~ /$port/;
     my $device = "/dev/$port";
	next if !-e $device || !hasModem($device);
     $serialprobe{$device}{device} = $device;
     push @modems, $serialprobe{$device};
    }
    my @devs = pcmcia_probe();
    foreach my $modem (@modems) {
        #- add an alias for macserial on PPC
        $modules_conf->set_alias('serial', $serdev) if arch() =~ /ppc/ && $modem->{device};
        foreach (@devs) { $_->{type} =~ /serial/ and $modem->{device} = $_->{device} }
    }
    @modems;
}

sub getModem {
    my ($modules_conf) = @_;
    getSerialModem($modules_conf, {}), matching_driver__regexp('www\.linmodems\.org'),
      matching_driver('ltmodem', list_modules::category2modules('network/slmodem'));
}

sub getSpeedtouch() {
    grep { $_->{description} eq 'Alcatel|USB ADSL Modem (Speed Touch)' } probeall();
}

sub getBewan() {
    matching_desc__regexp('Bewan Systems\|.*ADSL|BEWAN ADSL USB');
}
sub getSagem() {
    matching_driver('eagle-usb');
}

# generate from the following from eci driver sources:
# perl -e 'while (<>) { print qq("$1$2",\n"$3$4",\n) if /\b([a-z\d]*)\s*([a-z\d]*)\s*([a-z\d]*)\s*([a-z\d]*)$/ }' <modems.db|sort|uniq
sub getECI() {
    my @ids = (
              "05090801",
              "05472131",
              "06590915",
              "071dac81",
              "08ea00c9",
              "09150001",
              "09150002",
              "091500ca",
              "091500e7",
              "09150101",
              "09150102",
              "09150204",
              "09150206",
              "09150802",
              "09150916",
              "09158000",
              "09158001",
              "0915ac82",
              "0baf00e6",
              "0e600100",
              "0e600101",
              "0fe88000",
              "16900203",
              "16900205",
             );
    grep { member(sprintf("%04x%04x%04x%04x", $_->{vendor}, $_->{id}, $_->{subvendor}, $_->{subid}), @ids) } usb_probe();
}

sub getNet() { 
    # we want LAN like interfaces here (eg: ath|br|eth|fddi|plip|tr|usb|wifi|wlan).
    # there's also bnep%d for bluetooth, bcp%d...
    # we do this by blacklisting the following interfaces:
    # - sit0 which is *always* created by net/ipv6/sit.c, thus is always created since net.agent loads ipv6 module
    # - ippp|isdn|plip|ppp (initscripts suggest that isdn%d can be created but kernel sources claim not)
    #   ippp%d are created by drivers/isdn/i4l/isdn_ppp.c
    #   plip%d are created by drivers/net/plip.c
    #   ppp%d are created by drivers/net/ppp_generic.c
    #
    # we need both detection schemes since:
    # - get_netdevices() use the SIOCGIFCONF ioctl that does not list interfaces that are down
    # - /proc/net/dev does not list VLAN and IP aliased interfaces

    grep { !/^(?:lo|ippp|isdn|plip|ppp|sit0)/ }
      uniq(
           (map { if_(/^\s*([A-Za-z0-9:\.]*):/, $1) } cat_("/proc/net/dev")),
           c::get_netdevices(),
          );
 }

#sub getISDN() {
#    mapgrep(sub {member (($_[0] =~ /\s*(\w*):/), @netdevices), $1 }, split(/\n/, cat_("/proc/net/dev")));
#}

sub getUPS() {
    # MGE serial PnP devices:
    my @usb_devices = map { ($_->{name} = $_->{description}) =~ s/.*\|//; $_ } usb_probe();

    (map {
        $_->{port} = $_->{DEVICE};
        $_->{bus} = "Serial";
        $_->{driver} = "mge-utalk" if $_->{MODEL} =~ /0001/;
        $_->{driver} = "mge-shut"  if $_->{MODEL} =~ /0002/;
        $_->{media_type} = 'UPS';
        $_->{description} = "MGE UPS SYSTEMS|UPS - Uninterruptible Power Supply" if $_->{MODEL} =~ /000[12]/;
        $_;
    } grep { $_->{DESCRIPTION} =~ /MGE UPS/ } values %serialprobe),
      # USB UPSs;
      (grep { $_->{description} =~ /American Power Conversion\|Back-UPS/ } @usb_devices),
      (map {
          $_->{port} = "auto";
          $_->{media_type} = 'UPS';
          $_->{driver} = 'newhidups';
          $_;
      } grep { $_->{driver} =~ /ups$/ } @usb_devices);
}

$pcitable_addons = <<'EOF';
# add here lines conforming the pcitable format (0xXXXX\t0xXXXX\t"\w+"\t".*")
EOF

$usbtable_addons = <<'EOF';
# add here lines conforming the usbtable format (0xXXXX\t0xXXXX\t"\w+"\t".*")
EOF

sub install_addons {
    my ($prefix) = @_;

    #- this test means install_addons can only be called after ldetect-lst has been installed.
    if (-d "$prefix/usr/share/ldetect-lst") {
	my $update = 0;
	foreach ([ 'pcitable.d', $pcitable_addons ], [ 'usbtable.d', $usbtable_addons ]) {
	    my ($dir, $str) = @$_;
	    -d "$prefix/usr/share/ldetect-lst/$dir" && $str =~ /^[^#]/m and $update = 1 and
	      output "$prefix/usr/share/ldetect-lst/$dir/95drakx.lst", $str;
	}
	$update and run_program::rooted($prefix, "/usr/sbin/update-ldetect-lst");
    }
}

sub add_addons {
    my ($addons, @l) = @_;

    foreach (split "\n", $addons) {
	/^\s/ and die qq(bad detect_devices::probeall_addons line "$_");
	s/^#.*//;
	s/"(.*?)"/$1/g;
	next if /^$/;
	my ($vendor, $id, $driver, $description) = split("\t", $_, 4) or die qq(bad detect_devices::probeall_addons line "$_");
	foreach (@l) {
	    $_->{vendor} == hex $vendor && $_->{id} == hex $id or next;
	    put_in_hash($_, { driver => $driver, description => $description });
	}
    }
    @l;
}

sub pci_probe() {
    add_addons($pcitable_addons, map {
	my %l;
	@l{qw(vendor id subvendor subid pci_bus pci_device pci_function media_type driver description)} = split "\t";
	$l{$_} = hex $l{$_} foreach qw(vendor id subvendor subid);
	$l{bus} = 'PCI';
	\%l;
    } c::pci_probe());
}

sub usb_probe() {
    -e "/proc/bus/usb/devices" or return;

    add_addons($usbtable_addons, map {
	my %l;
	@l{qw(vendor id media_type driver description pci_bus pci_device)} = split "\t";
	$l{media_type} = join('|', grep { $_ ne '(null)' } split('\|', $l{media_type}));
	$l{$_} = hex $l{$_} foreach qw(vendor id);
	$l{bus} = 'USB';
	\%l;
    } c::usb_probe());
}

sub firewire_probe() {
    my $dev_dir = '/sys/bus/ieee1394/devices';
    my @l = map {
        my $dir = "$dev_dir/$_";
        my $get = sub { chomp_(cat_($_[0])) };
        {
            version => hex($get->("$dir/../vendor_id")),
            specifier_id => hex($get->("$dir/specifier_id")),
            specifier_version => hex($get->("$dir/version")),
            bus => 'Firewire',
        };
    } grep { -f "$dev_dir/$_/specifier_id" } all($dev_dir);

    my $e;
    foreach (cat_('/proc/bus/ieee1394/devices')) {
	if (m!Vendor/Model ID: (.*) \[(\w+)\] / (.*) \[(\w+)\]!) {
	    push @l, $e = { 
			   vendor => hex($2), id => hex($4), 
			   description => join('|', $1, $3),
			   bus => 'Firewire',
			  };
	} elsif (/Software Specifier ID: (\w+)/) {
	    $e->{specifier_id} = hex $1;
	} elsif (/Software Version: (\w+)/) {
	    $e->{specifier_version} = hex $1;	    
	}
    }

    foreach (@l) {
	if ($_->{specifier_id} == 0x00609e && $_->{specifier_version} == 0x010483) {
	    add2hash($_, { driver => 'sbp2', description => "Generic Firewire Storage Controller" });
	} elsif ($_->{specifier_id} == 0x00005e && $_->{specifier_version} == 0x000001) {
	    add2hash($_, { driver => 'eth1394', description => "IEEE 1394 IPv4 Driver (IPv4-over-1394 as per RFC 2734)" });
	}
    }
    @l;
}

sub pcmcia_controller_probe() {
    require list_modules;
    my @modules = list_modules::category2modules('bus/pcmcia');
    grep { member($_->{driver}, @modules) } probeall();
}

sub real_pcmcia_probe() {
    return if $::testing;

    c::pcmcia_probe() || first(map { $_->{driver} } pcmcia_controller_probe());
}

sub pcmcia_probe() {
    -e '/var/run/stab' || -e '/var/lib/pcmcia/stab' or return ();

    my (@devs, $desc);
    foreach (cat_('/var/run/stab'), cat_('/var/lib/pcmcia/stab')) {
	if (/^Socket\s+\d+:\s+(.*)/) {
	    $desc = $1;
	} else {
	    my (undef, $type, $module, undef, $device) = split;
	    push @devs, { description => $desc, driver => $module, type => $type, device => $device };
	}
    }
    @devs;
}

# pcmcia_probe provides field "device", used in network.pm
# => probeall with $probe_type is unsafe
sub probeall() {
    return if $::noauto;

    require sbus_probing::main;
    pci_probe(), usb_probe(), firewire_probe(), pcmcia_probe(), sbus_probing::main::probe();
}
sub matching_desc__regexp {
    my ($regexp) = @_;
    grep { $_->{description} =~ /$regexp/i } probeall();
}
sub matching_driver__regexp {
    my ($regexp) = @_;
    grep { $_->{driver} =~ /$regexp/i } probeall();
}

sub matching_driver {
    my (@list) = @_;
    grep { member($_->{driver}, @list) } probeall();
}

sub stringlist() { 
    map {
	sprintf("%-16s: %s%s%s", 
		$_->{driver} || 'unknown', 
		$_->{description} eq '(null)' ? sprintf("Vendor=0x%04x Device=0x%04x", $_->{vendor}, $_->{id}) : $_->{description},
		$_->{media_type} ? sprintf(" [%s]", $_->{media_type}) : '',
		$_->{subid} && $_->{subid} != 0xffff ? sprintf(" SubVendor=0x%04x SubDevice=0x%04x", $_->{subvendor}, $_->{subid}) : '',
	       );
    } probeall(); 
}

sub tryOpen($) {
    my $F;
    sysopen($F, devices::make($_[0]), c::O_NONBLOCK()) && $F;
}

sub tryWrite($) {
    my $F;
    sysopen($F, devices::make($_[0]), 1 | c::O_NONBLOCK()) && $F;
}

sub syslog() {
    -r "/tmp/syslog" and return map { /<\d+>(.*)/ } cat_("/tmp/syslog");
    my $LD_LOADER = $ENV{LD_LOADER} || "";
    `$LD_LOADER /bin/dmesg`;
}

sub get_mac_model() {
    my $mac_model = cat_("/proc/device-tree/model") || die "Can not open /proc/device-tree/model";
    log::l("Mac model: $mac_model");
    $mac_model;	
}

sub get_mac_generation() {
    cat_('/proc/cpuinfo') =~ /^pmac-generation\s*:\s*(.*)/m ? $1 : "Unknown Generation";	
}

sub hasSMP() { 
    return if $::testing;
    c::detectSMP() || any { /\bProcessor #(\d+)\s+(\S*)/ && $1 > 0 && $2 ne 'invalid' } syslog();
}
sub hasPCMCIA() { $::o->{pcmcia} } #- because /proc/pcmcia seems not to be present on 2.4 at least (or use /var/run/stab)

my (@dmis, $dmidecode_already_runned);

# we return a list b/c several DMIs have the same name:
sub dmidecode() {
	return @dmis if $dmidecode_already_runned;

	foreach (run_program::get_stdout('dmidecode')) {
	    if (/^\t\t(.*)/) {
		$dmis[-1]{string} .= "$1\n";
		$dmis[-1]{$1} = $2 if /^\t\t(.*): (.*)$/;
	    } elsif (my ($s) = /^\t(.*)/) {
		next if $s =~ /^DMI type /;
		$s =~ s/ Information$//;
		push @dmis, { name => $s };
	    }
	}
     $dmidecode_already_runned = 1;
    @dmis;
}

sub computer_info() {
     my @l = dmidecode();
	my $chassis = (find { $_->{name} eq 'Chassis' } @l) || { string => '' };
	my $Chassis = $chassis->{string} =~ /^Type:\s*(\S+)/m && $1;
	my $BIOS = (find { $_->{name} eq 'BIOS' } @l) || { string => '' };
	my $BIOS_Year = $BIOS->{string} =~ m!^Release Date:.*?(\d{4})!m && $1 ||
	                $BIOS->{string} =~ m!^Release Date:.*?\d\d/\d\d/(\d\d)!m && "20$1";
	
	+{ 
	    isLaptop => member($Chassis, 'Portable', 'Laptop', 'Notebook', 'Sub Notebook', 'Docking Station'),
	    if_($BIOS_Year, BIOS_Year => $BIOS_Year),
	};
}

#- try to detect a laptop, we assume pcmcia service is an indication of a laptop or
#- the following regexp to match graphics card apparently only used for such systems.
sub isLaptop() {
    arch() =~ /ppc/ ? 
      get_mac_model() =~ /Book/ :
      computer_info()->{isLaptop}
	|| (matching_desc__regexp('C&T.*655[45]\d') || matching_desc__regexp('C&T.*68554') ||
	    matching_desc__regexp('Neomagic.*Magic(Media|Graph)') ||
	    matching_desc__regexp('ViRGE.MX') || matching_desc__regexp('S3.*Savage.*[IM]X') ||
	    matching_desc__regexp('ATI.*(Mobility|LT)'))
	|| cat_('/proc/cpuinfo') =~ /\bmobile\b/i;
}

sub BIGMEM() {
    arch() !~ /x86_64|ia64/ && $> == 0 && c::dmiDetectMemory() > 4 * 1024;
}

sub is_i586() {
    my $cpuinfo = cat_('/proc/cpuinfo');
    $cpuinfo =~ /^cpu family\s*:\s*(\d+)/m && $1 < 6 ||
      $cpuinfo !~ /^flags.*\bcmov\b/m;
}

sub matching_type {
    my ($type) = @_;
    $type =~ /laptop/i && isLaptop();
}

sub usbMice()      { grep { $_->{media_type} =~ /\|Mouse/ && $_->{driver} !~ /wacom/ ||
			  $_->{driver} =~ /Mouse:USB/ } usb_probe() }
sub usbWacom()     { grep { $_->{driver} =~ /wacom/ } usb_probe() }
sub usbKeyboards() { grep { $_->{media_type} =~ /\|Keyboard/ } usb_probe() }
sub usbStorage()   { grep { $_->{media_type} =~ /Mass Storage\|/ } usb_probe() }
sub has_mesh()     { find { /mesh/ } all_files_rec("/proc/device-tree") }
sub has_53c94()    { find { /53c94/ } all_files_rec("/proc/device-tree") }

sub usbKeyboard2country_code {
    my ($usb_kbd) = @_;
    my ($F, $tmp);
    sysopen($F, sprintf("/proc/bus/usb/%03d/%03d", $usb_kbd->{pci_bus}, $usb_kbd->{pci_device}), 0) and
      sysseek $F, 0x28, 0 and
      sysread $F, $tmp, 1 and
      unpack("C", $tmp);
}

sub probeSerialDevices() {
    foreach (0..3) {
	#- make sure the device are created before probing,
	devices::make("/dev/ttyS$_");
	#- and make sure the device is a real terminal (major is 4).
	int((stat "/dev/ttyS$_")[6]/256) == 4 or $serialprobe{"/dev/ttyS$_"} = undef;
    }

    #- for device already probed, we can safely (assuming device are
    #- not moved during install :-)
    #- include /dev/mouse device if using an X server.
    mkdir_p("/var/lock");
    -l "/dev/mouse" and $serialprobe{"/dev/" . readlink "/dev/mouse"} = undef;
    foreach (keys %serialprobe) { m|^/dev/(.*)| and touch "/var/lock/LCK..$1" }

    print STDERR "Please wait while probing serial ports...\n";
    #- start probing all serial ports... really faster than before ...
    #- ... but still take some time :-)
    my %current; 
    foreach (run_program::get_stdout('serial_probe')) {
	if (/^\s*$/) {
	    $serialprobe{$current{DEVICE}} = { %current } if $current{DEVICE};
	    %current = ();
	} elsif (/^([^=]+)=(.*?)\s*$/) {
	    $current{$1} = $2;
	}
    }

    foreach (values %serialprobe) {
ofs	hex dump	ascii
0000	89 50 4e 47 0d 0a 1a 0a 00 00 00 0d 49 48 44 52 00 00 00 10 00 00 00 10 08 06 00 00 00 1f f3 ff	.PNG........IHDR................
0020	61 00 00 00 01 73 52 47 42 00 ae ce 1c e9 00 00 00 06 62 4b 47 44 00 ff 00 ff 00 ff a0 bd a7 93	a....sRGB.........bKGD..........
0040	00 00 00 09 70 48 59 73 00 00 0b 13 00 00 0b 13 01 00 9a 9c 18 00 00 00 07 74 49 4d 45 07 db 01	....pHYs.................tIME...
0060	18 14 2b 2c 43 67 8a aa 00 00 02 f7 49 44 41 54 38 cb 6d 93 3b 48 23 6d 14 86 df f3 4d 2e e3 e0	..+,Cg......IDAT8.m.;H#m....M...
0080	e4 62 44 c2 60 04 b7 73 63 13 b7 f9 cb 5d 48 65 6a 21 3f 56 f6 16 bb 04 0b 11 2c 44 11 2c d4 52	.bD.`..sc....]Hej!?V......,D.,.R
00a0	1b f9 b1 31 10 5b 8b 2d e2 6e 65 b7 5a 88 16 a2 81 24 98 78 89 89 c6 71 72 99 f9 e6 fc c5 12 f7	...1.[.-.ne.Z....$.x...qr.......
00c0	fa 75 0f 7c bc e7 f0 1e 1e c2 6f 6f 65 65 65 82 88 d2 ed 76 3b 65 db f6 08 00 78 bd de 92 aa aa	.u.\|......ooeee....v;e....x.....
00e0	07 cc 9c 5d 58 58 38 fe f9 3f fd 0c 8b 8b 8b 1b a6 69 7e 6c b7 db 08 87 c3 08 85 42 20 22 3c 3e	...]XX8..?.......i~l.......B."<>
0100	3e a2 5e af 43 55 55 f4 f7 f7 6f 2e 2d 2d 7d fa 23 60 7e 7e fe 4b a3 d1 78 6f 18 06 92 c9 24 c7	>.^.CUU...o.--}.#`~~.K..xo....$.
0120	62 31 f8 7c 3e 62 66 74 bb 5d be be be c6 e1 e1 21 95 cb 65 84 c3 e1 af ab ab ab 1f 00 40 01 80	b1.\|>bft.]......!..e.........@..
0140	b9 b9 b9 8d 87 87 87 74 3c 1e 97 33 33 33 22 16 8b 41 d7 75 f2 fb fd bd a9 14 89 44 10 8f c7 a9	.......t<..333"..A.u.......D....
0160	d1 68 c8 cb cb cb 37 c9 64 32 74 74 74 f4 99 32 99 cc 44 b3 d9 fc 66 18 06 66 67 67 a1 eb 3a ba	.h....7.d2ttt..2..D...f..fgg..:.
0180	dd 2e 3c 1e 0f 54 55 05 33 c3 b2 2c b8 ae 0b 45 51 60 59 16 b6 b7 b7 51 2c 16 11 0c 06 df 09 db	..<..TU.3..,...EQ`Y....Q,.......
01a0	b6 d3 a6 69 62 72 72 92 75 5d 67 c7 71 b0 bf bf 8f 9d 9d 1d 74 bb 5d d8 b6 8d f5 f5 75 2c 2f 2f	...ibrr.u]g.q.......t.].....u,//
01c0	c3 b6 6d 68 9a c6 a9 54 8a 2d cb 82 6d db 69 cf f3 f3 73 6a 70 70 10 86 61 40 51 14 72 5d 17 95	..mh...T.-..m.i...sjpp..a@Q.r]..
01e0	4a 05 b5 5a 0d ae eb 42 08 81 8b 8b 0b dc dd dd 81 99 d1 d7 d7 47 c3 c3 c3 1c 8d 46 51 af d7 53	J..Z...B.............G.....FQ..S
0200	a2 d5 6a 8d 44 22 91 d7 42 7b 01 f5 7a 1d 44 df 3b 36 4d f3 95 85 10 f0 7a bd 34 34 34 84 56 ab	..j.D"..B{..z.D.;6M.....z.444.V.
0220	35 e2 91 52 02 00 84 10 20 22 48 29 71 72 72 82 fb fb 7b 48 29 e1 f1 78 50 ab d5 d0 6c 36 7f dc	5..R....."H)qrr...{H)..xP...l6..
0240	9e 08 cc 0c 29 25 84 10 a2 74 7b 7b 0b c7 71 b8 17 a6 69 1a 82 c1 20 98 19 00 a0 aa 2a 02 81 c0	....)%...t{{..q...i.........*...
0260	2b 4b 29 b9 5a ad 42 08 51 f2 f8 fd fe 83 72 b9 fc b6 52 a9 20 1c 0e 33 33 d3 d8 d8 18 2c cb 7a	+K).Z.B.Q.....r...R....33....,.z
0280	dd aa c7 44 84 4e a7 c3 d5 6a 15 85 42 01 03 03 03 07 34 3d 3d 3d f1 f4 f4 f4 2d 1e 8f 23 93 c9	...D.N...j..B.....4===....-..#..
02a0	40 d3 34 74 3a 1d 28 8a 82 40 20 00 00 68 36 9b bd 02 e1 38 0e d6 d6 d6 70 7c 7c 8c 50 28 f4 4e	@.4t:.(..@...h6....8....p\|\|.P(.N
02c0	39 3d 3d ad 26 12 89 50 b1 58 fc e7 e5 e5 45 8e 8f 8f 0b 55 55 59 d3 34 92 52 c2 75 5d a8 aa 0a	9==.&..P.X....E....UUY.4.R.u]...
02e0	21 04 3b 8e 43 bb bb bb 32 9f cf 0b 5d d7 37 f7 f6 f6 fe 53 00 e0 ec ec ec 73 22 91 78 7f 7e 7e	!.;.C...2...].7....S.....s".x.~~
0300	fe a6 50 28 20 1a 8d c2 e7 f3 41 4a 49 8e e3 a0 d5 6a 71 a9 54 c2 d6 d6 16 e5 f3 79 11 0c 06 bf	..P(......AJI....jq.T......y....
0320	e6 72 b9 7f ff 90 69 6a 6a 6a c3 34 cd 8f ae eb 62 74 74 14 86 61 00 00 6e 6e 6e 70 75 75 05 22	.r....ijjj.4....btt..a..nnnpuu."
0340	82 ae eb 9b b9 5c ee d3 5f 6d 04 80 74 3a 3d c1 cc 69 cb b2 7e d1 59 d3 b4 03 22 ca 66 b3 d9 5f	.....\.._m..t:=..i..~.Y...".f.._
0360	74 fe 1f 14 e1 80 d1 3c 15 32 85 00 00 00 00 49 45 4e 44 ae 42 60 82	t......<.2.....IEND.B`.