ddclient.in

#!/usr/bin/perl
######################################################################
#
# DDCLIENT - a Perl client for updating DynDNS information
#
# Author: Paul Burry (paul+ddclient@burry.ca)
# ddclient developers: see https://github.com/orgs/ddclient/people
#
# website: https://ddclient.net
#
# Support for multiple IP numbers added by
# Astaro AG, Ingo Schwarze <ischwarze-OOs/4mkCeqbQT0dZR+AlfA@public.gmane.org> September 16, 2008
#
# Support for multiple domain support for Namecheap by Robert Ian Hawdon 2010-09-03: https://robertianhawdon.me.uk/
#
# Initial Cloudflare support by Ian Pye, updated by Robert Ian Hawdon 2012-07-16
# Further updates by Peter Roberts to support the new API 2013-09-26, 2014-06-22: http://blog.peter-r.co.uk/
#
#
######################################################################
package ddclient;
require v5.10.1;
use strict;
use warnings;
use File::Basename;
use File::Path qw(make_path);
use File::Temp;
use Getopt::Long;
use IO::Socket::INET;
use Socket qw(AF_INET AF_INET6 PF_INET PF_INET6);
use Sys::Hostname;

use version 0.77; our $VERSION = version->declare('v3.9.1');
(my $version = $VERSION->stringify()) =~ s/^v//;
my $programd = $0;
$programd =~ s%^.*/%%;
my $program = $programd;
$program =~ s/d$//;
my $now = time;
my $hostname = hostname();

# subst_var(subst, default) returns subst unless it looks like @foo@ in which case it returns
# default. The @foo@ strings are expected to be replaced by make; this function makes it possible
# to run this file as a Perl script before those substitutions are made.
sub subst_var {
    my ($subst, $default) = @_;
    return $default if $subst =~ qr'^@\w+@$';
    return $subst;
}

my $etc = subst_var('@sysconfdir@', '/etc/ddclient');
my $cachedir = subst_var('@localstatedir@', '/var') . '/cache/ddclient';
my $savedir = '/tmp';
if ($program =~ /test/i) {
    $etc = '.';
    $cachedir = '.';
    $savedir = 'URL';
}

my $msgs      = '';
my $last_msgs = '';

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

use vars qw($file $lineno);
local $file   = '';
local $lineno = '';

$ENV{'PATH'} = (exists($ENV{PATH}) ? "$ENV{PATH}:" : "") . "/sbin:/usr/sbin:/bin:/usr/bin:/etc:/usr/lib:";

our %globals;
my ($result, %config, %cache);
my $saved_cache;
my %saved_opt;
my $daemon;

sub T_ANY    { 'any' }
sub T_STRING { 'string' }
sub T_EMAIL  { 'e-mail address' }
sub T_NUMBER { 'number' }
sub T_DELAY  { 'time delay (ie. 1d, 1hour, 1m)' }
sub T_LOGIN  { 'login' }
sub T_PASSWD { 'password' }
sub T_BOOL   { 'boolean value' }
sub T_FQDN   { 'fully qualified host name' }
sub T_OFQDN  { 'optional fully qualified host name' }
sub T_FILE   { 'file name' }
sub T_FQDNP  { 'fully qualified host name and optional port number' }
sub T_PROTO  { 'protocol' }
sub T_USE    { 'ip strategy' }
sub T_IF     { 'interface' }
sub T_PROG   { 'program name' }
sub T_IP     { 'ip' }
sub T_POSTS  { 'postscript' }

## strategies for obtaining an ip address.
my %builtinweb = (
    'dyndns' => {'url' => 'http://checkip.dyndns.org/', 'skip' => 'Current IP Address:'},
    'freedns' => {'url' => 'https://freedns.afraid.org/dynamic/check.php'},
    'googledomains' => {'url' => 'https://domains.google.com/checkip'},
    'he' => {'url' => 'http://checkip.dns.he.net/'},
    'ip4only.me' => {'url' => 'http://ip4only.me/api/'},
    'ip6only.me' => {'url' => 'http://ip6only.me/api/'},
    'ipify-ipv4' => {'url' => 'https://api.ipify.org/'},
    'ipify-ipv6' => {'url' => 'https://api6.ipify.org/'},
    'loopia' => {'url' => 'http://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' => 'http://ipv4.nsupdate.info/myip'},
    'nsupdate.info-ipv6' => {'url' => 'http://ipv6.nsupdate.info/myip'},
    'zoneedit' => {'url' => 'http://dynamic.zoneedit.com/checkip.html'},
);
my %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',
    },
    'dlink-524' => {
        'name' => 'D-Link DI-524',
        'url'  => '/st_device.html',
        'skip' => 'WAN.*?Addres',
    },
    'dlink-604' => {
        'name' => 'D-Link DI-604',
        'url'  => '/st_devic.html',
        'skip' => 'WAN.*?IP.*Address',
    },
    'dlink-614' => {
        'name' => 'D-Link DI-614+',
        'url'  => '/st_devic.html',
        'skip' => 'WAN',
    },
    'e-tech' => {
        'name' => 'E-tech Router',
        'url'  => '/Status.htm',
        'skip' => 'Public IP Address',
    },
    'elsa-lancom-dsl10' => {
        'name' => 'ELSA LanCom DSL/10 DSL FW',
        'url'  => '/config/1/6/8/3/',
        'skip' => 'IP.Address',
    },
    'elsa-lancom-dsl10-ch01' => {
        'name' => 'ELSA LanCom DSL/10 DSL FW (isdn ch01)',
        'url'  => '/config/1/6/8/3/',
        'skip' => 'IP.Address.*?CH01',
    },
    'elsa-lancom-dsl10-ch02' => {
        'name' => 'ELSA LanCom DSL/10 DSL FW (isdn ch01)',
        'url'  => '/config/1/6/8/3/',
        'skip' => 'IP.Address.*?CH02',
    },
    'linksys' => {
        'name' => 'Linksys FW',
        'url'  => '/Status.htm',
        'skip' => 'WAN.*?Address',
    },
    'linksys-rv042-wan1' => {
        'name' => 'Linksys RV042 Dual Homed Router WAN Port 2',
        'url'  => '/home.htm',
        'skip' => 'WAN1 IP',
    },
    'linksys-rv042-wan2' => {
        'name' => 'Linksys RV042 Dual Homed Router WAN Port 2',
        'url'  => '/home.htm',
        'skip' => 'WAN2 IP',
    },
    'linksys-ver2' => {
        'name' => 'Linksys FW version 2',
        'url'  => '/RouterStatus.htm',
        'skip' => 'WAN.*?Address',
    },
    'linksys-ver3' => {
        'name' => 'Linksys FW version 3',
        'url'  => '/Status_Router.htm',
        'skip' => 'WAN.*?Address',
    },
    'linksys-wcg200' => {
        'name' => 'Linksys WCG200 FW',
        'url'  => '/RgStatus.asp',
        'skip' => 'WAN.IP.*?Address',
    },
    'linksys-wrt854g' => {
        'name' => 'Linksys WRT854G FW',
        'url'  => '/Status_Router.asp',
        'skip' => 'IP Address:',
    },
    'maxgate-ugate3x00' => {
        'name' => 'MaxGate UGATE-3x00 FW',
        'url'  => '/Status.htm',
        'skip' => 'WAN.*?IP Address',
    },
    'netcomm-nb3' => {
        'name' => 'NetComm NB3',
        'url'  => '/MainPage?id=6',
        'skip' => 'ppp-0',
    },
    'netgear-dg834g' => {
        'name' => 'netgear-dg834g',
        'url'  => '/setup.cgi?next_file=s_status.htm&todo=cfg_init',
        'skip' => '',
    },
    'netgear-rp614' => {
        'name' => 'Netgear RP614 FW',
        'url'  => '/sysstatus.html',
        'skip' => 'IP Address',
    },
    'netgear-rt3xx' => {
        'name' => 'Netgear FW',
        'url'  => '/mtenSysStatus.html',
        'skip' => 'IP Address',
    },
    'netgear-wgt624' => {
        'name' => 'Netgear WGT624',
        'url'  => '/RST_st_dhcp.htm',
        'skip' => 'IP Address</B></td><TD NOWRAP width="50%">',
    },
    'netgear-wpn824' => {
        'name' => 'Netgear WPN824 FW',
        'url'  => '/RST_status.htm',
        'skip' => 'IP Address',
    },
    'netopia-r910' => {
        'name' => 'Netopia R910 FW',
        'url'  => '/WanEvtLog',
        'skip' => 'local:',
    },
    'olitec-SX200' => {
        'name' => 'olitec-SX200',
        'url'  => '/doc/wan.htm',
        'skip' => 'st_wan_ip[0] = "',
    },
    'rtp300' => {
        'name' => 'Linksys RTP300',
        'url'  => '/cgi-bin/webcm?getpage=%2Fusr%2Fwww_safe%2Fhtml%2Fstatus%2FRouter.html',
        'skip' => 'Internet.*?IP Address',
    },
    'siemens-ss4200' => {
        'name' => 'Siemens SpeedStream 4200',
        'url'  => '/summary.htm',
        'skip' => '',
    },
    'sitecom-dc202' => {
        'name' => 'Sitecom DC-202 FW',
        'url'  => '/status.htm',
        'skip' => 'Internet IP Address',
    },
    'smc-barricade' => {
        'name' => 'SMC Barricade FW',
        'url'  => '/status.htm',
        'skip' => 'IP Address',
    },
    'smc-barricade-7004vbr' => {
        'name' => 'SMC Barricade FW (7004VBR model config)',
        'url'  => '/status_main.stm',
        'skip' => 'var wan_ip=',
    },
    'smc-barricade-7401bra' => {
        'name' => 'SMC Barricade 7401BRA FW',
        'url'  => '/admin/wan1.htm',
        'skip' => 'IP Address',
    },
    'smc-barricade-alt' => {
        'name' => 'SMC Barricade FW (alternate config)',
        'url'  => '/status.HTM',
        'skip' => 'WAN IP',
    },
    'sohoware-nbg800' => {
        'name' => 'SOHOWare BroadGuard NBG800',
        'url'  => '/status.htm',
        'skip' => 'Internet IP',
    },
    'sveasoft' => {
        'name' => 'Sveasoft WRT54G/WRT54GS',
        'url'  => '/Status_Router.asp',
        'skip' => 'var wan_ip',
    },
    'thomson-st536v6' => {
        'name' => 'Thomson SpeedTouch 536v6',
        'url'  => '/cgi/b/is/',
        'skip' => 'IP Address',
    },
    'thomson-tg782' => {
        'name' => 'Thomson/Technicolor TG782',
        'url'  => '/cgi/b/is/',
        'skip' => 'IP Address',
    },
    'vigor-2200usb' => {
        'name' => 'Vigor 2200 USB',
        'url'  => '/doc/online.sht',
        'skip' => 'PPPoA',
    },
    'watchguard-edge-x' => {
        'name' => 'Watchguard Edge X FW',
        'url'  => '/netstat.htm',
        'skip' => 'inet addr:',
    },
    'watchguard-soho' => {
        'name' => 'Watchguard SOHO FW',
        'url'  => '/pubnet.htm',
        'skip' => 'NAME=IPAddress VALUE=',
    },
    'westell-6100' => {
        'name' => 'Westell C90-610015-06 DSL Router',
        'url'  => '/advstat.htm',
        'skip' => 'IP.+?Address',
    },
    'xsense-aero' => {
        'name' => 'Xsense Aero',
        'url'  => '/A_SysInfo.htm',
        'skip' => 'WAN.*?IP Address',
    },
);

my %ip_strategies = (
    'ip'        => ": use IP given by '-ip <address>'",
    'web'       => ": obtain IP from the web-based IP discovery service given by '-web <service>|<url>'",
    'fw'        => ": obtain IP from a firewall/router device by visiting the URL given by '-fw <url>'",
    'if'        => ": obtain IP from the interface given by '-if <interface>'",
    'cmd'       => ": obtain IP by running the command given by '-cmd <command>'",
    'cisco'     => ": obtain IP from Cisco FW device at the address given by '-fw <address>'",
    'cisco-asa' => ": obtain IP from Cisco ASA device at the address given by '-fw <address>'",
    map({ $_ => sprintf(": obtain IP from %s device at the address given by '-fw <address>'",
                        $builtinfw{$_}->{'name'}) }
        keys(%builtinfw)),
);

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

sub setv {
    return {
        'type'     => shift,
        'required' => shift,
        'cache'    => shift,
        'default'  => shift,
        'minimum'  => shift,
    };
}
my %variables = (
    'global-defaults' => {
        'daemon'              => setv(T_DELAY, 0, 0, $daemon_default,      interval('60s')),
        'foreground'          => setv(T_BOOL,  0, 0, 0,                    undef),
        'file'                => setv(T_FILE,  0, 0, "$etc/$program.conf", undef),
        'cache'               => setv(T_FILE,  0, 0, "$cachedir/$program.cache", undef),
        'pid'                 => setv(T_FILE,  0, 0, "",                   undef),
        'proxy'               => setv(T_FQDNP, 0, 0, undef,                undef),
        'protocol'            => setv(T_PROTO, 0, 0, 'dyndns2',            undef),

        'use'                 => setv(T_USE,   0, 0, 'ip',                 undef),
        'ip'                  => setv(T_IP,    0, 0, undef,                undef),
        'if'                  => setv(T_IF,    0, 0, 'ppp0',               undef),
        'web'                 => setv(T_STRING,0, 0, 'dyndns',             undef),
        'web-skip'            => setv(T_STRING,1, 0, '',                   undef),
        'fw'                  => setv(T_ANY,   0, 0, '',                   undef),
        'fw-skip'             => setv(T_STRING,1, 0, '',                   undef),
        'fw-login'            => setv(T_LOGIN, 1, 0, '',                   undef),
        'fw-password'         => setv(T_PASSWD,1, 0, '',                   undef),
        'cmd'                 => setv(T_PROG,  0, 0, '',                   undef),
        'cmd-skip'            => setv(T_STRING,1, 0, '',                   undef),

        'timeout'             => setv(T_DELAY, 0, 0, interval('120s'),     interval('120s')),
        'retry'               => setv(T_BOOL,  0, 0, 0,                    undef),
        'force'               => setv(T_BOOL,  0, 0, 0,                    undef),
        'ssl'                 => setv(T_BOOL,  0, 0, 0,                    undef),
        'curl'                => setv(T_BOOL,  0, 0, 0,                    undef),
        'ipv6'                => setv(T_BOOL,  0, 0, 0,                    undef),
        'syslog'              => setv(T_BOOL,  0, 0, 0,                    undef),
        'facility'            => setv(T_STRING,0, 0, 'daemon',             undef),
        'priority'            => setv(T_STRING,0, 0, 'notice',             undef),
        'mail'                => setv(T_EMAIL, 0, 0, '',                   undef),
        'mail-failure'        => setv(T_EMAIL, 0, 0, '',                   undef),

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

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

        'use'                 => setv(T_USE,   0, 0, 'ip',                 undef),
        'if'                  => setv(T_IF,    0, 0, 'ppp0',               undef),
        'web'                 => setv(T_STRING,0, 0, 'dyndns',             undef),
        'web-skip'            => setv(T_STRING,0, 0, '',                   undef),
        'web-ssl-validate'    => setv(T_BOOL,  0, 0, 1,                    undef),
        'fw'                  => setv(T_ANY,   0, 0, '',                   undef),
        'fw-skip'             => setv(T_STRING,0, 0, '',                   undef),
        'fw-login'            => setv(T_LOGIN, 0, 0, '',                   undef),
        'fw-password'         => setv(T_PASSWD,0, 0, '',                   undef),
        'fw-ssl-validate'     => setv(T_BOOL,  0, 0, 1,                    undef),
        'cmd'                 => setv(T_PROG,  0, 0, '',                   undef),
        'cmd-skip'            => setv(T_STRING,0, 0, '',                   undef),
        'ipv6'                => setv(T_BOOL,  0, 0, 0,                    undef),
        'ip'                  => setv(T_IP,    0, 1, undef,                undef),
        'wtime'               => setv(T_DELAY, 0, 1, 0,                    interval('30s')),
        'mtime'               => setv(T_NUMBER,0, 1, 0,                    undef),
        'atime'               => setv(T_NUMBER,0, 1, 0,                    undef),
        'status'              => setv(T_ANY,   0, 1, '',                   undef),
        'min-interval'        => setv(T_DELAY, 0, 0, interval('30s'),      0),
        'max-interval'        => setv(T_DELAY, 0, 0, interval('25d'),      0),
        'min-error-interval'  => setv(T_DELAY, 0, 0, interval('5m'),       0),

        'warned-min-interval'       => setv(T_ANY, 0, 1, 0,                undef),
        'warned-min-error-interval' => setv(T_ANY, 0, 1, 0,                undef),
    },
    'dyndns-common-defaults' => {
        'backupmx'            => setv(T_BOOL,  0, 1, 0,                    undef),
        'mx'                  => setv(T_OFQDN, 0, 1, '',                   undef),
        'static'              => setv(T_BOOL,  0, 1, 0,                    undef),
        'wildcard'            => setv(T_BOOL,  0, 1, 0,                    undef),
    },
);
my %services = (
    'changeip' => {
        'updateable' => undef,
        'update'     => \&nic_changeip_update,
        'examples'   => \&nic_changeip_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'min-interval' => setv(T_DELAY, 0, 0, 0,                  interval('5m')),
            'server'       => setv(T_FQDNP, 1, 0, 'nic.changeip.com', undef),
        },
    },
    'cloudflare' => {
        'updateable' => undef,
        'update'     => \&nic_cloudflare_update,
        'examples'   => \&nic_cloudflare_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'backupmx'     => setv(T_BOOL,   0, 1, 0,                              undef),
            'login'        => setv(T_LOGIN,  0, 0, 'token',                        undef),
            'min-interval' => setv(T_DELAY,  0, 0, interval('5m'),                 0),
            'mx'           => setv(T_OFQDN,  0, 1, '',                             undef),
            'server'       => setv(T_FQDNP,  1, 0, 'api.cloudflare.com/client/v4', undef),
            'static'       => setv(T_BOOL,   0, 1, 0,                              undef),
            'ttl'          => setv(T_NUMBER, 1, 0, 1,                              undef),
            'wildcard'     => setv(T_BOOL,   0, 1, 0,                              undef),
            'zone'         => setv(T_FQDN,   1, 0, '',                             undef),
        },
    },
    'cloudns' => {
        'updateable' => undef,
        'update' => \&nic_cloudns_update,
        'examples' => \&nic_cloudns_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'dynurl' => setv(T_STRING, 1, 0, undef, undef),
            # nic_updateable() assumes that every service uses a username and password but that is
            # not true for CloudNS. Silence warnings by redefining the username and password
            # variables as non-required with a non-empty default.
            'login'    => setv(T_STRING, 0, 0, 'unused', undef),
            'password' => setv(T_STRING, 0, 0, 'unused', undef),
        },
    },
    'dinahosting' => {
        'updateable' => undef,
        'update'     => \&nic_dinahosting_update,
        'examples'   => \&nic_dinahosting_examples,
        'variables'  => {
            %{$variables{'service-common-defaults'}},
            'min-error-interval' => setv(T_DELAY,  0, 0, interval('8m'),     0),
            'script'             => setv(T_STRING, 0, 1, '/special/api.php', undef),
            'server'             => setv(T_FQDNP,  1, 0, 'dinahosting.com',  undef),
        },
    },
    'dnsmadeeasy' => {
        'updateable' => undef,
        'update'     => \&nic_dnsmadeeasy_update,
        'examples'   => \&nic_dnsmadeeasy_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'script' => setv(T_STRING, 1, 1, '/servlet/updateip',  undef),
            'server' => setv(T_FQDNP,  1, 0, 'cp.dnsmadeeasy.com', undef),
        },
    },
    'dondominio' => {
        'updateable' => undef,
        'update'     => \&nic_dondominio_update,
        'examples'   => \&nic_dondominio_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'server' => setv(T_FQDNP, 1, 0, 'dondns.dondominio.com', undef),
        },
    },
    'dslreports1' => {
        'updateable' => undef,
        'update'     => \&nic_dslreports1_update,
        'examples'   => \&nic_dslreports1_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'server' => setv(T_FQDNP, 1, 0, 'www.dslreports.com', undef),
            'host' => setv(T_NUMBER, 1, 1, 0, undef),
        },
    },
    'duckdns' => {
        'updateable' => undef,
        'update'     => \&nic_duckdns_update,
        'examples'   => \&nic_duckdns_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'login'  => setv(T_LOGIN, 0, 0, 'unused',          undef),
            'server' => setv(T_FQDNP, 1, 0, 'www.duckdns.org', undef),
        },
    },
    'dyndns1' => {
        'updateable' => \&nic_dyndns2_updateable,
        'update'     => \&nic_dyndns1_update,
        'examples'   => \&nic_dyndns1_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            %{$variables{'dyndns-common-defaults'}},
        },
    },
    'dyndns2' => {
        'updateable' => \&nic_dyndns2_updateable,
        'update'     => \&nic_dyndns2_update,
        'examples'   => \&nic_dyndns2_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            %{$variables{'dyndns-common-defaults'}},
            'custom' => setv(T_BOOL,   0, 1, 0,             undef),
            'script' => setv(T_STRING, 1, 1, '/nic/update', undef),
        },
    },
    'easydns' => {
        'updateable' => undef,
        'update'     => \&nic_easydns_update,
        'examples'   => \&nic_easydns_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'backupmx'     => setv(T_BOOL,  0, 1, 0,                     undef),
            'min-interval' => setv(T_DELAY, 0, 0, interval('5m'),        0),
            'mx'           => setv(T_OFQDN, 0, 1, '',                    undef),
            'server'       => setv(T_FQDNP, 1, 0, 'members.easydns.com', undef),
            'wildcard'     => setv(T_BOOL,  0, 1, 0,                     undef),
        },
    },
    'freedns' => {
        'updateable' => undef,
        'update'     => \&nic_freedns_update,
        'examples'   => \&nic_freedns_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'min-interval' => setv(T_DELAY, 0, 0, 0,                    interval('5m')),
            'server'       => setv(T_FQDNP, 1, 0, 'freedns.afraid.org', undef),
        },
    },
    'freemyip' => {
        'updateable' => undef,
        'update'     => \&nic_freemyip_update,
        'examples'   => \&nic_freemyip_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'login'  => setv(T_LOGIN, 0, 0, 'unused',       undef),
            'server' => setv(T_FQDNP, 1, 0, 'freemyip.com', undef),
        },
    },
    'gandi' => {
        'updateable' => undef,
        'update'     => \&nic_gandi_update,
        'examples'   => \&nic_gandi_examples,
        'variables'  => {
            %{$variables{'service-common-defaults'}},
            'min-interval' => setv(T_DELAY,  0, 0, 0,               interval('5m')),
            'server'       => setv(T_FQDNP,  1, 0, 'api.gandi.net', undef),
            'script'       => setv(T_STRING, 1, 1, '/v5',           undef),
            'ttl'          => setv(T_DELAY,  0, 0, undef,           interval('5m')),
            'zone'         => setv(T_FQDN,   1, 0, undef,           undef),
            # Unused variables.
            'login'        => setv(T_STRING, 0, 0, 'unused', undef),
        }
    },
    'googledomains' => {
        'updateable' => undef,
        'update'     => \&nic_googledomains_update,
        'examples'   => \&nic_googledomains_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'min-interval' => setv(T_DELAY, 0, 0, interval('5m'),       0),
            'server'       => setv(T_FQDNP, 1, 0, 'domains.google.com', undef),
        },
    },
    'namecheap' => {
        'updateable' => undef,
        'update'     => \&nic_namecheap_update,
        'examples'   => \&nic_namecheap_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'min-interval' => setv(T_DELAY, 0, 0, 0, interval('5m')),
            'server'       => setv(T_FQDNP, 1, 0, 'dynamicdns.park-your-domain.com', undef),
        },
    },
    'nfsn' => {
        'updateable' => undef,
        'update'     => \&nic_nfsn_update,
        'examples'   => \&nic_nfsn_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'min_interval' => setv(T_FQDNP,  0, 0, 0,                          interval('5m')),
            'server'       => setv(T_FQDNP,  1, 0, 'api.nearlyfreespeech.net', undef),
            'ttl'          => setv(T_NUMBER, 1, 0, 300,                        undef),
            'zone'         => setv(T_FQDN,   1, 0, undef,                      undef),
        },
    },
    'noip' => {
        'updateable' => undef,
        'update'     => \&nic_noip_update,
        'examples'   => \&nic_noip_examples,
        'variables' => {
            'atime'                     => setv(T_NUMBER, 0, 1, 0,               undef),
            'custom'                    => setv(T_BOOL,   0, 1, 0,               undef),
            'host'                      => setv(T_STRING, 1, 1, '',              undef),
            'ip'                        => setv(T_IP,     0, 1, undef,           undef),
            'login'                     => setv(T_LOGIN,  1, 0, '',              undef),
            'max-interval'              => setv(T_DELAY,  0, 0, interval('25d'), 0),
            'min-error-interval'        => setv(T_DELAY,  0, 0, interval('5m'),  0),
            'min-interval'              => setv(T_DELAY,  0, 0, interval('30s'), 0),
            'mtime'                     => setv(T_NUMBER, 0, 1, 0,               undef),
            'password'                  => setv(T_PASSWD, 1, 0, '',              undef),
            'server'                    => setv(T_FQDNP,  1, 0, 'dynupdate.no-ip.com', undef),
            'static'                    => setv(T_BOOL,   0, 1, 0,               undef),
            'status'                    => setv(T_ANY,    0, 1, '',              undef),
            'warned-min-error-interval' => setv(T_ANY,    0, 1, 0,               undef),
            'warned-min-interval'       => setv(T_ANY,    0, 1, 0,               undef),
            'wtime'                     => setv(T_DELAY,  0, 1, 0,               interval('30s')),
        },
    },
    'nsupdate' => {
        'updateable' => undef,
        'update'     => \&nic_nsupdate_update,
        'examples'   => \&nic_nsupdate_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'login' => setv(T_LOGIN,  1, 0, '/usr/bin/nsupdate', undef),
            'tcp'   => setv(T_BOOL,   0, 1, 0,                   undef),
            'ttl'   => setv(T_NUMBER, 0, 1, 600,                 undef),
            'zone'  => setv(T_STRING, 1, 1, '',                  undef),
        },
    },
    'ovh' => {
        'updateable' => undef,
        'update'     => \&nic_ovh_update,
        'examples'   => \&nic_ovh_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'login'    => setv(T_LOGIN,  1, 0, '',            undef),
            'password' => setv(T_PASSWD, 1, 0, '',            undef),
            'script'   => setv(T_STRING, 1, 1, '/nic/update', undef),
            'server'   => setv(T_FQDNP,  1, 0, 'www.ovh.com', undef),
        },
    },
    'sitelutions' => {
        'updateable' => undef,
        'update'     => \&nic_sitelutions_update,
        'examples'   => \&nic_sitelutions_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'server'       => setv(T_FQDNP, 1, 0, 'www.sitelutions.com', undef),
            'min-interval' => setv(T_DELAY, 0, 0, 0,                     interval('5m')),
        },
    },
    'woima' => {
        'updateable' => undef,
        'update'     => \&nic_woima_update,
        'examples'   => \&nic_woima_examples,
        'variables' => {
            'atime'                     => setv(T_NUMBER, 0, 1, 0,               undef),
            'backupmx'                  => setv(T_BOOL,   0, 1, 0,               undef),
            'custom'                    => setv(T_BOOL,   0, 1, 0,               undef),
            'ip'                        => setv(T_IP,     0, 1, undef,           undef),
            'login'                     => setv(T_LOGIN,  1, 0, '',              undef),
            'max-interval'              => setv(T_DELAY,  0, 0, interval('25d'), 0),
            'min-error-interval'        => setv(T_DELAY,  0, 0, interval('5m'),  0),
            'min-interval'              => setv(T_DELAY,  0, 0, interval('30s'), 0),
            'mtime'                     => setv(T_NUMBER, 0, 1, 0,               undef),
            'mx'                        => setv(T_OFQDN,  0, 1, '',              undef),
            'password'                  => setv(T_PASSWD, 1, 0, '',              undef),
            'script'                    => setv(T_STRING, 1, 1, '/nic/update',   undef),
            'server'                    => setv(T_FQDNP,  1, 0, 'dyn.woima.fi',  undef),
            'static'                    => setv(T_BOOL,   0, 1, 0,               undef),
            'status'                    => setv(T_ANY,    0, 1, '',              undef),
            'warned-min-error-interval' => setv(T_ANY,    0, 1, 0,               undef),
            'warned-min-interval'       => setv(T_ANY,    0, 1, 0,               undef),
            'wildcard'                  => setv(T_BOOL,   0, 1, 0,               undef),
            'wtime'                     => setv(T_DELAY,  0, 1, 0,               interval('30s')),
        },
    },
    'yandex' => {
        'updateable' => undef,
        'update'     => \&nic_yandex_update,
        'examples'   => \&nic_yandex_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'min-interval' => setv(T_DELAY, 0, 0, interval('5m'),     0),
            'server'       => setv(T_FQDNP, 1, 0, 'pddimp.yandex.ru', undef),
        },
    },
    'zoneedit1' => {
        'updateable' => undef,
        'update'     => \&nic_zoneedit1_update,
        'examples'   => \&nic_zoneedit1_examples,
        'variables' => {
            %{$variables{'service-common-defaults'}},
            'min-interval' => setv(T_DELAY, 0, 0, interval('5m'),         0),
            'server'       => setv(T_FQDNP, 1, 0, 'dynamic.zoneedit.com', undef),
            'zone'         => setv(T_OFQDN, 0, 0, undef,                  undef),
        },
    },
);
$variables{'merged'} = {
    map({ %{$services{$_}{'variables'}} } keys(%services)),
    %{$variables{'dyndns-common-defaults'}},
    %{$variables{'service-common-defaults'}},
    %{$variables{'global-defaults'}},
};

