#!/usr/bin/perl -w =begin comment info +-----------------------------------------------------------------------------+ | Copyright 2000-2005 Guardian Digital, Inc., All Rights Reserved | $Id: discover-einstall,v 1.5 2005/10/18 18:51:21 rwm Exp $ | | Ryan W. Maple +-----------------------------------------------------------------------------+ =end comment info =cut # use perl; use strict; use vars qw($seen); # # Local prototypes. # sub append_file($$$$); sub get_module_info($); sub read_names(); # # Local constants. # use constant PCI_DEVLIST_FILE => '/tmp/pci_probe_results'; use constant PCI_SCSILIST_FILE => '/tmp/pci_scsi_results'; # # Close STDERR and unlink our files if they already exist. # close STDERR; unlink PCI_DEVLIST_FILE, PCI_SCSILIST_FILE; # # Do it. # $seen = { }; my @names = read_names(); my @cmd = ('discover', '--data-path=linux/module/name', '--format=%s'); open MODULES, '-|', @cmd or exit 1; for (my $i = 0; my $l = ; $i++) { chomp $l; next if ($l eq ' ' || $l eq ''); $l =~ s/\s//g; my $type = get_module_info($l); next unless ($type); if ($type eq 'net') { append_file(PCI_DEVLIST_FILE, $l, $i, \@names); } elsif ($type eq 'scsi') { append_file(PCI_SCSILIST_FILE, $l, $i, \@names); } } close MODULES; # # All done, exit quietly. # exit 0; ################################################################################ sub append_file($$$$) { my $file = shift; my $module = shift; my $index = shift; my $names = shift; my $name = $names->[$index]; # Avoid writing duplicate SCSI entries. return 1 if ($seen->{$module} && $file eq PCI_SCSILIST_FILE); open FILE, '>>', $file or return 1; if ($file eq PCI_DEVLIST_FILE) { print FILE "1 0 $module $name ##\n"; } elsif ($file eq PCI_SCSILIST_FILE) { print FILE "2 2 $module $name ##\n"; } close FILE; $seen->{$module} = 1; return 0; } ################################################################################ sub get_module_info($) { my $module = shift; my @cmd = ('modinfo', $module); my $rv = undef; open CMD, '-|', @cmd or goto $rv; while (my $l = ) { chomp $l; if ($l =~ m/^filename\:\s+\/lib\/modules\/[^\/]+\/kernel\/(.+)$/) { my $stuff = $1; if ($stuff =~ m/\/net\//) { $rv = 'net'; goto done; } elsif ($stuff =~ m/\/usb\//) { $rv = 'usb'; goto done; } elsif ($stuff =~ m/\/scsi\//) { $rv = 'scsi'; goto done; } elsif ($stuff =~ m/\/message\//) { $rv = 'scsi'; goto done; } elsif ($stuff =~ m/\/block\//) { $rv = 'scsi'; goto done; } } } done: close CMD; return $rv; } ################################################################################ sub read_names() { my @cmd = ('discover'); my @rv = (); open CMD, '-|', @cmd or return @rv; while (my $l = ) { chomp $l; push @rv, $l; } close CMD; return @rv; }