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