Update unikernel with new build from builds.robur.coop

albatross.ml

@@ -1,3 +1,7 @@
+let ( let* ) = Result.bind
+
+module String_set = Set.Make (String)
+
 module Make (T : Mirage_time.S) (P : Mirage_clock.PCLOCK) (S : Tcpip.Stack.V4V6) =
 struct
   module TLS = Tls_mirage.Make (S.TCP)
@@ -91,6 +95,94 @@ struct
             }
     | Error (`Msg err) -> Error err
 
+  let manifest_devices_match ~bridges ~block_devices binary =
+    let* mft : Solo5_elftool.mft = Solo5_elftool.query_manifest binary in
+    let req_bridges =
+      List.map (fun (name, _, _) -> name) bridges |> String_set.of_list
+    and req_block_devices =
+      List.map (fun (name, _, _) -> name) block_devices |> String_set.of_list
+    and mft_bridges =
+      List.filter_map
+        (function Solo5_elftool.Dev_net_basic name -> Some name | _ -> None)
+        mft.Solo5_elftool.entries
+      |> String_set.of_list
+    and mft_block_devices =
+      List.filter_map
+        (function Solo5_elftool.Dev_block_basic name -> Some name | _ -> None)
+        mft.Solo5_elftool.entries
+      |> String_set.of_list
+    in
+    let req_only_bridges = String_set.(diff req_bridges mft_bridges |> elements)
+    and mft_only_bridges = String_set.(diff mft_bridges req_bridges |> elements)
+    and req_only_blocks =
+      String_set.(diff req_block_devices mft_block_devices |> elements)
+    and mft_only_blocks =
+      String_set.(diff mft_block_devices req_block_devices |> elements)
+    in
+    match
+      (req_only_bridges, mft_only_bridges, req_only_blocks, mft_only_blocks)
+    with
+    | [], [], [], [] -> Ok ()
+    | req_only_bridges, [], [], [] ->
+        Error
+          (`Msg
+             ("Network devices missing from manifest: "
+             ^ String.concat "," req_only_bridges))
+    | [], mft_only_bridges, [], [] ->
+        Error
+          (`Msg
+             ("Network devices only in manifest: "
+             ^ String.concat "," mft_only_bridges))
+    | [], [], req_only_blocks, [] ->
+        Error
+          (`Msg
+             ("Block devices missing from manifest: "
+             ^ String.concat "," req_only_blocks))
+    | [], [], [], mft_only_blocks ->
+        Error
+          (`Msg
+             ("Block devices only in manifest: "
+             ^ String.concat "," mft_only_blocks))
+    | req_only_bridges, req_only_blocks, [], [] ->
+        Error
+          (`Msg
+             ("Network devices missing from manifest: "
+             ^ String.concat "," req_only_bridges
+             ^ " and block devices missing from manifest: "
+             ^ String.concat "," req_only_blocks))
+    | [], req_only_blocks, mft_only_bridges, [] ->
+        Error
+          (`Msg
+             ("Network devices only in manifest: "
+             ^ String.concat "," mft_only_bridges
+             ^ " and block devices missing from manifest: "
+             ^ String.concat "," req_only_blocks))
+    | [], [], mft_only_blocks, req_only_bridges ->
+        Error
+          (`Msg
+             ("Network devices missing from manifest: "
+             ^ String.concat "," req_only_bridges
+             ^ " and block devices only in manifest: "
+             ^ String.concat "," mft_only_blocks))
+    | req_only_bridges, [], mft_only_blocks, [] ->
+        Error
+          (`Msg
+             ("Network devices missing from manifest: "
+             ^ String.concat "," req_only_bridges
+             ^ " and block devices only in manifest: "
+             ^ String.concat "," mft_only_blocks))
+    | req_only_bridges, req_only_blocks, mft_only_bridges, mft_only_blocks ->
+        Error
+          (`Msg
+             ("Network devices missing from manifest: "
+             ^ String.concat "," req_only_bridges
+             ^ " and block devices missing from manifest: "
+             ^ String.concat "," req_only_blocks
+             ^ " and network devices only in manifest: "
+             ^ String.concat "," mft_only_bridges
+             ^ " and block devices only in manifest: "
+             ^ String.concat "," mft_only_blocks))
+
   let key_ids exts pub issuer =
     let open X509 in
     let auth = (Some (Public_key.id issuer), General_name.empty, None) in

albatross_json.ml

@@ -298,3 +298,63 @@ let config_of_json str =
       bridges;
       argv;
     }
