Skip to content

Commit 4b6c1b5

Browse files
ufobatufobat
committed
trying to build an interface to SSL_set_verify
adjusted signature - 07-verify-cb.t passes wip wip
1 parent 973db4b commit 4b6c1b5

File tree

8 files changed

+245
-0
lines changed

8 files changed

+245
-0
lines changed

‎lib/OpenSSL.pm6‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ use OpenSSL::Bio;
55
use OpenSSL::Err;
66
use OpenSSL::EVP;
77
use OpenSSL::X509;
8+
use OpenSSL::X509_Store_Ctx;
89

910
use NativeCall;
1011

@@ -278,6 +279,10 @@ method get-client-ca-list (:$debug is copy) {
278279
$ca-stack;
279280
}
280281

282+
method set-verify(Int $mode, &callback) {
283+
OpenSSL::SSL::SSL_set_verify($!ssl, $mode, &callback);
284+
}
285+
281286
method check-private-key {
282287
unless OpenSSL::Ctx::SSL_CTX_check_private_key($!ctx) {
283288
die "Private key does not match the public certificate";

‎lib/OpenSSL/Bio.pm6‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -44,3 +44,4 @@ our sub BIO_read(OpaquePointer, Blob, long --> int32) is native(&gen-lib) { ...
4444
our sub BIO_write(OpaquePointer, Blob, long --> int32) is native(&gen-lib) { ... }
4545
our sub BIO_new_mem_buf(Blob, long --> OpaquePointer) is native(&gen-lib) { ... }
4646
our sub BIO_s_mem() returns BIO_METHOD is native(&gen-lib) { ... }
47+
our sub BIO_ctrl_pending(Pointer) returns long is native(&gen-lib) { ... }

‎lib/OpenSSL/Ctx.pm6‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -32,3 +32,8 @@ our sub SSL_CTX_set_alpn_select_cb(SSL_CTX, &callback (
3232
Pointer --> int32), # arg
3333
Pointer)
3434
is native(&gen-lib) {*}
35+
our sub SSL_CTX_set_verify(OpenSSL::Ctx::SSL_CTX, int32,
36+
&callback ( int32,
37+
Pointer # X509_STORE_CTX
38+
--> int32)
39+
) is native(&ssl-lib) { ... }

‎lib/OpenSSL/PEM.pm6‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,3 +7,4 @@ our sub PEM_read_bio_RSAPrivateKey(OpaquePointer, OpaquePointer, OpaquePointer,
77
our sub PEM_read_bio_RSAPublicKey(OpaquePointer, OpaquePointer, OpaquePointer, OpaquePointer --> OpaquePointer) is native(&gen-lib) { ... }
88
our sub PEM_read_bio_RSA_PUBKEY(OpaquePointer, OpaquePointer, OpaquePointer, OpaquePointer --> OpaquePointer) is native(&gen-lib) { ... }
99
our sub PEM_read_bio_X509(OpaquePointer, OpaquePointer, OpaquePointer, OpaquePointer --> OpaquePointer) is native(&gen-lib) { ... }
10+
our sub PEM_write_bio_X509(Pointer, Pointer) returns int32 is native(&gen-lib) { ... }

‎lib/OpenSSL/SSL.pm6‎

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,13 @@ use OpenSSL::Base;
99

1010
use NativeCall;
1111

12+
constant SSL_VERIFY_NONE = 0x00;
13+
constant SSL_VERIFY_PEER = 0x01;
14+
constant SSL_VERIFY_FAIL_IF_NO_PEER_CERT = 0x02;
15+
constant SSL_VERIFY_CLIENT_ONCE = 0x04;
16+
constant SSL_VERIFY_POST_HANDSHAKE = 0x08;
17+
18+
1219
our sub SSL_library_init() is native(&ssl-lib) { ... }
1320
our sub OPENSSL_init_ssl(uint64, OpaquePointer) is native(&ssl-lib) { ... }
1421
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
3845

3946
# long SSL_ctrl(SSL *ssl, int cmd, long larg, void *parg)
4047
our sub SSL_ctrl(OpenSSL::Base::SSL, int32, int64, Str ) returns int64 is native(&ssl-lib) { ... }
48+
our sub SSL_set_verify(OpenSSL::Base::SSL, int32,
49+
&callback ( int32,
50+
#OpenSSL::Ctx::X509_STORE_CTX
51+
Pointer
52+
--> int32)) is native(&ssl-lib) { ... }

‎lib/OpenSSL/X509.pm6‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -67,3 +67,4 @@ our sub X509_get_ext_d2i(Pointer, int32, CArray[int32], CArray[int32]) returns O
6767

6868
our sub ASN1_STRING_to_UTF8(CArray[CArray[uint8]], Pointer) returns int32
6969
is native(&crypto-lib) { ... }
70+
our sub X509_get_pathlen(Pointer) returns int64 is native(&crypto-lib) { ... }

‎lib/OpenSSL/X509_Store_Ctx.pm6‎

Lines changed: 147 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,147 @@
1+
unit module OpenSSL::X509_Store_Ctx;
2+
3+
use v6;
4+
use NativeCall;
5+
use OpenSSL::NativeLib;
6+
7+
8+
# struct crypto_ex_data_st {
9+
# STACK_OF(void) *sk;
10+
# };
11+
# class CRYPTO_EX_DATA is repr('CStruct') {
12+
# has Pointer $.sk;
13+
#}
14+
15+
16+
# class X509_STORE_CTX is repr('CStruct') {
17+
# # X509_STORE *ctx;
18+
# has OpaquePointer $.ctx;
19+
20+
# # /* The following are set by the caller */
21+
# # /* The cert to check */
22+
# # X509 *cert;
23+
# has OpaquePointer $.cert;
24+
25+
# # /* chain of X509s - untrusted - passed in */
26+
# # STACK_OF(X509) *untrusted;
27+
# has Pointer $.untrusted;
28+
29+
# # /* set of CRLs passed in */
30+
# # STACK_OF(X509_CRL) *crls;
31+
# # X509_VERIFY_PARAM *param;
32+
# has Pointer $.crls;
33+
# has Pointer $.param;
34+
35+
# # /* Other info for use with get_issuer() */
36+
# # void *other_ctx;
37+
# has Pointer $.other_ctx;
38+
39+
# # /* Callbacks for various operations */
40+
# # /* called to verify a certificate */
41+
# # int (*verify) (X509_STORE_CTX *ctx)
42+
# has Pointer $.verify;
43+
44+
# # /* error callback */
45+
# # int (*verify_cb) (int ok, X509_STORE_CTX *ctx);
46+
# has Pointer $.verify_cb;
47+
48+
# # /* get issuers cert from ctx */
49+
# # int (*get_issuer) (X509 **issuer, X509_STORE_CTX *ctx, X509 *x);
50+
# has Pointer $.get_issuer;
51+
52+
# # /* check issued */
53+
# # int (*check_issued) (X509_STORE_CTX *ctx, X509 *x, X509 *issuer);
54+
# has Pointer $.check_issued;
55+
56+
# # /* Check revocation status of chain */
57+
# # int (*check_revocation) (X509_STORE_CTX *ctx);
58+
# has Pointer $.check_revocation;
59+
60+
# # /* retrieve CRL */
61+
# # int (*get_crl) (X509_STORE_CTX *ctx, X509_CRL **crl, X509 *x);
62+
# has Pointer $.get_crl;
63+
64+
# # /* Check CRL validity */
65+
# # int (*check_crl) (X509_STORE_CTX *ctx, X509_CRL *crl);
66+
# has Pointer $.check_crl;
67+
68+
# # /* Check certificate against CRL */
69+
# # int (*cert_crl) (X509_STORE_CTX *ctx, X509_CRL *crl, X509 *x);
70+
# has Pointer $.cert_crl;
71+
72+
# # /* Check policy status of the chain */
73+
# # int (*check_policy) (X509_STORE_CTX *ctx);
74+
# has Pointer $.check_policy;
75+
76+
# # STACK_OF(X509) *(*lookup_certs) (X509_STORE_CTX *ctx, X509_NAME *nm);
77+
# has Pointer $.lookup_certs;
78+
79+
# # STACK_OF(X509_CRL) *(*lookup_crls) (X509_STORE_CTX *ctx, X509_NAME *nm);
80+
# has Pointer $.lookup_crls;
81+
82+
# # int (*cleanup) (X509_STORE_CTX *ctx);
83+
# has Pointer $.cleanup;
84+
85+
# # /* The following is built up */
86+
# # /* if 0, rebuild chain */
87+
# # int valid;
88+
# has int32 $.valid;
89+
90+
# # /* number of untrusted certs */
91+
# # int num_untrusted;
92+
# has int32 $.num_untrusted;
93+
94+
# # /* chain of X509s - built up and trusted */
95+
# # STACK_OF(X509) *chain;
96+
# has Pointer $.chain;
97+
98+
# # /* Valid policy tree */
99+
# # X509_POLICY_TREE *tree;
100+
# has Pointer $.tree;
101+
102+
# # /* Require explicit policy value */
103+
# # int explicit_policy;
104+
# has int32 $explicit_policy;
105+
106+
# # /* When something goes wrong, this is why */
107+
# # int error_depth;
108+
# has int32 $.error_depth;
109+
110+
# # int error;
111+
# has int32 $.error;
112+
113+
# # X509 *current_cert;
114+
# has Pointer $.current_cert;
115+
116+
# # /* cert currently being tested as valid issuer */
117+
# # X509 *current_issuer;
118+
# has Pointer $.current_issuer;
119+
120+
# # /* current CRL */
121+
# # X509_CRL *current_crl;
122+
# has Pointer $.current_crl;
123+
124+
# # /* score of current CRL */
125+
# # int current_crl_score;
126+
# has int32 $.current_crl_score;
127+
128+
# # /* Reason mask */
129+
# # unsigned int current_reasons;
130+
# has uint32 $.current_reasons;
131+
132+
# # /* For CRL path validation: parent context */
133+
# # X509_STORE_CTX *parent;
134+
# has OpenSSL::Ctx::X509_STORE_CTX $.parent;
135+
# # CRYPTO_EX_DATA ex_data;
136+
# HAS CRYPTO_EX_DATA $.ex_data;
137+
138+
# # SSL_DANE *dane;
139+
# has Pointer $.dane;
140+
141+
# # /* signed via bare TA public key, rather than CA certificate */
142+
# # int bare_ta_signed;
143+
# has int32 $.bare_ta_signed;
144+
# }
145+
146+
our sub X509_STORE_CTX_get_current_cert(Pointer) returns Pointer is native(&ssl-lib) { ... }
147+
our sub X509_STORE_CTX_get_error_depth(Pointer) returns int32 is native(&ssl-lib) { ... }

‎t/07-verify-cb.t‎

Lines changed: 73 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,73 @@
1+
use OpenSSL;
2+
use Test;
3+
4+
plan 4;
5+
6+
unless %*ENV<NETWORK_TESTING> {
7+
diag "NETWORK_TESTING was not set";
8+
skip-rest("NETWORK_TESTING was not set");
9+
exit;
10+
}
11+
12+
check(fetch('google.com', '/'));
13+
14+
sub check($result) {
15+
if $result ~~ /200 \s+ OK/ {
16+
pass 'Got good response';
17+
}
18+
elsif $result ~~ /302 \s+ Found/ && $result ~~ /^^'Location:' \s* $<location>=[\N+]/ {
19+
diag 'Got a redirect, following...';
20+
subtest {
21+
check(fetch('google.com', $<location>));
22+
}, 'Got good response after redirection';
23+
}
24+
else {
25+
fail 'Got good response';
26+
}
27+
}
28+
29+
sub verify-cb($preverify_ok, $x509_ctx) {
30+
say "preverify_ok: " ~ ($preverify_ok == 0 ?? 'failed' !! 'passed');
31+
my $peer-cert = OpenSSL::X509_Store_Ctx::X509_STORE_CTX_get_current_cert($x509_ctx);
32+
my $depth = OpenSSL::X509_Store_Ctx::X509_STORE_CTX_get_error_depth($x509_ctx);
33+
my $bp = OpenSSL::Bio::BIO_new(OpenSSL::Bio::BIO_s_mem());
34+
if $bp && $peer-cert {
35+
my $pathlen = OpenSSL::X509::X509_get_pathlen($peer-cert);
36+
say $pathlen;
37+
38+
my $n = OpenSSL::Bio::BIO_ctrl_pending($bp);
39+
say $n;
40+
41+
say OpenSSL::PEM::PEM_write_bio_X509($bp, $peer-cert);
42+
my $buf = buf8.new.reallocate($n);
43+
OpenSSL::BIO::BIO_read($bp, $buf, $n);
44+
say $buf.perl;
45+
}
46+
return $preverify_ok;
47+
}
48+
49+
sub fetch($host, $url) {
50+
my $ssl = OpenSSL.new(:client);
51+
$ssl.set-verify(OpenSSL::SSL::SSL_VERIFY_PEER, &verify-cb);
52+
my $s = IO::Socket::INET.new(:$host, :port(443));
53+
is $ssl.set-socket($s), 0, 'set-socket success';
54+
$ssl.set-connect-state;
55+
is $ssl.connect, 1, 'connect success';
56+
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';
57+
58+
#slurp it all up
59+
my $result = '';
60+
loop {
61+
my $tmp = $ssl.read(1024);
62+
if $tmp.chars {
63+
$result ~= $tmp;
64+
} else {
65+
last;
66+
}
67+
}
68+
69+
$ssl.close;
70+
$s.close;
71+
$result
72+
}
73+

0 commit comments

Comments
 (0)