Imported Upstream version 1.3upstream/1.3

1 files changed, 100 insertions, 26 deletions

diff --git a/perl/lib/Wallet/ACL.pm b/perl/lib/Wallet/ACL.pm
index a3b0146..ad0eb2c 100644
--- a/perl/lib/Wallet/ACL.pm
+++ b/perl/lib/Wallet/ACL.pm
@@ -1,7 +1,8 @@
-# Wallet::ACL -- Implementation of ACLs in the wallet system.
+# Wallet::ACL -- Implementation of ACLs in the wallet system
 #
 # Written by Russ Allbery <eagle@eyrie.org>
-# Copyright 2007, 2008, 2010, 2013, 2014
+# Copyright 2016 Russ Allbery <eagle@eyrie.org>
+# Copyright 2007, 2008, 2010, 2013, 2014, 2015
 #     The Board of Trustees of the Leland Stanford Junior University
 #
 # See LICENSE for licensing terms.
@@ -11,19 +12,15 @@
 ##############################################################################
 
 package Wallet::ACL;
-require 5.006;
 
+use 5.008;
 use strict;
 use warnings;
-use vars qw($VERSION);
 
 use DateTime;
-use DBI;
+use Wallet::Object::Base;
 
-# 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';
+our $VERSION = '1.03';
 
 ##############################################################################
 # Constructors
@@ -197,16 +194,55 @@ sub rename {
         $acls->ac_name ($name);
         $acls->update;
         $self->log_acl ('rename', undef, undef, $user, $host, $time);
+
+        # Find any references to this being used as a nested verifier and
+        # update the name.  This really breaks out of the normal flow, but
+        # it's hard to do otherwise.
+        %search = (ae_scheme     => 'nested',
+                   ae_identifier => $self->{name},
+                  );
+        my @entries = $self->{schema}->resultset('AclEntry')->search(\%search);
+        for my $entry (@entries) {
+            $entry->ae_identifier ($name);
+            $entry->update;
+        }
+
         $guard->commit;
     };
     if ($@) {
-        $self->error ("cannot rename ACL $self->{id} to $name: $@");
+        $self->error ("cannot rename ACL $self->{name} to $name: $@");
         return;
     }
     $self->{name} = $name;
     return 1;
 }
 
+# Moves everything owned by one ACL to instead be owned by another.  You'll
+# normally want to use rename, but this exists for cases where the replacing
+# ACL already exists and has things assigned to it.  Returns true on success,
+# false on failure.
+sub replace {
+    my ($self, $replace_id, $user, $host, $time) = @_;
+    $time ||= time;
+
+    my %search = (ob_owner => $self->{id});
+    my @objects = $self->{schema}->resultset('Object')->search (\%search);
+    if (@objects) {
+        for my $object (@objects) {
+            my $type   = $object->ob_type;
+            my $name   = $object->ob_name;
+            my $object = eval {
+                Wallet::Object::Base->new($type, $name, $self->{schema});
+            };
+            $object->owner ($replace_id, $user, $host, $time);
+        }
+    } else {
+        $self->error ("no objects found for ACL $self->{name}");
+        return;
+    }
+    return 1;
+}
+
 # Destroy the ACL, deleting it out of the database.  Returns true on success,
 # false on failure.
 #
@@ -233,8 +269,20 @@ sub destroy {
             die "ACL in use by ".$entry->ob_type.":".$entry->ob_name;
         }
 
+        # Also make certain the ACL isn't being nested in another.
+        my %search = (ae_scheme     => 'nested',
+                      ae_identifier => $self->{name});
+        my %options = (join     => 'acls',
+                       prefetch => 'acls');
+        @entries = $self->{schema}->resultset('AclEntry')->search(\%search,
+                                                                  \%options);
+        if (@entries) {
+            my ($entry) = @entries;
+            die "ACL is nested in ACL ".$entry->acls->ac_name;
+        }
+
         # Delete any entries (there may or may not be any).