+
+let fail_behaviour_to_json fb =
+  match fb with
+  | `Quit -> `String "quit"
+  | `Restart (Some codes) ->
+      `Assoc
+        [
+          ("restart", `Bool true);
+          ( "exit_code",
+            `List
+              (List.map (fun code -> `Int code) (Vmm_core.IS.elements codes)) );
+        ]
+  | `Restart None -> `Assoc [ ("restart", `Bool true) ]
+
+let bridge_to_json (name, host_device, mac) =
+  match (host_device, mac) with
+  | None, None -> `String name
+  | Some host, None ->
+      `Assoc [ ("name", `String name); ("host_device", `String host) ]
+  | None, Some mac ->
+      `Assoc
+        [ ("name", `String name); ("mac", `String (Macaddr.to_string mac)) ]
+  | Some host, Some mac ->
+      `Assoc
+        [
+          ("name", `String name);
+          ("host_device", `String host);
+          ("mac", `String (Macaddr.to_string mac));
+        ]
+
+let block_device_to_json (name, host_device, sector_size) =
+  match (host_device, sector_size) with
+  | None, None -> `String name
+  | Some host, None ->
+      `Assoc [ ("name", `String name); ("host_device", `String host) ]
+  | None, Some sector_size ->
+      `Assoc [ ("name", `String name); ("sector_size", `Int sector_size) ]
+  | Some host, Some sector_size ->
+      `Assoc
+        [
+          ("name", `String name);
+          ("host_device", `String host);
+          ("sector_size", `Int sector_size);
+        ]
+
+let unikernel_info_to_json (unikernel : Vmm_core.Unikernel.info) =
+  `Assoc
+    ([
+       ("fail_behaviour", fail_behaviour_to_json unikernel.fail_behaviour);
+       ("cpuid", `Int unikernel.cpuid);
+       ("memory", `Int unikernel.memory);
+       ("network_interfaces", `List (List.map bridge_to_json unikernel.bridges));
+       ( "block_devices",
+         `List (List.map block_device_to_json unikernel.block_devices) );
+     ]
+    @
+    match unikernel.argv with
+    | Some args ->
+        [ ("arguments", `List (List.map (fun arg -> `String arg) args)) ]
+    | None -> [])

assets/main.js

@@ -920,11 +920,52 @@ async function updateToken(value) {
 			buttonLoading(tokenButton, false, "Update Token")
 		}
 	} catch (error) {
-		postAlert("bg-secondary-300", data.data);
+		postAlert("bg-secondary-300", error);
 		buttonLoading(tokenButton, false, "Update Token")
 	}
 }
 
+async function updateUnikernel(job, build, unikernel_name) {
+	const updateButton = document.getElementById("update-unikernel-button");
+	const unikernelArguments = document.getElementById("unikernel-arguments").value;
+	const argumentsToggle = document.getElementById("arguments-toggle").checked;
+	const molly_csrf = document.getElementById("molly-csrf").value;
+	if (argumentsToggle && !unikernelArguments) {
+		postAlert("bg-secondary-300", "You must give arguments for this build else switch 'Update the arguments for this build' off");
+		buttonLoading(updateButton, false, "Proceed to update")
+		return;
+	}
+	try {
+		buttonLoading(updateButton, true, "Updating...")
+		const response = await fetch("/api/unikernel/update", {
+			method: 'POST',
+			headers: {
+				"Content-Type": "application/json",
+			},
+			body: JSON.stringify(
+				{
+					"job": job,
+					"build": build,
+					"unikernel_name": unikernel_name,
+					"unikernel_arguments": argumentsToggle ? unikernelArguments : null,
+					"molly_csrf": molly_csrf
+				})
+		})
+		const data = await response.json();
+		if (data.status === 200) {
+			postAlert("bg-primary-300", "Unikernel updated succesfully");
+			setTimeout(() => window.location.reload(), 1000);
+			buttonLoading(updateButton, false, "Proceed to update")
+		} else {
+			postAlert("bg-secondary-300", data.data);
+			buttonLoading(updateButton, false, "Proceed to update")
+		}
+	} catch (error) {
+		postAlert("bg-secondary-300", error);
+		buttonLoading(updateButton, false, "Proceed to update")
+	}
+}
+
 function isValidName(s) {
 	const length = s.length;
 	if (length === 0 || length >= 64) return false;

config.ml

@@ -23,6 +23,9 @@ let mollymawk =
       package "duration";
       package ~min:"0.2.0" "ohex";
       package "http-mirage-client";
+      package "solo5-elftool" ~max:"0.4.0";
+      (* NOTE(reynir): Pin no-unix owee until solo5-elftool 0.4.0 is released *)
+      package "owee" ~pin:"git+https://github.com/robur-coop/owee#unix-free";
     ]
   in
   main ~packages "Unikernel.Main"

unikernel.ml

@@ -1204,6 +1204,7 @@ struct
                                               ~content:
                                                 (Unikernel_update
                                                  .unikernel_update_layout
+                                                   ~unikernel_name:name
                                                    (unikernel_name, unikernel)
                                                    now build_comparison)
                                               ~icon:"/images/robur.png" ())
@@ -1240,6 +1241,122 @@ struct
                                     ~api_meth:false `Internal_server_error reqd
                                     ()))))))
 
