Verify that an ACL to be deleted is not referenced

When deleting an ACL on the server, verify that the ACL is not
referenced by any object first.  Database referential integrity should
also catch this, but not all database backends may enforce referential
integrity.  This also allows us to return a better error message
naming an object that's still using that ACL.

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';