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.pm682
1 files changed, 577 insertions, 105 deletions
diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm
index 0057ec937..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;
@@ -16,6 +16,39 @@ 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
#-#####################################################################################
@@ -25,6 +58,14 @@ my %serialprobe;
#- Functions
#-######################################################################################
+=over
+
+=item get()
+
+Returns a list of all block devices (IDE, SCSI, SATA, virtual, RAID, ...)
+
+=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
@@ -33,7 +74,7 @@ sub get() {
#- 2. The first SCSI device if SCSI exists. Or
#- 3. The first RAID device if RAID exists.
- getIDE(), getSCSI(), getVirtIO(), getDAC960(), getCompaqSmartArray(), getATARAID();
+ getIDE(), getSCSI(), getMmcBlk(), getNVMe(), getXenBlk(), getVirtIO(), getDAC960(), getCompaqSmartArray();
}
sub hds() { grep { may_be_a_hd($_) } get() }
sub tapes() { grep { $_->{media_type} eq 'tape' } get() }
@@ -54,16 +95,22 @@ sub floppies {
require modules;
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;
- eval { modules::load("floppy") if $::isInstall };
+ 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(devices::make("fd$_"));
+ my $info = c::floppy_info("/dev/fd$_");
if_($info && $info ne '(null)', { device => "fd$_", media_type => 'fd', info => $info });
} qw(0 1);
}
@@ -121,7 +168,8 @@ sub complete_usb_storage_info {
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) {
- $e->{info} = chomp_(cat_("/sys/block/$host/../serial"));
+ 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")));
@@ -186,6 +234,12 @@ sub get_scsi_driver {
}
}
+=item getSCSI()
+
+Returns a list of all SCSI device.
+
+=cut
+
sub getSCSI() {
my $dev_dir = '/sys/bus/scsi/devices';
@@ -217,7 +271,7 @@ sub getSCSI() {
}
warn("cannot get info for device ($_)"), next if !$device;
- my $usb_dir = readlink("$dir") =~ m!/usb! && "$dir/../../../..";
+ my $usb_dir = readlink($dir) =~ m!/usb! && "$dir/../../../..";
my $get_usb = sub { chomp_(cat_("$usb_dir/$_[0]")) };
my $get = sub {
@@ -226,15 +280,20 @@ sub getSCSI() {
$s;
};
- # Old hp scanners report themselves as "Processor"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';
- push @l, { info => $get->('vendor') . ' ' . $get->('model'), host => $host, channel => $channel, id => $id, lun => $lun,
- description => join('|', $get->('vendor'), $get->('model')),
+ 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')),
@@ -256,13 +315,15 @@ sub getSCSI() {
}
-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.",
@@ -283,6 +344,21 @@ my %eide_hds = (
"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;
@@ -292,15 +368,12 @@ 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 $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 ($vendor, $model) = _get_hd_vendor($info);
my $host = $num;
($host, my $id) = divide($host, 2);
@@ -320,13 +393,17 @@ sub block_devices() {
: 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++) {
my @raw_devices = cat_($f) =~ m|^\s*($name/.*?):|gm;
@@ -360,16 +437,26 @@ 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");
- }
- values %l;
+=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 {
@@ -378,14 +465,27 @@ sub getVirtIO() {
glob("/sys/bus/virtio/devices/*/block/*");
}
-# cpu_name : arch() =~ /^alpha/ ? "cpu " :
-# arch() =~ /^ppc/ ? "processor" : "vendor_id"
+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()
-# cpu_model : arch() =~ /^alpha/ ? "cpu model" :
-# arch() =~ /^ppc/ ? "cpu " : "model name"
+Returns a list of all CPUs.
-# cpu_freq = arch() =~ /^alpha/ ? "cycle frequency [Hz]" :
-# arch() =~ /^ppc/ ? "clock" : "cpu MHz"
+=cut
sub getCPUs() {
my (@cpus, $cpu);
@@ -405,15 +505,20 @@ sub ix86_cpu_frequency() {
cat_('/proc/cpuinfo') =~ /cpu MHz\s*:\s*(\d+)/ && $1;
}
+=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);
- if_($category =~ /sound/ && arch() =~ /ppc/ && get_mac_model() !~ /IBM/,
- { driver => 'snd_powermac', description => 'Macintosh built-in' },
- ),
grep {
if ($category eq 'network/isdn') {
my $b = $_->{driver} =~ /ISDN:([^,]*),?([^,]*)(?:,firmware=(.*))?/;
@@ -440,7 +545,10 @@ 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 = {};
@@ -492,14 +600,25 @@ sub getInputDevices() {
#- 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=(.*)/) {
@@ -522,15 +641,23 @@ sub getInputDevices() {
#- 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
- my $KEY = hex($1);
- $device->{SIDE} = 1 if $KEY & (1 << 0x13);
+ 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;
}
}
- @devices;
+ @input_devices = @devices;
}
sub getInputDevices_and_usb() {
@@ -550,11 +677,20 @@ sub serialPort2text {
$_[0] =~ /ttyS(\d+)/ ? "$_[0] / COM" . ($1 + 1) : $_[0];
}
+=back
+
+=head1 Network
+
+=over
+
+=cut
+
sub getSerialModem {
- my ($modules_conf, $o_mouse) = @_;
+ my ($_modules_conf, $o_mouse) = @_;
my $mouse = $o_mouse || {};
$mouse->{device} = readlink "/dev/mouse";
- my $serdev = arch() =~ /ppc/ ? "macserial" : "serial";
+ my $serdev = "serial";
+
eval { modules::load($serdev) };
my @modems;
@@ -569,13 +705,16 @@ sub getSerialModem {
}
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) { $_->{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) = @_;
@@ -624,6 +763,12 @@ sub getECI() {
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;
@@ -635,6 +780,12 @@ sub get_xdsl_usb_devices() {
@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...
@@ -649,6 +800,12 @@ sub is_lan_interface {
$_[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)
@@ -657,6 +814,12 @@ sub is_useful_interface {
$_[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
@@ -664,9 +827,17 @@ sub is_wireless_interface {
#- 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";
+ 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
@@ -677,22 +848,56 @@ sub get_all_net_devices() {
);
}
+=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, "bus");
+ my $bus = get_sysfs_field_from_link($dev_path, "subsystem");
#- FIXME: use $bus
if ($is_pcmcia) {
$sysfs_ids = { modalias => $dev_cat->('modalias') };
@@ -710,7 +915,7 @@ sub get_ids_from_sysfs_device {
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{qw(pci_domain pci_bus pci_device pci_function)} = map { hex($_) } @ids if @ids;
}
}
$sysfs_ids;
@@ -726,10 +931,6 @@ sub device_matches_sysfs_device {
device_matches_sysfs_ids($device, get_ids_from_sysfs_device($dev_path));
}
-#sub getISDN() {
-# mapgrep(sub {member (($_[0] =~ /\s*(\w*):/), @netdevices), $1 }, split(/\n/, cat_("/proc/net/dev")));
-#}
-
sub getUPS() {
# MGE serial PnP devices:
(map {
@@ -744,7 +945,7 @@ sub getUPS() {
# USB UPSs;
(map { ($_->{name} = $_->{description}) =~ s/.*\|//; $_ }
map {
- if ($_->{description} =~ /^American Power Conversion\|Back-UPS/ && $_->{driver} eq 'usbhid') {
+ 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";
@@ -811,14 +1012,19 @@ my (@pci, @usb);
sub pci_probe__real() {
add_addons($pcitable_addons, map {
- my %l;
- @l{qw(vendor id subvendor subid pci_domain pci_bus pci_device pci_function pci_revision is_pciexpress media_type nice_media_type driver description)} = split "\t";
- $l{$_} = hex $l{$_} foreach qw(vendor id subvendor subid);
- $l{bus} = 'PCI';
- $l{sysfs_device} = '/sys/bus/pci/devices/' . get_pci_sysfs_path(\%l);
- \%l;
+ 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) {
@@ -831,18 +1037,23 @@ sub pci_probe() {
}
sub usb_probe__real() {
- -e "/proc/bus/usb/devices" or return;
+ -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{media_type} = join('|', grep { $_ ne '(null)' } split('\|', $l{media_type}));
- $l{$_} = hex $l{$_} foreach qw(vendor id);
- $l{sysfs_device} = "/sys/class/usb_device/usbdev$l{pci_bus}.$l{pci_device}/device";
- $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());
}
+
+=item usb_probe()
+
+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;
@@ -851,6 +1062,12 @@ sub usb_probe() {
}
}
+=item firewire_probe()
+
+Return list of Firewire controllers
+
+=cut
+
sub firewire_probe() {
my $dev_dir = '/sys/bus/ieee1394/devices';
my @l = map {
@@ -890,6 +1107,12 @@ sub firewire_probe() {
@l;
}
+=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/) {
@@ -899,6 +1122,12 @@ sub pcmcia_controller_probe() {
$controller;
}
+=item pcmcia_probe()
+
+Return list of PCMCIA devices (eg: Ethernet PCMCIA cards, ...)
+
+=cut
+
sub pcmcia_probe() {
require modalias;
require modules;
@@ -906,8 +1135,8 @@ sub pcmcia_probe() {
map {
my $dir = "$dev_dir/$_";
my $get = sub { chomp_(cat_("$dir/$_[0]")) };
- my $class_dev = first(glob_("$dir/tty*"));
- my $device = $class_dev && get_sysfs_field_from_link($dir, basename($class_dev));
+ 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
@@ -926,20 +1155,61 @@ sub pcmcia_probe() {
} all($dev_dir);
}
-my $dmi_probe;
+=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() {
- $dmi_probe ||= [ map {
- /(.*?)\t(.*)/ && { bus => 'DMI', driver => $1, description => $2 };
- } $> ? () : c::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
-# => probeall with $probe_type is unsafe
sub probeall() {
return if $::noauto;
- pci_probe(), usb_probe(), firewire_probe(), pcmcia_probe(), dmi_probe(), getInputDevices_and_usb();
+ pci_probe(), usb_probe(), firewire_probe(), pcmcia_probe(), dmi_probe(), acpi_probe(), getInputDevices_and_usb();
}
sub probeall_update_cache() {
return if $::noauto;
@@ -1006,7 +1276,7 @@ sub syslog() {
}
sub get_mac_model() {
- my $mac_model = cat_("/proc/device-tree/model") || die "Can not 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;
}
@@ -1021,33 +1291,31 @@ sub hasSMP() {
(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} } #- because /proc/pcmcia seems not to be present on 2.4 at least (or use /var/run/stab)
+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) = run_program::get_stdout('dmidecode');
-
- my $tab = "\t";
+ my ($_ver, @l) = arch() =~ /86/ ? run_program::get_stdout('dmidecode') : ();
- my ($major, $minor) = $ver =~ /(\d+)\.(\d+)/;
-
- if ($major > 2 || $major == 2 && $minor > 7) {
- #- new dmidecode output is less indented
- $tab = '';
- #- drop header
- shift @l while @l && $l[0] ne "\n";
- }
+ #- drop header
+ shift @l while @l && $l[0] ne "\n";
foreach (@l) {
- if (/^$tab\t(.*)/) {
+ next if /TRUNCATED/;
+ if (/^\t(.*)/) {
$dmis[-1]{string} .= "$1\n";
- $dmis[-1]{$1} = $2 if /^$tab\t(.*): (.*)$/;
- } elsif (my ($s) = /^$tab(.*)/) {
+ $dmis[-1]{$1} = $2 if /^\t(.*): (.*)$/;
+ } elsif (my ($s) = /^(.*)/) {
next if $s =~ /^$/ || $s =~ /\bDMI type \d+/;
$s =~ s/ Information$//;
push @dmis, { name => $s };
@@ -1056,13 +1324,25 @@ sub dmidecode() {
$dmidecode_already_runned = 1;
@dmis;
}
+
+=item dmi_detect_memory($category)
+
+Return only one category from DMI table
+
+=cut
+
sub dmidecode_category {
my ($cat) = @_;
my @l = grep { $_->{name} eq $cat } dmidecode();
wantarray() ? @l : $l[0] || {};
}
-#- size in MB
+=item dmi_detect_memory()
+
+Return RAM size in MB according to DMI table
+
+=cut
+
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)$/ &&
@@ -1071,6 +1351,18 @@ sub dmi_detect_memory() {
max(sum(@l1), sum(@l2));
}
+=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;
@@ -1080,16 +1372,50 @@ sub computer_info() {
+{
isLaptop => member($Chassis, 'Portable', 'Laptop', 'Notebook', 'Hand Held', 'Sub Notebook', 'Docking Station'),
- isServer => member($Chassis, 'Pizza Box', 'Main Server Chassis', 'Blade'),
+ isServer => member($Chassis, 'Pizza Box', 'Main Server Chassis', 'Rack Mount Chassis', 'Blade'),
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.
+=item isLaptop()
+
+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() {
- arch() =~ /ppc/ ?
- get_mac_model() =~ /Book/ :
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') ||
@@ -1103,11 +1429,17 @@ sub isLaptop() {
|| (any { member($_->{driver}, qw(ipw2100 ipw2200 ipw3945)) } pci_probe());
}
+=item isServer()
+
+Is it a server?
+
+=cut
+
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/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')
@@ -1115,59 +1447,190 @@ sub isServer() {
}
sub BIGMEM() {
- arch() !~ /x86_64|ia64/ && $> == 0 && dmi_detect_memory() > 4 * 1024;
+ arch() !~ /x86_64/ && $> == 0 && dmi_detect_memory() > 4 * 1024;
}
-sub is_i586() {
- my $cpuinfo = cat_('/proc/cpuinfo');
- $cpuinfo =~ /^cpu family\s*:\s*(\d+)/m && $1 < 6 ||
- $cpuinfo =~ /^model name\s*:\s*Transmeta.* TM5800/m || # mdvbz#37866
- !has_cpu_flag('cmov');
+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() {
- any { $_->{driver} eq 'vboxadd' } detect_devices::pci_probe();
+ virt_technology() eq 'oracle';
}
+=item is_vmware()
+
+Are we running under VMware hypervisor?
+
+=cut
+
sub is_vmware() {
- any { $_->{driver} =~ /Card:VMware/ } detect_devices::pci_probe();
+ 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() {
+{
- laptop => isLaptop(),
- 'touchpad' => hasTouchpad(),
'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());
+ }
+ return $hasCPUMicrocode;
+}
+
+=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/;
+}
+
+=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() }
@@ -1177,6 +1640,7 @@ 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
@@ -1238,7 +1702,7 @@ sub probeall_unavailable_modules() {
!member($driver, 'hub', 'unknown', 'amd64_agp') &&
!modules::module_is_available($driver) ?
$driver :
- ();
+ @{[]};
} probeall();
}
@@ -1289,6 +1753,14 @@ sub suggest_mount_point {
$name;
}
+=back
+
+=head1 SEE ALSO
+
+See L<hardware_detection> for the overall view.
+
+=cut
+
1;
#- Local Variables: