#!/usr/bin/perl -w
######################################################################
#
# $Id: nph-webjob.cgi,v 1.44 2006/05/25 22:17:28 mavrik Exp $
#
######################################################################
#
# Copyright 2001-2006 Klayton Monroe, All Rights Reserved.
#
######################################################################
use strict;
use Fcntl qw(:flock);
######################################################################
#
# Main Routine
#
######################################################################
my (%hProperties, %hReturnCodes, $sLocalError);
%hReturnCodes =
(
'200' => "OK",
'251' => "Link Test OK",
'404' => "Not Found",
'405' => "Method Not Allowed",
'450' => "Invalid Query",
'451' => "File Already Exists",
'452' => "Username Undefined",
'453' => "Username-ClientId Mismatch",
'454' => "Content-Length Undefined",
'455' => "Content-Length Exceeds Limit",
'456' => "Content-Length Mismatch",
'457' => "File Not Available",
'458' => "Invalid Protocol",
'459' => "Payload Signature Not Available",
'470' => "CommonName Undefined",
'471' => "CommonName-ClientId Mismatch",
'500' => "Internal Server Error",
'550' => "Internal Server Initialization Error",
);
####################################################################
#
# Punch in and go to work.
#
####################################################################
$hProperties{'StartTime'} = time();
$hProperties{'Version'} = sprintf("%s %s", __FILE__, ('$Revision: 1.44 $' =~ /^.Revision: ([\d.]+)/));
####################################################################
#
# Create/Verify run time environment, and process GET/PUT requests.
#
####################################################################
if (!defined(CreateRunTimeEnvironment(\%hProperties, \$sLocalError)))
{
$hProperties{'ReturnStatus'} = 550;
$hProperties{'ReturnReason'} = $hReturnCodes{$hProperties{'ReturnStatus'}};
$hProperties{'ErrorMessage'} = $sLocalError;
}
else
{
if ($hProperties{'SslRequireSsl'} =~ /^[Yy]$/ && (!defined($hProperties{'Https'}) || $hProperties{'Https'} !~ /^[Oo][Nn]$/))
{
$hProperties{'ReturnStatus'} = 458;
$hProperties{'ReturnReason'} = $hReturnCodes{$hProperties{'ReturnStatus'}};
$hProperties{'ErrorMessage'} = "HTTPS required, but client is speaking HTTP";
}
else
{
if ($hProperties{'RequestMethod'} eq "GET")
{
$hProperties{'ReturnStatus'} = ProcessGetRequest(\%hProperties, \$sLocalError);
$hProperties{'ReturnReason'} = $hReturnCodes{$hProperties{'ReturnStatus'}};
$hProperties{'ErrorMessage'} = $sLocalError;
$hProperties{'ExpandTriggerCommandLineRoutine'} = \&ExpandGetTriggerCommandLine;
}
elsif ($hProperties{'RequestMethod'} eq "PUT")
{
$hProperties{'ReturnStatus'} = ProcessPutRequest(\%hProperties, \$sLocalError);
$hProperties{'ReturnReason'} = $hReturnCodes{$hProperties{'ReturnStatus'}};
$hProperties{'ErrorMessage'} = $sLocalError;
$hProperties{'ExpandTriggerCommandLineRoutine'} = \&ExpandPutTriggerCommandLine;
}
else
{
$hProperties{'ReturnStatus'} = 405;
$hProperties{'ReturnReason'} = $hReturnCodes{$hProperties{'ReturnStatus'}};
$hProperties{'ErrorMessage'} = "Method ($hProperties{'RequestMethod'}) not allowed";
}
}
}
$hProperties{'ServerContentLength'} = SendResponse(\%hProperties);
####################################################################
#
# Conditionally log the GET/PUT transaction.
#
####################################################################
$hProperties{'StopTime'} = time();
if ($hProperties{'EnableLogging'} =~ /^[Yy]$/)
{
LogMessage(\%hProperties);
}
####################################################################
#
# Conditionally pull the GET/PUT trigger and log the result.
#
####################################################################
if
(
$hProperties{'ReturnStatus'} == 200 &&
(
($hProperties{'RequestMethod'} eq "GET" && $hProperties{'GetTriggerEnable'} =~ /^[Yy]$/) ||
($hProperties{'RequestMethod'} eq "PUT" && $hProperties{'PutTriggerEnable'} =~ /^[Yy]$/)
)
)
{
$hProperties{'TriggerEpoch'} = time();
$hProperties{'TriggerPidLabel'} = "parent";
$hProperties{'TriggerPid'} = $$;
if (!defined(TriggerExecuteCommandLine(\%hProperties, \$sLocalError)))
{
$hProperties{'TriggerState'} = "failed";
$hProperties{'TriggerMessage'} = $sLocalError;
if ($hProperties{'EnableLogging'} =~ /^[Yy]$/)
{
TriggerLogMessage(\%hProperties);
}
}
}
####################################################################
#
# Clean up and go home.
#
####################################################################
1;
######################################################################
#
# CreateRunTimeEnvironment
#
######################################################################
sub CreateRunTimeEnvironment
{
my ($phProperties, $psError) = @_;
####################################################################
#
# Put input/output streams in binary mode.
#
####################################################################
foreach my $sHandle (\*STDIN, \*STDOUT, \*STDERR)
{
binmode($sHandle);
}
####################################################################
#
# Initialize regex variables.
#
####################################################################
my %hCommonRegexes =
(
'AnyValue' => qq(.*),
'Base64' => qq([0-9A-Za-z+\/]+={0,2}),
'BaseDirectory' => qq((?:[A-Za-z]:)?/[\\w./-]+),
'ClientId' => qq((?:[A-Za-z](?:(?:[0-9A-Za-z]|[_-](?=[^.]))){0,62})(?:[.][A-Za-z](?:(?:[0-9A-Za-z]|[_-](?=[^.]))){0,62}){0,127}),
'ClientSuppliedFilename' => qq([\\w+.:-]{1,1024}),
'ConfigSearchOrder' => qq((?:clients(?::commands)?|commands(?::clients)?)),
'Decimal32Bit' => qq(\\d{1,10}), # 4294967295
'Decimal64Bit' => qq(\\d{1,20}), # 18446744073709551615
'FolderList' => qq([\\w.-]+(?::[\\w.-]+)*),
'Ip' => qq((?:\\d{1,3}\\.){3}\\d{1,3}),
'JobId' => qq([\\w-]{1,64}_\\d{10}_\\d{5}),
'YesNo' => qq([YyNn]),
'ProcessId' => qq(\\d{5}),
'PutNameFormat' => qq([\\w%+./:-]+),
'ServerSuppliedPath' => qq([\\w+./:\\\\-]+),
'strftime_Y' => qq(\\d{4}),
'strftime_m' => qq(\\d{2}),
'strftime_d' => qq(\\d{2}),
'strftime_H' => qq(\\d{2}),
'strftime_M' => qq(\\d{2}),
'strftime_S' => qq(\\d{2}),
'strftime_s' => qq(\\d{10}),
'FileSuffix' => qq([\\w.-]{1,32}),
'SystemVersion' => qq([\\w ()+,./:-]{1,64}),
'WebJobVersion' => qq(webjob[\\w ().-]{1,64}),
);
$$phProperties{'CommonRegexes'} = { %hCommonRegexes };
my %hCustomRegexes =
(
'Version' => qq(VERSION=($$phProperties{'CommonRegexes'}{'WebJobVersion'})),
'System' => qq(&SYSTEM=($$phProperties{'CommonRegexes'}{'SystemVersion'})),
'ClientId' => qq(&CLIENTID=($$phProperties{'CommonRegexes'}{'ClientId'})),
'Filename' => qq(&FILENAME=($$phProperties{'CommonRegexes'}{'ClientSuppliedFilename'})),
'RunType' => qq(&RUNTYPE=(linktest|snapshot)),
'OutLength' => qq(&STDOUT_LENGTH=($$phProperties{'CommonRegexes'}{'Decimal64Bit'})),
'ErrLength' => qq(&STDERR_LENGTH=($$phProperties{'CommonRegexes'}{'Decimal64Bit'})),
'EnvLength' => qq(&STDENV_LENGTH=($$phProperties{'CommonRegexes'}{'Decimal64Bit'})),
);
$$phProperties{'CustomRegexes'} = { %hCustomRegexes };
$$phProperties{'CustomRegexes'}{'GetQuery'} =
$$phProperties{'CustomRegexes'}{'Version'} .
$$phProperties{'CustomRegexes'}{'System'} .
$$phProperties{'CustomRegexes'}{'ClientId'} .
$$phProperties{'CustomRegexes'}{'Filename'}
;
$$phProperties{'CustomRegexes'}{'PutQuery'} =
$$phProperties{'CustomRegexes'}{'Version'} .
$$phProperties{'CustomRegexes'}{'System'} .
$$phProperties{'CustomRegexes'}{'ClientId'} .
$$phProperties{'CustomRegexes'}{'Filename'} .
$$phProperties{'CustomRegexes'}{'RunType'} .
$$phProperties{'CustomRegexes'}{'OutLength'} .
$$phProperties{'CustomRegexes'}{'ErrLength'} .
$$phProperties{'CustomRegexes'}{'EnvLength'}
;
####################################################################
#
# Initialize environment-specific variables. Pull in SSL-related
# variables, but only if HTTPS is defined and on.
#
####################################################################
$$phProperties{'ContentLength'} = $ENV{'CONTENT_LENGTH'};
$$phProperties{'Https'} = $ENV{'HTTPS'};
$$phProperties{'QueryString'} = $ENV{'QUERY_STRING'};
$$phProperties{'RemoteAddress'} = $ENV{'REMOTE_ADDR'};
$$phProperties{'RemoteUser'} = $ENV{'REMOTE_USER'};
$$phProperties{'RequestMethod'} = $ENV{'REQUEST_METHOD'};
$$phProperties{'ServerSoftware'} = $ENV{'SERVER_SOFTWARE'};
$$phProperties{'PropertiesFile'} = $ENV{'WEBJOB_PROPERTIES_FILE'};
if (defined($hProperties{'Https'}) && $hProperties{'Https'} =~ /^[Oo][Nn]$/)
{
$$phProperties{'SslClientSDnCn'} = $ENV{'SSL_CLIENT_S_DN_CN'};
}
####################################################################
#
# Initialize platform-specific variables.
#
####################################################################
if ($^O =~ /MSWin32/i)
{
$$phProperties{'OSClass'} = "WINDOWS";
$$phProperties{'Newline'} = "\r\n";
}
else
{
$$phProperties{'OSClass'} = "UNIX";
$$phProperties{'Newline'} = "\n";
umask(022);
}
####################################################################
#
# Initialize site-specific variables. Note that the properties
# listed in the custom template are a subset of those in the
# global template. All values in the custom template may may be
# overridden through the use of client- and/or command-specific
# config files.
#
####################################################################
my (%hCustomConfigTemplate, %hGlobalConfigTemplate, $sLocalError);
%hGlobalConfigTemplate = # This is the set of site-wide properties.
(
'BaseDirectory' => $$phProperties{'CommonRegexes'}{'BaseDirectory'},
'CapContentLength' => $$phProperties{'CommonRegexes'}{'YesNo'},
'ConfigSearchOrder' => $$phProperties{'CommonRegexes'}{'ConfigSearchOrder'},
'DsvMaxSignatureLength' => $$phProperties{'CommonRegexes'}{'Decimal32Bit'},
'DsvRequireSignatures' => $$phProperties{'CommonRegexes'}{'YesNo'},
'DsvSignatureSuffix' => $$phProperties{'CommonRegexes'}{'FileSuffix'},
'EnableConfigOverrides' => $$phProperties{'CommonRegexes'}{'YesNo'},
'EnableJobIds' => $$phProperties{'CommonRegexes'}{'YesNo'},
'EnableLogging' => $$phProperties{'CommonRegexes'}{'YesNo'},
'FolderList' => $$phProperties{'CommonRegexes'}{'FolderList'},
'GetTriggerCommandLine' => $$phProperties{'CommonRegexes'}{'AnyValue'},
'GetTriggerEnable' => $$phProperties{'CommonRegexes'}{'YesNo'},
'MaxContentLength' => $$phProperties{'CommonRegexes'}{'Decimal64Bit'},
'OverwriteExistingFiles' => $$phProperties{'CommonRegexes'}{'YesNo'},
'PutNameFormat' => $$phProperties{'CommonRegexes'}{'PutNameFormat'},
'PutTriggerCommandLine' => $$phProperties{'CommonRegexes'}{'AnyValue'},
'PutTriggerEnable' => $$phProperties{'CommonRegexes'}{'YesNo'},
'RequireMatch' => $$phProperties{'CommonRegexes'}{'YesNo'},
'RequireUser' => $$phProperties{'CommonRegexes'}{'YesNo'},
'ServerId' => $$phProperties{'CommonRegexes'}{'ClientId'},
'SslRequireSsl' => $$phProperties{'CommonRegexes'}{'YesNo'},
'SslRequireCn' => $$phProperties{'CommonRegexes'}{'YesNo'},
'SslRequireMatch' => $$phProperties{'CommonRegexes'}{'YesNo'},
'UseGMT' => $$phProperties{'CommonRegexes'}{'YesNo'},
);
$$phProperties{'GlobalConfigTemplate'} = { %hGlobalConfigTemplate };
%hCustomConfigTemplate = # This is the subset of site-wide properties that can be overridden.
(
'CapContentLength' => $$phProperties{'CommonRegexes'}{'YesNo'},
'FolderList' => $$phProperties{'CommonRegexes'}{'FolderList'},
'GetTriggerCommandLine' => $$phProperties{'CommonRegexes'}{'AnyValue'},
'GetTriggerEnable' => $$phProperties{'CommonRegexes'}{'YesNo'},
'MaxContentLength' => $$phProperties{'CommonRegexes'}{'Decimal64Bit'},
'OverwriteExistingFiles' => $$phProperties{'CommonRegexes'}{'YesNo'},
'PutNameFormat' => $$phProperties{'CommonRegexes'}{'PutNameFormat'},
'PutTriggerCommandLine' => $$phProperties{'CommonRegexes'}{'AnyValue'},
'PutTriggerEnable' => $$phProperties{'CommonRegexes'}{'YesNo'},
'RequireMatch' => $$phProperties{'CommonRegexes'}{'YesNo'},
'RequireUser' => $$phProperties{'CommonRegexes'}{'YesNo'},
'SslRequireCn' => $$phProperties{'CommonRegexes'}{'YesNo'},
'SslRequireMatch' => $$phProperties{'CommonRegexes'}{'YesNo'},
);
$$phProperties{'CustomConfigTemplate'} = { %hCustomConfigTemplate };
GetGlobalConfigProperties($phProperties, \%hGlobalConfigTemplate, \$sLocalError);
####################################################################
#
# Initialize derived variables.
#
####################################################################
$$phProperties{'ConfigDirectory'} = $$phProperties{'BaseDirectory'} . "/config/nph-webjob";
$$phProperties{'IncomingDirectory'} = $$phProperties{'BaseDirectory'} . "/incoming";
$$phProperties{'LogfilesDirectory'} = $$phProperties{'BaseDirectory'} . "/logfiles";
$$phProperties{'ProfilesDirectory'} = $$phProperties{'BaseDirectory'} . "/profiles";
$$phProperties{'LogFile'} = $$phProperties{'LogfilesDirectory'} . "/nph-webjob.log";
$$phProperties{'TriggerLogFile'} = $$phProperties{'LogfilesDirectory'} . "/nph-webjob-trigger.log";
####################################################################
#
# Verify run time environment.
#
####################################################################
if (!defined(VerifyRunTimeEnvironment($phProperties, \%hGlobalConfigTemplate, \$sLocalError)))
{
$$psError = $sLocalError;
return undef;
}
####################################################################
#
# Conditionally, initialize and verify the job id.
#
####################################################################
if ($$phProperties{'EnableJobIds'} =~ /^[Yy]$/)
{
if ($$phProperties{'RequestMethod'} eq "GET")
{
$$phProperties{'JobId'} = sprintf("%s_%010u_%05d", $$phProperties{'ServerId'}, $$phProperties{'StartTime'}, $$);
}
else
{
if (exists($ENV{'HTTP_JOB_ID'}))
{
if ($ENV{'HTTP_JOB_ID'} =~ /^($$phProperties{'CommonRegexes'}{'JobId'})$/)
{
$$phProperties{'JobId'} = $1;
}
else
{
$$psError = "HTTP_JOB_ID ($ENV{'HTTP_JOB_ID'}) is undefined or invalid";
return undef;
}
}
else
{
$$phProperties{'JobId'} = "NA"; # Not Assigned.
}
}
}
else
{
$$phProperties{'JobId'} = "NR"; # Not Required.
}
if (!defined($$phProperties{'JobId'}) || $$phProperties{'JobId'} !~ /^(NA|NR|$$phProperties{'CommonRegexes'}{'JobId'})$/)
{
$$psError = "JobId ($$phProperties{'JobId'}) is undefined or invalid";
return undef;
}
1;
}
######################################################################
#
# ExpandConversionString
#
######################################################################
sub ExpandConversionString
{
my ($sConversionString, $phConversionValues, $psError) = @_;
####################################################################
#
# Make sure that required inputs are defined.
#
####################################################################
if (!defined($sConversionString) || !defined($phConversionValues))
{
$$psError = "Unable to proceed due to missing or undefined inputs";
return undef;
}
####################################################################
#
# Expand the provided conversion string. The TokenList must be
# processed in reverse order (i.e., from longest to shortest).
# Otherwise, a token such as %pid would be interpreted as the token
# %p followed by the literal string "id". Once all regular
# conversions are done, check for and convert any literal '%'s.
#
####################################################################
my ($sExpandedConversionString, $sTokenList);
$sTokenList = join('|', reverse(sort(keys(%$phConversionValues))));
$sExpandedConversionString = $sConversionString;
$sExpandedConversionString =~ s/%($sTokenList)/$$phConversionValues{$1}/ge;
$sExpandedConversionString =~ s/%%/%/g;
return $sExpandedConversionString;
}
######################################################################
#
# ExpandGetTriggerCommandLine
#
######################################################################
sub ExpandGetTriggerCommandLine
{
my ($phProperties, $psError) = @_;
####################################################################
#
# Make sure that required inputs are defined.
#
####################################################################
my @aKeys =
(
'ClientFilename',
'ClientId',
'CommonRegexes',
'GetTriggerCommandLine',
'JobId',
'RemoteAddress',
'ServerId',
'TriggerEpoch',
'UseGMT',
);
if (!defined(VerifyHashKeys($phProperties, \@aKeys)))
{
$$psError = "Unable to proceed due to missing or undefined inputs";
return undef;
}
####################################################################
#
# Create conversion values.
#
####################################################################
my
(
$sSecond,
$sMinute,
$sHour,
$sMonthDay,
$sMonth,
$sYear,
$sWeekDay,
$sYearDay,
$sDaylightSavings,
) = ($$phProperties{'UseGMT'} =~ /^[Yy]$/) ? gmtime($$phProperties{'TriggerEpoch'}) : localtime($$phProperties{'TriggerEpoch'});
my %hConversionValues =
(
'CID' => $$phProperties{'ClientId'}, # This is a legacy token, and it is being phased out.
'cid' => $$phProperties{'ClientId'},
'CMD' => $$phProperties{'ClientFilename'}, # This is a legacy token, and it is being phased out.
'cmd' => $$phProperties{'ClientFilename'},
'd' => sprintf("%02d", $sMonthDay),
'H' => sprintf("%02d", $sHour),
'IP' => $$phProperties{'RemoteAddress'}, # This is a legacy token, and it is being phased out.
'ip' => $$phProperties{'RemoteAddress'},
'jid' => $$phProperties{'JobId'},
'M' => sprintf("%02d", $sMinute),
'm' => sprintf("%02d", $sMonth + 1),
'PID' => sprintf("%05d", $$), # This is a legacy token, and it is being phased out.
'pid' => sprintf("%05d", $$),
'S' => sprintf("%02d", $sSecond),
's' => sprintf("%010u", $$phProperties{'TriggerEpoch'}),
'SID' => $$phProperties{'ServerId'}, # This is a legacy token, and it is being phased out.
'sid' => $$phProperties{'ServerId'},
'Y' => sprintf("%04d", $sYear + 1900),
);
####################################################################
#
# Verify conversion values.
#
####################################################################
my ($sLocalError);
my %hConversionChecks =
(
'CID' => $$phProperties{'CommonRegexes'}{'ClientId'}, # This is a legacy token, and it is being phased out.
'cid' => $$phProperties{'CommonRegexes'}{'ClientId'},
'CMD' => $$phProperties{'CommonRegexes'}{'ClientSuppliedFilename'}, # This is a legacy token, and it is being phased out.
'cmd' => $$phProperties{'CommonRegexes'}{'ClientSuppliedFilename'},
'd' => $$phProperties{'CommonRegexes'}{'strftime_d'},
'H' => $$phProperties{'CommonRegexes'}{'strftime_H'},
'IP' => $$phProperties{'CommonRegexes'}{'Ip'}, # This is a legacy token, and it is being phased out.
'ip' => $$phProperties{'CommonRegexes'}{'Ip'},
'jid' => $$phProperties{'CommonRegexes'}{'JobId'},
'M' => $$phProperties{'CommonRegexes'}{'strftime_M'},
'm' => $$phProperties{'CommonRegexes'}{'strftime_m'},
'PID' => $$phProperties{'CommonRegexes'}{'ProcessId'}, # This is a legacy token, and it is being phased out.
'pid' => $$phProperties{'CommonRegexes'}{'ProcessId'},
'S' => $$phProperties{'CommonRegexes'}{'strftime_S'},
's' => $$phProperties{'CommonRegexes'}{'strftime_s'},
'SID' => $$phProperties{'CommonRegexes'}{'ClientId'}, # This is a legacy token, and it is being phased out.
'sid' => $$phProperties{'CommonRegexes'}{'ClientId'},
'Y' => $$phProperties{'CommonRegexes'}{'strftime_Y'},
);
if (!defined(VerifyConversionValues(\%hConversionValues, \%hConversionChecks, \$sLocalError)))
{
$$psError = $sLocalError;
return undef;
}
####################################################################
#
# Expand conversion values.
#
####################################################################
my $sTriggerCommandLine = ExpandConversionString($$phProperties{'GetTriggerCommandLine'}, \%hConversionValues, \$sLocalError);
if (!defined($sTriggerCommandLine))
{
$$psError = $sLocalError;
return undef;
}
return $sTriggerCommandLine;
}
######################################################################
#
# ExpandPutTriggerCommandLine
#
######################################################################
sub ExpandPutTriggerCommandLine
{
my ($phProperties, $psError) = @_;
####################################################################
#
# Make sure that required inputs are defined.
#
####################################################################
my @aKeys =
(
'ClientFilename',
'ClientId',
'CommonRegexes',
'EnvFile',
'ErrFile',
'LckFile',
'PutTriggerCommandLine',
'JobId',
'OutFile',
'RdyFile',
'RemoteAddress',
'ServerId',
'TriggerEpoch',
'UseGMT',
);
if (!defined(VerifyHashKeys($phProperties, \@aKeys)))
{
$$psError = "Unable to proceed due to missing or undefined inputs";
return undef;
}
####################################################################
#
# Create conversion values.
#
####################################################################
my
(
$sSecond,
$sMinute,
$sHour,
$sMonthDay,
$sMonth,
$sYear,
$sWeekDay,
$sYearDay,
$sDaylightSavings,
) = ($$phProperties{'UseGMT'} =~ /^[Yy]$/) ? gmtime($$phProperties{'TriggerEpoch'}) : localtime($$phProperties{'TriggerEpoch'});
my %hConversionValues =
(
'CID' => $$phProperties{'ClientId'}, # This is a legacy token, and it is being phased out.
'cid' => $$phProperties{'ClientId'},
'CMD' => $$phProperties{'ClientFilename'}, # This is a legacy token, and it is being phased out.
'cmd' => $$phProperties{'ClientFilename'},
'd' => sprintf("%02d", $sMonthDay),
'env' => $$phProperties{'EnvFile'},
'err' => $$phProperties{'ErrFile'},
'H' => sprintf("%02d", $sHour),
'IP' => $$phProperties{'RemoteAddress'}, # This is a legacy token, and it is being phased out.
'ip' => $$phProperties{'RemoteAddress'},
'jid' => $$phProperties{'JobId'},
'lck' => $$phProperties{'LckFile'},
'M' => sprintf("%02d", $sMinute),
'm' => sprintf("%02d", $sMonth + 1),
'out' => $$phProperties{'OutFile'},
'PID' => sprintf("%05d", $$), # This is a legacy token, and it is being phased out.
'pid' => sprintf("%05d", $$),
'rdy' => $$phProperties{'RdyFile'},
'S' => sprintf("%02d", $sSecond),
's' => sprintf("%010u", $$phProperties{'TriggerEpoch'}),
'SID' => $$phProperties{'ServerId'}, # This is a legacy token, and it is being phased out.
'sid' => $$phProperties{'ServerId'},
'Y' => sprintf("%04d", $sYear + 1900),
);
####################################################################
#
# Verify conversion values.
#
####################################################################
my ($sLocalError);
my %hConversionChecks =
(
'CID' => $$phProperties{'CommonRegexes'}{'ClientId'}, # This is a legacy token, and it is being phased out.
'cid' => $$phProperties{'CommonRegexes'}{'ClientId'},
'CMD' => $$phProperties{'CommonRegexes'}{'ClientSuppliedFilename'}, # This is a legacy token, and it is being phased out.
'cmd' => $$phProperties{'CommonRegexes'}{'ClientSuppliedFilename'},
'd' => $$phProperties{'CommonRegexes'}{'strftime_d'},
'env' => $$phProperties{'CommonRegexes'}{'ServerSuppliedPath'},
'err' => $$phProperties{'CommonRegexes'}{'ServerSuppliedPath'},
'H' => $$phProperties{'CommonRegexes'}{'strftime_H'},
'IP' => $$phProperties{'CommonRegexes'}{'Ip'}, # This is a legacy token, and it is being phased out.
'ip' => $$phProperties{'CommonRegexes'}{'Ip'},
'jid' => $$phProperties{'CommonRegexes'}{'JobId'},
'lck' => $$phProperties{'CommonRegexes'}{'ServerSuppliedPath'},
'M' => $$phProperties{'CommonRegexes'}{'strftime_M'},
'm' => $$phProperties{'CommonRegexes'}{'strftime_m'},
'out' => $$phProperties{'CommonRegexes'}{'ServerSuppliedPath'},
'PID' => $$phProperties{'CommonRegexes'}{'ProcessId'}, # This is a legacy token, and it is being phased out.
'pid' => $$phProperties{'CommonRegexes'}{'ProcessId'},
'rdy' => $$phProperties{'CommonRegexes'}{'ServerSuppliedPath'},
'S' => $$phProperties{'CommonRegexes'}{'strftime_S'},
's' => $$phProperties{'CommonRegexes'}{'strftime_s'},
'SID' => $$phProperties{'CommonRegexes'}{'ClientId'}, # This is a legacy token, and it is being phased out.
'sid' => $$phProperties{'CommonRegexes'}{'ClientId'},
'Y' => $$phProperties{'CommonRegexes'}{'strftime_Y'},
);
if (!defined(VerifyConversionValues(\%hConversionValues, \%hConversionChecks, \$sLocalError)))
{
$$psError = $sLocalError;
return undef;
}
####################################################################
#
# Expand conversion values.
#
####################################################################
my $sTriggerCommandLine = ExpandConversionString($$phProperties{'PutTriggerCommandLine'}, \%hConversionValues, \$sLocalError);
if (!defined($sTriggerCommandLine))
{
$$psError = $sLocalError;
return undef;
}
return $sTriggerCommandLine;
}
######################################################################
#
# GetKeysAndValues
#
######################################################################
sub GetKeysAndValues
{
my ($sFile, $phValidKeys, $phKeyValuePairs, $psError) = @_;
####################################################################
#
# Make sure that required inputs are defined.
#
####################################################################
if (!defined($sFile) || !defined($phValidKeys) || !defined($phKeyValuePairs))
{
$$psError = "Unable to proceed due to missing or undefined inputs" if (defined($psError));
return undef;
}
####################################################################
#
# Open properties file.
#
####################################################################
if (!open(FH, "< $sFile"))
{
$$psError = "File ($sFile) could not be opened ($!)" if (defined($psError));
return undef;
}
####################################################################
#
# Read properties file. Ignore case (when evaluating keys), unknown
# keys, comments, and blank lines. Note: If $phValidKeys is empty,
# then nothing will be returned.
#
####################################################################
while (my $sLine = <FH>)
{
$sLine =~ s/[\r\n]+$//; # Remove CRs and LFs.
$sLine =~ s/#.*$//; # Remove comments.
if ($sLine !~ /^\s*$/)
{
my ($sKey, $sValue) = ($sLine =~ /^([^=]*)=(.*)$/);
$sKey =~ s/^\s+//; # Remove leading whitespace.
$sKey =~ s/\s+$//; # Remove trailing whitespace.
$sValue =~ s/^\s+//; # Remove leading whitespace.
$sValue =~ s/\s+$//; # Remove trailing whitespace.
if (defined($sKey) && length($sKey))
{
foreach my $sKnownKey (keys(%$phValidKeys))
{
if ($sKey =~ /^$sKnownKey$/i)
{
$$phKeyValuePairs{$sKnownKey} = $sValue;
}
}
}
}
}
close(FH);
1;
}
######################################################################
#
# GetCustomConfigProperties
#
######################################################################
sub GetCustomConfigProperties
{
my ($phProperties, $phTemplate, $psError) = @_;
####################################################################
#
# Make sure that required inputs are defined.
#
####################################################################
foreach my $sInput ($phProperties, $phTemplate, $psError)
{
if (!defined($sInput))
{
$$psError = "Unable to proceed due to missing or undefined inputs" if (defined($psError));
return undef;
}
}
####################################################################
#
# Make sure that required keys and values are defined.
#
####################################################################
my @aKeys =
(
'ClientFilename',
'ClientId',
'ConfigDirectory',
'ConfigSearchOrder',
);
if (!defined(VerifyHashKeys($phProperties, \@aKeys)))
{
$$psError = "Unable to proceed due to missing or undefined inputs";
return undef;
}
####################################################################
#
# Search for custom config files using the specified order. As each
# config file is processed, its values trump those of any that came
# before -- including any values that came from global config files.
#
####################################################################
foreach my $sFolder (split(/:/, $$phProperties{'ConfigSearchOrder'}))
{
##################################################################
#
# The first config file defined by this loop applies globally.
# The second applies to a particular client or command, and the
# third applies to a particular client/command pair.
#
##################################################################
my ($sFile1, $sFile2, $sFile3);
$sFile1 = $sFile2 = $sFile3 = $$phProperties{'ConfigDirectory'} . "/" . $sFolder . "/";
if ($sFolder =~ /^clients$/)
{
$sFile1 .= "nph-webjob.cfg";
$sFile2 .= $$phProperties{'ClientId'} . "/" . "nph-webjob.cfg";
$sFile3 .= $$phProperties{'ClientId'} . "/" . $$phProperties{'ClientFilename'} . "/" . "nph-webjob.cfg";
}
elsif ($sFolder =~ /^commands$/)
{
$sFile1 .= "nph-webjob.cfg";
$sFile2 .= $$phProperties{'ClientFilename'} . "/" . "nph-webjob.cfg";
$sFile3 .= $$phProperties{'ClientFilename'} . "/" . $$phProperties{'ClientId'} . "/" . "nph-webjob.cfg";
}
else
{
next; # Ignore invalid directories.
}
foreach my $sFile ($sFile1, $sFile2, $sFile3)
{
################################################################
#
# Pull in any externally defined properties according to the
# specified template. If the template is empty, no properties
# will be returned.
#
################################################################
my (%hProperties);
GetKeysAndValues($sFile, $phTemplate, \%hProperties, undef);
################################################################
#
# Validate properties according to the specified template. If
# the template is empty, nothing happens here. Properties that
# don't pass muster are deleted.
#
################################################################
foreach my $sProperty (keys(%$phTemplate))
{
my $sValue = $hProperties{$sProperty};
if (!defined($sValue) || $sValue !~ /$$phTemplate{$sProperty}/)
{
delete($hProperties{$sProperty});
}
}
################################################################
#
# Transfer validated properties, if any, to the main hash. This
# is where the trump action takes place.
#
################################################################
foreach my $sProperty (keys(%hProperties))
{
$$phProperties{$sProperty} = $hProperties{$sProperty};
}
}
}
1;
}
######################################################################
#
# GetGlobalConfigProperties
#
######################################################################
sub GetGlobalConfigProperties
{
my ($phProperties, $phSiteProperties, $psError) = @_;
####################################################################
#
# BaseDirectory is the epicenter of activity.
#
####################################################################
$$phProperties{'BaseDirectory'} = "/var/webjob";
####################################################################
#
# CapContentLength forces the script to abort when ContentLength
# exceeds MaxContentLength.
#
####################################################################
$$phProperties{'CapContentLength'} = "N"; # [Y|N]
####################################################################
#
# ConfigSearchOrder specifies the order in which custom config
# files are sought out and processed. Custom config files may be
# used to override a predefined subset of the site-specific
# properties. The following tree enumerates the locations where
# global and custom config files may exist.
#
# config
# |
# + nph-webjob
# |
# - nph-webjob.cfg # applies globally
# |
# + clients
# | |
# | - nph-webjob.cfg # applies globally
# | |
# | + <client-N>
# | |
# | - nph-webjob.cfg # applies to all commands for <client-N>
# | |
# | + <command-N>
# | |
# | - nph-webjob.cfg # applies only to <client-N>/<command-N>
# |
# + commands
# |
# - nph-webjob.cfg # applies globally
# |
# + <command-N>
# |
# - nph-webjob.cfg # applies to all clients for <command-N>
# |
# + <client-N>
# |
# - nph-webjob.cfg # applies only to <command-N>/<client-N>
#
# As each config file is processed, its values trump those of any
# that came before -- including any values that came form global
# config files. Supported values for this variable are "clients",
# "commands", "clients:commands", and "commands:clients".
#
####################################################################
$$phProperties{'ConfigSearchOrder'} = "clients:commands";
####################################################################
#
# DsvMaxSignatureLength specifies the maximum signature length that
# the script is willing to allow. If the signature length exceeds
# this limit (in bytes), the script will abort.
#
####################################################################
$$phProperties{'DsvMaxSignatureLength'} = 256;
####################################################################
#
# When active, DsvRequireSignatures forces the script to abort if
# no signature file is found, or if the signature does not meet
# basic syntax checks. A signature file must have the same basename
# as the requested payload, and its suffix must match the value
# defined by DsvSignatureSuffix.
#
####################################################################
$$phProperties{'DsvRequireSignatures'} = "N"; # [Y|N]
####################################################################
#
# DsvSignatureSuffix specifies the suffix assigned to and used by
# signature files. A signature file must have the same basename as
# the requested payload, and its suffix must match the value
# defined by this property.
#
####################################################################
$$phProperties{'DsvSignatureSuffix'} = ".sig";
####################################################################
#
# When active, EnableConfigOverrides causes the script to seek
# out and process additional client- and/or command-specific config
# files (see ConfigSearchOrder).
#
####################################################################
$$phProperties{'EnableConfigOverrides'} = "Y"; # [Y|N]
####################################################################
#
# When active, EnableJobIds forces the script to generate a job id
# for each GET request. EnableJobIds will also force the script to
# abort if a PUT request does not contain a valid job id.
#
####################################################################
$$phProperties{'EnableJobIds'} = "Y"; # [Y|N]
####################################################################
#
# When active, EnableLogging forces the script to generate a log
# message for each request. If the designated LogFile can not be
# opened, the log message will be written to STDERR.
#
####################################################################
$$phProperties{'EnableLogging'} = "Y"; # [Y|N]
####################################################################
#
# FolderList specifies locations where shared programs can be found.
# If a requested file does not exist in a given client's commands
# directory, the FolderList is searched according to the order given
# here. The list delimiter is a colon (e.g., "common:shared").
#
####################################################################
$$phProperties{'FolderList'} = "common";
####################################################################
#
# GetTriggerCommandLine is a string consisting of zero or more
# conversion specifications optionally interspersed with zero or
# more plain text characters. The following conversion
# specifications are supported:
#
# %CID = Alias for %cid (legacy token)
# %cid = Client ID as a string
# %CMD = Alias for %cmd (legacy token)
# %cmd = Client-requested command as a string
# %d = Day of the month as a decimal number (01-31)
# %H = Hour as a decimal number (00-23)
# %jid = Job ID as a string
# %IP = Alias for %ip (legacy token)
# %ip = IP address as a dotted quad string
# %M = Minute as a decimal number (00-59)
# %m = Month as a decimal number (01-12)
# %PID = Alias for %pid (legacy token)
# %pid = Process ID of server-side CGI script
# %S = Second as a decimal number (00-60)
# %s = Number of seconds since the Epoch
# %SID = Alias for %sid (legacy token)
# %sid = Server ID as a string
# %Y = Year with century as a decimal number
#
# For example, the following string:
#
# echo "%Y-%m-%d %H:%M:%S GET %jid %cid" >> /var/log/%cid.jids
#
# will append the current date, time, request method, job ID, and
# client ID to a client-specific file in /var/log.
#
# If the specified command is an empty string, then the trigger
# mechanism is (effectively) disabled, and the condition is logged.
# However, if the trigger is disabled (i.e., GetTriggerEnable=N),
# then this control is ignored.
#
# Note: Triggers are not currently supported on Windows platforms.
#
####################################################################
$$phProperties{'GetTriggerCommandLine'} = "";
####################################################################
#
# When active, GetTriggerEnable causes the script to execute the
# command line specified by GetTriggerCommandLine. The behavior of
# the trigger mechanism is to launch a subprocess and continue with
# the main line of execution. In particular, the script will not
# block or wait for the subprocess to finish, nor will it attempt
# check the status or cleanup after the subprocess. The trigger
# mechanism is highly configurable -- config file overrides are
# fully supported, multiple conversion tokens are available, and the
# user determines what, if any, commands are executed when the
# trigger is pulled. Currently, triggers are only pulled if they are
# enabled, a trigger command has been defined, and the HTTP status
# code is 200.
#
# Note: Triggers are not currently supported on Windows platforms.
#
####################################################################
$$phProperties{'GetTriggerEnable'} = "N"; # [Y|N]
####################################################################
#
# MaxContentLength specifies the largest upload in bytes the script
# will accept. If CapContentLength is disabled, this control has no
# effect.
#
####################################################################
$$phProperties{'MaxContentLength'} = 100000000; # 100 MB
####################################################################
#
# When active, OverwriteExistingFiles forces the script to unlink
# existing files prior to writing the uploaded data. The default
# PutNameFormat used by this script attempts to prevent filename
# collisions. However, that behavior is user-defined, and in some
# cases, it may be desirable to specify a PutNameFormat that is
# guaranteed to create collisions. In those situations, this
# control must be enabled to produce the desired outcome (i.e.,
# allow existing files with the same name to be overwritten).
#
####################################################################
$$phProperties{'OverwriteExistingFiles'} = "N"; # [Y|N]
####################################################################
#
# PutNameFormat controls how files are named/saved in the incoming
# directory. In other words, it controls the directory's layout.
# Basically, PutNameFormat is a format string consisting of zero or
# more conversion specifications optionally interspersed with zero
# or more plain text characters. The following conversion
# specifications are supported:
#
# %CID = Alias for %cid (legacy token)
# %cid = Client ID as a string
# %CMD = Alias for %cmd (legacy token)
# %cmd = Client-requested command as a string
# %d = Day of the month as a decimal number (01-31)
# %H = Hour as a decimal number (00-23)
# %IP = Alias for %ip (legacy token)
# %ip = IP address as a dotted quad string
# %M = Minute as a decimal number (00-59)
# %m = Month as a decimal number (01-12)
# %PID = Alias for %pid (legacy token)
# %pid = Process ID of server-side CGI script
# %S = Second as a decimal number (00-60)
# %s = Number of seconds since the Epoch
# %SID = Alias for %sid (legacy token)
# %sid = Server ID as a string
# %Y = Year with century as a decimal number
#
# For example, the following format string:
#
# "%cmd/%ip_%Y-%m-%d_%H.%M.%S"
#
# will cause uploaded files to be stored in sub-directories that
# correspond to the name of the command executed, and each output
# filename will consist of an IP address, date, and time.
#
# The added flexibility provided by this scheme means that it is
# possible to create format strings that are problematic. Consider
# the following string:
#
# "%cid/%cmd"
#
# While this is a legal format string, it is likely to cause name
# collisions (e.g., the same client runs the same command two or
# more times). Therefore, it is important to create format strings
# that contain enough job specific information to distinguish one
# set of uploaded files from another.
#
####################################################################
$$phProperties{'PutNameFormat'} = "%cid_%Y%m%d%H%M%S_%pid_%cmd";
####################################################################
#
# PutTriggerCommandLine is a string consisting of zero or more
# conversion specifications optionally interspersed with zero or
# more plain text characters. The following conversion
# specifications are supported:
#
# %CID = Alias for %cid (legacy token)
# %cid = Client ID as a string
# %CMD = Alias for %cmd (legacy token)
# %cmd = Client-requested command as a string
# %d = Day of the month as a decimal number (01-31)
# %env = Full path to .env file as a string
# %err = Full path to .err file as a string
# %H = Hour as a decimal number (00-23)
# %jid = Job ID as a string
# %IP = Alias for %ip (legacy token)
# %ip = IP address as a dotted quad string
# %lck = Full path to .lck file as a string
# %M = Minute as a decimal number (00-59)
# %m = Month as a decimal number (01-12)
# %out = Full path to .out file as a string
# %PID = Alias for %pid (legacy token)
# %pid = Process ID of server-side CGI script
# %rdy = Full path to .rdy file as a string
# %S = Second as a decimal number (00-60)
# %s = Number of seconds since the Epoch
# %SID = Alias for %sid (legacy token)
# %sid = Server ID as a string
# %Y = Year with century as a decimal number
#
# For example, the following string:
#
# echo "%Y-%m-%d %H:%M:%S PUT %jid %cid" >> /var/log/%cid.jids
#
# will append the current date, time, request method, job ID, and
# client ID to a client-specific file in /var/log.
#
# If the specified command is an empty string, then the trigger
# mechanism is (effectively) disabled, and the condition is logged.
# However, if the trigger is disabled (i.e., PutTriggerEnable=N),
# then this control is ignored.
#
# Note: Triggers are not currently supported on Windows platforms.
#
####################################################################
$$phProperties{'PutTriggerCommandLine'} = "";
####################################################################
#
# When active, PutTriggerEnable causes the script to execute the
# command line specified by PutTriggerCommandLine. The behavior of
# the trigger mechanism is to launch a subprocess and continue with
# the main line of execution. In particular, the script will not
# block or wait for the subprocess to finish, nor will it attempt
# check the status or cleanup after the subprocess. The trigger
# mechanism is highly configurable -- config file overrides are
# fully supported, multiple conversion tokens are available, and the
# user determines what, if any, commands are executed when the
# trigger is pulled. Currently, triggers are only pulled if they are
# enabled, a trigger command has been defined, and the HTTP status
# code is 200.
#
# Note: Triggers are not currently supported on Windows platforms.
#
####################################################################
$$phProperties{'PutTriggerEnable'} = "N"; # [Y|N]
####################################################################
#
# RequireMatch forces the script to abort unless ClientId matches
# RemoteUser. When this value is disabled, any authenticated user
# will be allowed to issue requests for a given client. Disabling
# RequireUser implicitly disables RequireMatch.
#
####################################################################
$$phProperties{'RequireMatch'} = "Y"; # [Y|N]
####################################################################
#
# RequireUser forces the script to abort unless RemoteUser has been
# set.
#
####################################################################
$$phProperties{'RequireUser'} = "Y"; # [Y|N]
####################################################################
#
# ServerId specifies the identity assigned to the WebJob server.
#
####################################################################
$$phProperties{'ServerId'} = "server_1";
####################################################################
#
# SslRequireCn forces the script to abort unless SslClientSDnCn has
# been set. If SslRequireSsl is disabled, this and all other SSL
# controls are ignored.
#
####################################################################
$$phProperties{'SslRequireCn'} = "N"; # [Y|N]
####################################################################
#
# SslRequireMatch forces the script to abort if ClientId does not
# match SslClientSDnCn. When this control is disabled, access will
# be governed by RequireMatch. Disabling SslRequireCn implicitly
# disables SslRequireMatch. Also, if SslRequireSsl is disabled,
# this and all other SSL controls are ignored. The SslRequireMatch
# check is performed prior to (not instead of) the RequireMatch
# check.
#
####################################################################
$$phProperties{'SslRequireMatch'} = "N"; # [Y|N]
####################################################################
#
# SslRequireSsl forces the script to abort unless the client is
# speaking HTTPS. Disabling SslRequireSsl implicitly disables
# all SSL-related controls.
#
####################################################################
$$phProperties{'SslRequireSsl'} = "Y"; # [Y|N]
####################################################################
#
# When active, UseGMT forces the script to convert all time values
# to GMT. Otherwise, time values are converted to local time.
#
####################################################################
$$phProperties{'UseGMT'} = "N"; # [Y|N]
####################################################################
#
# Pull in any externally defined properties. These properties trump
# internally defined properties.
#
####################################################################
if (!exists($$phProperties{'PropertiesFile'}) || !defined($$phProperties{'PropertiesFile'}))
{
$$phProperties{'PropertiesFile'} = $$phProperties{'BaseDirectory'} . "/config/nph-webjob/nph-webjob.cfg";
}
GetKeysAndValues($$phProperties{'PropertiesFile'}, $phSiteProperties, $phProperties, undef);
1;
}
######################################################################
#
# LogMessage
#
######################################################################
sub LogMessage
{
my ($phProperties) = @_;
####################################################################
#
# Create date/time stamp and calculate duration.
#
####################################################################
my
(
$sSecond,
$sMinute,
$sHour,
$sMonthDay,
$sMonth,
$sYear,
$sWeekDay,
$sYearDay,
$sDaylightSavings
) = ($$phProperties{'UseGMT'} =~ /^[Yy]$/) ? gmtime($$phProperties{'StopTime'}) : localtime($$phProperties{'StopTime'});
$$phProperties{'DateTime'} = sprintf("%04s-%02s-%02s %02s:%02s:%02s",
$sYear + 1900,
$sMonth + 1,
$sMonthDay,
$sHour,
$sMinute,
$sSecond
);
$$phProperties{'Duration'} = $$phProperties{'StopTime'} - $$phProperties{'StartTime'};
####################################################################
#
# Construct log message.
#
####################################################################
my (@aLogFields, @aOutputFields, $sLogMessage);
@aLogFields =
(
'DateTime',
'JobId',
'RemoteUser',
'RemoteAddress',
'RequestMethod',
'ClientId',
'ClientFilename',
'ContentLength',
'ServerContentLength',
'Duration',
'ReturnStatus',
'ErrorMessage'
);
foreach my $sField (@aLogFields)
{
my $sValue = $$phProperties{$sField};
if ($sField =~ /^ErrorMessage$/)
{
push(@aOutputFields, ((defined($sValue) && length($sValue)) ? "-- $sValue" : "--"));
}
else
{
push(@aOutputFields, ((defined($sValue) && length($sValue)) ? "$sValue" : "-"));
}
}
$sLogMessage = join(" ", @aOutputFields);
####################################################################
#
# Deliver log message.
#
####################################################################
if (!open(LH, ">> " . $$phProperties{'LogFile'}))
{
print STDERR $sLogMessage, $$phProperties{'Newline'};
return undef;
}
binmode(LH);
flock(LH, LOCK_EX);
print LH $sLogMessage, $$phProperties{'Newline'};
flock(LH, LOCK_UN);
close(LH);
1;
}
######################################################################
#
# MakePutName
#
######################################################################
sub MakePutName
{
my ($phProperties, $psError) = @_;
####################################################################
#
# Make sure that required inputs are defined.
#
####################################################################
my @aKeys =
(
'ClientFilename',
'ClientId',
'CommonRegexes',
'PutNameFormat',
'RemoteAddress',
'ServerId',
'StartTime',
'UseGMT',
);
if (!defined(VerifyHashKeys($phProperties, \@aKeys)))
{
$$psError = "Unable to proceed due to missing or undefined inputs";
return undef;
}
####################################################################
#
# Create conversion values.
#
####################################################################
my
(
$sSecond,
$sMinute,
$sHour,
$sMonthDay,
$sMonth,
$sYear,
$sWeekDay,
$sYearDay,
$sDaylightSavings
) = ($$phProperties{'UseGMT'} =~ /^[Yy]$/) ? gmtime($$phProperties{'StartTime'}) : localtime($$phProperties{'StartTime'});
my %hConversionValues =
(
'CID' => $$phProperties{'ClientId'}, # This is a legacy token, and it is being phased out.
'cid' => $$phProperties{'ClientId'},
'CMD' => $$phProperties{'ClientFilename'}, # This is a legacy token, and it is being phased out.
'cmd' => $$phProperties{'ClientFilename'},
'IP' => $$phProperties{'RemoteAddress'}, # This is a legacy token, and it is being phased out.
'ip' => $$phProperties{'RemoteAddress'},
'Y' => sprintf("%04d", $sYear + 1900),
'm' => sprintf("%02d", $sMonth + 1),
'd' => sprintf("%02d", $sMonthDay),
'H' => sprintf("%02d", $sHour),
'M' => sprintf("%02d", $sMinute),
'PID' => sprintf("%05d", $$), # This is a legacy token, and it is being phased out.
'pid' => sprintf("%05d", $$),
'S' => sprintf("%02d", $sSecond),
's' => sprintf("%010u", $$phProperties{'StartTime'}),
'SID' => $$phProperties{'ServerId'}, # This is a legacy token, and it is being phased out.
'sid' => $$phProperties{'ServerId'},
);
####################################################################
#
# Verify conversion values.
#
####################################################################
my ($sLocalError);
my %hConversionChecks =
(
'CID' => $$phProperties{'CommonRegexes'}{'ClientId'}, # This is a legacy token, and it is being phased out.
'cid' => $$phProperties{'CommonRegexes'}{'ClientId'},
'CMD' => $$phProperties{'CommonRegexes'}{'ClientSuppliedFilename'}, # This is a legacy token, and it is being phased out.
'cmd' => $$phProperties{'CommonRegexes'}{'ClientSuppliedFilename'},
'd' => $$phProperties{'CommonRegexes'}{'strftime_d'},
'H' => $$phProperties{'CommonRegexes'}{'strftime_H'},
'IP' => $$phProperties{'CommonRegexes'}{'Ip'}, # This is a legacy token, and it is being phased out.
'ip' => $$phProperties{'CommonRegexes'}{'Ip'},
'M' => $$phProperties{'CommonRegexes'}{'strftime_M'},
'm' => $$phProperties{'CommonRegexes'}{'strftime_m'},
'PID' => $$phProperties{'CommonRegexes'}{'ProcessId'}, # This is a legacy token, and it is being phased out.
'pid' => $$phProperties{'CommonRegexes'}{'ProcessId'},
'S' => $$phProperties{'CommonRegexes'}{'strftime_S'},
's' => $$phProperties{'CommonRegexes'}{'strftime_s'},
'SID' => $$phProperties{'CommonRegexes'}{'ClientId'}, # This is a legacy token, and it is being phased out.
'sid' => $$phProperties{'CommonRegexes'}{'ClientId'},
'Y' => $$phProperties{'CommonRegexes'}{'strftime_Y'},
);
if (!defined(VerifyConversionValues(\%hConversionValues, \%hConversionChecks, \$sLocalError)))
{
$$psError = $sLocalError;
return undef;
}
####################################################################
#
# Expand conversion values.
#
####################################################################
my $sPutName = ExpandConversionString($$phProperties{'PutNameFormat'}, \%hConversionValues, \$sLocalError);
if (!defined($sPutName))
{
$$psError = $sLocalError;
return undef;
}
return $sPutName;
}
######################################################################
#
# MakePutTree
#
######################################################################
sub MakePutTree
{
my ($sIncomingDirectory, $sPutName, $sMode, $sPopCount, $psError) = @_;
####################################################################
#
# Pop the specified number of elements from PutName. Normally, only
# the trailing filename is removed (i.e. PopCount = 1).
#
####################################################################
my (@aElements);
@aElements = split(/[\/\\]/, $sPutName);
while (defined($sPopCount) && $sPopCount-- > 0)
{
pop(@aElements);
}
####################################################################
#
# Create the tree -- one element at a time.
#
####################################################################
my ($sPath);
$sPath = $sIncomingDirectory;
foreach my $sElement (@aElements)
{
$sPath .= "/$sElement";
if (!-d $sPath)
{
if (!mkdir($sPath, $sMode))
{
$$psError = "Directory ($sPath) could not be created ($!)";
return undef;
}
}
}
1;
}
######################################################################
#
# ProcessGetRequest
#
######################################################################
sub ProcessGetRequest
{
my ($phProperties, $psError) = @_;
####################################################################
#
# Proceed only if QueryString matches the GetQuery expression.
#
####################################################################
my $sQueryString = URLDecode($$phProperties{'QueryString'});
if ($sQueryString =~ /^$$phProperties{'CustomRegexes'}{'GetQuery'}$/)
{
$$phProperties{'ClientVersion'} = $1;
$$phProperties{'ClientSystem'} = $2;
$$phProperties{'ClientId'} = $3 || "nobody";
$$phProperties{'ClientFilename'} = $4;
##################################################################
#
# Bring in any client- and/or command-specific properties.
#
##################################################################
my ($sLocalError);
if ($$phProperties{'EnableConfigOverrides'} =~ /^[Yy]$/)
{
GetCustomConfigProperties($phProperties, \%{$$phProperties{'CustomConfigTemplate'}}, \$sLocalError);
}
##################################################################
#
# Conditionally do CommonName and client ID checks.
#
##################################################################
if ($$phProperties{'SslRequireSsl'} =~ /^[Yy]$/)
{
if ($$phProperties{'SslRequireCn'} =~ /^[Yy]$/ && (!defined($$phProperties{'SslClientSDnCn'}) || !length($$phProperties{'SslClientSDnCn'})))
{
$$psError = "CommonName is undefined or null";
return 470;
}
if ($$phProperties{'SslRequireCn'} =~ /^[Yy]$/ && $$phProperties{'SslRequireMatch'} =~ /^[Yy]$/ && $$phProperties{'SslClientSDnCn'} ne $$phProperties{'ClientId'})
{
$$psError = "CommonName ($$phProperties{'SslClientSDnCn'}) does not match client ID ($$phProperties{'ClientId'})";
return 471;
}
}
##################################################################
#
# Do username and client ID checks.
#
##################################################################
if ($$phProperties{'RequireUser'} =~ /^[Yy]$/ && (!defined($$phProperties{'RemoteUser'}) || !length($$phProperties{'RemoteUser'})))
{
$$psError = "Remote user is undefined or null";
return 452;
}
if ($$phProperties{'RequireUser'} =~ /^[Yy]$/ && $$phProperties{'RequireMatch'} =~ /^[Yy]$/ && $$phProperties{'RemoteUser'} ne $$phProperties{'ClientId'})
{
$$psError = "Remote user ($$phProperties{'RemoteUser'}) does not match client ID ($$phProperties{'ClientId'})";
return 453;
}
##################################################################
#
# Do content length checks.
#
##################################################################
if (!defined($$phProperties{'ContentLength'}) || !length($$phProperties{'ContentLength'}))
{
$$psError = "Content length is undefined or null";
return 454;
}
if ($$phProperties{'CapContentLength'} =~ /^[Yy]$/ && $$phProperties{'ContentLength'} > $$phProperties{'MaxContentLength'})
{
$$psError = "Content length ($$phProperties{'ContentLength'}) exceeds maximum allowed length ($$phProperties{'MaxContentLength'})";
return 455;
}
##################################################################
#
# Locate the requested file and serve it up. Start by searching
# the client's commands directory. Then, move on to the shared
# folders.
#
##################################################################
my $sEffectiveFolderList = $$phProperties{'ClientId'} . ":" . $$phProperties{'FolderList'};
foreach my $sFolder (split(/:/, $sEffectiveFolderList))
{
my $sGetFile = $$phProperties{'ProfilesDirectory'} . "/" . $sFolder . "/" . "commands" . "/" . $$phProperties{'ClientFilename'};
if (-e $sGetFile)
{
my $sSigFile = $sGetFile . $$phProperties{'DsvSignatureSuffix'};
if (-f $sSigFile && -s _ && open(FH, "< $sSigFile"))
{
binmode(FH);
$$phProperties{'DsvPayloadSignature'} = <FH>; # This file should only contain one line.
$$phProperties{'DsvPayloadSignature'} =~ s/[\r\n]*$//;
if
(
$$phProperties{'DsvPayloadSignature'} !~ /^$$phProperties{'CommonRegexes'}{'Base64'}$/ ||
length($$phProperties{'DsvPayloadSignature'}) > $$phProperties{'DsvMaxSignatureLength'}
)
{
$$phProperties{'DsvPayloadSignature'} = undef;
}
close(FH);
}
else
{
$$phProperties{'DsvPayloadSignature'} = undef;
}
if ($$phProperties{'DsvRequireSignatures'} =~ /^[Yy]$/ && !defined($$phProperties{'DsvPayloadSignature'}))
{
$$psError = "Payload signature ($sSigFile) could not be opened, does not exist, contains invalid data, or is not the correct length";
return 459;
}
if (!open(FH, "< $sGetFile"))
{
$$psError = "Requested file ($sGetFile) could not be opened ($!)";
return 457;
}
binmode(FH);
$$phProperties{'ReturnHandle'} = \*FH;
$$psError = "Success";
return 200;
}
}
$$psError = "Requested file ($$phProperties{'ClientFilename'}) was not found in effective folder list ($sEffectiveFolderList)";
return 404;
}
else
{
$$psError = "Invalid query string ($$phProperties{'QueryString'})";
return 450;
}
}
######################################################################
#
# ProcessPutRequest
#
######################################################################
sub ProcessPutRequest
{
my ($phProperties, $psError) = @_;
####################################################################
#
# Proceed only if QueryString matches the PutQuery expression.
#
####################################################################
my $sQueryString = URLDecode($$phProperties{'QueryString'});
if ($sQueryString =~ /^$$phProperties{'CustomRegexes'}{'PutQuery'}$/)
{
my ($sEnvLength, $sErrLength, $sOutLength);
$$phProperties{'ClientVersion'} = $1;
$$phProperties{'ClientSystem'} = $2;
$$phProperties{'ClientId'} = $3 || "nobody";
$$phProperties{'ClientFilename'} = $4;
$$phProperties{'ClientRunType'} = $5;
$$phProperties{'ClientOutLength'} = $sOutLength = $6;
$$phProperties{'ClientErrLength'} = $sErrLength = $7;
$$phProperties{'ClientEnvLength'} = $sEnvLength = $8;
##################################################################
#
# Bring in any client- and/or command-specific properties.
#
##################################################################
my ($sLocalError);
if ($$phProperties{'EnableConfigOverrides'} =~ /^[Yy]$/)
{
GetCustomConfigProperties($phProperties, \%{$$phProperties{'CustomConfigTemplate'}}, \$sLocalError);
}
##################################################################
#
# Conditionally do CommonName and client ID checks.
#
##################################################################
if ($$phProperties{'SslRequireSsl'} =~ /^[Yy]$/)
{
if ($$phProperties{'SslRequireCn'} =~ /^[Yy]$/ && (!defined($$phProperties{'SslClientSDnCn'}) || !length($$phProperties{'SslClientSDnCn'})))
{
$$psError = "CommonName is undefined or null";
return 470;
}
if ($$phProperties{'SslRequireCn'} =~ /^[Yy]$/ && $$phProperties{'SslRequireMatch'} =~ /^[Yy]$/ && $$phProperties{'SslClientSDnCn'} ne $$phProperties{'ClientId'})
{
$$psError = "CommonName ($$phProperties{'SslClientSDnCn'}) does not match client ID ($$phProperties{'ClientId'})";
return 471;
}
}
##################################################################
#
# Do username and client ID checks.
#
##################################################################
if ($$phProperties{'RequireUser'} =~ /^[Yy]$/ && (!defined($$phProperties{'RemoteUser'}) || !length($$phProperties{'RemoteUser'})))
{
$$psError = "Remote user is undefined or null";
return 452;
}
if ($$phProperties{'RequireUser'} =~ /^[Yy]$/ && $$phProperties{'RequireMatch'} =~ /^[Yy]$/ && $$phProperties{'RemoteUser'} ne $$phProperties{'ClientId'})
{
$$psError = "Remote user ($$phProperties{'RemoteUser'}) does not match client ID ($$phProperties{'ClientId'})";
return 453;
}
##################################################################
#
# Do content length checks.
#
##################################################################
if (!defined($$phProperties{'ContentLength'}) || !length($$phProperties{'ContentLength'}))
{
$$psError = "Content length is undefined or null";
return 454;
}
if ($$phProperties{'CapContentLength'} =~ /^[Yy]$/ && $$phProperties{'ContentLength'} > $$phProperties{'MaxContentLength'})
{
$$psError = "Content length ($$phProperties{'ContentLength'}) exceeds maximum allowed length ($$phProperties{'MaxContentLength'})";
return 455;
}
if ($$phProperties{'ContentLength'} != ($sOutLength + $sErrLength + $sEnvLength))
{
$$psError = "Content length ($$phProperties{'ContentLength'}) does not equal sum of individual stream lengths ($sOutLength + $sErrLength + $sEnvLength)";
return 456;
}
##################################################################
#
# If this is a link test, dump the data and return success.
#
##################################################################
if ($$phProperties{'ClientRunType'} eq "linktest")
{
SysReadWrite(\*STDIN, undef, $$phProperties{'ContentLength'}, undef); # Slurp up data to prevent a broken pipe.
$$psError = "Success";
return 251;
}
##################################################################
#
# Make output filenames and directories.
#
##################################################################
my ($sEnvFile, $sErrFile, $sLckFile, $sOutFile, $sPutName, $sRdyFile);
$sPutName = MakePutName($phProperties, \$sLocalError);
if (!defined($sPutName))
{
$$psError = $sLocalError;
SysReadWrite(\*STDIN, undef, $$phProperties{'ContentLength'}, undef); # Slurp up data to prevent a broken pipe.
return 500;
}
$sLckFile = $$phProperties{'IncomingDirectory'} . "/" . $sPutName . ".lck";
$sOutFile = $$phProperties{'IncomingDirectory'} . "/" . $sPutName . ".out";
$sErrFile = $$phProperties{'IncomingDirectory'} . "/" . $sPutName . ".err";
$sEnvFile = $$phProperties{'IncomingDirectory'} . "/" . $sPutName . ".env";
$sRdyFile = $$phProperties{'IncomingDirectory'} . "/" . $sPutName . ".rdy";
$$phProperties{'LckFile'} = $sLckFile;
$$phProperties{'OutFile'} = $sOutFile;
$$phProperties{'ErrFile'} = $sErrFile;
$$phProperties{'EnvFile'} = $sEnvFile;
$$phProperties{'RdyFile'} = $sRdyFile;
if (!defined(MakePutTree($$phProperties{'IncomingDirectory'}, $sPutName, 0755, 1, \$sLocalError)))
{
$$psError = $sLocalError;
SysReadWrite(\*STDIN, undef, $$phProperties{'ContentLength'}, undef); # Slurp up data to prevent a broken pipe.
return 500;
}
##################################################################
#
# Create a group lockfile and lock it. The purpose of the lock
# is to prevent other instances of this script from writing to
# any of the output files (.out, .err, .env, .rdy).
#
##################################################################
if (!open(LH, "> $sLckFile"))
{
$$psError = "File ($sLckFile) could not be opened ($!)";
SysReadWrite(\*STDIN, undef, $$phProperties{'ContentLength'}, undef); # Slurp up data to prevent a broken pipe.
return 500;
}
flock(LH, LOCK_EX);
##################################################################
#
# Make sure that none of the output files exist.
#
##################################################################
foreach my $sPutFile ($sOutFile, $sErrFile, $sEnvFile, $sRdyFile)
{
if (-e $sPutFile)
{
if ($$phProperties{'OverwriteExistingFiles'} =~ /^[Yy]$/)
{
unlink($sPutFile);
}
else
{
$$psError = "File ($sPutFile) already exists";
SysReadWrite(\*STDIN, undef, $$phProperties{'ContentLength'}, undef); # Slurp up data to prevent a broken pipe.
flock(LH, LOCK_UN); close(LH); unlink($sLckFile); # Unlock, close, and remove the group lockfile.
return 451;
}
}
}
##################################################################
#
# Write the output files (.out, .err, .env, .rdy) to disk.
#
##################################################################
my (%hStreamLengths);
$hStreamLengths{$sOutFile} = $sOutLength;
$hStreamLengths{$sErrFile} = $sErrLength;
$hStreamLengths{$sEnvFile} = $sEnvLength;
foreach my $sPutFile ($sOutFile, $sErrFile, $sEnvFile, $sRdyFile)
{
if (!open(FH, "> $sPutFile"))
{
$$psError = "File ($sPutFile) could not be opened ($!)";
SysReadWrite(\*STDIN, undef, $$phProperties{'ContentLength'}, undef); # Slurp up data to prevent a broken pipe.
flock(LH, LOCK_UN); close(LH); unlink($sLckFile); # Unlock, close, and remove the group lockfile.
return 500;
}
binmode(FH);
flock(FH, LOCK_EX);
if ($sPutFile eq $sRdyFile)
{
print FH "Version=", $$phProperties{'Version'}, $$phProperties{'Newline'};
print FH "Jid=", $$phProperties{'JobId'}, $$phProperties{'Newline'};
foreach my $sKey (sort(keys(%{$$phProperties{'GlobalConfigTemplate'}})))
{
print FH $sKey, "=", $$phProperties{$sKey}, $$phProperties{'Newline'};
}
}
else
{
my $sByteCount = SysReadWrite(\*STDIN, \*FH, $hStreamLengths{$sPutFile}, \$sLocalError);
if (!defined($sByteCount))
{
$$psError = $sLocalError;
flock(FH, LOCK_UN); close(FH);
flock(LH, LOCK_UN); close(LH); unlink($sLckFile); # Unlock, close, and remove the group lockfile.
return 500;
}
if ($sByteCount != $hStreamLengths{$sPutFile})
{
$$psError = "Stream length ($hStreamLengths{$sPutFile}) does not equal number of bytes processed ($sByteCount) for output file ($sPutFile)";
flock(FH, LOCK_UN); close(FH);
flock(LH, LOCK_UN); close(LH); unlink($sLckFile); # Unlock, close, and remove the group lockfile.
return 456;
}
}
flock(FH, LOCK_UN); close(FH);
}
flock(LH, LOCK_UN); close(LH); unlink($sLckFile); # Unlock, close, and remove the group lockfile.
$$psError = "Success";
return 200;
}
else
{
$$psError = "Invalid query string ($$phProperties{'QueryString'})";
return 450;
}
}
######################################################################
#
# SendResponse
#
######################################################################
sub SendResponse
{
my ($phProperties) = @_;
####################################################################
#
# Send response header.
#
####################################################################
my ($sHandle, $sHeader, $sLength, $sReason, $sServer, $sStatus);
$sHandle = $$phProperties{'ReturnHandle'};
$sStatus = $$phProperties{'ReturnStatus'};
$sReason = $$phProperties{'ReturnReason'};
$sServer = $$phProperties{'ServerSoftware'};
$sLength = (defined($sHandle)) ? -s $sHandle : 0;
$sHeader = "HTTP/1.1 $sStatus $sReason\r\n";
$sHeader .= "Server: $sServer\r\n";
$sHeader .= "Content-Type: application/octet-stream\r\n";
$sHeader .= "Content-Length: $sLength\r\n";
if ($$phProperties{'RequestMethod'} eq 'GET' && $$phProperties{'EnableJobIds'} =~ /^[Yy]$/)
{
if (defined($$phProperties{'JobId'}) && $$phProperties{'JobId'} =~ /^$$phProperties{'CommonRegexes'}{'JobId'}$/)
{
$sHeader .= "Job-Id: $$phProperties{'JobId'}\r\n";
}
}
if (exists($$phProperties{'DsvPayloadSignature'}) && defined($$phProperties{'DsvPayloadSignature'}))
{
$sHeader .= "WebJob-Payload-Signature: $$phProperties{'DsvPayloadSignature'}\r\n";
}
$sHeader .= "\r\n";
syswrite(STDOUT, $sHeader, length($sHeader));
####################################################################
#
# Send content if any.
#
####################################################################
if (defined($sHandle))
{
SysReadWrite($sHandle, \*STDOUT, $sLength, undef);
close($sHandle);
}
return $sLength;
}
######################################################################
#
# SysReadWrite
#
######################################################################
sub SysReadWrite
{
my ($sReadHandle, $sWriteHandle, $sLength, $psError) = @_;
####################################################################
#
# Read/Write data, but discard data if write handle is undefined.
#
####################################################################
my ($sData, $sEOF, $sNRead, $sNProcessed, $sNWritten);
for ($sEOF = $sNRead = $sNProcessed = 0; !$sEOF && $sLength > 0; $sLength -= $sNRead)
{
$sNRead = sysread($sReadHandle, $sData, ($sLength > 0x4000) ? 0x4000 : $sLength);
if (!defined($sNRead))
{
$$psError = "Error reading from input stream ($!)" if (defined($psError));
return undef;
}
elsif ($sNRead == 0)
{
$sEOF = 1;
}
else
{
if (defined($sWriteHandle))
{
$sNWritten = syswrite($sWriteHandle, $sData, $sNRead);
if (!defined($sNWritten))
{
$$psError = "Error writing to output stream ($!)" if (defined($psError));
return undef;
}
}
else
{
$sNWritten = $sNRead;
}
$sNProcessed += $sNWritten;
}
}
return $sNProcessed;
}
######################################################################
#
# TriggerExecuteCommandLine
#
######################################################################
sub TriggerExecuteCommandLine
{
my ($phProperties, $psError) = @_;
####################################################################
#
# Make sure that required inputs are defined.
#
####################################################################
my @aKeys =
(
'EnableLogging',
'ExpandTriggerCommandLineRoutine',
'OSClass',
);
if (!defined(VerifyHashKeys($phProperties, \@aKeys)))
{
$$psError = "Unable to proceed due to missing or undefined inputs";
return undef;
}
####################################################################
#
# Windows platforms are not currently supported.
#
####################################################################
if ($$phProperties{'OSClass'} eq "WINDOWS")
{
$$psError = "Triggers are not currently supported on Windows platforms";
return undef;
}
####################################################################
#
# Expand the trigger's command line. If the result is undefined or
# null, abort.
#
####################################################################
my ($sLocalError);
$$phProperties{'TriggerCommandLine'} = &{$$phProperties{'ExpandTriggerCommandLineRoutine'}}($phProperties, \$sLocalError);
if (!defined($$phProperties{'TriggerCommandLine'}))
{
$$psError = $sLocalError;
return undef;
}
if (!length($$phProperties{'TriggerCommandLine'}))
{
$$psError = "Command line is undefined or null";
return undef;
}
####################################################################
#
# Spawn a subprocess. Set the kid's process group. This should
# isolate the kid from signals sent to his parent or grandparent
# (i.e., this script or the server daemon, respectively). Close
# STDOUT. This should prevent the kid from interfering with the
# original CGI connection (e.g., holding the socket open). Keep
# STDERR open open so that errors can be caught in the server's
# error log. Change to the root directory to prevent unmounting
# issues, which could happen if a long-running trigger process was
# specified.
#
####################################################################
my $sKidPid = fork();
if (!defined($sKidPid))
{
$$psError = "Unable to spawn process ($!)";
return undef;
}
else
{
if ($sKidPid == 0)
{
setpgrp(0, 0);
close(STDOUT);
chdir("/");
$$phProperties{'TriggerPidLabel'} = "kid";
$$phProperties{'TriggerPid'} = $$;
$$phProperties{'TriggerState'} = "pulled";
$$phProperties{'TriggerMessage'} = $$phProperties{'TriggerCommandLine'};
if ($$phProperties{'EnableLogging'} =~ /^[Yy]$/)
{
TriggerLogMessage($phProperties);
}
my $sKidReturn = system($$phProperties{'TriggerCommandLine'});
my $sKidStatus = ($sKidReturn >> 8) & 0xff;
my $sKidSignal = ($sKidReturn & 0x7f);
my $sKidDumped = ($sKidReturn & 0x80) ? 1 : 0;
if ($sKidStatus == 255)
{
$$phProperties{'TriggerState'} = "failed";
$$phProperties{'TriggerMessage'} = "Unable to execute trigger command ($!)";
}
else
{
$$phProperties{'TriggerState'} = "reaped";
$$phProperties{'TriggerMessage'} = "status($sKidStatus) signal($sKidSignal) coredump($sKidDumped)";
}
if ($$phProperties{'EnableLogging'} =~ /^[Yy]$/)
{
TriggerLogMessage($phProperties);
}
exit($sKidStatus);
}
}
return $sKidPid;
}
######################################################################
#
# TriggerLogMessage
#
######################################################################
sub TriggerLogMessage
{
my ($phProperties) = @_;
####################################################################
#
# Create date/time stamp and calculate duration.
#
####################################################################
my
(
$sSecond,
$sMinute,
$sHour,
$sMonthDay,
$sMonth,
$sYear,
$sWeekDay,
$sYearDay,
$sDaylightSavings,
) = ($$phProperties{'UseGMT'} =~ /^[Yy]$/) ? gmtime($$phProperties{'TriggerEpoch'}) : localtime($$phProperties{'TriggerEpoch'});
$$phProperties{'TriggerDate'} = sprintf("%04s-%02s-%02s", $sYear + 1900, $sMonth + 1, $sMonthDay);
$$phProperties{'TriggerTime'} = sprintf("%02s:%02s:%02s", $sHour, $sMinute, $sSecond);
####################################################################
#
# Construct log message.
#
####################################################################
my (@aOutputFields);
my @aLogFields =
(
'TriggerDate',
'TriggerTime',
'JobId',
'RequestMethod',
'ClientId',
'ClientFilename',
'TriggerPidLabel',
'TriggerPid',
'TriggerState',
'TriggerMessage',
);
foreach my $sField (@aLogFields)
{
my $sValue = $$phProperties{$sField};
if ($sField =~ /^TriggerMessage$/)
{
push(@aOutputFields, ((defined($sValue) && length($sValue)) ? "-- $sValue" : "--"));
}
else
{
push(@aOutputFields, ((defined($sValue) && length($sValue)) ? "$sValue" : "-"));
}
}
my $sLogMessage = join(" ", @aOutputFields);
####################################################################
#
# Deliver log message.
#
####################################################################
if (!open(LH, ">> " . $$phProperties{'TriggerLogFile'}))
{
print STDERR $sLogMessage, $$phProperties{'Newline'};
return undef;
}
binmode(LH);
flock(LH, LOCK_EX);
print LH $sLogMessage, $$phProperties{'Newline'};
flock(LH, LOCK_UN);
close(LH);
1;
}
######################################################################
#
# URLDecode
#
######################################################################
sub URLDecode
{
my ($sData) = @_;
$sData =~ s/\+/ /sg;
$sData =~ s/%([0-9a-fA-F]{2})/pack('C', hex($1))/seg;
return $sData;
}
######################################################################
#
# VerifyConversionValues
#
######################################################################
sub VerifyConversionValues
{
my ($phConversionValues, $phConversionChecks, $psError) = @_;
foreach my $sKey (sort(keys(%$phConversionChecks)))
{
if ($$phConversionValues{$sKey} !~ /^$$phConversionChecks{$sKey}$/)
{
$sKey =~ s/^(CID|CMD|IP|PID|SID)$/lc($1)/e; # Squash legacy tokens.
$$psError = "Conversion value ($$phConversionValues{$sKey}) for corresponding specification (%$sKey) is not valid";
return undef;
}
}
1;
}
######################################################################
#
# VerifyHashKeys
#
######################################################################
sub VerifyHashKeys
{
my ($phHash, $paKeys) = @_;
foreach my $sKey (@$paKeys)
{
if (!exists($$phHash{$sKey}) || !defined($$phHash{$sKey}))
{
return undef;
}
}
1;
}
######################################################################
#
# VerifyRunTimeEnvironment
#
######################################################################
sub VerifyRunTimeEnvironment
{
my ($phProperties, $phRequiredProperties, $psError) = @_;
####################################################################
#
# Make sure all required properties are defined and valid.
#
####################################################################
foreach my $sProperty (keys(%$phRequiredProperties))
{
my $sValue = $$phProperties{$sProperty};
if (!defined($sValue) || $sValue !~ /^$$phRequiredProperties{$sProperty}$/)
{
$$psError = "$sProperty property ($sValue) is undefined or invalid";
return undef;
}
}
####################################################################
#
# Make sure the config directory is readable.
#
####################################################################
if (!-d $$phProperties{'ConfigDirectory'} || !-R _)
{
$$psError = "Config directory ($$phProperties{'ConfigDirectory'}) does not exist or is not readable";
return undef;
}
####################################################################
#
# Make sure the logfiles directory is readable.
#
####################################################################
if (!-d $$phProperties{'LogfilesDirectory'} || !-R _)
{
$$psError = "Logfiles directory ($$phProperties{'LogfilesDirectory'}) does not exist or is not readable";
return undef;
}
####################################################################
#
# Make sure the profiles directory is readable.
#
####################################################################
if (!-d $$phProperties{'ProfilesDirectory'} || !-R _)
{
$$psError = "Profiles directory ($$phProperties{'ProfilesDirectory'}) does not exist or is not readable";
return undef;
}
####################################################################
#
# Make sure the incoming directory is writable.
#
####################################################################
if (!-d $$phProperties{'IncomingDirectory'} || !-W _)
{
$$psError = "Incoming directory ($$phProperties{'IncomingDirectory'}) does not exist or is not writeable";
return undef;
}
1;
}
syntax highlighted by Code2HTML, v. 0.9.1