From 835d1a5abeebb42f47159b04133ea70e48ac1053 Mon Sep 17 00:00:00 2001 From: Frederik Lindenaar <frederik@lindenaar.nl> Date: Sun, 2 Jun 2013 00:11:52 +0200 Subject: [PATCH] Initial commit --- .gitattributes | 1 + dyndns.pl | 368 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 369 insertions(+), 0 deletions(-) create mode 100644 .gitattributes create mode 100755 dyndns.pl diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000..5b93c11 --- /dev/null +++ b/.gitattributes @@ -0,0 +1 @@ +perl filter=keywords diff --git a/dyndns.pl b/dyndns.pl new file mode 100755 index 0000000..a71e356 --- /dev/null +++ b/dyndns.pl @@ -0,0 +1,368 @@ +#!/usr/bin/perl + +# +# dyndns.pl - CGI-BIN script to handle Dynamic DNS updates through http +# +# Last Update: $Date$ +# +# Latest version and documentation on http://projects.lindenaar.net/p/dyndns +# +# Copyright (C) 2013 Frederik Lindenaar +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# This program 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. +# +# You should have received a copy of the GNU General Public License along with +# this program; if not, write to the Free Software Foundation, Inc., 59 Temple +# Place, Suite 330, Boston, MA 02111-1307 USA +# + +use strict; +use CGI; +use POSIX; +use Net::DNS; +use feature 'state'; + + +############################## +# Configuration section +my $DNSServer = '192.168.1.1'; # DNS Server to communicate with (use IP!) +my $ExpandCNAMEs = 1; # CNAME levels to expand (0 to disable) +my $AllowDebugKey = 'on'; # Debuging, 'off' to disable, '' for always on + # and other values to enable with debug= param. +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 +my $UpdateTXT = 'Last DynDNS update on '; +my $DeleteTXT = 'DynDNS cleared on '; + + +############################## +# 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') { + $number *= 60; # Convert to minutes + if($units cmp 'm') { + $number *= 60; # Convert to hours + if($units cmp 'h') { + $number *= 24; # Convert to days + if($units cmp 'd') { + $number *= 7; # Convert to weeks + } + } + } + } + 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'); + die "No support for $rr->type in DNS_get()!, aborted!"; +} + +# 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"; + } +} + +# 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. +sub expand_CNAME($;$) { + my ($host, @found) = @_; + if(my $cname=DNS_get($host, 'CNAME')) { + push(@found, $host); + die $found[0]."has > $ExpandCNAMEs level deep CNAME chain, aborting!\n" + unless($#found < $ExpandCNAMEs); + foreach my $r (@found) { + die "found CNAME loop for $host, aborting!\n" if($cname eq $r); + } + + return &expand_CNAME($cname, @found); + } + return $host; +} + +# Method to perform an DNS Update for a single host +sub DNS_Update($$$$$$$) { + my ($dnsdomain, $dnshost, $ipv4, $ipv6, $signer, $key, $debug) = @_; + my $dnsupdate = Net::DNS::Update->new($dnsdomain); + + # 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 + $dnsupdate->push(update=>rr_add("$dnshost. 3600 A $ipv4")) if($ipv4); + $dnsupdate->push(update=>rr_add("$dnshost. 3600 AAAA $ipv6")) if($ipv6); + + # Always add a new TXT record with the timestamp of the last update + my $txt = ($ipv4 or $ipv6) ? $UpdateTXT : $DeleteTXT; + $dnsupdate->push(update=>rr_add($dnshost. '. 3600 TXT "' . $txt . localtime() + . '"')) if($txt); + + # 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); + + if ($response->header->rcode eq 'NOERROR') { + return (200, "OK - DNS update for $dnshost succeeded: " . + $response->header->rcode . $debugmessage); + } else { + # REFUSED, FORMERR + return (400, "ERROR - DNS update for $dnshost failed: " . + $response->header->rcode . $debugmessage); + } + } else { + return (503, 'ERROR - DNS update for $dnshost failed: '. + getResolver()->errorstring. $debugmessage); + } +} + + +############################## +# Handlers for the different requests +sub handle_update($$$$$$) { + my ($cgi, $mode, $host, $dnshost, $dnsdomain, $debug) = @_; + + # 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)); + + # 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; + my $ipv4addr = $cgi->param('ipv4addr') + || $cgi->param('ip') + || (is_ipv4($remote_addr) ? $remote_addr : undef); + my $ipv6addr = $cgi->param('ipv6addr') + || (! $ipv4addr and is_ipv6($remote_addr)) ? $remote_addr : undef; + ($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; + +} + +sub handle_expire($$$$$$) { + my ($cgi, $mode, $host, $dnshost, $dnsdomain, $debug) = @_; + + # 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)); + + 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)) { + DNS_Update($dnsdomain, $dnshost, undef, undef, $signer, $key, $debug) + 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 + print $cgi->header(-status=>200, -type=>'text/plain'), + "OK - DNS expiry for $dnsdomain succeeded\n" . $debugmsg; + } +} + +sub handle_status($$$$$$) { + my ($cgi, $mode, $host, $dnshost, $dnsdomain, $debug) = @_; + 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) { + print $cgi->Tr([ + $cgi->td([$DNS_label{$rr->type}, DNS_decode_rr($rr)]) + ]); + } + print $cgi->end_table(); + + print $cgi->end_html(); +} + +sub handle_view($$$$$$) { + my ($cgi, $mode, $host, $dnshost, $dnsdomain, $debug) = @_; + my $title = "DynDNS Updater - $dnsdomain"; + + 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); + print $cgi->Tr([ + $cgi->td([ ($lastname cmp $rr->name) ? $rr->name : '', + $DNS_label{$rr->type}, DNS_decode_rr($rr)]) + ]); + $lastname = $rr->name; + } + print $cgi->end_table(); + + print $cgi->end_html(); +} + +my $cgi = CGI->new; + +############################## +# Validate Configuration +my $CE = 'Configuration Error:'; +die "$CE \$AuthMode '$AuthMode' is unsupported must be remote, static or both\n" + unless $AuthMode=~/remote|static|both/; +die "$CE \$StaticSigner must be set for \$AuthMode '$AuthMode'\n" + unless ($StaticSigner or $AuthMode eq 'remote'); +die "$CE \$StaticKey must be set for \$AuthMode '$AuthMode'\n" + unless ($StaticKey or $AuthMode eq 'remote'); +die "$CE \$RequireRR is set to unsupported type '$RequireRR'\n" + if ($RequireRR and not $DNS_label{$RequireRR}); +die "$CE \$ExpireAfter '$ExpireAfter' is not supported\n" + unless ($ExpireAfter=~/^\d+[smhw]$/); +die "$CE \$UpdateTXT must be set when \$ExpireAfter is set\n" + if($ExpireAfter and not $UpdateTXT); +foreach my $rrtype (@ReplaceRR) { + die "$CE \$ReplaceRR contains unsupported type '$rrtype'\n" + unless ($DNS_label{$rrtype}); +} + + +############################## +# Determine what to do and fetch the input parameters +my $mode = $cgi->path_info || $cgi->param('mode') || '/status'; +$mode=~s/^\/([^\/]+)(\/(.*))?/$1/; +my $host = $cgi->param('host') || $3; +my $debug = ($AllowDebugKey eq 'off') ? 0 : ($AllowDebugKey eq ($cgi->param('debug') || '')); + + +############################## +# Dispatch the request to the correct handler +my %handlers = ( + status => \&handle_status, + update => \&handle_update, + delete => \&handle_update, + view => \&handle_view, + expire => \&handle_expire, +); +if($host eq '' and $mode cmp 'view' and $mode cmp 'expire') { + print $cgi->header(-status=>400, -type=>'text/plain'), + "ERROR - No host name to act on specified\n"; +} elsif(my $handler = $handlers{$mode}) { + # Replace provided host with that of a CNAME it points to and determine domain + my $dnshost = ($host) ? expand_CNAME($host) : undef; + my $dnsdomain = $cgi->param('domain') || ($dnshost=~/\.(.*)$/)[0]; + $handler->($cgi, $mode, $host, $dnshost, $dnsdomain, $debug); +} else { + print $cgi->header(-status=>($cgi->path_info) ? 404 : 400, + -type=>'text/plain'), + "ERROR - File Not Found / Invalid Mode '$mode' specified\n"; +} -- libgit2 0.22.2