#!/usr/bin/perl

#--------------------------------------------------------------
# cgi script that parses request argument to appropriate 
# open ssl or tstclntw options and starts ssl client.
#

use CGI qw/:standard/;

use subs qw(debug);

#--------------------------------------------------------------
# Prints out an error string and exits the script with an
# exitStatus.
# Param:
#    str : an error string
#    exitStat: an exit status of the program
#
sub svr_error {
    my ($str, $exitStat) = @_;

    if (!defined $str || $str eq "") {
        $str = $ERR;
    }
    print "SERVER ERROR: $str\n";
    if ($exitStat) {
        print end_html if ($osDataArr{wservRun});
        exit $exitStat;
    }
}

#--------------------------------------------------------------
# Prints out a debug message
# Params:
#     str: debug message
#     inVal: additional value to print(optional)
#
sub debug {
    my ($str, $inVal) = @_;
    
    print "-- DEBUG: $str ($inVal)\n" if ($DEBUG == 1);
}


#--------------------------------------------------------------
# Initializes execution context depending on a webserver the
# script is running under.
#
sub init {
    %osDataArr = (
                  loadSupportedCipthersFn => \&osSpecific,
                  cipherIsSupportedFn => \&verifyCipherSupport,
                  cipherListFn => \&convertCipher,
                  buildCipherTableFn => \&buildCipherTable,
                  execCmdFn => \&osSpecific,
                  );

    $scriptName = $ENV{'SCRIPT_NAME'};
    if (!defined $scriptName) {
        $DEBUG=1;
        debug "Debug is ON";
    }
    $DEBUG=1;
    
    $svrSoft = $ENV{'SERVER_SOFTWARE'};
    if (defined $svrSoft) {
        $_ = $svrSoft;
        /.*Microsoft.*/ && ($osDataArr{wserv} = "IIS");
        /.*Apache.*/ && ($osDataArr{wserv} = "Apache");
        $osDataArr{wservRun} = 1;
    } else {
        $osDataArr{wserv} = "Apache";
        $osDataArr{wservRun} = 0;
    }
}

#--------------------------------------------------------------
# Function-spigot to handle errors is OS specific functions are
# not implemented for a particular OS.
# Returns:
#   always returns 0(failure)
#
sub osSpecific {
    $ERR = "This function should be swapped to os specific function.";
    return 0;
}

#--------------------------------------------------------------
# Sets os specific execution context values.
# Returns:
#    1 upon success, or 0 upon failure(if OS was not recognized)
#
sub setFunctRefs {
    
    debug("Entering setFunctRefs function", $osDataArr{wserv});

    if ($osDataArr{wserv} eq "Apache") {
        $osDataArr{osConfigFile} = "apache_unix.cfg";
        $osDataArr{suppCiphersCmd} = '$opensslb ciphers ALL:NULL';
        $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';
        $osDataArr{loadSupportedCipthersFn} = \&getSupportedCipherList_Unix;
        $osDataArr{execCmdFn} = \&execClientCmd_Unix;
    } elsif ($osDataArr{wserv} eq "IIS") {
        $osDataArr{osConfigFile} = "iis_windows.cfg";
        $osDataArr{suppCiphersCmd} = '$tstclntwb';
        $osDataArr{clientRunCmd} = '$tstclntwb -h $in_host -p $in_port -n $in_cert $proto $ciphers < $reqFile';
        $osDataArr{loadSupportedCipthersFn} = \&getSupportedCipherList_Win;
        $osDataArr{execCmdFn} = \&execClientCmd_Win;
    } else {
        $ERR = "Unknown Web Server  type.";
        return 0;
    }
    return 1;
}

