Unity-Technologies
/
curl
зеркало из https://github.com/Unity-Technologies/curl.git
1
0
Форкнуть 0
Код Задачи Пакеты Проекты Релизы Вики Активность

test harness: non-stunnel https server integration overhaul

This commit is contained in:
Yang Tse 2011-10-06 20:26:42 +02:00
Родитель f7bfdbabf2
Коммит 1958fe5745
8 изменённых файлов: 377 добавлений и 219 удалений
Показать статистику Скачать Patch файл Скачать Diff файл Показать все файлы Свернуть все файлы

4
tests/FILEFORMAT
Просмотреть файл

@ -158,7 +158,8 @@ rtsp-ipv6
imap imap
pop3 pop3
smtp smtp
http+tls-srp httptls+srp
httptls+srp-ipv6
Give only one per line. This subsection is mandatory. Give only one per line. This subsection is mandatory.
</server> </server>
@ -183,6 +184,7 @@ SSL
socks socks
unittest unittest
debug debug
TLS-SRP
as well as each protocol that curl supports. A protocol only needs to be as well as each protocol that curl supports. A protocol only needs to be
specified if it is different from the server (useful when the server specified if it is different from the server (useful when the server

2
tests/data/test320
Просмотреть файл

@ -41,7 +41,7 @@ Accept: */*
# Client-side # Client-side
<client> <client>
<server> <server>
http+tls-srp httptls+srp
</server> </server>
<features> <features>
TLS-SRP TLS-SRP

2
tests/data/test321
Просмотреть файл

@ -10,7 +10,7 @@ FAILURE
# Client-side # Client-side
<client> <client>
<server> <server>
http+tls-srp httptls+srp
</server> </server>
<features> <features>
TLS-SRP TLS-SRP

2
tests/data/test322
Просмотреть файл

@ -10,7 +10,7 @@ FAILURE
# Client-side # Client-side
<client> <client>
<server> <server>
http+tls-srp httptls+srp
</server> </server>
<features> <features>
TLS-SRP TLS-SRP

2
tests/data/test324
Просмотреть файл

@ -10,7 +10,7 @@ FAILURE
# Client-side # Client-side
<client> <client>
<server> <server>
http+tls-srp httptls+srp
</server> </server>
<features> <features>
TLS-SRP TLS-SRP

434
tests/runtests.pl
Просмотреть файл

@ -100,7 +100,7 @@ use sshhelp qw(
find_sshd find_sshd
find_ssh find_ssh
find_sftp find_sftp
find_gnutls_serv find_httptlssrv
sshversioninfo sshversioninfo
); );
@ -115,28 +115,29 @@ my $CLIENT6IP="[::1]"; # address which curl uses for incoming connections
my $base = 8990; # base port number my $base = 8990; # base port number
my $HTTPPORT; # HTTP server port my $HTTPPORT; # HTTP server port
my $HTTP6PORT; # HTTP IPv6 server port my $HTTP6PORT; # HTTP IPv6 server port
my $HTTPSPORT; # HTTPS server port my $HTTPSPORT; # HTTPS (stunnel) server port
my $FTPPORT; # FTP server port my $FTPPORT; # FTP server port
my $FTP2PORT; # FTP server 2 port my $FTP2PORT; # FTP server 2 port
my $FTPSPORT; # FTPS server port my $FTPSPORT; # FTPS (stunnel) server port
my $FTP6PORT; # FTP IPv6 server port my $FTP6PORT; # FTP IPv6 server port
my $TFTPPORT; # TFTP my $TFTPPORT; # TFTP
my $TFTP6PORT; # TFTP my $TFTP6PORT; # TFTP
my $SSHPORT; # SCP/SFTP my $SSHPORT; # SCP/SFTP
my $SOCKSPORT; # SOCKS4/5 port my $SOCKSPORT; # SOCKS4/5 port
my $POP3PORT; # POP3 my $POP3PORT; # POP3
my $POP36PORT; # POP3 IPv6 server port my $POP36PORT; # POP3 IPv6 server port
my $IMAPPORT; # IMAP my $IMAPPORT; # IMAP
my $IMAP6PORT; # IMAP IPv6 server port my $IMAP6PORT; # IMAP IPv6 server port
my $SMTPPORT; # SMTP my $SMTPPORT; # SMTP
my $SMTP6PORT; # SMTP IPv6 server port my $SMTP6PORT; # SMTP IPv6 server port
my $RTSPPORT; # RTSP my $RTSPPORT; # RTSP
my $RTSP6PORT; # RTSP IPv6 server port my $RTSP6PORT; # RTSP IPv6 server port
my $GOPHERPORT; # Gopher my $GOPHERPORT; # Gopher
my $GOPHER6PORT; # Gopher IPv6 server port my $GOPHER6PORT; # Gopher IPv6 server port
my $HTTPTLSSRPPORT; # TLS-SRP HTTP port my $HTTPTLSPORT; # HTTP TLS (non-stunnel) server port
my $HTTPTLS6PORT; # HTTP TLS (non-stunnel) IPv6 server port
my $srcdir = $ENV{'srcdir'} || '.'; my $srcdir = $ENV{'srcdir'} || '.';
my $CURL="../src/curl".exe_ext(); # what curl executable to run on the tests my $CURL="../src/curl".exe_ext(); # what curl executable to run on the tests
@ -191,6 +192,7 @@ my $valgrind = checktestcmd("valgrind");
my $valgrind_logfile="--logfile"; my $valgrind_logfile="--logfile";
my $valgrind_tool; my $valgrind_tool;
my $gdb = checktestcmd("gdb"); my $gdb = checktestcmd("gdb");
my $httptlssrv = find_httptlssrv();
my $ssl_version; # set if libcurl is built with SSL support my $ssl_version; # set if libcurl is built with SSL support
my $large_file; # set if libcurl is built with large file support my $large_file; # set if libcurl is built with large file support
@ -220,7 +222,8 @@ my $ssllib; # name of the lib we use (for human presentation)
my $has_crypto; # set if libcurl is built with cryptographic support my $has_crypto; # set if libcurl is built with cryptographic support
my $has_textaware; # set if running on a system that has a text mode concept my $has_textaware; # set if running on a system that has a text mode concept
# on files. Windows for example # on files. Windows for example
my @protocols; # array of supported protocols
my @protocols; # array of lowercase supported protocol servers
my $skipped=0; # number of tests skipped; reported in main loop my $skipped=0; # number of tests skipped; reported in main loop
my %skipped; # skipped{reason}=counter, reasons for skip my %skipped; # skipped{reason}=counter, reasons for skip
@ -340,7 +343,7 @@ sub init_serverpidfile_hash {
} }
} }
} }
for my $proto (('tftp', 'sftp', 'socks', 'ssh', 'rtsp', 'gopher', 'http+tls-srp')) { for my $proto (('tftp', 'sftp', 'socks', 'ssh', 'rtsp', 'gopher', 'httptls')) {
for my $ipvnum ((4, 6)) { for my $ipvnum ((4, 6)) {
for my $idnum ((1, 2)) { for my $idnum ((1, 2)) {
my $serv = servername_id($proto, $ipvnum, $idnum); my $serv = servername_id($proto, $ipvnum, $idnum);
@ -393,7 +396,7 @@ sub startnew {
die "error: exec() has returned"; die "error: exec() has returned";
} }
# Ugly hack but ssh client doesn't support pid files # Ugly hack but ssh client and gnutls-serv don't support pid files
if ($fake) { if ($fake) {
if(open(OUT, ">$pidfile")) { if(open(OUT, ">$pidfile")) {
print OUT $child . "\n"; print OUT $child . "\n";
@ -632,20 +635,20 @@ sub stopserver {
# All servers relative to the given one must be stopped also # All servers relative to the given one must be stopped also
# #
my @killservers; my @killservers;
if($server =~ /^(ftp|http|imap|pop3|smtp)s(.*)$/) { if($server =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|))$/) {
# given an ssl server, also kill non-ssl underlying one # given a stunnel based ssl server, also kill non-ssl underlying one
push @killservers, "${1}${2}"; push @killservers, "${1}${2}";
} }
elsif($server =~ /^(ftp|http|imap|pop3|smtp)(.*)$/) { elsif($server =~ /^(ftp|http|imap|pop3|smtp)((\d*)(-ipv6|))$/) {
# given a non-ssl server, also kill ssl piggybacking one # given a non-ssl server, also kill stunnel based ssl piggybacking one
push @killservers, "${1}s${2}"; push @killservers, "${1}s${2}";
} }
elsif($server =~ /^(socks)(.*)$/) { elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) {
# given an socks server, also kill ssh underlying one # given a socks server, also kill ssh underlying one
push @killservers, "ssh${2}"; push @killservers, "ssh${2}";
} }
elsif($server =~ /^(ssh)(.*)$/) { elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) {
# given an ssh server, also kill socks piggybacking one # given a ssh server, also kill socks piggybacking one
push @killservers, "socks${2}"; push @killservers, "socks${2}";
} }
push @killservers, $server; push @killservers, $server;
@ -654,8 +657,7 @@ sub stopserver {
# #
foreach my $server (@killservers) { foreach my $server (@killservers) {
if($run{$server}) { if($run{$server}) {
# we must prepend a space since $pidlist may already contain # we must prepend a space since $pidlist may already contain a pid
# a pid
$pidlist .= " $run{$server}"; $pidlist .= " $run{$server}";
$run{$server} = 0; $run{$server} = 0;
} }
@ -680,8 +682,8 @@ sub stopserver {
# Verify that the server that runs on $ip, $port is our server. This also # Verify that the server that runs on $ip, $port is our server. This also
# implies that we can speak with it, as there might be occasions when the # implies that we can speak with it, as there might be occasions when the
# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
# assign requested address" # # assign requested address")
#
sub verifyhttp { sub verifyhttp {
my ($proto, $ipvnum, $idnum, $ip, $port) = @_; my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
my $server = servername_id($proto, $ipvnum, $idnum); my $server = servername_id($proto, $ipvnum, $idnum);
@ -760,8 +762,8 @@ sub verifyhttp {
# Verify that the server that runs on $ip, $port is our server. This also # Verify that the server that runs on $ip, $port is our server. This also
# implies that we can speak with it, as there might be occasions when the # implies that we can speak with it, as there might be occasions when the
# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
# assign requested address" # # assign requested address")
#
sub verifyftp { sub verifyftp {
my ($proto, $ipvnum, $idnum, $ip, $port) = @_; my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
my $server = servername_id($proto, $ipvnum, $idnum); my $server = servername_id($proto, $ipvnum, $idnum);
@ -832,8 +834,8 @@ sub verifyftp {
# Verify that the server that runs on $ip, $port is our server. This also # Verify that the server that runs on $ip, $port is our server. This also
# implies that we can speak with it, as there might be occasions when the # implies that we can speak with it, as there might be occasions when the
# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
# assign requested address" # # assign requested address")
#
sub verifyrtsp { sub verifyrtsp {
my ($proto, $ipvnum, $idnum, $ip, $port) = @_; my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
my $server = servername_id($proto, $ipvnum, $idnum); my $server = servername_id($proto, $ipvnum, $idnum);
@ -905,7 +907,7 @@ sub verifyrtsp {
# Verify that the ssh server has written out its pidfile, recovering # Verify that the ssh server has written out its pidfile, recovering
# the pid from the file and returning it if a process with that pid is # the pid from the file and returning it if a process with that pid is
# actually alive. # actually alive.
#
sub verifyssh { sub verifyssh {
my ($proto, $ipvnum, $idnum, $ip, $port) = @_; my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
my $server = servername_id($proto, $ipvnum, $idnum); my $server = servername_id($proto, $ipvnum, $idnum);
@ -931,7 +933,7 @@ sub verifyssh {
####################################################################### #######################################################################
# Verify that we can connect to the sftp server, properly authenticate # Verify that we can connect to the sftp server, properly authenticate
# with generated config and key files and run a simple remote pwd. # with generated config and key files and run a simple remote pwd.
#
sub verifysftp { sub verifysftp {
my ($proto, $ipvnum, $idnum, $ip, $port) = @_; my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
my $server = servername_id($proto, $ipvnum, $idnum); my $server = servername_id($proto, $ipvnum, $idnum);
@ -966,17 +968,16 @@ sub verifysftp {
} }
####################################################################### #######################################################################
# Verify that the TLS-SRP HTTP server that runs on $ip, $port is our server. # Verify that the non-stunnel HTTP TLS extensions capable server that runs
# This also implies that we can speak with it, as there might be occasions when # on $ip, $port is our server. This also implies that we can speak with it,
# the server runs fine but we cannot talk to it ("Failed to connect to ::1: # as there might be occasions when the server runs fine but we cannot talk
# Can't assign requested address" # # to it ("Failed to connect to ::1: Can't assign requested address")
#
sub verifyhttptlssrp { sub verifyhttptls {
my ($proto, $ipvnum, $idnum, $ip, $port) = @_; my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
my $server = servername_id($proto, $ipvnum, $idnum); my $server = servername_id($proto, $ipvnum, $idnum);
my $pidfile = server_pidfilename($proto, $ipvnum, $idnum); my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
my $pid = 0; my $pid = 0;
my $bonus="";
my $verifyout = "$LOGDIR/". my $verifyout = "$LOGDIR/".
servername_canon($proto, $ipvnum, $idnum) .'_verify.out'; servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
@ -991,7 +992,9 @@ sub verifyhttptlssrp {
$flags .= "--verbose "; $flags .= "--verbose ";
$flags .= "--globoff "; $flags .= "--globoff ";
$flags .= "--insecure "; $flags .= "--insecure ";
$flags .= "--tlsauthtype SRP --tlsuser jsmith --tlspassword abc "; $flags .= "--tlsauthtype SRP ";
$flags .= "--tlsuser jsmith ";
$flags .= "--tlspassword abc ";
$flags .= "\"https://$ip:$port/verifiedserver\""; $flags .= "\"https://$ip:$port/verifiedserver\"";
my $cmd = "$VCURL $flags 2>$verifylog"; my $cmd = "$VCURL $flags 2>$verifylog";
@ -1027,6 +1030,16 @@ sub verifyhttptlssrp {
if($data && ($data =~ /GNUTLS/) && open(FILE, "<$pidfile")) { if($data && ($data =~ /GNUTLS/) && open(FILE, "<$pidfile")) {
$pid=0+<FILE>; $pid=0+<FILE>;
close(FILE); close(FILE);
if($pid > 0) {
# if we have a pid it is actually our httptls server,
# since runhttptlsserver() unlinks previous pidfile
if(!kill(0, $pid)) {
logmsg "RUN: $server server has died after starting up\n";
checkdied($pid);
unlink($pidfile);
$pid = -1;
}
}
return $pid; return $pid;
} }
elsif($res == 6) { elsif($res == 6) {
@ -1043,7 +1056,7 @@ sub verifyhttptlssrp {
####################################################################### #######################################################################
# STUB for verifying socks # STUB for verifying socks
#
sub verifysocks { sub verifysocks {
my ($proto, $ipvnum, $idnum, $ip, $port) = @_; my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
my $server = servername_id($proto, $ipvnum, $idnum); my $server = servername_id($proto, $ipvnum, $idnum);
@ -1072,6 +1085,11 @@ sub verifysocks {
# particular can take a long time to start if it needs to generate # particular can take a long time to start if it needs to generate
# keys on a slow or loaded host. # keys on a slow or loaded host.
# #
# Just for convenience, test harness uses 'https' and 'httptls' literals
# as values for 'proto' variable in order to differentiate different
# servers. 'https' literal is used for stunnel based https test servers,
# and 'httptls' is used for non-stunnel https test servers.
#
my %protofunc = ('http' => \&verifyhttp, my %protofunc = ('http' => \&verifyhttp,
'https' => \&verifyhttp, 'https' => \&verifyhttp,
@ -1085,7 +1103,7 @@ my %protofunc = ('http' => \&verifyhttp,
'ssh' => \&verifyssh, 'ssh' => \&verifyssh,
'socks' => \&verifysocks, 'socks' => \&verifysocks,
'gopher' => \&verifyhttp, 'gopher' => \&verifyhttp,
'http+tls-srp' => \&verifyhttptlssrp); 'httptls' => \&verifyhttptls);
sub verifyserver { sub verifyserver {
my ($proto, $ipvnum, $idnum, $ip, $port) = @_; my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
@ -1126,7 +1144,6 @@ sub runhttpserver {
my $logfile; my $logfile;
my $flags = ""; my $flags = "";
if($ipv6) { if($ipv6) {
# if IPv6, use a different setup # if IPv6, use a different setup
$ipvnum = 6; $ipvnum = 6;
@ -1193,7 +1210,7 @@ sub runhttpserver {
} }
####################################################################### #######################################################################
# start the https server (or rather, tunnel) # start the https stunnel based server
# #
sub runhttpsserver { sub runhttpsserver {
my ($verbose, $ipv6, $certfile) = @_; my ($verbose, $ipv6, $certfile) = @_;
@ -1276,14 +1293,14 @@ sub runhttpsserver {
} }
####################################################################### #######################################################################
# start the TLS-SRP HTTP server # start the non-stunnel HTTP TLS extensions capable server
# #
sub runhttptlssrpserver { sub runhttptlsserver {
my ($verbose) = @_; my ($verbose, $ipv6) = @_;
my $proto = "http+tls-srp"; my $proto = "httptls";
my $ip = $HOSTIP; my $port = ($ipv6 && ($ipv6 =~ /6$/)) ? $HTTPTLS6PORT : $HTTPTLSPORT;
my $port = $HTTPTLSSRPPORT; my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
my $ipvnum = 4; my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
my $idnum = 1; my $idnum = 1;
my $server; my $server;
my $srvrname; my $srvrname;
@ -1291,6 +1308,10 @@ sub runhttptlssrpserver {
my $logfile; my $logfile;
my $flags = ""; my $flags = "";
if(!$httptlssrv) {
return (0,0);
}
$server = servername_id($proto, $ipvnum, $idnum); $server = servername_id($proto, $ipvnum, $idnum);
$pidfile = $serverpidfile{$server}; $pidfile = $serverpidfile{$server};
@ -1310,23 +1331,16 @@ sub runhttptlssrpserver {
$logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum); $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
$flags .= "--fork " if($forkserver);
$flags .= "--http "; $flags .= "--http ";
$flags .= "-d 1 " if($debugprotocol); $flags .= "--debug 1 " if($debugprotocol);
$flags .= "--port $port "; $flags .= "--port $port ";
$flags .= "--srppasswd certs/srp-verifier-db --srppasswdconf certs/srp-verifier-conf "; $flags .= "--srppasswd certs/srp-verifier-db ";
$flags .=" >log/gnutls.out 2>&1"; $flags .= "--srppasswdconf certs/srp-verifier-conf";
# Find gnutls-serv my $cmd = "$httptlssrv $flags > $logfile 2>&1";
my $gnutlsserv = find_gnutls_serv(); my ($httptlspid, $pid2) = startnew($cmd, $pidfile, 10, 1); # fake pidfile
if(!$gnutlsserv) {
logmsg "RUN: cannot find gnutls-serv\n";
return (0,0);
}
my $cmd = "$gnutlsserv $flags";
my ($httptlssrppid, $pid2) = startnew($cmd, $pidfile, 1, 1);
if($httptlssrppid <= 0 || !kill(0, $httptlssrppid)) { if($httptlspid <= 0 || !kill(0, $httptlspid)) {
# it is NOT alive # it is NOT alive
logmsg "RUN: failed to start the $srvrname server\n"; logmsg "RUN: failed to start the $srvrname server\n";
stopserver($server, "$pid2"); stopserver($server, "$pid2");
@ -1335,12 +1349,12 @@ sub runhttptlssrpserver {
return (0,0); return (0,0);
} }
# Server is up. Verify that we can speak to it. # Server is up. Verify that we can speak to it. PID is from fake pidfile
my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port); my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
if(!$pid3) { if(!$pid3) {
logmsg "RUN: $srvrname server failed verification\n"; logmsg "RUN: $srvrname server failed verification\n";
# failed to talk to it properly. Kill the server and return failure # failed to talk to it properly. Kill the server and return failure
stopserver($server, "$httptlssrppid $pid2"); stopserver($server, "$httptlspid $pid2");
displaylogs($testnumcheck); displaylogs($testnumcheck);
$doesntrun{$pidfile} = 1; $doesntrun{$pidfile} = 1;
return (0,0); return (0,0);
@ -1348,12 +1362,12 @@ sub runhttptlssrpserver {
$pid2 = $pid3; $pid2 = $pid3;
if($verbose) { if($verbose) {
logmsg "RUN: $srvrname server is now running PID $httptlssrppid\n"; logmsg "RUN: $srvrname server is now running PID $httptlspid\n";
} }
sleep(1); sleep(1);
return ($httptlssrppid, $pid2); return ($httptlspid, $pid2);
} }
####################################################################### #######################################################################
@ -1903,7 +1917,7 @@ sub runsocksserver {
# start our socks server # start our socks server
my $cmd="$ssh -N -F $sshconfig $ip > $sshlog 2>&1"; my $cmd="$ssh -N -F $sshconfig $ip > $sshlog 2>&1";
my ($sshpid, $pid2) = startnew($cmd, $pidfile, 30, 1); my ($sshpid, $pid2) = startnew($cmd, $pidfile, 30, 1); # fake pidfile
if($sshpid <= 0 || !kill(0, $sshpid)) { if($sshpid <= 0 || !kill(0, $sshpid)) {
# it is NOT alive # it is NOT alive
@ -1917,7 +1931,7 @@ sub runsocksserver {
return (0,0); return (0,0);
} }
# Ugly hack but ssh doesn't support pid files # Ugly hack but ssh doesn't support pid files. PID is from fake pidfile.
my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port); my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
if(!$pid3) { if(!$pid3) {
logmsg "RUN: $srvrname server failed verification\n"; logmsg "RUN: $srvrname server failed verification\n";
@ -1986,7 +2000,6 @@ sub filteroff {
# compare test results with the expected output, we might filter off # compare test results with the expected output, we might filter off
# some pattern that is allowed to differ, output test results # some pattern that is allowed to differ, output test results
# #
sub compare { sub compare {
# filter off patterns _before_ this comparison! # filter off patterns _before_ this comparison!
my ($subject, $firstref, $secondref)=@_; my ($subject, $firstref, $secondref)=@_;
@ -2125,22 +2138,15 @@ sub checksystem {
} }
elsif($_ =~ /^Protocols: (.*)/i) { elsif($_ =~ /^Protocols: (.*)/i) {
# these are the protocols compiled in to this libcurl # these are the protocols compiled in to this libcurl
@protocols = split(' ', $1); @protocols = split(' ', lc($1));
# Generate a "proto-ipv6" version of each protocol to match the # Generate a "proto-ipv6" version of each protocol to match the
# IPv6 <server> name. This works even if IPv6 support isn't # IPv6 <server> name. This works even if IPv6 support isn't
# compiled in because the <features> test will fail. # compiled in because the <features> test will fail.
push @protocols, map($_ . "-ipv6", @protocols); push @protocols, map($_ . '-ipv6', @protocols);
# Hack - we need a different, non-stunnel server to test HTTP
# TLS-SRP, but we don't want to add HTTP+TLS-SRP as a protocol
# throughout curl
if ($has_gnutls) {
push @protocols, ('http+tls-srp');
}
# 'none' is used in test cases to mean no server # 'none' is used in test cases to mean no server
push @protocols, ('none'); push @protocols, 'none';
} }
elsif($_ =~ /^Features: (.*)/i) { elsif($_ =~ /^Features: (.*)/i) {
$feat = $1; $feat = $1;
@ -2187,6 +2193,27 @@ sub checksystem {
$has_tls_srp=1; $has_tls_srp=1;
} }
} }
#
# Test harness currently uses a non-stunnel server in order to
# run HTTP TLS-SRP tests required when curl is built with https
# protocol support and TLS-SRP feature enabled. For convenience
# 'httptls' may be included in the test harness protocols array
# to differentiate this from classic stunnel based 'https' test
# harness server.
#
if($has_tls_srp) {
my $add_httptls;
for(@protocols) {
if($_ =~ /^https(-ipv6|)$/) {
$add_httptls=1;
last;
}
}
if($add_httptls && (! grep /^httptls$/, @protocols)) {
push @protocols, 'httptls';
push @protocols, 'httptls-ipv6';
}
}
} }
if(!$curl) { if(!$curl) {
logmsg "unable to get curl's version, further details are:\n"; logmsg "unable to get curl's version, further details are:\n";
@ -2308,6 +2335,13 @@ sub checksystem {
logmsg sprintf("IMAP-IPv6/%d ", $IMAP6PORT); logmsg sprintf("IMAP-IPv6/%d ", $IMAP6PORT);
logmsg sprintf("SMTP-IPv6/%d\n", $SMTP6PORT); logmsg sprintf("SMTP-IPv6/%d\n", $SMTP6PORT);
} }
if($httptlssrv) {
logmsg sprintf("* HTTPTLS/%d ", $HTTPTLSPORT);
if($has_ipv6) {
logmsg sprintf("HTTPTLS-IPv6/%d ", $HTTPTLS6PORT);
}
logmsg "\n";
}
$has_textaware = ($^O eq 'MSWin32') || ($^O eq 'msys'); $has_textaware = ($^O eq 'MSWin32') || ($^O eq 'msys');
@ -2320,36 +2354,57 @@ sub checksystem {
# #
sub subVariables { sub subVariables {
my ($thing) = @_; my ($thing) = @_;
$$thing =~ s/%HOSTIP/$HOSTIP/g;
$$thing =~ s/%HTTPPORT/$HTTPPORT/g; # ports
$$thing =~ s/%HOST6IP/$HOST6IP/g;
$$thing =~ s/%HTTP6PORT/$HTTP6PORT/g;
$$thing =~ s/%HTTPSPORT/$HTTPSPORT/g;
$$thing =~ s/%FTPPORT/$FTPPORT/g;
$$thing =~ s/%FTP6PORT/$FTP6PORT/g; $$thing =~ s/%FTP6PORT/$FTP6PORT/g;
$$thing =~ s/%FTP2PORT/$FTP2PORT/g; $$thing =~ s/%FTP2PORT/$FTP2PORT/g;
$$thing =~ s/%FTPSPORT/$FTPSPORT/g; $$thing =~ s/%FTPSPORT/$FTPSPORT/g;
$$thing =~ s/%SRCDIR/$srcdir/g; $$thing =~ s/%FTPPORT/$FTPPORT/g;
$$thing =~ s/%PWD/$pwd/g;
$$thing =~ s/%TFTPPORT/$TFTPPORT/g;
$$thing =~ s/%TFTP6PORT/$TFTP6PORT/g;
$$thing =~ s/%SSHPORT/$SSHPORT/g;
$$thing =~ s/%SOCKSPORT/$SOCKSPORT/g;
$$thing =~ s/%POP3PORT/$POP3PORT/g;
$$thing =~ s/%POP36PORT/$POP36PORT/g;
$$thing =~ s/%IMAPPORT/$IMAPPORT/g;
$$thing =~ s/%IMAP6PORT/$IMAP6PORT/g;
$$thing =~ s/%SMTPPORT/$SMTPPORT/g;
$$thing =~ s/%SMTP6PORT/$SMTP6PORT/g;
$$thing =~ s/%CURL/$CURL/g;
$$thing =~ s/%USER/$USER/g;
$$thing =~ s/%CLIENTIP/$CLIENTIP/g;
$$thing =~ s/%CLIENT6IP/$CLIENT6IP/g;
$$thing =~ s/%RTSPPORT/$RTSPPORT/g;
$$thing =~ s/%RTSP6PORT/$RTSP6PORT/g;
$$thing =~ s/%GOPHERPORT/$GOPHERPORT/g;
$$thing =~ s/%GOPHER6PORT/$GOPHER6PORT/g; $$thing =~ s/%GOPHER6PORT/$GOPHER6PORT/g;
$$thing =~ s/%HTTPTLSSRPPORT/$HTTPTLSSRPPORT/g; $$thing =~ s/%GOPHERPORT/$GOPHERPORT/g;
$$thing =~ s/%HTTPTLS6PORT/$HTTPTLS6PORT/g;
$$thing =~ s/%HTTPTLSPORT/$HTTPTLSPORT/g;
$$thing =~ s/%HTTP6PORT/$HTTP6PORT/g;
$$thing =~ s/%HTTPSPORT/$HTTPSPORT/g;
$$thing =~ s/%HTTPPORT/$HTTPPORT/g;
$$thing =~ s/%IMAP6PORT/$IMAP6PORT/g;
$$thing =~ s/%IMAPPORT/$IMAPPORT/g;
$$thing =~ s/%POP36PORT/$POP36PORT/g;
$$thing =~ s/%POP3PORT/$POP3PORT/g;
$$thing =~ s/%RTSP6PORT/$RTSP6PORT/g;
$$thing =~ s/%RTSPPORT/$RTSPPORT/g;
$$thing =~ s/%SMTP6PORT/$SMTP6PORT/g;
$$thing =~ s/%SMTPPORT/$SMTPPORT/g;
$$thing =~ s/%SOCKSPORT/$SOCKSPORT/g;
$$thing =~ s/%SSHPORT/$SSHPORT/g;
$$thing =~ s/%TFTP6PORT/$TFTP6PORT/g;
$$thing =~ s/%TFTPPORT/$TFTPPORT/g;
# client IP addresses
$$thing =~ s/%CLIENT6IP/$CLIENT6IP/g;
$$thing =~ s/%CLIENTIP/$CLIENTIP/g;
# server IP addresses
$$thing =~ s/%HOST6IP/$HOST6IP/g;
$$thing =~ s/%HOSTIP/$HOSTIP/g;
# misc
$$thing =~ s/%CURL/$CURL/g;
$$thing =~ s/%PWD/$pwd/g;
$$thing =~ s/%SRCDIR/$srcdir/g;
$$thing =~ s/%USER/$USER/g;
# The purpose of FTPTIME2 and FTPTIME3 is to provide times that can be # The purpose of FTPTIME2 and FTPTIME3 is to provide times that can be
# used for time-out tests and that whould work on most hosts as these # used for time-out tests and that whould work on most hosts as these
@ -2550,7 +2605,7 @@ sub singletest {
next; next;
} }
# See if this "feature" is in the list of supported protocols # See if this "feature" is in the list of supported protocols
elsif (grep /^$f$/, @protocols) { elsif (grep /^\Q$f\E$/i, @protocols) {
next; next;
} }
@ -2987,6 +3042,10 @@ sub singletest {
# Test harness ssh server does not have this synchronization mechanism, # Test harness ssh server does not have this synchronization mechanism,
# this implies that some ssh server based tests might need a small delay # this implies that some ssh server based tests might need a small delay
# once that the client command has run to avoid false test failures. # once that the client command has run to avoid false test failures.
#
# gnutls-serv also lacks this synchronization mechanism, so gnutls-serv
# based tests might need a small delay once that the client command has
# run to avoid false test failures.
sleep($postcommanddelay) if($postcommanddelay); sleep($postcommanddelay) if($postcommanddelay);
@ -3004,20 +3063,20 @@ sub singletest {
my @killservers; my @killservers;
foreach my $server (@killtestservers) { foreach my $server (@killtestservers) {
chomp $server; chomp $server;
if($server =~ /^(ftp|http|imap|pop3|smtp)s(.*)$/) { if($server =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|))$/) {
# given an ssl server, also kill non-ssl underlying one # given a stunnel ssl server, also kill non-ssl underlying one
push @killservers, "${1}${2}"; push @killservers, "${1}${2}";
} }
elsif($server =~ /^(ftp|http|imap|pop3|smtp)(.*)$/) { elsif($server =~ /^(ftp|http|imap|pop3|smtp)((\d*)(-ipv6|))$/) {
# given a non-ssl server, also kill ssl piggybacking one # given a non-ssl server, also kill stunnel piggybacking one
push @killservers, "${1}s${2}"; push @killservers, "${1}s${2}";
} }
elsif($server =~ /^(socks)(.*)$/) { elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) {
# given an socks server, also kill ssh underlying one # given a socks server, also kill ssh underlying one
push @killservers, "ssh${2}"; push @killservers, "ssh${2}";
} }
elsif($server =~ /^(ssh)(.*)$/) { elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) {
# given an ssh server, also kill socks piggybacking one # given a ssh server, also kill socks piggybacking one
push @killservers, "socks${2}"; push @killservers, "socks${2}";
} }
push @killservers, $server; push @killservers, $server;
@ -3402,6 +3461,7 @@ sub singletest {
####################################################################### #######################################################################
# Stop all running test servers # Stop all running test servers
#
sub stopservers { sub stopservers {
my $verbose = $_[0]; my $verbose = $_[0];
# #
@ -3449,17 +3509,17 @@ sub stopservers {
# startservers() starts all the named servers # startservers() starts all the named servers
# #
# Returns: string with error reason or blank for success # Returns: string with error reason or blank for success
#
sub startservers { sub startservers {
my @what = @_; my @what = @_;
my ($pid, $pid2); my ($pid, $pid2);
for(@what) { for(@what) {
my (@whatlist) = split(/\s+/,$_); my (@whatlist) = split(/\s+/,$_);
my $what = lc($whatlist[0]); my $what = lc($whatlist[0]);
$what =~ s/[^a-z0-9-+]//g; $what =~ s/[^a-z0-9-]//g;
my $certfile; my $certfile;
if($what =~ /^(ftp|http|imap|pop3|smtp)s(.*)$/) { if($what =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|))$/) {
$certfile = ($whatlist[1]) ? $whatlist[1] : 'stunnel.pem'; $certfile = ($whatlist[1]) ? $whatlist[1] : 'stunnel.pem';
} }
@ -3564,7 +3624,6 @@ sub startservers {
$run{'rtsp-ipv6'}="$pid $pid2"; $run{'rtsp-ipv6'}="$pid $pid2";
} }
} }
elsif($what eq "ftps") { elsif($what eq "ftps") {
if(!$stunnel) { if(!$stunnel) {
# we can't run ftps tests without stunnel # we can't run ftps tests without stunnel
@ -3601,11 +3660,11 @@ sub startservers {
} }
elsif($what eq "https") { elsif($what eq "https") {
if(!$stunnel) { if(!$stunnel) {
# we can't run ftps tests without stunnel # we can't run https tests without stunnel
return "no stunnel"; return "no stunnel";
} }
if(!$ssl_version) { if(!$ssl_version) {
# we can't run ftps tests if libcurl is SSL-less # we can't run https tests if libcurl is SSL-less
return "curl lacks SSL support"; return "curl lacks SSL support";
} }
if($runcert{'https'} && ($runcert{'https'} ne $certfile)) { if($runcert{'https'} && ($runcert{'https'} ne $certfile)) {
@ -3631,18 +3690,34 @@ sub startservers {
$run{'https'}="$pid $pid2"; $run{'https'}="$pid $pid2";
} }
} }
elsif($what eq "http+tls-srp") { elsif($what eq "httptls") {
if(!$has_gnutls) { if(!$httptlssrv) {
return "no GnuTLS"; # for now, we can't run http TLS-EXT tests without gnutls-serv
return "no gnutls-serv";
} }
if(!$run{'http+tls-srp'}) { if(!$run{'httptls'}) {
($pid, $pid2) = runhttptlssrpserver($verbose); ($pid, $pid2) = runhttptlsserver($verbose, "IPv4");
if($pid <= 0) { if($pid <= 0) {
return "failed starting HTTP+TLS-SRP server (gnutls-serv)"; return "failed starting HTTPTLS server (gnutls-serv)";
} }
logmsg sprintf("* pid http+tls-srp => %d %d\n", $pid, $pid2) logmsg sprintf("* pid httptls => %d %d\n", $pid, $pid2)
if($verbose); if($verbose);
$run{'http+tls-srp'}="$pid $pid2"; $run{'httptls'}="$pid $pid2";
}
}
elsif($what eq "httptls-ipv6") {
if(!$httptlssrv) {
# for now, we can't run http TLS-EXT tests without gnutls-serv
return "no gnutls-serv";
}
if(!$run{'httptls-ipv6'}) {
($pid, $pid2) = runhttptlsserver($verbose, "IPv6");
if($pid <= 0) {
return "failed starting HTTPTLS-IPv6 server (gnutls-serv)";
}
logmsg sprintf("* pid httptls-ipv6 => %d %d\n", $pid, $pid2)
if($verbose);
$run{'httptls-ipv6'}="$pid $pid2";
} }
} }
elsif($what eq "tftp") { elsif($what eq "tftp") {
@ -3720,7 +3795,6 @@ sub startservers {
# #
# Returns: a string, blank if everything is fine or a reason why it failed # Returns: a string, blank if everything is fine or a reason why it failed
# #
sub serverfortest { sub serverfortest {
my ($testnum)=@_; my ($testnum)=@_;
@ -3731,14 +3805,28 @@ sub serverfortest {
return "no server specified"; return "no server specified";
} }
for (@what) { for(my $i = scalar(@what) - 1; $i >= 0; $i--) {
my $proto = lc($_); my $srvrline = $what[$i];
chomp $proto; chomp $srvrline if($srvrline);
$proto =~ s/\s.*//g; # take first word if($srvrline =~ /^(\S+)((\s*)(.*))/) {
if (! grep /^\Q$proto\E$/, @protocols) { my $server = "${1}";
if (substr($proto,0,5) ne "socks") { my $lnrest = "${2}";
return "curl lacks $proto support"; my $tlsext;
if($server =~ /^(httptls)(\+)(ext|srp)(\d*)(-ipv6|)$/) {
$server = "${1}${4}${5}";
$tlsext = uc("TLS-${3}");
} }
if(! grep /^\Q$server\E$/, @protocols) {
if(substr($server,0,5) ne "socks") {
if($tlsext) {
return "curl lacks $tlsext support";
}
else {
return "curl lacks $server support";
}
}
}
$what[$i] = "$server$lnrest" if($tlsext);
} }
} }
@ -4101,29 +4189,29 @@ if ($gdbthis) {
} }
} }
$HTTPPORT = $base++; # HTTP server port $HTTPPORT = $base++; # HTTP server port
$HTTPSPORT = $base++; # HTTPS server port $HTTPSPORT = $base++; # HTTPS (stunnel) server port
$FTPPORT = $base++; # FTP server port $FTPPORT = $base++; # FTP server port
$FTPSPORT = $base++; # FTPS server port $FTPSPORT = $base++; # FTPS (stunnel) server port
$HTTP6PORT = $base++; # HTTP IPv6 server port (different IP protocol $HTTP6PORT = $base++; # HTTP IPv6 server port
# but we follow the same port scheme anyway) $FTP2PORT = $base++; # FTP server 2 port
$FTP2PORT = $base++; # FTP server 2 port $FTP6PORT = $base++; # FTP IPv6 port
$FTP6PORT = $base++; # FTP IPv6 port $TFTPPORT = $base++; # TFTP (UDP) port
$TFTPPORT = $base++; # TFTP (UDP) port $TFTP6PORT = $base++; # TFTP IPv6 (UDP) port
$TFTP6PORT = $base++; # TFTP IPv6 (UDP) port $SSHPORT = $base++; # SSH (SCP/SFTP) port
$SSHPORT = $base++; # SSH (SCP/SFTP) port $SOCKSPORT = $base++; # SOCKS port
$SOCKSPORT = $base++; # SOCKS port $POP3PORT = $base++; # POP3 server port
$POP3PORT = $base++; $POP36PORT = $base++; # POP3 IPv6 server port
$POP36PORT = $base++; $IMAPPORT = $base++; # IMAP server port
$IMAPPORT = $base++; $IMAP6PORT = $base++; # IMAP IPv6 server port
$IMAP6PORT = $base++; $SMTPPORT = $base++; # SMTP server port
$SMTPPORT = $base++; $SMTP6PORT = $base++; # SMTP IPv6 server port
$SMTP6PORT = $base++; $RTSPPORT = $base++; # RTSP server port
$RTSPPORT = $base++; $RTSP6PORT = $base++; # RTSP IPv6 server port
$RTSP6PORT = $base++; $GOPHERPORT = $base++; # Gopher IPv4 server port
$GOPHERPORT =$base++; $GOPHER6PORT = $base++; # Gopher IPv6 server port
$GOPHER6PORT=$base++; $HTTPTLSPORT = $base++; # HTTP TLS (non-stunnel) server port
$HTTPTLSSRPPORT=$base++; $HTTPTLS6PORT = $base++; # HTTP TLS (non-stunnel) IPv6 server port
####################################################################### #######################################################################
# clear and create logging directory: # clear and create logging directory:

