path: root/server/wallet-backend

#!/usr/bin/perl
our $ID = q$Id$;
#
# wallet-backend -- Wallet server for storing and retrieving secure data.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2007 Board of Trustees, Leland Stanford Jr. University
#
# See README for licensing terms.

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

use strict;
use DBI;
use Sys::Syslog qw(openlog syslog);
use Wallet::Config;
use Wallet::Server;

##############################################################################
# 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, 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 ($count, $exclude, @args) = @_;
    if (@args < $count) {
        die "insufficient arguments\n";
    } elsif (@args > $count) {
        die "too many arguments\n";
    }
    my %exclude = map { $_ => 1 } @$exclude;
    for (my $i = 1; $i <= @args; $i++) {
        next if $exclude{$i};
        unless ($args[$i - 1] =~ m,^[\w_/.-]+\z,) {
            die "invalid characters in argument: $args[$i - 1]\n";
        }
    }
}

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

# Separately log our actions.  remctl keeps some logs and we store extensive
# logs of successful actions in the database, but neither logs failed actions.
openlog ('wallet-backend', 'pid', 'auth');

# Get our trace information.
my $user = $ENV{REMOTE_USER} or die "REMOTE_USER not set\n";
my $host = $ENV{REMOTE_HOST} || $ENV{REMOTE_ADDR}
    or die "Neither REMOTE_HOST nor REMOTE_USER set\n";

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

# Parse command-line options and dispatch to the appropriate calls.
my ($command, @args) = @ARGV;
if ($command eq 'acl') {
    my $action = shift @args;
    if ($action eq 'add') {
        check_args (3, [], @args);
        $server->acl_add (@args) or die $server->error;
    } elsif ($action eq 'create') {
        check_args (1, [], @args);
        $server->acl_create (@args) or die $server->error;
    } elsif ($action eq 'destroy') {
        check_args (1, [], @args);
        $server->acl_destroy (@args) or die $server->error;
    } elsif ($action eq 'remove') {
        check_args (3, [], @args);
        $server->acl_remove (@args) or die $server->error;
    } elsif ($action eq 'rename') {
        check_args (2, [], @args);
        $server->acl_rename (@args) or die $server->error;
    } else {
        die "unknown command acl $action\n";
    }
} elsif ($command eq 'create') {
    check_args (2, [], @args);
    $server->create (@args) or die $server->error;
} elsif ($command eq 'destroy') {
    check_args (2, [], @args);
    $server->destroy (@args) or die $server->error;
} elsif ($command eq 'expires') {
    if (@args > 2) {
        check_args (3, [], @args);
        $server->expires (@args) or die $server->error;
    } else {
        check_args (2, [], @args);
        my $output = $server->expires (@args);
        if (defined $output) {
            print $output, "\n";
        } elsif (not $server->error) {
            print "No expiration set\n";
        } else {
            die $server->error;
        }
    }
} elsif ($command eq 'get') {
    check_args (2, [], @args);
    my $output = $server->get (@args);
    if (defined $output) {
        print $output;
    } else {
        die $server->error;
    }
} elsif ($command eq 'getacl') {
    check_args (3, [], @args);
    my $output = $server->acl (@args);
    if (defined $output) {
        print $output, "\n";
    } elsif (not $server->error) {
        print "No ACL set\n";
    } else {
        die $server->error;
    }
} elsif ($command eq 'owner') {
    if (@args > 2) {
        check_args (3, [], @args);
        $server->owner (@args) or die $server->error;
    } else {
        check_args (2, [], @args);
        my $output = $server->owner (@args);
        if (defined $output) {
            print $output, "\n";
        } elsif (not $server->error) {
            print "No owner set\n";
        } else {
            die $server->error;
        }
    }
} elsif ($command eq 'setacl') {
    check_args (4, [], @args);
    $server->acl (@args) or die $server->error;
} elsif ($command eq 'show') {
    check_args (2, [], @args);
    my $output = $server->show (@args);
    if (defined $output) {
        print $output;
    } else {
        die $server->error;
    }
} elsif ($command eq 'store') {
    check_args (3, [2], @args);
    $server->store (@args) or die $server->error;
} else {
    die "unknown command $command\n";
}
exit 0;
__END__

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

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

=head1 NAME

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

=head1 SYNOPSIS

B<wallet-backend> 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

B<wallet-backend> takes no traditional options.

=head1 COMMANDS

Most commands are only available to wallet administrators (users on the
C<ADMIN> ACL).  The exceptions are C<get>, C<store>, C<show>, and
C<destroy>.  All of those commands have their own ACLs, and if the
appropriate ACL is set, it alone is checked to see if the user has access.
Otherwise, C<get>, C<store>, and C<show> 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<show>, they must still be authorized by
either the appropriate specific ACL or the owner ACL.

=over 4

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

Adds 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 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 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 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> [<expires>]

If <expires> 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 <expires> is given, sets the expiration on the object identified by
<type> and <name> to <expires>.  <expires> should be given in seconds
since epoch.  If <expires> is the empty string, clears the expiration of
the object.

Currently, the expiration of an object is not used.

=item get <type> <output>

Prints to standard output the data associated with the object identified
by <type> and <name>, or stores it in a file if the B<-f> option was
given.  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 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 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.

Currently, <data> is limited to not containing nul characters and may
therefore not be binary data, and is limited by the maximum command line
length of the operating system of the wallet server.  These restrictions
will be lifted in the future.

=back

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

=head1 AUTHOR

Russ Allbery <rra@stanford.edu>

=cut