diff options
| -rw-r--r-- | perl-install/c.pm | 28 | ||||
| -rw-r--r-- | perl-install/detect_devices.pm | 368 | ||||
| -rw-r--r-- | perl-install/fs/dmcrypt.pm | 30 | ||||
| -rw-r--r-- | perl-install/fs/dmraid.pm | 16 | ||||
| -rw-r--r-- | perl-install/lvm.pm | 44 | ||||
| -rw-r--r-- | perl-install/raid.pm | 87 |
6 files changed, 570 insertions, 3 deletions
diff --git a/perl-install/c.pm b/perl-install/c.pm index 9b7a2c046..8022d0095 100644 --- a/perl-install/c.pm +++ b/perl-install/c.pm @@ -18,3 +18,31 @@ sub AUTOLOAD() { } 1; + + +=head1 SYNOPSYS + +The C module is glue code between the Perl & the C worlds that enable drakx to: + +=over + +=item * + +access various C libraries, mainly libldetect + +=item * + +bind some C functions (eg: syslog(), ...) + +=item * + +implement in C some helper functions + +=back + +It is autogenerated from perl-install/c/stuff.xs.pl. +One needs to run "perl Makefile.PL" + +It's used quite a lot by L<detect_devices>. + +=cut diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm index f9fe0d392..2e1a7c4d1 100644 --- a/perl-install/detect_devices.pm +++ b/perl-install/detect_devices.pm @@ -16,6 +16,39 @@ use modules; use c; use feature 'state'; + +=head2 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 /proc & /sys. + +Then the L<list_modules> enables to map modules into categories such as: + +=over + +=item network/ethernet, + +=item network/wireless, + +=item network/wifi, + +=item disk/sata, + +=item disk/scsi, + +=item ... + +=back + +This enables to detect a category by mapping drivers to categories. + +=head2 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 @@ -190,6 +231,12 @@ sub get_scsi_driver { } } +=item getSCSI() + +Returns a list of all SCSI device. + +=cut + sub getSCSI() { my $dev_dir = '/sys/bus/scsi/devices'; @@ -303,6 +350,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; @@ -337,6 +389,7 @@ sub block_devices() { : map { $_->{dev} } do { require fs::proc_partitions; fs::proc_partitions::read_raw() }; } +#Returns a list of all CCISS devices (Compaq Smart Array). sub getCompaqSmartArray() { my (@idi, $f); @@ -385,6 +438,12 @@ sub getATARAID() { values %l; } +=item getXenBlk() + +Returns a list of all Xen block devices (/dev/xvd*). + +=cut + sub getXenBlk() { -d '/sys/bus/xen/devices' or return; map { @@ -393,6 +452,12 @@ sub getXenBlk() { } glob("/sys/block/xvd*"); } +=item getVirtIO() + +Returns a list of all VirtIO block devices (/dev/vd*). + +=cut + sub getVirtIO() { -d '/sys/bus/virtio/devices' or return; map { @@ -418,6 +483,12 @@ sub getMmcBlk() { # cpu_freq = arch() =~ /^alpha/ ? "cycle frequency [Hz]" : # arch() =~ /^ppc/ ? "clock" : "cpu MHz" +=item getCPUs() + +Returns a list of all CPUs. + +=cut + sub getCPUs() { my (@cpus, $cpu); foreach (cat_("/proc/cpuinfo")) { @@ -436,6 +507,14 @@ 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) = @_; @@ -601,6 +680,14 @@ sub serialPort2text { $_[0] =~ /ttyS(\d+)/ ? "$_[0] / COM" . ($1 + 1) : $_[0]; } +=back + +=head2 Network + +=over + +=cut + sub getSerialModem { my ($modules_conf, $o_mouse) = @_; my $mouse = $o_mouse || {}; @@ -628,6 +715,11 @@ sub getSerialModem { @modems; } +=item getModem() + +Return list of modems (serial, WinModems) +=cut + our $detect_serial_modem = 1; sub getModem { my ($modules_conf) = @_; @@ -676,6 +768,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; @@ -687,6 +785,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... @@ -701,6 +805,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) @@ -709,6 +819,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 @@ -721,6 +837,12 @@ sub is_wireless_interface { || -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 @@ -731,15 +853,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 usefull 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 + +=head2 Enumerating devices + +=over + +=cut + sub get_ids_from_sysfs_device { my ($dev_path) = @_; my $dev_cat = sub { chomp_(cat_("$dev_path/$_[0]")) }; @@ -867,6 +1023,13 @@ sub pci_probe__real() { $l; } c::pci_probe()); } + +=item pci_probe() + +Cache the result of c::pci_probe() and return the list of items in the PCI devices. + +=cut + sub pci_probe() { state $done; if (!$done) { @@ -889,6 +1052,13 @@ sub usb_probe__real() { $l; } c::usb_probe()); } + +=item usb_probe() + +Cache the result of c::usb_probe() and return the list of items in the USB devices. + +=cut + sub usb_probe() { if ($::isStandalone && @usb) { @usb; @@ -897,6 +1067,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 { @@ -936,6 +1112,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/) { @@ -945,6 +1127,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; @@ -972,6 +1160,12 @@ sub pcmcia_probe() { } all($dev_dir); } +=item dmi_probe() + +Cache the result of c::dmi_probe() (aka dmidecode) and return the list of items in the DMI table + +=cut + sub dmi_probe() { state $dmi_probe; if (arch() !~ /86/) { @@ -981,7 +1175,15 @@ sub dmi_probe() { @$dmi_probe; } +=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; @@ -1071,6 +1273,11 @@ 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; @@ -1103,13 +1310,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)$/ && @@ -1118,6 +1337,18 @@ sub dmi_detect_memory() { max(sum(@l1), sum(@l2)); } +=back + +=head2 Test helpers + +=over + +=item computer_info() + +Analyze "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; @@ -1132,8 +1363,44 @@ 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 * + +computer_info() (really 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/ : @@ -1150,6 +1417,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')) @@ -1161,6 +1434,12 @@ sub isServer() { || (any { $_->{'model name'} =~ /(Xeon|Opteron)/i } getCPUs()); } +=item isHyperv() + +Are we running under Hyper-V hypervisor? + +=cut + sub isHyperv() { dmidecode_category('System')->{Manufacturer} =~ /Microsoft Corporation/i && dmidecode_category('System')->{'Product Name'} =~ /Virtual Machine/i; @@ -1210,33 +1489,75 @@ sub is_xbox() { any { $_->{vendor} == 0x10de && $_->{id} == 0x02a5 } pci_probe(); } +=item is_virtualbox() + +Are we running under VirtualBox hypervisor? + +=cut + sub is_virtualbox() { any { $_->{driver} eq 'vboxadd' } detect_devices::pci_probe(); } +=item is_vmware() + +Are we running under VMware hypervisor? + +=cut + sub is_vmware() { any { $_->{driver} =~ /Card:VMware/ } detect_devices::pci_probe(); } +=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 ressource 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 ressources 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() { +{ mips_lemote => is_mips_lemote(), @@ -1251,6 +1572,12 @@ sub matching_types() { }; } +=item sub hasCPUMicrocode() + +Does CPU need microcode updates? + +=cut + sub hasCPUMicrocode() { state $hasCPUMicrocode; if (!defined $hasCPUMicrocode) { @@ -1259,14 +1586,41 @@ sub hasCPUMicrocode() { 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() } @@ -1391,6 +1745,14 @@ sub suggest_mount_point { $name; } +=back + +=head2 SEE ALSO + +See L<hardware_detection> for the overall view. + +=cut + 1; #- Local Variables: diff --git a/perl-install/fs/dmcrypt.pm b/perl-install/fs/dmcrypt.pm index 0cb73a848..f26bad391 100644 --- a/perl-install/fs/dmcrypt.pm +++ b/perl-install/fs/dmcrypt.pm @@ -11,8 +11,22 @@ use fs::type; use fs::get; use run_program; +=head1 SYNOPSYS + +Manage encrypted file systems using cryptsetup + +=over + +=cut + sub _crypttab() { "$::prefix/etc/crypttab" } +=item init() + +Load kernel modules and init device mapper. + +=cut + sub init() { whereis_binary('cryptsetup') or die "cryptsetup not installed"; @@ -44,6 +58,12 @@ sub read_crypttab_ { } } +=item read_crypttab($all_hds) + +Read /etc/crypttab + +=cut + sub read_crypttab { my ($all_hds) = @_; read_crypttab_($all_hds, _crypttab()); @@ -67,6 +87,12 @@ sub save_crypttab_ { } $crypttab; } +=item save_crypttab($all_hds) + +Save /etc/crypttab + +=cut + sub save_crypttab { my ($all_hds) = @_; save_crypttab_($all_hds, _crypttab()); @@ -176,4 +202,8 @@ sub active_dm() { } run_program::get_stdout('dmsetup', 'table'); } +=back + +=cut + 1; diff --git a/perl-install/fs/dmraid.pm b/perl-install/fs/dmraid.pm index 851171c2f..657899b13 100644 --- a/perl-install/fs/dmraid.pm +++ b/perl-install/fs/dmraid.pm @@ -14,6 +14,18 @@ use fs::wild_device; use run_program; +=head1 SYNOPSYS + +Manage fake RAIDs using dmraid + +=over + +=item init() + +Load kernel modules, init device mapper then scan for fake RAIDs. + +=cut + sub init() { whereis_binary('dmraid') or die "dmraid not installed"; @@ -253,4 +265,8 @@ EOF $@ and die; } +=back + +=cut + 1; diff --git a/perl-install/lvm.pm b/perl-install/lvm.pm index 5bca97af9..006dbb087 100644 --- a/perl-install/lvm.pm +++ b/perl-install/lvm.pm @@ -12,6 +12,14 @@ use devices; use fs::type; use run_program; +=head1 SYNOPSYS + +Manage LVM (PV, VG, LV) + +=over 4 + +=cut + #- for partition_table_xxx emulation sub new { my ($class, $name) = @_; @@ -29,11 +37,23 @@ sub cylinder_size { $hd->{extent_size}; } +=item detect_durting_install() + +Explicitely scan VGs. + +=cut + sub detect_during_install() { run_program::run('lvm2', 'vgscan'); run_program::run('lvm2', 'vgchange', '-a', 'y'); } +=item init() + +Loads LVM modules and scan VGs (if in installer, not in standalone tool). + +=cut + sub init() { devices::init_device_mapper(); detect_during_install() if $::isInstall; @@ -42,6 +62,13 @@ sub init() { init() or log::l("lvm::init failed"); +=item lvm_cmd(...) + +Run a LVM command, then rescan VG. +See run_program::run() for arguments. + +=cut + sub lvm_cmd { if (my $r = run_program::run('lvm2', @_)) { $r; @@ -54,6 +81,13 @@ sub lvm_cmd { run_program::run('lvm2', @_); } } + +=item lvm_cmd_or_die($prog, @para) + +Like lvm_cmd() but die if there's an error. + +=cut + sub lvm_cmd_or_die { my ($prog, @para) = @_; my @err; @@ -112,6 +146,12 @@ sub lv_nb_pvs { listlength(lv_to_pvs($lv)); } +=item get_lvs($lvm) + +Return list of LVs. + +=cut + sub get_lvs { my ($lvm) = @_; my @l = run_program::get_stdout('lvm2', 'lvs', '--noheadings', '--nosuffix', '--units', 's', '-o', 'lv_name', $lvm->{VG_name}) =~ /(\S+)/g; @@ -241,4 +281,8 @@ sub create_singleton_vg { add_to_VG($part, $lvm); } +=back + +=cut + 1; diff --git a/perl-install/raid.pm b/perl-install/raid.pm index e65ee0676..6ae99a8d8 100644 --- a/perl-install/raid.pm +++ b/perl-install/raid.pm @@ -13,6 +13,14 @@ use run_program; use devices; use modules; +=head1 SYNOPSYS + +Manage regular soft RAID (MD=Multiple Drive). + +=over + +=cut + sub max_nb() { 31 } sub check_prog { @@ -38,6 +46,12 @@ sub new { $md_part; } +=item add() + +Add a partition to a RAID array + +=cut + sub add { my ($md_part, $part) = @_; $md_part->{isMounted} and die N("Cannot add a partition to _formatted_ RAID %s", $md_part->{device}); @@ -49,6 +63,12 @@ sub add { update($md_part); } +=item delete() + +Remove a partition from a RAID array + +=cut + sub delete { my ($raids, $md_part) = @_; inactivate_and_dirty($md_part); @@ -96,10 +116,22 @@ sub updateSize { }; } +=item allmodules() + +Return list of the RAID modules we support + +=cut + sub allmodules { ('raid0', 'raid1', 'raid10', 'raid456'); } +=item module($part) + +Return list of modules need by a md device (according to its RAID level) + +=cut + sub module { my ($part) = @_; my $level = $part->{level}; @@ -173,18 +205,45 @@ sub inactivate_and_dirty { set_isFormatted($part, 0); } +=item active_mds() + +Return list of active MDs + +=cut + sub active_mds() { map { if_(/^(md\S+)\s*:\s*active/, $1) } cat_("/proc/mdstat"); } + +=item inactive_mds() + +Return list of inactive MDs + +=cut + sub inactive_mds() { map { if_(/^(md\S+)\s*:\s*inactive/, $1) } cat_("/proc/mdstat"); } +=item free_mds() + +Return list of unused MD device nodes + +=cut + sub free_mds { my ($raids) = @_; difference2([ map { "md$_" } 0 .. max_nb() ], [ map { $_->{device} } @$raids ]); } +=item detect_durting_install() + +Load RAID modules. +Stop RAIDS that might have been started too early by udev. +Scan & starts RAID arrays, then stop any inactive md. + +=cut + sub detect_during_install { my (@parts) = @_; eval { modules::load($_) } foreach allmodules(); @@ -198,6 +257,12 @@ sub detect_during_install { stop_inactive_mds(); } +=item stop_inactive_mds() + +Stop any inactive md. + +=cut + sub stop_inactive_mds() { foreach (inactive_mds()) { log::l("$_ is an inactive md, we stop it to ensure it doesn't busy devices"); @@ -205,6 +270,12 @@ sub stop_inactive_mds() { } } +=item detect_during_install_once(@parts) + +Scan & starts RAID arrays, then stop any inactive md. + +=cut + sub detect_during_install_once { my (@parts) = @_; devices::make("md$_") foreach 0 .. max_nb(); @@ -256,11 +327,23 @@ sub get_existing { $raids; } +=item is_active($dev) + +Is it an?active md + +=cut + sub is_active { my ($dev) = @_; member($dev, active_mds()); } +=item write_conf() + +Write /etc/mdadm.conf + +=cut + sub write_conf { my ($raids) = @_; @@ -301,4 +384,8 @@ sub parse_mdadm_conf { \%conf; } +=back + +=cut + 1; |