add the possibility to replace the arguments on Unikernel_restart

TODO: this needs a bit more thought in respect to backwards compatibility

client/albatross_client.ml

@@ -700,7 +700,32 @@ let create () force image cpuid memory argv block network compression restart_on
   | Ok cmd -> jump (`Unikernel_cmd cmd) name d cert key ca key_type tmpdir
   | Error _ as e -> e
 
-let restart () = jump (`Unikernel_cmd `Unikernel_restart)
+let restart () replace cpuid memory argv block_devices bridges restart_on_fail exit_codes name d cert key ca key_type tmpdir =
+  let ( let* ) = Result.bind in
+  let* args =
+    if replace then
+      let* () =
+        if Vmm_core.String_set.(cardinal (of_list (List.map (fun (n, _, _) -> n) bridges))) = List.length bridges then
+          Ok ()
+        else
+          Error (`Msg "Bridge names must be a set")
+      in
+      let* () =
+        if Vmm_core.String_set.(cardinal (of_list (List.map (fun (n, _, _) -> n) block_devices))) = List.length block_devices then
+          Ok ()
+        else
+          Error (`Msg "Block devices must be a set")
+      in
+      let fail_behaviour =
+        let exits = match exit_codes with [] -> None | xs -> Some (Vmm_core.IS.of_list xs) in
+        if restart_on_fail then `Restart exits else `Quit
+      and argv = match argv with [] -> None | xs -> Some xs
+      in
+      Ok (Some { Vmm_core.Unikernel.fail_behaviour ; cpuid ; memory ; block_devices ; bridges ; argv })
+    else
+      Ok None
+  in
+  jump (`Unikernel_cmd (`Unikernel_restart args)) name d cert key ca key_type tmpdir
 
 let since_count since count = match since with
   | None -> `Count count
@@ -1096,7 +1121,7 @@ let net =
 
 let restart_on_fail =
   let doc = "When the unikernel exits, restart it." in
-  Arg.(value & flag & info [  "restart" ; "restart-on-fail" ] ~doc)
+  Arg.(value & flag & info [ "restart" ; "restart-on-fail" ] ~doc)
 
 let exit_code =
   let doc = "Exit codes to restart on (default: everything apart 1 (solo5 error), 60, 61, 62, 63, 64 (argument parsing errors)). Can be repeated." in
@@ -1237,14 +1262,18 @@ let destroy_cmd =
   in
   Cmd.v info term
 
+let replace_args =
+  let doc = "Replace the arguments with the provided ones." in
+  Arg.(value & flag & info [ "replace-arguments" ] ~doc)
+
 let restart_cmd =
   let doc = "Restarts a unikernel." in
   let man =
     [`S "DESCRIPTION";
      `P "Restarts a unikernel."]
   in
   let term =
-    Term.(term_result (const restart $ (Albatross_cli.setup_log (const false)) $ unikernel_name $ dst $ ca_cert $ ca_key $ server_ca $ pub_key_type $ Albatross_cli.tmpdir))
+    Term.(term_result (const restart $ (Albatross_cli.setup_log (const false)) $ replace_args $ cpu $ unikernel_mem $ args $ block $ net $ restart_on_fail $ exit_code $ unikernel_name $ dst $ ca_cert $ ca_key $ server_ca $ pub_key_type $ Albatross_cli.tmpdir))
   and info = Cmd.info "restart" ~doc ~man ~exits
   in
   Cmd.v info term

src/vmm_asn.ml

@@ -476,6 +476,37 @@ let unikernel_config =
                                 (optional ~label:"mac" mac_addr)))))
         -@ (optional ~label:"arguments"(my_explicit 2 (sequence_of utf8_string))))
 
