File 3251-Add-support-for-disksup-get_disk_info-0-1.patch of Package erlang

From d004daa61adcfee0e4acf65f1762a802d320fe8e Mon Sep 17 00:00:00 2001
From: Luke Bakken <luke@bakken.io>
Date: Fri, 21 Oct 2022 14:13:27 -0700
Subject: [PATCH] Add support for `disksup:get_disk_info/[0,1]`

References #6156

https://github.com/erlang/otp/issues/6156#issuecomment-1208010552

This PR adds support for a function that will immediately fetch total
and available disk space for all local drives, or for a specific path.
---
 lib/os_mon/doc/src/disksup.xml    |  49 ++++++-
 lib/os_mon/src/disksup.erl        | 210 +++++++++++++++++++++++++-----
 lib/os_mon/test/disksup_SUITE.erl |  30 ++++-
 3 files changed, 248 insertions(+), 41 deletions(-)

diff --git a/lib/os_mon/doc/src/disksup.xml b/lib/os_mon/doc/src/disksup.xml
index 47eff80ff5..422697e2c9 100644
--- a/lib/os_mon/doc/src/disksup.xml
+++ b/lib/os_mon/doc/src/disksup.xml
@@ -95,15 +95,15 @@
       <name since="">get_disk_data() -> [DiskData]</name>
       <fsummary>Get data for the disks in the system</fsummary>
       <type>
-        <v>DiskData = {Id, KByte, Capacity}</v>
+        <v>DiskData = {Id, TotalKiB, Capacity}</v>
         <v>&nbsp;Id = string()</v>
-        <v>&nbsp;KByte = int()</v>
+        <v>&nbsp;TotalKiB = int()</v>
         <v>&nbsp;Capacity = int()</v>
       </type>
       <desc>
         <p>Returns the result of the latest disk check. <c>Id</c> is a
-          string that identifies the disk or partition. <c>KByte</c> is
-          the total size of the disk or partition in kbytes.
+          string that identifies the disk or partition. <c>TotalKiB</c> is
+          the total size of the disk or partition in kibibytes.
           <c>Capacity</c> is the percentage of disk space used.</p>
         <p>The function is asynchronous in the sense that it does not
           invoke a disk check, but returns the latest available value.</p>
@@ -111,6 +111,47 @@
           available.</p>
       </desc>
     </func>
+    <func>
+      <name since="OTP 26.0">get_disk_info() -> [DiskData]</name>
+      <fsummary>Immediately get information for the disks in the system</fsummary>
+      <type>
+        <v>DiskData = {Id, TotalKiB, AvailableKiB, Capacity}</v>
+        <v>&nbsp;Id = string()</v>
+        <v>&nbsp;TotalKiB = int()</v>
+        <v>&nbsp;AvailableKiB = int()</v>
+        <v>&nbsp;Capacity = int()</v>
+      </type>
+      <desc>
+        <p>Immediately fetches total space, available space and capacity for local disks.
+          <c>Id</c> is a string that identifies the disk or partition.
+          <c>TotalKiB</c> is the total size of the disk or partition in kibibytes.
+          <c>AvailableKiB</c> is the disk space used in kibibytes.
+          <c>Capacity</c> is the percentage of disk space used.</p>
+        <p>Returns <c>[{"none",0,0,0}]</c> if <c>disksup</c> is not
+          available.</p>
+      </desc>
+    </func>
+    <func>
+      <name since="OTP 26.0">get_disk_info(Path) -> DiskData</name>
+      <fsummary>Immediately get information for a single path</fsummary>
+      <type>
+        <v>DiskData = [{Id, TotalKiB, AvailableKiB, Capacity}]</v>
+        <v>&nbsp;Id = string()</v>
+        <v>&nbsp;TotalKiB = int()</v>
+        <v>&nbsp;AvailableKiB = int()</v>
+        <v>&nbsp;Capacity = int()</v>
+      </type>
+      <desc>
+        <p>Immediately fetches total space, available space and capacity for a path.
+          <c>Id</c> is a string that identifies the disk or partition.
+          <c>TotalKiB</c> is the total size of the disk or partition in kibibytes.
+          <c>AvailableKiB</c> is the disk space used in kibibytes.
+          <c>Capacity</c> is the percentage of disk space used.</p>
+        <p>Returns <c>[{Path,0,0,0}]</c> if the <c>Path</c> is invalid or space
+          can't be determined. Returns <c>[{"none",0,0,0}]</c> if <c>disksup</c> is not
+          available.</p>
+      </desc>
+    </func>
     <func>
       <name since="">get_check_interval() -> MS</name>
       <fsummary>Get time interval, in milliseconds, for the periodic disk space check</fsummary>
