1#!/usr/bin/perl -w
2#-
3# Copyright (c) 2013-2017 Universitetet i Oslo
4# All rights reserved.
5#
6# Redistribution and use in source and binary forms, with or without
7# modification, are permitted provided that the following conditions
8# are met:
9# 1. Redistributions of source code must retain the above copyright
10#    notice, this list of conditions and the following disclaimer.
11# 2. Redistributions in binary form must reproduce the above copyright
12#    notice, this list of conditions and the following disclaimer in the
13#    documentation and/or other materials provided with the distribution.
14# 3. The name of the author may not be used to endorse or promote
15#    products derived from this software without specific prior written
16#    permission.
17#
18# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
19# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
20# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
21# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
22# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
23# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
24# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
25# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
26# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
27# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
28# SUCH DAMAGE.
29#
30# Author: Dag-Erling Smørgrav <d.e.smorgrav@usit.uio.no>
31#
32
33use v5.14;
34use strict;
35use warnings;
36use open qw(:locale);
37use utf8;
38
39use Authen::SASL qw(Perl);
40use Getopt::Std;
41use Net::DNS;
42use Net::LDAP;
43use Net::LDAP::Control::Paged;
44use Net::LDAP::Constant qw(LDAP_CONTROL_PAGED);
45use POSIX;
46use Regexp::Common qw(pattern);
47use Socket qw(AF_INET AF_INET6
48    SOCK_DGRAM SOCK_STREAM
49    getaddrinfo getnameinfo
50    AI_CANONNAME NI_NUMERICHOST NI_NUMERICSERV);
51use Try::Tiny;
52
53our $VERSION = '20170424';
54
55# Regexp for paths (POSIX portable filename character set)
56pattern
57    name => [ qw(path pfcs) ],
58    create => '/?(?:[0-9A-Za-z._-]+/)*[0-9A-Za-z._-]+',
59    ;
60
61our $opt_4;			# Include IPv4 addresses
62our $opt_6;			# Include IPv6 addresses
63our $opt_b;			# LDAP base
64our $opt_d;			# LDAP domain
65our $opt_F;			# Never flush
66our $opt_f;			# Persistence directory
67our $opt_h;			# Hostname
68our $opt_n;			# Dry run
69our $opt_P;			# Page size
70our $opt_p;			# Preserve existing addresses
71our $opt_s;			# LDAP server
72our $opt_t;			# Table name
73our $opt_u;			# LDAP user
74our $opt_v;			# Verbose mode
75
76our %rrs;
77
78our $filedir;			# Persistence directory
79our $host;			# Hostname
80our $domain;			# DNS and LDAP domain
81our $user;			# LDAP user
82our @servers;			# LDAP servers
83our $base;			# LDAP search base
84
85our $sasl;			# SASL context
86our $ldap;			# LDAP connection
87
88#
89# Print a message if in verbose mode.
90#
91sub verbose(@) {
92
93    if ($opt_v) {
94	my $msg = join('', @_);
95	$msg =~ s/\n*$/\n/s;
96	print(STDERR $msg);
97    }
98}
99
100#
101# Quote a command line so it can be printed in a form that can be
102# executed.
103#
104sub quote(@) {
105    return map {
106	m/[!\#\$\&\(\)\;\<\>\[\\\]\`\{\|\}\~\s]/ ? "'" . s/([\'\\])/\\$1/gr . "'" : $_;
107    } @_;
108}
109
110#
111# Run an LDAP search and return the result as an array of lines.
112#
113sub ldap_search($;@) {
114    my ($filter, @attrs) = @_;
115
116    verbose("# Looking for $filter in $base");
117    my $page = new Net::LDAP::Control::Paged(size => $opt_P || 250);
118    my %records;
119    while (1) {
120	my $res = $ldap->search(base => $base,
121				filter => $filter,
122				attrs => @attrs ? \@attrs : undef,
123				control => [ $page ]);
124	if ($res->code()) {
125	    die("failed to search LDAP directory: " . $res->error . "\n");
126	}
127	%records = (%records, %{$res->as_struct()});
128	my $control = $res->control(LDAP_CONTROL_PAGED)
129	    or last;
130	my $cookie = $control->cookie
131	    or last;
132	verbose("# next page (", int(keys %records), ")");
133	$page->cookie($cookie);
134    }
135    verbose("# last page (", int(keys %records), ")");
136    return \%records;
137}
138
139#
140# Look up a group by common name
141#
142sub ldap_lookup_group($;@) {
143    my ($cn, @attrs) = @_;
144
145    return ldap_search("(\&(objectclass=group)(name=$cn))", @attrs);
146}
147
148#
149# Look up a specific object in the LDAP directory
150#
151sub ldap_lookup_dn($;@) {
152    my ($dn, @attrs) = @_;
153
154    my $res = ldap_search("(distinguishedname=$dn)", @attrs)
155	or return undef;
156    return $$res{$dn};
157}
158
159our %group_cache;
160
161#
162# Look up a group recursively in the LDAP directory and return a
163# deduplicated list of the DNS names of its members.
164#
165sub ldap_resolve_group_r($$);
166sub ldap_resolve_group_r($$) {
167    my ($dn, $obj) = @_;
168    my %hostnames;
169
170    verbose("# resolving $dn");
171    map({ $hostnames{$_} = 1 } @{$$obj{dnshostname}});
172    foreach my $dn (@{$$obj{member}}) {
173	my $obj = ldap_lookup_dn($dn, qw(objectclass member dnshostname))
174	    or next;
175	map({ $hostnames{$_} = 1 } ldap_resolve_group_r($dn, $obj));
176    }
177    return keys(%hostnames);
178}
179
180sub ldap_resolve_group($) {
181    my ($group) = @_;
182
183    # Look it up
184    if (!$group_cache{$group}) {
185	my $res = ldap_lookup_group($group, qw(member));
186	while (my ($dn, $obj) = each %$res) {
187	    map({ $group_cache{$group}->{lc($_)} = 1 }
188		ldap_resolve_group_r($dn, $obj));
189	}
190    }
191    return keys(%{$group_cache{$group}});
192}
193
194
195
196#
197# This section was copied from srv2pf.pl and should probably go into a
198# shared module.
199#
200
201our $resolver;
202our %dns_cache;
203
204#
205# Recursively resolve CNAME, A and AAAA records for a given DNS name
206#
207sub dns_lookup($);
208sub dns_lookup($) {
209    my ($dnsname) = @_;
210
211    return $dnsname
212	if $dnsname =~ m/^($RE{net}{IPv4}|$RE{net}{IPv6})$/o;
213    if (!$dns_cache{$dnsname}) {
214	$resolver //= Net::DNS::Resolver->new;
215	verbose("# looking up $dnsname");
216	my %answers;
217	foreach my $rr ('CNAME', keys %rrs) {
218	    next unless my $query = $resolver->query($dnsname, $rr, 'IN');
219	    foreach my $res ($query->answer) {
220		verbose("# ", $res->string);
221		if ($res->type eq 'CNAME') {
222		    map({ $answers{$_}++ } dns_lookup($res->cname));
223		} elsif ($rrs{$res->type}) {
224		    $answers{$res->address}++;
225		}
226	    }
227	}
228	$dns_cache{$dnsname} = [ keys %answers ];
229    }
230    return @{$dns_cache{$dnsname}}
231}
232
233#
234# Look up an SRV record
235#
236sub srv_lookup($$;$) {
237    my ($name, $service, $transport) = @_;
238
239    $transport //= "tcp";
240    $resolver //= Net::DNS::Resolver->new;
241    my $dnsname = "_$service._$transport.$name";
242    my $type = 'SRV';
243    verbose("# looking up $type for $dnsname");
244    my $query = $resolver->query($dnsname, $type, 'IN')
245	or return ();
246    my %answers;
247    map({ $answers{$_->target}++ } $query->answer);
248    return keys %answers;
249}
250
251
252
253#
254# Look up all hosts in a list and return a deduplicated list of their
255# addresses.
256#
257sub dns_lookup_hosts(@) {
258    my (@members) = @_;
259
260    my %addresses;
261    map({ map({ ++$addresses{$_} } dns_lookup($_)) } @members);
262    return keys(%addresses);
263}
264
265#
266# Look up a group of hosts in the LDAP directory, resolve their
267# addresses, and create or update matching PF tables.
268#
269sub ldap2pf($) {
270    my ($group) = @_;
271
272    # Perform LDAP and DNS lookup
273    my @addresses = dns_lookup_hosts(ldap_resolve_group($group));
274    @addresses = (sort(grep { /\./ } @addresses),
275		  sort(grep { /:/ } @addresses));
276    if ($opt_F && !@addresses) {
277	verbose("# not flushing $group");
278	return undef;
279    }
280
281    # Store addresses to file
282    if ($filedir) {
283	my $file = "$filedir/$group";
284	my ($filetext, $tmpfiletext);
285	my $tmpfile = "$file.$$";
286	if (open(my $fh, "<", $file)) {
287	    local $/;
288	    $filetext = <$fh>;
289	    close($fh);
290	} else {
291	    $filetext = "";
292	}
293	$tmpfiletext = @addresses ? join("\n", @addresses) . "\n" : "";
294	if ($filetext eq $tmpfiletext) {
295	    verbose("# $file has not changed");
296	} elsif (!$opt_n && !open(my $fh, ">", $tmpfile)) {
297	    warn("$tmpfile: $!\n");
298	} else {
299	    try {
300		verbose("# writing the table to $tmpfile");
301		if (!$opt_n && !print($fh $tmpfiletext)) {
302		    die("print($tmpfile): $!\n");
303		}
304		verbose("# renaming $tmpfile to $file");
305		if (!$opt_n && !rename($tmpfile, $file)) {
306		    die("rename($tmpfile, $file): $!\n");
307		}
308	    } catch {
309		warn($_);
310		verbose("# deleting $tmpfile");
311		unlink($tmpfile);
312	    } finally {
313		if (!$opt_n) {
314		    close($fh);
315		}
316	    };
317	}
318    }
319
320    # Create or update table
321    my @pfctl_cmd = ('/sbin/pfctl');
322    push(@pfctl_cmd, '-q')
323	unless $opt_v;
324    push(@pfctl_cmd, '-t', $group, '-T');
325    if (@addresses) {
326	push(@pfctl_cmd, $opt_p ? 'add' : 'replace', @addresses);
327    } else {
328	return if $opt_p;
329	push(@pfctl_cmd, 'flush');
330    }
331    verbose(join(' ', quote(@pfctl_cmd)));
332    if (!$opt_n) {
333	system(@pfctl_cmd);
334    }
335}
336
337#
338# Print usage string and exit.
339#
340sub usage() {
341
342    print(STDERR
343	  "usage: ldap2pf [-46Fnpv] [-b base] [-d domain] [-f path] [-h host]\n",
344	  "           [-P page size] [-s servers] [-u user] group ...\n");
345    exit(1);
346}
347
348#
349# Main program - set defaults, validate and apply command-line
350# arguments, then iterate over specified groups.
351#
352MAIN:{
353    $ENV{PATH} = '';
354    usage() unless @ARGV;
355    if (!getopts('46b:d:Ff:h:nps:u:v') || @ARGV < 1) {
356	usage();
357    }
358
359    # Preserve implies no-flush
360    $opt_F ||= $opt_p;
361
362    # Filename
363    if ($opt_f) {
364	die("invalid file name\n")
365	    unless $opt_f =~ m/^($RE{path}{pfcs})$/o;
366	$filedir = $1;
367	die("$filedir is not a directory\n")
368	    unless -d $filedir;
369    }
370
371    # Address families
372    $rrs{A} = 1 if $opt_4 || !$opt_6;
373    $rrs{AAAA} = 1 if $opt_6 || !$opt_4;
374
375    # Hostname
376    $host = $opt_h // [ POSIX::uname() ]->[1];
377    die("invalid hostname: $host")
378	unless $host =~ m/^($RE{net}{domain})$/o;
379    $host = lc($1);
380    verbose("# host: $host");
381
382    # Domain
383    if ($opt_d) {
384	die("invalid domain: $domain\n")
385	    unless $opt_d =~ m/^($RE{net}{domain})$/o;
386	$domain = lc($1);
387    } else {
388        die("unable to derive domain from hostname\n")
389            unless $host =~ m/^[^.]+\.($RE{net}{domain})$/o;
390	$domain = $1;
391    }
392    verbose("# domain: $domain");
393
394    # User
395    $user = $opt_u // POSIX::getlogin();
396    die("invalid user: $user\n")
397	unless $user =~ m/^([\w-]+(?:\@$RE{net}{domain})?)$/o;
398    $user = $1;
399    $user = "$user\@$domain"
400	unless $user =~ m/\@/;
401    verbose("# user: $user");
402
403    # LDAP servers
404    if ($opt_s) {
405	@servers = split(',', $opt_s);
406    } else {
407	@servers = srv_lookup($domain, 'ldap');
408	die("unable to retrieve LDAP servers from DNS\n")
409	    unless @servers;
410    }
411    foreach (@servers) {
412	die("invalid server: $_\n")
413	    unless m/^($RE{net}{domain})\.?$/o;
414	$_ = $1;
415    }
416    verbose("# servers: ", join(' ', @servers));
417
418    # Search base
419    if ($opt_b) {
420	die("invalid base: $opt_b\n")
421	    unless $opt_b =~ m/^(DC=[0-9a-z-]+(?:,DC=[0-9a-z-]+)*)$/o;
422	$base = $1;
423    } else {
424	$base = join(',', map({ "DC=$_" } split(/[.]/, $domain)));
425    }
426    verbose("# base: $base");
427
428    # Connect to LDAP server
429    foreach (@servers) {
430	verbose("# Attempting to connect to $_");
431	try {
432	    $sasl = new Authen::SASL(mechanism => 'GSSAPI',
433				     callback => {
434					 user => $user,
435					 password => '',
436				     });
437	    $sasl = $sasl->client_new('ldap', $_);
438	    $ldap = new Net::LDAP($_, onerror => 'die')
439		or die("$@\n");
440	    $ldap->bind(sasl => $sasl);
441	} catch {
442	    verbose("# unable to connect to LDAP server: $_\n");
443	    $ldap = undef;
444	};
445	last if $ldap;
446    }
447    die("failed to connect to an LDAP server\n")
448	unless $ldap;
449
450    # Process groups from command line
451    foreach (@ARGV) {
452	if (!m/^(\w(?:[\w-]*\w)?)$/) {
453	    warn("invalid argument: $_\n");
454	    next;
455	}
456	ldap2pf($1);
457    }
458
459    # Work around bug in Net::LDAP
460    $SIG{__DIE__} = sub { exit 0 };
461}
462
463__END__
464
465=encoding utf8
466
467=head1 NAME
468
469B<ldap2pf> - Create and update PF tables from LDAP groups
470
471=head1 SYNOPSIS
472
473B<ldap2pf> [B<-46Fnpv>] S<[B<-b> I<base>]> S<[B<-d> I<domain>]> S<[B<-f> I<path>]> S<[B<-h> I<host>]> S<[B<-P> I<page size>]> S<[B<-s> I<servers>]> S<[B<-u> I<user>[I<@domain>]]> I<group> I<...>
474
475=head1 DESCRIPTION
476
477The B<ldap2pf> utility creates and updates PF address tables based on
478group memberships in an LDAP directory.
479
480For each group name specified on the command line, the B<ldap2pf>
481utility searches the LDAP directory for group objects bearing that
482name.  It then resolves the membership of these groups recursively,
483collects the I<DNSHostName> attributes of all member objects, and
484looks up I<A> and / or I<AAAA> DNS records for these names.
485
486If no errors occured during this process, a PF address table with the
487same name as the LDAP group is either created or updated to match the
488list of IP addresses that were discovered.  If the table already
489exists, its contents are replaced with the list that was obtained from
490the LDAP directory, unless the B<-p> option was specified, in which
491case the table is treated as append-only.
492
493The following options are available:
494
495=over
496
497=item B<-4>
498
499Include IPv4 addresses in the table.  If neither B<-4> nor B<-6> is
500specified, the default is to include both IPv4 and IPv6 addresses.
501
502=item B<-6>
503
504Include IPv6 addresses in the table.  If neither B<-4> nor B<-6> is
505specified, the default is to include both IPv4 and IPv6 addresses.
506
507=item B<-b> I<base>
508
509The search base for LDAP lookups.  The default is derived from the
510LDAP domain.
511
512=item B<-d> I<domain>
513
514The LDAP domain.  The default is derived from the host name.
515
516=item B<-F>
517
518Never flush a table.  If an LDAP lookup does not return any results,
519assume that something is wrong and terminate without updating the
520table or file.
521
522=item B<-f> I<path>
523
524The path to a directory in which to store each table as a separate
525file, named for the group it represents.  The default is to not store
526the tables to disk.
527
528=item B<-h> I<host>
529
530The client's host name.  The default is whatever L<uname(3)> returns.
531
532=item B<-n>
533
534Perform all LDAP and DNS lookups, but do not create or update any PF
535tables.
536
537=item B<-P> I<page size>
538
539The page size to use for LDAP requests.  The default is 250.
540
541=item B<-p>
542
543Preserve existing table entries even if they are no longer members of
544the corresponding group.  Implies B<-F>.
545
546This does not apply to the file generated with the B<-f> option, which
547will only contain the addresses retrieved from LDAP and DNS.
548
549=item B<-s> I<servers>
550
551A comma-separated list of LDAP server names.  The default is to
552perform an I<SRV> lookup.
553
554=item B<-u> I<user>[I<@domain>]
555
556The user name used to bind to the LDAP server, with or without domain
557qualifier.  The default is the name of the current user.
558
559=item B<-v>
560
561Show progress and debugging information.
562
563=back
564
565=head1 IMPLEMENTATION NOTES
566
567The B<ldap2pf> utility was designed for use with Microsoft Active
568Directory servers, and assumes that the server supports and requires
569GSSAPI authentication and that a valid Kerberos ticket is available.
570
571=head1 EXAMPLES
572
573Update a table named I<mx> used to allow traffic to and from the
574organisation's mail servers:
575
576    % grep -w mx /etc/pf.conf
577    table <mx> persist
578    pass in on egress proto tcp from any to <mx> port { smtp, smtps }
579    pass out on dmz proto tcp from any to <mx> port { smtp, smtps }
580    pass in on dmz proto tcp from <mx> to any port { smtp, smtps }
581    pass out on egress proto tcp from <mx> to any port { smtp, smtps }
582    pass in on int proto tcp from int:network to <mx> port { smtp, smtps }
583    pass out on dmz proto tcp from int:network to <mx> port { smtp, smtps }
584    % sudo env KRB5CCNAME=/var/db/ro_user.cc ldap2pf -pv -u ro_user mx
585    # host: client.example.com
586    # domain: example.com
587    # user: ro_user@example.com
588    # looking up SRV for _ldap._tcp.example.com
589    # servers: dc01.example.com dc02.example.com
590    # base: DC=example,DC=com
591    # Attempting to connect to dc01.example.com
592    # Looking for (&(objectclass=group)(name=mx)) in DC=example,DC=com
593    # last page (1)
594    # resolving CN=mx,OU=roles,OU=hostpolicies,DC=example,DC=com
595    # Looking for (distinguishedname=CN=mx01,OU=hosts,DC=example,DC=com) in DC=example,DC=com
596    # last page (1)
597    # resolving CN=mx01,OU=hosts,DC=example,DC=com
598    # Looking for (distinguishedname=CN=mx02,OU=hosts,DC=example,DC=com) in DC=example,DC=com
599    # last page (1)
600    # resolving CN=mx02,OU=hosts,DC=example,DC=com
601    # looking up mx01.example.com
602    # mx01.example.com.    3600    IN      AAAA    2001:db8:0:42::2501
603    # mx01.example.com.    3600    IN      A       198.51.100.251
604    # looking up mx02.example.com
605    # mx02.example.com.    3600    IN      AAAA    2001:db8:0:42::2502
606    # mx02.example.com.    3600    IN      A       198.51.100.252
607    /sbin/pfctl -t mx -T add 198.51.100.251 198.51.100.252 2001:db8:0:42:0:0:0:2501 2001:db8:0:42:0:0:0:2502
608    No ALTQ support in kernel
609    ALTQ related functions disabled
610    4/4 addresses added.
611
612=head1 SEE ALSO
613
614L<kinit(1)>, L<pf(4)>, L<pfctl(8)>
615
616=head1 AUTHOR
617
618The B<ldap2pf> utility was written by Dag-Erling Smørgrav
619<d.e.smorgrav@usit.uio.no> for the University of Oslo.
620
621=cut
622