From ea6b291ad075a164b16cf892c1d7f4ddf0662df8 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Sun, 28 Oct 2018 18:30:02 +0100 Subject: [PATCH] vmmp_ca work --- README.md | 2 +- _tags | 2 +- app/{vmmp_sign.ml => vmmp_ca.ml} | 115 +++++++++++++++++++------------ pkg/pkg.ml | 2 +- 4 files changed, 74 insertions(+), 47 deletions(-) rename app/{vmmp_sign.ml => vmmp_ca.ml} (57%) diff --git a/README.md b/README.md index 47b41ab..502acc2 100644 --- a/README.md +++ b/README.md @@ -16,7 +16,7 @@ Command-line applications for local and remote management are provided as well - `vmmc_remote`: connects to `vmm_tls_endpoint` and executes command - `vmmc_bistro`: command line utility to execute a command remotely: request, sign, remote (do not use in production, requires CA key on host) - `vmmp_request`: creates a certificate signing request containing a command -- `vmmp_sign`: signs a certificate signing request +- `vmmp_ca`: certificate authority operations: sign, generate (and revoke) Please read [the blog article](https://hannes.nqsb.io/Posts/VMM) for motivation and an overview. diff --git a/_tags b/_tags index c992ea9..484b388 100644 --- a/_tags +++ b/_tags @@ -19,7 +19,7 @@ true : package(rresult logs ipaddr bos hex ptime astring duration cstruct decomp : package(nocrypto tls.lwt nocrypto.lwt) : package(nocrypto.unix ptime.clock.os x509) -: package(nocrypto.unix ptime.clock.os x509) +: package(nocrypto.unix ptime.clock.os x509) : package(nocrypto.unix ptime.clock.os x509) diff --git a/app/vmmp_sign.ml b/app/vmmp_ca.ml similarity index 57% rename from app/vmmp_sign.ml rename to app/vmmp_ca.ml index 525d4e3..9e3d65d 100644 --- a/app/vmmp_sign.ml +++ b/app/vmmp_ca.ml @@ -1,6 +1,4 @@ -(* (c) 2017 Hannes Mehnert, all rights reserved *) - -open Vmm_provision +(* (c) 2017, 2018 Hannes Mehnert, all rights reserved *) open Rresult.R.Infix @@ -46,17 +44,18 @@ let sign dbname cacert key csr days = match albatross_extension csr with | Ok (ext, v) -> Vmm_asn.cert_extension_of_cstruct v >>= fun (version, cmd) -> - (if Vmm_commands.version_eq version asn_version then + (if Vmm_commands.version_eq version version then Ok () else Error (`Msg "unknown version in request")) >>= fun () -> (* TODO l_exts / d_exts trouble *) Logs.app (fun m -> m "signing %a" Vmm_commands.pp cmd) ; Ok (ext :: l_exts) >>= fun extensions -> - sign ~dbname extensions issuer key csr (Duration.of_day days) + Vmm_provision.sign ~dbname extensions issuer key csr (Duration.of_day days) | Error e -> Error e -let jump _ db cacert cakey csrname days = +let sign _ db cacert cakey csrname days = + let days = match days with None -> 1 | Some x -> x in Nocrypto_entropy_unix.initialize () ; match Bos.OS.File.read (Fpath.v cacert) >>= fun cacert -> @@ -70,6 +69,27 @@ let jump _ db cacert cakey csrname days = | Ok () -> `Ok () | Error (`Msg e) -> `Error (false, e) +let help _ man_format cmds = function + | None -> `Help (`Pager, None) + | Some t when List.mem t cmds -> `Help (man_format, Some t) + | Some _ -> List.iter print_endline cmds; `Ok () + +let generate _ name db days sname sdays = + let days = match days with None -> 3650 | Some x -> x in + Nocrypto_entropy_unix.initialize () ; + match + Vmm_provision.priv_key ~bits:4096 None name >>= fun key -> + let name = [ `CN name ] in + let csr = X509.CA.request name key in + Vmm_provision.sign ~certname:"cacert" (d_exts ()) name key csr (Duration.of_day days) >>= fun () -> + Vmm_provision.priv_key None sname >>= fun skey -> + let sname = [ `CN sname ] in + let csr = X509.CA.request sname skey in + Vmm_provision.sign ~dbname:(Fpath.v db) s_exts name key csr (Duration.of_day sdays) + with + | Ok () -> `Ok () + | Error (`Msg e) -> `Error (false, e) + open Cmdliner open Vmm_cli @@ -77,46 +97,13 @@ let csr = let doc = "signing request" in Arg.(required & pos 3 (some file) None & info [] ~doc) -let days = - let doc = "Number of days" in - Arg.(value & opt int 1 & info [ "days" ] ~doc) - let key = let doc = "Private key" in Arg.(required & pos 2 (some file) None & info [] ~doc) -let cmd = - Term.(ret (const jump $ setup_log $ db $ cacert $ key $ csr $ days)), - Term.info "vmmp_sign" ~version:"%%VERSION_NUM%%" - -let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1 -(* (c) 2017 Hannes Mehnert, all rights reserved *) - -open Vmm_provision - -open Rresult.R.Infix - -let jump _ name db days sname sdays = - Nocrypto_entropy_unix.initialize () ; - match - priv_key ~bits:4096 None name >>= fun key -> - let name = [ `CN name ] in - let csr = X509.CA.request name key in - sign ~certname:"cacert" (d_exts ()) name key csr (Duration.of_day days) >>= fun () -> - priv_key None sname >>= fun skey -> - let sname = [ `CN sname ] in - let csr = X509.CA.request sname skey in - sign ~dbname:(Fpath.v db) s_exts name key csr (Duration.of_day sdays) - with - | Ok () -> `Ok () - | Error (`Msg e) -> `Error (false, e) - - -open Cmdliner - let days = let doc = "Number of days" in - Arg.(value & opt int 3650 & info [ "days" ] ~doc) + Arg.(value & opt (some int) None & info [ "days" ] ~doc) let db = let doc = "Database" in @@ -130,8 +117,48 @@ let sday = let doc = "Server validity" in Arg.(value & opt int 365 & info [ "server-days" ] ~doc) -let cmd = - Term.(ret (const jump $ setup_log $ nam $ db $ days $ sname $ sday)), - Term.info "vmmp_sign" ~version:"%%VERSION_NUM%%" +let generate_cmd = + let doc = "generates a certificate authority" in + let man = + [`S "DESCRIPTION"; + `P "Generates a certificate authority."] + in + Term.(ret (const generate $ setup_log $ Vmm_provision.nam $ db $ days $ sname $ sday)), + Term.info "generate" ~doc ~man -let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1 +let sign_cmd = + let doc = "sign a request" in + let man = + [`S "DESCRIPTION"; + `P "Signs the certificate signing request."] + in + Term.(ret (const sign $ setup_log $ db $ Vmm_provision.cacert $ key $ csr $ days)), + Term.info "sign" ~doc ~man + +let help_cmd = + let topic = + let doc = "The topic to get help on. `topics' lists the topics." in + Arg.(value & pos 0 (some string) None & info [] ~docv:"TOPIC" ~doc) + in + let doc = "display help about vmmp_sign" in + let man = + [`S "DESCRIPTION"; + `P "Prints help about commands and subcommands"] + in + Term.(ret (const help $ setup_log $ Term.man_format $ Term.choice_names $ topic)), + Term.info "help" ~doc ~man + +let default_cmd = + let doc = "VMM " in + let man = [ + `S "DESCRIPTION" ; + `P "$(tname) executes the provided subcommand on a remote albatross" ] + in + Term.(ret (const help $ setup_log $ Term.man_format $ Term.choice_names $ Term.pure None)), + Term.info "vmmp_ca" ~version:"%%VERSION_NUM%%" ~doc ~man + +let cmds = [ help_cmd ; sign_cmd ; generate_cmd ; (* TODO revoke_cmd *)] + +let () = + match Term.eval_choice default_cmd cmds + with `Ok () -> exit 0 | _ -> exit 1 diff --git a/pkg/pkg.ml b/pkg/pkg.ml index 97a095f..d9df305 100644 --- a/pkg/pkg.ml +++ b/pkg/pkg.ml @@ -16,5 +16,5 @@ let () = Pkg.bin "app/vmmc_remote" ; Pkg.bin "app/vmmc_bistro" ; Pkg.bin "app/vmmp_request" ; - Pkg.bin "app/vmmp_sign" ; + Pkg.bin "app/vmmp_ca" ; ]