add binding for X509_digest

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

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. *)

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;

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

tests/dune

@@ -0,0 +1,3 @@
+(test
+ (name ssl_test)
+ (libraries ssl alcotest))

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;
+        ] );
+    ]