summaryrefslogtreecommitdiffstats
path: root/perl-install/timezone.pm
blob: 6515c041aff06d0be71716c8a8c010f3864b9844 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
package timezone; # $Id$

use diagnostics;
use strict;

use common;
use log;


sub getTimeZones() {
    my $prefix = $::testing ? '' : $::prefix;
    open(my $F, "cd $prefix/usr/share/zoneinfo && find [A-Z]* -type f |");
    my @l = difference2([ chomp_(<$F>) ], [ 'ROC', 'PRC' ]);
    close $F or die "cannot list the available zoneinfos";
    sort @l;
}

sub read() {
    my %t = getVarsFromSh("$::prefix/etc/sysconfig/clock") or return {};
    { timezone => $t{ZONE}, UTC => text2bool($t{UTC}) };
}

sub ntp_server {
    my $setting = @_ >= 1;
    my ($server) = @_;

    my $f = "$::prefix/etc/ntp.conf";
    -e $f or return;

    if ($setting) {
	my $added = 0;
	substInFile {
	    if (/^#?\s*server\s+(\S*)/ && $1 ne '127.127.1.0') {
		$_ = $added ? "#server $1\n" : "server $server\n";
		$added = 1;
	    }
	} $f;
	output_p("$::prefix/etc/ntp/step-tickers", "$server\n");
    } else {
	$server = find { $_ ne '127.127.1.0' } map { if_(/^\s*server\s+(\S*)/, $1) } cat_($f);
    }
    $server;
}

sub write {
    my ($t) = @_;

    ntp_server($t->{ntp});

    eval { cp_af("$::prefix/usr/share/zoneinfo/$t->{timezone}", "$::prefix/etc/localtime") };
    $@ and log::l("installing /etc/localtime failed");
    setVarsInSh("$::prefix/etc/sysconfig/clock", {
	ZONE => $t->{timezone},
	UTC  => bool2text($t->{UTC}),
	ARC  => "false",
    });
}

#- best guesses for a given country
my %c2t = (
'AM' => 'Asia/Yerevan',
'AR' => 'America/Buenos_Aires',
'AT' => 'Europe/Vienna',
'AU' => 'Australia/Sydney',
'BA' => 'Europe/Sarajevo',
'BE' => 'Europe/Brussels',
'BG' => 'Europe/Sofia',
'BR' => 'Brazil/East', #- most people live on the east coast
'BY' => 'Europe/Minsk',
'CA' => 'Canada/Eastern',
'CH' => 'Europe/Zurich',
'CN' => 'Asia/Beijing',
'CZ' => 'Europe/Prague',
'DE' => 'Europe/Berlin',
'DK' => 'Europe/Copenhagen',
'EE' => 'Europe/Tallinn',
'ES' => 'Europe/Madrid',
'FI' => 'Europe/Helsinki',
'FR' => 'Europe/Paris',
'GB' => 'Europe/London',
'GE' => 'Asia/Yerevan',
'GL' => 'Arctic/Longyearbyen',
'GR' => 'Europe/Athens',
'HR' => 'Europe/Zagreb',
'HU' => 'Europe/Budapest',
'ID' => 'Asia/Jakarta',
'IE' => 'Europe/Dublin',
'IL' => 'Asia/Tel_Aviv',
'IN' => 'Asia/Calcutta',
'IR' => 'Asia/Tehran',
'IS' => 'Atlantic/Reykjavik',
'IT' => 'Europe/Rome',
'JP' => 'Asia/Tokyo',
'KR' => 'Asia/Seoul',
'LT' => 'Europe/Vilnius',
'LV' => 'Europe/Riga',
'MK' => 'Europe/Skopje',
'MT' => 'Europe/Malta',
'MX' => 'America/Mexico_City',
'MY' => 'Asia/Kuala_Lumpur',
'NL' => 'Europe/Amsterdam',
'NO' => 'Europe/Oslo',
'NZ' => 'Pacific/Auckland',
'PL' => 'Europe/Warsaw',
'PT' => 'Europe/Lisbon',
'RO' => 'Europe/Bucharest',
'RU' => 'Europe/Moscow',
'SE' => 'Europe/Stockholm',
'SI' => 'Europe/Ljubljana',
'SK' => 'Europe/Bratislava',
'TH' => 'Asia/Bangkok',
'TJ' => 'Asia/Dushanbe',
'TR' => 'Europe/Istanbul',
'TW' => 'Asia/Taipei',
'UA' => 'Europe/Kiev',
'US' => 'America/New_York',
'UZ' => 'Asia/Tashkent',
'VN' => 'Asia/Saigon',
'YU' => 'Europe/Belgrade',
'ZA' => 'Africa/Johannesburg',
);

