diff options
Diffstat (limited to 'perl/lib/Wallet/ACL')
| -rw-r--r-- | perl/lib/Wallet/ACL/Base.pm | 126 | ||||
| -rw-r--r-- | perl/lib/Wallet/ACL/Krb5.pm | 126 | ||||
| -rw-r--r-- | perl/lib/Wallet/ACL/Krb5/Regex.pm | 134 | ||||
| -rw-r--r-- | perl/lib/Wallet/ACL/LDAP/Attribute.pm | 264 | ||||
| -rw-r--r-- | perl/lib/Wallet/ACL/NetDB.pm | 268 | ||||
| -rw-r--r-- | perl/lib/Wallet/ACL/NetDB/Root.pm | 129 | 
6 files changed, 1047 insertions, 0 deletions
| diff --git a/perl/lib/Wallet/ACL/Base.pm b/perl/lib/Wallet/ACL/Base.pm new file mode 100644 index 0000000..a2b07cc --- /dev/null +++ b/perl/lib/Wallet/ACL/Base.pm @@ -0,0 +1,126 @@ +# Wallet::ACL::Base -- Parent class for wallet ACL verifiers. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2010, 2014 +#     The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::ACL::Base; +require 5.006; + +use strict; +use warnings; +use vars qw($VERSION); + +# 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.02'; + +############################################################################## +# 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; +} + +# 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}; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=for stopwords +ACL Allbery verifier verifiers + +=head1 NAME + +Wallet::ACL::Base - Generic parent class for wallet ACL verifiers + +=head1 SYNOPSIS + +    package Wallet::ACL::Simple +    @ISA = qw(Wallet::ACL::Base); +    sub check { +        my ($self, $principal, $acl) = @_; +        return ($principal eq $acl) ? 1 : 0; +    } + +=head1 DESCRIPTION + +Wallet::ACL::Base 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() + +Creates a new ACL verifier.  The generic function provided here just +creates and blesses an object. + +=item check(PRINCIPAL, ACL) + +This method should always be overridden by child classes.  The default +implementation just declines all access. + +=item error([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. + +For the convenience of child classes, this method can also be called with +one or more error strings.  If so, those strings are concatenated +together, trailing newlines are removed, any text of the form S<C< at \S+ +line \d+\.?>> at the end of the message is stripped off, and the result is +stored as the error.  Only child classes should call this method with an +error string. + +=back + +=head1 SEE ALSO + +Wallet::ACL(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 diff --git a/perl/lib/Wallet/ACL/Krb5.pm b/perl/lib/Wallet/ACL/Krb5.pm new file mode 100644 index 0000000..80d32bd --- /dev/null +++ b/perl/lib/Wallet/ACL/Krb5.pm @@ -0,0 +1,126 @@ +# Wallet::ACL::Krb5 -- Wallet Kerberos v5 principal ACL verifier. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2010, 2014 +#     The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::ACL::Krb5; +require 5.006; + +use strict; +use warnings; +use vars qw(@ISA $VERSION); + +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.02'; + +############################################################################## +# 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; +    } +    unless ($acl) { +        $self->error ('malformed krb5 ACL'); +        return; +    } +    return ($principal eq $acl) ? 1 : 0; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=for stopwords +ACL krb5 Allbery verifier + +=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 C<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() + +Creates a new ACL verifier.  For this verifier, there is no setup work. + +=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 + +Wallet::ACL(3), 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 diff --git a/perl/lib/Wallet/ACL/Krb5/Regex.pm b/perl/lib/Wallet/ACL/Krb5/Regex.pm new file mode 100644 index 0000000..4934cfc --- /dev/null +++ b/perl/lib/Wallet/ACL/Krb5/Regex.pm @@ -0,0 +1,134 @@ +# Wallet::ACL::Krb5::Regex -- Wallet Kerberos v5 principal regex ACL verifier +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2010, 2014 +#     The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::ACL::Krb5::Regex; +require 5.006; + +use strict; +use warnings; +use vars qw(@ISA $VERSION); + +use Wallet::ACL::Krb5; + +@ISA = qw(Wallet::ACL::Krb5); + +# 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 +############################################################################## + +# Returns true if the Perl regular expression specified by the ACL matches +# the provided Kerberos principal. +sub check { +    my ($self, $principal, $acl) = @_; +    unless ($principal) { +        $self->error ('no principal specified'); +        return; +    } +    unless ($acl) { +        $self->error ('no ACL specified'); +        return; +    } +    my $regex = eval { qr/$acl/ }; +    if ($@) { +        $self->error ('malformed krb5-regex ACL'); +        return; +    } +    return ($principal =~ m/$regex/) ? 1 : 0; +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=for stopwords +ACL krb5-regex Durkacz Allbery verifier + +=head1 NAME + +Wallet::ACL::Krb5::Regex - Regex wallet ACL verifier for Kerberos principals + +=head1 SYNOPSIS + +    my $verifier = Wallet::ACL::Krb5::Regex->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::Regex is the wallet ACL verifier used to verify ACL +lines of type C<krb5-regex>.  The value of such an ACL is a Perl regular +expression, and the ACL grants access to a given Kerberos principal if and +only if the regular expression matches that principal. + +=head1 METHODS + +=over 4 + +=item new() + +Creates a new ACL verifier.  For this verifier, there is no setup work. + +=item check(PRINCIPAL, ACL) + +Returns true if the Perl regular expression specified by the ACL matches the +PRINCIPAL, 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-regex ACL + +The ACL parameter to check() was a malformed Perl regular expression. + +=item no principal specified + +The PRINCIPAL parameter to check() was undefined or the empty string. + +=item no ACL specified + +The ACL parameter to check() was undefined or the empty string. + +=back + +=head1 SEE ALSO + +Wallet::ACL(3), Wallet::ACL::Base(3), Wallet::ACL::Krb5(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 + +Ian Durkacz + +=cut diff --git a/perl/lib/Wallet/ACL/LDAP/Attribute.pm b/perl/lib/Wallet/ACL/LDAP/Attribute.pm new file mode 100644 index 0000000..c27729e --- /dev/null +++ b/perl/lib/Wallet/ACL/LDAP/Attribute.pm @@ -0,0 +1,264 @@ +# Wallet::ACL::LDAP::Attribute -- Wallet LDAP attribute ACL verifier. +# +# Written by Russ Allbery +# Copyright 2012, 2013, 2014 +#     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 warnings; +use vars qw(@ISA $VERSION); + +use Authen::SASL (); +use Net::LDAP qw(LDAP_COMPARE_TRUE); +use Wallet::ACL::Base; +use Wallet::Config; + +@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 verifier LDAP PRINCIPAL's DN ldap-attr + +=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 + +=over 4 + +=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: + +=over 4 + +=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 <eagle@eyrie.org> + +=cut diff --git a/perl/lib/Wallet/ACL/NetDB.pm b/perl/lib/Wallet/ACL/NetDB.pm new file mode 100644 index 0000000..ad2164b --- /dev/null +++ b/perl/lib/Wallet/ACL/NetDB.pm @@ -0,0 +1,268 @@ +# Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier. +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2010, 2014 +#     The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::ACL::NetDB; +require 5.006; + +use strict; +use warnings; +use vars qw(@ISA $VERSION); + +use Wallet::ACL::Base; +use Wallet::Config; + +@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.05'; + +############################################################################## +# Interface +############################################################################## + +# Creates a new persistant verifier.  Load the Net::Remctl module and open a +# persistant remctl connection that we'll use for later calls. +sub new { +    my $type = shift; +    my $host = $Wallet::Config::NETDB_REMCTL_HOST; +    unless ($host and $Wallet::Config::NETDB_REMCTL_CACHE) { +        die "NetDB ACL support not configured\n"; +    } +    eval { require Net::Remctl }; +    if ($@) { +        my $error = $@; +        chomp $error; +        1 while ($error =~ s/ at \S+ line \d+\.?\z//); +        die "NetDB ACL support not available: $error\n"; +    } +    local $ENV{KRB5CCNAME} = $Wallet::Config::NETDB_REMCTL_CACHE; +    my $remctl = Net::Remctl->new; + +    # Net::Remctl 2.12 and later will support passing in an empty string for +    # the principal.  Until then, be careful not to pass principal unless it +    # was specified. +    my $port = $Wallet::Config::NETDB_REMCTL_PORT || 0; +    my $principal = $Wallet::Config::NETDB_REMCTL_PRINCIPAL; +    my $status; +    if (defined $principal) { +        $status = $remctl->open ($host, $port, $principal); +    } else { +        $status = $remctl->open ($host, $port); +    } +    unless ($status) { +        die "cannot connect to NetDB remctl interface: ", $remctl->error, "\n"; +    } +    my $self = { remctl => $remctl }; +    bless ($self, $type); +    return $self; +} + +# Check whether the given principal has one of the user, administrator, or +# admin team roles in NetDB for the given host.  Returns 1 if it does, 0 if it +# doesn't, and undef, setting the error, if there's some failure in making the +# remctl call. +sub check { +    my ($self, $principal, $acl) = @_; +    unless ($principal) { +        $self->error ('no principal specified'); +        return; +    } +    unless ($acl) { +        $self->error ('malformed netdb ACL'); +        return; +    } +    my $remctl = $self->{remctl}; +    if ($Wallet::Config::NETDB_REALM) { +        $principal =~ s/\@\Q$Wallet::Config::NETDB_REALM\E\z//; +    } +    unless ($remctl->command ('netdb', 'node-roles', $principal, $acl)) { +        $self->error ('cannot check NetDB ACL: ' . $remctl->error); +        return; +    } +    my ($roles, $output, $status, $error); +    do { +        $output = $remctl->output; +        if ($output->type eq 'output') { +            if ($output->stream == 1) { +                $roles .= $output->data; +            } else { +                $error .= $output->data; +            } +        } elsif ($output->type eq 'error') { +            $self->error ('cannot check NetDB ACL: ' . $output->data); +            return; +        } elsif ($output->type eq 'status') { +            $status = $output->status; +        } else { +            $self->error ('malformed NetDB remctl token: ' . $output->type); +            return; +        } +    } while ($output->type eq 'output'); +    if ($status == 0) { +        $roles ||= ''; +        my @roles = split (' ', $roles); +        for my $role (@roles) { +            return 1 if $role eq 'admin'; +            return 1 if $role eq 'team'; +            return 1 if $role eq 'user'; +        } +        return 0; +    } else { +        if ($error) { +            chomp $error; +            $error =~ s/\n/ /g; +            $self->error ("error checking NetDB ACL: $error"); +        } else { +            $self->error ("error checking NetDB ACL"); +        } +        return; +    } +} + +1; +__END__ + +############################################################################## +# Documentation +############################################################################## + +=for stopwords +ACL NetDB remctl DNS DHCP Allbery netdb verifier + +=head1 NAME + +Wallet::ACL::NetDB - Wallet ACL verifier for NetDB roles + +=head1 SYNOPSIS + +    my $verifier = Wallet::ACL::NetDB->new; +    my $status = $verifier->check ($principal, $node); +    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::NetDB checks a principal against the NetDB roles for a given +host.  It is used to verify ACL lines of type C<netdb>.  The value of such +an ACL is a node, and the ACL grants access to a given principal if and +only if that principal has one of the roles user, admin, or team for that +node. + +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 + +=over 4 + +=item new() + +Creates a new ACL verifier.  Opens the remctl connection to the NetDB +server and authenticates. + +=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 is a node, +and PRINCIPAL will be granted access if it (with the realm stripped off if +configured) has the user, admin, or team role for that node. + +=item error() + +Returns the error if check() returned undef. + +=back + +=head1 DIAGNOSTICS + +The new() method may fail with one of the following exceptions: + +=over 4 + +=item NetDB ACL support not available: %s + +The Net::Remctl Perl module, required for NetDB ACL support, could not be +loaded. + +=item NetDB 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. + +=item cannot connect to NetDB remctl interface: %s + +Connecting to the NetDB remctl interface failed with the given error +message. + +=back + +Verifying a NetDB ACL may fail with the following errors (returned by the +error() method): + +=over 4 + +=item cannot check NetDB ACL: %s + +Issuing the remctl command to get the roles for the given principal failed +or returned an error. + +=item error checking NetDB ACL: %s + +The NetDB remctl interface that returns the roles for a user returned an +error message or otherwise returned failure. + +=item malformed netdb ACL + +The ACL parameter to check() was malformed.  Currently, this error is only +given if ACL is undefined or the empty string. + +=item malformed NetDB remctl token: %s + +The Net::Remctl Perl library returned a malformed token.  This should +never happen and indicates a bug in Net::Remctl. + +=item no principal specified + +The PRINCIPAL parameter to check() was undefined or the empty string. + +=back + +=head1 CAVEATS + +The list of possible NetDB roles that should be considered sufficient to +grant access is not currently configurable. + +=head1 SEE ALSO + +Net::Remctl(3), Wallet::ACL(3), Wallet::ACL::Base(3), Wallet::Config(3), +wallet-backend(8) + +NetDB is a free software system for managing DNS, DHCP, and related +machine information for large organizations.  For more information on +NetDB, see L<http://www.stanford.edu/group/networking/netdb/>. + +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 diff --git a/perl/lib/Wallet/ACL/NetDB/Root.pm b/perl/lib/Wallet/ACL/NetDB/Root.pm new file mode 100644 index 0000000..34163e7 --- /dev/null +++ b/perl/lib/Wallet/ACL/NetDB/Root.pm @@ -0,0 +1,129 @@ +# Wallet::ACL::NetDB::Root -- Wallet NetDB role ACL verifier (root instances). +# +# Written by Russ Allbery <eagle@eyrie.org> +# Copyright 2007, 2010, 2014 +#     The Board of Trustees of the Leland Stanford Junior University +# +# See LICENSE for licensing terms. + +############################################################################## +# Modules and declarations +############################################################################## + +package Wallet::ACL::NetDB::Root; +require 5.006; + +use strict; +use warnings; +use vars qw(@ISA $VERSION); + +use Wallet::ACL::NetDB; +use Wallet::Config; + +@ISA = qw(Wallet::ACL::NetDB); + +# 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.02'; + +############################################################################## +# Interface +############################################################################## + +# Override the check method of Wallet::ACL::NetDB 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) = @_; +    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 NetDB DNS DHCP Allbery verifier + +=head1 NAME + +Wallet::ACL::NetDB::Root - Wallet ACL verifier for NetDB roles (root instances) + +=head1 SYNOPSIS + +    my $verifier = Wallet::ACL::NetDB::Root->new; +    my $status = $verifier->check ($principal, $node); +    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::NetDB::Root works identically to Wallet::ACL::NetDB 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 NetDB roles.  As with the base +NetDB ACL verifier, the value of a C<netdb-root> ACL is a node, and the +ACL grants access to a given principal if and only if the that principal +(with C</root> stripped) has one of the roles user, admin, or team for +that node. + +To use this object, the same configuration parameters must be set as for +Wallet::ACL::NetDB.  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 is a node, +and PRINCIPAL will be granted access if it has an instance of C<root> and +if (with C</root> stripped off and the realm stripped off if configured) +has the user, admin, or team role for that node. + +=back + +=head1 DIAGNOSTICS + +Same as for Wallet::ACL::NetDB. + +=head1 CAVEATS + +The instance to strip is not currently configurable. + +The list of possible NetDB roles that should be considered sufficient to +grant access is not currently configurable. + +=head1 SEE ALSO + +Net::Remctl(3), Wallet::ACL(3), Wallet::ACL::Base(3), +Wallet::ACL::NetDB(3), Wallet::Config(3), wallet-backend(8) + +NetDB is a free software system for managing DNS, DHCP, and related +machine information for large organizations.  For more information on +NetDB, see L<http://www.stanford.edu/group/networking/netdb/>. + +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 | 
