mirror of
https://git.yoctoproject.org/meta-security
synced 2026-01-11 15:00:34 +00:00
2529 lines
80 KiB
Perl
2529 lines
80 KiB
Perl
# Copyright (C) 1999-2007 Jay Beale
|
|
# Copyright (C) 2001-2008 Hewlett-Packard Development Company, L.P.
|
|
# Licensed under the GNU General Public License, version 2
|
|
|
|
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.
|
|
#
|
|
# 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_symlink - create a symlink to a file, recording the revert rm
|
|
#
|
|
# More stuff
|
|
#
|
|
# &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_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::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 GetDistro ConfigureForDistro B_log B_revert_log
|
|
SanitizeEnv
|
|
B_open B_close B_symlink StopLogging
|
|
B_open_plus B_close_plus
|
|
B_isFileinSumDB
|
|
B_create_file B_read_sums B_check_sum B_set_sum isSumDifferent listModifiedFiles
|
|
B_create_dir B_create_log_file
|
|
B_delete_file
|
|
B_cp B_place B_mknod
|
|
showDisclaimer
|
|
getSupportedOSHash
|
|
B_Backtick
|
|
B_System
|
|
isProcessRunning
|
|
checkProcsForService
|
|
|
|
|
|
$GLOBAL_OS $GLOBAL_ACTUAL_OS $CLI
|
|
$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 %GLOBAL_RC_CONFIG
|
|
%GLOBAL_TEST
|
|
|
|
getGlobal setGlobal getGlobalConfig
|
|
|
|
|
|
B_parse_fstab
|
|
B_parse_mtab B_is_rpm_up_to_date
|
|
|
|
NOTSECURE_CAN_CHANGE SECURE_CANT_CHANGE
|
|
NOT_INSTALLED INCONSISTENT MANUAL NOTEST SECURE_CAN_CHANGE
|
|
STRING_NOT_DEFINED NOT_INSTALLED_NOTSECURE DONT_KNOW
|
|
RELEVANT_HEADERQ NOTRELEVANT_HEADERQ
|
|
);
|
|
|
|
|
|
|
|
######################################################
|
|
###Testing Functions
|
|
##################################################################
|
|
|
|
#Define "Constants" for test functions. Note these constants sometimes get
|
|
#interpreted as literal strings when used as hash references, so you may
|
|
# have to use CONSTANT() to disambiguate, like below. Sorry, it was either
|
|
# that or create even *more* global variables.
|
|
# See TestDriver.pm for definitions, and test design doc for full explaination
|
|
use constant {
|
|
NOTSECURE_CAN_CHANGE => 0,
|
|
SECURE_CANT_CHANGE => 1,
|
|
NOT_INSTALLED => 2, # (where the lack makes the system secure, eg telnet)
|
|
INCONSISTENT => 3,
|
|
MANUAL => 4,
|
|
NOTEST => 5,
|
|
SECURE_CAN_CHANGE => 6,
|
|
STRING_NOT_DEFINED => 7,
|
|
NOT_INSTALLED_NOTSECURE => 8, #(Where the missing s/w makes the system less secure eg IPFilter)
|
|
#Intentional duplicates follow
|
|
DONT_KNOW => 5,
|
|
RELEVANT_HEADERQ => 6,
|
|
NOTRELEVANT_HEADERQ => 0
|
|
};
|
|
|
|
&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 =" ";
|
|
my $GLOBAL_OS="None";
|
|
my $GLOBAL_ACTUAL_OS="None";
|
|
my %GLOBAL_SUMS=();
|
|
my $CLI='';
|
|
|
|
#OS independent Error Messages Follow, normally "bastille" script filters
|
|
#options before interactive or Bastille runs, so this check is often redundant
|
|
$GLOBAL_ERROR{"usage"}="\n".
|
|
"$spc Usage: bastille [ -b | -c | -x ] [ --os <version> ] [ -f <alternate config> ]\n".
|
|
"$spc bastille [ -r | --assess | --assessnobowser ]\n\n".
|
|
"$spc --assess : check status of system and report in browser\n".
|
|
"$spc --assessnobrowser : check status of system and list report locations\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 -f <alternate config>: populate answers with a different config file\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 six arguments, $GLOBAL_DEBUG, $GLOBAL_LOGONLY,
|
|
# $GLOBAL_VERBOSE, $GLOBAL_AUDITONLY, $GLOBAL_AUDIT_NO_BROWSER, and GLOBAL_OS;
|
|
###########################################################################
|
|
sub setOptions($$$$$$) {
|
|
($GLOBAL_DEBUG,$GLOBAL_LOGONLY,$GLOBAL_VERBOSE,$GLOBAL_AUDITONLY,
|
|
$GLOBAL_AUDIT_NO_BROWSER,$GLOBAL_OS) = @_;
|
|
if ($GLOBAL_AUDIT_NO_BROWSER) {
|
|
$GLOBAL_AUDITONLY = 1;
|
|
}
|
|
if (not(defined($GLOBAL_OS))){
|
|
$GLOBAL_OS="None";
|
|
}
|
|
}
|
|
###########################################################################
|
|
#
|
|
# 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)
|
|
}
|
|
|
|
###########################################################################
|
|
#
|
|
# 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 ($GLOBAL_OS eq "None") {
|
|
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*)/) ) {
|
|
$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";
|
|
}
|
|
elsif ($release =~ /^Fedora release (\d+\.?\d*)/) {
|
|
$distro = "RHFC$1";
|
|
}
|
|
else {
|
|
print STDERR "$err Could not determine Fedora version! Setting to Fedora Core 8\n";
|
|
$distro='RHFC8';
|
|
}
|
|
}
|
|
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.1"; #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*)/i) {
|
|
$distro="SESLES$1";
|
|
}
|
|
elsif ($release =~ /^SUSE Linux Enterprise Server (\d+\.?\d?\w*)/i) {
|
|
$distro="SESLES$1";
|
|
}
|
|
elsif ($release =~ /^openSuSE (\d+\.\d+\w*)/i) {
|
|
$distro="SE$1";
|
|
}
|
|
else {
|
|
print STDERR "$err Couldn't determine SuSE version! Setting to 10.3!\n";
|
|
$distro="SE10.3";
|
|
}
|
|
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.3";
|
|
}
|
|
else {
|
|
$distro = "unknown";
|
|
}
|
|
}
|
|
elsif ( $release =~ /(^HP-UX)\s*B\.(\d+\.\d+)/ ) {
|
|
$distro="$1$2";
|
|
}
|
|
else {
|
|
print STDERR "$err Could not determine operating system version!\n";
|
|
$distro="unknown";
|
|
}
|
|
}
|
|
}
|
|
|
|
$GLOBAL_OS=$distro;
|
|
} elsif (not (defined $GLOBAL_OS)) {
|
|
print "ERROR: GLOBAL OS Scoping Issue\n";
|
|
} else {
|
|
$distro = $GLOBAL_OS;
|
|
}
|
|
|
|
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
|
|
|
|
if ($GLOBAL_ACTUAL_OS eq "None") {
|
|
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 = "None";
|
|
$GLOBAL_ACTUAL_OS = &GetDistro;
|
|
# reset the GLOBAL_OS variable
|
|
$GLOBAL_OS = $os;
|
|
}
|
|
return $GLOBAL_ACTUAL_OS;
|
|
}
|
|
# 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",
|
|
"RHEL5",
|
|
"RHEL4AS","RHEL4ES","RHEL4WS",
|
|
"RHEL3AS","RHEL3ES","RHEL3WS",
|
|
"RHEL2AS","RHEL2ES","RHEL2WS",
|
|
"RHFC1","RHFC2","RHFC3","RHFC4",
|
|
"RHFC5","RHFC6","RHFC7","RHFC8",
|
|
"MN6.0","MN6.1 ","MN7.0","MN7.1",
|
|
"MN7.2","MN8.0","MN8.1","MN8.2",
|
|
"MN10.1",
|
|
"SE7.2","SE7.3", "SE8.0","SE8.1","SE9.0","SE9.1",
|
|
"SE9.2","SE9.3","SE10.0","SE10.1","SE10.2","SE10.3",
|
|
"SESLES8","SESLES9","SESLES10",
|
|
"TB7.0"
|
|
],
|
|
|
|
"HP-UX" => [
|
|
"HP-UX11.00","HP-UX11.11",
|
|
"HP-UX11.22", "HP-UX11.23",
|
|
"HP-UX11.31"
|
|
],
|
|
|
|
"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;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
unless(defined($map{uc("BFILE")}->{"current_config"})) {
|
|
&setGlobal("BFILE","current_config",&getGlobal("BFILE","config"));
|
|
}
|
|
}
|
|
|
|
###############################################################################
|
|
# 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_RC_CONFIG, 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,(rc-config-file rc-config-file ...),(rc-variable1 rc-variable2 ...),('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,$strConfigList,$strServiceList,
|
|
$strProcessList,@distroList) = split /\s*,\s*/, $service;
|
|
|
|
sub MakeArrayFromString($){
|
|
my $entryString = $_[0];
|
|
my @destArray = ();
|
|
if ($entryString =~ /\'\S+\'/) { #Make sure we have something to extract before we try
|
|
@destArray = split /\'\s+\'/, $entryString;
|
|
$destArray[0] =~ s/^\(\'(.+)$/$1/; # Remove leading quotation mark
|
|
$destArray[$#destArray] =~ s/^(.*)\'\)$/$1/; #Remove trailing quotation mark
|
|
}
|
|
return @destArray;
|
|
}
|
|
|
|
# produce a list of configuration files from the files
|
|
# format ('configuration' 'files')
|
|
my @configList = MakeArrayFromString($strConfigList);
|
|
|
|
# produce a list of service configurables from the files
|
|
# format ('service' 'configurable')
|
|
my @serviceList = MakeArrayFromString($strServiceList);
|
|
|
|
# produce a list of process names from the files format
|
|
# ('my' 'process' 'list')
|
|
my @processList = MakeArrayFromString($strProcessList);
|
|
|
|
# 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;
|
|
@{$GLOBAL_RC_CONFIG{$serviceID}} = @configList;
|
|
}
|
|
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;
|
|
@{$GLOBAL_RC_CONFIG{$serviceID}} = @configList;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
|
|
###############################################################################
|
|
# 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 information 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/",
|
|
"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;
|
|
$ENV{'LOCALE'}=''; # So that test cases checking for english results work ok.
|
|
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 $distro 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 -f -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 is used for opening a file for reading. B_open_plus is the preferred
|
|
# function for writing, since it saves a backup copy of the file for
|
|
# later restoration.
|
|
#
|
|
# 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("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 ( $file eq "" ){
|
|
&B_log("ERROR","Internal Error - Attempt Made to Open Blank Filename");
|
|
$return_old=0;
|
|
$return_file=0;
|
|
return 0; #False
|
|
} elsif (-e "${file}.bastille") {
|
|
&B_log("ERROR","Unable to open $file as the swap file ".
|
|
"${file}.bastille\" already exists. Rename the swap ".
|
|
"file to allow Bastille to make desired file modifications.");
|
|
$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 file: \"$original_file.bastille\" failed...\n");
|
|
}
|
|
unless ($return_old) {
|
|
$retval=0;
|
|
&B_log("ERROR","open file: \"$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("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
|
|
#
|
|
|
|
if (($file eq "") or (not(-e $file ))) {
|
|
&B_log("ERROR","Internal Error, attempted to close a blank filename ".
|
|
"or nonexistent file.");
|
|
return 0; #False
|
|
}
|
|
|
|
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");
|
|
|
|
# We add the file to the GLOBAL_SUMS hash if it is not already present
|
|
&B_set_sum($file);
|
|
|
|
}
|
|
|
|
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 ) {
|
|
|
|
unless ( -e $backup_file ) {
|
|
my $command=&getGlobal("BIN","cp");
|
|
&B_Backtick("$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
|
|
#
|
|
# It reads the information into the GLOBAL_SUM hash i.e.
|
|
# $GLOBAL_SUM{$file}{sum} = $cksum
|
|
# $GLOBAL_SUM{$file}{filesize} = $size
|
|
# For the first run of Bastille on a given system this subroutine
|
|
# is a no-op, and returns "undefined."
|
|
###########################################################################
|
|
|
|
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;
|
|
}
|
|
}
|
|
|
|
close(SUM);
|
|
} else {
|
|
return undef;
|
|
}
|
|
}
|
|
|
|
|
|
###########################################################################
|
|
# &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
|
|
#
|
|
# It writes the information from the GLOBAL_SUM hash i.e.
|
|
#
|
|
# $file,$GLOBAL_SUM{$file}{sum},$GLOBAL_SUM{$file}{filesize}
|
|
#
|
|
# This subroutine requires access to the GLOBAL_SUM hash.
|
|
###########################################################################
|
|
|
|
sub B_write_sums {
|
|
|
|
my $sumFile = &getGlobal('BFILE',"sum.csv");
|
|
|
|
if ( %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}\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.
|
|
# 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.
|
|
#
|
|
# Returns 1 if sum checks out and 0 if not
|
|
###########################################################################
|
|
|
|
sub B_check_sum($) {
|
|
my $file = $_[0];
|
|
my $cksum = &getGlobal('BIN',"cksum");
|
|
|
|
if (not(%GLOBAL_SUM)) {
|
|
&B_read_sums;
|
|
}
|
|
|
|
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");
|
|
return 0;
|
|
} else {
|
|
if ( exists $GLOBAL_SUM{$file} ) {
|
|
# if the file size or file sum differ from those recorded.
|
|
if (( $GLOBAL_SUM{$file}{filesize} == $size) and
|
|
($GLOBAL_SUM{$file}{sum} == $sum )) {
|
|
return 1; #True, since saved state matches up, all is well.
|
|
} else {
|
|
return 0; #False, since saved state doesn't match
|
|
}
|
|
} else {
|
|
&B_log("ERROR","File: $file does not exist in sums database.");
|
|
return 0;
|
|
}
|
|
}
|
|
} else {
|
|
&B_log("ERROR","The file: $file does not exist for comparison in B_check_sum.");
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
# Don't think we need this anymore as function now check_sums returns
|
|
# results directly
|
|
#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_isFileinSumDB($file) checks to see if a given file's sum was saved.
|
|
#
|
|
# $GLOBAL_SUM{$file}{filesize} = $size;
|
|
# $GLOBAL_SUM{$file}{sum} = $cksum;
|
|
#
|
|
# This subroutine requires access to the GLOBAL_SUM hash.
|
|
###########################################################################
|
|
|
|
sub B_isFileinSumDB($) {
|
|
my $file = $_[0];
|
|
|
|
if (not(%GLOBAL_SUM)) {
|
|
&B_log("DEBUG","Reading in DB from B_isFileinSumDB");
|
|
&B_read_sums;
|
|
}
|
|
if (exists($GLOBAL_SUM{"$file"})){
|
|
&B_log("DEBUG","$file is in sum database");
|
|
return 1; #true
|
|
} else {
|
|
&B_log("DEBUG","$file is not in sum database");
|
|
return 0; #false
|
|
}
|
|
}
|
|
|
|
###########################################################################
|
|
# &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;
|
|
&B_write_sums;
|
|
|
|
}
|
|
} else {
|
|
&B_log("ERROR","Can not save chksum for file: $file since it does not exist");
|
|
}
|
|
}
|
|
|
|
|
|
###########################################################################
|
|
#
|
|
# &B_delete_file ($file) deletes the file $file and makes a backup to
|
|
# the backup directory.
|
|
#
|
|
##########################################################################
|
|
|
|
|
|
sub B_delete_file($) { #Currently Linux only (TMPDIR)
|
|
#consideration: should create clear_sum routine if this is ever used to remove
|
|
# A Bastille-generated 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;
|
|
|
|
if ($file eq ""){
|
|
&B_log("ERROR","Internal Error, attempt made to create blank filename");
|
|
return 0; #False
|
|
}
|
|
|
|
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_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;
|
|
|
|
}
|
|
|
|
|
|
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");
|
|
}
|
|
# We add the file to the GLOBAL_SUMS hash if it is not already present
|
|
&B_set_sum($target);
|
|
$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 { # Only Linux references left (Firewall / TMPDIR)
|
|
|
|
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");
|
|
}
|
|
|
|
# We add the file to the GLOBAL_SUMS hash if it is not already present
|
|
&B_set_sum($target);
|
|
|
|
$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 $revertdir= &getGlobal('BDIR', "revert");
|
|
my @lines;
|
|
|
|
|
|
if (! (-e $revert_actions)) {
|
|
mkpath($revertdir); #if this doesn't work next line catches
|
|
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: $revert_actions.\n" .
|
|
" Unable to add the following command to the revert\n" .
|
|
" actions script: $revert_command\n");
|
|
}
|
|
|
|
}
|
|
|
|
&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.");
|
|
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,
|
|
"RCCONFIG" => \%GLOBAL_RC_CONFIG
|
|
);
|
|
|
|
# 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.
|
|
# Note that we can't use B_log, since it uses getGlobal ... recursive before
|
|
# configureForDistro is run.
|
|
print STDERR "ERROR: Bastille tried to use \$GLOBAL_${type}\{\'$key\'} but it does not exist.\n";
|
|
return undef;
|
|
}
|
|
}
|
|
|
|
###########################################################################
|
|
# &getGlobal($$)
|
|
#
|
|
# sets the requested GLOBAL_* hash value
|
|
###########################################################################
|
|
sub setGlobal ($$$) {
|
|
my $type = uc($_[0]);
|
|
my $key = $_[1];
|
|
my $input_value = $_[2];
|
|
|
|
# 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,
|
|
);
|
|
|
|
if ($map{$type}->{$key} = $input_value) {
|
|
return 1;
|
|
} else {
|
|
&B_log('ERROR','Internal Error, Unable to set global config value:' . $type . ", " .$key);
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
|
|
###########################################################################
|
|
# &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-2006 Jay Beale\n" .
|
|
"Copyright (C) 1999-2001 Peter Watkins\n" .
|
|
"Copyright (C) 2000 Paul L. Allen\n" .
|
|
"Copyright (C) 2001-2007 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. This notice will only \n".
|
|
"display on the first run on a given system.\n".
|
|
"To suppress the disclaimer on other machines, use Bastille\'s -n flag (example: bastille -n).\n";
|
|
|
|
|
|
# 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
|
|
print ($DISCLAIMER);
|
|
|
|
# there is a response
|
|
my $touch = &getGlobal('BIN', "touch");
|
|
my $retVal = system("$touch $nodisclaim_file");
|
|
if( $retVal != 0 ) {
|
|
&ErrorLog ( &getGlobal('ERROR','disclaimer'));
|
|
}
|
|
} # showDisclaimer
|
|
|
|
|
|
|
|
|
|
################################################################
|
|
# &systemCall
|
|
#Function used by exported methods B_Backtick and B_system
|
|
#to handle the mechanics of system calls.
|
|
# This function also manages error handling.
|
|
# Input: a system call
|
|
# Output: a list containing the status, sstdout and stderr
|
|
# of the the system call
|
|
#
|
|
################################################################
|
|
sub systemCall ($){
|
|
no strict;
|
|
local $command=$_[0]; # changed scoping so eval below can read it
|
|
|
|
local $SIG{'ALRM'} = sub { die "timeout" }; # This subroutine exits the "eval" below. The program
|
|
# can then move on to the next operation. Used "local"
|
|
# to avoid name space collision with disclaim alarm.
|
|
local $WAIT_TIME=120; # Wait X seconds for system commands
|
|
local $commandOutput = '';
|
|
my $errOutput = '';
|
|
eval{
|
|
$errorFile = &getGlobal('BFILE','stderrfile');
|
|
unlink($errorFile); #To make sure we don't mix output
|
|
alarm($WAIT_TIME); # start a time-out for command to complete. Some commands hang, and we want to
|
|
# fail gracefully. When we call "die" it exits this eval statement
|
|
# with a value we use below
|
|
$commandOutput = `$command 2> $errorFile`; # run the command and gather its output
|
|
my $commandRetVal = ($? >> 8); # find the commands return value
|
|
if ($commandRetVal == 0) {
|
|
&B_log("ACTION","Executed Command: " . $command . "\n");
|
|
&B_log("ACTION","Command Output: " . $commandOutput . "\n");
|
|
die "success";
|
|
} else {
|
|
die "failure";
|
|
};
|
|
};
|
|
|
|
my $exitcode=$@;
|
|
alarm(0); # End of the timed operation
|
|
|
|
my $cat = &getGlobal("BIN","cat");
|
|
if ( -e $errorFile ) {
|
|
$errOutput = `$cat $errorFile`;
|
|
}
|
|
|
|
if ($exitcode) { # The eval command above will exit with one of the 3 values below
|
|
if ($exitcode =~ /timeout/) {
|
|
&B_log("WARNING","No response received from $command after $WAIT_TIME seconds.\n" .
|
|
"Command Output: " . $commandOutput . "\n");
|
|
return (0,'','');
|
|
} elsif ($exitcode =~ /success/) {
|
|
return (1,$commandOutput,$errOutput);
|
|
} elsif ($exitcode =~ /failure/) {
|
|
return (0,$commandOutput,$errOutput);
|
|
} else {
|
|
&B_log("FATAL","Unexpected return state from command execution: $command\n" .
|
|
"Command Output: " . $commandOutput . "\n");
|
|
}
|
|
}
|
|
}
|
|
|
|
#############################################
|
|
# Use this **only** for commands used that are
|
|
# intended to test system state and
|
|
# not make any system change. Use this in place of the
|
|
# prior use of "backticks throughout Bastille
|
|
# Handles basic output redirection, but not for stdin
|
|
# Input: Command
|
|
# Output: Results
|
|
#############################################
|
|
|
|
sub B_Backtick($) {
|
|
my $command=$_[0];
|
|
my $combineOutput=0;
|
|
my $stdoutRedir = "";
|
|
my $stderrRedir = "";
|
|
my $echo = &getGlobal('BIN','echo');
|
|
|
|
if (($command =~ s/2>&1//) or
|
|
(s/>&2//)){
|
|
$combineOutput=1;
|
|
}
|
|
if ($command =~ s/>\s*([^>\s])+// ) {
|
|
$stdoutRedir = $1;
|
|
}
|
|
if ($command =~ s/2>\s*([^>\s])+// ) {
|
|
$stderrRedir = $1;
|
|
}
|
|
|
|
my ($ranFine, $stdout, $stderr) = &systemCall($command);
|
|
if ($ranFine) {
|
|
&B_log("DEBUG","Command: $command succeeded for test with output: $stdout , ".
|
|
"and stderr: $stderr");
|
|
} else {
|
|
&B_log("DEBUG","Command: $command failed for test with output: $stdout , ".
|
|
"and stderr: $stderr");
|
|
}
|
|
if ($combineOutput) {
|
|
$stdout .= $stderr;
|
|
$stderr = $stdout; #these should be the same
|
|
}
|
|
if ($stdoutRedir ne "") {
|
|
system("$echo \'$stdout\' > $stdoutRedir");
|
|
}
|
|
if ($stderrRedir ne "") {
|
|
system("$echo \'$stderr\' > $stderrRedir");
|
|
}
|
|
return $stdout;
|
|
}
|
|
|
|
####################################################################
|
|
# &B_System($command,$revertcommand);
|
|
# This function executes a command, then places the associated
|
|
# revert command in revert file. It takes two parameters, the
|
|
# command and the command that reverts that command.
|
|
#
|
|
# uses ActionLog and ErrorLog for logging purposes.
|
|
###################################################################
|
|
sub B_System ($$) {
|
|
my ($command,$revertcmd)=@_;
|
|
|
|
my ($ranFine, $stdout, $stderr) = &systemCall($command);
|
|
if ($ranFine) {
|
|
&B_revert_log ("$revertcmd \n");
|
|
if ($stderr ne '' ) {
|
|
&B_log("ACTION",$command . "suceeded with STDERR: " .
|
|
$stderr . "\n");
|
|
}
|
|
return 1;
|
|
} else {
|
|
my $warningString = "Command Failed: " . $command . "\n" .
|
|
"Command Output: " . $stdout . "\n";
|
|
if ($stderr ne '') {
|
|
$warningString .= "Error message: " . $stderr;
|
|
}
|
|
&B_log("WARNING", $warningString);
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
|
|
###########################################################################
|
|
# &isProcessRunning($procPattern);
|
|
#
|
|
# If called in scalar context this subroutine will return a 1 if the
|
|
# pattern specified can be matched against the process table. It will
|
|
# return a 0 otherwise.
|
|
# If called in the list context this subroutine will return the list
|
|
# of processes which matched the pattern supplied
|
|
#
|
|
# scalar return values:
|
|
# 0: pattern not in process table
|
|
# 1: pattern is in process table
|
|
#
|
|
# list return values:
|
|
# proc lines from the process table if they are found
|
|
###########################################################################
|
|
sub isProcessRunning($) {
|
|
|
|
my $procPattern= $_[0];
|
|
my $ps = &getGlobal('BIN',"ps");
|
|
|
|
my $isRunning=0;
|
|
# process table.
|
|
my @psTable = `$ps -elf`;
|
|
# list of processes that match the $procPattern
|
|
my @procList;
|
|
foreach my $process (@psTable) {
|
|
if($process =~ $procPattern) {
|
|
$isRunning = 1;
|
|
push @procList, $process . "\n";
|
|
}
|
|
}
|
|
|
|
&B_log("DEBUG","$procPattern search yielded $isRunning\n\n");
|
|
# if this subroutine was called in scalar context
|
|
if( ! wantarray ) {
|
|
return $isRunning;
|
|
}
|
|
|
|
return @procList;
|
|
}
|
|
|
|
|
|
###########################################################################
|
|
# &checkProcsForService($service);
|
|
#
|
|
# Checks if the given service is running by analyzing the process table.
|
|
# This is a helper function to checkServiceOnLinux and checkServiceOnHP
|
|
#
|
|
# Return values:
|
|
# SECURE_CANT_CHANGE() if the service is off
|
|
# INCONSISTENT() if the state of the service cannot be determined
|
|
#
|
|
# Mostly used in "check service" direct-return context, but added option use.
|
|
# to ignore warning if a check for a service ... where a found service doesn't
|
|
# have direct security problems.
|
|
#
|
|
###########################################################################
|
|
sub checkProcsForService ($;$) {
|
|
my $service=$_[0];
|
|
my $ignore_warning=$_[1];
|
|
|
|
my @psnames=@{ &getGlobal('PROCESS',$service)};
|
|
|
|
my @processes;
|
|
# inetd services don't have a separate process
|
|
foreach my $psname (@psnames) {
|
|
my @procList = &isProcessRunning($psname);
|
|
if(@procList >= 0){
|
|
splice @processes,$#processes+1,0,@procList;
|
|
}
|
|
}
|
|
|
|
if($#processes >= 0){
|
|
if ((defined($ignore_warning)) and ($ignore_warning eq "ignore_warning")) {
|
|
&B_log("WARNING","The following processes were still running even though " .
|
|
"the corresponding service appears to be turned off. Bastille " .
|
|
"question and action will be skipped.\n\n" .
|
|
"@processes\n\n");
|
|
# processes were still running, service is not off, but we don't know how
|
|
# to configure it so we skip the question
|
|
return INCONSISTENT();
|
|
} else {
|
|
return NOTSECURE_CAN_CHANGE(); # In the case we're ignoring the warning,
|
|
# ie: checking to make *sure* a process
|
|
# is running, the answer isn't inconsistent
|
|
}
|
|
} else {
|
|
&B_log("DEBUG","$service is off. Found no processes running on the system.");
|
|
# no processes, so service is off
|
|
return SECURE_CANT_CHANGE();
|
|
}
|
|
# Can't determine the state of the service by looking at the processes,
|
|
# so return INCONSISTENT().
|
|
return INCONSISTENT();
|
|
}
|
|
|
|
###########################################################################
|
|
# B_parse_fstab()
|
|
#
|
|
# Search the filesystem table for a specific mount point.
|
|
#
|
|
# scalar return value:
|
|
# The line form the table that matched the mount point, or the null string
|
|
# if no match was found.
|
|
#
|
|
# list return value:
|
|
# A list of parsed values from the line of the table that matched, with
|
|
# element [3] containing a reference to a hash of the mount options. The
|
|
# keys are: acl, dev, exec, rw, suid, sync, or user. The value of each key
|
|
# can be either 0 or 1. To access the hash, use code similar to this:
|
|
# %HashResult = %{(&B_parse_fstab($MountPoint))[3]};
|
|
#
|
|
###########################################################################
|
|
|
|
sub B_parse_fstab($)
|
|
{
|
|
my $name = shift;
|
|
my $file = &getGlobal('FILE','fstab');
|
|
my ($enable, $disable, $infile);
|
|
my @lineopt;
|
|
my $retline = "";
|
|
my @retlist = ();
|
|
|
|
unless (open FH, $file) {
|
|
&B_log('ERROR',"B_parse_fstab couldn't open fstab file at path $file.\n");
|
|
return 0;
|
|
}
|
|
while (<FH>) {
|
|
s/\#.*//;
|
|
next unless /\S/;
|
|
@retlist = split;
|
|
next unless $retlist[1] eq $name;
|
|
$retline .= $_;
|
|
if (wantarray) {
|
|
my $option = { # initialize to defaults
|
|
acl => 0, # for ext2, etx3, reiserfs
|
|
dev => 1,
|
|
exec => 1,
|
|
rw => 1,
|
|
suid => 1,
|
|
sync => 0,
|
|
user => 0,
|
|
};
|
|
|
|
my @lineopt = split(',',$retlist[3]);
|
|
foreach my $entry (@lineopt) {
|
|
if ($entry eq 'acl') {
|
|
$option->{'acl'} = 1;
|
|
}
|
|
elsif ($entry eq 'nodev') {
|
|
$option->{'dev'} = 0;
|
|
}
|
|
elsif ($entry eq 'noexec') {
|
|
$option->{'exec'} = 0;
|
|
}
|
|
elsif ($entry eq 'ro') {
|
|
$option->{'rw'} = 0;
|
|
}
|
|
elsif ($entry eq 'nosuid') {
|
|
$option->{'suid'} = 0;
|
|
}
|
|
elsif ($entry eq 'sync') {
|
|
$option->{'sync'} = 1;
|
|
}
|
|
elsif ($entry eq 'user') {
|
|
$option->{'user'} = 1;
|
|
}
|
|
}
|
|
$retlist[3]= $option;
|
|
}
|
|
last;
|
|
}
|
|
|
|
if (wantarray)
|
|
{
|
|
return @retlist;
|
|
}
|
|
else
|
|
{
|
|
return $retline;
|
|
}
|
|
|
|
}
|
|
|
|
|
|
###########################################################################
|
|
# B_parse_mtab()
|
|
#
|
|
# This routine returns a hash of devices and their mount points from mtab,
|
|
# simply so you can get a list of mounted filesystems.
|
|
#
|
|
###########################################################################
|
|
|
|
sub B_parse_mtab
|
|
{
|
|
my $mountpoints;
|
|
open(MTAB,&getGlobal('FILE','mtab'));
|
|
while(my $mtab_line = <MTAB>) {
|
|
#test if it's a device
|
|
if ($mtab_line =~ /^\//)
|
|
{
|
|
#parse out device and mount point
|
|
$mtab_line =~ /^(\S+)\s+(\S+)/;
|
|
$mountpoints->{$1} = $2;
|
|
}
|
|
}
|
|
return $mountpoints;
|
|
}
|
|
|
|
|
|
###########################################################################
|
|
# B_is_rpm_up_to_date()
|
|
#
|
|
#
|
|
###########################################################################
|
|
|
|
sub B_is_rpm_up_to_date(@)
|
|
{
|
|
my($nameB,$verB,$relB,$epochB) = @_;
|
|
my $installedpkg = $nameB;
|
|
|
|
if ($epochB =~ /(none)/) {
|
|
$epochB = 0;
|
|
}
|
|
|
|
my $rpmA = `rpm -q --qf '%{VERSION}-%{RELEASE}-%{EPOCH}\n' $installedpkg`;
|
|
my $nameA = $nameB;
|
|
my ($verA,$relA,$epochA);
|
|
|
|
my $retval;
|
|
|
|
# First, if the RPM isn't installed, let's handle that.
|
|
if ($rpmA =~ /is not installed/) {
|
|
$retval = -1;
|
|
return $retval;
|
|
}
|
|
else {
|
|
# Next, let's try to parse the EVR information without as few
|
|
# calls as possible to rpm.
|
|
if ($rpmA =~ /([^-]+)-([^-]+)-([^-]+)$/) {
|
|
$verA = $1;
|
|
$relA = $2;
|
|
$epochA = $3;
|
|
}
|
|
else {
|
|
$nameA = `rpm -q --qf '%{NAME}' $installedpkg`;
|
|
$verA = `rpm -q --qf '%{VERSION}' $installedpkg`;
|
|
$relA = `rpm -q --qf '%{RELEASE}' $installedpkg`;
|
|
$epochA = `rpm -q --qf '%{EPOCH}' $installedpkg`;
|
|
}
|
|
}
|
|
|
|
# Parse "none" as 0.
|
|
if ($epochA =~ /(none)/) {
|
|
$epochA = 0;
|
|
}
|
|
|
|
# Handle the case where only one of them is zero.
|
|
if ($epochA == 0 xor $epochB == 0)
|
|
{
|
|
if ($epochA != 0)
|
|
{
|
|
$retval = 1;
|
|
}
|
|
else
|
|
{
|
|
$retval = 0;
|
|
}
|
|
}
|
|
else
|
|
{
|
|
# ...otherwise they are either both 0 or both non-zero and
|
|
# so the situation isn't trivial.
|
|
|
|
# Check epoch first - highest epoch wins.
|
|
my $rpmcmp = &cmp_vers_part($epochA, $epochB);
|
|
#print "epoch rpmcmp is $rpmcmp\n";
|
|
if ($rpmcmp > 0)
|
|
{
|
|
$retval = 1;
|
|
}
|
|
elsif ($rpmcmp < 0)
|
|
{
|
|
$retval = 0;
|
|
}
|
|
else
|
|
{
|
|
# Epochs were the same. Check Version now.
|
|
$rpmcmp = &cmp_vers_part($verA, $verB);
|
|
#print "epoch rpmcmp is $rpmcmp\n";
|
|
if ($rpmcmp > 0)
|
|
{
|
|
$retval = 1;
|
|
}
|
|
elsif ($rpmcmp < 0)
|
|
{
|
|
$retval = 0;
|
|
}
|
|
else
|
|
{
|
|
# Versions were the same. Check Release now.
|
|
my $rpmcmp = &cmp_vers_part($relA, $relB);
|
|
#print "epoch rpmcmp is $rpmcmp\n";
|
|
if ($rpmcmp >= 0)
|
|
{
|
|
$retval = 1;
|
|
}
|
|
elsif ($rpmcmp < 0)
|
|
{
|
|
$retval = 0;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
return $retval;
|
|
}
|
|
|
|
#################################################
|
|
# Helper function for B_is_rpm_up_to_date()
|
|
#################################################
|
|
|
|
#This cmp_vers_part function taken from Kirk Bauer's Autorpm.
|
|
# This version comparison code was sent in by Robert Mitchell and, although
|
|
# not yet perfect, is better than the original one I had. He took the code
|
|
# from freshrpms and did some mods to it. Further mods by Simon Liddington
|
|
# <sjl96v@ecs.soton.ac.uk>.
|
|
#
|
|
# Splits string into minors on . and change from numeric to non-numeric
|
|
# characters. Minors are compared from the beginning of the string. If the
|
|
# minors are both numeric then they are numerically compared. If both minors
|
|
# are non-numeric and a single character they are alphabetically compared, if
|
|
# they are not a single character they are checked to be the same if the are not
|
|
# the result is unknown (currently we say the first is newer so that we have
|
|
# a choice to upgrade). If one minor is numeric and one non-numeric then the
|
|
# numeric one is newer as it has a longer version string.
|
|
# We also assume that (for example) .15 is equivalent to 0.15
|
|
|
|
sub cmp_vers_part($$) {
|
|
my($va, $vb) = @_;
|
|
my(@va_dots, @vb_dots);
|
|
my($a, $b);
|
|
my($i);
|
|
|
|
if ($vb !~ /^pre/ and $va =~ s/^pre(\d+.*)$/$1/) {
|
|
if ($va eq $vb) { return -1; }
|
|
} elsif ($va !~ /^pre/ and $vb =~ s/^pre(\d+.*)$/$1/) {
|
|
if ($va eq $vb) { return 1; }
|
|
}
|
|
|
|
@va_dots = split(/\./, $va);
|
|
@vb_dots = split(/\./, $vb);
|
|
|
|
$a = shift(@va_dots);
|
|
$b = shift(@vb_dots);
|
|
# We also assume that (for example) .15 is equivalent to 0.15
|
|
if ($a eq '' && $va ne '') { $a = "0"; }
|
|
if ($b eq '' && $vb ne '') { $b = "0"; }
|
|
while ((defined($a) && $a ne '') || (defined($b) && $b ne '')) {
|
|
# compare each minor from left to right
|
|
if ((not defined($a)) || ($a eq '')) { return -1; } # the longer version is newer
|
|
if ((not defined($b)) || ($b eq '')) { return 1; }
|
|
if ($a =~ /^\d+$/ && $b =~ /^\d+$/) {
|
|
# I have changed this so that when the two strings are numeric, but one or both
|
|
# of them start with a 0, then do a string compare - Kirk Bauer - 5/28/99
|
|
if ($a =~ /^0/ or $b =~ /^0/) {
|
|
# We better string-compare so that netscape-4.6 is newer than netscape-4.08
|
|
if ($a ne $b) {return ($a cmp $b);}
|
|
}
|
|
# numeric compare
|
|
if ($a != $b) { return $a <=> $b; }
|
|
} elsif ($a =~ /^\D+$/ && $b =~ /^\D+$/) {
|
|
# string compare
|
|
if (length($a) == 1 && length($b) == 1) {
|
|
# only minors with one letter seem to be useful for versioning
|
|
if ($a ne $b) { return $a cmp $b; }
|
|
} elsif (($a cmp $b) != 0) {
|
|
# otherwise we should at least check they are the same and if not say unknown
|
|
# say newer for now so at least we get choice whether to upgrade or not
|
|
return -1;
|
|
}
|
|
} elsif ( ($a =~ /^\D+$/ && $b =~ /^\d+$/) || ($a =~ /^\d+$/ && $b =~ /^\D+$/) ) {
|
|
# if we get a number in one and a word in another the one with a number
|
|
# has a longer version string
|
|
if ($a =~ /^\d+$/) { return 1; }
|
|
if ($b =~ /^\d+$/) { return -1; }
|
|
} else {
|
|
# minor needs splitting
|
|
$a =~ /\d+/ || $a =~ /\D+/;
|
|
# split the $a minor into numbers and non-numbers
|
|
my @va_bits = ($`, $&, $');
|
|
$b =~ /\d+/ || $b =~ /\D+/;
|
|
# split the $b minor into numbers and non-numbers
|
|
my @vb_bits = ($`, $&, $');
|
|
for ( my $j=2; $j >= 0; $j--) {
|
|
if ($va_bits[$j] ne '') { unshift(@va_dots,$va_bits[$j]); }
|
|
if ($vb_bits[$j] ne '') { unshift(@vb_dots,$vb_bits[$j]); }
|
|
}
|
|
}
|
|
$a = shift(@va_dots);
|
|
$b = shift(@vb_dots);
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
1;
|
|
|