sub fuzzyChoice { 
    my ($b, $count) = bestMatchSentence($_[0], keys %c2t);
    $count ? $b : '';
}
sub bestTimezone { $c2t{fuzzyChoice($_[0])} || 'GMT' }

sub ntp_servers() { 
    +{
	'time.sinectis.com.ar' => 'Argentina',
	'tick.nap.com.ar' => 'Argentina',
	'tock.nap.com.ar' => 'Argentina',
	'ntp.adelaide.edu.au' => 'Australia',
	'ntp.saard.net' => 'Australia',
	'ntp1.belbone.be' => 'Belgium',
	'ntp2.belbone.be' => 'Belgium',
	'ntp.cpsc.ucalgary.ca' => 'Canada',
	'ntp1.cmc.ec.gc.ca' => 'Canada',
	'ntp2.cmc.ec.gc.ca' => 'Canada',
	'time.chu.nrc.ca' => 'Canada',
	'time.nrc.ca' => 'Canada',
	'timelord.uregina.ca' => 'Canada',
	'ntp.globe.cz' => 'Czech republic',
	'ntp.karpo.cz' => 'Czech republic',
	'ntp1.contactel.cz' => 'Czech republic',
	'ntp2.contactel.cz' => 'Czech republic',
	'clock.netcetera.dk' => 'Denmark',
	'clock2.netcetera.dk' => 'Denmark',
	'slug.ctv.es' => 'Spain',
	'tick.keso.fi' => 'Finland',
	'tock.keso.fi' => 'Finland',
	'ntp.ndsoftwarenet.com' => 'France',
	'ntp.obspm.fr' => 'France',
	'ntp.tuxfamily.net' => 'France',
	'ntp1.tuxfamily.net' => 'France',
	'ntp2.tuxfamily.net' => 'France',
	'ntp.univ-lyon1.fr' => 'France',
	'zg1.ntp.carnet.hr' => 'Croatia',
	'zg2.ntp.carnet.hr' => 'Croatia',
	'st.ntp.carnet.hr' => 'Croatia',
	'ri.ntp.carnet.hr' => 'Croatia',
	'os.ntp.carnet.hr' => 'Croatia',
	'ntp.incaf.net' => 'Indonesia',
	'ntp.maths.tcd.ie' => 'Ireland',
	'time.ien.it' => 'Italy',
	'ntps.net4u.it' => 'Italy',
	'ntp.cyber-fleet.net' => 'Japan',
	'time.nuri.net' => 'Korea, republic of',
	'ntp2a.audiotel.com.mx' => 'Mexico',
	'ntp2b.audiotel.com.mx' => 'Mexico',
	'ntp2c.audiotel.com.mx' => 'Mexico',
	'ntp.doubleukay.com' => 'Malaysia',
	'ntp1.theinternetone.net' => 'Netherlands',
	'ntp2.theinternetone.net' => 'Netherlands',
	'ntp3.theinternetone.net' => 'Netherlands',
	'fartein.ifi.uio.no' => 'Norway',
	'info.cyf-kr.edu.pl' => 'Poland',
	'ntp.ip.ro' => 'Romania',
	'ntp.psn.ru' => 'Russia',
	'time.flygplats.net' => 'Sweden',
	'ntp.shim.org' => 'Singapore',
	'biofiz.mf.uni-lj.si' => 'Slovenia',
	'time.ijs.si' => 'Slovenia',
	'time.ijs.si' => 'Slovenia',
	'clock.cimat.ues.edu.sv' => 'El salvador',
	'a.ntp.alphazed.net' => 'United kingdom',
	'bear.zoo.bt.co.uk' => 'United kingdom',
	'ntp.cis.strath.ac.uk' => 'United kingdom',
	'ntp2a.mcc.ac.uk' => 'United kingdom',
	'ntp2b.mcc.ac.uk' => 'United kingdom',
	'ntp2c.mcc.ac.uk' => 'United kingdom',
	'ntp2d.mcc.ac.uk' => 'United kingdom',
	'tick.tanac.net' => 'United kingdom',
	'time-server.ndo.com' => 'United kingdom',
	'sushi.compsci.lyon.edu' => 'United states AR',
	'ntp.drydog.com' => 'United states AZ',
	'clock.fmt.he.net' => 'United states CA',
	'clock.sjc.he.net' => 'United states CA',
	'ntp.ucsd.edu' => 'United states CA',
	'ntp1.sf-bay.org' => 'United states CA',
	'ntp2.sf-bay.org' => 'United states CA',
	'time.berkeley.netdot.net' => 'United states CA',
	'ntp1.linuxmedialabs.com' => 'United states CO',
	'ntp1.tummy.com' => 'United states CO',
	'louie.udel.edu' => 'United states DE',
	'rolex.usg.edu' => 'United states GA',
	'timex.usg.edu' => 'United states GA',
	'ntp-0.cso.uiuc.edu' => 'United states IL',
	'ntp-1.cso.uiuc.edu' => 'United states IL',
	'ntp-1.mcs.anl.gov' => 'United states IL',
	'ntp-2.cso.uiuc.edu' => 'United states IL',
	'ntp-2.mcs.anl.gov' => 'United states IL',
	'gilbreth.ecn.purdue.edu' => 'United states IN',
	'harbor.ecn.purdue.edu' => 'United states IN',
	'molecule.ecn.purdue.edu' => 'United states IN',
	'ntp.ourconcord.net' => 'United states MA',
	'ns.nts.umn.edu' => 'United states MN',
	'nss.nts.umn.edu' => 'United states MN',
	'time-ext.missouri.edu' => 'United states MO',
	'chronos1.umt.edu' => 'United states MT',
	'chronos2.umt.edu' => 'United states MT',
	'chronos3.umt.edu' => 'United states MT',
	'tick.jrc.us' => 'United states NJ',
	'tock.jrc.us' => 'United states NJ',
	'cuckoo.nevada.edu' => 'United states NV',
	'tick.cs.unlv.edu' => 'United states NV',
	'tock.cs.unlv.edu' => 'United states NV',
	'clock.linuxshell.net' => 'United states NY',
	'clock.nyc.he.net' => 'United states NY',
	'ntp0.cornell.edu' => 'United states NY',
	'reva.sixgirls.org' => 'United states NY',
	'clock.psu.edu' => 'United states PA',
	'fuzz.psc.edu' => 'United states PA',
	'ntp-1.cede.psu.edu' => 'United states PA',
	'ntp-2.cede.psu.edu' => 'United states PA',
	'ntp-1.ece.cmu.edu' => 'United states PA',
	'ntp-2.ece.cmu.edu' => 'United states PA',
	'ntp.cox.smu.edu' => 'United states TX',
	'ntp.fnbhs.com' => 'United states TX',
	'ntppub.tamu.edu' => 'United states TX',
	'ntp-1.vt.edu' => 'United states VA',
	'ntp-2.vt.edu' => 'United states VA',
	'ntp.cmr.gov' => 'United states VA',
	'ntp1.cs.wisc.edu' => 'United states WI',
	'ntp3.cs.wisc.edu' => 'United states WI',
	'ntp3.sf-bay.org' => 'United states WI',
	'ntp.cs.unp.ac.za' => 'South africa',
	'tock.nml.csir.co.za' => 'South africa',
        'pool.ntp.org' => 'World Wide',
    };
}

