##
## Rscan 1.4.0 (c)1994 Nate Sammons [remote scanner]
##
## This runs on the remote machine and gathers information and relays
## it to the machine starting all the scans.
##
## A wise man once told me:
##  "Just because you're paranoid doesn't mean that they aren't out to get you."
##

###########################################################################
##           THERE ARE NO CONFIGURATION VARIABLES IN THIS FILE           ##
###########################################################################

## who are we?
$name    = 'Rscan';
$version = '1.4.0';

## set nonbuffered I/O on STDOUT
select STDOUT;  $| = 1;

## call as "scan [remote|local] scannerdir modlist [ascii|html]"
$api{'scanmode'}    = shift;  ## "remote" or "local"
$api{'scannerdir'}  = shift;  ## where is the "scanner" directory?
$moddata            = shift;  ## module list (unparsed)
$api{'outformat'}   = shift;  ## "ascii" or "html"
$api{'perlversion'} = $];     ## version of perl running

##
## Tell the remote machine what our PID is, in case we need to be killed.
##
print "p:$$\n";

## what's takling so long?
&screen("Initializing");

## debugging information
print "\nMode     = $api{'scanmode'}\n" ,
        "Dir      = $api{'scannerdir'}\n" ,
        "Moddata  = $moddata\n" ,
        "Format   = $api{'outformat'}\n\n";

## return strings for telling the other process what's going on
$result{'fail'}  = 'o:[ FAIL ] *';
$result{'warn'}  = 'o:[ WARN ] +';
$result{'pass'}  = 'o:[ PASS ]';
$result{'error'} = 'o:[ ERR  ]';
$result{'info'}  = 'o:[ INFO ]';
$result{'possible_error'} = 'pe:Possible Child Error';
$result{'childinfo'}      = 'ci:';

## tell teh remote process our PID.
print $result{'childinfo'}, 'pid:', $$, "\n",

## close off STDERR, and reconnect it to STDOUT
close(STDERR);
open(STDERR, ">&STDOUT");

## this is setup for time functions
@days   = (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);
@months = (January, February, March, April, May, June, July, August,
           September, October, November, December);

## some time variables
$api{'now'}         = $^T;    ## time
$api{'time'}        = &ltime($api{'now'});

## if we're running remote, we don't want anyone to be able
## to look at what we're doing.
if ($api{'scanmode'} eq 'remote') {
  chown 0, 0, $api{'scannerdir'};
  chmod 0500, $api{'scannerdir'};
  }

## change directories
chdir $api{'scannerdir'} || &leave("Cannot chdir to $api{'scannerdir'}\n");

## get the OS name...  we really need this!
chop($os{'name'} = `/bin/uname`);

## really, really need this ;-)
if (!$os{'name'}) {
  &leave("FATAL:  /bin/uname did not return anything!  We cannot proceed\n",
         "        with the scan on this machine without this information.\n\n");
  
  }

## sets up OS-dependant paths to apps, etc.
## there MUST be one of these for each OS to be run under
if (-e "$api{'scannerdir'}/pathconfig/" . $os{'name'}) {
  do "$api{'scannerdir'}/pathconfig/" . $os{'name'};
  }
else {
  &leave("\nNo path configuration data for OS " , $os{'name'} , "\n" ,
         "You can either brew your own and put it in the file\n" ,
         "'scanner/pathconfig/" , $os{'name'} , "' or look for one on the\n" ,
         "newsgroups.  Either way, mail it to\n",
         "Nate Sammons <nate\@vis.colostate.edu>\n");
  }

## tell the remote machine about ourselves... This data is put into
## the %remote hash table.
print $result{'childinfo'}, 'os:',       $os{'name'}, "\n",
      $result{'childinfo'}, 'osver:',    $os{'version'}, "\n",
      $result{'childinfo'}, 'fullname:', $machine, $domain, "\n",
      $result{'childinfo'}, 'hostname:', $machine, "\n",
      $result{'childinfo'}, 'pvers:',    $api{'perlversion'}, "\n",
      $result{'childinfo'}, 'remove:',   $remove, "\n";

