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 | +} | |
... | ... |