1;
span class="hl kwb">$_->{channel} == 0 && $_->{id} == 0 && $_->{lun} == 0 } @l; my %l; push @{$l{$_->{host}}}, $_ foreach @l; my @informed; foreach my $host (keys %usbs) { my @choices = @{$l{$host} || []} or log::l("weird, host$host from /proc/scsi/usb-storage-*/* is not in /proc/scsi/scsi"), next; if (@choices > 1) { @choices = grep { $_->{info} =~ /^\Q$usbs{$host}{vendor_name}/ } @choices; @choices or log::l("weird, can't find the good entry host$host from /proc/scsi/usb-storage-*/* in /proc/scsi/scsi"), next; @choices == 1 or log::l("argh, can't determine the good entry host$host from /proc/scsi/usb-storage-*/* in /proc/scsi/scsi"), next } add2hash($choices[0], $usbs{$host}); push @informed, $choices[0]; } @informed or return; foreach my $usb (usb_probe()) { if (my $e = find { $_->{usb_vendor} == $usb->{vendor} && $_->{usb_id} == $usb->{id} } @informed) { $e->{"usb_$_"} = $usb->{$_} foreach keys %$usb; } } } sub get_devfs_devices { my (@l) = @_; my %h = (cdrom => 'cd', hd => 'disc'); foreach (@l) { my $t = $h{$_->{media_type}} or next; $_->{devfs_device} = $_->{devfs_prefix} . '/' . $t; } } sub isBurner { my ($e) = @_; $e->{capacity} =~ /burner/ and return 1; #- do not work for SCSI my $f = tryOpen($e->{device}); #- SCSI burner are not detected this way. $f && c::isBurner(fileno($f)); } sub isDvdDrive { my ($e) = @_; $e->{capacity} =~ /DVD/ || $e->{info} =~ /DVD/ and return 1; #- do not work for SCSI my $f = tryOpen($e->{device}); $f && c::isDvdDrive(fileno($f)); } sub isZipDrive { $_[0]{info} =~ /ZIP\s+\d+/ } #- accept ZIP 100, untested for bigger ZIP drive. sub isJazzDrive { $_[0]{info} =~ /\bJAZZ?\b/i } #- accept "iomega jaz 1GB" sub isLS120Drive { $_[0]{info} =~ /LS-?120|144MB/ } sub isRemovableUsb { index($_[0]{usb_media_type}, 'Mass Storage|') == 0 && usb2removable($_[0]) } sub isFloppyUsb { $_[0]{usb_driver} eq 'Removable:floppy' } sub isRemovableDrive { my ($e) = @_; isZipDrive($e) || isLS120Drive($e) || $e->{media_type} eq 'fd' || isRemovableUsb($e) || index($e->{usb_media_type}, 'Mass Storage|Floppy (UFI)') == 0; } 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", host => $host, 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; get_usb_storage_info(@l); each_index { my $dev = "sd" . chr($::i + ord('a')); put_in_hash $_, { device => $dev, media_type => isFloppyUsb($_) ? 'fd' : 'hd' }; } grep { $_->{raw_type} =~ /Direct-Access|Optical Device/ } @l; each_index { put_in_hash $_, { device => "st$::i", media_type => 'tape' }; } grep { $_->{raw_type} =~ /Sequential-Access/ } @l; each_index { put_in_hash $_, { device => "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); get_sys_cdrom_info(@l); @l; } my %eide_hds = ( "ASUS" => "Asus", "CD-ROM CDU" => "Sony", "CD-ROM Drive/F5D" => "ASUSTeK", "Compaq" => "Compaq", "CONNER" => "Conner Peripherals", "IBM" => "IBM", "FUJITSU" => "Fujitsu", "HITACHI" => "Hitachi", "Lite-On" => "Lite-On Technology Corp.", "LTN" => "Lite-On Technology Corp.", "IOMEGA" => "Iomega", "MAXTOR" => "Maxtor", "Maxtor" => "Maxtor", "Micropolis" => "Micropolis", "Pioneer" => "Pioneer", "PLEXTOR" => "Plextor", "QUANTUM" => "Quantum", "SAMSUNG" => "Samsung", "Seagate " => "Seagate Technology", "ST3" => "Seagate Technology", "TEAC" => "Teac", "TOSHIBA" => "Toshiba", "WDC" => "Western Digital Corp.", ); sub getIDE() { my @idi; #- what about a system with absolutely no IDE on it, like some sparc machine. -e "/proc/ide" or return (); #- Great. 2.2 kernel, things are much easier and less error prone. foreach my $d (sort @{[glob_('/proc/ide/hd*')]}) { cat_("$d/driver") =~ /ide-scsi/ and next; #- already appears in /proc/scsi/scsi my $t = chomp_(cat_("$d/media")); my $type = ${{ disk => 'hd', cdrom => 'cdrom', tape => 'tape', floppy => 'fd' }}{$t} or next; my $info = chomp_(cat_("$d/model")) || "(none)"; my $num = ord(($d =~ /(.)$/)[0]) - ord 'a'; my ($vendor, $model) = map { if_($info =~ /^$_(-|\s)*(.*)/, $eide_hds{$_}, $2); } keys %eide_hds; my ($channel, $id) = ($num / 2, $num % 2); my $devfs_prefix = sprintf('ide/host0/bus%d/target%d/lun0', $channel, $id); push @idi, { media_type => $type, device => basename($d), devfs_prefix => $devfs_prefix, info => $info, 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 getCompaqSmartArray() { my (@idi, $f); foreach ('array/ida', 'cpqarray/ida', 'cciss/cciss') { my $prefix = "/proc/driver/$_"; #- kernel 2.4 places it here $prefix = "/proc/$_" if !-e "${prefix}0"; #- kernel 2.2 my ($name) = m|/(.*)|; for (my $i = 0; -r ($f = "${prefix}$i"); $i++) { foreach (cat_($f)) { if (my ($device) = m|^\s*($name/.*?):|) { push @idi, { device => $device, prefix => $device . 'p', info => "Compaq RAID logical disk", media_type => 'hd', bus => 'ida' }; } } } } @idi; } sub getDAC960() { my %idi; #- We are looking for lines of this format:DAC960#0: #- /dev/rd/c0d0: RAID-7, Online, 17928192 blocks, Write Thru0123456790123456789012 foreach (syslog()) { my ($device, $info) = m|/dev/(rd/.*?): (.*?),| or next; $idi{$device} = { info => $info, media_type => 'hd', device => $device, prefix => $device . 'p', bus => 'dac960' }; } values %idi; } sub getATARAID { my %l; foreach (syslog()) { my ($device) = m|^\s*(ataraid/d\d+):| or next; $l{$device} = { info => 'ATARAID block device', media_type => 'hd', device => $device, prefix => $device . 'p', bus => 'ataraid' }; log::l("ATARAID: $device"); } values %l; } # cpu_name : arch() =~ /^alpha/ ? "cpu " : # arch() =~ /^ppc/ ? "processor" : "vendor_id" # cpu_model : arch() =~ /^alpha/ ? "cpu model" : # arch() =~ /^ppc/ ? "cpu " : "model name" # cpu_freq = arch() =~ /^alpha/ ? "cycle frequency [Hz]" : # arch() =~ /^ppc/ ? "clock" : "cpu MHz" sub getCPUs { my (@cpus, $cpu); foreach (cat_("/proc/cpuinfo")) { if (/^processor/) { # ix86 specific push @cpus, $cpu if $cpu; $cpu = {}; } /^([^\t]*).*:\s(.*)$/; $cpu->{$1} = $2 if $1; } push @cpus, $cpu; @cpus; } sub getSoundDevices { (arch() =~ /ppc/ ? \&modules::load_category : \&modules::probe_category)->('multimedia/sound'); } sub getSerialModem { my ($modem, $mouse) = @_; $mouse ||= {}; $mouse->{device} = readlink "/dev/mouse"; my $serdev = arch() =~ /ppc/ ? "macserial" : "serial"; eval { modules::load($serdev) }; probeSerialDevices(); foreach ('modem', map { "ttyS$_" } (0..7)) { next if $mouse->{device} =~ /$_/; next unless -e "/dev/$_"; hasModem("/dev/$_") and $modem->{device} = $_, last; } #- add an alias for macserial on PPC modules::add_alias('serial', $serdev) if arch() =~ /ppc/ && $modem->{device}; my @devs = pcmcia_probe(); foreach (@devs) { $_->{type} =~ /serial/ and $modem->{device} = $_->{device} } $modem; } sub getModem() { my @pci_modems = grep { $_->{driver} =~ /www.linmodems.org/ } probeall(0); grep { !is_empty_hash_ref($_) } getSerialModem({}), @pci_modems; } sub getSpeedtouch { grep { $_->{description} eq 'Alcatel|USB ADSL Modem (Speed Touch)' } probeall(0); } sub getSagem { grep { $_->{description} eq 'Analog Devices Inc.|USB ADSL modem' } probeall(0); } sub getNet() { grep { !(($::isStandalone || $::live) && /plip/) && c::hasNetDevice($_) } @netdevices; } #sub getISDN() { # mapgrep(sub {member (($_[0] =~ /\s*(\w*):/), @netdevices), $1 }, split(/\n/, cat_("/proc/net/dev"))); #} $pcitable_addons = <<'EOF'; # add here lines conforming the pcitable format (0xXXXX\t0xXXXX\t"\w+"\t".*") EOF $usbtable_addons = <<'EOF'; # add here lines conforming the usbtable format (0xXXXX\t0xXXXX\t"\w+"\t".*") EOF sub install_addons { my ($prefix) = @_; #- this test means install_addons can only be called after ldetect-lst has been installed. if (-d "$prefix/usr/share/ldetect-lst") { my $update = 0; foreach ([ 'pcitable.d', $pcitable_addons ], [ 'usbtable.d', $usbtable_addons ]) { my ($dir, $str) = @$_; -d "$prefix/usr/share/ldetect-lst/$dir" && $str =~ /^[^#]/m and $update = 1 and output "$prefix/usr/share/ldetect-lst/$dir/95drakx.lst", $str; } $update and run_program::rooted($prefix, "/usr/sbin/update-ldetect-lst"); } } sub add_addons { my ($addons, @l) = @_; foreach (split "\n", $addons) { /^\s/ and die "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 \"$_\""; foreach (@l) { $_->{vendor} == hex $vendor && $_->{id} == hex $id or next; put_in_hash($_, { driver => $driver, description => $description }); } } @l; } sub pci_probe { my ($probe_type) = @_; log::l("full pci_probe") if $probe_type; 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)); } sub usb_probe { -e "/proc/bus/usb/devices" or return; add_addons($usbtable_addons, map { my %l; @l{qw(vendor id media_type driver description pci_bus pci_device)} = split "\t"; $l{$_} = hex $l{$_} foreach qw(vendor id); $l{bus} = 'USB'; \%l } c::usb_probe()); } sub pcmcia_probe { -e '/var/run/stab' || -e '/var/lib/pcmcia/stab' or return (); my (@devs, $desc); foreach (cat_('/var/run/stab'), cat_('/var/lib/pcmcia/stab')) { if (/^Socket\s+\d+:\s+(.*)/) { $desc = $1; } else { my (undef, $type, $module, undef, $device) = split; push @devs, { description => $desc, driver => $module, type => $type, device => $device }; } } @devs; } # 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) = @_; return if $::noauto; require sbus_probing::main; pci_probe($probe_type), usb_probe(), pcmcia_probe(), sbus_probing::main::probe(); } sub matching_desc { my ($regexp) = @_; grep { $_->{description} =~ /$regexp/i } probeall(); } sub stringlist { map { sprintf("%-16s: %s%s%s", $_->{driver} || 'unknown',