[1/8] extrahd.cgi: Add various perl functions deal with block devices

  This functions are going to replace the former used scan/write to file/read from
file approach by directly collecting the required informations from the
kernel sysfs and devfs.

Signed-off-by: Stefan Schantl <stefan.schantl@ipfire.org>
---
 html/cgi-bin/extrahd.cgi | 360 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 360 insertions(+)
  

Stefan,

I tried to apply this patch but it doesn’t seem to work.

I notice there are no lines that begin with `-`.

Does this patch start from a blank `extrahd.cgi` file?


Jon



> On Jun 22, 2023, at 11:01 PM, Stefan Schantl <stefan.schantl@ipfire.org> wrote:
> 
> This functions are going to replace the former used scan/write to file/read from
> file approach by directly collecting the required informations from the
> kernel sysfs and devfs.
> 
> Signed-off-by: Stefan Schantl <stefan.schantl@ipfire.org>
> ---
> html/cgi-bin/extrahd.cgi | 360 +++++++++++++++++++++++++++++++++++++++
> 1 file changed, 360 insertions(+)
> 
> diff --git a/html/cgi-bin/extrahd.cgi b/html/cgi-bin/extrahd.cgi
> index 36c0efc2e..44065a8a1 100644
> --- a/html/cgi-bin/extrahd.cgi
> +++ b/html/cgi-bin/extrahd.cgi
> @@ -255,3 +255,363 @@ END
> 
> &Header::closebigbox();
> &Header::closepage();
> +
> +#
> +## Function which return an array with all available block devices.
> +#
> +sub get_block_devices () {
> +	my @devices;
> +
> +	# Open directory from kernel sysfs.
> +	opendir(DEVICES, "/sys/block");
> +
> +	# Loop through the directory.
> +	while(readdir(DEVICES)) {
> +		# Skip . and ..
> +		next if($_ =~ /^\.$/);
> +		next if($_ =~ /^\..$/);
> +
> +		# Skip any loopback and ram devices.
> +		next if($_ =~ "^loop");
> +		next if($_ =~ "^ram");
> +
> +		# Add the device to the array of found devices.
> +		push(@devices, $_);
> +	}
> +
> +	# Close directory handle.
> +	closedir(DEVICES);
> +
> +	# Return the devices array.
> +	return @devices;
> +}
> +
> +#
> +## Function which return all partitions of a given block device.
> +#
> +sub get_device_partitions ($) {
> +	my ($device) = @_;
> +
> +	# Array to store the known partitions for the given
> +	# device.
> +	my @partitions;
> +
> +	# Assign device directory.
> +	my $device_dir = "$sysfs_block_dir/$device";
> +
> +	# Abort and return nothing if the device dir does not exist.
> +	return unless(-d "$device_dir");
> +
> +	opendir(DEVICE, "$sysfs_block_dir/$device");
> +	while(readdir(DEVICE)) {
> +		next unless($_ =~ "^$device");
> +
> +		push(@partitions, $_);
> +	}
> +
> +	closedir(DEVICE);
> +
> +	@partitions = sort(@partitions);
> +
> +	return @partitions;
> +}
> +
> +#
> +## Returns the vendor of a given block device.
> +#
> +sub get_device_vendor ($) {
> +	my ($device) = @_;
> +
> +	# Assign device directory.
> +	my $device_dir = "$sysfs_block_dir/$device";
> +
> +	# Abort and return nothing if the device dir does not exist
> +	# or no vendor file exists.
> +	return unless(-d "$device_dir");
> +	return unless(-f "$device_dir/device/vendor");
> +
> +	# Open and read-in the device vendor.
> +	open(VENDOR, "$device_dir/device/vendor");
> +	my $vendor = <VENDOR>;
> +	close(VENDOR);
> +
> +	# Abort and return nothing if no vendor could be read.
> +	return unless($vendor);
> +
> +	# Remove any newlines from the vendor string.
> +	chomp($vendor);
> +
> +	# Return the omited vendor.
> +	return $vendor;
> +}
> +
> +#
> +## Returns the model name (string) of a given block device.
> +#
> +sub get_device_model ($) {
> +	my ($device) = @_;
> +
> +	# Assign device directory.
> +	my $device_dir = "$sysfs_block_dir/$device";
> +
> +	# Abort and return nothing if the device dir does not exist
> +	# or no model file exists.
> +	return unless(-d "$device_dir");
> +	return unless(-f "$device_dir/device/model");
> +
> +	# Open and read-in the device model.
> +	open(MODEL, "$device_dir/device/model");
> +	my $model = <MODEL>;
> +	close(MODEL);
> +
> +	# Abort and return nothing if no model could be read.
> +	return unless($model);
> +
> +	# Remove any newlines from the model string.
> +	chomp($model);
> +
> +	# Return the model string.
> +	return $model;
> +}
> +
> +#
> +## Returns the size of a given device in bytes.
> +#
> +sub get_device_size ($) {
> +	my ($device) = @_;
> +
> +	# Assign device directory.
> +	my $device_dir = "$sysfs_block_dir/$device";
> +
> +	# Abort and return nothing if the device dir does not exist
> +	# or no size file exists.
> +	return unless(-d "$device_dir");
> +	return unless(-f "$device_dir/size");
> +
> +	# Open and read-in the device size.
> +	open(SIZE, "$device_dir/size");
> +	my $size = <SIZE>;
> +	close(SIZE);
> +
> +	# Abort and return nothing if the size could not be read.
> +	return unless($size);
> +
> +	# Remove any newlines for the size string.
> +	chomp($size);
> +
> +	# The omited size only contains the amount of blocks from the
> +	# given device. To convert this into bytes we have to multiply this
> +	# value with 512 bytes for each block. This is a static value used by
> +	# the linux kernel.
> +	$size = $size * 512;
> +
> +	# Return the size in bytes.
> +	return $size;
> +}
> +
> +#
> +## Function which returns all currently mounted devices as a hash.
> +## example: "sda1" -> "/boot"
> +#
> +sub get_mountpoints () {
> +	my %mounts;
> +
> +	# Open and read-in the current mounts from the
> +	# kernel file system.
> +	open(MOUNT, "/proc/mounts");
> +
> +	# Loop through the known mounts.
> +	while(<MOUNT>) {
> +		# Skip mounts which does not belong to a device.
> +		next unless ($_ =~ "^/dev");
> +
> +		# Cut the line into pieces and assign nice variables.
> +		my ($dev, $mpoint, $fs, $options, $a, $b) = split(/ /, $_);
> +
> +		# Split the device name.
> +		my @tmp = split("/", $dev);
> +
> +		# Assign the plain device name to a new variable.
> +		# It is the last element of the array.
> +		my $device = $tmp[-1];
> +
> +		# Add the mountpoint to the hash of mountpoints.
> +		$mounts{"$device"} = $mpoint;
> +	}
> +
> +	# Close file handle.
> +	close(MOUNT);
> +
> +	# Return the hash of known mountpoints.
> +	return %mounts;
> +}
> +
> +sub get_swaps () {
> +	my @swaps;
> +
> +	# Open and read the swaps file.
> +	open(SWAP, "/proc/swaps");
> +
> +	# Loop though the file content.
> +	while(<SWAP>) {
> +		# Skip lines which does not belong to a device.
> +		next unless ($_ =~ "^/dev");
> +
> +		# Split the line and assign nice variables.
> +		my ($dev, $type, $size, $used, $prio) = split(/ /, $_);
> +
> +		# Cut the device line into pieces.
> +		my @tmp = split("/", $dev);
> +
> +		my $device = @tmp[-1];
> +
> +		# Add the found swap to the array of swaps.
> +		push(@swaps, $device);
> +	}
> +
> +	# Close file handle.
> +	close(SWAP);
> +
> +	# Sort the array.
> +	@swaps = sort(@swaps);
> +
> +	# Return the array.
> +	return @swaps;
> +}
> +
> +#
> +## Function with returns the mounted devices and the used filesystems as a hash.
> +## Example: "sda1" -> "ext4"
> +#
> +sub get_mountedfs () {
> +	my %mountedfs;
> +
> +	# Open and read the current mounts from the kernel
> +	# file system.
> +	open(MOUNT, "/proc/mounts");
> +
> +	# Loop through the known mounts.
> +	while(<MOUNT>) {
> +		# Skip mounts which does not belong to a device.
> +		next unless ($_ =~ "^/dev");
> +
> +		# Split line and assign nice variables.
> +		my ($dev, $mpoint, $fs, $options, $a, $b) = split(/ /, $_);
> +
> +		# Cut the device line into pieces.
> +		my @tmp = split("/", $dev);
> +
> +		# Assign the plain device name to a variable
> +		# It is the last element of the temporary array.
> +		my $device = $tmp[-1];
> +
> +		# Convert the filesystem into lower case format.
> +		$fs = lc($fs);
> +
> +		# Add the mounted file system.
> +		$mountedfs{$device} = $fs;
> +	}
> +
> +	# Close file handle.
> +	close(MOUNT);
> +
> +	# Return the hash with the mounted filesystems.
> +	return %mountedfs;
> +}
> +
> +#
> +## Function which returns all known UUID's as a hash.
> +## Example: "sda1" -> "1234-5678-abcd"
> +#
> +sub get_uuids () {
> +	my %uuids;
> +
> +	# Directory where the uuid mappings can be found.
> +	my $uuid_dir = "/dev/disk/by-uuid";
> +
> +	# Open uuid directory and read-in the current known uuids.
> +	opendir(UUIDS, "$uuid_dir");
> +
> +	# Loop through the uuids.
> +	foreach my $uuid (readdir(UUIDS)) {
> +		# Skip . and ..
> +		next if($uuid eq "." or $uuid eq "..");
> +
> +		# Skip everything which is not a symbolic link.
> +		next unless(-l "$uuid_dir/$uuid");
> +
> +		# Resolve the target of the symbolic link.
> +		my $target = readlink("$uuid_dir/$uuid");
> +
> +		# Split the link target into pieces.
> +		my @tmp = split("/", $target);
> +
> +		# Assign the last element of the array to the dev variable.
> +		my $dev = "$tmp[-1]";
> +
> +		# Add the device and uuid to the hash of uuids.
> +		$uuids{$dev} = $uuid;
> +	}
> +
> +	# Close directory handle.
> +	closedir(UUIDS);
> +
> +	# Return the hash of uuids.
> +	return %uuids;
> +}
> +
> +#
> +## Returns the device name of a given uuid.
> +#
> +sub device_by_uuid ($) {
> +	my ($uuid) = @_;
> +
> +	# Reverse the main uuids hash.
> +	my %uuids = reverse %uuids;
> +
> +	# Lookup and return the device name.
> +	return $uuids{$uuid};
> +}
> +
> +#
> +## Returns "True" in case a given path is a known mountpoint.
> +#
> +sub is_mounted ($) {
> +	my ($mpoint) = @_;
> +
> +	my %mountpoints = reverse %mountpoints;
> +
> +	# Return "True" if the requested mountpoint is known and
> +	# therefore mounted.
> +	return 1 if($mountpoints{$mpoint});
> +}
> +
> +#
> +## Returns "True" if a given mountpoint is a subdirectory of one
> +## of the directories specified by the valid_mount_dirs array abouve.
> +#
> +sub is_valid_dir ($) {
> +	my ($mpoint) = @_;
> +
> +	# Split the given mountpoint into pieces and store them
> +	# in a temporay array.
> +	my @tmp = split("/", $mpoint);
> +
> +	# Exit and return nothing if the temporary array is empty.
> +	return unless(@tmp);
> +
> +	# Build the root path based on the given mount point.
> +	my $root_path = "/" . @tmp[1];
> +
> +	# Check if the root path is valid.
> +	return 1 if(grep /$root_path/, @valid_mount_dirs);
> +}
> +
> +#
> +# Returns "True" if a device is used as swap.
> +#
> +sub is_swap ($) {
> +	my ($device) = @_;
> +
> +	return 1 if(grep /$device/, @swaps);
> +}
> -- 
> 2.39.2
> 
>
  

