From 0f98541feb0cadab641fad881d09c1bf052c62b5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Thu, 21 Jan 2021 17:51:58 +0100 Subject: [PATCH] Store files on disk --- bin/builder_web_app.ml | 9 ++++--- lib/builder_web.ml | 13 ++++++---- lib/model.ml | 57 ++++++++++++++++++++++++++++++++++-------- lib/model.mli | 3 ++- 4 files changed, 62 insertions(+), 20 deletions(-) diff --git a/bin/builder_web_app.ml b/bin/builder_web_app.ml index 7a90dea..03ce536 100644 --- a/bin/builder_web_app.ml +++ b/bin/builder_web_app.ml @@ -1,12 +1,13 @@ open Opium -let t = Result.get_ok (Builder_web.init "builder.sqlite3") -let app = +let app t = App.empty |> App.cmd_name "Builder Web" |> Builder_web.add_routes t let () = - Mirage_crypto_rng_unix.initialize (); - App.run_command app + let () = Mirage_crypto_rng_unix.initialize () in + let datadir = Fpath.v "/var/db/builder-web/" in + let t = Result.get_ok (Builder_web.init "builder.sqlite3" datadir) in + App.run_command (app t) diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 0e3719f..a7ca135 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -12,17 +12,20 @@ let pp_error ppf = function | #Model.error as e -> Model.pp_error ppf e type 'a t = { - pool : (Caqti_lwt.connection, [> db_error ] as 'a) Caqti_lwt.Pool.t + pool : (Caqti_lwt.connection, [> db_error ] as 'a) Caqti_lwt.Pool.t; + datadir : Fpath.t; } let realm = "builder-web" -let init ?(pool_size = 10) dbpath = +let init ?(pool_size = 10) dbpath datadir = Caqti_lwt.connect_pool ~max_size:pool_size (Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ()) - |> Result.map (fun pool -> - { pool = (pool :> (Caqti_lwt.connection, [> db_error ]) Caqti_lwt.Pool.t); }) + |> Result.map (fun pool -> { + pool = (pool :> (Caqti_lwt.connection, [> db_error ]) Caqti_lwt.Pool.t); + datadir; + }) let pp_exec ppf (job, uuid, _, _, _, _, _) = Format.fprintf ppf "%s(%a)" job.Builder.name Uuidm.pp uuid @@ -181,7 +184,7 @@ let routes t = Log.debug (fun m -> m "Parse error: %s" e); Lwt.return (Response.of_plain_text "Bad request\n" ~status:`Bad_request) | Ok exec -> - let* r = Caqti_lwt.Pool.use (Model.add_build exec) t.pool in + let* r = Caqti_lwt.Pool.use (Model.add_build t.datadir exec) t.pool in match r with | Ok () -> Lwt.return (Response.of_plain_text "Success!") diff --git a/lib/model.ml b/lib/model.ml index 8d92ca1..8ef46a1 100644 --- a/lib/model.ml +++ b/lib/model.ml @@ -5,11 +5,12 @@ module Log = (val Logs.src_log src : Logs.LOG) module type CONN = Caqti_lwt.CONNECTION -type error = [ Caqti_error.call_or_retrieve | `Not_found | `File_error of Fpath.t ] +type error = [ Caqti_error.call_or_retrieve | `Not_found | `File_error of Fpath.t | `Msg of string ] let pp_error ppf = function | `Not_found -> Format.fprintf ppf "value not found in database" | `File_error path -> Format.fprintf ppf "error reading file %a" Fpath.pp path + | `Msg e -> Format.fprintf ppf "error %s" e | #Caqti_error.call_or_retrieve as e -> Caqti_error.pp ppf e @@ -55,16 +56,52 @@ let user username (module Db : CONN) = Db.find_opt Builder_db.User.get_user username >|= Option.map snd -let dummy_save base (filepath, data) = - let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in - let localpath = Fpath.append base filepath in - { Builder_db.filepath; localpath; sha256 } +let save file data = + let open Lwt.Infix in + Lwt_io.open_file ~mode:Lwt_io.Output (Fpath.to_string file) >>= fun oc -> + Lwt_io.write oc data >>= fun () -> + Lwt_io.close oc -let add_build (job, uuid, console, start, finish, result, artifacts) (module Db : CONN) = +let save_exec build_dir exec = + let cs = Builder.Asn.exec_to_cs exec in + save Fpath.(build_dir / "full") (Cstruct.to_string cs) + +let save_file dir (filepath, data) = + let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in + let localpath = Fpath.append dir filepath in + Lwt.bind + (save localpath data) + (fun () -> Lwt.return { Builder_db.filepath; localpath; sha256 }) + +let save_all basedir ((job, uuid, _, _, _, _, artifacts) as exec) = + let build_dir = Fpath.(basedir / job.Builder.name / Uuidm.to_string uuid) in + let input_dir = Fpath.(build_dir / "input") in + let output_dir = Fpath.(build_dir / "output") in + Lwt.return (Bos.OS.Dir.create build_dir) >>= (fun created -> + if not created + then Lwt_result.fail (`Msg "build directory already exists") + else Lwt_result.return ()) >>= fun () -> + Lwt.return (Bos.OS.Dir.create input_dir) >>= fun _ -> + Lwt.return (Bos.OS.Dir.create output_dir) >>= fun _ -> + Lwt.catch + (fun () -> + let open Lwt.Infix in + save_exec build_dir exec >>= fun () -> + Lwt_list.map_s (save_file input_dir) job.Builder.files >>= fun input_files -> + Lwt_list.map_s (save_file output_dir) artifacts >>= fun artifacts -> + Lwt_result.return (artifacts, input_files)) + (function + | Unix.Unix_error (e, _, _) -> + Lwt_result.fail (`Msg (Unix.error_message e)) + | e -> Lwt.fail e) + +let add_build + basedir + ((job, uuid, console, start, finish, result, _) as exec) + (module Db : CONN) = let open Builder_db in let job_name = job.Builder.name in - let output_dir = Fmt.strf "/var/db/builder/%s/%a/output" job_name Uuidm.pp uuid in - let input_dir = Fmt.strf "/var/db/builder/%s/%a/input" job_name Uuidm.pp uuid in + save_all basedir exec >>= fun (artifacts, input_files) -> Db.exec Job.try_add job_name >>= fun () -> Db.find Job.get_id_by_name job_name >>= fun job_id -> Db.exec Build.add { Build.uuid; start; finish; result; @@ -75,10 +112,10 @@ let add_build (job, uuid, console, start, finish, result, artifacts) (module Db r >>= fun () -> Db.exec Build_artifact.add (file, id)) (Lwt_result.return ()) - (List.map (dummy_save (Fpath.v output_dir)) artifacts) >>= fun () -> + artifacts >>= fun () -> List.fold_left (fun r file -> r >>= fun () -> Db.exec Build_file.add (file, id)) (Lwt_result.return ()) - (List.map (dummy_save (Fpath.v input_dir)) job.Builder.files) + input_files diff --git a/lib/model.mli b/lib/model.mli index f73f4f0..cc15a68 100644 --- a/lib/model.mli +++ b/lib/model.mli @@ -1,4 +1,4 @@ -type error = [ Caqti_error.call_or_retrieve | `Not_found | `File_error of Fpath.t ] +type error = [ Caqti_error.call_or_retrieve | `Not_found | `File_error of Fpath.t | `Msg of string ] val pp_error : Format.formatter -> error -> unit @@ -22,6 +22,7 @@ val user : string -> Caqti_lwt.connection -> val add_build : + Fpath.t -> (Builder.job * Uuidm.t * (int * string) list * Ptime.t * Ptime.t * Builder.execution_result * (Fpath.t * string) list) -> Caqti_lwt.connection ->