robur/builder-web
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix bugs

Browse source 
Parent directories for input file and output files must be created.
This commit is contained in:
Reynir Björnsson 2021-01-21 18:12:26 +01:00
parent 0f98541feb
commit 484658d23a
2 changed files with 27 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lib/builder_web.ml
View file

@ -187,7 +187,7 @@ let routes t =
let* r = Caqti_lwt.Pool.use (Model.add_build t.datadir exec) t.pool in let* r = Caqti_lwt.Pool.use (Model.add_build t.datadir exec) t.pool in
match r with match r with
| Ok () -> | Ok () ->
Lwt.return (Response.of_plain_text "Success!") Lwt.return (Response.of_plain_text "Success!\n")
| Error e -> | Error e ->
Log.warn (fun m -> m "Error saving build %a: %a" pp_exec exec pp_error e); Log.warn (fun m -> m "Error saving build %a: %a" pp_exec exec pp_error e);
Lwt.return (Response.of_plain_text "Internal server error\n" ~status:`Internal_server_error) Lwt.return (Response.of_plain_text "Internal server error\n" ~status:`Internal_server_error)

43
lib/model.ml
View file

@ -58,9 +58,16 @@ let user username (module Db : CONN) =
let save file data = let save file data =
let open Lwt.Infix in let open Lwt.Infix in
Lwt_io.open_file ~mode:Lwt_io.Output (Fpath.to_string file) >>= fun oc -> Lwt.catch
Lwt_io.write oc data >>= fun () -> (fun () ->
Lwt_io.close oc Lwt_io.open_file ~mode:Lwt_io.Output (Fpath.to_string file) >>= fun oc ->
Lwt_io.write oc data >>= fun () ->
Lwt_io.close oc
|> Lwt_result.ok)
(function
| Unix.Unix_error (e, _, _) ->
Lwt_result.fail (`Msg (Unix.error_message e))
| e -> Lwt.fail e)
let save_exec build_dir exec = let save_exec build_dir exec =
let cs = Builder.Asn.exec_to_cs exec in let cs = Builder.Asn.exec_to_cs exec in
@ -69,9 +76,18 @@ let save_exec build_dir exec =
let save_file dir (filepath, data) = let save_file dir (filepath, data) =
let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in
let localpath = Fpath.append dir filepath in let localpath = Fpath.append dir filepath in
Lwt.bind Lwt_result.lift (Bos.OS.Dir.create (Fpath.parent localpath)) >>= fun _ ->
(save localpath data) save localpath data >|= fun () ->
(fun () -> Lwt.return { Builder_db.filepath; localpath; sha256 }) { Builder_db.filepath; localpath; sha256 }
let save_files dir files =
List.fold_left
(fun r file ->
r >>= fun acc ->
save_file dir file >>= fun file ->
Lwt_result.return (file :: acc))
(Lwt_result.return [])
files
let save_all basedir ((job, uuid, _, _, _, _, artifacts) as exec) = let save_all basedir ((job, uuid, _, _, _, _, artifacts) as exec) =
let build_dir = Fpath.(basedir / job.Builder.name / Uuidm.to_string uuid) in let build_dir = Fpath.(basedir / job.Builder.name / Uuidm.to_string uuid) in
@ -83,17 +99,10 @@ let save_all basedir ((job, uuid, _, _, _, _, artifacts) as exec) =
else Lwt_result.return ()) >>= fun () -> else Lwt_result.return ()) >>= fun () ->
Lwt.return (Bos.OS.Dir.create input_dir) >>= fun _ -> Lwt.return (Bos.OS.Dir.create input_dir) >>= fun _ ->
Lwt.return (Bos.OS.Dir.create output_dir) >>= fun _ -> Lwt.return (Bos.OS.Dir.create output_dir) >>= fun _ ->
Lwt.catch save_exec build_dir exec >>= fun () ->
(fun () -> save_files output_dir artifacts >>= fun artifacts ->
let open Lwt.Infix in save_files input_dir job.Builder.files >>= fun input_files ->
save_exec build_dir exec >>= fun () -> Lwt_result.return (artifacts, input_files)
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 let add_build
basedir basedir