#! /usr/bin/perl -w
# Author: Ton Hospel
# Gnu copyleft
use 5.006;
use strict;
use Getopt::Long;
use Config::General;
# use Data::Dumper;

my $VERSION = "0.05";

&Getopt::Long::config("bundling", "require_order");
my $sys_mount   = "/sys";
my $config_file = "/etc/psensors.conf";
my $alarm       = "ALARM";
# Old version when files were called things like in_input0
# my $input_format = "%s%s_input%d";
# New version when files are  called things like in0_input
my $input_format = "%s%s%d_input";
my ($version, $unsafe, $help, $mount);
GetOptions("file=s"	=> \$config_file,
           "f=s"	=> \$config_file,
           "mount=s"	=> \$mount,
           "m=s"	=> \$mount,
           "version!"	=> \$version,
           "unsafe!"	=> \$unsafe,
           "U"		=> \$unsafe,
           "help!"	=> \$help,
           "h"		=> \$help) || die "Could not parse your command line";

if ($version) {
    print<<"EOF";
psensors (Ton Utils) $VERSION
EOF
    exit 0;
}
if ($help) {
    require Config;
    $ENV{PATH} .= ":" unless $ENV{PATH} eq "";
    $ENV{PATH} = "$ENV{PATH}$Config::Config{'installscript'}";
    exec("perldoc", "-F", $unsafe ? "-U" : (), $0) || exit 1;
    # make parser happy
    %Config::Config = ();
}

die "$0 (currently) doesn't take arguments\n" if @ARGV;

my %sensor_unit =
    (in   => [1/1000, "%6.2f V"],
     temp => [1/1000, "%6.2f°C"],
     cur  => [1/1000, "%6.2f A"],
     fan  => [1,      "%4d RPM"],
     fan_div  => [1,  "%3d     "],
     );

sub get_line {
    my $file = shift;
    open(my $fh, "<", $file) || die "Could not open $file: $!";
    defined (my $line = <$fh>) || die "unexpected EOF reading from $file";
    defined(<$fh>) && die "Unexpected extra lines in $file";
    chomp($line);
    return $line;
}

sub i2c_devices {
    my @devices;
    my $dir = $sys_mount;
    $dir =~ s|/*\z|/bus/i2c/devices/|;
    opendir(my $dhandle, $dir) || die "could not open $dir: $!\n";
    while (defined(my $f = readdir($dhandle))) {
        push @devices, {
            name	=> get_line("$dir$f/name"),
            container	=> get_line("$dir$f/../name"),
            id		=> $f,
            dir		=> "$dir$f/",
        } unless $f eq "." || $f eq "..";
    }
    return \@devices;
}

# For the moment only bother with linear formulas
sub coef {
    my $formula = shift;
    my $value = 0;
    my $y0 = eval $formula;
    $value = 1e6;
    my $div = eval($formula)-$y0 ||
        die "Formula $formula is a constant or not linear\n";
    $value /= $div;
    return [$value, -$value*$y0]
}

{
    my %coef;

    sub invert {
        my ($formula, $value) = @_;
        return $value if $formula eq "";
        my $coef = $coef{$formula} ||= coef($formula);
        return $coef->[1]*$value + $coef->[0];
    }
}

{
    my $expression;
    $expression = qr{\s*-?(?:\((??{$expression})\)|\d+(?:\.\d*)?|\@)\s*(?:[*/+-](??{$expression}))*};

    sub evaluate {
        return undef unless defined(my $str = shift);
        return "" if $str eq "";
        $str =~ /^$expression$/ ||
            die "'$str' is not a valid expression\n";
        if ($str =~ /\@/) {
            die "Unexpected \@ placeholder\n" unless shift;
            $str =~ s/\@/\$value/g;
            return $str;
        } else {
            die "No \@ placeholder\n" if shift;
            return eval $str;
        }
    }
}

# Remove a string from $hash
sub get_string {
    my ($hash, $name, $default, $override) = @_;
    if (defined(my $str = delete $hash->{$name})) {
        ref($str) eq "" ||
            die "The value for '$name' is a reference, not a string\n";
        return $override && defined($default) ? $default : $str;
    }
    die "Missing mandatory option '$name'\n" if @_ < 3;
    return $default;
}

