upstream: github.com/mirage/ca-certs
Merge pull request #36 from Julow/silent_logs
Silent logs
authored by
Hannes Mehnert
and committed by
GitHub
bf98f51f
37099bcc
+33
-26
+29
-22
lib/ca_certs.ml
+29
-22
lib/ca_certs.ml
···
16
16
| _ ->
17
17
Error
18
18
(`Msg
19
-
("ca-certs: no trust anchor file found, looked into " ^ path ^ ".\n"
20
-
^ issue))
19
+
("ca-certs: no trust anchor file found, looked into " ^ path ^ ".\n"
20
+
^ issue))
21
21
22
22
let detect_list paths =
23
23
let rec one = function
24
24
| [] ->
25
25
Error
26
26
(`Msg
27
-
("ca-certs: no trust anchor file found, looked into "
28
-
^ String.concat ", " paths ^ ".\n" ^ issue))
27
+
("ca-certs: no trust anchor file found, looked into "
28
+
^ String.concat ", " paths ^ ".\n" ^ issue))
29
29
| path :: paths -> (
30
30
match detect_one path with Ok data -> Ok data | Error _ -> one paths)
31
31
in
···
62
62
63
63
let ( let* ) = Result.bind
64
64
65
-
(** Load certificates from Windows' ["ROOT"] system certificate store.
66
-
The C API returns a list of DER-encoded certificates. These are decoded and
67
-
reencoded as a single PEM certificate. *)
65
+
(** Load certificates from Windows' ["ROOT"] system certificate store. The C API
66
+
returns a list of DER-encoded certificates. These are decoded and reencoded
67
+
as a single PEM certificate. *)
68
68
let windows_trust_anchors () =
69
69
let* anchors = get_anchors () in
70
-
let cert_list =
70
+
let cert_list, err_count =
71
71
List.fold_left
72
-
(fun acc cert ->
72
+
(fun (acc, err_count) cert ->
73
73
match X509.Certificate.decode_der cert with
74
-
| Ok cert -> cert :: acc
74
+
| Ok cert -> (cert :: acc, err_count)
75
75
| Error (`Msg msg) ->
76
-
Log.warn (fun m -> m "Ignoring undecodable trust anchor: %s." msg);
76
+
Log.debug (fun m -> m "Ignoring undecodable trust anchor: %s." msg);
77
77
Log.debug (fun m ->
78
78
m "Full certificate:@.%a" (Ohex.pp_hexdump ()) cert);
79
-
acc)
80
-
[] anchors
79
+
(acc, err_count + 1))
80
+
([], 0) anchors
81
81
in
82
+
if err_count > 0 then
83
+
Log.warn (fun m -> m "Ignored %u trust anchors." err_count);
82
84
Ok (X509.Certificate.encode_pem_multiple cert_list)
83
85
84
86
let system_trust_anchors () =
···
89
91
(Sys.getenv_opt "SSL_CERT_FILE", Sys.getenv_opt "NIX_SSL_CERT_FILE")
90
92
with
91
93
| Some x, _ ->
92
-
Log.info (fun m -> m "using %s (from SSL_CERT_FILE)" x);
94
+
Log.debug (fun m -> m "using %s (from SSL_CERT_FILE)" x);
93
95
detect_one x
94
96
| _, Some x ->
95
-
Log.info (fun m -> m "using %s (from NIX_SSL_CERT_FILE)" x);
97
+
Log.debug (fun m -> m "using %s (from NIX_SSL_CERT_FILE)" x);
96
98
detect_one x
97
99
| None, None -> (
98
100
let cmd = Bos.Cmd.(v "uname" % "-s") in
···
156
158
Ok cas
157
159
158
160
let decode_pem_multiple data =
159
-
X509.Certificate.fold_decode_pem_multiple
160
-
(fun acc -> function
161
-
| Ok t -> t :: acc
162
-
| Error (`Msg msg) ->
163
-
Log.warn (fun m -> m "Ignoring undecodable trust anchor: %s." msg);
164
-
acc)
165
-
[] data
161
+
let tas, err_count =
162
+
X509.Certificate.fold_decode_pem_multiple
163
+
(fun (acc, err_count) -> function
164
+
| Ok t -> (t :: acc, err_count)
165
+
| Error (`Msg msg) ->
166
+
Log.debug (fun m -> m "Ignoring undecodable trust anchor: %s." msg);
167
+
(acc, err_count + 1))
168
+
([], 0) data
169
+
in
170
+
if err_count > 0 then
171
+
Log.warn (fun m -> m "Ignored %u trust anchors." err_count);
172
+
tas
166
173
167
174
let authenticator ?crls ?allowed_hashes () =
168
175
let* data = trust_anchors () in
+3
-3
lib/ca_certs.mli
+3
-3
lib/ca_certs.mli
···
7
7
anchors) in the operating system's trust store using {!trust_anchors}. It
8
8
constructs an authenticator with the current timestamp {!Ptime_clock.now},
9
9
and the provided [~crls] and [~allowed_hashes] arguments. The resulting
10
-
authenticator can be used for {!Tls.Config.client}.
11
-
Returns [Error `Msg msg] if detection did not succeed. *)
10
+
authenticator can be used for {!Tls.Config.client}. Returns [Error `Msg msg]
11
+
if detection did not succeed. *)
12
12
13
13
val trust_anchors : unit -> (string, [> `Msg of string ]) result
14
14
(** [trust_anchors ()] detects the root CAs (trust anchors) in the operating
···
17
17
pem-encoded X509 certificates.
18
18
19
19
On Unix systems, if the environment variable [SSL_CERT_FILE] is set, its
20
-
value is used as path to the system trust anchors. Otherwise, if
20
+
value is used as path to the system trust anchors. Otherwise, if
21
21
[NIX_SSL_CERT_FILE] is set, its value is used.
22
22
23
23
The successful result is a list of pem-encoded X509 certificates. *)