Automatic viz migration on builder-web startup (#111)

Co-authored-by: rand00 <oth.rand@gmail.com>
Reviewed-on: https://git.robur.io/robur/builder-web/pulls/111
Co-authored-by: Reynir Björnsson <reynir@reynir.dk>
Co-committed-by: Reynir Björnsson <reynir@reynir.dk>

bin/builder_web_app.ml

@@ -78,7 +78,42 @@ let init_influx name data =
     in
     Lwt.async report
 
-let setup_app level influx port host datadir cachedir configdir =
+let run_batch_viz ~cachedir ~datadir ~configdir =
+  let open Rresult.R.Infix in
+  begin
+    let script = Fpath.(configdir / "batch-viz.sh") 
+    and script_log = Fpath.(cachedir / "batch-viz.log")
+    and viz_script = Fpath.(configdir / "upload-hooks" / "visualizations.sh") 
+    in
+    Bos.OS.File.exists script >>= fun script_exists ->
+    if not script_exists then begin
+      Logs.warn (fun m -> m "Didn't find %s" (Fpath.to_string script));
+      Ok ()
+    end else
+      let args = 
+        [ "--cache-dir=" ^ Fpath.to_string cachedir;
+          "--data-dir=" ^ Fpath.to_string datadir;
+          "--viz-script=" ^ Fpath.to_string viz_script ]
+        |> List.map (fun s -> "\"" ^ String.escaped s ^ "\"")
+        |> String.concat " "
+      in
+      (*> Note: The reason for appending, is that else a new startup could 
+          overwrite an existing running batch's log*)
+      (Fpath.to_string script ^ " " ^ args
+       ^ " 2>&1 >> " ^ Fpath.to_string script_log
+       ^ " &")
+      |> Sys.command 
+      |> ignore
+      |> Result.ok
+  end
+  |> function
+  | Ok () -> ()
+  | Error err ->
+    Logs.warn (fun m ->
+        m "Error while starting batch-viz.sh: %a"
+          Rresult.R.pp_msg err)
+
+let setup_app level influx port host datadir cachedir configdir run_batch_viz_flag =
   let dbpath = Printf.sprintf "%s/builder.sqlite3" datadir in
   let datadir = Fpath.v datadir in
   let cachedir =
@@ -86,6 +121,10 @@ let setup_app level influx port host datadir cachedir configdir =
   in
   let configdir = Fpath.v configdir in
   let () = init_influx "builder-web" influx in
+  let () =
+    if run_batch_viz_flag then
+      run_batch_viz ~cachedir ~datadir ~configdir
+  in
   match Builder_web.init dbpath datadir with
   | Error (#Caqti_error.load as e) ->
     Format.eprintf "Error: %a\n%!" Caqti_error.pp e;
@@ -140,19 +179,28 @@ let ip_port : (Ipaddr.V4.t * int) Arg.conv =
 
 let datadir =
   let doc = "data directory" in
-  Arg.(value & opt dir Builder_system.default_datadir & info [ "d"; "datadir" ] ~doc)
+  let docv = "DATA_DIR" in
+  Arg.(
+    value &
+    opt dir Builder_system.default_datadir &
+    info [ "d"; "datadir" ] ~doc ~docv
+  )
 
 let cachedir =
   let doc = "cache directory" in
+  let docv = "CACHE_DIR" in
   Arg.(
     value
     & opt (some ~none:"DATADIR/_cache" dir) None
-    & info [ "cachedir" ] ~doc
+    & info [ "cachedir" ] ~doc ~docv)
-  )
 
 let configdir =
   let doc = "config directory" in
-  Arg.(value & opt dir Builder_system.default_configdir & info [ "c"; "configdir" ] ~doc)
+  let docv = "CONFIG_DIR" in
+  Arg.(
+    value &
+    opt dir Builder_system.default_configdir &
+    info [ "c"; "configdir" ] ~doc ~docv)
 
 let port =
   let doc = "port" in
@@ -163,13 +211,25 @@ let host =
   Arg.(value & opt string "0.0.0.0" & info [ "h"; "host" ] ~doc)
 
 let influx =
-  let doc = "IP address and port (default: 8094) to report metrics to in influx line protocol" in
+  let doc = "IP address and port (default: 8094) to report metrics to \
-  Arg.(value & opt (some ip_port) None & info [ "influx" ] ~doc ~docv:"INFLUXHOST[:PORT]")
+             influx line protocol" in
+  Arg.(
+    value &
+    opt (some ip_port) None &
+    info [ "influx" ] ~doc ~docv:"INFLUXHOST[:PORT]")
+
+let run_batch_viz =
+  let doc = "Run CONFIG_DIR/batch-viz.sh on startup. \
+             Note that this is started in the background - so the user \
+             is in charge of not running several instances of this. A \
+             log is written to CACHE_DIR/batch-viz.log" in
+  Arg.(value & flag & info [ "run-batch-viz" ] ~doc)
+
 
 let () =
   let term =
     Term.(const setup_app $ Logs_cli.level () $ influx $ port $ host $ datadir $
-          cachedir $ configdir)
+          cachedir $ configdir $ run_batch_viz)
   in
   let info = Cmd.info "Builder web" ~doc:"Builder web" ~man:[] in
   Cmd.v info term

bin/visualizations/builder_viz.ml

@@ -1,175 +0,0 @@
-let src = Logs.Src.create "builder-viz" ~doc:"Builder_viz"
-module Log = (val Logs.src_log src : Logs.LOG)
-
-open Rresult
-
-let read_file file =
-  try
-    let fh = open_in file in
-    try
-      let content = really_input_string fh (in_channel_length fh) in
-      close_in_noerr fh ;
-      content
-    with _ ->
-      close_in_noerr fh;
-      invalid_arg ("Error reading file: " ^ file)
-  with _ -> invalid_arg ("Error opening file " ^ file)
-
-let print_treemap_html elf_path elf_size =
-  let open Modulectomy in
-  let infos =
-    elf_path
-    |> Elf.get
-    |> Result.map_error (fun _ -> R.msg "Invalid ELF file")
-    |> R.failwith_error_msg
-  in
-  let info, excluded_minors =
-    let size, info =
-      infos
-      |> Info.import
-      |> Info.diff_size_tree
-    in
-    (*> Note: this heuristic fails if one has all subtrees of equal size*)
-    let node_big_enough subtree =
-      match Info.(subtree.T.value.size) with
-      | None -> true
-      | Some subtree_size ->
-        let pct = Int64.(to_float subtree_size /. to_float size) in
-        pct > 0.004
-    in
-    info
-    |> Info.prefix_filename
-    |> Info.cut 2
-    |> Info.partition_subtrees node_big_enough
-  in
-  let scale_chunks =
-    let excluded_minors_size =
-      excluded_minors
-      |> List.map Info.compute_area
-      |> List.fold_left Int64.add 0L
-    in
-    [
-      "Smaller excluded entries", excluded_minors_size
-    ]
-  in
-  let override_css = {|
-    .treemap-module {
-      fill: rgb(60, 60, 87);
-    }
-    .treemap-functor > text, .treemap-module > text {
-      fill: bisque;
-    }
-  |}
-  in
-  info
-  |> Treemap.of_tree
-  |> Treemap.to_html_with_scale
-    ~binary_size:elf_size
-    ~scale_chunks
-    ~override_css
-  |> Tyxml.Html.pp () Format.std_formatter
-(* |> Treemap.svg
- * |> Fmt.to_to_string (Tyxml.Svg.pp ()) *)
-
-let print_dependencies_html file =
-  let module G = Opam_graph in
-  let switch = read_file file in
-  let data = OpamFile.SwitchExport.read_from_string switch in
-  let graph = G.Ui.dependencies ~transitive:false data in
-  let sharing_stats =
-    data
-    |> G.dependencies ~transitive:false
-    |> G.calc_sharing_stats in
-  let override_css = {|
-    .deps-svg-wrap {
-      background: rgb(60, 60, 87);
-    }
-  |}
-  in
-  let html = G.Render.Html.of_assoc ~override_css ~sharing_stats graph in
-  Format.printf "%a" G.Render.Html.pp html
-
-module Cmd_aux = struct
-
-  module Arg_aux = struct
-
-    let elf_path =
-      let doc = "The file-path of the debug-ELF to be analyzed" in
-      Cmdliner.Arg.(
-        required &
-        pos 0 (some file) None &
-        info ~doc ~docv:"DEBUG_ELF_PATH" []
-      )
-
-    let elf_size =
-      let doc = "The file-size of the stripped ELF file in bytes" in
-      Cmdliner.Arg.(
-        required &
-        pos 1 (some int) None &
-        info ~doc ~docv:"STRIPPED_ELF_SIZE" []
-      )
-
-    let opam_switch_path =
-      let doc = "The Opam-switch export file of the package to be analyzed" in
-      Cmdliner.Arg.(
-        required &
-        pos 0 (some file) None &
-        info ~doc ~docv:"SWITCH_EXPORT_PATH" []
-      )
-
-  end
-
-  module Aux = struct
-
-    let help man_format cmds = function
-      | None -> `Help (man_format, None)
-      | Some cmd ->
-        if List.mem cmd cmds
-        then `Help (man_format, Some cmd)
-        else `Error (true, "Unknown command: " ^ cmd)
-
-  end
-
-  open Cmdliner
-
-  let treemap =
-    let doc = "Dump treemap SVG and CSS wrapped in HTML" in
-    let term = Term.(const print_treemap_html $ Arg_aux.elf_path $ Arg_aux.elf_size) in
-    let info = Cmd.info ~doc "treemap" in
-    Cmd.v info term
-
-  let dependencies =
-    let doc = "Dump opam dependencies SVG and CSS wrapped in HTML" in
-    let term = Term.(const print_dependencies_html $ Arg_aux.opam_switch_path) in
-    let info = Cmd.info ~doc "dependencies" in
-    Cmd.v info term
-
-  let help =
-    let topic =
-      let doc = "Command to get help on" in
-      Cmdliner.Arg.(value & pos 0 (some string) None & info ~doc ~docv:"COMMAND" [])
-    in
-    let doc = "Builder database help" in
-    let term = Term.(ret (const Aux.help $ Arg.man_format $ choice_names $ topic)) in
-    let info = Cmd.info ~doc "help" in
-    Cmd.v info term
-
-  let default_info, default_cmd =
-    let doc = "Builder database command" in
-    let term = Term.(ret (const Aux.help $ Arg.man_format $ choice_names $ const None)) in
-    let info = Cmd.info ~doc "builder-viz" in
-    info, term
-
-end
-
-let () =
-  let open Cmdliner in
-  Cmd.group
-    ~default:Cmd_aux.default_cmd Cmd_aux.default_info
-    [
-      Cmd_aux.help;
-      Cmd_aux.treemap;
-      Cmd_aux.dependencies;
-    ]
-  |> Cmd.eval
-  |> exit

bin/visualizations/dune

@@ -1,12 +0,0 @@
-(executable
- (name builder_viz)
- (public_name builder-viz)
- (libraries
-  tyxml bos caqti-lwt cmdliner rresult
-  builder_db
-  modulectomy
-  opam-graph
-  )
- (flags (:standard (-w -27-26)))
- )
-

lib/builder_web.ml

@@ -163,48 +163,140 @@ let routes ~datadir ~cachedir ~configdir =
     |> Lwt_result.ok
   in
 
-  let redirect_main_binary req =
+  let main_binary_of_uuid uuid db =
-    let job_name = Dream.param req "job"
+    Model.build uuid db
-    and build = Dream.param req "build" in
-    get_uuid build >>= fun uuid ->
-    Dream.sql req (Model.build uuid)
     |> if_error "Error getting job build"
       ~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e))
     >>= fun (_id, build) ->
     match build.Builder_db.Build.main_binary with
     | None -> Lwt_result.fail ("Resource not found", `Not_Found)
     | Some main_binary ->
