1: #!/usr/bin/env perl
2: #***************************************************************************
3: # _ _ ____ _
4: # Project ___| | | | _ \| |
5: # / __| | | | |_) | |
6: # | (__| |_| | _ <| |___
7: # \___|\___/|_| \_\_____|
8: #
9: # Copyright (C) 1998 - 2020, Daniel Stenberg, <daniel@haxx.se>, et al.
10: #
11: # This software is licensed as described in the file COPYING, which
12: # you should have received as part of this distribution. The terms
13: # are also available at https://curl.haxx.se/docs/copyright.html.
14: #
15: # You may opt to use, copy, modify, merge, publish, distribute and/or sell
16: # copies of the Software, and permit persons to whom the Software is
17: # furnished to do so, under the terms of the COPYING file.
18: #
19: # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
20: # KIND, either express or implied.
21: #
22: #***************************************************************************
23:
24: # This is the HTTPS, FTPS, POP3S, IMAPS, SMTPS, server used for curl test
25: # harness. Actually just a layer that runs stunnel properly using the
26: # non-secure test harness servers.
27:
28: BEGIN {
29: push(@INC, $ENV{'srcdir'}) if(defined $ENV{'srcdir'});
30: push(@INC, ".");
31: }
32:
33: use strict;
34: use warnings;
35: use Cwd;
36: use Cwd 'abs_path';
37:
38: use serverhelp qw(
39: server_pidfilename
40: server_logfilename
41: );
42:
43: use pathhelp;
44:
45: my $stunnel = "stunnel";
46:
47: my $verbose=0; # set to 1 for debugging
48:
49: my $accept_port = 8991; # just our default, weird enough
50: my $target_port = 8999; # default test http-server port
51:
52: my $stuncert;
53:
54: my $ver_major;
55: my $ver_minor;
56: my $fips_support;
57: my $stunnel_version;
58: my $tstunnel_windows;
59: my $socketopt;
60: my $cmd;
61:
62: my $pidfile; # stunnel pid file
63: my $logfile; # stunnel log file
64: my $loglevel = 5; # stunnel log level
65: my $ipvnum = 4; # default IP version of stunneled server
66: my $idnum = 1; # default stunneled server instance number
67: my $proto = 'https'; # default secure server protocol
68: my $conffile; # stunnel configuration file
69: my $capath; # certificate chain PEM folder
70: my $certfile; # certificate chain PEM file
71:
72: #***************************************************************************
73: # stunnel requires full path specification for several files.
74: #
75: my $path = getcwd();
76: my $srcdir = $path;
77: my $logdir = $path .'/log';
78:
79: #***************************************************************************
80: # Signal handler to remove our stunnel 4.00 and newer configuration file.
81: #
82: sub exit_signal_handler {
83: my $signame = shift;
84: local $!; # preserve errno
85: local $?; # preserve exit status
86: unlink($conffile) if($conffile && (-f $conffile));
87: exit;
88: }
89:
90: #***************************************************************************
91: # Process command line options
92: #
93: while(@ARGV) {
94: if($ARGV[0] eq '--verbose') {
95: $verbose = 1;
96: }
97: elsif($ARGV[0] eq '--proto') {
98: if($ARGV[1]) {
99: $proto = $ARGV[1];
100: shift @ARGV;
101: }
102: }
103: elsif($ARGV[0] eq '--accept') {
104: if($ARGV[1]) {
105: if($ARGV[1] =~ /^(\d+)$/) {
106: $accept_port = $1;
107: shift @ARGV;
108: }
109: }
110: }
111: elsif($ARGV[0] eq '--connect') {
112: if($ARGV[1]) {
113: if($ARGV[1] =~ /^(\d+)$/) {
114: $target_port = $1;
115: shift @ARGV;
116: }
117: }
118: }
119: elsif($ARGV[0] eq '--stunnel') {
120: if($ARGV[1]) {
121: if($ARGV[1] =~ /^([\w\/]+)$/) {
122: $stunnel = $ARGV[1];
123: }
124: else {
125: $stunnel = "\"". $ARGV[1] ."\"";
126: }
127: shift @ARGV;
128: }
129: }
130: elsif($ARGV[0] eq '--srcdir') {
131: if($ARGV[1]) {
132: $srcdir = $ARGV[1];
133: shift @ARGV;
134: }
135: }
136: elsif($ARGV[0] eq '--certfile') {
137: if($ARGV[1]) {
138: $stuncert = $ARGV[1];
139: shift @ARGV;
140: }
141: }
142: elsif($ARGV[0] eq '--id') {
143: if($ARGV[1]) {
144: if($ARGV[1] =~ /^(\d+)$/) {
145: $idnum = $1 if($1 > 0);
146: shift @ARGV;
147: }
148: }
149: }
150: elsif($ARGV[0] eq '--ipv4') {
151: $ipvnum = 4;
152: }
153: elsif($ARGV[0] eq '--ipv6') {
154: $ipvnum = 6;
155: }
156: elsif($ARGV[0] eq '--pidfile') {
157: if($ARGV[1]) {
158: $pidfile = "$path/". $ARGV[1];
159: shift @ARGV;
160: }
161: }
162: elsif($ARGV[0] eq '--logfile') {
163: if($ARGV[1]) {
164: $logfile = "$path/". $ARGV[1];
165: shift @ARGV;
166: }
167: }
168: else {
169: print STDERR "\nWarning: secureserver.pl unknown parameter: $ARGV[0]\n";
170: }
171: shift @ARGV;
172: }
173:
174: #***************************************************************************
175: # Initialize command line option dependent variables
176: #
177: if(!$pidfile) {
178: $pidfile = "$path/". server_pidfilename($proto, $ipvnum, $idnum);
179: }
180: if(!$logfile) {
181: $logfile = server_logfilename($logdir, $proto, $ipvnum, $idnum);
182: }
183:
184: $conffile = "$path/${proto}_stunnel.conf";
185:
186: $capath = abs_path($path);
187: $certfile = "$srcdir/". ($stuncert?"certs/$stuncert":"stunnel.pem");
188: $certfile = abs_path($certfile);
189:
190: my $ssltext = uc($proto) ." SSL/TLS:";
191:
192: #***************************************************************************
193: # Find out version info for the given stunnel binary
194: #
195: foreach my $veropt (('-version', '-V')) {
196: foreach my $verstr (qx($stunnel $veropt 2>&1)) {
197: if($verstr =~ /^stunnel (\d+)\.(\d+) on /) {
198: $ver_major = $1;
199: $ver_minor = $2;
200: }
201: elsif($verstr =~ /^sslVersion.*fips *= *yes/) {
202: # the fips option causes an error if stunnel doesn't support it
203: $fips_support = 1;
204: last
205: }
206: }
207: last if($ver_major);
208: }
209: if((!$ver_major) || (!$ver_minor)) {
210: if(-x "$stunnel" && ! -d "$stunnel") {
211: print "$ssltext Unknown stunnel version\n";
212: }
213: else {
214: print "$ssltext No stunnel\n";
215: }
216: exit 1;
217: }
218: $stunnel_version = (100*$ver_major) + $ver_minor;
219:
220: #***************************************************************************
221: # Verify minimum stunnel required version
222: #
223: if($stunnel_version < 310) {
224: print "$ssltext Unsupported stunnel version $ver_major.$ver_minor\n";
225: exit 1;
226: }
227:
228: #***************************************************************************
229: # Find out if we are running on Windows using the tstunnel binary
230: #
231: if($stunnel =~ /tstunnel(\.exe)?"?$/) {
232: $tstunnel_windows = 1;
233:
234: # convert Cygwin/MinGW paths to Win32 format
235: $capath = pathhelp::sys_native_abs_path($capath);
236: $certfile = pathhelp::sys_native_abs_path($certfile);
237: }
238:
239: #***************************************************************************
240: # Build command to execute for stunnel 3.X versions
241: #
242: if($stunnel_version < 400) {
243: if($stunnel_version >= 319) {
244: $socketopt = "-O a:SO_REUSEADDR=1";
245: }
246: $cmd = "$stunnel -p $certfile -P $pidfile ";
247: $cmd .= "-d $accept_port -r $target_port -f -D $loglevel ";
248: $cmd .= ($socketopt) ? "$socketopt " : "";
249: $cmd .= ">$logfile 2>&1";
250: if($verbose) {
251: print uc($proto) ." server (stunnel $ver_major.$ver_minor)\n";
252: print "cmd: $cmd\n";
253: print "pem cert file: $certfile\n";
254: print "pid file: $pidfile\n";
255: print "log file: $logfile\n";
256: print "log level: $loglevel\n";
257: print "listen on port: $accept_port\n";
258: print "connect to port: $target_port\n";
259: }
260: }
261:
262: #***************************************************************************
263: # Build command to execute for stunnel 4.00 and newer
264: #
265: if($stunnel_version >= 400) {
266: $socketopt = "a:SO_REUSEADDR=1";
267: if(($stunnel_version >= 534) && $tstunnel_windows) {
268: # SO_EXCLUSIVEADDRUSE is on by default on Vista or newer,
269: # but does not work together with SO_REUSEADDR being on.
270: $socketopt .= "\nsocket = a:SO_EXCLUSIVEADDRUSE=0";
271: }
272: $cmd = "$stunnel $conffile ";
273: $cmd .= ">$logfile 2>&1";
274: # setup signal handler
275: $SIG{INT} = \&exit_signal_handler;
276: $SIG{TERM} = \&exit_signal_handler;
277: # stunnel configuration file
278: if(open(STUNCONF, ">$conffile")) {
279: print STUNCONF "CApath = $capath\n";
280: print STUNCONF "cert = $certfile\n";
281: print STUNCONF "debug = $loglevel\n";
282: print STUNCONF "socket = $socketopt\n";
283: if($fips_support) {
284: # disable fips in case OpenSSL doesn't support it
285: print STUNCONF "fips = no\n";
286: }
287: if(!$tstunnel_windows) {
288: # do not use Linux-specific options on Windows
289: print STUNCONF "output = $logfile\n";
290: print STUNCONF "pid = $pidfile\n";
291: print STUNCONF "foreground = yes\n";
292: }
293: print STUNCONF "\n";
294: print STUNCONF "[curltest]\n";
295: print STUNCONF "accept = $accept_port\n";
296: print STUNCONF "connect = $target_port\n";
297: if(!close(STUNCONF)) {
298: print "$ssltext Error closing file $conffile\n";
299: exit 1;
300: }
301: }
302: else {
303: print "$ssltext Error writing file $conffile\n";
304: exit 1;
305: }
306: if($verbose) {
307: print uc($proto) ." server (stunnel $ver_major.$ver_minor)\n";
308: print "cmd: $cmd\n";
309: print "CApath = $capath\n";
310: print "cert = $certfile\n";
311: print "debug = $loglevel\n";
312: print "socket = $socketopt\n";
313: if($fips_support) {
314: print "fips = no\n";
315: }
316: if(!$tstunnel_windows) {
317: print "pid = $pidfile\n";
318: print "output = $logfile\n";
319: print "foreground = yes\n";
320: }
321: print "\n";
322: print "[curltest]\n";
323: print "accept = $accept_port\n";
324: print "connect = $target_port\n";
325: }
326: }
327:
328: #***************************************************************************
329: # Set file permissions on certificate pem file.
330: #
331: chmod(0600, $certfile) if(-f $certfile);
332: print STDERR "RUN: $cmd\n" if($verbose);
333:
334: #***************************************************************************
335: # Run tstunnel on Windows.
336: #
337: if($tstunnel_windows) {
338: # Fake pidfile for tstunnel on Windows.
339: if(open(OUT, ">$pidfile")) {
340: print OUT $$ . "\n";
341: close(OUT);
342: }
343:
344: # Put an "exec" in front of the command so that the child process
345: # keeps this child's process ID by being tied to the spawned shell.
346: exec("exec $cmd") || die "Can't exec() $cmd: $!";
347: # exec() will create a new process, but ties the existance of the
348: # new process to the parent waiting perl.exe and sh.exe processes.
349:
350: # exec() should never return back here to this process. We protect
351: # ourselves by calling die() just in case something goes really bad.
352: die "error: exec() has returned";
353: }
354:
355: #***************************************************************************
356: # Run stunnel.
357: #
358: my $rc = system($cmd);
359:
360: $rc >>= 8;
361:
362: unlink($conffile) if($conffile && -f $conffile);
363:
364: exit $rc;
365:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to secureserver.pl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / curl / tests