#!/usr/bin/perl -w
#******************************************************************************
#  $Id: edac-ctl 4265 2007-05-07 21:39:23Z grondo $
#******************************************************************************
#  Copyright (C) 2003-2006 The Regents of the University of California.
#  Produced at Lawrence Livermore National Laboratory (cf, DISCLAIMER).
#  Written by Mark Grondona <mgrondona@llnl.gov>
#  UCRL-CODE-230739.
#
#  This file is part of edac-utils.
#
#  This is free software; you can redistribute it and/or modify it
#  under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This is distributed in the hope that it will be useful, but WITHOUT
#  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
#  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
#  for more details.
#
#  You should have received a copy of the GNU General Public License along
#  with this program; if not, write to the Free Software Foundation, Inc.,
#  51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA.
#****************************************************************************/

use strict;
use File::Basename;
use Getopt::Long;

my $dmidecode   = "/usr/sbin/dmidecode";
my $modprobe    = "/sbin/modprobe";
my $lspci       = "/sbin/lspci";

my %conf        = ();
my %bus         = ();
my $prog        = basename $0;
$conf{labeldb}  = "/etc/edac/labels.db";
$conf{driverdb} = "/etc/edac/driver.db";


my $status      = 0;

my $usage       = <<EOF;
Usage: $prog [OPTIONS...]
 --driver           Print name of valid EDAC driver for this HW.
 --mainboard        Print mainboard vendor and model for this hardware.
 --load             Load EDAC drivers.
 --unload           Unload EDAC drivers.
 --status           Print status of EDAC drivers.
 --print-labels     Print Motherboard DIMM labels to stdout.
 --register-labels  Load Motherboard DIMM labels into EDAC driver.
 --labeldb=DB       Load label database from file DB.
 --driverdb=DB      Load driver database from file DB.
 --help             This help message.
EOF


parse_cmdline();

if (  $conf{opt}{mainboard} || $conf{opt}{print_labels} 
   || $conf{opt}{register_labels}) {

    get_mainboard_info();

    if ($conf{opt}{mainboard} eq "report") {
        print "$prog: mainboard: ", 
              "$conf{mainboard}{vendor} $conf{mainboard}{model}\n";
    }

    if ($conf{opt}{print_labels}) { 
        print_dimm_labels ();

    }
    if ($conf{opt}{register_labels}) {
        register_dimm_labels ();
    } 

}

exit (0);

sub parse_cmdline
{
    $conf{opt}{driver} = 0;
    $conf{opt}{mainboard} = '';
    $conf{opt}{print_labels} = 0;
    $conf{opt}{register_labels} = 0;
    $conf{opt}{load} = 0;
    $conf{opt}{unload} = 0;
    $conf{opt}{status} = 0;
    $conf{opt}{quiet} = 0;

    my $rref = \$conf{opt}{report};
    my $mref = \$conf{opt}{mainboard};

    Getopt::Long::Configure ("bundling");
    my $rc = GetOptions ("mainboard:s" =>     sub { $$mref = $_[1]||"report" },
                         "help" =>            sub {usage (0)},
                         "quiet" =>           \$conf{opt}{quiet},
                         "print-labels" =>    \$conf{opt}{print_labels},
                         "register-labels" => \$conf{opt}{register_labels},
                         "labeldb=s" =>       \$conf{labeldb},
                         "driverdb=s" =>      \$conf{driverdb},
                         "driver" =>          \$conf{opt}{driver},
                         "load" =>            \$conf{opt}{load},
                         "unload" =>          \$conf{opt}{unload},
                         "status" =>          \$conf{opt}{status});
        
    usage(1) if !$rc;

    usage (0) if !grep $conf{opt}{$_}, keys %{$conf{opt}}; 

    if ($conf{opt}{status} + $conf{opt}{load} + $conf{opt}{unload} > 1) {
        print STDERR "Specify only one of --status --load or --unload\n";
        usage (1);
    }

}

