allow old unikernel info to be processed, use a new command for the n…

…ew info

src/vmm_asn.ml

@@ -522,9 +522,10 @@ let unikernel_cmd =
     | `C2 `C5 unikernel -> `Unikernel_force_create unikernel
     | `C2 `C6 level -> `Unikernel_get level
     | `C3 `C1 () -> `Unikernel_restart None
-    | `C3 `C2 () -> `Unikernel_info
+    | `C3 `C2 () -> `Old_unikernel_info3
     | `C3 `C3 `C1 () -> `Unikernel_restart None
     | `C3 `C3 `C2 args -> `Unikernel_restart (Some args)
+    | `C3 `C4 () -> `Unikernel_info
   and g = function
     | `Old_unikernel_info1 -> `C1 (`C1 ())
     | `Unikernel_create unikernel -> `C2 (`C4 unikernel)
@@ -535,7 +536,8 @@ let unikernel_cmd =
     | `Unikernel_get level -> `C2 (`C6 level)
     | `Unikernel_restart None -> `C3 (`C3 (`C1 ()))
     | `Unikernel_restart (Some args) -> `C3 (`C3 (`C2 args))
-    | `Unikernel_info -> `C3 (`C2 ())
+    | `Old_unikernel_info3 -> `C3 (`C2 ())
+    | `Unikernel_info -> `C3 (`C4 ())
   in
   Asn.S.map f g @@
   Asn.S.(choice3
@@ -553,13 +555,14 @@ let unikernel_cmd =
              (my_explicit 9 ~label:"create" unikernel_config)
              (my_explicit 10 ~label:"force-create" unikernel_config)
              (my_explicit 11 ~label:"get" int))
-          (choice3
+          (choice4
              (my_explicit 12 ~label:"restart-OLD" null)
-             (my_explicit 13 ~label:"info" null)
+             (my_explicit 13 ~label:"info-OLD3" null)
              (my_explicit 14 ~label:"restart"
                 (choice2
                    (my_explicit 0 ~label:"no arguments" null)
-                   (my_explicit 1 ~label:"new arguments" unikernel_arguments)))))
+                   (my_explicit 1 ~label:"new arguments" unikernel_arguments)))
+             (my_explicit 15 ~label:"info" null)))
 
 let policy_cmd =
   let f = function
@@ -664,17 +667,19 @@ let data =
                  (required ~label:"timestamp" generalized_time)
                  (required ~label:"data" utf8_string))))
 
-let old_unikernel_info =
+let old_unikernel_info2 =
   let open Unikernel in
   let f (typ, (fail_behaviour, (cpuid, (memory, (digest, (blocks, (bridges, argv))))))) =
     let bridges = match bridges with None -> [] | Some xs ->
       List.map (fun (unikernel_device, host_device, mac) ->
-          { unikernel_device ; host_device = Option.value ~default:unikernel_device host_device ;
+          { unikernel_device ;
+            host_device = Option.value ~default:unikernel_device host_device ;
             mac = Option.value ~default:Macaddr.broadcast mac })
         xs
     and block_devices = match blocks with None -> [] | Some xs ->
       List.map (fun (unikernel_device, host_device, sector_size) ->
-          { unikernel_device ; host_device = Option.value ~default:unikernel_device host_device ;
+          { unikernel_device ;
+            host_device = Option.value ~default:unikernel_device host_device ;
             sector_size = Option.value ~default:512 (* TODO: default from solo5-hvt *) sector_size ;
             size = 0 })
         xs
@@ -717,6 +722,58 @@ let old_unikernel_info =
                                    (optional ~label:"mac" mac_addr)))))
         -@ (optional ~label:"arguments"(my_explicit 2 (sequence_of utf8_string))))
 
