Improved wallet-admin list command with searches

wallet-admin's list command now has additional searches added for objects
and acls that match certain specifiers.  For objects these include
searching for objects owned by a specific ACL, objects owned by no one,
objects of a specific type, objects with a specific flag, and objects for
which a specific ACL has any privileges at all.  For acls, this includes
the ability to search for any ACL with an entry with given type and
identifier.

1 files changed, 157 insertions, 10 deletions

diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm
index c11c3d4..91f1bfb 100644
--- a/perl/Wallet/Admin.pm
+++ b/perl/Wallet/Admin.pm
@@ -22,7 +22,7 @@ use Wallet::Schema;
 # 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.03';
+$VERSION = '0.04';
 
 ##############################################################################
 # Constructor, destructor, and accessors
@@ -114,20 +114,132 @@ sub destroy {
 # Reporting
 ##############################################################################
 
+# Given an ACL name, translate it to the ID for that ACL and return it.  
+# Often this is unneeded and could be done with a join, but by doing it in a
+# separate step, we can give an error for the specific case of someone 
+# searching for a non-existant ACL.
+sub acl_name_to_id {
+    my ($self, $acl) = @_;
+    my ($id);
+    eval {
+	my $sql = 'select ac_id from acls where ac_name=?';
+	my $sth = $self->{dbh}->prepare ($sql);
+	$sth->execute ($acl);
+	while (defined (my $row = $sth->fetchrow_hashref)) {
+	    $id = $row->{'ac_id'};
+	}
+	$self->{dbh}->commit;
+    };
+    
+    if (!defined $id || $id !~ /^\d+$/) {
+        $self->error ("could not find the acl $acl");
+        return '';
+    }
+    return $id;
+}
+
+# Return the SQL statement to find every object in the database.
+sub list_objects_all {
+    my ($self) = @_;
+    my $sql = 'select ob_type, ob_name from objects order by ob_type,
+        ob_name';
+    return $sql;
+}
+
+# Return the SQL statement and the search field required to find all objects
+# matching a specific type.
+sub list_objects_type {
+    my ($self, $type) = @_;
+    my $sql = 'select ob_type, ob_name from objects where ob_type=? order
+        by ob_type, ob_name';
+    return ($sql, $type);
+}
+
+# Return the SQL statement and search field required to find all objects 
+# owned by a given ACL.  If the requested owner is 'null', then we ignore
+# this and do a different search for IS NULL.  If the requested owner does
+# not actually match any ACLs, set an error and return the empty string.
+sub list_objects_owner {
+    my ($self, $owner) = @_;
+    my ($sth);
+    if ($owner =~ /^null$/i) {
+	my $sql = 'select ob_type, ob_name from objects where ob_owner is null
+            order by objects.ob_type, objects.ob_name';
+	return ($sql);
+    } else {
+	my $id = $self->acl_name_to_id ($owner);
+	return '' unless $id;
+	my $sql = 'select ob_type, ob_name from objects where ob_owner=?
+            order by objects.ob_type, objects.ob_name';
+	return ($sql, $id);
+    }
+}
+
+# Return the SQL statement and search field required to find all objects
+# that have a specific flag set.
+sub list_objects_flag {
+    my ($self, $flag) = @_;
+    my $sql = 'select ob_type, ob_name from objects left join flags on
+        (objects.ob_type=flags.fl_type AND objects.ob_name=flags.fl_name)
+        where flags.fl_flag=? order by objects.ob_type, objects.ob_name';
+    return ($sql, $flag);
+}
+
+# Return the SQL statement and search field required to find all objects 
+# that a given ACL has any permissions on.  This expands from
+# list_objects_owner in that it will also match any records that have the ACL
+# set for get, store, show, destroy, or flags.  If the requested owner does
+# not actually match any ACLs, set an error and return the empty string.
+sub list_objects_acl {
+    my ($self, $acl) = @_;
+
+    my $id = $self->acl_name_to_id ($acl);
+    return '' unless $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=? 
+        order by objects.ob_type, objects.ob_name';
+    return ($sql, $id, $id, $id, $id, $id, $id);
+}
+
 # Returns a list of all objects stored in the wallet database in the form of
 # type and name pairs.  On error and for an empty database, the empty list
 # will be returned.  To distinguish between an empty list and an error, call
-# error(), which will return undef if there was no error.
+# error(), which will return undef if there was no error.  Farms out specific
+# statement to another subroutine for specific search types, but each case
+# should return ob_type and ob_name in that order.
 sub list_objects {
-    my ($self) = @_;
+    my ($self, $type, @args) = @_;
     undef $self->{error};
+
+    # Find the SQL statement and the arguments to use.
+    my $sql = '';
+    my @search = ();
+    if (!defined $type || $type eq '') {
+	($sql) = $self->list_objects_all ();
+    } else {
+	if (@args != 1) {
+	    $self->error ("object searches require an argument to search");
+	} elsif ($type eq 'type') {
+	    ($sql, @search) = $self->list_objects_type (@args);
+	} elsif ($type eq 'owner') {
+	    ($sql, @search) = $self->list_objects_owner (@args);
+	} elsif ($type eq 'flag') {
+	    ($sql, @search) = $self->list_objects_flag (@args);
+	} elsif ($type eq 'acl') {
+	    ($sql, @search) = $self->list_objects_acl (@args);
+	} else {
+	    $self->error ("do not know search type: $type");
+	}
+	return unless $sql;
+    }
+
     my @objects;
     eval {
-        my $sql = 'select ob_type, ob_name from objects order by ob_type,
-            ob_name';
-        my $sth = $self->{dbh}->prepare ($sql);
-        $sth->execute;
         my $object;
+	my $sth = $self->{dbh}->prepare ($sql);
+	$sth->execute (@search);
         while (defined ($object = $sth->fetchrow_arrayref)) {
             push (@objects, [ @$object ]);
         }
@@ -142,6 +254,25 @@ sub list_objects {
     }
 }
 
+# Returns the SQL statement required to find and return all ACLs in the db.
+sub list_acls_all {
+    my ($self) = @_;
+    my $sql = 'select ac_id, ac_name from acls order by ac_id';
+    return ($sql);
+}
+
+# Returns the SQL statement and the field required to search the ACLs and
+# return only those entries which contain a entries with identifiers 
+# matching a particular given string.
+sub list_acls_entry {
+    my ($self, $type, $identifier) = @_;
+    my $sql = 'select distinct ac_id, ac_name from acl_entries 
+        left join acls on (ae_id=ac_id) where ae_scheme=? and 
+        ae_identifier like ? order by ac_id';
+    $identifier = '%'.$identifier.'%';
+    return ($sql, $type, $identifier);
+}
+
 # Returns a list of all ACLs stored in the wallet database as a list of pairs
 # of ACL IDs and ACL names.  On error and for an empty database, the empty
 # list will be returned; however, this is unlikely since any valid database
@@ -149,13 +280,29 @@ sub list_objects {
 # list and an error, call error(), which will return undef if there was no
 # error.
 sub list_acls {
-    my ($self) = @_;
+    my ($self, $type, @args) = @_;
     undef $self->{error};
+
+    # Find the SQL statement and the arguments to use.
+    my $sql = '';
+    my @search = ();
+    if (!defined $type || $type eq '') {
+        ($sql) = $self->list_acls_all ();
+    } else {
+        if (@args == 0) {
+            $self->error ("acl searches require an argument to search");
+        } elsif ($type eq 'entry') {
+            ($sql, @search) = $self->list_acls_entry (@args);
+        } else {
+            $self->error ("do not know search type: $type");
+        }
+        return unless $sql;
+    }
+
     my @acls;
     eval {
-        my $sql = 'select ac_id, ac_name from acls order by ac_id';
         my $sth = $self->{dbh}->prepare ($sql);
-        $sth->execute;
+        $sth->execute (@search);
         my $object;
         while (defined ($object = $sth->fetchrow_arrayref)) {
             push (@acls, [ @$object ]);