From 2b85c65dd8855472ddeb07fd12f635cbb4d01d24 Mon Sep 17 00:00:00 2001
From: Hannes Mehnert <hannes@mehnert.org>
Date: Sun, 28 Oct 2018 23:06:15 +0100
Subject: [PATCH] minor fixes from testing: do not require vm to be present for
 force-create, fix id generation in vmm_tls, use 32mb memory for unikernels by
 default

---
 app/vmm_cli.ml      | 4 ++++
 app/vmmc_bistro.ml  | 2 +-
 app/vmmc_local.ml   | 2 +-
 app/vmmp_request.ml | 2 +-
 src/vmm_tls.ml      | 2 +-
 src/vmm_vmmd.ml     | 6 +++++-
 6 files changed, 13 insertions(+), 5 deletions(-)

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