diff --git a/.autom4te.cfg b/.autom4te.cfg new file mode 100644 index 000000000..2e235ff74 --- /dev/null +++ b/.autom4te.cfg @@ -0,0 +1,6 @@ +# Disable autom4te cache to ensure that any change to ddclient.in triggers a +# rebuild of the configure script (which gets the version of ddclient from +# ddclient.in). See . +begin-language: "Autoconf-without-aclocal-m4" +args: --no-cache +end-language: "Autoconf-without-aclocal-m4" diff --git a/.envrc b/.envrc new file mode 100644 index 000000000..d83cf80c3 --- /dev/null +++ b/.envrc @@ -0,0 +1,5 @@ +if has lorri; then + eval "$(lorri direnv)" +else + use nix +fi diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index ebe4d0d34..0b5139cc8 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -1,20 +1,16 @@ ---- name: CI on: push: - branches: - - master pull_request: - branches: - - master jobs: test-debian-like: strategy: + fail-fast: false matrix: image: - ubuntu:latest - - ubuntu:16.04 + - ubuntu:20.04 - debian:testing - debian:stable - debian:oldstable @@ -29,19 +25,19 @@ jobs: automake \ ca-certificates \ git \ + curl \ libhttp-daemon-perl \ libhttp-daemon-ssl-perl \ - libio-socket-inet6-perl \ - libio-socket-ip-perl \ libplack-perl \ libtest-mockmodule-perl \ libtest-tcp-perl \ libtest-warnings-perl \ liburi-perl \ + libwww-perl \ net-tools \ make \ ; - - uses: actions/checkout@v2 + - uses: actions/checkout@v4 - name: autogen run: ./autogen - name: configure @@ -52,64 +48,47 @@ jobs: run: make VERBOSE=1 AM_COLOR_TESTS=always distcheck - name: distribution tarball is complete run: ./.github/workflows/scripts/dist-tarball-check + - if: ${{ matrix.image == 'debian:testing' }} + uses: actions/upload-artifact@v4 + with: + name: distribution-tarball + path: ddclient-*.tar.gz - #test-centos6: - # runs-on: ubuntu-latest - # container: centos:6 - # steps: - # - uses: actions/checkout@v1 - # - name: install dependencies - # run: | - # yum install -y \ - # automake \ - # perl-IO-Socket-INET6 \ - # perl-core \ - # perl-libwww-perl \ - # ; - # - name: autogen - # run: ./autogen - # - name: configure - # run: ./configure - # - name: check - # run: make VERBOSE=1 AM_COLOR_TESTS=always check - # - name: distcheck - # run: make VERBOSE=1 AM_COLOR_TESTS=always distcheck - - #test-centos8: - # runs-on: ubuntu-latest - # container: centos:8 - # steps: - # - uses: actions/checkout@v2 - # - name: install dependencies - # run: | - # dnf --refresh --enablerepo=PowerTools install -y \ - # automake \ - # make \ - # perl-HTTP-Daemon \ - # perl-IO-Socket-INET6 \ - # perl-Test-Warnings \ - # perl-core \ - # ; - # - name: autogen - # run: ./autogen - # - name: configure - # run: ./configure - # - name: check - # run: make VERBOSE=1 AM_COLOR_TESTS=always check - # - name: distcheck - # run: make VERBOSE=1 AM_COLOR_TESTS=always distcheck - - test-fedora: + test-fedora-like: + strategy: + fail-fast: false + matrix: + image: + - fedora:39 + - fedora:latest + - fedora:rawhide + - almalinux:8 + - almalinux:latest runs-on: ubuntu-latest - container: fedora + container: + image: ${{ matrix.image }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v4 + - name: enable repositories (AlmaLinux 8) + if: ${{ matrix.image == 'almalinux:8' }} + run: | + dnf --refresh install -y 'dnf-command(config-manager)' epel-release && + dnf config-manager --set-enabled powertools + - name: enable repositories (AlmaLinux latest) + if: ${{ matrix.image == 'almalinux:latest' }} + run: | + dnf --refresh install -y 'dnf-command(config-manager)' epel-release && + dnf config-manager --set-enabled crb - name: install dependencies + # The --skip-broken argument works around missing packages. (They're + # only used for testing, so it's OK to not install them.) run: | - dnf --refresh install -y \ + dnf --refresh install --skip-broken -y \ automake \ findutils \ + iproute \ make \ + curl \ perl \ perl-HTTP-Daemon \ perl-HTTP-Daemon-SSL \ @@ -118,33 +97,9 @@ jobs: perl-Test-MockModule \ perl-Test-TCP \ perl-Test-Warnings \ - net-tools \ - ; - - name: autogen - run: ./autogen - - name: configure - run: ./configure - - name: check - run: make VERBOSE=1 AM_COLOR_TESTS=always check - - name: distcheck - run: make VERBOSE=1 AM_COLOR_TESTS=always distcheck - - test-redhat-ubi7: - runs-on: ubuntu-latest - # we use redhats univeral base image which is not available on docker hub - # https://catalog.redhat.com/software/containers/ubi7/ubi/5c3592dcd70cc534b3a37814 - container: registry.access.redhat.com/ubi7/ubi - steps: - - uses: actions/checkout@v2 - - name: install dependencies - run: | - yum install -y \ - automake \ - make \ - perl-HTTP-Daemon \ - perl-IO-Socket-INET6 \ perl-core \ - iproute \ + perl-libwww-perl \ + net-tools \ ; - name: autogen run: ./autogen diff --git a/.github/workflows/pr.yml b/.github/workflows/pr.yml new file mode 100644 index 000000000..b4a77293a --- /dev/null +++ b/.github/workflows/pr.yml @@ -0,0 +1,49 @@ +name: Pull Request +on: + pull_request: + types: + - labeled + - opened + - reopened + - synchronize + - unlabeled + +jobs: + linear-history: + if: ${{ !contains(github.event.pull_request.labels.*.name, 'pr-permit-nonlinear') }} + name: Linear History + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + with: + fetch-depth: 0 + - name: No new merge commits + run: | + log() { printf %s\\n "$*" >&2; } + error() { log "ERROR: $@"; } + fatal() { error "$@"; exit 1; } + try() { log "Running command $@"; "$@" || fatal "'$@' failed"; } + out=$(try git rev-list -n 1 --merges '${{ github.event.pull_request.base.sha }}..${{ github.event.pull_request.head.sha }}') || exit 1 + [ -z "${out}" ] || { + error "pull request includes a merge commit and does not have the 'pr-permit-nonlinear' label" + git show "${out}" >&2 + exit 1 + } + no-autosquash: + if: ${{ !contains(github.event.pull_request.labels.*.name, 'pr-permit-autosquash') }} + name: No --autosquash commits + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + with: + fetch-depth: 0 + - name: 'No commits with messages starting with "fixup!", "squash!", or "amend!"' + run: | + log() { printf %s\\n "$*" >&2; } + error() { log "ERROR: $@"; } + fatal() { error "$@"; exit 1; } + try() { log "Running command $@"; "$@" || fatal "'$@' failed"; } + out=$(try git log --oneline '${{ github.event.pull_request.base.sha }}..${{ github.event.pull_request.head.sha }}') || exit 1 + ! grep -E '^[^ ]* (fixup|squash|amend)!' <'$@'.tmp && \ + sed \ + -e 's|@PACKAGE_VERSION[@]|$(PACKAGE_VERSION)|g' \ + -e '1 s|^#\!.*perl$$|#\!$(PERL)|g' \ + -e 's|@localstatedir[@]|$(localstatedir)|g' \ + -e 's|@confdir[@]|$(confdir)|g' \ + -e 's|@runstatedir[@]|$(runstatedir)|g' \ + -e 's|@CURL[@]|$(CURL)|g' \ + "$${in}" >'$@'.tmp && \ { ! test -x "$${in}" || chmod +x '$@'.tmp; } mv '$@'.tmp '$@' @@ -54,7 +40,7 @@ ddclient.conf: $(srcdir)/ddclient.conf.in bin_SCRIPTS = ddclient -sysconf_DATA = ddclient.conf +conf_DATA = ddclient.conf install-data-local: $(MKDIR_P) '$(DESTDIR)$(localstatedir)'/cache/ddclient @@ -71,18 +57,36 @@ AM_PL_LOG_FLAGS = -Mstrict -w \ -I'$(abs_top_srcdir)'/t/lib \ -MDevel::Autoflush handwritten_tests = \ + t/builtinfw_query.pl \ + t/check_value.pl \ t/get_ip_from_if.pl \ - t/geturl_ssl.pl \ + t/geturl_connectivity.pl \ + t/geturl_response.pl \ + t/group_hosts_by.pl \ + t/header_ok.pl \ + t/interval_expired.pl \ t/is-and-extract-ipv4.pl \ t/is-and-extract-ipv6.pl \ t/is-and-extract-ipv6-global.pl \ + t/logmsg.pl \ t/parse_assignments.pl \ - t/write_cache.pl + t/protocol_directnic.pl \ + t/protocol_dnsexit2.pl \ + t/protocol_dyndns2.pl \ + t/read_recap.pl \ + t/skip.pl \ + t/ssl-validate.pl \ + t/update_nics.pl \ + t/use_cmd.pl \ + t/use_web.pl \ + t/variable_defaults.pl \ + t/write_recap.pl generated_tests = \ - t/geturl_connectivity.pl \ t/version.pl TESTS = $(handwritten_tests) $(generated_tests) +$(TESTS): ddclient EXTRA_DIST += $(handwritten_tests) \ + .autom4te.cfg \ t/lib/Devel/Autoflush.pm \ t/lib/Test/Builder.pm \ t/lib/Test/Builder/Formatter.pm \ @@ -153,5 +157,9 @@ EXTRA_DIST += $(handwritten_tests) \ t/lib/ddclient/Test/Fake/HTTPD/dummy-ca-cert.pem \ t/lib/ddclient/Test/Fake/HTTPD/dummy-server-cert.pem \ t/lib/ddclient/Test/Fake/HTTPD/dummy-server-key.pem \ + t/lib/ddclient/Test/Fake/HTTPD/other-ca-cert.pem \ t/lib/ddclient/t.pm \ + t/lib/ddclient/t/HTTPD.pm \ + t/lib/ddclient/t/Logger.pm \ + t/lib/ddclient/t/ip.pm \ t/lib/ok.pm diff --git a/README.md b/README.md index e39292f5a..7eef76e4a 100644 --- a/README.md +++ b/README.md @@ -1,55 +1,71 @@ -=============================================================================== -# DDCLIENT v3.9.1 +# DDCLIENT -ddclient is a Perl client used to update dynamic DNS entries for accounts -on many dynamic DNS services. +`ddclient` is a Perl client used to update dynamic DNS entries for accounts +on many dynamic DNS services. It uses `curl` for internet access. -=============================================================================== +## Alternatives + +You might also want to consider using one of the following, if they support +your dynamic DNS provider(s): or +. + +## Supported services Dynamic DNS services currently supported include: - DynDNS.com - See http://www.dyndns.com for details on obtaining a free account. - Zoneedit - See http://www.zoneedit.com for details. - EasyDNS - See http://www.easydns.com for details. - NameCheap - See http://www.namecheap.com for details - DslReports - See http://www.dslreports.com for details - Sitelutions - See http://www.sitelutions.com for details - Loopia - See http://www.loopia.se for details - Noip - See http://www.noip.com/ for details - Freedns - See http://freedns.afraid.org/ for details - ChangeIP - See http://www.changeip.com/ for details - nsupdate - See nsupdate(1) and ddns-confgen(8) for details - CloudFlare - See https://www.cloudflare.com/ for details - Google - See http://www.google.com/domains for details - Duckdns - See https://duckdns.org/ for details - Freemyip - See https://freemyip.com for details - woima.fi - See https://woima.fi/ for details - Yandex - See https://domain.yandex.com/ for details - DNS Made Easy - See https://dnsmadeeasy.com/ for details - DonDominio - See https://www.dondominio.com for details - NearlyFreeSpeech.net - See https://www.nearlyfreespeech.net/services/dns for details - OVH - See https://www.ovh.com for details - ClouDNS - See https://www.cloudns.net - dinahosting - See https://dinahosting.com - Gandi - See https://gandi.net - dnsexit - See https://dnsexit.com/ for details - -DDclient now supports many of cable/dsl broadband routers. - -Comments, suggestions and requests: use the issues on https://github.com/ddclient/ddclient/issues/new - -The code was originally written by Paul Burry and is now hosted and maintained -through github.com. Please check out http://ddclient.net - -------------------------------------------------------------------------------- + * [1984.is](https://www.1984.is/product/freedns) + * [ChangeIP](https://www.changeip.com) + * [CloudFlare](https://www.cloudflare.com) + * [ClouDNS](https://www.cloudns.net) + * [DDNS.fm](https://www.ddns.fm/) + * [DigitalOcean](https://www.digitalocean.com/) + * [dinahosting](https://dinahosting.com) + * [Directnic](https://directnic.com) + * [DonDominio](https://www.dondominio.com) + * [DNS Made Easy](https://dnsmadeeasy.com) + * [DNSExit](https://dnsexit.com/dns/dns-api) + * [dnsHome.de](https://www.dnshome.de) + * [Domeneshop](https://api.domeneshop.no/docs/#tag/ddns/paths/~1dyndns~1update/get) + * [DslReports](https://www.dslreports.com) + * [Duck DNS](https://duckdns.org) + * [DynDNS.com](https://account.dyn.com) + * [EasyDNS](https://www.easydns.com ) + * [Enom](https://www.enom.com) + * [Freedns](https://freedns.afraid.org) + * [Freemyip](https://freemyip.com) + * [Gandi](https://gandi.net) + * [GoDaddy](https://www.godaddy.com) + * [Hurricane Electric](https://dns.he.net) + * [Infomaniak](https://faq.infomaniak.com/2376) + * [INWX](https://www.inwx.com/) + * [Loopia](https://www.loopia.se) + * [Mythic Beasts](https://www.mythic-beasts.com/support/api/dnsv2/dynamic-dns) + * [NameCheap](https://www.namecheap.com) + * [NearlyFreeSpeech.net](https://www.nearlyfreespeech.net/services/dns) + * [Njalla](https://njal.la/docs/ddns) + * [Noip](https://www.noip.com) + * nsupdate - see nsupdate(1) and ddns-confgen(8) + * [OVH](https://www.ovhcloud.com) + * [Porkbun](https://porkbun.com) + * [regfish.de](https://www.regfish.de/domains/dyndns) + * [Sitelutions](https://www.sitelutions.com) + * [Yandex](https://dns.yandex.com) + * [Zoneedit](https://www.zoneedit.com) + +`ddclient` supports finding your IP address from many cable and DSL +broadband routers. + +Comments, suggestions and requests: please file an issue at +https://github.com/ddclient/ddclient/issues/new + +The code was originally written by Paul Burry and is now hosted and +maintained through github.com. Please check out https://ddclient.net ## REQUIREMENTS * An account from a supported dynamic DNS service provider * Perl v5.10.1 or later - * `IO::Socket::SSL` perl library for ssl-support * `JSON::PP` perl library for JSON support - * `IO::Socket:INET6` perl library for ipv6-support * Linux, macOS, or any other Unix-ish system * An implementation of `make` (such as [GNU Make](https://www.gnu.org/software/make/)) @@ -69,8 +85,7 @@ See https://github.com/ddclient/ddclient/releases Packaging status The easiest way to install ddclient is to install a package offered by your -operating system. See the image to the right for a list of distributions with a -ddclient package. +operating system. See the image to the right for a list of distributions with a ddclient package. ### Manual Installation @@ -78,8 +93,8 @@ ddclient package. the directory: ```shell - tar xvfa ddclient-3.9.1.tar.gz - cd ddclient-3.9.1 + tar xvfa ddclient-3.XX.X.tar.gz + cd ddclient-3.XX.X ``` (If you are installing from a clone of the Git repository, you @@ -90,7 +105,7 @@ ddclient package. ```shell ./configure \ --prefix=/usr \ - --sysconfdir=/etc/ddclient \ + --sysconfdir=/etc \ --localstatedir=/var make make VERBOSE=1 check @@ -111,125 +126,99 @@ start the first time by hand systemctl start ddclient.service -#### Redhat style rc files and daemon-mode - - cp sample-etc_rc.d_init.d_ddclient /etc/rc.d/init.d/ddclient - -enable automatic startup when booting. also check your distribution - - /sbin/chkconfig --add ddclient - -start the first time by hand - - /etc/rc.d/init.d/ddclient start - -#### Alpine style rc files and daemon-mode - - cp sample-etc_rc.d_init.d_ddclient.alpine /etc/init.d/ddclient - -enable automatic startup when booting - - rc-update add ddclient - -make sure you have perl installed - - apk add perl - -start the first time by hand - - rc-service ddclient start - -#### Ubuntu style rc files and daemon-mode +## Known issues +This is a list for quick referencing of known issues. For further details check out the linked issues and the changelog. - cp sample-etc_rc.d_init.d_ddclient.ubuntu /etc/init.d/ddclient +Note that any issues prior to version v3.9.1 will not be listed here. +If a fix is committed but not yet part of any tagged release, the notes here will reference the not-yet-released version number. -enable automatic startup when booting - - update-rc.d ddclient defaults - -make sure you have perl and the required modules installed - - apt-get install perl libdata-validate-ip-perl libio-socket-ssl-perl - -if you plan to use cloudflare or feedns you need the perl json module +### v3.11.2 - v3.9.1: SSL parameter breaks HTTP-only IP acquisition - apt-get install libjson-pp-perl +The `ssl` parameter forces all connections to use HTTPS. While technically +working as expected, this behavior keeps coming up as a pain point when using +HTTP-only IP querying sites such as http://checkip.dyndns.org. Starting with +v4.0.0, the behavior is changed to respect `http://` in a URL. A separate +parameter to disallow all HTTP connections or warn about them may be added +later. -for IPv6 you also need to instal the perl io-socker-inet6 module +**Fix**: v4.0.0 uses HTTP to connect to URLs starting with `http://`. See +[here](https://github.com/ddclient/ddclient/pull/608) for more info. - apt install libio-socket-inet6-perl +**Workaround**: Disable the SSL parameter -start the first time by hand - - service ddclient start - -#### FreeBSD style rc files and daemon mode +### v3.10.0: Chunked encoding not corretly supported in IO::Socket HTTP code +Using the IO::Socket HTTP code will break in various ways whenever the server responds using HTTP 1.1 chunked encoding. Refer to [this issue](https://github.com/ddclient/ddclient/issues/548) for more info. - mkdir -p /usr/local/etc/rc.d - cp sample-etc_rc.d_ddclient.freebsd /usr/local/etc/rc.d/ddclient - -enable automatic startup when booting +**Fix**: v3.11.0 - IO::Socket has been deprecated there and curl has been made the standard. - sysrc ddclient_enable=YES +**Workaround**: Use curl for transfers by either setting `-curl` in the command line or by adding `curl=yes` in the config -make sure you have perl and the required modules installed +### v3.10.0: Spammed updates to some providers +This issue arises when using the `use` parameter in the config and using one of these providers: +- Cloudflare +- Hetzner +- Digitalocean +- Infomaniak - pkg install perl5 p5-Data-Validate-IP p5-IO-Socket-SSL +**Fix**: v3.11.2 -if you plan to use cloudflare or feedns you need the perl json module +**Workaround**: Use the `usev4`/`usev6` parameters instead of `use`. - pkg install p5-JSON-PP -start the service manually for the first time - - service ddclient start - - -If you are not using daemon-mode, configure cron and dhcp or ppp as described below. +## TROUBLESHOOTING -------------------------------------------------------------------------------- + * Enable debugging and verbose messages: `ddclient --daemon=0 --debug --verbose` -## TROUBLESHOOTING + * Do you need to specify a proxy? + If so, just add a `proxy=your.isp.proxy` to the `ddclient.conf` file. - 1. enable debugging and verbose messages: ``$ ddclient -daemon=0 -debug -verbose -noquiet`` + * Define the IP address of your router with `fwv4=xxx.xxx.xxx.xxx` in + `/etc/ddclient/ddclient.conf` and then try `$ ddclient --daemon=0 --query` + to see if the router status web page can be understood. - 2. Do you need to specify a proxy? - If so, just add a ``proxy=your.isp.proxy`` to the ddclient.conf file. + * Need support for another router/firewall? + Define the router yourself with: - 3. Define the IP address of your router with ``fw=xxx.xxx.xxx.xxx`` in - ``/etc/ddclient/ddclient.conf`` and then try ``$ ddclient -daemon=0 -query`` to see if the router status web page can be understood. + ``` + usev4=fwv4 + fwv4=url-to-your-router-status-page + fwv4-skip="regular expression matching any string preceding your IP address, if necessary" + ``` - 4. Need support for another router/firewall? - Define the router status page yourself with: ``fw=url-to-your-router``'s-status-page ``fw-skip=any-string-preceding-your-IP-address`` + ddclient does something like this to provide builtin support for common + routers. + For example, the Linksys routers could have been added with: - ddclient does something like this to provide builtin support for - common routers. - For example, the Linksys routers could have been added with: + ``` + usev4=fwv4 + fwv4=192.168.1.1/Status.htm + fwv4-skip=WAN.*?IP Address + ``` - fw=192.168.1.1/Status.htm - fw-skip=WAN.*?IP Address + OR [create a new issue](https://github.com/ddclient/ddclient/issues/new) + containing the output from: -OR - Send me the output from: - ``$ ddclient -geturl {fw-ip-status-url} [-login login [-password password]]`` - and I'll add it to the next release! + ``` + curl --include --location http://url.of.your.firewall/ip-status-page + ``` -ie. for my fw/router I used: ``$ ddclient -geturl 192.168.1.254/status.htm`` + so that we can add a new firewall definition to a future release of + ddclient. - 5. Some broadband routers require the use of a password when ddclient - accesses its status page to determine the router's WAN IP address. - If this is the case for your router, add + * Some broadband routers require the use of a password when ddclient accesses + its status page to determine the router's WAN IP address. + If this is the case for your router, add + ``` fw-login=your-router-login fw-password=your-router-password + ``` -to the beginning of your ddclient.conf file. -Note that some routers use either 'root' or 'admin' as their login -while some others accept anything. + to the beginning of your ddclient.conf file. + Note that some routers use either 'root' or 'admin' as their login while + some others accept anything. -------------------------------------------------------------------------------- - -## USING DDCLIENT WITH ppp +## USING DDCLIENT WITH `ppp` If you are using a ppp connection, you can easily update your DynDNS entry with each connection, with: @@ -240,9 +229,7 @@ entry with each connection, with: Alternatively, you may just configure ddclient to operate as a daemon and monitor your ppp interface. -------------------------------------------------------------------------------- - -## USING DDCLIENT WITH cron +## USING DDCLIENT WITH `cron` If you have not configured ddclient to use daemon-mode, you'll need to configure cron to force an update once a month so that the dns entry will @@ -252,9 +239,7 @@ not become stale. cp sample-etc_cron.d_ddclient /etc/cron.d/ddclient vi /etc/cron.d/ddclient -------------------------------------------------------------------------------- - -## USING DDCLIENT WITH dhcpcd-1.3.17 +## USING DDCLIENT WITH `dhcpcd` If you are using dhcpcd-1.3.17 or thereabouts, you can easily update your DynDNS entry automatically every time your lease is obtained @@ -269,7 +254,7 @@ In my case, it is named dhcpcd-eth0.exe and contains the lines: #!/bin/sh PATH=/usr/bin:/root/bin:${PATH} logger -t dhcpcd IP address changed to $1 -ddclient -proxy fasthttp.sympatico.ca -wildcard -ip $1 | logger -t ddclient +ddclient --proxy fasthttp.sympatico.ca --wildcard --ip $1 | logger -t ddclient exit 0 ``` @@ -279,8 +264,7 @@ for updating DNS entries. Alternatively, you may just configure ddclient to operate as a daemon and monitor your ethernet interface. -------------------------------------------------------------------------------- -## USING DDCLIENT WITH dhclient +## USING DDCLIENT WITH `dhclient` If you are using the ISC DHCP client (dhclient), you can update your DynDNS entry automatically every time your lease is obtained @@ -293,5 +277,3 @@ Edit ``/etc/dhclient-exit-hooks`` to change any options required. Alternatively, you may just configure ddclient to operate as a daemon and monitor your ethernet interface. - -------------------------------------------------------------------------------- diff --git a/README.ssl b/README.ssl deleted file mode 100644 index 3aa579bb5..000000000 --- a/README.ssl +++ /dev/null @@ -1,13 +0,0 @@ -Since 3.7.0, ddclient support ssl-updates -To use ssl, put "ssl=yes" in your configuration and make sure -you have IO::Socket::SSL. - -On debian, you need libio-socket-ssl-perl to have IO::Socket::SSL - -On alpine, you need perl-io-socket-ssl to have IO::Socket::SSL - -ssl support is tested on folowing dynamic dns providers: -- dyndns.com -- freemyip.com -- DNS Made Easy -- dondominio.com diff --git a/TODO b/TODO deleted file mode 100644 index 1e92adf2c..000000000 --- a/TODO +++ /dev/null @@ -1,14 +0,0 @@ -* ssl: - - check if the library can be used - - ssl on routers - - ssl on other providers - -* notice about irc: there's almost always someone there but we're sometimes idle -or at work... -* adding router: halted, only in patches section. -* add doc postscript -* FAQ: bad hostname (checkip) -* note about init-scripts. -* request from dyndns: http://tinyurl.com/2l3twf - -* check bugs diff --git a/UPGRADE b/UPGRADE deleted file mode 100644 index e69de29bb..000000000 diff --git a/autogen b/autogen index e2f544005..a03c6fd2c 100755 --- a/autogen +++ b/autogen @@ -7,18 +7,16 @@ fatal() { error "$@"; exit 1; } try() { "$@" || fatal "'$@' failed"; } try cd "${0%/*}" -try mkdir -p m4 build-aux +# aclocal complains if a directory passed to AC_CONFIG_MACRO_DIR doesn't exist. +try mkdir -p build-aux/m4 +# autoreconf's '--force' option doesn't affect any of the files installed by the '--install' option. +# Remove the files to truly force them to be updated. +try rm -f \ + aclocal.m4 \ + build-aux/config.guess \ + build-aux/config.sub \ + build-aux/install-sh \ + build-aux/missing \ + build-aux/tap-driver.sh \ + ; try autoreconf -fviW all - -# Ignore changes to build-aux/tap-driver, but only if we're in a clone -# of the ddclient Git repository. Once CentOS 6 and RHEL 6 reach -# end-of-life we can delete build-aux/tap-driver.sh and this block of -# code. (tap-driver.sh is checked in to this Git repository only -# because we want to support all currently maintained CentOS and RHEL -# releases, and CentoOS 6 and RHEL 6 ship with Automake 1.11 which -# does not come with tap-driver.sh.) -command -v git >/dev/null || exit 0 -git rev-parse --is-inside-work-tree >/dev/null 2>&1 || exit 0 -cdup=$(try git rev-parse --show-cdup) || exit 1 -[ -z "${cdup}" ] || exit 0 -try git update-index --assume-unchanged -- build-aux/tap-driver.sh diff --git a/m4/ax_compare_version.m4 b/build-aux/m4/ax_compare_version.m4 similarity index 100% rename from m4/ax_compare_version.m4 rename to build-aux/m4/ax_compare_version.m4 diff --git a/m4/ax_prog_perl_modules.m4 b/build-aux/m4/ax_prog_perl_modules.m4 similarity index 100% rename from m4/ax_prog_perl_modules.m4 rename to build-aux/m4/ax_prog_perl_modules.m4 diff --git a/m4/ax_prog_perl_version.m4 b/build-aux/m4/ax_prog_perl_version.m4 similarity index 100% rename from m4/ax_prog_perl_version.m4 rename to build-aux/m4/ax_prog_perl_version.m4 diff --git a/m4/ax_with_prog.m4 b/build-aux/m4/ax_with_prog.m4 similarity index 100% rename from m4/ax_with_prog.m4 rename to build-aux/m4/ax_with_prog.m4 diff --git a/build-aux/tap-driver.sh b/build-aux/tap-driver.sh deleted file mode 100755 index 865761d3e..000000000 --- a/build-aux/tap-driver.sh +++ /dev/null @@ -1,651 +0,0 @@ -#! /bin/sh -# Copyright (C) 2011-2020 Free Software Foundation, Inc. -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - -# This file is maintained in Automake, please report -# bugs to or send patches to -# . - -scriptversion=2013-12-23.17; # UTC - -# Make unconditional expansion of undefined variables an error. This -# helps a lot in preventing typo-related bugs. -set -u - -me=tap-driver.sh - -fatal () -{ - echo "$me: fatal: $*" >&2 - exit 1 -} - -usage_error () -{ - echo "$me: $*" >&2 - print_usage >&2 - exit 2 -} - -print_usage () -{ - cat < - # - trap : 1 3 2 13 15 - if test $merge -gt 0; then - exec 2>&1 - else - exec 2>&3 - fi - "$@" - echo $? - ) | LC_ALL=C ${AM_TAP_AWK-awk} \ - -v me="$me" \ - -v test_script_name="$test_name" \ - -v log_file="$log_file" \ - -v trs_file="$trs_file" \ - -v expect_failure="$expect_failure" \ - -v merge="$merge" \ - -v ignore_exit="$ignore_exit" \ - -v comments="$comments" \ - -v diag_string="$diag_string" \ -' -# TODO: the usages of "cat >&3" below could be optimized when using -# GNU awk, and/on on systems that supports /dev/fd/. - -# Implementation note: in what follows, `result_obj` will be an -# associative array that (partly) simulates a TAP result object -# from the `TAP::Parser` perl module. - -## ----------- ## -## FUNCTIONS ## -## ----------- ## - -function fatal(msg) -{ - print me ": " msg | "cat >&2" - exit 1 -} - -function abort(where) -{ - fatal("internal error " where) -} - -# Convert a boolean to a "yes"/"no" string. -function yn(bool) -{ - return bool ? "yes" : "no"; -} - -function add_test_result(result) -{ - if (!test_results_index) - test_results_index = 0 - test_results_list[test_results_index] = result - test_results_index += 1 - test_results_seen[result] = 1; -} - -# Whether the test script should be re-run by "make recheck". -function must_recheck() -{ - for (k in test_results_seen) - if (k != "XFAIL" && k != "PASS" && k != "SKIP") - return 1 - return 0 -} - -# Whether the content of the log file associated to this test should -# be copied into the "global" test-suite.log. -function copy_in_global_log() -{ - for (k in test_results_seen) - if (k != "PASS") - return 1 - return 0 -} - -function get_global_test_result() -{ - if ("ERROR" in test_results_seen) - return "ERROR" - if ("FAIL" in test_results_seen || "XPASS" in test_results_seen) - return "FAIL" - all_skipped = 1 - for (k in test_results_seen) - if (k != "SKIP") - all_skipped = 0 - if (all_skipped) - return "SKIP" - return "PASS"; -} - -function stringify_result_obj(result_obj) -{ - if (result_obj["is_unplanned"] || result_obj["number"] != testno) - return "ERROR" - - if (plan_seen == LATE_PLAN) - return "ERROR" - - if (result_obj["directive"] == "TODO") - return result_obj["is_ok"] ? "XPASS" : "XFAIL" - - if (result_obj["directive"] == "SKIP") - return result_obj["is_ok"] ? "SKIP" : COOKED_FAIL; - - if (length(result_obj["directive"])) - abort("in function stringify_result_obj()") - - return result_obj["is_ok"] ? COOKED_PASS : COOKED_FAIL -} - -function decorate_result(result) -{ - color_name = color_for_result[result] - if (color_name) - return color_map[color_name] "" result "" color_map["std"] - # If we are not using colorized output, or if we do not know how - # to colorize the given result, we should return it unchanged. - return result -} - -function report(result, details) -{ - if (result ~ /^(X?(PASS|FAIL)|SKIP|ERROR)/) - { - msg = ": " test_script_name - add_test_result(result) - } - else if (result == "#") - { - msg = " " test_script_name ":" - } - else - { - abort("in function report()") - } - if (length(details)) - msg = msg " " details - # Output on console might be colorized. - print decorate_result(result) msg - # Log the result in the log file too, to help debugging (this is - # especially true when said result is a TAP error or "Bail out!"). - print result msg | "cat >&3"; -} - -function testsuite_error(error_message) -{ - report("ERROR", "- " error_message) -} - -function handle_tap_result() -{ - details = result_obj["number"]; - if (length(result_obj["description"])) - details = details " " result_obj["description"] - - if (plan_seen == LATE_PLAN) - { - details = details " # AFTER LATE PLAN"; - } - else if (result_obj["is_unplanned"]) - { - details = details " # UNPLANNED"; - } - else if (result_obj["number"] != testno) - { - details = sprintf("%s # OUT-OF-ORDER (expecting %d)", - details, testno); - } - else if (result_obj["directive"]) - { - details = details " # " result_obj["directive"]; - if (length(result_obj["explanation"])) - details = details " " result_obj["explanation"] - } - - report(stringify_result_obj(result_obj), details) -} - -# `skip_reason` should be empty whenever planned > 0. -function handle_tap_plan(planned, skip_reason) -{ - planned += 0 # Avoid getting confused if, say, `planned` is "00" - if (length(skip_reason) && planned > 0) - abort("in function handle_tap_plan()") - if (plan_seen) - { - # Error, only one plan per stream is acceptable. - testsuite_error("multiple test plans") - return; - } - planned_tests = planned - # The TAP plan can come before or after *all* the TAP results; we speak - # respectively of an "early" or a "late" plan. If we see the plan line - # after at least one TAP result has been seen, assume we have a late - # plan; in this case, any further test result seen after the plan will - # be flagged as an error. - plan_seen = (testno >= 1 ? LATE_PLAN : EARLY_PLAN) - # If testno > 0, we have an error ("too many tests run") that will be - # automatically dealt with later, so do not worry about it here. If - # $plan_seen is true, we have an error due to a repeated plan, and that - # has already been dealt with above. Otherwise, we have a valid "plan - # with SKIP" specification, and should report it as a particular kind - # of SKIP result. - if (planned == 0 && testno == 0) - { - if (length(skip_reason)) - skip_reason = "- " skip_reason; - report("SKIP", skip_reason); - } -} - -function extract_tap_comment(line) -{ - if (index(line, diag_string) == 1) - { - # Strip leading `diag_string` from `line`. - line = substr(line, length(diag_string) + 1) - # And strip any leading and trailing whitespace left. - sub("^[ \t]*", "", line) - sub("[ \t]*$", "", line) - # Return what is left (if any). - return line; - } - return ""; -} - -# When this function is called, we know that line is a TAP result line, -# so that it matches the (perl) RE "^(not )?ok\b". -function setup_result_obj(line) -{ - # Get the result, and remove it from the line. - result_obj["is_ok"] = (substr(line, 1, 2) == "ok" ? 1 : 0) - sub("^(not )?ok[ \t]*", "", line) - - # If the result has an explicit number, get it and strip it; otherwise, - # automatically assing the next progresive number to it. - if (line ~ /^[0-9]+$/ || line ~ /^[0-9]+[^a-zA-Z0-9_]/) - { - match(line, "^[0-9]+") - # The final `+ 0` is to normalize numbers with leading zeros. - result_obj["number"] = substr(line, 1, RLENGTH) + 0 - line = substr(line, RLENGTH + 1) - } - else - { - result_obj["number"] = testno - } - - if (plan_seen == LATE_PLAN) - # No further test results are acceptable after a "late" TAP plan - # has been seen. - result_obj["is_unplanned"] = 1 - else if (plan_seen && testno > planned_tests) - result_obj["is_unplanned"] = 1 - else - result_obj["is_unplanned"] = 0 - - # Strip trailing and leading whitespace. - sub("^[ \t]*", "", line) - sub("[ \t]*$", "", line) - - # This will have to be corrected if we have a "TODO"/"SKIP" directive. - result_obj["description"] = line - result_obj["directive"] = "" - result_obj["explanation"] = "" - - if (index(line, "#") == 0) - return # No possible directive, nothing more to do. - - # Directives are case-insensitive. - rx = "[ \t]*#[ \t]*([tT][oO][dD][oO]|[sS][kK][iI][pP])[ \t]*" - - # See whether we have the directive, and if yes, where. - pos = match(line, rx "$") - if (!pos) - pos = match(line, rx "[^a-zA-Z0-9_]") - - # If there was no TAP directive, we have nothing more to do. - if (!pos) - return - - # Let`s now see if the TAP directive has been escaped. For example: - # escaped: ok \# SKIP - # not escaped: ok \\# SKIP - # escaped: ok \\\\\# SKIP - # not escaped: ok \ # SKIP - if (substr(line, pos, 1) == "#") - { - bslash_count = 0 - for (i = pos; i > 1 && substr(line, i - 1, 1) == "\\"; i--) - bslash_count += 1 - if (bslash_count % 2) - return # Directive was escaped. - } - - # Strip the directive and its explanation (if any) from the test - # description. - result_obj["description"] = substr(line, 1, pos - 1) - # Now remove the test description from the line, that has been dealt - # with already. - line = substr(line, pos) - # Strip the directive, and save its value (normalized to upper case). - sub("^[ \t]*#[ \t]*", "", line) - result_obj["directive"] = toupper(substr(line, 1, 4)) - line = substr(line, 5) - # Now get the explanation for the directive (if any), with leading - # and trailing whitespace removed. - sub("^[ \t]*", "", line) - sub("[ \t]*$", "", line) - result_obj["explanation"] = line -} - -function get_test_exit_message(status) -{ - if (status == 0) - return "" - if (status !~ /^[1-9][0-9]*$/) - abort("getting exit status") - if (status < 127) - exit_details = "" - else if (status == 127) - exit_details = " (command not found?)" - else if (status >= 128 && status <= 255) - exit_details = sprintf(" (terminated by signal %d?)", status - 128) - else if (status > 256 && status <= 384) - # We used to report an "abnormal termination" here, but some Korn - # shells, when a child process die due to signal number n, can leave - # in $? an exit status of 256+n instead of the more standard 128+n. - # Apparently, both behaviours are allowed by POSIX (2008), so be - # prepared to handle them both. See also Austing Group report ID - # 0000051 - exit_details = sprintf(" (terminated by signal %d?)", status - 256) - else - # Never seen in practice. - exit_details = " (abnormal termination)" - return sprintf("exited with status %d%s", status, exit_details) -} - -function write_test_results() -{ - print ":global-test-result: " get_global_test_result() > trs_file - print ":recheck: " yn(must_recheck()) > trs_file - print ":copy-in-global-log: " yn(copy_in_global_log()) > trs_file - for (i = 0; i < test_results_index; i += 1) - print ":test-result: " test_results_list[i] > trs_file - close(trs_file); -} - -BEGIN { - -## ------- ## -## SETUP ## -## ------- ## - -'"$init_colors"' - -# Properly initialized once the TAP plan is seen. -planned_tests = 0 - -COOKED_PASS = expect_failure ? "XPASS": "PASS"; -COOKED_FAIL = expect_failure ? "XFAIL": "FAIL"; - -# Enumeration-like constants to remember which kind of plan (if any) -# has been seen. It is important that NO_PLAN evaluates "false" as -# a boolean. -NO_PLAN = 0 -EARLY_PLAN = 1 -LATE_PLAN = 2 - -testno = 0 # Number of test results seen so far. -bailed_out = 0 # Whether a "Bail out!" directive has been seen. - -# Whether the TAP plan has been seen or not, and if yes, which kind -# it is ("early" is seen before any test result, "late" otherwise). -plan_seen = NO_PLAN - -## --------- ## -## PARSING ## -## --------- ## - -is_first_read = 1 - -while (1) - { - # Involutions required so that we are able to read the exit status - # from the last input line. - st = getline - if (st < 0) # I/O error. - fatal("I/O error while reading from input stream") - else if (st == 0) # End-of-input - { - if (is_first_read) - abort("in input loop: only one input line") - break - } - if (is_first_read) - { - is_first_read = 0 - nextline = $0 - continue - } - else - { - curline = nextline - nextline = $0 - $0 = curline - } - # Copy any input line verbatim into the log file. - print | "cat >&3" - # Parsing of TAP input should stop after a "Bail out!" directive. - if (bailed_out) - continue - - # TAP test result. - if ($0 ~ /^(not )?ok$/ || $0 ~ /^(not )?ok[^a-zA-Z0-9_]/) - { - testno += 1 - setup_result_obj($0) - handle_tap_result() - } - # TAP plan (normal or "SKIP" without explanation). - else if ($0 ~ /^1\.\.[0-9]+[ \t]*$/) - { - # The next two lines will put the number of planned tests in $0. - sub("^1\\.\\.", "") - sub("[^0-9]*$", "") - handle_tap_plan($0, "") - continue - } - # TAP "SKIP" plan, with an explanation. - else if ($0 ~ /^1\.\.0+[ \t]*#/) - { - # The next lines will put the skip explanation in $0, stripping - # any leading and trailing whitespace. This is a little more - # tricky in truth, since we want to also strip a potential leading - # "SKIP" string from the message. - sub("^[^#]*#[ \t]*(SKIP[: \t][ \t]*)?", "") - sub("[ \t]*$", ""); - handle_tap_plan(0, $0) - } - # "Bail out!" magic. - # Older versions of prove and TAP::Harness (e.g., 3.17) did not - # recognize a "Bail out!" directive when preceded by leading - # whitespace, but more modern versions (e.g., 3.23) do. So we - # emulate the latter, "more modern" behaviour. - else if ($0 ~ /^[ \t]*Bail out!/) - { - bailed_out = 1 - # Get the bailout message (if any), with leading and trailing - # whitespace stripped. The message remains stored in `$0`. - sub("^[ \t]*Bail out![ \t]*", ""); - sub("[ \t]*$", ""); - # Format the error message for the - bailout_message = "Bail out!" - if (length($0)) - bailout_message = bailout_message " " $0 - testsuite_error(bailout_message) - } - # Maybe we have too look for dianogtic comments too. - else if (comments != 0) - { - comment = extract_tap_comment($0); - if (length(comment)) - report("#", comment); - } - } - -## -------- ## -## FINISH ## -## -------- ## - -# A "Bail out!" directive should cause us to ignore any following TAP -# error, as well as a non-zero exit status from the TAP producer. -if (!bailed_out) - { - if (!plan_seen) - { - testsuite_error("missing test plan") - } - else if (planned_tests != testno) - { - bad_amount = testno > planned_tests ? "many" : "few" - testsuite_error(sprintf("too %s tests run (expected %d, got %d)", - bad_amount, planned_tests, testno)) - } - if (!ignore_exit) - { - # Fetch exit status from the last line. - exit_message = get_test_exit_message(nextline) - if (exit_message) - testsuite_error(exit_message) - } - } - -write_test_results() - -exit 0 - -} # End of "BEGIN" block. -' - -# TODO: document that we consume the file descriptor 3 :-( -} 3>"$log_file" - -test $? -eq 0 || fatal "I/O or internal error" - -# Local Variables: -# mode: shell-script -# sh-indentation: 2 -# eval: (add-hook 'before-save-hook 'time-stamp) -# time-stamp-start: "scriptversion=" -# time-stamp-format: "%:y-%02m-%02d.%02H" -# time-stamp-time-zone: "UTC0" -# time-stamp-end: "; # UTC" -# End: diff --git a/configure.ac b/configure.ac index cc6a8b6c5..4ccecc8e3 100644 --- a/configure.ac +++ b/configure.ac @@ -1,8 +1,17 @@ AC_PREREQ([2.63]) -AC_INIT([ddclient], [3.9.1]) +# Get the version from ddclient.in so that the same version string +# doesn't have to be maintained in two places. The m4_dquote macro is +# used instead of quote characters to ensure that the command is only +# run once. The command outputs quote characters to prevent +# incidental expansion (the m4_esyscmd macro does not quote the +# command output itself, so the command output is subject to +# expansion). +AC_INIT([ddclient], m4_dquote(m4_esyscmd([printf '[%s]' "$(./ddclient.in --version=short)"]))) +# Needed because of the above invocation of ddclient.in. +AC_SUBST([CONFIGURE_DEPENDENCIES], ['$(top_srcdir)/ddclient.in']) AC_CONFIG_SRCDIR([ddclient.in]) AC_CONFIG_AUX_DIR([build-aux]) -AC_CONFIG_MACRO_DIR([m4]) +AC_CONFIG_MACRO_DIR([build-aux/m4]) AC_REQUIRE_AUX_FILE([tap-driver.sh]) # If the automake dependency is bumped to v1.12 or newer, remove # build-aux/tap-driver.sh from the repository. Automake 1.12+ comes @@ -14,6 +23,18 @@ AC_REQUIRE_AUX_FILE([tap-driver.sh]) AM_INIT_AUTOMAKE([1.11 -Wall -Werror foreign subdir-objects parallel-tests]) AM_SILENT_RULES +m4_define([CONFDIR_DEFAULT], [${sysconfdir}/AC_PACKAGE_NAME]) +AC_ARG_WITH( + [confdir], + [AS_HELP_STRING( + [--with-confdir=DIR], + m4_expand([[look for ddclient.conf in DIR @<:@default: ]CONFDIR_DEFAULT[@:>@]]))], + [], + # The single quotes are intentional; see: + # https://www.gnu.org/software/automake/manual/html_node/Uniform.html + [with_confdir='CONFDIR_DEFAULT']) +AC_SUBST([confdir], [${with_confdir}]) + AC_PROG_MKDIR_P # The Fedora Docker image doesn't come with the 'findutils' package. @@ -27,7 +48,19 @@ AC_PROG_MKDIR_P AC_PATH_PROG([FIND], [find]) AS_IF([test -z "${FIND}"], [AC_MSG_ERROR(['find' utility not found])]) -AC_PATH_PROG([CURL], [curl]) +AC_ARG_WITH([curl], + [AS_HELP_STRING([[--with-curl[=CURL]]], [use CURL as absolute path to curl executable])], + [], + [with_curl=yes]) +AS_CASE([${with_curl}], + [[yes]], [AC_PATH_PROG([CURL], [curl])], + [[no]], [CURL=], + [ + AC_MSG_CHECKING([for curl]) + CURL=${with_curl} + AC_MSG_RESULT([${CURL}]) + ]); +AS_IF([test -z "${CURL}"], [AC_MSG_ERROR([curl not found])]) AX_WITH_PROG([PERL], perl) AX_PROG_PERL_VERSION([5.10.1], [], @@ -39,11 +72,11 @@ AC_SUBST([PERL]) # package doesn't depend on all of them, so their availability can't # be assumed. m4_foreach_w([_m], [ + Data::Dumper File::Basename File::Path File::Temp Getopt::Long - IO::Socket::INET Socket Sys::Hostname version=0.77 @@ -54,9 +87,12 @@ m4_foreach_w([_m], [ # then some tests will fail. Only prints a warning if not installed. m4_foreach_w([_m], [ B - Data::Dumper + Exporter File::Spec::Functions File::Temp + List::Util + Scalar::Util + re ], [AX_PROG_PERL_MODULES([_m], [], [AC_MSG_WARN([some tests will fail due to missing module _m])])]) @@ -65,27 +101,23 @@ m4_foreach_w([_m], [ # prints a warning if not installed. m4_foreach_w([_m], [ Carp - Exporter HTTP::Daemon=6.12 HTTP::Daemon::SSL HTTP::Message::PSGI HTTP::Request HTTP::Response - IO::Socket::INET6 - IO::Socket::IP - IO::Socket::SSL - Scalar::Util + JSON::PP Test::MockModule Test::TCP Test::Warnings Time::HiRes URI + parent ], [AX_PROG_PERL_MODULES([_m], [], [AC_MSG_WARN([some tests may be skipped due to missing module _m])])]) AC_CONFIG_FILES([ Makefile - t/geturl_connectivity.pl t/version.pl ]) AC_OUTPUT diff --git a/ddclient.conf.in b/ddclient.conf.in index 5144c3a37..103b1fa13 100644 --- a/ddclient.conf.in +++ b/ddclient.conf.in @@ -1,12 +1,12 @@ ###################################################################### ## ## Define default global variables with lines like: -## var=value [, var=value]* +## var=value [, var=value]* ## These values will be used for each following host unless overridden ## with a local variable definition. ## ## Define local variables for one or more hosts with: -## var=value [, var=value]* host.and.domain[,host2.and.domain...] +## var=value [, var=value]* host.and.domain[,host2.and.domain...] ## ## Lines can be continued on the following line by ending the line ## with a \ @@ -16,37 +16,47 @@ ## are mentioned here. ## ###################################################################### -daemon=300 # check every 300 seconds -syslog=yes # log update msgs to syslog -mail=root # mail all msgs to root -mail-failure=root # mail failed update msgs to root -pid=@runstatedir@/ddclient.pid # record PID in file. -ssl=yes # use ssl-support. Works with - # ssl-library -# postscript=script # run script after updating. The - # new IP is added as argument. + +## Use encryption (TLS) when the scheme (either "http://" or "https://") is +## missing from a URL. Defaults to "yes". +#ssl=yes + +daemon=300 # check every 300 seconds +syslog=yes # log update msgs to syslog +mail=root # mail all msgs to root +mail-failure=root # mail failed update msgs to root +# mail-from=root # set the email "From:" header to "root". If + # unset (the default) or empty, the from address + # depends on your system's default behavior. +pid=@runstatedir@/ddclient.pid # record PID in file. +# postscript=script # run script after updating. The new IP is + # added as argument. # -#use=watchguard-soho, fw=192.168.111.1:80 # via Watchguard's SOHO FW -#use=netopia-r910, fw=192.168.111.1:80 # via Netopia R910 FW -#use=smc-barricade, fw=192.168.123.254:80 # via SMC's Barricade FW -#use=netgear-rt3xx, fw=192.168.0.1:80 # via Netgear's internet FW -#use=linksys, fw=192.168.1.1:80 # via Linksys's internet FW -#use=maxgate-ugate3x00, fw=192.168.0.1:80 # via MaxGate's UGATE-3x00 FW -#use=elsa-lancom-dsl10, fw=10.0.0.254:80 # via ELSA LanCom DSL/10 DSL Router -#use=elsa-lancom-dsl10-ch01, fw=10.0.0.254:80 # via ELSA LanCom DSL/10 DSL Router -#use=elsa-lancom-dsl10-ch02, fw=10.0.0.254:80 # via ELSA LanCom DSL/10 DSL Router +#use=watchguard-soho, fw=192.168.111.1:80 # via Watchguard's SOHO FW +#use=netopia-r910, fw=192.168.111.1:80 # via Netopia R910 FW +#use=smc-barricade, fw=192.168.123.254:80 # via SMC's Barricade FW +#use=netgear-rt3xx, fw=192.168.0.1:80 # via Netgear's internet FW +#use=linksys, fw=192.168.1.1:80 # via Linksys's internet FW +#use=maxgate-ugate3x00, fw=192.168.0.1:80 # via MaxGate's UGATE-3x00 FW +#use=elsa-lancom-dsl10, fw=10.0.0.254:80 # via ELSA LanCom DSL/10 DSL Router +#use=elsa-lancom-dsl10-ch01, fw=10.0.0.254:80 # via ELSA LanCom DSL/10 DSL Router +#use=elsa-lancom-dsl10-ch02, fw=10.0.0.254:80 # via ELSA LanCom DSL/10 DSL Router #use=alcatel-stp, fw=10.0.0.138:80 # via Alcatel Speed Touch Pro #use=xsense-aero, fw=192.168.1.1:80 # via Xsense Aero Router #use=allnet-1298, fw=192.168.1.1:80 # via AllNet 1298 DSL Router -#use=3com-oc-remote812, fw=192.168.0.254:80 # via 3com OfficeConnect Remote 812 +#use=3com-oc-remote812, fw=192.168.0.254:80 # via 3com OfficeConnect Remote 812 #use=e-tech, fw=192.168.1.1:80 # via E-tech Router #use=cayman-3220h, fw=192.168.0.1:1080 # via Cayman 3220-H DSL Router # -#fw-login=admin, fw-password=XXXXXX # FW login and password +#fw-login=admin, fw-password=XXXXXX # FW login and password # ## To obtain an IP address from FW status page (using fw-login, fw-password) #use=fw, fw=192.168.1.254/status.htm, fw-skip='IP Address' # found after IP Address # +## To obtain an IP address via UPnP from router +## Requires miniupnpc to be installed on the system. +#use=cmd, cmd=external-ip +# ## To obtain an IP address from Web status page (using the proxy if defined) ## by default, checkip.dyndns.org is used if you use the dyndns protocol. ## Using use=web is enough to get it working. @@ -54,112 +64,89 @@ ssl=yes # use ssl-support. Works with ## get banned from their service. #use=web, web=checkip.dyndns.org/, web-skip='IP Address' # found after IP Address # -#use=ip, ip=127.0.0.1 # via static IP's -#use=if, if=eth0 # via interfaces -#use=web # via web +#use=ip, ip=127.0.0.1 # via static IP's +#use=if, if=eth0 # via interfaces +#use=web # via web # -#protocol=dyndns2 # default protocol -#proxy=fasthttp.sympatico.ca:80 # default proxy -#server=members.dyndns.org # default server -#server=members.dyndns.org:8245 # default server (bypassing proxies) +#protocol=dyndns2 # default protocol +#proxy=fasthttp.sympatico.ca:80 # default proxy +#server=members.dyndns.org # default server +#server=members.dyndns.org:8245 # default server (bypassing proxies) -#login=your-login # default login -#password=test # default password -#mx=mx.for.your.host # default MX -#backupmx=yes|no # host is primary MX? -#wildcard=yes|no # add wildcard CNAME? +#login=your-login # default login +#password=test # default password +#mx=mx.for.your.host # default MX +#backupmx=yes|no # host is primary MX? +#wildcard=yes|no # add wildcard CNAME? ## ## dyndns.org dynamic addresses ## ## (supports variables: wildcard,mx,backupmx) ## -# server=members.dyndns.org, \ -# protocol=dyndns2 \ +# server=members.dyndns.org, \ +# protocol=dyndns2 \ # your-dynamic-host.dyndns.org -## -## dyndns.org static addresses -## -## (supports variables: wildcard,mx,backupmx) -## -# static=yes, \ -# server=members.dyndns.org, \ -# protocol=dyndns2 \ -# your-static-host.dyndns.org - -## -## -## dyndns.org custom addresses -## -## (supports variables: wildcard,mx,backupmx) -## -# custom=yes, \ -# server=members.dyndns.org, \ -# protocol=dyndns2 \ -# your-domain.top-level,your-other-domain.top-level - ## ## ZoneEdit (zoneedit.com) ## -# server=dynamic.zoneedit.com, \ -# protocol=zoneedit1, \ -# login=your-zoneedit-login, \ -# password=your-zoneedit-password \ +# server=dynamic.zoneedit.com, \ +# protocol=zoneedit1, \ +# login=your-zoneedit-login, \ +# password=your-zoneedit-password \ # your.any.domain,your-2nd.any.dom ## ## EasyDNS (easydns.com) ## -# server=members.easydns.com, \ -# protocol=easydns, \ -# login=your-easydns-login, \ -# password=your-easydns-password \ +# server=members.easydns.com, \ +# protocol=easydns, \ +# login=your-easydns-login, \ +# password=your-easydns-password \ # your.any.domain,your-2nd.any.domain ## ## dslreports.com dynamic-host monitoring ## -# server=members.dslreports.com \ -# protocol=dslreports1, \ -# login=dslreports-login, \ -# password=dslreports-password \ +# server=members.dslreports.com \ +# protocol=dslreports1, \ +# login=dslreports-login, \ +# password=dslreports-password \ # dslreports-unique-id ## ## OrgDNS.org account-configuration ## # use=web, web=members.orgdns.org/nic/ip -# server=www.orgdns.org \ -# protocol=dyndns2 \ -# login=yourLoginName \ -# password=yourPassword \ +# protocol=dyndns2 +# server=www.orgdns.org \ +# login=yourLoginName \ +# password=yourPassword \ # yourSubdomain.orgdns.org ## ## NameCheap (namecheap.com) ## -# protocol=namecheap, \ -# server=dynamicdns.park-your-domain.com, \ -# login=my-namecheap.com-login, \ -# password=my-namecheap.com-password \ -# fully.qualified.host +# protocol=namecheap, \ +# server=dynamicdns.park-your-domain.com, \ +# login=example.com, \ +# password=example.com-password \ +# subdomain.example.com ## ## NearlyFreeSpeech.NET (nearlyfreespeech.net) ## -# protocol = nfsn, \ +# protocol=nfsn, \ +# zone=example.com, \ # login=member-login, \ -# password=api-key, \ -# zone=example.com \ +# password=api-key \ # example.com,subdomain.example.com -## ## ## Loopia (loopia.se) ## -# use=web -# web=loopia +# use=web, web=loopia # protocol=dyndns2 # server=dns.loopia.se # script=/XDynDNSServer/XDynDNS.php @@ -174,7 +161,7 @@ ssl=yes # use ssl-support. Works with # ssl=yes, \ # server=dynupdate.no-ip.com, \ # login=your-noip-login, \ -# password=your-noip-password, \ +# password=your-noip-password \ # your-host.domain.com, your-2nd-host.domain.com ## @@ -189,30 +176,40 @@ ssl=yes # use ssl-support. Works with ## ## CloudFlare (www.cloudflare.com) ## -#protocol=cloudflare, \ -#zone=domain.tld, \ -#ttl=1, \ -#login=your-login-email, \ # Only needed if you are using your global API key. If you are using an API token, set it to "token" (wihtout double quotes). -#password=APIKey \ # This is either your global API key, or an API token. If you are using an API token, it must have the permissions "Zone - DNS - Edit" and "Zone - Zone - Read". The Zone resources must be "Include - All zones". -#domain.tld,my.domain.tld +# protocol=cloudflare, \ +# zone=domain.tld, \ +# ttl=1, \ +# login=your-login-email, \ # Only needed if you are using your global API key. If you are using an API token, set it to "token" (without double quotes). +# password=APIKey \ # This is either your global API key, or an API token. If you are using an API token, it must have the permissions "Zone - DNS - Edit" and "Zone - Zone - Read". The Zone resources must be "Include - All zones". +# domain.tld,my.domain.tld ## ## Gandi (gandi.net) ## ## Single host update -# protocol=gandi, \ -# zone=example.com, \ -# password=my-gandi-api-key, \ -# ttl=3h \ +# protocol=gandi +# zone=example.com +# password=my-gandi-access-token +# use-personal-access-token=yes +# ttl=10800 # optional # myhost.example.com ## -## Google Domains (www.google.com/domains) +## GoDaddy (godaddy.com) ## -# protocol=googledomains, -# login=my-auto-generated-username, -# password=my-auto-generated-password -# my.domain.tld, otherhost.domain.tld +# protocol=godaddy, \ +# password=my-godaddy-api-key, \ +# password=my-godaddy-secret, \ +# ttl=600 \ +# zone=example.com, \ +# myhost.example.com,nexthost.example.com + +## +## Hurricane Electric (dns.he.net) +## +# protocol=he.net, \ +# password=my-genereated-password \ +# myhost.example.com ## ## Duckdns (http://www.duckdns.org/) @@ -230,15 +227,23 @@ ssl=yes # use ssl-support. Works with # password=my-token # myhost +## +## DDNS.FM (https://ddns.fm/) +## +# +# protocol=ddns.fm, +# password=my-token +# myhost.example.com + ## ## MyOnlinePortal (http://myonlineportal.net) ## -# protocol=dyndns2 -# ssl=yes # # ipv6=yes # optional # use=web, web=myonlineportal.net/checkip # # use=if, if=eth0 # alternative to use=web # # if-skip=Scope:Link # alternative to use=web +# protocol=dyndns2 +# ssl=yes # login=your-myonlineportal-username # password=your-myonlineportal-password # domain.myonlineportal.net @@ -246,23 +251,23 @@ ssl=yes # use ssl-support. Works with ## ## nsupdate.info IPV4(https://www.nsupdate.info) ## -#protocol=dyndns2 -#use=web, web=http://ipv4.nsupdate.info/myip -#server=ipv4.nsupdate.info -#login=domain.nsupdate.info -#password='123' -#domain.nsupdate.info +# use=web, web=http://ipv4.nsupdate.info/myip +# protocol=dyndns2 +# server=ipv4.nsupdate.info +# login=domain.nsupdate.info +# password='123' +# domain.nsupdate.info ## ## nsupdate.info IPV6 (https://www.nsupdate.info) ## ddclient releases <= 3.8.1 do not support IPv6 ## -#protocol=dyndns2 -#usev6=if, if=eth0 -#server=ipv6.nsupdate.info -#login=domain.nsupdate.info -#password='123' -#domain.nsupdate.info +# usev6=if, if=eth0 +# protocol=dyndns2 +# server=ipv6.nsupdate.info +# login=domain.nsupdate.info +# password='123' +# domain.nsupdate.info ## ## Yandex.Mail for Domain (domain.yandex.com) @@ -288,6 +293,16 @@ ssl=yes # use ssl-support. Works with # password=your_password # test.example.com +## +## Porkbun (https://porkbun.com/) +## +# protocol=porkbun +# apikey=APIKey +# secretapikey=SecretAPIKey +# root-domain=example.com +# host.example.com,host2.sub.example.com +# example.com,sub.example.com + ## ## ClouDNS (https://www.cloudns.net) ## @@ -303,9 +318,104 @@ ssl=yes # use ssl-support. Works with # password=mypassword \ # myhost.mydomain.com +## ## dnsexit (www.dnsexit.com) ## -#protocol=dnsexit, \ -#login=myusername, \ -#password=mypassword, \ -#subdomain-1.domain.com,subdomain-2.domain.com +# protocol=dnsexit, \ +# login=myusername, \ +# password=mypassword, \ +# subdomain-1.domain.com,subdomain-2.domain.com + +## +## dnsexit2 (API method www.dnsexit.com) +## +# protocol=dnsexit2 +# password=MyAPIKey +# subdomain-1.domain.com,subdomain-2.domain.com + +## +## domeneshop (www.domeneshop.no) +## +# protocol=domeneshop +# login= +# password= +# subdomain-1.domain.com,subdomain-2.domain.com + +## +## Njal.la (http://njal.la/) +## +# protocol=njalla, +# password=mypassword +# quietreply=no|yes +# my-domain.com + +## +## regfish.de (www.regfish.de/) +## +# protocol=regfishde, +# password=mypassword +# my-domain.com + +## +## Enom (www.enom.com) +## +# protocol=enom, +# login=domain.name, +# password=domain-password +# my-domain.com + +## +## DigitalOcean (www.digitalocean.com) +## +# protocol=digitalocean, \ +# zone=example.com, \ +# password=api-token \ +# example.com,sub.example.com + +## +## Directnic (directnic.com) +## +# protocol=directnic, +# urlv4=https://directnic.com/dns/gateway/ipv4_token/ +# urlv6=https://directnic.com/dns/gateway/ipv6_token/ +# my-domain.com + +## +## Infomaniak (www.infomaniak.com) +## +# protocol=infomaniak, +# login=ddns_username, +# password=ddns_password +# example.com +# +# N.B. the infomaniak protocol is obsolete. Please use dyndns2 instead: +# +# protocol=dyndns2, +# use=web, web=infomaniak.com/ip.php/ +# login=ddns_username, +# password=ddns_password +# redirect=2 +# example.com + +## +## Email Only +## +# protocol=emailonly +# host.example.com + +## +## dnsHome.de +## +# protocol=dyndns2 \ +# server=www.dnshome.de \ +# login=subdomain.domain.tld \ +# password=your_password \ +# subdomain.domain.tld + +## +## INWX +## +# protocol=inwx \ +# login=my-inwx-DynDNS-account-username \ +# password=my-inwx-DynDNS-account-password \ +# myhost.example.org diff --git a/ddclient.in b/ddclient.in index 5a35d3893..cba36e0ef 100755 --- a/ddclient.in +++ b/ddclient.in @@ -3,40 +3,124 @@ # # 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 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/ +# Original Author: Paul Burry (paul+ddclient@burry.ca) +# Current maintainers: +# Reuben Thomas +# Lenard Heß # +# website: https://github.com/ddclient/ddclient # ###################################################################### package ddclient; require v5.10.1; use strict; use warnings; +use Data::Dumper; use File::Basename; use File::Path qw(make_path); use File::Temp; use Getopt::Long; -use 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//; +# Declare the ddclient version number. +# +# Perl's version strings do not support pre-release versions (alpha/development, beta, or release +# candidate) very well. The best it does is an optional underscore between arbitrary digits in the +# final component (e.g., "v1.2.3_4"). The underscore doesn't behave as most developers expect; it +# is treated as if it never existed (e.g., "v1.2.3_4" becomes "v1.2.34") except: +# +# * $v->is_alpha() will return true +# * $v->is_strict() will return false +# * $v->stringify() preserves the underscore (in its original position) +# +# Note that version::normal and version::numify lose information because the underscore is +# effectively removed. +# +# To work around Perl's limitations, Perl versions are translated to/from human-readable Semantic +# Versioning 2.0.0 version strings as follows: +# +# Human-readable Perl version Notes +# ------------------------------------------------------------------------------------------- +# 1.2.3-alpha v1.2.3.0_0 compares equal to Perl version v1.2.3 (unfortunately) +# 1.2.3-beta.N v1.2.3.0_N 1 <= N < 900; compares equal to Perl v1.2.3.N +# 1.2.3-rc.N v1.2.3.0_M 1 <= N < 99; M = N + 900; compares equal to Perl v1.2.3.M +# 1.2.3 v1.2.3.999 for releases; no underscore in Perl version string +# 1.2.3+r.N v1.2.3.999.N 1 <= N < 1000; for re-releases, if necessary (rare) +# +# A hyphen-minus ('-', a.k.a. dash) is used to separate "alpha", "beta", and "rc" from the version +# numbers because that is what requires. Tilde ('~') was +# considered instead of '-' because it has desirable semantics in the version comparison algorithms +# in Debian and RPM; see and +# +# However, tilde is not permitted in Git tags, so the human-readable version string would have to +# be transformed for release tags, and then transformed back by downstream package maintainers to +# reconstruct the original version string. As long as downstream package maintainers have to +# transform the tag name anyway, the human-readable version string might as well have the same +# format as the tag name. Version strings conforming to have +# this property. +# +# A period is required between "beta" or "rc" and its adjacent number(s) because +# says that parts containing non-number characters are +# compared lexicographically. For example, '-beta9' unfortunately sorts after '-beta10' but +# '-beta.9' sorts before '-beta.10', as desired. (Both the Debian and the RPM version comparison +# algorithms do not have this problem; they compare number parts numerically, not +# lexicographically, even if there is no period between the number and non-number characters.) +# +# A period is also required after the "r" for a re-release, but this is only for consistency with +# "beta" and "rc". says that build metadata (the stuff after +# the plus ('+') character) does not affect ordering at all so the lack of a period would not +# affect ordering. +# +# The Perl version is declared first then converted to a human-readable form. It would be nicer to +# declare a human-readable version string and convert that to a Perl version string, but various +# tools in the Perl ecosystem require the line of source code that defines the VERSION variable to +# be self-contained (because they grep the source code and evaluate only that one line). +# +# For consistency and to match user expectations, the release part of the version is always three +# components: MAJOR.MINOR.PATCH. +use version 0.77; our $VERSION = version->declare('v4.0.1.0_0'); + +sub parse_version { + my ($v) = @_; + # Matches a non-negative integer with 1-3 decimal digits (zero padding disallowed). + my $n = qr/0|[1-9]\d{0,2}/; + my $vre = qr/ + ^ + v # required "v" prefix + ((?:$n\.)*?$n) # release version (e.g., 1.2, 1.2.3, or 1.2.3.4) + \.(?: # release or pre-release suffix + 0_(?!999)($n)| # pre-release (alpha, beta, rc) revision + 999(?:\.($n))? # release with optional re-release revision + ) + $ + /x; + return $v =~ $vre; +} + +sub humanize_version { + my ($v) = @_; + my ($r, $pr, $rr) = parse_version($v); + return $v if !defined($r); + $v = $r; + if (!defined($pr)) { + $v .= "+r.$rr" if defined($rr); + } elsif ($pr eq '0') { + $v .= '-alpha'; + } elsif ($pr < 900) { + $v .= "-beta.$pr"; + } elsif ($pr < 999) { + $v .= '-rc.' . ($pr - 900); + } + return $v; +} + +our $version = humanize_version($VERSION); + my $programd = $0; $programd =~ s%^.*/%%; -my $program = $programd; +our $program = $programd; $program =~ s/d$//; -my $now = time; +our $now = time; my $hostname = hostname(); # subst_var(subst, default) returns subst unless it looks like @foo@ in which case it returns @@ -48,36 +132,69 @@ sub subst_var { return $subst; } -my $etc = subst_var('@sysconfdir@', '/etc/ddclient'); +my $etc = subst_var('@confdir@', '/etc/ddclient'); my $cachedir = subst_var('@localstatedir@', '/var') . '/cache/ddclient'; -my $savedir = '/tmp'; -if ($program =~ /test/i) { - $etc = '.'; - $cachedir = '.'; - $savedir = 'URL'; -} +our @curl = (subst_var('@CURL@', 'curl')); -my $msgs = ''; -my $last_msgs = ''; +our $emailbody = ''; +my $last_emailbody = ''; ## If run as *d (e.g., ddclientd) then daemonize by default (but allow ## flags and options to override). -my $daemon_default = ($programd =~ /d$/) ? interval('5m') : 0; +my $daemon_default = ($programd =~ /d$/) ? interval('5m') : undef; -use vars qw($file $lineno); -local $file = ''; -local $lineno = ''; +# Current Logger instance. To push a context prefix onto the context stack: +# local _l = pushlogctx('additional context goes here'); +our $_l = ddclient::Logger->new(); $ENV{'PATH'} = (exists($ENV{PATH}) ? "$ENV{PATH}:" : "") . "/sbin:/usr/sbin:/bin:/usr/bin:/etc:/usr/lib:"; our %globals; -my ($result, %config, %cache); -my $saved_cache; +our %config; + +# `%recap` holds details about recent updates (and attempts) that are needed to implement various +# service-specific and protocol-independent mechanisms such as `min-interval`. This data is +# persisted in the cache file (`--cache`) so that it survives ddclient restarts. This hash maps a +# hostname to a hashref with entries that map variable names to values. Only entries for the +# host's "recap variables" -- those declared in the host's protocol's `recapvars` property -- are +# included. +# +# There are two classes of recap variables: +# * "Status" variables: These track update success/failure, the IP address of the last successful +# update, etc. These do not hold configuration data; they are unrelated to any entries in +# `%config`. +# * "Configuration change detection" variables: These are used to force an update if the value in +# the same-named entry in `%config` has changed since the previous update attempt. The value +# stored in `%config` is the desired setting; the value in `%recap` is the desired setting as +# it was just before the previous update attempt. Values are synchronized from `%config` to +# `%recap` during each update attempt. +# +# A protocol's set of config change detection variables can be found in the protocol's +# `force_update_if_changed` property; all other recap variables are assumed to be status variables. +# +# A note about terminology: This was previously named `%cache`, but "cache" implies that the +# purpose is to reduce the cost or latency of data retrieval or computation, and that deletion only +# affects performance. That is not the case here, so the variable was renamed. "Recap" is meant +# to evoke the "previously on" clips that play before TV episodes, which are designed to give you +# just enough context to recall the state. The recap is written to the cache file, so-named for +# historical reasons. (Renaming "cache file" to "recap file" is more difficult due to +# compatibility concerns with the public `--cache` option.) +our %recap; + +my $result; +my $saved_recap; my %saved_opt; my $daemon; # Control how many times warning message logged for invalid IP addresses -my (%warned_ip, %warned_ipv4, %warned_ipv6); -my $inv_ip_warn_count = opt('max-warn') // 1; +my (%warned_ipv4, %warned_ipv6); + +sub repr { + my $vals = @_ % 2 ? [shift] : []; + my %opts = @_; + my $d = Data::Dumper->new($vals)->Sortkeys(1)->Terse(!exists($opts{Names}))->Useqq(1); + $d->$_($opts{$_}) for keys(%opts); + return $d->Dump(); +} sub T_ANY { 'any' } sub T_STRING { 'string' } @@ -88,10 +205,10 @@ 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_URL { 'url including fully qualified host name, optional port number, and path' } sub T_USE { 'ip strategy' } sub T_USEV4 { 'ipv4 strategy' } sub T_USEV6 { 'ipv6 strategy' } @@ -102,25 +219,105 @@ sub T_IPV4 { 'ipv4' } sub T_IPV6 { 'ipv6' } sub T_POSTS { 'postscript' } +# `%recapvars` contains common recap variable declarations that are used by multiple protocols (see +# the protocol `recapvars` property). +our %recapvars = ( + 'common' => { + 'host' => T_STRING, + 'protocol' => T_PROTO, + # The IPv4 address most recently saved at the DDNS service. + # TODO: This is independent of the `ipv4` configuration setting. Rename the `%recap` + # status variable to something like `saved-ipv4` to avoid confusion with the `%config` + # setting variable. + 'ipv4' => T_IPV4, + # As `ipv4`, but for an IPv6 address. + 'ipv6' => T_IPV6, + # Timestamp (seconds since epoch) indicating the earliest time the next update is + # permitted. + # TODO: Create a timestamp type and change this to that type. + 'wtime' => T_NUMBER, + # Timestamp (seconds since epoch) indicating when an IP address was last sent to the DDNS + # service, even if the IP address was not different from what was already stored. + # TODO: Create a timestamp type and change this to that type. + 'mtime' => T_NUMBER, + # Timestamp (seconds since epoch) of the most recent attempt to update the DDNS service + # (including attempts to update with the same IP address). This equals mtime if the most + # recent attempt was successful, otherwise it will be more recent than mtime. + # TODO: Create a timestamp type and change this to that type. + 'atime' => T_NUMBER, + # Disposition of the most recent (or currently in progress) attempt to update the DDNS + # service with the IP address in `wantipv4`. Anything other than `good`, including undef, + # is treated as a failure. + 'status-ipv4' => T_ANY, + # As `status-ipv4`, but with `wantipv6`. + 'status-ipv6' => T_ANY, + # Timestamp (seconds since epoch) of the most recent attempt that would have been made had + # `min-interval` not inhibited the attempt. This is reset to 0 once an attempt is actually + # made. This is used as a boolean to suppress repeated warnings to the user that indicate + # that `min-interval` has inhibited an update attempt. + # TODO: Change to a boolean and rename to improve readability. + 'warned-min-interval' => T_ANY, + # Timestamp (seconds since epoch) of the most recent attempt that would have been made had + # `min-error-interval` not inhibited the attempt. This is reset to 0 once an attempt is + # actually made. This is used as a boolean to suppress repeated warnings to the user that + # indicate that `min-error-interval` has inhibited an update attempt. + # TODO: Change to a boolean and rename to improve readability. + 'warned-min-error-interval' => T_ANY, + }, + 'dyndns-common' => { + 'backupmx' => T_BOOL, + 'mx' => T_FQDN, + 'wildcard' => T_BOOL, + }, +); + ## strategies for obtaining an ip address. -my %builtinweb = ( +our %builtinweb = ( 'dyndns' => {'url' => 'http://checkip.dyndns.org/', 'skip' => 'Current IP Address:'}, 'freedns' => {'url' => 'https://freedns.afraid.org/dynamic/check.php'}, - 'googledomains' => {'url' => 'https://domains.google.com/checkip'}, - 'he' => {'url' => 'http://checkip.dns.he.net/'}, - 'ip4only.me' => {'url' => 'http://ip4only.me/api/'}, - 'ip6only.me' => {'url' => 'http://ip6only.me/api/'}, + 'he' => { + url => 'https://checkip.dns.he.net/', + deprecated => "Use 'he.net' instead.", + }, + 'he.net' => {'url' => 'https://checkip.dns.he.net/'}, + 'ip4only.me' => {'url' => 'https://ip4only.me/api/'}, + 'ip6only.me' => {'url' => 'https://ip6only.me/api/'}, 'ipify-ipv4' => {'url' => 'https://api.ipify.org/'}, 'ipify-ipv6' => {'url' => 'https://api6.ipify.org/'}, - 'loopia' => {'url' => 'http://dns.loopia.se/checkip/checkip.php', 'skip' => 'Current IP Address:'}, + 'loopia' => {'url' => 'https://dns.loopia.se/checkip/checkip.php', 'skip' => 'Current IP Address:'}, 'myonlineportal' => {'url' => 'https://myonlineportal.net/checkip'}, 'noip-ipv4' => {'url' => 'http://ip1.dynupdate.no-ip.com/'}, 'noip-ipv6' => {'url' => 'http://ip1.dynupdate6.no-ip.com/'}, - 'nsupdate.info-ipv4' => {'url' => 'http://ipv4.nsupdate.info/myip'}, - 'nsupdate.info-ipv6' => {'url' => 'http://ipv6.nsupdate.info/myip'}, - 'zoneedit' => {'url' => 'http://dynamic.zoneedit.com/checkip.html'}, + 'nsupdate.info-ipv4' => {'url' => 'https://ipv4.nsupdate.info/myip'}, + 'nsupdate.info-ipv6' => {'url' => 'https://ipv6.nsupdate.info/myip'}, + 'zoneedit' => {'url' => 'https://dynamic.zoneedit.com/checkip.html'}, ); -my %builtinfw = ( + +sub query_cisco { + my ($asa, $v4, %p) = @_; + warning("'--if' is deprecated; use '--ifv4' instead") + if ($v4 && !defined($p{'ifv4'}) && defined($p{'if'})); + my $if = ($v4 ? $p{'ifv4'} : undef) // $p{'if'}; + my $fw = ($v4 ? $p{'fwv4'} : undef) // $p{'fw'}; + # Convert slashes to protected value "\/" + $if =~ s%\/%\\\/%g; + # Protect special HTML characters (like '?') + $if =~ s/([\?&= ])/sprintf("%%%02x", ord($1))/ge; + my $reply = geturl( + url => ($asa) + ? "https://$fw/exec/show%20interface%20$if" + : "http://$fw/level/1/exec/show/ip/interface/brief/$if/CR", + login => $p{'fw-login'}, + password => $p{'fw-password'}, + ignore_ssl_option => 1, + ssl_validate => $p{'fw-ssl-validate'}, + ); + return undef if !header_ok($reply, \&warning); + $reply =~ s/^.*?\n\n//s; + return $reply; +} + +our %builtinfw = ( '2wire' => { 'name' => '2Wire 1701HG Gateway', 'url' => '/xslt?PAGE=B01', @@ -161,6 +358,22 @@ my %builtinfw = ( 'url' => '/shell/show+ip+interfaces', 'skip' => '.*inet', }, + 'cisco' => { + 'name' => 'Cisco FW', + 'query' => sub { return query_cisco(0, 0, @_); }, + 'inputs' => ['fw', 'if', 'fw-login', 'fw-password', 'fw-ssl-validate'], + 'queryv4' => sub { return query_cisco(0, 1, @_); }, + 'inputsv4' => ['fwv4', 'fw', 'ifv4', 'if', 'fw-login', 'fw-password', 'fw-ssl-validate'], + 'help' => sub { return " at the host given by --fw$_[0]= and interface given by --if$_[0]="; }, + }, + 'cisco-asa' => { + 'name' => 'Cisco ASA', + 'query' => sub { return query_cisco(1, 0, @_); }, + 'inputs' => ['fw', 'if', 'fw-login', 'fw-password', 'fw-ssl-validate'], + 'queryv4' => sub { return query_cisco(1, 1, @_); }, + 'inputsv4' => ['fwv4', 'fw', 'ifv4', 'if', 'fw-login', 'fw-password', 'fw-ssl-validate'], + 'help' => sub { return " at the host given by --fw$_[0]= and interface given by --if$_[0]="; }, + }, 'dlink-524' => { 'name' => 'D-Link DI-524', 'url' => '/st_device.html', @@ -358,606 +571,890 @@ my %builtinfw = ( }, ); -my %ip_strategies = ( - 'no' => ": deprecated, see 'usev4' and 'usev6'", - 'ip' => ": deprecated, see 'usev4' and 'usev6'", - 'web' => ": deprecated, see 'usev4' and 'usev6'", - 'fw' => ": deprecated, see 'usev4' and 'usev6'", - 'if' => ": deprecated, see 'usev4' and 'usev6'", - 'cmd' => ": deprecated, see 'usev4' and 'usev6'", - 'cisco' => ": deprecated, see 'usev4' and 'usev6'", - 'cisco-asa' => ": deprecated, see 'usev4' and 'usev6'", - map({ $_ => sprintf(": Built-in firewall %s deprecated, see 'usev4' and 'usev6'", - $builtinfw{$_}->{'name'}) } - keys(%builtinfw)), +sub builtinfw_strategy { + my ($n) = @_; + my $fw = $builtinfw{$n}; + return ($n => { + help => ": deprecated, see '--usev4=$n'" . + (defined($fw->{queryv6}) ? " and '--usev6=$n'" : ''), + inputs => $fw->{inputs} // ['fw', 'fw-skip', 'fw-login', 'fw-password', 'fw-ssl-validate'], + }); +} + +our %ip_strategies = ( + 'disabled' => {help => ": do not use a deprecated method to obtain an IP address for this host", + inputs => []}, + 'no' => {help => ": deprecated, see '--use=disabled'", + inputs => []}, + 'ip' => {help => ": deprecated, see '--usev4=ipv4' and '--usev6=ipv6'", + inputs => ['ip']}, + 'web' => {help => ": deprecated, see '--usev4=webv4' and '--usev6=webv6'", + inputs => ['web', 'web-skip', 'proxy', 'web-ssl-validate']}, + 'fw' => {help => ": deprecated, see '--usev4=fwv4' and '--usev6=fwv6'", + inputs => ['fw', 'fw-skip', 'fw-login', 'fw-password', 'fw-ssl-validate']}, + 'if' => {help => ": deprecated, see '--usev4=ifv4' and '--usev6=ifv6'", + inputs => ['if']}, + 'cmd' => {help => ": deprecated, see '--usev4=cmdv4' and '--usev6=cmdv6'", + inputs => ['cmd', 'cmd-skip']}, + map(builtinfw_strategy($_), keys(%builtinfw)), ); sub ip_strategies_usage { - return map({ sprintf(" -use=%-22s %s.", $_, $ip_strategies{$_}) } - ('ip', 'web', 'if', 'cmd', 'fw', sort('cisco', 'cisco-asa', keys(%builtinfw)))); -} - -my %ipv4_strategies = ( - 'disabled' => ": do not obtain an IPv4 address for this host", - 'ipv4' => ": obtain IPv4 from -ipv4 {address}", - 'webv4' => ": obtain IPv4 from an IP discovery page on the web", - 'ifv4' => ": obtain IPv4 from the -ifv4 {interface}", - 'cmdv4' => ": obtain IPv4 from the -cmdv4 {external-command}", - 'fwv4' => ": obtain IPv4 from the firewall specified by -fwv4 {type|address}", - 'ciscov4' => ": obtain IPv4 from Cisco FW at the -fwv4 {address}", - 'cisco-asav4' => ": obtain IPv4 from Cisco ASA at the -fwv4 {address}", - map { $_ => sprintf ": obtain IPv4 from %s at the -fwv4 {address}", $builtinfw{$_}->{'name'} } keys %builtinfw, + return map({ sprintf(" --use=%-22s %s.", $_, $ip_strategies{$_}{help}); } + 'disabled', 'no', 'ip', 'web', 'if', 'cmd', 'fw', sort(keys(%builtinfw))); +} + +sub builtinfwv4_strategy { + my ($n) = @_; + my $fw = $builtinfw{$n}; + return ($n => { + help => defined($fw->{queryv4}) + ? ": obtain IPv4 from $fw->{name}@{[($fw->{help} // sub {})->('v4') // '']}" + : ": obtain IPv4 from $fw->{name} at the host or URL given by --fwv4=", + inputs => $fw->{inputsv4} // ['fwv4', 'fw', 'fwv4-skip', 'fw-skip', 'fw-login', + 'fw-password', 'fw-ssl-validate'], + }); +} + +our %ipv4_strategies = ( + 'disabled' => {help => ": do not obtain an IPv4 address for this host (except possibly via the deprecated '--use' option, if it is enabled)", + inputs => []}, + 'ipv4' => {help => ": obtain IPv4 from the address given by --ipv4=
", + inputs => ['ipv4']}, + 'webv4' => {help => ": obtain IPv4 from an IP discovery page on the web", + inputs => ['webv4', 'webv4-skip', 'proxy', 'web-ssl-validate']}, + 'ifv4' => {help => ": obtain IPv4 from the interface given by --ifv4=", + inputs => ['ifv4']}, + 'cmdv4' => {help => ": obtain IPv4 from the command given by --cmdv4=", + inputs => ['cmdv4', 'cmd-skip']}, + 'fwv4' => {help => ": obtain IPv4 from the URL given by --fwv4=", + inputs => ['fwv4', 'fw', 'fwv4-skip', 'fw-skip', 'fw-login', 'fw-password', 'fw-ssl-validate']}, + map(builtinfwv4_strategy($_), keys(%builtinfw)), ); sub ipv4_strategies_usage { - return map { sprintf(" -usev4=%-22s %s.", $_, $ipv4_strategies{$_}) } sort keys %ipv4_strategies; -} - -my %ipv6_strategies = ( - 'no' => ": deprecated, use 'disabled'", - 'disabled' => ": do not obtain an IPv6 address for this host", - 'ip' => ": deprecated, use 'ipv6'", - 'ipv6' => ": obtain IPv6 from -ipv6 {address}", - 'web' => ": deprecated, use 'webv6'", - 'webv6' => ": obtain IPv6 from an IP discovery page on the web", - 'if' => ": deprecated, use 'ifv6'", - 'ifv6' => ": obtain IPv6 from the -if {interface}", - 'cmd' => ": deprecated, use 'cmdv6'", - 'cmdv6' => ": obtain IPv6 from the -cmdv6 {external-command}", - 'fwv6' => ": obtain IPv6 from the firewall specified by -fwv6 {type|address}", - 'ciscov6' => ": obtain IPv6 from Cisco FW at the -fwv6 {address}", - 'cisco-asav6' => ": obtain IPv6 from Cisco ASA at the -fwv6 {address}", - map { $_ => sprintf ": obtain IPv6 from %s at the -fwv6 {address}", $builtinfw{$_}->{'name'} } keys %builtinfw, + return map({ sprintf(" --usev4=%-22s %s.", $_, $ipv4_strategies{$_}{help}) } + 'disabled', 'ipv4', 'webv4', 'ifv4', 'cmdv4', 'fwv4', sort(keys(%builtinfw))); +} + +sub builtinfwv6_strategy { + my ($n) = @_; + my $fw = $builtinfw{$n}; + return defined($fw->{queryv6}) + ? ($n => { + help => ": obtain IPv6 from $fw->{name}@{[($fw->{help} // sub {})->('v6') // '']}", + inputs => $fw->{inputsv6} // ['fwv6', 'fwv6-skip'], + }) + : (); +} + +our %ipv6_strategies = ( + 'disabled' => {help => ": do not obtain an IPv6 address for this host (except possibly via the deprecated '--use' option, if it is enabled)", + inputs => []}, + 'no' => {help => ": deprecated, use '--usev6=disabled'", + inputs => []}, + 'ipv6' => {help => ": obtain IPv6 from the address given by --ipv6=
", + inputs => ['ipv6', 'ip']}, + 'ip' => {help => ": deprecated, use '--usev6=ipv6'", + inputs => ['ipv6', 'ip']}, + 'webv6' => {help => ": obtain IPv6 from an IP discovery page on the web", + inputs => ['webv6', 'web', 'webv6-skip', 'web-skip', 'proxy', 'web-ssl-validate']}, + 'web' => {help => ": deprecated, use '--usev6=webv6'", + inputs => ['webv6', 'web', 'webv6-skip', 'web-skip', 'proxy', 'web-ssl-validate']}, + 'ifv6' => {help => ": obtain IPv6 from the interface given by --ifv6=", + inputs => ['ifv6', 'if']}, + 'if' => {help => ": deprecated, use '--usev6=ifv6'", + inputs => ['ifv6', 'if']}, + 'cmdv6' => {help => ": obtain IPv6 from the command given by --cmdv6=", + inputs => ['cmdv6', 'cmd', 'cmd-skip']}, + 'cmd' => {help => ": deprecated, use '--usev6=cmdv6'", + inputs => ['cmdv6', 'cmd', 'cmd-skip']}, + 'fwv6' => {help => ": obtain IPv6 from the URL given by --fwv6=", + inputs => ['fwv6', 'fwv6-skip']}, + map(builtinfwv6_strategy($_), keys(%builtinfw)), ); sub ipv6_strategies_usage { - return map { sprintf(" -usev6=%-22s %s.", $_, $ipv6_strategies{$_}) } sort keys %ipv6_strategies; + return map({ sprintf(" --usev6=%-22s %s.", $_, $ipv6_strategies{$_}{help}) } + 'disabled', 'no', 'ipv6', 'ip', 'webv6', 'web', 'ifv6', 'if', 'cmdv6', 'cmd', + 'fwv6', sort(map({exists($ipv6_strategies{$_}) ? ($_) : ()} keys(%builtinfw)))); } sub setv { return { 'type' => shift, 'required' => shift, - 'cache' => shift, 'default' => shift, 'minimum' => shift, }; } -my %variables = ( +our %cfgvars = ( '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), - 'usev4' => setv(T_USEV4, 0, 0, 'disabled', undef), - 'usev6' => setv(T_USEV6, 0, 0, 'disabled', undef), - 'ip' => setv(T_IP, 0, 0, undef, undef), - 'ipv4' => setv(T_IPV4, 0, 0, undef, undef), - 'ipv6' => setv(T_IPV6, 0, 0, undef, undef), - 'if' => setv(T_IF, 0, 0, 'ppp0', undef), - 'ifv4' => setv(T_IF, 0, 0, 'default', undef), - 'ifv6' => setv(T_IF, 0, 0, 'default', undef), - 'web' => setv(T_STRING,0, 0, 'dyndns', undef), - 'web-skip' => setv(T_STRING,1, 0, '', undef), - 'webv4' => setv(T_STRING,0, 0, 'googledomains', undef), - 'webv4-skip' => setv(T_STRING,1, 0, '', undef), - 'webv6' => setv(T_STRING,0, 0, 'googledomains', undef), - 'webv6-skip' => setv(T_STRING,1, 0, '', undef), - 'fw' => setv(T_ANY, 0, 0, '', undef), - 'fw-skip' => setv(T_STRING,1, 0, '', undef), - 'fwv4' => setv(T_ANY, 0, 0, '', undef), - 'fwv4-skip' => setv(T_STRING,1, 0, '', undef), - 'fwv6' => setv(T_ANY, 0, 0, '', undef), - 'fwv6-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), - 'cmdv4' => setv(T_PROG, 0, 0, '', undef), - 'cmdv6' => setv(T_PROG, 0, 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), - '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), - 'max-warn' => setv(T_NUMBER,0, 0, 1, undef), - - 'exec' => setv(T_BOOL, 0, 0, 1, undef), - 'debug' => setv(T_BOOL, 0, 0, 0, undef), - 'verbose' => setv(T_BOOL, 0, 0, 0, undef), - 'quiet' => setv(T_BOOL, 0, 0, 0, undef), - 'help' => setv(T_BOOL, 0, 0, 0, undef), - 'test' => setv(T_BOOL, 0, 0, 0, undef), - '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), + 'daemon' => setv(T_DELAY, 0, $daemon_default, interval('60s')), + 'foreground' => setv(T_BOOL, 0, 0, undef), + 'file' => setv(T_FILE, 0, "$etc/$program.conf", undef), + 'cache' => setv(T_FILE, 0, "$cachedir/$program.cache", undef), + 'pid' => setv(T_FILE, 0, undef, undef), + 'proxy' => setv(T_FQDNP, 0, undef, undef), + 'protocol' => setv(T_PROTO, 0, 'dyndns2', undef), + + 'timeout' => setv(T_DELAY, 0, interval('120s'), interval('120s')), + 'force' => setv(T_BOOL, 0, 0, undef), + 'ssl' => setv(T_BOOL, 0, 1, undef), + 'syslog' => setv(T_BOOL, 0, 0, undef), + 'facility' => setv(T_STRING,0, 'daemon', undef), + 'priority' => setv(T_STRING,0, 'notice', undef), + 'mail' => setv(T_EMAIL, 0, undef, undef), + 'mail-failure' => setv(T_EMAIL, 0, undef, undef), + 'mail-from' => setv(T_EMAIL, 0, undef, undef), + 'max-warn' => setv(T_NUMBER,0, 1, undef), + + 'exec' => setv(T_BOOL, 0, 1, undef), + 'debug' => setv(T_BOOL, 0, 0, undef), + 'verbose' => setv(T_BOOL, 0, 0, undef), + 'quiet' => setv(T_BOOL, 0, 0, undef), + 'test' => setv(T_BOOL, 0, 0, undef), + + 'postscript' => setv(T_POSTS, 0, undef, undef), + 'ssl_ca_dir' => setv(T_FILE, 0, undef, undef), + 'ssl_ca_file' => setv(T_FILE, 0, undef, undef), + 'redirect' => setv(T_NUMBER,0, 0, undef) }, - '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), - 'ip' => setv(T_IP, 0, 1, undef, undef), #TODO remove from cache? - 'ipv4' => setv(T_IPV4, 0, 1, undef, undef), - 'ipv6' => setv(T_IPV6, 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), #TODO remove from cache? - 'status-ipv4' => setv(T_ANY, 0, 1, '', undef), - 'status-ipv6' => 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), + 'protocol-common-defaults' => { + 'server' => setv(T_FQDNP, 0, 'members.dyndns.org', undef), + 'login' => setv(T_LOGIN, 1, undef, undef), + 'password' => setv(T_PASSWD,1, undef, undef), + 'host' => setv(T_STRING,1, undef, undef), + + 'use' => setv(T_USE, 0, sub { + my ($h) = @_; + return "'disabled' if '--usev4' or '--usev6' is enabled, otherwise 'ip'" + if ($h // '') eq ''; + return 'disabled' if opt('usev4', $h) ne 'disabled' || opt('usev6', $h) ne 'disabled'; + return 'ip'; + }, undef), + 'usev4' => setv(T_USEV4, 0, 'disabled', undef), + 'usev6' => setv(T_USEV6, 0, 'disabled', undef), + 'if' => setv(T_IF, 0, 'ppp0', undef), + 'ifv4' => setv(T_IF, 0, 'default', undef), + 'ifv6' => setv(T_IF, 0, 'default', undef), + 'web' => setv(T_STRING,0, 'dyndns', undef), + 'web-skip' => setv(T_STRING,0, undef, undef), + 'web-ssl-validate' => setv(T_BOOL, 0, 1, undef), + 'webv4' => setv(T_STRING,0, 'ipify-ipv4', undef), + 'webv4-skip' => setv(T_STRING,0, undef, undef), + 'webv6' => setv(T_STRING,0, 'ipify-ipv6', undef), + 'webv6-skip' => setv(T_STRING,0, undef, undef), + 'fw' => setv(T_ANY, 0, undef, undef), + 'fw-skip' => setv(T_STRING,0, undef, undef), + 'fw-login' => setv(T_LOGIN, 0, undef, undef), + 'fw-password' => setv(T_PASSWD,0, undef, undef), + 'fw-ssl-validate' => setv(T_BOOL, 0, 1, undef), + 'fwv4' => setv(T_ANY, 0, undef, undef), + 'fwv4-skip' => setv(T_STRING,0, undef, undef), + 'fwv6' => setv(T_ANY, 0, undef, undef), + 'fwv6-skip' => setv(T_STRING,0, undef, undef), + 'cmd' => setv(T_PROG, 0, undef, undef), + 'cmd-skip' => setv(T_STRING,0, undef, undef), + 'cmdv4' => setv(T_PROG, 0, undef, undef), + 'cmdv6' => setv(T_PROG, 0, undef, undef), + 'min-interval' => setv(T_DELAY, 0, interval('30s'), 0), + 'max-interval' => setv(T_DELAY, 0, interval('25d'), 0), + 'min-error-interval' => setv(T_DELAY, 0, interval('5m'), 0), + 'ip' => setv(T_IP, 0, undef, undef), + 'ipv4' => setv(T_IPV4, 0, undef, undef), + 'ipv6' => setv(T_IPV6, 0, undef, undef), }, 'dyndns-common-defaults' => { - 'backupmx' => setv(T_BOOL, 0, 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), - }, - 'dnsexit-common-defaults' => { - 'ssl' => setv(T_BOOL, 0, 0, 0, undef), - 'server' => setv(T_FQDNP, 1, 0, 'update.dnsexit.com', undef), - 'script' => setv(T_STRING, 0, 1, '/RemoteUpdate.sv', undef), - 'min-error-interval' => setv(T_DELAY, 0, 0, interval('8m'), 0), + 'backupmx' => setv(T_BOOL, 0, 0, undef), + 'mx' => setv(T_FQDN, 0, undef, undef), + 'wildcard' => setv(T_BOOL, 0, 0, undef), }, ); -my %services = ( - 'changeip' => { - 'updateable' => undef, + +{ + package ddclient::Protocol; + + # Keyword arguments: + # * `update`: Required coderef that takes `($self, @hosts)` and updates the given hosts. + # * `examples`: Required coderef that takes `($self)` and returns a string showing + # configuration examples for using the protocol. + # * `cfgvars`: Optional hashref of configuration variable declarations. If omitted or + # `undef`, `$cfgvars{'protocol-common-defaults'}` is used. + # * `recapvars`: Optional hashref of recap variable declarations. If omitted or `undef`, + # `$recapvars{'common'}` is used. + # * `force_update`: Optional coderef that takes `($self, $h)` and returns truthy to force the + # given host to update. Omitting or passing `undef` is equivalent to passing a subroutine + # that always returns falsy. + # * `force_update_if_changed`: Optional arrayref of variable names to watch for changes. If + # any of the named values in `%config` have changed since the previous update attempt + # (successful or not), the host update is forced. If omitted or `undef`, an empty array is + # used. + sub new { + my ($class, %args) = @_; + my $self = bless({%args}, $class); + # Set defaults and normalize. + $self->{cfgvars} //= $ddclient::cfgvars{'protocol-common-defaults'}; + $self->{recapvars} //= $ddclient::recapvars{'common'}; + for my $varset (qw(cfgvars recapvars)) { + $self->{$varset} = {%{$self->{$varset}}}; # Shallow clone. + # Delete `undef` variable declarations to make it easier to cancel previously declared + # variables. + delete($self->{$varset}{$_}) for grep(!defined($self->{$varset}{$_}), + keys(%{$self->{$varset}})); + } + $self->{force_update} //= sub { return 0; }; + $self->{force_update_if_changed} //= []; + # Eliminate duplicates and non-recap variables. + my %fvs = map({ ($_ => undef); } @{$self->{force_update_if_changed}}, 'protocol'); + $self->{force_update_if_changed} = + [grep({ $self->{cfgvars}{$_} && $self->{recapvars}{$_}; } sort(keys(%fvs)))]; + return $self; + } + + sub force_update { + my ($self, $h) = @_; + my @changed = grep({ + my $rv = $ddclient::recap{$h}{$_}; + my $cv = ddclient::opt($_, $h); + return defined($rv) && defined($cv) && $rv ne $cv; + } @{$self->{force_update_if_changed}}); + if (@changed) { + ddclient::info("update forced because options changed: " . join(', ', @changed)); + return 1; + } + my $f = $self->{force_update}; + return $f if ref($f) ne 'CODE'; + return $f->($self, $h); + } + + sub update { + my ($self, @hosts) = @_; + for my $h (@hosts) { + $ddclient::recap{$h}{'atime'} = $now; + delete($ddclient::recap{$h}{$_}) for qw(status-ipv4 status-ipv6 wtime + warned-min-interval warned-min-error-interval); + # Update the configuration change detection variables. The vars are updated regardless + # of whether the update actually succeeds because update failures should be retried at + # the error retry rate (`min-error-interval`), not forced by `force_update`. Notes + # about why the recap vars are updated here in this method: + # * The vars must not be updated if the host is not being updated because change + # detection is defined relative to the previous update attempt. In particular, + # these can't be updated when the protocol's `force_update` method is called + # because that method is not always called before an update is attempted. + # * The vars must be updated after the `force_update` method would be called so that + # `force_update` can check whether any settings have changed since the last time an + # update was attempted. + # * The vars are updated before the protocol's `update` method is called so that + # `update` sees consistent values between `%recap` and `%config`. This reduces the + # impact of Hyrum's Law; if a protocol needs a variable to be updated after the + # `update` method is called then that behavior should be made explicit. + for my $v (@{$self->{force_update_if_changed}}) { + if (defined(my $val = ddclient::opt($v, $h))) { + $ddclient::recap{$h}{$v} = $val; + } else { + # Entries in `%recap` with `undef` values are deleted to avoid needing to + # figure out how to represent `undef` in the cache file and to simplify + # testing. + delete($ddclient::recap{$h}{$v}); + } + } + } + $self->_update(@hosts); + } + + sub _update { + my $self = shift; + $self->{update}($self, @_); + } + + sub examples { + my ($self) = @_; + return $self->{examples}($self); + } +} + +{ + # A legacy protocol implementation reads `$config{$h}{wantip}` and sets `$recap{$h}{status}` + # and `$recap{$h}{ip}`, rather than reading `wantipv4` and `wantipv6` and setting + # `status-ipv4`, `status-ipv6`, `ipv4`, and `ipv6`. + package ddclient::LegacyProtocol; + use parent qw(-norequire ddclient::Protocol); + + sub _update { + my ($self, @hosts) = @_; + my %ipv; + for my $h (@hosts) { + $ipv{$h} = defined($ddclient::config{$h}{'wantipv4'}) ? '4' : '6'; + $ddclient::config{$h}{'wantip'} //= delete($ddclient::config{$h}{"wantipv$ipv{$h}"}); + delete($ddclient::recap{$h}{$_}) for qw(ip status); + } + $self->SUPER::_update(@hosts); + for my $h (@hosts) { + local $ddclient::_l = ddclient::pushlogctx($h); + delete($ddclient::config{$h}{'wantip'}); + ddclient::debug( + "legacy protocol; moving 'status' to 'status-ipv$ipv{$h}', 'ip' to 'ipv$ipv{$h}'"); + $ddclient::recap{$h}{"status-ipv$ipv{$h}"} = delete($ddclient::recap{$h}{'status'}); + $ddclient::recap{$h}{"ipv$ipv{$h}"} = delete($ddclient::recap{$h}{'ip'}); + } + } +} + +our %protocols = ( + '1984' => ddclient::LegacyProtocol->new( + 'update' => \&nic_1984_update, + 'examples' => \&nic_1984_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => undef, + 'server' => setv(T_FQDNP, 0, 'api.1984.is', undef), + }, + ), + 'changeip' => ddclient::LegacyProtocol->new( 'update' => \&nic_changeip_update, 'examples' => \&nic_changeip_examples, - '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), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'server' => setv(T_FQDNP, 0, 'nic.changeip.com', undef), }, - }, - 'cloudflare' => { - 'updateable' => undef, + ), + 'cloudflare' => ddclient::Protocol->new( '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), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => setv(T_LOGIN, 0, 'token', undef), + 'min-interval' => setv(T_DELAY, 0, interval('5m'), 0), + 'server' => setv(T_FQDNP, 0, 'api.cloudflare.com/client/v4', undef), + 'zone' => setv(T_FQDN, 1, undef, undef), }, - }, - 'cloudns' => { - 'updateable' => undef, + ), + 'cloudns' => ddclient::LegacyProtocol->new( '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), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => undef, + 'password' => undef, + 'dynurl' => setv(T_STRING, 1, undef, undef), }, - }, - 'dinahosting' => { - 'updateable' => undef, + ), + 'ddns.fm' => ddclient::Protocol->new( + 'update' => \&nic_ddnsfm_update, + 'examples' => \&nic_ddnsfm_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => undef, + 'server' => setv(T_FQDNP, 0, 'https://api.ddns.fm', undef), + }, + ), + 'digitalocean' => ddclient::Protocol->new( + 'update' => \&nic_digitalocean_update, + 'examples' => \&nic_digitalocean_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => undef, + 'server' => setv(T_FQDNP, 0, 'api.digitalocean.com', undef), + 'zone' => setv(T_FQDN, 1, undef, undef), + }, + ), + 'dinahosting' => ddclient::LegacyProtocol->new( 'update' => \&nic_dinahosting_update, 'examples' => \&nic_dinahosting_examples, - '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), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'min-error-interval' => setv(T_DELAY, 0, interval('8m'), 0), + 'script' => setv(T_STRING, 0, '/special/api.php', undef), + 'server' => setv(T_FQDNP, 0, 'dinahosting.com', undef), }, - }, - 'dnsmadeeasy' => { - 'updateable' => undef, + ), + 'directnic' => ddclient::Protocol->new( + 'update' => \&nic_directnic_update, + 'examples' => \&nic_directnic_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => undef, + 'password' => undef, + 'urlv4' => setv(T_URL, 0, undef, undef), + 'urlv6' => setv(T_URL, 0, undef, undef), + }, + ), + 'dnsmadeeasy' => ddclient::LegacyProtocol->new( 'update' => \&nic_dnsmadeeasy_update, 'examples' => \&nic_dnsmadeeasy_examples, - 'variables' => { - %{$variables{'service-common-defaults'}}, - 'script' => setv(T_STRING, 1, 1, '/servlet/updateip', undef), - 'server' => setv(T_FQDNP, 1, 0, 'cp.dnsmadeeasy.com', undef), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'script' => setv(T_STRING, 0, '/servlet/updateip', undef), + 'server' => setv(T_FQDNP, 0, 'cp.dnsmadeeasy.com', undef), }, - }, - 'dondominio' => { - 'updateable' => undef, + ), + 'dondominio' => ddclient::LegacyProtocol->new( 'update' => \&nic_dondominio_update, 'examples' => \&nic_dondominio_examples, - 'variables' => { - %{$variables{'service-common-defaults'}}, - 'server' => setv(T_FQDNP, 1, 0, 'dondns.dondominio.com', undef), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'server' => setv(T_FQDNP, 0, 'dondns.dondominio.com', undef), }, - }, - 'dslreports1' => { - 'updateable' => undef, + ), + 'dslreports1' => ddclient::LegacyProtocol->new( '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), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'server' => setv(T_FQDNP, 0, 'www.dslreports.com', undef), }, - }, - 'duckdns' => { - 'updateable' => undef, + ), + 'domeneshop' => ddclient::Protocol->new( + 'update' => \&nic_domeneshop_update, + 'examples' => \&nic_domeneshop_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'server' => setv(T_FQDNP, 0, 'api.domeneshop.no', undef), + }, + ), + 'duckdns' => ddclient::Protocol->new( 'update' => \&nic_duckdns_update, 'examples' => \&nic_duckdns_examples, - 'variables' => { - %{$variables{'service-common-defaults'}}, - 'login' => setv(T_LOGIN, 0, 0, 'unused', undef), - 'server' => setv(T_FQDNP, 1, 0, 'www.duckdns.org', undef), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => undef, + 'server' => setv(T_FQDNP, 0, 'www.duckdns.org', undef), }, - }, - 'dyndns1' => { - 'updateable' => \&nic_dyndns2_updateable, + ), + 'dyndns1' => ddclient::LegacyProtocol->new( 'update' => \&nic_dyndns1_update, 'examples' => \&nic_dyndns1_examples, - 'variables' => { - %{$variables{'service-common-defaults'}}, - %{$variables{'dyndns-common-defaults'}}, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + %{$cfgvars{'dyndns-common-defaults'}}, + 'static' => setv(T_BOOL, 0, 0, undef), }, - }, - 'dyndns2' => { - 'updateable' => \&nic_dyndns2_updateable, + 'recapvars' => { + %{$recapvars{'common'}}, + %{$recapvars{'dyndns-common'}}, + 'static' => T_BOOL, + }, + 'force_update_if_changed' => [qw(static wildcard mx backupmx)], + ), + 'dyndns2' => ddclient::Protocol->new( 'update' => \&nic_dyndns2_update, 'examples' => \&nic_dyndns2_examples, - '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), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + %{$cfgvars{'dyndns-common-defaults'}}, + 'script' => setv(T_STRING, 0, '/nic/update', undef), }, - }, - 'easydns' => { - 'updateable' => undef, + 'recapvars' => { + %{$recapvars{'common'}}, + %{$recapvars{'dyndns-common'}}, + }, + 'force_update_if_changed' => [qw(wildcard mx backupmx)], + ), + 'easydns' => ddclient::Protocol->new( 'update' => \&nic_easydns_update, 'examples' => \&nic_easydns_examples, - '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, 'api.cp.easydns.com', undef), - 'script' => setv(T_STRING, 1, 1, '/dyn/generic.php', undef), - 'wildcard' => setv(T_BOOL, 0, 1, 0, undef), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'backupmx' => setv(T_BOOL, 0, 0, undef), + # From : "You need to wait at least 10 + # minutes between updates." + 'min-interval' => setv(T_DELAY, 0, interval('10m'), 0), + 'mx' => setv(T_FQDN, 0, undef, undef), + 'server' => setv(T_FQDNP, 0, 'api.cp.easydns.com', undef), + 'script' => setv(T_STRING, 0, '/dyn/generic.php', undef), + 'wildcard' => setv(T_BOOL, 0, 0, undef), }, - }, - 'freedns' => { - 'updateable' => undef, + 'recapvars' => { + %{$recapvars{'common'}}, + %{$recapvars{'dyndns-common'}}, + }, + 'force_update_if_changed' => [qw(wildcard mx backupmx)], + ), + 'freedns' => ddclient::Protocol->new( 'update' => \&nic_freedns_update, 'examples' => \&nic_freedns_examples, - '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), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'min-interval' => setv(T_DELAY, 0, interval('5m'), interval('5m')), + 'server' => setv(T_FQDNP, 0, 'freedns.afraid.org', undef), }, - }, - 'freemyip' => { - 'updateable' => undef, + ), + 'freemyip' => ddclient::LegacyProtocol->new( '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), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => undef, + 'server' => setv(T_FQDNP, 0, 'freemyip.com', undef), }, - }, - 'gandi' => { - 'updateable' => undef, + ), + 'gandi' => ddclient::Protocol->new( '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), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => undef, + 'min-interval' => setv(T_DELAY, 0, interval('5m'), interval('5m')), + 'server' => setv(T_FQDNP, 0, 'api.gandi.net', undef), + 'script' => setv(T_STRING, 0, '/v5', undef), + 'use-personal-access-token' => setv(T_BOOL, 0, 0, undef), + 'ttl' => setv(T_DELAY, 0, undef, interval('5m')), + 'zone' => setv(T_FQDN, 1, undef, undef), + } + ), + 'godaddy' => ddclient::Protocol->new( + 'update' => \&nic_godaddy_update, + 'examples' => \&nic_godaddy_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'min-interval' => setv(T_DELAY, 0, interval('5m'), 0), + 'server' => setv(T_FQDNP, 0, 'api.godaddy.com/v1/domains', undef), + 'ttl' => setv(T_NUMBER, 0, 600, undef), + 'zone' => setv(T_FQDN, 1, undef, undef), }, - }, - 'namecheap' => { - 'updateable' => undef, + ), + 'he.net' => ddclient::Protocol->new( + 'update' => \&nic_henet_update, + 'examples' => \&nic_henet_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => undef, + 'min-interval' => setv(T_DELAY, 0, interval('5m'), 0), + 'server' => setv(T_FQDNP, 0, 'dyn.dns.he.net', undef), + }, + ), + 'hetzner' => ddclient::Protocol->new( + 'update' => \&nic_hetzner_update, + 'examples' => \&nic_hetzner_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => undef, + 'min-interval' => setv(T_DELAY, 0, interval('1m'), 0), + 'server' => setv(T_FQDNP, 0, 'dns.hetzner.com/api/v1', undef), + 'ttl' => setv(T_NUMBER, 0, 60, 60), + 'zone' => setv(T_FQDN, 1, undef, undef), + }, + ), + 'inwx' => ddclient::Protocol->new( + 'update' => \&nic_inwx_update, + 'examples' => \&nic_inwx_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'server' => setv(T_FQDNP, 0, 'dyndns.inwx.com', undef), + 'script' => setv(T_STRING, 0, '/nic/update', undef), + }, + ), + 'mythicdyn' => ddclient::Protocol->new( + 'update' => \&nic_mythicdyn_update, + 'examples' => \&nic_mythicdyn_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'min-interval' => setv(T_DELAY, 0, interval('5m'), 0), + 'server' => setv(T_FQDNP, 0, 'api.mythic-beasts.com', undef), + }, + ), + 'namecheap' => ddclient::LegacyProtocol->new( 'update' => \&nic_namecheap_update, 'examples' => \&nic_namecheap_examples, - '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), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'min-interval' => setv(T_DELAY, 0, interval('5m'), interval('5m')), + 'server' => setv(T_FQDNP, 0, 'dynamicdns.park-your-domain.com', undef), }, - }, - 'nfsn' => { - 'updateable' => undef, + ), + 'nfsn' => ddclient::LegacyProtocol->new( '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), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'min-interval' => setv(T_DELAY, 0, interval('5m'), interval('5m')), + 'server' => setv(T_FQDNP, 0, 'api.nearlyfreespeech.net', undef), + 'ttl' => setv(T_NUMBER, 0, 300, undef), + 'zone' => setv(T_FQDN, 1, undef, undef), }, - }, - 'noip' => { - 'updateable' => undef, + ), + 'njalla' => ddclient::Protocol->new( + 'update' => \&nic_njalla_update, + 'examples' => \&nic_njalla_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => undef, + 'server' => setv(T_FQDNP, 0, 'njal.la', undef), + 'quietreply' => setv(T_BOOL, 0, 0, undef), + }, + ), + 'noip' => ddclient::Protocol->new( 'update' => \&nic_noip_update, 'examples' => \&nic_noip_examples, - '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')), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'server' => setv(T_FQDNP, 0, 'dynupdate.no-ip.com', undef), }, - }, - 'nsupdate' => { - 'updateable' => undef, + ), + 'nsupdate' => ddclient::Protocol->new( '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), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => setv(T_LOGIN, 0, '/usr/bin/nsupdate', undef), + 'tcp' => setv(T_BOOL, 0, 0, undef), + 'ttl' => setv(T_NUMBER, 0, 600, undef), + 'zone' => setv(T_STRING, 1, undef, undef), }, - }, - 'ovh' => { - 'updateable' => undef, + ), + 'ovh' => ddclient::LegacyProtocol->new( '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), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'script' => setv(T_STRING, 0, '/nic/update', undef), + 'server' => setv(T_FQDNP, 0, 'www.ovh.com', undef), }, - }, - 'sitelutions' => { - 'updateable' => undef, + ), + 'porkbun' => ddclient::Protocol->new( + 'update' => \&nic_porkbun_update, + 'examples' => \&nic_porkbun_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => undef, + 'password' => undef, + 'apikey' => setv(T_PASSWD, 1, undef, undef), + 'secretapikey' => setv(T_PASSWD, 1, undef, undef), + 'root-domain' => setv(T_FQDN, 0, undef, undef), + 'on-root-domain' => setv(T_BOOL, 0, 0, undef), + 'server' => setv(T_FQDNP, 0, 'api.porkbun.com', undef), + }, + ), + 'sitelutions' => ddclient::LegacyProtocol->new( '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')), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'server' => setv(T_FQDNP, 0, 'www.sitelutions.com', undef), + 'min-interval' => setv(T_DELAY, 0, interval('5m'), 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, + ), + 'yandex' => ddclient::LegacyProtocol->new( '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), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'min-interval' => setv(T_DELAY, 0, interval('5m'), 0), + 'server' => setv(T_FQDNP, 0, 'pddimp.yandex.ru', undef), }, - }, - 'zoneedit1' => { - 'updateable' => undef, + ), + 'zoneedit1' => ddclient::LegacyProtocol->new( '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), + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'min-interval' => setv(T_DELAY, 0, interval('10m'), 0), + 'server' => setv(T_FQDNP, 0, 'dynamic.zoneedit.com', undef), + 'zone' => setv(T_FQDN, 0, undef, undef), }, - }, - 'dnsexit' => { - 'updateable' => undef, - 'update' => \&nic_dnsexit_update, - 'examples' => \&nic_dnsexit_examples, - 'variables' => merge( - $variables{'dnsexit-common-defaults'}, - $variables{'service-common-defaults'}, - ), - }, + ), + 'keysystems' => ddclient::LegacyProtocol->new( + 'update' => \&nic_keysystems_update, + 'examples' => \&nic_keysystems_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => undef, + 'server' => setv(T_FQDNP, 0, 'dynamicdns.key-systems.net', undef), + }, + ), + 'dnsexit2' => ddclient::Protocol->new( + 'update' => \&nic_dnsexit2_update, + 'examples' => \&nic_dnsexit2_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => undef, + 'ssl' => setv(T_BOOL, 0, 1, undef), + 'server' => setv(T_FQDNP, 0, 'api.dnsexit.com', undef), + 'path' => setv(T_STRING, 0, '/dns/', undef), + 'ttl' => setv(T_NUMBER, 0, 5, 0), + 'zone' => setv(T_STRING, 0, undef, undef), + }, + ), + 'regfishde' => ddclient::Protocol->new( + 'update' => \&nic_regfishde_update, + 'examples' => \&nic_regfishde_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => undef, + 'server' => setv(T_FQDNP, 0, 'dyndns.regfish.de', undef), + }, + ), + 'enom' => ddclient::LegacyProtocol->new( + 'update' => \&nic_enom_update, + 'examples' => \&nic_enom_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'server' => setv(T_FQDNP, 0, 'dynamic.name-services.com', undef), + 'min-interval' => setv(T_DELAY, 0, interval('5m'), interval('5m')), + }, + ), + 'infomaniak' => ddclient::Protocol->new( + 'update' => \&nic_infomaniak_update, + 'examples' => \&nic_infomaniak_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'server' => undef, + }, + ), + 'emailonly' => ddclient::Protocol->new( + 'update' => \&nic_emailonly_update, + 'examples' => \&nic_emailonly_examples, + 'cfgvars' => { + %{$cfgvars{'protocol-common-defaults'}}, + 'login' => undef, + 'password' => undef, + # Change default to never re-notify if IP address has not changed. + 'max-interval' => setv(T_DELAY, 0, 'inf', 0), + }, + ), ); -$variables{'merged'} = { - map({ %{$services{$_}{'variables'}} } keys(%services)), - %{$variables{'dyndns-common-defaults'}}, - %{$variables{'service-common-defaults'}}, - %{$variables{'global-defaults'}}, +$cfgvars{'merged'} = { + map({ %{$protocols{$_}{'cfgvars'}} } keys(%protocols)), + %{$cfgvars{'dyndns-common-defaults'}}, + %{$cfgvars{'protocol-common-defaults'}}, + %{$cfgvars{'global-defaults'}}, }; # This will hold the processed args. -my %opt = (); +our %opt; my $deprecated_handler = sub { warning("'-$_[0]' is deprecated and does nothing"); }; $opt{'fw-banlocal'} = $deprecated_handler; $opt{'if-skip'} = $deprecated_handler; +$opt{'list-devices'} = sub { + printf("%s %s\n", $_, $builtinfw{$_}{name}) for sort(keys(%builtinfw)); + exit(0); +}; +$opt{'list-protocols'} = sub { + printf("%s\n", $_) for sort(keys(%protocols)); + exit(0); +}; +$opt{'list-web-services'} = sub { + # This intentionally does not list deprecated services, although they are still accepted. + # Excluding deprecated services from the output discourages their selection by configuration + # wizards (e.g., Debian's debconf) that present this list to users. + printf("%s %s\n", $_, $builtinweb{$_}{url}) + for sort(grep(!$builtinweb{$_}{deprecated}, keys(%builtinweb))); + exit(0); +}; +$opt{'version'} = sub { + my (undef, $arg) = @_; + if ($arg eq "short") { + print("$version\n"); + } else { + print("$program version $version\n"); + print(" originally written by Paul Burry, paul+ddclient\@burry.ca\n"); + print(" project now maintained on https://github.com/ddclient/ddclient\n"); + } + exit(0); +}; my @opt = ( "usage: ${program} [options]", "options are:", - ["daemon", "=s", "-daemon : run as a daemon, specify as an interval"], - ["foreground", "!", "-foreground : do not fork"], - ["proxy", "=s", "-proxy : use as the HTTP proxy"], - ["server", "=s", "-server : update DNS information on "], - ["protocol", "=s", "-protocol : update protocol used"], - ["file", "=s", "-file : load configuration information from "], - ["cache", "=s", "-cache : record address used in "], - ["pid", "=s", "-pid : record process id in if daemonized"], + ["daemon", "=s", "--daemon= : run as a daemon, specify as an interval"], + ["foreground", "!", "--foreground : do not fork"], + ["proxy", "=s", "--proxy= : use as the HTTP proxy"], + ["server", "=s", "--server= : update DNS information on "], + ["protocol", "=s", "--protocol= : update protocol used"], + ["list-protocols", "", "--list-protocols : print a machine-readable list of supported update protocols and exit. Format: one per line"], + ["file", "=s", "--file= : load configuration information from "], + ["cache", "=s", "--cache= : record address used in "], + ["pid", "=s", "--pid= : record process id in if daemonized"], "", - ["use", "=s", "-use : deprecated, see 'usev4' and 'usev6'"], + ["use", "=s", "--use= : deprecated, see '--usev4' and '--usev6'"], &ip_strategies_usage(), - [ "usev4", "=s", "-usev4 : how the should IPv4 address be obtained."], + ["usev4", "=s", "--usev4= : how the IPv4 address should be obtained"], &ipv4_strategies_usage(), - [ "usev6", "=s", "-usev6 : how the should IPv6 address be obtained."], + ["usev6", "=s", "--usev6= : how the IPv6 address should be obtained"], &ipv6_strategies_usage(), "", - " Options that apply to 'use=ip':", - ["ip", "=s", "-ip
: deprecated, use 'ipv4' or 'ipv6'"], - ["ipv4", "=s", "-ipv4
: set the IPv4 address to
"], - ["ipv6", "=s", "-ipv6
: set the IPv6 address to
"], + " Options related to '--use=ip', '--usev4=ipv4', '--usev6=ipv6', and '--usev6=ip':", + ["ip", "=s", "--ip=
: deprecated, use '--ipv4' or '--ipv6'"], + ["ipv4", "=s", "--ipv4=
: set the IPv4 address to
"], + ["ipv6", "=s", "--ipv6=
: set the IPv6 address to
"], "", - " Options that apply to 'use=if':", - ["if", "=s", "-if : deprecated, use 'ifv4' or 'ifv6'"], - ["ifv4", "=s", "-ifv4 : obtain IPv4 address from "], - ["ifv6", "=s", "-ifv6 : obtain IPv6 address from "], + " Options related to '--use=if', '--usev4=ifv4', '--usev6=ifv6', and '--usev6=if':", + ["if", "=s", "--if= : deprecated, use '--ifv4' or '--ifv6'"], + ["ifv4", "=s", "--ifv4= : obtain IPv4 address from "], + ["ifv6", "=s", "--ifv6= : obtain IPv6 address from "], "", - " Options that apply to 'use=web':", - ["web", "=s", "-web | : deprecated, use 'webv4' or 'webv6'"], - ["web-skip", "=s", "-web-skip : deprecated, use 'webv4-skip' or 'webv6-skip'"], - ["webv4", "=s", "-webv4 |: obtain IPv4 address from a web-based IP discovery service, either a known or a custom "], - ["webv4-skip", "=s", "-webv4-skip : skip any IP addresses before in the output of 'ip address show dev ' (or 'ifconfig ')"], - ["webv6", "=s", "-webv6 |: obtain IPv6 address from a web-based IP discovery service, either a known or a custom "], - ["webv6-skip", "=s", "-webv6-skip : skip any IP addresses before in the output of 'ip address show dev ' (or 'ifconfig ')"], + " Options related to '--use=web', '--usev4=webv4', '--usev6=webv6', and '--usev6=web':", + ["web", "=s", "--web= : deprecated, use '--webv4' or '--webv6'"], + ["web-skip", "=s", "--web-skip= : deprecated, use '--webv4-skip' or '--webv6-skip'"], + ["webv4", "=s", "--webv4= : obtain IPv4 address from a web-based IP discovery service, either a known or a custom "], + ["webv4-skip", "=s", "--webv4-skip= : skip any IP addresses before in the output of 'ip address show dev ' (or 'ifconfig ')"], + ["webv6", "=s", "--webv6= : obtain IPv6 address from a web-based IP discovery service, either a known or a custom "], + ["webv6-skip", "=s", "--webv6-skip= : skip any IP addresses before in the output of 'ip address show dev ' (or 'ifconfig ')"], + ["list-web-services", "", "--list-web-services : print a machine-readable list of web-based IP discovery services for use with 'web=' and exit. Format: one service per line, each line has the form ' '"], "", - " Options that apply to 'use=fw' and 'use=':", - ["fw", "=s", "-fw
| : deprecated, use 'fwv4' or 'fwv6'"], - ["fw-skip", "=s", "-fw-skip : deprecated, use 'fwv4-skip' or 'fwv6-skip'"], - ["fwv4", "=s", "-fwv4
| : obtain IPv4 address from device with IP address
or URL "], - ["fwv4-skip", "=s", "-fwv4-skip : skip any IP addresses before in the text returned from the device"], - ["fwv6", "=s", "-fwv6
| : obtain IPv6 address from device with IP address
or URL "], - ["fwv6-skip", "=s", "-fwv6-skip : skip any IP addresses before in the text returned from the device"], - ["fw-login", "=s", "-fw-login : use when getting the IP from the device"], - ["fw-password", "=s", "-fw-password : use password when getting the IP from the device"], + " Options related to '--use=fw', '--usev4=fwv4', '--usev6=fwv6', and '--usev6=fw'", + " as well as '--use=', '--usev4=', and '--usev6=':", + ["fw", "=s", "--fw= : deprecated, use '--fwv4' or '--fwv6'"], + ["fw-skip", "=s", "--fw-skip= : deprecated, use '--fwv4-skip' or '--fwv6-skip'"], + ["fwv4", "=s", "--fwv4= : obtain IPv4 address from device with IP address
or URL "], + ["fwv4-skip", "=s", "--fwv4-skip= : skip any IP addresses before in the text returned from the device"], + ["fwv6", "=s", "--fwv6= : obtain IPv6 address from device with IP address
or URL "], + ["fwv6-skip", "=s", "--fwv6-skip= : skip any IP addresses before in the text returned from the device"], + ["fw-login", "=s", "--fw-login= : use when getting the IP from the device"], + ["fw-password", "=s", "--fw-password= : use password when getting the IP from the device"], + ["list-devices", "", "--list-devices : print a machine-readable list of supported firewall/router devices and exit. Format: one device per line, each line has the form ' '"], "", - " Options that apply to 'use=cmd':", - ["cmd", "=s", "-cmd : deprecated, use 'cmdv4' or 'cmdv6'"], - ["cmd-skip", "=s", "-cmd-skip : deprecated, filter in program wrapper script"], - ["cmdv4", "=s", "-cmdv4 : obtain IPv4 address from the output of "], - ["cmdv6", "=s", "-cmdv6 : obtain IPv6 address from the output of "], + " Options related to '--use=cmd', '--usev4=cmdv4', '--usev6=cmdv6', and '--usev6=cmd':", + ["cmd", "=s", "--cmd= : deprecated, use '--cmdv4' or '--cmdv6'"], + ["cmd-skip", "=s", "--cmd-skip= : deprecated, filter in program wrapper script"], + ["cmdv4", "=s", "--cmdv4= : obtain IPv4 address from the output of "], + ["cmdv6", "=s", "--cmdv6= : obtain IPv6 address from the output of "], "", - ["login", "=s", "-login : log in to the dynamic DNS service as "], - ["password", "=s", "-password : log in to the dynamic DNS service with password "], - ["host", "=s", "-host : update DNS information for "], + ["login", "=s", "--login= : log in to the dynamic DNS service as "], + ["password", "=s", "--password= : log in to the dynamic DNS service with password "], + ["host", "=s", "--host=[,,...]\n : only update the given hosts. The hosts must already be defined in the config file (see '--file') unless '--options' is also specified"], "", - ["options", "=s", "-options =[,=,...]\n : optional per-service arguments (see below)"], + ["options", "=s", "--options==[,=,...]\n : override settings from the config file (see '--file') with the given values. Applies to all hosts"], "", - ["ssl", "!", "-{no}ssl : do updates over encrypted SSL connection"], - ["ssl_ca_dir", "=s", "-ssl_ca_dir : look in for certificates of trusted certificate authorities (default: auto-detect)"], - ["ssl_ca_file", "=s", "-ssl_ca_file : look at 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 : when fetching a URL, wait at most seconds for a response"], - ["syslog", "!", "-{no}syslog : log messages to syslog"], - ["facility", "=s", "-facility : log messages to syslog to facility "], - ["priority", "=s", "-priority : log messages to syslog with priority "], - ["max-warn", "=i", "-max-warn : log at most warning messages for undefined IP address"], - ["mail", "=s", "-mail
: e-mail messages to
"], - ["mail-failure", "=s", "-mail-failure : e-mail messages for failed updates to "], - ["exec", "!", "-{no}exec : do {not} execute; just show what would be done"], - ["debug", "!", "-{no}debug : print {no} debugging information"], - ["verbose", "!", "-{no}verbose : print {no} verbose information"], - ["quiet", "!", "-{no}quiet : print {no} messages for unnecessary updates"], - ["help", "", "-help : display this message and exit"], - ["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 + ["ssl", "!", '--{no}ssl : use encryption (TLS) when the scheme (either "http://" or "https://") is missing from a URL'], + ["ssl_ca_dir", "=s", "--ssl_ca_dir= : look in for certificates of trusted certificate authorities (default: auto-detect)"], + ["ssl_ca_file", "=s", "--ssl_ca_file= : look at for certificates of trusted certificate authorities (default: auto-detect)"], + ["fw-ssl-validate", "!", "--{no}fw-ssl-validate : Validate SSL certificate when retrieving IP address from firewall"], + ["web-ssl-validate", "!", "--{no}web-ssl-validate : Validate SSL certificate when retrieving IP address from web"], + ["force", "!", "--{no}force : force an update even if the update may be unnecessary"], + ["timeout", "=i", "--timeout= : when fetching a URL, wait at most seconds for a response"], + ["syslog", "!", "--{no}syslog : log messages to syslog"], + ["facility", "=s", "--facility= : log messages to syslog to facility "], + ["priority", "=s", "--priority= : log messages to syslog with priority "], + ["max-warn", "=i", "--max-warn= : log at most warning messages for undefined IP address"], + ["mail", "=s", "--mail=
: e-mail messages to
"], + ["mail-failure", "=s", "--mail-failure= : e-mail messages for failed updates to "], + ["mail-from", "=s", '--mail-from= : set the "From:" header in e-mail messages to if non-empty'], + ["exec", "!", "--{no}exec : do {not} execute; just show what would be done"], + ["debug", "!", "--{no}debug : print {no} debugging information"], + ["verbose", "!", "--{no}verbose : print {no} verbose information"], + ["quiet", "!", "--{no}quiet : print {no} messages for unnecessary updates"], + ["help", "", "--help : display this message and exit"], + ["version", ":s", "--version[=short] : display version information and exit"], + ["postscript", "", "--postscript : script to run after updating ddclient, has new IP as param"], + ["query", "!", "--{no}query : print {no} ip addresses and exit"], + ["fw-banlocal", "!", ""], ## deprecated + ["if-skip", "=s", ""], ## deprecated + ["redirect", "=i", "--redirect= : enable and follow at most HTTP 30x redirections"], "", nic_examples(), - "$program version $version, ", - " originally written by Paul Burry, paul+ddclient\@burry.ca", - " project now maintained on https://github.com/ddclient/ddclient" ); +$opt{'help'} = sub { + print(usage(@opt), "\n"); + $opt{'version'}('', ''); +}; sub main { - ## process args - my $opt_usage = process_args(@opt); - $saved_cache = ''; + process_args(@opt); + $saved_recap = ''; %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); + read_config(opt('file'), \%config, \%globals); init_config(); test_possible_ip() if opt('query'); @@ -974,8 +1471,7 @@ sub main { $SIG{'CHLD'} = 'IGNORE'; my $pid = fork; if ($pid < 0) { - print STDERR "${program}: can not fork ($!)\n"; - exit -1; + fatal("failed to fork: %s", $!); } elsif ($pid) { exit 0; } @@ -991,23 +1487,10 @@ sub main { $now = time; $result = 'OK'; %opt = %saved_opt; - if (opt('help')) { - *STDERR = *STDOUT; - printf("Help found"); - } - - read_config($opt{'file'} // default('file'), \%config, \%globals); + read_config(opt('file'), \%config, \%globals); init_config(); - read_cache(opt('cache'), \%cache); + read_recap(opt('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')}; - if (defined($opt{'usev6'})) { - usage("invalid argument '-usev6 %s'; possible values are:\n%s", $opt{'usev6'}, join("\n",ipv6_strategies_usage())) - unless exists $ipv6_strategies{lc opt('usev6')}; - } - $daemon = opt('daemon'); update_nics(); @@ -1031,7 +1514,7 @@ sub main { $result = 0; } elsif (!scalar(%config)) { - warning("no hosts to update.") unless !opt('quiet') || opt('verbose') || !$daemon; + warning("no hosts to update.") if !opt('quiet'); $result = 1; } else { @@ -1053,11 +1536,12 @@ sub main { sub runpostscript { my ($ip) = @_; - if (defined $globals{postscript}) { - if (-x $globals{postscript}) { - system("$globals{postscript} $ip &"); + if (defined(my $ps = opt('postscript'))) { + my @postscript = split(/\s+/, $ps); + if (-x $postscript[0]) { + system("$ps $ip &"); } else { - warning("Can not execute post script: %s", $globals{postscript}); + warning("Can not execute post script: %s", $ps); } } } @@ -1067,107 +1551,73 @@ sub runpostscript { ###################################################################### sub update_nics { my %examined = (); - my %iplist = (); - my %ipv4list = (); - my %ipv6list = (); + my %use_results; + my %usev4_results; + my %usev6_results; - foreach my $s (sort keys %services) { + for my $p (sort keys %protocols) { my (@hosts, %ipsv4, %ipsv6) = (); - my $updateable = $services{$s}{'updateable'}; - my $update = $services{$s}{'update'}; - - foreach my $h (sort keys %config) { - next if $config{$h}{'protocol'} ne lc($s); + for my $h (sort keys %config) { + local $_l = pushlogctx($h); + next if opt('protocol', $h) ne $p; $examined{$h} = 1; # we only do this once per 'use' and argument combination - my $use = opt('use', $h) // 'disabled'; - my $usev4 = opt('usev4', $h) // 'disabled'; - my $usev6 = opt('usev6', $h) // 'disabled'; - $use = 'disabled' if ($use eq 'no'); # backward compatibility - $usev6 = 'disabled' if ($usev6 eq 'no'); # backward compatibility - my $arg_ip = opt('ip', $h) // ''; - my $arg_ipv4 = opt('ipv4', $h) // ''; - my $arg_ipv6 = opt('ipv6', $h) // ''; - my $arg_fw = opt('fw', $h) // ''; - my $arg_fwv4 = opt('fwv4', $h) // ''; - my $arg_fwv6 = opt('fwv6', $h) // ''; - my $arg_if = opt('if', $h) // ''; - my $arg_ifv4 = opt('ifv4', $h) // ''; - my $arg_ifv6 = opt('ifv6', $h) // ''; - my $arg_web = opt('web', $h) // ''; - my $arg_webv4 = opt('webv4', $h) // ''; - my $arg_webv6 = opt('webv6', $h) // ''; - my $arg_cmd = opt('cmd', $h) // ''; - my $arg_cmdv4 = opt('cmdv4', $h) // ''; - my $arg_cmdv6 = opt('cmdv6', $h) // ''; + my $use = opt('use', $h); + my $usev4 = opt('usev4', $h); + my $usev6 = opt('usev6', $h); my $ip = undef; my $ipv4 = undef; my $ipv6 = undef; if ($use ne 'disabled') { - if (exists $iplist{$use}{$arg_ip}{$arg_fw}{$arg_if}{$arg_web}{$arg_cmd}) { - # If we have already done a get_ip() for this, don't do it again. - $ip = $iplist{$use}{$arg_ip}{$arg_fw}{$arg_if}{$arg_web}{$arg_cmd}; - } else { - # Else need to find the IP address... - $ip = get_ip($use, $h); - if (is_ipv4($ip) || is_ipv6($ip)) { - # And if it is valid, remember it... - $iplist{$use}{$arg_ip}{$arg_fw}{$arg_if}{$arg_web}{$arg_cmd} = $ip; - } else { - warning("%s: unable to determine IP address with strategy use=%s", $h, $use) - if !$daemon || opt('verbose'); - } + my %inputs = strategy_inputs('use', $h); + my $sig = repr(\%inputs, Indent => 0); + $use_results{$sig} //= get_ip(%inputs); + if (!is_ipv4($use_results{$sig}) && !is_ipv6($use_results{$sig})) { + warning("unable to determine IP address with strategy '--use=$use'") + if !$daemon || opt('verbose'); + delete $use_results{$sig}; } - # And remember it as the IP address we want to send to the DNS service. - $config{$h}{'wantip'} = $ip; + $ip = $use_results{$sig}; } if ($usev4 ne 'disabled') { - if (exists $ipv4list{$usev4}{$arg_ipv4}{$arg_fwv4}{$arg_ifv4}{$arg_webv4}{$arg_cmdv4}) { - # If we have already done a get_ipv4() for this, don't do it again. - $ipv4 = $ipv4list{$usev4}{$arg_ipv4}{$arg_fwv4}{$arg_ifv4}{$arg_webv4}{$arg_cmdv4}; - } else { - # Else need to find the IPv4 address... - $ipv4 = get_ipv4($usev4, $h); - if (is_ipv4($ipv4)) { - # And if it is valid, remember it... - $ipv4list{$usev4}{$arg_ipv4}{$arg_fwv4}{$arg_ifv4}{$arg_webv4}{$arg_cmdv4} = $ipv4; - } else { - warning("%s: unable to determine IPv4 address with strategy usev4=%s", $h, $usev4) - if !$daemon || opt('verbose'); - } + my %inputs = strategy_inputs('usev4', $h); + my $sig = repr(\%inputs, Indent => 0); + $usev4_results{$sig} //= get_ipv4(%inputs); + if (!is_ipv4($usev4_results{$sig})) { + warning("unable to determine IPv4 address with strategy '--usev4=$usev4'") + if !$daemon || opt('verbose'); + delete $usev4_results{$sig}; } - # And remember it as the IPv4 address we want to send to the DNS service. - $config{$h}{'wantipv4'} = $ipv4; + $ipv4 = $usev4_results{$sig}; } if ($usev6 ne 'disabled') { - if (exists $ipv6list{$usev6}{$arg_ipv6}{$arg_fwv6}{$arg_ifv6}{$arg_webv6}{$arg_cmdv6}) { - # If we have already done a get_ipv6() for this, don't do it again. - $ipv6 = $ipv6list{$usev6}{$arg_ipv6}{$arg_fwv6}{$arg_ifv6}{$arg_webv6}{$arg_cmdv6}; - } else { - # Else need to find the IPv6 address... - $ipv6 = get_ipv6($usev6, $h); - if (is_ipv6($ipv6)) { - # And if it is valid, remember it... - $ipv6list{$usev6}{$arg_ipv6}{$arg_fwv6}{$arg_ifv6}{$arg_webv6}{$arg_cmdv6} = $ipv6; - } else { - warning("%s: unable to determine IPv6 address with strategy usev6=%s", $h, $usev6) - if !$daemon || opt('verbose'); - } + my %inputs = strategy_inputs('usev6', $h); + my $sig = repr(\%inputs, Indent => 0); + $usev6_results{$sig} //= get_ipv6(%inputs); + if (!is_ipv6($usev6_results{$sig})) { + warning("unable to determine IPv6 address with strategy '--usev6=$usev6'") + if !$daemon || opt('verbose'); + delete $usev6_results{$sig}; } - # And remember it as the IP address we want to send to the DNS service. - $config{$h}{'wantipv6'} = $ipv6; + $ipv6 = $usev6_results{$sig}; } - # DNS service update functions should only have to handle 'wantipv4' and 'wantipv6' - $config{$h}{'wantipv4'} = $ipv4 = $ip if (!$ipv4 && is_ipv4($ip)); - $config{$h}{'wantipv6'} = $ipv6 = $ip if (!$ipv6 && is_ipv6($ip)); - # But we will set 'wantip' to the IPv4 so old functions continue to work until we update them all - $config{$h}{'wantip'} = $ipv4 if (!$ip && $ipv4); - - next if !nic_updateable($h, $updateable); + $ip //= $ipv4 // $ipv6; + $ipv4 //= $ip if is_ipv4($ip); + $ipv6 //= $ip if is_ipv6($ip); + if (!$ipv4 && !$ipv6) { + warning('unable to determine IP address'); + next; + } + $config{$h}{'wantipv4'} = $ipv4; + $config{$h}{'wantipv6'} = $ipv6; + if (!nic_updateable($h)) { + delete($config{$h}{$_}) for qw(wantipv4 wantipv6); + next; + } push @hosts, $h; $ipsv4{$ipv4} = $h if ($ipv4); @@ -1175,17 +1625,22 @@ sub update_nics { } if (@hosts) { $0 = sprintf("%s - updating %s", $program, join(',', @hosts)); - &$update(@hosts); + local $_l = pushlogctx($p); + $protocols{$p}->update(@hosts); + for my $h (@hosts) { + delete($config{$h}{$_}) for qw(wantipv4 wantipv6); + } runpostscript(join ' ', keys %ipsv4, keys %ipsv6); } } - foreach my $h (sort keys %config) { + for my $h (sort keys %config) { + local $_l = pushlogctx($h); if (!exists $examined{$h}) { - failed("%s was not updated because protocol %s is not supported.", - $h, $config{$h}{'protocol'} // ''); + failed("not updated because protocol is not supported: " . + opt('protocol', $h) // ''); } } - write_cache(opt('cache')); + write_recap(opt('cache')); } ###################################################################### @@ -1216,30 +1671,18 @@ sub write_pid { } ###################################################################### -## write_cache($file) +## write_recap($file) ###################################################################### -sub write_cache { +sub write_recap { my ($file) = @_; + my $recap = ""; + for my $h (sort keys %recap) { + my $opt = join(',', map("$_=$recap{$h}{$_}", sort(keys(%{$recap{$h}})))); - ## merge the updated host entries into the cache. - foreach my $h (keys %config) { - if (!exists $cache{$h} || $config{$h}{'update'}) { - map { defined($config{$h}{$_}) ? ($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; + $recap .= sprintf "%s%s%s\n", $opt, ($opt ? ' ' : ''), $h; } - $file = '' if defined($saved_cache) && $cache eq $saved_cache; + $file = '' if defined($saved_recap) && $recap eq $saved_recap; - ## 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; @@ -1251,7 +1694,7 @@ sub write_cache { return; } - $saved_cache = undef; + $saved_recap = undef; local *FD; if (!open(FD, ">", $file)) { warning("Failed to create cache file %s: %s", $file, $!); @@ -1259,39 +1702,64 @@ sub write_cache { } printf FD "## %s-%s\n", $program, $version; printf FD "## last updated at %s (%d)\n", prettytime($now), $now; - printf FD "%s", $cache; + printf FD "%s", $recap; close(FD); } } ###################################################################### -## read_cache($file) - called before reading the .conf +## read_recap($file) - called before reading the .conf ###################################################################### -sub read_cache { - my $file = shift; - my $config = shift; +sub read_recap { + my $file = 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}{$_}; - } - } + %recap = (); + return if !(-e $file); + my %saved = %opt; + %opt = (); + $saved_recap = _read_config(\%recap, $globals, "##\\s*$program-$version\\s*", $file, sub { + my ($h, $k, $v, $normout) = @_; + if (!defined($h) && $k eq 'host') { + return 0 if !defined($v); + $$normout = $v; + return 1; + } + if (!defined($h) || !$config{$h}) { + warning("ignoring '$k=$v' for unknown host: " . ($h // '')); + return 0; + } + my $p = opt('protocol', $h); + my $type = $protocols{$p}{recapvars}{$k}; + if (!$type) { + warning("ignoring unrecognized recap variable for host '$h' with protocol '$p': $k"); + return 0; + } + my $norm; + if (!eval { $norm = check_value($v, {type => $type}); 1; }) { + warning("invalid value '$k=$v' for host '$h' with protocol '$p': $@"); + return 0; + } + $$normout = $norm if defined($normout); + return 1; + }); + %opt = %saved; + for my $h (keys(%recap)) { + if (!exists($config{$h})) { + delete($recap{$h}); + next; + } + my $vars = $protocols{opt('protocol', $h)}{recapvars}; + for my $v (keys(%{$recap{$h}})) { + delete($recap{$h}{$v}) if !$vars->{$v}; } } } ###################################################################### ## parse_assignments(string) return (rest, %variables) ## parse_assignment(string) return (name, value, rest) +# +# Parsing stops upon encountering non-assignment text (e.g., hostname after the assignments) or an +# unquoted/unescaped newline. ###################################################################### sub parse_assignments { my ($rest) = @_; @@ -1299,7 +1767,7 @@ sub parse_assignments { while (1) { (my $name, my $value, $rest) = parse_assignment($rest); - $rest =~ s/^[,\s]+//; + $rest =~ s/^(?:[^\S\n]|,)+//; # Remove leading commas and non-newline whitespace. return ($rest, %variables) if !defined($name); if ($name eq 'fw-banlocal' || $name eq 'if-skip') { warning("'$name' is deprecated and does nothing"); @@ -1313,7 +1781,9 @@ sub parse_assignment { my ($name, $value); my ($escape, $quote) = (0, ''); - if ($rest =~ /^[,\s]*([a-z][0-9a-z_-]*)=(.*)/i) { + # Ignore leading commas and non-newline whitespace. (An unquoted/unescaped newline terminates + # the assignment search.) + if ($rest =~ qr/^(?:[^\S\n]|,)*([a-z][0-9a-z_-]*)=(.*)/is) { ($name, $rest, $value) = ($1, $2, ''); while (length(my $c = substr($rest, 0, 1))) { @@ -1334,6 +1804,15 @@ sub parse_assignment { } $rest = substr($rest,1); } + if ($name =~ qr/^(.*)_env$/) { + $name = $1; + debug("Loading value for $name from environment variable $value"); + if (!exists($ENV{$value})) { + warning("Environment variable '$value' not set for keyword '$name' (ignored)"); + return parse_assignment($rest); + } + $value = $ENV{$value}; + } } warning("assignment to '%s' ended with the escape character (\\)", $name) if $escape; warning("assignment to '%s' ended with an unterminated quote (%s)", $name, $quote) if $quote; @@ -1344,7 +1823,39 @@ sub parse_assignment { ###################################################################### sub read_config { my ($file, $config, $globals) = @_; - _read_config($config, $globals, '', $file); + _read_config($config, $globals, '', $file, sub { + # TODO: The checks below are incorrect for a few reasons: + # + # * It is not protocol-aware. Different protocols can have different sets of variables, + # with different normalization and validation behaviors. + # * It does not check for missing required values. Note that a later line or a + # command-line argument might define a missing required value. + # * A later line or command-line argument might override an invalid value, changing it to + # valid. + # + # Fixing this is not simple. Values should be checked and normalized after processing the + # entire file and command-line arguments, but then we lose line number context. The line + # number could be recorded along with each variable's value to provide context in case + # validation fails, but that adds considerable complexity. Fortunately, a variable's type + # is unlikely to change even if the protocol changes (`$cfgvars{merged}{$var}{type}` will + # likely equal `$protocols{$proto}{cfgvars}{$var}{type}` for each variable `$var` for each + # protocol `$proto`), so normalizing and validating values on a line-by-line basis is + # likely to be safe. + my ($h, $k, $v, $normout) = @_; + if (!exists($cfgvars{'merged'}{$k})) { + warning("unrecognized keyword"); + return 0; + } + my $def = $cfgvars{'merged'}{$k}; + my $norm; + if (!eval { $norm = check_value($v, $def); 1; }) { + my $vf = defined($v) ? "'$v'" : ''; + warning("invalid value $vf: $@"); + return 0; + } + $$normout = $norm if defined($normout); + return 1; + }); } sub _read_config { # Configuration line format after comment and continuation @@ -1378,39 +1889,55 @@ sub _read_config { # 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 ($config, $globals, $stamp, $file, $check) = @_; + local $_l = pushlogctx("file $file"); my %globals = (); my %config = (); my $content = ''; + # Calls $check on each entry in the given hashref, deleting any entries that don't pass. + my $checkall = sub { + my ($h, $l) = @_; + for my $k (keys(%$l)) { + local $_l = pushlogctx($k); + delete($l->{$k}) if !$check->($h, $k, $l->{$k}, \$l->{$k}); + } + }; local *FD; if (!open(FD, "< $file")) { - warning("Cannot open file '%s'. (%s)", $file, $!); + warning("cannot open file: $!"); + goto done; } - # Check for only owner has any access to config file + + # If file is owned by our effective uid, ensure that it has no access for group or others. + # Otherwise, require that it isn't writable when not owned by us. For example allow it to + # be owned by root:ddclient with mode 640. Always ensure that it is not accessible to others. my ($dev, $ino, $mode, @statrest) = stat(FD); - if ($mode & 077) { + if ($mode & 077 && -o FD) { if (-f FD && (chmod 0600, $file)) { - warning("file %s must be accessible only by its owner (fixed).", $file); + warning("file must be accessible only by its owner (fixed)"); } else { - warning("file %s must be accessible only by its owner.", $file); + warning("file must be accessible only by its owner"); } + } elsif (! -o FD && -w FD) { + warning("file should be owned only by ddclient or not be writable."); + } + if ($mode & 07) { + warning("file must not be accessible by others."); } - local $lineno = 0; + my $lineno = 0; my $continuation = ''; my %passwords = (); while () { s/[\r\n]//g; $lineno++; + local $_l = $_l->{parent}; $_l = pushlogctx("file $file, line $lineno"); ## check for the program version stamp if (($. == 1) && $stamp && ($_ !~ /^$stamp$/i)) { - warning("program version mismatch; ignoring %s", $file); + warning('program version mismatch; ignoring'); last; } if (/\\\s+$/) { @@ -1420,7 +1947,7 @@ sub _read_config { $content .= "$_\n" unless /^#/; ## parsing passwords is special - if (/^([^#]*\s)?([^#]*?password\S*?)\s*=\s*('.*'|[^']\S*)(.*)/) { + if (/^([^#]*\s)?([^#]*?password)\s*=\s*('.*'|[^']\S*)(.*)/) { my ($head, $key, $value, $tail) = ($1 // '', $2, $3, $4); $value = $1 if $value =~ /^'(.*)'$/; $passwords{$key} = $value; @@ -1428,12 +1955,19 @@ sub _read_config { } ## remove comments + # TODO: This makes it impossible to include '#' in keys or values except as permitted by + # the special password parsing above. s/#.*//; - ## handle continuation lines + ## Handle continuation lines + # Any line ending in a backslash gets concatenated together with the following line + # Note: Trailing whitespace after the backslash is allowed. $_ = "$continuation$_"; - if (/\\$/) { - chop; + if (/\\\s*$/) { + # Remove the backslash and whitespace + s/\\\s*$//s; + + # Store the current line to be prepended to the next line $continuation = $_; next; } @@ -1441,6 +1975,8 @@ sub _read_config { s/^\s+//; # remove leading white space s/\s+$//; # remove trailing white space + # TODO: This makes it impossible to include multiple consecutive spaces, tabs, etc. in keys + # or values. s/\s+/ /g; # canonify next if /^$/; @@ -1448,243 +1984,156 @@ sub _read_config { ($_, %locals) = parse_assignments($_); s/\s*,\s*/,/g; my @args = split; - - ## verify that keywords are valid...and check the value - foreach my $k (keys %locals) { + for 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; + %passwords = (); + if (defined($locals{'host'})) { + $args[0] = (@args ? "$args[0]," : '') . $locals{host}; + } + my ($host, $login, $password) = @args; + $locals{'login'} = $login if defined $login; + $locals{'password'} = $password if defined $password; + my @hosts = split_by_comma($host); + if (!@hosts) { + local $_l = pushlogctx('globals'); + $checkall->(undef, \%locals); + %globals = (%globals, %locals); + next; } - - ## 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; - } + for my $h (@hosts) { + local $_l = pushlogctx($h); + # Shallow clone of %locals for host-dependent validation and normalization. + my %hlocals = %locals; + $checkall->($h, \%hlocals); + # TODO: Shouldn't `%hlocals` go after `$config{h}`? Later lines should override + # earlier lines, no? Otherwise, later assignments will have a mixed effect: + # assignments to new variables will take effect but assignments to variables that + # already have a value will not. + $config{$h} = {%globals, %hlocals, %{$config{$h} // {}}, 'host' => $h}; } - %passwords = (); } close(FD); warning("file ends while expecting a continuation line.") if $continuation; + done: %$globals = %globals; %$config = %config; return $content; } + ###################################################################### ## init_config - ###################################################################### sub init_config { %opt = %saved_opt; + # TODO: This might grab an arbitrary protocol-specific variable definition, which could cause + # surprising behavior. + for my $var (keys(%{$cfgvars{'merged'}})) { + # TODO: Also validate $opt{'options'}. + next if !defined($opt{$var}) || ref($opt{$var}); + if (!eval { $opt{$var} = check_value($opt{$var}, $cfgvars{'merged'}{$var}); 1; }) { + fatal("invalid argument '--$var=$opt{$var}': $@"); + } + } ## $opt{'quiet'} = 0 if opt('verbose'); - ## infer the IP strategy if possible - if (!$opt{'use'}) { - $opt{'use'} = 'web' if ($opt{'web'}); - $opt{'use'} = 'if' if ($opt{'if'}); - $opt{'use'} = 'ip' if ($opt{'ip'}); - } - ## infer the IPv4 strategy if possible - if (!$opt{'usev4'}) { - $opt{'usev4'} = 'webv4' if ($opt{'webv4'}); - $opt{'usev4'} = 'ifv4' if ($opt{'ifv4'}); - $opt{'usev4'} = 'ipv4' if ($opt{'ipv4'}); - } - ## infer the IPv6 strategy if possible - if (!$opt{'usev6'}) { - $opt{'usev6'} = 'webv6' if ($opt{'webv6'}); - $opt{'usev6'} = 'ifv6' if ($opt{'ifv6'}); - $opt{'usev6'} = 'ipv6' if ($opt{'ipv6'}); - } - - ## sanity check - $opt{'max-interval'} = min(interval(opt('max-interval')), interval(default('max-interval'))); - $opt{'min-interval'} = max(interval(opt('min-interval')), interval(default('min-interval'))); - $opt{'min-error-interval'} = max(interval(opt('min-error-interval')), interval(default('min-error-interval'))); - - $opt{'timeout'} = 0 if opt('timeout') < 0; - - ## parse an interval expression (such as '5m') into number of seconds - $opt{'daemon'} = interval(opt('daemon')) if defined($opt{'daemon'}); - ## make sure the interval isn't too short - $opt{'daemon'} = minimum('daemon') if opt('daemon') > 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 + if (defined($opt{'options'})) { + # TODO: Perhaps the --options argument should be processed like the contents of the config + # file: each line (after removing any comments or continuations) either specifies global + # values or host-specific settings. For now, non-value newlines and end-of-line host + # declarations are rejected. + my ($rest, %options) = parse_assignments($opt{'options'}); + fatal("unexpected content in '--options' argument: $rest") if $rest ne ''; + ## determine hosts specified with --host my @hosts = (); if (exists $opt{'host'}) { - foreach my $h (split_by_comma($opt{'host'})) { + for my $h (split_by_comma($opt{'host'})) { push @hosts, $h; } } - ## and those in -options=... + ## and those in --options=... if (exists $options{'host'}) { - foreach my $h (split_by_comma($options{'host'})) { + for my $h (split_by_comma($options{'host'})) { push @hosts, $h; } delete $options{'host'}; } ## merge options into host definitions or globals if (@hosts) { - foreach my $h (@hosts) { - $config{$h} = merge(\%options, $config{$h}); + for my $h (@hosts) { + $config{$h} //= {'host' => $h}; + my $proto = $options{'protocol'} // opt('protocol', $h); + my $protodef = $protocols{$proto} or fatal("host $h: invalid protocol: $proto"); + for my $var (keys(%options)) { + my $def = $protodef->{cfgvars}{$var} + or fatal("host $h: unknown option '--options=$var=$options{$var}'"); + eval { $config{$h}{$var} = check_value($options{$var}, $def); 1; } + or fatal("host $h: invalid option value '--options=$var=$options{$var}': $@"); + } } $opt{'host'} = join(',', @hosts); } else { - %globals = %{merge(\%options, \%globals)}; + for my $var (keys(%options)) { + # TODO: This might grab an arbitrary protocol-specific variable definition, which + # could cause surprising behavior. + my $def = $cfgvars{'merged'}{$var} + or fatal("unknown option '--options=$var=$options{$var}'"); + # TODO: Why not merge the values into %opt? + eval { $globals{$var} = check_value($options{$var}, $def); 1; } + or fatal("invalid option value '--options=$var=$options{$var}': $@"); + } } } ## override global options with those on the command-line. - foreach my $o (keys %opt) { - if (defined $opt{$o} && exists $variables{'global-defaults'}{$o}) { + for my $o (keys %opt) { + if (defined $opt{$o} && exists $cfgvars{'merged'}{$o}) { + # TODO: What's the point of this? The opt() function will fall back to %globals if + # %opt doesn't have a value, so this shouldn't be necessary. $globals{$o} = $opt{$o}; } + # TODO: Why aren't host configs updated with command-line values (except for $opt{options} + # handled above)? Shouldn't command-line values always override config file values (even + # if they are not associated with a host via `--host=` or `--options=host=`)? } - ## 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) + ## determine hosts to update (those on the cmd-line, config-file, or failed in recap) my @hosts = keys %config; if (opt('host')) { @hosts = split_by_comma($opt{'host'}); } - 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; + # TODO: Why aren't the hosts specified by --host added to %config except when --options is also + # given? - } - $config{$h} = $conf; - $config{$h}{'cacheable'} = [ @{$services{$proto}{'cacheable'}} ]; - } - } + my @protos = map(opt('protocol', $_), keys(%config)); + my @needs_sha1 = grep({ my $p = $_; grep($_ eq $p, @protos); } qw(freedns nfsn)); + load_sha1_support(join(', ', @needs_sha1)) if @needs_sha1; + my @needs_json = grep({ my $p = $_; grep($_ eq $p, @protos); } + qw(1984 cloudflare digitalocean directnic dnsexit2 gandi godaddy hetzner + nfsn njalla porkbun yandex)); + load_json_support(join(', ', @needs_json)) if @needs_json; } -###################################################################### -## process_args - -###################################################################### -sub process_args { - my @spec = (); +sub usage { my $usage = ""; - - foreach (@_) { + for (@_) { if (ref $_) { my ($key, $specifier, $arg_usage) = @$_; - my $value = default($key); - - ## add a option specifier - push @spec, $key . $specifier; - - ## define the default value which can be overwritten later - $opt{$key} = undef unless exists($opt{$key}); - + my $value = default($key, ''); next unless $arg_usage; - - ## add a line to the usage; $usage .= " $arg_usage"; if (defined($value) && $value ne '') { $usage .= " (default: "; @@ -1702,11 +2151,22 @@ sub process_args { } $usage .= "\n"; } - ## process the arguments + return $usage; +} + +###################################################################### +## process_args - +###################################################################### +sub process_args { + my @spec = (); + for (@_) { + next if !ref($_); + my ($key, $specifier) = @$_; + push @spec, $key . $specifier; + } if (!GetOptions(\%opt, @spec)) { - $opt{"help"} = 1; + $opt{'help'}('', ''); } - return $usage; } ###################################################################### @@ -1716,9 +2176,11 @@ sub test_possible_ip { local $opt{'debug'} = 0; printf "----- Test_possible_ip with 'get_ip' -----\n"; - printf "use=ip, ip=%s address is %s\n", opt('ip'), get_ip('ip') // 'NOT FOUND' - if defined opt('ip'); - + if (defined(opt('ip'))) { + local $opt{'use'} = 'ip'; + printf("use=ip, ip=%s address is %s\n", + opt('ip'), get_ip(strategy_inputs('use')) // 'NOT FOUND'); + } { local $opt{'use'} = 'if'; # Note: The `ip` command adds a `@eth0` suffix to the names of VLAN @@ -1729,43 +2191,52 @@ sub test_possible_ip { `command -v ifconfig >/dev/null && ifconfig -a`) if $? || !@ifs; @ifs = () if $?; warning("failed to get list of interfaces") if !@ifs; - foreach my $if (@ifs) { + for my $if (@ifs) { local $opt{'if'} = $if; - printf "use=if, if=%s address is %s\n", opt('if'), get_ip('if') // 'NOT FOUND'; + printf("use=if, if=%s address is %s\n", + opt('if'), get_ip(strategy_inputs('use')) // 'NOT FOUND'); } } if (opt('fw')) { if (opt('fw') !~ m%/%) { - foreach my $fw (sort keys %builtinfw) { + for my $fw (sort keys %builtinfw) { local $opt{'use'} = $fw; - printf "use=%s address is %s\n", $fw, get_ip($fw) // 'NOT FOUND'; + printf("use=%s address is %s\n", + $fw, get_ip(strategy_inputs('use')) // 'NOT FOUND'); } } local $opt{'use'} = 'fw'; - printf "use=fw, fw=%s address is %s\n", opt('fw'), get_ip(opt('fw')) // 'NOT FOUND' + printf("use=fw, fw=%s address is %s\n", + opt('fw'), get_ip(strategy_inputs('use')) // 'NOT FOUND') if !exists $builtinfw{opt('fw')}; } { local $opt{'use'} = 'web'; - foreach my $web (sort keys %builtinweb) { + for my $web (sort keys %builtinweb) { local $opt{'web'} = $web; - printf "use=web, web=%s address is %s\n", $web, get_ip('web') // 'NOT FOUND'; + printf("use=web, web=%s address is %s\n", + $web, get_ip(strategy_inputs('use')) // 'NOT FOUND'); } - printf "use=web, web=%s address is %s\n", opt('web'), get_ip('web') // 'NOT FOUND' + printf("use=web, web=%s address is %s\n", + opt('web'), get_ip(strategy_inputs('use')) // 'NOT FOUND') if !exists $builtinweb{opt('web')}; } if (opt('cmd')) { local $opt{'use'} = 'cmd'; - printf "use=cmd, cmd=%s address is %s\n", opt('cmd'), get_ip('cmd') // 'NOT FOUND'; + printf("use=cmd, cmd=%s address is %s\n", + opt('cmd'), get_ip(strategy_inputs('use')) // 'NOT FOUND'); } # Now force IPv4 printf "----- Test_possible_ip with 'get_ipv4' ------\n"; - printf "use=ipv4, ipv4=%s address is %s\n", opt('ipv4'), get_ipv4('ipv4') // 'NOT FOUND' - if defined opt('ipv4'); - + if (defined(opt('ipv4'))) { + local $opt{'usev4'} = 'ipv4'; + printf("usev4=ipv4, ipv4=%s address is %s\n", + opt('ipv4'), get_ipv4(strategy_inputs('usev4')) // 'NOT FOUND'); + } { + local $opt{'usev4'} = 'ifv4'; # Note: The `ip` command adds a `@eth0` suffix to the names of VLAN # interfaces. That `@eth0` suffix is NOT part of the interface name. my @ifs = map({ /^[^\s:]*:\s*([^\s:@]+)/ ? $1 : () } @@ -1774,32 +2245,39 @@ sub test_possible_ip { `command -v ifconfig >/dev/null && ifconfig -a`) if $? || !@ifs; @ifs = () if $?; warning("failed to get list of interfaces") if !@ifs; - foreach my $if (@ifs) { + for my $if (@ifs) { local $opt{'ifv4'} = $if; - printf "use=ifv4, ifv4=%s address is %s\n", opt('ifv4'), get_ipv4('ifv4') // 'NOT FOUND'; + printf("usev4=ifv4, ifv4=%s address is %s\n", + opt('ifv4'), get_ipv4(strategy_inputs('usev4')) // 'NOT FOUND'); } } { local $opt{'usev4'} = 'webv4'; - foreach my $web (sort keys %builtinweb) { + for my $web (sort keys %builtinweb) { local $opt{'webv4'} = $web; - printf "use=webv4, webv4=$web address is %s\n", get_ipv4('webv4') // 'NOT FOUND' + printf("usev4=webv4, webv4=%s address is %s\n", + $web, get_ipv4(strategy_inputs('usev4')) // 'NOT FOUND') if ($web !~ "6") ## Don't bother if web site only supports IPv6; } - printf "use=webv4, webv4=%s address is %s\n", opt('webv4'), get_ipv4('webv4') // 'NOT FOUND' + printf("usev4=webv4, webv4=%s address is %s\n", + opt('webv4'), get_ipv4(strategy_inputs('usev4')) // 'NOT FOUND') if ! exists $builtinweb{opt('webv4')}; } if (opt('cmdv4')) { local $opt{'usev4'} = 'cmdv4'; - printf "use=cmdv4, cmdv4=%s address is %s\n", opt('cmdv4'), get_ipv4('cmdv4') // 'NOT FOUND'; + printf("usev4=cmdv4, cmdv4=%s address is %s\n", + opt('cmdv4'), get_ipv4(strategy_inputs('usev4')) // 'NOT FOUND'); } # Now force IPv6 printf "----- Test_possible_ip with 'get_ipv6' -----\n"; - printf "use=ipv6, ipv6=%s address is %s\n", opt('ipv6'), get_ipv6('ipv6') // 'NOT FOUND' - if defined opt('ipv6'); - + if (defined(opt('ipv6'))) { + local $opt{'usev6'} = 'ipv6'; + printf("usev6=ipv6, ipv6=%s address is %s\n", + opt('ipv6'), get_ipv6(strategy_inputs('usev6')) // 'NOT FOUND'); + } { + local $opt{'usev6'} = 'ifv6'; # Note: The `ip` command adds a `@eth0` suffix to the names of VLAN # interfaces. That `@eth0` suffix is NOT part of the interface name. my @ifs = map({ /^[^\s:]*:\s*([^\s:@]+)/ ? $1 : () } @@ -1808,97 +2286,38 @@ sub test_possible_ip { `command -v ifconfig >/dev/null && ifconfig -a`) if $? || !@ifs; @ifs = () if $?; warning("failed to get list of interfaces") if !@ifs; - foreach my $if (@ifs) { + for my $if (@ifs) { local $opt{'ifv6'} = $if; - printf "use=ifv6, ifv6=%s address is %s\n", opt('ifv6'), get_ipv6('ifv6') // 'NOT FOUND'; + printf("usev6=ifv6, ifv6=%s address is %s\n", + opt('ifv6'), get_ipv6(strategy_inputs('usev6')) // 'NOT FOUND'); } } { local $opt{'usev6'} = 'webv6'; - foreach my $web (sort keys %builtinweb) { + for my $web (sort keys %builtinweb) { local $opt{'webv6'} = $web; - printf "use=webv6, webv6=$web address is %s\n", get_ipv6('webv6') // 'NOT FOUND' + printf("usev6=webv6, webv6=%s address is %s\n", + $web, get_ipv6(strategy_inputs('usev6')) // 'NOT FOUND') if ($web !~ "4"); ## Don't bother if web site only supports IPv4 } - printf "use=webv6, webv6=%s address is %s\n", opt('webv6'), get_ipv6('webv6') // 'NOT FOUND' + printf("usev6=webv6, webv6=%s address is %s\n", + opt('webv6'), get_ipv6(strategy_inputs('usev6')) // 'NOT FOUND') if ! exists $builtinweb{opt('webv6')}; } if (opt('cmdv6')) { local $opt{'usev6'} = 'cmdv6'; - printf "use=cmdv6, cmdv6=%s address is %s\n", opt('cmdv6'), get_ipv6('cmdv6') // 'NOT FOUND'; + printf("usev6=cmdv6, cmdv6=%s address is %s\n", + opt('cmdv6'), get_ipv6(strategy_inputs('usev6')) // '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 // "\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_recap ## print_info ###################################################################### sub _print_hash { @@ -1908,7 +2327,7 @@ sub _print_hash { if (!defined($ptr)) { $value = ""; } elsif (ref $ptr eq 'HASH') { - foreach my $key (sort keys %$ptr) { + for my $key (sort keys %$ptr) { if (($key eq "login") || ($key eq "password")) { $value = ""; } else { @@ -1928,12 +2347,12 @@ sub print_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_recap { print_hash("recap", \%recap); } sub print_info { print_opt(); print_globals(); print_config(); - print_cache(); + print_recap(); } ###################################################################### ## pipecmd - run an external command @@ -1942,6 +2361,7 @@ sub print_info { ###################################################################### sub pipecmd { my $cmd = shift; + local $_l = pushlogctx($cmd); my $stdin = join("\n", @_); my $ok = 0; @@ -1954,17 +2374,17 @@ sub pipecmd { ## execute the command. local *FD; if (!open(FD, $cmd)) { - printf STDERR "%s: cannot execute command %s.\n", $program, $cmd; + warning('cannot execute command'); } elsif ($stdin && (!print FD "$stdin\n")) { - printf STDERR "%s: failed writting to %s.\n", $program, $cmd; + warning('failed writing to stdin'); close(FD); } elsif (!close(FD)) { - printf STDERR "%s: failed closing %s.(%s)\n", $program, $cmd, $@; + warning("failed closing stdin: $@"); } elsif (opt('exec') && $?) { - printf STDERR "%s: failed %s. (%s)\n", $program, $cmd, $@; + warning("failed: $@"); } else { $ok = 1; @@ -1985,25 +2405,25 @@ sub sendmail { if (opt('mail-failure') && ($result ne 'OK' && $result ne '0')) { $recipients = opt('mail-failure'); } - if ($msgs && $recipients && $msgs ne $last_msgs) { + if ($emailbody && $recipients && $emailbody ne $last_emailbody) { + my $sender = opt('mail-from') // ''; pipecmd("sendmail -oi $recipients", "To: $recipients", + $sender ne '' ? ("From: $sender") : (), "Subject: status report from $program\@$hostname", "\r\n", - $msgs, + $emailbody, "", - "regards,", + "-- ", # https://en.wikipedia.org/wiki/Signature_block#Standard_delimiter " $program\@$hostname (version $version)" ); } - $last_msgs = $msgs; - $msgs = ''; + $last_emailbody = $emailbody; + $emailbody = ''; } ###################################################################### ## split_by_comma -## merge ## default -## minimum ## opt ###################################################################### sub split_by_comma { @@ -2012,39 +2432,39 @@ sub split_by_comma { 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'}; + my ($v, $h) = @_; + my $var; + if (defined($h) && $config{$h}) { + my $proto = $protocols{opt('protocol', $v eq 'protocol' ? undef : $h)}; + $var = $proto->{cfgvars}{$v} if $proto; + } + # TODO: This might grab an arbitrary protocol-specific variable definition, which could cause + # surprising behavior. + $var //= $cfgvars{'merged'}{$v}; + return undef if !defined($var); + return $var->{'default'}($h) if ref($var->{default}) eq 'CODE'; + return $var->{'default'}; } sub opt { my $v = shift; my $h = shift; return $config{$h}{$v} if defined($h) && defined($config{$h}{$v}); - return $opt{$v} // $globals{$v} // default($v); + # TODO: Why check %opt before %globals? Valid variables from %opt are merged into %globals by + # init_config(), so it shouldn't be necessary. Also, it runs the risk of collision with a + # non-variable command line option like `--version`, `--help`, etc. + return $opt{$v} // $globals{$v} // default($v, $h); } sub min { my $min = shift; - foreach my $arg (@_) { + for my $arg (@_) { $min = $arg if $arg < $min; } return $min; } sub max { my $max = shift; - foreach my $arg (@_) { + for my $arg (@_) { $max = $arg if $arg > $max; } return $max; @@ -2057,54 +2477,105 @@ sub ynu { return $no if !($value // ''); return $yes if $value eq '1'; - foreach (qw(yes true)) { + for (qw(yes true)) { return $yes if $_ =~ /^$value/i; } - foreach (qw(no false)) { + for (qw(no false)) { return $no if $_ =~ /^$value/i; } return $undef; } ###################################################################### -## msg -## debug -## warning -## fatal +## Logging ###################################################################### -sub _msg { - my $fh = shift; - my $log = shift; - my $prefix = shift; - my $format = shift; - my $buffer = sprintf $format, @_; - chomp($buffer); +{ + package ddclient::Logger; + + sub new { + my ($class, $ctx, $parent) = @_; + $ctx = [$ctx // ()] if ref($ctx) eq ''; + return bless({ctx => $ctx, parent => $parent, _in_logger => 0}, $class); + } + + # Takes the following keyword arguments: + # * `msg` (string): The message to log. + # * `label` (string): Severity ('DEBUG', 'WARNING', etc.) to prefix each line with. + # * `email` (boolean): Whether to include the message in the next email. + # * `raw` (boolean): Whether to omit `label` and the contexts (output `msg` as-is). + # * `ctx` (optional string or arrayref of strings): Context or contexts to temporarily push + # onto the context stack (for this call only). + # + # The keyword arguments may optionally be followed by a single positional argument, which + # becomes the value for the `msg` keyword argument if the `msg` keyword argument is not + # provided (it is ignored if the `msg` keyword is present). + sub log { + my $self = shift; + my %args = (label => '', @_ % 2 ? (msg => pop) : (), @_); + $args{ctx} = [$args{ctx} // ()] if ref($args{ctx}) eq ''; + $self->_log(\%args); + $self->_failed() if $args{label} eq 'FAILED'; + $self->_abort() if $args{label} eq 'FATAL'; + } + + sub _log { + my ($self, $args) = @_; + # A new arrayref is created instead of unshifting into @{$args->{ctx}} to avoid mutating + # the caller's arrayref (in case it is reused in a future call). + $args->{ctx} = [@{$self->{ctx}}, @{$args->{ctx}}]; + return $self->{parent}->_log($args) if defined($self->{parent}); + return if $args->{label} eq 'DEBUG' && !ddclient::opt('debug'); + return if $args->{label} eq 'INFO' && !ddclient::opt('verbose'); + my $buffer = $args->{msg} // ''; + chomp($buffer); + if (!$args->{raw}) { + my $prefix = $args->{label} ne '' ? sprintf("%-8s ", $args->{label} . ':') : ''; + $prefix .= "[$_]" for @{$args->{ctx}}; + $prefix .= '> ' if $prefix; + $buffer = "$prefix$buffer"; + $prefix =~ s/> $/ /; + $buffer =~ s/\n/\n$prefix/g; + } + $buffer .= "\n"; + print(STDERR $buffer); + + if ($args->{email}) { + $emailbody .= $buffer; + if (!$self->{_in_logger}) { + ++$self->{_in_logger}; # Avoid infinite recursion if logger itself logs. + ddclient::logger($buffer); + --$self->{_in_logger}; + } + } + } + + sub _failed { + my ($self) = @_; + return $self->{parent}->_failed() if defined($self->{parent}); + $ddclient::result = 'FAILED'; + $ddclient::result if 0; # Suppress spurious "used only once: possible typo" warning. + } + + sub _abort { + my ($self) = @_; + return $self->{parent}->_abort() if defined($self->{parent}); + ddclient::sendmail(); + exit(1); + } +} + +# Intended use: +# local $_l = pushlogctx('additional prefix goes here'); +sub pushlogctx { my ($ctx) = @_; return ddclient::Logger->new($ctx, $_l); } + +sub logmsg { $_l->log(@_); } +sub _logmsg_fmt { $_[0] eq 'ctx' ? (shift, shift) : (), (@_ > 1) ? sprintf(shift, @_) : shift; } +sub info { logmsg(email => 1, label => 'INFO', _logmsg_fmt(@_)); } +sub debug { logmsg( label => 'DEBUG', _logmsg_fmt(@_)); } +sub warning { logmsg(email => 1, label => 'WARNING', _logmsg_fmt(@_)); } +sub fatal { logmsg(email => 1, label => 'FATAL', _logmsg_fmt(@_)); } +sub success { logmsg(email => 1, label => 'SUCCESS', _logmsg_fmt(@_)); } +sub failed { logmsg(email => 1, label => 'FAILED', _logmsg_fmt(@_)); } - $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 { @@ -2139,19 +2610,21 @@ sub interval { $value = $1 * 60*60; } elsif ($value =~ /^(\d+)(days|d)/i) { $value = $1 * 60*60*24; + } elsif ($value =~ qr/^(?:inf(?:init[ye])?|indefinite(?:ly)?|never|forever|always)$/i) { + $value = 'inf'; } elsif ($value !~ /^\d+$/) { $value = undef; } return $value; } sub interval_expired { - my ($host, $time, $interval) = @_; - - return 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}); + my ($host, $time, $interval_opt) = @_; + my $interval = opt($interval_opt, $host); + return 0 if ($interval // 0) == 'inf'; + return 1 if !exists $recap{$host}; + return 1 if !exists $recap{$host}{$time} || !$recap{$host}{$time}; + return 1 if !$interval; + return $now > ($recap{$host}{$time} + $interval); } @@ -2160,20 +2633,25 @@ sub interval_expired { ## check_value ###################################################################### sub check_value { - my ($value, $def) = @_; + my ($orig, $def) = @_; + my $value = $orig; my $type = $def->{'type'}; my $min = $def->{'minimum'}; my $required = $def->{'required'}; if (!defined $value && !$required) { ; + } elsif (!defined($value) && $required) { + # None of the types have 'undef' as a valid value, so check definedness once here for + # convenience. + die("$type is required\n"); } elsif ($type eq T_DELAY) { $value = interval($value); $value = $min if defined($value) && defined($min) && $value < $min; } elsif ($type eq T_NUMBER) { - return undef if $value !~ /^\d+$/; + die("invalid $type: $orig\n") if $value !~ /^\d+$/; $value = $min if defined($min) && $value < $min; } elsif ($type eq T_BOOL) { @@ -2182,318 +2660,87 @@ sub check_value { } elsif ($value =~ /^(n(o)?|f(alse)?|0)$/i) { $value = 0; } else { - return undef; + die("invalid $type: $orig\n"); } - } elsif ($type eq T_FQDN || $type eq T_OFQDN && $value ne '') { + } elsif ($type eq T_FQDN) { $value = lc $value; - return undef if $value !~ /[^.]\.[^.]/; + die("invalid $type: $orig\n") if ($value ne '' || $required) && $value !~ /[^.]\.[^.]/; } elsif ($type eq T_FQDNP) { $value = lc $value; - return undef if $value !~ /[^.]\.[^.].*(:\d+)?$/; + die("invalid $type: $orig\n") if $value !~ /[^.]\.[^.].*(:\d+)?$/; } elsif ($type eq T_PROTO) { $value = lc $value; - return undef if !exists $services{$value}; + die("invalid $type: $orig\nSupported values: ", join(' ', sort(keys(%protocols))), "\n") + if !exists $protocols{$value}; + + } elsif ($type eq T_URL) { + die("invalid $type: $orig\n") + if $value !~ qr{^(?i:https?://)?[^./]+(\.[^./]+)+(:\d+)?(/[^/]+)*/?$}; } elsif ($type eq T_USE) { $value = lc $value; - return undef if !exists $ip_strategies{$value}; + $value = 'disabled' if $value eq 'no'; # backwards compatibility + die(map(($_, "\n"), "invalid $type: $orig", 'Supported values:', ip_strategies_usage())) + if !exists($ip_strategies{$value}); } elsif ($type eq T_USEV4) { $value = lc $value; - return undef if ! exists $ipv4_strategies{$value}; + die(map(($_, "\n"), "invalid $type: $orig", 'Supported values:', ipv4_strategies_usage())) + if !exists($ipv4_strategies{$value}); } elsif ($type eq T_USEV6) { $value = lc $value; - return undef if ! exists $ipv6_strategies{$value}; + $value = 'disabled' if $value eq 'no'; # backwards compatibility + die(map(($_, "\n"), "invalid $type: $orig", 'Supported values:', ipv6_strategies_usage())) + if !exists($ipv6_strategies{$value}); } elsif ($type eq T_FILE) { - return undef if $value eq ""; + die("invalid $type: $orig\n") if $value eq ""; } elsif ($type eq T_IF) { - return undef if $value !~ /^[a-zA-Z0-9:._-]+$/; + die("invalid $type: $orig\n") if $value !~ /^[a-zA-Z0-9:._-]+$/; } elsif ($type eq T_PROG) { - return undef if $value eq ""; + die("invalid $type: $orig\n") if $value eq ""; } elsif ($type eq T_LOGIN) { - return undef if $value eq ""; + die("invalid $type: $orig\n") if $value eq ""; } elsif ($type eq T_IP) { - return undef if !is_ipv4($value) && !is_ipv6($value); + die("invalid $type: $orig\n") if !is_ipv4($value) && !is_ipv6($value); } elsif ($type eq T_IPV4) { - return undef if !is_ipv4($value); + die("invalid $type: $orig\n") if !is_ipv4($value); } elsif ($type eq T_IPV6) { - return undef if !is_ipv6($value); + die("invalid $type: $orig\n") if !is_ipv6($value); } return $value; } -###################################################################### -## encode_base64 - from MIME::Base64 -###################################################################### -sub encode_base64 ($;$) { - my $res = ''; - my $eol = $_[1]; - $eol = "\n" unless defined $eol; - pos($_[0]) = 0; # ensure start at the beginning - while ($_[0] =~ /(.{1,45})/gs) { - $res .= substr(pack('u', $1), 1); - chop($res); - } - $res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs - - # fix padding at the end - my $padding = (3 - length($_[0]) % 3) % 3; - $res =~ s/.{$padding}$/'=' x $padding/e if $padding; - $res; -} -###################################################################### -## load_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. + my ($protocol) = @_; + eval { require Digest::SHA; } or fatal(<<"EOM"); +Error loading the Perl module Digest::SHA needed for $protocol update. +On Debian, the package libdigest-sha-perl must be installed. EOM - } - if ($sha1_loaded) { - import Digest::SHA1 (qw/sha1_hex/); - } elsif ($sha_loaded) { - import Digest::SHA (qw/sha1_hex/); - } + Digest::SHA->import(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 // ''); - debug("protocol = %s", $use_ssl ? "https" : "http"); - debug("server = %s", $server); - (my $_url = $url) =~ s%\?.*%?%; #redact ALL parameters passed on URL, including possible passwords - 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.1\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 . - (my $rq = $request) =~ s/(? $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", $_ // ""); - $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; + my ($protocol) = @_; + eval { require JSON::PP; } + or fatal("Error loading the Perl module JSON::PP needed for $protocol update."); + JSON::PP->import(qw/decode_json encode_json/); } ###################################################################### @@ -2503,7 +2750,7 @@ sub curl_cmd { my @params = @_; my $tmpfile; my $tfh; - my $system_curl = quotemeta(subst_var('@CURL@', 'curl')); + my $curl = join(' ', @curl); my %curl_codes = ( ## Subset of error codes from https://curl.haxx.se/docs/manpage.html 2 => "Failed to initialize. (Most likely a bug in ddclient, please open issue at https://github.com/ddclient/ddclient)", 3 => "URL malformed. The syntax was not correct", @@ -2521,11 +2768,11 @@ sub curl_cmd { 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", + 127 => "$curl was not found", ); - debug("CURL: %s", $system_curl); - fatal("curl not found") if ($system_curl eq ''); + debug("CURL: %s", $curl); + fatal("curl not found") if ($curl[0] eq ''); return '' if (scalar(@params) == 0); ## no parameters provided # Hard code to /tmp rather than use system TMPDIR to protect from malicious @@ -2541,9 +2788,20 @@ sub curl_cmd { print($tfh @params); } close($tfh); - my $reply = qx{ $system_curl --config $tmpfile 2>/dev/null; }; + # Use open's list form (as opposed to qx, backticks, or the scalar form of open) to avoid the + # shell and reduce the risk of a shell injection vulnerability. ':raw' mode is used because + # HTTP is defined in terms of octets (bytes), not characters. In raw mode, each byte from curl + # is mapped to a same-valued codepoint (byte value 0x78 becomes character U+0078, 0xff becomes + # U+00ff). The caller is responsible for decoding the byte sequence if necessary. + open(my $cfh, '-|:raw', @curl, '--config', $tmpfile) + or fatal("failed to run curl ($curl): $!"); + # According to , adding ':raw' to the open + # mode is buggy with Perl < v5.14. Call binmode on the filehandle just in case. + binmode($cfh) or fatal("binmode failed: $!"); + my $reply = do { local $/; <$cfh>; }; + close($cfh); # Closing $cfh waits for the process to exit and sets $?. if ((my $rc = $?>>8) != 0) { - warning("CURL error (%d) %s", $rc, $curl_codes{$rc} // "Unknown return code. Check $system_curl is installed and its manpage."); + warning("CURL error (%d) %s", $rc, $curl_codes{$rc} // "Unknown return code. Check $curl is installed and its manpage."); } return $reply; } @@ -2565,10 +2823,8 @@ sub escape_curl_param { return $str; } -###################################################################### -## fetch_via_curl() is used for geturl() when global curl option set -###################################################################### -sub fetch_via_curl { +sub geturl { + local $_l = pushlogctx('HTTP request'); my %params = @_; my $proxy = $params{proxy}; my $url = $params{url}; @@ -2582,22 +2838,28 @@ sub fetch_via_curl { my $reply; my $server; my $use_ssl = 0; - my $force_ssl = 0; my $protocol; my $timeout = opt('timeout'); + my $redirect = opt('redirect'); my @curlopt = (); - my @header_lines = (); - ## canonify proxy and url - $force_ssl = 1 if ($url =~ /^https:/); + ## canonify use_ssl, proxy and url + if ($url =~ /^https:/) { + $use_ssl = 1; + } elsif ($url =~ /^http:/) { + $use_ssl = 0; + } elsif (opt('ssl') && !($params{ignore_ssl_option} // 0)) { + $use_ssl = 1; + } else { + $use_ssl = 0; + } + $proxy =~ s%^https?://%%i if defined($proxy); $url =~ s%^https?://%%i; $server = $url; $server =~ s%[?/].*%%; $url =~ s%^[^?/]*/?%%; - $use_ssl = 1 if ($force_ssl || ($globals{'ssl'} && !($params{ignore_ssl_option} // 0))); - $protocol = ($use_ssl ? "https" : "http"); debug("proxy = %s", $proxy // ''); @@ -2605,232 +2867,150 @@ sub fetch_via_curl { debug("server = %s", $server); (my $_url = $url) =~ s%\?.*%?%; #redact possible credentials debug("url = %s", $_url); - debug("ip ver = %s", $ipversion); + if ($ipversion != 0) { + debug("ip ver = %s", $ipversion); + } if (!opt('exec')) { - debug("skipped network connection"); - verbose("SENDING:", "%s", "${server}/${url}"); + info("would request: ${protocol}://${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 // ""); + push(@curlopt, "silent"); + push(@curlopt, "include"); ## Include HTTP response for compatibility + push(@curlopt, "insecure") if ($use_ssl && !($params{ssl_validate} // 1)); + push(@curlopt, "cacert=\"".escape_curl_param(opt('ssl_ca_file')).'"') if defined(opt('ssl_ca_file')); + push(@curlopt, "capath=\"".escape_curl_param(opt('ssl_ca_dir')).'"') if defined(opt('ssl_ca_dir')); + push(@curlopt, "ipv4") if ($ipversion == 4); + push(@curlopt, "ipv6") if ($ipversion == 6); + push(@curlopt, "user-agent=\"".escape_curl_param("${program}/${version}").'"'); + push(@curlopt, "connect-timeout=$timeout"); + push(@curlopt, "max-time=$timeout"); + push(@curlopt, "request=$method"); + push(@curlopt, "user=\"".escape_curl_param("${login}:${password}").'"') if (defined($login) && defined($password)); + push(@curlopt, "proxy=\"".escape_curl_param("${protocol}://${proxy}").'"') if defined($proxy); + push(@curlopt, "url=\"".escape_curl_param("${protocol}://${server}/${url}").'"'); + push(@curlopt, map('header="' . escape_curl_param($_) . '"', + ref($headers) eq 'ARRAY' ? @$headers : split('\n', $headers))); + + # Add in the data if any was provided (for POST/PATCH) + push(@curlopt, "data=\"".escape_curl_param(${data}).'"') if ($data); + + # Handle 30x redirections + if ($redirect) { + push(@curlopt, "location"); + push(@curlopt, "max-redirs=$redirect"); + } + + # don't include ${url} as that might expose login credentials + $0 = sprintf("%s - Curl system cmd sending to %s", $program, "${protocol}://${server}"); + debug(ctx => 'REQUEST', "curl config:\n" . join("\n", @curlopt)); + $reply = curl_cmd(@curlopt); + debug(ctx => 'RESPONSE', defined($reply) ? "reply:\n$reply" : ""); 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"); + if ($ipversion != 0) { + warning("curl cannot connect to %s://%s using IPv%s",${protocol},${server},$ipversion); + } else { + warning("curl cannot connect to %s://%s",${protocol},${server}); + } } } - $reply =~ s/\r//g if defined $reply; return $reply; } +# Collects and returns all configuration data that get_ip* needs to determine the IP address. This +# makes it possible to avoid redundant queries by comparing the configuration data for different +# hosts. +sub strategy_inputs { + my ($whichuse, $h) = @_; + my $use = opt($whichuse, $h); + my $strategies + = $whichuse eq 'use' ? \%ip_strategies + : $whichuse eq 'usev4' ? \%ipv4_strategies + : $whichuse eq 'usev6' ? \%ipv6_strategies + : undef; + my $s = $strategies->{$use}; + my @v = @{$s->{inputs} // []}; + return map({ $_ => opt($_, $h); } $whichuse, @v); +} + ###################################################################### ## get_ip ###################################################################### sub get_ip { - my $use = lc shift; - $use = 'disabled' if ($use eq 'no'); # backward compatibility - my $h = shift; - my ($ip, $arg, $reply, $url, $skip) = (undef, opt($use, $h), ''); - $arg = '' unless $arg; - - if ($use eq 'ip') { - $ip = opt('ip', $h); + my %p = @_; + my ($ip, $reply, $url, $skip) = (undef, ''); + my $argvar = $p{'use'}; + # Note that --use=firewallname uses --fw=arg, not --firewallname=arg. + $argvar = 'fw' if $builtinfw{$p{'use'}}; + my $arg = $p{$argvar}; + local $_l = pushlogctx("use=$p{'use'} $argvar=" . ($arg // '')); + + if ($p{'use'} eq 'ip') { + $ip = $arg; if (!is_ipv4($ip) && !is_ipv6($ip)) { - warning("'%s' is not a valid IPv4 or IPv6 address", $ip // ''); + warning('not a valid IPv4 or IPv6 address'); $ip = undef; } - $arg = 'ip'; - - } elsif ($use eq 'if') { + } elsif ($p{'use'} eq 'if') { $ip = get_ip_from_interface($arg); - - } elsif ($use eq 'cmd') { + } elsif ($p{'use'} eq 'cmd') { if ($arg) { - $skip = opt('cmd-skip', $h) // ''; + $skip = $p{'cmd-skip'}; $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'}; + } elsif ($p{'use'} eq 'web') { + $url = $arg; + $skip = $p{'web-skip'}; + if (my $biw = $builtinweb{$url}) { + warning("'$arg' is deprecated: $biw->{deprecated}") if $biw->{deprecated}; + $skip //= $biw->{skip}; + $url = $biw->{url}; } - $arg = $url; - if ($url) { $reply = geturl( - proxy => opt('proxy', $h), + proxy => opt('proxy'), url => $url, - ssl_validate => opt('web-ssl-validate', $h), - ) // ''; + ssl_validate => $p{'web-ssl-validate'}, + ); + if (header_ok($reply, \&warning)) { + $reply =~ s/^.*?\n\n//s; + } else { + $reply = undef; + } } - - } 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; - - } elsif ($use eq 'disabled') { + } elsif ($p{'use'} eq 'disabled') { ## This is a no-op... Do not get an IP address for this host/service $reply = ''; - - } 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 =~ /\//; + } elsif ($p{'use'} eq 'fw' || defined(my $fw = $builtinfw{$p{'use'}})) { + $url = $arg; + $skip = $p{'fw-skip'}; + if ($fw) { + $skip //= $fw->{'skip'}; + if (defined(my $query = $fw->{'query'})) { + $url = undef; + $reply = $query->(%p); + } else { + $url = "http://$url$fw->{'url'}" unless $url =~ /\//; + } } - $arg = $url; - if ($url) { $reply = geturl( url => $url, - login => opt('fw-login', $h), - password => opt('fw-password', $h), + login => $p{'fw-login'}, + password => $p{'fw-password'}, ignore_ssl_option => 1, - ssl_validate => opt('fw-ssl-validate', $h), - ) // ''; + ssl_validate => $p{'fw-ssl-validate'}, + ); + if (header_ok($reply, \&warning)) { + $reply =~ s/^.*?\n\n//s; + } else { + $reply = undef; + } } + } else { + warning("ignoring unsupported '--use' strategy: $p{'use'}"); } if (!defined $reply) { $reply = ''; @@ -2840,12 +3020,11 @@ sub get_ip { $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') { + if ($p{'use'} ne 'ip' && ($ip // '') eq '0.0.0.0') { $ip = undef; } - - debug("get_ip: using %s, %s reports %s", $use, $arg, $ip // ""); + warning('did not find an IPv4 or IPv6 address') if !defined($ip); + debug("found IP address: $ip") if $ip; return $ip; } @@ -3019,10 +3198,10 @@ sub get_default_interface { 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)); + 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) { + for my $line (@list) { ## Interface will be after "dev" or the last word in the line. Must accept blank spaces ## at the end. Interface name may not have any whitespace or forward slash. $line =~ /\bdev\b\s*\K[^\s\/]+|\b[^\s\/]+(?=[\s\/]*$)/; @@ -3102,7 +3281,7 @@ sub get_ip_from_interface { 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 + ## 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 @@ -3154,108 +3333,94 @@ sub get_ip_from_interface { ## get_ipv4 ###################################################################### sub get_ipv4 { - my $usev4 = lc(shift); ## Method to obtain IP address - my $h = shift; ## Host/service making the request - + my %p = @_; my $ipv4 = undef; ## Found IPv4 address my $reply = ''; ## Text returned from various methods my $url = ''; ## URL of website or firewall - my $skip = ''; ## Regex of pattern to skip before looking for IP - my $arg = opt($usev4, $h) // ''; ## Value assigned to the "usev4" method - - if ($usev4 eq 'ipv4') { + my $skip = undef; ## Regex of pattern to skip before looking for IP + my $argvar = $p{'usev4'}; + # Note that --usev4=firewallname uses --fwv4=arg, not --firewallname=arg. + $argvar = (defined($p{'fwv4'}) || !defined($p{'fw'})) ? 'fwv4' : 'fw' + if $builtinfw{$p{'usev4'}}; + my $arg = $p{$argvar}; + local $_l = pushlogctx("usev4=$p{'usev4'} $argvar=" . ($arg // '')); + + if ($p{'usev4'} eq 'ipv4') { ## Static IPv4 address is provided in "ipv4=
" - $ipv4 = $arg; + $ipv4 = $arg; if (!is_ipv4($ipv4)) { - warning("'%s' is not a valid IPv4",$ipv4 // ''); + warning('not a valid IPv4 address'); $ipv4 = undef; } - $arg = 'ipv4'; # For debug message at end of function - - } elsif ($usev4 eq 'ifv4') { + } elsif ($p{'usev4'} eq 'ifv4') { ## Obtain IPv4 address from interface mamed in "ifv4=" - warning("'if-skip' is deprecated and does nothing for IPv4") if (opt('verbose') && opt('if-skip', $h)); - $ipv4 = get_ip_from_interface($arg,4); - - } elsif ($usev4 eq 'cmdv4') { + $ipv4 = get_ip_from_interface($arg, 4); + } elsif ($p{'usev4'} eq 'cmdv4') { ## Obtain IPv4 address by executing the command in "cmdv4=" - warning("'cmd-skip' is deprecated and does nothing for IPv4") if (opt('verbose') && opt('cmd-skip', $h)); + warning("'--cmd-skip' ignored for '--usev4=$p{'usev4'}'") + if opt('verbose') && defined($p{'cmd-skip'}); if ($arg) { - my $sys_cmd = quotemeta($arg); - $reply = qx{$sys_cmd}; + $reply = qx{$arg}; $reply = '' if $?; } - - } elsif ($usev4 eq 'webv4') { + } elsif ($p{'usev4'} eq 'webv4') { ## Obtain IPv4 address by accessing website at url in "webv4=" $url = $arg; - $skip = opt('webv4-skip', $h) // ''; - if (exists $builtinweb{$url}) { - $skip = $builtinweb{$url}->{'skip'} unless $skip; - $url = $builtinweb{$url}->{'url'}; - $arg = $url; + $skip = $p{'webv4-skip'}; + if (my $biw = $builtinweb{$url}) { + warning("'$arg' is deprecated: $biw->{deprecated}") if $biw->{deprecated}; + $skip //= $biw->{skip}; + $url = $biw->{url}; } if ($url) { - $reply = geturl( proxy => opt('proxy', $h), + $reply = geturl( + proxy => opt('proxy'), url => $url, ipversion => 4, # when using a URL to find IPv4 address we should force use of IPv4 - ssl_validate => opt('ssl-validate', $h), - ) // ''; - } - - } elsif ($usev4 eq 'cisco' || $usev4 eq 'cisco-asa') { - # Stuff added to support Cisco router ip http or ASA https daemon - # User fw-login should only have level 1 access to prevent - # password theft. This is pretty harmless. - warning("'if' does nothing for IPv4. Use 'ifv4'") if (opt('if', $h)); - warning("'fw' does nothing for IPv4. Use 'fwv4'") if (opt('fw', $h)); - warning("'fw-skip' does nothing for IPv4. Use 'fwv4-skip'") if (opt('fw-skip', $h)); - my $queryif = opt('ifv4', $h) // opt('if', $h); - $skip = opt('fwv4-skip', $h) // opt('fw-skip', $h) // ''; - # Convert slashes to protected value "\/" - $queryif =~ s%\/%\\\/%g; - # Protect special HTML characters (like '?') - $queryif =~ s/([\?&= ])/sprintf("%%%02x", ord($1))/ge; - if ($usev4 eq 'cisco') { - $url = "http://" . (opt('fwv4', $h) // opt('fw', $h)) . "/level/1/exec/show/ip/interface/brief/${queryif}/CR"; - } else { - $url = "https://" . (opt('fwv4', $h) // opt('fw', $h)) . "/exec/show%20interface%20${queryif}"; + ssl_validate => $p{'web-ssl-validate'}, + ); + if (header_ok($reply, \&warning)) { + $reply =~ s/^.*?\n\n//s; + } else { + $reply = undef; + } } - $arg = $url; - $reply = geturl( - url => $url, - login => opt('fw-login', $h), - password => opt('fw-password', $h), - ipversion => 4, # when using a URL to find IPv4 address we should force use of IPv4 - ignore_ssl_option => 1, - ssl_validate => opt('ssl-validate', $h), - ) // ''; - - } elsif ($usev4 eq 'disabled') { + } elsif ($p{'usev4'} eq 'disabled') { ## This is a no-op... Do not get an IPv4 address for this host/service $reply = ''; - - } else { - warning("'fw' does nothing for IPv4. Use 'fwv4'") if (opt('fw', $h)); - warning("'fw-skip' does nothing for IPv4. Use 'fwv4-skip'") if (opt('fw-skip', $h)); - $url = opt('fwv4', $h) // opt('fw', $h) // ''; - $skip = opt('fwv4-skip', $h) // opt('fw-skip', $h) // ''; - - if (exists $builtinfw{$usev4}) { - $skip = $builtinfw{$usev4}->{'skip'} unless $skip; - $url = "http://${url}" . $builtinfw{$usev4}->{'url'} unless $url =~ /\//; + } elsif ($p{'usev4'} eq 'fwv4' || defined(my $fw = $builtinfw{$p{'usev4'}})) { + warning("'--fw' is deprecated; use '--fwv4' instead") + if (!defined($p{'fwv4'}) && defined($p{'fw'})); + warning("'--fw-skip' is deprecated; use '--fwv4-skip' instead") + if (!defined($p{'fwv4-skip'}) && defined($p{'fw-skip'})); + $url = $arg; + $skip = $p{'fwv4-skip'} // $p{'fw-skip'}; + if ($fw) { + $skip //= $fw->{'skip'}; + if (defined(my $query = $fw->{'queryv4'})) { + $url = undef; + $reply = $query->(%p); + } else { + $url = "http://$url$fw->{'url'}" unless $url =~ /\//; + } } - $arg = $url; if ($url) { $reply = geturl( url => $url, - login => opt('fw-login', $h), - password => opt('fw-password', $h), + login => $p{'fw-login'}, + password => $p{'fw-password'}, ipversion => 4, # when using a URL to find IPv4 address we should force use of IPv4 ignore_ssl_option => 1, - ssl_validate => opt('ssl-validate', $h), - ) // ''; + ssl_validate => $p{'fw-ssl-validate'}, + ); + if (header_ok($reply, \&warning)) { + $reply =~ s/^.*?\n\n//s; + } else { + $reply = undef; + } } + } else { + warning("ignoring unsupported '--usev4' strategy: $p{'usev4'}"); } ## Set to loopback address if no text set yet @@ -3267,8 +3432,9 @@ sub get_ipv4 { ## If $ipv4 not set yet look for IPv4 address in the $reply text $ipv4 //= extract_ipv4($reply); ## Return undef for loopback address unless statically assigned by "ipv4=0.0.0.0" - $ipv4 = undef if (($usev4 ne 'ipv4') && (($ipv4 // '') eq '0.0.0.0')); - debug("get_ipv4: using (%s, %s) reports %s", $usev4, $arg, $ipv4 // ""); + $ipv4 = undef if (($p{'usev4'} ne 'ipv4') && (($ipv4 // '') eq '0.0.0.0')); + warning('did not find an IPv4 address') if !defined($ipv4); + debug("found IPv4 address: $ipv4") if $ipv4; return $ipv4; } @@ -3276,95 +3442,76 @@ sub get_ipv4 { ## get_ipv6 ###################################################################### sub get_ipv6 { - my $usev6 = lc(shift); ## Method to obtain IP address - $usev6 = 'disabled' if ($usev6 eq 'no'); # backward compatibility - my $h = shift; ## Host/service making the request - + my %p = @_; my $ipv6 = undef; ## Found IPv6 address my $reply = ''; ## Text returned from various methods my $url = ''; ## URL of website or firewall - my $skip = ''; ## Regex of pattern to skip before looking for IP - my $arg = opt($usev6, $h) // ''; ## Value assigned to the "usev6" method - - if ($usev6 eq 'ipv6' || $usev6 eq 'ip') { + my $skip = undef; ## Regex of pattern to skip before looking for IP + my $argvar = $p{'usev6'}; + if (grep($p{'usev6'} eq $_, qw(ip if cmd web))) { + my $new = $p{'usev6'} . 'v6'; + warning("'--usev6=$p{'usev6'}' is deprecated; use '--usev6=$new'"); + $argvar = $new if defined($p{$new}); + } + # Note that --usev6=firewallname uses --fwv6=arg, not --firewallname=arg. + $argvar = 'fwv6' if $builtinfw{$p{'usev6'}}; + my $arg = $p{$argvar}; + local $_l = pushlogctx("usev6=$p{'usev6'} $argvar=" . ($arg // '')); + + if ($p{'usev6'} eq 'ipv6' || $p{'usev6'} eq 'ip') { ## Static IPv6 address is provided in "ipv6=
" - if ($usev6 eq 'ip') { - warning("'usev6=ip' is deprecated. Use 'usev6=ipv6'"); - $usev6 = 'ipv6'; - ## If there is a value for ipv6= use that, else use value for ip= - $arg = opt($usev6, $h) // $arg; - } $ipv6 = $arg; if (!is_ipv6($ipv6)) { - warning("'%s' is not a valid IPv6",$ipv6 // ''); + warning('not a valid IPv6 address'); $ipv6 = undef; } - $arg = 'ipv6'; # For debug message at end of function - - } elsif ($usev6 eq 'ifv6' || $usev6 eq 'if' ) { + } elsif ($p{'usev6'} eq 'ifv6' || $p{'usev6'} eq 'if') { ## Obtain IPv6 address from interface mamed in "ifv6=" - if ($usev6 eq 'if') { - warning("'usev6=if' is deprecated. Use 'usev6=ifv6'"); - $usev6 = 'ifv6'; - ## If there is a value for ifv6= use that, else use value for if= - $arg = opt($usev6, $h) // $arg; - } - warning("'if-skip' is deprecated and does nothing for IPv6") if (opt('verbose') && opt('if-skip', $h)); - $ipv6 = get_ip_from_interface($arg,6); - - } elsif ($usev6 eq 'cmdv6' || $usev6 eq 'cmd') { + $ipv6 = get_ip_from_interface($arg, 6); + } elsif ($p{'usev6'} eq 'cmdv6' || $p{'usev6'} eq 'cmd') { ## Obtain IPv6 address by executing the command in "cmdv6=" - if ($usev6 eq 'cmd') { - warning("'usev6=cmd' is deprecated. Use 'usev6=cmdv6'"); - $usev6 = 'cmdv6'; - ## If there is a value for cmdv6= use that, else use value for cmd= - $arg = opt($usev6, $h) // $arg; - } - warning("'cmd-skip' is deprecated and does nothing for IPv6") if (opt('verbose') && opt('cmd-skip', $h)); + warning("'--cmd-skip' ignored for '--usev6=$p{'usev6'}'") + if opt('verbose') && defined($p{'cmd-skip'}); if ($arg) { - my $sys_cmd = quotemeta($arg); - $reply = qx{$sys_cmd}; + $reply = qx{$arg}; $reply = '' if $?; } - - } elsif ($usev6 eq 'webv6' || $usev6 eq 'web') { + } elsif ($p{'usev6'} eq 'webv6' || $p{'usev6'} eq 'web') { ## Obtain IPv6 address by accessing website at url in "webv6=" - if ($usev6 eq 'web') { - warning("'usev6=web' is deprecated. Use 'usev6=webv6'"); - $usev6 = 'webv6'; - ## If there is a value for webv6= use that, else use value for web= - $arg = opt($usev6, $h) // $arg; - } - warning("'web-skip' does nothing for IPv6. Use 'webv6-skip'") if (opt('web-skip', $h)); + warning("'--web-skip' ignored; use '--webv6-skip' instead") + if (!defined($p{'webv6-skip'}) && defined($p{'web-skip'})); $url = $arg; - $skip = opt('webv6-skip', $h) // ''; - if (exists $builtinweb{$url}) { - $skip = $builtinweb{$url}->{'skip'} unless $skip; - $url = $builtinweb{$url}->{'url'}; - $arg = $url; + $skip = $p{'webv6-skip'}; + if (my $biw = $builtinweb{$url}) { + warning("'--webv6=$url' is deprecated! $biw->{deprecated}") if $biw->{deprecated}; + $skip //= $biw->{skip}; + $url = $biw->{url}; } if ($url) { $reply = geturl( proxy => opt('proxy'), url => $url, ipversion => 6, # when using a URL to find IPv6 address we should force use of IPv6 - ssl_validate => opt('ssl-validate', $h), - ) // ''; + ssl_validate => $p{'web-ssl-validate'}, + ); + if (header_ok($reply, \&warning)) { + $reply =~ s/^.*?\n\n//s; + } else { + $reply = undef; + } } - - } elsif ($usev6 eq 'cisco' || $usev6 eq 'cisco-asa') { - warning("'usev6=cisco' and 'usev6=cisco-asa' are not implemented and do nothing"); - $reply = ''; - - } elsif ($usev6 eq 'disabled') { - ## This is a no-op... Do not get an IPv6 address for this host/service - warning("'usev6=no' is deprecated. Use 'usev6=disabled'") if ($usev6 eq 'no'); + } elsif ($p{'usev6'} eq 'disabled') { $reply = ''; - + } elsif ($p{'usev6'} eq 'fwv6' || defined(my $fw = $builtinfw{$p{'usev6'}})) { + $skip = $p{'fwv6-skip'} // $fw->{'skip'}; + if ($fw && defined(my $query = $fw->{'queryv6'})) { + $skip //= $fw->{'skip'}; + $reply = $query->(%p); + } else { + warning("not implemented (does nothing)"); + } } else { - warning("'usev6=%s' is not implemented and does nothing", $usev6); - $reply = ''; - + warning("ignoring unsupported '--usev6' strategy: $p{'usev6'}"); } ## Set to loopback address if no text set yet @@ -3376,8 +3523,9 @@ sub get_ipv6 { ## If $ipv6 not set yet look for IPv6 address in the $reply text $ipv6 //= extract_ipv6($reply); ## Return undef for loopback address unless statically assigned by "ipv6=::" - $ipv6 = undef if (($usev6 ne 'ipv6') && (($ipv6 // '') eq '::')); - debug("get_ipv6: using (%s, %s) reports %s", $usev6, $arg, $ipv6 // ""); + $ipv6 = undef if (($p{'usev6'} ne 'ipv6') && ($p{'usev6'} ne 'ip') && (($ipv6 // '') eq '::')); + warning('did not find an IPv6 address') if !defined($ipv6); + debug("found IPv6 address: $ipv6") if $ipv6; return $ipv6; } @@ -3385,16 +3533,18 @@ sub get_ipv6 { ## group_hosts_by ###################################################################### sub group_hosts_by { -##TODO - Update for wantipv4 and wantipv6 - 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; + my ($hosts, @attrs) = @_; + my %attrs = map({ ($_ => undef); } @attrs); + @attrs = sort(keys(%attrs)); + my %groups; + my %cfgs; + for my $h (@$hosts) { + my %cfg = map({ ($_ => opt($_, $h)); } grep(defined(opt($_, $h)), @attrs)); + my $sig = repr(\%cfg, Indent => 0); + push(@{$groups{$sig}}, $h); + $cfgs{$sig} = \%cfg; + } + return map({ {cfg => $cfgs{$_}, hosts => $groups{$_}}; } keys(%groups)); } ###################################################################### @@ -3406,7 +3556,7 @@ sub encode_www_form_urlencoded { my $must_encode = qr'[<>"#%{}|\\^~\[\]`;/?:=&+]'; my $encoded; my $i = 0; - foreach my $k (keys %$formdata) { + for my $k (keys %$formdata) { my $kenc = $k; my $venc = $formdata->{$k}; @@ -3432,16 +3582,12 @@ sub encode_www_form_urlencoded { 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"; - } + for my $p (sort keys %protocols) { + my $example = $protocols{$p}->examples(); + chomp($example); + $examples .= $example; + $examples .= "\n\n$separator"; + $separator = "\n"; } my $intro = <<"EoEXAMPLE"; == CONFIGURING ${program} @@ -3496,242 +3642,102 @@ EoEXAMPLE ## Returns true if we can go ahead and update the IP address at server ###################################################################### sub nic_updateable { - my $host = shift; - my $sub = shift; + my ($host) = @_; + my $protocol = $protocols{opt('protocol', $host)}; my $update = 0; - my $ip = $config{$host}{'wantip'}; my $ipv4 = $config{$host}{'wantipv4'}; my $ipv6 = $config{$host}{'wantipv6'}; - my $use = opt('use', $host) // 'disabled'; - my $usev4 = opt('usev4', $host) // 'disabled'; - my $usev6 = opt('usev6', $host) // 'disabled'; - $use = 'disabled' if ($use eq 'no'); # backward compatibility - $usev6 = 'disabled' if ($usev6 eq 'no'); # backward compatibility - - # If we have a valid IP address and we have previously warned that it was invalid. - # reset the warning count back to zero. - if (($use ne 'disabled') && $ip && $warned_ip{$host}) { - $warned_ip{$host} = 0; - warning("IP address for %s valid: %s. Reset warning count", $host, $ip); - } - if (($usev4 ne 'disabled') && $ipv4 && $warned_ipv4{$host}) { - $warned_ipv4{$host} = 0; - warning("IPv4 address for %s valid: %s. Reset warning count", $host, $ipv4); - } - if (($usev6 ne 'disabled') && $ipv6 && $warned_ipv6{$host}) { - $warned_ipv6{$host} = 0; - warning("IPv6 address for %s valid: %s. Reset warning count", $host, $ipv6); - } - - if ($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); + my $inv_ip_warn_count = opt('max-warn'); + my $previp = $recap{$host}{'ip'} || ''; + my $previpv4 = $recap{$host}{'ipv4'} || ''; + my $previpv6 = $recap{$host}{'ipv6'} || ''; + my %prettyt = map({ ($_ => $recap{$host}{$_} ? prettytime($recap{$host}{$_}) : ''); } + qw(atime mtime wtime)); + my %prettyi = map({ ($_ => prettyinterval(opt($_, $host))); } + qw(max-interval min-error-interval min-interval)); + + $warned_ipv4{$host} = 0 if defined($ipv4); + $warned_ipv6{$host} = 0 if defined($ipv6); + + if (opt('force')) { + info("update forced via 'force' option"); $update = 1; - } elsif (!exists($cache{$host})) { - info("forcing updating %s because no cached entry exists.", $host); + } elsif (!exists($recap{$host})) { + info("update forced because the time of the previous update (or attempt) is unknown"); $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'} : ''), $ip, - prettytime($cache{$host}{'wtime'}) - ); + } elsif ($recap{$host}{'wtime'} && $recap{$host}{'wtime'} > $now) { + warning("cannot update IP until after $prettyt{'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'} : ''), $ip, - prettyinterval($config{$host}{'max-interval'}), - prettytime($cache{$host}{'mtime'}) - ); + } elsif ($recap{$host}{'mtime'} && interval_expired($host, 'mtime', 'max-interval')) { + info("update forced because it has been $prettyi{'max-interval'} since the previous update (on $prettyt{'mtime'})"); $update = 1; - } elsif ( ($use ne 'disabled') - && ((!exists($cache{$host}{'ip'})) || ("$cache{$host}{'ip'}" ne "$ip"))) { - ## Check whether to update IP address for the "use" method" - if (($cache{$host}{'status'} eq 'good') && + } elsif (defined($ipv4) && $previpv4 ne $ipv4) { + if (($recap{$host}{'status-ipv4'} // '') eq 'good' && !interval_expired($host, 'mtime', 'min-interval')) { + warning("skipped update from $previpv4 to $ipv4 because it has been less than $prettyi{'min-interval'} since the previous update (on $prettyt{'mtime'})") + if opt('verbose') || !($recap{$host}{'warned-min-interval'} // 0); - 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'} : ''), - $ip, - ($cache{$host}{'mtime'} ? prettytime($cache{$host}{'mtime'}) : ''), - 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')) { - - if ( opt('verbose') - || ( ! $cache{$host}{'warned-min-error-interval'} - && (($warned_ip{$host} // 0) < $inv_ip_warn_count)) ) { - - warning("skipping update of %s from %s to %s.\nlast updated %s but last attempt on %s failed.\nWait at least %s between update attempts.", - $host, - ($cache{$host}{'ip'} ? $cache{$host}{'ip'} : ''), - $ip, - ($cache{$host}{'mtime'} ? prettytime($cache{$host}{'mtime'}) : ''), - ($cache{$host}{'atime'} ? prettytime($cache{$host}{'atime'}) : ''), - prettyinterval($config{$host}{'min-error-interval'}) - ); - if (!$ip && !opt('verbose')) { - $warned_ip{$host} = ($warned_ip{$host} // 0) + 1; - warning("IP address for %s undefined. Warned %s times, suppressing further warnings", $host, $inv_ip_warn_count) - if ($warned_ip{$host} >= $inv_ip_warn_count); - } - } - - $cache{$host}{'warned-min-error-interval'} = $now; - - } else { - $update = 1; - } + $recap{$host}{'warned-min-interval'} = $now; - } elsif ( ($usev4 ne 'disabled') - && ((!exists($cache{$host}{'ipv4'})) || ("$cache{$host}{'ipv4'}" ne "$ipv4"))) { - ## Check whether to update IPv4 address for the "usev4" method" - if (($cache{$host}{'status-ipv4'} eq 'good') && - !interval_expired($host, 'mtime', 'min-interval')) { + } elsif (($recap{$host}{'status-ipv4'} // '') ne 'good' && + !interval_expired($host, 'atime', 'min-error-interval')) { - warning("skipping update of %s from %s to %s.\nlast updated %s.\nWait at least %s between update attempts.", - $host, - ($cache{$host}{'ipv4'} ? $cache{$host}{'ipv4'} : ''), - $ipv4, - ($cache{$host}{'mtime'} ? prettytime($cache{$host}{'mtime'}) : ''), - prettyinterval($config{$host}{'min-interval'}) - ) - if opt('verbose') || !($cache{$host}{'warned-min-interval'} // 0); - - $cache{$host}{'warned-min-interval'} = $now; - - } elsif (($cache{$host}{'status-ipv4'} ne 'good') && - !interval_expired($host, 'atime', 'min-error-interval')) { - - if ( opt('verbose') - || ( ! $cache{$host}{'warned-min-error-interval'} - && (($warned_ipv4{$host} // 0) < $inv_ip_warn_count)) ) { - - warning("skipping update of %s from %s to %s.\nlast updated %s but last attempt on %s failed.\nWait at least %s between update attempts.", - $host, - ($cache{$host}{'ipv4'} ? $cache{$host}{'ipv4'} : ''), - $ipv4, - ($cache{$host}{'mtime'} ? prettytime($cache{$host}{'mtime'}) : ''), - ($cache{$host}{'atime'} ? prettytime($cache{$host}{'atime'}) : ''), - prettyinterval($config{$host}{'min-error-interval'}) - ); + if (opt('verbose') || (!$recap{$host}{'warned-min-error-interval'} && + ($warned_ipv4{$host} // 0) < $inv_ip_warn_count)) { + warning("skipped update from $previpv4 to $ipv4 because it has been less than $prettyi{'min-error-interval'} since the previous update attempt (on $prettyt{'atime'}), which failed"); if (!$ipv4 && !opt('verbose')) { $warned_ipv4{$host} = ($warned_ipv4{$host} // 0) + 1; - warning("IPv4 address for %s undefined. Warned %s times, suppressing further warnings", $host, $inv_ip_warn_count) + warning("IPv4 address undefined. Warned $inv_ip_warn_count times, suppressing further warnings") if ($warned_ipv4{$host} >= $inv_ip_warn_count); } } - $cache{$host}{'warned-min-error-interval'} = $now; + $recap{$host}{'warned-min-error-interval'} = $now; } else { $update = 1; } - } elsif ( ($usev6 ne 'disabled') - && ((!exists($cache{$host}{'ipv6'})) || ("$cache{$host}{'ipv6'}" ne "$ipv6"))) { - ## Check whether to update IPv6 address for the "usev6" method" - if (($cache{$host}{'status-ipv6'} eq 'good') && + } elsif (defined($ipv6) && $previpv6 ne $ipv6) { + if (($recap{$host}{'status-ipv6'} // '') eq 'good' && !interval_expired($host, 'mtime', 'min-interval')) { + warning("skipped update from $previpv6 to $ipv6 because it has been less than $prettyi{'min-interval'} since the previous update (on $prettyt{'mtime'})") + if opt('verbose') || !($recap{$host}{'warned-min-interval'} // 0); - warning("skipping update of %s from %s to %s.\nlast updated %s.\nWait at least %s between update attempts.", - $host, - ($cache{$host}{'ipv6'} ? $cache{$host}{'ipv6'} : ''), - $ipv6, - ($cache{$host}{'mtime'} ? prettytime($cache{$host}{'mtime'}) : ''), - prettyinterval($config{$host}{'min-interval'}) - ) - if opt('verbose') || !($cache{$host}{'warned-min-interval'} // 0); - - $cache{$host}{'warned-min-interval'} = $now; - - } elsif (($cache{$host}{'status-ipv6'} ne 'good') && - !interval_expired($host, 'atime', 'min-error-interval')) { - - if ( opt('verbose') - || ( ! $cache{$host}{'warned-min-error-interval'} - && (($warned_ipv6{$host} // 0) < $inv_ip_warn_count)) ) { - - warning("skipping update of %s from %s to %s.\nlast updated %s but last attempt on %s failed.\nWait at least %s between update attempts.", - $host, - ($cache{$host}{'ipv6'} ? $cache{$host}{'ipv6'} : ''), - $ipv6, - ($cache{$host}{'mtime'} ? prettytime($cache{$host}{'mtime'}) : ''), - ($cache{$host}{'atime'} ? prettytime($cache{$host}{'atime'}) : ''), - prettyinterval($config{$host}{'min-error-interval'}) - ); + $recap{$host}{'warned-min-interval'} = $now; + + } elsif (($recap{$host}{'status-ipv6'} // '') ne 'good' && + !interval_expired($host, 'atime', 'min-error-interval')) { + + if (opt('verbose') || (!$recap{$host}{'warned-min-error-interval'} && + ($warned_ipv6{$host} // 0) < $inv_ip_warn_count)) { + warning("skipped update from $previpv6 to $ipv6 because it has been less than $prettyi{'min-error-interval'} since the previous update attempt (on $prettyt{'atime'}, which failed"); if (!$ipv6 && !opt('verbose')) { $warned_ipv6{$host} = ($warned_ipv6{$host} // 0) + 1; - warning("IPv6 address for %s undefined. Warned %s times, suppressing further warnings", $host, $inv_ip_warn_count) + warning("IPv6 address undefined. Warned $inv_ip_warn_count times, suppressing further warnings") if ($warned_ipv6{$host} >= $inv_ip_warn_count); } } - $cache{$host}{'warned-min-error-interval'} = $now; + $recap{$host}{'warned-min-error-interval'} = $now; } else { $update = 1; } - } elsif (defined($sub) && &$sub($host)) { + } elsif ($protocol->force_update($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 { if (opt('verbose')) { - if ($use ne 'disabled') { - success("%s: skipped: IP address was already set to %s.", $host, $ip); - } - if ($usev4 ne 'disabled') { - success("%s: skipped: IPv4 address was already set to %s.", $host, $ipv6); - } - if ($usev6 ne 'disabled') { - success("%s: skipped: IPv6 address was already set to %s.", $host, $ipv6); - } + success("skipped update because IPv4 address is already set to $ipv4") + if defined($ipv4); + success("skipped update because IPv6 address is already set to $ipv6") + if defined($ipv6); } } - - $config{$host}{'status'} = $cache{$host}{'status'} // ''; - $config{$host}{'status-ipv4'} = $cache{$host}{'status-ipv4'} // ''; - $config{$host}{'status-ipv6'} = $cache{$host}{'status-ipv6'} // ''; - $config{$host}{'update'} = $update; - if ($update) { - $config{$host}{'status'} = 'noconnect'; - $config{$host}{'status-ipv4'} = 'noconnect'; - $config{$host}{'status-ipv6'} = '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; } @@ -3739,28 +3745,51 @@ sub nic_updateable { ## 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); + my ($line, $errlog) = @_; + $errlog //= \&failed; + if (!$line) { + $errlog->("no response from server"); + return 0; + } + $line =~ s/\r?\n.*//s; + my ($code, $msg) = ($line =~ qr%^\s*HTTP/.*\s+(\d+)\s*(?:\s+([^\s].*))?$%i); + if (!defined($code)) { + $errlog->("unexpected HTTP response: $line"); + return 0; + } elsif ($code !~ qr/^2\d\d$/) { + my %msgs = ( + '401' => 'authentication failed', + '403' => 'not authorized', + ); + $errlog->("$code " . ($msg // $msgs{$code} // '')); + return 0; } - return $ok; + return 1; } + +###################################################################### +## DDNS providers +# A DDNS provider consists of an example function, the update +# function, and an optional force_update function. +# +# The example function simply returns a string for the help message, +# explaining how to configure the provider +# +# The update function performs the actual record update. +# It receives an array of hosts as its argument. +# +# The force_update function allows a provider implementation to force +# an update even if ddclient has itself determined no update is +# necessary. The function shall return 1 if an update should be +# performed, else 0. +###################################################################### + + ###################################################################### ## nic_dyndns1_examples ###################################################################### sub nic_dyndns1_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'dyndns1' @@ -3774,7 +3803,7 @@ Configuration variables applicable to the 'dyndns1' protocol are: 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} + wildcard=no|yes ## add a DNS wildcard CNAME record that points to login=service-login ## login name and password registered with the service password=service-password ## fully.qualified.host ## the host registered with the service. @@ -3798,87 +3827,61 @@ EoEXAMPLE ## nic_dyndns1_update ###################################################################### sub nic_dyndns1_update { - debug("\nnic_dyndns1_update -------------------"); + my $self = shift; ## update each configured host - foreach my $h (@_) { + for my $h (@_) { + local $_l = pushlogctx($h); my $ip = delete $config{$h}{'wantip'}; - info("setting IP address to %s for %s", $ip, $h); - verbose("UPDATE:", "updating %s", $h); + info("setting IP address to $ip"); my $url; - $url = "http://$config{$h}{'server'}/nic/"; - $url .= ynu($config{$h}{'static'}, 'statdns', 'dyndns', 'dyndns'); + $url = 'https://' . opt('server', $h) . '/nic/'; + $url .= ynu(opt('static', $h), 'statdns', 'dyndns', 'dyndns'); $url .= "?action=edit&started=1&hostname=YES&host_id=$h"; $url .= "&myip="; $url .= $ip if $ip; - $url .= "&wildcard=ON" if ynu($config{$h}{'wildcard'}, 1, 0, 0); - if ($config{$h}{'mx'}) { - $url .= "&mx=$config{$h}{'mx'}"; - $url .= "&backmx=" . ynu($config{$h}{'backupmx'}, 'YES', 'NO'); + $url .= "&wildcard=ON" if ynu(opt('wildcard', $h), 1, 0, 0); + if (opt('mx', $h)) { + $url .= '&mx=' . opt('mx', $h); + $url .= "&backmx=" . ynu(opt('backupmx', $h), 'YES', 'NO'); } my $reply = geturl( proxy => opt('proxy'), url => $url, - login => $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); + login => opt('login', $h), + password => opt('password', $h), + ); + next if !header_ok($reply); my @reply = split /\n/, $reply; my ($title, $return_code, $error_code) = ('', '', ''); - foreach my $line (@reply) { + for my $line (@reply) { $title = $1 if $line =~ m%\s*(.*)\s*%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; + $recap{$h}{'status'} = 'failed'; + $title = 'incomplete response from ' . opt('server', $h) unless $title; warning("SENT: %s", $url) unless opt('verbose'); warning("REPLIED: %s", $reply); - failed("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); + failed($title); + next; } + $recap{$h}{'ip'} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{'status'} = 'good'; + success("$return_code: IP address set to $ip ($title)"); } } -###################################################################### -## nic_dyndns2_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 { + my $self = shift; return <<"EoEXAMPLE"; o 'dyndns2' @@ -3892,10 +3895,8 @@ Configuration variables applicable to the 'dyndns2' protocol are: 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} + wildcard=no|yes ## add a DNS wildcard CNAME record that points to login=service-login ## login name and password registered with the service password=service-password ## fully.qualified.host ## the host registered with the service. @@ -3921,365 +3922,400 @@ Example ${program}.conf file entries: 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 $self = shift; my %errors = ( - 'badauth' => 'Bad authorization (username or password)', - 'badsys' => 'The system parameter given was not valid', - - 'notfqdn' => 'A Fully-Qualified Domain Name was not provided', - 'nohost' => 'The hostname specified does not exist in the database', - '!yours' => 'The hostname specified exists, but not under the username currently being used', - '!donator' => 'The offline setting was set, when the user is not a donator', - '!active' => 'The hostname specified is in a Custom DNS domain which has not yet been activated.', - 'abuse', => 'The hostname specified is blocked for abuse; you should receive an email notification ' . - 'which provides an unblock request link. More info can be found on ' . - 'https://www.dyndns.com/support/abuse.html', - - 'numhost' => 'System error: Too many or too few hosts found. Contact support@dyndns.org', - 'dnserr' => 'System error: DNS error encountered. Contact support@dyndns.org', - - 'nochg' => 'No update required; unnecessary attempts to change to the current address are considered abusive', + '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 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 @group_by_attrs = qw( + backupmx + login + mx + password + script + server + wantipv4 + wantipv6 + wildcard + ); + for my $group (group_hosts_by(\@_, @group_by_attrs)) { + my @hosts = @{$group->{hosts}}; + my %groupcfg = %{$group->{cfg}}; my $hosts = join(',', @hosts); - my $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'; + local $_l = pushlogctx($hosts); + my $ipv4 = $groupcfg{'wantipv4'}; + my $ipv6 = $groupcfg{'wantipv6'}; + delete $config{$_}{'wantipv4'} for @hosts; + delete $config{$_}{'wantipv6'} for @hosts; + info("setting IPv4 address to $ipv4") if $ipv4; + info("setting IPv6 address to $ipv6") if $ipv6; + my $url = "$groupcfg{'server'}$groupcfg{'script'}?hostname=$hosts&myip="; + $url .= $ipv4 if $ipv4; + if ($ipv6) { + $url .= "," if $ipv4; + $url .= $ipv6; } - - $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'); + $url .= "&wildcard=ON" if ynu($groupcfg{'wildcard'}, 1, 0, 0); + if ($groupcfg{'mx'}) { + $url .= "&mx=$groupcfg{'mx'}"; + $url .= "&backmx=" . ynu($groupcfg{'backupmx'}, 'YES', 'NO'); } - my $reply = geturl( proxy => opt('proxy'), url => $url, - login => $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); - + login => $groupcfg{'login'}, + password => $groupcfg{'password'}, + ); + next if !header_ok($reply); + # Some services can return 200 OK even if there is an error (e.g., bad authentication, + # updates too frequent) so the body of the response must also be checked. + (my $body = $reply) =~ s/^.*?\n\n//s; + my @reply = split(qr/\n/, $body); + # From : + # + # If updating multiple hostnames, hostname-specific return codes are given one per line, + # in the same order as the hostnames were specified. Return codes indicating a failure + # with the account or the system are given only once. + # + # If there is only one result for multiple hosts, this function assumes the one result + # applies to all hosts. According to the documentation quoted above this should only + # happen if the result is a failure. In case there is a single successful result, this + # code applies the success to all hosts (with a warning) to maximize potential + # compatibility with all DynDNS-like services. If there are zero results, or two or more + # results, any host without a corresponding result line is treated as a failure. + # + # TODO: The DynDNS documentation does not mention what happens if multiple IP addresses are + # supplied (e.g., IPv4 and IPv6) for a host. If one address fails to update and the other + # doesn't, is that one error status line? An error status line and a success status line? + # Or is an update considered to be all-or-nothing and the status applies to the collection + # of addresses as a whole? If the IPv4 address changes but not the IPv6 address does that + # result in a status of "good" because the set of addresses for a host changed even if a + # subset did not? + my @statuses = map({ (my $l = $_) =~ s/ .*$//; $l; } @reply); + if (@statuses < @hosts && @statuses == 1) { + warning("service returned one successful result for multiple hosts; " . + "assuming the one success is intended to apply to all hosts") + if $statuses[0] =~ qr/^(?:good|nochg)$/; + @statuses = ($statuses[0]) x @hosts; + } + for (my $i = 0; $i < @hosts; ++$i) { + my $h = $hosts[$i]; + local $_l = $_l->{parent}; $_l = pushlogctx($h); + my $status = $statuses[$i] // 'unknown'; + if ($status eq 'nochg') { + warning("$status: $errors{$status}"); + $status = 'good'; + } + $recap{$h}{'status-ipv4'} = $status if $ipv4; + $recap{$h}{'status-ipv6'} = $status if $ipv6; + if ($status ne 'good') { + if (exists($errors{$status})) { + failed("$status: $errors{$status}"); + } elsif ($status eq 'unknown') { + failed('server did not return a success/fail result; assuming failure'); } else { - failed("updating %s: unexpected status (%s)", $h, $line); + # This case can only happen if there is a corresponding status line for this + # host or there was only one status line for all hosts. + failed("unexpected status: " . ($reply[$i] // $reply[0])); } + next; } - } - failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'}) - if $state ne 'results2'; + # The IP address normally comes after the status, but we ignore it. We could compare + # it with the expected address and mark the update as failed if it differs, but (1) + # some services do not return the IP; and (2) comparison is brittle (e.g., + # 192.000.002.001 vs. 192.0.2.1) and false errors could cause high load on the service + # (an update attempt every min-error-interval instead of every max-interval). + $recap{$h}{'ipv4'} = $ipv4 if $ipv4; + $recap{$h}{'ipv6'} = $ipv6 if $ipv6; + $recap{$h}{'mtime'} = $now; + success("IPv4 address set to $ipv4") if $ipv4; + success("IPv6 address set to $ipv6") if $ipv6; + } + warning("unexpected extra lines after per-host update status lines:\n" . + join("\n", @reply[@hosts..$#reply])) + if (@reply > @hosts); } } ###################################################################### -## nic_dnsexit_examples +## nic_dnsexit2_examples ###################################################################### -sub nic_dnsexit_examples { +sub nic_dnsexit2_examples { + my $self = shift; return <<"EoEXAMPLE"; -o 'dnsexit' - -The 'dnsexit' protocol is the protocol used by the dynamic hostname services -of the 'DnsExit' dns services. This is currently used by the free -dynamic DNS service offered by www.dnsexit.com. - -Configuration variables applicable to the 'dnsexit' protocol are: - ssl=no ## turn off ssl - protocol=dnsexit ## - server=update.dnsexit.com ## defaults to update.dnsexit.com - use=web ## defaults to web - web=update.dnsexit.com ## defaults to update.dnsexit.com - script=/RemoteUpdate.sv ## defaults to /RemoteUpdate.sv - login=service-userid ## userid registered with the service - password=service-password ## password registered with the service - fully.qualified.host ## the host registered with the service. +o 'dnsexit2' + +The 'dnsexit2' protocol is the updated protocol for the (free) dynamic hostname services +of 'DNSExit' (www.dnsexit.com). Their API is accepting JSON payload. +Note that we only update the record, it must already exist in the DNSExit system +(A and/or AAAA records where applicable). + +Configuration variables applicable to the 'dnsexit2' protocol are: + protocol=dnsexit2 ## + password=YourAPIKey ## API Key of your account. + server=api.dnsexit.com ## defaults to api.dnsexit.com. + path=/dns/ ## defaults to /dns/. + ttl=5 ## defaults to 5 minutes. + zone='' ## defaults to empty, which assumes the zone is equal to the fully.qualified.host (is root of your DNSExit domain). + fully.qualified.host ## the host registered with the service. Example ${program}.conf file entries: ## single host update - protocol=dnsexit \\ - login=service-userid \\ - password=service-password \\ - fully.qualified.host + protocol=dnsexit2 + password=YourAPIKey + yourown.publicvm.com + + ## two hosts (which must be) on the same zone + protocol=dnsexit2 + password=YourAPIKey + zone=yourown.publicvm.com + host1.yourown.publicvm.com,host2.yourown.publicvm.com EoEXAMPLE } ###################################################################### -## nic_dnsexit_update -## -## written by Gonzalo Pérez de Olaguer Córdoba +## nic_dnsexit2_update ## -## based on https://www.dnsexit.com/Direct.sv?cmd=ipClients -## fetches this URL to update: -## https://update.dnsexit.com/RemoteUpdate.sv?login=yourlogin&password=yourpassword& -## host=yourhost.yourdomain.com&myip=xxx.xx.xx.xxx +## by @jortkoopmans +## based on https://dnsexit.com/dns/dns-api/ ## ###################################################################### -sub nic_dnsexit_update { - debug("\nnic_dnsexit_update -------------------"); - - my %status = ( - '0' => [ 'good', 'Success' ], - '1' => [ 'nochg', 'IP is the same as the IP on the system' ], - '2' => [ 'badauth', 'Invalid password' ], - '3' => [ 'badauth', 'User not found' ], - '4' => [ 'nochg', 'IP not changed. To save our system resources, please don\'t post updates unless the IP got changed.' ], - '10' => [ 'error', 'Hostname is not specified' ], - '11' => [ 'nohost', 'fail to find the domain' ], - '13' => [ 'error', 'parameter validation error' ], - ); - - ## 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); - - # Set the URL that we're going to update - my $url; - $url = "https://$config{$h}{'server'}$config{$h}{'script'}"; - $url .= "?login=$config{$h}{'login'}"; - $url .= "&password=$config{$h}{'password'}"; - $url .= "&host=$h"; - $url .= "&myip="; - $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'}); - last; - } - last if !header_ok($h, $reply); +sub nic_dnsexit2_update { + my $self = shift; + for my $h (@_) { + $config{$h}{'zone'} = $h if !defined(opt('zone', $h)); + } + dnsexit2_update_hostgroup($_) for group_hosts_by(\@_, qw(password path server ssl zone)); +} - # Response found - if ($reply =~ /(\d+)=(.+)/) { - my ($statuscode, $statusmsg) = ($1, $2); - if (exists $status{$statuscode}) { - my ($status, $message) = @{ $status{$statuscode} }; - if ($status =~ m'^(good|nochg)$') { - $config{$h}{'ip'} = $ip; - $config{$h}{'mtime'} = $now; - } - $config{$h}{'status'} = $status; - if ($status eq 'good') { - success("updating %s: good: IP address set to %s", $h, $ip); - } else { - warning("updating %s: %s: %s", $h, $status, $message); - } - } else { - $config{$h}{'status'} = 'failed'; - failed("updating %s: failed: unrecognized status code (%s)", $h, $statuscode); - } +sub dnsexit2_update_hostgroup { + my ($group) = @_; + return unless @{$group->{hosts}} > 0; + local $_l = pushlogctx(join(', ', @{$group->{hosts}})); + my %hostips; + my @updates; + for my $h (@{$group->{hosts}}) { + local $_l = pushlogctx($h) if @{$group->{hosts}} > 1; + my $name = $h; + # Remove the zone suffix from $name. If the zone eq $name, $name can be left alone or + # set to the empty string; both have identical semantics. For consistency, always + # remove the zone even if it means $name becomes the empty string. + if ($name =~ s/(?:^|\.)\Q$group->{cfg}{'zone'}\E$//) { + # The zone was successfully trimmed from $name. } else { - $config{$h}{'status'} = 'failed'; - warning("SENT: %s", $url) unless opt('verbose'); - warning("REPLIED: %s", $reply); - failed("updating %s: unrecognized reply.", $h); + fatal("hostname does not end with the zone: $group->{cfg}{'zone'}"); + } + # The IPv4 and IPv6 addresses must be updated together in a single API call. + for my $ipv ('4', '6') { + my $ip = delete($config{$h}{"wantipv$ipv"}) or next; + $hostips{$h}{$ipv} = $ip; + info("updating IPv$ipv address to $ip"); + $recap{$h}{"status-ipv$ipv"} = 'failed'; + push(@updates, { + name => $name, + type => ($ipv eq '6') ? 'AAAA' : 'A', + content => $ip, + ttl => opt('ttl', $h), + }); + } + } + return unless @updates > 0; + my $reply = geturl( + proxy => opt('proxy'), + url => $group->{cfg}{'server'} . $group->{cfg}{'path'}, + headers => [ + 'Content-Type: application/json', + 'Accept: application/json', + ], + method => 'POST', + data => encode_json({ + apikey => $group->{cfg}{'password'}, + domain => $group->{cfg}{'zone'}, + update => \@updates, + }), + ); + return if !header_ok($reply); + (my $body = $reply) =~ s/^.*?\r?\n\r?\n//s; + my $response = eval { decode_json($body); }; + if (ref($response) ne 'HASH') { + failed("response is not a JSON object:\n$body"); + return; + } + if (!defined($response->{'code'}) || !defined($response->{'message'})) { + failed("missing 'code' and 'message' properties in server response:\n$body"); + return; + } + my %codemeaning = ( + '0' => ['good', 'Success! Actions got executed successfully.'], + '1' => ['warning', 'Some execution problems. May not indicate actions failures. Some action may got executed fine and some may have problems.'], + '2' => ['badauth', 'API Key Authentication Error. The API Key is missing or wrong.'], + '3' => ['error', 'Missing Required Definitions. Your JSON file may missing some required definitions.'], + '4' => ['error', 'JSON Data Syntax Error. Your JSON file has syntax error.'], + '5' => ['error', 'JSON Defined Record Type not Supported. Your JSON may try to update some record type not supported by our system.'], + '6' => ['error', 'System Error. Our system problem. May not be your problem. Contact our support if you got such error.'], + '7' => ['error', 'Error getting post data. Our server has problem to receive your JSON posting.'], + ); + if (!exists($codemeaning{$response->{'code'}})) { + failed("unknown status code: $response->{'code'}"); + return; + } + my ($status, $message) = @{$codemeaning{$response->{'code'}}}; + info("$status: $message"); + info("server message: $response->{'message'}"); + info("server details: " . + (defined($response->{'details'}) ? $response->{'details'}[0] : "no details received")); + if ($status ne 'good') { + if ($status eq 'warning') { + warning($message); + warning("server response: $response->{'message'}"); + } elsif ($status =~ m'^(badauth|error)$') { + failed($message); + failed("server response: $response->{'message'}"); + } else { + failed("unexpected status: $status"); + } + return; + } + success($message); + keys(%hostips); # Reset internal iterator. + while (my ($h, $ips) = each(%hostips)) { + $recap{$h}{'mtime'} = $now; + keys(%$ips); # Reset internal iterator. + while (my ($ipv, $ip) = each(%$ips)) { + $recap{$h}{"ipv$ipv"} = $ip; + $recap{$h}{"status-ipv$ipv"} = 'good'; + success("updated IPv$ipv address to $ip"); } } } + ###################################################################### ## nic_noip_update ## Note: uses same features as nic_dyndns2_update, less return codes ###################################################################### sub nic_noip_update { - 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 $self = shift; my %errors = ( - 'badauth' => 'Invalid username or password', + 'badauth' => 'Invalid username or password', 'badagent' => 'Invalid user agent', - 'nohost' => 'The hostname specified does not exist in the database', + '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', + 'abuse', => 'The hostname specified is blocked for abuse; open a trouble ticket at https://www.no-ip.com', + 'numhost' => 'System error: Too many or too few hosts found. open a trouble ticket at https://www.no-ip.com', + 'dnserr' => 'System error: DNS error encountered. Contact support@dyndns.org', + 'nochg' => 'No update required; unnecessary attempts to change the current address are considered abusive', ); - - ## update each set of hosts that had similar configurations - foreach my $sig (keys %groups) { - my @hosts = @{$groups{$sig}}; + for my $group (group_hosts_by(\@_, qw(login password server wantipv4 wantipv6))) { + my @hosts = @{$group->{hosts}}; + my %groupcfg = %{$group->{cfg}}; my $hosts = join(',', @hosts); - my $h = $hosts[0]; - my $ip = $config{$h}{'wantip'}; - delete $config{$_}{'wantip'} foreach @hosts; + local $_l = pushlogctx($hosts); + my $ipv4 = $groupcfg{'wantipv4'}; + my $ipv6 = $groupcfg{'wantipv6'}; + delete $config{$_}{'wantipv4'} for @hosts; + delete $config{$_}{'wantipv6'} for @hosts; - info("setting IP address to %s for %s", $ip, $hosts); - verbose("UPDATE:", "updating %s", $hosts); + info("setting IPv4 address to $ipv4") if $ipv4; + info("setting IPv6 address to $ipv6") if $ipv6; - my $url = "http://$config{$h}{'server'}/nic/update?system="; - $url .= 'noip'; - $url .= "&hostname=$hosts"; - $url .= "&myip="; - $url .= $ip if $ip; + my $url = "https://$groupcfg{'server'}/nic/update?system=noip&hostname=$hosts&myip="; + $url .= $ipv4 if $ipv4; + if ($ipv6) { + $url .= "," if $ipv4; + $url .= $ipv6; + } my $reply = geturl( proxy => opt('proxy'), url => $url, - login => $config{$h}{'login'}, - password => $config{$h}{'password'}, - ) // ''; - if ($reply eq '') { - failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'}); + login => $groupcfg{'login'}, + password => $groupcfg{'password'}, + ); + next if !header_ok($reply); + (my $body = $reply) =~ s/^.*?\n\n//s or do { + failed("request to $groupcfg{'server'} failed"); next; - } - 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); + }; + my @reply = split(/\n/, $body); + for my $line (@reply) { + my ($status, $returnedips) = split / /, lc $line; + my $h = shift @hosts; + local $_l = $_l->{parent}; $_l = pushlogctx($h); + + for my $ip (split_by_comma($returnedips)) { + next if (!$ip); + my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4'; + $recap{$h}{"status-ipv$ipv"} = $status; + } - } 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'; + if ($status eq 'good') { + $recap{$h}{'mtime'} = $now; + for my $ip (split_by_comma($returnedips)) { + next if (!$ip); + my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4'; + $recap{$h}{"ipv$ipv"} = $ip; + success("$status: IPv$ipv address set to $ip"); + } - } else { - failed("updating %s: %s: %s", $h, $status, $errors{$status}); + } elsif (exists $errors{$status}) { + if ($status eq 'nochg') { + warning("$status: $errors{$status}"); + $recap{$h}{'mtime'} = $now; + for my $ip (split_by_comma($returnedips)) { + next if (!$ip); + my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4'; + $recap{$h}{"ipv$ipv"} = $ip; + $recap{$h}{"status-ipv$ipv"} = 'good'; } + } else { + failed("$status: $errors{$status}"); + } - } elsif ($status =~ /w(\d+)(.)/) { - my ($wait, $units) = ($1, lc $2); - my ($sec, $scale) = ($wait, 1); + } 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'; + ($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); + $sec = $wait * $scale; + $recap{$h}{'wtime'} = $now + $sec; + warning("$status: wait $wait $units before further updates"); - } else { - failed("updating %s: unexpected status (%s)", $h, $line); - } + } else { + failed("unexpected status: $line"); } } - failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'}) - if $state ne 'results2'; } } + ###################################################################### ## nic_noip_examples ###################################################################### sub nic_noip_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'noip' The 'No-IP Compatible' protocol is used to make dynamic dns updates over an http request. Details of the protocol are outlined at: -http://www.no-ip.com/integrate/ +https://www.noip.com/integrate/ Configuration variables applicable to the 'noip' protocol are: protocol=noip ## @@ -4302,6 +4338,7 @@ EoEXAMPLE ## nic_dslreports1_examples ###################################################################### sub nic_dslreports1_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'dslreports1' @@ -4330,16 +4367,16 @@ EoEXAMPLE ## nic_dslreports1_update ###################################################################### sub nic_dslreports1_update { - debug("\nnic_dslreports1_update -------------------"); + my $self = shift; ## update each configured host - foreach my $h (@_) { + for my $h (@_) { + local $_l = pushlogctx($h); my $ip = delete $config{$h}{'wantip'}; - info("setting IP address to %s for %s", $ip, $h); - verbose("UPDATE:", "updating %s", $h); + info("setting IP address to $ip"); my $url; - $url = "http://$config{$h}{'server'}/nic/"; - $url .= ynu($config{$h}{'static'}, 'statdns', 'dyndns', 'dyndns'); + $url = 'https://' . opt('server', $h) . '/nic/'; + $url .= ynu(opt('static', $h), 'statdns', 'dyndns', 'dyndns'); $url .= "?action=edit&started=1&hostname=YES&host_id=$h"; $url .= "&myip="; $url .= $ip if $ip; @@ -4347,39 +4384,92 @@ sub nic_dslreports1_update { my $reply = geturl( proxy => opt('proxy'), url => $url, - login => $config{$h}{'login'}, - password => $config{$h}{'password'}, + login => opt('login', $h), + password => opt('password', $h), ) // ''; if ($reply eq '') { - failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); + failed("request to " . opt('server', $h) . " failed"); next; } my @reply = split /\n/, $reply; my $return_code = ''; - foreach my $line (@reply) { + for my $line (@reply) { $return_code = $1 if $line =~ m%^return\s+code\s*:\s*(.*)\s*$%i; } if ($return_code !~ /NOERROR/) { - $config{$h}{'status'} = 'failed'; - warning("SENT: %s", $url) unless opt('verbose'); - warning("REPLIED: %s", $reply); - failed("updating %s", $h); + $recap{$h}{'status'} = 'failed'; + failed($reply); + next; + } + $recap{$h}{'ip'} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{'status'} = 'good'; + success("$return_code: IP address set to $ip"); + } +} - } else { - $config{$h}{'ip'} = $ip; - $config{$h}{'mtime'} = $now; - $config{$h}{'status'} = 'good'; - success("updating %s: %s: IP address set to %s", $h, $return_code, $ip); +###################################################################### +## nic_domeneshop_examples +###################################################################### +sub nic_domeneshop_examples { + my $self = shift; + return <<"EoEXAMPLE"; +o 'domeneshop' + +API is documented here: https://api.domeneshop.no/docs/ + +To generate credentials, visit https://www.domeneshop.no/admin?view=api after logging in to the control panel at +https://www.domeneshop.no/admin?view=api + +Configuration variables applicable to the 'domeneshop' api are: + protocol=domeneshop ## + login=token ## api-token + password=secret ## api-secret + domain.example.com ## the host registered with the service. ## the host registered with the service. + +Example ${program}.conf file entries: + ## single host update + protocol=domeneshop + login=username + password=your-password + my.example.com + +EoEXAMPLE +} + +###################################################################### +## nic_domeneshop_update +###################################################################### +sub nic_domeneshop_update { + my $self = shift; + for my $h (@_) { + local $_l = pushlogctx($h); + for my $ipv ('4', '6') { + my $ip = delete $config{$h}{"wantipv$ipv"} or next; + info("setting IPv$ipv address to $ip"); + my $reply = geturl( + proxy => opt('proxy'), + url => opt('server', $h) . "/v0/dyndns/update?hostname=$h&myip=$ip", + login => opt('login', $h), + password => opt('password', $h), + ); + next if !header_ok($reply); + $recap{$h}{"ipv$ipv"} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{"status-ipv$ipv"} = 'good'; + success("IPv$ipv address set to $ip"); } } } + ###################################################################### ## nic_zoneedit1_examples ###################################################################### sub nic_zoneedit1_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'zoneedit1' @@ -4409,13 +4499,6 @@ Example ${program}.conf file entries: EoEXAMPLE } -###################################################################### -## nic_zoneedit1_updateable -###################################################################### -sub nic_zoneedit1_updateable { - return 0; -} - ###################################################################### ## nic_zoneedit1_update # @@ -4423,43 +4506,38 @@ sub nic_zoneedit1_updateable { # ###################################################################### 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 $self = shift; + for my $group (group_hosts_by(\@_, qw(login password server zone wantip))) { + my @hosts = @{$group->{hosts}}; + my %groupcfg = %{$group->{cfg}}; my $hosts = join(',', @hosts); - my $h = $hosts[0]; - my $ip = $config{$h}{'wantip'}; - delete $config{$_}{'wantip'} foreach @hosts; + local $_l = pushlogctx($hosts); + my $ip = $groupcfg{'wantip'}; + delete $config{$_}{'wantip'} for @hosts; - info("setting IP address to %s for %s", $ip, $hosts); - verbose("UPDATE:", "updating %s", $hosts); + info("setting IP address to $ip"); my $url = ''; - $url .= "http://$config{$h}{'server'}/auth/dynamic.html"; + $url .= "https://$groupcfg{'server'}/auth/dynamic.html"; $url .= "?host=$hosts"; - $url .= "&dnsto=$ip" if $ip; - $url .= "&zone=$config{$h}{'zone'}" if defined $config{$h}{'zone'}; + $url .= "&dnsto=$ip" if $ip; + $url .= "&zone=$groupcfg{'zone'}" if defined $groupcfg{'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); + login => $groupcfg{'login'}, + password => $groupcfg{'password'}, + ); + next if !header_ok($reply); my @reply = split /\n/, $reply; - foreach my $line (@reply) { - if ($line =~ /^[^<]*<(SUCCESS|ERROR)\s+([^>]+)>(.*)/) { + # TODO: This is awkward and fragile -- it assumes that each line in the response body + # corresponds with each host in @hosts (and in the same order). + my $h = $hosts[0]; + for my $line (@reply) { + local $_l = $_l->{parent}; $_l = pushlogctx($h); + if ($h && $line =~ /^[^<]*<(SUCCESS|ERROR)\s+([^>]+)>(.*)/) { my ($status, $assignments, $rest) = ($1, $2, $3); my ($left, %var) = parse_assignments($assignments); @@ -4467,58 +4545,40 @@ sub nic_zoneedit1_update { 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'}; + $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'; + $recap{$h}{'ip'} = $status_ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{'status'} = 'good'; - success("updating %s: IP address set to %s (%s: %s)", $h, $ip, $status_code, $status_text); + success("IP address set to $ip ($status_code: $status_text)"); } else { - $config{$h}{'status'} = 'failed'; - failed("updating %s: %s: %s", $h, $status_code, $status_text); + $recap{$h}{'status'} = 'failed'; + failed("$status_code: $status_text"); } shift @hosts; - $h = $hosts[0]; + $h = $hosts[0]; $hosts = join(',', @hosts); } $line = $rest; redo if $line; } } - failed("updating %s: no response from %s", $hosts, $config{$h}{'server'}) - if @hosts; + if (@hosts) { + # @hosts was potentially mutated so redo the log context. + local $_l = $_l->{parent}; $_l = pushlogctx(join(',', @hosts)); + failed("no response from $groupcfg{'server'}"); + } } } -###################################################################### -## nic_easydns_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 { + my $self = shift; return <<"EoEXAMPLE"; o 'easydns' @@ -4531,7 +4591,7 @@ Configuration variables applicable to the 'easydns' protocol are: 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} + wildcard=no|yes ## add a DNS wildcard CNAME record that points to login=service-login ## login name and password registered with the service password=service-password ## fully.qualified.host ## the host registered with the service. @@ -4559,110 +4619,68 @@ Example ${program}.conf file entries: 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 $self = shift; my %errors = ( - 'NOACCESS' => 'Authentication failed. This happens if the username/password OR host or domain are wrong.', + 'NOACCESS' => 'Authentication failed. This happens if the username/password OR host or domain are wrong.', + 'NO_AUTH' => 'Authentication failed. This happens if the username/password OR host or domain are wrong.', 'NOSERVICE' => 'Dynamic DNS is not turned on for this domain.', - 'ILLEGAL' => 'Client sent data that is not allowed in a dynamic DNS update.', - 'TOOSOON' => 'Update frequency is too short.', + 'ILLEGAL INPUT' => '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); - - #'https://api.cp.easydns.com/dyn/generic.php?hostname=test.burry.ca&myip=10.20.30.40&wildcard=ON' - - my $url; - $url = "https://$config{$h}{'server'}$config{$h}{'script'}?"; - $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}); - + for my $h (@_) { + local $_l = pushlogctx($h); + for my $ipv ('4', '6') { + my $ip = delete $config{$h}{"wantipv$ipv"} or next; + info("setting IPv$ipv address to $ip"); + #'https://api.cp.easydns.com/dyn/generic.php?hostname=test.burry.ca&myip=10.20.30.40&wildcard=ON' + my $url = "https://" . opt('server', $h) . opt('script', $h) . "?hostname=$h&myip=$ip"; + $url .= "&wildcard=" . ynu(opt('wildcard', $h), 'ON', 'OFF', 'OFF') + if defined(opt('wildcard', $h)); + $url .= "&mx=" . opt('mx', $h) . "&backmx=" . ynu(opt('backupmx', $h), 'YES', 'NO') + if opt('mx', $h); + my $reply = geturl( + proxy => opt('proxy'), + url => $url, + login => opt('login', $h), + password => opt('password', $h), + ); + next if !header_ok($reply); + (my $body = $reply) =~ s/^.*?\n\n//s or do { + failed("could not connect to " . opt('server', $h)); + next; + }; + my $resultcode_re = join('|', map({quotemeta} 'NOERROR', keys(%errors))); + my ($status) = $body =~ qr/\b($resultcode_re)\b/; + # 'good' is the only status value that ddclient considers to be successful. All other + # values are considered to be failures and will result in frequent retries (every + # min-error-interval, which defaults to 5m). + $status = 'good' if ($status // '') =~ qr/^NOERROR|OK$/; + $recap{$h}{"status-ipv$ipv"} = $status; + if ($status ne 'good') { + if (exists $errors{$status}) { + failed("$status: $errors{$status}"); } else { - failed("updating %s: unexpected status (%s)", $h, $line); + failed("unexpected result: $body"); } - last; + next; } + $recap{$h}{"ipv$ipv"} = $ip; + $recap{$h}{'mtime'} = $now; + success("IPv$ipv address set to $ip"); } - failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'}) - if $state ne 'results2'; } } -###################################################################### ###################################################################### ## nic_namecheap_examples ###################################################################### sub nic_namecheap_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'namecheap' @@ -4698,45 +4716,36 @@ EoEXAMPLE ## ###################################################################### sub nic_namecheap_update { - - - debug("\nnic_namecheap1_update -------------------"); - + my $self = shift; ## update each configured host - foreach my $h (@_) { + for my $h (@_) { + local $_l = pushlogctx($h); my $ip = delete $config{$h}{'wantip'}; - info("setting IP address to %s for %s", $ip, $h); - verbose("UPDATE:", "updating %s", $h); + info("setting IP address to $ip"); my $url; - $url = "https://$config{$h}{'server'}/update"; - my $domain = $config{$h}{'login'}; + $url = 'https://' . opt('server', $h) . '/update'; + my $domain = opt('login', $h); my $host = $h; $host =~ s/(.*)\.$domain(.*)/$1$2/; $url .= "?host=$host"; $url .= "&domain=$domain"; - $url .= "&password=$config{$h}{'password'}"; + $url .= '&password=' . opt('password', $h); $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 = geturl(proxy => opt('proxy'), url => $url); + next if !header_ok($reply); my @reply = split /\n/, $reply; if (grep /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); + $recap{$h}{'ip'} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{'status'} = 'good'; + success("IP address set to $ip"); } else { - $config{$h}{'status'} = 'failed'; - warning("SENT: %s", $url) unless opt('verbose'); - warning("REPLIED: %s", $reply); - failed("updating %s: Invalid reply.", $h); + $recap{$h}{'status'} = 'failed'; + failed("invalid reply: $reply"); } } } @@ -4747,6 +4756,7 @@ sub nic_namecheap_update { ## nic_nfsn_examples ###################################################################### sub nic_nfsn_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'nfsn' @@ -4794,7 +4804,7 @@ sub nic_nfsn_gen_auth_header { ## 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'} . ';'; + $auth_header .= opt('login', $h) . ';'; ## timestamp is the standard 32-bit unsigned Unix timestamp ## value. @@ -4812,10 +4822,10 @@ sub nic_nfsn_gen_auth_header { ## 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'} . ';' . + my $hash_string = opt('login', $h) . ';' . $timestamp . ';' . $salt . ';' . - $config{$h}{'password'} . ';'; + opt('password', $h) . ';'; ## The request-uri value is the path portion of the requested URL ## (i.e. excluding the protocol and hostname). @@ -4843,7 +4853,7 @@ sub nic_nfsn_make_request { my $method = shift // 'GET'; my $body = shift // ''; - my $base_url = "https://$config{$h}{'server'}"; + my $base_url = 'https://' . opt('server', $h); my $url = $base_url . $path; my $header = nic_nfsn_gen_auth_header($h, $path, $body); if ($method eq 'POST' && $body ne '') { @@ -4869,13 +4879,13 @@ sub nic_nfsn_handle_error { $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); + failed("invalid error response: $resp"); return; } failed("%s", $json->{'error'}); if (defined $json->{'debug'}) { - failed("%s", $json->{'debug'}); + failed($json->{'debug'}); } } @@ -4892,18 +4902,18 @@ sub nic_nfsn_handle_error { ## ###################################################################### sub nic_nfsn_update { - debug("\nnic_nfsn_update -------------------"); - + my $self = shift; ## update each configured host - foreach my $h (@_) { - my $zone = $config{$h}{'zone'}; + for my $h (@_) { + local $_l = pushlogctx($h); + my $zone = opt('zone', $h); 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); + $recap{$h}{'status'} = 'failed'; + failed("$h is outside zone $zone"); next; } else { $name = $h; @@ -4911,14 +4921,13 @@ sub nic_nfsn_update { } my $ip = delete $config{$h}{'wantip'}; - info("setting IP address to %s for %s", $ip, $h); - verbose("UPDATE", "updating %s", $h); + info("setting IP address to $ip"); my $list_path = "/dns/$zone/listRRs"; my $list_body = encode_www_form_urlencoded({name => $name, type => 'A'}); my $list_resp = nic_nfsn_make_request($h, $list_path, 'POST', $list_body); - if (!header_ok($h, $list_resp)) { - $config{$h}{'status'} = 'failed'; + if (!header_ok($list_resp)) { + $recap{$h}{'status'} = 'failed'; nic_nfsn_handle_error($list_resp, $h); next; } @@ -4926,12 +4935,12 @@ sub nic_nfsn_update { $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); + $recap{$h}{'status'} = 'failed'; + failed("JSON decoding failure"); next; } - my $rr_ttl = $config{$h}{'ttl'}; + my $rr_ttl = opt('ttl', $h); if (ref($list) eq 'ARRAY' && defined $list->[0]->{'data'}) { my $rr_data = $list->[0]->{'data'}; @@ -4942,9 +4951,9 @@ sub nic_nfsn_update { 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); + if (!header_ok($rm_resp)) { + $recap{$h}{'status'} = 'failed'; + nic_nfsn_handle_error($rm_resp, $h); next; } } @@ -4957,13 +4966,13 @@ sub nic_nfsn_update { 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); + if (header_ok($add_resp)) { + $recap{$h}{'ip'} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{'status'} = 'good'; + success("IP address set to $ip"); } else { - $config{$h}{'status'} = 'failed'; + $recap{$h}{'status'} = 'failed'; nic_nfsn_handle_error($add_resp, $h); } } @@ -4972,14 +4981,121 @@ sub nic_nfsn_update { ###################################################################### ###################################################################### -## nic_sitelutions_examples +## nic_njalla_examples ###################################################################### -sub nic_sitelutions_examples { +sub nic_njalla_examples { + my $self = shift; return <<"EoEXAMPLE"; -o 'sitelutions' +o 'njalla' -The 'sitelutions' protocol is used by DNS services offered by www.sitelutions.com. +The 'njalla' protocol is used by DNS service offered by njal.la. + +Configuration variables applicable to the 'njalla' protocol are: + protocol=njalla ## + password=service-password ## Generated password for your dynamic DNS record + quietreply=no|yes ## If yes return empty response on success with status 200 but print errors + domain ## subdomain to update, use @ for base domain name, * for catch all + +Example ${program}.conf file entries: + ## single host update + protocol=njalla \\ + password=njal.la-key + quietreply=no + domain.com + +EoEXAMPLE +} +###################################################################### +## nic_njalla_update +## +## written by satrapes +## +## based on https://njal.la/docs/ddns/ +## needs this url to update: +## https://njal.la/update?h=host_name&k=domain_password&a=your_ip +## response contains "code 200" on succesful completion +###################################################################### +sub nic_njalla_update { + my $self = shift; + for my $h (@_) { + local $_l = pushlogctx($h); + # Read input params + my $ipv4 = delete $config{$h}{'wantipv4'}; + my $ipv6 = delete $config{$h}{'wantipv6'}; + my $quietreply = opt('quietreply', $h); + my $ip_output = ''; + + # Build url + my $url = 'https://' . opt('server', $h) . "/update/?h=$h&k=" . opt('password', $h); + my $auto = 1; + for my $ip ($ipv4, $ipv6) { + next if (!$ip); + $auto = 0; + my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4'; + my $type = ($ip eq ($ipv6 // '')) ? 'aaaa' : 'a'; + $ip_output .= " IP v$ipv: $ip,"; + $url .= "&$type=$ip"; + } + $url .= (($auto eq 1)) ? '&auto' : ''; + $url .= (($quietreply eq 1)) ? '&quiet' : ''; + + info("setting address to" . ($ip_output eq '') ? ' auto' : $ip_output); + debug("url: %s", $url); + + # Try to get URL + my $reply = geturl(proxy => opt('proxy'), url => $url); + my $response = ''; + my $status = 'bad'; + if ($quietreply) { + $reply =~ qr/invalid host or key/mp; + $response = ${^MATCH}; + if (!$response) { + $status = 'good'; + success("IP address set to $ip_output"); + } + elsif ($response =~ /invalid host or key/) { + failed("Invalid host or key"); + } else { + failed("Unknown response"); + } + } else { + $reply =~ qr/{(?:[^{}]*|(?R))*}/mp; + $response = eval {decode_json(${^MATCH})}; + # No response, declare as failed + if (!defined($reply) || !$reply) { + failed("could not connect to " . opt('server', $h)); + } else { + # Strip header + if ($response->{status} == 401 && $response->{message} =~ /invalid host or key/) { + failed("Invalid host or key"); + } elsif ($response->{status} == 200 && $response->{message} =~ /record updated/) { + $status = 'good'; + success("IP address set to $response->{value}->{A}"); + } else { + failed("Unknown response"); + } + } + } + if ($status eq 'good') { + $recap{$h}{'ipv4'} = $ipv4 if $ipv4; + $recap{$h}{'ipv6'} = $ipv6 if $ipv6; + } + $recap{$h}{'status-ipv4'} = $status if $ipv4; + $recap{$h}{'status-ipv6'} = $status if $ipv6; + } +} + +###################################################################### +## nic_sitelutions_examples +###################################################################### +sub nic_sitelutions_examples { + my $self = shift; + return <<"EoEXAMPLE"; + +o 'sitelutions' + +The 'sitelutions' protocol is used by DNS services offered by www.sitelutions.com. Configuration variables applicable to the 'sitelutions' protocol are: protocol=sitelutions ## @@ -5002,49 +5118,42 @@ EoEXAMPLE ## ## written by Mike W. Smith ## -## based on http://www.sitelutions.com/help/dynamic_dns_clients#updatespec +## based on https://www.sitelutions.com/help/dynamic_dns_clients#updatespec ## needs this url to update: ## https://www.sitelutions.com/dnsup?id=990331&user=myemail@mydomain.com&pass=SecretPass&ip=192.168.10.4 ## domain=domain.com&password=domain_password&ip=your_ip ## ###################################################################### sub nic_sitelutions_update { - - - debug("\nnic_sitelutions_update -------------------"); - + my $self = shift; ## update each configured host - foreach my $h (@_) { + for my $h (@_) { + local $_l = pushlogctx($h); my $ip = delete $config{$h}{'wantip'}; - info("setting IP address to %s for %s", $ip, $h); - verbose("UPDATE:", "updating %s", $h); + info("setting IP address to $ip"); my $url; - $url = "http://$config{$h}{'server'}/dnsup"; + $url = 'https://' . opt('server', $h) . '/dnsup'; $url .= "?id=$h"; - $url .= "&user=$config{$h}{'login'}"; - $url .= "&pass=$config{$h}{'password'}"; + $url .= '&user=' . opt('login', $h); + $url .= '&pass=' . opt('password', $h); $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); + next if !header_ok($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); + $recap{$h}{'ip'} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{'status'} = 'good'; + success("IP address set to $ip"); } else { - $config{$h}{'status'} = 'failed'; + $recap{$h}{'status'} = 'failed'; warning("SENT: %s", $url) unless opt('verbose'); warning("REPLIED: %s", $reply); - failed("updating %s: Invalid reply.", $h); + failed("invalid reply"); } } } @@ -5055,6 +5164,7 @@ sub nic_sitelutions_update { ## nic_freedns_examples ###################################################################### sub nic_freedns_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'freedns' @@ -5080,10 +5190,10 @@ EoEXAMPLE ###################################################################### ## nic_freedns_update ## -## API v1 documented at http://freedns.afraid.org/api/ +## API v1 documented at https://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= +## https://freedns.afraid.org/api/?action=getdyndns&v=2&sha= ## The returned list looks like: ## ## hostname1.example.com|1.2.3.4|http://example/update/url1 @@ -5105,21 +5215,21 @@ EoEXAMPLE ## failure. ###################################################################### sub nic_freedns_update { - debug("\nnic_freedns_update -------------------"); + my $self = shift; # Separate the records that are currently holding IPv4 addresses from the records that are # currently holding IPv6 addresses so that we can avoid switching a record to a different # address type. my %recs_ipv4; my %recs_ipv6; - my $url_tmpl = "http://$config{$_[0]}{'server'}/api/?action=getdyndns&v=2&sha="; - my $creds = sha1_hex("$config{$_[0]}{'login'}|$config{$_[0]}{'password'}"); + my $url_tmpl = 'https://' . opt('server', $_[0]) . '/api/?action=getdyndns&v=2&sha='; + my $creds = sha1_hex(opt('login', $_[0]) . '|' . opt('password', $_[0])); (my $url = $url_tmpl) =~ s//$creds/; my $reply = geturl(proxy => opt('proxy'), url => $url ); my $record_list_error = ''; - if ($reply && header_ok($_[0], $reply)) { + if (header_ok($reply)) { $reply =~ s/^.*?\n\n//s; # Strip the headers. for (split("\n", $reply)) { my @rec = split(/\|/); @@ -5137,38 +5247,39 @@ sub nic_freedns_update { $record_list_error = "failed to get record list from $url_tmpl"; } - foreach my $h (@_) { + for my $h (@_) { + local $_l = pushlogctx($h); next if (!$h); my $ipv4 = delete $config{$h}{'wantipv4'}; my $ipv6 = delete $config{$h}{'wantipv6'}; if ($record_list_error ne '') { - $config{$h}{'status-ipv4'} = 'failed' if ($ipv4); - $config{$h}{'status-ipv6'} = 'failed' if ($ipv6); - failed("updating %s: %s", $h, $record_list_error); + $recap{$h}{'status-ipv4'} = 'failed' if ($ipv4); + $recap{$h}{'status-ipv6'} = 'failed' if ($ipv6); + failed($record_list_error); next; } # IPv4 and IPv6 handling are similar enough to do in a loop... - foreach my $ip ($ipv4, $ipv6) { + for my $ip ($ipv4, $ipv6) { next if (!$ip); my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4'; my $type = ($ip eq ($ipv6 // '')) ? 'AAAA' : 'A'; my $rec = ($ip eq ($ipv6 // '')) ? $recs_ipv6{$h} : $recs_ipv4{$h}; if (!$rec) { - failed("updating %s: Cannot set IPv$ipv to %s No '$type' record at FreeDNS", $h, $ip); + failed("cannot set IPv$ipv to $ip: no '$type' record at FreeDNS"); next; } - info("updating %s: setting IP address to %s", $h, $ip); - $config{$h}{"status-ipv$ipv"} = 'failed'; + info("setting IP address to $ip"); + $recap{$h}{"status-ipv$ipv"} = 'failed'; if ($ip eq $rec->[1]) { - $config{$h}{"ipv$ipv"} = $ip; - $config{$h}{'mtime'} = $now; - $config{$h}{"status-ipv$ipv"} = 'good'; - success("updating %s: update not necessary, '$type' record already set to %s", $h, $ip) + $recap{$h}{"ipv$ipv"} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{"status-ipv$ipv"} = 'good'; + success("update not necessary, '$type' record already set to $ip") if (!$daemon || opt('verbose')); } else { my $url = $rec->[2] . "&address=" . $ip; @@ -5178,30 +5289,104 @@ sub nic_freedns_update { my $reply = geturl(proxy => opt('proxy'), url => $url ); - if ($reply && header_ok($h, $reply)) { + if (header_ok($reply)) { $reply =~ s/^.*?\n\n//s; # Strip the headers. if ($reply =~ /Updated.*$h.*to.*$ip/) { - $config{$h}{"ipv$ipv"} = $ip; - $config{$h}{'mtime'} = $now; - $config{$h}{"status-ipv$ipv"} = 'good'; - success("updating %s: good: IPv$ipv address set to %s", $h, $ip); + $recap{$h}{"ipv$ipv"} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{"status-ipv$ipv"} = 'good'; + success("IPv$ipv address set to $ip"); } else { warning("SENT: %s", $url_tmpl) unless opt('verbose'); warning("REPLIED: %s", $reply); - failed("updating %s: Invalid reply.", $h); + failed("invalid reply"); } - } else { - failed("updating %s: Could not connect to %s.", $h, $url_tmpl); } } } } } +###################################################################### +## nic_1984_examples +###################################################################### +sub nic_1984_examples { + my $self = shift; + return <<"EoEXAMPLE"; + +o '1984' + +The '1984' protocol is used by DNS services offered by 1984.is. + +Configuration variables applicable to the '1984' protocol are: + protocol=1984 ## + password=api-key ## your API key + fully.qualified.host ## the domain to update + +Example ${program}.conf file entries: + ## single host update + protocol=1984, \\ + password=my-1984-api-key, \\ + myhost + +EoEXAMPLE +} + +###################################################################### +## nic_1984_update +## https://api.1984.is/1.0/freedns/?apikey=xxx&domain=mydomain&ip=myip +## The response is a JSON document containing the following entries +## - ok: true or false depending on if the request was successful or not, +## if the ip is the same as before this will be true, +## - msg: successes or why it is not working, +## - lookup: if domain or subdomain was not found lookup will contain a list of names tried +###################################################################### +sub nic_1984_update { + my $self = shift; + for my $host (@_) { + local $_l = pushlogctx($host); + my $ip = delete $config{$host}{'wantip'}; + info("setting IP address to $ip"); + + my $url; + $url = 'https://' . opt('server', $host) . '/1.0/freedns/'; + $url .= '?apikey=' . opt('password', $host); + $url .= "&domain=$host"; + $url .= "&ip=$ip"; + + my $reply = geturl( + proxy => opt('proxy'), + url => $url, + ); + next if !header_ok($reply); + + # Strip header + $reply =~ qr/{(?:[^{}]*|(?R))*}/mp; + my $response = eval { decode_json(${^MATCH}) }; + if ($@) { + failed("JSON decoding failure"); + next; + } + unless ($response->{ok}) { + failed("%s", $response->{msg}); + next; + } + + $recap{$host}{'status'} = 'good'; + $recap{$host}{'ip'} = $ip; + if ($response->{msg} =~ /unaltered/) { + success("skipped: IP was already set to $response->{ip}"); + } else { + success("updated successfully to $response->{ip}"); + } + } +} + ###################################################################### ## nic_changeip_examples ###################################################################### sub nic_changeip_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'changeip' @@ -5234,18 +5419,15 @@ EoEXAMPLE ## ###################################################################### sub nic_changeip_update { - - - debug("\nnic_changeip_update -------------------"); - + my $self = shift; ## update each configured host - foreach my $h (@_) { + for my $h (@_) { + local $_l = pushlogctx($h); my $ip = delete $config{$h}{'wantip'}; - info("setting IP address to %s for %s", $ip, $h); - verbose("UPDATE:", "updating %s", $h); + info("setting IP address to $ip"); my $url; - $url = "http://$config{$h}{'server'}/nic/update"; + $url = 'https://' . opt('server', $h) . '/nic/update'; $url .= "?hostname=$h"; $url .= "&ip="; $url .= $ip if $ip; @@ -5253,106 +5435,292 @@ sub nic_changeip_update { my $reply = geturl( proxy => opt('proxy'), url => $url, - login => $config{$h}{'login'}, - password => $config{$h}{'password'}, + login => opt('login', $h), + password => opt('password', $h), ); - if (!defined($reply) || !$reply) { - failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); - next; - } - next if !header_ok($h, $reply); + next if !header_ok($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); + $recap{$h}{'ip'} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{'status'} = 'good'; + success("IP address set to $ip"); } else { - $config{$h}{'status'} = 'failed'; + $recap{$h}{'status'} = 'failed'; warning("SENT: %s", $url) unless opt('verbose'); warning("REPLIED: %s", $reply); - failed("updating %s: Invalid reply.", $h); + failed("invalid reply"); } } } ###################################################################### -## nic_googledomains_examples +## nic_godaddy_examples ## -## written by Nelson Araujo +## written by awalon ## ###################################################################### -sub nic_googledomains_examples { +sub nic_godaddy_examples { + my $self = shift; return <<"EoEXAMPLE"; -o 'googledomains' -The 'googledomains' protocol is used by DNS service offered by www.google.com/domains. +o 'godaddy' -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. +The 'godaddy' protocol is used by DNS service offered by https://www.godaddy.com/domains. + +Configuration variables applicable to the 'godaddy' protocol are: + protocol=godaddy ## + login=my-generated-token ## the token/key name provided by the API interface + password=my-generated-secret ## the secret provided by the API interface + zone=domain.tld ## the domain used for DNS update. + ttl=600 ## time to live of the record; + hostname.domain.tld ## hostname/subdomain Example ${program}.conf file entries: ## single host update - protocol=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 + protocol=godaddy \\ + login=my-generated-token \\ + password=my-generated-secret \\ + zone=example.com \\ + hostname.example.com + + ## multiple host update to the DNS service + protocol=godaddy \\ + login=my-generated-token \\ + password=my-generated-secret \\ + zone=example.com \\ + host1.example.com,host2.example.com EoEXAMPLE } + ###################################################################### -## nic_googledomains_update +## nic_godaddy_update ###################################################################### -sub nic_googledomains_update { - debug("\nnic_googledomains_update -------------------"); +sub nic_godaddy_update { + my $self = shift; + for my $h (@_) { + local $_l = pushlogctx($h); + my $zone = opt('zone', $h); + (my $hostname = $h) =~ s/\.\Q$zone\E$//; + for my $ipv ('4', '6') { + my $ip = delete($config{$h}{"wantipv$ipv"}) or next; + info("setting IPv$ipv address to $ip"); + my $rrset_type = ($ipv eq '6') ? 'AAAA' : 'A'; + my $url = "https://" . opt('server', $h) . "/$zone/records/$rrset_type/$hostname"; + my $reply = geturl( + proxy => opt('proxy'), + url => $url, + headers => [ + 'Content-Type: application/json', + 'Accept: application/json', + "Authorization: sso-key " . opt('login', $h) . ":" . opt('password', $h), + ], + method => 'PUT', + data => encode_json([{ + data => $ip, + defined(opt('ttl', $h)) ? (ttl => opt('ttl', $h)) : (), + name => $hostname, + type => $rrset_type, + }]), + ); + unless ($reply) { + failed("could not connect to " . opt('server', $h)); + next; + } + (my $code) = ($reply =~ m%^s*HTTP/.*\s+(\d+)%i); + my $ok = header_ok($reply); + $reply =~ s/^.*?\n\n//s; + my $response = eval {decode_json($reply)}; + if (!defined($response)) { + failed("unexpected or empty service response, cannot parse data"); + next; + } elsif (defined($response->{code})) { + info("$response->{code} - $response->{message}"); + } + if (!$ok) { + my $msg; + if ($code eq "400") { + $msg = 'GoDaddy API URL ($url) was malformed.'; + } elsif ($code eq "401") { + if (opt('login', $h)) { + $msg = 'login or password option incorrect.'; + } else { + $msg = 'login or password option missing.'; + } + $msg .= ' Correct values can be obtained from from https://developer.godaddy.com/keys/.'; + } elsif ($code eq "403") { + $msg = 'Customer identified by login and password options denied permission.'; + } elsif ($code eq "404") { + $msg = "\"$h\" not found at GoDaddy, please check zone option and login/password."; + } elsif ($code eq "422") { + $msg = "\"$h\" has invalid domain or lacks A/AAAA record."; + } elsif ($code eq "429") { + $msg = 'Too many requests to GoDaddy within brief period.'; + } elsif ($code eq "503") { + $msg = "\"$h\" is unavailable."; + } else { + $msg = 'Unexpected service response.'; + } + failed($msg); + next; + } + $recap{$h}{"ipv$ipv"} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{"status-ipv$ipv"} = 'good'; + success("updated successfully to $ip (status: $code)"); + } + } +} - ## group hosts with identical attributes together - my %groups = group_hosts_by([ @_ ], [ qw(server login password) ]); +###################################################################### +## nic_henet_examples +## +## written by Indrajit Raychaudhuri +## +###################################################################### +sub nic_henet_examples { + my $self = shift; + return <<"EoEXAMPLE"; +o 'he.net' - ## 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'}; +The 'he.net' protocol is used by DNS service offered by dns.he.net. - # FQDNs - for my $host (@hosts) { - delete $config{$host}{'wantip'}; +Configuration variables applicable to the 'he.net' protocol are: + protocol=he.net ## + password=service-password ## the password provided by the admin interface + fully.qualified.host ## the host registered with the service. - info("setting IP address to %s for %s", $ip, $host); - verbose("UPDATE:", "updating %s", $host); +Example ${program}.conf file entries: + ## single host update + protocol=he.net, \\ + password=my-genereated-password \\ + myhost.example.com +EoEXAMPLE +} - # Update the DNS record - my $url = "https://$config{$host}{'server'}/nic/update"; - $url .= "?hostname=$host"; - $url .= "&myip="; - $url .= $ip if $ip; +###################################################################### +## nic_henet_update +###################################################################### +sub nic_henet_update { + my $self = shift; + my %errors = ( + 'badauth' => 'Bad authorization (username or password)', + 'badsys' => 'The system parameter given was not valid', + 'nohost' => 'The hostname specified does not exist in the database', + 'abuse' => 'The hostname specified is blocked for abuse', + 'nochg' => 'No update required; unnecessary attempts to change the current address are considered abusive', + ); + for my $h (@_) { + local $_l = pushlogctx($h); + # The IPv4 and IPv6 addresses must be updated in separate API call. + for my $ipv ('4', '6') { + my $ip = delete($config{$h}{"wantipv$ipv"}) or next; + info("setting IPv$ipv address to $ip"); my $reply = geturl( proxy => opt('proxy'), - url => $url, - login => $config{$host}{'login'}, - password => $config{$host}{'password'}, + url => "https://" . opt('server', $h) . "/nic/update?hostname=$h&myip=$ip", + login => $h, + password => opt('password', $h), ); - unless ($reply) { - failed("updating %s: Could not connect to %s.", $host, $config{$host}{'server'}); + next if !header_ok($reply); + # dyn.dns.he.net can return 200 OK even if there is an error (e.g., bad authentication, + # updates too frequent) so the body of the response must also be checked. + (my $body = $reply) =~ s/^.*?\n\n//s; + my ($line) = split(/\n/, $body, 2); + my ($status, $returnedip) = split(/ /, lc($line)); + $status = 'good' if $status eq 'nochg'; + $recap{$h}{"status-ipv$ipv"} = $status; + if ($status ne 'good') { + if (exists($errors{$status})) { + failed("$status: $errors{$status}"); + } else { + failed("unexpected status: $line"); + } next; } - next if !header_ok($host, $reply); + success("$status: IPv$ipv address set to $returnedip"); + $recap{$h}{"ipv$ipv"} = $returnedip; + $recap{$h}{'mtime'} = $now; + } + } +} + +###################################################################### +## nic_mythicdyn_examples +## +## written by Reuben Thomas +## +###################################################################### +sub nic_mythicdyn_examples { + my $self = shift; + return <<"EoEXAMPLE"; +o 'mythicdyn' + +The 'mythicdyn' protocol is used by the Dynamic DNS service offered by +www.mythic-beasts.com. + +Configuration variables applicable to the 'mythicdyn' protocol are: + protocol=mythicdyn ## + login=service-login ## the user name provided by the admin interface + password=service-password ## the password provided by the admin interface + fully.qualified.host ## the host registered with the service + +Note: this module examines the wantipv4 & wantipv6 parameters + and will set either or both V4 and/or V6 addresses as required + +Note: this service automatically sets the IP address to that from which the +request comes, so the IP address detected by ddclient is only used to keep +track of when it needs updating. + +Example ${program}.conf file entries: + ## Single host update. + protocol=mythicdyn, \\ + login=service-login \\ + password=service-password, \\ + host.example.com + + ## Multiple host update. + protocol=mythicdyn, \\ + login=service-login \\ + password=service-password, \\ + hosta.example.com,hostb.sub.example.com +EoEXAMPLE +} +###################################################################### +## nic_mythicdyn_update +###################################################################### +sub nic_mythicdyn_update { + my $self = shift; + # Update each configured host. + for my $h (@_) { + local $_l = pushlogctx($h); + info("setting IP address"); + + for my $mythver ('4','6') { + my $ip = $config{$h}{"wantipv$mythver"}; + + if (defined($ip)) { + info("Process configuration for IPV%s --------", $mythver); + my $reply = geturl( + proxy => opt('proxy'), + url => "https://ipv$mythver." . opt('server', $h) . "/dns/v2/dynamic/$h", + method => 'POST', + login => opt('login', $h), + password => opt('password', $h), + ipversion => $mythver, + ); + my $ok = header_ok($reply); + if ($ok) { + $recap{$h}{'mtime'} = $now; + $recap{$h}{"status-ipv$mythver"} = "good"; - # Cache - $config{$host}{'ip'} = $ip; - $config{$host}{'mtime'} = $now; - $config{$host}{'status'} = 'good'; + success("IPv$mythver updated successfully"); + } + } else { + info("No configuration for IPV%s -------------", $mythver); + } } } } @@ -5361,6 +5729,7 @@ sub nic_googledomains_update { ## nic_nsupdate_examples ###################################################################### sub nic_nsupdate_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'nsupdate' @@ -5409,65 +5778,65 @@ EoEXAMPLE ## by Daniel Roethlisberger ###################################################################### 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'}; + my $self = shift; + for my $group (group_hosts_by(\@_, qw(login password server tcp zone wantipv4 wantipv6))) { + my @hosts = @{$group->{hosts}}; + my %groupcfg = %{$group->{cfg}}; + my $hosts = join(',', @hosts); + local $_l = pushlogctx($hosts); + my $binary = $groupcfg{'login'}; + my $keyfile = $groupcfg{'password'}; + my $server = $groupcfg{'server'}; ## nsupdate requires a port number to be separated by whitepace, not colon $server =~ s/:/ /; - my $zone = $config{$h}{'zone'}; - my $ip = $config{$h}{'wantip'}; - my $recordtype = ''; - if (is_ipv6($ip)) { - $recordtype = 'AAAA'; - } else { - $recordtype = 'A'; - } - delete $config{$_}{'wantip'} foreach @hosts; + my $zone = $groupcfg{'zone'}; + my $ipv4 = $groupcfg{'wantipv4'}; + my $ipv6 = $groupcfg{'wantipv6'}; + delete $config{$_}{'wantipv4'} for @hosts; + delete $config{$_}{'wantipv6'} for @hosts; - info("setting IP address to %s for %s", $ip, $hosts); - verbose("UPDATE:", "updating %s", $hosts); + info("setting IPv4 address to $ipv4") if $ipv4; + info("setting IPv6 address to $ipv6") if $ipv6; ## send separate requests for each zone with all hosts in that zone my $instructions = <<"EoINSTR1"; server $server zone $zone. EoINSTR1 - foreach (@hosts) { - $instructions .= <<"EoINSTR2"; -update delete $_. $recordtype -update add $_. $config{$_}{'ttl'} $recordtype $ip + for (@hosts) { + for my $ip ($ipv4, $ipv6) { + next if (!$ip); + my $type = ($ip eq ($ipv6 // '')) ? 'AAAA' : 'A'; + $instructions .= <<"EoINSTR2"; +update delete $_. $type +update add $_. ${\(opt('ttl', $_))} $type $ip EoINSTR2 + } } - $instructions .= <<"EoINSTR3"; + $instructions .= <<"EoINSTR4"; send -EoINSTR3 +EoINSTR4 my $command = "$binary -k $keyfile"; - $command .= " -v" if ynu($config{$h}{'tcp'}, 1, 0, 0); + $command .= " -v" if ynu($groupcfg{'tcp'}, 1, 0, 0); $command .= " -d" if (opt('debug')); - verbose("UPDATE:", "nsupdate command is: %s", $command); - verbose("UPDATE:", "nsupdate instructions are:\n%s", $instructions); + debug("command: $command"); + debug("instructions:\n$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); + for (@hosts) { + $recap{$_}{'mtime'} = $now; + for my $ip ($ipv4, $ipv6) { + next if (!$ip); + my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4'; + $recap{$_}{"ipv$ipv"} = $ip; + $recap{$_}{"status-ipv$ipv"} = 'good'; + } } + success("IPv4 address set to $ipv4") if $ipv4; + success("IPv6 address set to $ipv6") if $ipv6; } else { - foreach (@hosts) { - failed("updating %s", $_); - } + failed("error running command"); } } } @@ -5481,6 +5850,7 @@ EoINSTR3 ## ###################################################################### sub nic_cloudflare_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'cloudflare' @@ -5516,103 +5886,90 @@ Example ${program}.conf file entries: 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 $self = shift; + for my $group (group_hosts_by(\@_, qw(login password))) { + my @hosts = @{$group->{hosts}}; + my %groupcfg = %{$group->{cfg}}; my $hosts = join(',', @hosts); - my $key = $hosts[0]; - my $headers = "Content-Type: application/json\n"; - if ($config{$key}{'login'} eq 'token') { - $headers .= "Authorization: Bearer $config{$key}{'password'}\n"; + if ($groupcfg{'login'} eq 'token') { + $headers .= "Authorization: Bearer $groupcfg{'password'}\n"; } else { - $headers .= "X-Auth-Email: $config{$key}{'login'}\n"; - $headers .= "X-Auth-Key: $config{$key}{'password'}\n"; + $headers .= "X-Auth-Email: $groupcfg{'login'}\n"; + $headers .= "X-Auth-Key: $groupcfg{'password'}\n"; } - # FQDNs for my $domain (@hosts) { - (my $hostname = $domain) =~ s/\.$config{$key}{zone}$//; - my $ipv4 = delete $config{$domain}{'wantipv4'}; - my $ipv6 = delete $config{$domain}{'wantipv6'}; + local $_l = pushlogctx($domain); + my $ipv4 = delete $config{$domain}{'wantipv4'}; + my $ipv6 = delete $config{$domain}{'wantipv6'}; - info("getting Cloudflare Zone ID for %s", $domain); + info('getting Cloudflare Zone ID'); # Get zone ID - my $url = "https://$config{$key}{'server'}/zones?"; - $url .= "name=" . $config{$key}{'zone'}; + my $url = "https://" . opt('server', $domain) . "/zones/?"; + $url .= "name=" . opt('zone', $domain); my $reply = geturl(proxy => opt('proxy'), url => $url, headers => $headers ); - unless ($reply && header_ok($domain, $reply)) { - failed("updating %s: Could not connect to %s.", $domain, $config{$key}{'server'}); - next; - } - + next if !header_ok($reply); # Strip header - $reply =~ s/^.*?\n\n//s; - my $response = eval {decode_json($reply)}; + $reply =~ qr/{(?:[^{}]*|(?R))*}/mp; + my $response = eval {decode_json(${^MATCH})}; unless ($response && $response->{result}) { - failed("updating %s: invalid json or result.", $domain); + 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}}; + my ($zone_id) = map {$_->{name} eq opt('zone', $domain) ? $_->{id} : ()} @{$response->{result}}; unless ($zone_id) { - failed("updating %s: No zone ID found.", $config{$key}{'zone'}); + failed("no zone ID found for zone " . opt('zone', $domain)); next; } info("Zone ID is %s", $zone_id); # IPv4 and IPv6 handling are similar enough to do in a loop... - foreach my $ip ($ipv4, $ipv6) { + for my $ip ($ipv4, $ipv6) { next if (!$ip); - my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4'; + my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4'; my $type = ($ip eq ($ipv6 // '')) ? 'AAAA' : 'A'; - info("updating %s: setting IPv$ipv address to %s", $domain, $ip); - $config{$domain}{"status-ipv$ipv"} = 'failed'; + info("setting IPv$ipv address to $ip"); + $recap{$domain}{"status-ipv$ipv"} = 'failed'; # Get DNS 'A' or 'AAAA' record ID - $url = "https://$config{$key}{'server'}/zones/$zone_id/dns_records?"; + $url = "https://" . opt('server', $domain) . "/zones/$zone_id/dns_records?"; $url .= "type=$type&name=$domain"; $reply = geturl(proxy => opt('proxy'), url => $url, headers => $headers ); - unless ($reply && header_ok($domain, $reply)) { - failed("updating %s: Could not connect to %s.", $domain, $config{$key}{'server'}); - next; - } + next if !header_ok($reply); # Strip header - $reply =~ s/^.*?\n\n//s; - $response = eval {decode_json($reply)}; + $reply =~ qr/{(?:[^{}]*|(?R))*}/mp; + $response = eval {decode_json(${^MATCH})}; unless ($response && $response->{result}) { - failed("updating %s: invalid json or result.", $domain); + 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: Cannot set IPv$ipv to %s No '$type' record at Cloudflare", $domain, $ip); + failed("cannot set IPv$ipv to $ip: no '$type' record at Cloudflare"); next; } - debug("updating %s: DNS '$type' record ID: $dns_rec_id", $domain); + debug("DNS '$type' record ID: $dns_rec_id"); # Set domain - $url = "https://$config{$key}{'server'}/zones/$zone_id/dns_records/$dns_rec_id"; + $url = "https://" . opt('server', $domain) . "/zones/$zone_id/dns_records/$dns_rec_id"; my $data = "{\"content\":\"$ip\"}"; $reply = geturl(proxy => opt('proxy'), url => $url, @@ -5620,20 +5977,17 @@ sub nic_cloudflare_update { method => "PATCH", data => $data ); - unless ($reply && header_ok($domain, $reply)) { - failed("updating %s: Could not connect to %s.", $domain, $config{$domain}{'server'}); - next; - } + next if !header_ok($reply); # Strip header - $reply =~ s/^.*?\n\n//s; - $response = eval {decode_json($reply)}; + $reply =~ qr/{(?:[^{}]*|(?R))*}/mp; + $response = eval {decode_json(${^MATCH})}; if ($response && $response->{result}) { - success("updating %s: IPv$ipv address set to %s", $domain, $ip); - $config{$domain}{"ipv$ipv"} = $ip; - $config{$domain}{'mtime'} = $now; - $config{$domain}{"status-ipv$ipv"} = 'good'; + success("IPv$ipv address set to $ip"); + $recap{$domain}{"ipv$ipv"} = $ip; + $recap{$domain}{'mtime'} = $now; + $recap{$domain}{"status-ipv$ipv"} = 'good'; } else { - failed("updating %s: invalid json or result.", $domain); + failed("invalid json or result"); } } } @@ -5641,123 +5995,395 @@ sub nic_cloudflare_update { } ###################################################################### -## nic_yandex_examples +## nic_hetzner_examples +## +## written by Joerg Werner +## ###################################################################### -sub nic_yandex_examples { +sub nic_hetzner_examples { + my $self = shift; return <<"EoEXAMPLE"; -o Yandex +o 'hetzner' -The 'yandex' protocol is used to by DNS service offered by Yandex. +The 'hetzner' protocol is used by DNS service offered by www.hetzner.com. -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 +Configuration variables applicable to the 'hetzner' protocol are: + protocol=hetzner ## + server=fqdn.of.service ## can be omitted, defaults to dns.hetzner.com/api/v1 + password=service-password ## API token fully.qualified.host ## the host registered with the service. Example ${program}.conf file entries: - ## 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 + protocol=hetzner, \\ + zone=dns.zone, \\ + password=my-hetzner-api-token \\ + my-toplevel-domain.com,my-other-domain.com EoEXAMPLE } + ###################################################################### -## nic_yandex_update -## -## written by Denis Akimkin -## +## nic_hetzner_update ###################################################################### -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); +sub nic_hetzner_update { + my $self = shift; + for my $domain (@_) { + local $_l = pushlogctx($domain); + my $headers = "Auth-API-Token: " . opt('password', $domain) . "\n"; + $headers .= "Content-Type: application/json"; - # 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; - } + my $zone = opt('zone', $domain); + (my $hostname = $domain) =~ s/\Q.$zone\E$//; + my $ipv4 = delete $config{$domain}{'wantipv4'}; + my $ipv6 = delete $config{$domain}{'wantipv6'}; - # 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; + info("getting Hetzner Zone ID"); - $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); + # Get zone ID + my $url = "https://" . opt('server', $domain) . "/zones?name=$zone"; + my $reply = geturl(proxy => opt('proxy'), + url => $url, + headers => $headers + ); + next if !header_ok($reply); + # Strip header + $reply =~ qr/{(?:[^{}]*|(?R))*}/mp; + my $response = eval {decode_json(${^MATCH})}; + unless ($response && $response->{zones}) { + failed("invalid json or result"); + next; + } + + # Pull the ID out of the json, messy + my ($zone_id) = map {$_->{name} eq $zone ? $_->{id} : ()} @{$response->{zones}}; + unless ($zone_id) { + failed("no zone ID found for zone " . opt('zone', $domain)); + next; + } + info("Zone ID is %s", $zone_id); + + # IPv4 and IPv6 handling are similar enough to do in a loop... + for my $ip ($ipv4, $ipv6) { + next if (!$ip); + my $ipv = ($ip eq ($ipv6 // '')) ? '6' : '4'; + my $type = ($ip eq ($ipv6 // '')) ? 'AAAA' : 'A'; + + info("setting IPv$ipv address to $ip"); + $recap{$domain}{"status-ipv$ipv"} = 'failed'; + + # Get DNS 'A' or 'AAAA' record ID + $url = "https://" . opt('server', $domain) . "/records?zone_id=$zone_id"; + $reply = geturl(proxy => opt('proxy'), + url => $url, + headers => $headers + ); + next if !header_ok($reply); # Strip header - $reply =~ s/^.*?\n\n//s; - $response = eval { decode_json($reply) }; - if ($response->{success} eq 'error') { - failed("%s", $response->{error}); + $reply =~ qr/{(?:[^{}]*|(?R))*}/mp; + $response = eval {decode_json(${^MATCH})}; + unless ($response && $response->{records}) { + failed("invalid json or result"); + next; + } + # Pull the ID out of the json, messy + my ($dns_rec_id) = map { ($_->{name} eq $hostname && $_->{type} eq $type) ? $_->{id} : ()} @{$response->{records}}; + + # Set domain + my $http_method=""; + if ($dns_rec_id) + { + debug("DNS '$type' record ID: $dns_rec_id"); + $url = "https://" . opt('server', $domain) . "/records/$dns_rec_id"; + $http_method = "PUT"; + } else { + debug("creating DNS '$type'"); + $url = "https://" . opt('server', $domain) . "/records"; + $http_method = "POST"; + } + my $data = "{\"zone_id\":\"$zone_id\", \"name\": \"$hostname\", \"value\": \"$ip\", \"type\": \"$type\", \"ttl\": " . opt('ttl', $domain) . "}"; + + $reply = geturl(proxy => opt('proxy'), + url => $url, + headers => $headers, + method => $http_method, + data => $data + ); + next if !header_ok($reply); + # Strip header + $reply =~ qr/{(?:[^{}]*|(?R))*}/mp; + $response = eval {decode_json(${^MATCH})}; + if ($response && $response->{record}) { + success("IPv$ipv address set to $ip"); + $recap{$domain}{"ipv$ipv"} = $ip; + $recap{$domain}{'mtime'} = $now; + $recap{$domain}{"status-ipv$ipv"} = 'good'; } else { - success("%s -- Updated Successfully to %s", $host, $ip); + failed("invalid json or result"); + } + } + } +} + +###################################################################### +## nic_inwx_examples +###################################################################### +sub nic_inwx_examples { + my $self = shift; + return <<"EoEXAMPLE"; +o 'inwx' + +The 'inwx' protocol is designed for DynDNS accounts at INWX +. It is similar to the 'dyndns2' protocol except IPv6 +addresses are passed in a separate 'myipv6' URL parameter (rather than included +in the 'myip' parameter): + + https://dyndns.inwx.com/nic/update?myip=&myipv6= + +The 'inwx' protocol was designed around INWX's behavior as of June 2024: + - Omitting the IPv4 address (either no 'myip' URL parameter or '' is + the empty string) will cause INWX to silently set the IPv4 address (A + record) to '127.0.0.1'. No error message is returned. + - Omitting the IPv6 address (either no 'myipv6' URL parameter or '' + is the empty string) will cause INWX to delete the IPv6 address (AAAA + record) if it exists. + - INWX will automatically create an IPv6 AAAA record for your hostname if + necessary. + - 'dyndns.inwx.com' is not reachable via IPv6 (there is no AAAA record). + - GET 'https://dyndns.inwx.com/nic/update' without further parameters will set + the IPv4 A record to the public IP of the requesting host and delete the + IPv6 AAAA record. + - You can ask INWX support to manually convert a DynDNS account into an + IPv6-only account. No A record will be created in that case. + +Configuration variables applicable to the 'inwx' protocol are: + protocol=inwx ## + server=fqdn.of.service ## defaults to dyndns.inwx.com + script=/path/to/script ## defaults to /nic/update + login=service-login ## login name and password registered with the service + password=service-password ## + fully.qualified.host ## the host registered with the service. + +Example ${program}.conf file entries: + ## single host update + protocol=inwx \\ + login=my-inwx-DynDNS-account-username \\ + password=my-inwx-DynDNS-account-password \\ + myhost.example.org +EoEXAMPLE +} + +###################################################################### +## nic_inwx_update +###################################################################### +sub nic_inwx_update { + my $self = shift; + my %errors = ( + 'badauth' => 'Bad authorization (username or password)', + 'badsys' => 'The system parameter given was not valid', + 'notfqdn' => 'A Fully-Qualified Domain Name was not provided', + 'nohost' => 'The hostname specified does not exist in the database', + '!yours' => 'The hostname specified exists, but not under the username currently being used', + '!donator' => 'The offline setting was set, when the user is not a donator', + '!active' => 'The hostname specified is in a Custom DNS domain which has not yet been activated.', + 'abuse' => 'The hostname specified is blocked for abuse; you should receive an email notification which provides an unblock request link.', + 'numhost' => 'System error: Too many or too few hosts found.', + 'dnserr' => 'System error: DNS error encountered.', + 'nochg' => 'No update required; unnecessary attempts to change the current address are considered abusive', + ); + my @group_by_attrs = qw( + login + password + server + script + wantipv4 + wantipv6 + ); + for my $group (group_hosts_by(\@_, @group_by_attrs)) { + my @hosts = @{$group->{hosts}}; + my %groupcfg = %{$group->{cfg}}; + my $hosts = join(',', @hosts); + local $_l = pushlogctx($hosts); + my $ipv4 = $groupcfg{'wantipv4'}; + my $ipv6 = $groupcfg{'wantipv6'}; + delete $config{$_}{'wantipv4'} for @hosts; + delete $config{$_}{'wantipv6'} for @hosts; + info("setting IPv4 address to $ipv4") if $ipv4; + info("setting IPv6 address to $ipv6") if $ipv6; + # Note: $hosts is intentionally omitted from the URL. INWX does not support a `hostname` + # argument; instead, INWX determines the hostname from the login credentials. (The user + # creates a DynDNS account at INWX and binds a hostname to it.) + my $url = "$groupcfg{'server'}$groupcfg{'script'}?"; + $url .= "myip=$ipv4" if $ipv4; + if ($ipv6) { + if (!$ipv4 && opt('usev4', $hosts) ne 'disabled') { + warning("Skipping IPv6 AAAA record update because INWX requires the IPv4 A record to be updated at the same time but the IPv4 address is unknown."); + next; + } + $url .= "&" if $ipv4; + $url .= "myipv6=$ipv6"; + } + my $reply = geturl( + proxy => opt('proxy'), + url => $url, + login => $groupcfg{'login'}, + password => $groupcfg{'password'}, + ); + next if !header_ok($reply); + # INWX can return 200 OK even if there is an error (e.g., bad authentication, + # updates too frequent) so the body of the response must also be checked. + (my $body = $reply) =~ s/^.*?\n\n//s; + my @reply = split(qr/\n/, $body); + if (!@reply) { + failed("could not connect to $groupcfg{'server'}"); + next; + } + # From : + # + # If updating multiple hostnames, hostname-specific return codes are given one per line, + # in the same order as the hostnames were specified. Return codes indicating a failure + # with the account or the system are given only once. + # + # TODO: There is no mention of what happens if multiple IP addresses are supplied (e.g., + # IPv4 and IPv6) for a host. If one address fails to update and the other doesn't, is that + # one error status line? An error status line and a success status line? Or is an update + # considered to be all-or-nothing and the status applies to the operation as a whole? If + # the IPv4 address changes but not the IPv6 address does that result in a status of "good" + # because the set of addresses for a host changed even if a subset did not? + # + # TODO: The logic below applies the last line's status to all hosts. Change it to apply + # each status to its corresponding host. + for my $line (@reply) { + # The IP address normally comes after the status, but we ignore it. We could compare + # it with the expected address and mark the update as failed if it differs, but (1) + # some services do not return the IP; and (2) comparison is brittle (e.g., + # 192.000.002.001 vs. 192.0.2.1) and false errors could cause high load on the service + # (an update attempt every min-error-interval instead of every max-interval). + (my $status = $line) =~ s/ .*$//; + if ($status eq 'nochg') { + warning("$status: $errors{$status}"); + $status = 'good'; + } + for my $h (@hosts) { + $recap{$h}{'status-ipv4'} = $status if $ipv4; + $recap{$h}{'status-ipv6'} = $status if $ipv6; + } + if ($status ne 'good') { + if (exists($errors{$status})) { + failed("$status: $errors{$status}"); + } else { + failed("unexpected status: $line"); + } + next; + } + for my $h (@hosts) { + $recap{$h}{'ipv4'} = $ipv4 if $ipv4; + $recap{$h}{'ipv6'} = $ipv6 if $ipv6; + $recap{$h}{'mtime'} = $now; } + success("IPv4 address set to $ipv4") if $ipv4; + success("IPv6 address set to $ipv6") if $ipv6; + } + } +} + +###################################################################### +## nic_yandex_examples +###################################################################### +sub nic_yandex_examples { + my $self = shift; + return <<"EoEXAMPLE"; +o Yandex + +The 'yandex' protocol is used to by DNS service offered by Yandex. + +Configuration variables applicable to the 'yandex' protocol are: + protocol=yandex ## + server=fqdn.of.service ## defaults to pddimp.yandex.ru + login=dns.zone ## Your zone name + password=pdd-token ## PDD token for authentication + fully.qualified.host ## the host registered with the service. + +Example ${program}.conf file entries: + ## single host update + protocol=yandex, \\ + login=myhost.com, \\ + password=123456789ABCDEF0000000000000000000000000000000000000 \\ + record.myhost.com + + ## multiple host update + protocol=yandex, \\ + login=myhost.com, \\ + password=123456789ABCDEF0000000000000000000000000000000000000 \\ + record.myhost.com,other.myhost.com +EoEXAMPLE +} + +###################################################################### +## nic_yandex_update +## +## written by Denis Akimkin +## +###################################################################### +sub nic_yandex_update { + my $self = shift; + for my $host (@_) { + local $_l = pushlogctx($host); + my $ip = delete $config{$host}{'wantip'}; + my $headers = "PddToken: " . opt('password', $host) . "\n"; + + info("setting IP address to $ip"); + + # Get record ID for host + my $url = "https://" . opt('server', $host) . "/api2/admin/dns/list?"; + $url .= "domain="; + $url .= opt('login', $host); + my $reply = geturl(proxy => opt('proxy'), url => $url, headers => $headers); + next if !header_ok($reply); + + # Strip header + $reply =~ s/^.*?\n\n//s; + my $response = eval { decode_json($reply) }; + if ($response->{success} ne 'ok') { + failed("%s", $response->{error}); + next; + } + + # Pull the ID out of the json + my ($id) = map { $_->{fqdn} eq $host ? $_->{record_id} : () } @{$response->{records}}; + unless ($id) { + failed("DNS record ID not found"); + next; + } + + # Update the DNS record + $url = "https://" . opt('server', $host) . "/api2/admin/dns/edit"; + my $data = "domain="; + $data .= opt('login', $host); + $data .= "&record_id="; + $data .= $id; + $data .= "&content="; + $data .= $ip if $ip; + + $reply = geturl( + proxy => opt('proxy'), + url => $url, + headers => $headers, + method => 'POST', + data => $data, + ); + next if !header_ok($reply); - # Cache - $config{$host}{'ip'} = $ip; - $config{$host}{'mtime'} = $now; - $config{$host}{'status'} = 'good'; + # Strip header + $reply =~ s/^.*?\n\n//s; + $response = eval { decode_json($reply) }; + if ($response->{success} ne 'ok') { + failed("%s", $response->{error}); + next; } + $recap{$host}{'ip'} = $ip; + $recap{$host}{'mtime'} = $now; + $recap{$host}{'status'} = 'good'; + success("updated successfully to $ip"); } } @@ -5765,6 +6391,7 @@ sub nic_yandex_update { ## nic_duckdns_examples ###################################################################### sub nic_duckdns_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'duckdns' @@ -5790,51 +6417,45 @@ 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 +## https://www.duckdns.org/update?domains=mydomain1,mydomain2&token=xxxx-xxx-xx-x&ip=x.x.x.x ## response contains OK or KO ###################################################################### sub nic_duckdns_update { - debug("\nnic_duckdns_update -------------------"); - - ## update each configured host - ## should improve to update in one pass - 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 $self = shift; + for my $group (group_hosts_by(\@_, qw(password server wantipv4 wantipv6))) { + my @hosts = @{$group->{hosts}}; + my %groupcfg = %{$group->{cfg}}; + my $hosts = join(',', @hosts); + local $_l = pushlogctx($hosts); + my $ipv4 = $groupcfg{'wantipv4'}; + my $ipv6 = $groupcfg{'wantipv6'}; + delete $config{$_}{'wantipv4'} for @hosts; + delete $config{$_}{'wantipv6'} for @hosts; + info("setting IPv4 address to $ipv4") if $ipv4; + info("setting IPv6 address to $ipv6") if $ipv6; + my $url = "https://$groupcfg{'server'}/update?domains=$hosts&token=$groupcfg{'password'}"; + $url .= "&ip=$ipv4" if $ipv4; + $url .= "&ipv6=$ipv6" if $ipv6; my $reply = geturl(proxy => opt('proxy'), url => $url); - - # No response, declare as failed - if (!defined($reply) || !$reply) { - failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); + next if !header_ok($reply); + (my $body = $reply) =~ s/^.*?\n\n//s or do { + failed("invalid response from server"); + next; + }; + chomp($body); + if ($body ne 'OK') { + failed("server said: $body"); next; } - 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); + for my $h (@hosts) { + $recap{$h}{'ipv4'} = $ipv4 if $ipv4; + $recap{$h}{'ipv6'} = $ipv6 if $ipv6; + $recap{$h}{'mtime'} = $now; + $recap{$h}{'status-ipv4'} = 'good' if $ipv4; + $recap{$h}{'status-ipv6'} = 'good' if $ipv6; } + success("IPv4 address set to $ipv4") if $ipv4; + success("IPv6 address set to $ipv6") if $ipv6; } } @@ -5842,6 +6463,7 @@ sub nic_duckdns_update { ## nic_freemyip_examples ###################################################################### sub nic_freemyip_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'freemyip' @@ -5866,219 +6488,80 @@ EoEXAMPLE ###################################################################### ## nic_freemyip_update ## by Cadence (reused code from nic_duckdns) -## http://freemyip.com/update?token=ec54b4b64db27fe8873c7f7&domain=myhost +## https://freemyip.com/update?token=ec54b4b64db27fe8873c7f7&domain=myhost ## response contains OK or ERROR ###################################################################### sub nic_freemyip_update { - debug("\nnic_freemyip_update -------------------"); - - foreach my $h (@_) { + my $self = shift; + for my $h (@_) { + local $_l = pushlogctx($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 + info("setting IP address to $ip"); + my $url = "https://" . opt('server', $h) . "/update?token=" . opt('password', $h) . "&domain=$h"; my $reply = geturl(proxy => opt('proxy'), url => $url); - - # No response, declare as failed - if (!defined($reply) || !$reply) { - failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); + next if !header_ok($reply); + (my $body = $reply) =~ s/^.*?\n\n//s; + if ($body !~ /OK/) { + failed("server said: $body"); 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); - } + $recap{$h}{'ip'} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{'status'} = 'good'; + success("IP address set to $ip"); } } ###################################################################### -## nic_woima_examples +## nic_ddnsfm_examples ###################################################################### -sub nic_woima_examples { +sub nic_ddnsfm_examples { + my $self = shift; return <<"EoEXAMPLE"; -o 'woima' +o 'ddns.fm' -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. +The 'ddns.fm' protocol is used by the free +dynamic DNS service available at ddns.fm. +API is documented here: https://ddns.fm/docs -Configuration variables applicable to the '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. +Configuration variables applicable to the 'ddns.fm' protocol are: + protocol=ddns.fm ## + password=service-key ## key for your domain + non-fully.qualified.host ## the host registered with the service. Example ${program}.conf file entries: ## single host update - protocol=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 + protocol=ddns.fm, \\ + password=your_ddns_key, \\ + myhost.example.com - ## 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 +## nic_ddnsfm_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', - ); - +sub nic_ddnsfm_update { + my $self = shift; 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); - } - } + local $_l = pushlogctx($h); + # ddns.fm behavior as of 2024-07-14: + # - IPv4 and IPv6 addresses cannot be updated simultaneously. + # - IPv4 updates do not affect the IPv6 AAAA record (if present). + # - IPv6 updates do not affect the IPv4 A record (if present). + for my $ipv ('4', '6') { + my $ip = delete $config{$h}{"wantipv$ipv"} or next; + info("setting IPv$ipv address to $ip"); + my $reply = geturl( + proxy => opt('proxy'), + url => opt('server', $h) . "/update?key=" . opt('password', $h) . "&domain=$h&myip=$ip", + ); + next if !header_ok($reply); + $recap{$h}{"ipv$ipv"} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{"status-ipv$ipv"} = 'good'; + success("IPv$ipv address set to $ip"); } - failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}) - if $state ne 'results2'; } } @@ -6086,6 +6569,7 @@ sub nic_woima_update { ## nic_dondominio_examples ###################################################################### sub nic_dondominio_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'dondominio' The 'dondominio' protocol is used by DNS service offered by www.dondominio.com/ . @@ -6110,49 +6594,24 @@ EoEXAMPLE ###################################################################### sub nic_dondominio_update { - debug("\nnic_dondominio_update -------------------"); - - ## update each configured host - ## should improve to update in one pass - foreach my $h (@_) { + my $self = shift; + for my $h (@_) { + local $_l = pushlogctx($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 + info("setting IP address to $ip"); + my $url = "https://" . opt('server', $h) . "/plain/?user=" . opt('login', $h) . "&password=" . opt('password', $h) . "&host=$h&ip=$ip"; my $reply = geturl(proxy => opt('proxy'), url => $url); - - # 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); - + next if !header_ok($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); + if ($returned !~ /OK|IP:\Q$ip\E/) { + failed("server said: $returned"); + next; } + $recap{$h}{'ip'} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{'status'} = 'good'; + success("IP address set to $ip"); } } @@ -6160,6 +6619,7 @@ sub nic_dondominio_update { ## nic_dnsmadeeasy_examples ###################################################################### sub nic_dnsmadeeasy_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'dnsmadeeasy' @@ -6188,8 +6648,7 @@ EoEXAMPLE ## nic_dnsmadeeasy_update ###################################################################### sub nic_dnsmadeeasy_update { - debug("\nnic_dnsmadeeasy_update -------------------"); - + my $self = shift; my %messages = ( 'error-auth' => 'Invalid username or password, or invalid IP syntax', 'error-auth-suspend' => 'User has had their account suspended due to complaints or misuse of the service.', @@ -6201,44 +6660,24 @@ sub nic_dnsmadeeasy_update { '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 (@_) { + for my $h (@_) { + local $_l = pushlogctx($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 + info("setting IP address to $ip"); + my $url = opt('server', $h) . opt('script', $h) . "?username=" . opt('login', $h) . "&password=" . opt('password', $h) . "&ip=$ip&id=$h"; my $reply = geturl(proxy => opt('proxy'), url => $url); - - # 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); - + next if !header_ok($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}); + if ($returned !~ qr/success/) { + my $err = $messages{$returned} ? "$returned: $messages{$returned}" : $returned; + failed("server said: $err"); + next; } + $recap{$h}{'ip'} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{'status'} = 'good'; + success("IP address set to $ip"); } } @@ -6246,6 +6685,7 @@ sub nic_dnsmadeeasy_update { ## nic_ovh_examples ###################################################################### sub nic_ovh_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'ovh' @@ -6274,18 +6714,17 @@ EoEXAMPLE ## nic_ovh_update ###################################################################### sub nic_ovh_update { - debug("\nnic_ovh_update -------------------"); - + my $self = shift; ## update each configured host ## should improve to update in one pass - foreach my $h (@_) { + for my $h (@_) { + local $_l = pushlogctx($h); my $ip = delete $config{$h}{'wantip'}; - info("setting IP address to %s for %s", $ip, $h); - verbose("UPDATE:","updating %s", $h); + info("setting IP address to $ip"); # Set the URL that we're going to update my $url; - $url .= "https://$config{$h}{'server'}$config{$h}{'script'}?system=dyndns"; + $url .= 'https://' . opt('server', $h) . opt('script', $h) . '?system=dyndns'; $url .= "&hostname=$h"; $url .= "&myip="; $url .= $ip if $ip; @@ -6293,34 +6732,197 @@ sub nic_ovh_update { my $reply = geturl( proxy => opt('proxy'), url => $url, - login => $config{$h}{'login'}, - password => $config{$h}{'password'}, + login => opt('login', $h), + password => opt('password', $h), ); if (!defined($reply) || !$reply) { - failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); + failed("could not connect to " . opt('server', $h)); 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'; + my $returned = List::Util::first { $_ =~ /good/ || $_ =~ /nochg/ } @reply; + if ($returned) { + $recap{$h}{'ip'} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{'status'} = 'good'; if ($returned =~ /good/) { - success("updating %s: good: IP address set to %s", $h, $ip); + success("IP address set to $ip"); } else { - success("updating %s: skipped: IP address was already set to %s.", $h, $ip); + success("skipped: IP address was already set to $ip"); } } else { - $config{$h}{'status'} = 'failed'; - failed("updating %s: Server said: '%s'", $h, $returned); + $recap{$h}{'status'} = 'failed'; + failed("server said: $reply"); + } + } +} + +###################################################################### +## nic_porkbun_examples +###################################################################### +sub nic_porkbun_examples { + my $self = shift; + return <<"EoEXAMPLE"; +o 'porkbun' + +The 'porkbun' protocol is used for porkbun (https://porkbun.com/). +The API is documented here: https://porkbun.com/api/json/v3/documentation + +Before setting up, it is necessary to create your API Key by referring to the following page. + +https://kb.porkbun.com/article/190-getting-started-with-the-porkbun-api + +Available configuration variables: + * apikey (required): API Key of Porkbun API + * secretapikey (required): Secret API Key of Porkbun API + * root-domain: The root domain of the specified domain name. + * on-root-domain=yes or no (default: no): Indicates whether the specified domain name (FQDN) is + an unnamed record (Zone APEX) in a zone. + It is useful to specify it as a local variable as shown in the example. + This configuration value is deprecated, use root-domain instead! + * server: API endpoint to use, defaults to api.porkbun.com + * usev4, usev6 : These configuration variables can be specified as local variables to override + the global settings. It is useful to finely control IPv4 or IPv6 as shown in the example. + * use (deprecated) : This parameter is deprecated but can be overridden like the above parameters. + +Limitations: + * Multiple same name records (for round robin) are not supported. + The same IP address is set for all, creating meaningless extra records. + * If neither root-domain nor on-root-domain are specified, ${program} will split the given + hostname into subdomain and domain on the first dot. + For example: + * sub.example.com -> Subdomain "sub", root domain "example.com" + * sub.foo.example.com -> Subdomain "sub", root domain "foo.example.com" + If both root-domain and on-root-domain are specified, root-domain takes precedence. + +Example ${program}.conf file entry: + protocol=porkbun + apikey=APIKey + secretapikey=SecretAPIKey + root-domain=example.com + example.com,host.example.com,host2.sub.example.com + +Additional example to finely control IPv4 or IPv6 : + # Example 01 : Global enable both IPv4 and IPv6, and update both records. + usev4=webv4 + usev6=ifv6, ifv6=enp1s0 + + protocol=porkbun + apikey=APIKey + secretapikey=SecretAPIKey + root-domain=example.com + host.example.com,host2.sub.example.com + + # Example 02 : Global enable only IPv4, and update only IPv6 record. + usev4=webv4 + + protocol=porkbun + apikey=APIKey + secretapikey=SecretAPIKey + root-domain=example.com + usev6=ifv6, ifv6=enp1s0, usev4=disabled ipv6.example.com + + # Example 03: Update just a root domain + protocol=porkbun + apikey=APIKey + secretapikey=SecretAPIKey + root-domain=host.example.com + host.example.com + +EoEXAMPLE +} + +###################################################################### +## nic_porkbun_update +###################################################################### +sub nic_porkbun_update { + my $self = shift; + for my $h (@_) { + my $server = opt('server', $h); + local $_l = pushlogctx($h); + my ($sub_domain, $domain); + if (opt('root-domain', $h)) { + warning("both 'root-domain' and 'on-root-domain' are set; ignoring the latter") + if opt('on-root-domain', $h); + $domain = opt('root-domain', $h); + $sub_domain = $h; + if ($sub_domain !~ s/(?:^|\.)\Q$domain\E$//) { + failed("hostname does not end with the 'root-domain' value: $domain"); + next; + } + } elsif (opt('on-root-domain', $h)) { + $sub_domain = ''; + $domain = $h; + } else { + ($sub_domain, $domain) = split(/\./, $h, 2); + } + info("subdomain $sub_domain, root domain $domain") if $sub_domain ne ''; + for my $ipv ('4', '6') { + my $ip = delete $config{$h}{"wantipv$ipv"} or next; + my $rrset_type = $ipv eq '4' ? 'A' : 'AAAA'; + info("setting IPv$ipv address to $ip"); + my $reply = geturl( + proxy => opt('proxy'), + url => "https://$server/api/json/v3/dns/retrieveByNameType/$domain/$rrset_type/$sub_domain", + headers => ['Content-Type: application/json'], + method => 'POST', + data => encode_json({ + secretapikey => opt('secretapikey', $h), + apikey => opt('apikey', $h), + }), + ); + next if !header_ok($reply); + (my $body = $reply) =~ s/^.*?\n\n//s; + $body =~ qr/{(?:[^{}]*|(?R))*}/mp; + my $response = eval { decode_json(${^MATCH}) }; + if (ref($response) ne 'HASH') { + failed("unexpected service response: $body"); + next; + } + if ($response->{status} ne 'SUCCESS') { + failed("unexpected status: $response->{status}"); + next; + } + my $records = $response->{records}; + if (ref($records) ne 'ARRAY' || !defined($records->[0]{'id'})) { + failed("no applicable existing records"); + next; + } + warning("There are multiple applicable records. Only first record is used. Overwrite all with the same content.") + if @$records > 1; + if ($records->[0]{'content'} eq $ip) { + $recap{$h}{"status-ipv$ipv"} = "good"; + success("skipped: IPv$ipv address was already set to $ip"); + next; + } + my $ttl = $records->[0]->{'ttl'}; + my $notes = $records->[0]->{'notes'}; + debug("ttl = %s", $ttl); + debug("notes = %s", $notes); + $reply = geturl( + proxy => opt('proxy'), + url => "https://$server/api/json/v3/dns/editByNameType/$domain/$rrset_type/$sub_domain", + headers => ['Content-Type: application/json'], + method => 'POST', + data => encode_json({ + secretapikey => opt('secretapikey', $h), + apikey => opt('apikey', $h), + content => $ip, + ttl => $ttl, + notes => $notes, + }), + ); + next if !header_ok($reply); + $recap{$h}{"status-ipv$ipv"} = "good"; + success("IPv$ipv address set to $ip"); } } } sub nic_cloudns_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'cloudns' @@ -6348,12 +6950,14 @@ EoEXAMPLE } sub nic_cloudns_update { - my %groups = group_hosts_by([ @_ ], [ qw(dynurl) ]); - for my $hr (values(%groups)) { - my @hosts = @$hr; + my $self = shift; + for my $group (group_hosts_by(\@_, qw(dynurl wantip))) { + my @hosts = @{$group->{hosts}}; + my %groupcfg = %{$group->{cfg}}; my $hosts = join(',', @hosts); - my $ip = $config{$hosts[0]}{'wantip'}; - my $dynurl = $config{$hosts[0]}{'dynurl'}; + local $_l = pushlogctx($hosts); + my $ip = $groupcfg{'wantip'}; + my $dynurl = $groupcfg{'dynurl'}; delete $config{$_}{'wantip'} for @hosts; # https://www.cloudns.net/wiki/article/36/ says, "If you are behind a proxy and your real # IP is set in the header X-Forwarded-For you need to add &proxy=1 at the end of the @@ -6364,23 +6968,19 @@ sub nic_cloudns_update { 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; - } + next if !header_ok($reply); $reply =~ s/^.*?\n\n//s; # Strip the headers. chomp($reply); if ($reply eq "The record's key is wrong!" || $reply eq "Invalid request.") { - $config{$_}{'status'} = 'failed' for @hosts; - failed("updating %s: %s", $hosts, $reply); + $recap{$_}{'status'} = 'failed' for @hosts; + failed($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); + $recap{$_}{'ip'} = $ip for @hosts; + $recap{$_}{'mtime'} = $now for @hosts; + $recap{$_}{'status'} = 'good' for @hosts; + success("IP address set to $ip"); } } @@ -6388,6 +6988,7 @@ sub nic_cloudns_update { ## nic_dinahosting_examples ###################################################################### sub nic_dinahosting_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'dinahosting' @@ -6412,42 +7013,106 @@ EoEXAMPLE ## nic_dinahosting_update ###################################################################### sub nic_dinahosting_update { - debug("\nnic_dinahosting_update -------------------"); + my $self = shift; for my $h (@_) { + local $_l = pushlogctx($h); my $ip = delete $config{$h}{'wantip'}; - info("setting IP address to %s for %s", $ip, $h); - verbose("UPDATE:", "updating %s", $h); + info("setting IP address to $ip"); my ($hostname, $domain) = split(/\./, $h, 2); - my $url = "https://$config{$h}{'server'}$config{$h}{'script'}"; + my $url = 'https://' . opt('server', $h) . opt('script', $h); $url .= "?hostname=$hostname"; $url .= "&domain=$domain"; $url .= "&command=Domain_Zone_UpdateType" . is_ipv6($ip) ? 'AAAA' : 'A'; $url .= "&ip=$ip"; my $reply = geturl( proxy => opt('proxy'), - login => $config{$h}{'login'}, - password => $config{$h}{'password'}, + login => opt('login', $h), + password => opt('password', $h), 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); + $recap{$h}{'status'} = 'failed'; # assume failure until otherwise determined + next if !header_ok($reply); $reply =~ s/^.*?\n\n//s; # Strip the headers. if ($reply !~ /Success/i) { $reply =~ /^responseCode = (\d+)$/m; my $code = $1 // ''; $reply =~ /^errors_0_message = '(.*)'$/m; my $message = $1 // ''; - failed("updating %s: error %d: %s", $code, $message); + failed("error $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); + $recap{$h}{'ip'} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{'status'} = 'good'; + success("IP address set to $ip"); + } +} + +###################################################################### +## nic_directnic_examples +###################################################################### +sub nic_directnic_examples { + my $self = shift; + return <<"EoEXAMPLE"; +o 'directnic' + +The 'directnic' protocol is used by directnic (https://directnic.com). +Details about the API can be found at https://directnic.com/knowledge#/knowledge/article/3726. + +You must specify at least one of the following variables: + * urlv4=https://directnic.com/dns/gateway/ad133743f001e318e455fdc05/ the URL to use to update the A record + * urlv6=https://directnic.com/dns/gateway/ad133743f001e318e455fdc06/ the URL to use to update the AAAA record + +urlv4 is required when updating an IPv4 record, and urlv6 is required when updating an IPv6 record. + +Example ${program}.conf file entry: + protocol=directnic, \\ + urlv4=https://directnic.com/dns/gateway/ad133743f001e318e455fdc05/ \\ + urlv6=https://directnic.com/dns/gateway/ad133743f001e318e455fdc06/ \\ + myhost.mydomain.com +EoEXAMPLE +} + +###################################################################### +## nic_directnic_update +###################################################################### +sub nic_directnic_update { + my $self = shift; + for my $h (@_) { + local $_l = pushlogctx($h); + for my $ipv ('4', '6') { + my $ip = delete $config{$h}{"wantipv$ipv"} or next; + info("setting IPv$ipv address to $ip"); + + my $url = opt("urlv$ipv", $h); + if (!defined($url)) { + failed("missing urlv$ipv option"); + next; + } + + $url .= "?data=$ip"; + my $reply = geturl(proxy => opt('proxy'), url => $url); + next if !header_ok($reply); + + (my $body = $reply) =~ s/^.*?\n\n//s; + my $response = eval {decode_json($body)}; + if (ref($response) ne 'HASH') { + $recap{$h}{"status-ipv$ipv"} = 'bad'; + failed("response is not a JSON object:\n$body"); + next; + } + + if ($response->{'result'} ne 'success') { + $recap{$h}{"status-ipv$ipv"} = 'failed'; + failed("server said:\n$body"); + next; + } + + $recap{$h}{"ipv$ipv"} = $ip; + $recap{$h}{"status-ipv$ipv"} = 'good'; + $recap{$h}{'mtime'} = $now; + success("IPv$ipv address set to $ip"); + } } } @@ -6456,6 +7121,7 @@ sub nic_dinahosting_update { ## by Jimmy Thrasibule ###################################################################### sub nic_gandi_examples { + my $self = shift; return <<"EoEXAMPLE"; o 'gandi' @@ -6465,25 +7131,36 @@ 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. + * password: The Gandi API key or personal access token. If you don’t have + one yet, you can generate a production API key from the API Key Page + (in the Security section) or a personal access token from the Gandi + Admin application. Required. + * use-personal-access-token: Whether the password value is a API key or a + personal access token. Defaults to API key. Note that API keys are + deprecated by Gandi. * zone: The DNS zone to be updated. Required. * ttl: The time-to-live value associated with the updated DNS record. - Optional; uses Gandi's default (3h) if unset. + Optional; uses Gandi's default (10800) if unset. Example ${program}.conf file entries: - ## Single host update. - protocol=gandi, \\ - zone=example.com, \\ - password=my-gandi-api-key, \\ + ## Single host update using API key. + protocol=gandi + zone=example.com + password=my-gandi-api-key + host.example.com + + ## Single host update using Personal access token + protocol=gandi + zone=example.com + password=my-gandi-personal-access-token + use-personal-access-token=yes host.example.com ## Multiple host update. - protocol=gandi, \\ - zone=example.com, \\ - password=my-gandi-api-key, \\ - ttl=1h \\ + protocol=gandi + zone=example.com + password=my-gandi-api-key + ttl=3600 # optional hosta.example.com,hostb.sub.example.com EoEXAMPLE } @@ -6492,74 +7169,520 @@ EoEXAMPLE ## nic_gandi_update ###################################################################### sub nic_gandi_update { - debug("\nnic_gandi_update -------------------"); + my $self = shift; + for my $h (@_) { + local $_l = pushlogctx($h); + for my $ipv ('ipv4', 'ipv6') { + my $ip = delete $config{$h}{"want$ipv"} or next; + my $zone = opt('zone', $h); + (my $hostname = $h) =~ s/\.\Q$zone\E$//; + info("setting IP address to $ip"); + my @headers = ('Content-Type: application/json'); + if (opt('use-personal-access-token', $h) == 1) { + push(@headers, "Authorization: Bearer " . opt('password', $h)); + } else { + push(@headers, "Authorization: Apikey " . opt('password', $h)); + } + my $rrset_type = $ipv eq 'ipv6' ? 'AAAA' : 'A'; + my $url = "https://" . opt('server', $h) . opt('script', $h) . "/livedns/domains/$zone/records/$hostname/$rrset_type"; + my $reply = geturl( + proxy => opt('proxy'), + url => $url, + headers => \@headers, + method => 'GET', + ); + next if !header_ok($reply); + $reply =~ s/^.*?\n\n//s; + my $response = eval { decode_json($reply) }; + if (ref($response) ne 'HASH') { + $recap{$h}{"status-$ipv"} = "bad"; + failed("response is not a JSON object: $reply"); + next; + } + if ($response->{'rrset_values'}->[0] eq $ip && (!defined(opt('ttl', $h)) || + $response->{'rrset_ttl'} eq opt('ttl', $h))) { + $recap{$h}{'ip'} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{"status-$ipv"} = "good"; + success("skipped: address was already set to $ip"); + next; + } + $reply = geturl( + proxy => opt('proxy'), + url => $url, + headers => \@headers, + method => 'PUT', + data => encode_json({ + defined(opt('ttl', $h)) ? (rrset_ttl => opt('ttl', $h)) : (), + rrset_values => [$ip], + }), + ); + if (!header_ok($reply)) { + $recap{$h}{"status-$ipv"} = "bad"; + $reply =~ s/^.*?\n\n//s; + my $response = eval { decode_json($reply) }; + if (ref($response) eq 'HASH' && ($response->{message} // '') ne '') { + failed($response->{message}); + } else { + failed("unexpected error response: $reply"); + } + next; + } + $recap{$h}{'ip'} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{"status-$ipv"} = "good"; + success("updated successfully to $ip"); + } + } +} + +###################################################################### +## nic_keysystems_examples +###################################################################### +sub nic_keysystems_examples { + my $self = shift; + return < opt('proxy'), url => $url); + last if !header_ok($reply); - info("%s -- Setting IP address to %s.", $h, $ip); - verbose("UPDATE:", "updating %s", $h); + if ($reply =~ /code = 200/) { + $recap{$h}{'ip'} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{'status'} = 'good'; + success("IP address set to $ip"); + } else { + $recap{$h}{'status'} = 'failed'; + failed("server said: $reply"); + } + } +} - my $headers; - $headers = "Content-Type: application/json\n"; - $headers .= "Authorization: Apikey $config{$h}{'password'}\n"; +###################################################################### +## nic_regfishde_examples +###################################################################### +sub nic_regfishde_examples { + my $self = shift; + return < $config{$h}{'ttl'}) : (), - rrset_values => [$ip], - }); +###################################################################### +## nic_regfishde_update +## response contains "success" on succesfull completion +###################################################################### +sub nic_regfishde_update { + my $self = shift; + ## update configured host + for my $h (@_) { + local $_l = pushlogctx($h); + my $ipv4 = delete $config{$h}{'wantipv4'}; + my $ipv6 = delete $config{$h}{'wantipv6'}; + info("setting IPv4 address to $ipv4") if $ipv4; + info("setting IPv6 address to $ipv6") if $ipv6; + my $url = 'https://' . opt('server', $h) . "/?fqdn=$h&forcehost=1&token=" . opt('password', $h); + $url .= "&ipv4=$ipv4" if $ipv4; + $url .= "&ipv6=$ipv6" if $ipv6; + + # Try to get URL + my $reply = geturl(proxy => opt('proxy'), url => $url); + last if !header_ok($reply); + if ($reply !~ /success/) { + failed("server said: $reply"); + next; + } + $recap{$h}{'ipv4'} = $ipv4 if $ipv4; + $recap{$h}{'ipv6'} = $ipv6 if $ipv6; + $recap{$h}{'status-ipv4'} = 'good' if $ipv4; + $recap{$h}{'status-ipv6'} = 'good' if $ipv6; + $recap{$h}{'mtime'} = $now; + success("IPv4 address set to $ipv4") if $ipv4; + success("IPv6 address set to $ipv6") if $ipv6; + } +} + +###################################################################### +###################################################################### +## enom +###################################################################### +sub nic_enom_examples { + my $self = shift; + return < opt('proxy'), - url => $url, - headers => $headers, - method => 'PUT', - data => $data, + proxy => opt('proxy'), + url => $url ); - unless ($reply) { - failed("%s -- Could not connect to %s.", $h, $config{$h}{'server'}); - next; + last if !header_ok($reply); + + my @reply = split /\n/, $reply; + + if (grep /Done=true/i, @reply) { + $recap{$h}{'ip'} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{'status'} = 'good'; + success("IP address set to $ip"); + } else { + $recap{$h}{'status'} = 'failed'; + warning("SENT: %s", $url) unless opt('verbose'); + warning("REPLIED: %s", $reply); + failed("invalid reply"); } - my $ok = header_ok($h, $reply); + } +} - $reply =~ s/^.*?\n\n//s; - my $response = eval { decode_json($reply) }; - if (!defined($response)) { - $config{$h}{'status'} = "bad"; +sub nic_digitalocean_examples { + my $self = shift; + return <<"EoEXAMPLE"; +o 'digitalocean' - failed("%s -- Unexpected service response.", $h); - next; +The 'digitalocean' protocol updates domains hosted by Digital Ocean (https://www.digitalocean.com/). + +This protocol supports both IPv4 and IPv6. It will only update an existing record; it will not +create a new one. So, before using it, make sure there's already one (and at most one) of each +record type (A and/or AAAA) you plan to update present in your Digital Ocean zone. + +This protocol implements the API documented here: + https://docs.digitalocean.com/reference/api/api-reference/. + +You can get your API token by following these instructions: + https://docs.digitalocean.com/reference/api/create-personal-access-token/ + +Available configuration variables: + * server (optional): API server. Defaults to 'api.digitalocean.com'. + * zone (required): DNS zone under which the hostname falls. + * password (required): API token from DigitalOcean Control Panel. See instructions linked above. + +Example ${program}.conf file entries: + protocol=digitalocean, \\ + zone=example.com, \\ + password=api-token \\ + example.com,sub.example.com +EoEXAMPLE +} + +sub nic_digitalocean_update_one { + my ($h, $ip, $ipv) = @_; + + info("setting $ipv address to $ip"); + + my $server = opt('server', $h); + my $type = $ipv eq 'ipv6' ? 'AAAA' : 'A'; + + my $headers; + $headers = "Content-Type: application/json\n"; + $headers .= 'Authorization: Bearer ' . opt('password', $h) . "\n"; + + my $list_url; + $list_url = "https://$server/v2/domains/" . opt('zone', $h) . '/records'; + $list_url .= "?name=$h"; + $list_url .= "&type=$type"; + + my $list_resp = geturl( + proxy => opt('proxy'), + url => $list_url, + headers => $headers, + ); + return if !header_ok($list_resp); + $list_resp =~ s/^.*?\n\n//s; # Strip header + + my $list = eval { decode_json($list_resp) }; + if ($@) { + $recap{$h}{"status-$ipv"} = 'failed'; + failed("listing $ipv: JSON decoding failure"); + return; + } + + my $elem = $list; + unless ((ref($elem) eq 'HASH') && + (ref ($elem = $elem->{'domain_records'}) eq 'ARRAY') && + (@$elem == 1 && ref ($elem = $elem->[0]) eq 'HASH')) { + $recap{$h}{"status-$ipv"} = 'failed'; + failed("listing $ipv: no record, multiple records, or malformed JSON"); + return; + } + + my $current_ip = $elem->{'data'}; + my $record_id = $elem->{'id'}; + + if ($current_ip eq $ip) { + info("$ipv: IP is already $ip, no update needed"); + } else { + my $update_data = encode_json({'type' => $type, 'data' => $ip}); + my $update_resp = geturl( + proxy => opt('proxy'), + url => "https://$server/v2/domains/" . opt('zone', $h) . "/records/$record_id", + method => 'PATCH', + headers => $headers, + data => $update_data, + ); + return if !header_ok($update_resp); + } + + $recap{$h}{"status-$ipv"} = 'good'; + $recap{$h}{"ip-$ipv"} = $ip; + $recap{$h}{"mtime"} = $now; +} + +sub nic_digitalocean_update { + my $self = shift; + for my $h (@_) { + local $_l = pushlogctx($h); + my $ipv4 = delete $config{$h}{'wantipv4'}; + my $ipv6 = delete $config{$h}{'wantipv6'}; + + if ($ipv4) { + nic_digitalocean_update_one($h, $ipv4, 'ipv4'); } - if ($ok) { - $config{$h}{'ip'} = $ip; - $config{$h}{'mtime'} = $now; - $config{$h}{'status'} = "good"; + if ($ipv6) { + nic_digitalocean_update_one($h, $ipv6, 'ipv6'); + } + } +} - success("%s -- Updated successfully to %s.", $h, $ip); - } else { - $config{$h}{'status'} = "bad"; +###################################################################### +## nic_infomaniak_examples +###################################################################### +sub nic_infomaniak_examples { + my $self = shift; + return <<"EoEXAMPLE"; - 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); +o 'infomaniak' + +**Note** The 'infomaniak' protocol is obsolete [*]. + +The 'infomaniak' protocol is used by DNS services offered by www.infomaniak.com. + +Configuration variables applicable to the 'infomaniak' protocol are: + protocol=infomaniak + login=ddns_username ## the DDNS username set up in Infomaniak + password=ddns_password ## the DDNS username set up in Infomaniak + example.com ## domain name to update + +Example ${program}.conf file entries: + protocol=infomaniak, \\ + login=my-username, \\ + password=my-password \\ + my.address.com + +For more information about how to create a dynamic DNS, see https://faq.infomaniak.com/2357. + +[*] Infomaniak DynDNS services (both IP discovery and update) can be used with the standard +'dyndns2' protocol. See . Notice that a minimum number of HTTP +redirections (usally 2) might be needed. + +Example ${program}.conf file entries: + protocol=dyndns2, \\ + use=web, web=infomaniak.com/ip.php/ \\ + login=my-username, \\ + password=my-password \\ + redirect=2 + my.address.com +EoEXAMPLE +} + +###################################################################### +## nic_infomaniak_update +## +## written by Timothée Andres +## +## based on https://faq.infomaniak.com/2376 +## +## needs one of the following urls to update: +## https://username:password@infomaniak.com/nic/update?hostname=subdomain.yourdomain.com&myip=1.2.3.4 +## https://infomaniak.com/nic/update?hostname=subdomain.yourdomain.com&myip=1.2.3.4&username=XXX&password=XXX +###################################################################### +sub nic_infomaniak_update { + my $self = shift; + for my $h (@_) { + local $_l = pushlogctx($h); + for my $v (4, 6) { + my $ip = delete $config{$h}{"wantipv$v"}; + if (!defined $ip) { + debug("IPv$v not wanted, skipping"); + next; + } + info("setting IP address to $ip"); + # No change in IP => nochg + # Bad auth => badauth + # Bad domain name => nohost + # Bad IP => nohost + # IP changed => good + # No domain name => Validation failed + my %statuses = ( + 'good' => [1, "IP set to $ip"], + 'nochg' => [1, "IP already set to $ip"], + 'nohost' => [0, "Bad domain name or bad IP $ip"], + 'badauth' => [0, "Bad authentication"], + ); + my $reply = geturl( + proxy => opt('proxy'), + url => "https://infomaniak.com/nic/update?hostname=$h&myip=$ip", + login => opt('login', $h), + password => opt('password', $h), + ); + next if !header_ok($reply); + (my $body = $reply) =~ s/^.*?\n\n//s; + my ($status) = split(/ /, $body, 2); + my ($ok, $msg) = + @{$statuses{$status} // [0, "Unknown reply from Infomaniak: $body"]}; + if (!$ok) { + failed($msg); + next; } + success($msg); + $recap{$h}{"ipv$v"} = $ip; + $recap{$h}{'mtime'} = $now; + $recap{$h}{"status-ipv$v"} = 'good'; } } } +###################################################################### +## nic_emailonly_update +## +## Written by Joel Croteau +## +## Do not update Dynamic DNS, only send status emails. Use if you do +## not have a DDNS host, but still want to get emails when your IP +## address changes. Note that you must set the "mail" config option +## and configure sendmail for this to have an effect. At least one +## host must be specified; the host names are mentioned in the email. +###################################################################### +sub nic_emailonly_update { + my $self = shift; + # Note: This is logged after opt('max-interval', $_) even if the IP address hasn't changed, so + # it is best to avoid phrasing like, "IP address has changed." + logmsg(email => 1, raw => 1, join("\n", 'Host IP addresses:', map({ + my $ipv4 = delete($config{$_}{'wantipv4'}); + my $ipv6 = delete($config{$_}{'wantipv6'}); + $recap{$_}{'status-ipv4'} = 'good' if $ipv4; + $recap{$_}{'status-ipv6'} = 'good' if $ipv6; + $recap{$_}{'ipv4'} = $ipv4 if $ipv4; + $recap{$_}{'ipv6'} = $ipv6 if $ipv6; + $recap{$_}{'mtime'} = $now; + sprintf('%30s %s', $_, join(' ', grep(defined($_), $ipv4, $ipv6))); + } @_))); +} + +###################################################################### +## nic_emailonly_examples +###################################################################### +sub nic_emailonly_examples { + my $self = shift; + return <<"EoEXAMPLE"; +o 'emailonly' + +The 'emailonly' protocol is a dummy protocol that will send status emails but +not actually issue any dynamic DNS updates. You can use this if you don\'t +have a DDNS host, but still want to get emails when your IP address changes. +For this to have an effect, you must set the 'mail' config option, have +sendmail properly configured on your machine, and specify at least one dummy +hostname. + +Example ${program}.conf file entries: + ## single host update + mail=me\@example.com + protocol=emailonly + host.example.com +EoEXAMPLE +} + # Execute main() if this file is run as a script or run via PAR (https://metacpan.org/pod/PAR), # otherwise do nothing. This "modulino" pattern makes it possible to import this file as a module # and test its functions directly; there's no need for test-only command-line arguments or stdout diff --git a/docs/ProviderGuidelines.md b/docs/ProviderGuidelines.md new file mode 100644 index 000000000..b57b968f1 --- /dev/null +++ b/docs/ProviderGuidelines.md @@ -0,0 +1,39 @@ +# Provider implementations + +Author: [@LenardHess](https://github.com/LenardHess/)\ +Date: 2023-11-23 + +This document is meant to detail the mechanisms that provider implementation shall use. It differentiates between new and legacy provider implementations. The former are adhering to the IPv6 support updates being done to ddclient, the legacy ones are from before that update. + +## New provider Implementation +1. Grab the IP(s) from $config{$host}{'wantipv4'} and/or $config{$host}{'wantipv6'} +2. Optional: Query the provider for the current IP record(s). If they are already good, skip updating IP record(s) +3. Update the IP record(s). +4. If successful (or if the records were already good): + - Set 'status-ipv4' and/or 'status-ipv6' to 'good' + - Set 'ipv4' and/or 'ipv6' to the IP that has been set + - Set 'mtime' to the current time +5. If not successful: + - Set 'status-ipv4' and/or 'status-ipv6' to an error message + - Set 'atime' to the current time + +The new provider implementation should not set 'status' nor 'ip'. They're part of the legacy infrastructure and ddclient will take care of setting them correctly. + +## Legacy provider implementations +1. Grab the IP from $config{$host}{'wantip'} +2. Optional: Query the provider for the current IP record. If it is already good, skip updating IP record +3. Update the IP record. +4. If successful (or if the record was already good): + - Set 'status' to 'good' + - Set 'ip' to the IP that has been set + - Set 'mtime' to the current time +5. If not successful: + - Set 'status' to an error message + - Set 'atime' to the current time + +# ToDo +- Decide/Inquire whether services prefer querying the IP first. Then decide whether to make it mandatory. +- Write guidelines on checking existing records (i.e. check TTL as well?). +- Start a list of providers and their implementation state +- Add more details to this document + - Whether 'wantip*' ought to be deleted when read or not. diff --git a/sample-etc_cron.d_ddclient b/sample-etc_cron.d_ddclient index b08183232..601980521 100644 --- a/sample-etc_cron.d_ddclient +++ b/sample-etc_cron.d_ddclient @@ -10,7 +10,3 @@ ## force an update twice a month (only if you are not using daemon-mode) ## ## 30 23 1,15 * * root /usr/bin/ddclient -daemon=0 -syslog -quiet -force -###################################################################### -## retry failed updates every hour (only if you are not using daemon-mode) -## -## 0 * * * * root /usr/bin/ddclient -daemon=0 -syslog -quiet retry diff --git a/sample-etc_rc.d_ddclient.freebsd b/sample-etc_rc.d_ddclient.freebsd deleted file mode 100755 index d8dc34148..000000000 --- a/sample-etc_rc.d_ddclient.freebsd +++ /dev/null @@ -1,31 +0,0 @@ -#!/bin/sh - -# PROVIDE: ddclient -# REQUIRE: LOGIN -# KEYWORD: shutdown -# -# Add the following lines to /etc/rc.conf.local or /etc/rc.conf -# to enable this service: -# -# ddclient_enable (bool): Set to NO by default. -# Set it to YES to enable ddclient. - -. /etc/rc.subr - -name=ddclient -rcvar=ddclient_enable -ddclient_conf="/etc/ddclient/ddclient.conf" - -command="/usr/local/sbin/${name}" -load_rc_config $name - -delay=$(grep -v '^\s*#' "${ddclient_conf}" | grep -i -m 1 "daemon" | awk -F '=' '{print $2}') - -if [ -z "${delay}" ] -then - ddclient_flags="-daemon 300" -else - ddclient_flags="" -fi - -run_rc_command "$1" diff --git a/sample-etc_rc.d_init.d_ddclient b/sample-etc_rc.d_init.d_ddclient deleted file mode 100755 index 5eb9b40cf..000000000 --- a/sample-etc_rc.d_init.d_ddclient +++ /dev/null @@ -1,100 +0,0 @@ -#!/bin/bash -# -# ddclient This shell script takes care of starting and stopping -# ddclient. -# -# chkconfig: 2345 65 35 -# description: ddclient provides support for updating dynamic DNS services. - -CONF=/etc/ddclient/ddclient.conf -program=ddclient - -[ -f $CONF ] || exit 0 - -system=unknown -if [ -f /etc/fedora-release ]; then - system=fedora -elif [ -f /etc/redhat-release ]; then - system=redhat -elif [ -f /etc/debian_version ]; then - system=debian -fi - -PID='' -if [ "$system" = "fedora" ] || [ "$system" = "redhat" ]; then - . /etc/init.d/functions - PID=`pidofproc $program` -else - PID=`ps -aef | grep "$program - sleep" | grep -v grep | awk '{print $2}'` -fi - -PATH=/usr/bin:/usr/local/bin:${PATH} -export PATH - -# See how we were called. -case "$1" in - start) - # See if daemon=value is specified in the config file. - # Assumptions: - # * there are no quoted "#" characters before "daemon=" - # (if there is a "#" it starts a comment) - # * "daemon=" does not appear in a password or value - # * if the interval value is 0, it is not quoted - INTERVAL=$(sed -e ' - s/^\([^#]*[,[:space:]]\)\{0,1\}daemon=\([^,[:space:]]*\).*$/\2/ - t quit - d - :quit - q - ' "$CONF") - if [ -z "$DELAY" ] || [ "$DELAY" = "0" ]; then - DELAY="-daemon 300" - else - # use the interval specified in the config file - DELAY='' - fi - echo -n "Starting ddclient: " - if [ "$system" = "fedora" ] || [ "$system" = "redhat" ]; then - daemon $program $DELAY - else - ddclient $DELAY - fi - echo - ;; - stop) - # Stop daemon. - echo -n "Shutting down ddclient: " - if [ -n "$PID" ]; then - if [ "$system" = "fedora" ] || [ "$system" = "redhat" ]; then - killproc $program - else - kill $PID - fi - else - echo "ddclient is not running" - fi - echo - ;; - restart) - $0 stop - $0 start - ;; - status) - if [ "$system" = "fedora" ] || [ "$system" = "redhat" ]; then - status $program - else - if test "$PID"; then - for p in $PID; do - echo "$program (pid $p) is running" - done - else - echo "$program is stopped" - fi - fi - ;; - *) - echo "Usage: ddclient {start|stop|restart|status}" - exit 1 -esac - -exit 0 diff --git a/sample-etc_rc.d_init.d_ddclient.alpine b/sample-etc_rc.d_init.d_ddclient.alpine deleted file mode 100755 index d20d1199d..000000000 --- a/sample-etc_rc.d_init.d_ddclient.alpine +++ /dev/null @@ -1,38 +0,0 @@ -#!/sbin/openrc-run -description="ddclient Daemon for Alpine" -command="/usr/bin/ddclient" -config_file="/etc/ddclient/ddclient.conf" -command_args="" -pidfile=$(grep -v '^\s*#' "${config_file}" | grep -i -m 1 pid= | awk -F '=' '{print $2}') -delay=$(grep -v '^\s*#' "${config_file}" | grep -i -m 1 "daemon" | awk -F '=' '{print $2}') - -if [ -z "${delay}" ] -then - command_args="-daemon 300" -else - command_args="" -fi - - -depend() { - use logger - need net - after firewall -} - -start() { - ebegin "Starting ddclient" - start-stop-daemon --start \ - --exec "${command}" \ - --pidfile "${pidfile}" \ - -- \ - ${command_args} - eend $? -} - -stop() { - ebegin "Stopping ddclient" - start-stop-daemon --stop --exec "${command}" \ - --pidfile "${pidfile}" - eend $? -} diff --git a/sample-etc_rc.d_init.d_ddclient.lsb b/sample-etc_rc.d_init.d_ddclient.lsb deleted file mode 100755 index bced239f2..000000000 --- a/sample-etc_rc.d_init.d_ddclient.lsb +++ /dev/null @@ -1,64 +0,0 @@ -#!/bin/sh -# -# ddclient This shell script takes care of starting and stopping -# ddclient. -# -# chkconfig: 2345 65 35 -# description: ddclient provides support for updating dynamic DNS services. -# -# Above is for RedHat and now the LSB part -### BEGIN INIT INFO -# Provides: ddclient -# Required-Start: $syslog $remote_fs -# Should-Start: $time ypbind sendmail -# Required-Stop: $syslog $remote_fs -# Should-Stop: $time ypbind sendmail -# Default-Start: 3 5 -# Default-Stop: 0 1 2 6 -# Short-Description: ddclient provides support for updating dynamic DNS services -# Description: ddclient is a Perl client used to update dynamic DNS -# entries for accounts on many dynamic DNS services and -# can be used on many types of firewalls -### END INIT INFO -# -### - -[ -f /etc/ddclient/ddclient.conf ] || exit 0 - -DDCLIENT_BIN=/usr/bin/ddclient - -# -# LSB Standard (SuSE,RedHat,...) -# -if [ -f /lib/lsb/init-functions ] ; then - . /lib/lsb/init-functions -fi - -# See how we were called. -case "$1" in - start) - echo -n "Starting ddclient " - start_daemon $DDCLIENT_BIN -daemon 300 - rc_status -v - ;; - stop) - echo -n "Shutting down ddclient " - killproc -TERM `basename $DDCLIENT_BIN` - rc_status -v - ;; - restart) - $0 stop - $0 start - rc_status - ;; - status) - echo -n "Checking for service ddclient " - checkproc `basename $DDCLIENT_BIN`w - rc_status -v - ;; - *) - echo "Usage: ddclient {start|stop|restart|status}" - exit 1 -esac - -exit 0 diff --git a/sample-etc_rc.d_init.d_ddclient.redhat b/sample-etc_rc.d_init.d_ddclient.redhat deleted file mode 100755 index 2e0fd3218..000000000 --- a/sample-etc_rc.d_init.d_ddclient.redhat +++ /dev/null @@ -1,41 +0,0 @@ -#!/bin/sh -# -# ddclient This shell script takes care of starting and stopping -# ddclient. -# -# chkconfig: 2345 65 35 -# description: ddclient provides support for updating dynamic DNS services. - -[ -f /etc/ddclient/ddclient.conf ] || exit 0 - -. /etc/rc.d/init.d/functions - -# See how we were called. -case "$1" in - start) - # Start daemon. - echo -n "Starting ddclient: " - touch /var/lock/subsys/ddclient - daemon ddclient -daemon 300 - echo - ;; - stop) - # Stop daemon. - echo -n "Shutting down ddclient: " - killproc ddclient - echo - rm -f /var/lock/subsys/ddclient - ;; - restart) - $0 stop - $0 start - ;; - status) - status ddclient - ;; - *) - echo "Usage: ddclient {start|stop|restart|status}" - exit 1 -esac - -exit 0 diff --git a/sample-etc_rc.d_init.d_ddclient.ubuntu b/sample-etc_rc.d_init.d_ddclient.ubuntu deleted file mode 100755 index 73451c0bd..000000000 --- a/sample-etc_rc.d_init.d_ddclient.ubuntu +++ /dev/null @@ -1,57 +0,0 @@ -#!/bin/sh -### BEGIN INIT INFO -# Provides: ddclient -# Required-Start: $remote_fs $syslog $network -# Required-Stop: $remote_fs $syslog $network -# Default-Start: 2 3 4 5 -# Default-Stop: 0 1 6 -# Short-Description: Start ddclient daemon at boot time -# Description: Start ddclient that provides support for updating dynamic DNS services. Originally submitted by paolo martinelli, updated by joe passavanti -### END INIT INFO - -DDCLIENT=/usr/bin/ddclient -CONF=/etc/ddclient/ddclient.conf -PIDFILE=/var/run/ddclient.pid - -test -x $DDCLIENT || exit 0 -test -f $CONF || exit 0 - -. /lib/lsb/init-functions - -case "$1" in - start) - if [ ! -f $PIDFILE ]; then - log_begin_msg "Starting ddclient..." - DELAY=`grep -v '^\s*#' $CONF | grep -i -m 1 "daemon" | awk -F '=' '{print $2}'` - if [ -z "$DELAY" ] ; then - DELAY="-daemon 300" - else - DELAY='' - fi - start-stop-daemon -S -q -p $PIDFILE -x $DDCLIENT -- $DELAY - log_end_msg $? - else - log_warning_msg "Service ddclient already running..." - fi - ;; - stop) - if [ -f $PIDFILE ] ; then - log_begin_msg "Stopping ddclient..." - start-stop-daemon -K -q -p $PIDFILE - log_end_msg $? - rm -f $PIDFILE - else - log_warning_msg "No ddclient running..." - fi - ;; - restart|reload|force-reload) - $0 stop - $0 start - ;; - *) - log_success_msg "Usage: $0 {start|stop|restart|reload|force-reload}" - exit 1 - ;; -esac - -exit 0 diff --git a/sample-etc_systemd.service b/sample-etc_systemd.service index 4abadace5..8de0cb4d1 100644 --- a/sample-etc_systemd.service +++ b/sample-etc_systemd.service @@ -1,11 +1,13 @@ [Unit] Description=Dynamic DNS Update Client -After=network.target +Wants=network-online.target +After=network-online.target nss-lookup.target [Service] -Type=forking -PIDFile=/var/run/ddclient.pid -ExecStart=/usr/bin/ddclient +Type=exec +Environment=daemon_interval=5m +ExecStart=/usr/bin/ddclient --daemon ${daemon_interval} --foreground +Restart=on-failure [Install] WantedBy=multi-user.target diff --git a/sample-get-ip-from-fritzbox b/sample-get-ip-from-fritzbox index 079df074d..05c8277cf 100755 --- a/sample-get-ip-from-fritzbox +++ b/sample-get-ip-from-fritzbox @@ -9,12 +9,13 @@ # # All credits for this one liner go to the author of this blog: # http://scytale.name/blog/2010/01/fritzbox-wan-ip -# As the author explains its not required to tamper with the provided IP for the FritzBox -# as it always binds to that address for UPnP. # Disclaimer: It might be necessary to make the script executable +# Set default hostname to connect to the FritzBox +: ${FRITZ_BOX_HOSTNAME:=fritz.box} + curl -s -H 'Content-Type: text/xml; charset="utf-8"' \ -H 'SOAPAction: urn:schemas-upnp-org:service:WANIPConnection:1#GetExternalIPAddress' \ -d ' ' \ - 'http://fritz.box:49000/igdupnp/control/WANIPConn1' | \ + "http://$FRITZ_BOX_HOSTNAME:49000/igdupnp/control/WANIPConn1" | \ grep -Eo '\<[[:digit:]]{1,3}(\.[[:digit:]]{1,3}){3}\>' diff --git a/shell.nix b/shell.nix new file mode 100644 index 000000000..857021ccf --- /dev/null +++ b/shell.nix @@ -0,0 +1,11 @@ +{ pkgs ? import { } }: + +with pkgs; + +mkShellNoCC { + buildInputs = [ + autoconf + automake + gnumake + ]; +} diff --git a/t/builtinfw_query.pl b/t/builtinfw_query.pl new file mode 100644 index 000000000..d7b445081 --- /dev/null +++ b/t/builtinfw_query.pl @@ -0,0 +1,169 @@ +use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } + +sub setbuiltinfw { + my ($fw) = @_; + no warnings 'once'; + $ddclient::builtinfw{$fw->{name}} = $fw; + %ddclient::ip_strategies = ddclient::builtinfw_strategy($fw->{name}); + %ddclient::ipv4_strategies = ddclient::builtinfwv4_strategy($fw->{name}); + %ddclient::ipv6_strategies = ddclient::builtinfwv6_strategy($fw->{name}); +} + +my @gotcalls; + +my $skip_test_fw = 't/builtinfw_query.pl skip test'; +setbuiltinfw({ + name => $skip_test_fw, + query => sub { return '192.0.2.1 skip1 192.0.2.2 skip2 192.0.2.3'; }, + queryv4 => sub { return '192.0.2.4 skip1 192.0.2.5 skip3 192.0.2.6'; }, + queryv6 => sub { return '2001:db8::1 skip1 2001:db8::2 skip4 2001:db8::3'; }, +}); + +my @skip_test_cases = ( + { + desc => 'query', + getip => \&ddclient::get_ip, + useopt => 'use', + cfgxtra => {}, + want => '192.0.2.2', + }, + { + desc => 'queryv4', + getip => \&ddclient::get_ipv4, + useopt => 'usev4', + cfgxtra => {'fwv4-skip' => 'skip3'}, + want => '192.0.2.6', + }, + { + desc => 'queryv4 with fw-skip fallback', + getip => \&ddclient::get_ipv4, + useopt => 'usev4', + cfgxtra => {}, + want => '192.0.2.5', + }, + { + desc => 'queryv6', + getip => \&ddclient::get_ipv6, + useopt => 'usev6', + cfgxtra => {'fwv6-skip' => 'skip4'}, + want => '2001:db8::3', + }, + { + # Support for --usev6= wasn't added until after --fwv6-skip was added, so fallback + # to the deprecated --fw-skip option was never needed. + desc => 'queryv6 ignores fw-skip', + getip => \&ddclient::get_ipv6, + useopt => 'usev6', + cfgxtra => {}, + want => '2001:db8::1', + }, +); + +for my $tc (@skip_test_cases) { + my $h = "t/builtinfw_query.pl $tc->{desc}"; + $ddclient::config{$h} = { + $tc->{useopt} => $skip_test_fw, + 'fw-skip' => 'skip1', + %{$tc->{cfgxtra}}, + }; + my $got = $tc->{getip}(ddclient::strategy_inputs($tc->{useopt}, $h)); + is($got, $tc->{want}, $tc->{desc}); +} + +my $default_inputs_fw = 't/builtinfw_query.pl default inputs'; +setbuiltinfw({ + name => $default_inputs_fw, + query => sub { my %p = @_; push(@gotcalls, \%p); return '192.0.2.1'; }, + queryv4 => sub { my %p = @_; push(@gotcalls, \%p); return '192.0.2.2'; }, + queryv6 => sub { my %p = @_; push(@gotcalls, \%p); return '2001:db8::1'; }, +}); +my @default_inputs_test_cases = ( + { + desc => 'use with default inputs', + getip => \&ddclient::get_ip, + useopt => 'use', + want => {use => $default_inputs_fw, fw => 'server', 'fw-skip' => 'skip', + 'fw-login' => 'login', 'fw-password' => 'password', 'fw-ssl-validate' => 1}, + }, + { + desc => 'usev4 with default inputs', + getip => \&ddclient::get_ipv4, + useopt => 'usev4', + want => {usev4 => $default_inputs_fw, fwv4 => 'serverv4', fw => 'server', + 'fwv4-skip' => 'skipv4', 'fw-skip' => 'skip', 'fw-login' => 'login', + 'fw-password' => 'password', 'fw-ssl-validate' => 1}, + }, + { + desc => 'usev6 with default inputs', + getip => \&ddclient::get_ipv6, + useopt => 'usev6', + want => {usev6 => $default_inputs_fw, fwv6 => 'serverv6', 'fwv6-skip' => 'skipv6'}, + }, +); +for my $tc (@default_inputs_test_cases) { + my $h = "t/builtinfw_query.pl $tc->{desc}"; + $ddclient::config{$h} = { + $tc->{useopt} => $default_inputs_fw, + 'fw' => 'server', + 'fwv4' => 'serverv4', + 'fwv6' => 'serverv6', + 'fw-login' => 'login', + 'fw-password' => 'password', + 'fw-ssl-validate' => 1, + 'fw-skip' => 'skip', + 'fwv4-skip' => 'skipv4', + 'fwv6-skip' => 'skipv6', + }; + @gotcalls = (); + $tc->{getip}(ddclient::strategy_inputs($tc->{useopt}, $h)); + is_deeply(\@gotcalls, [$tc->{want}], $tc->{desc}); +} + +my $custom_inputs_fw = 't/builtinfw_query.pl custom inputs'; +setbuiltinfw({ + name => $custom_inputs_fw, + query => sub { my %p = @_; push(@gotcalls, \%p); return '192.0.2.1'; }, + inputs => ['if'], + queryv4 => sub { my %p = @_; push(@gotcalls, \%p); return '192.0.2.2'; }, + inputsv4 => ['ifv4'], + queryv6 => sub { my %p = @_; push(@gotcalls, \%p); return '2001:db8::1'; }, + inputsv6 => ['ifv6'], +}); + +my @custom_inputs_test_cases = ( + { + desc => 'use with custom inputs', + getip => \&ddclient::get_ip, + useopt => 'use', + want => {use => $custom_inputs_fw, if => 'eth0'}, + }, + { + desc => 'usev4 with custom inputs', + getip => \&ddclient::get_ipv4, + useopt => 'usev4', + want => {usev4 => $custom_inputs_fw, ifv4 => 'eth4'}, + }, + { + desc => 'usev6 with custom inputs', + getip => \&ddclient::get_ipv6, + useopt => 'usev6', + want => {usev6 => $custom_inputs_fw, ifv6 => 'eth6'}, + }, +); + +for my $tc (@custom_inputs_test_cases) { + my $h = "t/builtinfw_query.pl $tc->{desc}"; + $ddclient::config{$h} = { + $tc->{useopt} => $custom_inputs_fw, + 'if' => 'eth0', + 'ifv4' => 'eth4', + 'ifv6' => 'eth6', + }; + @gotcalls = (); + $tc->{getip}(ddclient::strategy_inputs($tc->{useopt}, $h)); + is_deeply(\@gotcalls, [$tc->{want}], $tc->{desc}); +} + +done_testing(); diff --git a/t/check_value.pl b/t/check_value.pl new file mode 100644 index 000000000..d430851bc --- /dev/null +++ b/t/check_value.pl @@ -0,0 +1,53 @@ +use Test::More; +use strict; +SKIP: { eval { require Test::Warnings; } or skip($@, 1); } +eval { require 'ddclient'; } or BAIL_OUT($@); + +my @test_cases = ( + { + type => ddclient::T_FQDN(), + input => 'example.com', + want => 'example.com', + }, + { + type => ddclient::T_FQDN(), + input => 'example', + want_invalid => 1, + }, + { + type => ddclient::T_URL(), + input => 'https://www.example.com', + want => 'https://www.example.com', + }, + { + type => ddclient::T_URL(), + input => 'https://directnic.com/dns/gateway/ad133/', + want => 'https://directnic.com/dns/gateway/ad133/', + }, + { + type => ddclient::T_URL(), + input => 'HTTPS://MixedCase.com/', + want => 'HTTPS://MixedCase.com/', + }, + { + type => ddclient::T_URL(), + input => 'ftp://bad.protocol/', + want_invalid => 1, + }, + { + type => ddclient::T_URL(), + input => 'bad-url', + want_invalid => 1, + }, +); +for my $tc (@test_cases) { + my $got; + my $got_invalid = !(eval { + $got = ddclient::check_value($tc->{input}, + ddclient::setv($tc->{type}, 0, 0, undef, undef)); + 1; + }); + is($got_invalid, !!$tc->{want_invalid}, "$tc->{type}: $tc->{input}: validity"); + is($got, $tc->{want}, "$tc->{type}: $tc->{input}: normalization") if !$tc->{want_invalid}; +} +done_testing(); diff --git a/t/get_ip_from_if.pl b/t/get_ip_from_if.pl index 6f08e5d44..8ff36fb02 100644 --- a/t/get_ip_from_if.pl +++ b/t/get_ip_from_if.pl @@ -1,12 +1,7 @@ use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } use ddclient::t; -SKIP: { eval { require Test::Warnings; } or skip($@, 1); } -eval { require 'ddclient'; } or BAIL_OUT($@); - -# To aid in debugging, uncomment the following lines. (They are normally left commented to avoid -# accidentally interfering with the Test Anything Protocol messages written by Test::More.) -#STDOUT->autoflush(1); -#$ddclient::globals{'debug'} = 1; subtest "get_default_interface tests" => sub { for my $sample (@ddclient::t::routing_samples) { @@ -39,23 +34,30 @@ } }; -subtest "Get default interface and IP for test system" => sub { +subtest "Get default interface and IP for test system (IPv4)" => sub { my $interface = ddclient::get_default_interface(4); - if ($interface) { - isnt($interface, "lo", "Check for loopback 'lo'"); - isnt($interface, "lo0", "Check for loopback 'lo0'"); - my $ip1 = ddclient::get_ip_from_interface("default", 4); - my $ip2 = ddclient::get_ip_from_interface($interface, 4); - is($ip1, $ip2, "Check IPv4 from default interface"); + plan(skip_all => 'no IPv4 interface') if !$interface; + isnt($interface, "lo", "Check for loopback 'lo'"); + isnt($interface, "lo0", "Check for loopback 'lo0'"); + my $ip1 = ddclient::get_ip_from_interface("default", 4); + my $ip2 = ddclient::get_ip_from_interface($interface, 4); + is($ip1, $ip2, "Check IPv4 from default interface"); + SKIP: { + skip('default interface does not have an appropriate IPv4 addresses') if !$ip1; ok(ddclient::is_ipv4($ip1), "Valid IPv4 from get_ip_from_interface($interface)"); } - $interface = ddclient::get_default_interface(6); - if ($interface) { - isnt($interface, "lo", "Check for loopback 'lo'"); - isnt($interface, "lo0", "Check for loopback 'lo0'"); - my $ip1 = ddclient::get_ip_from_interface("default", 6); - my $ip2 = ddclient::get_ip_from_interface($interface, 6); - is($ip1, $ip2, "Check IPv6 from default interface"); +}; + +subtest "Get default interface and IP for test system (IPv6)" => sub { + my $interface = ddclient::get_default_interface(6); + plan(skip_all => 'no IPv6 interface') if !$interface; + isnt($interface, "lo", "Check for loopback 'lo'"); + isnt($interface, "lo0", "Check for loopback 'lo0'"); + my $ip1 = ddclient::get_ip_from_interface("default", 6); + my $ip2 = ddclient::get_ip_from_interface($interface, 6); + is($ip1, $ip2, "Check IPv6 from default interface"); + SKIP: { + skip('default interface does not have an appropriate IPv6 addresses') if !$ip1; ok(ddclient::is_ipv6($ip1), "Valid IPv6 from get_ip_from_interface($interface)"); } }; diff --git a/t/geturl_connectivity.pl b/t/geturl_connectivity.pl new file mode 100644 index 000000000..d3f20338c --- /dev/null +++ b/t/geturl_connectivity.pl @@ -0,0 +1,57 @@ +use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +use ddclient::t::HTTPD; +use ddclient::t::ip; + +httpd_required(); + +$ddclient::globals{'ssl_ca_file'} = $ca_file; + +for my $ipv ('4', '6') { + for my $ssl (0, 1) { + my $httpd = httpd($ipv, $ssl) or next; + $httpd->run(sub { + return [200, ['Content-Type' => 'application/octet-stream'], [$_[0]->as_string()]]; + }); + } +} + +my @test_cases = ( + {ipv6_opt => 0, server_ipv => '4', client_ipv => ''}, + {ipv6_opt => 0, server_ipv => '4', client_ipv => '4'}, + # IPv* client to a non-SSL IPv6 server is not expected to work unless opt('ipv6') is true + {ipv6_opt => 0, server_ipv => '6', client_ipv => '6'}, + + # Fetch without ssl + { server_ipv => '4', client_ipv => '' }, + { server_ipv => '4', client_ipv => '4' }, + { server_ipv => '6', client_ipv => '' }, + { server_ipv => '6', client_ipv => '6' }, + + # Fetch with ssl + { ssl => 1, server_ipv => '4', client_ipv => '' }, + { ssl => 1, server_ipv => '4', client_ipv => '4' }, + { ssl => 1, server_ipv => '6', client_ipv => '' }, + { ssl => 1, server_ipv => '6', client_ipv => '6' }, +); + +for my $tc (@test_cases) { + $tc->{ipv6_opt} //= 0; + $tc->{ssl} //= 0; + SKIP: { + skip("IPv6 not supported on this system", 1) + if $tc->{server_ipv} eq '6' && !$ipv6_supported; + skip("HTTP::Daemon too old for IPv6 support", 1) + if $tc->{server_ipv} eq '6' && !$httpd_ipv6_supported; + skip("HTTP::Daemon::SSL not available", 1) if $tc->{ssl} && !$httpd_ssl_supported; + my $uri = httpd($tc->{server_ipv}, $tc->{ssl})->endpoint(); + my $name = sprintf("IPv%s client to %s%s", + $tc->{client_ipv} || '*', $uri, $tc->{ipv6_opt} ? ' (-ipv6)' : ''); + $ddclient::globals{'ipv6'} = $tc->{ipv6_opt}; + my $got = ddclient::geturl(url => $uri, ipversion => $tc->{client_ipv}); + isnt($got // '', '', $name); + } +} + +done_testing(); diff --git a/t/geturl_connectivity.pl.in b/t/geturl_connectivity.pl.in deleted file mode 100644 index 2e825d01c..000000000 --- a/t/geturl_connectivity.pl.in +++ /dev/null @@ -1,114 +0,0 @@ -use Test::More; -eval { require ddclient::Test::Fake::HTTPD; } or plan(skip_all => $@); -SKIP: { eval { require Test::Warnings; } or skip($@, 1); } -eval { require 'ddclient'; } or BAIL_OUT($@); -my $has_http_daemon_ssl = eval { require HTTP::Daemon::SSL; }; -my $has_io_socket_inet6 = eval { require IO::Socket::INET6; }; -my $ipv6_supported = eval { - require IO::Socket::IP; - my $ipv6_socket = IO::Socket::IP->new( - Domain => 'PF_INET6', - LocalHost => '::1', - Listen => 1, - ); - defined($ipv6_socket); -}; -my $has_curl = qx{ @CURL@ --version 2>/dev/null; } && $? == 0; - -my $http_daemon_supports_ipv6 = eval { - require HTTP::Daemon; - HTTP::Daemon->VERSION(6.12); -}; - -# To aid in debugging, uncomment the following lines. (They are normally left commented to avoid -# accidentally interfering with the Test Anything Protocol messages written by Test::More.) -#STDOUT->autoflush(1); -#$ddclient::globals{'verbose'} = 1; - -my $certdir = "$ENV{abs_top_srcdir}/t/lib/ddclient/Test/Fake/HTTPD"; -$ddclient::globals{'ssl_ca_file'} = "$certdir/dummy-ca-cert.pem"; - -sub run_httpd { - my ($ipv6, $ssl) = @_; - return undef if $ssl && !$has_http_daemon_ssl; - return undef if $ipv6 && (!$ipv6_supported || !$http_daemon_supports_ipv6); - my $httpd = ddclient::Test::Fake::HTTPD->new( - host => $ipv6 ? '::1' : '127.0.0.1', - scheme => $ssl ? 'https' : 'http', - daemon_args => { - SSL_cert_file => "$certdir/dummy-server-cert.pem", - SSL_key_file => "$certdir/dummy-server-key.pem", - V6Only => 1, - }, - ); - $httpd->run(sub { - # Echo back the full request. - return [200, ['Content-Type' => 'application/octet-stream'], [$_[0]->as_string()]]; - }); - diag(sprintf("started IPv%s%s server running at %s", - $ipv6 ? '6' : '4', $ssl ? ' SSL' : '', $httpd->endpoint())); - return $httpd; -} - -my %httpd = ( - '4' => {'http' => run_httpd(0, 0), 'https' => run_httpd(0, 1)}, - '6' => {'http' => run_httpd(1, 0), 'https' => run_httpd(1, 1)}, -); - -my @test_cases = ( - # Fetch via IO::Socket::INET - {ipv6_opt => 0, server_ipv => '4', client_ipv => ''}, - {ipv6_opt => 0, server_ipv => '4', client_ipv => '4'}, - # IPv* client to a non-SSL IPv6 server is not expected to work unless opt('ipv6') is true - {ipv6_opt => 0, server_ipv => '6', client_ipv => '6'}, - - # Fetch via IO::Socket::INET6 - {ipv6_opt => 1, server_ipv => '4', client_ipv => ''}, - {ipv6_opt => 1, server_ipv => '4', client_ipv => '4'}, - {ipv6_opt => 1, server_ipv => '6', client_ipv => ''}, - {ipv6_opt => 1, server_ipv => '6', client_ipv => '6'}, - - # Fetch via IO::Socket::SSL - {ssl => 1, server_ipv => '4', client_ipv => ''}, - {ssl => 1, server_ipv => '4', client_ipv => '4'}, - {ssl => 1, server_ipv => '6', client_ipv => ''}, - {ssl => 1, server_ipv => '6', client_ipv => '6'}, - - # Fetch with curl - { curl => 1, server_ipv => '4', client_ipv => '' }, - { curl => 1, server_ipv => '4', client_ipv => '4' }, - { curl => 1, server_ipv => '6', client_ipv => '' }, - { curl => 1, server_ipv => '6', client_ipv => '6' }, - - # Fetch with curl and ssl - { curl => 1, ssl => 1, server_ipv => '4', client_ipv => '' }, - { curl => 1, ssl => 1, server_ipv => '4', client_ipv => '4' }, - { curl => 1, ssl => 1, server_ipv => '6', client_ipv => '' }, - { curl => 1, ssl => 1, server_ipv => '6', client_ipv => '6' }, -); - -for my $tc (@test_cases) { - $tc->{ipv6_opt} //= 0; - $tc->{ssl} //= 0; - $tc->{curl} //= 0; - SKIP: { - skip("IO::Socket::INET6 not available", 1) - if ($tc->{ipv6_opt} || $tc->{client_ipv} eq '6') && !$tc->{curl} && !$has_io_socket_inet6; - skip("IPv6 not supported on this system", 1) - if $tc->{server_ipv} eq '6' && !$ipv6_supported; - skip("HTTP::Daemon too old for IPv6 support", 1) - if $tc->{server_ipv} eq '6' && !$http_daemon_supports_ipv6; - skip("HTTP::Daemon::SSL not available", 1) if $tc->{ssl} && !$has_http_daemon_ssl; - skip("Curl not available on this system", 1) if $tc->{curl} && !$has_curl; - my $uri = $httpd{$tc->{server_ipv}}{$tc->{ssl} ? 'https' : 'http'}->endpoint(); - my $name = sprintf("IPv%s client to %s%s%s", - $tc->{client_ipv} || '*', $uri, $tc->{ipv6_opt} ? ' (-ipv6)' : '', - $tc->{curl} ? ' (curl)' : ''); - $ddclient::globals{'ipv6'} = $tc->{ipv6_opt}; - $ddclient::globals{'curl'} = $tc->{curl}; - my $got = ddclient::geturl(url => $uri, ipversion => $tc->{client_ipv}); - isnt($got // '', '', $name); - } -} - -done_testing(); diff --git a/t/geturl_response.pl b/t/geturl_response.pl new file mode 100644 index 000000000..beb1a9247 --- /dev/null +++ b/t/geturl_response.pl @@ -0,0 +1,27 @@ +use Test::More; +SKIP: { eval { require Test::Warnings; } or skip($@, 1); } +eval { require 'ddclient'; } or BAIL_OUT($@); + +# Fake curl. Use the printf utility, which can process escapes. This allows Perl to drive the fake +# curl with plain ASCII and get arbitrary bytes back, avoiding problems caused by any encoding that +# might be done by Perl (e.g., "use open ':encoding(UTF-8)';"). +my @fakecurl = ('sh', '-c', 'printf %b "$1"', '--'); + +my @test_cases = ( + { + desc => 'binary body', + # Body is UTF-8 encoded ✨ (U+2728 Sparkles) followed by a 0xff byte (invalid UTF-8). + printf => join('\r\n', ('HTTP/1.1 200 OK', '', '\0342\0234\0250\0377')), + # The raw bytes should come through as equally valued codepoints. They must not be decoded. + want => "HTTP/1.1 200 OK\n\n\xe2\x9c\xa8\xff", + }, +); + +for my $tc (@test_cases) { + @ddclient::curl = (@fakecurl, $tc->{printf}); + $ddclient::curl if 0; # suppress spurious warning "Name used only once: possible typo" + my $got = ddclient::geturl(url => 'http://ignored'); + is($got, $tc->{want}, $tc->{desc}); +} + +done_testing(); diff --git a/t/geturl_ssl.pl b/t/geturl_ssl.pl deleted file mode 100644 index c070deffb..000000000 --- a/t/geturl_ssl.pl +++ /dev/null @@ -1,264 +0,0 @@ -use Test::More; -use Data::Dumper; -eval { - require HTTP::Request; - require HTTP::Response; - require IO::Socket::IP; - require IO::Socket::SSL; - require ddclient::Test::Fake::HTTPD; -} or plan(skip_all => $@); -SKIP: { eval { require Test::Warnings; } or skip($@, 1); } -eval { require 'ddclient'; } or BAIL_OUT($@); - -$Data::Dumper::Sortkeys = 1; - -my $httpd = ddclient::Test::Fake::HTTPD->new(); -$httpd->run(sub { - my $req = shift; - # Echo back the full request. - my $resp = [ 200, [ 'Content-Type' => 'application/octet-stream' ], [ $req->as_string() ] ]; - if ($req->method() ne 'GET') { - # TODO: Add support for CONNECT to test https via proxy. - $resp->[0] = 501; # 501 == Not Implemented - } - return $resp; -}); - -my $args; - -{ - package InterceptSocket; - require base; - base->import(qw(IO::Socket::IP)); - - sub new { - my ($class, %args) = @_; - $args = \%args; - return $class->SUPER::new(%args, PeerAddr => $httpd->host(), PeerPort => $httpd->port()); - } -} - -# Keys: -# * name: Display name. -# * params: Parameters to pass to geturl. -# * opt_ssl: Value to return from opt('ssl'). Defaults to 0. -# * opt_ssl_ca_dir: Value to return from opt('ssl_ca_dir'). Defaults to undef. -# * opt_ssl_ca_file: Value to return from opt('ssl_ca_file'). Defaults to undef. -# * want_args: Args that should be passed to the socket constructor minus MultiHomed, Proto, -# Timeout, and original_socket_class. -# * want_req_method: The HTTP method geturl is expected to use. Defaults to 'GET'. -# * want_req_uri: URI that geturl is expected to request. -# * todo: If defined, mark this test as expected to fail. -my @test_cases = ( - { - name => 'https', - params => { - url => 'https://hostname', - }, - want_args => { - PeerAddr => 'hostname', - PeerPort => '443', - SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER, - }, - want_req_uri => '/', - }, - { - name => 'http with ssl=true', - params => { - url => 'http://hostname', - }, - opt_ssl => 1, - want_args => { - PeerAddr => 'hostname', - PeerPort => '443', - SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER, - }, - want_req_uri => '/', - }, - { - name => 'https with port', - params => { - url => 'https://hostname:123', - }, - want_args => { - PeerAddr => 'hostname', - PeerPort => '123', - SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER, - }, - want_req_uri => '/', - }, - { - name => 'http with port and ssl=true', - params => { - url => 'https://hostname:123', - }, - opt_ssl => 1, - want_args => { - PeerAddr => 'hostname', - PeerPort => '123', - SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER, - }, - want_req_uri => '/', - }, - { - name => 'https proxy, http URL', - params => { - proxy => 'https://proxy', - url => 'http://hostname', - }, - want_args => { - PeerAddr => 'proxy', - PeerPort => '443', - SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER, - }, - want_req_uri => 'http://hostname/', - todo => "broken", - }, - { - name => 'http proxy, https URL', - params => { - proxy => 'http://proxy', - url => 'https://hostname', - }, - want_args => { - PeerAddr => 'proxy', - PeerPort => '80', - SSL_startHandshake => 0, - }, - want_req_method => 'CONNECT', - want_req_uri => 'hostname:443', - todo => "not yet supported; silently fails", - }, - { - name => 'https proxy, https URL', - params => { - proxy => 'https://proxy', - url => 'https://hostname', - }, - want_args => { - PeerAddr => 'proxy', - PeerPort => '443', - SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER, - }, - want_req_method => 'CONNECT', - want_req_uri => 'hostname:443', - todo => "not yet supported; silently fails", - }, - { - name => 'http proxy, http URL, ssl=true', - params => { - proxy => 'http://proxy', - url => 'http://hostname', - }, - opt_ssl => 1, - want_args => { - PeerAddr => 'proxy', - PeerPort => '443', - SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER, - }, - want_req_method => 'CONNECT', - want_req_uri => 'hostname:443', - todo => "not yet supported; silently fails", - }, - { - name => 'https proxy with port, http URL with port', - params => { - proxy => 'https://proxy:123', - url => 'http://hostname:456', - }, - want_args => { - PeerAddr => 'proxy', - PeerPort => '123', - }, - want_req_uri => 'http://hostname:456/', - todo => "broken", - }, - { - name => 'http proxy with port, https URL with port', - params => { - proxy => 'http://proxy:123', - url => 'https://hostname:456', - }, - want_args => { - PeerAddr => 'proxy', - PeerPort => '123', - SSL_startHandshake => 0, - }, - want_req_method => 'CONNECT', - want_req_uri => 'hostname:456', - todo => "not yet supported; silently fails", - }, - { - name => 'CA dir', - params => { - url => 'https://hostname', - }, - opt_ssl_ca_dir => '/ca/dir', - want_args => { - PeerAddr => 'hostname', - PeerPort => '443', - SSL_ca_path => '/ca/dir', - SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER, - }, - want_req_uri => '/', - }, - { - name => 'CA file', - params => { - url => 'https://hostname', - }, - opt_ssl_ca_file => '/ca/file', - want_args => { - PeerAddr => 'hostname', - PeerPort => '443', - SSL_ca_file => '/ca/file', - SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER, - }, - want_req_uri => '/', - }, - { - name => 'CA dir and file', - params => { - url => 'https://hostname', - }, - opt_ssl_ca_dir => '/ca/dir', - opt_ssl_ca_file => '/ca/file', - want_args => { - PeerAddr => 'hostname', - PeerPort => '443', - SSL_ca_file => '/ca/file', - SSL_ca_path => '/ca/dir', - SSL_verify_mode => IO::Socket::SSL->SSL_VERIFY_PEER, - }, - want_req_uri => '/', - }, -); - -for my $tc (@test_cases) { - $args = undef; - $ddclient::globals{'ssl'} = $tc->{opt_ssl} // 0; - $ddclient::globals{'ssl_ca_dir'} = $tc->{opt_ssl_ca_dir}; - $ddclient::globals{'ssl_ca_file'} = $tc->{opt_ssl_ca_file}; - my $resp_str = ddclient::geturl(_testonly_socket_class => 'InterceptSocket', %{$tc->{params}}); - TODO: { - local $TODO = $tc->{todo}; - subtest $tc->{name} => sub { - my %want_args = ( - MultiHomed => 1, - Proto => 'tcp', - Timeout => ddclient::opt('timeout'), - original_socket_class => 'IO::Socket::SSL', - %{$tc->{want_args}}, - ); - is(Dumper($args), Dumper(\%want_args), "socket constructor args"); - ok(defined($resp_str), "response is defined") or return; - ok(my $resp = HTTP::Response->parse($resp_str), "parse response") or return; - ok(my $req_str = $resp->decoded_content(), "decode request from response") or return; - ok(my $req = HTTP::Request->parse($req_str), "parse request") or return; - is($req->method(), $tc->{want_req_method} // 'GET', "request method"); - is($req->uri(), $tc->{want_req_uri}, "request URI"); - }; - } -} - -done_testing(); diff --git a/t/group_hosts_by.pl b/t/group_hosts_by.pl new file mode 100644 index 000000000..4cf25a1ae --- /dev/null +++ b/t/group_hosts_by.pl @@ -0,0 +1,113 @@ +use Test::More; +SKIP: { eval { require Test::Warnings; } or skip($@, 1); } +eval { require 'ddclient'; } or BAIL_OUT($@); +eval { require Data::Dumper; } or skip($@, 1); +Data::Dumper->import(); + +my $h1 = 'h1'; +my $h2 = 'h2'; +my $h3 = 'h3'; + +$ddclient::config{$h1} = { + common => 'common', + h1h2 => 'h1 and h2', + unique => 'h1', + falsy => 0, + maybeunset => 'unique', +}; +$ddclient::config{$h2} = { + common => 'common', + h1h2 => 'h1 and h2', + unique => 'h2', + falsy => '', + maybeunset => undef, # should not be grouped with unset +}; +$ddclient::config{$h3} = { + common => 'common', + h1h2 => 'unique', + unique => 'h3', + falsy => undef, + # maybeunset is intentionally not set +}; + +my @test_cases = ( + { + desc => 'empty attribute set yields single group with all hosts', + groupby => [qw()], + want => [{cfg => {}, hosts => [$h1, $h2, $h3]}], + }, + { + desc => 'common attribute yields single group with all hosts', + groupby => [qw(common)], + want => [{cfg => {common => 'common'}, hosts => [$h1, $h2, $h3]}], + }, + { + desc => 'subset share a value', + groupby => [qw(h1h2)], + want => [ + {cfg => {h1h2 => 'h1 and h2'}, hosts => [$h1, $h2]}, + {cfg => {h1h2 => 'unique'}, hosts => [$h3]}, + ], + }, + { + desc => 'all unique', + groupby => [qw(unique)], + want => [ + {cfg => {unique => 'h1'}, hosts => [$h1]}, + {cfg => {unique => 'h2'}, hosts => [$h2]}, + {cfg => {unique => 'h3'}, hosts => [$h3]}, + ], + }, + { + desc => 'combination', + groupby => [qw(common h1h2)], + want => [ + {cfg => {common => 'common', h1h2 => 'h1 and h2'}, hosts => [$h1, $h2]}, + {cfg => {common => 'common', h1h2 => 'unique'}, hosts => [$h3]}, + ], + }, + { + desc => 'falsy values', + groupby => [qw(falsy)], + want => [ + {cfg => {falsy => 0}, hosts => [$h1]}, + {cfg => {falsy => ''}, hosts => [$h2]}, + # undef intentionally becomes unset because undef always means "fall back to global or + # default". + {cfg => {}, hosts => [$h3]}, + ], + }, + { + desc => 'set, unset, undef', + groupby => [qw(maybeunset)], + want => [ + {cfg => {maybeunset => 'unique'}, hosts => [$h1]}, + # undef intentionally becomes unset because undef always means "fall back to global or + # default". + {cfg => {}, hosts => [$h2, $h3]}, + ], + }, + { + desc => 'missing attribute', + groupby => [qw(thisdoesnotexist)], + want => [{cfg => {}, hosts => [$h1, $h2, $h3]}], + }, +); + +for my $tc (@test_cases) { + my @got = ddclient::group_hosts_by([$h1, $h2, $h3], @{$tc->{groupby}}); + # @got is used as a set of sets. Sort everything to make comparison easier. + $_->{hosts} = [sort(@{$_->{hosts}})] for @got; + @got = sort({ + for (my $i = 0; $i < @{$a->{hosts}} && $i < @{$b->{hosts}}; ++$i) { + my $x = $a->{hosts}[$i] cmp $b->{hosts}[$i]; + return $x if $x != 0; + } + return @{$a->{hosts}} <=> @{$b->{hosts}}; + } @got); + is_deeply(\@got, $tc->{want}, $tc->{desc}) + or diag(Data::Dumper->new([\@got, $tc->{want}], + [qw(got want)])->Sortkeys(1)->Useqq(1)->Dump()); +} + +done_testing(); diff --git a/t/header_ok.pl b/t/header_ok.pl new file mode 100644 index 000000000..a4ea63c59 --- /dev/null +++ b/t/header_ok.pl @@ -0,0 +1,74 @@ +use Test::More; +SKIP: { eval { require Test::Warnings; } or skip($@, 1); } +eval { require 'ddclient'; } or BAIL_OUT($@); +my $have_mock = eval { require Test::MockModule; }; + +my $failmsg; +my $module; +if ($have_mock) { + $module = Test::MockModule->new('ddclient'); + # Note: 'mock' is used instead of 'redefine' because 'redefine' is not available in the versions + # of Test::MockModule distributed with old Debian and Ubuntu releases. + $module->mock('failed', sub { $failmsg //= ''; $failmsg .= sprintf(shift, @_) . "\n"; }); +} + +my @test_cases = ( + { + desc => 'malformed not OK', + input => 'malformed', + want => 0, + wantmsg => qr/unexpected/, + }, + { + desc => 'HTTP/1.1 200 OK', + input => 'HTTP/1.1 200 OK', + want => 1, + }, + { + desc => 'HTTP/2 200 OK', + input => 'HTTP/2 200 OK', + want => 1, + }, + { + desc => 'HTTP/3 200 OK', + input => 'HTTP/3 200 OK', + want => 1, + }, + { + desc => '401 not OK, fallback message', + input => 'HTTP/1.1 401 ', + want => 0, + wantmsg => qr/authentication failed/, + }, + { + desc => '403 not OK, fallback message', + input => 'HTTP/1.1 403 ', + want => 0, + wantmsg => qr/not authorized/, + }, + { + desc => 'other 4xx not OK', + input => 'HTTP/1.1 456 bad', + want => 0, + wantmsg => qr/bad/, + }, + { + desc => 'only first line is logged on error', + input => "HTTP/1.1 404 not found\n\nbody", + want => 0, + wantmsg => qr/(?!body)/, + }, +); + +for my $tc (@test_cases) { + subtest $tc->{desc} => sub { + $failmsg = ''; + is(ddclient::header_ok($tc->{input}), $tc->{want}, 'return value matches'); + SKIP: { + skip('Test::MockModule not available') if !$have_mock; + like($failmsg, $tc->{wantmsg} // qr/^$/, 'fail message matches'); + } + }; +} + +done_testing(); diff --git a/t/interval_expired.pl b/t/interval_expired.pl new file mode 100644 index 000000000..1043dea84 --- /dev/null +++ b/t/interval_expired.pl @@ -0,0 +1,51 @@ +use Test::More; +SKIP: { eval { require Test::Warnings; } or skip($@, 1); } +eval { require 'ddclient'; } or BAIL_OUT($@); + +my $h = 't/interval_expired.pl'; + +my $default_now = 1000000000; + +my @test_cases = ( + { + interval => 'inf', + want => 0, + }, + { + now => 'inf', + interval => 'inf', + want => 0, + }, + { + cache => '-inf', + interval => 'inf', + want => 0, + }, + { + cache => undef, # Falsy cache value. + interval => 'inf', + want => 0, + }, + { + now => 0, + cache => 0, # Different kind of falsy cache value. + interval => 'inf', + want => 0, + }, +); + +for my $tc (@test_cases) { + $tc->{now} //= $default_now; + # For convenience, $tc->{cache} is an offset from $tc->{now}, not an absolute time.. + my $cachetime = $tc->{now} + $tc->{cache} if defined($tc->{cache}); + $ddclient::config{$h} = {'interval' => $tc->{interval}}; + %ddclient::config if 0; # suppress spurious warning "Name used only once: possible typo" + $ddclient::cache{$h} = {'cached-time' => $cachetime} if defined($cachetime); + %ddclient::cache if 0; # suppress spurious warning "Name used only once: possible typo" + $ddclient::now = $tc->{now}; + $ddclient::now if 0; # suppress spurious warning "Name used only once: possible typo" + my $desc = "now=$tc->{now}, cache=${\($cachetime // 'undef')}, interval=$tc->{interval}"; + is(ddclient::interval_expired($h, 'cached-time', 'interval'), $tc->{want}, $desc); +} + +done_testing(); diff --git a/t/lib/ddclient/Test/Fake/HTTPD.pm b/t/lib/ddclient/Test/Fake/HTTPD.pm index 0a7ba8519..308fb9912 100644 --- a/t/lib/ddclient/Test/Fake/HTTPD.pm +++ b/t/lib/ddclient/Test/Fake/HTTPD.pm @@ -1,8 +1,11 @@ -# Copied from https://metacpan.org/pod/release/MASAKI/Test-Fake-HTTPD-0.08/lib/Test/Fake/HTTPD.pm +# Copied from https://metacpan.org/release/MASAKI/Test-Fake-HTTPD-0.09/source/lib/Test/Fake/HTTPD.pm # and modified as follows: -# * Patched with https://github.com/masaki/Test-Fake-HTTPD/pull/4 to add IPv6 support. +# * Added this comment block. +# * Patched with https://github.com/masaki/Test-Fake-HTTPD/pull/6 to fix server exit if TLS +# negotiation fails. # * Changed package name to ddclient::Test::Fake::HTTPD. # +# Copyright: 2011-2020 NAKAGAWA Masaki # License: This library is free software; you can redistribute it and/or modify it under the same # terms as Perl itself. @@ -20,7 +23,7 @@ use Scalar::Util qw(blessed weaken); use Carp qw(croak); use Exporter qw(import); -our $VERSION = '0.08'; +our $VERSION = '0.09'; $VERSION = eval $VERSION; our @EXPORT = qw( @@ -101,9 +104,10 @@ sub run { $self->port || '', $@ eq '' ? '' : ": $@")) unless $d; - $d->accept; # wait for port check from parent process - - while (my $c = $d->accept) { + while (1) { + # accept can return undef if TLS handshake fails (e.g., port test or client rejects + # cert). + my $c = $d->accept or next; while (my $req = $c->get_request) { my $res = $self->_to_http_res($app->($req)); $c->send_response($res); @@ -143,7 +147,7 @@ sub endpoint { my $self = shift; my $uri = URI->new($self->scheme . ':'); my $host = $self->host; - $host = 'localhost' if !defined($host) || $host eq '0.0.0.0' || $host eq '::'; + $host = 'localhost' if !defined($host) || $host eq '' || $host eq '0.0.0.0' || $host eq '::'; $uri->host($host); $uri->port($self->port); return $uri; diff --git a/t/lib/ddclient/Test/Fake/HTTPD/other-ca-cert.pem b/t/lib/ddclient/Test/Fake/HTTPD/other-ca-cert.pem new file mode 100644 index 000000000..c15b26cb1 --- /dev/null +++ b/t/lib/ddclient/Test/Fake/HTTPD/other-ca-cert.pem @@ -0,0 +1,80 @@ +Certificate: + Data: + Version: 3 (0x2) + Serial Number: + 6c:bf:34:52:19:4d:c9:29:2b:a6:8b:41:59:aa:c6:c5:1f:a2:bb:10 + Signature Algorithm: sha256WithRSAEncryption + Issuer: CN=Root Certification Authority + Validity + Not Before: Jan 8 08:24:32 2025 GMT + Not After : Jan 9 08:24:32 2125 GMT + Subject: CN=Root Certification Authority + Subject Public Key Info: + Public Key Algorithm: rsaEncryption + Public-Key: (2048 bit) + Modulus: + 00:c3:3d:19:6b:72:0a:9e:87:c0:28:a1:ff:d0:08: + 21:55:52:71:92:f2:98:36:75:fc:95:b4:0c:5e:c9: + 98:b3:3c:a1:ee:cf:91:6f:07:bf:82:c9:d5:51:c0: + eb:f8:46:17:41:52:1d:c6:89:ec:63:dd:5c:30:87: + a7:b5:0d:dd:ae:bf:46:fd:de:1a:be:1d:69:83:0d: + fb:d9:5a:33:0b:8d:5f:63:76:fc:a8:b1:54:37:1e: + 0b:12:44:93:90:39:1c:48:ee:f0:f2:12:fe:dc:fb: + 58:a5:76:3b:e8:e8:94:44:1e:9d:03:22:5f:21:6a: + 17:66:d1:4a:bf:12:d7:3c:15:76:11:76:09:ab:bf: + 21:ef:0c:a5:a9:e0:08:99:63:19:26:e4:d8:5d:c2: + 40:8b:98:e6:5d:df:b3:8c:63:e2:01:7c:5e:fb:55: + 39:a8:67:78:80:d2:6b:61:b2:e2:2e:93:c0:9d:91: + 0e:a1:79:4f:fc:38:94:ff:6f:65:18:8f:3e:0b:8c: + 1f:cd:48:d7:46:5a:a2:76:d6:e0:bd:3c:aa:3d:44: + 9e:50:e6:fd:e1:12:1a:ee:a1:9a:69:48:60:63:da: + 41:ae:a7:3d:36:1b:95:fb:b7:f1:0d:60:cd:2f:e3: + b1:1f:b1:db:b4:98:a6:62:87:de:54:80:d1:45:43: + 5b:25 + Exponent: 65537 (0x10001) + X509v3 extensions: + X509v3 Subject Key Identifier: + E1:7C:D3:C3:9E:C7:F5:2C:DA:7C:D7:85:78:91:BA:26:88:61:F9:D4 + X509v3 Authority Key Identifier: + E1:7C:D3:C3:9E:C7:F5:2C:DA:7C:D7:85:78:91:BA:26:88:61:F9:D4 + X509v3 Basic Constraints: critical + CA:TRUE + X509v3 Key Usage: critical + Certificate Sign, CRL Sign + Signature Algorithm: sha256WithRSAEncryption + Signature Value: + 9d:dc:49:c6:14:13:19:38:d9:14:b5:70:f0:3b:01:8e:d7:32: + a7:69:f0:21:68:ec:ad:8c:ee:53:7d:16:64:7d:3e:c2:d2:ac: + 5a:54:17:55:84:43:1e:46:1d:42:01:fb:89:e0:db:ec:e8:f0: + 3c:22:82:54:1d:38:12:21:45:3c:37:44:3b:2e:c9:4d:ed:8d: + 6e:46:f5:a5:cc:ba:39:61:ab:df:cf:1f:d2:c9:40:e2:db:3f: + 05:ea:83:14:93:5f:0e:3d:33:be:98:04:80:87:25:3a:6c:ff: + 8e:87:6a:32:ed:1e:ec:54:90:9b:2a:6e:12:05:6a:9d:15:48: + 3c:ea:c6:9e:ab:71:58:1e:34:95:3f:9b:9e:e3:e5:4b:fb:9e: + 32:f2:d6:59:bf:8d:09:d6:e4:9e:9e:47:b9:d6:78:5f:f3:0c: + 98:ab:56:f0:18:5d:63:8e:83:ee:c1:f2:84:da:0e:64:af:1c: + 18:ff:b3:f9:15:0b:02:50:77:d1:0b:6e:ba:61:bc:9e:c3:37: + 63:91:26:e8:ce:77:9a:47:8f:ef:38:8f:9c:7f:f1:ab:7b:65: + a5:96:b6:92:2e:c7:d3:c3:7a:54:0d:d6:76:f5:d6:88:13:3b: + 17:e2:02:4e:3b:4d:10:95:0a:bb:47:e9:48:25:76:1d:7b:19: + 5c:6f:b8:a1 +-----BEGIN CERTIFICATE----- +MIIDQTCCAimgAwIBAgIUbL80UhlNySkrpotBWarGxR+iuxAwDQYJKoZIhvcNAQEL +BQAwJzElMCMGA1UEAwwcUm9vdCBDZXJ0aWZpY2F0aW9uIEF1dGhvcml0eTAgFw0y +NTAxMDgwODI0MzJaGA8yMTI1MDEwOTA4MjQzMlowJzElMCMGA1UEAwwcUm9vdCBD +ZXJ0aWZpY2F0aW9uIEF1dGhvcml0eTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCC +AQoCggEBAMM9GWtyCp6HwCih/9AIIVVScZLymDZ1/JW0DF7JmLM8oe7PkW8Hv4LJ +1VHA6/hGF0FSHcaJ7GPdXDCHp7UN3a6/Rv3eGr4daYMN+9laMwuNX2N2/KixVDce +CxJEk5A5HEju8PIS/tz7WKV2O+jolEQenQMiXyFqF2bRSr8S1zwVdhF2Cau/Ie8M +pangCJljGSbk2F3CQIuY5l3fs4xj4gF8XvtVOahneIDSa2Gy4i6TwJ2RDqF5T/w4 +lP9vZRiPPguMH81I10ZaonbW4L08qj1EnlDm/eESGu6hmmlIYGPaQa6nPTYblfu3 +8Q1gzS/jsR+x27SYpmKH3lSA0UVDWyUCAwEAAaNjMGEwHQYDVR0OBBYEFOF808Oe +x/Us2nzXhXiRuiaIYfnUMB8GA1UdIwQYMBaAFOF808Oex/Us2nzXhXiRuiaIYfnU +MA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgEGMA0GCSqGSIb3DQEBCwUA +A4IBAQCd3EnGFBMZONkUtXDwOwGO1zKnafAhaOytjO5TfRZkfT7C0qxaVBdVhEMe +Rh1CAfuJ4Nvs6PA8IoJUHTgSIUU8N0Q7LslN7Y1uRvWlzLo5Yavfzx/SyUDi2z8F +6oMUk18OPTO+mASAhyU6bP+Oh2oy7R7sVJCbKm4SBWqdFUg86saeq3FYHjSVP5ue +4+VL+54y8tZZv40J1uSenke51nhf8wyYq1bwGF1jjoPuwfKE2g5krxwY/7P5FQsC +UHfRC266YbyewzdjkSbozneaR4/vOI+cf/Gre2WllraSLsfTw3pUDdZ29daIEzsX +4gJOO00QlQq7R+lIJXYdexlcb7ih +-----END CERTIFICATE----- diff --git a/t/lib/ddclient/t.pm b/t/lib/ddclient/t.pm index c546b9c94..4f8813e80 100644 --- a/t/lib/ddclient/t.pm +++ b/t/lib/ddclient/t.pm @@ -560,3 +560,5 @@ EOF want_ipv6_if => "en0", }, ); + +1; diff --git a/t/lib/ddclient/t/HTTPD.pm b/t/lib/ddclient/t/HTTPD.pm new file mode 100644 index 000000000..997e4512e --- /dev/null +++ b/t/lib/ddclient/t/HTTPD.pm @@ -0,0 +1,161 @@ +package ddclient::t::HTTPD; + +use v5.10.1; +use strict; +use warnings; + +use parent qw(ddclient::Test::Fake::HTTPD); + +use Exporter qw(import); +use Test::More; +BEGIN { require 'ddclient'; } +use ddclient::t::ip; + +our @EXPORT = qw( + httpd + httpd_ok httpd_required $httpd_supported $httpd_support_error + httpd_ipv6_ok httpd_ipv6_required $httpd_ipv6_supported $httpd_ipv6_support_error + httpd_ssl_ok httpd_ssl_required $httpd_ssl_supported $httpd_ssl_support_error + $ca_file $certdir $other_ca_file + $textplain +); + +our $httpd_supported; +our $httpd_support_error; +BEGIN { + $httpd_supported = eval { + require parent; parent->import(qw(ddclient::Test::Fake::HTTPD)); + require JSON::PP; JSON::PP->import(); + 1; + } or $httpd_support_error = $@; +} + +sub httpd_ok { + ok($httpd_supported, "HTTPD is supported") or diag($httpd_support_error); +} + +sub httpd_required { + plan(skip_all => $httpd_support_error) if !$httpd_supported; +} + +our $httpd_ssl_supported = $httpd_supported; +our $httpd_ssl_support_error = $httpd_support_error; +$httpd_ssl_supported = eval { require HTTP::Daemon::SSL; 1; } + or $httpd_ssl_support_error = $@ + if $httpd_ssl_supported; + +sub httpd_ssl_ok { + ok($httpd_ssl_supported, "SSL is supported") or diag($httpd_ssl_support_error); +} + +sub httpd_ssl_required { + plan(skip_all => $httpd_ssl_support_error) if !$httpd_ssl_supported; +} + +our $httpd_ipv6_supported = $httpd_supported; +our $httpd_ipv6_support_error = $httpd_support_error; +$httpd_ipv6_supported = $ipv6_supported + or $httpd_ipv6_support_error = $ipv6_support_error + if $httpd_ipv6_supported; +$httpd_ipv6_supported = eval { require HTTP::Daemon; HTTP::Daemon->VERSION(6.12); } + or $httpd_ipv6_support_error = $@ + if $httpd_ipv6_supported; + +sub httpd_ipv6_ok { + ok($httpd_ipv6_supported, "test HTTP server supports IPv6") or diag($httpd_ipv6_support_error); +} + +sub httpd_ipv6_required { + plan(skip_all => $httpd_ipv6_support_error) if !$httpd_ipv6_supported; +} + +our $textplain = ['content-type' => 'text/plain; charset=utf-8']; + +sub new { + my $class = shift; + my $self = $class->SUPER::new(@_); + $self->{_requests} = []; # Log of received requests. + $self->{_responses} = []; # Script of responses to play back. + return $self; +} + +sub run { + my ($self, $app) = @_; + $self->SUPER::run(sub { + my ($req) = @_; + push(@{$self->{_requests}}, $req); + my $res = $app->($req) if defined($app); + return $res if defined($res); + if ($req->uri()->path() eq '/control') { + pop(@{$self->{_requests}}); + if ($req->method() eq 'PUT') { + return [400, $textplain, ['content must be json']] + if $req->headers()->content_type() ne 'application/json'; + eval { @{$self->{_responses}} = @{decode_json($req->content())}; 1; } + or return [400, $textplain, ['content is not valid json']]; + @{$self->{_requests}} = (); + return [200, $textplain, ["successfully reset request log and response script"]]; + } elsif ($req->method() eq 'GET') { + my @reqs = map($_->as_string(), @{$self->{_requests}}); + return [200, ['content-type' => 'application/json'], [encode_json(\@reqs)]]; + } else { + return [405, $textplain, ['unsupported method: ' . $req->method()]]; + } + } + return shift(@{$self->{_responses}}) // [500, $textplain, ["no more scripted responses"]]; + }); + diag("started server running at " . $self->endpoint()); + return $self; +} + +sub reset { + my $self = shift; + my $ep = $self->endpoint(); + my $got = ddclient::geturl(url => "$ep/control"); + diag("http response:\n$got"); + ddclient::header_ok($got) + or BAIL_OUT("failed to get log of requests from test http server at $ep"); + $got =~ s/^.*?\n\n//s; + my @got = map(HTTP::Request->parse($_), @{decode_json($got)}); + ddclient::header_ok(ddclient::geturl( + url => "$ep/control", + method => 'PUT', + headers => ['content-type: application/json'], + data => encode_json(\@_), + )) or BAIL_OUT("failed to reset the test http server at $ep"); + return @got; +} + +our $certdir = "$ENV{abs_top_srcdir}/t/lib/ddclient/Test/Fake/HTTPD"; +our $ca_file = "$certdir/dummy-ca-cert.pem"; +our $other_ca_file = "$certdir/other-ca-cert.pem"; + +my %daemons; + +sub httpd { + my ($ipv, $ssl) = @_; + $ipv //= ''; + $ssl = !!$ssl; + return undef if !$httpd_supported; + return undef if $ipv eq '6' && !$httpd_ipv6_supported; + return undef if $ssl && !$httpd_ssl_supported; + if (!defined($daemons{$ipv}{$ssl})) { + my $host + = $ipv eq '4' ? '127.0.0.1' + : $ipv eq '6' ? '::1' + : $httpd_ipv6_supported ? '::1' + : '127.0.0.1'; + $daemons{$ipv}{$ssl} = __PACKAGE__->new( + host => $host, + scheme => $ssl ? 'https' : 'http', + daemon_args => { + (V6Only => $ipv eq '6' ? 1 : 0) x ($host eq '::1'), + (SSL_cert_file => "$certdir/dummy-server-cert.pem", + SSL_key_file => "$certdir/dummy-server-key.pem") x $ssl, + }, + ); + } + return $daemons{$ipv}{$ssl}; +} + +1; diff --git a/t/lib/ddclient/t/Logger.pm b/t/lib/ddclient/t/Logger.pm new file mode 100644 index 000000000..5d419499a --- /dev/null +++ b/t/lib/ddclient/t/Logger.pm @@ -0,0 +1,39 @@ +package ddclient::t::Logger; +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +use parent qw(-norequire ddclient::Logger); + +{ + package ddclient::t::LoggerAbort; + use overload '""' => qw(stringify); + sub new { + my ($class, %args) = @_; + return bless(\%args, $class); + } + sub stringify { + return 'logged a FATAL message'; + } +} + +sub new { + my ($class, $parent, $labelre) = @_; + my $self = $class->SUPER::new(undef, $parent); + $self->{logs} = []; + $self->{_labelre} = $labelre; + return $self; +} + +sub _log { + my ($self, $args) = @_; + my $lre = $self->{_labelre}; + my $lbl = $args->{label}; + push(@{$self->{logs}}, $args) if !defined($lre) || (defined($lbl) && $lbl =~ $lre); + return $self->SUPER::_log($args); +} + +sub _abort { + my ($self) = @_; + push(@{$self->{logs}}, 'aborted'); + die(ddclient::t::LoggerAbort->new()); +} + +1; diff --git a/t/lib/ddclient/t/ip.pm b/t/lib/ddclient/t/ip.pm new file mode 100644 index 000000000..769e5a9cb --- /dev/null +++ b/t/lib/ddclient/t/ip.pm @@ -0,0 +1,30 @@ +package ddclient::t::ip; + +use v5.10.1; +use strict; +use warnings; +use Exporter qw(import); +use Test::More; + +our @EXPORT = qw(ipv6_ok ipv6_required $ipv6_supported $ipv6_support_error); + +our $ipv6_support_error; +our $ipv6_supported = eval { + require IO::Socket::IP; + my $ipv6_socket = IO::Socket::IP->new( + Domain => 'PF_INET6', + LocalHost => '::1', + Listen => 1, + ); + defined($ipv6_socket); +} or $ipv6_support_error = $@; + +sub ipv6_ok { + ok($ipv6_supported, "system supports IPv6") or diag($ipv6_support_error); +} + +sub ipv6_required { + plan(skip_all => $ipv6_support_error) if !$ipv6_supported; +} + +1; diff --git a/t/logmsg.pl b/t/logmsg.pl new file mode 100644 index 000000000..6db4b2e20 --- /dev/null +++ b/t/logmsg.pl @@ -0,0 +1,167 @@ +use Test::More; +SKIP: { eval { require Test::Warnings; } or skip($@, 1); } +eval { require 'ddclient'; } or BAIL_OUT($@); + +my @test_cases = ( + { + desc => 'adds a newline', + args => ['xyz'], + want => "xyz\n", + }, + { + desc => 'removes one trailing newline (before adding a newline)', + args => ["xyz \n\t\n\n"], + want => "xyz \n\t\n\n", + }, + { + desc => 'accepts msg keyword parameter', + args => [msg => 'xyz'], + want => "xyz\n", + }, + { + desc => 'msg keyword parameter trumps message parameter', + args => [msg => 'kw', 'pos'], + want => "kw\n", + }, + { + desc => 'msg keyword parameter trumps message parameter', + args => [msg => 'kw', 'pos'], + want => "kw\n", + }, + { + desc => 'email appends to email body', + args => [email => 1, 'foo'], + init_email => "preexisting message\n", + want_email => "preexisting message\nfoo\n", + want => "foo\n", + }, + { + desc => 'single-line label', + args => [label => 'LBL', 'foo'], + want => "LBL: > foo\n", + }, + { + desc => 'multi-line label', + args => [label => 'LBL', "foo\nbar"], + want => ("LBL: > foo\n" . + "LBL: bar\n"), + }, + { + desc => 'single-line long label', + args => [label => 'VERY LONG LABEL', 'foo'], + want => "VERY LONG LABEL: > foo\n", + }, + { + desc => 'multi-line long label', + args => [label => 'VERY LONG LABEL', "foo\nbar"], + want => ("VERY LONG LABEL: > foo\n" . + "VERY LONG LABEL: bar\n"), + }, + { + desc => 'single line, no label, single context', + args => ['foo'], + ctxs => ['only context'], + want => "[only context]> foo\n", + }, + { + desc => 'single line, no label, two contexts', + args => ['foo'], + ctxs => ['context one', 'context two'], + want => "[context one][context two]> foo\n", + }, + { + desc => 'single line, label, two contexts', + args => [label => 'LBL', 'foo'], + ctxs => ['context one', 'context two'], + want => "LBL: [context one][context two]> foo\n", + }, + { + desc => 'multiple lines, label, two contexts', + args => [label => 'LBL', "foo\nbar"], + ctxs => ['context one', 'context two'], + want => ("LBL: [context one][context two]> foo\n" . + "LBL: [context one][context two] bar\n"), + }, + { + desc => 'string ctx arg', + args => [label => 'LBL', ctx => 'three', "foo\nbar"], + ctxs => ['one', 'two'], + want => ("LBL: [one][two][three]> foo\n" . + "LBL: [one][two][three] bar\n"), + }, + { + desc => 'arrayref ctx arg', + args => [label => 'LBL', ctx => ['three', 'four'], "foo\nbar"], + ctxs => ['one', 'two'], + want => ("LBL: [one][two][three][four]> foo\n" . + "LBL: [one][two][three][four] bar\n"), + }, + { + desc => 'undef ctx', + args => [label => 'LBL', "foo"], + ctxs => ['one', undef], + want => "LBL: [one]> foo\n", + }, + { + desc => 'arrayref ctx', + args => [label => 'LBL', "foo"], + ctxs => ['one', ['two', 'three']], + want => "LBL: [one][two][three]> foo\n", + }, +); + +for my $tc (@test_cases) { + subtest $tc->{desc} => sub { + $tc->{wantemail} //= ''; + my $output; + open(my $fh, '>', \$output); + local $ddclient::emailbody = $tc->{init_email} // ''; + local $ddclient::_l = $ddclient::_l; + $ddclient::_l = ddclient::pushlogctx($_) for @{$tc->{ctxs} // []}; + { + local *STDERR = $fh; + ddclient::logmsg(@{$tc->{args}}); + } + close($fh); + is($output, $tc->{want}, 'output text matches'); + is($ddclient::emailbody, $tc->{want_email} // '', 'email content matches'); + } +} + +my @logfmt_test_cases = ( + { + desc => 'single argument is printed directly, not via sprintf', + args => ['%%'], + want => "DEBUG: > %%\n", + }, + { + desc => 'multiple arguments are formatted via sprintf', + args => ['%s', 'foo'], + want => "DEBUG: > foo\n", + }, + { + desc => 'single argument with context', + args => [ctx => 'context', '%%'], + want => "DEBUG: [context]> %%\n", + }, + { + desc => 'multiple arguments with context', + args => [ctx => 'context', '%s', 'foo'], + want => "DEBUG: [context]> foo\n", + }, +); + +for my $tc (@logfmt_test_cases) { + my $got; + open(my $fh, '>', \$got); + local $ddclient::globals{debug} = 1; + %ddclient::globals if 0; + { + local *STDERR = $fh; + ddclient::debug(@{$tc->{args}}); + } + close($fh); + is($got, $tc->{want}, $tc->{desc}); +} + +done_testing(); diff --git a/t/parse_assignments.pl b/t/parse_assignments.pl index d595459e9..ab965b9ea 100644 --- a/t/parse_assignments.pl +++ b/t/parse_assignments.pl @@ -44,8 +44,20 @@ sub tc { tc('unquoted escaped backslash', "a=\\\\", { a => "\\" }, ""), tc('squoted escaped squote', "a='\\''", { a => "'" }, ""), tc('dquoted escaped dquote', "a=\"\\\"\"", { a => '"' }, ""), + tc('env: empty', "a_env=", {}, ""), + tc('env: unset', "a_env=UNSET", {}, ""), + tc('env: set', "a_env=TEST", { a => 'val' }, ""), + tc('env: single quoted', "a_env='TEST'", { a => 'val' }, ""), + tc('newline: quoted value', "a='1\n2'", { a => "1\n2" }, ""), + tc('newline: escaped value', "a=1\\\n2", { a => "1\n2" }, ""), + tc('newline: between vars', "a=1 \n b=2", { a => '1' }, "\n b=2"), + tc('newline: terminating', "a=1 \n", { a => '1' }, "\n"), ); +delete($ENV{''}); +delete($ENV{UNSET}); +$ENV{TEST} = 'val'; + for my $tc (@test_cases) { my ($got_rest, %got_vars) = ddclient::parse_assignments($tc->{input}); subtest $tc->{name} => sub { diff --git a/t/protocol_directnic.pl b/t/protocol_directnic.pl new file mode 100644 index 000000000..bc96152ab --- /dev/null +++ b/t/protocol_directnic.pl @@ -0,0 +1,169 @@ +use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require JSON::PP; 1; } or plan(skip_all => $@); JSON::PP->import(); } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +use ddclient::t::HTTPD; +use ddclient::t::Logger; + +httpd_required(); + +ddclient::load_json_support('directnic'); + +httpd()->run(sub { + my ($req) = @_; + diag('=============================================================================='); + diag("Test server received request:\n" . $req->as_string()); + my $headers = ['content-type' => 'text/plain; charset=utf-8']; + if ($req->uri->as_string =~ m/\/dns\/gateway\/(abc|def)\/\?data=([^&]*)/) { + return [200, ['Content-Type' => 'application/json'], [encode_json({ + result => 'success', + message => "Your record was updated to $2", + })]]; + } elsif ($req->uri->as_string =~ m/\/dns\/gateway\/bad_token\/\?data=([^&]*)/) { + return [200, ['Content-Type' => 'application/json'], [encode_json({ + result => 'error', + message => "There was an error updating your record.", + })]]; + } elsif ($req->uri->as_string =~ m/\/bad\/path\/\?data=([^&]*)/) { + return [200, ['Content-Type' => 'application/json'], ['unexpected response body']]; + } + return [400, $headers, ['unexpected request: ' . $req->uri()]] +}); + +my $hostname = httpd()->endpoint(); +my @test_cases = ( + { + desc => 'IPv4, good', + cfg => {h1 => {urlv4 => "$hostname/dns/gateway/abc/", wantipv4 => '192.0.2.1'}}, + wantrecap => { + h1 => {'status-ipv4' => 'good', 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now}, + }, + wantlogs => [ + {label => 'SUCCESS', ctx => ['h1'], msg => qr/IPv4/}, + ], + }, + { + desc => 'IPv4, failed', + cfg => {h1 => {urlv4 => "$hostname/dns/gateway/bad_token/", wantipv4 => '192.0.2.1'}}, + wantrecap => { + h1 => {'status-ipv4' => 'failed'}, + }, + wantlogs => [ + {label => 'FAILED', ctx => ['h1'], msg => qr/There was an error updating your record/}, + ], + }, + { + desc => 'IPv4, bad', + cfg => {h1 => {urlv4 => "$hostname/bad/path/", wantipv4 => '192.0.2.1'}}, + wantrecap => { + h1 => {'status-ipv4' => 'bad'}, + }, + wantlogs => [ + {label => 'FAILED', ctx => ['h1'], msg => qr/response is not a JSON object:\nunexpected response body/}, + ], + }, + { + desc => 'IPv4, unexpected response', + cfg => {h1 => {urlv4 => "$hostname/unexpected/path/", wantipv4 => '192.0.2.1'}}, + wantrecap => {}, + wantlogs => [ + {label => 'FAILED', ctx => ['h1'], msg => qr/400 Bad Request/}, + ], + }, + { + desc => 'IPv4, no urlv4', + cfg => {h1 => {wantipv4 => '192.0.2.1'}}, + wantrecap => {}, + wantlogs => [ + {label => 'FAILED', ctx => ['h1'], msg => qr/missing urlv4 option/}, + ], + }, + { + desc => 'IPv6, good', + cfg => {h1 => {urlv6 => "$hostname/dns/gateway/abc/", wantipv6 => '2001:db8::1'}}, + wantrecap => { + h1 => {'status-ipv6' => 'good', 'ipv6' => '2001:db8::1', 'mtime' => $ddclient::now}, + }, + wantlogs => [ + {label => 'SUCCESS', ctx => ['h1'], msg => qr/IPv6/}, + ], + }, + { + desc => 'IPv4 and IPv6, good', + cfg => {h1 => { + urlv4 => "$hostname/dns/gateway/abc/", + urlv6 => "$hostname/dns/gateway/def/", + wantipv4 => '192.0.2.1', + wantipv6 => '2001:db8::1', + }}, + wantrecap => { + h1 => {'status-ipv4' => 'good', 'ipv4' => '192.0.2.1', + 'status-ipv6' => 'good', 'ipv6' => '2001:db8::1', + 'mtime' => $ddclient::now}, + }, + wantlogs => [ + {label => 'SUCCESS', ctx => ['h1'], msg => qr/IPv4/}, + {label => 'SUCCESS', ctx => ['h1'], msg => qr/IPv6/}, + ], + }, + { + desc => 'IPv4 and IPv6, mixed success', + cfg => {h1 => { + urlv4 => "$hostname/dns/gateway/bad_token/", + urlv6 => "$hostname/dns/gateway/def/", + wantipv4 => '192.0.2.1', + wantipv6 => '2001:db8::1', + }}, + wantips => {h1 => {wantipv4 => '192.0.2.1', wantipv6 => '2001:db8::1'}}, + wantrecap => { + h1 => {'status-ipv4' => 'failed', + 'status-ipv6' => 'good', 'ipv6' => '2001:db8::1', + 'mtime' => $ddclient::now}, + }, + wantlogs => [ + {label => 'FAILED', ctx => ['h1'], msg => qr/There was an error updating your record/}, + {label => 'SUCCESS', ctx => ['h1'], msg => qr/IPv6/}, + ], + }, +); + +for my $tc (@test_cases) { + diag('=============================================================================='); + diag("Starting test: $tc->{desc}"); + diag('=============================================================================='); + local $ddclient::globals{debug} = 1; + local $ddclient::globals{verbose} = 1; + my $l = ddclient::t::Logger->new($ddclient::_l, qr/^(?:WARNING|FATAL|SUCCESS|FAILED)$/); + local %ddclient::config = %{$tc->{cfg}}; + local %ddclient::recap; + { + local $ddclient::_l = $l; + ddclient::nic_directnic_update(undef, sort(keys(%{$tc->{cfg}}))); + } + is_deeply(\%ddclient::recap, $tc->{wantrecap}, "$tc->{desc}: recap") + or diag(ddclient::repr(Values => [\%ddclient::recap, $tc->{wantrecap}], + Names => ['*got', '*want'])); + $tc->{wantlogs} //= []; + subtest("$tc->{desc}: logs" => sub { + my @got = @{$l->{logs}}; + my @want = @{$tc->{wantlogs}}; + for my $i (0..$#want) { + last if $i >= @got; + my $got = $got[$i]; + my $want = $want[$i]; + subtest("log $i" => sub { + is($got->{label}, $want->{label}, "label matches"); + is_deeply($got->{ctx}, $want->{ctx}, "context matches"); + like($got->{msg}, $want->{msg}, "message matches"); + }) or diag(ddclient::repr(Values => [$got, $want], Names => ['*got', '*want'])); + } + my @unexpected = @got[@want..$#got]; + ok(@unexpected == 0, "no unexpected logs") + or diag(ddclient::repr(\@unexpected, Names => ['*unexpected'])); + my @missing = @want[@got..$#want]; + ok(@missing == 0, "no missing logs") + or diag(ddclient::repr(\@missing, Names => ['*missing'])); + }); +} + +done_testing(); diff --git a/t/protocol_dnsexit2.pl b/t/protocol_dnsexit2.pl new file mode 100644 index 000000000..9991e7cff --- /dev/null +++ b/t/protocol_dnsexit2.pl @@ -0,0 +1,242 @@ +use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require JSON::PP; 1; } or plan(skip_all => $@); JSON::PP->import(); } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +use ddclient::t::HTTPD; +use ddclient::t::Logger; + +httpd_required(); + +local $ddclient::globals{debug} = 1; +local $ddclient::globals{verbose} = 1; + +ddclient::load_json_support('dnsexit2'); + +httpd()->run(sub { + my ($req) = @_; + return undef if $req->uri()->path() eq '/control'; + return [200, ['Content-Type' => 'application/json'], [encode_json({ + code => 0, + message => 'Success' + })]]; +}); + +sub cmp_update { + my ($a, $b) = @_; + return $a->{name} cmp $b->{name} || $a->{type} cmp $b->{type}; +} + +sub sort_updates { + my ($req) = @_; + return { + %$req, + update => [sort({ cmp_update($a, $b); } @{$req->{update}})], + }; +} + +sub sort_reqs { + my @reqs = map(sort_updates($_), @_); + my @sorted = sort({ + my $ret = $a->{domain} cmp $b->{domain}; + $ret = @{$a->{update}} <=> @{$b->{update}} if !$ret; + my $i = 0; + while (!$ret && $i < @{$a->{update}} && $i < @{$b->{update}}) { + $ret = cmp_update($a->{update}[$i], $b->{update}[$i]); + } + return $ret; + } @reqs); + return @sorted; +} + +my @test_cases = ( + { + desc => 'both IPv4 and IPv6 are updated together', + cfg => { + 'host.my.example.com' => { + ttl => 5, + wantipv4 => '192.0.2.1', + wantipv6 => '2001:db8::1', + zone => 'my.example.com', + }, + }, + want => [{ + apikey => 'key', + domain => 'my.example.com', + update => [ + { + content => '192.0.2.1', + name => 'host', + ttl => 5, + type => 'A', + }, + { + content => '2001:db8::1', + name => 'host', + ttl => 5, + type => 'AAAA', + }, + ], + }], + }, + { + desc => 'zone defaults to host', + cfg => { + 'host.my.example.com' => { + ttl => 10, + wantipv4 => '192.0.2.1', + }, + }, + want => [{ + apikey => 'key', + domain => 'host.my.example.com', + update => [ + { + content => '192.0.2.1', + name => '', + ttl => 10, + type => 'A', + }, + ], + }], + }, + { + desc => 'two hosts, different zones', + cfg => { + 'host1.example.com' => { + ttl => 5, + wantipv4 => '192.0.2.1', + # 'zone' intentionally not set, so it will default to 'host1.example.com'. + }, + 'host2.example.com' => { + ttl => 10, + wantipv6 => '2001:db8::1', + zone => 'example.com', + }, + }, + want => [ + { + apikey => 'key', + domain => 'host1.example.com', + update => [ + { + content => '192.0.2.1', + name => '', + ttl => 5, + type => 'A', + }, + ], + }, + { + apikey => 'key', + domain => 'example.com', + update => [ + { + content => '2001:db8::1', + name => 'host2', + ttl => 10, + type => 'AAAA', + }, + ], + }, + ], + }, + { + desc => 'two hosts, same zone', + cfg => { + 'host1.example.com' => { + ttl => 5, + wantipv4 => '192.0.2.1', + zone => 'example.com', + }, + 'host2.example.com' => { + ttl => 10, + wantipv6 => '2001:db8::1', + zone => 'example.com', + }, + }, + want => [ + { + apikey => 'key', + domain => 'example.com', + update => [ + { + content => '192.0.2.1', + name => 'host1', + ttl => 5, + type => 'A', + }, + { + content => '2001:db8::1', + name => 'host2', + ttl => 10, + type => 'AAAA', + }, + ], + }, + ], + }, + { + desc => 'host outside of zone', + cfg => { + 'host.example' => { + wantipv4 => '192.0.2.1', + zone => 'example.com', + }, + }, + want_fatal => qr{hostname does not end with the zone: example.com}, + }, +); + +for my $tc (@test_cases) { + subtest($tc->{desc} => sub { + local $ddclient::_l = ddclient::pushlogctx($tc->{desc}); + local %ddclient::config = (); + my @hosts = keys(%{$tc->{cfg}}); + for my $h (@hosts) { + $ddclient::config{$h} = { + password => 'key', + path => '/update', + server => httpd()->endpoint(), + %{$tc->{cfg}{$h}}, + }; + } + my $l = ddclient::t::Logger->new($ddclient::_l, qr/^FATAL$/); + my $err = do { + local $ddclient::_l = $l; + local $@; + (eval { ddclient::nic_dnsexit2_update(undef, @hosts); 1; }) + ? undef : ($@ // 'unknown error'); + }; + my @requests = httpd()->reset(); + my @got; + for (my $i = 0; $i < @requests; $i++) { + subtest("request $i" => sub { + my $req = $requests[$i]; + is($req->method(), 'POST', 'method is POST'); + is($req->uri()->as_string(), '/update', 'path is /update'); + is($req->header('content-type'), 'application/json', 'Content-Type is JSON'); + is($req->header('accept'), 'application/json', 'Accept is JSON'); + my $got = decode_json($req->content()); + is(ref($got), 'HASH', 'request content is a JSON object'); + is(ref($got->{update}), 'ARRAY', 'JSON object has array "update" property'); + push(@got, $got); + }); + } + @got = sort_reqs(@got); + my @want = sort_reqs(@{$tc->{want} // []}); + is_deeply(\@got, \@want, 'request objects match'); + subtest('expected (or lack of) error' => sub { + if (is(defined($err), defined($tc->{want_fatal}), 'error existence') && defined($err)) { + my @got = @{$l->{logs}}; + if (is(scalar(@got), 2, 'logged two events')) { + is($got[0]->{label}, 'FATAL', 'first logged event is a FATAL message'); + like($got[0]->{msg}, $tc->{want_fatal}, 'first logged event message matches'); + is($got[1], 'aborted', 'second logged event is an "aborted" event'); + isa_ok($err, qw(ddclient::t::LoggerAbort)); + } + } + }); + }); +} + +done_testing(); diff --git a/t/protocol_dyndns2.pl b/t/protocol_dyndns2.pl new file mode 100644 index 000000000..a5091cbbb --- /dev/null +++ b/t/protocol_dyndns2.pl @@ -0,0 +1,279 @@ +use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +use MIME::Base64; +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +use ddclient::t::HTTPD; +use ddclient::t::Logger; + +httpd_required(); + +httpd()->run(sub { + my ($req) = @_; + diag('=============================================================================='); + diag("Test server received request:\n" . $req->as_string()); + return undef if $req->uri()->path() eq '/control'; + my $wantauthn = 'Basic ' . encode_base64('username:password', ''); + return [401, [@$textplain, 'www-authenticate' => 'Basic realm="realm", charset="UTF-8"'], + ['authentication required']] if ($req->header('authorization') // '') ne $wantauthn; + return [400, $textplain, ['invalid method: ' . $req->method()]] if $req->method() ne 'GET'; + return undef; +}); + +my @test_cases = ( + { + desc => 'IPv4, single host, good', + cfg => {h1 => {wantipv4 => '192.0.2.1'}}, + resp => ['good'], + wantquery => 'hostname=h1&myip=192.0.2.1', + wantrecap => { + h1 => {'status-ipv4' => 'good', 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now}, + }, + wantlogs => [ + {label => 'SUCCESS', ctx => ['h1'], msg => qr/IPv4/}, + ], + }, + { + desc => 'IPv4, single host, nochg', + cfg => {h1 => {wantipv4 => '192.0.2.1'}}, + resp => ['nochg'], + wantquery => 'hostname=h1&myip=192.0.2.1', + wantrecap => { + h1 => {'status-ipv4' => 'good', 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now}, + }, + wantlogs => [ + {label => 'WARNING', ctx => ['h1'], msg => qr/nochg/}, + {label => 'SUCCESS', ctx => ['h1'], msg => qr/IPv4/}, + ], + }, + { + desc => 'IPv4, single host, bad', + cfg => {h1 => {wantipv4 => '192.0.2.1'}}, + resp => ['nohost'], + wantquery => 'hostname=h1&myip=192.0.2.1', + wantrecap => { + h1 => {'status-ipv4' => 'nohost'}, + }, + wantlogs => [ + {label => 'FAILED', ctx => ['h1'], msg => qr/nohost/}, + ], + }, + { + desc => 'IPv4, single host, unexpected', + cfg => {h1 => {wantipv4 => '192.0.2.1'}}, + resp => ['WAT'], + wantquery => 'hostname=h1&myip=192.0.2.1', + wantrecap => { + h1 => {'status-ipv4' => 'WAT'}, + }, + wantlogs => [ + {label => 'FAILED', ctx => ['h1'], msg => qr/unexpected.*WAT/}, + ], + }, + { + desc => 'IPv4, multiple hosts, multiple good', + cfg => { + h1 => {wantipv4 => '192.0.2.1'}, + h2 => {wantipv4 => '192.0.2.1'}, + }, + resp => [ + 'good 192.0.2.1', + 'good', + ], + wantquery => 'hostname=h1,h2&myip=192.0.2.1', + wantrecap => { + h1 => {'status-ipv4' => 'good', 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now}, + h2 => {'status-ipv4' => 'good', 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now}, + }, + wantlogs => [ + {label => 'SUCCESS', ctx => ['h1'], msg => qr/IPv4/}, + {label => 'SUCCESS', ctx => ['h2'], msg => qr/IPv4/}, + ], + }, + { + desc => 'IPv4, multiple hosts, mixed success', + cfg => { + h1 => {wantipv4 => '192.0.2.1'}, + h2 => {wantipv4 => '192.0.2.1'}, + h3 => {wantipv4 => '192.0.2.1'}, + }, + resp => [ + 'good', + 'nochg', + 'dnserr', + ], + wantquery => 'hostname=h1,h2,h3&myip=192.0.2.1', + wantrecap => { + h1 => {'status-ipv4' => 'good', 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now}, + h2 => {'status-ipv4' => 'good', 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now}, + h3 => {'status-ipv4' => 'dnserr'}, + }, + wantlogs => [ + {label => 'SUCCESS', ctx => ['h1'], msg => qr/IPv4/}, + {label => 'WARNING', ctx => ['h2'], msg => qr/nochg/}, + {label => 'SUCCESS', ctx => ['h2'], msg => qr/IPv4/}, + {label => 'FAILED', ctx => ['h3'], msg => qr/dnserr/}, + ], + }, + { + desc => 'IPv6, single host, good', + cfg => {h1 => {wantipv6 => '2001:db8::1'}}, + resp => ['good'], + wantquery => 'hostname=h1&myip=2001:db8::1', + wantrecap => { + h1 => {'status-ipv6' => 'good', 'ipv6' => '2001:db8::1', 'mtime' => $ddclient::now}, + }, + wantlogs => [ + {label => 'SUCCESS', ctx => ['h1'], msg => qr/IPv6/}, + ], + }, + { + desc => 'IPv4 and IPv6, single host, good', + cfg => {h1 => {wantipv4 => '192.0.2.1', wantipv6 => '2001:db8::1'}}, + resp => ['good'], + wantquery => 'hostname=h1&myip=192.0.2.1,2001:db8::1', + wantrecap => { + h1 => {'status-ipv4' => 'good', 'ipv4' => '192.0.2.1', + 'status-ipv6' => 'good', 'ipv6' => '2001:db8::1', + 'mtime' => $ddclient::now}, + }, + wantlogs => [ + {label => 'SUCCESS', ctx => ['h1'], msg => qr/IPv4/}, + {label => 'SUCCESS', ctx => ['h1'], msg => qr/IPv6/}, + ], + }, + { + desc => 'excess status line', + cfg => { + h1 => {wantipv4 => '192.0.2.1'}, + h2 => {wantipv4 => '192.0.2.1'}, + }, + resp => [ + 'good', + 'good', + 'WAT', + ], + wantquery => 'hostname=h1,h2&myip=192.0.2.1', + wantrecap => { + h1 => {'status-ipv4' => 'good', 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now}, + h2 => {'status-ipv4' => 'good', 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now}, + }, + wantlogs => [ + {label => 'SUCCESS', ctx => ['h1'], msg => qr/IPv4/}, + {label => 'SUCCESS', ctx => ['h2'], msg => qr/IPv4/}, + {label => 'WARNING', ctx => ['h1,h2'], msg => qr/unexpected.*\nWAT$/}, + ], + }, + { + desc => 'multiple hosts, single failure', + cfg => { + h1 => {wantipv4 => '192.0.2.1'}, + h2 => {wantipv4 => '192.0.2.1'}, + }, + resp => ['abuse'], + wantquery => 'hostname=h1,h2&myip=192.0.2.1', + wantrecap => { + h1 => {'status-ipv4' => 'abuse'}, + h2 => {'status-ipv4' => 'abuse'}, + }, + wantlogs => [ + {label => 'FAILED', ctx => ['h1'], msg => qr/abuse/}, + {label => 'FAILED', ctx => ['h2'], msg => qr/abuse/}, + ], + }, + { + desc => 'multiple hosts, single success', + cfg => { + h1 => {wantipv4 => '192.0.2.1'}, + h2 => {wantipv4 => '192.0.2.1'}, + }, + resp => ['good'], + wantquery => 'hostname=h1,h2&myip=192.0.2.1', + wantrecap => { + h1 => {'status-ipv4' => 'good', 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now}, + h2 => {'status-ipv4' => 'good', 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now}, + }, + wantlogs => [ + {label => 'WARNING', ctx => ['h1,h2'], msg => qr//}, + {label => 'SUCCESS', ctx => ['h1'], msg => qr/IPv4/}, + {label => 'SUCCESS', ctx => ['h2'], msg => qr/IPv4/}, + ], + }, + { + desc => 'multiple hosts, fewer results', + cfg => { + h1 => {wantipv4 => '192.0.2.1'}, + h2 => {wantipv4 => '192.0.2.1'}, + h3 => {wantipv4 => '192.0.2.1'}, + }, + resp => [ + 'good', + 'nochg', + ], + wantquery => 'hostname=h1,h2,h3&myip=192.0.2.1', + wantrecap => { + h1 => {'status-ipv4' => 'good', 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now}, + h2 => {'status-ipv4' => 'good', 'ipv4' => '192.0.2.1', 'mtime' => $ddclient::now}, + h3 => {'status-ipv4' => 'unknown'}, + }, + wantlogs => [ + {label => 'SUCCESS', ctx => ['h1'], msg => qr/IPv4/}, + {label => 'WARNING', ctx => ['h2'], msg => qr/nochg/}, + {label => 'SUCCESS', ctx => ['h2'], msg => qr/IPv4/}, + {label => 'FAILED', ctx => ['h3'], msg => qr/assuming failure/}, + ], + }, +); + +for my $tc (@test_cases) { + diag('=============================================================================='); + diag("Starting test: $tc->{desc}"); + diag('=============================================================================='); + local $ddclient::globals{debug} = 1; + local $ddclient::globals{verbose} = 1; + my $l = ddclient::t::Logger->new($ddclient::_l, qr/^(?:WARNING|FATAL|SUCCESS|FAILED)$/); + local %ddclient::config; + local %ddclient::recap; + $ddclient::config{$_} = { + login => 'username', + password => 'password', + server => httpd()->endpoint(), + script => '/nic/update', + %{$tc->{cfg}{$_}}, + } for keys(%{$tc->{cfg}}); + httpd()->reset([200, $textplain, [map("$_\n", @{$tc->{resp}})]]); + { + local $ddclient::_l = $l; + ddclient::nic_dyndns2_update(undef, sort(keys(%{$tc->{cfg}}))); + } + my @requests = httpd()->reset(); + is(scalar(@requests), 1, "$tc->{desc}: single update request"); + my $req = shift(@requests); + is($req->uri()->path(), '/nic/update', "$tc->{desc}: request path"); + is($req->uri()->query(), $tc->{wantquery}, "$tc->{desc}: request query"); + is_deeply(\%ddclient::recap, $tc->{wantrecap}, "$tc->{desc}: recap") + or diag(ddclient::repr(Values => [\%ddclient::recap, $tc->{wantrecap}], + Names => ['*got', '*want'])); + $tc->{wantlogs} //= []; + subtest("$tc->{desc}: logs" => sub { + my @got = @{$l->{logs}}; + my @want = @{$tc->{wantlogs}}; + for my $i (0..$#want) { + last if $i >= @got; + my $got = $got[$i]; + my $want = $want[$i]; + subtest("log $i" => sub { + is($got->{label}, $want->{label}, "label matches"); + is_deeply($got->{ctx}, $want->{ctx}, "context matches"); + like($got->{msg}, $want->{msg}, "message matches"); + }) or diag(ddclient::repr(Values => [$got, $want], Names => ['*got', '*want'])); + } + my @unexpected = @got[@want..$#got]; + ok(@unexpected == 0, "no unexpected logs") + or diag(ddclient::repr(\@unexpected, Names => ['*unexpected'])); + my @missing = @want[@got..$#want]; + ok(@missing == 0, "no missing logs") + or diag(ddclient::repr(\@missing, Names => ['*missing'])); + }); +} + +done_testing(); diff --git a/t/read_recap.pl b/t/read_recap.pl new file mode 100644 index 000000000..a243d99a3 --- /dev/null +++ b/t/read_recap.pl @@ -0,0 +1,107 @@ +use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +use File::Temp; +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } + +local $ddclient::globals{debug} = 1; +local $ddclient::globals{verbose} = 1; +local %ddclient::protocols = ( + protocol_a => ddclient::Protocol->new( + recapvars => { + host => ddclient::T_STRING(), + var_a => ddclient::T_BOOL(), + }, + ), + protocol_b => ddclient::Protocol->new( + recapvars => { + host => ddclient::T_STRING(), + var_b => ddclient::T_NUMBER(), + }, + cfgvars => { + var_b_non_recap => {type => ddclient::T_ANY()}, + }, + ), +); +local %ddclient::cfgvars = (merged => {map({ %{$ddclient::protocols{$_}{cfgvars} // {}}; } + sort(keys(%ddclient::protocols)))}); + +my @test_cases = ( + { + desc => "ok value", + cachefile_lines => ["var_a=yes host_a"], + want => {host_a => {host => 'host_a', var_a => 1}}, + }, + { + desc => "unknown host", + cachefile_lines => ["var_a=yes host_c"], + want => {}, + }, + { + desc => "unknown var", + cachefile_lines => ["var_b=123 host_a"], + want => {host_a => {host => 'host_a'}}, + }, + { + desc => "invalid value", + cachefile_lines => ["var_a=wat host_a"], + want => {host_a => {host => 'host_a'}}, + }, + { + desc => "multiple entries", + cachefile_lines => [ + "var_a=yes host_a", + "var_b=123 host_b", + ], + want => { + host_a => {host => 'host_a', var_a => 1}, + host_b => {host => 'host_b', var_b => 123}, + }, + }, + { + desc => "non-recap vars are not loaded to %recap", + cachefile_lines => ["var_b_non_recap=foo host_b"], + want => {host_b => {host => 'host_b'}}, + }, + { + desc => "non-recap vars are scrubbed from %recap", + cachefile_lines => ["var_b_non_recap=foo host_b"], + recap => {host_b => {host => 'host_b', var_b_non_recap => 'foo'}}, + want => {host_b => {host => 'host_b'}}, + }, + { + desc => "unknown hosts are scrubbed from %recap", + cachefile_lines => ["host_a", "host_c"], + recap => {host_a => {host => 'host_a'}, host_c => {host => 'host_c'}}, + want => {host_a => {host => 'host_a'}}, + }, +); + +for my $tc (@test_cases) { + my $cachef = File::Temp->new(); + print($cachef join('', map("$_\n", "## $ddclient::program-$ddclient::version", + @{$tc->{cachefile_lines}}))); + $cachef->close(); + local $ddclient::globals{cache} = "$cachef"; + local %ddclient::recap = %{$tc->{recap} // {}}; + my %want_config = ( + host_a => {protocol => 'protocol_a'}, + host_b => {protocol => 'protocol_b'}, + ); + # Deep clone %want_config so we can check for changes. + local %ddclient::config; + $ddclient::config{$_} = {%{$want_config{$_}}} for keys(%want_config); + + ddclient::read_recap($cachef->filename()); + + TODO: { + local $TODO = $tc->{want_TODO}; + is_deeply(\%ddclient::recap, $tc->{want}, "$tc->{desc}: %recap") + or diag(ddclient::repr(Values => [\%ddclient::recap, $tc->{want}], + Names => ['*got', '*want'])); + } + is_deeply(\%ddclient::config, \%want_config, "$tc->{desc}: %config") + or diag(ddclient::repr(Values => [\%ddclient::config, \%want_config], + Names => ['*got', '*want'])); +} + +done_testing(); diff --git a/t/skip.pl b/t/skip.pl new file mode 100644 index 000000000..3f0ba3ac6 --- /dev/null +++ b/t/skip.pl @@ -0,0 +1,150 @@ +use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +use ddclient::t::HTTPD; +use ddclient::t::ip; + +httpd_required(); + +httpd('4')->run( + sub { return [200, ['Content-Type' => 'text/plain'], ['127.0.0.1 skip 127.0.0.2']]; }); +httpd('6')->run( + sub { return [200, ['Content-Type' => 'text/plain'], ['::1 skip ::2']]; }) + if httpd('6'); + +my $builtinwebv4 = 't/skip.pl webv4'; +my $builtinwebv6 = 't/skip.pl webv6'; +my $builtinfw = 't/skip.pl fw'; + +$ddclient::builtinweb{$builtinwebv4} = {'url' => httpd('4')->endpoint(), 'skip' => 'skip'}; +$ddclient::builtinweb{$builtinwebv6} = {'url' => httpd('6')->endpoint(), 'skip' => 'skip'} + if httpd('6'); +$ddclient::builtinfw{$builtinfw} = {name => 'test', skip => 'skip'}; +%ddclient::builtinfw if 0; # suppress spurious warning "Name used only once: possible typo" +%ddclient::ip_strategies = (%ddclient::ip_strategies, ddclient::builtinfw_strategy($builtinfw)); +%ddclient::ipv4_strategies = + (%ddclient::ipv4_strategies, ddclient::builtinfwv4_strategy($builtinfw)); +%ddclient::ipv6_strategies = + (%ddclient::ipv6_strategies, ddclient::builtinfwv6_strategy($builtinfw)); + +sub run_test_case { + my %tc = @_; + SKIP: { + skip("IPv6 not supported on this system", 1) if $tc{ipv6} && !$ipv6_supported; + skip("HTTP::Daemon too old for IPv6 support", 1) if $tc{ipv6} && !$httpd_ipv6_supported; + my $h = 't/skip.pl'; + $ddclient::config{$h} = $tc{cfg}; + %ddclient::config if 0; # suppress spurious warning "Name used only once: possible typo" + is(ddclient::get_ip(ddclient::strategy_inputs('use', $h)), $tc{want}, $tc{desc}) + if ($tc{cfg}{use}); + is(ddclient::get_ipv4(ddclient::strategy_inputs('usev4', $h)), $tc{want}, $tc{desc}) + if ($tc{cfg}{usev4}); + is(ddclient::get_ipv6(ddclient::strategy_inputs('usev6', $h)), $tc{want}, $tc{desc}) + if ($tc{cfg}{usev6}); + } +} + +subtest "use=web web='$builtinwebv4'" => sub { + run_test_case( + desc => "web-skip='' cancels built-in skip", + cfg => { + 'use' => 'web', + 'web' => $builtinwebv4, + 'web-skip' => '', + }, + want => '127.0.0.1', + ); + run_test_case( + desc => 'web-skip=undef uses built-in skip', + cfg => { + 'use' => 'web', + 'web' => $builtinwebv4, + 'web-skip' => undef, + }, + want => '127.0.0.2', + ); +}; +subtest "usev4=webv4 webv4='$builtinwebv4'" => sub { + run_test_case( + desc => "webv4-skip='' cancels built-in skip", + cfg => { + 'usev4' => 'webv4', + 'webv4' => $builtinwebv4, + 'webv4-skip' => '', + }, + want => '127.0.0.1', + ); + run_test_case( + desc => 'webv4-skip=undef uses built-in skip', + cfg => { + 'usev4' => 'webv4', + 'webv4' => $builtinwebv4, + 'webv4-skip' => undef, + }, + want => '127.0.0.2', + ); +}; +subtest "usev6=webv6 webv6='$builtinwebv6'" => sub { + run_test_case( + desc => "webv6-skip='' cancels built-in skip", + cfg => { + 'usev6' => 'webv6', + 'webv6' => $builtinwebv6, + 'webv6-skip' => '', + }, + ipv6 => 1, + want => '::1', + ); + run_test_case( + desc => 'webv6-skip=undef uses built-in skip', + cfg => { + 'usev6' => 'webv6', + 'webv6' => $builtinwebv6, + 'webv6-skip' => undef, + }, + ipv6 => 1, + want => '::2', + ); +}; +subtest "use='$builtinfw'" => sub { + run_test_case( + desc => "fw-skip='' cancels built-in skip", + cfg => { + 'fw' => httpd('4')->endpoint(), + 'fw-skip' => '', + 'use' => $builtinfw, + }, + want => '127.0.0.1', + ); + run_test_case( + desc => 'fw-skip=undef uses built-in skip', + cfg => { + 'fw' => httpd('4')->endpoint(), + 'fw-skip' => undef, + 'use' => $builtinfw, + }, + want => '127.0.0.2', + ); +}; +subtest "usev4='$builtinfw'" => sub { + run_test_case( + desc => "fwv4-skip='' cancels built-in skip", + cfg => { + 'fwv4' => httpd('4')->endpoint(), + 'fwv4-skip' => '', + 'usev4' => $builtinfw, + }, + want => '127.0.0.1', + ); + run_test_case( + desc => 'fwv4-skip=undef uses built-in skip', + cfg => { + 'fwv4' => httpd('4')->endpoint(), + 'fwv4-skip' => undef, + 'usev4' => $builtinfw, + }, + want => '127.0.0.2', + ); +}; + +done_testing(); diff --git a/t/ssl-validate.pl b/t/ssl-validate.pl new file mode 100644 index 000000000..6bea9a3f5 --- /dev/null +++ b/t/ssl-validate.pl @@ -0,0 +1,94 @@ +use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +use ddclient::t::HTTPD; +use ddclient::t::ip; + +local $ddclient::globals{debug} = 1; +local $ddclient::globals{verbose} = 1; + +httpd_required(); +httpd_ssl_required(); + +httpd('4', 1)->run(sub { return [200, $textplain, ['127.0.0.1']]; }); +httpd('6', 1)->run(sub { return [200, $textplain, ['::1']]; }) if httpd('6', 1); +my $h = 't/ssl-validate.pl'; +my %ep = ( + '4' => httpd('4', 1)->endpoint(), + '6' => httpd('6', 1) ? httpd('6', 1)->endpoint() : undef, +); + +my @test_cases = ( + { + desc => 'usev4=webv4 web-ssl-validate=no', + cfg => {'usev4' => 'webv4', 'web-ssl-validate' => 0, 'webv4' => $ep{'4'}}, + want => '127.0.0.1', + }, + { + desc => 'usev4=webv4 web-ssl-validate=yes', + cfg => {'usev4' => 'webv4', 'web-ssl-validate' => 1, 'webv4' => $ep{'4'}}, + want => undef, + }, + { + desc => 'usev6=webv6 web-ssl-validate=no', + cfg => {'usev6' => 'webv6', 'web-ssl-validate' => 0, 'webv6' => $ep{'6'}}, + ipv6 => 1, + want => '::1', + }, + { + desc => 'usev6=webv6 web-ssl-validate=yes', + cfg => {'usev6' => 'webv6', 'web-ssl-validate' => 1, 'webv6' => $ep{'6'}}, + ipv6 => 1, + want => undef, + }, + { + desc => 'usev4=cisco-asa fw-ssl-validate=no', + cfg => {'usev4' => 'cisco-asa', 'fw-ssl-validate' => 0, + # cisco-asa adds https:// to the URL. :-/ + 'fwv4' => substr($ep{'4'}, length('https://'))}, + want => '127.0.0.1', + }, + { + desc => 'usev4=cisco-asa fw-ssl-validate=yes', + cfg => {'usev4' => 'cisco-asa', 'fw-ssl-validate' => 1, + # cisco-asa adds https:// to the URL. :-/ + 'fwv4' => substr($ep{'4'}, length('https://'))}, + want => undef, + }, + { + desc => 'usev4=fwv4 fw-ssl-validate=no', + cfg => {'usev4' => 'fwv4', 'fw-ssl-validate' => 0, 'fwv4' => $ep{'4'}}, + want => '127.0.0.1', + }, + { + desc => 'usev4=fwv4 fw-ssl-validate=yes', + cfg => {'usev4' => 'fwv4', 'fw-ssl-validate' => 1, 'fwv4' => $ep{'4'}}, + want => undef, + }, +); + +for my $tc (@test_cases) { + local $ddclient::_l = ddclient::pushlogctx($tc->{desc}); + SKIP: { + skip("IPv6 not supported on this system", 1) if $tc->{ipv6} && !$ipv6_supported; + skip("HTTP::Daemon too old for IPv6 support", 1) if $tc->{ipv6} && !$httpd_ipv6_supported; + # $ddclient::globals{'ssl_ca_file'} is intentionally NOT set to $ca_file so that we can + # test what happens when certificate validation fails. However, if curl can't find any CA + # certificates (which may be the case in some minimal test environments, such as Docker + # images and Debian package builder chroots), it will immediately close the connection + # after it sends the TLS client hello and before it receives the server hello (in Debian + # sid as of 2025-01-08, anyway). This confuses IO::Socket::SSL (used by + # Test::Fake::HTTPD), causing it to hang in the middle of the TLS handshake waiting for + # input that will never arrive. To work around this, the CA certificate file is explicitly + # set to an unrelated certificate so that curl has something to read. + local $ddclient::globals{'ssl_ca_file'} = $other_ca_file; + local $ddclient::config{$h} = $tc->{cfg}; + %ddclient::config if 0; # suppress spurious warning "Name used only once: possible typo" + is(ddclient::get_ipv4(ddclient::strategy_inputs('usev4', $h)), $tc->{want}, $tc->{desc}) + if ($tc->{cfg}{usev4}); + is(ddclient::get_ipv6(ddclient::strategy_inputs('usev6', $h)), $tc->{want}, $tc->{desc}) + if ($tc->{cfg}{usev6}); + } +} + +done_testing(); diff --git a/t/update_nics.pl b/t/update_nics.pl new file mode 100644 index 000000000..e0fe679ab --- /dev/null +++ b/t/update_nics.pl @@ -0,0 +1,395 @@ +use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +use File::Temp; +BEGIN { eval { require HTTP::Request; 1; } or plan(skip_all => $@); } +BEGIN { eval { require JSON::PP; 1; } or plan(skip_all => $@); JSON::PP->import(); } +use List::Util qw(max); +use Scalar::Util qw(refaddr); +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +use ddclient::t::HTTPD; +use ddclient::t::ip; + +httpd_required(); + +httpd('4')->run(); +httpd('6')->run() if httpd('6'); +local %ddclient::builtinweb = ( + v4 => {url => "" . httpd('4')->endpoint()}, + defined(httpd('6')) ? (v6 => {url => "" . httpd('6')->endpoint()}) : (), +); + +# Sentinel value used by `mergecfg` that means "this hash entry should be deleted if it exists." +my $DOES_NOT_EXIST = []; + +sub mergecfg { + my %ret; + for my $cfg (@_) { + next if !defined($cfg); + for my $h (keys(%$cfg)) { + if (refaddr($cfg->{$h}) == refaddr($DOES_NOT_EXIST)) { + delete($ret{$h}); + next; + } + $ret{$h} = {%{$ret{$h} // {}}, %{$cfg->{$h}}}; + for my $k (keys(%{$ret{$h}})) { + my $a = refaddr($ret{$h}{$k}); + delete($ret{$h}{$k}) if defined($a) && $a == refaddr($DOES_NOT_EXIST); + } + } + } + return \%ret; +} + +local $ddclient::globals{debug} = 1; +local $ddclient::globals{verbose} = 1; +local $ddclient::now = 1000; +our @updates; +local %ddclient::protocols = ( + # The `legacy` protocol reads the legacy `wantip` property and sets the legacy `ip` and `status` + # properties. (Modern protocol implementations read `wantipv4` and `wantipv6` and set `ipv4`, + # `ipv6`, `status-ipv4`, and `status-ipv6`.) It always succeeds. + legacy => ddclient::LegacyProtocol->new( + update => sub { + my $self = shift; + ddclient::debug('in update'); + push(@updates, [@_]); + for my $h (@_) { + local $ddclient::_l = ddclient::pushlogctx($h); + ddclient::debug('updating host'); + $ddclient::recap{$h}{status} = 'good'; + $ddclient::recap{$h}{ip} = delete($ddclient::config{$h}{wantip}); + $ddclient::recap{$h}{mtime} = $ddclient::now; + } + ddclient::debug('returning from update'); + }, + ), +); + +my @test_cases = ( + map({ + my %cfg = %{delete($_->{cfg})}; + my $desc = join(' ', map("$_=$cfg{$_}", keys(%cfg))); + { + desc => "legacy, fresh, $desc", + cfg => {host => { + 'protocol' => 'legacy', + %cfg, + }}, + want_reqs_webv4 => 1, + want_updates => [['host']], + want_recap_changes => {host => { + 'atime' => $ddclient::now, + 'ipv4' => '192.0.2.1', + 'mtime' => $ddclient::now, + 'status-ipv4' => 'good', + }}, + %$_, + }; + } {cfg => {use => 'web'}}, {cfg => {usev4 => 'webv4'}}), + { + desc => 'legacy, fresh, use=web (IPv6)', + ipv6 => 1, + cfg => {host => { + 'protocol' => 'legacy', + 'use' => 'web', + 'web' => 'v6', + }}, + want_reqs_webv6 => 1, + want_updates => [['host']], + want_recap_changes => {host => { + 'atime' => $ddclient::now, + 'ipv6' => '2001:db8::1', + 'mtime' => $ddclient::now, + 'status-ipv6' => 'good', + }}, + }, + { + desc => 'legacy, fresh, usev6=webv6', + ipv6 => 1, + cfg => {host => { + 'protocol' => 'legacy', + 'usev6' => 'webv6', + }}, + want_reqs_webv6 => 1, + want_updates => [['host']], + want_recap_changes => {host => { + 'atime' => $ddclient::now, + 'ipv6' => '2001:db8::1', + 'mtime' => $ddclient::now, + 'status-ipv6' => 'good', + }}, + }, + { + desc => 'legacy, fresh, usev4=webv4 usev6=webv6', + ipv6 => 1, + cfg => {host => { + 'protocol' => 'legacy', + 'usev4' => 'webv4', + 'usev6' => 'webv6', + }}, + want_reqs_webv4 => 1, + want_reqs_webv6 => 1, + want_updates => [['host']], + want_recap_changes => {host => { + 'atime' => $ddclient::now, + 'ipv4' => '192.0.2.1', + 'mtime' => $ddclient::now, + 'status-ipv4' => 'good', + }}, + }, + map({ + my %cfg = %{delete($_->{cfg})}; + my $desc = join(' ', map("$_=$cfg{$_}", keys(%cfg))); + { + desc => "legacy, no change, not yet time, $desc", + recap => {host => { + 'atime' => $ddclient::now - ddclient::opt('min-interval'), + 'ipv4' => '192.0.2.1', + 'mtime' => $ddclient::now - ddclient::opt('min-interval'), + 'status-ipv4' => 'good', + }}, + cfg => {host => { + 'protocol' => 'legacy', + %cfg, + }}, + want_reqs_webv4 => 1, + %$_, + }; + } {cfg => {use => 'web'}}, {cfg => {usev4 => 'webv4'}}), + map({ + my %cfg = %{delete($_->{cfg})}; + my $desc = join(' ', map("$_=$cfg{$_}", keys(%cfg))); + { + desc => "legacy, min-interval elapsed but no change, $desc", + recap => {host => { + 'atime' => $ddclient::now - ddclient::opt('min-interval') - 1, + 'ipv4' => '192.0.2.1', + 'mtime' => $ddclient::now - ddclient::opt('min-interval') - 1, + 'status-ipv4' => 'good', + }}, + cfg => {host => { + 'protocol' => 'legacy', + %cfg, + }}, + want_reqs_webv4 => 1, + %$_, + }; + } {cfg => {use => 'web'}}, {cfg => {usev4 => 'webv4'}}), + map({ + my %cfg = %{delete($_->{cfg})}; + my $desc = join(' ', map("$_=$cfg{$_}", keys(%cfg))); + { + desc => "legacy, needs update, not yet time, $desc", + recap => {host => { + 'atime' => $ddclient::now - ddclient::opt('min-interval'), + 'ipv4' => '192.0.2.2', + 'mtime' => $ddclient::now - ddclient::opt('min-interval'), + 'status-ipv4' => 'good', + }}, + cfg => {host => { + 'protocol' => 'legacy', + %cfg, + }}, + want_reqs_webv4 => 1, + want_recap_changes => {host => { + 'warned-min-interval' => $ddclient::now, + }}, + %$_, + }; + } {cfg => {use => 'web'}}, {cfg => {usev4 => 'webv4'}}), + map({ + my %cfg = %{delete($_->{cfg})}; + my $desc = join(' ', map("$_=$cfg{$_}", keys(%cfg))); + { + desc => "legacy, min-interval elapsed, needs update, $desc", + recap => {host => { + 'atime' => $ddclient::now - ddclient::opt('min-interval') - 1, + 'ipv4' => '192.0.2.2', + 'mtime' => $ddclient::now - ddclient::opt('min-interval') - 1, + 'status-ipv4' => 'good', + }}, + cfg => {host => { + 'protocol' => 'legacy', + %cfg, + }}, + want_reqs_webv4 => 1, + want_updates => [['host']], + want_recap_changes => {host => { + 'atime' => $ddclient::now, + 'ipv4' => '192.0.2.1', + 'mtime' => $ddclient::now, + }}, + %$_, + }; + } {cfg => {use => 'web'}}, {cfg => {usev4 => 'webv4'}}), + map({ + my %cfg = %{delete($_->{cfg})}; + my $desc = join(' ', map("$_=$cfg{$_}", keys(%cfg))); + { + desc => "legacy, previous failed update, not yet time to retry, $desc", + recap => {host => { + 'atime' => $ddclient::now - ddclient::opt('min-error-interval'), + 'ipv4' => '192.0.2.2', + 'mtime' => $ddclient::now - max(ddclient::opt('min-error-interval'), + ddclient::opt('min-interval')) - 1, + 'status-ipv4' => 'failed', + }}, + cfg => {host => { + 'protocol' => 'legacy', + %cfg, + }}, + want_reqs_webv4 => 1, + want_recap_changes => {host => { + 'warned-min-error-interval' => $ddclient::now, + }}, + %$_, + }; + } {cfg => {use => 'web'}}, {cfg => {usev4 => 'webv4'}}), + map({ + my %cfg = %{delete($_->{cfg})}; + my $desc = join(' ', map("$_=$cfg{$_}", keys(%cfg))); + { + desc => "legacy, previous failed update, time to retry, $desc", + recap => {host => { + 'atime' => $ddclient::now - ddclient::opt('min-error-interval') - 1, + 'ipv4' => '192.0.2.2', + 'mtime' => $ddclient::now - ddclient::opt('min-error-interval') - 2, + 'status-ipv4' => 'failed', + }}, + cfg => {host => { + 'protocol' => 'legacy', + %cfg, + }}, + want_reqs_webv4 => 1, + want_updates => [['host']], + want_recap_changes => {host => { + 'atime' => $ddclient::now, + 'ipv4' => '192.0.2.1', + 'mtime' => $ddclient::now, + 'status-ipv4' => 'good', + }}, + %$_, + }; + } {cfg => {use => 'web'}}, {cfg => {usev4 => 'webv4'}}), + map({ + my %cfg = %{delete($_->{cfg})}; + my $desc = join(' ', map("$_=$cfg{$_}", sort(keys(%cfg)))); + { + desc => "deduplicates identical IP discovery, $desc", + cfg => { + hosta => {protocol => 'legacy', %cfg}, + hostb => {protocol => 'legacy', %cfg}, + }, + want_reqs_webv4 => 1, + want_updates => [['hosta', 'hostb']], + want_recap_changes => { + hosta => { + 'atime' => $ddclient::now, + 'ipv4' => '192.0.2.1', + 'mtime' => $ddclient::now, + 'status-ipv4' => 'good', + }, + hostb => { + 'atime' => $ddclient::now, + 'ipv4' => '192.0.2.1', + 'mtime' => $ddclient::now, + 'status-ipv4' => 'good', + }, + }, + %$_, + }; + } {cfg => {use => 'web'}}, {cfg => {usev4 => 'webv4'}}), + { + desc => "deduplicates identical IP discovery, usev6=webv6", + ipv6 => 1, + cfg => { + hosta => {protocol => 'legacy', usev6 => 'webv6'}, + hostb => {protocol => 'legacy', usev6 => 'webv6'}, + }, + want_reqs_webv6 => 1, + want_updates => [['hosta', 'hostb']], + want_recap_changes => { + hosta => { + 'atime' => $ddclient::now, + 'ipv6' => '2001:db8::1', + 'mtime' => $ddclient::now, + 'status-ipv6' => 'good', + }, + hostb => { + 'atime' => $ddclient::now, + 'ipv6' => '2001:db8::1', + 'mtime' => $ddclient::now, + 'status-ipv6' => 'good', + }, + }, + }, +); + +for my $tc (@test_cases) { + SKIP: { + skip("IPv6 not supported on this system", 1) if $tc->{ipv6} && !$ipv6_supported; + skip("HTTP::Daemon too old for IPv6 support", 1) if $tc->{ipv6} && !$httpd_ipv6_supported; + subtest($tc->{desc} => sub { + local $ddclient::_l = ddclient::pushlogctx($tc->{desc}); + for my $ipv ('4', '6') { + $tc->{"want_reqs_webv$ipv"} //= 0; + my $want = $tc->{"want_reqs_webv$ipv"}; + next if !defined(httpd($ipv)) && $want == 0; + local $ddclient::_l = ddclient::pushlogctx("IPv$ipv"); + my $ip = $ipv eq '4' ? '192.0.2.1' : '2001:db8::1'; + httpd($ipv)->reset(([200, $textplain, [$ip]]) x $want); + } + $tc->{recap}{$_}{host} //= $_ for keys(%{$tc->{recap} // {}}); + # Deep copy `%{$tc->{recap}}` so that updates to `%ddclient::recap` don't mutate it. + local %ddclient::recap = %{mergecfg($tc->{recap})}; + my $cachef = File::Temp->new(); + # $cachef is an object that stringifies to a filename. + local $ddclient::globals{cache} = "$cachef"; + $tc->{cfg} = {map({ + ($_ => { + host => $_, + web => 'v4', + webv4 => 'v4', + webv6 => 'v6', + %{$tc->{cfg}{$_}}, + }); + } keys(%{$tc->{cfg} // {}}))}; + # Deep copy `%{$tc->{cfg}}` so that updates to `%ddclient::config` don't mutate it. + local %ddclient::config = %{mergecfg($tc->{cfg})}; + local @updates; + + ddclient::update_nics(); + + for my $ipv ('4', '6') { + next if !defined(httpd($ipv)); + local $ddclient::_l = ddclient::pushlogctx("IPv$ipv"); + my @gotreqs = httpd($ipv)->reset(); + my $got = @gotreqs; + my $want = $tc->{"want_reqs_webv$ipv"}; + is($got, $want, "number of requests to webv$ipv service"); + } + TODO: { + local $TODO = $tc->{want_updates_TODO}; + is_deeply(\@updates, $tc->{want_updates} // [], 'got expected updates') + or diag(ddclient::repr(Values => [\@updates, $tc->{want_updates}], + Names => ['*got', '*want'])); + } + my %want_recap = %{mergecfg($tc->{recap}, $tc->{want_recap_changes})}; + TODO: { + local $TODO = $tc->{want_recap_changes_TODO}; + is_deeply(\%ddclient::recap, \%want_recap, 'recap matches') + or diag(ddclient::repr(Values => [\%ddclient::recap, \%want_recap], + Names => ['*got', '*want'])); + } + my %want_cfg = %{mergecfg($tc->{cfg}, $tc->{want_cfg_changes})}; + TODO: { + local $TODO = $tc->{want_cfg_changes_TODO}; + is_deeply(\%ddclient::config, \%want_cfg, 'config matches') + or diag(ddclient::repr(Values => [\%ddclient::config, \%want_cfg], + Names => ['*got', '*want'])); + } + }); + } +} + +done_testing(); diff --git a/t/use_cmd.pl b/t/use_cmd.pl new file mode 100644 index 000000000..1391da9b4 --- /dev/null +++ b/t/use_cmd.pl @@ -0,0 +1,41 @@ +use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } + +local $ddclient::globals{debug} = 1; +local $ddclient::globals{verbose} = 1; + +my @test_cases; +for my $ipv ('4', '6') { + my $ip = $ipv eq '4' ? '192.0.2.1' : '2001:db8::1'; + for my $use ('use', "usev$ipv") { + my @cmds = (); + push(@cmds, 'cmd') if $use eq 'use' || $ipv eq '6'; + push(@cmds, "cmdv$ipv") if $use ne 'use'; + for my $cmd (@cmds) { + my $cmdarg = "echo '$ip'"; + push( + @test_cases, + { + desc => "$use=$cmd $cmd=\"$cmdarg\"", + cfg => {$use => $cmd, $cmd => $cmdarg}, + want => $ip, + }, + ); + } + } +} + +for my $tc (@test_cases) { + local $ddclient::_l = ddclient::pushlogctx($tc->{desc}); + my $h = 'test-host'; + local $ddclient::config{$h} = $tc->{cfg}; + is(ddclient::get_ip(ddclient::strategy_inputs('use', $h)), $tc->{want}, $tc->{desc}) + if $tc->{cfg}{use}; + is(ddclient::get_ipv4(ddclient::strategy_inputs('usev4', $h)), $tc->{want}, $tc->{desc}) + if $tc->{cfg}{usev4}; + is(ddclient::get_ipv6(ddclient::strategy_inputs('usev6', $h)), $tc->{want}, $tc->{desc}) + if $tc->{cfg}{usev6}; +} + +done_testing(); diff --git a/t/use_web.pl b/t/use_web.pl new file mode 100644 index 000000000..130034a55 --- /dev/null +++ b/t/use_web.pl @@ -0,0 +1,87 @@ +use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +use ddclient::t::HTTPD; +use ddclient::t::ip; + +httpd_required(); + +my $builtinweb = 't/use_web.pl builtinweb'; +my $h = 't/use_web.pl hostname'; + +my $headers = [ + @$textplain, + 'this-ipv4-should-be-ignored' => 'skip skip2 192.0.2.255', + 'this-ipv6-should-be-ignored' => 'skip skip2 2001:db8::ff', +]; +httpd('4')->run(sub { return [200, $headers, ['192.0.2.1 skip 192.0.2.2 skip2 192.0.2.3']]; }); +httpd('6')->run(sub { return [200, $headers, ['2001:db8::1 skip 2001:db8::2 skip2 2001:db8::3']]; }) + if httpd('6'); +my %ep = ( + '4' => httpd('4')->endpoint(), + '6' => httpd('6') ? httpd('6')->endpoint() : undef, +); + +my @test_cases; +for my $ipv ('4', '6') { + my $ipv4 = $ipv eq '4'; + for my $sfx ('', "v$ipv") { + push( + @test_cases, + { + desc => "use$sfx=web$sfx web$sfx= IPv$ipv", + ipv6 => !$ipv4, + cfg => {"use$sfx" => "web$sfx", "web$sfx" => $ep{$ipv}}, + want => $ipv4 ? '192.0.2.1' : '2001:db8::1', + }, + { + desc => "use$sfx=web$sfx web$sfx= web$sfx-skip=skip IPv$ipv", + ipv6 => !$ipv4, + cfg => {"use$sfx" => "web$sfx", "web$sfx" => $ep{$ipv}, "web$sfx-skip" => 'skip'}, + # Note that "skip" should skip past the first "skip" and not past "skip2". + want => $ipv4 ? '192.0.2.2' : '2001:db8::2', + }, + { + desc => "use$sfx=web$sfx web$sfx= IPv$ipv", + ipv6 => !$ipv4, + cfg => {"use$sfx" => "web$sfx", "web$sfx" => $builtinweb}, + biw => {url => $ep{$ipv}}, + want => $ipv4 ? '192.0.2.1' : '2001:db8::1', + }, + { + desc => "use$sfx=web$sfx web$sfx= IPv$ipv", + ipv6 => !$ipv4, + cfg => {"use$sfx" => "web$sfx", "web$sfx" => $builtinweb}, + biw => {url => $ep{$ipv}, skip => 'skip'}, + # Note that "skip" should skip past the first "skip" and not past "skip2". + want => $ipv4 ? '192.0.2.2' : '2001:db8::2', + }, + { + desc => "use$sfx=web$sfx web$sfx= web$sfx-skip=skip2 IPv$ipv", + ipv6 => !$ipv4, + cfg => {"use$sfx" => "web$sfx", "web$sfx" => $builtinweb, "web$sfx-skip" => 'skip2'}, + biw => {url => $ep{$ipv}, skip => 'skip'}, + want => $ipv4 ? '192.0.2.3' : '2001:db8::3', + }, + ); + } +} + +for my $tc (@test_cases) { + local $ddclient::builtinweb{$builtinweb} = $tc->{biw}; + $ddclient::builtinweb if 0; + local $ddclient::config{$h} = $tc->{cfg}; + $ddclient::config if 0; + SKIP: { + skip("IPv6 not supported on this system", 1) if $tc->{ipv6} && !$ipv6_supported; + skip("HTTP::Daemon too old for IPv6 support", 1) if $tc->{ipv6} && !$httpd_ipv6_supported; + is(ddclient::get_ip(ddclient::strategy_inputs('use', $h)), $tc->{want}, $tc->{desc}) + if $tc->{cfg}{use}; + is(ddclient::get_ipv4(ddclient::strategy_inputs('usev4', $h)), $tc->{want}, $tc->{desc}) + if $tc->{cfg}{usev4}; + is(ddclient::get_ipv6(ddclient::strategy_inputs('usev6', $h)), $tc->{want}, $tc->{desc}) + if $tc->{cfg}{usev6}; + } +} + +done_testing(); diff --git a/t/variable_defaults.pl b/t/variable_defaults.pl new file mode 100644 index 000000000..8f2495d58 --- /dev/null +++ b/t/variable_defaults.pl @@ -0,0 +1,100 @@ +use Test::More; +BEGIN { SKIP: { eval { require Test::Warnings; 1; } or skip($@, 1); } } +BEGIN { eval { require 'ddclient'; } or BAIL_OUT($@); } +use re qw(is_regexp); + +my %variable_collections = ( + map({ ($_ => $ddclient::cfgvars{$_}) } grep($_ ne 'merged', keys(%ddclient::cfgvars))), + map({ ("protocol=$_" => $ddclient::protocols{$_}{cfgvars}); } keys(%ddclient::protocols)), +); +my %seen; +my @test_cases = ( + map({ + my $vcn = $_; + my $vc = $variable_collections{$_}; + map({ + my $def = $vc->{$_}; + my $seen = exists($seen{$def}); + $seen{$def} = undef; + ({desc => "$vcn $_", def => $vc->{$_}}) x !$seen; + } sort(keys(%$vc))); + } sort(keys(%variable_collections))), +); +for my $tc (@test_cases) { + if ($tc->{def}{required}) { + is($tc->{def}{default}, undef, "'$tc->{desc}' (required) has no default"); + } else { + # Preserve all existing variables in $cfgvars{merged} so that variables with dynamic + # defaults can reference them. + local %ddclient::cfgvars = (merged => { + %{$ddclient::cfgvars{merged}}, + 'var for test' => $tc->{def}, + }); + # Variables with dynamic defaults will need their own unit tests, but we can still check the + # clean-slate hostless default. + local %ddclient::config; + local %ddclient::opt; + local %ddclient::globals; + my $norm; + my $default = ddclient::default('var for test'); + diag("'$tc->{desc}' default: " . ($default // '')); + is($default, $tc->{def}{default}, "'$tc->{desc}' default() return value matches default") + if ref($tc->{def}{default}) ne 'CODE'; + my $valid = eval { $norm = ddclient::check_value($default, $tc->{def}); 1; } or diag($@); + ok($valid, "'$tc->{desc}' (optional) has a valid default"); + is($norm, $default, "'$tc->{desc}' default normalizes to itself") if $valid; + } +} + +my @use_test_cases = ( + { + desc => 'clean slate hostless default', + want => 'ip', + }, + { + desc => 'usage string', + host => '', + want => qr/disabled.*ip|ip.*disabled/, + }, + { + desc => 'usev4 disables use by default', + host => 'host', + cfg => {usev4 => 'webv4'}, + want => 'disabled', + }, + { + desc => 'usev6 disables use by default', + host => 'host', + cfg => {usev4 => 'webv4'}, + want => 'disabled', + }, + { + desc => 'explicitly setting use re-enables it', + host => 'host', + cfg => {use => 'web', usev4 => 'webv4'}, + want => 'web', + }, +); +for my $tc (@use_test_cases) { + my $desc = "'use' dynamic default: $tc->{desc}"; + local %ddclient::protocols = (protocol => ddclient::Protocol->new()); + local %ddclient::cfgvars = (merged => { + 'protocol' => $ddclient::cfgvars{'merged'}{'protocol'}, + 'use' => $ddclient::cfgvars{'protocol-common-defaults'}{'use'}, + 'usev4' => $ddclient::cfgvars{'merged'}{'usev4'}, + 'usev6' => $ddclient::cfgvars{'merged'}{'usev6'}, + }); + local %ddclient::config = (host => {protocol => 'protocol', %{$tc->{cfg} // {}}}); + local %ddclient::opt; + local %ddclient::globals; + + my $got = ddclient::opt('use', $tc->{host}); + + if (is_regexp($tc->{want})) { + like($got, $tc->{want}, $desc); + } else { + is($got, $tc->{want}, $desc); + } +} + +done_testing(); diff --git a/t/version.pl.in b/t/version.pl.in index 42b1bb07e..3b3c9f71b 100644 --- a/t/version.pl.in +++ b/t/version.pl.in @@ -4,6 +4,59 @@ use version; SKIP: { eval { require Test::Warnings; } or skip($@, 1); } eval { require 'ddclient'; } or BAIL_OUT($@); -is(ddclient->VERSION(), version->parse('v@PACKAGE_VERSION@'), "version matches Autoconf config"); +ok(ddclient::parse_version($ddclient::VERSION), + "module's Perl version string is in opinionated form"); + +my $n = qr/0|[1-9]\d{0,2}/; +like($ddclient::version, qr/^$n\.$n\.$n(?:-alpha|-beta\.$n|-rc\.$n|\+r\.$n)?$/, + "human-readable version is in opinionated form"); + +my @tcs = ( + ['v1.0_0', '1-alpha'], + ['v1.0.0_0', '1.0-alpha'], + ['v1.2.3.0_0', '1.2.3-alpha'], + ['v1.2.3.4.0_0', '1.2.3.4-alpha'], + ['v1.0_1', '1-beta.1'], + ['v1.0.0_1', '1.0-beta.1'], + ['v1.2.3.0_1', '1.2.3-beta.1'], + ['v1.2.3.4.0_1', '1.2.3.4-beta.1'], + ['v1.2.3.0_899', '1.2.3-beta.899'], + ['v1.0_901', '1-rc.1'], + ['v1.0.0_901', '1.0-rc.1'], + ['v1.2.3.0_901', '1.2.3-rc.1'], + ['v1.2.3.4.0_901', '1.2.3.4-rc.1'], + ['v1.2.3.0_998', '1.2.3-rc.98'], + ['v1.999', '1'], + ['v1.0.999', '1.0'], + ['v1.2.3.999', '1.2.3'], + ['v1.2.3.4.999', '1.2.3.4'], + ['v1.999.1', '1+r.1'], + ['v1.0.999.1', '1.0+r.1'], + ['v1.2.3.999.1', '1.2.3+r.1'], + ['v1.2.3.4.999.1', '1.2.3.4+r.1'], + ['v1.2.3.999.999', '1.2.3+r.999'], + [$ddclient::VERSION, $ddclient::version], +); + +subtest 'humanize_version' => sub { + for my $tc (@tcs) { + my ($pv, $want) = @$tc; + is(ddclient::humanize_version($pv), $want, "$pv -> $want"); + } +}; + +subtest 'human-readable version can be translated back to Perl version' => sub { + for my $tc (@tcs) { + my ($want, $hv) = @$tc; + my $pv = "v$hv"; + $pv =~ s/^(?!.*-)(.*?)(?:\+r\.(\d+))?$/"$1.999" . (defined($2) ? ".$2" : "")/e; + $pv =~ s/-alpha$/.0_0/; + $pv =~ s/-beta\.(\d+)$/.0_$1/; + $pv =~ s/-rc\.(\d+)$/'.0_' . (900 + $1)/e; + is($pv, $want, "$hv -> $want"); + } +}; + +is($ddclient::version, '@PACKAGE_VERSION@', "version matches version in Autoconf"); done_testing(); diff --git a/t/write_cache.pl b/t/write_recap.pl similarity index 97% rename from t/write_cache.pl rename to t/write_recap.pl index 94e959ba6..9f9c66158 100644 --- a/t/write_cache.pl +++ b/t/write_recap.pl @@ -35,7 +35,7 @@ sub tc { for my $tc (@test_cases) { $warning = undef; - ddclient::write_cache($tc->{f}); + ddclient::write_recap($tc->{f}); subtest $tc->{name} => sub { if (defined($tc->{warning_regex})) { like($warning, $tc->{warning_regex}, "expected warning message");