Stefan, could you please send a link to the CGI file so it can be downloaded easily without putting all these patches together?

> On 25 Jun 2023, at 04:43, jon <jon.murphy@ipfire.org> wrote:
> 
> Stefan,
> 
> I tried to apply this patch but it doesn’t seem to work.
> 
> I notice there are no lines that begin with `-`.
> 
> Does this patch start from a blank `extrahd.cgi` file?
> 
> 
> Jon
> 
> 
> 
>> On Jun 22, 2023, at 11:01 PM, Stefan Schantl <stefan.schantl@ipfire.org> wrote:
>> 
>> This functions are going to replace the former used scan/write to file/read from
>> file approach by directly collecting the required informations from the
>> kernel sysfs and devfs.
>> 
>> Signed-off-by: Stefan Schantl <stefan.schantl@ipfire.org>
>> ---
>> html/cgi-bin/extrahd.cgi | 360 +++++++++++++++++++++++++++++++++++++++
>> 1 file changed, 360 insertions(+)
>> 
>> diff --git a/html/cgi-bin/extrahd.cgi b/html/cgi-bin/extrahd.cgi
>> index 36c0efc2e..44065a8a1 100644
>> --- a/html/cgi-bin/extrahd.cgi
>> +++ b/html/cgi-bin/extrahd.cgi
>> @@ -255,3 +255,363 @@ END
>> 
>> &Header::closebigbox();
>> &Header::closepage();
>> +
>> +#
>> +## Function which return an array with all available block devices.
>> +#
>> +sub get_block_devices () {
>> + my @devices;
>> +
>> + # Open directory from kernel sysfs.
>> + opendir(DEVICES, "/sys/block");
>> +
>> + # Loop through the directory.
>> + while(readdir(DEVICES)) {
>> + # Skip . and ..
>> + next if($_ =~ /^\.$/);
>> + next if($_ =~ /^\..$/);
>> +
>> + # Skip any loopback and ram devices.
>> + next if($_ =~ "^loop");
>> + next if($_ =~ "^ram");
>> +
>> + # Add the device to the array of found devices.
>> + push(@devices, $_);
>> + }
>> +
>> + # Close directory handle.
>> + closedir(DEVICES);
>> +
>> + # Return the devices array.
>> + return @devices;
>> +}
>> +
>> +#
>> +## Function which return all partitions of a given block device.
>> +#
>> +sub get_device_partitions ($) {
>> + my ($device) = @_;
>> +
>> + # Array to store the known partitions for the given
>> + # device.
>> + my @partitions;
>> +
>> + # Assign device directory.
>> + my $device_dir = "$sysfs_block_dir/$device";
>> +
>> + # Abort and return nothing if the device dir does not exist.
>> + return unless(-d "$device_dir");
>> +
>> + opendir(DEVICE, "$sysfs_block_dir/$device");
>> + while(readdir(DEVICE)) {
>> + next unless($_ =~ "^$device");
>> +
>> + push(@partitions, $_);
>> + }
>> +
>> + closedir(DEVICE);
>> +
>> + @partitions = sort(@partitions);
>> +
>> + return @partitions;
>> +}
>> +
>> +#
>> +## Returns the vendor of a given block device.
>> +#
>> +sub get_device_vendor ($) {
>> + my ($device) = @_;
>> +
>> + # Assign device directory.
>> + my $device_dir = "$sysfs_block_dir/$device";
>> +
>> + # Abort and return nothing if the device dir does not exist
>> + # or no vendor file exists.
>> + return unless(-d "$device_dir");
>> + return unless(-f "$device_dir/device/vendor");
>> +
>> + # Open and read-in the device vendor.
>> + open(VENDOR, "$device_dir/device/vendor");
>> + my $vendor = <VENDOR>;
>> + close(VENDOR);
>> +
>> + # Abort and return nothing if no vendor could be read.
>> + return unless($vendor);
>> +
>> + # Remove any newlines from the vendor string.
>> + chomp($vendor);
>> +
>> + # Return the omited vendor.
>> + return $vendor;
>> +}
>> +
>> +#
>> +## Returns the model name (string) of a given block device.
>> +#
>> +sub get_device_model ($) {
>> + my ($device) = @_;
>> +
>> + # Assign device directory.
>> + my $device_dir = "$sysfs_block_dir/$device";
>> +
>> + # Abort and return nothing if the device dir does not exist
>> + # or no model file exists.
>> + return unless(-d "$device_dir");
>> + return unless(-f "$device_dir/device/model");
>> +
>> + # Open and read-in the device model.
>> + open(MODEL, "$device_dir/device/model");
>> + my $model = <MODEL>;
>> + close(MODEL);
>> +
>> + # Abort and return nothing if no model could be read.
>> + return unless($model);
>> +
>> + # Remove any newlines from the model string.
>> + chomp($model);
>> +
>> + # Return the model string.
>> + return $model;
>> +}
>> +
>> +#
>> +## Returns the size of a given device in bytes.
>> +#
>> +sub get_device_size ($) {
>> + my ($device) = @_;
>> +
>> + # Assign device directory.
>> + my $device_dir = "$sysfs_block_dir/$device";
>> +
>> + # Abort and return nothing if the device dir does not exist
>> + # or no size file exists.
>> + return unless(-d "$device_dir");
>> + return unless(-f "$device_dir/size");
>> +
>> + # Open and read-in the device size.
>> + open(SIZE, "$device_dir/size");
>> + my $size = <SIZE>;
>> + close(SIZE);
>> +
>> + # Abort and return nothing if the size could not be read.
>> + return unless($size);
>> +
>> + # Remove any newlines for the size string.
>> + chomp($size);
>> +
>> + # The omited size only contains the amount of blocks from the
>> + # given device. To convert this into bytes we have to multiply this
>> + # value with 512 bytes for each block. This is a static value used by
>> + # the linux kernel.
>> + $size = $size * 512;
>> +
>> + # Return the size in bytes.
>> + return $size;
>> +}
>> +
>> +#
>> +## Function which returns all currently mounted devices as a hash.
>> +## example: "sda1" -> "/boot"
>> +#
>> +sub get_mountpoints () {
>> + my %mounts;
>> +
>> + # Open and read-in the current mounts from the
>> + # kernel file system.
>> + open(MOUNT, "/proc/mounts");
>> +
>> + # Loop through the known mounts.
>> + while(<MOUNT>) {
>> + # Skip mounts which does not belong to a device.
>> + next unless ($_ =~ "^/dev");
>> +
>> + # Cut the line into pieces and assign nice variables.
>> + my ($dev, $mpoint, $fs, $options, $a, $b) = split(/ /, $_);
>> +
>> + # Split the device name.
>> + my @tmp = split("/", $dev);
>> +
>> + # Assign the plain device name to a new variable.
>> + # It is the last element of the array.
>> + my $device = $tmp[-1];
>> +
>> + # Add the mountpoint to the hash of mountpoints.
>> + $mounts{"$device"} = $mpoint;
>> + }
>> +
>> + # Close file handle.
>> + close(MOUNT);
>> +
>> + # Return the hash of known mountpoints.
>> + return %mounts;
>> +}
>> +
>> +sub get_swaps () {
>> + my @swaps;
>> +
>> + # Open and read the swaps file.
>> + open(SWAP, "/proc/swaps");
>> +
>> + # Loop though the file content.
>> + while(<SWAP>) {
>> + # Skip lines which does not belong to a device.
>> + next unless ($_ =~ "^/dev");
>> +
>> + # Split the line and assign nice variables.
>> + my ($dev, $type, $size, $used, $prio) = split(/ /, $_);
>> +
>> + # Cut the device line into pieces.
>> + my @tmp = split("/", $dev);
>> +
>> + my $device = @tmp[-1];
>> +
>> + # Add the found swap to the array of swaps.
>> + push(@swaps, $device);
>> + }
>> +
>> + # Close file handle.
>> + close(SWAP);
>> +
>> + # Sort the array.
>> + @swaps = sort(@swaps);
>> +
>> + # Return the array.
>> + return @swaps;
>> +}
>> +
>> +#
>> +## Function with returns the mounted devices and the used filesystems as a hash.
>> +## Example: "sda1" -> "ext4"
>> +#
>> +sub get_mountedfs () {
>> + my %mountedfs;
>> +
>> + # Open and read the current mounts from the kernel
>> + # file system.
>> + open(MOUNT, "/proc/mounts");
>> +
>> + # Loop through the known mounts.
>> + while(<MOUNT>) {
>> + # Skip mounts which does not belong to a device.
>> + next unless ($_ =~ "^/dev");
>> +
>> + # Split line and assign nice variables.
>> + my ($dev, $mpoint, $fs, $options, $a, $b) = split(/ /, $_);
>> +
>> + # Cut the device line into pieces.
>> + my @tmp = split("/", $dev);
>> +
>> + # Assign the plain device name to a variable
>> + # It is the last element of the temporary array.
>> + my $device = $tmp[-1];
>> +
>> + # Convert the filesystem into lower case format.
>> + $fs = lc($fs);
>> +
>> + # Add the mounted file system.
>> + $mountedfs{$device} = $fs;
>> + }
>> +
>> + # Close file handle.
>> + close(MOUNT);
>> +
>> + # Return the hash with the mounted filesystems.
>> + return %mountedfs;
>> +}
>> +
>> +#
>> +## Function which returns all known UUID's as a hash.
>> +## Example: "sda1" -> "1234-5678-abcd"
>> +#
>> +sub get_uuids () {
>> + my %uuids;
>> +
>> + # Directory where the uuid mappings can be found.
>> + my $uuid_dir = "/dev/disk/by-uuid";
>> +
>> + # Open uuid directory and read-in the current known uuids.
>> + opendir(UUIDS, "$uuid_dir");
>> +
>> + # Loop through the uuids.
>> + foreach my $uuid (readdir(UUIDS)) {
>> + # Skip . and ..
>> + next if($uuid eq "." or $uuid eq "..");
>> +
>> + # Skip everything which is not a symbolic link.
>> + next unless(-l "$uuid_dir/$uuid");
>> +
>> + # Resolve the target of the symbolic link.
>> + my $target = readlink("$uuid_dir/$uuid");
>> +
>> + # Split the link target into pieces.
>> + my @tmp = split("/", $target);
>> +
>> + # Assign the last element of the array to the dev variable.
>> + my $dev = "$tmp[-1]";
>> +
>> + # Add the device and uuid to the hash of uuids.
>> + $uuids{$dev} = $uuid;
>> + }
>> +
>> + # Close directory handle.
>> + closedir(UUIDS);
>> +
>> + # Return the hash of uuids.
>> + return %uuids;
>> +}
>> +
>> +#
>> +## Returns the device name of a given uuid.
>> +#
>> +sub device_by_uuid ($) {
>> + my ($uuid) = @_;
>> +
>> + # Reverse the main uuids hash.
>> + my %uuids = reverse %uuids;
>> +
>> + # Lookup and return the device name.
>> + return $uuids{$uuid};
>> +}
>> +
>> +#
>> +## Returns "True" in case a given path is a known mountpoint.
>> +#
>> +sub is_mounted ($) {
>> + my ($mpoint) = @_;
>> +
>> + my %mountpoints = reverse %mountpoints;
>> +
>> + # Return "True" if the requested mountpoint is known and
>> + # therefore mounted.
>> + return 1 if($mountpoints{$mpoint});
>> +}
>> +
>> +#
>> +## Returns "True" if a given mountpoint is a subdirectory of one
>> +## of the directories specified by the valid_mount_dirs array abouve.
>> +#
>> +sub is_valid_dir ($) {
>> + my ($mpoint) = @_;
>> +
>> + # Split the given mountpoint into pieces and store them
>> + # in a temporay array.
>> + my @tmp = split("/", $mpoint);
>> +
>> + # Exit and return nothing if the temporary array is empty.
>> + return unless(@tmp);
>> +
>> + # Build the root path based on the given mount point.
>> + my $root_path = "/" . @tmp[1];
>> +
>> + # Check if the root path is valid.
>> + return 1 if(grep /$root_path/, @valid_mount_dirs);
>> +}
>> +
>> +#
>> +# Returns "True" if a device is used as swap.
>> +#
>> +sub is_swap ($) {
>> + my ($device) = @_;
>> +
>> + return 1 if(grep /$device/, @swaps);
>> +}
>> -- 
>> 2.39.2
>> 
>> 
>
  

