Skip to content

Commit

Permalink
Include stderr in error reports for easier debugging (#320)
Browse files Browse the repository at this point in the history
Fixes #318
  • Loading branch information
JasonGross authored Oct 16, 2024
1 parent d5d3c0b commit 001a4ca
Show file tree
Hide file tree
Showing 3 changed files with 31 additions and 5 deletions.
19 changes: 14 additions & 5 deletions src/git_utils.ml
Original file line number Diff line number Diff line change
Expand Up @@ -11,10 +11,13 @@ let gitlab_repo ~bot_info ~gitlab_domain ~gitlab_full_name =
|> Result.map ~f:(fun token ->
f "https://oauth2:%s@%s/%s.git" token gitlab_domain gitlab_full_name )

let report_status ?(mask = []) command report code =
let report_status ?(mask = []) ?(stderr_content = "") command report code =
let stderr =
if String.is_empty stderr_content then "" else stderr_content ^ "\n"
in
Error
(List.fold_left
~init:(f {|Command "%s" %s %d%s|} command report code "\n")
~init:(f {|Command "%s" %s %d%s%s|} command report code "\n" stderr)
~f:(fun acc m -> Str.global_replace (Str.regexp_string m) "XXXXX" acc)
mask )

Expand Down Expand Up @@ -89,12 +92,18 @@ let ( |&& ) command1 command2 = command1 ^ " && " ^ command2
let execute_cmd ?(mask = []) command =
Lwt_io.printf "Executing command: %s\n" command
>>= fun () ->
Lwt_unix.system command
>|= fun status ->
let process = Lwt_process.open_process_full (Lwt_process.shell command) in
let stdout_pipe = copy_stream ~src:process#stdout ~dst:Lwt_io.stdout in
let stderr_pipe = copy_stream ~src:process#stderr ~dst:Lwt_io.stderr in
(* Capture stdout and stderr in parallel *)
(* Wait for the process to finish *)
let+ _stdout_content = stdout_pipe
and+ stderr_content = stderr_pipe
and+ status = process#status in
match status with
| Unix.WEXITED code ->
if Int.equal code 0 then Ok ()
else report_status ~mask command "exited with status" code
else report_status ~mask ~stderr_content command "exited with status" code
| Unix.WSIGNALED signal ->
report_status ~mask command "was killed by signal number" signal
| Unix.WSTOPPED signal ->
Expand Down
14 changes: 14 additions & 0 deletions src/helpers.ml
Original file line number Diff line number Diff line change
Expand Up @@ -169,3 +169,17 @@ let download ~uri dest =

let download_to ~uri chan =
download_cps ~uri ~with_file:(fun write_to -> write_to chan)

let copy_stream ~src ~dst =
let open Lwt.Infix in
let buffer = Buffer.create 1024 in
let rec aux () =
Lwt_io.read_char_opt src
>>= function
| Some c ->
Buffer.add_char buffer c ;
Lwt_io.write_char dst c >>= aux
| None ->
Lwt.return (Buffer.contents buffer)
in
aux ()
3 changes: 3 additions & 0 deletions src/helpers.mli
Original file line number Diff line number Diff line change
Expand Up @@ -40,3 +40,6 @@ val download : uri:Uri.t -> string -> (unit, string) Lwt_result.t

val download_to :
uri:Uri.t -> Lwt_io.output_channel -> (unit, string) Lwt_result.t

val copy_stream :
src:Lwt_io.input_channel -> dst:Lwt_io.output_channel -> string Lwt.t

0 comments on commit 001a4ca

Please sign in to comment.