From 1827320f8c4534ac74783cf9ec17cb272b7e3122 Mon Sep 17 00:00:00 2001 From: rand00 Date: Tue, 29 Mar 2022 14:00:13 +0200 Subject: [PATCH 1/5] Builder_web: Removed boilerplate for generating vizs --- lib/builder_web.ml | 19 ++++--------------- 1 file changed, 4 insertions(+), 15 deletions(-) diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 56523ab..edb929c 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -211,23 +211,12 @@ let add_routes datadir configdir = ) |> Lwt_result.map_err (fun exn -> `Msg (Printexc.to_string exn)) in - let job_build_viztreemap req = + let job_build_viz viz_typ req = let _job_name = Dream.param "job" req and build = Dream.param "build" req and datadir = Dream.global datadir_global req in get_uuid build >>= fun uuid -> - (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 - and datadir = Dream.global datadir_global req in - get_uuid build >>= fun uuid -> - (try_load_cached_visualization ~datadir ~uuid `Dependencies + (try_load_cached_visualization ~datadir ~uuid viz_typ |> if_error "Error getting cached visualization") >>= fun svg_html -> Lwt_result.ok (Dream.html svg_html) @@ -486,8 +475,8 @@ let add_routes datadir configdir = Dream.get "/job/:job/build/:build/" (w job_build); Dream.get "/job/:job/build/:build/f/**" (w job_build_file); Dream.get "/job/:job/build/:build/main-binary" (w redirect_main_binary); - Dream.get "/job/:job/build/:build/viztreemap" (w job_build_viztreemap); - Dream.get "/job/:job/build/:build/vizdependencies" (w job_build_vizdependencies); + Dream.get "/job/:job/build/:build/viztreemap" (w @@ job_build_viz `Treemap); + Dream.get "/job/:job/build/:build/vizdependencies" (w @@ job_build_viz `Dependencies); Dream.get "/job/:job/build/:build/script" (w (job_build_static_file `Script)); Dream.get "/job/:job/build/:build/console" (w (job_build_static_file `Console)); Dream.get "/failed-builds/" (w failed_builds); From ab3be6ec8e95ec724e21cd7cac26d821d7bca1e3 Mon Sep 17 00:00:00 2001 From: rand00 Date: Tue, 29 Mar 2022 22:27:24 +0200 Subject: [PATCH 2/5] builder-web: Added --cachedir CLI arg for staging new vizs --- bin/builder_system.ml | 3 +++ bin/builder_web_app.ml | 17 ++++++++++++++--- lib/builder_web.ml | 17 ++++++++++------- lib/model.ml | 5 +++-- lib/model.mli | 3 ++- 5 files changed, 32 insertions(+), 13 deletions(-) diff --git a/bin/builder_system.ml b/bin/builder_system.ml index 0c3bd1c..3ac2767 100644 --- a/bin/builder_system.ml +++ b/bin/builder_system.ml @@ -11,6 +11,9 @@ let default_datadir = | `FreeBSD -> "/var/db/builder-web" | `Linux -> "/var/lib/builder-web" +let default_cachedir = + default_datadir ^ "/_cache" + let default_configdir = match Lazy.force uname with | `FreeBSD -> "/usr/local/etc/builder-web" diff --git a/bin/builder_web_app.ml b/bin/builder_web_app.ml index cb43880..fca18df 100644 --- a/bin/builder_web_app.ml +++ b/bin/builder_web_app.ml @@ -78,9 +78,10 @@ let init_influx name data = in Lwt.async report -let setup_app level influx port host datadir configdir = +let setup_app level influx port host datadir cachedir configdir = let dbpath = Printf.sprintf "%s/builder.sqlite3" datadir in let datadir = Fpath.v datadir in + let cachedir = Fpath.v cachedir in let configdir = Fpath.v configdir in let () = init_influx "builder-web" influx in match Builder_web.init dbpath datadir with @@ -97,7 +98,7 @@ let setup_app level influx port host datadir configdir = @@ Dream.logger @@ Dream.sql_pool ("sqlite3:" ^ dbpath) @@ Http_status_metrics.handle - @@ Builder_web.add_routes datadir configdir + @@ Builder_web.add_routes ~datadir ~cachedir ~configdir @@ Builder_web.not_found open Cmdliner @@ -127,6 +128,10 @@ let datadir = let doc = "data directory" in Arg.(value & opt dir Builder_system.default_datadir & info [ "d"; "datadir" ] ~doc) +let cachedir = + let doc = "cache directory" in + Arg.(value & opt dir Builder_system.default_cachedir & info [ "cachedir" ] ~doc) + let configdir = let doc = "config directory" in Arg.(value & opt dir Builder_system.default_configdir & info [ "c"; "configdir" ] ~doc) @@ -144,7 +149,13 @@ let influx = Arg.(value & opt (some ip_port) None & info [ "influx" ] ~doc ~docv:"INFLUXHOST[:PORT]") let () = - let term = Term.(const setup_app $ Logs_cli.level () $ influx $ port $ host $ datadir $ configdir) in + let term = Term.( + const setup_app + $ Logs_cli.level () + $ influx + $ port $ host + $ datadir $ cachedir $ configdir + ) in let info = Cmd.info "Builder web" ~doc:"Builder web" ~man:[] in Cmd.v info term |> Cmd.eval diff --git a/lib/builder_web.ml b/lib/builder_web.ml index edb929c..4785340 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -104,8 +104,9 @@ let dream_svg ?status ?code ?headers body = |> Dream.with_header "Content-Type" "image/svg+xml" |> Lwt.return -let add_routes datadir configdir = +let add_routes ~datadir ~cachedir ~configdir = let datadir_global = Dream.new_global ~name:"datadir" (fun () -> datadir) in + let cachedir_global = Dream.new_global ~name:"cachedir" (fun () -> cachedir) in let builds req = Dream.sql req Model.jobs_with_section_synopsis @@ -194,12 +195,12 @@ let add_routes datadir configdir = |> Lwt_result.ok in - let try_load_cached_visualization ~datadir ~uuid typ = + let try_load_cached_visualization ~cachedir ~uuid typ = let fn = match typ with | `Treemap -> "treemap" | `Dependencies -> "dependencies" in - let path = Fpath.(datadir / "_cache" / Uuidm.to_string uuid + fn + "html") 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") @@ -214,9 +215,9 @@ let add_routes datadir configdir = let job_build_viz viz_typ req = let _job_name = Dream.param "job" req and build = Dream.param "build" req - and datadir = Dream.global datadir_global req in + and cachedir = Dream.global cachedir_global req in get_uuid build >>= fun uuid -> - (try_load_cached_visualization ~datadir ~uuid viz_typ + (try_load_cached_visualization ~cachedir ~uuid viz_typ |> if_error "Error getting cached visualization") >>= fun svg_html -> Lwt_result.ok (Dream.html svg_html) @@ -359,9 +360,10 @@ let add_routes datadir configdir = |> Lwt_result.ok | false -> let datadir = Dream.global datadir_global req in + let cachedir = Dream.global cachedir_global req in (Lwt.return (Dream.local Authorization.user_info_local req |> Option.to_result ~none:(`Msg "no authenticated user")) >>= fun (user_id, _) -> - Dream.sql req (Model.add_build ~configdir ~datadir user_id exec)) + Dream.sql req (Model.add_build ~datadir ~cachedir ~configdir user_id exec)) |> if_error "Internal server error" ~log:(fun e -> Log.warn (fun m -> m "Error saving build %a: %a" pp_exec exec pp_error e)) >>= fun () -> Dream.respond "" |> Lwt_result.ok @@ -452,6 +454,7 @@ let add_routes datadir configdir = |> Lwt_result.ok | false -> let datadir = Dream.global datadir_global req in + let cachedir = Dream.global cachedir_global req in let exec = let now = Ptime_clock.now () in ({ Builder.name = job ; platform ; script = "" }, uuid, [], now, now, Builder.Exited 0, @@ -459,7 +462,7 @@ let add_routes datadir configdir = in (Lwt.return (Dream.local Authorization.user_info_local req |> Option.to_result ~none:(`Msg "no authenticated user")) >>= fun (user_id, _) -> - Dream.sql req (Model.add_build ~configdir ~datadir user_id exec)) + Dream.sql req (Model.add_build ~datadir ~cachedir ~configdir user_id exec)) |> if_error "Internal server error" ~log:(fun e -> Log.warn (fun m -> m "Error saving build %a: %a" pp_exec exec pp_error e)) >>= fun () -> Dream.respond "" |> Lwt_result.ok diff --git a/lib/model.ml b/lib/model.ml index d86b8d1..22b6875 100644 --- a/lib/model.ml +++ b/lib/model.ml @@ -305,8 +305,9 @@ let prepare_staging staging_dir = else Lwt_result.return () let add_build - ~configdir ~datadir + ~cachedir + ~configdir user_id ((job : Builder.script_job), uuid, console, start, finish, result, raw_artifacts) (module Db : CONN) = @@ -445,7 +446,7 @@ let add_build (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") ; + "--cache-dir=" ^ Fpath.to_string cachedir ; fp_str main_binary ])) in Log.debug (fun m -> m "executing hooks with %s" args); diff --git a/lib/model.mli b/lib/model.mli index 8e993e0..6982c61 100644 --- a/lib/model.mli +++ b/lib/model.mli @@ -95,8 +95,9 @@ val user : string -> Caqti_lwt.connection -> val authorized : [`user] Builder_db.id -> string -> Caqti_lwt.connection -> (unit, [> Caqti_error.call_or_retrieve | `Msg of string ]) result Lwt.t val add_build : - configdir:Fpath.t -> datadir:Fpath.t -> + cachedir:Fpath.t -> + configdir:Fpath.t -> [`user] Builder_db.id -> (Builder.script_job * Uuidm.t * (int * string) list * Ptime.t * Ptime.t * Builder.execution_result * (Fpath.t * string) list) -> From 68849fecf37ccd929c0820deae795a64c9296780 Mon Sep 17 00:00:00 2001 From: rand00 Date: Wed, 6 Apr 2022 13:47:07 +0200 Subject: [PATCH 3/5] Fixed that cachedir should default to being relative to given datadir --- bin/builder_system.ml | 3 --- bin/builder_web_app.ml | 11 +++++++++-- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/bin/builder_system.ml b/bin/builder_system.ml index 3ac2767..0c3bd1c 100644 --- a/bin/builder_system.ml +++ b/bin/builder_system.ml @@ -11,9 +11,6 @@ let default_datadir = | `FreeBSD -> "/var/db/builder-web" | `Linux -> "/var/lib/builder-web" -let default_cachedir = - default_datadir ^ "/_cache" - let default_configdir = match Lazy.force uname with | `FreeBSD -> "/usr/local/etc/builder-web" diff --git a/bin/builder_web_app.ml b/bin/builder_web_app.ml index fca18df..d2dfcdc 100644 --- a/bin/builder_web_app.ml +++ b/bin/builder_web_app.ml @@ -81,7 +81,10 @@ let init_influx name data = let setup_app level influx port host datadir cachedir configdir = let dbpath = Printf.sprintf "%s/builder.sqlite3" datadir in let datadir = Fpath.v datadir in - let cachedir = Fpath.v cachedir in + let cachedir = match cachedir with + | Some c -> Fpath.v c + | None -> Fpath.(datadir / "_cache") + in let configdir = Fpath.v configdir in let () = init_influx "builder-web" influx in match Builder_web.init dbpath datadir with @@ -130,7 +133,11 @@ let datadir = let cachedir = let doc = "cache directory" in - Arg.(value & opt dir Builder_system.default_cachedir & info [ "cachedir" ] ~doc) + Arg.( + value + & opt (some ~none:"DATADIR/_cache" dir) None + & info [ "cachedir" ] ~doc + ) let configdir = let doc = "config directory" in From 1adc67c297fcea37348c8ae8691cfd8d2d1f5b40 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Mon, 11 Apr 2022 16:26:58 +0200 Subject: [PATCH 4/5] minor nits --- bin/builder_web_app.ml | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/bin/builder_web_app.ml b/bin/builder_web_app.ml index d2dfcdc..9b61a3e 100644 --- a/bin/builder_web_app.ml +++ b/bin/builder_web_app.ml @@ -81,10 +81,7 @@ let init_influx name data = let setup_app level influx port host datadir cachedir configdir = let dbpath = Printf.sprintf "%s/builder.sqlite3" datadir in let datadir = Fpath.v datadir in - let cachedir = match cachedir with - | Some c -> Fpath.v c - | None -> Fpath.(datadir / "_cache") - in + let cachedir = Option.fold ~none:Fpath.(datadir / "_cache") ~some:Fpath.v in let configdir = Fpath.v configdir in let () = init_influx "builder-web" influx in match Builder_web.init dbpath datadir with @@ -156,13 +153,10 @@ let influx = Arg.(value & opt (some ip_port) None & info [ "influx" ] ~doc ~docv:"INFLUXHOST[:PORT]") let () = - let term = Term.( - const setup_app - $ Logs_cli.level () - $ influx - $ port $ host - $ datadir $ cachedir $ configdir - ) in + let term = + Term.(const setup_app $ Logs_cli.level () $ influx $ port $ host $ datadir $ + cachedir $ configdir) + in let info = Cmd.info "Builder web" ~doc:"Builder web" ~man:[] in Cmd.v info term |> Cmd.eval From 6a1c8b0ecd55a1a321f3b818ea7108d59b9eebe8 Mon Sep 17 00:00:00 2001 From: rand00 Date: Mon, 11 Apr 2022 18:12:23 +0200 Subject: [PATCH 5/5] Builder_web_app: Fixed type-error + some 80-column fixes --- bin/builder_web_app.ml | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/bin/builder_web_app.ml b/bin/builder_web_app.ml index 9b61a3e..7d20e03 100644 --- a/bin/builder_web_app.ml +++ b/bin/builder_web_app.ml @@ -81,18 +81,32 @@ let init_influx name data = let setup_app level influx port host datadir cachedir configdir = let dbpath = Printf.sprintf "%s/builder.sqlite3" datadir in let datadir = Fpath.v datadir in - let cachedir = Option.fold ~none:Fpath.(datadir / "_cache") ~some:Fpath.v in + let cachedir = + cachedir |> Option.fold ~none:Fpath.(datadir / "_cache") ~some:Fpath.v + in let configdir = Fpath.v configdir in let () = init_influx "builder-web" influx in match Builder_web.init dbpath datadir with | Error (#Caqti_error.load as e) -> Format.eprintf "Error: %a\n%!" Caqti_error.pp e; exit 2 - | Error (#Caqti_error.connect | #Caqti_error.call_or_retrieve | `Msg _ | `Wrong_version _ as e) -> + | Error ( + #Caqti_error.connect + | #Caqti_error.call_or_retrieve + | `Msg _ + | `Wrong_version _ as e + ) -> Format.eprintf "Error: %a\n%!" Builder_web.pp_error e; exit 1 | Ok () -> - let level = match level with None -> None | Some Logs.Debug -> Some `Debug | Some Info -> Some `Info | Some Warning -> Some `Warning | Some Error -> Some `Error | Some App -> None in + let level = match level with + | None -> None + | Some Logs.Debug -> Some `Debug + | Some Info -> Some `Info + | Some Warning -> Some `Warning + | Some Error -> Some `Error + | Some App -> None + in Dream.initialize_log ?level (); Dream.run ~port ~interface:host ~https:false @@ Dream.logger