The Tor Browser / file comparison

comparison: security/nss/tests/iopr/server_scr/client.cgi

security/nss/tests/iopr/server_scr/client.cgi

changeset 0
6474c204b198
equal deleted inserted replaced
-1:000000000000 0:f2a7e70d1a50
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 }

Mercurial Repository: The Tor Browser

Europalab SCM Repository Server

mercurial