Add initial LDAP attribute ACL verifier

A new ACL type, ldap-attr (Wallet::ACL::LDAP::Attribute), is now
supported.  This ACL type grants access if the LDAP entry
corresponding to the principal contains the attribute name and value
specified in the ACL.  The Net::LDAP and Authen::SASL Perl modules are
required to use this ACL type.  New configuration settings are
required as well; see Wallet::Config for more information.  To enable
this ACL type for an existing wallet database, use wallet-admin to
register the new verifier.

8 files changed, 426 insertions, 4 deletions

diff --git a/NEWS b/NEWS
index 42fb3e7..d08cb14 100644
--- a/NEWS
+++ b/NEWS
@@ -6,6 +6,15 @@ wallet 1.0 (unreleased)
     database to the latest schema version.  This command should be run
     when deploying any new version of the wallet server.
 
+    A new ACL type, ldap-attr (Wallet::ACL::LDAP::Attribute), is now
+    supported.  This ACL type grants access if the LDAP entry
+    corresponding to the principal contains the attribute name and value
+    specified in the ACL.  The Net::LDAP and Authen::SASL Perl modules are
+    required to use this ACL type.  New configuration settings are
+    required as well; see Wallet::Config for more information.  To enable
+    this ACL type for an existing wallet database, use wallet-admin to
+    register the new verifier.
+
     Add a comment field to objects and corresponding commands to
     wallet-backend and wallet to set and retrieve it.  The comment field
     can only be set by the owner or wallet administrators but can be seen
diff --git a/README b/README
index c981272..c440b8c 100644
--- a/README
+++ b/README
@@ -95,6 +95,10 @@ REQUIREMENTS
   binary that supports the -norandkey option to ktadd.  This option is
   included in MIT Kerberos 1.7 and later.
 
+  To support the LDAP attribute ACL verifier, the Authen::SASL and
+  Net::LDAP Perl modules must be installed on the server.  This verifier
+  only works with LDAP servers that support GSS-API binds.
+
   To support the NetDB ACL verifier (only of interest at sites using NetDB
   to manage DNS), the Net::Remctl Perl module must be installed on the
   server.
diff --git a/TODO b/TODO
index b0b4652..b019903 100644
--- a/TODO
+++ b/TODO
@@ -63,8 +63,6 @@ ACLs:
  * Error messages from ACL operations should refer to the ACLs by name
    instead of by ID.
 
- * Write the LDAP entitlement ACL verifier.
-
  * Write the PTS ACL verifier.
 
  * Rename Wallet::ACL::* to Wallet::Verifier::*.  Add Wallet::ACL as a
@@ -81,7 +79,8 @@ ACLs:
  * A group-in-groups ACL schema.
 
  * Provide an API for verifiers to syntax-check the values before an ACL
-   is set and implement syntax checking for the Krb5 verifier.
+   is set and implement syntax checking for the krb5 and ldap-attr
+   verifiers.
 
  * Investigate how best to support client authentication using anonymous
    PKINIT for things like initial system keying.
@@ -195,6 +194,11 @@ Code Style and Cleanup:
 
 Test Suite:
 
+ * The ldap-attr verifier test case is awful and completely specific to
+   people with admin access to the Stanford LDAP tree.  Write a real test.
+
+ * Rename the tests to use a subdirectory organization.
+
  * Add POD coverage testing using Test::POD::Coverage for the server
    modules.
 
