ddclient.in

#!/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%^.*/%%;
our $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';
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;

# Current Logger instance.  To push a context prefix onto the context stack:
#    local _l = pushlogctx('additional context goes here');
our $_l = ddclient::Logger->new();

$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 with entries that map variable names to values.  Only entries for the
# host's "recap variables" -- those declared in the host's protocol's `recapvars` property -- are
# included.
#
# There are two classes of recap variables:
#   * "Status" variables: These track update success/failure, the IP address of the last successful
#     update, etc.  These do not hold configuration data; they are unrelated to any entries in
#     `%config`.
#   * "Configuration change detection" variables: These are used to force an update if the value in
#     the same-named entry in `%config` has changed since the previous update attempt.  The value
#     stored in `%config` is the desired setting; the value in `%recap` is the desired setting as
#     it was just before the previous update attempt.  Values are synchronized from `%config` to
#     `%recap` during each update attempt.
#
# A protocol's set of config change detection variables can be found in the protocol's
# `force_update_if_changed` property; all other recap variables are assumed to be status variables.
#
# 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_ipv4, %warned_ipv6);

sub repr {
    my $vals = @_ % 2 ? [shift] : [];
    my %opts = @_;
    my $d = Data::Dumper->new($vals)->Sortkeys(1)->Terse(!exists($opts{Names}))->Useqq(1);
    $d->$_($opts{$_}) for keys(%opts);
    return $d->Dump();
}

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_FILE   { 'file name' }
sub T_FQDNP  { 'fully qualified host name and optional port number' }
sub T_PROTO  { 'protocol' }
sub T_URL    { 'url including fully qualified host name, optional port number, and path' }
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' }

# `%recapvars` contains common recap variable declarations that are used by multiple protocols (see
# the protocol `recapvars` property).
our %recapvars = (
    'common' => {
        'host' => T_STRING,
        'protocol' => T_PROTO,
        # The IPv4 address most recently saved at the DDNS service.
        # TODO: This is independent of the `ipv4` configuration setting.  Rename the `%recap`
        # status variable to something like `saved-ipv4` to avoid confusion with the `%config`
        # setting variable.
        'ipv4' => T_IPV4,
        # As `ipv4`, but for an IPv6 address.
        'ipv6' => T_IPV6,
        # 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' => T_NUMBER,
        # 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' => T_NUMBER,
        # 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' => T_NUMBER,
        # Disposition of the most recent (or currently in progress) attempt to update the DDNS
        # service with the IP address in `wantipv4`.  Anything other than `good`, including undef,
        # is treated as a failure.
        'status-ipv4' => T_ANY,
        # As `status-ipv4`, but with `wantipv6`.
        'status-ipv6' => T_ANY,
        # 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' => T_ANY,
        # 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' => T_ANY,
    },
    'dyndns-common' => {
        'backupmx' => T_BOOL,
        'mx' => T_FQDN,
        'wildcard' => T_BOOL,
    },
);

## 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'},
    '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 ($asa, $v4, %p) = @_;
    warning("'--if' is deprecated; use '--ifv4' instead")
        if ($v4 && !defined($p{'ifv4'}) && defined($p{'if'}));
    my $if = ($v4 ? $p{'ifv4'} : undef) // $p{'if'};
    my $fw = ($v4 ? $p{'fwv4'} : undef) // $p{'fw'};
    # Convert slashes to protected value "\/"
    $if =~ s%\/%\\\/%g;
    # Protect special HTML characters (like '?')
    $if =~ s/([\?&= ])/sprintf("%%%02x", ord($1))/ge;
    my $reply = geturl(
        url => ($asa)
            ? "https://$fw/exec/show%20interface%20$if"
            : "http://$fw/level/1/exec/show/ip/interface/brief/$if/CR",
        login => $p{'fw-login'},
        password => $p{'fw-password'},
        ignore_ssl_option => 1,
        ssl_validate => $p{'fw-ssl-validate'},
    );
    return undef if !header_ok($reply, \&warning);
    $reply =~ s/^.*?\n\n//s;
    return $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, @_); },
        'inputs' => ['fw', 'if', 'fw-login', 'fw-password', 'fw-ssl-validate'],
        'queryv4' => sub { return query_cisco(0, 1, @_); },
        'inputsv4' => ['fwv4', 'fw', 'ifv4', 'if', 'fw-login', 'fw-password', 'fw-ssl-validate'],
        '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(1, 0, @_); },
        'inputs' => ['fw', 'if', 'fw-login', 'fw-password', 'fw-ssl-validate'],
        'queryv4' => sub { return query_cisco(1, 1, @_); },
        'inputsv4' => ['fwv4', 'fw', 'ifv4', 'if', 'fw-login', 'fw-password', 'fw-ssl-validate'],
        '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',
    },
);

sub builtinfw_strategy {
    my ($n) = @_;
    my $fw = $builtinfw{$n};
    return ($n => {
        help => ": deprecated, see '--usev4=$n'" .
            (defined($fw->{queryv6}) ? " and '--usev6=$n'" : ''),
        inputs => $fw->{inputs} // ['fw', 'fw-skip', 'fw-login', 'fw-password', 'fw-ssl-validate'],
    });
}

our %ip_strategies = (
    'disabled' => {help => ": do not use a deprecated method to obtain an IP address for this host",
                   inputs => []},
    'no'       => {help => ": deprecated, see '--use=disabled'",
                   inputs => []},
    'ip'       => {help => ": deprecated, see '--usev4=ipv4' and '--usev6=ipv6'",
                   inputs => ['ip']},
    'web'      => {help => ": deprecated, see '--usev4=webv4' and '--usev6=webv6'",
                   inputs => ['web', 'web-skip', 'proxy', 'web-ssl-validate']},
    'fw'       => {help => ": deprecated, see '--usev4=fwv4' and '--usev6=fwv6'",
                   inputs => ['fw', 'fw-skip', 'fw-login', 'fw-password', 'fw-ssl-validate']},
    'if'       => {help => ": deprecated, see '--usev4=ifv4' and '--usev6=ifv6'",
                   inputs => ['if']},
    'cmd'      => {help => ": deprecated, see '--usev4=cmdv4' and '--usev6=cmdv6'",
                   inputs => ['cmd', 'cmd-skip']},
    map(builtinfw_strategy($_), keys(%builtinfw)),
);

sub ip_strategies_usage {
    return map({ sprintf("    --use=%-22s %s.", $_, $ip_strategies{$_}{help}); }
               'disabled', 'no', 'ip', 'web', 'if', 'cmd', 'fw', sort(keys(%builtinfw)));
}

sub builtinfwv4_strategy {
    my ($n) = @_;
    my $fw = $builtinfw{$n};
    return ($n => {
        help => 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>",
        inputs => $fw->{inputsv4} // ['fwv4', 'fw', 'fwv4-skip', 'fw-skip', 'fw-login',
                                      'fw-password', 'fw-ssl-validate'],
    });
}

our %ipv4_strategies = (
    'disabled' => {help => ": do not obtain an IPv4 address for this host (except possibly via the deprecated '--use' option, if it is enabled)",
                   inputs => []},
    'ipv4'     => {help => ": obtain IPv4 from the address given by --ipv4=<address>",
                   inputs => ['ipv4']},
    'webv4'    => {help => ": obtain IPv4 from an IP discovery page on the web",
                   inputs => ['webv4', 'webv4-skip', 'proxy', 'web-ssl-validate']},
    'ifv4'     => {help => ": obtain IPv4 from the interface given by --ifv4=<interface>",
                   inputs => ['ifv4']},
    'cmdv4'    => {help => ": obtain IPv4 from the command given by --cmdv4=<command>",
                   inputs => ['cmdv4', 'cmd-skip']},
    'fwv4'     => {help => ": obtain IPv4 from the URL given by --fwv4=<URL>",
                   inputs => ['fwv4', 'fw', 'fwv4-skip', 'fw-skip', 'fw-login', 'fw-password', 'fw-ssl-validate']},
    map(builtinfwv4_strategy($_), keys(%builtinfw)),
);
sub ipv4_strategies_usage {
    return map({ sprintf("    --usev4=%-22s %s.", $_, $ipv4_strategies{$_}{help}) }
               'disabled', 'ipv4', 'webv4', 'ifv4', 'cmdv4', 'fwv4', sort(keys(%builtinfw)));
}

sub builtinfwv6_strategy {
    my ($n) = @_;
    my $fw = $builtinfw{$n};
    return defined($fw->{queryv6})
        ? ($n => {
            help => ": obtain IPv6 from $fw->{name}@{[($fw->{help} // sub {})->('v6') // '']}",
            inputs => $fw->{inputsv6} // ['fwv6', 'fwv6-skip'],
        })
        : ();
}

