execute all executables in <conigdir>/upload-hooks when an upload succeeded

Only uploads with a single main binary invoke the hooks (since they use the
main_binary)
This commit is contained in:
Hannes Mehnert 2022-02-21 12:11:06 +01:00 committed by Robur
parent 550dd59a19
commit f7bc55f2e3
5 changed files with 71 additions and 14 deletions

View file

@ -10,3 +10,8 @@ let default_datadir =
match Lazy.force uname with
| `FreeBSD -> "/var/db/builder-web"
| `Linux -> "/var/lib/builder-web"
let default_configdir =
match Lazy.force uname with
| `FreeBSD -> "/usr/local/etc/builder-web"
| `Linux -> "/etc/builder-web"

View file

@ -78,9 +78,10 @@ let init_influx name data =
in
Lwt.async report
let setup_app level influx port host datadir =
let setup_app level influx port host datadir configdir =
let dbpath = Printf.sprintf "%s/builder.sqlite3" datadir in
let datadir = Fpath.v datadir 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) ->
@ -96,7 +97,7 @@ let setup_app level influx port host datadir =
@@ Dream.logger
@@ Dream.sql_pool ("sqlite3:" ^ dbpath)
@@ Http_status_metrics.handle
@@ Builder_web.add_routes datadir
@@ Builder_web.add_routes datadir configdir
@@ Builder_web.not_found
open Cmdliner
@ -124,6 +125,10 @@ let datadir =
let doc = "data directory" in
Arg.(value & opt dir Builder_system.default_datadir & info [ "d"; "datadir" ] ~doc)
let configdir =
let doc = "config directory" in
Arg.(value & opt dir Builder_system.default_configdir & info [ "c"; "configdir" ] ~doc)
let port =
let doc = "port" in
Arg.(value & opt int 3000 & info [ "p"; "port" ] ~doc)
@ -137,7 +142,7 @@ let influx =
Arg.(value & opt (some ip_port) None & info [ "influx" ] ~doc ~docv:"INFLUXHOST[:PORT]")
let () =
let term = Term.(pure setup_app $ Logs_cli.level () $ influx $ port $ host $ datadir) in
let term = Term.(pure setup_app $ Logs_cli.level () $ influx $ port $ host $ datadir $ configdir) in
let info = Term.info "Builder web" ~doc:"Builder web" ~man:[] in
match Term.eval (term, info) with
| `Ok () -> exit 0

View file

@ -106,7 +106,7 @@ let dream_svg ?status ?code ?headers body =
|> Dream.with_header "Content-Type" "image/svg+xml"
|> Lwt.return
let add_routes datadir =
let add_routes datadir configdir =
let datadir_global = Dream.new_global ~name:"datadir" (fun () -> datadir) in
let builds req =
@ -404,7 +404,7 @@ let add_routes datadir =
let datadir = Dream.global datadir_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 datadir user_id exec))
Dream.sql req (Model.add_build ~configdir ~datadir 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
@ -502,7 +502,7 @@ let add_routes datadir =
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 datadir user_id exec))
Dream.sql req (Model.add_build ~configdir ~datadir 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

View file

@ -31,7 +31,7 @@ let read_file datadir filepath =
Lwt_result.return data)
(function
| Unix.Unix_error (e, _, _) ->
Logs.warn (fun m -> m "Error reading local file %a: %s"
Log.warn (fun m -> m "Error reading local file %a: %s"
Fpath.pp filepath (Unix.error_message e));
Lwt.return_error (`File_error filepath)
| e -> Lwt.fail e)
@ -301,7 +301,8 @@ let prepare_staging staging_dir =
else Lwt_result.return ()
let add_build
datadir
~configdir
~datadir
user_id
((job : Builder.script_job), uuid, console, start, finish, result, raw_artifacts)
(module Db : CONN) =
@ -383,17 +384,20 @@ let add_build
artifacts >>= 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, _) ] -> Db.exec Build.set_main_binary (id, build_artifact_id)
| [ (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 ()
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 ()) >>= fun () ->
Lwt_result.return None) >>= fun main_binary ->
Db.commit () >>= fun () ->
commit_files datadir staging_dir job_name uuid
commit_files datadir staging_dir job_name uuid >|= fun () ->
main_binary
in
Lwt_result.bind_lwt_err (or_cleanup r)
(fun e ->
@ -402,4 +406,46 @@ let add_build
Result.iter_error
(fun e' -> Log.err (fun m -> m "Failed rollback: %a" Caqti_error.pp e'))
r;
e))
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 =
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 job = job.name
in
let args =
String.concat " "
(List.map (fun s -> "\"" ^ String.escaped s ^ "\"")
[ "--build-time=" ^ time ; "--sha256=" ^ sha256 ; "--job=" ^ job ;
"--uuid=" ^ uuid ; Fpath.(to_string (datadir // main_binary)) ])
in
Log.debug (fun m -> m "executing hooks with %s" args);
let dir = Fpath.(configdir / "upload-hooks") in
(try
Lwt.return (Ok (Some (Unix.opendir (Fpath.to_string dir))))
with
Unix.Unix_error _ -> Lwt.return (Ok None)) >>= function
| None -> Lwt.return (Ok ())
| Some dh ->
try
let is_executable file =
let st = Unix.stat (Fpath.to_string file) in
st.Unix.st_perm land 0o111 = 0o111 &&
st.Unix.st_kind = Unix.S_REG
in
let rec go () =
let next_file = Unix.readdir dh in
let file = Fpath.(dir / next_file) in
if is_executable file then
ignore (Sys.command (Fpath.to_string file ^ " " ^ args ^ " &"));
go ()
in
go ()
with
| End_of_file ->
Unix.closedir dh;
Lwt.return (Ok ())

View file

@ -93,7 +93,8 @@ 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 :
Fpath.t ->
configdir:Fpath.t ->
datadir: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) ->