upstream: github.com/mirage/ca-certs
Merge pull request #19 from hannesm/next
avoid misleading warning message, drop rresult dependency
authored by
Hannes Mehnert
and committed by
GitHub
f90d95c6
f14b409d
+47
-56
+2
-14
.github/workflows/test.yml
+2
-14
.github/workflows/test.yml
···
9
9
strategy:
10
10
fail-fast: false
11
11
matrix:
12
-
ocaml-version: ["4.11.1"]
12
+
ocaml-version: ["4.13.1", "4.12.1", "4.11.2"]
13
13
operating-system: [macos-latest, ubuntu-latest, windows-latest]
14
14
15
15
runs-on: ${{ matrix.operating-system }}
···
19
19
uses: actions/checkout@v2
20
20
21
21
- name: Use OCaml ${{ matrix.ocaml-version }}
22
-
uses: avsm/setup-ocaml@v1
22
+
uses: ocaml/setup-ocaml@v2
23
23
with:
24
24
ocaml-version: ${{ matrix.ocaml-version }}
25
-
26
-
- name: Install dependencies
27
-
run: |
28
-
opam pin add -n ca-certs.dev .
29
-
opam depext -y ca-certs
30
-
opam install -t --deps-only .
31
-
32
-
- name: Build
33
-
run: opam exec -- dune build
34
-
35
-
- name: Test
36
-
run: opam exec -- dune runtest
-1
ca-certs.opam
-1
ca-certs.opam
+1
-1
dune-project
+1
-1
dune-project
+24
-19
lib/ca_certs.ml
+24
-19
lib/ca_certs.ml
···
59
59
der_list := Cstruct.of_string der_cert :: !der_list)
60
60
with
61
61
| () -> Ok !der_list
62
-
| exception Failure msg -> Rresult.R.error_msg msg
62
+
| exception Failure msg -> Error (`Msg msg)
63
+
64
+
let ( let* ) = Result.bind
63
65
64
66
let rec map_m f l =
65
67
match l with
66
68
| [] -> Ok []
67
69
| x :: xs ->
68
-
let open Rresult.R in
69
-
f x >>= fun y ->
70
-
map_m f xs >>| fun ys -> y :: ys
70
+
let* y = f x in
71
+
let* ys = map_m f xs in
72
+
Ok (y :: ys)
71
73
72
74
(** Load certificates from Windows' ["ROOT"] system certificate store.
73
75
The C API returns a list of DER-encoded certificates. These are decoded and
74
76
reencoded as a single PEM certificate. *)
75
77
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
78
+
let* anchors = get_anchors () in
79
+
let* cert_list = map_m X509.Certificate.decode_der anchors in
80
+
Ok (X509.Certificate.encode_pem_multiple cert_list |> Cstruct.to_string)
79
81
80
82
let trust_anchors () =
81
-
let open Rresult.R.Infix in
82
83
if Sys.win32 then windows_trust_anchors ()
83
84
else
84
85
(* NixOS is special and sets "NIX_SSL_CERT_FILE" as location during builds *)
···
88
89
detect_one x
89
90
| None -> (
90
91
let cmd = Bos.Cmd.(v "uname" % "-s") in
91
-
Bos.OS.Cmd.(run_out cmd |> out_string |> success) >>= function
92
+
let* os = Bos.OS.Cmd.(run_out cmd |> out_string |> success) in
93
+
match os with
92
94
| "FreeBSD" -> detect_one freebsd_location
93
95
| "OpenBSD" -> detect_one openbsd_location
94
96
| "Linux" -> detect_list linux_locations
···
102
104
| s -> Error (`Msg ("ca-certs: unknown system " ^ s ^ ".\n" ^ issue)))
103
105
104
106
let authenticator ?crls ?allowed_hashes () =
105
-
let open Rresult.R.Infix in
106
-
trust_anchors () >>= fun data ->
107
+
let* data = trust_anchors () in
107
108
let time () = Some (Ptime_clock.now ()) in
108
109
(* we cannot use decode_pem_multiple since this fails on the first
109
110
undecodable certificate - while we'd like to stay operational, and ignore
110
111
some certificates *)
111
-
let sep = "-----END CERTIFICATE-----" in
112
+
let d = "-----" in
113
+
let sep = d ^ "END CERTIFICATE" ^ d in
112
114
let certs = Astring.String.cuts ~sep ~empty:false data in
113
115
let cas =
116
+
let affix = d ^ "BEGIN CERTIFICATE" ^ d in
114
117
List.fold_left
115
118
(fun acc data ->
116
-
let data = data ^ sep in
117
-
match X509.Certificate.decode_pem (Cstruct.of_string data) with
118
-
| Ok ca -> ca :: acc
119
-
| Error (`Msg msg) ->
120
-
Log.warn (fun m -> m "Failed to decode a trust anchor %s." msg);
121
-
Log.debug (fun m -> m "Full certificate:@.%s" data);
122
-
acc)
119
+
if not (Astring.String.is_infix ~affix data) then acc
120
+
else
121
+
let data = data ^ sep in
122
+
match X509.Certificate.decode_pem (Cstruct.of_string data) with
123
+
| Ok ca -> ca :: acc
124
+
| Error (`Msg msg) ->
125
+
Log.warn (fun m -> m "Failed to decode a trust anchor %s." msg);
126
+
Log.debug (fun m -> m "Full certificate:@.%s" data);
127
+
acc)
123
128
[] certs
124
129
in
125
130
let cas = List.rev cas in
+1
-1
lib/dune
+1
-1
lib/dune
+19
-20
test/tests.ml
+19
-20
test/tests.ml
···
940
940
(fun (name, data) ->
941
941
let host = Domain_name.(of_string_exn name |> host_exn)
942
942
and chain =
943
-
Rresult.R.get_ok
943
+
Result.get_ok
944
944
(X509.Certificate.decode_pem_multiple (Cstruct.of_string data))
945
945
in
946
946
(name, `Quick, test_one tas (Ok (Some (chain, List.hd chain))) host chain))
···
949
949
(fun (name, result, data, time) ->
950
950
let host = Domain_name.(of_string_exn name |> host_exn)
951
951
and chain =
952
-
Rresult.R.get_ok
952
+
Result.get_ok
953
953
(X509.Certificate.decode_pem_multiple (Cstruct.of_string data))
954
954
in
955
955
(name, `Quick, test_one ?time tas (Error (result host chain)) host chain))
956
956
err_tests
957
957
958
958
let ta () =
959
-
let open Rresult.R.Infix in
960
-
Ca_certs.trust_anchors () >>| fun data ->
961
-
(* we cannot use decode_pem_multiple since this fails on the first
962
-
undecodable certificate - while we'd like to stay operational, and ignore
963
-
some certificates *)
964
-
let sep = "-----END CERTIFICATE-----" in
965
-
let certs = Astring.String.cuts ~sep ~empty:false data in
966
-
let cas =
967
-
List.fold_left
968
-
(fun acc data ->
969
-
let data = data ^ sep in
970
-
match X509.Certificate.decode_pem (Cstruct.of_string data) with
971
-
| Ok ca -> ca :: acc
972
-
| Error _ -> acc)
973
-
[] certs
974
-
in
975
-
List.rev cas
959
+
Result.bind (Ca_certs.trust_anchors ()) (fun data ->
960
+
(* we cannot use decode_pem_multiple since this fails on the first
961
+
undecodable certificate - while we'd like to stay operational, and
962
+
ignore some certificates *)
963
+
let sep = "-----END CERTIFICATE-----" in
964
+
let certs = Astring.String.cuts ~sep ~empty:false data in
965
+
let cas =
966
+
List.fold_left
967
+
(fun acc data ->
968
+
let data = data ^ sep in
969
+
match X509.Certificate.decode_pem (Cstruct.of_string data) with
970
+
| Ok ca -> ca :: acc
971
+
| Error _ -> acc)
972
+
[] certs
973
+
in
974
+
Ok (List.rev cas))
976
975
977
976
let () =
978
-
let tas = Rresult.R.get_ok (ta ()) in
977
+
let tas = Result.get_ok (ta ()) in
979
978
Alcotest.run "verification tests"
980
979
[ ("X509 certificate validation", tests tas) ]