Checkpoint. The object manipulation functions are here, as are the ACL

verification pieces.

1 files changed, 194 insertions, 0 deletions

diff --git a/perl/Wallet/Server.pm b/perl/Wallet/Server.pm
new file mode 100644
index 0000000..549e5dd
--- /dev/null
+++ b/perl/Wallet/Server.pm
@@ -0,0 +1,194 @@
+# Wallet::Server -- Wallet system server implementation.
+# $Id$
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2007 Board of Trustees, Leland Stanford Jr. University
+#
+# See README for licensing terms.
+
+##############################################################################
+# Modules and declarations
+##############################################################################
+
+package Wallet::Server;
+require 5.006;
+
+use strict;
+use vars qw(%MAPPING $VERSION);
+
+use Wallet::ACL;
+use Wallet::Object::Keytab;
+
+# This version should be increased on any code change to this module.  Always
+# use two digits for the minor version with a leading zero if necessary so
+# that it will sort properly.
+$VERSION = '0.01';
+
+# This is a mapping of object types to class names, used to determine which
+# object implementation should be instantiated for a given object type.
+# Currently, there's no dynamic way to recognize new object types, so if you
+# extend the wallet system to add new object types, you need to modify this
+# list.
+%MAPPING = (keytab => 'Wallet::Object::Keytab');
+
+##############################################################################
+# Utility functions
+##############################################################################
+
+# Create a new wallet server object.  A new server should be created for each
+# user who is making changes to the wallet.  Takes the database handle that
+# will be used for all of the wallet metadata and the principal and host who
+# are sending wallet requests.  We also instantiate the administrative ACL,
+# which we'll use for various things.  Throw an exception if anything goes
+# wrong.
+sub new {
+    my ($class, $dbh, $user, $host) = @_;
+    my $acl = Wallet::ACL->new ('ADMIN');
+    my $self = {
+        dbh   => $dbh,
+        user  => $user,
+        host  => $host,
+        admin => $acl,
+    };
+    bless ($self, $class);
+    return $self;
+}
+
+# Returns the error from the previous failed operation.
+sub error {
+    my ($self) = @_;
+    return $self->{error};
+}
+
+##############################################################################
+# Object functions
+##############################################################################
+
+# Create a new object and returns that object.  On error, returns undef and
+# sets the internal error.
+#
+# For the time being, we hard-code an ACL named ADMIN to use to authorize
+# object creation.  This needs more work later.
+sub create {
+    my ($self, $name, $type) = @_;
+    unless ($MAPPING{$type}) {
+        $self->{error} = "unknown object type $type";
+        return undef;
+    }
+    my $class = $MAPPING{$type};
+    my $dbh = $self->{dbh};
+    my $user = $self->{user};
+    my $host = $self->{host};
+    unless ($self->{admin}->check ($user)) {
+        $self->{error} = "$user not authorized to create ${type}:${name}";
+        return undef;
+    }
+    my $object = eval { $class->create ($name, $type, $dbh, $user, $host) };
+    if ($@) {
+        $self->{error} = $@;
+        return undef;
+    } else {
+        return $object;
+    }
+}
+
+# Given the name and type of an object, returns a Perl object representing it
+# or returns undef and sets the internal error.
+sub retrieve {
+    my ($self, $name, $type) = @_;
+    unless ($MAPPING{$type}) {
+        $self->{error} = "unknown object type $type";
+        return undef;
+    }
+    my $class = $MAPPING{$type};
+    my $object = eval { $class->new ($name, $type, $self->{dbh}) };
+    if ($@) {
+        $self->{error} = $@;
+        return undef;
+    } else {
+        return $object;
+    }
+}
+
+# Given an object and an action, checks if the current user has access to
+# perform that object.  If so, returns true.  If not, returns undef and sets
+# the internal error message.
+sub acl_check {
+    my ($self, $object, $action) = @_;
+    unless ($action =~ /^(get|store|show|destroy|flags)\z/) {
+        $self->{error} = "unknown action $action";
+        return undef;
+    }
+    return 1 if $self->{admin}->check ($self->{user});
+    my $id = $object->acl ($action);
+    if (not defined $id && $action =~ /^(get|store|show)\z/) {
+        $id = $object->owner;
+    }
+    unless (defined $id) {
+        my $user = $self->{user};
+        my $id = $object->type . ':' . $object->name;
+        $action = 'set flags on' if $action eq 'flags';
+        $self->{error} = "$self->{user} not authorized to $action $id";
+        return undef;
+    }
+    my $acl = eval { Wallet::ACL->new ($id) };
+    if ($@) {
+        $self->{error} = $@;
+        return undef;
+    }
+    my $status = $acl->check ($self->{user});
+    if ($status == 1) {
+        return 1;
+    } elsif (not defined $status) {
+        $self->{error} = $acl->error;
+        return undef;
+    } else {
+        my $user = $self->{user};
+        my $id = $object->type . ':' . $object->name;
+        $action = 'set flags on' if $action eq 'flags';
+        $self->{error} = "$self->{user} not authorized to $action $id";
+        return undef;
+    }
+}
+
+# Retrieve the information associated with an object, or returns undef and
+# sets the internal error if the retrieval fails or if the user isn't
+# authorized.
+sub get {
+    my ($self, $name, $type) = @_;
+    my $object = $self->retrieve ($name, $type);
+    return undef unless defined $object;
+    return undef unless $self->acl_check ($object, 'get');
+    return $object->get ($self->{user}, $self->{host});
+}
+
+# Store new data in an object, or returns undef and sets the internal error if
+# the object can't be found or if the user isn't authorized.
+sub store {
+    my ($self, $name, $type) = @_;
+    my $object = $self->retrieve ($name, $type);
+    return undef unless defined $object;
+    return undef unless $self->acl_check ($object, 'store');
+    return $object->get ($self->{user}, $self->{host});
+}
+
+# Return a human-readable description of the object's metadata, or returns
+# undef and sets the internal error if the object can't be found or if the
+# user isn't authorized.
+sub show {
+    my ($self, $name, $type) = @_;
+    my $object = $self->retrieve ($name, $type);
+    return undef unless defined $object;
+    return undef unless $self->acl_check ($object, 'show');
+    return $object->show;
+}
+
+# Destroys the object, or returns undef and sets the internal error if the
+# object can't be found or if the user isn't authorized.
+sub destroy {
+    my ($self, $name, $type) = @_;
+    my $object = $self->retrieve ($name, $type);
+    return undef unless defined $object;
+    return undef unless $self->{admin}->check ($self->{user});
+    return $object->destroy ($self->{user}, $self->{host});
+}