8073 lines
324 KiB
Perl
Executable file
8073 lines
324 KiB
Perl
Executable file
#!/usr/bin/perl
|
||
######################################################################
|
||
#
|
||
# DDCLIENT - a Perl client for updating DynDNS information
|
||
#
|
||
# Original Author: Paul Burry (paul+ddclient@burry.ca)
|
||
# Current maintainers:
|
||
# Reuben Thomas <rrt@sc3d.org>
|
||
# Lenard Heß <lenard@rrhess.de>
|
||
#
|
||
# website: https://github.com/ddclient/ddclient
|
||
#
|
||
######################################################################
|
||
package ddclient;
|
||
require v5.10.1;
|
||
use strict;
|
||
use warnings;
|
||
use Data::Dumper;
|
||
use File::Basename;
|
||
use File::Path qw(make_path);
|
||
use File::Temp;
|
||
use Getopt::Long;
|
||
use Sys::Hostname;
|
||
|
||
# Declare the ddclient version number.
|
||
#
|
||
# Perl's version strings do not support pre-release versions (alpha/development, beta, or release
|
||
# candidate) very well. The best it does is an optional underscore between arbitrary digits in the
|
||
# final component (e.g., "v1.2.3_4"). The underscore doesn't behave as most developers expect; it
|
||
# is treated as if it never existed (e.g., "v1.2.3_4" becomes "v1.2.34") except:
|
||
#
|
||
# * $v->is_alpha() will return true
|
||
# * $v->is_strict() will return false
|
||
# * $v->stringify() preserves the underscore (in its original position)
|
||
#
|
||
# Note that version::normal and version::numify lose information because the underscore is
|
||
# effectively removed.
|
||
#
|
||
# To work around Perl's limitations, human-readable versions are translated to/from Perl versions
|
||
# as follows:
|
||
#
|
||
# Human-readable Perl version Notes
|
||
# -------------------------------------------------------------------------------------------
|
||
# 1.2.3~alpha v1.2.3.0_0 compares equal to Perl version v1.2.3 (unfortunately)
|
||
# 1.2.3~betaN v1.2.3.0_N 1 <= N < 900; compares equal to Perl v1.2.3.N
|
||
# 1.2.3~rcN v1.2.3.0_M 1 <= N < 99; M = N + 900; compares equal to Perl v1.2.3.M
|
||
# 1.2.3 v1.2.3.999 for releases; no underscore in Perl version string
|
||
# 1.2.3rN v1.2.3.999.N 1 <= N < 1000; for re-releases, if necessary (rare)
|
||
#
|
||
# A tilde is used to separate "alpha", "beta", and "rc" from the version numbers because it has
|
||
# special meaning for the version comparison algorithms in RPM and Debian:
|
||
# https://docs.fedoraproject.org/en-US/packaging-guidelines/Versioning/#_handling_non_sorting_versions_with_tilde_dot_and_caret
|
||
# https://manpages.debian.org/bookworm/dpkg-dev/deb-version.7.en.html
|
||
#
|
||
# No period separator is required between "beta", "rc", or "r" and its adjacent number(s); both RPM
|
||
# and Debian will compare the adjacent number numerically, not lexicographically ("~beta2" sorts
|
||
# before "~beta10" as expected).
|
||
#
|
||
# The Perl version is declared first then converted to a human-readable form. It would be nicer to
|
||
# declare a human-readable version string and convert that to a Perl version string, but various
|
||
# tools in the Perl ecosystem require the line of source code that defines the VERSION variable to
|
||
# be self-contained (because they grep the source code and evaluate only that one line).
|
||
#
|
||
# For consistency and to match user expectations, the release part of the version is always three
|
||
# components: MAJOR.MINOR.PATCH.
|
||
use version 0.77; our $VERSION = version->declare('v4.0.0.0_0');
|
||
|
||
sub parse_version {
|
||
my ($v) = @_;
|
||
# Matches a non-negative integer with 1-3 decimal digits (zero padding disallowed).
|
||
my $n = qr/0|[1-9]\d{0,2}/;
|
||
my $vre = qr/
|
||
^
|
||
v # required "v" prefix
|
||
((?:$n\.)*?$n) # release version (e.g., 1.2, 1.2.3, or 1.2.3.4)
|
||
\.(?: # release or pre-release suffix
|
||
0_(?!999)($n)| # pre-release (alpha, beta, rc) revision
|
||
999(?:\.($n))? # release with optional re-release revision
|
||
)
|
||
$
|
||
/x;
|
||
return $v =~ $vre;
|
||
}
|
||
|
||
sub humanize_version {
|
||
my ($v) = @_;
|
||
my ($r, $pr, $rr) = parse_version($v);
|
||
return $v if !defined($r);
|
||
$v = $r;
|
||
if (!defined($pr)) {
|
||
$v .= "r$rr" if defined($rr);
|
||
} elsif ($pr eq '0') {
|
||
$v .= '~alpha';
|
||
} elsif ($pr < 900) {
|
||
$v .= "~beta$pr";
|
||
} elsif ($pr < 999) {
|
||
$v .= '~rc' . ($pr - 900);
|
||
}
|
||
return $v;
|
||
}
|
||
|
||
our $version = humanize_version($VERSION);
|
||
|
||
my $programd = $0;
|
||
$programd =~ s%^.*/%%;
|
||
my $program = $programd;
|
||
$program =~ s/d$//;
|
||
our $now = time;
|
||
my $hostname = hostname();
|
||
|
||
# subst_var(subst, default) returns subst unless it looks like @foo@ in which case it returns
|
||
# default. The @foo@ strings are expected to be replaced by make; this function makes it possible
|
||
# to run this file as a Perl script before those substitutions are made.
|
||
sub subst_var {
|
||
my ($subst, $default) = @_;
|
||
return $default if $subst =~ qr'^@\w+@$';
|
||
return $subst;
|
||
}
|
||
|
||
my $etc = subst_var('@sysconfdir@', '/etc/ddclient');
|
||
my $cachedir = subst_var('@localstatedir@', '/var') . '/cache/ddclient';
|
||
my $savedir = '/tmp';
|
||
if ($program =~ /test/i) {
|
||
$etc = '.';
|
||
$cachedir = '.';
|
||
$savedir = 'URL';
|
||
}
|
||
our @curl = (subst_var('@CURL@', 'curl'));
|
||
|
||
our $emailbody = '';
|
||
my $last_emailbody = '';
|
||
|
||
## If run as *d (e.g., ddclientd) then daemonize by default (but allow
|
||
## flags and options to override).
|
||
my $daemon_default = ($programd =~ /d$/) ? interval('5m') : undef;
|
||
|
||
use vars qw($file $lineno);
|
||
local $file = '';
|
||
local $lineno = '';
|
||
|
||
$ENV{'PATH'} = (exists($ENV{PATH}) ? "$ENV{PATH}:" : "") . "/sbin:/usr/sbin:/bin:/usr/bin:/etc:/usr/lib:";
|
||
|
||
our %globals;
|
||
our %config;
|
||
|
||
# %recap holds details about recent updates (and attempts) that are needed to implement various
|
||
# service-specific and protocol-independent mechanisms such as `min-interval`. This data is
|
||
# persisted in the cache file (`--cache`) so that it survives ddclient restarts. This hash maps a
|
||
# hostname to a hashref containing those protocol variables that have their `recap` property set to
|
||
# true.
|
||
#
|
||
# A note about terminology: This was previously named `%cache`, but "cache" implies that the
|
||
# purpose is to reduce the cost or latency of data retrieval or computation, and that deletion only
|
||
# affects performance. That is not the case here, so the variable was renamed. "Recap" is meant
|
||
# to evoke the "previously on" clips that play before TV episodes, which are designed to give you
|
||
# just enough context to recall the state. The recap is written to the cache file, so-named for
|
||
# historical reasons. (Renaming "cache file" to "recap file" is more difficult due to
|
||
# compatibility concerns with the public `--cache` option.)
|
||
our %recap;
|
||
|
||
my $result;
|
||
my $saved_recap;
|
||
my %saved_opt;
|
||
my $daemon;
|
||
# Control how many times warning message logged for invalid IP addresses
|
||
my (%warned_ip, %warned_ipv4, %warned_ipv6);
|
||
my $inv_ip_warn_count = opt('max-warn') // 1;
|
||
|
||
sub T_ANY { 'any' }
|
||
sub T_STRING { 'string' }
|
||
sub T_EMAIL { 'e-mail address' }
|
||
sub T_NUMBER { 'number' }
|
||
sub T_DELAY { 'time delay (ie. 1d, 1hour, 1m)' }
|
||
sub T_LOGIN { 'login' }
|
||
sub T_PASSWD { 'password' }
|
||
sub T_BOOL { 'boolean value' }
|
||
sub T_FQDN { 'fully qualified host name' }
|
||
sub T_OFQDN { 'optional fully qualified host name' }
|
||
sub T_FILE { 'file name' }
|
||
sub T_FQDNP { 'fully qualified host name and optional port number' }
|
||
sub T_PROTO { 'protocol' }
|
||
sub T_USE { 'ip strategy' }
|
||
sub T_USEV4 { 'ipv4 strategy' }
|
||
sub T_USEV6 { 'ipv6 strategy' }
|
||
sub T_IF { 'interface' }
|
||
sub T_PROG { 'program name' }
|
||
sub T_IP { 'ip' }
|
||
sub T_IPV4 { 'ipv4' }
|
||
sub T_IPV6 { 'ipv6' }
|
||
sub T_POSTS { 'postscript' }
|
||
|
||
## strategies for obtaining an ip address.
|
||
our %builtinweb = (
|
||
'dyndns' => {'url' => 'http://checkip.dyndns.org/', 'skip' => 'Current IP Address:'},
|
||
'freedns' => {'url' => 'https://freedns.afraid.org/dynamic/check.php'},
|
||
'googledomains' => {
|
||
url => 'https://domains.google.com/checkip',
|
||
deprecated => 'See https://github.com/ddclient/ddclient/issues/622 for more info.',
|
||
},
|
||
'he' => {
|
||
url => 'https://checkip.dns.he.net/',
|
||
deprecated => "Use 'he.net' instead.",
|
||
},
|
||
'he.net' => {'url' => 'https://checkip.dns.he.net/'},
|
||
'ip4only.me' => {'url' => 'https://ip4only.me/api/'},
|
||
'ip6only.me' => {'url' => 'https://ip6only.me/api/'},
|
||
'ipify-ipv4' => {'url' => 'https://api.ipify.org/'},
|
||
'ipify-ipv6' => {'url' => 'https://api6.ipify.org/'},
|
||
'loopia' => {'url' => 'https://dns.loopia.se/checkip/checkip.php', 'skip' => 'Current IP Address:'},
|
||
'myonlineportal' => {'url' => 'https://myonlineportal.net/checkip'},
|
||
'noip-ipv4' => {'url' => 'http://ip1.dynupdate.no-ip.com/'},
|
||
'noip-ipv6' => {'url' => 'http://ip1.dynupdate6.no-ip.com/'},
|
||
'nsupdate.info-ipv4' => {'url' => 'https://ipv4.nsupdate.info/myip'},
|
||
'nsupdate.info-ipv6' => {'url' => 'https://ipv6.nsupdate.info/myip'},
|
||
'zoneedit' => {'url' => 'https://dynamic.zoneedit.com/checkip.html'},
|
||
);
|
||
|
||
sub query_cisco {
|
||
my ($h, $asa, $v4) = @_;
|
||
warning("'--if' is deprecated for '--usev4=cisco%s; use '--ifv4' instead", $asa ? '-asa' : '')
|
||
if ($v4 && !defined(opt('ifv4')) && defined(opt('if', $h)));
|
||
warning("'--fw' is deprecated for '--usev4=cisco%s; use '--fwv4' instead", $asa ? '-asa' : '')
|
||
if ($v4 && !defined(opt('fwv4')) && defined(opt('fw', $h)));
|
||
my $if = ($v4 ? opt('ifv4', $h) : undef) // opt('if', $h);
|
||
my $fw = ($v4 ? opt('fwv4', $h) : undef) // opt('fw', $h);
|
||
# Convert slashes to protected value "\/"
|
||
$if =~ s%\/%\\\/%g;
|
||
# Protect special HTML characters (like '?')
|
||
$if =~ s/([\?&= ])/sprintf("%%%02x", ord($1))/ge;
|
||
my $url = ($asa)
|
||
? "https://$fw/exec/show%20interface%20$if"
|
||
: "http://$fw/level/1/exec/show/ip/interface/brief/$if/CR";
|
||
my $reply = geturl(
|
||
url => $url,
|
||
login => opt('fw-login', $h),
|
||
password => opt('fw-password', $h),
|
||
ignore_ssl_option => 1,
|
||
ssl_validate => opt('fw-ssl-validate', $h),
|
||
) // '';
|
||
return ($url, $reply);
|
||
}
|
||
|
||
our %builtinfw = (
|
||
'2wire' => {
|
||
'name' => '2Wire 1701HG Gateway',
|
||
'url' => '/xslt?PAGE=B01',
|
||
'skip' => 'Internet Address:',
|
||
},
|
||
'3com-3c886a' => {
|
||
'name' => '3com 3c886a 56k Lan Modem',
|
||
'url' => '/stat3.htm',
|
||
'skip' => 'IP address in use',
|
||
},
|
||
'3com-oc-remote812' => {
|
||
'name' => '3com OfficeConnect Remote 812',
|
||
'url' => '/callEvent',
|
||
'skip' => '.*LOCAL',
|
||
},
|
||
'alcatel-510' => {
|
||
'name' => 'Alcatel Speed Touch 510',
|
||
'url' => '/cgi/ip/',
|
||
'skip' => 'ppp',
|
||
},
|
||
'alcatel-530' => {
|
||
'name' => 'Alcatel/Thomson SpeedTouch 530',
|
||
'url' => '/cgi/status/',
|
||
'skip' => 'IP Address',
|
||
},
|
||
'alcatel-stp' => {
|
||
'name' => 'Alcatel Speed Touch Pro',
|
||
'url' => '/cgi/router/',
|
||
'skip' => 'Brt',
|
||
},
|
||
'allnet-1298' => {
|
||
'name' => 'Allnet 1298',
|
||
'url' => '/cgi/router/',
|
||
'skip' => 'WAN',
|
||
},
|
||
'cayman-3220h' => {
|
||
'name' => 'Cayman 3220-H DSL',
|
||
'url' => '/shell/show+ip+interfaces',
|
||
'skip' => '.*inet',
|
||
},
|
||
'cisco' => {
|
||
'name' => 'Cisco FW',
|
||
'query' => sub { return query_cisco($_[0], 0, 0); },
|
||
'queryv4' => sub { return query_cisco($_[0], 0, 1); },
|
||
'help' => sub { return " at the host given by --fw$_[0]=<host> and interface given by --if$_[0]=<interface>"; },
|
||
},
|
||
'cisco-asa' => {
|
||
'name' => 'Cisco ASA',
|
||
'query' => sub { return query_cisco($_[0], 1, 0); },
|
||
'queryv4' => sub { return query_cisco($_[0], 1, 1); },
|
||
'help' => sub { return " at the host given by --fw$_[0]=<host> and interface given by --if$_[0]=<interface>"; },
|
||
},
|
||
'dlink-524' => {
|
||
'name' => 'D-Link DI-524',
|
||
'url' => '/st_device.html',
|
||
'skip' => 'WAN.*?Addres',
|
||
},
|
||
'dlink-604' => {
|
||
'name' => 'D-Link DI-604',
|
||
'url' => '/st_devic.html',
|
||
'skip' => 'WAN.*?IP.*Address',
|
||
},
|
||
'dlink-614' => {
|
||
'name' => 'D-Link DI-614+',
|
||
'url' => '/st_devic.html',
|
||
'skip' => 'WAN',
|
||
},
|
||
'e-tech' => {
|
||
'name' => 'E-tech Router',
|
||
'url' => '/Status.htm',
|
||
'skip' => 'Public IP Address',
|
||
},
|
||
'elsa-lancom-dsl10' => {
|
||
'name' => 'ELSA LanCom DSL/10 DSL FW',
|
||
'url' => '/config/1/6/8/3/',
|
||
'skip' => 'IP.Address',
|
||
},
|
||
'elsa-lancom-dsl10-ch01' => {
|
||
'name' => 'ELSA LanCom DSL/10 DSL FW (isdn ch01)',
|
||
'url' => '/config/1/6/8/3/',
|
||
'skip' => 'IP.Address.*?CH01',
|
||
},
|
||
'elsa-lancom-dsl10-ch02' => {
|
||
'name' => 'ELSA LanCom DSL/10 DSL FW (isdn ch01)',
|
||
'url' => '/config/1/6/8/3/',
|
||
'skip' => 'IP.Address.*?CH02',
|
||
},
|
||
'linksys' => {
|
||
'name' => 'Linksys FW',
|
||
'url' => '/Status.htm',
|
||
'skip' => 'WAN.*?Address',
|
||
},
|
||
'linksys-rv042-wan1' => {
|
||
'name' => 'Linksys RV042 Dual Homed Router WAN Port 2',
|
||
'url' => '/home.htm',
|
||
'skip' => 'WAN1 IP',
|
||
},
|
||
'linksys-rv042-wan2' => {
|
||
'name' => 'Linksys RV042 Dual Homed Router WAN Port 2',
|
||
'url' => '/home.htm',
|
||
'skip' => 'WAN2 IP',
|
||
},
|
||
'linksys-ver2' => {
|
||
'name' => 'Linksys FW version 2',
|
||
'url' => '/RouterStatus.htm',
|
||
'skip' => 'WAN.*?Address',
|
||
},
|
||
'linksys-ver3' => {
|
||
'name' => 'Linksys FW version 3',
|
||
'url' => '/Status_Router.htm',
|
||
'skip' => 'WAN.*?Address',
|
||
},
|
||
'linksys-wcg200' => {
|
||
'name' => 'Linksys WCG200 FW',
|
||
'url' => '/RgStatus.asp',
|
||
'skip' => 'WAN.IP.*?Address',
|
||
},
|
||
'linksys-wrt854g' => {
|
||
'name' => 'Linksys WRT854G FW',
|
||
'url' => '/Status_Router.asp',
|
||
'skip' => 'IP Address:',
|
||
},
|
||
'maxgate-ugate3x00' => {
|
||
'name' => 'MaxGate UGATE-3x00 FW',
|
||
'url' => '/Status.htm',
|
||
'skip' => 'WAN.*?IP Address',
|
||
},
|
||
'netcomm-nb3' => {
|
||
'name' => 'NetComm NB3',
|
||
'url' => '/MainPage?id=6',
|
||
'skip' => 'ppp-0',
|
||
},
|
||
'netgear-dg834g' => {
|
||
'name' => 'netgear-dg834g',
|
||
'url' => '/setup.cgi?next_file=s_status.htm&todo=cfg_init',
|
||
'skip' => '',
|
||
},
|
||
'netgear-rp614' => {
|
||
'name' => 'Netgear RP614 FW',
|
||
'url' => '/sysstatus.html',
|
||
'skip' => 'IP Address',
|
||
},
|
||
'netgear-rt3xx' => {
|
||
'name' => 'Netgear FW',
|
||
'url' => '/mtenSysStatus.html',
|
||
'skip' => 'IP Address',
|
||
},
|
||
'netgear-wgt624' => {
|
||
'name' => 'Netgear WGT624',
|
||
'url' => '/RST_st_dhcp.htm',
|
||
'skip' => 'IP Address</B></td><TD NOWRAP width="50%">',
|
||
},
|
||
'netgear-wpn824' => {
|
||
'name' => 'Netgear WPN824 FW',
|
||
'url' => '/RST_status.htm',
|
||
'skip' => 'IP Address',
|
||
},
|
||
'netopia-r910' => {
|
||
'name' => 'Netopia R910 FW',
|
||
'url' => '/WanEvtLog',
|
||
'skip' => 'local:',
|
||
},
|
||
'olitec-SX200' => {
|
||
'name' => 'olitec-SX200',
|
||
'url' => '/doc/wan.htm',
|
||
'skip' => 'st_wan_ip[0] = "',
|
||
},
|
||
'rtp300' => {
|
||
'name' => 'Linksys RTP300',
|
||
'url' => '/cgi-bin/webcm?getpage=%2Fusr%2Fwww_safe%2Fhtml%2Fstatus%2FRouter.html',
|
||
'skip' => 'Internet.*?IP Address',
|
||
},
|
||
'siemens-ss4200' => {
|
||
'name' => 'Siemens SpeedStream 4200',
|
||
'url' => '/summary.htm',
|
||
'skip' => '',
|
||
},
|
||
'sitecom-dc202' => {
|
||
'name' => 'Sitecom DC-202 FW',
|
||
'url' => '/status.htm',
|
||
'skip' => 'Internet IP Address',
|
||
},
|
||
'smc-barricade' => {
|
||
'name' => 'SMC Barricade FW',
|
||
'url' => '/status.htm',
|
||
'skip' => 'IP Address',
|
||
},
|
||
'smc-barricade-7004vbr' => {
|
||
'name' => 'SMC Barricade FW (7004VBR model config)',
|
||
'url' => '/status_main.stm',
|
||
'skip' => 'var wan_ip=',
|
||
},
|
||
'smc-barricade-7401bra' => {
|
||
'name' => 'SMC Barricade 7401BRA FW',
|
||
'url' => '/admin/wan1.htm',
|
||
'skip' => 'IP Address',
|
||
},
|
||
'smc-barricade-alt' => {
|
||
'name' => 'SMC Barricade FW (alternate config)',
|
||
'url' => '/status.HTM',
|
||
'skip' => 'WAN IP',
|
||
},
|
||
'sohoware-nbg800' => {
|
||
'name' => 'SOHOWare BroadGuard NBG800',
|
||
'url' => '/status.htm',
|
||
'skip' => 'Internet IP',
|
||
},
|
||
'sveasoft' => {
|
||
'name' => 'Sveasoft WRT54G/WRT54GS',
|
||
'url' => '/Status_Router.asp',
|
||
'skip' => 'var wan_ip',
|
||
},
|
||
'thomson-st536v6' => {
|
||
'name' => 'Thomson SpeedTouch 536v6',
|
||
'url' => '/cgi/b/is/',
|
||
'skip' => 'IP Address',
|
||
},
|
||
'thomson-tg782' => {
|
||
'name' => 'Thomson/Technicolor TG782',
|
||
'url' => '/cgi/b/is/',
|
||
'skip' => 'IP Address',
|
||
},
|
||
'vigor-2200usb' => {
|
||
'name' => 'Vigor 2200 USB',
|
||
'url' => '/doc/online.sht',
|
||
'skip' => 'PPPoA',
|
||
},
|
||
'watchguard-edge-x' => {
|
||
'name' => 'Watchguard Edge X FW',
|
||
'url' => '/netstat.htm',
|
||
'skip' => 'inet addr:',
|
||
},
|
||
'watchguard-soho' => {
|
||
'name' => 'Watchguard SOHO FW',
|
||
'url' => '/pubnet.htm',
|
||
'skip' => 'NAME=IPAddress VALUE=',
|
||
},
|
||
'westell-6100' => {
|
||
'name' => 'Westell C90-610015-06 DSL Router',
|
||
'url' => '/advstat.htm',
|
||
'skip' => 'IP.+?Address',
|
||
},
|
||
'xsense-aero' => {
|
||
'name' => 'Xsense Aero',
|
||
'url' => '/A_SysInfo.htm',
|
||
'skip' => 'WAN.*?IP Address',
|
||
},
|
||
);
|
||
|
||
my %ip_strategies = (
|
||
'disabled' => ": do not use a deprecated method to obtain an IP address for this host",
|
||
'no' => ": deprecated, see '--use=disabled'",
|
||
'ip' => ": deprecated, see '--usev4=ipv4' and '--usev6=ipv6'",
|
||
'web' => ": deprecated, see '--usev4=webv4' and '--usev6=webv6'",
|
||
'fw' => ": deprecated, see '--usev4=fwv4' and '--usev6=fwv6'",
|
||
'if' => ": deprecated, see '--usev4=ifv4' and '--usev6=ifv6'",
|
||
'cmd' => ": deprecated, see '--usev4=cmdv4' and '--usev6=cmdv6'",
|
||
map({
|
||
my $fw = $builtinfw{$_};
|
||
$_ => ": deprecated, see '--usev4=$_'" .
|
||
(defined($fw->{queryv6}) ? " and '--usev6=$_'" : '');
|
||
} keys(%builtinfw)),
|
||
);
|
||
|
||
sub ip_strategies_usage {
|
||
return map({ sprintf(" --use=%-22s %s.", $_, $ip_strategies{$_}) }
|
||
'disabled', 'no', 'ip', 'web', 'if', 'cmd', 'fw', sort(keys(%builtinfw)));
|
||
}
|
||
|
||
my %ipv4_strategies = (
|
||
'disabled' => ": do not obtain an IPv4 address for this host (except possibly via the deprecated '--use' option, if it is enabled)",
|
||
'ipv4' => ": obtain IPv4 from the address given by --ipv4=<address>",
|
||
'webv4' => ": obtain IPv4 from an IP discovery page on the web",
|
||
'ifv4' => ": obtain IPv4 from the interface given by --ifv4=<interface>",
|
||
'cmdv4' => ": obtain IPv4 from the command given by --cmdv4=<command>",
|
||
'fwv4' => ": obtain IPv4 from the URL given by --fwv4=<URL>",
|
||
map({
|
||
my $fw = $builtinfw{$_};
|
||
$_ => defined($fw->{queryv4})
|
||
? ": obtain IPv4 from $fw->{name}@{[($fw->{help} // sub {})->('v4') // '']}"
|
||
: ": obtain IPv4 from $fw->{name} at the host or URL given by --fwv4=<host|URL>";
|
||
} keys(%builtinfw)),
|
||
);
|
||
sub ipv4_strategies_usage {
|
||
return map({ sprintf(" --usev4=%-22s %s.", $_, $ipv4_strategies{$_}) }
|
||
'disabled', 'ipv4', 'webv4', 'ifv4', 'cmdv4', 'fwv4', sort(keys(%builtinfw)));
|
||
}
|
||
|
||
my %ipv6_strategies = (
|
||
'disabled' => ": do not obtain an IPv6 address for this host (except possibly via the deprecated '--use' option, if it is enabled)",
|
||
'no' => ": deprecated, use '--usev6=disabled'",
|
||
'ipv6' => ": obtain IPv6 from the address given by --ipv6=<address>",
|
||
'ip' => ": deprecated, use '--usev6=ipv6'",
|
||
'webv6' => ": obtain IPv6 from an IP discovery page on the web",
|
||
'web' => ": deprecated, use '--usev6=webv6'",
|
||
'ifv6' => ": obtain IPv6 from the interface given by --ifv6=<interface>",
|
||
'if' => ": deprecated, use '--usev6=ifv6'",
|
||
'cmdv6' => ": obtain IPv6 from the command given by --cmdv6=<command>",
|
||
'cmd' => ": deprecated, use '--usev6=cmdv6'",
|
||
'fwv6' => ": obtain IPv6 from the URL given by --fwv6=<URL>",
|
||
map({
|
||
my $fw = $builtinfw{$_};
|
||
defined($fw->{queryv6})
|
||
? ($_ => ": obtain IPv6 from $fw->{name}@{[($fw->{help} // sub {})->('v6') // '']}")
|
||
: ();
|
||
} keys(%builtinfw)),
|
||
);
|
||
sub ipv6_strategies_usage {
|
||
return map({ sprintf(" --usev6=%-22s %s.", $_, $ipv6_strategies{$_}) }
|
||
'disabled', 'no', 'ipv6', 'ip', 'webv6', 'web', 'ifv6', 'if', 'cmdv6', 'cmd',
|
||
'fwv6', sort(map({exists($ipv6_strategies{$_}) ? ($_) : ()} keys(%builtinfw))));
|
||
}
|
||
|
||
sub setv {
|
||
return {
|
||
'type' => shift,
|
||
'required' => shift,
|
||
'recap' => shift,
|
||
'default' => shift,
|
||
'minimum' => shift,
|
||
};
|
||
}
|
||
our %variables = (
|
||
'global-defaults' => {
|
||
'daemon' => setv(T_DELAY, 0, 0, $daemon_default, interval('60s')),
|
||
'foreground' => setv(T_BOOL, 0, 0, 0, undef),
|
||
'file' => setv(T_FILE, 0, 0, "$etc/$program.conf", undef),
|
||
'cache' => setv(T_FILE, 0, 0, "$cachedir/$program.cache", undef),
|
||
'pid' => setv(T_FILE, 0, 0, undef, undef),
|
||
'proxy' => setv(T_FQDNP, 0, 0, undef, undef),
|
||
'protocol' => setv(T_PROTO, 0, 0, 'dyndns2', undef),
|
||
|
||
'use' => setv(T_USE, 0, 0, 'ip', undef),
|
||
'usev4' => setv(T_USEV4, 0, 0, 'disabled', undef),
|
||
'usev6' => setv(T_USEV6, 0, 0, 'disabled', undef),
|
||
'ip' => setv(T_IP, 0, 0, undef, undef),
|
||
'ipv4' => setv(T_IPV4, 0, 0, undef, undef),
|
||
'ipv6' => setv(T_IPV6, 0, 0, undef, undef),
|
||
'if' => setv(T_IF, 0, 0, 'ppp0', undef),
|
||
'ifv4' => setv(T_IF, 0, 0, 'default', undef),
|
||
'ifv6' => setv(T_IF, 0, 0, 'default', undef),
|
||
'web' => setv(T_STRING,0, 0, 'dyndns', undef),
|
||
'web-skip' => setv(T_STRING,0, 0, undef, undef),
|
||
'webv4' => setv(T_STRING,0, 0, 'ipify-ipv4', undef),
|
||
'webv4-skip' => setv(T_STRING,0, 0, undef, undef),
|
||
'webv6' => setv(T_STRING,0, 0, 'ipify-ipv6', undef),
|
||
'webv6-skip' => setv(T_STRING,0, 0, undef, undef),
|
||
'fw' => setv(T_ANY, 0, 0, undef, undef),
|
||
'fw-skip' => setv(T_STRING,0, 0, undef, undef),
|
||
'fwv4' => setv(T_ANY, 0, 0, undef, undef),
|
||
'fwv4-skip' => setv(T_STRING,0, 0, undef, undef),
|
||
'fwv6' => setv(T_ANY, 0, 0, undef, undef),
|
||
'fwv6-skip' => setv(T_STRING,0, 0, undef, undef),
|
||
'fw-login' => setv(T_LOGIN, 0, 0, undef, undef),
|
||
'fw-password' => setv(T_PASSWD,0, 0, undef, undef),
|
||
'cmd' => setv(T_PROG, 0, 0, undef, undef),
|
||
'cmd-skip' => setv(T_STRING,0, 0, undef, undef),
|
||
'cmdv4' => setv(T_PROG, 0, 0, undef, undef),
|
||
'cmdv6' => setv(T_PROG, 0, 0, undef, undef),
|
||
|
||
'timeout' => setv(T_DELAY, 0, 0, interval('120s'), interval('120s')),
|
||
'retry' => setv(T_BOOL, 0, 0, 0, undef),
|
||
'force' => setv(T_BOOL, 0, 0, 0, undef),
|
||
'ssl' => setv(T_BOOL, 0, 0, 1, undef),
|
||
'syslog' => setv(T_BOOL, 0, 0, 0, undef),
|
||
'facility' => setv(T_STRING,0, 0, 'daemon', undef),
|
||
'priority' => setv(T_STRING,0, 0, 'notice', undef),
|
||
'mail' => setv(T_EMAIL, 0, 0, undef, undef),
|
||
'mail-failure' => setv(T_EMAIL, 0, 0, undef, undef),
|
||
'max-warn' => setv(T_NUMBER,0, 0, 1, undef),
|
||
|
||
'exec' => setv(T_BOOL, 0, 0, 1, undef),
|
||
'debug' => setv(T_BOOL, 0, 0, 0, undef),
|
||
'verbose' => setv(T_BOOL, 0, 0, 0, undef),
|
||
'quiet' => setv(T_BOOL, 0, 0, 0, undef),
|
||
'help' => setv(T_BOOL, 0, 0, 0, undef),
|
||
'test' => setv(T_BOOL, 0, 0, 0, undef),
|
||
|
||
'postscript' => setv(T_POSTS, 0, 0, undef, undef),
|
||
'ssl_ca_dir' => setv(T_FILE, 0, 0, undef, undef),
|
||
'ssl_ca_file' => setv(T_FILE, 0, 0, undef, undef),
|
||
'redirect' => setv(T_NUMBER,0, 0, 0, undef)
|
||
},
|
||
'protocol-common-defaults' => {
|
||
'server' => setv(T_FQDNP, 0, 0, 'members.dyndns.org', undef),
|
||
'login' => setv(T_LOGIN, 1, 0, undef, undef),
|
||
'password' => setv(T_PASSWD,1, 0, undef, undef),
|
||
'host' => setv(T_STRING,1, 1, undef, undef),
|
||
|
||
'use' => setv(T_USE, 0, 0, 'ip', undef),
|
||
'usev4' => setv(T_USEV4, 0, 0, 'disabled', undef),
|
||
'usev6' => setv(T_USEV6, 0, 0, 'disabled', undef),
|
||
'if' => setv(T_IF, 0, 0, 'ppp0', undef),
|
||
'ifv4' => setv(T_IF, 0, 0, 'default', undef),
|
||
'ifv6' => setv(T_IF, 0, 0, 'default', undef),
|
||
'web' => setv(T_STRING,0, 0, 'dyndns', undef),
|
||
'web-skip' => setv(T_STRING,0, 0, undef, undef),
|
||
'web-ssl-validate' => setv(T_BOOL, 0, 0, 1, undef),
|
||
'webv4' => setv(T_STRING,0, 0, 'ipify-ipv4', undef),
|
||
'webv4-skip' => setv(T_STRING,0, 0, undef, undef),
|
||
'webv6' => setv(T_STRING,0, 0, 'ipify-ipv6', undef),
|
||
'webv6-skip' => setv(T_STRING,0, 0, undef, undef),
|
||
'fw' => setv(T_ANY, 0, 0, undef, undef),
|
||
'fw-skip' => setv(T_STRING,0, 0, undef, undef),
|
||
'fw-login' => setv(T_LOGIN, 0, 0, undef, undef),
|
||
'fw-password' => setv(T_PASSWD,0, 0, undef, undef),
|
||
'fw-ssl-validate' => setv(T_BOOL, 0, 0, 1, undef),
|
||
'fwv4' => setv(T_ANY, 0, 0, undef, undef),
|
||
'fwv4-skip' => setv(T_STRING,0, 0, undef, undef),
|
||
'fwv6' => setv(T_ANY, 0, 0, undef, undef),
|
||
'fwv6-skip' => setv(T_STRING,0, 0, undef, undef),
|
||
'cmd' => setv(T_PROG, 0, 0, undef, undef),
|
||
'cmd-skip' => setv(T_STRING,0, 0, undef, undef),
|
||
'cmdv4' => setv(T_PROG, 0, 0, undef, undef),
|
||
'cmdv6' => setv(T_PROG, 0, 0, undef, undef),
|
||
'min-interval' => setv(T_DELAY, 0, 0, interval('30s'), 0),
|
||
'max-interval' => setv(T_DELAY, 0, 0, interval('25d'), 0),
|
||
'min-error-interval' => setv(T_DELAY, 0, 0, interval('5m'), 0),
|
||
|
||
# As a recap value, this is the IP address (IPv4 or IPv6, but almost always IPv4) most
|
||
# recently saved at the DDNS service. As a setting, this is the desired IP address that
|
||
# should be saved at the DDNS service. Unfortunately, these two meanings are conflated,
|
||
# causing the bug "skipped: IP address was already set to a.b.c.d" when the IP was never
|
||
# set to a.b.c.d.
|
||
# TODO: Move the recap value elsewhere to fix the bug.
|
||
'ip' => setv(T_IP, 0, 1, undef, undef),
|
||
# As `ip`, but only IPv4 addresses.
|
||
'ipv4' => setv(T_IPV4, 0, 1, undef, undef),
|
||
# As `ip`, but only IPv6 addresses.
|
||
'ipv6' => setv(T_IPV6, 0, 1, undef, undef),
|
||
# Timestamp (seconds since epoch) indicating the earliest time the next update is
|
||
# permitted.
|
||
# TODO: Create a timestamp type and change this to that type.
|
||
'wtime' => setv(T_NUMBER,0, 1, undef, undef),
|
||
# Timestamp (seconds since epoch) indicating when an IP address was last sent to the DDNS
|
||
# service, even if the IP address was not different from what was already stored.
|
||
# TODO: Create a timestamp type and change this to that type.
|
||
'mtime' => setv(T_NUMBER,0, 1, 0, undef),
|
||
# Timestamp (seconds since epoch) of the most recent attempt to update the DDNS service
|
||
# (including attempts to update with the same IP address). This equals mtime if the most
|
||
# recent attempt was successful, otherwise it will be more recent than mtime.
|
||
# TODO: Create a timestamp type and change this to that type.
|
||
'atime' => setv(T_NUMBER,0, 1, 0, undef),
|
||
# Disposition of the most recent (or currently in progress) attempt to update the DDNS
|
||
# service with the IP address in `wantip`. Anything other than `good`, including undef, is
|
||
# treated as a failure.
|
||
'status' => setv(T_ANY, 0, 1, undef, undef),
|
||
# As `status`, but with `wantipv4`.
|
||
'status-ipv4' => setv(T_ANY, 0, 1, undef, undef),
|
||
# As `status`, but with `wantipv6`.
|
||
'status-ipv6' => setv(T_ANY, 0, 1, undef, undef),
|
||
# Timestamp (seconds since epoch) of the most recent attempt that would have been made had
|
||
# `min-interval` not inhibited the attempt. This is reset to 0 once an attempt is actually
|
||
# made. This is used as a boolean to suppress repeated warnings to the user that indicate
|
||
# that `min-interval` has inhibited an update attempt.
|
||
# TODO: Change to a boolean and rename to improve readability.
|
||
'warned-min-interval' => setv(T_ANY, 0, 1, 0, undef),
|
||
# Timestamp (seconds since epoch) of the most recent attempt that would have been made had
|
||
# `min-error-interval` not inhibited the attempt. This is reset to 0 once an attempt is
|
||
# actually made. This is used as a boolean to suppress repeated warnings to the user that
|
||
# indicate that `min-error-interval` has inhibited an update attempt.
|
||
# TODO: Change to a boolean and rename to improve readability.
|
||
'warned-min-error-interval' => setv(T_ANY, 0, 1, 0, undef),
|
||
},
|
||
'dyndns-common-defaults' => {
|
||
'backupmx' => setv(T_BOOL, 0, 1, 0, undef),
|
||
'mx' => setv(T_OFQDN, 0, 1, undef, undef),
|
||
'wildcard' => setv(T_BOOL, 0, 1, 0, undef),
|
||
},
|
||
);
|
||
our %protocols = (
|
||
'1984' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_1984_update,
|
||
'examples' => \&nic_1984_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'login' => undef,
|
||
'server' => setv(T_FQDNP, 0, 0, 'api.1984.is', undef),
|
||
},
|
||
},
|
||
'changeip' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_changeip_update,
|
||
'examples' => \&nic_changeip_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'min-interval' => setv(T_DELAY, 0, 0, interval('5m'), interval('5m')),
|
||
'server' => setv(T_FQDNP, 0, 0, 'nic.changeip.com', undef),
|
||
},
|
||
},
|
||
'cloudflare' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_cloudflare_update,
|
||
'examples' => \&nic_cloudflare_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'backupmx' => setv(T_BOOL, 0, 1, 0, undef),
|
||
'login' => setv(T_LOGIN, 0, 0, 'token', undef),
|
||
'min-interval' => setv(T_DELAY, 0, 0, interval('5m'), 0),
|
||
'mx' => setv(T_OFQDN, 0, 1, undef, undef),
|
||
'server' => setv(T_FQDNP, 0, 0, 'api.cloudflare.com/client/v4', undef),
|
||
'static' => setv(T_BOOL, 0, 1, 0, undef),
|
||
'ttl' => setv(T_NUMBER, 0, 0, 1, undef),
|
||
'wildcard' => setv(T_BOOL, 0, 1, 0, undef),
|
||
'zone' => setv(T_FQDN, 1, 0, undef, undef),
|
||
},
|
||
},
|
||
'cloudns' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_cloudns_update,
|
||
'examples' => \&nic_cloudns_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'login' => undef,
|
||
'password' => undef,
|
||
'dynurl' => setv(T_STRING, 1, 0, undef, undef),
|
||
},
|
||
},
|
||
'ddns.fm' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_ddnsfm_update,
|
||
'examples' => \&nic_ddnsfm_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'login' => undef,
|
||
'server' => setv(T_FQDNP, 0, 0, 'https://api.ddns.fm', undef),
|
||
},
|
||
},
|
||
'digitalocean' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_digitalocean_update,
|
||
'examples' => \&nic_digitalocean_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'login' => undef,
|
||
'server' => setv(T_FQDNP, 0, 0, 'api.digitalocean.com', undef),
|
||
'zone' => setv(T_FQDN, 1, 0, undef, undef),
|
||
},
|
||
},
|
||
'dinahosting' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_dinahosting_update,
|
||
'examples' => \&nic_dinahosting_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'min-error-interval' => setv(T_DELAY, 0, 0, interval('8m'), 0),
|
||
'script' => setv(T_STRING, 0, 1, '/special/api.php', undef),
|
||
'server' => setv(T_FQDNP, 0, 0, 'dinahosting.com', undef),
|
||
},
|
||
},
|
||
'dnsmadeeasy' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_dnsmadeeasy_update,
|
||
'examples' => \&nic_dnsmadeeasy_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'script' => setv(T_STRING, 0, 1, '/servlet/updateip', undef),
|
||
'server' => setv(T_FQDNP, 0, 0, 'cp.dnsmadeeasy.com', undef),
|
||
},
|
||
},
|
||
'dondominio' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_dondominio_update,
|
||
'examples' => \&nic_dondominio_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'server' => setv(T_FQDNP, 0, 0, 'dondns.dondominio.com', undef),
|
||
},
|
||
},
|
||
'dslreports1' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_dslreports1_update,
|
||
'examples' => \&nic_dslreports1_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'server' => setv(T_FQDNP, 0, 0, 'www.dslreports.com', undef),
|
||
},
|
||
},
|
||
'domeneshop' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_domeneshop_update,
|
||
'examples' => \&nic_domeneshop_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'server' => setv(T_FQDNP, 0, 0, 'api.domeneshop.no', undef),
|
||
},
|
||
},
|
||
'duckdns' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_duckdns_update,
|
||
'examples' => \&nic_duckdns_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'login' => undef,
|
||
'server' => setv(T_FQDNP, 0, 0, 'www.duckdns.org', undef),
|
||
},
|
||
},
|
||
'dyndns1' => {
|
||
'force_update' => \&nic_dyndns2_force_update,
|
||
'update' => \&nic_dyndns1_update,
|
||
'examples' => \&nic_dyndns1_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
%{$variables{'dyndns-common-defaults'}},
|
||
'static' => setv(T_BOOL, 0, 1, 0, undef),
|
||
},
|
||
},
|
||
'dyndns2' => {
|
||
'force_update' => \&nic_dyndns2_force_update,
|
||
'update' => \&nic_dyndns2_update,
|
||
'examples' => \&nic_dyndns2_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
%{$variables{'dyndns-common-defaults'}},
|
||
'script' => setv(T_STRING, 0, 1, '/nic/update', undef),
|
||
},
|
||
},
|
||
'easydns' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_easydns_update,
|
||
'examples' => \&nic_easydns_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'backupmx' => setv(T_BOOL, 0, 1, 0, undef),
|
||
# From <https://kb.easydns.com/knowledge/dynamic-dns/>: "You need to wait at least 10
|
||
# minutes between updates."
|
||
'min-interval' => setv(T_DELAY, 0, 0, interval('10m'), 0),
|
||
'mx' => setv(T_OFQDN, 0, 1, undef, undef),
|
||
'server' => setv(T_FQDNP, 0, 0, 'api.cp.easydns.com', undef),
|
||
'script' => setv(T_STRING, 0, 1, '/dyn/generic.php', undef),
|
||
'wildcard' => setv(T_BOOL, 0, 1, 0, undef),
|
||
},
|
||
},
|
||
'freedns' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_freedns_update,
|
||
'examples' => \&nic_freedns_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'min-interval' => setv(T_DELAY, 0, 0, interval('5m'), interval('5m')),
|
||
'server' => setv(T_FQDNP, 0, 0, 'freedns.afraid.org', undef),
|
||
},
|
||
},
|
||
'freemyip' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_freemyip_update,
|
||
'examples' => \&nic_freemyip_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'login' => undef,
|
||
'server' => setv(T_FQDNP, 0, 0, 'freemyip.com', undef),
|
||
},
|
||
},
|
||
'gandi' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_gandi_update,
|
||
'examples' => \&nic_gandi_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'login' => undef,
|
||
'min-interval' => setv(T_DELAY, 0, 0, interval('5m'), interval('5m')),
|
||
'server' => setv(T_FQDNP, 0, 0, 'api.gandi.net', undef),
|
||
'script' => setv(T_STRING, 0, 1, '/v5', undef),
|
||
'use-personal-access-token' => setv(T_BOOL, 0, 0, 0, undef),
|
||
'ttl' => setv(T_DELAY, 0, 0, undef, interval('5m')),
|
||
'zone' => setv(T_FQDN, 1, 0, undef, undef),
|
||
}
|
||
},
|
||
'godaddy' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_godaddy_update,
|
||
'examples' => \&nic_godaddy_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'min-interval' => setv(T_DELAY, 0, 0, interval('5m'), 0),
|
||
'server' => setv(T_FQDNP, 0, 0, 'api.godaddy.com/v1/domains', undef),
|
||
'ttl' => setv(T_NUMBER, 0, 0, 600, undef),
|
||
'zone' => setv(T_FQDN, 1, 0, undef, undef),
|
||
},
|
||
},
|
||
'googledomains' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_googledomains_update,
|
||
'examples' => \&nic_googledomains_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'min-interval' => setv(T_DELAY, 0, 0, interval('5m'), 0),
|
||
'server' => setv(T_FQDNP, 0, 0, 'domains.google.com', undef),
|
||
},
|
||
},
|
||
'he.net' => {
|
||
'updateable' => undef,
|
||
'update' => \&nic_henet_update,
|
||
'examples' => \&nic_henet_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'login' => undef,
|
||
'min-interval' => setv(T_DELAY, 0, 0, interval('5m'), 0),
|
||
'server' => setv(T_FQDNP, 0, 0, 'dyn.dns.he.net', undef),
|
||
},
|
||
},
|
||
'hetzner' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_hetzner_update,
|
||
'examples' => \&nic_hetzner_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'login' => undef,
|
||
'min-interval' => setv(T_DELAY, 0, 0, interval('1m'), 0),
|
||
'server' => setv(T_FQDNP, 0, 0, 'dns.hetzner.com/api/v1', undef),
|
||
'ttl' => setv(T_NUMBER, 0, 0, 60, 60),
|
||
'zone' => setv(T_FQDN, 1, 0, undef, undef),
|
||
},
|
||
},
|
||
'inwx' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_inwx_update,
|
||
'examples' => \&nic_inwx_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'server' => setv(T_FQDNP, 0, 0, 'dyndns.inwx.com', undef),
|
||
'script' => setv(T_STRING, 0, 0, '/nic/update', undef),
|
||
},
|
||
},
|
||
'mythicdyn' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_mythicdyn_update,
|
||
'examples' => \&nic_mythicdyn_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'min-interval' => setv(T_DELAY, 0, 0, interval('5m'), 0),
|
||
'server' => setv(T_FQDNP, 0, 0, 'api.mythic-beasts.com', undef),
|
||
},
|
||
},
|
||
'namecheap' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_namecheap_update,
|
||
'examples' => \&nic_namecheap_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'min-interval' => setv(T_DELAY, 0, 0, interval('5m'), interval('5m')),
|
||
'server' => setv(T_FQDNP, 0, 0, 'dynamicdns.park-your-domain.com', undef),
|
||
},
|
||
},
|
||
'nfsn' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_nfsn_update,
|
||
'examples' => \&nic_nfsn_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'min-interval' => setv(T_DELAY, 0, 0, interval('5m'), interval('5m')),
|
||
'server' => setv(T_FQDNP, 0, 0, 'api.nearlyfreespeech.net', undef),
|
||
'ttl' => setv(T_NUMBER, 0, 0, 300, undef),
|
||
'zone' => setv(T_FQDN, 1, 0, undef, undef),
|
||
},
|
||
},
|
||
'njalla' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_njalla_update,
|
||
'examples' => \&nic_njalla_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'login' => undef,
|
||
'server' => setv(T_FQDNP, 0, 0, 'njal.la', undef),
|
||
'quietreply' => setv(T_BOOL, 0, 1, 0, undef),
|
||
},
|
||
},
|
||
'noip' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_noip_update,
|
||
'examples' => \&nic_noip_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'server' => setv(T_FQDNP, 0, 0, 'dynupdate.no-ip.com', undef),
|
||
},
|
||
},
|
||
'nsupdate' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_nsupdate_update,
|
||
'examples' => \&nic_nsupdate_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'login' => setv(T_LOGIN, 0, 0, '/usr/bin/nsupdate', undef),
|
||
'tcp' => setv(T_BOOL, 0, 1, 0, undef),
|
||
'ttl' => setv(T_NUMBER, 0, 1, 600, undef),
|
||
'zone' => setv(T_STRING, 1, 1, undef, undef),
|
||
},
|
||
},
|
||
'ovh' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_ovh_update,
|
||
'examples' => \&nic_ovh_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'script' => setv(T_STRING, 0, 1, '/nic/update', undef),
|
||
'server' => setv(T_FQDNP, 0, 0, 'www.ovh.com', undef),
|
||
},
|
||
},
|
||
'porkbun' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_porkbun_update,
|
||
'examples' => \&nic_porkbun_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'login' => undef,
|
||
'password' => undef,
|
||
'apikey' => setv(T_PASSWD, 1, 0, undef, undef),
|
||
'secretapikey' => setv(T_PASSWD, 1, 0, undef, undef),
|
||
'root-domain' => setv(T_OFQDN, 0, 0, undef, undef),
|
||
'on-root-domain' => setv(T_BOOL, 0, 0, 0, undef),
|
||
},
|
||
},
|
||
'sitelutions' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_sitelutions_update,
|
||
'examples' => \&nic_sitelutions_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'server' => setv(T_FQDNP, 0, 0, 'www.sitelutions.com', undef),
|
||
'min-interval' => setv(T_DELAY, 0, 0, interval('5m'), interval('5m')),
|
||
},
|
||
},
|
||
'yandex' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_yandex_update,
|
||
'examples' => \&nic_yandex_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'min-interval' => setv(T_DELAY, 0, 0, interval('5m'), 0),
|
||
'server' => setv(T_FQDNP, 0, 0, 'pddimp.yandex.ru', undef),
|
||
},
|
||
},
|
||
'zoneedit1' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_zoneedit1_update,
|
||
'examples' => \&nic_zoneedit1_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'min-interval' => setv(T_DELAY, 0, 0, interval('10m'), 0),
|
||
'server' => setv(T_FQDNP, 0, 0, 'dynamic.zoneedit.com', undef),
|
||
'zone' => setv(T_OFQDN, 0, 0, undef, undef),
|
||
},
|
||
},
|
||
'keysystems' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_keysystems_update,
|
||
'examples' => \&nic_keysystems_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'login' => undef,
|
||
'server' => setv(T_FQDNP, 0, 0, 'dynamicdns.key-systems.net', undef),
|
||
},
|
||
},
|
||
'dnsexit2' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_dnsexit2_update,
|
||
'examples' => \&nic_dnsexit2_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'login' => undef,
|
||
'ssl' => setv(T_BOOL, 0, 0, 1, undef),
|
||
'server' => setv(T_FQDNP, 0, 0, 'api.dnsexit.com', undef),
|
||
'path' => setv(T_STRING, 0, 0, '/dns/', undef),
|
||
'ttl' => setv(T_NUMBER, 0, 0, 5, 0),
|
||
'zone' => setv(T_STRING, 0, 0, undef, undef),
|
||
},
|
||
},
|
||
'regfishde' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_regfishde_update,
|
||
'examples' => \&nic_regfishde_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'login' => undef,
|
||
'server' => setv(T_FQDNP, 0, 0, 'dyndns.regfish.de', undef),
|
||
},
|
||
},
|
||
'enom' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_enom_update,
|
||
'examples' => \&nic_enom_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'server' => setv(T_FQDNP, 0, 0, 'dynamic.name-services.com', undef),
|
||
'min-interval' => setv(T_DELAY, 0, 0, interval('5m'), interval('5m')),
|
||
},
|
||
},
|
||
'infomaniak' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_infomaniak_update,
|
||
'examples' => \&nic_infomaniak_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'server' => undef,
|
||
},
|
||
},
|
||
'emailonly' => {
|
||
'force_update' => undef,
|
||
'update' => \&nic_emailonly_update,
|
||
'examples' => \&nic_emailonly_examples,
|
||
'variables' => {
|
||
%{$variables{'protocol-common-defaults'}},
|
||
'login' => undef,
|
||
'password' => undef,
|
||
# Change default to never re-notify if IP address has not changed.
|
||
'max-interval' => setv(T_DELAY, 0, 0, 'inf', 0),
|
||
},
|
||
},
|
||
);
|
||
# Delete undefined variables to make it easier to cancel previously defined variables.
|
||
for my $proto (values(%protocols)) {
|
||
my $vars = $proto->{variables};
|
||
delete(@$vars{grep(!defined($vars->{$_}), keys(%$vars))});
|
||
}
|
||
$variables{'merged'} = {
|
||
map({ %{$protocols{$_}{'variables'}} } keys(%protocols)),
|
||
%{$variables{'dyndns-common-defaults'}},
|
||
%{$variables{'protocol-common-defaults'}},
|
||
%{$variables{'global-defaults'}},
|
||
};
|
||
|
||
# This will hold the processed args.
|
||
my %opt = ();
|
||
my $deprecated_handler = sub { warning("'-$_[0]' is deprecated and does nothing"); };
|
||
$opt{'fw-banlocal'} = $deprecated_handler;
|
||
$opt{'if-skip'} = $deprecated_handler;
|
||
$opt{'list-devices'} = sub {
|
||
printf("%s %s\n", $_, $builtinfw{$_}{name}) for sort(keys(%builtinfw));
|
||
exit(0);
|
||
};
|
||
$opt{'list-protocols'} = sub {
|
||
printf("%s\n", $_) for sort(keys(%protocols));
|
||
exit(0);
|
||
};
|
||
$opt{'list-web-services'} = sub {
|
||
# This intentionally does not list deprecated services, although they are still accepted.
|
||
# Excluding deprecated services from the output discourages their selection by configuration
|
||
# wizards (e.g., Debian's debconf) that present this list to users.
|
||
printf("%s %s\n", $_, $builtinweb{$_}{url})
|
||
for sort(grep(!$builtinweb{$_}{deprecated}, keys(%builtinweb)));
|
||
exit(0);
|
||
};
|
||
$opt{'version'} = sub {
|
||
my (undef, $arg) = @_;
|
||
if ($arg eq "short") {
|
||
print("$version\n");
|
||
} else {
|
||
print("$program version $version\n");
|
||
print(" originally written by Paul Burry, paul+ddclient\@burry.ca\n");
|
||
print(" project now maintained on https://github.com/ddclient/ddclient\n");
|
||
}
|
||
exit(0);
|
||
};
|
||
|
||
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"],
|
||
["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"],
|
||
["list-protocols", "", "--list-protocols : print a machine-readable list of supported update protocols and exit. Format: one per line"],
|
||
["file", "=s", "--file=<path> : load configuration information from <path>"],
|
||
["cache", "=s", "--cache=<path> : record address used in <path>"],
|
||
["pid", "=s", "--pid=<path> : record process id in <path> if daemonized"],
|
||
"",
|
||
["use", "=s", "--use=<which> : deprecated, see '--usev4' and '--usev6' (forced to 'disabled' if either '--usev4' or '--usev6' is enabled)"],
|
||
&ip_strategies_usage(),
|
||
["usev4", "=s", "--usev4=<which> : how the IPv4 address should be obtained"],
|
||
&ipv4_strategies_usage(),
|
||
["usev6", "=s", "--usev6=<which> : how the IPv6 address should be obtained"],
|
||
&ipv6_strategies_usage(),
|
||
"",
|
||
" Options related to '--use=ip', '--usev4=ipv4', '--usev6=ipv6', and '--usev6=ip':",
|
||
["ip", "=s", "--ip=<address> : deprecated, use '--ipv4' or '--ipv6'"],
|
||
["ipv4", "=s", "--ipv4=<address> : set the IPv4 address to <address>"],
|
||
["ipv6", "=s", "--ipv6=<address> : set the IPv6 address to <address>"],
|
||
"",
|
||
" Options related to '--use=if', '--usev4=ifv4', '--usev6=ifv6', and '--usev6=if':",
|
||
["if", "=s", "--if=<interface> : deprecated, use '--ifv4' or '--ifv6'"],
|
||
["ifv4", "=s", "--ifv4=<interface> : obtain IPv4 address from <interface>"],
|
||
["ifv6", "=s", "--ifv6=<interface> : obtain IPv6 address from <interface>"],
|
||
"",
|
||
" Options related to '--use=web', '--usev4=webv4', '--usev6=webv6', and '--usev6=web':",
|
||
["web", "=s", "--web=<service|url> : deprecated, use '--webv4' or '--webv6'"],
|
||
["web-skip", "=s", "--web-skip=<pattern> : deprecated, use '--webv4-skip' or '--webv6-skip'"],
|
||
["webv4", "=s", "--webv4=<service|url> : obtain IPv4 address from a web-based IP discovery service, either a known <service> or a custom <url>"],
|
||
["webv4-skip", "=s", "--webv4-skip=<pattern> : skip any IP addresses before <pattern> in the output of 'ip address show dev <interface>' (or 'ifconfig <interface>')"],
|
||
["webv6", "=s", "--webv6=<service|url> : obtain IPv6 address from a web-based IP discovery service, either a known <service> or a custom <url>"],
|
||
["webv6-skip", "=s", "--webv6-skip=<pattern> : skip any IP addresses before <pattern> in the output of 'ip address show dev <interface>' (or 'ifconfig <interface>')"],
|
||
["list-web-services", "", "--list-web-services : print a machine-readable list of web-based IP discovery services for use with 'web=<service>' and exit. Format: one service per line, each line has the form '<service> <url>'"],
|
||
"",
|
||
" Options related to '--use=fw', '--usev4=fwv4', '--usev6=fwv6', and '--usev6=fw'",
|
||
" as well as '--use=<device>', '--usev4=<device>', and '--usev6=<device>':",
|
||
["fw", "=s", "--fw=<address|url> : deprecated, use '--fwv4' or '--fwv6'"],
|
||
["fw-skip", "=s", "--fw-skip=<pattern> : deprecated, use '--fwv4-skip' or '--fwv6-skip'"],
|
||
["fwv4", "=s", "--fwv4=<address|url> : obtain IPv4 address from device with IP address <address> or URL <url>"],
|
||
["fwv4-skip", "=s", "--fwv4-skip=<pattern> : skip any IP addresses before <pattern> in the text returned from the device"],
|
||
["fwv6", "=s", "--fwv6=<address|url> : obtain IPv6 address from device with IP address <address> or URL <url>"],
|
||
["fwv6-skip", "=s", "--fwv6-skip=<pattern> : skip any IP addresses before <pattern> in the text returned from the device"],
|
||
["fw-login", "=s", "--fw-login=<login> : use <login> when getting the IP from the device"],
|
||
["fw-password", "=s", "--fw-password=<secret> : use password <secret> when getting the IP from the device"],
|
||
["list-devices", "", "--list-devices : print a machine-readable list of supported firewall/router devices and exit. Format: one device per line, each line has the form '<device> <description>'"],
|
||
"",
|
||
" Options related to '--use=cmd', '--usev4=cmdv4', '--usev6=cmdv6', and '--usev6=cmd':",
|
||
["cmd", "=s", "--cmd=<command> : deprecated, use '--cmdv4' or '--cmdv6'"],
|
||
["cmd-skip", "=s", "--cmd-skip=<pattern> : deprecated, filter in program wrapper script"],
|
||
["cmdv4", "=s", "--cmdv4=<command> : obtain IPv4 address from the output of <command>"],
|
||
["cmdv6", "=s", "--cmdv6=<command> : obtain IPv6 address from the output of <command>"],
|
||
"",
|
||
["login", "=s", "--login=<user> : log in to the dynamic DNS service as <user>"],
|
||
["password", "=s", "--password=<secret> : log in to the dynamic DNS service with password <secret>"],
|
||
["host", "=s", "--host=<host> : update DNS information for <host>"],
|
||
"",
|
||
["options", "=s", "--options=<opt>=<val>[,<opt>=<val>,...]\n : optional per-service arguments (see below)"],
|
||
"",
|
||
["ssl", "!", '--{no}ssl : use encryption (TLS) when the scheme (either "http://" or "https://") is missing from a URL'],
|
||
["ssl_ca_dir", "=s", "--ssl_ca_dir=<dir> : look in <dir> for certificates of trusted certificate authorities (default: auto-detect)"],
|
||
["ssl_ca_file", "=s", "--ssl_ca_file=<file> : look at <file> for certificates of trusted certificate authorities (default: auto-detect)"],
|
||
["fw-ssl-validate", "!", "--{no}fw-ssl-validate : Validate SSL certificate when retrieving IP address from firewall"],
|
||
["web-ssl-validate", "!", "--{no}web-ssl-validate : Validate SSL certificate when retrieving IP address from web"],
|
||
["retry", "!", "--{no}retry : Initiate a one-time update attempt for hosts that have not been successfully updated (according to the cache). Incompatible with '--daemon'"],
|
||
["force", "!", "--{no}force : force an update even if the update may be unnecessary"],
|
||
["timeout", "=i", "--timeout=<max> : when fetching a URL, wait at most <max> seconds for a response"],
|
||
["syslog", "!", "--{no}syslog : log messages to syslog"],
|
||
["facility", "=s", "--facility=<type> : log messages to syslog to facility <type>"],
|
||
["priority", "=s", "--priority=<pri> : log messages to syslog with priority <pri>"],
|
||
["max-warn", "=i", "--max-warn=<max> : log at most <max> warning messages for undefined IP address"],
|
||
["mail", "=s", "--mail=<address> : e-mail messages to <address>"],
|
||
["mail-failure", "=s", "--mail-failure=<addr> : e-mail messages for failed updates to <addr>"],
|
||
["exec", "!", "--{no}exec : do {not} execute; just show what would be done"],
|
||
["debug", "!", "--{no}debug : print {no} debugging information"],
|
||
["verbose", "!", "--{no}verbose : print {no} verbose information"],
|
||
["quiet", "!", "--{no}quiet : print {no} messages for unnecessary updates"],
|
||
["help", "", "--help : display this message and exit"],
|
||
["version", ":s", "--version[=short] : display version information and exit"],
|
||
["postscript", "", "--postscript : script to run after updating ddclient, has new IP as param"],
|
||
["query", "!", "--{no}query : print {no} ip addresses and exit"],
|
||
["fw-banlocal", "!", ""], ## deprecated
|
||
["if-skip", "=s", ""], ## deprecated
|
||
["test", "!", ""], ## hidden
|
||
["redirect", "=i", "--redirect=<max> : enable and follow at most <max> HTTP 30x redirections"],
|
||
"",
|
||
nic_examples(),
|
||
);
|
||
|
||
sub main {
|
||
## process args
|
||
my $opt_usage = process_args(@opt);
|
||
$saved_recap = '';
|
||
%saved_opt = %opt;
|
||
$result = 'OK';
|
||
if (opt('help')) {
|
||
printf "%s\n", $opt_usage;
|
||
$opt{'version'}('', '');
|
||
}
|
||
|
||
## read config file because 'daemon' mode may be defined there.
|
||
read_config($opt{'file'} // default('file'), \%config, \%globals);
|
||
init_config();
|
||
test_possible_ip() if opt('query');
|
||
|
||
my $caught_hup = 0;
|
||
my $caught_term = 0;
|
||
my $caught_int = 0;
|
||
$SIG{'HUP'} = sub { $caught_hup = 1; };
|
||
$SIG{'TERM'} = sub { $caught_term = 1; };
|
||
$SIG{'INT'} = sub { $caught_int = 1; };
|
||
# don't fork() if foreground
|
||
if (opt('foreground')) {
|
||
;
|
||
} elsif (opt('daemon')) {
|
||
$SIG{'CHLD'} = 'IGNORE';
|
||
my $pid = fork;
|
||
if ($pid < 0) {
|
||
fatal("failed to fork: %s", $!);
|
||
} elsif ($pid) {
|
||
exit 0;
|
||
}
|
||
$SIG{'CHLD'} = 'DEFAULT';
|
||
open(STDOUT, ">/dev/null");
|
||
open(STDERR, ">/dev/null");
|
||
open(STDIN, "</dev/null");
|
||
write_pid();
|
||
}
|
||
|
||
umask 077;
|
||
do {
|
||
$now = time;
|
||
$result = 'OK';
|
||
%opt = %saved_opt;
|
||
if (opt('help')) {
|
||
*STDERR = *STDOUT;
|
||
printf("Help found");
|
||
}
|
||
|
||
read_config($opt{'file'} // default('file'), \%config, \%globals);
|
||
init_config();
|
||
read_recap(opt('cache'), \%recap);
|
||
print_info() if opt('debug') && opt('verbose');
|
||
|
||
fatal("invalid argument '--use=%s'; possible values are:\n%s",
|
||
$opt{'use'}, join("\n", ip_strategies_usage()))
|
||
if defined(opt('use')) && !$ip_strategies{lc(opt('use'))};
|
||
if (defined($opt{'usev6'})) {
|
||
fatal("invalid argument '--usev6=%s'; possible values are:\n%s",
|
||
$opt{'usev6'}, join("\n", ipv6_strategies_usage()))
|
||
unless exists $ipv6_strategies{lc opt('usev6')};
|
||
}
|
||
|
||
$daemon = opt('daemon');
|
||
|
||
update_nics();
|
||
|
||
if ($daemon) {
|
||
debug("sleep %s", $daemon);
|
||
sendmail();
|
||
|
||
my $left = $daemon;
|
||
while (($left > 0) && !$caught_hup && !$caught_term && !$caught_int) {
|
||
my $delay = $left > 10 ? 10 : $left;
|
||
|
||
$0 = sprintf("%s - sleeping for %s seconds", $program, $left);
|
||
$left -= sleep $delay;
|
||
# preventing deep sleep - see [bugs:#46]
|
||
if ($left > $daemon) {
|
||
$left = $daemon;
|
||
}
|
||
}
|
||
$caught_hup = 0;
|
||
$result = 0;
|
||
|
||
} elsif (!scalar(%config)) {
|
||
warning("no hosts to update.") if !opt('quiet');
|
||
$result = 1;
|
||
|
||
} else {
|
||
$result = $result eq 'OK' ? 0 : 1;
|
||
}
|
||
} while ($daemon && !$result && !$caught_term && !$caught_int);
|
||
|
||
warning("caught SIGINT; exiting") if $caught_int;
|
||
unlink_pid();
|
||
sendmail();
|
||
|
||
exit($result);
|
||
}
|
||
|
||
######################################################################
|
||
## runpostscript
|
||
######################################################################
|
||
|
||
sub runpostscript {
|
||
my ($ip) = @_;
|
||
|
||
if (defined $globals{postscript}) {
|
||
my @postscript = split(/\s+/, $globals{postscript});
|
||
if (-x $postscript[0]) {
|
||
system("$globals{postscript} $ip &");
|
||
} else {
|
||
warning("Can not execute post script: %s", $globals{postscript});
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## update_nics
|
||
######################################################################
|
||
sub update_nics {
|
||
my %examined = ();
|
||
my %iplist = ();
|
||
my %ipv4list = ();
|
||
my %ipv6list = ();
|
||
|
||
for my $p (sort keys %protocols) {
|
||
my (@hosts, %ipsv4, %ipsv6) = ();
|
||
my $force_update = $protocols{$p}{'force_update'};
|
||
my $update = $protocols{$p}{'update'};
|
||
|
||
for my $h (sort keys %config) {
|
||
next if $config{$h}{'protocol'} ne lc($p);
|
||
$examined{$h} = 1;
|
||
# we only do this once per 'use' and argument combination
|
||
my $use = opt('use', $h) // 'disabled';
|
||
my $usev4 = opt('usev4', $h) // 'disabled';
|
||
my $usev6 = opt('usev6', $h) // 'disabled';
|
||
$use = 'disabled' if ($use eq 'no'); # backward compatibility
|
||
$usev6 = 'disabled' if ($usev6 eq 'no'); # backward compatibility
|
||
$use = 'disabled' if ($usev4 ne 'disabled') || ($usev6 ne 'disabled');
|
||
my $arg_ip = opt('ip', $h) // '';
|
||
my $arg_ipv4 = opt('ipv4', $h) // '';
|
||
my $arg_ipv6 = opt('ipv6', $h) // '';
|
||
my $arg_fw = opt('fw', $h) // '';
|
||
my $arg_fwv4 = opt('fwv4', $h) // '';
|
||
my $arg_fwv6 = opt('fwv6', $h) // '';
|
||
my $arg_if = opt('if', $h) // '';
|
||
my $arg_ifv4 = opt('ifv4', $h) // '';
|
||
my $arg_ifv6 = opt('ifv6', $h) // '';
|
||
my $arg_web = opt('web', $h) // '';
|
||
my $arg_webv4 = opt('webv4', $h) // '';
|
||
my $arg_webv6 = opt('webv6', $h) // '';
|
||
my $arg_cmd = opt('cmd', $h) // '';
|
||
my $arg_cmdv4 = opt('cmdv4', $h) // '';
|
||
my $arg_cmdv6 = opt('cmdv6', $h) // '';
|
||
my $ip = undef;
|
||
my $ipv4 = undef;
|
||
my $ipv6 = undef;
|
||
|
||
if ($use ne 'disabled') {
|
||
if (exists $iplist{$use}{$arg_ip}{$arg_fw}{$arg_if}{$arg_web}{$arg_cmd}) {
|
||
# If we have already done a get_ip() for this, don't do it again.
|
||
$ip = $iplist{$use}{$arg_ip}{$arg_fw}{$arg_if}{$arg_web}{$arg_cmd};
|
||
} else {
|
||
# Else need to find the IP address...
|
||
$ip = get_ip($use, $h);
|
||
if (is_ipv4($ip) || is_ipv6($ip)) {
|
||
# And if it is valid, remember it...
|
||
$iplist{$use}{$arg_ip}{$arg_fw}{$arg_if}{$arg_web}{$arg_cmd} = $ip;
|
||
} else {
|
||
warning("%s: unable to determine IP address with strategy use=%s", $h, $use)
|
||
if !$daemon || opt('verbose');
|
||
}
|
||
}
|
||
}
|
||
|
||
if ($usev4 ne 'disabled') {
|
||
if (exists $ipv4list{$usev4}{$arg_ipv4}{$arg_fwv4}{$arg_ifv4}{$arg_webv4}{$arg_cmdv4}) {
|
||
# If we have already done a get_ipv4() for this, don't do it again.
|
||
$ipv4 = $ipv4list{$usev4}{$arg_ipv4}{$arg_fwv4}{$arg_ifv4}{$arg_webv4}{$arg_cmdv4};
|
||
} else {
|
||
# Else need to find the IPv4 address...
|
||
$ipv4 = get_ipv4($usev4, $h);
|
||
if (is_ipv4($ipv4)) {
|
||
# And if it is valid, remember it...
|
||
$ipv4list{$usev4}{$arg_ipv4}{$arg_fwv4}{$arg_ifv4}{$arg_webv4}{$arg_cmdv4} = $ipv4;
|
||
} else {
|
||
warning("$h: unable to determine IPv4 address with strategy '--usev4=$usev4'")
|
||
if !$daemon || opt('verbose');
|
||
}
|
||
}
|
||
}
|
||
|
||
if ($usev6 ne 'disabled') {
|
||
if (exists $ipv6list{$usev6}{$arg_ipv6}{$arg_fwv6}{$arg_ifv6}{$arg_webv6}{$arg_cmdv6}) {
|
||
# If we have already done a get_ipv6() for this, don't do it again.
|
||
$ipv6 = $ipv6list{$usev6}{$arg_ipv6}{$arg_fwv6}{$arg_ifv6}{$arg_webv6}{$arg_cmdv6};
|
||
} else {
|
||
# Else need to find the IPv6 address...
|
||
$ipv6 = get_ipv6($usev6, $h);
|
||
if (is_ipv6($ipv6)) {
|
||
# And if it is valid, remember it...
|
||
$ipv6list{$usev6}{$arg_ipv6}{$arg_fwv6}{$arg_ifv6}{$arg_webv6}{$arg_cmdv6} = $ipv6;
|
||
} else {
|
||
warning("$h: unable to determine IPv6 address with strategy '--usev6=$usev6'")
|
||
if !$daemon || opt('verbose');
|
||
}
|
||
}
|
||
}
|
||
|
||
$ip //= $ipv4 // $ipv6;
|
||
$ipv4 //= $ip if is_ipv4($ip);
|
||
$ipv6 //= $ip if is_ipv6($ip);
|
||
$config{$h}{'wantip'} = $ip;
|
||
$config{$h}{'wantipv4'} = $ipv4;
|
||
$config{$h}{'wantipv6'} = $ipv6;
|
||
|
||
if (!$ip && !$ipv4 && !$ipv6) {
|
||
warning("Could not determine an IP for %s", $h);
|
||
next;
|
||
}
|
||
|
||
next if !nic_updateable($h, $force_update);
|
||
push @hosts, $h;
|
||
|
||
$ipsv4{$ipv4} = $h if ($ipv4);
|
||
$ipsv6{$ipv6} = $h if ($ipv6);
|
||
}
|
||
if (@hosts) {
|
||
$0 = sprintf("%s - updating %s", $program, join(',', @hosts));
|
||
&$update(@hosts);
|
||
|
||
# Backwards compatibility:
|
||
# The legacy '--use' parameter sets 'wantip' and the legacy providers process this and
|
||
# set 'ip', 'status' accordingly.
|
||
# The new '--usev*' parameters set 'wantipv*' and the new providers set 'ipv*' and 'status-ipv*'.
|
||
# To allow gradual transition, we make sure both the old 'status' and 'ip' are being set
|
||
# accordingly to what new providers returned in the new 'status-ipv*' and 'ipv*' fields respectively.
|
||
for my $h (@hosts) {
|
||
$config{$h}{'status'} //= $config{$h}{'status-ipv4'} // $config{$h}{'status-ipv6'};
|
||
$config{$h}{'ip'} //= $config{$h}{'ipv4'} // $config{$h}{'ipv6'};
|
||
}
|
||
|
||
runpostscript(join ' ', keys %ipsv4, keys %ipsv6);
|
||
}
|
||
}
|
||
for my $h (sort keys %config) {
|
||
if (!exists $examined{$h}) {
|
||
failed("%s was not updated because protocol %s is not supported.",
|
||
$h, $config{$h}{'protocol'} // '<undefined>');
|
||
}
|
||
}
|
||
write_recap(opt('cache'));
|
||
}
|
||
|
||
######################################################################
|
||
## unlink_pid()
|
||
######################################################################
|
||
sub unlink_pid {
|
||
if (opt('pid') && opt('daemon')) {
|
||
unlink opt('pid');
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## write_pid()
|
||
######################################################################
|
||
sub write_pid {
|
||
my $file = opt('pid');
|
||
|
||
if ($file && opt('daemon')) {
|
||
local *FD;
|
||
if (!open(FD, "> $file")) {
|
||
warning("Cannot create file '%s'. (%s)", $file, $!);
|
||
|
||
} else {
|
||
printf FD "%s\n", $$;
|
||
close(FD);
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## write_recap($file)
|
||
######################################################################
|
||
sub write_recap {
|
||
my ($file) = @_;
|
||
|
||
for my $h (keys %config) {
|
||
if (!exists $recap{$h} || $config{$h}{'update'}) {
|
||
my $vars = $protocols{$config{$h}{protocol}}{variables};
|
||
for my $v (keys(%$vars)) {
|
||
next if !$vars->{$v}{recap} || !defined($config{$h}{$v});
|
||
$recap{$h}{$v} = $config{$h}{$v};
|
||
}
|
||
} else {
|
||
for my $v (qw(atime wtime status status-ipv4 status-ipv6)) {
|
||
$recap{$h}{$v} = $config{$h}{$v};
|
||
}
|
||
}
|
||
}
|
||
|
||
my $recap = "";
|
||
for my $h (sort keys %recap) {
|
||
my $opt = join(',', map { "$_=" . ($recap{$h}{$_} // '') } sort keys %{$recap{$h}});
|
||
|
||
$recap .= sprintf "%s%s%s\n", $opt, ($opt ? ' ' : ''), $h;
|
||
}
|
||
$file = '' if defined($saved_recap) && $recap eq $saved_recap;
|
||
|
||
if ($file) {
|
||
(undef, my $dir) = fileparse($file);
|
||
make_path($dir, { error => \my $err }) if !-d $dir;
|
||
if ($err && @$err) {
|
||
for my $diag (@$err) {
|
||
my ($f, $msg) = %$diag;
|
||
warning("Failed to create cache file directory: %s: %s", $f, $msg);
|
||
}
|
||
return;
|
||
}
|
||
|
||
$saved_recap = undef;
|
||
local *FD;
|
||
if (!open(FD, ">", $file)) {
|
||
warning("Failed to create cache file %s: %s", $file, $!);
|
||
return;
|
||
}
|
||
printf FD "## %s-%s\n", $program, $version;
|
||
printf FD "## last updated at %s (%d)\n", prettytime($now), $now;
|
||
printf FD "%s", $recap;
|
||
|
||
close(FD);
|
||
}
|
||
}
|
||
######################################################################
|
||
## read_recap($file) - called before reading the .conf
|
||
######################################################################
|
||
sub read_recap {
|
||
my $file = shift;
|
||
my $config = shift;
|
||
my $globals = {};
|
||
|
||
%{$config} = ();
|
||
if (-e $file) {
|
||
my %saved = %opt;
|
||
%opt = ();
|
||
$saved_recap = _read_config($config, $globals, "##\\s*$program-$version\\s*", $file);
|
||
%opt = %saved;
|
||
|
||
for my $h (keys(%recap)) {
|
||
next if !exists($config->{$h});
|
||
for (qw(atime mtime wtime ip ipv4 ipv6 status status-ipv4 status-ipv6)) {
|
||
# TODO: Isn't $config equal to \%recap here? If so, this is a no-op. What was the
|
||
# original intention behind this? To copy %recap values into %config? If so, is
|
||
# it better to just delete this and live with the current behavior (which doesn't
|
||
# seem to be causing users any problems) or to "fix" it to match the original
|
||
# intention, which might introduce a bug?
|
||
$config->{$h}{$_} = $recap{$h}{$_} if exists $recap{$h}{$_};
|
||
}
|
||
}
|
||
}
|
||
}
|
||
######################################################################
|
||
## parse_assignments(string) return (rest, %variables)
|
||
## parse_assignment(string) return (name, value, rest)
|
||
######################################################################
|
||
sub parse_assignments {
|
||
my ($rest) = @_;
|
||
my %variables = ();
|
||
|
||
while (1) {
|
||
(my $name, my $value, $rest) = parse_assignment($rest);
|
||
$rest =~ s/^[,\s]+//;
|
||
return ($rest, %variables) if !defined($name);
|
||
if ($name eq 'fw-banlocal' || $name eq 'if-skip') {
|
||
warning("'$name' is deprecated and does nothing");
|
||
next;
|
||
}
|
||
$variables{$name} = $value;
|
||
}
|
||
}
|
||
sub parse_assignment {
|
||
my ($rest) = @_;
|
||
my ($name, $value);
|
||
my ($escape, $quote) = (0, '');
|
||
|
||
if ($rest =~ /^[,\s]*([a-z][0-9a-z_-]*)=(.*)/i) {
|
||
($name, $rest, $value) = ($1, $2, '');
|
||
|
||
while (length(my $c = substr($rest, 0, 1))) {
|
||
if ($escape) {
|
||
$value .= $c;
|
||
$escape = 0;
|
||
} elsif ($c eq "\\") {
|
||
$escape = 1;
|
||
} elsif ($quote && $c eq $quote) {
|
||
$quote = '';
|
||
} elsif (!$quote && $c =~ /[\'\"]/) {
|
||
$quote = $c;
|
||
} elsif (!$quote && $c =~ /^[\n\s,]/) {
|
||
# The terminating character is not consumed.
|
||
last;
|
||
} else {
|
||
$value .= $c;
|
||
}
|
||
$rest = substr($rest,1);
|
||
}
|
||
}
|
||
warning("assignment to '%s' ended with the escape character (\\)", $name) if $escape;
|
||
warning("assignment to '%s' ended with an unterminated quote (%s)", $name, $quote) if $quote;
|
||
return ($name, $value, $rest);
|
||
}
|
||
######################################################################
|
||
## read_config
|
||
######################################################################
|
||
sub read_config {
|
||
my ($file, $config, $globals) = @_;
|
||
_read_config($config, $globals, '', $file);
|
||
}
|
||
sub _read_config {
|
||
# Configuration line format after comment and continuation
|
||
# removal:
|
||
#
|
||
# [opt=value, ...] [host[, ...] [login [password]]]
|
||
#
|
||
# Details:
|
||
# - No whitespace is allowed around the '=' in opt=value.
|
||
# - An option name may only contain lowercase letters, numbers,
|
||
# underscore, and hyphen-minus, and must start with a letter.
|
||
# - A value or hostname is terminated by unquoted whitespace
|
||
# (including newline) or an unquoted comma followed by
|
||
# optional whitespace.
|
||
# - Values (but not hosts, login, or password) may contain
|
||
# quoted parts:
|
||
# - A backslash that itself is not quoted by another
|
||
# backslash quotes the next character.
|
||
# - An unquoted single quote quotes the subsequent
|
||
# non-backslash, non-newline characters until the next
|
||
# single quote.
|
||
# - An unquoted double quote quotes the subsequent
|
||
# non-backslash, non-newline characters until the next
|
||
# double quote.
|
||
# - login and password must not contain whitespace.
|
||
# - login must not start or end with a comma.
|
||
# - password must not start with a comma.
|
||
# - If no host is specified (either via a 'host=' option or
|
||
# after the options), the options are stored in %{$2}.
|
||
# Otherwise, the options are combined with the global values
|
||
# accumulated thus far and stored in $1->{$host} for each
|
||
# referenced host.
|
||
|
||
my $config = shift;
|
||
my $globals = shift;
|
||
my $stamp = shift;
|
||
local $file = shift;
|
||
my %globals = ();
|
||
my %config = ();
|
||
my $content = '';
|
||
|
||
local *FD;
|
||
if (!open(FD, "< $file")) {
|
||
warning("Cannot open file '%s'. (%s)", $file, $!);
|
||
goto done;
|
||
}
|
||
|
||
# If file is owned by our effective uid, ensure that it has no access for group or others.
|
||
# Otherwise, require that it isn't writable when not owned by us. For example allow it to
|
||
# be owned by root:ddclient with mode 640. Always ensure that it is not accessible to others.
|
||
my ($dev, $ino, $mode, @statrest) = stat(FD);
|
||
if ($mode & 077 && -o FD) {
|
||
if (-f FD && (chmod 0600, $file)) {
|
||
warning("file $file must be accessible only by its owner (fixed).");
|
||
} else {
|
||
warning("file $file must be accessible only by its owner.");
|
||
}
|
||
} elsif (! -o FD && -w FD) {
|
||
warning("file $file should be owned only by ddclient or not be writable.");
|
||
}
|
||
if ($mode & 07) {
|
||
warning("file $file must not be accessible by others.");
|
||
}
|
||
|
||
local $lineno = 0;
|
||
my $continuation = '';
|
||
my %passwords = ();
|
||
while (<FD>) {
|
||
s/[\r\n]//g;
|
||
|
||
$lineno++;
|
||
|
||
## check for the program version stamp
|
||
if (($. == 1) && $stamp && ($_ !~ /^$stamp$/i)) {
|
||
warning("program version mismatch; ignoring %s", $file);
|
||
last;
|
||
}
|
||
if (/\\\s+$/) {
|
||
warning("whitespace follows the \\ at the end-of-line.\nIf you meant to have a line continuation, remove the trailing whitespace.");
|
||
}
|
||
|
||
$content .= "$_\n" unless /^#/;
|
||
|
||
## parsing passwords is special
|
||
if (/^([^#]*\s)?([^#]*?password)\s*=\s*('.*'|[^']\S*)(.*)/) {
|
||
my ($head, $key, $value, $tail) = ($1 // '', $2, $3, $4);
|
||
$value = $1 if $value =~ /^'(.*)'$/;
|
||
$passwords{$key} = $value;
|
||
$_ = "${head}${key}=dummy${tail}";
|
||
}
|
||
|
||
## remove comments
|
||
s/#.*//;
|
||
|
||
## Handle continuation lines
|
||
# Any line ending in a backslash gets concatenated together with the following line
|
||
# Note: Trailing whitespace after the backslash is allowed.
|
||
$_ = "$continuation$_";
|
||
if (/\\\s*$/) {
|
||
# Remove the backslash and whitespace
|
||
s/\\\s*$//s;
|
||
|
||
# Store the current line to be prepended to the next line
|
||
$continuation = $_;
|
||
next;
|
||
}
|
||
$continuation = '';
|
||
|
||
s/^\s+//; # remove leading white space
|
||
s/\s+$//; # remove trailing white space
|
||
s/\s+/ /g; # canonify
|
||
next if /^$/;
|
||
|
||
my %locals;
|
||
($_, %locals) = parse_assignments($_);
|
||
s/\s*,\s*/,/g;
|
||
my @args = split;
|
||
|
||
## verify that keywords are valid...and check the value
|
||
for my $k (keys %locals) {
|
||
# Handle '_env' keyword suffix
|
||
if ($k =~ /(.*)_env$/) {
|
||
debug("Loading value for $1 from environment variable $locals{$k}.");
|
||
if (!exists($ENV{$locals{$k}})) {
|
||
warning("Environment variable '$locals{$k}' not set for keyword '$k' (ignored)");
|
||
delete $locals{$k};
|
||
next;
|
||
}
|
||
# Set the value to the value of the environment variable
|
||
$locals{$1} = $ENV{$locals{$k}};
|
||
# Remove the '_env' suffix from the key
|
||
$k = $1;
|
||
}
|
||
|
||
$locals{$k} = $passwords{$k} if defined $passwords{$k};
|
||
if (!exists $variables{'merged'}{$k}) {
|
||
warning("unrecognized keyword '%s' (ignored)", $k);
|
||
delete $locals{$k};
|
||
next;
|
||
}
|
||
my $def = $variables{'merged'}{$k};
|
||
my $value = check_value($locals{$k}, $def);
|
||
if (!defined($value)) {
|
||
warning("Invalid Value for keyword '%s' = '%s'", $k, $locals{$k});
|
||
delete $locals{$k};
|
||
next;
|
||
}
|
||
$locals{$k} = $value;
|
||
}
|
||
%passwords = ();
|
||
if (exists($locals{'host'})) {
|
||
$args[0] = (@args ? "$args[0]," : '') . $locals{host};
|
||
}
|
||
## accumulate globals
|
||
if (!@args) {
|
||
%globals = (%globals, %locals);
|
||
next;
|
||
}
|
||
|
||
## process this host definition
|
||
my ($host, $login, $password) = @args;
|
||
|
||
## add in any globals..
|
||
%locals = (%globals, %locals);
|
||
|
||
## override login and password if specified the old way.
|
||
$locals{'login'} = $login if defined $login;
|
||
$locals{'password'} = $password if defined $password;
|
||
|
||
## allow {host} to be a comma separated list of hosts
|
||
for my $h (split_by_comma($host)) {
|
||
# TODO: Shouldn't %locals go after $config{h}? Later lines should override earlier
|
||
# lines, no? Otherwise, later assignments will have a mixed effect: assignments to new
|
||
# variables will take effect but assignments to variables that already have a value
|
||
# will not. One problem with swapping the order: due to the `%locals = (%globals,
|
||
# %locals)` line above, any values in %globals would override any locals in the
|
||
# previous host line.
|
||
$config{$h} = {%locals, %{$config{$h} // {}}};
|
||
$config{$h}{'host'} = $h;
|
||
}
|
||
}
|
||
close(FD);
|
||
|
||
warning("file ends while expecting a continuation line.")
|
||
if $continuation;
|
||
|
||
done:
|
||
%$globals = %globals;
|
||
%$config = %config;
|
||
|
||
return $content;
|
||
}
|
||
######################################################################
|
||
## init_config -
|
||
######################################################################
|
||
sub init_config {
|
||
%opt = %saved_opt;
|
||
|
||
##
|
||
$opt{'quiet'} = 0 if opt('verbose');
|
||
|
||
## infer the IP strategy if possible
|
||
if (!$opt{'use'}) {
|
||
$opt{'use'} = 'web' if ($opt{'web'});
|
||
$opt{'use'} = 'if' if ($opt{'if'});
|
||
$opt{'use'} = 'ip' if ($opt{'ip'});
|
||
}
|
||
## infer the IPv4 strategy if possible
|
||
if (!$opt{'usev4'}) {
|
||
$opt{'usev4'} = 'webv4' if ($opt{'webv4'});
|
||
$opt{'usev4'} = 'ifv4' if ($opt{'ifv4'});
|
||
$opt{'usev4'} = 'ipv4' if ($opt{'ipv4'});
|
||
}
|
||
## infer the IPv6 strategy if possible
|
||
if (!$opt{'usev6'}) {
|
||
$opt{'usev6'} = 'webv6' if ($opt{'webv6'});
|
||
$opt{'usev6'} = 'ifv6' if ($opt{'ifv6'});
|
||
$opt{'usev6'} = 'ipv6' if ($opt{'ipv6'});
|
||
}
|
||
|
||
## sanity check
|
||
$opt{'max-interval'} = min(interval(opt('max-interval')), interval(default('max-interval')));
|
||
$opt{'min-interval'} = max(interval(opt('min-interval')), interval(default('min-interval')));
|
||
$opt{'min-error-interval'} = max(interval(opt('min-error-interval')), interval(default('min-error-interval')));
|
||
|
||
$opt{'timeout'} = 0 if opt('timeout') < 0;
|
||
|
||
## parse an interval expression (such as '5m') into number of seconds
|
||
$opt{'daemon'} = interval(opt('daemon')) if defined($opt{'daemon'});
|
||
## make sure the interval isn't too short
|
||
$opt{'daemon'} = minimum('daemon') if opt('daemon') && opt('daemon') < minimum('daemon');
|
||
|
||
## define or modify host options specified on the command-line
|
||
if (defined($opt{'options'})) {
|
||
## collect cmdline configuration options.
|
||
my %options = ();
|
||
for my $opt (split_by_comma($opt{'options'})) {
|
||
my ($name, $var) = split /\s*=\s*/, $opt;
|
||
if ($name eq 'fw-banlocal' || $name eq 'if-skip') {
|
||
warning("'$name' is deprecated and does nothing");
|
||
next;
|
||
}
|
||
$options{$name} = $var;
|
||
}
|
||
## determine hosts specified with --host
|
||
my @hosts = ();
|
||
if (exists $opt{'host'}) {
|
||
for my $h (split_by_comma($opt{'host'})) {
|
||
push @hosts, $h;
|
||
}
|
||
}
|
||
## and those in --options=...
|
||
if (exists $options{'host'}) {
|
||
for my $h (split_by_comma($options{'host'})) {
|
||
push @hosts, $h;
|
||
}
|
||
delete $options{'host'};
|
||
}
|
||
## merge options into host definitions or globals
|
||
if (@hosts) {
|
||
for my $h (@hosts) {
|
||
$config{$h} = {%{$config{$h} // {}}, %options, 'host' => $h};
|
||
}
|
||
$opt{'host'} = join(',', @hosts);
|
||
} else {
|
||
%globals = (%globals, %options);
|
||
}
|
||
}
|
||
|
||
## override global options with those on the command-line.
|
||
for my $o (keys %opt) {
|
||
# TODO: Isn't $opt{$o} guaranteed to be defined? Otherwise $o wouldn't appear in the keys
|
||
# of %opt, right?
|
||
# TODO: Why is this limited to $variables{'global-defaults'}? Why not
|
||
# $variables{'merged'}?
|
||
if (defined $opt{$o} && exists $variables{'global-defaults'}{$o}) {
|
||
# TODO: What's the point of this? The opt() function will fall back to %globals if
|
||
# %opt doesn't have a value, so this shouldn't be necessary.
|
||
$globals{$o} = $opt{$o};
|
||
}
|
||
}
|
||
|
||
## sanity check
|
||
if (defined $opt{'host'} && defined $opt{'retry'}) {
|
||
fatal("options --retry and --host (or --option host=..) are mutually exclusive");
|
||
}
|
||
fatal("options --retry and --daemon cannot be used together") if (opt('retry') && opt('daemon'));
|
||
|
||
## determine hosts to update (those on the cmd-line, config-file, or failed in recap)
|
||
my @hosts = keys %config;
|
||
if (opt('host')) {
|
||
@hosts = split_by_comma($opt{'host'});
|
||
}
|
||
# TODO: This function is called before the recap file is read. How is this supposed to work?
|
||
if (opt('retry')) {
|
||
@hosts = grep(($recap{$_}{'status'} // '') ne 'good', keys(%recap));
|
||
}
|
||
|
||
## remove any other hosts
|
||
my %hosts;
|
||
map { $hosts{$_} = undef } @hosts;
|
||
map { delete $config{$_} unless exists $hosts{$_} } keys %config;
|
||
|
||
## sanity check..
|
||
## make sure config entries have all defaults and they meet minimums
|
||
## first the globals...
|
||
for my $k (keys %globals) {
|
||
# Make sure any _env suffixed variables look at their original entry
|
||
$k = $1 if $k =~ /^(.*)_env$/;
|
||
|
||
# TODO: This might grab an arbitrary protocol-specific variable, which could cause
|
||
# surprising behavior.
|
||
my $def = $variables{'merged'}{$k};
|
||
if (!$def) {
|
||
warning("ignoring unknown setting '$k=$globals{$k}'");
|
||
delete($globals{$k});
|
||
next;
|
||
}
|
||
# TODO: Isn't $globals{$k} guaranteed to be defined here? Otherwise $k wouldn't appear in
|
||
# %globals.
|
||
my $ovalue = $globals{$k} // $def->{'default'};
|
||
# TODO: Didn't _read_config already check the value? Or is the purpose of this to check
|
||
# the value of command-line options ($opt{$k}) which were merged into %globals above?
|
||
my $value = check_value($ovalue, $def);
|
||
if ($def->{'required'} && !defined $value) {
|
||
# TODO: What's the point of this? The opt() function will fall back to the default
|
||
# value if $globals{$k} is undefined.
|
||
$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...
|
||
HOST:
|
||
for my $h (keys %config) {
|
||
my $proto = opt('protocol', $h);
|
||
load_sha1_support($proto) if (grep($_ eq $proto, ("freedns", "nfsn")));
|
||
load_json_support($proto) if (grep($_ eq $proto, ("1984", "cloudflare", "digitalocean", "gandi", "godaddy", "hetzner", "yandex", "nfsn", "njalla", "porkbun", "dnsexit2")));
|
||
|
||
if (!exists($protocols{$proto})) {
|
||
warning("skipping host: %s: unrecognized protocol '%s'", $h, $proto);
|
||
delete $config{$h};
|
||
next;
|
||
}
|
||
|
||
my $svars = $protocols{$proto}{'variables'};
|
||
my $conf = {'host' => $h, 'protocol' => $proto};
|
||
|
||
for my $k (keys %$svars) {
|
||
# Make sure any _env suffixed variables look at their original entry
|
||
$k = $1 if $k =~ /^(.*)_env$/;
|
||
|
||
my $def = $svars->{$k};
|
||
my $ovalue = $config{$h}{$k} // $def->{'default'};
|
||
my $value = check_value($ovalue, $def);
|
||
if ($def->{'required'} && !defined $value) {
|
||
$ovalue //= '(not set)';
|
||
warning("skipping host $h: invalid $def->{type} variable value '$k=$ovalue'");
|
||
delete $config{$h};
|
||
next HOST;
|
||
}
|
||
$conf->{$k} = $value;
|
||
}
|
||
$config{$h} = $conf;
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## process_args -
|
||
######################################################################
|
||
sub process_args {
|
||
my @spec = ();
|
||
my $usage = "";
|
||
|
||
for (@_) {
|
||
if (ref $_) {
|
||
my ($key, $specifier, $arg_usage) = @$_;
|
||
my $value = default($key);
|
||
|
||
## add a option specifier
|
||
push @spec, $key . $specifier;
|
||
|
||
## define the default value which can be overwritten later
|
||
$opt{$key} //= undef;
|
||
|
||
next unless $arg_usage;
|
||
|
||
## add a line to the usage;
|
||
$usage .= " $arg_usage";
|
||
if (defined($value) && $value ne '') {
|
||
$usage .= " (default: ";
|
||
if ($specifier eq '!') {
|
||
$usage .= "no" if ($specifier eq '!') && !$value;
|
||
$usage .= $key;
|
||
} else {
|
||
$usage .= $value;
|
||
}
|
||
$usage .= ")";
|
||
}
|
||
$usage .= ".";
|
||
} else {
|
||
$usage .= $_;
|
||
}
|
||
$usage .= "\n";
|
||
}
|
||
## process the arguments
|
||
if (!GetOptions(\%opt, @spec)) {
|
||
$opt{"help"} = 1;
|
||
}
|
||
return $usage;
|
||
}
|
||
|
||
######################################################################
|
||
## test_possible_ip - print possible IPs
|
||
######################################################################
|
||
sub test_possible_ip {
|
||
local $opt{'debug'} = 0;
|
||
|
||
printf "----- Test_possible_ip with 'get_ip' -----\n";
|
||
if (defined(opt('ip'))) {
|
||
local $opt{'use'} = 'ip';
|
||
printf "use=ip, ip=%s address is %s\n", opt('ip'), get_ip('ip') // 'NOT FOUND';
|
||
}
|
||
{
|
||
local $opt{'use'} = 'if';
|
||
# Note: The `ip` command adds a `@eth0` suffix to the names of VLAN
|
||
# interfaces. That `@eth0` suffix is NOT part of the interface name.
|
||
my @ifs = map({ /^[^\s:]*:\s*([^\s:@]+)/ ? $1 : () }
|
||
`command -v ip >/dev/null && ip -o link show`);
|
||
@ifs = map({ /^([a-zA-Z].*?)(?::?\s.*)?$/ ? $1 : () }
|
||
`command -v ifconfig >/dev/null && ifconfig -a`) if $? || !@ifs;
|
||
@ifs = () if $?;
|
||
warning("failed to get list of interfaces") if !@ifs;
|
||
for my $if (@ifs) {
|
||
local $opt{'if'} = $if;
|
||
printf "use=if, if=%s address is %s\n", opt('if'), get_ip('if') // 'NOT FOUND';
|
||
}
|
||
}
|
||
if (opt('fw')) {
|
||
if (opt('fw') !~ m%/%) {
|
||
for my $fw (sort keys %builtinfw) {
|
||
local $opt{'use'} = $fw;
|
||
printf "use=%s address is %s\n", $fw, get_ip($fw) // 'NOT FOUND';
|
||
}
|
||
}
|
||
local $opt{'use'} = 'fw';
|
||
printf "use=fw, fw=%s address is %s\n", opt('fw'), get_ip('fw') // 'NOT FOUND'
|
||
if !exists $builtinfw{opt('fw')};
|
||
|
||
}
|
||
{
|
||
local $opt{'use'} = 'web';
|
||
for my $web (sort keys %builtinweb) {
|
||
local $opt{'web'} = $web;
|
||
printf "use=web, web=%s address is %s\n", $web, get_ip('web') // 'NOT FOUND';
|
||
}
|
||
printf "use=web, web=%s address is %s\n", opt('web'), get_ip('web') // 'NOT FOUND'
|
||
if !exists $builtinweb{opt('web')};
|
||
}
|
||
if (opt('cmd')) {
|
||
local $opt{'use'} = 'cmd';
|
||
printf "use=cmd, cmd=%s address is %s\n", opt('cmd'), get_ip('cmd') // 'NOT FOUND';
|
||
}
|
||
|
||
# Now force IPv4
|
||
printf "----- Test_possible_ip with 'get_ipv4' ------\n";
|
||
if (defined(opt('ipv4'))) {
|
||
local $opt{'usev4'} = 'ipv4';
|
||
printf "usev4=ipv4, ipv4=%s address is %s\n", opt('ipv4'), get_ipv4('ipv4') // 'NOT FOUND';
|
||
}
|
||
{
|
||
local $opt{'usev4'} = 'ifv4';
|
||
# Note: The `ip` command adds a `@eth0` suffix to the names of VLAN
|
||
# interfaces. That `@eth0` suffix is NOT part of the interface name.
|
||
my @ifs = map({ /^[^\s:]*:\s*([^\s:@]+)/ ? $1 : () }
|
||
`command -v ip >/dev/null && ip -o link show`);
|
||
@ifs = map({ /^([a-zA-Z].*?)(?::?\s.*)?$/ ? $1 : () }
|
||
`command -v ifconfig >/dev/null && ifconfig -a`) if $? || !@ifs;
|
||
@ifs = () if $?;
|
||
warning("failed to get list of interfaces") if !@ifs;
|
||
for my $if (@ifs) {
|
||
local $opt{'ifv4'} = $if;
|
||
printf "usev4=ifv4, ifv4=%s address is %s\n", opt('ifv4'), get_ipv4('ifv4') // 'NOT FOUND';
|
||
}
|
||
}
|
||
{
|
||
local $opt{'usev4'} = 'webv4';
|
||
for my $web (sort keys %builtinweb) {
|
||
local $opt{'webv4'} = $web;
|
||
printf "usev4=webv4, webv4=$web address is %s\n", get_ipv4('webv4') // 'NOT FOUND'
|
||
if ($web !~ "6") ## Don't bother if web site only supports IPv6;
|
||
}
|
||
printf "usev4=webv4, webv4=%s address is %s\n", opt('webv4'), get_ipv4('webv4') // 'NOT FOUND'
|
||
if ! exists $builtinweb{opt('webv4')};
|
||
}
|
||
if (opt('cmdv4')) {
|
||
local $opt{'usev4'} = 'cmdv4';
|
||
printf "usev4=cmdv4, cmdv4=%s address is %s\n", opt('cmdv4'), get_ipv4('cmdv4') // 'NOT FOUND';
|
||
}
|
||
|
||
# Now force IPv6
|
||
printf "----- Test_possible_ip with 'get_ipv6' -----\n";
|
||
if (defined(opt('ipv6'))) {
|
||
local $opt{'usev6'} = 'ipv6';
|
||
printf "usev6=ipv6, ipv6=%s address is %s\n", opt('ipv6'), get_ipv6('ipv6') // 'NOT FOUND';
|
||
}
|
||
{
|
||
local $opt{'usev6'} = 'ifv6';
|
||
# Note: The `ip` command adds a `@eth0` suffix to the names of VLAN
|
||
# interfaces. That `@eth0` suffix is NOT part of the interface name.
|
||
my @ifs = map({ /^[^\s:]*:\s*([^\s:@]+)/ ? $1 : () }
|
||
`command -v ip >/dev/null && ip -o link show`);
|
||
@ifs = map({ /^([a-zA-Z].*?)(?::?\s.*)?$/ ? $1 : () }
|
||
`command -v ifconfig >/dev/null && ifconfig -a`) if $? || !@ifs;
|
||
@ifs = () if $?;
|
||
warning("failed to get list of interfaces") if !@ifs;
|
||
for my $if (@ifs) {
|
||
local $opt{'ifv6'} = $if;
|
||
printf "usev6=ifv6, ifv6=%s address is %s\n", opt('ifv6'), get_ipv6('ifv6') // 'NOT FOUND';
|
||
}
|
||
}
|
||
{
|
||
local $opt{'usev6'} = 'webv6';
|
||
for my $web (sort keys %builtinweb) {
|
||
local $opt{'webv6'} = $web;
|
||
printf "usev6=webv6, webv6=$web address is %s\n", get_ipv6('webv6') // 'NOT FOUND'
|
||
if ($web !~ "4"); ## Don't bother if web site only supports IPv4
|
||
}
|
||
printf "usev6=webv6, webv6=%s address is %s\n", opt('webv6'), get_ipv6('webv6') // 'NOT FOUND'
|
||
if ! exists $builtinweb{opt('webv6')};
|
||
}
|
||
if (opt('cmdv6')) {
|
||
local $opt{'usev6'} = 'cmdv6';
|
||
printf "usev6=cmdv6, cmdv6=%s address is %s\n", opt('cmdv6'), get_ipv6('cmdv6') // 'NOT FOUND';
|
||
}
|
||
|
||
exit 0 unless opt('debug');
|
||
}
|
||
|
||
######################################################################
|
||
## load_file
|
||
######################################################################
|
||
sub load_file {
|
||
my $file = shift;
|
||
my $buffer = '';
|
||
|
||
if (exists($ENV{'TEST_CASE'})) {
|
||
my $try = "$file-$ENV{'TEST_CASE'}";
|
||
$file = $try if -f $try;
|
||
}
|
||
|
||
local *FD;
|
||
if (open(FD, "< $file")) {
|
||
read(FD, $buffer, -s FD);
|
||
close(FD);
|
||
debug("Loaded %d bytes from %s", length($buffer), $file);
|
||
} else {
|
||
debug("Load failed from %s (%s)", $file, $!);
|
||
}
|
||
return $buffer;
|
||
}
|
||
######################################################################
|
||
## save_file
|
||
######################################################################
|
||
sub save_file {
|
||
my ($file, $buffer, $opt) = @_;
|
||
|
||
$file .= "-$ENV{'TEST_CASE'}" if exists $ENV{'TEST_CASE'};
|
||
if (defined $opt) {
|
||
my $i = 0;
|
||
while (-f "$file-$i") {
|
||
if ('unique' =~ /^$opt/i) {
|
||
my $a = join('\n', grep {!/^Date:/} split /\n/, $buffer);
|
||
my $b = join('\n', grep {!/^Date:/} split /\n/, load_file("$file-$i"));
|
||
last if $a eq $b;
|
||
}
|
||
$i++;
|
||
}
|
||
$file = "$file-$i";
|
||
}
|
||
debug("Saving to %s", $file);
|
||
local *FD;
|
||
open(FD, "> $file") or return;
|
||
print FD $buffer;
|
||
close(FD);
|
||
return $buffer;
|
||
}
|
||
######################################################################
|
||
## print_opt
|
||
## print_globals
|
||
## print_config
|
||
## print_recap
|
||
## print_info
|
||
######################################################################
|
||
sub _print_hash {
|
||
my ($string, $ptr) = @_;
|
||
my $value = $ptr;
|
||
|
||
if (!defined($ptr)) {
|
||
$value = "<undefined>";
|
||
} elsif (ref $ptr eq 'HASH') {
|
||
for my $key (sort keys %$ptr) {
|
||
if (($key eq "login") || ($key eq "password")) {
|
||
$value = "<redacted>";
|
||
} else {
|
||
$value = $ptr->{$key};
|
||
}
|
||
_print_hash("${string}\{$key\}", $value);
|
||
}
|
||
return;
|
||
}
|
||
printf "%-36s : %s\n", $string, $value;
|
||
}
|
||
sub print_hash {
|
||
my ($string, $hash) = @_;
|
||
printf "=== %s ====\n", $string;
|
||
_print_hash($string, $hash);
|
||
}
|
||
sub print_opt { print_hash("opt", \%opt); }
|
||
sub print_globals { print_hash("globals", \%globals); }
|
||
sub print_config { print_hash("config", \%config); }
|
||
sub print_recap { print_hash("recap", \%recap); }
|
||
sub print_info {
|
||
print_opt();
|
||
print_globals();
|
||
print_config();
|
||
print_recap();
|
||
}
|
||
######################################################################
|
||
## pipecmd - run an external command
|
||
## logger
|
||
## sendmail
|
||
######################################################################
|
||
sub pipecmd {
|
||
my $cmd = shift;
|
||
my $stdin = join("\n", @_);
|
||
my $ok = 0;
|
||
|
||
## remove trailing newlines
|
||
1 while chomp($stdin);
|
||
|
||
## override when debugging.
|
||
$cmd = opt('exec') ? "| $cmd" : "> /dev/null";
|
||
|
||
## execute the command.
|
||
local *FD;
|
||
if (!open(FD, $cmd)) {
|
||
warning('cannot execute command %s.', $cmd);
|
||
|
||
} elsif ($stdin && (!print FD "$stdin\n")) {
|
||
warning('failed writting to %s.', $cmd);
|
||
close(FD);
|
||
|
||
} elsif (!close(FD)) {
|
||
warning('failed closing %s. (%s)', $cmd, $@);
|
||
|
||
} elsif (opt('exec') && $?) {
|
||
warning('failed %s. (%s)', $cmd, $@);
|
||
|
||
} else {
|
||
$ok = 1;
|
||
}
|
||
return $ok;
|
||
}
|
||
sub logger {
|
||
if (opt('syslog') && opt('facility') && opt('priority')) {
|
||
my $facility = opt('facility');
|
||
my $priority = opt('priority');
|
||
return pipecmd("logger -p$facility.$priority -t${program}\[$$\]", @_);
|
||
}
|
||
return 1;
|
||
}
|
||
sub sendmail {
|
||
my $recipients = opt('mail');
|
||
|
||
if (opt('mail-failure') && ($result ne 'OK' && $result ne '0')) {
|
||
$recipients = opt('mail-failure');
|
||
}
|
||
if ($emailbody && $recipients && $emailbody ne $last_emailbody) {
|
||
pipecmd("sendmail -oi $recipients",
|
||
"To: $recipients",
|
||
"Subject: status report from $program\@$hostname",
|
||
"\r\n",
|
||
$emailbody,
|
||
"",
|
||
"-- ", # https://en.wikipedia.org/wiki/Signature_block#Standard_delimiter
|
||
" $program\@$hostname (version $version)"
|
||
);
|
||
}
|
||
$last_emailbody = $emailbody;
|
||
$emailbody = '';
|
||
}
|
||
######################################################################
|
||
## split_by_comma
|
||
## default
|
||
## minimum
|
||
## opt
|
||
######################################################################
|
||
sub split_by_comma {
|
||
my $string = shift;
|
||
|
||
return split /\s*[, ]\s*/, $string if defined $string;
|
||
return ();
|
||
}
|
||
sub default {
|
||
my $v = shift;
|
||
return undef if !defined($variables{'merged'}{$v});
|
||
return $variables{'merged'}{$v}{'default'};
|
||
}
|
||
sub minimum {
|
||
my $v = shift;
|
||
return undef if !defined($variables{'merged'}{$v});
|
||
return $variables{'merged'}{$v}{'minimum'};
|
||
}
|
||
sub opt {
|
||
my $v = shift;
|
||
my $h = shift;
|
||
return $config{$h}{$v} if defined($h) && defined($config{$h}{$v});
|
||
return $opt{$v} // $globals{$v} // default($v);
|
||
}
|
||
sub min {
|
||
my $min = shift;
|
||
for my $arg (@_) {
|
||
$min = $arg if $arg < $min;
|
||
}
|
||
return $min;
|
||
}
|
||
sub max {
|
||
my $max = shift;
|
||
for my $arg (@_) {
|
||
$max = $arg if $arg > $max;
|
||
}
|
||
return $max;
|
||
}
|
||
######################################################################
|
||
## ynu
|
||
######################################################################
|
||
sub ynu {
|
||
my ($value, $yes, $no, $undef) = @_;
|
||
|
||
return $no if !($value // '');
|
||
return $yes if $value eq '1';
|
||
for (qw(yes true)) {
|
||
return $yes if $_ =~ /^$value/i;
|
||
}
|
||
for (qw(no false)) {
|
||
return $no if $_ =~ /^$value/i;
|
||
}
|
||
return $undef;
|
||
}
|
||
######################################################################
|
||
## Logging
|
||
######################################################################
|
||
my $_in_logmsg = 0;
|
||
sub logmsg {
|
||
my %args = (
|
||
msg => '',
|
||
pfx => '',
|
||
fh => *STDERR,
|
||
email => 0, # If truthy, the message is also included in the next email.
|
||
(@_ % 2) ? (msg => pop) : (),
|
||
@_,
|
||
);
|
||
my $buffer = $args{msg};
|
||
chomp($buffer);
|
||
|
||
my $prefix = $args{pfx};
|
||
$prefix = sprintf "%-9s ", $prefix if $prefix;
|
||
if ($file) {
|
||
$prefix .= "file $file";
|
||
$prefix .= ", line $lineno" if $lineno;
|
||
$prefix .= ": ";
|
||
}
|
||
if ($prefix) {
|
||
$buffer = "$prefix$buffer";
|
||
$prefix =~ s/ $/| /;
|
||
$buffer =~ s/\n/\n$prefix/g;
|
||
}
|
||
$buffer .= "\n";
|
||
print({$args{fh}} $buffer);
|
||
|
||
if ($args{email}) {
|
||
$emailbody .= $buffer;
|
||
if (!$_in_logmsg) {
|
||
++$_in_logmsg; # avoid infinite recursion if logger calls logmsg
|
||
logger($buffer);
|
||
--$_in_logmsg;
|
||
}
|
||
}
|
||
}
|
||
sub _logmsg_fmt { return (@_ > 1) ? sprintf(shift, @_) : shift; }
|
||
sub msg { logmsg( _logmsg_fmt(@_)); }
|
||
sub verbose { logmsg(email => 1, pfx => shift, _logmsg_fmt(@_)) if opt('verbose'); }
|
||
sub info { logmsg(email => 1, pfx => 'INFO:', _logmsg_fmt(@_)) if opt('verbose'); }
|
||
sub debug { logmsg( pfx => 'DEBUG:', _logmsg_fmt(@_)) if opt('debug'); }
|
||
sub debug2 { logmsg( pfx => 'DEBUG:', _logmsg_fmt(@_)) if opt('debug') && opt('verbose'); }
|
||
sub warning { logmsg(email => 1, pfx => 'WARNING:', _logmsg_fmt(@_)); }
|
||
sub fatal { logmsg(email => 1, pfx => 'FATAL:', _logmsg_fmt(@_)); sendmail(); exit(1); }
|
||
sub success { logmsg(email => 1, pfx => 'SUCCESS:', _logmsg_fmt(@_)); }
|
||
sub failed { logmsg(email => 1, pfx => 'FAILED:', _logmsg_fmt(@_)); $result = 'FAILED'; }
|
||
sub prettytime { return scalar(localtime(shift)); }
|
||
|
||
sub prettyinterval {
|
||
my $interval = shift;
|
||
use integer;
|
||
my $s = $interval % 60; $interval /= 60;
|
||
my $m = $interval % 60; $interval /= 60;
|
||
my $h = $interval % 24; $interval /= 24;
|
||
my $d = $interval;
|
||
|
||
my $string = "";
|
||
$string .= "$d day" if $d;
|
||
$string .= "s" if $d > 1;
|
||
$string .= ", " if $string && $h;
|
||
$string .= "$h hour" if $h;
|
||
$string .= "s" if $h > 1;
|
||
$string .= ", " if $string && $m;
|
||
$string .= "$m minute" if $m;
|
||
$string .= "s" if $m > 1;
|
||
$string .= ", " if $string && $s;
|
||
$string .= "$s second" if $s;
|
||
$string .= "s" if $s > 1;
|
||
return $string;
|
||
}
|
||
sub interval {
|
||
my $value = shift;
|
||
if ($value =~ /^(\d+)(seconds|s)/i) {
|
||
$value = $1;
|
||
} elsif ($value =~ /^(\d+)(minutes|m)/i) {
|
||
$value = $1 * 60;
|
||
} elsif ($value =~ /^(\d+)(hours|h)/i) {
|
||
$value = $1 * 60*60;
|
||
} elsif ($value =~ /^(\d+)(days|d)/i) {
|
||
$value = $1 * 60*60*24;
|
||
} elsif ($value =~ qr/^(?:inf(?:init[ye])?|indefinite(?:ly)?|never|forever|always)$/i) {
|
||
$value = 'inf';
|
||
} elsif ($value !~ /^\d+$/) {
|
||
$value = undef;
|
||
}
|
||
return $value;
|
||
}
|
||
sub interval_expired {
|
||
my ($host, $time, $interval) = @_;
|
||
|
||
return 0 if ($config{$host}{$interval} // 0) == 'inf';
|
||
return 1 if !exists $recap{$host};
|
||
return 1 if !exists $recap{$host}{$time} || !$recap{$host}{$time};
|
||
return 1 if !exists $config{$host}{$interval} || !$config{$host}{$interval};
|
||
|
||
return $now > ($recap{$host}{$time} + $config{$host}{$interval});
|
||
}
|
||
|
||
|
||
|
||
######################################################################
|
||
## check_value
|
||
######################################################################
|
||
sub check_value {
|
||
my ($value, $def) = @_;
|
||
my $type = $def->{'type'};
|
||
my $min = $def->{'minimum'};
|
||
my $required = $def->{'required'};
|
||
|
||
if (!defined $value && !$required) {
|
||
;
|
||
} elsif (!defined($value) && $required) {
|
||
# None of the types have 'undef' as a valid value, so check definedness once here for
|
||
# convenience.
|
||
return undef;
|
||
|
||
} elsif ($type eq T_DELAY) {
|
||
$value = interval($value);
|
||
$value = $min if defined($value) && defined($min) && $value < $min;
|
||
|
||
} elsif ($type eq T_NUMBER) {
|
||
return undef if $value !~ /^\d+$/;
|
||
$value = $min if defined($min) && $value < $min;
|
||
|
||
} elsif ($type eq T_BOOL) {
|
||
if ($value =~ /^(y(es)?|t(rue)?|1)$/i) {
|
||
$value = 1;
|
||
} elsif ($value =~ /^(n(o)?|f(alse)?|0)$/i) {
|
||
$value = 0;
|
||
} else {
|
||
return undef;
|
||
}
|
||
} elsif ($type eq T_FQDN || $type eq T_OFQDN && $value ne '') {
|
||
$value = lc $value;
|
||
return undef if $value !~ /[^.]\.[^.]/;
|
||
|
||
} elsif ($type eq T_FQDNP) {
|
||
$value = lc $value;
|
||
return undef if $value !~ /[^.]\.[^.].*(:\d+)?$/;
|
||
|
||
} elsif ($type eq T_PROTO) {
|
||
$value = lc $value;
|
||
return undef if !exists $protocols{$value};
|
||
|
||
} elsif ($type eq T_USE) {
|
||
$value = lc $value;
|
||
return undef if !exists $ip_strategies{$value};
|
||
|
||
} elsif ($type eq T_USEV4) {
|
||
$value = lc $value;
|
||
return undef if !exists $ipv4_strategies{$value};
|
||
|
||
} elsif ($type eq T_USEV6) {
|
||
$value = lc $value;
|
||
return undef if !exists $ipv6_strategies{$value};
|
||
|
||
} elsif ($type eq T_FILE) {
|
||
return undef if $value eq "";
|
||
|
||
} elsif ($type eq T_IF) {
|
||
return undef if $value !~ /^[a-zA-Z0-9:._-]+$/;
|
||
|
||
} elsif ($type eq T_PROG) {
|
||
return undef if $value eq "";
|
||
|
||
} elsif ($type eq T_LOGIN) {
|
||
return undef if $value eq "";
|
||
|
||
} elsif ($type eq T_IP) {
|
||
return undef if !is_ipv4($value) && !is_ipv6($value);
|
||
|
||
} elsif ($type eq T_IPV4) {
|
||
return undef if !is_ipv4($value);
|
||
|
||
} elsif ($type eq T_IPV6) {
|
||
return undef if !is_ipv6($value);
|
||
|
||
}
|
||
return $value;
|
||
}
|
||
######################################################################
|
||
## encode_base64 - from MIME::Base64
|
||
######################################################################
|
||
sub encode_base64 ($;$) {
|
||
my $res = '';
|
||
my $eol = $_[1];
|
||
$eol = "\n" unless defined $eol;
|
||
pos($_[0]) = 0; # ensure start at the beginning
|
||
while ($_[0] =~ /(.{1,45})/gs) {
|
||
$res .= substr(pack('u', $1), 1);
|
||
chop($res);
|
||
}
|
||
$res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs
|
||
|
||
# fix padding at the end
|
||
my $padding = (3 - length($_[0]) % 3) % 3;
|
||
$res =~ s/.{$padding}$/'=' x $padding/e if $padding;
|
||
$res;
|
||
}
|
||
|
||
######################################################################
|
||
## load_sha1_support
|
||
######################################################################
|
||
sub load_sha1_support {
|
||
my ($protocol) = @_;
|
||
eval { require Digest::SHA; } or fatal(<<"EOM");
|
||
Error loading the Perl module Digest::SHA needed for $protocol update.
|
||
On Debian, the package libdigest-sha-perl must be installed.
|
||
EOM
|
||
Digest::SHA->import(qw/sha1_hex/);
|
||
}
|
||
|
||
######################################################################
|
||
## load_json_support
|
||
######################################################################
|
||
sub load_json_support {
|
||
my ($protocol) = @_;
|
||
eval { require JSON::PP; }
|
||
or fatal("Error loading the Perl module JSON::PP needed for $protocol update.");
|
||
JSON::PP->import(qw/decode_json encode_json/);
|
||
}
|
||
|
||
######################################################################
|
||
## curl_cmd() function to execute system curl command
|
||
######################################################################
|
||
sub curl_cmd {
|
||
my @params = @_;
|
||
my $tmpfile;
|
||
my $tfh;
|
||
my $curl = join(' ', @curl);
|
||
my %curl_codes = ( ## Subset of error codes from https://curl.haxx.se/docs/manpage.html
|
||
2 => "Failed to initialize. (Most likely a bug in ddclient, please open issue at https://github.com/ddclient/ddclient)",
|
||
3 => "URL malformed. The syntax was not correct",
|
||
5 => "Couldn't resolve proxy. The given proxy host could not be resolved.",
|
||
6 => "Couldn't resolve host. The given remote host was not resolved.",
|
||
7 => "Failed to connect to host.",
|
||
22 => "HTTP page not retrieved. The requested url was not found or returned another error.",
|
||
28 => "Operation timeout. The specified time-out period was reached according to the conditions.",
|
||
35 => "SSL connect error. The SSL handshaking failed.",
|
||
47 => "Too many redirects. When following redirects, curl hit the maximum amount.",
|
||
52 => "The server didn't reply anything, which here is considered an error.",
|
||
51 => "The peer's SSL certificate or SSH MD5 fingerprint was not OK.",
|
||
58 => "Problem with the local certificate.",
|
||
60 => "Peer certificate cannot be authenticated with known CA certificates.",
|
||
67 => "The user name, password, or similar was not accepted and curl failed to log in.",
|
||
77 => "Problem with reading the SSL CA cert (path? access rights?).",
|
||
78 => "The resource referenced in the URL does not exist.",
|
||
127 => "$curl was not found",
|
||
);
|
||
|
||
debug("CURL: %s", $curl);
|
||
fatal("curl not found") if ($curl[0] eq '');
|
||
return '' if (scalar(@params) == 0); ## no parameters provided
|
||
|
||
# Hard code to /tmp rather than use system TMPDIR to protect from malicious
|
||
# shell instructions in TMPDIR environment variable. All systems should have /tmp.
|
||
$tfh = File::Temp->new(DIR => '/tmp',
|
||
TEMPLATE => 'ddclient_XXXXXXXXXX');
|
||
$tmpfile = $tfh->filename;
|
||
|
||
debug("CURL Tempfile: %s", $tmpfile);
|
||
{
|
||
local $\ = "\n"; ## Terminate the file,
|
||
local $, = "\n"; ## and each parameter, with a newline.
|
||
print($tfh @params);
|
||
}
|
||
close($tfh);
|
||
# Use open's list form (as opposed to qx, backticks, or the scalar form of open) to avoid the
|
||
# shell and reduce the risk of a shell injection vulnerability. ':raw' mode is used because
|
||
# HTTP is defined in terms of octets (bytes), not characters. In raw mode, each byte from curl
|
||
# is mapped to a same-valued codepoint (byte value 0x78 becomes character U+0078, 0xff becomes
|
||
# U+00ff). The caller is responsible for decoding the byte sequence if necessary.
|
||
open(my $cfh, '-|:raw', @curl, '--config', $tmpfile)
|
||
or fatal("failed to run curl ($curl): $!");
|
||
# According to <https://perldoc.perl.org/PerlIO#Alternatives-to-raw>, adding ':raw' to the open
|
||
# mode is buggy with Perl < v5.14. Call binmode on the filehandle just in case.
|
||
binmode($cfh) or fatal("binmode failed: $!");
|
||
my $reply = do { local $/; <$cfh>; };
|
||
close($cfh); # Closing $cfh waits for the process to exit and sets $?.
|
||
if ((my $rc = $?>>8) != 0) {
|
||
warning("CURL error (%d) %s", $rc, $curl_codes{$rc} // "Unknown return code. Check $curl is installed and its manpage.");
|
||
}
|
||
return $reply;
|
||
}
|
||
|
||
######################################################################
|
||
## escape_curl_param() makes sure any special characters within a
|
||
## curl parameter is properly escaped.
|
||
######################################################################
|
||
sub escape_curl_param {
|
||
my $str = shift // '';
|
||
|
||
return '' if ($str eq '');
|
||
$str =~ s/\\/\\\\/g;## Escape backslashes
|
||
$str =~ s/"/\\"/g; ## Escape double-quotes
|
||
$str =~ s/\n/\\n/g; ## Escape newline
|
||
$str =~ s/\r/\\r/g; ## Escape carrage return
|
||
$str =~ s/\t/\\t/g; ## Escape tabs
|
||
$str =~ s/\v/\\v/g; ## Escape vertical whitespace
|
||
return $str;
|
||
}
|
||
|
||
sub geturl {
|
||
my %params = @_;
|
||
my $proxy = $params{proxy};
|
||
my $url = $params{url};
|
||
my $login = $params{login};
|
||
my $password = $params{password};
|
||
my $ipversion = ($params{ipversion}) ? int($params{ipversion}) : 0;
|
||
my $headers = $params{headers} // '';
|
||
my $method = $params{method} // 'GET';
|
||
my $data = $params{data} // '';
|
||
|
||
my $reply;
|
||
my $server;
|
||
my $use_ssl = 0;
|
||
my $protocol;
|
||
my $timeout = opt('timeout');
|
||
my $redirect = opt('redirect');
|
||
my @curlopt = ();
|
||
my @header_lines = ();
|
||
|
||
## canonify use_ssl, proxy and url
|
||
if ($url =~ /^https:/) {
|
||
$use_ssl = 1;
|
||
} elsif ($url =~ /^http:/) {
|
||
$use_ssl = 0;
|
||
} elsif ($globals{'ssl'} && !($params{ignore_ssl_option} // 0)) {
|
||
$use_ssl = 1;
|
||
} else {
|
||
$use_ssl = 0;
|
||
}
|
||
|
||
$proxy =~ s%^https?://%%i if defined($proxy);
|
||
$url =~ s%^https?://%%i;
|
||
$server = $url;
|
||
$server =~ s%[?/].*%%;
|
||
$url =~ s%^[^?/]*/?%%;
|
||
|
||
$protocol = ($use_ssl ? "https" : "http");
|
||
|
||
debug("proxy = %s", $proxy // '<undefined>');
|
||
debug("protocol = %s", $protocol);
|
||
debug("server = %s", $server);
|
||
(my $_url = $url) =~ s%\?.*%?<redacted>%; #redact possible credentials
|
||
debug("url = %s", $_url);
|
||
if ($ipversion != 0) {
|
||
debug("ip ver = %s", $ipversion);
|
||
}
|
||
|
||
if (!opt('exec')) {
|
||
debug("skipped network connection");
|
||
verbose("SENDING:", "%s", "${server}/${url}");
|
||
} else {
|
||
push(@curlopt, "silent");
|
||
push(@curlopt, "include"); ## Include HTTP response for compatibility
|
||
push(@curlopt, "insecure") if ($use_ssl && !($params{ssl_validate} // 1));
|
||
push(@curlopt, "cacert=\"".escape_curl_param(opt('ssl_ca_file')).'"') if defined(opt('ssl_ca_file'));
|
||
push(@curlopt, "capath=\"".escape_curl_param(opt('ssl_ca_dir')).'"') if defined(opt('ssl_ca_dir'));
|
||
push(@curlopt, "ipv4") if ($ipversion == 4);
|
||
push(@curlopt, "ipv6") if ($ipversion == 6);
|
||
push(@curlopt, "user-agent=\"".escape_curl_param("${program}/${version}").'"');
|
||
push(@curlopt, "connect-timeout=$timeout");
|
||
push(@curlopt, "max-time=$timeout");
|
||
push(@curlopt, "request=$method");
|
||
push(@curlopt, "user=\"".escape_curl_param("${login}:${password}").'"') if (defined($login) && defined($password));
|
||
push(@curlopt, "proxy=\"".escape_curl_param("${protocol}://${proxy}").'"') if defined($proxy);
|
||
push(@curlopt, "url=\"".escape_curl_param("${protocol}://${server}/${url}").'"');
|
||
|
||
# Each header line is added individually
|
||
@header_lines = ref($headers) eq 'ARRAY' ? @$headers : split('\n', $headers);
|
||
$_ = "header=\"".escape_curl_param($_).'"' for (@header_lines);
|
||
push(@curlopt, @header_lines);
|
||
|
||
# Add in the data if any was provided (for POST/PATCH)
|
||
push(@curlopt, "data=\"".escape_curl_param(${data}).'"') if ($data);
|
||
|
||
# Handle 30x redirections
|
||
if ($redirect) {
|
||
push(@curlopt, "location");
|
||
push(@curlopt, "max-redirs=$redirect");
|
||
}
|
||
|
||
# don't include ${url} as that might expose login credentials
|
||
$0 = sprintf("%s - Curl system cmd sending to %s", $program, "${protocol}://${server}");
|
||
verbose("SENDING:", "Curl system cmd to %s", "${protocol}://${server}");
|
||
verbose("SENDING:", "%s", $_) for (@curlopt);
|
||
|
||
$reply = curl_cmd(@curlopt);
|
||
verbose("RECEIVE:", "%s", $reply // "<undefined>");
|
||
if (!$reply) {
|
||
# don't include ${url} as that might expose login credentials
|
||
if ($ipversion != 0) {
|
||
warning("curl cannot connect to %s://%s using IPv%s",${protocol},${server},$ipversion);
|
||
} else {
|
||
warning("curl cannot connect to %s://%s",${protocol},${server});
|
||
}
|
||
}
|
||
}
|
||
|
||
## during testing simulate reading the URL
|
||
if (opt('test')) {
|
||
my $filename = "$server/$url";
|
||
$filename =~ s|/|%2F|g;
|
||
if (opt('exec')) {
|
||
$reply = save_file("$savedir/$filename", $reply, 'unique');
|
||
} else {
|
||
$reply = load_file("$savedir/$filename");
|
||
}
|
||
}
|
||
|
||
$reply =~ s/\r//g if defined $reply;
|
||
return $reply;
|
||
}
|
||
|
||
######################################################################
|
||
## get_ip
|
||
######################################################################
|
||
sub get_ip {
|
||
my $use = lc shift;
|
||
$use = 'disabled' if ($use eq 'no'); # backward compatibility
|
||
my $h = shift;
|
||
my ($ip, $arg, $reply, $url, $skip) = (undef, opt($use, $h), '');
|
||
$arg = '' unless $arg;
|
||
|
||
if ($use eq 'ip') {
|
||
$ip = opt('ip', $h);
|
||
if (!is_ipv4($ip) && !is_ipv6($ip)) {
|
||
warning("'%s' is not a valid IPv4 or IPv6 address", $ip // '');
|
||
$ip = undef;
|
||
}
|
||
$arg = 'ip';
|
||
} elsif ($use eq 'if') {
|
||
$ip = get_ip_from_interface($arg);
|
||
} elsif ($use eq 'cmd') {
|
||
if ($arg) {
|
||
$skip = opt('cmd-skip', $h);
|
||
$reply = `$arg`;
|
||
$reply = '' if $?;
|
||
}
|
||
} elsif ($use eq 'web') {
|
||
$url = opt('web', $h) // '';
|
||
$skip = opt('web-skip', $h);
|
||
if (my $biw = $builtinweb{$url}) {
|
||
warning("'--web=$url' is deprecated! $biw->{deprecated}") if $biw->{deprecated};
|
||
$skip //= $biw->{skip};
|
||
$url = $biw->{url};
|
||
}
|
||
$arg = $url;
|
||
if ($url) {
|
||
$reply = geturl(
|
||
proxy => opt('proxy', $h),
|
||
url => $url,
|
||
ssl_validate => opt('web-ssl-validate', $h),
|
||
) // '';
|
||
}
|
||
} elsif ($use eq 'disabled') {
|
||
## This is a no-op... Do not get an IP address for this host/service
|
||
$reply = '';
|
||
} elsif ($use eq 'fw' || defined(my $fw = $builtinfw{$use})) {
|
||
# Note that --use=firewallname uses --fw=arg, not --firewallname=arg.
|
||
$arg = opt('fw', $h) // '';
|
||
$url = $arg;
|
||
$skip = opt('fw-skip', $h);
|
||
if ($fw) {
|
||
$skip //= $fw->{'skip'};
|
||
if (defined(my $query = $fw->{'query'})) {
|
||
$url = undef;
|
||
($arg, $reply) = $query->($h);
|
||
} else {
|
||
$url = "http://$url$fw->{'url'}" unless $url =~ /\//;
|
||
}
|
||
}
|
||
if ($url) {
|
||
$reply = geturl(
|
||
url => $url,
|
||
login => opt('fw-login', $h),
|
||
password => opt('fw-password', $h),
|
||
ignore_ssl_option => 1,
|
||
ssl_validate => opt('fw-ssl-validate', $h),
|
||
) // '';
|
||
}
|
||
} else {
|
||
warning("ignoring unsupported '--use=$use'");
|
||
}
|
||
if (!defined $reply) {
|
||
$reply = '';
|
||
}
|
||
if (($skip // '') ne '') {
|
||
$skip =~ s/ /\\s/is;
|
||
$reply =~ s/^.*?${skip}//is;
|
||
}
|
||
$ip //= extract_ipv4($reply) // extract_ipv6($reply);
|
||
warning("found neither IPv4 nor IPv6 address") if !defined($ip);
|
||
if ($use ne 'ip' && ($ip // '') eq '0.0.0.0') {
|
||
$ip = undef;
|
||
}
|
||
|
||
debug("get_ip: using %s, %s reports %s", $use, $arg, $ip // "<undefined>");
|
||
return $ip;
|
||
}
|
||
|
||
######################################################################
|
||
## Regex to find IPv4 address. Accepts embedded leading zeros.
|
||
######################################################################
|
||
my $regex_ipv4 = qr/(?:(?<octet>25[0-5]|2[0-4]\d|[01]?\d\d?)\.){3}(?&octet)/;
|
||
|
||
######################################################################
|
||
## is_ipv4() validates if string is valid IPv4 address with no preceding
|
||
## or trailing spaces/characters, not even line breaks.
|
||
######################################################################
|
||
sub is_ipv4 {
|
||
return (shift // '') =~ /\A$regex_ipv4\z/;
|
||
}
|
||
|
||
######################################################################
|
||
## extract_ipv4() finds the first valid IPv4 address in the given string,
|
||
## removes embedded leading zeros, and returns the result.
|
||
######################################################################
|
||
sub extract_ipv4 {
|
||
(shift // '') =~ /(?:\b|_)($regex_ipv4)(?:\b|_)/ or return undef;
|
||
(my $ip = $1) =~ s/\b0+\B//g; ## remove embedded leading zeros
|
||
return $ip;
|
||
}
|
||
|
||
######################################################################
|
||
## Regex that matches an IPv6 address. Accepts embedded leading zeros.
|
||
## Accepts IPv4-mapped IPv6 addresses such as 64:ff9b::192.0.2.13.
|
||
######################################################################
|
||
my $regex_ipv6 = qr/
|
||
# Define some named groups so we can use Perl's recursive subpattern feature for shorthand:
|
||
(?<g>[0-9A-F]{1,4}){0} # "g" matches a group of 1 to 4 hex chars
|
||
(?<g_>(?&g):){0} # "g_" matches a group of 1 to 4 hex chars followed by a colon
|
||
(?<_g>:(?&g)){0} # "_g" matches a colon followed by a group of 1 to 4 hex chars
|
||
(?<g0>(?&g)?){0} # "g0" is an optional "g" (matches a group of 0 to 4 hex chars)
|
||
(?<g0_>(?&g0):){0} # "g0_" is an optional "g" followed by a colon
|
||
(?<x>[:.0-9A-Z]){0} # "x" matches chars that should never come before or after the address
|
||
(?<ip4>$regex_ipv4){0} # "ip4" matches an IPv4 address x.x.x.x
|
||
|
||
# Now for the regex itself:
|
||
(?<!(?&x)) # Not preceded by a character that is not allowed to come before the address
|
||
(?:
|
||
(?&g_){7}(?&g) # Exactly 8 groups of 1-4 hex chars
|
||
| (?&g_){1,7}: # OR compressed form with the double colon at the end
|
||
| :(?&_g){1,7} # OR compressed form with the double colon at the beginning
|
||
| :: # OR compressed to just a double colon
|
||
| # OR compressed form with the double colon in the middle:
|
||
(?= # Only consider this case if the string...
|
||
(?&g0_){2,7}(?&g0) # ...has 3 to 8 possibly empty groups (at least 3 because there
|
||
# will be at least one group before the ::, at least one group
|
||
# after the ::, and the :: itself is an empty group)...
|
||
(?!(?&x)) # ...then ends.
|
||
) # If the condition is true, then:
|
||
(?&g_){1,6} # 1 to 6 non-empty groups before the double colon
|
||
(?&_g){1,6} # 1 to 6 non-empty groups after the double colon
|
||
| # OR an IPv4-mapped IPv6 address:
|
||
(?: # It starts with a 96-bit prefix represented by:
|
||
(?&g_){6} # Exactly 6 groups of 1-4 hex chars with their colons
|
||
| (?&g_){1,5}: # OR compressed form with the double colon at the end
|
||
| ::(?&g_){0,5} # OR compressed form with the double colon at the beginning
|
||
| # OR compressed form with the double colon in the middle:
|
||
(?= # Only consider this case if the prefix...
|
||
(?&g0_){3,6} # ...has 3 to 6 possibly empty groups...
|
||
(?&ip4)(?!(?&x)) # ...then ends.
|
||
) # If the condition is true, then:
|
||
(?&g_){1,4} # 1 to 4 non-empty groups before the double colon
|
||
(?&_g){1,4} # 1 to 4 non-empty groups after the double colon
|
||
: # colon separating the IPv6 part from the IPv4 part
|
||
)
|
||
(?&ip4) # Prefix is followed by an IPv4 address
|
||
)
|
||
(?!(?&x)) # Not followed by a character that is not allowed to come after the address
|
||
/xi;
|
||
|
||
######################################################################
|
||
## is_ipv6() validates if string is valid IPv6 address with no preceding
|
||
## or trailing spaces/characters, not even line breaks.
|
||
######################################################################
|
||
sub is_ipv6 {
|
||
return (shift // '') =~ /\A$regex_ipv6\z/;
|
||
}
|
||
|
||
######################################################################
|
||
## extract_ipv6() finds the first valid IPv6 address in the given string,
|
||
## removes embedded leading zeros, and returns the result.
|
||
######################################################################
|
||
sub extract_ipv6 {
|
||
(shift // '') =~ /($regex_ipv6)/ or return undef;
|
||
(my $ip = $1) =~ s/\b0+\B//g; ## remove embedded leading zeros
|
||
return $ip;
|
||
}
|
||
|
||
######################################################################
|
||
## Regex that matches an IPv6 address that is probably globally routable.
|
||
## Accepts embedded leading zeros.
|
||
######################################################################
|
||
my $regex_ipv6_global = qr{
|
||
(?! # Is not one of the following addresses:
|
||
0{0,4}: # ::/16 is assumed to never contain globaly routable addresses
|
||
| f[cd][0-9a-f]{2}: # fc00::/7 RFC4193 ULA
|
||
| fe[89ab][0-9a-f]: # fe80::/10 link local
|
||
| ff[0-9a-f]{2}: # ff00::/8 multicast
|
||
)
|
||
$regex_ipv6 # And is a valid IPv6 address
|
||
}xi;
|
||
|
||
######################################################################
|
||
## is_ipv6_global() returns true if the string is a valid IPv6 address
|
||
## that is probably globally routable, with no preceding or trailing
|
||
## characters. All addresses in the ::/16 block are assumed to not be
|
||
## globally routable.
|
||
######################################################################
|
||
sub is_ipv6_global {
|
||
return (shift // '') =~ /\A$regex_ipv6_global\z/
|
||
}
|
||
|
||
######################################################################
|
||
## extract_ipv6_global() finds the first IPv6 address in the given
|
||
## string that satisfies is_ipv6_global(), removes embedded leading
|
||
## zeros, and returns the result. Returns undef if no such address is
|
||
## found.
|
||
######################################################################
|
||
sub extract_ipv6_global {
|
||
(shift // '') =~ /($regex_ipv6_global)/ or return undef;
|
||
(my $ip = $1) =~ s/\b0+\B//g; ## remove embedded leading zeros
|
||
return $ip;
|
||
}
|
||
|
||
######################################################################
|
||
## Regex that matches an IPv6 address that is unique local (ULA).
|
||
## Accepts embedded leading zeros.
|
||
######################################################################
|
||
my $regex_ipv6_ula = qr{
|
||
(?= # Address starts with
|
||
f[cd][0-9a-f]{2}: # fc00::/7 RFC4193 ULA
|
||
)
|
||
$regex_ipv6 # And is a valid IPv6 address
|
||
}xi;
|
||
|
||
######################################################################
|
||
## get_default_interface finds the default network interface based on
|
||
## the IP routing table on the system. We validate that the interface
|
||
## found is likely to have global routing (e.g. is not LOOPBACK).
|
||
## Returns undef if no global scope interface can be found for IP version.
|
||
######################################################################
|
||
sub get_default_interface {
|
||
my $ipver = int(shift // 4); ## Defaults to IPv4 if not specified
|
||
my $ipstr = ($ipver == 6) ? 'inet6' : 'inet';
|
||
my $reply = shift // ''; ## Pass in data for unit testing purposes only
|
||
my $cmd = "test";
|
||
|
||
return undef if (($ipver != 4) && ($ipver != 6));
|
||
|
||
if (!$reply) { ## skip if test data passed in.
|
||
## Best option is the ip command from iproute2 package
|
||
$cmd = "ip -$ipver -o route list match default"; $reply = qx{ $cmd 2>/dev/null };
|
||
## Fallback is the netstat command. This is only option on MacOS.
|
||
if ($?) { $cmd = "netstat -rn -$ipver"; $reply = qx{ $cmd 2>/dev/null }; } # Linux, FreeBSD
|
||
if ($?) { $cmd = "netstat -rn -f $ipstr"; $reply = qx{ $cmd 2>/dev/null }; } # MacOS
|
||
if ($?) { $cmd = "netstat -rn"; $reply = qx{ $cmd 2>/dev/null }; } # Busybox
|
||
if ($?) { $cmd = "missing ip or netstat command";
|
||
failed("Unable to obtain default route information -- %s", $cmd)
|
||
}
|
||
}
|
||
debug("Reply from '%s' :\n------\n%s------", $cmd, $reply);
|
||
|
||
# Check we have IPv6 address in case we got routing table from non-specific cmd above
|
||
return undef if (($ipver == 6) && !extract_ipv6($reply));
|
||
# Filter down to just the default interfaces
|
||
my @list = split(/\n/, $reply);
|
||
@list = grep(/^default|^(?:0\.){3}0|^::\/0/, @list); # Select 'default' or '0.0.0.0' or '::/0'
|
||
return undef if (scalar(@list) == 0);
|
||
debug("Default routes found for IPv%s :\n%s", $ipver, join("\n",@list));
|
||
|
||
# now check each interface to make sure it is global (not loopback).
|
||
for my $line (@list) {
|
||
## Interface will be after "dev" or the last word in the line. Must accept blank spaces
|
||
## at the end. Interface name may not have any whitespace or forward slash.
|
||
$line =~ /\bdev\b\s*\K[^\s\/]+|\b[^\s\/]+(?=[\s\/]*$)/;
|
||
my $interface = $&;
|
||
## If test data was passed in skip following tests
|
||
if ($cmd ne "test") {
|
||
## We do not want the loopback interface or anything interface without global scope
|
||
$cmd = "ip -$ipver -o addr show dev $interface scope global"; $reply = qx{$cmd 2>/dev/null};
|
||
if ($?) { $cmd = "ifconfig $interface"; $reply = qx{$cmd 2>/dev/null}; }
|
||
if ($?) { $cmd = "missing ip or ifconfig command";
|
||
failed("Unable to obtain information for '%s' -- %s", $interface, $cmd);
|
||
}
|
||
debug("Reply from '%s' :\n------\n%s------", $cmd, $reply);
|
||
}
|
||
## Has global scope, is not LOOPBACK
|
||
return($interface) if (($reply) && ($reply !~ /\bLOOPBACK\b/));
|
||
}
|
||
return undef;
|
||
}
|
||
|
||
######################################################################
|
||
## get_ip_from_interface() finds an IPv4 or IPv6 address from a network
|
||
## interface. Defaults to IPv4 unless '6' passed as 2nd parameter.
|
||
######################################################################
|
||
sub get_ip_from_interface {
|
||
my $interface = shift // "default";
|
||
my $ipver = int(shift // 4); ## Defaults to IPv4 if not specified
|
||
my $scope = lc(shift // "gua"); ## "gua" or "ula"
|
||
my $reply = shift // ''; ## Pass in data for unit testing purposes only
|
||
my $MacOS = shift // 0; ## For testing can set to 1 if input data is MacOS/FreeBSD format
|
||
my $count = 0;
|
||
my $cmd = "test";
|
||
|
||
if (($ipver != 4) && ($ipver != 6)) {
|
||
warning("get_ip_from_interface() invalid IP version: %s", $ipver);
|
||
return undef;
|
||
}
|
||
|
||
if ((lc($interface) eq "default") && (!$reply)) { ## skip if test data passed in.
|
||
$interface = get_default_interface($ipver);
|
||
return undef if !defined($interface);
|
||
}
|
||
|
||
if ($ipver == 4) {
|
||
if (!$reply) { ## skip if test data passed in.
|
||
## Try ip first, then ifconfig.
|
||
$cmd = "ip -4 -o addr show dev $interface scope global"; $reply = qx{$cmd 2>/dev/null};
|
||
if ($?) { $cmd = "ifconfig $interface"; $reply = qx{$cmd 2>/dev/null}; }
|
||
if ($?) { $cmd = "missing ip or ifconfig command";
|
||
failed("Unable to obtain information for '%s' -- %s", $interface, $cmd);
|
||
}
|
||
}
|
||
debug("Reply from '%s' :\n------\n%s------", $cmd, $reply);
|
||
|
||
## IPv4 is simple, we just need to find the first IPv4 address returned in the list.
|
||
my @reply = split(/\n/, $reply);
|
||
@reply = grep(/\binet\b/, @reply); # Select only IPv4 entries
|
||
return extract_ipv4($reply[0]);
|
||
}
|
||
|
||
## From this point on we only looking for IPv6 address.
|
||
if (($scope ne "gua") && ($scope ne "ula")) {
|
||
warning("get_ip_from_interface() invalid IPv6 scope: %s, using type GUA", $scope);
|
||
$scope = "gua";
|
||
}
|
||
|
||
$cmd = "test data";
|
||
if (!$reply) { ## skip if test data passed in.
|
||
## Try ip first, then ifconfig with -L for MacOS/FreeBSD then finally ifconfig for everything else
|
||
$cmd = "ip -6 -o addr show dev $interface scope global"; $reply = qx{$cmd 2>/dev/null}; # Linux
|
||
if ($?) { $cmd = "ifconfig -L $interface"; $MacOS = 1; $reply = qx{$cmd 2>/dev/null}; } # MacOS/FreeBSD
|
||
if ($?) { $cmd = "ifconfig $interface"; $reply = qx{$cmd 2>/dev/null}; } # Anything without iproute2 or -L
|
||
if ($?) { $cmd = "missing ip or ifconfig command";
|
||
failed("Unable to obtain information for '%s' -- %s", $interface, $cmd);
|
||
}
|
||
}
|
||
debug("Reply from '%s' :\n------\n%s------", $cmd, $reply);
|
||
|
||
## IPv6 is more complex than IPv4. Start by filtering on only "inet6" addresses
|
||
## Then remove deprecated or temporary addresses and finally seleect on global or local addresses
|
||
my @reply = split(/\n/, $reply);
|
||
@reply = grep(/\binet6\b/, @reply); # Select only IPv6 entries
|
||
@reply = grep(!/\bdeprecated\b|\btemporary\b/, @reply); # Remove deprecated and temporary
|
||
@reply = ($scope eq "gua") ? grep(/$regex_ipv6_global/, @reply) # Select only global addresses
|
||
: grep(/$regex_ipv6_ula/, @reply); # or only ULA addresses
|
||
debug("Raw IPv6 after filtering for %s addresses %s: (%s)\r\n%s", uc($scope), $interface, scalar(@reply), join("\n", @reply));
|
||
|
||
## If we filter down to zero or one result then we are done...
|
||
return undef if (($count = scalar(@reply)) == 0);
|
||
return extract_ipv6($reply[0]) if ($count == 1);
|
||
|
||
## If there are more than one we need to select the "best".
|
||
## First choice would be a static address.
|
||
my @static = ($MacOS == 1) ? grep(!/^.*\bvltime\b.*$/i, @reply) # MacOS/FreeBSD, no 'vltime'
|
||
: grep(/^.*\bvalid_lft.\bforever\b.*$/i, @reply); # Everything else 'forever' life
|
||
$count = scalar(@static);
|
||
debug("Possible Static IP addresses %s: (%s)\r\n%s", $interface, $count, join("\n", @static));
|
||
|
||
## If only one result then we are done. If there are more than one static addresses
|
||
## then we will replace our original list with the list of statics and sort on them.
|
||
## If zero static addresses we fall through with our original list.
|
||
return extract_ipv6($static[0]) if ($count == 1);
|
||
@reply = @static if ($count > 1);
|
||
|
||
## Sort what we have by the prefix length, IP address "length" and finally valid life.
|
||
my @sorted = sort {
|
||
## We give preference to IP addressess with the longest prefix... so we prefer a /128 over a /64
|
||
## this is a decimal (\d+) either after the word "prefixlen" or after a forward slash.
|
||
(($b =~ /(?:\bprefixlen\b\s*|\/)(\d+)/i)[0] // 0) <=> (($a =~ /(?:\bprefixlen\b\s*|\/)(\d+)/i)[0] // 0)
|
||
|
||
## If there are multiple the same then we prefer "shorter" IP addresses in the
|
||
## theory that a shorter address is more likely assigned by DHCPv6 than SLAAC.
|
||
## E.g. 2001:db8:4341:0781::8214/64 is preferable to 2001:db8:4341:0781:34a6:c329:c52e:8ba6/64
|
||
## So we count the number () of groups of [0-9a-f] blocks in the IP address.
|
||
|| (()= (extract_ipv6($a) // '') =~ /[0-9A-F]+/gi) <=> (()= (extract_ipv6($b) // '') =~ /[0-9A-F]+/gi)
|
||
|
||
## Finally we check remaining valid lifetime and prefer longer remaining life.
|
||
## This is a desimal (\d+) after the word "valid_lft" or "vltime". Only available
|
||
## from iproute2 or MacOS/FreeBSD version of ifconfig (-L parameter).
|
||
|| (($b =~ /(?:\bvalid_lft\b\s*|\bvltime\b\s*)(\d+)/i)[0] // 0) <=> (($a =~ /(?:\bvalid_lft\b\s*|\bvltime\b\s*)(\d+)/i)[0] // 0)
|
||
} @reply;
|
||
debug("Sorted list of IP addresss for %s: (%s)\r\n%s", $interface, scalar(@sorted), join("\n", @sorted));
|
||
|
||
## Whatever sorted to the top is the best choice for IPv6 address
|
||
return extract_ipv6($sorted[0]);
|
||
}
|
||
|
||
######################################################################
|
||
## get_ipv4
|
||
######################################################################
|
||
sub get_ipv4 {
|
||
my $usev4 = lc(shift); ## Method to obtain IP address
|
||
my $h = shift; ## Host/service making the request
|
||
my $ipv4 = undef; ## Found IPv4 address
|
||
my $reply = ''; ## Text returned from various methods
|
||
my $url = ''; ## URL of website or firewall
|
||
my $skip = undef; ## Regex of pattern to skip before looking for IP
|
||
my $arg = opt($usev4, $h) // ''; ## Value assigned to the "usev4" method
|
||
|
||
if ($usev4 eq 'ipv4') {
|
||
## Static IPv4 address is provided in "ipv4=<address>"
|
||
$ipv4 = $arg;
|
||
if (!is_ipv4($ipv4)) {
|
||
warning("'%s' is not a valid IPv4", $ipv4 // '');
|
||
$ipv4 = undef;
|
||
}
|
||
$arg = 'ipv4'; # For debug message at end of function
|
||
} elsif ($usev4 eq 'ifv4') {
|
||
## Obtain IPv4 address from interface mamed in "ifv4=<if>"
|
||
$ipv4 = get_ip_from_interface($arg, 4);
|
||
} elsif ($usev4 eq 'cmdv4') {
|
||
## Obtain IPv4 address by executing the command in "cmdv4=<command>"
|
||
warning("'--cmd-skip' ignored for '--usev4=$usev4'") if (opt('verbose') && opt('cmd-skip', $h));
|
||
if ($arg) {
|
||
my $sys_cmd = quotemeta($arg);
|
||
$reply = qx{$sys_cmd};
|
||
$reply = '' if $?;
|
||
}
|
||
} elsif ($usev4 eq 'webv4') {
|
||
## Obtain IPv4 address by accessing website at url in "webv4=<url>"
|
||
$url = $arg;
|
||
$skip = opt('webv4-skip', $h);
|
||
if (my $biw = $builtinweb{$url}) {
|
||
warning("'--webv4=$url' is deprecated! $biw->{deprecated}") if $biw->{deprecated};
|
||
$skip //= $biw->{skip};
|
||
$url = $biw->{url};
|
||
$arg = $url;
|
||
}
|
||
if ($url) {
|
||
$reply = geturl(
|
||
proxy => opt('proxy', $h),
|
||
url => $url,
|
||
ipversion => 4, # when using a URL to find IPv4 address we should force use of IPv4
|
||
ssl_validate => opt('web-ssl-validate', $h),
|
||
) // '';
|
||
}
|
||
} elsif ($usev4 eq 'disabled') {
|
||
## This is a no-op... Do not get an IPv4 address for this host/service
|
||
$reply = '';
|
||
} elsif ($usev4 eq 'fwv4' || defined(my $fw = $builtinfw{$usev4})) {
|
||
warning("'--fw' is deprecated for '--usev4=$usev4'; use '--fwv4' instead")
|
||
if (!defined(opt('fwv4', $h)) && defined(opt('fw', $h)));
|
||
warning("'--fw-skip' is deprecated for '--usev4=$usev4'; use '--fwv4-skip' instead")
|
||
if (!defined(opt('fwv4-skip', $h)) && defined(opt('fw-skip', $h)));
|
||
# Note that --usev4=firewallname uses --fwv4=arg (or --fw=arg), not --firewallname=arg.
|
||
$arg = opt('fwv4', $h) // opt('fw', $h) // '';
|
||
$url = $arg;
|
||
$skip = opt('fwv4-skip', $h) // opt('fw-skip', $h);
|
||
if ($fw) {
|
||
$skip //= $fw->{'skip'};
|
||
if (defined(my $query = $fw->{'queryv4'})) {
|
||
$url = undef;
|
||
($arg, $reply) = $query->($h);
|
||
} else {
|
||
$url = "http://$url$fw->{'url'}" unless $url =~ /\//;
|
||
}
|
||
}
|
||
if ($url) {
|
||
$reply = geturl(
|
||
url => $url,
|
||
login => opt('fw-login', $h),
|
||
password => opt('fw-password', $h),
|
||
ipversion => 4, # when using a URL to find IPv4 address we should force use of IPv4
|
||
ignore_ssl_option => 1,
|
||
ssl_validate => opt('fw-ssl-validate', $h),
|
||
) // '';
|
||
}
|
||
} else {
|
||
warning("ignoring unsupported '--usev4=$usev4'");
|
||
}
|
||
|
||
## Set to loopback address if no text set yet
|
||
$reply = '0.0.0.0' if !defined($reply);
|
||
if (($skip // '') ne '') {
|
||
$skip =~ s/ /\\s/is;
|
||
$reply =~ s/^.*?${skip}//is;
|
||
}
|
||
## If $ipv4 not set yet look for IPv4 address in the $reply text
|
||
$ipv4 //= extract_ipv4($reply);
|
||
## Return undef for loopback address unless statically assigned by "ipv4=0.0.0.0"
|
||
$ipv4 = undef if (($usev4 ne 'ipv4') && (($ipv4 // '') eq '0.0.0.0'));
|
||
debug("get_ipv4: using (%s, %s) reports %s", $usev4, $arg, $ipv4 // "<undefined>");
|
||
return $ipv4;
|
||
}
|
||
|
||
######################################################################
|
||
## get_ipv6
|
||
######################################################################
|
||
sub get_ipv6 {
|
||
my $usev6 = lc(shift); ## Method to obtain IP address
|
||
$usev6 = 'disabled' if ($usev6 eq 'no'); # backward compatibility
|
||
my $h = shift; ## Host/service making the request
|
||
my $ipv6 = undef; ## Found IPv6 address
|
||
my $reply = ''; ## Text returned from various methods
|
||
my $url = ''; ## URL of website or firewall
|
||
my $skip = undef; ## Regex of pattern to skip before looking for IP
|
||
my $arg = opt($usev6, $h) // ''; ## Value assigned to the "usev6" method
|
||
|
||
if ($usev6 eq 'ipv6' || $usev6 eq 'ip') {
|
||
## Static IPv6 address is provided in "ipv6=<address>"
|
||
if ($usev6 eq 'ip') {
|
||
warning("'--usev6=ip' is deprecated. Use '--usev6=ipv6'");
|
||
$arg = opt('ipv6', $h) // $arg;
|
||
}
|
||
$ipv6 = $arg;
|
||
if (!is_ipv6($ipv6)) {
|
||
warning("'%s' is not a valid IPv6", $ipv6 // '');
|
||
$ipv6 = undef;
|
||
}
|
||
$arg = 'ipv6'; # For debug message at end of function
|
||
} elsif ($usev6 eq 'ifv6' || $usev6 eq 'if') {
|
||
## Obtain IPv6 address from interface mamed in "ifv6=<if>"
|
||
if ($usev6 eq 'if') {
|
||
warning("'--usev6=if' is deprecated. Use '--usev6=ifv6'");
|
||
$arg = opt('ifv6', $h) // $arg;
|
||
}
|
||
$ipv6 = get_ip_from_interface($arg, 6);
|
||
} elsif ($usev6 eq 'cmdv6' || $usev6 eq 'cmd') {
|
||
## Obtain IPv6 address by executing the command in "cmdv6=<command>"
|
||
if ($usev6 eq 'cmd') {
|
||
warning("'--usev6=cmd' is deprecated. Use '--usev6=cmdv6'");
|
||
$arg = opt('cmdv6', $h) // $arg;
|
||
}
|
||
warning("'--cmd-skip' ignored for '--usev6=$usev6'") if (opt('verbose') && opt('cmd-skip', $h));
|
||
if ($arg) {
|
||
my $sys_cmd = quotemeta($arg);
|
||
$reply = qx{$sys_cmd};
|
||
$reply = '' if $?;
|
||
}
|
||
} elsif ($usev6 eq 'webv6' || $usev6 eq 'web') {
|
||
## Obtain IPv6 address by accessing website at url in "webv6=<url>"
|
||
if ($usev6 eq 'web') {
|
||
warning("'--usev6=web' is deprecated. Use '--usev6=webv6'");
|
||
$arg = opt('webv6', $h) // $arg;
|
||
}
|
||
warning("'--web-skip' ignored for '--usev6=$usev6'; use '--webv6-skip' instead")
|
||
if (!defined(opt('webv6-skip', $h)) && defined(opt('web-skip', $h)));
|
||
$url = $arg;
|
||
$skip = opt('webv6-skip', $h);
|
||
if (my $biw = $builtinweb{$url}) {
|
||
warning("'--webv6=$url' is deprecated! $biw->{deprecated}") if $biw->{deprecated};
|
||
$skip //= $biw->{skip};
|
||
$url = $biw->{url};
|
||
$arg = $url;
|
||
}
|
||
if ($url) {
|
||
$reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
ipversion => 6, # when using a URL to find IPv6 address we should force use of IPv6
|
||
ssl_validate => opt('web-ssl-validate', $h),
|
||
) // '';
|
||
}
|
||
} elsif ($usev6 eq 'disabled') {
|
||
$reply = '';
|
||
} elsif ($usev6 eq 'fwv6' || defined(my $fw = $builtinfw{$usev6})) {
|
||
$skip = opt('fwv6-skip', $h) // $fw->{'skip'};
|
||
if ($fw && defined(my $query = $fw->{'queryv6'})) {
|
||
$skip //= $fw->{'skip'};
|
||
($arg, $reply) = $query->($h);
|
||
} else {
|
||
warning("'--usev6=%s' is not implemented and does nothing", $usev6);
|
||
}
|
||
} else {
|
||
warning("ignoring unsupported '--usev6=$usev6'");
|
||
}
|
||
|
||
## Set to loopback address if no text set yet
|
||
$reply = '::' if !defined($reply);
|
||
if (($skip // '') ne '') {
|
||
$skip =~ s/ /\\s/is;
|
||
$reply =~ s/^.*?${skip}//is;
|
||
}
|
||
## If $ipv6 not set yet look for IPv6 address in the $reply text
|
||
$ipv6 //= extract_ipv6($reply);
|
||
## Return undef for loopback address unless statically assigned by "ipv6=::"
|
||
$ipv6 = undef if (($usev6 ne 'ipv6') && ($usev6 ne 'ip') && (($ipv6 // '') eq '::'));
|
||
debug("get_ipv6: using (%s, %s) reports %s", $usev6, $arg, $ipv6 // "<undefined>");
|
||
return $ipv6;
|
||
}
|
||
|
||
######################################################################
|
||
## group_hosts_by
|
||
######################################################################
|
||
sub group_hosts_by {
|
||
my ($hosts, @attrs) = @_;
|
||
my %attrs = map({ ($_ => undef); } @attrs);
|
||
@attrs = sort(keys(%attrs));
|
||
my %groups;
|
||
my %cfgs;
|
||
my $d = Data::Dumper->new([])->Indent(0)->Sortkeys(1)->Terse(1)->Useqq(1);
|
||
for my $h (@$hosts) {
|
||
my %cfg = map({ ($_ => $config{$h}{$_}); } grep(exists($config{$h}{$_}), @attrs));
|
||
my $sig = $d->Reset()->Values([\%cfg])->Dump();
|
||
push(@{$groups{$sig}}, $h);
|
||
$cfgs{$sig} = \%cfg;
|
||
}
|
||
return map({ {cfg => $cfgs{$_}, hosts => $groups{$_}}; } keys(%groups));
|
||
}
|
||
|
||
######################################################################
|
||
## encode_www_form_urlencoded
|
||
######################################################################
|
||
sub encode_www_form_urlencoded {
|
||
my $formdata = shift;
|
||
|
||
my $must_encode = qr'[<>"#%{}|\\^~\[\]`;/?:=&+]';
|
||
my $encoded;
|
||
my $i = 0;
|
||
for my $k (keys %$formdata) {
|
||
my $kenc = $k;
|
||
my $venc = $formdata->{$k};
|
||
|
||
$kenc =~ s/($must_encode)/sprintf('%%%02X', ord($1))/ge;
|
||
$venc =~ s/($must_encode)/sprintf('%%%02X', ord($1))/ge;
|
||
|
||
$kenc =~ s/ /+/g;
|
||
$venc =~ s/ /+/g;
|
||
|
||
$encoded .= $kenc . '=' . $venc;
|
||
if ($i < (keys %$formdata) - 1) {
|
||
$encoded .= '&';
|
||
}
|
||
$i++;
|
||
}
|
||
|
||
return $encoded;
|
||
}
|
||
|
||
######################################################################
|
||
## nic_examples
|
||
######################################################################
|
||
sub nic_examples {
|
||
my $examples = "";
|
||
my $separator = "";
|
||
for my $p (sort keys %protocols) {
|
||
my $subr = $protocols{$p}{'examples'};
|
||
my $example;
|
||
|
||
if (defined($subr) && ($example = &$subr())) {
|
||
chomp($example);
|
||
$examples .= $example;
|
||
$examples .= "\n\n$separator";
|
||
$separator = "\n";
|
||
}
|
||
}
|
||
my $intro = <<"EoEXAMPLE";
|
||
== CONFIGURING ${program}
|
||
|
||
The configuration file, ${program}.conf, can be used to define the
|
||
default behaviour and operation of ${program}. The file consists of
|
||
sequences of global variable definitions and host definitions.
|
||
|
||
Global definitions look like:
|
||
name=value [,name=value]*
|
||
|
||
For example:
|
||
daemon=5m
|
||
use=if, if=eth0
|
||
proxy=proxy.myisp.com
|
||
protocol=dyndns2
|
||
|
||
specifies that ${program} should operate as a daemon, checking the
|
||
eth0 interface for an IP address change every 5 minutes and use the
|
||
'dyndns2' protocol by default. The daemon interval can be specified
|
||
as seconds (600s), minutes (5m), hours (1h) or days (1d).
|
||
|
||
Host definitions look like:
|
||
[name=value [,name=value]*]* a.host.domain [,b.host.domain] [login] [password]
|
||
|
||
For example:
|
||
protocol=noip, \\
|
||
login=your-username, password=your-password myhost.noip.com
|
||
login=your-username, password=your-password myhost.noip.com,myhost2.noip.com
|
||
|
||
specifies two host definitions.
|
||
|
||
The first definition will use the noip protocol,
|
||
your-username and your-password to update the ip-address of
|
||
myhost.noip.com and my2ndhost.noip.com.
|
||
|
||
The second host definition will use the current default protocol
|
||
('dyndns2'), my-login and my-password to update the ip-address of
|
||
myhost.dyndns.org and my2ndhost.dyndns.org.
|
||
|
||
The order of this sequence is significant because the values of any
|
||
global variable definitions are bound to a host definition when the
|
||
host definition is encountered.
|
||
|
||
See the sample-${program}.conf file for further examples.
|
||
EoEXAMPLE
|
||
$intro .= "\n== NIC specific variables and examples:\n$examples" if $examples;
|
||
return $intro;
|
||
}
|
||
######################################################################
|
||
## nic_updateable
|
||
## Returns true if we can go ahead and update the IP address at server
|
||
######################################################################
|
||
sub nic_updateable {
|
||
my $host = shift;
|
||
my $sub = shift;
|
||
my $update = 0;
|
||
my $ip = $config{$host}{'wantip'};
|
||
my $ipv4 = $config{$host}{'wantipv4'};
|
||
my $ipv6 = $config{$host}{'wantipv6'};
|
||
my $use = opt('use', $host) // 'disabled';
|
||
my $usev4 = opt('usev4', $host) // 'disabled';
|
||
my $usev6 = opt('usev6', $host) // 'disabled';
|
||
$use = 'disabled' if ($use eq 'no'); # backward compatibility
|
||
$usev6 = 'disabled' if ($usev6 eq 'no'); # backward compatibility
|
||
$use = 'disabled' if ($usev4 ne 'disabled') || ($usev6 ne 'disabled');
|
||
|
||
# If we have a valid IP address and we have previously warned that it was invalid.
|
||
# reset the warning count back to zero.
|
||
if (($use ne 'disabled') && $ip && $warned_ip{$host}) {
|
||
$warned_ip{$host} = 0;
|
||
warning("IP address for %s valid: %s. Reset warning count", $host, $ip);
|
||
}
|
||
if (($usev4 ne 'disabled') && $ipv4 && $warned_ipv4{$host}) {
|
||
$warned_ipv4{$host} = 0;
|
||
warning("IPv4 address for %s valid: %s. Reset warning count", $host, $ipv4);
|
||
}
|
||
if (($usev6 ne 'disabled') && $ipv6 && $warned_ipv6{$host}) {
|
||
$warned_ipv6{$host} = 0;
|
||
warning("IPv6 address for %s valid: %s. Reset warning count", $host, $ipv6);
|
||
}
|
||
|
||
if ($opt{'force'}) {
|
||
info("forcing update of %s.", $host);
|
||
$update = 1;
|
||
|
||
} elsif (!exists($recap{$host})) {
|
||
info("forcing updating %s because no recap entry exists in cache file.", $host);
|
||
$update = 1;
|
||
|
||
} elsif ($recap{$host}{'wtime'} && $recap{$host}{'wtime'} > $now) {
|
||
warning("cannot update %s from %s to %s until after %s.",
|
||
$host,
|
||
($recap{$host}{'ip'} ? $recap{$host}{'ip'} : '<nothing>'), $ip,
|
||
prettytime($recap{$host}{'wtime'})
|
||
);
|
||
|
||
} elsif ($recap{$host}{'mtime'} && interval_expired($host, 'mtime', 'max-interval')) {
|
||
warning("forcing update of %s from %s to %s; %s since last update on %s.",
|
||
$host,
|
||
($recap{$host}{'ip'} ? $recap{$host}{'ip'} : '<nothing>'), $ip,
|
||
prettyinterval($config{$host}{'max-interval'}),
|
||
prettytime($recap{$host}{'mtime'})
|
||
);
|
||
$update = 1;
|
||
|
||
} elsif ($use ne 'disabled' && ($recap{$host}{'ip'} // '') ne $ip) {
|
||
## Check whether to update IP address for the "--use" method"
|
||
if (($recap{$host}{'status'} // '') eq 'good' &&
|
||
!interval_expired($host, 'mtime', 'min-interval')) {
|
||
|
||
warning("skipping update of %s from %s to %s.\nlast updated %s.\nWait at least %s between update attempts.",
|
||
$host,
|
||
($recap{$host}{'ip'} ? $recap{$host}{'ip'} : '<nothing>'),
|
||
$ip,
|
||
($recap{$host}{'mtime'} ? prettytime($recap{$host}{'mtime'}) : '<never>'),
|
||
prettyinterval($config{$host}{'min-interval'})
|
||
)
|
||
if opt('verbose') || !($recap{$host}{'warned-min-interval'} // 0);
|
||
|
||
$recap{$host}{'warned-min-interval'} = $now;
|
||
|
||
} elsif (($recap{$host}{'status'} // '') ne 'good' &&
|
||
!interval_expired($host, 'atime', 'min-error-interval')) {
|
||
|
||
if (opt('verbose') || (!$recap{$host}{'warned-min-error-interval'} &&
|
||
($warned_ip{$host} // 0) < $inv_ip_warn_count)) {
|
||
|
||
warning("skipping update of %s from %s to %s.\nlast updated %s but last attempt on %s failed.\nWait at least %s between update attempts.",
|
||
$host,
|
||
($recap{$host}{'ip'} ? $recap{$host}{'ip'} : '<nothing>'),
|
||
$ip,
|
||
($recap{$host}{'mtime'} ? prettytime($recap{$host}{'mtime'}) : '<never>'),
|
||
($recap{$host}{'atime'} ? prettytime($recap{$host}{'atime'}) : '<never>'),
|
||
prettyinterval($config{$host}{'min-error-interval'})
|
||
);
|
||
if (!$ip && !opt('verbose')) {
|
||
$warned_ip{$host} = ($warned_ip{$host} // 0) + 1;
|
||
warning("IP address for %s undefined. Warned %s times, suppressing further warnings", $host, $inv_ip_warn_count)
|
||
if ($warned_ip{$host} >= $inv_ip_warn_count);
|
||
}
|
||
}
|
||
|
||
$recap{$host}{'warned-min-error-interval'} = $now;
|
||
|
||
} else {
|
||
$update = 1;
|
||
}
|
||
|
||
} elsif ($usev4 ne 'disabled' && ($recap{$host}{'ipv4'} // '') ne $ipv4) {
|
||
## Check whether to update IPv4 address for the "--usev4" method"
|
||
if (($recap{$host}{'status-ipv4'} // '') eq 'good' &&
|
||
!interval_expired($host, 'mtime', 'min-interval')) {
|
||
|
||
warning("skipping update of %s from %s to %s.\nlast updated %s.\nWait at least %s between update attempts.",
|
||
$host,
|
||
($recap{$host}{'ipv4'} ? $recap{$host}{'ipv4'} : '<nothing>'),
|
||
$ipv4,
|
||
($recap{$host}{'mtime'} ? prettytime($recap{$host}{'mtime'}) : '<never>'),
|
||
prettyinterval($config{$host}{'min-interval'})
|
||
)
|
||
if opt('verbose') || !($recap{$host}{'warned-min-interval'} // 0);
|
||
|
||
$recap{$host}{'warned-min-interval'} = $now;
|
||
|
||
} elsif (($recap{$host}{'status-ipv4'} // '') ne 'good' &&
|
||
!interval_expired($host, 'atime', 'min-error-interval')) {
|
||
|
||
if (opt('verbose') || (!$recap{$host}{'warned-min-error-interval'} &&
|
||
($warned_ipv4{$host} // 0) < $inv_ip_warn_count)) {
|
||
|
||
warning("skipping update of %s from %s to %s.\nlast updated %s but last attempt on %s failed.\nWait at least %s between update attempts.",
|
||
$host,
|
||
($recap{$host}{'ipv4'} ? $recap{$host}{'ipv4'} : '<nothing>'),
|
||
$ipv4,
|
||
($recap{$host}{'mtime'} ? prettytime($recap{$host}{'mtime'}) : '<never>'),
|
||
($recap{$host}{'atime'} ? prettytime($recap{$host}{'atime'}) : '<never>'),
|
||
prettyinterval($config{$host}{'min-error-interval'})
|
||
);
|
||
if (!$ipv4 && !opt('verbose')) {
|
||
$warned_ipv4{$host} = ($warned_ipv4{$host} // 0) + 1;
|
||
warning("IPv4 address for %s undefined. Warned %s times, suppressing further warnings", $host, $inv_ip_warn_count)
|
||
if ($warned_ipv4{$host} >= $inv_ip_warn_count);
|
||
}
|
||
}
|
||
|
||
$recap{$host}{'warned-min-error-interval'} = $now;
|
||
|
||
} else {
|
||
$update = 1;
|
||
}
|
||
|
||
} elsif ($usev6 ne 'disabled' && ($recap{$host}{'ipv6'} // '') ne $ipv6) {
|
||
## Check whether to update IPv6 address for the "--usev6" method"
|
||
if (($recap{$host}{'status-ipv6'} // '') eq 'good' &&
|
||
!interval_expired($host, 'mtime', 'min-interval')) {
|
||
|
||
warning("skipping update of %s from %s to %s.\nlast updated %s.\nWait at least %s between update attempts.",
|
||
$host,
|
||
($recap{$host}{'ipv6'} ? $recap{$host}{'ipv6'} : '<nothing>'),
|
||
$ipv6,
|
||
($recap{$host}{'mtime'} ? prettytime($recap{$host}{'mtime'}) : '<never>'),
|
||
prettyinterval($config{$host}{'min-interval'})
|
||
)
|
||
if opt('verbose') || !($recap{$host}{'warned-min-interval'} // 0);
|
||
|
||
$recap{$host}{'warned-min-interval'} = $now;
|
||
|
||
} elsif (($recap{$host}{'status-ipv6'} // '') ne 'good' &&
|
||
!interval_expired($host, 'atime', 'min-error-interval')) {
|
||
|
||
if (opt('verbose') || (!$recap{$host}{'warned-min-error-interval'} &&
|
||
($warned_ipv6{$host} // 0) < $inv_ip_warn_count)) {
|
||
|
||
warning("skipping update of %s from %s to %s.\nlast updated %s but last attempt on %s failed.\nWait at least %s between update attempts.",
|
||
$host,
|
||
($recap{$host}{'ipv6'} ? $recap{$host}{'ipv6'} : '<nothing>'),
|
||
$ipv6,
|
||
($recap{$host}{'mtime'} ? prettytime($recap{$host}{'mtime'}) : '<never>'),
|
||
($recap{$host}{'atime'} ? prettytime($recap{$host}{'atime'}) : '<never>'),
|
||
prettyinterval($config{$host}{'min-error-interval'})
|
||
);
|
||
if (!$ipv6 && !opt('verbose')) {
|
||
$warned_ipv6{$host} = ($warned_ipv6{$host} // 0) + 1;
|
||
warning("IPv6 address for %s undefined. Warned %s times, suppressing further warnings", $host, $inv_ip_warn_count)
|
||
if ($warned_ipv6{$host} >= $inv_ip_warn_count);
|
||
}
|
||
}
|
||
|
||
$recap{$host}{'warned-min-error-interval'} = $now;
|
||
|
||
} else {
|
||
$update = 1;
|
||
}
|
||
|
||
} elsif (defined($sub) && &$sub($host)) {
|
||
$update = 1;
|
||
} elsif ((defined($recap{$host}{'static'}) && defined($config{$host}{'static'}) &&
|
||
($recap{$host}{'static'} ne $config{$host}{'static'})) ||
|
||
(defined($recap{$host}{'wildcard'}) && defined($config{$host}{'wildcard'}) &&
|
||
($recap{$host}{'wildcard'} ne $config{$host}{'wildcard'})) ||
|
||
(defined($recap{$host}{'mx'}) && defined($config{$host}{'mx'}) &&
|
||
($recap{$host}{'mx'} ne $config{$host}{'mx'})) ||
|
||
(defined($recap{$host}{'backupmx'}) && defined($config{$host}{'backupmx'}) &&
|
||
($recap{$host}{'backupmx'} ne $config{$host}{'backupmx'}))) {
|
||
info("updating %s because host settings have been changed.", $host);
|
||
$update = 1;
|
||
|
||
} else {
|
||
if (opt('verbose')) {
|
||
if ($use ne 'disabled') {
|
||
success("%s: skipped: IP address was already set to %s.", $host, $ip);
|
||
}
|
||
if ($usev4 ne 'disabled') {
|
||
success("%s: skipped: IPv4 address was already set to %s.", $host, $ipv4);
|
||
}
|
||
if ($usev6 ne 'disabled') {
|
||
success("%s: skipped: IPv6 address was already set to %s.", $host, $ipv6);
|
||
}
|
||
}
|
||
}
|
||
|
||
$config{$host}{'status'} = $recap{$host}{'status'};
|
||
$config{$host}{'status-ipv4'} = $recap{$host}{'status-ipv4'};
|
||
$config{$host}{'status-ipv6'} = $recap{$host}{'status-ipv6'};
|
||
$config{$host}{'update'} = $update;
|
||
if ($update) {
|
||
$config{$host}{'status'} = undef;
|
||
$config{$host}{'status-ipv4'} = undef;
|
||
$config{$host}{'status-ipv6'} = undef;
|
||
$config{$host}{'atime'} = $now;
|
||
$config{$host}{'wtime'} = 0;
|
||
$config{$host}{'warned-min-interval'} = 0;
|
||
$config{$host}{'warned-min-error-interval'} = 0;
|
||
|
||
delete $recap{$host}{'warned-min-interval'};
|
||
delete $recap{$host}{'warned-min-error-interval'};
|
||
}
|
||
|
||
return $update;
|
||
}
|
||
|
||
######################################################################
|
||
## header_ok
|
||
######################################################################
|
||
sub header_ok {
|
||
my ($host, $line) = @_;
|
||
if (!$line) {
|
||
failed("updating %s: no response from server", $host);
|
||
return 0;
|
||
}
|
||
$line =~ s/\r?\n.*//s;
|
||
my ($code, $msg) = ($line =~ qr%^\s*HTTP/.*\s+(\d+)\s*(?:\s+([^\s].*))?$%i);
|
||
if (!defined($code)) {
|
||
failed('updating %s: unexpected HTTP response: %s', $host, $line);
|
||
return 0;
|
||
} elsif ($code !~ qr/^2\d\d$/) {
|
||
my %msgs = (
|
||
'401' => 'authentication failed',
|
||
'403' => 'not authorized',
|
||
);
|
||
failed('updating %s: %s %s', $host, $code, $msg // $msgs{$code} // '');
|
||
return 0;
|
||
}
|
||
return 1;
|
||
}
|
||
|
||
######################################################################
|
||
## DDNS providers
|
||
# A DDNS provider consists of an example function, the update
|
||
# function, and an optional force_update function.
|
||
#
|
||
# The example function simply returns a string for the help message,
|
||
# explaining how to configure the provider
|
||
#
|
||
# The update function performs the actual record update.
|
||
# It receives an array of hosts as its argument.
|
||
#
|
||
# The force_update function allows a provider implementation to force
|
||
# an update even if ddclient has itself determined no update is
|
||
# necessary. The function shall return 1 if an update should be
|
||
# performed, else 0.
|
||
######################################################################
|
||
|
||
|
||
######################################################################
|
||
## nic_dyndns1_examples
|
||
######################################################################
|
||
sub nic_dyndns1_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'dyndns1'
|
||
|
||
The 'dyndns1' protocol is a deprecated protocol used by the free dynamic
|
||
DNS service offered by www.dyndns.org. The 'dyndns2' should be used to
|
||
update the www.dyndns.org service. However, other services are also
|
||
using this protocol so support is still provided by ${program}.
|
||
|
||
Configuration variables applicable to the 'dyndns1' protocol are:
|
||
protocol=dyndns1 ##
|
||
server=fqdn.of.service ## defaults to members.dyndns.org
|
||
backupmx=no|yes ## indicates that this host is the primary MX for the domain.
|
||
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=dyndns1, \\
|
||
login=my-dyndns.org-login, \\
|
||
password=my-dyndns.org-password \\
|
||
myhost.dyndns.org
|
||
|
||
## multiple host update with wildcard'ing mx, and backupmx
|
||
protocol=dyndns1, \\
|
||
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
|
||
EoEXAMPLE
|
||
}
|
||
######################################################################
|
||
## nic_dyndns1_update
|
||
######################################################################
|
||
sub nic_dyndns1_update {
|
||
debug("\nnic_dyndns1_update -------------------");
|
||
## update each configured host
|
||
for my $h (@_) {
|
||
my $ip = delete $config{$h}{'wantip'};
|
||
info("setting IP address to %s for %s", $ip, $h);
|
||
verbose("UPDATE:", "updating %s", $h);
|
||
|
||
my $url;
|
||
$url = "https://$config{$h}{'server'}/nic/";
|
||
$url .= ynu($config{$h}{'static'}, 'statdns', 'dyndns', 'dyndns');
|
||
$url .= "?action=edit&started=1&hostname=YES&host_id=$h";
|
||
$url .= "&myip=";
|
||
$url .= $ip if $ip;
|
||
$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(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
login => $config{$h}{'login'},
|
||
password => $config{$h}{'password'},
|
||
) // '';
|
||
if ($reply eq '') {
|
||
failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
|
||
next;
|
||
}
|
||
next if !header_ok($h, $reply);
|
||
|
||
my @reply = split /\n/, $reply;
|
||
my ($title, $return_code, $error_code) = ('', '', '');
|
||
for my $line (@reply) {
|
||
$title = $1 if $line =~ m%<TITLE>\s*(.*)\s*</TITLE>%i;
|
||
$return_code = $1 if $line =~ m%^return\s+code\s*:\s*(.*)\s*$%i;
|
||
$error_code = $1 if $line =~ m%^error\s+code\s*:\s*(.*)\s*$%i;
|
||
}
|
||
|
||
if ($return_code ne 'NOERROR' || $error_code ne 'NOERROR' || !$title) {
|
||
$config{$h}{'status'} = 'failed';
|
||
$title = "incomplete response from $config{$h}{server}" unless $title;
|
||
warning("SENT: %s", $url) unless opt('verbose');
|
||
warning("REPLIED: %s", $reply);
|
||
failed("updating %s: %s", $h, $title);
|
||
|
||
} else {
|
||
$config{$h}{'ip'} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{'status'} = 'good';
|
||
success("updating %s: %s: IP address set to %s (%s)", $h, $return_code, $ip, $title);
|
||
}
|
||
}
|
||
}
|
||
######################################################################
|
||
## nic_dyndns2_force_update
|
||
######################################################################
|
||
sub nic_dyndns2_force_update {
|
||
my $host = shift;
|
||
my $update = 0;
|
||
|
||
if ($config{$host}{'mx'} ne $recap{$host}{'mx'}) {
|
||
info("forcing updating %s because 'mx' has changed to %s.", $host, $config{$host}{'mx'});
|
||
$update = 1;
|
||
|
||
} elsif ($config{$host}{'mx'} && (ynu($config{$host}{'backupmx'}, 1, 2, 3) ne ynu($recap{$host}{'backupmx'}, 1, 2, 3))) {
|
||
info("forcing updating %s because 'backupmx' has changed to %s.", $host, ynu($config{$host}{'backupmx'}, "YES", "NO", "NO"));
|
||
$update = 1;
|
||
|
||
} elsif ($config{$host}{'static'} ne $recap{$host}{'static'}) {
|
||
|
||
info("forcing updating %s because 'static' has changed to %s.", $host, ynu($config{$host}{'static'}, "YES", "NO", "NO"));
|
||
$update = 1;
|
||
|
||
}
|
||
return $update;
|
||
}
|
||
######################################################################
|
||
## nic_dyndns2_examples
|
||
######################################################################
|
||
sub nic_dyndns2_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'dyndns2'
|
||
|
||
The 'dyndns2' protocol is a newer low-bandwidth protocol used by a
|
||
free dynamic DNS service offered by www.dyndns.org. It supports
|
||
features of the older 'dyndns1' in addition to others. [These will be
|
||
supported in a future version of ${program}.]
|
||
|
||
Configuration variables applicable to the 'dyndns2' protocol are:
|
||
protocol=dyndns2 ##
|
||
server=fqdn.of.service ## defaults to members.dyndns.org
|
||
script=/path/to/script ## defaults to /nic/update
|
||
backupmx=no|yes ## indicates that this host is the primary MX for the domain.
|
||
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=dyndns2, \\
|
||
login=my-dyndns.org-login, \\
|
||
password=my-dyndns.org-password \\
|
||
myhost.dyndns.org
|
||
|
||
## multiple host update with wildcard'ing mx, and backupmx
|
||
protocol=dyndns2, \\
|
||
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=dyndns2, \\
|
||
login=my-dyndns.org-login, \\
|
||
password=my-dyndns.org-password \\
|
||
my-toplevel-domain.com,my-other-domain.com
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_dyndns2_update
|
||
######################################################################
|
||
sub nic_dyndns2_update {
|
||
debug("\nnic_dyndns2_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 @group_by_attrs = qw(
|
||
backupmx
|
||
login
|
||
mx
|
||
password
|
||
script
|
||
server
|
||
wantipv4
|
||
wantipv6
|
||
wildcard
|
||
);
|
||
for my $group (group_hosts_by(\@_, @group_by_attrs)) {
|
||
my @hosts = @{$group->{hosts}};
|
||
my %groupcfg = %{$group->{cfg}};
|
||
my $hosts = join(',', @hosts);
|
||
my $ipv4 = $groupcfg{'wantipv4'};
|
||
my $ipv6 = $groupcfg{'wantipv6'};
|
||
delete $config{$_}{'wantipv4'} for @hosts;
|
||
delete $config{$_}{'wantipv6'} for @hosts;
|
||
info("$hosts: setting IPv4 address to $ipv4") if $ipv4;
|
||
info("$hosts: setting IPv6 address to $ipv6") if $ipv6;
|
||
my $url = "$groupcfg{'server'}$groupcfg{'script'}?hostname=$hosts&myip=";
|
||
$url .= $ipv4 if $ipv4;
|
||
if ($ipv6) {
|
||
$url .= "," if $ipv4;
|
||
$url .= $ipv6;
|
||
}
|
||
## some args are not valid for a custom domain.
|
||
$url .= "&wildcard=ON" if ynu($groupcfg{'wildcard'}, 1, 0, 0);
|
||
if ($groupcfg{'mx'}) {
|
||
$url .= "&mx=$groupcfg{'mx'}";
|
||
$url .= "&backmx=" . ynu($groupcfg{'backupmx'}, 'YES', 'NO');
|
||
}
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
login => $groupcfg{'login'},
|
||
password => $groupcfg{'password'},
|
||
) // '';
|
||
if ($reply eq '') {
|
||
failed("$hosts: Could not connect to $groupcfg{'server'}");
|
||
next;
|
||
}
|
||
next if !header_ok($hosts, $reply);
|
||
# Some services can return 200 OK even if there is an error (e.g., bad authentication,
|
||
# updates too frequent) so the body of the response must also be checked.
|
||
(my $body = $reply) =~ s/^.*?\n\n//s;
|
||
my @reply = split(qr/\n/, $body);
|
||
if (!@reply) {
|
||
failed("$hosts: Could not connect to $groupcfg{'server'}");
|
||
next;
|
||
}
|
||
# From <https://help.dyn.com/remote-access-api/return-codes/>:
|
||
#
|
||
# If updating multiple hostnames, hostname-specific return codes are given one per line,
|
||
# in the same order as the hostnames were specified. Return codes indicating a failure
|
||
# with the account or the system are given only once.
|
||
#
|
||
# TODO: There is no mention of what happens if multiple IP addresses are supplied (e.g.,
|
||
# IPv4 and IPv6) for a host. If one address fails to update and the other doesn't, is that
|
||
# one error status line? An error status line and a success status line? Or is an update
|
||
# considered to be all-or-nothing and the status applies to the operation as a whole? If
|
||
# the IPv4 address changes but not the IPv6 address does that result in a status of "good"
|
||
# because the set of addresses for a host changed even if a subset did not?
|
||
#
|
||
# TODO: The logic below applies the last line's status to all hosts. Change it to apply
|
||
# each status to its corresponding host.
|
||
for my $line (@reply) {
|
||
# The IP address normally comes after the status, but we ignore it. We could compare
|
||
# it with the expected address and mark the update as failed if it differs, but (1)
|
||
# some services do not return the IP; and (2) comparison is brittle (e.g.,
|
||
# 192.000.002.001 vs. 192.0.2.1) and false errors could cause high load on the service
|
||
# (an update attempt every min-error-interval instead of every max-interval).
|
||
(my $status = $line) =~ s/ .*$//;
|
||
if ($status eq 'nochg') {
|
||
warning("$hosts: $status: $errors{$status}");
|
||
$status = 'good';
|
||
}
|
||
for my $h (@hosts) {
|
||
$config{$h}{'status-ipv4'} = $status if $ipv4;
|
||
$config{$h}{'status-ipv6'} = $status if $ipv6;
|
||
}
|
||
if ($status ne 'good') {
|
||
if (exists($errors{$status})) {
|
||
failed("$hosts: $status: $errors{$status}");
|
||
} else {
|
||
failed("$hosts: unexpected status: $line");
|
||
}
|
||
next;
|
||
}
|
||
for my $h (@hosts) {
|
||
$config{$h}{'ipv4'} = $ipv4 if $ipv4;
|
||
$config{$h}{'ipv6'} = $ipv6 if $ipv6;
|
||
$config{$h}{'mtime'} = $now;
|
||
}
|
||
success("$hosts: IPv4 address set to $ipv4") if $ipv4;
|
||
success("$hosts: IPv6 address set to $ipv6") if $ipv6;
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_dnsexit2_examples
|
||
######################################################################
|
||
sub nic_dnsexit2_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'dnsexit2'
|
||
|
||
The 'dnsexit2' protocol is the updated protocol for the (free) dynamic hostname services
|
||
of 'DNSExit' (www.dnsexit.com). Their API is accepting JSON payload.
|
||
Note that we only update the record, it must already exist in the DNSExit system
|
||
(A and/or AAAA records where applicable).
|
||
|
||
Configuration variables applicable to the 'dnsexit2' protocol are:
|
||
protocol=dnsexit2 ##
|
||
password=YourAPIKey ## API Key of your account.
|
||
server=api.dnsexit.com ## defaults to api.dnsexit.com.
|
||
path=/dns/ ## defaults to /dns/.
|
||
ttl=5 ## defaults to 5 minutes.
|
||
zone='' ## defaults to empty, which assumes the zone is equal to the fully.qualified.host (is root of your DNSExit domain).
|
||
fully.qualified.host ## the host registered with the service.
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=dnsexit2
|
||
password=YourAPIKey
|
||
yourown.publicvm.com
|
||
|
||
## two hosts (which must be) on the same zone
|
||
protocol=dnsexit2
|
||
password=YourAPIKey
|
||
zone=yourown.publicvm.com
|
||
host1.yourown.publicvm.com,host2.yourown.publicvm.com
|
||
|
||
EoEXAMPLE
|
||
}
|
||
######################################################################
|
||
## nic_dnsexit2_update
|
||
##
|
||
## by @jortkoopmans
|
||
## based on https://dnsexit.com/dns/dns-api/
|
||
##
|
||
######################################################################
|
||
sub nic_dnsexit2_update {
|
||
debug("\nnic_dnsexit2_update -------------------");
|
||
# The DNSExit API does not support updating hosts with different zones at the same time,
|
||
# handling update per host.
|
||
for my $h (@_) {
|
||
$config{$h}{'zone'} //= $h;
|
||
dnsexit2_update_host($h);
|
||
}
|
||
}
|
||
|
||
sub dnsexit2_update_host {
|
||
my ($h) = @_;
|
||
my $name = $h;
|
||
# Remove the zone suffix from $name. If the zone eq $name, $name can be left alone or
|
||
# set to the empty string; both have identical semantics. For consistency, always
|
||
# remove the zone even if it means $name becomes the empty string.
|
||
if ($name =~ s/(?:^|\.)\Q$config{$h}{'zone'}\E$//) {
|
||
# The zone was successfully trimmed from $name.
|
||
} else {
|
||
fatal("Hostname %s does not end with the zone %s", $h, $config{$h}{'zone'});
|
||
}
|
||
# The IPv4 and IPv6 addresses must be updated together in a single API call.
|
||
my %ips;
|
||
my @updates;
|
||
for my $ipv ('4', '6') {
|
||
my $ip = delete($config{$h}{"wantipv$ipv"}) or next;
|
||
$ips{$ipv} = $ip;
|
||
info("Going to update IPv%s address to %s for %s.", $ipv, $ip, $h);
|
||
$config{$h}{"status-ipv$ipv"} = 'failed';
|
||
push(@updates, {
|
||
name => $name,
|
||
type => ($ipv eq '6') ? 'AAAA' : 'A',
|
||
content => $ip,
|
||
ttl => $config{$h}{'ttl'},
|
||
});
|
||
};
|
||
my $url = $config{$h}{'server'} . $config{$h}{'path'};
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
headers => "Content-Type: application/json\nAccept: application/json",
|
||
method => 'POST',
|
||
data => encode_json({
|
||
apikey => $config{$h}{'password'},
|
||
domain => $config{$h}{'zone'},
|
||
update => \@updates,
|
||
}),
|
||
);
|
||
unless ($reply && header_ok($h, $reply)) {
|
||
failed("updating %s: Could not connect to %s", $h, $url);
|
||
return;
|
||
};
|
||
debug("%s", $reply);
|
||
(my $http_status) = ($reply =~ m%^s*HTTP/.*\s+(\d+)%i);
|
||
debug("HTTP response code: %s", $http_status);
|
||
if ($http_status ne '200') {
|
||
failed("Failed to update Host\n%s", $h);
|
||
failed("HTTP response code\n%s", $http_status);
|
||
failed("Full reply\n%s", $reply) unless opt('verbose');
|
||
return;
|
||
}
|
||
my $body = ($reply =~ s/^.*?\r?\n\r?\n//sr);
|
||
my $response = eval { decode_json($body); };
|
||
if (!$response) {
|
||
failed("failed to parse response: $@");
|
||
return;
|
||
}
|
||
if (!defined($response->{'code'}) || !defined($response->{'message'})) {
|
||
failed("Did not receive expected 'code' and 'message' keys in server response:\n%s",
|
||
$body);
|
||
return;
|
||
}
|
||
my %codemeaning = (
|
||
'0' => ['good', 'Success! Actions got executed successfully.'],
|
||
'1' => ['warning', 'Some execution problems. May not indicate actions failures. Some action may got executed fine and some may have problems.'],
|
||
'2' => ['badauth', 'API Key Authentication Error. The API Key is missing or wrong.'],
|
||
'3' => ['error', 'Missing Required Definitions. Your JSON file may missing some required definitions.'],
|
||
'4' => ['error', 'JSON Data Syntax Error. Your JSON file has syntax error.'],
|
||
'5' => ['error', 'JSON Defined Record Type not Supported. Your JSON may try to update some record type not supported by our system.'],
|
||
'6' => ['error', 'System Error. Our system problem. May not be your problem. Contact our support if you got such error.'],
|
||
'7' => ['error', 'Error getting post data. Our server has problem to receive your JSON posting.'],
|
||
);
|
||
if (!exists($codemeaning{$response->{'code'}})) {
|
||
failed("Status code %s is unknown!", $response->{'code'});
|
||
return;
|
||
}
|
||
my ($status, $message) = @{$codemeaning{$response->{'code'}}};
|
||
info("Status: %s -- Message: %s", $status, $message);
|
||
info("Server Message: %s -- Server Details: %s", $response->{'message'},
|
||
defined($response->{'details'}) ? $response->{'details'}[0] : "no details received");
|
||
if ($status ne 'good') {
|
||
if ($status eq 'warning') {
|
||
warning("%s", $message);
|
||
warning("Server response: %s", $response->{'message'});
|
||
} elsif ($status =~ m'^(badauth|error)$') {
|
||
failed("%s", $message);
|
||
failed("Server response: %s", $response->{'message'});
|
||
} else {
|
||
failed("Unexpected status: %s", $status);
|
||
}
|
||
return;
|
||
}
|
||
success("%s", $message);
|
||
$config{$h}{'mtime'} = $now;
|
||
keys(%ips); # Reset internal iterator.
|
||
while (my ($ipv, $ip) = each(%ips)) {
|
||
$config{$h}{"ipv$ipv"} = $ip;
|
||
$config{$h}{"status-ipv$ipv"} = 'good';
|
||
success("Updated %s successfully to IPv%s address %s at time %s", $h, $ipv, $ip, prettytime($config{$h}{'mtime'}));
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_noip_update
|
||
## Note: uses same features as nic_dyndns2_update, less return codes
|
||
######################################################################
|
||
sub nic_noip_update {
|
||
debug("\nnic_noip_update -------------------");
|
||
my %errors = (
|
||
'badauth' => 'Invalid username or password',
|
||
'badagent' => 'Invalid user agent',
|
||
'nohost' => 'The hostname specified does not exist in the database',
|
||
'!donator' => 'The offline setting was set, when the user is not a donator',
|
||
'abuse', => 'The hostname specified is blocked for abuse; open a trouble ticket at https://www.no-ip.com',
|
||
'numhost' => 'System error: Too many or too few hosts found. open a trouble ticket at https://www.no-ip.com',
|
||
'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',
|
||
);
|
||
for my $group (group_hosts_by(\@_, qw(login password server wantipv4 wantipv6))) {
|
||
my @hosts = @{$group->{hosts}};
|
||
my %groupcfg = %{$group->{cfg}};
|
||
my $hosts = join(',', @hosts);
|
||
my $ipv4 = $groupcfg{'wantipv4'};
|
||
my $ipv6 = $groupcfg{'wantipv6'};
|
||
delete $config{$_}{'wantipv4'} for @hosts;
|
||
delete $config{$_}{'wantipv6'} for @hosts;
|
||
|
||
info("setting IPv4 address to %s for %s", $ipv4, $hosts) if $ipv4;
|
||
info("setting IPv6 address to %s for %s", $ipv6, $hosts) if $ipv6;
|
||
verbose("UPDATE:", "updating %s", $hosts);
|
||
|
||
my $url = "https://$groupcfg{'server'}/nic/update?system=noip&hostname=$hosts&myip=";
|
||
$url .= $ipv4 if $ipv4;
|
||
if ($ipv6) {
|
||
$url .= "," if $ipv4;
|
||
$url .= $ipv6;
|
||
}
|
||
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
login => $groupcfg{'login'},
|
||
password => $groupcfg{'password'},
|
||
) // '';
|
||
if ($reply eq '') {
|
||
failed("updating %s: Could not connect to %s.", $hosts, $groupcfg{'server'});
|
||
next;
|
||
}
|
||
next if !header_ok($hosts, $reply);
|
||
|
||
my @reply = split /\n/, $reply;
|
||
my $state = 'header';
|
||
for my $line (@reply) {
|
||
if ($state eq 'header') {
|
||
$state = 'body';
|
||
|
||
} elsif ($state eq 'body') {
|
||
$state = 'results' if $line eq '';
|
||
|
||
} elsif ($state =~ /^results/) {
|
||
$state = 'results2';
|
||
|
||
my ($status, $returnedips) = split / /, lc $line;
|
||
my $h = shift @hosts;
|
||
|
||
for my $ip (split_by_comma($returnedips)) {
|
||
next if (!$ip);
|
||
my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4';
|
||
$config{$h}{"status-ipv$ipv"} = $status;
|
||
}
|
||
|
||
if ($status eq 'good') {
|
||
$config{$h}{'mtime'} = $now;
|
||
for my $ip (split_by_comma($returnedips)) {
|
||
next if (!$ip);
|
||
my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4';
|
||
$config{$h}{"ipv$ipv"} = $ip;
|
||
success("updating %s: %s: IPv%s address set to %s", $h, $status, $ipv, $ip);
|
||
}
|
||
|
||
} elsif (exists $errors{$status}) {
|
||
if ($status eq 'nochg') {
|
||
warning("updating %s: %s: %s", $h, $status, $errors{$status});
|
||
$config{$h}{'mtime'} = $now;
|
||
for my $ip (split_by_comma($returnedips)) {
|
||
next if (!$ip);
|
||
my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4';
|
||
$config{$h}{"ipv$ipv"} = $ip;
|
||
$config{$h}{"status-ipv$ipv"} = '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 %s %s before further updates", $h, $status, $wait, $units);
|
||
|
||
} else {
|
||
failed("updating %s: unexpected status (%s)", $h, $line);
|
||
}
|
||
}
|
||
}
|
||
failed("updating %s: Could not connect to %s.", $hosts, $groupcfg{'server'})
|
||
if $state ne 'results2';
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_noip_examples
|
||
######################################################################
|
||
sub nic_noip_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'noip'
|
||
|
||
The 'No-IP Compatible' protocol is used to make dynamic dns updates
|
||
over an http request. Details of the protocol are outlined at:
|
||
https://www.noip.com/integrate/
|
||
|
||
Configuration variables applicable to the 'noip' protocol are:
|
||
protocol=noip ##
|
||
server=fqdn.of.service ## defaults to dynupdate.no-ip.com
|
||
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=noip, \\
|
||
login=userlogin\@domain.com, \\
|
||
password=noip-password \\
|
||
myhost.no-ip.biz
|
||
|
||
|
||
EoEXAMPLE
|
||
}
|
||
######################################################################
|
||
## nic_dslreports1_examples
|
||
######################################################################
|
||
sub nic_dslreports1_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'dslreports1'
|
||
|
||
The 'dslreports1' protocol is used by a free DSL monitoring service
|
||
offered by www.dslreports.com.
|
||
|
||
Configuration variables applicable to the 'dslreports1' protocol are:
|
||
protocol=dslreports1 ##
|
||
server=fqdn.of.service ## defaults to www.dslreports.com
|
||
login=service-login ## login name and password registered with the service
|
||
password=service-password ##
|
||
unique-number ## the host registered with the service.
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=dslreports1, \\
|
||
login=my-dslreports-login, \\
|
||
password=my-dslreports-password \\
|
||
123456
|
||
|
||
Note: DSL Reports uses a unique number as the host name. This number
|
||
can be found on the Monitor Control web page.
|
||
EoEXAMPLE
|
||
}
|
||
######################################################################
|
||
## nic_dslreports1_update
|
||
######################################################################
|
||
sub nic_dslreports1_update {
|
||
debug("\nnic_dslreports1_update -------------------");
|
||
## update each configured host
|
||
for my $h (@_) {
|
||
my $ip = delete $config{$h}{'wantip'};
|
||
info("setting IP address to %s for %s", $ip, $h);
|
||
verbose("UPDATE:", "updating %s", $h);
|
||
|
||
my $url;
|
||
$url = "https://$config{$h}{'server'}/nic/";
|
||
$url .= ynu($config{$h}{'static'}, 'statdns', 'dyndns', 'dyndns');
|
||
$url .= "?action=edit&started=1&hostname=YES&host_id=$h";
|
||
$url .= "&myip=";
|
||
$url .= $ip if $ip;
|
||
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
login => $config{$h}{'login'},
|
||
password => $config{$h}{'password'},
|
||
) // '';
|
||
if ($reply eq '') {
|
||
failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
|
||
next;
|
||
}
|
||
|
||
my @reply = split /\n/, $reply;
|
||
my $return_code = '';
|
||
for my $line (@reply) {
|
||
$return_code = $1 if $line =~ m%^return\s+code\s*:\s*(.*)\s*$%i;
|
||
}
|
||
|
||
if ($return_code !~ /NOERROR/) {
|
||
$config{$h}{'status'} = 'failed';
|
||
warning("SENT: %s", $url) unless opt('verbose');
|
||
warning("REPLIED: %s", $reply);
|
||
failed("updating %s", $h);
|
||
|
||
} else {
|
||
$config{$h}{'ip'} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{'status'} = 'good';
|
||
success("updating %s: %s: IP address set to %s", $h, $return_code, $ip);
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_domeneshop_examples
|
||
######################################################################
|
||
sub nic_domeneshop_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'domeneshop'
|
||
|
||
API is documented here: https://api.domeneshop.no/docs/
|
||
|
||
To generate credentials, visit https://www.domeneshop.no/admin?view=api after logging in to the control panel at
|
||
https://www.domeneshop.no/admin?view=api
|
||
|
||
Configuration variables applicable to the 'domeneshop' api are:
|
||
protocol=domeneshop ##
|
||
login=token ## api-token
|
||
password=secret ## api-secret
|
||
domain.example.com ## the host registered with the service. ## the host registered with the service.
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=domeneshop
|
||
login=username
|
||
password=your-password
|
||
my.example.com
|
||
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_domeneshop_update
|
||
######################################################################
|
||
sub nic_domeneshop_update {
|
||
debug("\nnic_domeneshop_update -------------------");
|
||
|
||
my $endpointPath = "/v0/dyndns/update";
|
||
|
||
## update each configured host
|
||
## should improve to update in one pass
|
||
for my $h (@_) {
|
||
my $ip = delete $config{$h}{'wantip'};
|
||
info("Setting IP address to %s for %s", $ip, $h);
|
||
verbose("UPDATE:", "Updating %s", $h);
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => "$config{$h}{'server'}$endpointPath?hostname=$h&myip=$ip",
|
||
login => $config{$h}{'login'},
|
||
password => $config{$h}{'password'},
|
||
);
|
||
|
||
# No response, declare as failed
|
||
if (!defined($reply) || !$reply) {
|
||
failed("Updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
|
||
next;
|
||
}
|
||
next if !header_ok($h, $reply);
|
||
|
||
# evaluate response
|
||
my @reply = split /\n/, $reply;
|
||
my $status = shift(@reply);
|
||
my $message = pop(@reply);
|
||
if ($status =~ /204/) {
|
||
$config{$h}{'ip'} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{'status'} = 'good';
|
||
success("updating %s: good: IP address set to %s", $h, $ip);
|
||
} else {
|
||
$config{$h}{'status'} = 'failed';
|
||
failed("updating %s: Server said: '%s' '%s'", $h, $status, $message);
|
||
}
|
||
}
|
||
}
|
||
|
||
|
||
######################################################################
|
||
## nic_zoneedit1_examples
|
||
######################################################################
|
||
sub nic_zoneedit1_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'zoneedit1'
|
||
|
||
The 'zoneedit1' protocol is used by a DNS service offered by
|
||
www.zoneedit.com.
|
||
|
||
Configuration variables applicable to the 'zoneedit1' protocol are:
|
||
protocol=zoneedit1 ##
|
||
server=fqdn.of.service ## defaults to www.zoneedit.com
|
||
zone=zone-where-domains-are ## only needed if 1 or more subdomains are deeper
|
||
## than 1 level in relation to the zone where it
|
||
## is defined. For example, b.foo.com in a zone
|
||
## foo.com doesn't need this, but a.b.foo.com in
|
||
## the same zone needs zone=foo.com
|
||
login=service-login ## login name and password registered with the service
|
||
password=service-password ##
|
||
your.domain.name ## the host registered with the service.
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=zoneedit1, \\
|
||
server=dynamic.zoneedit.com, \\
|
||
zone=zone-where-domains-are, \\
|
||
login=my-zoneedit-login, \\
|
||
password=my-zoneedit-password \\
|
||
my.domain.name
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_zoneedit1_force_update
|
||
######################################################################
|
||
sub nic_zoneedit1_force_update {
|
||
return 0;
|
||
}
|
||
|
||
######################################################################
|
||
## nic_zoneedit1_update
|
||
# <SUCCESS CODE="200" TEXT="Update succeeded." ZONE="trialdomain.com" IP="127.0.0.12">
|
||
# <SUCCESS CODE="201" TEXT="No records need updating." ZONE="bannedware.com">
|
||
# <ERROR CODE="701" TEXT="Zone is not set up in this account." ZONE="bad.com">
|
||
######################################################################
|
||
sub nic_zoneedit1_update {
|
||
debug("\nnic_zoneedit1_update -------------------");
|
||
for my $group (group_hosts_by(\@_, qw(login password server zone wantip))) {
|
||
my @hosts = @{$group->{hosts}};
|
||
my %groupcfg = %{$group->{cfg}};
|
||
my $hosts = join(',', @hosts);
|
||
my $ip = $groupcfg{'wantip'};
|
||
delete $config{$_}{'wantip'} for @hosts;
|
||
|
||
info("setting IP address to %s for %s", $ip, $hosts);
|
||
verbose("UPDATE:", "updating %s", $hosts);
|
||
|
||
my $url = '';
|
||
$url .= "https://$groupcfg{'server'}/auth/dynamic.html";
|
||
$url .= "?host=$hosts";
|
||
$url .= "&dnsto=$ip" if $ip;
|
||
$url .= "&zone=$groupcfg{'zone'}" if defined $groupcfg{'zone'};
|
||
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
login => $groupcfg{'login'},
|
||
password => $groupcfg{'password'},
|
||
) // '';
|
||
if ($reply eq '') {
|
||
failed("updating %s: Could not connect to %s.", $hosts, $groupcfg{'server'});
|
||
next;
|
||
}
|
||
next if !header_ok($hosts, $reply);
|
||
|
||
my @reply = split /\n/, $reply;
|
||
# TODO: This is awkward and fragile -- it assumes that each line in the response body
|
||
# corresponds with each host in @hosts (and in the same order).
|
||
my $h = $hosts[0];
|
||
for my $line (@reply) {
|
||
if ($h && $line =~ /^[^<]*<(SUCCESS|ERROR)\s+([^>]+)>(.*)/) {
|
||
my ($status, $assignments, $rest) = ($1, $2, $3);
|
||
my ($left, %var) = parse_assignments($assignments);
|
||
|
||
if (keys %var) {
|
||
my ($status_code, $status_text, $status_ip) = ('999', '', $ip);
|
||
$status_code = $var{'CODE'} if exists $var{'CODE'};
|
||
$status_text = $var{'TEXT'} if exists $var{'TEXT'};
|
||
$status_ip = $var{'IP'} if exists $var{'IP'};
|
||
|
||
if ($status eq 'SUCCESS' || ($status eq 'ERROR' && $var{'CODE'} eq '707')) {
|
||
$config{$h}{'ip'} = $status_ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{'status'} = 'good';
|
||
|
||
success("updating %s: IP address set to %s (%s: %s)", $h, $ip, $status_code, $status_text);
|
||
|
||
} else {
|
||
$config{$h}{'status'} = 'failed';
|
||
failed("updating %s: %s: %s", $h, $status_code, $status_text);
|
||
}
|
||
shift @hosts;
|
||
$h = $hosts[0];
|
||
$hosts = join(',', @hosts);
|
||
}
|
||
$line = $rest;
|
||
redo if $line;
|
||
}
|
||
}
|
||
# TODO: Shouldn't this log join(',' @hosts) instead of $hosts?
|
||
failed("updating %s: no response from %s", $hosts, $groupcfg{'server'})
|
||
if @hosts;
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_easydns_force_update
|
||
######################################################################
|
||
sub nic_easydns_force_update {
|
||
my $host = shift;
|
||
my $update = 0;
|
||
|
||
if ($config{$host}{'mx'} ne $recap{$host}{'mx'}) {
|
||
info("forcing updating %s because 'mx' has changed to %s.", $host, $config{$host}{'mx'});
|
||
$update = 1;
|
||
|
||
} elsif ($config{$host}{'mx'} && (ynu($config{$host}{'backupmx'}, 1, 2, 3) ne ynu($config{$host}{'backupmx'}, 1, 2, 3))) {
|
||
info("forcing updating %s because 'backupmx' has changed to %s.", $host, ynu($config{$host}{'backupmx'}, "YES", "NO", "NO"));
|
||
$update = 1;
|
||
|
||
} elsif ($config{$host}{'static'} ne $recap{$host}{'static'}) {
|
||
|
||
info("forcing updating %s because 'static' has changed to %s.", $host, ynu($config{$host}{'static'}, "YES", "NO", "NO"));
|
||
$update = 1;
|
||
|
||
}
|
||
return $update;
|
||
}
|
||
|
||
######################################################################
|
||
## nic_easydns_examples
|
||
######################################################################
|
||
sub nic_easydns_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'easydns'
|
||
|
||
The 'easydns' protocol is used by the for fee DNS service offered
|
||
by www.easydns.com.
|
||
|
||
Configuration variables applicable to the 'easydns' protocol are:
|
||
protocol=easydns ##
|
||
server=fqdn.of.service ## defaults to members.easydns.com
|
||
backupmx=no|yes ## indicates that EasyDNS should be the secondary MX
|
||
## for this domain or host.
|
||
mx=any.host.domain ## a host MX'ing for this host or domain.
|
||
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=easydns, \\
|
||
login=my-easydns.com-login, \\
|
||
password=my-easydns.com-password \\
|
||
myhost.easydns.com
|
||
|
||
## multiple host update with wildcard'ing mx, and backupmx
|
||
protocol=easydns, \\
|
||
login=my-easydns.com-login, \\
|
||
password=my-easydns.com-password, \\
|
||
mx=a.host.willing.to.mx.for.me, \\
|
||
backupmx=yes, \\
|
||
wildcard=yes \\
|
||
my-toplevel-domain.com,my-other-domain.com
|
||
|
||
## multiple host update to the custom DNS service
|
||
protocol=easydns, \\
|
||
login=my-easydns.com-login, \\
|
||
password=my-easydns.com-password \\
|
||
my-toplevel-domain.com,my-other-domain.com
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_easydns_update
|
||
######################################################################
|
||
sub nic_easydns_update {
|
||
debug("\nnic_easydns_update -------------------");
|
||
my %errors = (
|
||
'NOACCESS' => 'Authentication failed. This happens if the username/password OR host or domain are wrong.',
|
||
'NO_AUTH' => 'Authentication failed. This happens if the username/password OR host or domain are wrong.',
|
||
'NOSERVICE' => 'Dynamic DNS is not turned on for this domain.',
|
||
'ILLEGAL INPUT' => 'Client sent data that is not allowed in a dynamic DNS update.',
|
||
'TOOSOON' => 'Update frequency is too short.',
|
||
);
|
||
for my $h (@_) {
|
||
for my $ipv ('4', '6') {
|
||
my $ip = delete $config{$h}{"wantipv$ipv"} or next;
|
||
info("$h: setting IPv$ipv address to $ip");
|
||
#'https://api.cp.easydns.com/dyn/generic.php?hostname=test.burry.ca&myip=10.20.30.40&wildcard=ON'
|
||
my $url = "https://$config{$h}{'server'}$config{$h}{'script'}?hostname=$h&myip=$ip";
|
||
$url .= "&wildcard=" . ynu($config{$h}{'wildcard'}, 'ON', 'OFF', 'OFF')
|
||
if defined($config{$h}{'wildcard'});
|
||
$url .= "&mx=$config{$h}{'mx'}&backmx=" . ynu($config{$h}{'backupmx'}, 'YES', 'NO')
|
||
if $config{$h}{'mx'};
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
login => $config{$h}{'login'},
|
||
password => $config{$h}{'password'},
|
||
) // '';
|
||
if ($reply eq '') {
|
||
failed("$h: Could not connect to $config{$h}{'server'}");
|
||
next;
|
||
}
|
||
next if !header_ok($h, $reply);
|
||
(my $body = $reply) =~ s/^.*?\n\n//s or do {
|
||
failed("$h: Could not connect to $config{$h}{'server'}");
|
||
next;
|
||
};
|
||
my $resultcode_re = join('|', map({quotemeta} 'NOERROR', keys(%errors)));
|
||
my ($status) = $body =~ qr/\b($resultcode_re)\b/;
|
||
# 'good' is the only status value that ddclient considers to be successful. All other
|
||
# values are considered to be failures and will result in frequent retries (every
|
||
# min-error-interval, which defaults to 5m).
|
||
$status = 'good' if ($status // '') =~ qr/^NOERROR|OK$/;
|
||
$config{$h}{"status-ipv$ipv"} = $status;
|
||
if ($status ne 'good') {
|
||
if (exists $errors{$status}) {
|
||
failed("$h: $status: $errors{$status}");
|
||
} else {
|
||
failed("$h: unexpected result: $body");
|
||
}
|
||
next;
|
||
}
|
||
$config{$h}{"ipv$ipv"} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
success("$h: IPv$ipv address set to $ip");
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_namecheap_examples
|
||
######################################################################
|
||
sub nic_namecheap_examples {
|
||
return <<"EoEXAMPLE";
|
||
|
||
o 'namecheap'
|
||
|
||
The 'namecheap' protocol is used by DNS service offered by www.namecheap.com.
|
||
|
||
Configuration variables applicable to the 'namecheap' protocol are:
|
||
protocol=namecheap ##
|
||
server=fqdn.of.service ## defaults to dynamicdns.park-your-domain.com
|
||
login=service-login ## the domain of the dynamic DNS record you want to update
|
||
password=service-password ## Generated password for your dynamic DNS record
|
||
hostname ## the subdomain to update, use @ for base domain name, * for catch all
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=namecheap \\
|
||
login=example.com \\
|
||
password=example.com-generated-password \\
|
||
@
|
||
|
||
EoEXAMPLE
|
||
}
|
||
######################################################################
|
||
## nic_namecheap_update
|
||
##
|
||
## written by Dan Boardman
|
||
##
|
||
## based on https://www.namecheap.com/support/knowledgebase/
|
||
## article.aspx/29/11/how-to-use-the-browser-to-dynamically-update-hosts-ip
|
||
## needs this url to update:
|
||
## https://dynamicdns.park-your-domain.com/update?host=host_name&
|
||
## domain=domain.com&password=domain_password[&ip=your_ip]
|
||
##
|
||
######################################################################
|
||
sub nic_namecheap_update {
|
||
debug("\nnic_namecheap1_update -------------------");
|
||
|
||
## update each configured host
|
||
for my $h (@_) {
|
||
my $ip = delete $config{$h}{'wantip'};
|
||
info("setting IP address to %s for %s", $ip, $h);
|
||
verbose("UPDATE:", "updating %s", $h);
|
||
|
||
my $url;
|
||
$url = "https://$config{$h}{'server'}/update";
|
||
my $domain = $config{$h}{'login'};
|
||
my $host = $h;
|
||
$host =~ s/(.*)\.$domain(.*)/$1$2/;
|
||
$url .= "?host=$host";
|
||
$url .= "&domain=$domain";
|
||
$url .= "&password=$config{$h}{'password'}";
|
||
$url .= "&ip=";
|
||
$url .= $ip if $ip;
|
||
|
||
my $reply = geturl(proxy => opt('proxy'), url => $url) // '';
|
||
if ($reply eq '') {
|
||
failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
|
||
next;
|
||
}
|
||
next if !header_ok($h, $reply);
|
||
|
||
my @reply = split /\n/, $reply;
|
||
if (grep /<ErrCount>0/i, @reply) {
|
||
$config{$h}{'ip'} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{'status'} = 'good';
|
||
success("updating %s: good: IP address set to %s", $h, $ip);
|
||
} else {
|
||
$config{$h}{'status'} = 'failed';
|
||
warning("SENT: %s", $url) unless opt('verbose');
|
||
warning("REPLIED: %s", $reply);
|
||
failed("updating %s: Invalid reply.", $h);
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
|
||
######################################################################
|
||
## nic_nfsn_examples
|
||
######################################################################
|
||
sub nic_nfsn_examples {
|
||
return <<"EoEXAMPLE";
|
||
|
||
o 'nfsn'
|
||
|
||
The 'nfsn' protocol is used for the DNS service offered by www.nearlyfreespeech.net. Use this URL to get your API-Key-password:
|
||
https://members.nearlyfreespeech.net/support/assist?tag=apikey
|
||
|
||
Configuration variables applicable to the 'nfsn' protocol are:
|
||
protocol=nfsn
|
||
server=api-server ## defaults to api.nearlyfreespeech.net
|
||
login=member-login ## NearlyFreeSpeech.net login name
|
||
password=api-key ## NearlyFreeSpeech.net API key
|
||
zone=zone ## The DNS zone under which the hostname falls; e.g. example.com
|
||
hostname ## the hostname to update in the specified zone; e.g. example.com or www.example.com
|
||
|
||
Example ${program}.conf file entries:
|
||
## update two hosts (example.com and www.example.com) in example.com zone
|
||
protocol=nfsn, \\
|
||
login=my-nfsn-member-login, \\
|
||
password=my-nfsn-api-key, \\
|
||
zone=example.com \\
|
||
example.com,www.example.com
|
||
|
||
## repeat the above for other zones, e.g. example.net:
|
||
[...]
|
||
zone=example.net \\
|
||
subdomain1.example.net,subdomain2.example.net
|
||
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_nfsn_gen_auth_header
|
||
######################################################################
|
||
sub nic_nfsn_gen_auth_header {
|
||
my $h = shift;
|
||
my $path = shift;
|
||
my $body = shift // '';
|
||
|
||
## API requests must include a custom HTTP header in the
|
||
## following format:
|
||
##
|
||
## X-NFSN-Authentication: login;timestamp;salt;hash
|
||
##
|
||
## In this header, login is the member login name of the user
|
||
## making the API request.
|
||
my $auth_header = 'X-NFSN-Authentication: ';
|
||
$auth_header .= $config{$h}{'login'} . ';';
|
||
|
||
## timestamp is the standard 32-bit unsigned Unix timestamp
|
||
## value.
|
||
my $timestamp = time();
|
||
$auth_header .= $timestamp . ';';
|
||
|
||
## salt is a randomly generated 16 character alphanumeric value
|
||
## (a-z, A-Z, 0-9).
|
||
my @chars = ('A'..'Z', 'a'..'z', '0'..'9');
|
||
my $salt;
|
||
for (my $i = 0; $i < 16; $i++) {
|
||
$salt .= $chars[int(rand(@chars))];
|
||
}
|
||
$auth_header .= $salt . ';';
|
||
|
||
## hash is a SHA1 hash of a string in the following format:
|
||
## login;timestamp;salt;api-key;request-uri;body-hash
|
||
my $hash_string = $config{$h}{'login'} . ';' .
|
||
$timestamp . ';' .
|
||
$salt . ';' .
|
||
$config{$h}{'password'} . ';';
|
||
|
||
## The request-uri value is the path portion of the requested URL
|
||
## (i.e. excluding the protocol and hostname).
|
||
$hash_string .= $path . ';';
|
||
|
||
## The body-hash is the SHA1 hash of the request body (if any).
|
||
## If there is no request body, the SHA1 hash of the empty string
|
||
## must be used.
|
||
my $body_hash = sha1_hex($body);
|
||
$hash_string .= $body_hash;
|
||
|
||
my $hash = sha1_hex($hash_string);
|
||
$auth_header .= $hash;
|
||
$auth_header .= "\n";
|
||
|
||
return $auth_header;
|
||
}
|
||
|
||
######################################################################
|
||
## nic_nfsn_make_request
|
||
######################################################################
|
||
sub nic_nfsn_make_request {
|
||
my $h = shift;
|
||
my $path = shift;
|
||
my $method = shift // 'GET';
|
||
my $body = shift // '';
|
||
|
||
my $base_url = "https://$config{$h}{'server'}";
|
||
my $url = $base_url . $path;
|
||
my $header = nic_nfsn_gen_auth_header($h, $path, $body);
|
||
if ($method eq 'POST' && $body ne '') {
|
||
$header .= "Content-Type: application/x-www-form-urlencoded\n";
|
||
}
|
||
|
||
return geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
headers => $header,
|
||
method => $method,
|
||
data => $body,
|
||
);
|
||
}
|
||
|
||
######################################################################
|
||
## nic_nfsn_handle_error
|
||
######################################################################
|
||
sub nic_nfsn_handle_error {
|
||
my $resp = shift;
|
||
my $h = shift;
|
||
|
||
$resp =~ s/^.*?\n\n//s; # Strip header
|
||
my $json = eval { decode_json($resp) };
|
||
if ($@ || ref($json) ne 'HASH' || not defined $json->{'error'}) {
|
||
failed("Invalid error response: %s", $resp);
|
||
return;
|
||
}
|
||
|
||
failed("%s", $json->{'error'});
|
||
if (defined $json->{'debug'}) {
|
||
failed("%s", $json->{'debug'});
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_nfsn_update
|
||
##
|
||
## Written by John Brooks
|
||
##
|
||
## Based on API docs: https://members.nearlyfreespeech.net/wiki/API/Introduction
|
||
## Uses the API endpoints under https://api.nearlyfreespeech.net/dns/$zone/
|
||
##
|
||
## NB: There is no "updateRR" API function; to update an existing RR, we use
|
||
## removeRR to delete the RR, and then addRR to re-add it with the new data.
|
||
##
|
||
######################################################################
|
||
sub nic_nfsn_update {
|
||
debug("\nnic_nfsn_update -------------------");
|
||
|
||
## update each configured host
|
||
for my $h (@_) {
|
||
my $zone = $config{$h}{'zone'};
|
||
my $name;
|
||
|
||
if ($h eq $zone) {
|
||
$name = '';
|
||
} elsif ($h !~ /$zone$/) {
|
||
$config{$h}{'status'} = 'failed';
|
||
failed("updating %s: %s is outside zone %s", $h, $h, $zone);
|
||
next;
|
||
} else {
|
||
$name = $h;
|
||
$name =~ s/(.*)\.${zone}$/$1/;
|
||
}
|
||
|
||
my $ip = delete $config{$h}{'wantip'};
|
||
info("setting IP address to %s for %s", $ip, $h);
|
||
verbose("UPDATE:", "updating %s", $h);
|
||
|
||
my $list_path = "/dns/$zone/listRRs";
|
||
my $list_body = encode_www_form_urlencoded({name => $name, type => 'A'});
|
||
my $list_resp = nic_nfsn_make_request($h, $list_path, 'POST', $list_body);
|
||
if (!header_ok($h, $list_resp)) {
|
||
$config{$h}{'status'} = 'failed';
|
||
nic_nfsn_handle_error($list_resp, $h);
|
||
next;
|
||
}
|
||
|
||
$list_resp =~ s/^.*?\n\n//s; # Strip header
|
||
my $list = eval { decode_json($list_resp) };
|
||
if ($@) {
|
||
$config{$h}{'status'} = 'failed';
|
||
failed("updating %s: JSON decoding failure", $h);
|
||
next;
|
||
}
|
||
|
||
my $rr_ttl = $config{$h}{'ttl'};
|
||
|
||
if (ref($list) eq 'ARRAY' && defined $list->[0]->{'data'}) {
|
||
my $rr_data = $list->[0]->{'data'};
|
||
my $rm_path = "/dns/$zone/removeRR";
|
||
my $rm_data = {name => $name,
|
||
type => 'A',
|
||
data => $rr_data};
|
||
my $rm_body = encode_www_form_urlencoded($rm_data);
|
||
my $rm_resp = nic_nfsn_make_request($h, $rm_path,
|
||
'POST', $rm_body);
|
||
if (!header_ok($h, $rm_resp)) {
|
||
$config{$h}{'status'} = 'failed';
|
||
nic_nfsn_handle_error($rm_resp);
|
||
next;
|
||
}
|
||
}
|
||
|
||
my $add_path = "/dns/$zone/addRR";
|
||
my $add_data = {name => $name,
|
||
type => 'A',
|
||
data => $ip,
|
||
ttl => $rr_ttl};
|
||
my $add_body = encode_www_form_urlencoded($add_data);
|
||
my $add_resp = nic_nfsn_make_request($h, $add_path, 'POST',
|
||
$add_body);
|
||
if (header_ok($h, $add_resp)) {
|
||
$config{$h}{'ip'} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{'status'} = 'good';
|
||
success("updating %s: good: IP address set to %s", $h, $ip);
|
||
} else {
|
||
$config{$h}{'status'} = 'failed';
|
||
nic_nfsn_handle_error($add_resp, $h);
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
|
||
######################################################################
|
||
## nic_njalla_examples
|
||
######################################################################
|
||
sub nic_njalla_examples {
|
||
return <<"EoEXAMPLE";
|
||
|
||
o 'njalla'
|
||
|
||
The 'njalla' protocol is used by DNS service offered by njal.la.
|
||
|
||
Configuration variables applicable to the 'njalla' protocol are:
|
||
protocol=njalla ##
|
||
password=service-password ## Generated password for your dynamic DNS record
|
||
quietreply=no|yes ## If yes return empty response on success with status 200 but print errors
|
||
domain ## subdomain to update, use @ for base domain name, * for catch all
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=njalla \\
|
||
password=njal.la-key
|
||
quietreply=no
|
||
domain.com
|
||
|
||
EoEXAMPLE
|
||
}
|
||
######################################################################
|
||
## nic_njalla_update
|
||
##
|
||
## written by satrapes
|
||
##
|
||
## based on https://njal.la/docs/ddns/
|
||
## needs this url to update:
|
||
## https://njal.la/update?h=host_name&k=domain_password&a=your_ip
|
||
## response contains "code 200" on succesful completion
|
||
######################################################################
|
||
sub nic_njalla_update {
|
||
debug("\nnic_njalla_update -------------------");
|
||
|
||
for my $h (@_) {
|
||
# Read input params
|
||
my $ipv4 = delete $config{$h}{'wantipv4'};
|
||
my $ipv6 = delete $config{$h}{'wantipv6'};
|
||
my $quietreply = $config{$h}{'quietreply'};
|
||
my $ip_output = '';
|
||
|
||
# Build url
|
||
my $url = "https://$config{$h}{'server'}/update/?h=$h&k=$config{$h}{'password'}";
|
||
my $auto = 1;
|
||
for my $ip ($ipv4, $ipv6) {
|
||
next if (!$ip);
|
||
$auto = 0;
|
||
my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4';
|
||
my $type = ($ip eq ($ipv6 // '')) ? 'aaaa' : 'a';
|
||
$ip_output .= " IP v$ipv: $ip,";
|
||
$url .= "&$type=$ip";
|
||
}
|
||
$url .= (($auto eq 1)) ? '&auto' : '';
|
||
$url .= (($quietreply eq 1)) ? '&quiet' : '';
|
||
|
||
info("setting address to%s for %s", ($ip_output eq '') ? ' auto' : $ip_output, $h);
|
||
verbose("UPDATE:", "updating %s", $h);
|
||
debug("url: %s", $url);
|
||
|
||
# Try to get URL
|
||
my $reply = geturl(proxy => opt('proxy'), url => $url);
|
||
my $response = '';
|
||
my $status = 'bad';
|
||
if ($quietreply) {
|
||
$reply =~ qr/invalid host or key/mp;
|
||
$response = ${^MATCH};
|
||
if (!$response) {
|
||
$status = 'good';
|
||
success("updating %s: good: IP address set to %s", $h, $ip_output);
|
||
}
|
||
elsif ($response =~ /invalid host or key/) {
|
||
failed("Invalid host or key");
|
||
} else {
|
||
failed("Unknown response");
|
||
}
|
||
} else {
|
||
$reply =~ qr/{(?:[^{}]*|(?R))*}/mp;
|
||
$response = eval {decode_json(${^MATCH})};
|
||
# No response, declare as failed
|
||
if (!defined($reply) || !$reply) {
|
||
failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
|
||
} else {
|
||
# Strip header
|
||
if ($response->{status} == 401 && $response->{message} =~ /invalid host or key/) {
|
||
failed("Invalid host or key");
|
||
} elsif ($response->{status} == 200 && $response->{message} =~ /record updated/) {
|
||
$status = 'good';
|
||
success("updating %s: good: IP address set to %s", $h, $response->{value}->{A});
|
||
} else {
|
||
failed("Unknown response");
|
||
}
|
||
}
|
||
}
|
||
if ($status eq 'good') {
|
||
$config{$h}{'ipv4'} = $ipv4 if $ipv4;
|
||
$config{$h}{'ipv6'} = $ipv6 if $ipv6;
|
||
}
|
||
$config{$h}{'status-ipv4'} = $status if $ipv4;
|
||
$config{$h}{'status-ipv6'} = $status if $ipv6;
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_sitelutions_examples
|
||
######################################################################
|
||
sub nic_sitelutions_examples {
|
||
return <<"EoEXAMPLE";
|
||
|
||
o 'sitelutions'
|
||
|
||
The 'sitelutions' protocol is used by DNS services offered by www.sitelutions.com.
|
||
|
||
Configuration variables applicable to the 'sitelutions' protocol are:
|
||
protocol=sitelutions ##
|
||
server=fqdn.of.service ## defaults to sitelutions.com
|
||
login=service-login ## login name and password registered with the service
|
||
password=service-password ##
|
||
A_record_id ## Id of the A record for the host registered with the service.
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=sitelutions, \\
|
||
login=my-sitelutions.com-login, \\
|
||
password=my-sitelutions.com-password \\
|
||
my-sitelutions.com-id_of_A_record
|
||
|
||
EoEXAMPLE
|
||
}
|
||
######################################################################
|
||
## nic_sitelutions_update
|
||
##
|
||
## written by Mike W. Smith
|
||
##
|
||
## based on https://www.sitelutions.com/help/dynamic_dns_clients#updatespec
|
||
## needs this url to update:
|
||
## https://www.sitelutions.com/dnsup?id=990331&user=myemail@mydomain.com&pass=SecretPass&ip=192.168.10.4
|
||
## domain=domain.com&password=domain_password&ip=your_ip
|
||
##
|
||
######################################################################
|
||
sub nic_sitelutions_update {
|
||
debug("\nnic_sitelutions_update -------------------");
|
||
|
||
## update each configured host
|
||
for my $h (@_) {
|
||
my $ip = delete $config{$h}{'wantip'};
|
||
info("setting IP address to %s for %s", $ip, $h);
|
||
verbose("UPDATE:", "updating %s", $h);
|
||
|
||
my $url;
|
||
$url = "https://$config{$h}{'server'}/dnsup";
|
||
$url .= "?id=$h";
|
||
$url .= "&user=$config{$h}{'login'}";
|
||
$url .= "&pass=$config{$h}{'password'}";
|
||
$url .= "&ip=";
|
||
$url .= $ip if $ip;
|
||
|
||
my $reply = geturl(proxy => opt('proxy'), url => $url);
|
||
if (!defined($reply) || !$reply) {
|
||
failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
|
||
next;
|
||
}
|
||
next if !header_ok($h, $reply);
|
||
|
||
my @reply = split /\n/, $reply;
|
||
if (grep /success/i, @reply) {
|
||
$config{$h}{'ip'} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{'status'} = 'good';
|
||
success("updating %s: good: IP address set to %s", $h, $ip);
|
||
} else {
|
||
$config{$h}{'status'} = 'failed';
|
||
warning("SENT: %s", $url) unless opt('verbose');
|
||
warning("REPLIED: %s", $reply);
|
||
failed("updating %s: Invalid reply.", $h);
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
|
||
######################################################################
|
||
## nic_freedns_examples
|
||
######################################################################
|
||
sub nic_freedns_examples {
|
||
return <<"EoEXAMPLE";
|
||
|
||
o 'freedns'
|
||
|
||
The 'freedns' protocol is used by DNS services offered by freedns.afraid.org.
|
||
|
||
Configuration variables applicable to the 'freedns' protocol are:
|
||
protocol=freedns ##
|
||
server=fqdn.of.service ## defaults to freedns.afraid.org
|
||
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=freedns, \\
|
||
login=my-freedns.afraid.org-login, \\
|
||
password=my-freedns.afraid.org-password \\
|
||
myhost.afraid.com
|
||
|
||
EoEXAMPLE
|
||
}
|
||
######################################################################
|
||
## nic_freedns_update
|
||
##
|
||
## API v1 documented at https://freedns.afraid.org/api/
|
||
##
|
||
## An update requires two steps. The first is to get a list of records from:
|
||
## https://freedns.afraid.org/api/?action=getdyndns&v=2&sha=<sha1sum of login|password>
|
||
## The returned list looks like:
|
||
##
|
||
## hostname1.example.com|1.2.3.4|http://example/update/url1
|
||
## hostname1.example.com|dead::beef|http://example/update/url2
|
||
## hostname2.example.com|5.6.7.8|http://example/update/url3
|
||
## hostname2.example.com|9.10.11.12|http://example/update/url4
|
||
## hostname3.example.com|cafe::f00d|http://example/update/url5
|
||
## hostname4.example.com|NULL|http://example/update/url6
|
||
##
|
||
## The record's columns are separated by '|'. The first is the hostname, the second is the current
|
||
## address, and the third is the record-specific update URL. There can be multiple records for the
|
||
## same host, and they can even have the same address type. To update an IP address the record
|
||
## must already exist of the type we want to update... We will not change a record type from
|
||
## an IPv4 to IPv6 or viz versa. Records may exist with a NULL address which we will allow to be
|
||
## updated with an IPv4 address, not an IPv6.
|
||
##
|
||
## The second step is to visit the appropriate record's update URL with
|
||
## ?address=<ipv4-or-ipv6-address> appended. "Updated" in the result means success, "fail" means
|
||
## failure.
|
||
######################################################################
|
||
sub nic_freedns_update {
|
||
debug("\nnic_freedns_update -------------------");
|
||
# Separate the records that are currently holding IPv4 addresses from the records that are
|
||
# currently holding IPv6 addresses so that we can avoid switching a record to a different
|
||
# address type.
|
||
my %recs_ipv4;
|
||
my %recs_ipv6;
|
||
my $url_tmpl = "https://$config{$_[0]}{'server'}/api/?action=getdyndns&v=2&sha=<credentials>";
|
||
my $creds = sha1_hex("$config{$_[0]}{'login'}|$config{$_[0]}{'password'}");
|
||
(my $url = $url_tmpl) =~ s/<credentials>/$creds/;
|
||
|
||
my $reply = geturl(proxy => opt('proxy'),
|
||
url => $url
|
||
);
|
||
my $record_list_error = '';
|
||
if ($reply && header_ok($_[0], $reply)) {
|
||
$reply =~ s/^.*?\n\n//s; # Strip the headers.
|
||
for (split("\n", $reply)) {
|
||
my @rec = split(/\|/);
|
||
next if ($#rec < 2);
|
||
my $recs = is_ipv6($rec[1]) ? \%recs_ipv6 : \%recs_ipv4;
|
||
$recs->{$rec[0]} = \@rec;
|
||
# Update URL contains credentials that don't require login to use, so best to hide.
|
||
debug("host: %s, current address: %s, update URL: <redacted>", $rec[0], $rec[1]);
|
||
}
|
||
if (keys(%recs_ipv4) + keys(%recs_ipv6) == 0) {
|
||
chomp($reply);
|
||
$record_list_error = "failed to get record list from $url_tmpl: $reply";
|
||
}
|
||
} else {
|
||
$record_list_error = "failed to get record list from $url_tmpl";
|
||
}
|
||
|
||
for my $h (@_) {
|
||
next if (!$h);
|
||
my $ipv4 = delete $config{$h}{'wantipv4'};
|
||
my $ipv6 = delete $config{$h}{'wantipv6'};
|
||
|
||
if ($record_list_error ne '') {
|
||
$config{$h}{'status-ipv4'} = 'failed' if ($ipv4);
|
||
$config{$h}{'status-ipv6'} = 'failed' if ($ipv6);
|
||
failed("updating %s: %s", $h, $record_list_error);
|
||
next;
|
||
}
|
||
|
||
# IPv4 and IPv6 handling are similar enough to do in a loop...
|
||
for my $ip ($ipv4, $ipv6) {
|
||
next if (!$ip);
|
||
my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4';
|
||
my $type = ($ip eq ($ipv6 // '')) ? 'AAAA' : 'A';
|
||
my $rec = ($ip eq ($ipv6 // '')) ? $recs_ipv6{$h}
|
||
: $recs_ipv4{$h};
|
||
if (!$rec) {
|
||
failed("updating %s: Cannot set IPv$ipv to %s No '$type' record at FreeDNS", $h, $ip);
|
||
next;
|
||
}
|
||
|
||
info("updating %s: setting IP address to %s", $h, $ip);
|
||
$config{$h}{"status-ipv$ipv"} = 'failed';
|
||
|
||
if ($ip eq $rec->[1]) {
|
||
$config{$h}{"ipv$ipv"} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{"status-ipv$ipv"} = 'good';
|
||
success("updating %s: update not necessary, '$type' record already set to %s", $h, $ip)
|
||
if (!$daemon || opt('verbose'));
|
||
} else {
|
||
my $url = $rec->[2] . "&address=" . $ip;
|
||
($url_tmpl = $url) =~ s/\?.*\&/?<redacted>&/; # redact unique update token
|
||
debug("updating: %s", $url_tmpl);
|
||
|
||
my $reply = geturl(proxy => opt('proxy'),
|
||
url => $url
|
||
);
|
||
if ($reply && header_ok($h, $reply)) {
|
||
$reply =~ s/^.*?\n\n//s; # Strip the headers.
|
||
if ($reply =~ /Updated.*$h.*to.*$ip/) {
|
||
$config{$h}{"ipv$ipv"} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{"status-ipv$ipv"} = 'good';
|
||
success("updating %s: good: IPv$ipv address set to %s", $h, $ip);
|
||
} else {
|
||
warning("SENT: %s", $url_tmpl) unless opt('verbose');
|
||
warning("REPLIED: %s", $reply);
|
||
failed("updating %s: Invalid reply.", $h);
|
||
}
|
||
} else {
|
||
failed("updating %s: Could not connect to %s.", $h, $url_tmpl);
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_1984_examples
|
||
######################################################################
|
||
sub nic_1984_examples {
|
||
return <<"EoEXAMPLE";
|
||
|
||
o '1984'
|
||
|
||
The '1984' protocol is used by DNS services offered by 1984.is.
|
||
|
||
Configuration variables applicable to the '1984' protocol are:
|
||
protocol=1984 ##
|
||
password=api-key ## your API key
|
||
fully.qualified.host ## the domain to update
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=1984, \\
|
||
password=my-1984-api-key, \\
|
||
myhost
|
||
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_1984_update
|
||
## https://api.1984.is/1.0/freedns/?apikey=xxx&domain=mydomain&ip=myip
|
||
## The response is a JSON document containing the following entries
|
||
## - ok: true or false depending on if the request was successful or not,
|
||
## if the ip is the same as before this will be true,
|
||
## - msg: successes or why it is not working,
|
||
## - lookup: if domain or subdomain was not found lookup will contain a list of names tried
|
||
######################################################################
|
||
sub nic_1984_update {
|
||
debug("\nnic_1984_update -------------------");
|
||
for my $host (@_) {
|
||
my $ip = delete $config{$host}{'wantip'};
|
||
info("setting IP address to %s for %s", $ip, $host);
|
||
verbose("UPDATE:", "updating %s", $host);
|
||
|
||
my $url;
|
||
$url = "https://$config{$host}{'server'}/1.0/freedns/";
|
||
$url .= "?apikey=$config{$host}{'password'}";
|
||
$url .= "&domain=$host";
|
||
$url .= "&ip=$ip";
|
||
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
) // '';
|
||
if ($reply eq '') {
|
||
failed("Updating %s: Could not connect to %s.", $host, $config{$host}{'server'});
|
||
next;
|
||
}
|
||
next if !header_ok($host, $reply);
|
||
|
||
# Strip header
|
||
$reply =~ qr/{(?:[^{}]*|(?R))*}/mp;
|
||
my $response = eval { decode_json(${^MATCH}) };
|
||
if ($@) {
|
||
failed("Updating %s: JSON decoding failure", $host);
|
||
next;
|
||
}
|
||
unless ($response->{ok}) {
|
||
failed("%s", $response->{msg});
|
||
next;
|
||
}
|
||
|
||
$config{$host}{'status'} = 'good';
|
||
$config{$host}{'ip'} = $ip;
|
||
if ($response->{msg} =~ /unaltered/) {
|
||
success("Updating %s: skipped: IP was already set to %s", $host, $response->{ip});
|
||
} else {
|
||
success("%s -- Updated successfully to %s", $host, $response->{ip});
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_changeip_examples
|
||
######################################################################
|
||
sub nic_changeip_examples {
|
||
return <<"EoEXAMPLE";
|
||
|
||
o 'changeip'
|
||
|
||
The 'changeip' protocol is used by DNS services offered by changeip.com.
|
||
|
||
Configuration variables applicable to the 'changeip' protocol are:
|
||
protocol=changeip ##
|
||
server=fqdn.of.service ## defaults to nic.changeip.com
|
||
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=changeip, \\
|
||
login=my-my-changeip.com-login, \\
|
||
password=my-changeip.com-password \\
|
||
myhost.changeip.org
|
||
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_changeip_update
|
||
##
|
||
## adapted by Michele Giorato
|
||
##
|
||
## https://nic.ChangeIP.com/nic/update?hostname=host.example.org&myip=66.185.162.19
|
||
##
|
||
######################################################################
|
||
sub nic_changeip_update {
|
||
debug("\nnic_changeip_update -------------------");
|
||
|
||
## update each configured host
|
||
for my $h (@_) {
|
||
my $ip = delete $config{$h}{'wantip'};
|
||
info("setting IP address to %s for %s", $ip, $h);
|
||
verbose("UPDATE:", "updating %s", $h);
|
||
|
||
my $url;
|
||
$url = "https://$config{$h}{'server'}/nic/update";
|
||
$url .= "?hostname=$h";
|
||
$url .= "&ip=";
|
||
$url .= $ip if $ip;
|
||
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
login => $config{$h}{'login'},
|
||
password => $config{$h}{'password'},
|
||
);
|
||
if (!defined($reply) || !$reply) {
|
||
failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
|
||
next;
|
||
}
|
||
next if !header_ok($h, $reply);
|
||
|
||
my @reply = split /\n/, $reply;
|
||
if (grep /success/i, @reply) {
|
||
$config{$h}{'ip'} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{'status'} = 'good';
|
||
success("updating %s: good: IP address set to %s", $h, $ip);
|
||
} else {
|
||
$config{$h}{'status'} = 'failed';
|
||
warning("SENT: %s", $url) unless opt('verbose');
|
||
warning("REPLIED: %s", $reply);
|
||
failed("updating %s: Invalid reply.", $h);
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_godaddy_examples
|
||
##
|
||
## written by awalon
|
||
##
|
||
######################################################################
|
||
sub nic_godaddy_examples {
|
||
return <<"EoEXAMPLE";
|
||
|
||
o 'godaddy'
|
||
|
||
The 'godaddy' protocol is used by DNS service offered by https://www.godaddy.com/domains.
|
||
|
||
Configuration variables applicable to the 'godaddy' protocol are:
|
||
protocol=godaddy ##
|
||
login=my-generated-token ## the token/key name provided by the API interface
|
||
password=my-generated-secret ## the secret provided by the API interface
|
||
zone=domain.tld ## the domain used for DNS update.
|
||
ttl=600 ## time to live of the record;
|
||
hostname.domain.tld ## hostname/subdomain
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=godaddy \\
|
||
login=my-generated-token \\
|
||
password=my-generated-secret \\
|
||
zone=example.com \\
|
||
hostname.example.com
|
||
|
||
## multiple host update to the DNS service
|
||
protocol=godaddy \\
|
||
login=my-generated-token \\
|
||
password=my-generated-secret \\
|
||
zone=example.com \\
|
||
host1.example.com,host2.example.com
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_godaddy_update
|
||
######################################################################
|
||
sub nic_godaddy_update {
|
||
debug("\nnic_godaddy_update --------------------");
|
||
for my $h (@_) {
|
||
my $zone = $config{$h}{'zone'};
|
||
(my $hostname = $h) =~ s/\.\Q$zone\E$//;
|
||
for my $ipv ('4', '6') {
|
||
my $ip = delete($config{$h}{"wantipv$ipv"}) or next;
|
||
info("$h: Setting IPv$ipv address to $ip");
|
||
my $rrset_type = ($ipv eq '6') ? 'AAAA' : 'A';
|
||
my $url = "https://$config{$h}{'server'}/$zone/records/$rrset_type/$hostname";
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
headers => [
|
||
'Content-Type: application/json',
|
||
'Accept: application/json',
|
||
"Authorization: sso-key $config{$h}{'login'}:$config{$h}{'password'}",
|
||
],
|
||
method => 'PUT',
|
||
data => encode_json([{
|
||
data => $ip,
|
||
defined($config{$h}{'ttl'}) ? (ttl => $config{$h}{'ttl'}) : (),
|
||
name => $hostname,
|
||
type => $rrset_type,
|
||
}]),
|
||
);
|
||
unless ($reply) {
|
||
failed("$h: Could not connect to $config{$h}{'server'}");
|
||
next;
|
||
}
|
||
(my $code) = ($reply =~ m%^s*HTTP/.*\s+(\d+)%i);
|
||
my $ok = header_ok($h, $reply);
|
||
$reply =~ s/^.*?\n\n//s;
|
||
my $response = eval {decode_json($reply)};
|
||
if (!defined($response)) {
|
||
failed("$h: Unexpected or empty service response, cannot parse data");
|
||
next;
|
||
} elsif (defined($response->{code})) {
|
||
info("$h: $response->{code} - $response->{message}");
|
||
}
|
||
if (!$ok) {
|
||
my $msg;
|
||
if ($code eq "400") {
|
||
$msg = 'GoDaddy API URL ($url) was malformed.';
|
||
} elsif ($code eq "401") {
|
||
if ($config{$h}{'login'} && $config{$h}{'login'}) {
|
||
$msg = 'login or password option incorrect.';
|
||
} else {
|
||
$msg = 'login or password option missing.';
|
||
}
|
||
$msg .= ' Correct values can be obtained from from https://developer.godaddy.com/keys/.';
|
||
} elsif ($code eq "403") {
|
||
$msg = 'Customer identified by login and password options denied permission.';
|
||
} elsif ($code eq "404") {
|
||
$msg = "\"$h\" not found at GoDaddy, please check zone option and login/password.";
|
||
} elsif ($code eq "422") {
|
||
$msg = "\"$h\" has invalid domain or lacks A/AAAA record.";
|
||
} elsif ($code eq "429") {
|
||
$msg = 'Too many requests to GoDaddy within brief period.';
|
||
} elsif ($code eq "503") {
|
||
$msg = "\"$h\" is unavailable.";
|
||
} else {
|
||
$msg = 'Unexpected service response.';
|
||
}
|
||
failed("$h: $msg");
|
||
next;
|
||
}
|
||
$config{$h}{"ipv$ipv"} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{"status-ipv$ipv"} = 'good';
|
||
success("$h: Updated successfully to $ip (status: $code)");
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_googledomains_examples
|
||
##
|
||
## written by Nelson Araujo
|
||
##
|
||
######################################################################
|
||
sub nic_googledomains_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'googledomains'
|
||
|
||
The 'googledomains' protocol is used by DNS service offered by www.google.com/domains.
|
||
|
||
Configuration variables applicable to the 'googledomains' protocol are:
|
||
protocol=googledomains ##
|
||
login=service-login ## the user name provided by the admin interface
|
||
password=service-password ## the password provided by the admin interface
|
||
fully.qualified.host ## the host registered with the service.
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=googledomains, \\
|
||
login=my-generated-user-name, \\
|
||
password=my-genereated-password \\
|
||
myhost.com
|
||
|
||
## multiple host update to the custom DNS service
|
||
protocol=googledomains, \\
|
||
login=my-generated-user-name, \\
|
||
password=my-genereated-password \\
|
||
my-toplevel-domain.com,my-other-domain.com
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_googledomains_update
|
||
######################################################################
|
||
sub nic_googledomains_update {
|
||
debug("\nnic_googledomains_update -------------------");
|
||
for my $host (@_) {
|
||
my $ip = delete $config{$host}{'wantip'};
|
||
info("setting IP address to %s for %s", $ip, $host);
|
||
verbose("UPDATE:", "updating %s", $host);
|
||
|
||
my $url = "https://$config{$host}{'server'}/nic/update";
|
||
$url .= "?hostname=$host";
|
||
$url .= "&myip=";
|
||
$url .= $ip if $ip;
|
||
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
login => $config{$host}{'login'},
|
||
password => $config{$host}{'password'},
|
||
);
|
||
unless ($reply) {
|
||
failed("updating %s: Could not connect to %s.", $host, $config{$host}{'server'});
|
||
next;
|
||
}
|
||
next if !header_ok($host, $reply);
|
||
|
||
$config{$host}{'ip'} = $ip;
|
||
$config{$host}{'mtime'} = $now;
|
||
$config{$host}{'status'} = 'good';
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_henet_examples
|
||
##
|
||
## written by Indrajit Raychaudhuri
|
||
##
|
||
######################################################################
|
||
sub nic_henet_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'he.net'
|
||
|
||
The 'he.net' protocol is used by DNS service offered by dns.he.net.
|
||
|
||
Configuration variables applicable to the 'he.net' protocol are:
|
||
protocol=he.net ##
|
||
password=service-password ## the password provided by the admin interface
|
||
fully.qualified.host ## the host registered with the service.
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=he.net, \\
|
||
password=my-genereated-password \\
|
||
myhost.example.com
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_henet_update
|
||
######################################################################
|
||
sub nic_henet_update {
|
||
debug("\nnic_henet_update -------------------");
|
||
|
||
my %errors = (
|
||
'badauth' => 'Bad authorization (username or password)',
|
||
'badsys' => 'The system parameter given was not valid',
|
||
'nohost' => 'The hostname specified does not exist in the database',
|
||
'abuse' => 'The hostname specified is blocked for abuse',
|
||
'nochg' => 'No update required; unnecessary attempts to change to the current address are considered abusive',
|
||
);
|
||
|
||
for my $h (@_) {
|
||
# The IPv4 and IPv6 addresses must be updated in separate API call.
|
||
for my $ipv ('4', '6') {
|
||
my $ip = delete($config{$h}{"wantipv$ipv"}) or next;
|
||
info("Setting IPv%s address to %s for %s", $ipv, $ip, $h);
|
||
verbose("UPDATE:", "updating %s", $h);
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => "https://$config{$h}{'server'}/nic/update?hostname=$h&myip=$ip",
|
||
login => $h,
|
||
password => $config{$h}{'password'},
|
||
) // '';
|
||
if ($reply eq '') {
|
||
failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
|
||
next;
|
||
}
|
||
next if !header_ok($h, $reply);
|
||
# dyn.dns.he.net can return 200 OK even if there is an error (e.g., bad authentication,
|
||
# updates too frequent) so the body of the response must also be checked.
|
||
(my $body = $reply) =~ s/^.*?\n\n//s;
|
||
my ($line) = split(/\n/, $body, 2);
|
||
my ($status, $returnedip) = split(/ /, lc($line));
|
||
$status = 'good' if $status eq 'nochg';
|
||
$config{$h}{"status-ipv$ipv"} = $status;
|
||
if ($status ne 'good') {
|
||
if (exists($errors{$status})) {
|
||
failed("updating %s: %s: %s", $h, $status, $errors{$status});
|
||
} else {
|
||
failed("updating %s: unexpected status: %s", $h, $line);
|
||
}
|
||
next;
|
||
}
|
||
success("updating %s: %s: IPv%s address set to %s", $h, $status, $ipv, $returnedip);
|
||
$config{$h}{"ipv$ipv"} = $returnedip;
|
||
$config{$h}{'mtime'} = $now;
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_mythicdyn_examples
|
||
##
|
||
## written by Reuben Thomas
|
||
##
|
||
######################################################################
|
||
sub nic_mythicdyn_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'mythicdyn'
|
||
|
||
The 'mythicdyn' protocol is used by the Dynamic DNS service offered by
|
||
www.mythic-beasts.com.
|
||
|
||
Configuration variables applicable to the 'mythicdyn' protocol are:
|
||
protocol=mythicdyn ##
|
||
login=service-login ## the user name provided by the admin interface
|
||
password=service-password ## the password provided by the admin interface
|
||
fully.qualified.host ## the host registered with the service
|
||
|
||
Note: this module examines the wantipv4 & wantipv6 parameters
|
||
and will set either or both V4 and/or V6 addresses as required
|
||
|
||
Note: this service automatically sets the IP address to that from which the
|
||
request comes, so the IP address detected by ddclient is only used to keep
|
||
track of when it needs updating.
|
||
|
||
Example ${program}.conf file entries:
|
||
## Single host update.
|
||
protocol=mythicdyn, \\
|
||
login=service-login \\
|
||
password=service-password, \\
|
||
host.example.com
|
||
|
||
## Multiple host update.
|
||
protocol=mythicdyn, \\
|
||
login=service-login \\
|
||
password=service-password, \\
|
||
hosta.example.com,hostb.sub.example.com
|
||
EoEXAMPLE
|
||
}
|
||
######################################################################
|
||
## nic_mythicdyn_update
|
||
######################################################################
|
||
sub nic_mythicdyn_update {
|
||
debug("\nnic_mythicdyn_update --------------------");
|
||
|
||
# Update each configured host.
|
||
for my $h (@_) {
|
||
info("%s -- Setting IP address.", $h);
|
||
|
||
for my $mythver ('4','6') {
|
||
my $ip = $config{$h}{"wantipv$mythver"};
|
||
|
||
if (defined($ip)) {
|
||
info("Process configuration for IPV%s --------", $mythver);
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => "https://ipv$mythver.$config{$h}{'server'}/dns/v2/dynamic/$h",
|
||
method => 'POST',
|
||
login => $config{$h}{'login'},
|
||
password => $config{$h}{'password'},
|
||
ipversion => $mythver,
|
||
);
|
||
unless ($reply) {
|
||
failed("Updating service %s failed: %s", $h, $config{$h}{'server'});
|
||
next;
|
||
}
|
||
|
||
my $ok = header_ok($h, $reply);
|
||
if ($ok) {
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{"status-ipv$mythver"} = "good";
|
||
|
||
success("%s -- IPV%s Updated successfully.", $h, $mythver);
|
||
} else {
|
||
failed("%s -- Failed to update.", $h);
|
||
}
|
||
} else {
|
||
info("No configuration for IPV%s -------------", $mythver);
|
||
}
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_nsupdate_examples
|
||
######################################################################
|
||
sub nic_nsupdate_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'nsupdate'
|
||
|
||
The 'nsupdate' protocol is used to submit Dynamic DNS Update requests as
|
||
defined in RFC2136 to a name server using the 'nsupdate' command line
|
||
utility part of ISC BIND. Dynamic DNS updates allow resource records to
|
||
be added or removed from a zone configured for dynamic updates through
|
||
DNS requests protected using TSIG. BIND ships with 'ddns-confgen', a
|
||
utility to generate sample configurations and instructions for both the
|
||
server and the client. See nsupdate(1) and ddns-confgen(8) for details.
|
||
|
||
Configuration variables applicable to the 'nsupdate' protocol are:
|
||
protocol=nsupdate
|
||
server=ns1.example.com ## name or IP address of the DNS server to send
|
||
## the update requests to; usually master for
|
||
## zone, but slaves should forward the request
|
||
password=tsig.key ## path and name of the symmetric HMAC key file
|
||
## to use for TSIG signing of the request
|
||
## (as generated by 'ddns-confgen -q' and
|
||
## configured on server in 'grant' statement)
|
||
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
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=nsupdate \\
|
||
server=ns1.example.com \\
|
||
password=/etc/${program}/dyn.example.com.key \\
|
||
zone=dyn.example.com \\
|
||
ttl=3600 \\
|
||
myhost.dyn.example.com
|
||
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_nsupdate_update
|
||
## by Daniel Roethlisberger <daniel@roe.ch>
|
||
######################################################################
|
||
sub nic_nsupdate_update {
|
||
debug("\nnic_nsupdate_update -------------------");
|
||
for my $group (group_hosts_by(\@_, qw(login password server tcp zone wantipv4 wantipv6))) {
|
||
my @hosts = @{$group->{hosts}};
|
||
my %groupcfg = %{$group->{cfg}};
|
||
my $hosts = join(',', @hosts);
|
||
my $binary = $groupcfg{'login'};
|
||
my $keyfile = $groupcfg{'password'};
|
||
my $server = $groupcfg{'server'};
|
||
## nsupdate requires a port number to be separated by whitepace, not colon
|
||
$server =~ s/:/ /;
|
||
my $zone = $groupcfg{'zone'};
|
||
my $ipv4 = $groupcfg{'wantipv4'};
|
||
my $ipv6 = $groupcfg{'wantipv6'};
|
||
delete $config{$_}{'wantipv4'} for @hosts;
|
||
delete $config{$_}{'wantipv6'} for @hosts;
|
||
|
||
info("setting IPv4 address to %s for %s", $ipv4, $hosts) if ($ipv4);
|
||
info("setting IPv6 address to %s for %s", $ipv6, $hosts) if ($ipv6);
|
||
verbose("UPDATE:", "updating %s", $hosts);
|
||
|
||
## send separate requests for each zone with all hosts in that zone
|
||
my $instructions = <<"EoINSTR1";
|
||
server $server
|
||
zone $zone.
|
||
EoINSTR1
|
||
for (@hosts) {
|
||
for my $ip ($ipv4, $ipv6) {
|
||
next if (!$ip);
|
||
my $type = ($ip eq ($ipv6 // '')) ? 'AAAA' : 'A';
|
||
$instructions .= <<"EoINSTR2";
|
||
update delete $_. $type
|
||
update add $_. $config{$_}{'ttl'} $type $ip
|
||
EoINSTR2
|
||
}
|
||
}
|
||
$instructions .= <<"EoINSTR4";
|
||
send
|
||
EoINSTR4
|
||
my $command = "$binary -k $keyfile";
|
||
$command .= " -v" if ynu($groupcfg{'tcp'}, 1, 0, 0);
|
||
$command .= " -d" if (opt('debug'));
|
||
verbose("UPDATE:", "nsupdate command is: %s", $command);
|
||
verbose("UPDATE:", "nsupdate instructions are:\n%s", $instructions);
|
||
|
||
my $status = pipecmd($command, $instructions);
|
||
if ($status eq 1) {
|
||
for (@hosts) {
|
||
$config{$_}{'mtime'} = $now;
|
||
for my $ip ($ipv4, $ipv6) {
|
||
next if (!$ip);
|
||
my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4';
|
||
$config{$_}{"ipv$ipv"} = $ip;
|
||
$config{$_}{"status-ipv$ipv"} = 'good';
|
||
success("updating %s: good: IPv%s address set to %s", $_, $ipv, $ip);
|
||
}
|
||
}
|
||
} else {
|
||
for (@hosts) {
|
||
failed("updating %s", $_);
|
||
}
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
|
||
######################################################################
|
||
## nic_cloudflare_examples
|
||
##
|
||
## written by Ian Pye
|
||
##
|
||
######################################################################
|
||
sub nic_cloudflare_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'cloudflare'
|
||
|
||
The 'cloudflare' protocol is used by DNS service offered by www.cloudflare.com.
|
||
|
||
Configuration variables applicable to the 'cloudflare' protocol are:
|
||
protocol=cloudflare ##
|
||
server=fqdn.of.service ## defaults to api.cloudflare.com/client/v4
|
||
login=service-login ## login email when using a global API key
|
||
password=service-password ## Global API key, or an API token. If using an API token, it must have the permissions "Zone - DNS - Edit" and "Zone - Zone - Read". The Zone resources must be "Include - All zones".
|
||
fully.qualified.host ## the host registered with the service.
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update using a global API key
|
||
protocol=cloudflare, \\
|
||
zone=dns.zone, \\
|
||
login=my-cloudflare.com-login, \\
|
||
password=my-cloudflare-global-key \\
|
||
myhost.com
|
||
|
||
## single host update using an API token
|
||
protocol=cloudflare, \\
|
||
zone=dns.zone, \\
|
||
login=token, \\
|
||
password=cloudflare-api-token \\
|
||
myhost.com
|
||
|
||
## multiple host update to the custom DNS service
|
||
protocol=cloudflare, \\
|
||
zone=dns.zone, \\
|
||
login=my-cloudflare.com-login, \\
|
||
password=my-cloudflare-global-api-key \\
|
||
my-toplevel-domain.com,my-other-domain.com
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_cloudflare_update
|
||
######################################################################
|
||
sub nic_cloudflare_update {
|
||
debug("\nnic_cloudflare_update -------------------");
|
||
for my $group (group_hosts_by(\@_, qw(login password))) {
|
||
my @hosts = @{$group->{hosts}};
|
||
my %groupcfg = %{$group->{cfg}};
|
||
my $hosts = join(',', @hosts);
|
||
my $headers = "Content-Type: application/json\n";
|
||
if ($groupcfg{'login'} eq 'token') {
|
||
$headers .= "Authorization: Bearer $groupcfg{'password'}\n";
|
||
} else {
|
||
$headers .= "X-Auth-Email: $groupcfg{'login'}\n";
|
||
$headers .= "X-Auth-Key: $groupcfg{'password'}\n";
|
||
}
|
||
|
||
for my $domain (@hosts) {
|
||
my $ipv4 = delete $config{$domain}{'wantipv4'};
|
||
my $ipv6 = delete $config{$domain}{'wantipv6'};
|
||
|
||
info("getting Cloudflare Zone ID for %s", $domain);
|
||
|
||
# Get zone ID
|
||
my $url = "https://$config{$domain}{'server'}/zones/?";
|
||
$url .= "name=" . $config{$domain}{'zone'};
|
||
|
||
my $reply = geturl(proxy => opt('proxy'),
|
||
url => $url,
|
||
headers => $headers
|
||
);
|
||
unless ($reply && header_ok($domain, $reply)) {
|
||
failed("updating %s: Could not connect to %s.", $domain, $config{$domain}{'server'});
|
||
next;
|
||
}
|
||
|
||
# Strip header
|
||
$reply =~ qr/{(?:[^{}]*|(?R))*}/mp;
|
||
my $response = eval {decode_json(${^MATCH})};
|
||
unless ($response && $response->{result}) {
|
||
failed("updating %s: invalid json or result.", $domain);
|
||
next;
|
||
}
|
||
|
||
# Pull the ID out of the json, messy
|
||
my ($zone_id) = map {$_->{name} eq $config{$domain}{'zone'} ? $_->{id} : ()} @{$response->{result}};
|
||
unless ($zone_id) {
|
||
failed("updating %s: No zone ID found.", $config{$domain}{'zone'});
|
||
next;
|
||
}
|
||
info("Zone ID is %s", $zone_id);
|
||
|
||
|
||
# IPv4 and IPv6 handling are similar enough to do in a loop...
|
||
for my $ip ($ipv4, $ipv6) {
|
||
next if (!$ip);
|
||
my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4';
|
||
my $type = ($ip eq ($ipv6 // '')) ? 'AAAA' : 'A';
|
||
|
||
info("updating %s: setting IPv$ipv address to %s", $domain, $ip);
|
||
$config{$domain}{"status-ipv$ipv"} = 'failed';
|
||
|
||
# Get DNS 'A' or 'AAAA' record ID
|
||
$url = "https://$config{$domain}{'server'}/zones/$zone_id/dns_records?";
|
||
$url .= "type=$type&name=$domain";
|
||
$reply = geturl(proxy => opt('proxy'),
|
||
url => $url,
|
||
headers => $headers
|
||
);
|
||
unless ($reply && header_ok($domain, $reply)) {
|
||
failed("updating %s: Could not connect to %s.", $domain, $config{$domain}{'server'});
|
||
next;
|
||
}
|
||
# Strip header
|
||
$reply =~ qr/{(?:[^{}]*|(?R))*}/mp;
|
||
$response = eval {decode_json(${^MATCH})};
|
||
unless ($response && $response->{result}) {
|
||
failed("updating %s: invalid json or result.", $domain);
|
||
next;
|
||
}
|
||
# Pull the ID out of the json, messy
|
||
my ($dns_rec_id) = map {$_->{name} eq $domain ? $_->{id} : ()} @{$response->{result}};
|
||
unless($dns_rec_id) {
|
||
failed("updating %s: Cannot set IPv$ipv to %s No '$type' record at Cloudflare", $domain, $ip);
|
||
next;
|
||
}
|
||
debug("updating %s: DNS '$type' record ID: $dns_rec_id", $domain);
|
||
# Set domain
|
||
$url = "https://$config{$domain}{'server'}/zones/$zone_id/dns_records/$dns_rec_id";
|
||
my $data = "{\"content\":\"$ip\"}";
|
||
$reply = geturl(proxy => opt('proxy'),
|
||
url => $url,
|
||
headers => $headers,
|
||
method => "PATCH",
|
||
data => $data
|
||
);
|
||
unless ($reply && header_ok($domain, $reply)) {
|
||
failed("updating %s: Could not connect to %s.", $domain, $config{$domain}{'server'});
|
||
next;
|
||
}
|
||
# Strip header
|
||
$reply =~ qr/{(?:[^{}]*|(?R))*}/mp;
|
||
$response = eval {decode_json(${^MATCH})};
|
||
if ($response && $response->{result}) {
|
||
success("updating %s: IPv$ipv address set to %s", $domain, $ip);
|
||
$config{$domain}{"ipv$ipv"} = $ip;
|
||
$config{$domain}{'mtime'} = $now;
|
||
$config{$domain}{"status-ipv$ipv"} = 'good';
|
||
} else {
|
||
failed("updating %s: invalid json or result.", $domain);
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_hetzner_examples
|
||
##
|
||
## written by Joerg Werner
|
||
##
|
||
######################################################################
|
||
sub nic_hetzner_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'hetzner'
|
||
|
||
The 'hetzner' protocol is used by DNS service offered by www.hetzner.com.
|
||
|
||
Configuration variables applicable to the 'hetzner' protocol are:
|
||
protocol=hetzner ##
|
||
server=fqdn.of.service ## can be omitted, defaults to dns.hetzner.com/api/v1
|
||
password=service-password ## API token
|
||
fully.qualified.host ## the host registered with the service.
|
||
|
||
Example ${program}.conf file entries:
|
||
protocol=hetzner, \\
|
||
zone=dns.zone, \\
|
||
password=my-hetzner-api-token \\
|
||
my-toplevel-domain.com,my-other-domain.com
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_hetzner_update
|
||
######################################################################
|
||
sub nic_hetzner_update {
|
||
debug("\nnic_hetzner_update -------------------");
|
||
for my $domain (@_) {
|
||
my $headers = "Auth-API-Token: $config{$domain}{'password'}\n";
|
||
$headers .= "Content-Type: application/json";
|
||
|
||
(my $hostname = $domain) =~ s/\.$config{$domain}{zone}$//;
|
||
my $ipv4 = delete $config{$domain}{'wantipv4'};
|
||
my $ipv6 = delete $config{$domain}{'wantipv6'};
|
||
|
||
info("getting Hetzner Zone ID for %s", $domain);
|
||
|
||
# Get zone ID
|
||
my $url = "https://$config{$domain}{'server'}/zones?name=" . $config{$domain}{'zone'};
|
||
|
||
my $reply = geturl(proxy => opt('proxy'),
|
||
url => $url,
|
||
headers => $headers
|
||
);
|
||
unless ($reply && header_ok($domain, $reply)) {
|
||
failed("updating %s: Could not connect to %s.", $domain, $config{$domain}{'server'});
|
||
next;
|
||
}
|
||
|
||
# Strip header
|
||
$reply =~ qr/{(?:[^{}]*|(?R))*}/mp;
|
||
my $response = eval {decode_json(${^MATCH})};
|
||
unless ($response && $response->{zones}) {
|
||
failed("updating %s: invalid json or result.", $domain);
|
||
next;
|
||
}
|
||
|
||
# Pull the ID out of the json, messy
|
||
my ($zone_id) = map {$_->{name} eq $config{$domain}{'zone'} ? $_->{id} : ()} @{$response->{zones}};
|
||
unless ($zone_id) {
|
||
failed("updating %s: No zone ID found.", $config{$domain}{'zone'});
|
||
next;
|
||
}
|
||
info("Zone ID is %s", $zone_id);
|
||
|
||
# IPv4 and IPv6 handling are similar enough to do in a loop...
|
||
for my $ip ($ipv4, $ipv6) {
|
||
next if (!$ip);
|
||
my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4';
|
||
my $type = ($ip eq ($ipv6 // '')) ? 'AAAA' : 'A';
|
||
|
||
info("updating %s: setting IPv$ipv address to %s", $domain, $ip);
|
||
$config{$domain}{"status-ipv$ipv"} = 'failed';
|
||
|
||
# Get DNS 'A' or 'AAAA' record ID
|
||
$url = "https://$config{$domain}{'server'}/records?zone_id=$zone_id";
|
||
$reply = geturl(proxy => opt('proxy'),
|
||
url => $url,
|
||
headers => $headers
|
||
);
|
||
unless ($reply && header_ok($domain, $reply)) {
|
||
failed("updating %s: Could not connect to %s.", $domain, $config{$domain}{'server'});
|
||
next;
|
||
}
|
||
# Strip header
|
||
$reply =~ qr/{(?:[^{}]*|(?R))*}/mp;
|
||
$response = eval {decode_json(${^MATCH})};
|
||
unless ($response && $response->{records}) {
|
||
failed("updating %s: invalid json or result.", $domain);
|
||
next;
|
||
}
|
||
# Pull the ID out of the json, messy
|
||
my ($dns_rec_id) = map { ($_->{name} eq $hostname && $_->{type} eq $type) ? $_->{id} : ()} @{$response->{records}};
|
||
|
||
# Set domain
|
||
my $http_method="";
|
||
if ($dns_rec_id)
|
||
{
|
||
debug("updating %s: DNS '$type' record ID: $dns_rec_id", $domain);
|
||
$url = "https://$config{$domain}{'server'}/records/$dns_rec_id";
|
||
$http_method = "PUT";
|
||
} else {
|
||
debug("creating %s: DNS '$type'", $domain);
|
||
$url = "https://$config{$domain}{'server'}/records";
|
||
$http_method = "POST";
|
||
}
|
||
my $data = "{\"zone_id\":\"$zone_id\", \"name\": \"$hostname\", \"value\": \"$ip\", \"type\": \"$type\", \"ttl\": $config{$domain}{'ttl'}}";
|
||
|
||
$reply = geturl(proxy => opt('proxy'),
|
||
url => $url,
|
||
headers => $headers,
|
||
method => $http_method,
|
||
data => $data
|
||
);
|
||
unless ($reply && header_ok($domain, $reply)) {
|
||
failed("updating %s: Could not connect to %s.", $domain, $config{$domain}{'server'});
|
||
next;
|
||
}
|
||
# Strip header
|
||
$reply =~ qr/{(?:[^{}]*|(?R))*}/mp;
|
||
$response = eval {decode_json(${^MATCH})};
|
||
if ($response && $response->{record}) {
|
||
success("updating %s: IPv$ipv address set to %s", $domain, $ip);
|
||
$config{$domain}{"ipv$ipv"} = $ip;
|
||
$config{$domain}{'mtime'} = $now;
|
||
$config{$domain}{"status-ipv$ipv"} = 'good';
|
||
} else {
|
||
failed("updating %s: invalid json or result.", $domain);
|
||
}
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_inwx_examples
|
||
######################################################################
|
||
sub nic_inwx_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'inwx'
|
||
|
||
The 'inwx' protocol is designed for DynDNS accounts at INWX
|
||
<https://www.inwx.com/>. It is similar to the 'dyndns2' protocol except IPv6
|
||
addresses are passed in a separate 'myipv6' URL parameter (rather than included
|
||
in the 'myip' parameter):
|
||
|
||
https://dyndns.inwx.com/nic/update?myip=<ipaddr>&myipv6=<ip6addr>
|
||
|
||
The 'inwx' protocol was designed around INWX's behavior as of June 2024:
|
||
- Omitting the IPv4 address (either no 'myip' URL parameter or '<ipaddr>' is
|
||
the empty string) will cause INWX to silently set the IPv4 address (A
|
||
record) to '127.0.0.1'. No error message is returned.
|
||
- Omitting the IPv6 address (either no 'myipv6' URL parameter or '<ip6addr>'
|
||
is the empty string) will cause INWX to delete the IPv6 address (AAAA
|
||
record) if it exists.
|
||
- INWX will automatically create an IPv6 AAAA record for your hostname if
|
||
necessary.
|
||
- 'dyndns.inwx.com' is not reachable via IPv6 (there is no AAAA record).
|
||
- GET 'https://dyndns.inwx.com/nic/update' without further parameters will set
|
||
the IPv4 A record to the public IP of the requesting host and delete the
|
||
IPv6 AAAA record.
|
||
- You can ask INWX support to manually convert a DynDNS account into an
|
||
IPv6-only account. No A record will be created in that case.
|
||
|
||
Configuration variables applicable to the 'inwx' protocol are:
|
||
protocol=inwx ##
|
||
server=fqdn.of.service ## defaults to dyndns.inwx.com
|
||
script=/path/to/script ## defaults to /nic/update
|
||
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=inwx \\
|
||
login=my-inwx-DynDNS-account-username \\
|
||
password=my-inwx-DynDNS-account-password \\
|
||
myhost.example.org
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_inwx_update
|
||
######################################################################
|
||
sub nic_inwx_update {
|
||
debug("\nnic_inwx_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.',
|
||
'numhost' => 'System error: Too many or too few hosts found.',
|
||
'dnserr' => 'System error: DNS error encountered.',
|
||
'nochg' => 'No update required; unnecessary attempts to change to the current address are considered abusive',
|
||
);
|
||
my @group_by_attrs = qw(
|
||
login
|
||
password
|
||
server
|
||
script
|
||
wantipv4
|
||
wantipv6
|
||
);
|
||
for my $group (group_hosts_by(\@_, @group_by_attrs)) {
|
||
my @hosts = @{$group->{hosts}};
|
||
my %groupcfg = %{$group->{cfg}};
|
||
my $hosts = join(',', @hosts);
|
||
my $ipv4 = $groupcfg{'wantipv4'};
|
||
my $ipv6 = $groupcfg{'wantipv6'};
|
||
delete $config{$_}{'wantipv4'} for @hosts;
|
||
delete $config{$_}{'wantipv6'} for @hosts;
|
||
info("$hosts: setting IPv4 address to $ipv4") if $ipv4;
|
||
info("$hosts: setting IPv6 address to $ipv6") if $ipv6;
|
||
my $url = "$groupcfg{'server'}$groupcfg{'script'}?";
|
||
$url .= "myip=$ipv4" if $ipv4;
|
||
if ($ipv6) {
|
||
if (!$ipv4 && opt('usev4', $hosts) ne 'disabled') {
|
||
warning("Skipping IPv6 AAAA record update because INWX requires the IPv4 A record to be updated at the same time but the IPv4 address is unknown.");
|
||
next;
|
||
}
|
||
$url .= "&" if $ipv4;
|
||
$url .= "myipv6=$ipv6";
|
||
}
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
login => $groupcfg{'login'},
|
||
password => $groupcfg{'password'},
|
||
) // '';
|
||
if ($reply eq '') {
|
||
failed("$hosts: Could not connect to $groupcfg{'server'}");
|
||
next;
|
||
}
|
||
next if !header_ok($hosts, $reply);
|
||
# INWX can return 200 OK even if there is an error (e.g., bad authentication,
|
||
# updates too frequent) so the body of the response must also be checked.
|
||
(my $body = $reply) =~ s/^.*?\n\n//s;
|
||
my @reply = split(qr/\n/, $body);
|
||
if (!@reply) {
|
||
failed("$hosts: Could not connect to $groupcfg{'server'}");
|
||
next;
|
||
}
|
||
# From <https://help.dyn.com/remote-access-api/return-codes/>:
|
||
#
|
||
# If updating multiple hostnames, hostname-specific return codes are given one per line,
|
||
# in the same order as the hostnames were specified. Return codes indicating a failure
|
||
# with the account or the system are given only once.
|
||
#
|
||
# TODO: There is no mention of what happens if multiple IP addresses are supplied (e.g.,
|
||
# IPv4 and IPv6) for a host. If one address fails to update and the other doesn't, is that
|
||
# one error status line? An error status line and a success status line? Or is an update
|
||
# considered to be all-or-nothing and the status applies to the operation as a whole? If
|
||
# the IPv4 address changes but not the IPv6 address does that result in a status of "good"
|
||
# because the set of addresses for a host changed even if a subset did not?
|
||
#
|
||
# TODO: The logic below applies the last line's status to all hosts. Change it to apply
|
||
# each status to its corresponding host.
|
||
for my $line (@reply) {
|
||
# The IP address normally comes after the status, but we ignore it. We could compare
|
||
# it with the expected address and mark the update as failed if it differs, but (1)
|
||
# some services do not return the IP; and (2) comparison is brittle (e.g.,
|
||
# 192.000.002.001 vs. 192.0.2.1) and false errors could cause high load on the service
|
||
# (an update attempt every min-error-interval instead of every max-interval).
|
||
(my $status = $line) =~ s/ .*$//;
|
||
if ($status eq 'nochg') {
|
||
warning("$hosts: $status: $errors{$status}");
|
||
$status = 'good';
|
||
}
|
||
for my $h (@hosts) {
|
||
$config{$h}{'status-ipv4'} = $status if $ipv4;
|
||
$config{$h}{'status-ipv6'} = $status if $ipv6;
|
||
}
|
||
if ($status ne 'good') {
|
||
if (exists($errors{$status})) {
|
||
failed("$hosts: $status: $errors{$status}");
|
||
} else {
|
||
failed("$hosts: unexpected status: $line");
|
||
}
|
||
next;
|
||
}
|
||
for my $h (@hosts) {
|
||
$config{$h}{'ipv4'} = $ipv4 if $ipv4;
|
||
$config{$h}{'ipv6'} = $ipv6 if $ipv6;
|
||
$config{$h}{'mtime'} = $now;
|
||
}
|
||
success("$hosts: IPv4 address set to $ipv4") if $ipv4;
|
||
success("$hosts: IPv6 address set to $ipv6") if $ipv6;
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_yandex_examples
|
||
######################################################################
|
||
sub nic_yandex_examples {
|
||
return <<"EoEXAMPLE";
|
||
o Yandex
|
||
|
||
The 'yandex' protocol is used to by DNS service offered by Yandex.
|
||
|
||
Configuration variables applicable to the 'yandex' protocol are:
|
||
protocol=yandex ##
|
||
server=fqdn.of.service ## defaults to pddimp.yandex.ru
|
||
login=dns.zone ## Your zone name
|
||
password=pdd-token ## PDD token for authentication
|
||
fully.qualified.host ## the host registered with the service.
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=yandex, \\
|
||
login=myhost.com, \\
|
||
password=123456789ABCDEF0000000000000000000000000000000000000 \\
|
||
record.myhost.com
|
||
|
||
## multiple host update
|
||
protocol=yandex, \\
|
||
login=myhost.com, \\
|
||
password=123456789ABCDEF0000000000000000000000000000000000000 \\
|
||
record.myhost.com,other.myhost.com
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_yandex_update
|
||
##
|
||
## written by Denis Akimkin
|
||
##
|
||
######################################################################
|
||
sub nic_yandex_update {
|
||
debug("\nnic_yandex_update -------------------");
|
||
for my $host (@_) {
|
||
my $ip = delete $config{$host}{'wantip'};
|
||
my $headers = "PddToken: $config{$host}{'password'}\n";
|
||
|
||
info("setting IP address to %s for %s", $ip, $host);
|
||
verbose("UPDATE:", "updating %s", $host);
|
||
|
||
# Get record ID for host
|
||
my $url = "https://$config{$host}{'server'}/api2/admin/dns/list?";
|
||
$url .= "domain=";
|
||
$url .= $config{$host}{'login'};
|
||
my $reply = geturl(proxy => opt('proxy'), url => $url, headers => $headers);
|
||
unless ($reply) {
|
||
failed("updating %s: Could not connect to %s.", $host, $config{$host}{'server'});
|
||
next;
|
||
}
|
||
next if !header_ok($host, $reply);
|
||
|
||
# Strip header
|
||
$reply =~ s/^.*?\n\n//s;
|
||
my $response = eval { decode_json($reply) };
|
||
if ($response->{success} eq 'error') {
|
||
failed("%s", $response->{error});
|
||
next;
|
||
}
|
||
|
||
# Pull the ID out of the json
|
||
my ($id) = map { $_->{fqdn} eq $host ? $_->{record_id} : () } @{$response->{records}};
|
||
unless ($id) {
|
||
failed("updating %s: DNS record ID not found.", $host);
|
||
next;
|
||
}
|
||
|
||
# Update the DNS record
|
||
$url = "https://$config{$host}{'server'}/api2/admin/dns/edit";
|
||
my $data = "domain=";
|
||
$data .= $config{$host}{'login'};
|
||
$data .= "&record_id=";
|
||
$data .= $id;
|
||
$data .= "&content=";
|
||
$data .= $ip if $ip;
|
||
|
||
$reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
headers => $headers,
|
||
method => 'POST',
|
||
data => $data,
|
||
);
|
||
unless ($reply) {
|
||
failed("updating %s: Could not connect to %s.", $host, $config{$host}{'server'});
|
||
next;
|
||
}
|
||
next if !header_ok($host, $reply);
|
||
|
||
# Strip header
|
||
$reply =~ s/^.*?\n\n//s;
|
||
$response = eval { decode_json($reply) };
|
||
if ($response->{success} eq 'error') {
|
||
failed("%s", $response->{error});
|
||
} else {
|
||
success("%s -- Updated Successfully to %s", $host, $ip);
|
||
}
|
||
|
||
$config{$host}{'ip'} = $ip;
|
||
$config{$host}{'mtime'} = $now;
|
||
$config{$host}{'status'} = 'good';
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_duckdns_examples
|
||
######################################################################
|
||
sub nic_duckdns_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'duckdns'
|
||
|
||
The 'duckdns' protocol is used by the free
|
||
dynamic DNS service offered by www.duckdns.org.
|
||
Check https://www.duckdns.org/install.jsp?tab=linux-cron for API
|
||
|
||
Configuration variables applicable to the 'duckdns' protocol are:
|
||
protocol=duckdns ##
|
||
server=www.fqdn.of.service ## defaults to www.duckdns.org
|
||
password=service-password ## password (token) registered with the service
|
||
non-fully.qualified.host ## the host registered with the service.
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=duckdns, \\
|
||
password=your_password, \\
|
||
myhost
|
||
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_duckdns_update
|
||
## by George Kranis (copypasta from nic_dtdns_update)
|
||
## https://www.duckdns.org/update?domains=mydomain1,mydomain2&token=xxxx-xxx-xx-x&ip=x.x.x.x
|
||
## response contains OK or KO
|
||
######################################################################
|
||
sub nic_duckdns_update {
|
||
debug("\nnic_duckdns_update -------------------");
|
||
|
||
## update each configured host
|
||
## should improve to update in one pass
|
||
for my $h (@_) {
|
||
my $ipv4 = delete $config{$h}{'wantipv4'};
|
||
my $ipv6 = delete $config{$h}{'wantipv6'};
|
||
info("setting IPv4 address to %s for %s", $ipv4, $h) if $ipv4;
|
||
info("setting IPv6 address to %s for %s", $ipv6, $h) if $ipv6;
|
||
verbose("UPDATE:", "updating %s", $h);
|
||
|
||
# Set the URL that we're going to to update
|
||
my $url;
|
||
$url = "https://$config{$h}{'server'}/update";
|
||
$url .= "?domains=";
|
||
$url .= $h;
|
||
$url .= "&token=";
|
||
$url .= $config{$h}{'password'};
|
||
$url .= "&ip=$ipv4" if $ipv4;
|
||
$url .= "&ipv6=$ipv6" if $ipv6;
|
||
|
||
# Try to get URL
|
||
my $reply = geturl(proxy => opt('proxy'), url => $url);
|
||
|
||
# No response, declare as failed
|
||
if (!defined($reply) || !$reply) {
|
||
failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
|
||
next;
|
||
}
|
||
next if !header_ok($h, $reply);
|
||
|
||
my @reply = split /\n/, $reply;
|
||
my $state = 'noresult';
|
||
my $line = '';
|
||
|
||
for $line (@reply) {
|
||
if ($line eq 'OK') {
|
||
$config{$h}{'ipv4'} = $ipv4 if $ipv4;
|
||
$config{$h}{'ipv6'} = $ipv6 if $ipv6;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{'status-ipv4'} = 'good' if $ipv4;
|
||
$config{$h}{'status-ipv6'} = 'good' if $ipv6;
|
||
$state = 'result';
|
||
success("updating %s: good: IPv4 address set to %s", $h, $ipv4) if $ipv4;
|
||
success("updating %s: good: IPv6 address set to %s", $h, $ipv6) if $ipv6;
|
||
|
||
} elsif ($line eq 'KO') {
|
||
$config{$h}{'status-ipv4'} = 'failed' if $ipv4;
|
||
$config{$h}{'status-ipv6'} = 'failed' if $ipv6;
|
||
$state = 'result';
|
||
failed("updating %s: Server said: '%s'", $h, $line);
|
||
}
|
||
}
|
||
|
||
if ($state eq 'noresult') {
|
||
failed("updating %s: Server said: '%s'", $h, $line);
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_freemyip_examples
|
||
######################################################################
|
||
sub nic_freemyip_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'freemyip'
|
||
|
||
The 'freemyip' protocol is used by the free
|
||
dynamic DNS service available at freemyip.com.
|
||
API is documented here: https://freemyip.com/help.py
|
||
|
||
Configuration variables applicable to the 'freemyip' protocol are:
|
||
protocol=freemyip ##
|
||
password=service-token ## token for your domain
|
||
non-fully.qualified.host ## the host registered with the service.
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=freemyip, \\
|
||
password=35a6b8d65c6e67c7f78cca65cd \\
|
||
myhost
|
||
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_freemyip_update
|
||
## by Cadence (reused code from nic_duckdns)
|
||
## https://freemyip.com/update?token=ec54b4b64db27fe8873c7f7&domain=myhost
|
||
## response contains OK or ERROR
|
||
######################################################################
|
||
sub nic_freemyip_update {
|
||
debug("\nnic_freemyip_update -------------------");
|
||
|
||
for my $h (@_) {
|
||
my $ip = delete $config{$h}{'wantip'};
|
||
info("setting IP address to %s for %s", $ip, $h);
|
||
verbose("UPDATE:", "updating %s", $h);
|
||
|
||
# Set the URL that we're going to to update
|
||
my $url;
|
||
$url = "https://$config{$h}{'server'}/update";
|
||
$url .= "?token=";
|
||
$url .= $config{$h}{'password'};
|
||
$url .= "&domain=";
|
||
$url .= $h;
|
||
|
||
# Try to get URL
|
||
my $reply = geturl(proxy => opt('proxy'), url => $url);
|
||
|
||
# No response, declare as failed
|
||
if (!defined($reply) || !$reply) {
|
||
failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
|
||
next;
|
||
}
|
||
next if !header_ok($h, $reply);
|
||
|
||
my @reply = split /\n/, $reply;
|
||
my $returned = pop(@reply);
|
||
if ($returned =~ /OK/) {
|
||
$config{$h}{'ip'} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{'status'} = 'good';
|
||
success("updating %s: good: IP address set to %s", $h, $ip);
|
||
} else {
|
||
$config{$h}{'status'} = 'failed';
|
||
failed("updating %s: Server said: '%s'", $h, $returned);
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_ddnsfm_examples
|
||
######################################################################
|
||
sub nic_ddnsfm_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'ddns.fm'
|
||
|
||
The 'ddns.fm' protocol is used by the free
|
||
dynamic DNS service available at ddns.fm.
|
||
API is documented here: https://ddns.fm/docs
|
||
|
||
Configuration variables applicable to the 'ddns.fm' protocol are:
|
||
protocol=ddns.fm ##
|
||
password=service-key ## key for your domain
|
||
non-fully.qualified.host ## the host registered with the service.
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=ddns.fm, \\
|
||
password=your_ddns_key, \\
|
||
myhost.example.com
|
||
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_ddnsfm_update
|
||
######################################################################
|
||
sub nic_ddnsfm_update {
|
||
debug("\nnic_ddnsfm_update -------------------");
|
||
for my $h (@_) {
|
||
# ddns.fm behavior as of 2024-07-14:
|
||
# - IPv4 and IPv6 addresses cannot be updated simultaneously.
|
||
# - IPv4 updates do not affect the IPv6 AAAA record (if present).
|
||
# - IPv6 updates do not affect the IPv4 A record (if present).
|
||
for my $ipv ('4', '6') {
|
||
my $ip = delete $config{$h}{"wantipv$ipv"} or next;
|
||
info("setting IPv$ipv address to $ip for $h");
|
||
verbose("UPDATE:", "updating %s", $h);
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => "$config{$h}{server}/update?key=$config{$h}{password}&domain=$h&myip=$ip",
|
||
);
|
||
if (!$reply) {
|
||
failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
|
||
next;
|
||
}
|
||
next if !header_ok($h, $reply);
|
||
$config{$h}{"ipv$ipv"} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{"status-ipv$ipv"} = 'good';
|
||
success("updating $h: good: IPv$ipv address set to $ip");
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_dondominio_examples
|
||
######################################################################
|
||
sub nic_dondominio_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'dondominio'
|
||
The 'dondominio' protocol is used by DNS service offered by www.dondominio.com/ .
|
||
API information and user instructions available at: https://dev.dondominio.com/dondns/docs/api/
|
||
Configuration variables applicable to the 'dondominio' protocol are:
|
||
protocol=dondominio ##
|
||
login=service-login ## the username registered with the service
|
||
password=dondominio-apikey ## API key provided by dondominio -see link above-
|
||
fully.qualified.host ## the host registered with the service.
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=dondominio, \\
|
||
login=my-generated-user-name, \\
|
||
password=dondominio-apikey \\
|
||
myhost.tld
|
||
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_dondominio_examples
|
||
######################################################################
|
||
|
||
sub nic_dondominio_update {
|
||
debug("\nnic_dondominio_update -------------------");
|
||
|
||
## update each configured host
|
||
## should improve to update in one pass
|
||
for my $h (@_) {
|
||
my $ip = delete $config{$h}{'wantip'};
|
||
info("setting IP address to %s for %s", $ip, $h);
|
||
verbose("UPDATE:", "updating %s", $h);
|
||
|
||
# Set the URL that we're going to update
|
||
my $url;
|
||
$url = "https://$config{$h}{'server'}/plain/";
|
||
$url .= "?user=";
|
||
$url .= $config{$h}{'login'};
|
||
$url .= "&password=";
|
||
$url .= $config{$h}{'password'};
|
||
$url .= "&host=";
|
||
$url .= $h;
|
||
$url .= "&ip=";
|
||
$url .= $ip if $ip;
|
||
|
||
|
||
# Try to get URL
|
||
my $reply = geturl(proxy => opt('proxy'), url => $url);
|
||
|
||
# No response, declare as failed
|
||
if (!defined($reply) || !$reply) {
|
||
failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
|
||
next;
|
||
}
|
||
next if !header_ok($h, $reply);
|
||
|
||
my @reply = split /\n/, $reply;
|
||
my $returned = pop(@reply);
|
||
if ($returned =~ /OK/ || $returned =~ /IP:$ip/) {
|
||
$config{$h}{'ip'} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{'status'} = 'good';
|
||
success("updating %s: good: IP address set to %s", $h, $ip);
|
||
} else {
|
||
$config{$h}{'status'} = 'failed';
|
||
failed("updating %s: Server said: '%s'", $h, $returned);
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_dnsmadeeasy_examples
|
||
######################################################################
|
||
sub nic_dnsmadeeasy_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'dnsmadeeasy'
|
||
|
||
The 'dnsmadeeasy' protocol is used by the DNS Made Easy service at https://www.dnsmadeeasy.com.
|
||
API is documented here: https://dnsmadeeasy.com/technology/dynamic-dns/
|
||
|
||
Configuration variables applicable to the 'dnsmadeeasy' protocol are:
|
||
protocol=dnsmadeeasy ##
|
||
login=email-address ## Email address used to log in to your account.
|
||
password=dynamic-record-password ## Generated password for your dynamic DNS record.
|
||
record-id-1,record-id-2,... ## Numeric dynamic DNS record IDs, comma-separated if updating multiple.
|
||
|
||
Note: Dynamic record ID is generated when you create a new Dynamic DNS record in the DNS Made Easy control panel.
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=dnsmadeeasy, \\
|
||
username=dme\@example.com, \\
|
||
password=myg3nerat3dp4ssword, \\
|
||
1007,1008
|
||
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_dnsmadeeasy_update
|
||
######################################################################
|
||
sub nic_dnsmadeeasy_update {
|
||
debug("\nnic_dnsmadeeasy_update -------------------");
|
||
|
||
my %messages = (
|
||
'error-auth' => 'Invalid username or password, or invalid IP syntax',
|
||
'error-auth-suspend' => 'User has had their account suspended due to complaints or misuse of the service.',
|
||
'error-auth-voided' => 'User has had their account permanently revoked.',
|
||
'error-record-invalid' =>'Record ID number does not exist in the system.',
|
||
'error-record-auth' => 'User does not have access to this record.',
|
||
'error-record-ip-same' => 'No update required.',
|
||
'error-system' => 'General system error which is caught and recognized by the system.',
|
||
'error' => 'General system error unrecognized by the system.',
|
||
'success' => 'Record successfully updated!',
|
||
);
|
||
|
||
## update each configured host
|
||
## should improve to update in one pass
|
||
for my $h (@_) {
|
||
my $ip = delete $config{$h}{'wantip'};
|
||
info("Setting IP address to %s for %s", $ip, $h);
|
||
verbose("UPDATE:", "Updating %s", $h);
|
||
my $url = $config{$h}{'server'} . $config{$h}{'script'};
|
||
$url .= "?username=$config{$h}{'login'}";
|
||
$url .= "&password=$config{$h}{'password'}";
|
||
$url .= "&ip=$ip";
|
||
$url .= "&id=$h";
|
||
|
||
# Try to get URL
|
||
my $reply = geturl(proxy => opt('proxy'), url => $url);
|
||
|
||
# No response, declare as failed
|
||
if (!defined($reply) || !$reply) {
|
||
failed("Updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
|
||
next;
|
||
}
|
||
next if !header_ok($h, $reply);
|
||
|
||
my @reply = split /\n/, $reply;
|
||
my $returned = pop(@reply);
|
||
if ($returned =~ 'success') {
|
||
$config{$h}{'ip'} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{'status'} = 'good';
|
||
success("Updating %s: good: IP address set to %s", $h, $ip);
|
||
} else {
|
||
$config{$h}{'status'} = 'failed';
|
||
failed("Updating %s: Server said: '%s': %s", $h, $returned, $messages{$returned});
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_ovh_examples
|
||
######################################################################
|
||
sub nic_ovh_examples {
|
||
return <<"EoEXAMPLE";
|
||
|
||
o 'ovh'
|
||
|
||
The 'ovh' protocol is used by DNS services offered by www.ovh.com.
|
||
|
||
API information and user instructions available at: https://docs.ovh.com/gb/en/domains/hosting_dynhost/
|
||
|
||
Configuration variables applicable to the 'ovh' protocol are:
|
||
protocol=ovh ##
|
||
login=dnsdomain-userid ## The username/id registered with the service
|
||
password=userid-password ## The password related to the username/id
|
||
fully.qualified.host ## the hostiname registered with the service.
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=ovh, \\
|
||
login=example.com-dynhostuser, \\
|
||
password=your_password, \\
|
||
test.example.com
|
||
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_ovh_update
|
||
######################################################################
|
||
sub nic_ovh_update {
|
||
debug("\nnic_ovh_update -------------------");
|
||
|
||
## update each configured host
|
||
## should improve to update in one pass
|
||
for my $h (@_) {
|
||
my $ip = delete $config{$h}{'wantip'};
|
||
info("setting IP address to %s for %s", $ip, $h);
|
||
verbose("UPDATE:","updating %s", $h);
|
||
|
||
# Set the URL that we're going to update
|
||
my $url;
|
||
$url .= "https://$config{$h}{'server'}$config{$h}{'script'}?system=dyndns";
|
||
$url .= "&hostname=$h";
|
||
$url .= "&myip=";
|
||
$url .= $ip if $ip;
|
||
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
login => $config{$h}{'login'},
|
||
password => $config{$h}{'password'},
|
||
);
|
||
|
||
if (!defined($reply) || !$reply) {
|
||
failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
|
||
next;
|
||
}
|
||
|
||
my @reply = split /\n/, $reply;
|
||
my $returned = List::Util::first { $_ =~ /good/ || $_ =~ /nochg/ } @reply;
|
||
if ($returned) {
|
||
$config{$h}{'ip'} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{'status'} = 'good';
|
||
if ($returned =~ /good/) {
|
||
success("updating %s: good: IP address set to %s", $h, $ip);
|
||
} else {
|
||
success("updating %s: skipped: IP address was already set to %s.", $h, $ip);
|
||
}
|
||
} else {
|
||
$config{$h}{'status'} = 'failed';
|
||
failed("updating %s: Server said: '%s'", $h, $reply);
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_porkbun_examples
|
||
######################################################################
|
||
sub nic_porkbun_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'porkbun'
|
||
|
||
The 'porkbun' protocol is used for porkbun (https://porkbun.com/).
|
||
The API is documented here: https://porkbun.com/api/json/v3/documentation
|
||
|
||
Before setting up, it is necessary to create your API Key by referring to the following page.
|
||
|
||
https://kb.porkbun.com/article/190-getting-started-with-the-porkbun-api
|
||
|
||
Available configuration variables:
|
||
* apikey (required): API Key of Porkbun API
|
||
* secretapikey (required): Secret API Key of Porkbun API
|
||
* root-domain: The root domain of the specified domain name.
|
||
* on-root-domain=yes or no (default: no): Indicates whether the specified domain name (FQDN) is
|
||
an unnamed record (Zone APEX) in a zone.
|
||
It is useful to specify it as a local variable as shown in the example.
|
||
This configuration value is deprecated, use root-domain instead!
|
||
* usev4, usev6 : These configuration variables can be specified as local variables to override
|
||
the global settings. It is useful to finely control IPv4 or IPv6 as shown in the example.
|
||
* use (deprecated) : This parameter is deprecated but can be overridden like the above parameters.
|
||
|
||
Limitations:
|
||
* Multiple same name records (for round robin) are not supported.
|
||
The same IP address is set for all, creating meaningless extra records.
|
||
* If neither root-domain nor on-root-domain are specified, ${program} will split the given
|
||
hostname into subdomain and domain on the first dot.
|
||
For example:
|
||
* sub.example.com -> Subdomain "sub", root domain "example.com"
|
||
* sub.foo.example.com -> Subdomain "sub", root domain "foo.example.com"
|
||
If both root-domain and on-root-domain are specified, root-domain takes precedence.
|
||
|
||
Example ${program}.conf file entry:
|
||
protocol=porkbun
|
||
apikey=APIKey
|
||
secretapikey=SecretAPIKey
|
||
root-domain=example.com
|
||
example.com,host.example.com,host2.sub.example.com
|
||
|
||
Additional example to finely control IPv4 or IPv6 :
|
||
# Example 01 : Global enable both IPv4 and IPv6, and update both records.
|
||
usev4=webv4
|
||
usev6=ifv6, ifv6=enp1s0
|
||
|
||
protocol=porkbun
|
||
apikey=APIKey
|
||
secretapikey=SecretAPIKey
|
||
root-domain=example.com
|
||
host.example.com,host2.sub.example.com
|
||
|
||
# Example 02 : Global enable only IPv4, and update only IPv6 record.
|
||
usev4=webv4
|
||
|
||
protocol=porkbun
|
||
apikey=APIKey
|
||
secretapikey=SecretAPIKey
|
||
root-domain=example.com
|
||
usev6=ifv6, ifv6=enp1s0, usev4=disabled ipv6.example.com
|
||
|
||
# Example 03: Update just a root domain
|
||
protocol=porkbun
|
||
apikey=APIKey
|
||
secretapikey=SecretAPIKey
|
||
root-domain=host.example.com
|
||
host.example.com
|
||
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_porkbun_update
|
||
######################################################################
|
||
sub nic_porkbun_update {
|
||
debug("\nnic_porkbun_update -------------------");
|
||
|
||
for my $host (@_) {
|
||
my ($sub_domain, $domain);
|
||
if ($config{$host}{'root-domain'}) {
|
||
# Process 'root-domain' option
|
||
$domain = $config{$host}{'root-domain'};
|
||
$sub_domain = $host;
|
||
if ($host eq $domain) {
|
||
$sub_domain = '';
|
||
} else {
|
||
$sub_domain =~ s/\.$domain//;
|
||
}
|
||
# Not valid if not an exact match and the root domain not stripped
|
||
if ($sub_domain eq $host) {
|
||
failed("'root-domain' (%s) is not part of the full host name (%s)!", $domain, $host);
|
||
next;
|
||
}
|
||
warning("%s has both 'root-domain' and 'on-root-domain' defined. The latter is ignored") if $config{$host}{'on-root-domain'};
|
||
} elsif ($config{$host}{'on-root-domain'}) {
|
||
# Process legacy 'on-root-domain' option
|
||
$sub_domain = '';
|
||
$domain = $host;
|
||
} else {
|
||
# Default to the subdomain/domain being split at the first dot
|
||
($sub_domain, $domain) = split(/\./, $host, 2);
|
||
}
|
||
info("subdomain %s, root domain %s", $sub_domain, $domain) if $sub_domain ne '';
|
||
|
||
for my $ipv ('ipv4', 'ipv6') {
|
||
my $ip = delete $config{$host}{"want$ipv"};
|
||
if (!$ip) {
|
||
next;
|
||
}
|
||
my $rrset_type = is_ipv6($ip) ? "AAAA" : "A";
|
||
|
||
info("setting %s address to %s for %s", $ipv, $ip, $host);
|
||
verbose("UPDATE:","updating %s", $host);
|
||
|
||
my $url = "https://porkbun.com/api/json/v3/dns/retrieveByNameType/$domain/$rrset_type/$sub_domain";
|
||
my $data = encode_json({
|
||
secretapikey => $config{$host}{'secretapikey'},
|
||
apikey => $config{$host}{'apikey'},
|
||
});
|
||
my $header = "Content-Type: application/json\n";
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
headers => $header,
|
||
method => 'POST',
|
||
data => $data,
|
||
);
|
||
# No response, declare as failed
|
||
if (!defined($reply) || !$reply) {
|
||
$config{$host}{"status-$ipv"} = "bad";
|
||
failed("updating %s: Could not connect to porkbun.com.", $host);
|
||
next;
|
||
}
|
||
if (!header_ok($host, $reply)) {
|
||
$config{$host}{"status-$ipv"} = "bad";
|
||
failed("updating %s: failed (%s)", $host, $reply);
|
||
next;
|
||
}
|
||
# Strip header
|
||
# Porkbun sends data in chunks, so it is assumed to be one chunk and parsed forcibly.
|
||
$reply =~ qr/{(?:[^{}]*|(?R))*}/mp;
|
||
my $response = eval { decode_json(${^MATCH}) };
|
||
if (!defined($response)) {
|
||
$config{$host}{"status-$ipv"} = "bad";
|
||
failed("%s -- Unexpected service response.", $host);
|
||
next;
|
||
}
|
||
if ($response->{status} ne 'SUCCESS') {
|
||
$config{$host}{"status-$ipv"} = "bad";
|
||
failed("%s -- Unexpected status. (status = %s)", $host, $response->{status});
|
||
next;
|
||
}
|
||
my $records = $response->{records};
|
||
if (ref($records) eq 'ARRAY' && defined $records->[0]->{'id'}) {
|
||
my $count = scalar(@{$records});
|
||
if ($count > 1) {
|
||
warning("updating %s: There are multiple applicable records. Only first record is used. Overwrite all with the same content.");
|
||
}
|
||
my $current_content = $records->[0]->{'content'};
|
||
if ($current_content eq $ip) {
|
||
$config{$host}{"status-$ipv"} = "good";
|
||
success("updating %s: skipped: %s address was already set to %s.", $ipv, $host, $ip);
|
||
next;
|
||
}
|
||
my $ttl = $records->[0]->{'ttl'};
|
||
my $notes = $records->[0]->{'notes'};
|
||
debug("ttl = %s", $ttl);
|
||
debug("notes = %s", $notes);
|
||
$url = "https://porkbun.com/api/json/v3/dns/editByNameType/$domain/$rrset_type/$sub_domain";
|
||
$data = encode_json({
|
||
secretapikey => $config{$host}{'secretapikey'},
|
||
apikey => $config{$host}{'apikey'},
|
||
content => $ip,
|
||
ttl => $ttl,
|
||
notes => $notes,
|
||
});
|
||
$reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
headers => $header,
|
||
method => 'POST',
|
||
data => $data,
|
||
);
|
||
# No response, declare as failed
|
||
if (!defined($reply) || !$reply) {
|
||
failed("updating %s: Could not connect to porkbun.com.", $host);
|
||
next;
|
||
}
|
||
if (!header_ok($host, $reply)) {
|
||
failed("updating %s: failed (%s)", $host, $reply);
|
||
next;
|
||
}
|
||
$config{$host}{"status-$ipv"} = "good";
|
||
success("updating %s: good: %s address set to %s", $ipv, $host, $ip);
|
||
next;
|
||
} else {
|
||
$config{$host}{"status-$ipv"} = "bad";
|
||
failed("updating %s: No applicable existing records.", $host);
|
||
next;
|
||
}
|
||
}
|
||
}
|
||
}
|
||
|
||
sub nic_cloudns_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'cloudns'
|
||
|
||
The 'cloudns' protocol is used for ClouDNS (https://www.cloudns.net). Details
|
||
about dynamic DNS updates can be found at https://www.cloudns.net/dynamic-dns/.
|
||
|
||
Available configuration variables:
|
||
* dynurl: The DynURL associated with the A or AAAA record you wish to update.
|
||
|
||
Limitations:
|
||
* $program cannot tell if the DynURL you provide belongs to the hostname you
|
||
specify.
|
||
* ClouDNS does not document how to tell whether an update suceeded or failed,
|
||
so there is no way for $program to reliably handle failures.
|
||
* The ClouDNS API does not provide a reliable way to set the desired IP
|
||
address. It might save the IP address you want, or it might save the IP
|
||
address that connects to CloudDNS. It is more likely to work if you do not
|
||
use a proxy.
|
||
|
||
Example ${program}.conf file entry:
|
||
protocol=cloudns, \\
|
||
dynurl=https://ipv4.cloudns.net/api/dynamicURL/?q=Njc1OTE2OjY3Njk0ND..., \\
|
||
myhost.example.com
|
||
EoEXAMPLE
|
||
}
|
||
|
||
sub nic_cloudns_update {
|
||
for my $group (group_hosts_by(\@_, qw(dynurl wantip))) {
|
||
my @hosts = @{$group->{hosts}};
|
||
my %groupcfg = %{$group->{cfg}};
|
||
my $hosts = join(',', @hosts);
|
||
my $ip = $groupcfg{'wantip'};
|
||
my $dynurl = $groupcfg{'dynurl'};
|
||
delete $config{$_}{'wantip'} for @hosts;
|
||
# https://www.cloudns.net/wiki/article/36/ says, "If you are behind a proxy and your real
|
||
# IP is set in the header X-Forwarded-For you need to add &proxy=1 at the end of the
|
||
# DynamicURL." We abuse this to pass the desired IP address to ClouDNS, which might not be
|
||
# the same as the client IP address seen by ClouDNS.
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $dynurl . '&proxy=1',
|
||
headers => "X-Forwarded-For: $ip\n",
|
||
);
|
||
if (($reply // '') eq '' || !header_ok($hosts, $reply)) {
|
||
$config{$_}{'status'} = 'failed' for @hosts;
|
||
failed("updating %s: failed to visit DynURL", $hosts);
|
||
next;
|
||
}
|
||
$reply =~ s/^.*?\n\n//s; # Strip the headers.
|
||
chomp($reply);
|
||
if ($reply eq "The record's key is wrong!" || $reply eq "Invalid request.") {
|
||
$config{$_}{'status'} = 'failed' for @hosts;
|
||
failed("updating %s: %s", $hosts, $reply);
|
||
next;
|
||
}
|
||
# There's no documentation explaining possible return values, so we assume success.
|
||
$config{$_}{'ip'} = $ip for @hosts;
|
||
$config{$_}{'mtime'} = $now for @hosts;
|
||
$config{$_}{'status'} = 'good' for @hosts;
|
||
success("updating %s: IP address set to %s", $hosts, $ip);
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_dinahosting_examples
|
||
######################################################################
|
||
sub nic_dinahosting_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'dinahosting'
|
||
|
||
The 'dinahosting' protocol is used by dinahosting (https://dinahosting.com).
|
||
Details about the API can be found at https://dinahosting.com/api.
|
||
|
||
Available configuration variables and their defaults:
|
||
* login (required) is your username.
|
||
* password (required) is your password.
|
||
* server=dinahosting.com is the hostname part of the dinahosting API URL.
|
||
* script=/special/api.php is the path part of the dinahosting API URL.
|
||
|
||
Example ${program}.conf file entry:
|
||
protocol=dinahosting, \\
|
||
login=myusername, \\
|
||
password=mypassword \\
|
||
myhost.mydomain.com
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_dinahosting_update
|
||
######################################################################
|
||
sub nic_dinahosting_update {
|
||
debug("\nnic_dinahosting_update -------------------");
|
||
for my $h (@_) {
|
||
my $ip = delete $config{$h}{'wantip'};
|
||
info("setting IP address to %s for %s", $ip, $h);
|
||
verbose("UPDATE:", "updating %s", $h);
|
||
my ($hostname, $domain) = split(/\./, $h, 2);
|
||
my $url = "https://$config{$h}{'server'}$config{$h}{'script'}";
|
||
$url .= "?hostname=$hostname";
|
||
$url .= "&domain=$domain";
|
||
$url .= "&command=Domain_Zone_UpdateType" . is_ipv6($ip) ? 'AAAA' : 'A';
|
||
$url .= "&ip=$ip";
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
login => $config{$h}{'login'},
|
||
password => $config{$h}{'password'},
|
||
url => $url,
|
||
);
|
||
$config{$h}{'status'} = 'failed'; # assume failure until otherwise determined
|
||
if (!$reply) {
|
||
failed("updating %s: failed to visit URL %s", $h, $url);
|
||
next;
|
||
}
|
||
next if !header_ok($h, $reply);
|
||
$reply =~ s/^.*?\n\n//s; # Strip the headers.
|
||
if ($reply !~ /Success/i) {
|
||
$reply =~ /^responseCode = (\d+)$/m;
|
||
my $code = $1 // '<undefined>';
|
||
$reply =~ /^errors_0_message = '(.*)'$/m;
|
||
my $message = $1 // '<undefined>';
|
||
failed("updating %s: error %d: %s", $code, $message);
|
||
next;
|
||
}
|
||
$config{$h}{'ip'} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{'status'} = 'good';
|
||
success("updating %s: IP address set to %s", $h, $ip);
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_gandi_examples
|
||
## by Jimmy Thrasibule <dev@jimmy.lt>
|
||
######################################################################
|
||
sub nic_gandi_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'gandi'
|
||
|
||
The 'gandi' protocol is used by the LiveDNS service offered by gandi.net.
|
||
Description of Gandi's LiveDNS API can be found at:
|
||
|
||
https://api.gandi.net/docs/livedns/
|
||
|
||
Available configuration variables:
|
||
* password: The Gandi API key or personal access token. If you don’t have
|
||
one yet, you can generate a production API key from the API Key Page
|
||
(in the Security section) or a personal access token from the Gandi
|
||
Admin application. Required.
|
||
* use-personal-access-token: Whether the password value is a API key or a
|
||
personal access token. Defaults to API key. Note that API keys are
|
||
deprecated by Gandi.
|
||
* zone: The DNS zone to be updated. Required.
|
||
* ttl: The time-to-live value associated with the updated DNS record.
|
||
Optional; uses Gandi's default (10800) if unset.
|
||
|
||
Example ${program}.conf file entries:
|
||
## Single host update using API key.
|
||
protocol=gandi
|
||
zone=example.com
|
||
password=my-gandi-api-key
|
||
host.example.com
|
||
|
||
## Single host update using Personal access token
|
||
protocol=gandi
|
||
zone=example.com
|
||
password=my-gandi-personal-access-token
|
||
use-personal-access-token=yes
|
||
host.example.com
|
||
|
||
## Multiple host update.
|
||
protocol=gandi
|
||
zone=example.com
|
||
password=my-gandi-api-key
|
||
ttl=3600 # optional
|
||
hosta.example.com,hostb.sub.example.com
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_gandi_update
|
||
######################################################################
|
||
sub nic_gandi_update {
|
||
debug("\nnic_gandi_update -------------------");
|
||
# Update each set configured host.
|
||
for my $h (@_) {
|
||
for my $ipv ('ipv4', 'ipv6') {
|
||
my $ip = delete $config{$h}{"want$ipv"};
|
||
if(!$ip) {
|
||
next;
|
||
}
|
||
(my $hostname = $h) =~ s/\.\Q$config{$h}{zone}\E$//;
|
||
info("%s -- Setting IP address to %s.", $h, $ip);
|
||
verbose("UPDATE:", "updating %s", $h);
|
||
|
||
my $headers;
|
||
$headers = "Content-Type: application/json\n";
|
||
if ($config{$h}{'use-personal-access-token'} == 1) {
|
||
$headers .= "Authorization: Bearer $config{$h}{'password'}\n";
|
||
}
|
||
else
|
||
{
|
||
$headers .= "Authorization: Apikey $config{$h}{'password'}\n";
|
||
}
|
||
|
||
|
||
|
||
my $rrset_type = $ipv eq 'ipv6' ? 'AAAA' : 'A';
|
||
my $url;
|
||
$url = "https://$config{$h}{'server'}$config{$h}{'script'}";
|
||
$url .= "/livedns/domains/$config{$h}{'zone'}/records/$hostname/$rrset_type";
|
||
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
headers => $headers,
|
||
method => 'GET'
|
||
);
|
||
unless ($reply) {
|
||
failed("%s -- Could not connect to %s.", $h, $config{$h}{'server'});
|
||
next;
|
||
}
|
||
my $ok = header_ok($h, $reply);
|
||
|
||
$reply =~ s/^.*?\n\n//s;
|
||
my $response = eval { decode_json($reply) };
|
||
if (!defined($response)) {
|
||
$config{$h}{"status-$ipv"} = "bad";
|
||
|
||
failed("%s -- Unexpected service response.", $h);
|
||
next;
|
||
}
|
||
if($response->{'rrset_values'}->[0] eq $ip && (!defined($config{$h}{'ttl'}) ||
|
||
$response->{'rrset_ttl'} eq $config{$h}{'ttl'})) {
|
||
$config{$h}{'ip'} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{"status-$ipv"} = "good";
|
||
success("updating %s: skipped: address was already set to %s.", $h, $ip);
|
||
next;
|
||
}
|
||
|
||
my $data = encode_json({
|
||
defined($config{$h}{'ttl'}) ? (rrset_ttl => $config{$h}{'ttl'}) : (),
|
||
rrset_values => [$ip],
|
||
});
|
||
$reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url,
|
||
headers => $headers,
|
||
method => 'PUT',
|
||
data => $data,
|
||
);
|
||
unless ($reply) {
|
||
failed("%s -- Could not connect to %s.", $h, $config{$h}{'server'});
|
||
next;
|
||
}
|
||
$ok = header_ok($h, $reply);
|
||
if ($ok) {
|
||
$config{$h}{'ip'} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{"status-$ipv"} = "good";
|
||
success("%s -- Updated successfully to %s.", $h, $ip);
|
||
} else {
|
||
$config{$h}{"status-$ipv"} = "bad";
|
||
if (defined($response->{status}) && $response->{status} eq "error") {
|
||
my @errors;
|
||
for my $err (@{$response->{errors}}) {
|
||
push(@errors, $err->{description});
|
||
}
|
||
failed("%s -- %s.", $h, join(", ", @errors));
|
||
} else {
|
||
failed("%s -- Unexpected service response.", $h);
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
######################################################################
|
||
## nic_keysystems_examples
|
||
######################################################################
|
||
sub nic_keysystems_examples {
|
||
return <<EoEXAMPLE;
|
||
o 'keysystems'
|
||
|
||
The 'keysystems' protocol is used by the non-free
|
||
dynamic DNS service offered by www.domaindiscount24.com and www.rrpproxy.net.
|
||
Check https://www.domaindiscount24.com/faq/en/dynamic-dns for API
|
||
|
||
Configuration variables applicable to the 'keysystems' protocol are:
|
||
protocol=keysystems
|
||
server=dynamicdns.key-systems.net
|
||
password=service-password ## password (token) registered with the service
|
||
subdomain.example.com ## the host registered with the service.
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=keysystems, \\\\
|
||
password=service-password \\\\
|
||
example.com
|
||
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_keysystems_update
|
||
## response contains "code 200" on succesfull completion
|
||
######################################################################
|
||
sub nic_keysystems_update {
|
||
debug("\nnic_keysystems_update -------------------");
|
||
|
||
## update each configured host
|
||
## should improve to update in one pass
|
||
for my $h (@_) {
|
||
my $ip = delete $config{$h}{'wantip'};
|
||
info("KEYSYSTEMS setting IP address to %s for %s", $ip, $h);
|
||
my $url = "$config{$h}{'server'}/update.php?hostname=$h&password=$config{$h}{'password'}&ip=$ip";
|
||
my $reply = geturl(proxy => opt('proxy'), url => $url) // '';
|
||
|
||
# No response, declare as failed
|
||
if (!defined($reply) || !$reply) {
|
||
failed("KEYSYSTEMS updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
|
||
last;
|
||
}
|
||
last if !header_ok($h, $reply);
|
||
|
||
if ($reply =~ /code = 200/) {
|
||
$config{$h}{'ip'} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{'status'} = 'good';
|
||
success("updating %s: good: IP address set to %s", $h, $ip);
|
||
} else {
|
||
$config{$h}{'status'} = 'failed';
|
||
failed("updating %s: Server said: '$reply'", $h);
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_regfishde_examples
|
||
######################################################################
|
||
sub nic_regfishde_examples {
|
||
return <<EoEXAMPLE;
|
||
o 'regfishde'
|
||
The 'regfishde' protocol is used by the non-free dynamic DNS service offered by www.regfish.de.
|
||
Check https://www.regfish.de for configuration variables applicable to the 'regfishde' protocol:
|
||
protocol=regfishde
|
||
server=dyndns.regfish.de
|
||
password=service-password ## password (token) registered with the service
|
||
myhost.mydomain.com ## the host registered with the service.
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=regfishde
|
||
password=service-password
|
||
myhost.mydomain.com
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_regfishde_update
|
||
## response contains "success" on succesfull completion
|
||
######################################################################
|
||
sub nic_regfishde_update {
|
||
debug("\nnic_regfishde_update -------------------");
|
||
|
||
## update configured host
|
||
for my $h (@_) {
|
||
my $ipv4 = delete $config{$h}{'wantipv4'};
|
||
my $ipv6 = delete $config{$h}{'wantipv6'};
|
||
info("regfish.de setting IPv4 address to %s for %s", $ipv4, $h) if $ipv4;
|
||
info("regfish.de setting IPv6 address to %s for %s", $ipv6, $h) if $ipv6;
|
||
my $url = "https://$config{$h}{'server'}/?fqdn=$h&forcehost=1&token=$config{$h}{'password'}";
|
||
$url .= "&ipv4=$ipv4" if $ipv4;
|
||
$url .= "&ipv6=$ipv6" if $ipv6;
|
||
|
||
# Try to get URL
|
||
my $reply = geturl(proxy => opt('proxy'), url => $url);
|
||
|
||
# No response, give error
|
||
if (!defined($reply) || !$reply) {
|
||
failed("regfish.de updating %s: failed: %s.", $h, $config{$h}{'server'});
|
||
last;
|
||
}
|
||
last if !header_ok($h, $reply);
|
||
if ($reply !~ /success/) {
|
||
failed("updating %s: Server said: '%s'", $h, $reply);
|
||
next;
|
||
}
|
||
$config{$h}{'ipv4'} = $ipv4 if $ipv4;
|
||
$config{$h}{'ipv6'} = $ipv6 if $ipv6;
|
||
$config{$h}{'status-ipv4'} = 'good' if $ipv4;
|
||
$config{$h}{'status-ipv6'} = 'good' if $ipv6;
|
||
$config{$h}{'mtime'} = $now;
|
||
success("updating %s: good: IPv4 address set to %s", $h, $ipv4) if $ipv4;
|
||
success("updating %s: good: IPv6 address set to %s", $h, $ipv6) if $ipv6;
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
######################################################################
|
||
## enom
|
||
######################################################################
|
||
sub nic_enom_examples {
|
||
return <<EoEXAMPLE;
|
||
o 'enom'
|
||
The 'enom' protocol is used by DNS services offered by www.enom.com and their resellers.
|
||
Configuration variables applicable to the 'enom' protocol are:
|
||
protocol=enom ##
|
||
server=fqdn.of.service ## defaults to dynamic.name-services.com
|
||
login=domain.name ## base domain name
|
||
password=domain-password ## the domain password registered with the service
|
||
A_record ## the A record(s) registered with the service
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
protocol=enom, \\
|
||
login=mydomain.com, \\
|
||
password=mydomain.com-password \\
|
||
www
|
||
## multiple host update
|
||
protocol=enom, \\
|
||
login=mydomain.com, \\
|
||
password=mydomain.com-password \\
|
||
www,mail,*
|
||
EoEXAMPLE
|
||
}
|
||
######################################################################
|
||
## enom_update
|
||
##
|
||
## written by Lars Fredriksson
|
||
## modified by Leonidas Arvanitis
|
||
##
|
||
## based on http://www.edoceo.com/creo/enomddu.php
|
||
##
|
||
## needs this url to update:
|
||
## http://dynamic.name-services.com/interface.asp?Command=SetDNSHost&HostName=www
|
||
## &Zone=mydomain.com&DomainPassword=MyD0mainPa55w0rD&Address=123.45.678.90
|
||
##
|
||
######################################################################
|
||
sub nic_enom_update {
|
||
debug("\nenom_update -------------------");
|
||
## update each configured host
|
||
for my $h (@_) {
|
||
my $ip = delete $config{$h}{'wantip'};
|
||
info("setting IP address to %s for %s", $ip, $h);
|
||
verbose("UPDATE:","updating %s", $h);
|
||
|
||
my $url;
|
||
$url = "https://$config{$h}{'server'}/interface.asp?Command=SetDNSHost";
|
||
$url .= "&HostName=$h";
|
||
$url .= "&Zone=$config{$h}{'login'}";
|
||
$url .= "&DomainPassword=$config{$h}{'password'}";
|
||
$url .= "&Address=";
|
||
$url .= $ip if $ip;
|
||
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $url
|
||
);
|
||
|
||
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;
|
||
|
||
if (grep /Done=true/i, @reply) {
|
||
$config{$h}{'ip'} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{'status'} = 'good';
|
||
success("updating %s: good: IP address set to %s", $h, $ip);
|
||
} else {
|
||
$config{$h}{'status'} = 'failed';
|
||
warning("SENT: %s", $url) unless opt('verbose');
|
||
warning("REPLIED: %s", $reply);
|
||
failed("updating %s: Invalid reply.", $h);
|
||
}
|
||
}
|
||
}
|
||
|
||
sub nic_digitalocean_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'digitalocean'
|
||
|
||
The 'digitalocean' protocol updates domains hosted by Digital Ocean (https://www.digitalocean.com/).
|
||
|
||
This protocol supports both IPv4 and IPv6. It will only update an existing record; it will not
|
||
create a new one. So, before using it, make sure there's already one (and at most one) of each
|
||
record type (A and/or AAAA) you plan to update present in your Digital Ocean zone.
|
||
|
||
This protocol implements the API documented here:
|
||
https://docs.digitalocean.com/reference/api/api-reference/.
|
||
|
||
You can get your API token by following these instructions:
|
||
https://docs.digitalocean.com/reference/api/create-personal-access-token/
|
||
|
||
Available configuration variables:
|
||
* server (optional): API server. Defaults to 'api.digitalocean.com'.
|
||
* zone (required): DNS zone under which the hostname falls.
|
||
* password (required): API token from DigitalOcean Control Panel. See instructions linked above.
|
||
|
||
Example ${program}.conf file entries:
|
||
protocol=digitalocean, \\
|
||
zone=example.com, \\
|
||
password=api-token \\
|
||
example.com,sub.example.com
|
||
EoEXAMPLE
|
||
}
|
||
|
||
sub nic_digitalocean_update_one {
|
||
my ($h, $ip, $ipv) = @_;
|
||
|
||
info("setting %s address to %s for %s", $ipv, $ip, $h);
|
||
|
||
my $server = $config{$h}{'server'};
|
||
my $type = $ipv eq 'ipv6' ? 'AAAA' : 'A';
|
||
|
||
my $headers;
|
||
$headers = "Content-Type: application/json\n";
|
||
$headers .= "Authorization: Bearer $config{$h}{'password'}\n";
|
||
|
||
my $list_url;
|
||
$list_url = "https://$server/v2/domains/$config{$h}{'zone'}/records";
|
||
$list_url .= "?name=$h";
|
||
$list_url .= "&type=$type";
|
||
|
||
my $list_resp = geturl(
|
||
proxy => opt('proxy'),
|
||
url => $list_url,
|
||
headers => $headers,
|
||
);
|
||
unless ($list_resp && header_ok($h, $list_resp)) {
|
||
$config{$h}{"status-$ipv"} = 'failed';
|
||
failed("listing %s %s: Failed connection or bad response from %s.", $h, $ipv, $server);
|
||
return;
|
||
}
|
||
$list_resp =~ s/^.*?\n\n//s; # Strip header
|
||
|
||
my $list = eval { decode_json($list_resp) };
|
||
if ($@) {
|
||
$config{$h}{"status-$ipv"} = 'failed';
|
||
failed("listing %s %s: JSON decoding failure", $h, $ipv);
|
||
return;
|
||
}
|
||
|
||
my $elem = $list;
|
||
unless ((ref($elem) eq 'HASH') &&
|
||
(ref ($elem = $elem->{'domain_records'}) eq 'ARRAY') &&
|
||
(@$elem == 1 && ref ($elem = $elem->[0]) eq 'HASH')) {
|
||
$config{$h}{"status-$ipv"} = 'failed';
|
||
failed("listing %s %s: no record, multiple records, or malformed JSON", $h, $ipv);
|
||
return;
|
||
}
|
||
|
||
my $current_ip = $elem->{'data'};
|
||
my $record_id = $elem->{'id'};
|
||
|
||
if ($current_ip eq $ip) {
|
||
info("updating %s %s: IP is already %s, no update needed.", $h, $ipv, $ip);
|
||
} else {
|
||
my $update_data = encode_json({'type' => $type, 'data' => $ip});
|
||
my $update_resp = geturl(
|
||
proxy => opt('proxy'),
|
||
url => "https://$server/v2/domains/$config{$h}{'zone'}/records/$record_id",
|
||
method => 'PATCH',
|
||
headers => $headers,
|
||
data => $update_data,
|
||
);
|
||
unless ($update_resp && header_ok($h, $update_resp)) {
|
||
$config{$h}{"status-$ipv"} = 'failed';
|
||
failed("updating %s %s: Failed connection or bad response from %s.", $h, $ipv, $server);
|
||
return;
|
||
}
|
||
}
|
||
|
||
$config{$h}{"status-$ipv"} = 'good';
|
||
$config{$h}{"ip-$ipv"} = $ip;
|
||
$config{$h}{"mtime"} = $now;
|
||
}
|
||
|
||
sub nic_digitalocean_update {
|
||
debug("\nnic_digitalocean_update -------------------");
|
||
|
||
for my $h (@_) {
|
||
my $ipv4 = delete $config{$h}{'wantipv4'};
|
||
my $ipv6 = delete $config{$h}{'wantipv6'};
|
||
|
||
if ($ipv4) {
|
||
nic_digitalocean_update_one($h, $ipv4, 'ipv4');
|
||
}
|
||
|
||
if ($ipv6) {
|
||
nic_digitalocean_update_one($h, $ipv6, 'ipv6');
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_infomaniak_examples
|
||
######################################################################
|
||
sub nic_infomaniak_examples {
|
||
return <<"EoEXAMPLE";
|
||
|
||
o 'infomaniak'
|
||
|
||
**Note** The 'infomaniak' protocol is obsolete [*].
|
||
|
||
The 'infomaniak' protocol is used by DNS services offered by www.infomaniak.com.
|
||
|
||
Configuration variables applicable to the 'infomaniak' protocol are:
|
||
protocol=infomaniak
|
||
login=ddns_username ## the DDNS username set up in Infomaniak
|
||
password=ddns_password ## the DDNS username set up in Infomaniak
|
||
example.com ## domain name to update
|
||
|
||
Example ${program}.conf file entries:
|
||
protocol=infomaniak, \\
|
||
login=my-username, \\
|
||
password=my-password \\
|
||
my.address.com
|
||
|
||
For more information about how to create a dynamic DNS, see https://faq.infomaniak.com/2357.
|
||
|
||
[*] Infomaniak DynDNS services (both IP discovery and update) can be used with the standard
|
||
'dyndns2' protocol. See <https://faq.infomaniak.com/40>. Notice that a minimum number of HTTP
|
||
redirections (usally 2) might be needed.
|
||
|
||
Example ${program}.conf file entries:
|
||
protocol=dyndns2, \\
|
||
use=web, web=infomaniak.com/ip.php/ \\
|
||
login=my-username, \\
|
||
password=my-password \\
|
||
redirect=2
|
||
my.address.com
|
||
EoEXAMPLE
|
||
}
|
||
|
||
######################################################################
|
||
## nic_infomaniak_update
|
||
##
|
||
## written by Timothée Andres
|
||
##
|
||
## based on https://faq.infomaniak.com/2376
|
||
##
|
||
## needs one of the following urls to update:
|
||
## https://username:password@infomaniak.com/nic/update?hostname=subdomain.yourdomain.com&myip=1.2.3.4
|
||
## https://infomaniak.com/nic/update?hostname=subdomain.yourdomain.com&myip=1.2.3.4&username=XXX&password=XXX
|
||
######################################################################
|
||
sub nic_infomaniak_update {
|
||
debug("\nnic_infomaniak_update -------------------");
|
||
for my $h (@_) {
|
||
for my $v (4, 6) {
|
||
my $ip = delete $config{$h}{"wantipv$v"};
|
||
if (!defined $ip) {
|
||
debug("ipv%d not wanted, skipping", $v);
|
||
next;
|
||
}
|
||
info("setting IP address to %s for %s", $ip, $h);
|
||
# No change in IP => nochg <w.x.y.z>
|
||
# Bad auth => badauth
|
||
# Bad domain name => nohost
|
||
# Bad IP => nohost
|
||
# IP changed => good <xxxx::yyyy>
|
||
# No domain name => Validation failed
|
||
my %statuses = (
|
||
'good' => (1, sprintf("IP set to %s for %s", $ip, $h)),
|
||
'nochg' => (1, sprintf("IP already set to %s for %s", $ip, $h)),
|
||
'nohost' => (0, sprintf("Bad domain name %s or bad IP %s", $h, $ip)),
|
||
'badauth' => (0, sprintf("Bad authentication for %s", $h)),
|
||
);
|
||
my $reply = geturl(
|
||
proxy => opt('proxy'),
|
||
url => "https://infomaniak.com/nic/update?hostname=$h&myip=$ip",
|
||
login => $config{$h}{'login'},
|
||
password => $config{$h}{'password'},
|
||
);
|
||
next if !header_ok($h, $reply);
|
||
(my $body = $reply) =~ s/^.*?\n\n//s;
|
||
my ($status) = split(/ /, $body, 2);
|
||
my ($ok, $msg) =
|
||
$statuses{$status} // (0, sprintf("Unknown reply from Infomaniak: %s", $body));
|
||
if (!$ok) {
|
||
failed($msg);
|
||
next;
|
||
}
|
||
success($msg);
|
||
$config{$h}{"ipv$v"} = $ip;
|
||
$config{$h}{'mtime'} = $now;
|
||
$config{$h}{"status-ipv$v"} = 'good';
|
||
}
|
||
}
|
||
}
|
||
|
||
######################################################################
|
||
## nic_emailonly_update
|
||
##
|
||
## Written by Joel Croteau
|
||
##
|
||
## Do not update Dynamic DNS, only send status emails. Use if you do
|
||
## not have a DDNS host, but still want to get emails when your IP
|
||
## address changes. Note that you must set the "mail" config option
|
||
## and configure sendmail for this to have an effect. At least one
|
||
## host must be specified; the host names are mentioned in the email.
|
||
######################################################################
|
||
sub nic_emailonly_update {
|
||
debug("\nnic_emailonly_update -------------------");
|
||
# Note: This is logged after $config{$_}{'max-interval'] even if the IP address hasn't changed,
|
||
# so it is best to avoid phrasing like, "IP address has changed."
|
||
logmsg(email => 1, join("\n", 'Host IP addresses:', map({
|
||
my $ipv4 = delete($config{$_}{'wantipv4'});
|
||
my $ipv6 = delete($config{$_}{'wantipv6'});
|
||
$config{$_}{'status-ipv4'} = 'good' if $ipv4;
|
||
$config{$_}{'status-ipv6'} = 'good' if $ipv6;
|
||
$config{$_}{'ipv4'} = $ipv4 if $ipv4;
|
||
$config{$_}{'ipv6'} = $ipv6 if $ipv6;
|
||
$config{$_}{'mtime'} = $now;
|
||
sprintf('%30s %s', $_, join(' ', grep(defined($_), $ipv4, $ipv6)));
|
||
} @_)));
|
||
}
|
||
|
||
######################################################################
|
||
## nic_emailonly_examples
|
||
######################################################################
|
||
sub nic_emailonly_examples {
|
||
return <<"EoEXAMPLE";
|
||
o 'emailonly'
|
||
|
||
The 'emailonly' protocol is a dummy protocol that will send status emails but
|
||
not actually issue any dynamic DNS updates. You can use this if you don\'t
|
||
have a DDNS host, but still want to get emails when your IP address changes.
|
||
For this to have an effect, you must set the 'mail' config option, have
|
||
sendmail properly configured on your machine, and specify at least one dummy
|
||
hostname.
|
||
|
||
Example ${program}.conf file entries:
|
||
## single host update
|
||
mail=me\@example.com
|
||
protocol=emailonly
|
||
host.example.com
|
||
EoEXAMPLE
|
||
}
|
||
|
||
# Execute main() if this file is run as a script or run via PAR (https://metacpan.org/pod/PAR),
|
||
# otherwise do nothing. This "modulino" pattern makes it possible to import this file as a module
|
||
# and test its functions directly; there's no need for test-only command-line arguments or stdout
|
||
# parsing.
|
||
__PACKAGE__->main() unless caller() && caller() ne 'PAR';
|
||
|
||
######################################################################
|
||
## Emacs and Vim settings
|
||
|
||
# Local Variables:
|
||
# mode: perl
|
||
# fill-column: 99
|
||
# indent-tabs-mode: nil
|
||
# perl-indent-level: 4
|
||
# tab-width: 8
|
||
# End:
|
||
|
||
# vim: ai et ts=8 sw=4 tw=99 cc=+1 filetype=perl
|
||
|
||
__END__
|