diff --git a/CHANGES.md b/CHANGES.md index b531481..b45b6d3 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,10 @@ - Add `digest` function (#65, #66). - Restore compatibility with openssl < 1.1.0 (#73). - Improved compatibility with OCaml 5 (#79). +- Fix `client_verify_callback` for `NO_NAKED_POINTERS` mode. A user-provided + verification function in C remains an out-of-heap pointer for 4.x for + compatibility, but is boxed for OCaml 5.x or 4.x when configured with + `--disable-naked-pointers`. (#83) 0.5.10 (2021-02-01) ====== diff --git a/src/ssl_stubs.c b/src/ssl_stubs.c index 2822d81..69beca1 100644 --- a/src/ssl_stubs.c +++ b/src/ssl_stubs.c @@ -59,6 +59,9 @@ #endif static int client_verify_callback(int, X509_STORE_CTX *); +#ifdef NO_NAKED_POINTERS +static value vclient_verify_callback = Val_int(0); +#endif static DH *load_dh_param(const char *dhfile); /******************* @@ -561,7 +564,16 @@ CAMLprim value ocaml_ssl_digest(value vevp, value vcert) CAMLprim value ocaml_ssl_get_client_verify_callback_ptr(value unit) { +#ifdef NO_NAKED_POINTERS + if (Is_long(vclient_verify_callback)) { + vclient_verify_callback = caml_alloc_shr(1, Abstract_tag); + *((int(**) (int, X509_STORE_CTX*))Data_abstract_val(vclient_verify_callback)) = client_verify_callback; + caml_register_generational_global_root(&vclient_verify_callback); + } + return vclient_verify_callback; +#else return (value)client_verify_callback; +#endif } static int client_verify_callback_verbose = 1; @@ -610,7 +622,16 @@ CAMLprim value ocaml_ssl_ctx_set_verify(value context, value vmode, value vcallb } if (Is_block(vcallback)) + { +#ifdef NO_NAKED_POINTERS + vcallback = Field(vcallback, 0); + if (!Is_block(vcallback) || Tag_val(vcallback) != Abstract_tag || Wosize_val(vcallback) != 1) + caml_invalid_argument("callback"); + callback = *((int(**) (int, X509_STORE_CTX*))Data_abstract_val(vcallback)); +#else callback = (int(*) (int, X509_STORE_CTX*))Field(vcallback, 0); +#endif + } caml_enter_blocking_section(); SSL_CTX_set_verify(ctx, mode, callback);