# This will hold the processed args.
my %opt = ();
my $deprecated_handler = sub { warning("'-$_[0]' is deprecated and does nothing"); };
$opt{'fw-banlocal'} = $deprecated_handler;
$opt{'if-skip'} = $deprecated_handler;

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"],
    ["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>          : how the IP address should be obtained"],
    &ip_strategies_usage(),
    "",
    "  Options that apply to 'use=ip':",
    ["ip",           "=s", "-ip <address>         : set the IP address to <address>"],
    "",
    "  Options that apply to 'use=if':",
    ["if",           "=s", "-if <interface>       : obtain IP address from <interface>"],
    "",
    "  Options that apply to 'use=web':",
    ["web",          "=s", "-web <service>|<url>  : obtain IP address from a web-based IP discovery service, either a known <service> or a custom <url>"],
    ["web-skip",     "=s", "-web-skip <pattern>   : skip any IP addresses before <pattern> in the text returned from the web-based IP discovery service"],
    "",
    "  Options that apply to 'use=fw' and 'use=<device>':",
    ["fw",           "=s", "-fw <address>|<url>   : obtain IP address from device with IP address <address> or URL <url>"],
    ["fw-skip",      "=s", "-fw-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"],
    "",
    "  Options that apply to 'use=cmd':",
    ["cmd",          "=s", "-cmd <command>        : obtain IP address from the output of <command>"],
    ["cmd-skip",     "=s", "-cmd-skip <pattern>   : skip any IP addresses before <pattern> in the command's output"],
    "",
    ["login",        "=s", "-login <user>         : log in to the dynamic DNS service as <user>"],
    ["password",     "=s", "-password <secret>    : log in to the dynamic DNS service with password <secret>"],
    ["host",         "=s", "-host <host>          : update DNS information for <host>"],
    "",
    ["options",      "=s", "-options <opt>=<val>[,<opt>=<val>,...]\n                        : optional per-service arguments (see below)"],
    "",
    ["ssl",          "!",  "-{no}ssl              : do updates over encrypted SSL connection"],
    ["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"],
    ["curl",         "!",  "-{no}curl             : use curl for network connections"],
    ["retry",        "!",  "-{no}retry            : retry failed updates"],
    ["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>"],
    ["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"],
    ["ipv6",         "!",  "-{no}ipv6             : use ipv6"],
    ["help",         "",   "-help                 : display this message and exit"],
    ["postscript",   "",   "-postscript           : script to run after updating ddclient, has new IP as param"],
    ["query",        "!",  "-{no}query            : print {no} ip addresses and exit"],
    ["fw-banlocal",  "!",  ""], ## deprecated
    ["if-skip",      "=s", ""], ## deprecated
    ["test",         "!",  ""], ## hidden
    ["geturl",       "=s", ""], ## hidden
    "",
    nic_examples(),
    "$program version $version, ",
    "  originally written by Paul Burry, paul+ddclient\@burry.ca",
    "  project now maintained on https://github.com/ddclient/ddclient"
);

