2 files changed, 228 insertions, 0 deletions
diff --git a/perl/Wallet/ACL.pm b/perl/Wallet/ACL.pm
new file mode 100644
index 0000000..d22385e
--- /dev/null
+++ b/perl/Wallet/ACL.pm
@@ -0,0 +1,108 @@
+# Wallet::ACL -- Parent class for wallet ACL verifiers.
+# $Id$
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2007 Board of Trustees, Leland Stanford Jr. University
+#
+# See README for licensing terms.
+
+##############################################################################
+# Modules and declarations
+##############################################################################
+
+package Wallet::ACL;
+require 5.006;
+
+use strict;
+
+# 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
+##############################################################################
+
+# Creates a new persistant verifier, taking a database handle.  This parent
+# class just creates an empty object and ignores the handle.  Child classes
+# should override if there are necessary initialization tasks or if the handle
+# will be used by the verifier.
+sub new {
+    my $type = shift;
+    my $self = {};
+    bless ($self, $type);
+    return $self;
+}
+
+# The default check method denies all access.
+sub check {
+    return 0;
+}
+
+# Return the error stashed in the object.
+sub error {
+    my ($self) = @_;
+    return $self->{error};
+}
+
+1;
+__END__
+
+##############################################################################
+# Documentation
+##############################################################################
+
+=head1 NAME
+
+Wallet::ACL - Generic parent class for wallet ACL verifiers
+
+=head1 SYNOPSIS
+
+    package Wallet::ACL::Simple
+    @ISA = qw(Wallet::ACL);
+    sub check {
+        my ($self, $principal, $acl) = @_;
+        return ($principal eq $acl) ? 1 : 0;
+    }
+
+=head1 DESCRIPTION
+
+Wallet::ACL is the generic parent class for wallet ACL verifiers.  It
+provides default functions and behavior and all ACL verifiers should inherit
+from it.  It is not used directly.
+
+=head1 METHODS
+
+=over 4
+
+=item new(DBH)
+
+Creates a new ACL verifier.  The generic function provided here just creates
+and blesses an object and ignores the provided database handle.
+
+=item check(PRINCIPAL, ACL)
+
+This method should always be overridden by child classes.  The default
+implementation just declines all access.
+
+=item error()
+
+Returns whatever is stored in the error key of the object hash.  Child
+classes should store error messages in that key when returning undef from
+check().
+
+=back
+
+=head1 SEE ALSO
+
+walletd(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/ACL/Krb5.pm b/perl/Wallet/ACL/Krb5.pm
new file mode 100644
index 0000000..c5e8527
--- /dev/null
+++ b/perl/Wallet/ACL/Krb5.pm
@@ -0,0 +1,120 @@
+# Wallet::ACL::Krb5 -- Wallet Kerberos v5 principal ACL verifier.
+# $Id$
+#
+# Written by Russ Allbery <rra@stanford.edu>
+# Copyright 2007 Board of Trustees, Leland Stanford Jr. University
+#
+# See README for licensing terms.
+
+##############################################################################
+# Modules and declarations
+##############################################################################
+
+package Wallet::ACL::Krb5;
+require 5.006;
+
+use strict;
+use vars qw(@ISA);
+
+@ISA = qw(Wallet::ACL);
+
+# 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
+##############################################################################
+
+# The most trivial ACL verifier.  Returns true if the provided principal
+# matches the ACL.
+sub check {
+    my ($self, $principal, $acl) = @_;
+    unless ($principal) {
+        $self->{error} = 'no principal specified';
+        return undef;
+    }
+    unless ($acl) {
+        $self->{error} = 'malformed krb5 ACL';
+        return undef;
+    }
+    return ($principal eq $acl) ? 1 : 0;
+}
+
+1;
+__END__
+
+##############################################################################
+# Documentation
+##############################################################################
+
+=head1 NAME
+
+Wallet::ACL::Krb5 - Simple wallet ACL verifier for Kerberos principals
+
+=head1 SYNOPSIS
+
+    my $verifier = Wallet::ACL::Krb5->new;
+    my $status = $verifier->check ($principal, $acl);
+    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::Krb5 is the simplest wallet ACL verifier, used to verify ACL
+lines of type krb5.  The value of such an ACL is a simple Kerberos
+principal in its text display form, and the ACL grants access to a given
+principal if and only if the principal exactly matches the ACL.
+
+=head1 METHODS
+
+=over 4
+
+=item new(DBH)
+
+Creates a new ACL verifier.  The database handle is not used.
+
+=item check(PRINCIPAL, ACL)
+
+Returns true if PRINCIPAL matches ACL, false if not, and undef on an error
+(see L<"DIAGNOSTICS"> below).
+
+=item error()
+
+Returns the error if check() returned undef.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item malformed krb5 ACL
+
+The ACL parameter to check() was malformed.  Currently, this error is only
+given if ACL is undefined or the empty string.
+
+=item no principal specified
+
+The PRINCIPAL parameter to check() was undefined or the empty string.
+
+=back
+
+=head1 SEE ALSO
+
+walletd(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