# Remove an evaluated formula from $hash
sub get_value {
    my ($hash, $name, $default, $override) = @_;
    if (defined(my $str = delete $hash->{$name})) {
        ref($str) eq "" ||
            die "The value for '$name' is a reference, not a numeric value\n";
        return evaluate($override && defined($default) ? $default : $str);
    }
    die "Missing mandatory option '$name'\n" if @_ < 3;
    return evaluate($default);
}

# Remove an unevaluated formula from $hash
sub get_formula {
    my ($hash, $name, $default, $override) = @_;
    if (defined(my $str = delete $hash->{$name})) {
        ref($str) eq "" ||
            die "The value for '$name' is a reference, not a formula\n";
        return evaluate($override && defined($default) ? $default : $str, 1);
    }
    die "Missing mandatory option '$name'\n" if @_ < 3;
    return evaluate($default, 1);
}

# Remove a hash reference from $hash
sub get_hash {
    my ($hash, $name, $default) = @_;
    if (defined(my $h = delete $hash->{$name})) {
        ref($h) eq "HASH" || die "The value for '$name' is '$h', not a hash\n";
        return $h;
    }
    die "Missing mandatory option '$name'\n" if @_ < 3;
    return $default;
}

# parse a <SENSOR> section
sub parse_sensors {
    my $sensors = shift;
    my (%sensors, $error);
    for my $sensor (keys %$sensors) {
        eval {
            my $options = $sensors->{$sensor};
            my %options;

            $options{formula} = get_formula($options, "compute", "");
            $options{hyst}    = get_value($options, "hysteresis", undef);
            $options{div}     = get_value($options, "divisor", undef);
            $options{min}     = get_value($options, "min", undef);
            $options{max}     = get_value($options, "max", undef);
            if (defined($options{max})) {
                die "Minimum $options{min} is actually bigger than maximum $options{max}\n" if defined($options{min}) && $options{min} > $options{max};
                die "Hysteresis $options{hyst} is actually bigger than maximum $options{max}\n" if defined($options{hyst}) && $options{hyst} > $options{max};
            }
            $options{label}   = get_string($options, "label", $sensor);

            die "Unknown option(s): ", join(",", keys %$options),"\n"
                if %$options;
            $sensors{$sensor} = \%options;
        };
        $error .= "sensor '$sensor': $@" if $@;
    }
    die $error if $error;
    return \%sensors;
}

# parse a <CHIP> section
sub parse_chips {
    my $chips = shift;
    my (%chips, $error);
    for my $chip (keys %$chips) {
        eval {
            my $options = $chips->{$chip};
            my %options;

            $options{sensor} = parse_sensors(get_hash($options, "sensor", {}));

            die "Unknown option(s): ", join(",", keys %$options),"\n"
                if %$options;
            $chips{$chip} = \%options;
        };
        $error .= "chip '$chip': $@" if $@;
    }
    die $error if $error;
    return \%chips;
}

# parse <Group> section
sub parse_groups {
    my $groups = shift;
    my $error;
    for my $group (keys %$groups) {
        eval {
            my $options = $groups->{$group};
            my @options = ($sensor_unit{$group}[0] || 1, 
                           $sensor_unit{$group}[1] || "%3d     ");
            $options[0] = get_value( $options, "factor", $options[0]);
            $options[1] = get_string($options, "format", $options[1]);
            $sensor_unit{$group} = \@options;
        };
        $error .= "group '$group': $@" if $@;
    }
    die $error if $error;
}

