diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/Wallet/ACL.pm | 32 | ||||
| -rwxr-xr-x | perl/t/server.t | 17 |
2 files changed, 39 insertions, 10 deletions
diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm index 76e7354..44a82b2 100644 --- a/perl/Wallet/ACL.pm +++ b/perl/Wallet/ACL.pm @@ -21,7 +21,7 @@ use POSIX qw(strftime); # 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.06'; +$VERSION = '0.07'; ############################################################################## # Constructors @@ -191,11 +191,25 @@ sub rename { # Destroy the ACL, deleting it out of the database. Returns true on success, # false on failure. +# +# Checks to ensure that the ACL is not referenced anywhere in the database, +# since we may not have referential integrity enforcement. It's not clear +# that this is the right place to do this; it's a bit of an abstraction +# violation, since it's a query against the object table. sub destroy { my ($self, $user, $host, $time) = @_; $time ||= time; eval { - my $sql = 'delete from acl_entries where ae_id = ?'; + my $sql = 'select ob_type, ob_name from objects where ob_owner = ? + or ob_acl_get = ? or ob_acl_store = ? or ob_acl_show = ? or + ob_acl_destroy = ? or ob_acl_flags = ?'; + my $sth = $self->{dbh}->prepare ($sql); + $sth->execute (($self->{id}) x 6); + my $entry = $sth->fetchrow_arrayref; + if (defined $entry) { + die "ACL in use by $entry->[0]:$entry->[1]"; + } + $sql = 'delete from acl_entries where ae_id = ?'; $self->{dbh}->do ($sql, undef, $self->{id}); $sql = 'delete from acls where ac_id = ?'; $self->{dbh}->do ($sql, undef, $self->{id}); @@ -525,13 +539,13 @@ array context and undef in scalar context. =item destroy(PRINCIPAL, HOSTNAME [, DATETIME]) -Destroys this ACL from the database. Note that this will fail due to -integrity constraint errors if the ACL is still referenced by any object; -the ACL must be removed from all objects first. Returns true on success -and false on failure. On failure, the caller should call error() to get -the error message. PRINCIPAL, HOSTNAME, and DATETIME are stored as -history information. PRINCIPAL should be the user who is destroying the -ACL. If DATETIME isn't given, the current time is used. +Destroys this ACL from the database. Note that this will fail if the ACL +is still referenced by any object; the ACL must be removed from all +objects first. Returns true on success and false on failure. On failure, +the caller should call error() to get the error message. PRINCIPAL, +HOSTNAME, and DATETIME are stored as history information. PRINCIPAL +should be the user who is destroying the ACL. If DATETIME isn't given, +the current time is used. =item error() diff --git a/perl/t/server.t b/perl/t/server.t index 7b30053..2a178e8 100755 --- a/perl/t/server.t +++ b/perl/t/server.t @@ -7,7 +7,7 @@ # # See LICENSE for licensing terms. -use Test::More tests => 341; +use Test::More tests => 349; use POSIX qw(strftime); use Wallet::Admin; @@ -923,6 +923,21 @@ is ($server->error, 'base:host/default.stanford.edu rejected: host' . ' default.stanford.edu not in .example.edu domain', ' with the right error'); +# Ensure that we can't destroy an ACL that's in use. +is ($server->acl_create ('test-destroy'), 1, 'Creating an ACL works'); +is ($server->create ('base', 'service/acl-user'), 1, 'Creating object works'); +is ($server->owner ('base', 'service/acl-user', 'test-destroy'), 1, + ' and setting owner'); +is ($server->acl_destroy ('test-destroy'), undef, + ' and now we cannot destroy that ACL'); +is ($server->error, + 'cannot destroy ACL 9: ACL in use by base:service/acl-user', + ' with the right error'); +is ($server->owner ('base', 'service/acl-user', ''), 1, + ' but after we clear the owner'); +is ($server->acl_destroy ('test-destroy'), 1, ' now we can destroy the ACL'); +is ($server->destroy ('base', 'service/acl-user'), 1, ' and the object'); + # Clean up. $setup->destroy; unlink 'wallet-db'; |