#
# Support library for scripts parsing the sitesummary files.
#

package SiteSummary;
require Exporter;

our $VERSION = 0.01;
our @ISA     = qw(Exporter);
our @EXPORT  = qw(
                  for_all_hosts
                  get_filepath_current
                  get_hostclass
                  get_site
                  get_sitegroup
                  get_hostname
                  get_dns_address
                  get_macaddresses
                  get_primary_macaddress
                  get_primary_ip_address
                  get_linux_kernel_ver
                  get_debian_edu_profile
                  get_debian_edu_ver
                  get_hardware_info
                  );

my $pwd = "/var/lib/sitesummary/entries";  # Path to the entries

# File for debian-edu configuration
my $debian_edu_config = "/debian-edu/config";

sub get_filepath_current {
    my ($hostid, $file) = @_;
    return "$pwd/$hostid$file";
}

#
# Return the value string from a file, ignoring comments
#
sub get_file_string {
    my ($hostid, $filename) = @_;
    my $path = get_filepath_current($hostid, $filename);
    my $string;
    if (open (FILE, $path)) {
        while(<FILE>) {
            chomp;
            s/\#.+$//;
            next if (/^\s*$/);
            $string = $_;
        }
        close(FILE);
        return $string;
    } else {
        return undef;
    }
}

#
# Return the site string
#
sub get_site {
    my $hostid = shift;
    return get_file_string($hostid, "/siteinfo/site");
}

#
# Return the sitegroup string
#
sub get_sitegroup {
    my $hostid = shift;
    return get_file_string($hostid, "/siteinfo/sitegroup");
}

#
# Return the hostclass string
#
sub get_hostclass {
    my $hostid = shift;
    return get_file_string($hostid, "/siteinfo/hostclass");
}

#
# Return the IP address on the primary network interface
#
sub get_primary_ip_address {
    my $hostid = shift;
    my $path = get_filepath_current($hostid, "/system/ifconfig-a");
    # XXX Not properly implemented, just pick the first IP
    my $ip;
    if (open (FILE, $path)) {
        while(<FILE>) {
            chomp;
            if (m/inet addr:(\S+)\s+/) {
                $ip = $1;
                last;
            }
        }
        close(FILE);
        return $ip;
    } else {
        return undef;
    }
}

#
# Return all MAC addresses
sub get_macaddresses {
    my $hostid = shift;
    my $path = get_filepath_current($hostid, "/system/ifconfig-a");
    if (open (FILE, $path)) {
        my @macs;
        while(<FILE>) {
            chomp;
            if (m/Link encap:Ethernet\s+HWaddr (\S+)\s+/) {
                push(@macs, $1);
            }
        }
        close(FILE);
        return @macs;
    } else {
        return undef;
    }
}

#
# Return the IP address on the primary network interface
#
sub get_primary_macaddress {
    my $hostid = shift;
    my $path = get_filepath_current($hostid, "/system/ifconfig-a");
    # XXX Not properly implemented, just pick the first MAC after
    # sorting alphabetically.
    if (open (FILE, $path)) {
        my @macs;
        while(<FILE>) {
            chomp;
            if (m/Link encap:Ethernet\s+HWaddr (\S+)\s+/) {
                push(@macs, $1);
            }
        }
        close(FILE);
        return (sort @macs)[0];
    } else {
        return undef;
    }
}

#
# Return the hostname string
#
sub get_hostname {
    my $hostid = shift;
    return get_file_string($hostid, "/system/hostname");
}

#
# Return an address that can be used to contact the host.  Prefer DNS,
# but fall back to the IP address if the IP address do not resolve in
# DNS.
#
sub in_dns {
    my $hostname = shift;
    my $packed_ip = gethostbyname($hostname);
    return defined $packed_ip;
}
sub get_dns_address {
    my $hostid = shift;
    my $hostname = get_hostname($hostid);
    # Use IP address as hostname if the provided hostname is bogus or
    # missing in DNS.
    $hostname = get_primary_ip_address($hostid)
        if (! in_dns($hostname) || "localhost" eq $hostname);
    return $hostname;
}

#
# Return Linux kernel version for the machines using Linux.
#
sub get_linux_kernel_ver {
    my $hostid = shift;
    my $path = get_filepath_current($hostid, "/system/uname-smr");
    my $kver;
    if (open (FILE, $path)) {
        while(<FILE>) {
            chomp;
            s/\#.+$//;
            next if (/^\s*$/);
            my @f = (split(/\s+/, $_));
            $kver = $f[1] if ("Linux" eq $f[0]);
        }
        close(FILE);
        return $kver;
    } else {
        return undef;
    }
}

sub get_debian_edu_profile {
    my $hostid = shift;
    my $path = get_filepath_current($hostid, $debian_edu_config);
    if ( ! -e $path ) {
        return undef;
    }
    if (open (FILE, $path)) {
        while (<FILE>) {
                chomp;
                s/\#.+$//;
                next if not (/PROFILE/);
                s/^PROFILE=//;
                return $_;
        }
    }
    close(FILE);
}

sub get_debian_edu_ver {
    my $hostid = shift;
    my $path = get_filepath_current($hostid, $debian_edu_config);
    if ( ! -e $path ) {
        return undef;
    }
    if (open (FILE, $path)) {
        while (<FILE>) {
                chomp;
                s/\#.+$//;
                next if not (/VERSION/);
                s/^VERSION=//;
                return $_;
        }
    }
}

sub get_hardware_info {
    my $hostid = shift;
    my $path = get_filepath_current($hostid, "/system/dmidecode");
    if (open(FILE, "<", $path)) {
        my $sysinfo = 0;
        my ($vendor, $model, $version, $serial);
        while (<FILE>) {
            chomp;
            next unless ($sysinfo || m/^System Information/);
            $sysinfo = 1;
            $vendor = $1 if (m/Manufacturer: (.+\S)\s*$/);
            $model = $1 if (m/Product Name: (.+\S)\s*$/);
            $version = $1 if (m/Version: (.+\S)\s*$/);
            $serial = $1 if (m/Serial Number: (.+\S)\s*$/);
            last if (m/^Handle /);
        }
        close(FILE);

        # Append version string to get for example the thinkpad model
        # name, but ignore bogus entries.
        $model = "$model $version" if ($version
                                       && $version ne "Not Specified"
                                       && $version ne "Not Available"
                                       && $version ne "System Version"
                                       && $version ne "None");

        return ($vendor, $model, $serial);
    } else {
        return undef;
    }
}

sub for_all_hosts {
    my $callback = shift;

    if ( ! -d $pwd ) {
        print STDERR "error: Missing $pwd directory.\n";
        return undef;
    }
    opendir(DIR, $pwd) or die "$!: $pwd\nDied";
    my $count = 0;
    foreach (readdir(DIR)) {
        chomp;
        next if m/^$/ || m/^.$/ || m/^..$/;
        my $hostid = $_;
        if ( -d "$pwd/$hostid" ) {
            $count ++ if ($callback->($hostid));
        } else {
            print STDERR "warning: Junk in filelog: $pwd/$hostid\n";
        }
    }
    closedir(DIR);
    return $count;
}

1;

########################################################################
# Local Variables:
# mode: perl
# End:
########################################################################