# Display the stats for $device as configured by $conf
sub show {
    my ($device, $conf) = @_;

    print "Chip: $device->{name} in $device->{container}\n";
    my $dir = $device->{dir};
    my $sensors = $conf->{sensor};
    # 5 = 1 current + 4 possible attributes
    my @len = (0)    x 5;
    my @end = (1e50) x 5;
    for (keys %$sensors) {
        my $sensor = $sensors->{$_};
        if (my ($name, $num) = /^([a-z]+)_(\d+)$/i) {
            my $unit = $sensor_unit{$name} ||
                die "Unknown sensor type $name\n";
            my $value = get_line(sprintf($input_format, $dir, $name, $num)) * $unit->[0];
            $value = eval $sensor->{formula} if $sensor->{formula} ne "";
            $sensor->{val}[0] = ["$sensor->{label}: ",
                                 sprintf($unit->[1], $value) ];
            if (defined $sensor->{min}) {
                push @{$sensor->{val}}, ["min= ",
                                         sprintf($unit->[1], $sensor->{min})];
                $sensor->{alarm}++ if $value < $sensor->{min};
            }
            if (defined $sensor->{hyst}) {
                push @{$sensor->{val}}, ["hyst.= ",
                                         sprintf($unit->[1], $sensor->{hyst})];
            }
            if (defined $sensor->{max}) {
                push @{$sensor->{val}}, ["max= ",
                                         sprintf($unit->[1], $sensor->{max})];
                $sensor->{alarm}++ if $value > $sensor->{max};
            }
            if (defined $sensor->{div}) {
                push @{$sensor->{val}},
                ["div= ", sprintf($sensor_unit{fan_div}[1],
                                  $sensor->{div} * $sensor_unit{fan_div}[0])];
            }
            if (@{$sensor->{val}} > 1) {
                $sensor->{val}[1][0] = "($sensor->{val}[1][0]";
                $sensor->{val}[$_][1] =~ s/(\s*)$/$1,/ for
                    1..$#{$sensor->{val}}-1;
                $sensor->{val}[-1][1] =~ s/(\s*)$/\)$1/;
            }
            for (0..$#{$sensor->{val}}) {
                $sensor->{val}[$_][1] =~ s/^\s*//;
                my $l = length($sensor->{val}[$_][0])+
                    length($sensor->{val}[$_][1]);
                $len[$_] = $l if $len[$_] < $l;
                $sensor->{val}[$_][1] =~ /\s*\z/;
                $end[$_] = $+[0]-$-[0] if $+[0]-$-[0] < $end[$_];
            }
        } else {
            die "Unhandled sensor type '$_'\n";
        }
    }

    my $format = "   ";	# Initial indent -1
    for (0..$#len) {
        my $l = $len[$_]-$end[$_];
        $format .= $l > 0 ? " %-.${l}s" : "%.0s";
    }
    $format .= "%s\n";	# The ALARM string

    my $last = "";
    for (sort keys %$sensors) {
        /^([a-z]+)/;
        if ($1 ne $last) {
            print "\n" if $last;
            $last = $1;
        }
        my $sensor = $sensors->{$_};
        my $val = $sensor->{val};
        printf($format,
               map({
                   if ($val->[$_]) {
                       my $spaces = " " x ($len[$_]-
                                           length($val->[$_][0])-
                                           length($val->[$_][1]));
                       "$val->[$_][0]$spaces$val->[$_][1]";
                   } else {
                       "";
                   }
               } 0..$#len),
               $sensor->{alarm} ? " $alarm" : "");
    }
}

my $config = eval {
  Config::General->new
      (-file			=> $config_file,
       -LowerCaseNames		=> "yes",
       -AllowMultiOptions	=> "no",
       -IncludeRelative		=> "yes",
       -UseApacheInclude	=> "yes");
};
if ($@) {
    $@ =~ s/\n at .*\n\z/\nTry $0 -h for help\n/;
    die $@;
}
my %args = $config->getall;
$alarm = get_string(\%args, "alarmstring", $alarm);
my $chips  = parse_chips(get_hash(\%args, "chip", {}));
parse_groups(get_hash(\%args, "group", {}));
$sys_mount = defined($mount) ? $mount :
    get_string(\%args, "sysmount", $sys_mount);
die "Unknown option(s): ", join(",", keys %args), "\n" if %args;

my $devices = i2c_devices;
die "No i2c devices found\n" unless @$devices;

my $matches = 0;
for my $chip (keys %$chips) {
    my $match = $chip;
    $match =~ s/(\W)/$1 eq "*" ? ".*" : $1 eq "?" ? "." : "\\$1"/eg;
    $match = qr/^$match$/i;
    # print "Match=$match\n";
    for (@$devices) {
        if ($_->{name} =~ $match) {
            show($_, $chips->{$chip});
            $matches++;
        }
    }
}
die("None of the i2c devices (",
    join(", ", map $_->{name}, @$devices),
    ") has a matching config entry in $config_file\n") unless $matches;

__END__

=head1 NAME

psensors - Reporting sensors information on Linux using sysfs

