package Tie::Mounted;

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

use Carp ();
use File::Which ();
use IO::File ();
use Symbol ();

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

$VERSION = '0.16';


$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 { Carp::croak 'Tied array is read-only' };

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

sub _gather_paths {
    unless (-e $MOUNT_BIN && -x $MOUNT_BIN) {
        eval { require File::Basename };
	die $@ if $@;
        my $mount_which = File::Which::which('mount');
	$mount_which
	  ? $MOUNT_BIN = $mount_which
	  : Carp::croak "Can't locate ", File::Basename::basename($MOUNT_BIN), ": $!";
    }
    unless (-e $UMOUNT_BIN && -x $UMOUNT_BIN) {
        eval { require File::Basename };
	die $@ if $@;
        my $umount_which = File::Which::which('umount');
	$umount_which
	  ? $UMOUNT_BIN = $umount_which
	  : Carp::croak "Can't locate ", File::Basename::basename($UMOUNT_BIN), ": $!";
    }
}

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
      ? Carp::croak 'No node supplied'
      : !-d $node
        ? Carp::croak "$node doesn't exist"
        : $fstabs =~ /^\#.*$node/m
          ? Carp::croak "$node is enlisted as disabled in $FSTAB"
	  : $fstabs !~ /$node/s
	    ? Carp::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')) { 
	Carp::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 = Symbol::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 = Symbol::gensym();
    
    opendir($dh, $node)
      or die "Can't open directory $node: $!";
      
    my @items = sort readdir($dh); 
    splice(@items, 0, 2);
    
    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>).

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 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.

=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
