view release on metacpan or  search on metacpan

t/17-web-server-ssl.t  view on Meta::CPAN

use strict;
use warnings;

# Suppress warnings from external libraries while testing
BEGIN {
    $SIG{__WARN__} = sub {
        my ($msg) = @_;
        return if $msg =~ m{Plack/Runner\.pm|Getopt/Long\.pm};
        warn $msg;
    };
}

use Capture::Tiny qw(capture);
use File::Path qw(make_path remove_tree);
use File::Spec;
use File::Temp qw(tempdir tempfile);
use IO::Socket::INET;
use IO::Socket::SSL ();
use HTTP::Request::Common qw(GET);
use LWP::UserAgent;
use Plack::Test;
use Socket qw(AF_UNIX PF_UNSPEC SOCK_STREAM);
use Test::More;
use Time::HiRes qw(sleep);

use lib 'lib';

use Developer::Dashboard::Web::Server;
use Developer::Dashboard::Web::DancerApp;

sub _openssl_cert_text {
    my ($cert_file) = @_;
    my ( $stdout, $stderr, $exit ) = capture {
        system( 'openssl', 'x509', '-in', $cert_file, '-noout', '-text' );
    };
    die "Unable to inspect certificate $cert_file: $stderr$stdout" if $exit != 0;
    return $stdout;
}

sub _openssl_verify_certificate_name {
    my ( $cert_file, $name ) = @_;
    my @cmd = ( 'openssl', 'verify', '-CAfile', $cert_file );
    if ( defined $name && $name =~ /\A(?:\d{1,3}\.){3}\d{1,3}\z/ || ( defined $name && $name =~ /:/ ) ) {
        push @cmd, '-verify_ip', $name;
    }
    else {
        push @cmd, '-verify_hostname', $name;
    }
    push @cmd, $cert_file;
    my ( $stdout, $stderr, $exit ) = capture {
        system(@cmd);
    };
    return {
        stdout => $stdout,
        stderr => $stderr,
        exit   => $exit,
    };
}

sub _mode_octal {
    my ($path) = @_;
    my @stat = stat($path);
    return undef if !@stat;
    return sprintf '%04o', $stat[2] & 07777;
}