+let old_unikernel_info3 =
+  let open Unikernel in
+  let f (typ, (fail_behaviour, (cpuid, (memory, (digest, (blocks, (bridges, (argv, started)))))))) =
+    let bridges = match bridges with None -> [] | Some xs ->
+      List.map (fun (unikernel_device, host_device, mac) ->
+          { unikernel_device ;
+            host_device = Option.value ~default:unikernel_device host_device ;
+            mac = Option.value ~default:Macaddr.broadcast mac })
+        xs
+    and block_devices = match blocks with None -> [] | Some xs ->
+      List.map (fun (unikernel_device, host_device, sector_size) ->
+          { unikernel_device ;
+            host_device = Option.value ~default:unikernel_device host_device ;
+            sector_size = Option.value ~default:512 (* TODO: default from solo5-hvt *) sector_size ;
+            size = 0 })
+        xs
+    and started = Option.value ~default:Ptime.epoch started
+    in
+    { typ ; fail_behaviour ; cpuid ; memory ; block_devices ; bridges ; argv ; digest ; started }
+  and g (unikernel : info) =
+    let bridges = match unikernel.bridges with
+      | [] -> None
+      | xs -> Some (List.map (fun { unikernel_device ; host_device ; mac } ->
+          unikernel_device, Some host_device, Some mac) xs)
+    and blocks = match unikernel.block_devices with
+      | [] -> None
+      | xs -> Some (List.map (fun { unikernel_device ; host_device ; sector_size ; _ } ->
+          unikernel_device, Some host_device, Some sector_size) xs)
+    in
+    (unikernel.typ, (unikernel.fail_behaviour, (unikernel.cpuid, (unikernel.memory, (unikernel.digest, (blocks, (bridges, (unikernel.argv, Some unikernel.started))))))))
+  in
+  Asn.S.(map f g @@ sequence @@
+           (required ~label:"typ" typ)
+         @ (required ~label:"fail-behaviour" fail_behaviour)
+         @ (required ~label:"cpuid" int)
+         @ (required ~label:"memory" int)
+         @ (required ~label:"digest" octet_string)
+         @ (optional ~label:"blocks"
+              (my_explicit 0 (set_of
+                                (sequence3
+                                   (required ~label:"unikernel-device" utf8_string)
+                                   (optional ~label:"host-device" utf8_string)
+                                   (optional ~label:"block-sector-size" int)))))
+         @ (optional ~label:"bridges"
+              (my_explicit 1 (set_of
+                                (sequence3
+                                   (required ~label:"unikernel-device" utf8_string)
+                                   (optional ~label:"host-device" utf8_string)
+                                   (optional ~label:"mac" mac_addr)))))
+         @ (optional ~label:"arguments"(my_explicit 2 (sequence_of utf8_string)))
+        -@ (optional ~label:"started" (my_explicit 3 generalized_time)))
+
 let unikernel_info =
   let open Unikernel in
   let f (typ, (fail_behaviour, (cpuid, (memory, (digest, (blocks, (bridges, (argv, started)))))))) =
@@ -782,20 +839,22 @@ let success name =
     | `C1 `C3 policies -> `Policies policies
     | `C1 `C4 unikernels -> `Old_unikernels unikernels
     | `C1 `C5 blocks -> `Block_devices blocks
-    | `C1 `C6 unikernels -> `Old_unikernel_info unikernels
+    | `C1 `C6 unikernels -> `Old_unikernel_info2 unikernels
     | `C2 `C1 (c, i) -> `Unikernel_image (c, i)
     | `C2 `C2 (compress, data) -> `Block_device_image (compress, data)
-    | `C2 `C3 unikernels -> `Unikernel_info unikernels
+    | `C2 `C3 unikernels -> `Old_unikernel_info3 unikernels
+    | `C2 `C4 unikernels -> `Old_unikernel_info3 unikernels
   and g = function
     | `Empty -> `C1 (`C1 ())
     | `String s -> `C1 (`C2 s)
     | `Policies ps -> `C1 (`C3 ps)
     | `Old_unikernels unikernels -> `C1 (`C4 unikernels)
     | `Block_devices blocks -> `C1 (`C5 blocks)
-    | `Old_unikernel_info unikernels -> `C1 (`C6 unikernels)
+    | `Old_unikernel_info2 unikernels -> `C1 (`C6 unikernels)
     | `Unikernel_image (c, i) -> `C2 (`C1 (c, i))
     | `Block_device_image (compress, data) -> `C2 (`C2 (compress, data))
-    | `Unikernel_info unikernels -> `C2 (`C3 unikernels)
+    | `Old_unikernel_info3 unikernels -> `C2 (`C3 unikernels)
+    | `Unikernel_info unikernels -> `C2 (`C4 unikernels)
   in
   Asn.S.map f g @@
   Asn.S.(choice2
@@ -818,12 +877,12 @@ let success name =
                       (required ~label:"name" name)
                       (required ~label:"size" int)
                       (required ~label:"active" bool))))
