#!/usr/bin/perl -w
$ID = q$Id: afs-backend,v 1.21 2005-12-22 03:09:33 eagle Exp $;
#
# afs-backend -- sysctl/remctl backend script for AFS maintenance.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2002, 2003, 2005 Board of Trustees, Leland Stanford Jr. University
#
# This program serves as a front end for volcreate and vos release, allowing
# either to be executed with AFS administrative privileges for certain types
# of volumes, provided that the user is on the appropriate ACL.  It implements
# the ACL checking internally since the ACLs depend on the volume being
# created or released; the surrounding sysctl/remctl ACLs should be a merger
# of all users allowed to create or release any volume.

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

# Use the existing K4 admin ticket maintained by kstart.
$ENV{KRBTKFILE} = '/var/run/admin.k4.tgt';

# The ACL file.  The format of this file is an operation (currently either
# create or release), a regular expression surrounded by // matching the
# affected volumes, and then a whitespace-separated list of users who are
# allowed to perform that operation on that volume.
$ACL            = '/db/afsdb/acl/afs-backend';

# The full path to aklog, used to obtain AFS tokens from a Kerberos ticket.
$AKLOG          = '/usr/local/bin/aklog';

# Address to which to mail notification of actions taken.
$ADDRESS        = 'afs-reports' . '@' . 'stanford.edu';

# The local realm, which will be stripped off of principals in REMUSER before
# checking them against the ACL file.
$REALM          = 'stanford.edu';

# Rules for mapping a volume name to a type.  This should be a list of regex
# to volume type pairs.  The resulting type is passed to volcreate.
@RULES          = ([ qr/^(data\.)?gsb\./     => 'gsb'      ],
                   [ qr/^(ls|sweet)\.trip\./ => 'tripwire' ]);

# The full path to various programs that should be used.  $VOLRELEASE is just
# a wrapper around vos release that retries it several times; if you want to
# just call vos release directly, you can change the volrelease sub below.
$VOLCREATE      = '/afs/ir/service/afs/scripts/volcreate';
$VOLNUKE        = '/afs/ir/service/afs/scripts/volnuke';
$VOLRELEASE     = '/afs/ir/service/afs/scripts/volrelease';

# Find the paths to AFS programs on either local disk or in pubsw.
($FS)  = grep { -x $_ } qw(/usr/bin/fs /usr/afsws/bin/fs /usr/pubsw/bin/fs);
$FS  ||= '/usr/afsws/bin/fs';
($PTS) = grep { -x $_ } qw(/usr/bin/pts /usr/pubsw/bin/pts);
$PTS ||= '/usr/pubsw/bin/pts';
($VOS) = grep { -x $_ } qw(/usr/bin/vos /usr/pubsw/bin/vos);
$PTS ||= '/usr/pubsw/bin/vos';

# Transform a K5 principal name to a name used in AFS ACLs and in the ACL file
# for this script.  If you use K5 names everywhere, you can just make this sub
# return its argument.  The following does K5 to K4 name mapping.
sub principal_to_acl ( $ ) {
    my ($principal) = @_;
    $principal =~ s%/([^./]+)\.[^/]*%$1%;
    $principal =~ tr%/%.%;
    $principal =~ s/^host\./rcmd\./;
    return $principal;
}

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

require 5.005;

use strict;
use vars qw($ACL $ADDRESS $AKLOG $FS $ID $PTS $REALM @RULES $VOLCREATE
            $VOLNUKE $VOLRELEASE $VOS);

use AFS::Utils qw(setpag unlog);

##############################################################################
# Reporting
##############################################################################

