diff --git a/command-line/albatross_cli.ml b/command-line/albatross_cli.ml index 6b125d8..c49a61f 100644 --- a/command-line/albatross_cli.ml +++ b/command-line/albatross_cli.ml @@ -82,15 +82,15 @@ let setup_log style_renderer level = let create_vm force image cpuid memory argv block_devices bridges compression restart_on_fail = let open Rresult.R.Infix in Bos.OS.File.read (Fpath.v image) >>| fun image -> - let image = match compression with - | 0 -> `Hvt_amd64, Cstruct.of_string image + let image, compressed = match compression with + | 0 -> Cstruct.of_string image, false | level -> let img = Vmm_compress.compress ~level image in - `Hvt_amd64_compressed, Cstruct.of_string img + Cstruct.of_string img, true and argv = match argv with [] -> None | xs -> Some xs and fail_behaviour = if restart_on_fail then `Restart else `Quit in - let config = Unikernel.{ cpuid ; memory ; block_devices ; bridges ; argv ; image ; fail_behaviour } in + let config = Unikernel.{ typ = `Solo5 ; compressed ; image ; fail_behaviour ; cpuid ; memory ; block_devices ; bridges ; argv } in if force then `Unikernel_force_create config else `Unikernel_create config let policy vms memory cpus block bridges = diff --git a/src/vmm_asn.ml b/src/vmm_asn.ml index 69f0aea..61f143f 100644 --- a/src/vmm_asn.ml +++ b/src/vmm_asn.ml @@ -50,22 +50,6 @@ let policy = (optional ~label:"block" int) (required ~label:"bridges" Asn.S.(sequence_of utf8_string))) -let image = - let f = function - | `C1 x -> `Hvt_amd64, x - | `C2 x -> `Hvt_arm64, x - | `C3 x -> `Hvt_amd64_compressed, x - and g = function - | `Hvt_amd64, x -> `C1 x - | `Hvt_arm64, x -> `C2 x - | `Hvt_amd64_compressed, x -> `C3 x - in - Asn.S.map f g @@ - Asn.S.(choice3 - (explicit 0 octet_string) - (explicit 1 octet_string) - (explicit 2 octet_string)) - let console_cmd = let f = function | `C1 () -> `Console_add @@ -282,6 +266,16 @@ let log_cmd = Asn.S.map f g @@ Asn.S.(sequence (single (optional ~label:"since" utc_time))) +let typ = + let f = function + | `C1 () -> `Solo5 + | `C2 () -> assert false + and g = function + | `Solo5 -> `C1 () + in + Asn.S.map f g @@ + Asn.S.(choice2 (explicit 0 null) (explicit 1 null)) + let fail_behaviour = let f = function | `C1 () -> `Quit @@ -297,21 +291,23 @@ let fail_behaviour = let unikernel_config = let open Unikernel in - let f (fail_behaviour, (image, (cpuid, (memory, (blocks, (bridges, argv)))))) = + let f (typ, (compressed, (image, (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 - { cpuid ; memory ; block_devices ; bridges ; image ; argv ; fail_behaviour } + { typ ; compressed ; image ; fail_behaviour ; cpuid ; memory ; block_devices ; bridges ; argv } and g vm = let bridges = match vm.bridges with [] -> None | xs -> Some xs and blocks = match vm.block_devices with [] -> None | xs -> Some xs in - (vm.fail_behaviour, (vm.image, (vm.cpuid, (vm.memory, (blocks, (bridges, vm.argv)))))) + (vm.typ, (vm.compressed, (vm.image, (vm.fail_behaviour, (vm.cpuid, (vm.memory, (blocks, (bridges, vm.argv)))))))) in Asn.S.(map f g @@ sequence @@ - (required ~label:"fail behaviour" (explicit 3 fail_behaviour)) - @ (required ~label:"image" image) - @ (required ~label:"cpu" int) + (required ~label:"typ" typ) + @ (required ~label:"compressed" bool) + @ (required ~label:"image" octet_string) + @ (required ~label:"fail behaviour" fail_behaviour) + @ (required ~label:"cpuid" int) @ (required ~label:"memory" int) @ (optional ~label:"blocks" (explicit 0 (sequence_of utf8_string))) @ (optional ~label:"bridges" (explicit 1 (sequence_of utf8_string))) diff --git a/src/vmm_core.ml b/src/vmm_core.ml index e3a8911..85b1019 100644 --- a/src/vmm_core.ml +++ b/src/vmm_core.ml @@ -151,12 +151,10 @@ module Policy = struct end module Unikernel = struct - type typ = [ `Hvt_amd64 | `Hvt_arm64 | `Hvt_amd64_compressed ] + type typ = [ `Solo5 ] let pp_typ ppf = function - | `Hvt_amd64 -> Fmt.pf ppf "hvt-amd64" - | `Hvt_amd64_compressed -> Fmt.pf ppf "hvt-amd64-compressed" - | `Hvt_arm64 -> Fmt.pf ppf "hvt-arm64" + | `Solo5 -> Fmt.pf ppf "solo5" type fail_behaviour = [ `Quit | `Restart ] @@ -164,26 +162,26 @@ module Unikernel = struct Fmt.string ppf (match f with `Quit -> "quit" | `Restart -> "restart") type config = { + typ : typ ; + compressed : bool ; + image : Cstruct.t ; + fail_behaviour : fail_behaviour; cpuid : int ; memory : int ; block_devices : string list ; bridges : string list ; - image : typ * Cstruct.t ; argv : string list option ; - fail_behaviour : fail_behaviour; } - let pp_image ppf (typ, blob) = - let l = Cstruct.len blob in - Fmt.pf ppf "%a: %d bytes" pp_typ typ l - let pp_config ppf (vm : config) = - Fmt.pf ppf "fail behaviour %a, cpu %d, %d MB memory, block devices %a@ bridge %a, image %a, argv %a" + Fmt.pf ppf "typ %a@ compression %B image %d bytes@ fail behaviour %a@ cpu %d@ %d MB memory@ block devices %a@ bridge %a@ argv %a" + pp_typ vm.typ + vm.compressed + (Cstruct.len vm.image) pp_fail_behaviour vm.fail_behaviour vm.cpuid vm.memory Fmt.(list ~sep:(unit ", ") string) vm.block_devices Fmt.(list ~sep:(unit ", ") string) vm.bridges - pp_image vm.image Fmt.(option ~none:(unit "no") (list ~sep:(unit " ") string)) vm.argv type t = { diff --git a/src/vmm_core.mli b/src/vmm_core.mli index 37049f5..cc5dfd6 100644 --- a/src/vmm_core.mli +++ b/src/vmm_core.mli @@ -55,23 +55,23 @@ module Policy : sig end module Unikernel : sig - type typ = [ `Hvt_amd64 | `Hvt_amd64_compressed | `Hvt_arm64 ] + type typ = [ `Solo5 ] val pp_typ : typ Fmt.t type fail_behaviour = [ `Quit | `Restart ] type config = { - cpuid : int; - memory : int; - block_devices : string list; - bridges : string list; - image : typ * Cstruct.t; - argv : string list option; + typ : typ ; + compressed : bool ; + image : Cstruct.t ; fail_behaviour : fail_behaviour; + cpuid : int ; + memory : int ; + block_devices : string list ; + bridges : string list ; + argv : string list option ; } - val pp_image : (typ * Cstruct.t) Fmt.t - val pp_config : config Fmt.t type t = { diff --git a/src/vmm_unix.ml b/src/vmm_unix.ml index b3cc55e..6ef8910 100644 --- a/src/vmm_unix.ml +++ b/src/vmm_unix.ml @@ -125,14 +125,15 @@ let destroy_tap tapname = | x -> Error (`Msg ("unsupported operating system " ^ x)) let prepare name vm = - (match vm.Unikernel.image with - | `Hvt_amd64, blob -> Ok blob - | `Hvt_amd64_compressed, blob -> - begin match Vmm_compress.uncompress (Cstruct.to_string blob) with - | Ok blob -> Ok (Cstruct.of_string blob) - | Error () -> Error (`Msg "failed to uncompress") - end - | `Hvt_arm64, _ -> Error (`Msg "no amd64 hvt image found")) >>= fun image -> + (match vm.Unikernel.typ with + | `Solo5 -> + if vm.Unikernel.compressed then + begin match Vmm_compress.uncompress (Cstruct.to_string vm.Unikernel.image) with + | Ok blob -> Ok (Cstruct.of_string blob) + | Error () -> Error (`Msg "failed to uncompress") + end + else + Ok vm.Unikernel.image) >>= fun image -> let fifo = Name.fifo_file name in (match fifo_exists fifo with | Ok true -> Ok ()