diff --git a/lib/OpenSSL.pm6 b/lib/OpenSSL.pm6 index 7fe7c03..5ccbe63 100644 --- a/lib/OpenSSL.pm6 +++ b/lib/OpenSSL.pm6 @@ -5,6 +5,7 @@ use OpenSSL::Bio; use OpenSSL::Err; use OpenSSL::EVP; use OpenSSL::X509; +use OpenSSL::X509_Store_Ctx; use NativeCall; @@ -278,6 +279,10 @@ method get-client-ca-list (:$debug is copy) { $ca-stack; } +method set-verify(Int $mode, &callback) { + OpenSSL::SSL::SSL_set_verify($!ssl, $mode, &callback); +} + method check-private-key { unless OpenSSL::Ctx::SSL_CTX_check_private_key($!ctx) { die "Private key does not match the public certificate"; diff --git a/lib/OpenSSL/Bio.pm6 b/lib/OpenSSL/Bio.pm6 index 1d6b80e..b44a635 100644 --- a/lib/OpenSSL/Bio.pm6 +++ b/lib/OpenSSL/Bio.pm6 @@ -44,3 +44,4 @@ our sub BIO_read(OpaquePointer, Blob, long --> int32) is native(&gen-lib) { ... our sub BIO_write(OpaquePointer, Blob, long --> int32) is native(&gen-lib) { ... } our sub BIO_new_mem_buf(Blob, long --> OpaquePointer) is native(&gen-lib) { ... } our sub BIO_s_mem() returns BIO_METHOD is native(&gen-lib) { ... } +our sub BIO_ctrl_pending(Pointer) returns long is native(&gen-lib) { ... } diff --git a/lib/OpenSSL/Ctx.pm6 b/lib/OpenSSL/Ctx.pm6 index 0b635d2..1177797 100644 --- a/lib/OpenSSL/Ctx.pm6 +++ b/lib/OpenSSL/Ctx.pm6 @@ -32,3 +32,8 @@ our sub SSL_CTX_set_alpn_select_cb(SSL_CTX, &callback ( Pointer --> int32), # arg Pointer) is native(&gen-lib) {*} +our sub SSL_CTX_set_verify(OpenSSL::Ctx::SSL_CTX, int32, + &callback ( int32, + Pointer # X509_STORE_CTX + --> int32) + ) is native(&ssl-lib) { ... } diff --git a/lib/OpenSSL/PEM.pm6 b/lib/OpenSSL/PEM.pm6 index d9f1c24..fdcd791 100644 --- a/lib/OpenSSL/PEM.pm6 +++ b/lib/OpenSSL/PEM.pm6 @@ -7,3 +7,4 @@ our sub PEM_read_bio_RSAPrivateKey(OpaquePointer, OpaquePointer, OpaquePointer, our sub PEM_read_bio_RSAPublicKey(OpaquePointer, OpaquePointer, OpaquePointer, OpaquePointer --> OpaquePointer) is native(&gen-lib) { ... } our sub PEM_read_bio_RSA_PUBKEY(OpaquePointer, OpaquePointer, OpaquePointer, OpaquePointer --> OpaquePointer) is native(&gen-lib) { ... } our sub PEM_read_bio_X509(OpaquePointer, OpaquePointer, OpaquePointer, OpaquePointer --> OpaquePointer) is native(&gen-lib) { ... } +our sub PEM_write_bio_X509(Pointer, Pointer) returns int32 is native(&gen-lib) { ... } diff --git a/lib/OpenSSL/SSL.pm6 b/lib/OpenSSL/SSL.pm6 index ade91b8..1307cc9 100644 --- a/lib/OpenSSL/SSL.pm6 +++ b/lib/OpenSSL/SSL.pm6 @@ -9,6 +9,13 @@ use OpenSSL::Base; use NativeCall; +constant SSL_VERIFY_NONE = 0x00; +constant SSL_VERIFY_PEER = 0x01; +constant SSL_VERIFY_FAIL_IF_NO_PEER_CERT = 0x02; +constant SSL_VERIFY_CLIENT_ONCE = 0x04; +constant SSL_VERIFY_POST_HANDSHAKE = 0x08; + + our sub SSL_library_init() is native(&ssl-lib) { ... } our sub OPENSSL_init_ssl(uint64, OpaquePointer) is native(&ssl-lib) { ... } our sub SSL_load_error_strings() is native(&ssl-lib) { ... } @@ -38,3 +45,8 @@ our sub SSL_get0_alpn_selected(OpenSSL::Base::SSL, CArray[CArray[uint8]], uint32 # long SSL_ctrl(SSL *ssl, int cmd, long larg, void *parg) our sub SSL_ctrl(OpenSSL::Base::SSL, int32, int64, Str ) returns int64 is native(&ssl-lib) { ... } +our sub SSL_set_verify(OpenSSL::Base::SSL, int32, + &callback ( int32, + #OpenSSL::Ctx::X509_STORE_CTX + Pointer + --> int32)) is native(&ssl-lib) { ... } diff --git a/lib/OpenSSL/X509.pm6 b/lib/OpenSSL/X509.pm6 index 8a53cc7..78a71dd 100644 --- a/lib/OpenSSL/X509.pm6 +++ b/lib/OpenSSL/X509.pm6 @@ -67,3 +67,4 @@ our sub X509_get_ext_d2i(Pointer, int32, CArray[int32], CArray[int32]) returns O our sub ASN1_STRING_to_UTF8(CArray[CArray[uint8]], Pointer) returns int32 is native(&crypto-lib) { ... } +our sub X509_get_pathlen(Pointer) returns int64 is native(&crypto-lib) { ... } diff --git a/lib/OpenSSL/X509_Store_Ctx.pm6 b/lib/OpenSSL/X509_Store_Ctx.pm6 new file mode 100644 index 0000000..d7d6e24 --- /dev/null +++ b/lib/OpenSSL/X509_Store_Ctx.pm6 @@ -0,0 +1,147 @@ +unit module OpenSSL::X509_Store_Ctx; + +use v6; +use NativeCall; +use OpenSSL::NativeLib; + + +# struct crypto_ex_data_st { +# STACK_OF(void) *sk; +# }; +# class CRYPTO_EX_DATA is repr('CStruct') { +# has Pointer $.sk; +#} + + +# class X509_STORE_CTX is repr('CStruct') { +# # X509_STORE *ctx; +# has OpaquePointer $.ctx; + +# # /* The following are set by the caller */ +# # /* The cert to check */ +# # X509 *cert; +# has OpaquePointer $.cert; + +# # /* chain of X509s - untrusted - passed in */ +# # STACK_OF(X509) *untrusted; +# has Pointer $.untrusted; + +# # /* set of CRLs passed in */ +# # STACK_OF(X509_CRL) *crls; +# # X509_VERIFY_PARAM *param; +# has Pointer $.crls; +# has Pointer $.param; + +# # /* Other info for use with get_issuer() */ +# # void *other_ctx; +# has Pointer $.other_ctx; + +# # /* Callbacks for various operations */ +# # /* called to verify a certificate */ +# # int (*verify) (X509_STORE_CTX *ctx) +# has Pointer $.verify; + +# # /* error callback */ +# # int (*verify_cb) (int ok, X509_STORE_CTX *ctx); +# has Pointer $.verify_cb; + +# # /* get issuers cert from ctx */ +# # int (*get_issuer) (X509 **issuer, X509_STORE_CTX *ctx, X509 *x); +# has Pointer $.get_issuer; + +# # /* check issued */ +# # int (*check_issued) (X509_STORE_CTX *ctx, X509 *x, X509 *issuer); +# has Pointer $.check_issued; + +# # /* Check revocation status of chain */ +# # int (*check_revocation) (X509_STORE_CTX *ctx); +# has Pointer $.check_revocation; + +# # /* retrieve CRL */ +# # int (*get_crl) (X509_STORE_CTX *ctx, X509_CRL **crl, X509 *x); +# has Pointer $.get_crl; + +# # /* Check CRL validity */ +# # int (*check_crl) (X509_STORE_CTX *ctx, X509_CRL *crl); +# has Pointer $.check_crl; + +# # /* Check certificate against CRL */ +# # int (*cert_crl) (X509_STORE_CTX *ctx, X509_CRL *crl, X509 *x); +# has Pointer $.cert_crl; + +# # /* Check policy status of the chain */ +# # int (*check_policy) (X509_STORE_CTX *ctx); +# has Pointer $.check_policy; + +# # STACK_OF(X509) *(*lookup_certs) (X509_STORE_CTX *ctx, X509_NAME *nm); +# has Pointer $.lookup_certs; + +# # STACK_OF(X509_CRL) *(*lookup_crls) (X509_STORE_CTX *ctx, X509_NAME *nm); +# has Pointer $.lookup_crls; + +# # int (*cleanup) (X509_STORE_CTX *ctx); +# has Pointer $.cleanup; + +# # /* The following is built up */ +# # /* if 0, rebuild chain */ +# # int valid; +# has int32 $.valid; + +# # /* number of untrusted certs */ +# # int num_untrusted; +# has int32 $.num_untrusted; + +# # /* chain of X509s - built up and trusted */ +# # STACK_OF(X509) *chain; +# has Pointer $.chain; + +# # /* Valid policy tree */ +# # X509_POLICY_TREE *tree; +# has Pointer $.tree; + +# # /* Require explicit policy value */ +# # int explicit_policy; +# has int32 $explicit_policy; + +# # /* When something goes wrong, this is why */ +# # int error_depth; +# has int32 $.error_depth; + +# # int error; +# has int32 $.error; + +# # X509 *current_cert; +# has Pointer $.current_cert; + +# # /* cert currently being tested as valid issuer */ +# # X509 *current_issuer; +# has Pointer $.current_issuer; + +# # /* current CRL */ +# # X509_CRL *current_crl; +# has Pointer $.current_crl; + +# # /* score of current CRL */ +# # int current_crl_score; +# has int32 $.current_crl_score; + +# # /* Reason mask */ +# # unsigned int current_reasons; +# has uint32 $.current_reasons; + +# # /* For CRL path validation: parent context */ +# # X509_STORE_CTX *parent; +# has OpenSSL::Ctx::X509_STORE_CTX $.parent; +# # CRYPTO_EX_DATA ex_data; +# HAS CRYPTO_EX_DATA $.ex_data; + +# # SSL_DANE *dane; +# has Pointer $.dane; + +# # /* signed via bare TA public key, rather than CA certificate */ +# # int bare_ta_signed; +# has int32 $.bare_ta_signed; +# } + +our sub X509_STORE_CTX_get_current_cert(Pointer) returns Pointer is native(&ssl-lib) { ... } +our sub X509_STORE_CTX_get_error_depth(Pointer) returns int32 is native(&ssl-lib) { ... } diff --git a/t/07-verify-cb.t b/t/07-verify-cb.t new file mode 100644 index 0000000..4769b4e --- /dev/null +++ b/t/07-verify-cb.t @@ -0,0 +1,73 @@ +use OpenSSL; +use Test; + +plan 4; + +unless %*ENV { + diag "NETWORK_TESTING was not set"; + skip-rest("NETWORK_TESTING was not set"); + exit; +} + +check(fetch('google.com', '/')); + +sub check($result) { + if $result ~~ /200 \s+ OK/ { + pass 'Got good response'; + } + elsif $result ~~ /302 \s+ Found/ && $result ~~ /^^'Location:' \s* $=[\N+]/ { + diag 'Got a redirect, following...'; + subtest { + check(fetch('google.com', $)); + }, 'Got good response after redirection'; + } + else { + fail 'Got good response'; + } +} + +sub verify-cb($preverify_ok, $x509_ctx) { + say "preverify_ok: " ~ ($preverify_ok == 0 ?? 'failed' !! 'passed'); + my $peer-cert = OpenSSL::X509_Store_Ctx::X509_STORE_CTX_get_current_cert($x509_ctx); + my $depth = OpenSSL::X509_Store_Ctx::X509_STORE_CTX_get_error_depth($x509_ctx); + my $bp = OpenSSL::Bio::BIO_new(OpenSSL::Bio::BIO_s_mem()); + if $bp && $peer-cert { + my $pathlen = OpenSSL::X509::X509_get_pathlen($peer-cert); + say $pathlen; + + my $n = OpenSSL::Bio::BIO_ctrl_pending($bp); + say $n; + + say OpenSSL::PEM::PEM_write_bio_X509($bp, $peer-cert); + my $buf = buf8.new.reallocate($n); + OpenSSL::BIO::BIO_read($bp, $buf, $n); + say $buf.perl; + } + return $preverify_ok; +} + +sub fetch($host, $url) { + my $ssl = OpenSSL.new(:client); + $ssl.set-verify(OpenSSL::SSL::SSL_VERIFY_PEER, &verify-cb); + my $s = IO::Socket::INET.new(:$host, :port(443)); + is $ssl.set-socket($s), 0, 'set-socket success'; + $ssl.set-connect-state; + is $ssl.connect, 1, 'connect success'; + is $ssl.write("GET $url HTTP/1.1\r\nHost:www.$host\r\nConnection:close\r\n\r\n"), 46 + $url.chars + $host.chars, 'write success'; + + #slurp it all up + my $result = ''; + loop { + my $tmp = $ssl.read(1024); + if $tmp.chars { + $result ~= $tmp; + } else { + last; + } + } + + $ssl.close; + $s.close; + $result +} +