Also fix a test.
This commit is contained in:
parent
e73145d054
commit
ff5773a47b
|
@ -3,9 +3,13 @@ open Lwt.Syntax
|
|||
let sock_path = "/home/reynir/cert.sock"
|
||||
let version = `V1
|
||||
|
||||
let organization = "HashBang"
|
||||
|
||||
let csr user =
|
||||
let dn =
|
||||
X509.Distinguished_name.(Relative_distinguished_name.singleton (CN user)) in
|
||||
X509.Distinguished_name.(
|
||||
Relative_distinguished_name.singleton (CN user)
|
||||
|> Relative_distinguished_name.add (O organization)) in
|
||||
let key : X509.Private_key.t =
|
||||
`RSA (Mirage_crypto_pk.Rsa.generate ~bits:2048 ()) in
|
||||
let csr = X509.Signing_request.create [dn] key in
|
||||
|
|
|
@ -38,7 +38,8 @@ let main () =
|
|||
Mirage_crypto_rng_lwt.initialize ();
|
||||
let cacert = Rresult.R.get_ok (load_cacert (Fpath.v cacert_path)) in
|
||||
let cakey = Rresult.R.get_ok (load_cakey (Fpath.v cakey_path)) in
|
||||
let t = { Cert_service.host = "hashbang.sh"; cacert; cakey } in
|
||||
let t = { Cert_service.host = "hashbang.sh";
|
||||
organization = "HashBang"; cacert; cakey } in
|
||||
let server_fd = Lwt_unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
|
||||
let old_umask = Unix.umask 0o011 in
|
||||
let () = try Unix.unlink sock_path
|
||||
|
|
|
@ -8,22 +8,27 @@ let wire_to_cstruct = Wire_asn.wire_to_cstruct
|
|||
|
||||
type t = {
|
||||
host : string;
|
||||
organization : string;
|
||||
cacert : X509.Certificate.t;
|
||||
cakey : X509.Private_key.t;
|
||||
}
|
||||
|
||||
let check_csr_dn csr user =
|
||||
let subject =
|
||||
[X509.Distinguished_name.(Relative_distinguished_name.singleton (CN user))] in
|
||||
let check_csr_dn csr dn =
|
||||
if X509.Distinguished_name.equal
|
||||
subject
|
||||
dn
|
||||
(X509.Signing_request.info csr).subject
|
||||
then Ok ()
|
||||
else R.error_msgf "Bad subject in csr: %a"
|
||||
X509.Distinguished_name.pp (X509.Signing_request.info csr).subject
|
||||
|
||||
let sign t csr user =
|
||||
check_csr_dn csr user >>= fun () ->
|
||||
let subject =
|
||||
[X509.Distinguished_name.(
|
||||
Relative_distinguished_name.singleton (CN user)
|
||||
|> Relative_distinguished_name.add (O t.organization)
|
||||
)]
|
||||
in
|
||||
check_csr_dn csr subject >>= fun () ->
|
||||
let issuer = X509.Certificate.subject t.cacert in
|
||||
let email = Printf.sprintf "%s@%s" user t.host in
|
||||
let valid_from = Ptime_clock.now () in
|
||||
|
|
37
test/test.ml
37
test/test.ml
|
@ -8,9 +8,12 @@ let ca_privkey =
|
|||
lazy
|
||||
(`RSA (Mirage_crypto_pk.Rsa.generate ~bits:1024 ()))
|
||||
|
||||
let dn_of_name name =
|
||||
[X509.(Distinguished_name.Relative_distinguished_name.singleton
|
||||
(CN name))]
|
||||
let organization = "Free Shell Servers, Inc."
|
||||
|
||||
let dn_of_name ?(organization=organization) name =
|
||||
let open X509.Distinguished_name in
|
||||
let open Relative_distinguished_name in
|
||||
[ singleton (CN name) |> add (O organization) ]
|
||||
|
||||
let ca_cert =
|
||||
let gen_ca () =
|
||||
|
@ -49,37 +52,46 @@ let csr subject =
|
|||
(Lazy.force csr_privkey)
|
||||
|
||||
let check_csr_dn_good () =
|
||||
let name = "reynir" in
|
||||
let csr = csr (dn_of_name name) in
|
||||
let subject = dn_of_name "reynir" in
|
||||
let csr = csr subject in
|
||||
Alcotest.(check @@ result unit Alcotest.reject)
|
||||
"good dn in csr"
|
||||
(Ok ())
|
||||
(Cert_service.check_csr_dn
|
||||
csr name)
|
||||
csr subject)
|
||||
|
||||
let check_csr_dn_different () =
|
||||
let name = "reynir" in
|
||||
let csr = csr (dn_of_name name) in
|
||||
match Cert_service.check_csr_dn csr "notreynir" with
|
||||
let subject = dn_of_name "reynir" in
|
||||
let csr = csr subject in
|
||||
match Cert_service.check_csr_dn csr (dn_of_name "notreynir") with
|
||||
| Ok () -> Alcotest.fail "check succeeded, expected failure"
|
||||
| Error (`Msg _) -> ()
|
||||
|
||||
let check_csr_dn_diff_org () =
|
||||
let subject = dn_of_name ~organization:"Evil Corp" "reynir" in
|
||||
let csr = csr subject in
|
||||
match Cert_service.check_csr_dn csr (dn_of_name "reynir") with
|
||||
| Ok () -> Alcotest.fail "check succeeded, expected failure"
|
||||
| Error (`Msg _) -> ()
|
||||
|
||||
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
|
||||
let subject = dn_of_name "reynir" in
|
||||
let csr = csr (subject @ dn_of_name "bob") in
|
||||
match Cert_service.check_csr_dn csr (dn_of_name "reynir") 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_different", `Quick, check_csr_dn_different;
|
||||
"check_csr_dn_diff_org", `Quick, check_csr_dn_diff_org;
|
||||
"check_csr_dn_extra", `Quick, check_csr_dn_extra;
|
||||
]
|
||||
|
||||
let good_sign () =
|
||||
let t = {
|
||||
Cert_service.host = "example.com";
|
||||
organization;
|
||||
cacert = Lazy.force ca_cert;
|
||||
cakey = Lazy.force ca_privkey;
|
||||
}
|
||||
|
@ -93,6 +105,7 @@ let good_sign () =
|
|||
let bad_sign () =
|
||||
let t = {
|
||||
Cert_service.host = "example.com";
|
||||
organization;
|
||||
cacert = Lazy.force ca_cert;
|
||||
cakey = Lazy.force ca_privkey;
|
||||
}
|
||||
|
|
Loading…
Reference in a new issue