diff --git a/bin/builder_web_app.ml b/bin/builder_web_app.ml index 78c3e42..87b108b 100644 --- a/bin/builder_web_app.ml +++ b/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 diff --git a/bin/visualizations/builder_viz.ml b/bin/visualizations/builder_viz.ml deleted file mode 100644 index 5219bd3..0000000 --- a/bin/visualizations/builder_viz.ml +++ /dev/null @@ -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 diff --git a/bin/visualizations/dune b/bin/visualizations/dune deleted file mode 100644 index c77ff33..0000000 --- a/bin/visualizations/dune +++ /dev/null @@ -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))) - ) - diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 3440bbb..36233ef 100644 --- a/lib/builder_web.ml +++ b/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 diff --git a/lib/dune b/lib/dune index a56c8ea..243595a 100644 --- a/lib/dune +++ b/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 diff --git a/lib/model.ml b/lib/model.ml index 22b6875..8df5791 100644 --- a/lib/model.ml +++ b/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 diff --git a/packaging/FreeBSD/create_package.sh b/packaging/FreeBSD/create_package.sh index 478a9e3..1d0a956 100755 --- a/packaging/FreeBSD/create_package.sh +++ b/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 {} + | diff --git a/packaging/batch-viz.sh b/packaging/batch-viz.sh index 073f202..358eb6c 100755 --- a/packaging/batch-viz.sh +++ b/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 <&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)" + diff --git a/packaging/debian/create_package.sh b/packaging/debian/create_package.sh index e3ba9e7..235bd19 100755 --- a/packaging/debian/create_package.sh +++ b/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 diff --git a/packaging/visualizations.sh b/packaging/visualizations.sh index 5e5d9a5..4f6e6c0 100755 --- a/packaging/visualizations.sh +++ b/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 <&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" -FILENAME="${1}" -CACHE_DIR="${CACHE}/${UUID}" -BUILDER_VIZ="builder-viz" +info "processing UUID '$UUID'" + +DB="${DATA_DIR}/builder.sqlite3" + +get_main_binary () { + sqlite3 "${DB}" < "${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 [ ! -z "${DEBUG}" ]; then - if [ -e "${CACHE_DIR}.treemap.html" ]; then - echo "Treemap visualization already exists ${CACHE_DIR}.treemap.html" +if [ ! -d "${TREEMAP_CACHE_DIR}" ]; then + mkdir "${TREEMAP_CACHE_DIR}" +fi + +get_debug_bin_hash () { + sqlite3 "${DB}" < "${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