sub _generate_legacy_cert_fixture {
    my ( $cert_file, $key_file ) = @_;
    my ( $config_fh, $config_file ) = tempfile( 'dd-legacy-openssl-XXXXXX', SUFFIX => '.cnf' );
    print {$config_fh} <<'OPENSSL_CONFIG' or die "Unable to write legacy OpenSSL config $config_file: $!";
[ req ]
default_bits = 2048
prompt = no
default_md = sha256
distinguished_name = dn
x509_extensions = legacy_req

[ dn ]

t/17-web-server-ssl.t  view on Meta::CPAN

# Test 13: Live SSL frontend redirects plain HTTP and still serves HTTPS on the public port
{
    my $temp_home = tempdir(CLEANUP => 1);
    local $ENV{HOME} = $temp_home;

    my $listener = IO::Socket::INET->new(
        LocalAddr => '127.0.0.1',
        LocalPort => 0,
        Proto     => 'tcp',
        ReuseAddr => 1,
        Listen    => 5,
    ) or die "Unable to reserve live SSL test port: $!";
    my $port = $listener->sockport;
    close $listener or die "Unable to close reserved live SSL test port: $!";

    my $server = Developer::Dashboard::Web::Server->new(
        app     => Local::SSLTestApp->new,
        host    => '127.0.0.1',
        port    => $port,
        workers => 1,
        ssl     => 1,
    );

    my $pid = fork();
    die "Unable to fork live SSL server test: $!" if !defined $pid;
    if ( !$pid ) {
        $server->run;
        exit 0;
    }

    my $ready = 0;
    for ( 1 .. 50 ) {
        my $probe = IO::Socket::INET->new(
            PeerAddr => '127.0.0.1',
            PeerPort => $port,
            Proto    => 'tcp',
        );
        if ($probe) {
            close $probe;
            $ready = 1;
            last;
        }
        sleep 0.1;
    }
    ok( $ready, 'live SSL frontend became reachable on the public port' );

    my $http = LWP::UserAgent->new(
        max_redirect => 0,
        timeout      => 5,
    );
    my $http_response = $http->get("http://127.0.0.1:$port/live-check?mode=http");
    is( $http_response->code, 307, 'live SSL frontend redirects plain HTTP on the public port' );
    is(
        $http_response->header('Location'),
        "https://127.0.0.1:$port/live-check?mode=http",
        'live SSL frontend redirects plain HTTP to the equivalent HTTPS URL on the same public port'
    );

    my $https_socket;
    for ( 1 .. 50 ) {
        $https_socket = IO::Socket::SSL->new(
            PeerHost        => '127.0.0.1',
            PeerPort        => $port,
            SSL_verify_mode => 0,
            Timeout         => 5,
        );
        last if $https_socket;
        sleep 0.1;
    }
    ok( $https_socket, 'live SSL frontend accepts a direct TLS client on the public port' );
    my $https_raw = '';
    if ($https_socket) {
        print {$https_socket} "GET / HTTP/1.1\r\nHost: 127.0.0.1:$port\r\nConnection: close\r\n\r\n"
          or die "Unable to write HTTPS test request: $!";
        $https_raw = do {
            local $/;
            <$https_socket>;
        };
        close $https_socket;
        like( $https_raw, qr/^HTTP\/1\.1 200 OK\r\n/, 'live SSL frontend still serves HTTPS on the public port' );
        like( $https_raw, qr/\r\n\r\nOK\z/s, 'live SSL frontend preserves the HTTPS app response body' );
    }
    else {
        diag( 'IO::Socket::SSL connect error: ' . ( IO::Socket::SSL::errstr() || 'unknown SSL error' ) );
        fail('live SSL frontend still serves HTTPS on the public port');
        fail('live SSL frontend preserves the HTTPS app response body');
    }

    kill 'TERM', $pid;
    waitpid( $pid, 0 );
}

done_testing();

__END__

=head1 NAME

t/17-web-server-ssl.t - SSL support tests for Developer Dashboard web server

=head1 DESCRIPTION

Tests self-signed certificate generation, SSL flag handling, HTTPS URL generation,
Starman SSL configuration, and HTTP->HTTPS redirect middleware.

=for comment FULL-POD-DOC START

=head1 PURPOSE

This test is the executable regression contract for HTTPS serving, certificates, and browser-facing SSL behavior. Read it when you need to understand the real fixture setup, assertions, and failure modes for this slice of the repository instead of gu...

=head1 WHY IT EXISTS

It exists because HTTPS serving, certificates, and browser-facing SSL behavior has enough moving parts that a code-only review can miss real regressions. Keeping those expectations in a dedicated test file makes the TDD loop, coverage loop, and relea...

=head1 WHEN TO USE

Use this file when changing HTTPS serving, certificates, and browser-facing SSL behavior, when a focused CI failure points here, or when you want a faster regression loop than running the entire suite.

=head1 HOW TO USE

Run it directly with C<prove -lv t/17-web-server-ssl.t> while iterating, then keep it green under C<prove -lr t> and the coverage runs before release. 

=head1 WHAT USES IT

Developers during TDD, the full C<prove -lr t> suite, the coverage gates, and the release verification loop all rely on this file to keep this behavior from drifting.

=head1 EXAMPLES

Example 1:

  prove -lv t/17-web-server-ssl.t

Run the focused regression test by itself while you are changing the behavior it owns.

Example 2:

  HARNESS_PERL_SWITCHES=-MDevel::Cover prove -lv t/17-web-server-ssl.t

Exercise the same focused test while collecting coverage for the library code it reaches.

Example 3:

  prove -lr t