secureserver.pl 11 KB

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