|
1
2
3
4
5
|
#!/usr/bin/perl
#
# dyndns.pl - CGI-BIN script to handle Dynamic DNS updates through http
#
|
|
6
|
# Version 1.1, latest version, documentation and bugtracker available at:
|
|
7
|
# https://gitlab.lindenaar.net/scripts/dyndns
|
|
8
|
#
|
|
9
|
# Copyright (c) 2013 - 2019 Frederik Lindenaar
|
|
10
|
#
|
|
11
12
13
|
# This script is free software: you can redistribute and/or modify it under the
# terms of version 3 of the GNU General Public License as published by the Free
# Software Foundation, or (at your option) any later version of the license.
|
|
14
|
#
|
|
15
16
17
|
# This script is distributed in the hope that it will be useful but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
|
18
19
|
#
# You should have received a copy of the GNU General Public License along with
|
|
20
|
# this program. If not, visit <http://www.gnu.org/licenses/> to download it.
|
|
21
22
23
24
25
26
27
28
|
#
use strict;
use CGI;
use POSIX;
use Net::DNS;
use feature 'state';
|
|
29
|
my $ConfigFile = 'optional'; # hardcoded, either optional, required or ignore
|
|
30
31
|
##############################
|
|
32
|
# Configuration section (defaults, can be set in config file)
|
|
33
|
my $DNSServer = '192.168.1.1'; # DNS Server to communicate with (use IP!)
|
|
34
35
36
37
38
39
40
|
my @DNSDomain = ( '?', '!', 0 ); # DNS Domain to support, match hostname with:
# '?': take domain name from parameter 'domain'
# '!': take domain name from virtualhost name
# 0: take domain from hostname
# positive number: last # parts from hostname
# negative number: last # parts from virtualhost
# any other string: use if hostname ends on it
|
|
41
|
my $ExpandCNAMEs = 1; # CNAME levels to expand (0 to disable)
|
|
42
|
my $AllowDebugKey = 'off'; # Debuging, 'off' to disable, '' for always on
|
|
43
|
# and other values to enable with debug= param.
|
|
44
45
|
my $DomainListKey = 'off'; # List operation, 'off' to disable, '' to always
# allow and other values to enable with secret
|
|
46
47
48
49
50
51
52
|
my $AuthMode = 'remote'; # either 'static', 'remote' or 'both'
my $StaticSigner = ''; # required for AuthMode 'static' or 'both'
my $StaticKey = ''; # required for AuthMode 'static' or 'both'
my $RequireRR = ''; # Require existing record of this type for upd.
my $ExpireAfter = '1w'; # Expire time for registrations in minutes,
# hours, weeks or seconds. format: [0-9]+[mhws]?
my @ReplaceRR = ('A', 'AAAA', 'TXT'); # Records types to replace in update
|
|
53
54
55
|
my $RecordTTL = '1h'; # TTL for created records, format: [0-9]+[mhws]?
my $UpdateTXT = 'Last DynDNS update on'; # if set add TXT with this+date on update
my $DeleteTXT = 'DynDNS cleared on'; # if set add TXT with this+date on delete
|
|
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
##############################
# Support functions
my %months = (Jan=> 0, Feb=> 1, Mar=> 2, Apr=> 3, May=>4, Jun=> 5, Jul=> 6,
Aug=> 7, Sep=> 8, Sep=> 8, Oct=> 9, Nov=> 10, Dec=> 11);
# Parse the date and return time for: Sun May 26 21:22:15 2013
sub parse_localtime($) {
my ($day, $month, $mday, $time, $year)=split(' ', $_[0]);
return mktime(reverse(split(':',$time)),$mday,$months{$month},$year-1900);
}
sub is_ipv4 { return $_[0]=~/^((25[0-5]|(2[0-4]|[01]?[0-9]?)[0-9])(\.|$)){4}/; }
sub is_ipv6 { return $_[0]=~/^([0-9a-fA-F]{0,4}(:|$)){3,8}/i; }
sub periodSeconds($) {
my ($number, $units) = ($_[0]=~/^(\d+)([smhdw])?$/);
if($number && $units && $units cmp 's') {
|
|
74
|
$number *= ($units eq 'm') ? 60 # Seconds per minute
|
|
75
76
|
: ($units eq 'h') ? 3600 # Seconds per hour
: ($units eq 'd') ? 86400 # Seconds per day
|
|
77
|
: 604800; # Seconds per week
|
|
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
|
}
return $number;
}
# Provide a resolver object for further use, re-using the initially created one
sub getResolver() {
state $resolver;
unless($resolver) {
$resolver = Net::DNS::Resolver->new(
nameservers => [ $DNSServer ],
recurse => 0,
);
}
return $resolver;
}
my %DNS_label = (
A => 'IPv4 Address',
AAAA => 'IPv6 Address',
CNAME => 'Alias',
TXT => 'Additional Information',
MX => 'Mail Server',
NS => 'Name Server',
HINFO => 'Host Information',
);
sub DNS_decode_rr($) {
my ($rr) = @_;
return $rr->address if($rr->type eq 'A');
return $rr->address if($rr->type eq 'AAAA');
return lc($rr->cname) if($rr->type eq 'CNAME');
return $rr->txtdata if($rr->type eq 'TXT');
return $rr->nsdname if($rr->type eq 'NS');
return $rr->exchange.' (priority '.$rr->preference.')' if($rr->type eq 'MX');
return $rr->cpu.', '.$rr->os if($rr->type eq 'HINFO');
|
|
112
|
die "No support for $rr " . $rr->type . " in DNS_decode_rr()!, aborted!";
|
|
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
}
# Retrieve a single value from the DNS server of a given type or everything
sub DNS_get($;$) {
my ($host, $type) = @_;
if (my $response = getResolver()->send($host, $type || 'ANY')) {
return $response unless($type);
foreach my $rr ($response->answer) {
next unless $rr->type eq $type;
return DNS_decode_rr($rr);
}
} else {
die 'DNS query failed: ', getResolver()->errorstring, "\n";
}
}
|
|
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
##############################
# Initialize CGI, determine whether debugging is on and declaire fail method
my $cgi = CGI->new;
my $debug = ($AllowDebugKey cmp 'off') && (($AllowDebugKey eq '') || ($AllowDebugKey eq $cgi->param('debug')) );
my $SE = 'System Error';
my $CE = 'Configuration Error';
my $PE = 'Required parameter missing';
sub fail($$;$) {
my ($errormsg, $debugmsg, $exitcode) = @_;
print $cgi->header(-status=>$exitcode || 503, -type=>'text/plain'),
"ERROR - $errormsg" . ($debug ? ": $debugmsg\n" : "\n");
exit 0;
}
|
|
144
145
|
# Check whether the hostname provided is actually a CNAME, returns the host
# it points to in case of a CNAME or the original hostname if it is not.
|
|
146
147
148
149
|
sub expand_CNAME($) {
my ($host) = @_;
my @found;
while(my $cname = DNS_get($host, 'CNAME')) {
|
|
150
|
push(@found, $host);
|
|
151
152
153
154
|
$host = $cname;
fail("DNS CNAME Not supported", "$found[0] points to a CNAME but this is not supported", 400)
unless($ExpandCNAMEs);
fail("DNS CNAME Chain Error", "$found[0] has > $ExpandCNAMEs level deep CNAME chain", 400)
|
|
155
|
unless($#found < $ExpandCNAMEs);
|
|
156
157
|
foreach my $r (@found) {
fail("DNS CNAME Loop", "found CNAME loop for $found[0]", 400) if($cname eq $r);
|
|
158
159
160
161
162
|
}
}
return $host;
}
|
|
163
164
165
166
167
168
169
170
171
172
173
|
# Get signer and key CGI paramseters, abort with HTTP 400 error if not present
sub get_authinfo($$) {
my ($cgi, $host) = @_;
# Get signer and key parameters
my $signer = ($AuthMode eq 'static') ? $StaticSigner : ($cgi->param('user')
|| (($AuthMode eq 'both') ? $StaticSigner : $host));
my $key = ($AuthMode eq 'static') ? $StaticKey : ($cgi->param('secret')
|| (($AuthMode eq 'both') ? $StaticSigner : undef));
# Ensure we have a value for signer and key, otherwise abort the processing
|
|
174
175
|
fail($PE, "No/incomplete authentication information provided", 400)
if($signer eq '' or $key eq '');
|
|
176
177
178
179
180
181
|
# and return the values
return($signer, $key);
}
# Perform an DNS Update for a single host
|
|
182
183
184
|
sub DNS_Update($$$$$$$) {
my ($dnsdomain, $dnshost, $ipv4, $ipv6, $signer, $key, $debug) = @_;
my $dnsupdate = Net::DNS::Update->new($dnsdomain);
|
|
185
|
my $ttl = periodSeconds($RecordTTL);
|
|
186
187
188
189
190
191
192
193
194
195
|
# If $RequireRR is set, ensure an records of specified type exist for the name
$dnsupdate->push(pre => yxrrset("$dnshost. $RequireRR")) if($RequireRR);
# Replace any existing A, AAAA and TXT entries (update was requested)
foreach my $rrtype (@ReplaceRR) {
$dnsupdate->push(update=>rr_del("$dnshost. $rrtype"));
}
# Add new A and AAAA record based on whether ipv4 and ipv6 address provided
|
|
196
197
|
$dnsupdate->push(update=>rr_add("$dnshost. $ttl A $ipv4")) if($ipv4);
$dnsupdate->push(update=>rr_add("$dnshost. $ttl AAAA $ipv6")) if($ipv6);
|
|
198
|
|
|
199
200
201
202
203
|
# Add a TXT record with the timestamp of the last update, if required
if (my $txt = ($ipv4 or $ipv6) ? $UpdateTXT : $DeleteTXT) {
my $timestamp = localtime();
$dnsupdate->push(update=>rr_add("$dnshost. $ttl TXT \"$txt $timestamp\""));
}
|
|
204
205
206
207
208
209
210
211
212
213
214
|
# Sign the request with the signer and key
$dnsupdate->sign_tsig($signer, $key);
my $debugmessage = ($debug)
? "\n\n\n========================================================\n" .
$dnsupdate->string . "\n"
: "\n";
if(my $response = getResolver()->send($dnsupdate)) {
$debugmessage .= $response->string . "\n" if($debug);
|
|
215
|
|
|
216
|
if ($response->header->rcode eq 'NOERROR') {
|
|
217
|
return (200, "OK - DNS update for $dnshost succeeded: " .
|
|
218
219
220
|
$response->header->rcode . $debugmessage);
} else {
# REFUSED, FORMERR
|
|
221
|
return (403, "ERROR - DNS update for $dnshost failed: " .
|
|
222
223
224
225
226
227
228
229
230
231
232
|
$response->header->rcode . $debugmessage);
}
} else {
return (503, 'ERROR - DNS update for $dnshost failed: '.
getResolver()->errorstring. $debugmessage);
}
}
##############################
# Handlers for the different requests
|
|
233
234
235
|
sub handle_update($$$$) {
my ($mode, $host, $dnsdomain, $debug) = @_;
my $dnshost = expand_CNAME($host);
|
|
236
|
my ($signer, $key) = get_authinfo($cgi, $host);
|
|
237
238
239
240
241
242
243
244
245
|
# perform the action
my ($statuscode, $statusmessage);
if($mode eq 'delete') {
($statuscode, $statusmessage) =
DNS_Update($dnsdomain, $dnshost, undef, undef, $signer, $key, $debug)
} else {
# Get ipv4, and ipv6 parameters
my $remote_addr = $cgi->remote_addr;
|
|
246
247
248
249
250
251
252
253
|
my $ipv4addr = $cgi->param('ipv4addr') || $cgi->param('ip');
if ($ipv4addr == 'auto') {
$ipv4addr = is_ipv4($remote_addr) ? $remote_addr : undef;
}
my $ipv6addr = $cgi->param('ipv6addr') || $cgi->param('ipv6');
if ($ipv6addr == 'auto') {
$ipv6addr = is_ipv6($remote_addr) ? $remote_addr : undef;
}
|
|
254
255
256
257
258
259
260
|
($statuscode, $statusmessage) =
DNS_Update($dnsdomain, $dnshost, $ipv4addr, $ipv6addr, $signer, $key, $debug);
}
# And report back the status
print $cgi->header(-status=>$statuscode, -type=>'text/plain'), $statusmessage;
|
|
261
|
}
|
|
262
|
|
|
263
264
|
sub handle_expire($$$$) {
my ($mode, $host, $dnsdomain, $debug) = @_;
|
|
265
|
my ($signer, $key) = get_authinfo($cgi, $host);
|
|
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
|
my $debugmsg = ($debug) ? "\n" : '';
# perform the action
if(my $period = periodSeconds($ExpireAfter)) {
my $validafter = time - $period;
if($debug) {
$debugmsg .= "ExpireAfter $ExpireAfter, expiring all entries older than ";
$debugmsg .= localtime($validafter) . "\n";
}
foreach my $rr (getResolver->axfr($dnsdomain)) {
next if($rr->name eq $dnsdomain);
if($rr->type eq 'TXT' &&
$rr->txtdata=~/$UpdateTXT(.*\d\d:\d\d:\d\d \d{4})$/){
if(my $lastupdate = parse_localtime($1)) {
|
|
281
|
DNS_Update($dnsdomain, $rr->name, undef, undef, $signer, $key, $debug)
|
|
282
283
284
285
286
287
288
289
290
291
292
|
unless($lastupdate > $validafter);
if($debug) {
$debugmsg .= ($lastupdate > $validafter) ? 'Keeping ' : 'Expiring ';
$debugmsg .= $rr->name . " last update ($1)\n";
}
} elsif($debug) {
$debugmsg .= 'Skipping '. $rr->name ." TXT: '". $rr->txtdata ."'\n";
}
}
}
# And report back the status
|
|
293
|
print $cgi->header(-status=>200, -type=>'text/plain'),
|
|
294
295
296
297
|
"OK - DNS expiry for $dnsdomain succeeded\n" . $debugmsg;
}
}
|
|
298
299
300
|
sub handle_view($$$$) {
my ($mode, $host, $dnsdomain, $debug) = @_;
my $dnshost = expand_CNAME($host);
|
|
301
302
303
304
305
306
307
308
309
310
311
312
313
|
my $title = "DynDNS Updater - $host";
print $cgi->header(-status=>200),
$cgi->start_html(-title => $title),
$cgi->h1($title);
print $cgi->p("$host resolves to $dnshost") if($host cmp $dnshost);
print $cgi->p("Current DNS information for $dnshost:"),
$cgi->start_table,
$cgi->Tr({-align=>'LEFT',-valign=>'TOP'}, [
$cgi->th(['Field', 'Value'])
]);
foreach my $rr (DNS_get($dnshost)->answer) {
|
|
314
315
316
|
if(my $label = $DNS_label{$rr->type}) {
print $cgi->Tr([ $cgi->td([$label, DNS_decode_rr($rr)]) ]);
}
|
|
317
318
319
320
321
322
|
}
print $cgi->end_table();
print $cgi->end_html();
}
|
|
323
324
|
sub handle_list($$$$) {
my ($mode, $host, $dnsdomain, $debug) = @_;
|
|
325
326
|
my $title = "DynDNS Updater - $dnsdomain";
|
|
327
328
329
330
|
fail("Operation not allowed", ($DomainListKey eq 'off') ? "List is disabled"
: "No/incorrect authentication information provided", 403)
if ($DomainListKey eq 'off') || (($DomainListKey cmp '') && ($DomainListKey cmp $cgi->param('secret')));
|
|
331
332
333
334
335
336
337
338
339
340
341
342
|
print $cgi->header(-status=>200),
$cgi->start_html(-title => $title),
$cgi->h1($title);
print $cgi->p("Current DNS information for $dnsdomain:"),
$cgi->start_table,
$cgi->Tr({-align=>'LEFT',-valign=>'TOP'}, [
$cgi->th(['Name', 'Field', 'Value'])
]);
my $lastname = '';
foreach my $rr (getResolver->axfr($dnsdomain)) {
next if($rr->name eq $dnsdomain);
|
|
343
344
345
346
347
|
if(my $label = $DNS_label{$rr->type}) {
print $cgi->Tr([ $cgi->td([ ($lastname cmp $rr->name) ? $rr->name : '',
$label, DNS_decode_rr($rr)]) ]);
$lastname = $rr->name;
}
|
|
348
349
350
351
352
353
354
|
}
print $cgi->end_table();
print $cgi->end_html();
}
|
|
355
356
357
358
359
360
361
|
##############################
# Load configuration, if desired
if ($ConfigFile cmp 'ignore') {
my $CFGFile = $0;
$CFGFile =~ s/(\.pl)?$/.cfg/;
if (open (CONFIG, $CFGFile)) {
my %CONFIG = (
|
|
362
|
allow_debug_key => \$AllowDebugKey, domain_list_key => \$DomainListKey,
|
|
363
|
dns_server => \$DNSServer, dns_domain => \@DNSDomain,
|
|
364
365
366
367
368
369
370
371
372
373
374
375
376
377
|
expand_cnames => \$ExpandCNAMEs, auth_mode => \$AuthMode,
static_signer => \$StaticSigner, static_key => \$StaticKey,
require_rr => \$RequireRR, replace_rr => \@ReplaceRR,
update_txt => \$UpdateTXT, delete_txt => \$DeleteTXT,
expire_after => \$ExpireAfter, record_ttl => \$RecordTTL,
);
while (<CONFIG>) {
chomp; s/^\s+//; s/\s*(#.*)?$//; # trim whitespace & comments
next unless length; # skip empty lines
my ($key, $value) = split(/\s*=\s*/, $_, 2); # split key and value
my $dst = $CONFIG{$key}; # get destination for value
if (ref $dst eq 'SCALAR') { $$dst = $value; } # store scalar value
elsif (ref $dst eq 'CODE') { &$dst($value); } # call setter function
|
|
378
379
|
elsif (ref $dst cmp 'ARRAY') { fail($SE, "Invalid config: $key"); }
else { @$dst = split(/\s*,\s*/, $value); } # split and store array
|
|
380
381
382
|
}
close CONFIG;
} elsif ($ConfigFile eq 'required') {
|
|
383
|
fail($SE, "unable to load configuration from $CFGFile: $!");
|
|
384
385
386
|
}
}
|
|
387
|
|
|
388
389
|
##############################
# Validate Configuration
|
|
390
|
fail($CE, "ConfigFile must be optional, required or ignore, not '$ConfigFile'")
|
|
391
|
unless $ConfigFile=~/optional|required|ignore/;
|
|
392
|
fail($CE, "AuthMode '$AuthMode' is unsupported must be remote, static or both")
|
|
393
|
unless $AuthMode=~/remote|static|both/;
|
|
394
|
fail($CE, "StaticSigner must be set for \$AuthMode '$AuthMode'")
|
|
395
|
unless ($StaticSigner or $AuthMode eq 'remote');
|
|
396
|
fail($CE, "StaticKey must be set for \$AuthMode '$AuthMode'")
|
|
397
|
unless ($StaticKey or $AuthMode eq 'remote');
|
|
398
|
fail($CE, "RequireRR is set to unsupported type '$RequireRR'")
|
|
399
|
if ($RequireRR and not $DNS_label{$RequireRR});
|
|
400
|
fail($CE, "RecordTTL '$RecordTTL' is not supported")
|
|
401
|
unless ($RecordTTL=~/^\d+[smhw]?$/);
|
|
402
|
fail($CE, "ExpireAfter '$ExpireAfter' is not supported")
|
|
403
|
unless ($ExpireAfter=~/^\d+[smhw]?$/);
|
|
404
|
fail($CE, "UpdateTXT must be set when \$ExpireAfter is set")
|
|
405
406
|
if($ExpireAfter and not $UpdateTXT);
foreach my $rrtype (@ReplaceRR) {
|
|
407
|
fail($CE, "ReplaceRR contains unsupported type '$rrtype'")
|
|
408
|
unless exists $DNS_label{$rrtype};
|
|
409
410
411
412
413
|
}
##############################
# Determine what to do and fetch the input parameters
|
|
414
|
my $mode = $cgi->path_info || $cgi->param('mode') || 'view';
|
|
415
416
|
$mode=~s/^\/([^\/]+)(\/(.*))?/$1/;
my $host = $cgi->param('host') || $3;
|
|
417
418
419
420
421
|
my $dnsdomain;
foreach my $d (@DNSDomain) {
if ($d eq '!') { $d = $cgi->virtual_host; }
elsif ($d eq '?') { $d = $cgi->param('domain'); }
elsif ($d =~ /-?\d+/) {
|
|
422
423
|
if ($d <0) { $d = join('.', splice(@{[ split(/\./, $cgi->virtual_host) ]}, $d)); }
else { $d = join('.', splice(@{[ split(/\./, $host) ]}, ($d) ? -$d : 1)); }
|
|
424
|
}
|
|
425
|
$dnsdomain = $d if (!$host || length($host) == length($d)+rindex($host,$d));
|
|
426
427
428
429
430
|
last if $dnsdomain;
}
fail($PE, "No host name to act on specified", 400)
unless $host || $mode eq 'list' || $mode eq 'expire';
fail($PE, "No host or domain name to act on specified", 400) unless $dnsdomain;
|
|
431
432
433
434
435
|
##############################
# Dispatch the request to the correct handler
my %handlers = (
|
|
436
|
view => \&handle_view,
|
|
437
438
|
update => \&handle_update,
delete => \&handle_update,
|
|
439
|
list => \&handle_list,
|
|
440
441
|
expire => \&handle_expire,
);
|
|
442
443
|
if(my $handler = $handlers{$mode}) {
$handler->($mode, $host, $dnsdomain, $debug);
|
|
444
|
} else {
|
|
445
|
fail("File Not Found", "Invalid Mode '$mode' specified", 404);
|
|
446
|
}
|
|
447
|
|