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> Id = string()</v>
- <v> KByte = int()</v>
+ <v> TotalKiB = int()</v>
<v> 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> Id = string()</v>
+ <v> TotalKiB = int()</v>
+ <v> AvailableKiB = int()</v>
+ <v> 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> Id = string()</v>
+ <v> TotalKiB = int()</v>
+ <v> AvailableKiB = int()</v>
+ <v> 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