package Tie::Mounted;

use strict;
use warnings;
use base qw(Tie::Array);

use Carp qw(croak);
use File::Which ();
use IO::File ();
use Symbol qw(gensym);

our ($VERSION, $FSTAB, $MOUNT_BIN, $UMOUNT_BIN, $NO_FILES);

$VERSION = '0.18';
$FSTAB = '/etc/fstab';
$MOUNT_BIN  = '/sbin/mount';
$UMOUNT_BIN = '/sbin/umount';

sub _private
{
    my $APPROVE = 0;
    my @NODES   = qw(    );

    return eval do { $_[0] };
}

{
    sub TIEARRAY
    {
        my $class = shift;

        _gather_paths();
        _validate_node($_[0]);

        return bless &_tie, $class;
    }

    sub FETCHSIZE { $#{$_[0]} }           # FETCHSIZE, FETCH: Due to the node,
    sub FETCH     { $_[0]->[++$_[1]] }    # which is being kept hideously, accordingly
                                          # subtract (FETCHSIZE) or add (FETCH) 1.
    *STORESIZE = *STORE =
      sub { croak 'Tied array is read-only' };

    sub UNTIE { _approve('umount', $_[0]->[0]) }
}

sub _gather_paths
{
    my $which_bin = sub
    {
        my ($target_var_name, $target) = @_;

        no strict 'refs';
        unless (-e ${$target_var_name} && -x _) {
            eval { require File::Basename };
            die $@ if $@;
            my $which = File::Which::which($target);
            defined $which
              ? ${$target_var_name} = $which
              : croak "Can't locate '", File::Basename::basename(${$target_var_name}), "': $!";
        }
    };

    $which_bin->('MOUNT_BIN', 'mount');
    $which_bin->('UMOUNT_BIN', 'umount');
}

sub _validate_node
{
    my ($node) = @_;

    my $fh = IO::File->new("<$FSTAB") or die "Can't open $FSTAB for reading: $!";
    my $fstabs = do { local $/; <$fh> };
    $fh->close;

    !$node
      ? croak 'No node supplied'
      : !-d $node
        ? croak "$node doesn't exist in $FSTAB"
        : $fstabs =~ /^\#.*$node/m
          ? croak "$node is enlisted as disabled in $FSTAB"
          : $fstabs !~ /$node/s
            ? croak "$node is not enlisted in $FSTAB"
            : '';
}

sub _tie
{
    my $node = shift;
    my @args = split /\s+/, $_[0];

    _approve('mount', $node, grep !/^-[aAd]$/o, @args);

    my $items = $NO_FILES ? [] : _read_dir($node);

    # Invisible node at index 0
    unshift @$items, $node;

    return $items;
}

sub _approve
{
    my ($sub, $node) = (shift, @_);

    if (_private('$APPROVE')) {
        croak "Attempt to $sub unapproved node"
          unless (grep { $node eq $_ } _private('@NODES'));
    }

    no strict 'refs';
    &{"_$sub"};
}

sub _mount
{
    my $node = shift;

    unless (_is_mounted($node)) {
        my $cmd = "$MOUNT_BIN @_ $node";
        system($cmd) == 0 or exit(1);
    }
}

sub _is_mounted
{
    my ($node) = @_;

    my $pipe = gensym();

    open($pipe, "$MOUNT_BIN |")
      or die "Can't init pipe to $MOUNT_BIN: $!";

    my $retval = (grep /$node/, <$pipe>) ? 1 : 0;

    close($pipe);

    return $retval;
}

sub _read_dir
{
    my ($node) = @_;

    my $dh = gensym();

    opendir($dh, $node)
      or die "Can't open directory $node: $!";

    my @items = grep !/^(?:\.|\.\.)$/, sort readdir($dh);

    closedir($dh);

    return \@items;
}

sub _umount
{
    my ($node) = @_;

    my $cmd = "$UMOUNT_BIN $node";
    system($cmd) == 0 or exit(1);
}

1;
__END__

=head1 NAME

Tie::Mounted - Tie a mounted node to an array

=head1 SYNOPSIS

 use Tie::Mounted;

 tie @files, 'Tie::Mounted', '/backup', '-v';
 print $files[-1];
 untie @files;

=head1 DESCRIPTION

This module ties files (and directories) of a mount point to an
array by invoking the system commands C<mount> and C<umount>;
C<mount> is invoked when a former attempt to tie an array is
being committed, C<umount> when a tied array is to be untied.
Suitability is therefore limited and suggests a rarely
used node (such as F</backup>, for example).

The mandatory parameter consists of the node (or: I<mount point>)
to be mounted (F</backup> - as declared in F</etc/fstab>);
optional options to C<mount> may be subsequently passed (C<-v>).
Device names and mount options (C<-a,-A,-d>) will be discarded
in regard of system security.

Default paths to C<mount> and C<umount> may be overriden
by setting accordingly either C<$Tie::Mounted::MOUNT_BIN> or
C<$Tie::Mounted::UMOUNT_BIN>. If either of them doesn't exist
at the predefined path, a C<which()> will be performed to
determine the actual path.

If C<$Tie::Mounted::NO_FILES> is set to a true value,
a bogus array with zero files will be tied.

=head1 BUGS & CAVEATS

=head2 Security

C<Tie::Mounted> has by default set C<$APPROVE> to an untrue value in order
to allow all nodes to be passed. If C<$APPROVE> is set to a true value,
C<@NODES> has to contain the nodes that are considered ``approved"; both
variables are lexically scoped and adjustable within C<_private()>. If in
approval mode and a node is passed that is considered unapproved,
C<Tie::Mounted> will throw an exception.

Such ``security" is rather trivial; instead it is recommended
to adjust filesystem permissions to prevent malicious use.

=head2 Portability

C<Tie::Mounted> is Linux/UNIX centered (due to the F<fstab> file & the
C<mount/umount> binaries requirements) and will most likely won't work
on other platforms.

=head2 Miscellanea

The tied array is read-only.

Files within the tied array are statically tied.

=head2 Lacking tests

Tests that test the base functionality are completely missing due to an
environment that most likely can't be adequately simulated.

=head1 SEE ALSO

L<perlfunc/tie>, fstab(5), mount(8), umount(8)

=head1 AUTHOR

Steven Schubiger <schubiger@cpan.org>

=head1 LICENSE

This program is free software; you may redistribute it and/or
modify it under the same terms as Perl itself.

See L<http://www.perl.com/perl/misc/Artistic.html>

=cut