# Copyright (C) 1999-2005 Jay Beale
# Copyright (C) 2001-2003 Hewlett Packard Corporation
# Licensed under the GNU General Public License
package Bastille::IOLoader;
use lib "/usr/lib";

require Bastille::API;
import Bastille::API;

use Bastille::TestAPI;
use File::Path;
use Exporter;
@ISA = qw ( Exporter );
@EXPORT = qw( Load_Questions compareQandA validateAnswer ReadConfig isConfigDefined
	      validateAnswers getRegExp checkQtree outputConfig partialSave
	      %Question %moduleHead
	      );

@ENV="";
$ENV{PATH}="";
$ENV{CDPATH}=".";
$ENV{BASH_ENV}="";

my %deletedQText;  # variable used to store the question text from
                  # questions that will be deleted but are distro appropriate.
                  #  Used in Load_Questions and outputConfig

###############################################################################
# &Load_Questions does:
#
# 1) Create a question record for the Title screen: no question, no default
#    answer, toggle_yn=0, just a Short Explanation=Title Screen
# 2) Load in each question, one by one, by grabbing the expected records one 
#    by one from a file.  Records, within the file, are described below.  
# 3) Append a "Done now--gonna run the script" screen as Y/N question...  Needs
#    to have Yes-Child to be Bastille_Finish  QuestionName:  End_Screen
#
# Record format within Questions file:
# - A record is terminated by a blank line which is not part of a quoted
#   string.
# - A new record is began by the LABEL: tag, along with the index for the
#   question.
# - Otherwise, the entries within the record can be in any order at all.  
# - Multi-line fields must be quoted in double-quotes..
# - Double quotes are allowed inside a string, but must be escaped, like \".
#
###############################################################################

sub Load_Questions($) {
# sub Load_Questions creates a data structure called %%Questions
  my $UseRequiresRules = $_[0];

  my ($current_module_number,$first_question) = &parse_questions();
  &Load_Scoring_Weights();
  $first_question = &prune_questions($UseRequiresRules,$first_question);
  &validate_questions();

  return ($current_module_number, $first_question);
}

