From 6f3c89c91d3bede25e6858dacf3687a990ecda27 Mon Sep 17 00:00:00 2001 From: hannes Date: Thu, 24 Feb 2022 11:52:05 +0000 Subject: [PATCH] display visualizations from cache, generate visualizations on upload (#90) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This is #88 (reading visualiations from the cache directory), together with shell scripts that can be used as upload hooks to generate the visualizations. Co-authored-by: rand00 Co-authored-by: Hannes Mehnert Co-authored-by: Reynir Björnsson Co-authored-by: Robur Reviewed-on: https://git.robur.io/robur/builder-web/pulls/90 Co-authored-by: hannes Co-committed-by: hannes --- lib/builder_web.ml | 81 ++++++++------------------- lib/model.ml | 53 ++++++++++++------ packaging/batch-viz.sh | 59 +++++++++++++++++++ packaging/visualizations.sh | 109 ++++++++++++++++++++++++++++++++++++ 4 files changed, 226 insertions(+), 76 deletions(-) create mode 100755 packaging/batch-viz.sh create mode 100755 packaging/visualizations.sh diff --git a/lib/builder_web.ml b/lib/builder_web.ml index b4df57d..c98e06b 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -198,78 +198,41 @@ let add_routes datadir configdir = |> Lwt_result.ok in - let visualization_cmd args = - let cmd_list = "builder-viz" :: args in - let cmd = "", Array.of_list cmd_list in - let pin = - Lwt_process.open_process_in - ~stdin:`Dev_null ~stderr:`Dev_null - ~timeout:15. - cmd + let try_load_cached_visualization ~datadir ~uuid typ = + let fn = match typ with + | `Treemap -> "treemap" + | `Dependencies -> "dependencies" in - let* output = Lwt_io.read pin#stdout - and* exit_status = pin#status in - match exit_status with - | Unix.WEXITED 0 -> Lwt_result.return output - | Unix.WEXITED _ | Unix.WSIGNALED _ |Unix.WSTOPPED _ -> - let cmd_str = String.concat " " cmd_list in - `Msg (sprintf "Error when running cmd: '%s'" cmd_str) - |> Lwt_result.fail - in - - let treemap_visualization_cmd ~debug_elf_path ~elf_size = - [ "treemap"; debug_elf_path; Int.to_string elf_size ] - |> visualization_cmd - in - - let dependencies_visualization_cmd ~opam_switch_path = - [ "dependencies"; opam_switch_path ] - |> visualization_cmd + let path = Fpath.(datadir / "_cache" / Uuidm.to_string uuid + fn + "html") in + Lwt.return (Bos.OS.File.exists path) >>= fun cached_file_exists -> + if not cached_file_exists then + Lwt_result.fail (`Msg "Visualization does not exist") + else + Lwt_result.catch ( + Lwt_io.with_file ~mode:Lwt_io.Input + (Fpath.to_string path) + Lwt_io.read + ) |> Lwt_result.map_err (fun exn -> `Msg (Printexc.to_string exn)) in let job_build_viztreemap req = let _job_name = Dream.param "job" req - and build = Dream.param "build" req in + and build = Dream.param "build" req + and datadir = Dream.global datadir_global req in get_uuid build >>= fun uuid -> - ( - Dream.sql req (Model.build uuid) >>= fun (_id, build) -> - Model.not_found build.Builder_db.Build.main_binary >>= fun main_binary_id -> - Dream.sql req (Model.build_artifact_by_id main_binary_id) >>= fun main_binary -> - let debug_binary_path = Fpath.(base main_binary.Builder_db.filepath + "debug") in - (* lookup debug_binary_path artifact *) - Dream.sql req (Model.build_artifact uuid debug_binary_path) >>= fun debug_binary -> - Lwt_result.return (debug_binary, main_binary)) - |> if_error "Error getting job build" - ~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e)) - >>= fun (debug_binary, main_binary) -> - let elf_size = main_binary.Builder_db.size in - let datadir = Dream.global datadir_global req in - let debug_elf_path = Fpath.( - datadir // debug_binary.Builder_db.localpath - |> to_string - ) in - treemap_visualization_cmd ~debug_elf_path ~elf_size - |> if_error "Failed to generate treemap visualization" + (try_load_cached_visualization ~datadir ~uuid `Treemap + |> if_error "Error getting cached visualization") >>= fun svg_html -> Lwt_result.ok (Dream.html svg_html) in let job_build_vizdependencies req = let _job_name = Dream.param "job" req - and build = Dream.param "build" req in + and build = Dream.param "build" req + and datadir = Dream.global datadir_global req in get_uuid build >>= fun uuid -> - let opam_switch_path = Fpath.(v "opam-switch") in - Dream.sql req (Model.build_artifact uuid opam_switch_path) - |> if_error "Error getting job build" - ~log:(fun e -> Log.warn (fun m -> m "Error getting job data: %a" pp_error e)) - >>= fun opam_switch -> - let datadir = Dream.global datadir_global req in - let opam_switch_path = Fpath.( - datadir // opam_switch.Builder_db.localpath - |> to_string - ) in - dependencies_visualization_cmd ~opam_switch_path - |> if_error "Failed to generate dependencies visualization" + (try_load_cached_visualization ~datadir ~uuid `Dependencies + |> if_error "Error getting cached visualization") >>= fun svg_html -> Lwt_result.ok (Dream.html svg_html) in diff --git a/lib/model.ml b/lib/model.ml index c1aea23..c123f5b 100644 --- a/lib/model.ml +++ b/lib/model.ml @@ -382,25 +382,26 @@ let add_build match readme, readme_anywhere with | None, None -> Lwt_result.return () | Some (_, data), _ | None, Some (_, data) -> add_or_update readme_id data) >>= fun () -> + (match List.partition (fun p -> Fpath.(is_prefix (v "bin/") p.filepath)) artifacts with + | [ main_binary ], other_artifacts -> + Db.exec Build_artifact.add (main_binary, id) >>= fun () -> + Db.find Builder_db.last_insert_rowid () >>= fun main_binary_id -> + Db.exec Build.set_main_binary (id, main_binary_id) >|= fun () -> + Some main_binary, other_artifacts + | [], _ -> + Log.debug (fun m -> m "Zero binaries for build %a" Uuidm.pp uuid); + Lwt_result.return (None, artifacts) + | xs, _ -> + Log.warn (fun m -> m "Multiple binaries for build %a: %a" Uuidm.pp uuid + Fmt.(list ~sep:(any ",") Fpath.pp) + (List.map (fun a -> a.filepath) xs)); + Lwt_result.return (None, artifacts)) >>= fun (main_binary, remaining_artifacts_to_add) -> List.fold_left (fun r file -> r >>= fun () -> Db.exec Build_artifact.add (file, id)) (Lwt_result.return ()) - artifacts >>= fun () -> - Db.collect_list Build_artifact.get_all_by_build id >>= fun artifacts -> - (match List.filter (fun (_, p) -> Fpath.(is_prefix (v "bin/") p.filepath)) artifacts with - | [ (build_artifact_id, p) ] -> - Db.exec Build.set_main_binary (id, build_artifact_id) >|= fun () -> - Some p - | [] -> - Log.debug (fun m -> m "Zero binaries for build %a" Uuidm.pp uuid); - Lwt_result.return None - | xs -> - Log.warn (fun m -> m "Multiple binaries for build %a: %a" Uuidm.pp uuid - Fmt.(list ~sep:(any ",") Fpath.pp) - (List.map (fun (_, a) -> a.filepath) xs)); - Lwt_result.return None) >>= fun main_binary -> + remaining_artifacts_to_add >>= fun () -> Db.commit () >>= fun () -> commit_files datadir staging_dir job_name uuid >|= fun () -> main_binary @@ -423,13 +424,31 @@ let add_build Printf.sprintf "%04d%02d%02d%02d%02d%02d" y m d hh mm ss and job = job.name and platform = job.platform + and debug_binary = + 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 ^ "\"") - [ "--build-time=" ^ time ; "--sha256=" ^ sha256 ; "--job=" ^ job ; - "--uuid=" ^ uuid ; "--platform=" ^ platform ; - Fpath.(to_string (datadir // main_binary)) ]) + ((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=" ^ fp_str (Fpath.v "_cache") ; + fp_str main_binary ])) in Log.debug (fun m -> m "executing hooks with %s" args); let dir = Fpath.(configdir / "upload-hooks") in diff --git a/packaging/batch-viz.sh b/packaging/batch-viz.sh new file mode 100755 index 0000000..073f202 --- /dev/null +++ b/packaging/batch-viz.sh @@ -0,0 +1,59 @@ +#!/bin/sh + +set -e + +prog_NAME=$(basename "${0}") + +warn() +{ + echo "${prog_NAME}: WARN: $*" +} + +err() +{ + echo "${prog_NAME}: ERROR: $*" 1>&2 +} + +die() +{ + echo "${prog_NAME}: ERROR: $*" 1>&2 + exit 1 +} + +usage() +{ + cat <&2 +usage: ${prog_NAME} [ OPTIONS ] DATADIR +Generates visualizations of all things +EOM + exit 1 +} + +if [ $# -ne 1 ]; then + usage +fi + +DIR="${1}" + +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 diff --git a/packaging/visualizations.sh b/packaging/visualizations.sh new file mode 100755 index 0000000..8f7c057 --- /dev/null +++ b/packaging/visualizations.sh @@ -0,0 +1,109 @@ +#!/bin/sh + +set -ex + +prog_NAME=$(basename "${0}") + +warn() +{ + echo "${prog_NAME}: WARN: $*" +} + +err() +{ + echo "${prog_NAME}: ERROR: $*" 1>&2 +} + +die() +{ + echo "${prog_NAME}: ERROR: $*" 1>&2 + exit 1 +} + +usage() +{ + cat <&2 +usage: ${prog_NAME} [ OPTIONS ] FILE +Generates visualizations +Options: + --debug-binary=STRING + Path to debug binary. + --opam-switch=STRING + Path to opam switch. + --uuid=STRING + UUID of build. + --cache-dir=STRING + Path to the cache directory. +EOM + exit 1 +} + +DEBUG= +OPAM= +UUID= +CACHE= + +while [ $# -gt 1 ]; do + OPT="$1" + + case "${OPT}" in + --debug-binary=*) + DEBUG="${OPT##*=}" + ;; + --opam-switch=*) + OPAM="${OPT##*=}" + ;; + --uuid=*) + UUID="${OPT##*=}" + ;; + --cache-dir=*) + CACHE="${OPT##*=}" + ;; + --*) + warn "Ignoring unknown option: '${OPT}'" + ;; + *) + err "Unknown option: '${OPT}'" + usage + ;; + esac + shift +done + +[ -z "${UUID}" ] && die "The --uuid option must be specified" +[ -z "${CACHE}" ] && die "The --cache-dir option must be specified" +[ -z "${OPAM}" ] && die "The --opam-switch option must be specified" + +FILENAME="${1}" +CACHE_DIR="${CACHE}/${UUID}" +BUILDER_VIZ="builder-viz" + +TMPTREE=$(mktemp -t treevis) +TMPOPAM=$(mktemp -t opamvis) +cleanup () { + rm -rf "${TMPTREE}" "${TMPOPAM}" +} + +trap cleanup EXIT + +if [ -e "${CACHE_DIR}.dependencies.html" ]; then + echo "Dependency visualization already exists ${CACHE_DIR}.dependencies.html" +else + if ${BUILDER_VIZ} dependencies "${OPAM}" > "${TMPOPAM}"; then + mv "${TMPOPAM}" "${CACHE_DIR}.dependencies.html" + fi +fi + +SIZE="$(stat -f "%z" ${FILENAME})" + +if [ ! -z "${DEBUG}" ]; then + if [ -e "${CACHE_DIR}.treemap.html" ]; then + echo "Treemap visualization already exists ${CACHE_DIR}.treemap.html" + else + if ${BUILDER_VIZ} treemap "${DEBUG}" "${SIZE}" > "${TMPTREE}"; then + mv "${TMPTREE}" "${CACHE_DIR}.treemap.html" + fi + fi +else + echo "No --debug-binary provided, not producing any treemap" +fi