-             (my_explicit 5 ~label:"old-unikernel-info"
+             (my_explicit 5 ~label:"old-unikernel-info2"
                 (sequence_of
                    (sequence2
                       (required ~label:"name" name)
-                      (required ~label:"info" old_unikernel_info)))))
-          (choice3
+                      (required ~label:"info" old_unikernel_info2)))))
+          (choice4
              (my_explicit 6 ~label:"unikernel-image"
                 (sequence2
                    (required ~label:"compressed" bool)
@@ -832,7 +891,12 @@ let success name =
                 (sequence2
                    (required ~label:"compressed" bool)
                    (required ~label:"image" octet_string)))
-             (my_explicit 8 ~label:"unikernel-info"
+             (my_explicit 8 ~label:"old-unikernel-info3"
+                (sequence_of
+                   (sequence2
+                      (required ~label:"name" name)
+                      (required ~label:"info" old_unikernel_info3))))
+             (my_explicit 9 ~label:"unikernel-info"
                 (sequence_of
                    (sequence2
                       (required ~label:"name" name)

src/vmm_commands.ml

@@ -64,6 +64,7 @@ type unikernel_cmd = [
   | `Unikernel_get of int
   | `Old_unikernel_info1
   | `Old_unikernel_info2
+  | `Old_unikernel_info3
   | `Old_unikernel_get
 ]
 
@@ -85,6 +86,7 @@ let pp_unikernel_cmd ~verbose ppf = function
   | `Unikernel_get level -> Fmt.pf ppf "unikernel get compress level %d" level
   | `Old_unikernel_info1 -> Fmt.string ppf "old unikernel info1"
   | `Old_unikernel_info2 -> Fmt.string ppf "old unikernel info2"
+  | `Old_unikernel_info3 -> Fmt.string ppf "old unikernel info3"
   | `Old_unikernel_get -> Fmt.string ppf "old unikernel get"
 
 type policy_cmd = [
@@ -160,7 +162,8 @@ type success = [
   | `Policies of (Name.t * Policy.t) list
   | `Old_unikernels of (Name.t * Unikernel.config) list
   | `Unikernel_info of (Name.t * Unikernel.info) list
-  | `Old_unikernel_info of (Name.t * Unikernel.info) list
+  | `Old_unikernel_info2 of (Name.t * Unikernel.info) list
+  | `Old_unikernel_info3 of (Name.t * Unikernel.info) list
   | `Unikernel_image of bool * string
   | `Block_devices of (Name.t * int * bool) list
   | `Block_device_image of bool * string
@@ -184,7 +187,7 @@ let pp_success ~verbose ppf = function
       Fmt.(pair ~sep:(any ": ") Name.pp
              (if verbose then Unikernel.pp_config_with_argv else Unikernel.pp_config))
       ppf unikernels
-  | `Unikernel_info infos | `Old_unikernel_info infos ->
+  | `Unikernel_info infos | `Old_unikernel_info2 infos | `Old_unikernel_info3 infos ->
     my_fmt_list "no unikernels"
       Fmt.(pair ~sep:(any ": ") Name.pp
              (if verbose then Unikernel.pp_info_with_argv else Unikernel.pp_info))

src/vmm_commands.mli

@@ -39,6 +39,7 @@ type unikernel_cmd = [
   | `Unikernel_get of int
   | `Old_unikernel_info1
   | `Old_unikernel_info2
+  | `Old_unikernel_info3
   | `Old_unikernel_get
 ]
 
@@ -87,7 +88,8 @@ type success = [
   | `String of string
   | `Policies of (Name.t * Policy.t) list
   | `Old_unikernels of (Name.t * Unikernel.config) list
-  | `Old_unikernel_info of (Name.t * Unikernel.info) list
+  | `Old_unikernel_info2 of (Name.t * Unikernel.info) list
+  | `Old_unikernel_info3 of (Name.t * Unikernel.info) list
   | `Unikernel_info of (Name.t * Unikernel.info) list
   | `Unikernel_image of bool * string
   | `Block_devices of (Name.t * int * bool) list

src/vmm_vmmd.ml

@@ -324,7 +324,19 @@ let handle_unikernel_cmd t id =
         Option.fold ~none:[] ~some:(fun unikernel -> [ id, Unikernel.info (block_size id) unikernel ])
           (Vmm_trie.find id t.resources.Vmm_resources.unikernels)
     in
-    Ok (t, `End (`Success (`Old_unikernel_info infos)))
+    Ok (t, `End (`Success (`Old_unikernel_info2 infos)))
+  | `Old_unikernel_info3 ->
+    Logs.debug (fun m -> m "old info3 %a" Name.pp id) ;
+    let infos =
+      match Name.name id with
+      | None ->
+        Vmm_trie.fold (Name.path id) t.resources.Vmm_resources.unikernels
+          (fun id unikernel unikernels -> (id, Unikernel.info (block_size id) unikernel) :: unikernels) []
+      | Some _ ->
+        Option.fold ~none:[] ~some:(fun unikernel -> [ id, Unikernel.info (block_size id) unikernel ])
+          (Vmm_trie.find id t.resources.Vmm_resources.unikernels)
+    in
+    Ok (t, `End (`Success (`Old_unikernel_info3 infos)))
   | `Unikernel_info ->
     Logs.debug (fun m -> m "info %a" Name.pp id) ;
     let infos =