## resolve the modules to be used from the $modlist data
%modules = &parsemodlist($moddata, "$api{'scannerdir'}/modules");
if ($modules{'__error__'}) {
  &leave("There was an error found when parsing the modlist.\n",
         "Be sure that you followed the guidelines for writing\n",
         "the modlist.\n\n",
         "Here is the offending modlist:\n",
         "   $moddata\n\n",
         "The scan on $machine has been aborted.\n\n");
  }

foreach $i (keys %modules) {
  ## get the fullname and version of the module
  open(NAME, "$api{'scannerdir'}/modules/$i/fullname");
  chop( $modfname{$i} = <NAME> );
  close(NAME);
  open(VERS, "$api{'scannerdir'}/modules/$i/version");
  chop( $modversion{$i} = <VERS> );
  close(VERS);

  ## set the whereami value for each file
  foreach $file (split(' ', $modules{$i})) {
    @tmp = split('/', $file);
    if (substr($file, 0, 1) eq '/') {
      $whereami{$file} = '/' . join('/', splice(@tmp, 0, $#tmp));
      }
    else {
      $whereami{$file} = join('/', splice(@tmp, 0, $#tmp));
      }
    }
  }

## Print some nice startup info
&screen("\n\n$name $version starting scan on $machine\n");
&screen('Date: ' , &ltime($api{'now'}) , "\n\n");

## print the test banner
&screen(' Test' , ' ' x 59 , "Condition\n");
&screen('-' x 73 , "\n");

## Print startup info to the report
if ($api{'outformat'} eq 'html') {
  &rawheader("<center><h3>Report for $machine</h3></center>");
  &rawheader("");
  }
else {
  &rawheader("Report for $machine");
  &rawheader("");
  }
&header('The date is', &ltime($api{'now'}));
&header('Rscan Version', $version);
&header('Perl Version', $api{'perlversion'});

## make a nice little list of scans and their names, versions, etc.
undef @tmp;
foreach $i (sort keys %modules) {
  push(@tmp, join('', $modfname{$i}, ' version ', $modversion{$i}));
  }
&header('Scans', @tmp);
undef @tmp;

## make a nice list of the modlist used on this scan
&header('Modlist', split(',', $moddata));

if ($domain) {
  &header('Machine name',     "$machine ($machine$domain)");
  }
else {
  &header('Machine name',     $machine);
  }
&header('Operating System', "$os{'name'} $os{'version'}$os{'minor'}");
&header('OS Patch Level',   $os{'patchlevel'});
&header('CPU Type',         $cpu);
&header('System ID',        $sysid);

##
## get rid of a some stuff before we continue
##
undef $moddata;

##
## Setup where tar is and how to make tar archives
##
$tar = $tar{$os{'name'} . $os{'version'}} ||
       $tar{$os{'name'} . 'default'};
$tar_extract = $tar_extract{$os{'name'} . $os{'version'}} ||
               $tar_extract{$os{'name'} . 'default'};


#########################  BEGIN TESTS  ##########################

## execute all scripts ending with ".pl" in the appropriate
## directories, assuming they exist.  Directories that they live
## in are listed in the %modules hash.
## fork a new process for each module to be run, this way, modules
## don't interfere with eachother.
foreach $module (sort keys %modules) {
  
  ## open a pipe, later we'll take care of this more
  pipe(READM, WRITEM) || &leave("Pipe error: $!\n");
  
  if ($modpid = fork) {
    ## parent process here
    close(WRITEM);
    
    ## for debugging
    print "Parent process $$ sees child at PID $modpid, listening.\n";
    
    ## relay info to remote process
    while (<READM>) { print; }
    
    ## close the end of the pipe when we're done
    close(READM);

    ##
    ## check exit status of the module.  If it happens to exit with
    ## other than status == 0, then log an error to the report.
    ##
    $module_exit = ($? >> 8);
    if ($module_exit) {
      if ($api{'outformat'} eq 'html') {
        &report("<b><blink>WARNING:</blink></b> The module \"<i>$module</i>\"",
          " exited abnormally on $machine.\n",
          "      There must have been an error somewhere in it's run,\n",
          "      since modules should not exit of their own free will.\n",
          "      You should contact the author of the module if possible.\n\n",
          "      The Process ID was $modpid, the exit value was ",
          "$module_exit\n");
        }
      else {
        &report("WARNING: The module \"$module\" exited ",
          "abnormally on $machine.\n",
          "      There must have been an error somewhere in it's run,\n",
          "      since modules should not exit of their own free will.\n",
          "      You should contact the author of the module if possible.\n\n",
          "      The Process ID was $modpid, the exit value was ",
          "$module_exit\n");
        }
      }
    }
  
  elsif (defined $modpid) {
    
    ## child here
    ## unless debugging is on, this will not print
    print "Fork successful, child running module $module at PID $$\n";

    close(READM);
    close(STDOUT);            ## close STDOUT
    open(STDOUT, ">&WRITEM"); ## then redirect it to the pipe
    close(STDERR);            ## close STDERR
    open(STDERR, ">&WRITEM"); ## then redirect it to the pipe

    &screen("\nInitializing data for $modfname{$module} ",
            "version $modversion{$module}");

    ## tell the report what module we're doing.
    &modulename($modfname{$module});

    ## first, run the OS-independent init stuff, if it exists
    if (-e "$api{'scannerdir'}/modules/$module/init") {
      print "Parsing Generic Initialization data for module $module\n";
      
      ## set the whereami variable for the script
      $api{'whereami'} = "$api{'scannerdir'}/modules/$module";
      do "$api{'scannerdir'}/modules/$module/init";
      }

    ## second, run the OS-specific init stuff, if it exists
    if (-e "$api{'scannerdir'}/modules/$module/$os{'name'}/init") {
      print "Parsing OS Initialization data for module $module\n";
      
      ## set the whereami variable for the script
      $api{'whereami'} = "$api{'scannerdir'}/modules/$module/$os{'name'}";
      do "$api{'scannerdir'}/modules/$module/$os{'name'}/init";
      }

    ## now, find all the scripts we should run, and run them
    undef @scripts;
    
    @scripts = split(' ', $modules{$module});
    print "Files to run for $module:\n",
          "   ", join("\n   ", @scripts), "\n\n";
    
    ## done with initialization
    &screen("\n");
    
    ## do scripts in alphabetic order, but do the general ones first,
    ## then the OS-general (common) ones, then the version-specific ones last
    foreach $script (sort @scripts) {

	 ## reset some variables.
	 $failed = 0;
	 undef $childpid;
	 undef $child_exit;

	 ## open a pipe so we can read what the specific scan tell us
	 pipe(READP, WRITEP) || &leave("Pipe error: $!\n");

	 ## we do some fancy forking here so that when the mini-script runs,
	 ## it can use any variables it wants to and munge with it's
	 ## environment and not worry about cleaning up after itself.
	 ## we simply redirect the STDOUT and STDERR of the child to
	 ## be sent through the pipe to the scan process on the remote
	 ## machine, which is then interpreted and sent back across the
	 ## pipe to the rscan process, which further interprets it and makes
	 ## some pretty screen output and writes the report.

	 if ($childpid = fork) {
        ## parent here
        close(WRITEP);

        ## this will not be printed unless debug is turned on
        print "Parent sees child at PID $childpid, listening to output.\n";

        ## listen to the child and relay the info to the remote process
        while (<READP>) {
          
          ## we want to make sure that every check has a result,
          ## and visa versa
          chop;
          
          ## if a check comes across, then set the $unresolved_check
          ## flag.  'c' is the check delimiter (see rscan code)
          ## if another check comes across, and there's an unresolved check,
          ## then raise an error.
          if ((split(':', $_))[0] eq 'c') {
            if ($unresolved_check) {
              if ($api{'outformat'} eq 'html') {
                &report("\n<b><blink>WARNING:</b></blink> ",
                  "Scan \"<i>$script</i>\"\n",
                  "  Did not return a result, so an error condition\n",
                  "  has been raised for it. PID was $childpid.\n");
                }
              else {
                &report("\nScan \"$script\"\n",
                  "  Did not return a result, so an error condition\n",
                  "  has been raised for it. PID was $childpid.\n");
                }
              &error;
              }
            
            ## set the flag
            $unresolved_check = 1;
            }
          
          ## if a result comes across, unset the $unresolved_check
          ## flag.  'o' is the result delimiter (see rscan code)
          if ((split(':', $_))[0] eq 'o') { $unresolved_check = 0; }
          
          ## possible error condition.  If there's an unresolved
          ## check, then register an error and report something
          if ($_ eq $result{'possible_error'}) {
            if ($unresolved_check) {
              if ($api{'outformat'} eq 'html') {
                &report("\n<b><blink>WARNING:</b></blink> ",
                  "Scan \"<i>$script</i>\"\n",
                  "  Did not return a result, so an error condition\n",
                  "  has been raised for it. PID was $childpid.\n");
                }
              else {
                &report("\nScan \"$script\"\n",
                  "  Did not return a result, so an error condition\n",
                  "  has been raised for it. PID was $childpid.\n");
                }
              &error;
              $unresolved_check = 0;
              }
            }
          
          ## always relay information, no matter what
          print $_, "\n";
          }
                
        ## close the pipe when we're done
        close(READP);
        
        ## wait for the child to die (a somber time ;-)
        waitpid($childpid, 0);
        
        ## if the child exited with a non-zero exit status,
        ## then we should log some kind of error.
        $child_exit = ($? >> 8);
        if ($child_exit) {

          if ($api{'outformat'} eq 'html') {
            &report("<b><blink>WARNING</blink></b>: Scan \"<i>$script</i>\"\n",
              "         exited with status = $child_exit.  There may have\n",
              "         been an error in it's run. PID was $childpid.\n");
            }
          else {
            &report("WARNING: scan \"$script\"\n",
              "         exited with status = $child_exit.  There may have\n",
              "         been an error in it's run. PID was $childpid.\n");
            }
          
          ## if there's an unresolved check, then report an error.
          if ($unresolved_check) {
            &error;
            $unresolved_check = 0;
            }
          }
        }
	 elsif (defined $childpid) {
        ## child here
        ## unless debugging is on, this will not print
        print "Fork successful, child running $script at PID $$\n";

        close(READP);
        close(STDOUT);            ## close STDOUT
        open(STDOUT, ">&WRITEP"); ## then redirect it to the pipe
        close(STDERR);            ## close STDERR
        open(STDERR, ">&WRITEP"); ## then redirect it to the pipe

        ## retrieve the whereami variable
        $api{'whereami'} = $whereami{$script};
        print "  Whereami [ $script ] = $api{'whereami'}\n";

        ##
        ## execute the scan and get out of here
        ## a little debugging
        ##&screen("\ndoing $api{'scannerdir'}/modules/$script\n\n");
        do "$api{'scannerdir'}/modules/$script";
        
        ##
        ## If the scan did not exit by itself, we register a possible error,
        ## which the process "above" us will maybe do something with
        ##
        print $result{'possible_error'}, "\n",
              ## debugging info here
              "Possible error reported by PID $$, scan=\"$script\"\n";
        
        ##
        ## Then we exit cleanly.
        ##
        exit 0;
        }
	 else {
        # cannot fork, we're screwd.
        &report("Cannot fork to execute scan '$script'\n" ,
     	"  Error was \"$!\"\n");
        &screen("Cannot fork to execute scan '$script'\n" ,
     	"  Error was \"$!\"\n");
        }
      }
    
    ## exit (module only)
    exit 0;
    }
  else {
    
    # cannot fork, we're screwd.
    &report("Cannot fork to execute module $module\n" ,
            "  Error was \"$!\"\n");
    &screen("Cannot fork to execute module $module\n" ,
            "  Error was \"$!\"\n");
    
    }
  }

######################### END TESTS ###############################

## Now, get rid of all the evidence and get outta dodge
&doexitstuff;

#######################################################################
## some subroutines to make life easy (pretty self explanitory, or not)

##
## These are the API functions
##

sub passed  { print $result{'pass'},  "\n"; }

sub failed  { print $result{'fail'},  "\n"; }

sub warn    { print $result{'warn'},  "\n"; }

sub error   { print $result{'error'}, "\n"; }

sub info    { print $result{'info'}, "\n";  }

sub report {
  local($text) = join('', @_);
  $text =~ s/\n/<R>/g;
  print "r:$text\n";
  }

sub screen {
  local($text) = join('', @_);
  $text =~ s/\n/<R>/g;
  print "s:$text\n";
  }

## prints the line about what hole we're checking for
sub pcheck {
  local($text) = join('', @_);
  print "c:$text\n";
  }

## centers text on a 65 character wide page.
sub center {
  local($text) = join('', @_);
  $tmp = " " x ((65- length($text))/2) . $text;
  }

## prints text in a buffered space
sub nprint {
  local($space, $text) = @_;
  $text . " " x ($space - length($text));
  }

## header takes a list.  The first element is the header name,
## like "System Name" and the rest of the options are formatted like this:
## (BTW, You cannot use \n characters in the options or header name.)
##
## Header Name:       Option1
##                    Option2
##                    Option3
##                    OptionN
sub header {
  local($name, @opts) = @_;
  print "h:$name<<SEPARATOR>>$opts[0]\n";
  foreach $i (1..$#opts) {
    print "h:<<NONE>><<SEPARATOR>>$opts[$i]\n";
    }
  }

## just like header, only no formatting on the other end.
## Cannot use \n (though one is appended when it's printed at the
## other end).
sub rawheader {
  local($text) = join('', @_);
  print "rh:$text\n";
  }

##
## Return permissions info off of a file, returns
##   ($uid, $gid, $suidinfo, $ownerinfo, $groupinfo, $otherinfo)
##  where $uid = file's user id
##        $gid = file's group id
##  and the rest are chmod-like file permissions. (eg 1, 2, ... 6, 7)
##
sub permissions {
  local(@sd) = stat($_[0]);

  ## mode is the last 4 digits of the octal string
  local($mode) = sprintf("%o", $sd[2]);
  local($t) = substr($mode, 0, (length($mode) - 4));
  local(@m) = split('', substr($mode, (length($mode) -4)));
  return ($sd[4],  ## UID
          $sd[5],  ## GID
          $m[0],   ## SUID/SGID data
          $m[1],   ## Owner permissions
          $m[2],   ## Group permissions
          $m[3],   ## Other permissions
          $t);     ## File type (a number)
  }

#######################################################################
## communication subroutines -- not really API functions, but we
## can't keep people from using them.

## tells the remote machine what module we're doing.
sub modulename { print "m:$_[0]\n"; }

## if we need to quit
sub leave {
  local($text) = join('', @_);
  &report($text);
  &screen($text);
  &doexitstuff;
  }

## this one returns a string that describes the time (so we don't need to
## use the date command)
sub ltime {
  local($mytime, $ampm);
  $mytime = shift;
  @tmp = localtime($mytime);
  if ($tmp[2] > 12) { $tmp[2] -= 12; $ampm = "pm"; }
  else { $ampm = "am"; }
  $tmp[5] += 1900;
  $mytime = "@days[$tmp[6]], @months[$tmp[4]] $tmp[3] $tmp[5] at " . 
   sprintf("%d", $tmp[2]) . ":" . sprintf("%02d", $tmp[1]) . ":" . 
   sprintf("%02d", $tmp[0]) . " $ampm";
  }

sub doexitstuff {
  &screen(" Exiting $machine");
  if ($api{'scanmode'} eq 'remote') {
    ## Now, get rid of all the evidence, but only if we're remote
    chdir "/";
    exec "$remove $api{'scannerdir'}";
    &report("Could not remove $api{'scannerdir'} on $machine!!\n");
    &screen("Could not remove $api{'scannerdir'} on $machine!!\n");
    &screen("\n");
    exit 0;
    }
  else { &screen("\n"); exit 0; }
  }

##
## Parses a modlist and returns either -1 on error or
## an array of files to run.
##
sub parsemodlist {
  local($list) = shift;
  local($moduledir) = shift;
  local($delim1, $delim2, $negatestr) = ('\[', ':', '-');
  local($flag, @runs, %n, @a, $modulename,
        $neg, $pod, %files, $gotlist, $dir, @tmp);
  
  ## if they didn't give a modlist, or specified any,
  ## we make one up for them.
  if ((!$list) || ($list eq 'any')) {
    print "[parsemodlist] looking for modules in\n",
          "  $moduledir\n";
    opendir(MODDIR, $moduledir) ||
      print "[parsemodlist]  Cannot open module directory: $!\n";
    while ($_ = readdir(MODDIR)) {
      if (/^\.+$/) { next; } ## skip . and ..
      if (-d "$moduledir/$_") {
        print "[parsemodlist] Found module:  $_\n";
        push(@tmp, $_);
        }
      }
    $list = join(',', sort @tmp);
    print "[parsemodlist] new modlist is \"$list\"\n";
    closedir(MODDIR);
    }
  
  
  foreach $_ (split(',', $list)) {

    undef $neg;
    undef $gotlist;
    undef %n;
    undef @a;
    undef @runs;
    ($modulename, $_) = split($delim1);

    ## axe the last ']'
    chop;

    ## get a list of which things to run
    foreach $_ (split($delim2)) {
	 $gotlist = 1;
	 if (substr($_, 0, 1) eq $negatestr) {
        if ($pos) { $files{'__error__'} = 1; return %files; }
        $neg = 1;
        $n{substr($_, 1)} = 1;
        }
	 else {
	   if ($neg) { $files{'__error__'} = 1; return %files; }
	   $pos = 1;
        push(@a, $_);
        }
	 }

    if ($gotlist) {
	 if ($neg) {
	   foreach $dir ('', "$os{'name'}/common", "$os{'name'}/$os{'version'}") {
     	opendir(DIR, "$moduledir/$modulename/$dir");
     	while ($_ = readdir(DIR)) {
            if (( substr($_, (length($_) -3)) eq '.pl' ) &&
          	 ( !$n{substr($_, 0, (length($_) -3))} )) {
              push(@runs, "$modulename/$dir/$_");
              $runs[$#runs] =~ s/\/+/\//g;
              }
            }
     	closedir(DIR);
     	}
	   }
	 else {
	   foreach $dir ('', "$os{'name'}/common", "$os{'name'}/$os{'version'}") {
     	foreach $scan (@a) {
     	  if (-e "$moduledir/$modulename/$dir/$scan.pl") {
              push(@runs, "$modulename/$dir/$scan.pl");
              $runs[$#runs] =~ s/\/+/\//g;
              }
     	  }
     	}
	   }
	 }
    else {
	 foreach $dir ('', "$os{'name'}/common", "$os{'name'}/$os{'version'}") {
        opendir(DIR, "$moduledir/$modulename/$dir");
        while ($_ = readdir(DIR)) {
     	if (substr($_, (length($_) -3)) eq '.pl') {
     	  push(@runs, "$modulename/$dir/$_");
     	  $runs[$#runs] =~ s/\/+/\//g;
     	  }
     	}
        closedir(DIR);
        }
	 }
    $files{$modulename} = join(' ', @runs);
    }
  return %files;
  }
