diff --git a/client/albatross_client_bistro.ml b/client/albatross_client_bistro.ml index 1423f25..ca36058 100644 --- a/client/albatross_client_bistro.ml +++ b/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 ] diff --git a/client/albatross_client_local.ml b/client/albatross_client_local.ml index d4a13fc..18ad269 100644 --- a/client/albatross_client_local.ml +++ b/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 ] diff --git a/command-line/albatross_cli.ml b/command-line/albatross_cli.ml index 31241fa..489271b 100644 --- a/command-line/albatross_cli.ml +++ b/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); diff --git a/provision/albatross_provision_request.ml b/provision/albatross_provision_request.ml index 75ed9b5..e340879 100644 --- a/provision/albatross_provision_request.ml +++ b/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 ] diff --git a/src/vmm_asn.ml b/src/vmm_asn.ml index 48ec44f..1057fda 100644 --- a/src/vmm_asn.ml +++ b/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 - | `C2 vm -> `Unikernel_create vm - | `C3 vm -> `Unikernel_force_create vm - | `C4 () -> `Unikernel_destroy - | `C5 vm -> `Unikernel_create vm - | `C6 vm -> `Unikernel_force_create vm + | `C1 `C1 () -> `Unikernel_info + | `C1 `C2 vm -> `Unikernel_create vm + | `C1 `C3 vm -> `Unikernel_force_create vm + | `C1 `C4 () -> `Unikernel_destroy + | `C1 `C5 vm -> `Unikernel_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_create vm -> `C5 vm - | `Unikernel_force_create vm -> `C6 vm - | `Unikernel_destroy -> `C4 () + | `Unikernel_info -> `C1 (`C1 ()) + | `Unikernel_create vm -> `C1 (`C5 vm) + | `Unikernel_force_create vm -> `C1 (`C6 vm) + | `Unikernel_destroy -> `C1 (`C4 ()) + | `Unikernel_get -> `C2 (`C1 ()) in Asn.S.map f g @@ - Asn.S.(choice6 - (explicit 0 null) - (explicit 1 v1_unikernel_config) - (explicit 2 v1_unikernel_config) - (explicit 3 null) - (explicit 4 unikernel_config) - (explicit 5 unikernel_config)) + Asn.S.(choice2 + (choice6 + (explicit 0 null) + (explicit 1 v1_unikernel_config) + (explicit 2 v1_unikernel_config) + (explicit 3 null) + (explicit 4 unikernel_config) + (explicit 5 unikernel_config)) + (choice2 + (explicit 6 null) + (explicit 7 null (* placeholder *) ))) let policy_cmd = let f = function diff --git a/src/vmm_commands.ml b/src/vmm_commands.ml index 35665ea..f62f184 100644 --- a/src/vmm_commands.ml +++ b/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 diff --git a/src/vmm_commands.mli b/src/vmm_commands.mli index 1c39ac5..9413cbe 100644 --- a/src/vmm_commands.mli +++ b/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 = [ diff --git a/src/vmm_vmmd.ml b/src/vmm_vmmd.ml index ad6c611..7b58f89 100644 --- a/src/vmm_vmmd.ml +++ b/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