display visualizations from cache, generate visualizations on upload (#90)

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 <oth.rand@gmail.com>
Co-authored-by: Hannes Mehnert <hannes@mehnert.org>
Co-authored-by: Reynir Björnsson <reynir@reynir.dk>
Co-authored-by: Robur <team@robur.coop>
Reviewed-on: https://git.robur.io/robur/builder-web/pulls/90
Co-authored-by: hannes <hannes@mehnert.org>
Co-committed-by: hannes <hannes@mehnert.org>
This commit is contained in:
Hannes Mehnert 2022-02-24 11:52:05 +00:00 committed by Reynir Björnsson
parent 255bcd9e9c
commit 6f3c89c91d
4 changed files with 226 additions and 76 deletions

View file

@ -198,78 +198,41 @@ let add_routes datadir configdir =
|> Lwt_result.ok |> Lwt_result.ok
in in
let visualization_cmd args = let try_load_cached_visualization ~datadir ~uuid typ =
let cmd_list = "builder-viz" :: args in let fn = match typ with
let cmd = "", Array.of_list cmd_list in | `Treemap -> "treemap"
let pin = | `Dependencies -> "dependencies"
Lwt_process.open_process_in
~stdin:`Dev_null ~stderr:`Dev_null
~timeout:15.
cmd
in in
let* output = Lwt_io.read pin#stdout let path = Fpath.(datadir / "_cache" / Uuidm.to_string uuid + fn + "html") in
and* exit_status = pin#status in Lwt.return (Bos.OS.File.exists path) >>= fun cached_file_exists ->
match exit_status with if not cached_file_exists then
| Unix.WEXITED 0 -> Lwt_result.return output Lwt_result.fail (`Msg "Visualization does not exist")
| Unix.WEXITED _ | Unix.WSIGNALED _ |Unix.WSTOPPED _ -> else
let cmd_str = String.concat " " cmd_list in Lwt_result.catch (
`Msg (sprintf "Error when running cmd: '%s'" cmd_str) Lwt_io.with_file ~mode:Lwt_io.Input
|> Lwt_result.fail (Fpath.to_string path)
in Lwt_io.read
) |> Lwt_result.map_err (fun exn -> `Msg (Printexc.to_string exn))
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
in in
let job_build_viztreemap req = let job_build_viztreemap req =
let _job_name = Dream.param "job" 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 -> get_uuid build >>= fun uuid ->
( (try_load_cached_visualization ~datadir ~uuid `Treemap
Dream.sql req (Model.build uuid) >>= fun (_id, build) -> |> if_error "Error getting cached visualization")
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"
>>= fun svg_html -> >>= fun svg_html ->
Lwt_result.ok (Dream.html svg_html) Lwt_result.ok (Dream.html svg_html)
in in
let job_build_vizdependencies req = let job_build_vizdependencies req =
let _job_name = Dream.param "job" 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 -> get_uuid build >>= fun uuid ->
let opam_switch_path = Fpath.(v "opam-switch") in (try_load_cached_visualization ~datadir ~uuid `Dependencies
Dream.sql req (Model.build_artifact uuid opam_switch_path) |> if_error "Error getting cached visualization")
|> 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"
>>= fun svg_html -> >>= fun svg_html ->
Lwt_result.ok (Dream.html svg_html) Lwt_result.ok (Dream.html svg_html)
in in

View file

@ -382,25 +382,26 @@ let add_build
match readme, readme_anywhere with match readme, readme_anywhere with
| None, None -> Lwt_result.return () | None, None -> Lwt_result.return ()
| Some (_, data), _ | None, Some (_, data) -> add_or_update readme_id data) >>= fun () -> | 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 List.fold_left
(fun r file -> (fun r file ->
r >>= fun () -> r >>= fun () ->
Db.exec Build_artifact.add (file, id)) Db.exec Build_artifact.add (file, id))
(Lwt_result.return ()) (Lwt_result.return ())
artifacts >>= fun () -> remaining_artifacts_to_add >>= 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 ->
Db.commit () >>= fun () -> Db.commit () >>= fun () ->
commit_files datadir staging_dir job_name uuid >|= fun () -> commit_files datadir staging_dir job_name uuid >|= fun () ->
main_binary main_binary
@ -423,13 +424,31 @@ let add_build
Printf.sprintf "%04d%02d%02d%02d%02d%02d" y m d hh mm ss Printf.sprintf "%04d%02d%02d%02d%02d%02d" y m d hh mm ss
and job = job.name and job = job.name
and platform = job.platform 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 in
let args = let args =
String.concat " " String.concat " "
(List.map (fun s -> "\"" ^ String.escaped s ^ "\"") (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 ; [ "--build-time=" ^ time ; "--sha256=" ^ sha256 ; "--job=" ^ job ;
"--uuid=" ^ uuid ; "--platform=" ^ platform ; "--uuid=" ^ uuid ; "--platform=" ^ platform ;
Fpath.(to_string (datadir // main_binary)) ]) "--cache-dir=" ^ fp_str (Fpath.v "_cache") ;
fp_str main_binary ]))
in in
Log.debug (fun m -> m "executing hooks with %s" args); Log.debug (fun m -> m "executing hooks with %s" args);
let dir = Fpath.(configdir / "upload-hooks") in let dir = Fpath.(configdir / "upload-hooks") in

59
packaging/batch-viz.sh Executable file
View file

@ -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 <<EOM 1>&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

109
packaging/visualizations.sh Executable file
View file

@ -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 <<EOM 1>&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