33
tests/serverhelp.pm
Просмотреть файл

@ -5,7 +5,7 @@
# | (__| |_| | _ <| |___ # | (__| |_| | _ <| |___
# \___|\___/|_| \_\_____| # \___|\___/|_| \_\_____|
# #
# Copyright (C) 1998 - 2010, Daniel Stenberg, <daniel@haxx.se>, et al. # Copyright (C) 1998 - 2011, Daniel Stenberg, <daniel@haxx.se>, et al.
# #
# This software is licensed as described in the file COPYING, which # This software is licensed as described in the file COPYING, which
# you should have received as part of this distribution. The terms # you should have received as part of this distribution. The terms
@ -62,6 +62,13 @@ use vars qw(
); );
#***************************************************************************
# Just for convenience, test harness uses 'https' and 'httptls' literals as
# values for 'proto' variable in order to differentiate different servers.
# 'https' literal is used for stunnel based https test servers, and 'httptls'
# is used for non-stunnel https test servers.
#*************************************************************************** #***************************************************************************
# Return server characterization factors given a server id string. # Return server characterization factors given a server id string.
# #
@ -71,18 +78,20 @@ sub serverfactors {
my $ipvnum; my $ipvnum;
my $idnum; my $idnum;
if($server =~ /^((ftp|http|imap|pop3|smtp)s?)(\d*)(-ipv6|)$/) { if($server =~
/^((ftp|http|imap|pop3|smtp)s?)(\d*)(-ipv6|)$/) {
$proto = $1; $proto = $1;
$idnum = ($3 && ($3 > 1)) ? $3 : 1; $idnum = ($3 && ($3 > 1)) ? $3 : 1;
$ipvnum = ($4 && ($4 =~ /6$/)) ? 6 : 4; $ipvnum = ($4 && ($4 =~ /6$/)) ? 6 : 4;
} }
elsif($server =~ /^(tftp|sftp|socks|ssh|rtsp)(\d*)(-ipv6|)$/) { elsif($server =~
/^(tftp|sftp|socks|ssh|rtsp|gopher|httptls)(\d*)(-ipv6|)$/) {
$proto = $1; $proto = $1;
$idnum = ($2 && ($2 > 1)) ? $2 : 1; $idnum = ($2 && ($2 > 1)) ? $2 : 1;
$ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4; $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;
} }
else { else {
die "invalid server id: $server" die "invalid server id: '$server'"
} }
return($proto, $ipvnum, $idnum); return($proto, $ipvnum, $idnum);
} }
@ -95,16 +104,16 @@ sub servername_str {
my ($proto, $ipver, $idnum) = @_; my ($proto, $ipver, $idnum) = @_;
$proto = uc($proto) if($proto); $proto = uc($proto) if($proto);
die "unsupported protocol: $proto" unless($proto && die "unsupported protocol: '$proto'" unless($proto &&
($proto =~ /^(((FTP|HTTP|IMAP|POP3|SMTP)S?)|(TFTP|SFTP|SOCKS|SSH|RTSP|GOPHER|HTTP\+TLS-SRP))$/)); ($proto =~ /^(((FTP|HTTP|IMAP|POP3|SMTP)S?)|(TFTP|SFTP|SOCKS|SSH|RTSP|GOPHER|HTTPTLS))$/));
$ipver = (not $ipver) ? 'ipv4' : lc($ipver); $ipver = (not $ipver) ? 'ipv4' : lc($ipver);
die "unsupported IP version: $ipver" unless($ipver && die "unsupported IP version: '$ipver'" unless($ipver &&
($ipver =~ /^(4|6|ipv4|ipv6|-ipv4|-ipv6)$/)); ($ipver =~ /^(4|6|ipv4|ipv6|-ipv4|-ipv6)$/));
$ipver = ($ipver =~ /6$/) ? '-IPv6' : ''; $ipver = ($ipver =~ /6$/) ? '-IPv6' : '';
$idnum = 1 if(not $idnum); $idnum = 1 if(not $idnum);
die "unsupported ID number: $idnum" unless($idnum && die "unsupported ID number: '$idnum'" unless($idnum &&
($idnum =~ /^(\d+)$/)); ($idnum =~ /^(\d+)$/));
$idnum = '' unless($idnum > 1); $idnum = '' unless($idnum > 1);
@ -188,7 +197,7 @@ sub server_outputfilename {
# #
sub mainsockf_pidfilename { sub mainsockf_pidfilename {
my ($proto, $ipver, $idnum) = @_; my ($proto, $ipver, $idnum) = @_;
die "unsupported protocol: $proto" unless($proto && die "unsupported protocol: '$proto'" unless($proto &&
(lc($proto) =~ /^(ftp|imap|pop3|smtp)s?$/)); (lc($proto) =~ /^(ftp|imap|pop3|smtp)s?$/));
my $trailer = (lc($proto) =~ /^ftps?$/) ? '_sockctrl.pid':'_sockfilt.pid'; my $trailer = (lc($proto) =~ /^ftps?$/) ? '_sockctrl.pid':'_sockfilt.pid';
return '.'. servername_canon($proto, $ipver, $idnum) ."$trailer"; return '.'. servername_canon($proto, $ipver, $idnum) ."$trailer";
@ -200,7 +209,7 @@ sub mainsockf_pidfilename {
# #
sub mainsockf_logfilename { sub mainsockf_logfilename {
my ($logdir, $proto, $ipver, $idnum) = @_; my ($logdir, $proto, $ipver, $idnum) = @_;
die "unsupported protocol: $proto" unless($proto && die "unsupported protocol: '$proto'" unless($proto &&
(lc($proto) =~ /^(ftp|imap|pop3|smtp)s?$/)); (lc($proto) =~ /^(ftp|imap|pop3|smtp)s?$/));
my $trailer = (lc($proto) =~ /^ftps?$/) ? '_sockctrl.log':'_sockfilt.log'; my $trailer = (lc($proto) =~ /^ftps?$/) ? '_sockctrl.log':'_sockfilt.log';
return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer"; return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer";
@ -212,7 +221,7 @@ sub mainsockf_logfilename {
# #
sub datasockf_pidfilename { sub datasockf_pidfilename {
my ($proto, $ipver, $idnum) = @_; my ($proto, $ipver, $idnum) = @_;
die "unsupported protocol: $proto" unless($proto && die "unsupported protocol: '$proto'" unless($proto &&
(lc($proto) =~ /^ftps?$/)); (lc($proto) =~ /^ftps?$/));
my $trailer = '_sockdata.pid'; my $trailer = '_sockdata.pid';
return '.'. servername_canon($proto, $ipver, $idnum) ."$trailer"; return '.'. servername_canon($proto, $ipver, $idnum) ."$trailer";
@ -224,7 +233,7 @@ sub datasockf_pidfilename {
# #
sub datasockf_logfilename { sub datasockf_logfilename {
my ($logdir, $proto, $ipver, $idnum) = @_; my ($logdir, $proto, $ipver, $idnum) = @_;
die "unsupported protocol: $proto" unless($proto && die "unsupported protocol: '$proto'" unless($proto &&
(lc($proto) =~ /^ftps?$/)); (lc($proto) =~ /^ftps?$/));
my $trailer = '_sockdata.log'; my $trailer = '_sockdata.log';
return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer"; return "${logdir}/". servername_canon($proto, $ipver, $idnum) ."$trailer";

117
tests/sshhelp.pm
Просмотреть файл

@ -39,6 +39,7 @@ use vars qw(
$sftpsrvexe $sftpsrvexe
$sftpexe $sftpexe
$sshkeygenexe $sshkeygenexe
$httptlssrvexe
$sshdconfig $sshdconfig
$sshconfig $sshconfig
$sftpconfig $sftpconfig
@ -52,6 +53,7 @@ use vars qw(
$cliprvkeyf $cliprvkeyf
$clipubkeyf $clipubkeyf
@sftppath @sftppath
@httptlssrvpath
); );
@ -95,7 +97,7 @@ use vars qw(
find_sftpsrv find_sftpsrv
find_sftp find_sftp
find_sshkeygen find_sshkeygen
find_gnutls_serv find_httptlssrv
logmsg logmsg
sshversioninfo sshversioninfo
); );
@ -104,27 +106,28 @@ use vars qw(
#*************************************************************************** #***************************************************************************
# Global variables initialization # Global variables initialization
# #
$sshdexe = 'sshd' .exe_ext(); # base name and ext of ssh daemon $sshdexe = 'sshd' .exe_ext(); # base name and ext of ssh daemon
$sshexe = 'ssh' .exe_ext(); # base name and ext of ssh client $sshexe = 'ssh' .exe_ext(); # base name and ext of ssh client
$sftpsrvexe = 'sftp-server' .exe_ext(); # base name and ext of sftp-server $sftpsrvexe = 'sftp-server' .exe_ext(); # base name and ext of sftp-server
$sftpexe = 'sftp' .exe_ext(); # base name and ext of sftp client $sftpexe = 'sftp' .exe_ext(); # base name and ext of sftp client
$sshkeygenexe = 'ssh-keygen' .exe_ext(); # base name and ext of ssh-keygen $sshkeygenexe = 'ssh-keygen' .exe_ext(); # base name and ext of ssh-keygen
$sshdconfig = 'curl_sshd_config'; # ssh daemon config file $httptlssrvexe = 'gnutls-serv' .exe_ext(); # base name and ext of gnutls-serv
$sshconfig = 'curl_ssh_config'; # ssh client config file $sshdconfig = 'curl_sshd_config'; # ssh daemon config file
$sftpconfig = 'curl_sftp_config'; # sftp client config file $sshconfig = 'curl_ssh_config'; # ssh client config file
$sshdlog = undef; # ssh daemon log file $sftpconfig = 'curl_sftp_config'; # sftp client config file
$sshlog = undef; # ssh client log file $sshdlog = undef; # ssh daemon log file
$sftplog = undef; # sftp client log file $sshlog = undef; # ssh client log file
$sftpcmds = 'curl_sftp_cmds'; # sftp client commands batch file $sftplog = undef; # sftp client log file
$knownhosts = 'curl_client_knownhosts'; # ssh knownhosts file $sftpcmds = 'curl_sftp_cmds'; # sftp client commands batch file
$hstprvkeyf = 'curl_host_dsa_key'; # host private key file $knownhosts = 'curl_client_knownhosts'; # ssh knownhosts file
$hstpubkeyf = 'curl_host_dsa_key.pub'; # host public key file $hstprvkeyf = 'curl_host_dsa_key'; # host private key file
$cliprvkeyf = 'curl_client_key'; # client private key file $hstpubkeyf = 'curl_host_dsa_key.pub'; # host public key file
$clipubkeyf = 'curl_client_key.pub'; # client public key file $cliprvkeyf = 'curl_client_key'; # client private key file
$clipubkeyf = 'curl_client_key.pub'; # client public key file
#*************************************************************************** #***************************************************************************
# Absolute paths where to look for sftp-server plugin # Absolute paths where to look for sftp-server plugin, when not in PATH
# #
@sftppath = qw( @sftppath = qw(
/usr/lib/openssh /usr/lib/openssh
@ -149,6 +152,30 @@ $clipubkeyf = 'curl_client_key.pub'; # client public key file
); );
#***************************************************************************
# Absolute paths where to look for httptlssrv (gnutls-serv), when not in PATH
#
@httptlssrvpath = qw(
/usr/sbin
/usr/libexec
/usr/lib
/usr/lib/misc
/usr/lib64/misc
/usr/local/bin
/usr/local/sbin
/usr/local/libexec
/opt/local/bin
/opt/local/sbin
/opt/local/libexec
/usr/freeware/bin
/usr/freeware/sbin
/usr/freeware/libexec
/opt/gnutls/bin
/opt/gnutls/sbin
/opt/gnutls/libexec
);
#*************************************************************************** #***************************************************************************
# Return file extension for executable files on this operating system # Return file extension for executable files on this operating system
# #
@ -273,17 +300,35 @@ sub find_file {
my @path = @_; my @path = @_;
foreach (@path) { foreach (@path) {
my $file = File::Spec->catfile($_, $fn); my $file = File::Spec->catfile($_, $fn);
if(-e $file) { if(-e $file && ! -d $file) {
return $file; return $file;
} }
} }
} }
#***************************************************************************
# Find an executable file somewhere in the given path
#
sub find_exe_file {
my $fn = $_[0];
shift;
my @path = @_;
my $xext = exe_ext();
foreach (@path) {
my $file = File::Spec->catfile($_, $fn);
if(-e $file && ! -d $file) {
return $file if(-x $file);
return $file if(($xext) && (lc($file) =~ /\Q$xext\E$/));
}
}
}
#*************************************************************************** #***************************************************************************
# Find a file in environment path or in our sftppath # Find a file in environment path or in our sftppath
# #
sub find_sfile { sub find_file_spath {
my $filename = $_[0]; my $filename = $_[0];
my @spath; my @spath;
push(@spath, File::Spec->path()); push(@spath, File::Spec->path());
@ -291,18 +336,24 @@ sub find_sfile {
return find_file($filename, @spath); return find_file($filename, @spath);
} }
#*************************************************************************** #***************************************************************************
# Find gnutls-serv and return canonical filename # Find an executable file in environment path or in our httptlssrvpath
# #
sub find_gnutls_serv { sub find_exe_file_hpath {
return find_file("gnutls-serv", split(':', $ENV{PATH})); my $filename = $_[0];
my @hpath;
push(@hpath, File::Spec->path());
push(@hpath, @httptlssrvpath);
return find_exe_file($filename, @hpath);
} }
#*************************************************************************** #***************************************************************************
# Find ssh daemon and return canonical filename # Find ssh daemon and return canonical filename
# #
sub find_sshd { sub find_sshd {
return find_sfile($sshdexe); return find_file_spath($sshdexe);
} }
@ -310,7 +361,7 @@ sub find_sshd {
# Find ssh client and return canonical filename # Find ssh client and return canonical filename
# #
sub find_ssh { sub find_ssh {
return find_sfile($sshexe); return find_file_spath($sshexe);
} }
@ -318,7 +369,7 @@ sub find_ssh {
# Find sftp-server plugin and return canonical filename # Find sftp-server plugin and return canonical filename
# #
sub find_sftpsrv { sub find_sftpsrv {
return find_sfile($sftpsrvexe); return find_file_spath($sftpsrvexe);
} }
@ -326,7 +377,7 @@ sub find_sftpsrv {
# Find sftp client and return canonical filename # Find sftp client and return canonical filename
# #
sub find_sftp { sub find_sftp {
return find_sfile($sftpexe); return find_file_spath($sftpexe);
} }
@ -334,7 +385,15 @@ sub find_sftp {
# Find ssh-keygen and return canonical filename # Find ssh-keygen and return canonical filename
# #
sub find_sshkeygen { sub find_sshkeygen {
return find_sfile($sshkeygenexe); return find_file_spath($sshkeygenexe);
}
#***************************************************************************
# Find httptlssrv (gnutls-serv) and return canonical filename
#
sub find_httptlssrv {
return find_exe_file_hpath($httptlssrvexe);
} }