summaryrefslogtreecommitdiff
path: root/perl/Wallet/ACL/NetDB.pm
blob: 2d35f4925a00a16d6dfd7bdbbccc6de253de88ad (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
# Wallet::ACL::NetDB -- Wallet NetDB role ACL verifier.
#
# Written by Russ Allbery <rra@stanford.edu>
# Copyright 2007, 2010
#     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 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 <rra@stanford.edu>

=cut