# Copyright (C) 1999-2005 Jay Beale
# Copyright (C) 2001-2003 Hewlett-Packard Development Company, L.P.
# Licensed under the GNU General Public License

package Bastille::API;

## TO DO:
#
#
#   1) Look for more places to insert error handling... 
#
#   2) Document this module more
#
#


##########################################################################
#
# This module forms the basis for the v1.1 API.
# 
 ##########################################################################

# 
# This module forms the initial basis for the Bastille Engine, implemented
# presently via a Perl API for Perl modules.
#
# This is still under construction -- it is very usable, but not very well
# documented, yet.
#

##########################################################################
#
#                          API Function Listing                               
#
##########################################################################
# The routines which should be called by Bastille modules are listed here,
# though they are better documented throughout this file.
#
# Distro Specific Stuff:
#
#  &GetDistro     - figures out what distro we're running, if it knows it...
#  &ConfigureForDistro - sets global variables based on the distro
#  &GetGlobal - returns hash values defined in ConfigureForDistro
#
#  &getGlobalConfig - returns value of hash set up by ReadConfig
#
# Logging Specific Stuff has moved to LogAPI.pm:
#
#  &B_log(type,msg) -- takes care of all logging
#
#
# Input functions for the old input method...
#
# File open/close/backup functions
#
#  &B_open     * -- opens a file handle and logs the action/error (OLD WAY!)
#  &B_open_plus  -- opens a pair of file handles for the old and new version
#                   of a file; respects logonly flag.  (NEW WAY)
#  &B_close    * -- closes a file handle and logs the action/error (OLD WAY!)
#  &B_close_plus -- closes a pair of file handles opened by B_open_plus,
#                   backing up one file and renaming the new file to the
#                   old one's name, logging actions/errors.  Respects the 
#                   logonly flag -- needs B_backup file.  Finally, sets
#                   new file's mode,uid,gid to old file's...  (NEW WAY)
#  &B_backup_file - backs up a file that is being changed/deleted into the
#                   $GLOBAL_BDIR{"backup"} directory.
#
# Content (Line-based) file modification functions
#
#  &B_blank_file  - blanks a file if it isn't ours, so that we can rewrite it
#  &B_append_line - opens a file, appends a line to it, and closes file
#  &B_insert_line_after - opens a file, inserts a line after a specified line, closes
#  &B_insert_line_before - opens a file, inserts a line before a specified line, closes
#  &B_prepend_line- opens a file, prepends a line to it, and closes file
#  &B_replace_line- replaces one or more lines in a file using regep matching
#  &B_hash_comment_line
#                 - hash - comments one or more lines in a file
#  &B_hash_uncomment_line
#                 - hash - uncomments one or more lines in a file
#  &B_delete_line - deletes one or more lines in a file using regep matching
#
# Content (multiple-line-based) file mod functions (for PeterW's Firewall.pm)
#
#
#  &B_chunk_replace
#
#
# Non-content file modification functions
#
#  &B_delete_file - deletes the named file, backing up a copy
#  &B_create_file - creates the named file, if it doesn't exist
#
#  &B_print       	- print a line to the named file handle, logging the action
#  &B_chmod       	- chmod a file, logging the action
#  &B_chmod_if_exists  	- chmod a file, logging the action only if the file exists
#  &B_chown       	- change only the owner on a file, logging the action
#  &B_chgrp       	- change the group owner on a file, logging the action
#  &B_remove_suid       - remove suid bit from a given file.
#  &B_symlink     	- create a symlink to a file, recording the revert rm
#
# More stuff
#
#  &B_chkconfig_off - removed all S links from rcX.d directory
#  &B_chkconfig_on  - make all S links from rcX.d directory
#  &B_createdir     - make a directory, if it doesn't exist, record revert rmdir
#  &B_cp            - copy a file, respecting LOGONLY and revert func.
#  &B_mknod         - wrap mknod with revert and logonly and prefix functionality
#
#  &B_userdel       - removes a user from the system safely - Use with Care!
#  &B_groupdel      - removes a group from the system safely
#  &B_remove_user_from_group - removes $user from $group
#
#  &B_read_sums     - reads sum.csv file and parses input into the GLOBAL_SUM hash
#  &B_write_sums    - writes sum.csv file from GLOBAL_SUM hash
#  &B_check_sum($)  - take a file name and compares the stored cksum with the current
#                     cksum of said file
#  &B_set_sum($)    - takes a file name and gets that files current cksum then sets
#                     that sum in the GLOBAL_SUM hash
#  &B_revert_log - create entry in shell script, executed later by bastille -r
#  &showDisclaimer  - Print the disclaimer and wait for 5 minutes for acceptance
###########################################################################
# Note:  GLOBAL_VERBOSE
# 
# All logging functions now check GLOBAL_VERBOSE and, if set, will print
# all the information sent to log files to STDOUT/STDERR as well.
#

#
# Note:  GLOBAL_LOGONLY
# 
# All Bastille API functions now check for the existence of a GLOBAL_LOGONLY 
# variable.  When said variable is set, no function actually modifies the 
# system.
#
# Note:  GLOBAL_DEBUG
#
# The B_log("DEBUG",...) function now checks GLOBAL_DEBUG and, if set, it will
# print all the information to a new debug-log file. If GLOBAL_VERBOSE is
# set it might log to STDOUT/STDERR as well (not yet implemented, pending
# discussion). Developers should populate appropriate places with &B_log(DEBUG)
# in order to be able to tell users to use this options and send the logs
# for inspection and debugging.
#
#


# Libraries for the Backup_file routine: Cwd and File::Path
use Cwd;
use Bastille::HP_API;
use Bastille::OSX_API;    
use Bastille::LogAPI;    
use File::Path;
use File::Basename;

# Export the API functions listed below for use by the modules.

use Exporter;
@ISA = qw ( Exporter );
@EXPORT = qw( setOptions PrepareToRun GetDistro ConfigureForDistro B_log
	      SanitizeEnv
              B_open B_close B_print B_symlink StopLogging 
	      B_open_plus B_close_plus B_blank_file B_append_line
	      B_insert_line_after
	      B_insert_line_before
	      B_insert_line
	      B_prepend_line B_replace_line B_replace_pattern
	      B_chunk_replace 
	      B_hash_comment_line B_hash_uncomment_line 
	      B_delete_line
	      B_create_file B_read_sums B_check_sum  B_set_sum isSumDifferent listModifiedFiles
	      B_create_dir B_remove_suid
	      B_delete_file B_chmod B_chmod_if_exists B_chown B_chgrp 
	      B_chkconfig_off B_chkconfig_on B_cp B_place B_mknod
	      B_remove_user B_remove_user_from_group B_remove_group
	      B_ch_rc B_set_value B_System B_Schedule B_TODO B_install_jail 
              B_chperm showDisclaimer 
              B_load_ipf_rules B_deactivate_inetd_service getSupportedOSHash
	      B_set_rc B_get_rc B_chrootHPapache 
	      B_userdel B_groupdel B_removeuserfromgroup
              $GLOBAL_OS
	       $GLOBAL_LOGONLY $GLOBAL_VERBOSE $GLOBAL_DEBUG $GLOBAL_AUDITONLY $GLOBAL_AUDIT_NO_BROWSER $errorFlag
	      %GLOBAL_BIN %GLOBAL_DIR %GLOBAL_FILE
	      %GLOBAL_BDIR %GLOBAL_BFILE
	      %GLOBAL_CONFIG %GLOBAL_SUM
	      %GLOBAL_SERVICE %GLOBAL_SERVTYPE %GLOBAL_PROCESS

              getGlobal getGlobalConfig getGlobalSwlist

	      );

&SanitizeEnv;

# Set up some common error messages.  These are independent of 
# operating system

# These will allow us to line up the warnings and error messages
my $err ="ERROR:  ";
my $spc ="        ";

#OS independent Error Messages Follow
$GLOBAL_ERROR{"usage"}="Invalid argument list:\n".
    "$spc Usage: bastille [ -b | -c | -r | -x [ --os version ] ]\n".
    "$spc -b : use a saved config file to apply changes\n".
    "$spc      directly to system\n".
    "$spc -c : use the Curses (non-X11) TUI\n".
    "$spc -r : revert all Bastille changes to-date\n".
    "$spc -x : use the Perl/Tk (X11) GUI\n" .
    "$spc --os version : ask all questions for the given operating system\n" . 
    "$spc                version.  e.g. --os RH6.0\n";

# These options don't work universally, so it's best not to
# document them here (yet).  Hopefully, we'll get them
# straightened out soon.
#"$spc --log : log-only option\n".
#"$spc -v : verbose mode\n".
#"$spc --debug : debug mode\n";


##############################################################################
#
#  Directory structure for Bastille Linux v1.2 and up
#
##############################################################################
#
#  /usr/sbin/          -- location of Bastille binaries
#  /usr/lib/Bastille   -- location of Bastille modules
#  /usr/share/Bastille -- location of Bastille data files
#  /etc/Bastille       -- location of Bastille config files
#
#  /var/log/Bastille      -- location of Bastille log files
#  /var/log/Bastille/revert -- directory holding all Bastille-created revert scripts
#  /var/log/Bastille/revert/backup -- directory holding the original files that
#                                   Bastille modifies, with permissions intact
#
##############################################################################

##############################################################################
#
#  Directory structure for HP-UX Bastille v2.0 and up
#
##############################################################################
#
#  /opt/sec_mgmt/bastille/bin/  -- location of Bastille binaries
#  /opt/sec_mgmt/bastille/lib/  -- location of Bastille modules
#  /etc/opt/sec_mgmt/bastille/  -- location of Bastille data and config files
#
#  /var/opt/sec_mgmt/bastille/log/   -- location of Bastille log files
#  /var/opt/sec_mgmt/bastille/revert -- directory holding all Bastille-created
#                                       revert scripts and save files
#
##############################################################################


##############################################################################
##############################################################################
##################  Actual functions start here... ###########################
##############################################################################
##############################################################################

###########################################################################
# setOptions takes five arguments, $GLOBAL_DEBUG, $GLOBAL_LOGONLY,
# $GLOBAL_VERBOSE, $GLOBAL_AUDITONLY, and $GLOBAL_AUDIT_NO_BROWSER;
###########################################################################
sub setOptions($$$$) {
    ($GLOBAL_DEBUG,$GLOBAL_LOGONLY,$GLOBAL_VERBOSE,$GLOBAL_AUDITONLY,$GLOBAL_AUDIT_NO_BROWSER) = @_;
    if ($GLOBAL_AUDIT_NO_BROWSER) {
	$GLOBAL_AUDITONLY = 1;
    }
}
###########################################################################
# 
# SanitizeEnv load a proper environment so Bastille cannot be tricked
# and Perl modules work correctly.
# 
###########################################################################
sub SanitizeEnv {
	 delete @ENV{'IFS','CDPATH','ENV','BASH_ENV'};
	 $ENV{CDPATH}=".";
	 $ENV{BASH_ENV}= "";
	 # Bin is needed here or else  /usr/lib/perl5/5.005/Cwd.pm 
	 # will not find `pwd`
	 # Detected while testing with -w, jfs
	 $ENV{PATH} = "/bin:/usr/bin";
	 # Giorgi, is /usr/local/bin needed? (jfs)
}

###########################################################################
# 
# PrepareToRun sets up Bastille to run.  It checks the ARGV array for
# special options and runs ConfigureForDistro to set necessary file
# locations and other global variables.
#
###########################################################################

sub PrepareToRun {
    
    # Make sure we're root!
    if ( $> != 0 ) {
	&B_log("ERROR","Bastille Back-End must run as root!\n");
        exit(1);
    }

   
    # Make any directories that don't exist...
    foreach my $dir ( &getGlobal('BDIR', "revert") , &getGlobal('BDIR', "backup"), &getGlobal('BDIR', "log"),&getGlobal('BDIR', "config") ) {
	mkpath ($dir,0,0700);
    }

    if(&GetDistro =~ "^HP-UX") {
	&B_check_system;
    }

    &B_log("ACTION","\n########################################################\n" .
	       "#  Begin Bastille Run                                  #\n" .
	       "########################################################\n\n");

    #read sum file if it exists.
    &B_read_sums;

    # check the integrity of the files listed
    for my $file (sort keys %GLOBAL_SUM) {
	&B_check_sum($file);
    }
    # write out the newly flagged sums
    &B_write_sums;


}

###########################################################################
#
# GetDistro checks to see if the target is a known distribution and reports
# said distribution.
#
# This is used throughout the script, but also by ConfigureForDistro.
# 
#
###########################################################################