# Open our e-mail report.  Takes the user who is performing the operation.
sub report_open {
    my ($user) = @_;
    my $from = ($user =~ /\./) ? 'root' : $user;
    my $program = $ENV{REMUSER} ? 'remctl' : 'sysctl';
    my ($sendmail) = grep { -x $_ } qw(/usr/sbin/sendmail /usr/lib/sendmail);
    $sendmail ||= '/usr/lib/sendmail';
    open (MAIL, "|$sendmail -oi -oem $ADDRESS")
        or die "$0: cannot fork $sendmail: $!\n";
    print MAIL "To: $ADDRESS\n";
    print MAIL "From: $from\@$REALM ($user by way of $program)\n";
}

# Finish our e-mail report.  Takes a subject header, a status flag indicating
# whether the operation succeeded, and then a list of body lines for the
# message.  Also prints the command output to stdout.
sub report {
    my ($subject, $status, @output) = @_;
    if (!$status) {
        $subject = "FAIL: $subject";
    }
    print MAIL "Subject: $subject\n\n";
    print MAIL "Command output:\n\n", @output;
    close MAIL;
    print @output;
}

# Report a fatal error after we've already started sending a report.  Takes
# the subject to use for the error message and then the actual error message,
# sends the e-mail, and then dies with that second error message.
sub error {
    my ($subject, $error) = @_;
    print MAIL "Subject: ERROR: $subject\n\n";
    print MAIL $error, "\n";
    close MAIL;
    die $error, "\n";
}

##############################################################################
# ACL checking
##############################################################################

# Given a PTS group, expand it out into its members.
sub pts_expand {
    my ($group) = @_;
    my @output = `$PTS membership '$group' -noauth`;
    if ($? != 0) {
        warn "$0: $PTS membership on $group failed\n";
        return;
    } else {
        shift @output;
        for (@output) {
            s/^\s*//;
            s/\s*$//;
        }
        return @output;
    }
}

