Commit 835d1a5abeebb42f47159b04133ea70e48ac1053

Authored by Frederik Lindenaar
0 parents

Initial commit

Showing 2 changed files with 369 additions and 0 deletions
.gitattributes 0 → 100644
  1 +++ a/.gitattributes
  1 +perl filter=keywords
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 +}