From patchwork Tue Aug 1 15:48:28 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Stefan Schantl X-Patchwork-Id: 7048 Return-Path: Received: from mail01.ipfire.org (mail01.haj.ipfire.org [172.28.1.202]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384 client-signature ECDSA (secp384r1) client-digest SHA384) (Client CN "mail01.haj.ipfire.org", Issuer "R3" (verified OK)) by web04.haj.ipfire.org (Postfix) with ESMTPS id 4RFffk73RQz3wmm for ; Tue, 1 Aug 2023 15:49:02 +0000 (UTC) Received: from mail02.haj.ipfire.org (mail02.haj.ipfire.org [172.28.1.201]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384 client-signature ECDSA (secp384r1) client-digest SHA384) (Client CN "mail02.haj.ipfire.org", Issuer "R3" (verified OK)) by mail01.ipfire.org (Postfix) with ESMTPS id 4RFffj2zy0z16Y; Tue, 1 Aug 2023 15:49:01 +0000 (UTC) Received: from mail02.haj.ipfire.org (localhost [127.0.0.1]) by mail02.haj.ipfire.org (Postfix) with ESMTP id 4RFffj28k0z2yWd; Tue, 1 Aug 2023 15:49:01 +0000 (UTC) Received: from mail01.ipfire.org (mail01.haj.ipfire.org [172.28.1.202]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (P-384) server-digest SHA384 client-signature ECDSA (P-384) client-digest SHA384) (Client CN "mail01.haj.ipfire.org", Issuer "R3" (verified OK)) by mail02.haj.ipfire.org (Postfix) with ESMTPS id 4RFffh4bbYz2x9l for ; Tue, 1 Aug 2023 15:49:00 +0000 (UTC) Received: from [127.0.0.1] (localhost [127.0.0.1]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by mail01.ipfire.org (Postfix) with ESMTPSA id 4RFffg00jgzRC; Tue, 1 Aug 2023 15:48:58 +0000 (UTC) DKIM-Signature: v=1; a=ed25519-sha256; c=relaxed/relaxed; d=ipfire.org; s=202003ed25519; t=1690904939; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding; bh=hlCJVww6xDYmhhAgG/dCYs8F4kyAQn5yKCoGlCfXhvM=; b=/JFwSyYriPLOEIgdF/b6pAUgVYSffnZV2xBTwp0ShyGrs6isXgEMMB0jGJeIXR2YFphv89 lwecm+jkkDZOZPDQ== DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=ipfire.org; s=202003rsa; t=1690904939; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding; bh=hlCJVww6xDYmhhAgG/dCYs8F4kyAQn5yKCoGlCfXhvM=; b=YuyemEimuSgVsfk0I4+SjLrnnuCmO0RfweEq4X6SwUH5bVY9kL1lfKnt7SDtwgFSVjusJu zukN1y9aB8edwm5c0fymD135zfIAeZOTVgikhNUn87GTRPHFQ+u+EbehF0HeNb0IkG3dcm 3O4gRA7Pe8OzPl0cS6ep6QTsg5tOQzam4s0iYDREKSzSE6um2Th2NA/brvr8dr55ya3lrV rj9wRvvbMtn0DdfdGojQqzPSRS0uNtH3OSJ39UOaPb4OnxXdRsMdyfH4+K7itZBD51WDg1 NXZDHQYlFd9IOuur0U4MFPqsA4cVJBRljcrzUXnE/GHmUbrF9LRaFcPDwphcew== From: Stefan Schantl To: development@lists.ipfire.org Subject: [PATCHv2 01/12] extrahd.cgi: Add various perl functions deal with block devices Date: Tue, 1 Aug 2023 17:48:28 +0200 Message-Id: <20230801154839.2373-1-stefan.schantl@ipfire.org> MIME-Version: 1.0 X-BeenThere: development@lists.ipfire.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: IPFire development talk List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: development-bounces@lists.ipfire.org Sender: "Development" 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 Reviewed-by: Bernhard Bitsch --- 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 9dd3a0eee..5aadf15e8 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 = ; + 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 = ; + 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 = ; + 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() { + # 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() { + # 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() { + # 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); +}