#--------------------------------------------------------------
# Parses data from HTTP request. Will print a form if request
# does not contain sufficient number of parameters.
# Returns: 
#     1 if request has sufficient number of parameters
#     0 if not.
sub getReqData {
    my $debug = param('debug');
    $in_host = param('host');
    $in_port = param('port');
    $in_cert = param('cert');
    $in_cipher = param('cipher');

    if (!$osDataArr{wservRun}) {
        $in_host="goa1";
        $in_port="443";
        $in_cert="TestUser511";
        $in_cipher = "SSL3_RSA_WITH_NULL_SHA";
    }

    debug("Entering getReqData function", "$in_port:$in_host:$in_cert:$in_cipher");

    if (defined $debug && $debug == "debug on") {
        $DEBUG = 1;
    }

    if (!defined $in_host || $in_host eq "" ||
        !defined $in_port || $in_port eq "" ||
        !defined $in_cert || $in_cert eq "") {
        if ($osDataArr{wservRun}) {
            print h1('Command description form:'),
            start_form(-method=>"get"),
            "Host: ",textfield('host'),p,
            "Port: ",textfield('port'),p,
            "Cert: ",textfield('cert'),p,
            "Cipher: ",textfield('cipher'),p,
            checkbox_group(-name=>'debug',
                           -values=>['debug on  ']),
            submit,
            end_form,
            hr;
        } else {
            print "Printing html form to get client arguments\n";
        }
        $ERR = "the following parameters are required: host, port, cert";
        return 0;
    } else {
        print "<pre>" if ($osDataArr{wservRun});
        return 1;
    }
}


#--------------------------------------------------------------
# Building cipher conversion table from file based on the OS.
# Params:
#     tfile: cipher conversion file.
#     sysName: system name
#     tblPrt: returned pointer to a table.
sub buildCipherTable {
    my ($tfile, $sysName, $tblPrt) = @_;
    my @retArr = @$tblPrt;
    my %table, %rtable;
    my $strCount = 0;

    debug("Entering getReqData function", "$tfile:$sysName:$tblPrt");

    ($ERR = "No system name supplied" && return 0) if ($sysName =~ /^$/);
    if (!open(TFILE, "$tfile")) {
        $ERR = "Missing cipher conversion table file.";
        return 0;
    }
    foreach (<TFILE>) {
        chop;
        /^#.*/ && next;
        /^\s*$/ && next;
        if ($strCount++ == 0) {
            my @sysArr =  split /\s+/;
            $colCount = 0;
            for (;$colCount <= $#sysArr;$colCount++) {
                last if ($sysArr[$colCount] =~ /(.*:|^)$sysName.*/);
            }
            next;
        }
        my @ciphArr =  split /\s+/, $_;
        $table{$ciphArr[0]} = $ciphArr[$colCount];
        $rtable{$ciphArr[$colCount]} = $ciphArr[0];
    }
    close(TFILE);
    $cipherTablePtr[0] = \%table;
    $cipherTablePtr[1] = \%rtable;
    return 1
}

#--------------------------------------------------------------
# Client configuration function. Loads client configuration file.
# Initiates cipher table. Loads cipher list supported by ssl client.
#
sub configClient {

    debug "Entering configClient function";

    my $res = &setFunctRefs();
    return $res if (!$res);

    open(CFILE, $osDataArr{'osConfigFile'}) ||
        ($ERR = "Missing configuration file." && return 0);
    foreach (<CFILE>) {
        /^#.*/ && next;
        chop;
        eval $_;
    }
    close(CFILE);
   
    local @cipherTablePtr = ();
    $osDataArr{'buildCipherTableFn'}->($cipherTableFile, $clientSys) || return 0;
    $osDataArr{cipherTable} = $cipherTablePtr[0];
    $osDataArr{rcipherTable} = $cipherTablePtr[1];
    
    local $suppCiphersTablePrt;
    &{$osDataArr{'loadSupportedCipthersFn'}} || return 0;
    $osDataArr{suppCiphersTable} = $suppCiphersTablePrt;
}