sub usage
{
    my ($rc) = @_;
    print "$usage\n";
    exit ($rc);
}

sub run_cmd
{
    my @args = @_;
    system ("@args");
    return ($?>>8);
}


sub print_status
{
    my $status = 0;
    open (MODULES, "/proc/modules")
         or die "Unable to open /proc/modules: $!\n";

    while (<MODULES>) {
       $status = 1 if /$conf{driver}_edac/;
    }

    print "$prog: drivers ", ($status ? "are" : "not"), " loaded.\n"
        unless $conf{opt}{quiet};

    return ($status);
}


sub parse_driver_db
{
    my $driver = "";
    open CONF, "< $conf{driverdb}"
         or die "Unable to open driver DB: \"$conf{driverdb}\": $!";
    while (<CONF>) {
        chomp;
        s/#.*$//;
        s/^\s+//;
        s/\s+$//;
        next unless length;

        if (/^Driver\s+(\S+)\s*:/i) {
            $driver = $1;
            next;
        }
        next unless $driver;

        if (my ($vendor, $ids) = /^\s*(\w+)\s*:\s*(.*)/) {
            $vendor =~ s/^0x//;
            $ids    =~ s/0x//g;
            map { $conf{driver}{"$vendor:$_"} = $driver}
               split(/[, ]+/, $ids)
        }
    }
}

sub find_edac_driver
{
    my $cmd = "/sbin/lspci -n";
    my $driver = "";

    parse_driver_db();

    open (LSPCI, "$cmd |") or die "$prog: Unable to run $cmd: $!\n";

    while (<LSPCI>) {
        next unless /^[\d:\.]+ Class \w+: ([0-9a-f]+:[0-9a-f]+)/i;
        (my $key = $1) =~ s/0x//g;
        last if (exists $conf{driver}{$key} && ($driver = $conf{driver}{$key}));
    }
    close (LSPCI) or warn "$prog: $cmd exited with $?\n";

    return $driver;
}



sub get_mainboard_info {
    my ($vendor, $model);

    if ($conf{opt}{mainboard} && $conf{opt}{mainboard} ne "report") {
        ($vendor, $model) = split (/[: ]/, $conf{opt}{mainboard}, 2);
    }

    if (!$vendor || !$model) {
        ($vendor, $model) = guess_vendor_model ();
    }
    
    $conf{mainboard}{vendor} = $vendor;
    $conf{mainboard}{model}  = $model;
}

sub guess_vendor_model {
    my ($vendor, $model);
    my $line = 0;

    $< == 0 || die "Must be root to run dmidecode\n";

    open (DMI, "$dmidecode |") or die "failed to run $dmidecode: $!\n";

    $vendor = $model = "";

  LINE:
    while (<DMI>) {
        $line++;

        /^(\s*)(system|board) information/i || next LINE;
        my $indent = $1;

        while ( <DMI> ) {
            /^(\s*)/;
            $1 lt $indent && last LINE;
            $indent = $1;
            /(?:manufacturer|vendor):\s*(.*\S)\s*/i && ( $vendor = $1 );
	        /product(?: name)?:\s*(.*\S)\s*/i       && ( $model  = $1 );
            last LINE if ($vendor && $model);
	    }
	}

    close (DMI);
    return ($vendor, $model);
}


