Browse Source

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>
pull/121/head
Reynir Björnsson 2 months ago
parent
commit
09a180c3cd
  1. 76
      bin/builder_web_app.ml
  2. 175
      bin/visualizations/builder_viz.ml
  3. 12
      bin/visualizations/dune
  4. 144
      lib/builder_web.ml
  5. 15
      lib/dune
  6. 34
      lib/model.ml
  7. 1
      packaging/FreeBSD/create_package.sh
  8. 162
      packaging/batch-viz.sh
  9. 1
      packaging/debian/create_package.sh
  10. 187
      packaging/visualizations.sh

76
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
Arg.(value & opt (some ip_port) None & info [ "influx" ] ~doc ~docv:"INFLUXHOST[:PORT]")
let doc = "IP address and port (default: 8094) to report metrics to \
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

175
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

12
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)))
)

144
lib/builder_web.ml

@ -163,48 +163,140 @@ let routes ~datadir ~cachedir ~configdir =
|> Lwt_result.ok
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 (Model.build uuid)
let main_binary_of_uuid uuid db =
Model.build uuid db
|> if_error "Error getting job build"
~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e))
~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)
|> if_error "Error getting main binary" >>= 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
Model.build_artifact_by_id main_binary db
|> if_error "Error getting main binary"
in
let try_load_cached_visualization ~cachedir ~uuid typ =
let fn = match typ with
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 hash_viz_input ~uuid typ db =
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
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))
get_viz_version ~cachedir ~viz_typ_str
|> if_error "Error getting visualization version" >>= fun latest_viz_version ->
hash_viz_input ~uuid typ db >>= fun viz_input_hash ->
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 viz_path)
Lwt_io.read
)
|> 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
|> if_error ~status:`Not_Found "Error getting cached visualization"
Dream.sql req (try_load_cached_visualization ~cachedir ~uuid viz_typ)
>>= fun svg_html ->
Lwt_result.ok (Dream.html svg_html)
in

15
lib/dune

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

34
lib/model.ml

@ -414,40 +414,24 @@ let add_build
r;
e)) >>= function
| None -> Lwt.return (Ok ())
| Some p ->
let main_binary = p.localpath
and `Hex sha256 = Hex.of_cstruct p.sha256
and uuid = Uuidm.to_string uuid
and time =
| Some main_binary ->
let 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 =
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)
and `Hex sha256 = Hex.of_cstruct main_binary.sha256
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 ]))
[ "--build-time=" ^ time ; "--sha256=" ^ sha256 ; "--job=" ^ job ;
"--uuid=" ^ uuid ; "--platform=" ^ platform ;
"--cache-dir=" ^ Fpath.to_string cachedir ;
"--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

1
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 {} + |

162
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
usage
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
;;
esac
shift
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
DIR="${1}"
[ ! -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
CACHE="${DIR}/_cache"
OPAM_GRAPH="opam-graph"
MODULECTOMY="modulectomy"
for i in $(find "${DIR}" -type f -path \*output/bin\*); do
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)
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}
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)"

1
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

187
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##*=}"
;;
--*)
warn "Ignoring unknown option: '${OPT}'"
--data-dir=*)
DATA_DIR="${OPT##*=}"
;;
*)
err "Unknown option: '${OPT}'"
usage
warn "Ignoring unknown option: '${OPT}' (Note that this script reads DB)"
;;
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"
[ -z "${CACHE_DIR}" ] && die "The --cache-dir option must be specified"
[ -z "${DATA_DIR}" ] && die "The --data-dir option must be specified"
info "processing UUID '$UUID'"
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"
FILENAME="${1}"
CACHE_DIR="${CACHE}/${UUID}"
BUILDER_VIZ="builder-viz"
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
echo "Dependency visualization already exists ${CACHE_DIR}.dependencies.html"
# /// Dependencies viz
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
mv "${TMPOPAM}" "${CACHE_DIR}.dependencies.html"
if ${OPAM_GRAPH} --output-format=html "${OPAM_SWITCH}" > "${TMPDEPENDENCIES}"; then
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 [ ! -d "${TREEMAP_CACHE_DIR}" ]; then
mkdir "${TREEMAP_CACHE_DIR}"
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 [ ! -z "${DEBUG}" ]; then
if [ -e "${CACHE_DIR}.treemap.html" ]; then
echo "Treemap visualization already exists ${CACHE_DIR}.treemap.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
mv "${TMPTREE}" "${CACHE_DIR}.treemap.html"
if
${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

Loading…
Cancel
Save