sub parse_questions() {

    # Line loaded in from file and it's non-tag data
    my ($line,$data);
    my @questionFile;
    
    # Line number (within the disk file)
    my $line_number=0;
    
    # Module to which the current question being loaded in belongs and
    # the order that Load_Questions loads it in
    my $current_module;
    my $current_module_number=0;
    
    # Question (record) that we're in, listed by index(LABEL) 
    my $current_index;
    
    # The first and last questions -- used for Title_Screen and End_Screen 
    my $first_question="";
    my $previous_question="";
    my $previous_module = "";

    # Field we're in
    my $current_field;
    
    
    # OK, so here's how this goes.  The config file looks has a series of
    # records, which have a series of  TAG: value    lines.  A value may span
    # multiple lines if it was begun with a  "  mark, but is usually expected
    # to be a string.  " marks can occur inside records, if escaped:  \"
    # Records end with a blank line and begin with a LABEL: tag.  We get module
    # names from FILE: somename.pm  lines, which should have whitespace around
    # them...
    
    # Major change: we're parsing questions out of Questions/<module>.txt now,
    # getting our module names from Modules.txt.

    #unless (open QUESTIONS,&getGlobal('BFILE',"Questions")) {
    #   &B_log("ERROR","Can't open ./Questions.txt data file.\n");
    #   exit(1);
    #}

    # Get the list of questions files, each corresponding to one module
    unless (open QUESTIONS_MODULES,&getGlobal('BFILE','QuestionsModules')) {
	&B_log("ERROR","Can't open ./Modules.txt data file to get our list of modules.\n");
       exit(1);
    }

    my @module_list = <QUESTIONS_MODULES>;
    close QUESTIONS_MODULES;
    chomp @module_list;

    my $module_path = &getGlobal('BDIR','QuestionsDir') . '/';
    foreach $questions_module (@module_list) {
	$questions_module .= '.txt';

	unless (open QUESTIONS,$module_path . $questions_module) {
	    &B_log("ERROR","Can't open $module_path$questions_module questions file.\n");
	    exit(1);
	}

	# Load the Questions in.
	my @questions_data = <QUESTIONS>;
	close QUESTIONS;

	# To close the current record at the end of a file, we're going to add
	# a blank line.  This is because the code as written expects a single Questions
	# file and thus a blank line between records.  Rather than dramatically change
	# that logic, we'll adapt it more simply by adding the line below.
	push @questions_data,"\n";

    # Avoiding indention on the next CVS checkin to make these changes clearer.
    # Don't tell Larry and I'll make sure to make the indention on the next major 
    # checkin.  - Jay

    foreach $line (@questions_data) {
#    while ($line=<QUESTIONS>) {
	
	# Increment line number
	$line_number++;
	
	# If we're currently in a question record...
	if ($current_index) {
	    
	    # If we're currently in a __multi-line__ record (a quoted string),
	    if ($current_field) {
		
		# See if it's terminated in a quote (i.e. is end of a string?)
		my $end_of_string=0;

		if ($line =~ /^(.*)\"\s*\n*$/) {
		    # Make sure the terminating quote isn't an escaped quote
		    my $templine=$1;
		    unless ($templine =~ /\\$/) {
			$line=$templine;
			$end_of_string=1;
		    }
		}
		
		#
		### Text Handling
		#
		
		# Convert escaped quotes \" to real quotes "
		$line =~ s/\\\"/\"/g;
		
		# Strip out terminating \n's
		unless ($line =~ /^\s*\n+\s*$/) {
		    if ($line =~ /^(.*)\n$/) {
			$line = $1 . " ";
		    }
		}
		else {
		    $line .= "\n";
		}
		
		# Add the line to the end of the record and ...
		if ($Question{$current_index}{$current_field} =~ /[^\s\n]$/) {
		    $Question{$current_index}{$current_field} .= " ";
		}
		
		$Question{$current_index}{$current_field}.=$line;
		
		# Check if the record is over.
		if ($end_of_string) {
		    $current_field="";
	        }
            }
            else {
                # We're _not_ in a multi-line record
		
		# Did we hit a blank line? Blank lines, not embedded in
		#  " marks, delimit records
		if ($line =~/^\s*$/) {
		    $current_field="";
		    $current_index="";
		}
		else {
		    # Figure out what field to put this data in...
		    ($current_field,$data) = &getFieldData($line,$line_number);

		    # If the data isn't quoted, just finish up...
		    unless ( ($data =~ /^\"/ ) or ($data =~ /[^\\]\"$/) ){
			
			# Convert escaped quote marks
			$data =~ s/\\\"/\"/g;
			
			
			# If this is the REQUIRE_DISTRO field, expand any macros
			if ($current_field eq 'require_distro') {
			    
			    # Replace macros with their (by design) hard-coded values,
			    # making sure to respect recursively defined macros.
			    
			    if ($data =~ /\bLINUX\b/) {
				my $supported_distros = 'RH MN RHEL RHFC DB SE';
				$data =~ s/\bLINUX\b/$supported_distros/;
			    }
			    if ($data =~ /\bRH\b/) {
				my $supported_versions = 'RH6.0 RH6.1 RH6.2 RH7.0 RH7.1 RH7.2 RH7.3 RH8.0 RH9.0 RH9 RHEL4 RHEL3 RHEL2 RHFC';
				$data =~ s/\bRH\b/$supported_versions/;
			    }
			    if ($data =~ /\bRHEL\b/) {
				my $supported_versions = 'RHEL4AS RHEL4ES RHEL4WS RHEL3AS RHEL3ES RHEL3WS RHEL2AS RHEL2ES RHEL2WS';
                                $data =~ s/\bRHEL\b/$supported_versions/;
                            }
			    if ($data =~ /\bRHEL4\b/) {
                                my $supported_versions = 'RHEL4AS RHEL4ES RHEL4WS';
                                $data =~ s/\bRHEL4\b/$supported_versions/;
                            }
                            if ($data =~ /\bRHEL3\b/) {
                                my $supported_versions = 'RHEL3AS RHEL3ES RHEL3WS';
                                $data =~ s/\bRHEL3\b/$supported_versions/;
                            }
			    if ($data =~ /\bRHEL2\b/) {
                                my $supported_versions = 'RHEL2AS RHEL2ES RHEL2WS';
                                $data =~ s/\bRHEL2\b/$supported_versions/;
                            }
			    if ($data =~ /\bRHFC\b/) {
				# We want Fedora Core to look like a Red Hat
				# product for compatibility tests, since it is.
				my $supported_versions = 'RHFC1 RHFC2 RHFC3 RHFC4 RHFC5';
				$data =~ s/\bRHFC\b/$supported_versions/;
			    }
			    if ($data =~ /\bMN\b/) {
				my $supported_versions = 'MN6.0 MN6.1 MN6.2 MN7.0 MN7.1 MN7.2 MN8.0 MN8.1 MN8.2 MN9.2 MN10.0 MN10.1 MN2006.0';
				$data =~ s/\bMN\b/$supported_versions/;
			    }
			    if ($data =~ /\bDB\b/) {
				my $supported_versions = 'DB2.2 DB3.0';
				$data =~ s/\bDB\b/$supported_versions/;
			    } 
			    if ($data =~ /\bSE\b/) {
                                my $supported_versions = 'SE7.2 SE7.3 SE8.0 SE9.0 SE9.1 SE9.2 SE9.3 SE10.0 SESLES';
                                $data =~ s/\bSE\b/$supported_versions/;
                            }
			    if ($data =~ /\bSESLES\b/) {
 				my $supported_versions = 'SESLES8 SESLES9';
 				$data =~ s/\bSESLES\b/$supported_versions/;
 			    }
                            if ($data =~ /\bTB\b/) {
                                my $supported_versions = 'TB7.0';
                                $data =~ s/\bTB\b/$supported_versions/;
                            }
			    if ($data =~ /\bHP-UX\b/) {
				my $supported_versions = 'HP-UX11.00 HP-UX11.11 HP-UX11.22 HP-UX11.23 HP-UX11.31';
				$data =~ s/\bHP-UX\b/$supported_versions/;
			    }
			    if ($data =~ /\bOSX\b/) {
				my $supported_versions = 'OSX10.2 OSX10.3';
				$data =~ s/\bOSX\b/$supported_versions/;
			    }
			}
			
			$Question{$current_index}{$current_field}=$data;
			
			$current_field="";
		    }
		    else {
			# Make sure this looks like a real quoted string
			if ($data !~ /^\s*\"/) {
			    &B_log("ERROR","Mis-quoted line\n\n$line\n\n" .
			              "         Line number $line_number\n");
                            exit(1);
			}
			
			# Strip off initiating quote mark
		        if ($data =~ /^\s*\"(.*)$/) {
			    $data=$1;
			}
			
			# If this thing has a terminating quote mark, it is a
			# single-line quoted record, probably used to preserve
			# leading or trailing whitespace.
			if ($data =~ /[^\\]\"$/) {
			    
			    if ($data =~ /^(.*)([^\\])\"$/) {
				$data=$1 . $2;
				
				# Convert escaped quote marks
				$data =~ s/\\\"/\"/g;
				
				$Question{$current_index}{$current_field}=$data;
				$current_field="";
			    }
			}
			# Otherwise, it is the beginning of a multi-line record
			else {
			    
			    # Strip off end \n's
			    unless ($data =~ /^\s*\n+\s*$/) {
				if ($data =~ /^(.*)\n$/) {
				    $data=$1 . " ";
				}
			    }
			    
			    # Convert escaped quote marks
			    $data =~ s/\\\"/\"/g;
			    			
			    # Now, actually copy the data in
			    $Question{$current_index}{$current_field}=$data;
			}

		    }		 
		
		}
	    }
	}
	# OK, so we're not in a record (Question) at all...
	else {
	    
	    # Are we starting a new one, on another blank line, or getting a
	    # module name?
	    if ($line =~ /^LABEL:\s*(.*)$/) {
		
		# We have found a new record...
		$current_index=$1;
		
		# Prune whitespace from the name
		if ($current_index=~/^(.*)\s+$/) {
		    $current_index =$1;
		}
		
		$Question{$current_index}{"module"}=$current_module;
		$Question{$current_index}{"shortModule"} = (split(/.pm/,$current_module))[0];

		$current_field="";  # This is not a multi-line record
		
                # Record the name of the record so sanity checks can be done
		# later
		$recordnames[@recordnames]=$current_index;
		
		#
		# Put together proper ties for Questions so that each question ties to the one
		# before it and the one after it unless proper_parent, yes_child or no_child
		# are explicitly listed.  For proper_parent, we just set a default and let it
		# get clobbered in the parsing process.  For children, we check their existence.
		#

                # If this is the first record (question), treat it differently.  
		# Make the necessary link from Title_Screen record and don't try to set children
		# entries in the parent.
		unless ( $first_question ) {
		    $first_question=$current_index;
		    $Question{$current_index}{"proper_parent"} = $current_index;
		}
		# ...otherwise proceed as normal
		else {

		    $Question{$current_index}{'proper_parent'} = $previous_question;
		    unless ($Question{$previous_question}{'yes_child'}) {
			$Question{$previous_question}{'yes_child'}=$current_index;
		    }
		    unless ($Question{$previous_question}{'no_child'}) {
			$Question{$previous_question}{'no_child'}=$current_index;
		    }
		}
		
		# Save the value of the current index so the End_Screen can
		# find the right parent...
		$previous_question=$current_index;
		
	    }
	    elsif ($line =~ /^FILE:\s*(.*)$/) {
		# Record the module we're leaving.
		$previous_module = $current_module;

		# Started a new module name...
		$current_module_number++;
		$current_module=$1 . " Module $current_module_number";

	    }
	    elsif ($line =~ /^\s*$/) {
		# A blank line
		# do nothing
	    }
	    else {
                &B_log("ERROR","Invalid question record found at line $line_number\n" .
                          "         of Questions.txt.  Expecting FILE: or LABEL:\n" .
                          "         Found \n\n$line\n" .
                          "         instead.  This is a fatal error, exiting...\n");
                exit(1);
	    }
	}
    }

#    close QUESTIONS;

    }
    
    return ($current_module_number, $first_question);
}


################################################################################
# &getFieldData($line,$line_number);
#
# Given a line and line number this subroutines the Questions current field
# type and the data in that field.
################################################################################
sub getFieldData($$) {

    my $line = $_[0];
    my $line_number = $_[1];

    my $current_field="";
    my $data = "";

    if ($line =~ /^SHORT_EXP:(.*)$/) {
	$current_field="short_exp";
    }
    elsif ($line =~ /^LONG_EXP:(.*)$/) { 
	$current_field="long_exp";
    }
    elsif ($line =~ /^QUESTION:(.*)$/) {
	$current_field="question";
    }
    elsif ($line =~ /^QUESTION_AUDIT:(.*)$/) {
	$current_field="question_audit";
    }
    elsif ($line =~ /^DEFAULT_ANSWER:(.*)$/) {
	$current_field="answer";
    }
    # What I wouldn't give for a case/switch in Perl...
    elsif ($line =~ /^YES_EXP:(.*)$/) {
	$current_field="yes_epilogue";
    }
    elsif ($line =~ /^NO_EXP:(.*)$/) {
	$current_field="no_epilogue";
    }
    elsif ($line =~ /^CONFIRM_TEXT:(.*)$/) {
	$current_field="confirm_text";
    }
    elsif ($line =~ /^REQUIRE_IS_SUID:(.*)$/) {
	$current_field="require_is_suid";
    }
    elsif ($line =~ /^REQUIRE_FILE_EXISTS:(.*)$/) {
	$current_field="require_file_exists";
    }
    elsif ($line =~ /^REQUIRE_DISTRO:(.*)$/) {
	$current_field="require_distro";
    }
    elsif ($line =~ /^YN_TOGGLE:(.*)$/) {
	$current_field="toggle_yn";
    }
    elsif ($line =~ /^YES_CHILD:(.*)$/) {
	$current_field="yes_child";
    }
    elsif ($line =~ /^NO_CHILD:(.*)$/) {
	$current_field="no_child";
    }
    elsif ($line =~ /^SKIP_CHILD:(.*)$/) {
	$current_field="skip_child";
    }
    elsif ($line =~ /^PROPER_PARENT:(.*)$/) {
	$current_field="proper_parent";
    }
    elsif ($line =~ /^REG_EXP:(.*)$/) {
	$current_field="reg_exp";
    }
    elsif ($line =~ /^EXPL_ANS:(.*)$/) {
	$current_field="expl_ans";
    }
    else {
	# UH OH!!! We've found a line (inside a record)
	# that isn't recognized
	&B_log("ERROR","The following line (inside " .
	       "a record is not recognized.\n\n$line\n\n".
	       "          Line number: $line_number\n");
	exit(1);
    }

    # OK, we've know out what field to assign this data to...
    $data =$1;
    
    # Strip off any initiating white space
    if ($data =~ /^\s+(.*)$/) {
	$data=$1;
    }
    
    # Strip off any terminating white space...
    if ($data =~ /^(.*)\s+$/) {
	$data=$1;
    }

    return ($current_field, $data);

}




sub prune_questions ($$) {
    my $UseRequiresRules = $_[0];
    my $first_question = $_[1];
    
    ##############################################
    # Walk through $Question hash, eliminating   #
    # questions that don't apply to this system. #
    #                                            #
    # Use the new requires- fields to figure out #
    # which questions to prune.  Prune by simply #
    # moving the parent/child pointers to skip   #
    # around the question.                       #
    #                        - JJB 3/2001        #
    ##############################################

    # Additionally, log the information found 
    # during the pruning to help administrators
    # and auditors discover the current state of
    # the system's hardening measures.
    #   JJB 4/2005
 
    &OpenAuditReport;

    # Start score computation
    my $score;

    # Walk through the items/questions.
    
    foreach my $key (@recordnames) {

      # Test all requires 
      #
      # If the distro is correct and any of the other tests pass, 
      # show the question.  Otherwise, skip to the skip_child
      #
      # Example:
      # REQUIRE_DISTRO: RH6.0 HP-UX11.00
      # REQUIRE_IS_SUID: foo bar
      # REQUIRE_FILE_EXISTS: alpha beta gamma
      #
      # should return true iff
      # (we are on a RH6.0 or HP-UX11.00 machine) and
      # (either foo or bar is SUID) or
      # (any of alpha, beta, or gamma exist) or
      # (the internal require test for the question returns 0 or undef)
      #
      # we shortcut the rest of the tests if the DISTRO is wrong
      # for efficiency and because the appropriate hash values
      # may not be defined.

      my $skip_this_question=0;

      my %require_tests;
      
      #print "Key: $key\n";
      
      ####### CHECK OS VERSION TO SEE IF THE QUESTION IS APPLICABLE
      my $require_distro=$Question{$key}{"require_distro"};
      my @require_distro_array;
      (@require_distro_array) = split(/\s+/,$require_distro);
      
      my $distro_is_appropriate=0;
      
      foreach my $distro ( @require_distro_array ) {
	  #print "Testing for distro $distro\n";
	  if ($distro eq &GetDistro ) {
	      $distro_is_appropriate=1;
	  }
      }

      if ($distro_is_appropriate) {
	  # Note: UseRequiresRules doesn't work exactly like you'd expect
	  #       because in some cases "not" is implemented
	  #       using the SKIP_CHILD.  Hence, some questions are never
	  #       reached unless you SKIP another question
	  #       When this happens, change the question to use a negated
	  #       test instead of using SKIP.
	  if ( $UseRequiresRules eq 'Y') {
	      
            if ( defined $Question{$key}{"require_is_suid"} ) {
	      my $require_is_suid=$Question{$key}{"require_is_suid"};
	      #print "Parsing suid requirement tag: $require_is_suid\n";
	      
	      # NOTE: the anonymous subroutine stuff can get a little
	      # weird.  What we're doing here is defining a code-block
	      # that will be run a little later on.  The value of 
	      # $require_is_suid will be determined at the time the
	      # code block gets run, which is run later on.  It's
	      # still in the same scope, so it will use the same value. 
	      
	      # The "return"s will return out of the anonymous sub, but not
	      # out of the current subroutine
	      
	      $require_tests{"suidbin"} = sub {
		  # we only return 1 (skip) if the REQUIRE_IS_SUID tag has
		  # values and one of them exists.
		  my $retval=0; # no values
		  foreach my $suidbin ( split(/\s+/,$require_is_suid) ) {
		      if ( -u &getGlobal('BIN',$suidbin)) {
			  return 0; # ask question if any suid bits are set
		      } else {
			  $retval=1; # now default to skipping; we've been here
		      }
		  }
		  return $retval;# will skip unless we never looped
	      };
	    }  

            if ( defined $Question{$key}{"require_file_exists"} ) {
	      my $require_file_exists=$Question{$key}{"require_file_exists"};
	      #print "Parsing requires file tag: $require_file_exists\n";
	      
	      # NOTE: here's more weird anonymous subroutine stuff.  See
	      # the note above.  Same structure here as the SUID stuff.
	      $require_tests{"file"} = sub { 
		  my $retval=0; # no values
		  foreach my $file ( split(/\s+/,$require_file_exists) ) {
		      if ( -e &getGlobal('FILE',$file)) {
			  return 0; # ask question if any of the files exists
		      } else {
			  $retval=1; # now default to skipping; we've been here
		      }
		  }
		  return $retval; # will skip unless we never looped
	      };
	    }  

	    # TODO: replace all references to REQUIRE_IS_SUID and 
	    # REQUIRE_FILE_EXISTS with internal tests.  Then, just use 
            # B_run_test directly.  For now, we'll make a subroutine 
            # in the hash of tests to call it
	      
            # Here we use the anonymous subroutines defined for each individual
            # question, which are much more flexible than just the REQUIRE_FILE
            # and REQUIRE_SUID routines.
	      $require_tests{"internaltest"} = sub { &B_run_test($Question{$key}{'shortModule'},$key); };
	     
	      # run non-distro tests.  If the question does not fit, then
	      # juggle the pointers.

	      foreach my $test (keys %require_tests) {
		  #print "running test -- $test --\n";
		  # NOTE: here is where we actually run those anonymous
		  # subroutines defined above.
#		  if ( &{$require_tests{"$test"}}) {
		  if (not defined($require_tests{"$test"})) {
		      print AUDIT_LOG "NOTEST: Not including test for " . $Question{$key}{'shortModule'} . ".$key\n";
		      next;
		  }
 		  my $result = &{$require_tests{"$test"}};
 		  if ( defined($result) ) {

		      if ($test eq 'internaltest') {
			  # Create a page about the hardening item for the report.
			  &PrintAuditPage($key);

			  # Store the result.
			  $Question{$key}{'result'} = $result;
			  my $module = $Question{$key}{'shortModule'};
			  push @{ $TestedItems{$module} },$key;
			  $TestedModules{$module}=1;

			  # Add this item to the score if it has a question.
			  # This restriction gets us past items that are not actually questions, items that, say, introduce a concept.
			  unless ($Question{$key}{'question_audit'} =~ /^\s*$/) {
			      $score += $Question{$key}{'weight'} * $result;
			      $weight += $Question{$key}{'weight'};
			  }
		      }

		      # Contribute a line to the reports.
		      unless ($Question{$key}{'question_audit'} =~ /^\s*$/) {
			  &PrintAuditLine($key,$result);
		      }

		      if ($result) {
			  &B_log("DEBUG","Question $Question{$key}{'shortModule'}.$key will be skipped " .
                                 "because of the $test test\n");
			  $skip_this_question=1;

			  # Print the audit log and report
#			  if ($test eq 'internaltest') {

			  # Skip remaining tests?
			  #last;
		      }
		      else {
			  #if ($test eq 'internaltest') {
		      }

		  }
		  else {
		      if (! defined($Question{$key}{'weight'})) {
			  print AUDIT_LOG "DEBUG: Test not defined for Module " . $Question{$key}{'shortModule'} . " $key\n";
		      }
		  }
	      }
	  }       
      } else {
	  $skip_this_question=1;
      }
	
      # OK, if we didn't meet all the requirements, skip this question.
      # 
      # This is rudimentary pointer mangling.  There are serious speed-ups
      # that we can make by thinking more about tree traversals -- this 
      # is the "simple" implementation intended to introduce the 
      # functionality.  Let's speed it up later, for 1.2.x, x>0.
      #
      # - JJB 3/2001
	
      #print "skip_this_question=$skip_this_question\n";
      if ($skip_this_question) {
	  
	  my $parent=$Question{$key}{"proper_parent"};
	  my $child;
	  
	  # Choose the next question to go to carefully
	  if ($Question{$key}{"yes_child"} eq $Question{$key}{"no_child"}) {
	      $child = $Question{$key}{"yes_child"};
	  }
	  
	  # if there is a skip child, use it
	  if (defined $Question{$key}{"skip_child"}) {
	      $child = $Question{$key}{"skip_child"};
	  }
	  
	  #Now do the pruning.
	  if ($child) {
	      # insure that first question is a valid question
	      if("$key" eq "$first_question"){
		  $first_question = $child;
	      }
	      my $loop_over_key;
	      #print "Pruning $key\n";
	      foreach $loop_over_key (keys(%Question)) {
		  
		  # Any questions which have the phantom question as a child
		  # should now point to the phantom's child instead.
		  if ($Question{$loop_over_key}{"yes_child"} eq $key) {
		      $Question{$loop_over_key}{"yes_child"}=$child;
		  }
		  if ($Question{$loop_over_key}{"no_child"} eq $key) {
		      $Question{$loop_over_key}{"no_child"}=$child;
		  }
		  # This gets tricky...think about this one deeply before
		    # emailing me on this.  - JJB
		  if ($Question{$loop_over_key}{"proper_parent"} eq $key) {
		      
		      $Question{$loop_over_key}{"proper_parent"}=$parent;
		  }
	      }
	      if($distro_is_appropriate) {
		  $deletedQText{$key} = $Question{$key}{'question'};
	      }
	      
	      $Question{$key}{'deleteme'} = "Y";
	      
	  }
	  else {
	      &B_log("ERROR","Question $key couldn't be skipped because Bastille\n" .
                        "         couldn't figure out which question to skip to!\n");
	  }
      }

  }
      
    ##############################################
    #   Delete irrelevant questions.             #
    ##############################################
    foreach my $key (keys %Question) {
	
	if($Question{$key}{'deleteme'} eq "Y"){
	    delete $Question{$key};
	}
	else {
	    $Question{$key}{"default_answer"}=$Question{$key}{'answer'};
	}

    }

    &CloseAuditReport($score,$weight);
#    &CreateAuditReport(\%Question);

    if ($GLOBAL_AUDITONLY) {

	print "\n\n";
	print "==============================================================================\n";
	print "| Bastille Hardening Assessment Completed                                    |\n";
	print "|                                                                            |\n";
	print "| You can find a report in HTML format at:                                   |\n";
	print "|   file:///var/log/Bastille/Assessment/assessment-report.html               |\n";
	print "|                                                                            |\n";
	print "| You can find a report in text format at:                                   |\n";
	print "|                                                                            |\n";
	print "|   /var/log/Bastille/Assessment/assessment-report.txt                       |\n";
	print "|                                                                            |\n";
	print "| You can find a more machine-parseable report at:                           |\n";
	print "|                                                                            |\n";
	print "|   /var/log/Bastille/Assessment/assessment-log.txt                          |\n";
	print "==============================================================================\n";
	print "\n\n";

	# Secret code for not having browser pop up
	if ( -e "/etc/Bastille/.nobrowser" )  {
	    exit 0;
	}
	if ( $GLOBAL_AUDIT_NO_BROWSER ) {
	    exit 0;
	}

	print "   Attempting to launch a browser to view the report...\n\n";

	#################
	# Open a browser
	#################

	# Give the user back some PATH information
	$ENV{'PATH'} = "/bin:/usr/bin:/usr/local/bin:/opt/bin";

	# Check for X
	if ( $ENV{DISPLAY} ne '' ) {    
	    
	    my @graphical_browsers_full_path = ('/usr/bin/mozilla','/usr/bin/firefox','/usr/bin/netscape');
	    my @graphical_browsers_no_path = ('mozilla','firefox','netscape');

	    # Try common browsers by path
	    foreach $possible_browser (@graphical_browsers_full_path) {
		if ( -x $possible_browser) {
		    print "Found browser $possible_browser -- launching...\n";
		    exec "$possible_browser file:///var/log/Bastille/Assessment/assessment-report.html";
		}
	    }
	    # Try common browsers using which to find them -- consider changing this to check for the relevant package.
	    foreach $possible_browser (@graphical_browsers_no_path) {
		my $browser_path = `which $possible_browser`;
		unless ($browser_path =~ /^.*\/which: no/) {
		    if ( -x $browser_path) {
			print "Found browser $browser_path -- launching...\n";
			exec "$browser_path file:///var/log/Bastille/Assessment/assessment-report.html";
		    }
		}
	    }

	    print "X is available, but Bastille failed to find a graphical browser.\n";
	}
	# else {
	if (1) {
	# If we failed to find a capable graphical browser, try the non-graphical one.
	    # No X
	    my @nongraphical_browsers_full_path = ('/usr/bin/links','/usr/bin/w3m','/usr/bin/lynx');
	    my @nongraphical_browsers_no_path = ('links','w3m','lynx');

	    # Try common browsers by path
	    foreach $possible_browser (@nongraphical_browsers_full_path) {
		if ( -x $possible_browser) {
		    print "Found browser $possible_browser -- launching...\n";
		    exec "$possible_browser file:///var/log/Bastille/Assessment/assessment-report.html";
		}
	    }
	    # Try common browsers using which to find them -- consider changing this to check for the relevant package.
	    foreach $possible_browser (@nongraphical_browsers_no_path) {
		my $browser_path = `which $possible_browser`;
		unless ($browser_path =~ /^.*\/which: no/) {
		    if ( -x $browser_path) {
			print "Found browser $browser_path -- launching...\n";
			exec "$browser_path file:///var/log/Bastille/Assessment/assessment-report.html";
		    }
		}
	    }
	}
	exit 0;
    }

    # If we're in audit-only mode ($GLOBAL_AUDITONLY is set), we shouldn't get here.

    return $first_question;
}

sub validate_questions () {
    ##############################################
    #   Run sanity checks on questions database  #
    ##############################################
    
    foreach my $key (keys %Question) {
	
	my ($parent,$yes_child,$no_child);

	$parent=$Question{$key}{"proper_parent"};
	$yes_child=$Question{$key}{"yes_child"};

	my $current_module = $Question{$key}{'shortModule'};
	my $parent_module = $Question{$parent}{'shortModule'};

        my $no_child_to_print="";

	if ($Question{$key}{"toggle_yn"}) {
	    $no_child=$Question{$key}{"no_child"};
            my $no_child_to_print=$no_child;
	}

	&B_log("DEBUG","LABEL: $key\n".
	          "Yes-child: $yes_child\n".	    
	          "No-child:  $no_child_to_print\n".
	          "Parent:    $parent\n".
	          "Short expression:\n".
	          $Question{$key}{"short_exp"}.
	          "Long expression:\n".
	          $Question{$key}{"long_exp"}.
	          "Question:\n".
	          $Question{$key}{"question"}.
	          "\nDefault: ". $Question{$key}{"default_answer"}."\n\n");

        my $problemfound=0;
        unless ($parent) {
	    &B_log("ERROR","Problem found in Question database. $key doesn't have a parent!\n" .
                      "         This is likely to cause problems later.\n");
            $problemfound=1;
        }

        unless (exists ($Question{$parent})) {
	    &B_log("ERROR","Problem found in Question database. $key\'s parent \"$parent\"\n" .
                      "         does not exist!  This is likely to cause problems later.\n");
            $problemfound=1;
        }

	# Allows for header/footer question wrap to come later. IE Title_Screen End_Screen
	if(exists $Question{$key} && $Question{$key}{"yes_child"} !~ "End_Screen"){
            unless (exists ($Question{$yes_child})) {
	        &B_log("ERROR","Problem found in Question database. $key\'s yes_child \"$yes_child\"\n" .
                          "         does not exist!  This is likely to cause problems later.\n");
                $problemfound=1;
            }
	}

        unless ($yes_child) {
	        &B_log("ERROR","Problem found in Question database. $key has no yes child.\n" .
                          "         This is likely to cause problems later.\n");
                $problemfound=1;
        }

	if (exists $Question{$key} && $Question{$key}{"toggle_yn"}) {
            unless ($no_child) {
	        &B_log("ERROR","Problem found in Question database. $key has no no_child.\n" .
                          "         This is likely to cause problems later.\n");
                $problemfound=1;
            }

	    # Allows for header/footer question wrap to come later. IE Title_Screen End_Screen
	    if(exists $Question{$key} && $Question{$key}{"no_child"} !~ "End_Screen"){
                unless (exists ($Question{$no_child})) {
	            &B_log("ERROR","Problem found in Question database. $key\'s no_child \"$no_child\"\n" .
                              "         does not exist!  This is likely to cause problems later.\n");
                    $problemfound=1;
                }
	    }

            unless ( $Question{$key}{"question"} ) {
	            &B_log("ERROR","Problem found in Question database. y/n question $key\n" .
                              "         has no Question!  This is likely to cause problems later.\n");
                    $problemfound=1;
            }
	    
	}

        if ($problemfound) {
           &B_log("ERROR","Earlier problems are preventing correct Bastille execution.  Exiting.\n");
           exit(1);
        }

	# finds the first question in each module.
	if($parent_module ne $current_module){
	    # moduleHead is a global that will be sent to Interactive for progress indication
	    $moduleHead{$current_module} = $key;
	}

    }
    
#    if ($TEST_ONLY) {
#	exit;
#    }      
    
    # Return number of modules loaded in and the index of the first questions.
}

###########################################################################
# &ReadConfig reads in the user's choices from the TUI, stored in the file
# $GLOBAL_BFILE{"config"}.  We were using AppConfig here at first, but it was
# just such a pain in the, ermm, keyboard...
#
###########################################################################

sub ReadConfig {

    if (open CONFIG, &getGlobal('BFILE', "config")) {
	while (my $line = <CONFIG>) {
	    chomp $line;
	    # Skip commented lines...
	    unless ($line =~ /^\s*\#/) {
		if ($line =~ /^\s*(\w+).(\w+)\s*=\s*\"(.*)\"/ ) {
		    $GLOBAL_CONFIG{$1}{$2}=$3;
		    
		    if (exists $Question{$2}) {
			# This is only used by the front end to populate the 
			# "defaults".  It will cause problems with the back end
			# if we accidentally create a %Question entry based on
			# the config file for a question that didn't exist
			$Question{$2}{'answer'} = $3;
		    }
		}  # if the line contains non-whitespace
		elsif($line !~ /^\s*$/) {
		    &B_log("WARNING","The following line in the configuration file is invalid:\n" . 
			      "$line\n" .
			      "The line will be disregarded.\n\n");
		}
	    }
	}
	close CONFIG;
      return 1;
    }

    # Failed to open config
    return 0;
}



######################################################################
# compareQandA($first_question)
#      This subroutine takes the pruned questions hash and the
#      GLOBAL_CONFIG hashes and does an index compare of the two
#      This program is meant to be run just before the back end
#      It is designed to insure multi-system support.  That is,
#      it tests the config file for question validity on the current
#      machine before the back end will run.
#
#      This function returns:
#        0 for WARNING questions were not answered or questions were
#          answered that do not apply to the current system.
#        1 for correct match of questions and answers.
#
#      REQUIRES %Question
#      REQUIRES %GLOBAL_CONFIG
#      REQUIRES &ActionLog
#      REQUIRES &ErrorLog
#
######################################################################

sub compareQandA($$) {
###
    my $first_question = $_[0];
    my $force = $_[1];
    my $returnValue = "";
    my $sumNotAsked = 0;
    my $warnFlag = 0;

    # this checks to see if any questions were not answered that should
    # have been.
    my ($moduleNotAnswered,$questionNotAnswered) = &checkQtree($first_question);

    
    # if checkQtree returns a question that has not been answered
    if ($questionNotAnswered ne "" && ! $force) {
	&B_log("FATAL","A fatal error has occurred. Not all of the questions\n" .
		  "that pertain to this system have been answered.  Rerun\n" .
		  "the interactive portion of Bastille on this system.\n" . 
		  "MODULE.QUESTION=$moduleNotAnswered.$questionNotAnswered\n");
	exit(1);
    }

    # This section checks to see if a question was answered that does
    # not make sense on this machine.
    for my $module ( keys %GLOBAL_CONFIG ) {
	for my $key (keys %{$GLOBAL_CONFIG{$module}}){
	    # check to see if the question should be answered
	    if( (!(exists $Question{$key}) ) || ($Question{$key}{"mark"} ne "OK") ){
		# This prunes the answer out if the question should
		# not have been answered
		my $parent = $Question{$key}{'proper_parent'};
		my $parentMod = $Question{$parent}{'shortModule'};

		# This logic tells us if other values in the config will be affected by removing this answer
		if($Question{$parent}{'toggle_yn'} eq "1")  {
			  
		    if($Question{$parent}{'no_child'} ne $Question{$parent}{'yes_child'}) {
			
			if($Question{$parent}{'no_child'} eq $key && $GLOBAL_CONFIG{$parentMod}{$parent} eq "Y"){
			    $warnFlag = 1;
			}
			elsif($Question{$parent}{'yes_child'} eq $key && $GLOBAL_CONFIG{$parentMod}{$parent} eq "N"){
			    $warnFlag = 1;
			}
		    }
		}
		if(! $force) {
		    delete $GLOBAL_CONFIG{$module}{$key};
		    &B_log("DEBUG", "$module\.$key was removed (not applicable).\n");
		    # checking to see if this answer is appropriate for this OS.
		    if(! exists $deletedQText{$key} ) {
			# Warn the user that this question will not run on 
			# their system as it is was not designed for their OS.
			&B_log("WARNING","$module\.$key was removed (not applicable).\n");
		    }

		    $sumNotAsked++;
		}
	    }

	}
    }

    # Logging this subroutines actions.

    if($sumNotAsked > 0){

	&B_log("DEBUG","$sumNotAsked question(s) were answered that do not pertain to this system.\n" .
	       "Answered questions that do not pertain to this machine have\n" . 
	       "been removed.\n");

	if($warnFlag){
	    &B_log("WARNING","The configuration file appears to contain invalid entries.\n" . 
		   "Bastille will continue but you should rerun the interactive\n" . 
		   "portion of Bastille to correct the invalid portions of the\n" .
		   "configuration file.\n\n");
	    &B_log("WARNING","The configuration file appears to contain invalid entries.\n" . 
		   "Bastille will continue but you should rerun the interactive\n" . 
		   "portion of Bastille to correct the invalid portions of the\n" .
		   "configuration file.\n\n");
	}

	$returnValue = 0;
    }

    # return 1 for success and 0 for Warnings that were reported.
    return $returnValue;
}

######################################################################
#  &validateAnswer($question,$answer)
#     This subroutine takes the in the LABEL of a question and the
#     answer that is being proposed.  Both in string form
#     It then checks the proposed answer against a regular expression
#     that is listed in Questions.txt as REG_EXP and in the Question
#     hash as $Question{$question}{"reg_exp"}.
#     If the reg_exp matches the proposed question then 1 is returned
#     otherwise 0 is returned.
#     An exception to this rule is if the reg_exp field is not present
#     then an 1 is returned suggesting that any answer will do.
#
#     REQUIRES %Questions
#     REQUIRES &ErrorLog
#     REQUIRES &getRegExp
#
######################################################################
sub validateAnswer($$) {

    my $question = $_[0];
    my $answer = $_[1];

    if( defined &getRegExp($question)){
	
	$pattern = &getRegExp($question);
	if( $answer =~ /$pattern/ ){
	    return 1;
	}
	else {
	    return 0;
	}
    }
    elsif( exists $Question{$question} ) {
	return 1;
    }
    else {
	&B_log("ERROR","Could not find \"$question\" in the Questions hash\n");
	return 0;
    }


}

######################################################################
#  &validateAnswers
#     This subroutine checks the proposed answers against a regular 
#     expressions that are listed in Questions.txt as REG_EXP and in 
#     the Question hash as $Question{$question}{"reg_exp"}.
#     If the reg_exp matches for all the proposed answers then 1 is 
#     returned otherwise a non-zero exit is performed and the user
#     is asked to rerun Interactive Bastille.
#
#     This subroutine is to be used in the back end as a qualifier to
#     running the code.
#
#     REQUIRES %GLOBAL_CONFIG
#     REQUIRES %Questions
#     REQUIRES &validateAnswer
#     REQUIRES &ActionLog
#     REQUIRES &ErrorLog
#
######################################################################

sub validateAnswers {
    
    for my $module ( keys %GLOBAL_CONFIG ){
	for my $question (keys %{ $GLOBAL_CONFIG{$module} } ){
	    
	    my $answer = $GLOBAL_CONFIG{$module}{$question};
	    if(! &validateAnswer($question,$answer)){
		my $error = "A fatal error has occurred. On the following\n" . 
		      "line of Bastille's config, the specified answer does\n" .
		      "not match the following Perl regular expression.\n" . 
		      "config: $module.$question=$answer\n" . 
		      "Regular Expression: \"". &getRegExp($question) . "\"\n" . 
		      "Please run the interactive portion of Bastille again\n" .
		      " and fix the error.\n";
		&B_log("ERROR", $error );
		exit(1);  
	    }
	}
    }
 
   &B_log("DEBUG","Validated config file input\n");
    return 1;
}

######################################################################
#  &getRegExp($question)
#     This subroutine is a lookup function that for a given question
#     label will return a regular expression that is defined.
#     If no regular expression is defined for that question then
#     this subroutine will return undefined.
#
#     REQUIRES: %Questions
#    
######################################################################

sub getRegExp($) {

    my $question = $_[0];
    
    if( exists $Question{$question}{"reg_exp"} ) {
	return $Question{$question}{"reg_exp"};
    } 
    else {
	return undef;
    }
}

######################################################################
#  &checkQtree($first_question);
#    This subroutine checks to see if all applicable Questions
#    have been asked on this system.  If it finds a discontinuity
#    in the pruned questions tree vs the GLOBAL_CONFIG hash it will
#    return the ($offending_module,$offending_key).  Otherwise it
#    will return NULL stings.  i.e. ("","")
#
#    This subroutine also marks the questions that have answers in
#    the GLOBAL_HASH.  This allows &compareQandA to actively delete
#    GLOBAL_HASH keys if they are not appropriate for the current
#    machine.
#
#    REQUIRES: %Questions
#    REQUIRES: %GLOBAL_CONFIG
#
######################################################################

sub checkQtree($) {

    my $first_question = $_[0];
    my $current_question = $first_question;

    while( $current_question ne "End_Screen" ) {
	my $module = $Question{$current_question}{"shortModule"};

	# check and see if this record is a question...
	if( $Question{$current_question}{"question"} ne "" ) {
	    # This question should have an answer...
	    if( ! (exists $GLOBAL_CONFIG{$module}{$current_question})){
		# This question has no answer and should...
		return ($module,$current_question);
	    }
	    elsif($Question{$current_question}{"toggle_yn"} == 1) {
		# this is a yes or no question
		if($GLOBAL_CONFIG{$module}{$current_question} eq "Y"){
		    $Question{$current_question}{"mark"} = "OK";
		    $current_question=$Question{$current_question}{"yes_child"};
		}
		else {
		    $Question{$current_question}{"mark"} = "OK";
		    $current_question=$Question{$current_question}{"no_child"};
		}
		
	    }
	    else {
		$Question{$current_question}{"mark"} = "OK";
		$current_question=$Question{$current_question}{"yes_child"};
	    }
	}
	else {
	    $current_question=$Question{$current_question}{"yes_child"};
	}

    }
    # all of the questions that should be answered are.
    return ("","");
}


######################################################################
#  &outputConfig;
#
#    This subroutine writes out a configuration
#    file.  It uses Global_Config as a data source and will write
#    out all defined values excepting End_Screen.
#
#    REQUIRES: %GLOBAL_CONFIG
#    REQUIRES: %Question
#    REQUIRES: %deletedQText
#
######################################################################

# When does a previously answered question get written out to the
# config file?

#Always write out answers to questions which the user just answered.
#
#For answers which were retrieved from the config file, there are the
#following cases:
#
#Case                        write    GUI behavior       back end behavior
#                            answer?  (questions)        (if answer is missing)
#----------------------------------------------------------------------------
# Pruned (can't get to in GUI):
#  Configured Securely              Y      don't ask          don't warn
#  Missing software
#    - Security related             Y      ask different Q    ensure other Q 
#                                          (install foo?)     is answered   
#    - non-security related         Y      don't ask          don't warn
#
#  distro not applicable            Y      warn (not asking   warn (not doing 
#                                          foo)               foo)
# Not pruned:
#  Question depends on Y/N
#    from another question          N      ask Q if user      warn (invalid 
#                                          changes answer     config)

sub outputConfig {

    my %CONFIG;

    my $config = &getGlobal('BFILE', "config");

#   Needs to use a tree traversal as well as the proper distro deletion items
    my $index="Title_Screen";

    while ($index ne "End_Screen") {

	if ($Question{$index}{"question"} ne "" && exists $Question{$index}{"answer"}) {

	    # If the answer is just a space (the way the &Prompt_Input sub
	    # designates a blank line, strip it.	    
	    if ($Question{$index}{"answer"} =~ /^\s+$/) {
		$Question{$index}{"answer"} = "";
	    }

	    my $module = $Question{$index}{"module"};
	    if ($module =~ /^([^.]+).pm/) {
		$module =$1;
	    }
	    # adding this question to the config hash which will be written out
	    $CONFIG{$module}{$index} = $Question{$index}{"answer"};

	    
	}
	if ($Question{$index}{"toggle_yn"} == 0) {
	    $index=$Question{$index}{"yes_child"};
	}
	else {
	    if ($Question{$index}{"answer"} =~ /^\s*Y/i) {
		$index=$Question{$index}{"yes_child"};
	    }
	    elsif ($Question{$index}{"answer"} =~ /^\s*N/i) {
		$index=$Question{$index}{"no_child"};
	    }
	    else {
                &B_log("ERROR","Internal Bastille error on question $index.  Answer\n" .
                          "to y/n question is not 'Y' or 'N'.\n");
	    }
	}
    }

    # We already got the answers which the user just put in, so now we start
    # looping through the GLOBAL_CONFIG looking for deleted questions that 
    # have been answered (possibly due to an OS switch or the action  
    # already having been performed and it does not make sense to attempt to 
    # perform the action) i.e. the configurable software is not installed. 
    foreach my $module (keys %GLOBAL_CONFIG) {
	foreach my $question (keys %{$GLOBAL_CONFIG{$module}}) {
	    if((defined $GLOBAL_CONFIG{$module}{$question}) && ($module ne "End")){
		# if the question is defined in the deletedQText hash then 
                # it is distro appropriate and therefore should be saved 
                # to maintain state across Bastille back end/front end runs.
		if( defined $deletedQText{$question} ){ 
		    $CONFIG{$module}{$question} = $GLOBAL_CONFIG{$module}{$question};
		}
	    }
	}
    }
    
    # create the config directory if it doesn't exist
    if( ! -d &getGlobal('BDIR',"config")) {
	mkpath(&getGlobal('BDIR',"config"),0,0700);
    }

    # it is finally time to print the config file out.
    unless (open FORMATTED_CONFIG,"> $config") {
        &B_log("ERROR","Couldn't not write to " . $config  ."\n");
        exit(1);
    }

    foreach my $module (sort keys %CONFIG) {
	foreach my $question (sort keys %{$CONFIG{$module}}) {
	    if((defined $CONFIG{$module}{$question}) && ($module ne "End")){
		# if the question is defined in the Question hash then 
		if( defined $Question{$question}{'question'} ) {
		    print FORMATTED_CONFIG "# Q:  $Question{$question}{question}\n";
		    print FORMATTED_CONFIG "$module\.$question=\"$GLOBAL_CONFIG{$module}{$question}\"\n";
		}
		# if the question is defined in the deletedQText hash then 
                # it is distro appropriate and therefore should be saved 
                # to maintain state across Bastille back end/front end runs.
		elsif( defined $deletedQText{$question} ){ 
		    print FORMATTED_CONFIG "# Q:  $deletedQText{$question}\n";
		    print FORMATTED_CONFIG "$module\.$question=\"$GLOBAL_CONFIG{$module}{$question}\"\n";
		}
		    
	    }
	}
    }

    close(FORMATTED_CONFIG);
    
    
}


######################################################################
#  &partialSave;
#
#    This subroutine writes out an incomplete configuration 
#    file.  It uses Global_Config as a data source and will write
#    out all defined values excepting End_Screen.
#
#    REQUIRES: %GLOBAL_CONFIG
#    REQUIRES: %Question
#    REQUIRES: %deletedQText
#
######################################################################

sub partialSave {
    my $config = &getGlobal('BFILE', "config");
    unless (open FORMATTED_CONFIG,"> $config") {
        &B_log("ERROR","Couldn't not write to " . $config  ."\n");
        exit(1);
    }

    foreach my $module (sort keys %GLOBAL_CONFIG) {
	foreach my $question (sort keys %{$GLOBAL_CONFIG{$module}}) {
	    if((defined $GLOBAL_CONFIG{$module}{$question}) && ($module ne "End")){
		# if the question is defined in the Question hash then 
		if( defined $Question{$question}{'question'} ) {
		    print FORMATTED_CONFIG "# Q:  $Question{$question}{question}\n";
		    print FORMATTED_CONFIG "$module\.$question=\"$GLOBAL_CONFIG{$module}{$question}\"\n";
		}
		# if the question is defined in the deletedQText hash 
                # then it is distro appropriate and therefore should be 
                # saved to maintain state across Bastille back end/front end runs.
		elsif( defined $deletedQText{$question} ){ 
		    print FORMATTED_CONFIG "# Q:  $deletedQText{$question}\n";
		    print FORMATTED_CONFIG "$module\.$question=\"$GLOBAL_CONFIG{$module}{$question}\"\n";
		}
	    }
	}
    }

    close(FORMATTED_CONFIG);
    
}

######################################################################
#  &isConfigDefined($)
#
#    This subroutine returns a 1 in the given Module exists in
#    the GLOBAL_CONFIG hash.  A 0 is returned otherwise.
#
#    REQUIRES: %GLOBAL_CONFIG
#
######################################################################

sub isConfigDefined($) {

    my $module=$_[0];
    if(exists $GLOBAL_CONFIG{$module}) {
	B_log("DEBUG", "$module exists in the GLOBAL_CONFIG hash");
	return 1;
    } 
    else {
	B_log("DEBUG", "$module does not exist in the GLOBAL_CONFIG hash");
	return 0;
    }  
}

######################################################################
# &Load_Scoring_Weights()
#
# This routine loads the weights that Bastille will use to score the 
# system during its auditing phase.
#
######################################################################

sub Load_Scoring_Weights {

    my $total_weight = 0;

    # Get the list of questions files, each corresponding to one module
    unless (open QUESTIONS_WEIGHTS,&getGlobal('BFILE','QuestionsWeights')) {
	&B_log("WARNING","Can't open ./Weights.txt data file to the weighting for the questions -- Bastille will not score the system.\n");
	#exit(1);
	$GLOBAL_NO_WEIGHTS = 1;
    }

    # Load in the weights file entirely.
    my @lines = <QUESTIONS_WEIGHTS>;

    # Load in the name of the weights file.
    my $line = shift @lines;
    if ($line =~ /^Weights\s*:\s*(.*)\s*$/ ) {
	$weights_name = $1;
    }
    else {
	unshift @lines,$line;
    }

    # Load in the raw, non-calibrated weights.
    foreach $line (@lines) {
	next if ($line =~ /^\s*\#/);
	next if ($line =~ /^\s*$/);

	if ($line =~ /^\s*(\w+)\s*\.\s*(\w+)\s*=\s*(\d+)\s*$/) {
	    my $key = $2;
	    my $weight = $3;
	    $Question{$key}{'weight'} = $weight;
	    $total_weight += $weight;
	}
	else {
	    &B_log("WARNING","The following weight line cannot be parsed:\n$line\n");
	}
    }
    close QUESTIONS_WEIGHTS;

    return;

    # Calibrate the weights.
    my $calibration_factor = ( 10 / $total_weight );

    foreach $key (keys(%Question)) {
	$Question{$key}{'weight'} *= $calibration_factor;
	$Question{$key}{'weight'} = sprintf "%2.2f",$Question{$key}{'weight'};
    }
}

sub PrintAuditPage {
    my $key = $_[0];
    
    return unless ($GLOBAL_AUDITONLY);

    # Write a page for the question itself.
    unless ( -d '/var/log/Bastille/Assessment' ) {
	mkdir '/var/log/Bastille/Assessment',0700;
    }
    unless ( -d '/var/log/Bastille/Assessment/QuestionData' ) {
	mkdir '/var/log/Bastille/Assessment/QuestionData',0755;
    }
    my $question=$Question{$key}{'question'};
    if ($Question{$key}{'question_audit'}) {
        $question = $Question{$key}{'question_audit'};
    }
    my $explanation=$Question{$key}{'short_exp'};
    if ($Question{$key}{'long_exp'}) {
	$explanation=$Question{$key}{'long_exp'};
    }

    if (open QUESTIONPAGE,">/var/log/Bastille/Assessment/QuestionData/$key.html") {
	print QUESTIONPAGE "<HTML>\n<HEAD><TITLE>" . $question . "</TITLE></HEAD>\n<BODY>\n";
	print QUESTIONPAGE "<TABLE cellspacing=1 cellpadding=1 border=4 frame=border><TR><TD><PRE>" . $question . "</PRE></TD></TR>\n";
	print QUESTIONPAGE "<TR><TD>" . $explanation . "</TD></TR>\n";
	print QUESTIONPAGE "</TABLE>\n</BODY>\n</HTML>\n";
	close QUESTIONPAGE;
    }
    else {
	print "Could not open /var/log/Bastille/Assessment/QuestionData/$key.html\n";
    }
    
    # Continue to write the report and log.
}


sub OpenAuditReport {

    return unless ($GLOBAL_AUDITONLY);

    # Open the Audit report files - text and html.
    my $audit_directory = &getGlobal('BDIR','log') . "/Assessment/";
    my $audit_log_file = &getGlobal('BDIR','log') . "/Assessment/assessment-log.txt";
    my $audit_report_file_html = &getGlobal('BDIR','log') . "/Assessment/assessment-report.html";
    my $audit_report_file_text = &getGlobal('BDIR','log') . "/Assessment/assessment-report.txt";
   
    unless ( -d $audit_directory ) {
	mkdir $audit_directory,0700;
	chmod 0700,$audit_directory;
    }
    open AUDIT_LOG,">$audit_log_file" or die "Could not open log file $audit_log_file for writing.\n";
    open AUDIT_REPORT_HTML,">$audit_report_file_html" or die "Could not open log file $audit_report_file_html for writing.\n";
    open AUDIT_REPORT_TEXT,">$audit_report_file_text" or die "Could not open log file $audit_report_file_text for writing.\n";

    $audit_report_html_lines = "";
    $audit_report_html_score = "";
    $audit_report_html_preamble = "";

    # Add introductory text/formatting to the reports.
    $audit_report_html_preamble .= <<END_HTML;
<HTML>
<HEAD>
<TITLE>Bastille Hardening Assessment Report</TITLE>
END_HTML
    # Add Javascript for the expansion/contraction functionality.
    $audit_report_html_preamble .=  &JavascriptExpansionHeader();

    # Add our inline stylesheet
    $audit_report_html_preamble .= &InlineStyleSheet;

    $audit_report_html_preamble .= <<END_HTML;
</HEAD>
<BODY>
END_HTML

    $audit_report_html_preamble .= qq~<script language="JavaScript" type="text/javascript" src="wz_tooltip.js"></script>\n~;
    $audit_report_html_preamble .= <<END_HTML;
<img src="bastille.jpg">
<CENTER>
<H3>Bastille Hardening Assessment Report</H3>
</CENTER>
END_HTML

    $audit_report_html_lines .= qq~<hr><div><a href="javascript:sweeptoggle('contract')">Contract all Modules</a> | <a href="javascript:sweeptoggle('expand')">Expand all Modules</a></div>~;

    # Make sure bastille.jpg is in the current directory
    my $command = &getGlobal('BIN','cp') . " " . &getGlobal('BDIR','share') . "/bastille.jpg" . " " . &getGlobal('BDIR','log') . "/Assessment/";
    `$command`;
    # Make sure the javascript library for mouseovers is also in the current directory.
    $command = &getGlobal('BIN','cp') . " " . &getGlobal('BDIR','share') . "/wz_tooltip.js" . " " . &getGlobal('BDIR','log') . "/Assessment/";
    `$command`;

    print AUDIT_REPORT_TEXT "Bastille Hardening Assessment Report\n";
    print AUDIT_REPORT_TEXT "+" . "-" x 37 . "+" .  "-" x 42 . "+" . "-----" . "+" . "------" . "+" . "------" . "+\n";
    printf AUDIT_REPORT_TEXT "| %-35.35s | %-40.40s | Yes |Weight|Score |\n",'Item','Question';
    print AUDIT_REPORT_TEXT "+" . "-" x 37 . "+" .  "-" x 42 . "+" . "-----" . "+" . "------" . "+" . "------" . "+\n";
}

######################################################################################################
# &PrintAuditLine($key,$hardened) prints a line in a table corresponding to the Bastille item $key,
# which is a question index from the %Questions hash.  It prints this line to several files, and 
# thus in several formats: html, text and machine-parseable text.  The $hardened_toggle tells the
# routine whether this item is hardened or not.
#
######################################################################################################

sub PrintAuditLine {
    my $key = $_[0];
    my $hardened_toggle = $_[1];

    return unless ($GLOBAL_AUDITONLY);

    # The label gives the question context.
    my $module =  $Question{$key}{'shortModule'};
    my $label = "$module : $key";

    #########################
    # Temporary KLUDGE:
    #   Let's put a module line in every time we switch modules.
    #   This allows us not to put a module name on every question.
    if ($module ne $GLOBAL_AUDIT_PAGE_MODULE) {
	if ($GLOBAL_AUDIT_PAGE_MODULE ne "") {
	    $audit_report_html_lines .= "</table>\n";
	    $audit_report_html_lines .= "</div>\n";
	}
	$audit_report_html_lines .= qq~<h3 onClick="expandcontent(this, '$module')" style="cursor:hand; cursor:pointer"><span class="showstate"></span>$module</h3>\n~ . 
	    qq~<div id="$module" class="switchcontent" style="display: block">\n~ . 
	    "<TABLE border=4 frame=border>\n" .
	    qq~<TR><TD class="item">Item</TD><TD class="question">Question</TD><TD class="state">State</TD><TD class="weight">Weight</TD><TD class="scorecontrib">Score Contrib</TD></TR>\n~;
	$GLOBAL_AUDIT_PAGE_MODULE = $module;
    }
    $label = $key;
    #
    #
    #########################

    # If the item has a special audit-only version, use that.
    my $question=$Question{$key}{'question'};
    if ($Question{$key}{'question_audit'}) {
	$question = $Question{$key}{'question_audit'};
    }

    # Generate a result and a score-contribution number.
    my $result = "No ";
    my $score_contribution = "0.00";
    if ($hardened_toggle) {
	$result = "Yes";
	$score_contribution = $Question{$key}{'weight'};
    }
    my $score_contribution_formatted = sprintf "%-2.2f",$score_contribution;

    # Create a single-letter-result for the audit-log, which allows skew detection
    my $single_letter_result = 'N';
    if ($result eq "Yes") {
	$single_letter_result = 'Y';
    }

    # Create a version of the question that shows an explanation on mouseover.
    my $shortexp = &escape_quotes_or_apostrophes( $Question{$key}{'short_exp'} );

    # Print a row in the HTML table for this item.
    $audit_report_html_lines .= "<tr>" .
    "<td>$label</td>" .
    qq~<td><a href="QuestionData/$key.html" onmouseover="return escape('$shortexp')">$question</a></td>~ .
    "<td>" . $result . "</td>" .
    "<td>" . $Question{$key}{'weight'} . "</td>" .
    "<td>" . $score_contribution_formatted . "</td>" .
    "</tr>\n";

    # Print this information out in a text-only format.
    printf AUDIT_REPORT_TEXT "| %-35.35s | %-40.40s | $result | %-2.2f | %-2.2f |\n", $label,$question,$Question{$key}{'weight'},$score_contribution_formatted;

    # Print the answer out for the machine-parseable log.
    print AUDIT_LOG $Question{$key}{'shortModule'} . ':' . $key . " = $single_letter_result\n";
}


sub escape_quotes_or_apostrophes {
    my $content = $_[0];

    $content =~ s/'/\\'/g;
    $content =~ s/`/\\`/g;
    $content =~ s/\"/&quot;/g;
    $content =~ s/\n/<br>/g;
    return $content;
}

sub JavascriptExpansionHeader {

    my $header = <<ENDL;
<script type="text/javascript">

/***********************************************
* Switch Content script- © Dynamic Drive (www.dynamicdrive.com)
* This notice must stay intact for legal use. Last updated April 2nd, 2005.
* Visit http://www.dynamicdrive.com/ for full source code
***********************************************/

var enablepersist="on" //Enable saving state of content structure using session cookies? (on/off)
var collapseprevious="no" //Collapse previously open content when opening present? (yes/no)

var contractsymbol='(<i>contract</i>) ' //HTML for contract symbol. For image, use: <img src="whatever.gif">
var expandsymbol='(<i>expand</i>) ' //HTML for expand symbol.


if (document.getElementById){
document.write('<style type="text/css">')
document.write('.switchcontent{display:none;}')
document.write('</style>')
}

function getElementbyClass(rootobj, classname){
var temparray=new Array()
var inc=0
for (i=0; i<rootobj.length; i++){
if (rootobj[i].className==classname)
temparray[inc++]=rootobj[i]
}
return temparray
}

function sweeptoggle(ec){
var thestate=(ec=="expand")? "block" : "none"
var inc=0
while (ccollect[inc]){
ccollect[inc].style.display=thestate
inc++
}
revivestatus()
}


function contractcontent(omit){
var inc=0
while (ccollect[inc]){
if (ccollect[inc].id!=omit)
ccollect[inc].style.display="none"
inc++
}
}

function expandcontent(curobj, cid){
var spantags=curobj.getElementsByTagName("SPAN")
var showstateobj=getElementbyClass(spantags, "showstate")
if (ccollect.length>0){
if (collapseprevious=="yes")
contractcontent(cid)
document.getElementById(cid).style.display=(document.getElementById(cid).style.display!="block")? "block" : "none"
if (showstateobj.length>0){ //if "showstate" span exists in header
if (collapseprevious=="no")
showstateobj[0].innerHTML=(document.getElementById(cid).style.display=="block")? contractsymbol : expandsymbol
else
revivestatus()
}
}
}

function revivecontent(){
contractcontent("omitnothing")
selectedItem=getselectedItem()
selectedComponents=selectedItem.split("|")
for (i=0; i<selectedComponents.length-1; i++)
document.getElementById(selectedComponents[i]).style.display="block"
}

function revivestatus(){
var inc=0
while (statecollect[inc]){
if (ccollect[inc].style.display=="block")
statecollect[inc].innerHTML=contractsymbol
else
statecollect[inc].innerHTML=expandsymbol
inc++
}
}

function get_cookie(Name) { 
var search = Name + "="
var returnvalue = "";
if (document.cookie.length > 0) {
offset = document.cookie.indexOf(search)
if (offset != -1) { 
offset += search.length
end = document.cookie.indexOf(";", offset);
if (end == -1) end = document.cookie.length;
returnvalue=unescape(document.cookie.substring(offset, end))
}
}
return returnvalue;
}

function getselectedItem(){
if (get_cookie(window.location.pathname) != ""){
selectedItem=get_cookie(window.location.pathname)
return selectedItem
}
else
return ""
}

function saveswitchstate(){
var inc=0, selectedItem=""
while (ccollect[inc]){
if (ccollect[inc].style.display=="block")
selectedItem+=ccollect[inc].id+"|"
inc++
}

document.cookie=window.location.pathname+"="+selectedItem
}

function do_onload(){
uniqueidn=window.location.pathname+"firsttimeload"
var alltags=document.all? document.all : document.getElementsByTagName("*")
ccollect=getElementbyClass(alltags, "switchcontent")
statecollect=getElementbyClass(alltags, "showstate")
if (enablepersist=="on" && ccollect.length>0){
document.cookie=(get_cookie(uniqueidn)=="")? uniqueidn+"=1" : uniqueidn+"=0" 
firsttimeload=(get_cookie(uniqueidn)==1)? 1 : 0 //check if this is 1st page load
if (!firsttimeload)
revivecontent()
}
if (ccollect.length>0 && statecollect.length>0)
revivestatus()
}

if (window.addEventListener)
window.addEventListener("load", do_onload, false)
else if (window.attachEvent)
window.attachEvent("onload", do_onload)
else if (document.getElementById)
window.onload=do_onload

if (enablepersist=="on" && document.getElementById)
window.onunload=saveswitchstate

</script>
ENDL

    return $header;
}

sub InlineStyleSheet {
    my $sheet;

    $sheet = <<ENDSHEET;
<style type="text/css">
    body {
        color: black;
	background-color: white;
	font-family: Georgia, "Times New Roman",Times, serif;
      }
    h3 {
	font-family: Helvetica, Geneva, Arial,SunSans-Regular, sans-serif;
    }
    table {
      width: 80em;
	table-layout: fixed;
    }
    table.score {
      width: 20em;
    }
    TD {
      width: 10em;
    }
    TD.item {
      width: 15em;
    }
    TD.question {
      width: 50em;
    }
    TD.state {
      width: 5em;
    }
    TD.weight {
      width: 5em;
    }
    TD.scorecontrib {
      width: 5em;
    }
    TD.scoreword {
      width: 6em;
    }
    TD.scorenumber {
      width: 14em;
    }
   
</style>

ENDSHEET
    return $sheet;
}

sub CloseAuditReport {

    ##############################################
    # Wrap up auditing report.
    ##############################################

    my $score = $_[0];
    my $weight = $_[1];
    my $formatted_score;

    return unless ($GLOBAL_AUDITONLY);

    $audit_report_html_lines .= "</TABLE>\n" .
	"</DIV>\n";
    unless ($weight == 0 ) {
	$formatted_score = sprintf "%2.2f",($score/$weight*10);
    }
    $audit_report_html_score .= qq~<TABLE cellspacing=1 cellpadding=1 border=4 frame=border class="score"><TR><TD class="scoreword">~ . 
	"<b3><b>Score</b></TD><TD><b>Weights File</b></TD></TR><TR><TD class=\"scorenumber\">" . $formatted_score . " / 10.00</b3></TD><TD> $weights_name </TD></TR>\n</TABLE>\n";

    # Load in our Javascript library used for the mouseover descriptions
    $audit_report_html_lines .= qq~<script language="JavaScript" type="text/javascript" src="wz_tooltip.js"></script>\n~ .
	"</BODY>\n</HTML>\n";

    print AUDIT_REPORT_HTML $audit_report_html_preamble;
    print AUDIT_REPORT_HTML $audit_report_html_score;
    print AUDIT_REPORT_HTML $audit_report_html_lines;

    print AUDIT_REPORT_TEXT "+" . "-" x 37 . "+" .  "-" x 42 . "+" . "-----" . "+" . "------" . "+" . "------" . "+\n";
    print AUDIT_REPORT_TEXT "Score: " . $formatted_score . " / 10.00\n";
   
    close AUDIT_REPORT_TEXT;
    close AUDIT_REPORT_HTML;
    close AUDIT_LOG;
}

sub CreateAuditReport {
    my %Question=$_[0];

    return unless ($GLOBAL_AUDITONLY);

    &OpenAuditReport;
    
    # Print Score
    my $formatted_score = sprintf "%2.2f",$score;
    print AUDIT_REPORT_HTML qq~<TABLE cellspacing=1 cellpadding=1 border=4 frame=border class="score"><TR><TD class="scoreword">~;
    print AUDIT_REPORT_HTML qq~<b3>Score:</TD><TD class="scorenumber">" . $formatted_score . " / 10.00</b3></TD></TR>\n</TABLE>\n~;

    # Walk through printing lines by module
    foreach $module (keys(%TestedModules)) {
	print AUDIT_REPORT_HTML "<TABLE cellspacing=1 cellpadding=1 border=4 frame=border>\n";
	print AUDIT_REPORT_HTML "<TR><TD><h3><b>$module</b></h3></TD><TD>Description</TD><TD>Result</TD><TD>Weight</TD><TD>Contribution</TD></TR>\n";
	foreach $key ( @{ $TestedItems{$module} }) {
	    print AUDIT_REPORT_HTML "<tr><td>$key</td>" . "<td>" . "<a href=\"/var/log/Bastille/Assessment/QuestionData/$key.html\">" . $Question{$key}{'question'} . "</a></td><td>" . $Question{$key}{'result'} . "</td><td>" . $Question{$key}{'weight'} . "</td><td>" . "0" . "</td></tr>\n";
	}
	print AUDIT_REPORT_HTML "</TABLE>\n";
    }
    print AUDIT_REPORT_HTML "</BODY>\n</HTML>\n";

   &CloseAuditReport($score);
    close AUDIT_REPORT_TEXT;
    close AUDIT_REPORT_HTML;
    close AUDIT_LOG;
}

1;



