michael@0: #!/usr/bin/perl
michael@0: 
michael@0: # This Source Code Form is subject to the terms of the Mozilla Public
michael@0: # License, v. 2.0. If a copy of the MPL was not distributed with this
michael@0: # file, You can obtain one at http://mozilla.org/MPL/2.0/.
michael@0: 
michael@0: #--------------------------------------------------------------
michael@0: # cgi script that parses request argument to appropriate 
michael@0: # open ssl or tstclntw options and starts ssl client.
michael@0: #
michael@0: 
michael@0: use CGI qw/:standard/;
michael@0: 
michael@0: use subs qw(debug);
michael@0: 
michael@0: #--------------------------------------------------------------
michael@0: # Prints out an error string and exits the script with an
michael@0: # exitStatus.
michael@0: # Param:
michael@0: #    str : an error string
michael@0: #    exitStat: an exit status of the program
michael@0: #
michael@0: sub svr_error {
michael@0:     my ($str, $exitStat) = @_;
michael@0: 
michael@0:     if (!defined $str || $str eq "") {
michael@0:         $str = $ERR;
michael@0:     }
michael@0:     print "SERVER ERROR: $str\n";
michael@0:     if ($exitStat) {
michael@0:         print end_html if ($osDataArr{wservRun});
michael@0:         exit $exitStat;
michael@0:     }
michael@0: }
michael@0: 
michael@0: #--------------------------------------------------------------
michael@0: # Prints out a debug message
michael@0: # Params:
michael@0: #     str: debug message
michael@0: #     inVal: additional value to print(optional)
michael@0: #
michael@0: sub debug {
michael@0:     my ($str, $inVal) = @_;
michael@0:     
michael@0:     print "-- DEBUG: $str ($inVal)\n" if ($DEBUG == 1);
michael@0: }
michael@0: 
michael@0: 
michael@0: #--------------------------------------------------------------
michael@0: # Initializes execution context depending on a webserver the
michael@0: # script is running under.
michael@0: #
michael@0: sub init {
michael@0:     %osDataArr = (
michael@0:                   loadSupportedCipthersFn => \&osSpecific,
michael@0:                   cipherIsSupportedFn => \&verifyCipherSupport,
michael@0:                   cipherListFn => \&convertCipher,
michael@0:                   buildCipherTableFn => \&buildCipherTable,
michael@0:                   execCmdFn => \&osSpecific,
michael@0:                   );
michael@0: 
michael@0:     $scriptName = $ENV{'SCRIPT_NAME'};
michael@0:     if (!defined $scriptName) {
michael@0:         $DEBUG=1;
michael@0:         debug "Debug is ON";
michael@0:     }
michael@0:     $DEBUG=1;
michael@0:     
michael@0:     $svrSoft = $ENV{'SERVER_SOFTWARE'};
michael@0:     if (defined $svrSoft) {
michael@0:         $_ = $svrSoft;
michael@0:         /.*Microsoft.*/ && ($osDataArr{wserv} = "IIS");
michael@0:         /.*Apache.*/ && ($osDataArr{wserv} = "Apache");
michael@0:         $osDataArr{wservRun} = 1;
michael@0:     } else {
michael@0:         $osDataArr{wserv} = "Apache";
michael@0:         $osDataArr{wservRun} = 0;
michael@0:     }
michael@0: }
michael@0: 
michael@0: #--------------------------------------------------------------
michael@0: # Function-spigot to handle errors is OS specific functions are
michael@0: # not implemented for a particular OS.
michael@0: # Returns:
michael@0: #   always returns 0(failure)
michael@0: #
michael@0: sub osSpecific {
michael@0:     $ERR = "This function should be swapped to os specific function.";
michael@0:     return 0;
michael@0: }
michael@0: 
michael@0: #--------------------------------------------------------------
michael@0: # Sets os specific execution context values.
michael@0: # Returns:
michael@0: #    1 upon success, or 0 upon failure(if OS was not recognized)
michael@0: #
michael@0: sub setFunctRefs {
michael@0:     
michael@0:     debug("Entering setFunctRefs function", $osDataArr{wserv});
michael@0: 
michael@0:     if ($osDataArr{wserv} eq "Apache") {
michael@0:         $osDataArr{osConfigFile} = "apache_unix.cfg";
michael@0:         $osDataArr{suppCiphersCmd} = '$opensslb ciphers ALL:NULL';
michael@0:         $osDataArr{clientRunCmd} = '$opensslb s_client -host $in_host -port $in_port -cert $certDir/$in_cert.crt -key $certDir/$in_cert.key -CAfile $caCertFile $proto $ciphers -ign_eof < $reqFile';
michael@0:         $osDataArr{loadSupportedCipthersFn} = \&getSupportedCipherList_Unix;
michael@0:         $osDataArr{execCmdFn} = \&execClientCmd_Unix;
michael@0:     } elsif ($osDataArr{wserv} eq "IIS") {
michael@0:         $osDataArr{osConfigFile} = "iis_windows.cfg";
michael@0:         $osDataArr{suppCiphersCmd} = '$tstclntwb';
michael@0:         $osDataArr{clientRunCmd} = '$tstclntwb -h $in_host -p $in_port -n $in_cert $proto $ciphers < $reqFile';
michael@0:         $osDataArr{loadSupportedCipthersFn} = \&getSupportedCipherList_Win;
michael@0:         $osDataArr{execCmdFn} = \&execClientCmd_Win;
michael@0:     } else {
michael@0:         $ERR = "Unknown Web Server  type.";
michael@0:         return 0;
michael@0:     }
michael@0:     return 1;
michael@0: }
michael@0: 
michael@0: #--------------------------------------------------------------
michael@0: # Parses data from HTTP request. Will print a form if request
michael@0: # does not contain sufficient number of parameters.
michael@0: # Returns: 
michael@0: #     1 if request has sufficient number of parameters
michael@0: #     0 if not.
michael@0: sub getReqData {
michael@0:     my $debug = param('debug');
michael@0:     $in_host = param('host');
michael@0:     $in_port = param('port');
michael@0:     $in_cert = param('cert');
michael@0:     $in_cipher = param('cipher');
michael@0: 
michael@0:     if (!$osDataArr{wservRun}) {
michael@0:         $in_host="goa1";
michael@0:         $in_port="443";
michael@0:         $in_cert="TestUser511";
michael@0:         $in_cipher = "SSL3_RSA_WITH_NULL_SHA";
michael@0:     }
michael@0: 
michael@0:     debug("Entering getReqData function", "$in_port:$in_host:$in_cert:$in_cipher");
michael@0: 
michael@0:     if (defined $debug && $debug == "debug on") {
michael@0:         $DEBUG = 1;
michael@0:     }
michael@0: 
michael@0:     if (!defined $in_host || $in_host eq "" ||
michael@0:         !defined $in_port || $in_port eq "" ||
michael@0:         !defined $in_cert || $in_cert eq "") {
michael@0:         if ($osDataArr{wservRun}) {
michael@0:             print h1('Command description form:'),
michael@0:             start_form(-method=>"get"),
michael@0:             "Host: ",textfield('host'),p,
michael@0:             "Port: ",textfield('port'),p,
michael@0:             "Cert: ",textfield('cert'),p,
michael@0:             "Cipher: ",textfield('cipher'),p,
michael@0:             checkbox_group(-name=>'debug',
michael@0:                            -values=>['debug on  ']),
michael@0:             submit,
michael@0:             end_form,
michael@0:             hr;
michael@0:         } else {
michael@0:             print "Printing html form to get client arguments\n";
michael@0:         }
michael@0:         $ERR = "the following parameters are required: host, port, cert";
michael@0:         return 0;
michael@0:     } else {
michael@0:         print "<pre>" if ($osDataArr{wservRun});
michael@0:         return 1;
michael@0:     }
michael@0: }
michael@0: 
michael@0: 
michael@0: #--------------------------------------------------------------
michael@0: # Building cipher conversion table from file based on the OS.
michael@0: # Params:
michael@0: #     tfile: cipher conversion file.
michael@0: #     sysName: system name
michael@0: #     tblPrt: returned pointer to a table.
michael@0: sub buildCipherTable {
michael@0:     my ($tfile, $sysName, $tblPrt) = @_;
michael@0:     my @retArr = @$tblPrt;
michael@0:     my %table, %rtable;
michael@0:     my $strCount = 0;
michael@0: 
michael@0:     debug("Entering getReqData function", "$tfile:$sysName:$tblPrt");
michael@0: 
michael@0:     ($ERR = "No system name supplied" && return 0) if ($sysName =~ /^$/);
michael@0:     if (!open(TFILE, "$tfile")) {
michael@0:         $ERR = "Missing cipher conversion table file.";
michael@0:         return 0;
michael@0:     }
michael@0:     foreach (<TFILE>) {
michael@0:         chop;
michael@0:         /^#.*/ && next;
michael@0:         /^\s*$/ && next;
michael@0:         if ($strCount++ == 0) {
michael@0:             my @sysArr =  split /\s+/;
michael@0:             $colCount = 0;
michael@0:             for (;$colCount <= $#sysArr;$colCount++) {
michael@0:                 last if ($sysArr[$colCount] =~ /(.*:|^)$sysName.*/);
michael@0:             }
michael@0:             next;
michael@0:         }
michael@0:         my @ciphArr =  split /\s+/, $_;
michael@0:         $table{$ciphArr[0]} = $ciphArr[$colCount];
michael@0:         $rtable{$ciphArr[$colCount]} = $ciphArr[0];
michael@0:     }
michael@0:     close(TFILE);
michael@0:     $cipherTablePtr[0] = \%table;
michael@0:     $cipherTablePtr[1] = \%rtable;
michael@0:     return 1
michael@0: }
michael@0: 
michael@0: #--------------------------------------------------------------
michael@0: # Client configuration function. Loads client configuration file.
michael@0: # Initiates cipher table. Loads cipher list supported by ssl client.
michael@0: #
michael@0: sub configClient {
michael@0: 
michael@0:     debug "Entering configClient function";
michael@0: 
michael@0:     my $res = &setFunctRefs();
michael@0:     return $res if (!$res);
michael@0: 
michael@0:     open(CFILE, $osDataArr{'osConfigFile'}) ||
michael@0:         ($ERR = "Missing configuration file." && return 0);
michael@0:     foreach (<CFILE>) {
michael@0:         /^#.*/ && next;
michael@0:         chop;
michael@0:         eval $_;
michael@0:     }
michael@0:     close(CFILE);
michael@0:    
michael@0:     local @cipherTablePtr = ();
michael@0:     $osDataArr{'buildCipherTableFn'}->($cipherTableFile, $clientSys) || return 0;
michael@0:     $osDataArr{cipherTable} = $cipherTablePtr[0];
michael@0:     $osDataArr{rcipherTable} = $cipherTablePtr[1];
michael@0:     
michael@0:     local $suppCiphersTablePrt;
michael@0:     &{$osDataArr{'loadSupportedCipthersFn'}} || return 0;
michael@0:     $osDataArr{suppCiphersTable} = $suppCiphersTablePrt;
michael@0: }
michael@0: 
michael@0: #--------------------------------------------------------------
michael@0: # Verifies that a particular cipher is supported.
michael@0: # Params:
michael@0: #    checkCipher: cipher name
michael@0: # Returns:
michael@0: #    1 - cipher is supported(also echos the cipher).
michael@0: #    0 - not supported.
michael@0: #
michael@0: sub verifyCipherSupport {
michael@0:     my ($checkCipher) = @_;
michael@0:     my @suppCiphersTable = @{$osDataArr{suppCiphersTable}};
michael@0: 
michael@0:     debug("Entering verifyCipherSupport", $checkCipher);
michael@0:     foreach (@suppCiphersTable) {
michael@0:         return 1 if ($checkCipher eq $_);
michael@0:     }
michael@0:     $ERR = "cipher is not supported.";
michael@0:     return 0;
michael@0: }
michael@0: 
michael@0: #--------------------------------------------------------------
michael@0: # Converts long(?name of the type?) cipher name to 
michael@0: # openssl/tstclntw cipher name.
michael@0: # Returns:
michael@0: #   0 if cipher was not listed. 1 upon success.
michael@0: #
michael@0: sub convertCipher {
michael@0:     my ($cipher) = @_;
michael@0:     my @retList;
michael@0:     my $resStr;
michael@0:     my %cipherTable = %{$osDataArr{cipherTable}};
michael@0: 
michael@0:     debug("Entering convertCipher", $cipher);
michael@0:     if (defined $cipher) {
michael@0:         my $cphr = $cipherTable{$cipher};
michael@0:         if (!defined $cphr) {
michael@0:             $ERR = "cipher is not listed.";
michael@0:             return 0;
michael@0:         }        
michael@0:         &{$osDataArr{'cipherIsSupportedFn'}}($cphr) || return 0;
michael@0:         $ciphers = "$cphr";
michael@0:         return 1;
michael@0:     }
michael@0:     return 0;
michael@0: }
michael@0: 
michael@0: #################################################################
michael@0: #  UNIX Apache Specific functions
michael@0: #----------------------------------------------------------------
michael@0: 
michael@0: #--------------------------------------------------------------
michael@0: # Executes ssl client command to get a list of ciphers supported
michael@0: # by client.
michael@0: #
michael@0: sub getSupportedCipherList_Unix {
michael@0:     my @arr, @suppCiphersTable;
michael@0: 
michael@0:     debug "Entering getSupportedCipherList_Unix function";
michael@0: 
michael@0:     eval '$sLisrCmd = "'.$osDataArr{'suppCiphersCmd'}.'"';
michael@0:     if (!open (OUT, "$sLisrCmd|")) {
michael@0:         $ERR="Can not run command to verify supported cipher list.";
michael@0:         return 0;
michael@0:     }
michael@0:     @arr = <OUT>;
michael@0:     chop $arr[0];
michael@0:     @suppCiphersTable = split /:/, $arr[0];
michael@0:     debug("Supported ciphers", $arr[0]);
michael@0:     $suppCiphersTablePrt = \@suppCiphersTable;
michael@0:     close(OUT);
michael@0:     return 1;
michael@0: }
michael@0: 
michael@0: #--------------------------------------------------------------
michael@0: # Lunches ssl client command in response to a request.
michael@0: #
michael@0: #
michael@0: sub execClientCmd_Unix {
michael@0:     my $proto;
michael@0:     local $ciphers;
michael@0: 
michael@0:     debug "Entering execClientCmd_Unix";
michael@0:     if (defined $in_cipher && $in_cipher ne "") {
michael@0:         my @arr = split /_/, $in_cipher, 2;
michael@0:         $proto = "-".$arr[0];
michael@0:         $proto =~ tr /SLT/slt/;
michael@0:         $proto = "-tls1" if ($proto eq "-tls");
michael@0:         return 0 if (!&{$osDataArr{'cipherListFn'}}($in_cipher));
michael@0:         $ciphers = "-cipher $ciphers";
michael@0:         debug("Return from cipher conversion", "$ciphers");
michael@0:     }
michael@0: 
michael@0:     eval '$command = "'.$osDataArr{'clientRunCmd'}.'"';
michael@0:     debug("Executing command", $command);
michael@0:     if (!open CMD_OUT, "$command 2>&1 |") {
michael@0:        $ERR = "can not launch client";
michael@0:        return 0;
michael@0:     }
michael@0: 
michael@0:     my @cmdOutArr = <CMD_OUT>;
michael@0:     
michael@0:     foreach (@cmdOutArr) {
michael@0:         print $_;
michael@0:     }
michael@0: 
michael@0:     my $haveVerify = 0;
michael@0:     my $haveErrors = 0;
michael@0:     foreach (@cmdOutArr) {
michael@0:         chop;
michael@0:         if (/unknown option/) {
michael@0:             $haveErrors++;
michael@0:             svr_error "unknown option\n";
michael@0:             next;
michael@0:         }
michael@0:         if (/:no ciphers available/) {
michael@0:             $haveErrors++;
michael@0:             svr_error "no cipthers available\n";
michael@0:             next;
michael@0:         }
michael@0:         if (/verify error:/) {
michael@0:             $haveErrors++;
michael@0:             svr_error "unable to do verification\n";
michael@0:             next;
michael@0:         }
michael@0:         if (/alert certificate revoked:/) {
michael@0:             $haveErrors++;
michael@0:             svr_error "attempt to connect with revoked sertificate\n";
michael@0:             next;
michael@0:         }
michael@0:         if (/(error|ERROR)/) {
michael@0:             $haveErrors++;
michael@0:             svr_error "found errors in server log\n";
michael@0:             next;
michael@0:         }
michael@0:         /verify return:1/ && ($haveVerify = 1);
michael@0:     }
michael@0:      if ($haveVerify == 0) {
michael@0:          svr_error "no 'verify return:1' found in server log\n";
michael@0:          $haveErrors++;
michael@0:      }
michael@0: 
michael@0:     if ($haveErrors > 0) {
michael@0:         $ERR = "Have $haveErrors server errors";
michael@0:         debug "Exiting execClientCmd_Unix";
michael@0:         return 0;
michael@0:     }
michael@0:     debug "Exiting execClientCmd_Unix";
michael@0:     return 1;
michael@0: }
michael@0: 
michael@0: #################################################################
michael@0: #  Windows IIS Specific functions
michael@0: #----------------------------------------------------------------
michael@0: 
michael@0: #--------------------------------------------------------------
michael@0: # Executes ssl client command to get a list of ciphers supported
michael@0: # by client.
michael@0: #
michael@0: sub getSupportedCipherList_Win {
michael@0:     my @arr, @suppCiphersTable;
michael@0: 
michael@0:     debug "Entering getSupportedCipherList_Win function";
michael@0: 
michael@0:     eval '$sLisrCmd = "'.$osDataArr{'suppCiphersCmd'}.'"';
michael@0:     if (!open (OUT, "$sLisrCmd|")) {
michael@0:         $ERR="Can not run command to verify supported cipher list.";
michael@0:         return 0;
michael@0:     }
michael@0:     my $startCipherList = 0;
michael@0:     foreach (<OUT>) {
michael@0:         chop;
michael@0:         if ($startCipherList) {
michael@0:             /^([a-zA-Z])\s+/ && push @suppCiphersTable, $1;
michael@0:             next;
michael@0:         }
michael@0:         /.*from list below.*/ && ($startCipherList = 1);
michael@0:     }
michael@0:     debug("Supported ciphers", join ':', @suppCiphersTable);
michael@0:     $suppCiphersTablePrt = \@suppCiphersTable;
michael@0:     close(OUT);
michael@0:     return 1;
michael@0: }
michael@0: 
michael@0: #--------------------------------------------------------------
michael@0: # Lunches ssl client command in response to a request.
michael@0: #
michael@0: #
michael@0: sub execClientCmd_Win {
michael@0:     my $proto;
michael@0:     local $ciphers;
michael@0: 
michael@0:     debug "Entering execClientCmd_Win";
michael@0:     if (defined $in_cipher && $in_cipher ne "") {
michael@0:         my @arr = split /_/, $in_cipher, 2;
michael@0:         $proto = "-2 -3 -T";
michael@0: 
michael@0:         $proto =~ s/-T// if ($arr[0] eq "TLS");
michael@0:         $proto =~ s/-3// if ($arr[0] eq "SSL3");
michael@0:         $proto =~ s/-2// if ($arr[0] eq "SSL2");
michael@0: 	return 0 if (!&{$osDataArr{'cipherListFn'}}($in_cipher));
michael@0:         $ciphers = "-c $ciphers";
michael@0:         debug("Return from cipher conversion", $ciphers);
michael@0:     }
michael@0: 
michael@0:     eval '$command = "'.$osDataArr{'clientRunCmd'}.'"';
michael@0:     debug("Executing command", $command);
michael@0:     if (!open CMD_OUT, "$command 2>&1 |") {
michael@0:         $ERR = "can not launch client";
michael@0:         return 0;
michael@0:     }
michael@0: 
michael@0:     my @cmdOutArr = <CMD_OUT>;
michael@0:     
michael@0:     foreach (@cmdOutArr) {
michael@0:         print $_;
michael@0:     }
michael@0: 
michael@0:     my $haveVerify = 0;
michael@0:     my $haveErrors = 0;
michael@0:     foreach (@cmdOutArr) {
michael@0:         chop;
michael@0:         if (/unknown option/) {
michael@0:             $haveErrors++;
michael@0:             svr_error "unknown option\n";
michael@0:             next;
michael@0:         }
michael@0:         if (/Error performing handshake/) {
michael@0:             $haveErrors++;
michael@0:             svr_error "Error performing handshake\n";
michael@0:             next;
michael@0:         }
michael@0:         if (/Error creating credentials/) {
michael@0:             $haveErrors++;
michael@0:             svr_error "Error creating credentials\n";
michael@0:             next;
michael@0:         }
michael@0:         if (/Error .* authenticating server credentials!/) {
michael@0:             $haveErrors++;
michael@0:             svr_error "Error authenticating server credentials\n";
michael@0:             next;
michael@0:         }
michael@0:         if (/(error|ERROR|Error)/) {
michael@0:             $haveErrors++;
michael@0:             svr_error "found errors in server log\n";
michael@0:             next;
michael@0:         }
michael@0:     }
michael@0: 
michael@0:     if ($haveErrors > 0) {
michael@0:         $ERR = "Have $haveErrors server errors";
michael@0:         debug "Exiting execClientCmd_Win";
michael@0:         return 0;
michael@0:     }
michael@0:     debug "Exiting execClientCmd_Win";
michael@0:     return 1;
michael@0: }
michael@0: 
michael@0: #################################################################
michael@0: #  Main line of execution
michael@0: #----------------------------------------------------------------
michael@0: &init;
michael@0: 
michael@0: if ($osDataArr{wservRun}) {
michael@0:     print header('text/html').
michael@0:         start_html('iopr client');
michael@0: }
michael@0:  
michael@0: print "SCRIPT=OK\n";
michael@0: 
michael@0: if (!&getReqData) { 
michael@0:     svr_error($ERR, 1);
michael@0: }
michael@0: 
michael@0: if (!&configClient) { 
michael@0:     svr_error($ERR, 1);
michael@0: }
michael@0: 
michael@0: &{$osDataArr{'execCmdFn'}} || svr_error;
michael@0: 
michael@0: if ($osDataArr{wservRun}) {
michael@0:     print "</pre>";
michael@0:     print end_html;
michael@0: }