summaryrefslogtreecommitdiff
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.pm667
1 files changed, 667 insertions, 0 deletions
diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm
new file mode 100644
index 0000000..a3b0146
--- /dev/null
+++ b/perl/lib/Wallet/ACL.pm
@@ -0,0 +1,667 @@
+# Wallet::ACL -- Implementation of ACLs in the wallet system.
+#
+# Written by Russ Allbery <eagle@eyrie.org>
+# Copyright 2007, 2008, 2010, 2013, 2014
+# The Board of Trustees of the Leland Stanford Junior University
+#
+# See LICENSE for licensing terms.
+
+##############################################################################
+# Modules and declarations
+##############################################################################
+
+package Wallet::ACL;
+require 5.006;
+
+use strict;
+use warnings;
+use vars qw($VERSION);
+
+use DateTime;
+use DBI;
+
+# 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';
+
+##############################################################################
+# Constructors
+##############################################################################
+
+# Initialize a new ACL from the database. Verify that the ACL already exists
+# in the database and, if so, return a new blessed object. Stores the ACL ID
+# and the database handle to use for future operations. If the object
+# doesn't exist, throws an exception.
+sub new {
+ my ($class, $id, $schema) = @_;
+ my (%search, $data, $name);
+ if ($id =~ /^\d+\z/) {
+ $search{ac_id} = $id;
+ } else {
+ $search{ac_name} = $id;
+ }
+ eval {
+ $data = $schema->resultset('Acl')->find (\%search);
+ };
+ if ($@) {
+ die "cannot search for ACL $id: $@\n";
+ } elsif (not defined $data) {
+ die "ACL $id not found\n";
+ }
+ my $self = {
+ schema => $schema,
+ id => $data->ac_id,
+ name => $data->ac_name,
+ };
+ bless ($self, $class);
+ return $self;
+}
+
+# Create a new ACL in the database with the given name and return a new
+# blessed ACL object for it. Stores the database handle to use and the ID of
+# the newly created ACL in the object. On failure, throws an exception.
+sub create {
+ my ($class, $name, $schema, $user, $host, $time) = @_;
+ if ($name =~ /^\d+\z/) {
+ die "ACL name may not be all numbers\n";
+ }
+ $time ||= time;
+ my $id;
+ eval {
+ my $guard = $schema->txn_scope_guard;
+
+ # Create the new record.
+ my %record = (ac_name => $name);
+ my $acl = $schema->resultset('Acl')->create (\%record);
+ $id = $acl->ac_id;
+ die "unable to retrieve new ACL ID" unless defined $id;
+
+ # Add to the history table.
+ my $date = DateTime->from_epoch (epoch => $time);
+ %record = (ah_acl => $id,
+ ah_name => $name,
+ ah_action => 'create',
+ ah_by => $user,
+ ah_from => $host,
+ ah_on => $date);
+ my $history = $schema->resultset('AclHistory')->create (\%record);
+ die "unable to create new history entry" unless defined $history;
+ $guard->commit;
+ };
+ if ($@) {
+ die "cannot create ACL $name: $@\n";
+ }
+ my $self = {
+ schema => $schema,
+ id => $id,
+ name => $name,
+ };
+ bless ($self, $class);
+ return $self;
+}
+
+##############################################################################
+# Utility functions
+##############################################################################
+
+# Set or return the error stashed in the object.
+sub error {
+ my ($self, @error) = @_;
+ if (@error) {
+ my $error = join ('', @error);
+ chomp $error;
+ 1 while ($error =~ s/ at \S+ line \d+\.?\z//);
+ $self->{error} = $error;
+ }
+ return $self->{error};
+}
+
+# Returns the ID of an ACL.
+sub id {
+ my ($self) = @_;
+ return $self->{id};
+}
+
+# Returns the name of the ACL.
+sub name {
+ my ($self)= @_;
+ return $self->{name};
+}
+
+# Given an ACL scheme, return the mapping to a class by querying the
+# database, or undef if no mapping exists. Also load the relevant module.
+sub scheme_mapping {
+ my ($self, $scheme) = @_;
+ my $class;
+ eval {
+ my %search = (as_name => $scheme);
+ my $scheme_rec = $self->{schema}->resultset('AclScheme')
+ ->find (\%search);
+ $class = $scheme_rec->as_class;
+ };
+ if ($@) {
+ $self->error ($@);
+ return;
+ }
+ if (defined $class) {
+ eval "require $class";
+ if ($@) {
+ $self->error ($@);
+ return;
+ }
+ }
+ return $class;
+}
+
+# Record a change to an ACL. Takes the type of change, the scheme and
+# identifier of the entry, and the trace information (user, host, and time).
+# This function does not commit and does not catch exceptions. It should
+# normally be called as part of a larger transaction that implements the
+# change and should be committed with that change.
+sub log_acl {
+ my ($self, $action, $scheme, $identifier, $user, $host, $time) = @_;
+ unless ($action =~ /^(add|remove|rename)\z/) {
+ die "invalid history action $action";
+ }
+ my $date = DateTime->from_epoch (epoch => $time);
+ my %record = (ah_acl => $self->{id},
+ ah_name => $self->{name},
+ ah_action => $action,
+ ah_scheme => $scheme,
+ ah_identifier => $identifier,
+ ah_by => $user,
+ ah_from => $host,
+ ah_on => $date);
+ $self->{schema}->resultset('AclHistory')->create (\%record);
+}
+
+##############################################################################
+# ACL manipulation
+##############################################################################
+
+# Changes the human-readable name of the ACL. Note that this operation is not
+# logged since it isn't a change to any of the data stored in the wallet.
+# Returns true on success, false on failure.
+sub rename {
+ my ($self, $name, $user, $host, $time) = @_;
+ $time ||= time;
+ if ($name =~ /^\d+\z/) {
+ $self->error ("ACL name may not be all numbers");
+ return;
+ }
+ eval {
+ my $guard = $self->{schema}->txn_scope_guard;
+ my %search = (ac_id => $self->{id});
+ my $acls = $self->{schema}->resultset('Acl')->find (\%search);
+ $acls->ac_name ($name);
+ $acls->update;
+ $self->log_acl ('rename', undef, undef, $user, $host, $time);
+ $guard->commit;
+ };
+ if ($@) {
+ $self->error ("cannot rename ACL $self->{id} to $name: $@");
+ return;
+ }
+ $self->{name} = $name;
+ return 1;
+}
+
+# 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 $guard = $self->{schema}->txn_scope_guard;
+
+ # Make certain no one is using the ACL.
+ my @search = ({ ob_owner => $self->{id} },
+ { ob_acl_get => $self->{id} },
+ { ob_acl_store => $self->{id} },
+ { ob_acl_show => $self->{id} },
+ { ob_acl_destroy => $self->{id} },
+ { ob_acl_flags => $self->{id} });
+ my @entries = $self->{schema}->resultset('Object')->search (\@search);
+ if (@entries) {
+ my ($entry) = @entries;
+ die "ACL in use by ".$entry->ob_type.":".$entry->ob_name;
+ }
+
+ # Delete any entries (there may or may not be any).
+ my %search = (ae_id => $self->{id});
+ @entries = $self->{schema}->resultset('AclEntry')->search(\%search);
+ for my $entry (@entries) {
+ $entry->delete;
+ }
+
+ # There should definitely be an ACL record to delete.
+ %search = (ac_id => $self->{id});
+ my $entry = $self->{schema}->resultset('Acl')->find(\%search);
+ $entry->delete if defined $entry;
+
+ # Create new history line for the deletion.
+ my $date = DateTime->from_epoch (epoch => $time);
+ my %record = (ah_acl => $self->{id},
+ ah_name => $self->{name},
+ ah_action => 'destroy',
+ ah_by => $user,
+ ah_from => $host,
+ ah_on => $date);
+ $self->{schema}->resultset('AclHistory')->create (\%record);
+ $guard->commit;
+ };
+ if ($@) {
+ $self->error ("cannot destroy ACL $self->{id}: $@");
+ return;
+ }
+ return 1;
+}
+
+##############################################################################
+# ACL entry manipulation
+##############################################################################
+
+# Add an ACL entry to this ACL. Returns true on success and false on failure.
+sub add {
+ my ($self, $scheme, $identifier, $user, $host, $time) = @_;
+ $time ||= time;
+ unless ($self->scheme_mapping ($scheme)) {
+ $self->error ("unknown ACL scheme $scheme");
+ return;
+ }
+ eval {
+ my $guard = $self->{schema}->txn_scope_guard;
+ my %record = (ae_id => $self->{id},
+ ae_scheme => $scheme,
+ ae_identifier => $identifier);
+ my $entry = $self->{schema}->resultset('AclEntry')->create (\%record);
+ $self->log_acl ('add', $scheme, $identifier, $user, $host, $time);
+ $guard->commit;
+ };
+ if ($@) {
+ $self->error ("cannot add $scheme:$identifier to $self->{id}: $@");
+ return;
+ }
+ return 1;
+}
+
+# Remove an ACL entry to this ACL. Returns true on success and false on
+# failure. Detect the case where no such row exists before doing the delete
+# so that we can provide a good error message.
+sub remove {
+ my ($self, $scheme, $identifier, $user, $host, $time) = @_;
+ $time ||= time;
+ eval {
+ my $guard = $self->{schema}->txn_scope_guard;
+ my %search = (ae_id => $self->{id},
+ ae_scheme => $scheme,
+ ae_identifier => $identifier);
+ my $entry = $self->{schema}->resultset('AclEntry')->find (\%search);
+ unless (defined $entry) {
+ die "entry not found in ACL\n";
+ }
+ $entry->delete;
+ $self->log_acl ('remove', $scheme, $identifier, $user, $host, $time);
+ $guard->commit;
+ };
+ if ($@) {
+ my $entry = "$scheme:$identifier";
+ $self->error ("cannot remove $entry from $self->{id}: $@");
+ return;
+ }
+ return 1;
+}
+
+##############################################################################
+# ACL checking
+##############################################################################
+
+# List all of the entries in an ACL. Returns an array of tuples, each of
+# which contains a scheme and identifier, or an array containing undef on
+# error. Sets the internal error string on error.
+sub list {
+ my ($self) = @_;
+ undef $self->{error};
+ my @entries;
+ eval {
+ my $guard = $self->{schema}->txn_scope_guard;
+ my %search = (ae_id => $self->{id});
+ my @entry_recs = $self->{schema}->resultset('AclEntry')
+ ->search (\%search);
+ for my $entry (@entry_recs) {
+ push (@entries, [ $entry->ae_scheme, $entry->ae_identifier ]);
+ }
+ $guard->commit;
+ };
+ if ($@) {
+ $self->error ("cannot retrieve ACL $self->{id}: $@");
+ return;
+ } else {
+ return @entries;
+ }
+}
+
+# Return as a string a human-readable description of an ACL, including its
+# membership. This method is only for human-readable output; use the list()
+# method if you are using the results in other code. Returns undef on
+# failure.
+sub show {
+ my ($self) = @_;
+ my @entries = $self->list;
+ if (not @entries and $self->error) {
+ return;
+ }
+ my $name = $self->name;
+ my $id = $self->id;
+ my $output = "Members of ACL $name (id: $id) are:\n";
+ for my $entry (sort { $$a[0] cmp $$b[0] or $$a[1] cmp $$b[1] } @entries) {
+ my ($scheme, $identifier) = @$entry;
+ $output .= " $scheme $identifier\n";
+ }
+ return $output;
+}
+
+# Return as a string the history of an ACL. Returns undef on failure.
+sub history {
+ my ($self) = @_;
+ my $output = '';
+ eval {
+ my $guard = $self->{schema}->txn_scope_guard;
+ my %search = (ah_acl => $self->{id});
+ my %options = (order_by => 'ah_on');
+ my @data = $self->{schema}->resultset('AclHistory')
+ ->search (\%search, \%options);
+ for my $data (@data) {
+ my $date = $data->ah_on;
+ $date->set_time_zone ('local');
+ $output .= sprintf ("%s %s ", $date->ymd, $date->hms);
+ if ($data->ah_action eq 'add' || $data->ah_action eq 'remove') {
+ $output .= sprintf ("%s %s %s", $data->ah_action,
+ $data->ah_scheme, $data->ah_identifier);
+ } elsif ($data->ah_action eq 'rename') {
+ $output .= 'rename from ' . $data->ah_name;
+ } else {
+ $output .= $data->ah_action;
+ }
+ $output .= sprintf ("\n by %s from %s\n", $data->ah_by,
+ $data->ah_from);
+ }
+ $guard->commit;
+ };
+ if ($@) {
+ $self->error ("cannot read history for $self->{id}: $@");
+ return;
+ }
+ return $output;
+}
+
+# Given a principal, a scheme, and an identifier, check whether that ACL
+# scheme and identifier grant access to that principal. Return 1 if access
+# was granted, 0 if access was deined, and undef on some error. On error, the
+# error message is also added to the check_errors variable. This method is
+# internal to the class.
+#
+# Maintain ACL verifiers for all schemes we've seen in the local %verifier
+# hash so that we can optimize repeated ACL checks.
+{
+ my %verifier;
+ sub check_line {
+ my ($self, $principal, $scheme, $identifier) = @_;
+ unless ($verifier{$scheme}) {
+ my $class = $self->scheme_mapping ($scheme);
+ unless ($class) {
+ push (@{ $self->{check_errors} }, "unknown scheme $scheme");
+ return;
+ }
+ $verifier{$scheme} = $class->new;
+ unless (defined $verifier{$scheme}) {
+ push (@{ $self->{check_errors} }, "cannot verify $scheme");
+ return;
+ }
+ }
+ my $result = ($verifier{$scheme})->check ($principal, $identifier);
+ if (not defined $result) {
+ push (@{ $self->{check_errors} }, ($verifier{$scheme})->error);
+ return;
+ } else {
+ return $result;
+ }
+ }
+}
+
+# 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.
+sub check {
+ my ($self, $principal) = @_;
+ unless ($principal) {
+ $self->error ('no principal specified');
+ return;
+ }
+ my @entries = $self->list;
+ return if (not @entries and $self->error);
+ my %verifier;
+ $self->{check_errors} = [];
+ for my $entry (@entries) {
+ my ($scheme, $identifier) = @$entry;
+ my $result = $self->check_line ($principal, $scheme, $identifier);
+ return 1 if $result;
+ }
+ return 0;
+}
+
+# Returns the errors from the last ACL verification as an array in array
+# context or as a string with newlines after each error in a scalar context.
+sub check_errors {
+ my ($self) = @_;
+ my @errors;
+ if ($self->{check_errors}) {
+ @errors = @{ $self->{check_errors} };
+ }
+ return wantarray ? @errors : join ("\n", @errors, '');
+}
+
+1;
+__END__
+
+##############################################################################
+# Documentation
+##############################################################################
+
+=head1 NAME
+
+Wallet::ACL - Implementation of ACLs in the wallet system
+
+=for stopwords
+ACL DBH metadata HOSTNAME DATETIME timestamp Allbery verifier verifiers
+
+=head1 SYNOPSIS
+
+ my $acl = Wallet::ACL->create ('group:sysadmin');
+ $acl->rename ('group:unix');
+ $acl->add ('krb5', 'alice@EXAMPLE.COM', $admin, $host);
+ $acl->add ('krb5', 'bob@EXAMPLE.COM', $admin, $host);
+ if ($acl->check ($user)) {
+ print "Permission granted\n";
+ warn scalar ($acl->check_errors) if $acl->check_errors;
+ }
+ $acl->remove ('krb5', 'bob@EXAMPLE.COM', $admin, $host);
+ my @entries = $acl->list;
+ my $summary = $acl->show;
+ my $history = $acl->history;
+ $acl->destroy ($admin, $host);
+
+=head1 DESCRIPTION
+
+Wallet::ACL implements the ACL system for the wallet: the methods to
+create, find, rename, and destroy ACLs; the methods to add and remove
+entries from an ACL; and the methods to list the contents of an ACL and
+check a principal against it.
+
+An ACL is a list of zero or more ACL entries, each of which consists of a
+scheme and an identifier. Each scheme is associated with a verifier
+module that checks Kerberos principals against identifiers for that scheme
+and returns whether the principal should be permitted access by that
+identifier. The interpretation of the identifier is entirely left to the
+scheme. This module maintains the ACLs and dispatches check operations to
+the appropriate verifier module.
+
+Each ACL is identified by a human-readable name and a persistent unique
+numeric identifier. The numeric identifier (ID) should be used to refer
+to the ACL so that it can be renamed as needed without breaking external
+references.
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item new(ACL, SCHEMA)
+
+Instantiate a new ACL object with the given ACL ID or name. Takes the
+Wallet::Schema object to use for retrieving metadata from the wallet
+database. Returns a new ACL object if the ACL was found and throws an
+exception if it wasn't or on any other error.
+
+=item create(NAME, SCHEMA, PRINCIPAL, HOSTNAME [, DATETIME])
+
+Similar to new() in that it instantiates a new ACL object, but instead of
+finding an existing one, creates a new ACL record in the database with the
+given NAME. NAME must not be all-numeric, since that would conflict with
+the automatically assigned IDs. Returns the new object on success and
+throws an exception on failure. PRINCIPAL, HOSTNAME, and DATETIME are
+stored as history information. PRINCIPAL should be the user who is
+creating the ACL. If DATETIME isn't given, the current time is used.
+
+=back
+
+=head1 INSTANCE METHODS
+
+=over 4
+
+=item add(SCHEME, INSTANCE, PRINCIPAL, HOSTNAME [, DATETIME])
+
+Add the given ACL entry (given by SCHEME and INSTANCE) to this ACL.
+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 adding the ACL entry. If DATETIME isn't given, the current time is
+used.
+
+=item check(PRINCIPAL)
+
+Checks whether the given PRINCIPAL should be allowed access given ACL.
+Returns 1 if access was granted, 0 if access is declined, and undef on
+error. On error, the caller should call error() to get the error text.
+Any errors found by the individual ACL verifiers can be retrieved by
+calling check_errors(). Errors from individual ACL verifiers will not
+result in an error return from check(); instead, the check will continue
+with the next entry in the ACL.
+
+check() returns success as soon as an entry in the ACL grants access to
+PRINCIPAL. There is no provision for negative ACLs or exceptions.
+
+=item check_errors()
+
+Return (as a list in array context and a string with newlines between
+errors and at the end of the last error in scalar context) the errors, if
+any, returned by ACL verifiers for the last check operation. If there
+were no errors from the last check() operation, returns the empty list in
+array context and undef in scalar context.
+
+=item destroy(PRINCIPAL, HOSTNAME [, DATETIME])
+
+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()
+
+Returns the error of the last failing operation or undef if no operations
+have failed. Callers should call this function to get the error message
+after an undef return from any other instance method.
+
+=item history()
+
+Returns the human-readable history of this ACL. Each action that changes
+the ACL (not including changes to the name of the ACL) will be represented
+by two lines. The first line will have a timestamp of the change followed
+by a description of the change, and the second line will give the user who
+made the change and the host from which the change was made. On failure,
+returns undef, and the caller should call error() to get the error
+message.
+
+=item id()
+
+Returns the numeric system-generated ID of this ACL.
+
+=item list()
+
+Returns all the entries of this ACL. The return value will be a list of
+references to pairs of scheme and identifier. For example, for an ACL
+containing two entries, both of scheme C<krb5> and with values
+C<alice@EXAMPLE.COM> and C<bob@EXAMPLE.COM>, list() would return:
+
+ ([ 'krb5', 'alice@EXAMPLE.COM' ], [ 'krb5', 'bob@EXAMPLE.COM' ])
+
+Returns the empty list on failure. To distinguish between this and the
+ACL containing no entries, 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.
+
+=item name()
+
+Returns the human-readable name of this ACL.
+
+=item remove(SCHEME, INSTANCE, PRINCIPAL, HOSTNAME [, DATETIME])
+
+Remove the given ACL line (given by SCHEME and INSTANCE) from this ACL.
+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 removing the ACL entry. If DATETIME isn't given, the current time
+is used.
+
+=item rename(NAME)
+
+Rename this ACL. This changes the name used for human convenience but not
+the system-generated ACL ID that is used to reference this ACL. The new
+NAME must not be all-numeric, since that would conflict with
+system-generated ACL IDs. Returns true on success and false on failure.
+On failure, the caller should call error() to get the error message.
+
+Note that rename() operations are not logged in the ACL history.
+
+=item show()
+
+Returns a human-readable description of this ACL, including its
+membership. This method should only be used for display of the ACL to
+humans. Use the list(), name(), and id() methods instead to get ACL
+information for use in other code. On failure, returns undef, and the
+caller should call error() to get the error message.
+
+=back
+
+=head1 SEE ALSO
+
+Wallet::ACL::Base(3), wallet-backend(8)
+
+This module is part of the wallet system. The current version is
+available from L<http://www.eyrie.org/~eagle/software/wallet/>.
+
+=head1 AUTHOR
+
+Russ Allbery <eagle@eyrie.org>
+
+=cut
generated by cgit v1.2.3 (git 2.39.1) at 2025-02-05 20:15:18 +0000