Hello Michael,

I'm quite a bit bussy at the moment so thanks for your reminder.

I've attached the CGI file and required language file on our bugtracker
:

https://bugzilla.ipfire.org/show_bug.cgi?id=12863

-Stefan
> Stefan, could you please send a link to the CGI file so it can be
> downloaded easily without putting all these patches together?
> 
> > On 25 Jun 2023, at 04:43, jon <jon.murphy@ipfire.org> wrote:
> > 
> > Stefan,
> > 
> > I tried to apply this patch but it doesn’t seem to work.
> > 
> > I notice there are no lines that begin with `-`.
> > 
> > Does this patch start from a blank `extrahd.cgi` file?
> > 
> > 
> > Jon
> > 
> > 
> > 
> > > On Jun 22, 2023, at 11:01 PM, Stefan Schantl
> > > <stefan.schantl@ipfire.org> wrote:
> > > 
> > > This functions are going to replace the former used scan/write to
> > > file/read from
> > > file approach by directly collecting the required informations
> > > from the
> > > kernel sysfs and devfs.
> > > 
> > > Signed-off-by: Stefan Schantl <stefan.schantl@ipfire.org>
> > > ---
> > > html/cgi-bin/extrahd.cgi | 360
> > > +++++++++++++++++++++++++++++++++++++++
> > > 1 file changed, 360 insertions(+)
> > > 
> > > diff --git a/html/cgi-bin/extrahd.cgi b/html/cgi-bin/extrahd.cgi
> > > index 36c0efc2e..44065a8a1 100644
> > > --- a/html/cgi-bin/extrahd.cgi
> > > +++ b/html/cgi-bin/extrahd.cgi
> > > @@ -255,3 +255,363 @@ END
> > > 
> > > &Header::closebigbox();
> > > &Header::closepage();
> > > +
> > > +#
> > > +## Function which return an array with all available block
> > > devices.
> > > +#
> > > +sub get_block_devices () {
> > > + my @devices;
> > > +
> > > + # Open directory from kernel sysfs.
> > > + opendir(DEVICES, "/sys/block");
> > > +
> > > + # Loop through the directory.
> > > + while(readdir(DEVICES)) {
> > > + # Skip . and ..
> > > + next if($_ =~ /^\.$/);
> > > + next if($_ =~ /^\..$/);
> > > +
> > > + # Skip any loopback and ram devices.
> > > + next if($_ =~ "^loop");
> > > + next if($_ =~ "^ram");
> > > +
> > > + # Add the device to the array of found devices.
> > > + push(@devices, $_);
> > > + }
> > > +
> > > + # Close directory handle.
> > > + closedir(DEVICES);
> > > +
> > > + # Return the devices array.
> > > + return @devices;
> > > +}
> > > +
> > > +#
> > > +## Function which return all partitions of a given block device.
> > > +#
> > > +sub get_device_partitions ($) {
> > > + my ($device) = @_;
> > > +
> > > + # Array to store the known partitions for the given
> > > + # device.
> > > + my @partitions;
> > > +
> > > + # Assign device directory.
> > > + my $device_dir = "$sysfs_block_dir/$device";
> > > +
> > > + # Abort and return nothing if the device dir does not exist.
> > > + return unless(-d "$device_dir");
> > > +
> > > + opendir(DEVICE, "$sysfs_block_dir/$device");
> > > + while(readdir(DEVICE)) {
> > > + next unless($_ =~ "^$device");
> > > +
> > > + push(@partitions, $_);
> > > + }
> > > +
> > > + closedir(DEVICE);
> > > +
> > > + @partitions = sort(@partitions);
> > > +
> > > + return @partitions;
> > > +}
> > > +
> > > +#
> > > +## Returns the vendor of a given block device.
> > > +#
> > > +sub get_device_vendor ($) {
> > > + my ($device) = @_;
> > > +
> > > + # Assign device directory.
> > > + my $device_dir = "$sysfs_block_dir/$device";
> > > +
> > > + # Abort and return nothing if the device dir does not exist
> > > + # or no vendor file exists.
> > > + return unless(-d "$device_dir");
> > > + return unless(-f "$device_dir/device/vendor");
> > > +
> > > + # Open and read-in the device vendor.
> > > + open(VENDOR, "$device_dir/device/vendor");
> > > + my $vendor = <VENDOR>;
> > > + close(VENDOR);
> > > +
> > > + # Abort and return nothing if no vendor could be read.
> > > + return unless($vendor);
> > > +
> > > + # Remove any newlines from the vendor string.
> > > + chomp($vendor);
> > > +
> > > + # Return the omited vendor.
> > > + return $vendor;
> > > +}
> > > +
> > > +#
> > > +## Returns the model name (string) of a given block device.
> > > +#
> > > +sub get_device_model ($) {
> > > + my ($device) = @_;
> > > +
> > > + # Assign device directory.
> > > + my $device_dir = "$sysfs_block_dir/$device";
> > > +
> > > + # Abort and return nothing if the device dir does not exist
> > > + # or no model file exists.
> > > + return unless(-d "$device_dir");
> > > + return unless(-f "$device_dir/device/model");
> > > +
> > > + # Open and read-in the device model.
> > > + open(MODEL, "$device_dir/device/model");
> > > + my $model = <MODEL>;
> > > + close(MODEL);
> > > +
> > > + # Abort and return nothing if no model could be read.
> > > + return unless($model);
> > > +
> > > + # Remove any newlines from the model string.
> > > + chomp($model);
> > > +
> > > + # Return the model string.
> > > + return $model;
> > > +}
> > > +
> > > +#
> > > +## Returns the size of a given device in bytes.
> > > +#
> > > +sub get_device_size ($) {
> > > + my ($device) = @_;
> > > +
> > > + # Assign device directory.
> > > + my $device_dir = "$sysfs_block_dir/$device";
> > > +
> > > + # Abort and return nothing if the device dir does not exist
> > > + # or no size file exists.
> > > + return unless(-d "$device_dir");
> > > + return unless(-f "$device_dir/size");
> > > +
> > > + # Open and read-in the device size.
> > > + open(SIZE, "$device_dir/size");
> > > + my $size = <SIZE>;
> > > + close(SIZE);
> > > +
> > > + # Abort and return nothing if the size could not be read.
> > > + return unless($size);
> > > +
> > > + # Remove any newlines for the size string.
> > > + chomp($size);
> > > +
> > > + # The omited size only contains the amount of blocks from the
> > > + # given device. To convert this into bytes we have to multiply
> > > this
> > > + # value with 512 bytes for each block. This is a static value
> > > used by
> > > + # the linux kernel.
> > > + $size = $size * 512;
> > > +
> > > + # Return the size in bytes.
> > > + return $size;
> > > +}
> > > +
> > > +#
> > > +## Function which returns all currently mounted devices as a
> > > hash.
> > > +## example: "sda1" -> "/boot"
> > > +#
> > > +sub get_mountpoints () {
> > > + my %mounts;
> > > +
> > > + # Open and read-in the current mounts from the
> > > + # kernel file system.
> > > + open(MOUNT, "/proc/mounts");
> > > +
> > > + # Loop through the known mounts.
> > > + while(<MOUNT>) {
> > > + # Skip mounts which does not belong to a device.
> > > + next unless ($_ =~ "^/dev");
> > > +
> > > + # Cut the line into pieces and assign nice variables.
> > > + my ($dev, $mpoint, $fs, $options, $a, $b) = split(/ /, $_);
> > > +
> > > + # Split the device name.
> > > + my @tmp = split("/", $dev);
> > > +
> > > + # Assign the plain device name to a new variable.
> > > + # It is the last element of the array.
> > > + my $device = $tmp[-1];
> > > +
> > > + # Add the mountpoint to the hash of mountpoints.
> > > + $mounts{"$device"} = $mpoint;
> > > + }
> > > +
> > > + # Close file handle.
> > > + close(MOUNT);
> > > +
> > > + # Return the hash of known mountpoints.
> > > + return %mounts;
> > > +}
> > > +
> > > +sub get_swaps () {
> > > + my @swaps;
> > > +
> > > + # Open and read the swaps file.
> > > + open(SWAP, "/proc/swaps");
> > > +
> > > + # Loop though the file content.
> > > + while(<SWAP>) {
> > > + # Skip lines which does not belong to a device.
> > > + next unless ($_ =~ "^/dev");
> > > +
> > > + # Split the line and assign nice variables.
> > > + my ($dev, $type, $size, $used, $prio) = split(/ /, $_);
> > > +
> > > + # Cut the device line into pieces.
> > > + my @tmp = split("/", $dev);
> > > +
> > > + my $device = @tmp[-1];
> > > +
> > > + # Add the found swap to the array of swaps.
> > > + push(@swaps, $device);
> > > + }
> > > +
> > > + # Close file handle.
> > > + close(SWAP);
> > > +
> > > + # Sort the array.
> > > + @swaps = sort(@swaps);
> > > +
> > > + # Return the array.
> > > + return @swaps;
> > > +}
> > > +
> > > +#
> > > +## Function with returns the mounted devices and the used
> > > filesystems as a hash.
> > > +## Example: "sda1" -> "ext4"
> > > +#
> > > +sub get_mountedfs () {
> > > + my %mountedfs;
> > > +
> > > + # Open and read the current mounts from the kernel
> > > + # file system.
> > > + open(MOUNT, "/proc/mounts");
> > > +
> > > + # Loop through the known mounts.
> > > + while(<MOUNT>) {
> > > + # Skip mounts which does not belong to a device.
> > > + next unless ($_ =~ "^/dev");
> > > +
> > > + # Split line and assign nice variables.
> > > + my ($dev, $mpoint, $fs, $options, $a, $b) = split(/ /, $_);
> > > +
> > > + # Cut the device line into pieces.
> > > + my @tmp = split("/", $dev);
> > > +
> > > + # Assign the plain device name to a variable
> > > + # It is the last element of the temporary array.
> > > + my $device = $tmp[-1];
> > > +
> > > + # Convert the filesystem into lower case format.
> > > + $fs = lc($fs);
> > > +
> > > + # Add the mounted file system.
> > > + $mountedfs{$device} = $fs;
> > > + }
> > > +
> > > + # Close file handle.
> > > + close(MOUNT);
> > > +
> > > + # Return the hash with the mounted filesystems.
> > > + return %mountedfs;
> > > +}
> > > +
> > > +#
> > > +## Function which returns all known UUID's as a hash.
> > > +## Example: "sda1" -> "1234-5678-abcd"
> > > +#
> > > +sub get_uuids () {
> > > + my %uuids;
> > > +
> > > + # Directory where the uuid mappings can be found.
> > > + my $uuid_dir = "/dev/disk/by-uuid";
> > > +
> > > + # Open uuid directory and read-in the current known uuids.
> > > + opendir(UUIDS, "$uuid_dir");
> > > +
> > > + # Loop through the uuids.
> > > + foreach my $uuid (readdir(UUIDS)) {
> > > + # Skip . and ..
> > > + next if($uuid eq "." or $uuid eq "..");
> > > +
> > > + # Skip everything which is not a symbolic link.
> > > + next unless(-l "$uuid_dir/$uuid");
> > > +
> > > + # Resolve the target of the symbolic link.
> > > + my $target = readlink("$uuid_dir/$uuid");
> > > +
> > > + # Split the link target into pieces.
> > > + my @tmp = split("/", $target);
> > > +
> > > + # Assign the last element of the array to the dev variable.
> > > + my $dev = "$tmp[-1]";
> > > +
> > > + # Add the device and uuid to the hash of uuids.
> > > + $uuids{$dev} = $uuid;
> > > + }
> > > +
> > > + # Close directory handle.
> > > + closedir(UUIDS);
> > > +
> > > + # Return the hash of uuids.
> > > + return %uuids;
> > > +}
> > > +
> > > +#
> > > +## Returns the device name of a given uuid.
> > > +#
> > > +sub device_by_uuid ($) {
> > > + my ($uuid) = @_;
> > > +
> > > + # Reverse the main uuids hash.
> > > + my %uuids = reverse %uuids;
> > > +
> > > + # Lookup and return the device name.
> > > + return $uuids{$uuid};
> > > +}
> > > +
> > > +#
> > > +## Returns "True" in case a given path is a known mountpoint.
> > > +#
> > > +sub is_mounted ($) {
> > > + my ($mpoint) = @_;
> > > +
> > > + my %mountpoints = reverse %mountpoints;
> > > +
> > > + # Return "True" if the requested mountpoint is known and
> > > + # therefore mounted.
> > > + return 1 if($mountpoints{$mpoint});
> > > +}
> > > +
> > > +#
> > > +## Returns "True" if a given mountpoint is a subdirectory of one
> > > +## of the directories specified by the valid_mount_dirs array
> > > abouve.
> > > +#
> > > +sub is_valid_dir ($) {
> > > + my ($mpoint) = @_;
> > > +
> > > + # Split the given mountpoint into pieces and store them
> > > + # in a temporay array.
> > > + my @tmp = split("/", $mpoint);
> > > +
> > > + # Exit and return nothing if the temporary array is empty.
> > > + return unless(@tmp);
> > > +
> > > + # Build the root path based on the given mount point.
> > > + my $root_path = "/" . @tmp[1];
> > > +
> > > + # Check if the root path is valid.
> > > + return 1 if(grep /$root_path/, @valid_mount_dirs);
> > > +}
> > > +
> > > +#
> > > +# Returns "True" if a device is used as swap.
> > > +#
> > > +sub is_swap ($) {
> > > + my ($device) = @_;
> > > +
> > > + return 1 if(grep /$device/, @swaps);
> > > +}
> > > -- 
> > > 2.39.2
> > > 
> > > 
> > 
>