path: root/server/wallet-backend

#!/usr/bin/perl
#
# Wallet server for storing and retrieving secure data.

##############################################################################
# Declarations and site configuration
##############################################################################

use strict;

use Getopt::Long qw(GetOptions);
use Sys::Syslog qw(openlog syslog);
use Wallet::Server;

# Set to zero to suppress syslog logging, which is used for testing and for
# the -q option.  Set to a reference to a string to append messages to that
# string instead.
our $SYSLOG;
$SYSLOG = 1 unless defined $SYSLOG;

##############################################################################
# Logging
##############################################################################

# Initialize logging.
sub log_init {
    if (ref $SYSLOG) {
        $$SYSLOG = '';
    } elsif ($SYSLOG) {
        openlog ('wallet-backend', 'pid', 'auth');
    }
}

# Get an identity string for the user suitable for including in log messages.
sub identity {
    my $identity = '';
    if ($ENV{REMOTE_USER}) {
        $identity = $ENV{REMOTE_USER};
        my $host = $ENV{REMOTE_HOST} || $ENV{REMOTE_ADDR};
        $identity .= " ($host)" if $host;
    }
    return $identity;
}

# Log an error message to both syslog and to stderr and exit with a non-zero
# status.
sub error {
    my $message = join ('', @_);
    if ($SYSLOG) {
        my $identity = identity;
        my $log;
        if ($identity) {
            $log = "error for $identity: $message";
        } else {
            $log = "error: $message";
        }
        $log =~ s/[^\x20-\x7e]/_/g;
        if (ref $SYSLOG) {
            $$SYSLOG .= "$log\n";
        } else {
            syslog ('err', "%s", $log);
        }
    }
    die "$message\n";
}

# Log a wallet failure message for a given command to both syslog and to
# stderr and exit with a non-zero status.  Takes the message and the command
# that was being run.
sub failure {
    my ($message, @command) = @_;
    if ($SYSLOG) {
        my $log = "command @command from " . identity . " failed: $message";
        $log =~ s/[^\x20-\x7e]/_/g;
        if (ref $SYSLOG) {
            $$SYSLOG .= "$log\n";
        } else {
            syslog ('err', "%s", $log);
        }
    }
    die "$message\n";
}

# Log a wallet success message for a given command.
sub success {
    my (@command) = @_;
    if ($SYSLOG) {
        my $log = "command @command from " . identity . " succeeded";
        $log =~ s/[^\x20-\x7e]/_/g;
        if (ref $SYSLOG) {
            $$SYSLOG .= "$log\n";
        } else {
            syslog ('info', "%s", $log);
        }
    }
}

##############################################################################
# Parameter checking
##############################################################################

# Check all arguments against a very restricted set of allowed characters and
# to ensure the right number of arguments are taken.  The arguments are the
# number of arguments expected (minimum and maximum), a reference to an array
# of which argument numbers shouldn't be checked, and then the arguments.
#
# This function is probably temporary and will be replaced with something that
# knows more about the syntax of each command and can check more things.
sub check_args {
    my ($min, $max, $exclude, @args) = @_;
    if (@args < $min) {
        error "insufficient arguments";
    } elsif (@args > $max and $max != -1) {
        error "too many arguments";
    }
    my %exclude = map { $_ => 1 } @$exclude;
    for (my $i = 1; $i <= @args; $i++) {
        next if $exclude{$i};
        unless ($args[$i - 1] =~ m,^[\w_/\@.-]*\z,) {
            error "invalid characters in argument: $args[$i - 1]";
        }
    }
}

##############################################################################
# Implementation
##############################################################################

