#!/usr/bin/perl
use strict ;
use warnings ;
use autodie ;

use Term::ANSIColor ;
use Carp ;

# Get the desired hostname:
my $HOSTNAME = $ARGV[0] ;

if (!$HOSTNAME) {
    print usage() ;
    exit 0 ;
}

my ($stdout, $stderr, $tmp) ;

$HOSTNAME = lc(trim($HOSTNAME)) ;
my $ROOT = main::is_root() ;

# 1. Get the hostname from /bin/hostname. We grab only the hostname part
# (not the domain). E.g., $hostname will be 'luckdragon' not
# 'luckdragon.stanford.edu'.
($stdout, $stderr) = run_command_improved('/bin/hostname',) ;
my $hostname = get_first_part(trim($stdout)) ;

# progress("$hostname is $hostname") ;
passfail($hostname eq $HOSTNAME, '/bin/hostname', $hostname) ;

# 2. Get the hostname from /etc/hostname.
my $etchostname = get_first_part(trim(slurp('/etc/hostname'))) ;
passfail($etchostname eq $HOSTNAME, '/etc/hostname', $etchostname) ;

# 3. Check /etc/passwd
($stdout, $stderr) =
  run_command_improved('/bin/grep', ":$HOSTNAME root", '/etc/passwd') ;
$stdout = trim($stdout) ;
passfail($stdout, '/etc/passwd', "$HOSTNAME not in /etc/passwd") ;

# 4A. Check /etc/krb5.keytab
my $host_keytab_file = '/etc/krb5.keytab' ;
passfail_keytab($host_keytab_file, 'host') ;

# 4B. Check WebAuth keytab (but skip if /etc/webauth/ directory does not
# exists).
my $webauth_keytab_file = '/etc/webauth/keytab' ;
if (-d '/etc/webauth') {
    passfail_keytab($webauth_keytab_file, 'webauth') ;
} else {
    skip($webauth_keytab_file, 'no directory /etc/webauth (webauth not used?)') ;
}

# 5. Check /etc/hosts. Look for an entry of the form
# ###.###.###.### something.stanford.edu. If 'something' matches HOSTNAME,
# then it passes. If 'something' does not match, fails.
my $etchosts = slurp('/etc/hosts') ;
foreach my $line (split(/\n/xsm, $etchosts)) {
    if ($line =~ m{^\s*\d+\.\d+\.\d+\.\d+\s+([^\.]+)\.stanford\.edu\s*}xsm) {
        my $host_name = $1 ;
        if (lc($host_name) eq $HOSTNAME) {
            passfail(1, '/etc/hosts', undef) ;
            last ;
        } else {
            passwarn('/etc/hosts', "found non-matching host ($host_name)") ;
            last ;
        }
    }
}

# 6. /etc/postfix/senders
my $postfix_senders = '/etc/postfix/senders' ;
if (-f $postfix_senders) {
    ($stdout, $stderr) =
      run_command_improved('/bin/grep', $HOSTNAME, $postfix_senders) ;
    $stdout = trim($stdout) ;
    if ($stdout =~ m/${HOSTNAME}(?:\s|$)/xsm) {
        $tmp = 1 ;
    } else {
        $tmp = 0 ;
    }
    passfail($tmp, $postfix_senders, "$HOSTNAME not in $postfix_senders") ;
} else {
    skip($postfix_senders, "no file $postfix_senders") ;
}

# 7A. Puppet certificate
my $cert_file    = "/etc/puppet/ssl/certs/$HOSTNAME.stanford.edu.pem" ;
my $pupcertfound = passfail(
    -f $cert_file,
    'Puppet certificate exists',
    'Puppet certificate not found'
) ;

# 7B. Puppet certificate has correct subject
if ($pupcertfound) {
    ($stdout, $stderr) = run_command_improved('/usr/bin/show-pem', $cert_file) ;
    passfail(
        $stdout =~ m{subject:\s+\/CN=$HOSTNAME}xsm,
        'Puppet subject correct',
        'INCORRECT SUBJECT'
    ) ;
} else {
    skip('Puppet subject correct',
        'cannot check (Puppet certificate not found)') ;
}

# 8. Check /afs/ir/dept/its/cgi-bin/group/unix/servers.csv
my $servers_csv = '/afs/ir/dept/its/cgi-bin/group/unix/servers.csv' ;
if (-f $servers_csv) {
    ($stdout, $stderr) =
      run_command_improved('/bin/grep', $HOSTNAME, $servers_csv) ;
    $stdout = trim($stdout) ;
    passfail($stdout, 'AFS servers csv', "$HOSTNAME not in file") ;
} else {
    skip('AFS servers.csv', "cannot access AFS file $servers_csv") ;
}

