1#!/usr/bin/perl -w 2#- 3# Copyright (c) 2013-2017 Universitetet i Oslo 4# Copyright (c) 2021 Dag-Erling Smørgrav 5# All rights reserved. 6# 7# Redistribution and use in source and binary forms, with or without 8# modification, are permitted provided that the following conditions 9# are met: 10# 1. Redistributions of source code must retain the above copyright 11# notice, this list of conditions and the following disclaimer. 12# 2. Redistributions in binary form must reproduce the above copyright 13# notice, this list of conditions and the following disclaimer in the 14# documentation and/or other materials provided with the distribution. 15# 3. The name of the author may not be used to endorse or promote 16# products derived from this software without specific prior written 17# permission. 18# 19# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 20# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 21# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 22# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 23# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 24# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 25# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 26# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 27# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 28# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 29# SUCH DAMAGE. 30# 31# Author: Dag-Erling Smørgrav <des@des.no> 32# 33 34use v5.14; 35use strict; 36use warnings; 37use open qw(:locale); 38use utf8; 39 40use Getopt::Std; 41use Net::DNS; 42use Regexp::Common qw(pattern); 43use Try::Tiny; 44 45our $VERSION = '20211010'; 46 47# Regexp for paths (POSIX portable filename character set) 48pattern 49 name => [ qw(path pfcs) ], 50 create => '/?(?:[0-9A-Za-z._-]+/)*[0-9A-Za-z._-]+', 51 ; 52 53our $opt_4; # Include IPv4 addresses 54our $opt_6; # Include IPv6 addresses 55our $opt_F; # Never flush 56our $opt_f; # Save to file 57our $opt_h; # Print help text 58our $opt_n; # Dry run 59our $opt_p; # Preserve existing addresses 60our $opt_t; # Table name 61our $opt_v; # Verbose mode 62 63our %rrs; 64 65our %services = ( 66 22 => 'ssh', 67 53 => 'domain', 68 80 => 'http', 69 123 => 'ntp', 70 443 => 'https', 71); 72 73# 74# Print a message if in verbose mode. 75# 76sub verbose { 77 if ($opt_v) { 78 my $msg = join('', @_); 79 $msg =~ s/\n*$/\n/s; 80 print(STDERR $msg); 81 } 82} 83 84# 85# Quote a command line so it can be printed in a form that can be 86# executed. 87# 88sub quote { 89 return map { 90 m/[!\#\$\&\(\)\;\<\>\[\\\]\`\{\|\}\~\s]/ ? "'" . s/([\'\\])/\\$1/gr . "'" : $_; 91 } @_; 92} 93 94our $resolver; 95our %dns_cache; 96 97# 98# Recursively resolve CNAME, A and AAAA records for a given DNS name 99# 100sub dns_lookup { 101 my ($dnsname) = @_; 102 103 return $dnsname 104 if $dnsname =~ m/^($RE{net}{IPv4}|$RE{net}{IPv6})$/o; 105 if (!$dns_cache{$dnsname}) { 106 $resolver //= Net::DNS::Resolver->new; 107 verbose("# looking up $dnsname"); 108 my %answers; 109 foreach my $rr ('CNAME', keys %rrs) { 110 next unless my $query = $resolver->query($dnsname, $rr, 'IN'); 111 foreach my $res ($query->answer) { 112 verbose("# ", $res->string =~ s/\s+/ /gr); 113 if ($res->type eq 'CNAME') { 114 map({ $answers{$_}++ } dns_lookup($res->cname)); 115 } elsif ($rrs{$res->type}) { 116 $answers{$res->address}++; 117 } else { 118 # can't happen 119 } 120 } 121 } 122 $dns_cache{$dnsname} = [ keys %answers ]; 123 } 124 return @{$dns_cache{$dnsname}} 125} 126 127# 128# Look up an SRV record 129# 130sub srv_lookup { 131 my ($name, $service, $transport) = @_; 132 133 $transport //= "tcp"; 134 $resolver //= Net::DNS::Resolver->new; 135 my $dnsname = "_$service._$transport.$name"; 136 my $type = 'SRV'; 137 verbose("# looking up $type for $dnsname"); 138 my $query = $resolver->query($dnsname, $type, 'IN') 139 or return (); 140 my %answers; 141 foreach my $res ($query->answer) { 142 verbose("# ", $res->string =~ s/\s+/ /gr); 143 if ($res->type eq 'CNAME') { 144 $answers{$res->cname}++; 145 } elsif ($res->type eq 'SRV') { 146 $answers{$res->target}++; 147 } else { 148 # can't happen 149 } 150 } 151 return keys %answers; 152} 153 154sub srv2pf { 155 my ($table, $file, @names) = @_; 156 157 # Targets 158 my %addresses; 159 foreach (@names) { 160 if (m/^($RE{net}{IPv4}|$RE{net}{IPv6})$/ || m/^\[($RE{net}{IPv6})\]$/) { 161 $addresses{$1}++; 162 next; 163 } elsif (m/^($RE{net}{domain}{-nospace})\.?$/) { 164 map({ $addresses{$_}++ } dns_lookup($1)); 165 next; 166 } 167 my ($name, $service, $transport) = split(':'); 168 die("invalid name\n") 169 unless $name =~ m/^($RE{net}{domain}{-nospace})\.?$/; 170 $name = $1; 171 $service ||= "http,https"; 172 die("invalid service\n") 173 unless $service =~ m/^(\w+(?:,\w+)*)$/; 174 my @services = split(',', $1); 175 $transport ||= "tcp"; 176 die("invalid transport\n") 177 unless $transport =~ m/^(tcp(?:,udp)?|udp(?:,tcp))$/; 178 my @transports = split(',', $1); 179 foreach $service (@services) { 180 foreach $transport (@transports) { 181 # SRV lookup 182 map({ $addresses{$_}++ } 183 map({ dns_lookup($_) } 184 srv_lookup($name, $service, $transport))); 185 } 186 } 187 # fallback 188 map({ $addresses{$_}++ } dns_lookup($name)); 189 } 190 my @addresses = keys %addresses; 191 @addresses = (sort(grep { /\./ } @addresses), 192 sort(grep { /:/ } @addresses)); 193 if ($opt_F && !@addresses) { 194 verbose("# not flushing $table"); 195 return undef; 196 } 197 198 # Store addresses to file 199 if ($file) { 200 my ($filetext, $tmpfiletext); 201 my $tmpfile = "$file.$$"; 202 if (open(my $fh, "<", $file)) { 203 local $/; 204 $filetext = <$fh>; 205 close($fh); 206 } else { 207 $filetext = ""; 208 } 209 $tmpfiletext = @addresses ? join("\n", @addresses) . "\n" : ""; 210 if ($filetext eq $tmpfiletext) { 211 verbose("# $file has not changed"); 212 } elsif (!$opt_n && !open(my $fh, ">", $tmpfile)) { 213 warn("$tmpfile: $!\n"); 214 } else { 215 try { 216 verbose("# writing the table to $tmpfile"); 217 if (!$opt_n && !print($fh $tmpfiletext)) { 218 die("print($tmpfile): $!\n"); 219 } 220 verbose("# renaming $tmpfile to $file"); 221 if (!$opt_n && !rename($tmpfile, $file)) { 222 die("rename($tmpfile, $file): $!\n"); 223 } 224 } catch { 225 warn($_); 226 verbose("# deleting $tmpfile"); 227 unlink($tmpfile); 228 } finally { 229 if (!$opt_n) { 230 close($fh); 231 } 232 }; 233 } 234 } 235 236 # Create or update table 237 my @pfctl_cmd = ('/sbin/pfctl'); 238 push(@pfctl_cmd, '-q') 239 unless $opt_v; 240 push(@pfctl_cmd, '-t', $table, '-T'); 241 if (@addresses) { 242 push(@pfctl_cmd, $opt_p ? 'add' : 'replace', @addresses); 243 } else { 244 return if $opt_p; 245 push(@pfctl_cmd, 'flush'); 246 } 247 verbose(join(' ', quote(@pfctl_cmd))); 248 if (!$opt_n) { 249 system(@pfctl_cmd); 250 } 251} 252 253# Print usage string and exit 254sub usage { 255 print(STDERR 256 "usage: srv2pf [-46Fnpv] [-f file] -t table name[:service[:transport]] [...]\n"); 257 exit(1); 258} 259 260MAIN:{ 261 $ENV{PATH} = ''; 262 usage() unless @ARGV; 263 if (!getopts('46Ff:hnpt:v') || $opt_h || @ARGV < 1) { 264 usage(); 265 } 266 267 # Address families 268 $rrs{A} = 1 if $opt_4 || !$opt_6; 269 $rrs{AAAA} = 1 if $opt_6 || !$opt_4; 270 271 # Table 272 die("no table name specified\n") 273 unless defined($opt_t); 274 die("invalid table name\n") 275 unless $opt_t =~ m/^(\w(?:[\w-]*\w)?)$/; 276 $opt_t = $1; 277 278 # Preserve implies no-flush 279 $opt_F ||= $opt_p; 280 281 # File 282 if ($opt_f) { 283 die("invalid file name\n") 284 unless $opt_f =~ m/^($RE{path}{pfcs})$/o; 285 $opt_f = $1; 286 $opt_f .= "/$opt_t" 287 if -d $opt_f; 288 } 289 290 srv2pf($opt_t, $opt_f, @ARGV); 291} 292 293__END__ 294 295=encoding utf8 296 297=head1 NAME 298 299B<srv2pf> - Create and update PF tables from DNS records 300 301=head1 SYNOPSIS 302 303B<srv2pf> [B<-46Fnpv>] [S<B<-f> I<file>>] S<B<-t> I<table>> S<I<name>[B<:>I<service>[B<:>I<transport>]]> [I<...>] 304 305=head1 DESCRIPTION 306 307The B<srv2pf> utility creates and updates PF address tables based on 308DNS records. 309 310For each name specified on the command line, the B<srv2pf> utility 311performs a DNS lookup for I<SRV>, I<CNAME>, I<A> and I<AAAA> records. 312The right-hand side of any I<SRV> and I<CNAME> records encountered are 313resolved recursively. 314 315If no errors occured during this process, a PF address table with the 316name specified on the command line is either created or updated to 317match the list of IP addresses that were found. If the table already 318exists, its contents are replaced with the list that was obtained from 319DNS, unless the B<-p> option was specified, in which case the table is 320treated as append-only. 321 322The following options are available: 323 324=over 325 326=item B<-4> 327 328Include IPv4 addresses in the table. If neither B<-4> nor B<-6> is 329specified, the default is to include both IPv4 and IPv6 addresses. 330 331=item B<-6> 332 333Include IPv6 addresses in the table. If neither B<-4> nor B<-6> is 334specified, the default is to include both IPv4 and IPv6 addresses. 335 336=item B<-F> 337 338Never flush a table. If a DNS lookup does not return any results, 339assume that something is wrong and terminate without updating the 340table or file. 341 342=item B<-f> I<file> 343 344Save the addresses to a file in addition to updating the table. If 345I<file> is a directory, the addresses will be stored in a file bearing 346the name of the table within that directory. The file is written out 347before the table is created or updated. Failure to write the file 348will generate an error message but will not prevent the table from 349being created or updated. 350 351=item B<-t> I<table> 352 353The name of the table to be created or update. This option is 354mandatory. 355 356=item B<-n> 357 358Perform all LDAP and DNS lookups, but do not create or update any PF 359tables or files. 360 361=item B<-p> 362 363Preserve existing table entries even if they are not encountered in 364DNS lookups. Implies B<-F>. 365 366This does not apply to the file generated with the B<-f> option, which 367will only contain the addresses retrieved from DNS. 368 369=item B<-v> 370 371Show progress and debugging information. 372 373=back 374 375Each subsequent argument is either a DNS name or IP address, or a 376service specification consisting of at least two and at most three 377items, separated by colons. The first item is a DNS name. The second 378is a comma-separated list of service names, which defaults to 379I<http,https>. The third is a comma-separated list of transport 380protocols, which defaults to I<tcp>. At least one service 381specification must be provided. 382 383=head1 EXAMPLES 384 385Update a table named I<ldap> used to allow traffic from the 386organization's internal network to its LDAP servers: 387 388 % grep -w ldap /etc/pf.conf 389 table <ldap> persist 390 pass in on int proto tcp from int:network to <ldap> port { ldap, ldaps } 391 pass out on dmz proto tcp from int:network to <ldap> port { ldap, ldaps } 392 % sudo srv2pf -pv -t ldap example.com:ldap:tcp 393 # looking up SRV for _ldap._tcp.example.com 394 # looking up dc01.example.com 395 # dc01.example.com. 50339 IN AAAA 2001:db8:0:42::dc1 396 # dc01.example.com. 50339 IN A 198.51.100.221 397 # looking up dc02.example.com 398 # dc02.example.com. 302 IN AAAA 2001:db8:0:42::dc02 399 # dc02.example.com. 128 IN A 198.51.100.222 400 # looking up example.com 401 /sbin/pfctl -t ldap -T add 198.51.100.221 198.51.100.222 2001:db8:0:42::dc01 2001:db8:0:42::dc02 402 No ALTQ support in kernel 403 ALTQ related functions disabled 404 4/4 addresses added. 405 406=head1 SEE ALSO 407 408L<pf(4)>, L<pfctl(8)> 409 410=head1 AUTHOR 411 412The B<srv2pf> utility was written by Dag-Erling Smørgrav <des@des.no> 413for the University of Oslo. 414 415=cut 416