+let unikernel_arguments =
+  let open Unikernel in
+  let f (fail_behaviour, (cpuid, (memory, (blocks, (bridges, argv))))) =
+    let bridges = match bridges with None -> [] | Some xs -> xs
+    and block_devices = match blocks with None -> [] | Some xs -> xs
+    in
+    { fail_behaviour ; cpuid ; memory ; block_devices ; bridges ; argv }
+  and g (unikernel : arguments) =
+    let bridges = match unikernel.bridges with [] -> None | xs -> Some xs
+    and blocks = match unikernel.block_devices with [] -> None | xs -> Some xs
+    in
+    (unikernel.fail_behaviour, (unikernel.cpuid, (unikernel.memory, (blocks, (bridges, unikernel.argv)))))
+  in
+  Asn.S.(map f g @@ sequence @@
+           (required ~label:"fail-behaviour" fail_behaviour)
+         @ (required ~label:"cpuid" int)
+         @ (required ~label:"memory" int)
+         @ (optional ~label:"blocks"
+              (my_explicit 0 (set_of
+                                (sequence3
+                                   (required ~label:"block-name" utf8_string)
+                                   (optional ~label:"block-device-name" utf8_string)
+                                   (optional ~label:"block-sector-size" int)))))
+         @ (optional ~label:"bridges"
+              (my_explicit 1 (set_of
+                             (sequence3
+                                (required ~label:"netif" utf8_string)
+                                (optional ~label:"bridge" utf8_string)
+                                (optional ~label:"mac" mac_addr)))))
+        -@ (optional ~label:"arguments"(my_explicit 2 (sequence_of utf8_string))))
+
 let unikernel_cmd =
   let f = function
     | `C1 `C1 () -> `Old_unikernel_info1
@@ -490,7 +521,8 @@ let unikernel_cmd =
     | `C2 `C4 unikernel -> `Unikernel_create unikernel
     | `C2 `C5 unikernel -> `Unikernel_force_create unikernel
     | `C2 `C6 level -> `Unikernel_get level
-    | `C3 `C1 () -> `Unikernel_restart
+    | `C3 `C1 `C1 () -> `Unikernel_restart None
+    | `C3 `C1 `C2 args -> `Unikernel_restart (Some args)
     | `C3 `C2 () -> `Unikernel_info
   and g = function
     | `Old_unikernel_info1 -> `C1 (`C1 ())
@@ -500,7 +532,8 @@ let unikernel_cmd =
     | `Old_unikernel_get -> `C2 (`C1 ())
     | `Old_unikernel_info2 -> `C2 (`C2 ())
     | `Unikernel_get level -> `C2 (`C6 level)
-    | `Unikernel_restart -> `C3 (`C1 ())
+    | `Unikernel_restart None -> `C3 (`C1 (`C1 ()))
+    | `Unikernel_restart (Some args) -> `C3 (`C1 (`C2 args))
     | `Unikernel_info -> `C3 (`C2 ())
   in
   Asn.S.map f g @@
@@ -520,7 +553,10 @@ let unikernel_cmd =
              (my_explicit 10 ~label:"force-create" unikernel_config)
              (my_explicit 11 ~label:"get" int))
           (choice2
-             (my_explicit 12 ~label:"restart" null)
+             (my_explicit 12 ~label:"restart"
+                (choice2
+                   (my_explicit 0 ~label:"no arguments" null)
+                   (my_explicit 1 ~label:"new arguments" unikernel_arguments)))
              (my_explicit 13 ~label:"info" null)))
 
 let policy_cmd =

src/vmm_commands.ml

