Attachment 893881 Details for Bug 1094440 – Test case

Test case

https.t (text/plain), 3.19 KB, created by Petr Pisar on 2014-05-09 08:32:07 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Petr Pisar

Created: 2014-05-09 08:32:07 UTC

Size: 3.19 KB

patch

obsolete

>use strict;
>use warnings;
>use Test::More tests => 1 + 2 + 6 + 3 * 2 + 1;
>
># Generate keys
>use File::Temp ();
>my $directory = File::Temp::tempdir;
>ok(defined $directory, "temporary directory $directory created");
>
>sub generate {
>    my ($key, $password, $certificate, $hostname, $message) = @_;
>    is(system('openssl', 'req', '-x509', '-out', $certificate,
>            '-newkey', 'rsa:2048', '-keyout', $key, '-batch',
>            '-passout', "pass:$password", '-subj', "/CN=$hostname"), 0,
>        $message);
>}
>use File::Spec;
>my $key = File::Spec->catfile($directory, 'key');
>my $password = 'abcd';
>my $certificate = File::Spec->catfile($directory, 'certificate');
>my $hostname = '127.0.0.1';
>generate($key, $password, $certificate, $hostname, 'keys generated');
>
>my $foreign_key = File::Spec->catfile($directory, 'foreign_key');
>my $foreign_certificate = File::Spec->catfile($directory,
>    'foreign_certificate');
>generate($foreign_key, $password, $foreign_certificate, $hostname,
>    'foreign CA certificate generated');
>
># Fork server
>ok(pipe(my ($slave, $master)), 'pipes created');
>
>my $server_pid = fork;
>if (0 == $server_pid) {
>    # Server process
>    close($slave);
>
>    use IO::Socket::SSL ();
>    my $server = IO::Socket::SSL->new(
>        Proto => 'tcp',
>        LocalAddr => $hostname,
>        Listen => 1,
>        SSL_key_file => $key,
>        SSL_passwd_cb => sub { $password },
>        SSL_cert_file => $certificate,
>    );
>
>    if (!defined $server) {
>        $master->printflush("Could not create TLS server socket: $!\n");
>        exit 1;
>    }
>    $master->printflush("ready\n");
>    $master->printflush(
>        ($server->sockhost =~ /:/) ?
>            '[' . $server->sockhost . ']' : 
>            $server->sockhost,
>        ':', $server->sockport, "\n"
>    );
>
>    while (1) {
>        my $client = $server->accept or next;
>
>        while (<$client>) {
>            s/\r\n\z//;
>            last if (/\A\z/);
>        }
>
>        $client->printflush("HTTP/1.0 200 Ok\r\n\r\n");
>        $client->close;
>    } continue {
>        $master->printflush("ready\n");
>    }
>
>    $server->close;
>    exit 0;
>}
>
># Client process
>ok(defined($server_pid), 'server forked');
>close($master);
>
>is(<$slave>, "ready\n", 'server is ready');
>chomp(my $address = <$slave>);
>ok($address, "server reported address");
>
># Check the LWP::Protocol::https for HTTPS_CA_FILE environment variable
>sub check {
>    my ($env_value, $expected_status, $comment) = @_;
>    if (defined $env_value) {
>        $ENV{HTTPS_CA_FILE} = $env_value;
>    } else {
>        delete $ENV{HTTPS_CA_FILE};
>    }
>    use LWP::UserAgent ();
>    my $response = LWP::UserAgent->new->get("https://$address/");
>    ok($response->is_success == $expected_status,
>        "$comment: " . $response->status_line);
>    diag("HTTP::Response is:\n", $response->as_string);
>    is(<$slave>, "ready\n", 'server is ready');
>}
>check(undef, 0, 'no variable should fail');
>check($foreign_certificate, 0, 'variable to wrong CA should fail');
>check($certificate, 1, 'variable to correct CA should pass');
>
># Cleanup
>ok(kill('TERM', $server_pid), 'killing server');
>is(waitpid($server_pid, 0), $server_pid, 'server terminated');
>use File::Path ();
>ok(File::Path::remove_tree($directory), 'temporary directory removed');

Actions: View

Attachments on bug 1094440: 893659 | 893881 | 894671 | 894672 | 894747 | 894748 | 895124