-        my %search = (ae_id => $self->{id});
+        %search = (ae_id => $self->{id});
         @entries = $self->{schema}->resultset('AclEntry')->search(\%search);
         for my $entry (@entries) {
             $entry->delete;
@@ -257,7 +305,7 @@ sub destroy {
         $guard->commit;
     };
     if ($@) {
-        $self->error ("cannot destroy ACL $self->{id}: $@");
+        $self->error ("cannot destroy ACL $self->{name}: $@");
         return;
     }
     return 1;
@@ -275,6 +323,22 @@ sub add {
         $self->error ("unknown ACL scheme $scheme");
         return;
     }
+
+    # Check to make sure that this entry has a valid name for the scheme.
+    my $class = $self->scheme_mapping ($scheme);
+    my $object = eval {
+        $class->new ($identifier, $self->{schema});
+    };
+    if ($@) {
+        $self->error ("cannot create ACL verifier: $@");
+        return;
+    }
+    unless ($object && $object->syntax_check ($identifier)) {
+        $self->error ("invalid ACL identifier $identifier for $scheme");
+        return;
+    };
+
+    # Actually create the scheme.
     eval {
         my $guard = $self->{schema}->txn_scope_guard;
         my %record = (ae_id         => $self->{id},
@@ -285,7 +349,7 @@ sub add {
         $guard->commit;
     };
     if ($@) {
-        $self->error ("cannot add $scheme:$identifier to $self->{id}: $@");
+        $self->error ("cannot add $scheme:$identifier to $self->{name}: $@");
         return;
     }
     return 1;
@@ -312,7 +376,7 @@ sub remove {
     };
     if ($@) {
         my $entry = "$scheme:$identifier";
-        $self->error ("cannot remove $entry from $self->{id}: $@");
+        $self->error ("cannot remove $entry from $self->{name}: $@");
         return;
     }
     return 1;
@@ -340,7 +404,7 @@ sub list {
         $guard->commit;
     };
     if ($@) {
-        $self->error ("cannot retrieve ACL $self->{id}: $@");
+        $self->error ("cannot retrieve ACL $self->{name}: $@");
         return;
     } else {
         return @entries;
@@ -395,7 +459,7 @@ sub history {
         $guard->commit;
     };
     if ($@) {
-        $self->error ("cannot read history for $self->{id}: $@");
+        $self->error ("cannot read history for $self->{name}: $@");
         return;
     }
     return $output;
@@ -412,20 +476,21 @@ sub history {
 {
     my %verifier;
     sub check_line {
-        my ($self, $principal, $scheme, $identifier) = @_;
+        my ($self, $principal, $scheme, $identifier, $type, $name) = @_;
         unless ($verifier{$scheme}) {
             my $class = $self->scheme_mapping ($scheme);
             unless ($class) {
                 push (@{ $self->{check_errors} }, "unknown scheme $scheme");
                 return;
             }
-            $verifier{$scheme} = $class->new;
+            $verifier{$scheme} = $class->new ($identifier, $self->{schema});
             unless (defined $verifier{$scheme}) {
                 push (@{ $self->{check_errors} }, "cannot verify $scheme");
                 return;
             }
         }
-        my $result = ($verifier{$scheme})->check ($principal, $identifier);
+        my $result = ($verifier{$scheme})->check ($principal, $identifier,
+                                                  $type, $name);
         if (not defined $result) {
             push (@{ $self->{check_errors} }, ($verifier{$scheme})->error);
             return;
@@ -435,13 +500,13 @@ sub history {
     }
 }
 
-# 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.
+# Given a principal, object type, and object name, check whether that
+# principal 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) = @_;
+    my ($self, $principal, $type, $name) = @_;
     unless ($principal) {
         $self->error ('no principal specified');
         return;
@@ -452,7 +517,8 @@ sub check {
     $self->{check_errors} = [];
     for my $entry (@entries) {
         my ($scheme, $identifier) = @$entry;
-        my $result = $self->check_line ($principal, $scheme, $identifier);
+        my $result = $self->check_line ($principal, $scheme, $identifier,
+                                        $type, $name);
         return 1 if $result;
     }
     return 0;
@@ -643,6 +709,14 @@ On failure, the caller should call error() to get the error message.
 
 Note that rename() operations are not logged in the ACL history.
 
+=item replace(ID)
+
+Replace this ACL with another.  This goes through each object owned by
+the ACL and changes its ownership to the new ACL, leaving this ACL owning
+nothing (and probably then needing to be deleted).  Returns true on
+success and false on failure.  On failure, the caller should call error()
+to get the error message.
+
 =item show()
 
 Returns a human-readable description of this ACL, including its