#--------------------------------------------------------------
# Verifies that a particular cipher is supported.
# Params:
#    checkCipher: cipher name
# Returns:
#    1 - cipher is supported(also echos the cipher).
#    0 - not supported.
#
sub verifyCipherSupport {
    my ($checkCipher) = @_;
    my @suppCiphersTable = @{$osDataArr{suppCiphersTable}};

    debug("Entering verifyCipherSupport", $checkCipher);
    foreach (@suppCiphersTable) {
        return 1 if ($checkCipher eq $_);
    }
    $ERR = "cipher is not supported.";
    return 0;
}

#--------------------------------------------------------------
# Converts long(?name of the type?) cipher name to 
# openssl/tstclntw cipher name.
# Returns:
#   0 if cipher was not listed. 1 upon success.
#
sub convertCipher {
    my ($cipher) = @_;
    my @retList;
    my $resStr;
    my %cipherTable = %{$osDataArr{cipherTable}};

    debug("Entering convertCipher", $cipher);
    if (defined $cipher) {
        my $cphr = $cipherTable{$cipher};
        if (!defined $cphr) {
            $ERR = "cipher is not listed.";
            return 0;
        }        
        &{$osDataArr{'cipherIsSupportedFn'}}($cphr) || return 0;
        $ciphers = "$cphr";
        return 1;
    }
    return 0;
}

#################################################################
#  UNIX Apache Specific functions
#----------------------------------------------------------------

#--------------------------------------------------------------
# Executes ssl client command to get a list of ciphers supported
# by client.
#
sub getSupportedCipherList_Unix {
    my @arr, @suppCiphersTable;

    debug "Entering getSupportedCipherList_Unix function";

    eval '$sLisrCmd = "'.$osDataArr{'suppCiphersCmd'}.'"';
    if (!open (OUT, "$sLisrCmd|")) {
        $ERR="Can not run command to verify supported cipher list.";
        return 0;
    }
    @arr = <OUT>;
    chop $arr[0];
    @suppCiphersTable = split /:/, $arr[0];
    debug("Supported ciphers", $arr[0]);
    $suppCiphersTablePrt = \@suppCiphersTable;
    close(OUT);
    return 1;
}

#--------------------------------------------------------------
# Lunches ssl client command in response to a request.
#
#
sub execClientCmd_Unix {
    my $proto;
    local $ciphers;

    debug "Entering execClientCmd_Unix";
    if (defined $in_cipher && $in_cipher ne "") {
        my @arr = split /_/, $in_cipher, 2;
        $proto = "-".$arr[0];
        $proto =~ tr /SLT/slt/;
        $proto = "-tls1" if ($proto eq "-tls");
        return 0 if (!&{$osDataArr{'cipherListFn'}}($in_cipher));
        $ciphers = "-cipher $ciphers";
        debug("Return from cipher conversion", "$ciphers");
    }

    eval '$command = "'.$osDataArr{'clientRunCmd'}.'"';
    debug("Executing command", $command);
    if (!open CMD_OUT, "$command 2>&1 |") {
       $ERR = "can not launch client";
       return 0;
    }

    my @cmdOutArr = <CMD_OUT>;
    
    foreach (@cmdOutArr) {
        print $_;
    }

    my $haveVerify = 0;
    my $haveErrors = 0;
    foreach (@cmdOutArr) {
        chop;
        if (/unknown option/) {
            $haveErrors++;
            svr_error "unknown option\n";
            next;
        }
        if (/:no ciphers available/) {
            $haveErrors++;
            svr_error "no cipthers available\n";
            next;
        }
        if (/verify error:/) {
            $haveErrors++;
            svr_error "unable to do verification\n";
            next;
        }
        if (/alert certificate revoked:/) {
            $haveErrors++;
            svr_error "attempt to connect with revoked sertificate\n";
            next;
        }
        if (/(error|ERROR)/) {
            $haveErrors++;
            svr_error "found errors in server log\n";
            next;
        }
        /verify return:1/ && ($haveVerify = 1);
    }
     if ($haveVerify == 0) {
         svr_error "no 'verify return:1' found in server log\n";
         $haveErrors++;
     }

    if ($haveErrors > 0) {
        $ERR = "Have $haveErrors server errors";
        debug "Exiting execClientCmd_Unix";
        return 0;
    }
    debug "Exiting execClientCmd_Unix";
    return 1;
}

