Merge pull request 'solo5-manifest' (#67) from solo5-manifest into main

Reviewed-on: https://git.robur.io/robur/builder-web/pulls/67

builder-web.opam

@@ -50,6 +50,8 @@ depends: [
   "modulectomy"
   "opam-graph"
   "tar"
+  "owee"
+  "solo5-elftool"
 ]
 
 synopsis: "Web interface for builder"

lib/builder_web.ml

@@ -275,11 +275,16 @@ let add_routes datadir configdir =
   in
 
   let job_build req =
+    let datadir = Dream.global datadir_global req in
     let job_name = Dream.param "job" req
     and build = Dream.param "build" req in
     get_uuid build >>= fun uuid ->
     Dream.sql req (fun conn ->
         Model.build uuid conn >>= fun (build_id, build) ->
+        (match build.Builder_db.Build.main_binary with
+         | Some main_binary ->
+           Model.build_artifact_by_id main_binary conn |> Lwt_result.map Option.some
+         | None -> Lwt_result.return None) >>= fun main_binary ->
         Model.build_artifacts build_id conn >>= fun artifacts ->
         Model.builds_with_same_input_and_same_main_binary build_id conn >>= fun same_input_same_output ->
         Model.builds_with_different_input_and_same_main_binary build_id conn >>= fun different_input_same_output ->
@@ -287,15 +292,21 @@ let add_routes datadir configdir =
         Model.latest_successful_build build.job_id (Some build.Builder_db.Build.platform) conn >>= fun latest ->
         Model.next_successful_build_different_output build_id conn >>= fun next ->
         Model.previous_successful_build_different_output build_id conn >|= fun previous ->
-        (build, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest, next, previous)
+        (build, main_binary, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest, next, previous)
       )
     |> if_error "Error getting job build"
       ~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e))
-    >>= fun (build, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest, next, previous) ->
+    >>= fun (build, main_binary, artifacts, same_input_same_output, different_input_same_output, same_input_different_output, latest, next, previous) ->
+    (match main_binary with
+     | Some main_binary -> Model.solo5_manifest datadir main_binary
+     | None -> Lwt_result.return None)
+    |> if_error "Error getting solo5 manifest" >>= fun solo5_manifest ->
     Views.Job_build.make
       ~name:job_name
       ~build
       ~artifacts
+      ~main_binary
+      ~solo5_manifest
       ~same_input_same_output
       ~different_input_same_output
       ~same_input_different_output

lib/dune

@@ -6,6 +6,8 @@
   opamdiff ptime.clock.os omd tar
   modulectomy
   opam-graph
+  owee
+  solo5-elftool
   )
  (flags (:standard))
  )

lib/model.ml

@@ -50,6 +50,12 @@ let build_artifacts build (module Db : CONN) =
   Db.collect_list Builder_db.Build_artifact.get_all_by_build build >|=
   List.map snd
 
+let solo5_manifest datadir file =
+  try
+    let buf = Owee_buf.map_binary Fpath.(to_string (datadir // file.Builder_db.localpath)) in
+    Lwt.return (Solo5_elftool.query_manifest buf |> Result.map Option.some)
+  with Owee_buf.Invalid_format _ -> Lwt_result.return None
+
 let platforms_of_job id (module Db : CONN) =
   Db.collect_list Builder_db.Build.get_platforms_for_job id
 

lib/model.mli

@@ -21,6 +21,9 @@ val build_artifact_data : Fpath.t -> Builder_db.file ->
 val build_artifacts : [`build] Builder_db.id -> Caqti_lwt.connection ->
   (Builder_db.file list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
 
+val solo5_manifest : Fpath.t -> Builder_db.file ->
+  (Solo5_elftool.mft option, [> `Msg of string ]) result Lwt.t
+
 val platforms_of_job : [`job] Builder_db.id -> Caqti_lwt.connection ->
   (string list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
 

lib/views.ml

@@ -431,17 +431,42 @@ module Job_build = struct
     in
     List.exists check artifacts
 
-  let make_artifacts ~artifacts =
+  let make_artifacts ~artifacts ~main_binary ~solo5_manifest =
+    let solo5_devices solo5_manifest =
+      let pp_devices =
+        let pp_device_name ppf = function
+          | Solo5_elftool.Dev_block_basic name | Solo5_elftool.Dev_net_basic name ->
+            Fmt.pf ppf "%S" name
+        in
+        Fmt.(list ~sep:(any ", ") pp_device_name)
+      in
+      match
+        List.partition (function Solo5_elftool.Dev_block_basic _ -> true | _ -> false)
+          solo5_manifest.Solo5_elftool.entries
+      with
+      | [], [] -> [txtf "with no devices in solo5 manifest"]
+      | (_::_) as block_devices, [] ->
+        [txtf "with block devices %a" pp_devices block_devices]
+      | [], ((_::_) as net_devices) ->
+        [txtf "with net devices %a" pp_devices net_devices]
+      | block_devices, net_devices ->
+        [txtf "with block devices %a, and net devices %a"
+           pp_devices block_devices pp_devices net_devices]
+    in
     let aux (file:Builder_db.file) =
       let (`Hex sha256_hex) = Hex.of_cstruct file.sha256 in
       [
         H.dt [
           H.a ~a:H.[Fmt.kstr a_href "f/%a" Fpath.pp file.filepath]
             [H.code [txtf "%a" Fpath.pp file.filepath]] ];
-        H.dd [
-          H.code [H.txt "SHA256:"; H.txt sha256_hex];
-          txtf " (%a)" Fmt.byte_size file.size;
-        ];
+        H.dd ([
+            H.code [H.txt "SHA256:"; H.txt sha256_hex];
+            txtf " (%a)" Fmt.byte_size file.size;
+          ] @
+            match main_binary, solo5_manifest with
+            | Some main_binary, Some solo5_manifest when main_binary = file ->
+              (H.br () :: solo5_devices solo5_manifest)
+            | _ -> []);
       ]
     in
     [
@@ -539,6 +564,8 @@ module Job_build = struct
       ~delta
       ~(build:Builder_db.Build.t)
       ~artifacts
+      ~main_binary
+      ~solo5_manifest
       ~same_input_same_output
       ~different_input_same_output
       ~same_input_different_output
@@ -563,7 +590,7 @@ module Job_build = struct
         ]
       ];
     ]
-    @ make_artifacts ~artifacts
+    @ make_artifacts ~artifacts ~main_binary ~solo5_manifest
     @ make_reproductions
       ~name
       ~build
@@ -623,6 +650,8 @@ module Job_build = struct
       ~name
       ~(build:Builder_db.Build.t)
       ~artifacts
+      ~main_binary
+      ~solo5_manifest
       ~same_input_same_output
       ~different_input_same_output
       ~same_input_different_output
@@ -636,6 +665,8 @@ module Job_build = struct
         ~delta
         ~build
         ~artifacts
+        ~main_binary
+        ~solo5_manifest
         ~same_input_same_output
         ~different_input_same_output
         ~same_input_different_output