# Parse and execute a command.  We wrap this in a subroutine call for easier
# testing.
sub command {
    log_init;
    my $user = $ENV{REMOTE_USER} or error "REMOTE_USER not set";
    my $host = $ENV{REMOTE_HOST} || $ENV{REMOTE_ADDR}
        or error "neither REMOTE_HOST nor REMOTE_ADDR set";

    # Instantiate the server object.
    my $server = Wallet::Server->new ($user, $host);

    # Parse command-line options and dispatch to the appropriate calls.
    my ($command, @args) = @_;
    if ($command eq 'acl') {
        my $action = shift @args;
        if ($action eq 'add') {
            check_args (3, 3, [3], @args);
            $server->acl_add (@args) or failure ($server->error, @_);
        } elsif ($action eq 'check') {
            check_args (1, 1, [], @args);
            my $status = $server->acl_check (@args);
            if (!defined ($status)) {
                failure ($server->error, @_);
            } else {
                print $status ? "yes\n" : "no\n";
            }
        } elsif ($action eq 'create') {
            check_args (1, 1, [], @args);
            $server->acl_create (@args) or failure ($server->error, @_);
        } elsif ($action eq 'destroy') {
            check_args (1, 1, [], @args);
            $server->acl_destroy (@args) or failure ($server->error, @_);
        } elsif ($action eq 'history') {
            check_args (1, 1, [], @args);
            my $output = $server->acl_history (@args);
            if (defined $output) {
                print $output;
            } else {
                failure ($server->error, @_);
            }
        } elsif ($action eq 'remove') {
            check_args (3, 3, [3], @args);
            $server->acl_remove (@args) or failure ($server->error, @_);
        } elsif ($action eq 'rename') {
            check_args (2, 2, [], @args);
            $server->acl_rename (@args) or failure ($server->error, @_);
        } elsif ($action eq 'show') {
            check_args (1, 1, [], @args);
            my $output = $server->acl_show (@args);
            if (defined $output) {
                print $output;
            } else {
                failure ($server->error, @_);
            }
        } else {
            error "unknown command acl $action";
        }
    } elsif ($command eq 'autocreate') {
        check_args (2, 2, [], @args);
        $server->autocreate (@args) or failure ($server->error, @_);
    } elsif ($command eq 'check') {
        check_args (2, 2, [], @args);
        my $status = $server->check (@args);
        if (!defined ($status)) {
            failure ($server->error, @_);
        } else {
            print $status ? "yes\n" : "no\n";
        }
    } elsif ($command eq 'comment') {
        check_args (2, 3, [], @args);
        if (@args > 2) {
            $server->comment (@args) or failure ($server->error, @_);
        } else {
            my $output = $server->comment (@args);
            if (defined $output) {
                print $output, "\n";
            } elsif (not $server->error) {
                print "No comment set\n";
            } else {
                failure ($server->error, @_);
            }
        }
    } elsif ($command eq 'create') {
        check_args (2, 2, [], @args);
        $server->create (@args) or failure ($server->error, @_);
    } elsif ($command eq 'destroy') {
        check_args (2, 2, [], @args);
        $server->destroy (@args) or failure ($server->error, @_);
    } elsif ($command eq 'expires') {
        check_args (2, 4, [], @args);
        if (@args > 2) {
            $server->expires (@args) or failure ($server->error, @_);
        } else {
            my $output = $server->expires (@args);
            if (defined $output) {
                print $output, "\n";
            } elsif (not $server->error) {
                print "No expiration set\n";
            } else {
                failure ($server->error, @_);
            }
        }
    } elsif ($command eq 'flag') {
        my $action = shift @args;
        check_args (3, 3, [], @args);
        if ($action eq 'clear') {
            $server->flag_clear (@args) or failure ($server->error, @_);
        } elsif ($action eq 'set') {
            $server->flag_set (@args) or failure ($server->error, @_);
        } else {
            error "unknown command flag $action";
        }
    } elsif ($command eq 'get') {
        check_args (2, 2, [], @args);
        my $output = $server->get (@args);
        if (defined $output) {
            print $output;
        } else {
            failure ($server->error, @_);
        }
    } elsif ($command eq 'getacl') {
        check_args (3, 3, [], @args);
        my $output = $server->acl (@args);
        if (defined $output) {
            print $output, "\n";
        } elsif (not $server->error) {
            print "No ACL set\n";
        } else {
            failure ($server->error, @_);
        }
    } elsif ($command eq 'getattr') {
        check_args (3, 3, [], @args);
        my @result = $server->attr (@args);
        if (not @result and $server->error) {
            failure ($server->error, @_);
        } elsif (@result) {
            print join ("\n", @result, '');
        }
    } elsif ($command eq 'history') {
        check_args (2, 2, [], @args);
        my $output = $server->history (@args);
        if (defined $output) {
            print $output;
        } else {
            failure ($server->error, @_);
        }
    } elsif ($command eq 'owner') {
        check_args (2, 3, [], @args);
        if (@args > 2) {
            $server->owner (@args) or failure ($server->error, @_);
        } else {
            my $output = $server->owner (@args);
            if (defined $output) {
                print $output, "\n";
            } elsif (not $server->error) {
                print "No owner set\n";
            } else {
                failure ($server->error, @_);
            }
        }
    } elsif ($command eq 'setacl') {
        check_args (4, 4, [], @args);
        $server->acl (@args) or failure ($server->error, @_);
    } elsif ($command eq 'setattr') {
        check_args (4, -1, [], @args);
        $server->attr (@args) or failure ($server->error, @_);
    } elsif ($command eq 'show') {
        check_args (2, 2, [], @args);
        my $output = $server->show (@args);
        if (defined $output) {
            print $output;
        } else {
            failure ($server->error, @_);
        }
    } elsif ($command eq 'store') {
        check_args (2, 3, [3], @args);
        if (@args == 2) {
            local $/;
            $args[2] = <STDIN>;
        }
        splice (@_, 3);
        $server->store (@args) or failure ($server->error, @_);
    } else {
        error "unknown command $command";
    }
    success (@_);
}