# 9. Check tripwire database (note that this directory is world-readable).
my $tripwire_db = '/afs/ir/site/leland/tripwire/' . $HOSTNAME . '.stanford.edu' ;
passfail(-d $tripwire_db, 'AFS tripwire database', "$tripwire_db not found") ;

# 10. Get the local system's IP address that is "en route" to "the internet":
my $ip_address = get_local_ip_address() ;
($stdout, $stderr) = run_command_improved('nslookup', $ip_address) ;
$stdout = trim($stdout) ;
if ($stdout =~ m{name\ = \ (\S+)(\s|$)}xsm) {
    my $dns_name = $1 ;
    $dns_name = get_first_part($dns_name) ;

    passfail(
        $dns_name eq $HOSTNAME,
        'DNS name/IP address',
        "do not agree ($dns_name <> $HOSTNAME)"
    ) ;
} else {
    passfail(0, 'DNS name/IP address', "no DNS record found for $HOSTNAME") ;
}

# 11. See if the local IP address is in the networking interfaces file.
my $interfaces_file = '/etc/network/interfaces' ;
if (-f $interfaces_file) {
    ($stdout, $stderr) =
      run_command_improved('/bin/grep', $ip_address, $interfaces_file) ;
    $stdout = trim($stdout) ;
    passfail($stdout, $interfaces_file, "$ip_address not in file") ;
} else {
    skip('interfaces file', "cannot find '$interfaces_file' file") ;
}

# 12. Check /etc/ssl/certs/server.pem, but only if the Stanford::PKObj
# package is available.
my $server_pem = '/etc/ssl/certs/server.pem' ;

eval {
    require Stanford::PKObj ;  # libstanford-certtools-perl
} ;

if ($@) {
    skip($server_pem,
        "cannot check $server_pem as Stanford::PKObj is not installed") ;
} else {
    if (-f $server_pem) {
        my $pkobj = Stanford::PKObj->new('file' => $server_pem) ;
        $pkobj->load_from_file() ;

        my %field_to_value = Stanford::PKObj::parse_x509($pkobj->get_contents()) ;

        my $subject = $field_to_value{'subject'} ;
        if ($subject =~ m{CN=$HOSTNAME\.stanford\.edu}xsm) {
            $tmp = 1 ;
        } else {
            $tmp = 0 ;
        }
        passfail($tmp, $server_pem,
            "cert subject [$subject] does not agree with hostname [$HOSTNAME]") ;
    } else {
        skip($server_pem, "file $server_pem does not exist") ;
    }
}

##########################################
sub progress {
    my ($msg) = @_ ;
    print $msg . "\n" ;
    return ;
}

sub passfail {
    ## no critic (RequireBracedFileHandleWithPrint)
    my ($test, $msg, $result) = @_ ;

    print pad($msg) . ': ' ;

    my $rv ;
    if ($test) {
        print color 'green' ;
        print 'PASS' ;
        $rv = 1 ;
    } else {
        print color 'red' ;
        print "FAIL ($result)" ;
        $rv = 0 ;
    }

    print color 'reset' ;
    print "\n" ;

    return $rv ;
}

sub passwarn {
    my ($test, $msg) = @_ ;

    print pad($test) . ': ' ;

    print "WARN: $msg" ;

    print "\n" ;
    return ;
}

sub skip {
    my ($test, $msg) = @_ ;
    print pad($test) . ': ' . "SKIP ($msg)\n" ;
    return ;
}

sub usage {
    return <<"EOG";
Usage:   $0 <server-name>
Example: $0 luckdragon
EOG
}

# Grab everything up to the first '.'.
sub get_first_part {
    my ($x) = @_ ;
    $x =~ s{^([^\.]+)\.+.*$}{$1}xsm ;
    return $x ;
}

sub is_root {
    return ($> == 0) ;
}

sub pad {
    my ($msg) = @_ ;

    my $length = 28 ;

    my $pad_length = $length - length($msg) ;
    if ($pad_length < 0) {
        $pad_length = 0 ;
    }

    return $msg . q{ } x $pad_length ;
}

sub get_keytab_info {
    my ($keytab_file) = @_ ;

    my ($stout, $sterr) =
      run_command_improved('/usr/bin/klist', '-k', $keytab_file) ;
    return trim($stout) ;
}

sub passfail_keytab {
    my ($keytab_file, $primary) = @_ ;

    my $tmpx ;
    if ($ROOT) {
        $stdout = get_keytab_info($keytab_file) ;
        if ($stdout =~ m/$primary\/${HOSTNAME}\.stanford\.edu/xsm) {
            $tmpx = 1 ;
        } else {
            $tmpx = 0 ;
        }

        passfail($tmpx, $keytab_file, "$HOSTNAME not found in $keytab_file") ;
    } else {
        skip($keytab_file, 'cannot check since not root') ;
    }

    return ;
}