-      Dream.sql req (Model.build_artifact_by_id main_binary)
+      Model.build_artifact_by_id main_binary db
-      |> if_error "Error getting main binary" >>= fun main_binary ->
+      |> if_error "Error getting main binary" 
+  in
+
+  let redirect_main_binary req =
+    let job_name = Dream.param req "job"
+    and build = Dream.param req "build" in
+    get_uuid build >>= fun uuid ->
+    Dream.sql req (main_binary_of_uuid uuid) >>= fun main_binary ->
     Dream.redirect req
       (Fmt.str "/job/%s/build/%a/f/%a" job_name Uuidm.pp uuid
          Fpath.pp main_binary.Builder_db.filepath)
     |> Lwt_result.ok
   in
 
-  let try_load_cached_visualization ~cachedir ~uuid typ =
+  let hash_viz_input ~uuid typ db =
-    let fn = match typ with
+    let open Builder_db in
+    let hex cstruct =
+      let `Hex hex_str = Hex.of_cstruct cstruct in
+      hex_str
+    in
+    main_binary_of_uuid uuid db >>= fun main_binary ->
+    Model.build uuid db
+    |> if_error "Error getting build" >>= fun (build_id, _build) ->
+    Model.build_artifacts build_id db
+    |> if_error "Error getting build artifacts" >>= fun artifacts ->
+    match typ with
+    | `Treemap ->
+      let debug_binary = 
+        let bin = Fpath.base main_binary.localpath in
+        List.find_opt
+          (fun p -> Fpath.(equal (bin + "debug") (base p.localpath)))
+          artifacts
+      in
+      begin
+        match debug_binary with
+        | None -> Lwt_result.fail ("Error getting debug-binary", `Not_Found)
+        | Some debug_binary ->
+          debug_binary.sha256
+          |> hex
+          |> Lwt_result.return
+      end 
+    | `Dependencies -> 
+      let opam_switch =
+        List.find_opt
+          (fun p -> Fpath.(equal (v "opam-switch") (base p.localpath)))
+          artifacts
+      in
+      match opam_switch with
+      | None -> Lwt_result.fail ("Error getting opam-switch", `Not_Found)
+      | Some opam_switch ->
+        opam_switch.sha256
+        |> hex
+        |> Lwt_result.return
+  in
+
+  let get_viz_version ~cachedir ~viz_typ_str =
+    Lwt.return (Bos.OS.Dir.contents cachedir) >>= fun versioned_dirs ->
+    let max_cached_version = 
+      let viz_typ_str = viz_typ_str ^ "_" in
+      versioned_dirs
+      |> List.filter_map (fun versioned_dir ->
+          let dir_str = Fpath.filename versioned_dir in
+          if not (String.starts_with ~prefix:viz_typ_str dir_str) then
+            None
+          else
+            try
+              String.(sub dir_str
+                        (length viz_typ_str)
+                        (length dir_str - length viz_typ_str))
+              |> int_of_string
+              |> Option.some
+            with Failure _ ->
+              Logs.warn (fun m ->
+                  m "Failed to read visualization-version from directory: '%s'"
+                    (Fpath.to_string versioned_dir));
+              None
+        )
+      |> List.fold_left Int.max (-1)
+    in
+    if max_cached_version = -1 then
+      Lwt_result.fail @@
+      `Msg (Fmt.str "Couldn't find any visualization-version of %s" viz_typ_str)
+    else
+      Lwt_result.return max_cached_version
+  in
+  
+  let try_load_cached_visualization ~cachedir ~uuid typ db =
+    let viz_typ_str = match typ with
       | `Treemap -> "treemap"
       | `Dependencies -> "dependencies"
     in
-    let path = Fpath.(cachedir / Uuidm.to_string uuid + fn + "html") in
+    get_viz_version ~cachedir ~viz_typ_str
-    Lwt.return (Bos.OS.File.exists path) >>= fun cached_file_exists ->
+    |> if_error "Error getting visualization version" >>= fun latest_viz_version ->
-    if not cached_file_exists then
+    hash_viz_input ~uuid typ db >>= fun viz_input_hash ->
-      Lwt_result.fail (`Msg "Visualization does not exist")
+    let rec choose_versioned_viz_path current_version = 
+      let path = Fpath.(
+          cachedir
+          / Fmt.str "%s_%d" viz_typ_str current_version
+          / viz_input_hash + "html"
+        ) in
+      Lwt.return (Bos.OS.File.exists path) >>= fun path_exists ->
+      if path_exists then Lwt_result.return path else (
+        if current_version = 1 then
+          Lwt_result.fail (`Msg "There exist no version of the requested visualization")
         else 
+          choose_versioned_viz_path (pred current_version)
+      )
+    in
+    (choose_versioned_viz_path latest_viz_version
+     |> if_error "Error finding a version of the requested visualization")
+    >>= fun viz_path ->
     Lwt_result.catch (
       Lwt_io.with_file ~mode:Lwt_io.Input
-          (Fpath.to_string path)
+        (Fpath.to_string viz_path)
         Lwt_io.read
-      ) |> Lwt_result.map_err (fun exn -> `Msg (Printexc.to_string exn))
+    )
+    |> Lwt_result.map_err (fun exn -> `Msg (Printexc.to_string exn))
+    |> if_error "Error getting cached visualization"
   in
 
   let job_build_viz viz_typ req =
     let _job_name = Dream.param req "job"
     and build = Dream.param req "build" in
     get_uuid build >>= fun uuid ->
-    try_load_cached_visualization ~cachedir ~uuid viz_typ
+    Dream.sql req (try_load_cached_visualization ~cachedir ~uuid viz_typ)
-    |> if_error ~status:`Not_Found "Error getting cached visualization"
     >>= fun svg_html ->
     Lwt_result.ok (Dream.html svg_html)
   in

lib/dune

@@ -1,9 +1,18 @@
 (library
  (name builder_web)
  (libraries
-  builder builder_db
+  builder
-  dream tyxml bos duration hex caqti-lwt
+  builder_db
-  opamdiff ptime.clock.os omd tar
+  dream
+  tyxml
+  bos
+  duration
+  hex
+  caqti-lwt
+  opamdiff
+  ptime.clock.os
+  omd
+  tar
   owee
   solo5-elftool
   uri

lib/model.ml

@@ -414,40 +414,24 @@ let add_build
              r;
            e)) >>= function
   | None -> Lwt.return (Ok ())
-  | Some p ->
+  | Some main_binary ->
-    let main_binary = p.localpath
+    let time =
-    and `Hex sha256 = Hex.of_cstruct p.sha256
-    and uuid = Uuidm.to_string uuid
-    and time =
       let (y, m, d), ((hh, mm, ss), _) = Ptime.to_date_time start in
       Printf.sprintf "%04d%02d%02d%02d%02d%02d" y m d hh mm ss
+    and uuid = Uuidm.to_string uuid
     and job = job.name
     and platform = job.platform
-    and debug_binary =
+    and `Hex sha256 = Hex.of_cstruct main_binary.sha256
-      let bin = Fpath.base p.localpath in
-      List.find_opt
-        (fun p -> Fpath.(equal (bin + "debug") (base p.localpath)))
-        artifacts |>
-      Option.map (fun p -> p.localpath)
-    and opam_switch =
-      List.find_opt
-        (fun p -> Fpath.(equal (v "opam-switch") (base p.localpath)))
-        artifacts |>
-      Option.map (fun p -> p.localpath)
     in
     let fp_str p = Fpath.(to_string (datadir // p)) in
-    let opt_str ~prefix p =
-      Option.fold ~none:[] ~some:(fun p -> [ "--" ^ prefix ^ "=" ^ fp_str p ]) p
-    in
     let args =
       String.concat " "
         (List.map (fun s -> "\"" ^ String.escaped s ^ "\"")
-           ((opt_str ~prefix:"debug-binary" debug_binary) @
-            (opt_str ~prefix:"opam-switch" opam_switch) @
            [ "--build-time=" ^ time ; "--sha256=" ^ sha256 ; "--job=" ^ job ;
              "--uuid=" ^ uuid ; "--platform=" ^ platform ;
              "--cache-dir=" ^ Fpath.to_string cachedir ;
-              fp_str main_binary ]))
+             "--data-dir=" ^ Fpath.to_string datadir ;
+             fp_str main_binary.localpath ])
     in
     Log.debug (fun m -> m "executing hooks with %s" args);
     let dir = Fpath.(configdir / "upload-hooks") in

packaging/FreeBSD/create_package.sh

@@ -31,7 +31,6 @@ install -U $bdir/builder-web $libexecdir/builder-web
 
 install -U $bdir/builder-migrations $sbindir/builder-migrations
 install -U $bdir/builder-db $sbindir/builder-db
-install -U $bdir/builder-viz $sbindir/builder-viz
 
 # create +MANIFEST
 flatsize=$(find "$rootdir" -type f -exec stat -f %z {} + |

packaging/batch-viz.sh

@@ -1,7 +1,5 @@
 #!/bin/sh
 
-set -e
-
 prog_NAME=$(basename "${0}")
 
 warn()
@@ -9,6 +7,11 @@ warn()
     echo "${prog_NAME}: WARN: $*"
 }
 
+info()
+{
+    echo "${prog_NAME}: INFO: $*"
+}
+
 err()
 {
     echo "${prog_NAME}: ERROR: $*" 1>&2
@@ -23,37 +26,148 @@ die()
 usage()
 {
     cat <<EOM 1>&2
-usage: ${prog_NAME} [ OPTIONS ] DATADIR
+usage: ${prog_NAME} [ OPTIONS ] 
 Generates visualizations of all things
+    --data-dir=STRING
+        Path to the data directory.
+    --cache-dir=STRING
+        Optional path to the cache directory. Defaults to DATA_DIR/_cache
+    --viz-script=STRING
+        Optional path to the visualizations.sh script. Defaults to ./visualizations.sh
+    --ignore-done
+        Optional flag to force script to ignore '.done' files
 EOM
     exit 1
 }
 
-if [ $# -ne 1 ]; then
+CACHE_DIR=
+DATA_DIR=
+VISUALIZATIONS_CMD="./visualizations.sh"
+IGNORE_DONE="false"
+
+while [ $# -gt 0 ]; do
+    OPT="$1"
+
+    case "${OPT}" in
+        --cache-dir=*)
+            CACHE_DIR="${OPT##*=}"
+            ;;
+        --data-dir=*)
+            DATA_DIR="${OPT##*=}"
+            ;;
+        --viz-script=*)
+            VISUALIZATIONS_CMD="${OPT##*=}"
+            ;;
+        --ignore-done)
+            IGNORE_DONE="true"
+            ;;
+        --*)
+            warn "Ignoring unknown option: '${OPT}'"
+            ;;
+        *)
+            err "Unknown option: '${OPT}'"
             usage
-fi
+            ;;
-
+    esac
-DIR="${1}"
+    shift
-
-CACHE="${DIR}/_cache"
-
-for i in $(find "${DIR}" -type f -path \*output/bin\*); do
-    UUID=$(echo "${i}" | rev | cut -d '/' -f 4 | rev)
-    ARGS="--cache-dir="${CACHE}" --uuid="${UUID}""
-    FILE=$(basename "${i}")
-    DIR=$(dirname "${i}")
-    PDIR="${DIR}/.."
-    ARGS2=
-    if [ -f "${PDIR}/${FILE}.debug" ]; then
-        ARGS2="${ARGS2} --debug-binary="${PDIR}/${FILE}.debug""
-    fi
-    if [ -f "${PDIR}/opam-switch" ]; then
-        ARGS2="${ARGS2} --opam-switch="${PDIR}/opam-switch""
-    fi
-    if [ -z "${ARGS2}" ]; then
-        echo "neither debug nor opam switch found for ${UUID}"
-    else
-        ARGS="${ARGS}${ARGS2} ${i}"
-        ./visualizations.sh ${ARGS}
-    fi
 done
+
+[ -z "$DATA_DIR" ] && die "The --data-dir option must be specified"
+
+DB="${DATA_DIR}/builder.sqlite3"
+[ ! -e "$DB" ] && die "The database doesn't exist: '$DB'"
+
+DB_VERSION="$(sqlite3 "$DB" "PRAGMA user_version;")"
+[ -z "$DB_VERSION" ] && die "Couldn't read database version from '$DB'"
+[ "$DB_VERSION" -lt 16 ] && die "The database version should be >= 16. It is '$DB_VERSION'"
+
+APP_ID="$(sqlite3 "$DB" "PRAGMA application_id;")"
+[ -z "$APP_ID" ] && die "Couldn't read application-id from '$DB'"
+[ "$APP_ID" -ne 1234839235 ] && die "The application-id should be = 1234839235. It is '$APP_ID'"
+
+echo 
+echo "-----------------------------------------------------------------------------"
+info "Starting batch creation of visualizations: $(date)"
+
+if [ -z "$CACHE_DIR" ]; then
+    CACHE_DIR="${DATA_DIR}/_cache"
+    info "Defaulting --cache-dir to '$CACHE_DIR'"
+fi
+if [ ! -d "${CACHE_DIR}" ]; then
+    info "Cache directory '$CACHE_DIR' doesn't exist, so it will be made"
+    if ! mkdir "${CACHE_DIR}"; then
+        die "Couldn't make cache directory: '$CACHE_DIR'"
+    fi
+fi
+
+[ ! -e "${VISUALIZATIONS_CMD}" ] && die "'$VISUALIZATIONS_CMD' doesn't exist"
+if [ -f "${VISUALIZATIONS_CMD}" ] && [ -x "${VISUALIZATIONS_CMD}" ]; then :; else
+	die "'$VISUALIZATIONS_CMD' is not an executable"
+fi
+
+OPAM_GRAPH="opam-graph"
+MODULECTOMY="modulectomy"
+
+LATEST_TREEMAPVIZ_VERSION="$($MODULECTOMY --version)"
+[ $? -ne 0 ] && die "Couldn't get modulectomy version"
+LATEST_DEPENDENCIESVIZ_VERSION="$($OPAM_GRAPH --version)"
+[ $? -ne 0 ] && die "Couldn't get opam-graph version"
+
+TREEMAP_CACHE_DIR="${CACHE_DIR}/treemap_${LATEST_TREEMAPVIZ_VERSION}"
+DEPENDENCIES_CACHE_DIR="${CACHE_DIR}/dependencies_${LATEST_DEPENDENCIESVIZ_VERSION}"
+
+if
+    [ "${IGNORE_DONE}" = "false" ] && \
+    [ -f "${TREEMAP_CACHE_DIR}/.done" ] && \
+    [ -f "${DEPENDENCIES_CACHE_DIR}/.done" ]; then
+    info "Nothing to do"
+    exit 0
+fi
+
+ATTEMPTED_VIZS=0
+FAILED_VIZS=0
+
+for i in $(find "${DATA_DIR}" -type f -path \*output/bin\*); do
+    UUID=$(echo "${i}" | rev | cut -d '/' -f 4 | rev)
+    if ! "$VISUALIZATIONS_CMD" \
+         --data-dir="${DATA_DIR}" \
+         --cache-dir="${CACHE_DIR}" \
+         --uuid="${UUID}"
+    then
+        FAILED_VIZS=$((FAILED_VIZS + 1))
+    fi
+    ATTEMPTED_VIZS=$((ATTEMPTED_VIZS + 1))
+done
+
+if [ -n "$(ls -A "${TREEMAP_CACHE_DIR}")" ]; then
+    touch "${TREEMAP_CACHE_DIR}/.done"
+
+    V=1
+    while [ "$V" -lt "$LATEST_TREEMAPVIZ_VERSION" ]; do
+        DIR_REMOVE="${CACHE_DIR}/treemap_${V}"
+        if test -d "$DIR_REMOVE" && rm -r "$DIR_REMOVE"; then
+            info "Removed old cache-directory: '$DIR_REMOVE'"
+        fi
+        V=$((V+1))
+    done
+else
+    warn "Treemap-viz cache-directory is still empty - problem?"
+fi
+
+if [ -n "$(ls -A "${DEPENDENCIES_CACHE_DIR}")" ]; then
+    touch "${DEPENDENCIES_CACHE_DIR}/.done"
+
+    V=1
+    while [ "$V" -lt "$LATEST_DEPENDENCIESVIZ_VERSION" ]; do
+        DIR_REMOVE="${CACHE_DIR}/dependencies_${V}"
+        if test -d "$DIR_REMOVE" && rm -r "$DIR_REMOVE"; then
+            info "Removed old cache-directory: '$DIR_REMOVE'"
+        fi
+        V=$((V+1))
+    done
+else
+    warn "Dependencies-viz cache-directory is still empty - problem?"
+fi
+
+info "Batch creation of visualizations for $ATTEMPTED_VIZS binaries, finished with $FAILED_VIZS failures: $(date)"
+

packaging/debian/create_package.sh

@@ -23,7 +23,6 @@ mkdir -p "$bindir" "$debiandir" "$systemddir"
 install $bdir/builder-web $bindir/builder-web
 install $bdir/builder-migrations $bindir/builder-migrations
 install $bdir/builder-db $bindir/builder-db
-install $bdir/builder-viz $bindir/builder-viz
 
 # service script
 install -m 0644 $basedir/packaging/debian/builder-web.service $systemddir/builder-web.service

packaging/visualizations.sh

@@ -1,6 +1,7 @@
 #!/bin/sh
 
-set -ex
+set -e
+#set -x
 
 prog_NAME=$(basename "${0}")
 
@@ -9,6 +10,11 @@ warn()
     echo "${prog_NAME}: WARN: $*"
 }
 
+info()
+{
+    echo "${prog_NAME}: INFO: $*"
+}
+
 err()
 {
     echo "${prog_NAME}: ERROR: $*" 1>&2
@@ -23,60 +29,106 @@ die()
 usage()
 {
     cat <<EOM 1>&2
-usage: ${prog_NAME} [ OPTIONS ] FILE
+usage: ${prog_NAME} [ OPTIONS ]
 Generates visualizations
 Options:
-    --debug-binary=STRING
-        Path to debug binary.
-    --opam-switch=STRING
-        Path to opam switch.
     --uuid=STRING
         UUID of build.
+    --data-dir=STRING
+        Path to the data directory.
     --cache-dir=STRING
         Path to the cache directory.
 EOM
     exit 1
 }
 
-DEBUG=
-OPAM=
 UUID=
-CACHE=
+CACHE_DIR=
+DATA_DIR=
 
-while [ $# -gt 1 ]; do
+while [ $# -gt 0 ]; do
     OPT="$1"
 
     case "${OPT}" in
-        --debug-binary=*)
-            DEBUG="${OPT##*=}"
-            ;;
-        --opam-switch=*)
-            OPAM="${OPT##*=}"
-            ;;
         --uuid=*)
             UUID="${OPT##*=}"
             ;;
         --cache-dir=*)
-            CACHE="${OPT##*=}"
+            CACHE_DIR="${OPT##*=}"
             ;;
-        --*)
+        --data-dir=*)
-            warn "Ignoring unknown option: '${OPT}'"
+            DATA_DIR="${OPT##*=}"
             ;;
         *)
-            err "Unknown option: '${OPT}'"
+            warn "Ignoring unknown option: '${OPT}' (Note that this script reads DB)"
-            usage
             ;;
     esac
     shift
 done
 
 [ -z "${UUID}" ] && die "The --uuid option must be specified"
-[ -z "${CACHE}" ] && die "The --cache-dir option must be specified"
+[ -z "${CACHE_DIR}" ] && die "The --cache-dir option must be specified"
-[ -z "${OPAM}" ] && die "The --opam-switch option must be specified"
+[ -z "${DATA_DIR}" ] && die "The --data-dir option must be specified"
 
-FILENAME="${1}"
+info "processing UUID '$UUID'"
-CACHE_DIR="${CACHE}/${UUID}"
+
-BUILDER_VIZ="builder-viz"
+DB="${DATA_DIR}/builder.sqlite3"
+
+get_main_binary () {
+    sqlite3 "${DB}" <<EOF
+        select ba.localpath from build as b
+        join build_artifact as ba on ba.build = b.id and b.main_binary = ba.id
+        where uuid = '$UUID';
+EOF
+}
+
+BIN="${DATA_DIR}/$(get_main_binary)"
+[ -z "${BIN}" ] && die "No main-binary found in db '$DB' for build '$UUID'"
+
+get_debug_binary () {
+    sqlite3 "${DB}" <<EOF
+        select ba.localpath from build as b
+        join build_artifact as ba on ba.build = b.id 
+        where 
+          uuid = '$UUID'
+          and ba.localpath like '%.debug';
+EOF
+}
+
+DEBUG_BIN_RELATIVE="$(get_debug_binary)"
+
+get_opam_switch () {
+    sqlite3 "${DB}" <<EOF
+        select ba.localpath from build as b
+        join build_artifact as ba on ba.build = b.id 
+        where 
+          uuid = '$UUID'
+          and ba.filepath = 'opam-switch';
+EOF
+}
+
+OPAM_SWITCH="$(get_opam_switch)"
+[ -z "${OPAM_SWITCH}" ] && die "No 'opam-switch' found in db '$DB' for build '$UUID'"
+OPAM_SWITCH="${DATA_DIR}/${OPAM_SWITCH}"
+
+#START debug print values
+# echo "UUID = $UUID"
+# echo "CACHE_DIR = $CACHE_DIR"
+# echo "DATA_DIR = $DATA_DIR"
+# echo "DB = $DB"
+# echo "BIN = $BIN"
+# echo "DEBUG_BIN = $DEBUG_BIN"
+# echo "OPAM_SWITCH = $OPAM_SWITCH"
+#END debug print values
+
+OPAM_GRAPH="opam-graph"
+MODULECTOMY="modulectomy"
+
+LATEST_TREEMAPVIZ_VERSION="$($MODULECTOMY --version)"
+LATEST_DEPENDENCIESVIZ_VERSION="$($OPAM_GRAPH --version)"
+
+TREEMAP_CACHE_DIR="${CACHE_DIR}/treemap_${LATEST_TREEMAPVIZ_VERSION}"
+DEPENDENCIES_CACHE_DIR="${CACHE_DIR}/dependencies_${LATEST_DEPENDENCIESVIZ_VERSION}"
 
 mktemp_aux () {
     if [ "$(uname)" = "Linux" ]; then
@@ -84,45 +136,96 @@ mktemp_aux () {
     elif [ "$(uname)" = "FreeBSD" ]; then
         mktemp -t "$1"
     else
-        echo 'Unsupported platform'; exit 1
+        die 'Unsupported platform'
     fi
 }
-TMPTREE=$(mktemp_aux treeviz)
+
-TMPOPAM=$(mktemp_aux opamviz)
+TMPTREE=$(mktemp_aux viz_treemap)
+TMPDEPENDENCIES=$(mktemp_aux viz_dependencies)
+
 cleanup () {
-  rm -rf "${TMPTREE}" "${TMPOPAM}"
+  rm -rf "${TMPTREE}" "${TMPDEPENDENCIES}"
 }
 
 trap cleanup EXIT
 
-if [ -e "${CACHE_DIR}.dependencies.html" ]; then
+# /// Dependencies viz
-    echo "Dependency visualization already exists ${CACHE_DIR}.dependencies.html"
+
+if [ ! -d "${DEPENDENCIES_CACHE_DIR}" ]; then
+    mkdir "${DEPENDENCIES_CACHE_DIR}"
+fi
+
+OPAM_SWITCH_FILEPATH='opam-switch'
+
+get_opam_switch_hash () {
+    sqlite3 "${DB}" <<EOF
+        select lower(hex(ba.sha256)) from build as b
+        join build_artifact as ba on ba.build = b.id
+        where uuid = '$UUID' 
+        and ba.filepath = '$OPAM_SWITCH_FILEPATH';
+EOF
+}
+
+DEPENDENCIES_INPUT_HASH="$(get_opam_switch_hash)" 
+DEPENDENCIES_VIZ_FILENAME="${DEPENDENCIES_CACHE_DIR}/${DEPENDENCIES_INPUT_HASH}.html"
+
+if [ -e "${DEPENDENCIES_VIZ_FILENAME}" ]; then
+    info "Dependency visualization already exists: '${DEPENDENCIES_VIZ_FILENAME}'"
 else
-    if ${BUILDER_VIZ} dependencies "${OPAM}" > "${TMPOPAM}"; then
+    if ${OPAM_GRAPH} --output-format=html "${OPAM_SWITCH}" > "${TMPDEPENDENCIES}"; then
-        mv "${TMPOPAM}" "${CACHE_DIR}.dependencies.html"
+        mv "${TMPDEPENDENCIES}" "${DEPENDENCIES_VIZ_FILENAME}"
+    else
+        die "opam-graph failed to generate visualization"
     fi
 fi
 
+# /// Treemap viz
+
 stat_aux () {
     if [ "$(uname)" = "Linux" ]; then
         stat -c "%s" "$1"
     elif [ "$(uname)" = "FreeBSD" ]; then
         stat -f "%z" "$1"
     else
-        echo 'Unsupported platform'; exit 1
+        die 'Unsupported platform'
     fi
 }
 
-SIZE="$(stat_aux ${FILENAME})"
+SIZE="$(stat_aux "$BIN")"
 
-if [ ! -z "${DEBUG}" ]; then
+if [ ! -d "${TREEMAP_CACHE_DIR}" ]; then
-    if [ -e "${CACHE_DIR}.treemap.html" ]; then
+    mkdir "${TREEMAP_CACHE_DIR}"
-        echo "Treemap visualization already exists ${CACHE_DIR}.treemap.html"
+fi
+
+get_debug_bin_hash () {
+    sqlite3 "${DB}" <<EOF
+        select lower(hex(ba.sha256)) from build as b
+        join build_artifact as ba on ba.build = b.id
+        where uuid = '$UUID' 
+        and ba.filepath like '%.debug';
+EOF
+}
+
+TREEMAP_INPUT_HASH="$(get_debug_bin_hash)" 
+TREEMAP_VIZ_FILENAME="${TREEMAP_CACHE_DIR}/${TREEMAP_INPUT_HASH}.html"
+
+if [ -n "${DEBUG_BIN_RELATIVE}" ]; then
+    DEBUG_BIN="${DATA_DIR}/$(get_debug_binary)"
+    if [ -e "${TREEMAP_VIZ_FILENAME}" ]; then
+        info "Treemap visualization already exists: '${TREEMAP_VIZ_FILENAME}'"
     else
-        if ${BUILDER_VIZ} treemap "${DEBUG}" "${SIZE}" > "${TMPTREE}"; then
+        if
-            mv "${TMPTREE}" "${CACHE_DIR}.treemap.html"
+            ${MODULECTOMY} \
+                --robur-defaults \
+                --with-scale="${SIZE}" \
+                "${DEBUG_BIN}" \
+                > "${TMPTREE}"
+        then
+            mv "${TMPTREE}" "${TREEMAP_VIZ_FILENAME}"
+        else
+            die "modulectomy failed to generate visualization"
         fi
     fi
 else
-    echo "No --debug-binary provided, not producing any treemap"
+    info "No --debug-binary provided, not producing any treemap"
 fi