File Coverage

blib/lib/FusionInventory/Agent/Tools/Generic.pm

Criterion	Covered	Total	%
statement	18	114	15.7
branch	0	84	0.0
condition	0	30	0.0
subroutine	6	17	35.2
pod	7	7	100.0
total	31	252	12.3

package FusionInventory::Agent::Tools::Generic;

use strict;
use warnings;
use base 'Exporter';

use English qw(-no_match_vars);
use Memoize;

use FusionInventory::Agent::Tools;

our @EXPORT = qw(
    getDmidecodeInfos
    getCpusFromDmidecode
    getHdparmInfo
    getPCIDevices
    getPCIDeviceVendor
    getPCIDeviceClass
    getUSBDeviceVendor
    getUSBDeviceClass
    getEDIDVendor
);

my $PCIVendors;
my $PCIClasses;
my $USBVendors;
my $USBClasses;
my $EDIDVendors;

memoize('getDmidecodeInfos');
memoize('getPCIDevices');

sub getDmidecodeInfos {
    my (%params) = (
        command => 'dmidecode',
        @_
    );

    my $handle = getFileHandle(%params);
    return unless $handle;
    my ($info, $block, $type);

    while (my $line = <$handle>) {
        chomp $line;

        if ($line =~ /DMI type (\d+)/) {
            # start of block

            # push previous block in list
            if ($block) {
                push(@{$info->{$type}}, $block);
                undef $block;
            }

            # switch type
            $type = $1;

            next;
        }

        next unless defined $type;

        next unless $line =~ /^\s+ ([^:]+) : \s (.*\S)/x;

        next if
            $2 eq 'N/A'                        ||
            $2 eq 'Not Specified'              ||
            $2 eq 'Not Present'                ||
            $2 eq 'Unknown'                    ||
            $2 eq ''                ||
            $2 eq ''              ||
            $2 eq '' ;

        $block->{$1} = trimWhitespace($2);
    }
    close $handle;

    # do not return anything if dmidecode output is obviously truncated
    return if keys %$info < 2;

    return $info;
}

sub getCpusFromDmidecode {
    my $infos = getDmidecodeInfos(@_);

    return unless $infos->{4};

    my @cpus;
    foreach my $info (@{$infos->{4}}) {
        next if $info->{Status} && $info->{Status} =~ /Unpopulated|Disabled/i;

        my $manufacturer = $info->{'Manufacturer'} ||
                           $info->{'Processor Manufacturer'};
        my $version      = $info->{'Version'} ||
                           $info->{'Processor Version'};

        # VMware
        next if
            ($manufacturer && $manufacturer eq '000000000000') &&
            ($version      && $version eq '00000000000000000000000000000000');

        my $cpu = {
            SERIAL       => $info->{'Serial Number'},
            ID           => $info->{ID},
            CORE         => $info->{'Core Count'} || $info->{'Core Enabled'},
            THREAD       => $info->{'Thread Count'},
            FAMILYNAME   => $info->{'Family'},
            MANUFACTURER => $manufacturer
        };
        $cpu->{NAME} =
            ($cpu->{MANUFACTURER} =~ /Intel/ ? $info->{'Family'} : undef) ||
            $info->{'Version'}                                     ||
            $info->{'Processor Family'}                            ||
            $info->{'Processor Version'};

       if ($cpu->{ID}) {

            # Split CPUID to get access to its content
            my @id = split ("",$cpu->{ID});
            # convert hexadecimal value
            $cpu->{STEPPING} = hex $id[1];
            # family number is composed of 3 hexadecimal number
            $cpu->{FAMILYNUMBER} = hex $id[9] . $id[10] . $id[4];
            $cpu->{MODEL} = hex $id[7] . $id[0];
        }

        if ($info->{Version}) {
            if ($info->{Version} =~ /([\d\.]+)MHz$/) {
                $cpu->{SPEED} = $1;
            } elsif ($info->{Version} =~ /([\d\.]+)GHz$/) {
                $cpu->{SPEED} = $1 * 1000;
            }
        }
        if (!$cpu->{SPEED} && $info->{'Max Speed'}) {
            # We only look for 3 digit Mhz frequency to avoid abvious bad
            # value like 30000 (#633)
            if ($info->{'Max Speed'} =~ /^\s*(\d{3,4})\s*Mhz/i) {
                $cpu->{SPEED} = $1;
            } elsif ($info->{'Max Speed'} =~ /^\s*(\d+)\s*Ghz/i) {
                $cpu->{SPEED} = $1 * 1000;
            }
        }
        if (!$cpu->{SPEED} && $info->{'Current Speed'}) {
            if ($info->{'Current Speed'} =~ /^\s*(\d{3,4})\s*Mhz/i) {
                $cpu->{SPEED} = $1;
            } elsif ($info->{'Current Speed'} =~ /^\s*(\d+)\s*Ghz/i) {
                $cpu->{SPEED} = $1 * 1000;
            }
        }

        if ($info->{'External Clock'}) {
            if ($info->{'External Clock'} =~ /^\s*(\d+)\s*Mhz/i) {
                $cpu->{EXTERNAL_CLOCK} = $1;
            } elsif ($info->{'External Clock'} =~ /^\s*(\d+)\s*Ghz/i) {
                $cpu->{EXTERNAL_CLOCK} = $1 * 1000;
            }
        }

        push @cpus, $cpu;
    }

    return @cpus;
}

