#!/usr/bin/perl -w
#
# amount
#
# Process a command, automatically mounting and unmounting any mount
# points in the command's arguments.  Also re-globs arguments as
# needed after mounting.
#
# Usage: amount command args...
#
# This program is in the public domain.  Use at your own risk.
# <http://membled.com/work/apps/amount/>.
#
# Version 0.1.4
#
# -- Ed Avis, ed@membled.com, 2004-12-26
#

use strict;
use File::Basename;

# Subroutine prototypes
sub canon_dirname($);
sub under_dir($$);

my $FSTAB = '/etc/fstab';
my $MOUNT = '/proc/mounts'; # or 'mount |'

# Check usage
my ($cmd, @args) = @ARGV;
die "usage: $0 command [args]\n" if not defined $cmd;

# Get list of mount points
my %auto_mp;
open(FSTAB, $FSTAB) or die "cannot open $FSTAB: $!";
while (<FSTAB>) {
    s/\#.*//; s/^\s+//; s/\s+$//; next if not length;
    /^\S+\s+(\S+)\s+\S+\s+\S+\s+\d+\s+\d+$/
      or die "$FSTAB:$.: bad line";
    my $mp = $1;

    if ($mp !~ m!^/!) {
	warn "$FSTAB:$.: mount point $mp not absolute\n" unless $mp eq 'swap';
	next;
    }

    $auto_mp{canon_dirname($mp)}++
      && warn "$FSTAB:$.: mount point $mp already seen";
}

# But leave alone those which are already mounted
open(MOUNT, $MOUNT) or die "cannot open $MOUNT: $!";
while (<MOUNT>) {
    s/\#.*//; s/^\s+//; s/\s+$//; next if not length;
    /^.+ (.+) .+ .+ \d \d$/
      or /^.+ on (.+) type .+ \(.+\)\s*$/
	or die "$MOUNT:$.:bad line";

    delete $auto_mp{canon_dirname($1)};
}

# Now look at the command's arguments and do any mounting needed.
my %mounted;
my $fail = 0;
MP: foreach my $mp (keys %auto_mp) {
  ARG: foreach (@args) {
	if (under_dir($_, $mp)) {
	    if (system('mount', $mp) != 0) {
		warn "could not mount $mp, aborting\n";
		$fail = 1;
		last MP;
	    } else {
		$mounted{$mp} = 1;
		last ARG;
	    }
	}
    }
}

# Exit status is from command - unless something went wrong, when we
# don't run the command but just return 1.
#
my $rc;
if ($fail) {
    $rc = 1;
} else {
    # Glob arguments which are on one of the auto-mounted places
    my @globbed;
  ARG: foreach my $arg (@args) {
	foreach my $m (keys %mounted) {
	    if (under_dir($arg, $m)) {
		# Okay, glob it - but if it doesn't match anything,
                # push it on unchanged (like the shell does).
                #
		my @glob_arg = glob $arg;
		push @globbed, (scalar @glob_arg) ? @glob_arg : $arg;
		next ARG;
	    }
	}

	# Not under any of the places we mounted.
	push @globbed, $arg;
    }

    # At last, run the command.
    $rc = system($cmd, @globbed);
}

# Finally, put things back as they were before.
foreach (keys %mounted) {
    system('umount', $_) && warn "could not umount $_\n";
}

exit($rc);


# canon_dirname()
#
# In Unix, directories are sometimes written with a trailing slash,
# and sometimes without.  Furthermore several consecutive slashes are
# equivalent to just one.
#
# This function converts a directory name to a canonical form which
# always ends in a slash and doesn't have two consecutive slashes
# anywhere.  It knows nothing about '.' and '..'.
#
# Parameters: directory name
# Returns: canonical form
#
sub canon_dirname($) {
    die 'usage: canon_dirname(directory name)' if @_ != 1;
    local $_ = shift;

    s!/{2,}!/!g;
    $_ .= '/' unless m!/$!;
    return $_;
}


# under_dir()
#
# Is one file 'at or under' a certain directory?  NB a directory is a
# type of 'file'.
#
# Parameters:
#   filename
#   directory name
#
# Returns: whether (file is under directory or file _is_ directory)
#
sub under_dir($$) {
    die 'usage: under_dir(filename, dirname)' if @_ != 2;
    my ($f, $d) = @_;
    $d = canon_dirname($d);

    if (canon_dirname($f) eq $d) {
	# File and directory are the same
	return 1;
    }

    if (index(canon_dirname(dirname($f)), $d) == 0) {
	# File contained in directory
	return 1;
    }

    return 0;
}