our %ipv6_strategies = (
    'disabled' => {help => ": do not obtain an IPv6 address for this host (except possibly via the deprecated '--use' option, if it is enabled)",
                   inputs => []},
    'no'       => {help => ": deprecated, use '--usev6=disabled'",
                   inputs => []},
    'ipv6'     => {help => ": obtain IPv6 from the address given by --ipv6=<address>",
                   inputs => ['ipv6', 'ip']},
    'ip'       => {help => ": deprecated, use '--usev6=ipv6'",
                   inputs => ['ipv6', 'ip']},
    'webv6'    => {help => ": obtain IPv6 from an IP discovery page on the web",
                   inputs => ['webv6', 'web', 'webv6-skip', 'web-skip', 'proxy', 'web-ssl-validate']},
    'web'      => {help => ": deprecated, use '--usev6=webv6'",
                   inputs => ['webv6', 'web', 'webv6-skip', 'web-skip', 'proxy', 'web-ssl-validate']},
    'ifv6'     => {help => ": obtain IPv6 from the interface given by --ifv6=<interface>",
                   inputs => ['ifv6', 'if']},
    'if'       => {help => ": deprecated, use '--usev6=ifv6'",
                   inputs => ['ifv6', 'if']},
    'cmdv6'    => {help => ": obtain IPv6 from the command given by --cmdv6=<command>",
                   inputs => ['cmdv6', 'cmd', 'cmd-skip']},
    'cmd'      => {help => ": deprecated, use '--usev6=cmdv6'",
                   inputs => ['cmdv6', 'cmd', 'cmd-skip']},
    'fwv6'     => {help => ": obtain IPv6 from the URL given by --fwv6=<URL>",
                   inputs => ['fwv6', 'fwv6-skip']},
    map(builtinfwv6_strategy($_), keys(%builtinfw)),
);
sub ipv6_strategies_usage {
    return map({ sprintf("    --usev6=%-22s %s.", $_, $ipv6_strategies{$_}{help}) }
               '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,
        'default'  => shift,
        'minimum'  => shift,
    };
}
our %cfgvars = (
    'global-defaults' => {
        'daemon'              => setv(T_DELAY, 0, $daemon_default,      interval('60s')),
        'foreground'          => setv(T_BOOL,  0, 0,                    undef),
        'file'                => setv(T_FILE,  0, "$etc/$program.conf", undef),
        'cache'               => setv(T_FILE,  0, "$cachedir/$program.cache", undef),
        'pid'                 => setv(T_FILE,  0, undef,                undef),
        'proxy'               => setv(T_FQDNP, 0, undef,                undef),
        'protocol'            => setv(T_PROTO, 0, 'dyndns2',            undef),

        'timeout'             => setv(T_DELAY, 0, interval('120s'),     interval('120s')),
        'force'               => setv(T_BOOL,  0, 0,                    undef),
        'ssl'                 => setv(T_BOOL,  0, 1,                    undef),
        'syslog'              => setv(T_BOOL,  0, 0,                    undef),
        'facility'            => setv(T_STRING,0, 'daemon',             undef),
        'priority'            => setv(T_STRING,0, 'notice',             undef),
        'mail'                => setv(T_EMAIL, 0, undef,                undef),
        'mail-failure'        => setv(T_EMAIL, 0, undef,                undef),
        'max-warn'            => setv(T_NUMBER,0, 1,                    undef),

        'exec'                => setv(T_BOOL,  0, 1,                    undef),
        'debug'               => setv(T_BOOL,  0, 0,                    undef),
        'verbose'             => setv(T_BOOL,  0, 0,                    undef),
        'quiet'               => setv(T_BOOL,  0, 0,                    undef),
        'test'                => setv(T_BOOL,  0, 0,                    undef),

        'postscript'          => setv(T_POSTS, 0, undef,                undef),
        'ssl_ca_dir'          => setv(T_FILE,  0, undef,                undef),
        'ssl_ca_file'         => setv(T_FILE,  0, undef,                undef),
        'redirect'            => setv(T_NUMBER,0, 0,                    undef)
    },
    'protocol-common-defaults' => {
        'server'              => setv(T_FQDNP, 0, 'members.dyndns.org', undef),
        'login'               => setv(T_LOGIN, 1, undef,                undef),
        'password'            => setv(T_PASSWD,1, undef,                undef),
        'host'                => setv(T_STRING,1, undef,                undef),

        'use' => setv(T_USE, 0, sub {
            my ($h) = @_;
            return "'disabled' if '--usev4' or '--usev6' is enabled, otherwise 'ip'"
                if ($h // '') eq '<usage>';
            return 'disabled' if opt('usev4', $h) ne 'disabled' || opt('usev6', $h) ne 'disabled';
            return 'ip';
        }, undef),
        'usev4'               => setv(T_USEV4, 0, 'disabled',           undef),
        'usev6'               => setv(T_USEV6, 0, 'disabled',           undef),
        'if'                  => setv(T_IF,    0, 'ppp0',               undef),
        'ifv4'                => setv(T_IF,    0, 'default',            undef),
        'ifv6'                => setv(T_IF,    0, 'default',            undef),
        'web'                 => setv(T_STRING,0, 'dyndns',             undef),
        'web-skip'            => setv(T_STRING,0, undef,                undef),
        'web-ssl-validate'    => setv(T_BOOL,  0, 1,                    undef),
        'webv4'               => setv(T_STRING,0, 'ipify-ipv4',         undef),
        'webv4-skip'          => setv(T_STRING,0, undef,                undef),
        'webv6'               => setv(T_STRING,0, 'ipify-ipv6',         undef),
        'webv6-skip'          => setv(T_STRING,0, undef,                undef),
        'fw'                  => setv(T_ANY,   0, undef,                undef),
        'fw-skip'             => setv(T_STRING,0, undef,                undef),
        'fw-login'            => setv(T_LOGIN, 0, undef,                undef),
        'fw-password'         => setv(T_PASSWD,0, undef,                undef),
        'fw-ssl-validate'     => setv(T_BOOL,  0, 1,                    undef),
        'fwv4'                => setv(T_ANY,   0, undef,                undef),
        'fwv4-skip'           => setv(T_STRING,0, undef,                undef),
        'fwv6'                => setv(T_ANY,   0, undef,                undef),
        'fwv6-skip'           => setv(T_STRING,0, undef,                undef),
        'cmd'                 => setv(T_PROG,  0, undef,                undef),
        'cmd-skip'            => setv(T_STRING,0, undef,                undef),
        'cmdv4'               => setv(T_PROG,  0, undef,                undef),
        'cmdv6'               => setv(T_PROG,  0, undef,                undef),
        'min-interval'        => setv(T_DELAY, 0, interval('30s'),      0),
        'max-interval'        => setv(T_DELAY, 0, interval('25d'),      0),
        'min-error-interval'  => setv(T_DELAY, 0, interval('5m'),       0),
        'ip'                  => setv(T_IP,    0, undef,                undef),
        'ipv4'                => setv(T_IPV4,  0, undef,                undef),
        'ipv6'                => setv(T_IPV6,  0, undef,                undef),
    },
    'dyndns-common-defaults' => {
        'backupmx'            => setv(T_BOOL,  0, 0,                    undef),
        'mx'                  => setv(T_FQDN,  0, undef,                undef),
        'wildcard'            => setv(T_BOOL,  0, 0,                    undef),
    },
);

{
    package ddclient::Protocol;

    # Keyword arguments:
    #   * `update`: Required coderef that takes `($self, @hosts)` and updates the given hosts.
    #   * `examples`: Required coderef that takes `($self)` and returns a string showing
    #     configuration examples for using the protocol.
    #   * `cfgvars`: Optional hashref of configuration variable declarations.  If omitted or
    #     `undef`, `$cfgvars{'protocol-common-defaults'}` is used.
    #   * `recapvars`: Optional hashref of recap variable declarations.  If omitted or `undef`,
    #     `$recapvars{'common'}` is used.
    #   * `force_update`: Optional coderef that takes `($self, $h)` and returns truthy to force the
    #     given host to update.  Omitting or passing `undef` is equivalent to passing a subroutine
    #     that always returns falsy.
    #   * `force_update_if_changed`: Optional arrayref of variable names to watch for changes.  If
    #     any of the named values in `%config` have changed since the previous update attempt
    #     (successful or not), the host update is forced.  If omitted or `undef`, an empty array is
    #     used.
    sub new {
        my ($class, %args) = @_;
        my $self = bless({%args}, $class);
        # Set defaults and normalize.
        $self->{cfgvars} //= $ddclient::cfgvars{'protocol-common-defaults'};
        $self->{recapvars} //= $ddclient::recapvars{'common'};
        for my $varset (qw(cfgvars recapvars)) {
            $self->{$varset} = {%{$self->{$varset}}};  # Shallow clone.
            # Delete `undef` variable declarations to make it easier to cancel previously declared
            # variables.
            delete($self->{$varset}{$_}) for grep(!defined($self->{$varset}{$_}),
                                                  keys(%{$self->{$varset}}));
        }
        $self->{force_update} //= sub { return 0; };
        $self->{force_update_if_changed} //= [];
        # Eliminate duplicates and non-recap variables.
        my %fvs = map({ ($_ => undef); } @{$self->{force_update_if_changed}}, 'protocol');
        $self->{force_update_if_changed} =
            [grep({ $self->{cfgvars}{$_} && $self->{recapvars}{$_}; } sort(keys(%fvs)))];
        return $self;
    }

    sub force_update {
        my ($self, $h) = @_;
        my @changed = grep({
            my $rv = $ddclient::recap{$h}{$_};
            my $cv = ddclient::opt($_, $h);
            return defined($rv) && defined($cv) && $rv ne $cv;
        } @{$self->{force_update_if_changed}});
        if (@changed) {
            ddclient::info("update forced because options changed: " . join(', ', @changed));
            return 1;
        }
        my $f = $self->{force_update};
        return $f if ref($f) ne 'CODE';
        return $f->($self, $h);
    }

    sub update {
        my ($self, @hosts) = @_;
        for my $h (@hosts) {
            $ddclient::recap{$h}{'atime'} = $now;
            delete($ddclient::recap{$h}{$_}) for qw(status-ipv4 status-ipv6 wtime
                                                    warned-min-interval warned-min-error-interval);
            # Update the configuration change detection variables.  The vars are updated regardless
            # of whether the update actually succeeds because update failures should be retried at
            # the error retry rate (`min-error-interval`), not forced by `force_update`.  Notes
            # about why the recap vars are updated here in this method:
            #   * The vars must not be updated if the host is not being updated because change
            #     detection is defined relative to the previous update attempt.  In particular,
            #     these can't be updated when the protocol's `force_update` method is called
            #     because that method is not always called before an update is attempted.
            #   * The vars must be updated after the `force_update` method would be called so that
            #     `force_update` can check whether any settings have changed since the last time an
            #     update was attempted.
            #   * The vars are updated before the protocol's `update` method is called so that
            #     `update` sees consistent values between `%recap` and `%config`.  This reduces the
            #     impact of Hyrum's Law; if a protocol needs a variable to be updated after the
            #     `update` method is called then that behavior should be made explicit.
            for my $v (@{$self->{force_update_if_changed}}) {
                if (defined(my $val = ddclient::opt($v, $h))) {
                    $ddclient::recap{$h}{$v} = $val;
                } else {
                    # Entries in `%recap` with `undef` values are deleted to avoid needing to
                    # figure out how to represent `undef` in the cache file and to simplify
                    # testing.
                    delete($ddclient::recap{$h}{$v});
                }
            }
        }
        $self->_update(@hosts);
    }

    sub _update {
        my $self = shift;
        $self->{update}($self, @_);
    }

    sub examples {
        my ($self) = @_;
        return $self->{examples}($self);
    }
}

{
    # A legacy protocol implementation reads `$config{$h}{wantip}` and sets `$recap{$h}{status}`
    # and `$recap{$h}{ip}`, rather than reading `wantipv4` and `wantipv6` and setting
    # `status-ipv4`, `status-ipv6`, `ipv4`, and `ipv6`.
    package ddclient::LegacyProtocol;
    use parent qw(-norequire ddclient::Protocol);

    sub _update {
        my ($self, @hosts) = @_;
        my %ipv;
        for my $h (@hosts) {
            $ipv{$h} = defined($ddclient::config{$h}{'wantipv4'}) ? '4' : '6';
            $ddclient::config{$h}{'wantip'} //= delete($ddclient::config{$h}{"wantipv$ipv{$h}"});
            delete($ddclient::recap{$h}{$_}) for qw(ip status);
        }
        $self->SUPER::_update(@hosts);
        for my $h (@hosts) {
            local $ddclient::_l = ddclient::pushlogctx($h);
            delete($ddclient::config{$h}{'wantip'});
            ddclient::debug(
                "legacy protocol; moving 'status' to 'status-ipv$ipv{$h}', 'ip' to 'ipv$ipv{$h}'");
            $ddclient::recap{$h}{"status-ipv$ipv{$h}"} = delete($ddclient::recap{$h}{'status'});
            $ddclient::recap{$h}{"ipv$ipv{$h}"} = delete($ddclient::recap{$h}{'ip'});
        }
    }
}

our %protocols = (
    '1984' => ddclient::LegacyProtocol->new(
        'update' => \&nic_1984_update,
        'examples' => \&nic_1984_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'login' => undef,
            'server' => setv(T_FQDNP, 0, 'api.1984.is', undef),
        },
    ),
    'changeip' => ddclient::LegacyProtocol->new(
        'update'     => \&nic_changeip_update,
        'examples'   => \&nic_changeip_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'server' => setv(T_FQDNP, 0, 'nic.changeip.com', undef),
        },
    ),
    'cloudflare' => ddclient::Protocol->new(
        'update'     => \&nic_cloudflare_update,
        'examples'   => \&nic_cloudflare_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'login'        => setv(T_LOGIN,  0, 'token',                        undef),
            'min-interval' => setv(T_DELAY,  0, interval('5m'),                 0),
            'server'       => setv(T_FQDNP,  0, 'api.cloudflare.com/client/v4', undef),
            'zone'         => setv(T_FQDN,   1, undef,                          undef),
        },
    ),
    'cloudns' => ddclient::LegacyProtocol->new(
        'update' => \&nic_cloudns_update,
        'examples' => \&nic_cloudns_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'login' => undef,
            'password' => undef,
            'dynurl' => setv(T_STRING, 1, undef, undef),
        },
    ),
    'ddns.fm' => ddclient::Protocol->new(
        'update' => \&nic_ddnsfm_update,
        'examples' => \&nic_ddnsfm_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'login' => undef,
            'server' => setv(T_FQDNP, 0, 'https://api.ddns.fm', undef),
        },
    ),
    'digitalocean' => ddclient::Protocol->new(
        'update' => \&nic_digitalocean_update,
        'examples' => \&nic_digitalocean_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'login' => undef,
            'server' => setv(T_FQDNP, 0, 'api.digitalocean.com', undef),
            'zone'   => setv(T_FQDN,  1, undef,                  undef),
        },
    ),
    'dinahosting' => ddclient::LegacyProtocol->new(
        'update'     => \&nic_dinahosting_update,
        'examples'   => \&nic_dinahosting_examples,
        'cfgvars'  => {
            %{$cfgvars{'protocol-common-defaults'}},
            'min-error-interval' => setv(T_DELAY,  0, interval('8m'),     0),
            'script'             => setv(T_STRING, 0, '/special/api.php', undef),
            'server'             => setv(T_FQDNP,  0, 'dinahosting.com',  undef),
        },
    ),
    'directnic' => ddclient::Protocol->new(
        'update'     => \&nic_directnic_update,
        'examples'   => \&nic_directnic_examples,
        'cfgvars'  => {
            %{$cfgvars{'protocol-common-defaults'}},
            'login'    => undef,
            'password' => undef,
            'urlv4'    => setv(T_URL, 0, undef, undef),
            'urlv6'    => setv(T_URL, 0, undef, undef),
        },
    ),
    'dnsmadeeasy' => ddclient::LegacyProtocol->new(
        'update'     => \&nic_dnsmadeeasy_update,
        'examples'   => \&nic_dnsmadeeasy_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'script' => setv(T_STRING, 0, '/servlet/updateip',  undef),
            'server' => setv(T_FQDNP,  0, 'cp.dnsmadeeasy.com', undef),
        },
    ),
    'dondominio' => ddclient::LegacyProtocol->new(
        'update'     => \&nic_dondominio_update,
        'examples'   => \&nic_dondominio_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'server' => setv(T_FQDNP, 0, 'dondns.dondominio.com', undef),
        },
    ),
    'dslreports1' => ddclient::LegacyProtocol->new(
        'update'     => \&nic_dslreports1_update,
        'examples'   => \&nic_dslreports1_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'server' => setv(T_FQDNP, 0, 'www.dslreports.com', undef),
        },
    ),
    'domeneshop' => ddclient::Protocol->new(
        'update'     => \&nic_domeneshop_update,
        'examples'   => \&nic_domeneshop_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'server' => setv(T_FQDNP, 0, 'api.domeneshop.no', undef),
        },
    ),
    'duckdns' => ddclient::Protocol->new(
        'update'     => \&nic_duckdns_update,
        'examples'   => \&nic_duckdns_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'login' => undef,
            'server' => setv(T_FQDNP, 0, 'www.duckdns.org', undef),
        },
    ),
    'dyndns1' => ddclient::LegacyProtocol->new(
        'update'     => \&nic_dyndns1_update,
        'examples'   => \&nic_dyndns1_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            %{$cfgvars{'dyndns-common-defaults'}},
            'static' => setv(T_BOOL, 0, 0, undef),
        },
        'recapvars' => {
            %{$recapvars{'common'}},
            %{$recapvars{'dyndns-common'}},
            'static' => T_BOOL,
        },
        'force_update_if_changed' => [qw(static wildcard mx backupmx)],
    ),
    'dyndns2' => ddclient::Protocol->new(
        'update'     => \&nic_dyndns2_update,
        'examples'   => \&nic_dyndns2_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            %{$cfgvars{'dyndns-common-defaults'}},
            'script' => setv(T_STRING, 0, '/nic/update', undef),
        },
        'recapvars' => {
            %{$recapvars{'common'}},
            %{$recapvars{'dyndns-common'}},
        },
        'force_update_if_changed' => [qw(wildcard mx backupmx)],
    ),
    'easydns' => ddclient::Protocol->new(
        'update'     => \&nic_easydns_update,
        'examples'   => \&nic_easydns_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'backupmx'     => setv(T_BOOL,   0, 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, interval('10m'), 0),
            'mx'           => setv(T_FQDN,   0, undef,                undef),
            'server'       => setv(T_FQDNP,  0, 'api.cp.easydns.com', undef),
            'script'       => setv(T_STRING, 0, '/dyn/generic.php',   undef),
            'wildcard'     => setv(T_BOOL,   0, 0,                    undef),
        },
        'recapvars' => {
            %{$recapvars{'common'}},
            %{$recapvars{'dyndns-common'}},
        },
        'force_update_if_changed' => [qw(wildcard mx backupmx)],
    ),
    'freedns' => ddclient::Protocol->new(
        'update'     => \&nic_freedns_update,
        'examples'   => \&nic_freedns_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'min-interval' => setv(T_DELAY, 0, interval('5m'), interval('5m')),
            'server'       => setv(T_FQDNP, 0, 'freedns.afraid.org', undef),
        },
    ),
    'freemyip' => ddclient::LegacyProtocol->new(
        'update'     => \&nic_freemyip_update,
        'examples'   => \&nic_freemyip_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'login' => undef,
            'server' => setv(T_FQDNP, 0, 'freemyip.com', undef),
        },
    ),
    'gandi' => ddclient::Protocol->new(
        'update'     => \&nic_gandi_update,
        'examples'   => \&nic_gandi_examples,
        'cfgvars'  => {
            %{$cfgvars{'protocol-common-defaults'}},
            'login' => undef,
            'min-interval'              => setv(T_DELAY,  0, interval('5m'),  interval('5m')),
            'server'                    => setv(T_FQDNP,  0, 'api.gandi.net', undef),
            'script'                    => setv(T_STRING, 0, '/v5',           undef),
            'use-personal-access-token' => setv(T_BOOL, 0, 0, undef),
            'ttl'                       => setv(T_DELAY,  0, undef,           interval('5m')),
            'zone'                      => setv(T_FQDN,   1, undef,           undef),
        }
    ),
    'godaddy' => ddclient::Protocol->new(
        'update'     => \&nic_godaddy_update,
        'examples'   => \&nic_godaddy_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'min-interval' => setv(T_DELAY,  0, interval('5m'),                 0),
            'server'       => setv(T_FQDNP,  0, 'api.godaddy.com/v1/domains',   undef),
            'ttl'          => setv(T_NUMBER, 0, 600,                            undef),
            'zone'         => setv(T_FQDN,   1, undef,                          undef),
        },
    ),
    'he.net' => ddclient::Protocol->new(
        'update' => \&nic_henet_update,
        'examples' => \&nic_henet_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'login' => undef,
            'min-interval' => setv(T_DELAY, 0, interval('5m'), 0),
            'server' => setv(T_FQDNP, 0, 'dyn.dns.he.net', undef),
        },
    ),
    'hetzner' => ddclient::Protocol->new(
        'update'     => \&nic_hetzner_update,
        'examples'   => \&nic_hetzner_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'login' => undef,
            'min-interval' => setv(T_DELAY,  0, interval('1m'),                 0),
            'server'       => setv(T_FQDNP,  0, 'dns.hetzner.com/api/v1',       undef),
            'ttl'          => setv(T_NUMBER, 0, 60,                             60),
            'zone'         => setv(T_FQDN,   1, undef,                          undef),
        },
    ),
    'inwx' => ddclient::Protocol->new(
        'update' => \&nic_inwx_update,
        'examples' => \&nic_inwx_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'server' => setv(T_FQDNP, 0, 'dyndns.inwx.com', undef),
            'script' => setv(T_STRING, 0, '/nic/update', undef),
        },
    ),
    'mythicdyn' => ddclient::Protocol->new(
        'update'     => \&nic_mythicdyn_update,
        'examples'   => \&nic_mythicdyn_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'min-interval' => setv(T_DELAY, 0, interval('5m'),       0),
            'server'       => setv(T_FQDNP, 0, 'api.mythic-beasts.com', undef),
        },
    ),
    'namecheap' => ddclient::LegacyProtocol->new(
        'update'     => \&nic_namecheap_update,
        'examples'   => \&nic_namecheap_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'min-interval' => setv(T_DELAY, 0, interval('5m'), interval('5m')),
            'server'       => setv(T_FQDNP, 0, 'dynamicdns.park-your-domain.com', undef),
        },
    ),
    'nfsn' => ddclient::LegacyProtocol->new(
        'update'     => \&nic_nfsn_update,
        'examples'   => \&nic_nfsn_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'min-interval' => setv(T_DELAY, 0, interval('5m'), interval('5m')),
            'server'       => setv(T_FQDNP,  0, 'api.nearlyfreespeech.net', undef),
            'ttl'          => setv(T_NUMBER, 0, 300,                        undef),
            'zone'         => setv(T_FQDN,   1, undef,                      undef),
        },
    ),
    'njalla' => ddclient::Protocol->new(
        'update'     => \&nic_njalla_update,
        'examples'   => \&nic_njalla_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'login' => undef,
            'server' => setv(T_FQDNP, 0, 'njal.la', undef),
            'quietreply' => setv(T_BOOL, 0, 0, undef),
        },
    ),
    'noip' => ddclient::Protocol->new(
        'update'     => \&nic_noip_update,
        'examples'   => \&nic_noip_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'server' => setv(T_FQDNP, 0, 'dynupdate.no-ip.com', undef),
        },
    ),
    'nsupdate' => ddclient::Protocol->new(
        'update'     => \&nic_nsupdate_update,
        'examples'   => \&nic_nsupdate_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'login' => setv(T_LOGIN,  0, '/usr/bin/nsupdate', undef),
            'tcp'   => setv(T_BOOL,   0, 0,                   undef),
            'ttl'   => setv(T_NUMBER, 0, 600,                 undef),
            'zone'  => setv(T_STRING, 1, undef,               undef),
        },
    ),
    'ovh' => ddclient::LegacyProtocol->new(
        'update'     => \&nic_ovh_update,
        'examples'   => \&nic_ovh_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'script'   => setv(T_STRING, 0, '/nic/update', undef),
            'server'   => setv(T_FQDNP,  0, 'www.ovh.com', undef),
        },
    ),
    'porkbun' => ddclient::Protocol->new(
        'update'     => \&nic_porkbun_update,
        'examples'   => \&nic_porkbun_examples,
        'cfgvars'  => {
            %{$cfgvars{'protocol-common-defaults'}},
            'login' => undef,
            'password' => undef,
            'apikey'         => setv(T_PASSWD, 1, undef,      undef),
            'secretapikey'   => setv(T_PASSWD, 1, undef,      undef),
            'root-domain'    => setv(T_FQDN,   0, undef,      undef),
            'on-root-domain' => setv(T_BOOL,   0, 0,          undef),
        },
    ),
    'sitelutions' => ddclient::LegacyProtocol->new(
        'update'     => \&nic_sitelutions_update,
        'examples'   => \&nic_sitelutions_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'server'       => setv(T_FQDNP, 0, 'www.sitelutions.com', undef),
            'min-interval' => setv(T_DELAY, 0, interval('5m'), interval('5m')),
        },
    ),
    'yandex' => ddclient::LegacyProtocol->new(
        'update'     => \&nic_yandex_update,
        'examples'   => \&nic_yandex_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'min-interval' => setv(T_DELAY, 0, interval('5m'),     0),
            'server'       => setv(T_FQDNP, 0, 'pddimp.yandex.ru', undef),
        },
    ),
    'zoneedit1' => ddclient::LegacyProtocol->new(
        'update'     => \&nic_zoneedit1_update,
        'examples'   => \&nic_zoneedit1_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'min-interval' => setv(T_DELAY, 0, interval('10m'),        0),
            'server'       => setv(T_FQDNP, 0, 'dynamic.zoneedit.com', undef),
            'zone'         => setv(T_FQDN,  0, undef,                  undef),
        },
    ),
    'keysystems' => ddclient::LegacyProtocol->new(
        'update' => \&nic_keysystems_update,
        'examples'  => \&nic_keysystems_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'login' => undef,
            'server' => setv(T_FQDNP, 0, 'dynamicdns.key-systems.net', undef),
        },
    ),
    'dnsexit2' => ddclient::Protocol->new(
        'update'     => \&nic_dnsexit2_update,
        'examples'   => \&nic_dnsexit2_examples,
        'cfgvars'  => {
            %{$cfgvars{'protocol-common-defaults'}},
            'login' => undef,
            'ssl' => setv(T_BOOL, 0, 1, undef),
            'server' => setv(T_FQDNP, 0, 'api.dnsexit.com', undef),
            'path' => setv(T_STRING, 0, '/dns/', undef),
            'ttl' => setv(T_NUMBER, 0, 5, 0),
            'zone' => setv(T_STRING, 0, undef, undef),
        },
    ),
    'regfishde' => ddclient::Protocol->new(
        'update'     => \&nic_regfishde_update,
        'examples'   => \&nic_regfishde_examples,
        'cfgvars' => {
            %{$cfgvars{'protocol-common-defaults'}},
            'login' => undef,
            'server' => setv(T_FQDNP, 0, 'dyndns.regfish.de', undef),
        },
    ),
    'enom' => ddclient::LegacyProtocol->new(
        'update'     => \&nic_enom_update,
        'examples'   => \&nic_enom_examples,
        'cfgvars'  => {
            %{$cfgvars{'protocol-common-defaults'}},
            'server' => setv(T_FQDNP, 0, 'dynamic.name-services.com', undef),
            'min-interval' => setv(T_DELAY, 0, interval('5m'), interval('5m')),
         },
     ),
    'infomaniak' => ddclient::Protocol->new(
        'update'     => \&nic_infomaniak_update,
        'examples'   => \&nic_infomaniak_examples,
        'cfgvars'  => {
            %{$cfgvars{'protocol-common-defaults'}},
            'server' => undef,
        },
    ),
    'emailonly' => ddclient::Protocol->new(
        'update'     => \&nic_emailonly_update,
        'examples'   => \&nic_emailonly_examples,
        'cfgvars'  => {
            %{$cfgvars{'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, 'inf', 0),
        },
    ),
);
$cfgvars{'merged'} = {
    map({ %{$protocols{$_}{'cfgvars'}} } keys(%protocols)),
    %{$cfgvars{'dyndns-common-defaults'}},
    %{$cfgvars{'protocol-common-defaults'}},
    %{$cfgvars{'global-defaults'}},
};

# This will hold the processed args.
our %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'"],
    &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>[,<host>,...]\n                         : only update the given hosts.  The hosts must already be defined in the config file (see '--file') unless '--options' is also specified"],
    "",
    ["options",           "=s", "--options=<opt>=<val>[,<opt>=<val>,...]\n                         : override settings from the config file (see '--file') with the given values.  Applies to all hosts"],
    "",
    ["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"],
    ["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
    ["redirect",          "=i", "--redirect=<max>       : enable and follow at most <max> HTTP 30x redirections"],
    "",
    nic_examples(),
);
$opt{'help'} = sub {
    print(usage(@opt), "\n");
    $opt{'version'}('', '');
};

sub main {
    process_args(@opt);
    $saved_recap = '';
    %saved_opt = %opt;
    $result = 'OK';
    ## read config file because 'daemon' mode may be defined there.
    read_config(opt('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;
        read_config(opt('file'), \%config, \%globals);
        init_config();
        read_recap(opt('cache'));
        print_info() if opt('debug') && opt('verbose');
        $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(my $ps = opt('postscript'))) {
        my @postscript = split(/\s+/, $ps);
        if (-x $postscript[0]) {
            system("$ps $ip &");
        } else {
            warning("Can not execute post script: %s", $ps);
        }
    }
}

######################################################################
## update_nics
######################################################################
sub update_nics {
    my %examined = ();
    my %use_results;
    my %usev4_results;
    my %usev6_results;

    for my $p (sort keys %protocols) {
        my (@hosts, %ipsv4, %ipsv6) = ();
        for my $h (sort keys %config) {
            local $_l = pushlogctx($h);
            next if opt('protocol', $h) ne $p;
            $examined{$h} = 1;
            # we only do this once per 'use' and argument combination
            my $use = opt('use', $h);
            my $usev4 = opt('usev4', $h);
            my $usev6 = opt('usev6', $h);
            my $ip = undef;
            my $ipv4 = undef;
            my $ipv6 = undef;

            if ($use ne 'disabled') {
                my %inputs = strategy_inputs('use', $h);
                my $sig = repr(\%inputs, Indent => 0);
                $use_results{$sig} //= get_ip(%inputs);
                if (!is_ipv4($use_results{$sig}) && !is_ipv6($use_results{$sig})) {
                    warning("unable to determine IP address with strategy '--use=$use'")
                        if !$daemon || opt('verbose');
                    delete $use_results{$sig};
                }
                $ip = $use_results{$sig};
            }

            if ($usev4 ne 'disabled') {
                my %inputs = strategy_inputs('usev4', $h);
                my $sig = repr(\%inputs, Indent => 0);
                $usev4_results{$sig} //= get_ipv4(%inputs);
                if (!is_ipv4($usev4_results{$sig})) {
                    warning("unable to determine IPv4 address with strategy '--usev4=$usev4'")
                        if !$daemon || opt('verbose');
                    delete $usev4_results{$sig};
                }
                $ipv4 = $usev4_results{$sig};
            }

            if ($usev6 ne 'disabled') {
                my %inputs = strategy_inputs('usev6', $h);
                my $sig = repr(\%inputs, Indent => 0);
                $usev6_results{$sig} //= get_ipv6(%inputs);
                if (!is_ipv6($usev6_results{$sig})) {
                    warning("unable to determine IPv6 address with strategy '--usev6=$usev6'")
                        if !$daemon || opt('verbose');
                    delete $usev6_results{$sig};
                }
                $ipv6 = $usev6_results{$sig};
            }

            $ip //= $ipv4 // $ipv6;
            $ipv4 //= $ip if is_ipv4($ip);
            $ipv6 //= $ip if is_ipv6($ip);
            if (!$ipv4 && !$ipv6) {
                warning('unable to determine IP address');
                next;
            }
            $config{$h}{'wantipv4'} = $ipv4;
            $config{$h}{'wantipv6'} = $ipv6;
            if (!nic_updateable($h)) {
                delete($config{$h}{$_}) for qw(wantipv4 wantipv6);
                next;
            }
            push @hosts, $h;

            $ipsv4{$ipv4} = $h if ($ipv4);
            $ipsv6{$ipv6} = $h if ($ipv6);
        }
        if (@hosts) {
            $0 = sprintf("%s - updating %s", $program, join(',', @hosts));
            local $_l = pushlogctx($p);
            $protocols{$p}->update(@hosts);
            for my $h (@hosts) {
                delete($config{$h}{$_}) for qw(wantipv4 wantipv6);
            }
            runpostscript(join ' ', keys %ipsv4, keys %ipsv6);
        }
    }
    for my $h (sort keys %config) {
        local $_l = pushlogctx($h);
        if (!exists $examined{$h}) {
            failed("not updated because protocol is not supported: " .
                   opt('protocol', $h) // '<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) = @_;
    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 $globals = {};
    %recap = ();
    return if !(-e $file);
    my %saved = %opt;
    %opt = ();
    $saved_recap = _read_config(\%recap, $globals, "##\\s*$program-$version\\s*", $file, sub {
        my ($h, $k, $v, $normout) = @_;
        if (!defined($h) && $k eq 'host') {
            return 0 if !defined($v);
            $$normout = $v;
            return 1;
        }
        if (!defined($h) || !$config{$h}) {
            warning("ignoring '$k=$v' for unknown host: " . ($h // '<undefined>'));
            return 0;
        }
        my $p = opt('protocol', $h);
        my $type = $protocols{$p}{recapvars}{$k};
        if (!$type) {
            warning("ignoring unrecognized recap variable for host '$h' with protocol '$p': $k");
            return 0;
        }
        my $norm;
        if (!eval { $norm = check_value($v, {type => $type}); 1; }) {
            warning("invalid value '$k=$v' for host '$h' with protocol '$p': $@");
            return 0;
        }
        $$normout = $norm if defined($normout);
        return 1;
    });
    %opt = %saved;
    for my $h (keys(%recap)) {
        if (!exists($config{$h})) {
            delete($recap{$h});
            next;
        }
        my $vars = $protocols{opt('protocol', $h)}{recapvars};
        for my $v (keys(%{$recap{$h}})) {
            delete($recap{$h}{$v}) if !$vars->{$v};
        }
    }
}
######################################################################
## parse_assignments(string) return (rest, %variables)
## parse_assignment(string)  return (name, value, rest)
#
# Parsing stops upon encountering non-assignment text (e.g., hostname after the assignments) or an
# unquoted/unescaped newline.
######################################################################
sub parse_assignments {
    my ($rest) = @_;
    my %variables = ();

    while (1) {
        (my $name, my $value, $rest) = parse_assignment($rest);
        $rest =~ s/^(?:[^\S\n]|,)+//;  # Remove leading commas and non-newline whitespace.
        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, '');

    # Ignore leading commas and non-newline whitespace.  (An unquoted/unescaped newline terminates
    # the assignment search.)
    if ($rest =~ qr/^(?:[^\S\n]|,)*([a-z][0-9a-z_-]*)=(.*)/is) {
        ($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);
        }
        if ($name =~ qr/^(.*)_env$/) {
            $name = $1;
            debug("Loading value for $name from environment variable $value");
            if (!exists($ENV{$value})) {
                warning("Environment variable '$value' not set for keyword '$name' (ignored)");
                return parse_assignment($rest);
            }
            $value = $ENV{$value};
        }
    }
    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 {
        # TODO: The checks below are incorrect for a few reasons:
        #
        #   * It is not protocol-aware.  Different protocols can have different sets of variables,
        #     with different normalization and validation behaviors.
        #   * It does not check for missing required values.  Note that a later line or a
        #     command-line argument might define a missing required value.
        #   * A later line or command-line argument might override an invalid value, changing it to
        #     valid.
        #
        # Fixing this is not simple.  Values should be checked and normalized after processing the
        # entire file and command-line arguments, but then we lose line number context.  The line
        # number could be recorded along with each variable's value to provide context in case
        # validation fails, but that adds considerable complexity.  Fortunately, a variable's type
        # is unlikely to change even if the protocol changes (`$cfgvars{merged}{$var}{type}` will
        # likely equal `$protocols{$proto}{cfgvars}{$var}{type}` for each variable `$var` for each
        # protocol `$proto`), so normalizing and validating values on a line-by-line basis is
        # likely to be safe.
        my ($h, $k, $v, $normout) = @_;
        if (!exists($cfgvars{'merged'}{$k})) {
            warning("unrecognized keyword");
            return 0;
        }
        my $def = $cfgvars{'merged'}{$k};
        my $norm;
        if (!eval { $norm = check_value($v, $def); 1; }) {
            my $vf = defined($v) ? "'$v'" : '<undefined>';
            warning("invalid value $vf: $@");
            return 0;
        }
        $$normout = $norm if defined($normout);
        return 1;
    });
}
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, $globals, $stamp, $file, $check) = @_;
    local $_l = pushlogctx("file $file");
    my %globals = ();
    my %config  = ();
    my $content = '';
    # Calls $check on each entry in the given hashref, deleting any entries that don't pass.
    my $checkall = sub {
        my ($h, $l) = @_;
        for my $k (keys(%$l)) {
            local $_l = pushlogctx($k);
            delete($l->{$k}) if !$check->($h, $k, $l->{$k}, \$l->{$k});
        }
    };

    local *FD;
    if (!open(FD, "< $file")) {
        warning("cannot open 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 must be accessible only by its owner (fixed)");
        } else {
            warning("file must be accessible only by its owner");
        }
    } elsif (! -o FD && -w FD) {
        warning("file should be owned only by ddclient or not be writable.");
    }
    if ($mode & 07) {
        warning("file must not be accessible by others.");
    }

    my $lineno = 0;
    my $continuation = '';
    my %passwords    = ();
    while (<FD>) {
        s/[\r\n]//g;

        $lineno++;
        local $_l = $_l->{parent}; $_l = pushlogctx("file $file, line $lineno");

        ## check for the program version stamp
        if (($. == 1) && $stamp && ($_ !~ /^$stamp$/i)) {
            warning('program version mismatch; ignoring');
            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
        # TODO: This makes it impossible to include '#' in keys or values except as permitted by
        # the special password parsing above.
        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
        # TODO: This makes it impossible to include multiple consecutive spaces, tabs, etc. in keys
        # or values.
        s/\s+/ /g;    # canonify
        next if /^$/;

        my %locals;
        ($_, %locals) = parse_assignments($_);
        s/\s*,\s*/,/g;
        my @args = split;
        for my $k (keys %locals) {
            $locals{$k} = $passwords{$k} if defined $passwords{$k};
        }
        %passwords = ();
        if (defined($locals{'host'})) {
            $args[0] = (@args ? "$args[0]," : '') . $locals{host};
        }
        my ($host, $login, $password) = @args;
        $locals{'login'} = $login if defined $login;
        $locals{'password'} = $password if defined $password;
        my @hosts = split_by_comma($host);
        if (!@hosts) {
            local $_l = pushlogctx('globals');
            $checkall->(undef, \%locals);
            %globals = (%globals, %locals);
            next;
        }
        for my $h (@hosts) {
            local $_l = pushlogctx($h);
            # Shallow clone of %locals for host-dependent validation and normalization.
            my %hlocals = %locals;
            $checkall->($h, \%hlocals);
            # TODO: Shouldn't `%hlocals` 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.
            $config{$h} = {%globals, %hlocals, %{$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;
    # TODO: This might grab an arbitrary protocol-specific variable definition, which could cause
    # surprising behavior.
    for my $var (keys(%{$cfgvars{'merged'}})) {
        # TODO: Also validate $opt{'options'}.
        next if !defined($opt{$var}) || ref($opt{$var});
        if (!eval { $opt{$var} = check_value($opt{$var}, $cfgvars{'merged'}{$var}); 1; }) {
            fatal("invalid argument '--$var=$opt{$var}': $@");
        }
    }

    ##
    $opt{'quiet'} = 0 if opt('verbose');

    ## define or modify host options specified on the command-line
    if (defined($opt{'options'})) {
        # TODO: Perhaps the --options argument should be processed like the contents of the config
        # file: each line (after removing any comments or continuations) either specifies global
        # values or host-specific settings.  For now, non-value newlines and end-of-line host
        # declarations are rejected.
        my ($rest, %options) = parse_assignments($opt{'options'});
        fatal("unexpected content in '--options' argument: $rest") if $rest ne '';
        ## 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} //= {'host' => $h};
                my $proto = $options{'protocol'} // opt('protocol', $h);
                my $protodef = $protocols{$proto} or fatal("host $h: invalid protocol: $proto");
                for my $var (keys(%options)) {
                    my $def = $protodef->{cfgvars}{$var}
                        or fatal("host $h: unknown option '--options=$var=$options{$var}'");
                    eval { $config{$h}{$var} = check_value($options{$var}, $def); 1; }
                        or fatal("host $h: invalid option value '--options=$var=$options{$var}': $@");
                }
            }
            $opt{'host'} = join(',', @hosts);
        } else {
            for my $var (keys(%options)) {
                # TODO: This might grab an arbitrary protocol-specific variable definition, which
                # could cause surprising behavior.
                my $def = $cfgvars{'merged'}{$var}
                    or fatal("unknown option '--options=$var=$options{$var}'");
                # TODO: Why not merge the values into %opt?
                eval { $globals{$var} = check_value($options{$var}, $def); 1; }
                    or fatal("invalid option value '--options=$var=$options{$var}': $@");
            }
        }
    }

    ## override global options with those on the command-line.
    for my $o (keys %opt) {
        if (defined $opt{$o} && exists $cfgvars{'merged'}{$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};
        }
        # TODO: Why aren't host configs updated with command-line values (except for $opt{options}
        # handled above)?  Shouldn't command-line values always override config file values (even
        # if they are not associated with a host via `--host=` or `--options=host=`)?
    }

    ## 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'});
    }

    ## remove any other hosts
    my %hosts;
    map { $hosts{$_} = undef } @hosts;
    map { delete $config{$_} unless exists $hosts{$_} } keys %config;

    # TODO: Why aren't the hosts specified by --host added to %config except when --options is also
    # given?

    my @protos = map(opt('protocol', $_), keys(%config));
    my @needs_sha1 = grep({ my $p = $_; grep($_ eq $p, @protos); } qw(freedns nfsn));
    load_sha1_support(join(', ', @needs_sha1)) if @needs_sha1;
    my @needs_json = grep({ my $p = $_; grep($_ eq $p, @protos); }
                          qw(1984 cloudflare digitalocean directnic dnsexit2 gandi godaddy hetzner
                             nfsn njalla porkbun yandex));
    load_json_support(join(', ', @needs_json)) if @needs_json;
}

sub usage {
    my $usage = "";
    for (@_) {
        if (ref $_) {
            my ($key, $specifier, $arg_usage) = @$_;
            my $value = default($key, '<usage>');
            next unless $arg_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";
    }
    return $usage;
}

######################################################################
## process_args -
######################################################################
sub process_args {
    my @spec = ();
    for (@_) {
        next if !ref($_);
        my ($key, $specifier) = @$_;
        push @spec, $key . $specifier;
    }
    if (!GetOptions(\%opt, @spec)) {
        $opt{'help'}('', '');
    }
}

######################################################################
## 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(strategy_inputs('use')) // '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(strategy_inputs('use')) // '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(strategy_inputs('use')) // 'NOT FOUND');
            }
        }
        local $opt{'use'} = 'fw';
        printf("use=fw, fw=%s address is %s\n",
               opt('fw'), get_ip(strategy_inputs('use')) // '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(strategy_inputs('use')) // 'NOT FOUND');
        }
        printf("use=web, web=%s address is %s\n",
               opt('web'), get_ip(strategy_inputs('use')) // '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(strategy_inputs('use')) // '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(strategy_inputs('usev4')) // '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(strategy_inputs('usev4')) // 'NOT FOUND');
        }
    }
    {
        local $opt{'usev4'} = 'webv4';
        for my $web (sort keys %builtinweb) {
            local $opt{'webv4'} = $web;
            printf("usev4=webv4, webv4=%s address is %s\n",
                   $web, get_ipv4(strategy_inputs('usev4')) // '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(strategy_inputs('usev4')) // '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(strategy_inputs('usev4')) // '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(strategy_inputs('usev6')) // '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(strategy_inputs('usev6')) // 'NOT FOUND');
        }
    }
    {
        local $opt{'usev6'} = 'webv6';
        for my $web (sort keys %builtinweb) {
            local $opt{'webv6'} = $web;
            printf("usev6=webv6, webv6=%s address is %s\n",
                   $web, get_ipv6(strategy_inputs('usev6')) // '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(strategy_inputs('usev6')) // '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(strategy_inputs('usev6')) // 'NOT FOUND');
    }

    exit 0 unless opt('debug');
}

######################################################################
## 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;
    local $_l = pushlogctx($cmd);
    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');

    } elsif ($stdin && (!print FD "$stdin\n")) {
        warning('failed writing to stdin');
        close(FD);

    } elsif (!close(FD)) {
        warning("failed closing stdin: $@");

    } elsif (opt('exec') && $?) {
        warning("failed: $@");

    } 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
##  opt
######################################################################
sub split_by_comma {
    my $string = shift;

    return split /\s*[, ]\s*/, $string if defined $string;
    return ();
}
sub default {
    my ($v, $h) = @_;
    my $var;
    if (defined($h) && $config{$h}) {
        my $proto = $protocols{opt('protocol', $v eq 'protocol' ? undef : $h)};
        $var = $proto->{cfgvars}{$v} if $proto;
    }
    # TODO: This might grab an arbitrary protocol-specific variable definition, which could cause
    # surprising behavior.
    $var //= $cfgvars{'merged'}{$v};
    return undef if !defined($var);
    return $var->{'default'}($h) if ref($var->{default}) eq 'CODE';
    return $var->{'default'};
}
sub opt {
    my $v = shift;
    my $h = shift;
    return $config{$h}{$v} if defined($h) && defined($config{$h}{$v});
    # TODO: Why check %opt before %globals?  Valid variables from %opt are merged into %globals by
    # init_config(), so it shouldn't be necessary.  Also, it runs the risk of collision with a
    # non-variable command line option like `--version`, `--help`, etc.
    return $opt{$v} // $globals{$v} // default($v, $h);
}
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
######################################################################
{
    package ddclient::Logger;

    sub new {
        my ($class, $ctx, $parent) = @_;
        $ctx = [$ctx // ()] if ref($ctx) eq '';
        return bless({ctx => $ctx, parent => $parent, _in_logger => 0}, $class);
    }

    # Takes the following keyword arguments:
    #   * `msg` (string): The message to log.
    #   * `label` (string): Severity ('DEBUG', 'WARNING', etc.) to prefix each line with.
    #   * `email` (boolean): Whether to include the message in the next email.
    #   * `raw` (boolean): Whether to omit `label` and the contexts (output `msg` as-is).
    #   * `ctx` (optional string or arrayref of strings): Context or contexts to temporarily push
    #     onto the context stack (for this call only).
    #
    # The keyword arguments may optionally be followed by a single positional argument, which
    # becomes the value for the `msg` keyword argument if the `msg` keyword argument is not
    # provided (it is ignored if the `msg` keyword is present).
    sub log {
        my $self = shift;
        my %args = (@_ % 2 ? (msg => pop) : (), @_);
        $args{ctx} = [$args{ctx} // ()] if ref($args{ctx}) eq '';
        return $self->_log(\%args);
    }

    sub _log {
        my ($self, $args) = @_;
        # A new arrayref is created instead of unshifting into @{$args->{ctx}} to avoid mutating
        # the caller's arrayref (in case it is reused in a future call).
        $args->{ctx} = [@{$self->{ctx}}, @{$args->{ctx}}];
        return $self->{parent}->_log($args) if defined($self->{parent});
        my $buffer = $args->{msg} // '';
        chomp($buffer);
        if (!$args->{raw}) {
            $args->{label} //= '';
            my $prefix = $args->{label} ne '' ? sprintf("%-8s ", $args->{label} . ':') : '';
            $prefix .= "[$_]" for @{$args->{ctx}};
            $prefix .= '> ' if $prefix;
            $buffer = "$prefix$buffer";
            $prefix =~ s/> $/  /;
            $buffer =~ s/\n/\n$prefix/g;
        }
        $buffer .= "\n";
        print(STDERR $buffer);

        if ($args->{email}) {
            $emailbody .= $buffer;
            if (!$self->{_in_logger}) {
                ++$self->{_in_logger};  # Avoid infinite recursion if logger itself logs.
                ddclient::logger($buffer);
                --$self->{_in_logger};
            }
        }
    }
}

# Intended use:
#     local $_l = pushlogctx('additional prefix goes here');
sub pushlogctx { my ($ctx) = @_; return ddclient::Logger->new($ctx, $_l); }

sub logmsg { $_l->log(@_); }
sub _logmsg_fmt { $_[0] eq 'ctx' ? (shift, shift) : (), (@_ > 1) ? sprintf(shift, @_) : shift; }
sub info    { logmsg(email => 1, label => 'INFO',    _logmsg_fmt(@_)) if opt('verbose'); }
sub debug   { logmsg(            label => 'DEBUG',   _logmsg_fmt(@_)) if opt('debug'); }
sub warning { logmsg(email => 1, label => 'WARNING', _logmsg_fmt(@_)); }
sub fatal   { logmsg(email => 1, label => 'FATAL',   _logmsg_fmt(@_)); sendmail(); exit(1); }
sub success { logmsg(email => 1, label => 'SUCCESS', _logmsg_fmt(@_)); }
sub failed  { logmsg(email => 1, label => '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_opt) = @_;
    my $interval = opt($interval_opt, $host);
    return 0 if ($interval // 0) == 'inf';
    return 1 if !exists $recap{$host};
    return 1 if !exists $recap{$host}{$time} || !$recap{$host}{$time};
    return 1 if !$interval;
    return $now > ($recap{$host}{$time} + $interval);
}



######################################################################
## check_value
######################################################################
sub check_value {
    my ($orig, $def) = @_;
    my $value = $orig;
    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.
        die("$type is required\n");

    } elsif ($type eq T_DELAY) {
        $value = interval($value);
        $value = $min if defined($value) && defined($min) && $value < $min;

    } elsif ($type eq T_NUMBER) {
        die("invalid $type: $orig\n") 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 {
            die("invalid $type: $orig\n");
        }
    } elsif ($type eq T_FQDN) {
        $value = lc $value;
        die("invalid $type: $orig\n") if ($value ne '' || $required) && $value !~ /[^.]\.[^.]/;

    } elsif ($type eq T_FQDNP) {
        $value = lc $value;
        die("invalid $type: $orig\n") if $value !~ /[^.]\.[^.].*(:\d+)?$/;

    } elsif ($type eq T_PROTO) {
        $value = lc $value;
        die("invalid $type: $orig\nSupported values: ", join(' ', sort(keys(%protocols))), "\n")
            if !exists $protocols{$value};

    } elsif ($type eq T_URL) {
        die("invalid $type: $orig\n")
            if $value !~ qr{^(?i:https?://)?[^./]+(\.[^./]+)+(:\d+)?(/[^/]+)*/?$};

    } elsif ($type eq T_USE) {
        $value = lc $value;
        $value = 'disabled' if $value eq 'no';  # backwards compatibility
        die(map(($_, "\n"), "invalid $type: $orig", 'Supported values:', ip_strategies_usage()))
            if !exists($ip_strategies{$value});

    } elsif ($type eq T_USEV4) {
        $value = lc $value;
        die(map(($_, "\n"), "invalid $type: $orig", 'Supported values:', ipv4_strategies_usage()))
            if !exists($ipv4_strategies{$value});

    } elsif ($type eq T_USEV6) {
        $value = lc $value;
        $value = 'disabled' if $value eq 'no';  # backwards compatibility
        die(map(($_, "\n"), "invalid $type: $orig", 'Supported values:', ipv6_strategies_usage()))
            if !exists($ipv6_strategies{$value});

    } elsif ($type eq T_FILE) {
        die("invalid $type: $orig\n") if $value eq "";

    } elsif ($type eq T_IF) {
        die("invalid $type: $orig\n") if $value !~ /^[a-zA-Z0-9:._-]+$/;

    } elsif ($type eq T_PROG) {
        die("invalid $type: $orig\n") if $value eq "";

    } elsif ($type eq T_LOGIN) {
        die("invalid $type: $orig\n") if $value eq "";

    } elsif ($type eq T_IP) {
        die("invalid $type: $orig\n") if !is_ipv4($value) && !is_ipv6($value);

    } elsif ($type eq T_IPV4) {
        die("invalid $type: $orig\n") if !is_ipv4($value);

    } elsif ($type eq T_IPV6) {
        die("invalid $type: $orig\n") if !is_ipv6($value);

    }
    return $value;
}

######################################################################
## 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 {
    local $_l = pushlogctx('HTTP request');
    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 = ();

    ## canonify use_ssl, proxy and url
    if ($url =~ /^https:/) {
        $use_ssl = 1;
    } elsif ($url =~ /^http:/) {
        $use_ssl = 0;
    } elsif (opt('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')) {
        info("would request: ${protocol}://${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}").'"');
        push(@curlopt, map('header="' . escape_curl_param($_) . '"',
                           ref($headers) eq 'ARRAY' ? @$headers : split('\n', $headers)));

        # 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}");
        debug(ctx => 'REQUEST', "curl config:\n" . join("\n", @curlopt));
        $reply = curl_cmd(@curlopt);
        debug(ctx => 'RESPONSE', defined($reply) ? "reply:\n$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});
            }
        }
    }
    $reply =~ s/\r//g if defined $reply;
    return $reply;
}

# Collects and returns all configuration data that get_ip* needs to determine the IP address.  This
# makes it possible to avoid redundant queries by comparing the configuration data for different
# hosts.
sub strategy_inputs {
    my ($whichuse, $h) = @_;
    my $use = opt($whichuse, $h);
    my $strategies
        = $whichuse eq 'use' ? \%ip_strategies
        : $whichuse eq 'usev4' ? \%ipv4_strategies
        : $whichuse eq 'usev6' ? \%ipv6_strategies
        : undef;
    my $s = $strategies->{$use};
    my @v = @{$s->{inputs} // []};
    return map({ $_ => opt($_, $h); } $whichuse, @v);
}

######################################################################
## get_ip
######################################################################
sub get_ip {
    my %p = @_;
    my ($ip, $reply, $url, $skip) = (undef, '');
    my $argvar = $p{'use'};
    # Note that --use=firewallname uses --fw=arg, not --firewallname=arg.
    $argvar = 'fw' if $builtinfw{$p{'use'}};
    my $arg = $p{$argvar};
    local $_l = pushlogctx("use=$p{'use'} $argvar=" . ($arg // '<undefined>'));

    if ($p{'use'} eq 'ip') {
        $ip = $arg;
        if (!is_ipv4($ip) && !is_ipv6($ip)) {
            warning('not a valid IPv4 or IPv6 address');
            $ip = undef;
        }
    } elsif ($p{'use'} eq 'if') {
        $ip = get_ip_from_interface($arg);
    } elsif ($p{'use'} eq 'cmd') {
        if ($arg) {
            $skip = $p{'cmd-skip'};
            $reply = `$arg`;
            $reply = '' if $?;
        }
    } elsif ($p{'use'} eq 'web') {
        $url = $arg;
        $skip = $p{'web-skip'};
        if (my $biw = $builtinweb{$url}) {
            warning("'$arg' is deprecated: $biw->{deprecated}") if $biw->{deprecated};
            $skip //= $biw->{skip};
            $url = $biw->{url};
        }
        if ($url) {
            $reply = geturl(
                proxy => opt('proxy'),
                url => $url,
                ssl_validate => $p{'web-ssl-validate'},
            );
            if (header_ok($reply, \&warning)) {
                $reply =~ s/^.*?\n\n//s;
            } else {
                $reply = undef;
            }
        }
    } elsif ($p{'use'} eq 'disabled') {
        ## This is a no-op... Do not get an IP address for this host/service
        $reply = '';
    } elsif ($p{'use'} eq 'fw' || defined(my $fw = $builtinfw{$p{'use'}})) {
        $url = $arg;
        $skip = $p{'fw-skip'};
        if ($fw) {
            $skip //= $fw->{'skip'};
            if (defined(my $query = $fw->{'query'})) {
                $url = undef;
                $reply = $query->(%p);
            } else {
                $url = "http://$url$fw->{'url'}" unless $url =~ /\//;
            }
        }
        if ($url) {
            $reply = geturl(
                url => $url,
                login => $p{'fw-login'},
                password => $p{'fw-password'},
                ignore_ssl_option => 1,
                ssl_validate => $p{'fw-ssl-validate'},
            );
            if (header_ok($reply, \&warning)) {
                $reply =~ s/^.*?\n\n//s;
            } else {
                $reply = undef;
            }
        }
    } else {
        warning("ignoring unsupported '--use' strategy: $p{'use'}");
    }
    if (!defined $reply) {
        $reply = '';
    }
    if (($skip // '') ne '') {
        $skip  =~ s/ /\\s/is;
        $reply =~ s/^.*?${skip}//is;
    }
    $ip //= extract_ipv4($reply) // extract_ipv6($reply);
    if ($p{'use'} ne 'ip' && ($ip // '') eq '0.0.0.0') {
        $ip = undef;
    }
    warning('did not find an IPv4 or IPv6 address') if !defined($ip);
    debug("found IP address: $ip") if $ip;
    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 %p = @_;
    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 $argvar = $p{'usev4'};
    # Note that --usev4=firewallname uses --fwv4=arg, not --firewallname=arg.
    $argvar = (defined($p{'fwv4'}) || !defined($p{'fw'})) ? 'fwv4' : 'fw'
        if $builtinfw{$p{'usev4'}};
    my $arg = $p{$argvar};
    local $_l = pushlogctx("usev4=$p{'usev4'} $argvar=" . ($arg // '<undefined>'));

    if ($p{'usev4'} eq 'ipv4') {
        ## Static IPv4 address is provided in "ipv4=<address>"
        $ipv4 = $arg;
        if (!is_ipv4($ipv4)) {
            warning('not a valid IPv4 address');
            $ipv4 = undef;
        }
    } elsif ($p{'usev4'} eq 'ifv4') {
        ## Obtain IPv4 address from interface mamed in "ifv4=<if>"
        $ipv4 = get_ip_from_interface($arg, 4);
    } elsif ($p{'usev4'} eq 'cmdv4') {
        ## Obtain IPv4 address by executing the command in "cmdv4=<command>"
        warning("'--cmd-skip' ignored for '--usev4=$p{'usev4'}'")
            if (opt('verbose') && $p{'cmd-skip'});
        if ($arg) {
            my $sys_cmd = quotemeta($arg);
            $reply = qx{$sys_cmd};
            $reply = '' if $?;
        }
    } elsif ($p{'usev4'} eq 'webv4') {
        ## Obtain IPv4 address by accessing website at url in "webv4=<url>"
        $url = $arg;
        $skip = $p{'webv4-skip'};
        if (my $biw = $builtinweb{$url}) {
            warning("'$arg' is deprecated: $biw->{deprecated}") if $biw->{deprecated};
            $skip //= $biw->{skip};
            $url = $biw->{url};
        }
        if ($url) {
            $reply = geturl(
                proxy => opt('proxy'),
                url => $url,
                ipversion => 4, # when using a URL to find IPv4 address we should force use of IPv4
                ssl_validate => $p{'web-ssl-validate'},
            );
            if (header_ok($reply, \&warning)) {
                $reply =~ s/^.*?\n\n//s;
            } else {
                $reply = undef;
            }
        }
    } elsif ($p{'usev4'} eq 'disabled') {
        ## This is a no-op... Do not get an IPv4 address for this host/service
        $reply = '';
    } elsif ($p{'usev4'} eq 'fwv4' || defined(my $fw = $builtinfw{$p{'usev4'}})) {
        warning("'--fw' is deprecated; use '--fwv4' instead")
            if (!defined($p{'fwv4'}) && defined($p{'fw'}));
        warning("'--fw-skip' is deprecated; use '--fwv4-skip' instead")
            if (!defined($p{'fwv4-skip'}) && defined($p{'fw-skip'}));
        $url = $arg;
        $skip = $p{'fwv4-skip'} // $p{'fw-skip'};
        if ($fw) {
            $skip //= $fw->{'skip'};
            if (defined(my $query = $fw->{'queryv4'})) {
                $url = undef;
                $reply = $query->(%p);
            } else {
                $url = "http://$url$fw->{'url'}" unless $url =~ /\//;
            }
        }
        if ($url) {
            $reply = geturl(
                url => $url,
                login => $p{'fw-login'},
                password => $p{'fw-password'},
                ipversion => 4, # when using a URL to find IPv4 address we should force use of IPv4
                ignore_ssl_option => 1,
                ssl_validate => $p{'fw-ssl-validate'},
            );
            if (header_ok($reply, \&warning)) {
                $reply =~ s/^.*?\n\n//s;
            } else {
                $reply = undef;
            }
        }
    } else {
        warning("ignoring unsupported '--usev4' strategy: $p{'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 (($p{'usev4'} ne 'ipv4') && (($ipv4 // '') eq '0.0.0.0'));
    warning('did not find an IPv4 address') if !defined($ipv4);
    debug("found IPv4 address: $ipv4") if $ipv4;
    return $ipv4;
}

######################################################################
## get_ipv6
######################################################################
sub get_ipv6 {
    my %p = @_;
    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 $argvar = $p{'usev6'};
    if (grep($p{'usev6'} eq $_, qw(ip if cmd web))) {
        my $new = $p{'usev6'} . 'v6';
        warning("'--usev6=$p{'usev6'}' is deprecated; use '--usev6=$new'");
        $argvar = $new if defined($p{$new});
    }
    # Note that --usev6=firewallname uses --fwv6=arg, not --firewallname=arg.
    $argvar = 'fwv6' if $builtinfw{$p{'usev6'}};
    my $arg = $p{$argvar};
    local $_l = pushlogctx("usev6=$p{'usev6'} $argvar=" . ($arg // '<undefined>'));

    if ($p{'usev6'} eq 'ipv6' || $p{'usev6'} eq 'ip') {
        ## Static IPv6 address is provided in "ipv6=<address>"
        $ipv6 = $arg;
        if (!is_ipv6($ipv6)) {
            warning('not a valid IPv6 address');
            $ipv6 = undef;
        }
    } elsif ($p{'usev6'} eq 'ifv6' || $p{'usev6'} eq 'if') {
        ## Obtain IPv6 address from interface mamed in "ifv6=<if>"
        $ipv6 = get_ip_from_interface($arg, 6);
    }  elsif ($p{'usev6'} eq 'cmdv6' || $p{'usev6'} eq 'cmd') {
        ## Obtain IPv6 address by executing the command in "cmdv6=<command>"
        warning("'--cmd-skip' ignored") if opt('verbose') && p{'cmd-skip'};
        if ($arg) {
            my $sys_cmd = quotemeta($arg);
            $reply = qx{$sys_cmd};
            $reply = '' if $?;
        }
    } elsif ($p{'usev6'} eq 'webv6' || $p{'usev6'} eq 'web') {
        ## Obtain IPv6 address by accessing website at url in "webv6=<url>"
        warning("'--web-skip' ignored; use '--webv6-skip' instead")
            if (!defined($p{'webv6-skip'}) && defined($p{'web-skip'}));
        $url = $arg;
        $skip = $p{'webv6-skip'};
        if (my $biw = $builtinweb{$url}) {
            warning("'--webv6=$url' is deprecated!  $biw->{deprecated}") if $biw->{deprecated};
            $skip //= $biw->{skip};
            $url = $biw->{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 => $p{'web-ssl-validate'},
            );
            if (header_ok($reply, \&warning)) {
                $reply =~ s/^.*?\n\n//s;
            } else {
                $reply = undef;
            }
        }
    } elsif ($p{'usev6'} eq 'disabled') {
        $reply = '';
    } elsif ($p{'usev6'} eq 'fwv6' || defined(my $fw = $builtinfw{$p{'usev6'}})) {
        $skip = $p{'fwv6-skip'} // $fw->{'skip'};
        if ($fw && defined(my $query = $fw->{'queryv6'})) {
            $skip //= $fw->{'skip'};
            $reply = $query->(%p);
        } else {
            warning("not implemented (does nothing)");
        }
    } else {
        warning("ignoring unsupported '--usev6' strategy: $p{'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 (($p{'usev6'} ne 'ipv6') && ($p{'usev6'} ne 'ip') && (($ipv6 // '') eq '::'));
    warning('did not find an IPv6 address') if !defined($ipv6);
    debug("found IPv6 address: $ipv6") if $ipv6;
    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;
    for my $h (@$hosts) {
        my %cfg = map({ ($_ => opt($_, $h)); } grep(defined(opt($_, $h)), @attrs));
        my $sig = repr(\%cfg, Indent => 0);
        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 $example = $protocols{$p}->examples();
        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) = @_;
    my $protocol = $protocols{opt('protocol', $host)};
    my $update = 0;
    my $ipv4   = $config{$host}{'wantipv4'};
    my $ipv6   = $config{$host}{'wantipv6'};
    my $inv_ip_warn_count = opt('max-warn');
    my $previp = $recap{$host}{'ip'} || '<nothing>';
    my $previpv4 = $recap{$host}{'ipv4'} || '<nothing>';
    my $previpv6 = $recap{$host}{'ipv6'} || '<nothing>';
    my %prettyt = map({ ($_ => $recap{$host}{$_} ? prettytime($recap{$host}{$_}) : '<never>'); }
                      qw(atime mtime wtime));
    my %prettyi = map({ ($_ => prettyinterval(opt($_, $host))); }
                      qw(max-interval min-error-interval min-interval));

    $warned_ipv4{$host} = 0 if defined($ipv4);
    $warned_ipv6{$host} = 0 if defined($ipv6);

    if (opt('force')) {
        info("update forced via 'force' option");
        $update = 1;

    } elsif (!exists($recap{$host})) {
        info("update forced because the time of the previous update (or attempt) is unknown");
        $update = 1;

    } elsif ($recap{$host}{'wtime'} && $recap{$host}{'wtime'} > $now) {
        warning("cannot update IP until after $prettyt{'wtime'}");

    } elsif ($recap{$host}{'mtime'} && interval_expired($host, 'mtime', 'max-interval')) {
        info("update forced because it has been $prettyi{'max-interval'} since the previous update (on $prettyt{'mtime'})");
        $update = 1;

    } elsif (defined($ipv4) && $previpv4 ne $ipv4) {
        if (($recap{$host}{'status-ipv4'} // '') eq 'good' &&
            !interval_expired($host, 'mtime', 'min-interval')) {
            warning("skipped update from $previpv4 to $ipv4 because it has been less than $prettyi{'min-interval'} since the previous update (on $prettyt{'mtime'})")
                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("skipped update from $previpv4 to $ipv4 because it has been less than $prettyi{'min-error-interval'} since the previous update attempt (on $prettyt{'atime'}), which failed");
                if (!$ipv4 && !opt('verbose')) {
                    $warned_ipv4{$host} = ($warned_ipv4{$host} // 0) + 1;
                    warning("IPv4 address undefined. Warned $inv_ip_warn_count times, suppressing further warnings")
                        if ($warned_ipv4{$host} >= $inv_ip_warn_count);
                }
            }

            $recap{$host}{'warned-min-error-interval'} = $now;

        } else {
            $update = 1;
        }

    } elsif (defined($ipv6) && $previpv6 ne $ipv6) {
        if (($recap{$host}{'status-ipv6'} // '') eq 'good' &&
            !interval_expired($host, 'mtime', 'min-interval')) {
            warning("skipped update from $previpv6 to $ipv6 because it has been less than $prettyi{'min-interval'} since the previous update (on $prettyt{'mtime'})")
                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("skipped update from $previpv6 to $ipv6 because it has been less than $prettyi{'min-error-interval'} since the previous update attempt (on $prettyt{'atime'}, which failed");
                if (!$ipv6 && !opt('verbose')) {
                    $warned_ipv6{$host} = ($warned_ipv6{$host} // 0) + 1;
                    warning("IPv6 address undefined. Warned $inv_ip_warn_count times, suppressing further warnings")
                        if ($warned_ipv6{$host} >= $inv_ip_warn_count);
                }
            }

            $recap{$host}{'warned-min-error-interval'} = $now;

        } else {
            $update = 1;
        }

    } elsif ($protocol->force_update($host)) {
        $update = 1;
    } else {
        if (opt('verbose')) {
            success("skipped update because IPv4 address is already set to $ipv4")
                if defined($ipv4);
            success("skipped update because IPv6 address is already set to $ipv6")
                if defined($ipv6);
        }
    }
    return $update;
}

######################################################################
## header_ok
######################################################################
sub header_ok {
    my ($line, $errlog) = @_;
    $errlog //= \&failed;
    if (!$line) {
        $errlog->("no response from server");
        return 0;
    }
    $line =~ s/\r?\n.*//s;
    my ($code, $msg) = ($line =~ qr%^\s*HTTP/.*\s+(\d+)\s*(?:\s+([^\s].*))?$%i);
    if (!defined($code)) {
        $errlog->("unexpected HTTP response: $line");
        return 0;
    } elsif ($code !~ qr/^2\d\d$/) {
        my %msgs = (
            '401' => 'authentication failed',
            '403' => 'not authorized',
        );
        $errlog->("$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 {
    my $self = shift;
    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 {
    my $self = shift;
    ## update each configured host
    for my $h (@_) {
        local $_l = pushlogctx($h);
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to $ip");

        my $url;
        $url  = 'https://' . opt('server', $h) . '/nic/';
        $url .= ynu(opt('static', $h), 'statdns', 'dyndns', 'dyndns');
        $url .= "?action=edit&started=1&hostname=YES&host_id=$h";
        $url .= "&myip=";
        $url .= $ip            if $ip;
        $url .= "&wildcard=ON" if ynu(opt('wildcard', $h), 1, 0, 0);
        if (opt('mx', $h)) {
            $url .= '&mx=' . opt('mx', $h);
            $url .= "&backmx=" . ynu(opt('backupmx', $h), 'YES', 'NO');
        }

        my $reply = geturl(
            proxy => opt('proxy'),
            url => $url,
            login => opt('login', $h),
            password => opt('password', $h),
        );
        next if !header_ok($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) {
            $recap{$h}{'status'} = 'failed';
            $title = 'incomplete response from ' . opt('server', $h) unless $title;
            warning("SENT:    %s", $url) unless opt('verbose');
            warning("REPLIED: %s", $reply);
            failed($title);
            next;
        }
        $recap{$h}{'ip'} = $ip;
        $recap{$h}{'mtime'} = $now;
        $recap{$h}{'status'} = 'good';
        success("$return_code: IP address set to $ip ($title)");
    }
}

######################################################################
## nic_dyndns2_examples
######################################################################
sub nic_dyndns2_examples {
    my $self = shift;
    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 {
    my $self = shift;
    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);
        local $_l = pushlogctx($hosts);
        my $ipv4 = $groupcfg{'wantipv4'};
        my $ipv6 = $groupcfg{'wantipv6'};
        delete $config{$_}{'wantipv4'} for @hosts;
        delete $config{$_}{'wantipv6'} for @hosts;
        info("setting IPv4 address to $ipv4") if $ipv4;
        info("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'},
        );
        next if !header_ok($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);
        # 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.
        #
        # If there is only one result for multiple hosts, this function assumes the one result
        # applies to all hosts.  According to the documentation quoted above this should only
        # happen if the result is a failure.  In case there is a single successful result, this
        # code applies the success to all hosts (with a warning) to maximize potential
        # compatibility with all DynDNS-like services.  If there are zero results, or two or more
        # results, any host without a corresponding result line is treated as a failure.
        #
        # TODO: The DynDNS documentation does not mention 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 collection
        # of addresses 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?
        my @statuses = map({ (my $l = $_) =~ s/ .*$//; $l; } @reply);
        if (@statuses < @hosts && @statuses == 1) {
            warning("service returned one successful result for multiple hosts; " .
                    "assuming the one success is intended to apply to all hosts")
                if $statuses[0] =~ qr/^(?:good|nochg)$/;
            @statuses = ($statuses[0]) x @hosts;
        }
        for (my $i = 0; $i < @hosts; ++$i) {
            my $h = $hosts[$i];
            local $_l = $_l->{parent}; $_l = pushlogctx($h);
            my $status = $statuses[$i] // 'unknown';
            if ($status eq 'nochg') {
                warning("$status: $errors{$status}");
                $status = 'good';
            }
            $recap{$h}{'status-ipv4'} = $status if $ipv4;
            $recap{$h}{'status-ipv6'} = $status if $ipv6;
            if ($status ne 'good') {
                if (exists($errors{$status})) {
                    failed("$status: $errors{$status}");
                } elsif ($status eq 'unknown') {
                    failed('server did not return a success/fail result; assuming failure');
                } else {
                    # This case can only happen if there is a corresponding status line for this
                    # host or there was only one status line for all hosts.
                    failed("unexpected status: " . ($reply[$i] // $reply[0]));
                }
                next;
            }
            # 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).
            $recap{$h}{'ipv4'} = $ipv4 if $ipv4;
            $recap{$h}{'ipv6'} = $ipv6 if $ipv6;
            $recap{$h}{'mtime'} = $now;
            success("IPv4 address set to $ipv4") if $ipv4;
            success("IPv6 address set to $ipv6") if $ipv6;
        }
        warning("unexpected extra lines after per-host update status lines:\n" .
                join("\n", @reply[@hosts..$#reply]))
            if (@reply > @hosts);
    }
}

######################################################################
## nic_dnsexit2_examples
######################################################################
sub nic_dnsexit2_examples {
    my $self = shift;
    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 {
    my $self = shift;
    # 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 if !defined(opt('zone', $h));
        dnsexit2_update_host($h);
    }
}

sub dnsexit2_update_host {
    my ($h) = @_;
    local $_l = pushlogctx($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.
    my $zone = opt('zone', $h);
    if ($name =~ s/(?:^|\.)\Q$zone\E$//) {
        # The zone was successfully trimmed from $name.
    } else {
        fatal("hostname does not end with the zone: " . opt('zone', $h));
    }
    # 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("updating IPv$ipv address to $ip");
        $recap{$h}{"status-ipv$ipv"} = 'failed';
        push(@updates, {
            name => $name,
            type => ($ipv eq '6') ? 'AAAA' : 'A',
            content => $ip,
            ttl => opt('ttl', $h),
        });
    };
    my $url = opt('server', $h) . opt('path', $h);
    my $reply = geturl(
        proxy => opt('proxy'),
        url => $url,
        headers => [
            'Content-Type: application/json',
            'Accept: application/json',
        ],
        method => 'POST',
        data => encode_json({
            apikey => opt('password', $h),
            domain => $zone,
            update => \@updates,
        }),
    );
    return if !header_ok($reply);
    (my $body = $reply) =~ s/^.*?\r?\n\r?\n//s;
    my $response = eval { decode_json($body); };
    if (ref($response) ne 'HASH') {
        failed("response is not a JSON object:\n$body");
        return;
    }
    if (!defined($response->{'code'}) || !defined($response->{'message'})) {
        failed("missing 'code' and 'message' properties in server response:\n$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("unknown status code: $response->{'code'}");
        return;
    }
    my ($status, $message) = @{$codemeaning{$response->{'code'}}};
    info("$status: $message");
    info("server message: $response->{'message'}");
    info("server details: " .
         (defined($response->{'details'}) ? $response->{'details'}[0] : "no details received"));
    if ($status ne 'good') {
        if ($status eq 'warning') {
            warning($message);
            warning("server response: $response->{'message'}");
        } elsif ($status =~ m'^(badauth|error)$') {
            failed($message);
            failed("server response: $response->{'message'}");
        } else {
            failed("unexpected status: $status");
        }
        return;
    }
    success($message);
    $recap{$h}{'mtime'} = $now;
    keys(%ips);  # Reset internal iterator.
    while (my ($ipv, $ip) = each(%ips)) {
        $recap{$h}{"ipv$ipv"} = $ip;
        $recap{$h}{"status-ipv$ipv"} = 'good';
        success("updated IPv$ipv address to $ip");
    }
}

######################################################################
## nic_noip_update
## Note: uses same features as nic_dyndns2_update, less return codes
######################################################################
sub nic_noip_update {
    my $self = shift;
    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);
        local $_l = pushlogctx($hosts);
        my $ipv4 = $groupcfg{'wantipv4'};
        my $ipv6 = $groupcfg{'wantipv6'};
        delete $config{$_}{'wantipv4'} for @hosts;
        delete $config{$_}{'wantipv6'} for @hosts;

        info("setting IPv4 address to $ipv4") if $ipv4;
        info("setting IPv6 address to $ipv6") if $ipv6;

        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'},
        );
        next if !header_ok($reply);
        (my $body = $reply) =~ s/^.*?\n\n//s or do {
            failed("request to $groupcfg{'server'} failed");
            next;
        };
        my @reply = split(/\n/, $body);
        for my $line (@reply) {
            my ($status, $returnedips) = split / /, lc $line;
            my $h = shift @hosts;
            local $_l = $_l->{parent}; $_l = pushlogctx($h);

            for my $ip (split_by_comma($returnedips)) {
                next if (!$ip);
                my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4';
                $recap{$h}{"status-ipv$ipv"} = $status;
            }

            if ($status eq 'good') {
                $recap{$h}{'mtime'} = $now;
                for my $ip (split_by_comma($returnedips)) {
                    next if (!$ip);
                    my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4';
                    $recap{$h}{"ipv$ipv"} = $ip;
                    success("$status: IPv$ipv address set to $ip");
                }

            } elsif (exists $errors{$status}) {
                if ($status eq 'nochg') {
                    warning("$status: $errors{$status}");
                    $recap{$h}{'mtime'} = $now;
                    for my $ip (split_by_comma($returnedips)) {
                        next if (!$ip);
                        my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4';
                        $recap{$h}{"ipv$ipv"} = $ip;
                        $recap{$h}{"status-ipv$ipv"} = 'good';
                    }
                } else {
                    failed("$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;
                $recap{$h}{'wtime'} = $now + $sec;
                warning("$status: wait $wait $units before further updates");

            } else {
                failed("unexpected status: $line");
            }
        }
    }
}

######################################################################
## nic_noip_examples
######################################################################
sub nic_noip_examples {
    my $self = shift;
    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 {
    my $self = shift;
    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 {
    my $self = shift;
    ## update each configured host
    for my $h (@_) {
        local $_l = pushlogctx($h);
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to $ip");

        my $url;
        $url  = 'https://' . opt('server', $h) . '/nic/';
        $url .= ynu(opt('static', $h), '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 => opt('login', $h),
            password => opt('password', $h),
        ) // '';
        if ($reply eq '') {
            failed("request to " . opt('server', $h) . " failed");
            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/) {
            $recap{$h}{'status'} = 'failed';
            failed($reply);
            next;
        }
        $recap{$h}{'ip'} = $ip;
        $recap{$h}{'mtime'} = $now;
        $recap{$h}{'status'} = 'good';
        success("$return_code: IP address set to $ip");
    }
}

######################################################################
## nic_domeneshop_examples
######################################################################
sub nic_domeneshop_examples {
    my $self = shift;
    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 {
    my $self = shift;
    for my $h (@_) {
        local $_l = pushlogctx($h);
        for my $ipv ('4', '6') {
            my $ip = delete $config{$h}{"wantipv$ipv"} or next;
            info("setting IPv$ipv address to $ip");
            my $reply = geturl(
                proxy => opt('proxy'),
                url => opt('server', $h) . "/v0/dyndns/update?hostname=$h&myip=$ip",
                login => opt('login', $h),
                password => opt('password', $h),
            );
            next if !header_ok($reply);
            $recap{$h}{"ipv$ipv"} = $ip;
            $recap{$h}{'mtime'} = $now;
            $recap{$h}{"status-ipv$ipv"} = 'good';
            success("IPv$ipv address set to $ip");
        }
    }
}


######################################################################
## nic_zoneedit1_examples
######################################################################
sub nic_zoneedit1_examples {
    my $self = shift;
    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_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 {
    my $self = shift;
    for my $group (group_hosts_by(\@_, qw(login password server zone wantip))) {
        my @hosts = @{$group->{hosts}};
        my %groupcfg = %{$group->{cfg}};
        my $hosts = join(',', @hosts);
        local $_l = pushlogctx($hosts);
        my $ip = $groupcfg{'wantip'};
        delete $config{$_}{'wantip'} for @hosts;

        info("setting IP address to $ip");

        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'},
        );
        next if !header_ok($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) {
            local $_l = $_l->{parent}; $_l = pushlogctx($h);
            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')) {
                        $recap{$h}{'ip'} = $status_ip;
                        $recap{$h}{'mtime'} = $now;
                        $recap{$h}{'status'} = 'good';

                        success("IP address set to $ip ($status_code: $status_text)");

                    } else {
                        $recap{$h}{'status'} = 'failed';
                        failed("$status_code: $status_text");
                    }
                    shift @hosts;
                    $h = $hosts[0];
                    $hosts = join(',', @hosts);
                }
                $line = $rest;
                redo if $line;
            }
        }
        if (@hosts) {
            # @hosts was potentially mutated so redo the log context.
            local $_l = $_l->{parent}; $_l = pushlogctx(join(',', @hosts));
            failed("no response from $groupcfg{'server'}");
        }
    }
}

######################################################################
## nic_easydns_examples
######################################################################
sub nic_easydns_examples {
    my $self = shift;
    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 {
    my $self = shift;
    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 (@_) {
        local $_l = pushlogctx($h);
        for my $ipv ('4', '6') {
            my $ip = delete $config{$h}{"wantipv$ipv"} or next;
            info("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://" . opt('server', $h) . opt('script', $h) . "?hostname=$h&myip=$ip";
            $url .= "&wildcard=" . ynu(opt('wildcard', $h), 'ON', 'OFF', 'OFF')
                if defined(opt('wildcard', $h));
            $url .= "&mx=" . opt('mx', $h) . "&backmx=" . ynu(opt('backupmx', $h), 'YES', 'NO')
                if opt('mx', $h);
            my $reply = geturl(
                proxy => opt('proxy'),
                url => $url,
                login => opt('login', $h),
                password => opt('password', $h),
            );
            next if !header_ok($reply);
            (my $body = $reply) =~ s/^.*?\n\n//s or do {
                failed("could not connect to " . opt('server', $h));
                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$/;
            $recap{$h}{"status-ipv$ipv"} = $status;
            if ($status ne 'good') {
                if (exists $errors{$status}) {
                    failed("$status: $errors{$status}");
                } else {
                    failed("unexpected result: $body");
                }
                next;
            }
            $recap{$h}{"ipv$ipv"} = $ip;
            $recap{$h}{'mtime'} = $now;
            success("IPv$ipv address set to $ip");
        }
    }
}

######################################################################
## nic_namecheap_examples
######################################################################
sub nic_namecheap_examples {
    my $self = shift;
    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 {
    my $self = shift;
    ## update each configured host
    for my $h (@_) {
        local $_l = pushlogctx($h);
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to $ip");

        my $url;
        $url = 'https://' . opt('server', $h) . '/update';
        my $domain = opt('login', $h);
        my $host   = $h;
        $host =~ s/(.*)\.$domain(.*)/$1$2/;
        $url .= "?host=$host";
        $url .= "&domain=$domain";
        $url .= '&password=' . opt('password', $h);
        $url .= "&ip=";
        $url .= $ip if $ip;

        my $reply = geturl(proxy => opt('proxy'), url => $url);
        next if !header_ok($reply);

        my @reply = split /\n/, $reply;
        if (grep /<ErrCount>0/i, @reply) {
            $recap{$h}{'ip'} = $ip;
            $recap{$h}{'mtime'} = $now;
            $recap{$h}{'status'} = 'good';
            success("IP address set to $ip");
        } else {
            $recap{$h}{'status'} = 'failed';
            failed("invalid reply: $reply");
        }
    }
}

######################################################################

######################################################################
## nic_nfsn_examples
######################################################################
sub nic_nfsn_examples {
    my $self = shift;
    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 .= opt('login', $h) . ';';

    ## 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 = opt('login', $h) . ';' .
              $timestamp . ';' .
              $salt . ';' .
              opt('password', $h) . ';';

    ## 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://' . opt('server', $h);
    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: $resp");
        return;
    }

    failed("%s", $json->{'error'});
    if (defined $json->{'debug'}) {
        failed($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 {
    my $self = shift;
    ## update each configured host
    for my $h (@_) {
        local $_l = pushlogctx($h);
        my $zone = opt('zone', $h);
        my $name;

        if ($h eq $zone) {
            $name = '';
        } elsif ($h !~ /$zone$/) {
            $recap{$h}{'status'} = 'failed';
            failed("$h is outside zone $zone");
            next;
        } else {
            $name = $h;
            $name =~ s/(.*)\.${zone}$/$1/;
        }

        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to $ip");

        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($list_resp)) {
            $recap{$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 ($@) {
            $recap{$h}{'status'} = 'failed';
            failed("JSON decoding failure");
            next;
        }

        my $rr_ttl = opt('ttl', $h);

        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($rm_resp)) {
                $recap{$h}{'status'} = 'failed';
                nic_nfsn_handle_error($rm_resp, $h);
                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($add_resp)) {
            $recap{$h}{'ip'} = $ip;
            $recap{$h}{'mtime'} = $now;
            $recap{$h}{'status'} = 'good';
            success("IP address set to $ip");
        } else {
            $recap{$h}{'status'} = 'failed';
            nic_nfsn_handle_error($add_resp, $h);
        }
    }
}

######################################################################

######################################################################
## nic_njalla_examples
######################################################################
sub nic_njalla_examples {
    my $self = shift;
    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 {
    my $self = shift;
    for my $h (@_) {
        local $_l = pushlogctx($h);
        # Read input params
        my $ipv4 = delete $config{$h}{'wantipv4'};
        my $ipv6 = delete $config{$h}{'wantipv6'};
        my $quietreply = opt('quietreply', $h);
        my $ip_output = '';

        # Build url
        my $url = 'https://' . opt('server', $h) . "/update/?h=$h&k=" . opt('password', $h);
        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" . ($ip_output eq '') ? ' auto' : $ip_output);
        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("IP address set to $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("could not connect to " . opt('server', $h));
            } 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("IP address set to $response->{value}->{A}");
                } else {
                    failed("Unknown response");
                }
            }
        }
        if ($status eq 'good') {
            $recap{$h}{'ipv4'} = $ipv4 if $ipv4;
            $recap{$h}{'ipv6'} = $ipv6 if $ipv6;
        }
        $recap{$h}{'status-ipv4'} = $status if $ipv4;
        $recap{$h}{'status-ipv6'} = $status if $ipv6;
    }
}

######################################################################
## nic_sitelutions_examples
######################################################################
sub nic_sitelutions_examples {
    my $self = shift;
    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 {
    my $self = shift;
    ## update each configured host
    for my $h (@_) {
        local $_l = pushlogctx($h);
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to $ip");

        my $url;
        $url  = 'https://' . opt('server', $h) . '/dnsup';
        $url .= "?id=$h";
        $url .= '&user=' . opt('login', $h);
        $url .= '&pass=' . opt('password', $h);
        $url .= "&ip=";
        $url .= $ip if $ip;

        my $reply = geturl(proxy => opt('proxy'), url => $url);
        next if !header_ok($reply);

        my @reply = split /\n/, $reply;
        if (grep /success/i, @reply) {
            $recap{$h}{'ip'} = $ip;
            $recap{$h}{'mtime'} = $now;
            $recap{$h}{'status'} = 'good';
            success("IP address set to $ip");
        } else {
            $recap{$h}{'status'} = 'failed';
            warning("SENT:    %s", $url) unless opt('verbose');
            warning("REPLIED: %s", $reply);
            failed("invalid reply");
        }
    }
}

######################################################################

######################################################################
## nic_freedns_examples
######################################################################
sub nic_freedns_examples {
    my $self = shift;
    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 {
    my $self = shift;
    # 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://' . opt('server', $_[0]) . '/api/?action=getdyndns&v=2&sha=<credentials>';
    my $creds = sha1_hex(opt('login', $_[0]) . '|' . opt('password', $_[0]));
    (my $url = $url_tmpl) =~ s/<credentials>/$creds/;

    my $reply = geturl(proxy => opt('proxy'),
                       url => $url
                      );
    my $record_list_error = '';
    if (header_ok($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 (@_) {
        local $_l = pushlogctx($h);
        next if (!$h);
        my $ipv4 = delete $config{$h}{'wantipv4'};
        my $ipv6 = delete $config{$h}{'wantipv6'};

        if ($record_list_error ne '') {
            $recap{$h}{'status-ipv4'} = 'failed' if ($ipv4);
            $recap{$h}{'status-ipv6'} = 'failed' if ($ipv6);
            failed($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("cannot set IPv$ipv to $ip: no '$type' record at FreeDNS");
                next;
            }

            info("setting IP address to $ip");
            $recap{$h}{"status-ipv$ipv"} = 'failed';

            if ($ip eq $rec->[1]) {
                $recap{$h}{"ipv$ipv"} = $ip;
                $recap{$h}{'mtime'} = $now;
                $recap{$h}{"status-ipv$ipv"} = 'good';
                success("update not necessary, '$type' record already set to $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 (header_ok($reply)) {
                    $reply =~ s/^.*?\n\n//s;  # Strip the headers.
                    if ($reply =~ /Updated.*$h.*to.*$ip/) {
                        $recap{$h}{"ipv$ipv"} = $ip;
                        $recap{$h}{'mtime'} = $now;
                        $recap{$h}{"status-ipv$ipv"} = 'good';
                        success("IPv$ipv address set to $ip");
                    } else {
                        warning("SENT: %s", $url_tmpl) unless opt('verbose');
                        warning("REPLIED: %s", $reply);
                        failed("invalid reply");
                    }
                }
            }
        }
    }
}

######################################################################
## nic_1984_examples
######################################################################
sub nic_1984_examples {
    my $self = shift;
    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 {
    my $self = shift;
    for my $host (@_) {
        local $_l = pushlogctx($host);
        my $ip = delete $config{$host}{'wantip'};
        info("setting IP address to $ip");

        my $url;
        $url  = 'https://' . opt('server', $host) . '/1.0/freedns/';
        $url .= '?apikey=' . opt('password', $host);
        $url .= "&domain=$host";
        $url .= "&ip=$ip";

        my $reply = geturl(
            proxy => opt('proxy'),
            url => $url,
        );
        next if !header_ok($reply);

        # Strip header
        $reply =~ qr/{(?:[^{}]*|(?R))*}/mp;
        my $response = eval { decode_json(${^MATCH}) };
        if ($@) {
            failed("JSON decoding failure");
            next;
        }
        unless ($response->{ok}) {
            failed("%s", $response->{msg});
            next;
        }

        $recap{$host}{'status'} = 'good';
        $recap{$host}{'ip'} = $ip;
        if ($response->{msg} =~ /unaltered/) {
            success("skipped: IP was already set to $response->{ip}");
        } else {
            success("updated successfully to $response->{ip}");
        }
    }
}

######################################################################
## nic_changeip_examples
######################################################################
sub nic_changeip_examples {
    my $self = shift;
    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 {
    my $self = shift;
    ## update each configured host
    for my $h (@_) {
        local $_l = pushlogctx($h);
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to $ip");

        my $url;
        $url  = 'https://' . opt('server', $h) . '/nic/update';
        $url .= "?hostname=$h";
        $url .= "&ip=";
        $url .= $ip if $ip;

        my $reply = geturl(
            proxy => opt('proxy'),
            url => $url,
            login => opt('login', $h),
            password => opt('password', $h),
        );
        next if !header_ok($reply);

        my @reply = split /\n/, $reply;
        if (grep /success/i, @reply) {
            $recap{$h}{'ip'} = $ip;
            $recap{$h}{'mtime'} = $now;
            $recap{$h}{'status'} = 'good';
            success("IP address set to $ip");
        } else {
            $recap{$h}{'status'} = 'failed';
            warning("SENT:    %s", $url) unless opt('verbose');
            warning("REPLIED: %s", $reply);
            failed("invalid reply");
        }
    }
}

######################################################################
## nic_godaddy_examples
##
## written by awalon
##
######################################################################
sub nic_godaddy_examples {
    my $self = shift;
    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 {
    my $self = shift;
    for my $h (@_) {
        local $_l = pushlogctx($h);
        my $zone = opt('zone', $h);
        (my $hostname = $h) =~ s/\.\Q$zone\E$//;
        for my $ipv ('4', '6') {
            my $ip = delete($config{$h}{"wantipv$ipv"}) or next;
            info("setting IPv$ipv address to $ip");
            my $rrset_type = ($ipv eq '6') ? 'AAAA' : 'A';
            my $url = "https://" . opt('server', $h) . "/$zone/records/$rrset_type/$hostname";
            my $reply = geturl(
                proxy => opt('proxy'),
                url => $url,
                headers => [
                    'Content-Type: application/json',
                    'Accept: application/json',
                    "Authorization: sso-key " . opt('login', $h) . ":" . opt('password', $h),
                ],
                method => 'PUT',
                data => encode_json([{
                    data => $ip,
                    defined(opt('ttl', $h)) ? (ttl => opt('ttl', $h)) : (),
                    name => $hostname,
                    type => $rrset_type,
                }]),
            );
            unless ($reply) {
                failed("could not connect to " . opt('server', $h));
                next;
            }
            (my $code) = ($reply =~ m%^s*HTTP/.*\s+(\d+)%i);
            my $ok = header_ok($reply);
            $reply =~ s/^.*?\n\n//s;
            my $response = eval {decode_json($reply)};
            if (!defined($response)) {
                failed("unexpected or empty service response, cannot parse data");
                next;
            } elsif (defined($response->{code})) {
                info("$response->{code} - $response->{message}");
            }
            if (!$ok) {
                my $msg;
                if ($code eq "400") {
                    $msg = 'GoDaddy API URL ($url) was malformed.';
                } elsif ($code eq "401") {
                    if (opt('login', $h)) {
                        $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($msg);
                next;
            }
            $recap{$h}{"ipv$ipv"} = $ip;
            $recap{$h}{'mtime'} = $now;
            $recap{$h}{"status-ipv$ipv"} = 'good';
            success("updated successfully to $ip (status: $code)");
        }
    }
}

######################################################################
## nic_henet_examples
##
## written by Indrajit Raychaudhuri
##
######################################################################
sub nic_henet_examples {
    my $self = shift;
    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 {
    my $self = shift;
    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 (@_) {
        local $_l = pushlogctx($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$ipv address to $ip");
            my $reply = geturl(
                proxy => opt('proxy'),
                url => "https://" . opt('server', $h) . "/nic/update?hostname=$h&myip=$ip",
                login => $h,
                password => opt('password', $h),
            );
            next if !header_ok($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';
            $recap{$h}{"status-ipv$ipv"} = $status;
            if ($status ne 'good') {
                if (exists($errors{$status})) {
                    failed("$status: $errors{$status}");
                } else {
                    failed("unexpected status: $line");
                }
                next;
            }
            success("$status: IPv$ipv address set to $returnedip");
            $recap{$h}{"ipv$ipv"} = $returnedip;
            $recap{$h}{'mtime'} = $now;
        }
    }
}

######################################################################
## nic_mythicdyn_examples
##
## written by Reuben Thomas
##
######################################################################
sub nic_mythicdyn_examples {
    my $self = shift;
    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 {
    my $self = shift;
    # Update each configured host.
    for my $h (@_) {
        local $_l = pushlogctx($h);
        info("setting IP address");

        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." . opt('server', $h) . "/dns/v2/dynamic/$h",
                    method    => 'POST',
                    login     => opt('login', $h),
                    password  => opt('password', $h),
                    ipversion => $mythver,
                );
                my $ok = header_ok($reply);
                if ($ok) {
                    $recap{$h}{'mtime'} = $now;
                    $recap{$h}{"status-ipv$mythver"} = "good";

                    success("IPv$mythver updated successfully");
                }
            } else {
                info("No configuration for IPV%s -------------", $mythver);
            }
        }
    }
}

######################################################################
## nic_nsupdate_examples
######################################################################
sub nic_nsupdate_examples {
    my $self = shift;
    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 {
    my $self = shift;
    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);
        local $_l = pushlogctx($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 $ipv4") if $ipv4;
        info("setting IPv6 address to $ipv6") if $ipv6;

        ## 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 $_. ${\(opt('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'));
        debug("command: $command");
        debug("instructions:\n$instructions");

        my $status = pipecmd($command, $instructions);
        if ($status eq 1) {
            for (@hosts) {
                $recap{$_}{'mtime'} = $now;
                for my $ip ($ipv4, $ipv6) {
                    next if (!$ip);
                    my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4';
                    $recap{$_}{"ipv$ipv"} = $ip;
                    $recap{$_}{"status-ipv$ipv"} = 'good';
                }
            }
            success("IPv4 address set to $ipv4") if $ipv4;
            success("IPv6 address set to $ipv6") if $ipv6;
        } else {
            failed("error running command");
        }
    }
}

######################################################################

######################################################################
## nic_cloudflare_examples
##
## written by Ian Pye
##
######################################################################
sub nic_cloudflare_examples {
    my $self = shift;
    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 {
    my $self = shift;
    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) {
            local $_l = pushlogctx($domain);
            my $ipv4 = delete $config{$domain}{'wantipv4'};
            my $ipv6 = delete $config{$domain}{'wantipv6'};

            info('getting Cloudflare Zone ID');

            # Get zone ID
            my $url = "https://" . opt('server', $domain) . "/zones/?";
            $url .= "name=" . opt('zone', $domain);

            my $reply = geturl(proxy => opt('proxy'),
                               url => $url,
                               headers => $headers
                              );
            next if !header_ok($reply);
            # Strip header
            $reply =~ qr/{(?:[^{}]*|(?R))*}/mp;
            my $response = eval {decode_json(${^MATCH})};
            unless ($response && $response->{result}) {
                failed("invalid json or result");
                next;
            }

            # Pull the ID out of the json, messy
            my ($zone_id) = map {$_->{name} eq opt('zone', $domain) ? $_->{id} : ()} @{$response->{result}};
            unless ($zone_id) {
                failed("no zone ID found for zone " . opt('zone', $domain));
                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("setting IPv$ipv address to $ip");
                $recap{$domain}{"status-ipv$ipv"} = 'failed';

                # Get DNS 'A' or 'AAAA' record ID
                $url = "https://" . opt('server', $domain) . "/zones/$zone_id/dns_records?";
                $url .= "type=$type&name=$domain";
                $reply = geturl(proxy => opt('proxy'),
                                url => $url,
                                headers => $headers
                               );
                next if !header_ok($reply);
                # Strip header
                $reply =~ qr/{(?:[^{}]*|(?R))*}/mp;
                $response = eval {decode_json(${^MATCH})};
                unless ($response && $response->{result}) {
                    failed("invalid json or result");
                    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("cannot set IPv$ipv to $ip: no '$type' record at Cloudflare");
                    next;
                }
                debug("DNS '$type' record ID: $dns_rec_id");
                # Set domain
                $url = "https://" . opt('server', $domain) . "/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
                               );
                next if !header_ok($reply);
                # Strip header
                $reply =~ qr/{(?:[^{}]*|(?R))*}/mp;
                $response = eval {decode_json(${^MATCH})};
                if ($response && $response->{result}) {
                    success("IPv$ipv address set to $ip");
                    $recap{$domain}{"ipv$ipv"} = $ip;
                    $recap{$domain}{'mtime'} = $now;
                    $recap{$domain}{"status-ipv$ipv"} = 'good';
                } else {
                    failed("invalid json or result");
                }
            }
        }
    }
}

######################################################################
## nic_hetzner_examples
##
## written by Joerg Werner
##
######################################################################
sub nic_hetzner_examples {
    my $self = shift;
    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 {
    my $self = shift;
    for my $domain (@_) {
        local $_l = pushlogctx($domain);
        my $headers = "Auth-API-Token: " . opt('password', $domain) . "\n";
        $headers .= "Content-Type: application/json";

        my $zone = opt('zone', $domain);
        (my $hostname = $domain) =~ s/\Q.$zone\E$//;
        my $ipv4 = delete $config{$domain}{'wantipv4'};
        my $ipv6 = delete $config{$domain}{'wantipv6'};

        info("getting Hetzner Zone ID");

        # Get zone ID
        my $url = "https://" . opt('server', $domain) . "/zones?name=$zone";

        my $reply = geturl(proxy => opt('proxy'),
                           url => $url,
                           headers => $headers
                          );
        next if !header_ok($reply);
        # Strip header
        $reply =~ qr/{(?:[^{}]*|(?R))*}/mp;
        my $response = eval {decode_json(${^MATCH})};
        unless ($response && $response->{zones}) {
            failed("invalid json or result");
            next;
        }

        # Pull the ID out of the json, messy
        my ($zone_id) = map {$_->{name} eq $zone ? $_->{id} : ()} @{$response->{zones}};
        unless ($zone_id) {
            failed("no zone ID found for zone " . opt('zone', $domain));
            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("setting IPv$ipv address to $ip");
            $recap{$domain}{"status-ipv$ipv"} = 'failed';

            # Get DNS 'A' or 'AAAA' record ID
            $url = "https://" . opt('server', $domain) . "/records?zone_id=$zone_id";
            $reply = geturl(proxy => opt('proxy'),
                            url => $url,
                            headers => $headers
                           );
            next if !header_ok($reply);
            # Strip header
            $reply =~ qr/{(?:[^{}]*|(?R))*}/mp;
            $response = eval {decode_json(${^MATCH})};
            unless ($response && $response->{records}) {
                failed("invalid json or result");
                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("DNS '$type' record ID: $dns_rec_id");
                $url = "https://" . opt('server', $domain) . "/records/$dns_rec_id";
                $http_method = "PUT";
            } else {
                debug("creating DNS '$type'");
                $url = "https://" . opt('server', $domain) . "/records";
                $http_method = "POST";
            }
            my $data = "{\"zone_id\":\"$zone_id\", \"name\": \"$hostname\", \"value\": \"$ip\", \"type\": \"$type\", \"ttl\": " . opt('ttl', $domain) . "}";

            $reply = geturl(proxy => opt('proxy'),
                            url => $url,
                            headers => $headers,
                            method => $http_method,
                            data => $data
                           );
            next if !header_ok($reply);
            # Strip header
            $reply =~ qr/{(?:[^{}]*|(?R))*}/mp;
            $response = eval {decode_json(${^MATCH})};
            if ($response && $response->{record}) {
                success("IPv$ipv address set to $ip");
                $recap{$domain}{"ipv$ipv"} = $ip;
                $recap{$domain}{'mtime'} = $now;
                $recap{$domain}{"status-ipv$ipv"} = 'good';
            } else {
                failed("invalid json or result");
            }
        }
    }
}

######################################################################
## nic_inwx_examples
######################################################################
sub nic_inwx_examples {
    my $self = shift;
    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 {
    my $self = shift;
    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);
        local $_l = pushlogctx($hosts);
        my $ipv4 = $groupcfg{'wantipv4'};
        my $ipv6 = $groupcfg{'wantipv6'};
        delete $config{$_}{'wantipv4'} for @hosts;
        delete $config{$_}{'wantipv6'} for @hosts;
        info("setting IPv4 address to $ipv4") if $ipv4;
        info("setting IPv6 address to $ipv6") if $ipv6;
        # Note: $hosts is intentionally omitted from the URL.  INWX does not support a `hostname`
        # argument; instead, INWX determines the hostname from the login credentials.  (The user
        # creates a DynDNS account at INWX and binds a hostname to it.)
        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'},
        );
        next if !header_ok($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("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("$status: $errors{$status}");
                $status = 'good';
            }
            for my $h (@hosts) {
                $recap{$h}{'status-ipv4'} = $status if $ipv4;
                $recap{$h}{'status-ipv6'} = $status if $ipv6;
            }
            if ($status ne 'good') {
                if (exists($errors{$status})) {
                    failed("$status: $errors{$status}");
                } else {
                    failed("unexpected status: $line");
                }
                next;
            }
            for my $h (@hosts) {
                $recap{$h}{'ipv4'} = $ipv4 if $ipv4;
                $recap{$h}{'ipv6'} = $ipv6 if $ipv6;
                $recap{$h}{'mtime'} = $now;
            }
            success("IPv4 address set to $ipv4") if $ipv4;
            success("IPv6 address set to $ipv6") if $ipv6;
        }
    }
}

######################################################################
## nic_yandex_examples
######################################################################
sub nic_yandex_examples {
    my $self = shift;
    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 {
    my $self = shift;
    for my $host (@_) {
        local $_l = pushlogctx($host);
        my $ip = delete $config{$host}{'wantip'};
        my $headers = "PddToken: " . opt('password', $host) . "\n";

        info("setting IP address to $ip");

        # Get record ID for host
        my $url = "https://" . opt('server', $host) . "/api2/admin/dns/list?";
        $url .= "domain=";
        $url .= opt('login', $host);
        my $reply = geturl(proxy => opt('proxy'), url => $url, headers => $headers);
        next if !header_ok($reply);

        # Strip header
        $reply =~ s/^.*?\n\n//s;
        my $response = eval { decode_json($reply) };
        if ($response->{success} ne 'ok') {
            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("DNS record ID not found");
            next;
        }

        # Update the DNS record
        $url = "https://" . opt('server', $host) . "/api2/admin/dns/edit";
        my $data = "domain=";
        $data .= opt('login', $host);
        $data .= "&record_id=";
        $data .= $id;
        $data .= "&content=";
        $data .= $ip if $ip;

        $reply = geturl(
            proxy => opt('proxy'),
            url => $url,
            headers => $headers,
            method => 'POST',
            data => $data,
        );
        next if !header_ok($reply);

        # Strip header
        $reply =~ s/^.*?\n\n//s;
        $response = eval { decode_json($reply) };
        if ($response->{success} ne 'ok') {
            failed("%s", $response->{error});
            next;
        }
        $recap{$host}{'ip'} = $ip;
        $recap{$host}{'mtime'} = $now;
        $recap{$host}{'status'} = 'good';
        success("updated successfully to $ip");
    }
}

######################################################################
## nic_duckdns_examples
######################################################################
sub nic_duckdns_examples {
    my $self = shift;
    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 {
    my $self = shift;
    for my $group (group_hosts_by(\@_, qw(password server wantipv4 wantipv6))) {
        my @hosts = @{$group->{hosts}};
        my %groupcfg = %{$group->{cfg}};
        my $hosts = join(',', @hosts);
        local $_l = pushlogctx($hosts);
        my $ipv4 = $groupcfg{'wantipv4'};
        my $ipv6 = $groupcfg{'wantipv6'};
        delete $config{$_}{'wantipv4'} for @hosts;
        delete $config{$_}{'wantipv6'} for @hosts;
        info("setting IPv4 address to $ipv4") if $ipv4;
        info("setting IPv6 address to $ipv6") if $ipv6;
        my $url = "https://$groupcfg{'server'}/update?domains=$hosts&token=$groupcfg{'password'}";
        $url .= "&ip=$ipv4" if $ipv4;
        $url .= "&ipv6=$ipv6" if $ipv6;
        my $reply = geturl(proxy => opt('proxy'), url => $url);
        next if !header_ok($reply);
        (my $body = $reply) =~ s/^.*?\n\n//s or do {
            failed("invalid response from server");
            next;
        };
        chomp($body);
        if ($body ne 'OK') {
            failed("server said: $body");
            next;
        }
        for my $h (@hosts) {
            $recap{$h}{'ipv4'} = $ipv4 if $ipv4;
            $recap{$h}{'ipv6'} = $ipv6 if $ipv6;
            $recap{$h}{'mtime'} = $now;
            $recap{$h}{'status-ipv4'} = 'good' if $ipv4;
            $recap{$h}{'status-ipv6'} = 'good' if $ipv6;
        }
        success("IPv4 address set to $ipv4") if $ipv4;
        success("IPv6 address set to $ipv6") if $ipv6;
    }
}

######################################################################
## nic_freemyip_examples
######################################################################
sub nic_freemyip_examples {
    my $self = shift;
    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 {
    my $self = shift;
    for my $h (@_) {
        local $_l = pushlogctx($h);
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to $ip");
        my $url = "https://" . opt('server', $h) . "/update?token=" . opt('password', $h) . "&domain=$h";
        my $reply = geturl(proxy => opt('proxy'), url => $url);
        next if !header_ok($reply);
        (my $body = $reply) =~ s/^.*?\n\n//s;
        if ($body !~ /OK/) {
            failed("server said: $body");
            next;
        }
        $recap{$h}{'ip'} = $ip;
        $recap{$h}{'mtime'} = $now;
        $recap{$h}{'status'} = 'good';
        success("IP address set to $ip");
    }
}

######################################################################
## nic_ddnsfm_examples
######################################################################
sub nic_ddnsfm_examples {
    my $self = shift;
    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 {
    my $self = shift;
    for my $h (@_) {
        local $_l = pushlogctx($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");
            my $reply = geturl(
                proxy => opt('proxy'),
                url => opt('server', $h) . "/update?key=" . opt('password', $h) . "&domain=$h&myip=$ip",
            );
            next if !header_ok($reply);
            $recap{$h}{"ipv$ipv"} = $ip;
            $recap{$h}{'mtime'} = $now;
            $recap{$h}{"status-ipv$ipv"} = 'good';
            success("IPv$ipv address set to $ip");
        }
    }
}

######################################################################
## nic_dondominio_examples
######################################################################
sub nic_dondominio_examples {
    my $self = shift;
    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 {
    my $self = shift;
    for my $h (@_) {
        local $_l = pushlogctx($h);
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to $ip");
        my $url = "https://" . opt('server', $h) . "/plain/?user=" . opt('login', $h) . "&password=" . opt('password', $h) . "&host=$h&ip=$ip";
        my $reply = geturl(proxy => opt('proxy'), url => $url);
        next if !header_ok($reply);
        my @reply = split /\n/, $reply;
        my $returned = pop(@reply);
        if ($returned !~ /OK|IP:\Q$ip\E/) {
            failed("server said: $returned");
            next;
        }
        $recap{$h}{'ip'} = $ip;
        $recap{$h}{'mtime'} = $now;
        $recap{$h}{'status'} = 'good';
        success("IP address set to $ip");
    }
}

######################################################################
## nic_dnsmadeeasy_examples
######################################################################
sub nic_dnsmadeeasy_examples {
    my $self = shift;
    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 {
    my $self = shift;
    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!',
    );
    for my $h (@_) {
        local $_l = pushlogctx($h);
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to $ip");
        my $url = opt('server', $h) . opt('script', $h) . "?username=" . opt('login', $h) . "&password=" . opt('password', $h) . "&ip=$ip&id=$h";
        my $reply = geturl(proxy => opt('proxy'), url => $url);
        next if !header_ok($reply);
        my @reply = split /\n/, $reply;
        my $returned = pop(@reply);
        if ($returned !~ qr/success/) {
            my $err = $messages{$returned} ? "$returned: $messages{$returned}" : $returned;
            failed("server said: $err");
            next;
        }
        $recap{$h}{'ip'} = $ip;
        $recap{$h}{'mtime'} = $now;
        $recap{$h}{'status'} = 'good';
        success("IP address set to $ip");
    }
}

######################################################################
## nic_ovh_examples
######################################################################
sub nic_ovh_examples {
    my $self = shift;
    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 {
    my $self = shift;
    ## update each configured host
    ## should improve to update in one pass
    for my $h (@_) {
        local $_l = pushlogctx($h);
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to $ip");

        # Set the URL that we're going to update
        my $url;
        $url .= 'https://' . opt('server', $h) . opt('script', $h) . '?system=dyndns';
        $url .= "&hostname=$h";
        $url .= "&myip=";
        $url .= $ip if $ip;

        my $reply = geturl(
            proxy => opt('proxy'),
            url => $url,
            login => opt('login', $h),
            password => opt('password', $h),
        );

        if (!defined($reply) || !$reply) {
            failed("could not connect to " . opt('server', $h));
            next;
        }

        my @reply = split /\n/, $reply;
        my $returned = List::Util::first { $_ =~ /good/ || $_ =~ /nochg/ } @reply;
        if ($returned) {
            $recap{$h}{'ip'} = $ip;
            $recap{$h}{'mtime'} = $now;
            $recap{$h}{'status'} = 'good';
            if ($returned =~ /good/) {
                success("IP address set to $ip");
            } else {
                success("skipped: IP address was already set to $ip");
            }
        } else {
            $recap{$h}{'status'} = 'failed';
            failed("server said: $reply");
        }
    }
}

######################################################################
## nic_porkbun_examples
######################################################################
sub nic_porkbun_examples {
    my $self = shift;
    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 {
    my $self = shift;
    for my $h (@_) {
        local $_l = pushlogctx($h);
        my ($sub_domain, $domain);
        if (opt('root-domain', $h)) {
            warning("both 'root-domain' and 'on-root-domain' are set; ignoring the latter")
                if opt('on-root-domain', $h);
            $domain = opt('root-domain', $h);
            $sub_domain = $h;
            if ($sub_domain !~ s/(?:^|\.)\Q$domain\E$//) {
                failed("hostname does not end with the 'root-domain' value: $domain");
                next;
            }
        } elsif (opt('on-root-domain', $h)) {
            $sub_domain = '';
            $domain = $h;
        } else {
            ($sub_domain, $domain) = split(/\./, $h, 2);
        }
        info("subdomain $sub_domain, root domain $domain") if $sub_domain ne '';
        for my $ipv ('4', '6') {
            my $ip = delete $config{$h}{"wantipv$ipv"} or next;
            my $rrset_type = $ipv eq '4' ? 'A' : 'AAAA';
            info("setting IPv$ipv address to $ip");
            my $reply = geturl(
                proxy => opt('proxy'),
                url => "https://porkbun.com/api/json/v3/dns/retrieveByNameType/$domain/$rrset_type/$sub_domain",
                headers => ['Content-Type: application/json'],
                method => 'POST',
                data => encode_json({
                    secretapikey => opt('secretapikey', $h),
                    apikey => opt('apikey', $h),
                }),
            );
            next if !header_ok($reply);
            (my $body = $reply) =~ s/^.*?\n\n//s;
            $body =~ qr/{(?:[^{}]*|(?R))*}/mp;
            my $response = eval { decode_json(${^MATCH}) };
            if (ref($response) ne 'HASH') {
                failed("unexpected service response: $body");
                next;
            }
            if ($response->{status} ne 'SUCCESS') {
                failed("unexpected status: $response->{status}");
                next;
            }
            my $records = $response->{records};
            if (ref($records) ne 'ARRAY' || !defined($records->[0]{'id'})) {
                failed("no applicable existing records");
                next;
            }
            warning("There are multiple applicable records. Only first record is used. Overwrite all with the same content.")
                if @$records > 1;
            if ($records->[0]{'content'} eq $ip) {
                $recap{$h}{"status-ipv$ipv"} = "good";
                success("skipped: IPv$ipv address was already set to $ip");
                next;
            }
            my $ttl = $records->[0]->{'ttl'};
            my $notes = $records->[0]->{'notes'};
            debug("ttl = %s", $ttl);
            debug("notes = %s", $notes);
            $reply = geturl(
                proxy => opt('proxy'),
                url => "https://porkbun.com/api/json/v3/dns/editByNameType/$domain/$rrset_type/$sub_domain",
                headers => ['Content-Type: application/json'],
                method => 'POST',
                data => encode_json({
                    secretapikey => opt('secretapikey', $h),
                    apikey => opt('apikey', $h),
                    content => $ip,
                    ttl => $ttl,
                    notes => $notes,
                }),
            );
            next if !header_ok($reply);
            $recap{$h}{"status-ipv$ipv"} = "good";
            success("IPv$ipv address set to $ip");
        }
    }
}

sub nic_cloudns_examples {
    my $self = shift;
    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 {
    my $self = shift;
    for my $group (group_hosts_by(\@_, qw(dynurl wantip))) {
        my @hosts = @{$group->{hosts}};
        my %groupcfg = %{$group->{cfg}};
        my $hosts = join(',', @hosts);
        local $_l = pushlogctx($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",
        );
        next if !header_ok($reply);
        $reply =~ s/^.*?\n\n//s;  # Strip the headers.
        chomp($reply);
        if ($reply eq "The record's key is wrong!" || $reply eq "Invalid request.") {
            $recap{$_}{'status'} = 'failed' for @hosts;
            failed($reply);
            next;
        }
        # There's no documentation explaining possible return values, so we assume success.
        $recap{$_}{'ip'} = $ip for @hosts;
        $recap{$_}{'mtime'} = $now for @hosts;
        $recap{$_}{'status'} = 'good' for @hosts;
        success("IP address set to $ip");
    }
}

######################################################################
## nic_dinahosting_examples
######################################################################
sub nic_dinahosting_examples {
    my $self = shift;
    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 {
    my $self = shift;
    for my $h (@_) {
        local $_l = pushlogctx($h);
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to $ip");
        my ($hostname, $domain) = split(/\./, $h, 2);
        my $url = 'https://' . opt('server', $h) . opt('script', $h);
        $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 => opt('login', $h),
            password => opt('password', $h),
            url => $url,
        );
        $recap{$h}{'status'} = 'failed';  # assume failure until otherwise determined
        next if !header_ok($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("error $code: $message");
            next;
        }
        $recap{$h}{'ip'} = $ip;
        $recap{$h}{'mtime'} = $now;
        $recap{$h}{'status'} = 'good';
        success("IP address set to $ip");
    }
}

######################################################################
## nic_directnic_examples
######################################################################
sub nic_directnic_examples {
    my $self = shift;
    return <<"EoEXAMPLE";
o 'directnic'

The 'directnic' protocol is used by directnic (https://directnic.com).
Details about the API can be found at https://directnic.com/knowledge#/knowledge/article/3726.

You must specify at least one of the following variables:
  * urlv4=https://directnic.com/dns/gateway/ad133743f001e318e455fdc05/ the URL to use to update the A record
  * urlv6=https://directnic.com/dns/gateway/ad133743f001e318e455fdc06/ the URL to use to update the AAAA record

urlv4 is required when updating an IPv4 record, and urlv6 is required when updating an IPv6 record.

Example ${program}.conf file entry:
  protocol=directnic,                                                \\
  urlv4=https://directnic.com/dns/gateway/ad133743f001e318e455fdc05/ \\
  urlv6=https://directnic.com/dns/gateway/ad133743f001e318e455fdc06/ \\
  myhost.mydomain.com
EoEXAMPLE
}

######################################################################
## nic_directnic_update
######################################################################
sub nic_directnic_update {
    my $self = shift;
    for my $h (@_) {
        local $_l = pushlogctx($h);
        for my $ipv ('4', '6') {
            my $ip = delete $config{$h}{"wantipv$ipv"} or next;
            info("setting IPv$ipv address to $ip");

            my $url = opt("urlv$ipv", $h);
            if (!defined($url)) {
                failed("missing urlv$ipv option");
                next;
            }

            $url .= "?data=$ip";
            my $reply = geturl(proxy => opt('proxy'), url => $url);
            next if !header_ok($reply);

            (my $body = $reply) =~ s/^.*?\n\n//s;
            my $response = eval {decode_json($body)};
            if (ref($response) ne 'HASH') {
                $recap{$h}{"status-ipv$ipv"} = 'bad';
                failed("response is not a JSON object:\n$body");
                next;
            }

            if ($response->{'result'} ne 'success') {
                $recap{$h}{"status-ipv$ipv"} = 'failed';
                failed("server said:\n$body");
                next;
            }

            $recap{$h}{"ipv$ipv"} = $ip;
            $recap{$h}{"status-ipv$ipv"} = 'good';
            $recap{$h}{'mtime'} = $now;
            success("IPv$ipv address set to $ip");
        }
    }
}

######################################################################
## nic_gandi_examples
## by Jimmy Thrasibule <dev@jimmy.lt>
######################################################################
sub nic_gandi_examples {
    my $self = shift;
    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 {
    my $self = shift;
    for my $h (@_) {
        local $_l = pushlogctx($h);
        for my $ipv ('ipv4', 'ipv6') {
            my $ip = delete $config{$h}{"want$ipv"} or next;
            my $zone = opt('zone', $h);
            (my $hostname = $h) =~ s/\.\Q$zone\E$//;
            info("setting IP address to $ip");
            my @headers = ('Content-Type: application/json');
            if (opt('use-personal-access-token', $h) == 1) {
                push(@headers, "Authorization: Bearer " . opt('password', $h));
            } else {
                push(@headers, "Authorization: Apikey " . opt('password', $h));
            }
            my $rrset_type = $ipv eq 'ipv6' ? 'AAAA' : 'A';
            my $url = "https://" . opt('server', $h) . opt('script', $h) . "/livedns/domains/$zone/records/$hostname/$rrset_type";
            my $reply = geturl(
                proxy => opt('proxy'),
                url => $url,
                headers => \@headers,
                method => 'GET',
            );
            next if !header_ok($reply);
            $reply =~ s/^.*?\n\n//s;
            my $response = eval { decode_json($reply) };
            if (ref($response) ne 'HASH') {
                $recap{$h}{"status-$ipv"} = "bad";
                failed("response is not a JSON object: $reply");
                next;
            }
            if ($response->{'rrset_values'}->[0] eq $ip && (!defined(opt('ttl', $h)) ||
                $response->{'rrset_ttl'} eq opt('ttl', $h))) {
                $recap{$h}{'ip'} = $ip;
                $recap{$h}{'mtime'} = $now;
                $recap{$h}{"status-$ipv"} = "good";
                success("skipped: address was already set to $ip");
                next;
            }
            $reply = geturl(
                proxy => opt('proxy'),
                url => $url,
                headers => \@headers,
                method => 'PUT',
                data => encode_json({
                    defined(opt('ttl', $h)) ? (rrset_ttl => opt('ttl', $h)) : (),
                    rrset_values => [$ip],
                }),
            );
            if (!header_ok($reply)) {
                $recap{$h}{"status-$ipv"} = "bad";
                $reply =~ s/^.*?\n\n//s;
                my $response = eval { decode_json($reply) };
                if (ref($response) eq 'HASH' && ($response->{message} // '') ne '') {
                    failed($response->{message});
                } else {
                    failed("unexpected error response: $reply");
                }
                next;
            }
            $recap{$h}{'ip'} = $ip;
            $recap{$h}{'mtime'} = $now;
            $recap{$h}{"status-$ipv"} = "good";
            success("updated successfully to $ip");
        }
    }
}

######################################################################
## nic_keysystems_examples
######################################################################
sub nic_keysystems_examples {
    my $self = shift;
    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 {
    my $self = shift;
    ## update each configured host
    ## should improve to update in one pass
    for my $h (@_) {
        local $_l = pushlogctx($h);
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to $ip");
        my $url = opt('server', $h) . "/update.php?hostname=$h&password=" . opt('password', $h) . "&ip=$ip";
        my $reply = geturl(proxy => opt('proxy'), url => $url);
        last if !header_ok($reply);

        if ($reply =~ /code = 200/) {
            $recap{$h}{'ip'} = $ip;
            $recap{$h}{'mtime'} = $now;
            $recap{$h}{'status'} = 'good';
            success("IP address set to $ip");
        } else {
            $recap{$h}{'status'} = 'failed';
            failed("server said: $reply");
        }
    }
}

######################################################################
## nic_regfishde_examples
######################################################################
sub nic_regfishde_examples {
    my $self = shift;
    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 {
    my $self = shift;
    ## update configured host
    for my $h (@_) {
        local $_l = pushlogctx($h);
        my $ipv4 = delete $config{$h}{'wantipv4'};
        my $ipv6 = delete $config{$h}{'wantipv6'};
        info("setting IPv4 address to $ipv4") if $ipv4;
        info("setting IPv6 address to $ipv6") if $ipv6;
        my $url = 'https://' . opt('server', $h) . "/?fqdn=$h&forcehost=1&token=" . opt('password', $h);
        $url .= "&ipv4=$ipv4" if $ipv4;
        $url .= "&ipv6=$ipv6" if $ipv6;

        # Try to get URL
        my $reply = geturl(proxy => opt('proxy'), url => $url);
        last if !header_ok($reply);
        if ($reply !~ /success/) {
            failed("server said: $reply");
            next;
        }
        $recap{$h}{'ipv4'} = $ipv4 if $ipv4;
        $recap{$h}{'ipv6'} = $ipv6 if $ipv6;
        $recap{$h}{'status-ipv4'} = 'good' if $ipv4;
        $recap{$h}{'status-ipv6'} = 'good' if $ipv6;
        $recap{$h}{'mtime'} = $now;
        success("IPv4 address set to $ipv4") if $ipv4;
        success("IPv6 address set to $ipv6") if $ipv6;
    }
}

######################################################################
######################################################################
## enom
######################################################################
sub nic_enom_examples {
    my $self = shift;
    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 {
    my $self = shift;
    ## update each configured host
    for my $h (@_) {
        local $_l = pushlogctx($h);
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to $ip");

        my $url;
        $url   = 'https://' . opt('server', $h) . '/interface.asp?Command=SetDNSHost';
        $url  .= "&HostName=$h";
        $url  .= '&Zone=' . opt('login', $h);
        $url  .= '&DomainPassword=' . opt('password', $h);
        $url  .= "&Address=";
        $url  .= $ip if $ip;

        my $reply = geturl(
            proxy => opt('proxy'),
            url => $url
        );
        last if !header_ok($reply);

        my @reply = split /\n/, $reply;

        if (grep /Done=true/i, @reply) {
            $recap{$h}{'ip'} = $ip;
            $recap{$h}{'mtime'} = $now;
            $recap{$h}{'status'} = 'good';
            success("IP address set to $ip");
        } else {
            $recap{$h}{'status'} = 'failed';
            warning("SENT:    %s", $url) unless opt('verbose');
            warning("REPLIED: %s", $reply);
            failed("invalid reply");
        }
    }
}

sub nic_digitalocean_examples {
    my $self = shift;
    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 $ipv address to $ip");

    my $server = opt('server', $h);
    my $type = $ipv eq 'ipv6' ? 'AAAA' : 'A';

    my $headers;
    $headers  = "Content-Type: application/json\n";
    $headers .= 'Authorization: Bearer ' . opt('password', $h) . "\n";

    my $list_url;
    $list_url  = "https://$server/v2/domains/" . opt('zone', $h) . '/records';
    $list_url .= "?name=$h";
    $list_url .= "&type=$type";

    my $list_resp = geturl(
        proxy => opt('proxy'),
        url => $list_url,
        headers => $headers,
    );
    return if !header_ok($list_resp);
    $list_resp =~ s/^.*?\n\n//s;  # Strip header

    my $list = eval { decode_json($list_resp) };
    if ($@) {
        $recap{$h}{"status-$ipv"} = 'failed';
        failed("listing $ipv: JSON decoding failure");
        return;
    }

    my $elem = $list;
    unless ((ref($elem) eq 'HASH') &&
            (ref ($elem = $elem->{'domain_records'}) eq 'ARRAY') &&
            (@$elem == 1 && ref ($elem = $elem->[0]) eq 'HASH')) {
        $recap{$h}{"status-$ipv"} = 'failed';
        failed("listing $ipv: no record, multiple records, or malformed JSON");
        return;
    }

    my $current_ip = $elem->{'data'};
    my $record_id = $elem->{'id'};

    if ($current_ip eq $ip) {
        info("$ipv: IP is already $ip, no update needed");
    } else {
        my $update_data = encode_json({'type' => $type, 'data' => $ip});
        my $update_resp = geturl(
            proxy => opt('proxy'),
            url => "https://$server/v2/domains/" . opt('zone', $h) . "/records/$record_id",
            method => 'PATCH',
            headers => $headers,
            data => $update_data,
        );
        return if !header_ok($update_resp);
    }

    $recap{$h}{"status-$ipv"} = 'good';
    $recap{$h}{"ip-$ipv"} = $ip;
    $recap{$h}{"mtime"} = $now;
}

sub nic_digitalocean_update {
    my $self = shift;
    for my $h (@_) {
        local $_l = pushlogctx($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 {
    my $self = shift;
    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 {
    my $self = shift;
    for my $h (@_) {
        local $_l = pushlogctx($h);
        for my $v (4, 6) {
            my $ip = delete $config{$h}{"wantipv$v"};
            if (!defined $ip) {
                debug("IPv$v not wanted, skipping");
                next;
            }
            info("setting IP address to $ip");
            # 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, "IP set to $ip"],
                'nochg' => [1, "IP already set to $ip"],
                'nohost' => [0, "Bad domain name or bad IP $ip"],
                'badauth' => [0, "Bad authentication"],
            );
            my $reply = geturl(
                proxy => opt('proxy'),
                url => "https://infomaniak.com/nic/update?hostname=$h&myip=$ip",
                login => opt('login', $h),
                password => opt('password', $h),
            );
            next if !header_ok($reply);
            (my $body = $reply) =~ s/^.*?\n\n//s;
            my ($status) = split(/ /, $body, 2);
            my ($ok, $msg) =
                @{$statuses{$status} // [0, "Unknown reply from Infomaniak: $body"]};
            if (!$ok) {
                failed($msg);
                next;
            }
            success($msg);
            $recap{$h}{"ipv$v"} = $ip;
            $recap{$h}{'mtime'} = $now;
            $recap{$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 {
    my $self = shift;
    # Note: This is logged after opt('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, raw => 1, join("\n", 'Host IP addresses:', map({
        my $ipv4 = delete($config{$_}{'wantipv4'});
        my $ipv6 = delete($config{$_}{'wantipv6'});
        $recap{$_}{'status-ipv4'} = 'good' if $ipv4;
        $recap{$_}{'status-ipv6'} = 'good' if $ipv6;
        $recap{$_}{'ipv4'} = $ipv4 if $ipv4;
        $recap{$_}{'ipv6'} = $ipv6 if $ipv6;
        $recap{$_}{'mtime'} = $now;
        sprintf('%30s  %s', $_, join('  ', grep(defined($_), $ipv4, $ipv6)));
    } @_)));
}

######################################################################
## nic_emailonly_examples
######################################################################
sub nic_emailonly_examples {
    my $self = shift;
    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__