diff --git a/perl/Wallet/ACL/LDAP/Attribute.pm b/perl/Wallet/ACL/LDAP/Attribute.pm
new file mode 100644
index 0000000..7a54546
--- /dev/null
+++ b/perl/Wallet/ACL/LDAP/Attribute.pm
@@ -0,0 +1,258 @@
+# Wallet::ACL::LDAP::Attribute -- Wallet LDAP attribute ACL verifier.
+#
+# Written by Russ Allbery
+# Copyright 2012
+#     The Board of Trustees of the Leland Stanford Junior University
+#
+# See LICENSE for licensing terms.
+
+##############################################################################
+# Modules and declarations
+##############################################################################
+
+package Wallet::ACL::LDAP::Attribute;
+require 5.006;
+
+use strict;
+use vars qw(@ISA $VERSION);
+
+use Authen::SASL ();
+use Net::LDAP qw(LDAP_COMPARE_TRUE);
+use Wallet::ACL::Base;
+
+@ISA = qw(Wallet::ACL::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.01';
+
+##############################################################################
+# Interface
+##############################################################################
+
+# Create a new persistant verifier.  Load the Net::LDAP module and open a
+# persistant LDAP server connection that we'll use for later calls.
+sub new {
+    my $type = shift;
+    my $host = $Wallet::Config::LDAP_HOST;
+    my $base = $Wallet::Config::LDAP_BASE;
+    unless ($host and defined ($base) and $Wallet::Config::LDAP_CACHE) {
+        die "LDAP attribute ACL support not configured\n";
+    }
+
+    # Ensure the required Perl modules are available and bind to the directory
+    # server.  Catch any errors with a try/catch block.
+    my $ldap;
+    eval {
+        local $ENV{KRB5CCNAME} = $Wallet::Config::LDAP_CACHE;
+        my $sasl = Authen::SASL->new (mechanism => 'GSSAPI');
+        $ldap = Net::LDAP->new ($host, onerror => 'die');
+        my $mesg = eval { $ldap->bind (undef, sasl => $sasl) };
+    };
+    if ($@) {
+        my $error = $@;
+        chomp $error;
+        1 while ($error =~ s/ at \S+ line \d+\.?\z//);
+        die "LDAP attribute ACL support not available: $error\n";
+    }
+
+    # We successfully bound, so create our object and return it.
+    my $self = { ldap => $ldap };
+    bless ($self, $type);
+    return $self;
+}
+
+# Check whether a given principal has the required LDAP attribute.  We first
+# map the principal to a DN by doing a search for that principal (and bailing
+# if we get more than one entry).  Then, we do a compare to see if that DN has
+# the desired attribute and value.
+#
+# If the ldap_map_principal sub is defined in Wallet::Config, call it on the
+# principal first to map it to the value for which we'll search.
+#
+# The connection is configured to die on any error, so we do all the work in a
+# try/catch block to report errors.
+sub check {
+    my ($self, $principal, $acl) = @_;
+    undef $self->{error};
+    unless ($principal) {
+        $self->error ('no principal specified');
+        return;
+    }
+    my ($attr, $value);
+    if ($acl) {
+        ($attr, $value) = split ('=', $acl, 2);
+    }
+    unless (defined ($attr) and defined ($value)) {
+        $self->error ('malformed ldap-attr ACL');
+        return;
+    }
+    my $ldap = $self->{ldap};
+
+    # Map the principal name to an attribute value for our search if we're
+    # doing a custom mapping.
+    if (defined &Wallet::Config::ldap_map_principal) {
+        eval { $principal = Wallet::Config::ldap_map_principal ($principal) };
+        if ($@) {
+            $self->error ("mapping principal to LDAP failed: $@");
+            return;
+        }
+    }
+
+    # Now, map the user to a DN by doing a search.
+    my $entry;
+    eval {
+        my $fattr = $Wallet::Config::LDAP_FILTER_ATTR || 'krb5PrincipalName';
+        my $filter = "($fattr=$principal)";
+        my $base = $Wallet::Config::LDAP_BASE;
+        my @options = (base => $base, filter => $filter, attrs => [ 'dn' ]);
+        my $search = $ldap->search (@options);
+        if ($search->count == 1) {
+            $entry = $search->pop_entry;
+        } elsif ($search->count > 1) {
+            die $search->count . " LDAP entries found for $principal";
+        }
+    };
+    if ($@) {
+        $self->error ("cannot search for $principal in LDAP: $@");
+        return;
+    }
+    return 0 unless $entry;
+
+    # We have a user entry.  We can now check whether that user has the
+    # desired attribute and value.
+    my $result;
+    eval {
+        my $mesg = $ldap->compare ($entry, attr => $attr, value => $value);
+        $result = $mesg->code;
+    };
+    if ($@) {
+        $self->error ("cannot check LDAP attribute $attr for $principal: $@");
+        return;
+    }
+    return ($result == LDAP_COMPARE_TRUE) ? 1 : 0;
+}
+
+1;
+
+##############################################################################
+# Documentation
+##############################################################################
+
+=for stopwords
+ACL Allbery
+
+=head1 NAME
+
+Wallet::ACL::LDAP::Attribute - Wallet ACL verifier for LDAP attribute compares
+
+=head1 SYNOPSIS
+
+    my $verifier = Wallet::ACL::LDAP::Attribute->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 checks whether the LDAP record for the entry
+corresponding to a principal contains an attribute with a particular
+value.  It is used to verify ACL lines of type C<ldap-attr>.  The value of
+such an 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 has that attribute set to that value.
+
+To use this object, several configuration parameters must be set.  See
+L<Wallet::Config> for details on those configuration parameters and
+information about how to set wallet configuration.
+
+=head1 METHODS
+
+=item new()
+
+Creates a new ACL verifier.  Opens and binds the connection to the LDAP
+server.
+
+=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 its LDAP entry contains
+that attribute with that value.
+
+=item error()
+
+Returns the error if check() returned undef.
+
+=back
+
+=head1 DIAGNOSTICS
+
+The new() method may fail with one of the following exceptions:
+
+=item LDAP attribute ACL support not available: %s
+
+Attempting to connect or bind to the LDAP server failed.
+
+=item LDAP attribute ACL support not configured
+
+The required configuration parameters were not set.  See Wallet::Config(3)
+for the required configuration parameters and how to set them.
+
+=back
+
+Verifying an LDAP attribute ACL may fail with the following errors
+(returned by the error() method):
+
+=over 4
+
+=item cannot check LDAP attribute %s for %s: %s
+
+The LDAP compare to check for the required attribute failed.  The
+attribute may have been misspelled, or there may be LDAP directory
+permission issues.  This error indicates that PRINCIPAL's entry was
+located in LDAP, but the check failed during the compare to verify the
+attribute value.
+
+=item cannot search for %s in LDAP: %s
+
+Searching for PRINCIPAL (possibly after ldap_map_principal() mapping)
+failed.  This is often due to LDAP directory permissions issues.  This
+indicates a failure during the mapping of PRINCIPAL to an LDAP DN.
+
+=item malformed ldap-attr ACL
+
+The ACL parameter to check() was malformed.  Usually this means that
+either the attribute or the value were empty or the required C<=> sign
+separating them was missing.
+
+=item mapping principal to LDAP failed: %s
+
+There was an ldap_map_principal() function defined in the wallet
+configuration, but calling it for the PRINCIPAL argument failed.
+
+=item no principal specified
+
+The PRINCIPAL parameter to check() was undefined or the empty string.
+
+=back
+
+=head1 SEE ALSO
+
+Wallet::ACL(3), Wallet::ACL::Base(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 AUTHOR
+
+Russ Allbery <rra@stanford.edu>
+
+=cut
diff --git a/perl/Wallet/Config.pm b/perl/Wallet/Config.pm
index 23a051d..3f53f74 100644
--- a/perl/Wallet/Config.pm
+++ b/perl/Wallet/Config.pm
@@ -378,6 +378,85 @@ our $KEYTAB_REMCTL_PORT;
 
 =back
 
+=head1 LDAP ACL CONFIGURATION
+
+These configuration variables are only needed if you intend to use the
+C<ldap-attr> ACL type (the Wallet::ACL::LDAP::Attribute class).  They
+specify the LDAP server and additional connection and data model
+information required for the wallet to check for the existence of
+attributes.
+
+=over 4
+
+=item LDAP_HOST
+
+The LDAP server name to use to verify LDAP ACLs.  This variable must be
+set to use LDAP ACLs.
+
+=cut
+
+our $LDAP_HOST;
+
+=item LDAP_BASE
+
+The base DN under which to search for the entry corresponding to a
+principal.  Currently, the wallet always does a full subtree search under
+this base DN.  This variable must be set to use LDAP ACLs.
+
+=cut
+
+our $LDAP_BASE;
+
+=item LDAP_FILTER_ATTR
+
+The attribute used to find the entry corresponding to a principal.  The
+LDAP entry containing this attribute with a value equal to the principal
+will be found and checked for the required attribute and value.  If this
+variable is not set, the default is C<krb5PrincipalName>.
+
+=cut
+
+our $LDAP_FILTER_ATTR;
+
+=item LDAP_CACHE
+
+Specifies the Kerberos ticket cache to use when connecting to the LDAP
+server.  GSS-API authentication is always used; there is currently no
+support for any other type of bind.  The ticket cache must be for a
+principal with access to verify the values of attributes that will be used
+with this ACL type.  This variable must be set to use LDAP ACLs.
+
+=cut
+
+our $LDAP_CACHE;
+
+=back
+
+Finally, depending on the structure of the LDAP directory being queried,
+there may not be any attribute in the directory whose value exactly
+matches the Kerberos principal.  The attribute designated by
+LDAP_FILTER_ATTR may instead hold a transformation of the principal name
+(such as the principal with the local realm stripped off, or rewritten
+into an LDAP DN form).  If this is the case, define a Perl function named
+ldap_map_attribute.  This function will be called whenever an LDAP
+attribute ACL is being verified.  It will take one argument, the
+principal, and is expected to return the value to search for in the LDAP
+directory server.
+
+For example, if the principal name without the local realm is stored in
+the C<uid> attribute in the directory, set LDAP_FILTER_ATTR to C<uid> and
+then define ldap_map_attribute as follows:
+
+    sub ldap_map_attribute {
+        my ($principal) = @_;
+        $principal =~ s/\@EXAMPLE\.COM$//;
+        return $principal;
+    }
+
+Note that this example only removes the local realm (here, EXAMPLE.COM).
+Any principal from some other realm will be left fully qualified, and then
+presumably will not be found in the directory.
+
 =head1 NETDB ACL CONFIGURATION
 
 These configuration variables are only needed if you intend to use the
diff --git a/perl/Wallet/Schema.pm b/perl/Wallet/Schema.pm
index 7400776..5c6b9ca 100644
--- a/perl/Wallet/Schema.pm
+++ b/perl/Wallet/Schema.pm
@@ -277,6 +277,8 @@ Holds the supported ACL schemes and their corresponding Perl classes:
   insert into acl_schemes (as_name, as_class)
       values ('krb5-regex', 'Wallet::ACL::Krb5::Regex');
   insert into acl_schemes (as_name, as_class)
+      values ('ldap-attr', 'Wallet::ACL::LDAP::Attribute');
+  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/schema.t b/perl/t/schema.t
index ce8a62a..5dd90d1 100755
--- a/perl/t/schema.t
+++ b/perl/t/schema.t
@@ -23,7 +23,7 @@ ok (defined $schema, 'Wallet::Schema creation');
 ok ($schema->isa ('Wallet::Schema'), ' and class verification');
 my @sql = $schema->sql;
 ok (@sql > 0, 'sql() returns something');
-is (scalar (@sql), 31, ' and returns the right number of statements');
+is (scalar (@sql), 32, ' and returns the right number of statements');
 
 # Connect to a database and test create.
 db_setup;
diff --git a/perl/t/verifier-ldap-attr.t b/perl/t/verifier-ldap-attr.t
new file mode 100755
index 0000000..1c84fac
--- /dev/null
+++ b/perl/t/verifier-ldap-attr.t
@@ -0,0 +1,66 @@
+#!/usr/bin/perl -w
+#
+# Tests for the LDAP attribute ACL verifier.
+#
+# This test can only be run by someone local to Stanford with appropriate
+# access to the LDAP server and will be skipped in all other environments.
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2012
+#     The Board of Trustees of the Leland Stanford Junior University
+#
+# See LICENSE for licensing terms.
+
+use Test::More tests => 10;
+
+use lib 't/lib';
+use Util;
+
+BEGIN { use_ok ('Wallet::ACL::LDAP::Attribute') };
+
+my $host   = 'ldap.stanford.edu';
+my $base   = 'cn=people,dc=stanford,dc=edu';
+my $filter = 'uid';
+my $user   = 'rra@stanford.edu';
+my $attr   = 'suPrivilegeGroup';
+my $value  = 'stanford:stanford';
+
+# Remove the realm from principal names.
+package Wallet::Config;
+sub ldap_map_principal {
+    my ($principal) = @_;
+    $principal =~ s/\@.*//;
+    return $principal;
+}
+package main;
+
+# Determine the local principal.
+my $klist = `klist 2>&1` || '';
+SKIP: {
+    skip "tests useful only with Stanford Kerberos tickets", 4
+        unless ($klist =~ /[Pp]rincipal: \S+\@stanford\.edu$/m);
+
+    # Set up our configuration.
+    $Wallet::Config::LDAP_HOST        = $host;
+    $Wallet::Config::LDAP_CACHE       = $ENV{KRB5CCNAME};
+    $Wallet::Config::LDAP_BASE        = $base;
+    $Wallet::Config::LDAP_FILTER_ATTR = $filter;
+
+    # Finally, we can test.
+    my $verifier = eval { Wallet::ACL::LDAP::Attribute->new };
+    isa_ok ($verifier, 'Wallet::ACL::LDAP::Attribute');
+    is ($verifier->check ($user, "$attr=$value"), 1,
+        "Checking $attr=$value succeeds");
+    is ($verifier->error, undef, '...with no error');
+    is ($verifier->check ($user, "$attr=BOGUS"), 0,
+        "Checking $attr=BOGUS fails");
+    is ($verifier->error, undef, '...with no error');
+    is ($verifier->check ($user, "BOGUS=$value"), undef,
+        "Checking BOGUS=$value fails with error");
+    is ($verifier->error,
+        'cannot check LDAP attribute BOGUS for rra: 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');
+}