#!/usr/bin/perl # # dyndns.pl - CGI-BIN script to handle Dynamic DNS updates through http # # Version 1.1, latest version, documentation and bugtracker available at: # https://gitlab.lindenaar.net/scripts/dyndns # # Copyright (c) 2013 - 2019 Frederik Lindenaar # # This script is free software: you can redistribute and/or modify it under the # terms of version 3 of the GNU General Public License as published by the Free # Software Foundation, or (at your option) any later version of the license. # # This script 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, visit <http://www.gnu.org/licenses/> to download it. # use strict; use CGI; use POSIX; use Net::DNS; use feature 'state'; my $ConfigFile = 'optional'; # hardcoded, either optional, required or ignore ############################## # Configuration section (defaults, can be set in config file) my $DNSServer = '192.168.1.1'; # DNS Server to communicate with (use IP!) my @DNSDomain = ( '?', '!', 0 ); # DNS Domain to support, match hostname with: # '?': take domain name from parameter 'domain' # '!': take domain name from virtualhost name # 0: take domain from hostname # positive number: last # parts from hostname # negative number: last # parts from virtualhost # any other string: use if hostname ends on it my $ExpandCNAMEs = 1; # CNAME levels to expand (0 to disable) my $AllowDebugKey = 'off'; # Debuging, 'off' to disable, '' for always on # and other values to enable with debug= param. my $DomainListKey = 'off'; # List operation, 'off' to disable, '' to always # allow and other values to enable with secret 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 $RecordTTL = '1h'; # TTL for created records, format: [0-9]+[mhws]? my $UpdateTXT = 'Last DynDNS update on'; # if set add TXT with this+date on update my $DeleteTXT = 'DynDNS cleared on'; # if set add TXT with this+date on delete ############################## # 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 *= ($units eq 'm') ? 60 # Seconds per minute : ($units eq 'h') ? 3600 # Seconds per hour : ($units eq 'd') ? 86400 # Seconds per day : 604800; # Seconds per week } 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 " . $rr->type . " in DNS_decode_rr()!, 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"; } } ############################## # Initialize CGI, determine whether debugging is on and declaire fail method my $cgi = CGI->new; my $debug = ($AllowDebugKey cmp 'off') && (($AllowDebugKey eq '') || ($AllowDebugKey eq $cgi->param('debug')) ); my $SE = 'System Error'; my $CE = 'Configuration Error'; my $PE = 'Required parameter missing'; sub fail($$;$) { my ($errormsg, $debugmsg, $exitcode) = @_; print $cgi->header(-status=>$exitcode || 503, -type=>'text/plain'), "ERROR - $errormsg" . ($debug ? ": $debugmsg\n" : "\n"); exit 0; } # 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) = @_; my @found; while(my $cname = DNS_get($host, 'CNAME')) { push(@found, $host); $host = $cname; fail("DNS CNAME Not supported", "$found[0] points to a CNAME but this is not supported", 400) unless($ExpandCNAMEs); fail("DNS CNAME Chain Error", "$found[0] has > $ExpandCNAMEs level deep CNAME chain", 400) unless($#found < $ExpandCNAMEs); foreach my $r (@found) { fail("DNS CNAME Loop", "found CNAME loop for $found[0]", 400) if($cname eq $r); } } return $host; } # Get signer and key CGI paramseters, abort with HTTP 400 error if not present sub get_authinfo($$) { my ($cgi, $host) = @_; # 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)); # Ensure we have a value for signer and key, otherwise abort the processing fail($PE, "No/incomplete authentication information provided", 400) if($signer eq '' or $key eq ''); # and return the values return($signer, $key); } # 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); my $ttl = periodSeconds($RecordTTL); # 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. $ttl A $ipv4")) if($ipv4); $dnsupdate->push(update=>rr_add("$dnshost. $ttl AAAA $ipv6")) if($ipv6); # Add a TXT record with the timestamp of the last update, if required if (my $txt = ($ipv4 or $ipv6) ? $UpdateTXT : $DeleteTXT) { my $timestamp = localtime(); $dnsupdate->push(update=>rr_add("$dnshost. $ttl TXT \"$txt $timestamp\"")); } # 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 (403, "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 ($mode, $host, $dnsdomain, $debug) = @_; my $dnshost = expand_CNAME($host); my ($signer, $key) = get_authinfo($cgi, $host); # 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'); if ($ipv4addr == 'auto') { $ipv4addr = is_ipv4($remote_addr) ? $remote_addr : undef; } my $ipv6addr = $cgi->param('ipv6addr') || $cgi->param('ipv6'); if ($ipv6addr == 'auto') { $ipv6addr = 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 ($mode, $host, $dnsdomain, $debug) = @_; my ($signer, $key) = get_authinfo($cgi, $host); 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, $rr->name, 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_view($$$$) { my ($mode, $host, $dnsdomain, $debug) = @_; my $dnshost = expand_CNAME($host); 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) { if(my $label = $DNS_label{$rr->type}) { print $cgi->Tr([ $cgi->td([$label, DNS_decode_rr($rr)]) ]); } } print $cgi->end_table(); print $cgi->end_html(); } sub handle_list($$$$) { my ($mode, $host, $dnsdomain, $debug) = @_; my $title = "DynDNS Updater - $dnsdomain"; fail("Operation not allowed", ($DomainListKey eq 'off') ? "List is disabled" : "No/incorrect authentication information provided", 403) if ($DomainListKey eq 'off') || (($DomainListKey cmp '') && ($DomainListKey cmp $cgi->param('secret'))); 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); if(my $label = $DNS_label{$rr->type}) { print $cgi->Tr([ $cgi->td([ ($lastname cmp $rr->name) ? $rr->name : '', $label, DNS_decode_rr($rr)]) ]); $lastname = $rr->name; } } print $cgi->end_table(); print $cgi->end_html(); } ############################## # Load configuration, if desired if ($ConfigFile cmp 'ignore') { my $CFGFile = $0; $CFGFile =~ s/(\.pl)?$/.cfg/; if (open (CONFIG, $CFGFile)) { my %CONFIG = ( allow_debug_key => \$AllowDebugKey, domain_list_key => \$DomainListKey, dns_server => \$DNSServer, dns_domain => \@DNSDomain, expand_cnames => \$ExpandCNAMEs, auth_mode => \$AuthMode, static_signer => \$StaticSigner, static_key => \$StaticKey, require_rr => \$RequireRR, replace_rr => \@ReplaceRR, update_txt => \$UpdateTXT, delete_txt => \$DeleteTXT, expire_after => \$ExpireAfter, record_ttl => \$RecordTTL, ); while (<CONFIG>) { chomp; s/^\s+//; s/\s*(#.*)?$//; # trim whitespace & comments next unless length; # skip empty lines my ($key, $value) = split(/\s*=\s*/, $_, 2); # split key and value my $dst = $CONFIG{$key}; # get destination for value if (ref $dst eq 'SCALAR') { $$dst = $value; } # store scalar value elsif (ref $dst eq 'CODE') { &$dst($value); } # call setter function elsif (ref $dst cmp 'ARRAY') { fail($SE, "Invalid config: $key"); } else { @$dst = split(/\s*,\s*/, $value); } # split and store array } close CONFIG; } elsif ($ConfigFile eq 'required') { fail($SE, "unable to load configuration from $CFGFile: $!"); } } ############################## # Validate Configuration fail($CE, "ConfigFile must be optional, required or ignore, not '$ConfigFile'") unless $ConfigFile=~/optional|required|ignore/; fail($CE, "AuthMode '$AuthMode' is unsupported must be remote, static or both") unless $AuthMode=~/remote|static|both/; fail($CE, "StaticSigner must be set for \$AuthMode '$AuthMode'") unless ($StaticSigner or $AuthMode eq 'remote'); fail($CE, "StaticKey must be set for \$AuthMode '$AuthMode'") unless ($StaticKey or $AuthMode eq 'remote'); fail($CE, "RequireRR is set to unsupported type '$RequireRR'") if ($RequireRR and not $DNS_label{$RequireRR}); fail($CE, "RecordTTL '$RecordTTL' is not supported") unless ($RecordTTL=~/^\d+[smhw]?$/); fail($CE, "ExpireAfter '$ExpireAfter' is not supported") unless ($ExpireAfter=~/^\d+[smhw]?$/); fail($CE, "UpdateTXT must be set when \$ExpireAfter is set") if($ExpireAfter and not $UpdateTXT); foreach my $rrtype (@ReplaceRR) { fail($CE, "ReplaceRR contains unsupported type '$rrtype'") unless exists $DNS_label{$rrtype}; } ############################## # Determine what to do and fetch the input parameters my $mode = $cgi->path_info || $cgi->param('mode') || 'view'; $mode=~s/^\/([^\/]+)(\/(.*))?/$1/; my $host = $cgi->param('host') || $3; my $dnsdomain; foreach my $d (@DNSDomain) { if ($d eq '!') { $d = $cgi->virtual_host; } elsif ($d eq '?') { $d = $cgi->param('domain'); } elsif ($d =~ /-?\d+/) { if ($d <0) { $d = join('.', splice(@{[ split(/\./, $cgi->virtual_host) ]}, $d)); } else { $d = join('.', splice(@{[ split(/\./, $host) ]}, ($d) ? -$d : 1)); } } $dnsdomain = $d if (!$host || length($host) == length($d)+rindex($host,$d)); last if $dnsdomain; } fail($PE, "No host name to act on specified", 400) unless $host || $mode eq 'list' || $mode eq 'expire'; fail($PE, "No host or domain name to act on specified", 400) unless $dnsdomain; ############################## # Dispatch the request to the correct handler my %handlers = ( view => \&handle_view, update => \&handle_update, delete => \&handle_update, list => \&handle_list, expire => \&handle_expire, ); if(my $handler = $handlers{$mode}) { $handler->($mode, $host, $dnsdomain, $debug); } else { fail("File Not Found", "Invalid Mode '$mode' specified", 404); }