=head1 SYNOPSIS

    psensors [-f config_file] [--file config_file] [-m mount_point] [--mount mount_point]
    psensors --version
    psensors [-U] [--unsafe] [-h] [--help]

=head1 OPTIONS

=over 4

=item -f config_file, --file config_file

Use the given file as config file. Default is F</etc/psensors.conf>

=item -m mount_point, --mount mount_point

Assume sys is mounted on mount_point. Defaults to F</sys>.
If explicitely given, it will override any entry in the configuration file.

=item  -h, --help

Show this help.

=item -U, --unsafe

Allow even root to run the perldoc.
Remember, the reason this is off by default is because it B<IS> unsafe.

=item --version

Print version info.

=back

=head1 EXAMPLE CONFIGURATION FILE

 # Elite's K7s5a mainboard
 #<GROUP in>
 #   format "%8.2f V"
 #</GROUP>
 <CHIP it87>
     <Sensor in_0>
 	Label VCore
 	Min  1.75*0.95
 	Max  1.75*1.05
     </Sensor>
     <Sensor in_1>
 	Label Vcc+2.5V
 	Min  2.4
 	Max  2.6
     </Sensor>
     <Sensor in_2>
 	Label Vcc+3.3V
 	Min  3.3*0.95
 	Max  3.3*1.05
     </Sensor>
     <Sensor in_3>
 	Label + 5V
 	Min  5.0*0.95
 	Max  5.0*1.05
 	Compute ((6.8/10)+1)*@
     </Sensor>
     <Sensor in_4>
 	Label +12V
 	Min  12*0.95
 	Max  12*1.05
 	Compute ((30/10)+1)*@
     </Sensor>
     <Sensor in_5>
 	Label -12V
 	Max  -12*0.95
 	Min  -12*1.05
 	Compute -(36/10)*@
     </Sensor>
     <Sensor in_6>
 	Label - 5V
 	Max  -5*0.95
 	Min  -5*1.05
 	Compute -(56/10)*@
     </Sensor>
     <Sensor in_7>
 	Label SB 5V
 	Min  5*0.95
 	Max  5*1.05
 	Compute ((6.8/10)+1)*@
     </Sensor>
     <Sensor in_8>
 	Label V battery
 	Min  3.3*0.95
 	Max  3.3*1.05
     </Sensor>

     <Sensor temp_1>
 	Label System
 	Hysteresis	35
 	Max  40
     </Sensor>
     <Sensor temp_3>
 	Label CPU
 	Hysteresis	55
 	Max  75
     </Sensor>

     <Sensor fan_1>
 	Label CPU fan
 	Min  3000
 	Divisor  2
     </Sensor>
 </CHIP>

Which on my system can cause running F<psensors> to output:

 Chip it87
    CPU fan: 4115 RPM (min=  3000 RPM, div=   2)

    VCore:     1.74 V (min=    1.66 V, max=   1.84 V)
    Vcc+2.5V:  2.48 V (min=    2.40 V, max=   2.60 V)
    Vcc+3.3V:  3.23 V (min=    3.13 V, max=   3.46 V)
    + 5V:      4.91 V (min=    4.75 V, max=   5.25 V)
    +12V:     11.68 V (min=   11.40 V, max=  12.60 V)
    -12V:    -12.20 V (min=  -12.60 V, max= -11.40 V)
    - 5V:     -4.98 V (min=   -5.25 V, max=  -4.75 V)
    SB 5V:     4.94 V (min=    4.75 V, max=   5.25 V)
    V battery: 3.37 V (min=    3.13 V, max=   3.46 V)

    System:   33.00°C (hyst.= 35.00°C, max=  40.00°C)
    CPU:      46.00°C (hyst.= 55.00°C, max=  75.00°C)

=head1 CONFIGURATION FILE

The configuration file is read using the L<Config::General|Config::General>
perl module, whose exact format is described in the
L<config file format section|Config::General/"CONFIG FILE FORMAT">. Look
there for all the possible ways to specify things.

Basically it is the well known apache format.

Sections get started with <Section argument> and ended by </Section>.
Sections can nest to any level. Attributes for a given section (or the
toplevel) are entered by giving a keyword followed by the attribute value,
leading and trailing spaces are ignored, but you can give a value inside
quotes. Section- and attribute names are case insensitive.

Comments can be shell style, started by C<#> and continueing to the end of the
line or in C-style, starting with C</*> and ending with C<*/>.

