#!/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 = ) { $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 # | | # | + # | | # | - nph-webjob.cfg # applies to all commands for # | | # | + # | | # | - nph-webjob.cfg # applies only to / # | # + commands # | # - nph-webjob.cfg # applies globally # | # + # | # - nph-webjob.cfg # applies to all clients for # | # + # | # - nph-webjob.cfg # applies only to / # # 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'} = ; # 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; }