new command: get which downloads a unikernel and dumps it into a file

client/albatross_client_bistro.ml

@@ -115,6 +115,9 @@ let add_policy _ endp cert key ca name vms memory cpus block bridges =
 let info_ _ endp cert key ca name =
   jump endp cert key ca name (`Unikernel_cmd `Unikernel_info)
 
+let get _ endp cert key ca name =
+  jump endp cert key ca name (`Unikernel_cmd `Unikernel_get)
+
 let destroy _ endp cert key ca name =
   jump endp cert key ca name (`Unikernel_cmd `Unikernel_destroy)
 
@@ -197,6 +200,15 @@ let info_cmd =
   Term.(const info_ $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ opt_vm_name),
   Term.info "info" ~doc ~man ~exits
 
+let get_cmd =
+  let doc = "retrieve a VM" in
+  let man =
+    [`S "DESCRIPTION";
+     `P "Downloads a VM."]
+  in
+  Term.(const get $ setup_log $ destination $ ca_cert $ ca_key $ server_ca $ vm_name),
+  Term.info "get" ~doc ~man ~exits
+
 let policy_cmd =
   let doc = "active policies" in
   let man =
@@ -300,9 +312,9 @@ let default_cmd =
   Term.(ret (const help $ setup_log $ destination $ Term.man_format $ Term.choice_names $ Term.pure None)),
   Term.info "albatross_client_bistro" ~version ~doc ~man ~exits
 
-let cmds = [ help_cmd ; info_cmd ;
+let cmds = [ help_cmd ;
              policy_cmd ; remove_policy_cmd ; add_policy_cmd ;
-             destroy_cmd ; create_cmd ;
+             info_cmd ; get_cmd ; destroy_cmd ; create_cmd ;
              block_info_cmd ; block_create_cmd ; block_destroy_cmd ;
              console_cmd ; stats_cmd ; log_cmd ]
 

client/albatross_client_local.ml

@@ -57,6 +57,9 @@ let add_policy _ opt_socket name vms memory cpus block bridges =
 let info_ _ opt_socket name =
   jump opt_socket name (`Unikernel_cmd `Unikernel_info)
 
+let get _ opt_socket name =
+  jump opt_socket name (`Unikernel_cmd `Unikernel_get)
+
 let destroy _ opt_socket name =
   jump opt_socket name (`Unikernel_cmd `Unikernel_destroy)
 
@@ -131,6 +134,15 @@ let info_cmd =
   Term.(term_result (const info_ $ setup_log $ socket $ opt_vm_name $ tmpdir)),
   Term.info "info" ~doc ~man ~exits
 
+let get_cmd =
+  let doc = "retrieve a VM" in
+  let man =
+    [`S "DESCRIPTION";
+     `P "Downloads a VM."]
+  in
+  Term.(term_result (const get $ setup_log $ socket $ vm_name $ tmpdir)),
+  Term.info "get" ~doc ~man ~exits
+
 let policy_cmd =
   let doc = "active policies" in
   let man =
@@ -252,9 +264,9 @@ let default_cmd =
   Term.(ret (const help $ setup_log $ socket $ Term.man_format $ Term.choice_names $ Term.pure None)),
   Term.info "albatross_client_local" ~version ~doc ~man ~exits
 
-let cmds = [ help_cmd ; info_cmd ;
+let cmds = [ help_cmd ;
              policy_cmd ; remove_policy_cmd ; add_policy_cmd ;
-             destroy_cmd ; create_cmd ;
+             info_cmd ; get_cmd ; destroy_cmd ; create_cmd ;
              block_info_cmd ; block_create_cmd ; block_destroy_cmd ;
              console_cmd ;
              stats_subscribe_cmd ; stats_add_cmd ; stats_remove_cmd ; log_cmd ]

command-line/albatross_cli.ml

@@ -60,8 +60,29 @@ type exit_status =
 
 let output_result ((_, reply) as wire) =
   match reply with
-  | `Success _ ->
+  | `Success s ->
     Logs.app (fun m -> m "%a" Vmm_commands.pp_wire wire);
+    begin match s with
+      | `Unikernels vms ->
+        List.iter (fun (name, cfg) ->
+            if Cstruct.len cfg.Unikernel.image > 0 then
+              let filename =
+                let ts = Ptime.to_rfc3339 (Ptime_clock.now ()) in
+                Fpath.(v (Filename.get_temp_dir_name ()) / Name.to_string name + ts)
+              in
+              let write data =
+                match Bos.OS.File.write filename data with
+                | Ok () -> Logs.app (fun m -> m "dumped image to %a" Fpath.pp filename)
+                | Error (`Msg msg) -> Logs.err (fun m -> m "failed to write image: %s" msg)
+              in
+              if cfg.Unikernel.compressed then
+                match Vmm_compress.uncompress (Cstruct.to_string cfg.Unikernel.image) with
+                | Ok blob -> write blob
+                | Error () -> Logs.err (fun m -> m "failed to uncompress unikernel image")
+              else
+                write (Cstruct.to_string cfg.Unikernel.image)) vms
+      | _ -> ()
+    end;
     Ok ()
   | `Data _ ->
     Logs.app (fun m -> m "%a" Vmm_commands.pp_wire wire);

provision/albatross_provision_request.ml

@@ -35,6 +35,8 @@ let add_policy _ name vms memory cpus block bridges =
 
 let info_ _ name = jump name (`Unikernel_cmd `Unikernel_info)
 
+let get _ name = jump name (`Unikernel_cmd `Unikernel_get)
+
 let destroy _ name =
   jump name (`Unikernel_cmd `Unikernel_destroy)
 
@@ -96,6 +98,15 @@ let info_cmd =
   Term.(term_result (const info_ $ setup_log $ opt_vm_name)),
   Term.info "info" ~doc ~man
 
+let get_cmd =
+  let doc = "retrieve a VM" in
+  let man =
+    [`S "DESCRIPTION";
+     `P "Downloads a VM."]
+  in
+  Term.(term_result (const get $ setup_log $ vm_name)),
+  Term.info "get" ~doc ~man ~exits
+
 let policy_cmd =
   let doc = "active policies" in
   let man =
@@ -199,9 +210,9 @@ let default_cmd =
   Term.(ret (const help $ setup_log $ Term.man_format $ Term.choice_names $ Term.pure None)),
   Term.info "albatross_provision_request" ~version ~doc ~man
 
-let cmds = [ help_cmd ; info_cmd ;
+let cmds = [ help_cmd ;
              policy_cmd ; remove_policy_cmd ; add_policy_cmd ;
-             destroy_cmd ; create_cmd ;
+             info_cmd ; get_cmd ; destroy_cmd ; create_cmd ;
              block_info_cmd ; block_create_cmd ; block_destroy_cmd ;
              console_cmd ; stats_cmd ; log_cmd ]
 

src/vmm_asn.ml

@@ -280,7 +280,7 @@ let log_event =
                                    (sequence2
                                       (required ~label:"name" utf8_string)
                                       (required ~label:"device" utf8_string))))))
-              (explicit 7 null)))
+              (explicit 7 null (* placeholder *) )))
 
 
 let log_cmd =
@@ -420,26 +420,33 @@ let unikernel_config =
 
 let unikernel_cmd =
   let f = function
-    | `C1 () -> `Unikernel_info
+    | `C1 `C1 () -> `Unikernel_info
-    | `C2 vm -> `Unikernel_create vm
+    | `C1 `C2 vm -> `Unikernel_create vm
-    | `C3 vm -> `Unikernel_force_create vm
+    | `C1 `C3 vm -> `Unikernel_force_create vm
-    | `C4 () -> `Unikernel_destroy
+    | `C1 `C4 () -> `Unikernel_destroy
-    | `C5 vm -> `Unikernel_create vm
+    | `C1 `C5 vm -> `Unikernel_create vm
-    | `C6 vm -> `Unikernel_force_create vm
+    | `C1 `C6 vm -> `Unikernel_force_create vm
+    | `C2 `C1 () -> `Unikernel_get
+    | `C2 `C2 () -> assert false (* placeholder *)
   and g = function
