btrfs-functions.pl: New perl functions library

This library will contain functions to deal with BTRFS file systems.

Signed-off-by: Stefan Schantl <stefan.schantl@ipfire.org>

diff --git a/config/cfgroot/btrfs-functions.pl b/config/cfgroot/btrfs-functions.pl
new file mode 100644 (file)
index 0000000..acbb875
--- /dev/null
+++ b/config/cfgroot/btrfs-functions.pl
@@ -0,0 +1,136 @@
+#!/usr/bin/perl -w
+###############################################################################
+#                                                                             #
+# IPFire.org - A linux based firewall                                         #
+# Copyright (C) 2007-2024  IPFire Team  <info@ipfire.org>                     #
+#                                                                             #
+# This program is free software: you can redistribute it and/or modify        #
+# it under the terms of the GNU General Public License as published by        #
+# the Free Software Foundation, either version 2 of the License, or           #
+# (at your option) any later version.                                         #
+#                                                                             #
+# This program is distributed in the hope that it will be useful,             #
+# but WITHOUT ANY WARRANTY; without even the implied warranty of              #
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the               #
+# GNU General Public License for more details.                                #
+#                                                                             #
+# You should have received a copy of the GNU General Public License           #
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.       #
+#                                                                             #
+###############################################################################
+
+package BTRFS;
+
+require '/var/ipfire/general-functions.pl';
+
+# Location where the btrfs binary lives.
+my $btrfs_bin = "/usr/bin/btrfs";
+
+#
+## Function to determine if a given mount path has an underlying BTRFS device.
+##
+## Example: is_btrfs("/")
+#
+sub is_btrfs($) {
+       my ($path) = @_;
+       
+       # Open and read-in the current mounts from the
+       # kernel file system.
+       open(MOUNT, "/proc/mounts");
+
+       # Read-in all currently mounted devices.
+       my @mounts = <MOUNT>;
+
+       # Close file handle.
+       close(MOUNT);
+
+       # Loop through the array of known mounts.
+       foreach my $mount (@mounts) {
+               # Skip mounts which does not belong to a device.
+               next unless ($mount =~ "^/dev");
+
+               # Cut the line into pieces and assign nice variables.
+               my ($dev, $mpoint, $fs, $options, $a, $b) = split(/ /, $mount);
+
+               # Skip lines until we found our given one.
+               next unless($path eq $mpoint);
+
+               # Check if the given path has a BTRFS file system.
+               if(($mpoint eq $path) && ($fs eq "btrfs")) {
+                       # Requested path has a BTRFS as file system.
+                       return 1;
+               }
+       }
+
+       # Requested path does not exist or does not contain a BTRFS.
+       return;
+}
+
+#
+## Function to get the proper free space of a given BTRFS formated device.
+##
+## Second argument: Output format in size or percent
+#
+sub free_space($$) {
+       my ($path, $format) = @_;
+
+       my $size;
+       my $free;
+
+       # Default to output in size (MB)
+       $format //= "size";
+
+       # Call the privata usage function.
+       my @usage = &_filesystem_usage($path);
+
+       # Loop through the output of the usage function.
+       foreach my $line (@usage) {
+               # Remove any newlines.
+               chomp($line);
+
+               # Split the output line into pieces.
+               my ($item, $value) = split(/:/, $line);
+
+               # Grab the total size of the filesystem.
+               if ($line =~/.*Device size:\s+(.*)MB/) {
+                       $size = $1;
+
+               # Grab the available space.
+               } elsif ($line =~/.*Free.*estimated.*:\s+(.*)MB.*min:.*/) {
+                       $free = $1;
+               }
+
+               # Break the loop in case the size and free space have been grabbed.
+               last if(($size) && ($free));
+       }
+
+       # Calculate the output in percent if requested.
+       if ($format eq "percent") {
+               my $free_percent = $free * 100 / $size;
+
+               # Return the free space in percent.
+               return sprintf("%.2f", $free_percent);
+       }
+
+       # Return the free space in MB.
+       return "$free";
+}
+
+#
+## Private subfunction which simply calls the filesystem usage of the btrfs tool.
+#
+sub _filesystem_usage($) {
+       my ($path) = @_;
+
+       # Abort if the given path does not exist or does not contain a BTRFS.
+       return unless(&is_btrfs($path));
+
+       # Call btrfs binary to get details about the current filesystem usage.
+       my @output = &General::system_output("$btrfs_bin", "filesystem", "usage", "--si", "-m", "$path");
+
+       # Return the grabbed output.
+       return @output;
+}
+
+
+1;