@@ -59,7 +59,7 @@ type unikernel_cmd = [
   | `Unikernel_info
   | `Unikernel_create of Unikernel.config
   | `Unikernel_force_create of Unikernel.config
-  | `Unikernel_restart
+  | `Unikernel_restart of Unikernel.arguments option
   | `Unikernel_destroy
   | `Unikernel_get of int
   | `Old_unikernel_info1
@@ -77,7 +77,10 @@ let pp_unikernel_cmd ~verbose ppf = function
     Fmt.pf ppf "unikernel force create %a"
       (if verbose then Unikernel.pp_config_with_argv else Unikernel.pp_config)
       config
-  | `Unikernel_restart -> Fmt.string ppf "unikernel restart"
+  | `Unikernel_restart args ->
+    Fmt.pf ppf "unikernel restart%a"
+      Fmt.(option ~none:(any "") (any " " ++ if verbose then Unikernel.pp_arguments_with_argv else Unikernel.pp_arguments))
+      args
   | `Unikernel_destroy -> Fmt.string ppf "unikernel destroy"
   | `Unikernel_get level -> Fmt.pf ppf "unikernel get compress level %d" level
   | `Old_unikernel_info1 -> Fmt.string ppf "old unikernel info1"

src/vmm_commands.mli

@@ -34,7 +34,7 @@ type unikernel_cmd = [
   | `Unikernel_info
   | `Unikernel_create of Unikernel.config
   | `Unikernel_force_create of Unikernel.config
-  | `Unikernel_restart
+  | `Unikernel_restart of Unikernel.arguments option
   | `Unikernel_destroy
   | `Unikernel_get of int
   | `Old_unikernel_info1

src/vmm_core.ml

@@ -362,6 +362,26 @@ module Unikernel = struct
   let restart_handler config =
     match config.fail_behaviour with `Quit -> false | `Restart _ -> true
 
+  type arguments = {
+    fail_behaviour : fail_behaviour;
+    cpuid : int ;
+    memory : int ;
+    block_devices : (string * string option * int option) list ;
+    bridges : (string * string option * Macaddr.t option) list ;
+    argv : string list option ;
+  }
+
+  let pp_arguments ppf (unikernel : arguments) =
+    Fmt.pf ppf "fail behaviour %a@ cpu %d@ %d MB memory@ block devices %a@ bridge %a"
+      pp_fail_behaviour unikernel.fail_behaviour
+      unikernel.cpuid unikernel.memory
+      Fmt.(list ~sep:(any ", ") pp_block) unikernel.block_devices
+      Fmt.(list ~sep:(any ", ") pp_bridge) unikernel.bridges
+
+  let pp_arguments_with_argv ppf (unikernel : arguments) =
+    Fmt.pf ppf "%a@ argv %a" pp_arguments unikernel
+      Fmt.(option ~none:(any "no") (list ~sep:(any " ") string)) unikernel.argv
+
   type t = {
     config : config ;
     cmd : string array ;

src/vmm_core.mli

@@ -123,6 +123,19 @@ module Unikernel : sig
 
   val restart_handler : config -> bool
 
+  type arguments = {
+    fail_behaviour : fail_behaviour;
+    cpuid : int ;
+    memory : int ;
+    block_devices : (string * string option * int option) list ;
+    bridges : (string * string option * Macaddr.t option) list ;
+    argv : string list option ;
+  }
+
+  val pp_arguments : arguments Fmt.t
+
+  val pp_arguments_with_argv : arguments Fmt.t
+
   type t = {
     config : config;
     cmd : string array;

src/vmm_vmmd.ml

@@ -378,12 +378,24 @@ let handle_unikernel_cmd t id =
          | () -> ());
         Ok (t, `Wait_and_create (id, (id, unikernel_config)))
     end
-  | `Unikernel_restart ->
+  | `Unikernel_restart args ->
     begin
       match Vmm_resources.find_unikernel t.resources id with
       | None -> stop_create t id
       | Some unikernel ->
-        Ok (t, `Wait_and_create (id, (id, unikernel.Unikernel.config)))
+        let config =
+          match args with
+          | None -> unikernel.Unikernel.config
+          | Some (a : Unikernel.arguments) ->
+            (* TODO: should check whether args conform to manifest!? *)
+            { unikernel.Unikernel.config with
+              fail_behaviour = a.fail_behaviour ;
+              cpuid = a.cpuid ;
+              block_devices = a.block_devices ;
+              bridges = a.bridges ;
+              argv = a.argv }
+        in
+        Ok (t, `Wait_and_create (id, (id, config)))
     end
   | `Unikernel_destroy ->
     match Vmm_resources.find_unikernel t.resources id with