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)
-
+     | ex -> Lwt.reraise ex)

lib/btrfs_store.ml

@@ -154,7 +154,7 @@ let build t ?base ~id fn =
   (fun ex ->
       Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn ex);
       Btrfs.subvolume_delete result_tmp >>= fun () ->
-      Lwt.fail ex
+      Lwt.reraise ex
   )
 
 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
+      | ex -> Lwt.reraise ex
     )
 
 let tail ?switch t dst =

lib/docker_store.ml

@@ -110,9 +110,9 @@ let build t ?base ~id (fn:(string -> (unit, 'e) Lwt_result.t)) : (unit, 'e) Lwt_
   | None ->
     Lwt.catch
       (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)
+      (fun ex ->
+         Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn ex);
+         Lwt.reraise ex)
   | Some base ->
     let base = Docker.docker_image base in
     let tmp_image = (Docker.docker_image ~tmp:true id) in
@@ -125,10 +125,10 @@ let build t ?base ~id (fn:(string -> (unit, 'e) Lwt_result.t)) : (unit, 'e) Lwt_
             the container still has a reference to the cache. *)
          let+ () = Docker.Cmd.image (`Remove tmp_image) in
          r)
-      (fun exn ->
-         Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn exn);
+      (fun ex ->
+         Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn ex);
          let* () = Docker.Cmd.image (`Remove tmp_image) in
-         Lwt.fail exn)
+         Lwt.reraise ex)
 
 let delete t id =
   let image = Docker.docker_image id in

lib/os.ml

@@ -238,7 +238,7 @@ let win32_unlink fn =
   Lwt.catch
     (fun () -> Lwt_unix.unlink fn)
     (function
-      | Unix.Unix_error (Unix.EACCES, _, _) as exn ->
+      | Unix.Unix_error (Unix.EACCES, _, _) as ex ->
         Lwt_unix.lstat fn >>= fun {st_perm; _} ->
         (* Try removing the read-only attribute *)
         Lwt_unix.chmod fn 0o666 >>= fun () ->
@@ -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 ex)
+      | ex -> Lwt.reraise ex)
 
 let unlink =
   if Sys.win32 then

lib/overlayfs_store.ml

@@ -202,7 +202,8 @@ let build t ?base ~id fn =
       >>= 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)
+      Overlayfs.delete [ merged; work; in_progress ] >>= fun () ->
+      Lwt.reraise ex)
 
 let delete t id =
   let path = Path.result t id in
@@ -218,7 +219,7 @@ let delete t id =
       |> List.map decendants
       |> List.flatten
       |> List.append [ parent ]
-  in decendants path 
+  in decendants path
       |> Overlayfs.delete
 
 let result t id =

lib/rsync_store.ml

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

lib/xfs_store.ml

@@ -78,7 +78,7 @@ let build t ?base ~id fn =
     (fun ex ->
       Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn ex);
       Xfs.delete result_tmp >>= fun () ->
-      Lwt.fail ex
+      Lwt.reraise ex
     )
 
 let delete t id =
@@ -136,7 +136,7 @@ let cache ~user t name =
         cache.gen <- cache.gen + 1;
         Xfs.delete snapshot >>= fun () ->
         Xfs.rename ~src:tmp ~dst:snapshot
-      ) else 
+      ) else
         Xfs.delete tmp
     end
   in

lib/zfs_store.ml

@@ -247,7 +247,7 @@ let build t ?base ~id fn =
     (fun ex ->
         Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn ex);
         Zfs.destroy t ds `And_snapshots >>= fun () ->
-        Lwt.fail ex
+        Lwt.reraise ex
     )
 
 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.16"}
-  "lwt" {>= "5.6.1"}
+  "lwt" {>= "5.7.0"}
   "astring"
   "fmt" {>= "0.8.9"}
   "logs"