89 lines
2.1 KiB
Perl
89 lines
2.1 KiB
Perl
use strict;
|
|
use warnings FATAL => 'all';
|
|
use Apache::Test;
|
|
use Apache::TestUtil;
|
|
use Apache::TestRequest;
|
|
use Apache::TestConfig ();
|
|
use Apache::TestSSLCA ();
|
|
|
|
#if keepalives are on, renegotiation not happen again once
|
|
#a client cert is presented.
|
|
Apache::TestRequest::user_agent_keepalive(0);
|
|
|
|
my $cert = 'client_snakeoil';
|
|
|
|
my $server_expect =
|
|
Apache::TestSSLCA::dn_vars('ca', 'SERVER_I');
|
|
|
|
my $client_expect =
|
|
Apache::TestSSLCA::dn_vars($cert, 'CLIENT_S');
|
|
|
|
my $url = '/ssl-cgi/env.pl';
|
|
|
|
my $tests = (keys(%$server_expect) + keys(%$client_expect) + 1) * 2;
|
|
plan tests => $tests, need need_cgi, need_lwp;
|
|
|
|
Apache::TestRequest::scheme('https');
|
|
|
|
my $r = GET($url);
|
|
|
|
ok t_cmp($r->code, 200, "response status OK");
|
|
|
|
my $env = getenv($r->as_string);
|
|
|
|
verify($env, $server_expect);
|
|
verify($env, $client_expect, 1);
|
|
|
|
$url = '/require-ssl-cgi/env.pl';
|
|
|
|
$r = GET($url, cert => $cert);
|
|
|
|
ok t_cmp($r->code, 200, "second response status OK");
|
|
|
|
$env = getenv($r->as_string);
|
|
|
|
verify($env, $server_expect);
|
|
verify($env, $client_expect);
|
|
|
|
sub verify {
|
|
my($env, $expect, $ne) = @_;
|
|
|
|
while (my($key, $val) = each %$expect) {
|
|
# the emailAddress attribute is still exported using the name
|
|
# _DN_Email by mod_ssl, even when using OpenSSL 0.9.7.
|
|
if ($key =~ /(.*)_emailAddress/) {
|
|
$key = $1 . "_Email";
|
|
}
|
|
if (Apache::TestConfig::WIN32) {
|
|
#perl uppercases all %ENV keys
|
|
#which causes SSL_*_DN_Email lookups to fail
|
|
$key = uc $key;
|
|
}
|
|
unless ($ne || $env->{$key}) {
|
|
print "#$key does not exist\n";
|
|
$env->{$key} = ""; #prevent use of unitialized value
|
|
}
|
|
if ($ne) {
|
|
print "#$key should not exist\n";
|
|
ok not exists $env->{$key};
|
|
}
|
|
else {
|
|
print "#$key: expect '$val', got '$env->{$key}'\n";
|
|
ok $env->{$key} eq $val;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub getenv {
|
|
my $str = shift;
|
|
|
|
my %env;
|
|
|
|
for my $line (split /[\r\n]+/, $str) {
|
|
my($key, $val) = split /\s*=\s*/, $line, 2;
|
|
next unless $key and $val;
|
|
$env{$key} = $val;
|
|
}
|
|
|
|
\%env;
|
|
}
|