Re-raise exceptions to preserve backtraces

dune-project

@@ -25,7 +25,7 @@
  (description
   "OBuilder takes a build script (similar to a Dockerfile) and performs the steps in it in a sandboxed environment.")
  (depends
-  (lwt (>= 5.6.1))
+  (lwt (>= 5.7.0))
   astring
   (fmt (>= 0.8.9))
   logs

lib/archive_extract.ml

@@ -24,5 +24,4 @@ let fetch ~log ~rootfs base =
     (function
      | Sys_error s ->
        Fmt.failwith "Archive fetcher encountered a system error: %s" s
-     | e -> Lwt.fail e)
-
+     | exn -> Lwt.reraise exn)

lib/btrfs_store.ml

@@ -151,10 +151,10 @@ let build t ?base ~id fn =
        Btrfs.subvolume_delete result_tmp >>= fun () ->
        Lwt.return r
     )
-  (fun ex ->
-      Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn ex);
+  (fun exn ->
+      Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn exn);
       Btrfs.subvolume_delete result_tmp >>= fun () ->
-      Lwt.fail ex
+      Lwt.reraise exn
   )
 
 let result t id =

lib/build_log.ml

@@ -22,7 +22,7 @@ let catch_cancel fn =
   Lwt.catch fn
     (function
       | Lwt.Canceled -> Lwt_result.fail `Cancelled
-      | ex -> Lwt.fail ex
+      | exn -> Lwt.reraise exn
     )
 
 let tail ?switch t dst =

lib/docker_store.ml

@@ -112,7 +112,7 @@ let build t ?base ~id (fn:(string -> (unit, 'e) Lwt_result.t)) : (unit, 'e) Lwt_
       (fun () -> fn (Path.empty t))
       (fun exn ->
          Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn exn);
-         Lwt.fail exn)
+         Lwt.reraise exn)
   | Some base ->
     let base = Docker.docker_image base in
     let tmp_image = (Docker.docker_image ~tmp:true id) in
@@ -128,7 +128,7 @@ let build t ?base ~id (fn:(string -> (unit, 'e) Lwt_result.t)) : (unit, 'e) Lwt_
       (fun exn ->
          Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn exn);
          let* () = Docker.Cmd.image (`Remove tmp_image) in
-         Lwt.fail exn)
+         Lwt.reraise exn)
 
 let delete t id =
   let image = Docker.docker_image id in

lib/os.ml

@@ -247,8 +247,8 @@ let win32_unlink fn =
           (function _ ->
              (* Restore original permissions *)
              Lwt_unix.chmod fn st_perm >>= fun () ->
-             Lwt.fail exn)
-      | exn -> Lwt.fail exn)
+             Lwt.reraise exn)
+      | exn -> Lwt.reraise exn)
 
 let unlink =
   if Sys.win32 then

lib/overlayfs_store.ml

@@ -200,9 +200,10 @@ let build t ?base ~id fn =
         Overlayfs.delete [ merged; work ]
       | Error _ -> Overlayfs.delete [ merged; work; in_progress ])
       >>= fun () -> Lwt.return r)
-    (fun ex ->
-      Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn ex);
-      Overlayfs.delete [ merged; work; in_progress ] >>= fun () -> Lwt.fail ex)
+    (fun exn ->
+      Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn exn);
+      Overlayfs.delete [ merged; work; in_progress ] >>= fun () ->
+      Lwt.reraise exn)
 
 let delete t id =
   let path = Path.result t id in

lib/rsync_store.ml

@@ -107,10 +107,10 @@ let build t ?base ~id fn =
       end >>= fun () ->
       Lwt.return r
     )
-    (fun ex ->
-      Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn ex);
+    (fun exn ->
+      Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn exn);
       Rsync.delete result_tmp >>= fun () ->
-      Lwt.fail ex
+      Lwt.reraise exn
     )
 
 let delete t id =

lib/xfs_store.ml

@@ -75,10 +75,10 @@ let build t ?base ~id fn =
       end >>= fun () ->
       Lwt.return r
     )
-    (fun ex ->
-      Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn ex);
+    (fun exn ->
+      Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn exn);
       Xfs.delete result_tmp >>= fun () ->
-      Lwt.fail ex
+      Lwt.reraise exn
     )
 
 let delete t id =

lib/zfs_store.ml

@@ -244,10 +244,10 @@ let build t ?base ~id fn =
         Zfs.destroy t ds `And_snapshots >>= fun () ->
         Lwt.return e
     )
-    (fun ex ->
-        Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn ex);
+    (fun exn ->
+        Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn exn);
         Zfs.destroy t ds `And_snapshots >>= fun () ->
-        Lwt.fail ex
+        Lwt.reraise exn
     )
 
 let result t id =

obuilder.opam

@@ -25,7 +25,7 @@ doc: "https://ocurrent.github.io/obuilder/"
 bug-reports: "https://github.com/ocurrent/obuilder/issues"
 depends: [
   "dune" {>= "3.7"}
-  "lwt" {>= "5.6.1"}
+  "lwt" {>= "5.7.0"}
   "astring"
   "fmt" {>= "0.8.9"}
   "logs"