Store relative paths for build artifacts in database
This commit is contained in:
Robur
parent
10351c65bd
commit
49003ca21f
12 changed files with 98 additions and 45 deletions
|
|
@ -6,6 +6,8 @@ let pp_error ppf = function
|
|||
| `Wrong_version (application_id, user_version) ->
|
||||
Format.fprintf ppf "wrong version { application_id: %ld, user_version: %Ld }"
|
||||
application_id user_version
|
||||
| `Msg m ->
|
||||
Format.fprintf ppf "%s" m
|
||||
|
||||
let or_die exit_code = function
|
||||
| Ok r -> r
|
||||
|
|
@ -13,18 +15,20 @@ let or_die exit_code = function
|
|||
Format.eprintf "Database error: %a" pp_error e;
|
||||
exit exit_code
|
||||
|
||||
let do_database_action action () dbpath =
|
||||
let do_database_action action () datadir =
|
||||
let datadir = Fpath.v datadir in
|
||||
let dbpath = Fpath.(datadir / "builder.sqlite3") in
|
||||
Logs.debug (fun m -> m "Connecting to database...");
|
||||
let ((module Db : Caqti_blocking.CONNECTION) as conn) =
|
||||
Caqti_blocking.connect
|
||||
(Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ())
|
||||
(Uri.make ~scheme:"sqlite3" ~path:(Fpath.to_string dbpath) ~query:["create", ["false"]] ())
|
||||
|> or_die 1
|
||||
in
|
||||
Logs.debug (fun m -> m "Connected!");
|
||||
let r =
|
||||
Db.start () >>= fun () ->
|
||||
Logs.debug (fun m -> m "Started database transaction");
|
||||
match action conn with
|
||||
match action datadir conn with
|
||||
| Ok () ->
|
||||
Logs.debug (fun m -> m "Committing database transaction");
|
||||
Db.commit ()
|
||||
|
|
@ -42,11 +46,11 @@ let help man_format migrations = function
|
|||
then `Help (man_format, Some migration)
|
||||
else `Error (true, "Unknown migration: " ^ migration)
|
||||
|
||||
let dbpath =
|
||||
let doc = "sqlite3 database path" in
|
||||
let datadir =
|
||||
let doc = "data directory containing builder.sqlite3 and data files" in
|
||||
Cmdliner.Arg.(value &
|
||||
opt non_dir_file "/var/db/builder-web/builder.sqlite3" &
|
||||
info ~doc ["dbpath"])
|
||||
opt dir "/var/db/builder-web/" &
|
||||
info ~doc ["datadir"])
|
||||
|
||||
let setup_log =
|
||||
let setup_log level =
|
||||
|
|
@ -57,60 +61,69 @@ let setup_log =
|
|||
|
||||
let m20210126 =
|
||||
let doc = "Adds a column 'main_binary' in 'build' (2021-01-26)" in
|
||||
Cmdliner.Term.(const do_database_action $ const M20210126.migrate $ setup_log $ dbpath),
|
||||
Cmdliner.Term.(const do_database_action $ const M20210126.migrate $ setup_log $ datadir),
|
||||
Cmdliner.Term.info ~doc "migrate-2021-01-26"
|
||||
|
||||
let r20210126 =
|
||||
let doc = "Rollback 'main_binary' in 'build' (2021-01-26)" in
|
||||
Cmdliner.Term.(const do_database_action $ const M20210126.rollback $ setup_log $ dbpath),
|
||||
Cmdliner.Term.(const do_database_action $ const M20210126.rollback $ setup_log $ datadir),
|
||||
Cmdliner.Term.info ~doc "rollback-2021-01-26"
|
||||
|
||||
let m20210202 =
|
||||
let doc = "Adds an index 'job_build_idx' on 'build' (2021-02-02)" in
|
||||
Cmdliner.Term.(const do_database_action $ const M20210202.migrate $ setup_log $ dbpath),
|
||||
Cmdliner.Term.(const do_database_action $ const M20210202.migrate $ setup_log $ datadir),
|
||||
Cmdliner.Term.info ~doc "migrate-2021-02-02"
|
||||
|
||||
let r20210202 =
|
||||
let doc = "Rollback index 'job_build_idx' on 'build' (2021-02-02)" in
|
||||
Cmdliner.Term.(const do_database_action $ const M20210202.rollback $ setup_log $ dbpath),
|
||||
Cmdliner.Term.(const do_database_action $ const M20210202.rollback $ setup_log $ datadir),
|
||||
Cmdliner.Term.info ~doc "rollback-2021-02-02"
|
||||
|
||||
let m20210216 =
|
||||
let doc = "Changes 'user' for scrypt hashed passwords (NB: Destructive!!) (2021-02-16)" in
|
||||
Cmdliner.Term.(const do_database_action $ const M20210216.migrate $ setup_log $ dbpath),
|
||||
Cmdliner.Term.(const do_database_action $ const M20210216.migrate $ setup_log $ datadir),
|
||||
Cmdliner.Term.info ~doc "migrate-2021-02-16"
|
||||
|
||||
let r20210216 =
|
||||
let doc = "Rollback scrypt hashed passwords (NB: Destructive!!) (2021-02-16)" in
|
||||
Cmdliner.Term.(const do_database_action $ const M20210216.rollback $ setup_log $ dbpath),
|
||||
Cmdliner.Term.(const do_database_action $ const M20210216.rollback $ setup_log $ datadir),
|
||||
Cmdliner.Term.info ~doc "rollback-2021-02-16"
|
||||
|
||||
let m20210218 =
|
||||
let doc = "Adds column 'size' to 'build_file' and 'build_artifact' (2021-02-18)" in
|
||||
Cmdliner.Term.(const do_database_action $ const M20210218.migrate $ setup_log $ dbpath),
|
||||
Cmdliner.Term.(const do_database_action $ const M20210218.migrate $ setup_log $ datadir),
|
||||
Cmdliner.Term.info ~doc "migrate-2021-02-18"
|
||||
|
||||
let r20210218 =
|
||||
let doc = "Roll back column 'size' in 'build_file' and 'build_artifact' (2021-02-18)" in
|
||||
Cmdliner.Term.(const do_database_action $ const M20210218.rollback $ setup_log $ dbpath),
|
||||
Cmdliner.Term.(const do_database_action $ const M20210218.rollback $ setup_log $ datadir),
|
||||
Cmdliner.Term.info ~doc "rollback-2021-02-18"
|
||||
|
||||
let f20210308 =
|
||||
let doc = "Remove broken builds as fixed in commit a57798f4c02eb4d528b90932ec26fb0b718f1a13. \
|
||||
Note that the files on disk have to be removed manually." in
|
||||
Cmdliner.Term.(const do_database_action $ const M20210308.fixup $ setup_log $ dbpath),
|
||||
Cmdliner.Term.(const do_database_action $ const M20210308.fixup $ setup_log $ datadir),
|
||||
Cmdliner.Term.info ~doc "fixup-2021-03-08"
|
||||
|
||||
let m20210427 =
|
||||
let doc = "Adds an index 'idx_build_job_start' on 'build' (2021-04-27)" in
|
||||
Cmdliner.Term.(const do_database_action $ const M20210427.migrate $ setup_log $ dbpath),
|
||||
Cmdliner.Term.(const do_database_action $ const M20210427.migrate $ setup_log $ datadir),
|
||||
Cmdliner.Term.info ~doc "migrate-2021-04-27"
|
||||
|
||||
let r20210427 =
|
||||
let doc = "Rollback index 'idx_build_job_start'' on 'build' (2021-04-27)" in
|
||||
Cmdliner.Term.(const do_database_action $ const M20210427.rollback $ setup_log $ dbpath),
|
||||
Cmdliner.Term.(const do_database_action $ const M20210427.rollback $ setup_log $ datadir),
|
||||
Cmdliner.Term.info ~doc "rollback-2021-04-27"
|
||||
|
||||
let m20210531 =
|
||||
let doc = "Remove datadir from build_artifact.localpath" in
|
||||
Cmdliner.Term.(const do_database_action $ const M20210531.migrate $ setup_log $ datadir),
|
||||
Cmdliner.Term.info ~doc "migrate-2021-05-31"
|
||||
|
||||
let r20210531 =
|
||||
let doc = "Add datadir to build_artifact.localpath" in
|
||||
Cmdliner.Term.(const do_database_action $ const M20210531.rollback $ setup_log $ datadir),
|
||||
Cmdliner.Term.info ~doc "rollback-2021-05-31"
|
||||
|
||||
let help_cmd =
|
||||
let topic =
|
||||
|
|
@ -136,5 +149,6 @@ let () =
|
|||
m20210218; r20210218;
|
||||
f20210308;
|
||||
m20210427; r20210427;
|
||||
m20210531; r20210531;
|
||||
]
|
||||
|> Cmdliner.Term.exit
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@ let set_main_binary =
|
|||
Caqti_type.(tup2 int64 (option string))
|
||||
"UPDATE build SET main_binary = ?2 WHERE id = ?1"
|
||||
|
||||
let migrate (module Db : Caqti_blocking.CONNECTION) =
|
||||
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
|
||||
let open Rresult.R.Infix in
|
||||
Grej.check_version ~application_id:0l ~user_version:0L (module Db) >>= fun () ->
|
||||
Db.exec alter_build () >>= fun () ->
|
||||
|
|
@ -84,7 +84,7 @@ let rollback_data =
|
|||
FROM __tmp_build
|
||||
|}
|
||||
|
||||
let rollback (module Db : Caqti_blocking.CONNECTION) =
|
||||
let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
|
||||
let open Rresult.R.Infix in
|
||||
Grej.check_version ~user_version:new_user_version (module Db) >>= fun () ->
|
||||
Db.exec rename_build () >>= fun () ->
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
open Rresult.R.Infix
|
||||
|
||||
let migrate (module Db : Caqti_blocking.CONNECTION) =
|
||||
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
|
||||
let job_build_idx =
|
||||
Caqti_request.exec ~oneshot:true
|
||||
Caqti_type.unit
|
||||
|
|
@ -9,7 +9,7 @@ let migrate (module Db : Caqti_blocking.CONNECTION) =
|
|||
Grej.check_version ~user_version:1L (module Db) >>= fun () ->
|
||||
Db.exec job_build_idx ()
|
||||
|
||||
let rollback (module Db : Caqti_blocking.CONNECTION) =
|
||||
let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
|
||||
let q =
|
||||
Caqti_request.exec ~oneshot:true
|
||||
Caqti_type.unit
|
||||
|
|
|
|||
|
|
@ -32,14 +32,14 @@ let old_user =
|
|||
)
|
||||
|}
|
||||
|
||||
let migrate (module Db : Caqti_blocking.CONNECTION) =
|
||||
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
|
||||
let open Rresult.R.Infix in
|
||||
Grej.check_version ~user_version:old_user_version (module Db) >>= fun () ->
|
||||
Db.exec drop_user () >>= fun () ->
|
||||
Db.exec new_user () >>= fun () ->
|
||||
Db.exec (Grej.set_version new_user_version) ()
|
||||
|
||||
let rollback (module Db : Caqti_blocking.CONNECTION) =
|
||||
let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
|
||||
let open Rresult.R.Infix in
|
||||
Grej.check_version ~user_version:new_user_version (module Db) >>= fun () ->
|
||||
Db.exec drop_user () >>= fun () ->
|
||||
|
|
|
|||
|
|
@ -79,7 +79,7 @@ let rename_build_file =
|
|||
Caqti_type.unit
|
||||
"ALTER TABLE new_build_file RENAME TO build_file"
|
||||
|
||||
let migrate (module Db : Caqti_blocking.CONNECTION) =
|
||||
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
|
||||
let open Rresult.R.Infix in
|
||||
Grej.check_version ~user_version:old_user_version (module Db) >>= fun () ->
|
||||
Db.exec new_build_artifact () >>= fun () ->
|
||||
|
|
@ -146,7 +146,7 @@ let copy_build_file =
|
|||
Caqti_type.unit
|
||||
"INSERT INTO new_build_file SELECT id, filepath, localpath, sha256, build FROM build_file"
|
||||
|
||||
let rollback (module Db : Caqti_blocking.CONNECTION) =
|
||||
let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
|
||||
let open Rresult.R.Infix in
|
||||
Grej.check_version ~user_version:new_user_version (module Db) >>= fun () ->
|
||||
Db.exec old_build_artifact () >>= fun () ->
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ let broken_builds =
|
|||
WHERE a.build = b.id and a.filepath = b.main_binary) = 0
|
||||
|}
|
||||
|
||||
let fixup (module Db : Caqti_blocking.CONNECTION) =
|
||||
let fixup _datadir (module Db : Caqti_blocking.CONNECTION) =
|
||||
let open Rresult.R.Infix in
|
||||
Grej.check_version ~user_version:3L (module Db) >>= fun () ->
|
||||
Db.rev_collect_list broken_builds () >>= fun broken_builds ->
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
open Rresult.R.Infix
|
||||
|
||||
let migrate (module Db : Caqti_blocking.CONNECTION) =
|
||||
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
|
||||
let idx_build_job_start =
|
||||
Caqti_request.exec ~oneshot:true
|
||||
Caqti_type.unit
|
||||
|
|
@ -15,7 +15,7 @@ let migrate (module Db : Caqti_blocking.CONNECTION) =
|
|||
Db.exec rm_job_build_idx () >>= fun () ->
|
||||
Db.exec idx_build_job_start ()
|
||||
|
||||
let rollback (module Db : Caqti_blocking.CONNECTION) =
|
||||
let rollback _datadir (module Db : Caqti_blocking.CONNECTION) =
|
||||
let job_build_idx =
|
||||
Caqti_request.exec ~oneshot:true
|
||||
Caqti_type.unit
|
||||
|
|
|
|||
36
bin/migrations/m20210531.ml
Normal file
36
bin/migrations/m20210531.ml
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
let old_version = 3L
|
||||
let new_version = 4L
|
||||
|
||||
let build_artifacts =
|
||||
Caqti_request.collect ~oneshot:true
|
||||
Caqti_type.unit
|
||||
Caqti_type.(tup2 Builder_db.Rep.id Builder_db.Rep.fpath)
|
||||
"SELECT id, localpath FROM build_artifact"
|
||||
|
||||
let build_artifact_update_localpath =
|
||||
Caqti_request.exec ~oneshot:true
|
||||
Caqti_type.(tup2 Builder_db.Rep.id Builder_db.Rep.fpath)
|
||||
"UPDATE build_artifact SET localpath = ?2 WHERE id = ?1"
|
||||
|
||||
(* We are not migrating build_file because it is unused *)
|
||||
|
||||
let migrate datadir (module Db : Caqti_blocking.CONNECTION) =
|
||||
let open Rresult.R.Infix in
|
||||
Grej.check_version ~user_version:old_version (module Db) >>= fun () ->
|
||||
Db.collect_list build_artifacts () >>= fun artifacts ->
|
||||
Grej.list_iter_result (fun (id, localpath) ->
|
||||
match Fpath.rem_prefix datadir localpath with
|
||||
| Some p -> Db.exec build_artifact_update_localpath (id, p)
|
||||
| None -> Error (`Msg ("couldn't remove datadir prefix from " ^ Fpath.to_string localpath)))
|
||||
artifacts >>= fun () ->
|
||||
Db.exec (Grej.set_version new_version) ()
|
||||
|
||||
let rollback datadir (module Db : Caqti_blocking.CONNECTION) =
|
||||
let open Rresult.R.Infix in
|
||||
Grej.check_version ~user_version:new_version (module Db) >>= fun () ->
|
||||
Db.collect_list build_artifacts () >>= fun artifacts ->
|
||||
Grej.list_iter_result (fun (id, localpath) ->
|
||||
let p = Fpath.(datadir // localpath) in
|
||||
Db.exec build_artifact_update_localpath (id, p))
|
||||
artifacts >>= fun () ->
|
||||
Db.exec (Grej.set_version old_version) ()
|
||||
|
|
@ -4,7 +4,7 @@ open Rep
|
|||
let application_id = 1234839235l
|
||||
|
||||
(* Please update this when making changes! *)
|
||||
let current_version = 3L
|
||||
let current_version = 4L
|
||||
|
||||
type id = Rep.id
|
||||
|
||||
|
|
|
|||
|
|
@ -162,6 +162,7 @@ let add_routes datadir =
|
|||
in
|
||||
|
||||
let job_build_file req =
|
||||
let datadir = Dream.global datadir_global req in
|
||||
let _job_name = Dream.param "job" req
|
||||
and build = Dream.param "build" req
|
||||
and filepath = Dream.path req |> String.concat "/" in
|
||||
|
|
@ -176,7 +177,7 @@ let add_routes datadir =
|
|||
Log.debug (fun m -> m "bad path: %s" e);
|
||||
Dream.respond ~status:`Not_Found "File not found"
|
||||
| Some build, Ok filepath ->
|
||||
let* artifact = Dream.sql req (Model.build_artifact build filepath) in
|
||||
let* artifact = Dream.sql req (Model.build_artifact datadir build filepath) in
|
||||
match artifact with
|
||||
| Error e ->
|
||||
Log.warn (fun m -> m "Error getting build artifact: %a" pp_error e);
|
||||
|
|
@ -242,6 +243,7 @@ let add_routes datadir =
|
|||
in
|
||||
|
||||
let compare_opam req =
|
||||
let datadir = Dream.global datadir_global req in
|
||||
let build_left = Dream.param "build_left" req in
|
||||
let build_right = Dream.param "build_right" req in
|
||||
match Uuidm.of_string build_left, Uuidm.of_string build_right with
|
||||
|
|
@ -249,9 +251,9 @@ let add_routes datadir =
|
|||
Dream.respond ~status:`Bad_Request "Bad request"
|
||||
| Some build_left, Some build_right ->
|
||||
let* r =
|
||||
Dream.sql req (Model.build_artifact build_left (Fpath.v "opam-switch"))
|
||||
Dream.sql req (Model.build_artifact datadir build_left (Fpath.v "opam-switch"))
|
||||
>>= fun switch_left ->
|
||||
Dream.sql req (Model.build_artifact build_right (Fpath.v "opam-switch"))
|
||||
Dream.sql req (Model.build_artifact datadir build_right (Fpath.v "opam-switch"))
|
||||
>>= fun switch_right ->
|
||||
Dream.sql req (Model.build build_left) >>= fun (_id, build_left) ->
|
||||
Dream.sql req (Model.build build_right) >>= fun (_id, build_right) ->
|
||||
|
|
|
|||
23
lib/model.ml
23
lib/model.ml
|
|
@ -20,7 +20,8 @@ let not_found = function
|
|||
|
||||
let staging datadir = Fpath.(datadir / "_staging")
|
||||
|
||||
let read_file filepath =
|
||||
let read_file datadir filepath =
|
||||
let filepath = Fpath.(datadir // filepath) in
|
||||
Lwt.try_bind
|
||||
(fun () -> Lwt_io.open_file ~mode:Lwt_io.Input (Fpath.to_string filepath))
|
||||
(fun ic -> Lwt_result.ok (Lwt_io.read ic))
|
||||
|
|
@ -31,11 +32,11 @@ let read_file filepath =
|
|||
Lwt.return_error (`File_error filepath)
|
||||
| e -> Lwt.fail e)
|
||||
|
||||
let build_artifact build filepath (module Db : CONN) =
|
||||
let build_artifact datadir build filepath (module Db : CONN) =
|
||||
Db.find_opt Builder_db.Build_artifact.get_by_build_uuid (build, filepath)
|
||||
>>= function
|
||||
| Some (_id, file) ->
|
||||
read_file file.Builder_db.localpath >|= fun data -> data, file.Builder_db.sha256
|
||||
read_file datadir file.Builder_db.localpath >|= fun data -> data, file.Builder_db.sha256
|
||||
| None ->
|
||||
Lwt.return_error `Not_found
|
||||
|
||||
|
|
@ -154,8 +155,8 @@ let save_files dir staging files =
|
|||
(Lwt_result.return [])
|
||||
files
|
||||
|
||||
let save_all basedir staging_dir ((job, uuid, _, _, _, _, artifacts) as exec) =
|
||||
let build_dir = Fpath.(basedir / job.Builder.name / Uuidm.to_string uuid) in
|
||||
let save_all staging_dir ((job, uuid, _, _, _, _, artifacts) as exec) =
|
||||
let build_dir = Fpath.(v job.Builder.name / Uuidm.to_string uuid) in
|
||||
let input_dir = Fpath.(build_dir / "input")
|
||||
and staging_input_dir = Fpath.(staging_dir / "input") in
|
||||
let output_dir = Fpath.(build_dir / "output")
|
||||
|
|
@ -171,19 +172,19 @@ let save_all basedir staging_dir ((job, uuid, _, _, _, _, artifacts) as exec) =
|
|||
save_files input_dir staging_input_dir job.Builder.files >>= fun input_files ->
|
||||
Lwt_result.return (artifacts, input_files)
|
||||
|
||||
let commit_files basedir staging_dir job_name uuid =
|
||||
let job_dir = Fpath.(basedir / job_name) in
|
||||
let commit_files datadir staging_dir job_name uuid =
|
||||
let job_dir = Fpath.(datadir / job_name) in
|
||||
let dest = Fpath.(job_dir / Uuidm.to_string uuid) in
|
||||
Lwt.return (Bos.OS.Dir.create job_dir) >>= fun _ ->
|
||||
Lwt.return (Bos.OS.Path.move staging_dir dest)
|
||||
|
||||
let add_build
|
||||
basedir
|
||||
datadir
|
||||
((job, uuid, console, start, finish, result, _) as exec)
|
||||
(module Db : CONN) =
|
||||
let open Builder_db in
|
||||
let job_name = job.Builder.name in
|
||||
let staging_dir = Fpath.(staging basedir / Uuidm.to_string uuid) in
|
||||
let staging_dir = Fpath.(staging datadir / Uuidm.to_string uuid) in
|
||||
let or_cleanup x =
|
||||
Lwt_result.map_err (fun e ->
|
||||
Bos.OS.Dir.delete ~recurse:true staging_dir
|
||||
|
|
@ -194,7 +195,7 @@ let add_build
|
|||
e)
|
||||
x
|
||||
in
|
||||
or_cleanup (save_all basedir staging_dir exec) >>= fun (artifacts, input_files) ->
|
||||
or_cleanup (save_all staging_dir exec) >>= fun (artifacts, input_files) ->
|
||||
let main_binary =
|
||||
match List.find_all
|
||||
(fun file ->
|
||||
|
|
@ -233,7 +234,7 @@ let add_build
|
|||
(Lwt_result.return ())
|
||||
input_files >>= fun () ->
|
||||
Db.commit () >>= fun () ->
|
||||
commit_files basedir staging_dir job_name uuid
|
||||
commit_files datadir staging_dir job_name uuid
|
||||
in
|
||||
Lwt_result.bind_lwt_err (or_cleanup r)
|
||||
(fun e ->
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ val staging : Fpath.t -> Fpath.t
|
|||
val cleanup_staging : Fpath.t -> Caqti_lwt.connection ->
|
||||
(unit, [> `Msg of string ]) result Lwt.t
|
||||
|
||||
val build_artifact : Uuidm.t -> Fpath.t -> Caqti_lwt.connection ->
|
||||
val build_artifact : Fpath.t -> Uuidm.t -> Fpath.t -> Caqti_lwt.connection ->
|
||||
(string * Cstruct.t, [> error ]) result Lwt.t
|
||||
|
||||
val build_artifacts : Builder_db.id -> Caqti_lwt.connection ->
|
||||
|
|
|
|||
Loading…
Reference in a new issue