add ipv6 support
This commit is contained in:
Gerald Hansen
parent
027fa03895
commit
dc01f09224
2 changed files with 95 additions and 65 deletions
|
|
@ -25,7 +25,7 @@ Dynamic DNS services currently supported include:
|
|||
nsupdate - See nsupdate(1) and ddns-confgen(8) for details
|
||||
CloudFlare - See https://www.cloudflare.com/ for details
|
||||
Google - See http://www.google.com/domains for details
|
||||
Duckdns - See https://duckdns.org/ for details
|
||||
Duckdns - See https://duckdns.org/ for details
|
||||
woima.fi - See https://woima.fi/ for details
|
||||
|
||||
DDclient now supports many of cable/dsl broadband routers.
|
||||
|
|
@ -42,8 +42,9 @@ REQUIREMENTS:
|
|||
- one or more accounts from one of the dynamic DNS services
|
||||
|
||||
- Perl 5.014 or later
|
||||
(you need the IO::Socket::SSL perl library for ssl-support
|
||||
and JSON::Any perl library for JSON support)
|
||||
(you need the IO::Socket::SSL perl library for ssl-support,
|
||||
JSON::Any perl library for JSON support and
|
||||
IO::Socket:INET6 perl library for ipv6-support)
|
||||
|
||||
- Linux or probably any common Unix system
|
||||
|
||||
|
|
|
|||
153
ddclient
153
ddclient
|
|
@ -345,12 +345,12 @@ 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),
|
||||
'mail' => setv(T_EMAIL, 0, 0, 1, '', undef),
|
||||
'mail-failure' => setv(T_EMAIL, 0, 0, 1, '', undef),
|
||||
'mail' => setv(T_EMAIL, 0, 0, 1, '', undef),
|
||||
'mail-failure' => setv(T_EMAIL, 0, 0, 1, '', undef),
|
||||
|
||||
'exec' => setv(T_BOOL, 0, 0, 1, 1, undef),
|
||||
'debug' => setv(T_BOOL, 0, 0, 1, 0, undef),
|
||||
|
|
@ -380,7 +380,7 @@ my %variables = (
|
|||
'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),
|
||||
|
|
@ -681,7 +681,7 @@ my @opt = (
|
|||
"usage: ${program} [options]",
|
||||
"options are:",
|
||||
[ "daemon", "=s", "-daemon delay : run as a daemon, specify delay as an interval." ],
|
||||
[ "foreground", "!", "-foreground : do not fork" ],
|
||||
[ "foreground", "!", "-foreground : do not fork" ],
|
||||
[ "proxy", "=s", "-proxy host : use 'host' as the HTTP proxy" ],
|
||||
[ "server", "=s", "-server host : update DNS information on 'host'" ],
|
||||
[ "protocol", "=s", "-protocol type : update protocol used" ],
|
||||
|
|
@ -729,6 +729,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" ],
|
||||
|
||||
|
|
@ -1048,7 +1049,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))) {
|
||||
|
|
@ -1161,7 +1162,7 @@ sub _read_config {
|
|||
|
||||
## verify that keywords are valid...and check the value
|
||||
foreach my $k (keys %locals) {
|
||||
$locals{$k} = $passwords{$k} if defined $passwords{$k};
|
||||
$locals{$k} = $passwords{$k} if defined $passwords{$k};
|
||||
if (!exists $variables{'merged'}{$k}) {
|
||||
warning("unrecognized keyword '%s' (ignored)", $k);
|
||||
delete $locals{$k};
|
||||
|
|
@ -1258,14 +1259,14 @@ sub init_config {
|
|||
## and those in -options=...
|
||||
if (exists $options{'host'}) {
|
||||
foreach my $h (split_by_comma($options{'host'})) {
|
||||
push @hosts, $h;
|
||||
push @hosts, $h;
|
||||
}
|
||||
delete $options{'host'};
|
||||
}
|
||||
## merge options into host definitions or globals
|
||||
if (@hosts) {
|
||||
foreach my $h (@hosts) {
|
||||
$config{$h} = merge(\%options, $config{$h});
|
||||
$config{$h} = merge(\%options, $config{$h});
|
||||
}
|
||||
$opt{'host'} = join(',', @hosts);
|
||||
} else {
|
||||
|
|
@ -1275,14 +1276,14 @@ sub init_config {
|
|||
|
||||
## override global options with those on the command-line.
|
||||
foreach my $o (keys %opt) {
|
||||
if (defined $opt{$o} && exists $variables{'global-defaults'}{$o}) {
|
||||
$globals{$o} = $opt{$o};
|
||||
}
|
||||
if (defined $opt{$o} && exists $variables{'global-defaults'}{$o}) {
|
||||
$globals{$o} = $opt{$o};
|
||||
}
|
||||
}
|
||||
|
||||
## sanity check
|
||||
if (defined $opt{'host'} && defined $opt{'retry'}) {
|
||||
usage("options -retry and -host (or -option host=..) are mutually exclusive");
|
||||
usage("options -retry and -host (or -option host=..) are mutually exclusive");
|
||||
}
|
||||
|
||||
## determine hosts to update (those on the cmd-line, config-file, or failed cached)
|
||||
|
|
@ -1312,14 +1313,14 @@ sub init_config {
|
|||
## make sure config entries have all defaults and they meet minimums
|
||||
## first the globals...
|
||||
foreach my $k (keys %globals) {
|
||||
my $def = $variables{'merged'}{$k};
|
||||
my $ovalue = define($globals{$k}, $def->{'default'});
|
||||
my $value = check_value($ovalue, $def);
|
||||
if ($def->{'required'} && !defined $value) {
|
||||
$value = default($k);
|
||||
warning("'%s=%s' is an invalid %s. (using default of %s)", $k, $ovalue, $def->{'type'}, $value);
|
||||
}
|
||||
$globals{$k} = $value;
|
||||
my $def = $variables{'merged'}{$k};
|
||||
my $ovalue = define($globals{$k}, $def->{'default'});
|
||||
my $value = check_value($ovalue, $def);
|
||||
if ($def->{'required'} && !defined $value) {
|
||||
$value = default($k);
|
||||
warning("'%s=%s' is an invalid %s. (using default of %s)", $k, $ovalue, $def->{'type'}, $value);
|
||||
}
|
||||
$globals{$k} = $value;
|
||||
}
|
||||
|
||||
## now the host definitions...
|
||||
|
|
@ -1893,6 +1894,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-ssl-perl must be installed.
|
||||
On Red Hat, the package perl-IO-Socket-SSL must be installed.
|
||||
On Alpine, the package perl-io-socket-ssl must be installed.
|
||||
EOM
|
||||
}
|
||||
import IO::Socket::INET6;
|
||||
{ no warnings; $IO::Socket::INET6::DEBUG = 0; }
|
||||
}
|
||||
|
||||
######################################################################
|
||||
## load_sha1_support
|
||||
######################################################################
|
||||
|
|
@ -1988,8 +2007,8 @@ sub geturl {
|
|||
# local $^W = 0;
|
||||
$0 = sprintf("%s - connecting to %s port %s", $program, $peer, $port);
|
||||
if (! opt('exec')) {
|
||||
debug("skipped network connection");
|
||||
verbose("SENDING:", "%s", $request);
|
||||
debug("skipped network connection");
|
||||
verbose("SENDING:", "%s", $request);
|
||||
} elsif ($use_ssl) {
|
||||
$sd = IO::Socket::SSL->new(
|
||||
PeerAddr => $peer,
|
||||
|
|
@ -1999,6 +2018,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,
|
||||
|
|
@ -2141,63 +2170,63 @@ sub get_ip {
|
|||
}
|
||||
|
||||
} elsif (($use eq 'cisco')) {
|
||||
# Stuff added to support Cisco router ip http daemon
|
||||
# User fw-login should only have level 1 access to prevent
|
||||
# password theft. This is pretty harmless.
|
||||
my $queryif = opt('if', $h);
|
||||
$skip = opt('fw-skip', $h) || '';
|
||||
# Stuff added to support Cisco router ip http daemon
|
||||
# User fw-login should only have level 1 access to prevent
|
||||
# password theft. This is pretty harmless.
|
||||
my $queryif = opt('if', $h);
|
||||
$skip = opt('fw-skip', $h) || '';
|
||||
|
||||
# Convert slashes to protected value "\/"
|
||||
$queryif =~ s%\/%\\\/%g;
|
||||
# Convert slashes to protected value "\/"
|
||||
$queryif =~ s%\/%\\\/%g;
|
||||
|
||||
# Protect special HTML characters (like '?')
|
||||
$queryif =~ s/([\?&= ])/sprintf("%%%02x",ord($1))/ge;
|
||||
# Protect special HTML characters (like '?')
|
||||
$queryif =~ s/([\?&= ])/sprintf("%%%02x",ord($1))/ge;
|
||||
|
||||
$url = "http://".opt('fw', $h)."/level/1/exec/show/ip/interface/brief/${queryif}/CR";
|
||||
$reply = geturl('', $url, opt('fw-login', $h), opt('fw-password', $h)) || '';
|
||||
$arg = $url;
|
||||
$url = "http://".opt('fw', $h)."/level/1/exec/show/ip/interface/brief/${queryif}/CR";
|
||||
$reply = geturl('', $url, opt('fw-login', $h), opt('fw-password', $h)) || '';
|
||||
$arg = $url;
|
||||
|
||||
} elsif (($use eq 'cisco-asa')) {
|
||||
# Stuff added to support Cisco ASA ip https daemon
|
||||
# User fw-login should only have level 1 access to prevent
|
||||
# password theft. This is pretty harmless.
|
||||
my $queryif = opt('if', $h);
|
||||
$skip = opt('fw-skip', $h) || '';
|
||||
# Stuff added to support Cisco ASA ip https daemon
|
||||
# User fw-login should only have level 1 access to prevent
|
||||
# password theft. This is pretty harmless.
|
||||
my $queryif = opt('if', $h);
|
||||
$skip = opt('fw-skip', $h) || '';
|
||||
|
||||
# Convert slashes to protected value "\/"
|
||||
$queryif =~ s%\/%\\\/%g;
|
||||
# Convert slashes to protected value "\/"
|
||||
$queryif =~ s%\/%\\\/%g;
|
||||
|
||||
# Protect special HTML characters (like '?')
|
||||
$queryif =~ s/([\?&= ])/sprintf("%%%02x",ord($1))/ge;
|
||||
# Protect special HTML characters (like '?')
|
||||
$queryif =~ s/([\?&= ])/sprintf("%%%02x",ord($1))/ge;
|
||||
|
||||
$url = "https://".opt('fw', $h)."/exec/show%20interface%20${queryif}";
|
||||
$reply = geturl('', $url, opt('fw-login', $h), opt('fw-password', $h)) || '';
|
||||
$arg = $url;
|
||||
$url = "https://".opt('fw', $h)."/exec/show%20interface%20${queryif}";
|
||||
$reply = geturl('', $url, opt('fw-login', $h), opt('fw-password', $h)) || '';
|
||||
$arg = $url;
|
||||
|
||||
} else {
|
||||
$url = opt('fw', $h) || '';
|
||||
$skip = opt('fw-skip', $h) || '';
|
||||
$url = opt('fw', $h) || '';
|
||||
$skip = opt('fw-skip', $h) || '';
|
||||
|
||||
if (exists $builtinfw{$use}) {
|
||||
$skip = $builtinfw{$use}->{'skip'} unless $skip;
|
||||
$url = "http://${url}" . $builtinfw{$use}->{'url'} unless $url =~ /\//;
|
||||
}
|
||||
$arg = $url;
|
||||
if (exists $builtinfw{$use}) {
|
||||
$skip = $builtinfw{$use}->{'skip'} unless $skip;
|
||||
$url = "http://${url}" . $builtinfw{$use}->{'url'} unless $url =~ /\//;
|
||||
}
|
||||
$arg = $url;
|
||||
|
||||
if ($url) {
|
||||
$reply = geturl('', $url, opt('fw-login', $h), opt('fw-password', $h)) || '';
|
||||
if ($url) {
|
||||
$reply = geturl('', $url, opt('fw-login', $h), opt('fw-password', $h)) || '';
|
||||
}
|
||||
}
|
||||
}
|
||||
if (!defined $reply) {
|
||||
$reply = '';
|
||||
if (!defined $reply) {
|
||||
$reply = '';
|
||||
}
|
||||
if ($skip) {
|
||||
$skip =~ s/ /\\s/is;
|
||||
$reply =~ s/^.*?${skip}//is;
|
||||
$skip =~ s/ /\\s/is;
|
||||
$reply =~ s/^.*?${skip}//is;
|
||||
}
|
||||
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 = un_zero_pad($ip);
|
||||
$ip = filter_local($ip) if opt('fw-banlocal', $h);
|
||||
} elsif ( $ip = ipv6_match($reply) ) {
|
||||
$ip = un_zero_pad($ip);
|
||||
|
|
|
|||
Loading…
Reference in a new issue