sub getHdparmInfo {
    my (%params) = @_;

    my $handle = getFileHandle(
        %params,
        command => $params{device} ? "hdparm -I $params{device}" : undef,
    );
    return unless $handle;

    my $info;
    while (my $line = <$handle>) {
        $info->{model}     = $1 if $line =~ /Model Number:\s+(\S.+\S)/;
        $info->{firmware}  = $1 if $line =~ /Firmware Revision:\s+(\S+)/;
        $info->{serial}    = $1 if $line =~ /Serial Number:\s+(\S*)/;
        $info->{size}      = $1 if $line =~ /1000:\s+(\d*)\sMBytes/;
        $info->{transport} = $1 if $line =~ /Transport:.+(SCSI|SATA|USB)/;
        $info->{wwn}       = $1 if $line =~ /WWN Device Identifier:\s+(\S+)/;
    }
    close $handle;

    return $info;
}

sub getPCIDevices {
    my (%params) = (
        command => 'lspci -v -nn',
        @_
    );
    my $handle = getFileHandle(%params);

    my (@controllers, $controller);

    while (my $line = <$handle>) {
        chomp $line;

        if ($line =~ /^
            (\S+) \s                     # slot
            ([^[]+) \s                   # name
            \[([a-f\d]+)\]: \s           # class
            (\S.+) \s                   # manufacturer
            \[([a-f\d]+:[a-f\d]+)\]      # id
            (?:\s \(rev \s (\d+)\))?     # optional version
            /x) {

            $controller = {
                PCISLOT      => $1,
                NAME         => $2,
                PCICLASS     => $3,
                MANUFACTURER => $4,
                PCIID        => $5,
                REV          => $6
            };
            next;
        }

        next unless defined $controller;

        if ($line =~ /^$/) {
            push(@controllers, $controller);
            undef $controller;
        } elsif ($line =~ /^\tKernel driver in use: (\w+)/) {
            $controller->{DRIVER} = $1;
        } elsif ($line =~ /^\tSubsystem: ([a-f\d]{4}:[a-f\d]{4})/) {
            $controller->{PCISUBSYSTEMID} = $1;
        }
    }

    close $handle;

    return @controllers;
}

sub getPCIDeviceVendor {
    my (%params) = @_;

    _loadPCIDatabase(%params) if !$PCIVendors;

    return unless $params{id};
    return $PCIVendors->{$params{id}};
}

sub getPCIDeviceClass {
    my (%params) = @_;

    _loadPCIDatabase(%params) if !$PCIClasses;

    return unless $params{id};
    return $PCIClasses->{$params{id}};
}

sub getUSBDeviceVendor {
    my (%params) = @_;

    _loadUSBDatabase(%params) if !$USBVendors;

    return unless $params{id};
    return $USBVendors->{$params{id}};
}

sub getUSBDeviceClass {
    my (%params) = @_;

    _loadUSBDatabase(%params) if !$USBClasses;

    return unless $params{id};
    return $USBClasses->{$params{id}};
}

sub getEDIDVendor {
    my (%params) = @_;

    _loadEDIDDatabase(%params) if !$EDIDVendors;

    return unless $params{id};
    return $EDIDVendors->{$params{id}};
}

sub _loadPCIDatabase {
    my (%params) = @_;

    ($PCIVendors, $PCIClasses) = _loadDatabase(
        file => "$params{datadir}/pci.ids"
    );
}

sub _loadUSBDatabase {
    my (%params) = @_;

    ($USBVendors, $USBClasses) = _loadDatabase(
        file => "$params{datadir}/usb.ids"
    );
}

sub _loadDatabase {
    my $handle = getFileHandle(@_);
    return unless $handle;

    my ($vendors, $classes);
    my ($vendor_id, $device_id, $class_id);
    while (my $line = <$handle>) {

        if ($line =~ /^\t (\S{4}) \s+ (.*)/x) {
            # Device ID
            $device_id = $1;
            $vendors->{$vendor_id}->{devices}->{$device_id}->{name} = $2;
        } elsif ($line =~ /^\t\t (\S{4}) \s+ (\S{4}) \s+ (.*)/x) {
            # Subdevice ID
            my $subdevice_id = "$1:$2";
            $vendors->{$vendor_id}->{devices}->{$device_id}->{subdevices}->{$subdevice_id}->{name} = $3;
        } elsif ($line =~ /^(\S{4}) \s+ (.*)/x) {
            # Vendor ID
            $vendor_id = $1;
            $vendors->{$vendor_id}->{name} = $2;
        } elsif ($line =~ /^C \s+ (\S{2}) \s+ (.*)/x) {
            # Class ID
            $class_id = $1;
            $classes->{$class_id}->{name} = $2;
        } elsif ($line =~ /^\t (\S{2}) \s+ (.*)/x) {
            # SubClass ID
            my $subclass_id = $1;
            $classes->{$class_id}->{subclasses}->{$subclass_id}->{name} = $2;
        }
    }
    close $handle;

    return ($vendors, $classes);
}


sub _loadEDIDDatabase {
    my (%params) = @_;

    my $handle = getFileHandle(file => "$params{datadir}/edid.ids");
    return unless $handle;

    foreach my $line (<$handle>) {
       next unless $line =~ /^([A-Z]{3}) __ (.*)$/;
       $EDIDVendors->{$1} = $2;
   }

   return;
}

1;
__END__