diff --git a/bin/hashbang_cert_client.ml b/bin/hashbang_cert_client.ml index 6ca6cec..1e802a6 100644 --- a/bin/hashbang_cert_client.ml +++ b/bin/hashbang_cert_client.ml @@ -22,6 +22,10 @@ let main () = 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 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 ({ version }, `Command (`Sign_request csr)) in let* () = diff --git a/bin/hashbang_cert_server.ml b/bin/hashbang_cert_server.ml index 5a03877..ded0abc 100644 --- a/bin/hashbang_cert_server.ml +++ b/bin/hashbang_cert_server.ml @@ -25,19 +25,19 @@ let handler t _sockaddr fd = () let load_cacert f = - Rresult.R.bind + Result.bind (Bos.OS.File.read f) (fun s -> X509.Certificate.decode_pem (Cstruct.of_string s)) let load_cakey f = - Rresult.R.bind + Result.bind (Bos.OS.File.read f) (fun s -> X509.Private_key.decode_pem (Cstruct.of_string s)) 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 cacert = Result.get_ok (load_cacert (Fpath.v cacert_path)) in + let cakey = Result.get_ok (load_cakey (Fpath.v cakey_path)) 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 diff --git a/lib/cert_service.ml b/lib/cert_service.ml index 11acecf..8fda2e7 100644 --- a/lib/cert_service.ml +++ b/lib/cert_service.ml @@ -1,5 +1,3 @@ -open Rresult - module Commands = Wire_commands module Wire_lwt = Wire_lwt @@ -13,12 +11,14 @@ type t = { cakey : X509.Private_key.t; } +let ( >>= ) = Result.bind + let check_csr_dn csr dn = let subject = (X509.Signing_request.info csr).subject in if X509.Distinguished_name.equal dn subject then Ok () - else R.error_msgf "Bad subject in csr: %a" - X509.Distinguished_name.pp subject + else Error (`Msg (Fmt.str "Bad subject in csr: %a" + X509.Distinguished_name.pp subject)) let sign t csr user = let subject = @@ -53,5 +53,5 @@ let sign t csr user = ~extensions t.cakey issuer - |> R.reword_error (fun ve -> - R.msgf "Signing failed: %a" X509.Validation.pp_validation_error ve) + |> Result.map_error (fun ve -> + `Msg (Fmt.str "Signing failed: %a" X509.Validation.pp_signature_error ve)) diff --git a/lib/wire_asn.ml b/lib/wire_asn.ml index 74268cb..cf92041 100644 --- a/lib/wire_asn.ml +++ b/lib/wire_asn.ml @@ -1,4 +1,3 @@ -open Rresult open Wire_commands 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 = match Asn.decode codec cs with | Ok (a, cs) -> - if Cstruct.len cs > 0 - then R.error_msg "trailing bytes" + if Cstruct.length cs > 0 + then Error (`Msg "trailing bytes") else Ok a | Error (`Parse msg) -> Error (`Msg msg) diff --git a/lib/wire_lwt.ml b/lib/wire_lwt.ml index ccb0760..159fbd0 100644 --- a/lib/wire_lwt.ml +++ b/lib/wire_lwt.ml @@ -56,6 +56,6 @@ let write_raw fd buf = let write_wire fd wire = let data = Wire_asn.wire_to_cstruct wire 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 write_raw fd buf diff --git a/test/test.ml b/test/test.ml index 22cfa51..0d21c21 100644 --- a/test/test.ml +++ b/test/test.ml @@ -36,6 +36,10 @@ let ca_cert = subject (Lazy.force ca_privkey) in + let csr = + Result.fold csr ~ok:Fun.id + ~error:(fun (`Msg e) -> Alcotest.failf "CSR error %s" e) + in X509.Signing_request.sign csr ~valid_from @@ -54,6 +58,10 @@ let csr subject = let check_csr_dn_good () = let subject = dn_of_name "reynir" 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) "good dn in csr" (Ok ()) @@ -63,6 +71,10 @@ let check_csr_dn_good () = let check_csr_dn_different () = let subject = dn_of_name "reynir" 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 | Ok () -> Alcotest.fail "check succeeded, expected failure" | Error (`Msg _) -> () @@ -70,6 +82,10 @@ let check_csr_dn_different () = let check_csr_dn_diff_org () = let subject = dn_of_name ~organization:"Evil Corp" "reynir" 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 | Ok () -> Alcotest.fail "check succeeded, expected failure" | Error (`Msg _) -> () @@ -77,6 +93,10 @@ let check_csr_dn_diff_org () = let check_csr_dn_extra () = let subject = dn_of_name "reynir" 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 | Ok () -> Alcotest.fail "check succeeded, expected failure" | Error (`Msg _) -> () @@ -98,6 +118,10 @@ let good_sign () = in let name = "reynir" 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 | Ok _cert -> () | Error (`Msg e) -> Alcotest.failf "cert sign failed unexpectedly: %s" e @@ -112,6 +136,10 @@ let bad_sign () = in let name = "reynir" 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 | Ok cert -> Alcotest.failf