From 714fb00dbbfab421430b0fefec4419858ef91f33 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Tue, 25 Feb 2025 17:46:19 +0100 Subject: [PATCH 1/2] Fix printing signal numbers --- bin/admin.ml | 4 ++-- bin/worker.ml | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/bin/admin.ml b/bin/admin.ml index dd562e26..fbb756ea 100644 --- a/bin/admin.ml +++ b/bin/admin.ml @@ -65,8 +65,8 @@ let show () cap_path terse pool worker = let check_exit_status = function | Unix.WEXITED 0 -> () | Unix.WEXITED x -> Fmt.failwith "Sub-process failed with exit code %d" x - | Unix.WSIGNALED x -> Fmt.failwith "Sub-process failed with signal %d" x - | Unix.WSTOPPED x -> Fmt.failwith "Sub-process stopped with signal %d" x + | Unix.WSIGNALED x -> Fmt.failwith "Sub-process failed with signal %a" Fmt.Dump.signal x + | Unix.WSTOPPED x -> Fmt.failwith "Sub-process stopped with signal %a" Fmt.Dump.signal x let exec () cap_path pool command = run cap_path @@ fun admin_service -> diff --git a/bin/worker.ml b/bin/worker.ml index c5b57525..8010c2f4 100644 --- a/bin/worker.ml +++ b/bin/worker.ml @@ -15,8 +15,8 @@ let or_die = function let check_exit_status = function | Unix.WEXITED 0 -> () | Unix.WEXITED x -> Fmt.failwith "Sub-process failed with exit code %d" x - | Unix.WSIGNALED x -> Fmt.failwith "Sub-process failed with signal %d" x - | Unix.WSTOPPED x -> Fmt.failwith "Sub-process stopped with signal %d" x + | Unix.WSIGNALED x -> Fmt.failwith "Sub-process failed with signal %a" Fmt.Dump.signal x + | Unix.WSTOPPED x -> Fmt.failwith "Sub-process stopped with signal %a" Fmt.Dump.signal x module Self_update = struct let service = "builder_agent" From 5b2d1bdf5fc71cf9a4be30d635217617ef68410f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Tue, 25 Feb 2025 17:46:25 +0100 Subject: [PATCH 2/2] Display Windows NTSTATUS exit codes in hex On Windows, "negative" exit codes are probably NTSTATUS values. For example, if a program accesses an invalid memory location, Unix sends a SIGSEGV signal which, if unhandled, will terminate the process (setting some kind of non-zero exit code - for example, Linux sets the exit code to 128 + signal number to give a fairly memorable 139). In the equivalent scenario, Windows throws an EXCEPTION_ACCESS_VIOLATION which, if handled by the default exception handler, will terminate the process with exit code STATUS_ACCESS_VIOLATION. These codes are large negative numbers, which are not terribly memorable in decimal, so for negative exit codes we instead display them in hexadecimal as 0xc0000005 is slightly more memorable than -1073741819. --- bin/admin.ml | 2 +- bin/logging.ml | 6 ++++++ bin/worker.ml | 2 +- worker/process.ml | 8 +++++++- 4 files changed, 15 insertions(+), 3 deletions(-) diff --git a/bin/admin.ml b/bin/admin.ml index fbb756ea..28795ad1 100644 --- a/bin/admin.ml +++ b/bin/admin.ml @@ -64,7 +64,7 @@ let show () cap_path terse pool worker = let check_exit_status = function | Unix.WEXITED 0 -> () - | Unix.WEXITED x -> Fmt.failwith "Sub-process failed with exit code %d" x + | Unix.WEXITED x -> Fmt.failwith "Sub-process failed with exit code %a" Logging.pp_exit_status x | Unix.WSIGNALED x -> Fmt.failwith "Sub-process failed with signal %a" Fmt.Dump.signal x | Unix.WSTOPPED x -> Fmt.failwith "Sub-process stopped with signal %a" Fmt.Dump.signal x diff --git a/bin/logging.ml b/bin/logging.ml index 8eaa12df..34ae8589 100644 --- a/bin/logging.ml +++ b/bin/logging.ml @@ -1,3 +1,9 @@ +let pp_exit_status f n = + if Sys.win32 && n < 0 then + Fmt.pf f "0x%08lx" (Int32.of_int n) + else + Fmt.int f n + let pp_timestamp f x = let open Unix in let tm = localtime x in diff --git a/bin/worker.ml b/bin/worker.ml index 8010c2f4..f78cda73 100644 --- a/bin/worker.ml +++ b/bin/worker.ml @@ -14,7 +14,7 @@ let or_die = function let check_exit_status = function | Unix.WEXITED 0 -> () - | Unix.WEXITED x -> Fmt.failwith "Sub-process failed with exit code %d" x + | Unix.WEXITED x -> Fmt.failwith "Sub-process failed with exit code %a" Logging.pp_exit_status x | Unix.WSIGNALED x -> Fmt.failwith "Sub-process failed with signal %a" Fmt.Dump.signal x | Unix.WSTOPPED x -> Fmt.failwith "Sub-process stopped with signal %a" Fmt.Dump.signal x diff --git a/worker/process.ml b/worker/process.ml index f8c0b27a..5f0f5bd3 100644 --- a/worker/process.ml +++ b/worker/process.ml @@ -41,9 +41,15 @@ let exec ~label ~log ~switch ?env ?(stdin="") ?(stderr=`FD_copy Unix.stdout) ?(i | Unix.WSIGNALED x -> Fmt.error_msg "%s failed with signal %a" label Fmt.Dump.signal x | Unix.WSTOPPED x -> Fmt.error_msg "%s stopped with signal %a" label Fmt.Dump.signal x +let pp_exit_status f n = + if Sys.win32 && n < 0 then + Fmt.pf f "0x%08lx" (Int32.of_int n) + else + Fmt.int f n + let check_call ~label ~log ~switch ?env ?stdin ?stderr ?is_success cmd = exec ~label ~log ~switch ?env ?stdin ?stderr ?is_success cmd >|= function | Ok () -> Ok () | Error `Cancelled -> Error `Cancelled - | Error (`Exit_code n) -> Fmt.error_msg "%s failed with exit-code %d" label n + | Error (`Exit_code n) -> Fmt.error_msg "%s failed with exit-code %a" label pp_exit_status n | Error (`Msg _) as e -> e