Update
All checks were successful
continuous-integration/drone/push Build is passing

This commit is contained in:
Reynir Björnsson 2023-02-01 13:57:44 +01:00
parent abd3d591f2
commit 8601e4b137
6 changed files with 45 additions and 14 deletions

View file

@ -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* () =

View file

@ -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

View file

@ -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))

View file

@ -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)

View file

@ -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

View file

@ -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