API tools faq
paste
Advertisement
Guest User

Untitled

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