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