diff options
Diffstat (limited to 'perl-install/detect_devices.pm')
| -rw-r--r-- | perl-install/detect_devices.pm | 641 |
1 files changed, 549 insertions, 92 deletions
diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm index 9818745c1..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); } @@ -187,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'; @@ -227,7 +280,7 @@ 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')]; @@ -236,7 +289,7 @@ sub getSCSI() { my ($vendor, $model) = ($get->('vendor'), $get->('model')); my ($v, $m) = _get_hd_vendor($model); - if ($v && $v) { + if ($v && $m) { ($vendor, $model) = ($v, $m); } push @l, { info => $vendor . ' ' . $model, host => $host, channel => $channel, id => $id, lun => $lun, @@ -270,6 +323,7 @@ my %hd_vendors = ( "Compaq" => "Compaq", "CONNER" => "Conner Peripherals", "IBM" => "IBM", + "INTEL" => "Intel", "FUJITSU" => "Fujitsu", "HITACHI" => "Hitachi", "Lite-On" => "Lite-On Technology Corp.", @@ -300,6 +354,11 @@ sub _get_hd_vendor { return ("Hitachi", $info) if $info =~ /^HD[ST][0-9]/; } +=item getIDE() + +Returns a list of all IDE device. + +=cut sub getIDE() { my @idi; @@ -309,7 +368,6 @@ 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)"; @@ -335,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; @@ -375,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 { @@ -393,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); @@ -420,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=(.*))?/; @@ -455,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 = {}; @@ -507,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=(.*)/) { @@ -537,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() { @@ -565,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; @@ -584,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) = @_; @@ -639,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; @@ -650,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... @@ -664,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) @@ -672,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 @@ -679,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 @@ -692,15 +848,49 @@ 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]")) }; @@ -741,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 { @@ -759,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"; @@ -826,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) { @@ -846,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 usb_port)} = split "\t"; - $l{media_type} = join('|', grep { $_ ne '(null)' } split('\|', $l{media_type})); - $l{$_} = hex $l{$_} foreach qw(vendor id); - $l{sysfs_device} = "/sys/bus/usb/devices/$l{pci_bus}-" . ($l{usb_port} + 1); - $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; @@ -866,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 { @@ -905,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/) { @@ -914,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; @@ -941,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; @@ -1021,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; } @@ -1036,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 ($major, $minor) = $ver =~ /(\d+)\.(\d+)/; + my ($_ver, @l) = arch() =~ /86/ ? run_program::get_stdout('dmidecode') : (); - 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 }; @@ -1071,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)$/ && @@ -1086,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; @@ -1100,11 +1377,45 @@ sub computer_info() { }; } -#- 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') || @@ -1118,6 +1429,12 @@ 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')) @@ -1130,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_arm_openrd_client() { + to_bool(cat_('/proc/cpuinfo') =~ /OpenRD Client/); } -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_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() } @@ -1192,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 @@ -1253,7 +1702,7 @@ sub probeall_unavailable_modules() { !member($driver, 'hub', 'unknown', 'amd64_agp') && !modules::module_is_available($driver) ? $driver : - (); + @{[]}; } probeall(); } @@ -1304,6 +1753,14 @@ sub suggest_mount_point { $name; } +=back + +=head1 SEE ALSO + +See L<hardware_detection> for the overall view. + +=cut + 1; #- Local Variables: |