diff --git a/dune-project b/dune-project index 61c2010a..0f633fb8 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..96e4384f 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) - + | ex -> Lwt.reraise ex) diff --git a/lib/btrfs_store.ml b/lib/btrfs_store.ml index f9618c6a..bab2763f 100644 --- a/lib/btrfs_store.ml +++ b/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 = diff --git a/lib/build_log.ml b/lib/build_log.ml index 02b23951..7eb7abba 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 + | ex -> Lwt.reraise ex ) let tail ?switch t dst = diff --git a/lib/docker_store.ml b/lib/docker_store.ml index d93baff6..a9a44e24 100644 --- a/lib/docker_store.ml +++ b/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 diff --git a/lib/os.ml b/lib/os.ml index 24eed766..3887fa3a 100644 --- a/lib/os.ml +++ b/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 diff --git a/lib/overlayfs_store.ml b/lib/overlayfs_store.ml index 18070953..c4f61f28 100644 --- a/lib/overlayfs_store.ml +++ b/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 = diff --git a/lib/rsync_store.ml b/lib/rsync_store.ml index dfc15b6f..f95d2ff0 100644 --- a/lib/rsync_store.ml +++ b/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 = diff --git a/lib/xfs_store.ml b/lib/xfs_store.ml index 7ae68ab3..992a0681 100644 --- a/lib/xfs_store.ml +++ b/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 diff --git a/lib/zfs_store.ml b/lib/zfs_store.ml index 4f870333..a810c18a 100644 --- a/lib/zfs_store.ml +++ b/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 = diff --git a/obuilder.opam b/obuilder.opam index 228fda6d..5346a1b2 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.16"} - "lwt" {>= "5.6.1"} + "lwt" {>= "5.7.0"} "astring" "fmt" {>= "0.8.9"} "logs"