# Given an operation, a volume name, and the user attempting to perform it,
# return true if that user is authorized and false otherwise.
sub acl_check {
    my ($operation, $volume, $user) = @_;
    open ACL or die "$0: cannot open $ACL: $!\n";
    local $_;
    while (<ACL>) {
        next if /^\s*\#/;
        next if /^\s*$/;
        my @acl = split;
        next unless $operation eq $acl[0];
        my $regex = $acl[1];
        if ($regex =~ s%^/(.*)/\z%$1%) {
            next unless ($volume =~ /$regex/);
        } else {
            next unless ($volume eq $regex);
        }
        my %users = map { $_ => 1 }
            map { /:/ ? pts_expand ($_) : ($_) } @acl[2..$#acl];
        next unless $users{$user};
        close ACL;
        return 1;
    }
    close ACL;
    return 0;
}

##############################################################################
# AFS operations
##############################################################################

# Given a mount point, get the volume name of the volume mounted there.
sub mount_to_name {
    my $path = shift;
    if ($path =~ /[\'\\]/) {
        die "$0: invalid characters in path: $path";
    }
    my $volume = `$FS lsmount '$path'`;
    if ($volume =~ /^\S+ is a mount point for volume \'\#(\S+)\'$/) {
        return $1;
    } else {
        return;
    }
}

# Run a given command passed as an array using runauth, reporting the output
# from that command.  Returns true if the command succeeds and false if it
# fails.
sub run_command {
    my ($subject, @command) = @_;
    my (@output, $status);
    my $pid = open (OUT, '-|');
    if (!defined $pid) {
        error ('unable to fork', "$0: unable to fork: $!");
    } elsif ($pid == 0) {
        open (STDERR, '>&STDOUT')
            or error ('cannot dup', "$0: cannot dup stdout: $!");
        exec @command
            or error ("cannot exec $command[0]",
                      "$0: cannot exec $command[0]: $!");
    } else {
        @output = <OUT>;
        waitpid ($pid, 0);
        $status = $?;
        close OUT;
    }
    report ($subject, ($status == 0), @output);
    return ($status == 0);
}

# Set the quota of a volume to the given amount.  The quota value should be in
# megabytes (actually, 1000KB) and should be no more than 4MB.
sub setquota ( $$$ ) {
    my ($volume, $quota, $user) = @_;
    die "$0: quota value may be no more than 4000 (MB)\n" if ($quota > 4000);
    return run_command ("$volume quota set to $quota by $user",
                        $VOS, 'setfields', '-id', $volume, '-maxquota',
                        $quota * 1000);
}

# Release the given volume, also taking the user doing the release.  Returns
# true if the volume release succeeded and false if it fails.
sub volrelease ( $$ ) {
    my ($volume, $user) = @_;
    return run_command ("$volume released by $user",
                        $VOLRELEASE, $volume);
}

# Create the given volume with the given quota and mount point, also taking
# the user doing the volume creation.  Determines the volume type from the
# name of the volume and bails out if it can't figure it out.
sub volcreate ( $$$$ ) {
    my ($volume, $quota, $mount, $user) = @_;
    my $type;
    for (@RULES) {
        my ($regex, $result) = @$_;
        $type = $result if ($volume =~ /$regex/);
    }
    unless ($type) {
        error ("unknown volume type",
               "$0: cannot map $volume to a volume type");
    }
    return run_command ("$volume created by $user",
                        $VOLCREATE, '-t', $type, $volume, $quota, $mount);
}

# Delete the given volume.  Takes the volume name and user.  If the volume
# name is actually a path, discover the volume from that path and remove the
# mount point at the same time.
sub volnuke ( $$$ ) {
    my ($volume, $path, $user) = @_;
    my @args = ('-F');
    if ($path) {
        push (@args, '-m', $path);
    } else {
        push (@args, $volume);
    }
    return run_command ("$volume deleted by $user", $VOLNUKE, @args);
}

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

# Get the authenticated user from sysctl/remctl.  The sysctl code is here just
# for backward compatibility.
my $user;
if ($ENV{SCUSER}) {
    $user = $ENV{SCUSER};
} elsif ($ENV{REMUSER}) {
    $user = $ENV{REMUSER};
    unless ($user =~ s/\@\Q$REALM\E$//) {
        die "$0: user principal is not in $REALM realm\n";
    }
    $user = principal_to_acl ($user);
} else {
    die "$0: must be run from sysctl or remctl (REMUSER not set)\n";
}

# Acquire an AFS token.
setpag or die "$0: unable to setpag: $!\n";
system ($AKLOG) == 0 or die "$0: unable to obtain tokens\n";

# Parse the command line.
my $action = shift;
if ($action eq 'help') {
    print "  afs create <volume> <quota> <mount>\n";
    print "  afs delete [<mountpoint> | <volume>]\n";
    print "  afs quota <volume> <quota>\n";
    print "  afs release <volume>\n";
    exit 0;
} elsif ($action eq 'create') {
    my ($volume, $quota, $mount) = @ARGV;
    unless ($mount) {
        die "$0: volume name, quota, and mount point must be given\n";
    }
    acl_check ('create', $volume, $user)
        or die "$0: permission denied for $user to create $volume\n";
    report_open ($user);
    exit (volcreate ($volume, $quota, $mount, $user) ? 0 : 1);
} elsif ($action eq 'delete') {
    my ($volume) = @ARGV;
    unless ($volume) { die "$0: volume name must be given\n" }
    my $path;
    if ($volume =~ m%^/%) {
        $path = $volume;
        $volume = mount_to_name ($path)
            or die "$0: $path is not a mount point";
    }
    acl_check ('delete', $volume, $user)
        or die "$0: permission denied for $user to delete $volume\n";
    report_open ($user);
    exit (volnuke ($volume, $path, $user) ? 0 : 1);
} elsif ($action eq 'release') {
    my ($volume) = @ARGV;
    unless ($volume) { die "$0: volume name must be given\n" }
    acl_check ('release', $volume, $user)
        or die "$0: permission denied for $user to release $volume\n";
    report_open ($user);
    exit (volrelease ($volume, $user) ? 0 : 1);
} elsif ($action eq 'quota') {
    my ($volume, $quota) = @ARGV;
    unless ($quota) { die "$0: volume name and quota must be given\n"; }
    acl_check ('quota', $volume, $user)
        or die "$0: permission denied for $user to set quota for $volume\n";
    report_open ($user);
    exit (setquota ($volume, $quota, $user) ? 0 : 1);
} else {
    die "$0: unknown operation $action\n";
}

# Remove our AFS token just to be tidy.
unlog;

__END__

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

=head1 NAME

afs-backend - sysctl/remctl backend script for AFS maintenance

=head1 SYNOPSIS

B<afs-backend> release I<volume>

B<afs-backend> create I<volume> I<quota> I<mount>

B<afs-backend> delete I<volume>

B<afs-backend> quota I<volume> I<quota>

=head1 REQUIREMENTS

Either B<sysctl> or B<remctl> is required to run this script.  Any new
installation should use B<remctl>.  The AFS commands B<fs>, B<pts>, and
B<vos> are required, as are B<volcreate> and B<volnuke> for volume creation
and deletion.  By default, a B<volrelease> wrapper is used to release
volumes; this can be replaced in the script with a call to C<vos release> if
desired.

B<afs-backend> by default uses an existing K4 ticket cache and runs B<aklog>
to obtain AFS tokens.  Set KRB5CCNAME at the top of the script if you use K5
instead of K4.  B<kstart> is recommended as a program to maintain the ticket
cache.

Be sure to update the reporting address, realm, and volume type mapping at
the top of this script for your cell, and change the principal mapping if
you don't use K4 principal names in AFS.

=head1 DESCRIPTION

This script is intended to be run from sysctl or remctl to perform various
AFS administrative commands that should be restricted by ACL.  It's intended
to allow specific people to perform actions that would normally require AFS
administrative access, but only for particular volumes and possibly with
other constraints.

Currently, it supports four operations, C<release> to release an AFS volume
(which takes only the name of the volume), C<create> to create an AFS volume,
which takes the volume name, the quota (in MB), and the mount point (which
should begin with F</afs/.ir>), C<delete> to delete a volume (taking only
the name of the volume), and C<quota> to set the quota on a volume to the
provided value (in MB).

All actions are checked against an ACL file.  Blank lines and lines
beginning with C<#> in this file are ignored, and all other lines should
have one of the following two syntaxes:

    <action> <volume>  <user> [<user> ...]
    <action> /<regex>/ <user> [<user> ...]

where <action> is C<create>, C<release>, C<delete>, or C<quota>, <volume> is
the name of a volume, <regex> is a regular expression matching a set of
volumes to which that line applies (regular expressions must be surrounded
by //), and <user> is either a Kerberos identity for a particular user or is
the name of a PTS group (distinguished from a regular user by the fact that
only PTS group names containing colons are supported).  If a PTS group is
given, any user who is a member of that PTS group will be granted access.
If a Kerberos identity is given, it should be the Kerberos v4 identity for
the user (so rcmd.host instead of host/host.stanford.edu) unless the
configuration is changed at the top of this script.

If the action is C<create>, B<afs-backend> maps the volume name to a volume
type using rules that are currently contained in this script.  If new types
of volumes are added, new mapping rules from volume names to types may have
to be added to the configuration at the top of this script so that
B<afs-backend> can pass the appropriate volume type to B<volcreate>.  This
script currently cannot handle creation of replicated volumes.

If the action is C<delete>, <volume> doesn't have to be a volume name.  If
instead it begins with C</>, it is taken to be a mount point and the volume
to remove is determined by that mount point.  In this case, the mount point
will also be removed when the volume is removed.

An action of C<help> is also supported and just prints out the available
commands.  This action isn't checked against the ACL.

B<afs-backend> retrieves the user identity from the environment variable
SCUSER or REMUSER, which is set by sysctl or remctl respectively.  It
reports the output from the command that it runs to both stdout and via
e-mail to afs-reports at stanford.edu (configured at the beginning of this
script).  If the operation failed, the Subject header of that e-mail will
begin with FAIL.  If some unexpected error occurred, the Subject header of
that e-mail will begin with ERROR.

=head1 EXAMPLES

Release ls.tripwire:

    afs-backend release ls.tripwire

Create a new volume named ls.trip.example with a quota of 10MB (or,
actually, 10,000KB, fitting the somewhat odd quota standard that we use at
Stanford) and mounted at /afs/.ir/site/leland/tripwire/example.Stanford.EDU:

    afs-backend create ls.trip.example 10 \
        /afs/.ir/site/leland/tripwire/example.Stanford.EDU

Delete a volume named ls.trip.example:

    afs-backend delete ls.trip.example

(note that the mount point still must be removed separately).

Set the quota on ls.trip.example to 20MB (actually 20,000 KB):

    afs-backend quota ls.trip.example 20

B<afs-backend> should normally never be run directly, only via sysctl or
remctl.  If it must be run directly for some reason, the environment
variable SCUSER or REMUSER must be set to the authenticated user.

=head1 ENVIRONMENT

=over 4

=item REMUSER

Expected to contain the authenticated Kerberos identity of the user running
this script via remctl, ending in @ and the realm.

=item SCUSER

Expected to contain the authenticated Kerberos identity of the user running
this script via sysctl, without the realm (just the principal portion of the
identity).

=back

=head1 FILES

=over 4

=item F</afs/ir/service/afs/scripts/volcreate>

The expected location of the B<volcreate> script, which is used to create
volumes.  A B<-t> option is passed to it indicating the volume type, which
is determined by B<afs-backend> from the name of the volume.  The volume
name, quota, and mount point are taken from the arguments to B<afs-backend>,
and no additional ACLs are passed in.  B<volcreate> is expected to handle
the ACLs itself.

=item F</afs/ir/service/afs/scripts/volrelease>

The expected location of the B<volrelease> script, used to release volumes.
This script automatically passes the right arguments to C<vos release> and
retries on failure for a set number of times.

=item F</afs/ir/service/afs/scripts/volnuke>

The expected location of the B<volnuke> script, which is used to delete
volumes.  If the supplied volume is actually a mount point, this script is
called with the B<-m> option.  The B<-F> option is always used to force
non-interactive operation.

=item F</db/afsdb/acl/afs-backend>

The expected location of the ACL file describing which users have which
volume release and creation permissions, as described in L<DESCRIPTION>
above.

=item F</usr/local/bin/aklog>

The path to the program to run to obtain AFS tokens from a ticket cache.

=item F</var/run/admin.k4.tgt>

The expected path to a K4 ticket cache for an identity that has the ability
to create, release, and remove AFS volumes and set volume quota.  It should
be in both system:administrators and in F<UserList> on the AFS servers.

=back

B<fs>, B<pts>, and B<vos> are searched for in F</usr/bin>, then in
F</usr/afsws/bin> for B<fs>, and then in F</usr/pubsw/bin>.

=head1 AUTHOR

Russ Allbery <rra@stanford.edu>

=head1 COPYRIGHT AND LICENSE

Copyright 2002, 2003, 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.

=head1 SEE ALSO

k4start(1), k5start(1), pts(1), sysctl(1), sysctld(8), volcreate(1),
volnuke(1), vos(1)

The current version of this program is available from its web page at
L<http://www.eyrie.org/~eagle/software/afs-backend/>.

B<volcreate> and B<volnuke> can be obtained from their web pages at
L<http://www.eyrie.org/~eagle/software/volcreate/> and
L<http://www.eyrie.org/~eagle/software/volnuke/> respectively.  B<remctl> is
available at L<http://www.eyrie.org/~eagle/software/remctl/>.

B<kstart> (either B<k4start> or B<k5start>) is recommended for maintaining a
ticket cache.  It can be obtained from its web page at
L<http://www.eyrie.org/~eagle/software/kstart/>.

=cut