This commit is contained in:
parent
abd3d591f2
commit
8601e4b137
|
@ -22,6 +22,10 @@ let main () =
|
||||||
let fd = Lwt_unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
|
let fd = Lwt_unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
|
||||||
let* () = Lwt_unix.connect fd (Unix.ADDR_UNIX sock_path) in
|
let* () = Lwt_unix.connect fd (Unix.ADDR_UNIX sock_path) in
|
||||||
let key, csr = csr user.pw_name in
|
let key, csr = csr user.pw_name in
|
||||||
|
let csr =
|
||||||
|
Result.fold csr ~ok:Fun.id
|
||||||
|
~error:(fun (`Msg e) -> Fmt.kstr failwith "CSR error: %s" e)
|
||||||
|
in
|
||||||
let* r = Cert_service.Wire_lwt.write_wire fd
|
let* r = Cert_service.Wire_lwt.write_wire fd
|
||||||
({ version }, `Command (`Sign_request csr)) in
|
({ version }, `Command (`Sign_request csr)) in
|
||||||
let* () =
|
let* () =
|
||||||
|
|
|
@ -25,19 +25,19 @@ let handler t _sockaddr fd =
|
||||||
()
|
()
|
||||||
|
|
||||||
let load_cacert f =
|
let load_cacert f =
|
||||||
Rresult.R.bind
|
Result.bind
|
||||||
(Bos.OS.File.read f)
|
(Bos.OS.File.read f)
|
||||||
(fun s -> X509.Certificate.decode_pem (Cstruct.of_string s))
|
(fun s -> X509.Certificate.decode_pem (Cstruct.of_string s))
|
||||||
|
|
||||||
let load_cakey f =
|
let load_cakey f =
|
||||||
Rresult.R.bind
|
Result.bind
|
||||||
(Bos.OS.File.read f)
|
(Bos.OS.File.read f)
|
||||||
(fun s -> X509.Private_key.decode_pem (Cstruct.of_string s))
|
(fun s -> X509.Private_key.decode_pem (Cstruct.of_string s))
|
||||||
|
|
||||||
let main () =
|
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 = Result.get_ok (load_cacert (Fpath.v cacert_path)) in
|
||||||
let cakey = Rresult.R.get_ok (load_cakey (Fpath.v cakey_path)) in
|
let cakey = Result.get_ok (load_cakey (Fpath.v cakey_path)) in
|
||||||
let t = { Cert_service.host = "hashbang.sh";
|
let t = { Cert_service.host = "hashbang.sh";
|
||||||
organization = "HashBang"; cacert; cakey } in
|
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
|
||||||
|
|
|
@ -1,5 +1,3 @@
|
||||||
open Rresult
|
|
||||||
|
|
||||||
module Commands = Wire_commands
|
module Commands = Wire_commands
|
||||||
module Wire_lwt = Wire_lwt
|
module Wire_lwt = Wire_lwt
|
||||||
|
|
||||||
|
@ -13,12 +11,14 @@ type t = {
|
||||||
cakey : X509.Private_key.t;
|
cakey : X509.Private_key.t;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
let ( >>= ) = Result.bind
|
||||||
|
|
||||||
let check_csr_dn csr dn =
|
let check_csr_dn csr dn =
|
||||||
let subject = (X509.Signing_request.info csr).subject in
|
let subject = (X509.Signing_request.info csr).subject in
|
||||||
if X509.Distinguished_name.equal dn subject
|
if X509.Distinguished_name.equal dn subject
|
||||||
then Ok ()
|
then Ok ()
|
||||||
else R.error_msgf "Bad subject in csr: %a"
|
else Error (`Msg (Fmt.str "Bad subject in csr: %a"
|
||||||
X509.Distinguished_name.pp subject
|
X509.Distinguished_name.pp subject))
|
||||||
|
|
||||||
let sign t csr user =
|
let sign t csr user =
|
||||||
let subject =
|
let subject =
|
||||||
|
@ -53,5 +53,5 @@ let sign t csr user =
|
||||||
~extensions
|
~extensions
|
||||||
t.cakey
|
t.cakey
|
||||||
issuer
|
issuer
|
||||||
|> R.reword_error (fun ve ->
|
|> Result.map_error (fun ve ->
|
||||||
R.msgf "Signing failed: %a" X509.Validation.pp_validation_error ve)
|
`Msg (Fmt.str "Signing failed: %a" X509.Validation.pp_signature_error ve))
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
open Rresult
|
|
||||||
open Wire_commands
|
open Wire_commands
|
||||||
|
|
||||||
let oid = Asn.OID.(base 1 3 <| 6 <| 1 <| 4 <| 1 <| 49836 <| 5171)
|
let oid = Asn.OID.(base 1 3 <| 6 <| 1 <| 4 <| 1 <| 49836 <| 5171)
|
||||||
|
@ -6,8 +5,8 @@ let oid = Asn.OID.(base 1 3 <| 6 <| 1 <| 4 <| 1 <| 49836 <| 5171)
|
||||||
let decode_strict codec cs =
|
let decode_strict codec cs =
|
||||||
match Asn.decode codec cs with
|
match Asn.decode codec cs with
|
||||||
| Ok (a, cs) ->
|
| Ok (a, cs) ->
|
||||||
if Cstruct.len cs > 0
|
if Cstruct.length cs > 0
|
||||||
then R.error_msg "trailing bytes"
|
then Error (`Msg "trailing bytes")
|
||||||
else Ok a
|
else Ok a
|
||||||
| Error (`Parse msg) -> Error (`Msg msg)
|
| Error (`Parse msg) -> Error (`Msg msg)
|
||||||
|
|
||||||
|
|
|
@ -56,6 +56,6 @@ let write_raw fd buf =
|
||||||
let write_wire fd wire =
|
let write_wire fd wire =
|
||||||
let data = Wire_asn.wire_to_cstruct wire in
|
let data = Wire_asn.wire_to_cstruct wire in
|
||||||
let dlen = Cstruct.create 4 in
|
let dlen = Cstruct.create 4 in
|
||||||
Cstruct.BE.set_uint32 dlen 0 (Int32.of_int (Cstruct.len data)) ;
|
Cstruct.BE.set_uint32 dlen 0 (Int32.of_int (Cstruct.length data)) ;
|
||||||
let buf = Cstruct.(to_bytes (append dlen data)) in
|
let buf = Cstruct.(to_bytes (append dlen data)) in
|
||||||
write_raw fd buf
|
write_raw fd buf
|
||||||
|
|
28
test/test.ml
28
test/test.ml
|
@ -36,6 +36,10 @@ let ca_cert =
|
||||||
subject
|
subject
|
||||||
(Lazy.force ca_privkey)
|
(Lazy.force ca_privkey)
|
||||||
in
|
in
|
||||||
|
let csr =
|
||||||
|
Result.fold csr ~ok:Fun.id
|
||||||
|
~error:(fun (`Msg e) -> Alcotest.failf "CSR error %s" e)
|
||||||
|
in
|
||||||
X509.Signing_request.sign
|
X509.Signing_request.sign
|
||||||
csr
|
csr
|
||||||
~valid_from
|
~valid_from
|
||||||
|
@ -54,6 +58,10 @@ let csr subject =
|
||||||
let check_csr_dn_good () =
|
let check_csr_dn_good () =
|
||||||
let subject = dn_of_name "reynir" in
|
let subject = dn_of_name "reynir" in
|
||||||
let csr = csr subject in
|
let csr = csr subject in
|
||||||
|
let csr =
|
||||||
|
Result.fold csr ~ok:Fun.id
|
||||||
|
~error:(fun (`Msg e) -> Alcotest.failf "CSR error %s" e)
|
||||||
|
in
|
||||||
Alcotest.(check @@ result unit Alcotest.reject)
|
Alcotest.(check @@ result unit Alcotest.reject)
|
||||||
"good dn in csr"
|
"good dn in csr"
|
||||||
(Ok ())
|
(Ok ())
|
||||||
|
@ -63,6 +71,10 @@ let check_csr_dn_good () =
|
||||||
let check_csr_dn_different () =
|
let check_csr_dn_different () =
|
||||||
let subject = dn_of_name "reynir" in
|
let subject = dn_of_name "reynir" in
|
||||||
let csr = csr subject in
|
let csr = csr subject in
|
||||||
|
let csr =
|
||||||
|
Result.fold csr ~ok:Fun.id
|
||||||
|
~error:(fun (`Msg e) -> Alcotest.failf "CSR error %s" e)
|
||||||
|
in
|
||||||
match Cert_service.check_csr_dn csr (dn_of_name "notreynir") with
|
match Cert_service.check_csr_dn csr (dn_of_name "notreynir") with
|
||||||
| Ok () -> Alcotest.fail "check succeeded, expected failure"
|
| Ok () -> Alcotest.fail "check succeeded, expected failure"
|
||||||
| Error (`Msg _) -> ()
|
| Error (`Msg _) -> ()
|
||||||
|
@ -70,6 +82,10 @@ let check_csr_dn_different () =
|
||||||
let check_csr_dn_diff_org () =
|
let check_csr_dn_diff_org () =
|
||||||
let subject = dn_of_name ~organization:"Evil Corp" "reynir" in
|
let subject = dn_of_name ~organization:"Evil Corp" "reynir" in
|
||||||
let csr = csr subject in
|
let csr = csr subject in
|
||||||
|
let csr =
|
||||||
|
Result.fold csr ~ok:Fun.id
|
||||||
|
~error:(fun (`Msg e) -> Alcotest.failf "CSR error %s" e)
|
||||||
|
in
|
||||||
match Cert_service.check_csr_dn csr (dn_of_name "reynir") 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 _) -> ()
|
||||||
|
@ -77,6 +93,10 @@ let check_csr_dn_diff_org () =
|
||||||
let check_csr_dn_extra () =
|
let check_csr_dn_extra () =
|
||||||
let subject = dn_of_name "reynir" in
|
let subject = dn_of_name "reynir" in
|
||||||
let csr = csr (subject @ dn_of_name "bob") in
|
let csr = csr (subject @ dn_of_name "bob") in
|
||||||
|
let csr =
|
||||||
|
Result.fold csr ~ok:Fun.id
|
||||||
|
~error:(fun (`Msg e) -> Alcotest.failf "CSR error %s" e)
|
||||||
|
in
|
||||||
match Cert_service.check_csr_dn csr (dn_of_name "reynir") 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 _) -> ()
|
||||||
|
@ -98,6 +118,10 @@ let good_sign () =
|
||||||
in
|
in
|
||||||
let name = "reynir" in
|
let name = "reynir" in
|
||||||
let csr = csr (dn_of_name name) in
|
let csr = csr (dn_of_name name) in
|
||||||
|
let csr =
|
||||||
|
Result.fold csr ~ok:Fun.id
|
||||||
|
~error:(fun (`Msg e) -> Alcotest.failf "CSR error %s" e)
|
||||||
|
in
|
||||||
match Cert_service.sign t csr name with
|
match Cert_service.sign t csr name with
|
||||||
| Ok _cert -> ()
|
| Ok _cert -> ()
|
||||||
| Error (`Msg e) -> Alcotest.failf "cert sign failed unexpectedly: %s" e
|
| Error (`Msg e) -> Alcotest.failf "cert sign failed unexpectedly: %s" e
|
||||||
|
@ -112,6 +136,10 @@ let bad_sign () =
|
||||||
in
|
in
|
||||||
let name = "reynir" in
|
let name = "reynir" in
|
||||||
let csr = csr (dn_of_name name) in
|
let csr = csr (dn_of_name name) in
|
||||||
|
let csr =
|
||||||
|
Result.fold csr ~ok:Fun.id
|
||||||
|
~error:(fun (`Msg e) -> Alcotest.failf "CSR error %s" e)
|
||||||
|
in
|
||||||
match Cert_service.sign t csr "notreynir" with
|
match Cert_service.sign t csr "notreynir" with
|
||||||
| Ok cert ->
|
| Ok cert ->
|
||||||
Alcotest.failf
|
Alcotest.failf
|
||||||
|
|
Loading…
Reference in a new issue