client.cgi (15192B)
1 #!/usr/bin/perl 2 3 # This Source Code Form is subject to the terms of the Mozilla Public 4 # License, v. 2.0. If a copy of the MPL was not distributed with this 5 # file, You can obtain one at http://mozilla.org/MPL/2.0/. 6 7 #-------------------------------------------------------------- 8 # cgi script that parses request argument to appropriate 9 # open ssl or tstclntw options and starts ssl client. 10 # 11 12 use CGI qw/:standard/; 13 14 use subs qw(debug); 15 16 #-------------------------------------------------------------- 17 # Prints out an error string and exits the script with an 18 # exitStatus. 19 # Param: 20 # str : an error string 21 # exitStat: an exit status of the program 22 # 23 sub svr_error { 24 my ($str, $exitStat) = @_; 25 26 if (!defined $str || $str eq "") { 27 $str = $ERR; 28 } 29 print "SERVER ERROR: $str\n"; 30 if ($exitStat) { 31 print end_html if ($osDataArr{wservRun}); 32 exit $exitStat; 33 } 34 } 35 36 #-------------------------------------------------------------- 37 # Prints out a debug message 38 # Params: 39 # str: debug message 40 # inVal: additional value to print(optional) 41 # 42 sub debug { 43 my ($str, $inVal) = @_; 44 45 print "-- DEBUG: $str ($inVal)\n" if ($DEBUG == 1); 46 } 47 48 49 #-------------------------------------------------------------- 50 # Initializes execution context depending on a webserver the 51 # script is running under. 52 # 53 sub init { 54 %osDataArr = ( 55 loadSupportedCipthersFn => \&osSpecific, 56 cipherIsSupportedFn => \&verifyCipherSupport, 57 cipherListFn => \&convertCipher, 58 buildCipherTableFn => \&buildCipherTable, 59 execCmdFn => \&osSpecific, 60 ); 61 62 $scriptName = $ENV{'SCRIPT_NAME'}; 63 if (!defined $scriptName) { 64 $DEBUG=1; 65 debug "Debug is ON"; 66 } 67 $DEBUG=1; 68 69 $svrSoft = $ENV{'SERVER_SOFTWARE'}; 70 if (defined $svrSoft) { 71 $_ = $svrSoft; 72 /.*Microsoft.*/ && ($osDataArr{wserv} = "IIS"); 73 /.*Apache.*/ && ($osDataArr{wserv} = "Apache"); 74 $osDataArr{wservRun} = 1; 75 } else { 76 $osDataArr{wserv} = "Apache"; 77 $osDataArr{wservRun} = 0; 78 } 79 } 80 81 #-------------------------------------------------------------- 82 # Function-spigot to handle errors is OS specific functions are 83 # not implemented for a particular OS. 84 # Returns: 85 # always returns 0(failure) 86 # 87 sub osSpecific { 88 $ERR = "This function should be swapped to os specific function."; 89 return 0; 90 } 91 92 #-------------------------------------------------------------- 93 # Sets os specific execution context values. 94 # Returns: 95 # 1 upon success, or 0 upon failure(if OS was not recognized) 96 # 97 sub setFunctRefs { 98 99 debug("Entering setFunctRefs function", $osDataArr{wserv}); 100 101 if ($osDataArr{wserv} eq "Apache") { 102 $osDataArr{osConfigFile} = "apache_unix.cfg"; 103 $osDataArr{suppCiphersCmd} = '$opensslb ciphers ALL:NULL'; 104 $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'; 105 $osDataArr{loadSupportedCipthersFn} = \&getSupportedCipherList_Unix; 106 $osDataArr{execCmdFn} = \&execClientCmd_Unix; 107 } elsif ($osDataArr{wserv} eq "IIS") { 108 $osDataArr{osConfigFile} = "iis_windows.cfg"; 109 $osDataArr{suppCiphersCmd} = '$tstclntwb'; 110 $osDataArr{clientRunCmd} = '$tstclntwb -h $in_host -p $in_port -n $in_cert $proto $ciphers < $reqFile'; 111 $osDataArr{loadSupportedCipthersFn} = \&getSupportedCipherList_Win; 112 $osDataArr{execCmdFn} = \&execClientCmd_Win; 113 } else { 114 $ERR = "Unknown Web Server type."; 115 return 0; 116 } 117 return 1; 118 } 119 120 #-------------------------------------------------------------- 121 # Parses data from HTTP request. Will print a form if request 122 # does not contain sufficient number of parameters. 123 # Returns: 124 # 1 if request has sufficient number of parameters 125 # 0 if not. 126 sub getReqData { 127 my $debug = param('debug'); 128 $in_host = param('host'); 129 $in_port = param('port'); 130 $in_cert = param('cert'); 131 $in_cipher = param('cipher'); 132 133 if (!$osDataArr{wservRun}) { 134 $in_host="goa1"; 135 $in_port="443"; 136 $in_cert="TestUser511"; 137 $in_cipher = "SSL3_RSA_WITH_NULL_SHA"; 138 } 139 140 debug("Entering getReqData function", "$in_port:$in_host:$in_cert:$in_cipher"); 141 142 if (defined $debug && $debug == "debug on") { 143 $DEBUG = 1; 144 } 145 146 if (!defined $in_host || $in_host eq "" || 147 !defined $in_port || $in_port eq "" || 148 !defined $in_cert || $in_cert eq "") { 149 if ($osDataArr{wservRun}) { 150 print h1('Command description form:'), 151 start_form(-method=>"get"), 152 "Host: ",textfield('host'),p, 153 "Port: ",textfield('port'),p, 154 "Cert: ",textfield('cert'),p, 155 "Cipher: ",textfield('cipher'),p, 156 checkbox_group(-name=>'debug', 157 -values=>['debug on ']), 158 submit, 159 end_form, 160 hr; 161 } else { 162 print "Printing html form to get client arguments\n"; 163 } 164 $ERR = "the following parameters are required: host, port, cert"; 165 return 0; 166 } else { 167 print "<pre>" if ($osDataArr{wservRun}); 168 return 1; 169 } 170 } 171 172 173 #-------------------------------------------------------------- 174 # Building cipher conversion table from file based on the OS. 175 # Params: 176 # tfile: cipher conversion file. 177 # sysName: system name 178 # tblPrt: returned pointer to a table. 179 sub buildCipherTable { 180 my ($tfile, $sysName, $tblPrt) = @_; 181 my @retArr = @$tblPrt; 182 my %table, %rtable; 183 my $strCount = 0; 184 185 debug("Entering getReqData function", "$tfile:$sysName:$tblPrt"); 186 187 ($ERR = "No system name supplied" && return 0) if ($sysName =~ /^$/); 188 if (!open(TFILE, "$tfile")) { 189 $ERR = "Missing cipher conversion table file."; 190 return 0; 191 } 192 foreach (<TFILE>) { 193 chop; 194 /^#.*/ && next; 195 /^\s*$/ && next; 196 if ($strCount++ == 0) { 197 my @sysArr = split /\s+/; 198 $colCount = 0; 199 for (;$colCount <= $#sysArr;$colCount++) { 200 last if ($sysArr[$colCount] =~ /(.*:|^)$sysName.*/); 201 } 202 next; 203 } 204 my @ciphArr = split /\s+/, $_; 205 $table{$ciphArr[0]} = $ciphArr[$colCount]; 206 $rtable{$ciphArr[$colCount]} = $ciphArr[0]; 207 } 208 close(TFILE); 209 $cipherTablePtr[0] = \%table; 210 $cipherTablePtr[1] = \%rtable; 211 return 1 212 } 213 214 #-------------------------------------------------------------- 215 # Client configuration function. Loads client configuration file. 216 # Initiates cipher table. Loads cipher list supported by ssl client. 217 # 218 sub configClient { 219 220 debug "Entering configClient function"; 221 222 my $res = &setFunctRefs(); 223 return $res if (!$res); 224 225 open(CFILE, $osDataArr{'osConfigFile'}) || 226 ($ERR = "Missing configuration file." && return 0); 227 foreach (<CFILE>) { 228 /^#.*/ && next; 229 chop; 230 eval $_; 231 } 232 close(CFILE); 233 234 local @cipherTablePtr = (); 235 $osDataArr{'buildCipherTableFn'}->($cipherTableFile, $clientSys) || return 0; 236 $osDataArr{cipherTable} = $cipherTablePtr[0]; 237 $osDataArr{rcipherTable} = $cipherTablePtr[1]; 238 239 local $suppCiphersTablePrt; 240 &{$osDataArr{'loadSupportedCipthersFn'}} || return 0; 241 $osDataArr{suppCiphersTable} = $suppCiphersTablePrt; 242 } 243 244 #-------------------------------------------------------------- 245 # Verifies that a particular cipher is supported. 246 # Params: 247 # checkCipher: cipher name 248 # Returns: 249 # 1 - cipher is supported(also echos the cipher). 250 # 0 - not supported. 251 # 252 sub verifyCipherSupport { 253 my ($checkCipher) = @_; 254 my @suppCiphersTable = @{$osDataArr{suppCiphersTable}}; 255 256 debug("Entering verifyCipherSupport", $checkCipher); 257 foreach (@suppCiphersTable) { 258 return 1 if ($checkCipher eq $_); 259 } 260 $ERR = "cipher is not supported."; 261 return 0; 262 } 263 264 #-------------------------------------------------------------- 265 # Converts long(?name of the type?) cipher name to 266 # openssl/tstclntw cipher name. 267 # Returns: 268 # 0 if cipher was not listed. 1 upon success. 269 # 270 sub convertCipher { 271 my ($cipher) = @_; 272 my @retList; 273 my $resStr; 274 my %cipherTable = %{$osDataArr{cipherTable}}; 275 276 debug("Entering convertCipher", $cipher); 277 if (defined $cipher) { 278 my $cphr = $cipherTable{$cipher}; 279 if (!defined $cphr) { 280 $ERR = "cipher is not listed."; 281 return 0; 282 } 283 &{$osDataArr{'cipherIsSupportedFn'}}($cphr) || return 0; 284 $ciphers = "$cphr"; 285 return 1; 286 } 287 return 0; 288 } 289 290 ################################################################# 291 # UNIX Apache Specific functions 292 #---------------------------------------------------------------- 293 294 #-------------------------------------------------------------- 295 # Executes ssl client command to get a list of ciphers supported 296 # by client. 297 # 298 sub getSupportedCipherList_Unix { 299 my @arr, @suppCiphersTable; 300 301 debug "Entering getSupportedCipherList_Unix function"; 302 303 eval '$sLisrCmd = "'.$osDataArr{'suppCiphersCmd'}.'"'; 304 if (!open (OUT, "$sLisrCmd|")) { 305 $ERR="Can not run command to verify supported cipher list."; 306 return 0; 307 } 308 @arr = <OUT>; 309 chop $arr[0]; 310 @suppCiphersTable = split /:/, $arr[0]; 311 debug("Supported ciphers", $arr[0]); 312 $suppCiphersTablePrt = \@suppCiphersTable; 313 close(OUT); 314 return 1; 315 } 316 317 #-------------------------------------------------------------- 318 # Lunches ssl client command in response to a request. 319 # 320 # 321 sub execClientCmd_Unix { 322 my $proto; 323 local $ciphers; 324 325 debug "Entering execClientCmd_Unix"; 326 if (defined $in_cipher && $in_cipher ne "") { 327 my @arr = split /_/, $in_cipher, 2; 328 $proto = "-".$arr[0]; 329 $proto =~ tr /SLT/slt/; 330 $proto = "-tls1" if ($proto eq "-tls"); 331 return 0 if (!&{$osDataArr{'cipherListFn'}}($in_cipher)); 332 $ciphers = "-cipher $ciphers"; 333 debug("Return from cipher conversion", "$ciphers"); 334 } 335 336 eval '$command = "'.$osDataArr{'clientRunCmd'}.'"'; 337 debug("Executing command", $command); 338 if (!open CMD_OUT, "$command 2>&1 |") { 339 $ERR = "can not launch client"; 340 return 0; 341 } 342 343 my @cmdOutArr = <CMD_OUT>; 344 345 foreach (@cmdOutArr) { 346 print $_; 347 } 348 349 my $haveVerify = 0; 350 my $haveErrors = 0; 351 foreach (@cmdOutArr) { 352 chop; 353 if (/unknown option/) { 354 $haveErrors++; 355 svr_error "unknown option\n"; 356 next; 357 } 358 if (/:no ciphers available/) { 359 $haveErrors++; 360 svr_error "no cipthers available\n"; 361 next; 362 } 363 if (/verify error:/) { 364 $haveErrors++; 365 svr_error "unable to do verification\n"; 366 next; 367 } 368 if (/alert certificate revoked:/) { 369 $haveErrors++; 370 svr_error "attempt to connect with revoked sertificate\n"; 371 next; 372 } 373 if (/(error|ERROR)/) { 374 $haveErrors++; 375 svr_error "found errors in server log\n"; 376 next; 377 } 378 /verify return:1/ && ($haveVerify = 1); 379 } 380 if ($haveVerify == 0) { 381 svr_error "no 'verify return:1' found in server log\n"; 382 $haveErrors++; 383 } 384 385 if ($haveErrors > 0) { 386 $ERR = "Have $haveErrors server errors"; 387 debug "Exiting execClientCmd_Unix"; 388 return 0; 389 } 390 debug "Exiting execClientCmd_Unix"; 391 return 1; 392 } 393 394 ################################################################# 395 # Windows IIS Specific functions 396 #---------------------------------------------------------------- 397 398 #-------------------------------------------------------------- 399 # Executes ssl client command to get a list of ciphers supported 400 # by client. 401 # 402 sub getSupportedCipherList_Win { 403 my @arr, @suppCiphersTable; 404 405 debug "Entering getSupportedCipherList_Win function"; 406 407 eval '$sLisrCmd = "'.$osDataArr{'suppCiphersCmd'}.'"'; 408 if (!open (OUT, "$sLisrCmd|")) { 409 $ERR="Can not run command to verify supported cipher list."; 410 return 0; 411 } 412 my $startCipherList = 0; 413 foreach (<OUT>) { 414 chop; 415 if ($startCipherList) { 416 /^([a-zA-Z])\s+/ && push @suppCiphersTable, $1; 417 next; 418 } 419 /.*from list below.*/ && ($startCipherList = 1); 420 } 421 debug("Supported ciphers", join ':', @suppCiphersTable); 422 $suppCiphersTablePrt = \@suppCiphersTable; 423 close(OUT); 424 return 1; 425 } 426 427 #-------------------------------------------------------------- 428 # Lunches ssl client command in response to a request. 429 # 430 # 431 sub execClientCmd_Win { 432 my $proto; 433 local $ciphers; 434 435 debug "Entering execClientCmd_Win"; 436 if (defined $in_cipher && $in_cipher ne "") { 437 my @arr = split /_/, $in_cipher, 2; 438 $proto = "-2 -3 -T"; 439 440 $proto =~ s/-T// if ($arr[0] eq "TLS"); 441 $proto =~ s/-3// if ($arr[0] eq "SSL3"); 442 $proto =~ s/-2// if ($arr[0] eq "SSL2"); 443 return 0 if (!&{$osDataArr{'cipherListFn'}}($in_cipher)); 444 $ciphers = "-c $ciphers"; 445 debug("Return from cipher conversion", $ciphers); 446 } 447 448 eval '$command = "'.$osDataArr{'clientRunCmd'}.'"'; 449 debug("Executing command", $command); 450 if (!open CMD_OUT, "$command 2>&1 |") { 451 $ERR = "can not launch client"; 452 return 0; 453 } 454 455 my @cmdOutArr = <CMD_OUT>; 456 457 foreach (@cmdOutArr) { 458 print $_; 459 } 460 461 my $haveVerify = 0; 462 my $haveErrors = 0; 463 foreach (@cmdOutArr) { 464 chop; 465 if (/unknown option/) { 466 $haveErrors++; 467 svr_error "unknown option\n"; 468 next; 469 } 470 if (/Error performing handshake/) { 471 $haveErrors++; 472 svr_error "Error performing handshake\n"; 473 next; 474 } 475 if (/Error creating credentials/) { 476 $haveErrors++; 477 svr_error "Error creating credentials\n"; 478 next; 479 } 480 if (/Error .* authenticating server credentials!/) { 481 $haveErrors++; 482 svr_error "Error authenticating server credentials\n"; 483 next; 484 } 485 if (/(error|ERROR|Error)/) { 486 $haveErrors++; 487 svr_error "found errors in server log\n"; 488 next; 489 } 490 } 491 492 if ($haveErrors > 0) { 493 $ERR = "Have $haveErrors server errors"; 494 debug "Exiting execClientCmd_Win"; 495 return 0; 496 } 497 debug "Exiting execClientCmd_Win"; 498 return 1; 499 } 500 501 ################################################################# 502 # Main line of execution 503 #---------------------------------------------------------------- 504 &init; 505 506 if ($osDataArr{wservRun}) { 507 print header('text/html'). 508 start_html('iopr client'); 509 } 510 511 print "SCRIPT=OK\n"; 512 513 if (!&getReqData) { 514 svr_error($ERR, 1); 515 } 516 517 if (!&configClient) { 518 svr_error($ERR, 1); 519 } 520 521 &{$osDataArr{'execCmdFn'}} || svr_error; 522 523 if ($osDataArr{wservRun}) { 524 print "</pre>"; 525 print end_html; 526 }