Added Wallet::ACL::LDAP::Attribute::Root

Added a version of the LDAP attribute ACL.  Like the root version for
NetDB, this requires that the principal end in /root, and then strips
off /root before doing matching against the given LDAP attribute.

Change-Id: I23119ef9c9ce3e0556f5d71a509815f2efc1bbe6

6 files changed, 179 insertions, 18 deletions

diff --git a/perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm b/perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm
new file mode 100644
index 0000000..eb30931
--- /dev/null
+++ b/perl/lib/Wallet/ACL/LDAP/Attribute/Root.pm
@@ -0,0 +1,128 @@
+# Wallet::ACL::LDAP::Attribute::Root -- Wallet LDAP ACL verifier (root instances).
+#
+# Written by Jon Robertson <jonrober@stanford.edu>
+# From Wallet::ACL::NetDB::Root by Russ Allbery <eagle@eyrie.org>
+# Copyright 2015
+#     The Board of Trustees of the Leland Stanford Junior University
+#
+# See LICENSE for licensing terms.
+
+##############################################################################
+# Modules and declarations
+##############################################################################
+
+package Wallet::ACL::LDAP::Attribute::Root;
+require 5.006;
+
+use strict;
+use warnings;
+use vars qw(@ISA $VERSION);
+
+use Wallet::ACL::LDAP::Attribute;
+use Wallet::Config;
+
+@ISA = qw(Wallet::ACL::LDAP::Attribute);
+
+# 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.01';
+
+##############################################################################
+# Interface
+##############################################################################
+
+# Override the check method of Wallet::ACL::LDAP::Attribute to require that
+# the principal be a root instance and to strip /root out of the principal
+# name before checking roles.
+sub check {
+    my ($self, $principal, $acl) = @_;
+    undef $self->{error};
+    unless ($principal) {
+        $self->error ('no principal specified');
+        return;
+    }
+    unless ($principal =~ s%^([^/\@]+)/root(\@|\z)%$1$2%) {
+        return 0;
+    }
+    return $self->SUPER::check ($principal, $acl);
+}
+
+##############################################################################
+# Documentation
+##############################################################################
+
+=for stopwords
+ACL Allbery LDAP verifier
+
+=head1 NAME
+
+Wallet::ACL::LDAP::Attribute::Root - Wallet ACL verifier for LDAP attributes (root instances)
+
+=head1 SYNOPSIS
+
+    my $verifier = Wallet::ACL::LDAP::Attribute::Root->new;
+    my $status = $verifier->check ($principal, "$attr=$value");
+    if (not defined $status) {
+        die "Something failed: ", $verifier->error, "\n";
+    } elsif ($status) {
+        print "Access granted\n";
+    } else {
+        print "Access denied\n";
+    }
+
+=head1 DESCRIPTION
+
+Wallet::ACL::LDAP::Attribute::Root works identically to
+Wallet::ACL::LDAP::Attribute except that it requires the principal to
+be a root instance (in other words, to be in the form
+<principal>/root@<realm>) and strips the C</root> portion from the
+principal before checking against the LDAP attribute and value.  As
+with the base LDAP Attribute ACL verifier, the value of such a
+C<ldap-attr-root> ACL is an attribute followed by an equal sign and a
+value, and the ACL grants access to a given principal if and only if
+the LDAP entry for that principal (with C</root> stripped) has that
+attribute set to that value.
+
+To use this object, the same configuration parameters must be set as for
+Wallet::ACL::LDAP::Attribute.  See Wallet::Config(3) for details on
+those configuration parameters and information about how to set wallet
+configuration.
+
+=head1 METHODS
+
+=over 4
+
+=item check(PRINCIPAL, ACL)
+
+Returns true if PRINCIPAL is granted access according to ACL, false if
+not, and undef on an error (see L<"DIAGNOSTICS"> below).  ACL must be an
+attribute name and a value, separated by an equal sign (with no
+whitespace).  PRINCIPAL will be granted access if it has an instance of
+C<root> and if (with C</root> stripped off)  its LDAP entry contains
+that attribute with that value
+
+=back
+
+=head1 DIAGNOSTICS
+
+Same as for Wallet::ACL::LDAP::Attribute.
+
+=head1 CAVEATS
+
+The instance to strip is not currently configurable.
+
+=head1 SEE ALSO
+
+Net::Remctl(3), Wallet::ACL(3), Wallet::ACL::Base(3),
+Wallet::ACL::LDAP::Attribute(3), Wallet::Config(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 AUTHORS
+
+Jon Robertson <jonrober@stanford.edu>
+Russ Allbery <eagle@eyrie.org>
+
+=cut
diff --git a/perl/lib/Wallet/Admin.pm b/perl/lib/Wallet/Admin.pm
index f6f1f90..b4246ba 100644
--- a/perl/lib/Wallet/Admin.pm
+++ b/perl/lib/Wallet/Admin.pm
@@ -115,12 +115,13 @@ sub default_data {
     # acl_schemes default rows.
     my ($r1) = $self->{schema}->resultset('AclScheme')->populate ([
                        [ qw/as_name as_class/ ],
-                       [ 'krb5',       'Wallet::ACL::Krb5'            ],
-                       [ 'krb5-regex', 'Wallet::ACL::Krb5::Regex'     ],
-                       [ 'ldap-attr',  'Wallet::ACL::LDAP::Attribute' ],
-                       [ 'nested',     'Wallet::ACL::Nested'          ],
-                       [ 'netdb',      'Wallet::ACL::NetDB'           ],
-                       [ 'netdb-root', 'Wallet::ACL::NetDB::Root'     ],
+                       [ 'krb5',           'Wallet::ACL::Krb5'            ],
+                       [ 'krb5-regex',     'Wallet::ACL::Krb5::Regex'     ],
+                       [ 'ldap-attr',      'Wallet::ACL::LDAP::Attribute' ],
+                       [ 'ldap-attr-root', 'Wallet::ACL::LDAP::Attribute::Root' ],
+                       [ 'nested',         'Wallet::ACL::Nested'          ],
+                       [ 'netdb',          'Wallet::ACL::NetDB'           ],
+                       [ 'netdb-root',     'Wallet::ACL::NetDB::Root'     ],
                                                      ]);
     warn "default AclScheme not installed" unless defined $r1;
 
diff --git a/perl/lib/Wallet/Schema.pm b/perl/lib/Wallet/Schema.pm
index 5b850c0..386801a 100644
--- a/perl/lib/Wallet/Schema.pm
+++ b/perl/lib/Wallet/Schema.pm
@@ -114,6 +114,10 @@ Holds the supported ACL schemes and their corresponding Perl classes:
   insert into acl_schemes (as_name, as_class)
       values ('ldap-attr', 'Wallet::ACL::LDAP::Attribute');
   insert into acl_schemes (as_name, as_class)
+      values ('ldap-attr-root', 'Wallet::ACL::LDAP::Attribute::Root');
+  insert into acl_schemes (as_name, as_class)
+      values ('nested', 'Wallet::ACL::Nested');
+  insert into acl_schemes (as_name, as_class)
       values ('netdb', 'Wallet::ACL::NetDB');
   insert into acl_schemes (as_name, as_class)
       values ('netdb-root', 'Wallet::ACL::NetDB::Root');
diff --git a/perl/lib/Wallet/Schema/Result/AclScheme.pm b/perl/lib/Wallet/Schema/Result/AclScheme.pm
index 91a58b2..be4ec09 100644
--- a/perl/lib/Wallet/Schema/Result/AclScheme.pm
+++ b/perl/lib/Wallet/Schema/Result/AclScheme.pm
@@ -36,6 +36,10 @@ By default it contains the following entries:
   insert into acl_schemes (as_name, as_class)
       values ('ldap-attr', 'Wallet::ACL::LDAP::Attribute');
   insert into acl_schemes (as_name, as_class)
+      values ('ldap-attr-root', 'Wallet::ACL::LDAP::Attribute::Root');
+  insert into acl_schemes (as_name, as_class)
+      values ('nested', 'Wallet::ACL::Nested');
+  insert into acl_schemes (as_name, as_class)
       values ('netdb', 'Wallet::ACL::NetDB');
   insert into acl_schemes (as_name, as_class)
       values ('netdb-root', 'Wallet::ACL::NetDB::Root');
diff --git a/perl/t/general/report.t b/perl/t/general/report.t
index a841acd..e47cdc6 100755
--- a/perl/t/general/report.t
+++ b/perl/t/general/report.t
@@ -11,7 +11,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 222;
+use Test::More tests => 223;
 
 use Wallet::Admin;
 use Wallet::Report;
@@ -57,14 +57,15 @@ is ($types[9][0], 'wa-keyring', ' and the tenth member is correct');
 
 # And that we have all schemes that we expect.
 my @schemes = $report->acl_schemes;
-is (scalar (@schemes), 7, 'There are seven acl schemes created');
+is (scalar (@schemes), 8, 'There are seven acl schemes created');
 is ($schemes[0][0], 'base', ' and the first member is correct');
 is ($schemes[1][0], 'krb5', ' and the second member is correct');
 is ($schemes[2][0], 'krb5-regex', ' and the third member is correct');
 is ($schemes[3][0], 'ldap-attr', ' and the fourth member is correct');
-is ($schemes[4][0], 'nested', ' and the fifth member is correct');
-is ($schemes[5][0], 'netdb', ' and the sixth member is correct');
-is ($schemes[6][0], 'netdb-root', ' and the seventh member is correct');
+is ($schemes[4][0], 'ldap-attr-root', ' and the fifth member is correct');
+is ($schemes[5][0], 'nested', ' and the sixth member is correct');
+is ($schemes[6][0], 'netdb', ' and the seventh member is correct');
+is ($schemes[7][0], 'netdb-root', ' and the eighth member is correct');
 
 # Create an object.
 my $server = eval { Wallet::Server->new ('admin@EXAMPLE.COM', 'localhost') };
diff --git a/perl/t/verifier/ldap-attr.t b/perl/t/verifier/ldap-attr.t
index 3caaf8b..cff3b63 100755
--- a/perl/t/verifier/ldap-attr.t
+++ b/perl/t/verifier/ldap-attr.t
@@ -24,16 +24,18 @@ plan skip_all => 'LDAP verifier tests only run for maintainer'
     unless $ENV{RRA_MAINTAINER_TESTS};
 
 # Declare a plan.
-plan tests => 10;
+plan tests => 22;
 
 require_ok ('Wallet::ACL::LDAP::Attribute');
+require_ok ('Wallet::ACL::LDAP::Attribute::Root');
 
-my $host   = 'ldap.stanford.edu';
-my $base   = 'cn=people,dc=stanford,dc=edu';
-my $filter = 'uid';
-my $user   = 'jonrober@stanford.edu';
-my $attr   = 'suPrivilegeGroup';
-my $value  = 'stanford:stanford';
+my $host     = 'ldap.stanford.edu';
+my $base     = 'cn=people,dc=stanford,dc=edu';
+my $filter   = 'uid';
+my $user     = 'jonrober@stanford.edu';
+my $rootuser = 'jonrober/root@stanford.edu';
+my $attr     = 'suPrivilegeGroup';
+my $value    = 'stanford:stanford';
 
 # Remove the realm from principal names.
 package Wallet::Config;
@@ -73,4 +75,25 @@ SKIP: {
     is ($verifier->check ('user-does-not-exist', "$attr=$value"), 0,
         "Checking for nonexistent user fails");
     is ($verifier->error, undef, '...with no error');
+
+    # Then also test the root version.
+    $verifier = eval { Wallet::ACL::LDAP::Attribute::Root->new };
+    isa_ok ($verifier, 'Wallet::ACL::LDAP::Attribute::Root');
+    is ($verifier->check ($user, "$attr=$value"), 0,
+        "Checking as a non /root user fails");
+    is ($verifier->error, undef, '...with no error');
+    is ($verifier->check ($rootuser, "$attr=$value"), 1,
+        "Checking $attr=$value succeeds");
+    is ($verifier->error, undef, '...with no error');
+    is ($verifier->check ($rootuser, "$attr=BOGUS"), 0,
+        "Checking $attr=BOGUS fails");
+    is ($verifier->error, undef, '...with no error');
+    is ($verifier->check ($rootuser, "BOGUS=$value"), undef,
+        "Checking BOGUS=$value fails with error");
+    is ($verifier->error,
+        'cannot check LDAP attribute BOGUS for jonrober: Undefined attribute type',
+        '...with correct error');
+    is ($verifier->check ('user-does-not-exist', "$attr=$value"), 0,
+        "Checking for nonexistent user fails");
+    is ($verifier->error, undef, '...with no error');
 }