Re-add viewing build script and build console

Instead of displaying the script and console output in the build page
the build page links to new endpoints for viewing the script and the
console output.
This commit is contained in:
Reynir Björnsson 2021-09-09 18:06:08 +02:00
parent dd6535296d
commit f24a9297d0
4 changed files with 42 additions and 0 deletions

View file

@ -199,6 +199,23 @@ let add_routes datadir =
Dream.respond ~headers data |> Lwt_result.ok Dream.respond ~headers data |> Lwt_result.ok
in in
let job_build_static_file (file : [< `Console | `Script ]) req =
let datadir = Dream.global datadir_global req in
let _job_name = Dream.param "job" req
and build = Dream.param "build" req in
get_uuid build >>= fun build ->
(match file with
| `Console ->
Dream.sql req (Model.build_console_by_uuid datadir build)
| `Script ->
Dream.sql req (Model.build_script_by_uuid datadir build))
|> if_error "Error getting data"
~log:(fun e -> Log.warn (fun m -> m "Error getting script or console data for build %a: %a"
Uuidm.pp build pp_error e)) >>= fun data ->
let headers = [ "Content-Type", "text/plain" ] in
Dream.respond ~headers data |> Lwt_result.ok
in
let upload req = let upload req =
let* body = Dream.body req in let* body = Dream.body req in
Builder.Asn.exec_of_cs (Cstruct.of_string body) |> Lwt.return Builder.Asn.exec_of_cs (Cstruct.of_string body) |> Lwt.return
@ -322,6 +339,8 @@ let add_routes datadir =
Dream.get "/job/:job/build/:build/" (w job_build); 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/f/**" (w job_build_file);
Dream.get "/job/:job/build/:build/main-binary" (w redirect_main_binary); Dream.get "/job/:job/build/:build/main-binary" (w redirect_main_binary);
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 "/hash" (w hash); Dream.get "/hash" (w hash);
Dream.get "/compare/:build_left/:build_right/opam-switch" (w compare_opam); Dream.get "/compare/:build_left/:build_right/opam-switch" (w compare_opam);
Dream.post "/upload" (Authorization.authenticate (w upload)); Dream.post "/upload" (Authorization.authenticate (w upload));

View file

@ -96,6 +96,14 @@ let builds_with_same_input_and_different_main_binary id (module Db : CONN) =
Lwt.return (Ok (build :: metas))) Lwt.return (Ok (build :: metas)))
(Ok []) hashes (Ok []) hashes
let build_console_by_uuid datadir uuid (module Db : CONN) =
build uuid (module Db) >>= fun (_id, { Builder_db.Build.console; _ })->
read_file datadir console
let build_script_by_uuid datadir uuid (module Db : CONN) =
build uuid (module Db) >>= fun (_id, { Builder_db.Build.script; _ })->
read_file datadir script
let job_id job_name (module Db : CONN) = let job_id job_name (module Db : CONN) =
Db.find_opt Builder_db.Job.get_id_by_name job_name Db.find_opt Builder_db.Job.get_id_by_name job_name

View file

@ -51,6 +51,12 @@ val builds_with_same_input_and_same_main_binary : [`build] Builder_db.id -> Caqt
val builds_with_same_input_and_different_main_binary : [`build] Builder_db.id -> Caqti_lwt.connection -> val builds_with_same_input_and_different_main_binary : [`build] Builder_db.id -> Caqti_lwt.connection ->
(Builder_db.Build.t list, [> Caqti_error.call_or_retrieve ]) result Lwt.t (Builder_db.Build.t list, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val build_console_by_uuid : Fpath.t -> Uuidm.t -> Caqti_lwt.connection ->
(string, [> error ]) result Lwt.t
val build_script_by_uuid : Fpath.t -> Uuidm.t -> Caqti_lwt.connection ->
(string, [> error ]) result Lwt.t
val readme : string -> Caqti_lwt.connection -> val readme : string -> Caqti_lwt.connection ->
(string option, [> error ]) result Lwt.t (string option, [> error ]) result Lwt.t

View file

@ -221,6 +221,15 @@ let job_build
[txtf "%a" pp_ptime start] ; [txtf "%a" pp_ptime start] ;
txt ", " ]) txt ", " ])
xs) ] ) @ [ xs) ] ) @ [
h3 [txt "Build info"];
ul [
li [ a ~a:[Fmt.kstr a_href "/job/%s/build/%a/console" name Uuidm.pp uuid]
[txt "Console output"];
];
li [ a ~a:[Fmt.kstr a_href "/job/%s/build/%a/script" name Uuidm.pp uuid]
[txt "Build script"];
]
];
h3 [txt "Comparisons with other builds"]; h3 [txt "Comparisons with other builds"];
p p
((match latest_uuid with ((match latest_uuid with