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