1#!/usr/local/bin/perl -w 2###################################################################### 3# 4# DDCLIENT - a Perl client for updating DynDNS information 5# 6# Author: Paul Burry (paul+ddclient@burry.ca) 7# ddclient-developers: see https://sourceforge.net/project/memberlist.php?group_id=116817 8# 9# website: http://ddclient.sf.net 10# 11# Support for multiple IP numbers added by 12# Astaro AG, Ingo Schwarze <ischwarze-OOs/4mkCeqbQT0dZR+AlfA@public.gmane.org> September 16, 2008 13# 14# Support for multiple domain support for Namecheap by Robert Ian Hawdon 2010-09-03: https://robertianhawdon.me.uk/ 15# 16# Initial Cloudflare support by Ian Pye, updated by Robert Ian Hawdon 2012-07-16 17# Further updates by Peter Roberts to support the new API 2013-09-26, 2014-06-22: http://blog.peter-r.co.uk/ 18# 19# 20###################################################################### 21require 5.004; 22use strict; 23use Getopt::Long; 24use Sys::Hostname; 25use IO::Socket; 26use Data::Validate::IP; 27use POSIX 'setsid'; 28 29my $version = "3.9.1"; 30my $programd = $0; 31$programd =~ s%^.*/%%; 32my $program = $programd; 33$program =~ s/d$//; 34my $now = time; 35my $hostname = hostname(); 36my $etc = ($program =~ /test/i) ? './' : '/usr/local/etc/'; 37my $cachedir = ($program =~ /test/i) ? './' : '/var/tmp/'; 38my $savedir = ($program =~ /test/i) ? 'URL/' : '/var/tmp/'; 39my $msgs = ''; 40my $last_msgs = ''; 41 42use vars qw($file $lineno); 43local $file = ''; 44local $lineno = ''; 45 46$ENV{'PATH'} = (exists($ENV{PATH}) ? "$ENV{PATH}:" : "") . "/sbin:/usr/local/sbin:/bin:"; 47 48sub T_ANY {'any'}; 49sub T_STRING {'string'}; 50sub T_EMAIL {'e-mail address'}; 51sub T_NUMBER {'number'}; 52sub T_DELAY {'time delay (ie. 1d, 1hour, 1m)'}; 53sub T_LOGIN {'login'}; 54sub T_PASSWD {'password'}; 55sub T_BOOL {'boolean value'}; 56sub T_FQDN {'fully qualified host name'}; 57sub T_OFQDN {'optional fully qualified host name'}; 58sub T_FILE {'file name'}; 59sub T_FQDNP {'fully qualified host name and optional port number'}; 60sub T_PROTO {'protocol'} 61sub T_USE {'ip strategy'} 62sub T_IF {'interface'} 63sub T_PROG {'program name'} 64sub T_IP {'ip'} 65sub T_POSTS {'postscript'}; 66 67## strategies for obtaining an ip address. 68my %builtinweb = ( 69 'dyndns' => { 'url' => 'http://checkip.dyndns.org/', 'skip' => 70 'Current IP Address:', }, 71 'dnspark' => { 'url' => 'http://ipdetect.dnspark.com/', 'skip' => 'Current Address:', }, 72 'loopia' => { 'url' => 'http://dns.loopia.se/checkip/checkip.php', 'skip' => 'Current IP Address:', }, 73); 74my %builtinfw = ( 75 'watchguard-soho' => { 76 'name' => 'Watchguard SOHO FW', 77 'url' => '/pubnet.htm', 78 'skip' => 'NAME=IPAddress VALUE=', 79 }, 80 'netopia-r910' => { 81 'name' => 'Netopia R910 FW', 82 'url' => '/WanEvtLog', 83 'skip' => 'local:', 84 }, 85 'smc-barricade' => { 86 'name' => 'SMC Barricade FW', 87 'url' => '/status.htm', 88 'skip' => 'IP Address', 89 }, 90 'smc-barricade-alt' => { 91 'name' => 'SMC Barricade FW (alternate config)', 92 'url' => '/status.HTM', 93 'skip' => 'WAN IP', 94 }, 95 'smc-barricade-7401bra' => { 96 'name' => 'SMC Barricade 7401BRA FW', 97 'url' => '/admin/wan1.htm', 98 'skip' => 'IP Address', 99 }, 100 'netgear-rt3xx' => { 101 'name' => 'Netgear FW', 102 'url' => '/mtenSysStatus.html', 103 'skip' => 'IP Address', 104 }, 105 'elsa-lancom-dsl10' => { 106 'name' => 'ELSA LanCom DSL/10 DSL FW', 107 'url' => '/config/1/6/8/3/', 108 'skip' => 'IP.Address', 109 }, 110 'elsa-lancom-dsl10-ch01' => { 111 'name' => 'ELSA LanCom DSL/10 DSL FW (isdn ch01)', 112 'url' => '/config/1/6/8/3/', 113 'skip' => 'IP.Address.*?CH01', 114 }, 115 'elsa-lancom-dsl10-ch02' => { 116 'name' => 'ELSA LanCom DSL/10 DSL FW (isdn ch01)', 117 'url' => '/config/1/6/8/3/', 118 'skip' => 'IP.Address.*?CH02', 119 }, 120 'linksys' => { 121 'name' => 'Linksys FW', 122 'url' => '/Status.htm', 123 'skip' => 'WAN.*?Address', 124 }, 125 'linksys-ver2' => { 126 'name' => 'Linksys FW version 2', 127 'url' => '/RouterStatus.htm', 128 'skip' => 'WAN.*?Address', 129 }, 130 'linksys-ver3' => { 131 'name' => 'Linksys FW version 3', 132 'url' => '/Status_Router.htm', 133 'skip' => 'WAN.*?Address', 134 }, 135 'linksys-wrt854g' => { 136 'name' => 'Linksys WRT854G FW', 137 'url' => '/Status_Router.asp', 138 'skip' => 'IP Address:', 139 }, 140 'maxgate-ugate3x00' => { 141 'name' => 'MaxGate UGATE-3x00 FW', 142 'url' => '/Status.htm', 143 'skip' => 'WAN.*?IP Address', 144 }, 145 'netcomm-nb3' => { 146 'name' => 'NetComm NB3', 147 'url' => '/MainPage?id=6', 148 'skip' => 'ppp-0', 149 }, 150 '3com-3c886a' => { 151 'name' => '3com 3c886a 56k Lan Modem', 152 'url' => '/stat3.htm', 153 'skip' => 'IP address in use', 154 }, 155 'sohoware-nbg800' => { 156 'name' => 'SOHOWare BroadGuard NBG800', 157 'url' => '/status.htm', 158 'skip' => 'Internet IP', 159 }, 160 'xsense-aero' => { 161 'name' => 'Xsense Aero', 162 'url' => '/A_SysInfo.htm', 163 'skip' => 'WAN.*?IP Address', 164 }, 165 'alcatel-stp' => { 166 'name' => 'Alcatel Speed Touch Pro', 167 'url' => '/cgi/router/', 168 'skip' => 'Brt', 169 }, 170 'alcatel-510' => { 171 'name' => 'Alcatel Speed Touch 510', 172 'url' => '/cgi/ip/', 173 'skip' => 'ppp', 174 }, 175 'allnet-1298' => { 176 'name' => 'Allnet 1298', 177 'url' => '/cgi/router/', 178 'skip' => 'WAN', 179 }, 180 '3com-oc-remote812' => { 181 'name' => '3com OfficeConnect Remote 812', 182 'url' => '/callEvent', 183 'skip' => '.*LOCAL', 184 }, 185 'e-tech' => { 186 'name' => 'E-tech Router', 187 'url' => '/Status.htm', 188 'skip' => 'Public IP Address', 189 }, 190 'cayman-3220h' => { 191 'name' => 'Cayman 3220-H DSL', 192 'url' => '/shell/show+ip+interfaces', 193 'skip' => '.*inet', 194 }, 195 'vigor-2200usb' => { 196 'name' => 'Vigor 2200 USB', 197 'url' => '/doc/online.sht', 198 'skip' => 'PPPoA', 199 }, 200 'dlink-614' => { 201 'name' => 'D-Link DI-614+', 202 'url' => '/st_devic.html', 203 'skip' => 'WAN', 204 }, 205 'dlink-604' => { 206 'name' => 'D-Link DI-604', 207 'url' => '/st_devic.html', 208 'skip' => 'WAN.*?IP.*Address', 209 }, 210 'olitec-SX200' => { 211 'name' => 'olitec-SX200', 212 'url' => '/doc/wan.htm', 213 'skip' => 'st_wan_ip[0] = "', 214 }, 215 'westell-6100' => { 216 'name' => 'Westell C90-610015-06 DSL Router', 217 'url' => '/advstat.htm', 218 'skip' => 'IP.+?Address', 219 }, 220 '2wire' => { 221 'name' => '2Wire 1701HG Gateway', 222 'url' => '/xslt?PAGE=B01', 223 'skip' => 'Internet Address:', 224 }, 225 'linksys-rv042-wan1' => { 226 'name' => 'Linksys RV042 Dual Homed Router WAN Port 2', 227 'url' => '/home.htm', 228 'skip' => 'WAN1 IP', 229 }, 230 'linksys-rv042-wan2' => { 231 'name' => 'Linksys RV042 Dual Homed Router WAN Port 2', 232 'url' => '/home.htm', 233 'skip' => 'WAN2 IP', 234 }, 235 'netgear-rp614' => { 236 'name' => 'Netgear RP614 FW', 237 'url' => '/sysstatus.html', 238 'skip' => 'IP Address', 239 }, 240 'watchguard-edge-x' => { 241 'name' => 'Watchguard Edge X FW', 242 'url' => '/netstat.htm', 243 'skip' => 'inet addr:', 244 }, 245 'dlink-524' => { 246 'name' => 'D-Link DI-524', 247 'url' => '/st_device.html', 248 'skip' => 'WAN.*?Addres', 249 }, 250 'rtp300' => { 251 'name' => 'Linksys RTP300', 252 'url' => '/cgi-bin/webcm?getpage=%2Fusr%2Fwww_safe%2Fhtml%2Fstatus%2FRouter.html', 253 'skip' => 'Internet.*?IP Address', 254 }, 255 'netgear-wpn824' => { 256 'name' => 'Netgear WPN824 FW', 257 'url' => '/RST_status.htm', 258 'skip' => 'IP Address', 259 }, 260 'linksys-wcg200' => { 261 'name' => 'Linksys WCG200 FW', 262 'url' => '/RgStatus.asp', 263 'skip' => 'WAN.IP.*?Address', 264 }, 265 'netgear-dg834g' => { 266 'name' => 'netgear-dg834g', 267 'url' => '/setup.cgi?next_file=s_status.htm&todo=cfg_init', 268 'skip' => '', 269 }, 270 'netgear-wgt624' => { 271 'name' => 'Netgear WGT624', 272 'url' => '/RST_st_dhcp.htm', 273 'skip' => 'IP Address</B></td><TD NOWRAP width="50%">', 274 }, 275 'sveasoft' => { 276 'name' => 'Sveasoft WRT54G/WRT54GS', 277 'url' => '/Status_Router.asp', 278 'skip' => 'var wan_ip', 279 }, 280 'smc-barricade-7004vbr' => { 281 'name' => 'SMC Barricade FW (7004VBR model config)', 282 'url' => '/status_main.stm', 283 'skip' => 'var wan_ip=', 284 }, 285 'sitecom-dc202' => { 286 'name' => 'Sitecom DC-202 FW', 287 'url' => '/status.htm', 288 'skip' => 'Internet IP Address', 289 }, 290); 291my %ip_strategies = ( 292 'ip' => ": obtain IP from -ip {address}", 293 'web' => ": obtain IP from an IP discovery page on the web", 294 'fw' => ": obtain IP from the firewall specified by -fw {type|address}", 295 'if' => ": obtain IP from the -if {interface}", 296 'cmd' => ": obtain IP from the -cmd {external-command}", 297 'cisco' => ": obtain IP from Cisco FW at the -fw {address}", 298 'cisco-asa' => ": obtain IP from Cisco ASA at the -fw {address}", 299 map { $_ => sprintf ": obtain IP from %s at the -fw {address}", $builtinfw{$_}->{'name'} } keys %builtinfw, 300); 301sub ip_strategies_usage { 302 return map { sprintf(" -use=%-22s %s.", $_, $ip_strategies{$_}) } sort keys %ip_strategies; 303} 304 305my %web_strategies = ( 306 'dyndns'=> 1, 307 'dnspark'=> 1, 308 'loopia'=> 1, 309); 310 311sub setv { 312 return { 313 'type' => shift, 314 'required' => shift, 315 'cache' => shift, 316 'config' => shift, 317 'default' => shift, 318 'minimum' => shift, 319 }; 320}; 321my %variables = ( 322 'global-defaults' => { 323 'daemon' => setv(T_DELAY, 0, 0, 1, 0, interval('60s')), 324 'foreground' => setv(T_BOOL, 0, 0, 1, 0, undef), 325 'file' => setv(T_FILE, 0, 0, 1, "$etc$program.conf", undef), 326 'cache' => setv(T_FILE, 0, 0, 1, "$cachedir$program.cache", undef), 327 'pid' => setv(T_FILE, 0, 0, 1, "", undef), 328 'proxy' => setv(T_FQDNP, 0, 0, 1, '', undef), 329 'protocol' => setv(T_PROTO, 0, 0, 1, 'dyndns2', undef), 330 331 'use' => setv(T_USE, 0, 0, 1, 'ip', undef), 332 'ip' => setv(T_IP, 0, 0, 1, undef, undef), 333 'if' => setv(T_IF, 0, 0, 1, 'ppp0', undef), 334 'if-skip' => setv(T_STRING,1, 0, 1, '', undef), 335 'web' => setv(T_STRING,0, 0, 1, 'dyndns', undef), 336 'web-skip' => setv(T_STRING,1, 0, 1, '', undef), 337 'fw' => setv(T_ANY, 0, 0, 1, '', undef), 338 'fw-skip' => setv(T_STRING,1, 0, 1, '', undef), 339 'fw-banlocal' => setv(T_BOOL, 0, 0, 1, 0, undef), 340 'fw-login' => setv(T_LOGIN, 1, 0, 1, '', undef), 341 'fw-password' => setv(T_PASSWD,1, 0, 1, '', undef), 342 'cmd' => setv(T_PROG, 0, 0, 1, '', undef), 343 'cmd-skip' => setv(T_STRING,1, 0, 1, '', undef), 344 345 'timeout' => setv(T_DELAY, 0, 0, 1, interval('120s'), interval('120s')), 346 'retry' => setv(T_BOOL, 0, 0, 0, 0, undef), 347 'force' => setv(T_BOOL, 0, 0, 0, 0, undef), 348 'ssl' => setv(T_BOOL, 0, 0, 0, 0, undef), 349 'ipv6' => setv(T_BOOL, 0, 0, 0, 0, undef), 350 'syslog' => setv(T_BOOL, 0, 0, 1, 0, undef), 351 'facility' => setv(T_STRING,0, 0, 1, 'daemon', undef), 352 'priority' => setv(T_STRING,0, 0, 1, 'notice', undef), 353 'mail' => setv(T_EMAIL, 0, 0, 1, '', undef), 354 'mail-failure' => setv(T_EMAIL, 0, 0, 1, '', undef), 355 356 'exec' => setv(T_BOOL, 0, 0, 1, 1, undef), 357 'debug' => setv(T_BOOL, 0, 0, 1, 0, undef), 358 'verbose' => setv(T_BOOL, 0, 0, 1, 0, undef), 359 'quiet' => setv(T_BOOL, 0, 0, 1, 0, undef), 360 'help' => setv(T_BOOL, 0, 0, 1, 0, undef), 361 'test' => setv(T_BOOL, 0, 0, 1, 0, undef), 362 'geturl' => setv(T_STRING,0, 0, 0, '', undef), 363 364 'postscript' => setv(T_POSTS, 0, 0, 1, '', undef), 365 }, 366 'service-common-defaults' => { 367 'server' => setv(T_FQDNP, 1, 0, 1, 'members.dyndns.org', undef), 368 'login' => setv(T_LOGIN, 1, 0, 1, '', undef), 369 'password' => setv(T_PASSWD, 1, 0, 1, '', undef), 370 'host' => setv(T_STRING, 1, 1, 1, '', undef), 371 372 'use' => setv(T_USE, 0, 0, 1, 'ip', undef), 373 'if' => setv(T_IF, 0, 0, 1, 'ppp0', undef), 374 'if-skip' => setv(T_STRING,0, 0, 1, '', undef), 375 'web' => setv(T_STRING,0, 0, 1, 'dyndns', undef), 376 'web-skip' => setv(T_STRING,0, 0, 1, '', undef), 377 'fw' => setv(T_ANY, 0, 0, 1, '', undef), 378 'fw-skip' => setv(T_STRING,0, 0, 1, '', undef), 379 'fw-banlocal' => setv(T_BOOL, 0, 0, 1, 0, undef), 380 'fw-login' => setv(T_LOGIN, 0, 0, 1, '', undef), 381 'fw-password' => setv(T_PASSWD,0, 0, 1, '', undef), 382 'cmd' => setv(T_PROG, 0, 0, 1, '', undef), 383 'cmd-skip' => setv(T_STRING,0, 0, 1, '', undef), 384 'ipv6' => setv(T_BOOL, 0, 0, 0, 0, undef), 385 'ip' => setv(T_IP, 0, 1, 0, undef, undef), 386 'wtime' => setv(T_DELAY, 0, 1, 1, 0, interval('30s')), 387 'mtime' => setv(T_NUMBER, 0, 1, 0, 0, undef), 388 'atime' => setv(T_NUMBER, 0, 1, 0, 0, undef), 389 'status' => setv(T_ANY, 0, 1, 0, '', undef), 390 'min-interval' => setv(T_DELAY, 0, 0, 1, interval('30s'), 0), 391 'max-interval' => setv(T_DELAY, 0, 0, 1, interval('25d'), 0), 392 'min-error-interval' => setv(T_DELAY, 0, 0, 1, interval('5m'), 0), 393 394 'warned-min-interval' => setv(T_ANY, 0, 1, 0, 0, undef), 395 'warned-min-error-interval' => setv(T_ANY, 0, 1, 0, 0, undef), 396 }, 397 'dyndns-common-defaults' => { 398 'static' => setv(T_BOOL, 0, 1, 1, 0, undef), 399 'wildcard' => setv(T_BOOL, 0, 1, 1, 0, undef), 400 'mx' => setv(T_OFQDN, 0, 1, 1, '', undef), 401 'backupmx' => setv(T_BOOL, 0, 1, 1, 0, undef), 402 }, 403 'easydns-common-defaults' => { 404 'wildcard' => setv(T_BOOL, 0, 1, 1, 0, undef), 405 'mx' => setv(T_OFQDN, 0, 1, 1, '', undef), 406 'backupmx' => setv(T_BOOL, 0, 1, 1, 0, undef), 407 }, 408 'dnspark-common-defaults' => { 409 'mx' => setv(T_OFQDN, 0, 1, 1, '', undef), 410 'mxpri' => setv(T_NUMBER, 0, 0, 1, 5, undef), 411 }, 412 'noip-common-defaults' => { 413 'static' => setv(T_BOOL, 0, 1, 1, 0, undef), 414 }, 415 'noip-service-common-defaults' => { 416 'server' => setv(T_FQDNP, 1, 0, 1, 'dynupdate.no-ip.com', undef), 417 'login' => setv(T_LOGIN, 1, 0, 1, '', undef), 418 'password' => setv(T_PASSWD, 1, 0, 1, '', undef), 419 'host' => setv(T_STRING, 1, 1, 1, '', undef), 420 'ip' => setv(T_IP, 0, 1, 0, undef, undef), 421 'wtime' => setv(T_DELAY, 0, 1, 1, 0, interval('30s')), 422 'mtime' => setv(T_NUMBER, 0, 1, 0, 0, undef), 423 'atime' => setv(T_NUMBER, 0, 1, 0, 0, undef), 424 'status' => setv(T_ANY, 0, 1, 0, '', undef), 425 'min-interval' => setv(T_DELAY, 0, 0, 1, interval('30s'), 0), 426 'max-interval' => setv(T_DELAY, 0, 0, 1, interval('25d'), 0), 427 'min-error-interval' => setv(T_DELAY, 0, 0, 1, interval('5m'), 0), 428 'warned-min-interval' => setv(T_ANY, 0, 1, 0, 0, undef), 429 'warned-min-error-interval' => setv(T_ANY, 0, 1, 0, 0, undef), 430 }, 431 'zoneedit-service-common-defaults' => { 432 'zone' => setv(T_OFQDN, 0, 0, 1, undef, undef), 433 }, 434 'dtdns-common-defaults' => { 435 'login' => setv(T_LOGIN, 0, 0, 0, 'unused', undef), 436 'client' => setv(T_STRING, 0, 1, 1, $program, undef), 437 }, 438 'nsupdate-common-defaults' => { 439 'ttl' => setv(T_NUMBER, 0, 1, 0, 600, undef), 440 'zone' => setv(T_STRING, 1, 1, 1, '', undef), 441 'tcp' => setv(T_BOOL, 0, 1, 1, 0, undef), 442 }, 443 'cloudflare-common-defaults' => { 444 'server' => setv(T_FQDNP, 1, 0, 1, 'api.cloudflare.com/client/v4', undef), 445 'zone' => setv(T_FQDN, 1, 0, 1, '', undef), 446 'static' => setv(T_BOOL, 0, 1, 1, 0, undef), 447 'wildcard' => setv(T_BOOL, 0, 1, 1, 0, undef), 448 'mx' => setv(T_OFQDN, 0, 1, 1, '', undef), 449 'backupmx' => setv(T_BOOL, 0, 1, 1, 0, undef), 450 'ttl' => setv(T_NUMBER, 1, 0, 1, 1, undef), 451 }, 452 'googledomains-common-defaults' => { 453 'server' => setv(T_FQDNP, 1, 0, 1, 'domains.google.com', undef), 454 }, 455 'duckdns-common-defaults' => { 456 'server' => setv(T_FQDNP, 1, 0, 1, 'www.duckdns.org', undef), 457 'login' => setv(T_LOGIN, 0, 0, 0, 'unused', undef), 458 }, 459 'freemyip-common-defaults' => { 460 'server' => setv(T_FQDNP, 1, 0, 1, 'freemyip.com', undef), 461 'login' => setv(T_LOGIN, 0, 0, 0, 'unused', undef), 462 }, 463 'woima-common-defaults' => { 464 'static' => setv(T_BOOL, 0, 1, 1, 0, undef), 465 'wildcard' => setv(T_BOOL, 0, 1, 1, 0, undef), 466 'mx' => setv(T_OFQDN, 0, 1, 1, '', undef), 467 'backupmx' => setv(T_BOOL, 0, 1, 1, 0, undef), 468 'custom' => setv(T_BOOL, 0, 1, 1, 0, undef), 469 'script' => setv(T_STRING, 1, 1, 1, '/nic/update', undef), 470 }, 471 'woima-service-common-defaults' => { 472 'server' => setv(T_FQDNP, 1, 0, 1, 'dyn.woima.fi', undef), 473 'login' => setv(T_LOGIN, 1, 0, 1, '', undef), 474 'password' => setv(T_PASSWD, 1, 0, 1, '', undef), 475 'ip' => setv(T_IP, 0, 1, 0, undef, undef), 476 'wtime' => setv(T_DELAY, 0, 1, 1, 0, interval('30s')), 477 'mtime' => setv(T_NUMBER, 0, 1, 0, 0, undef), 478 'atime' => setv(T_NUMBER, 0, 1, 0, 0, undef), 479 'status' => setv(T_ANY, 0, 1, 0, '', undef), 480 'min-interval' => setv(T_DELAY, 0, 0, 1, interval('30s'), 0), 481 'max-interval' => setv(T_DELAY, 0, 0, 1, interval('25d'), 0), 482 'min-error-interval' => setv(T_DELAY, 0, 0, 1, interval('5m'), 0), 483 'warned-min-interval' => setv(T_ANY, 0, 1, 0, 0, undef), 484 'warned-min-error-interval' => setv(T_ANY, 0, 1, 0, 0, undef), 485 }, 486 'yandex-common-defaults' => { 487 'server' => setv(T_FQDNP, 1, 0, 1, 'pddimp.yandex.ru', undef), 488 }, 489 'dnsmadeeasy-common-defaults' => { 490 'server' => setv(T_FQDNP, 1, 0, 1, 'cp.dnsmadeeasy.com', undef), 491 'script' => setv(T_STRING, 1, 1, 1, '/servlet/updateip', undef), 492 }, 493 'dondominio-common-defaults' => { 494 'server' => setv(T_FQDNP, 1, 0, 1, 'dondns.dondominio.com', undef), 495 }, 496); 497my %services = ( 498 'dyndns1' => { 499 'updateable' => \&nic_dyndns2_updateable, 500 'update' => \&nic_dyndns1_update, 501 'examples' => \&nic_dyndns1_examples, 502 'variables' => merge( 503 $variables{'dyndns-common-defaults'}, 504 $variables{'service-common-defaults'}, 505 ), 506 }, 507 'dyndns2' => { 508 'updateable' => \&nic_dyndns2_updateable, 509 'update' => \&nic_dyndns2_update, 510 'examples' => \&nic_dyndns2_examples, 511 'variables' => merge( 512 { 'custom' => setv(T_BOOL, 0, 1, 1, 0, undef), }, 513 { 'script' => setv(T_STRING, 1, 1, 1, '/nic/update', undef), }, 514# { 'offline' => setv(T_BOOL, 0, 1, 1, 0, undef), }, 515 $variables{'dyndns-common-defaults'}, 516 $variables{'service-common-defaults'}, 517 ), 518 }, 519 'noip' => { 520 'updateable' => undef, 521 'update' => \&nic_noip_update, 522 'examples' => \&nic_noip_examples, 523 'variables' => merge( 524 { 'custom' => setv(T_BOOL, 0, 1, 1, 0, undef), }, 525 $variables{'noip-common-defaults'}, 526 $variables{'noip-service-common-defaults'}, 527 ), 528 }, 529 'concont' => { 530 'updateable' => undef, 531 'update' => \&nic_concont_update, 532 'examples' => \&nic_concont_examples, 533 'variables' => merge( 534 $variables{'service-common-defaults'}, 535 { 'mx' => setv(T_OFQDN, 0, 1, 1, '', undef), }, 536 { 'wildcard' => setv(T_BOOL, 0, 1, 1, 0, undef), }, 537 ), 538 }, 539 'dslreports1' => { 540 'updateable' => undef, 541 'update' => \&nic_dslreports1_update, 542 'examples' => \&nic_dslreports1_examples, 543 'variables' => merge( 544 { 'host' => setv(T_NUMBER, 1, 1, 1, 0, undef) }, 545 $variables{'service-common-defaults'}, 546 ), 547 }, 548 'hammernode1' => { 549 'updateable' => undef, 550 'update' => \&nic_hammernode1_update, 551 'examples' => \&nic_hammernode1_examples, 552 'variables' => merge( 553 { 'server' => setv(T_FQDNP, 1, 0, 1, 'dup.hn.org', undef) }, 554 { 'min-interval' => setv(T_DELAY, 0, 0, 1, interval('5m'), 0),}, 555 $variables{'service-common-defaults'}, 556 ), 557 }, 558 'zoneedit1' => { 559 'updateable' => undef, 560 'update' => \&nic_zoneedit1_update, 561 'examples' => \&nic_zoneedit1_examples, 562 'variables' => merge( 563 { 'server' => setv(T_FQDNP, 1, 0, 1, 'dynamic.zoneedit.com', undef) }, 564 { 'min-interval' => setv(T_DELAY, 0, 0, 1, interval('5m'), 0),}, 565 $variables{'service-common-defaults'}, 566 $variables{'zoneedit-service-common-defaults'}, 567 ), 568 }, 569 'easydns' => { 570 'updateable' => undef, 571 'update' => \&nic_easydns_update, 572 'examples' => \&nic_easydns_examples, 573 'variables' => merge( 574 { 'server' => setv(T_FQDNP, 1, 0, 1, 'members.easydns.com', undef) }, 575 { 'min-interval' => setv(T_DELAY, 0, 0, 1, interval('5m'), 0),}, 576 $variables{'easydns-common-defaults'}, 577 $variables{'service-common-defaults'}, 578 ), 579 }, 580 'dnspark' => { 581 'updateable' => undef, 582 'update' => \&nic_dnspark_update, 583 'examples' => \&nic_dnspark_examples, 584 'variables' => merge( 585 { 'server' => setv(T_FQDNP, 1, 0, 1, 'www.dnspark.com', undef) }, 586 { 'min-interval' => setv(T_DELAY, 0, 0, 1, interval('5m'), 0),}, 587 $variables{'dnspark-common-defaults'}, 588 $variables{'service-common-defaults'}, 589 ), 590 }, 591 'namecheap' => { 592 'updateable' => undef, 593 'update' => \&nic_namecheap_update, 594 'examples' => \&nic_namecheap_examples, 595 'variables' => merge( 596 { 'server' => setv(T_FQDNP, 1, 0, 1, 'dynamicdns.park-your-domain.com', undef) }, 597 { 'min-interval' => setv(T_DELAY, 0, 0, 1, 0, interval('5m')),}, 598 $variables{'service-common-defaults'}, 599 ), 600 }, 601 'nfsn' => { 602 'updateable' => undef, 603 'update' => \&nic_nfsn_update, 604 'examples' => \&nic_nfsn_examples, 605 'variables' => merge( 606 { 'server' => setv(T_FQDNP, 1, 0, 1, 'api.nearlyfreespeech.net', undef) }, 607 { 'min_interval' => setv(T_FQDNP, 0, 0, 1, 0, interval('5m')) }, 608 { 'ttl' => setv(T_NUMBER, 1, 0, 1, 300, undef) }, 609 { 'zone' => setv(T_FQDN, 1, 0, 1, undef, undef) }, 610 $variables{'service-common-defaults'}, 611 ), 612 }, 613 'sitelutions' => { 614 'updateable' => undef, 615 'update' => \&nic_sitelutions_update, 616 'examples' => \&nic_sitelutions_examples, 617 'variables' => merge( 618 { 'server' => setv(T_FQDNP, 1, 0, 1, 'www.sitelutions.com', undef) }, 619 { 'min-interval' => setv(T_DELAY, 0, 0, 1, 0, interval('5m')),}, 620 $variables{'service-common-defaults'}, 621 ), 622 }, 623 'freedns' => { 624 'updateable' => undef, 625 'update' => \&nic_freedns_update, 626 'examples' => \&nic_freedns_examples, 627 'variables' => merge( 628 { 'server' => setv(T_FQDNP, 1, 0, 1, 'freedns.afraid.org', undef) }, 629 { 'min-interval' => setv(T_DELAY, 0, 0, 1, 0, interval('5m')),}, 630 $variables{'service-common-defaults'}, 631 ), 632 }, 633 'changeip' => { 634 'updateable' => undef, 635 'update' => \&nic_changeip_update, 636 'examples' => \&nic_changeip_examples, 637 'variables' => merge( 638 { 'server' => setv(T_FQDNP, 1, 0, 1, 'nic.changeip.com', undef) }, 639 { 'min-interval' => setv(T_DELAY, 0, 0, 1, 0, interval('5m')),}, 640 $variables{'service-common-defaults'}, 641 ), 642 }, 643 'dtdns' => { 644 'updateable' => undef, 645 'update' => \&nic_dtdns_update, 646 'examples' => \&nic_dtdns_examples, 647 'variables' => merge( 648 $variables{'dtdns-common-defaults'}, 649 $variables{'service-common-defaults'}, 650 ), 651 }, 652 'nsupdate' => { 653 'updateable' => undef, 654 'update' => \&nic_nsupdate_update, 655 'examples' => \&nic_nsupdate_examples, 656 'variables' => merge( 657 { 'login' => setv(T_LOGIN, 1, 0, 1, '/usr/local/bin/nsupdate', undef), }, 658 $variables{'nsupdate-common-defaults'}, 659 $variables{'service-common-defaults'}, 660 ), 661 }, 662 'cloudflare' => { 663 'updateable' => undef, 664 'update' => \&nic_cloudflare_update, 665 'examples' => \&nic_cloudflare_examples, 666 'variables' => merge( 667 { 'server' => setv(T_FQDNP, 1, 0, 1, 'api.cloudflare.com/client/v4', undef) }, 668 { 'min-interval' => setv(T_DELAY, 0, 0, 1, interval('5m'), 0),}, 669 $variables{'cloudflare-common-defaults'}, 670 $variables{'service-common-defaults'}, 671 ), 672 }, 673 'googledomains' => { 674 'updateable' => undef, 675 'update' => \&nic_googledomains_update, 676 'examples' => \&nic_googledomains_examples, 677 'variables' => merge( 678 { 'min-interval' => setv(T_DELAY, 0, 0, 1, interval('5m'), 0),}, 679 $variables{'googledomains-common-defaults'}, 680 $variables{'service-common-defaults'}, 681 ), 682 }, 683 'duckdns' => { 684 'updateable' => undef, 685 'update' => \&nic_duckdns_update, 686 'examples' => \&nic_duckdns_examples, 687 'variables' => merge( 688 $variables{'duckdns-common-defaults'}, 689 $variables{'service-common-defaults'}, 690 ), 691 }, 692 'freemyip' => { 693 'updateable' => undef, 694 'update' => \&nic_freemyip_update, 695 'examples' => \&nic_freemyip_examples, 696 'variables' => merge( 697 $variables{'freemyip-common-defaults'}, 698 $variables{'service-common-defaults'}, 699 ), 700 }, 701 'woima' => { 702 'updateable' => undef, 703 'update' => \&nic_woima_update, 704 'examples' => \&nic_woima_examples, 705 'variables' => merge( 706 $variables{'woima-common-defaults'}, 707 $variables{'woima-service-common-defaults'}, 708 ), 709 }, 710 'yandex' => { 711 'updateable' => undef, 712 'update' => \&nic_yandex_update, 713 'examples' => \&nic_yandex_examples, 714 'variables' => merge( 715 { 'min-interval' => setv(T_DELAY, 0, 0, 1, interval('5m'), 0),}, 716 $variables{'yandex-common-defaults'}, 717 $variables{'service-common-defaults'}, 718 ), 719 }, 720 'dnsmadeeasy' => { 721 'updateable' => undef, 722 'update' => \&nic_dnsmadeeasy_update, 723 'examples' => \&nic_dnsmadeeasy_examples, 724 'variables' => merge( 725 $variables{'dnsmadeeasy-common-defaults'}, 726 $variables{'service-common-defaults'}, 727 ), 728 }, 729 'dondominio' => { 730 'updateable' => undef, 731 'update' => \&nic_dondominio_update, 732 'examples' => \&nic_dondominio_examples, 733 'variables' => merge( 734 $variables{'dondominio-common-defaults'}, 735 $variables{'service-common-defaults'}, 736 ), 737 }, 738); 739$variables{'merged'} = merge($variables{'global-defaults'}, 740 $variables{'service-common-defaults'}, 741 $variables{'dyndns-common-defaults'}, 742 map { $services{$_}{'variables'} } keys %services, 743); 744 745my @opt = ( 746 "usage: ${program} [options]", 747 "options are:", 748 [ "daemon", "=s", "-daemon delay : run as a daemon, specify delay as an interval." ], 749 [ "foreground", "!", "-foreground : do not fork" ], 750 [ "proxy", "=s", "-proxy host : use 'host' as the HTTP proxy" ], 751 [ "server", "=s", "-server host : update DNS information on 'host'" ], 752 [ "protocol", "=s", "-protocol type : update protocol used" ], 753 [ "file", "=s", "-file path : load configuration information from 'path'" ], 754 [ "cache", "=s", "-cache path : record address used in 'path'" ], 755 [ "pid", "=s", "-pid path : record process id in 'path'" ], 756 "", 757 [ "use", "=s", "-use which : how the should IP address be obtained." ], 758 &ip_strategies_usage(), 759 "", 760 [ "ip", "=s", "-ip address : set the IP address to 'address'" ], 761 "", 762 [ "if", "=s", "-if interface : obtain IP address from 'interface'" ], 763 [ "if-skip", "=s", "-if-skip pattern : skip any IP addresses before 'pattern' in the output of ifconfig {if}" ], 764 "", 765 [ "web", "=s", "-web provider|url : obtain IP address from provider's IP checking page" ], 766 [ "web-skip", "=s", "-web-skip pattern : skip any IP addresses before 'pattern' on the web provider|url" ], 767 "", 768 [ "fw", "=s", "-fw address|url : obtain IP address from firewall at 'address'" ], 769 [ "fw-skip", "=s", "-fw-skip pattern : skip any IP addresses before 'pattern' on the firewall address|url" ], 770 [ "fw-banlocal", "!", "-fw-banlocal : ignore local IP addresses on the firewall address|url" ], 771 [ "fw-login", "=s", "-fw-login login : use 'login' when getting IP from fw" ], 772 [ "fw-password", "=s", "-fw-password secret : use password 'secret' when getting IP from fw" ], 773 "", 774 [ "cmd", "=s", "-cmd program : obtain IP address from by calling {program}" ], 775 [ "cmd-skip", "=s", "-cmd-skip pattern : skip any IP addresses before 'pattern' in the output of {cmd}" ], 776 "", 777 [ "login", "=s", "-login user : login as 'user'" ], 778 [ "password", "=s", "-password secret : use password 'secret'" ], 779 [ "host", "=s", "-host host : update DNS information for 'host'" ], 780 "", 781 [ "options", "=s", "-options opt,opt : optional per-service arguments (see below)" ], 782 "", 783 [ "ssl", "!", "-{no}ssl : do updates over encrypted SSL connection" ], 784 [ "retry", "!", "-{no}retry : retry failed updates." ], 785 [ "force", "!", "-{no}force : force an update even if the update may be unnecessary" ], 786 [ "timeout", "=i", "-timeout max : wait at most 'max' seconds for the host to respond" ], 787 788 [ "syslog", "!", "-{no}syslog : log messages to syslog" ], 789 [ "facility", "=s", "-facility {type} : log messages to syslog to facility {type}" ], 790 [ "priority", "=s", "-priority {pri} : log messages to syslog with priority {pri}" ], 791 [ "mail", "=s", "-mail address : e-mail messages to {address}" ], 792 [ "mail-failure","=s", "-mail-failure address : e-mail messages for failed updates to {address}" ], 793 [ "exec", "!", "-{no}exec : do {not} execute; just show what would be done" ], 794 [ "debug", "!", "-{no}debug : print {no} debugging information" ], 795 [ "verbose", "!", "-{no}verbose : print {no} verbose information" ], 796 [ "quiet", "!", "-{no}quiet : print {no} messages for unnecessary updates" ], 797 [ "ipv6", "!", "-{no}ipv6 : use ipv6" ], 798 [ "help", "", "-help : this message" ], 799 [ "postscript", "", "-postscript : script to run after updating ddclient, has new IP as param" ], 800 801 [ "query", "!", "-{no}query : print {no} ip addresses and exit" ], 802 [ "test", "!", "" ], ## hidden 803 [ "geturl", "=s", "" ], ## hidden 804 "", 805 nic_examples(), 806 "$program version $version, ", 807 " originally written by Paul Burry, paul+ddclient\@burry.ca", 808 " project now maintained on http://ddclient.sourceforge.net" 809); 810 811## process args 812my ($opt_usage, %opt) = process_args(@opt); 813my ($result, %config, %globals, %cache); 814my $saved_cache = ''; 815my %saved_opt = %opt; 816$result = 'OK'; 817 818test_geturl(opt('geturl')) if opt('geturl'); 819 820## process help option 821if (opt('help')) { 822 *STDERR = *STDOUT; 823 usage(0); 824} 825 826## read config file because 'daemon' mode may be defined there. 827read_config(define($opt{'file'}, default('file')), \%config, \%globals); 828init_config(); 829test_possible_ip() if opt('query'); 830 831if (!opt('daemon') && $programd =~ /d$/) { 832 $opt{'daemon'} = minimum('daemon'); 833} 834my $caught_hup = 0; 835my $caught_term = 0; 836my $caught_kill = 0; 837$SIG{'HUP'} = sub { $caught_hup = 1; }; 838$SIG{'TERM'} = sub { $caught_term = 1; }; 839$SIG{'KILL'} = sub { $caught_kill = 1; }; 840# don't fork() if foreground or force is on 841if (opt('foreground') || opt('force')) { 842 ; 843} elsif (opt('daemon')) { 844 $SIG{'CHLD'} = 'IGNORE'; 845 chdir '/'; 846 open(STDIN, "</dev/null"); 847 open(STDOUT, ">/dev/null"); 848 my $pid = fork; 849 if ($pid < 0) { 850 print STDERR "${program}: can not fork ($!)\n"; 851 exit -1; 852 } elsif ($pid) { 853 exit 0; 854 } 855 setsid; 856 $SIG{'CHLD'} = 'DEFAULT'; 857 open(STDERR, "&STDOUT"); 858} 859 860# write out the pid file if we're daemon'ized 861if(opt('daemon')) { 862 write_pid(); 863 $opt{'syslog'} = 1; 864} 865 866umask 077; 867my $daemon; 868do { 869 $now = time; 870 $result = 'OK'; 871 %opt = %saved_opt; 872 if (opt('help')) { 873 *STDERR = *STDOUT; 874 printf("Help found"); 875 # usage(); 876 } 877 878 read_config(define($opt{'file'}, default('file')), \%config, \%globals); 879 init_config(); 880 read_cache(opt('cache'), \%cache); 881 print_info() if opt('debug') && opt('verbose'); 882 883# usage("invalid argument '-use %s'; possible values are:\n\t%s", $opt{'use'}, join("\n\t,",sort keys %ip_strategies)) 884 usage("invalid argument '-use %s'; possible values are:\n%s", $opt{'use'}, join("\n",ip_strategies_usage())) 885 unless exists $ip_strategies{lc opt('use')}; 886 887 $daemon = $opt{'daemon'}; 888 $daemon = 0 if opt('force'); 889 890 update_nics(); 891 892 if ($daemon) { 893 debug("sleep %s", $daemon); 894 sendmail(); 895 896 my $left = $daemon; 897 while (($left > 0) && !$caught_hup && !$caught_term && !$caught_kill) { 898 my $delay = $left > 10 ? 10 : $left; 899 900 $0 = sprintf("%s - sleeping for %s seconds", $program, $left); 901 $left -= sleep $delay; 902 # preventing deep sleep - see [bugs:#46] 903 if ($left > $daemon) { 904 $left = $daemon; 905 } 906 } 907 $caught_hup = 0; 908 $result = 0; 909 910 } elsif (! scalar(%config)) { 911 warning("no hosts to update.") unless !opt('quiet') || opt('verbose') || !$daemon; 912 $result = 1; 913 914 } else { 915 $result = $result eq 'OK' ? 0 : 1; 916 } 917} while ($daemon && !$result && !$caught_term && !$caught_kill); 918 919warning("caught SIGKILL; exiting") if $caught_kill; 920unlink_pid(); 921sendmail(); 922 923exit($result); 924 925###################################################################### 926## runpostscript 927###################################################################### 928 929sub runpostscript { 930 my ($ip) = @_; 931 932 if ( defined $globals{postscript} ) { 933 if ( -x $globals{postscript}) { 934 system ("$globals{postscript} $ip &"); 935 } else { 936 warning ("Can not execute post script: %s", $globals{postscript}); 937 } 938 } 939} 940 941###################################################################### 942## update_nics 943###################################################################### 944sub update_nics { 945 my %examined = (); 946 my %iplist = (); 947 948 foreach my $s (sort keys %services) { 949 my (@hosts, %ips) = (); 950 my $updateable = $services{$s}{'updateable'}; 951 my $update = $services{$s}{'update'}; 952 953 foreach my $h (sort keys %config) { 954 next if $config{$h}{'protocol'} ne lc($s); 955 $examined{$h} = 1; 956 # we only do this once per 'use' and argument combination 957 my $use = opt('use', $h); 958 my $arg_ip = opt('ip', $h) || ''; 959 my $arg_fw = opt('fw', $h) || ''; 960 my $arg_if = opt('if', $h) || ''; 961 my $arg_web = opt('web', $h) || ''; 962 my $arg_cmd = opt('cmd', $h) || ''; 963 my $ip = ""; 964 if (exists $iplist{$use}{$arg_ip}{$arg_fw}{$arg_if}{$arg_web}{$arg_cmd}) { 965 $ip = $iplist{$use}{$arg_ip}{$arg_fw}{$arg_if}{$arg_web}{$arg_cmd}; 966 } else { 967 $ip = get_ip($use, $h); 968 if (!defined $ip || !$ip) { 969 warning("unable to determine IP address") 970 if !$daemon || opt('verbose'); 971 next; 972 } 973 if ($ip !~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) { 974 if( !ipv6_match($ip) ) { 975 warning("malformed IP address (%s)", $ip); 976 next; 977 } 978 } 979 $iplist{$use}{$arg_ip}{$arg_fw}{$arg_if}{$arg_web}{$arg_cmd} = $ip; 980 } 981 $config{$h}{'wantip'} = $ip; 982 next if !nic_updateable($h, $updateable); 983 push @hosts, $h; 984 $ips{$ip} = $h; 985 } 986 if (@hosts) { 987 $0 = sprintf("%s - updating %s", $program, join(',', @hosts)); 988 &$update(@hosts); 989 runpostscript(join ' ', keys %ips); 990 } 991 } 992 foreach my $h (sort keys %config) { 993 if (!exists $examined{$h}) { 994 failed("%s was not updated because protocol %s is not supported.", 995 $h, define($config{$h}{'protocol'}, '<undefined>') 996 ); 997 } 998 } 999 write_cache(opt('cache')); 1000} 1001###################################################################### 1002## unlink_pid() 1003###################################################################### 1004sub unlink_pid { 1005 if (opt('pid') && opt('daemon')) { 1006 unlink opt('pid'); 1007 } 1008} 1009 1010###################################################################### 1011## write_pid() 1012###################################################################### 1013sub write_pid { 1014 my $file = opt('pid'); 1015 1016 if ($file && opt('daemon')) { 1017 local *FD; 1018 if (! open(FD, "> $file")) { 1019 warning("Cannot create file '%s'. ($!)", $file); 1020 1021 } else { 1022 printf FD "$$\n"; 1023 close(FD); 1024 } 1025 } 1026} 1027 1028###################################################################### 1029## write_cache($file) 1030###################################################################### 1031sub write_cache { 1032 my ($file) = @_; 1033 1034 ## merge the updated host entries into the cache. 1035 foreach my $h (keys %config) { 1036 if (! exists $cache{$h} || $config{$h}{'update'}) { 1037 map {$cache{$h}{$_} = $config{$h}{$_} } @{$config{$h}{'cacheable'}}; 1038 1039 } else { 1040 map {$cache{$h}{$_} = $config{$h}{$_} } qw(atime wtime status); 1041 } 1042 } 1043 1044 ## construct the cache file. 1045 my $cache = ""; 1046 foreach my $h (sort keys %cache) { 1047 my $opt = join(',', map { "$_=".define($cache{$h}{$_},'') } sort keys %{$cache{$h}}); 1048 1049 $cache .= sprintf "%s%s%s\n", $opt, ($opt ? ' ' : ''), $h; 1050 } 1051 $file = '' if defined($saved_cache) && $cache eq $saved_cache; 1052 1053 ## write the updates and other entries to the cache file. 1054 if ($file) { 1055 $saved_cache = undef; 1056 local *FD; 1057 if (! open(FD, "> $file")) { 1058 fatal("Cannot create file '%s'. ($!)", $file); 1059 } 1060 printf FD "## $program-$version\n"; 1061 printf FD "## last updated at %s (%d)\n", prettytime($now), $now; 1062 printf FD $cache; 1063 1064 close(FD); 1065 } 1066} 1067###################################################################### 1068## read_cache($file) - called before reading the .conf 1069###################################################################### 1070sub read_cache { 1071 my $file = shift; 1072 my $config = shift; 1073 my $globals = {}; 1074 1075 %{$config} = (); 1076 ## read the cache file ignoring anything on the command-line. 1077 if (-e $file) { 1078 my %saved = %opt; 1079 %opt = (); 1080 $saved_cache = _read_config($config, $globals, "##\\s*$program-$version\\s*", $file); 1081 %opt = %saved; 1082 1083 foreach my $h (keys %cache) { 1084 if (exists $config->{$h}) { 1085 foreach (qw(atime mtime wtime ip status)) { 1086 $config->{$h}{$_} = $cache{$h}{$_} if exists $cache{$h}{$_}; 1087 } 1088 } 1089 } 1090 } 1091} 1092###################################################################### 1093## parse_assignments(string) return (rest, %variables) 1094## parse_assignment(string) return (name, value, rest) 1095###################################################################### 1096sub parse_assignments { 1097 my $rest = shift; 1098 my @args = @_; 1099 my %variables = (); 1100 my ($name, $value); 1101 1102 while (1) { 1103 $rest =~ s/^\s+//; 1104 ($name, $value, $rest) = parse_assignment($rest, @args); 1105 if (defined $name) { 1106 $variables{$name} = $value; 1107 } else { 1108 last; 1109 } 1110 } 1111 return ($rest, %variables); 1112} 1113sub parse_assignment { 1114 my $rest = shift; 1115 my $stop = @_ ? shift : '[\n\s,]'; 1116 my ($c, $name, $value); 1117 my ($escape, $quote) = (0, ''); 1118 1119 if ($rest =~ /^\s*([a-z][0-9a-z_-]*)=(.*)/i) { 1120 ($name, $rest, $value) = ($1, $2, ''); 1121 1122 while (length($c = substr($rest,0,1))) { 1123 $rest = substr($rest,1); 1124 if ($escape) { 1125 $value .= $c; 1126 $escape = 0; 1127 } elsif ($c eq "\\") { 1128 $escape = 1; 1129 } elsif ($quote && $c eq $quote) { 1130 $quote = '' 1131 } elsif (!$quote && $c =~ /[\'\"]/) { 1132 $quote = $c; 1133 } elsif (!$quote && $c =~ /^${stop}/) { 1134 last; 1135 } else { 1136 $value .= $c; 1137 } 1138 } 1139 } 1140 warning("assignment ended with an open quote") if $quote; 1141 return ($name, $value, $rest); 1142} 1143###################################################################### 1144## read_config 1145###################################################################### 1146sub read_config { 1147 my $file = shift; 1148 my $config = shift; 1149 my $globals = shift; 1150 my %globals = (); 1151 1152 _read_config($config, $globals, '', $file, %globals); 1153} 1154sub _read_config { 1155 my $config = shift; 1156 my $globals = shift; 1157 my $stamp = shift; 1158 local $file = shift; 1159 my %globals = @_; 1160 my %config = (); 1161 my $content = ''; 1162 1163 local *FD; 1164 if (! open(FD, "< $file")) { 1165 # fatal("Cannot open file '%s'. ($!)", $file); 1166 warning("Cannot open file '%s'. ($!)", $file); 1167 } 1168 # Check for only owner has any access to config file 1169 my ($dev, $ino, $mode, @statrest) = stat(FD); 1170 if ($mode & 077) { 1171 if (-f FD && (chmod 0600, $file)) { 1172 warning("file $file must be accessible only by its owner (fixed)."); 1173 } else { 1174 # fatal("file $file must be accessible only by its owner."); 1175 warning("file $file must be accessible only by its owner."); 1176 } 1177 } 1178 1179 local $lineno = 0; 1180 my $continuation = ''; 1181 my %passwords = (); 1182 while (<FD>) { 1183 s/[\r\n]//g; 1184 1185 $lineno++; 1186 1187 ## check for the program version stamp 1188 if (($. == 1) && $stamp && ($_ !~ /^$stamp$/i)) { 1189 warning("program version mismatch; ignoring %s", $file); 1190 last; 1191 } 1192 if (/\\\s+$/) { 1193 warning("whitespace follows the \\ at the end-of-line.\nIf you meant to have a line continuation, remove the trailing whitespace."); 1194 } 1195 1196 $content .= "$_\n" unless /^#/; 1197 1198 ## parsing passwords is special 1199 if (/^([^#]*\s)?([^#]*?password\S*?)\s*=\s*('.*'|[^']\S*)(.*)/) { 1200 my ($head, $key, $value, $tail) = ($1 || '', $2, $3, $4); 1201 $value = $1 if $value =~ /^'(.*)'$/; 1202 $passwords{$key} = $value; 1203 $_ = "${head}${key}=dummy${tail}"; 1204 } 1205 1206 ## remove comments 1207 s/#.*//; 1208 1209 ## handle continuation lines 1210 $_ = "$continuation$_"; 1211 if (/\\$/) { 1212 chop; 1213 $continuation = $_; 1214 next; 1215 } 1216 $continuation = ''; 1217 1218 s/^\s+//; # remove leading white space 1219 s/\s+$//; # remove trailing white space 1220 s/\s+/ /g; # canonify 1221 next if /^$/; 1222 1223 ## expected configuration line is: 1224 ## [opt=value,opt=..] [host [login [password]]] 1225 my %locals; 1226 ($_, %locals) = parse_assignments($_); 1227 s/\s*,\s*/,/g; 1228 my @args = split; 1229 1230 ## verify that keywords are valid...and check the value 1231 foreach my $k (keys %locals) { 1232 $locals{$k} = $passwords{$k} if defined $passwords{$k}; 1233 if (!exists $variables{'merged'}{$k}) { 1234 warning("unrecognized keyword '%s' (ignored)", $k); 1235 delete $locals{$k}; 1236 } else { 1237 my $def = $variables{'merged'}{$k}; 1238 my $value = check_value($locals{$k}, $def); 1239 if (!defined($value)) { 1240 warning("Invalid Value for keyword '%s' = '%s'", $k, $locals{$k}); 1241 delete $locals{$k}; 1242 } else { $locals{$k} = $value; } 1243 } 1244 } 1245 if (exists($locals{'host'})) { 1246 $args[0] = @args ? "$args[0],$locals{host}" : "$locals{host}"; 1247 } 1248 ## accumulate globals 1249 if ($#args < 0) { 1250 map { $globals{$_} = $locals{$_} } keys %locals; 1251 } 1252 1253 ## process this host definition 1254 if (@args) { 1255 my ($host, $login, $password) = @args; 1256 1257 ## add in any globals.. 1258 %locals = %{ merge(\%locals, \%globals) }; 1259 1260 ## override login and password if specified the old way. 1261 $locals{'login'} = $login if defined $login; 1262 $locals{'password'} = $password if defined $password; 1263 1264 ## allow {host} to be a comma separated list of hosts 1265 foreach my $h (split_by_comma($host)) { 1266 ## save a copy of the current globals 1267 $config{$h} = { %locals }; 1268 $config{$h}{'host'} = $h; 1269 } 1270 } 1271 %passwords = (); 1272 } 1273 close(FD); 1274 1275 warning("file ends while expecting a continuation line.") 1276 if $continuation; 1277 1278 %$globals = %globals; 1279 %$config = %config; 1280 1281 return $content; 1282} 1283###################################################################### 1284## init_config - 1285###################################################################### 1286sub init_config { 1287 %opt = %saved_opt; 1288 1289 ## 1290 $opt{'quiet'} = 0 if opt('verbose'); 1291 1292 ## infer the IP strategy if possible 1293 $opt{'use'} = 'ip' if !define($opt{'use'}) && defined($opt{'ip'}); 1294 $opt{'use'} = 'if' if !define($opt{'use'}) && defined($opt{'if'}); 1295 $opt{'use'} = 'web' if !define($opt{'use'}) && defined($opt{'web'}); 1296 1297 ## sanity check 1298 $opt{'max-interval'} = min(interval(opt('max-interval')), interval(default('max-interval'))); 1299 $opt{'min-interval'} = max(interval(opt('min-interval')), interval(default('min-interval'))); 1300 $opt{'min-error-interval'} = max(interval(opt('min-error-interval')), interval(default('min-error-interval'))); 1301 1302 $opt{'timeout'} = 0 if opt('timeout') < 0; 1303 1304 ## only set $opt{'daemon'} if it has been explicitly passed in 1305 if (define($opt{'daemon'},$globals{'daemon'},0)) { 1306 $opt{'daemon'} = interval(opt('daemon')); 1307 $opt{'daemon'} = minimum('daemon') 1308 if ($opt{'daemon'} < minimum('daemon')); 1309 } 1310 1311 ## define or modify host options specified on the command-line 1312 if (exists $opt{'options'} && defined $opt{'options'}) { 1313 ## collect cmdline configuration options. 1314 my %options = (); 1315 foreach my $opt (split_by_comma($opt{'options'})) { 1316 my ($name,$var) = split /\s*=\s*/, $opt; 1317 $options{$name} = $var; 1318 } 1319 ## determine hosts specified with -host 1320 my @hosts = (); 1321 if (exists $opt{'host'}) { 1322 foreach my $h (split_by_comma($opt{'host'})) { 1323 push @hosts, $h; 1324 } 1325 } 1326 ## and those in -options=... 1327 if (exists $options{'host'}) { 1328 foreach my $h (split_by_comma($options{'host'})) { 1329 push @hosts, $h; 1330 } 1331 delete $options{'host'}; 1332 } 1333 ## merge options into host definitions or globals 1334 if (@hosts) { 1335 foreach my $h (@hosts) { 1336 $config{$h} = merge(\%options, $config{$h}); 1337 } 1338 $opt{'host'} = join(',', @hosts); 1339 } else { 1340 %globals = %{ merge(\%options, \%globals) }; 1341 } 1342 } 1343 1344 ## override global options with those on the command-line. 1345 foreach my $o (keys %opt) { 1346 if (defined $opt{$o} && exists $variables{'global-defaults'}{$o}) { 1347 $globals{$o} = $opt{$o}; 1348 } 1349 } 1350 1351 ## sanity check 1352 if (defined $opt{'host'} && defined $opt{'retry'}) { 1353 usage("options -retry and -host (or -option host=..) are mutually exclusive"); 1354 } 1355 1356 ## determine hosts to update (those on the cmd-line, config-file, or failed cached) 1357 my @hosts = keys %config; 1358 if (opt('host')) { 1359 @hosts = split_by_comma($opt{'host'}); 1360 } 1361 if (opt('retry')) { 1362 @hosts = map { $_ if $cache{$_}{'status'} ne 'good' } keys %cache; 1363 } 1364 1365 ## remove any other hosts 1366 my %hosts; 1367 map { $hosts{$_} = undef } @hosts; 1368 map { delete $config{$_} unless exists $hosts{$_} } keys %config; 1369 1370 ## collect the cacheable variables. 1371 foreach my $proto (keys %services) { 1372 my @cacheable = (); 1373 foreach my $k (keys %{$services{$proto}{'variables'}}) { 1374 push @cacheable, $k if $services{$proto}{'variables'}{$k}{'cache'}; 1375 } 1376 $services{$proto}{'cacheable'} = [ @cacheable ]; 1377 } 1378 1379 ## sanity check.. 1380 ## make sure config entries have all defaults and they meet minimums 1381 ## first the globals... 1382 foreach my $k (keys %globals) { 1383 my $def = $variables{'merged'}{$k}; 1384 my $ovalue = define($globals{$k}, $def->{'default'}); 1385 my $value = check_value($ovalue, $def); 1386 if ($def->{'required'} && !defined $value) { 1387 $value = default($k); 1388 warning("'%s=%s' is an invalid %s. (using default of %s)", $k, $ovalue, $def->{'type'}, $value); 1389 } 1390 $globals{$k} = $value; 1391 } 1392 1393 ## now the host definitions... 1394 HOST: 1395 foreach my $h (keys %config) { 1396 my $proto; 1397 $proto = $config{$h}{'protocol'}; 1398 $proto = opt('protocol') if !defined($proto); 1399 1400 load_sha1_support($proto) if (grep (/^$proto$/, ("freedns", "nfsn"))); 1401 load_json_support($proto) if (grep (/^$proto$/, ("cloudflare","yandex","nfsn"))); 1402 1403 if (!exists($services{$proto})) { 1404 warning("skipping host: %s: unrecognized protocol '%s'", $h, $proto); 1405 delete $config{$h}; 1406 1407 } else { 1408 my $svars = $services{$proto}{'variables'}; 1409 my $conf = { 'protocol' => $proto }; 1410 1411 foreach my $k (keys %$svars) { 1412 my $def = $svars->{$k}; 1413 my $ovalue = define($config{$h}{$k}, $def->{'default'}); 1414 my $value = check_value($ovalue, $def); 1415 if ($def->{'required'} && !defined $value) { 1416 warning("skipping host: %s: '%s=%s' is an invalid %s.", $h, $k, $ovalue, $def->{'type'}); 1417 delete $config{$h}; 1418 next HOST; 1419 } 1420 $conf->{$k} = $value; 1421 1422 } 1423 $config{$h} = $conf; 1424 $config{$h}{'cacheable'} = [ @{$services{$proto}{'cacheable'}} ]; 1425 } 1426 } 1427} 1428 1429###################################################################### 1430## usage 1431###################################################################### 1432sub usage { 1433 my $exitcode = 1; 1434 $exitcode = shift if @_ != 0; # use first arg if given 1435 my $msg = ''; 1436 if (@_) { 1437 my $format = shift; 1438 $msg .= sprintf $format, @_; 1439 1 while chomp($msg); 1440 $msg .= "\n"; 1441 } 1442 printf STDERR "%s%s\n", $msg, $opt_usage; 1443 sendmail(); 1444 exit $exitcode; 1445} 1446 1447###################################################################### 1448## process_args - 1449###################################################################### 1450sub process_args { 1451 my @spec = (); 1452 my $usage = ""; 1453 my %opts = (); 1454 1455 foreach (@_) { 1456 if (ref $_) { 1457 my ($key, $specifier, $arg_usage) = @$_; 1458 my $value = default($key); 1459 1460 ## add a option specifier 1461 push @spec, $key . $specifier; 1462 1463 ## define the default value which can be overwritten later 1464 $opt{$key} = undef; 1465 1466 next unless $arg_usage; 1467 1468 ## add a line to the usage; 1469 $usage .= " $arg_usage"; 1470 if (defined($value) && $value ne '') { 1471 $usage .= " (default: "; 1472 if ($specifier eq '!') { 1473 $usage .= "no" if ($specifier eq '!') && !$value; 1474 $usage .= $key; 1475 } else { 1476 $usage .= $value; 1477 } 1478 $usage .= ")"; 1479 } 1480 $usage .= "."; 1481 } else { 1482 $usage .= $_; 1483 } 1484 $usage .= "\n"; 1485 } 1486 ## process the arguments 1487 if (! GetOptions(\%opt, @spec)) { 1488 $opt{"help"} = 1; 1489 } 1490 return ($usage, %opt); 1491} 1492###################################################################### 1493## test_possible_ip - print possible IPs 1494###################################################################### 1495sub test_possible_ip { 1496 local $opt{'debug'} = 0; 1497 1498 printf "use=ip, ip=%s address is %s\n", opt('ip'), define(get_ip('ip'), 'NOT FOUND') 1499 if defined opt('ip'); 1500 1501 { 1502 local $opt{'use'} = 'if'; 1503 foreach my $if (grep {/^[a-zA-Z]/} `ifconfig -a`) { 1504 $if =~ s/:?\s.*//is; 1505 local $opt{'if'} = $if; 1506 printf "use=if, if=%s address is %s\n", opt('if'), define(get_ip('if'), 'NOT FOUND'); 1507 } 1508 } 1509 if (opt('fw')) { 1510 if (opt('fw') !~ m%/%) { 1511 foreach my $fw (sort keys %builtinfw) { 1512 local $opt{'use'} = $fw; 1513 printf "use=$fw address is %s\n", define(get_ip($fw), 'NOT FOUND'); 1514 } 1515 } 1516 local $opt{'use'} = 'fw'; 1517 printf "use=fw, fw=%s address is %s\n", opt('fw'), define(get_ip(opt('fw')), 'NOT FOUND') 1518 if ! exists $builtinfw{opt('fw')}; 1519 1520 } 1521 { 1522 local $opt{'use'} = 'web'; 1523 foreach my $web (sort keys %builtinweb) { 1524 local $opt{'web'} = $web; 1525 printf "use=web, web=$web address is %s\n", define(get_ip('web'), 'NOT FOUND'); 1526 } 1527 printf "use=web, web=%s address is %s\n", opt('web'), define(get_ip('web'), 'NOT FOUND') 1528 if ! exists $builtinweb{opt('web')}; 1529 } 1530 if (opt('cmd')) { 1531 local $opt{'use'} = 'cmd'; 1532 printf "use=cmd, cmd=%s address is %s\n", opt('cmd'), define(get_ip('cmd'), 'NOT FOUND'); 1533 } 1534 exit 0 unless opt('debug'); 1535} 1536###################################################################### 1537## test_geturl - print (and save if -test) result of fetching a URL 1538###################################################################### 1539sub test_geturl { 1540 my $url = shift; 1541 1542 my $reply = geturl(opt('proxy'), $url, opt('login'), opt('password')); 1543 print "URL $url\n";; 1544 print defined($reply) ? $reply : "<undefined>\n"; 1545 exit; 1546} 1547###################################################################### 1548## load_file 1549###################################################################### 1550sub load_file { 1551 my $file = shift; 1552 my $buffer = ''; 1553 1554 if (exists($ENV{'TEST_CASE'})) { 1555 my $try = "$file-$ENV{'TEST_CASE'}"; 1556 $file = $try if -f $try; 1557 } 1558 1559 local *FD; 1560 if (open(FD, "< $file")) { 1561 read(FD, $buffer, -s FD); 1562 close(FD); 1563 debug("Loaded %d bytes from %s", length($buffer), $file); 1564 } else { 1565 debug("Load failed from %s ($!)", $file); 1566 } 1567 return $buffer 1568} 1569###################################################################### 1570## save_file 1571###################################################################### 1572sub save_file { 1573 my ($file, $buffer, $opt) = @_; 1574 1575 $file .= "-$ENV{'TEST_CASE'}" if exists $ENV{'TEST_CASE'}; 1576 if (defined $opt) { 1577 my $i = 0; 1578 while (-f "$file-$i") { 1579 if ('unique' =~ /^$opt/i) { 1580 my $a = join('\n', grep {!/^Date:/} split /\n/, $buffer); 1581 my $b = join('\n', grep {!/^Date:/} split /\n/, load_file("$file-$i")); 1582 last if $a eq $b; 1583 } 1584 $i++; 1585 } 1586 $file = "$file-$i"; 1587 } 1588 debug("Saving to %s", $file); 1589 local *FD; 1590 open(FD, "> $file") or return; 1591 print FD $buffer; 1592 close(FD); 1593 return $buffer; 1594} 1595###################################################################### 1596## print_opt 1597## print_globals 1598## print_config 1599## print_cache 1600## print_info 1601###################################################################### 1602sub _print_hash { 1603 my ($string, $ptr) = @_; 1604 my $value = $ptr; 1605 1606 if (! defined($ptr)) { 1607 $value = "<undefined>"; 1608 } elsif (ref $ptr eq 'HASH') { 1609 foreach my $key (sort keys %$ptr) { 1610 _print_hash("${string}\{$key\}", $ptr->{$key}); 1611 } 1612 return; 1613 } 1614 printf "%-36s : %s\n", $string, $value; 1615} 1616sub print_hash { 1617 my ($string, $hash) = @_; 1618 printf "=== %s ====\n", $string; 1619 _print_hash($string, $hash); 1620} 1621sub print_opt { print_hash("opt", \%opt); } 1622sub print_globals { print_hash("globals", \%globals); } 1623sub print_config { print_hash("config", \%config); } 1624sub print_cache { print_hash("cache", \%cache); } 1625sub print_info { 1626 print_opt(); 1627 print_globals(); 1628 print_config(); 1629 print_cache(); 1630} 1631###################################################################### 1632## pipecmd - run an external command 1633## logger 1634## sendmail 1635###################################################################### 1636sub pipecmd { 1637 my $cmd = shift; 1638 my $stdin = join("\n", @_); 1639 my $ok = 0; 1640 1641 ## remove trailing newlines 1642 1 while chomp($stdin); 1643 1644 ## override when debugging. 1645 $cmd = opt('exec') ? "| $cmd" : "> /dev/null"; 1646 1647 ## execute the command. 1648 local *FD; 1649 if (! open(FD, $cmd)) { 1650 warning("$program: cannot execute command %s.\n", $cmd); 1651 1652 } elsif ($stdin && (! print FD "$stdin\n")) { 1653 warning("$program: failed writing to %s.\n", $cmd); 1654 close(FD); 1655 1656 } elsif (! close(FD)) { 1657 warning("$program: failed closing %s.($@)\n", $cmd); 1658 1659 } elsif (opt('exec') && $?) { 1660 warning("$program: failed %s. ($@)\n", $cmd); 1661 1662 } else { 1663 $ok = 1; 1664 } 1665 return $ok; 1666} 1667sub logger { 1668 if (opt('syslog') && opt('facility') && opt('priority')) { 1669 my $facility = opt('facility'); 1670 my $priority = opt('priority'); 1671 return pipecmd("logger -p$facility.$priority -t${program}\[$$\]", @_); 1672 } 1673 return 1; 1674} 1675sub sendmail { 1676 my $recipients = opt('mail'); 1677 1678 if (opt('mail-failure') && ($result ne 'OK' && $result ne '0')) { 1679 $recipients = opt('mail-failure'); 1680 } 1681 if ($msgs && $recipients && $msgs ne $last_msgs) { 1682 pipecmd("sendmail -oi $recipients", 1683 "To: $recipients", 1684 "Subject: status report from $program\@$hostname", 1685 "\r\n", 1686 $msgs, 1687 "", 1688 "regards,", 1689 " $program\@$hostname (version $version)" 1690 ); 1691 } 1692 $last_msgs = $msgs; 1693 $msgs = ''; 1694} 1695###################################################################### 1696## split_by_comma 1697## merge 1698## default 1699## minimum 1700## opt 1701###################################################################### 1702sub split_by_comma { 1703 my $string = shift; 1704 1705 return split /\s*[, ]\s*/, $string if defined $string; 1706 return (); 1707} 1708sub merge { 1709 my %merged = (); 1710 foreach my $h (@_) { 1711 foreach my $k (keys %$h) { 1712 $merged{$k} = $h->{$k} unless exists $merged{$k}; 1713 } 1714 } 1715 return \%merged; 1716} 1717sub default { 1718 my $v = shift; 1719 return $variables{'merged'}{$v}{'default'}; 1720} 1721sub minimum { 1722 my $v = shift; 1723 return $variables{'merged'}{$v}{'minimum'}; 1724} 1725sub opt { 1726 my $v = shift; 1727 my $h = shift; 1728 return $config{$h}{$v} if defined($h && $config{$h}{$v}); 1729 return $opt{$v} if defined $opt{$v}; 1730 return $globals{$v} if defined $globals{$v}; 1731 return default($v) if defined default($v); 1732 return undef; 1733} 1734sub min { 1735 my $min = shift; 1736 foreach my $arg (@_) { 1737 $min = $arg if $arg < $min; 1738 } 1739 return $min; 1740} 1741sub max { 1742 my $max = shift; 1743 foreach my $arg (@_) { 1744 $max = $arg if $arg > $max; 1745 } 1746 return $max; 1747} 1748###################################################################### 1749## define 1750###################################################################### 1751sub define { 1752 foreach (@_) { 1753 return $_ if defined $_; 1754 } 1755 return undef; 1756} 1757###################################################################### 1758## ynu 1759###################################################################### 1760sub ynu { 1761 my ($value, $yes, $no, $undef) = @_; 1762 1763 return $no if !defined($value) || !$value; 1764 return $yes if $value eq '1'; 1765 foreach (qw(yes true)) { 1766 return $yes if $_ =~ /^$value/i; 1767 } 1768 foreach (qw(no false)) { 1769 return $no if $_ =~ /^$value/i; 1770 } 1771 return $undef; 1772} 1773###################################################################### 1774## msg 1775## debug 1776## warning 1777## fatal 1778###################################################################### 1779sub _msg { 1780 my $log = shift; 1781 my $prefix = shift; 1782 my $format = shift; 1783 my $buffer = sprintf $format, @_; 1784 chomp($buffer); 1785 1786 $prefix = sprintf "%-9s ", $prefix if $prefix; 1787 if ($file) { 1788 $prefix .= "file $file"; 1789 $prefix .= ", line $lineno" if $lineno; 1790 $prefix .= ": "; 1791 } 1792 if ($prefix) { 1793 $buffer = "$prefix$buffer"; 1794 $buffer =~ s/\n/\n$prefix /g; 1795 } 1796 $buffer .= "\n"; 1797 print $buffer; 1798 1799 $msgs .= $buffer if $log; 1800 logger($buffer) if $log; 1801 1802} 1803sub msg { _msg(0, '', @_); } 1804sub verbose { _msg(1, @_) if opt('verbose'); } 1805sub info { _msg(1, 'INFO:', @_) if opt('verbose'); } 1806sub debug { _msg(0, 'DEBUG:', @_) if opt('debug'); } 1807sub debug2 { _msg(0, 'DEBUG:', @_) if opt('debug') && opt('verbose');} 1808sub warning { _msg(1, 'WARNING:', @_); } 1809sub fatal { _msg(1, 'FATAL:', @_); sendmail(); exit(1); } 1810sub success { _msg(1, 'SUCCESS:', @_); } 1811sub failed { _msg(1, 'FAILED:', @_); $result = 'FAILED'; } 1812sub prettytime { return scalar(localtime(shift)); } 1813 1814sub prettyinterval { 1815 my $interval = shift; 1816 use integer; 1817 my $s = $interval % 60; $interval /= 60; 1818 my $m = $interval % 60; $interval /= 60; 1819 my $h = $interval % 24; $interval /= 24; 1820 my $d = $interval; 1821 1822 my $string = ""; 1823 $string .= "$d day" if $d; 1824 $string .= "s" if $d > 1; 1825 $string .= ", " if $string && $h; 1826 $string .= "$h hour" if $h; 1827 $string .= "s" if $h > 1; 1828 $string .= ", " if $string && $m; 1829 $string .= "$m minute" if $m; 1830 $string .= "s" if $m > 1; 1831 $string .= ", " if $string && $s; 1832 $string .= "$s second" if $s; 1833 $string .= "s" if $s > 1; 1834 return $string; 1835} 1836sub interval { 1837 my $value = shift; 1838 if ($value =~ /^(\d+)(seconds|s)/i) { 1839 $value = $1; 1840 } elsif ($value =~ /^(\d+)(minutes|m)/i) { 1841 $value = $1 * 60; 1842 } elsif ($value =~ /^(\d+)(hours|h)/i) { 1843 $value = $1 * 60*60; 1844 } elsif ($value =~ /^(\d+)(days|d)/i) { 1845 $value = $1 * 60*60*24; 1846 } elsif ($value !~ /^\d+$/) { 1847 $value = undef; 1848 } 1849 return $value; 1850} 1851sub interval_expired { 1852 my ($host, $time, $interval) = @_; 1853 1854 return 1 if !exists $cache{$host}; 1855 return 1 if !exists $cache{$host}{$time} || !$cache{$host}{$time}; 1856 return 1 if !exists $config{$host}{$interval} || !$config{$host}{$interval}; 1857 1858 return $now > ($cache{$host}{$time} + $config{$host}{$interval}); 1859} 1860 1861 1862 1863###################################################################### 1864## check_value 1865###################################################################### 1866sub check_value { 1867 my ($value, $def) = @_; 1868 my $type = $def->{'type'}; 1869 my $min = $def->{'minimum'}; 1870 my $required = $def->{'required'}; 1871 1872 if (!defined $value && !$required) { 1873 ; 1874 1875 } elsif ($type eq T_DELAY) { 1876 $value = interval($value); 1877 $value = $min if defined($value) && defined($min) && $value < $min; 1878 1879 } elsif ($type eq T_NUMBER) { 1880 return undef if $value !~ /^\d+$/; 1881 $value = $min if defined($min) && $value < $min; 1882 1883 } elsif ($type eq T_BOOL) { 1884 if ($value =~ /^y(es)?$|^t(true)?$|^1$/i) { 1885 $value = 1; 1886 } elsif ($value =~ /^n(o)?$|^f(alse)?$|^0$/i) { 1887 $value = 0; 1888 } else { 1889 return undef; 1890 } 1891 } elsif ($type eq T_FQDN || $type eq T_OFQDN && $value ne '') { 1892 $value = lc $value; 1893 return undef if $value !~ /[^.]\.[^.]/; 1894 1895 } elsif ($type eq T_FQDNP) { 1896 $value = lc $value; 1897 return undef if $value !~ /[^.]\.[^.].*(:\d+)?$/; 1898 1899 } elsif ($type eq T_PROTO) { 1900 $value = lc $value; 1901 return undef if ! exists $services{$value}; 1902 1903 } elsif ($type eq T_USE) { 1904 $value = lc $value; 1905 return undef if ! exists $ip_strategies{$value}; 1906 1907 } elsif ($type eq T_FILE) { 1908 return undef if $value eq ""; 1909 1910 } elsif ($type eq T_IF) { 1911 return undef if $value !~ /^[a-zA-Z0-9:._-]+$/; 1912 1913 } elsif ($type eq T_PROG) { 1914 return undef if $value eq ""; 1915 1916 } elsif ($type eq T_LOGIN) { 1917 return undef if $value eq ""; 1918 1919# } elsif ($type eq T_PASSWD) { 1920# return undef if $value =~ /:/; 1921 1922 } elsif ($type eq T_IP) { 1923 if( !ipv6_match($value) ) { 1924 return undef if $value !~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/; 1925 } 1926 } 1927 return $value; 1928} 1929###################################################################### 1930## encode_base64 - from MIME::Base64 1931###################################################################### 1932sub encode_base64 ($;$) { 1933 my $res = ''; 1934 my $eol = $_[1]; 1935 $eol = "\n" unless defined $eol; 1936 pos($_[0]) = 0; # ensure start at the beginning 1937 while ($_[0] =~ /(.{1,45})/gs) { 1938 $res .= substr(pack('u', $1), 1); 1939 chop($res); 1940 } 1941 $res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs 1942 1943 # fix padding at the end 1944 my $padding = (3 - length($_[0]) % 3) % 3; 1945 $res =~ s/.{$padding}$/'=' x $padding/e if $padding; 1946 $res; 1947} 1948###################################################################### 1949## load_ssl_support 1950###################################################################### 1951sub load_ssl_support { 1952 my $ssl_loaded = eval {require IO::Socket::SSL}; 1953 unless ($ssl_loaded) { 1954 fatal(<<"EOM"); 1955Error loading the Perl module IO::Socket::SSL needed for SSL connect. 1956On Debian, the package libio-socket-ssl-perl must be installed. 1957On Red Hat, the package perl-IO-Socket-SSL must be installed. 1958On Alpine, the package perl-io-socket-ssl must be installed. 1959EOM 1960 } 1961 import IO::Socket::SSL; 1962 { no warnings; $IO::Socket::SSL::DEBUG = 0; } 1963} 1964 1965###################################################################### 1966## load_ipv6_support 1967###################################################################### 1968sub load_ipv6_support { 1969 my $ipv6_loaded = eval {require IO::Socket::INET6}; 1970 unless ($ipv6_loaded) { 1971 fatal(<<"EOM"); 1972Error loading the Perl module IO::Socket::INET6 needed for ipv6 connect. 1973On Debian, the package libio-socket-inet6-perl must be installed. 1974On Red Hat, the package perl-IO-Socket-INET6 must be installed. 1975On Alpine, the package perl-io-socket-inet6 must be installed. 1976EOM 1977 } 1978 import IO::Socket::INET6; 1979 { no warnings; $IO::Socket::INET6::DEBUG = 0; } 1980} 1981 1982###################################################################### 1983## load_sha1_support 1984###################################################################### 1985sub load_sha1_support { 1986 my $why = shift; 1987 my $sha1_loaded = eval {require Digest::SHA1}; 1988 my $sha_loaded = eval {require Digest::SHA}; 1989 unless ($sha1_loaded || $sha_loaded) { 1990 fatal(<<"EOM"); 1991Error loading the Perl module Digest::SHA1 or Digest::SHA needed for $why update. 1992On Debian, the package libdigest-sha1-perl or libdigest-sha-perl must be installed. 1993EOM 1994 } 1995 if($sha1_loaded) { 1996 import Digest::SHA1 (qw/sha1_hex/); 1997 } elsif($sha_loaded) { 1998 import Digest::SHA (qw/sha1_hex/); 1999 } 2000} 2001###################################################################### 2002## load_json_support 2003###################################################################### 2004sub load_json_support { 2005 my $why = shift; 2006 my $json_loaded = eval {require JSON::PP}; 2007 unless ($json_loaded) { 2008 fatal(<<"EOM"); 2009Error loading the Perl module JSON::PP needed for $why update. 2010EOM 2011 } 2012 import JSON::PP (qw/decode_json/); 2013} 2014###################################################################### 2015## geturl 2016###################################################################### 2017sub geturl { 2018 my $proxy = shift || ''; 2019 my $url = shift || ''; 2020 my $login = shift || ''; 2021 my $password = shift || ''; 2022 my $headers = shift || ''; 2023 my $method = shift || 'GET'; 2024 my $data = shift || ''; 2025 my ($peer, $server, $port, $default_port, $use_ssl); 2026 my ($sd, $rq, $request, $reply); 2027 2028 debug("proxy = $proxy"); 2029 debug("url = %s", $url); 2030 ## canonify proxy and url 2031 my $force_ssl; 2032 $force_ssl = 1 if ($url =~ /^https:/); 2033 $proxy =~ s%^https?://%%i; 2034 $url =~ s%^https?://%%i; 2035 $server = $url; 2036 $server =~ s%/.*%%; 2037 $url = "/" unless $url =~ m%/%; 2038 $url =~ s%^[^/]*/%%; 2039 2040 debug("server = $server"); 2041 opt('fw') && debug("opt(fw = ",opt('fw'),")"); 2042 $globals{'fw'} && debug("glo fw = $globals{'fw'}"); 2043 #if ( $globals{'ssl'} and $server ne $globals{'fw'} ) { 2044 ## always omit SSL for connections to local router 2045 if ( $force_ssl || ($globals{'ssl'} and (caller(1))[3] ne 'main::get_ip') ) { 2046 $use_ssl = 1; 2047 $default_port = 443; 2048 load_ssl_support; 2049 } else { 2050 $use_ssl = 0; 2051 $default_port = 80; 2052 } 2053 2054 ## determine peer and port to use. 2055 $peer = $proxy || $server; 2056 $peer =~ s%/.*%%; 2057 $port = $peer; 2058 $port =~ s%^.*:%%; 2059 $port = $default_port unless $port =~ /^\d+$/; 2060 $peer =~ s%:.*$%%; 2061 2062 my $to = sprintf "%s%s", $server, $proxy ? " via proxy $peer:$port" : ""; 2063 verbose("CONNECT:", "%s", $to); 2064 2065 $request = "$method "; 2066 if (!$use_ssl) { 2067 $request .= "http://$server" if $proxy; 2068 } else { 2069 $request .= "https://$server" if $proxy; 2070 } 2071 $request .= "/$url HTTP/1.0\n"; 2072 $request .= "Host: $server\n"; 2073 2074 my $auth = encode_base64("${login}:${password}", ""); 2075 $request .= "Authorization: Basic $auth\n" if $login || $password; 2076 $request .= "User-Agent: ${program}/${version}\n"; 2077 if ($data) { 2078 $request .= "Content-Type: application/x-www-form-urlencoded\n" if ! $headers =~ /^Content-Type: /; 2079 $request .= "Content-Length: " . length($data) . "\n"; 2080 } 2081 $request .= "Connection: close\n"; 2082 $request .= "$headers\n"; 2083 $request .= "\n"; 2084 $request .= $data; 2085 2086 ## make sure newlines are <cr><lf> for some pedantic proxy servers 2087 ($rq = $request) =~ s/\n/\r\n/g; 2088 2089 # local $^W = 0; 2090 $0 = sprintf("%s - connecting to %s port %s", $program, $peer, $port); 2091 if (! opt('exec')) { 2092 debug("skipped network connection"); 2093 verbose("SENDING:", "%s", $request); 2094 } elsif ($use_ssl) { 2095 $sd = IO::Socket::SSL->new( 2096 PeerAddr => $peer, 2097 PeerPort => $port, 2098 SSL_ca_file => '/usr/local/share/certs/ca-root-nss.crt', 2099 Proto => 'tcp', 2100 MultiHomed => 1, 2101 Timeout => opt('timeout'), 2102 ); 2103 defined $sd or warning("cannot connect to $peer:$port socket: $@ " . IO::Socket::SSL::errstr()); 2104 } elsif ($globals{'ipv6'}) { 2105 load_ipv6_support; 2106 $sd = IO::Socket::INET6->new( 2107 PeerAddr => $peer, 2108 PeerPort => $port, 2109 Proto => 'tcp', 2110 MultiHomed => 1, 2111 Timeout => opt('timeout'), 2112 ); 2113 defined $sd or warning("cannot connect to $peer:$port socket: $@"); 2114 } else { 2115 $sd = IO::Socket::INET->new( 2116 PeerAddr => $peer, 2117 PeerPort => $port, 2118 Proto => 'tcp', 2119 MultiHomed => 1, 2120 Timeout => opt('timeout'), 2121 ); 2122 defined $sd or warning("cannot connect to $peer:$port socket: $@"); 2123 } 2124 2125 if (defined $sd) { 2126 ## send the request to the http server 2127 verbose("CONNECTED: ", $use_ssl ? 'using SSL' : 'using HTTP'); 2128 verbose("SENDING:", "%s", $request); 2129 2130 $0 = sprintf("%s - sending to %s port %s", $program, $peer, $port); 2131 my $result = syswrite $sd, $rq; 2132 if ($result != length($rq)) { 2133 warning("cannot send to $peer:$port ($!)."); 2134 } else { 2135 $0 = sprintf("%s - reading from %s port %s", $program, $peer, $port); 2136 eval { 2137 local $SIG{'ALRM'} = sub { die "timeout";}; 2138 alarm(opt('timeout')) if opt('timeout') > 0; 2139 while ($_ = <$sd>) { 2140 $0 = sprintf("%s - read from %s port %s", $program, $peer, $port); 2141 verbose("RECEIVE:", "%s", define($_, "<undefined>")); 2142 $reply .= $_ if defined $_; 2143 } 2144 if (opt('timeout') > 0) { 2145 alarm(0); 2146 } 2147 }; 2148 close($sd); 2149 2150 if ($@ and $@ =~ /timeout/) { 2151 warning("TIMEOUT: %s after %s seconds", $to, opt('timeout')); 2152 $reply = ''; 2153 } 2154 $reply = '' if !defined $reply; 2155 } 2156 } 2157 $0 = sprintf("%s - closed %s port %s", $program, $peer, $port); 2158 2159 ## during testing simulate reading the URL 2160 if (opt('test')) { 2161 my $filename = "$server/$url"; 2162 $filename =~ s|/|%2F|g; 2163 if (opt('exec')) { 2164 $reply = save_file("${savedir}$filename", $reply, 'unique'); 2165 } else { 2166 $reply = load_file("${savedir}$filename"); 2167 } 2168 } 2169 2170 $reply =~ s/\r//g if defined $reply; 2171 return $reply; 2172} 2173###################################################################### 2174## un_zero_pad 2175###################################################################### 2176sub un_zero_pad { 2177 my $in_str = shift(@_); 2178 my @out_str = (); 2179 2180 if ($in_str eq '0.0.0.0') { 2181 return $in_str; 2182 } 2183 2184 foreach my $block (split /\./, $in_str) { 2185 $block =~ s/^0+//; 2186 if ($block eq '') { 2187 $block = '0'; 2188 } 2189 push @out_str, $block; 2190 } 2191 return join('.', @out_str); 2192} 2193###################################################################### 2194## filter_local 2195###################################################################### 2196sub filter_local { 2197 my $in_ip = shift(@_); 2198 2199 if ($in_ip eq '0.0.0.0') { 2200 return $in_ip; 2201 } 2202 2203 my @guess_local = ( 2204 '^10\.', 2205 '^172\.(?:1[6-9]|2[0-9]|3[01])\.', 2206 '^192\.168' 2207 ); 2208 foreach my $block (@guess_local) { 2209 if ($in_ip =~ /$block/) { 2210 return '0.0.0.0'; 2211 } 2212 } 2213 return $in_ip; 2214} 2215###################################################################### 2216## get_ip 2217###################################################################### 2218sub get_ip { 2219 my $use = lc shift; 2220 my $h = shift; 2221 my ($ip, $arg, $reply, $url, $skip) = (undef, opt($use, $h), ''); 2222 $arg = '' unless $arg; 2223 2224 if ($use eq 'ip') { 2225 $ip = opt('ip', $h); 2226 $arg = 'ip'; 2227 2228 } elsif ($use eq 'if') { 2229 $skip = opt('if-skip', $h) || ''; 2230 $reply = `ifconfig $arg 2> /dev/null`; 2231 $reply = `ip addr list dev $arg 2> /dev/null` if $?; 2232 $reply = '' if $?; 2233 2234 } elsif ($use eq 'cmd') { 2235 if ($arg) { 2236 $skip = opt('cmd-skip', $h) || ''; 2237 $reply = `$arg`; 2238 $reply = '' if $?; 2239 } 2240 2241 } elsif ($use eq 'web') { 2242 $url = opt('web', $h) || ''; 2243 $skip = opt('web-skip', $h) || ''; 2244 2245 if (exists $builtinweb{$url}) { 2246 $skip = $builtinweb{$url}->{'skip'} unless $skip; 2247 $url = $builtinweb{$url}->{'url'}; 2248 } 2249 $arg = $url; 2250 2251 if ($url) { 2252 $reply = geturl(opt('proxy', $h), $url) || ''; 2253 } 2254 2255 } elsif (($use eq 'cisco')) { 2256 # Stuff added to support Cisco router ip http daemon 2257 # User fw-login should only have level 1 access to prevent 2258 # password theft. This is pretty harmless. 2259 my $queryif = opt('if', $h); 2260 $skip = opt('fw-skip', $h) || ''; 2261 2262 # Convert slashes to protected value "\/" 2263 $queryif =~ s%\/%\\\/%g; 2264 2265 # Protect special HTML characters (like '?') 2266 $queryif =~ s/([\?&= ])/sprintf("%%%02x",ord($1))/ge; 2267 2268 $url = "http://".opt('fw', $h)."/level/1/exec/show/ip/interface/brief/${queryif}/CR"; 2269 $reply = geturl('', $url, opt('fw-login', $h), opt('fw-password', $h)) || ''; 2270 $arg = $url; 2271 2272 } elsif (($use eq 'cisco-asa')) { 2273 # Stuff added to support Cisco ASA ip https daemon 2274 # User fw-login should only have level 1 access to prevent 2275 # password theft. This is pretty harmless. 2276 my $queryif = opt('if', $h); 2277 $skip = opt('fw-skip', $h) || ''; 2278 2279 # Convert slashes to protected value "\/" 2280 $queryif =~ s%\/%\\\/%g; 2281 2282 # Protect special HTML characters (like '?') 2283 $queryif =~ s/([\?&= ])/sprintf("%%%02x",ord($1))/ge; 2284 2285 $url = "https://".opt('fw', $h)."/exec/show%20interface%20${queryif}"; 2286 $reply = geturl('', $url, opt('fw-login', $h), opt('fw-password', $h)) || ''; 2287 $arg = $url; 2288 2289 } else { 2290 $url = opt('fw', $h) || ''; 2291 $skip = opt('fw-skip', $h) || ''; 2292 2293 if (exists $builtinfw{$use}) { 2294 $skip = $builtinfw{$use}->{'skip'} unless $skip; 2295 $url = "http://${url}" . $builtinfw{$use}->{'url'} unless $url =~ /\//; 2296 } 2297 $arg = $url; 2298 2299 if ($url) { 2300 $reply = geturl('', $url, opt('fw-login', $h), opt('fw-password', $h)) || ''; 2301 } 2302 } 2303 if (!defined $reply) { 2304 $reply = ''; 2305 } 2306 if ($skip) { 2307 $skip =~ s/ /\\s/is; 2308 $reply =~ s/^.*?${skip}//is; 2309 } 2310 if ($reply =~ /^.*?\b(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\b.*/is) { 2311 $ip = $1; 2312 $ip = un_zero_pad($ip); 2313 $ip = filter_local($ip) if opt('fw-banlocal', $h); 2314 } elsif ( $ip = ipv6_match($reply) ) { 2315 $ip = un_zero_pad($ip); 2316 $ip = filter_local($ip) if opt('fw-banlocal', $h); 2317 } else { 2318 warning("found neither ipv4 nor ipv6 address"); 2319 } 2320 if (($use ne 'ip') && (define($ip,'') eq '0.0.0.0')) { 2321 $ip = undef; 2322 } 2323 2324 debug("get_ip: using %s, %s reports %s", $use, $arg, define($ip, "<undefined>")); 2325 return $ip; 2326} 2327 2328###################################################################### 2329## ipv6_match determine ipv6 address from given string and return them 2330###################################################################### 2331sub ipv6_match { 2332 my $content = shift; 2333 my $omits; 2334 my $ip = ""; 2335 my $linenumbers = 0; 2336 2337 my @values = split('\n', $content); 2338 foreach my $val (@values) { 2339 next unless $val =~ /((:{0,2}[A-F0-9]{1,4}){0,7}:{1,2}[A-F0-9]{1,4})/ai; # invalid char 2340 my $parsed = $1; 2341 2342 # check for at least 7 colons 2343 my $count_colon = () = $parsed =~ /:/g; 2344 if ($count_colon != 7) { 2345 # or one double colon 2346 my $count_double_colon = () = $parsed =~ /::/g; 2347 if ($count_double_colon != 1) { 2348 next 2349 } 2350 } 2351 return $parsed; 2352 } 2353 return; 2354} 2355 2356###################################################################### 2357## group_hosts_by 2358###################################################################### 2359sub group_hosts_by { 2360 my ($hosts, $attributes) = @_; 2361 2362 my %groups = (); 2363 foreach my $h (@$hosts) { 2364 my @keys = (@$attributes, 'wantip'); 2365 map { $config{$h}{$_} = '' unless exists $config{$h}{$_} } @keys; 2366 my $sig = join(',', map { "$_=$config{$h}{$_}" } @keys); 2367 2368 push @{$groups{$sig}}, $h; 2369 } 2370 return %groups; 2371} 2372###################################################################### 2373## encode_www_form_urlencoded 2374###################################################################### 2375sub encode_www_form_urlencoded { 2376 my $formdata = shift; 2377 2378 my $must_encode = qr'[<>"#%{}|\\^~\[\]`;/?:=&+]'; 2379 my $encoded; 2380 my $i = 0; 2381 foreach my $k (keys %$formdata) { 2382 my $kenc = $k; 2383 my $venc = $formdata->{$k}; 2384 2385 $kenc =~ s/($must_encode)/sprintf('%%%02X', ord($1))/ge; 2386 $venc =~ s/($must_encode)/sprintf('%%%02X', ord($1))/ge; 2387 2388 $kenc =~ s/ /+/g; 2389 $venc =~ s/ /+/g; 2390 2391 $encoded .= $kenc.'='.$venc; 2392 if ($i < (keys %$formdata) - 1) { 2393 $encoded .= '&'; 2394 } 2395 $i++; 2396 } 2397 2398 return $encoded; 2399} 2400 2401###################################################################### 2402## nic_examples 2403###################################################################### 2404sub nic_examples { 2405 my $examples = ""; 2406 my $separator = ""; 2407 foreach my $s (sort keys %services) { 2408 my $subr = $services{$s}{'examples'}; 2409 my $example; 2410 2411 if (defined($subr) && ($example = &$subr())) { 2412 chomp($example); 2413 $examples .= $example; 2414 $examples .= "\n\n$separator"; 2415 $separator = "\n"; 2416 } 2417 } 2418 my $intro = <<EoEXAMPLE; 2419== CONFIGURING ${program} 2420 2421The configuration file, ${program}.conf, can be used to define the 2422default behaviour and operation of ${program}. The file consists of 2423sequences of global variable definitions and host definitions. 2424 2425Global definitions look like: 2426 name=value [,name=value]* 2427 2428For example: 2429 daemon=5m 2430 use=if, if=eth0 2431 proxy=proxy.myisp.com 2432 protocol=dyndns2 2433 2434specifies that ${program} should operate as a daemon, checking the 2435eth0 interface for an IP address change every 5 minutes and use the 2436'dyndns2' protocol by default. The daemon interval can be specified 2437as seconds (600s), minutes (5m), hours (1h) or days (1d). 2438 2439Host definitions look like: 2440 [name=value [,name=value]*]* a.host.domain [,b.host.domain] [login] [password] 2441 2442For example: 2443 protocol=hammernode1, \\ 2444 login=my-hn-login, password=my-hn-password myhost.hn.org 2445 login=my-login, password=my-password myhost.dyndns.org,my2nd.dyndns.org 2446 2447specifies two host definitions. 2448 2449The first definition will use the hammernode1 protocol, 2450my-hn-login and my-hn-password to update the ip-address of 2451myhost.hn.org and my2ndhost.hn.org. 2452 2453The second host definition will use the current default protocol 2454('dyndns2'), my-login and my-password to update the ip-address of 2455myhost.dyndns.org and my2ndhost.dyndns.org. 2456 2457The order of this sequence is significant because the values of any 2458global variable definitions are bound to a host definition when the 2459host definition is encountered. 2460 2461See the sample-${program}.conf file for further examples. 2462EoEXAMPLE 2463 $intro .= "\n== NIC specific variables and examples:\n$examples" if $examples; 2464 return $intro; 2465} 2466###################################################################### 2467## nic_updateable 2468###################################################################### 2469sub nic_updateable { 2470 my $host = shift; 2471 my $sub = shift; 2472 my $update = 0; 2473 my $ip = $config{$host}{'wantip'}; 2474 2475 if ($config{$host}{'login'} eq '') { 2476 warning("null login name specified for host %s.", $host); 2477 2478 } elsif ($config{$host}{'password'} eq '') { 2479 warning("null password specified for host %s.", $host); 2480 2481 } elsif ($opt{'force'}) { 2482 info("forcing update of %s.", $host); 2483 $update = 1; 2484 2485 } elsif (!exists($cache{$host})) { 2486 info("forcing updating %s because no cached entry exists.", $host); 2487 $update = 1; 2488 2489 } elsif ($cache{$host}{'wtime'} && $cache{$host}{'wtime'} > $now) { 2490 warning("cannot update %s from %s to %s until after %s.", 2491 $host, 2492 ($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'), $ip, 2493 prettytime($cache{$host}{'wtime'}) 2494 ); 2495 2496 } elsif ($cache{$host}{'mtime'} && interval_expired($host, 'mtime', 'max-interval')) { 2497 warning("forcing update of %s from %s to %s; %s since last update on %s.", 2498 $host, 2499 ($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'), $ip, 2500 prettyinterval($config{$host}{'max-interval'}), 2501 prettytime($cache{$host}{'mtime'}) 2502 ); 2503 $update = 1; 2504 2505 } elsif ((!exists($cache{$host}{'ip'})) || 2506 ("$cache{$host}{'ip'}" ne "$ip")) { 2507 if (($cache{$host}{'status'} eq 'good') && 2508 !interval_expired($host, 'mtime', 'min-interval')) { 2509 2510 warning("skipping update of %s from %s to %s.\nlast updated %s.\nWait at least %s between update attempts.", 2511 $host, 2512 ($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'), 2513 $ip, 2514 ($cache{$host}{'mtime'} ? prettytime($cache{$host}{'mtime'}) : '<never>'), 2515 prettyinterval($config{$host}{'min-interval'}) 2516 ) 2517 if opt('verbose') || !define($cache{$host}{'warned-min-interval'}, 0); 2518 2519 $cache{$host}{'warned-min-interval'} = $now; 2520 2521 } elsif (($cache{$host}{'status'} ne 'good') && !interval_expired($host, 'atime', 'min-error-interval')) { 2522 2523 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.", 2524 $host, 2525 ($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'), 2526 $ip, 2527 ($cache{$host}{'mtime'} ? prettytime($cache{$host}{'mtime'}) : '<never>'), 2528 ($cache{$host}{'atime'} ? prettytime($cache{$host}{'atime'}) : '<never>'), 2529 prettyinterval($config{$host}{'min-error-interval'}) 2530 ) 2531 if opt('verbose') || !define($cache{$host}{'warned-min-error-interval'}, 0); 2532 2533 $cache{$host}{'warned-min-error-interval'} = $now; 2534 2535 } else { 2536 $update = 1; 2537 } 2538 2539 } elsif (defined($sub) && &$sub($host)) { 2540 $update = 1; 2541 } elsif ((defined($cache{$host}{'static'}) && defined($config{$host}{'static'}) && 2542 ($cache{$host}{'static'} ne $config{$host}{'static'})) || 2543 (defined($cache{$host}{'wildcard'}) && defined($config{$host}{'wildcard'}) && 2544 ($cache{$host}{'wildcard'} ne $config{$host}{'wildcard'})) || 2545 (defined($cache{$host}{'mx'}) && defined($config{$host}{'mx'}) && 2546 ($cache{$host}{'mx'} ne $config{$host}{'mx'})) || 2547 (defined($cache{$host}{'backupmx'}) && defined($config{$host}{'backupmx'}) && 2548 ($cache{$host}{'backupmx'} ne $config{$host}{'backupmx'})) ) { 2549 info("updating %s because host settings have been changed.", $host); 2550 $update = 1; 2551 2552 } else { 2553 success("%s: skipped: IP address was already set to %s.", $host, $ip) 2554 if opt('verbose'); 2555 } 2556 $config{$host}{'status'} = define($cache{$host}{'status'},''); 2557 $config{$host}{'update'} = $update; 2558 if ($update) { 2559 $config{$host}{'status'} = 'noconnect'; 2560 $config{$host}{'atime'} = $now; 2561 $config{$host}{'wtime'} = 0; 2562 $config{$host}{'warned-min-interval'} = 0; 2563 $config{$host}{'warned-min-error-interval'} = 0; 2564 2565 delete $cache{$host}{'warned-min-interval'}; 2566 delete $cache{$host}{'warned-min-error-interval'}; 2567 } 2568 2569 return $update; 2570} 2571###################################################################### 2572## header_ok 2573###################################################################### 2574sub header_ok { 2575 my ($host, $line) = @_; 2576 my $ok = 0; 2577 2578 if ($line =~ m%^s*HTTP/1.*\s+(\d+)%i) { 2579 my $result = $1; 2580 2581 if ($result eq '200') { 2582 $ok = 1; 2583 2584 } elsif ($result eq '401') { 2585 failed("updating %s: authorization failed (%s)", $host, $line); 2586 } 2587 2588 } else { 2589 failed("updating %s: unexpected line (%s)", $host, $line); 2590 } 2591 return $ok; 2592} 2593###################################################################### 2594## nic_dyndns1_examples 2595###################################################################### 2596sub nic_dyndns1_examples { 2597 return <<EoEXAMPLE; 2598o 'dyndns1' 2599 2600The 'dyndns1' protocol is a deprecated protocol used by the free dynamic 2601DNS service offered by www.dyndns.org. The 'dyndns2' should be used to 2602update the www.dyndns.org service. However, other services are also 2603using this protocol so support is still provided by ${program}. 2604 2605Configuration variables applicable to the 'dyndns1' protocol are: 2606 protocol=dyndns1 ## 2607 server=fqdn.of.service ## defaults to members.dyndns.org 2608 backupmx=no|yes ## indicates that this host is the primary MX for the domain. 2609 mx=any.host.domain ## a host MX'ing for this host definition. 2610 wildcard=no|yes ## add a DNS wildcard CNAME record that points to {host} 2611 login=service-login ## login name and password registered with the service 2612 password=service-password ## 2613 fully.qualified.host ## the host registered with the service. 2614 2615Example ${program}.conf file entries: 2616 ## single host update 2617 protocol=dyndns1, \\ 2618 login=my-dyndns.org-login, \\ 2619 password=my-dyndns.org-password \\ 2620 myhost.dyndns.org 2621 2622 ## multiple host update with wildcard'ing mx, and backupmx 2623 protocol=dyndns1, \\ 2624 login=my-dyndns.org-login, \\ 2625 password=my-dyndns.org-password, \\ 2626 mx=a.host.willing.to.mx.for.me,backupmx=yes,wildcard=yes \\ 2627 myhost.dyndns.org,my2ndhost.dyndns.org 2628EoEXAMPLE 2629} 2630###################################################################### 2631## nic_dyndns1_update 2632###################################################################### 2633sub nic_dyndns1_update { 2634 debug("\nnic_dyndns1_update -------------------"); 2635 ## update each configured host 2636 foreach my $h (@_) { 2637 my $ip = delete $config{$h}{'wantip'}; 2638 info("setting IP address to %s for %s", $ip, $h); 2639 verbose("UPDATE:","updating %s", $h); 2640 2641 my $url; 2642 $url = "http://$config{$h}{'server'}/nic/"; 2643 $url .= ynu($config{$h}{'static'}, 'statdns', 'dyndns', 'dyndns'); 2644 $url .= "?action=edit&started=1&hostname=YES&host_id=$h"; 2645 $url .= "&myip="; 2646 $url .= $ip if $ip; 2647 $url .= "&wildcard=ON" if ynu($config{$h}{'wildcard'}, 1, 0, 0); 2648 if ($config{$h}{'mx'}) { 2649 $url .= "&mx=$config{$h}{'mx'}"; 2650 $url .= "&backmx=" . ynu($config{$h}{'backupmx'}, 'YES', 'NO'); 2651 } 2652 2653 my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'}); 2654 if (!defined($reply) || !$reply) { 2655 failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); 2656 next; 2657 } 2658 last if !header_ok($h, $reply); 2659 2660 my @reply = split /\n/, $reply; 2661 my ($title, $return_code, $error_code) = ('','',''); 2662 foreach my $line (@reply) { 2663 $title = $1 if $line =~ m%<TITLE>\s*(.*)\s*</TITLE>%i; 2664 $return_code = $1 if $line =~ m%^return\s+code\s*:\s*(.*)\s*$%i; 2665 $error_code = $1 if $line =~ m%^error\s+code\s*:\s*(.*)\s*$%i; 2666 } 2667 2668 if ($return_code ne 'NOERROR' || $error_code ne 'NOERROR' || !$title) { 2669 $config{$h}{'status'} = 'failed'; 2670 $title = "incomplete response from $config{$h}{server}" unless $title; 2671 warning("SENT: %s", $url) unless opt('verbose'); 2672 warning("REPLIED: %s", $reply); 2673 failed("updating %s: %s", $h, $title); 2674 2675 } else { 2676 $config{$h}{'ip'} = $ip; 2677 $config{$h}{'mtime'} = $now; 2678 $config{$h}{'status'} = 'good'; 2679 success("updating %s: %s: IP address set to %s (%s)", $h, $return_code, $ip, $title); 2680 } 2681 } 2682} 2683###################################################################### 2684## nic_dyndns2_updateable 2685###################################################################### 2686sub nic_dyndns2_updateable { 2687 my $host = shift; 2688 my $update = 0; 2689 2690 if ($config{$host}{'mx'} ne $cache{$host}{'mx'}) { 2691 info("forcing updating %s because 'mx' has changed to %s.", $host, $config{$host}{'mx'}); 2692 $update = 1; 2693 2694 } elsif ($config{$host}{'mx'} && (ynu($config{$host}{'backupmx'},1,2,3) ne ynu($config{$host}{'backupmx'},1,2,3))) { 2695 info("forcing updating %s because 'backupmx' has changed to %s.", $host, ynu($config{$host}{'backupmx'},"YES","NO","NO")); 2696 $update = 1; 2697 2698 } elsif ($config{$host}{'static'} ne $cache{$host}{'static'}) { 2699 2700 info("forcing updating %s because 'static' has changed to %s.", $host, ynu($config{$host}{'static'},"YES","NO","NO")); 2701 $update = 1; 2702 2703 } 2704 return $update; 2705} 2706###################################################################### 2707## nic_dyndns2_examples 2708###################################################################### 2709sub nic_dyndns2_examples { 2710 return <<EoEXAMPLE; 2711o 'dyndns2' 2712 2713The 'dyndns2' protocol is a newer low-bandwidth protocol used by a 2714free dynamic DNS service offered by www.dyndns.org. It supports 2715features of the older 'dyndns1' in addition to others. [These will be 2716supported in a future version of ${program}.] 2717 2718Configuration variables applicable to the 'dyndns2' protocol are: 2719 protocol=dyndns2 ## 2720 server=fqdn.of.service ## defaults to members.dyndns.org 2721 script=/path/to/script ## defaults to /nic/update 2722 backupmx=no|yes ## indicates that this host is the primary MX for the domain. 2723 static=no|yes ## indicates that this host has a static IP address. 2724 custom=no|yes ## indicates that this host is a 'custom' top-level domain name. 2725 mx=any.host.domain ## a host MX'ing for this host definition. 2726 wildcard=no|yes ## add a DNS wildcard CNAME record that points to {host} 2727 login=service-login ## login name and password registered with the service 2728 password=service-password ## 2729 fully.qualified.host ## the host registered with the service. 2730 2731Example ${program}.conf file entries: 2732 ## single host update 2733 protocol=dyndns2, \\ 2734 login=my-dyndns.org-login, \\ 2735 password=my-dyndns.org-password \\ 2736 myhost.dyndns.org 2737 2738 ## multiple host update with wildcard'ing mx, and backupmx 2739 protocol=dyndns2, \\ 2740 login=my-dyndns.org-login, \\ 2741 password=my-dyndns.org-password, \\ 2742 mx=a.host.willing.to.mx.for.me,backupmx=yes,wildcard=yes \\ 2743 myhost.dyndns.org,my2ndhost.dyndns.org 2744 2745 ## multiple host update to the custom DNS service 2746 protocol=dyndns2, \\ 2747 login=my-dyndns.org-login, \\ 2748 password=my-dyndns.org-password \\ 2749 my-toplevel-domain.com,my-other-domain.com 2750EoEXAMPLE 2751} 2752###################################################################### 2753## nic_dyndns2_update 2754###################################################################### 2755sub nic_dyndns2_update { 2756 debug("\nnic_dyndns2_update -------------------"); 2757 2758 ## group hosts with identical attributes together 2759 my %groups = group_hosts_by([ @_ ], [ qw(login password server static custom wildcard mx backupmx) ]); 2760 2761 my %errors = ( 2762 'badauth' => 'Bad authorization (username or password)', 2763 'badsys' => 'The system parameter given was not valid', 2764 2765 'notfqdn' => 'A Fully-Qualified Domain Name was not provided', 2766 'nohost' => 'The hostname specified does not exist in the database', 2767 '!yours' => 'The hostname specified exists, but not under the username currently being used', 2768 '!donator' => 'The offline setting was set, when the user is not a donator', 2769 '!active' => 'The hostname specified is in a Custom DNS domain which has not yet been activated.', 2770 'abuse', => 'The hostname specified is blocked for abuse; you should receive an email notification ' . 2771 'which provides an unblock request link. More info can be found on ' . 2772 'https://www.dyndns.com/support/abuse.html', 2773 2774 'numhost' => 'System error: Too many or too few hosts found. Contact support@dyndns.org', 2775 'dnserr' => 'System error: DNS error encountered. Contact support@dyndns.org', 2776 2777 'nochg' => 'No update required; unnecessary attempts to change to the current address are considered abusive', 2778 ); 2779 2780 ## update each set of hosts that had similar configurations 2781 foreach my $sig (keys %groups) { 2782 my @hosts = @{$groups{$sig}}; 2783 my $hosts = join(',', @hosts); 2784 my $h = $hosts[0]; 2785 my $ip = $config{$h}{'wantip'}; 2786 delete $config{$_}{'wantip'} foreach @hosts; 2787 2788 info("setting IP address to %s for %s", $ip, $hosts); 2789 verbose("UPDATE:","updating %s", $hosts); 2790 2791 ## Select the DynDNS system to update 2792 my $url = "http://$config{$h}{'server'}$config{$h}{'script'}?system="; 2793 if ($config{$h}{'custom'}) { 2794 warning("updating %s: 'custom' and 'static' may not be used together. ('static' ignored)", $hosts) 2795 if $config{$h}{'static'}; 2796# warning("updating %s: 'custom' and 'offline' may not be used together. ('offline' ignored)", $hosts) 2797# if $config{$h}{'offline'}; 2798 $url .= 'custom'; 2799 2800 } elsif ($config{$h}{'static'}) { 2801# warning("updating %s: 'static' and 'offline' may not be used together. ('offline' ignored)", $hosts) 2802# if $config{$h}{'offline'}; 2803 $url .= 'statdns'; 2804 2805 } else { 2806 $url .= 'dyndns'; 2807 } 2808 2809 $url .= "&hostname=$hosts"; 2810 $url .= "&myip="; 2811 $url .= $ip if $ip; 2812 2813 ## some args are not valid for a custom domain. 2814 $url .= "&wildcard=ON" if ynu($config{$h}{'wildcard'}, 1, 0, 0); 2815 if ($config{$h}{'mx'}) { 2816 $url .= "&mx=$config{$h}{'mx'}"; 2817 $url .= "&backmx=" . ynu($config{$h}{'backupmx'}, 'YES', 'NO'); 2818 } 2819 2820 my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'}); 2821 if (!defined($reply) || !$reply) { 2822 failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'}); 2823 last; 2824 } 2825 last if !header_ok($hosts, $reply); 2826 2827 my @reply = split /\n/, $reply; 2828 my $state = 'header'; 2829 my $returnedip = $ip; 2830 2831 foreach my $line (@reply) { 2832 if ($state eq 'header') { 2833 $state = 'body'; 2834 2835 } elsif ($state eq 'body') { 2836 $state = 'results' if $line eq ''; 2837 2838 } elsif ($state =~ /^results/) { 2839 $state = 'results2'; 2840 2841 # bug #10: some dyndns providers does not return the IP so 2842 # we can't use the returned IP 2843 my ($status, $returnedip) = split / /, lc $line; 2844 $ip = $returnedip if (not $ip); 2845 my $h = shift @hosts; 2846 2847 $config{$h}{'status'} = $status; 2848 if ($status eq 'good') { 2849 $config{$h}{'ip'} = $ip; 2850 $config{$h}{'mtime'} = $now; 2851 success("updating %s: %s: IP address set to %s", $h, $status, $ip); 2852 2853 } elsif (exists $errors{$status}) { 2854 if ($status eq 'nochg') { 2855 warning("updating %s: %s: %s", $h, $status, $errors{$status}); 2856 $config{$h}{'ip'} = $ip; 2857 $config{$h}{'mtime'} = $now; 2858 $config{$h}{'status'} = 'good'; 2859 2860 } else { 2861 failed("updating %s: %s: %s", $h, $status, $errors{$status}); 2862 } 2863 2864 } elsif ($status =~ /w(\d+)(.)/) { 2865 my ($wait, $units) = ($1, lc $2); 2866 my ($sec, $scale) = ($wait, 1); 2867 2868 ($scale, $units) = (1, 'seconds') if $units eq 's'; 2869 ($scale, $units) = (60, 'minutes') if $units eq 'm'; 2870 ($scale, $units) = (60*60, 'hours') if $units eq 'h'; 2871 2872 $sec = $wait * $scale; 2873 $config{$h}{'wtime'} = $now + $sec; 2874 warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip); 2875 2876 } else { 2877 failed("updating %s: %s: unexpected status (%s)", $h, $line); 2878 } 2879 } 2880 } 2881 failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'}) 2882 if $state ne 'results2'; 2883 } 2884} 2885 2886 2887###################################################################### 2888## nic_noip_update 2889## Note: uses same features as nic_dyndns2_update, less return codes 2890###################################################################### 2891sub nic_noip_update { 2892 debug("\nnic_noip_update -------------------"); 2893 2894 ## group hosts with identical attributes together 2895 my %groups = group_hosts_by([ @_ ], [ qw(login password server static custom wildcard mx backupmx) ]); 2896 2897 my %errors = ( 2898 'badauth' => 'Invalid username or password', 2899 'badagent' => 'Invalid user agent', 2900 'nohost' => 'The hostname specified does not exist in the database', 2901 '!donator' => 'The offline setting was set, when the user is not a donator', 2902 'abuse', => 'The hostname specified is blocked for abuse; open a trouble ticket at http://www.no-ip.com', 2903 'numhost' => 'System error: Too many or too few hosts found. open a trouble ticket at http://www.no-ip.com', 2904 'dnserr' => 'System error: DNS error encountered. Contact support@dyndns.org', 2905 'nochg' => 'No update required; unnecessary attempts to change to the current address are considered abusive', 2906 ); 2907 2908 ## update each set of hosts that had similar configurations 2909 foreach my $sig (keys %groups) { 2910 my @hosts = @{$groups{$sig}}; 2911 my $hosts = join(',', @hosts); 2912 my $h = $hosts[0]; 2913 my $ip = $config{$h}{'wantip'}; 2914 delete $config{$_}{'wantip'} foreach @hosts; 2915 2916 info("setting IP address to %s for %s", $ip, $hosts); 2917 verbose("UPDATE:","updating %s", $hosts); 2918 2919 my $url = "http://$config{$h}{'server'}/nic/update?system="; 2920 $url .= 'noip'; 2921 $url .= "&hostname=$hosts"; 2922 $url .= "&myip="; 2923 $url .= $ip if $ip; 2924 2925 my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'}); 2926 if (!defined($reply) || !$reply) { 2927 failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'}); 2928 last; 2929 } 2930 last if !header_ok($hosts, $reply); 2931 2932 my @reply = split /\n/, $reply; 2933 my $state = 'header'; 2934 foreach my $line (@reply) { 2935 if ($state eq 'header') { 2936 $state = 'body'; 2937 2938 } elsif ($state eq 'body') { 2939 $state = 'results' if $line eq ''; 2940 2941 } elsif ($state =~ /^results/) { 2942 $state = 'results2'; 2943 2944 my ($status, $ip) = split / /, lc $line; 2945 my $h = shift @hosts; 2946 2947 $config{$h}{'status'} = $status; 2948 if ($status eq 'good') { 2949 $config{$h}{'ip'} = $ip; 2950 $config{$h}{'mtime'} = $now; 2951 success("updating %s: %s: IP address set to %s", $h, $status, $ip); 2952 2953 } elsif (exists $errors{$status}) { 2954 if ($status eq 'nochg') { 2955 warning("updating %s: %s: %s", $h, $status, $errors{$status}); 2956 $config{$h}{'ip'} = $ip; 2957 $config{$h}{'mtime'} = $now; 2958 $config{$h}{'status'} = 'good'; 2959 2960 } else { 2961 failed("updating %s: %s: %s", $h, $status, $errors{$status}); 2962 } 2963 2964 } elsif ($status =~ /w(\d+)(.)/) { 2965 my ($wait, $units) = ($1, lc $2); 2966 my ($sec, $scale) = ($wait, 1); 2967 2968 ($scale, $units) = (1, 'seconds') if $units eq 's'; 2969 ($scale, $units) = (60, 'minutes') if $units eq 'm'; 2970 ($scale, $units) = (60*60, 'hours') if $units eq 'h'; 2971 2972 $sec = $wait * $scale; 2973 $config{$h}{'wtime'} = $now + $sec; 2974 warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip); 2975 2976 } else { 2977 failed("updating %s: %s: unexpected status (%s)", $h, $line); 2978 } 2979 } 2980 } 2981 failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'}) 2982 if $state ne 'results2'; 2983 } 2984} 2985###################################################################### 2986## nic_noip_examples 2987###################################################################### 2988sub nic_noip_examples { 2989 return <<EoEXAMPLE; 2990o 'noip' 2991 2992The 'No-IP Compatible' protocol is used to make dynamic dns updates 2993over an http request. Details of the protocol are outlined at: 2994http://www.no-ip.com/integrate/ 2995 2996Configuration variables applicable to the 'noip' protocol are: 2997 protocol=noip ## 2998 server=fqdn.of.service ## defaults to dynupdate.no-ip.com 2999 login=service-login ## login name and password registered with the service 3000 password=service-password ## 3001 fully.qualified.host ## the host registered with the service. 3002 3003Example ${program}.conf file entries: 3004 ## single host update 3005 protocol=noip, \\ 3006 login=userlogin\@domain.com, \\ 3007 password=noip-password \\ 3008 myhost.no-ip.biz 3009 3010 3011EoEXAMPLE 3012} 3013 3014###################################################################### 3015## nic_concont_examples 3016###################################################################### 3017sub nic_concont_examples { 3018 return <<EoEXAMPLE; 3019o 'concont' 3020 3021The 'concont' protocol is the protocol used by the content management 3022system ConCont's dydns module. This is currently used by the free 3023dynamic DNS service offered by Tyrmida at www.dydns.za.net 3024 3025Configuration variables applicable to the 'concont' protocol are: 3026 protocol=concont ## 3027 server=www.fqdn.of.service ## for example www.dydns.za.net (for most add a www) 3028 login=service-login ## login registered with the service 3029 password=service-password ## password registered with the service 3030 mx=mail.server.fqdn ## fqdn of the server handling domain\'s mail (leave out for none) 3031 wildcard=yes|no ## set yes for wild (*.host.domain) support 3032 fully.qualified.host ## the host registered with the service. 3033 3034Example ${program}.conf file entries: 3035 ## single host update 3036 protocol=concont, \\ 3037 login=dydns.za.net, \\ 3038 password=my-dydns.za.net-password, \\ 3039 mx=mailserver.fqdn, \\ 3040 wildcard=yes \\ 3041 myhost.hn.org 3042 3043EoEXAMPLE 3044} 3045###################################################################### 3046## nic_concont_update 3047###################################################################### 3048sub nic_concont_update { 3049 debug("\nnic_concont_update -------------------"); 3050 3051 ## update each configured host 3052 foreach my $h (@_) { 3053 my $ip = delete $config{$h}{'wantip'}; 3054 info("setting IP address to %s for %s", $ip, $h); 3055 verbose("UPDATE:","updating %s", $h); 3056 3057 # Set the URL that we're going to to update 3058 my $url; 3059 $url = "http://$config{$h}{'server'}/modules/dydns/update.php"; 3060 $url .= "?username="; 3061 $url .= $config{$h}{'login'}; 3062 $url .= "&password="; 3063 $url .= $config{$h}{'password'}; 3064 $url .= "&wildcard="; 3065 $url .= $config{$h}{'wildcard'}; 3066 $url .= "&mx="; 3067 $url .= $config{$h}{'mx'}; 3068 $url .= "&host="; 3069 $url .= $h; 3070 $url .= "&ip="; 3071 $url .= $ip; 3072 3073 # Try to get URL 3074 my $reply = geturl(opt('proxy'), $url); 3075 3076 # No response, declare as failed 3077 if (!defined($reply) || !$reply) { 3078 failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); 3079 last; 3080 } 3081 last if !header_ok($h, $reply); 3082 3083 # Response found, just declare as success (this is ugly, we need more error checking) 3084 if ($reply =~ /SUCCESS/) 3085 { 3086 $config{$h}{'ip'} = $ip; 3087 $config{$h}{'mtime'} = $now; 3088 $config{$h}{'status'} = 'good'; 3089 success("updating %s: good: IP address set to %s", $h, $ip); 3090 } 3091 else 3092 { 3093 my @reply = split /\n/, $reply; 3094 my $returned = pop(@reply); 3095 $config{$h}{'status'} = 'failed'; 3096 failed("updating %s: Server said: '$returned'", $h); 3097 } 3098 } 3099} 3100###################################################################### 3101## nic_dslreports1_examples 3102###################################################################### 3103sub nic_dslreports1_examples { 3104 return <<EoEXAMPLE; 3105o 'dslreports1' 3106 3107The 'dslreports1' protocol is used by a free DSL monitoring service 3108offered by www.dslreports.com. 3109 3110Configuration variables applicable to the 'dslreports1' protocol are: 3111 protocol=dslreports1 ## 3112 server=fqdn.of.service ## defaults to www.dslreports.com 3113 login=service-login ## login name and password registered with the service 3114 password=service-password ## 3115 unique-number ## the host registered with the service. 3116 3117Example ${program}.conf file entries: 3118 ## single host update 3119 protocol=dslreports1, \\ 3120 server=www.dslreports.com, \\ 3121 login=my-dslreports-login, \\ 3122 password=my-dslreports-password \\ 3123 123456 3124 3125Note: DSL Reports uses a unique number as the host name. This number 3126can be found on the Monitor Control web page. 3127EoEXAMPLE 3128} 3129###################################################################### 3130## nic_dslreports1_update 3131###################################################################### 3132sub nic_dslreports1_update { 3133 debug("\nnic_dslreports1_update -------------------"); 3134 ## update each configured host 3135 foreach my $h (@_) { 3136 my $ip = delete $config{$h}{'wantip'}; 3137 info("setting IP address to %s for %s", $ip, $h); 3138 verbose("UPDATE:","updating %s", $h); 3139 3140 my $url; 3141 $url = "http://$config{$h}{'server'}/nic/"; 3142 $url .= ynu($config{$h}{'static'}, 'statdns', 'dyndns', 'dyndns'); 3143 $url .= "?action=edit&started=1&hostname=YES&host_id=$h"; 3144 $url .= "&myip="; 3145 $url .= $ip if $ip; 3146 3147 my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'}); 3148 if (!defined($reply) || !$reply) { 3149 failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); 3150 next; 3151 } 3152 3153 my @reply = split /\n/, $reply; 3154 my $return_code = ''; 3155 foreach my $line (@reply) { 3156 $return_code = $1 if $line =~ m%^return\s+code\s*:\s*(.*)\s*$%i; 3157 } 3158 3159 if ($return_code !~ /NOERROR/) { 3160 $config{$h}{'status'} = 'failed'; 3161 warning("SENT: %s", $url) unless opt('verbose'); 3162 warning("REPLIED: %s", $reply); 3163 failed("updating %s", $h); 3164 3165 } else { 3166 $config{$h}{'ip'} = $ip; 3167 $config{$h}{'mtime'} = $now; 3168 $config{$h}{'status'} = 'good'; 3169 success("updating %s: %s: IP address set to %s", $h, $return_code, $ip); 3170 } 3171 } 3172} 3173###################################################################### 3174## nic_hammernode1_examples 3175###################################################################### 3176sub nic_hammernode1_examples { 3177 return <<EoEXAMPLE; 3178o 'hammernode1' 3179 3180The 'hammernode1' protocol is the protocol used by the free dynamic 3181DNS service offered by Hammernode at www.hn.org 3182 3183Configuration variables applicable to the 'hammernode1' protocol are: 3184 protocol=hammernode1 ## 3185 server=fqdn.of.service ## defaults to members.dyndns.org 3186 login=service-login ## login name and password registered with the service 3187 password=service-password ## 3188 fully.qualified.host ## the host registered with the service. 3189 3190Example ${program}.conf file entries: 3191 ## single host update 3192 protocol=hammernode1, \\ 3193 login=my-hn.org-login, \\ 3194 password=my-hn.org-password \\ 3195 myhost.hn.org 3196 3197 ## multiple host update 3198 protocol=hammernode1, \\ 3199 login=my-hn.org-login, \\ 3200 password=my-hn.org-password, \\ 3201 myhost.hn.org,my2ndhost.hn.org 3202EoEXAMPLE 3203} 3204###################################################################### 3205## nic_hammernode1_update 3206###################################################################### 3207sub nic_hammernode1_update { 3208 debug("\nnic_hammernode1_update -------------------"); 3209 3210 ## update each configured host 3211 foreach my $h (@_) { 3212 my $ip = delete $config{$h}{'wantip'}; 3213 info("setting IP address to %s for %s", $ip, $h); 3214 verbose("UPDATE:","updating %s", $h); 3215 3216 my $url; 3217 $url = "http://$config{$h}{'server'}/vanity/update"; 3218 $url .= "?ver=1"; 3219 $url .= "&ip="; 3220 $url .= $ip if $ip; 3221 3222 my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'}); 3223 if (!defined($reply) || !$reply) { 3224 failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); 3225 last; 3226 } 3227 last if !header_ok($h, $reply); 3228 3229 my @reply = split /\n/, $reply; 3230 if (grep /<!--\s+DDNS_Response_Code=101\s+-->/i, @reply) { 3231 $config{$h}{'ip'} = $ip; 3232 $config{$h}{'mtime'} = $now; 3233 $config{$h}{'status'} = 'good'; 3234 success("updating %s: good: IP address set to %s", $h, $ip); 3235 } else { 3236 $config{$h}{'status'} = 'failed'; 3237 warning("SENT: %s", $url) unless opt('verbose'); 3238 warning("REPLIED: %s", $reply); 3239 failed("updating %s: Invalid reply.", $h); 3240 } 3241 } 3242} 3243###################################################################### 3244## nic_zoneedit1_examples 3245###################################################################### 3246sub nic_zoneedit1_examples { 3247 return <<EoEXAMPLE; 3248o 'zoneedit1' 3249 3250The 'zoneedit1' protocol is used by a DNS service offered by 3251www.zoneedit.com. 3252 3253Configuration variables applicable to the 'zoneedit1' protocol are: 3254 protocol=zoneedit1 ## 3255 server=fqdn.of.service ## defaults to www.zoneedit.com 3256 zone=zone-where-domains-are ## only needed if 1 or more subdomains are deeper 3257 ## than 1 level in relation to the zone where it 3258 ## is defined. For example, b.foo.com in a zone 3259 ## foo.com doesn't need this, but a.b.foo.com in 3260 ## the same zone needs zone=foo.com 3261 login=service-login ## login name and password registered with the service 3262 password=service-password ## 3263 your.domain.name ## the host registered with the service. 3264 3265Example ${program}.conf file entries: 3266 ## single host update 3267 protocol=zoneedit1, \\ 3268 server=dynamic.zoneedit.com, \\ 3269 zone=zone-where-domains-are, \\ 3270 login=my-zoneedit-login, \\ 3271 password=my-zoneedit-password \\ 3272 my.domain.name 3273EoEXAMPLE 3274} 3275 3276###################################################################### 3277## nic_zoneedit1_updateable 3278###################################################################### 3279sub nic_zoneedit1_updateable { 3280 return 0; 3281} 3282 3283###################################################################### 3284## nic_zoneedit1_update 3285# <SUCCESS CODE="200" TEXT="Update succeeded." ZONE="trialdomain.com" IP="127.0.0.12"> 3286# <SUCCESS CODE="201" TEXT="No records need updating." ZONE="bannedware.com"> 3287# <ERROR CODE="701" TEXT="Zone is not set up in this account." ZONE="bad.com"> 3288###################################################################### 3289sub nic_zoneedit1_update { 3290 debug("\nnic_zoneedit1_update -------------------"); 3291 3292 ## group hosts with identical attributes together 3293 my %groups = group_hosts_by([ @_ ], [ qw(login password server zone) ]); 3294 3295 ## update each set of hosts that had similar configurations 3296 foreach my $sig (keys %groups) { 3297 my @hosts = @{$groups{$sig}}; 3298 my $hosts = join(',', @hosts); 3299 my $h = $hosts[0]; 3300 my $ip = $config{$h}{'wantip'}; 3301 delete $config{$_}{'wantip'} foreach @hosts; 3302 3303 info("setting IP address to %s for %s", $ip, $hosts); 3304 verbose("UPDATE:","updating %s", $hosts); 3305 3306 my $url = ''; 3307 $url .= "http://$config{$h}{'server'}/auth/dynamic.html"; 3308 $url .= "?host=$hosts"; 3309 $url .= "&dnsto=$ip" if $ip; 3310 $url .= "&zone=$config{$h}{'zone'}" if defined $config{$h}{'zone'}; 3311 3312 my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'}); 3313 if (!defined($reply) || !$reply) { 3314 failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'}); 3315 last; 3316 } 3317 last if !header_ok($hosts, $reply); 3318 3319 my @reply = split /\n/, $reply; 3320 foreach my $line (@reply) { 3321 if ($line =~ /^[^<]*<(SUCCESS|ERROR)\s+([^>]+)>(.*)/) { 3322 my ($status, $assignments, $rest) = ($1, $2, $3); 3323 my ($left, %var) = parse_assignments($assignments); 3324 3325 if (keys %var) { 3326 my ($status_code, $status_text, $status_ip) = ('999', '', $ip); 3327 $status_code = $var{'CODE'} if exists $var{'CODE'}; 3328 $status_text = $var{'TEXT'} if exists $var{'TEXT'}; 3329 $status_ip = $var{'IP'} if exists $var{'IP'}; 3330 3331 if ($status eq 'SUCCESS' || ($status eq 'ERROR' && $var{'CODE'} eq '707')) { 3332 $config{$h}{'ip'} = $status_ip; 3333 $config{$h}{'mtime'} = $now; 3334 $config{$h}{'status'} = 'good'; 3335 3336 success("updating %s: IP address set to %s (%s: %s)", $h, $ip, $status_code, $status_text); 3337 3338 } else { 3339 $config{$h}{'status'} = 'failed'; 3340 failed("updating %s: %s: %s", $h, $status_code, $status_text); 3341 } 3342 shift @hosts; 3343 $h = $hosts[0]; 3344 $hosts = join(',', @hosts); 3345 } 3346 $line = $rest; 3347 redo if $line; 3348 } 3349 } 3350 failed("updating %s: no response from %s", $hosts, $config{$h}{'server'}) 3351 if @hosts; 3352 } 3353} 3354###################################################################### 3355## nic_easydns_updateable 3356###################################################################### 3357sub nic_easydns_updateable { 3358 my $host = shift; 3359 my $update = 0; 3360 3361 if ($config{$host}{'mx'} ne $cache{$host}{'mx'}) { 3362 info("forcing updating %s because 'mx' has changed to %s.", $host, $config{$host}{'mx'}); 3363 $update = 1; 3364 3365 } elsif ($config{$host}{'mx'} && (ynu($config{$host}{'backupmx'},1,2,3) ne ynu($config{$host}{'backupmx'},1,2,3))) { 3366 info("forcing updating %s because 'backupmx' has changed to %s.", $host, ynu($config{$host}{'backupmx'},"YES","NO","NO")); 3367 $update = 1; 3368 3369 } elsif ($config{$host}{'static'} ne $cache{$host}{'static'}) { 3370 3371 info("forcing updating %s because 'static' has changed to %s.", $host, ynu($config{$host}{'static'},"YES","NO","NO")); 3372 $update = 1; 3373 3374 } 3375 return $update; 3376} 3377###################################################################### 3378## nic_easydns_examples 3379###################################################################### 3380sub nic_easydns_examples { 3381 return <<EoEXAMPLE; 3382o 'easydns' 3383 3384The 'easydns' protocol is used by the for fee DNS service offered 3385by www.easydns.com. 3386 3387Configuration variables applicable to the 'easydns' protocol are: 3388 protocol=easydns ## 3389 server=fqdn.of.service ## defaults to members.easydns.com 3390 backupmx=no|yes ## indicates that EasyDNS should be the secondary MX 3391 ## for this domain or host. 3392 mx=any.host.domain ## a host MX'ing for this host or domain. 3393 wildcard=no|yes ## add a DNS wildcard CNAME record that points to {host} 3394 login=service-login ## login name and password registered with the service 3395 password=service-password ## 3396 fully.qualified.host ## the host registered with the service. 3397 3398Example ${program}.conf file entries: 3399 ## single host update 3400 protocol=easydns, \\ 3401 login=my-easydns.com-login, \\ 3402 password=my-easydns.com-password \\ 3403 myhost.easydns.com 3404 3405 ## multiple host update with wildcard'ing mx, and backupmx 3406 protocol=easydns, \\ 3407 login=my-easydns.com-login, \\ 3408 password=my-easydns.com-password, \\ 3409 mx=a.host.willing.to.mx.for.me, \\ 3410 backupmx=yes, \\ 3411 wildcard=yes \\ 3412 my-toplevel-domain.com,my-other-domain.com 3413 3414 ## multiple host update to the custom DNS service 3415 protocol=easydns, \\ 3416 login=my-easydns.com-login, \\ 3417 password=my-easydns.com-password \\ 3418 my-toplevel-domain.com,my-other-domain.com 3419EoEXAMPLE 3420} 3421###################################################################### 3422## nic_easydns_update 3423###################################################################### 3424sub nic_easydns_update { 3425 debug("\nnic_easydns_update -------------------"); 3426 3427 ## group hosts with identical attributes together 3428 ## my %groups = group_hosts_by([ @_ ], [ qw(login password server wildcard mx backupmx) ]); 3429 3430 ## each host is in a group by itself 3431 my %groups = map { $_ => [ $_ ] } @_; 3432 3433 my %errors = ( 3434 'NOACCESS' => 'Authentication failed. This happens if the username/password OR host or domain are wrong.', 3435 'NOSERVICE'=> 'Dynamic DNS is not turned on for this domain.', 3436 'ILLEGAL' => 'Client sent data that is not allowed in a dynamic DNS update.', 3437 'TOOSOON' => 'Update frequency is too short.', 3438 ); 3439 3440 ## update each set of hosts that had similar configurations 3441 foreach my $sig (keys %groups) { 3442 my @hosts = @{$groups{$sig}}; 3443 my $hosts = join(',', @hosts); 3444 my $h = $hosts[0]; 3445 my $ip = $config{$h}{'wantip'}; 3446 delete $config{$_}{'wantip'} foreach @hosts; 3447 3448 info("setting IP address to %s for %s", $ip, $hosts); 3449 verbose("UPDATE:","updating %s", $hosts); 3450 3451 #'http://members.easydns.com/dyn/dyndns.php?hostname=test.burry.ca&myip=10.20.30.40&wildcard=ON' 3452 3453 my $url; 3454 $url = "http://$config{$h}{'server'}/dyn/dyndns.php?"; 3455 $url .= "hostname=$hosts"; 3456 $url .= "&myip="; 3457 $url .= $ip if $ip; 3458 $url .= "&wildcard=" . ynu($config{$h}{'wildcard'}, 'ON', 'OFF', 'OFF') if defined $config{$h}{'wildcard'}; 3459 3460 if ($config{$h}{'mx'}) { 3461 $url .= "&mx=$config{$h}{'mx'}"; 3462 $url .= "&backmx=" . ynu($config{$h}{'backupmx'}, 'YES', 'NO'); 3463 } 3464 3465 my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'}); 3466 if (!defined($reply) || !$reply) { 3467 failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'}); 3468 last; 3469 } 3470 last if !header_ok($hosts, $reply); 3471 3472 my @reply = split /\n/, $reply; 3473 my $state = 'header'; 3474 foreach my $line (@reply) { 3475 if ($state eq 'header') { 3476 $state = 'body'; 3477 3478 } elsif ($state eq 'body') { 3479 $state = 'results' if $line eq ''; 3480 3481 } elsif ($state =~ /^results/) { 3482 $state = 'results2'; 3483 3484 my ($status) = $line =~ /^(\S*)\b.*/; 3485 my $h = shift @hosts; 3486 3487 $config{$h}{'status'} = $status; 3488 if ($status eq 'NOERROR') { 3489 $config{$h}{'ip'} = $ip; 3490 $config{$h}{'mtime'} = $now; 3491 success("updating %s: %s: IP address set to %s", $h, $status, $ip); 3492 3493 } elsif ($status =~ /TOOSOON/) { 3494 ## make sure we wait at least a little 3495 my ($wait, $units) = (5, 'm'); 3496 my ($sec, $scale) = ($wait, 1); 3497 3498 ($scale, $units) = (1, 'seconds') if $units eq 's'; 3499 ($scale, $units) = (60, 'minutes') if $units eq 'm'; 3500 ($scale, $units) = (60*60, 'hours') if $units eq 'h'; 3501 $config{$h}{'wtime'} = $now + $sec; 3502 warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip); 3503 3504 } elsif (exists $errors{$status}) { 3505 failed("updating %s: %s: %s", $h, $line, $errors{$status}); 3506 3507 } else { 3508 failed("updating %s: %s: unexpected status (%s)", $h, $line); 3509 } 3510 last; 3511 } 3512 } 3513 failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'}) 3514 if $state ne 'results2'; 3515 } 3516} 3517###################################################################### 3518 3519###################################################################### 3520## nic_dnspark_updateable 3521###################################################################### 3522sub nic_dnspark_updateable { 3523 my $host = shift; 3524 my $update = 0; 3525 3526 if ($config{$host}{'mx'} ne $cache{$host}{'mx'}) { 3527 info("forcing updating %s because 'mx' has changed to %s.", $host, $config{$host}{'mx'}); 3528 $update = 1; 3529 3530 } elsif ($config{$host}{'mx'} && ($config{$host}{'mxpri'} ne $cache{$host}{'mxpri'})) { 3531 info("forcing updating %s because 'mxpri' has changed to %s.", $host, $config{$host}{'mxpri'}); 3532 $update = 1; 3533 } 3534 return $update; 3535} 3536###################################################################### 3537## nic_dnspark_examples 3538###################################################################### 3539sub nic_dnspark_examples { 3540 return <<EoEXAMPLE; 3541o 'dnspark' 3542 3543The 'dnspark' protocol is used by DNS service offered by www.dnspark.com. 3544 3545Configuration variables applicable to the 'dnspark' protocol are: 3546 protocol=dnspark ## 3547 server=fqdn.of.service ## defaults to www.dnspark.com 3548 backupmx=no|yes ## indicates that DNSPark should be the secondary MX 3549 ## for this domain or host. 3550 mx=any.host.domain ## a host MX'ing for this host or domain. 3551 mxpri=priority ## MX priority. 3552 login=service-login ## login name and password registered with the service 3553 password=service-password ## 3554 fully.qualified.host ## the host registered with the service. 3555 3556Example ${program}.conf file entries: 3557 ## single host update 3558 protocol=dnspark, \\ 3559 login=my-dnspark.com-login, \\ 3560 password=my-dnspark.com-password \\ 3561 myhost.dnspark.com 3562 3563 ## multiple host update with wildcard'ing mx, and backupmx 3564 protocol=dnspark, \\ 3565 login=my-dnspark.com-login, \\ 3566 password=my-dnspark.com-password, \\ 3567 mx=a.host.willing.to.mx.for.me, \\ 3568 mxpri=10, \\ 3569 my-toplevel-domain.com,my-other-domain.com 3570 3571 ## multiple host update to the custom DNS service 3572 protocol=dnspark, \\ 3573 login=my-dnspark.com-login, \\ 3574 password=my-dnspark.com-password \\ 3575 my-toplevel-domain.com,my-other-domain.com 3576EoEXAMPLE 3577} 3578###################################################################### 3579## nic_dnspark_update 3580###################################################################### 3581sub nic_dnspark_update { 3582 debug("\nnic_dnspark_update -------------------"); 3583 3584 ## group hosts with identical attributes together 3585 ## my %groups = group_hosts_by([ @_ ], [ qw(login password server wildcard mx backupmx) ]); 3586 3587 ## each host is in a group by itself 3588 my %groups = map { $_ => [ $_ ] } @_; 3589 3590 my %errors = ( 3591 'nochange' => 'No changes made to the hostname(s). Continual updates with no changes lead to blocked clients.', 3592 'nofqdn' => 'No valid FQDN (fully qualified domain name) was specified', 3593 'nohost'=> 'An invalid hostname was specified. This due to the fact the hostname has not been created in the system. Creating new host names via clients is not supported.', 3594 'abuse' => 'The hostname specified has been blocked for abuse.', 3595 'unauth' => 'The username specified is not authorized to update this hostname and domain.', 3596 'blocked' => 'The dynamic update client (specified by the user-agent) has been blocked from the system.', 3597 'notdyn' => 'The hostname specified has not been marked as a dynamic host. Hosts must be marked as dynamic in the system in order to be updated via clients. This prevents unwanted or accidental updates.', 3598 ); 3599 3600 ## update each set of hosts that had similar configurations 3601 foreach my $sig (keys %groups) { 3602 my @hosts = @{$groups{$sig}}; 3603 my $hosts = join(',', @hosts); 3604 my $h = $hosts[0]; 3605 my $ip = $config{$h}{'wantip'}; 3606 delete $config{$_}{'wantip'} foreach @hosts; 3607 3608 info("setting IP address to %s for %s", $ip, $hosts); 3609 verbose("UPDATE:","updating %s", $hosts); 3610 3611 #'http://www.dnspark.com:80/visitors/update.html?myip=10.20.30.40&hostname=test.burry.ca' 3612 3613 my $url; 3614 $url = "http://$config{$h}{'server'}/visitors/update.html"; 3615 $url .= "?hostname=$hosts"; 3616 $url .= "&myip="; 3617 $url .= $ip if $ip; 3618 3619 if ($config{$h}{'mx'}) { 3620 $url .= "&mx=$config{$h}{'mx'}"; 3621 $url .= "&mxpri=" . $config{$h}{'mxpri'}; 3622 } 3623 3624 my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'}); 3625 if (!defined($reply) || !$reply) { 3626 failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'}); 3627 last; 3628 } 3629 last if !header_ok($hosts, $reply); 3630 3631 my @reply = split /\n/, $reply; 3632 my $state = 'header'; 3633 foreach my $line (@reply) { 3634 if ($state eq 'header') { 3635 $state = 'body'; 3636 3637 } elsif ($state eq 'body') { 3638 $state = 'results' if $line eq ''; 3639 3640 } elsif ($state =~ /^results/) { 3641 $state = 'results2'; 3642 3643 my ($status) = $line =~ /^(\S*)\b.*/; 3644 my $h = pop @hosts; 3645 3646 $config{$h}{'status'} = $status; 3647 if ($status eq 'ok') { 3648 $config{$h}{'ip'} = $ip; 3649 $config{$h}{'mtime'} = $now; 3650 success("updating %s: %s: IP address set to %s", $h, $status, $ip); 3651 3652 } elsif ($status =~ /TOOSOON/) { 3653 ## make sure we wait at least a little 3654 my ($wait, $units) = (5, 'm'); 3655 my ($sec, $scale) = ($wait, 1); 3656 3657 ($scale, $units) = (1, 'seconds') if $units eq 's'; 3658 ($scale, $units) = (60, 'minutes') if $units eq 'm'; 3659 ($scale, $units) = (60*60, 'hours') if $units eq 'h'; 3660 $config{$h}{'wtime'} = $now + $sec; 3661 warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip); 3662 3663 } elsif (exists $errors{$status}) { 3664 failed("updating %s: %s: %s", $h, $line, $errors{$status}); 3665 3666 } else { 3667 failed("updating %s: %s: unexpected status (%s)", $h, $line); 3668 } 3669 last; 3670 } 3671 } 3672 failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'}) 3673 if $state ne 'results2'; 3674 } 3675} 3676 3677###################################################################### 3678 3679###################################################################### 3680## nic_namecheap_examples 3681###################################################################### 3682sub nic_namecheap_examples { 3683 return <<EoEXAMPLE; 3684 3685o 'namecheap' 3686 3687The 'namecheap' protocol is used by DNS service offered by www.namecheap.com. 3688 3689Configuration variables applicable to the 'namecheap' protocol are: 3690 protocol=namecheap ## 3691 server=fqdn.of.service ## defaults to dynamicdns.park-your-domain.com 3692 login=service-login ## login name and password registered with the service 3693 password=service-password ## 3694 fully.qualified.host ## the hostname to update. 3695 3696Example ${program}.conf file entries: 3697 ## single host update 3698 protocol=namecheap \\ 3699 login=my-namecheap.com-login \\ 3700 password=my-namecheap.com-password \\ 3701 myhost 3702 3703EoEXAMPLE 3704} 3705###################################################################### 3706## nic_namecheap_update 3707## 3708## written by Dan Boardman 3709## 3710## based on https://www.namecheap.com/support/knowledgebase/ 3711## article.aspx/29/11/how-to-use-the-browser-to-dynamically-update-hosts-ip 3712## needs this url to update: 3713## https://dynamicdns.park-your-domain.com/update?host=host_name& 3714## domain=domain.com&password=domain_password[&ip=your_ip] 3715## 3716###################################################################### 3717sub nic_namecheap_update { 3718 3719 3720 debug("\nnic_namecheap1_update -------------------"); 3721 3722 ## update each configured host 3723 foreach my $h (@_) { 3724 my $ip = delete $config{$h}{'wantip'}; 3725 info("setting IP address to %s for %s", $ip, $h); 3726 verbose("UPDATE:","updating %s", $h); 3727 3728 my $url; 3729 $url = "https://$config{$h}{'server'}/update"; 3730 my $domain = $config{$h}{'login'}; 3731 my $host = $h; 3732 $host =~ s/(.*)\.$domain(.*)/$1$2/; 3733 $url .= "?host=$host"; 3734 $url .= "&domain=$domain"; 3735 $url .= "&password=$config{$h}{'password'}"; 3736 $url .= "&ip="; 3737 $url .= $ip if $ip; 3738 3739 my $reply = geturl(opt('proxy'), $url); 3740 if (!defined($reply) || !$reply) { 3741 failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); 3742 last; 3743 } 3744 last if !header_ok($h, $reply); 3745 3746 my @reply = split /\n/, $reply; 3747 if (grep /<ErrCount>0/i, @reply) { 3748 $config{$h}{'ip'} = $ip; 3749 $config{$h}{'mtime'} = $now; 3750 $config{$h}{'status'} = 'good'; 3751 success("updating %s: good: IP address set to %s", $h, $ip); 3752 } else { 3753 $config{$h}{'status'} = 'failed'; 3754 warning("SENT: %s", $url) unless opt('verbose'); 3755 warning("REPLIED: %s", $reply); 3756 failed("updating %s: Invalid reply.", $h); 3757 } 3758 } 3759} 3760 3761###################################################################### 3762 3763###################################################################### 3764## nic_nfsn_examples 3765###################################################################### 3766sub nic_nfsn_examples { 3767 return <<EoEXAMPLE; 3768 3769o 'nfsn' 3770 3771The 'nfsn' protocol is used for the DNS service offered by www.nearlyfreespeech.net. Use this URL to get your API-Key-password: 3772 https://members.nearlyfreespeech.net/support/assist?tag=apikey 3773 3774Configuration variables applicable to the 'nfsn' protocol are: 3775 protocol=nfsn 3776 server=api-server ## defaults to api.nearlyfreespeech.net 3777 login=member-login ## NearlyFreeSpeech.net login name 3778 password=api-key ## NearlyFreeSpeech.net API key 3779 zone=zone ## The DNS zone under which the hostname falls; e.g. example.com 3780 hostname ## the hostname to update in the specified zone; e.g. example.com or www.example.com 3781 3782Example ${program}.conf file entries: 3783 ## update two hosts (example.com and www.example.com) in example.com zone 3784 protocol=nfsn, \\ 3785 login=my-nfsn-member-login, \\ 3786 password=my-nfsn-api-key, \\ 3787 zone=example.com \\ 3788 example.com,www.example.com 3789 3790 ## repeat the above for other zones, e.g. example.net: 3791 [...] 3792 zone=example.net \\ 3793 subdomain1.example.net,subdomain2.example.net 3794 3795EoEXAMPLE 3796} 3797 3798###################################################################### 3799## nic_nfsn_gen_auth_header 3800###################################################################### 3801sub nic_nfsn_gen_auth_header { 3802 my $h = shift; 3803 my $path = shift; 3804 my $body = shift || ''; 3805 3806 ## API requests must include a custom HTTP header in the 3807 ## following format: 3808 ## 3809 ## X-NFSN-Authentication: login;timestamp;salt;hash 3810 ## 3811 ## In this header, login is the member login name of the user 3812 ## making the API request. 3813 my $auth_header = 'X-NFSN-Authentication: '; 3814 $auth_header .= $config{$h}{'login'} . ';'; 3815 3816 ## timestamp is the standard 32-bit unsigned Unix timestamp 3817 ## value. 3818 my $timestamp = time(); 3819 $auth_header .= $timestamp . ';'; 3820 3821 ## salt is a randomly generated 16 character alphanumeric value 3822 ## (a-z, A-Z, 0-9). 3823 my @chars = ('A'..'Z', 'a'..'z', '0'..'9'); 3824 my $salt; 3825 for (my $i = 0; $i < 16; $i++) { 3826 $salt .= $chars[int(rand(@chars))]; 3827 } 3828 $auth_header .= $salt . ';'; 3829 3830 ## hash is a SHA1 hash of a string in the following format: 3831 ## login;timestamp;salt;api-key;request-uri;body-hash 3832 my $hash_string = $config{$h}{'login'}.';'. 3833 $timestamp . ';' . 3834 $salt . ';' . 3835 $config{$h}{'password'} . ';'; 3836 3837 ## The request-uri value is the path portion of the requested URL 3838 ## (i.e. excluding the protocol and hostname). 3839 $hash_string .= $path . ';'; 3840 3841 ## The body-hash is the SHA1 hash of the request body (if any). 3842 ## If there is no request body, the SHA1 hash of the empty string 3843 ## must be used. 3844 my $body_hash = sha1_hex($body); 3845 $hash_string .= $body_hash; 3846 3847 my $hash = sha1_hex($hash_string); 3848 $auth_header .= $hash; 3849 3850 return $auth_header; 3851} 3852 3853###################################################################### 3854## nic_nfsn_make_request 3855###################################################################### 3856sub nic_nfsn_make_request { 3857 my $h = shift; 3858 my $path = shift; 3859 my $method = shift || 'GET'; 3860 my $body = shift || ''; 3861 3862 my $base_url = "https://$config{$h}{'server'}"; 3863 my $url = $base_url . $path; 3864 my $header = nic_nfsn_gen_auth_header($h, $path, $body); 3865 if ($method eq 'POST' && $body ne '') { 3866 $header .= "\nContent-Type: application/x-www-form-urlencoded"; 3867 } 3868 3869 return geturl(opt('proxy'), $url, '', '', $header, $method, $body); 3870} 3871 3872###################################################################### 3873## nic_nfsn_handle_error 3874###################################################################### 3875sub nic_nfsn_handle_error { 3876 my $resp = shift; 3877 my $h = shift; 3878 3879 $resp =~ s/^.*?\n\n//s; # Strip header 3880 my $json = eval {decode_json($resp)}; 3881 if ($@ || ref($json) ne 'HASH' || not defined $json->{'error'}) { 3882 failed("Invalid error response: %s", $resp); 3883 return; 3884 } 3885 3886 failed($json->{'error'}); 3887 if (defined $json->{'debug'}) { 3888 failed($json->{'debug'}); 3889 } 3890} 3891 3892###################################################################### 3893## nic_nfsn_update 3894## 3895## Written by John Brooks 3896## 3897## Based on API docs: https://members.nearlyfreespeech.net/wiki/API/Introduction 3898## Uses the API endpoints under https://api.nearlyfreespeech.net/dns/$zone/ 3899## 3900## NB: There is no "updateRR" API function; to update an existing RR, we use 3901## removeRR to delete the RR, and then addRR to re-add it with the new data. 3902## 3903###################################################################### 3904sub nic_nfsn_update { 3905 debug("\nnic_nfsn_update -------------------"); 3906 3907 ## update each configured host 3908 foreach my $h (@_) { 3909 my $zone = $config{$h}{'zone'}; 3910 my $name; 3911 3912 if ($h eq $zone) { 3913 $name = ''; 3914 } elsif ($h !~ /$zone$/) { 3915 $config{$h}{'status'} = 'failed'; 3916 failed("updating %s: %s is outside zone %s", $h, $h, 3917 $zone); 3918 next; 3919 } else { 3920 $name = $h; 3921 $name =~ s/(.*)\.${zone}$/$1/; 3922 } 3923 3924 my $ip = delete $config{$h}{'wantip'}; 3925 info("setting IP address to %s for %s", $ip, $h); 3926 verbose("UPDATE", "updating %s", $h); 3927 3928 my $list_path = "/dns/$zone/listRRs"; 3929 my $list_body = encode_www_form_urlencoded({name => $name, 3930 type => 'A'}); 3931 my $list_resp = nic_nfsn_make_request($h, $list_path, 'POST', 3932 $list_body); 3933 if (!header_ok($h, $list_resp)) { 3934 $config{$h}{'status'} = 'failed'; 3935 nic_nfsn_handle_error($list_resp, $h); 3936 next; 3937 } 3938 3939 $list_resp =~ s/^.*?\n\n//s; # Strip header 3940 my $list = eval{decode_json($list_resp)}; 3941 if ($@) { 3942 $config{$h}{'status'} = 'failed'; 3943 failed("updating %s: JSON decoding failure", $h); 3944 next; 3945 } 3946 3947 my $rr_ttl = $config{$h}{'ttl'}; 3948 3949 if (ref($list) eq 'ARRAY' && defined $list->[0]->{'data'}) { 3950 my $rr_data = $list->[0]->{'data'}; 3951 my $rm_path = "/dns/$zone/removeRR"; 3952 my $rm_data = {name => $name, 3953 type => 'A', 3954 data => $rr_data}; 3955 my $rm_body = encode_www_form_urlencoded($rm_data); 3956 my $rm_resp = nic_nfsn_make_request($h, $rm_path, 3957 'POST', $rm_body); 3958 if (!header_ok($h, $rm_resp)) { 3959 $config{$h}{'status'} = 'failed'; 3960 nic_nfsn_handle_error($rm_resp); 3961 next; 3962 } 3963 } 3964 3965 my $add_path = "/dns/$zone/addRR"; 3966 my $add_data = {name => $name, 3967 type => 'A', 3968 data => $ip, 3969 ttl => $rr_ttl}; 3970 my $add_body = encode_www_form_urlencoded($add_data); 3971 my $add_resp = nic_nfsn_make_request($h, $add_path, 'POST', 3972 $add_body); 3973 if (header_ok($h, $add_resp)) { 3974 $config{$h}{'ip'} = $ip; 3975 $config{$h}{'mtime'} = $now; 3976 $config{$h}{'status'} = 'good'; 3977 success("updating %s: good: IP address set to %s", $h, $ip); 3978 } else { 3979 $config{$h}{'status'} = 'failed'; 3980 nic_nfsn_handle_error($add_resp, $h); 3981 } 3982 } 3983} 3984 3985###################################################################### 3986 3987###################################################################### 3988## nic_sitelutions_examples 3989###################################################################### 3990sub nic_sitelutions_examples { 3991 return <<EoEXAMPLE; 3992 3993o 'sitelutions' 3994 3995The 'sitelutions' protocol is used by DNS services offered by www.sitelutions.com. 3996 3997Configuration variables applicable to the 'sitelutions' protocol are: 3998 protocol=sitelutions ## 3999 server=fqdn.of.service ## defaults to sitelutions.com 4000 login=service-login ## login name and password registered with the service 4001 password=service-password ## 4002 A_record_id ## Id of the A record for the host registered with the service. 4003 4004Example ${program}.conf file entries: 4005 ## single host update 4006 protocol=sitelutions, \\ 4007 login=my-sitelutions.com-login, \\ 4008 password=my-sitelutions.com-password \\ 4009 my-sitelutions.com-id_of_A_record 4010 4011EoEXAMPLE 4012} 4013###################################################################### 4014## nic_sitelutions_update 4015## 4016## written by Mike W. Smith 4017## 4018## based on http://www.sitelutions.com/help/dynamic_dns_clients#updatespec 4019## needs this url to update: 4020## https://www.sitelutions.com/dnsup?id=990331&user=myemail@mydomain.com&pass=SecretPass&ip=192.168.10.4 4021## domain=domain.com&password=domain_password&ip=your_ip 4022## 4023###################################################################### 4024sub nic_sitelutions_update { 4025 4026 4027 debug("\nnic_sitelutions_update -------------------"); 4028 4029 ## update each configured host 4030 foreach my $h (@_) { 4031 my $ip = delete $config{$h}{'wantip'}; 4032 info("setting IP address to %s for %s", $ip, $h); 4033 verbose("UPDATE:","updating %s", $h); 4034 4035 my $url; 4036 $url = "http://$config{$h}{'server'}/dnsup"; 4037 $url .= "?id=$h"; 4038 $url .= "&user=$config{$h}{'login'}"; 4039 $url .= "&pass=$config{$h}{'password'}"; 4040 $url .= "&ip="; 4041 $url .= $ip if $ip; 4042 4043 my $reply = geturl(opt('proxy'), $url); 4044 if (!defined($reply) || !$reply) { 4045 failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); 4046 last; 4047 } 4048 last if !header_ok($h, $reply); 4049 4050 my @reply = split /\n/, $reply; 4051 if (grep /success/i, @reply) { 4052 $config{$h}{'ip'} = $ip; 4053 $config{$h}{'mtime'} = $now; 4054 $config{$h}{'status'} = 'good'; 4055 success("updating %s: good: IP address set to %s", $h, $ip); 4056 } else { 4057 $config{$h}{'status'} = 'failed'; 4058 warning("SENT: %s", $url) unless opt('verbose'); 4059 warning("REPLIED: %s", $reply); 4060 failed("updating %s: Invalid reply.", $h); 4061 } 4062 } 4063} 4064 4065###################################################################### 4066 4067###################################################################### 4068## nic_freedns_examples 4069###################################################################### 4070sub nic_freedns_examples { 4071return <<EoEXAMPLE; 4072 4073o 'freedns' 4074 4075The 'freedns' protocol is used by DNS services offered by freedns.afraid.org. 4076 4077Configuration variables applicable to the 'freedns' protocol are: 4078 protocol=freedns ## 4079 server=fqdn.of.service ## defaults to freedns.afraid.org 4080 login=service-login ## login name and password registered with the service 4081 password=service-password ## 4082 fully.qualified.host ## the host registered with the service. 4083 4084Example ${program}.conf file entries: 4085 ## single host update 4086 protocol=freedns, \\ 4087 login=my-freedns.afraid.org-login, \\ 4088 password=my-freedns.afraid.org-password \\ 4089 myhost.afraid.com 4090 4091EoEXAMPLE 4092} 4093###################################################################### 4094## nic_freedns_update 4095## 4096## written by John Haney 4097## 4098## based on http://freedns.afraid.org/api/ 4099## needs this url to update: 4100## http://freedns.afraid.org/api/?action=getdyndns&sha=<sha1sum of login|password> 4101## This returns a list of host|currentIP|updateURL lines. 4102## Pick the line that matches myhost, and fetch the URL. 4103## word 'Updated' for success, 'fail' for failure. 4104## 4105###################################################################### 4106sub nic_freedns_update { 4107 4108 4109 debug("\nnic_freedns_update -------------------"); 4110 4111 ## First get the list of updatable hosts 4112 my $url; 4113 $url = "http://$config{$_[0]}{'server'}/api/?action=getdyndns&sha=".&sha1_hex("$config{$_[0]}{'login'}|$config{$_[0]}{'password'}"); 4114 my $reply = geturl(opt('proxy'), $url); 4115 if (!defined($reply) || !$reply || !header_ok($_[0], $reply)) { 4116 failed("updating %s: Could not connect to %s for site list.", $_[0], $url); 4117 return; 4118 } 4119 my @lines = split("\n", $reply); 4120 my %freedns_hosts; 4121 grep { 4122 my @rec = split(/\|/, $_); 4123 $freedns_hosts{$rec[0]} = \@rec if ($#rec > 0); 4124 } @lines; 4125 if (!keys %freedns_hosts) { 4126 failed("Could not get freedns update URLs from %s", $config{$_[0]}{'server'}); 4127 return; 4128 } 4129 ## update each configured host 4130 foreach my $h (@_) { 4131 if(!$h){ next }; 4132 my $ip = delete $config{$h}{'wantip'}; 4133 info("setting IP address to %s for %s", $ip, $h); 4134 verbose("UPDATE:","updating %s", $h); 4135 4136 if($ip eq $freedns_hosts{$h}->[1]) { 4137 $config{$h}{'ip'} = $ip; 4138 $config{$h}{'mtime'} = $now; 4139 $config{$h}{'status'} = 'good'; 4140 success("update not necessary %s: good: IP address already set to %s", $h, $ip); 4141 } else { 4142 my $reply = geturl(opt('proxy'), $freedns_hosts{$h}->[2]); 4143 if (!defined($reply) || !$reply) { 4144 failed("updating %s: Could not connect to %s.", $h, $freedns_hosts{$h}->[2]); 4145 last; 4146 } 4147 if(!header_ok($h, $reply)) { 4148 $config{$h}{'status'} = 'failed'; 4149 last; 4150 } 4151 4152 if($reply =~ /Updated.*$h.*to.*$ip/) { 4153 $config{$h}{'ip'} = $ip; 4154 $config{$h}{'mtime'} = $now; 4155 $config{$h}{'status'} = 'good'; 4156 success("updating %s: good: IP address set to %s", $h, $ip); 4157 } else { 4158 $config{$h}{'status'} = 'failed'; 4159 warning("SENT: %s", $freedns_hosts{$h}->[2]) unless opt('verbose'); 4160 warning("REPLIED: %s", $reply); 4161 failed("updating %s: Invalid reply.", $h); 4162 } 4163 } 4164 } 4165} 4166 4167###################################################################### 4168## nic_changeip_examples 4169###################################################################### 4170sub nic_changeip_examples { 4171return <<EoEXAMPLE; 4172 4173o 'changeip' 4174 4175The 'changeip' protocol is used by DNS services offered by changeip.com. 4176 4177Configuration variables applicable to the 'changeip' protocol are: 4178 protocol=changeip ## 4179 server=fqdn.of.service ## defaults to nic.changeip.com 4180 login=service-login ## login name and password registered with the service 4181 password=service-password ## 4182 fully.qualified.host ## the host registered with the service. 4183 4184Example ${program}.conf file entries: 4185 ## single host update 4186 protocol=changeip, \\ 4187 login=my-my-changeip.com-login, \\ 4188 password=my-changeip.com-password \\ 4189 myhost.changeip.org 4190 4191EoEXAMPLE 4192} 4193 4194###################################################################### 4195## nic_changeip_update 4196## 4197## adapted by Michele Giorato 4198## 4199## https://nic.ChangeIP.com/nic/update?hostname=host.example.org&myip=66.185.162.19 4200## 4201###################################################################### 4202sub nic_changeip_update { 4203 4204 4205 debug("\nnic_changeip_update -------------------"); 4206 4207 ## update each configured host 4208 foreach my $h (@_) { 4209 my $ip = delete $config{$h}{'wantip'}; 4210 info("setting IP address to %s for %s", $ip, $h); 4211 verbose("UPDATE:","updating %s", $h); 4212 4213 my $url; 4214 $url = "http://$config{$h}{'server'}/nic/update"; 4215 $url .= "?hostname=$h"; 4216 $url .= "&ip="; 4217 $url .= $ip if $ip; 4218 4219 my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'}); 4220 if (!defined($reply) || !$reply) { 4221 failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); 4222 last; 4223 } 4224 last if !header_ok($h, $reply); 4225 4226 my @reply = split /\n/, $reply; 4227 if (grep /success/i, @reply) { 4228 $config{$h}{'ip'} = $ip; 4229 $config{$h}{'mtime'} = $now; 4230 $config{$h}{'status'} = 'good'; 4231 success("updating %s: good: IP address set to %s", $h, $ip); 4232 } else { 4233 $config{$h}{'status'} = 'failed'; 4234 warning("SENT: %s", $url) unless opt('verbose'); 4235 warning("REPLIED: %s", $reply); 4236 failed("updating %s: Invalid reply.", $h); 4237 } 4238 } 4239} 4240 4241###################################################################### 4242## nic_dtdns_examples 4243###################################################################### 4244sub nic_dtdns_examples { 4245 return <<EoEXAMPLE; 4246o 'dtdns' 4247 4248The 'dtdns' protocol is the protocol used by the dynamic hostname services 4249of the 'DtDNS' dns services. This is currently used by the free 4250dynamic DNS service offered by www.dtdns.com. 4251 4252Configuration variables applicable to the 'dtdns' protocol are: 4253 protocol=dtdns ## 4254 server=www.fqdn.of.service ## defaults to www.dtdns.com 4255 password=service-password ## password registered with the service 4256 client=name_of_updater ## defaults to $program (10 chars max, no spaces) 4257 fully.qualified.host ## the host registered with the service. 4258 4259Example ${program}.conf file entries: 4260 ## single host update 4261 protocol=dtdns, \\ 4262 password=my-dydns.za.net-password, \\ 4263 client=ddclient \\ 4264 myhost.dtdns.net 4265 4266EoEXAMPLE 4267} 4268 4269###################################################################### 4270## nic_dtdns_update 4271## by Achim Franke 4272###################################################################### 4273sub nic_dtdns_update { 4274 debug("\nnic_dtdns_update -------------------"); 4275 4276 ## update each configured host 4277 foreach my $h (@_) { 4278 my $ip = delete $config{$h}{'wantip'}; 4279 info("setting IP address to %s for %s", $ip, $h); 4280 verbose("UPDATE:","updating %s", $h); 4281 4282 # Set the URL that we're going to to update 4283 my $url; 4284 $url = "http://$config{$h}{'server'}/api/autodns.cfm"; 4285 $url .= "?id="; 4286 $url .= $h; 4287 $url .= "&pw="; 4288 $url .= $config{$h}{'password'}; 4289 $url .= "&ip="; 4290 $url .= $ip; 4291 $url .= "&client="; 4292 $url .= $config{$h}{'client'}; 4293 4294 # Try to get URL 4295 my $reply = geturl(opt('proxy'), $url); 4296 4297 # No response, declare as failed 4298 if (!defined($reply) || !$reply) { 4299 failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); 4300 last; 4301 } 4302 last if !header_ok($h, $reply); 4303 4304 # Response found, just declare as success (this is ugly, we need more error checking) 4305 if ($reply =~ /now\spoints\sto/) 4306 { 4307 $config{$h}{'ip'} = $ip; 4308 $config{$h}{'mtime'} = $now; 4309 $config{$h}{'status'} = 'good'; 4310 success("updating %s: good: IP address set to %s", $h, $ip); 4311 } 4312 else 4313 { 4314 my @reply = split /\n/, $reply; 4315 my $returned = pop(@reply); 4316 $config{$h}{'status'} = 'failed'; 4317 failed("updating %s: Server said: '$returned'", $h); 4318 } 4319 } 4320} 4321###################################################################### 4322 4323###################################################################### 4324## nic_googledomains_examples 4325## 4326## written by Nelson Araujo 4327## 4328###################################################################### 4329sub nic_googledomains_examples { 4330 return <<EoEXAMPLE; 4331o 'googledomains' 4332 4333The 'googledomains' protocol is used by DNS service offered by www.google.com/domains. 4334 4335Configuration variables applicable to the 'googledomains' protocol are: 4336 protocol=googledomains ## 4337 login=service-login ## the user name provided by the admin interface 4338 password=service-password ## the password provided by the admin interface 4339 fully.qualified.host ## the host registered with the service. 4340 4341Example ${program}.conf file entries: 4342 ## single host update 4343 protocol=googledomains, \\ 4344 login=my-generated-user-name, \\ 4345 password=my-genereated-password \\ 4346 myhost.com 4347 4348 ## multiple host update to the custom DNS service 4349 protocol=googledomains, \\ 4350 login=my-generated-user-name, \\ 4351 password=my-genereated-password \\ 4352 my-toplevel-domain.com,my-other-domain.com 4353EoEXAMPLE 4354} 4355###################################################################### 4356## nic_googledomains_update 4357###################################################################### 4358sub nic_googledomains_update { 4359 debug("\nnic_googledomains_update -------------------"); 4360 4361 ## group hosts with identical attributes together 4362 my %groups = group_hosts_by([ @_ ], [ qw(server login password) ]); 4363 4364 ## update each set of hosts that had similar configurations 4365 foreach my $sig (keys %groups) { 4366 my @hosts = @{$groups{$sig}}; 4367 my $key = $hosts[0]; 4368 my $ip = $config{$key}{'wantip'}; 4369 4370 # FQDNs 4371 for my $host (@hosts) { 4372 delete $config{$host}{'wantip'}; 4373 4374 info("setting IP address to %s for %s", $ip, $host); 4375 verbose("UPDATE:","updating %s", $host); 4376 4377 # Update the DNS record 4378 my $url = "https://$config{$host}{'server'}/nic/update"; 4379 $url .= "?hostname=$host"; 4380 $url .= "&myip="; 4381 $url .= $ip if $ip; 4382 4383 my $reply = geturl(opt('proxy'), $url, $config{$host}{'login'}, $config{$host}{'password'}); 4384 unless ($reply) { 4385 failed("updating %s: Could not connect to %s.", $host, $config{$host}{'server'}); 4386 last; 4387 } 4388 last if !header_ok($host, $reply); 4389 4390 # Cache 4391 $config{$host}{'ip'} = $ip; 4392 $config{$host}{'mtime'} = $now; 4393 $config{$host}{'status'} = 'good'; 4394 } 4395 } 4396} 4397 4398###################################################################### 4399## nic_nsupdate_examples 4400###################################################################### 4401sub nic_nsupdate_examples { 4402 return <<EoEXAMPLE; 4403o 'nsupdate' 4404 4405The 'nsupdate' protocol is used to submit Dynamic DNS Update requests as 4406defined in RFC2136 to a name server using the 'nsupdate' command line 4407utility part of ISC BIND. Dynamic DNS updates allow resource records to 4408be added or removed from a zone configured for dynamic updates through 4409DNS requests protected using TSIG. BIND ships with 'ddns-confgen', a 4410utility to generate sample configurations and instructions for both the 4411server and the client. See nsupdate(1) and ddns-confgen(8) for details. 4412 4413Configuration variables applicable to the 'nsupdate' protocol are: 4414 protocol=nsupdate 4415 server=ns1.example.com ## name or IP address of the DNS server to send 4416 ## the update requests to; usually master for 4417 ## zone, but slaves should forward the request 4418 password=tsig.key ## path and name of the symmetric HMAC key file 4419 ## to use for TSIG signing of the request 4420 ## (as generated by 'ddns-confgen -q' and 4421 ## configured on server in 'grant' statement) 4422 zone=dyn.example.com ## forward zone that is to be updated 4423 ttl=600 ## time to live of the record; 4424 ## defaults to 600 seconds 4425 tcp=off|on ## nsupdate uses UDP by default, and switches to 4426 ## TCP if the update is too large to fit in a 4427 ## UDP datagram; this setting forces TCP; 4428 ## defaults to off 4429 login=/usr/local/bin/nsupdate ## path and name of nsupdate binary; 4430 ## defaults to '/usr/local/bin/nsupdate' 4431 <hostname> ## fully qualified hostname to update 4432 4433Example ${program}.conf file entries: 4434 ## single host update 4435 protocol=nsupdate \\ 4436 server=ns1.example.com \\ 4437 password=/etc/${program}/dyn.example.com.key \\ 4438 zone=dyn.example.com \\ 4439 ttl=3600 \\ 4440 myhost.dyn.example.com 4441 4442EoEXAMPLE 4443} 4444 4445###################################################################### 4446## nic_nsupdate_update 4447## by Daniel Roethlisberger <daniel@roe.ch> 4448###################################################################### 4449sub nic_nsupdate_update { 4450 debug("\nnic_nsupdate_update -------------------"); 4451 4452 ## group hosts with identical attributes together 4453 my %groups = group_hosts_by([ @_ ], [ qw(login password server zone) ]); 4454 4455 ## update each set of hosts that had similar configurations 4456 foreach my $sig (keys %groups) { 4457 my @hosts = @{$groups{$sig}}; 4458 my $hosts = join(',', @hosts); 4459 my $h = $hosts[0]; 4460 my $binary = $config{$h}{'login'}; 4461 my $keyfile = $config{$h}{'password'}; 4462 my $server = $config{$h}{'server'}; 4463 ## nsupdate requires a port number to be separated by whitepace, not colon 4464 $server =~ s/:/ /; 4465 my $zone = $config{$h}{'zone'}; 4466 my $ip = $config{$h}{'wantip'}; 4467 my $recordtype = ''; 4468 if (is_ipv6($ip)) { 4469 $recordtype = 'AAAA'; 4470 } else { 4471 $recordtype = 'A'; 4472 } 4473 delete $config{$_}{'wantip'} foreach @hosts; 4474 4475 info("setting IP address to %s for %s", $ip, $hosts); 4476 verbose("UPDATE:","updating %s", $hosts); 4477 4478 ## send separate requests for each zone with all hosts in that zone 4479 my $instructions = <<EoINSTR1; 4480server $server 4481zone $zone. 4482EoINSTR1 4483 foreach (@hosts) { 4484 $instructions .= <<EoINSTR2; 4485update delete $_. $recordtype 4486update add $_. $config{$_}{'ttl'} $recordtype $ip 4487EoINSTR2 4488 } 4489 $instructions .= <<EoINSTR3; 4490send 4491EoINSTR3 4492 my $command = "$binary -k $keyfile"; 4493 $command .= " -v" if ynu($config{$h}{'tcp'}, 1, 0, 0); 4494 $command .= " -d" if (opt('debug')); 4495 verbose("UPDATE:", "nsupdate command is: %s", $command); 4496 verbose("UPDATE:", "nsupdate instructions are:\n%s", $instructions); 4497 4498 my $status = pipecmd($command, $instructions); 4499 if ($status eq 1) { 4500 foreach (@hosts) { 4501 $config{$_}{'ip'} = $ip; 4502 $config{$_}{'mtime'} = $now; 4503 success("updating %s: %s: IP address set to %s", $_, $status, $ip); 4504 } 4505 } else { 4506 foreach (@hosts) { 4507 failed("updating %s", $_); 4508 } 4509 } 4510 } 4511} 4512 4513###################################################################### 4514 4515###################################################################### 4516## nic_cloudflare_examples 4517## 4518## written by Ian Pye 4519## 4520###################################################################### 4521sub nic_cloudflare_examples { 4522 return <<EoEXAMPLE; 4523o 'cloudflare' 4524 4525The 'cloudflare' protocol is used by DNS service offered by www.cloudflare.com. 4526 4527Configuration variables applicable to the 'cloudflare' protocol are: 4528 protocol=cloudflare ## 4529 server=fqdn.of.service ## defaults to api.cloudflare.com/client/v4 4530 login=service-login ## login name and password registered with the service 4531 password=service-password ## 4532 fully.qualified.host ## the host registered with the service. 4533 4534Example ${program}.conf file entries: 4535 ## single host update 4536 protocol=cloudflare, \\ 4537 zone=dns.zone, \\ 4538 login=my-cloudflare.com-login, \\ 4539 password=my-cloudflare.com-secure-token \\ 4540 myhost.com 4541 4542 ## multiple host update to the custom DNS service 4543 protocol=cloudflare, \\ 4544 zone=dns.zone, \\ 4545 login=my-cloudflare.com-login, \\ 4546 password=my-cloudflare.com-secure-token \\ 4547 my-toplevel-domain.com,my-other-domain.com 4548EoEXAMPLE 4549} 4550###################################################################### 4551## nic_cloudflare_update 4552###################################################################### 4553sub nic_cloudflare_update { 4554 debug("\nnic_cloudflare_update -------------------"); 4555 4556 ## group hosts with identical attributes together 4557 my %groups = group_hosts_by([ @_ ], [ qw(ssh login password server wildcard mx backupmx zone) ]); 4558 4559 ## update each set of hosts that had similar configurations 4560 foreach my $sig (keys %groups) { 4561 my @hosts = @{$groups{$sig}}; 4562 my $hosts = join(',', @hosts); 4563 my $key = $hosts[0]; 4564 my $ip = $config{$key}{'wantip'}; 4565 4566 my $headers = "X-Auth-Email: $config{$key}{'login'}\n"; 4567 $headers .= "X-Auth-Key: $config{$key}{'password'}\n"; 4568 $headers .= "Content-Type: application/json"; 4569 4570 # FQDNs 4571 for my $domain (@hosts) { 4572 (my $hostname = $domain) =~ s/\.$config{$key}{zone}$//; 4573 delete $config{$domain}{'wantip'}; 4574 4575 info("setting IP address to %s for %s", $ip, $domain); 4576 verbose("UPDATE:","updating %s", $domain); 4577 4578 # Get zone ID 4579 my $url = "https://$config{$key}{'server'}/zones?"; 4580 $url .= "name=".$config{$key}{'zone'}; 4581 4582 my $reply = geturl(opt('proxy'), $url, undef, undef, $headers); 4583 unless ($reply) { 4584 failed("updating %s: Could not connect to %s.", $domain, $config{$key}{'server'}); 4585 last; 4586 } 4587 last if !header_ok($domain, $reply); 4588 4589 # Strip header 4590 $reply =~ s/^.*?\n\n//s; 4591 my $response = eval {decode_json($reply)}; 4592 if (!defined $response || !defined $response->{result}) { 4593 failed ("invalid json or result."); 4594 next; 4595 } 4596 4597 # Pull the ID out of the json, messy 4598 my ($zone_id) = map { $_->{name} eq $config{$key}{'zone'} ? $_->{id} : () } @{ $response->{result} }; 4599 unless($zone_id) { 4600 failed("updating %s: No zone ID found.", $config{$key}{'zone'}); 4601 next; 4602 } 4603 info("zone ID is $zone_id"); 4604 4605 # Get DNS record ID 4606 $url = "https://$config{$key}{'server'}/zones/$zone_id/dns_records?"; 4607 if (is_ipv6($ip)) { 4608 $url .= "type=AAAA&name=$domain"; 4609 } else { 4610 $url .= "type=A&name=$domain"; 4611 } 4612 4613 $reply = geturl(opt('proxy'), $url, undef, undef, $headers); 4614 unless ($reply) { 4615 failed("updating %s: Could not connect to %s.", $domain, $config{$key}{'server'}); 4616 last; 4617 } 4618 last if !header_ok($domain, $reply); 4619 4620 # Strip header 4621 $reply =~ s/^.*?\n\n//s; 4622 $response = eval {decode_json($reply)}; 4623 if (!defined $response || !defined $response->{result}) { 4624 failed ("invalid json or result."); 4625 next; 4626 } 4627 4628 # Pull the ID out of the json, messy 4629 my ($dns_rec_id) = map { $_->{name} eq $domain ? $_->{id} : () } @{ $response->{result} }; 4630 unless($dns_rec_id) { 4631 failed("updating %s: No DNS record ID found.", $domain); 4632 next; 4633 } 4634 info("DNS record ID is $dns_rec_id"); 4635 4636 # Set domain 4637 $url = "https://$config{$key}{'server'}/zones/$zone_id/dns_records/$dns_rec_id"; 4638 my $data = "{\"content\":\"$ip\"}"; 4639 $reply = geturl(opt('proxy'), $url, undef, undef, $headers, "PATCH", $data); 4640 unless ($reply) { 4641 failed("updating %s: Could not connect to %s.", $domain, $config{$domain}{'server'}); 4642 last; 4643 } 4644 last if !header_ok($domain, $reply); 4645 4646 # Strip header 4647 $reply =~ s/^.*?\n\n//s; 4648 $response = eval {decode_json($reply)}; 4649 if (!defined $response || !defined $response->{result}) { 4650 failed ("invalid json or result."); 4651 } else { 4652 success ("%s -- Updated Successfully to %s", $domain, $ip); 4653 4654 } 4655 4656 # Cache 4657 $config{$key}{'ip'} = $ip; 4658 $config{$key}{'mtime'} = $now; 4659 $config{$key}{'status'} = 'good'; 4660 } 4661 } 4662} 4663###################################################################### 4664## nic_yandex_examples 4665###################################################################### 4666sub nic_yandex_examples { 4667 return <<EoEXAMPLE; 4668o Yandex 4669 4670The 'yandex' protocol is used to by DNS service offered by Yandex. 4671 4672Configuration variables applicable to the 'yandex' protocol are: 4673 protocol=yandex ## 4674 server=fqdn.of.service ## defaults to pddimp.yandex.ru 4675 login=dns.zone ## Your zone name 4676 password=pdd-token ## PDD token for authentication 4677 fully.qualified.host ## the host registered with the service. 4678 4679Example ${program}.conf file entries: 4680 ## single host update 4681 protocol=yandex, \\ 4682 login=myhost.com, \\ 4683 password=123456789ABCDEF0000000000000000000000000000000000000 \\ 4684 record.myhost.com 4685 4686 ## multiple host update 4687 protocol=yandex, \\ 4688 login=myhost.com, \\ 4689 password=123456789ABCDEF0000000000000000000000000000000000000 \\ 4690 record.myhost.com,other.myhost.com 4691EoEXAMPLE 4692} 4693###################################################################### 4694## nic_yandex_update 4695## 4696## written by Denis Akimkin 4697## 4698###################################################################### 4699sub nic_yandex_update { 4700 debug("\nnic_yandex_update -------------------"); 4701 4702 ## group hosts with identical attributes together 4703 my %groups = group_hosts_by([ @_ ], [ qw(server login pasword) ]); 4704 4705 ## update each set of hosts that had similar configurations 4706 foreach my $sig (keys %groups) { 4707 my @hosts = @{$groups{$sig}}; 4708 my $key = $hosts[0]; 4709 my $ip = $config{$key}{'wantip'}; 4710 my $headers = 'PddToken: ' . $config{$key}{'password'}; 4711 4712 # FQDNs 4713 for my $host (@hosts) { 4714 delete $config{$host}{'wantip'}; 4715 4716 info("setting IP address to %s for %s", $ip, $host); 4717 verbose("UPDATE:","updating %s", $host); 4718 4719 # Get record ID for host 4720 my $url = "https://$config{$host}{'server'}/api2/admin/dns/list?"; 4721 $url .= "domain="; 4722 $url .= $config{$key}{'login'}; 4723 my $reply = geturl(opt('proxy'), $url, '', '', $headers); 4724 unless ($reply) { 4725 failed("updating %s: Could not connect to %s.", $host, $config{$key}{'server'}); 4726 last; 4727 } 4728 last if !header_ok($host, $reply); 4729 4730 # Strip header 4731 $reply =~ s/^.*?\n\n//s; 4732 my $response = eval { decode_json($reply) }; 4733 if ($response->{success} eq 'error') { 4734 failed ("%s", $response->{error}); 4735 next; 4736 } 4737 4738 # Pull the ID out of the json 4739 my ($id) = map { $_->{fqdn} eq $host ? $_->{record_id} : () } @{ $response->{records} }; 4740 unless($id) { 4741 failed("updating %s: DNS record ID not found.", $host); 4742 next; 4743 } 4744 4745 # Update the DNS record 4746 $url = "https://$config{$host}{'server'}/api2/admin/dns/edit"; 4747 my $data = "domain="; 4748 $data .= $config{$key}{'login'}; 4749 $data .= "&record_id="; 4750 $data .= $id; 4751 $data .= "&content="; 4752 $data .= $ip if $ip; 4753 4754 $reply = geturl(opt('proxy'), $url, '', '', $headers, 'POST', $data); 4755 unless ($reply) { 4756 failed("updating %s: Could not connect to %s.", $host, $config{$host}{'server'}); 4757 last; 4758 } 4759 last if !header_ok($host, $reply); 4760 4761 # Strip header 4762 $reply =~ s/^.*?\n\n//s; 4763 $response = eval { decode_json($reply) }; 4764 if ($response->{success} eq 'error') { 4765 failed ("%s", $response->{error}); 4766 } else { 4767 success ("%s -- Updated Successfully to %s", $host, $ip); 4768 } 4769 4770 # Cache 4771 $config{$host}{'ip'} = $ip; 4772 $config{$host}{'mtime'} = $now; 4773 $config{$host}{'status'} = 'good'; 4774 } 4775 } 4776} 4777 4778###################################################################### 4779## nic_duckdns_examples 4780###################################################################### 4781sub nic_duckdns_examples { 4782 return <<EoEXAMPLE; 4783o 'duckdns' 4784 4785The 'duckdns' protocol is used by the free 4786dynamic DNS service offered by www.duckdns.org. 4787Check http://www.duckdns.org/install.jsp?tab=linux-cron for API 4788 4789Configuration variables applicable to the 'duckdns' protocol are: 4790 protocol=duckdns ## 4791 server=www.fqdn.of.service ## defaults to www.duckdns.org 4792 password=service-password ## password (token) registered with the service 4793 non-fully.qualified.host ## the host registered with the service. 4794 4795Example ${program}.conf file entries: 4796 ## single host update 4797 protocol=duckdns, \\ 4798 password=z0mgs3cjur3p4ss \\ 4799 myhost 4800 4801EoEXAMPLE 4802} 4803 4804###################################################################### 4805## nic_duckdns_update 4806## by George Kranis (copypasta from nic_dtdns_update) 4807## http://www.duckdns.org/update?domains=mydomain1,mydomain2&token=xxxx-xxx-xx-x&ip=x.x.x.x 4808## response contains OK or KO 4809###################################################################### 4810sub nic_duckdns_update { 4811 debug("\nnic_duckdns_update -------------------"); 4812 4813 ## update each configured host 4814 ## should improve to update in one pass 4815 foreach my $h (@_) { 4816 my $ip = delete $config{$h}{'wantip'}; 4817 info("setting IP address to %s for %s", $ip, $h); 4818 verbose("UPDATE:","updating %s", $h); 4819 4820 # Set the URL that we're going to to update 4821 my $url; 4822 $url = "http://$config{$h}{'server'}/update"; 4823 $url .= "?domains="; 4824 $url .= $h; 4825 $url .= "&token="; 4826 $url .= $config{$h}{'password'}; 4827 $url .= "&ip="; 4828 $url .= $ip; 4829 4830 4831 # Try to get URL 4832 my $reply = geturl(opt('proxy'), $url); 4833 4834 # No response, declare as failed 4835 if (!defined($reply) || !$reply) { 4836 failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); 4837 last; 4838 } 4839 last if !header_ok($h, $reply); 4840 4841 my @reply = split /\n/, $reply; 4842 my $returned = pop(@reply); 4843 if ($returned =~ /OK/) 4844 { 4845 $config{$h}{'ip'} = $ip; 4846 $config{$h}{'mtime'} = $now; 4847 $config{$h}{'status'} = 'good'; 4848 success("updating %s: good: IP address set to %s", $h, $ip); 4849 } 4850 else 4851 { 4852 $config{$h}{'status'} = 'failed'; 4853 failed("updating %s: Server said: '$returned'", $h); 4854 } 4855 } 4856} 4857 4858###################################################################### 4859## nic_freemyip_examples 4860###################################################################### 4861sub nic_freemyip_examples { 4862 return <<EoEXAMPLE; 4863o 'freemyip' 4864 4865The 'freemyip' protocol is used by the free 4866dynamic DNS service available at freemyip.com. 4867API is documented here: https://freemyip.com/help.py 4868 4869Configuration variables applicable to the 'freemyip' protocol are: 4870 protocol=freemyip ## 4871 password=service-token ## token for your domain 4872 non-fully.qualified.host ## the host registered with the service. 4873 4874Example ${program}.conf file entries: 4875 ## single host update 4876 protocol=freemyip, \\ 4877 password=35a6b8d65c6e67c7f78cca65cd \\ 4878 myhost 4879 4880EoEXAMPLE 4881} 4882 4883###################################################################### 4884## nic_freemyip_update 4885## by Cadence (reused code from nic_duckdns) 4886## http://freemyip.com/update?token=ec54b4b64db27fe8873c7f7&domain=myhost 4887## response contains OK or ERROR 4888###################################################################### 4889sub nic_freemyip_update { 4890 debug("\nnic_freemyip_update -------------------"); 4891 4892 foreach my $h (@_) { 4893 my $ip = delete $config{$h}{'wantip'}; 4894 info("setting IP address to %s for %s", $ip, $h); 4895 verbose("UPDATE:","updating %s", $h); 4896 4897 # Set the URL that we're going to to update 4898 my $url; 4899 $url = "http://$config{$h}{'server'}/update"; 4900 $url .= "?token="; 4901 $url .= $config{$h}{'password'}; 4902 $url .= "&domain="; 4903 $url .= $h; 4904 4905 # Try to get URL 4906 my $reply = geturl(opt('proxy'), $url); 4907 4908 # No response, declare as failed 4909 if (!defined($reply) || !$reply) { 4910 failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); 4911 last; 4912 } 4913 last if !header_ok($h, $reply); 4914 4915 my @reply = split /\n/, $reply; 4916 my $returned = pop(@reply); 4917 if ($returned =~ /OK/) 4918 { 4919 $config{$h}{'ip'} = $ip; 4920 $config{$h}{'mtime'} = $now; 4921 $config{$h}{'status'} = 'good'; 4922 success("updating %s: good: IP address set to %s", $h, $ip); 4923 } 4924 else 4925 { 4926 $config{$h}{'status'} = 'failed'; 4927 failed("updating %s: Server said: '$returned'", $h); 4928 } 4929 } 4930} 4931 4932###################################################################### 4933## nic_woima_examples 4934###################################################################### 4935sub nic_woima_examples { 4936 return <<EoEXAMPLE; 4937o 'woima' 4938 4939The 'woima' protocol is used by the free 4940dynamic DNS service offered by woima.fi. 4941It offers also nameservers for own domains for free. 4942Dynamic DNS service for own domains is not free. 4943 4944Configuration variables applicable to the 'woima' protocol are: 4945 protocol=woima ## 4946 server=fqdn.of.service ## defaults to dyn.woima.fi 4947 script=/path/to/script ## defaults to /nic/update 4948 backupmx=no|yes ## indicates that this host is the primary MX for the domain. 4949 static=no|yes ## indicates that this host has a static IP address. 4950 custom=no|yes ## indicates that this host is a 'custom' top-level domain name. 4951 mx=any.host.domain ## a host MX'ing for this host definition. 4952 wildcard=no|yes ## add a DNS wildcard CNAME record that points to {host} 4953 login=service-login ## login name and password registered with the service 4954 password=service-password ## 4955 fully.qualified.host ## the host registered with the service. 4956 4957Example ${program}.conf file entries: 4958 ## single host update 4959 protocol=woima, \\ 4960 login=my-dyndns.org-login, \\ 4961 password=my-dyndns.org-password \\ 4962 myhost.dyndns.org 4963 4964 ## multiple host update with wildcard'ing mx, and backupmx 4965 protocol=woima, \\ 4966 login=my-dyndns.org-login, \\ 4967 password=my-dyndns.org-password, \\ 4968 mx=a.host.willing.to.mx.for.me,backupmx=yes,wildcard=yes \\ 4969 myhost.dyndns.org,my2ndhost.dyndns.org 4970 4971 ## multiple host update to the custom DNS service 4972 protocol=woima, \\ 4973 login=my-dyndns.org-login, \\ 4974 password=my-dyndns.org-password \\ 4975 my-toplevel-domain.com,my-other-domain.com 4976EoEXAMPLE 4977} 4978###################################################################### 4979## nic_woima_update 4980###################################################################### 4981sub nic_woima_update { 4982 debug("\nnic_woima_update -------------------"); 4983 4984 my %errors = ( 4985 'badauth' => 'Bad authorization (username or password)', 4986 'badsys' => 'The system parameter given was not valid', 4987 4988 'notfqdn' => 'A Fully-Qualified Domain Name was not provided', 4989 'nohost' => 'The hostname specified does not exist in the database', 4990 '!yours' => 'The hostname specified exists, but not under the username currently being used', 4991 '!donator' => 'The offline setting was set, when the user is not a donator', 4992 '!active' => 'The hostname specified is in a Custom DNS domain which has not yet been activated.', 4993 'abuse', => 'The hostname specified is blocked for abuse; you should receive an email notification ' . 4994 'which provides an unblock request link. More info can be found on ' . 4995 'https://www.dyndns.com/support/abuse.html', 4996 4997 'numhost' => 'System error: Too many or too few hosts found. Contact support@dyndns.org', 4998 'dnserr' => 'System error: DNS error encountered. Contact support@dyndns.org', 4999 5000 'nochg' => 'No update required; unnecessary attempts to change to the current address are considered abusive', 5001 ); 5002 5003 my @hosts = @_; 5004 foreach my $key (keys @hosts) { 5005 my $h = $hosts[$key]; 5006 my $ip = $config{$h}{'wantip'}; 5007 delete $config{$h}{'wantip'}; 5008 5009 info("setting IP address to %s for %s", $ip, $h); 5010 verbose("UPDATE:","updating %s", $h); 5011 5012 ## Select the DynDNS system to update 5013 my $url = "http://$config{$h}{'server'}$config{$h}{'script'}?system="; 5014 if ($config{$h}{'custom'}) { 5015 warning("updating %s: 'custom' and 'static' may not be used together. ('static' ignored)", $h) 5016 if $config{$h}{'static'}; 5017 # warning("updating %s: 'custom' and 'offline' may not be used together. ('offline' ignored)", $h) 5018 # if $config{$h}{'offline'}; 5019 $url .= 'custom'; 5020 5021 } elsif ($config{$h}{'static'}) { 5022 # warning("updating %s: 'static' and 'offline' may not be used together. ('offline' ignored)", $h) 5023 # if $config{$h}{'offline'}; 5024 $url .= 'statdns'; 5025 5026 } else { 5027 $url .= 'dyndns'; 5028 } 5029 5030 $url .= "&hostname=$h"; 5031 $url .= "&myip="; 5032 $url .= $ip if $ip; 5033 5034 ## some args are not valid for a custom domain. 5035 $url .= "&wildcard=ON" if ynu($config{$h}{'wildcard'}, 1, 0, 0); 5036 if ($config{$h}{'mx'}) { 5037 $url .= "&mx=$config{$h}{'mx'}"; 5038 $url .= "&backmx=" . ynu($config{$h}{'backupmx'}, 'YES', 'NO'); 5039 } 5040 5041 my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'}); 5042 if (!defined($reply) || !$reply) { 5043 failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); 5044 last; 5045 } 5046 last if !header_ok($h, $reply); 5047 5048 my @reply = split /\n/, $reply; 5049 my $state = 'header'; 5050 my $returnedip = $ip; 5051 5052 foreach my $line (@reply) { 5053 if ($state eq 'header') { 5054 $state = 'body'; 5055 5056 } elsif ($state eq 'body') { 5057 $state = 'results' if $line eq ''; 5058 5059 } elsif ($state =~ /^results/) { 5060 $state = 'results2'; 5061 5062 # bug #10: some dyndns providers does not return the IP so 5063 # we can't use the returned IP 5064 my ($status, $returnedip) = split / /, lc $line; 5065 $ip = $returnedip if (not $ip); 5066 #my $h = shift @hosts; 5067 5068 $config{$h}{'status'} = $status; 5069 if ($status eq 'good') { 5070 $config{$h}{'ip'} = $ip; 5071 $config{$h}{'mtime'} = $now; 5072 success("updating %s: %s: IP address set to %s", $h, $status, $ip); 5073 5074 } elsif (exists $errors{$status}) { 5075 if ($status eq 'nochg') { 5076 warning("updating %s: %s: %s", $h, $status, $errors{$status}); 5077 $config{$h}{'ip'} = $ip; 5078 $config{$h}{'mtime'} = $now; 5079 $config{$h}{'status'} = 'good'; 5080 5081 } else { 5082 failed("updating %s: %s: %s", $h, $status, $errors{$status}); 5083 } 5084 5085 } elsif ($status =~ /w(\d+)(.)/) { 5086 my ($wait, $units) = ($1, lc $2); 5087 my ($sec, $scale) = ($wait, 1); 5088 5089 ($scale, $units) = (1, 'seconds') if $units eq 's'; 5090 ($scale, $units) = (60, 'minutes') if $units eq 'm'; 5091 ($scale, $units) = (60*60, 'hours') if $units eq 'h'; 5092 5093 $sec = $wait * $scale; 5094 $config{$h}{'wtime'} = $now + $sec; 5095 warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip); 5096 5097 } else { 5098 failed("updating %s: %s: unexpected status (%s)", $h, $line); 5099 } 5100 } 5101 } 5102 failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}) 5103 if $state ne 'results2'; 5104 } 5105} 5106 5107###################################################################### 5108## nic_dondominio_examples 5109###################################################################### 5110sub nic_dondominio_examples { 5111 return <<EoEXAMPLE; 5112o 'dondominio' 5113The 'dondominio' protocol is used by DNS service offered by www.dondominio.com/ . 5114API information and user instructions available at: https://dev.dondominio.com/dondns/docs/api/ 5115Configuration variables applicable to the 'dondominio' protocol are: 5116 protocol=dondominio ## 5117 login=service-login ## the username registered with the service 5118 password=dondominio-apikey ## API key provided by dondominio -see link above- 5119 fully.qualified.host ## the host registered with the service. 5120Example ${program}.conf file entries: 5121 ## single host update 5122 protocol=dondominio, \\ 5123 login=my-generated-user-name, \\ 5124 password=dondominio-apikey \\ 5125 myhost.tld 5126 5127EoEXAMPLE 5128} 5129 5130###################################################################### 5131## nic_dondominio_examples 5132###################################################################### 5133 5134sub nic_dondominio_update { 5135 debug("\nnic_duckdns_update -------------------"); 5136 5137 ## update each configured host 5138 ## should improve to update in one pass 5139 foreach my $h (@_) { 5140 my $ip = delete $config{$h}{'wantip'}; 5141 info("setting IP address to %s for %s", $ip, $h); 5142 verbose("UPDATE:","updating %s", $h); 5143 5144 # Set the URL that we're going to update 5145 my $url; 5146 $url = "https://$config{$h}{'server'}/plain/"; 5147 $url .= "?user="; 5148 $url .= $config{$h}{'login'}; 5149 $url .= "&password="; 5150 $url .= $config{$h}{'password'}; 5151 $url .= "&host="; 5152 $url .= $h; 5153 $url .= "&ip="; 5154 $url .= $ip if $ip; 5155 5156 5157 # Try to get URL 5158 my $reply = geturl(opt('proxy'), $url); 5159 5160 # No response, declare as failed 5161 if (!defined($reply) || !$reply) { 5162 failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); 5163 last; 5164 } 5165 last if !header_ok($h, $reply); 5166 5167 my @reply = split /\n/, $reply; 5168 my $returned = pop(@reply); 5169 if ($returned =~ /OK/) { 5170 $config{$h}{'ip'} = $ip; 5171 $config{$h}{'mtime'} = $now; 5172 $config{$h}{'status'} = 'good'; 5173 success("updating %s: good: IP address set to %s", $h, $ip); 5174 } else { 5175 $config{$h}{'status'} = 'failed'; 5176 failed("updating %s: Server said: '$returned'", $h); 5177 } 5178 } 5179} 5180 5181###################################################################### 5182## nic_dnsmadeeasy_examples 5183###################################################################### 5184sub nic_dnsmadeeasy_examples { 5185 return <<EoEXAMPLE; 5186o 'dnsmadeeasy' 5187 5188The 'dnsmadeeasy' protocol is used by the DNS Made Easy service at https://www.dnsmadeeasy.com. 5189API is documented here: https://dnsmadeeasy.com/technology/dynamic-dns/ 5190 5191Configuration variables applicable to the 'dnsmadeeasy' protocol are: 5192 protocol=dnsmadeeasy ## 5193 login=email-address ## Email address used to log in to your account. 5194 password=dynamic-record-password ## Generated password for your dynamic DNS record. 5195 record-id-1,record-id-2,... ## Numeric dynamic DNS record IDs, comma-separated if updating multiple. 5196 5197Note: Dynamic record ID is generated when you create a new Dynamic DNS record in the DNS Made Easy control panel. 5198 5199Example ${program}.conf file entries: 5200 ## single host update 5201 protocol=dnsmadeeasy, \\ 5202 username=dme\@example.com, \\ 5203 password=myg3nerat3dp4ssword, \\ 5204 1007,1008 5205 5206EoEXAMPLE 5207} 5208 5209###################################################################### 5210## nic_dnsmadeeasy_update 5211###################################################################### 5212sub nic_dnsmadeeasy_update { 5213 debug("\nnic_dnsmadeeasy_update -------------------"); 5214 5215 my %messages = ( 5216 'error-auth' => 'Invalid username or password, or invalid IP syntax', 5217 'error-auth-suspend' => 'User has had their account suspended due to complaints or misuse of the service.', 5218 'error-auth-voided' => 'User has had their account permanently revoked.', 5219 'error-record-invalid' =>'Record ID number does not exist in the system.', 5220 'error-record-auth' => 'User does not have access to this record.', 5221 'error-record-ip-same' => 'No update required.', 5222 'error-system' => 'General system error which is caught and recognized by the system.', 5223 'error' => 'General system error unrecognized by the system.', 5224 'success' => 'Record successfully updated!', 5225 ); 5226 5227 ## update each configured host 5228 ## should improve to update in one pass 5229 foreach my $h (@_) { 5230 my $ip = delete $config{$h}{'wantip'}; 5231 info("Setting IP address to %s for %s", $ip, $h); 5232 verbose("UPDATE:","Updating %s", $h); 5233 5234 # Set the URL that we're going to to update 5235 my $url; 5236 $url = $globals{'ssl'} ? "https://" : "http://"; 5237 $url .= $config{$h}{'server'}.$config{$h}{'script'}; 5238 $url .= "?username=$config{$h}{'login'}"; 5239 $url .= "&password=$config{$h}{'password'}"; 5240 $url .= "&ip=$ip"; 5241 $url .= "&id=$h"; 5242 5243 # Try to get URL 5244 my $reply = geturl(opt('proxy'), $url); 5245 5246 # No response, declare as failed 5247 if (!defined($reply) || !$reply) { 5248 failed("Updating %s: Could not connect to %s.", $h, $config{$h}{'server'}); 5249 last; 5250 } 5251 last if !header_ok($h, $reply); 5252 5253 my @reply = split /\n/, $reply; 5254 my $returned = pop(@reply); 5255 if ($returned =~ 'success') 5256 { 5257 $config{$h}{'ip'} = $ip; 5258 $config{$h}{'mtime'} = $now; 5259 $config{$h}{'status'} = 'good'; 5260 success("Updating %s: good: IP address set to %s", $h, $ip); 5261 } 5262 else 5263 { 5264 $config{$h}{'status'} = 'failed'; 5265 failed("Updating %s: Server said: '$returned': $messages{$returned}", $h); 5266 } 5267 } 5268} 5269 5270###################################################################### 5271# vim: ai ts=4 sw=4 tw=78 : 5272 5273 5274__END__ 5275