albatross/provision/vmm_req_delegation.ml

83 lines
2.7 KiB
OCaml
Raw Normal View History

2017-05-26 14:30:34 +00:00
(* (c) 2017 Hannes Mehnert, all rights reserved *)
open Vmm_provision
open Vmm_asn
open Rresult.R.Infix
open Astring
let subca_csr key name cpus memory vms block bridges =
let cpuids = Vmm_core.IS.of_list cpus
and bridges = List.fold_left (fun acc b -> match b with
| `Internal name -> String.Map.add name b acc
| `External (name, _, _, _, _) -> String.Map.add name b acc)
String.Map.empty bridges
2017-05-26 14:30:34 +00:00
in
let policy = Vmm_core.{ vms ; cpuids ; memory ; block ; bridges } in
let cmd = `Policy_cmd (`Policy_add policy) in
2017-05-26 14:30:34 +00:00
let exts =
[ (false, `Unsupported (oid, cert_extension_to_cstruct (asn_version, cmd))) ]
2017-05-26 14:30:34 +00:00
and name = [ `CN name ]
in
X509.CA.request name ~extensions:[`Extensions exts] key
let jump _ name key vms mem cpus block bridges =
Nocrypto_entropy_unix.initialize () ;
match
priv_key key name >>= fun key ->
let csr = subca_csr key name cpus mem vms block bridges in
let enc = X509.Encoding.Pem.Certificate_signing_request.to_pem_cstruct1 csr in
Bos.OS.File.write Fpath.(v name + ".req") (Cstruct.to_string enc)
with
| Ok () -> `Ok ()
| Error (`Msg m) -> `Error (false, m)
open Cmdliner
let cpus =
let doc = "CPUids to provision" in
Arg.(value & opt_all int [] & info [ "cpu" ] ~doc)
let vms =
let doc = "Number of VMs to provision" in
Arg.(required & pos 1 (some int) None & info [] ~doc)
let block =
let doc = "Block storage to provision" in
Arg.(value & opt (some int) None & info [ "block" ] ~doc)
let b =
let parse s =
match String.cuts ~sep:"/" s with
| [ name ; fst ; lst ; gw ; nm ] ->
begin match Ipaddr.V4.(of_string fst, of_string lst, of_string gw) with
| Some fst, Some lst, Some gw ->
(try
let nm = int_of_string nm in
if nm > 0 && nm <= 32 then
let net = Ipaddr.V4.Prefix.make nm gw in
if Ipaddr.V4.Prefix.mem fst net && Ipaddr.V4.Prefix.mem lst net then
`Ok (`External (name, fst, lst, gw, nm))
else
`Error "first or last IP are not in subnet"
else
`Error "netmask must be > 0 and <= 32"
with Failure _ -> `Error "couldn't parse netmask")
| _ -> `Error "couldn't parse IP address"
end
| [ name ] -> `Ok (`Internal name)
| _ -> `Error "couldn't parse bridge (either 'name' or 'name/fstIP/lstIP/gwIP/netmask')"
in
(parse, Vmm_core.pp_bridge)
let bridge =
let doc = "Bridge to provision" in
Arg.(value & opt_all b [] & info [ "bridge" ] ~doc)
let cmd =
Term.(ret (const jump $ setup_log $ nam $ key $ vms $ mem $ cpus $ block $ bridge)),
Term.info "vmm_req_delegation" ~version:"%%VERSION_NUM%%"
let () = match Term.eval cmd with `Ok () -> exit 0 | _ -> exit 1