cleanups
This commit is contained in:
parent
811f3abc50
commit
a08f35ee5e
|
@ -103,7 +103,7 @@ let strings_of_cstruct, strings_to_cstruct =
|
||||||
|
|
||||||
let string_of_cstruct, string_to_cstruct = projections_of Asn.S.utf8_string
|
let string_of_cstruct, string_to_cstruct = projections_of Asn.S.utf8_string
|
||||||
|
|
||||||
let policy_obj =
|
let policy =
|
||||||
let f (cpuids, vms, memory, block, bridges) =
|
let f (cpuids, vms, memory, block, bridges) =
|
||||||
let bridges = match bridges with
|
let bridges = match bridges with
|
||||||
| xs ->
|
| xs ->
|
||||||
|
@ -127,13 +127,6 @@ let policy_obj =
|
||||||
(optional ~label:"block" int)
|
(optional ~label:"block" int)
|
||||||
(required ~label:"bridges" Asn.S.(sequence_of bridge)))
|
(required ~label:"bridges" Asn.S.(sequence_of bridge)))
|
||||||
|
|
||||||
let policy_of_cstruct, policy_to_cstruct =
|
|
||||||
let c = Asn.codec Asn.der policy_obj in
|
|
||||||
((fun cs -> match Asn.decode c cs with
|
|
||||||
| Ok x -> Ok x
|
|
||||||
| Error (`Parse msg) -> Error (`Msg msg)),
|
|
||||||
Asn.encode c)
|
|
||||||
|
|
||||||
let image =
|
let image =
|
||||||
let f = function
|
let f = function
|
||||||
| `C1 x -> `Hvt_amd64, x
|
| `C1 x -> `Hvt_amd64, x
|
||||||
|
@ -564,7 +557,7 @@ let policy_cmd =
|
||||||
Asn.S.map f g @@
|
Asn.S.map f g @@
|
||||||
Asn.S.(choice3
|
Asn.S.(choice3
|
||||||
(explicit 0 null)
|
(explicit 0 null)
|
||||||
(explicit 1 policy_obj)
|
(explicit 1 policy)
|
||||||
(explicit 2 null))
|
(explicit 2 null))
|
||||||
|
|
||||||
let version =
|
let version =
|
||||||
|
@ -688,7 +681,7 @@ let wire =
|
||||||
(explicit 2 (sequence_of
|
(explicit 2 (sequence_of
|
||||||
(sequence2
|
(sequence2
|
||||||
(required ~label:"name" (sequence_of utf8_string))
|
(required ~label:"name" (sequence_of utf8_string))
|
||||||
(required ~label:"policy" policy_obj))))
|
(required ~label:"policy" policy))))
|
||||||
(explicit 3 (sequence_of
|
(explicit 3 (sequence_of
|
||||||
(sequence2
|
(sequence2
|
||||||
(required ~label:"name" (sequence_of utf8_string))
|
(required ~label:"name" (sequence_of utf8_string))
|
||||||
|
|
|
@ -139,13 +139,6 @@ val strings_to_cstruct : string list -> Cstruct.t
|
||||||
encoded [buffer] or an error. *)
|
encoded [buffer] or an error. *)
|
||||||
val strings_of_cstruct : Cstruct.t -> (string list, [> `Msg of string ]) result
|
val strings_of_cstruct : Cstruct.t -> (string list, [> `Msg of string ]) result
|
||||||
|
|
||||||
(** [policy_to_cstruct xs] is the DER encoded policy. *)
|
|
||||||
val policy_to_cstruct : Vmm_core.policy -> Cstruct.t
|
|
||||||
|
|
||||||
(** [policy_of_cstruct buffer] is either a decoded policy of the DER
|
|
||||||
encoded [buffer] or an error. *)
|
|
||||||
val policy_of_cstruct : Cstruct.t -> (Vmm_core.policy * Cstruct.t, [> `Msg of string ]) result
|
|
||||||
|
|
||||||
(** {1 Decoding functions} *)
|
(** {1 Decoding functions} *)
|
||||||
|
|
||||||
(** [contains_vm cert] is [true] if the certificate contains a virtual machine image. *)
|
(** [contains_vm cert] is [true] if the certificate contains a virtual machine image. *)
|
||||||
|
|
|
@ -46,7 +46,6 @@ let log t id event =
|
||||||
({ t with log_counter }, `Log (header, `Command (`Log_cmd data)))
|
({ t with log_counter }, `Log (header, `Command (`Log_cmd data)))
|
||||||
|
|
||||||
let handle_create t hdr vm_config =
|
let handle_create t hdr vm_config =
|
||||||
(* TODO fix (remove field?) *)
|
|
||||||
let name = hdr.Vmm_asn.id in
|
let name = hdr.Vmm_asn.id in
|
||||||
(match Vmm_resources.find_vm t.resources name with
|
(match Vmm_resources.find_vm t.resources name with
|
||||||
| Some _ -> Error (`Msg "VM with same name is already running")
|
| Some _ -> Error (`Msg "VM with same name is already running")
|
||||||
|
@ -60,9 +59,11 @@ let handle_create t hdr vm_config =
|
||||||
Vmm_unix.prepare name vm_config >>= fun taps ->
|
Vmm_unix.prepare name vm_config >>= fun taps ->
|
||||||
Logs.debug (fun m -> m "prepared vm with taps %a" Fmt.(list ~sep:(unit ",@ ") string) taps) ;
|
Logs.debug (fun m -> m "prepared vm with taps %a" Fmt.(list ~sep:(unit ",@ ") string) taps) ;
|
||||||
(* TODO should we pre-reserve sth in t? *)
|
(* TODO should we pre-reserve sth in t? *)
|
||||||
let cons = `Console_add in
|
let cons_out =
|
||||||
let header = Vmm_asn.{ version = t.wire_version ; sequence = t.console_counter ; id = name } in
|
let header = Vmm_asn.{ version = t.wire_version ; sequence = t.console_counter ; id = name } in
|
||||||
Ok ({ t with console_counter = Int64.succ t.console_counter }, [ `Cons (header, `Command (`Console_cmd cons)) ],
|
(header, `Command (`Console_cmd `Console_add))
|
||||||
|
in
|
||||||
|
Ok ({ t with console_counter = Int64.succ t.console_counter }, [ `Cons cons_out ],
|
||||||
`Create (fun t task ->
|
`Create (fun t task ->
|
||||||
(* actually execute the vm *)
|
(* actually execute the vm *)
|
||||||
Vmm_unix.exec name vm_config taps >>= fun vm ->
|
Vmm_unix.exec name vm_config taps >>= fun vm ->
|
||||||
|
|
|
@ -13,5 +13,3 @@ val exec : id -> vm_config -> string list -> (vm, [> R.msg ]) result
|
||||||
val destroy : vm -> unit
|
val destroy : vm -> unit
|
||||||
|
|
||||||
val close_no_err : Unix.file_descr -> unit
|
val close_no_err : Unix.file_descr -> unit
|
||||||
|
|
||||||
val create_tap : string -> (string, [> R.msg ]) result
|
|
||||||
|
|
Loading…
Reference in a new issue