diff --git a/src/ssl.ml b/src/ssl.ml index fac6ed3..a96a3c9 100644 --- a/src/ssl.ml +++ b/src/ssl.ml @@ -179,6 +179,8 @@ external get_verify_result : socket -> int = "ocaml_ssl_get_verify_result" external get_verify_error_string : int -> string = "ocaml_ssl_get_verify_error_string" +external digest : [`SHA1 | `SHA256 | `SHA384] -> certificate -> string = "ocaml_ssl_digest" + type verify_mode = | Verify_peer | Verify_fail_if_no_peer_cert diff --git a/src/ssl.mli b/src/ssl.mli index 010cef6..8463f29 100644 --- a/src/ssl.mli +++ b/src/ssl.mli @@ -385,6 +385,9 @@ val get_verify_result : socket -> int Its input should be the result of calling [get_verify_result]. *) val get_verify_error_string : int -> string +(** Get the digest of the certificate as a binary string, using the SHA1, SHA256 or SHA384 hashing algorithm. *) +val digest : [`SHA1 | `SHA256 | `SHA384] -> certificate -> string + (** {2 Creating, connecting and closing sockets} *) (** Embed a Unix socket into an SSL socket. *) diff --git a/src/ssl_stubs.c b/src/ssl_stubs.c index 046d408..82e8ad1 100644 --- a/src/ssl_stubs.c +++ b/src/ssl_stubs.c @@ -531,6 +531,34 @@ CAMLprim value ocaml_ssl_get_verify_error_string(value verrn) return caml_copy_string(error_string); } +CAMLprim value ocaml_ssl_digest(value vevp, value vcert) +{ + CAMLparam2(vevp, vcert); + CAMLlocal1(vdigest); + char buf[384/8]; + const EVP_MD *evp; + if (vevp == hash_variant("SHA384")) + evp = EVP_sha384(); + else if(vevp == hash_variant("SHA256")) + evp = EVP_sha256(); + else + evp = EVP_sha1(); + size_t digest_size = EVP_MD_size(evp); + assert(digest_size <= sizeof(buf)); + X509 *x509 = *((X509 **) Data_custom_val(vcert)); + caml_enter_blocking_section(); + int status = X509_digest(x509, evp, (unsigned char*)buf, NULL); + caml_leave_blocking_section(); + if (0 == status) + { + ERR_error_string_n(ERR_get_error(), buf, sizeof(buf)); + caml_raise_with_arg(*caml_named_value("ssl_exn_certificate_error"), caml_copy_string(buf)); + } + vdigest = caml_alloc_string(digest_size); + memcpy(Bytes_val(vdigest), buf, digest_size); + CAMLreturn(vdigest); +} + CAMLprim value ocaml_ssl_get_client_verify_callback_ptr(value unit) { return (value)client_verify_callback; diff --git a/tests/digicert_certificate.pem b/tests/digicert_certificate.pem new file mode 100644 index 0000000..9e6810a --- /dev/null +++ b/tests/digicert_certificate.pem @@ -0,0 +1,23 @@ +-----BEGIN CERTIFICATE----- +MIIDxTCCAq2gAwIBAgIQAqxcJmoLQJuPC3nyrkYldzANBgkqhkiG9w0BAQUFADBs +MQswCQYDVQQGEwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQLExB3 +d3cuZGlnaWNlcnQuY29tMSswKQYDVQQDEyJEaWdpQ2VydCBIaWdoIEFzc3VyYW5j +ZSBFViBSb290IENBMB4XDTA2MTExMDAwMDAwMFoXDTMxMTExMDAwMDAwMFowbDEL +MAkGA1UEBhMCVVMxFTATBgNVBAoTDERpZ2lDZXJ0IEluYzEZMBcGA1UECxMQd3d3 +LmRpZ2ljZXJ0LmNvbTErMCkGA1UEAxMiRGlnaUNlcnQgSGlnaCBBc3N1cmFuY2Ug +RVYgUm9vdCBDQTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMbM5XPm ++9S75S0tMqbf5YE/yc0lSbZxKsPVlDRnogocsF9ppkCxxLeyj9CYpKlBWTrT3JTW +PNt0OKRKzE0lgvdKpVMSOO7zSW1xkX5jtqumX8OkhPhPYlG++MXs2ziS4wblCJEM +xChBVfvLWokVfnHoNb9Ncgk9vjo4UFt3MRuNs8ckRZqnrG0AFFoEt7oT61EKmEFB +Ik5lYYeBQVCmeVyJ3hlKV9Uu5l0cUyx+mM0aBhakaHPQNAQTXKFx01p8VdteZOE3 +hzBWBOURtCmAEvF5OYiiAhF8J2a3iLd48soKqDirCmTCv2ZdlYTBoSUeh10aUAsg +EsxBu24LUTi4S8sCAwEAAaNjMGEwDgYDVR0PAQH/BAQDAgGGMA8GA1UdEwEB/wQF +MAMBAf8wHQYDVR0OBBYEFLE+w2kD+L9HAdSYJhoIAu9jZCvDMB8GA1UdIwQYMBaA +FLE+w2kD+L9HAdSYJhoIAu9jZCvDMA0GCSqGSIb3DQEBBQUAA4IBAQAcGgaX3Nec +nzyIZgYIVyHbIUf4KmeqvxgydkAQV8GK83rZEWWONfqe/EW1ntlMMUu4kehDLI6z +eM7b41N5cdblIZQB2lWHmiRk9opmzN6cN82oNLFpmyPInngiK3BD41VHMWEZ71jF +hS9OMPagMRYjyOfiZRYzy78aG6A9+MpeizGLYAiJLQwGXFK3xPkKmNEVX58Svnw2 +Yzi9RKR/5CYrCsSXaQ3pjOLAEFe4yHYSkVXySGnYvCoCWw9E1CAx2/S6cCZdkGCe +vEsXCS+0yx5DaMkHJ8HSXPfqIbloEpw8nL+e/IBcm2PN7EeqJSdnoDfzAIJ9VNep ++OkuE6N36B9K +-----END CERTIFICATE----- diff --git a/tests/dune b/tests/dune new file mode 100644 index 0000000..24e8687 --- /dev/null +++ b/tests/dune @@ -0,0 +1,3 @@ +(test + (name ssl_test) + (libraries ssl alcotest)) diff --git a/tests/ssl_test.ml b/tests/ssl_test.ml new file mode 100644 index 0000000..96a143a --- /dev/null +++ b/tests/ssl_test.ml @@ -0,0 +1,38 @@ +(** Get the colon-separated hex representation of a binary string. *) +let hex_digest digest = + let rec go acc i = + if i < 0 then acc + else + let byte = Printf.sprintf "%02X" @@ int_of_char digest.[i] in + go (byte :: acc) (i - 1) + in + go [] (String.length digest - 1) |> String.concat ":" + +(* The reference hashes come from Firefox’ certificate viewer. It doesn’t show + * the SHA384 hash, hence its absence from the tests. *) + +let test_sha1 () = + Alcotest.(check string) + "same digest" "5F:B7:EE:06:33:E2:59:DB:AD:0C:4C:9A:E6:D3:8F:1A:61:C7:DC:25" + Ssl.( + read_certificate "digicert_certificate.pem" |> digest `SHA1 |> hex_digest) + +let test_sha256 () = + Alcotest.(check string) + "same digest" + "74:31:E5:F4:C3:C1:CE:46:90:77:4F:0B:61:E0:54:40:88:3B:A9:A0:1E:D0:0B:A6:AB:D7:80:6E:D3:B1:18:CF" + Ssl.( + read_certificate "digicert_certificate.pem" + |> digest `SHA256 + |> hex_digest) + +let () = + let open Alcotest in + run "Ssl" + [ + ( "digest", + [ + test_case "SHA1" `Quick test_sha1; + test_case "SHA256" `Quick test_sha256; + ] ); + ]