#!/usr/pubsw/bin/perl -w
$ID = q$Id: loadmtpt,v 1.13 2006-08-06 19:40:41 eagle Exp $;
#
# loadmtpt -- Insert or update an AFS volume mountpoint into database.
#
# Written by Neil Crellin <neilc@stanford.edu>
# Extensively updated by Russ Allbery <rra@stanford.edu>
# Copyright 1999, 2000, 2003, 2004, 2005
#     Board of Trustees, Leland Stanford Jr. University
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.

##############################################################################
# Site configuration
##############################################################################

# This is probably specific to Stanford and can be removed elsewhere.
if (`uname -m` =~ /x86_64/) {
    die "loadmtpt: Cannot run on 64 bit systems due to db incompatibilities\n";
}

# The path to the mount point database.  Note that you need to make sure that
# all versions of Perl that you use to run this script use the same version of
# the Berkeley DB database format.
$DB = '/afs/ir/service/afs/data/mountpoints/mountpoints.db';

# The full path to fs and vos.  Allow for Linux where the preferred location
# may be on local disk.
($FS)  = grep { -x $_ } qw(/usr/bin/fs /usr/afsws/bin/fs /usr/pubsw/bin/fs);
$FS ||= '/usr/afsws/bin/fs';
($VOS) = grep { -x $_ } qw(/usr/bin/vos /usr/pubsw/bin/vos);
$VOS ||= '/usr/pubsw/bin/vos';

# The following function is used to convert paths to a canonical form.  You
# will almost certainly want to change this for your site.
sub canonify_path {
    my ($path) = @_;
    $path =~ s%^/chroot/afs/%/afs%;
    $path =~ s%^/afs/\.?ir(?:\.stanford\.edu)?/%/afs/.ir/%;
    unless ($path =~ m%^/afs/\.ir(/|\z)% || $path eq '/afs') {
        die "$0: bad path $path (all paths must begin with /afs/.ir/)\n";
    }
    return $path;
}

# The following function is used to guess a mount point for a particular
# volume.  You will almost certainly want to change this for your site.  It is
# used to support the -g option to guess at a mount point for a volume.
sub guess_mount {
    local $_ = shift;
    if (/^user\.((\w)(\w)\w+)$/) {
        return "/afs/.ir/users/$2/$3/$1";
    } elsif (/^class\.(([a-z]+)[a-z0-9-]*)\.(\d+)$/) {
        return "/afs/.ir/class/archive/$2/$1/$1.$3";
    } elsif (/^(group|dept)\.(\w+)$/) {
        return "/afs/.ir/$1/$2";
    } elsif (/^(?:gf\.)?data\.(\S+)$/) {
        my $path = $1;
        $path =~ tr%.%/%;
        return "/afs/.ir/data/$path";
    } else {
        return;
    }
}

# You will probably also need to modify the path to Perl at the top of this
# script.

##############################################################################
# Modules and declarations
##############################################################################

use strict;
use vars qw($DB $ID $FS $VOS);

use Cwd qw(cwd);
use DB_File ();
use Getopt::Long qw(GetOptions);

##############################################################################
# Mount point loading
##############################################################################