# Parse command-line options.
my ($quiet);
Getopt::Long::config ('require_order');
GetOptions ('q|quiet' => \$quiet) or exit 1;
$SYSLOG = 0 if $quiet;

# Run the command.
command (@ARGV);

__END__

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

# The commands section of this document is duplicated from the documentation
# for wallet and should be kept in sync.

=for stopwords
wallet-backend backend backend-specific remctld ACL acl timestamp getacl
setacl metadata keytab keytabs enctypes enctype ktadd KDC Allbery
autocreate

=head1 NAME

wallet-backend - Wallet server for storing and retrieving secure data

=head1 SYNOPSIS

B<wallet-backend> [B<-q>] I<command> [I<args> ...]

=head1 DESCRIPTION

B<wallet-backend> implements the interface between B<remctld> and the
wallet system.  It is written to run under B<remctld> and expects the
authenticated identity of the remote user in the REMOTE_USER environment
variable.  It uses REMOTE_HOST or REMOTE_ADDR if REMOTE_HOST isn't set for
additional trace information.  It accepts the command from B<remctld> on
the command line, creates a Wallet::Server object, and calls the
appropriate methods.

This program is a fairly thin wrapper around Wallet::Server that
translates command strings into method calls and returns the results.  It
does check all arguments except for the <data> argument to the store
command and rejects any argument not matching C<^[\w_/.-]+\z>; in other
words, only alphanumerics, underscore (C<_>), slash (C</>), period (C<.>),
and hyphen (C<->) are permitted in arguments.  This provides some
additional security over and above the checking already done by the rest
of the wallet code.

=head1 OPTIONS

=over 4

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

If this option is given, B<wallet-backend> will not log its actions to
syslog.

=back

=head1 COMMANDS

Most commands are only available to wallet administrators (users on the
C<ADMIN> ACL).  The exceptions are C<acl check>, C<check>, C<get>,
C<store>, C<show>, C<destroy>, C<flag clear>, C<flag set>, C<getattr>,
C<setattr>, and C<history>.  C<acl check> and C<check> can be run by
anyone.  All of the rest of those commands have their own ACLs except
C<getattr> and C<history>, which use the C<show> ACL, C<setattr>, which
uses the C<store> ACL, and C<comment>, which uses the owner or C<show> ACL
depending on whether one is setting or retrieving the comment.  If the
appropriate ACL is set, it alone is checked to see if the user has access.
Otherwise, C<get>, C<store>, C<show>, C<getattr>, C<setattr>, C<history>,
and C<comment> access is permitted if the user is authorized by the owner
ACL of the object.

