summaryrefslogtreecommitdiff
path: root/perl/Wallet/Admin.pm
diff options
context:
space:
mode:
Diffstat (limited to 'perl/Wallet/Admin.pm')
-rw-r--r--perl/Wallet/Admin.pm311
1 files changed, 2 insertions, 309 deletions
diff --git a/perl/Wallet/Admin.pm b/perl/Wallet/Admin.pm
index b4b3d86..e835713 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.04';
+$VERSION = '0.05';
##############################################################################
# Constructor, destructor, and accessors
@@ -111,256 +111,6 @@ 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. 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, $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 $object;
- my $sth = $self->{dbh}->prepare ($sql);
- $sth->execute (@search);
- while (defined ($object = $sth->fetchrow_arrayref)) {
- push (@objects, [ @$object ]);
- }
- $self->{dbh}->commit;
- };
- if ($@) {
- $self->error ("cannot list objects: $@");
- $self->{dbh}->rollback;
- return;
- } else {
- return @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 required to find and returned all empty ACLs in
-# the db.
-sub list_acls_empty {
- my ($self) = @_;
- my $sql = 'select ac_id, ac_name from acls left join acl_entries
- on (acls.ac_id = acl_entries.ae_id) where ae_id is null';
- 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
-# will have at least an ADMIN ACL. Still, to distinguish between an empty
-# list and an error, call error(), which will return undef if there was no
-# error.
-sub list_acls {
- 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 ($type eq 'entry') {
- if (@args == 0) {
- $self->error ("acl searches require an argument to search");
- } else {
- ($sql, @search) = $self->list_acls_entry (@args);
- }
- } elsif ($type eq 'empty') {
- ($sql) = $self->list_acls_empty ();
- } else {
- $self->error ("do not know search type: $type");
- }
- return unless $sql;
- }
-
- my @acls;
- eval {
- my $sth = $self->{dbh}->prepare ($sql);
- $sth->execute (@search);
- my $object;
- while (defined ($object = $sth->fetchrow_arrayref)) {
- push (@acls, [ @$object ]);
- }
- $self->{dbh}->commit;
- };
- if ($@) {
- $self->error ("cannot list ACLs: $@");
- $self->{dbh}->rollback;
- return;
- } else {
- return @acls;
- }
-}
-
-# Returns a report of all ACL lines contained in owner ACLs for matching
-# objects. Objects are specified by type and name, which may be SQL wildcard
-# expressions. Each list member will be a pair of ACL scheme and ACL
-# identifier, with duplicates removed. On error and for no matching entries,
-# the empty list will be returned. To distinguish between an empty return and
-# an error, call error(), which will return undef if there was no error.
-sub report_owners {
- my ($self, $type, $name) = @_;
- undef $self->{error};
- my @lines;
- eval {
- my $sql = 'select distinct ae_scheme, ae_identifier from acl_entries,
- acls, objects where ae_id = ac_id and ac_id = ob_owner and
- ob_type like ? and ob_name like ? order by ae_scheme,
- ae_identifier';
- my $sth = $self->{dbh}->prepare ($sql);
- $sth->execute ($type, $name);
- my $object;
- while (defined ($object = $sth->fetchrow_arrayref)) {
- push (@lines, [ @$object ]);
- }
- $self->{dbh}->commit;
- };
- if ($@) {
- $self->error ("cannot report on owners: $@");
- $self->{dbh}->rollback;
- return;
- } else {
- return @lines;
- }
-}
-
-##############################################################################
# Object registration
##############################################################################
@@ -414,7 +164,7 @@ __DATA__
Wallet::Admin - Wallet system administrative interface
=for stopwords
-ACL hostname ACLs SQL wildcard Allbery
+ACL hostname Allbery
=head1 SYNOPSIS
@@ -478,52 +228,6 @@ initialize() uses C<localhost> as the hostname and PRINCIPAL as the user
when logging the history of the ADMIN ACL creation and for any subsequent
actions on the object it returns.
-=item list_acls(TYPE, SEARCH)
-
-Returns a list of all ACLs matching a search type and string in the
-database, or all ACLs if no search information is given. The return value
-is a list of references to pairs of ACL ID and name. For example, if
-there are two ACLs in the database, one with name "ADMIN" and ID 1 and one
-with name "group/admins" and ID 3, list_acls() with no arguments would
-return:
-
- ([ 1, 'ADMIN' ], [ 3, 'group/admins' ])
-
-Returns the empty list on failure. Any valid wallet database should have
-at least one ACL, but an error can be distinguished from the odd case of a
-database with no ACLs by calling error(). error() is guaranteed to return
-the error message if there was an error and undef if there was no error.
-
-There are currently two search types. C<empty> takes no arguments and
-will return only those ACLs that have no entries within them. C<entry>
-takes two arguments, an entry scheme and an entry identifier, and will
-return any ACLs with an entry that matches the given scheme and contains
-the given identifier.
-
-=item list_objects(TYPE, SEARCH)
-
-Returns a list of all objects matching a search type and string in the
-database, or all objects in the database if no search information is
-given. The return value is a list of references to pairs of type and
-name. For example, if two objects existed in the database, both of type
-C<keytab> and with values C<host/example.com> and C<foo>, list_objects()
-with no arguments would return:
-
- ([ 'keytab', 'host/example.com' ], [ 'keytab', 'foo' ])
-
-Returns the empty list on failure. To distinguish between this and a
-database containing no objects, the caller should call error(). error()
-is guaranteed to return the error message if there was an error and undef
-if there was no error.
-
-There are four types of searches currently. C<type> (with a given type)
-will return only those entries where the type matches the given type.
-C<owner>, with a given owner, will only return those objects owned by the
-given ACL name. C<flag>, with a given flag name, will only return those
-items with a flag set to the given value. C<acl> operates like C<owner>,
-but will return only those objects that have the given ACL name on any of
-the possible ACL settings, not just owner.
-
=item register_object (TYPE, CLASS)
Register in the database a mapping from the object type TYPE to the class
@@ -545,17 +249,6 @@ be deleted and a fresh set of wallet database tables will be created.
This method is equivalent to calling destroy() followed by initialize().
Returns true on success and false on failure.
-=item report_owners(TYPE, NAME)
-
-Returns a list of all ACL lines contained in owner ACLs for objects
-matching TYPE and NAME, which are interpreted as SQL patterns using C<%>
-as a wildcard. The return value is a list of references to pairs of
-schema and identifier, with duplicates removed.
-
-Returns the empty list on failure. To distinguish between this and no
-matches, the caller should call error(). error() is guaranteed to return
-the error message if there was an error and undef if there was no error.
-
=back
=head1 SEE ALSO
generated by cgit v1.2.3 (git 2.39.1) at 2025-02-05 23:45:50 +0000