summaryrefslogtreecommitdiff
path: root/perl/Wallet/ACL.pm
diff options
context:
space:
mode:
Diffstat (limited to 'perl/Wallet/ACL.pm')
-rw-r--r--perl/Wallet/ACL.pm657
1 files changed, 0 insertions, 657 deletions
diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm
deleted file mode 100644
index 808be3c..0000000
--- a/perl/Wallet/ACL.pm
+++ /dev/null
@@ -1,657 +0,0 @@
-# Wallet::ACL -- Implementation of ACLs in the wallet system.
-#
-# Written by Russ Allbery <eagle@eyrie.org>
-# Copyright 2007, 2008, 2010, 2013
-# 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 vars qw($VERSION);
-
-use DBI;
-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.07';
-
-##############################################################################
-# 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 = strftime ('%Y-%m-%d %T', localtime $time);
- %record = (ah_acl => $id,
- 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)\z/) {
- die "invalid history action $action";
- }
- my %record = (ah_acl => $self->{id},
- ah_action => $action,
- ah_scheme => $scheme,
- ah_identifier => $identifier,
- ah_by => $user,
- ah_from => $host,
- ah_on => strftime ('%Y-%m-%d %T', localtime $time));
- $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) = @_;
- 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;
- $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 %record = (ah_acl => $self->{id},
- ah_action => 'destroy',
- ah_by => $user,
- ah_from => $host,
- ah_on => strftime ('%Y-%m-%d %T', localtime $time));
- $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) {
- $output .= sprintf ("%s %s ", $data->ah_on->ymd,
- $data->ah_on->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);
- } 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-07 20:44:29 +0000