From e0e6ff5f6fc13c55af31eb7a997d5bb35891ee9c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Tue, 3 Sep 2024 15:40:39 +0200 Subject: [PATCH] Re-raise exceptions to preserve backtraces --- dune-project | 2 +- lib/archive_extract.ml | 3 +-- lib/btrfs_store.ml | 6 +++--- lib/build_log.ml | 2 +- lib/docker_store.ml | 4 ++-- lib/os.ml | 4 ++-- lib/overlayfs_store.ml | 7 ++++--- lib/rsync_store.ml | 6 +++--- lib/xfs_store.ml | 6 +++--- lib/zfs_store.ml | 6 +++--- obuilder.opam | 2 +- 11 files changed, 24 insertions(+), 24 deletions(-) diff --git a/dune-project b/dune-project index dbe3fe81..aabe85ed 100644 --- a/dune-project +++ b/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 diff --git a/lib/archive_extract.ml b/lib/archive_extract.ml index 2c84bd0d..62dd98b4 100644 --- a/lib/archive_extract.ml +++ b/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) diff --git a/lib/btrfs_store.ml b/lib/btrfs_store.ml index f9618c6a..4d0b20ce 100644 --- a/lib/btrfs_store.ml +++ b/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 = diff --git a/lib/build_log.ml b/lib/build_log.ml index 02b23951..d762720b 100644 --- a/lib/build_log.ml +++ b/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 = diff --git a/lib/docker_store.ml b/lib/docker_store.ml index d93baff6..948fcd84 100644 --- a/lib/docker_store.ml +++ b/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 diff --git a/lib/os.ml b/lib/os.ml index 24eed766..17801c37 100644 --- a/lib/os.ml +++ b/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 diff --git a/lib/overlayfs_store.ml b/lib/overlayfs_store.ml index 18070953..9f1f978b 100644 --- a/lib/overlayfs_store.ml +++ b/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 diff --git a/lib/rsync_store.ml b/lib/rsync_store.ml index dfc15b6f..df84133c 100644 --- a/lib/rsync_store.ml +++ b/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 = diff --git a/lib/xfs_store.ml b/lib/xfs_store.ml index 7ae68ab3..219e18c6 100644 --- a/lib/xfs_store.ml +++ b/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 = diff --git a/lib/zfs_store.ml b/lib/zfs_store.ml index 4f870333..695f6204 100644 --- a/lib/zfs_store.ml +++ b/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 = diff --git a/obuilder.opam b/obuilder.opam index 8e3b9170..7bd4f978 100644 --- a/obuilder.opam +++ b/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"