aboutsummaryrefslogtreecommitdiff
path: root/perl/lib/Wallet/ACL.pm
diff options
context:
space:
mode:
Diffstat (limited to 'perl/lib/Wallet/ACL.pm')
-rw-r--r--perl/lib/Wallet/ACL.pm126
1 files changed, 100 insertions, 26 deletions
diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm
index a3b0146..ad0eb2c 100644
--- a/perl/lib/Wallet/ACL.pm
+++ b/perl/lib/Wallet/ACL.pm
@@ -1,7 +1,8 @@
-# Wallet::ACL -- Implementation of ACLs in the wallet system.
+# Wallet::ACL -- Implementation of ACLs in the wallet system
#
# Written by Russ Allbery <eagle@eyrie.org>
-# Copyright 2007, 2008, 2010, 2013, 2014
+# Copyright 2016 Russ Allbery <eagle@eyrie.org>
+# Copyright 2007, 2008, 2010, 2013, 2014, 2015
# The Board of Trustees of the Leland Stanford Junior University
#
# See LICENSE for licensing terms.
@@ -11,19 +12,15 @@
##############################################################################
package Wallet::ACL;
-require 5.006;
+use 5.008;
use strict;
use warnings;
-use vars qw($VERSION);
use DateTime;
-use DBI;
+use Wallet::Object::Base;
-# 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.08';
+our $VERSION = '1.03';
##############################################################################
# Constructors
@@ -197,16 +194,55 @@ sub rename {
$acls->ac_name ($name);
$acls->update;
$self->log_acl ('rename', undef, undef, $user, $host, $time);
+
+ # Find any references to this being used as a nested verifier and
+ # update the name. This really breaks out of the normal flow, but
+ # it's hard to do otherwise.
+ %search = (ae_scheme => 'nested',
+ ae_identifier => $self->{name},
+ );
+ my @entries = $self->{schema}->resultset('AclEntry')->search(\%search);
+ for my $entry (@entries) {
+ $entry->ae_identifier ($name);
+ $entry->update;
+ }
+
$guard->commit;
};
if ($@) {
- $self->error ("cannot rename ACL $self->{id} to $name: $@");
+ $self->error ("cannot rename ACL $self->{name} to $name: $@");
return;
}
$self->{name} = $name;
return 1;
}
+# Moves everything owned by one ACL to instead be owned by another. You'll
+# normally want to use rename, but this exists for cases where the replacing
+# ACL already exists and has things assigned to it. Returns true on success,
+# false on failure.
+sub replace {
+ my ($self, $replace_id, $user, $host, $time) = @_;
+ $time ||= time;
+
+ my %search = (ob_owner => $self->{id});
+ my @objects = $self->{schema}->resultset('Object')->search (\%search);
+ if (@objects) {
+ for my $object (@objects) {
+ my $type = $object->ob_type;
+ my $name = $object->ob_name;
+ my $object = eval {
+ Wallet::Object::Base->new($type, $name, $self->{schema});
+ };
+ $object->owner ($replace_id, $user, $host, $time);
+ }
+ } else {
+ $self->error ("no objects found for ACL $self->{name}");
+ return;
+ }
+ return 1;
+}
+
# Destroy the ACL, deleting it out of the database. Returns true on success,
# false on failure.
#
@@ -233,8 +269,20 @@ sub destroy {
die "ACL in use by ".$entry->ob_type.":".$entry->ob_name;
}
+ # Also make certain the ACL isn't being nested in another.
+ my %search = (ae_scheme => 'nested',
+ ae_identifier => $self->{name});
+ my %options = (join => 'acls',
+ prefetch => 'acls');
+ @entries = $self->{schema}->resultset('AclEntry')->search(\%search,
+ \%options);
+ if (@entries) {
+ my ($entry) = @entries;
+ die "ACL is nested in ACL ".$entry->acls->ac_name;
+ }
+
# Delete any entries (there may or may not be any).
- my %search = (ae_id => $self->{id});
+ %search = (ae_id => $self->{id});
@entries = $self->{schema}->resultset('AclEntry')->search(\%search);
for my $entry (@entries) {
$entry->delete;
@@ -257,7 +305,7 @@ sub destroy {
$guard->commit;
};
if ($@) {
- $self->error ("cannot destroy ACL $self->{id}: $@");
+ $self->error ("cannot destroy ACL $self->{name}: $@");
return;
}
return 1;
@@ -275,6 +323,22 @@ sub add {
$self->error ("unknown ACL scheme $scheme");
return;
}
+
+ # Check to make sure that this entry has a valid name for the scheme.
+ my $class = $self->scheme_mapping ($scheme);
+ my $object = eval {
+ $class->new ($identifier, $self->{schema});
+ };
+ if ($@) {
+ $self->error ("cannot create ACL verifier: $@");
+ return;
+ }
+ unless ($object && $object->syntax_check ($identifier)) {
+ $self->error ("invalid ACL identifier $identifier for $scheme");
+ return;
+ };
+
+ # Actually create the scheme.
eval {
my $guard = $self->{schema}->txn_scope_guard;
my %record = (ae_id => $self->{id},
@@ -285,7 +349,7 @@ sub add {
$guard->commit;
};
if ($@) {
- $self->error ("cannot add $scheme:$identifier to $self->{id}: $@");
+ $self->error ("cannot add $scheme:$identifier to $self->{name}: $@");
return;
}
return 1;
@@ -312,7 +376,7 @@ sub remove {
};
if ($@) {
my $entry = "$scheme:$identifier";
- $self->error ("cannot remove $entry from $self->{id}: $@");
+ $self->error ("cannot remove $entry from $self->{name}: $@");
return;
}
return 1;
@@ -340,7 +404,7 @@ sub list {
$guard->commit;
};
if ($@) {
- $self->error ("cannot retrieve ACL $self->{id}: $@");
+ $self->error ("cannot retrieve ACL $self->{name}: $@");
return;
} else {
return @entries;
@@ -395,7 +459,7 @@ sub history {
$guard->commit;
};
if ($@) {
- $self->error ("cannot read history for $self->{id}: $@");
+ $self->error ("cannot read history for $self->{name}: $@");
return;
}
return $output;
@@ -412,20 +476,21 @@ sub history {
{
my %verifier;
sub check_line {
- my ($self, $principal, $scheme, $identifier) = @_;
+ my ($self, $principal, $scheme, $identifier, $type, $name) = @_;
unless ($verifier{$scheme}) {
my $class = $self->scheme_mapping ($scheme);
unless ($class) {
push (@{ $self->{check_errors} }, "unknown scheme $scheme");
return;
}
- $verifier{$scheme} = $class->new;
+ $verifier{$scheme} = $class->new ($identifier, $self->{schema});
unless (defined $verifier{$scheme}) {
push (@{ $self->{check_errors} }, "cannot verify $scheme");
return;
}
}
- my $result = ($verifier{$scheme})->check ($principal, $identifier);
+ my $result = ($verifier{$scheme})->check ($principal, $identifier,
+ $type, $name);
if (not defined $result) {
push (@{ $self->{check_errors} }, ($verifier{$scheme})->error);
return;
@@ -435,13 +500,13 @@ sub history {
}
}
-# 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.
+# Given a principal, object type, and object name, check whether that
+# principal 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.
sub check {
- my ($self, $principal) = @_;
+ my ($self, $principal, $type, $name) = @_;
unless ($principal) {
$self->error ('no principal specified');
return;
@@ -452,7 +517,8 @@ sub check {
$self->{check_errors} = [];
for my $entry (@entries) {
my ($scheme, $identifier) = @$entry;
- my $result = $self->check_line ($principal, $scheme, $identifier);
+ my $result = $self->check_line ($principal, $scheme, $identifier,
+ $type, $name);
return 1 if $result;
}
return 0;
@@ -643,6 +709,14 @@ On failure, the caller should call error() to get the error message.
Note that rename() operations are not logged in the ACL history.
+=item replace(ID)
+
+Replace this ACL with another. This goes through each object owned by
+the ACL and changes its ownership to the new ACL, leaving this ACL owning
+nothing (and probably then needing to be deleted). Returns true on
+success and false on failure. On failure, the caller should call error()
+to get the error message.
+
=item show()
Returns a human-readable description of this ACL, including its