sitesummary 0.1.9 / usr / share / perl5 / SiteSummary.pm

#
# 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_age_group
                  get_age_groups
                  get_debian_edu_profile
                  get_debian_edu_ver
                  get_debian_ver
                  get_default_route
                  get_dns_address
                  get_filepath_current
                  get_hardware_info
                  get_hostclass
                  get_localhostname
                  get_hostname
                  get_linux_kernel_ver
                  get_macaddresses
                  get_primary_ip_address
                  get_primary_macaddress
                  get_unique_ether_id
                  get_site
                  get_sitegroup
                  is_laptop
                  is_pkg_installed
                  );

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

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

# Provide mechanism to remap host names for hosts private networks
# available via tunnels.

my $hostmapfile = "/etc/sitesummary/hostmap";
my $hostmapdir = "/etc/sitesummary/hostmap.d";
my %hostmap;

sub load_hostmap {
    my @files = ($hostmapfile);
    %hostmap = (); # Clear hostmap

    if (opendir(my $dh, $hostmapdir)) {
        push(@files, grep { /^\./ && -f "$some_dir/$_" } sort readdir($dh));
        closedir $dh;
    }
    for my $file (@files) {
        if (open(my $fh, '<', $file)) {
            while (<$fh>) {
                chomp;
                s/\#.*$//;
                next if m/^\s*$/;
                my ($hostid, $newhostname) = split(/\s+/);
                $hostmap{$hostid} = $newhostname;
            }
            close $fh;
        }
    }
    return;
}

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 current default route used on host
sub get_default_route {
    my $hostid = shift;
    my $path = get_filepath_current($hostid, "/system/route-n");
    if (open(my $fh, $path)) {
        while (<$fh>) {
            if (m/^0.0.0.0\s+(\S+)\s+/) {
                close($fh);
                return $1;
            }
        }
        close($fh);
    }
    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;
    }
}

#
# Given the output from 'ifconfig -a', return the unique host ID used
# by sitesummary.
# Use like this:
#   get_unique_ether_id(get_file_string($hostid, "/system/ifconfig-a"))
#
sub get_unique_ether_id {
    my $ifconfigoutput = shift;
    my $eth0mac;
    my $eth1mac;
    my $eth2mac;
    open(IFCONFIG, $ifconfigoutput) || return undef;
    while (<IFCONFIG>) {
        chomp;
        $eth0mac = $1 if (m/^eth0\s+Link encap:Ethernet  HWaddr (\S+)/);
        $eth1mac = $1 if (m/^eth1\s+Link encap:Ethernet  HWaddr (\S+)/);
        $eth2mac = $1 if (m/^eth2\s+Link encap:Ethernet  HWaddr (\S+)/);
    }
    close (IFCONFIG);
    #print STDERR "MAC: $eth0mac\n";
    my $mac = $eth0mac || $eth1mac || $eth2mac || "unknown";
    return lc("ether-$mac");
}

#
# Return the hostname string as seen on the host itself
#
sub get_localhostname {
    my $hostid = shift;
    return get_file_string($hostid, "/system/hostname");
}

#
# Return the hostname string
#
sub get_hostname {
    my $hostid = shift;
    if (exists $hostmap{$hostid}) {
        return $hostmap{$hostid};
    } else {
        return get_localhostname($hostid);
    }
}

#
# 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_debian_ver {
    my $hostid = shift;
    my $path = get_filepath_current($hostid, "/debian/debian_version");
    if (open (my $fh, $path)) {
        my $version = <$fh>;
        chomp $version;
        close($fh);
        return $version;
    } else {
        return undef;
    }
}

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);

        # Avoid returning bogus vendor and model
        undef $vendor if (defined $vendor &&
                          (
                           "Not Specified" eq $vendor
                           || "System Manufaturer" eq $vendor
                           || "System manufaturer" eq $vendor
                           || "System manufacturer" eq $vendor
                           || "To Be Filled By O.E.M." eq $vendor
                           || "To Be Filled By O.E.M. by More String" eq $vendor
                          ));
        undef $model if (defined $model &&
                         (
                          "Not Specified" eq $model
                          || "System Name" eq $model
                          || "System Product Name" eq $model
                          || "To Be Filled By O.E.M." eq $model
                          || "To Be Filled By O.E.M. To Be Filled By O.E.M." eq $model
                         ));

        # 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 "To Be Filled By O.E.M."
                                       && $version ne "None");

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

sub is_pkg_installed {
    my ($hostid, $pkgname) = @_;
    # Check debian/dpkg-l for 'ii *pkgname '
    my $path = get_filepath_current($hostid, "/debian/dpkg-l");
    if (open (my $fh, $path)) {
        while(<$fh>) {
            if (m/^ii *$pkgname /) {
                close($fh);
                return 1
            }
        }
        close($fh);
    }
    return undef;
}

sub is_laptop {
    my $hostid = shift;
    my $path = get_filepath_current($hostid, "/system/laptop");
    return -e $path;
}

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;
}

sub get_age_groups {
    return (
        0 => '>0 days',
        3 => '>3 days',
        7 => '>one week',
        14 => '>14 days',
        30 => '>30 days',
        90 => '>90 days',
        120 => '>120 days',
        180 => '>180 days',
        );
}
sub get_age_group {
    my $hostid = shift;
    my %agegroups = get_age_groups();
    my $topdir = get_filepath_current($hostid, "/");
    my $age = (time() - (stat($topdir))[9]) / (60 * 60 * 24);

    my $thisgroup;
    for my $group (sort { $a <=> $b; } keys %agegroups) {
        if ($age > $group) {
            $thisgroup = $group;
        }
    }
    return $thisgroup;
}

load_hostmap();
1;

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