sub GetDistro() {

    my ($release,$distro);

    # Only read files for the distro once.
    # if the --os option was used then 
    if (defined $GLOBAL_OS) {
	$distro = $GLOBAL_OS;
    } else {

	if ( -e "/etc/mandrake-release" ) {
	    open(MANDRAKE_RELEASE,"/etc/mandrake-release");
	    $release=<MANDRAKE_RELEASE>;

	    if ( ($release =~ /^Mandrake Linux release (\d+\.\d+\w*)/) or ($release =~ /^Linux Mandrake release (\d+\.\d+\w*)/) or ($release =~ /^Mandriva Linux release (\d+\.\d+\w*)/) ) {
		$distro="MN$1";
	    }
	    elsif ( $release =~ /^Mandrakelinux release (\d+\.\d+)\b/ ) {
                $distro="MN$1";
            }
            else {
		print STDERR "$err Couldn't determine Mandrake/Mandriva version! Setting to 10.1!\n";
		$distro="MN10.1";
	    }

	    close(MANDRAKE_RELEASE);
	}
	elsif ( -e "/etc/immunix-release" ) {
	    open(IMMUNIX_RELEASE,"/etc/immunix-release");
	    $release=<IMMUNIX_RELEASE>;
	    unless ($release =~ /^Immunix Linux release (\d+\.\d+\w*)/) {
		print STDERR "$err Couldn't determine Immunix version! Setting to 6.2!\n";
		$distro="RH6.2";
	    }
	    else {
		$distro="RH$1";
	    }
	    close(*IMMUNIX_RELEASE);
	}
	elsif ( -e '/etc/fedora-release' ) {
            open(FEDORA_RELEASE,'/etc/fedora-release');
            $release=<FEDORA_RELEASE>;
            close FEDORA_RELEASE;
            if ($release =~ /^Fedora Core release (\d+\.?\d*)/) {
                $distro = "RHFC$1";
            }
            else {
                print STDERR "$err Could not determine Fedora version! Setting to Fedora Core 5\n";
                $distro='RHFC5';
            }
	}
	elsif ( -e "/etc/redhat-release" ) {
	    open(*REDHAT_RELEASE,"/etc/redhat-release");
	    $release=<REDHAT_RELEASE>;
	    if ($release =~ /^Red Hat Linux release (\d+\.?\d*\w*)/) {
		$distro="RH$1";
	    }
            elsif ($release =~ /^Red Hat Linux .+ release (\d+)\.?\d*([AEW]S)/) {
                $distro="RHEL$1$2";
            }
	    elsif ($release =~ /^Red Hat Enterprise Linux ([AEW]S) release (\d+)/) {
		$distro="RHEL$2$1";
	    }
	    elsif ($release =~ /^CentOS release (\d+\.\d+)/) { 	 
		my $version = $1; 	 
		if ($version =~ /^4\./) { 	 
		    $distro='RHEL4AS'; 	 
		} 	 
		elsif ($version =~ /^3\./) { 	 
		    $distro='RHEL3AS'; 	 
		}
		else {
		    print STDERR "$err Could not determine CentOS version! Setting to Red Hat Enterprise 4 AS.\n"; 	 
		    $distro='RHEL4AS'; 	 
                 }
	    }
 	    else {
		# JJB/HP - Should this be B_log?
		print STDERR "$err Couldn't determine Red Hat version! Setting to 9!\n";
		$distro="RH9";
	    }
	    close(REDHAT_RELEASE);

	}
	elsif ( -e "/etc/debian_version" ) {
	    $stable="3.0"; #Change this when Debian stable changes
	    open(*DEBIAN_RELEASE,"/etc/debian_version");
	    $release=<DEBIAN_RELEASE>;
	    unless ($release =~ /^(\d+\.\d+\w*)/) {
		print STDERR "$err System is not running a stable Debian GNU/Linux version. Setting to $stable.\n";
		$distro="DB$stable";
	    }
	    else {
		$distro="DB$1";
	    }      
	    close(DEBIAN_RELEASE);
	}
	elsif ( -e "/etc/SuSE-release" ) {
	    open(*SUSE_RELEASE,"/etc/SuSE-release");
	    $release=<SUSE_RELEASE>;
	    if ($release =~ /^SuSE Linux (\d+\.\d+\w*)/i) {
		$distro="SE$1";
	    }
	    elsif ($release =~ /^SUSE LINUX Enterprise Server (\d+\.?\d?\w*)/) {
		$distro="SESLES$1";
	    }
	    else {
		print STDERR "$err Couldn't determine SuSE version! Setting to 7.2!\n";
		$distro="SE7.2";
	    } 
	    close(SUSE_RELEASE);
	}   
	elsif ( -e "/etc/turbolinux-release") {
	    open(*TURBOLINUX_RELEASE,"/etc/turbolinux-release");
	    $release=<TURBOLINUX_RELEASE>;
	    unless ($release =~ /^Turbolinux Workstation (\d+\.\d+\w*)/) {
		print STDERR "$err Couldn't determine TurboLinux version! Setting to 7.0!\n";
		$distro="TB7.0";
	    }
	    else {
		$distro="TB$1";
	    }
	    close(TURBOLINUX_RELEASE);
	}
	else {
	    # We're either on Mac OS X, HP-UX or an unsupported O/S.
            if ( -x '/usr/bin/uname') {
		# uname is in /usr/bin on Mac OS X and HP-UX
		$release=`/usr/bin/uname -sr`;
	    }
	    else {
	 	print STDERR "$err Could not determine operating system version!\n";
		$distro="unknown";
            }

	    # Figure out what kind of system we're on.
	    if ($release ne "") {
		if ($release =~ /^Darwin\s+(\d+)\.(\d+)/) {
		    if ($1 == 6 ) {
			$distro = "OSX10.2";
		    }
		    elsif ($1 == 7) {
			$distro = "OSX10.3";
		    }
		    elsif ($1 == 8) {
			$distro = "OSX10.4";
 		    }
		    else {
		        $distro = "unknown";
		    }
		}
	        elsif ( $release =~ /(^HP-UX)\s*B\.(\d+\.\d+)/ ) {
		   $distro="$1$2";
		} elsif ( $release =~ /^(\w+)\s+(\d+)/) {
		   $distro="$1$2";
		}
		else {
		   print STDERR "$err Could not determine operating system version!\n";
	           $distro="unknown";
		}
	    }
	}
	
	$GLOBAL_OS=$distro;
    }
    
    return $distro;
}

###################################################################################
#   &getActualDistro;                                                             #
#                                                                                 #
#    This subroutine returns the actual os version in which is running on.  This  #
#    os version is independent of the --os switch feed to bastille.               #
#                                                                                 #
###################################################################################
sub getActualDistro {
    # set local variable to $GLOBAL_OS
    my $os = $GLOBAL_OS;
    # undef GLOBAL_OS so that the GetDistro routine will return
    # the actualDistro, it might otherwise return the distro set
    # by the --os switch.
    $GLOBAL_OS = undef;
    my $actualDistro = &GetDistro;
    # reset the GLOBAL_OS variable
    $GLOBAL_OS = $os;
    
    return $actualDistro;

}
# These are helper routines which used to be included inside GetDistro
sub is_OS_supported($) {
   my $os=$_[0];
   my $supported=0;
   my %supportedOSHash = &getSupportedOSHash;
   
   foreach my $oSType (keys %supportedOSHash) {
       foreach my $supported_os ( @{$supportedOSHash{$oSType}} ) {
	   if ( $supported_os eq $os ) {
	       $supported=1;
	   }
       }
   }

   return $supported;
}

###############################################################################
#   getSupportedOSHash
#   
#   This subrountine returns a hash of supported OSTypes, which point to a
#   a list of supported distros.  When porting to a new distro, add the
#   distro id to the hash in its appropriate list.
###############################################################################
sub getSupportedOSHash () {

    my %osHash = ("LINUX" => [
			      "DB2.2", "DB3.0", 
			      "RH6.0","RH6.1","RH6.2","RH7.0",
			      "RH7.1","RH7.2","RH7.3","RH8.0",
			      "RH9",
			      "RHEL4AS","RHEL4ES","RHEL4WS",
			      "RHEL3AS","RHEL3ES","RHEL3WS",
			      "RHEL2AS","RHEL2ES","RHEL2WS",
			      "RHFC1","RHFC2","RHFC3","RHFC4","RHFC5",
			      "MN6.0","MN6.1 ","MN7.0","MN7.1",
			      "MN7.2","MN8.0","MN8.1","MN8.2",
			      "MN9.2",
			      "MN10.0","MN10.1","MN2006.0",
			      "SE7.2","SE7.3", "SE8.0","SE8.1","SE9.0","SE9.1",
			      "SE9.2","SE9.3","SE10.0",
			      "SESLES8","SESLES9",
			      "TB7.0" 
			      ],

		  "HP-UX" => [
			      "HP-UX11.00","HP-UX11.11", 
			      "HP-UX11.22", "HP-UX11.23", 
			      "HP-UX11.31"
			      ],

		"NetBSD" => [
			"NetBSD1", "NetBSD2", "NetBSD3", "NetBSD4",
		],

		  "OSX" => [
			    'OSX10.2','OSX10.3','OSX10.4'
			    ]
		  );

  return %osHash;

}


###############################################################################
#  setFileLocations(OSMapFile, currentDistro);
#  
#  Given a file map location this subroutine will create the GLOBAL_*
#  hash entries specified within this file.
###############################################################################
sub setFileLocations($$) {

    my ($fileInfoFile,$currentDistro) = @_;
    
    # define a mapping from the first argument to the proper hash
    my %map = ("BIN"   => \%GLOBAL_BIN,
	       "FILE"  => \%GLOBAL_FILE,
	       "BFILE" => \%GLOBAL_BFILE,
	       "DIR"   => \%GLOBAL_DIR,
	       "BDIR"  => \%GLOBAL_BDIR
	       );
    my @fileInfo = ();

    #  File containing file location information
    if(open(FILEINFO, "<$fileInfoFile" )) {
	
	@fileInfo = <FILEINFO>;
	
	close(FILEINFO);
	
    }
    else {
	print STDERR "$err Unable to find file location information for '$distro'.\n" .
	    "$spc Contact the Bastille support list for details.\n";
	exit(1);
    }
    
    # Each line of the file map follows the pattern below:
    # bdir,init.d,'/etc/rc.d/init.d',RH7.2,RH7.3
    # if the distro information is not available, e.g.
    # bdir,init.d,'/etc/rc.d/init.d'
    # then the line applies to all distros under the OSType
    foreach my $file (@fileInfo) {
	# Perl comments are allowed within the file but only entire line comments
	if($file !~ /^\s+\#|^\s+$/) {
	    chomp $file;
	    # type relates to the map above, type bin will map to GLOBAL_BIN
	    # id is the identifier used as the hash key by the GLOBAL hash
	    # fileLocation is the full path to the file
	    # distroList is an optional list of distros that this particular
	    #   file location, if no distro list is presented the file location
	    #   is considered to apply to all distros
	    my ($type,$id,$fileLocation,@distroList) = split /\s*,\s*/, $file;
	    $fileLocation =~ s/^\'(.*)\'$/$1/;
	    if($#distroList == -1) {
		$map{uc($type)}->{$id}=$fileLocation;
	    }
	    else {
		foreach my $distro (@distroList) {
		    # if the current distro matches the distro listed then
		    # this file location applies
		    if($currentDistro =~ /$distro/) {
			$map{uc($type)}->{$id}=$fileLocation;
		    }
		}
	    }
	}
    }
}

