From 9326ffcde2012e5c530771ac64aef62387b1735f Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Wed, 17 Jul 2024 09:23:25 +0100 Subject: [PATCH] Silence stderr for zfs --- lib/os.ml | 12 ++++++++---- lib/zfs_store.ml | 10 +++++----- 2 files changed, 13 insertions(+), 9 deletions(-) diff --git a/lib/os.ml b/lib/os.ml index 8fd55c7d..16b9ea25 100644 --- a/lib/os.ml +++ b/lib/os.ml @@ -43,6 +43,9 @@ let close_redirection (x : [`FD_move_safely of unix_fd | `Dev_null]) = | `FD_move_safely x -> ensure_closed_unix x | `Dev_null -> () +let log_std v = + Logs.info (fun f -> f "Stderr %s" (match v with Some `Dev_null -> "DEVNULL" | Some `FD_move_safely _ -> "FD" | None -> "none")) + (* stdin, stdout and stderr are copied to the child and then closed on the host. They are closed at most once, so duplicates are OK. *) let default_exec ?timeout ?cwd ?stdin ?stdout ?stderr ~pp argv = @@ -50,7 +53,7 @@ let default_exec ?timeout ?cwd ?stdin ?stdout ?stderr ~pp argv = let stdin = Option.map redirection stdin in let stdout = Option.map redirection stdout in let stderr = Option.map redirection stderr in - try Lwt_result.ok (Lwt_process.exec ?timeout ?cwd ?stdin ?stdout ?stderr argv) + try Lwt_result.ok (Lwt_process.exec ?timeout ?cwd ?stdin ?stdout ~stderr:`Close argv) with e -> Lwt_result.fail e in Option.iter close_redirection stdin; @@ -102,6 +105,7 @@ let exec_result ?cwd ?stdin ?stdout ?stderr ~pp ?(is_success=((=) 0)) ?(cmd="") let exec ?timeout ?cwd ?stdin ?stdout ?stderr ?(is_success=((=) 0)) ?(cmd="") argv = Logs.info (fun f -> f "Exec %a" pp_cmd (cmd, argv)); + log_std stderr; let pp f = pp_cmd f (cmd, argv) in !lwt_process_exec ?timeout ?cwd ?stdin ?stdout ?stderr ~pp (cmd, Array.of_list argv) >>= function | Ok n when is_success n -> Lwt.return_unit @@ -110,13 +114,13 @@ let exec ?timeout ?cwd ?stdin ?stdout ?stderr ?(is_success=((=) 0)) ?(cmd="") ar let running_as_root = not (Sys.unix) || Unix.getuid () = 0 -let sudo ?stdin args = +let sudo ?(stdout=`Dev_null) ?stdin args = let args = if running_as_root then args else "sudo" :: "--" :: args in - exec ?stdin args + exec ?stdin ~stdout ~stderr:`Dev_null args let sudo_result ?cwd ?stdin ?stdout ?stderr ?is_success ~pp args = let args = if running_as_root then args else "sudo" :: "--" :: args in - exec_result ?cwd ?stdin ?stdout ?stderr ?is_success ~pp args + exec_result ?cwd ?stdin ?stdout ~stderr:`Dev_null ?is_success ~pp args let rec write_all fd buf ofs len = assert (len >= 0); diff --git a/lib/zfs_store.ml b/lib/zfs_store.ml index 19510345..9dc7acf8 100644 --- a/lib/zfs_store.ml +++ b/lib/zfs_store.ml @@ -104,7 +104,7 @@ end = struct else strf "%s%s/.zfs/snapshot/%s" t.prefix (dataset_no_pool t.subdir ds) snapshot let exists_raw raw = - Lwt_process.pread ("", [| "zfs"; "list"; "-p"; "-H"; raw |]) >>= function + Lwt_process.pread ~stderr:`Dev_null ("", [| "zfs"; "list"; "-p"; "-H"; raw |]) >>= function | "" -> Lwt.return false | _ -> Lwt.return true @@ -173,7 +173,7 @@ module Zfs = struct Os.sudo ["zfs"; "clone"; "--"; Dataset.full_name t src ~snapshot; Dataset.full_name t dst] let mounted ?snapshot t ~ds = - Lwt_process.pread ("", [| "zfs"; "get"; "-pH"; "mounted"; Dataset.full_name t ds ?snapshot |]) >>= fun s -> + Lwt_process.pread ~stderr:`Dev_null ("", [| "zfs"; "get"; "-pH"; "mounted"; Dataset.full_name t ds ?snapshot |]) >>= fun s -> match ( Scanf.sscanf s "%s %s %s %s" (fun _ _ yesno _ -> yesno = "yes") ) with | state -> Lwt.return state | exception Scanf.Scan_failure _ -> Lwt.return false @@ -182,7 +182,7 @@ module Zfs = struct mounted t ~ds ?snapshot >>= fun m -> if not m then let pp _ ppf = Fmt.pf ppf "zfs mount" in - let* t = Os.sudo_result ~pp:(pp "zfs mount") ~is_success:(fun n -> n = 0 || n = 16) ["zfs"; "mount"; "--"; Dataset.full_name t ds ?snapshot] in + let* t = Os.sudo_result ~stdout:`Dev_null ~stderr:`Dev_null ~pp:(pp "zfs mount") ~is_success:(fun n -> n = 0 || n = 16) ["zfs"; "mount"; "--"; Dataset.full_name t ds ?snapshot] in match t with | Ok () -> Lwt.return () | Error (`Msg m) -> @@ -195,7 +195,7 @@ module Zfs = struct Os.sudo ["zfs"; "mount"; Dataset.full_name t dst] >>= fun () -> let vol = Dataset.full_name t src in let len = String.length vol in - Lwt_process.pread ("", [| "zfs"; "list"; "-H"; "-r"; "-o"; "name"; vol |]) >>= fun output -> + Lwt_process.pread ~stderr:`Dev_null ("", [| "zfs"; "list"; "-H"; "-r"; "-o"; "name"; vol |]) >>= fun output -> String.split_on_char '\n' output |> List.map (fun s -> (s, String.length s)) |> List.filter (fun (_, l) -> l > len) |> List.map (fun (s, l) -> String.sub s (len + 1) (l - len - 1)) |> Lwt_list.iter_s (fun subvolume -> Os.sudo ["zfs"; "clone"; "-o"; "mountpoint=none"; "--"; @@ -226,7 +226,7 @@ let state_dir t = Dataset.path t Dataset.state let root t = t.pool let df t = - Lwt_process.pread ("", [| "zpool"; "list"; "-Hp"; "-o"; "capacity"; t.pool |]) >>= fun s -> + Lwt_process.pread ~stderr:`Dev_null ("", [| "zpool"; "list"; "-Hp"; "-o"; "capacity"; t.pool |]) >>= fun s -> match (String.trim s) with | "" -> Lwt.return 0. | s -> Lwt.return (100. -. float_of_string s)