#################################################################
#  Windows IIS Specific functions
#----------------------------------------------------------------

#--------------------------------------------------------------
# Executes ssl client command to get a list of ciphers supported
# by client.
#
sub getSupportedCipherList_Win {
    my @arr, @suppCiphersTable;

    debug "Entering getSupportedCipherList_Win function";

    eval '$sLisrCmd = "'.$osDataArr{'suppCiphersCmd'}.'"';
    if (!open (OUT, "$sLisrCmd|")) {
        $ERR="Can not run command to verify supported cipher list.";
        return 0;
    }
    my $startCipherList = 0;
    foreach (<OUT>) {
        chop;
        if ($startCipherList) {
            /^([a-zA-Z])\s+/ && push @suppCiphersTable, $1;
            next;
        }
        /.*from list below.*/ && ($startCipherList = 1);
    }
    debug("Supported ciphers", join ':', @suppCiphersTable);
    $suppCiphersTablePrt = \@suppCiphersTable;
    close(OUT);
    return 1;
}

#--------------------------------------------------------------
# Lunches ssl client command in response to a request.
#
#
sub execClientCmd_Win {
    my $proto;
    local $ciphers;

    debug "Entering execClientCmd_Win";
    if (defined $in_cipher && $in_cipher ne "") {
        my @arr = split /_/, $in_cipher, 2;
        $proto = "-2 -3 -T";

        $proto =~ s/-T// if ($arr[0] eq "TLS");
        $proto =~ s/-3// if ($arr[0] eq "SSL3");
        $proto =~ s/-2// if ($arr[0] eq "SSL2");
	return 0 if (!&{$osDataArr{'cipherListFn'}}($in_cipher));
        $ciphers = "-c $ciphers";
        debug("Return from cipher conversion", $ciphers);
    }

    eval '$command = "'.$osDataArr{'clientRunCmd'}.'"';
    debug("Executing command", $command);
    if (!open CMD_OUT, "$command 2>&1 |") {
        $ERR = "can not launch client";
        return 0;
    }

    my @cmdOutArr = <CMD_OUT>;
    
    foreach (@cmdOutArr) {
        print $_;
    }

    my $haveVerify = 0;
    my $haveErrors = 0;
    foreach (@cmdOutArr) {
        chop;
        if (/unknown option/) {
            $haveErrors++;
            svr_error "unknown option\n";
            next;
        }
        if (/Error performing handshake/) {
            $haveErrors++;
            svr_error "Error performing handshake\n";
            next;
        }
        if (/Error creating credentials/) {
            $haveErrors++;
            svr_error "Error creating credentials\n";
            next;
        }
        if (/Error .* authenticating server credentials!/) {
            $haveErrors++;
            svr_error "Error authenticating server credentials\n";
            next;
        }
        if (/(error|ERROR|Error)/) {
            $haveErrors++;
            svr_error "found errors in server log\n";
            next;
        }
    }

    if ($haveErrors > 0) {
        $ERR = "Have $haveErrors server errors";
        debug "Exiting execClientCmd_Win";
        return 0;
    }
    debug "Exiting execClientCmd_Win";
    return 1;
}

#################################################################
#  Main line of execution
#----------------------------------------------------------------
&init;

if ($osDataArr{wservRun}) {
    print header('text/html').
        start_html('iopr client');
}
 
print "SCRIPT=OK\n";

if (!&getReqData) { 
    svr_error($ERR, 1);
}

if (!&configClient) { 
    svr_error($ERR, 1);
}

&{$osDataArr{'execCmdFn'}} || svr_error;

if ($osDataArr{wservRun}) {
    print "</pre>";
    print end_html;
}