diff options
| -rw-r--r-- | perl/Wallet/ACL.pm | 66 |
1 files changed, 42 insertions, 24 deletions
diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm index 5b8dc86..bbab03d 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/Wallet/ACL.pm @@ -43,23 +43,22 @@ sub new { $dbh->{AutoCommit} = 0; $dbh->{RaiseError} = 1; $dbh->{PrintError} = 0; - my ($sql, $data); + my ($sql, $data, $name); if ($id =~ /^\d+\z/) { - $sql = 'select ac_id from acls where ac_id = ?'; + $sql = 'select ac_id, ac_name from acls where ac_id = ?'; } else { - $sql = 'select ac_id from acls where ac_name = ?'; + $sql = 'select ac_id, ac_name from acls where ac_name = ?'; } - eval { - $data = $dbh->selectrow_array ($sql, undef, $id); - }; + ($data, $name) = eval { $dbh->selectrow_array ($sql, undef, $id) }; if ($@) { die "cannot search for ACL $id: $@\n"; } elsif (not defined $data) { die "ACL $id not found\n"; } my $self = { - dbh => $dbh, - id => $data, + dbh => $dbh, + id => $data, + name => $name, }; bless ($self, $class); return $self; @@ -90,8 +89,9 @@ sub create { die "cannot create ACL $name: $@\n"; } my $self = { - dbh => $dbh, - id => $id, + dbh => $dbh, + id => $id, + name => $name, }; bless ($self, $class); return $self; @@ -113,6 +113,12 @@ sub id { return $self->{id}; } +# Returns the name of the ACL. +sub name { + my ($self)= @_; + return $self->{name}; +} + # Record a change to an ACL. Takes the type of change, the scheme and # identifier of the entry, and the trace information (user, host, and time). # This function does not commit and does not catch exceptions. It should @@ -234,23 +240,17 @@ sub remove { # ACL checking ############################################################################## -# Given a principal, check whether it should be granted access according to -# this ACL. Returns 1 if access was granted, 0 if access was denied, and -# undef on some error. Errors from ACL verifiers do not cause an error -# return, but are instead accumulated in the check_errors variable returned by -# the check_errors() method. -# -# This routine is currently rather inefficient when it comes to instantiating -# verifier objects. They're created anew for each check. Ideally, we should -# globally cache verifiers in some way. -sub check { - my ($self, $principal) = @_; - my (%verifier, @entries); +# List all of the entries in an ACL. Returns an array of tuples, each of +# which contains a scheme and identifier, or an array containing undef on +# error. Sets the internal error string on error. +sub list { + my ($self) = @_; + my @entries; eval { my $sql = 'select ae_scheme, ae_identifier from acl_entries where ae_id = ?'; my $sth = $self->{dbh}->prepare ($sql); - $sth->execute; + $sth->execute ($self->{id}); my $entry; while (defined ($entry = $sth->fetchrow_arrayref)) { push (@entries, $entry); @@ -258,8 +258,26 @@ sub check { }; if ($@) { $self->{error} = "cannot retrieve ACL $self->{id}: $@"; - return undef; + return (undef); + } else { + return @entries; } +} + +# Given a principal, check whether it should be granted access according to +# this ACL. Returns 1 if access was granted, 0 if access was denied, and +# undef on some error. Errors from ACL verifiers do not cause an error +# return, but are instead accumulated in the check_errors variable returned by +# the check_errors() method. +# +# This routine is currently rather inefficient when it comes to instantiating +# verifier objects. They're created anew for each check. Ideally, we should +# globally cache verifiers in some way. +sub check { + my ($self, $principal) = @_; + my @entries = $self->list; + return undef if (@entries == 1 and not defined $entries[0]); + my %verifier; $self->{check_errors} = []; for my $entry (@entries) { my ($scheme, $identifier) = @$entry; |