upstream: github.com/mirage/ca-certs
Initial version
+201
+1
.ocamlformat
+1
.ocamlformat
···
1
+
profile=conventional
+15
LICENSE.md
+15
LICENSE.md
···
1
+
## ISC License
2
+
3
+
Copyright (c) 2019, The MirageOS contributors
4
+
5
+
Permission to use, copy, modify, and/or distribute this software for any
6
+
purpose with or without fee is hereby granted, provided that the above
7
+
copyright notice and this permission notice appear in all copies.
8
+
9
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10
+
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11
+
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12
+
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13
+
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14
+
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15
+
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+7
README.md
+7
README.md
···
1
+
## ca-certs - detect root CA certificates from the operating system
2
+
3
+
TLS requires a set of root anchors (Certificate Authorities) to authenticate
4
+
servers. This library exposes this list so that it can be registered with
5
+
[ocaml-tls].
6
+
7
+
[ocaml-tls]: https://github.com/mirleft/ocaml-tls
+33
ca-certs.opam
+33
ca-certs.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Detect root CA certificates from the operating system"
4
+
description: """
5
+
TLS requires a set of root anchors (Certificate Authorities) to
6
+
authenticate servers. This library exposes this list so that it can be
7
+
registered with ocaml-tls.
8
+
"""
9
+
maintainer: ["Etienne Millon <me@emillon.org>"]
10
+
authors: ["Etienne Millon <me@emillon.org>"]
11
+
license: "ISC"
12
+
homepage: "https://github.com/mirage/ca-certs"
13
+
doc: "https://mirage.github.io/ca-certs/doc"
14
+
bug-reports: "https://github.com/mirage/ca-certs/issues"
15
+
depends: [
16
+
"dune" {>= "1.11"}
17
+
]
18
+
build: [
19
+
["dune" "subst"] {pinned}
20
+
[
21
+
"dune"
22
+
"build"
23
+
"-p"
24
+
name
25
+
"-j"
26
+
jobs
27
+
"@install"
28
+
"@runtest" {with-test}
29
+
"@doc" {with-doc}
30
+
]
31
+
]
32
+
dev-repo: "git+https://github.com/mirage/ca-certs.git"
33
+
tags: ["org:mirage"]
+1
ca-certs.opam.template
+1
ca-certs.opam.template
···
1
+
tags: ["org:mirage"]
+22
dune-project
+22
dune-project
···
1
+
(lang dune 1.11)
2
+
(name ca-certs)
3
+
4
+
(generate_opam_files true)
5
+
(source (github mirage/ca-certs))
6
+
(documentation "https://mirage.github.io/ca-certs/doc")
7
+
(license ISC)
8
+
(maintainers "Etienne Millon <me@emillon.org>")
9
+
(authors "Etienne Millon <me@emillon.org>")
10
+
11
+
(package
12
+
(name ca-certs)
13
+
(depends)
14
+
(synopsis "Detect root CA certificates from the operating system")
15
+
(description
16
+
"\> TLS requires a set of root anchors (Certificate Authorities) to
17
+
"\> authenticate servers. This library exposes this list so that it can be
18
+
"\> registered with ocaml-tls.
19
+
)
20
+
; tags are not included before (lang dune 2.0)
21
+
; so an opam template is necessary until then
22
+
(tags (org:mirage)))
+24
lib/ca_certs.ml
+24
lib/ca_certs.ml
···
1
+
(*
2
+
"/etc/ssl/certs/ca-certificates.crt" (* Debian/Ubuntu/Gentoo etc.*);
3
+
(* "/etc/pki/tls/certs/ca-bundle.crt", // Fedora/RHEL 6*)
4
+
(* "/etc/ssl/ca-bundle.pem", // OpenSUSE*)
5
+
(* "/etc/pki/tls/cacert.pem", // OpenELEC*)
6
+
"/etc/pki/ca-trust/extracted/pem/tls-ca-bundle.pem" (* CentOS/RHEL 7*);
7
+
(* "/etc/ssl/cert.pem", // Alpine Linux*)
8
+
*)
9
+
10
+
let rec detect_list =
11
+
let open Lwt in
12
+
function
13
+
| [] -> return_none
14
+
| path :: paths ->
15
+
Lwt_unix.file_exists path >>= fun exists ->
16
+
if exists then return_some (`Ca_file path) else detect_list paths
17
+
18
+
let locations =
19
+
[
20
+
"/etc/ssl/certs/ca-certificates.crt";
21
+
"/etc/pki/ca-trust/extracted/pem/tls-ca-bundle.pem";
22
+
]
23
+
24
+
let detect () = detect_list locations
+4
lib/ca_certs.mli
+4
lib/ca_certs.mli
+4
lib/dune
+4
lib/dune
+17
test/e2e/dune
+17
test/e2e/dune
···
1
+
(executable
2
+
(name test_e2e)
3
+
(libraries ca_certs tls.lwt lwt.unix))
4
+
5
+
(alias
6
+
(name runtest)
7
+
(deps ./test_e2e.exe))
8
+
9
+
(alias
10
+
(name runtest-e2e)
11
+
(action
12
+
(diff test_e2e.expected test_e2e.output)))
13
+
14
+
(rule
15
+
(with-stdout-to
16
+
test_e2e.output
17
+
(run ./test_e2e.exe)))
+6
test/e2e/test_e2e.expected
+6
test/e2e/test_e2e.expected
···
1
+
google.com -> Accepted
2
+
self-signed.badssl.com -> Authentication failure: invalid certificate chain
3
+
expired.badssl.com -> Authentication failure (leaf: expired)
4
+
untrusted-root.badssl.com -> Authentication failure: invalid certificate chain
5
+
revoked.badssl.com -> Authentication failure (leaf: expired)
6
+
extended-validation.badssl.com -> Accepted
+64
test/e2e/test_e2e.ml
+64
test/e2e/test_e2e.ml
···
1
+
type result =
2
+
| Accepted
3
+
| Unknown_exception of exn
4
+
| Authentication_failure of X509.Validation.validation_error
5
+
6
+
let pp_leaf_validation_error ppf = function
7
+
| `LeafCertificateExpired _ -> Format.fprintf ppf "expired"
8
+
| `LeafInvalidName _ -> Format.fprintf ppf "invalid name"
9
+
| `LeafInvalidVersion _ -> Format.fprintf ppf "invalid version"
10
+
| `LeafInvalidExtensions _ -> Format.fprintf ppf "invalid extensions"
11
+
12
+
let pp_result ppf = function
13
+
| Accepted -> Format.pp_print_string ppf "Accepted"
14
+
| Unknown_exception e ->
15
+
Format.fprintf ppf "Unknown_exception: %s" (Printexc.to_string e)
16
+
| Authentication_failure (`Leaf e) ->
17
+
Format.fprintf ppf "Authentication failure (leaf: %a)"
18
+
pp_leaf_validation_error e
19
+
| Authentication_failure e ->
20
+
Format.fprintf ppf "Authentication failure: %a"
21
+
X509.Validation.pp_validation_error e
22
+
23
+
let to_authenticator_param = function
24
+
| Some x -> x
25
+
| None ->
26
+
print_endline "defaulting to null auth";
27
+
`No_authentication_I'M_STUPID
28
+
29
+
let make_client () =
30
+
let open Lwt in
31
+
Ca_certs.detect () >>= fun r ->
32
+
to_authenticator_param r |> X509_lwt.authenticator >|= fun authenticator ->
33
+
Tls.Config.client ~authenticator ()
34
+
35
+
let connect client host =
36
+
let open Lwt in
37
+
let create () = Tls_lwt.Unix.connect client (host, 443) in
38
+
let act tls = Tls_lwt.Unix.close tls >|= fun () -> Accepted in
39
+
let on_exn = function
40
+
| Tls_lwt.Tls_failure (`Error (`AuthenticationFailure f)) ->
41
+
return (Authentication_failure f)
42
+
| e -> return (Unknown_exception e)
43
+
in
44
+
Lwt.try_bind create act on_exn
45
+
46
+
let test client host =
47
+
let open Lwt in
48
+
connect client host >|= fun result ->
49
+
Format.printf "%s -> %a\n" host pp_result result
50
+
51
+
let main () =
52
+
let open Lwt in
53
+
make_client () >>= fun client ->
54
+
Lwt_list.iter_s (test client)
55
+
[
56
+
"google.com";
57
+
"self-signed.badssl.com";
58
+
"expired.badssl.com";
59
+
"untrusted-root.badssl.com";
60
+
"revoked.badssl.com";
61
+
"extended-validation.badssl.com";
62
+
]
63
+
64
+
let () = Lwt_main.run (main ())
test/e2e/test_e2e.mli
test/e2e/test_e2e.mli
This is a binary file and will not be displayed.