Commit 835d1a5abeebb42f47159b04133ea70e48ac1053
0 parents
Initial commit
Showing
2 changed files
with
369 additions
and
0 deletions
.gitattributes
0 → 100644
dyndns.pl
0 → 100755
1 | +++ a/dyndns.pl | ||
1 | +#!/usr/bin/perl | ||
2 | + | ||
3 | +# | ||
4 | +# dyndns.pl - CGI-BIN script to handle Dynamic DNS updates through http | ||
5 | +# | ||
6 | +# Last Update: $Date$ | ||
7 | +# | ||
8 | +# Latest version and documentation on http://projects.lindenaar.net/p/dyndns | ||
9 | +# | ||
10 | +# Copyright (C) 2013 Frederik Lindenaar | ||
11 | +# | ||
12 | +# This program is free software; you can redistribute it and/or modify it under | ||
13 | +# the terms of the GNU General Public License as published by the Free Software | ||
14 | +# Foundation; either version 2 of the License, or (at your option) any later | ||
15 | +# version. | ||
16 | +# | ||
17 | +# This program is distributed in the hope that it will be useful, but WITHOUT | ||
18 | +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS | ||
19 | +# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. | ||
20 | +# | ||
21 | +# You should have received a copy of the GNU General Public License along with | ||
22 | +# this program; if not, write to the Free Software Foundation, Inc., 59 Temple | ||
23 | +# Place, Suite 330, Boston, MA 02111-1307 USA | ||
24 | +# | ||
25 | + | ||
26 | +use strict; | ||
27 | +use CGI; | ||
28 | +use POSIX; | ||
29 | +use Net::DNS; | ||
30 | +use feature 'state'; | ||
31 | + | ||
32 | + | ||
33 | +############################## | ||
34 | +# Configuration section | ||
35 | +my $DNSServer = '192.168.1.1'; # DNS Server to communicate with (use IP!) | ||
36 | +my $ExpandCNAMEs = 1; # CNAME levels to expand (0 to disable) | ||
37 | +my $AllowDebugKey = 'on'; # Debuging, 'off' to disable, '' for always on | ||
38 | + # and other values to enable with debug= param. | ||
39 | +my $AuthMode = 'remote'; # either 'static', 'remote' or 'both' | ||
40 | +my $StaticSigner = ''; # required for AuthMode 'static' or 'both' | ||
41 | +my $StaticKey = ''; # required for AuthMode 'static' or 'both' | ||
42 | +my $RequireRR = ''; # Require existing record of this type for upd. | ||
43 | +my $ExpireAfter = '1w'; # Expire time for registrations in minutes, | ||
44 | + # hours, weeks or seconds. format: [0-9]+[mhws]? | ||
45 | +my @ReplaceRR = ('A', 'AAAA', 'TXT'); # Records types to replace in update | ||
46 | +my $UpdateTXT = 'Last DynDNS update on '; | ||
47 | +my $DeleteTXT = 'DynDNS cleared on '; | ||
48 | + | ||
49 | + | ||
50 | +############################## | ||
51 | +# Support functions | ||
52 | +my %months = (Jan=> 0, Feb=> 1, Mar=> 2, Apr=> 3, May=>4, Jun=> 5, Jul=> 6, | ||
53 | + Aug=> 7, Sep=> 8, Sep=> 8, Oct=> 9, Nov=> 10, Dec=> 11); | ||
54 | +# Parse the date and return time for: Sun May 26 21:22:15 2013 | ||
55 | +sub parse_localtime($) { | ||
56 | + my ($day, $month, $mday, $time, $year)=split(' ', $_[0]); | ||
57 | + return mktime(reverse(split(':',$time)),$mday,$months{$month},$year-1900); | ||
58 | +} | ||
59 | + | ||
60 | +sub is_ipv4 { return $_[0]=~/^((25[0-5]|(2[0-4]|[01]?[0-9]?)[0-9])(\.|$)){4}/; } | ||
61 | +sub is_ipv6 { return $_[0]=~/^([0-9a-fA-F]{0,4}(:|$)){3,8}/i; } | ||
62 | + | ||
63 | +sub periodSeconds($) { | ||
64 | + my ($number, $units) = ($_[0]=~/^(\d+)([smhdw])?$/); | ||
65 | + if($number && $units && $units cmp 's') { | ||
66 | + $number *= 60; # Convert to minutes | ||
67 | + if($units cmp 'm') { | ||
68 | + $number *= 60; # Convert to hours | ||
69 | + if($units cmp 'h') { | ||
70 | + $number *= 24; # Convert to days | ||
71 | + if($units cmp 'd') { | ||
72 | + $number *= 7; # Convert to weeks | ||
73 | + } | ||
74 | + } | ||
75 | + } | ||
76 | + } | ||
77 | + return $number; | ||
78 | +} | ||
79 | + | ||
80 | +# Provide a resolver object for further use, re-using the initially created one | ||
81 | +sub getResolver() { | ||
82 | + state $resolver; | ||
83 | + unless($resolver) { | ||
84 | + $resolver = Net::DNS::Resolver->new( | ||
85 | + nameservers => [ $DNSServer ], | ||
86 | + recurse => 0, | ||
87 | + ); | ||
88 | + } | ||
89 | + return $resolver; | ||
90 | +} | ||
91 | + | ||
92 | +my %DNS_label = ( | ||
93 | + A => 'IPv4 Address', | ||
94 | + AAAA => 'IPv6 Address', | ||
95 | + CNAME => 'Alias', | ||
96 | + TXT => 'Additional Information', | ||
97 | + MX => 'Mail Server', | ||
98 | + NS => 'Name Server', | ||
99 | + HINFO => 'Host Information', | ||
100 | +); | ||
101 | +sub DNS_decode_rr($) { | ||
102 | + my ($rr) = @_; | ||
103 | + return $rr->address if($rr->type eq 'A'); | ||
104 | + return $rr->address if($rr->type eq 'AAAA'); | ||
105 | + return lc($rr->cname) if($rr->type eq 'CNAME'); | ||
106 | + return $rr->txtdata if($rr->type eq 'TXT'); | ||
107 | + return $rr->nsdname if($rr->type eq 'NS'); | ||
108 | + return $rr->exchange.' (priority '.$rr->preference.')' if($rr->type eq 'MX'); | ||
109 | + return $rr->cpu.', '.$rr->os if($rr->type eq 'HINFO'); | ||
110 | + die "No support for $rr->type in DNS_get()!, aborted!"; | ||
111 | +} | ||
112 | + | ||
113 | +# Retrieve a single value from the DNS server of a given type or everything | ||
114 | +sub DNS_get($;$) { | ||
115 | + my ($host, $type) = @_; | ||
116 | + if (my $response = getResolver()->send($host, $type || 'ANY')) { | ||
117 | + return $response unless($type); | ||
118 | + foreach my $rr ($response->answer) { | ||
119 | + next unless $rr->type eq $type; | ||
120 | + return DNS_decode_rr($rr); | ||
121 | + } | ||
122 | + } else { | ||
123 | + die 'DNS query failed: ', getResolver()->errorstring, "\n"; | ||
124 | + } | ||
125 | +} | ||
126 | + | ||
127 | +# Check whether the hostname provided is actually a CNAME, returns the host | ||
128 | +# it points to in case of a CNAME or the original hostname if it is not. | ||
129 | +sub expand_CNAME($;$) { | ||
130 | + my ($host, @found) = @_; | ||
131 | + if(my $cname=DNS_get($host, 'CNAME')) { | ||
132 | + push(@found, $host); | ||
133 | + die $found[0]."has > $ExpandCNAMEs level deep CNAME chain, aborting!\n" | ||
134 | + unless($#found < $ExpandCNAMEs); | ||
135 | + foreach my $r (@found) { | ||
136 | + die "found CNAME loop for $host, aborting!\n" if($cname eq $r); | ||
137 | + } | ||
138 | + | ||
139 | + return &expand_CNAME($cname, @found); | ||
140 | + } | ||
141 | + return $host; | ||
142 | +} | ||
143 | + | ||
144 | +# Method to perform an DNS Update for a single host | ||
145 | +sub DNS_Update($$$$$$$) { | ||
146 | + my ($dnsdomain, $dnshost, $ipv4, $ipv6, $signer, $key, $debug) = @_; | ||
147 | + my $dnsupdate = Net::DNS::Update->new($dnsdomain); | ||
148 | + | ||
149 | + # If $RequireRR is set, ensure an records of specified type exist for the name | ||
150 | + $dnsupdate->push(pre => yxrrset("$dnshost. $RequireRR")) if($RequireRR); | ||
151 | + | ||
152 | + # Replace any existing A, AAAA and TXT entries (update was requested) | ||
153 | + foreach my $rrtype (@ReplaceRR) { | ||
154 | + $dnsupdate->push(update=>rr_del("$dnshost. $rrtype")); | ||
155 | + } | ||
156 | + | ||
157 | + # Add new A and AAAA record based on whether ipv4 and ipv6 address provided | ||
158 | + $dnsupdate->push(update=>rr_add("$dnshost. 3600 A $ipv4")) if($ipv4); | ||
159 | + $dnsupdate->push(update=>rr_add("$dnshost. 3600 AAAA $ipv6")) if($ipv6); | ||
160 | + | ||
161 | + # Always add a new TXT record with the timestamp of the last update | ||
162 | + my $txt = ($ipv4 or $ipv6) ? $UpdateTXT : $DeleteTXT; | ||
163 | + $dnsupdate->push(update=>rr_add($dnshost. '. 3600 TXT "' . $txt . localtime() | ||
164 | + . '"')) if($txt); | ||
165 | + | ||
166 | + # Sign the request with the signer and key | ||
167 | + $dnsupdate->sign_tsig($signer, $key); | ||
168 | + | ||
169 | + my $debugmessage = ($debug) | ||
170 | + ? "\n\n\n========================================================\n" . | ||
171 | + $dnsupdate->string . "\n" | ||
172 | + : "\n"; | ||
173 | + | ||
174 | + if(my $response = getResolver()->send($dnsupdate)) { | ||
175 | + $debugmessage .= $response->string . "\n" if($debug); | ||
176 | + | ||
177 | + if ($response->header->rcode eq 'NOERROR') { | ||
178 | + return (200, "OK - DNS update for $dnshost succeeded: " . | ||
179 | + $response->header->rcode . $debugmessage); | ||
180 | + } else { | ||
181 | + # REFUSED, FORMERR | ||
182 | + return (400, "ERROR - DNS update for $dnshost failed: " . | ||
183 | + $response->header->rcode . $debugmessage); | ||
184 | + } | ||
185 | + } else { | ||
186 | + return (503, 'ERROR - DNS update for $dnshost failed: '. | ||
187 | + getResolver()->errorstring. $debugmessage); | ||
188 | + } | ||
189 | +} | ||
190 | + | ||
191 | + | ||
192 | +############################## | ||
193 | +# Handlers for the different requests | ||
194 | +sub handle_update($$$$$$) { | ||
195 | + my ($cgi, $mode, $host, $dnshost, $dnsdomain, $debug) = @_; | ||
196 | + | ||
197 | + # Get signer and key parameters | ||
198 | + my $signer = ($AuthMode eq 'static') ? $StaticSigner : ($cgi->param('user') | ||
199 | + || (($AuthMode eq 'both') ? $StaticSigner : $host)); | ||
200 | + my $key = ($AuthMode eq 'static') ? $StaticKey : ($cgi->param('secret') | ||
201 | + || (($AuthMode eq 'both') ? $StaticSigner : undef)); | ||
202 | + | ||
203 | + # perform the action | ||
204 | + my ($statuscode, $statusmessage); | ||
205 | + if($mode eq 'delete') { | ||
206 | + ($statuscode, $statusmessage) = | ||
207 | + DNS_Update($dnsdomain, $dnshost, undef, undef, $signer, $key, $debug) | ||
208 | + } else { | ||
209 | + # Get ipv4, and ipv6 parameters | ||
210 | + my $remote_addr = $cgi->remote_addr; | ||
211 | + my $ipv4addr = $cgi->param('ipv4addr') | ||
212 | + || $cgi->param('ip') | ||
213 | + || (is_ipv4($remote_addr) ? $remote_addr : undef); | ||
214 | + my $ipv6addr = $cgi->param('ipv6addr') | ||
215 | + || (! $ipv4addr and is_ipv6($remote_addr)) ? $remote_addr : undef; | ||
216 | + ($statuscode, $statusmessage) = | ||
217 | + DNS_Update($dnsdomain, $dnshost, $ipv4addr, $ipv6addr, $signer, $key, $debug); | ||
218 | + } | ||
219 | + | ||
220 | + # And report back the status | ||
221 | + print $cgi->header(-status=>$statuscode, -type=>'text/plain'), $statusmessage; | ||
222 | + | ||
223 | +} | ||
224 | + | ||
225 | +sub handle_expire($$$$$$) { | ||
226 | + my ($cgi, $mode, $host, $dnshost, $dnsdomain, $debug) = @_; | ||
227 | + | ||
228 | + # Get signer and key parameters | ||
229 | + my $signer = ($AuthMode eq 'static') ? $StaticSigner : ($cgi->param('user') | ||
230 | + || (($AuthMode eq 'both') ? $StaticSigner : $host)); | ||
231 | + my $key = ($AuthMode eq 'static') ? $StaticKey : ($cgi->param('secret') | ||
232 | + || (($AuthMode eq 'both') ? $StaticSigner : undef)); | ||
233 | + | ||
234 | + my $debugmsg = ($debug) ? "\n" : ''; | ||
235 | + | ||
236 | + # perform the action | ||
237 | + if(my $period = periodSeconds($ExpireAfter)) { | ||
238 | + my $validafter = time - $period; | ||
239 | + if($debug) { | ||
240 | + $debugmsg .= "ExpireAfter $ExpireAfter, expiring all entries older than "; | ||
241 | + $debugmsg .= localtime($validafter) . "\n"; | ||
242 | + } | ||
243 | + foreach my $rr (getResolver->axfr($dnsdomain)) { | ||
244 | + next if($rr->name eq $dnsdomain); | ||
245 | + if($rr->type eq 'TXT' && | ||
246 | + $rr->txtdata=~/$UpdateTXT(.*\d\d:\d\d:\d\d \d{4})$/){ | ||
247 | + if(my $lastupdate = parse_localtime($1)) { | ||
248 | + DNS_Update($dnsdomain, $dnshost, undef, undef, $signer, $key, $debug) | ||
249 | + unless($lastupdate > $validafter); | ||
250 | + if($debug) { | ||
251 | + $debugmsg .= ($lastupdate > $validafter) ? 'Keeping ' : 'Expiring '; | ||
252 | + $debugmsg .= $rr->name . " last update ($1)\n"; | ||
253 | + } | ||
254 | + } elsif($debug) { | ||
255 | + $debugmsg .= 'Skipping '. $rr->name ." TXT: '". $rr->txtdata ."'\n"; | ||
256 | + } | ||
257 | + } | ||
258 | + } | ||
259 | + # And report back the status | ||
260 | + print $cgi->header(-status=>200, -type=>'text/plain'), | ||
261 | + "OK - DNS expiry for $dnsdomain succeeded\n" . $debugmsg; | ||
262 | + } | ||
263 | +} | ||
264 | + | ||
265 | +sub handle_status($$$$$$) { | ||
266 | + my ($cgi, $mode, $host, $dnshost, $dnsdomain, $debug) = @_; | ||
267 | + my $title = "DynDNS Updater - $host"; | ||
268 | + print $cgi->header(-status=>200), | ||
269 | + $cgi->start_html(-title => $title), | ||
270 | + $cgi->h1($title); | ||
271 | + | ||
272 | + print $cgi->p("$host resolves to $dnshost") if($host cmp $dnshost); | ||
273 | + | ||
274 | + print $cgi->p("Current DNS information for $dnshost:"), | ||
275 | + $cgi->start_table, | ||
276 | + $cgi->Tr({-align=>'LEFT',-valign=>'TOP'}, [ | ||
277 | + $cgi->th(['Field', 'Value']) | ||
278 | + ]); | ||
279 | + foreach my $rr (DNS_get($dnshost)->answer) { | ||
280 | + print $cgi->Tr([ | ||
281 | + $cgi->td([$DNS_label{$rr->type}, DNS_decode_rr($rr)]) | ||
282 | + ]); | ||
283 | + } | ||
284 | + print $cgi->end_table(); | ||
285 | + | ||
286 | + print $cgi->end_html(); | ||
287 | +} | ||
288 | + | ||
289 | +sub handle_view($$$$$$) { | ||
290 | + my ($cgi, $mode, $host, $dnshost, $dnsdomain, $debug) = @_; | ||
291 | + my $title = "DynDNS Updater - $dnsdomain"; | ||
292 | + | ||
293 | + print $cgi->header(-status=>200), | ||
294 | + $cgi->start_html(-title => $title), | ||
295 | + $cgi->h1($title); | ||
296 | + | ||
297 | + print $cgi->p("Current DNS information for $dnsdomain:"), | ||
298 | + $cgi->start_table, | ||
299 | + $cgi->Tr({-align=>'LEFT',-valign=>'TOP'}, [ | ||
300 | + $cgi->th(['Name', 'Field', 'Value']) | ||
301 | + ]); | ||
302 | + my $lastname = ''; | ||
303 | + foreach my $rr (getResolver->axfr($dnsdomain)) { | ||
304 | + next if($rr->name eq $dnsdomain); | ||
305 | + print $cgi->Tr([ | ||
306 | + $cgi->td([ ($lastname cmp $rr->name) ? $rr->name : '', | ||
307 | + $DNS_label{$rr->type}, DNS_decode_rr($rr)]) | ||
308 | + ]); | ||
309 | + $lastname = $rr->name; | ||
310 | + } | ||
311 | + print $cgi->end_table(); | ||
312 | + | ||
313 | + print $cgi->end_html(); | ||
314 | +} | ||
315 | + | ||
316 | +my $cgi = CGI->new; | ||
317 | + | ||
318 | +############################## | ||
319 | +# Validate Configuration | ||
320 | +my $CE = 'Configuration Error:'; | ||
321 | +die "$CE \$AuthMode '$AuthMode' is unsupported must be remote, static or both\n" | ||
322 | + unless $AuthMode=~/remote|static|both/; | ||
323 | +die "$CE \$StaticSigner must be set for \$AuthMode '$AuthMode'\n" | ||
324 | + unless ($StaticSigner or $AuthMode eq 'remote'); | ||
325 | +die "$CE \$StaticKey must be set for \$AuthMode '$AuthMode'\n" | ||
326 | + unless ($StaticKey or $AuthMode eq 'remote'); | ||
327 | +die "$CE \$RequireRR is set to unsupported type '$RequireRR'\n" | ||
328 | + if ($RequireRR and not $DNS_label{$RequireRR}); | ||
329 | +die "$CE \$ExpireAfter '$ExpireAfter' is not supported\n" | ||
330 | + unless ($ExpireAfter=~/^\d+[smhw]$/); | ||
331 | +die "$CE \$UpdateTXT must be set when \$ExpireAfter is set\n" | ||
332 | + if($ExpireAfter and not $UpdateTXT); | ||
333 | +foreach my $rrtype (@ReplaceRR) { | ||
334 | + die "$CE \$ReplaceRR contains unsupported type '$rrtype'\n" | ||
335 | + unless ($DNS_label{$rrtype}); | ||
336 | +} | ||
337 | + | ||
338 | + | ||
339 | +############################## | ||
340 | +# Determine what to do and fetch the input parameters | ||
341 | +my $mode = $cgi->path_info || $cgi->param('mode') || '/status'; | ||
342 | +$mode=~s/^\/([^\/]+)(\/(.*))?/$1/; | ||
343 | +my $host = $cgi->param('host') || $3; | ||
344 | +my $debug = ($AllowDebugKey eq 'off') ? 0 : ($AllowDebugKey eq ($cgi->param('debug') || '')); | ||
345 | + | ||
346 | + | ||
347 | +############################## | ||
348 | +# Dispatch the request to the correct handler | ||
349 | +my %handlers = ( | ||
350 | + status => \&handle_status, | ||
351 | + update => \&handle_update, | ||
352 | + delete => \&handle_update, | ||
353 | + view => \&handle_view, | ||
354 | + expire => \&handle_expire, | ||
355 | +); | ||
356 | +if($host eq '' and $mode cmp 'view' and $mode cmp 'expire') { | ||
357 | + print $cgi->header(-status=>400, -type=>'text/plain'), | ||
358 | + "ERROR - No host name to act on specified\n"; | ||
359 | +} elsif(my $handler = $handlers{$mode}) { | ||
360 | + # Replace provided host with that of a CNAME it points to and determine domain | ||
361 | + my $dnshost = ($host) ? expand_CNAME($host) : undef; | ||
362 | + my $dnsdomain = $cgi->param('domain') || ($dnshost=~/\.(.*)$/)[0]; | ||
363 | + $handler->($cgi, $mode, $host, $dnshost, $dnsdomain, $debug); | ||
364 | +} else { | ||
365 | + print $cgi->header(-status=>($cgi->path_info) ? 404 : 400, | ||
366 | + -type=>'text/plain'), | ||
367 | + "ERROR - File Not Found / Invalid Mode '$mode' specified\n"; | ||
368 | +} |