summaryrefslogtreecommitdiffstats
path: root/perl-install/detect_devices.pm
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install/detect_devices.pm')
-rw-r--r--perl-install/detect_devices.pm2083
1 files changed, 1465 insertions, 618 deletions
diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm
index 51d7cd5ae..48dadadbb 100644
--- a/perl-install/detect_devices.pm
+++ b/perl-install/detect_devices.pm
@@ -1,4 +1,4 @@
-package detect_devices; # $Id$
+package detect_devices;
use diagnostics;
use strict;
@@ -8,24 +8,65 @@ use vars qw($pcitable_addons $usbtable_addons);
#- misc imports
#-######################################################################################
use log;
+use MDK::Common; # help perl_checker
use common;
use devices;
use run_program;
+use modules;
use c;
+use feature 'state';
+
+
+=head1 SYNOPSYS
+
+The B<detect_devices> modules offers a high level API for detecting devices.*
+It mostly relies on the L<c> modules for gluing libldetect back into the Perl world, and thus
+being able to enumerate DMI/HID/PCI/USB devices.
+
+Other devices are mostly detected through C</proc> & C</sys>.
+
+Then the L<list_modules> enables to map modules into categories such as:
+
+=over 4
+
+=item * C<network/ethernet,>
+
+=item * C<network/wireless,>
+
+=item * C<network/wifi,>
+
+=item * C<disk/sata,>
+
+=item * C<disk/scsi,>
+
+=item * ...
+
+=back
+
+This enables to detect a category by mapping drivers to categories.
+
+=head1 Listing block devices
+
+=cut
#-#####################################################################################
#- Globals
#-#####################################################################################
-my @netdevices = map { my $l = $_; map { "$l$_" } (0..3) } qw(eth tr fddi plip);
my %serialprobe;
#-######################################################################################
#- Functions
#-######################################################################################
-sub dev_is_devfs { -e "/dev/.devfsd" }
+=over
+
+=item get()
+
+Returns a list of all block devices (IDE, SCSI, SATA, virtual, RAID, ...)
-sub get {
+=cut
+
+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
@@ -33,83 +74,74 @@ sub get {
#- 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 { $_->{media_type} eq 'hd' && ($::isStandalone || !isRemovableDrive($_)) } get() }
-sub tapes { grep { $_->{media_type} eq 'tape' && ($::isStandalone || !isRemovableDrive($_)) } 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 {
+ getIDE(), getSCSI(), getMmcBlk(), getNVMe(), getXenBlk(), getVirtIO(), getDAC960(), getCompaqSmartArray();
+}
+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 ls120s() { grep { member($_->{media_type}, 'fd', 'hd') && isLS120Drive($_) } get() }
+sub zips() {
map {
$_->{device} .= 4;
- $_->{devfs_device} = $_->{devfs_prefix} . '/part4';
$_;
} raw_zips();
}
-sub cdroms__faking_ide_scsi {
- my @l = cdroms();
- return @l if $::isStandalone;
- if (my @l_ide = grep { $_->{bus} eq 'ide' && isBurner($_) } @l) {
- require modules;
- modules::add_probeall('scsi_hostadapter', 'ide-scsi');
- my $nb = 1 + max(-1, map { $_->{device} =~ /scd(\d+)/ } @l);
- foreach my $e (@l_ide) {
- log::l("IDEBurner: $e->{device}");
- $e->{device} = "scd" . $nb++;
- }
- }
- @l;
-}
-sub zips__faking_ide_scsi {
- my @l = raw_zips();
- if (my @l_ide = grep { $_->{bus} eq 'ide' && $::isInstall } @l) {
- require modules;
- modules::add_probeall('scsi_hostadapter', 'ide-scsi');
- my $nb = 1 + max(-1, map { if_($_->{device} =~ /sd(\w+)/, ord($1) - ord('a')) } getSCSI());
- foreach my $e (@l_ide) {
- my $faked = "sd" . chr(ord('a') + $nb++);
- log::l("IDE Zip: $e->{device} => $faked");
- $e->{device} = $faked;
- }
- }
- map { $_->{device} .= 4; $_ } @l;
-}
-
-sub floppies() {
+sub floppies {
+ my ($o_not_detect_legacy_floppies) = @_;
require modules;
- eval { modules::load("floppy") };
- my @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") };
+ state @fds;
+ state $legacy_already_detected;
+
+ $o_not_detect_legacy_floppies = 1 if arch() =~ /arm/;
+
+ if (!$o_not_detect_legacy_floppies && !$legacy_already_detected) {
+ $legacy_already_detected = 1;
+ if ($::isInstall) {
+ eval { modules::load("floppy") };
+ system(qw(udevadm settle)) if !$@;
+ }
+ #- do not bother probing /dev/fd0 and loading floppy device uselessly,
+ #- it takes time and it is already done by boot process (if not in install):
+ #- /dev/fd0 is created by start_udev (/etc/udev/devices.d/default.nodes)
+ #- then hal probes /dev/fd0 and triggers floppy module loading through kernel's kmod
+ if (any { (split)[1] eq 'fd' } cat_("/proc/devices")) {
+ @fds = map {
+ my $info = c::floppy_info("/dev/fd$_");
+ if_($info && $info ne '(null)', { device => "fd$_", 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' && !isZipDrive($_) && !isJazzDrive($_) } getSCSI();
+ eval { modules::load("usb_storage") } if $::isInstall && usbStorage();
+ my @scsi = grep { $_->{media_type} eq 'fd' } getSCSI();
@ide, @scsi, @fds;
}
sub floppies_dev() { map { $_->{device} } floppies() }
-sub floppy { first(floppies_dev()) }
+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 = split ' ', $l;
+ my @l;
+ @l = split(' ', $l) if $l;
if ($t eq 'drive name') {
@drives_order = map {
- s/^sr/scd/;
my $dev = $_;
- first(grep { $_->{device} eq $dev } @drives);
+ find { $_->{device} eq $dev } @drives;
} @l;
} else {
my $capacity;
@@ -127,14 +159,24 @@ sub get_sys_cdrom_info {
}
}
-sub get_devfs_devices {
+sub complete_usb_storage_info {
my (@l) = @_;
- my %h = (cdrom => 'cd', hd => 'disc');
-
- foreach (@l) {
- my $t = $h{$_->{media_type}} or next;
- $_->{devfs_device} = $_->{devfs_prefix} . '/' . $t;
+ my @usb = grep { exists $_->{usb_vendor} } @l;
+
+ foreach my $usb (usb_probe()) {
+ if (my $e = find { !$_->{found} && $_->{usb_vendor} == $usb->{vendor} && $_->{usb_id} == $usb->{id} } @usb) {
+ my $host = get_sysfs_usbpath_for_block($e->{device});
+ if ($host) {
+ my $file = "/sys/block/$host/../serial";
+ $e->{info} = chomp_(cat_($file)) if -e $file;
+ $e->{usb_description} = join('|',
+ chomp_(cat_("/sys/block/$host/../manufacturer")),
+ chomp_(cat_("/sys/block/$host/../product")));
+ }
+ local $e->{found} = 1;
+ $e->{"usb_$_"} ||= $usb->{$_} foreach keys %$usb;
+ }
}
}
@@ -155,71 +197,143 @@ sub isDvdDrive {
$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 isRemovableDrive { &isZipDrive || &isLS120Drive || $_[0]{media_type} eq 'fd' } #-or &isJazzDrive }
+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_sysfs_field_from_link {
+ my ($device, $field) = @_;
+ my $l = readlink("$device/$field");
+ $l =~ s!.*/!!;
+ $l;
+}
-sub isFloppyOrHD {
- my ($dev) = @_;
- require partition_table::raw;
- my $geom = partition_table::raw::get_geometry(devices::make($dev));
- $geom->{totalsectors} < 10 << 11 ? 'fd' : 'hd';
+sub get_sysfs_usbpath_for_block {
+ my ($device) = @_;
+ my $host = readlink("/sys/block/$device");
+ $host =~ s!/host.*!!;
+ $host;
}
+sub get_scsi_driver {
+ my (@l) = @_;
+ # find driver of host controller from sysfs:
+ foreach (@l) {
+ next if $_->{driver};
+ my $host = get_sysfs_usbpath_for_block($_->{device});
+ require list_modules;
+ $_->{driver} = list_modules::filename2modname(get_sysfs_field_from_link("/sys/block/$host", 'driver'));
+ }
+}
+
+=item getSCSI()
+
+Returns a list of all SCSI device.
+
+=cut
+
sub getSCSI() {
- 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", channel => $channel, id => $id, lun => $lun,
- device => "sg$::i", devfs_prefix => sprintf('scsi/host%d/bus%d/target%d/lun%d', $host, $channel, $id, $lun),
- raw_type => $type, bus => 'SCSI' };
- } @l;
-
- each_index {
- my $dev = "sd" . chr($::i + ord('a'));
- put_in_hash $_, { device => $dev, media_type => isZipDrive($_) ? 'hd' : isFloppyOrHD($dev) };
- } grep { $_->{raw_type} =~ /Direct-Access/ } @l;
-
- each_index {
- put_in_hash $_, { device => "st$::i", media_type => 'tape' };
- } grep { $_->{raw_type} =~ /Sequential-Access/ } @l;
-
- each_index {
- put_in_hash $_, { device => "scd$::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;
-
- get_devfs_devices(@l);
+ 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;
+ foreach (all($dev_dir)) {
+ my ($host, $channel, $id, $lun) = split ':';
+ defined $lun or next;
+
+ my $dir = "$dev_dir/$_";
+
+ # handle both old and new kernels:
+ my $node = find { -e $_ } "$dir/block", top(glob_("$dir/block*")), "$dir/tape", top(glob_("$dir/scsi_generic*"));
+ my ($device) = readlink($node) =~ m!/(?:scsi_(?:generic|tape)|block)/(.*)!;
+ if (!$device) {
+ ($device) = top(glob_("$node/*")) =~ m!/(?:scsi_(?:generic|tape)|block)/(.*)!;
+ }
+ warn("cannot get info for device ($_)"), next if !$device;
+
+ my $usb_dir = readlink($dir) =~ m!/usb! && "$dir/../../../..";
+ my $get_usb = sub { chomp_(cat_("$usb_dir/$_[0]")) };
+
+ my $get = sub {
+ my $s = cat_("$dir/$_[0]");
+ $s =~ s/\s+$//;
+ $s;
+ };
+
+ # 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')];
+
+ my $media_type = ${{ st => 'tape', sr => 'cdrom', sd => 'hd', sg => 'generic' }}{substr($device, 0, 2)} ||
+ $raw_type =~ /Scanner|Processor/ && 'scanner';
+
+ my ($vendor, $model) = ($get->('vendor'), $get->('model'));
+ my ($v, $m) = _get_hd_vendor($model);
+ if ($v && $m) {
+ ($vendor, $model) = ($v, $m);
+ }
+ push @l, { info => $vendor . ' ' . $model, host => $host, channel => $channel, id => $id, lun => $lun,
+ description => join('|', $vendor, $model),
+ bus => 'SCSI', media_type => $media_type, device => $device,
+ $usb_dir ? (
+ usb_vendor => hex($get_usb->('idVendor')), usb_id => hex($get_usb->('idProduct')),
+ ) : (),
+ };
+ }
+
+ @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_sys_cdrom_info(@l);
+ get_scsi_driver(@l);
@l;
}
-my %eide_hds = (
+
+my %hd_vendors = (
"ASUS" => "Asus",
+ "ATA Maxtor" => "Maxtor",
"CD-ROM CDU" => "Sony",
"CD-ROM Drive/F5D" => "ASUSTeK",
"Compaq" => "Compaq",
"CONNER" => "Conner Peripherals",
"IBM" => "IBM",
+ "INTEL" => "Intel",
"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",
@@ -227,11 +341,24 @@ my %eide_hds = (
"ST3" => "Seagate Technology",
"TEAC" => "Teac",
"TOSHIBA" => "Toshiba",
- "TEAC" => "Teac",
- "TOSHIBA" => "Toshiba",
"WDC" => "Western Digital Corp.",
);
+# return ($vendor, $model)
+sub _get_hd_vendor {
+ my ($info) = @_;
+ foreach my $name (keys %hd_vendors) {
+ next if !$name;
+ return ($hd_vendors{$name}, $2) if $info =~ /^$name(-|\s)*(.*)/;
+ }
+ return ("Hitachi", $info) if $info =~ /^HD[ST][0-9]/;
+}
+
+=item getIDE()
+
+Returns a list of all IDE device.
+
+=cut
sub getIDE() {
my @idi;
@@ -241,46 +368,61 @@ sub getIDE() {
#- 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 $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 =~ /^$_\b(-|\s*)(.*)/, $eide_hds{$_}, $2);
- } keys %eide_hds;
+ my $num = ord(($d =~ /(.)$/)[0]) - ord 'a';
+ my ($vendor, $model) = _get_hd_vendor($info);
- my ($channel, $id) = ($num / 2, $num % 2);
- my $devfs_prefix = sprintf('ide/host0/bus%d/target%d/lun0', $channel, $id);
+ my $host = $num;
+ ($host, my $id) = divide($host, 2);
+ ($host, my $channel) = divide($host, 2);
push @idi, { media_type => $type, device => basename($d),
- devfs_prefix => $devfs_prefix,
- info => $info, channel => $channel, id => $id, bus => 'ide',
- Vendor => $vendor, Model => $model };
+ 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} } do { require fs::proc_partitions; fs::proc_partitions::read_raw() };
+}
+
+=item getCompaqSmartArray()
+
+Returns a list of all CCISS devices (Compaq Smart Array).
+
+=cut
+
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 $prefix = "/proc/driver/$_";
my ($name) = m|/(.*)|;
for (my $i = 0; -r ($f = "${prefix}$i"); $i++) {
- foreach (cat_($f)) {
- if (m|^\s*($name/.*?):|) {
- push @idi, { device => $1, info => "Compaq RAID logical disk", media_type => 'hd', bus => 'ida' };
- }
+ my @raw_devices = cat_($f) =~ m|^\s*($name/.*?):|gm;
+
+ #- this is ugly and buggy. keeping it for 2007.0
+ #- on a cciss, cciss/cciss0 didn't contain c0d0, but cciss/cciss1 did contain c0d1
+ #- the line below adds both c0d0 and c0d1 for cciss0, and so some duplicates
+ @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;
+ #- workaround the buggy code above. this should be safe though
+ uniq_ { $_->{device} } @idi;
}
sub getDAC960() {
@@ -295,23 +437,530 @@ sub getDAC960() {
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, bus => 'ataraid' };
- log::l("ATARAID: $device");
+=item getXenBlk()
+
+Returns a list of all Xen block devices (C</dev/xvd*>).
+
+=cut
+
+sub getXenBlk() {
+ -d '/sys/bus/xen/devices' or return;
+ map {
+ s/block://;
+ { device => basename($_), info => "Xen block device", media_type => 'hd', bus => 'xen' };
+ } glob("/sys/block/xvd*");
+}
+
+=item getVirtIO()
+
+Returns a list of all VirtIO block devices (/dev/C<vd*>).
+
+=cut
+
+sub getVirtIO() {
+ -d '/sys/bus/virtio/devices' or return;
+ map {
+ { device => basename($_), info => "VirtIO block device", media_type => 'hd', bus => 'virtio' };
}
- values %l;
+ glob("/sys/bus/virtio/devices/*/block/*");
}
-sub getNet() {
- grep { !(($::isStandalone || $::live) && /plip/) && c::hasNetDevice($_) } @netdevices;
+sub getMmcBlk() {
+ -d '/sys/bus/mmc/devices' or return;
+ map {
+ { device => basename($_), info => "MMC block device", media_type => 'hd', bus => 'mmc' };
+ }
+ glob("/sys/bus/mmc/devices/*/block/*");
+}
+
+sub getNVMe() {
+ -d '/sys/class/nvme' or return;
+ map {
+ { device => basename($_), info => "NVMe block device", media_type => 'hd', bus => 'pci_express' };
+ }
+ glob("/sys/block/nvme*");
+}
+
+=item getCPUs()
+
+Returns a list of all CPUs.
+
+=cut
+
+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 ix86_cpu_frequency() {
+ cat_('/proc/cpuinfo') =~ /cpu MHz\s*:\s*(\d+)/ && $1;
}
-#sub getISDN() {
-# mapgrep(sub {member (($_[0] =~ /\s*(\w*):/), @netdevices), $1 }, split(/\n/, cat_("/proc/net/dev")));
-#}
+=item probe_category($category)
+
+Returns a list of devices which drivers are in the asked category. eg:
+
+ my @eth_cards = probe_category('network/ethernet');
+
+=cut
+
+sub probe_category {
+ my ($category) = @_;
+
+ require list_modules;
+ my @modules = list_modules::category2modules($category);
+
+ grep {
+ if ($category eq 'network/isdn') {
+ my $b = $_->{driver} =~ /ISDN:([^,]*),?([^,]*)(?:,firmware=(.*))?/;
+ if ($b) {
+ $_->{driver} = $1;
+ $_->{type} = $2;
+ $_->{type} =~ s/type=//;
+ $_->{firmware} = $3;
+ $_->{driver} eq "hisax" and $_->{options} .= " id=HiSax";
+ }
+ $b;
+ } else {
+ member($_->{driver}, @modules);
+ }
+ } probeall();
+}
+
+sub getSoundDevices() {
+ probe_category('multimedia/sound');
+}
+
+sub isTVcardConfigurable { member($_[0]{driver}, qw(bttv cx88 saa7134)) }
+
+sub getTVcards() { probe_category('multimedia/tv') }
+
+sub getInputDevices() {
+ state @input_devices;
+ return @input_devices if @input_devices;
+ my (@devices, $device);
+ my $event;
+ foreach (cat_('/proc/bus/input/devices')) {
+ if (/^I:/) {
+ $device = {};
+ $device->{vendor} = /Vendor=(\w+)/ && $1;
+ $device->{id} = /Product=(\w+)/ && $1;
+ $device->{bustype} = /Bus=(\w+)/ && $1;
+ } elsif (/N: Name="(.*)"/) {
+ my $descr = $1;
+ $device->{description} = "|$descr";
+
+ #- I: Bus=0011 Vendor=0002 Product=0008 Version=7321
+ #- N: Name="AlpsPS/2 ALPS GlidePoint"
+ #- P: Phys=isa0060/serio1/input0
+ #- H: Handlers=mouse1 event2 ts1
+ #- B: EV=f
+ #- B: KEY=420 0 70000 0 0 0 0 0 0 0 0 #=> BTN_LEFT BTN_RIGHT BTN_MIDDLE BTN_TOOL_FINGER BTN_TOUCH
+ #- or B: KEY=420 0 670000 0 0 0 0 0 0 0 0 #=> same with BTN_BACK
+ #- B: REL=3 #=> X Y
+ #- B: ABS=1000003 #=> X Y PRESSURE
+
+ #- I: Bus=0011 Vendor=0002 Product=0008 Version=2222
+ #- N: Name="AlpsPS/2 ALPS DualPoint TouchPad"
+ #- P: Phys=isa0060/serio1/input0
+ #- S: Sysfs=/class/input/input2
+ #- H: Handlers=mouse1 ts1 event2
+ #- B: EV=f
+ #- B: KEY=420 0 70000 0 0 0 0 0 0 0 0
+ #- B: REL=3
+ #- B: ABS=1000003
+
+ #- I: Bus=0011 Vendor=0002 Product=0007 Version=0000
+ #- N: Name="SynPS/2 Synaptics TouchPad"
+ #- P: Phys=isa0060/serio1/input0
+ #- S: Sysfs=/class/input/input1
+ #- H: Handlers=mouse0 event1 ts0
+ #- B: EV=b
+ #- B: KEY=6420 0 70000 0 0 0 0 0 0 0 0 #=> BTN_LEFT BTN_RIGHT BTN_MIDDLE BTN_TOOL_FINGER BTN_TOUCH BTN_TOOL_DOUBLETAP BTN_TOOL_TRIPLETAP
+ #- or B: KEY=6420 0 670000 0 0 0 0 0 0 0 0 #=> same with BTN_BACK
+ #- or B: KEY=420 30000 670000 0 0 0 0 0 0 0 0 #=> same without BTN_TOOL_TRIPLETAP but with BTN_B
+ #- B: ABS=11000003 #=> X Y PRESSURE TOOL_WIDTH
+
+ #- I: Bus=0003 Vendor=056a Product=0065 Version=0108
+ #- N: Name="Wacom Bamboo"
+ #- B: KEY=1c63 0 70033 0 0 0 0 0 0 0 0 #=> BTN_0 BTN_1 BTN_4 BTN_5 BTN_LEFT BTN_RIGHT BTN_MIDDLE TOOL_PEN TOOL_RUBBER TOOL_BRUSH TOOL_FINGER TOOL_MOUSE TOUCH STYLUS STYLUS2
+ #- B: ABS=100 3000103 #=> X Y WHEEL PRESSURE DISTANCE MISC
+
+ #- I: Bus=0003 Vendor=056a Product=0011 Version=0201
+ #- N: Name="Wacom Graphire2 4x5"
+ #- B: KEY=1c43 0 70000 0 0 0 0 0 0 0 0 #=> BTN_LEFT BTN_RIGHT BTN_MIDDLE TOOL_PEN TOOL_RUBBER TOOL_FINGER TOOL_MOUSE TOUCH STYLUS STYLUS2
+ #- B: ABS=100 3000003 #=> X Y PRESSURE DISTANCE MISC
+
+ #I: Bus=0003 Vendor=049f Product=0024 Version=0001
+ #N: Name="Compaq Compaq Numeric Keypad"
+ #P: Phys=usb-0000:00:03.2-2/input0
+ #S: Sysfs=/class/input/input7
+ #H: Handlers=kbd event3
+ #B: EV=120003
+ #B: KEY=10000 7 ff800000 7ff febeffdf ffefffff ffffffff fffffffe
+ #B: LED=1f
+
+ $device->{Synaptics} = $descr eq 'SynPS/2 Synaptics TouchPad';
+ $device->{ALPS} = $descr =~ m!^AlpsPS/2 ALPS!;
+ $device->{Elantech} = $descr eq 'ETPS/2 Elantech Touchpad';
+ $device->{Numpad} = $descr =~ /Numeric Keypad/;
+
+ } elsif (/H: Handlers=(.*)/) {
+ my @l = split(' ', $1);
+ $device->{driver} = $l[0]; #- keep it for compatibility
+ $device->{Handlers} = +{ map { (/^(.*?)\d*$/ ? $1 : $_, $_) } split(' ', $1) };
+ $event = $device->{Handlers}{event};
+ } elsif (/S: Sysfs=(.+)/) {
+ $device->{sysfs_path} = $1;
+ } elsif (/P: Phys=(.*)/) {
+ $device->{location} = $1;
+ $device->{bus} = 'isa' if $device->{location} =~ /^isa/;
+ $device->{bus} = 'usb' if $device->{location} =~ /^usb/i;
+ } elsif (/B: REL=(.* )?(.*)/) {
+ #- REL=3 #=> X Y
+ #- REL=103 #=> X Y WHEEL
+ #- REL=143 #=> X Y HWHEEL WHEEL
+ #- REL=1c3 #=> X Y HWHEEL DIAL WHEEL
+ my $REL = hex($2);
+ $device->{HWHEEL} = 1 if $REL & (1 << 6);
+ $device->{WHEEL} = 1 if $REL & (1 << 8); #- not reliable ("Mitsumi Apple USB Mouse" says REL=103 and KEY=1f0000 ...)
+
+ } elsif (/B: KEY=(\S+)/) {
+ #- some KEY explained:
+ #- (but note that BTN_MIDDLE can be reported even if missing)
+ #- (and "Mitsumi Apple USB Mouse" reports 1f0000)
+ #- KEY=30000 0 0 0 0 0 0 0 0 #=> BTN_LEFT BTN_RIGHT
+ #- KEY=70000 0 0 0 0 0 0 0 0 #=> BTN_LEFT BTN_RIGHT BTN_MIDDLE
+ #- KEY=1f0000 0 0 0 0 0 0 0 0 #=> BTN_LEFT BTN_RIGHT BTN_MIDDLE BTN_SIDE BTN_EXTRA
+ if (!$> && ! -f "/dev/input/$event") {
+ devices::make("/dev/input/$event");
+ }
+ if (-r "/dev/input/$event") {
+ my @KEYS = c::EVIocGBitKey("/dev/input/$event");
+ $device->{SIDE} = 1 if $KEYS[0] & (1 << 0x13);
+ } else {
+ my $KEY = hex($1);
+ $device->{SIDE} = 1 if $KEY & (1 << 0x13);
+ }
+
+ } elsif (/^\s*$/) {
+ push @devices, $device if $device;
+ undef $device;
+ }
+ }
+ @input_devices = @devices;
+}
+
+sub getInputDevices_and_usb() {
+ my @l = getInputDevices();
+
+ foreach my $usb (usb_probe()) {
+ if (my $e = find { hex($_->{vendor}) == $usb->{vendor} && hex($_->{id}) == $usb->{id} } @l) {
+ $e->{usb} = $usb;
+ }
+ }
+
+ @l;
+}
+
+sub serialPorts() { map { "ttyS$_" } 0..7 }
+sub serialPort2text {
+ $_[0] =~ /ttyS(\d+)/ ? "$_[0] / COM" . ($1 + 1) : $_[0];
+}
+
+=back
+
+=head1 Network
+
+=over
+
+=cut
+
+sub getSerialModem {
+ my ($_modules_conf, $o_mouse) = @_;
+ my $mouse = $o_mouse || {};
+ $mouse->{device} = readlink "/dev/mouse";
+ my $serdev = "serial";
+
+ eval { modules::load($serdev) };
+
+ my @modems;
+
+ probeSerialDevices();
+ foreach my $port (serialPorts()) {
+ 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) {
+ foreach (@devs) { $_->{device} and $modem->{device} = $_->{device} }
+ }
+ @modems;
+}
+
+=item getModem()
+
+Return list of modems (serial, WinModems)
+=cut
+
+our $detect_serial_modem = 1;
+sub getModem {
+ my ($modules_conf) = @_;
+ ($detect_serial_modem ? getSerialModem($modules_conf, {}) : ()), get_winmodems();
+}
+
+sub get_winmodems() {
+ matching_driver__regexp('www\.linmodems\.org'),
+ matching_driver(list_modules::category2modules('network/modem'),
+ list_modules::category2modules('network/slmodem'));
+}
+
+sub getBewan() {
+ matching_desc__regexp('Bewan Systems\|.*ADSL|BEWAN ADSL USB|\[Unicorn\]');
+}
+
+# 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();
+}
+
+=item get_xdsl_usb_devices()
+
+Return list of xDSL devices.
+
+=cut
+
+sub get_xdsl_usb_devices() {
+ my @bewan = detect_devices::getBewan();
+ $_->{driver} = $_->{bus} eq 'USB' ? 'unicorn_usb_atm' : 'unicorn_pci_atm' foreach @bewan;
+ my @eci = detect_devices::getECI();
+ $_->{driver} = 'eciusb' foreach @eci;
+ my @usb = detect_devices::probe_category('network/usb_dsl');
+ $_->{description} = "USB ADSL modem (eagle chipset)" foreach
+ grep { $_->{driver} eq 'ueagle_atm' && $_->{description} eq '(null)' } @usb;
+ @usb, @bewan, @eci;
+}
+
+=item is_lan_interface($device)
+
+Is it a LAN interface (blacklist some interfaces (PPP, ...)?
+
+=cut
+
+sub is_lan_interface {
+ #- we want LAN like interfaces here (eg: ath|br|eth|fddi|plip|ra|tr|usb|wlan).
+ #- there's also bnep%d for bluetooth, bcp%d...
+ #- we do this by blacklisting the following interfaces:
+ #- hso%d are created by drivers/net/usb/hso.c
+ #- 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
+ #- pan%d are created by bnep
+ is_useful_interface($_[0]) &&
+ $_[0] !~ /^(?:hso|ippp|isdn|plip|ppp|pan)/;
+}
+
+=item is_useful_interface($device)
+
+Is it a usefull interface (blacklist some interfaces (loopback, sit, wifi, ...)?
+
+=cut
+
+sub is_useful_interface {
+ #- sit0 which is *always* created by net/ipv6/sit.c, thus is always created since net.agent loads ipv6 module
+ #- wifi%d are created by 3rdparty/hostap/hostap_hw.c (pseudo statistics devices, #14523)
+ #- wmaster%d are created by net/mac80211/ieee80211.c ("master" 802.11 device)
+ #- ax*, rose*, nr*, bce* and scc* are Hamradio devices (#28776)
+ $_[0] !~ /^(?:lo|sit0|wifi|wmaster|ax|rose|nr|bce|scc)/;
+}
+
+=item is_wireless_interface($device)
+
+Is it a WiFi interface?
+
+=cut
+
+sub is_wireless_interface {
+ my ($interface) = @_;
+ #- some wireless drivers don't always support the SIOCGIWNAME ioctl
+ #- ralink devices need to be up to support it
+ #- wlan-ng (prism2_*) need some special tweaks to support it
+ #- use sysfs as fallback to detect wireless interfaces,
+ #- i.e interfaces for which get_wireless_stats() is available
+ c::isNetDeviceWirelessAware($interface)
+ || -e "/sys/class/net/$interface/wireless"
+ || -e "/sys/class/net/$interface/phy80211";
+}
+
+=item get_all_net_devices()
+
+Returns list of all network devices
+
+=cut
+
+sub get_all_net_devices() {
+ #- 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
+ uniq(
+ (map { if_(/^\s*([A-Za-z0-9:\.]*):/, $1) } cat_("/proc/net/dev")),
+ c::get_netdevices(),
+ );
+}
+
+=item get_lan_interfaces()
+
+Returns list of all LAN devices
+
+=cut
+
+sub get_lan_interfaces() { grep { is_lan_interface($_) } get_all_net_devices() }
+
+=item get_net_interfaces()
+
+Returns list of all useful network devices
+
+=cut
+
+sub get_net_interfaces() { grep { is_useful_interface($_) } get_all_net_devices() }
+
+=item get_wireless_interface()
+
+Returns list of all Wireless devices
+
+=cut
+
+sub get_wireless_interface() { find { is_wireless_interface($_) } get_lan_interfaces() }
+
+=item is_bridge_interface($interface)
+
+Is it a bridge?
+
+=cut
+
+sub is_bridge_interface {
+ my ($interface) = @_;
+ -f "/sys/class/net/$interface/bridge/bridge_id";
+}
+
+=back
+
+=head1 Enumerating devices
+
+=over
+
+=cut
+
+sub get_ids_from_sysfs_device {
+ my ($dev_path) = @_;
+ my $dev_cat = sub { chomp_(cat_("$dev_path/$_[0]")) };
+ my $usb_root = -f "$dev_path/bInterfaceNumber" && "../" || -f "$dev_path/idVendor" && "";
+ my $is_pcmcia = -f "$dev_path/card_id";
+ my $sysfs_ids;
+ my $bus = get_sysfs_field_from_link($dev_path, "subsystem");
+ #- FIXME: use $bus
+ if ($is_pcmcia) {
+ $sysfs_ids = { modalias => $dev_cat->('modalias') };
+ } else {
+ $sysfs_ids = $bus eq 'ieee1394' ?
+ {
+ version => "../vendor_id",
+ specifier_id => "specifier_id",
+ specifier_version => "version",
+ } :
+ defined $usb_root ?
+ { id => $usb_root . 'idProduct', vendor => $usb_root . 'idVendor' } :
+ { id => "device", subid => "subsystem_device", vendor => "vendor", subvendor => "subsystem_vendor" };
+ $_ = hex($dev_cat->($_)) foreach values %$sysfs_ids;
+ if ($bus eq 'pci') {
+ my $device = basename(readlink $dev_path);
+ my @ids = $device =~ /^(.{4}):(.{2}):(.{2})\.(.+)$/;
+ @$sysfs_ids{qw(pci_domain pci_bus pci_device pci_function)} = map { hex($_) } @ids if @ids;
+ }
+ }
+ $sysfs_ids;
+}
+
+sub device_matches_sysfs_ids {
+ my ($device, $sysfs_ids) = @_;
+ every { defined $device->{$_} && member($device->{$_}, $sysfs_ids->{$_}, 0xffff) } keys %$sysfs_ids;
+}
+
+sub device_matches_sysfs_device {
+ my ($device, $dev_path) = @_;
+ device_matches_sysfs_ids($device, get_ids_from_sysfs_device($dev_path));
+}
+
+sub getUPS() {
+ # MGE serial PnP devices:
+ (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;
+ (map { ($_->{name} = $_->{description}) =~ s/.*\|//; $_ }
+ map {
+ if ($_->{description} =~ /Back-UPS/ && $_->{driver} eq 'usbhid') {
+ #- FIXME: should not be hardcoded, use $_->{sysfs_device} . */usb:(hiddev\d+)
+ #- the device should also be assigned to the ups user
+ $_->{port} = "/dev/hiddev0";
+ $_->{driver} = 'hidups';
+ $_;
+ } elsif ($_->{description} =~ /^MGE UPS Systems\|/ && $_->{driver} =~ /ups$/) {
+ $_->{port} = "auto";
+ $_->{media_type} = 'UPS';
+ $_->{driver} = 'newhidups';
+ $_;
+ } else {
+ ();
+ }
+ } usb_probe());
+}
$pcitable_addons = <<'EOF';
# add here lines conforming the pcitable format (0xXXXX\t0xXXXX\t"\w+"\t".*")
@@ -321,15 +970,30 @@ $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 "bad detect_devices::probeall_addons line \"$_\"";
+ /^\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 "bad detect_devices::probeall_addons line \"$_\"";
+ 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 });
@@ -338,530 +1002,681 @@ sub add_addons {
@l;
}
-sub pci_probe {
- my ($probe_type) = @_;
- log::l("full pci_probe") if $probe_type;
+sub get_pci_sysfs_path {
+ my ($l) = @_;
+ sprintf('%04x:%02x:%02x.%d', $l->{pci_domain}, $l->{pci_bus}, $l->{pci_device}, $l->{pci_function});
+}
+
+
+my (@pci, @usb);
+
+sub pci_probe__real() {
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($probe_type || 0));
+ my $l = $_;
+ $l->{bus} = 'PCI';
+ $l->{sysfs_device} = '/sys/bus/pci/devices/' . get_pci_sysfs_path($l);
+ $l;
+ } c::pci_probe());
+}
+
+=item pci_probe()
+
+Cache the result of C<c::pci_probe()> and return the list of items in the PCI devices.
+
+=cut
+
+sub pci_probe() {
+ state $done;
+ if (!$done) {
+ @pci = pci_probe__real() if !@pci;
+ foreach (@pci) {
+ $_->{nice_bus} = $_->{is_pciexpress} ? "PCI Express" : "PCI";
+ }
+ }
+ @pci;
}
-sub usb_probe {
- -e "/proc/bus/usb/devices" or return;
+sub usb_probe__real() {
+ -e "/sys/kernel/debug/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{$_} = hex $l{$_} foreach qw(vendor id);
- $l{bus} = 'USB';
- \%l
+ my $l = $_;
+ $l->{media_type} = join('|', grep { $_ ne '(null)' } split('\|', $l->{media_type}));
+ $l->{sysfs_device} = "/sys/bus/usb/devices/$l->{pci_bus}-" . ($l->{usb_port} + 1);
+ $l->{bus} = 'USB';
+ $l;
} c::usb_probe());
}
-sub pcmcia_probe {
- -e '/var/run/stab' || -e '/var/lib/pcmcia/stab' or return ();
+=item usb_probe()
- 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 };
+Cache the result of C<c::usb_probe()> and return the list of items in the USB devices.
+
+=cut
+
+sub usb_probe() {
+ if ($::isStandalone && @usb) {
+ @usb;
+ } else {
+ @usb = usb_probe__real();
+ }
+}
+
+=item firewire_probe()
+
+Return list of Firewire controllers
+
+=cut
+
+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',
+ sysfs_device => $dir,
+ };
+ } 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;
}
}
- @devs;
+
+ 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;
}
-# pci_probe with $probe_type is unsafe for pci! (bug in kernel&hardware)
-# pcmcia_probe provides field "device", used in network.pm
-# => probeall with $probe_type is unsafe
-sub probeall {
- my ($probe_type) = @_;
+=item pcmcia_controller_probe()
+
+Return list of PCMCIA controllers
+
+=cut
+
+sub pcmcia_controller_probe() {
+ my ($controller) = probe_category('bus/pcmcia');
+ if (!$controller && !$::testing && !$::noauto && arch() =~ /i.86/) {
+ my $driver = c::pcmcia_probe();
+ $controller = { driver => $driver, description => "PCMCIA controller ($driver)" } if $driver;
+ }
+ $controller;
+}
+
+=item pcmcia_probe()
+
+Return list of PCMCIA devices (eg: Ethernet PCMCIA cards, ...)
+
+=cut
+
+sub pcmcia_probe() {
+ require modalias;
+ require modules;
+ my $dev_dir = '/sys/bus/pcmcia/devices';
+ map {
+ my $dir = "$dev_dir/$_";
+ my $get = sub { chomp_(cat_("$dir/$_[0]")) };
+ my $class_dev = first(glob_("$dir/tty/tty*"));
+ my $device = $class_dev && basename($class_dev);
+ my $modalias = $get->('modalias');
+ my $driver = get_sysfs_field_from_link($dir, 'driver');
+ #- fallback on modalias result
+ #- but only if the module isn't loaded yet (else, it would already be binded)
+ #- this prevents from guessing the wrong driver for multi-function devices
+ my $module = $modalias && first(modalias::get_modules($modalias));
+ $driver ||= !member($module, modules::loaded_modules()) && $module;
+ {
+ description => join(' ', grep { $_ } map { $get->("prod_id$_") } 1 .. 4),
+ driver => $driver,
+ if_($modalias, modalias => $modalias),
+ if_($device, device => $device),
+ bus => 'PCMCIA',
+ sysfs_device => $dir,
+ };
+ } all($dev_dir);
+}
+
+=item dmi_probe()
+
+Cache the result of c::dmi_probe() (aka C<dmidecode>) and return the list of items in the DMI table
+
+=cut
+
+sub dmi_probe() {
+ state $dmi_probe;
+ return if arch() !~ /86/;
+ $dmi_probe ||= $> ? [] : [ c::dmi_probe() ];
+ @$dmi_probe;
+}
+
+=item acpi_probe()
+
+Return list of devices that are only discoverable via ACPI
+
+=cut
+
+my %acpi_device_info = (
+ "80860F28" => { vendor => 0x8086, id => 0x0f28, description => 'Intel Corporation|Bay Trail SST Audio DSP',
+ nice_media_type => 'Audio device', driver => 'snd_sof_acpi_intel_byt' },
+ "808622A8" => { vendor => 0x8086, id => 0x22a8, description => 'Intel Corporation|Cherry Trail SST Audio DSP',
+ nice_media_type => 'Audio device', driver => 'snd_sof_acpi_intel_byt' },
+ "INT3438" => { vendor => 0x8086, id => 0x3438, description => 'Intel Corporation|Broadwell SST Audio DSP',
+ nice_media_type => 'Audio device', driver => 'snd_sof_acpi_intel_bdw' }
+);
+sub acpi_probe() {
+ my $dev_dir = '/sys/bus/acpi/devices';
+ my @l;
+ foreach (glob("$dev_dir/*")) {
+ my $dev_name = basename($_);
+ my ($prefix, $suffix) = split(':', $dev_name);
+ my $e = $acpi_device_info{$prefix};
+ if ($e) {
+ add2hash($e, { bus => 'ACPI', sysfs_device => "$dev_dir/$dev_name" });
+ push @l, $e;
+ }
+ }
+ @l;
+}
+
+=item probeall()
+
+Returns a list of all PCI/USB/Firewire/PCMCIA/DMI/HID devices.
+It's usually called through a higher level filtering function.
+
+=cut
+
+# pcmcia_probe provides field "device", used in network.pm
+sub probeall() {
return if $::noauto;
- require sbus_probing::main;
- pci_probe($probe_type), usb_probe(), pcmcia_probe(), sbus_probing::main::probe();
+ pci_probe(), usb_probe(), firewire_probe(), pcmcia_probe(), dmi_probe(), acpi_probe(), getInputDevices_and_usb();
+}
+sub probeall_update_cache() {
+ return if $::noauto;
+ @pci = pci_probe__real(), @usb = usb_probe__real(), firewire_probe(), pcmcia_probe(), dmi_probe();
}
-sub matching_desc {
+sub matching_desc__regexp {
my ($regexp) = @_;
grep { $_->{description} =~ /$regexp/i } probeall();
}
-sub stringlist {
+sub matching_driver__regexp {
+ my ($regexp) = @_;
+ grep { $_->{driver} =~ /$regexp/i } probeall();
+}
+
+sub matching_driver {
+ my (@list) = @_;
+ grep { member($_->{driver}, @list) } probeall();
+}
+sub probe_name {
+ my ($name) = @_;
+ map { $_->{driver} =~ /^$name:(.*)/ } probeall();
+}
+sub probe_unique_name {
+ my ($name) = @_;
+ my @l = uniq(probe_name($name));
+ if (@l > 1) {
+ log::l("oops, more than one $name from probe: ", join(' ', @l));
+ }
+ $l[0];
+}
+
+sub stringlist {
+ my ($b_verbose) = @_;
map {
+ my $ids = $b_verbose || $_->{description} eq '(null)' ? sprintf("vendor:%04x device:%04x", $_->{vendor}, $_->{id}) : '';
+ my $subids = $_->{subid} && $_->{subid} != 0xffff ? sprintf("subv:%04x subd:%04x", $_->{subvendor}, $_->{subid}) : '';
sprintf("%-16s: %s%s%s",
- $_->{driver} ? $_->{driver} : 'unknown',
- $_->{description} eq '(null)' ? sprintf("Vendor=0x%04x Device=0x%04x", $_->{vendor}, $_->{id}) : $_->{description},
+ $_->{driver} || 'unknown',
+ $_->{description},
$_->{media_type} ? sprintf(" [%s]", $_->{media_type}) : '',
- $_->{subid} && $_->{subid} != 0xffff ? sprintf(" SubVendor=0x%04x SubDevice=0x%04x", $_->{subvendor}, $_->{subid}) : '',
+ $ids || $subids ? " ($ids" . ($ids && $subids && " ") . "$subids)" : '',
);
- } probeall(@_);
+ } probeall();
}
sub tryOpen($) {
- local *F;
- sysopen F, devices::make($_[0]), c::O_NONBLOCK() and *F;
+ my $F;
+ sysopen($F, devices::make($_[0]), c::O_NONBLOCK()) && $F;
}
sub tryWrite($) {
- local *F;
- sysopen F, devices::make($_[0]), 1 | c::O_NONBLOCK() and *F;
+ my $F;
+ sysopen($F, devices::make($_[0]), 1 | c::O_NONBLOCK()) && $F;
}
-sub syslog {
- -r "/tmp/syslog" and return map { /<\d+>(.*)/ } cat_("/tmp/syslog");
- `$ENV{LD_LOADER} /bin/dmesg`;
+my @dmesg;
+sub syslog() {
+ if (-r "/tmp/syslog") {
+ map { /<\d+>(.*)/ } cat_("/tmp/syslog");
+ } else {
+ @dmesg = `/bin/dmesg` if !@dmesg;
+ @dmesg;
+ }
}
sub get_mac_model() {
- my $mac_model = cat_("/proc/device-tree/model") || die "Can't open /proc/device-tree/model";
+ my $mac_model = cat_("/proc/device-tree/model") || die "Cannot open /proc/device-tree/model";
log::l("Mac model: $mac_model");
$mac_model;
}
sub get_mac_generation() {
- my $generation = cat_("/proc/cpuinfo") || die "Can't open /proc/cpuinfo";
- my @genarray = split(/\n/, $generation);
- my $count = 0;
- while ($count <= @genarray) {
- if ($genarray[$count] =~ /pmac-generation/) {
- @genarray = split(/:/, $genarray[$count]);
- return $genarray[1];
+ cat_('/proc/cpuinfo') =~ /^pmac-generation\s*:\s*(.*)/m ? $1 : "Unknown Generation";
+}
+
+sub hasSMP() {
+ return if $::testing;
+ (any { /NR_CPUS limit of 1 reached/ } syslog()) ||
+ (any { /^processor\s*:\s*(\d+)/ && $1 > 0 } cat_('/proc/cpuinfo')) ||
+ any { /\bProcessor #(\d+)\s+(\S*)/ && $1 > 0 && $2 ne 'invalid' } syslog();
+}
+sub hasPCMCIA() { $::o->{pcmcia} }
+
+my (@dmis, $dmidecode_already_runned);
+
+=item dmidecode()
+
+Return list of DMI categories from DMI table
+
+=cut
+# we return a list b/c several DMIs have the same name:
+sub dmidecode() {
+ return @dmis if $dmidecode_already_runned;
+
+ return if $>;
+ my ($_ver, @l) = arch() =~ /86/ ? run_program::get_stdout('dmidecode') : ();
+
+ #- drop header
+ shift @l while @l && $l[0] ne "\n";
+
+ foreach (@l) {
+ next if /TRUNCATED/;
+ if (/^\t(.*)/) {
+ $dmis[-1]{string} .= "$1\n";
+ $dmis[-1]{$1} = $2 if /^\t(.*): (.*)$/;
+ } elsif (my ($s) = /^(.*)/) {
+ next if $s =~ /^$/ || $s =~ /\bDMI type \d+/;
+ $s =~ s/ Information$//;
+ push @dmis, { name => $s };
}
- $count++;
}
- return "Unknown Generation";
+ $dmidecode_already_runned = 1;
+ @dmis;
}
-sub hasSMP { c::detectSMP() }
-sub hasPCMCIA { $::o->{pcmcia} } #- because /proc/pcmcia seems not to be present on 2.4 at least (or use /var/run/stab)
+=item dmi_detect_memory($category)
+
+Return only one category from DMI table
-#- 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 {
- hasPCMCIA() || (matching_desc('C&T.*655[45]\d') || matching_desc('C&T.*68554') ||
- matching_desc('Neomagic.*Magic(Media|Graph)') ||
- matching_desc('ViRGE.MX') || matching_desc('S3.*Savage.*[IM]X') ||
- matching_desc('ATI.*(Mobility|LT)'));
+=cut
+
+sub dmidecode_category {
+ my ($cat) = @_;
+ my @l = grep { $_->{name} eq $cat } dmidecode();
+ wantarray() ? @l : $l[0] || {};
}
-sub hasUltra66 {
- die "hasUltra66 deprecated";
- #- keep it BUT DO NOT USE IT as now included in kernel.
- cat_("/proc/cmdline") =~ /(ide2=(\S+)(\s+ide3=(\S+))?)/ and return $1;
+=item dmi_detect_memory()
+
+Return RAM size in MB according to DMI table
- 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 ?
- (map_index { hex($_) + (odd($::i) ? 1 : -1) } map { (split ' ')[3..4] } @l) :
- (map_index { hex($_) + (odd($::i) ? 1 : -1) } map { (split ' ')[3..6] } @l);
+=cut
- log::l("HPT|Ultra66: found $ide");
- $ide;
+sub dmi_detect_memory() {
+ my @l1 = map { $_->{'Enabled Size'} =~ /(\d+) MB/ && $1 } dmidecode_category('Memory Module');
+ my @l2 = map { $_->{'Form Factor'} =~ /^(SIMM|SIP|DIP|DIMM|FB-DIMM|RIMM|SODIMM|SRIMM)$/ &&
+ ($_->{Size} =~ /(\d+) MB/ && $1 || $_->{Size} =~ /(\d+) kB/ && $1 * 1024);
+ } dmidecode_category('Memory Device');
+ max(sum(@l1), sum(@l2));
}
-sub whatParport() {
- my @res;
- foreach (0..3) {
- my $elem = {};
- local *F;
- open F, "/proc/parport/$_/autoprobe" or open F, "/proc/sys/dev/parport/parport$_/autoprobe" or next;
- {
- local $_;
- while (<F>) {
- if (/(.*):(.*);/) { #-#
- $elem->{$1} = $2;
- $elem->{$1} =~ s/Hewlett[-\s_]Packard/HP/;
- $elem->{$1} =~ s/HEWLETT[-\s_]PACKARD/HP/;
- }
- }
- }
- push @res, { port => "/dev/lp$_", val => $elem };
- }
- @res;
+=back
+
+=head1 Test helpers
+
+=over
+
+=item computer_info()
+
+Analyse "Chassis" & "Bios" in dmidecode output and return a hash of flags/values (isLaptop, isServer, BIOS_Year)
+
+=cut
+
+sub computer_info() {
+ my $Chassis = dmidecode_category('Chassis')->{Type} =~ /(\S+)/ && $1;
+
+ my $date = dmidecode_category('BIOS')->{'Release Date'} || '';
+ my $BIOS_Year = $date =~ m!(\d{4})! && $1 ||
+ $date =~ m!\d\d/\d\d/(\d\d)! && "20$1";
+
+ +{
+ isLaptop => member($Chassis, 'Portable', 'Laptop', 'Notebook', 'Hand Held', 'Sub Notebook', 'Docking Station'),
+ isServer => member($Chassis, 'Pizza Box', 'Main Server Chassis', 'Rack Mount Chassis', 'Blade'),
+ if_($BIOS_Year, BIOS_Year => $BIOS_Year),
+ };
}
-sub usbMice { grep { $_->{media_type} =~ /\|Mouse/ && $_->{driver} !~ /Tablet:wacom/ ||
- $_->{driver} =~ /Mouse:USB/ } usb_probe() }
-sub usbWacom { grep { $_->{driver} =~ /Tablet:wacom/ } usb_probe() }
-sub usbKeyboards { grep { $_->{media_type} =~ /\|Keyboard/ } usb_probe() }
-sub usbStorage { grep { $_->{media_type} =~ /Mass Storage\|/ } usb_probe() }
+=item isLaptop()
-sub usbKeyboard2country_code {
- my ($usb_kbd) = @_;
- local *F;
- my $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);
+try to detect a laptop. We assume the following is an indication of a laptop:
+
+=over 4
+
+=item *
+
+pcmcia service
+
+=item *
+
+C<computer_info()> (really C<dmidecode>) telling us it's a laptop
+
+=item *
+
+ACPI lid button
+
+=item *
+
+a regexp to match graphics card apparently only used for such systems.
+
+=item *
+
+Mobility CPU
+
+=item *
+
+having Type as Laptop in some device
+
+=item *
+
+Intel ipw2100/2200/3945 Wireless
+
+=back
+
+=cut
+
+sub isLaptop() {
+ computer_info()->{isLaptop}
+ || glob_("/sys/bus/acpi/devices/PNP0C0D:*") #- ACPI lid button
+ || (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('Intel Corporation\|Mobile') ||
+ matching_desc__regexp('\bATI\b.*(Mobility|\bLT\b)'))
+ || (any { $_->{'model name'} =~ /\b(mobile|C7-M)\b/i } getCPUs())
+ || probe_unique_name("Type") eq 'laptop'
+ #- ipw2100/2200/3945 are Mini-PCI (Express) adapters
+ || (any { member($_->{driver}, qw(ipw2100 ipw2200 ipw3945)) } pci_probe());
}
-sub whatUsbport() {
- # The printer manufacturer and model names obtained with the usb_probe()
- # function were very messy, once there was a lot of noise around the
- # manufacturers name ("Inc.", "SA", "International", ...) and second,
- # all Epson inkjets answered with the name "Epson Stylus Color 760" which
- # lead many newbies to install their Epson Stylus Photo XXX as an Epson
- # Stylus Color 760 ...
- #
- # This routine based on an ioctl request gives very clean and correct
- # manufacturer and model names, so that they are easily matched to the
- # printer entries in the Foomatic database
- my $i;
- my @res;
- foreach $i (0..15) {
- my $port = "/dev/usb/lp$i";
- my $realport = devices::make($port);
- next if (!$realport);
- next if (! -r $realport);
- open PORT, $realport or do next;
- my $idstr = "";
- # Calculation of IOCTL function 0x84005001 (to get device ID
- # string):
- # len = 1024
- # IOCNR_GET_DEVICE_ID = 1
- # LPIOC_GET_DEVICE_ID(len) =
- # _IOC(_IOC_READ, 'P', IOCNR_GET_DEVICE_ID, len)
- # _IOC(), _IOC_READ as defined in /usr/include/asm/ioctl.h
- # Use "eval" so that program does not stop when IOCTL fails
- eval {
- my $output = "\0" x 1024;
- ioctl(PORT, 0x84005001, $output);
- $idstr = $output;
- } or do {
- close PORT;
- next;
- };
- close PORT;
- # Remove non-printable characters
- $idstr =~ tr/[\x00-\x1f]/\./;
- # Extract the printer data from the ID string
- my ($manufacturer, $model, $serialnumber, $description) =
- ("", "", "", "");
- if (($idstr =~ /MFG:([^;]+);/) ||
- ($idstr =~ /MANUFACTURER:([^;]+);/)) {
- $manufacturer = $1;
- $manufacturer =~ s/Hewlett[-\s_]Packard/HP/;
- $manufacturer =~ s/HEWLETT[-\s_]PACKARD/HP/;
- }
- if (($idstr =~ /MDL:([^;]+);/) ||
- ($idstr =~ /MODEL:([^;]+);/)) {
- $model = $1;
- }
- if (($idstr =~ /DES:([^;]+);/) ||
- ($idstr =~ /DESCRIPTION:([^;]+);/)) {
- $description = $1;
- $description =~ s/Hewlett[-\s_]Packard/HP/;
- $description =~ s/HEWLETT[-\s_]PACKARD/HP/;
- }
- if ($idstr =~ /SE*R*N:([^;]+);/) {
- $serialnumber = $1;
- }
- # Was there a manufacturer and a model in the string?
- if (($manufacturer eq "") || ($model eq "")) {
- next;
- }
- # No description field? Make one out of manufacturer and model.
- if ($description eq "") {
- $description = "$manufacturer $model";
- }
- # Store this auto-detection result in the data structure
- push @res, { port => $port, val =>
- { CLASS => 'PRINTER',
- MODEL => $model,
- MANUFACTURER => $manufacturer,
- DESCRIPTION => $description,
- SERIALNUMBER => $serialnumber
- }};
- }
- @res;
-}
-
-sub getSNMPModel {
-
- my ($host) = @_;
- my $manufacturer = "";
- my $model = "";
- my $description = "";
- my $serialnumber = "";
-
- # SNMP request to auto-detect model
- local *F;
- open F, "scli -1 -c \"show printer info\" $host |" ||
- return { CLASS => 'PRINTER',
- MODEL => _("Unknown Model"),
- MANUFACTURER => "",
- DESCRIPTION => "",
- SERIALNUMBER => ""
- };
- while (my $l = <F>) {
- chomp $l;
- if (($l =~ /^\s*Manufacturer:\s*(\S.*)$/i) &&
- ($l =~ /^\s*Vendor:\s*(\S.*)$/i)) {
- $manufacturer = $1;
- $manufacturer =~ s/Hewlett[-\s_]Packard/HP/;
- $manufacturer =~ s/HEWLETT[-\s_]PACKARD/HP/;
- } elsif ($l =~ /^\s*Model:\s*(\S.*)$/i) {
- $model = $1;
- } elsif ($l =~ /^\s*Description:\s*(\S.*)$/i) {
- $description = $1;
- $description =~ s/Hewlett[-\s_]Packard/HP/;
- $description =~ s/HEWLETT[-\s_]PACKARD/HP/;
- } elsif ($l =~ /^\s*Serial\s*Number:\s*(\S.*)$/i) {
- $serialnumber = $1;
- }
- }
- close F;
+=item isServer()
- # Was there a manufacturer and a model in the output?
- # If not, get them from the description
- if (($manufacturer eq "") || ($model eq "")) {
- if ($description =~ /^\s*(\S*)\s+(\S.*)$/) {
- if ($manufacturer eq "") {
- $manufacturer = $1;
- }
- if ($model eq "") {
- $model = $2;
- }
- }
- # No description field? Make one out of manufacturer and model.
- } elsif ($description eq "") {
- $description = "$manufacturer $model";
- }
-
- # We couldn't determine a model
- if ($model eq "") {
- $model = _("Unknown Model");
- }
-
- # Remove trailing spaces
- $manufacturer =~ s/(\S+)\s+$/$1/;
- $model =~ s/(\S+)\s+$/$1/;
- $description =~ s/(\S+)\s+$/$1/;
- $serialnumber =~ s/(\S+)\s+$/$1/;
-
- # Now we have all info for one printer
- # Store this auto-detection result in the data structure
- return { CLASS => 'PRINTER',
- MODEL => $model,
- MANUFACTURER => $manufacturer,
- DESCRIPTION => $description,
- SERIALNUMBER => $serialnumber
- };
-}
-
-sub getSMBPrinterShares {
-
- my ($host) = @_;
-
- # SMB request to auto-detect shares
- local *F;
- open F, "export LC_ALL=\"C\"; smbclient -N -L $host |" || return ();
- my $insharelist = 0;
- my @shares;
- while (my $l = <F>) {
- chomp $l;
- if ($l =~ /^\s*Sharename\s+Type\s+Comment\s*$/i) {
- $insharelist = 1;
- } elsif ($l =~ /^\s*Server\s+Comment\s*$/i) {
- $insharelist = 0;
- } elsif (($l =~ /^\s*(\S+)\s+Printer\s*(.*)$/i) &&
- ($insharelist)) {
- my $name = $1;
- my $description = $2;
- $description =~ s/^(\s*)//;
- push (@shares, { name => $name, description => $description });
- }
- }
- close F;
+Is it a server?
+
+=cut
- return @shares;
+sub isServer() {
+ computer_info()->{isServer}
+ || (any { $_->{Type} =~ /ECC/ } dmidecode_category('Memory Module'))
+ || dmidecode_category('System Information')->{Manufacturer} =~ /Supermicro/i
+ || dmidecode_category('System Information')->{'Product Name'} =~ /NetServer|Proliant|PowerEdge|eServer|IBM System x|ThinkServer/i
+ || matching_desc__regexp('LSI Logic.*SCSI')
+ || matching_desc__regexp('MegaRAID')
+ || matching_desc__regexp('NetServer')
+ || (any { $_->{'model name'} =~ /(Xeon|Opteron)/i } getCPUs());
}
-sub getIPsInLocalNetworks {
+sub BIGMEM() {
+ arch() !~ /x86_64/ && $> == 0 && dmi_detect_memory() > 4 * 1024;
+}
- # subroutine determines the list of all hosts reachable in the local
- # networks by means of pinging the broadcast addresses.
-
- # Read the output of "ifconfig" to determine the broadcast addresses of
- # the local networks
- my $dev_is_localnet = 0;
- my @local_bcasts;
- my $current_bcast = "";
-
- local *IFCONFIG_OUT;
- open IFCONFIG_OUT, "export LC_ALL=C; ifconfig |" or return ();
- while (my $readline = <IFCONFIG_OUT>) {
- # New entry ...
- if ($readline =~ /^(\S+)\s/) {
- my $dev = $1;
- # ... for a local network (eth = ethernet,
- # vmnet = VMWare,
- # ethernet card connected to ISP excluded)?
- $dev_is_localnet = (($dev =~ /^eth/) || ($dev =~ /^vmnet/));
- # delete previous address
- $current_bcast = "";
- }
- # Are we in the important line now?
- if ($readline =~ /\sBcast:([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)\s/) {
- # Rip out the broadcast IP address
- $current_bcast = $1;
-
- # Are we in an entry for a local network?
- if ($dev_is_localnet == 1) {
- # Store current IP address
- push @local_bcasts, $current_bcast;
- }
- }
- }
- close(IFCONFIG_OUT);
-
- my @addresses;
- # Now ping all broadcast addresses
- for my $bcast (@local_bcasts) {
- local *F;
- open F, "export LC_ALL=C; ping -w 1 -b -n $bcast | cut -f 4 -d \" \" | sed s/:// | egrep \"^[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\" | uniq |" or next;
- while (<F>) { chomp; push @addresses, $_ }
- close F;
- }
-
- @addresses;
-}
-
-sub whatNetPrinter {
-
- my ($network, $smb) = @_;
-
- my $i;
- my @res;
-
- # Which ports should be scanned?
- my @portstoscan;
- if ($smb) {
- push @portstoscan, "139";
- }
- if ($network) {
- push @portstoscan, "4010", "4020", "4030", "5503", "9100-9104";
- }
- return () if $#portstoscan < 0;
- my $portlist = join (",", @portstoscan);
-
- # Which hosts should be scanned?
- # (Applying nmap to a whole network is very time-consuming, because nmap
- # waits for a certain timeout period on non-existing hosts, so we get a
- # lists of existing hosts by pinging the broadcast addresses for existing
- # hosts and then scanning only them, which is much faster)
- my @hostips = getIPsInLocalNetworks();
- return () if $#hostips < 0;
- my $hostlist = join (" ", @hostips);
-
- # Scan network for printers
- local *F;
- open F, "export LC_ALL=\"C\"; nmap -p $portlist $hostlist |" ||
- return @res;
- my $host = "";
- my $ip = "";
- my $port = "";
- my $modelinfo = "";
- while (my $line = <F>) {
- chomp $line;
-
- # head line of the report of a host with the ports in question open
- #if ($line =~ m/^\s*Interesting\s+ports\s+on\s+(\S*)\s*\(([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)\)\s*:\s*$/i) {
- if ($line =~ m/^\s*Interesting\s+ports\s+on\s+(\S*)\s*\((\S+)\)\s*:\s*$/i) {
- $host = $1;
- $ip = $2;
- if ($host eq "") {
- $host = $ip;
- }
- $port = "";
-
- undef $modelinfo;
-
- } elsif ($line =~ m/^\s*(\d+)\/\S+\s+open\s+/i) {
- next if ($ip eq "");
- $port = $1;
-
- # Now we have all info for one printer
- # Store this auto-detection result in the data structure
-
- # Determine the protocol by the port number
-
- # SMB/Windows
- if ($port eq "139") {
- my @shares = getSMBPrinterShares($ip);
- for my $share (@shares) {
- push @res, { port => "smb://$host/$share->{name}",
- val => { CLASS => 'PRINTER',
- MODEL => _("Unknown Model"),
- MANUFACTURER => "",
- DESCRIPTION =>
- "$share->{description}",
- SERIALNUMBER => ""
- }
- };
- }
- } else {
- if (!defined($modelinfo)) {
- # SNMP request to auto-detect model
- $modelinfo = getSNMPModel ($ip);
- }
- if (defined($modelinfo)) {
- push @res, { port => "socket://$host:$port",
- val => $modelinfo
- };
- }
- }
- }
+sub is_arm_openrd_client() {
+ to_bool(cat_('/proc/cpuinfo') =~ /OpenRD Client/);
+}
+
+sub is_arm_versatile() {
+ to_bool(cat_('/proc/cpuinfo') =~ /ARM-Versatile/);
+}
+
+sub is_arm_efikamix() {
+ to_bool(cat_('/proc/cpuinfo') =~ /Efika MX/);
+}
+
+sub is_xbox() {
+ any { $_->{vendor} == 0x10de && $_->{id} == 0x02a5 } pci_probe();
+}
+
+=item virt_technology()
+
+Returns the virtualization technology (eg: kvm, oracle, ...)
+
+=cut
+
+sub virt_technology() {
+ state $tech;
+ $tech ||= chomp_(run_program::get_stdout('systemd-detect-virt'));
+}
+
+=item is_hyperv()
+
+Are we running under Hyper-V hypervisor?
+
+=cut
+
+sub is_hyperv() {
+ virt_technology() eq 'microsoft';
+}
+
+=item is_qemu()
+
+Are we running under Qemu hypervisor?
+
+=cut
+
+sub is_qemu() {
+ member(virt_technology(), qw(kvm qemu));
+}
+
+=item is_virtualbox()
+
+Are we running under VirtualBox hypervisor?
+
+=cut
+
+sub is_virtualbox() {
+ virt_technology() eq 'oracle';
+}
+
+=item is_vmware()
+
+Are we running under VMware hypervisor?
+
+=cut
+
+sub is_vmware() {
+ virt_technology() eq 'vmware';
+}
+
+=item is_netbook_nettop()
+
+Is it a NetBook?
+
+=cut
+
+sub is_netbook_nettop() {
+ my @cpus = getCPUs();
+ (any { $_->{'model name'} =~ /(\bIntel\(R\) Atom\(TM\)\B)/i } @cpus) ||
+ (any { $_->{'model name'} =~ /(\bIntel\(R\) Celeron\(R\) M processor\b|\bVIA C7-M Processor\b|\bGeode\(TM\)\B)/i && $_->{'cpu MHz'} < 1500 } @cpus);
+}
+
+=item has_low_resources()
+
+Is it a low resource machine?
+
+=cut
+
+sub has_low_resources() {
+ availableRamMB() < 100 || arch() =~ /i.86/ && ix86_cpu_frequency() < 350;
+}
+
+=item need_light_desktop()
+
+Does it need a light desktop (netbook or low resources machine)?
+
+=cut
+
+sub need_light_desktop() {
+ has_low_resources() || is_netbook_nettop();
+}
+
+=item has_cpu_flag($flag)
+
+Does CPU has this flag
+
+=cut
+
+sub has_cpu_flag {
+ my ($flag) = @_;
+ cat_('/proc/cpuinfo') =~ /^flags.*\b$flag\b/m;
+}
+
+=item sub matching_types()
+
+Returns a hash of flags (laptop, hyperv, touchpad, 64bit, wireless, ...)
+
+=cut
+
+sub matching_types() {
+ +{
+ '64bit' => to_bool(arch() =~ /64/),
+ hyperv => is_hyperv(),
+ laptop => isLaptop(),
+ numpad => hasNumpad(),
+ touchpad => hasTouchpad(),
+ qemu => is_qemu(),
+ virtualbox => is_virtualbox(),
+ vmware => is_vmware(),
+ wireless => to_bool(get_wireless_interface() || probe_category('network/wireless')),
+ };
+}
+
+=item sub hasCPUMicrocode()
+
+Does CPU need microcode updates?
+
+=cut
+
+sub hasCPUMicrocode() {
+ state $hasCPUMicrocode;
+ if (!defined $hasCPUMicrocode) {
+ $hasCPUMicrocode = to_bool(find { 'microcode' } modules::loaded_modules());
}
- close F;
- @res;
+ return $hasCPUMicrocode;
}
-#-CLASS:PRINTER;
-#-MODEL:HP LaserJet 1100;
-#-MANUFACTURER:Hewlett-Packard;
-#-DESCRIPTION:HP LaserJet 1100 Printer;
-#-COMMAND SET:MLC,PCL,PJL;
-sub whatPrinter {
- my ($local, $network, $smb) = @_;
- my @res = (($local ? (whatParport(), whatUsbport()) : ()),
- ($network || $smb ? whatNetPrinter($network,$smb) : ()));
- grep { $_->{val}{CLASS} eq "PRINTER"} @res;
+=item sub hasCPUFreq()
+
+Does CPU support cpufreq?
+
+=cut
+
+sub hasCPUFreq() {
+ require cpufreq;
+ to_bool(cpufreq::get_modules())
+ || cat_('/proc/cpuinfo') =~ /AuthenticAMD/ && arch() =~ /x86_64/
+ || cat_('/proc/cpuinfo') =~ /model name.*Intel\(R\) Core\(TM\)2 CPU/;
}
-sub whatPrinterPort() {
- grep { tryWrite($_) } qw(/dev/lp0 /dev/lp1 /dev/lp2 /dev/usb/lp0 /dev/usb/lp1 /dev/usb/lp2 /dev/usb/lp3 /dev/usb/lp4 /dev/usb/lp5 /dev/usb/lp6 /dev/usb/lp7 /dev/usb/lp8 /dev/usb/lp9);
+=item sub hasWacom()
+
+is there a Wacom tablet?
+
+=cut
+
+sub hasWacom() { find { $_->{vendor} == 0x056a || $_->{driver} =~ /wacom/ } usb_probe() }
+
+=item sub hasTouchpad()
+
+is there a touchpad?
+
+=cut
+
+sub hasTouchpad() { any { $_->{Synaptics} || $_->{ALPS} || $_->{Elantech} } getInputDevices() }
+
+=item sub hasNumpad()
+
+is there a numeric pad?
+
+=cut
+
+sub hasNumpad() { any { $_->{Numpad} } getInputDevices() }
+
+sub usbWacom() { grep { $_->{vendor} eq '056a' } getInputDevices() }
+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);
+ # FIXME: usbfs is dead! we should poke somewhere in /sys/ !!!!
+ 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 {
- #- make sure the device are created before probing.
- foreach (0..3) { devices::make("/dev/ttyS$_") }
+sub probeSerialDevices() {
+ require list_modules;
+ require modules;
+ modules::append_to_modules_loaded_at_startup_for_all_kernels(modules::load_category($::o->{modules_conf}, 'various/serial'));
+ 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.
- -d "/var/lock" or mkdir "/var/lock", 0755;
+ 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 :-)
- local *F; open F, "$ENV{LD_LOADER} serial_probe |";
- local $_;
- my %current; while (<F>) {
- $serialprobe{$current{DEVICE}} = { %current } and %current = () if /^\s*$/ && $current{DEVICE};
- $current{$1} = $2 if /^([^=]+)=(.*?)\s*$/;
+ my %current;
+ foreach (run_program::get_stdout('serial_probe')) {
+ if (/^\s*$/) {
+ $serialprobe{$current{DEVICE}} = { %current } if $current{DEVICE};
+ %current = ();
+ } elsif (/^([^=]+)=(.*?)\s*$/) {
+ $current{$1} = $2;
+ }
}
- close F;
foreach (values %serialprobe) {
$_->{DESCRIPTION} =~ /modem/i and $_->{CLASS} = 'MODEM'; #- hack to make sure a modem is detected.
@@ -873,50 +1688,82 @@ sub probeSerialDevices {
sub probeSerial($) { $serialprobe{$_[0]} }
sub hasModem($) {
- $serialprobe{$_[0]} and $serialprobe{$_[0]}{CLASS} eq 'MODEM' and $serialprobe{$_[0]}{DESCRIPTION};
+ $serialprobe{$_[0]} && $serialprobe{$_[0]}{CLASS} eq 'MODEM' && $serialprobe{$_[0]}{DESCRIPTION};
}
sub hasMousePS2 {
my $t; sysread(tryOpen($_[0]) || return, $t, 256) != 1 || $t ne "\xFE";
}
-sub raidAutoStartIoctl {
- local *F;
- sysopen F, devices::make("md0"), 2 or return;
- ioctl F, 2324, 0;
+sub probeall_unavailable_modules() {
+ map {
+ my $driver = $_->{driver};
+ $driver !~ /:/ &&
+ !member($driver, 'hub', 'unknown', 'amd64_agp') &&
+ !modules::module_is_available($driver) ?
+ $driver :
+ @{[]};
+ } probeall();
}
-sub raidAutoStartRaidtab {
- my (@parts) = @_;
- require raid;
- #- faking a raidtab, it seems to be working :-)))
- #- (choosing any inactive md)
- raid::inactivate_all();
- foreach (@parts) {
- my ($nb) = grep { !raid::is_active("md$_") } 0..7;
- output("/etc/raidtab", "raiddev /dev/md$nb\n device " . devices::make($_->{device}) . "\n");
- run_program::run('raidstart', devices::make("md$nb"));
- }
+sub probeall_dkms_modules() {
+ my @unavailable_modules = probeall_unavailable_modules() or return;
+ require modalias;
+ my $dkms_modules = modalias::parse_file_modules($::prefix . "/usr/share/ldetect-lst/dkms-modules.alias");
+ intersection([ keys(%$dkms_modules) ], \@unavailable_modules);
}
-sub raidAutoStart {
- my (@parts) = @_;
+sub usb_description2removable {
+ local ($_) = @_;
+ return 'camera' if /\bcamera\b/i;
+ return 'memory_card' if /\bmemory\s?stick\b/i || /\bcompact\s?flash\b/i || /\bsmart\s?media\b/i;
+ return 'memory_card' if /DiskOnKey/i || /IBM-DMDM/i;
+ return 'zip' if /\bzip\s?(100|250|750)/i;
+ return 'floppy' if /\bLS-?120\b/i;
+ return;
+}
+
+sub usb2removable {
+ my ($e) = @_;
+ $e->{usb_driver} or return;
- log::l("raidAutoStart");
- eval { modules::load('md') };
- my %personalities = ('1' => 'linear', '2' => 'raid0', '3' => 'raid1', '4' => 'raid5');
- raidAutoStartIoctl() or raidAutoStartRaidtab(@parts);
- if (my @needed_perso = map {
- if_(/^kmod: failed.*md-personality-(.)/ ||
- /^md: personality (.) is not loaded/, $personalities{$1}) } syslog()) {
- eval { modules::load(@needed_perso) };
- raidAutoStartIoctl() or raidAutoStartRaidtab(@parts);
+ if ($e->{usb_driver} =~ /Removable:(.*)/) {
+ return $1;
+ } elsif (my $name = usb_description2removable($e->{usb_description})) {
+ return $name;
}
+ undef;
}
-sub is_a_recent_computer {
- my ($frequence) = map { /cpu MHz\s*:\s*(.*)/ } cat_("/proc/cpuinfo");
- $frequence > 600;
+sub suggest_mount_point {
+ my ($e) = @_;
+
+ my $name = $e->{media_type};
+ if (member($e->{media_type}, 'hd', 'fd')) {
+ if (exists $e->{usb_driver}) {
+ $name = usb2removable($e) || 'removable';
+ } elsif (isZipDrive($e)) {
+ $name = 'zip';
+ } elsif ($e->{media_type} eq 'fd') {
+ $name = 'floppy';
+ } else {
+ log::l("suggest_mount_point: do not know what to with hd $e->{device}");
+ }
+ }
+ $name;
}
+=back
+
+=head1 SEE ALSO
+
+See L<hardware_detection> for the overall view.
+
+=cut
+
1;
+
+#- Local Variables:
+#- mode:cperl
+#- tab-width:8
+#- End:
generated by cgit v1.2.1 (git 2.21.0) at 2025-10-23 22:33:24 +0000