#!/s/std/bin/perl

# Script to check filedist once a week and generate reqs based
# upon seeming invalid entries.  A list of entries to ignore is
# currently kept in /s/lab/lib/dist-whitelist
#
# Author: Ryan Kern
#
# fixed: the mailback from lab.
#
# -stefan
#
# modified on 20041111 by tkurth:
#   - added checks for the files in /s/what/xml/hosts
#

use strict;
use Mail::Send;
use XML::Parser;
use IO::Dir;

my $DISTDIR = "/s/lab/dist";
my $CONFIG_FILE = "$DISTDIR/CONFIG.xml";
my $DB_FILE = "/s/lab/lib/machineinfo";
my $EXCLUDE = "/s/lab/lib/dist-whitelist";
my $WHAT_XML_DIR = "/s/what/xml/hosts";

my $parent;
my %group;
my @groups;
my @files;
my @what_hosts;
my @hosts;
my %dbhash;
my %dbos;
my %dnshash;
my %conf;
my %flags;
my %exclude;

my $parser = new XML::Parser('Handlers' => {'Start' => \&tag_start, 
    'End' => \&tag_end, 'Char' => \&char});

$parser->parsefile($CONFIG_FILE);

open EXCLUDE, $EXCLUDE;

while (my $thisline = <EXCLUDE>) {
    chomp($thisline);
    if ( !($thisline =~ /^[\#\s]/) && $thisline ne "") {
        $thisline =~ s/\s*\#.*?$//;
        $thisline =~ s/^\s+//;
        $exclude{$thisline} = "1";
    }

}

close EXCLUDE;

open DBFILE, $DB_FILE;

while (my $line = <DBFILE>) {
    chomp $line;
    $line =~ s/\s+\|/\|/g;

    my ($fqdn, $room, $user, $sponsor, $os, $b, $cpu) = split('\|', $line);
    my ($uqdn) = split('\.', $line);

    $dbhash{$uqdn} = 1;
    $dbhash{$fqdn} = 1;
    $dbos{$uqdn} = $os;

}

close DBFILE;

# Recurse through directories, record bad entries
foreach my $file (@files) {
    # Get the list of hosts/groups for this file
    my $filename = $file->{name};
    my $filedir = "$DISTDIR/$filename";

    opendir(DISTDIR, "$filedir");
    my @distfiles = readdir DISTDIR;
    closedir DISTDIR;

    foreach my $distfile (@distfiles) {

        my $valid_db = 0; # Is it in the DB?
        my $valid_dns= 0; # Is it in DNS?
        my $valid_os= 0;  # Is it an OS still using dist?

        my @hostchk = gethostbyname($distfile);
        if (@hostchk) {
            $valid_dns = 1;
            $dnshash{$distfile} = "1";
        }

        if ($dbhash{$distfile}) {
            $valid_db = 1;
        }

        if ($dbos{$distfile}) {
            $valid_os = 1 if ($dbos{$distfile} eq "Sol 8");
        } else {
            $valid_os = 1;
        }

        # It's okay if it's a group from CONFIG.xml
        foreach my $group (@groups) {
            if ( $group->{name} =~ /$distfile/ ) {
                $valid_db = 1;
                $valid_dns= 1;
                $valid_os = 1;
                last;
            }

        }

        # It's okay if it's the target of a symlink
        foreach my $link (@distfiles) {
            my $link_d = readlink("$DISTDIR/$filename/$link");
            if ( $link_d =~ /$distfile/ ) {
                $valid_db = 1;
                $valid_dns= 1;
                $valid_os = 1;
                last;
            }
        }

        # ignore RCS control directories
        if ( $distfile =~ /RCS/ ) {
            $valid_db = 1;
            $valid_dns= 1;
            $valid_os = 1;
        }

        # ignore variants of "default"
        if ( $distfile =~ /default|timestamp/i ) {
            $valid_db = 1;
            $valid_dns= 1;
            $valid_os = 1;
        }

        if ( $distfile =~ /readme/i ) {
            $valid_db = 1;
            $valid_dns= 1;
            $valid_os = 1;
        }
    
        # ignore '.' and '..'
        if ( $distfile =~ /^\./ ) {
            $valid_db = 1;
            $valid_dns= 1;
            $valid_os = 1;
        }

        if ($exclude{$distfile}) {
            $valid_db = 1;
            $valid_dns= 1;
            $valid_os = 1;
        }

        if ($valid_db == 0 || $valid_dns == 0 || $valid_os == 0) {
            my $location = "$DISTDIR/$filename/";
            $flags{$distfile} ||= [];
            push @{$flags{$distfile}}, $location;
        }

    }
 
}

opendir(WHAT_XML_DIR, "$WHAT_XML_DIR");
@what_hosts = readdir WHAT_XML_DIR;
closedir WHAT_XML_DIR;

foreach my $what_host (@what_hosts) {
    my $valid = 0;
    my $wasxml = 0;
    
    # strip .xml from the filename if it matches
    if ($what_host =~ /.xml$/) {
        $what_host = substr($what_host, 0, -4);
        $wasxml = 1;
    }
    
    # ignore RCS dir
    if ($what_host =~ /RCS/) {
        $valid = 1;
    }

    # ignore default
    if ($what_host =~ /default/i) {
        $valid = 1;
    }

    # ignore .orig, .old and .bak files
    if ($what_host =~ /.orig$|.bak$|~$|.old$/) {
        $valid = 1;
    }
    
    # ignore emacs (#blah.blah#) and vim (blah~) backup files
    if ($what_host =~ /^#.*#$/) {
        $valid = 1;
    }

    # ignore any file starting with .
    if ($what_host =~ /^\./) {
        $valid = 1;
    }
        
    # ignore things we're told to ignore
    if ($exclude{$what_host}) {
        $valid = 1;
    }
    
    # if the host exists in DNS, ignore it
    my @hostchk = gethostbyname($what_host);
    if (@hostchk) {
        $valid = 1;
        $dnshash{$what_host} = "1";
    }

    if ($valid == 0) {
        my $location = "$WHAT_XML_DIR/$what_host";
        
        if ($wasxml) {
            $location = "$WHAT_XML_DIR/$what_host.xml";
        }     
        
        $flags{$what_host} ||= [];
        push @{$flags{$what_host}}, $location;        

    }
}

foreach my $host (@hosts) {

    my $valid_db = 0; # Is it in the DB?
    my $valid_dns= 0; # Is it in DNS?
    
    my @hostchk = gethostbyname($host);
    if (@hostchk) {
        $valid_dns = 1;
        $dnshash{$host} = "1";
    }
    
    if ($dbhash{$host}) {
        $valid_db = 1;
    }

    if ($exclude{$host}) {
        $valid_db = 1;
        $valid_dns= 1;
    }

    if ($valid_db == 0 || $valid_dns == 0) {
        $flags{$host} ||= [];
        $conf{$host} = "1";
    }

    
}

my @flagkeys = keys(%flags);
my $numentry = 0;
foreach my $mykey (@flagkeys) {
    my $errors = "";
    my $error_loc;
    my $program;
    
    if (!$dbhash{$mykey} ) {
        $errors = $errors . "Not found in Database\n";
    }

    if (!$dnshash{$mykey} ) {
        $errors = $errors . "Not found in DNS\n";
    }

    if ($conf{$mykey} ) {
        $errors = $errors . "Found in CONFIG.xml\n";
    }

    foreach my $entry (@{$flags{$mykey}}) {
        $errors = $errors . "$entry\n";
    
        if ($entry =~ /$WHAT_XML_DIR/) {
            $error_loc = $WHAT_XML_DIR;
            $program = "what";
        } else {
            $error_loc = $DISTDIR;
            $program = "filedist";
        }
    }

    if ($program eq "filedist") {
        if ($dbos{$mykey} ne "Sol 8") {
            $errors = "Entry is in filedist, but OS is $dbos{$mykey}, not Sol 8 - will never be used\n$errors";
        }
    }

    my $msg = new Mail::Send Subject=>"$mykey found in $program",
                             To=>'lab@cs.wisc.edu';
    $msg->set("X-Request-No-Reply", "yes");
 
    my $fh = $msg->open('smtp', Server=>"smtp.cs.wisc.edu");

    print $fh
    "The host $mykey was found within the $error_loc tree and does not appear to belong there.  This message is generated if it does not meet any of the following criteria:
1.) It is not the name of a valid host (having a fully qualified domain name and having a CSDB entry including a CPU part)
2.) It is not a valid group as definied in /s/lab/dist/CONFIG.xml
3.) It is not the target of a symlink within the dist'd file's directory..

If the entry should remain within the $error_loc tree, these messages can be suppressed by adding it to /s/lab/lib/dist-whitelist.

This script was run as $0.

Details follow:
$errors
";

     $fh->close;
}

# begin XML parsing subs 

sub tag_start {
    my ($this, $tag, %data) = @_;
    $parent = $tag;

    if ($tag eq "group") {
        die "Config file error: files must have names" if (!$data{'name'});
    
        %group = %data;
    } elsif ($tag eq "file") {
        die "Config file error: files must have names" if (!$data{'name'});
        die "Config file error: files must have dests" if (!$data{'dest'});

        my $thisfile = \%data;
        if ( ! ($thisfile->{name} =~ /k5login/ )) {
            $data{handlers} = [];
            push @files, \%data;
        }
    }
}

sub tag_end {
    my ($this, $tag) = @_;

    if ($tag eq "group") {
        my %local_group = %group;
        push @groups, \%local_group;
    }
}

sub char {
    my ($this, $char) = @_;

    if ($parent eq "member" && $char !~ /^\s+$/ && $char !~ /\\d/ &&
       $char !~ /\*/) {
        push @hosts, $char;
    }
}