sub get_local_ip_address {

    # In case Net::Address::IP::Local is not available, use
    # get_local_ip_address_core.
    eval {
        require Net::Address::IP::Local ;  # libnet-address-ip-local-perl
    } ;

    if ($@) {
        return get_local_ip_address_core() ;
    } else {
        return Net::Address::IP::Local->public() ;
    }
}

# Taken from
# http://stackoverflow.com/questions/330458/how-can-i-determine-the-local-machines-ip-addresses-from-perl
# This idea was stolen from Net::Address::IP::Local::connected_to()
sub get_local_ip_address_core {
    use IO::Socket::INET ;

    my $dns_server = 'ice-4.stanford.edu' ;

    my $socket = IO::Socket::INET->new(
        Proto    => 'udp',
        PeerAddr => $dns_server,  # Stanford DNS server
        PeerPort => '53',         # DNS port
        ) or croak "cannot connect to DNS server $dns_server: $!" ;

    # A side-effect of making a socket connection is that our IP address
    # is available from the 'sockhost' method
    my $local_ip_address = $socket->sockhost ;

    return $local_ip_address ;
}

# Use: pass in an array, returns ($stdout, $stderr, $exit_value)
sub run_command_improved {
    my (@command) = @_ ;

    ## no critic (ProhibitStringyEval, RequireCheckingReturnValueOfEval);
    eval 'use IPC::Run' ;

    # (From Russ)
    my ($out, $err) ;
    IPC::Run::run(\@command, q{>}, \$out, q{2>}, \$err) ;
    return ($out, $err, $? >> 8) ;
}

sub trim {
    my ($s) = @_ ;

    if (!defined($s)) { return $s }

    $s =~ s{^\s*}{}xs ;  ## no critic (RequireLineBoundaryMatching) ;
    $s =~ s{\s*$}{}xs ;  ## no critic (RequireLineBoundaryMatching) ;

    return $s ;
}

sub slurp {              ## no critic (Subroutines::RequireArgUnpacking) ;
    eval { require Perl6::Slurp ; } ;

    if ($@) {
        return slurp_local(@_) ;
    } else {
        return Perl6::Slurp::slurp(@_) ;
    }
}

sub slurp_local {
    my ($filename, $filesize_limit) = @_ ;

    # If filesize is defined but is non-positive, it is silently ignored.
    if (defined($filesize_limit) && (($filesize_limit + 0) > 0) && (-e $filename))
    {

        # Get the file size (in bytes) of $filename
        my $filesize = -s $filename ;
        if ($filesize > $filesize_limit) {
            croak "could not open file '$filename' for slurping: "
              . "file '$filename' has $filesize bytes exceeding "
              . "the limit of $filesize_limit" ;
        }
    }

    my $text = q{} ;
    {
        ## no critic (Variables, InputOutput)

        local ($/, *FH) ;

        # Turn off autodie for a bit.
        {
            no autodie qw(open) ;
            if (!open(FH, '<', $filename)) {
                croak "can't open file $filename for slurping: $!" ;
            }
        }

        $text = <FH> ;
        ## use critic
    }

    return $text ;
}

exit(0) ;

__END__

#############################################################################

=head1 NAME

    sysname-check - Check hostname consistency on a Linux server

=head1 SYNOPSIS

    sysname-check <hostname>
    sysname-check luckdragon

=head1 DESCRIPTION

This utility looks in various places for the system hostname and verifies
that they are all consistent. Here are the places it looks:

    /bin/hostname
    /etc/hostname
    /etc/passwd
    /etc/krb5.keytab
    /etc/webauth.keytab
    /etc/hosts
    Puppet certificate
    /afs/ir/dept/its/cgi-bin/group/unix/servers.csv
    tripwire database directory
    DNS name vs. IP address
    /etc/ssl/certs/server.pem

A few of the above will be skipped if the files are not accessible (e.g.,
C</etc/krb5.keytab> will be skipped if utility run as non-root).

This utility has only been tested on Debian; it will probably not work on
other systems (e.g., RedHat).

=head1 AUTHOR

Adam Lewenberg <adamhl@stanford.edu>

=head1 COPYRIGHT AND LICENSE

Copyright 2013 The Board of Trustees of the Leland Stanford Junior
University.  All rights reserved.

Permission to use, copy, modify, and distribute this software and its
documentation for any purpose and without fee is hereby granted, provided
that the above copyright notice appear in all copies and that both that
copyright notice and this permission notice appear in supporting
documentation, and that the name of Stanford University not be used in
advertising or publicity pertaining to distribution of the software
without specific, written prior permission.  Stanford University makes no
representations about the suitability of this software for any purpose.
It is provided "as is" without express or implied warranty.

THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.

=cut

#############################################################################
