1 files changed, 89 insertions, 0 deletions
diff --git a/debian/perl-framework/t/ssl/env.t b/debian/perl-framework/t/ssl/env.t
new file mode 100644
index 0000000..912a4dc
--- /dev/null
+++ b/debian/perl-framework/t/ssl/env.t
@@ -0,0 +1,89 @@
+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;
+}