+  let process_unikernel_update ~unikernel_name ~job ~build
+      (unikernel_cfg : Vmm_core.Unikernel.config) (user : User_model.user)
+      albatross http_client reqd =
+    Builder_web.send_request http_client
+      ("/job/" ^ job ^ "/build/" ^ build ^ "/main-binary")
+    >>= function
+    | Error (`Msg err) ->
+        Logs.err (fun m ->
+            m
+              "builds.robur.coop: Error while fetching the binary of %s with \
+               error: %s"
+              unikernel_name err);
+        Middleware.http_response reqd ~title:"Error"
+          ~data:
+            (`String
+               ("An error occured while fetching the binary from \
+                 builds.robur.coop with error " ^ err))
+          `Internal_server_error
+    | Ok image -> (
+        match
+          Albatross.manifest_devices_match ~bridges:unikernel_cfg.bridges
+            ~block_devices:unikernel_cfg.block_devices image
+        with
+        | Error (`Msg err) ->
+            Middleware.http_response reqd ~title:"Error"
+              ~data:(`String ("Manifest mismatch: " ^ err))
+              `Bad_request
+        | Ok () -> (
+            let unikernel_config = { unikernel_cfg with image } in
+            Albatross.query albatross ~domain:user.name ~name:unikernel_name
+              (`Unikernel_cmd (`Unikernel_force_create unikernel_config))
+            >>= function
+            | Error msg ->
+                Logs.err (fun m -> m "Error querying albatross: %s" msg);
+                Middleware.http_response reqd ~title:"Error"
+                  ~data:(`String ("Error querying albatross: " ^ msg))
+                  `Internal_server_error
+            | Ok (_hdr, res) -> (
+                match Albatross_json.res res with
+                | Error (`String err) ->
+                    Middleware.http_response reqd ~title:"Error"
+                      ~data:(`String (String.escaped err))
+                      `Internal_server_error
+                | Ok res ->
+                    Logs.err (fun m ->
+                        m "%s has been updated succesfully with result: %s"
+                          unikernel_name
+                          (Yojson.Basic.to_string res));
+                    Middleware.http_response reqd ~title:"Error"
+                      ~data:
+                        (`String
+                           (unikernel_name
+                          ^ " has been updated to the latest build."))
+                      `OK)))
+
+  let unikernel_update albatross reqd http_client ~json_dict
+      (user : User_model.user) =
+    match
+      Utils.Json.
+        ( get "job" json_dict,
+          get "build" json_dict,
+          get "unikernel_name" json_dict,
+          get "unikernel_arguments" json_dict )
+    with
+    | ( Some (`String job),
+        Some (`String build),
+        Some (`String unikernel_name),
+        arguments ) -> (
+        match Utils.Json.string_or_none "unikernel_arguments" arguments with
+        | Error (`Msg err) ->
+            Middleware.http_response reqd
+              ~title:"Error with Unikernel Arguments Json"
+              ~data:
+                (`String ("Could not get the unikernel arguments json: " ^ err))
+              `OK
+        | Ok None -> (
+            user_unikernel albatross ~user_name:user.name ~unikernel_name
+            >>= fun unikernel_info ->
+            match unikernel_info with
+            | Error err ->
+                Middleware.redirect_to_error
+                  ~data:
+                    (`String
+                       ("An error occured while fetching " ^ unikernel_name
+                      ^ " from albatross with error " ^ err))
+                  ~title:"Albatross Error" ~api_meth:false
+                  `Internal_server_error reqd ()
+            | Ok (_, unikernel) -> (
+                match
+                  Albatross_json.(
+                    unikernel_info_to_json unikernel
+                    |> Yojson.Basic.to_string |> config_of_json)
+                with
+                | Ok cfg ->
+                    process_unikernel_update ~unikernel_name ~job ~build cfg
+                      user albatross http_client reqd
+                | Error (`Msg err) ->
+                    Logs.warn (fun m -> m "Couldn't decode data %s" err);
+                    Middleware.http_response reqd ~title:"Error"
+                      ~data:(`String (String.escaped err))
+                      `Internal_server_error))
+        | Ok (Some args) -> (
+            match Albatross_json.config_of_json args with
+            | Ok cfg ->
+                process_unikernel_update ~unikernel_name ~job ~build cfg user
+                  albatross http_client reqd
+            | Error (`Msg err) ->
+                Logs.warn (fun m -> m "Couldn't decode data %s" err);
+                Middleware.http_response reqd ~title:"Error"
+                  ~data:(`String (String.escaped err))
+                  `Internal_server_error))
+    | _ ->
+        Middleware.http_response reqd ~title:"Error"
+          ~data:(`String "Couldn't find job or build in json. Received ")
+          `Bad_request
+
   let unikernel_destroy ~json_dict albatross reqd (user : User_model.user) =
     (* TODO use uuid in the future *)
     match Utils.Json.get "name" json_dict with
@@ -2125,6 +2242,11 @@ struct
                 authenticate store reqd
                   (unikernel_prepare_update !albatross store unikernel_name reqd
                      http_client))
+        | "/api/unikernel/update" ->
+            check_meth `POST (fun () ->
+                authenticate ~check_token:true ~check_csrf:true ~api_meth:true
+                  store reqd
+                  (unikernel_update !albatross reqd http_client))
         | _ ->
             let error =
               {