#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use IO::Socket::INET;
use Net::SSLeay;
plan skip_all => "no OCSP support"
if ! defined &Net::SSLeay::OCSP_response_status;
#$Net::SSLeay::trace=3;
my @tests = (
{
# this should give us OCSP stapling
host => 'www.microsoft.com',
port => 443,
fingerprint => '5f0b37e633840ca02468552ea3b1197e5e118f7b',
ocsp_staple => 1,
expect_status => Net::SSLeay::V_OCSP_CERTSTATUS_GOOD(),
},
{
# no OCSP stapling
host => 'www.heise.de',
port => 443,
fingerprint => '36a7d7bfc59db65c040bccd291ae563d9ef7bafc',
expect_status => Net::SSLeay::V_OCSP_CERTSTATUS_GOOD(),
},
{
# this is revoked
host => 'revoked.grc.com',
port => 443,
fingerprint => '310665f4c8e78db761c764e798dca66047341264',
expect_status => Net::SSLeay::V_OCSP_CERTSTATUS_REVOKED(),
},
);
my $release_tests = $ENV{RELEASE_TESTING} ? 1:0;
plan tests => $release_tests + @tests;
my $timeout = 10; # used to TCP connect and SSL connect
my $http_ua = eval { require HTTP::Tiny } && HTTP::Tiny->new(verify_SSL => 0);
Net::SSLeay::randomize();
Net::SSLeay::load_error_strings();
Net::SSLeay::ERR_load_crypto_strings();
Net::SSLeay::SSLeay_add_ssl_algorithms();
my $sha1 = Net::SSLeay::EVP_get_digestbyname('sha1');
my @fp_mismatch;
TEST:
for my $test (@tests) {
my $cleanup = __cleanup__->new;
SKIP: {
skip 'HTTP::Tiny required but not installed', 1
unless $http_ua;
my $cl = IO::Socket::INET->new(
PeerAddr => $test->{host},
PeerPort => $test->{port},
Timeout => $timeout,
);
skip "TCP connect to $test->{host}:$test->{port} failed: $!",1
if !$cl;
diag("tcp connect to $test->{host}:$test->{port} ok");
my $ctx = Net::SSLeay::CTX_new() or die "failed to create CTX";
# enable verification with hopefully usable CAs
Net::SSLeay::CTX_set_default_verify_paths($ctx);
Net::SSLeay::CTX_load_verify_locations($ctx,
Mozilla::CA::SSL_ca_file(),'')
if eval { require Mozilla::CA };
Net::SSLeay::CTX_set_verify($ctx,Net::SSLeay::VERIFY_PEER(),undef);
# setup TLS extension callback to catch stapled OCSP response
my $stapled_response;
Net::SSLeay::CTX_set_tlsext_status_cb($ctx,sub {
my ($ssl,$resp) = @_;
diag("got ".($resp ? '':'no ')."stapled OCSP response");
return 1 if ! $resp;
$stapled_response = Net::SSLeay::i2d_OCSP_RESPONSE($resp);
return 1;
});
# create SSL object only after we have the context fully done since
# some parts of the context (like verification mode) will be copied
# to the SSL object and thus later changes to the CTX don't affect
# the SSL object
my $ssl = Net::SSLeay::new($ctx) or die "failed to create SSL";
# setup TLS extension to request stapled OCSP response
Net::SSLeay::set_tlsext_status_type($ssl,
Net::SSLeay::TLSEXT_STATUSTYPE_ocsp());
# non-blocking SSL_connect with timeout
$cl->blocking(0);
Net::SSLeay::set_fd($ssl,fileno($cl));
my $end = time() + $timeout;
my ($rv,@err);
while (($rv = Net::SSLeay::connect($ssl)) < 0) {
my $to = $end-time();
$to<=0 and last;
my $err = Net::SSLeay::get_error($ssl,$rv);
vec( my $vec = '',fileno($cl),1) = 1;
if ( $err == Net::SSLeay::ERROR_WANT_READ()) {
select($vec,undef,undef,$to);
} elsif ( $err == Net::SSLeay::ERROR_WANT_WRITE()) {
select(undef,$vec,undef,$to);
} else {
while ( my $err = Net::SSLeay::ERR_get_error()) {
push @err, Net::SSLeay::ERR_error_string($err);
}
last
}
}
skip "SSL_connect with $test->{host}:$test->{port} failed: @err",1
if $rv<=0;
diag("SSL_connect ok");
# make sure we talk to the right party, e.g. no SSL interception
my $leaf_cert = Net::SSLeay::get_peer_certificate($ssl);
$cleanup->add(sub { Net::SSLeay::X509_free($leaf_cert) }) if $leaf_cert;
my $fp = $leaf_cert
&& unpack("H*",Net::SSLeay::X509_digest($leaf_cert,$sha1));
skip "could not get fingerprint",1 if !$fp;
if ($fp ne $test->{fingerprint}) {
push @fp_mismatch, [ $fp,$test ];
skip("bad fingerprint for $test->{host}:$test->{port} -".
" expected $test->{fingerprint}, got $fp",1)
}
diag("fingerprint matches");
if ( $test->{ocsp_staple} && ! $stapled_response ) {
fail("did not get expected stapled OCSP response on $test->{host}:$test->{port}");
next TEST;
}
# create OCSP_REQUEST for all certs
my @requests;
for my $cert (Net::SSLeay::get_peer_cert_chain($ssl)) {
my $subj = Net::SSLeay::X509_NAME_oneline(
Net::SSLeay::X509_get_subject_name($cert));
my $uri = Net::SSLeay::P_X509_get_ocsp_uri($cert);
if (!$uri) {
diag("no OCSP URI for cert $subj");
next;
}
my $id = eval { Net::SSLeay::OCSP_cert2ids($ssl,$cert) } or do {
fail("failed to get OCSP_CERTIDs for cert $subj: $@");
next TEST;
};
my $req = Net::SSLeay::OCSP_ids2req($id);
push @requests, [ $uri,$req,$id,$subj ];
$cleanup->add(sub { Net::SSLeay::OCSP_REQUEST_free($req) });
}
if (!@requests) {
fail("no certificate checks for $test->{host}:$test->{port}");
next TEST;
}
my $check_response = sub {
my ($resp,$req,$id,$expect_status) = @_;
if ( Net::SSLeay::OCSP_response_status($resp)
!= Net::SSLeay::OCSP_RESPONSE_STATUS_SUCCESSFUL()) {
return [ undef,"response bad status ".
Net::SSLeay::OCSP_response_status_str(Net::SSLeay::OCSP_response_status($resp)) ];
} elsif ( ! eval {
Net::SSLeay::OCSP_response_verify($ssl,$resp,$req) }) {
return [ undef,"cannot verify response: $@" ];
}
# extract result for id
my ($status) = Net::SSLeay::OCSP_response_results($resp,$id);
return [ undef,"no data for cert in response: $status->[1]" ]
if ! $status->[2];
if ($expect_status != $status->[2]{statusType}) {
return [ undef,
"unexpected status=$status->[2]{statusType} (expected $expect_status): $status->[1]" ]
} elsif ( $status->[2]{nextUpdate} ) {
diag("status=$expect_status as expected: nextUpd=".localtime($status->[2]{nextUpdate}));
} else {
diag("status=$expect_status as expected: no nextUpd");
}
return $status;
};
if ($stapled_response) {
my $stat = $check_response->(
Net::SSLeay::d2i_OCSP_RESPONSE($stapled_response),
undef, # no OCSP_REQUEST
$requests[0][2], # stapled response is for the leaf certificate
$test->{expect_status}
);
if (!$stat->[0]) {
fail($stat->[1]);
next TEST;
}
}
for(my $i=0;$i<@requests;$i++) {
my ($uri,$req,$id,$subj) = @{$requests[$i]};
if ( ! $http_ua ) {
diag("no HTTP: skip checking $uri | $subj");
next
}
my $res = $http_ua->request('POST',$uri, {
headers => { 'Content-type' => 'application/ocsp-request' },
content => Net::SSLeay::i2d_OCSP_REQUEST($req),
timeout => $timeout,
});
if (!$res->{success}) {
if ($res->{status} == 599) {
# internal error, assume network problem
diag("disabling HTTP because of $http_ua->{reason}");
$http_ua = undef;
}
diag("$http_ua->{reason}: skip checking $uri | $subj");
next;
}
my $resp = eval { Net::SSLeay::d2i_OCSP_RESPONSE($res->{content}) };
if (!$resp) {
diag("bad OCSP response($@): skip checking $uri | $subj");
next;
}
my $stat = $check_response->(
$resp,
$req,
$id,
($i>0) ? Net::SSLeay::V_OCSP_CERTSTATUS_GOOD() : $test->{expect_status},
);
if (!$stat->[0]) {
fail($stat->[1]);
next TEST;
}
}
pass("OCSP test $test->{host}:$test->{port} ok");
}
}
if ($release_tests) {
if (!@fp_mismatch) {
pass("all fingerprints matched");
} else {
for(@fp_mismatch) {
my ($fp,$test) = @$_;
diag("fingerprint mismatch for $test->{host}:$test->{port} -".
" expected $test->{fingerprint}, got $fp")
}
fail("some fingerprints did not matched - please adjust test");
}
}
{
# cleanup stuff when going out of scope
package __cleanup__;
sub new { bless [],shift };
sub add { my $self = shift; push @$self,@_ }
sub DESTROY {
my $self = shift;
&$_ for(@$self)
}
}