sub main {
    ## process args
    my $opt_usage = process_args(@opt);
    $saved_cache = '';
    %saved_opt = %opt;
    $result = 'OK';

    test_geturl(opt('geturl')) if opt('geturl');

    if (opt('help')) {
        printf "%s\n", $opt_usage;
        exit 0;
    }

    ## read config file because 'daemon' mode may be defined there.
    read_config($opt{'file'} // default('file'), \%config, \%globals);
    init_config();
    test_possible_ip() if opt('query');

    my $caught_hup  = 0;
    my $caught_term = 0;
    my $caught_int  = 0;
    $SIG{'HUP'}  = sub { $caught_hup  = 1; };
    $SIG{'TERM'} = sub { $caught_term = 1; };
    $SIG{'INT'}  = sub { $caught_int  = 1; };
    # don't fork() if foreground
    if (opt('foreground')) {
        ;
    } elsif (opt('daemon')) {
        $SIG{'CHLD'} = 'IGNORE';
        my $pid = fork;
        if ($pid < 0) {
            print STDERR "${program}: can not fork ($!)\n";
            exit -1;
        } elsif ($pid) {
            exit 0;
        }
        $SIG{'CHLD'} = 'DEFAULT';
        open(STDOUT, ">/dev/null");
        open(STDERR, ">/dev/null");
        open(STDIN,  "</dev/null");
        write_pid();
    }

    umask 077;
    do {
        $now    = time;
        $result = 'OK';
        %opt    = %saved_opt;
        if (opt('help')) {
            *STDERR = *STDOUT;
            printf("Help found");
        }

        read_config($opt{'file'} // default('file'), \%config, \%globals);
        init_config();
        read_cache(opt('cache'), \%cache);
        print_info() if opt('debug') && opt('verbose');

        fatal("invalid argument '-use %s'; possible values are:\n%s", $opt{'use'}, join("\n", ip_strategies_usage()))
            unless exists $ip_strategies{lc opt('use')};

        $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.") unless !opt('quiet') || opt('verbose') || !$daemon;
            $result = 1;

        } else {
            $result = $result eq 'OK' ? 0 : 1;
        }
    } while ($daemon && !$result && !$caught_term && !$caught_int);

    warning("caught SIGINT; exiting") if $caught_int;
    unlink_pid();
    sendmail();

    exit($result);
}

######################################################################
## runpostscript
######################################################################

sub runpostscript {
    my ($ip) = @_;

    if (defined $globals{postscript}) {
        if (-x $globals{postscript}) {
            system("$globals{postscript} $ip &");
        } else {
            warning("Can not execute post script: %s", $globals{postscript});
        }
    }
}

######################################################################
## update_nics
######################################################################
sub update_nics {
    my %examined = ();
    my %iplist   = ();

    foreach my $s (sort keys %services) {
        my (@hosts, %ips) = ();
        my $updateable = $services{$s}{'updateable'};
        my $update     = $services{$s}{'update'};

        foreach my $h (sort keys %config) {
            next if $config{$h}{'protocol'} ne lc($s);
            $examined{$h} = 1;
            # we only do this once per 'use' and argument combination
            my $use = opt('use', $h);
            my $arg_ip = opt('ip', $h) // '';
            my $arg_fw = opt('fw', $h) // '';
            my $arg_if = opt('if', $h) // '';
            my $arg_web = opt('web', $h) // '';
            my $arg_cmd = opt('cmd', $h) // '';
            my $ip = "";
            if (exists $iplist{$use}{$arg_ip}{$arg_fw}{$arg_if}{$arg_web}{$arg_cmd}) {
                $ip = $iplist{$use}{$arg_ip}{$arg_fw}{$arg_if}{$arg_web}{$arg_cmd};
            } else {
                $ip = get_ip($use, $h);
                if (!defined($ip)) {
                    warning("unable to determine IP address")
                        if !$daemon || opt('verbose');
                    next;
                }
                $iplist{$use}{$arg_ip}{$arg_fw}{$arg_if}{$arg_web}{$arg_cmd} = $ip;
            }
            $config{$h}{'wantip'} = $ip;
            next if !nic_updateable($h, $updateable);
            push @hosts, $h;
            $ips{$ip} = $h;
        }
        if (@hosts) {
            $0 = sprintf("%s - updating %s", $program, join(',', @hosts));
            &$update(@hosts);
            runpostscript(join ' ', keys %ips);
        }
    }
    foreach my $h (sort keys %config) {
        if (!exists $examined{$h}) {
            failed("%s was not updated because protocol %s is not supported.",
                   $h, $config{$h}{'protocol'} // '<undefined>');
        }
    }
    write_cache(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_cache($file)
######################################################################
sub write_cache {
    my ($file) = @_;

    ## merge the updated host entries into the cache.
    foreach my $h (keys %config) {
        if (!exists $cache{$h} || $config{$h}{'update'}) {
            map { $cache{$h}{$_} = $config{$h}{$_} } @{$config{$h}{'cacheable'}};

        } else {
            map { $cache{$h}{$_} = $config{$h}{$_} } qw(atime wtime status);
        }
    }

    ## construct the cache file.
    my $cache = "";
    foreach my $h (sort keys %cache) {
        my $opt = join(',', map { "$_=" . ($cache{$h}{$_} // '') } sort keys %{$cache{$h}});

        $cache .= sprintf "%s%s%s\n", $opt, ($opt ? ' ' : ''), $h;
    }
    $file = '' if defined($saved_cache) && $cache eq $saved_cache;

    ## write the updates and other entries to the cache file.
    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_cache = 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", $cache;

        close(FD);
    }
}
######################################################################
## read_cache($file) - called before reading the .conf
######################################################################
sub read_cache {
    my $file    = shift;
    my $config  = shift;
    my $globals = {};

    %{$config} = ();
    ## read the cache file ignoring anything on the command-line.
    if (-e $file) {
        my %saved = %opt;
        %opt         = ();
        $saved_cache = _read_config($config, $globals, "##\\s*$program-$version\\s*", $file);
        %opt         = %saved;

        foreach my $h (keys %cache) {
            if (exists $config->{$h}) {
                foreach (qw(atime mtime wtime ip status)) {
                    $config->{$h}{$_} = $cache{$h}{$_} if exists $cache{$h}{$_};
                }
            }
        }
    }
}
######################################################################
## parse_assignments(string) return (rest, %variables)
## parse_assignment(string)  return (name, value, rest)
######################################################################
sub parse_assignments {
    my ($rest) = @_;
    my %variables = ();

    while (1) {
        (my $name, my $value, $rest) = parse_assignment($rest);
        $rest =~ s/^[,\s]+//;
        return ($rest, %variables) if !defined($name);
        if ($name eq 'fw-banlocal' || $name eq 'if-skip') {
            warning("'$name' is deprecated and does nothing");
            next;
        }
        $variables{$name} = $value;
    }
}
sub parse_assignment {
    my ($rest) = @_;
    my ($name, $value);
    my ($escape, $quote) = (0, '');

    if ($rest =~ /^[,\s]*([a-z][0-9a-z_-]*)=(.*)/i) {
        ($name, $rest, $value) = ($1, $2, '');

        while (length(my $c = substr($rest, 0, 1))) {
            if ($escape) {
                $value .= $c;
                $escape = 0;
            } elsif ($c eq "\\") {
                $escape = 1;
            } elsif ($quote && $c eq $quote) {
                $quote = '';
            } elsif (!$quote && $c =~ /[\'\"]/) {
                $quote = $c;
            } elsif (!$quote && $c =~ /^[\n\s,]/) {
                # The terminating character is not consumed.
                last;
            } else {
                $value .= $c;
            }
            $rest = substr($rest,1);
        }
    }
    warning("assignment to '%s' ended with the escape character (\\)", $name) if $escape;
    warning("assignment to '%s' ended with an unterminated quote (%s)", $name, $quote) if $quote;
    return ($name, $value, $rest);
}
######################################################################
## read_config
######################################################################
sub read_config {
    my ($file, $config, $globals) = @_;
    _read_config($config, $globals, '', $file);
}
sub _read_config {
    # Configuration line format after comment and continuation
    # removal:
    #
    #   [opt=value, ...] [host[, ...] [login [password]]]
    #
    # Details:
    #   - No whitespace is allowed around the '=' in opt=value.
    #   - An option name may only contain lowercase letters, numbers,
    #     underscore, and hyphen-minus, and must start with a letter.
    #   - A value or hostname is terminated by unquoted whitespace
    #     (including newline) or an unquoted comma followed by
    #     optional whitespace.
    #   - Values (but not hosts, login, or password) may contain
    #     quoted parts:
    #       - A backslash that itself is not quoted by another
    #         backslash quotes the next character.
    #       - An unquoted single quote quotes the subsequent
    #         non-backslash, non-newline characters until the next
    #         single quote.
    #       - An unquoted double quote quotes the subsequent
    #         non-backslash, non-newline characters until the next
    #         double quote.
    #   - login and password must not contain whitespace.
    #   - login must not start or end with a comma.
    #   - password must not start with a comma.
    #   - If no host is specified (either via a 'host=' option or
    #     after the options), the options are stored in %{$2}.
    #     Otherwise, the options are combined with the global values
    #     accumulated thus far and stored in $1->{$host} for each
    #     referenced host.

    my $config  = shift;
    my $globals = shift;
    my $stamp   = shift;
    local $file = shift;
    my %globals = ();
    my %config  = ();
    my $content = '';

    local *FD;
    if (!open(FD, "< $file")) {
        warning("Cannot open file '%s'. (%s)", $file, $!);
    }
    # Check for only owner has any access to config file
    my ($dev, $ino, $mode, @statrest) = stat(FD);
    if ($mode & 077) {
        if (-f FD && (chmod 0600, $file)) {
            warning("file %s must be accessible only by its owner (fixed).", $file);
        } else {
            warning("file %s must be accessible only by its owner.", $file);
        }
    }

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

        $lineno++;

        ## check for the program version stamp
        if (($. == 1) && $stamp && ($_ !~ /^$stamp$/i)) {
            warning("program version mismatch; ignoring %s", $file);
            last;
        }
        if (/\\\s+$/) {
            warning("whitespace follows the \\ at the end-of-line.\nIf you meant to have a line continuation, remove the trailing whitespace.");
        }

        $content .= "$_\n" unless /^#/;

        ## parsing passwords is special
        if (/^([^#]*\s)?([^#]*?password\S*?)\s*=\s*('.*'|[^']\S*)(.*)/) {
            my ($head, $key, $value, $tail) = ($1 // '', $2, $3, $4);
            $value = $1 if $value =~ /^'(.*)'$/;
            $passwords{$key} = $value;
            $_ = "${head}${key}=dummy${tail}";
        }

        ## remove comments
        s/#.*//;

        ## handle continuation lines
        $_ = "$continuation$_";
        if (/\\$/) {
            chop;
            $continuation = $_;
            next;
        }
        $continuation = '';

        s/^\s+//;     # remove leading white space
        s/\s+$//;     # remove trailing white space
        s/\s+/ /g;    # canonify
        next if /^$/;

        my %locals;
        ($_, %locals) = parse_assignments($_);
        s/\s*,\s*/,/g;
        my @args = split;

        ## verify that keywords are valid...and check the value
        foreach my $k (keys %locals) {
            $locals{$k} = $passwords{$k} if defined $passwords{$k};
            if (!exists $variables{'merged'}{$k}) {
                warning("unrecognized keyword '%s' (ignored)", $k);
                delete $locals{$k};
            } else {
                my $def = $variables{'merged'}{$k};
                my $value = check_value($locals{$k}, $def);
                if (!defined($value)) {
                    warning("Invalid Value for keyword '%s' = '%s'", $k, $locals{$k});
                    delete $locals{$k};
                } else { $locals{$k} = $value; }
            }
        }
        if (exists($locals{'host'})) {
            $args[0] = @args ? "$args[0],$locals{host}" : "$locals{host}";
        }
        ## accumulate globals
        if ($#args < 0) {
            map { $globals{$_} = $locals{$_} } keys %locals;
        }

        ## process this host definition
        if (@args) {
            my ($host, $login, $password) = @args;

            ## add in any globals..
            %locals = %{merge(\%locals, \%globals)};

            ## override login and password if specified the old way.
            $locals{'login'}    = $login    if defined $login;
            $locals{'password'} = $password if defined $password;

            ## allow {host} to be a comma separated list of hosts
            foreach my $h (split_by_comma($host)) {
                ## save a copy of the current globals
                $config{$h} = { %locals };
                $config{$h}{'host'} = $h;
            }
        }
        %passwords = ();
    }
    close(FD);

    warning("file ends while expecting a continuation line.")
        if $continuation;

    %$globals = %globals;
    %$config  = %config;

    return $content;
}
######################################################################
## init_config -
######################################################################
sub init_config {
    %opt = %saved_opt;

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

    ## infer the IP strategy if possible
    if (!defined($opt{'use'})) {
        $opt{'use'} = 'web' if defined($opt{'web'});
        $opt{'use'} = 'if'  if defined($opt{'if'});
        $opt{'use'} = 'ip'  if defined($opt{'ip'});
    }

    ## sanity check
    $opt{'max-interval'}       = min(interval(opt('max-interval')), interval(default('max-interval')));
    $opt{'min-interval'}       = max(interval(opt('min-interval')), interval(default('min-interval')));
    $opt{'min-error-interval'} = max(interval(opt('min-error-interval')), interval(default('min-error-interval')));

    $opt{'timeout'} = 0 if opt('timeout') < 0;

    ## parse an interval expression (such as '5m') into number of seconds
    $opt{'daemon'} = interval(opt('daemon')) if defined($opt{'daemon'});
    ## make sure the interval isn't too short
    $opt{'daemon'} = minimum('daemon') if opt('daemon') > 0 && opt('daemon') < minimum('daemon');

    ## define or modify host options specified on the command-line
    if (exists $opt{'options'} && defined $opt{'options'}) {
        ## collect cmdline configuration options.
        my %options = ();
        foreach my $opt (split_by_comma($opt{'options'})) {
            my ($name, $var) = split /\s*=\s*/, $opt;
            if ($name eq 'fw-banlocal' || $name eq 'if-skip') {
                warning("'$name' is deprecated and does nothing");
                next;
            }
            $options{$name} = $var;
        }
        ## determine hosts specified with -host
        my @hosts = ();
        if (exists $opt{'host'}) {
            foreach my $h (split_by_comma($opt{'host'})) {
                push @hosts, $h;
            }
        }
        ## and those in -options=...
        if (exists $options{'host'}) {
            foreach my $h (split_by_comma($options{'host'})) {
                push @hosts, $h;
            }
            delete $options{'host'};
        }
        ## merge options into host definitions or globals
        if (@hosts) {
            foreach my $h (@hosts) {
                $config{$h} = merge(\%options, $config{$h});
            }
            $opt{'host'} = join(',', @hosts);
        } else {
            %globals = %{merge(\%options, \%globals)};
        }
    }

    ## override global options with those on the command-line.
    foreach my $o (keys %opt) {
        if (defined $opt{$o} && exists $variables{'global-defaults'}{$o}) {
            $globals{$o} = $opt{$o};
        }
    }

    ## sanity check
    if (defined $opt{'host'} && defined $opt{'retry'}) {
        fatal("options -retry and -host (or -option host=..) are mutually exclusive");
    }

    ## determine hosts to update (those on the cmd-line, config-file, or failed cached)
    my @hosts = keys %config;
    if (opt('host')) {
        @hosts = split_by_comma($opt{'host'});
    }
    if (opt('retry')) {
        @hosts = map { $_ if $cache{$_}{'status'} ne 'good' } keys %cache;
    }

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

    ## collect the cacheable variables.
    foreach my $proto (keys %services) {
        my @cacheable = ();
        foreach my $k (keys %{$services{$proto}{'variables'}}) {
            push @cacheable, $k if $services{$proto}{'variables'}{$k}{'cache'};
        }
        $services{$proto}{'cacheable'} = [ @cacheable ];
    }

    ## sanity check..
    ## make sure config entries have all defaults and they meet minimums
    ## first the globals...
    foreach my $k (keys %globals) {
        my $def    = $variables{'merged'}{$k};
        my $ovalue = $globals{$k} // $def->{'default'};
        my $value  = check_value($ovalue, $def);
        if ($def->{'required'} && !defined $value) {
            $value = default($k);
            warning("'%s=%s' is an invalid %s. (using default of %s)", $k, $ovalue, $def->{'type'}, $value);
        }
        $globals{$k} = $value;
    }

    ## now the host definitions...
  HOST:
    foreach my $h (keys %config) {
        my $proto;
        $proto = $config{$h}{'protocol'};
        $proto = opt('protocol') if !defined($proto);

        load_sha1_support($proto) if (grep (/^$proto$/, ("freedns", "nfsn")));
        load_json_support($proto) if (grep (/^$proto$/, ("cloudflare", "gandi", "yandex", "nfsn")));

        if (!exists($services{$proto})) {
            warning("skipping host: %s: unrecognized protocol '%s'", $h, $proto);
            delete $config{$h};

        } else {
            my $svars = $services{$proto}{'variables'};
            my $conf  = { 'protocol' => $proto };

            foreach my $k (keys %$svars) {
                my $def    = $svars->{$k};
                my $ovalue = $config{$h}{$k} // $def->{'default'};
                my $value  = check_value($ovalue, $def);
                if ($def->{'required'} && !defined $value) {
                    warning("skipping host: %s: '%s=%s' is an invalid %s.", $h, $k, $ovalue, $def->{'type'});
                    delete $config{$h};
                    next HOST;
                }
                $conf->{$k} = $value;

            }
            $config{$h} = $conf;
            $config{$h}{'cacheable'} = [ @{$services{$proto}{'cacheable'}} ];
        }
    }
}

######################################################################
## process_args -
######################################################################
sub process_args {
    my @spec  = ();
    my $usage = "";

    foreach (@_) {
        if (ref $_) {
            my ($key, $specifier, $arg_usage) = @$_;
            my $value = default($key);

            ## add a option specifier
            push @spec, $key . $specifier;

            ## define the default value which can be overwritten later
            $opt{$key} = undef unless exists($opt{$key});

            next unless $arg_usage;

            ## add a line to the usage;
            $usage .= "  $arg_usage";
            if (defined($value) && $value ne '') {
                $usage .= " (default: ";
                if ($specifier eq '!') {
                    $usage .= "no" if ($specifier eq '!') && !$value;
                    $usage .= $key;
                } else {
                    $usage .= $value;
                }
                $usage .= ")";
            }
            $usage .= ".";
        } else {
            $usage .= $_;
        }
        $usage .= "\n";
    }
    ## process the arguments
    if (!GetOptions(\%opt, @spec)) {
        $opt{"help"} = 1;
    }
    return $usage;
}

######################################################################
## test_possible_ip - print possible IPs
######################################################################
sub test_possible_ip {
    local $opt{'debug'} = 0;

    printf "use=ip, ip=%s address is %s\n", opt('ip'), get_ip('ip') // 'NOT FOUND'
        if defined opt('ip');

    {
        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;
        foreach my $if (@ifs) {
            local $opt{'if'} = $if;
            printf "use=if, if=%s address is %s\n", opt('if'), get_ip('if') // 'NOT FOUND';
        }
    }
    if (opt('fw')) {
        if (opt('fw') !~ m%/%) {
            foreach my $fw (sort keys %builtinfw) {
                local $opt{'use'} = $fw;
                printf "use=%s address is %s\n", $fw, get_ip($fw) // 'NOT FOUND';
            }
        }
        local $opt{'use'} = 'fw';
        printf "use=fw, fw=%s address is %s\n", opt('fw'), get_ip(opt('fw')) // 'NOT FOUND'
            if !exists $builtinfw{opt('fw')};

    }
    {
        local $opt{'use'} = 'web';
        foreach my $web (sort keys %builtinweb) {
            local $opt{'web'} = $web;
            printf "use=web, web=%s address is %s\n", $web, get_ip('web') // 'NOT FOUND';
        }
        printf "use=web, web=%s address is %s\n", opt('web'), get_ip('web') // 'NOT FOUND'
            if !exists $builtinweb{opt('web')};
    }
    if (opt('cmd')) {
        local $opt{'use'} = 'cmd';
        printf "use=cmd, cmd=%s address is %s\n", opt('cmd'), get_ip('cmd') // 'NOT FOUND';
    }
    exit 0 unless opt('debug');
}
######################################################################
## test_geturl - print (and save if -test) result of fetching a URL
######################################################################
sub test_geturl {
    my $url = shift;

    my $reply = geturl(
        proxy => opt('proxy'),
        url => $url,
        login => opt('login'),
        password => opt('password'),
    );
    print "URL $url\n";
    print $reply // "<undefined>\n";
    exit;
}
######################################################################
## load_file
######################################################################
sub load_file {
    my $file   = shift;
    my $buffer = '';

    if (exists($ENV{'TEST_CASE'})) {
        my $try = "$file-$ENV{'TEST_CASE'}";
        $file = $try if -f $try;
    }

    local *FD;
    if (open(FD, "< $file")) {
        read(FD, $buffer, -s FD);
        close(FD);
        debug("Loaded %d bytes from %s", length($buffer), $file);
    } else {
        debug("Load failed from %s (%s)", $file, $!);
    }
    return $buffer;
}
######################################################################
## save_file
######################################################################
sub save_file {
    my ($file, $buffer, $opt) = @_;

    $file .= "-$ENV{'TEST_CASE'}" if exists $ENV{'TEST_CASE'};
    if (defined $opt) {
        my $i = 0;
        while (-f "$file-$i") {
            if ('unique' =~ /^$opt/i) {
                my $a = join('\n', grep {!/^Date:/} split /\n/, $buffer);
                my $b = join('\n', grep {!/^Date:/} split /\n/, load_file("$file-$i"));
                last if $a eq $b;
            }
            $i++;
        }
        $file = "$file-$i";
    }
    debug("Saving to %s", $file);
    local *FD;
    open(FD, "> $file") or return;
    print FD $buffer;
    close(FD);
    return $buffer;
}
######################################################################
## print_opt
## print_globals
## print_config
## print_cache
## print_info
######################################################################
sub _print_hash {
    my ($string, $ptr) = @_;
    my $value = $ptr;

    if (!defined($ptr)) {
        $value = "<undefined>";
    } elsif (ref $ptr eq 'HASH') {
        foreach my $key (sort keys %$ptr) {
            _print_hash("${string}\{$key\}", $ptr->{$key});
        }
        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_cache   { print_hash("cache",   \%cache);   }
sub print_info {
    print_opt();
    print_globals();
    print_config();
    print_cache();
}
######################################################################
## pipecmd      - run an external command
## logger
## sendmail
######################################################################
sub pipecmd {
    my $cmd   = shift;
    my $stdin = join("\n", @_);
    my $ok    = 0;

    ## remove trailing newlines
    1 while chomp($stdin);

    ## override when debugging.
    $cmd = opt('exec') ? "| $cmd" : "> /dev/null";

    ## execute the command.
    local *FD;
    if (!open(FD, $cmd)) {
        printf STDERR "%s: cannot execute command %s.\n", $program, $cmd;

    } elsif ($stdin && (!print FD "$stdin\n")) {
        printf STDERR "%s: failed writting to %s.\n", $program, $cmd;
        close(FD);

    } elsif (!close(FD)) {
        printf STDERR "%s: failed closing %s.(%s)\n", $program, $cmd, $@;

    } elsif (opt('exec') && $?) {
        printf STDERR "%s: failed %s. (%s)\n", $program, $cmd, $@;

    } else {
        $ok = 1;
    }
    return $ok;
}
sub logger {
    if (opt('syslog') && opt('facility') && opt('priority')) {
        my $facility = opt('facility');
        my $priority = opt('priority');
        return pipecmd("logger -p$facility.$priority -t${program}\[$$\]", @_);
    }
    return 1;
}
sub sendmail {
    my $recipients = opt('mail');

    if (opt('mail-failure') && ($result ne 'OK' && $result ne '0')) {
        $recipients = opt('mail-failure');
    }
    if ($msgs && $recipients && $msgs ne $last_msgs) {
        pipecmd("sendmail -oi $recipients",
                "To: $recipients",
                "Subject: status report from $program\@$hostname",
                "\r\n",
                $msgs,
                "",
                "regards,",
                "   $program\@$hostname (version $version)"
        );
    }
    $last_msgs = $msgs;
    $msgs      = '';
}
######################################################################
##  split_by_comma
##  merge
##  default
##  minimum
##  opt
######################################################################
sub split_by_comma {
    my $string = shift;

    return split /\s*[, ]\s*/, $string if defined $string;
    return ();
}
sub merge {
    my %merged = ();
    foreach my $h (@_) {
        foreach my $k (keys %$h) {
            $merged{$k} = $h->{$k} unless exists $merged{$k};
        }
    }
    return \%merged;
}
sub default {
    my $v = shift;
    return $variables{'merged'}{$v}{'default'};
}
sub minimum {
    my $v = shift;
    return $variables{'merged'}{$v}{'minimum'};
}
sub opt {
    my $v = shift;
    my $h = shift;
    return $config{$h}{$v} if defined($h) && defined($config{$h}{$v});
    return $opt{$v} // $globals{$v} // default($v);
}
sub min {
    my $min = shift;
    foreach my $arg (@_) {
        $min = $arg if $arg < $min;
    }
    return $min;
}
sub max {
    my $max = shift;
    foreach 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';
    foreach (qw(yes true)) {
        return $yes if $_ =~ /^$value/i;
    }
    foreach (qw(no false)) {
        return $no if $_ =~ /^$value/i;
    }
    return $undef;
}
######################################################################
## msg
## debug
## warning
## fatal
######################################################################
sub _msg {
    my $fh     = shift;
    my $log    = shift;
    my $prefix = shift;
    my $format = shift;
    my $buffer = sprintf $format, @_;
    chomp($buffer);

    $prefix = sprintf "%-9s ", $prefix if $prefix;
    if ($file) {
        $prefix .= "file $file";
        $prefix .= ", line $lineno" if $lineno;
        $prefix .= ": ";
    }
    if ($prefix) {
        $buffer = "$prefix$buffer";
        $buffer =~ s/\n/\n$prefix/g;
    }
    $buffer .= "\n";
    print $fh $buffer;

    $msgs .= $buffer if $log;
    logger($buffer) if $log;

}
sub msg     { _msg(*STDOUT, 0, '',         @_);                                   }
sub verbose { _msg(*STDOUT, 1, @_)             if opt('verbose');                 }
sub info    { _msg(*STDOUT, 1, 'INFO:',    @_) if opt('verbose');                 }
sub debug   { _msg(*STDOUT, 0, 'DEBUG:',   @_) if opt('debug');                   }
sub debug2  { _msg(*STDOUT, 0, 'DEBUG:',   @_) if opt('debug') && opt('verbose'); }
sub warning { _msg(*STDERR, 1, 'WARNING:', @_);                                   }
sub fatal   { _msg(*STDERR, 1, 'FATAL:',   @_); sendmail(); exit(1);              }
sub success { _msg(*STDOUT, 1, 'SUCCESS:', @_);                                   }
sub failed  { _msg(*STDERR, 1, 'FAILED:',  @_); $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 !~ /^\d+$/) {
        $value = undef;
    }
    return $value;
}
sub interval_expired {
    my ($host, $time, $interval) = @_;

    return 1 if !exists $cache{$host};
    return 1 if !exists $cache{$host}{$time}      || !$cache{$host}{$time};
    return 1 if !exists $config{$host}{$interval} || !$config{$host}{$interval};

    return $now > ($cache{$host}{$time} + $config{$host}{$interval});
}



######################################################################
## check_value
######################################################################
sub check_value {
    my ($value, $def) = @_;
    my $type     = $def->{'type'};
    my $min      = $def->{'minimum'};
    my $required = $def->{'required'};

    if (!defined $value && !$required) {
        ;

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

    } elsif ($type eq T_NUMBER) {
        return undef if $value !~ /^\d+$/;
        $value = $min if defined($min) && $value < $min;

    } elsif ($type eq T_BOOL) {
        if ($value =~ /^(y(es)?|t(rue)?|1)$/i) {
            $value = 1;
        } elsif ($value =~ /^(n(o)?|f(alse)?|0)$/i) {
            $value = 0;
        } else {
            return undef;
        }
    } elsif ($type eq T_FQDN || $type eq T_OFQDN && $value ne '') {
        $value = lc $value;
        return undef if $value !~ /[^.]\.[^.]/;

    } elsif ($type eq T_FQDNP) {
        $value = lc $value;
        return undef if $value !~ /[^.]\.[^.].*(:\d+)?$/;

    } elsif ($type eq T_PROTO) {
        $value = lc $value;
        return undef if !exists $services{$value};

    } elsif ($type eq T_USE) {
        $value = lc $value;
        return undef if !exists $ip_strategies{$value};

    } elsif ($type eq T_FILE) {
        return undef if $value eq "";

    } elsif ($type eq T_IF) {
        return undef if $value !~ /^[a-zA-Z0-9:._-]+$/;

    } elsif ($type eq T_PROG) {
        return undef if $value eq "";

    } elsif ($type eq T_LOGIN) {
        return undef if $value eq "";

    } elsif ($type eq T_IP) {
        return undef if !is_ipv4($value) && !is_ipv6($value);
    }
    return $value;
}
######################################################################
## encode_base64 - from MIME::Base64
######################################################################
sub encode_base64 ($;$) {
    my $res = '';
    my $eol = $_[1];
    $eol = "\n" unless defined $eol;
    pos($_[0]) = 0;  # ensure start at the beginning
    while ($_[0] =~ /(.{1,45})/gs) {
        $res .= substr(pack('u', $1), 1);
        chop($res);
    }
    $res =~ tr|` -_|AA-Za-z0-9+/|;  # `# help emacs

    # fix padding at the end
    my $padding = (3 - length($_[0]) % 3) % 3;
    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
    $res;
}
######################################################################
## load_ssl_support
######################################################################
sub load_ssl_support {
    my $ssl_loaded = eval { require IO::Socket::SSL };
    unless ($ssl_loaded) {
        fatal("%s", <<"EOM");
Error loading the Perl module IO::Socket::SSL needed for SSL connect.
On Debian, the package libio-socket-ssl-perl must be installed.
On Red Hat, the package perl-IO-Socket-SSL must be installed.
On Alpine, the package perl-io-socket-ssl must be installed.
EOM
    }
    import IO::Socket::SSL;
    { no warnings; $IO::Socket::SSL::DEBUG = 0; }
}

######################################################################
## load_ipv6_support
######################################################################
sub load_ipv6_support {
    my $ipv6_loaded = eval { require IO::Socket::INET6 };
    unless ($ipv6_loaded) {
        fatal("%s", <<"EOM");
Error loading the Perl module IO::Socket::INET6 needed for ipv6 connect.
On Debian, the package libio-socket-inet6-perl must be installed.
On Red Hat, the package perl-IO-Socket-INET6 must be installed.
On Alpine, the package perl-io-socket-inet6 must be installed.
EOM
    }
    import IO::Socket::INET6;
    { no warnings; $IO::Socket::INET6::DEBUG = 0; }
}

######################################################################
## load_sha1_support
######################################################################
sub load_sha1_support {
    my $why         = shift;
    my $sha1_loaded = eval { require Digest::SHA1 };
    my $sha_loaded  = eval { require Digest::SHA };
    unless ($sha1_loaded || $sha_loaded) {
        fatal("%s", <<"EOM");
Error loading the Perl module Digest::SHA1 or Digest::SHA needed for $why update.
On Debian, the package libdigest-sha1-perl or libdigest-sha-perl must be installed.
EOM
    }
    if ($sha1_loaded) {
        import Digest::SHA1 (qw/sha1_hex/);
    } elsif ($sha_loaded) {
        import Digest::SHA (qw/sha1_hex/);
    }
}
######################################################################
## load_json_support
######################################################################
sub load_json_support {
    my $why = shift;
    my $json_loaded = eval { require JSON::PP };
    unless ($json_loaded) {
        fatal("%s", <<"EOM");
Error loading the Perl module JSON::PP needed for $why update.
EOM
    }
    import JSON::PP (qw/decode_json encode_json/);
}

######################################################################
## geturl
######################################################################
sub geturl {
    return opt('curl') ? fetch_via_curl(@_) : fetch_via_socket_io(@_);
}

sub fetch_via_socket_io {
    my %params = @_;
    my $proxy = $params{proxy};
    my $url = $params{url};
    my $login = $params{login};
    my $password = $params{password};
    my $ipversion = $params{ipversion} // '';
    my $headers = $params{headers} // '';
    my $method = $params{method} // 'GET';
    my $data = $params{data} // '';
    my ($peer, $server, $port, $default_port, $use_ssl);
    my ($sd, $request, $reply);

    ## canonify proxy and url
    my $force_ssl;
    $force_ssl = 1 if ($url =~ /^https:/);
    $proxy  =~ s%^https?://%%i if defined($proxy);
    $url    =~ s%^https?://%%i;
    $server = $url;
    $server =~ s%[?/].*%%;
    $url    =~ s%^[^?/]*/?%%;

    if ($force_ssl || ($globals{'ssl'} && !($params{ignore_ssl_option} // 0))) {
        $use_ssl      = 1;
        $default_port = '443';
    } else {
        $use_ssl      = 0;
        $default_port = '80';
    }
    debug("proxy    = %s", $proxy // '<undefined>');
    debug("protocol = %s", $use_ssl ? "https" : "http");
    debug("server   = %s", $server);
    (my $_url = $url) =~ s%\?.*%?<redacted>%; #redact possible credentials
    debug("url      = %s", $_url);
    debug("ip ver   = %s", $ipversion);

    ## determine peer and port to use.
    $peer = $proxy // $server;
    $peer =~ s%[?/].*%%;
    if ($peer =~ /^\[([^]]+)\](?::(\d+))?$/ || $peer =~ /^([^:]+)(?::(\d+))?/) {
        $peer = $1;
        $port = $2 // $default_port;
    } else {
        failed("unable to extract host and port from %s", $peer);
        return undef;
    }

    $request = "$method ";
    if (!$use_ssl) {
        $request .= "http://$server" if defined($proxy);
    } else {
        $request .= "https://$server" if defined($proxy);
    }
    $request .= "/$url HTTP/1.0\n";
    $request .= "Host: $server\n";

    if (defined($login) || defined($password)) {
        my $auth = encode_base64(($login // '') . ':' . ($password // ''), '');
        $request .= "Authorization: Basic $auth\n";
    }
    $request .= "User-Agent: ${program}/${version}\n";
    if ($data) {
        $request .= "Content-Type: application/x-www-form-urlencoded\n" if $headers !~ /^Content-Type:/mi;
        $request .= "Content-Length: " . length($data) . "\n";
    }
    $request .= "Connection: close\n";
    $headers .= "\n" if $headers ne '' && substr($headers, -1) ne "\n";
    $request .= $headers;
    $request .= "\n";
    # RFC 7230 says that all lines before the body must end with <cr><lf>.
    (my $rq = $request) =~ s/(?<!\r)\n/\r\n/g;
    $request .= $data;
    $rq .= $data;

    my %socket_args = (
        PeerAddr => $peer,
        PeerPort => $port,
        Proto => 'tcp',
        MultiHomed => 1,
        Timeout => opt('timeout'),
    );
    my $socket_class = 'IO::Socket::INET';
    if ($use_ssl) {
        # IO::Socket::SSL will load IPv6 support if available on the system.
        load_ssl_support;
        $socket_class = 'IO::Socket::SSL';
        $socket_args{SSL_ca_file} = opt('ssl_ca_file') if defined(opt('ssl_ca_file'));
        $socket_args{SSL_ca_path} = opt('ssl_ca_dir') if defined(opt('ssl_ca_dir'));
        $socket_args{SSL_verify_mode} = ($params{ssl_validate} // 1)
                                        ? IO::Socket::SSL->SSL_VERIFY_PEER
                                        : IO::Socket::SSL->SSL_VERIFY_NONE;
    } elsif ($globals{'ipv6'} || $ipversion eq '6') {
        load_ipv6_support;
        $socket_class = 'IO::Socket::INET6';
    }
    if (defined($params{_testonly_socket_class})) {
        $socket_args{original_socket_class} = $socket_class;
        $socket_class = $params{_testonly_socket_class};
    }
    if ($ipversion eq '4') {
        $socket_args{Domain} = PF_INET;
        $socket_args{Family} = AF_INET;
    } elsif ($ipversion eq '6') {
        $socket_args{Domain} = PF_INET6;
        $socket_args{Family} = AF_INET6;
    } elsif ($ipversion ne '') {
        fatal("geturl passed unsupported 'ipversion' value %s", $ipversion);
    }

    my $ipv = $ipversion eq '' ? '' : sprintf(" (IPv%s)", $ipversion);
    my $peer_port_ipv = sprintf("%s:%s%s", $peer, $port, $ipv);
    my $to = sprintf("%s%s%s", $server, defined($proxy) ? " via proxy $peer:$port" : "", $ipv);
    verbose("CONNECT:", "%s", $to);
    $0 = sprintf("%s - connecting to %s", $program, $peer_port_ipv);
    if (opt('exec')) {
        $sd = $socket_class->new(%socket_args);
        defined($sd) or warning("cannot connect to %s socket: %s%s", $peer_port_ipv, $@,
                                $use_ssl ? ' ' . IO::Socket::SSL::errstr() : '');
    } else {
        debug("skipped network connection");
        verbose("SENDING:", "%s", $request);
    }
    if (defined $sd) {
        ## send the request to the http server
        verbose("CONNECTED: ", $use_ssl ? 'using SSL' : 'using HTTP');
        verbose("SENDING:", "%s", $request);

        $0 = sprintf("%s - sending to %s", $program, $peer_port_ipv);
        my $result = syswrite $sd, $rq;
        if ($result != length($rq)) {
            warning("cannot send to %s (%s).", $peer_port_ipv, $!);
        } else {
            $0 = sprintf("%s - reading from %s", $program, $peer_port_ipv);
            eval {
                local $SIG{'ALRM'} = sub { die "timeout"; };
                alarm(opt('timeout')) if opt('timeout') > 0;
                while ($_ = <$sd>) {
                    $0 = sprintf("%s - read from %s", $program, $peer_port_ipv);
                    verbose("RECEIVE:", "%s", $_ // "<undefined>");
                    $reply .= $_ // '';
                }
                if (opt('timeout') > 0) {
                    alarm(0);
                }
            };
            close($sd);

            if ($@ and $@ =~ /timeout/) {
                warning("TIMEOUT: %s after %s seconds", $to, opt('timeout'));
                $reply = '';
            }
            $reply //= '';
        }
    }
    $0 = sprintf("%s - closed %s", $program, $peer_port_ipv);

    ## during testing simulate reading the URL
    if (opt('test')) {
        my $filename = "$server/$url";
        $filename =~ s|/|%2F|g;
        if (opt('exec')) {
            $reply = save_file("$savedir/$filename", $reply, 'unique');
        } else {
            $reply = load_file("$savedir/$filename");
        }
    }

    $reply =~ s/\r//g if defined $reply;
    return $reply;
}

######################################################################
## curl_cmd() function to execute system curl command
######################################################################
sub curl_cmd {
    my @params = @_;
    my $tmpfile;
    my $tfh;
    my $system_curl = quotemeta(subst_var('@CURL@', '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 => "You requested network access with curl but $system_curl was not found",
    );

    debug("CURL: %s", $system_curl);
    fatal("curl not found") if ($system_curl 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);
    my $reply = qx{ $system_curl --config $tmpfile 2>/dev/null; };
    if ((my $rc = $?>>8) != 0) {
        warning("CURL error (%d) %s", $rc, $curl_codes{$rc} // "Unknown return code. Check $system_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;
}

######################################################################
## fetch_via_curl() is used for geturl() when global curl option set
######################################################################
sub fetch_via_curl {
    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 $force_ssl = 0;
    my $protocol;
    my $timeout  = opt('timeout');
    my @curlopt = ();
    my @header_lines = ();

    ## canonify proxy and url
    $force_ssl = 1 if ($url =~ /^https:/);
    $proxy  =~ s%^https?://%%i if defined($proxy);
    $url    =~ s%^https?://%%i;
    $server = $url;
    $server =~ s%[?/].*%%;
    $url    =~ s%^[^?/]*/?%%;

    $use_ssl = 1 if ($force_ssl || ($globals{'ssl'} && !($params{ignore_ssl_option} // 0)));

    $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);
    debug("ip ver   = %s", $ipversion);

    if (!opt('exec')) {
        debug("skipped network connection");
        verbose("SENDING:", "%s", "${server}/${url}");
    } else {
        my $curl_loaded = eval { require WWW::Curl::Easy };
        if ($curl_loaded) {
            # System has the WWW::Curl::Easy module so use that
            import WWW::Curl::Easy;
            my $curl = WWW::Curl::Easy->new;

            $curl->setopt(WWW::Curl::Easy->CURLOPT_HEADER, 1);   ## Include HTTP response for compatibility
            $curl->setopt(WWW::Curl::Easy->CURLOPT_SSL_VERIFYPEER, ($params{ssl_validate} // 1) ? 1 : 0 );
            $curl->setopt(WWW::Curl::Easy->CURLOPT_SSL_VERIFYHOST, ($params{ssl_validate} // 1) ? 1 : 0 );
            $curl->setopt(WWW::Curl::Easy->CURLOPT_CAINFO, opt('ssl_ca_file')) if defined(opt('ssl_ca_file'));
            $curl->setopt(WWW::Curl::Easy->CURLOPT_CAPATH, opt('ssl_ca_dir')) if defined(opt('ssl_ca_dir'));
            $curl->setopt(WWW::Curl::Easy->CURLOPT_IPRESOLVE,
                                            ($ipversion == 4) ? WWW::Curl::Easy->CURL_IPRESOLVE_V4 : 
                                            ($ipversion == 6) ? WWW::Curl::Easy->CURL_IPRESOLVE_V6 :
                                                                WWW::Curl::Easy->CURL_IPRESOLVE_WHATEVER);
            $curl->setopt(WWW::Curl::Easy->CURLOPT_USERAGENT, "${program}/${version}");
            $curl->setopt(WWW::Curl::Easy->CURLOPT_CONNECTTIMEOUT, $timeout);
            $curl->setopt(WWW::Curl::Easy->CURLOPT_TIMEOUT, $timeout);

            $curl->setopt(WWW::Curl::Easy->CURLOPT_POST, 1) if ($method eq 'POST');
            $curl->setopt(WWW::Curl::Easy->CURLOPT_PUT, 1) if ($method eq 'PUT');
            $curl->setopt(WWW::Curl::Easy->CURLOPT_CUSTOMREQUEST, $method) if ($method ne 'GET'); ## for PATCH

            $curl->setopt(WWW::Curl::Easy->CURLOPT_USERPWD, "${login}:${password}") if (defined($login) && defined($password));
            $curl->setopt(WWW::Curl::Easy->CURLOPT_PROXY, "${protocol}://${proxy}") if defined($proxy);
            $curl->setopt(WWW::Curl::Easy->CURLOPT_URL, "${protocol}://${server}/${url}");

            # Add header lines if any was provided
            if ($headers) {
                @header_lines = split('\n', $headers);
                $curl->setopt(WWW::Curl::Easy->CURLOPT_HTTPHEADER, \@header_lines);
            }
            # Add in the data if any was provided (for POST/PATCH)
            if (my $datalen = length($data)) {
                $curl->setopt(WWW::Curl::Easy->CURLOPT_POSTFIELDS, ${data});
                $curl->setopt(WWW::Curl::Easy->CURLOPT_POSTFIELDSIZE, $datalen);
            }
            $curl->setopt(WWW::Curl::Easy->CURLOPT_WRITEDATA,\$reply);

            # don't include ${url} as that might expose login credentials
            $0 = sprintf("%s - WWW::Curl::Easy sending to %s", $program, "${protocol}://${server}");
            verbose("SENDING:", "WWW::Curl::Easy to %s", "${protocol}://${server}");
            verbose("SENDING:", "%s", $headers) if ($headers);
            verbose("SENDING:", "%s", $data) if ($data);

            my $rc = $curl->perform;

            if ($rc != 0) {
                warning("CURL error (%d) %s", $rc, $curl->strerror($rc));
                debug($curl->errbuf);
            }
        } else {
            # System does not have the WWW::Curl::Easy module so attempt with system Curl command
            push(@curlopt, "silent");
            push(@curlopt, "include");  ## Include HTTP response for compatibility
            push(@curlopt, "insecure") if ($use_ssl && !($params{ssl_validate} // 1));
            push(@curlopt, "cacert=\"".escape_curl_param(opt('ssl_ca_file')).'"') if defined(opt('ssl_ca_file'));
            push(@curlopt, "capath=\"".escape_curl_param(opt('ssl_ca_dir')).'"') if defined(opt('ssl_ca_dir'));
            push(@curlopt, "ipv4") if ($ipversion == 4);
            push(@curlopt, "ipv6") if ($ipversion == 6);
            push(@curlopt, "user-agent=\"".escape_curl_param("${program}/${version}").'"');
            push(@curlopt, "connect-timeout=$timeout");
            push(@curlopt, "max-time=$timeout");
            push(@curlopt, "request=$method");
            push(@curlopt, "user=\"".escape_curl_param("${login}:${password}").'"') if (defined($login) && defined($password));
            push(@curlopt, "proxy=\"".escape_curl_param("${protocol}://${proxy}").'"') if defined($proxy);
            push(@curlopt, "url=\"".escape_curl_param("${protocol}://${server}/${url}").'"');

            # Each header line is added individually
            @header_lines = split('\n', $headers);
            $_ = "header=\"".escape_curl_param($_).'"' foreach (@header_lines);
            push(@curlopt, @header_lines);

            # Add in the data if any was provided (for POST/PATCH)
            push(@curlopt, "data=\"".escape_curl_param(${data}).'"') if ($data);

            # don't include ${url} as that might expose login credentials
            $0 = sprintf("%s - Curl system cmd sending to %s", $program, "${protocol}://${server}");
            verbose("SENDING:", "Curl system cmd to %s", "${protocol}://${server}");
            verbose("SENDING:", "%s", $_) foreach (@curlopt);

            $reply = curl_cmd(@curlopt);
        }
        verbose("RECEIVE:", "%s", $reply // "<undefined>");
        if (!$reply) {
            # don't include ${url} as that might expose login credentials
            warning("curl cannot connect to %s://%s using IPv%s",${protocol},${server},$ipversion);
        }
    }

    ## during testing simulate reading the URL
    if (opt('test')) {
        my $filename = "$server/$url";
        $filename =~ s|/|%2F|g;
        if (opt('exec')) {
            $reply = save_file("$savedir/$filename", $reply, 'unique');
        } else {
            $reply = load_file("$savedir/$filename");
        }
    }

    $reply =~ s/\r//g if defined $reply;
    return $reply;
}

######################################################################
## get_ip
######################################################################
sub get_ip {
    my $use = lc shift;
    my $h   = shift;
    my ($ip, $arg, $reply, $url, $skip) = (undef, opt($use, $h), '');
    $arg = '' unless $arg;

    if ($use eq 'ip') {
        $ip  = opt('ip', $h);
        if (!is_ipv4($ip) && !is_ipv6($ip)) {
            warning("'%s' is not a valid IPv4 or IPv6 address", $ip);
            $ip = undef;
        }
        $arg = 'ip';

    } elsif ($use eq 'if') {
        $ip = get_ip_from_interface($arg);

    } elsif ($use eq 'cmd') {
        if ($arg) {
            $skip = opt('cmd-skip', $h) // '';
            $reply = `$arg`;
            $reply = '' if $?;
        }

    } elsif ($use eq 'web') {
        $url = opt('web', $h) // '';
        $skip = opt('web-skip', $h) // '';

        if (exists $builtinweb{$url}) {
            $skip = $builtinweb{$url}->{'skip'} unless $skip;
            $url  = $builtinweb{$url}->{'url'};
        }
        $arg = $url;

        if ($url) {
            $reply = geturl(
                proxy => opt('proxy', $h),
                url => $url,
                ssl_validate => opt('web-ssl-validate', $h),
            ) // '';
        }

    } elsif (($use eq 'cisco')) {
        # Stuff added to support Cisco router ip http daemon
        # User fw-login should only have level 1 access to prevent
        # password theft.  This is pretty harmless.
        my $queryif = opt('if', $h);
        $skip = opt('fw-skip', $h) // '';

        # Convert slashes to protected value "\/"
        $queryif =~ s%\/%\\\/%g;

        # Protect special HTML characters (like '?')
        $queryif =~ s/([\?&= ])/sprintf("%%%02x", ord($1))/ge;

        $url = "http://" . opt('fw', $h) . "/level/1/exec/show/ip/interface/brief/${queryif}/CR";
        $reply = geturl(
            url => $url,
            login => opt('fw-login', $h),
            password => opt('fw-password', $h),
            ignore_ssl_option => 1,
            ssl_validate => opt('fw-ssl-validate', $h),
        ) // '';
        $arg = $url;

    } elsif (($use eq 'cisco-asa')) {
        # Stuff added to support Cisco ASA ip https daemon
        # User fw-login should only have level 1 access to prevent
        # password theft.  This is pretty harmless.
        my $queryif = opt('if', $h);
        $skip = opt('fw-skip', $h) // '';

        # Convert slashes to protected value "\/"
        $queryif =~ s%\/%\\\/%g;

        # Protect special HTML characters (like '?')
        $queryif =~ s/([\?&= ])/sprintf("%%%02x", ord($1))/ge;

        $url = "https://" . opt('fw', $h) . "/exec/show%20interface%20${queryif}";
        $reply = geturl(
            url => $url,
            login => opt('fw-login', $h),
            password => opt('fw-password', $h),
            ignore_ssl_option => 1,
            ssl_validate => opt('fw-ssl-validate', $h),
        ) // '';
        $arg = $url;

    } else {
        $url = opt('fw', $h) // '';
        $skip = opt('fw-skip', $h) // '';

        if (exists $builtinfw{$use}) {
            $skip = $builtinfw{$use}->{'skip'} unless $skip;
            $url  = "http://${url}" . $builtinfw{$use}->{'url'} unless $url =~ /\//;
        }
        $arg = $url;

        if ($url) {
            $reply = geturl(
                url => $url,
                login => opt('fw-login', $h),
                password => opt('fw-password', $h),
                ignore_ssl_option => 1,
                ssl_validate => opt('fw-ssl-validate', $h),
            ) // '';
        }
    }
    if (!defined $reply) {
        $reply = '';
    }
    if (($skip // '') ne '') {
        $skip  =~ s/ /\\s/is;
        $reply =~ s/^.*?${skip}//is;
    }
    $ip //= extract_ipv4($reply) // extract_ipv6($reply);
    warning("found neither IPv4 nor IPv6 address") if !defined($ip);
    if ($use ne 'ip' && ($ip // '') eq '0.0.0.0') {
        $ip = undef;
    }

    debug("get_ip: using %s, %s reports %s", $use, $arg, $ip // "<undefined>");
    return $ip;
}


######################################################################
## Regex to find IPv4 address. Accepts embedded leading zeros.
######################################################################
my $regex_ipv4 = qr/(?:(?<octet>25[0-5]|2[0-4]\d|[01]?\d\d?)\.){3}(?&octet)/;

######################################################################
## is_ipv4() validates if string is valid IPv4 address with no preceding
## or trailing spaces/characters, not even line breaks.
######################################################################
sub is_ipv4 {
    return (shift // '') =~ /\A$regex_ipv4\z/;
}

######################################################################
## extract_ipv4() finds the first valid IPv4 address in the given string,
## removes embedded leading zeros, and returns the result.
######################################################################
sub extract_ipv4 {
    (shift // '') =~ /(?:\b|_)($regex_ipv4)(?:\b|_)/ or return undef;
    (my $ip = $1) =~ s/\b0+\B//g; ## remove embedded leading zeros
    return $ip;
}

######################################################################
## Regex that matches an IPv6 address. Accepts embedded leading zeros.
## Accepts IPv4-mapped IPv6 addresses such as 64:ff9b::192.0.2.13.
######################################################################
my $regex_ipv6 = qr/
    # Define some named groups so we can use Perl's recursive subpattern feature for shorthand:
    (?<g>[0-9A-F]{1,4}){0}  # "g" matches a group of 1 to 4 hex chars
    (?<g_>(?&g):){0}        # "g_" matches a group of 1 to 4 hex chars followed by a colon
    (?<_g>:(?&g)){0}        # "_g" matches a colon followed by a group of 1 to 4 hex chars
    (?<g0>(?&g)?){0}        # "g0" is an optional "g" (matches a group of 0 to 4 hex chars)
    (?<g0_>(?&g0):){0}      # "g0_" is an optional "g" followed by a colon
    (?<x>[:.0-9A-Z]){0}     # "x" matches chars that should never come before or after the address
    (?<ip4>$regex_ipv4){0}  # "ip4" matches an IPv4 address x.x.x.x

    # Now for the regex itself:
    (?<!(?&x))  # Not preceded by a character that is not allowed to come before the address
    (?:
      (?&g_){7}(?&g)     # Exactly 8 groups of 1-4 hex chars
      | (?&g_){1,7}:     # OR compressed form with the double colon at the end
      | :(?&_g){1,7}     # OR compressed form with the double colon at the beginning
      | ::               # OR compressed to just a double colon
      |                  # OR compressed form with the double colon in the middle:
        (?=                   # Only consider this case if the string...
          (?&g0_){2,7}(?&g0)  # ...has 3 to 8 possibly empty groups (at least 3 because there
                              # will be at least one group before the ::, at least one group
                              # after the ::, and the :: itself is an empty group)...
          (?!(?&x))           # ...then ends.
        )                     # If the condition is true, then:
        (?&g_){1,6}           #   1 to 6 non-empty groups before the double colon
        (?&_g){1,6}           #   1 to 6 non-empty groups after the double colon
      |                  # OR an IPv4-mapped IPv6 address:
        (?:                # It starts with a 96-bit prefix represented by:
          (?&g_){6}          # Exactly 6 groups of 1-4 hex chars with their colons
          | (?&g_){1,5}:     # OR compressed form with the double colon at the end
          | ::(?&g_){0,5}    # OR compressed form with the double colon at the beginning
          |                  # OR compressed form with the double colon in the middle:
            (?=                 # Only consider this case if the prefix...
              (?&g0_){3,6}      # ...has 3 to 6 possibly empty groups...
              (?&ip4)(?!(?&x))  # ...then ends.
            )                   # If the condition is true, then:
            (?&g_){1,4}         #   1 to 4 non-empty groups before the double colon
            (?&_g){1,4}         #   1 to 4 non-empty groups after the double colon
            :                   #   colon separating the IPv6 part from the IPv4 part
        )
        (?&ip4)            # Prefix is followed by an IPv4 address
    )
    (?!(?&x))  # Not followed by a character that is not allowed to come after the address
/xi;

######################################################################
## is_ipv6() validates if string is valid IPv6 address with no preceding
## or trailing spaces/characters, not even line breaks.
######################################################################
sub is_ipv6 {
    return (shift // '') =~ /\A$regex_ipv6\z/;
}

######################################################################
## extract_ipv6() finds the first valid IPv6 address in the given string,
## removes embedded leading zeros, and returns the result.
######################################################################
sub extract_ipv6 {
    (shift // '') =~ /($regex_ipv6)/ or return undef;
    (my $ip = $1) =~ s/\b0+\B//g; ## remove embedded leading zeros
    return $ip;
}

######################################################################
## Regex that matches an IPv6 address that is probably globally routable.
## Accepts embedded leading zeros.
######################################################################
my $regex_ipv6_global = qr{
    (?!  # Is not one of the following addresses:
        0{0,4}:             # ::/16 is assumed to never contain globaly routable addresses
      | f[cd][0-9a-f]{2}:   # fc00::/7 RFC4193 ULA
      | fe[89ab][0-9a-f]:   # fe80::/10 link local
      | ff[0-9a-f]{2}:      # ff00::/8 multicast
    )
    $regex_ipv6             # And is a valid IPv6 address
}xi;

######################################################################
## is_ipv6_global() returns true if the string is a valid IPv6 address
## that is probably globally routable, with no preceding or trailing
## characters. All addresses in the ::/16 block are assumed to not be
## globally routable.
######################################################################
sub is_ipv6_global {
    return (shift // '') =~ /\A$regex_ipv6_global\z/
}

######################################################################
## extract_ipv6_global() finds the first IPv6 address in the given
## string that satisfies is_ipv6_global(), removes embedded leading
## zeros, and returns the result. Returns undef if no such address is
## found.
######################################################################
sub extract_ipv6_global {
    (shift // '') =~ /($regex_ipv6_global)/ or return undef;
    (my $ip = $1) =~ s/\b0+\B//g; ## remove embedded leading zeros
    return $ip;
}

######################################################################
## Regex that matches an IPv6 address that is unique local (ULA).
## Accepts embedded leading zeros.
######################################################################
my $regex_ipv6_ula = qr{
    (?=  # Address starts with
      f[cd][0-9a-f]{2}:     # fc00::/7 RFC4193 ULA
    )
    $regex_ipv6             # And is a valid IPv6 address
}xi;

######################################################################
## get_default_interface finds the default network interface based on
## the IP routing table on the system.  We validate that the interface
## found is likely to have global routing (e.g. is not LOOPBACK).
## Returns undef if no global scope interface can be found for IP version.
######################################################################
sub get_default_interface {
    my $ipver = int(shift // 4);    ## Defaults to IPv4 if not specified
    my $ipstr = ($ipver == 6) ? 'inet6' : 'inet';
    my $reply = shift // '';  ## Pass in data for unit testing purposes only
    my $cmd = "test";

    return undef if (($ipver != 4) && ($ipver != 6));

    if (!$reply) { ## skip if test data passed in.
        ## Best option is the ip command from iproute2 package
        $cmd = "ip -$ipver -o route list match default"; $reply = qx{ $cmd 2>/dev/null };
        ## Fallback is the netstat command. This is only option on MacOS.
        if ($?) { $cmd = "netstat -rn -$ipver";     $reply = qx{ $cmd 2>/dev/null }; } # Linux, FreeBSD
        if ($?) { $cmd = "netstat -rn -f $ipstr";   $reply = qx{ $cmd 2>/dev/null }; } # MacOS
        if ($?) { $cmd = "netstat -rn";             $reply = qx{ $cmd 2>/dev/null }; } # Busybox
        if ($?) { $cmd = "missing ip or netstat command";
            failed("Unable to obtain default route information -- %s", $cmd)
        }
    }
    debug("Reply from '%s' :\n------\n%s------", $cmd, $reply);

    # Check we have IPv6 address in case we got routing table from non-specific cmd above
    return undef if (($ipver == 6) && !extract_ipv6($reply));
    # Filter down to just the default interfaces
    my @list = split(/\n/, $reply);
    @list = grep(/^default|^(?:0\.){3}0|^::\/0/, @list); # Select 'default' or '0.0.0.0' or '::/0'
    return undef if (scalar(@list) == 0);
    debug("Default routes found for IPv%s :\n%s", $ipver, join("\n",@list));

    # now check each interface to make sure it is global (not loopback).
    foreach 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]);
}

######################################################################
## group_hosts_by
######################################################################
sub group_hosts_by {
    my ($hosts, $attributes) = @_;
    my %attrs = (map({ ($_ => 1) } @$attributes), 'wantip' => 1);
    my @attrs = sort(keys(%attrs));
    my %groups = ();
    foreach my $h (@$hosts) {
        my $sig = join(',', map({ sprintf("%s=%s", $_, $config{$h}{$_} // '') } @attrs));
        push @{$groups{$sig}}, $h;
    }
    return %groups;
}

######################################################################
## encode_www_form_urlencoded
######################################################################
sub encode_www_form_urlencoded {
    my $formdata = shift;

    my $must_encode = qr'[<>"#%{}|\\^~\[\]`;/?:=&+]';
    my $encoded;
    my $i = 0;
    foreach 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 = "";
    foreach my $s (sort keys %services) {
        my $subr = $services{$s}{'examples'};
        my $example;

        if (defined($subr) && ($example = &$subr())) {
            chomp($example);
            $examples .= $example;
            $examples .= "\n\n$separator";
            $separator = "\n";
        }
    }
    my $intro = <<"EoEXAMPLE";
== CONFIGURING ${program}

The configuration file, ${program}.conf, can be used to define the
default behaviour and operation of ${program}.  The file consists of
sequences of global variable definitions and host definitions.

Global definitions look like:
  name=value [,name=value]*

For example:
  daemon=5m
  use=if, if=eth0
  proxy=proxy.myisp.com
  protocol=dyndns2

specifies that ${program} should operate as a daemon, checking the
eth0 interface for an IP address change every 5 minutes and use the
'dyndns2' protocol by default. The daemon interval can be specified
as seconds (600s), minutes (5m), hours (1h) or days (1d).

Host definitions look like:
  [name=value [,name=value]*]* a.host.domain [,b.host.domain] [login] [password]

For example:
  protocol=noip, \\
  login=your-username, password=your-password  myhost.noip.com
  login=your-username, password=your-password  myhost.noip.com,myhost2.noip.com

specifies two host definitions.

The first definition will use the noip protocol,
your-username and your-password to update the ip-address of
myhost.noip.com and my2ndhost.noip.com.

The second host definition will use the current default protocol
('dyndns2'), my-login and my-password to update the ip-address of
myhost.dyndns.org and my2ndhost.dyndns.org.

The order of this sequence is significant because the values of any
global variable definitions are bound to a host definition when the
host definition is encountered.

See the sample-${program}.conf file for further examples.
EoEXAMPLE
    $intro .= "\n== NIC specific variables and examples:\n$examples" if $examples;
    return $intro;
}
######################################################################
## nic_updateable
######################################################################
sub nic_updateable {
    my $host   = shift;
    my $sub    = shift;
    my $update = 0;
    my $ip     = $config{$host}{'wantip'};

    if ($config{$host}{'login'} eq '') {
        warning("null login name specified for host %s.", $host);

    } elsif ($config{$host}{'password'} eq '') {
        warning("null password specified for host %s.", $host);

    } elsif ($opt{'force'}) {
        info("forcing update of %s.", $host);
        $update = 1;

    } elsif (!exists($cache{$host})) {
        info("forcing updating %s because no cached entry exists.", $host);
        $update = 1;

    } elsif ($cache{$host}{'wtime'} && $cache{$host}{'wtime'} > $now) {
        warning("cannot update %s from %s to %s until after %s.",
                $host,
                ($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'), $ip,
                prettytime($cache{$host}{'wtime'})
        );

    } elsif ($cache{$host}{'mtime'} && interval_expired($host, 'mtime', 'max-interval')) {
        warning("forcing update of %s from %s to %s; %s since last update on %s.",
                $host,
                ($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'), $ip,
                prettyinterval($config{$host}{'max-interval'}),
                prettytime($cache{$host}{'mtime'})
        );
        $update = 1;

    } elsif (!exists($cache{$host}{'ip'}) || $cache{$host}{'ip'} ne $ip) {
        if (($cache{$host}{'status'} eq 'good') &&
            !interval_expired($host, 'mtime', 'min-interval')) {

            warning("skipping update of %s from %s to %s.\nlast updated %s.\nWait at least %s between update attempts.",
                    $host,
                    ($cache{$host}{'ip'}    ? $cache{$host}{'ip'}                : '<nothing>'),
                    $ip,
                    ($cache{$host}{'mtime'} ? prettytime($cache{$host}{'mtime'}) : '<never>'),
                    prettyinterval($config{$host}{'min-interval'})
            )
                if opt('verbose') || !($cache{$host}{'warned-min-interval'} // 0);

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

        } elsif (($cache{$host}{'status'} ne 'good') && !interval_expired($host, 'atime', 'min-error-interval')) {

            warning("skipping update of %s from %s to %s.\nlast updated %s but last attempt on %s failed.\nWait at least %s between update attempts.",
                    $host,
                    ($cache{$host}{'ip'}    ? $cache{$host}{'ip'}                : '<nothing>'),
                    $ip,
                    ($cache{$host}{'mtime'} ? prettytime($cache{$host}{'mtime'}) : '<never>'),
                    ($cache{$host}{'atime'} ? prettytime($cache{$host}{'atime'}) : '<never>'),
                    prettyinterval($config{$host}{'min-error-interval'})
            )
                if opt('verbose') || !($cache{$host}{'warned-min-error-interval'} // 0);

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

        } else {
            $update = 1;
        }

    } elsif (defined($sub) && &$sub($host)) {
        $update = 1;
    } elsif ((defined($cache{$host}{'static'}) && defined($config{$host}{'static'}) &&
              ($cache{$host}{'static'} ne $config{$host}{'static'})) ||
             (defined($cache{$host}{'wildcard'}) && defined($config{$host}{'wildcard'}) &&
              ($cache{$host}{'wildcard'} ne $config{$host}{'wildcard'})) ||
             (defined($cache{$host}{'mx'}) && defined($config{$host}{'mx'}) &&
              ($cache{$host}{'mx'} ne $config{$host}{'mx'})) ||
             (defined($cache{$host}{'backupmx'}) && defined($config{$host}{'backupmx'}) &&
              ($cache{$host}{'backupmx'} ne $config{$host}{'backupmx'}))) {
        info("updating %s because host settings have been changed.", $host);
        $update = 1;

    } else {
        success("%s: skipped: IP address was already set to %s.", $host, $ip)
            if opt('verbose');
    }
    $config{$host}{'status'} = $cache{$host}{'status'} // '';
    $config{$host}{'update'} = $update;
    if ($update) {
        $config{$host}{'status'}                    = 'noconnect';
        $config{$host}{'atime'}                     = $now;
        $config{$host}{'wtime'}                     = 0;
        $config{$host}{'warned-min-interval'}       = 0;
        $config{$host}{'warned-min-error-interval'} = 0;

        delete $cache{$host}{'warned-min-interval'};
        delete $cache{$host}{'warned-min-error-interval'};
    }

    return $update;
}

######################################################################
## header_ok
######################################################################
sub header_ok {
    my ($host, $line) = @_;
    my $ok = 0;

    if ($line =~ m%^s*HTTP/.*\s+(\d+)%i) {
        my $result = $1;

        if ($result =~ m/^2\d\d$/) {
            $ok = 1;

        } elsif ($result eq '401') {
            failed("updating %s: authorization failed (%s)", $host, $line);
        }

    } else {
        failed("updating %s: unexpected line (%s)", $host, $line);
    }
    return $ok;
}
######################################################################
## nic_dyndns1_examples
######################################################################
sub nic_dyndns1_examples {
    return <<"EoEXAMPLE";
o 'dyndns1'

The 'dyndns1' protocol is a deprecated protocol used by the free dynamic
DNS service offered by www.dyndns.org. The 'dyndns2' should be used to
update the www.dyndns.org service.  However, other services are also
using this protocol so support is still provided by ${program}.

Configuration variables applicable to the 'dyndns1' protocol are:
  protocol=dyndns1             ##
  server=fqdn.of.service       ## defaults to members.dyndns.org
  backupmx=no|yes              ## indicates that this host is the primary MX for the domain.
  mx=any.host.domain           ## a host MX'ing for this host definition.
  wildcard=no|yes              ## add a DNS wildcard CNAME record that points to {host}
  login=service-login          ## login name and password  registered with the service
  password=service-password    ##
  fully.qualified.host         ## the host registered with the service.

Example ${program}.conf file entries:
  ## single host update
  protocol=dyndns1,                                         \\
  login=my-dyndns.org-login,                                \\
  password=my-dyndns.org-password                           \\
  myhost.dyndns.org

  ## multiple host update with wildcard'ing mx, and backupmx
  protocol=dyndns1,                                         \\
  login=my-dyndns.org-login,                                \\
  password=my-dyndns.org-password,                          \\
  mx=a.host.willing.to.mx.for.me,backupmx=yes,wildcard=yes  \\
  myhost.dyndns.org,my2ndhost.dyndns.org
EoEXAMPLE
}
######################################################################
## nic_dyndns1_update
######################################################################
sub nic_dyndns1_update {
    debug("\nnic_dyndns1_update -------------------");
    ## update each configured host
    foreach my $h (@_) {
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to %s for %s", $ip, $h);
        verbose("UPDATE:", "updating %s", $h);

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

        my $reply = geturl(
            proxy => opt('proxy'),
            url => $url,
            login => $config{$h}{'login'},
            password => $config{$h}{'password'},
        ) // '';
        if ($reply eq '') {
            failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
            next;
        }
        next if !header_ok($h, $reply);

        my @reply = split /\n/, $reply;
        my ($title, $return_code, $error_code) = ('', '', '');
        foreach my $line (@reply) {
            $title       = $1 if $line =~ m%<TITLE>\s*(.*)\s*</TITLE>%i;
            $return_code = $1 if $line =~ m%^return\s+code\s*:\s*(.*)\s*$%i;
            $error_code  = $1 if $line =~ m%^error\s+code\s*:\s*(.*)\s*$%i;
        }

        if ($return_code ne 'NOERROR' || $error_code ne 'NOERROR' || !$title) {
            $config{$h}{'status'} = 'failed';
            $title = "incomplete response from $config{$h}{server}" unless $title;
            warning("SENT:    %s", $url) unless opt('verbose');
            warning("REPLIED: %s", $reply);
            failed("updating %s: %s", $h, $title);

        } else {
            $config{$h}{'ip'}     = $ip;
            $config{$h}{'mtime'}  = $now;
            $config{$h}{'status'} = 'good';
            success("updating %s: %s: IP address set to %s (%s)", $h, $return_code, $ip, $title);
        }
    }
}
######################################################################
## nic_dyndns2_updateable
######################################################################
sub nic_dyndns2_updateable {
    my $host   = shift;
    my $update = 0;

    if ($config{$host}{'mx'} ne $cache{$host}{'mx'}) {
        info("forcing updating %s because 'mx' has changed to %s.", $host, $config{$host}{'mx'});
        $update = 1;

    } elsif ($config{$host}{'mx'} && (ynu($config{$host}{'backupmx'}, 1, 2, 3) ne ynu($config{$host}{'backupmx'}, 1, 2, 3))) {
        info("forcing updating %s because 'backupmx' has changed to %s.", $host, ynu($config{$host}{'backupmx'}, "YES", "NO", "NO"));
        $update = 1;

    } elsif ($config{$host}{'static'} ne $cache{$host}{'static'}) {

        info("forcing updating %s because 'static' has changed to %s.", $host, ynu($config{$host}{'static'}, "YES", "NO", "NO"));
        $update = 1;

    }
    return $update;
}
######################################################################
## nic_dyndns2_examples
######################################################################
sub nic_dyndns2_examples {
    return <<"EoEXAMPLE";
o 'dyndns2'

The 'dyndns2' protocol is a newer low-bandwidth protocol used by a
free dynamic DNS service offered by www.dyndns.org.  It supports
features of the older 'dyndns1' in addition to others.  [These will be
supported in a future version of ${program}.]

Configuration variables applicable to the 'dyndns2' protocol are:
  protocol=dyndns2             ##
  server=fqdn.of.service       ## defaults to members.dyndns.org
  script=/path/to/script       ## defaults to /nic/update
  backupmx=no|yes              ## indicates that this host is the primary MX for the domain.
  static=no|yes                ## indicates that this host has a static IP address.
  custom=no|yes                ## indicates that this host is a 'custom' top-level domain name.
  mx=any.host.domain           ## a host MX'ing for this host definition.
  wildcard=no|yes              ## add a DNS wildcard CNAME record that points to {host}
  login=service-login          ## login name and password  registered with the service
  password=service-password    ##
  fully.qualified.host         ## the host registered with the service.

Example ${program}.conf file entries:
  ## single host update
  protocol=dyndns2,                                         \\
  login=my-dyndns.org-login,                                \\
  password=my-dyndns.org-password                           \\
  myhost.dyndns.org

  ## multiple host update with wildcard'ing mx, and backupmx
  protocol=dyndns2,                                         \\
  login=my-dyndns.org-login,                                \\
  password=my-dyndns.org-password,                          \\
  mx=a.host.willing.to.mx.for.me,backupmx=yes,wildcard=yes  \\
  myhost.dyndns.org,my2ndhost.dyndns.org

  ## multiple host update to the custom DNS service
  protocol=dyndns2,                                         \\
  login=my-dyndns.org-login,                                \\
  password=my-dyndns.org-password                           \\
  my-toplevel-domain.com,my-other-domain.com
EoEXAMPLE
}
######################################################################
## nic_dyndns2_update
######################################################################
sub nic_dyndns2_update {
    debug("\nnic_dyndns2_update -------------------");

    ## group hosts with identical attributes together
    my %groups = group_hosts_by([ @_ ], [ qw(login password server static custom wildcard mx backupmx) ]);

    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',
    );

    ## update each set of hosts that had similar configurations
    foreach my $sig (keys %groups) {
        my @hosts = @{$groups{$sig}};
        my $hosts = join(',', @hosts);
        my $h     = $hosts[0];
        my $ip    = $config{$h}{'wantip'};
        delete $config{$_}{'wantip'} foreach @hosts;

        info("setting IP address to %s for %s", $ip, $hosts);
        verbose("UPDATE:", "updating %s", $hosts);

        ## Select the DynDNS system to update
        my $url = "http://$config{$h}{'server'}$config{$h}{'script'}?system=";
        if ($config{$h}{'custom'}) {
            warning("updating %s: 'custom' and 'static' may not be used together. ('static' ignored)", $hosts)
                if $config{$h}{'static'};
            $url .= 'custom';

        } elsif ($config{$h}{'static'}) {
            $url .= 'statdns';

        } else {
            $url .= 'dyndns';
        }

        $url .= "&hostname=$hosts";
        $url .= "&myip=";
        $url .= $ip if $ip;

        ## some args are not valid for a custom domain.
        $url .= "&wildcard=ON" if ynu($config{$h}{'wildcard'}, 1, 0, 0);
        if ($config{$h}{'mx'}) {
            $url .= "&mx=$config{$h}{'mx'}";
            $url .= "&backmx=" . ynu($config{$h}{'backupmx'}, 'YES', 'NO');
        }

        my $reply = geturl(
            proxy => opt('proxy'),
            url => $url,
            login => $config{$h}{'login'},
            password => $config{$h}{'password'},
        ) // '';
        if ($reply eq '') {
            failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});
            next;
        }
        next if !header_ok($hosts, $reply);

        my @reply      = split /\n/, $reply;
        my $state      = 'header';
        my $returnedip = $ip;

        foreach my $line (@reply) {
            if ($state eq 'header') {
                $state = 'body';

            } elsif ($state eq 'body') {
                $state = 'results' if $line eq '';

            } elsif ($state =~ /^results/) {
                $state = 'results2';

                # bug #10: some dyndns providers does not return the IP so
                # we can't use the returned IP
                my ($status, $returnedip) = split / /, lc $line;
                $ip = $returnedip if (not $ip);
                my $h = shift @hosts;

                $config{$h}{'status'} = $status;
                if ($status eq 'good') {
                    $config{$h}{'ip'}    = $ip;
                    $config{$h}{'mtime'} = $now;
                    success("updating %s: %s: IP address set to %s", $h, $status, $ip);

                } elsif (exists $errors{$status}) {
                    if ($status eq 'nochg') {
                        warning("updating %s: %s: %s", $h, $status, $errors{$status});
                        $config{$h}{'ip'}     = $ip;
                        $config{$h}{'mtime'}  = $now;
                        $config{$h}{'status'} = 'good';

                    } else {
                        failed("updating %s: %s: %s", $h, $status, $errors{$status});
                    }

                } elsif ($status =~ /w(\d+)(.)/) {
                    my ($wait, $units) = ($1, lc $2);
                    my ($sec,  $scale) = ($wait, 1);

                    ($scale, $units) = (1, 'seconds')   if $units eq 's';
                    ($scale, $units) = (60, 'minutes')  if $units eq 'm';
                    ($scale, $units) = (60*60, 'hours') if $units eq 'h';

                    $sec = $wait * $scale;
                    $config{$h}{'wtime'} = $now + $sec;
                    warning("updating %s: %s: wait %s %s before further updates", $h, $status, $wait, $units);

                } else {
                    failed("updating %s: unexpected status (%s)", $h, $line);
                }
            }
        }
        failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'})
            if $state ne 'results2';
    }
}


######################################################################
## nic_noip_update
## Note: uses same features as nic_dyndns2_update, less return codes
######################################################################
sub nic_noip_update {
    debug("\nnic_noip_update -------------------");

    ## group hosts with identical attributes together
    my %groups = group_hosts_by([ @_ ], [ qw(login password server static custom wildcard mx backupmx) ]);

    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 http://www.no-ip.com',
        'numhost'  => 'System error: Too many or too few hosts found. open a trouble ticket at http://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',
    );

    ## update each set of hosts that had similar configurations
    foreach my $sig (keys %groups) {
        my @hosts = @{$groups{$sig}};
        my $hosts = join(',', @hosts);
        my $h     = $hosts[0];
        my $ip    = $config{$h}{'wantip'};
        delete $config{$_}{'wantip'} foreach @hosts;

        info("setting IP address to %s for %s", $ip, $hosts);
        verbose("UPDATE:", "updating %s", $hosts);

        my $url = "http://$config{$h}{'server'}/nic/update?system=";
        $url .= 'noip';
        $url .= "&hostname=$hosts";
        $url .= "&myip=";
        $url .= $ip if $ip;

        my $reply = geturl(
            proxy => opt('proxy'),
            url => $url,
            login => $config{$h}{'login'},
            password => $config{$h}{'password'},
        ) // '';
        if ($reply eq '') {
            failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});
            next;
        }
        next if !header_ok($hosts, $reply);

        my @reply = split /\n/, $reply;
        my $state = 'header';
        foreach my $line (@reply) {
            if ($state eq 'header') {
                $state = 'body';

            } elsif ($state eq 'body') {
                $state = 'results' if $line eq '';

            } elsif ($state =~ /^results/) {
                $state = 'results2';

                my ($status, $ip) = split / /, lc $line;
                my $h = shift @hosts;

                $config{$h}{'status'} = $status;
                if ($status eq 'good') {
                    $config{$h}{'ip'}     = $ip;
                    $config{$h}{'mtime'}  = $now;
                    success("updating %s: %s: IP address set to %s", $h, $status, $ip);

                } elsif (exists $errors{$status}) {
                    if ($status eq 'nochg') {
                        warning("updating %s: %s: %s", $h, $status, $errors{$status});
                        $config{$h}{'ip'}     = $ip;
                        $config{$h}{'mtime'}  = $now;
                        $config{$h}{'status'} = 'good';

                    } else {
                        failed("updating %s: %s: %s", $h, $status, $errors{$status});
                    }

                } elsif ($status =~ /w(\d+)(.)/) {
                    my ($wait, $units) = ($1, lc $2);
                    my ($sec,  $scale) = ($wait, 1);

                    ($scale, $units) = (1, 'seconds')   if $units eq 's';
                    ($scale, $units) = (60, 'minutes')  if $units eq 'm';
                    ($scale, $units) = (60*60, 'hours') if $units eq 'h';

                    $sec = $wait * $scale;
                    $config{$h}{'wtime'} = $now + $sec;
                    warning("updating %s: %s: wait %s %s before further updates", $h, $status, $wait, $units);

                } else {
                    failed("updating %s: unexpected status (%s)", $h, $line);
                }
            }
        }
        failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'})
            if $state ne 'results2';
    }
}
######################################################################
## nic_noip_examples
######################################################################
sub nic_noip_examples {
    return <<"EoEXAMPLE";
o 'noip'

The 'No-IP Compatible' protocol is used to make dynamic dns updates
over an http request.  Details of the protocol are outlined at:
http://www.no-ip.com/integrate/

Configuration variables applicable to the 'noip' protocol are:
  protocol=noip                ##
  server=fqdn.of.service       ## defaults to dynupdate.no-ip.com
  login=service-login          ## login name and password  registered with the service
  password=service-password    ##
  fully.qualified.host         ## the host registered with the service.

Example ${program}.conf file entries:
  ## single host update
  protocol=noip,                                   \\
  login=userlogin\@domain.com,                     \\
  password=noip-password                           \\
  myhost.no-ip.biz


EoEXAMPLE
}
######################################################################
## nic_dslreports1_examples
######################################################################
sub nic_dslreports1_examples {
    return <<"EoEXAMPLE";
o 'dslreports1'

The 'dslreports1' protocol is used by a free DSL monitoring service
offered by www.dslreports.com.

Configuration variables applicable to the 'dslreports1' protocol are:
  protocol=dslreports1         ##
  server=fqdn.of.service       ## defaults to www.dslreports.com
  login=service-login          ## login name and password  registered with the service
  password=service-password    ##
  unique-number                ## the host registered with the service.

Example ${program}.conf file entries:
  ## single host update
  protocol=dslreports1,                                     \\
  login=my-dslreports-login,                                \\
  password=my-dslreports-password                           \\
  123456

Note: DSL Reports uses a unique number as the host name.  This number
can be found on the Monitor Control web page.
EoEXAMPLE
}
######################################################################
## nic_dslreports1_update
######################################################################
sub nic_dslreports1_update {
    debug("\nnic_dslreports1_update -------------------");
    ## update each configured host
    foreach my $h (@_) {
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to %s for %s", $ip, $h);
        verbose("UPDATE:", "updating %s", $h);

        my $url;
        $url  = "http://$config{$h}{'server'}/nic/";
        $url .= ynu($config{$h}{'static'}, 'statdns', 'dyndns', 'dyndns');
        $url .= "?action=edit&started=1&hostname=YES&host_id=$h";
        $url .= "&myip=";
        $url .= $ip if $ip;

        my $reply = geturl(
            proxy => opt('proxy'),
            url => $url,
            login => $config{$h}{'login'},
            password => $config{$h}{'password'},
        ) // '';
        if ($reply eq '') {
            failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
            next;
        }

        my @reply = split /\n/, $reply;
        my $return_code = '';
        foreach my $line (@reply) {
            $return_code = $1 if $line =~ m%^return\s+code\s*:\s*(.*)\s*$%i;
        }

        if ($return_code !~ /NOERROR/) {
            $config{$h}{'status'} = 'failed';
            warning("SENT:    %s", $url) unless opt('verbose');
            warning("REPLIED: %s", $reply);
            failed("updating %s", $h);

        } else {
            $config{$h}{'ip'}     = $ip;
            $config{$h}{'mtime'}  = $now;
            $config{$h}{'status'} = 'good';
            success("updating %s: %s: IP address set to %s", $h, $return_code, $ip);
        }
    }
}

######################################################################
## nic_zoneedit1_examples
######################################################################
sub nic_zoneedit1_examples {
    return <<"EoEXAMPLE";
o 'zoneedit1'

The 'zoneedit1' protocol is used by a DNS service offered by
www.zoneedit.com.

Configuration variables applicable to the 'zoneedit1' protocol are:
  protocol=zoneedit1           ##
  server=fqdn.of.service       ## defaults to www.zoneedit.com
  zone=zone-where-domains-are  ## only needed if 1 or more subdomains are deeper
                               ## than 1 level in relation to  the zone where it
                               ## is defined. For example, b.foo.com in a zone
                               ## foo.com doesn't need this, but a.b.foo.com in
                               ## the same zone needs zone=foo.com
  login=service-login          ## login name and password  registered with the service
  password=service-password    ##
  your.domain.name             ## the host registered with the service.

Example ${program}.conf file entries:
  ## single host update
  protocol=zoneedit1,                                     \\
  server=dynamic.zoneedit.com,                            \\
  zone=zone-where-domains-are,                            \\
  login=my-zoneedit-login,                                \\
  password=my-zoneedit-password                           \\
  my.domain.name
EoEXAMPLE
}

######################################################################
## nic_zoneedit1_updateable
######################################################################
sub nic_zoneedit1_updateable {
    return 0;
}

######################################################################
## nic_zoneedit1_update
# <SUCCESS CODE="200" TEXT="Update succeeded." ZONE="trialdomain.com" IP="127.0.0.12">
# <SUCCESS CODE="201" TEXT="No records need updating." ZONE="bannedware.com">
# <ERROR CODE="701" TEXT="Zone is not set up in this account." ZONE="bad.com">
######################################################################
sub nic_zoneedit1_update {
    debug("\nnic_zoneedit1_update -------------------");

    ## group hosts with identical attributes together
    my %groups = group_hosts_by([ @_ ], [ qw(login password server zone) ]);

    ## update each set of hosts that had similar configurations
    foreach my $sig (keys %groups) {
        my @hosts = @{$groups{$sig}};
        my $hosts = join(',', @hosts);
        my $h     = $hosts[0];
        my $ip    = $config{$h}{'wantip'};
        delete $config{$_}{'wantip'} foreach @hosts;

        info("setting IP address to %s for %s", $ip, $hosts);
        verbose("UPDATE:", "updating %s", $hosts);

        my $url = '';
        $url .= "http://$config{$h}{'server'}/auth/dynamic.html";
        $url .= "?host=$hosts";
        $url .= "&dnsto=$ip"   if $ip;
        $url .= "&zone=$config{$h}{'zone'}" if defined $config{$h}{'zone'};

        my $reply = geturl(
            proxy => opt('proxy'),
            url => $url,
            login => $config{$h}{'login'},
            password => $config{$h}{'password'},
        ) // '';
        if ($reply eq '') {
            failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});
            next;
        }
        next if !header_ok($hosts, $reply);

        my @reply = split /\n/, $reply;
        foreach my $line (@reply) {
            if ($line =~ /^[^<]*<(SUCCESS|ERROR)\s+([^>]+)>(.*)/) {
                my ($status, $assignments, $rest) = ($1, $2, $3);
                my ($left, %var) = parse_assignments($assignments);

                if (keys %var) {
                    my ($status_code, $status_text, $status_ip) = ('999', '', $ip);
                    $status_code = $var{'CODE'} if exists $var{'CODE'};
                    $status_text = $var{'TEXT'} if exists $var{'TEXT'};
                    $status_ip   = $var{'IP'}   if exists $var{'IP'};

                    if ($status eq 'SUCCESS' || ($status eq 'ERROR' && $var{'CODE'} eq '707')) {
                        $config{$h}{'ip'}     = $status_ip;
                        $config{$h}{'mtime'}  = $now;
                        $config{$h}{'status'} = 'good';

                        success("updating %s: IP address set to %s (%s: %s)", $h, $ip, $status_code, $status_text);

                    } else {
                        $config{$h}{'status'} = 'failed';
                        failed("updating %s: %s: %s", $h, $status_code, $status_text);
                    }
                    shift @hosts;
                    $h     = $hosts[0];
                    $hosts = join(',', @hosts);
                }
                $line = $rest;
                redo if $line;
            }
        }
        failed("updating %s: no response from %s", $hosts, $config{$h}{'server'})
            if @hosts;
    }
}
######################################################################
## nic_easydns_updateable
######################################################################
sub nic_easydns_updateable {
    my $host   = shift;
    my $update = 0;

    if ($config{$host}{'mx'} ne $cache{$host}{'mx'}) {
        info("forcing updating %s because 'mx' has changed to %s.", $host, $config{$host}{'mx'});
        $update = 1;

    } elsif ($config{$host}{'mx'} && (ynu($config{$host}{'backupmx'}, 1, 2, 3) ne ynu($config{$host}{'backupmx'}, 1, 2, 3))) {
        info("forcing updating %s because 'backupmx' has changed to %s.", $host, ynu($config{$host}{'backupmx'}, "YES", "NO", "NO"));
        $update = 1;

    } elsif ($config{$host}{'static'} ne $cache{$host}{'static'}) {

        info("forcing updating %s because 'static' has changed to %s.", $host, ynu($config{$host}{'static'}, "YES", "NO", "NO"));
        $update = 1;

    }
    return $update;
}
######################################################################
## nic_easydns_examples
######################################################################
sub nic_easydns_examples {
    return <<"EoEXAMPLE";
o 'easydns'

The 'easydns' protocol is used by the for fee DNS service offered
by www.easydns.com.

Configuration variables applicable to the 'easydns' protocol are:
  protocol=easydns             ##
  server=fqdn.of.service       ## defaults to members.easydns.com
  backupmx=no|yes              ## indicates that EasyDNS should be the secondary MX
                               ## for this domain or host.
  mx=any.host.domain           ## a host MX'ing for this host or domain.
  wildcard=no|yes              ## add a DNS wildcard CNAME record that points to {host}
  login=service-login          ## login name and password  registered with the service
  password=service-password    ##
  fully.qualified.host         ## the host registered with the service.

Example ${program}.conf file entries:
  ## single host update
  protocol=easydns,                                         \\
  login=my-easydns.com-login,                               \\
  password=my-easydns.com-password                          \\
  myhost.easydns.com

  ## multiple host update with wildcard'ing mx, and backupmx
  protocol=easydns,                                         \\
  login=my-easydns.com-login,                               \\
  password=my-easydns.com-password,                         \\
  mx=a.host.willing.to.mx.for.me,                           \\
  backupmx=yes,                                             \\
  wildcard=yes                                              \\
  my-toplevel-domain.com,my-other-domain.com

  ## multiple host update to the custom DNS service
  protocol=easydns,                                         \\
  login=my-easydns.com-login,                               \\
  password=my-easydns.com-password                          \\
  my-toplevel-domain.com,my-other-domain.com
EoEXAMPLE
}
######################################################################
## nic_easydns_update
######################################################################
sub nic_easydns_update {
    debug("\nnic_easydns_update -------------------");

    ## each host is in a group by itself
    my %groups = map { $_ => [ $_ ] } @_;

    my %errors = (
        'NOACCESS'  => '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'   => 'Client sent data that is not allowed in a dynamic DNS update.',
        'TOOSOON'   => 'Update frequency is too short.',
    );

    ## update each set of hosts that had similar configurations
    foreach my $sig (keys %groups) {
        my @hosts = @{$groups{$sig}};
        my $hosts = join(',', @hosts);
        my $h     = $hosts[0];
        my $ip    = $config{$h}{'wantip'};
        delete $config{$_}{'wantip'} foreach @hosts;

        info("setting IP address to %s for %s", $ip, $hosts);
        verbose("UPDATE:", "updating %s", $hosts);

        #'http://members.easydns.com/dyn/dyndns.php?hostname=test.burry.ca&myip=10.20.30.40&wildcard=ON'

        my $url;
        $url  = "http://$config{$h}{'server'}/dyn/dyndns.php?";
        $url .= "hostname=$hosts";
        $url .= "&myip=";
        $url .= $ip if $ip;
        $url .= "&wildcard=" . ynu($config{$h}{'wildcard'}, 'ON', 'OFF', 'OFF') if defined $config{$h}{'wildcard'};

        if ($config{$h}{'mx'}) {
            $url .= "&mx=$config{$h}{'mx'}";
            $url .= "&backmx=" . ynu($config{$h}{'backupmx'}, 'YES', 'NO');
        }

        my $reply = geturl(
            proxy => opt('proxy'),
            url => $url,
            login => $config{$h}{'login'},
            password => $config{$h}{'password'},
        ) // '';
        if ($reply eq '') {
            failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});
            next;
        }
        next if !header_ok($hosts, $reply);

        my @reply = split /\n/, $reply;
        my $state = 'header';
        foreach my $line (@reply) {
            if ($state eq 'header') {
                $state = 'body';

            } elsif ($state eq 'body') {
                $state = 'results' if $line eq '';

            } elsif ($state =~ /^results/) {
                $state = 'results2';

                my ($status) = $line =~ /^(\S*)\b.*/;
                my $h = shift @hosts;

                $config{$h}{'status'} = $status;
                if ($status eq 'NOERROR') {
                    $config{$h}{'ip'}    = $ip;
                    $config{$h}{'mtime'} = $now;
                    success("updating %s: %s: IP address set to %s", $h, $status, $ip);

                } elsif ($status =~ /TOOSOON/) {
                    ## make sure we wait at least a little
                    my ($wait, $units) = (5, 'm');
                    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';
                    $config{$h}{'wtime'} = $now + $sec;
                    warning("updating %s: %s: wait %d %s before further updates", $h, $status, $wait, $units);

                } elsif (exists $errors{$status}) {
                    failed("updating %s: %s: %s", $h, $line, $errors{$status});

                } else {
                    failed("updating %s: unexpected status (%s)", $h, $line);
                }
                last;
            }
        }
        failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'})
            if $state ne 'results2';
    }
}
######################################################################

######################################################################
## nic_namecheap_examples
######################################################################
sub nic_namecheap_examples {
    return <<"EoEXAMPLE";

o 'namecheap'

The 'namecheap' protocol is used by DNS service offered by www.namecheap.com.

Configuration variables applicable to the 'namecheap' protocol are:
  protocol=namecheap           ##
  server=fqdn.of.service       ## defaults to dynamicdns.park-your-domain.com
  login=service-login          ## the domain of the dynamic DNS record you want to update
  password=service-password    ## Generated password for your dynamic DNS record
  hostname                     ## the subdomain to update, use @ for base domain name, * for catch all

Example ${program}.conf file entries:
  ## single host update
  protocol=namecheap                                          \\
  login=example.com                                           \\
  password=example.com-generated-password                     \\
  @

EoEXAMPLE
}
######################################################################
## nic_namecheap_update
##
## written by Dan Boardman
##
## based on https://www.namecheap.com/support/knowledgebase/
## article.aspx/29/11/how-to-use-the-browser-to-dynamically-update-hosts-ip
## needs this url to update:
## https://dynamicdns.park-your-domain.com/update?host=host_name&
## domain=domain.com&password=domain_password[&ip=your_ip]
##
######################################################################
sub nic_namecheap_update {


    debug("\nnic_namecheap1_update -------------------");

    ## update each configured host
    foreach my $h (@_) {
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to %s for %s", $ip, $h);
        verbose("UPDATE:", "updating %s", $h);

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

        my $reply = geturl(proxy => opt('proxy'), url => $url) // '';
        if ($reply eq '') {
            failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
            next;
        }
        next if !header_ok($h, $reply);

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

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

######################################################################
## nic_nfsn_examples
######################################################################
sub nic_nfsn_examples {
    return <<"EoEXAMPLE";

o 'nfsn'

The 'nfsn' protocol is used for the DNS service offered by www.nearlyfreespeech.net. Use this URL to get your API-Key-password:
  https://members.nearlyfreespeech.net/support/assist?tag=apikey

Configuration variables applicable to the 'nfsn' protocol are:
  protocol=nfsn
  server=api-server    ## defaults to api.nearlyfreespeech.net
  login=member-login   ## NearlyFreeSpeech.net login name
  password=api-key     ## NearlyFreeSpeech.net API key
  zone=zone            ## The DNS zone under which the hostname falls; e.g. example.com
  hostname             ## the hostname to update in the specified zone; e.g. example.com or www.example.com

Example ${program}.conf file entries:
  ## update two hosts (example.com and www.example.com) in example.com zone
  protocol=nfsn,                                         \\
  login=my-nfsn-member-login,                            \\
  password=my-nfsn-api-key,                              \\
  zone=example.com                                       \\
  example.com,www.example.com

  ## repeat the above for other zones, e.g. example.net:
  [...]
  zone=example.net                                       \\
  subdomain1.example.net,subdomain2.example.net

EoEXAMPLE
}

######################################################################
## nic_nfsn_gen_auth_header
######################################################################
sub nic_nfsn_gen_auth_header {
    my $h    = shift;
    my $path = shift;
    my $body = shift // '';

    ## API requests must include a custom HTTP header in the
    ## following format:
    ##
    ## X-NFSN-Authentication: login;timestamp;salt;hash
    ##
    ## In this header, login is the member login name of the user
    ## making the API request.
    my $auth_header = 'X-NFSN-Authentication: ';
    $auth_header .= $config{$h}{'login'} . ';';

    ## timestamp is the standard 32-bit unsigned Unix timestamp
    ## value.
    my $timestamp = time();
    $auth_header .= $timestamp . ';';

    ## salt is a randomly generated 16 character alphanumeric value
    ## (a-z, A-Z, 0-9).
    my @chars = ('A'..'Z', 'a'..'z', '0'..'9');
    my $salt;
    for (my $i = 0; $i < 16; $i++) {
        $salt .= $chars[int(rand(@chars))];
    }
    $auth_header .= $salt . ';';

    ## hash is a SHA1 hash of a string in the following format:
    ## login;timestamp;salt;api-key;request-uri;body-hash
    my $hash_string = $config{$h}{'login'} . ';' .
              $timestamp . ';' .
              $salt . ';' .
              $config{$h}{'password'} . ';';

    ## The request-uri value is the path portion of the requested URL
    ## (i.e. excluding the protocol and hostname).
    $hash_string .= $path . ';';

    ## The body-hash is the SHA1 hash of the request body (if any).
    ## If there is no request body, the SHA1 hash of the empty string
    ## must be used.
    my $body_hash = sha1_hex($body);
    $hash_string .= $body_hash;

    my $hash = sha1_hex($hash_string);
    $auth_header .= $hash;
    $auth_header .= "\n";

    return $auth_header;
}

######################################################################
## nic_nfsn_make_request
######################################################################
sub nic_nfsn_make_request {
    my $h = shift;
    my $path = shift;
    my $method = shift // 'GET';
    my $body = shift // '';

    my $base_url = "https://$config{$h}{'server'}";
    my $url      = $base_url . $path;
    my $header   = nic_nfsn_gen_auth_header($h, $path, $body);
    if ($method eq 'POST' && $body ne '') {
        $header .= "Content-Type: application/x-www-form-urlencoded\n";
    }

    return geturl(
        proxy => opt('proxy'),
        url => $url,
        headers => $header,
        method => $method,
        data => $body,
    );
}

######################################################################
## nic_nfsn_handle_error
######################################################################
sub nic_nfsn_handle_error {
    my $resp = shift;
    my $h    = shift;

    $resp =~ s/^.*?\n\n//s;  # Strip header
    my $json = eval { decode_json($resp) };
    if ($@ || ref($json) ne 'HASH' || not defined $json->{'error'}) {
        failed("Invalid error response: %s", $resp);
        return;
    }

    failed("%s", $json->{'error'});
    if (defined $json->{'debug'}) {
        failed("%s", $json->{'debug'});
    }
}

######################################################################
## nic_nfsn_update
##
## Written by John Brooks
##
## Based on API docs: https://members.nearlyfreespeech.net/wiki/API/Introduction
## Uses the API endpoints under https://api.nearlyfreespeech.net/dns/$zone/
##
## NB: There is no "updateRR" API function; to update an existing RR, we use
##     removeRR to delete the RR, and then addRR to re-add it with the new data.
##
######################################################################
sub nic_nfsn_update {
    debug("\nnic_nfsn_update -------------------");

    ## update each configured host
    foreach my $h (@_) {
        my $zone = $config{$h}{'zone'};
        my $name;

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

        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to %s for %s", $ip, $h);
        verbose("UPDATE", "updating %s", $h);

        my $list_path = "/dns/$zone/listRRs";
        my $list_body = encode_www_form_urlencoded({name => $name, type => 'A'});
        my $list_resp = nic_nfsn_make_request($h, $list_path, 'POST', $list_body);
        if (!header_ok($h, $list_resp)) {
            $config{$h}{'status'} = 'failed';
            nic_nfsn_handle_error($list_resp, $h);
            next;
        }

        $list_resp =~ s/^.*?\n\n//s;  # Strip header
        my $list = eval { decode_json($list_resp) };
        if ($@) {
            $config{$h}{'status'} = 'failed';
            failed("updating %s: JSON decoding failure", $h);
            next;
        }

        my $rr_ttl = $config{$h}{'ttl'};

        if (ref($list) eq 'ARRAY' && defined $list->[0]->{'data'}) {
            my $rr_data = $list->[0]->{'data'};
            my $rm_path = "/dns/$zone/removeRR";
            my $rm_data = {name => $name,
                           type => 'A',
                           data => $rr_data};
            my $rm_body = encode_www_form_urlencoded($rm_data);
            my $rm_resp = nic_nfsn_make_request($h, $rm_path,
                                                'POST', $rm_body);
            if (!header_ok($h, $rm_resp)) {
                $config{$h}{'status'} = 'failed';
                nic_nfsn_handle_error($rm_resp);
                next;
            }
        }

        my $add_path = "/dns/$zone/addRR";
        my $add_data = {name => $name,
                        type => 'A',
                        data => $ip,
                        ttl => $rr_ttl};
        my $add_body = encode_www_form_urlencoded($add_data);
        my $add_resp = nic_nfsn_make_request($h, $add_path, 'POST',
                                             $add_body);
        if (header_ok($h, $add_resp)) {
            $config{$h}{'ip'}     = $ip;
            $config{$h}{'mtime'}  = $now;
            $config{$h}{'status'} = 'good';
            success("updating %s: good: IP address set to %s", $h, $ip);
        } else {
            $config{$h}{'status'} = 'failed';
            nic_nfsn_handle_error($add_resp, $h);
        }
    }
}

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

######################################################################
## nic_sitelutions_examples
######################################################################
sub nic_sitelutions_examples {
    return <<"EoEXAMPLE";

o 'sitelutions'

The 'sitelutions' protocol is used by DNS services offered by www.sitelutions.com.

Configuration variables applicable to the 'sitelutions' protocol are:
  protocol=sitelutions         ##
  server=fqdn.of.service       ## defaults to sitelutions.com
  login=service-login          ## login name and password  registered with the service
  password=service-password    ##
  A_record_id                  ## Id of the A record for the host registered with the service.

Example ${program}.conf file entries:
  ## single host update
  protocol=sitelutions,                                         \\
  login=my-sitelutions.com-login,                               \\
  password=my-sitelutions.com-password                          \\
  my-sitelutions.com-id_of_A_record

EoEXAMPLE
}
######################################################################
## nic_sitelutions_update
##
## written by Mike W. Smith
##
## based on http://www.sitelutions.com/help/dynamic_dns_clients#updatespec
## needs this url to update:
## https://www.sitelutions.com/dnsup?id=990331&user=myemail@mydomain.com&pass=SecretPass&ip=192.168.10.4
## domain=domain.com&password=domain_password&ip=your_ip
##
######################################################################
sub nic_sitelutions_update {


    debug("\nnic_sitelutions_update -------------------");

    ## update each configured host
    foreach my $h (@_) {
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to %s for %s", $ip, $h);
        verbose("UPDATE:", "updating %s", $h);

        my $url;
        $url  = "http://$config{$h}{'server'}/dnsup";
        $url .= "?id=$h";
        $url .= "&user=$config{$h}{'login'}";
        $url .= "&pass=$config{$h}{'password'}";
        $url .= "&ip=";
        $url .= $ip if $ip;

        my $reply = geturl(proxy => opt('proxy'), url => $url);
        if (!defined($reply) || !$reply) {
            failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
            next;
        }
        next if !header_ok($h, $reply);

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

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

######################################################################
## nic_freedns_examples
######################################################################
sub nic_freedns_examples {
    return <<"EoEXAMPLE";

o 'freedns'

The 'freedns' protocol is used by DNS services offered by freedns.afraid.org.

Configuration variables applicable to the 'freedns' protocol are:
  protocol=freedns             ##
  server=fqdn.of.service       ## defaults to freedns.afraid.org
  login=service-login          ## login name and password registered with the service
  password=service-password    ##
  fully.qualified.host         ## the host registered with the service.

Example ${program}.conf file entries:
  ## single host update
  protocol=freedns,                                             \\
  login=my-freedns.afraid.org-login,                            \\
  password=my-freedns.afraid.org-password                       \\
  myhost.afraid.com

EoEXAMPLE
}
######################################################################
## nic_freedns_update
##
## API v1 documented at http://freedns.afraid.org/api/
##
## An update requires two steps. The first is to get a list of records from:
##   http://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
##
## 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. Any record can be updated to hold
## either type of address (e.g., if given an IPv6 address the record will automatically become an
## AAAA record).
##
## The second step is to visit the appropriate record's update URL with
## ?address=<ipv4-or-ipv6-address> appended. "Updated" in the result means success, "fail" means
## failure.
######################################################################
sub nic_freedns_update {
    debug("\nnic_freedns_update -------------------");
    # Separate the records that are currently holding IPv4 addresses from the records that are
    # currently holding IPv6 addresses so that we can avoid switching a record to a different
    # address type.
    my %recs_ipv4;
    my %recs_ipv6;
    my $url_tmpl = "http://$config{$_[0]}{'server'}/api/?action=getdyndns&v=2&sha=<credentials>";
    my $creds = sha1_hex("$config{$_[0]}{'login'}|$config{$_[0]}{'password'}");
    (my $url = $url_tmpl) =~ s/<credentials>/$creds/;
    my $reply = geturl(proxy => opt('proxy'), url => $url);
    my $record_list_error = '';
    if ($reply && header_ok($_[0], $reply)) {
        $reply =~ s/^.*?\n\n//s;  # Strip the headers.
        for (split("\n", $reply)) {
            my @rec = split(/\|/);
            next if ($#rec < 2);
            my $recs = is_ipv6($rec[1]) ? \%recs_ipv6 : \%recs_ipv4;
            $recs->{$rec[0]} = \@rec;
            debug("host: %s, current address: %s, update URL: %s", @rec);
        }
        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";
    }

    foreach my $h (@_) {
        if (!$h) { next }
        my $ip = delete $config{$h}{'wantip'};

        info("%s: setting IP address to %s", $h, $ip);

        if ($record_list_error ne '') {
            $config{$h}{'status'} = 'failed';
            failed("updating %s: %s", $h, $record_list_error);
            next;
        }
        # If there is a record with matching type then update it, otherwise let
        # freedns convert the record to the desired type.
        my $rec = is_ipv6($ip)
            ? ($recs_ipv6{$h} // $recs_ipv4{$h})
            : ($recs_ipv4{$h} // $recs_ipv6{$h});
        if (!defined($rec)) {
            $config{$h}{'status'} = 'failed';
            failed("updating %s: host record does not exist", $h);
            next;
        }

        if ($ip eq $rec->[1]) {
            $config{$h}{'ip'}     = $ip;
            $config{$h}{'mtime'}  = $now;
            $config{$h}{'status'} = 'good';
            success("update not necessary %s: good: IP address already set to %s", $h, $ip)
                if (!$daemon || opt('verbose'));
        } else {
            my $url = $rec->[2] . "&address=" . $ip;
            debug("Update: %s", $url);
            my $reply = geturl(proxy => opt('proxy'), url => $url);
            if (!defined($reply) || !$reply || !header_ok($h, $reply)) {
                $config{$h}{'status'} = 'failed';
                failed("updating %s: Could not connect to %s.", $h, $url);
                next;
            }

            $reply =~ s/^.*?\n\n//s;  # Strip the headers.
            if ($reply =~ /Updated.*$h.*to.*$ip/) {
                $config{$h}{'ip'}     = $ip;
                $config{$h}{'mtime'}  = $now;
                $config{$h}{'status'} = 'good';
                success("updating %s: good: IP address set to %s", $h, $ip);
            } else {
                $config{$h}{'status'} = 'failed';
                warning("SENT: %s", $url) unless opt('verbose');
                warning("REPLIED: %s", $reply);
                failed("updating %s: Invalid reply.", $h);
            }
        }
    }
}

######################################################################
## nic_changeip_examples
######################################################################
sub nic_changeip_examples {
    return <<"EoEXAMPLE";

o 'changeip'

The 'changeip' protocol is used by DNS services offered by changeip.com.

Configuration variables applicable to the 'changeip' protocol are:
  protocol=changeip            ##
  server=fqdn.of.service       ## defaults to nic.changeip.com
  login=service-login          ## login name and password registered with the service
  password=service-password    ##
  fully.qualified.host         ## the host registered with the service.

Example ${program}.conf file entries:
  ## single host update
  protocol=changeip,                                               \\
  login=my-my-changeip.com-login,                                  \\
  password=my-changeip.com-password                                \\
  myhost.changeip.org

EoEXAMPLE
}

######################################################################
## nic_changeip_update
##
## adapted by Michele Giorato
##
## https://nic.ChangeIP.com/nic/update?hostname=host.example.org&myip=66.185.162.19
##
######################################################################
sub nic_changeip_update {


    debug("\nnic_changeip_update -------------------");

    ## update each configured host
    foreach my $h (@_) {
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to %s for %s", $ip, $h);
        verbose("UPDATE:", "updating %s", $h);

        my $url;
        $url  = "http://$config{$h}{'server'}/nic/update";
        $url .= "?hostname=$h";
        $url .= "&ip=";
        $url .= $ip if $ip;

        my $reply = geturl(
            proxy => opt('proxy'),
            url => $url,
            login => $config{$h}{'login'},
            password => $config{$h}{'password'},
        );
        if (!defined($reply) || !$reply) {
            failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
            next;
        }
        next if !header_ok($h, $reply);

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

######################################################################
## nic_googledomains_examples
##
## written by Nelson Araujo
##
######################################################################
sub nic_googledomains_examples {
    return <<"EoEXAMPLE";
o 'googledomains'

The 'googledomains' protocol is used by DNS service offered by www.google.com/domains.

Configuration variables applicable to the 'googledomains' protocol are:
  protocol=googledomains       ##
  login=service-login          ## the user name provided by the admin interface
  password=service-password    ## the password provided by the admin interface
  fully.qualified.host         ## the host registered with the service.

Example ${program}.conf file entries:
  ## single host update
  protocol=googledomains,                                      \\
  login=my-generated-user-name,                                \\
  password=my-genereated-password                              \\
  myhost.com

  ## multiple host update to the custom DNS service
  protocol=googledomains,                                      \\
  login=my-generated-user-name,                                \\
  password=my-genereated-password                              \\
  my-toplevel-domain.com,my-other-domain.com
EoEXAMPLE
}
######################################################################
## nic_googledomains_update
######################################################################
sub nic_googledomains_update {
    debug("\nnic_googledomains_update -------------------");

    ## group hosts with identical attributes together
    my %groups = group_hosts_by([ @_ ], [ qw(server login password) ]);

    ## update each set of hosts that had similar configurations
    foreach my $sig (keys %groups) {
        my @hosts = @{$groups{$sig}};
        my $key   = $hosts[0];
        my $ip    = $config{$key}{'wantip'};

        # FQDNs
        for my $host (@hosts) {
            delete $config{$host}{'wantip'};

            info("setting IP address to %s for %s", $ip, $host);
            verbose("UPDATE:", "updating %s", $host);

            # Update the DNS record
            my $url = "https://$config{$host}{'server'}/nic/update";
            $url .= "?hostname=$host";
            $url .= "&myip=";
            $url .= $ip if $ip;

            my $reply = geturl(
                proxy => opt('proxy'),
                url => $url,
                login => $config{$host}{'login'},
                password => $config{$host}{'password'},
            );
            unless ($reply) {
                failed("updating %s: Could not connect to %s.", $host, $config{$host}{'server'});
                next;
            }
            next if !header_ok($host, $reply);

            # Cache
            $config{$host}{'ip'}     = $ip;
            $config{$host}{'mtime'}  = $now;
            $config{$host}{'status'} = 'good';
        }
    }
}

######################################################################
## nic_nsupdate_examples
######################################################################
sub nic_nsupdate_examples {
    return <<"EoEXAMPLE";
o 'nsupdate'

The 'nsupdate' protocol is used to submit Dynamic DNS Update requests as
defined in RFC2136 to a name server using the 'nsupdate' command line
utility part of ISC BIND.  Dynamic DNS updates allow resource records to
be added or removed from a zone configured for dynamic updates through
DNS requests protected using TSIG.  BIND ships with 'ddns-confgen', a
utility to generate sample configurations and instructions for both the
server and the client.  See nsupdate(1) and ddns-confgen(8) for details.

Configuration variables applicable to the 'nsupdate' protocol are:
  protocol=nsupdate
  server=ns1.example.com       ## name or IP address of the DNS server to send
                               ## the update requests to; usually master for
                               ## zone, but slaves should forward the request
  password=tsig.key            ## path and name of the symmetric HMAC key file
                               ## to use for TSIG signing of the request
                               ## (as generated by 'ddns-confgen -q' and
                               ## configured on server in 'grant' statement)
  zone=dyn.example.com         ## forward zone that is to be updated
  ttl=600                      ## time to live of the record;
                               ## defaults to 600 seconds
  tcp=off|on                   ## nsupdate uses UDP by default, and switches to
                               ## TCP if the update is too large to fit in a
                               ## UDP datagram; this setting forces TCP;
                               ## defaults to off
  login=/usr/bin/nsupdate      ## path and name of nsupdate binary;
                               ## defaults to '/usr/bin/nsupdate'
  <hostname>                   ## fully qualified hostname to update

Example ${program}.conf file entries:
  ## single host update
  protocol=nsupdate \\
  server=ns1.example.com \\
  password=/etc/${program}/dyn.example.com.key \\
  zone=dyn.example.com \\
  ttl=3600 \\
  myhost.dyn.example.com

EoEXAMPLE
}

######################################################################
## nic_nsupdate_update
## by Daniel Roethlisberger <daniel@roe.ch>
######################################################################
sub nic_nsupdate_update {
    debug("\nnic_nsupdate_update -------------------");

    ## group hosts with identical attributes together
    my %groups = group_hosts_by([ @_ ], [ qw(login password server zone) ]);

    ## update each set of hosts that had similar configurations
    foreach my $sig (keys %groups) {
        my @hosts   = @{$groups{$sig}};
        my $hosts   = join(',', @hosts);
        my $h       = $hosts[0];
        my $binary  = $config{$h}{'login'};
        my $keyfile = $config{$h}{'password'};
        my $server  = $config{$h}{'server'};
        ## nsupdate requires a port number to be separated by whitepace, not colon
        $server =~ s/:/ /;
        my $zone       = $config{$h}{'zone'};
        my $ip         = $config{$h}{'wantip'};
        my $recordtype = '';
        if (is_ipv6($ip)) {
            $recordtype = 'AAAA';
        } else {
            $recordtype = 'A';
        }
        delete $config{$_}{'wantip'} foreach @hosts;

        info("setting IP address to %s for %s", $ip, $hosts);
        verbose("UPDATE:", "updating %s", $hosts);

        ## send separate requests for each zone with all hosts in that zone
        my $instructions = <<"EoINSTR1";
server $server
zone $zone.
EoINSTR1
        foreach (@hosts) {
            $instructions .= <<"EoINSTR2";
update delete $_. $recordtype
update add $_. $config{$_}{'ttl'} $recordtype $ip
EoINSTR2
        }
        $instructions .= <<"EoINSTR3";
send
EoINSTR3
        my $command = "$binary -k $keyfile";
        $command .= " -v" if ynu($config{$h}{'tcp'}, 1, 0, 0);
        $command .= " -d" if (opt('debug'));
        verbose("UPDATE:", "nsupdate command is: %s", $command);
        verbose("UPDATE:", "nsupdate instructions are:\n%s", $instructions);

        my $status = pipecmd($command, $instructions);
        if ($status eq 1) {
            foreach (@hosts) {
                $config{$_}{'ip'}    = $ip;
                $config{$_}{'mtime'} = $now;
                success("updating %s: %s: IP address set to %s", $_, $status, $ip);
            }
        } else {
            foreach (@hosts) {
                failed("updating %s", $_);
            }
        }
    }
}

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

######################################################################
## nic_cloudflare_examples
##
## written by Ian Pye
##
######################################################################
sub nic_cloudflare_examples {
    return <<"EoEXAMPLE";
o 'cloudflare'

The 'cloudflare' protocol is used by DNS service offered by www.cloudflare.com.

Configuration variables applicable to the 'cloudflare' protocol are:
  protocol=cloudflare          ##
  server=fqdn.of.service       ## defaults to api.cloudflare.com/client/v4
  login=service-login          ## login email when using a global API key
  password=service-password    ## Global API key, or an API token. If using an API token, it must have the permissions "Zone - DNS - Edit" and "Zone - Zone - Read". The Zone resources must be "Include - All zones".
  fully.qualified.host         ## the host registered with the service.

Example ${program}.conf file entries:
  ## single host update using a global API key
  protocol=cloudflare,                                         \\
  zone=dns.zone,                                               \\
  login=my-cloudflare.com-login,                               \\
  password=my-cloudflare-global-key                            \\
  myhost.com

  ## single host update using an API token
  protocol=cloudflare,                                         \\
  zone=dns.zone,                                               \\
  password=cloudflare-api-token                                \\
  myhost.com

  ## multiple host update to the custom DNS service
  protocol=cloudflare,                                         \\
  zone=dns.zone,                                               \\
  login=my-cloudflare.com-login,                               \\
  password=my-cloudflare-global-api-key                        \\
  my-toplevel-domain.com,my-other-domain.com
EoEXAMPLE
}
######################################################################
## nic_cloudflare_update
######################################################################
sub nic_cloudflare_update {
    debug("\nnic_cloudflare_update -------------------");

    ## group hosts with identical attributes together
    my %groups = group_hosts_by([ @_ ], [ qw(ssh login password server wildcard mx backupmx zone) ]);

    ## update each set of hosts that had similar configurations
    foreach my $sig (keys %groups) {
        my @hosts = @{$groups{$sig}};
        my $hosts = join(',', @hosts);
        my $key   = $hosts[0];
        my $ip    = $config{$key}{'wantip'};

        my $headers = "Content-Type: application/json\n";
        if ($config{$key}{'login'} eq 'token') {
            $headers .= "Authorization: Bearer $config{$key}{'password'}\n";
        } else {
            $headers .= "X-Auth-Email: $config{$key}{'login'}\n";
            $headers .= "X-Auth-Key: $config{$key}{'password'}\n";
        }

        # FQDNs
        for my $domain (@hosts) {
            (my $hostname = $domain) =~ s/\.$config{$key}{zone}$//;
            delete $config{$domain}{'wantip'};

            info("setting IP address to %s for %s", $ip, $domain);
            verbose("UPDATE:", "updating %s", $domain);

            # Get zone ID
            my $url = "https://$config{$key}{'server'}/zones?";
            $url .= "name=".$config{$key}{'zone'};

            my $reply = geturl(proxy => opt('proxy'), url => $url, headers => $headers);
            unless ($reply) {
                failed("updating %s: Could not connect to %s.", $domain, $config{$key}{'server'});
                next;
            }
            next if !header_ok($domain, $reply);

            # Strip header
            $reply =~ s/^.*?\n\n//s;
            my $response = eval { decode_json($reply) };
            if (!defined $response || !defined $response->{result}) {
                failed("invalid json or result.");
                next;
            }

            # Pull the ID out of the json, messy
            my ($zone_id) = map { $_->{name} eq $config{$key}{'zone'} ? $_->{id} : () } @{$response->{result}};
            unless ($zone_id) {
                failed("updating %s: No zone ID found.", $config{$key}{'zone'});
                next;
            }
            info("zone ID is %s", $zone_id);

            # Get DNS record ID
            $url = "https://$config{$key}{'server'}/zones/$zone_id/dns_records?";
            if (is_ipv6($ip)) {
                $url .= "type=AAAA&name=$domain";
            } else {
                $url .= "type=A&name=$domain";
            }

            $reply = geturl(proxy => opt('proxy'), url => $url, headers => $headers);
            unless ($reply) {
                failed("updating %s: Could not connect to %s.", $domain, $config{$key}{'server'});
                next;
            }
            next if !header_ok($domain, $reply);

            # Strip header
            $reply =~ s/^.*?\n\n//s;
            $response = eval { decode_json($reply) };
            if (!defined $response || !defined $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("updating %s: No DNS record ID found.", $domain);
                next;
            }
            info("DNS record ID is %s", $dns_rec_id);

            # Set domain
            $url = "https://$config{$key}{'server'}/zones/$zone_id/dns_records/$dns_rec_id";
            my $data = "{\"content\":\"$ip\"}";
            $reply = geturl(
                proxy => opt('proxy'),
                url => $url,
                headers => $headers,
                method => "PATCH",
                data => $data,
            );
            unless ($reply) {
                failed("updating %s: Could not connect to %s.", $domain, $config{$domain}{'server'});
                next;
            }
            next if !header_ok($domain, $reply);

            # Strip header
            $reply =~ s/^.*?\n\n//s;
            $response = eval { decode_json($reply) };
            if (!defined $response || !defined $response->{result}) {
                failed("invalid json or result.");
            } else {
                success("%s -- Updated Successfully to %s", $domain, $ip);

            }

            # Cache
            $config{$domain}{'ip'}     = $ip;
            $config{$domain}{'mtime'}  = $now;
            $config{$domain}{'status'} = 'good';
        }
    }
}
######################################################################
## nic_yandex_examples
######################################################################
sub nic_yandex_examples {
    return <<"EoEXAMPLE";
o Yandex

The 'yandex' protocol is used to by DNS service offered by Yandex.

Configuration variables applicable to the 'yandex' protocol are:
  protocol=yandex             ##
  server=fqdn.of.service       ## defaults to pddimp.yandex.ru
  login=dns.zone               ## Your zone name
  password=pdd-token           ## PDD token for authentication
  fully.qualified.host         ## the host registered with the service.

Example ${program}.conf file entries:
  ## single host update
  protocol=yandex,                                              \\
  login=myhost.com,                                             \\
  password=123456789ABCDEF0000000000000000000000000000000000000 \\
  record.myhost.com

  ## multiple host update
  protocol=yandex,                                              \\
  login=myhost.com,                                             \\
  password=123456789ABCDEF0000000000000000000000000000000000000 \\
  record.myhost.com,other.myhost.com
EoEXAMPLE
}
######################################################################
## nic_yandex_update
##
## written by Denis Akimkin
##
######################################################################
sub nic_yandex_update {
    debug("\nnic_yandex_update -------------------");

    ## group hosts with identical attributes together
    my %groups = group_hosts_by([ @_ ], [ qw(server login pasword) ]);

    ## update each set of hosts that had similar configurations
    foreach my $sig (keys %groups) {
        my @hosts   = @{$groups{$sig}};
        my $key     = $hosts[0];
        my $ip      = $config{$key}{'wantip'};
        my $headers = "PddToken: $config{$key}{'password'}\n";

        # FQDNs
        for my $host (@hosts) {
            delete $config{$host}{'wantip'};

            info("setting IP address to %s for %s", $ip, $host);
            verbose("UPDATE:", "updating %s", $host);

            # Get record ID for host
            my $url = "https://$config{$host}{'server'}/api2/admin/dns/list?";
            $url .= "domain=";
            $url .= $config{$key}{'login'};
            my $reply = geturl(proxy => opt('proxy'), url => $url, headers => $headers);
            unless ($reply) {
                failed("updating %s: Could not connect to %s.", $host, $config{$key}{'server'});
                next;
            }
            next if !header_ok($host, $reply);

            # Strip header
            $reply =~ s/^.*?\n\n//s;
            my $response = eval { decode_json($reply) };
            if ($response->{success} eq 'error') {
                failed("%s", $response->{error});
                next;
            }

            # Pull the ID out of the json
            my ($id) = map { $_->{fqdn} eq $host ? $_->{record_id} : () } @{$response->{records}};
            unless ($id) {
                failed("updating %s: DNS record ID not found.", $host);
                next;
            }

            # Update the DNS record
            $url = "https://$config{$host}{'server'}/api2/admin/dns/edit";
            my $data = "domain=";
            $data .= $config{$key}{'login'};
            $data .= "&record_id=";
            $data .= $id;
            $data .= "&content=";
            $data .= $ip if $ip;

            $reply = geturl(
                proxy => opt('proxy'),
                url => $url,
                headers => $headers,
                method => 'POST',
                data => $data,
            );
            unless ($reply) {
                failed("updating %s: Could not connect to %s.", $host, $config{$host}{'server'});
                next;
            }
            next if !header_ok($host, $reply);

            # Strip header
            $reply =~ s/^.*?\n\n//s;
            $response = eval { decode_json($reply) };
            if ($response->{success} eq 'error') {
                failed("%s", $response->{error});
            } else {
                success("%s -- Updated Successfully to %s", $host, $ip);
            }

            # Cache
            $config{$host}{'ip'}     = $ip;
            $config{$host}{'mtime'}  = $now;
            $config{$host}{'status'} = 'good';
        }
    }
}

######################################################################
## nic_duckdns_examples
######################################################################
sub nic_duckdns_examples {
    return <<"EoEXAMPLE";
o 'duckdns'

The 'duckdns' protocol is used by the free
dynamic DNS service offered by www.duckdns.org.
Check https://www.duckdns.org/install.jsp?tab=linux-cron for API

Configuration variables applicable to the 'duckdns' protocol are:
  protocol=duckdns               ##
  server=www.fqdn.of.service   ## defaults to www.duckdns.org
  password=service-password    ## password (token) registered with the service
  non-fully.qualified.host         ## the host registered with the service.

Example ${program}.conf file entries:
  ## single host update
  protocol=duckdns,        \\
  password=your_password,  \\
  myhost

EoEXAMPLE
}

######################################################################
## nic_duckdns_update
## by George Kranis (copypasta from nic_dtdns_update)
## http://www.duckdns.org/update?domains=mydomain1,mydomain2&token=xxxx-xxx-xx-x&ip=x.x.x.x
## response contains OK or KO
######################################################################
sub nic_duckdns_update {
    debug("\nnic_duckdns_update -------------------");

    ## update each configured host
    ## should improve to update in one pass
    foreach my $h (@_) {
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to %s for %s", $ip, $h);
        verbose("UPDATE:", "updating %s", $h);

        # Set the URL that we're going to to update
        my $url;
        $url  = "https://$config{$h}{'server'}/update";
        $url .= "?domains=";
        $url .= $h;
        $url .= "&token=";
        $url .= $config{$h}{'password'};
        $url .= "&ip=";
        $url .= $ip;


        # Try to get URL
        my $reply = geturl(proxy => opt('proxy'), url => $url);

        # No response, declare as failed
        if (!defined($reply) || !$reply) {
            failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
            next;
        }
        next if !header_ok($h, $reply);

        my @reply = split /\n/, $reply;
        my $returned = pop(@reply);
        if ($returned =~ /OK/) {
            $config{$h}{'ip'}     = $ip;
            $config{$h}{'mtime'}  = $now;
            $config{$h}{'status'} = 'good';
            success("updating %s: good: IP address set to %s", $h, $ip);
        } else {
            $config{$h}{'status'} = 'failed';
            failed("updating %s: Server said: '%s'", $h, $returned);
        }
    }
}

######################################################################
## nic_freemyip_examples
######################################################################
sub nic_freemyip_examples {
    return <<"EoEXAMPLE";
o 'freemyip'

The 'freemyip' protocol is used by the free
dynamic DNS service available at freemyip.com.
API is documented here: https://freemyip.com/help.py

Configuration variables applicable to the 'freemyip' protocol are:
  protocol=freemyip               ##
  password=service-token             ## token for your domain
  non-fully.qualified.host        ## the host registered with the service.

Example ${program}.conf file entries:
  ## single host update
  protocol=freemyip,                                     \\
  password=35a6b8d65c6e67c7f78cca65cd                    \\
  myhost

EoEXAMPLE
}

######################################################################
## nic_freemyip_update
## by Cadence (reused code from nic_duckdns)
## http://freemyip.com/update?token=ec54b4b64db27fe8873c7f7&domain=myhost
## response contains OK or ERROR
######################################################################
sub nic_freemyip_update {
    debug("\nnic_freemyip_update -------------------");

    foreach my $h (@_) {
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to %s for %s", $ip, $h);
        verbose("UPDATE:", "updating %s", $h);

        # Set the URL that we're going to to update
        my $url;
        $url  = "http://$config{$h}{'server'}/update";
        $url .= "?token=";
        $url .= $config{$h}{'password'};
        $url .= "&domain=";
        $url .= $h;

        # Try to get URL
        my $reply = geturl(proxy => opt('proxy'), url => $url);

        # No response, declare as failed
        if (!defined($reply) || !$reply) {
            failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
            next;
        }
        next if !header_ok($h, $reply);

        my @reply = split /\n/, $reply;
        my $returned = pop(@reply);
        if ($returned =~ /OK/) {
            $config{$h}{'ip'}     = $ip;
            $config{$h}{'mtime'}  = $now;
            $config{$h}{'status'} = 'good';
            success("updating %s: good: IP address set to %s", $h, $ip);
        } else {
            $config{$h}{'status'} = 'failed';
            failed("updating %s: Server said: '%s'", $h, $returned);
        }
    }
}

######################################################################
## nic_woima_examples
######################################################################
sub nic_woima_examples {
    return <<"EoEXAMPLE";
o 'woima'

The 'woima' protocol is used by the free
dynamic DNS service offered by woima.fi.
It offers also nameservers for own domains for free.
Dynamic DNS service for own domains is not free.

Configuration variables applicable to the 'woima' protocol are:
  protocol=woima               ##
  server=fqdn.of.service       ## defaults to dyn.woima.fi
  script=/path/to/script       ## defaults to /nic/update
  backupmx=no|yes              ## indicates that this host is the primary MX for the domain.
  static=no|yes                ## indicates that this host has a static IP address.
  custom=no|yes                ## indicates that this host is a 'custom' top-level domain name.
  mx=any.host.domain           ## a host MX'ing for this host definition.
  wildcard=no|yes              ## add a DNS wildcard CNAME record that points to {host}
  login=service-login          ## login name and password  registered with the service
  password=service-password    ##
  fully.qualified.host         ## the host registered with the service.

Example ${program}.conf file entries:
  ## single host update
  protocol=woima,                                           \\
  login=my-dyndns.org-login,                                \\
  password=my-dyndns.org-password                           \\
  myhost.dyndns.org

  ## multiple host update with wildcard'ing mx, and backupmx
  protocol=woima,                                           \\
  login=my-dyndns.org-login,                                \\
  password=my-dyndns.org-password,                          \\
  mx=a.host.willing.to.mx.for.me,backupmx=yes,wildcard=yes  \\
  myhost.dyndns.org,my2ndhost.dyndns.org

  ## multiple host update to the custom DNS service
  protocol=woima,                                           \\
  login=my-dyndns.org-login,                                \\
  password=my-dyndns.org-password                           \\
  my-toplevel-domain.com,my-other-domain.com
EoEXAMPLE
}
######################################################################
## nic_woima_update
######################################################################
sub nic_woima_update {
    debug("\nnic_woima_update -------------------");

    my %errors = (
        'badauth'  => 'Bad authorization (username or password)',
        'badsys'   => 'The system parameter given was not valid',

        'notfqdn'  => 'A Fully-Qualified Domain Name was not provided',
        'nohost'   => 'The hostname specified does not exist in the database',
        '!yours'   => 'The hostname specified exists, but not under the username currently being used',
        '!donator' => 'The offline setting was set, when the user is not a donator',
        '!active'  => 'The hostname specified is in a Custom DNS domain which has not yet been activated.',
        'abuse',   => 'The hostname specified is blocked for abuse; you should receive an email notification ' .
                      'which provides an unblock request link.  More info can be found on ' .
                      'https://www.dyndns.com/support/abuse.html',

        'numhost'  => 'System error: Too many or too few hosts found. Contact support@dyndns.org',
        'dnserr'   => 'System error: DNS error encountered. Contact support@dyndns.org',

        'nochg'    => 'No update required; unnecessary attempts to change to the current address are considered abusive',
    );

    for my $h (@_) {
        my $ip = $config{$h}{'wantip'};
        delete $config{$h}{'wantip'};

        info("setting IP address to %s for %s", $ip, $h);
        verbose("UPDATE:", "updating %s", $h);

        ## Select the DynDNS system to update
        my $url = "http://$config{$h}{'server'}$config{$h}{'script'}?system=";
        if ($config{$h}{'custom'}) {
            warning("updating %s: 'custom' and 'static' may not be used together. ('static' ignored)", $h)
                if $config{$h}{'static'};
            $url .= 'custom';

        } elsif ($config{$h}{'static'}) {
            $url .= 'statdns';

        } else {
            $url .= 'dyndns';
        }

        $url .= "&hostname=$h";
        $url .= "&myip=";
        $url .= $ip            if $ip;

        ## some args are not valid for a custom domain.
        $url .= "&wildcard=ON" if ynu($config{$h}{'wildcard'}, 1, 0, 0);
        if ($config{$h}{'mx'}) {
            $url .= "&mx=$config{$h}{'mx'}";
            $url .= "&backmx=" . ynu($config{$h}{'backupmx'}, 'YES', 'NO');
        }

        my $reply = geturl(
            proxy => opt('proxy'),
            url => $url,
            login => $config{$h}{'login'},
            password => $config{$h}{'password'},
        );
        if (!defined($reply) || !$reply) {
            failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
            next;
        }
        next if !header_ok($h, $reply);

        my @reply      = split /\n/, $reply;
        my $state      = 'header';
        my $returnedip = $ip;

        foreach my $line (@reply) {
            if ($state eq 'header') {
                $state = 'body';

            } elsif ($state eq 'body') {
                $state = 'results' if $line eq '';

            } elsif ($state =~ /^results/) {
                $state = 'results2';

                # bug #10: some dyndns providers does not return the IP so
                # we can't use the returned IP
                my ($status, $returnedip) = split / /, lc $line;
                $ip = $returnedip if (not $ip);

                $config{$h}{'status'} = $status;
                if ($status eq 'good') {
                    $config{$h}{'ip'}    = $ip;
                    $config{$h}{'mtime'} = $now;
                    success("updating %s: %s: IP address set to %s", $h, $status, $ip);

                } elsif (exists $errors{$status}) {
                    if ($status eq 'nochg') {
                        warning("updating %s: %s: %s", $h, $status, $errors{$status});
                        $config{$h}{'ip'}     = $ip;
                        $config{$h}{'mtime'}  = $now;
                        $config{$h}{'status'} = 'good';

                    } else {
                        failed("updating %s: %s: %s", $h, $status, $errors{$status});
                    }

                } elsif ($status =~ /w(\d+)(.)/) {
                    my ($wait, $units) = ($1, lc $2);
                    my ($sec,  $scale) = ($wait, 1);

                    ($scale, $units) = (1, 'seconds')   if $units eq 's';
                    ($scale, $units) = (60, 'minutes')  if $units eq 'm';
                    ($scale, $units) = (60*60, 'hours') if $units eq 'h';

                    $sec = $wait * $scale;
                    $config{$h}{'wtime'} = $now + $sec;
                    warning("updating %s: %s: wait %s %s before further updates", $h, $status, $wait, $units);

                } else {
                    failed("updating %s: unexpected status (%s)", $h, $line);
                }
            }
        }
        failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'})
            if $state ne 'results2';
    }
}

######################################################################
## nic_dondominio_examples
######################################################################
sub nic_dondominio_examples {
    return <<"EoEXAMPLE";
o 'dondominio'
The 'dondominio' protocol is used by DNS service offered by www.dondominio.com/ .
API information and user instructions available at: https://dev.dondominio.com/dondns/docs/api/
Configuration variables applicable to the 'dondominio' protocol are:
  protocol=dondominio          ##
  login=service-login          ## the username registered with the service
  password=dondominio-apikey   ## API key provided by dondominio -see link above-
  fully.qualified.host         ## the host registered with the service.
Example ${program}.conf file entries:
  ## single host update
  protocol=dondominio,                                   \\
  login=my-generated-user-name,                          \\
  password=dondominio-apikey                             \\
  myhost.tld

EoEXAMPLE
}

######################################################################
## nic_dondominio_examples
######################################################################

sub nic_dondominio_update {
    debug("\nnic_dondominio_update -------------------");

    ## update each configured host
    ## should improve to update in one pass
    foreach my $h (@_) {
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to %s for %s", $ip, $h);
        verbose("UPDATE:", "updating %s", $h);

        # Set the URL that we're going to update
        my $url;
        $url  = "https://$config{$h}{'server'}/plain/";
        $url .= "?user=";
        $url .= $config{$h}{'login'};
        $url .= "&password=";
        $url .= $config{$h}{'password'};
        $url .= "&host=";
        $url .= $h;
        $url .= "&ip=";
        $url .= $ip if $ip;


        # Try to get URL
        my $reply = geturl(proxy => opt('proxy'), url => $url);

        # No response, declare as failed
        if (!defined($reply) || !$reply) {
            failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
            next;
        }
        next if !header_ok($h, $reply);

        my @reply = split /\n/, $reply;
        my $returned = pop(@reply);
        if ($returned =~ /OK/) {
            $config{$h}{'ip'}     = $ip;
            $config{$h}{'mtime'}  = $now;
            $config{$h}{'status'} = 'good';
            success("updating %s: good: IP address set to %s", $h, $ip);
        } else {
            $config{$h}{'status'} = 'failed';
            failed("updating %s: Server said: '%s'", $h, $returned);
        }
    }
}

######################################################################
## nic_dnsmadeeasy_examples
######################################################################
sub nic_dnsmadeeasy_examples {
    return <<"EoEXAMPLE";
o 'dnsmadeeasy'

The 'dnsmadeeasy' protocol is used by the DNS Made Easy service at https://www.dnsmadeeasy.com.
API is documented here: https://dnsmadeeasy.com/technology/dynamic-dns/

Configuration variables applicable to the 'dnsmadeeasy' protocol are:
  protocol=dnsmadeeasy               ##
  login=email-address                ## Email address used to log in to your account.
  password=dynamic-record-password   ## Generated password for your dynamic DNS record.
  record-id-1,record-id-2,...        ## Numeric dynamic DNS record IDs, comma-separated if updating multiple.

Note: Dynamic record ID is generated when you create a new Dynamic DNS record in the DNS Made Easy control panel.

Example ${program}.conf file entries:
  ## single host update
  protocol=dnsmadeeasy,              \\
  username=dme\@example.com,         \\
  password=myg3nerat3dp4ssword,      \\
  1007,1008

EoEXAMPLE
}

######################################################################
## nic_dnsmadeeasy_update
######################################################################
sub nic_dnsmadeeasy_update {
    debug("\nnic_dnsmadeeasy_update -------------------");

    my %messages = (
        'error-auth' => 'Invalid username or password, or invalid IP syntax',
        'error-auth-suspend' => 'User has had their account suspended due to complaints or misuse of the service.',
        'error-auth-voided' => 'User has had their account permanently revoked.',
        'error-record-invalid' =>'Record ID number does not exist in the system.',
        'error-record-auth' => 'User does not have access to this record.',
        'error-record-ip-same' => 'No update required.',
        'error-system' => 'General system error which is caught and recognized by the system.',
        'error' => 'General system error unrecognized by the system.',
        'success' => 'Record successfully updated!',
    );

    ## update each configured host
    ## should improve to update in one pass
    foreach my $h (@_) {
        my $ip = delete $config{$h}{'wantip'};
        info("Setting IP address to %s for %s", $ip, $h);
        verbose("UPDATE:", "Updating %s", $h);

        # Set the URL that we're going to to update
        my $url;
        $url  = $globals{'ssl'} ? "https://" : "http://";
        $url .= $config{$h}{'server'} . $config{$h}{'script'};
        $url .= "?username=$config{$h}{'login'}";
        $url .= "&password=$config{$h}{'password'}";
        $url .= "&ip=$ip";
        $url .= "&id=$h";

        # Try to get URL
        my $reply = geturl(proxy => opt('proxy'), url => $url);

        # No response, declare as failed
        if (!defined($reply) || !$reply) {
            failed("Updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
            next;
        }
        next if !header_ok($h, $reply);

        my @reply = split /\n/, $reply;
        my $returned = pop(@reply);
        if ($returned =~ 'success') {
            $config{$h}{'ip'}     = $ip;
            $config{$h}{'mtime'}  = $now;
            $config{$h}{'status'} = 'good';
            success("Updating %s: good: IP address set to %s", $h, $ip);
        } else {
            $config{$h}{'status'} = 'failed';
            failed("Updating %s: Server said: '%s': %s", $h, $returned, $messages{$returned});
        }
    }
}

######################################################################
## nic_ovh_examples
######################################################################
sub nic_ovh_examples {
    return <<"EoEXAMPLE";

o 'ovh'

The 'ovh' protocol is used by DNS services offered by www.ovh.com.

API information and user instructions available at: https://docs.ovh.com/gb/en/domains/hosting_dynhost/

Configuration variables applicable to the 'ovh' protocol are:
  protocol=ovh                 ##
  login=dnsdomain-userid       ## The username/id registered with the service
  password=userid-password     ## The password related to the username/id
  fully.qualified.host         ## the hostiname registered with the service.

Example ${program}.conf file entries:
  ## single host update
  protocol=ovh,                   \\
  login=example.com-dynhostuser,  \\
  password=your_password,         \\
  test.example.com

EoEXAMPLE
}

######################################################################
## nic_ovh_update
######################################################################
sub nic_ovh_update {
    debug("\nnic_ovh_update -------------------");

    ## update each configured host
    ## should improve to update in one pass
    foreach my $h (@_) {
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to %s for %s", $ip, $h);
        verbose("UPDATE:","updating %s", $h);

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

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

        if (!defined($reply) || !$reply) {
            failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});
            next;
        }

        my @reply = split /\n/, $reply;
        my $returned = pop(@reply);
        if ($returned =~ /good/ || $returned =~ /nochg/) {
            $config{$h}{'ip'}     = $ip;
            $config{$h}{'mtime'}  = $now;
            $config{$h}{'status'} = 'good';
            if ($returned =~ /good/) {
                success("updating %s: good: IP address set to %s", $h, $ip);
            } else {
                success("updating %s: skipped: IP address was already set to %s.", $h, $ip);
            }
        } else {
            $config{$h}{'status'} = 'failed';
            failed("updating %s: Server said: '%s'", $h, $returned);
        }
    }
}

sub nic_cloudns_examples {
    return <<"EoEXAMPLE";
o 'cloudns'

The 'cloudns' protocol is used for ClouDNS (https://www.cloudns.net).  Details
about dynamic DNS updates can be found at https://www.cloudns.net/dynamic-dns/.

Available configuration variables:
  * dynurl: The DynURL associated with the A or AAAA record you wish to update.

Limitations:
  * $program cannot tell if the DynURL you provide belongs to the hostname you
    specify.
  * ClouDNS does not document how to tell whether an update suceeded or failed,
    so there is no way for $program to reliably handle failures.
  * The ClouDNS API does not provide a reliable way to set the desired IP
    address. It might save the IP address you want, or it might save the IP
    address that connects to CloudDNS. It is more likely to work if you do not
    use a proxy.

Example ${program}.conf file entry:
  protocol=cloudns,                                                        \\
  dynurl=https://ipv4.cloudns.net/api/dynamicURL/?q=Njc1OTE2OjY3Njk0ND..., \\
  myhost.example.com
EoEXAMPLE
}

sub nic_cloudns_update {
    my %groups = group_hosts_by([ @_ ], [ qw(dynurl) ]);
    for my $hr (values(%groups)) {
        my @hosts = @$hr;
        my $hosts = join(',', @hosts);
        my $ip = $config{$hosts[0]}{'wantip'};
        my $dynurl = $config{$hosts[0]}{'dynurl'};
        delete $config{$_}{'wantip'} for @hosts;
        # https://www.cloudns.net/wiki/article/36/ says, "If you are behind a proxy and your real
        # IP is set in the header X-Forwarded-For you need to add &proxy=1 at the end of the
        # DynamicURL." We abuse this to pass the desired IP address to ClouDNS, which might not be
        # the same as the client IP address seen by ClouDNS.
        my $reply = geturl(
            proxy => opt('proxy'),
            url => $dynurl . '&proxy=1',
            headers => "X-Forwarded-For: $ip\n",
        );
        if (($reply // '') eq '' || !header_ok($hosts, $reply)) {
            $config{$_}{'status'} = 'failed' for @hosts;
            failed("updating %s: failed to visit DynURL", $hosts);
            next;
        }
        $reply =~ s/^.*?\n\n//s;  # Strip the headers.
        chomp($reply);
        if ($reply eq "The record's key is wrong!" || $reply eq "Invalid request.") {
            $config{$_}{'status'} = 'failed' for @hosts;
            failed("updating %s: %s", $hosts, $reply);
            next;
        }
        # There's no documentation explaining possible return values, so we assume success.
        $config{$_}{'ip'} = $ip for @hosts;
        $config{$_}{'mtime'} = $now for @hosts;
        $config{$_}{'status'} = 'good' for @hosts;
        success("updating %s: IP address set to %s", $hosts, $ip);
    }
}

######################################################################
## nic_dinahosting_examples
######################################################################
sub nic_dinahosting_examples {
    return <<"EoEXAMPLE";
o 'dinahosting'

The 'dinahosting' protocol is used by dinahosting (https://dinahosting.com).
Details about the API can be found at https://dinahosting.com/api.

Available configuration variables and their defaults:
  * login (required) is your username.
  * password (required) is your password.
  * server=dinahosting.com is the hostname part of the dinahosting API URL.
  * script=/special/api.php is the path part of the dinahosting API URL.

Example ${program}.conf file entry:
  protocol=dinahosting,  \\
  login=myusername,      \\
  password=mypassword    \\
  myhost.mydomain.com
EoEXAMPLE
}

######################################################################
## nic_dinahosting_update
######################################################################
sub nic_dinahosting_update {
    debug("\nnic_dinahosting_update -------------------");
    for my $h (@_) {
        my $ip = delete $config{$h}{'wantip'};
        info("setting IP address to %s for %s", $ip, $h);
        verbose("UPDATE:", "updating %s", $h);
        my ($hostname, $domain) = split(/\./, $h, 2);
        my $url = "https://$config{$h}{'server'}$config{$h}{'script'}";
        $url .= "?hostname=$hostname";
        $url .= "&domain=$domain";
        $url .= "&command=Domain_Zone_UpdateType" . is_ipv6($ip) ? 'AAAA' : 'A';
        $url .= "&ip=$ip";
        my $reply = geturl(
            proxy => opt('proxy'),
            login => $config{$h}{'login'},
            password => $config{$h}{'password'},
            url => $url,
        );
        $config{$h}{'status'} = 'failed';  # assume failure until otherwise determined
        if (!$reply) {
            failed("updating %s: failed to visit URL %s", $h, $url);
            next;
        }
        next if !header_ok($h, $reply);
        $reply =~ s/^.*?\n\n//s;  # Strip the headers.
        if ($reply !~ /Success/i) {
            $reply =~ /^responseCode = (\d+)$/m;
            my $code = $1 // '<undefined>';
            $reply =~ /^errors_0_message = '(.*)'$/m;
            my $message = $1 // '<undefined>';
            failed("updating %s: error %d: %s", $code, $message);
            next;
        }
        $config{$h}{'ip'}     = $ip;
        $config{$h}{'mtime'}  = $now;
        $config{$h}{'status'} = 'good';
        success("updating %s: IP address set to %s", $h, $ip);
    }
}

######################################################################
## nic_gandi_examples
## by Jimmy Thrasibule <dev@jimmy.lt>
######################################################################
sub nic_gandi_examples {
    return <<"EoEXAMPLE";
o 'gandi'

The 'gandi' protocol is used by the LiveDNS service offered by gandi.net.
Description of Gandi's LiveDNS API can be found at:

    https://api.gandi.net/docs/livedns/

Available configuration variables:
  * password: The Gandi API key. If you don’t have one yet, you can generate
    your production API key from the API Key Page (in the Security section).
    Required.
  * 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 (3h) if unset.

Example ${program}.conf file entries:
  ## Single host update.
  protocol=gandi,                           \\
  zone=example.com,                         \\
  password=my-gandi-api-key,                \\
  host.example.com

  ## Multiple host update.
  protocol=gandi,                           \\
  zone=example.com,                         \\
  password=my-gandi-api-key,                \\
  ttl=1h                                    \\
  hosta.example.com,hostb.sub.example.com
EoEXAMPLE
}

######################################################################
## nic_gandi_update
######################################################################
sub nic_gandi_update {
    debug("\nnic_gandi_update -------------------");

    # Update each set configured host.
    foreach my $h (@_) {
        my $ip = delete $config{$h}{'wantip'};
        (my $hostname = $h) =~ s/\.\Q$config{$h}{zone}\E$//;

        info("%s -- Setting IP address to %s.", $h, $ip);
        verbose("UPDATE:", "updating %s", $h);

        my $headers;
        $headers  = "Content-Type: application/json\n";
        $headers .= "Authorization: Apikey $config{$h}{'password'}\n";

        my $data = encode_json({
            defined($config{$h}{'ttl'}) ? (rrset_ttl => $config{$h}{'ttl'}) : (),
            rrset_values => [$ip],
        });

        my $rrset_type = is_ipv6($ip) ? "AAAA" : "A";
        my $url;
        $url  = "https://$config{$h}{'server'}$config{$h}{'script'}";
        $url .= "/livedns/domains/$config{$h}{'zone'}/records/$hostname/$rrset_type";

        my $reply = geturl({
            proxy   => opt('proxy'),
            url     => $url,
            headers => $headers,
            method  => 'PUT',
            data    => $data,
        });
        unless ($reply) {
            failed("%s -- Could not connect to %s.", $h, $config{$h}{'server'});
            next;
        }
        my $ok = header_ok($h, $reply);

        $reply =~ s/^.*?\n\n//s;
        my $response = eval { decode_json($reply) };
        if (!defined($response)) {
            $config{$h}{'status'} = "bad";

            failed("%s -- Unexpected service response.", $h);
            next;
        }

        if ($ok) {
            $config{$h}{'ip'}     = $ip;
            $config{$h}{'mtime'}  = $now;
            $config{$h}{'status'} = "good";

            success("%s -- Updated successfully to %s.", $h, $ip);
        } else {
            $config{$h}{'status'} = "bad";

            if (defined($response->{status}) && $response->{status} eq "error") {
                my @errors;
                for my $err (@{$response->{errors}}) {
                    push(@errors, $err->{description});
                }
                failed("%s -- %s.", $h, join(", ", @errors));
            } else {
                failed("%s -- Unexpected service response.", $h);
            }
        }
    }
}

# 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__