-    | `Unikernel_info -> `C1 ()
+    | `Unikernel_info -> `C1 (`C1 ())
-    | `Unikernel_create vm -> `C5 vm
+    | `Unikernel_create vm -> `C1 (`C5 vm)
-    | `Unikernel_force_create vm -> `C6 vm
+    | `Unikernel_force_create vm -> `C1 (`C6 vm)
-    | `Unikernel_destroy -> `C4 ()
+    | `Unikernel_destroy -> `C1 (`C4 ())
+    | `Unikernel_get -> `C2 (`C1 ())
   in
   Asn.S.map f g @@
-  Asn.S.(choice6
+  Asn.S.(choice2
-           (explicit 0 null)
+          (choice6
-           (explicit 1 v1_unikernel_config)
+             (explicit 0 null)
-           (explicit 2 v1_unikernel_config)
+             (explicit 1 v1_unikernel_config)
-           (explicit 3 null)
+             (explicit 2 v1_unikernel_config)
-           (explicit 4 unikernel_config)
+             (explicit 3 null)
-           (explicit 5 unikernel_config))
+             (explicit 4 unikernel_config)
+             (explicit 5 unikernel_config))
+          (choice2
+             (explicit 6 null)
+             (explicit 7 null (* placeholder *) )))
 
 let policy_cmd =
   let f = function

src/vmm_commands.ml

@@ -61,6 +61,7 @@ type unikernel_cmd = [
   | `Unikernel_create of Unikernel.config
   | `Unikernel_force_create of Unikernel.config
   | `Unikernel_destroy
+  | `Unikernel_get
 ]
 
 let pp_unikernel_cmd ppf = function
@@ -68,6 +69,7 @@ let pp_unikernel_cmd ppf = function
   | `Unikernel_create config -> Fmt.pf ppf "unikernel create %a" Unikernel.pp_config config
   | `Unikernel_force_create config -> Fmt.pf ppf "vm force create %a" Unikernel.pp_config config
   | `Unikernel_destroy -> Fmt.string ppf "unikernel destroy"
+  | `Unikernel_get -> Fmt.string ppf "unikernel get"
 
 type policy_cmd = [
   | `Policy_info

src/vmm_commands.mli

@@ -35,6 +35,7 @@ type unikernel_cmd = [
   | `Unikernel_create of Unikernel.config
   | `Unikernel_force_create of Unikernel.config
   | `Unikernel_destroy
+  | `Unikernel_get
 ]
 
 type policy_cmd = [

src/vmm_vmmd.ml

@@ -236,6 +236,13 @@ let handle_unikernel_cmd t id = function
       | _ ->
         Ok (t, `End (`Success (`Unikernels vms)))
     end
+  | `Unikernel_get ->
+    Logs.debug (fun m -> m "get %a" Name.pp id) ;
+    begin match Vmm_trie.find id t.resources.Vmm_resources.unikernels with
+      | None -> Error (`Msg "get: no unikernel found")
+      | Some u ->
+        Ok (t, `End (`Success (`Unikernels [ (id, u.Unikernel.config) ])))
+    end
   | `Unikernel_create vm_config -> Ok (t, `Create (id, vm_config))
   | `Unikernel_force_create vm_config ->
     begin