1
- #include <ctype.h>
2
1
#include <string.h>
3
2
#include <stdio.h>
4
3
18
17
#include <caml/callback.h>
19
18
#include <caml/custom.h>
20
19
21
- #include "mbedtls/debug.h"
22
20
#include "mbedtls/error.h"
23
- #include "mbedtls/config.h"
24
21
#include "mbedtls/ssl.h"
25
22
#include "mbedtls/entropy.h"
26
23
#include "mbedtls/ctr_drbg.h"
27
- #include "mbedtls/certs.h"
28
24
#include "mbedtls/oid.h"
29
25
30
26
#define PVoid_val (v ) (*((void**) Data_custom_val(v)))
@@ -84,7 +80,7 @@ CAMLprim value ml_mbedtls_ctr_drbg_init(void) {
84
80
85
81
CAMLprim value ml_mbedtls_ctr_drbg_random (value p_rng , value output , value output_len ) {
86
82
CAMLparam3 (p_rng , output , output_len );
87
- CAMLreturn (Val_int (mbedtls_ctr_drbg_random (CtrDrbg_val (p_rng ), String_val (output ), Int_val (output_len ))));
83
+ CAMLreturn (Val_int (mbedtls_ctr_drbg_random (CtrDrbg_val (p_rng ), Bytes_val (output ), Int_val (output_len ))));
88
84
}
89
85
90
86
CAMLprim value ml_mbedtls_ctr_drbg_seed (value ctx , value p_entropy , value custom ) {
@@ -124,7 +120,7 @@ CAMLprim value ml_mbedtls_entropy_init(void) {
124
120
125
121
CAMLprim value ml_mbedtls_entropy_func (value data , value output , value len ) {
126
122
CAMLparam3 (data , output , len );
127
- CAMLreturn (Val_int (mbedtls_entropy_func (PVoid_val (data ), String_val (output ), Int_val (len ))));
123
+ CAMLreturn (Val_int (mbedtls_entropy_func (PVoid_val (data ), Bytes_val (output ), Int_val (len ))));
128
124
}
129
125
130
126
// Certificate
@@ -171,7 +167,7 @@ CAMLprim value ml_mbedtls_x509_next(value chain) {
171
167
172
168
CAMLprim value ml_mbedtls_x509_crt_parse (value chain , value bytes ) {
173
169
CAMLparam2 (chain , bytes );
174
- const char * buf = String_val (bytes );
170
+ const unsigned char * buf = Bytes_val (bytes );
175
171
int len = caml_string_length (bytes );
176
172
CAMLreturn (Val_int (mbedtls_x509_crt_parse (X509Crt_val (chain ), buf , len + 1 )));
177
173
}
@@ -191,16 +187,19 @@ CAMLprim value ml_mbedtls_x509_crt_parse_path(value chain, value path) {
191
187
value caml_string_of_asn1_buf (mbedtls_asn1_buf * dat ) {
192
188
CAMLparam0 ();
193
189
CAMLlocal1 (s );
194
- s = caml_alloc_string (dat -> len );
195
- memcpy (String_val (s ), dat -> p , dat -> len );
190
+ s = caml_alloc_initialized_string (dat -> len , (const char * )dat -> p );
196
191
CAMLreturn (s );
197
192
}
198
193
199
194
CAMLprim value hx_cert_get_alt_names (value chain ) {
200
195
CAMLparam1 (chain );
201
196
CAMLlocal1 (obj );
202
197
mbedtls_x509_crt * cert = X509Crt_val (chain );
203
- if (cert -> ext_types & MBEDTLS_X509_EXT_SUBJECT_ALT_NAME == 0 || & cert -> subject_alt_names == NULL ) {
198
+ #if MBEDTLS_VERSION_MAJOR >= 3
199
+ if (!mbedtls_x509_crt_has_ext_type (cert , MBEDTLS_X509_EXT_SUBJECT_ALT_NAME )) {
200
+ #else
201
+ if ((cert -> ext_types & MBEDTLS_X509_EXT_SUBJECT_ALT_NAME ) == 0 ) {
202
+ #endif
204
203
obj = Atom (0 );
205
204
} else {
206
205
mbedtls_asn1_sequence * cur = & cert -> subject_alt_names ;
@@ -366,29 +365,39 @@ CAMLprim value ml_mbedtls_pk_init(void) {
366
365
CAMLreturn (obj );
367
366
}
368
367
369
- CAMLprim value ml_mbedtls_pk_parse_key (value ctx , value key , value password ) {
370
- CAMLparam3 (ctx , key , password );
371
- const char * pwd = NULL ;
368
+ CAMLprim value ml_mbedtls_pk_parse_key (value ctx , value key , value password , value rng ) {
369
+ CAMLparam4 (ctx , key , password , rng );
370
+ const unsigned char * pwd = NULL ;
372
371
size_t pwdlen = 0 ;
373
372
if (password != Val_none ) {
374
- pwd = String_val (Field (password , 0 ));
373
+ pwd = Bytes_val (Field (password , 0 ));
375
374
pwdlen = caml_string_length (Field (password , 0 ));
376
375
}
377
- CAMLreturn (mbedtls_pk_parse_key (PkContext_val (ctx ), String_val (key ), caml_string_length (key ) + 1 , pwd , pwdlen ));
376
+ #if MBEDTLS_VERSION_MAJOR >= 3
377
+ mbedtls_ctr_drbg_context * ctr_drbg = CtrDrbg_val (rng );
378
+ CAMLreturn (mbedtls_pk_parse_key (PkContext_val (ctx ), Bytes_val (key ), caml_string_length (key ) + 1 , pwd , pwdlen , mbedtls_ctr_drbg_random , NULL ));
379
+ #else
380
+ CAMLreturn (mbedtls_pk_parse_key (PkContext_val (ctx ), Bytes_val (key ), caml_string_length (key ) + 1 , pwd , pwdlen ));
381
+ #endif
378
382
}
379
383
380
- CAMLprim value ml_mbedtls_pk_parse_keyfile (value ctx , value path , value password ) {
381
- CAMLparam3 (ctx , path , password );
384
+ CAMLprim value ml_mbedtls_pk_parse_keyfile (value ctx , value path , value password , value rng ) {
385
+ CAMLparam4 (ctx , path , password , rng );
382
386
const char * pwd = NULL ;
383
387
if (password != Val_none ) {
384
388
pwd = String_val (Field (password , 0 ));
385
389
}
390
+ #if MBEDTLS_VERSION_MAJOR >= 3
391
+ mbedtls_ctr_drbg_context * ctr_drbg = CtrDrbg_val (rng );
392
+ CAMLreturn (mbedtls_pk_parse_keyfile (PkContext_val (ctx ), String_val (path ), pwd , mbedtls_ctr_drbg_random , ctr_drbg ));
393
+ #else
386
394
CAMLreturn (mbedtls_pk_parse_keyfile (PkContext_val (ctx ), String_val (path ), pwd ));
395
+ #endif
387
396
}
388
397
389
398
CAMLprim value ml_mbedtls_pk_parse_public_key (value ctx , value key ) {
390
399
CAMLparam2 (ctx , key );
391
- CAMLreturn (mbedtls_pk_parse_public_key (PkContext_val (ctx ), String_val (key ), caml_string_length (key ) + 1 ));
400
+ CAMLreturn (mbedtls_pk_parse_public_key (PkContext_val (ctx ), Bytes_val (key ), caml_string_length (key ) + 1 ));
392
401
}
393
402
394
403
CAMLprim value ml_mbedtls_pk_parse_public_keyfile (value ctx , value path ) {
@@ -446,23 +455,22 @@ CAMLprim value ml_mbedtls_ssl_handshake(value ssl) {
446
455
447
456
CAMLprim value ml_mbedtls_ssl_read (value ssl , value buf , value pos , value len ) {
448
457
CAMLparam4 (ssl , buf , pos , len );
449
- CAMLreturn (Val_int (mbedtls_ssl_read (SslContext_val (ssl ), String_val (buf ) + Int_val (pos ), Int_val (len ))));
458
+ CAMLreturn (Val_int (mbedtls_ssl_read (SslContext_val (ssl ), Bytes_val (buf ) + Int_val (pos ), Int_val (len ))));
450
459
}
451
460
452
461
static int bio_write_cb (void * ctx , const unsigned char * buf , size_t len ) {
453
462
CAMLparam0 ();
454
463
CAMLlocal3 (r , s , vctx );
455
- vctx = (value )ctx ;
456
- s = caml_alloc_string (len );
457
- memcpy (String_val (s ), buf , len );
464
+ vctx = * (value * )ctx ;
465
+ s = caml_alloc_initialized_string (len , (const char * )buf );
458
466
r = caml_callback2 (Field (vctx , 1 ), Field (vctx , 0 ), s );
459
467
CAMLreturn (Int_val (r ));
460
468
}
461
469
462
470
static int bio_read_cb (void * ctx , unsigned char * buf , size_t len ) {
463
471
CAMLparam0 ();
464
472
CAMLlocal3 (r , s , vctx );
465
- vctx = (value )ctx ;
473
+ vctx = * (value * )ctx ;
466
474
s = caml_alloc_string (len );
467
475
r = caml_callback2 (Field (vctx , 2 ), Field (vctx , 0 ), s );
468
476
memcpy (buf , String_val (s ), len );
@@ -476,7 +484,11 @@ CAMLprim value ml_mbedtls_ssl_set_bio(value ssl, value p_bio, value f_send, valu
476
484
Store_field (ctx , 0 , p_bio );
477
485
Store_field (ctx , 1 , f_send );
478
486
Store_field (ctx , 2 , f_recv );
479
- mbedtls_ssl_set_bio (SslContext_val (ssl ), (void * )ctx , bio_write_cb , bio_read_cb , NULL );
487
+ // TODO: this allocation is leaked
488
+ value * location = malloc (sizeof (value ));
489
+ * location = ctx ;
490
+ caml_register_generational_global_root (location );
491
+ mbedtls_ssl_set_bio (SslContext_val (ssl ), (void * )location , bio_write_cb , bio_read_cb , NULL );
480
492
CAMLreturn (Val_unit );
481
493
}
482
494
@@ -492,7 +504,7 @@ CAMLprim value ml_mbedtls_ssl_setup(value ssl, value conf) {
492
504
493
505
CAMLprim value ml_mbedtls_ssl_write (value ssl , value buf , value pos , value len ) {
494
506
CAMLparam4 (ssl , buf , pos , len );
495
- CAMLreturn (Val_int (mbedtls_ssl_write (SslContext_val (ssl ), String_val (buf ) + Int_val (pos ), Int_val (len ))));
507
+ CAMLreturn (Val_int (mbedtls_ssl_write (SslContext_val (ssl ), Bytes_val (buf ) + Int_val (pos ), Int_val (len ))));
496
508
}
497
509
498
510
// glue
@@ -520,36 +532,23 @@ CAMLprim value hx_cert_load_defaults(value certificate) {
520
532
#endif
521
533
522
534
#ifdef __APPLE__
523
- CFMutableDictionaryRef search ;
524
- CFArrayRef result ;
525
- SecKeychainRef keychain ;
526
- SecCertificateRef item ;
527
- CFDataRef dat ;
528
- // Load keychain
529
- if (SecKeychainOpen ("/System/Library/Keychains/SystemRootCertificates.keychain" , & keychain ) == errSecSuccess ) {
530
- // Search for certificates
531
- search = CFDictionaryCreateMutable (NULL , 0 , NULL , NULL );
532
- CFDictionarySetValue (search , kSecClass , kSecClassCertificate );
533
- CFDictionarySetValue (search , kSecMatchLimit , kSecMatchLimitAll );
534
- CFDictionarySetValue (search , kSecReturnRef , kCFBooleanTrue );
535
- CFDictionarySetValue (search , kSecMatchSearchList , CFArrayCreate (NULL , (const void * * )& keychain , 1 , NULL ));
536
- if (SecItemCopyMatching (search , (CFTypeRef * )& result ) == errSecSuccess ) {
537
- CFIndex n = CFArrayGetCount (result );
538
- for (CFIndex i = 0 ; i < n ; i ++ ) {
539
- item = (SecCertificateRef )CFArrayGetValueAtIndex (result , i );
540
-
541
- // Get certificate in DER format
542
- dat = SecCertificateCopyData (item );
543
- if (dat ) {
544
- r = mbedtls_x509_crt_parse_der (chain , (unsigned char * )CFDataGetBytePtr (dat ), CFDataGetLength (dat ));
545
- CFRelease (dat );
546
- if (r != 0 ) {
547
- CAMLreturn (Val_int (r ));
548
- }
535
+ CFArrayRef certs ;
536
+ if (SecTrustCopyAnchorCertificates (& certs ) == errSecSuccess ) {
537
+ CFIndex count = CFArrayGetCount (certs );
538
+ for (CFIndex i = 0 ; i < count ; i ++ ) {
539
+ SecCertificateRef item = (SecCertificateRef )CFArrayGetValueAtIndex (certs , i );
540
+
541
+ // Get certificate in DER format
542
+ CFDataRef data = SecCertificateCopyData (item );
543
+ if (data ) {
544
+ r = mbedtls_x509_crt_parse_der (chain , (unsigned char * )CFDataGetBytePtr (data ), CFDataGetLength (data ));
545
+ CFRelease (data );
546
+ if (r != 0 ) {
547
+ CAMLreturn (Val_int (r ));
549
548
}
550
549
}
551
550
}
552
- CFRelease (keychain );
551
+ CFRelease (certs );
553
552
}
554
553
#endif
555
554
0 commit comments