upstream: github.com/mirage/ca-certs
Merge pull request #11 from hannesm/resilient-trust-anchor-failures
More resilient in respect to certificate decoding failures
authored by
Hannes Mehnert
and committed by
GitHub
a708a326
9365b401
+29
-4
+2
ca-certs.opam
+2
ca-certs.opam
+1
-1
dune-project
+1
-1
dune-project
+25
-2
lib/ca_certs.ml
+25
-2
lib/ca_certs.ml
···
1
+
let src = Logs.Src.create "ca-certs" ~doc:"CA certificates"
2
+
3
+
module Log = (val Logs.src_log src : Logs.LOG)
4
+
1
5
let issue =
2
6
{|Please report an issue at https://github.com/mirage/ca-certs, including:
3
7
- the output of uname -s
···
69
73
let open Rresult.R.Infix in
70
74
trust_anchors () >>= fun data ->
71
75
let time () = Some (Ptime_clock.now ()) in
72
-
X509.Certificate.decode_pem_multiple (Cstruct.of_string data) >>| fun cas ->
73
-
X509.Authenticator.chain_of_trust ?crls ?hash_whitelist ~time cas
76
+
(* we cannot use decode_pem_multiple since this fails on the first
77
+
undecodable certificate - while we'd like to stay operational, and ignore
78
+
some certificates *)
79
+
let sep = "-----END CERTIFICATE-----" in
80
+
let certs = Astring.String.cuts ~sep ~empty:false data in
81
+
let cas =
82
+
List.fold_left
83
+
(fun acc data ->
84
+
let data = data ^ sep in
85
+
match X509.Certificate.decode_pem (Cstruct.of_string data) with
86
+
| Ok ca -> ca :: acc
87
+
| Error (`Msg msg) ->
88
+
Log.warn (fun m -> m "Failed to decode a trust anchor %s." msg);
89
+
Log.debug (fun m -> m "Full certificate:@.%s" data);
90
+
acc)
91
+
[] certs
92
+
in
93
+
let cas = List.rev cas in
94
+
match cas with
95
+
| [] -> Error (`Msg ("ca-certs: empty trust anchors.\n" ^ issue))
96
+
| _ -> Ok (X509.Authenticator.chain_of_trust ?crls ?hash_whitelist ~time cas)