Retrieve list of filesystems and their properties

Sys::Filesystem is intended to be a portable interface to list and query filesystem names and their properties. At the time of writing there were only Solaris and Win32 modules available on CPAN to perform this kind of operation. This module hopes to provide a consistant API to list all, mounted, unmounted and special filesystems on a system, and query as many properties as possible with common aliases wherever possible. WWW: http://search.cpan.org/dist/Sys-Filesystem/ PR: ports/98307 Submitted by: pirzyk
svn path=/head/; revision=166572
2006-06-29 08:36:42 +00:00 · 2006-06-29 08:36:42 +00:00 · 9d9ba9300a · 2021-03-31 03:12:20 +00:00
commit 9d9ba9300a
parent e5108f2b26
7 changed files with 172 additions and 0 deletions
--- a/sysutils/Makefile
+++ b/sysutils/Makefile
@ -391,6 +391,7 @@
    SUBDIR += p5-Schedule-Match
    SUBDIR += p5-Stat-lsMode
    SUBDIR += p5-Sys-CpuLoad
+    SUBDIR += p5-Sys-Filesystem
    SUBDIR += p5-Sys-Hostname-Long
    SUBDIR += p5-Sys-Utmp
    SUBDIR += p5-SyslogScan
--- a/sysutils/p5-Sys-Filesystem/Makefile
+++ b/sysutils/p5-Sys-Filesystem/Makefile
@ -0,0 +1,37 @@
+# New ports collection makefile for:   p5-Sys-Filesystem
+# Date created:                        Thu May 25 21:12:53 CDT 2006
+# Whom:                                        Jim Pirzyk pirzyk@freebsd.org
+#
+# $FreeBSD$
+#
+
+PORTNAME=		Sys-Filesystem
+PORTVERSION=	1.21
+CATEGORIES=	sysutils perl5
+MASTER_SITES=	${MASTER_SITE_PERL_CPAN}
+MASTER_SITE_SUBDIR=	Sys
+PKGNAMEPREFIX=	p5-
+
+MAINTAINER=	pirzyk@FreeBSD.org
+COMMENT=		Perl module to Retrieve list of filesystems and their properties
+
+PERL_MODBUILD=	yes
+
+MAN3=		Sys::Filesystem::Mswin32.3 \
+			Sys::Filesystem.3 \
+			Sys::Filesystem::Linux.3 \
+			Sys::Filesystem::Darwin.3 \
+			Sys::Filesystem::Cygwin.3 \
+			Sys::Filesystem::Aix.3 \
+			Sys::Filesystem::Unix.3 \
+			Sys::Filesystem::Dummy.3 \
+			Sys::Filesystem::Freebsd.3 \
+			Sys::Filesystem::Solaris.3
+
+.include <bsd.port.pre.mk>
+
+.if ${PERL_LEVEL} < 500600
+IGNORE=		requires perl 5.6.x or later. Install lang/perl5 then try again
+.endif
+
+.include <bsd.port.post.mk>
--- a/sysutils/p5-Sys-Filesystem/distinfo
+++ b/sysutils/p5-Sys-Filesystem/distinfo
@ -0,0 +1,3 @@
+MD5 (Sys-Filesystem-1.21.tar.gz) = 99bdb1a37ed2fde8e6ebede2c36c117e
+SHA256 (Sys-Filesystem-1.21.tar.gz) = 9d5a706f730bbdf013d610c46e32b8c2bb8663382799976df8eb1e6fa17483c5
+SIZE (Sys-Filesystem-1.21.tar.gz) = 18352
--- a/sysutils/p5-Sys-Filesystem/files/patch-lib-Sys-Filesystem-Freebsd.pm
+++ b/sysutils/p5-Sys-Filesystem/files/patch-lib-Sys-Filesystem-Freebsd.pm
@ -0,0 +1,98 @@
+--- ./lib/Sys/Filesystem/Freebsd.pm.orig	Sat Mar 25 14:44:35 2006
+++ ./lib/Sys/Filesystem/Freebsd.pm	Thu Jun  1 14:55:02 2006
+@@ -26,20 +26,33 @@
+ use FileHandle;
+ use Carp qw(croak);
+ 
+# For access to the getfsstat system call
+require 'sys/syscall.ph';
+require 'sys/mount.ph';
+
+ use vars qw($VERSION);
+ $VERSION = '1.05' || sprintf('%d', q$Revision: 364 $ =~ /(\d+)/g);
+ 
+my $sizeof;
+if ( &STATFS_VERSION == 0x20030518 ) {
+	$sizeof = 472; # The size in bytes of the statfs structure
+} else {
+	croak "The statfs strucuture changed version (" . &STATFS_VERSION . ")\n";
+}
+# unpack format, we want the 3rd and the last 3 fields.
+my $format = 'x8L' . 'x192' . ('A' . &MNAMELEN ) x 3 ;
+
+ sub new {
+ 	ref(my $class = shift) && croak 'Class name required';
+ 	my %args = @_;
+ 	my $self = { };
+ 
+ 	$args{fstab} ||= '/etc/fstab';
+-	$args{mtab} ||= '/etc/mtab';
+-	$args{xtab} ||= '/etc/lib/nfs/xtab';
+	# $args{mtab} ||= '/etc/mtab';  # Does not exist on FreeBSD
+	$args{xtab} ||= '/var/db/mountdtab';
+ 
+ 	my @keys = qw(fs_spec fs_file fs_vfstype fs_mntops fs_freq fs_passno);
+-	my @special_fs = qw(swap proc devpts tmpfs);
+	my @special_fs = qw(swap proc devpts devfs tmpfs);
+ 
+ 	# Read the fstab
+ 	my $fstab = new FileHandle;
+@@ -60,24 +73,42 @@
+ 		croak "Unable to open fstab file ($args{fstab})\n";
+ 	}
+ 
+-	# Read the mtab
+-	my $mtab = new FileHandle;
+-	if ($mtab->open($args{mtab})) {
+-		while (<$mtab>) {
+-			next if (/^\s*#/ || /^\s*$/);
+-			my @vals = split(/\s+/, $_);
+-			delete $self->{$vals[1]}->{unmounted} if exists $self->{$vals[1]}->{unmounted};
+-			$self->{$vals[1]}->{mounted} = 1;
+-			$self->{$vals[1]}->{mount_point} = $vals[1];
+-			$self->{$vals[1]}->{device} = $vals[0];
+-			$self->{$vals[1]}->{special} = 1 if grep(/^$vals[2]$/,qw(swap proc devpts tmpfs));
+-			for (my $i = 0; $i < @keys; $i++) {
+-				$self->{$vals[1]}->{$keys[$i]} = $vals[$i];
+-			}
+	# Get the number of mounted fileystems we have
+	my $buf = '';
+	my $cnt = syscall(&SYS_getfsstat, $buf, length $buf, &MNT_NOWAIT);
+
+	# Fix a bug on some 5.x systems, the previous syscall may return 0...
+	$cnt = 20 if ( ! $cnt );
+
+	# Preallocate the buffer memory per the syscall() requreiments
+	$buf = ' ' x ( $sizeof * $cnt );
+
+	if ( ($cnt=syscall(&SYS_getfsstat, $buf, length $buf, &MNT_NOWAIT)) ) {
+		for (my ($i) = 0; $i < $cnt; $i++) {
+
+			my $offset = ($i)? 'x' . ($i * $sizeof): '';
+			my @vals = unpack ( $offset . $format, $buf);
+
+			delete $self->{$vals[3]}->{unmounted} if exists $self->{$vals[3]}->{unmounted};
+			$self->{$vals[3]}->{mounted} = 1;
+			$self->{$vals[3]}->{mount_point} = $vals[3];
+			$self->{$vals[3]}->{device} = $vals[2];
+			$self->{$vals[3]}->{special} = 1 if grep(/^$vals[1]$/,@special_fs);
+
+			$self->{$vals[3]}->{fs_spec} = $vals[2];
+			$self->{$vals[3]}->{fs_file} = $vals[3];
+			$self->{$vals[3]}->{fs_vfstype} = $vals[1];
+			$self->{$vals[3]}->{fs_mntops} = 
+				($vals[0] & &MNT_RDONLY)? 'ro': 'rw';
+			$self->{$vals[3]}->{fs_mntops} .= ',noexec'
+				if ($vals[0] & &MNT_NOEXEC);
+			$self->{$vals[3]}->{fs_mntops} .= ',nosuid'
+				if ($vals[0] & &MNT_NOSUID);
+			$self->{$vals[3]}->{fs_mntops} .= ',nodev'
+				if ($vals[0] & &MNT_NODEV);
+ 		}
+-		$mtab->close;
+ 	} else {
+-		croak "Unable to open mtab file ($args{mtab})\n";
+		croak "Unable to retrieve mounted filesystem information\n";
+ 	}
+ 
+ 	# Bless and return
--- a/sysutils/p5-Sys-Filesystem/files/patch-lib-Sys-Filesystem.pm
+++ b/sysutils/p5-Sys-Filesystem/files/patch-lib-Sys-Filesystem.pm
@ -0,0 +1,11 @@
+--- lib/Sys/Filesystem.pm.orig	Fri May 26 12:06:39 2006
+++ lib/Sys/Filesystem.pm	Fri May 26 12:06:40 2006
+@@ -108,7 +108,7 @@
+ 	# Invert logic for regular
+ 	if (exists $params->{regular}) {
+ 		delete $params->{regular};
+-		$params->{regular} = undef;
+		$params->{special} = undef;
+ 	}
+ 
+ 	my @filesystems = ();
--- a/sysutils/p5-Sys-Filesystem/pkg-descr
+++ b/sysutils/p5-Sys-Filesystem/pkg-descr
@ -0,0 +1,10 @@
+Retrieve list of filesystems and their properties
+
+Sys::Filesystem is intended to be a portable interface to list and query
+filesystem names and their properties. At the time of writing there were
+only Solaris and Win32 modules available on CPAN to perform this kind of
+operation. This module hopes to provide a consistant API to list all,
+mounted, unmounted and special filesystems on a system, and query as
+many properties as possible with common aliases wherever possible.
+
+WWW: http://search.cpan.org/dist/Sys-Filesystem/
--- a/sysutils/p5-Sys-Filesystem/pkg-plist
+++ b/sysutils/p5-Sys-Filesystem/pkg-plist
@ -0,0 +1,12 @@
+%%SITE_PERL%%/Sys/Filesystem.pm
+%%SITE_PERL%%/Sys/Filesystem/Aix.pm
+%%SITE_PERL%%/Sys/Filesystem/Cygwin.pm
+%%SITE_PERL%%/Sys/Filesystem/Darwin.pm
+%%SITE_PERL%%/Sys/Filesystem/Dummy.pm
+%%SITE_PERL%%/Sys/Filesystem/Freebsd.pm
+%%SITE_PERL%%/Sys/Filesystem/Linux.pm
+%%SITE_PERL%%/Sys/Filesystem/Mswin32.pm
+%%SITE_PERL%%/Sys/Filesystem/Solaris.pm
+%%SITE_PERL%%/Sys/Filesystem/Unix.pm
+@dirrm %%SITE_PERL%%/Sys/Filesystem
+@dirrmtry %%SITE_PERL%%/Sys