You can include files by using:

  include SomeConfig

The recognized top level attributes are:

=over 4

=item SysMount

The mountpoint of the sys filesystem. Defaults to F</sys> and can be overridden
from the commandline

=item AlarmString

The string used on a line with an alarm. Defaults to C<ALARM>.

=back

The top level sections are:

=over 4

=item Chip match

This describes what to display for a particular chip and how to display it.
Match is a case insensitive wildcarded string (? representing a single
character and * any amount of any characters), and compared to all chips
announced in sysfs (as represented by their F<name> file). If there is a
match, the corresponding device will be displayed under control of this
section.

The body will consist of a number of sensor descriptors, one for each one you
are interested in.

So the only subsection is:

=over 4

=item Sensor Type_Num

A Type_Num string will represent sensor number Num of type Type. The builtin
supported types are:

=over 4

=item in

Represents a voltage. You typically declare minimum and maximum values.

=item temp

Represents a temperature. You typically declare a hysteresis and a maximum.

=item cur

Represents a current. You typically declare minimum and maximum values.

=item fan

Represents a fan speed. You typically declare a minimum value and a divisor.

=back

If you have other devices in there, you can declare how they are to be
displayed using a <L<Group Type|"Group sensor_type">> section.

The attributes you can set inside a Sensor section are:

=over 4

=item label

The string displayed i front of the values for this sensor. Defaults to
the Sensor Section name.

=item compute

Quite often a sensor really reports some value derived from what we are
actually interested in. A high voltage for example is often scaled using
a few external resistors. To get the value we are actually interested in,
a little calculation may be needed.

For example:

 actual V = (Vmeasured * (1 + Rin/Rf)) - (Vref * (Rin/Rf))

and for -12V:

 Rin/Rf = 6.68
 Vref   = 4.096V

So we get:

 actual V = 7.67 * Vmeasured - 27.36

This attribute represents the actual value using C<@>, so the configuration 
line will be:

 Compute 7.67 * @ - 27.36

=item min

Represents the minimum acceptable value for this sensor. If it goes below
that, an alarm should be raised.

Ignored if not given.

If L<max|"max"> is also given, the minimum should be below the maximum

=item max

Represents the maximum acceptable value for this sensor. If it goes below
that, an alarm should be raised.

Ignored if not given.

=item hysteresis

On some sensors once a (hardware) alarm is raised, it remains on until
the value drops below the hysteresis. This is typically what's used for
temperature sensors.

If L<max|"max"> is also given, the hysteresis should be below the maximum

Ignored if not given.

The current code only does its own alarm detection, so this value effectively
always gets ignored.

=item divisor

The divisor applied to the clock which measures the fan speed.

 RPM = (60 * 22500) / (count * divisor)

The divisor is already accounted for in the RPM calculation, so changing the
divisor does not change the reproted fan speed. It only impacts the possible
resolution.

Note that most chips only support fan divisors of 1, 2, 4, and 8.

Ignored if not given.

Note that the current code does no setting, so for now this attribute is
pretty useless.

=back

=back

=item Group sensor_type

Used to declare how to represent sensors not (currently) built in (please
report such cases to the author). You can also use it to override the
values used for the builtin sensor types.

Sensor_type represents the sensor family.

Attributes can be:

=over 4

=item factor formula

The values reported in sysfs are often scaled. This gives the multiplication 
factor to be applied.

Defaults to 1

=item format string

For presentation the value is sent through a standard perl 
L<sprintf|perlfunc/"sprintf">. Here you can say which format string should be
used. 

Notice that the value presentation columns are aligned on the end of the 
strings, so you can push a value to the left by adding spaces at the end.
Leading spaces get squeezed out in the display, so they are irrelevant.

Defaults to C<"%3d     ">

=back

For example, if voltage reporting was not built in, you could make it available
using:

 <GROUP in>	   # sysfs prefix used to report voltages is "in"
  factor 1/1000    # sysfs value / 1000 is the actual voltage
  format "%6.2f V" # 2 digits after the period, followed by a V
 </GROUP>

=back

=head1 BUGS

None known.

=head1 AUTHOR

Ton Hospel (psensors@ton.iguana.be)

=head1 SEE ALSO

L<Config::General>,
L<sensors>

=cut