Help Needed: SSL_set_verify_cb

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";

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) { ... }

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) { ... }

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) { ... }

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) { ... }

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) { ... }

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) { ... }

t/07-verify-cb.t

@@ -0,0 +1,73 @@
+use OpenSSL;
+use Test;
+
+plan 4;
+
+unless %*ENV<NETWORK_TESTING> {
+    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* $<location>=[\N+]/ {
+        diag 'Got a redirect, following...';
+        subtest {
+            check(fetch('google.com', $<location>));
+        }, '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
+}
+