# Given a path, make sure it's fully qualified and doesn't contain any invalid
# characters.
sub qualify_path {
    my ($path) = @_;

    # If the path is relative, attempt to fully qualify it.  All paths in
    # the mount point database point to the read/write paths.
    $path = cwd . '/' . $path if ($path !~ m%^/%);
    $path = canonify_path ($path);
    $path =~ s%/+$%%;

    # \ and ' are not allowed in path names because we invoke fs lsmount on
    # the path and can't pass them safely.  ; is not allowed because we use it
    # as a delimiter in the database.
    if ($path =~ /[\\\';]/) {
        die "$0: invalid character in $path\n";
    }
    return $path;
}

# Given a path, return the volume mounted on that path or undef if it does not
# appear to be a mount point (or on any other failure).
sub path_to_volume {
    my ($path) = @_;
    my $volname;
    if ($path eq '/afs') {
        $volname = 'root.afs';
    } elsif ($path =~ m%/afs/\.[^/]+\z%) {
        $volname = 'root.cell';
    } else {
        $volname = `$FS lsmount '$path' 2>&1`;
        my $ismtpt = ($? == 0);
        return unless $ismtpt;
        $volname =~ s/.*a mount point for volume \'\#(\S+)\'\s+$/$1/;
    }
    return $volname;
}

# Given a volume name, path, and reference to the database, enter that into
# the database.  We currently also store the AFS volume ID.
sub store {
    my ($volname, $path, $mtpts) = @_;

    # Obtain the volume ID.
    my $volid;
    open (VOSEXAM, "$VOS examine $volname|")
        or die "$0: can't fork $VOS examine: $!\n";
    while (<VOSEXAM>) {
        if (m/^\Q$volname\E\s*(\d+)\s+RW\s+(\d+)\s+K\s+\S+/) {
            $volid = $1;
        }
    }
    close VOSEXAM;
    die "$0: unable to determine volume ID for $volname\n"
        unless defined $volid;

    # Insert the entry into the database.
    $$mtpts{$volname} = "$path;$volid;y";
}

# Given a volume name and two paths, prompt for the best one for a particular
# volume.  Return true if the user asked for a change, false otherwise.
sub prompt_replace {
    my ($volname, @paths) = @_;
    unless (-t STDIN) {
        print "$volname is already registered with a different path\n";
        return;
    }
    print "\n$volname is already in the database\n\n";
    my $response;
    do {
        print " 1) $paths[0] (new)\n";
        print " 2) $paths[1] (current)\n\n";
        print "Indicate the best path: ";
        $response = <STDIN>;
    } until ($response =~ /^(1|2)$/);
    print "\n";
    return ($response =~ /1/);
}

# Load a single mount point into the database.  Takes the path to the
# directory that we believe is a mount point, a flag saying whether to ask the
# user if this volume already has another entry, a flag saying whether to be
# silent about what we're doing, and the mount point database as a tied hash.
sub load {
    my ($path, $force, $quiet, $mtpts) = @_;

    # Find the fully qualified path and what volume it is a mount point for.
    $path = qualify_path ($path);
    my $volname = path_to_volume ($path);
    die "$0: $path does not appear to be a mount point\n"
        unless defined $volname;

    # Now, see if this volume is already in the database.  If it is, check
    # to see if the current location is valid; if it is, we'll have to give
    # the user a choice.  If it's not, or if this volume isn't already in
    # the database, just insert it.
    if (defined $$mtpts{$volname}) {
        my ($path2, $canonical);
        ($path2) = split (/;/, $$mtpts{$volname});
        my $volname2 = path_to_volume ($path2);
        if ($force || !defined ($volname2) || $volname2 ne $volname) {
            print "REPLACING $volname => $path\n" unless $quiet;
            store ($volname, $path, $mtpts);
        } elsif ($path ne $path2) {
            if (prompt_replace ($volname, $path, $path2)) {
                print "REPLACING $volname => $path\n" unless $quiet;
                store ($volname, $path, $mtpts);
            }
        } else {
            print "$volname => $path already registered\n" unless $quiet;
        }
    } else {
        print "INSERTING $volname => $path\n" unless $quiet;
        store ($volname, $path, $mtpts);
    }
}

# Try to guess the path for a particular mount point and register it if we can
# guess it properly.  If we can't guess or can't find a good path, just warn
# and otherwise skip it.
sub load_guess {
    my ($volume, $force, $quiet, $mtpts) = @_;
    my $path = guess_mount ($volume);
    if (!$path) {
        warn "$0: can't guess mount point for $volume\n";
        return;
    }
    my $guessed = path_to_volume ($path);
    if (!$guessed || $guessed ne $volume) {
        warn "$0: guess $path for $volume didn't work out\n";
        return;
    }
    load ($path, $force, $quiet, $mtpts);
}

##############################################################################
# Main routine
##############################################################################

# Trim extraneous garbage from the path.
my $fullpath = $0;
$0 =~ s%.*/%%;

# Parse command line options.
my ($force, $guess, $help, $quiet, $version);
Getopt::Long::config ('bundling', 'no_ignore_case');
GetOptions ('force|f'   => \$force,
            'guess|g'   => \$guess,
            'help|h'    => \$help,
            'quiet|q'   => \$quiet,
            'version|v' => \$version) or exit 1;
if ($help) {
    print "Feeding myself to perldoc, please wait....\n";
    exec ('perldoc', '-t', $fullpath) or die "$0: cannot fork: $!\n";
} elsif ($version) {
    my $version = join (' ', (split (' ', $ID))[1..3]);
    $version =~ s/,v\b//;
    $version =~ s/(\S+)$/($1)/;
    $version =~ tr%/%-%;
    print $version, "\n";
    exit 0;
}
if (@ARGV < 1) {
    if ($guess) {
        die "Usage: loadmtpt -g [-fq] volume [volume ...]\n";
    } else {
        die "Usage: loadmtpt [-fhqv] path [path ...]\n";
    }
}

# Tie the database file.  Note that we do not do any locking here even though
# we probably should.  See the documentation.
my %mtpts;
tie (%mtpts, 'DB_File', $DB) or die "$0: unable to read $DB: $!\n";

# Process the arguments.
for (@ARGV) {
    if ($guess) {
        load_guess ($_, $force, $quiet, \%mtpts);
    } else {
        load ($_, $force, $quiet, \%mtpts);
    }
}
exit 0;
__END__

##############################################################################
# Documentation
##############################################################################

=head1 NAME

loadmtpt - Insert or update an AFS volume mountpoint into database

=head1 SYNOPSIS

loadmtpt [B<-fhqv>] I<path> [I<path> ...]

loadmtpt B<-g> [B<-fq>] I<volume> [I<volume> ...]

=head1 DESCRIPTION

B<loadmtpt> registers the mount point for an AFS volume in the mount point
database.  It normally takes some number of mount point locations on the
command line and, for each one, makes sure they are actual mount points.  It
then looks up the volume, retrieves the volume ID from AFS, and stores the
mapping into the database.

If that volume already has a mapping, it checks the old path to see if it's
still a valid mount point.  If not, the old mapping is replaced with the new
one.  If it is, the user is prompted to select the most appropriate mapping.

I<path> may be relative, in which case it's transformed into an absolute
path before registering it (using the standard system getcwd() call, so
beware of cases where this produces strange results).  All paths are
canonicalized to take care of variations between read-only path vs.
read/write path, fully-qualified domain name after C</afs> or not, etc.

If given the B<-g> option, B<loadmtpt> instead takes a list of volumes on
the command line and, for each one, attempts to guess the correct mount
point based on rules encoded at the top of this script.  If it can do so
successfully, it loads the mount point using the logic above.  Otherwise, it
prints a warning message and moves to the next volume.

=head1 OPTIONS

=over 4

=item B<-f>, B<--force>

Always update the mapping for a volume to the mount point given on the
command line.  Don't prompt even if the volume already has a valid mount
point listed in the database.

=item B<-g>, B<--guess>

Take the arguments to be volume names instead of paths and try to guess the
appropriate mount point.  See L<DESCRIPTION> for more details.

=item B<-h>, B<--help>

Print out this documentation (which is done simply by feeding the script
to C<perldoc -t>).

=item B<-q>, B<--quiet>

Don't print out any status information about what's being done.  (Error
messages will still be printed.)

=item B<-v>, B<--version>

Print out the version of B<loadmtpt> and exit.

=back

=head1 EXAMPLES

Load the mount point for /afs/.ir/users/r/r/rra:

    loadmtpt /afs/.ir/users/r/r/rra

Load all mount points in the current directory.  Note that this requires
that everything in the current directory be a mount point; B<loadmtpt>
doesn't skip specified paths that aren't mount points, but will instead
abort with an error.

    loadmtpt *

Quietly force /afs/ir/users to be registered as the mount point for its
volume regardless of what's already in the database:

    loadmtpt -qf /afs/ir/users

Try to guess the mount points for user.rra and user.neilc and load them:

    loadmtpt -g user.rra user.neilc

=head1 FILES

=over 4

=item F</afs/ir/service/afs/data/mountpoints/mountpoints.db>

The default location of the mount point database where mount point mappings
are looked up.  This will use whatever database format that the DB_File that
comes with Perl uses.

=back

=head1 BUGS

This program doesn't lock the database, so multiple runs of B<loadmtpt> at
the same time may corrupt it (although in extensive use of this program and
related programs, I've never seen this happen).  The only reason why this
has not yet been done is that B<cleanmtpts> can take hours to run and I want
to be able to run it without locking all other users out of the database in
the meantime.

=head1 SEE ALSO

mtpt(1), cleanmtpts(1)

The current version of this program and the B<mtpt> and B<cleanmtpts>
utilities are available from their web page at
L<http://www.eyrie.org/~eagle/software/afs-mount/>.

=head1 AUTHORS

Neil Crellin <neilc@stanford.edu> and Russ Allbery <rra@stanford.edu>.

=head1 COPYRIGHT AND LICENSE

Copyright 1999, 2004 Board of Trustees, Leland Stanford Jr. University.

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

=cut