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