Administrators can run any command on any object or ACL except for C<get>
and C<store>.  For C<get> and C<store>, they must still be authorized by
either the appropriate specific ACL or the owner ACL.

If the locked flag is set on an object, no commands can be run on that
object that change data except the C<flags> commands, nor can the C<get>
command be used on that object.  C<show>, C<history>, C<getacl>,
C<getattr>, and C<owner>, C<comment>, or C<expires> without an argument
can still be used on that object.

For more information on attributes, see L<ATTRIBUTES>.

=over 4

=item acl add <id> <scheme> <identifier>

Add an entry with <scheme> and <identifier> to the ACL <id>.  <id> may be
either the name of an ACL or its numeric identifier.

=item acl check <id>

Check whether an ACL with the ID <id> already exists.  If it does, prints
C<yes>; if not, prints C<no>.

=item acl create <name>

Create a new, empty ACL with name <name>.  When setting an ACL on an
object with a set of entries that don't match an existing ACL, first
create a new ACL with C<acl create>, add the appropriate entries to it
with C<acl add>, and then set the ACL on an object with the C<owner> or
C<setacl> commands.

=item acl destroy <id>

Destroy the ACL <id>.  This ACL must no longer be referenced by any object
or the ACL destruction will fail.  The special ACL named C<ADMIN> cannot
be destroyed.

=item acl history <id>

Display the history of the ACL <id>.  Each change to the ACL (not
including changes to the name of the ACL) will be represented by two
lines.  The first line will have a timestamp of the change followed by a
description of the change, and the second line will give the user who made
the change and the host from which the change was made.

=item acl remove <id> <scheme> <identifier>

Remove the entry with <scheme> and <identifier> from the ACL <id>.  <id>
may be either the name of an ACL or its numeric identifier.  The last
entry in the special ACL C<ADMIN> cannot be removed to protect against
accidental lockout, but administrators can remove themselves from the
C<ADMIN> ACL and can leave only a non-functioning entry on the ACL.  Use
caution when removing entries from the C<ADMIN> ACL.

=item acl show <id>

Display the name, numeric ID, and entries of the ACL <id>.

=item autocreate <type> <name>

Create a new object of type <type> with name <name>.  The user must be
listed in the default ACL for an object with that type and name, and the
object will be created with that default ACL set as the object owner.

=item check <type> <name>

Check whether an object of type <type> and name <name> already exists.  If
it does, prints C<yes>; if not, prints C<no>.

=item comment <type> <name> [<comment>]

If <comment> is not given, displays the current comment for the object
identified by <type> and <name>, or C<No comment set> if none is set.

If <comment> is given, sets the comment on the object identified by
<type> and <name> to <comment>.  If <comment> is the empty string, clears
the comment.

=item create <type> <name>

Create a new object of type <type> with name <name>.  With some backends,
this will trigger creation of an entry in an external system as well.
The new object will have no ACLs and no owner set, so usually the
administrator will want to then set an owner with C<owner> so that the
object will be usable.

=item destroy <type> <name>

Destroy the object identified by <type> and <name>.  With some backends,
this will trigger destruction of an object in an external system as well.

=item expires <type> <name> [<date> [<time>]]

If <date> is not given, displays the current expiration of the object
identified by <type> and <name>, or C<No expiration set> if none is set.
The expiration will be displayed in seconds since epoch.

If <date> is given, sets the expiration on the object identified by <type>
and <name> to <date> and (if given) <time>.  <date> must be in the format
C<YYYY-MM-DD> and <time> in the format C<HH:MM:SS>.  If <date> is the
empty string, clears the expiration of the object.

Currently, the expiration of an object is not used.

=item flag clear <type> <name> <flag>

Clears the flag <flag> on the object identified by <type> and <name>.

=item flag set <type> <name> <flag>

Sets the flag <flag> on the object identified by <type> and <name>.
Recognized flags are C<locked>, which prevents all further actions on that
object until the flag is cleared, and C<unchanging>, which tells the
object backend to not generate new data on get but instead return the same
data as previously returned.  The C<unchanging> flag is not meaningful for
objects that do not generate new data on the fly.

=item get <type> <name>

