#!/usr/bin/perl
#Name:    map_hardware_to_drivers.pl
#version: 1.0.0
#Date:    2020-03-12
#Author:  David Mathog
#
#  Map the pci hardware list to drivers for the running kernel
#
#  assumes wget, lspci, and access to the internet are available
#  If access is not available specify one parameter to the already downloaded
#  PCI IDs file.
#
#
use strict;
use warnings;
my $IDLIST="https://pci-ids.ucw.cz/v2.2/pci.ids";
my $real_filename="/tmp/pci.ids";
my $kernel=`uname -r`;
chomp $kernel;
my $MODALIAS="/lib/modules/$kernel/modules.alias";
my %dev_hash_longname;
my %dev_hash_module;
my %pci_hash_builtin;
my $count=0;
my $vendor="";
my $device="";
my $long_name="";
my $module_name="";
my $pci_id;
my $dev_id;
my $ignore;

my $num_args = $#ARGV;
if ($num_args != 0) {
    print 
     "Usage: map_hardware_to_drivers.pl PciIDsFile\n\n",
     "If internet access is available let PciIDsFile = \"-\" and it will be downloaded\n",
     "automatically.  Otherwise on some machine do:\n\n",
     "   wget -O PciIDsFile $IDLIST\n\n",
     "Then copy that file by some means to the target and specify\n",
     "the file name on the command line.\n";
    exit;
}
my $filename=$ARGV[0];



if($filename eq '-'){
   my $messages = `wget -q -O $real_filename $IDLIST 2>/dev/null`;
   if($messages){
      print
        "Some problem running:\n\n",
        "  wget -q -O $real_filename 2>/dev/null\n\n",
	"returned:\n",
	"$messages\n";
      exit;
   }
}
else {
   $real_filename = $filename;
}

#######################
open(FH, $real_filename) or die "could not open file $real_filename";

print "Checking this machine for drivers\n";
print "Getting Device ID list from $IDLIST\n";
# Syntax in this file:
#   #comment line
#   <blank lines>
#   vendor  vendor_name
#	device  device_name				<-- single tab
#		subvendor subdevice  subsystem_name	<-- two tabs
#   Only the vendor and device lines are retained
#(This will obtain all PCI ID -> long name mappings even if the current kernel does
#not have the information.)
while (my $line = <FH>){
    chomp $line;
    if(! $line){ next; }
    if(substr($line,0,1) eq "#"){ next; }
    if(substr($line,0,2) eq "\t\t"){ next; }
    if(substr($line,0,1) eq "\t"){ #device line
       $device = substr($line,1,4);
       $long_name = substr($line,7);
       $dev_id = $vendor . ":" . uc $device;
       $dev_hash_longname{$dev_id} = $long_name;
    }
    else { #vendor line
       $vendor = uc substr($line,0,4);
    }
}
close(FH);
#       my ($dev_type, $dev_id, $dev_driver) = split(/\s+/,$line);

#print "Getting pci IDs and long names from lspci\n";
#foreach my $line (`lspci`){
#    chomp $line;
#    my $starts = index($line," ");
#    my $pci_id = uc substr($line,0,$starts);
#    my $ln = substr($line,$starts+1);
#    $dev_hash_longname{$pci_id}=$ln;
#}

#######################
# get all the PCI ID to builtin mappings.
print "Getting PCI ID to builtin mappings from /sys/bus/pci/drivers\n";
foreach my $line (`find /sys/bus/pci/drivers`){
    chomp $line;
    my $starts = index($line,"/0000:");
    if($starts != -1){
       my $pci_id = uc substr($line,$starts + 6);
       my $delim = rindex(substr($line,0,$starts-1),"/");
       my $driver= substr($line,$delim+1,$starts - $delim -1);
#       print "pci_id >$pci_id< driver >$driver<\n";
       $pci_hash_builtin{$pci_id}=$driver . "(builtin)";
    }
}

#######################
# get all the PCI ID to module name mappings.  Ignore subvendor and subdevice information.
# This uses the "alias pci:" lines which have the syntax:
#   alias pci:vVENDORdDEVICEsvSUBVENDORsdSUBDEVICEscIGNOREiIGNORE module_name
# extract the VENDOR and DEVICE files to construct a PCI ID like 1234:ABCD
# Use that to store the module_name value in a hash.
#

open(FH, $MODALIAS) or die "could not open file $MODALIAS";
print "Getting PCI ID to kernel module name mappings";

my $next_delim;
while (my $line = <FH>){
    chomp $line;
    if(substr($line,0,10) eq 'alias pci:'){
#       print "line: $line\n";
       if(substr($line,11,1) eq "*"){ next; }
       $next_delim=index($line,"d",11);
       if($next_delim == -1){ die "File $MODALIAS has pci: line with unexpected syntax: $line"; }
       $vendor = substr($line,15,4);
       $next_delim=index($line,"sv",20);
       if($next_delim == -1){ die("File $MODALIAS has pci: line with unexpected syntax: $line"); }
       $device = substr($line,24,4);
       $dev_id = $vendor . ":" . $device;
       $next_delim=index($line," ",28);
       if($next_delim == -1){ die "File $MODALIAS has pci: line with unexpected syntax: $line"; }
       $module_name = substr($line,$next_delim + 1);
       if(defined($dev_hash_module{$dev_id})){ next; } #subvendor/subdevice lines
       $dev_hash_module{$dev_id} = $module_name . "(module)";
       $count++;
#       print "  parsed $dev_id $module_name\n";
    }
}
close(FH);

print "Checking pci and device IDs from lspci -n\n";
print "pci_id  dev_id    driver description\n";
foreach my $line (`lspci -n`){
    chomp $line;
    ($pci_id, $ignore, $dev_id)= split /\s/,$line;
    $dev_id = uc $dev_id;
    my $description = (defined($dev_hash_longname{$dev_id}) ? $dev_hash_longname{$dev_id} : "unknown");
    my $module = (defined($dev_hash_module{$dev_id}) ? $dev_hash_module{$dev_id} : "");
    my $builtin = (defined($pci_hash_builtin{$pci_id}) ? $pci_hash_builtin{$pci_id} : "");
    if(!$module){
       if($builtin){
          $module = $builtin;
       }
       else {
          $module = "<none>";
       }
    }
    else {
       if($builtin){
          $module .= "/" . $builtin;
       }
    }
    print "$pci_id $dev_id $module \"$description\"\n";
}
if($filename eq "-"){
   unlink($real_filename);
}
print "Done\n";