upstream: github.com/mirage/ca-certs
Merge pull request #14 from emillon/windows
Windows support
authored by
Etienne Millon
and committed by
GitHub
517a0f17
3abe171e
+101
-3
+28
-2
lib/ca_certs.ml
+28
-2
lib/ca_certs.ml
···
50
50
let macos_keychain_location =
51
51
"/System/Library/Keychains/SystemRootCertificates.keychain"
52
52
53
+
external iter_on_anchors : (string -> unit) -> unit = "ca_certs_iter_on_anchors"
54
+
55
+
let get_anchors () =
56
+
let der_list = ref [] in
57
+
match
58
+
iter_on_anchors (fun der_cert ->
59
+
der_list := Cstruct.of_string der_cert :: !der_list)
60
+
with
61
+
| () -> Ok !der_list
62
+
| exception Failure msg -> Rresult.R.error_msg msg
63
+
64
+
let rec map_m f l =
65
+
match l with
66
+
| [] -> Ok []
67
+
| x :: xs ->
68
+
let open Rresult.R in
69
+
f x >>= fun y ->
70
+
map_m f xs >>| fun ys -> y :: ys
71
+
72
+
(** Load certificates from Windows' ["ROOT"] system certificate store.
73
+
The C API returns a list of DER-encoded certificates. These are decoded and
74
+
reencoded as a single PEM certificate. *)
75
+
let windows_trust_anchors () =
76
+
let open Rresult.R in
77
+
get_anchors () >>= map_m X509.Certificate.decode_der >>| fun cert_list ->
78
+
X509.Certificate.encode_pem_multiple cert_list |> Cstruct.to_string
79
+
53
80
let trust_anchors () =
54
81
let open Rresult.R.Infix in
55
-
if Sys.win32 then
56
-
Error (`Msg "ca-certs: windows is not supported at the moment")
82
+
if Sys.win32 then windows_trust_anchors ()
57
83
else
58
84
let cmd = Bos.Cmd.(v "uname" % "-s") in
59
85
Bos.OS.Cmd.(run_out cmd |> out_string |> success) >>= function
+49
lib/ca_certs_stubs.c
+49
lib/ca_certs_stubs.c
···
1
+
#include "caml/alloc.h"
2
+
#include "caml/callback.h"
3
+
#include "caml/fail.h"
4
+
#include "caml/memory.h"
5
+
6
+
#ifdef _WIN32
7
+
8
+
#include <windows.h>
9
+
10
+
value ca_certs_iter_on_anchors(value v_f)
11
+
{
12
+
CAMLparam1(v_f);
13
+
CAMLlocal1(v_encoded_cert);
14
+
15
+
HCERTSTORE hCertStore = CertOpenSystemStore(0, "ROOT");
16
+
if (!hCertStore)
17
+
{
18
+
caml_failwith("ca_certs_iter_on_anchors: CertOpenSystemStore returned NULL");
19
+
}
20
+
21
+
PCCERT_CONTEXT pCertContext = NULL;
22
+
while ((pCertContext = CertEnumCertificatesInStore(hCertStore, pCertContext)) != NULL)
23
+
{
24
+
if (!(pCertContext->dwCertEncodingType & X509_ASN_ENCODING))
25
+
{
26
+
caml_failwith("ca_certs_iter_on_anchors: certificate does not have expected encoding");
27
+
}
28
+
v_encoded_cert = caml_alloc_initialized_string(
29
+
pCertContext->cbCertEncoded,
30
+
pCertContext->pbCertEncoded);
31
+
caml_callback(v_f, v_encoded_cert);
32
+
}
33
+
34
+
if (!CertCloseStore(hCertStore, 0))
35
+
{
36
+
caml_failwith("ca_certs_iter_on_anchors: CertCloseStore returned an error");
37
+
}
38
+
39
+
CAMLreturn(Val_unit);
40
+
}
41
+
42
+
#else
43
+
44
+
value ca_certs_iter_on_anchors(value v_unit)
45
+
{
46
+
caml_failwith("ca_certs_iter_on_anchors: only implemented on Windows");
47
+
}
48
+
49
+
#endif
+24
-1
lib/dune
+24
-1
lib/dune
···
1
1
(library
2
2
(name ca_certs)
3
3
(public_name ca-certs)
4
-
(libraries mirage-crypto x509 astring bos rresult fpath logs ptime.clock.os))
4
+
(libraries mirage-crypto x509 astring bos rresult fpath logs ptime.clock.os)
5
+
(foreign_stubs
6
+
(language c)
7
+
(names ca_certs_stubs))
8
+
(c_library_flags
9
+
(:include flags.sexp)))
10
+
11
+
(rule
12
+
(target flags.sexp)
13
+
(enabled_if
14
+
(= %{os_type} Win32))
15
+
(action
16
+
(with-stdout-to
17
+
%{target}
18
+
(echo "(:standard -lcrypt32)"))))
19
+
20
+
(rule
21
+
(target flags.sexp)
22
+
(enabled_if
23
+
(<> %{os_type} Win32))
24
+
(action
25
+
(with-stdout-to
26
+
%{target}
27
+
(echo :standard))))