From 001a4cadff0b66515c2e29f5b53a649294a5301e Mon Sep 17 00:00:00 2001
From: Jason Gross <jgross@mit.edu>
Date: Wed, 16 Oct 2024 10:39:11 -0700
Subject: [PATCH] Include stderr in error reports for easier debugging (#320)

Fixes #318
---
 src/git_utils.ml | 19 ++++++++++++++-----
 src/helpers.ml   | 14 ++++++++++++++
 src/helpers.mli  |  3 +++
 3 files changed, 31 insertions(+), 5 deletions(-)

diff --git a/src/git_utils.ml b/src/git_utils.ml
index 652dacdb..d61aafc4 100644
--- a/src/git_utils.ml
+++ b/src/git_utils.ml
@@ -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 )
 
@@ -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 ->
diff --git a/src/helpers.ml b/src/helpers.ml
index 00076b35..cd33b60d 100644
--- a/src/helpers.ml
+++ b/src/helpers.ml
@@ -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 ()
diff --git a/src/helpers.mli b/src/helpers.mli
index f5c65e3c..11d2eae5 100644
--- a/src/helpers.mli
+++ b/src/helpers.mli
@@ -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