This commit is contained in:
parent
aa2ff7b2f0
commit
2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
327
unikernel/duniverse/ocaml-x509/tests/x509tests.ml
Normal file
327
unikernel/duniverse/ocaml-x509/tests/x509tests.ml
Normal file
|
|
@ -0,0 +1,327 @@
|
|||
open X509
|
||||
|
||||
let time () = None
|
||||
|
||||
let with_loaded_file file ~f =
|
||||
let fullpath = "./testcertificates/" ^ file ^ ".pem" in
|
||||
let fd = open_in fullpath in
|
||||
let ln = in_channel_length fd in
|
||||
let buf = Bytes.create ln in
|
||||
really_input fd buf 0 ln;
|
||||
let buf = Bytes.unsafe_to_string buf in
|
||||
try
|
||||
let r = f buf in
|
||||
close_in fd;
|
||||
match r with
|
||||
| Ok data -> data
|
||||
| Error (`Msg m) -> Alcotest.failf "decoding error in %s: %s" fullpath m
|
||||
with e ->
|
||||
close_in fd;
|
||||
Alcotest.failf "exception in %s: %s" fullpath (Printexc.to_string e)
|
||||
|
||||
let priv =
|
||||
match with_loaded_file "private/cakey" ~f:Private_key.decode_pem with
|
||||
| `RSA x -> x
|
||||
| _ -> assert false
|
||||
|
||||
let cert name = with_loaded_file name ~f:Certificate.decode_pem
|
||||
|
||||
let host name = Domain_name.host_exn (Domain_name.of_string_exn name)
|
||||
|
||||
let invalid_cas = [
|
||||
"cacert-basicconstraint-ca-false";
|
||||
"cacert-unknown-critical-extension" ;
|
||||
"cacert-keyusage-crlsign" ;
|
||||
"cacert-ext-usage-timestamping"
|
||||
]
|
||||
|
||||
let cert_public_is_pub cert =
|
||||
let pub = Mirage_crypto_pk.Rsa.pub_of_priv priv in
|
||||
( match Certificate.public_key cert with
|
||||
| `RSA pub' when pub = pub' -> ()
|
||||
| _ -> Alcotest.fail "public / private key doesn't match" )
|
||||
|
||||
let test_invalid_ca name () =
|
||||
let c = cert name in
|
||||
cert_public_is_pub c ;
|
||||
Alcotest.(check int "CA list is empty" 0
|
||||
(List.length (Validation.valid_cas [c])))
|
||||
|
||||
let invalid_ca_tests =
|
||||
List.mapi
|
||||
(fun i args -> "invalid CA " ^ string_of_int i, `Quick, test_invalid_ca args)
|
||||
invalid_cas
|
||||
|
||||
let cacert = cert "cacert"
|
||||
let cacert_pathlen0 = cert "cacert-pathlen-0"
|
||||
let cacert_ext = cert "cacert-unknown-extension"
|
||||
let cacert_ext_ku = cert "cacert-ext-usage"
|
||||
let cacert_v1 = cert "cacert-v1"
|
||||
|
||||
let test_valid_ca c () =
|
||||
cert_public_is_pub c ;
|
||||
Alcotest.(check int "CA is valid" 1
|
||||
(List.length (Validation.valid_cas [c])))
|
||||
|
||||
let valid_ca_tests = [
|
||||
"valid CA cacert", `Quick, test_valid_ca cacert ;
|
||||
"valid CA cacert_pathlen0", `Quick, test_valid_ca cacert_pathlen0 ;
|
||||
"valid CA cacert_ext", `Quick, test_valid_ca cacert_ext ;
|
||||
"valid CA cacert_v1", `Quick, test_valid_ca cacert_v1
|
||||
]
|
||||
|
||||
let first_cert name =
|
||||
with_loaded_file ("first/" ^ name) ~f:Certificate.decode_pem
|
||||
|
||||
(* ok, now some real certificates *)
|
||||
let first_certs = [
|
||||
( "first", true,
|
||||
[ "foo.foobar.com" ; "foobar.com" ], (* commonName: "bar.foobar.com" *)
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], None ) ;
|
||||
( "first-basicconstraint-true" , false, [ "ca.foobar.com" ], (* no subjAltName *)
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], None ) ;
|
||||
( "first-keyusage-and-timestamping", true, [ "ext.foobar.com" ], (* no subjAltName *)
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], Some [`Time_stamping] ) ;
|
||||
( "first-keyusage-any", true, [ "any.foobar.com" ], (* no subjAltName *)
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], Some [`Time_stamping; `Any] ) ;
|
||||
( "first-keyusage-nonrep", true, [ "key.foobar.com" ], (* no subjAltName *)
|
||||
[ `Content_commitment ], None ) ;
|
||||
( "first-unknown-critical-extension", false, (* commonName: "blafasel.com" *)
|
||||
[ "foo.foobar.com" ; "foobar.com" ],
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], None ) ;
|
||||
( "first-unknown-extension", true, [ "foobar.com" ], (* no subjAltName *)
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], None ) ;
|
||||
]
|
||||
|
||||
let allowed_hashes = [ `MD5 ; `SHA1 ; `SHA224 ; `SHA256 ; `SHA384 ; `SHA512 ]
|
||||
|
||||
let test_valid_ca_cert ?(allowed_hashes = allowed_hashes) server chain valid name ca () =
|
||||
let anchors = ca
|
||||
and host = Some (host name)
|
||||
and full_chain = server :: chain
|
||||
in
|
||||
match valid, Validation.verify_chain_of_trust ~time ~allowed_hashes ~host ~anchors full_chain with
|
||||
| false, Ok _ -> Alcotest.fail "expected to fail, but didn't"
|
||||
| false, Error _ -> ()
|
||||
| true , Ok _ -> ()
|
||||
| true , Error c -> Alcotest.failf "valid certificate %a" Validation.pp_validation_error c
|
||||
|
||||
let test_cert c usages extusage () =
|
||||
let ku, eku =
|
||||
let exts = Certificate.extensions c in
|
||||
let ku = match Extension.(find Key_usage exts) with
|
||||
| None -> []
|
||||
| Some (_crit, ku) -> ku
|
||||
and eku = match Extension.(find Ext_key_usage exts) with
|
||||
| None -> []
|
||||
| Some (_crit, eku) -> eku
|
||||
in
|
||||
ku, eku
|
||||
in
|
||||
( if List.for_all (fun u -> List.mem u ku) usages then
|
||||
()
|
||||
else
|
||||
Alcotest.fail "key usage is different" ) ;
|
||||
( match extusage with
|
||||
| None -> ()
|
||||
| Some x when List.for_all (fun u -> List.mem u eku) x -> ()
|
||||
| _ -> Alcotest.fail "extended key usage is broken" )
|
||||
|
||||
let first_cert_tests =
|
||||
List.mapi
|
||||
(fun i (name, _, _, us, eus) ->
|
||||
"certificate property testing " ^ string_of_int i, `Quick,
|
||||
test_cert (first_cert name) us eus)
|
||||
first_certs
|
||||
|
||||
let first_cert_ca_test (ca, x) =
|
||||
List.flatten
|
||||
(List.map
|
||||
(fun (name, valid, cns, _, _) ->
|
||||
let c = first_cert name in
|
||||
("verification CA " ^ x ^ " cn blablbalbala", `Quick, test_valid_ca_cert c [] false "blablabalbal" [ca]) ::
|
||||
List.mapi (fun i cn ->
|
||||
"certificate verification testing using CA " ^ x ^ " and CN " ^ cn ^ " " ^ string_of_int i,
|
||||
`Quick, test_valid_ca_cert c [] valid cn [ca])
|
||||
cns)
|
||||
first_certs)
|
||||
|
||||
let ca_tests f =
|
||||
List.flatten (List.map f
|
||||
[ (cacert, "cacert") ;
|
||||
(cacert_pathlen0, "cacert_pathlen0") ;
|
||||
(cacert_ext, "cacert_ext") ;
|
||||
(cacert_ext_ku, "cacert_ext_ku") ;
|
||||
(cacert_v1, "cacert_v1") ])
|
||||
|
||||
let first_wildcard_certs = [
|
||||
( "first-wildcard-subjaltname",
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], None ) ;
|
||||
( "first-wildcard",
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], None ) ;
|
||||
]
|
||||
|
||||
let first_wildcard_cert_tests =
|
||||
List.mapi
|
||||
(fun i (name, us, eus) ->
|
||||
"wildcard certificate property testing " ^ string_of_int i, `Quick, test_cert (first_cert name) us eus)
|
||||
first_wildcard_certs
|
||||
|
||||
let first_wildcard_cert_ca_test (ca, x) =
|
||||
List.flatten
|
||||
(List.map
|
||||
(fun (name, _, _) ->
|
||||
let c = first_cert name in
|
||||
("verification CA " ^ x ^ " cn blablbalbala", `Quick, test_valid_ca_cert c [] false "blablabalbal" [ca]) ::
|
||||
List.mapi (fun i cn ->
|
||||
"wildcard certificate CA " ^ x ^ " and CN " ^ cn ^ " " ^ string_of_int i,
|
||||
`Quick, test_valid_ca_cert c [] true cn [ca])
|
||||
[ "foo.foobar.com" ; "bar.foobar.com" ; "www.foobar.com" ] @
|
||||
List.mapi (fun i cn ->
|
||||
"wildcard certificate CA " ^ x ^ " and CN " ^ cn ^ " " ^ string_of_int i,
|
||||
`Quick, test_valid_ca_cert c [] false cn [ca])
|
||||
[ "foo.foo.foobar.com" ; "bar.fbar.com" ; "foobar.com" ; "com" ; "foobar.com.bla" ]
|
||||
)
|
||||
first_wildcard_certs)
|
||||
|
||||
let intermediate_cas = [
|
||||
(true, "cacert") ;
|
||||
(true, "cacert-any-ext") ;
|
||||
(false, "cacert-ba-false") ;
|
||||
(false, "cacert-no-bc") ;
|
||||
(false, "cacert-no-keyusage") ;
|
||||
(true, "cacert-ku-critical") ;
|
||||
(true, "cacert-timestamp") ; (* if we require CAs to have ext_key_usage any, github.com doesn't talk to us *)
|
||||
(false, "cacert-unknown") ;
|
||||
(false, "cacert-v1")
|
||||
]
|
||||
|
||||
let im_cert name =
|
||||
with_loaded_file ("intermediate/" ^ name) ~f:Certificate.decode_pem
|
||||
|
||||
let second_certs = [
|
||||
("second", [ "second.foobar.com" ], true, (* no subjAltName *)
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], None ) ;
|
||||
("second-any", [ "second.foobar.com" ], true, (* no subjAltName *)
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], Some [ `Any ] ) ;
|
||||
("second-subj", [ "foobar.com" ; "foo.foobar.com" ], true, (* commonName: "second.foobar.com" *)
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], None ) ;
|
||||
("second-unknown-noncrit", [ "second.foobar.com" ], true, (* no subjAltName *)
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], None ) ;
|
||||
("second-nonrepud", [ "second.foobar.com" ], true, (* no subjAltName *)
|
||||
[ `Content_commitment ], None ) ;
|
||||
("second-time", [ "second.foobar.com" ], true, (* no subjAltName *)
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], Some [ `Time_stamping ]) ;
|
||||
("second-subj-wild", [ "foo.foobar.com" ], true, (* commonName: "second.foobar.com" *)
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], None ) ;
|
||||
("second-bc-true", [ "second.foobar.com" ], false, (* no subjAltName *)
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], None ) ;
|
||||
("second-unknown", [ "second.foobar.com" ], false, (* no subjAltName *)
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], None ) ;
|
||||
("second-no-cn", [ ], false, (* no subjAltName *)
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], None ) ;
|
||||
("second-subjaltemail", [ ], false, (* email in subjAltName, do not use CN *)
|
||||
[ `Digital_signature ; `Content_commitment ; `Key_encipherment ], None ) ;
|
||||
]
|
||||
|
||||
let second_cert name =
|
||||
with_loaded_file ("intermediate/second/" ^ name) ~f:Certificate.decode_pem
|
||||
|
||||
let second_cert_tests =
|
||||
List.mapi
|
||||
(fun i (name, _, _, us, eus) ->
|
||||
"second certificate property testing " ^ string_of_int i, `Quick, test_cert (second_cert name) us eus)
|
||||
second_certs
|
||||
|
||||
let second_cert_ca_test (cavalid, ca, x) =
|
||||
List.flatten
|
||||
(List.flatten
|
||||
(List.map
|
||||
(fun (imvalid, im) ->
|
||||
let chain = [im_cert im] in
|
||||
List.map
|
||||
(fun (name, cns, valid, _, _) ->
|
||||
let c = second_cert name in
|
||||
("verification CA " ^ x ^ " cn blablbalbala", `Quick, test_valid_ca_cert c chain false "blablabalbal" [ca]) ::
|
||||
List.mapi (fun i cn ->
|
||||
"strict certificate verification testing using CA " ^ x ^ " and CN " ^ cn ^ " " ^ string_of_int i,
|
||||
`Quick, test_valid_ca_cert c chain (cavalid && imvalid && valid) cn [ca])
|
||||
cns)
|
||||
second_certs)
|
||||
intermediate_cas))
|
||||
|
||||
let im_ca_tests f =
|
||||
List.flatten (List.map f
|
||||
[ (true, cacert, "cacert") ;
|
||||
(true, cacert_ext, "cacert_ext") ;
|
||||
(true, cacert_ext_ku, "cacert_ext_ku") ;
|
||||
(true, cacert_v1, "cacert_v1") ;
|
||||
(false, cacert_pathlen0, "cacert_pathlen0") ])
|
||||
|
||||
let second_wildcard_cert_ca_test (cavalid, ca, x) =
|
||||
List.flatten
|
||||
(List.map
|
||||
(fun (imvalid, im) ->
|
||||
let chain = [im_cert im] in
|
||||
let c = second_cert "second-subj-wild" in
|
||||
("verification CA " ^ x ^ " cn blablbalbala", `Quick, test_valid_ca_cert c chain false "blablabalbal" [ca]) ::
|
||||
List.mapi (fun i cn ->
|
||||
"wildcard certificate verification CA " ^ x ^ " and CN " ^ cn ^ " " ^ string_of_int i,
|
||||
`Quick, test_valid_ca_cert c chain (cavalid && imvalid) cn [ca])
|
||||
[ "a.foobar.com" ; "foo.foobar.com" ; "foobar.foobar.com" ; "www.foobar.com" ] @
|
||||
List.mapi (fun i cn ->
|
||||
"wildcard certificate verification CA " ^ x ^ " and CN " ^ cn ^ " " ^ string_of_int i,
|
||||
`Quick, test_valid_ca_cert c chain false cn [ca])
|
||||
[ "a.b.foobar.com" ; "f.foobar.com.com" ; "f.f.f." ; "foobar.com.uk" ; "foooo.bar.com" ; "foobar.com" ])
|
||||
intermediate_cas)
|
||||
|
||||
let second_no_cn_cert_ca_test (_, ca, x) =
|
||||
List.flatten
|
||||
(List.map
|
||||
(fun (_, im) ->
|
||||
let chain = [im_cert im] in
|
||||
let c = second_cert "second-no-cn" in
|
||||
("verification CA " ^ x ^ " cn blablbalbala", `Quick, test_valid_ca_cert c chain false "blablabalbal" [ca]) ::
|
||||
List.mapi (fun i cn ->
|
||||
"certificate verification CA " ^ x ^ " and CN " ^ cn ^ " " ^ string_of_int i,
|
||||
`Quick, test_valid_ca_cert c chain false cn [ca])
|
||||
[ "a.foobar.com" ; "foo.foobar.com" ; "foobar.foobar.com" ; "foobar.com" ; "www.foobar.com" ] @
|
||||
List.mapi (fun i cn ->
|
||||
"certificate verification CA " ^ x ^ " and CN " ^ cn ^ " " ^ string_of_int i,
|
||||
`Quick, test_valid_ca_cert c chain false cn [ca])
|
||||
[ "a.b.foobar.com" ; "f.foobar.com.com" ; "f.f.f." ; "foobar.com.uk" ; "foooo.bar.com" ])
|
||||
intermediate_cas)
|
||||
|
||||
let invalid_tests =
|
||||
let c = second_cert "second" in
|
||||
let h = "second.foobar.com" in
|
||||
let allowed_hashes = [ `SHA256 ; `SHA384 ; `SHA512 ] in
|
||||
[
|
||||
"invalid chain", `Quick, test_valid_ca_cert c [] false h [cacert] ;
|
||||
"broken chain", `Quick, test_valid_ca_cert c [cacert] false h [cacert] ;
|
||||
"no trust anchor", `Quick, test_valid_ca_cert c [im_cert "cacert"] false h [] ;
|
||||
"2chain invalid", `Quick, test_valid_ca_cert ~allowed_hashes c [im_cert "cacert" ; cacert] false h [cacert] ;
|
||||
"2chain valid", `Quick, test_valid_ca_cert c [im_cert "cacert" ; cacert] true h [cacert] ;
|
||||
"3chain invalid", `Quick, test_valid_ca_cert ~allowed_hashes c [im_cert "cacert" ; cacert ; cacert] false h [cacert] ;
|
||||
"3chain valid", `Quick, test_valid_ca_cert c [im_cert "cacert" ; cacert ; cacert] true h [cacert] ;
|
||||
"chain-order invalid", `Quick, test_valid_ca_cert ~allowed_hashes c [im_cert "cacert" ; im_cert "cacert" ; cacert] false h [cacert] ;
|
||||
"chain-order valid", `Quick, test_valid_ca_cert c [im_cert "cacert" ; im_cert "cacert" ; cacert] true h [cacert] ;
|
||||
"not a CA", `Quick, (fun _ -> Alcotest.(check int "is not a CA" 0
|
||||
(List.length (Validation.valid_cas [im_cert "cacert"])))) ;
|
||||
"not a CA", `Quick, (fun _ -> Alcotest.(check int "is also not a CA" 0
|
||||
(List.length (Validation.valid_cas [c])))) ;
|
||||
]
|
||||
|
||||
let x509_tests = [
|
||||
"Invalid CA", invalid_ca_tests ;
|
||||
"Valid CA", valid_ca_tests ;
|
||||
"Certificate", first_cert_tests ;
|
||||
"CA tests with certificate", ca_tests first_cert_ca_test ;
|
||||
"Wildcard certificate", first_wildcard_cert_tests ;
|
||||
"CA tests with wildcard certificate", ca_tests first_wildcard_cert_ca_test ;
|
||||
"Second certificate test", second_cert_tests ;
|
||||
"Intermediate CA with second certificate", im_ca_tests second_cert_ca_test ;
|
||||
"Intermediate CA with CA and second", im_ca_tests second_wildcard_cert_ca_test ;
|
||||
"Intermediate CA with second no common name", im_ca_tests second_no_cn_cert_ca_test ;
|
||||
"Tests with invalid data", invalid_tests
|
||||
]
|
||||
Loading…
Add table
Add a link
Reference in a new issue