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