sub parse_dimm_labels
{
    my %labels = ();
    my $line = -1;
    my $vendor = "";
    my @models = ();
    my $file = $conf{labeldb};

    open (LABELS, "$file") 
        or die "Unable to open label database: $file: $!\n";

    while (<LABELS>) {
        $line++;
        next if /^#/;
        chomp; 
        s/^\s+//;
        s/\s+$//;
        next unless length;

        if (/vendor\s*:\s*(.*\S)\s*/i) {
            $vendor = lc $1;
            @models = ();
            next;
        }
        if (/(model|board)\s*:\s*(.*)$/i) {
            !$vendor && die "$file: line $line: MB model without vendor\n";
            @models = split(/,[\ ]*/, lc $2);
            next;
        }

        # Allow multiple labels to be specified on a single line, 
        #  separated by ;
        for my $str (split /;/) {
            $str =~ s/^\s*(.*)\s*$/$1/;

            next unless (my ($label, $info) = ($str =~ /^(.*)\s*:\s*(.*)$/i));

            unless ($info =~ /(\d\.\d\.\d,*)+/) {
                print STDERR "$file: $line: Invalid syntax, ignoring: \"$_\"\n";
                next;
            }

            for my $target (split (/[, ]+/, $info)) {
                my ($mc, $row, $chan) = ($target =~ /(\d+)\.(\d+)\.(\d+)/);

                map { $labels{$vendor}{lc $_}{$mc}{$row}{$chan} = $label } 
                         @models;

            }
        }
    }

    close (LABELS) or die "Error from label db \"$file\" : $!\n";

    return \%labels
}

sub read_dimm_label
{
    my ($mc, $row, $chan) = @_;
    my $sysfs = "/sys/devices/system/edac/mc";

    my $file = "$sysfs/mc$mc/csrow$row/ch${chan}_dimm_label";

    return ("Missing") unless -f $file;

    if (!open (LABEL, "$file")) {
        warn "Failed to open $file: $!\n";
        return ("Error");
    }

    chomp (my $label = <LABEL> || "");

    close (LABEL);

    return ($label);
}

sub print_dimm_labels
{
    my $fh = shift || *STDOUT;
    my $lref = parse_dimm_labels ();
    my $vendor = lc $conf{mainboard}{vendor};
    my $model  = lc $conf{mainboard}{model};
    my $format = "%-35s %-20s %-20s\n";

    if (!exists $$lref{$vendor}{$model}) {
        print STDERR "No dimm labels for $conf{mainboard}{vendor} " .
                     "$conf{mainboard}{model} \n";
        return;
    }

    
    printf $fh $format, "LOCATION", "CONFIGURED LABEL", "SYSFS CONTENTS";

    for my $mc (sort keys %{$$lref{$vendor}{$model}}) {
        for my $row (sort keys %{$$lref{$vendor}{$model}{$mc}}) {
            for my $chan (sort keys %{$$lref{$vendor}{$model}{$mc}{$row}}) {

                my $label = $$lref{$vendor}{$model}{$mc}{$row}{$chan};
                my $rlabel = read_dimm_label ($mc, $row, $chan);
                my $loc = "mc$mc/csrow$row/ch${chan}_dimm_label";

                printf $fh $format, $loc, $label, $rlabel;
            }
        }
    }
    print $fh "\n";

}

sub register_dimm_labels
{
    my $lref = parse_dimm_labels ();
    my $vendor = lc $conf{mainboard}{vendor};
    my $model  = lc $conf{mainboard}{model};
    my $sysfs  = "/sys/devices/system/edac/mc";

    if (!exists $$lref{$vendor}{$model}) {
        print STDERR "No dimm labels for $conf{mainboard}{vendor} " .
                                        "$conf{mainboard}{model} \n";
        return;
    }

    for my $mc (sort keys %{$$lref{$vendor}{$model}}) {
        for my $row (sort keys %{$$lref{$vendor}{$model}{$mc}}) {
            for my $chan (sort keys %{$$lref{$vendor}{$model}{$mc}{$row}}) {

                my $file = "$sysfs/mc$mc/csrow$row/ch${chan}_dimm_label";

                # Ignore sysfs files that don't exist. Might just be
                #  unpopulated bank.
                next unless -f $file;

                if (!open (DL, ">$file")) {
                    warn ("Unable to open $file\n");
                    next;
                }

                syswrite DL, $$lref{$vendor}{$model}{$mc}{$row}{$chan};

                close (DL);

            }
        }
    }
}



# vi: ts=4 sw=4 expandtab
