diff --git a/app/vmm_cli.ml b/app/vmm_cli.ml index e177ff5..6f2d892 100644 --- a/app/vmm_cli.ml +++ b/app/vmm_cli.ml @@ -119,6 +119,10 @@ let cpu = let doc = "CPUid" in Arg.(value & opt int 0 & info [ "cpu" ] ~doc) +let vm_mem = + let doc = "Memory to assign" in + Arg.(value & opt int 32 & info [ "mem" ] ~doc) + let args = let doc = "Boot arguments" in Arg.(value & opt_all string [] & info [ "arg" ] ~doc) diff --git a/app/vmmc_bistro.ml b/app/vmmc_bistro.ml index 54c3972..76cc3db 100644 --- a/app/vmmc_bistro.ml +++ b/app/vmmc_bistro.ml @@ -197,7 +197,7 @@ let create_cmd = [`S "DESCRIPTION"; `P "Creates a virtual machine."] in - Term.(ret (const create $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ force $ vm_name $ image $ cpu $ mem $ args $ block $ net $ compress_level)), + Term.(ret (const create $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ force $ vm_name $ image $ cpu $ vm_mem $ args $ block $ net $ compress_level)), Term.info "create" ~doc ~man let console_cmd = diff --git a/app/vmmc_local.ml b/app/vmmc_local.ml index 4ab4e60..683b2f6 100644 --- a/app/vmmc_local.ml +++ b/app/vmmc_local.ml @@ -156,7 +156,7 @@ let create_cmd = [`S "DESCRIPTION"; `P "Creates a virtual machine."] in - Term.(ret (const create $ setup_log $ socket $ force $ vm_name $ image $ cpu $ mem $ args $ block $ net $ compress_level)), + Term.(ret (const create $ setup_log $ socket $ force $ vm_name $ image $ cpu $ vm_mem $ args $ block $ net $ compress_level)), Term.info "create" ~doc ~man let console_cmd = diff --git a/app/vmmp_request.ml b/app/vmmp_request.ml index 094e584..5d030e0 100644 --- a/app/vmmp_request.ml +++ b/app/vmmp_request.ml @@ -121,7 +121,7 @@ let create_cmd = [`S "DESCRIPTION"; `P "Creates a virtual machine."] in - Term.(ret (const create $ setup_log $ force $ vm_name $ image $ cpu $ mem $ args $ block $ net $ compress_level)), + Term.(ret (const create $ setup_log $ force $ vm_name $ image $ cpu $ vm_mem $ args $ block $ net $ compress_level)), Term.info "create" ~doc ~man let console_cmd = diff --git a/src/vmm_tls.ml b/src/vmm_tls.ml index 77264c1..7e8696b 100644 --- a/src/vmm_tls.ml +++ b/src/vmm_tls.ml @@ -13,7 +13,7 @@ let cert_name cert = match Vmm_asn.cert_extension_of_cstruct data with | Error (`Msg _) -> Error (`Msg "couldn't parse albatross extension") | Ok (_, `Policy_cmd (`Policy_add _)) -> Error (`Msg "policy add may not have an empty name") - | _ -> Ok (Some name) + | _ -> Ok None else Ok (Some name) let name chain = diff --git a/src/vmm_vmmd.ml b/src/vmm_vmmd.ml index fd6cead..ffcc7fd 100644 --- a/src/vmm_vmmd.ml +++ b/src/vmm_vmmd.ml @@ -158,7 +158,11 @@ let handle_command t (header, payload) = | `Vm_create vm_config -> handle_create t header vm_config | `Vm_force_create vm_config -> - Vmm_resources.remove_vm t.resources id >>= fun resources -> + let resources = + match Vmm_resources.remove_vm t.resources id with + | Error _ -> t.resources + | Ok r -> r + in if Vmm_resources.check_vm_policy resources id vm_config then begin match Vmm_resources.find_vm t.resources id with | None -> handle_create t header vm_config