diff options
Diffstat (limited to 'perl/Wallet/Server.pm')
| -rw-r--r-- | perl/Wallet/Server.pm | 194 |
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}); +} |