Prints to standard output the data associated with the object identified
by <type> and <name>.  This may trigger generation of new data and
invalidate old data for that object depending on the object type.

=item getacl <type> <name> <acl>

Prints the ACL <acl>, which must be one of C<get>, C<store>, C<show>,
C<destroy>, or C<flags>, for the object identified by <type> and <name>.
Prints C<No ACL set> if that ACL isn't set on that object.  Remember that
if the C<get>, C<store>, or C<show> ACLs aren't set, authorization falls
back to checking the owner ACL.  See the C<owner> command for displaying
or setting it.

=item getattr <type> <name> <attr>

Prints the object attribute <attr> for the object identified by <type> and
<name>.  Attributes are used to store backend-specific information for a
particular object type, and <attr> must be an attribute type known to the
underlying object implementation.  The attribute values, if any, are
printed one per line.  If the attribute is not set on this object, nothing
is printed.

=item history <type> <name>

Displays the history for the object identified by <type> and <name>.  This
human-readable output will have two lines for each action that changes the
object, plus for any get action.  The first line has the timestamp of the
action and the action, and the second line gives the user who performed
the action and the host from which they performed it.

=item owner <type> <name> [<owner>]

If <owner> is not given, displays the current owner ACL of the object
identified by <type> and <name>, or C<No owner set> if none is set.  The
result will be the name of an ACL.

If <owner> is given, sets the owner of the object identified by <type> and
<name> to <owner>.  If <owner> is the empty string, clears the owner of
the object.

=item setacl <type> <name> <acl> <id>

Sets the ACL <acl>, which must be one of C<get>, C<store>, C<show>,
C<destroy>, or C<flags>, to <id> on the object identified by <type> and
<name>.  If <id> is the empty string, clears that ACL on the object.

=item setattr <type> <name> <attr> <value> [<value> ...]

Sets the object attribute <attr> for the object identified by <type> and
<name>.  Attributes are used to store backend-specific information for a
particular object type, and <attr> must be an attribute type known to the
underlying object implementation.  To clear the attribute for this object,
pass in a <value> of the empty string (C<''>).

=item show <type> <name>

Displays the current object metadata for the object identified by <type>
and <name>.  This human-readable output will show the object type and
name, the owner, any specific ACLs set on the object, the expiration if
any, and the user, remote host, and time when the object was created, last
stored, and last downloaded.

=item store <type> <name> [<data>]

Stores <data> for the object identified by <type> and <name> for later
retrieval with C<get>.  Not all object types support this.  If <data> is
not given as an argument, it will be read from standard input.

=back

=head1 ATTRIBUTES

Object attributes store additional properties and configuration
information for objects stored in the wallet.  They are displayed as part
of the object data with C<show>, retrieved with C<getattr>, and set with
C<setattr>.

=head2 Keytab Attributes

Keytab objects support the following attributes:

=over 4

=item enctypes

Restricts the generated keytab to a specific set of encryption types.  The
values of this attribute must be enctype strings recognized by Kerberos
(strings like C<aes256-cts-hmac-sha1-96> or C<des-cbc-crc>).  Note that
the salt should not be included; since the salt is irrelevant for keytab
keys, it will always be set to C<normal> by the wallet.

If this attribute is set, the specified enctype list will be passed to
ktadd when get() is called for that keytab.  If it is not set, the default
set in the KDC will be used.

This attribute is ignored if the C<unchanging> flag is set on a keytab.
Keytabs retrieved with C<unchanging> set will contain all keys present in
the KDC for that Kerberos principal and therefore may contain different
enctypes than those requested by this attribute.

=back

=head1 AUTHOR

Russ Allbery <rra@stanford.edu>

=head1 COPYRIGHT AND LICENSE

Copyright 2007, 2008, 2010, 2011, 2012, 2013 The Board of Trustees of the
Leland Stanford Junior University

Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, sublicense,
and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
DEALINGS IN THE SOFTWARE.

=head1 SEE ALSO

Wallet::Server(3), remctld(8)

This program is part of the wallet system.  The current version is
available from L<http://www.eyrie.org/~eagle/software/wallet/>.

=cut