###############################################################################
#  setServiceInfo($OSServiceMapFile, $currentDistro
#
#  Given the location of an OS Service map file, which describes
#  a service in terms of configurables, processes and a service type.
#  The subroutine fills out the GLOBAL_SERVICE, GLOBAL_SERVTYPE, and
#  GLOBAL_PROCESS hashes for a given service ID.
###############################################################################
sub setServiceInfo($$) {
    my ($serviceInfoFile,$currentDistro) = @_;
    my @serviceInfo = ();

    if(open(SERVICEINFO, "<$serviceInfoFile" )) {
	
	@serviceInfo = <SERVICEINFO>;
	
	close(SERVICEINFO);
	
    }
    else {
	print STDERR "$err Unable to find service, service type, and process information\n" . 
	             "$spc for '$distro'.\n" .
	             "$spc Contact the Bastille support list for details.\n";
	exit(1);
    }
    

    # The following loop, parses the entire (YOUR OS).service file
    # to provide service information for YOUR OS.
    # The files format is as follows:
    # serviceID,servType,('service' 'configuration' 'list'),('process' 'list')[,DISTROS]* 
    # if distros are not present then the service is assumed to be 
    # relevant the the current distro


#
# More specifically, this file's format for rc-based daemons is:
#
# script_name,rc, (),('program_name1 program_name2 ...')
#
# ...where script_name is a file in /etc/init.d/ and
# ...program_nameN is a program launced by the script.
#
# This file's format for inet-based daemons is:
#
# identifier, inet, line name/file name, program name
#
# label,inet,(port1 port2 ...),(daemon1 daemon2 ...)
#
# ...where label is arbitrary, portN is one of the ports
# ...this one listens on, and daemonN is a program launched
# ...in response to a connection on a port.

    foreach my $service (@serviceInfo) {
	# This file accepts simple whole line comments perl style
	if($service !~ /^\s+\#|^\s+$/) {
	    chomp $service;
	    my ($serviceID,$servType,$strServiceList,
		$strProcessList,@distroList) = split /\s*,\s*/, $service;

	    # produce a list of service configurables from the files
	    # format ('service' 'configurable')
	    my @serviceList = split /\'\s+\'/, $strServiceList;
	    $serviceList[0] =~ s/^\(\'(.+)$/$1/;
	    $serviceList[$#serviceList] =~ s/^(.+)\'\)$/$1/;
	    
	    # produce a list of process names from the files format
	    # ('my' 'process' 'list')
	    my @processList = split /\'\s+\'/, $strProcessList;
	    $processList[0] =~ s/^\(\'(.+)$/$1/;
	    $processList[$#processList] =~ s/^(.+)\'\)$/$1/;

	    # if distros were not specified then accept the service information
	    if($#distroList == -1) {
		@{$GLOBAL_SERVICE{$serviceID}} = @serviceList;
		$GLOBAL_SERVTYPE{$serviceID} = $servType;
		@{$GLOBAL_PROCESS{$serviceID}} = @processList;
	    }
	    else {
		# only if the current distro matches one of the listed distros
		# include the service information.
		foreach my $distro (@distroList) {
		    if($currentDistro =~ /$distro/) {
			@{$GLOBAL_SERVICE{$serviceID}} = @serviceList;
			$GLOBAL_SERVTYPE{$serviceID} = $servType;
			@{$GLOBAL_PROCESS{$serviceID}} = @processList;
		    }
		}
	    }
	}
    }
}



###############################################################################
#  getFileAndServiceInfo($distro,$actualDistro)
#
#  This subrountine, given distribution information, will import system file
#  and service information into the GLOBA_* hashes.
#
#  NOTE: $distro and $actualDistro will only differ when the --os switch is
#        used to generate a configuration file for an arbitrary operating
#        system.
#
###############################################################################
sub getFileAndServiceInfo($$) {

    my ($distro,$actualDistro) = @_;

    # defines the path to the OS map information for any supported OS type.
    # OS map inforation is used to determine file locations for a given
    # distribution.
    my %oSInfoPath = ( 
		       "LINUX" => "/usr/share/Bastille/OSMap/",
		       "HP-UX" => "/etc/opt/sec_mgmt/bastille/OSMap/",
		       "NetBSD" => "/usr/pkg/share/Bastille/OSMap/",
		       "OSX" => "/usr/share/Bastille/OSMap/"
		       );

    # returns the OS, LINUX,  HP-UX, or OSX, associated with this
    # distribution
    my $actualOS = &getOSType($actualDistro);
    my $oS = &getOSType($distro);

    if(defined $actualOS && defined $oS) {
	my $bastilleInfoFile = $oSInfoPath{$actualOS} . "${actualOS}.bastille";
	my $systemInfoFile =  $oSInfoPath{$actualOS} . "${oS}.system";
	my $serviceInfoFile = $oSInfoPath{$actualOS} . "${oS}.service";
	
	if(-f $bastilleInfoFile) {
	    &setFileLocations($bastilleInfoFile,$actualDistro);
	}
	else {
	    print STDERR "$err Unable to find bastille file information.\n" . 
		         "$spc $bastilleInfoFile does not exist on the system";
	    exit(1);
	}
	
	if(-f $systemInfoFile) {
	    &setFileLocations($systemInfoFile,$distro);
	}	
	else {
	    print STDERR "$err Unable to find system file information.\n" . 
		         "$spc $systemInfoFile does not exist on the system";
	    exit(1);
	}
	# Service info File is optional
	if(-f $serviceInfoFile) {
	    &setServiceInfo($serviceInfoFile,$distro);
	}
    }
    else {
	print STDERR "$err Unable to determine operating system type\n" .
	             "$spc for $actualDistro or $distro\n";
	exit(1);
    }
    
}


# returns the Operating System type associated with the specified
# distribution.
sub getOSType($) {

    my $distro = $_[0];

    my %supportedOSHash = &getSupportedOSHash;
    foreach my $oSType (keys %supportedOSHash) {
	foreach my $oSDistro (@{$supportedOSHash{$oSType}}) {
	    if($distro eq $oSDistro) {
		return $oSType;
	    }
	}
    }

    return undef;

}


# Test subroutine used to debug file location info for new Distributions as
# they are ported.
sub dumpFileInfo {
    print "Dumping File Information\n";
    foreach my $hashref (\%GLOBAL_BIN,\%GLOBAL_DIR,\%GLOBAL_FILE,\%GLOBAL_BFILE,\%GLOBAL_BDIR) {
	foreach my $id (keys %{$hashref}) {
	    print "$id: ${$hashref}{$id}\n";
	}
	print "-----------------------\n\n";
    }
}

# Test subroutine used to debug service info for new Distributions as
# they are ported.
sub dumpServiceInfo {
    print "Dumping Service Information\n";
    foreach my $serviceId (keys %GLOBAL_SERVICE) {
	print "$serviceId:\n";
	print "Type - $GLOBAL_SERVTYPE{$serviceId}\n";
	print "Service List:\n";
	foreach my $service (@{$GLOBAL_SERVICE{$serviceId}}) {
	    print "$service ";
	}
	print "\nProcess List:\n";
	foreach my $process (@{$GLOBAL_PROCESS{$serviceId}}) {
	    print "$process ";
	}
	print "\n----------------------\n";
    }
}
	 

###########################################################################
#
# &ConfigureForDistro configures the API for a given distribution.  This
# includes setting global variables that tell the Bastille API about
# given binaries and directories.
#
# WARNING: If a distro is not covered here, Bastille may not be 100% 
#          compatible with it, though 1.1 is written to be much smarter
#          about unknown distros...
#
###########################################################################
sub ConfigureForDistro {

    my $retval=1;

    # checking to see if the os version given is in fact supported
    my $distro = &GetDistro;

    # checking to see if the actual os version is in fact supported
    my $actualDistro = &getActualDistro;
    if ((! &is_OS_supported($distro)) or (! &is_OS_supported($actualDistro))  ) {
	# if either is not supported then print out a list of supported versions
	if (! &is_OS_supported($distro)) {
	    print STDERR "$err '$distro' is not a supported operating system.\n";
	}
	else {
	    print STDERR "$err Bastille is unable to operate correctly on this\n";
	    print STDERR "$spc operating system.\n";
	}
	my %supportedOSHash = &getSupportedOSHash;
	print STDERR "$spc Valid operating system versions are as follows:\n";

	foreach my $oSType (keys %supportedOSHash) {

	    print STDERR "$spc $oSType:\n$spc ";

	    my $os_number = 1;
	    foreach my $os (@{$supportedOSHash{$oSType}}) {
		print STDERR "'$os' ";
		if ($os_number == 5){
		    print STDERR "\n$spc ";
		    $os_number = 1;
		}
		else {
		    $os_number++;
		}
		
	    }
	    print STDERR "\n";
	}

	print "\n" . $GLOBAL_ERROR{"usage"};
	exit(1);
    }

    # First, let's make sure that we do not create any files or 
    # directories with more permissive permissions than we 
    # intend via setting the Perl umask
    umask(077);

    &getFileAndServiceInfo($distro,$actualDistro);
    
#    &dumpFileInfo;  # great for debuging file location issues
#    &dumpServiceInfo; # great for debuging service information issues

   # OS dependent error messages (after configuring file locations)
    my $nodisclaim_file = &getGlobal('BFILE', "nodisclaimer");

    $GLOBAL_ERROR{"disclaimer"}="$err Unable to touch $nodisclaim_file:" .
	    "$spc You must use Bastille\'s -n flag (for example:\n" .
	    "$spc bastille -i -n) or \'touch $nodisclaim_file \'\n"; 

    return $retval;
}


###########################################################################
###########################################################################
#                                                                         #
# The B_<perl_function> file utilities are replacements for their Perl    #
# counterparts.  These replacements log their actions and their errors,   #
# but are very similar to said counterparts.                              #
#                                                                         #
###########################################################################
###########################################################################


###########################################################################
# B_open was the v1.0 open command.  It is still used in places in the
# code, but B_open_plus is the preferred 
#
# B_open opens the given file handle, associated with the given filename
# and logs appropriately.
#
###########################################################################

sub B_open {
   my $retval=1;
   my ($handle,$filename)=@_;

   unless ($GLOBAL_LOGONLY) {
       $retval = open $handle,$filename;
   }

   ($handle) = "$_[0]" =~ /[^:]+::[^:]+::([^:]+)/;
   &B_log("ACTION","open $handle,\"$filename\";\n");
   unless ($retval) {
      &B_log("ACTION","#open $handle , $filename failed...\n");
      &B_log("ERROR","#open $handle, $filename failed...\n");
   }
   
   return $retval;
}   

###########################################################################
# B_open_plus is the v1.1 open command.
# 
# &B_open_plus($handle_file,$handle_original,$file) opens the file $file
# for reading and opens the file ${file}.bastille for writing.  It is the
# counterpart to B_close_plus, which will move the original file to
# $GLOBAL_BDIR{"backup"} and will place the new file ${file}.bastille in its
# place.
#
# &B_open_plus makes the appropriate log entries in the action and error
# logs.
###########################################################################

sub B_open_plus {

    my ($handle_file,$handle_original,$file)=@_;
    my $retval=1;
    my $return_file=1;
    my $return_old=1;
  
    my $original_file = $file;

    # Open the original file and open a copy for writing.
    unless ($GLOBAL_LOGONLY) {
	# if the temporary filename already exists then the open operation will fail.
	if (-e "${file}.bastille") {
	    &B_log("ERROR","Unable to open $file as the\n" . 
		      "         swap file ${file}.bastille\n" .
		      "         already exists.  Rename the swap file to allow Bastille\n" .
		      "         to make desired file modifications.\n");
	    $return_old=0;
	    $return_file=0;
	}
	else {
	    $return_old = open $handle_original,"$file";
	    $return_file = open $handle_file,("> $file.bastille");
	}
    }
    
    # Error handling/logging here...
    #&B_log("ACTION","# Modifying file $original_file via temporary file $original_file.bastille\n");
    unless ($return_file) {
	$retval=0;
	&B_log("ERROR","open $original_file.bastille failed...\n");
    }
    unless ($return_old) {
	$retval=0;
	&B_log("ERROR","open $original_file failed.\n");
    }

    return $retval;
        
}

###########################################################################
# B_close was the v1.0 close command.  It is still used in places in the
# code.
# However the use of B _close_plus, which implements a new, smarter,
# backup scheme is preferred.
#
# B_close closes the given file handle, associated with the given filename
# and logs appropriately.
###########################################################################


sub B_close {
   my $retval=1;

   unless ($GLOBAL_LOGONLY) {
       $retval = close $_[0];
   }

   &B_log("ACTION", "close $_[0];\n");
   unless ($retval) {
      &B_log("ACTION","#ERROR: close $_[0] failed...\n");
      &B_log("ERROR", "#ERROR: close $_[0] failed...\n");
   }

   return $retval;
}


###########################################################################
# B_close_plus is the v1.1 close command.
# 
# &B_close_plus($handle_file,$handle_original,$file) closes the files
# $file and ${file}.bastille, backs up $file to $GLOBAL_BDIR{"backup"} and
# renames ${file}.bastille to $file.  This backup is made using the
# internal API function &B_backup_file.  Further, it sets the new file's
# permissions and uid/gid to the same as the old file.
#
# B_close_plus is the counterpart to B_open_plus, which opened $file and 
# $file.bastille with the file handles $handle_original and $handle_file, 
# respectively.
#
# &B_close_plus makes the appropriate log entries in the action and error
# logs.
###########################################################################

sub B_close_plus {
    my ($handle_file,$handle_original,$file)=@_;
    my ($mode,$uid,$gid);
    my @junk;

    my $original_file;

    my $retval=1;
    my $return_file=1;
    my $return_old=1;

    # Append the global prefix, but save the original for B_backup_file b/c
    # it appends the prefix on its own...

    $original_file=$file;

    #
    # Close the files and prepare for the rename
    #

    unless ($GLOBAL_LOGONLY) {
	$return_file = close $handle_file;
	$return_old = close $handle_original;
    }

    # Error handling/logging here...
    #&B_log("ACTION","#Closing $original_file and backing up to " . &getGlobal('BDIR', "backup"));
    #&B_log("ACTION","/$original_file\n");

    unless ($return_file) {
	$retval=0;
	&B_log("ERROR","close $original_file failed...\n");
    }
    unless ($return_old) {
	$retval=0;
	&B_log("ERROR","close $original_file.bastille failed.\n");
    }

    #
    # If we've had no errors, backup the old file and put the new one
    # in its place, with the Right permissions.
    #

    unless ( ($retval == 0) or $GLOBAL_LOGONLY) {

	# Read the permissions/owners on the old file
	
	@junk=stat ($file);
	$mode=$junk[2];
	$uid=$junk[4];
	$gid=$junk[5];

	# Set the permissions/owners on the new file

	chmod $mode, "$file.bastille" or &B_log("ERROR","Not able to retain permissions on $original_file!!!\n");
	chown $uid, $gid, "$file.bastille" or &B_log("ERROR","Not able to retain owners on $original_file!!!\n");

	# Backup the old file and put a new one in place.
	
	&B_backup_file($original_file);
	rename "$file.bastille", $file or &B_log("ERROR","B_close_plus: not able to move $original_file.bastille to $original_file\n");

    }

    return $retval;
}

###########################################################################
# &B_backup_file ($file) makes a backup copy of the file $file in 
# &getGlobal('BDIR', "backup").  Note that this routine is intended for internal
# use only -- only Bastille API functions should call B_backup_file.
#
###########################################################################

sub B_backup_file {

    my $file=$_[0];
    my $complain = 1;
    my $original_file = $file;

    my $backup_dir = &getGlobal('BDIR', "backup");
    my $backup_file = $backup_dir . $original_file;

    my $retval=1;

    # First, separate the file into the directory and the relative filename

    my $directory ="";
    if ($file =~ /^(.*)\/([^\/]+)$/) {
	#$relative_file=$2;
	$directory = $1;
    } else {
        $directory=cwd;
    }

    # Now, if the directory does not exist, create it.
    # Later:
    #   Try to set the same permissions on the patch directory that the
    #   original had...?

    unless ( -d ($backup_dir . $directory) ) {
	mkpath(( $backup_dir . $directory),0,0700);

    }

    # Now we backup the file.  If there is already a backup file there,
    # we will leave it alone, since it exists from a previous run and
    # should be the _original_ (possibly user-modified) distro's version 
    # of the file.

    if ( -e $file ) {
	# We add the file to the GLOBAL_SUMS hash if it is not already present
	&B_set_sum($file);

	unless ( -e $backup_file ) {
	    $command=&getGlobal("BIN","cp");
            `$command -p $file $backup_file`;
	    &B_revert_log (&getGlobal("BIN","mv"). " $backup_file $file");
	}

    } else {
	# The file we were trying to backup doesn't exist.

	$retval=0;
	# This is a non-fatal error, not worth complaining about
	$complain = 0;
	#&ErrorLog ("# Failed trying to backup file $file -- it doesn't exist!\n");
    }

    # Check to make sure that the file does exist in the backup location.
    
    unless ( -e $backup_file ) {
	$retval=0;
	if ( $complain == 1 ) { 
	    &B_log("ERROR","Failed trying to backup $file -- the copy was not created.\n"); 
	}
    }

    return $retval;
}


###########################################################################
# &B_read_sums reads in the sum.csv file which contains information
#   about Bastille modified files. The file structure is as follows:
#
#     filename,filesize,cksum,change_flag
# 
#   It reads the information into the GLOBAL_SUM hash i.e.
#      $GLOBAL_SUM{$file}{sum} = $cksum
#      $GLOBAL_SUM{$file}{filesize} = $size
#      $GLOBAL_SUM{$file}{flag} = $flag_that_denotes_changes_have_occurred
#   For the first run of Bastille on a given system this subroutine
#   is a no-op.
###########################################################################

sub B_read_sums {

    my $sumFile = &getGlobal('BFILE',"sum.csv");

    if ( -e $sumFile ) {

	open( SUM, "< $sumFile") or &B_log("ERROR","Unable to open $sumFile for read.\n$!\n");

	while( my $line = <SUM> ) {
	    chomp $line;
	    my ($file,$filesize,$sum,$flag) = split /,/, $line;
	    if(-e $file) {
		$GLOBAL_SUM{"$file"}{filesize} = $filesize;
		$GLOBAL_SUM{"$file"}{sum} = $sum;
		$GLOBAL_SUM{"$file"}{flag} = $flag;
	    }
	}

	close(SUM);
    }
}


###########################################################################
# &B_write_sums writes out the sum.csv file which contains information
#   about Bastille modified files. The file structure is as follows:
#
#     filename,filesize,cksum,change_flag
# 
#   It writes the information from the GLOBAL_SUM hash i.e.
#
#      $file,$GLOBAL_SUM{$file}{sum},$GLOBAL_SUM{$file}{filesize},$GLOBAL_SUM{$file}{flag}
#
#   This subroutine requires access to the GLOBAL_SUM hash.
###########################################################################

sub B_write_sums {

    my $sumFile = &getGlobal('BFILE',"sum.csv");

    if ( defined %GLOBAL_SUM ) {

	open( SUM, "> $sumFile") or &B_log("ERROR","Unable to open $sumFile for write.\n$!\n");

	for my $file (sort keys %GLOBAL_SUM) {
	    if( -e $file) {
		print SUM "$file,$GLOBAL_SUM{\"$file\"}{filesize},$GLOBAL_SUM{\"$file\"}{sum},$GLOBAL_SUM{\"$file\"}{flag}\n";
	    }
	}

	close(SUM);
    }

}


###########################################################################
# &B_check_sum($file) compares the stored cksum and filesize of the given
#   file compared to the current cksum and filesize respectively.
#   It uses the GLOBAL_SUM hash to determine if the file has been modified
#   since the last run of Bastille.  If it has been modified the file flag
#   is set.
#
#     $GLOBAL_SUM{$file}{flag} = 1;
#
#   This subroutine also keeps the state of the sum check by setting the
#   checked flag which tells the subroutine that on this run this file
#   has already been checked.
#
#     $GLOBAL_SUM{$file}{checked} = 1;
#
#   This subroutine requires access to the GLOBAL_SUM hash.
###########################################################################
	
sub B_check_sum($) {
    my $file = $_[0];
    my $cksum = &getGlobal('BIN',"cksum");
    if(-e $file) {
	my ($sum,$size,$ckfile) = split /\s+/, `$cksum $file`;
        my $commandRetVal = ($? >> 8);  # find the command's return value

	if($commandRetVal != 0) {
	    &B_log("ERROR","$cksum reported the following error:\n$!\n");
	}
	else {
	    
	    if( exists $GLOBAL_SUM{$file} ) {
		# if the flag is currently set to 0
		if(! $GLOBAL_SUM{$file}{flag}) {
		    # if the file size or file sum differ from those recorded.
		    if( $GLOBAL_SUM{$file}{filesize} != $size ||
			$GLOBAL_SUM{$file}{sum} != $sum ) {
			# setting flag to 1
			$GLOBAL_SUM{$file}{flag} = 1;
		    }
		}
	    }
	    else {  
		&B_log("ERROR","The file $file does not exist in the sums database\n");
	    }
	}
    }
}

sub isSumDifferent($) {
    my $file = $_[0];
    if(exists $GLOBAL_SUM{$file}) {
	return $GLOBAL_SUM{$file}{flag}
    }
}

sub listModifiedFiles {
    my @listModifiedFiles=sort keys %GLOBAL_SUM;
    return @listModifiedFiles;
}

###########################################################################
# &B_set_sum($file) sets the current cksum and filesize of the given
#   file into the GLOBAL_SUM hash.
#
#     $GLOBAL_SUM{$file}{filesize} = $size;
#     $GLOBAL_SUM{$file}{sum} = $cksum;
#
#   This subroutine requires access to the GLOBAL_SUM hash.
###########################################################################
	
sub B_set_sum($) {

    my $file = $_[0];
    my $cksum = &getGlobal('BIN',"cksum");
    if( -e $file) {
    
	my ($sum,$size,$ckfile) = split /\s+/, `$cksum $file`;
        my $commandRetVal = ($? >> 8);  # find the command's return value

	if($commandRetVal != 0) {
	    
	    &B_log("ERROR","$cksum reported the following error:\n$!\n");
	    
	}
	else {
	    
	    # new file size and sum are added to the hash
	    $GLOBAL_SUM{$file}{filesize} = $size;
	    $GLOBAL_SUM{$file}{sum} = $sum;
	    # Ensure that each new sum added to the hash has a flag defined
	    if( ! exists $GLOBAL_SUM{$file}{flag} ) {
		$GLOBAL_SUM{$file}{flag} = 0;
	    }
	    &B_write_sums;

	}
    }
}


###########################################################################
# &B_blank_file ($filename,$pattern) blanks the file $filename, unless the
# pattern $pattern is present in the file.  This lets us completely redo
# a file, if it isn't the one we put in place on a previous run...
#
# B_blank_file respects $GLOBAL_LOGONLY and uses B_open_plus and B_close_plus
# so that it makes backups and only modifies files when we're not in "-v"
# mode...
#
# If the file does not exist, the function does nothing, and gives an error 
# to the Error Log
#
###########################################################################

sub B_blank_file($$) {
    
    my ($filename,$pattern) = @_;
    my $retval;

    # If this variable is true, we won't blank the file...

    my $found_pattern=0;

    if ($retval=&B_open_plus (*BLANK_NEW,*BLANK_OLD,$filename) ) {

	my @lines;
	
	while (my $line = <BLANK_OLD>) {

	    push @lines,$line;
	    if ($line =~ $pattern) {
		$found_pattern=1;
	    }
	}

	# Only copy the old file if the new one didn't match.
	if ($found_pattern) {
	    while ($line = shift @lines ) {
		&B_print(*BLANK_NEW,$line);
	    }
	}
	else {
	    &B_log("ACTION","Blanked file $filename\n");
	}
	&B_close_plus(*BLANK_NEW,*BLANK_OLD,$filename);
    }
    else {
	&B_log("ERROR","Couldn't blank file $filename since we couldn't open it or its replacement\n");
    }

    return $retval;

}


###########################################################################
# &B_append_line ($filename,$pattern,$line_to_append)  modifies $filename,
# appending $line_to_append unless one or more lines in the file matches
# $pattern.  This is an enhancement to the append_line_if_no_such_line_exists
# idea.
#
# Additionally, if $pattern is set equal to "", the line is always appended.  
#
# B_append_line uses B_open_plus and B_close_plus, so that the file
# modified is backed up...
#
# Here's examples of where you might use this:
#
# You'd like to add a   root   line to /etc/ftpusers if none exists.
# You'd like to add a   Options Indexes  line to Apache's config. file,
# after you delete all Options lines from said config file.
#
###########################################################################

sub B_append_line($$$) {
   
    my ($filename,$pattern,$line_to_append) = @_;

    my $found_pattern=0;
    my $retval=1;

    if ( &B_open_plus (*APPEND_NEW,*APPEND_OLD,$filename) ) {
	while (my $line=<APPEND_OLD>) {
	    &B_print(*APPEND_NEW,$line);
	    if ($line =~ $pattern) {
		$found_pattern=1;
	    }
	}
	# Changed != 0 to $pattern so that "" works instead of 0 and perl
	# does not give the annoying
	# Argument "XX" isn't numeric in ne at ...
	if ( $pattern eq "" or ! $found_pattern ) {
	    &B_print(*APPEND_NEW,$line_to_append);
	    &B_log("ACTION","Appended the following line to $filename:\n");
	    &B_log("ACTION","$line_to_append");
	}
	&B_close_plus (*APPEND_NEW,*APPEND_OLD,$filename);
    }
    else {
	$retval=0;
	&B_log("ERROR","# Couldn't append line to $filename, since open failed.");
    }

    return $retval;

}

###########################################################################
# &B_insert_line_after ($filename,$pattern,$line_to_insert,$line_to_follow)  
# modifies $filename, inserting $line_to_insert unless one or more lines
# in the file matches $pattern.  The $line_to_insert will be placed
# immediately after $line_to_follow, if it exists.  If said line does not
# exist, the line will not be inserted and this routine will return 0.
#
# B_insert_line uses B_open_plus and B_close_plus, so that the file
# modified is backed up...
#
# Here's examples of where you might use this:
#
# You'd like to insert a line in Apache's configuration file, in a 
# particular section.
#
###########################################################################

sub B_insert_line_after($$$$) {
  
    my ($filename,$pattern,$line_to_insert,$line_to_follow) = @_;

    my @lines;
    my $found_pattern=0;
    my $found_line_to_follow=0;

    my $retval=1;

    if ( &B_open_plus (*INSERT_NEW,*INSERT_OLD,$filename) ) {

	# Read through the file looking for a match both on the $pattern
	# and the line we are supposed to be inserting after...

	my $ctr=1;
	while (my $line=<INSERT_OLD>) {
	    push (@lines,$line);
	    if ($line =~ $pattern) {
		$found_pattern=1;
	    }
	    if ( ($found_line_to_follow < 1) and ($line =~ $line_to_follow)) {
		$found_line_to_follow=$ctr;
	    }
	    $ctr++;
	}

	# Log an error if we never found the line we were to insert after
	unless ($found_line_to_follow ) {
	    $retval=0;
	    &B_log("ERROR","Never found the line that we were supposed to insert after in $filename\n");
	}

	# Now print the file back out, inserting our line if we should...

	$ctr=1;
	while (my $line = shift @lines) {
	    &B_print(*INSERT_NEW,$line);
	    if ( ($ctr == $found_line_to_follow) and ($found_pattern == 0) ) {
		&B_print(*INSERT_NEW,$line_to_insert);
		&B_log("ACTION","Inserted the following line in $filename:\n");
		&B_log("ACTION","$line_to_insert");
	    }
	    $ctr++;
	}

	&B_close_plus (*INSERT_NEW,*INSERT_OLD,$filename);
	
    }
    else {
	$retval=0;
	&B_log("ERROR","Couldn't insert line to $filename, since open failed.");
    }

    return $retval;

}
###########################################################################
# &B_insert_line_before ($filename,$pattern,$line_to_insert,$line_to_preceed)  
# modifies $filename, inserting $line_to_insert unless one or more lines
# in the file matches $pattern.  The $line_to_insert will be placed
# immediately before $line_to_preceed, if it exists.  If said line does not
# exist, the line will not be inserted and this routine will return 0.
#
# B_insert_line uses B_open_plus and B_close_plus, so that the file
# modified is backed up...
#
# Here's examples of where you might use this:
#
# You'd like to insert a line in Apache's configuration file, in a 
# particular section.
#
###########################################################################

sub B_insert_line_before($$$$) {
  
    my ($filename,$pattern,$line_to_insert,$line_to_preceed) = @_;

    my @lines;
    my $found_pattern=0;
    my $found_line_to_preceed=0;

    my $retval=1;

    if ( &B_open_plus (*INSERT_NEW,*INSERT_OLD,$filename) ) {

	# Read through the file looking for a match both on the $pattern
	# and the line we are supposed to be inserting after...

	my $ctr=1;
	while (my $line=<INSERT_OLD>) {
	    push (@lines,$line);
	    if ($line =~ $pattern) {
		$found_pattern=1;
	    }
	    if ( ($found_line_to_preceed < 1) and ($line =~ $line_to_preceed)) {
		$found_line_to_preceed=$ctr;
	    }
	    $ctr++;
	}

	# Log an error if we never found the line we were to preceed
	unless ($found_line_to_preceed ) {
	    $retval=0;
	    &B_log("ERROR","Never found the line that we were supposed to insert before in $filename\n");
	}

	# Now print the file back out, inserting our line if we should...

	$ctr=1;
	while (my $line = shift @lines) {
	    if ( ($ctr == $found_line_to_preceed) and ($found_pattern == 0) ) {
		&B_print(*INSERT_NEW,$line_to_insert);
		&B_log("ACTION","Inserted the following line in $filename:\n");
		&B_log("ACTION","$line_to_insert");
	    }
	    &B_print(*INSERT_NEW,$line);
	    $ctr++;
	}

	&B_close_plus (*INSERT_NEW,*INSERT_OLD,$filename);
	
    }
    else {
	$retval=0;
	&B_log("ERROR","Couldn't insert line to $filename, since open failed.");
    }

    return $retval;

}

###########################################################################
# &B_insert_line ($filename,$pattern,$line_to_insert,$line_to_follow)  
#
#   has been renamed to B_insert_line_after()
# 
# This name will continue to work, as a shim for code that has not been
# transitioned.
###########################################################################

sub B_insert_line($$$$) {

    my $rtn_value = &B_insert_line_after(@_);

    return ($rtn_value);
}


###########################################################################
# &B_prepend_line ($filename,$pattern,$line_to_prepend)  modifies $filename,
# pre-pending $line_to_prepend unless one or more lines in the file matches
# $pattern.  This is an enhancement to the prepend_line_if_no_such_line_exists
# idea.  
#
# B_prepend_line uses B_open_plus and B_close_plus, so that the file
# modified is backed up...
#
# Here's examples of where you might use this:
#
# You'd like to insert the line "auth   required   pam_deny.so" to the top
# of the PAM stack file /etc/pam.d/rsh to totally deactivate rsh.
#
###########################################################################

sub B_prepend_line($$$) {
   
    my ($filename,$pattern,$line_to_prepend) = @_;

    my @lines;
    my $found_pattern=0;
    my $retval=1;

    if ( &B_open_plus (*PREPEND_NEW,*PREPEND_OLD,$filename) ) {
	while (my $line=<PREPEND_OLD>) {
	    push (@lines,$line);
	    if ($line =~ $pattern) {
		$found_pattern=1;
	    }
	}
	unless ($found_pattern) {
	    &B_print(*PREPEND_NEW,$line_to_prepend);
	}
	while (my $line = shift @lines) {
	    &B_print(*PREPEND_NEW,$line);
	}

	&B_close_plus (*PREPEND_NEW,*PREPEND_OLD,$filename);
	
	# Log the action
	&B_log("ACTION","Pre-pended the following line to $filename:\n");
	&B_log("ACTION","$line_to_prepend");
    }
    else {
	$retval=0;
	&B_log("ERROR","Couldn't prepend line to $filename, since open failed.\n");
    }

    return $retval;

}


###########################################################################
# &B_replace_line ($filename,$pattern,$line_to_switch_in) modifies $filename,
# replacing any lines matching $pattern with $line_to_switch_in.
#
# It returns the number of lines it replaced (or would have replaced, if
# LOGONLY mode wasn't on...)
#
# B_replace_line uses B_open_plus and B_close_plus, so that the file
# modified is backed up...
#
# Here an example of where you might use this:
#
# You'd like to replace any Options lines in Apache's config file with:
#            Options Indexes FollowSymLinks
#
###########################################################################

sub B_replace_line($$$) {
   
    my ($filename,$pattern,$line_to_switch_in) = @_;
    my $retval=0;

    if ( &B_open_plus (*REPLACE_NEW,*REPLACE_OLD,$filename) ) {
	while (my $line=<REPLACE_OLD>) {
	    unless ($line =~ $pattern) {    
		&B_print(*REPLACE_NEW,$line);
	    }
	    else {
		# Don't replace the line if it's already there.
		unless ($line eq $line_to_switch_in) {
		    &B_print(*REPLACE_NEW,$line_to_switch_in);
		
		    $retval++;
		    &B_log("ACTION","File modification in $filename -- replaced line\n" . 
			   "$line\n" . 
			   "with:\n" . 
			   "$line_to_switch_in");
		}
                # But if it is there, make sure it stays there! (by Paul Allen)
		else {
		    &B_print(*REPLACE_NEW,$line);
                }    
	    }
	}
	&B_close_plus (*REPLACE_NEW,*REPLACE_OLD,$filename);
    }
    else {
	$retval=0;
	&B_log("ERROR","Couldn't replace line(s) in $filename because open failed.\n");
    }

    return $retval;
}

################################################################################################
# &B_replace_pattern ($filename,$pattern,$pattern_to_remove,$text_to_switch_in)
# modifies $filename, acting on only lines that match $pattern, replacing a 
# string that matches $pattern_to_remove with $text_to_switch_in.
#
# Ex:
#  B_replace_pattern('/etc/httpd.conf','^\s*Options.*\bIncludes\b','Includes','IncludesNoExec')
#
#   replaces all "Includes" with "IncludesNoExec" on Apache Options lines.
#
# It returns the number of lines it altered (or would have replaced, if
# LOGONLY mode wasn't on...)
#
# B_replace_pattern uses B_open_plus and B_close_plus, so that the file
# modified is backed up...
#
#################################################################################################

sub B_replace_pattern($$$$) {
   
    my ($filename,$pattern,$pattern_to_remove,$text_to_switch_in) = @_;
    my $retval=0;

    if ( &B_open_plus (*REPLACE_NEW,*REPLACE_OLD,$filename) ) {
	while (my $line=<REPLACE_OLD>) {
	    unless ($line =~ $pattern) {    
		&B_print(*REPLACE_NEW,$line);
	    }
	    else {
		my $orig_line =$line;
		$line =~ s/$pattern_to_remove/$text_to_switch_in/;

		&B_print(*REPLACE_NEW,$line);

		$retval++;
		&B_log("ACTION","File modification in $filename -- replaced line\n" . 
		       "$orig_line\n" . 
		       "via pattern with:\n" . 
		       "$line\n\n");
	    }
	}
	&B_close_plus (*REPLACE_NEW,*REPLACE_OLD,$filename);
    }
    else {
	$retval=0;
	&B_log("ERROR","Couldn't pattern-replace line(s) in $filename because open failed.\n");
    }

    return $retval;
}

###########################################################################
# &B_hash_comment_line ($filename,$pattern) modifies $filename, replacing 
# any lines matching $pattern with a "hash-commented" version, like this:
#
#
#        finger  stream  tcp     nowait  nobody  /usr/sbin/tcpd  in.fingerd
# becomes:
#        #finger  stream  tcp     nowait  nobody  /usr/sbin/tcpd  in.fingerd
#
# Also:
#       tftp        dgram  udp wait   root /usr/lbin/tftpd    tftpd\
#        /opt/ignite\
#        /var/opt/ignite
# becomes:
#       #tftp        dgram  udp wait   root /usr/lbin/tftpd    tftpd\
#       # /opt/ignite\
#       # /var/opt/ignite
#
#
# B_hash_comment_line uses B_open_plus and B_close_plus, so that the file
# modified is backed up...
#
###########################################################################

sub B_hash_comment_line($$) {
   
    my ($filename,$pattern) = @_;
    my $retval=1;

    if ( &B_open_plus (*HASH_NEW,*HASH_OLD,$filename) ) {
	while (my $line=<HASH_OLD>) {
	    unless ( ($line =~ $pattern) and ($line !~ /^\s*\#/) ) {    
		&B_print(*HASH_NEW,$line);
	    }
	    else {
		&B_print(*HASH_NEW,"#$line");
		&B_log("ACTION","File modification in $filename -- hash commented line\n" . 
		       "$line\n" . 
		       "like this:\n" . 
		       "#$line\n\n");
		# while the line has a trailing \ then we should also comment out the line below
		while($line =~ m/\\\n$/) {
		    if($line=<HASH_OLD>) {
			&B_print(*HASH_NEW,"#$line");
			&B_log("ACTION","File modification in $filename -- hash commented line\n" . 
			       "$line\n" . 
			       "like this:\n" . 
			       "#$line\n\n");
		    }
		    else {
			$line = "";
		    }
		}
			
	    }
	}
	&B_close_plus (*HASH_NEW,*HASH_OLD,$filename);
    }
    else {
	$retval=0;
	&B_log("ERROR","Couldn't hash-comment line(s) in $filename because open failed.\n");
    }

    return $retval;
}


###########################################################################
# &B_hash_uncomment_line ($filename,$pattern) modifies $filename, 
# removing any commenting from lines that match $pattern.
#
#        #finger  stream  tcp     nowait  nobody  /usr/sbin/tcpd  in.fingerd
# becomes:
#        finger  stream  tcp     nowait  nobody  /usr/sbin/tcpd  in.fingerd
#
#
# B_hash_uncomment_line uses B_open_plus and B_close_plus, so that the file
# modified is backed up...
#
###########################################################################

sub B_hash_uncomment_line($$) {
   
    my ($filename,$pattern) = @_;
    my $retval=1;

    if ( &B_open_plus (*HASH_NEW,*HASH_OLD,$filename) ) {
	while (my $line=<HASH_OLD>) {
	    unless ( ($line =~ $pattern) and ($line =~ /^\s*\#/) ) {    
		&B_print(*HASH_NEW,$line);
	    }
	    else {
		$line =~ /^\s*\#+(.*)$/;
		$line = "$1\n";

		&B_print(*HASH_NEW,"$line");
		&B_log("ACTION","File modification in $filename -- hash uncommented line\n");
		&B_log("ACTION",$line);
		# while the line has a trailing \ then we should also uncomment out the line below
		while($line =~ m/\\\n$/) {
		    if($line=<HASH_OLD>) {
			$line =~ /^\s*\#+(.*)$/;
			$line = "$1\n";
			&B_print(*HASH_NEW,"$line");
			&B_log("ACTION","File modification in $filename -- hash uncommented line\n");
			&B_log("ACTION","#$line");
			&B_log("ACTION","like this:\n");
			&B_log("ACTION","$line");
		    }
		    else {
			$line = "";
		    }
		}
	    }
	}
	&B_close_plus (*HASH_NEW,*HASH_OLD,$filename);
    }
    else {
	$retval=0;
	&B_log("ERROR","Couldn't hash-uncomment line(s) in $filename because open failed.\n");
    }

    return $retval;
}



###########################################################################
# &B_delete_line ($filename,$pattern) modifies $filename, deleting any 
# lines matching $pattern.  It uses B_replace_line to do this.
#
# B_replace_line uses B_open_plus and B_close_plus, so that the file
# modified is backed up...
#
# Here an example of where you might use this:
#
# You'd like to remove any timeout=  lines in /etc/lilo.conf, so that your
# delay=1 modification will work.

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


sub B_delete_line($$) {

    my ($filename,$pattern)=@_;
    my $retval=&B_replace_line($filename,$pattern,"");

    return $retval;
}


###########################################################################
# &B_chunk_replace ($file,$pattern,$replacement) reads $file replacing the
# first occurrence of $pattern with $replacement.
# 
###########################################################################

sub B_chunk_replace($$$) {

    my ($file,$pattern,$replacement) = @_;

    my @lines;
    my $big_long_line;
    my $retval=1;

    &B_open (*OLDFILE,$file);

    # Read all lines into one scalar.
    @lines = <OLDFILE>;
    &B_close (*OLDFILE);
    foreach my $line ( @lines ) {
	$big_long_line .= $line;
    }

    # Substitution routines get weird unless last line is terminated with \n
    chomp $big_long_line;
    $big_long_line .= "\n";

    # Exit if we don't find a match
    unless ($big_long_line =~ $pattern) {
	return 0;
    }
    
    $big_long_line =~ s/$pattern/$replacement/s;

    $retval=&B_open_plus (*NEWFILE,*OLDFILE,$file);
    if ($retval) {
	&B_print (*NEWFILE,$big_long_line);
	&B_close_plus (*NEWFILE,*OLDFILE,$file);
    }

    return $retval;
}


###########################################################################
#
# &B_delete_file ($file)  deletes the file $file and makes a backup to
# the backup directory.
#
##########################################################################


sub B_delete_file($) {

    #
    # This API routine deletes the named file, backing it up first to the
    # backup directory.
    # 

    my $filename=shift @_;
    my $retval=1;

    # We have to append the prefix ourselves since we don't use B_open_plus

    my $original_filename=$filename;

    &B_log("ACTION","Deleting (and backing-up) file $original_filename\n");
    &B_log("ACTION","rm $original_filename\n");

    unless ($filename) {
	&B_log("ERROR","B_delete_file called with no arguments!\n");
    }
    
    unless ($GLOBAL_LOGONLY) {
	if ( B_backup_file($original_filename) ) {
	    unless ( unlink $filename ) {
		&B_log("ERROR","Couldn't unlink file $original_filename");
		$retval=0;
	    }
	}
	else {
	    $retval=0;
	    &B_log("ERROR","B_delete_file did not delete $original_filename since it could not back it up\n");
	}
    }

    $retval;

}


###########################################################################
# &B_create_file ($file) creates the file $file, if it doesn't already
# exist.
# It will set a default mode of 0700 and a default uid/gid or 0/0.
#
# &B_create_file, to support Bastille's revert functionality, writes an
# rm $file command to the end of the file &getGlobal('BFILE', "created-files").
#
##########################################################################


sub B_create_file($) {

    my $file = $_[0];
    my $retval=1;

    # We have to create the file ourselves since we don't use B_open_plus

    my $original_file = $file;

    unless ( -e $file ) {

	unless ($GLOBAL_LOGONLY) {

	    # find the directory in which the file is to reside.
	    my $dirName = dirname($file);
	    # if the directory does not exist then
	    if(! -d $dirName) {
		# create it.
		mkpath ($dirName,0,0700);
	    }

	    $retval=open CREATE_FILE,">$file";
	    
	    if ($retval) {
		close CREATE_FILE;
		chmod 0700,$file;
		# Make the revert functionality
		&B_revert_log( &getGlobal('BIN','rm') . " $original_file \n");
	    } else {
		&B_log("ERROR","Couldn't create file $original_file even though " . 
			  "it didn't already exist!\n");
	    }   
	}
	&B_log("ACTION","Created file $original_file\n");
    } else {
	&B_log("DEBUG","Didn't create file $original_file since it already existed.\n");
	$retval=0;
    }

    $retval;
}

	    
###########################################################################
# &B_create_dir ($dir) creates the directory $dir, if it doesn't already
# exist.
# It will set a default mode of 0700 and a default uid/gid or 0/0.
#
##########################################################################


sub B_create_dir($) {

    my $dir = $_[0];
    my $retval=1;

    # We have to append the prefix ourselves since we don't use B_open_plus

    my $original_dir=$dir;

    unless ( -d $dir ) {
	unless ($GLOBAL_LOGONLY) {
	    $retval=mkdir $dir,0700;
	    
	    if ($retval) {
		# Make the revert functionality
		&B_revert_log (&getGlobal('BIN','rmdir') . " $original_dir\n");
	    }
	    else {
		&B_log("ERROR","Couldn't create dir $original_dir even though it didn't already exist!");
	    }
	    
	}
	&B_log("ACTION","Created directory $original_dir\n");
    }
    else {
	&B_log("ACTION","Didn't create directory $original_dir since it already existed.\n");
	$retval=0;
    }

    $retval;
}
		

###########################################################################
# &B_print ($handle,@list) prints the items of @list to the file handle
# $handle.  It logs the action and respects the $GLOBAL_LOGONLY variable.
#
###########################################################################

sub B_print {
   my $handle=shift @_;

   my $result=1;

   unless ($GLOBAL_LOGONLY) {
       $result=print $handle @_;
   }

   ($handle) = "$handle" =~ /[^:]+::[^:]+::([^:]+)/;

   $result;
}


###########################################################################
# &B_remove_suid ($file) removes the suid bit from $file if it
# is set and the file exist. If you would like to remove the suid bit
# from /bin/ping then you need to use:
# 
#                 &B_remove_suid("/bin/ping");
#
# &B_remove_suid respects GLOBAL_LOGONLY.
# &B_remove_suid uses &B_chmod to make the permission changes
# &B_remove_suid allows for globbing.  tyler_e
#
###########################################################################

sub B_remove_suid($) {
   my $file_expr = $_[0];

   &B_log("ACTION","Removing SUID bit from \"$file_expr\".");
   unless ($GLOBAL_LOGONLY) {
       my @files = glob($file_expr);

     foreach my $file (@files) {
# check file existence
	 if(-e $file){
# stat current file to get raw permissions
	    my $old_perm_raw = (stat $file)[2];
	    # test to see if suidbit is set
	    my $suid_bit = (($old_perm_raw/2048) % 2);
	    if($suid_bit == 1){
		# new permission without the suid bit
		my $new_perm = ((($old_perm_raw/512) % 8 ) - 4) . 
		    (($old_perm_raw/64) % 8 ) . 
			(($old_perm_raw/8) % 8 ) . 
			    (($old_perm_raw) % 8 );
		if(&B_chmod(oct($new_perm), $file)){
		    &B_log("ACTION","Removed SUID bit from \"$file\".");
		}
		else {
		    &B_log("ERROR","Could not remove SUID bit from \"$file\".");
		}
	    } # No action if SUID bit is not set
	}# No action if file does not exist
      }# Repeat for each file in the file glob
    } # unless Global_log
}
    

###########################################################################
# &B_chmod_if_exists ($mode, $file) sets the mode of $file to $mode *if*
# $file exists.  $mode must be stored in octal, so if you want to give 
# mode 700 to /etc/aliases, you need to use:
#
#                 &B_chmod_if_exists ( 0700 , "/etc/aliases");
#
# where the 0700 denotes "octal 7-0-0".
#
# &B_chmod_if_exists respects GLOBAL_LOGONLY and uses 
# &B_revert_log to reset the permissions of the file.
#
# B_chmod_if_exists allow for globbing now, as of 1.2.0.  JJB
#
##########################################################################


sub B_chmod_if_exists($$) {
   my ($new_perm,$file_expr)=@_;
   # If $file_expr has a glob character, pass it on (B_chmod won't complain
   # about nonexistent files if given a glob pattern)
   if ( $file_expr =~ /[\*\[\{]/ ) {   # } just to match open brace for vi
       &B_log("ACTION","Running chmod $new_perm $file_expr"); 
       return(&B_chmod($new_perm,$file_expr));
   }
   # otherwise, test for file existence
   if ( -e $file_expr ) { 
       &B_log("ACTION","File exists, running chmod $new_perm $file_expr"); 
       return(&B_chmod($new_perm,$file_expr)); 
   }
}


###########################################################################
# &B_chmod ($mode, $file) sets the mode of $file to $mode.  $mode must
# be stored in octal, so if you want to give mode 700 to /etc/aliases,
# you need to use:
#
#                 &B_chmod ( 0700 , "/etc/aliases");
#
# where the 0700 denotes "octal 7-0-0".
#
# &B_chmod ($mode_changes,$file) also respects the symbolic methods of 
# changing file permissions, which are often what question authors are
# really seeking.  
#
#                 &B_chmod ("u-s" , "/bin/mount")
# or
#                 &B_chmod ("go-rwx", "/bin/mount")
#
#
# &B_chmod respects GLOBAL_LOGONLY and uses 
# &B_revert_log used to insert a shell command that will return
#         the permissions to the pre-Bastille state.
#
# B_chmod allow for globbing now, as of 1.2.0.  JJB
#
##########################################################################


sub B_chmod($$) {
   my ($new_perm,$file_expr)=@_;
   my $old_perm;
   my $old_perm_raw;
   my $new_perm_formatted;
   my $old_perm_formatted;

   my $retval=1;

   my $symbolic = 0;
   my ($chmod_noun,$add_remove,$capability) = ();
   # Handle symbolic possibilities too
   if ($new_perm =~ /([ugo]+)([+-]{1})([rwxst]+)/) {
       $symbolic = 1;
       $chmod_noun = $1;
       $add_remove = $2;
       $capability = $3;
   }

   my $file;
   my @files = glob ($file_expr);

   foreach $file (@files) {

       # Prepend global prefix, but save the original filename for B_backup_file
       my $original_file=$file;
       
       # Store the old permissions so that we can log them.
       unless (stat $file) {
	   &B_log("ERROR","Couldn't stat $original_file from $old_perm to change permissions\n");
	   next;
       }
       
       $old_perm_raw=(stat(_))[2];
       $old_perm= (($old_perm_raw/512) % 8) . 
	   (($old_perm_raw/64) % 8) .
	       (($old_perm_raw/8) % 8) . 
		   ($old_perm_raw % 8);

       # If we've gone symbolic, calculate the new permissions in octal.
       if ($symbolic) {
	   #
	   # We calculate the new permissions by applying a bitmask to
	   # the current permissions, by OR-ing (for +) or XOR-ing (for -).
	   #
	   # We create this mask by first calculating a perm_mask that forms
	   # the right side of this, then multiplying it by 8 raised to the
	   # appropriate power to affect the correct digit of the octal mask.
	   # This means that we raise 8 to the power of 0,1,2, or 3, based on 
	   # the noun of "other","group","user", or "suid/sgid/sticky".
	   #
	   # Actually, we handle multiple nouns by summing powers of 8.
	   #
	   # The only tough part is that we have to handle suid/sgid/sticky
	   # differently.
	   #

	   # We're going to calculate a mask to OR or XOR with the current
	   # file mode.  This mask is $mask.  We calculate this by calculating
	   # a sum of powers of 8, corresponding to user/group/other, 
	   # multiplied with a $premask.  The $premask is simply the 
	   # corresponding bitwise expression of the rwx bits.
	   #
	   # To handle SUID, SGID or sticky in the simplest way possible, we 
	   # simply add their values to the $mask first.

	   my $perm_mask = 00;
	   my $mask = 00;

	   # Check for SUID, SGID or sticky as these are exceptional.
	   if ($capability =~ /s/) {
	       if ($chmod_noun =~ /u/) {
		   $mask += 04000;
	       }
	       if ($chmod_noun =~ /g/) {
		   $mask += 02000;
	       }
	   }
	   if ($capability =~ /t/) {
	       $mask += 01000;
	   }

	   # Now handle the normal attributes
	   if ($capability =~ /[rwx]/) {
	       if ($capability =~ /r/) {
		   $perm_mask |= 04;
	       }
	       if ($capability =~ /w/) {
		   $perm_mask |= 02;
	       }
	       if ($capability =~ /x/) {
		   $perm_mask |= 01;
	       }

	       # Now figure out which 3 bit octal digit we're affecting.
	       my $power = 0;
	       if ($chmod_noun =~ /u/) {
		   $mask += $perm_mask * 64;
	       }
	       if ($chmod_noun =~ /g/) {
		   $mask += $perm_mask * 8;
	       }
	       if ($chmod_noun =~ /o/) {
		   $mask += $perm_mask * 1;
	       }
	   }
	   # Now apply the mask to get the new permissions
	   if ($add_remove eq '+') {
	       $new_perm = $old_perm_raw | $mask;
	   }
	   elsif ($add_remove eq '-') {
	       $new_perm = $old_perm_raw & ( ~($mask) );
	   }
       }

       # formating for simple long octal output of the permissions in string form
       $new_perm_formatted=sprintf "%5lo",$new_perm;
       $old_perm_formatted=sprintf "%5lo",$old_perm_raw;

       &B_log("ACTION","change permissions on $original_file from $old_perm_formatted to $new_perm_formatted\n");
       
       &B_log("ACTION", "chmod $new_perm_formatted,\"$original_file\";\n");
       
       # Change the permissions on the file
       
       if ( -e $file ) {
	   unless ($GLOBAL_LOGONLY) {
	       $retval=chmod $new_perm,$file;
	       if($retval){
		   # if the distribution is HP-UX then the modifications should
		   # also be made to the IPD (installed product database)
		   if(&GetDistro =~ "^HP-UX"){
		       &B_swmodify($file);
		   }
		   # making changes revert-able
		   &B_revert_log(&getGlobal('BIN', "chmod") . " $old_perm $file\n");
	       }
	   }
	   unless ($retval) {
	       &B_log("ERROR","Couldn't change permissions on $original_file from $old_perm_formatted to $new_perm_formatted\n");
	       $retval=0;
	   }				       
       }
       else {
	   &B_log("ERROR", "chmod: File $original_file doesn't exist!\n");	 
	   $retval=0;
       }
   }

   $retval;

}


###########################################################################
# &B_chown ($uid, $file) sets the owner of $file to $uid, like this:
#
#                 &B_chown ( 0 , "/etc/aliases");
#
# &B_chown respects $GLOBAL_LOGONLY  and uses 
# &B_revert_log to insert a shell command that will return
#         the file/directory owner to the pre-Bastille state.
#
# Unlike Perl, we've broken the chown function into B_chown/B_chgrp to
# make error checking simpler.
#
# As of 1.2.0, this now supports file globbing. JJB
#
##########################################################################


sub B_chown($$) {
   my ($newown,$file_expr)=@_;
   my $oldown;
   my $oldgown;

   my $retval=1;
   
   my $file;
   my @files = glob($file_expr);

   foreach $file (@files) {

       # Prepend prefix, but save original filename 
       my $original_file=$file;
       
       $oldown=(stat $file)[4];
       $oldgown=(stat $file)[5];
       
       &B_log("ACTION","change ownership on $original_file from $oldown to $newown\n");
       &B_log("ACTION","chown $newown,$oldgown,\"$original_file\";\n");
       if ( -e $file ) {
	   unless ($GLOBAL_LOGONLY) {
	       # changing the files owner using perl chown function
	       $retval = chown $newown,$oldgown,$file;
	       if($retval){
		   # if the distribution is HP-UX then the modifications should
		   # also be made to the IPD (installed product database)
		   if(&GetDistro =~ "^HP-UX"){
		       &B_swmodify($file);
		   }
		   # making ownership change revert-able
		   &B_revert_log(&getGlobal('BIN', "chown") . " $oldown $file\n");
	       }	       
	   }
	   unless ($retval) {
	       &B_log("ERROR","Couldn't change ownership to $newown on file $original_file\n");
  	   }
       }
       else {
	   &B_log("ERROR","chown: File $original_file doesn't exist!\n");
	   $retval=0;
       }
   }
   
   $retval;
}




###########################################################################
# &B_chgrp ($gid, $file) sets the group owner of $file to $gid, like this:
#
#                 &B_chgrp ( 0 , "/etc/aliases");
#
# &B_chgrp respects $GLOBAL_LOGONLY  and uses 
# &B_revert_log to insert a shell command that will return
#         the file/directory group to the pre-Bastille state.
#
# Unlike Perl, we've broken the chown function into B_chown/B_chgrp to
# make error checking simpler.
#
# As of 1.2.0, this now supports file globbing.  JJB
#
##########################################################################


sub B_chgrp($$) {
   my ($newgown,$file_expr)=@_;
   my $oldown;
   my $oldgown;

   my $retval=1;

   my $file;
   my @files = glob($file_expr);
   
   foreach $file (@files) {
   
       # Prepend global prefix, but save original filename for &B_backup_file
       my $original_file=$file;
       
       $oldown=(stat $file)[4];
       $oldgown=(stat $file)[5];
       
       &B_log("ACTION", "Change group ownership on $original_file from $oldgown to $newgown\n");
       &B_log("ACTION", "chown $oldown,$newgown,\"$original_file\";\n");
       if ( -e $file ) {
	   unless ($GLOBAL_LOGONLY) {
	       # changing the group for the file/directory
	       $retval = chown $oldown,$newgown,$file;
	       if($retval){
		   # if the distribution is HP-UX then the modifications should
		   # also be made to the IPD (installed product database)
		   if(&GetDistro =~ "^HP-UX"){
		       &B_swmodify($file);
		   }
		   &B_revert_log(&getGlobal('BIN', "chgrp") . " $oldgown $file\n");
	       }	       
	   }
	   unless ($retval) {
	       &B_log("ERROR","Couldn't change ownership to $newgown on file $original_file\n");	    
	   }
       }
       else {
	   &B_log("ERROR","chgrp: File $original_file doesn't exist!\n");
	   $retval=0;
       }
   }

   $retval;
}


###########################################################################
# &B_symlink ($original_file,$new_symlink) creates a symbolic link from
# $original_file to $new_symlink.
#
# &B_symlink respects $GLOBAL_LOGONLY.  It supports
# the revert functionality that you've come to know and love by adding every
# symbolic link it creates to &getGlobal('BFILE', "created-symlinks"), currently set to:
#
#         /root/Bastille/revert/revert-created-symlinks
#
# The revert script, if it works like I think it should, will run this file,
# which should be a script or rm's...
#
##########################################################################

sub B_symlink($$) {
    my ($source_file,$new_symlink)=@_;
    my $retval=1;
    my $original_source = $source_file;
    my $original_symlink = $new_symlink;
    
    unless ($GLOBAL_LOGONLY) {
	$retval=symlink $source_file,$new_symlink;
	if ($retval) {
	    &B_revert_log (&getGlobal('BIN',"rm") .  " $original_symlink\n");
	}
    }

    &B_log("ACTION", "Created a symbolic link called $original_symlink from $original_source\n");
    &B_log("ACTION", "symlink \"$original_source\",\"$original_symlink\";\n");
    unless ($retval) { 
	&B_log("ERROR","Couldn't symlink $original_symlink -> $original_source\n");
    }

    $retval;

}

###########################################################################
# &B_chkconfig_on ($daemon_name) creates the symbolic links that are
# named in the "# chkconfig: ___ _ _ " portion of the init.d files.  We
# need this utility, in place of the distro's chkconfig, because of both
# our need to add revert functionality and our need to harden distros that
# are not mounted on /.
#
# It uses the following global variables to find the links and the init
# scripts, respectively:
#
#   &getGlobal('DIR', "rcd")    -- directory where the rc_.d subdirs can be found
#   &getGlobal('DIR', "initd")  -- directory the rc_.d directories link to
#
# Here an example of where you might use this:
#
# You'd like to tell the system to run the firewall at boot:
#       B_chkconfig_on("bastille-firewall")
#
###########################################################################

# PW: Blech. Copied B_chkconfig_off() and changed a few things,
#		then changed a few more things....

sub B_chkconfig_on {

    my $startup_script=$_[0];
    my $retval=1;

    my $chkconfig_line;
    my ($runlevelinfo,@runlevels);
    my ($start_order,$stop_order,$filetolink);

    &B_log("ACTION","# chkconfig_on enabling $startup_script\n");
    
    # In Debian system there is no chkconfig script, run levels are checked
    # one by one (jfs)
    if (&GetDistro =~/^DB.*/) {
	    $filetolink = &getGlobal('DIR', "initd") . "/$startup_script";
	    if (-x $filetolink)
	    {
		    foreach my $level ("0","1","2","3","4","5","6" ) {
			    my $link = '';
			    $link = &getGlobal('DIR', "rcd") . "/rc" . "$level" . ".d/K50" . "$startup_script";
			    $retval=symlink($filetolink,$link);
		    }
	    }
	    return $retval;
    }
    #
    # On SUSE, chkconfig-based rc scripts have been replaced with a whole different
    # system.  chkconfig on SUSE is actually a shell script that does some stuff and then
    # calls insserv, their replacement.
    #

    if (&GetDistro =~ /^SE/) {
	if (system("chkconfig $startup_script on") == 0) {
	    return 1;
	}
	else {
	    return 0;
	}
	
    }

    #
    # Run through the init script looking for the chkconfig line...
    #
    $retval = open CHKCONFIG,&getGlobal('DIR', "initd") . "/$startup_script";
    unless ($retval) {
	&B_log("ACTION","# Didn't chkconfig_on $startup_script because we couldn't open " . &getGlobal('DIR', "initd") . "/$startup_script\n");
    }
    else {

      READ_LOOP:
	while (my $line=<CHKCONFIG>) {

	    # We're looking for lines like this one:
	    #      # chkconfig: 2345 10 90
	    # OR this
	    #      # chkconfig: - 10 90
	    
	    if ($line =~ /^#\s*chkconfig:\s*([-\d]+)\s*(\d+)\s*(\d+)/ ) {
		$runlevelinfo = $1;
		$start_order = $2;
		$stop_order = $3;
		# handle a run levels arg of '-'
		if ( $runlevelinfo eq '-' ) {
		    &B_log("ACTION","chkconfig_on saw '-' for run levels for \"$startup_script\", is defaulting to levels 3,4,5\n");
		    $runlevelinfo = '345';
		}
		@runlevels = split(//,$runlevelinfo);
		# make sure the orders have 2 digits
		$start_order =~ s/^(\d)$/0$1/;
		$stop_order =~ s/^(\d)$/0$1/;
		last READ_LOOP;
	    }
	}
	close CHKCONFIG;

	# Do we have what we need?
	if ( (scalar(@runlevels) < 1) || (! $start_order =~ /^\d{2}$/) || (! $stop_order =~ /^\d{2}$/) ) {
		# problem
		&B_log("ERROR","# B_chkconfig_on $startup_script failed -- no valid run level/start/stop info found\n");
		return(-1);
	}

	# Now, run through creating symlinks...
	&B_log("ACTION","# chkconfig_on will use run levels ".join(",",@runlevels)." for \"$startup_script\" with S order $start_order and K order $stop_order\n");
	
	$retval=0;
	# BUG: we really ought to readdir() on &getGlobal('DIR', "rcd") to get all levels
	foreach my $level ( "0","1","2","3","4","5","6" ) {
		my $link = '';
		# we make K links in run levels not specified in the chkconfig line
	    	$link = &getGlobal('DIR', "rcd") . "/rc" . $level . ".d/K$stop_order" . $startup_script;
		my $klink = $link;
		# now we see if this is a specified run level; if so, make an S link
		foreach my $markedlevel ( @runlevels ) {
			if ( $level == $markedlevel) {
	    			$link = &getGlobal('DIR', "rcd") . "/rc" . $level . ".d/S$start_order" . $startup_script;
			}
		}
	    	my $target = &getGlobal('DIR', "initd") ."/" . $startup_script;
	    	my $local_return;

		if ( (-e "$klink") && ($klink ne $link) ) {
		    # there's a K link, but this level needs an S link
		    unless ($GLOBAL_LOGONLY) {
			$local_return = unlink("$klink");
			if ( ! local_return ) {
			    # unlinking old, bad $klink failed
			    &B_log("ERROR","Unlinking $klink failed\n");
			} else {
			    &B_log("ACTION","Removed link $klink\n");
			    # If we removed the link, add a link command to the revert file
			    &B_revert_log (&getGlobal('BIN','ln') . " -s $target $klink\n");
			} # close what to do if unlink works	
		    }	# if not GLOBAL_LOGONLY
		}	# if $klink exists and ne $link
	   	
		# OK, we've disposed of any old K links, make what we need 
	    	if ( (! ( -e "$link" )) && ($link ne '') ) {
		    # link doesn't exist and the start/stop number is OK; make it
		    unless ($GLOBAL_LOGONLY) {
			# create the link
			$local_return = &B_symlink($target,$link);
			if ($local_return) {
			    $retval++;
			    &B_log("ACTION","Created link $link\n");
			} else {
			    &B_log("ERROR","Couldn't create $link when trying to chkconfig on $startup_script\n");
			}
		    }
		    
		} # link doesn't exist
	    } # foreach level
	
    }

    if ($retval < @runlevels) {
	$retval=0;
    }
    
    $retval;

}


###########################################################################
# &B_chkconfig_off ($daemon_name) deletes the symbolic links that are
# named in the "# chkconfig: ___ _ _ " portion of the init.d files.  We
# need this utility, in place of the distro's chkconfig, because of both
# our need to add revert functionality and our need to harden distros that
# are not mounted on /.
#
# chkconfig allows for a REVERT of its work by writing to an executable
# file &getGlobal('BFILE', "removed-symlinks").
#
# It uses the following global variables to find the links and the init
# scripts, respectively:
#
#   &getGlobal('DIR', "rcd")    -- directory where the rc_.d subdirs can be found
#   &getGlobal('DIR', "initd")  -- directory the rc_.d directories link to
#
# Here an example of where you might use this:
#
# You'd like to tell stop running sendmail in daemon mode on boot:
#       B_chkconfig_off("sendmail")
#
###########################################################################



sub B_chkconfig_off {

    my $startup_script=$_[0];
    my $retval=1;

    my $chkconfig_line;
    my @runlevels;
    my ($start_order,$stop_order,$filetolink);

    if (&GetDistro =~/^DB.*/) {
	    $filetolink = &getGlobal('DIR', "initd") . "/$startup_script";
	    if (-x $filetolink)
	    {
		    # Three ways to do this in Debian:
		    # 1.- have the initd script set to 600 mode
		    # 2.- Remove the links in rcd (re-installing the package
		    # will break it)
		    # 3.- Use update-rc.d --remove (same as 2.)
		    # (jfs) 
		    &B_chmod(0600,$filetolink);
		    $retval=6;
		    
		    # The second option
		    #foreach my $level ("0","1","2","3","4","5","6" ) {
		    #my $link = '';
		    #$link = &getGlobal('DIR', "rcd") . "/rc" . "$level" . ".d/K50" . "$startup_script"; 
		    #unlink($link);
		    #}
	    }
    }

    #
    # On SUSE, chkconfig-based rc scripts have been replaced with a whole different
    # system.  chkconfig on SUSE is actually a shell script that does some stuff and then
    # calls insserv, their replacement.
    #
    elsif (&GetDistro =~ /^SE/) {
        if (system("chkconfig $startup_script on") == 0) {
            return 1;
        }
        else {
            return 0;
        }

    }
    else {

	    # Run through the init script looking for the chkconfig line...


	    $retval = open CHKCONFIG,&getGlobal('DIR', "initd") . "/$startup_script";
	    unless ($retval) {
		    &B_log("ACTION","Didn't chkconfig_off $startup_script because we couldn't open " . &getGlobal('DIR', "initd") . "/$startup_script\n");
	    }
	    else {

		    READ_LOOP:
		    while (my $line=<CHKCONFIG>) {

			    # We're looking for lines like this one:
			    #      # chkconfig: 2345 10 90

			    if ($line =~ /^#\s*chkconfig:\s*([-\d]+)\s*(\d+)\s*(\d+)/ ) {
				    @runlevels=split //,$1;
				    $start_order=$2;
				    $stop_order=$3;


				    # Change single digit run levels to double digit -- otherwise,
				    # the alphabetic ordering chkconfig depends on fails.
				    if ($start_order =~ /^\d$/ ) {
					    $start_order = "0" . $start_order;
					    &B_log("ACTION","chkconfig_off converted start order to $start_order\n");
				    }
				    if ($stop_order =~ /^\d$/ ) {
					    $stop_order = "0" . $stop_order;
					    &B_log("ACTION","chkconfig_off converted stop order to $stop_order\n");
				    }

				    last READ_LOOP;
			    }
		    }
		    close CHKCONFIG;

		    # If we never found a chkconfig line, can we just run through all 5 
		    # rcX.d dirs from 1 to 5...?

		    # unless ( $start_order and $stop_order ) {
		    #	 @runlevels=("1","2","3","4","5");
		    #	 $start_order = "*"; $stop_order="*";
		    # }

		    # Now, run through removing symlinks...



		    $retval=0;

		    # Handle the special case that the run level specified is solely "-"
		    if ($runlevels[0] =~ /-/) {
			    @runlevels = ( "0","1","2","3","4","5","6" );
		    }

		    foreach $level ( @runlevels ) {
			    my $link = &getGlobal('DIR', "rcd") . "/rc" . $level . ".d/S$start_order" . $startup_script;
			    my $new_link = &getGlobal('DIR', "rcd") . "/rc" . $level . ".d/K$stop_order" . $startup_script;
			    my $target = &getGlobal('DIR', "initd") ."/" . $startup_script;
			    my $local_return;


			    # Replace the S__ link in this level with a K__ link.
			    if ( -e $link ) {
				    unless ($GLOBAL_LOGONLY) {
					    $local_return=unlink $link;
					    if ($local_return) {
						    $local_return=symlink $target,$new_link;
						    unless ($local_return) {
							    &B_log("ERROR","Linking $target to $new_link failed.\n");
						    }
					    }
					    else {  # unlinking failed
						    &B_log("ERROR","Unlinking $link failed\n");
					    }

				    }
				    if ($local_return) {
					    $retval++;
					    &B_log("ACTION","Removed link $link\n");

					    #
					    # If we removed the link, add a link command to the revert file
					    # Write out the revert information for recreating the S__
					    # symlink and deleting the K__ symlink.
					    &B_revert_log(&getGlobal('BIN',"ln") . " -s $target $link\n");
					    &B_revert_log(&getGlobal('BIN',"rm") . " -f $new_link\n");
				    }
				    else {
					    &B_log("ERROR","B_chkconfig_off $startup_script failed\n");
				    }

			    }
		    } # foreach

	    } # else-unless

    } # else-DB
    if ($retval < @runlevels) {
	    $retval=0;
    }

    $retval;

}


############################################################################
# &B_cp is the Bastille cp command, which is based on Perl's File::cp.
# &B_cp($source,$target).  It is somewhat strange, to make the Backup and
# revert functions easier to implement, in that:
#
#
#     It can ONLY copy from one file to another! Both $source and
#     $target must be files, not directories!!!!
#
# It respects $GLOBAL_LOGONLY. 
# If $target is an already-existing file, it is backed up.
#
# revert either appends another "rm $target" to &getGlobal('BFILE', "revert-actions")  or
# backs up the file that _was_ there into the &getGlobal('BDIR', "backup").
#
############################################################################

sub B_cp($$) {

    my ($source,$target)=@_;
    my $retval=0;

    my $had_to_backup_target=0;

    use File::Copy;

    my $original_source=$source;
    my $original_target=$target;

    if( -e $target and -f $target ) {
	&B_backup_file($original_target);
	&B_log("ACTION","About to copy $original_source to $original_target -- had to backup target\n");
	$had_to_backup_target=1;
    }
    
    $retval=copy($source,$target);
    if ($retval) {
	&B_log("ACTION","cp $original_source $original_target\n");
	
	#
	# We want to add a line to the &getGlobal('BFILE', "created-files") so that the
	# file we just put at $original_target gets deleted.
	#
	&B_revert_log(&getGlobal('BIN',"rm") . " $original_target\n");
    } else {
	&B_log("ERROR","Failed to copy $original_source to $original_target\n");
    }
    
    $retval;
}



############################################################################
# &B_place puts a file in place, using Perl's File::cp.  This file is taken
# from &getGlobal('BDIR', "share") and is used to place a file that came with
# Bastille.  
#
# This should be DEPRECATED in favor of &B_cp, since the only reason it exists
# is because of GLOBAL_PREFIX, which has been broken for quite some time.
# Otherwise, the two routines are identical.
#
# It respects $GLOBAL_LOGONLY.
# If $target is an already-existing file, it is backed up.
#
# revert either appends another "rm $target" to &getGlobal('BFILE', "revert-actions")  or
# backs up the file that _was_ there into the &getGlobal('BDIR', "backup"),
# appending a "mv" to revert-actions to put it back.
#
############################################################################

sub B_place {

    my ($source,$target)=@_;
    my $retval=0;

    my $had_to_backup_target=0;

    use File::Copy;

    my $original_source=$source;
    $source  = &getGlobal('BDIR', "share") . $source;
    my $original_target=$target;

    if ( -e $target and -f $target ) {
	&B_backup_file($original_target);
	&B_log("ACTION","About to copy $original_source to $original_target -- had to backup target\n");
	$had_to_backup_target=1;
    }
    $retval=copy($source,$target);
    if ($retval) {
	&B_log("ACTION","placed file $original_source  as  $original_target\n");   
	#
	# We want to add a line to the &getGlobal('BFILE', "created-files") so that the
	# file we just put at $original_target gets deleted.
	&B_revert_log(&getGlobal('BIN',"rm") . " $original_target\n");
    } else {
	&B_log("ERROR","Failed to place $original_source as $original_target\n");
    }
    

    $retval;
}





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

###########################################################################
# &B_mknod ($file) creates the node $file, if it doesn't already
# exist.  It uses the prefix and suffix, like this:
#
#            mknod $prefix $file $suffix
#
# This is just a wrapper to the mknod program, which tries to introduce
# revert functionality, by writing    rm $file     to the end of the 
# file &getGlobal('BFILE', "created-files").
#
##########################################################################


sub B_mknod($$$) {

    my ($prefix,$file,$suffix) = @_;
    my $retval=1;

    # We have to create the filename ourselves since we don't use B_open_plus

    my $original_file = $file;

    unless ( -e $file ) {
	my $command = &getGlobal("BIN","mknod") . " $prefix $file $suffix";
	
	if ( system($command) == 0) {
	    # Since system will return 0 on success, invert the error code
	    $retval=1;
	}
	else {
	    $retval=0;
	}
	
	if ($retval) {
	    
	    # Make the revert functionality
	    &B_revert_log(&getGlobal('BIN',"rm") . " $original_file\n");
	} else {
	    &B_log("ERROR","Couldn't mknod $prefix $original_file $suffix even though it didn't already exist!\n");
	}
	
    
	&B_log("ACTION","mknod $prefix $original_file $suffix\n");
    }
    else {
	&B_log("ACTION","Didn't mknod $prefix $original_file $suffix since $original_file already existed.\n");
	$retval=0;
    }
    
    $retval;
}

###########################################################################
# &B_revert_log("reverse_command") prepends a command to a shell script.  This 
# shell script is intended to be run by bastille -r to reverse the changes that 
# Bastille made, returning the files which Bastille changed to their original 
# state.
###########################################################################

sub B_revert_log($) {
   
    my $revert_command = $_[0];
    my $revert_actions = &getGlobal('BFILE', "revert-actions");
    my @lines;
    

    if (! (-e $revert_actions)) {
	if (open REVERT_ACTIONS,">" . $revert_actions){ # create revert file
	    close REVERT_ACTIONS; # chown to root, rwx------
	    chmod 0700,$revert_actions;
	    chown 0,0,$revert_actions;
	}
	else { 
	    &B_log("FATAL","Can not create revert-actions file.\n" .
		       "         Unable to add the following command to the revert\n" . 
		       "         actions script:\n"  .
		       "           $revert_command\n");
	    exit(1);
	}
	
    }
	
    &B_open_plus (*REVERT_NEW, *REVERT_OLD, $revert_actions); 

    while (my $line=<REVERT_OLD>) { #copy file into @lines
	push (@lines,$line);
    }
    print REVERT_NEW $revert_command .  "\n";  #make the revert command first in the new file
    while (my $line = shift @lines) { #write the rest of the lines of the file
	print REVERT_NEW $line;
    }
    close REVERT_OLD;
    close REVERT_NEW;
    if (rename "${revert_actions}.bastille", $revert_actions) { #replace the old file with the new file we
	chmod 0700,$revert_actions;                # just made / mirrors B_close_plus logic
	chown 0,0,$revert_actions;
    } else {
	&B_log("ERROR","B_revert_log: not able to move ${revert_actions}.bastille to ${revert_actions}!!! $!) !!!\n");
    }
}


###########################################################################
# &getGlobalConfig($$)
#
# returns the requested GLOBAL_CONFIG hash value, ignoring the error 
# if the value does not exist (because every module uses this to find
# out if the question was answered "Y")
###########################################################################
sub getGlobalConfig ($$) {
  my $module = $_[0];
  my $key = $_[1];
  if (exists $GLOBAL_CONFIG{$module}{$key}) {
    my $answer=$GLOBAL_CONFIG{$module}{$key};
    &B_log("ACTION","Answer to question $module.$key is \"$answer\".\n");
    return $answer;
  } else {
    &B_log("ACTION","Answer to question $module.$key is undefined, do not\n" . 
	       "implement question\n");
    return undef;
  }
}

###########################################################################
# &getGlobal($$)
#
# returns the requested GLOBAL_* hash value, and logs an error 
# if the variable does not exist.
###########################################################################
sub getGlobal ($$) {
  my $type = uc($_[0]);
  my $key = $_[1];

  # define a mapping from the first argument to the proper hash
  my %map = ("BIN"   => \%GLOBAL_BIN,
             "FILE"  => \%GLOBAL_FILE,
             "BFILE" => \%GLOBAL_BFILE,
             "DIR"   => \%GLOBAL_DIR,
             "BDIR"  => \%GLOBAL_BDIR,
	     "ERROR" => \%GLOBAL_ERROR,
	     "SERVICE" => \%GLOBAL_SERVICE,
	     "SERVTYPE" => \%GLOBAL_SERVTYPE,
	     "PROCESS" => \%GLOBAL_PROCESS,
            );

  # check to see if the desired key is in the desired hash
  if (exists $map{$type}->{$key}) {
    # get the value from the right hash with the key
    return $map{$type}->{$key};
  } else {
    # i.e. Bastille tried to use $GLOBAL_BIN{'cp'} but it does not exist.
    &B_log("ERROR","Bastille tried to use \$GLOBAL_${type}\{\'$key\'} but it does not exist.\n");
    return undef;
  }
}


###########################################################################
# &showDisclaimer:
# Print the disclaimer and wait for 2 minutes for acceptance
# Do NOT do so if any of the following conditions hold
# 1. the -n option was used
# 2. the file ~/.bastille_disclaimer exists
###########################################################################

sub showDisclaimer($) {

    my $nodisclaim = $_[0];
    my $nodisclaim_file = &getGlobal('BFILE', "nodisclaimer");
    my $response;
    my $WAIT_TIME = 300; # we'll wait for 5 minutes
    my $developersAnd;
    my $developersOr;
    if ($GLOBAL_OS =~ "^HP-UX") {
	$developersAnd ="HP AND ITS";
	$developersOr ="HP OR ITS";
    }else{
	$developersAnd ="JAY BEALE, THE BASTILLE DEVELOPERS, AND THEIR";
	$developersOr ="JAY BEALE, THE BASTILLE DEVELOPERS, OR THEIR";
    }	
    my $DISCLAIMER =
	"\n" .
        "Copyright (C) 1999-2002 Jay Beale\n" .
        "Copyright (C) 1999-2001 Peter Watkins\n" .
        "Copyright (C) 2000 Paul L. Allen\n" .
        "Copyright (C) 2001-2003 Hewlett-Packard Development Company, L.P.\n" .
        "Bastille is free software; you are welcome to redistribute it under\n" .
        "certain conditions.  See the \'COPYING\' file in your distribution for terms.\n\n" .
	"DISCLAIMER.  Use of Bastille can help optimize system security, but does not\n" .
	"guarantee system security. Information about security obtained through use of\n" .
	"Bastille is provided on an AS-IS basis only and is subject to change without\n" .
	"notice. Customer acknowledges they are responsible for their system\'s security.\n" .
	"TO THE EXTENT ALLOWED BY LOCAL LAW, Bastille (\"SOFTWARE\") IS PROVIDED TO YOU \n" .
	"\"AS IS\" WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, WHETHER ORAL OR WRITTEN,\n" .
	"EXPRESS OR IMPLIED.  $developersAnd SUPPLIERS\n" .
	"DISCLAIM ALL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING WITHOUT LIMITATION THE \n" .
	"IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.\n" . 
	"Some countries, states and provinces do not allow exclusions of implied\n" .
	"warranties or conditions, so the above exclusion may not apply to you. You may\n" .
	"have other rights that vary from country to country, state to state, or province\n" .
	"to province.  EXCEPT TO THE EXTENT PROHIBITED BY LOCAL LAW, IN NO EVENT WILL\n" .
	"$developersOr SUBSIDIARIES, AFFILIATES OR\n" .
	"SUPPLIERS BE LIABLE FOR DIRECT, SPECIAL, INCIDENTAL, CONSEQUENTIAL OR OTHER\n" .
	"DAMAGES (INCLUDING LOST PROFIT, LOST DATA, OR DOWNTIME COSTS), ARISING OUT OF\n" .
	"THE USE, INABILITY TO USE, OR THE RESULTS OF USE OF THE SOFTWARE, WHETHER BASED\n" .
	"IN WARRANTY, CONTRACT, TORT OR OTHER LEGAL THEORY, AND WHETHER OR NOT ADVISED\n" .
	"OF THE POSSIBILITY OF SUCH DAMAGES. Your use of the Software is entirely at your\n" .
	"own risk. Should the Software prove defective, you assume the entire cost of all\n" .
	"service, repair or correction. Some countries, states and provinces do not allow\n" .
	"the exclusion or limitation of liability for incidental or consequential \n" .
	"damages, so the above limitation may not apply to you.\n";
    
# once we prompt the user, we'll wait for $WAIT_TIME seconds for a response
# if no response is received, we exit nicely -- we catch the SIGALRM
    $SIG{'ALRM'} = sub {
	&B_log("ERROR",
		  "\n\nERROR:   Waited for $WAIT_TIME seconds. No response received.\n" .
		  "             Quitting.\n" );
	exit 1;
    };

# If the user has specified not to show the disclaimer, or
# the .bastille_disclaimer file already exists, then return
    if( ( $nodisclaim ) || -e $nodisclaim_file ) { return 1; }

# otherwise, show the disclaimer
    my $echo = &getGlobal('BIN', "echo");
    my $more = &getGlobal('BIN', "more");
    system "$echo \"$DISCLAIMER\" | $more";
    alarm $WAIT_TIME; # start alarm
    print("You must accept the terms of this disclaimer to use\n" .
	  "Bastille.  Type \"accept\" (without quotes) within 5\n" .
	  "minutes to accept the terms of the above disclaimer\n" .  "> " );

    chop( $response = <STDIN> ); # Script blocks on STDIN here
    alarm 0; # turn off alarm immediately after getting line
 
# there is a response
    if( lc( $response ) eq "accept" ) {
	my $touch = &getGlobal('BIN', "touch");
	my $retVal = system("$touch $nodisclaim_file");
	if( $retVal != 0 ) {
	    &ErrorLog ( &getGlobal('ERROR','disclaimer'));
	} # if
	else {
	    print("This disclaimer will not appear again on this machine.\n" .
		  "To suppress the disclaimer on other machines, use Bastille\'s\n" .
		  "-n flag (example: bastille -n).\n");
	} # else
    } # outer if
    else { # something besides "accept" was typed
	print("You must accept the terms of the disclaimer before using\n" .
	      "Bastille.  Exiting.\n" );
	exit 0;
    } # else
} # showDisclaimer


###########################################################################
# B_userdel($user) removes $user from the system, chmoding her home
# directory to 000, root:root owned, and removes the user from all 
# /etc/passwd, /etc/shadow and /etc/group lines.
# 
# In the future, we may also choose to make a B_lock_account routine.
#
# This routine depends on B_remove_user_from_group.
###########################################################################

sub B_userdel($) {

    my $user_to_remove = $_[0];

    if (&GetDistro =~ /^HP-UX/) {
	return 0;

	# Not yet suported on HP-UX, where we'd need to support
	# the TCB files and such.
    }

    #
    # First, let's chmod/chown/chgrp the user's home directory.
    #

    # Get the user's home directory from /etc/passwd
    if (open PASSWD,&getGlobal('FILE','passwd')) {
	my @lines=<PASSWD>;
	close PASSWD;

	# Get the home directory
	my $user_line = grep '^\s*$user_to_remove\s*:',@lines;
	my $home_directory = (split /\s*:\s*/,$user_line)[5];

	# Chmod that home dir to 0000,owned by uid 0, gid 0.
	if (&B_chmod_if_exists(0000,$home_directory)) {
	    &B_chown(0,$home_directory);
	    &B_chgrp(0,$home_directory);
	}
    }	
    else {
        &B_log('ERROR',"B_userdel couldn't open the passwd file to remove a user.");
	return 0;
    }
	
    #
    # Next find out what groups the user is in, so we can call
    # B_remove_user_from_group($user,$group)
    #
    # TODO: add this to the helper functions for the test suite.
    #

    my @groups = ();

    # Parse /etc/group, looking for our user.
    if (open GROUP,&getGlobal('FILE','group')) {
	my @lines = <GROUP>;
	close GROUP;

	foreach $line (@lines) {

	    # Parse the line -- first field is group, last is users in group.
	    if ($line =~ /([^\#^:]+):[^:]+:[^:]+:(.*)/) {
		my $group = $1;
		my $users_section = $2;

		# Get the user list and check if our user is in it.
		my @users = split /\s*,\s*/,$users_section;
		foreach $user (@users) {
		    if ($user_to_remove eq $user) {
			push @groups,$group;
			last;
		    }
		}
	    }
	}
    }

    # Now remove the user from each of those groups.
    foreach $group (@groups) {
	&B_remove_user_from_group($user_to_remove,$group);
    }

    # Remove the user's /etc/passwd and /etc/shadow lines
    &B_delete_line(&getGlobal('FILE','passwd'),"^$user_to_remove\\s*:");
    &B_delete_line(&getGlobal('FILE','shadow'),"^$user_to_remove\\s*:");


    #
    # We should delete the user's group as well, if it's a single-user group.
    #
    if (open ETCGROUP,&getGlobal('FILE','group')) {
	my @group_lines = <ETCGROUP>;
	close ETCGROUP;
	chomp @group_lines;

        if (grep /^$user_to_remove\s*:[^:]*:[^:]*:\s*$/,@group_lines > 0) {
	   &B_groupdel($user_to_remove);
	}
    }

}

###########################################################################
# B_groupdel($group) removes $group from /etc/group.
###########################################################################

sub B_groupdel($) {

    my $group = $_[0];
 
    # First read /etc/group to make sure the group is in there.
    if (open GROUP,&getGlobal('FILE','group')) {
	my @lines=<GROUP>;
	close GROUP;

	# Delete the line in /etc/group if present
	if (grep /^$group:/,@lines > 0) {
	    # The group is named in /etc/group
	    &B_delete_line(&getGlobal('FILE','group'),"^$group:/");
	}
    }

}


###########################################################################
# B_remove_user_from_group($user,$group) removes $user from $group,
# by modifying $group's /etc/group line, pulling the user out.  This 
# uses B_chunk_replace thrice to replace these patterns:
#
#   ":\s*$user\s*," --> ":"
#   ",\s*$user" -> ""
# 
###########################################################################

sub B_remove_user_from_group($$) {

    my ($user_to_remove,$group) = @_;

    #
    # We need to find the line from /etc/group that defines the group, parse
    # it, and put it back together without this user.
    #

    # Open the group file
    unless (open GROUP,&getGlobal('FILE','group')) {
	&B_log('ERROR',"&B_remove_user_from_group couldn't read /etc/group to remove $user_to_remove from $group.\n");
	return 0;
    }
    my @lines = <GROUP>;
    close GROUP;
    chomp @lines;

    #
    # Read through the lines to find the one we care about.  We'll construct a 
    # replacement and then use B_replace_line to make the switch.
    #

    foreach $line (@lines) {

	if ($line =~ /^\s*$group\s*:/) {

	    # Parse this line.
	    my @group_entries = split ':',$line;
	    my @users = split ',',($group_entries[3]);

	    # Now, recreate it.
	    my $first_user = 1;
	    my $group_line = $group_entries[0] . ':' . $group_entries[1] . ':' . $group_entries[2] . ':';

	    # Add every user except the one we're removing.
	    foreach $user (@users) {

		# Remove whitespace.
		$user =~ s/\s+//g;

		if ($user ne $user_to_remove) {
		    # Add the user to the end of the line, prefacing
		    # it with a comma if it's not the first user.

		    if ($first_user) {
			$group_line .= "$user";
			$first_user = 0;
		    }
		    else {
			$group_line .= ",$user";
		    }
		}
	    }

	    # The line is now finished.  Replace the original line.
	    $group_line .= "\n";
	    &B_replace_line(&getGlobal('FILE','group'),"^\\s*$group\\s*:",$group_line);
	}

    }

    return 1;
}




1;
