Add more tests
continuous-integration/drone/push Build is passing
Details
continuous-integration/drone/push Build is passing
Details
This commit is contained in:
parent
5b6433ca55
commit
80299f086b
94
test/test.ml
94
test/test.ml
|
@ -4,38 +4,116 @@ let csr_privkey =
|
||||||
lazy
|
lazy
|
||||||
(`RSA (Mirage_crypto_pk.Rsa.generate ~bits:1024 ()))
|
(`RSA (Mirage_crypto_pk.Rsa.generate ~bits:1024 ()))
|
||||||
|
|
||||||
|
let ca_privkey =
|
||||||
|
lazy
|
||||||
|
(`RSA (Mirage_crypto_pk.Rsa.generate ~bits:1024 ()))
|
||||||
|
|
||||||
let dn_of_name name =
|
let dn_of_name name =
|
||||||
[X509.(Distinguished_name.Relative_distinguished_name.singleton
|
[X509.(Distinguished_name.Relative_distinguished_name.singleton
|
||||||
(CN name))]
|
(CN name))]
|
||||||
|
|
||||||
let csr name =
|
let ca_cert =
|
||||||
|
let gen_ca () =
|
||||||
|
let valid_from = Ptime_clock.now () in
|
||||||
|
let valid_until =
|
||||||
|
Ptime.add_span valid_from
|
||||||
|
(Ptime.Span.of_int_s 60)
|
||||||
|
|> Option.get
|
||||||
|
in
|
||||||
|
let subject = dn_of_name "Bad Authority, Inc." in
|
||||||
|
let extensions =
|
||||||
|
let open X509.Extension in
|
||||||
|
empty
|
||||||
|
|> add Key_usage
|
||||||
|
(true, [`Key_cert_sign; `CRL_sign; `Digital_signature; `Content_commitment])
|
||||||
|
|> add Basic_constraints (true, (true, None))
|
||||||
|
in
|
||||||
|
let csr =
|
||||||
|
X509.Signing_request.create
|
||||||
|
subject
|
||||||
|
(Lazy.force ca_privkey)
|
||||||
|
in
|
||||||
|
X509.Signing_request.sign
|
||||||
|
csr
|
||||||
|
~valid_from
|
||||||
|
~valid_until
|
||||||
|
~extensions
|
||||||
|
(Lazy.force ca_privkey)
|
||||||
|
subject
|
||||||
|
in
|
||||||
|
lazy (Result.get_ok (gen_ca ()))
|
||||||
|
|
||||||
|
let csr subject =
|
||||||
X509.Signing_request.create
|
X509.Signing_request.create
|
||||||
(dn_of_name name)
|
subject
|
||||||
(Lazy.force csr_privkey)
|
(Lazy.force csr_privkey)
|
||||||
|
|
||||||
let check_csr_dn_good () =
|
let check_csr_dn_good () =
|
||||||
let name = "reynir" in
|
let name = "reynir" in
|
||||||
let csr = csr name in
|
let csr = csr (dn_of_name name) in
|
||||||
Alcotest.(check @@ result unit Alcotest.reject)
|
Alcotest.(check @@ result unit Alcotest.reject)
|
||||||
"good dn in csr"
|
"good dn in csr"
|
||||||
(Ok ())
|
(Ok ())
|
||||||
(Cert_service.check_csr_dn
|
(Cert_service.check_csr_dn
|
||||||
csr name)
|
csr name)
|
||||||
|
|
||||||
let check_csr_dn_different () =
|
let check_csr_dn_different () =
|
||||||
let name = "reynir" in
|
let name = "reynir" in
|
||||||
let csr = csr name in
|
let csr = csr (dn_of_name name) in
|
||||||
match Cert_service.check_csr_dn csr "notreynir" with
|
match Cert_service.check_csr_dn csr "notreynir" with
|
||||||
| Ok () -> Alcotest.fail "check succeeded, expected failure"
|
| Ok () -> Alcotest.fail "check succeeded, expected failure"
|
||||||
| Error (`Msg _) -> ()
|
| Error (`Msg _) -> ()
|
||||||
|
|
||||||
let cert_tests = [
|
let check_csr_dn_extra () =
|
||||||
|
let name = "reynir" in
|
||||||
|
let csr = csr (dn_of_name name @ dn_of_name "bob") in
|
||||||
|
match Cert_service.check_csr_dn csr "notreynir" with
|
||||||
|
| Ok () -> Alcotest.fail "check succeeded, expected failure"
|
||||||
|
| Error (`Msg _) -> ()
|
||||||
|
|
||||||
|
let check_csr_tests = [
|
||||||
"check_csr_dn_good", `Quick, check_csr_dn_good;
|
"check_csr_dn_good", `Quick, check_csr_dn_good;
|
||||||
"check_csr_dn_different", `Quick, check_csr_dn_different;
|
"check_csr_dn_different", `Quick, check_csr_dn_different;
|
||||||
|
"check_csr_dn_extra", `Quick, check_csr_dn_extra;
|
||||||
|
]
|
||||||
|
|
||||||
|
let good_sign () =
|
||||||
|
let t = {
|
||||||
|
Cert_service.host = "example.com";
|
||||||
|
cacert = Lazy.force ca_cert;
|
||||||
|
cakey = Lazy.force ca_privkey;
|
||||||
|
}
|
||||||
|
in
|
||||||
|
let name = "reynir" in
|
||||||
|
let csr = csr (dn_of_name name) in
|
||||||
|
match Cert_service.sign t csr name with
|
||||||
|
| Ok _cert -> ()
|
||||||
|
| Error (`Msg e) -> Alcotest.failf "cert sign failed unexpectedly: %s" e
|
||||||
|
|
||||||
|
let bad_sign () =
|
||||||
|
let t = {
|
||||||
|
Cert_service.host = "example.com";
|
||||||
|
cacert = Lazy.force ca_cert;
|
||||||
|
cakey = Lazy.force ca_privkey;
|
||||||
|
}
|
||||||
|
in
|
||||||
|
let name = "reynir" in
|
||||||
|
let csr = csr (dn_of_name name) in
|
||||||
|
match Cert_service.sign t csr "notreynir" with
|
||||||
|
| Ok cert ->
|
||||||
|
Alcotest.failf
|
||||||
|
"cert sign succeeded unexpectedly:\n%a" X509.Certificate.pp
|
||||||
|
cert
|
||||||
|
| Error (`Msg _) -> ()
|
||||||
|
|
||||||
|
let cert_tests = [
|
||||||
|
"good_sign", `Slow, good_sign;
|
||||||
|
"bad_sign", `Slow, bad_sign;
|
||||||
]
|
]
|
||||||
|
|
||||||
let tests : unit Alcotest.test list= [
|
let tests : unit Alcotest.test list= [
|
||||||
"check_csr_dn", cert_tests
|
"check_csr_dn", check_csr_tests;
|
||||||
|
"cert_tests", cert_tests;
|
||||||
]
|
]
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
|
|
Loading…
Reference in New Issue