diff --git a/lib/os_mon/src/disksup.erl b/lib/os_mon/src/disksup.erl
index 80f833bb49..0940db7df0 100644
--- a/lib/os_mon/src/disksup.erl
+++ b/lib/os_mon/src/disksup.erl
@@ -22,7 +22,7 @@
 
 %% API
 -export([start_link/0]).
--export([get_disk_data/0,
+-export([get_disk_data/0, get_disk_info/0, get_disk_info/1,
 	 get_check_interval/0, set_check_interval/1,
 	 get_almost_full_threshold/0, set_almost_full_threshold/1]).
 -export([dummy_reply/1, param_type/2, param_default/1]).
@@ -46,6 +46,12 @@ start_link() ->
 get_disk_data() ->
     os_mon:call(disksup, get_disk_data, infinity).
 
+get_disk_info() ->
+    os_mon:call(disksup, get_disk_info, infinity).
+
+get_disk_info(Path) ->
+    os_mon:call(disksup, {get_disk_info, Path}, infinity).
+
 get_check_interval() ->
     os_mon:call(disksup, get_check_interval, infinity).

@@ -68,6 +74,10 @@ set_almost_full_threshold(Float) ->
 
 dummy_reply(get_disk_data) ->
     [{"none", 0, 0}];
+dummy_reply(get_disk_info) ->
+    [{"none", 0, 0, 0}];
+dummy_reply({get_disk_info, Path}) ->
+    [{Path, 0, 0, 0}];
 dummy_reply(get_check_interval) ->
     case os_mon:get_env(disksup, disk_space_check_interval) of
         {TimeUnit, Time} ->
@@ -132,6 +142,12 @@ init([]) ->
 handle_call(get_disk_data, _From, State) ->
     {reply, State#state.diskdata, State};
 
+handle_call(get_disk_info, _From, #state{os = OS, port = Port} = State) ->
+    {reply, get_disk_info(OS, Port), State};
+
+handle_call({get_disk_info, Path}, _From, #state{os = OS, port = Port} = State) ->
+    {reply, get_disk_info(Path, OS, Port), State};
+
 handle_call(get_check_interval, _From, State) ->
     {reply, State#state.timeout, State};
 handle_call({set_check_interval, {TimeUnit, Time}}, _From, State) ->
@@ -241,6 +257,134 @@ find_cmd(Cmd, Path) ->
             Found
     end.
 
+%%-- Run "df" based on OS ----------------------------------------------
+run_df(OS, Port) ->
+    run_df("", OS, Port).
+
+run_df(Path, {unix, solaris}, Port) ->
+    my_cmd("/usr/bin/df -lk " ++ Path, Port);
+run_df(Path, {unix, irix}, Port) ->
+    my_cmd("/usr/sbin/df -lk " ++ Path, Port);
+run_df(Path, {unix, linux}, Port) ->
+    Df = find_cmd("df", "/bin"),
+    my_cmd(Df ++ " -lk -x squashfs " ++ Path, Port);
+run_df(Path, {unix, posix}, Port) ->
+    my_cmd("df -k -P " ++ Path, Port);
+run_df(Path, {unix, dragonfly}, Port) ->
+    my_cmd("/bin/df -k -t ufs,hammer " ++ Path, Port);
+run_df(Path, {unix, freebsd}, Port) ->
+    my_cmd("/bin/df -k -l " ++ Path, Port);
+run_df(Path, {unix, openbsd}, Port) ->
+    my_cmd("/bin/df -k -l " ++ Path, Port);
+run_df(Path, {unix, netbsd}, Port) ->
+    my_cmd("/bin/df -k -t ffs " ++ Path, Port);
+run_df(Path, {unix, sunos4}, Port) ->
+    my_cmd("df " ++ Path, Port);
+run_df(Path, {unix, darwin}, Port) ->
+    my_cmd("/bin/df -i -k -t ufs,hfs,apfs " ++ Path, Port).
+
+%%--Get disk info-------------------------------------------------------
+%% We use as many absolute paths as possible below as there may be stale
+%% NFS handles in the PATH which cause these commands to hang.
+get_disk_info(OS, Port) ->
+    get_disk_info("", OS, Port).
+
+get_disk_info(Path, OS, Port) ->
+    case do_get_disk_info(Path, OS, Port) of
+        [] -> dummy_reply({get_disk_info, Path});
+        DiskInfo -> DiskInfo
+    end.
+
+do_get_disk_info("", {win32, _}, not_used) ->
+  Result = os_mon_sysinfo:get_disk_info(),
+  disk_info_win32(Result);
+do_get_disk_info(DriveRoot, {win32, _}, not_used) ->
+  Result = os_mon_sysinfo:get_disk_info(DriveRoot),
+  disk_info_win32(Result);
+do_get_disk_info(Path, {unix, solaris}=OS, Port) ->
+    Result = run_df(Path, OS, Port),
+    disk_info_solaris(skip_to_eol(Result));
+do_get_disk_info(Path, {unix, irix}=OS, Port) ->
+    Result = run_df(Path, OS, Port),
+    disk_info_irix(skip_to_eol(Result));
+do_get_disk_info(Path, {unix, linux}=OS, Port) ->
+    Result = run_df(Path, OS, Port),
+    disk_info_solaris(skip_to_eol(Result));
+do_get_disk_info(Path, {unix, posix}=OS, Port) ->
+    Result = run_df(Path, OS, Port),
+    disk_info_solaris(skip_to_eol(Result));
+do_get_disk_info(Path, {unix, dragonfly}=OS, Port) ->
+    Result = run_df(Path, OS, Port),
+    disk_info_solaris(skip_to_eol(Result));
+do_get_disk_info(Path, {unix, freebsd}=OS, Port) ->
+    Result = run_df(Path, OS, Port),
+    disk_info_solaris(skip_to_eol(Result));
+do_get_disk_info(Path, {unix, openbsd}=OS, Port) ->
+    Result = run_df(Path, OS, Port),
+    disk_info_solaris(skip_to_eol(Result));
+do_get_disk_info(Path, {unix, netbsd}=OS, Port) ->
+    Result = run_df(Path, OS, Port),
+    disk_info_solaris(skip_to_eol(Result));
+do_get_disk_info(Path, {unix, sunos4}=OS, Port) ->
+    Result = run_df(Path, OS, Port),
+    disk_info_solaris(skip_to_eol(Result));
+do_get_disk_info(Path, {unix, darwin}=OS, Port) ->
+    Result = run_df(Path, OS, Port),
+    disk_info_susv3(skip_to_eol(Result)).
+
+disk_info_win32([]) ->
+    [];
+disk_info_win32([H|T]) ->
+    case io_lib:fread("~s~s~d~d~d", H) of
+    {ok, [Drive, "DRIVE_FIXED", BAvail, BTot, _TotFree], _RestStr} ->
+        KiBTotal = BTot div 1024,
+        KiBAvailable = BAvail div 1024,
+        BUsed = BTot - BAvail,
+        Capacity = trunc(math:ceil(100 * (BUsed / BTot))),
+        [{Drive, KiBTotal, KiBAvailable, Capacity} | disk_info_win32(T)];
+    {ok, _, _RestStr} ->
+        disk_info_win32(T);
+    _Other ->
+        []
+    end.
+
+% This code works for Linux and FreeBSD as well
+disk_info_solaris("") ->
+    [];
+disk_info_solaris("\n") ->
+    [];
+disk_info_solaris(Str) ->
+    case parse_df(Str, posix) of
+    {ok, {KiBTotal, KiBAvailable, Capacity, MntOn}, RestStr} ->
+        [{MntOn, KiBTotal, KiBAvailable, Capacity} | disk_info_solaris(RestStr)];
+    _Other ->
+        disk_info_solaris(skip_to_eol(Str))
+    end.
+
+%% Irix: like Linux with an extra FS type column and no '%'.
+disk_info_irix("") -> [];
+disk_info_irix("\n") -> [];
+disk_info_irix(Str) ->
+    case io_lib:fread("~s~s~d~d~d~d~s", Str) of
+	{ok, [_FS, _FSType, KiBAvailable, Capacity, _Avail, KiBTotal, MntOn], RestStr} ->
+	    [{MntOn, KiBTotal, KiBAvailable, Capacity} | disk_info_irix(RestStr)];
+	_Other ->
+	    disk_info_irix(skip_to_eol(Str))
+    end.
+
+% Parse per SUSv3 specification, notably recent OS X
+disk_info_susv3("") ->
+    [];
+disk_info_susv3("\n") ->
+    [];
+disk_info_susv3(Str) ->
+    case parse_df(Str, susv3) of
+    {ok, {KiBTotal, KiBAvailable, Capacity, MntOn}, RestStr} ->
+	    [{MntOn, KiBTotal, KiBAvailable, Capacity} | disk_info_susv3(RestStr)];
+	_Other ->
+	    disk_info_susv3(skip_to_eol(Str))
+    end.
+
 %%--Check disk space----------------------------------------------------
 
 %% We use as many absolute paths as possible below as there may be stale
@@ -248,36 +392,35 @@ find_cmd(Cmd, Path) ->
 check_disk_space({win32,_}, not_used, Threshold) ->
     Result = os_mon_sysinfo:get_disk_info(),
     check_disks_win32(Result, Threshold);
-check_disk_space({unix, solaris}, Port, Threshold) ->
-    Result = my_cmd("/usr/bin/df -lk", Port),
+check_disk_space({unix, solaris}=OS, Port, Threshold) ->
+    Result = run_df(OS, Port),
     check_disks_solaris(skip_to_eol(Result), Threshold);
-check_disk_space({unix, irix}, Port, Threshold) ->
-    Result = my_cmd("/usr/sbin/df -lk",Port),
+check_disk_space({unix, irix}=OS, Port, Threshold) ->
+    Result = run_df(OS, Port),
     check_disks_irix(skip_to_eol(Result), Threshold);
-check_disk_space({unix, linux}, Port, Threshold) ->
-    Df = find_cmd("df", "/bin"),
-    Result = my_cmd(Df ++ " -lk -x squashfs", Port),
+check_disk_space({unix, linux}=OS, Port, Threshold) ->
+    Result = run_df(OS, Port),
     check_disks_solaris(skip_to_eol(Result), Threshold);
-check_disk_space({unix, posix}, Port, Threshold) ->
-    Result = my_cmd("df -k -P", Port),
+check_disk_space({unix, posix}=OS, Port, Threshold) ->
+    Result = run_df(OS, Port),
     check_disks_solaris(skip_to_eol(Result), Threshold);
-check_disk_space({unix, dragonfly}, Port, Threshold) ->
-    Result = my_cmd("/bin/df -k -t ufs,hammer", Port),
+check_disk_space({unix, dragonfly}=OS, Port, Threshold) ->
+    Result = run_df(OS, Port),
     check_disks_solaris(skip_to_eol(Result), Threshold);
-check_disk_space({unix, freebsd}, Port, Threshold) ->
-    Result = my_cmd("/bin/df -k -l", Port),
+check_disk_space({unix, freebsd}=OS, Port, Threshold) ->
+    Result = run_df(OS, Port),
     check_disks_solaris(skip_to_eol(Result), Threshold);
-check_disk_space({unix, openbsd}, Port, Threshold) ->
-    Result = my_cmd("/bin/df -k -l", Port),
+check_disk_space({unix, openbsd}=OS, Port, Threshold) ->
+    Result = run_df(OS, Port),
     check_disks_solaris(skip_to_eol(Result), Threshold);
-check_disk_space({unix, netbsd}, Port, Threshold) ->
-    Result = my_cmd("/bin/df -k -t ffs", Port),
+check_disk_space({unix, netbsd}=OS, Port, Threshold) ->
+    Result = run_df(OS, Port),
     check_disks_solaris(skip_to_eol(Result), Threshold);
-check_disk_space({unix, sunos4}, Port, Threshold) ->
-    Result = my_cmd("df", Port),
+check_disk_space({unix, sunos4}=OS, Port, Threshold) ->
+    Result = run_df(OS, Port),
     check_disks_solaris(skip_to_eol(Result), Threshold);
-check_disk_space({unix, darwin}, Port, Threshold) ->
-    Result = my_cmd("/bin/df -i -k -t ufs,hfs,apfs", Port),
+check_disk_space({unix, darwin}=OS, Port, Threshold) ->
+    Result = run_df(OS, Port),
     check_disks_susv3(skip_to_eol(Result), Threshold).
 
 % This code works for Linux and FreeBSD as well
@@ -287,14 +430,14 @@ check_disks_solaris("\n", _Threshold) ->
     [];
 check_disks_solaris(Str, Threshold) ->
     case parse_df(Str, posix) of
-	{ok, {KB, Cap, MntOn}, RestStr} ->
+        {ok, {KiBTotal, _KiBAvailable, Capacity, MntOn}, RestStr} ->
 	    if
-		Cap >= Threshold ->
+		Capacity >= Threshold ->
 		    set_alarm({disk_almost_full, MntOn}, []);
 		true ->
 		    clear_alarm({disk_almost_full, MntOn})
 	    end,
-	    [{MntOn, KB, Cap} |
+	    [{MntOn, KiBTotal, Capacity} |
 	     check_disks_solaris(RestStr, Threshold)];
 	_Other ->
 	    check_disks_solaris(skip_to_eol(Str),Threshold)
@@ -349,15 +492,15 @@ parse_df_take_word_percent(Input) ->
 %% and capacity), skip % sign, (optionally for susv3 can also skip IUsed, IFree
 %% and ICap% fields) then take remaining characters as the mount path
 -spec parse_df(string(), posix | susv3) ->
-    {error, parse_df} | {ok, {integer(), integer(), list()}, string()}.
+    {error, parse_df} | {ok, {integer(), integer(), integer(), list()}, string()}.
 parse_df(Input0, Flavor) ->
     %% Format of Posix/Linux df output looks like Header + Lines
     %% Filesystem     1024-blocks     Used Available Capacity Mounted on
     %% udev               2467108        0   2467108       0% /dev
     Input1 = parse_df_skip_word(Input0), % skip device path field
-    {KbStr, Input2} = parse_df_take_word(Input1), % take Kb field
+    {KiBTotalStr, Input2} = parse_df_take_word(Input1), % take Kb field
     Input3 = parse_df_skip_word(Input2), % skip Used field
-    Input4 = parse_df_skip_word(Input3), % skip Avail field
+    {KiBAvailableStr, Input4} = parse_df_take_word(Input3),
 
     % take Capacity% field; drop a % sign following the capacity
     {CapacityStr, Input5} = parse_df_take_word_percent(Input4),
@@ -381,9 +524,10 @@ parse_df(Input0, Flavor) ->
     Remaining = lists:dropwhile(fun(X) -> not parse_df_is_not_eol(X) end,
                                 Input7),
     try
-        Kb = erlang:list_to_integer(KbStr),
+        KiBTotal = erlang:list_to_integer(KiBTotalStr),
+        KiBAvailable = erlang:list_to_integer(KiBAvailableStr),
         Capacity = erlang:list_to_integer(CapacityStr),
-        {ok, {Kb, Capacity, MountPath}, Remaining}
+        {ok, {KiBTotal, KiBAvailable, Capacity, MountPath}, Remaining}
     catch error:badarg ->
         {error, parse_df}
     end.
@@ -395,14 +539,14 @@ check_disks_susv3("\n", _Threshold) ->
     [];
 check_disks_susv3(Str, Threshold) ->
     case parse_df(Str, susv3) of
-    {ok, {KB, Cap, MntOn}, RestStr} ->
+    {ok, {KiBTotal, _KiBAvailable, Capacity, MntOn}, RestStr} ->
 	    if
-		Cap >= Threshold ->
+		Capacity >= Threshold ->
 		    set_alarm({disk_almost_full, MntOn}, []);
 		true ->
 		    clear_alarm({disk_almost_full, MntOn})
 	    end,
-	    [{MntOn, KB, Cap} |
+	    [{MntOn, KiBTotal, Capacity} |
 	     check_disks_susv3(RestStr, Threshold)];
 	_Other ->
 	    check_disks_susv3(skip_to_eol(Str),Threshold)
diff --git a/lib/os_mon/test/disksup_SUITE.erl b/lib/os_mon/test/disksup_SUITE.erl
index a583c1e4d7..1582b3727d 100644
--- a/lib/os_mon/test/disksup_SUITE.erl
+++ b/lib/os_mon/test/disksup_SUITE.erl
@@ -73,6 +73,9 @@ api(Config) when is_list(Config) ->
     %% get_disk_data()
     ok = check_get_disk_data(),
 
+    %% get_disk_info()
+    ok = check_get_disk_info(),
+
     %% get_check_interval()
     1800000 = disksup:get_check_interval(),
 
@@ -402,6 +405,25 @@ check_get_disk_data() ->
     true = KByte>0,
     ok.
 
+check_get_disk_info() ->
+    DiskInfo = disksup:get_disk_info(),
+    [{Id, TotalKiB, AvailableKiB, Capacity}|_] = DiskInfo,
+    true = io_lib:printable_list(Id),
+    true = is_integer(TotalKiB),
+    true = is_integer(AvailableKiB),
+    true = is_integer(Capacity),
+    true = TotalKiB > 0,
+    true = AvailableKiB > 0,
+
+    [DiskInfoRoot|_] = disksup:get_disk_info("/"),
+    {"/", TotalKiBRoot, AvailableKiBRoot, CapacityRoot} = DiskInfoRoot,
+    true = is_integer(TotalKiBRoot),
+    true = is_integer(AvailableKiBRoot),
+    true = is_integer(CapacityRoot),
+    true = TotalKiBRoot > 0,
+    true = AvailableKiBRoot > 0,
+    ok.
+
 % filter get_disk_data and remove entriew with zero capacity
 % "non-normal" filesystems report zero capacity
 % - Perhaps erroneous 'df -k -l'?
@@ -424,11 +446,11 @@ parse_df_output_posix(Config) when is_list(Config) ->
 
     %% Have a simple example with no funny spaces in mount path
     Posix1 = "tmpfs             498048     7288    490760   2% /run\n",
-    {ok, {498048, 2, "/run"}, ""} = disksup:parse_df(Posix1, posix),
+    {ok, {498048, 490760, 2, "/run"}, ""} = disksup:parse_df(Posix1, posix),
 
     %% Have a mount path with some spaces in it
     Posix2 = "tmpfs             498048     7288    490760   2% /spaces 1 2\n",
-    {ok, {498048, 2, "/spaces 1 2"}, ""} = disksup:parse_df(Posix2, posix).
+    {ok, {498048, 490760, 2, "/spaces 1 2"}, ""} = disksup:parse_df(Posix2, posix).
 
 %% @doc Test various expected inputs to 'df' command output (Darwin/SUSv3)
 parse_df_output_susv3(Config) when is_list(Config) ->
@@ -441,9 +463,9 @@ parse_df_output_susv3(Config) when is_list(Config) ->
     %% Have a simple example with no funny spaces in mount path
     Darwin1 = "/dev/disk1   243949060 157002380  86690680    65% 2029724 " ++
               "4292937555    0%   /\n",
-    {ok, {243949060, 65, "/"}, ""} = disksup:parse_df(Darwin1, susv3),
+    {ok, {243949060, 86690680, 65, "/"}, ""} = disksup:parse_df(Darwin1, susv3),
 
     %% Have a mount path with some spaces in it
     Darwin2 = "/dev/disk1   243949060 157002380  86690680    65% 2029724 " ++
               "4292937555    0%   /spaces 1 2\n",
-    {ok, {243949060, 65, "/spaces 1 2"}, ""} = disksup:parse_df(Darwin2, susv3).
+    {ok, {243949060, 86690680, 65, "/spaces 1 2"}, ""} = disksup:parse_df(Darwin2, susv3).
-- 
2.35.3

openSUSE Build Service is sponsored by