Add files via upload

Catch up to changes in wimpunk/master.

ddclient

@@ -1,7 +1,6 @@
 #!/usr/bin/perl -w
 #!/usr/local/bin/perl -w
 ######################################################################
-# $Id: ddclient 184 2015-05-28 19:59:34Z wimpunk $
 #
 # DDCLIENT - a Perl client for updating DynDNS information
 #
@@ -25,8 +24,7 @@ use strict;
 use Getopt::Long;
 use Sys::Hostname;
 use IO::Socket;
-
+use Data::Validate::IP;
-# my ($VERSION) = q$Revision: 184 $ =~ /(\d+)/;
 
 my $version  = "3.8.3";
 my $programd  = $0; 
@@ -338,6 +336,7 @@ my %variables = (
 	'web-skip'            => setv(T_STRING,1, 0, 1, '',                   undef),
 	'fw'                  => setv(T_ANY,   0, 0, 1, '', 		      undef),
 	'fw-skip'             => setv(T_STRING,1, 0, 1, '',                   undef),
+	'fw-banlocal'         => setv(T_BOOL,  0, 0, 1, 0,                    undef),
 	'fw-login'            => setv(T_LOGIN, 1, 0, 1, '',                   undef),
 	'fw-password'         => setv(T_PASSWD,1, 0, 1, '',                   undef),
 	'cmd'                 => setv(T_PROG,  0, 0, 1, '',                   undef),
@@ -347,7 +346,7 @@ my %variables = (
 	'retry'               => setv(T_BOOL,  0, 0, 0, 0,                    undef),
 	'force'               => setv(T_BOOL,  0, 0, 0, 0,                    undef),
 	'ssl'                 => setv(T_BOOL,  0, 0, 0, 0,                    undef),
-
+    'ipv6'                 => setv(T_BOOL,  0, 0, 0, 0,                    undef),
 	'syslog'              => setv(T_BOOL,  0, 0, 1, 0,                    undef),
 	'facility'            => setv(T_STRING,0, 0, 1, 'daemon',             undef),
 	'priority'            => setv(T_STRING,0, 0, 1, 'notice',             undef),
@@ -377,11 +376,12 @@ my %variables = (
 	'web-skip'            => setv(T_STRING,0, 0, 1, '',                   undef),
 	'fw'                  => setv(T_ANY,   0, 0, 1, '', 		      undef),
 	'fw-skip'             => setv(T_STRING,0, 0, 1, '',                   undef),
+	'fw-banlocal'         => setv(T_BOOL,  0, 0, 1, 0,                    undef),
 	'fw-login'            => setv(T_LOGIN, 0, 0, 1, '',                   undef),
 	'fw-password'         => setv(T_PASSWD,0, 0, 1, '',                   undef),
 	'cmd'                 => setv(T_PROG,  0, 0, 1, '',                   undef),
 	'cmd-skip'            => setv(T_STRING,0, 0, 1, '',                   undef),
-
+    'ipv6'                => setv(T_BOOL,  0, 0, 0, 0,                    undef),
 	'ip'                  => setv(T_IP,     0, 1, 0, undef,               undef),
 	'wtime'               => setv(T_DELAY,  0, 1, 1, 0,                   interval('30s')),
 	'mtime'               => setv(T_NUMBER, 0, 1, 0, 0,                   undef),
@@ -438,6 +438,7 @@ my %variables = (
     'nsupdate-common-defaults' => {
 	'ttl'                 => setv(T_NUMBER, 0, 1, 0, 600,                 undef),
 	'zone'                => setv(T_STRING, 1, 1, 1, '',                  undef),
+	'tcp'                 => setv(T_BOOL,   0, 1, 1, 0,                   undef),
     },
 	'cloudflare-common-defaults'       => {
 		'server'	      => setv(T_FQDNP,  1, 0, 1, 'api.cloudflare.com/client/v4', undef),
@@ -446,6 +447,7 @@ my %variables = (
 		'wildcard'            => setv(T_BOOL,   0, 1, 1, 0,                   undef),
 		'mx'	              => setv(T_OFQDN,  0, 1, 1, '',                  undef),
 		'backupmx'            => setv(T_BOOL,   0, 1, 1, 0,                   undef),
+		'ttl'		      => setv(T_NUMBER, 1, 0, 1, 1,                   undef),
 	},
 	'googledomains-common-defaults'       => {
 		'server'	      => setv(T_FQDNP,  1, 0, 1, 'domains.google.com', undef),
@@ -454,6 +456,29 @@ my %variables = (
 			'server'              => setv(T_FQDNP,  1, 0, 1, 'www.duckdns.org', undef),
 			'login'               => setv(T_LOGIN,  0, 0, 0, 'unused',            undef),
 	},
+    'woima-common-defaults'       => {
+        'static'              => setv(T_BOOL,   0, 1, 1, 0,                   undef),
+        'wildcard'            => setv(T_BOOL,   0, 1, 1, 0,                   undef),
+        'mx'	              => setv(T_OFQDN,  0, 1, 1, '',                  undef),
+        'backupmx'            => setv(T_BOOL,   0, 1, 1, 0,                   undef),
+        'custom'              => setv(T_BOOL,   0, 1, 1, 0,                   undef),
+        'script'              => setv(T_STRING, 1, 1, 1, '/nic/update',       undef),
+    },
+    'woima-service-common-defaults'       => {
+        'server'	          => setv(T_FQDNP,  1, 0, 1, 'dyn.woima.fi',      undef),
+        'login'               => setv(T_LOGIN,  1, 0, 1, '',                  undef),
+        'password'            => setv(T_PASSWD, 1, 0, 1, '',                  undef),
+        'ip'                  => setv(T_IP,     0, 1, 0, undef,               undef),
+        'wtime'               => setv(T_DELAY,  0, 1, 1, 0,                   interval('30s')),
+        'mtime'               => setv(T_NUMBER, 0, 1, 0, 0,                   undef),
+        'atime'               => setv(T_NUMBER, 0, 1, 0, 0,                   undef),
+        'status'              => setv(T_ANY,    0, 1, 0, '',                  undef),
+        'min-interval'        => setv(T_DELAY,  0, 0, 1, interval('30s'),     0),
+        'max-interval'        => setv(T_DELAY,  0, 0, 1, interval('25d'),     0),
+        'min-error-interval'  => setv(T_DELAY,  0, 0, 1, interval('5m'),      0),
+        'warned-min-interval'       => setv(T_ANY,    0, 1, 0, 0,             undef),
+        'warned-min-error-interval' => setv(T_ANY,    0, 1, 0, 0,             undef),
+    },
 );
 my %services = (
     'dyndns1' => {
@@ -638,6 +663,15 @@ my %services = (
                           $variables{'service-common-defaults'},
                         ),
     },
+    'woima' => {
+        'updateable' => undef,
+        'update'     => \&nic_woima_update,
+        'examples'   => \&nic_woima_examples,
+        'variables'  => merge(
+            $variables{'woima-common-defaults'},
+            $variables{'woima-service-common-defaults'},
+        ),
+    },
 );
 $variables{'merged'} = merge($variables{'global-defaults'},
 			     $variables{'service-common-defaults'},
@@ -670,6 +704,7 @@ my @opt = (
     "",
     [ "fw",          "=s", "-fw address|url       : obtain IP address from firewall at 'address'" ],
     [ "fw-skip",     "=s", "-fw-skip pattern      : skip any IP addresses before 'pattern' on the firewall address|url" ],
+    [ "fw-banlocal", "!", "-fw-banlocal           : ignore local IP addresses on the firewall address|url" ],
     [ "fw-login",    "=s", "-fw-login login       :   use 'login' when getting IP from fw" ],
     [ "fw-password", "=s", "-fw-password secret   :   use password 'secret' when getting IP from fw" ],
     "",			     
@@ -696,6 +731,7 @@ my @opt = (
     [ "debug",       "!",  "-{no}debug            : print {no} debugging information" ],
     [ "verbose",     "!",  "-{no}verbose          : print {no} verbose information" ],
     [ "quiet",       "!",  "-{no}quiet            : print {no} messages for unnecessary updates" ],
+    [ "ipv6",        "!",  "-{no}ipv6             : use ipv6" ],
     [ "help",        "",   "-help                 : this message" ],
     [ "postscript",  "",   "-postscript           : script to run after updating ddclient, has new IP as param" ],
 
@@ -870,8 +906,10 @@ sub update_nics {
 					next;
 				}
 				if ($ip !~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) {
+                    if( !ipv6_match($ip) ) {            
 					    warning("malformed IP address (%s)", $ip);
 					    next;
+                    }
 				}
 				$iplist{$use}{$arg_ip}{$arg_fw}{$arg_if}{$arg_web}{$arg_cmd} = $ip;
 			}
@@ -1013,7 +1051,7 @@ sub parse_assignment {
     my ($c, $name, $value);
     my ($escape, $quote) = (0, '');
 
-    if ($rest =~ /^\s*([a-z][a-z_-]*)=(.*)/i) {
+    if ($rest =~ /^\s*([a-z][0-9a-z_-]*)=(.*)/i) {
 	($name, $rest, $value) = ($1, $2, '');
 
 	while (length($c = substr($rest,0,1))) {
@@ -1817,8 +1855,10 @@ sub check_value {
 #	return undef if $value =~ /:/;
 
     } elsif ($type eq T_IP) {
+    if( !ipv6_match($value) ) {
         return undef if $value !~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/;
       }
+    }
     return $value;
 }
 ######################################################################
@@ -1856,6 +1896,24 @@ EOM
     import  IO::Socket::SSL;
     { no warnings; $IO::Socket::SSL::DEBUG = 0; }
 }
+
+######################################################################
+## load_ipv6_support
+######################################################################
+sub load_ipv6_support {
+    my $ipv6_loaded = eval {require IO::Socket::INET6};
+    unless ($ipv6_loaded) {
+        fatal(<<"EOM");
+Error loading the Perl module IO::Socket::INET6 needed for ipv6 connect.
+On Debian, the package libio-socket-inet6-perl must be installed.
+On Red Hat, the package perl-IO-Socket-INET6 must be installed.
+On Alpine, the package perl-io-socket-inet6 must be installed.
+EOM
+    }
+    import IO::Socket::INET6;
+    { no warnings; $IO::Socket::INET6::DEBUG = 0; }
+}
+
 ######################################################################
 ## load_sha1_support
 ######################################################################
@@ -1968,6 +2026,16 @@ sub geturl {
             Timeout => opt('timeout'),
         );
 	    defined $sd or warning("cannot connect to $peer:$port socket: $@ " . IO::Socket::SSL::errstr());
+    } elsif ($globals{'ipv6'}) {
+        load_ipv6_support;
+	    $sd = IO::Socket::INET6->new(
+            PeerAddr => $peer,
+            PeerPort => $port,
+            Proto => 'tcp',
+            MultiHomed => 1,
+            Timeout => opt('timeout'),
+        );
+	    defined $sd or warning("cannot connect to $peer:$port socket: $@");
     } else {
 	    $sd = IO::Socket::INET->new(
             PeerAddr => $peer,
@@ -2028,6 +2096,48 @@ sub geturl {
     return $reply;
 }
 ######################################################################
+## un_zero_pad
+######################################################################
+sub un_zero_pad {
+	my $in_str = shift(@_);
+	my @out_str = ();
+
+	if ($in_str eq '0.0.0.0') {
+	    return $in_str;
+	}
+
+	foreach my $block (split /\./, $in_str) {
+	    $block =~ s/^0+//;
+	    if ($block eq '') {
+		$block = '0';
+	    }
+	    push @out_str, $block;
+	}
+	return join('.', @out_str);
+}
+######################################################################
+## filter_local
+######################################################################
+sub filter_local {
+	my $in_ip = shift(@_);
+
+	if ($in_ip eq '0.0.0.0') {
+	    return $in_ip;
+	}
+
+	my @guess_local = (
+	    '^10\.',
+	    '^172\.(?:1[6-9]|2[0-9]|3[01])\.',
+	    '^192\.168'
+	);
+	foreach my $block (@guess_local) {
+	    if ($in_ip =~ /$block/) {
+		return '0.0.0.0';
+	    }
+	}
+	return $in_ip;
+}
+######################################################################
 ## get_ip
 ######################################################################
 sub get_ip {
@@ -2124,6 +2234,13 @@ sub get_ip {
     }
     if ($reply =~ /^.*?\b(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\b.*/is) {
 	    $ip = $1;
+        $ip = un_zero_pad($ip);
+	    $ip = filter_local($ip) if opt('fw-banlocal', $h);
+    } elsif ( $ip = ipv6_match($reply) ) {
+        $ip = un_zero_pad($ip);
+        $ip = filter_local($ip) if opt('fw-banlocal', $h);
+    } else {
+       warning("found neither ipv4 nor ipv6 address");
     }
     if (($use ne 'ip') && (define($ip,'') eq '0.0.0.0')) {
 	$ip = undef;
@@ -2133,6 +2250,34 @@ sub get_ip {
     return $ip;
 }
 
+######################################################################
+## ipv6_match determine ipv6 address from given string and return them
+######################################################################
+sub ipv6_match {
+	my $content = shift;
+	my $omits;
+    my $ip = "";
+    my $linenumbers = 0;
+ 
+    my @values = split('\n', $content);
+    foreach my $val (@values) {
+        next unless $val =~ /((:{0,2}[A-F0-9]{1,4}){0,7}:{1,2}[A-F0-9]{1,4})/ai; # invalid char
+        my $parsed = $1;
+        
+        # check for at least 7 colons
+        my $count_colon = () = $parsed =~ /:/g;
+        if ($count_colon != 7) {
+            # or one double colon
+            my $count_double_colon = () = $parsed =~ /::/g;
+            if ($count_double_colon != 1) {
+                next
+            } 
+        }       
+        return $parsed;
+    }
+    return;    
+}
+
 ######################################################################
 ## group_hosts_by
 ######################################################################
@@ -3633,10 +3778,7 @@ EoEXAMPLE
 ##
 ######################################################################
 sub nic_freedns_update {
-
-
     debug("\nnic_freedns_update -------------------");
-
     ## First get the list of updatable hosts
     my $url;
     $url = "http://$config{$_[0]}{'server'}/api/?action=getdyndns&sha=".&sha1_hex("$config{$_[0]}{'login'}|$config{$_[0]}{'password'}");
@@ -3683,6 +3825,12 @@ sub nic_freedns_update {
                 $config{$h}{'mtime'}  = $now;
                 $config{$h}{'status'} = 'good';
                 success("updating %s: good: IP address set to %s", $h, $ip);
+            } elsif ($reply =~ /Address (\d+\.\d+\.\d+\.\d+) has not changed/) {
+                $ip = $1;
+                $config{$h}{'mtime'}  = $now;
+                $config{$h}{'status'} = 'good';
+                $config{$h}{'ip'}     = $ip;
+                success("updating %s: good: IP address %s has not changed", $h, $ip);
             } else {
                 $config{$h}{'status'} = 'failed';
                 warning("SENT: %s", $freedns_hosts{$h}->[2]) unless opt('verbose');
@@ -3951,6 +4099,10 @@ Configuration variables applicable to the 'nsupdate' protocol are:
   zone=dyn.example.com         ## forward zone that is to be updated
   ttl=600                      ## time to live of the record;
                                ## defaults to 600 seconds
+  tcp=off|on                   ## nsupdate uses UDP by default, and switches to
+                               ## TCP if the update is too large to fit in a
+                               ## UDP datagram; this setting forces TCP;
+                               ## defaults to off
   login=/usr/bin/nsupdate      ## path and name of nsupdate binary;
                                ## defaults to '/usr/bin/nsupdate'
   <hostname>                   ## fully qualified hostname to update
@@ -3987,6 +4139,12 @@ sub nic_nsupdate_update {
 		my $server = $config{$h}{'server'};
 		my $zone = $config{$h}{'zone'};
 		my $ip = $config{$h}{'wantip'};
+		my $recordtype = '';
+		if (is_ipv6($ip)) {
+		    $recordtype = 'AAAA';
+		} else {
+		    $recordtype = 'A';
+		}
 		delete $config{$_}{'wantip'} foreach @hosts;
 
 		info("setting IP address to %s for %s", $ip, $hosts);
@@ -3999,14 +4157,15 @@ zone $zone.
 EoINSTR1
 		foreach (@hosts) {
 			$instructions .= <<EoINSTR2;
-update delete $_. A
+update delete $_. $recordtype
-update add $_. $config{$_}{'ttl'} A $ip
+update add $_. $config{$_}{'ttl'} $recordtype $ip
 EoINSTR2
 		}
 		$instructions .= <<EoINSTR3;
 send
 EoINSTR3
 		my $command = "$binary -k $keyfile";
+		$command .= " -v" if ynu($config{$h}{'tcp'}, 1, 0, 0);
 		$command .= " -d" if (opt('debug'));
 		verbose("UPDATE:", "nsupdate command is: %s", $command);
 		verbose("UPDATE:", "nsupdate instructions are:\n%s", $instructions);
@@ -4253,6 +4412,182 @@ sub nic_duckdns_update {
     }
 }
 
+######################################################################
+## nic_woima_examples
+######################################################################
+sub nic_woima_examples {
+    return <<EoEXAMPLE;
+o 'woima'
+
+The 'woima' protocol is used by the free
+dynamic DNS service offered by woima.fi.
+It offers also nameservers for own domains for free.
+Dynamic DNS service for own domains is not free.
+
+Configuration variables applicable to the 'woima' protocol are:
+  protocol=woima             ## 
+  server=fqdn.of.service       ## defaults to dyn.woima.fi
+  script=/path/to/script       ## defaults to /nic/update
+  backupmx=no|yes              ## indicates that this host is the primary MX for the domain.
+  static=no|yes                ## indicates that this host has a static IP address.
+  custom=no|yes                ## indicates that this host is a 'custom' top-level domain name.
+  mx=any.host.domain           ## a host MX'ing for this host definition.
+  wildcard=no|yes              ## add a DNS wildcard CNAME record that points to {host}
+  login=service-login          ## login name and password  registered with the service
+  password=service-password    ##
+  fully.qualified.host         ## the host registered with the service.
+
+Example ${program}.conf file entries:
+  ## single host update
+  protocol=woima,                                         \\
+  login=my-dyndns.org-login,                                \\
+  password=my-dyndns.org-password                           \\
+  myhost.dyndns.org 
+
+  ## multiple host update with wildcard'ing mx, and backupmx
+  protocol=woima,                                         \\
+  login=my-dyndns.org-login,                                \\
+  password=my-dyndns.org-password,                          \\
+  mx=a.host.willing.to.mx.for.me,backupmx=yes,wildcard=yes  \\
+  myhost.dyndns.org,my2ndhost.dyndns.org 
+
+  ## multiple host update to the custom DNS service
+  protocol=woima,                                         \\
+  login=my-dyndns.org-login,                                \\
+  password=my-dyndns.org-password                           \\
+  my-toplevel-domain.com,my-other-domain.com
+EoEXAMPLE
+}
+######################################################################
+## nic_woima_update
+######################################################################
+sub nic_woima_update {
+    debug("\nnic_woima_update -------------------");
+    
+    my %errors = (
+       'badauth'  => 'Bad authorization (username or password)',
+       'badsys'   => 'The system parameter given was not valid',
+
+       'notfqdn'  => 'A Fully-Qualified Domain Name was not provided',
+       'nohost'   => 'The hostname specified does not exist in the database',
+       '!yours'   => 'The hostname specified exists, but not under the username currently being used',
+       '!donator' => 'The offline setting was set, when the user is not a donator',
+       '!active'  => 'The hostname specified is in a Custom DNS domain which has not yet been activated.',
+       'abuse',   => 'The hostname specified is blocked for abuse; you should receive an email notification ' . 
+                     'which provides an unblock request link.  More info can be found on ' . 
+                     'https://www.dyndns.com/support/abuse.html',
+
+       'numhost'  => 'System error: Too many or too few hosts found. Contact support@dyndns.org',
+       'dnserr'   => 'System error: DNS error encountered. Contact support@dyndns.org',
+
+       'nochg'    => 'No update required; unnecessary attempts to change to the current address are considered abusive',
+    );
+    
+    my @hosts = @_;
+    foreach my $key (keys @hosts) {
+        my $h = $hosts[$key];
+        my $ip = $config{$h}{'wantip'};
+        delete $config{$h}{'wantip'};
+    
+        info("setting IP address to %s for %s", $ip, $h);
+        verbose("UPDATE:","updating %s", $h);
+    
+        ## Select the DynDNS system to update
+        my $url = "http://$config{$h}{'server'}$config{$h}{'script'}?system=";
+        if ($config{$h}{'custom'}) {
+            warning("updating %s: 'custom' and 'static' may not be used together. ('static' ignored)", $h)
+            if $config{$h}{'static'};
+    #	    warning("updating %s: 'custom' and 'offline' may not be used together. ('offline' ignored)", $h)
+    #	      if $config{$h}{'offline'};
+            $url .= 'custom';
+    
+        } elsif  ($config{$h}{'static'}) {
+    #	    warning("updating %s: 'static' and 'offline' may not be used together. ('offline' ignored)", $h)
+    #	      if $config{$h}{'offline'};
+            $url .= 'statdns';
+    
+        } else {
+            $url .= 'dyndns';
+        }
+    
+        $url  .= "&hostname=$h";
+        $url  .= "&myip=";
+        $url  .= $ip            if $ip;
+    
+        ## some args are not valid for a custom domain.
+        $url  .= "&wildcard=ON" if ynu($config{$h}{'wildcard'}, 1, 0, 0);
+        if ($config{$h}{'mx'}) {
+            $url .= "&mx=$config{$h}{'mx'}";
+            $url .= "&backmx=" . ynu($config{$h}{'backupmx'}, 'YES', 'NO');
+        }
+    
+        my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'});
+        if (!defined($reply) || !$reply) {
+            failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
+            last;
+        }
+        last if !header_ok($h, $reply);
+    
+        my @reply = split /\n/, $reply;
+        my $state = 'header';
+        my $returnedip = $ip;
+    
+        foreach my $line (@reply) {
+            if ($state eq 'header') {
+                $state = 'body';
+            
+            } elsif ($state eq 'body') {
+                $state = 'results' if $line eq '';
+            
+            } elsif ($state =~ /^results/) {
+                $state = 'results2';
+    
+                # bug #10: some dyndns providers does not return the IP so
+                # we can't use the returned IP
+                my ($status, $returnedip) = split / /, lc $line;
+                $ip = $returnedip if (not $ip);
+                #my $h = shift @hosts;
+            
+                $config{$h}{'status'} = $status;
+                if ($status eq 'good') {
+                    $config{$h}{'ip'}     = $ip;
+                    $config{$h}{'mtime'}  = $now;
+                    success("updating %s: %s: IP address set to %s", $h, $status, $ip);
+                
+                } elsif (exists $errors{$status}) {
+                    if ($status eq 'nochg') {
+                    warning("updating %s: %s: %s", $h, $status, $errors{$status});
+                    $config{$h}{'ip'}     = $ip;
+                        $config{$h}{'mtime'}  = $now;
+                    $config{$h}{'status'} = 'good';
+                    
+                    } else {
+                    failed("updating %s: %s: %s", $h, $status, $errors{$status});
+                    }
+        
+                } elsif ($status =~ /w(\d+)(.)/) {
+                    my ($wait, $units) = ($1, lc $2);
+                    my ($sec,  $scale) = ($wait, 1);
+                
+                    ($scale, $units) = (1, 'seconds')   if $units eq 's';
+                    ($scale, $units) = (60, 'minutes')  if $units eq 'm';
+                    ($scale, $units) = (60*60, 'hours') if $units eq 'h';
+        
+                    $sec = $wait * $scale;
+                    $config{$h}{'wtime'} = $now + $sec;
+                    warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip);
+                
+                } else {
+                    failed("updating %s: %s: unexpected status (%s)", $h, $line);
+                } 	
+            }
+        }
+        failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'})
+            if $state ne 'results2';
+    }
+}
+
+
 ######################################################################
 # vim: ai ts=4 sw=4 tw=78 :