Sys-Filesystem-1.408/0000755000175000017500000000000013744034346012616 5ustar snosnoSys-Filesystem-1.408/lib/0000755000175000017500000000000013744034346013364 5ustar snosnoSys-Filesystem-1.408/lib/Sys/0000755000175000017500000000000013744034346014142 5ustar snosnoSys-Filesystem-1.408/lib/Sys/Filesystem.pm0000644000175000017500000004243513744021026016623 0ustar snosno############################################################ # # Sys::Filesystem - Retrieve list of filesystems and their properties # # Copyright 2004,2005,2006 Nicola Worthington # Copyright 2008-2020 Jens Rehsack # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # ############################################################ package Sys::Filesystem; # vim:ts=4:sw=4:tw=78 use 5.008001; use strict; use warnings; use vars qw($VERSION $AUTOLOAD $CANONDEV $FSTAB $MTAB); use Carp qw(carp croak cluck confess); my @query_order; use Module::Pluggable require => 1, only => [@query_order = map { __PACKAGE__ . '::' . $_ } (ucfirst(lc $^O), $^O =~ m/Win32/i ? 'Win32' : 'Unix', 'Dummy')], inner => 0, search_path => ['Sys::Filesystem'], sub_name => '_plugins'; use Params::Util qw(_INSTANCE); use Scalar::Util qw(blessed); use List::Util qw(first); use constant DEBUG => $ENV{SYS_FILESYSTEM_DEBUG} ? 1 : 0; use constant SPECIAL => ('darwin' eq $^O) ? 0 : undef; $VERSION = '1.408'; my ($FsPlugin, $Supported); BEGIN { ## no critic (Subroutines::ProtectPrivateSubs) Sys::Filesystem->_plugins(); foreach my $qo (@query_order) { next unless (eval { $qo->isa($qo) }); $FsPlugin = $qo; last; } $Supported = $FsPlugin ne 'Sys::Filesystem::Unix' and $FsPlugin ne 'Sys::Filesystem::Dummy'; } ## no critic (Subroutines::RequireArgUnpacking) sub new { # Check we're being called correctly with a class name ref(my $class = shift) and croak 'Class name required'; # Check we've got something sane passed croak 'Odd number of elements passed when even number was expected' if (@_ % 2); my %args = @_; exists $args{xtab} and carp("Using xtab is depreciated") and delete $args{xtab}; defined $FSTAB and not exists $args{fstab} and $args{fstab} = $FSTAB; defined $MTAB and not exists $args{mtab} and $args{mtab} = $MTAB; defined $CANONDEV and not exists $args{canondev} and $args{canondev} = $CANONDEV; # Double check the key pairs for stuff we recognise my @sane_keys = qw(aliases canondev fstab mtab); my %sane_args; @sane_args{@sane_keys} = delete @args{@sane_keys}; scalar keys %args and croak("Unrecognised parameter(s) '" . join("', '", sort keys %args) . "' passed to module $class"); my $self = {%sane_args}; # Filesystem property aliases - unless caller knows better ... defined $self->{aliases} or $self->{aliases} = { device => [qw(fs_spec dev)], filesystem => [qw(fs_file mount_point)], mount_point => [qw(fs_file filesystem)], type => [qw(fs_vfstype vfs)], format => [qw(fs_vfstype vfs vfstype)], options => [qw(fs_mntops)], check_frequency => [qw(fs_freq)], check_order => [qw(fs_passno)], boot_order => [qw(fs_mntno)], volume => [qw(fs_volume fs_vol vol)], label => [qw(fs_label)], }; # Debug DUMP('$self', $self) if (DEBUG); $self->{filesystems} = $FsPlugin->new(%sane_args); # Maybe upchuck a little croak "Unable to create object for OS type '$self->{osname}'" unless ($self->{filesystems}); # Bless and return bless($self, $class); return $self; } sub filesystems { my $self = shift; unless (defined(_INSTANCE($self, __PACKAGE__))) { unshift @_, $self unless (0 == (scalar(@_) % 2)); $self = __PACKAGE__->new(); } # Check we've got something sane passed @_ % 2 and croak 'Odd number of elements passed when even number was expected'; my $params = {@_}; for my $param (keys %{$params}) { croak "Illegal paramater '$param' passed to filesystems() method" unless grep { m/^$param$/ } qw(mounted unmounted special device regular); } # Invert logic for regular if (exists $params->{regular}) { delete $params->{regular}; exists($params->{special}) and carp("Mutual exclusive parameters 'special' and 'regular' specified together"); $params->{special} = SPECIAL; } my @filesystems = (); # Return list of all filesystems ## no critic (Subroutines::ProhibitReturnSort) keys %{$params} or return sort(keys(%{$self->{filesystems}})); for my $fsname (sort(keys(%{$self->{filesystems}}))) { for my $requirement (keys(%{$params})) { my $fs = $self->{filesystems}->{$fsname}; my $fsreqname = (not exists $fs->{$requirement} and exists $self->{aliases}->{$requirement}) ? first { exists $fs->{$_} } @{$self->{aliases}->{$requirement}} : $requirement; defined $params->{$requirement} and exists $fs->{$fsreqname} and $fs->{$fsreqname} eq $params->{$requirement} and push(@filesystems, $fsname) and last; push(@filesystems, $fsname) and last unless defined($params->{$requirement}) or exists($fs->{$fsreqname}); } } # Return return @filesystems; } sub supported { return $Supported; } sub mounted_filesystems { return $_[0]->filesystems(mounted => 1); } sub unmounted_filesystems { return $_[0]->filesystems(unmounted => 1); } sub special_filesystems { return $_[0]->filesystems(special => 1); } sub regular_filesystems { return $_[0]->filesystems(special => SPECIAL); } sub DESTROY { } ## no critic (ClassHierarchies::ProhibitAutoloading) sub AUTOLOAD { my ($self, $fsname) = @_; croak "$self is not an object" unless (blessed($self)); croak "No filesystem passed where expected" unless ($fsname); (my $name = $AUTOLOAD) =~ s/.*://; # No such filesystem exists $self->{filesystems}->{$fsname} or croak "No such filesystem"; # Found the property my $fs = $self->{filesystems}->{$fsname}; exists $fs->{$name} and return $fs->{$name}; # Didn't find the property, but check any aliases exists $self->{aliases}->{$name} and $name = first { exists $fs->{$_} } @{$self->{aliases}->{$name}} and return $fs->{$name}; return; } ## no critic (Subroutines::RequireFinalReturn) sub TRACE { return unless DEBUG; carp($_[0]); } sub DUMP { return unless DEBUG; ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval) eval { require Data::Dumper; carp(shift() . ': ' . Data::Dumper::Dumper(shift())); }; } 1; =pod =head1 NAME Sys::Filesystem - Retrieve list of filesystems and their properties =head1 SYNOPSIS use strict; use Sys::Filesystem (); # Method 1 my $fs = Sys::Filesystem->new(); my @filesystems = $fs->filesystems(); for (@filesystems) { printf("%s is a %s filesystem mounted on %s\n", $fs->mount_point($_), $fs->format($_), $fs->device($_) ); } # Method 2 my $weird_fs = Sys::Filesystem->new( fstab => '/etc/weird/vfstab.conf', mtab => '/etc/active_mounts', xtab => '/etc/nfs/mounts' ); my @weird_filesystems = $weird_fs->filesystems(); # Method 3 (nice but naughty) my @filesystems = Sys::Filesystem->filesystems(); =head1 DESCRIPTION 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 consistent API to list all, mounted, unmounted and special filesystems on a system, and query as many properties as possible with common aliases wherever possible. =head1 INHERITANCE Sys::Filesystem ISA UNIVERSAL =head1 METHODS =over 4 =item new Creates a new Sys::Filesystem object. C accepts following optional key value pairs to help or force where mount information is gathered from. These values are not otherwise defaulted by the main Sys::Filesystem object, but left to the platform specific helper modules to determine as an exercise of common sense. =over 4 =item canondev Specify whether device path's shall be resolved when they're a symbolic link. C<$Sys::Filesystem::CANONDEV> is used when no key C is passed. =item fstab Specify the full path and filename of the filesystem table (or fstab for short). Not all platforms have such a file and so this option may be ignored on some systems. C<$Sys::Filesystem::FSTAB> is used when no key C is passed. =item mtab Specify the full path and filename of the mounted filesystem table (or mtab for short). Not all platforms have such a file and so this option may be ignored on some systems. C<$Sys::Filesystem::MTAB> is used when no key C is passed. =item xtab B Specify the full path and filename of the mounted NFS filesystem table (or xtab for short). This is usually only pertinent to Unix bases systems. Not all helper modules will query NFS mounts as a separate exercise, and therefore this option may be ignored on some systems. B of the OS plugins use that tunable (anymore?), so now a warning is raised when it's used. The entire support will be removed not before 2015. Once that happened, using C will raise an exception. =item aliases Overrides internal aliasing table used to match queries against OS plugin. This should be used only when dealing with closed source platform helper module(s). =back =item supported Returns true if the operating system is supported by Sys::Filesystem. Unsupported operating systems may get less information, e.g. the mount state couldn't determined or which file system type is special isn't known. =back =head2 Listing Filesystems =over 4 =item filesystems() Returns a list of all filesystem. May accept an optional list of key pair values in order to filter/restrict the results which are returned. The restrictions are evaluated to match as much as possible, so asking for regular and special file system (or mounted and special file systems), you'll get all. For better understanding, please imagine the parameters like: @fslist = $fs->filesystems( mounted => 1, special => 1 ); # results similar as SELECT mountpoint FROM filesystems WHERE mounted = 1 OR special = 1 If you need other selection choices, please take a look at L. Valid values are as follows: =over 4 =item device => "string" Returns only filesystems that are mounted using the device of "string". For example: my $fdd_filesytem = Sys::Filesystem->filesystems(device => "/dev/fd0"); =item mounted => 1 Returns only filesystems which can be confirmed as actively mounted. (Filesystems which are mounted). The mounted_filesystems() method is an alias for this syntax. =item unmounted => 1 Returns only filesystems which cannot be confirmed as actively mounted. (Filesystems which are not mounted). The unmounted_filesystems() method is an alias for this syntax. =item special => 1 Returns only filesystems which are regarded as special in some way. A filesystem is marked as special by the operating specific helper module. For example, a tmpfs type filesystem on one operating system might be regarded as a special filesystem, but not on others. Consult the documentation of the operating system specific helper module for further information about your system. (Sys::Filesystem::Linux for Linux or Sys::Filesystem::Solaris for Solaris etc). This parameter is mutually exclusive to C. The special_filesystems() method is an alias for this syntax. =item regular => 1 Returns only fileystems which are not regarded as special. (Normal filesystems). This parameter is mutually exclusive to C. The regular_filesystems() method is an alias for this syntax. =back =item mounted_filesystems() Returns a list of all filesystems which can be verified as currently being mounted. =item unmounted_filesystems() Returns a list of all filesystems which cannot be verified as currently being mounted. =item special_filesystems() Returns a list of all fileystems which are considered special. This will usually contain meta and swap partitions like /proc and /dev/shm on Linux. =item regular_filesystems() Returns a list of all filesystems which are not considered to be special. =back =head2 Filesystem Properties Available filesystem properties and their names vary wildly between platforms. Common aliases have been provided wherever possible. You should check the documentation of the specific platform helper module to list all of the properties which are available for that platform. For example, read the Sys::Filesystem::Linux documentation for a list of all filesystem properties available to query under Linux. =over 4 =item mount_point() or filesystem() Returns the friendly name of the filesystem. This will usually be the same name as appears in the list returned by the filesystems() method. =item mounted() Returns boolean true if the filesystem is mounted. =item label() Returns the fileystem label. This functionality may need to be retrofitted to some original OS specific helper modules as of Sys::Filesystem 1.12. =item volume() Returns the volume that the filesystem belongs to or is mounted on. This functionality may need to be retrofitted to some original OS specific helper modules as of Sys::Filesystem 1.12. =item device() Returns the physical device that the filesystem is connected to. =item special() Returns boolean true if the filesystem type is considered "special". =item type() or format() Returns the type of filesystem format. fat32, ntfs, ufs, hpfs, ext3, xfs etc. =item options() Returns the options that the filesystem was mounted with. This may commonly contain information such as read-write, user and group settings and permissions. =item mount_order() Returns the order in which this filesystem should be mounted on boot. =item check_order() Returns the order in which this filesystem should be consistency checked on boot. =item check_frequency() Returns how often this filesystem is checked for consistency. =back =head1 OS SPECIFIC HELPER MODULES =head2 Dummy The Dummy module is there to provide a default failover result to the main Sys::Filesystem module if no suitable platform specific module can be found or successfully loaded. This is the last module to be tried, in order of platform, Unix (if not on Win32), and then Dummy. =head2 Unix The Unix module is intended to provide a "best guess" failover result to the main Sys::Filesystem module if no suitable platform specific module can be found, and the platform is not 'MSWin32'. This module requires additional work to improve it's guestimation abilities. =head2 Darwin First written by Christian Renz . =head2 Win32 Provides C and C of mounted filesystems on Windows. =head2 AIX Please be aware that the AIX /etc/filesystems file has both a "type" and "vfs" field. The "type" field should not be confused with the filesystem format/type (that is stored in the "vfs" field). You may wish to use the "format" field when querying for filesystem types, since it is aliased to be more reliable accross different platforms. =head2 Other Linux, Solaris, Cygwin, FreeBSD, NetBSD, HP-UX. =head2 OS Identifiers The following list is taken from L. Please refer to the original source for the most up to date version. This information should help anyone who wishes to write a helper module for a new platform. Modules should have the same name as ^O in title caps. Thus 'openbsd' becomes 'Openbsd.pm'. =head1 REQUIREMENTS Sys::Filesystem requires Perl >= 5.6 to run. =head1 TODO Add support for Tru64, MidnightBSD, Haiku, Minix, DragonflyBSD and OpenBSD. Please contact me if you would like to provide code for these operating systems. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Sys::Filesystem You can also look for information at: =over 4 =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 SEE ALSO L, L, L, L =head1 AUTHOR Nicola Worthington - L Jens Rehsack - L =head1 ACKNOWLEDGEMENTS See CREDITS in the distribution tarball. =head1 COPYRIGHT Copyright 2004,2005,2006 Nicola Worthington. Copyright 2008-2020 Jens Rehsack. This software is licensed under The Apache Software License, Version 2.0. L =cut Sys-Filesystem-1.408/lib/Sys/Filesystem/0000755000175000017500000000000013744034346016266 5ustar snosnoSys-Filesystem-1.408/lib/Sys/Filesystem/Dummy.pm0000644000175000017500000000354313744021026017713 0ustar snosno############################################################ # # Sys::Filesystem - Retrieve list of filesystems and their properties # # Copyright 2004,2005,2006 Nicola Worthington # Copyright 2008-2020 Jens Rehsack # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # ############################################################ package Sys::Filesystem::Dummy; # vim:ts=4:sw=4:tw=78 use 5.008001; use strict; use warnings; use Carp qw(croak); use vars qw($VERSION); $VERSION = '1.408'; sub version() { return $VERSION; } ## no critic (Subroutines::RequireArgUnpacking) sub new { ref(my $class = shift) && croak 'Class name required'; my %args = @_; my $self = bless({}, $class); return $self; } 1; =pod =head1 NAME Sys::Filesystem::Dummy - Returns nothing to Sys::Filesystem =head1 SYNOPSIS See L. =head1 INHERITANCE Sys::Filesystem::Dummy ISA UNIVERSAL =head1 METHODS =over 4 =item version () Return the version of the (sub)module. =back =head1 AUTHOR Nicola Worthington - L Jens Rehsack - L =head1 COPYRIGHT Copyright 2004,2005,2006 Nicola Worthington. Copyright 2009-2020 Jens Rehsack. This software is licensed under The Apache Software License, Version 2.0. L =cut Sys-Filesystem-1.408/lib/Sys/Filesystem/Hpux.pm0000644000175000017500000000513613744021026017544 0ustar snosno############################################################ # # Sys::Filesystem - Retrieve list of filesystems and their properties # # Copyright (c) 2009 H.Merijn Brand, All rights reserved. # Copyright (c) 2009-2020 Jens Rehsack, All rights reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # ############################################################ package Sys::Filesystem::Hpux; use 5.008001; use strict; use warnings; use vars qw($VERSION); use parent qw(Sys::Filesystem::Unix); use Carp qw(croak); $VERSION = '1.408'; sub version() { return $VERSION; } # Default fstab and mtab layout my @fstabkeys = qw(fs_spec fs_file fs_vfstype fs_mntops fs_freq fs_passno); my @mnttabkeys = qw(fs_spec fs_file fs_vfstype fs_mntops fs_freq fs_passno mount_time); my %special_fs = ( swap => 1, proc => 1 ); ## no critic (Subroutines::RequireArgUnpacking) sub new { my $proto = shift; my $class = ref($proto) || $proto or croak 'Class name required'; my %args = @_; my $self = bless({}, $class); $args{canondev} and $self->{canondev} = 1; # Defaults $args{fstab} ||= '/etc/fstab'; $args{mtab} ||= '/etc/mnttab'; unless ($self->readFsTab($args{fstab}, \@fstabkeys, [0, 1, 2], \%special_fs)) { croak "Unable to open fstab file ($args{fstab})\n"; } unless ($self->readMntTab($args{mtab}, \@mnttabkeys, [0, 1, 2], \%special_fs)) { croak "Unable to open fstab file ($args{mtab})\n"; } delete $self->{canondev}; return $self; } 1; =pod =head1 NAME Sys::Filesystem::Hpux - Return HP-UX filesystem information to Sys::Filesystem =head1 SYNOPSIS See L. =head1 INHERITANCE Sys::Filesystem::Hpux ISA Sys::Filesystem::Unix ISA UNIVERSAL =head1 METHODS =over 4 =item version () Return the version of the (sub)module. =back =head1 AUTHOR H.Merijn Brand, PROCURA B.V. =head1 COPYRIGHT Copyright 2009 H.Merijn Brand PROCURA B.V. Copyright 2009-2020 Jens Rehsack. This software is licensed under The Apache Software License, Version 2.0. L =cut Sys-Filesystem-1.408/lib/Sys/Filesystem/Mswin32.pm0000644000175000017500000000746113744021026020065 0ustar snosno############################################################ # # Sys::Filesystem - Retrieve list of filesystems and their properties # # Copyright 2004,2005,2006 Nicola Worthington # Copyright 2008-2020 Jens Rehsack # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # ############################################################ package Sys::Filesystem::Mswin32; # vim:ts=4:sw=4:tw=78 use 5.008001; use strict; use warnings; use vars qw($VERSION); use Params::Util qw(_STRING); use Win32::DriveInfo; use Carp qw(croak); $VERSION = '1.408'; sub version() { return $VERSION; } my @volInfoAttrs = ('n/a', 'preserve case', 'case sensitive', 'unicode', 'acl', 'file compression', 'compressed volume'); my @typeExplain = ('unable to determine', 'no root directory', 'removeable', 'fixed', 'network', 'cdrom', 'ram disk'); ## no critic (Subroutines::RequireArgUnpacking) sub new { ref(my $class = shift) && croak 'Class name required'; my %args = @_; my $self = {}; my @drives = Win32::DriveInfo::DrivesInUse(); for my $drvletter (@drives) { my $type = Win32::DriveInfo::DriveType($drvletter); my ($VolumeName, $VolumeSerialNumber, $MaximumComponentLength, $FileSystemName, @attr) = Win32::DriveInfo::VolumeInfo($drvletter); my $drvRoot = $drvletter . ":/"; defined(_STRING($VolumeName)) and $VolumeName =~ s/\\/\//g; defined(_STRING($VolumeName)) or $VolumeName = $drvRoot; $VolumeName = ucfirst($VolumeName); $FileSystemName ||= 'CDFS' if ($type == 5); # XXX Win32::DriveInfo gives no details here ... $self->{$drvRoot}->{mount_point} = $drvRoot; $self->{$drvRoot}->{device} = $VolumeName; # XXX Win32::DriveInfo gives sometime wrong information here $self->{$drvRoot}->{format} = $FileSystemName; $self->{$drvRoot}->{options} = join(',', map { $volInfoAttrs[$_] } @attr); my $mntstate = ((defined $FileSystemName) and $type > 1); $mntstate and 2 == $type and $mntstate = Win32::DriveInfo::IsReady($drvletter); $mntstate = $mntstate ? "mounted" : "unmounted"; $self->{$drvRoot}->{$mntstate} = 1; $type > 0 and $self->{$drvRoot}->{type} = $typeExplain[$type]; } bless($self, $class); return $self; } 1; =pod =head1 NAME Sys::Filesystem::Mswin32 - Return Win32 filesystem information to Sys::Filesystem =head1 SYNOPSIS See L. =head1 INHERITANCE Sys::Filesystem::Mswin32 ISA UNIVERSAL =head1 METHODS =over 4 =item version () Return the version of the (sub)module. =back =head1 ATTRIBUTES =over 4 =item mount_point Mount point. =item device Device of the file system. =item mounted True when mounted. =back =head1 AUTHOR Nicola Worthington - L Jens Rehsack - L =head1 BUGS AND LIMITATIONS As long no better data source as Win32::DriveInfo is available, only mounted drives are recognized, no UNC names neither file systems mounted to a path. =head1 COPYRIGHT Copyright 2004,2005,2006 Nicola Worthington. Copyright 2009-2020 Jens Rehsack. This software is licensed under The Apache Software License, Version 2.0. L =cut Sys-Filesystem-1.408/lib/Sys/Filesystem/Darwin.pm0000644000175000017500000001353113744021026020042 0ustar snosno############################################################ # # Sys::Filesystem - Retrieve list of filesystems and their properties # # Copyright 2004,2005,2006 Nicola Worthington # Copyright 2008-2020 Jens Rehsack # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # ############################################################ package Sys::Filesystem::Darwin; # vim:ts=4:sw=4:tw=78 use 5.008001; use strict; use warnings; use vars qw($VERSION); use parent qw(Sys::Filesystem::Unix); use IPC::Cmd (); use Carp qw(croak); $VERSION = '1.408'; sub version() { return $VERSION; } my @dt_keys = qw(fs_spec fs_file fs_vfstype fs_name); my @mount_keys1 = qw(fs_spec fs_file fs_vfstype); my @mount_keys2 = qw(fs_spec fs_file fs_mntops); my %special_fs = ( devfs => 1, autofs => 1, ); ## no critic (RegularExpressions::ProhibitComplexRegexes) my $dt_rx = qr/Disk\sAppeared\s+\('([^']+)',\s* Mountpoint\s*=\s*'([^']+)',\s* fsType\s*=\s*'([^']*)',\s* volName\s*=\s*'([^']*)'\)/x; my $mount_rx1 = qr/(.*) on (.*) \((\w+),?.*\)/; # /dev/disk on / (hfs,...) my $mount_rx2 = qr/(.*) on (.*) \(([^)]*)\)/; # /dev/disk on / (hfs,...) sub new { my ($class, %args) = @_; my $self = bless({}, $class); $args{canondev} and $self->{canondev} = 1; foreach my $prog (qw(diskutil disktool mount)) { defined $args{$prog} or $args{$prog} = (grep { defined $_ and -x $_ } ("/usr/sbin/$prog", "/sbin/$prog"))[0]; } my @list_fs_cmd; defined $args{diskutil} and $args{diskutil} and @list_fs_cmd = ($args{diskutil}, "list"); (0 == scalar @list_fs_cmd) and defined $args{disktool} and $args{disktool} and @list_fs_cmd = ($args{disktool}, "-l"); @list_fs_cmd or croak("No command to list file systems ..."); # don't use backticks, don't use the shell my @fslist = (); my @mntlist = (); open(my $dt_fh, '-|') or exec(@list_fs_cmd) or croak("Cannot execute " . join(" ", @list_fs_cmd) . ": $!"); @fslist = <$dt_fh>; close($dt_fh); open(my $m_fh, '-|') or exec($args{mount}) or croak("Cannot execute $args{mount}: $!"); @mntlist = <$m_fh>; close($m_fh); $self->readMounts($dt_rx, [0, 1, 2], \@dt_keys, \%special_fs, @fslist); #foreach (@fslist) #{ # # For mounted FTP servers, fsType and volName are empty on Mac OS X 10.3 # # However, Mountpoint should not be empty. # next unless (/Disk Appeared \('([^']+)',Mountpoint = '([^']+)', fsType = '([^']*)', volName = '([^']*)'\)/); # my ( $device, $mount_point, $fstype, $name ) = ( $1, $2, $3, $4 ); # $self->{$mount_point}->{mounted} = 1; # $self->{$mount_point}->{special} = 0; # $self->{$mount_point}->{device} = $device; # $self->{$mount_point}->{mount_point} = $mount_point; # $self->{$mount_point}->{fs_vfstype} = $fstype; # $self->{$mount_point}->{fs_mntops} = ''; # $self->{$mount_point}->{label} = $name; #} $self->readMounts($mount_rx1, [0, 1, 2], \@mount_keys1, \%special_fs, @mntlist); $self->readMounts($mount_rx2, [0, 1], \@mount_keys2, undef, @mntlist); # set the mount options #foreach (@mntlist) #{ # next unless (/(.*) on (.*) \((.*)\)/); # /dev/disk on / (hfs,...) # my ( $device, $mount_point, $mntopts ) = ( $1, $2, $3 ); # if ( exists( $self->{$mount_point} ) ) # { # $self->{$mount_point}->{fs_mntops} = $mntopts; # } #} delete $self->{canondev}; return $self; } 1; =head1 NAME Sys::Filesystem::Darwin - Return Darwin (Mac OS X) filesystem information to Sys::Filesystem =head1 SYNOPSIS See L. =head1 DESCRIPTION The filesystem information is taken from diskutil, the system utility supplied on Mac OS X. =head1 INHERITANCE Sys::Filesystem::Darwin ISA Sys::Filesystem::Unix ISA UNIVERSAL =head1 METHODS =over 4 =item version () Return the version of the (sub)module. =back =head1 ATTRIBUTES The following is a list of filesystem properties which may be queried as methods through the parent L object. The property 'label' is also set, but cannot be queried by L yet. =over 4 =item mount_point The mount point (usually either '/' or '/Volumes/...'). =item device The mounted device =item format Describes the type of the filesystem. So far I encountered the following types: =over 4 =item hfs The standard Mac OS X HFS(+) filesystem. Disk images (.dmg) and Mac Software DVDs normally also use the HFS(+) format. =item msdos DOS image files (e.g. floppy disk images) =item cd9660 CD-ROM image files or real CD-ROMs =item cddafs Audio CDs =item udf UDF filesystem (e.g. DVDs) =back =item (empty) For mounted FTP servers, disktool returns an empty filesystem type (ie, ''). =back =head1 BUGS Doesn't take /etc/fstab or /etc/xtab into account right now, since they are normally not used. Contact the author if you need this. =head1 SEE ALSO L, L =head1 AUTHOR Christian Renz Jens Rehsack - L =head1 COPYRIGHT Copyright 2004,2005,2006 Nicola Worthington. Copyright 2009-2020 Jens Rehsack. This software is licensed under The Apache Software License, Version 2.0. L =cut Sys-Filesystem-1.408/lib/Sys/Filesystem/Solaris.pm0000644000175000017500000000702213744021026020230 0ustar snosno############################################################ # # Sys::Filesystem - Retrieve list of filesystems and their properties # # Copyright 2004,2005,2006 Nicola Worthington # Copyright 2009-2020 Jens Rehsack # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # ############################################################ package Sys::Filesystem::Solaris; # vim:ts=4:sw=4:tw=78 use 5.008001; use strict; use warnings; use vars qw($VERSION); use parent qw(Sys::Filesystem::Unix); use Carp qw(croak); use Data::Dumper; require Sys::Filesystem::Unix; $VERSION = '1.408'; sub version() { return $VERSION; } my @fstab_keys = qw(device device_to_fsck mount_point fs_vfstype fs_freq mount_at_boot fs_mntops); my @mtab_keys = qw(device mount_point fs_vfstype fs_mntops time); my %special_fs = ( swap => 1, proc => 1, procfs => 1, tmpfs => 1, mntfs => 1, autofs => 1, lofs => 1, fd => 1, ctfs => 1, devfs => 1, dev => 1, objfs => 1, cachefs => 1, ); ## no critic (Subroutines::RequireArgUnpacking) sub new { ref(my $class = shift) && croak 'Class name required'; my %args = @_; my $self = bless({}, $class); $args{canondev} and $self->{canondev} = 1; $args{fstab} ||= '/etc/vfstab'; $args{mtab} ||= '/etc/mnttab'; unless ($self->readFsTab($args{fstab}, \@fstab_keys, [0, 2, 3], \%special_fs)) { croak "Unable to open fstab file ($args{fstab})\n"; } unless ($self->readMntTab($args{mtab}, \@mtab_keys, [0, 1, 2], \%special_fs)) { croak "Unable to open mtab file ($args{mtab})\n"; } delete $self->{canondev}; return $self; } 1; =pod =head1 NAME Sys::Filesystem::Solaris - Return Solaris filesystem information to Sys::Filesystem =head1 SYNOPSIS See L. =head1 INHERITANCE Sys::Filesystem::Solaris ISA Sys::Filesystem::Unix ISA UNIVERSAL =head1 METHODS =over 4 =item version () Return the version of the (sub)module. =back =head1 ATTRIBUTES The following is a list of filesystem properties which may be queried as methods through the parent L object. =over 4 =item device Resource name. =item device_to_fsck The raw device to fsck. =item mount_point The default mount directory. =item fs_vfstype The name of the file system type. =item fs_freq The number used by fsck to decide whether to check the file system automatically. =item mount_at_boot Whether the file system should be mounted automatically by mountall. =item fs_mntops The file system mount options. =item time The time at which the file system was mounted. =back =head1 SEE ALSO L =head1 AUTHOR Nicola Worthington - L Jens Rehsack - L =head1 COPYRIGHT Copyright 2004,2005,2006 Nicola Worthington. Copyright 2009-2020 Jens Rehsack. This software is licensed under The Apache Software License, Version 2.0. L =cut Sys-Filesystem-1.408/lib/Sys/Filesystem/Cygwin.pm0000644000175000017500000000641713744021026020063 0ustar snosno############################################################ # # Sys::Filesystem - Retrieve list of filesystems and their properties # # Copyright 2004,2005,2006 Nicola Worthington # Copyright 2008-2020 Jens Rehsack # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # ############################################################ package Sys::Filesystem::Cygwin; # vim:ts=4:sw=4:tw=78 use 5.008001; use strict; use warnings; use vars qw($VERSION); use parent qw(Sys::Filesystem::Unix); use Carp qw(croak); $VERSION = '1.408'; sub version() { return $VERSION; } my @keys = qw(fs_spec fs_file fs_vfstype fs_mntops); my %special_fs = ( swap => 1, proc => 1, devpts => 1, tmpfs => 1, ); my $mount_rx = qr/^\s*(.+?)\s+on\s+(\/.*)\s+type\s+(\S+)\s+\((\S+)\)\s*$/; ## no critic (Subroutines::RequireArgUnpacking) sub new { ref(my $class = shift) && croak 'Class name required'; my %args = @_; my $self = bless({}, $class); $args{canondev} and $self->{canondev} = 1; local $/ = "\n"; my @mounts = qx( mount ); $self->readMounts($mount_rx, [0, 1, 2], \@keys, \%special_fs, @mounts); delete $self->{canondev}; return $self; } 1; #worthn01@PC-L438082~ $ mount #d:\cygwin\bin on /usr/bin type user (binmode) #d:\cygwin\lib on /usr/lib type user (binmode) #d:\cygwin on / type user (binmode) #c: on /cygdrive/c type user (binmode,noumount) #d: on /cygdrive/d type user (binmode,noumount) #f: on /cygdrive/f type user (binmode,noumount) #i: on /cygdrive/i type user (binmode,noumount) #j: on /cygdrive/j type user (binmode,noumount) #l: on /cygdrive/l type user (binmode,noumount) #s: on /cygdrive/s type user (binmode,noumount) #z: on /cygdrive/z type user (binmode,noumount) #worthn01@PC-L438082~ $ =pod =head1 NAME Sys::Filesystem::Cygwin - Return Cygwin filesystem information to Sys::Filesystem =head1 SYNOPSIS See L. =head1 INHERITANCE Sys::Filesystem::Cygwin ISA Sys::Filesystem::Unix ISA UNIVERSAL =head1 METHODS =over 4 =item version() Return the version of the (sub)module. =back =head1 ATTRIBUTES The following is a list of filesystem properties which may be queried as methods through the parent L object. =over 4 =item device Device mounted. =item mount_point Mount point. =item fs_vfstype Filesystem type. =item fs_mntops Mount options. =back =head1 SEE ALSO L =head1 AUTHOR Nicola Worthington - L Jens Rehsack - L =head1 COPYRIGHT Copyright 2004,2005,2006 Nicola Worthington. Copyright 2008-2020 Jens Rehsack. This software is licensed under The Apache Software License, Version 2.0. L =cut Sys-Filesystem-1.408/lib/Sys/Filesystem/Aix.pm0000644000175000017500000002334613744021026017344 0ustar snosno############################################################ # # Sys::Filesystem - Retrieve list of filesystems and their properties # # Copyright 2004,2005,2006 Nicola Worthington # Copyright 2008-2020 Jens Rehsack # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # ############################################################ package Sys::Filesystem::Aix; # vim:ts=4:sw=4:tw=78 use 5.008001; use strict; use warnings; use vars qw($VERSION); use Carp qw(croak); use Cwd 'abs_path'; use IO::File; $VERSION = '1.408'; sub version() { return $VERSION; } my @fstab_keys = qw(account boot check dev mount nodename size type vfs vol log); my %special_fs = ( swap => 1, procfs => 1, proc => 1, tmpfs => 1, mntfs => 1, autofs => 1, ); # see AIX commands at # http://publib.boulder.ibm.com/infocenter/pseries/v5r3/topic/com.ibm.aix.doc/doc/base/alphabeticallistofcommands.htm ## no critic (Subroutines::RequireArgUnpacking) sub new { ref(my $class = shift) && croak 'Class name required'; my %args = @_; my $self = bless({}, $class); $args{fstab} ||= '/etc/filesystems'; local $/ = "\n"; my %curr_mountz = map { my $path = $_ =~ m/^\s/ ? (split)[1] : (split)[2]; ($path => 1); } qx( /usr/sbin/mount ); my %fs_info = map { my ($path, $device, $vfs, $nodename, $type, $size, $options, $mount, $account) = split(m/:/, $_); ($path => [$device, $vfs, $nodename, $type, $size, $options, $mount, $account]) } grep { m/^[^#]/ } qx( /usr/sbin/lsfs -c ); foreach my $current_filesystem (keys %fs_info) { $self->{$current_filesystem}->{filesystem} = $current_filesystem; my ($device, $vfs, $nodename, $type, $size, $options, $mount, $account) = @{$fs_info{$current_filesystem}}; $args{canondev} and -l $device and $device = abs_path($device); $self->{$current_filesystem}->{dev} = $device; $self->{$current_filesystem}->{vfs} = $vfs; $self->{$current_filesystem}->{options} = $options; $self->{$current_filesystem}->{nodename} = $nodename; $self->{$current_filesystem}->{type} = $type; $self->{$current_filesystem}->{size} = $size; $self->{$current_filesystem}->{mount} = $mount; $self->{$current_filesystem}->{account} = $account; $self->{$current_filesystem}->{special} = 1 if (defined($vfs) && defined($special_fs{$vfs})); # the filesystem is either currently mounted or is not, # this does not need to be checked for each individual # attribute. my $state = defined($curr_mountz{$current_filesystem}) ? 'mounted' : 'unmounted'; $self->{$current_filesystem}->{$state} = 1; } my @active_vgs = qx(/usr/sbin/lsvg -Lo); scalar @active_vgs and %fs_info = map { my ($lvname, $type, $lps, $pps, $pvs, $lvstate, $path) = split(m/\s+/, $_); ($path => [$lvname, $type, $lps, $pps, $pvs, $lvstate]) } grep { $_ !~ m/^\w+:$/ } grep { $_ !~ m/^LV\sNAME\s+/ } grep { $_ !~ m(N/A$) } qx( /usr/sbin/lsvg -Ll `/usr/sbin/lsvg -Lo` ); foreach my $current_filesystem (keys %fs_info) { $self->{$current_filesystem}->{filesystem} = $current_filesystem; my ($lvname, $type, $lps, $pps, $pvs, $lvstate) = @{$fs_info{$current_filesystem}}; $args{canondev} and -l $lvname and $lvname = abs_path($lvname); $self->{$current_filesystem}->{dev} = $lvname; $self->{$current_filesystem}->{vfs} = $type; $self->{$current_filesystem}->{LPs} = $lps; $self->{$current_filesystem}->{PPs} = $pps; $self->{$current_filesystem}->{PVs} = $pvs; $self->{$current_filesystem}->{lvstate} = $lvstate; $self->{$current_filesystem}->{special} = 1 if (defined($type) && defined($special_fs{$type})); # the filesystem is either currently mounted or is not, # this does not need to be checked for each individual # attribute. my $state = defined($curr_mountz{$current_filesystem}) ? 'mounted' : 'unmounted'; $self->{$current_filesystem}->{$state} = 1; } # Read the fstab if (my $fstab = IO::File->new($args{fstab}, 'r')) { my $current_filesystem = '*UNDEFINED*'; while (<$fstab>) { # skip comments and blank lines. next if m{^ [*] }x || m{^ \s* $}x; # Found a new filesystem group if (/^\s*(.+?):\s*$/) { $current_filesystem = $1; $self->{$current_filesystem}->{filesystem} = $1; # the filesystem is either currently mounted or is not, # this does not need to be checked for each individual # attribute. my $state = defined($curr_mountz{$current_filesystem}) ? 'mounted' : 'unmounted'; $self->{$current_filesystem}{$state} = 1; # This matches a filesystem attribute } elsif (my ($key, $value) = $_ =~ /^\s*([a-z]{3,8})\s+=\s+"?(.+)"?\s*$/) { # do not overwrite already known data defined $self->{$current_filesystem}->{$key} and next; $key eq "dev" and $args{canondev} and -l $value and $value = abs_path($value); $self->{$current_filesystem}->{$key} = $value; if (($key eq 'vfs') && defined($special_fs{$value})) { $self->{$current_filesystem}->{special} = 1; } } } $fstab->close(); } else { croak "Unable to open fstab file ($args{fstab})\n"; } return $self; } 1; =pod =head1 NAME Sys::Filesystem::Aix - Return AIX filesystem information to Sys::Filesystem =head1 SYNOPSIS See L. =head1 INHERITANCE Sys::Filesystem::Aix ISA UNIVERSAL =head1 METHODS =over 4 =item version () Return the version of the (sub)module. =back =head1 ATTRIBUTES The following is a list of filesystem properties which may be queried as methods through the parent L object. =over 4 =item account Used by the dodisk command to determine the filesystems to be processed by the accounting system. =item boot Used by the mkfs command to initialize the boot block of a new filesystem. =item check Used by the fsck command to determine the default filesystems to be checked. =item dev Identifies, for local mounts, either the block special file where the filesystem resides or the file or directory to be mounted. =item free This value can be either true or false. (Obsolete and ignored). =item mount Used by the mount command to determine whether this file system should be mounted by default. =item nodename Used by the mount command to determine which node contains the remote filesystem. =item size Used by the mkfs command for reference and to build the file system. =item type Used to group related mounts. =item vfs Specifies the type of mount. For example, vfs=nfs specifies the virtual filesystem being mounted is an NFS filesystem. =item vol Used by the mkfs command when initializing the label on a new filesystem. The value is a volume or pack label using a maximum of 6 characters. =item log The LVName must be the full path name of the filesystem logging logical volume name to which log data is written as this file system is modified. This is only valid for journaled filesystems. =back =head1 SEE ALSO L =head2 Example /etc/filesystems * @(#)filesystems @(#)29 1.22 src/bos/etc/filesystems/filesystems, cmdfs, bos530 9/8/00 13:57:45 * IBM_PROLOG_BEGIN_TAG * This is an automatically generated prolog. * * * * This version of /etc/filesystems assumes that only the root file system * is created and ready. As new file systems are added, change the check, * mount, free, log, vol and vfs entries for the appropriate stanza. /: dev = /dev/hd4 vol = "root" mount = automatic check = false free = true vfs = jfs2 log = /dev/hd8 type = bootfs /proc: dev = /proc vol = "/proc" mount = true check = false free = false vfs = procfs /scratch: dev = /dev/fslv02 vfs = jfs2 log = INLINE mount = true account = false =head2 Example /usr/sbin/mount output node mounted mounted over vfs date options -------- --------------- --------------- ------ ------------ --------------- /dev/hd4 / jfs2 Mar 24 12:14 rw,log=/dev/hd8 /proc /proc procfs Mar 24 12:15 rw /dev/fslv02 /scratch jfs2 Mar 24 12:15 rw,log=INLINE =head2 filesystems(4) Manpage includes all known options, describes the format and comment char's. =head1 AUTHOR Nicola Worthington - L Jens Rehsack - L =head1 COPYRIGHT Copyright 2004,2005,2006 Nicola Worthington. Copyright 2008-2020 Jens Rehsack. This software is licensed under The Apache Software License, Version 2.0. L =cut Sys-Filesystem-1.408/lib/Sys/Filesystem/Unix.pm0000644000175000017500000002275113744021026017545 0ustar snosno############################################################ # # $Id$ # Sys::Filesystem - Retrieve list of filesystems and their properties # # Copyright 2004,2005,2006 Nicola Worthington # Copyright 2008-2020 Jens Rehsack # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # ############################################################ package Sys::Filesystem::Unix; # vim:ts=4:sw=4:tw=78 use 5.008001; use strict; use warnings; use vars qw($VERSION); use Carp qw(croak); use Cwd 'abs_path'; use Fcntl qw(:flock); use IO::File; $VERSION = '1.408'; sub version() { return $VERSION; } # Default fstab and mtab layout my @keys = qw(fs_spec fs_file fs_vfstype fs_mntops fs_freq fs_passno); my %special_fs = ( swap => 1, proc => 1 ); ## no critic (Subroutines::RequireArgUnpacking) sub new { ref(my $class = shift) && croak 'Class name required'; my %args = @_; my $self = bless({}, $class); $args{canondev} and $self->{canondev} = 1; # Defaults $args{fstab} ||= '/etc/fstab'; $args{mtab} ||= '/etc/mtab'; $self->readFsTab($args{fstab}, \@keys, [0, 1, 2], \%special_fs); $self->readMntTab($args{mtab}, \@keys, [0, 1, 2], \%special_fs); delete $self->{canondev}; return $self; } ## no critic (Subroutines::ProhibitSubroutinePrototypes) sub readFsTab($\@\@\%) { my ($self, $fstabPath, $fstabKeys, $pridx, $special_fs) = @_; # Read the fstab local $/ = "\n"; if (my $fstab = IO::File->new($fstabPath, 'r')) { while (<$fstab>) { next if (/^\s*#/ || /^\s*$/); # $_ =~ s/#.*$//; # next if( /^\s*$/ ); my @vals = split(' ', $_); $self->{canondev} and -l $vals[$pridx->[0]] and $vals[$pridx->[0]] = abs_path($vals[$pridx->[0]]); $self->{$vals[$pridx->[1]]}->{mount_point} = $vals[$pridx->[1]]; $self->{$vals[$pridx->[1]]}->{device} = $vals[$pridx->[0]]; $self->{$vals[$pridx->[1]]}->{unmounted} = 1 unless (defined($self->{$vals[$pridx->[1]]}->{mounted})); if (defined($pridx->[2])) { my $vfs_type = $self->{$vals[$pridx->[1]]}->{fs_vfstype} = $vals[$pridx->[2]]; $self->{$vals[$pridx->[1]]}->{special} = 1 if (defined($special_fs->{$vfs_type})); } else { $self->{$vals[$pridx->[1]]}->{special} = 0 unless (defined($self->{$vals[$pridx->[1]]}->{special})); } for (my $i = 0; $i < @{$fstabKeys}; ++$i) { $self->{$vals[$pridx->[1]]}->{$fstabKeys->[$i]} = defined($vals[$i]) ? $vals[$i] : ''; } } $fstab->close(); return 1; } return 0; } sub readMntTab($\@\@\%) { my ($self, $mnttabPath, $mnttabKeys, $pridx, $special_fs) = @_; # Read the mtab local $/ = "\n"; my $mtab; if (($mtab = IO::File->new($mnttabPath, 'r')) && flock($mtab, LOCK_SH | LOCK_NB)) { while (<$mtab>) { next if (/^\s*#/ || /^\s*$/); # $_ =~ s/#.*$//; # next if( /^\s*$/ ); my @vals = split(/\s+/, $_); $self->{canondev} and -l $vals[$pridx->[0]] and $vals[$pridx->[0]] = abs_path($vals[$pridx->[0]]); delete $self->{$vals[$pridx->[1]]}->{unmounted} if (exists($self->{$vals[$pridx->[1]]}->{unmounted})); $self->{$vals[$pridx->[1]]}->{mounted} = 1; $self->{$vals[$pridx->[1]]}->{mount_point} = $vals[$pridx->[1]]; $self->{$vals[$pridx->[1]]}->{device} = $vals[$pridx->[0]]; if (defined($pridx->[2])) { my $vfs_type = $self->{$vals[$pridx->[1]]}->{fs_vfstype} = $vals[$pridx->[2]]; $self->{$vals[$pridx->[1]]}->{special} = 1 if (defined($special_fs->{$vfs_type})); } else { $self->{$vals[$pridx->[1]]}->{special} = 0 unless (defined($self->{$vals[$pridx->[1]]}->{special})); } for (my $i = 0; $i < @{$mnttabKeys}; ++$i) { $self->{$vals[$pridx->[1]]}->{$mnttabKeys->[$i]} = defined($vals[$i]) ? $vals[$i] : ''; } } $mtab->close(); return 1; } return 0; } ## no critic (Subroutines::ProhibitManyArgs) sub readMounts { my ($self, $mount_rx, $pridx, $keys, $special, @lines) = @_; foreach my $line (@lines) { if (my @vals = $line =~ $mount_rx) { $self->{canondev} and -l $vals[$pridx->[0]] and $vals[$pridx->[0]] = abs_path($vals[$pridx->[0]]); $self->{$vals[$pridx->[1]]}->{mount_point} = $vals[$pridx->[1]]; $self->{$vals[$pridx->[1]]}->{device} = $vals[$pridx->[0]]; $self->{$vals[$pridx->[1]]}->{mounted} = 1; delete $self->{$vals[$pridx->[1]]}->{unmounted} if (exists($self->{$vals[$pridx->[1]]}->{unmounted})); if (defined($pridx->[2])) { my $vfs_type = $self->{$vals[$pridx->[1]]}->{fs_vfstype} = $vals[$pridx->[2]]; $self->{$vals[$pridx->[1]]}->{special} = 1 if (defined($special->{$vfs_type})); } elsif (!defined($self->{$vals[$pridx->[1]]}->{special})) { $self->{$vals[$pridx->[1]]}->{special} = 0; } for (my $i = 0; $i < @{$keys}; ++$i) { $self->{$vals[$pridx->[1]]}->{$keys->[$i]} = defined($vals[$i]) ? $vals[$i] : ''; } } } return $self; } sub readSwap { my ($self, $swap_rx, @lines) = @_; foreach my $line (@lines) { if (my ($dev) = $line =~ $swap_rx) { $self->{canondev} and -l $dev and $dev = abs_path($dev); $self->{none}->{mount_point} ||= 'none'; $self->{none}->{device} = $dev; $self->{none}->{fs_vfstype} = 'swap'; $self->{none}->{mounted} = 1; $self->{none}->{special} = 1; delete $self->{none}->{unmounted}; } } return $self; } 1; =pod =head1 NAME Sys::Filesystem::Unix - Return generic Unix filesystem information to Sys::Filesystem =head1 SYNOPSIS See L. =head1 INHERITANCE Sys::Filesystem::Unix ISA UNIVERSAL =head1 METHODS =over 4 =item version() Return the version of the (sub)module. =item readFsTab This method provides the capability to parse a standard unix fstab file. It expects following arguments: =over 8 =item fstabPath Full qualified path to the fstab file to read. =item fstabKeys The column names for the fstab file through an array reference. =item special_fs Hash reference containing the names of all special file systems having a true value as key. =back This method return true in case the specified file could be opened for reading, false otherwise. =item readMntTab This method provides the capability to read abd parse a standard unix mount-tab file. The file is locked using flock after opening it. It expects following arguments: =over 8 =item mnttabPath Full qualified path to the mnttab file to read. =item mnttabKeys The column names for the mnttab file through an array reference. =item $special_fs Hash reference containing the names of all special file systems having a true value as key. =back This method return true in case the specified file could be opened for reading and locked, false otherwise. =item readMounts This method is called to parse the information got from C system command. It expects following arguments: =over 8 =item mount_rx Regular expression to extract the information from each mount line. =item pridx Array reference containing the index for primary keys of interest in match in following order: device, mount_point, type. =item keys Array reference of the columns of the match - in order of paranteses in regular expression. =item special Array reference containing the names of the special file system types. =item lines Array containing the lines to parse. =back =item readSwap This method is called to parse the information from the swap status. It expects following arguments: =over 8 =item swap_rx Regular expression to extract the information from each swap status line. This regular expression should have exact one pair of parantheses to identify the swap device. =item lines Array containing the lines to parse. =back =back =head1 AUTHOR Nicola Worthington - L Jens Rehsack - L =head1 COPYRIGHT Copyright 2004,2005,2006 Nicola Worthington. Copyright 2008-2020 Jens Rehsack. This software is licensed under The Apache Software License, Version 2.0. L =cut Sys-Filesystem-1.408/lib/Sys/Filesystem/Linux.pm0000644000175000017500000001634613744021026017724 0ustar snosno############################################################ # # Sys::Filesystem - Retrieve list of filesystems and their properties # # Copyright 2004,2005,2006 Nicola Worthington # Copyright 2008-2020 Jens Rehsack # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # ############################################################ package Sys::Filesystem::Linux; # vim:ts=4:sw=4:tw=78 use 5.008001; use strict; use warnings; use vars qw($VERSION); use parent qw(Sys::Filesystem::Unix); use Carp qw(croak); use Cwd 'abs_path'; use IO::File (); $VERSION = '1.408'; sub version() { return $VERSION; } # Default fstab and mtab layout my @keys = qw(fs_spec fs_file fs_vfstype fs_mntops fs_freq fs_passno); my %special_fs = ( binfmt_misc => 1, debugfs => 1, devpts => 1, fusectl => 1, 'fuse.gvfs-fuse-daemon' => 1, mini_fo => 1, nfsd => 1, proc => 1, procbususb => 1, securityfs => 1, swap => 1, sysfs => 1, tmpfs => 1, udev => 1, ); ## no critic (Subroutines::RequireArgUnpacking) sub new { ref(my $class = shift) && croak 'Class name required'; my %args = @_; my $self = bless({}, $class); # Defaults $args{fstab} ||= '/etc/fstab'; $args{mtab} ||= -r '/proc/mounts' ? '/proc/mounts' : '/etc/mtab'; #$args{xtab} ||= '/etc/lib/nfs/xtab'; $args{canondev} and $self->{canondev} = 1; local $/ = "\n"; # Read the fstab if (my $fstab = IO::File->new($args{fstab}, 'r')) { while (<$fstab>) { next if (/^\s*#/ || /^\s*$/); my @vals = split(' ', $_); $vals[0] =~ /^\s*LABEL=(.+)\s*$/ and $self->{$vals[1]}->{label} = $1; $args{canondev} and -l $vals[0] and $vals[0] = abs_path($vals[0]); $self->{$vals[1]}->{mount_point} = $vals[1]; $self->{$vals[1]}->{device} = $vals[0]; $self->{$vals[1]}->{unmounted} = 1; defined $special_fs{$vals[2]} and $self->{$vals[1]}->{special} = 1; @{$self->{$vals[1]}}{@keys} = @vals; } $fstab->close(); } else { croak "Unable to open fstab file ($args{fstab})\n"; } # Read the mtab unless ($self->readMntTab($args{mtab}, \@keys, [0, 1, 2], \%special_fs)) { croak "Unable to open fstab file ($args{mtab})\n"; } delete $self->{canondev}; return $self; } 1; =pod =head1 NAME Sys::Filesystem::Linux - Return Linux filesystem information to Sys::Filesystem =head1 SYNOPSIS See L. =head1 INHERITANCE Sys::Filesystem::Linux ISA Sys::Filesystem::Unix ISA UNIVERSAL =head1 METHODS =over 4 =item version () Return the version of the (sub)module. =back =head1 ATTRIBUTES The following is a list of filesystem properties which may be queried as methods through the parent L object. =over 4 =item fs_spec Describes the block special device or remote filesystem to be mounted. For ordinary mounts it will hold (a link to) a block special device node (as created by L) for the device to be mounted, like '/dev/cdrom' or '/dev/sdb7'. For NFS mounts one will have :, e.g., 'knuth.aeb.nl:/'. For procfs, use 'proc'. Instead of giving the device explicitly, one may indicate the (ext2 or xfs) filesystem that is to be mounted by its UUID or volume label (cf. L or L), writing LABEL=