Verify devices with manifest

src/vmm_json.ml

@@ -16,6 +16,32 @@ let find_string_value k = function
     | Some (_, `String value) -> Ok value
     | _ -> Rresult.R.error_msgf "couldn't find %s in json dictionary" k
 
+
+let find_devices x =
+  let open Rresult in
+  let device dev =
+    find_string_value "name" dev >>= fun name ->
+    find_string_value "type" dev >>= fun typ ->
+    match typ with
+    | "BLOCK_BASIC" -> Ok (`Block name)
+    | "NET_BASIC" -> Ok (`Net name)
+    | _ -> Rresult.R.error_msgf "unknown device type %s in json" typ
+  in
+  match x with
+  | `Null | `Bool _ | `Float _ | `String _ | `A _ ->
+    Rresult.R.error_msg "couldn't find devices in json"
+  | `O dict ->
+    match List.find_opt (fun (key, _) -> String.equal key "devices") dict with
+    | Some (_, `A devices) ->
+      List.fold_left
+        (fun acc dev ->
+           acc >>= fun (block_devices, networks) ->
+           device dev >>= function
+           | `Block block -> Ok (block :: block_devices, networks)
+           | `Net net -> Ok (block_devices, (net, None) :: networks))
+        (Ok ([], [])) devices
+    | _ -> Rresult.R.error_msg "devices field is not array in json"
+
 let json_of_string src =
   let dec d = match Jsonm.decode d with
     | `Lexeme l -> l

src/vmm_unix.ml

@@ -201,6 +201,23 @@ let solo5_image_target image =
 
 let solo5_tender = function Spt -> "solo5-spt" | Hvt -> "solo5-hvt"
 
+let solo5_image_devices image =
+  check_solo5_cmd "solo5-elftool" >>= fun cmd ->
+  let cmd = Bos.Cmd.(cmd % "query-manifest" % p image) in
+  Bos.OS.Cmd.(run_out cmd |> out_string |> success) >>= fun s ->
+  R.error_to_msg ~pp_error:Jsonm.pp_error
+    (Vmm_json.json_of_string s) >>= fun data ->
+  Vmm_json.find_devices data
+
+let equal_blocks b1 b2 =
+  let open Astring in
+  String.Set.(equal (of_list b1) (of_list b2))
+
+let equal_networks n1 n2 =
+  let open Astring in
+  let n1 = List.map fst n1 and n2 = List.map fst n2 in
+  String.Set.(equal (of_list n1) (of_list n2))
+
 let prepare name vm =
   (match vm.Unikernel.typ with
    | `Solo5 ->
@@ -214,6 +231,11 @@ let prepare name vm =
   Bos.OS.File.write filename (Cstruct.to_string image) >>= fun () ->
   solo5_image_target filename >>= fun target ->
   check_solo5_cmd (solo5_tender target) >>= fun _ ->
+  solo5_image_devices filename >>= fun (block_devices, networks) ->
+  (if equal_blocks vm.Unikernel.block_devices block_devices then Ok ()
+   else R.error_msg "specified block device(s) does not match with manifest") >>= fun () ->
+  (if equal_networks vm.Unikernel.bridges networks then Ok ()
+   else R.error_msg "specified bridge(s) does not match with the manifest") >>= fun () ->
   let fifo = Name.fifo_file name in
   begin match fifo_exists fifo with
     | Ok true -> Ok ()

src/vmm_unix.mli

@@ -37,3 +37,6 @@ val dump : ?name:string -> Cstruct.t -> (unit, [> R.msg ]) result
 val restore : ?name:string -> unit -> (Cstruct.t, [> R.msg | `NoFile ]) result
 
 val vm_device : Unikernel.t -> (string, [> R.msg ]) result
+
+(* XXX: remove? *)
+val solo5_image_devices : Fpath.t -> (string list * (string * string option) list , [> R.msg]) result