~ubuntu-branches/ubuntu/vivid/ddclient/vivid : revision 40

1

#!/usr/bin/perl -w

2

#!/usr/local/bin/perl -w

3

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

4

# $Id: ddclient 130 2011-07-11 21:02:07Z 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

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

17

require 5.004;

18

use strict;

19

use Getopt::Long;

20

use Sys::Hostname;

21

use IO::Socket;

22

23

my ($VERSION) = q$Revision: 130 $ =~ /(\d+)/;

24

25

my $version = "3.8.1";

26

my $programd = $0;

27

$programd =~ s%^.*/%%;

28

my $program = $programd;

29

$program =~ s/d$//;

30

my $now = time;

31

my $hostname = hostname();

32

my $etc = ($program =~ /test/i) ? './' : '/etc/';

33

my $cachedir = ($program =~ /test/i) ? './' : '/var/cache/ddclient/';

34

my $savedir = ($program =~ /test/i) ? 'URL/' : '/tmp/';

35

my $msgs = '';

36

my $last_msgs = '';

37

38

use vars qw($file $lineno);

39

local $file = '';

40

local $lineno = '';

41

42

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

43

44

sub T_ANY {'any'};

45

sub T_STRING {'string'};

46

sub T_EMAIL {'e-mail address'};

47

sub T_NUMBER {'number'};

48

sub T_DELAY {'time delay (ie. 1d, 1hour, 1m)'};

49

sub T_LOGIN {'login'};

50

sub T_PASSWD {'password'};

51

sub T_BOOL {'boolean value'};

52

sub T_FQDN {'fully qualified host name'};

53

sub T_OFQDN {'optional fully qualified host name'};

54

sub T_FILE {'file name'};

55

sub T_FQDNP {'fully qualified host name and optional port number'};

56

sub T_PROTO {'protocol'}

57

sub T_USE {'ip strategy'}

58

sub T_IF {'interface'}

59

sub T_PROG {'program name'}

60

sub T_IP {'ip'}

61

sub T_POSTS {'postscript'};

62

63

## strategies for obtaining an ip address.

64

my %builtinweb = (

65

'dyndns' => { 'url' => 'http://checkip.dyndns.org/', 'skip' =>

66

'Current IP Address:', },

67

'dnspark' => { 'url' => 'http://ipdetect.dnspark.com/', 'skip' => 'Current Address:', },

68

'loopia' => { 'url' => 'http://dns.loopia.se/checkip/checkip.php', 'skip' => 'Current Address:', },

69

);

70

my %builtinfw = (

71

'watchguard-soho' => {

72

'name' => 'Watchguard SOHO FW',

73

'url' => '/pubnet.htm',

74

'skip' => 'NAME=IPAddress VALUE=',

75

},

76

'netopia-r910' => {

77

'name' => 'Netopia R910 FW',

78

'url' => '/WanEvtLog',

79

'skip' => 'local:',

80

},

81

'smc-barricade' => {

82

'name' => 'SMC Barricade FW',

83

'url' => '/status.htm',

84

'skip' => 'IP Address',

85

},

86

'smc-barricade-alt' => {

87

'name' => 'SMC Barricade FW (alternate config)',

88

'url' => '/status.HTM',

89

'skip' => 'WAN IP',

90

},

91

'smc-barricade-alt' => {

92

'name' => 'SMC Barricade FW (alternate config)',

93

'url' => '/status.HTM',

94

'skip' => 'WAN IP',

95

},

96

'smc-barricade-7401bra' => {

97

'name' => 'SMC Barricade 7401BRA FW',

98

'url' => '/admin/wan1.htm',

99

'skip' => 'IP Address',

100

},

101

'netgear-rt3xx' => {

102

'name' => 'Netgear FW',

103

'url' => '/mtenSysStatus.html',

104

'skip' => 'IP Address',

105

},

106

'elsa-lancom-dsl10' => {

107

'name' => 'ELSA LanCom DSL/10 DSL FW',

108

'url' => '/config/1/6/8/3/',

109

'skip' => 'IP.Address',

110

},

111

'elsa-lancom-dsl10-ch01' => {

112

'name' => 'ELSA LanCom DSL/10 DSL FW (isdn ch01)',

113

'url' => '/config/1/6/8/3/',

114

'skip' => 'IP.Address.*?CH01',

115

},

116

'elsa-lancom-dsl10-ch02' => {

117

'name' => 'ELSA LanCom DSL/10 DSL FW (isdn ch01)',

118

'url' => '/config/1/6/8/3/',

119

'skip' => 'IP.Address.*?CH02',

120

},

121

'linksys' => {

122

'name' => 'Linksys FW',

123

'url' => '/Status.htm',

124

'skip' => 'WAN.*?Address',

125

},

126

'linksys-ver2' => {

127

'name' => 'Linksys FW version 2',

128

'url' => '/RouterStatus.htm',

129

'skip' => 'WAN.*?Address',

130

},

131

'linksys-ver3' => {

132

'name' => 'Linksys FW version 3',

133

'url' => '/Status_Router.htm',

134

'skip' => 'WAN.*?Address',

135

},

136

'linksys-wrt854g' => {

137

'name' => 'Linksys WRT854G FW',

138

'url' => '/Status_Router.asp',

139

'skip' => 'IP Address:',

140

},

141

'maxgate-ugate3x00' => {

142

'name' => 'MaxGate UGATE-3x00 FW',

143

'url' => '/Status.htm',

144

'skip' => 'WAN.*?IP Address',

145

},

146

'netcomm-nb3' => {

147

'name' => 'NetComm NB3',

148

'url' => '/MainPage?id=6',

149

'skip' => 'ppp-0',

150

},

151

'3com-3c886a' => {

152

'name' => '3com 3c886a 56k Lan Modem',

153

'url' => '/stat3.htm',

154

'skip' => 'IP address in use',

155

},

156

'sohoware-nbg800' => {

157

'name' => 'SOHOWare BroadGuard NBG800',

158

'url' => '/status.htm',

159

'skip' => 'Internet IP',

160

},

161

'xsense-aero' => {

162

'name' => 'Xsense Aero',

163

'url' => '/A_SysInfo.htm',

164

'skip' => 'WAN.*?IP Address',

165

},

166

'alcatel-stp' => {

167

'name' => 'Alcatel Speed Touch Pro',

168

'url' => '/cgi/router/',

169

'skip' => 'Brt',

170

},

171

'alcatel-510' => {

172

'name' => 'Alcatel Speed Touch 510',

173

'url' => '/cgi/ip/',

174

'skip' => 'ppp',

175

},

176

'allnet-1298' => {

177

'name' => 'Allnet 1298',

178

'url' => '/cgi/router/',

179

'skip' => 'WAN',

180

},

181

'3com-oc-remote812' => {

182

'name' => '3com OfficeConnect Remote 812',

183

'url' => '/callEvent',

184

'skip' => '.*LOCAL',

185

},

186

'e-tech' => {

187

'name' => 'E-tech Router',

188

'url' => '/Status.htm',

189

'skip' => 'Public IP Address',

190

},

191

'cayman-3220h' => {

192

'name' => 'Cayman 3220-H DSL',

193

'url' => '/shell/show+ip+interfaces',

194

'skip' => '.*inet',

195

},

196

'vigor-2200usb' => {

197

'name' => 'Vigor 2200 USB',

198

'url' => '/doc/online.sht',

199

'skip' => 'PPPoA',

200

},

201

'dlink-614' => {

202

'name' => 'D-Link DI-614+',

203

'url' => '/st_devic.html',

204

'skip' => 'WAN',

205

},

206

'dlink-604' => {

207

'name' => 'D-Link DI-604',

208

'url' => '/st_devic.html',

209

'skip' => 'WAN.*?IP.*Address',

210

},

211

'olitec-SX200' => {

212

'name' => 'olitec-SX200',

213

'url' => '/doc/wan.htm',

214

'skip' => 'st_wan_ip[0] = "',

215

},

216

'westell-6100' => {

217

'name' => 'Westell C90-610015-06 DSL Router',

218

'url' => '/advstat.htm',

219

'skip' => 'IP.+?Address',

220

},

221

'2wire' => {

222

'name' => '2Wire 1701HG Gateway',

223

'url' => '/xslt?PAGE=B01',

224

'skip' => 'Internet Address:',

225

},

226

'linksys-rv042-wan1' => {

227

'name' => 'Linksys RV042 Dual Homed Router WAN Port 2',

228

'url' => '/home.htm',

229

'skip' => 'WAN1 IP',

230

},

231

'linksys-rv042-wan2' => {

232

'name' => 'Linksys RV042 Dual Homed Router WAN Port 2',

233

'url' => '/home.htm',

234

'skip' => 'WAN2 IP',

235

},

236

'netgear-rp614' => {

237

'name' => 'Netgear RP614 FW',

238

'url' => '/sysstatus.html',

239

'skip' => 'IP Address',

240

},

241

'watchguard-edge-x' => {

242

'name' => 'Watchguard Edge X FW',

243

'url' => '/netstat.htm',

244

'skip' => 'inet addr:',

245

},

246

'dlink-524' => {

247

'name' => 'D-Link DI-524',

248

'url' => '/st_device.html',

249

'skip' => 'WAN.*?Addres',

250

},

251

'rtp300' => {

252

'name' => 'Linksys RTP300',

253

'url' => '/cgi-bin/webcm?getpage=%2Fusr%2Fwww_safe%2Fhtml%2Fstatus%2FRouter.html',

254

'skip' => 'Internet.*?IP Address',

255

},

256

'netgear-wpn824' => {

257

'name' => 'Netgear WPN824 FW',

258

'url' => '/RST_status.htm',

259

'skip' => 'IP Address',

260

},

261

'linksys-wcg200' => {

262

'name' => 'Linksys WCG200 FW',

263

'url' => '/RgStatus.asp',

264

'skip' => 'WAN.IP.*?Address',

265

},

266

'netgear-dg834g' => {

267

'name' => 'netgear-dg834g',

268

'url' => '/setup.cgi?next_file=s_status.htm&todo=cfg_init',

269

'skip' => '',

270

},

271

'netgear-wgt624' => {

272

'name' => 'Netgear WGT624',

273

'url' => '/RST_st_dhcp.htm',

274

'skip' => 'IP Address</B></td><TD NOWRAP width="50%">',

275

},

276

'sveasoft' => {

277

'name' => 'Sveasoft WRT54G/WRT54GS',

278

'url' => '/Status_Router.asp',

279

'skip' => 'var wan_ip',

280

},

281

'smc-barricade-7004vbr' => {

282

'name' => 'SMC Barricade FW (7004VBR model config)',

283

'url' => '/status_main.stm',

284

'skip' => 'var wan_ip=',

285

},

286

'sitecom-dc202' => {

287

'name' => 'Sitecom DC-202 FW',

288

'url' => '/status.htm',

289

'skip' => 'Internet IP Address',

290

},

291

);

292

my %ip_strategies = (

293

'ip' => ": obtain IP from -ip {address}",

294

'web' => ": obtain IP from an IP discovery page on the web",

295

'fw' => ": obtain IP from the firewall specified by -fw {type|address}",

296

'if' => ": obtain IP from the -if {interface}",

297

'cmd' => ": obtain IP from the -cmd {external-command}",

298

'cisco' => ": obtain IP from Cisco FW at the -fw {address}",

299

'cisco-asa' => ": obtain IP from Cisco ASA at the -fw {address}",

300

map { $_ => sprintf ": obtain IP from %s at the -fw {address}", $builtinfw{$_}->{'name'} } keys %builtinfw,

301

);

302

sub ip_strategies_usage {

303

return map { sprintf(" -use=%-22s %s.", $_, $ip_strategies{$_}) } sort keys %ip_strategies;

304

}

305

306

my %web_strategies = (

307

'dyndns'=> 1,

308

'dnspark'=> 1,

309

'loopia'=> 1,

310

);

311

312

sub setv {

313

return {

314

'type' => shift,

315

'required' => shift,

316

'cache' => shift,

317

'config' => shift,

318

'default' => shift,

319

'minimum' => shift,

320

};

321

};

322

my %variables = (

323

'global-defaults' => {

324

'daemon' => setv(T_DELAY, 0, 0, 1, 0, interval('60s')),

325

'foreground' => setv(T_BOOL, 0, 0, 1, 0, undef),

326

'file' => setv(T_FILE, 0, 0, 1, "$etc$program.conf", undef),

327

'cache' => setv(T_FILE, 0, 0, 1, "$cachedir$program.cache", undef),

328

'pid' => setv(T_FILE, 0, 0, 1, "", undef),

329

'proxy' => setv(T_FQDNP, 0, 0, 1, '', undef),

330

'protocol' => setv(T_PROTO, 0, 0, 1, 'dyndns2', undef),

331

332

'use' => setv(T_USE, 0, 0, 1, 'ip', undef),

333

'ip' => setv(T_IP, 0, 0, 1, undef, undef),

334

'if' => setv(T_IF, 0, 0, 1, 'ppp0', undef),

335

'if-skip' => setv(T_STRING,1, 0, 1, '', undef),

336

'web' => setv(T_STRING,0, 0, 1, 'dyndns', undef),

337

'web-skip' => setv(T_STRING,1, 0, 1, '', undef),

338

'fw' => setv(T_ANY, 0, 0, 1, '', undef),

339

'fw-skip' => setv(T_STRING,1, 0, 1, '', undef),

340

'fw-login' => setv(T_LOGIN, 1, 0, 1, '', undef),

341

'fw-password' => setv(T_PASSWD,1, 0, 1, '', undef),

342

'cmd' => setv(T_PROG, 0, 0, 1, '', undef),

343

'cmd-skip' => setv(T_STRING,1, 0, 1, '', undef),

344

345

'timeout' => setv(T_DELAY, 0, 0, 1, interval('120s'), interval('120s')),

346

'retry' => setv(T_BOOL, 0, 0, 0, 0, undef),

347

'force' => setv(T_BOOL, 0, 0, 0, 0, undef),

348

'ssl' => setv(T_BOOL, 0, 0, 0, 0, undef),

349

350

'syslog' => setv(T_BOOL, 0, 0, 1, 0, undef),

351

'facility' => setv(T_STRING,0, 0, 1, 'daemon', undef),

352

'priority' => setv(T_STRING,0, 0, 1, 'notice', undef),

353

'mail' => setv(T_EMAIL, 0, 0, 1, '', undef),

354

'mail-failure' => setv(T_EMAIL, 0, 0, 1, '', undef),

355

356

'exec' => setv(T_BOOL, 0, 0, 1, 1, undef),

357

'debug' => setv(T_BOOL, 0, 0, 1, 0, undef),

358

'verbose' => setv(T_BOOL, 0, 0, 1, 0, undef),

359

'quiet' => setv(T_BOOL, 0, 0, 1, 0, undef),

360

'help' => setv(T_BOOL, 0, 0, 1, 0, undef),

361

'test' => setv(T_BOOL, 0, 0, 1, 0, undef),

362

'geturl' => setv(T_STRING,0, 0, 0, '', undef),

363

364

'postscript' => setv(T_POSTS, 0, 0, 1, '', undef),

365

},

366

'service-common-defaults' => {

367

'server' => setv(T_FQDNP, 1, 0, 1, 'members.dyndns.org', undef),

368

'login' => setv(T_LOGIN, 1, 0, 1, '', undef),

369

'password' => setv(T_PASSWD, 1, 0, 1, '', undef),

370

'host' => setv(T_STRING, 1, 1, 1, '', undef),

371

372

'use' => setv(T_USE, 0, 0, 1, 'ip', undef),

373

'if' => setv(T_IF, 0, 0, 1, 'ppp0', undef),

374

'if-skip' => setv(T_STRING,0, 0, 1, '', undef),

375

'web' => setv(T_STRING,0, 0, 1, 'dyndns', undef),

376

'web-skip' => setv(T_STRING,0, 0, 1, '', undef),

377

'fw' => setv(T_ANY, 0, 0, 1, '', undef),

378

'fw-skip' => setv(T_STRING,0, 0, 1, '', undef),

379

'fw-login' => setv(T_LOGIN, 0, 0, 1, '', undef),

380

'fw-password' => setv(T_PASSWD,0, 0, 1, '', undef),

381

'cmd' => setv(T_PROG, 0, 0, 1, '', undef),

382

'cmd-skip' => setv(T_STRING,0, 0, 1, '', undef),

383

384

'ip' => setv(T_IP, 0, 1, 0, undef, undef),

385

'wtime' => setv(T_DELAY, 0, 1, 1, 0, interval('30s')),

386

'mtime' => setv(T_NUMBER, 0, 1, 0, 0, undef),

387

'atime' => setv(T_NUMBER, 0, 1, 0, 0, undef),

388

'status' => setv(T_ANY, 0, 1, 0, '', undef),

389

'min-interval' => setv(T_DELAY, 0, 0, 1, interval('30s'), 0),

390

'max-interval' => setv(T_DELAY, 0, 0, 1, interval('30d'), 0),

391

'min-error-interval' => setv(T_DELAY, 0, 0, 1, interval('5m'), 0),

392

393

'warned-min-interval' => setv(T_ANY, 0, 1, 0, 0, undef),

394

'warned-min-error-interval' => setv(T_ANY, 0, 1, 0, 0, undef),

395

},

396

'dyndns-common-defaults' => {

397

'static' => setv(T_BOOL, 0, 1, 1, 0, undef),

398

'wildcard' => setv(T_BOOL, 0, 1, 1, 0, undef),

399

'mx' => setv(T_OFQDN, 0, 1, 1, '', undef),

400

'backupmx' => setv(T_BOOL, 0, 1, 1, 0, undef),

401

},

402

'easydns-common-defaults' => {

403

'wildcard' => setv(T_BOOL, 0, 1, 1, 0, undef),

404

'mx' => setv(T_OFQDN, 0, 1, 1, '', undef),

405

'backupmx' => setv(T_BOOL, 0, 1, 1, 0, undef),

406

},

407

'dnspark-common-defaults' => {

408

'mx' => setv(T_OFQDN, 0, 1, 1, '', undef),

409

'mxpri' => setv(T_NUMBER, 0, 0, 1, 5, undef),

410

},

411

'noip-common-defaults' => {

412

'static' => setv(T_BOOL, 0, 1, 1, 0, undef),

413

},

414

'noip-service-common-defaults' => {

415

'server' => setv(T_FQDNP, 1, 0, 1, 'dynupdate.no-ip.com', undef),

416

'login' => setv(T_LOGIN, 1, 0, 1, '', undef),

417

'password' => setv(T_PASSWD, 1, 0, 1, '', undef),

418

'host' => setv(T_STRING, 1, 1, 1, '', undef),

419

'ip' => setv(T_IP, 0, 1, 0, undef, undef),

420

'wtime' => setv(T_DELAY, 0, 1, 1, 0, interval('30s')),

421

'mtime' => setv(T_NUMBER, 0, 1, 0, 0, undef),

422

'atime' => setv(T_NUMBER, 0, 1, 0, 0, undef),

423

'status' => setv(T_ANY, 0, 1, 0, '', undef),

424

'min-interval' => setv(T_DELAY, 0, 0, 1, interval('30s'), 0),

425

'max-interval' => setv(T_DELAY, 0, 0, 1, interval('25d'), 0),

426

'min-error-interval' => setv(T_DELAY, 0, 0, 1, interval('5m'), 0),

427

'warned-min-interval' => setv(T_ANY, 0, 1, 0, 0, undef),

428

'warned-min-error-interval' => setv(T_ANY, 0, 1, 0, 0, undef),

429

},

430

'zoneedit-service-common-defaults' => {

431

'zone' => setv(T_OFQDN, 0, 0, 1, undef, undef),

432

},

433

'dtdns-common-defaults' => {

434

'login' => setv(T_LOGIN, 0, 0, 0, 'unused', undef),

435

'client' => setv(T_STRING, 0, 1, 1, $program, undef),

436

},

437

);

438

my %services = (

439

'dyndns1' => {

440

'updateable' => \&nic_dyndns2_updateable,

441

'update' => \&nic_dyndns1_update,

442

'examples' => \&nic_dyndns1_examples,

443

'variables' => merge(

444

$variables{'dyndns-common-defaults'},

445

$variables{'service-common-defaults'},

446

),

447

},

448

'dyndns2' => {

449

'updateable' => \&nic_dyndns2_updateable,

450

'update' => \&nic_dyndns2_update,

451

'examples' => \&nic_dyndns2_examples,

452

'variables' => merge(

453

{ 'custom' => setv(T_BOOL, 0, 1, 1, 0, undef), },

454

{ 'script' => setv(T_STRING, 1, 1, 1, '/nic/update', undef), },

455

# { 'offline' => setv(T_BOOL, 0, 1, 1, 0, undef), },

456

$variables{'dyndns-common-defaults'},

457

$variables{'service-common-defaults'},

458

),

459

},

460

'noip' => {

461

'updateable' => undef,

462

'update' => \&nic_noip_update,

463

'examples' => \&nic_noip_examples,

464

'variables' => merge(

465

{ 'custom' => setv(T_BOOL, 0, 1, 1, 0, undef), },

466

$variables{'noip-common-defaults'},

467

$variables{'noip-service-common-defaults'},

468

),

469

},

470

'concont' => {

471

'updateable' => undef,

472

'update' => \&nic_concont_update,

473

'examples' => \&nic_concont_examples,

474

'variables' => merge(

475

$variables{'service-common-defaults'},

476

{ 'mx' => setv(T_OFQDN, 0, 1, 1, '', undef), },

477

{ 'wildcard' => setv(T_BOOL, 0, 1, 1, 0, undef), },

478

),

479

},

480

'dslreports1' => {

481

'updateable' => undef,

482

'update' => \&nic_dslreports1_update,

483

'examples' => \&nic_dslreports1_examples,

484

'variables' => merge(

485

{ 'host' => setv(T_NUMBER, 1, 1, 1, 0, undef) },

486

$variables{'service-common-defaults'},

487

),

488

},

489

'hammernode1' => {

490

'updateable' => undef,

491

'update' => \&nic_hammernode1_update,

492

'examples' => \&nic_hammernode1_examples,

493

'variables' => merge(

494

{ 'server' => setv(T_FQDNP, 1, 0, 1, 'dup.hn.org', undef) },

495

{ 'min-interval' => setv(T_DELAY, 0, 0, 1, interval('5m'), 0),},

496

$variables{'service-common-defaults'},

497

),

498

},

499

'zoneedit1' => {

500

'updateable' => undef,

501

'update' => \&nic_zoneedit1_update,

502

'examples' => \&nic_zoneedit1_examples,

503

'variables' => merge(

504

{ 'server' => setv(T_FQDNP, 1, 0, 1, 'dynamic.zoneedit.com', undef) },

505

{ 'min-interval' => setv(T_DELAY, 0, 0, 1, interval('5m'), 0),},

506

$variables{'service-common-defaults'},

507

$variables{'zoneedit-service-common-defaults'},

508

),

509

},

510

'easydns' => {

511

'updateable' => undef,

512

'update' => \&nic_easydns_update,

513

'examples' => \&nic_easydns_examples,

514

'variables' => merge(

515

{ 'server' => setv(T_FQDNP, 1, 0, 1, 'members.easydns.com', undef) },

516

{ 'min-interval' => setv(T_DELAY, 0, 0, 1, interval('5m'), 0),},

517

$variables{'easydns-common-defaults'},

518

$variables{'service-common-defaults'},

519

),

520

},

521

'dnspark' => {

522

'updateable' => undef,

523

'update' => \&nic_dnspark_update,

524

'examples' => \&nic_dnspark_examples,

525

'variables' => merge(

526

{ 'server' => setv(T_FQDNP, 1, 0, 1, 'www.dnspark.com', undef) },

527

{ 'min-interval' => setv(T_DELAY, 0, 0, 1, interval('5m'), 0),},

528

$variables{'dnspark-common-defaults'},

529

$variables{'service-common-defaults'},

530

),

531

},

532

'namecheap' => {

533

'updateable' => undef,

534

'update' => \&nic_namecheap_update,

535

'examples' => \&nic_namecheap_examples,

536

'variables' => merge(

537

{ 'server' => setv(T_FQDNP, 1, 0, 1, 'dynamicdns.park-your-domain.com', undef) },

538

{ 'min-interval' => setv(T_DELAY, 0, 0, 1, 0, interval('5m')),},

539

$variables{'service-common-defaults'},

540

),

541

},

542

'sitelutions' => {

543

'updateable' => undef,

544

'update' => \&nic_sitelutions_update,

545

'examples' => \&nic_sitelutions_examples,

546

'variables' => merge(

547

{ 'server' => setv(T_FQDNP, 1, 0, 1, 'www.sitelutions.com', undef) },

548

{ 'min-interval' => setv(T_DELAY, 0, 0, 1, 0, interval('5m')),},

549

$variables{'service-common-defaults'},

550

),

551

},

552

'freedns' => {

553

'updateable' => undef,

554

'update' => \&nic_freedns_update,

555

'examples' => \&nic_freedns_examples,

556

'variables' => merge(

557

{ 'server' => setv(T_FQDNP, 1, 0, 1, 'freedns.afraid.org', undef) },

558

{ 'min-interval' => setv(T_DELAY, 0, 0, 1, 0, interval('5m')),},

559

$variables{'service-common-defaults'},

560

),

561

},

562

'dtdns' => {

563

'updateable' => undef,

564

'update' => \&nic_dtdns_update,

565

'examples' => \&nic_dtdns_examples,

566

'variables' => merge(

567

$variables{'dtdns-common-defaults'},

568

$variables{'service-common-defaults'},

569

),

570

},

571

);

572

$variables{'merged'} = merge($variables{'global-defaults'},

573

$variables{'service-common-defaults'},

574

$variables{'dyndns-common-defaults'},

575

map { $services{$_}{'variables'} } keys %services,

576

);

577

578

my @opt = (

579

"usage: ${program} [options]",

580

"options are:",

581

[ "daemon", "=s", "-daemon delay : run as a daemon, specify delay as an interval." ],

582

+ [ "foreground", "!", "-foreground : do not fork" ],

583

[ "proxy", "=s", "-proxy host : use 'host' as the HTTP proxy" ],

584

[ "server", "=s", "-server host : update DNS information on 'host'" ],

585

[ "protocol", "=s", "-protocol type : update protocol used" ],

586

[ "file", "=s", "-file path : load configuration information from 'path'" ],

587

[ "cache", "=s", "-cache path : record address used in 'path'" ],

588

[ "pid", "=s", "-pid path : record process id in 'path'" ],

589

"",

590

[ "use", "=s", "-use which : how the should IP address be obtained." ],

591

&ip_strategies_usage(),

592

"",

593

[ "ip", "=s", "-ip address : set the IP address to 'address'" ],

594

"",

595

[ "if", "=s", "-if interface : obtain IP address from 'interface'" ],

596

[ "if-skip", "=s", "-if-skip pattern : skip any IP addresses before 'pattern' in the output of ifconfig {if}" ],

597

"",

598

[ "web", "=s", "-web provider|url : obtain IP address from provider's IP checking page" ],

599

[ "web-skip", "=s", "-web-skip pattern : skip any IP addresses before 'pattern' on the web provider|url" ],

600

"",

601

[ "fw", "=s", "-fw address|url : obtain IP address from firewall at 'address'" ],

602

[ "fw-skip", "=s", "-fw-skip pattern : skip any IP addresses before 'pattern' on the firewall address|url" ],

603

[ "fw-login", "=s", "-fw-login login : use 'login' when getting IP from fw" ],

604

[ "fw-password", "=s", "-fw-password secret : use password 'secret' when getting IP from fw" ],

605

"",

606

[ "cmd", "=s", "-cmd program : obtain IP address from by calling {program}" ],

607

[ "cmd-skip", "=s", "-cmd-skip pattern : skip any IP addresses before 'pattern' in the output of {cmd}" ],

608

"",

609

[ "login", "=s", "-login user : login as 'user'" ],

610

[ "password", "=s", "-password secret : use password 'secret'" ],

611

[ "host", "=s", "-host host : update DNS information for 'host'" ],

612

"",

613

[ "options", "=s", "-options opt,opt : optional per-service arguments (see below)" ],

614

"",

615

[ "ssl", "!", "-{no}ssl : do updates over encrypted SSL connection" ],

616

[ "retry", "!", "-{no}retry : retry failed updates." ],

617

[ "force", "!", "-{no}force : force an update even if the update may be unnecessary" ],

618

[ "timeout", "=i", "-timeout max : wait at most 'max' seconds for the host to respond" ],

619

620

[ "syslog", "!", "-{no}syslog : log messages to syslog" ],

621

[ "facility", "=s", "-facility {type} : log messages to syslog to facility {type}" ],

622

[ "priority", "=s", "-priority {pri} : log messages to syslog with priority {pri}" ],

623

[ "mail", "=s", "-mail address : e-mail messages to {address}" ],

624

[ "mail-failure","=s", "-mail-failure address : e-mail messages for failed updates to {address}" ],

625

[ "exec", "!", "-{no}exec : do {not} execute; just show what would be done" ],

626

[ "debug", "!", "-{no}debug : print {no} debugging information" ],

627

[ "verbose", "!", "-{no}verbose : print {no} verbose information" ],

628

[ "quiet", "!", "-{no}quiet : print {no} messages for unnecessary updates" ],

629

[ "help", "", "-help : this message" ],

630

[ "postscript", "", "-postscript : script to run after updating ddclient, has new IP as param" ],

631

632

[ "query", "!", "-{no}query : print {no} ip addresses and exit" ],

633

[ "test", "!", "" ], ## hidden

634

[ "geturl", "=s", "" ], ## hidden

635

"",

636

nic_examples(),

637

"$program version $version, ",

638

" originally written by Paul Burry, paul+ddclient\@burry.ca",

639

" project now maintained on http://ddclient.sourceforge.net"

640

);

641

642

## process args

643

my ($opt_usage, %opt) = process_args(@opt);

644

my ($result, %config, %globals, %cache);

645

my $saved_cache = '';

646

my %saved_opt = %opt;

647

$result = 'OK';

648

649

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

650

651

## process help option

652

if (opt('help')) {

653

*STDERR = *STDOUT;

654

usage(0);

655

}

656

657

## read config file because 'daemon' mode may be defined there.

658

read_config(define($opt{'file'}, default('file')), \%config, \%globals);

659

init_config();

660

test_possible_ip() if opt('query');

661

662

if (!opt('daemon') && $programd =~ /d$/) {

663

$opt{'daemon'} = minimum('daemon');

664

}

665

my $caught_hup = 0;

666

my $caught_term = 0;

667

my $caught_kill = 0;

668

$SIG{'HUP'} = sub { $caught_hup = 1; };

669

$SIG{'TERM'} = sub { $caught_term = 1; };

670

$SIG{'KILL'} = sub { $caught_kill = 1; };

671

# don't fork() if foreground or force is on

672

if (opt('foreground') || opt('force')) {

673

;

674

} elsif (opt('daemon')) {

675

$SIG{'CHLD'} = 'IGNORE';

676

my $pid = fork;

677

if ($pid < 0) {

678

print STDERR "${program}: can not fork ($!)\n";

679

exit -1;

680

} elsif ($pid) {

681

exit 0;

682

}

683

$SIG{'CHLD'} = 'DEFAULT';

684

open(STDOUT, ">/dev/null");

685

open(STDERR, ">/dev/null");

686

open(STDIN, "</dev/null");

687

}

688

689

# write out the pid file if we're daemon'ized

690

if(opt('daemon')) {

691

write_pid();

692

$opt{'syslog'} = 1;

693

}

694

695

umask 077;

696

my $daemon;

697

do {

698

$now = time;

699

$result = 'OK';

700

%opt = %saved_opt;

701

if (opt('help')) {

702

*STDERR = *STDOUT;

703

printf("Help found");

704

# usage();

705

}

706

707

read_config(define($opt{'file'}, default('file')), \%config, \%globals);

708

init_config();

709

read_cache(opt('cache'), \%cache);

710

print_info() if opt('debug') && opt('verbose');

711

712

# usage("invalid argument '-use %s'; possible values are:\n\t%s", $opt{'use'}, join("\n\t,",sort keys %ip_strategies))

713

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

714

unless exists $ip_strategies{lc opt('use')};

715

716

$daemon = $opt{'daemon'};

717

$daemon = 0 if opt('force');

718

719

update_nics();

720

721

if ($daemon) {

722

debug("sleep %s", $daemon);

723

sendmail();

724

725

my $left = $daemon;

726

while (($left > 0) && !$caught_hup && !$caught_term && !$caught_kill) {

727

my $delay = $left > 10 ? 10 : $left;

728

729

$0 = sprintf("%s - sleeping for %s seconds", $program, $left);

730

$left -= sleep $delay;

731

}

732

$caught_hup = 0;

733

$result = 0;

734

735

} elsif (! scalar(%config)) {

736

warning("no hosts to update.") unless !opt('quiet') || opt('verbose') || !$daemon;

737

$result = 1;

738

739

} else {

740

$result = $result eq 'OK' ? 0 : 1;

741

}

742

} while ($daemon && !$result && !$caught_term && !$caught_kill);

743

744

warning("caught SIGKILL; exiting") if $caught_kill;

745

unlink_pid();

746

sendmail();

747

748

exit($result);

749

750

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

751

## runpostscript

752

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

753

754

sub runpostscript {

755

my ($ip) = @_;

756

757

if ( defined $globals{postscript} ) {

758

if ( -x $globals{postscript}) {

759

system ("$globals{postscript} $ip &");

760

} else {

761

warning ("Can not execute post script: %s", $globals{postscript});

762

}

763

}

764

}

765

766

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

767

## update_nics

768

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

769

sub update_nics {

770

my %examined = ();

771

my %iplist = ();

772

773

foreach my $s (sort keys %services) {

774

my (@hosts, %ips) = ();

775

my $updateable = $services{$s}{'updateable'};

776

my $update = $services{$s}{'update'};

777

778

foreach my $h (sort keys %config) {

779

next if $config{$h}{'protocol'} ne lc($s);

780

$examined{$h} = 1;

781

my $use = $config{$h}{'use'} || opt('use');

782

local $opt{$use} = $config{$h}{$use} if $config{$h}{$use};

783

# bug #13: we should only do this once

784

# use isn't enough, we have to save the origin to.

785

# this will break the multiple ip stuff if use has

786

# been used twice for the same device.

787

my $ip = "";

788

if (defined $iplist{$use}) {

789

$ip = $iplist{$use};

790

} else {

791

$ip = get_ip($use, $h);

792

if (!defined $ip || !$ip) {

793

warning("unable to determine IP address")

794

if !$daemon || opt('verbose');

795

next;

796

}

797

if ($ip !~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) {

798

warning("malformed IP address (%s)", $ip);

799

next;

800

}

801

$iplist{$use} = $ip;

802

}

803

$config{$h}{'wantip'} = $ip;

804

next if !nic_updateable($h, $updateable);

805

push @hosts, $h;

806

$ips{$ip} = $h;

807

}

808

if (@hosts) {

809

$0 = sprintf("%s - updating %s", $program, join(',', @hosts));

810

&$update(@hosts);

811

runpostscript(join ' ', keys %ips);

812

}

813

}

814

foreach my $h (sort keys %config) {

815

if (!exists $examined{$h}) {

816

failed("%s was not updated because protocol %s is not supported.",

817

$h, define($config{$h}{'protocol'}, '<undefined>')

818

);

819

}

820

}

821

write_cache(opt('cache'));

822

}

823

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

824

## unlink_pid()

825

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

826

sub unlink_pid {

827

if (opt('pid') && opt('daemon')) {

828

unlink opt('pid');

829

}

830

}

831

832

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

833

## write_pid()

834

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

835

sub write_pid {

836

my $file = opt('pid');

837

838

if ($file && opt('daemon')) {

839

local *FD;

840

if (! open(FD, "> $file")) {

841

warning("Cannot create file '%s'. ($!)", $file);

842

843

} else {

844

printf FD "$$\n";

845

close(FD);

846

}

847

}

848

}

849

850

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

851

## write_cache($file)

852

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

853

sub write_cache {

854

my ($file) = @_;

855

856

## merge the updated host entries into the cache.

857

foreach my $h (keys %config) {

858

if (! exists $cache{$h} || $config{$h}{'update'}) {

859

map {$cache{$h}{$_} = $config{$h}{$_} } @{$config{$h}{'cacheable'}};

860

861

} else {

862

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

863

}

864

}

865

866

## construct the cache file.

867

my $cache = "";

868

foreach my $h (sort keys %cache) {

869

my $opt = join(',', map { "$_=".define($cache{$h}{$_},'') } sort keys %{$cache{$h}});

870

871

$cache .= sprintf "%s%s%s\n", $opt, ($opt ? ' ' : ''), $h;

872

}

873

$file = '' if defined($saved_cache) && $cache eq $saved_cache;

874

875

## write the updates and other entries to the cache file.

876

if ($file) {

877

$saved_cache = undef;

878

local *FD;

879

if (! open(FD, "> $file")) {

880

fatal("Cannot create file '%s'. ($!)", $file);

881

}

882

printf FD "## $program-$version\n";

883

printf FD "## last updated at %s (%d)\n", prettytime($now), $now;

884

printf FD $cache;

885

886

close(FD);

887

}

888

}

889

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

890

## read_cache($file) - called before reading the .conf

891

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

892

sub read_cache {

893

my $file = shift;

894

my $config = shift;

895

my $globals = {};

896

897

%{$config} = ();

898

## read the cache file ignoring anything on the command-line.

899

if (-e $file) {

900

my %saved = %opt;

901

%opt = ();

902

$saved_cache = _read_config($config, $globals, "##\\s*$program-$version\\s*", $file);

903

%opt = %saved;

904

905

foreach my $h (keys %cache) {

906

if (exists $config->{$h}) {

907

foreach (qw(atime mtime wtime ip status)) {

908

$config->{$h}{$_} = $cache{$h}{$_} if exists $cache{$h}{$_};

909

}

910

}

911

}

912

}

913

}

914

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

915

## parse_assignments(string) return (rest, %variables)

916

## parse_assignment(string) return (name, value, rest)

917

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

918

sub parse_assignments {

919

my $rest = shift;

920

my @args = @_;

921

my %variables = ();

922

my ($name, $value);

923

924

while (1) {

925

$rest =~ s/^\s+//;

926

($name, $value, $rest) = parse_assignment($rest, @args);

927

if (defined $name) {

928

$variables{$name} = $value;

929

} else {

930

last;

931

}

932

}

933

return ($rest, %variables);

934

}

935

sub parse_assignment {

936

my $rest = shift;

937

my $stop = @_ ? shift : '[\n\s,]';

938

my ($c, $name, $value);

939

my ($escape, $quote) = (0, '');

940

941

if ($rest =~ /^\s*([a-z][a-z_-]*)=(.*)/i) {

942

($name, $rest, $value) = ($1, $2, '');

943

944

while (length($c = substr($rest,0,1))) {

945

$rest = substr($rest,1);

946

if ($escape) {

947

$value .= $c;

948

$escape = 0;

949

} elsif ($c eq "\\") {

950

$escape = 1;

951

} elsif ($quote && $c eq $quote) {

952

$quote = ''

953

} elsif (!$quote && $c =~ /[\'\"]/) {

954

$quote = $c;

955

} elsif (!$quote && $c =~ /^${stop}/) {

956

last;

957

} else {

958

$value .= $c;

959

}

960

}

961

}

962

warning("assignment ended with an open quote") if $quote;

963

return ($name, $value, $rest);

964

}

965

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

966

## read_config

967

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

968

sub read_config {

969

my $file = shift;

970

my $config = shift;

971

my $globals = shift;

972

my %globals = ();

973

974

_read_config($config, $globals, '', $file, %globals);

975

}

976

sub _read_config {

977

my $config = shift;

978

my $globals = shift;

979

my $stamp = shift;

980

local $file = shift;

981

my %globals = @_;

982

my %config = ();

983

my $content = '';

984

985

local *FD;

986

if (! open(FD, "< $file")) {

987

# fatal("Cannot open file '%s'. ($!)", $file);

988

warning("Cannot open file '%s'. ($!)", $file);

989

}

990

# Check for only owner has any access to config file

991

my ($dev, $ino, $mode, @statrest) = stat(FD);

992

if ($mode & 077) {

993

if (-f FD && (chmod 0600, $file)) {

994

warning("file $file must be accessible only by its owner (fixed).");

995

} else {

996

# fatal("file $file must be accessible only by its owner.");

997

warning("file $file must be accessible only by its owner.");

998

}

999

}

1000

1001

local $lineno = 0;

1002

my $continuation = '';

1003

my %passwords = ();

1004

while (<FD>) {

1005

s/[\r\n]//g;

1006

1007

$lineno++;

1008

1009

## check for the program version stamp

1010

if (($. == 1) && $stamp && ($_ !~ /^$stamp$/i)) {

1011

warning("program version mismatch; ignoring %s", $file);

1012

last;

1013

}

1014

if (/\\\s+$/) {

1015

warning("whitespace follows the \\ at the end-of-line.\nIf you meant to have a line continuation, remove the trailing whitespace.");

1016

}

1017

1018

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

1019

1020

## parsing passwords is special

1021

if (/^([^#]*\s)?([^#]*?password\S*?)\s*=\s*('.*'|[^']\S*)(.*)/) {

1022

my ($head, $key, $value, $tail) = ($1 || '', $2, $3, $4);

1023

$value = $1 if $value =~ /^'(.*)'$/;

1024

$passwords{$key} = $value;

1025

$_ = "${head}${key}=dummy${tail}";

1026

}

1027

1028

## remove comments

1029

s/#.*//;

1030

1031

## handle continuation lines

1032

$_ = "$continuation$_";

1033

if (/\\$/) {

1034

chop;

1035

$continuation = $_;

1036

next;

1037

}

1038

$continuation = '';

1039

1040

s/^\s+//; # remove leading white space

1041

s/\s+$//; # remove trailing white space

1042

s/\s+/ /g; # canonify

1043

next if /^$/;

1044

1045

## expected configuration line is:

1046

## [opt=value,opt=..] [host [login [password]]]

1047

my %locals;

1048

($_, %locals) = parse_assignments($_);

1049

s/\s*,\s*/,/g;

1050

my @args = split;

1051

1052

## verify that keywords are valid...and check the value

1053

foreach my $k (keys %locals) {

1054

$locals{$k} = $passwords{$k} if defined $passwords{$k};

1055

if (!exists $variables{'merged'}{$k}) {

1056

warning("unrecognized keyword '%s' (ignored)", $k);

1057

delete $locals{$k};

1058

} else {

1059

my $def = $variables{'merged'}{$k};

1060

my $value = check_value($locals{$k}, $def);

1061

if (!defined($value)) {

1062

warning("Invalid Value for keyword '%s' = '%s'", $k, $locals{$k});

1063

delete $locals{$k};

1064

} else { $locals{$k} = $value; }

1065

}

1066

}

1067

if (exists($locals{'host'})) {

1068

$args[0] = @args ? "$args[0],$locals{host}" : "$locals{host}";

1069

}

1070

## accumulate globals

1071

if ($#args < 0) {

1072

map { $globals{$_} = $locals{$_} } keys %locals;

1073

}

1074

1075

## process this host definition

1076

if (@args) {

1077

my ($host, $login, $password) = @args;

1078

1079

## add in any globals..

1080

%locals = %{ merge(\%locals, \%globals) };

1081

1082

## override login and password if specified the old way.

1083

$locals{'login'} = $login if defined $login;

1084

$locals{'password'} = $password if defined $password;

1085

1086

## allow {host} to be a comma separated list of hosts

1087

foreach my $h (split_by_comma($host)) {

1088

## save a copy of the current globals

1089

$config{$h} = { %locals };

1090

$config{$h}{'host'} = $h;

1091

}

1092

}

1093

%passwords = ();

1094

}

1095

close(FD);

1096

1097

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

1098

if $continuation;

1099

1100

%$globals = %globals;

1101

%$config = %config;

1102

1103

return $content;

1104

}

1105

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

1106

## init_config -

1107

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

1108

sub init_config {

1109

%opt = %saved_opt;

1110

1111

##

1112

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

1113

1114

## infer the IP strategy if possible

1115

$opt{'use'} = 'ip' if !define($opt{'use'}) && defined($opt{'ip'});

1116

$opt{'use'} = 'if' if !define($opt{'use'}) && defined($opt{'if'});

1117

$opt{'use'} = 'web' if !define($opt{'use'}) && defined($opt{'web'});

1118

1119

## sanity check

1120

$opt{'max-interval'} = min(interval(opt('max-interval')), interval(default('max-interval')));

1121

$opt{'min-interval'} = max(interval(opt('min-interval')), interval(default('min-interval')));

1122

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

1123

1124

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

1125

1126

## only set $opt{'daemon'} if it has been explicitly passed in

1127

if (define($opt{'daemon'},$globals{'daemon'},0)) {

1128

$opt{'daemon'} = interval(opt('daemon'));

1129

$opt{'daemon'} = minimum('daemon')

1130

if ($opt{'daemon'} < minimum('daemon'));

1131

}

1132

1133

## define or modify host options specified on the command-line

1134

if (exists $opt{'options'} && defined $opt{'options'}) {

1135

## collect cmdline configuration options.

1136

my %options = ();

1137

foreach my $opt (split_by_comma($opt{'options'})) {

1138

my ($name,$var) = split /\s*=\s*/, $opt;

1139

$options{$name} = $var;

1140

}

1141

## determine hosts specified with -host

1142

my @hosts = ();

1143

if (exists $opt{'host'}) {

1144

foreach my $h (split_by_comma($opt{'host'})) {

1145

push @hosts, $h;

1146

}

1147

}

1148

## and those in -options=...

1149

if (exists $options{'host'}) {

1150

foreach my $h (split_by_comma($options{'host'})) {

1151

push @hosts, $h;

1152

}

1153

delete $options{'host'};

1154

}

1155

## merge options into host definitions or globals

1156

if (@hosts) {

1157

foreach my $h (@hosts) {

1158

$config{$h} = merge(\%options, $config{$h});

1159

}

1160

$opt{'host'} = join(',', @hosts);

1161

} else {

1162

%globals = %{ merge(\%options, \%globals) };

1163

}

1164

}

1165

1166

## override global options with those on the command-line.

1167

foreach my $o (keys %opt) {

1168

if (defined $opt{$o} && exists $variables{'global-defaults'}{$o}) {

1169

$globals{$o} = $opt{$o};

1170

}

1171

}

1172

1173

## sanity check

1174

if (defined $opt{'host'} && defined $opt{'retry'}) {

1175

usage("options -retry and -host (or -option host=..) are mutually exclusive");

1176

}

1177

1178

## determine hosts to update (those on the cmd-line, config-file, or failed cached)

1179

my @hosts = keys %config;

1180

if (opt('host')) {

1181

@hosts = split_by_comma($opt{'host'});

1182

}

1183

if (opt('retry')) {

1184

@hosts = map { $_ if $cache{$_}{'status'} ne 'good' } keys %cache;

1185

}

1186

1187

## remove any other hosts

1188

my %hosts;

1189

map { $hosts{$_} = undef } @hosts;

1190

map { delete $config{$_} unless exists $hosts{$_} } keys %config;

1191

1192

## collect the cacheable variables.

1193

foreach my $proto (keys %services) {

1194

my @cacheable = ();

1195

foreach my $k (keys %{$services{$proto}{'variables'}}) {

1196

push @cacheable, $k if $services{$proto}{'variables'}{$k}{'cache'};

1197

}

1198

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

1199

}

1200

1201

## sanity check..

1202

## make sure config entries have all defaults and they meet minimums

1203

## first the globals...

1204

foreach my $k (keys %globals) {

1205

my $def = $variables{'merged'}{$k};

1206

my $ovalue = define($globals{$k}, $def->{'default'});

1207

my $value = check_value($ovalue, $def);

1208

if ($def->{'required'} && !defined $value) {

1209

$value = default($k);

1210

warning("'%s=%s' is an invalid %s. (using default of %s)", $k, $ovalue, $def->{'type'}, $value);

1211

}

1212

$globals{$k} = $value;

1213

}

1214

1215

## now the host definitions...

1216

HOST:

1217

foreach my $h (keys %config) {

1218

my $proto;

1219

$proto = $config{$h}{'protocol'};

1220

$proto = opt('protocol') if !defined($proto);

1221

1222

load_sha1_support() if ($proto eq "freedns");

1223

1224

if (!exists($services{$proto})) {

1225

warning("skipping host: %s: unrecognized protocol '%s'", $h, $proto);

1226

delete $config{$h};

1227

1228

} else {

1229

my $svars = $services{$proto}{'variables'};

1230

my $conf = { 'protocol' => $proto };

1231

1232

foreach my $k (keys %$svars) {

1233

my $def = $svars->{$k};

1234

my $ovalue = define($config{$h}{$k}, $def->{'default'});

1235

my $value = check_value($ovalue, $def);

1236

if ($def->{'required'} && !defined $value) {

1237

warning("skipping host: %s: '%s=%s' is an invalid %s.", $h, $k, $ovalue, $def->{'type'});

1238

delete $config{$h};

1239

next HOST;

1240

}

1241

$conf->{$k} = $value;

1242

1243

}

1244

$config{$h} = $conf;

1245

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

1246

}

1247

}

1248

}

1249

1250

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

1251

## usage

1252

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

1253

sub usage {

1254

my $exitcode = 1;

1255

$exitcode = shift if @_ != 0; # use first arg if given

1256

my $msg = '';

1257

if (@_) {

1258

my $format = shift;

1259

$msg .= sprintf $format, @_;

1260

1 while chomp($msg);

1261

$msg .= "\n";

1262

}

1263

printf STDERR "%s%s\n", $msg, $opt_usage;

1264

sendmail();

1265

exit $exitcode;

1266

}

1267

1268

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

1269

## process_args -

1270

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

1271

sub process_args {

1272

my @spec = ();

1273

my $usage = "";

1274

my %opts = ();

1275

1276

foreach (@_) {

1277

if (ref $_) {

1278

my ($key, $specifier, $arg_usage) = @$_;

1279

my $value = default($key);

1280

1281

## add a option specifier

1282

push @spec, $key . $specifier;

1283

1284

## define the default value which can be overwritten later

1285

$opt{$key} = undef;

1286

1287

next unless $arg_usage;

1288

1289

## add a line to the usage;

1290

$usage .= " $arg_usage";

1291

if (defined($value) && $value ne '') {

1292

$usage .= " (default: ";

1293

if ($specifier eq '!') {

1294

$usage .= "no" if ($specifier eq '!') && !$value;

1295

$usage .= $key;

1296

} else {

1297

$usage .= $value;

1298

}

1299

$usage .= ")";

1300

}

1301

$usage .= ".";

1302

} else {

1303

$usage .= $_;

1304

}

1305

$usage .= "\n";

1306

}

1307

## process the arguments

1308

if (! GetOptions(\%opt, @spec)) {

1309

$opt{"help"} = 1;

1310

}

1311

return ($usage, %opt);

1312

}

1313

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

1314

## test_possible_ip - print possible IPs

1315

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

1316

sub test_possible_ip {

1317

local $opt{'debug'} = 0;

1318

1319

printf "use=ip, ip=%s address is %s\n", opt('ip'), define(get_ip('ip'), 'NOT FOUND')

1320

if defined opt('ip');

1321

1322

{

1323

local $opt{'use'} = 'if';

1324

foreach my $if (grep {/^[a-zA-Z]/} `ifconfig -a`) {

1325

$if =~ s/:?\s.*//is;

1326

local $opt{'if'} = $if;

1327

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

1328

}

1329

}

1330

if (opt('fw')) {

1331

if (opt('fw') !~ m%/%) {

1332

foreach my $fw (sort keys %builtinfw) {

1333

local $opt{'use'} = $fw;

1334

printf "use=$fw address is %s\n", define(get_ip($fw), 'NOT FOUND');

1335

}

1336

}

1337

local $opt{'use'} = 'fw';

1338

printf "use=fw, fw=%s address is %s\n", opt('fw'), define(get_ip(opt('fw')), 'NOT FOUND')

1339

if ! exists $builtinfw{opt('fw')};

1340

1341

}

1342

{

1343

local $opt{'use'} = 'web';

1344

foreach my $web (sort keys %builtinweb) {

1345

local $opt{'web'} = $web;

1346

printf "use=web, web=$web address is %s\n", define(get_ip('web'), 'NOT FOUND');

1347

}

1348

printf "use=web, web=%s address is %s\n", opt('web'), define(get_ip('web'), 'NOT FOUND')

1349

if ! exists $builtinweb{opt('web')};

1350

}

1351

if (opt('cmd')) {

1352

local $opt{'use'} = 'cmd';

1353

printf "use=cmd, cmd=%s address is %s\n", opt('cmd'), define(get_ip('cmd'), 'NOT FOUND');

1354

}

1355

exit 0 unless opt('debug');

1356

}

1357

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

1358

## test_geturl - print (and save if -test) result of fetching a URL

1359

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

1360

sub test_geturl {

1361

my $url = shift;

1362

1363

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

1364

print "URL $url\n";;

1365

print defined($reply) ? $reply : "<undefined>\n";

1366

exit;

1367

}

1368

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

1369

## load_file

1370

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

1371

sub load_file {

1372

my $file = shift;

1373

my $buffer = '';

1374

1375

if (exists($ENV{'TEST_CASE'})) {

1376

my $try = "$file-$ENV{'TEST_CASE'}";

1377

$file = $try if -f $try;

1378

}

1379

1380

local *FD;

1381

if (open(FD, "< $file")) {

1382

read(FD, $buffer, -s FD);

1383

close(FD);

1384

debug("Loaded %d bytes from %s", length($buffer), $file);

1385

} else {

1386

debug("Load failed from %s ($!)", $file);

1387

}

1388

return $buffer

1389

}

1390

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

1391

## save_file

1392

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

1393

sub save_file {

1394

my ($file, $buffer, $opt) = @_;

1395

1396

$file .= "-$ENV{'TEST_CASE'}" if exists $ENV{'TEST_CASE'};

1397

if (defined $opt) {

1398

my $i = 0;

1399

while (-f "$file-$i") {

1400

if ('unique' =~ /^$opt/i) {

1401

my $a = join('\n', grep {!/^Date:/} split /\n/, $buffer);

1402

my $b = join('\n', grep {!/^Date:/} split /\n/, load_file("$file-$i"));

1403

last if $a eq $b;

1404

}

1405

$i++;

1406

}

1407

$file = "$file-$i";

1408

}

1409

debug("Saving to %s", $file);

1410

local *FD;

1411

open(FD, "> $file") or return;

1412

print FD $buffer;

1413

close(FD);

1414

return $buffer;

1415

}

1416

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

1417

## print_opt

1418

## print_globals

1419

## print_config

1420

## print_cache

1421

## print_info

1422

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

1423

sub _print_hash {

1424

my ($string, $ptr) = @_;

1425

my $value = $ptr;

1426

1427

if (! defined($ptr)) {

1428

$value = "<undefined>";

1429

} elsif (ref $ptr eq 'HASH') {

1430

foreach my $key (sort keys %$ptr) {

1431

_print_hash("${string}\{$key\}", $ptr->{$key});

1432

}

1433

return;

1434

}

1435

printf "%-36s : %s\n", $string, $value;

1436

}

1437

sub print_hash {

1438

my ($string, $hash) = @_;

1439

printf "=== %s ====\n", $string;

1440

_print_hash($string, $hash);

1441

}

1442

sub print_opt { print_hash("opt", \%opt); }

1443

sub print_globals { print_hash("globals", \%globals); }

1444

sub print_config { print_hash("config", \%config); }

1445

sub print_cache { print_hash("cache", \%cache); }

1446

sub print_info {

1447

print_opt();

1448

print_globals();

1449

print_config();

1450

print_cache();

1451

}

1452

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

1453

## pipecmd - run an external command

1454

## logger

1455

## sendmail

1456

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

1457

sub pipecmd {

1458

my $cmd = shift;

1459

my $stdin = join("\n", @_);

1460

my $ok = 0;

1461

1462

## remove trailing newlines

1463

1 while chomp($stdin);

1464

1465

## override when debugging.

1466

$cmd = opt('exec') ? "| $cmd" : "> /dev/null";

1467

1468

## execute the command.

1469

local *FD;

1470

if (! open(FD, $cmd)) {

1471

printf STDERR "$program: cannot execute command %s.\n", $cmd;

1472

1473

} elsif ($stdin && (! print FD "$stdin\n")) {

1474

printf STDERR "$program: failed writting to %s.\n", $cmd;

1475

close(FD);

1476

1477

} elsif (! close(FD)) {

1478

printf STDERR "$program: failed closing %s.($@)\n", $cmd;

1479

1480

} elsif (opt('exec') && $?) {

1481

printf STDERR "$program: failed %s. ($@)\n", $cmd;

1482

1483

} else {

1484

$ok = 1;

1485

}

1486

return $ok;

1487

}

1488

sub logger {

1489

if (opt('syslog') && opt('facility') && opt('priority')) {

1490

my $facility = opt('facility');

1491

my $priority = opt('priority');

1492

return pipecmd("logger -p$facility.$priority -t${program}\[$$\]", @_);

1493

}

1494

return 1;

1495

}

1496

sub sendmail {

1497

my $recipients = opt('mail');

1498

1499

if (opt('mail-failure') && ($result ne 'OK' && $result ne '0')) {

1500

$recipients = opt('mail-failure');

1501

}

1502

if ($msgs && $recipients && $msgs ne $last_msgs) {

1503

pipecmd("sendmail -oi $recipients",

1504

"To: $recipients",

1505

"Subject: status report from $program\@$hostname",

1506

"\r\n",

1507

$msgs,

1508

"",

1509

"regards,",

1510

" $program\@$hostname (version $version)"

1511

);

1512

}

1513

$last_msgs = $msgs;

1514

$msgs = '';

1515

}

1516

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

1517

## split_by_comma

1518

## merge

1519

## default

1520

## minimum

1521

## opt

1522

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

1523

sub split_by_comma {

1524

my $string = shift;

1525

1526

return split /\s*[, ]\s*/, $string if defined $string;

1527

return ();

1528

}

1529

sub merge {

1530

my %merged = ();

1531

foreach my $h (@_) {

1532

foreach my $k (keys %$h) {

1533

$merged{$k} = $h->{$k} unless exists $merged{$k};

1534

}

1535

}

1536

return \%merged;

1537

}

1538

sub default {

1539

my $v = shift;

1540

return $variables{'merged'}{$v}{'default'};

1541

}

1542

sub minimum {

1543

my $v = shift;

1544

return $variables{'merged'}{$v}{'minimum'};

1545

}

1546

sub opt {

1547

my $v = shift;

1548

my $h = shift;

1549

return $config{$h}{$v} if defined($h && $config{$h}{$v});

1550

return $opt{$v} if defined $opt{$v};

1551

return $globals{$v} if defined $globals{$v};

1552

return default($v) if defined default($v);

1553

return undef;

1554

}

1555

sub min {

1556

my $min = shift;

1557

foreach my $arg (@_) {

1558

$min = $arg if $arg < $min;

1559

}

1560

return $min;

1561

}

1562

sub max {

1563

my $max = shift;

1564

foreach my $arg (@_) {

1565

$max = $arg if $arg > $max;

1566

}

1567

return $max;

1568

}

1569

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

1570

## define

1571

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

1572

sub define {

1573

foreach (@_) {

1574

return $_ if defined $_;

1575

}

1576

return undef;

1577

}

1578

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

1579

## ynu

1580

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

1581

sub ynu {

1582

my ($value, $yes, $no, $undef) = @_;

1583

1584

return $no if !defined($value) || !$value;

1585

return $yes if $value eq '1';

1586

foreach (qw(yes true)) {

1587

return $yes if $_ =~ /^$value/i;

1588

}

1589

foreach (qw(no false)) {

1590

return $no if $_ =~ /^$value/i;

1591

}

1592

return $undef;

1593

}

1594

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

1595

## msg

1596

## debug

1597

## warning

1598

## fatal

1599

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

1600

sub _msg {

1601

my $log = shift;

1602

my $prefix = shift;

1603

my $format = shift;

1604

my $buffer = sprintf $format, @_;

1605

chomp($buffer);

1606

1607

$prefix = sprintf "%-9s ", $prefix if $prefix;

1608

if ($file) {

1609

$prefix .= "file $file";

1610

$prefix .= ", line $lineno" if $lineno;

1611

$prefix .= ": ";

1612

}

1613

if ($prefix) {

1614

$buffer = "$prefix$buffer";

1615

$buffer =~ s/\n/\n$prefix /g;

1616

}

1617

$buffer .= "\n";

1618

print $buffer;

1619

1620

$msgs .= $buffer if $log;

1621

logger($buffer) if $log;

1622

1623

}

1624

sub msg { _msg(0, '', @_); }

1625

sub verbose { _msg(1, @_) if opt('verbose'); }

1626

sub info { _msg(1, 'INFO:', @_) if opt('verbose'); }

1627

sub debug { _msg(0, 'DEBUG:', @_) if opt('debug'); }

1628

sub debug2 { _msg(0, 'DEBUG:', @_) if opt('debug') && opt('verbose');}

1629

sub warning { _msg(1, 'WARNING:', @_); }

1630

sub fatal { _msg(1, 'FATAL:', @_); sendmail(); exit(1); }

1631

sub success { _msg(1, 'SUCCESS:', @_); }

1632

sub failed { _msg(1, 'FAILED:', @_); $result = 'FAILED'; }

1633

sub prettytime { return scalar(localtime(shift)); }

1634

1635

sub prettyinterval {

1636

my $interval = shift;

1637

use integer;

1638

my $s = $interval % 60; $interval /= 60;

1639

my $m = $interval % 60; $interval /= 60;

1640

my $h = $interval % 24; $interval /= 24;

1641

my $d = $interval;

1642

1643

my $string = "";

1644

$string .= "$d day" if $d;

1645

$string .= "s" if $d > 1;

1646

$string .= ", " if $string && $h;

1647

$string .= "$h hour" if $h;

1648

$string .= "s" if $h > 1;

1649

$string .= ", " if $string && $m;

1650

$string .= "$m minute" if $m;

1651

$string .= "s" if $m > 1;

1652

$string .= ", " if $string && $s;

1653

$string .= "$s second" if $s;

1654

$string .= "s" if $s > 1;

1655

return $string;

1656

}

1657

sub interval {

1658

my $value = shift;

1659

if ($value =~ /^(\d+)(seconds|s)/i) {

1660

$value = $1;

1661

} elsif ($value =~ /^(\d+)(minutes|m)/i) {

1662

$value = $1 * 60;

1663

} elsif ($value =~ /^(\d+)(hours|h)/i) {

1664

$value = $1 * 60*60;

1665

} elsif ($value =~ /^(\d+)(days|d)/i) {

1666

$value = $1 * 60*60*24;

1667

} elsif ($value !~ /^\d+$/) {

1668

$value = undef;

1669

}

1670

return $value;

1671

}

1672

sub interval_expired {

1673

my ($host, $time, $interval) = @_;

1674

1675

return 1 if !exists $cache{$host};

1676

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

1677

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

1678

1679

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

1680

}

1681

1682

1683

1684

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

1685

## check_value

1686

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

1687

sub check_value {

1688

my ($value, $def) = @_;

1689

my $type = $def->{'type'};

1690

my $min = $def->{'minimum'};

1691

my $required = $def->{'required'};

1692

1693

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

1694

;

1695

1696

} elsif ($type eq T_DELAY) {

1697

$value = interval($value);

1698

$value = $min if defined($value) && defined($min) && $value < $min;

1699

1700

} elsif ($type eq T_NUMBER) {

1701

return undef if $value !~ /^\d+$/;

1702

$value = $min if defined($min) && $value < $min;

1703

1704

} elsif ($type eq T_BOOL) {

1705

if ($value =~ /^y(es)?$|^t(true)?$|^1$/i) {

1706

$value = 1;

1707

} elsif ($value =~ /^n(o)?$|^f(alse)?$|^0$/i) {

1708

$value = 0;

1709

} else {

1710

return undef;

1711

}

1712

} elsif ($type eq T_FQDN || $type eq T_OFQDN && $value ne '') {

1713

$value = lc $value;

1714

return undef if $value !~ /[^.]\.[^.]/;

1715

1716

} elsif ($type eq T_FQDNP) {

1717

$value = lc $value;

1718

return undef if $value !~ /[^.]\.[^.].*(:\d+)?$/;

1719

1720

} elsif ($type eq T_PROTO) {

1721

$value = lc $value;

1722

return undef if ! exists $services{$value};

1723

1724

} elsif ($type eq T_USE) {

1725

$value = lc $value;

1726

return undef if ! exists $ip_strategies{$value};

1727

1728

} elsif ($type eq T_FILE) {

1729

return undef if $value eq "";

1730

1731

} elsif ($type eq T_IF) {

1732

return undef if $value !~ /^[a-z0-9:._-]+$/;

1733

1734

} elsif ($type eq T_PROG) {

1735

return undef if $value eq "";

1736

1737

} elsif ($type eq T_LOGIN) {

1738

return undef if $value eq "";

1739

1740

# } elsif ($type eq T_PASSWD) {

1741

# return undef if $value =~ /:/;

1742

1743

} elsif ($type eq T_IP) {

1744

return undef if $value !~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/;

1745

}

1746

return $value;

1747

}

1748

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

1749

## encode_base64 - from MIME::Base64

1750

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

1751

sub encode_base64 ($;$) {

1752

my $res = '';

1753

my $eol = $_[1];

1754

$eol = "\n" unless defined $eol;

1755

pos($_[0]) = 0; # ensure start at the beginning

1756

while ($_[0] =~ /(.{1,45})/gs) {

1757

$res .= substr(pack('u', $1), 1);

1758

chop($res);

1759

}

1760

$res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs

1761

1762

# fix padding at the end

1763

my $padding = (3 - length($_[0]) % 3) % 3;

1764

$res =~ s/.{$padding}$/'=' x $padding/e if $padding;

1765

$res;

1766

}

1767

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

1768

## load_ssl_support

1769

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

1770

sub load_ssl_support {

1771

my $ssl_loaded = eval {require IO::Socket::SSL};

1772

unless ($ssl_loaded) {

1773

fatal(<<"EOM");

1774

Error loading the Perl module IO::Socket::SSL needed for SSL connect.

1775

On Debian, the package libio-socket-ssl-perl must be installed.

1776

On Red Hat, the package perl-IO-Socket-SSL must be installed.

1777

EOM

1778

}

1779

import IO::Socket::SSL;

1780

{ no warnings; $IO::Socket::SSL::DEBUG = 0; }

1781

}

1782

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

1783

## load_sha1_support

1784

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

1785

sub load_sha1_support {

1786

my $sha1_loaded = eval {require Digest::SHA1};

1787

unless ($sha1_loaded) {

1788

fatal(<<"EOM");

1789

Error loading the Perl module Digest::SHA1 needed for freedns update.

1790

On Debian, the package libdigest-sha1-perl must be installed.

1791

EOM

1792

}

1793

import Digest::SHA1 (qw/sha1_hex/);

1794

}

1795

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

1796

## geturl

1797

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

1798

sub geturl {

1799

my $proxy = shift || '';

1800

my $url = shift || '';

1801

my $login = shift || '';

1802

my $password = shift || '';

1803

my ($peer, $server, $port, $default_port, $use_ssl);

1804

my ($sd, $rq, $request, $reply);

1805

1806

debug("proxy = $proxy");

1807

debug("url = %s", $url);

1808

## canonify proxy and url

1809

my $force_ssl;

1810

$force_ssl = 1 if ($url =~ /^https:/);

1811

$proxy =~ s%^https?://%%i;

1812

$url =~ s%^https?://%%i;

1813

$server = $url;

1814

$server =~ s%/.*%%;

1815

$url = "/" unless $url =~ m%/%;

1816

$url =~ s%^[^/]*/%%;

1817

1818

debug("server = $server");

1819

opt('fw') && debug("opt(fw = ",opt('fw'),")");

1820

$globals{'fw'} && debug("glo fw = $globals{'fw'}");

1821

#if ( $globals{'ssl'} and $server ne $globals{'fw'} ) {

1822

## always omit SSL for connections to local router

1823

if ( $force_ssl || ($globals{'ssl'} and (caller(1))[3] ne 'main::get_ip') ) {

1824

$use_ssl = 1;

1825

$default_port = 443;

1826

load_ssl_support;

1827

} else {

1828

$use_ssl = 0;

1829

$default_port = 80;

1830

}

1831

1832

## determine peer and port to use.

1833

$peer = $proxy || $server;

1834

$peer =~ s%/.*%%;

1835

$port = $peer;

1836

$port =~ s%^.*:%%;

1837

$port = $default_port unless $port =~ /^\d+$/;

1838

$peer =~ s%:.*$%%;

1839

1840

my $to = sprintf "%s%s", $server, $proxy ? " via proxy $peer:$port" : "";

1841

verbose("CONNECT:", "%s", $to);

1842

1843

$request = "GET ";

1844

$request .= "http://$server" if $proxy;

1845

$request .= "/$url HTTP/1.0\n";

1846

$request .= "Host: $server\n";

1847

1848

my $auth = encode_base64("${login}:${password}");

1849

$request .= "Authorization: Basic $auth\n" if $login || $password;

1850

$request .= "User-Agent: ${program}/${version}\n";

1851

$request .= "Connection: close\n";

1852

$request .= "\n";

1853

1854

## make sure newlines are <cr><lf> for some pedantic proxy servers

1855

($rq = $request) =~ s/\n/\r\n/g;

1856

1857

# local $^W = 0;

1858

$0 = sprintf("%s - connecting to %s port %s", $program, $peer, $port);

1859

if (! opt('exec')) {

1860

debug("skipped network connection");

1861

verbose("SENDING:", "%s", $request);

1862

} elsif ($use_ssl) {

1863

$sd = IO::Socket::SSL->new(

1864

PeerAddr => $peer,

1865

PeerPort => $port,

1866

Proto => 'tcp',

1867

MultiHomed => 1,

1868

Timeout => opt('timeout'),

1869

);

1870

defined $sd or warning("cannot connect to $peer:$port socket: $@ " . IO::Socket::SSL::errstr());

1871

} else {

1872

$sd = IO::Socket::INET->new(

1873

PeerAddr => $peer,

1874

PeerPort => $port,

1875

Proto => 'tcp',

1876

MultiHomed => 1,

1877

Timeout => opt('timeout'),

1878

);

1879

defined $sd or warning("cannot connect to $peer:$port socket: $@");

1880

}

1881

1882

if (defined $sd) {

1883

## send the request to the http server

1884

verbose("CONNECTED: ", $use_ssl ? 'using SSL' : 'using HTTP');

1885

verbose("SENDING:", "%s", $request);

1886

1887

$0 = sprintf("%s - sending to %s port %s", $program, $peer, $port);

1888

my $result = syswrite $sd, $rq;

1889

if ($result != length($rq)) {

1890

warning("cannot send to $peer:$port ($!).");

1891

} else {

1892

$0 = sprintf("%s - reading from %s port %s", $program, $peer, $port);

1893

eval {

1894

local $SIG{'ALRM'} = sub { die "timeout";};

1895

alarm(opt('timeout')) if opt('timeout') > 0;

1896

while ($_ = <$sd>) {

1897

$0 = sprintf("%s - read from %s port %s", $program, $peer, $port);

1898

verbose("RECEIVE:", "%s", define($_, "<undefined>"));

1899

$reply .= $_ if defined $_;

1900

}

1901

if (opt('timeout') > 0) {

1902

alarm(0);

1903

}

1904

};

1905

close($sd);

1906

1907

if ($@ and $@ =~ /timeout/) {

1908

warning("TIMEOUT: %s after %s seconds", $to, opt('timeout'));

1909

$reply = '';

1910

}

1911

$reply = '' if !defined $reply;

1912

}

1913

}

1914

$0 = sprintf("%s - closed %s port %s", $program, $peer, $port);

1915

1916

## during testing simulate reading the URL

1917

if (opt('test')) {

1918

my $filename = "$server/$url";

1919

$filename =~ s|/|%2F|g;

1920

if (opt('exec')) {

1921

$reply = save_file("${savedir}$filename", $reply, 'unique');

1922

} else {

1923

$reply = load_file("${savedir}$filename");

1924

}

1925

}

1926

1927

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

1928

return $reply;

1929

}

1930

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

1931

## get_ip

1932

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

1933

sub get_ip {

1934

my $use = lc shift;

1935

my $h = shift;

1936

my ($ip, $arg, $reply, $url, $skip) = (undef, opt($use), '');

1937

$arg = '' unless $arg;

1938

1939

if ($use eq 'ip') {

1940

$ip = opt('ip', $h);

1941

$arg = 'ip';

1942

1943

} elsif ($use eq 'if') {

1944

$skip = opt('if-skip', $h) || '';

1945

$reply = `ifconfig $arg 2> /dev/null`;

1946

$reply = '' if $?;

1947

1948

} elsif ($use eq 'cmd') {

1949

if ($arg) {

1950

$skip = opt('cmd-skip', $h) || '';

1951

$reply = `$arg`;

1952

$reply = '' if $?;

1953

}

1954

1955

} elsif ($use eq 'web') {

1956

$url = opt('web', $h) || '';

1957

$skip = opt('web-skip', $h) || '';

1958

1959

if (exists $builtinweb{$url}) {

1960

$skip = $builtinweb{$url}->{'skip'} unless $skip;

1961

$url = $builtinweb{$url}->{'url'};

1962

}

1963

$arg = $url;

1964

1965

if ($url) {

1966

$reply = geturl(opt('proxy', $h), $url) || '';

1967

}

1968

1969

} elsif (($use eq 'cisco')) {

1970

# Stuff added to support Cisco router ip http daemon

1971

# User fw-login should only have level 1 access to prevent

1972

# password theft. This is pretty harmless.

1973

my $queryif = opt('if', $h);

1974

$skip = opt('fw-skip', $h) || '';

1975

1976

# Convert slashes to protected value "\/"

1977

$queryif =~ s%\/%\\\/%g;

1978

1979

# Protect special HTML characters (like '?')

1980

$queryif =~ s/([\?&= ])/sprintf("%%%02x",ord($1))/ge;

1981

1982

$url = "http://".opt('fw', $h)."/level/1/exec/show/ip/interface/brief/${queryif}/CR";

1983

$reply = geturl('', $url, opt('fw-login', $h), opt('fw-password', $h)) || '';

1984

$arg = $url;

1985

1986

} elsif (($use eq 'cisco-asa')) {

1987

# Stuff added to support Cisco ASA ip https daemon

1988

# User fw-login should only have level 1 access to prevent

1989

# password theft. This is pretty harmless.

1990

my $queryif = opt('if', $h);

1991

$skip = opt('fw-skip', $h) || '';

1992

1993

# Convert slashes to protected value "\/"

1994

$queryif =~ s%\/%\\\/%g;

1995

1996

# Protect special HTML characters (like '?')

1997

$queryif =~ s/([\?&= ])/sprintf("%%%02x",ord($1))/ge;

1998

1999

$url = "https://".opt('fw', $h)."/exec/show%20interface%20${queryif}";

2000

$reply = geturl('', $url, opt('fw-login', $h), opt('fw-password', $h)) || '';

2001

$arg = $url;

2002

2003

} else {

2004

$url = opt('fw', $h) || '';

2005

$skip = opt('fw-skip', $h) || '';

2006

2007

if (exists $builtinfw{$use}) {

2008

$skip = $builtinfw{$use}->{'skip'} unless $skip;

2009

$url = "http://${url}" . $builtinfw{$use}->{'url'} unless $url =~ /\//;

2010

}

2011

$arg = $url;

2012

2013

if ($url) {

2014

$reply = geturl('', $url, opt('fw-login', $h), opt('fw-password', $h)) || '';

2015

}

2016

}

2017

if (!defined $reply) {

2018

$reply = '';

2019

}

2020

if ($skip) {

2021

$skip =~ s/ /\\s/is;

2022

$reply =~ s/^.*?${skip}//is;

2023

}

2024

if ($reply =~ /^.*?\b(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\b.*/is) {

2025

$ip = $1;

2026

}

2027

if (($use ne 'ip') && (define($ip,'') eq '0.0.0.0')) {

2028

$ip = undef;

2029

}

2030

2031

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

2032

return $ip;

2033

}

2034

2035

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

2036

## group_hosts_by

2037

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

2038

sub group_hosts_by {

2039

my ($hosts, $attributes) = @_;

2040

2041

my %groups = ();

2042

foreach my $h (@$hosts) {

2043

my @keys = (@$attributes, 'wantip');

2044

map { $config{$h}{$_} = '' unless exists $config{$h}{$_} } @keys;

2045

my $sig = join(',', map { "$_=$config{$h}{$_}" } @keys);

2046

2047

push @{$groups{$sig}}, $h;

2048

}

2049

return %groups;

2050

}

2051

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

2052

## nic_examples

2053

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

2054

sub nic_examples {

2055

my $examples = "";

2056

my $separator = "";

2057

foreach my $s (sort keys %services) {

2058

my $subr = $services{$s}{'examples'};

2059

my $example;

2060

2061

if (defined($subr) && ($example = &$subr())) {

2062

chomp($example);

2063

$examples .= $example;

2064

$examples .= "\n\n$separator";

2065

$separator = "\n";

2066

}

2067

}

2068

my $intro = <<EoEXAMPLE;

2069

== CONFIGURING ${program}

2070

2071

The configuration file, ${program}.conf, can be used to define the

2072

default behaviour and operation of ${program}. The file consists of

2073

sequences of global variable definitions and host definitions.

2074

2075

Global definitions look like:

2076

name=value [,name=value]*

2077

2078

For example:

2079

daemon=5m

2080

use=if, if=eth0

2081

proxy=proxy.myisp.com

2082

protocol=dyndns2

2083

2084

specifies that ${program} should operate as a daemon, checking the

2085

eth0 interface for an IP address change every 5 minutes and use the

2086

'dyndns2' protocol by default. The daemon interval can be specified

2087

as seconds (600s), minutes (5m), hours (1h) or days (1d).

2088

2089

Host definitions look like:

2090

[name=value [,name=value]*]* a.host.domain [,b.host.domain] [login] [password]

2091

2092

For example:

2093

protocol=hammernode1, \\

2094

login=my-hn-login, password=my-hn-password myhost.hn.org

2095

login=my-login, password=my-password myhost.dyndns.org,my2nd.dyndns.org

2096

2097

specifies two host definitions.

2098

2099

The first definition will use the hammernode1 protocol,

2100

my-hn-login and my-hn-password to update the ip-address of

2101

myhost.hn.org and my2ndhost.hn.org.

2102

2103

The second host definition will use the current default protocol

2104

('dyndns2'), my-login and my-password to update the ip-address of

2105

myhost.dyndns.org and my2ndhost.dyndns.org.

2106

2107

The order of this sequence is significant because the values of any

2108

global variable definitions are bound to a host definition when the

2109

host definition is encountered.

2110

2111

See the sample-${program}.conf file for further examples.

2112

EoEXAMPLE

2113

$intro .= "\n== NIC specific variables and examples:\n$examples" if $examples;

2114

return $intro;

2115

}

2116

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

2117

## nic_updateable

2118

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

2119

sub nic_updateable {

2120

my $host = shift;

2121

my $sub = shift;

2122

my $update = 0;

2123

my $ip = $config{$host}{'wantip'};

2124

2125

if ($config{$host}{'login'} eq '') {

2126

warning("null login name specified for host %s.", $host);

2127

2128

} elsif ($config{$host}{'password'} eq '') {

2129

warning("null password specified for host %s.", $host);

2130

2131

} elsif ($opt{'force'}) {

2132

info("forcing update of %s.", $host);

2133

$update = 1;

2134

2135

} elsif (!exists($cache{$host})) {

2136

info("forcing updating %s because no cached entry exists.", $host);

2137

$update = 1;

2138

2139

} elsif ($cache{$host}{'wtime'} && $cache{$host}{'wtime'} > $now) {

2140

warning("cannot update %s from %s to %s until after %s.",

2141

$host,

2142

($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'), $ip,

2143

prettytime($cache{$host}{'wtime'})

2144

);

2145

2146

} elsif ($cache{$host}{'mtime'} && interval_expired($host, 'mtime', 'max-interval')) {

2147

warning("forcing update of %s from %s to %s; %s since last update on %s.",

2148

$host,

2149

($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'), $ip,

2150

prettyinterval($config{$host}{'max-interval'}),

2151

prettytime($cache{$host}{'mtime'})

2152

);

2153

$update = 1;

2154

2155

} elsif ((!exists($cache{$host}{'ip'})) ||

2156

("$cache{$host}{'ip'}" ne "$ip")) {

2157

if (($cache{$host}{'status'} eq 'good') &&

2158

!interval_expired($host, 'mtime', 'min-interval')) {

2159

2160

warning("skipping update of %s from %s to %s.\nlast updated %s.\nWait at least %s between update attempts.",

2161

$host,

2162

($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'),

2163

$ip,

2164

($cache{$host}{'mtime'} ? prettytime($cache{$host}{'mtime'}) : '<never>'),

2165

prettyinterval($config{$host}{'min-interval'})

2166

)

2167

if opt('verbose') || !define($cache{$host}{'warned-min-interval'}, 0);

2168

2169

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

2170

2171

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

2172

2173

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.",

2174

$host,

2175

($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'),

2176

$ip,

2177

($cache{$host}{'mtime'} ? prettytime($cache{$host}{'mtime'}) : '<never>'),

2178

($cache{$host}{'atime'} ? prettytime($cache{$host}{'atime'}) : '<never>'),

2179

prettyinterval($config{$host}{'min-error-interval'})

2180

)

2181

if opt('verbose') || !define($cache{$host}{'warned-min-error-interval'}, 0);

2182

2183

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

2184

2185

} else {

2186

$update = 1;

2187

}

2188

2189

} elsif (defined($sub) && &$sub($host)) {

2190

$update = 1;

2191

} elsif ((defined($cache{$host}{'static'}) && defined($config{$host}{'static'}) &&

2192

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

2193

(defined($cache{$host}{'wildcard'}) && defined($config{$host}{'wildcard'}) &&

2194

($cache{$host}{'wildcard'} ne $config{$host}{'wildcard'})) ||

2195

(defined($cache{$host}{'mx'}) && defined($config{$host}{'mx'}) &&

2196

($cache{$host}{'mx'} ne $config{$host}{'mx'})) ||

2197

(defined($cache{$host}{'backupmx'}) && defined($config{$host}{'backupmx'}) &&

2198

($cache{$host}{'backupmx'} ne $config{$host}{'backupmx'})) ) {

2199

info("updating %s because host settings have been changed.", $host);

2200

$update = 1;

2201

2202

} else {

2203

success("%s: skipped: IP address was already set to %s.", $host, $ip)

2204

if opt('verbose');

2205

}

2206

$config{$host}{'status'} = define($cache{$host}{'status'},'');

2207

$config{$host}{'update'} = $update;

2208

if ($update) {

2209

$config{$host}{'status'} = 'noconnect';

2210

$config{$host}{'atime'} = $now;

2211

$config{$host}{'wtime'} = 0;

2212

$config{$host}{'warned-min-interval'} = 0;

2213

$config{$host}{'warned-min-error-interval'} = 0;

2214

2215

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

2216

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

2217

}

2218

2219

return $update;

2220

}

2221

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

2222

## header_ok

2223

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

2224

sub header_ok {

2225

my ($host, $line) = @_;

2226

my $ok = 0;

2227

2228

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

2229

my $result = $1;

2230

2231

if ($result eq '200') {

2232

$ok = 1;

2233

2234

} elsif ($result eq '401') {

2235

failed("updating %s: authorization failed (%s)", $host, $line);

2236

}

2237

2238

} else {

2239

failed("updating %s: unexpected line (%s)", $host, $line);

2240

}

2241

return $ok;

2242

}

2243

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

2244

## nic_dyndns1_examples

2245

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

2246

sub nic_dyndns1_examples {

2247

return <<EoEXAMPLE;

2248

o 'dyndns1'

2249

2250

The 'dyndns1' protocol is a deprecated protocol used by the free dynamic

2251

DNS service offered by www.dyndns.org. The 'dyndns2' should be used to

2252

update the www.dyndns.org service. However, other services are also

2253

using this protocol so support is still provided by ${program}.

2254

2255

Configuration variables applicable to the 'dyndns1' protocol are:

2256

protocol=dyndns1 ##

2257

server=fqdn.of.service ## defaults to members.dyndns.org

2258

backupmx=no|yes ## indicates that this host is the primary MX for the domain.

2259

mx=any.host.domain ## a host MX'ing for this host definition.

2260

wildcard=no|yes ## add a DNS wildcard CNAME record that points to {host}

2261

login=service-login ## login name and password registered with the service

2262

password=service-password ##

2263

fully.qualified.host ## the host registered with the service.

2264

2265

Example ${program}.conf file entries:

2266

## single host update

2267

protocol=dyndns1, \\

2268

login=my-dyndns.org-login, \\

2269

password=my-dyndns.org-password \\

2270

myhost.dyndns.org

2271

2272

## multiple host update with wildcard'ing mx, and backupmx

2273

protocol=dyndns1, \\

2274

login=my-dyndns.org-login, \\

2275

password=my-dyndns.org-password, \\

2276

mx=a.host.willing.to.mx.for.me,backupmx=yes,wildcard=yes \\

2277

myhost.dyndns.org,my2ndhost.dyndns.org

2278

EoEXAMPLE

2279

}

2280

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

2281

## nic_dyndns1_update

2282

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

2283

sub nic_dyndns1_update {

2284

debug("\nnic_dyndns1_update -------------------");

2285

## update each configured host

2286

foreach my $h (@_) {

2287

my $ip = delete $config{$h}{'wantip'};

2288

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

2289

verbose("UPDATE:","updating %s", $h);

2290

2291

my $url;

2292

$url = "http://$config{$h}{'server'}/nic/";

2293

$url .= ynu($config{$h}{'static'}, 'statdns', 'dyndns', 'dyndns');

2294

$url .= "?action=edit&started=1&hostname=YES&host_id=$h";

2295

$url .= "&myip=";

2296

$url .= $ip if $ip;

2297

$url .= "&wildcard=ON" if ynu($config{$h}{'wildcard'}, 1, 0, 0);

2298

if ($config{$h}{'mx'}) {

2299

$url .= "&mx=$config{$h}{'mx'}";

2300

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

2301

}

2302

2303

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

2304

if (!defined($reply) || !$reply) {

2305

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

2306

next;

2307

}

2308

last if !header_ok($h, $reply);

2309

2310

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

2311

my ($title, $return_code, $error_code) = ('','','');

2312

foreach my $line (@reply) {

2313

$title = $1 if $line =~ m%<TITLE>\s*(.*)\s*</TITLE>%i;

2314

$return_code = $1 if $line =~ m%^return\s+code\s*:\s*(.*)\s*$%i;

2315

$error_code = $1 if $line =~ m%^error\s+code\s*:\s*(.*)\s*$%i;

2316

}

2317

2318

if ($return_code ne 'NOERROR' || $error_code ne 'NOERROR' || !$title) {

2319

$config{$h}{'status'} = 'failed';

2320

$title = "incomplete response from $config{$h}{server}" unless $title;

2321

warning("SENT: %s", $url) unless opt('verbose');

2322

warning("REPLIED: %s", $reply);

2323

failed("updating %s: %s", $h, $title);

2324

2325

} else {

2326

$config{$h}{'ip'} = $ip;

2327

$config{$h}{'mtime'} = $now;

2328

$config{$h}{'status'} = 'good';

2329

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

2330

}

2331

}

2332

}

2333

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

2334

## nic_dyndns2_updateable

2335

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

2336

sub nic_dyndns2_updateable {

2337

my $host = shift;

2338

my $update = 0;

2339

2340

if ($config{$host}{'mx'} ne $cache{$host}{'mx'}) {

2341

info("forcing updating %s because 'mx' has changed to %s.", $host, $config{$host}{'mx'});

2342

$update = 1;

2343

2344

} elsif ($config{$host}{'mx'} && (ynu($config{$host}{'backupmx'},1,2,3) ne ynu($config{$host}{'backupmx'},1,2,3))) {

2345

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

2346

$update = 1;

2347

2348

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

2349

2350

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

2351

$update = 1;

2352

2353

}

2354

return $update;

2355

}

2356

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

2357

## nic_dyndns2_examples

2358

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

2359

sub nic_dyndns2_examples {

2360

return <<EoEXAMPLE;

2361

o 'dyndns2'

2362

2363

The 'dyndns2' protocol is a newer low-bandwidth protocol used by a

2364

free dynamic DNS service offered by www.dyndns.org. It supports

2365

features of the older 'dyndns1' in addition to others. [These will be

2366

supported in a future version of ${program}.]

2367

2368

Configuration variables applicable to the 'dyndns2' protocol are:

2369

protocol=dyndns2 ##

2370

server=fqdn.of.service ## defaults to members.dyndns.org

2371

script=/path/to/script ## defaults to /nic/update

2372

backupmx=no|yes ## indicates that this host is the primary MX for the domain.

2373

static=no|yes ## indicates that this host has a static IP address.

2374

custom=no|yes ## indicates that this host is a 'custom' top-level domain name.

2375

mx=any.host.domain ## a host MX'ing for this host definition.

2376

wildcard=no|yes ## add a DNS wildcard CNAME record that points to {host}

2377

login=service-login ## login name and password registered with the service

2378

password=service-password ##

2379

fully.qualified.host ## the host registered with the service.

2380

2381

Example ${program}.conf file entries:

2382

## single host update

2383

protocol=dyndns2, \\

2384

login=my-dyndns.org-login, \\

2385

password=my-dyndns.org-password \\

2386

myhost.dyndns.org

2387

2388

## multiple host update with wildcard'ing mx, and backupmx

2389

protocol=dyndns2, \\

2390

login=my-dyndns.org-login, \\

2391

password=my-dyndns.org-password, \\

2392

mx=a.host.willing.to.mx.for.me,backupmx=yes,wildcard=yes \\

2393

myhost.dyndns.org,my2ndhost.dyndns.org

2394

2395

## multiple host update to the custom DNS service

2396

protocol=dyndns2, \\

2397

login=my-dyndns.org-login, \\

2398

password=my-dyndns.org-password \\

2399

my-toplevel-domain.com,my-other-domain.com

2400

EoEXAMPLE

2401

}

2402

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

2403

## nic_dyndns2_update

2404

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

2405

sub nic_dyndns2_update {

2406

debug("\nnic_dyndns2_update -------------------");

2407

2408

## group hosts with identical attributes together

2409

my %groups = group_hosts_by([ @_ ], [ qw(login password server static custom wildcard mx backupmx) ]);

2410

2411

my %errors = (

2412

'badauth' => 'Bad authorization (username or password)',

2413

'badsys' => 'The system parameter given was not valid',

2414

2415

'notfqdn' => 'A Fully-Qualified Domain Name was not provided',

2416

'nohost' => 'The hostname specified does not exist in the database',

2417

'!yours' => 'The hostname specified exists, but not under the username currently being used',

2418

'!donator' => 'The offline setting was set, when the user is not a donator',

2419

'!active' => 'The hostname specified is in a Custom DNS domain which has not yet been activated.',

2420

'abuse', => 'The hostname specified is blocked for abuse; you should receive an email notification ' .

2421

'which provides an unblock request link. More info can be found on ' .

2422

'https://www.dyndns.com/support/abuse.html',

2423

2424

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

2425

'dnserr' => 'System error: DNS error encountered. Contact support@dyndns.org',

2426

2427

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

2428

);

2429

2430

## update each set of hosts that had similar configurations

2431

foreach my $sig (keys %groups) {

2432

my @hosts = @{$groups{$sig}};

2433

my $hosts = join(',', @hosts);

2434

my $h = $hosts[0];

2435

my $ip = $config{$h}{'wantip'};

2436

delete $config{$_}{'wantip'} foreach @hosts;

2437

2438

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

2439

verbose("UPDATE:","updating %s", $hosts);

2440

2441

## Select the DynDNS system to update

2442

my $url = "http://$config{$h}{'server'}$config{$h}{'script'}?system=";

2443

if ($config{$h}{'custom'}) {

2444

warning("updating %s: 'custom' and 'static' may not be used together. ('static' ignored)", $hosts)

2445

if $config{$h}{'static'};

2446

# warning("updating %s: 'custom' and 'offline' may not be used together. ('offline' ignored)", $hosts)

2447

# if $config{$h}{'offline'};

2448

$url .= 'custom';

2449

2450

} elsif ($config{$h}{'static'}) {

2451

# warning("updating %s: 'static' and 'offline' may not be used together. ('offline' ignored)", $hosts)

2452

# if $config{$h}{'offline'};

2453

$url .= 'statdns';

2454

2455

} else {

2456

$url .= 'dyndns';

2457

}

2458

2459

$url .= "&hostname=$hosts";

2460

$url .= "&myip=";

2461

$url .= $ip if $ip;

2462

2463

## some args are not valid for a custom domain.

2464

$url .= "&wildcard=ON" if ynu($config{$h}{'wildcard'}, 1, 0, 0);

2465

if ($config{$h}{'mx'}) {

2466

$url .= "&mx=$config{$h}{'mx'}";

2467

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

2468

}

2469

2470

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

2471

if (!defined($reply) || !$reply) {

2472

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});

2473

last;

2474

}

2475

last if !header_ok($hosts, $reply);

2476

2477

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

2478

my $state = 'header';

2479

my $returnedip = $ip;

2480

2481

foreach my $line (@reply) {

2482

if ($state eq 'header') {

2483

$state = 'body';

2484

2485

} elsif ($state eq 'body') {

2486

$state = 'results' if $line eq '';

2487

2488

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

2489

$state = 'results2';

2490

2491

# bug #10: some dyndns providers does not return the IP so

2492

# we can't use the returned IP

2493

my ($status, $returnedip) = split / /, lc $line;

2494

$ip = $returnedip if (not $ip);

2495

my $h = shift @hosts;

2496

2497

$config{$h}{'status'} = $status;

2498

if ($status eq 'good') {

2499

$config{$h}{'ip'} = $ip;

2500

$config{$h}{'mtime'} = $now;

2501

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

2502

2503

} elsif (exists $errors{$status}) {

2504

if ($status eq 'nochg') {

2505

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

2506

$config{$h}{'ip'} = $ip;

2507

$config{$h}{'mtime'} = $now;

2508

$config{$h}{'status'} = 'good';

2509

2510

} else {

2511

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

2512

}

2513

2514

} elsif ($status =~ /w(\d+)(.)/) {

2515

my ($wait, $units) = ($1, lc $2);

2516

my ($sec, $scale) = ($wait, 1);

2517

2518

($scale, $units) = (1, 'seconds') if $units eq 's';

2519

($scale, $units) = (60, 'minutes') if $units eq 'm';

2520

($scale, $units) = (60*60, 'hours') if $units eq 'h';

2521

2522

$sec = $wait * $scale;

2523

$config{$h}{'wtime'} = $now + $sec;

2524

warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip);

2525

2526

} else {

2527

failed("updating %s: %s: unexpected status (%s)", $h, $line);

2528

}

2529

}

2530

}

2531

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'})

2532

if $state ne 'results2';

2533

}

2534

}

2535

2536

2537

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

2538

## nic_noip_update

2539

## Note: uses same features as nic_dyndns2_update, less return codes

2540

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

2541

sub nic_noip_update {

2542

debug("\nnic_noip_update -------------------");

2543

2544

## group hosts with identical attributes together

2545

my %groups = group_hosts_by([ @_ ], [ qw(login password server static custom wildcard mx backupmx) ]);

2546

2547

my %errors = (

2548

'badauth' => 'Invalid username or password',

2549

'badagent' => 'Invalid user agent',

2550

'nohost' => 'The hostname specified does not exist in the database',

2551

'!donator' => 'The offline setting was set, when the user is not a donator',

2552

'abuse', => 'The hostname specified is blocked for abuse; open a trouble ticket at http://www.no-ip.com',

2553

'numhost' => 'System error: Too many or too few hosts found. open a trouble ticket at http://www.no-ip.com',

2554

'dnserr' => 'System error: DNS error encountered. Contact support@dyndns.org',

2555

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

2556

);

2557

2558

## update each set of hosts that had similar configurations

2559

foreach my $sig (keys %groups) {

2560

my @hosts = @{$groups{$sig}};

2561

my $hosts = join(',', @hosts);

2562

my $h = $hosts[0];

2563

my $ip = $config{$h}{'wantip'};

2564

delete $config{$_}{'wantip'} foreach @hosts;

2565

2566

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

2567

verbose("UPDATE:","updating %s", $hosts);

2568

2569

my $url = "http://$config{$h}{'server'}/nic/update?system=";

2570

$url .= 'noip';

2571

$url .= "&hostname=$hosts";

2572

$url .= "&myip=";

2573

$url .= $ip if $ip;

2574

2575

2576

print "here..." . $config{$h}{'login'} . " --> " . $config{$h}{'password'} . "\n";

2577

2578

2579

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

2580

if (!defined($reply) || !$reply) {

2581

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});

2582

last;

2583

}

2584

last if !header_ok($hosts, $reply);

2585

2586

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

2587

my $state = 'header';

2588

foreach my $line (@reply) {

2589

if ($state eq 'header') {

2590

$state = 'body';

2591

2592

} elsif ($state eq 'body') {

2593

$state = 'results' if $line eq '';

2594

2595

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

2596

$state = 'results2';

2597

2598

my ($status, $ip) = split / /, lc $line;

2599

my $h = shift @hosts;

2600

2601

$config{$h}{'status'} = $status;

2602

if ($status eq 'good') {

2603

$config{$h}{'ip'} = $ip;

2604

$config{$h}{'mtime'} = $now;

2605

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

2606

2607

} elsif (exists $errors{$status}) {

2608

if ($status eq 'nochg') {

2609

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

2610

$config{$h}{'ip'} = $ip;

2611

$config{$h}{'mtime'} = $now;

2612

$config{$h}{'status'} = 'good';

2613

2614

} else {

2615

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

2616

}

2617

2618

} elsif ($status =~ /w(\d+)(.)/) {

2619

my ($wait, $units) = ($1, lc $2);

2620

my ($sec, $scale) = ($wait, 1);

2621

2622

($scale, $units) = (1, 'seconds') if $units eq 's';

2623

($scale, $units) = (60, 'minutes') if $units eq 'm';

2624

($scale, $units) = (60*60, 'hours') if $units eq 'h';

2625

2626

$sec = $wait * $scale;

2627

$config{$h}{'wtime'} = $now + $sec;

2628

warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip);

2629

2630

} else {

2631

failed("updating %s: %s: unexpected status (%s)", $h, $line);

2632

}

2633

}

2634

}

2635

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'})

2636

if $state ne 'results2';

2637

}

2638

}

2639

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

2640

## nic_noip_examples

2641

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

2642

sub nic_noip_examples {

2643

return <<EoEXAMPLE;

2644

o 'noip'

2645

2646

The 'No-IP Compatible' protocol is used to make dynamic dns updates

2647

over an http request. Details of the protocol are outlined at:

2648

http://www.no-ip.com/integrate/

2649

2650

Configuration variables applicable to the 'noip' protocol are:

2651

protocol=noip ##

2652

server=fqdn.of.service ## defaults to dynupdate.no-ip.com

2653

login=service-login ## login name and password registered with the service

2654

password=service-password ##

2655

fully.qualified.host ## the host registered with the service.

2656

2657

Example ${program}.conf file entries:

2658

## single host update

2659

protocol=noip, \\

2660

login=userlogin\@domain.com, \\

2661

password=noip-password \\

2662

myhost.no-ip.biz

2663

2664

2665

EoEXAMPLE

2666

}

2667

2668

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

2669

## nic_concont_examples

2670

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

2671

sub nic_concont_examples {

2672

return <<EoEXAMPLE;

2673

o 'concont'

2674

2675

The 'concont' protocol is the protocol used by the content management

2676

system ConCont's dydns module. This is currently used by the free

2677

dynamic DNS service offered by Tyrmida at www.dydns.za.net

2678

2679

Configuration variables applicable to the 'concont' protocol are:

2680

protocol=concont ##

2681

server=www.fqdn.of.service ## for example www.dydns.za.net (for most add a www)

2682

login=service-login ## login registered with the service

2683

password=service-password ## password registered with the service

2684

mx=mail.server.fqdn ## fqdn of the server handling domain\'s mail (leave out for none)

2685

wildcard=yes|no ## set yes for wild (*.host.domain) support

2686

fully.qualified.host ## the host registered with the service.

2687

2688

Example ${program}.conf file entries:

2689

## single host update

2690

protocol=concont, \\

2691

login=dydns.za.net, \\

2692

password=my-dydns.za.net-password, \\

2693

mx=mailserver.fqdn, \\

2694

wildcard=yes \\

2695

myhost.hn.org

2696

2697

EoEXAMPLE

2698

}

2699

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

2700

## nic_concont_update

2701

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

2702

sub nic_concont_update {

2703

debug("\nnic_concont_update -------------------");

2704

2705

## update each configured host

2706

foreach my $h (@_) {

2707

my $ip = delete $config{$h}{'wantip'};

2708

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

2709

verbose("UPDATE:","updating %s", $h);

2710

2711

# Set the URL that we're going to to update

2712

my $url;

2713

$url = "http://$config{$h}{'server'}/modules/dydns/update.php";

2714

$url .= "?username=";

2715

$url .= $config{$h}{'login'};

2716

$url .= "&password=";

2717

$url .= $config{$h}{'password'};

2718

$url .= "&wildcard=";

2719

$url .= $config{$h}{'wildcard'};

2720

$url .= "&mx=";

2721

$url .= $config{$h}{'mx'};

2722

$url .= "&host=";

2723

$url .= $h;

2724

$url .= "&ip=";

2725

$url .= $ip;

2726

2727

# Try to get URL

2728

my $reply = geturl(opt('proxy'), $url);

2729

2730

# No response, declare as failed

2731

if (!defined($reply) || !$reply) {

2732

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

2733

last;

2734

}

2735

last if !header_ok($h, $reply);

2736

2737

# Response found, just declare as success (this is ugly, we need more error checking)

2738

if ($reply =~ /SUCCESS/)

2739

{

2740

$config{$h}{'ip'} = $ip;

2741

$config{$h}{'mtime'} = $now;

2742

$config{$h}{'status'} = 'good';

2743

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

2744

}

2745

else

2746

{

2747

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

2748

my $returned = pop(@reply);

2749

$config{$h}{'status'} = 'failed';

2750

failed("updating %s: Server said: '$returned'", $h);

2751

}

2752

}

2753

}

2754

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

2755

## nic_dslreports1_examples

2756

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

2757

sub nic_dslreports1_examples {

2758

return <<EoEXAMPLE;

2759

o 'dslreports1'

2760

2761

The 'dslreports1' protocol is used by a free DSL monitoring service

2762

offered by www.dslreports.com.

2763

2764

Configuration variables applicable to the 'dslreports1' protocol are:

2765

protocol=dslreports1 ##

2766

server=fqdn.of.service ## defaults to www.dslreports.com

2767

login=service-login ## login name and password registered with the service

2768

password=service-password ##

2769

unique-number ## the host registered with the service.

2770

2771

Example ${program}.conf file entries:

2772

## single host update

2773

protocol=dslreports1, \\

2774

server=www.dslreports.com, \\

2775

login=my-dslreports-login, \\

2776

password=my-dslreports-password \\

2777

123456

2778

2779

Note: DSL Reports uses a unique number as the host name. This number

2780

can be found on the Monitor Control web page.

2781

EoEXAMPLE

2782

}

2783

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

2784

## nic_dslreports1_update

2785

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

2786

sub nic_dslreports1_update {

2787

debug("\nnic_dslreports1_update -------------------");

2788

## update each configured host

2789

foreach my $h (@_) {

2790

my $ip = delete $config{$h}{'wantip'};

2791

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

2792

verbose("UPDATE:","updating %s", $h);

2793

2794

my $url;

2795

$url = "http://$config{$h}{'server'}/nic/";

2796

$url .= ynu($config{$h}{'static'}, 'statdns', 'dyndns', 'dyndns');

2797

$url .= "?action=edit&started=1&hostname=YES&host_id=$h";

2798

$url .= "&myip=";

2799

$url .= $ip if $ip;

2800

2801

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

2802

if (!defined($reply) || !$reply) {

2803

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

2804

next;

2805

}

2806

2807

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

2808

my $return_code = '';

2809

foreach my $line (@reply) {

2810

$return_code = $1 if $line =~ m%^return\s+code\s*:\s*(.*)\s*$%i;

2811

}

2812

2813

if ($return_code !~ /NOERROR/) {

2814

$config{$h}{'status'} = 'failed';

2815

warning("SENT: %s", $url) unless opt('verbose');

2816

warning("REPLIED: %s", $reply);

2817

failed("updating %s", $h);

2818

2819

} else {

2820

$config{$h}{'ip'} = $ip;

2821

$config{$h}{'mtime'} = $now;

2822

$config{$h}{'status'} = 'good';

2823

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

2824

}

2825

}

2826

}

2827

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

2828

## nic_hammernode1_examples

2829

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

2830

sub nic_hammernode1_examples {

2831

return <<EoEXAMPLE;

2832

o 'hammernode1'

2833

2834

The 'hammernode1' protocol is the protocol used by the free dynamic

2835

DNS service offered by Hammernode at www.hn.org

2836

2837

Configuration variables applicable to the 'hammernode1' protocol are:

2838

protocol=hammernode1 ##

2839

server=fqdn.of.service ## defaults to members.dyndns.org

2840

login=service-login ## login name and password registered with the service

2841

password=service-password ##

2842

fully.qualified.host ## the host registered with the service.

2843

2844

Example ${program}.conf file entries:

2845

## single host update

2846

protocol=hammernode1, \\

2847

login=my-hn.org-login, \\

2848

password=my-hn.org-password \\

2849

myhost.hn.org

2850

2851

## multiple host update

2852

protocol=hammernode1, \\

2853

login=my-hn.org-login, \\

2854

password=my-hn.org-password, \\

2855

myhost.hn.org,my2ndhost.hn.org

2856

EoEXAMPLE

2857

}

2858

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

2859

## nic_hammernode1_update

2860

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

2861

sub nic_hammernode1_update {

2862

debug("\nnic_hammernode1_update -------------------");

2863

2864

## update each configured host

2865

foreach my $h (@_) {

2866

my $ip = delete $config{$h}{'wantip'};

2867

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

2868

verbose("UPDATE:","updating %s", $h);

2869

2870

my $url;

2871

$url = "http://$config{$h}{'server'}/vanity/update";

2872

$url .= "?ver=1";

2873

$url .= "&ip=";

2874

$url .= $ip if $ip;

2875

2876

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

2877

if (!defined($reply) || !$reply) {

2878

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

2879

last;

2880

}

2881

last if !header_ok($h, $reply);

2882

2883

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

2884

if (grep //i, @reply) {

2885

$config{$h}{'ip'} = $ip;

2886

$config{$h}{'mtime'} = $now;

2887

$config{$h}{'status'} = 'good';

2888

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

2889

} else {

2890

$config{$h}{'status'} = 'failed';

2891

warning("SENT: %s", $url) unless opt('verbose');

2892

warning("REPLIED: %s", $reply);

2893

failed("updating %s: Invalid reply.", $h);

2894

}

2895

}

2896

}

2897

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

2898

## nic_zoneedit1_examples

2899

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

2900

sub nic_zoneedit1_examples {

2901

return <<EoEXAMPLE;

2902

o 'zoneedit1'

2903

2904

The 'zoneedit1' protocol is used by a DNS service offered by

2905

www.zoneedit.com.

2906

2907

Configuration variables applicable to the 'zoneedit1' protocol are:

2908

protocol=zoneedit1 ##

2909

server=fqdn.of.service ## defaults to www.zoneedit.com

2910

zone=zone-where-domains-are ## only needed if 1 or more subdomains are deeper

2911

## than 1 level in relation to the zone where it

2912

## is defined. For example, b.foo.com in a zone

2913

## foo.com doesn't need this, but a.b.foo.com in

2914

## the same zone needs zone=foo.com

2915

login=service-login ## login name and password registered with the service

2916

password=service-password ##

2917

your.domain.name ## the host registered with the service.

2918

2919

Example ${program}.conf file entries:

2920

## single host update

2921

protocol=zoneedit1, \\

2922

server=dynamic.zoneedit.com, \\

2923

zone=zone-where-domains-are, \\

2924

login=my-zoneedit-login, \\

2925

password=my-zoneedit-password \\

2926

my.domain.name

2927

EoEXAMPLE

2928

}

2929

2930

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

2931

## nic_zoneedit1_updateable

2932

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

2933

sub nic_zoneedit1_updateable {

2934

return 0;

2935

}

2936

2937

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

2938

## nic_zoneedit1_update

2939

# <SUCCESS CODE="200" TEXT="Update succeeded." ZONE="trialdomain.com" IP="127.0.0.12">

2940

# <SUCCESS CODE="201" TEXT="No records need updating." ZONE="bannedware.com">

2941

# <ERROR CODE="701" TEXT="Zone is not set up in this account." ZONE="bad.com">

2942

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

2943

sub nic_zoneedit1_update {

2944

debug("\nnic_zoneedit1_update -------------------");

2945

2946

## group hosts with identical attributes together

2947

my %groups = group_hosts_by([ @_ ], [ qw(login password server zone) ]);

2948

2949

## update each set of hosts that had similar configurations

2950

foreach my $sig (keys %groups) {

2951

my @hosts = @{$groups{$sig}};

2952

my $hosts = join(',', @hosts);

2953

my $h = $hosts[0];

2954

my $ip = $config{$h}{'wantip'};

2955

delete $config{$_}{'wantip'} foreach @hosts;

2956

2957

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

2958

verbose("UPDATE:","updating %s", $hosts);

2959

2960

my $url = '';

2961

$url .= "http://$config{$h}{'server'}/auth/dynamic.html";

2962

$url .= "?host=$hosts";

2963

$url .= "&dnsto=$ip" if $ip;

2964

$url .= "&zone=$config{$h}{'zone'}" if defined $config{$h}{'zone'};

2965

2966

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

2967

if (!defined($reply) || !$reply) {

2968

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});

2969

last;

2970

}

2971

last if !header_ok($hosts, $reply);

2972

2973

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

2974

foreach my $line (@reply) {

2975

if ($line =~ /^[^<]*<(SUCCESS|ERROR)\s+([^>]+)>(.*)/) {

2976

my ($status, $assignments, $rest) = ($1, $2, $3);

2977

my ($left, %var) = parse_assignments($assignments);

2978

2979

if (keys %var) {

2980

my ($status_code, $status_text, $status_ip) = ('999', '', $ip);

2981

$status_code = $var{'CODE'} if exists $var{'CODE'};

2982

$status_text = $var{'TEXT'} if exists $var{'TEXT'};

2983

$status_ip = $var{'IP'} if exists $var{'IP'};

2984

2985

if ($status eq 'SUCCESS' || ($status eq 'ERROR' && $var{'CODE'} eq '707')) {

2986

$config{$h}{'ip'} = $status_ip;

2987

$config{$h}{'mtime'} = $now;

2988

$config{$h}{'status'} = 'good';

2989

2990

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

2991

2992

} else {

2993

$config{$h}{'status'} = 'failed';

2994

failed("updating %s: %s: %s", $h, $status_code, $status_text);

2995

}

2996

shift @hosts;

2997

$h = $hosts[0];

2998

$hosts = join(',', @hosts);

2999

}

3000

$line = $rest;

3001

redo if $line;

3002

}

3003

}

3004

failed("updating %s: no response from %s", $hosts, $config{$h}{'server'})

3005

if @hosts;

3006

}

3007

}

3008

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

3009

## nic_easydns_updateable

3010

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

3011

sub nic_easydns_updateable {

3012

my $host = shift;

3013

my $update = 0;

3014

3015

if ($config{$host}{'mx'} ne $cache{$host}{'mx'}) {

3016

info("forcing updating %s because 'mx' has changed to %s.", $host, $config{$host}{'mx'});

3017

$update = 1;

3018

3019

} elsif ($config{$host}{'mx'} && (ynu($config{$host}{'backupmx'},1,2,3) ne ynu($config{$host}{'backupmx'},1,2,3))) {

3020

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

3021

$update = 1;

3022

3023

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

3024

3025

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

3026

$update = 1;

3027

3028

}

3029

return $update;

3030

}

3031

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

3032

## nic_easydns_examples

3033

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

3034

sub nic_easydns_examples {

3035

return <<EoEXAMPLE;

3036

o 'easydns'

3037

3038

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

3039

by www.easydns.com.

3040

3041

Configuration variables applicable to the 'easydns' protocol are:

3042

protocol=easydns ##

3043

server=fqdn.of.service ## defaults to members.easydns.com

3044

backupmx=no|yes ## indicates that EasyDNS should be the secondary MX

3045

## for this domain or host.

3046

mx=any.host.domain ## a host MX'ing for this host or domain.

3047

wildcard=no|yes ## add a DNS wildcard CNAME record that points to {host}

3048

login=service-login ## login name and password registered with the service

3049

password=service-password ##

3050

fully.qualified.host ## the host registered with the service.

3051

3052

Example ${program}.conf file entries:

3053

## single host update

3054

protocol=easydns, \\

3055

login=my-easydns.com-login, \\

3056

password=my-easydns.com-password \\

3057

myhost.easydns.com

3058

3059

## multiple host update with wildcard'ing mx, and backupmx

3060

protocol=easydns, \\

3061

login=my-easydns.com-login, \\

3062

password=my-easydns.com-password, \\

3063

mx=a.host.willing.to.mx.for.me, \\

3064

backupmx=yes, \\

3065

wildcard=yes \\

3066

my-toplevel-domain.com,my-other-domain.com

3067

3068

## multiple host update to the custom DNS service

3069

protocol=easydns, \\

3070

login=my-easydns.com-login, \\

3071

password=my-easydns.com-password \\

3072

my-toplevel-domain.com,my-other-domain.com

3073

EoEXAMPLE

3074

}

3075

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

3076

## nic_easydns_update

3077

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

3078

sub nic_easydns_update {

3079

debug("\nnic_easydns_update -------------------");

3080

3081

## group hosts with identical attributes together

3082

## my %groups = group_hosts_by([ @_ ], [ qw(login password server wildcard mx backupmx) ]);

3083

3084

## each host is in a group by itself

3085

my %groups = map { $_ => [ $_ ] } @_;

3086

3087

my %errors = (

3088

'NOACCESS' => 'Authentication failed. This happens if the username/password OR host or domain are wrong.',

3089

'NOSERVICE'=> 'Dynamic DNS is not turned on for this domain.',

3090

'ILLEGAL' => 'Client sent data that is not allowed in a dynamic DNS update.',

3091

'TOOSOON' => 'Update frequency is too short.',

3092

);

3093

3094

## update each set of hosts that had similar configurations

3095

foreach my $sig (keys %groups) {

3096

my @hosts = @{$groups{$sig}};

3097

my $hosts = join(',', @hosts);

3098

my $h = $hosts[0];

3099

my $ip = $config{$h}{'wantip'};

3100

delete $config{$_}{'wantip'} foreach @hosts;

3101

3102

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

3103

verbose("UPDATE:","updating %s", $hosts);

3104

3105

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

3106

3107

my $url;

3108

$url = "http://$config{$h}{'server'}/dyn/dyndns.php?";

3109

$url .= "hostname=$hosts";

3110

$url .= "&myip=";

3111

$url .= $ip if $ip;

3112

$url .= "&wildcard=" . ynu($config{$h}{'wildcard'}, 'ON', 'OFF', 'OFF') if defined $config{$h}{'wildcard'};

3113

3114

if ($config{$h}{'mx'}) {

3115

$url .= "&mx=$config{$h}{'mx'}";

3116

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

3117

}

3118

3119

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

3120

if (!defined($reply) || !$reply) {

3121

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});

3122

last;

3123

}

3124

last if !header_ok($hosts, $reply);

3125

3126

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

3127

my $state = 'header';

3128

foreach my $line (@reply) {

3129

if ($state eq 'header') {

3130

$state = 'body';

3131

3132

} elsif ($state eq 'body') {

3133

$state = 'results' if $line eq '';

3134

3135

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

3136

$state = 'results2';

3137

3138

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

3139

my $h = shift @hosts;

3140

3141

$config{$h}{'status'} = $status;

3142

if ($status eq 'NOERROR') {

3143

$config{$h}{'ip'} = $ip;

3144

$config{$h}{'mtime'} = $now;

3145

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

3146

3147

} elsif ($status =~ /TOOSOON/) {

3148

## make sure we wait at least a little

3149

my ($wait, $units) = (5, 'm');

3150

my ($sec, $scale) = ($wait, 1);

3151

3152

($scale, $units) = (1, 'seconds') if $units eq 's';

3153

($scale, $units) = (60, 'minutes') if $units eq 'm';

3154

($scale, $units) = (60*60, 'hours') if $units eq 'h';

3155

$config{$h}{'wtime'} = $now + $sec;

3156

warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip);

3157

3158

} elsif (exists $errors{$status}) {

3159

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

3160

3161

} else {

3162

failed("updating %s: %s: unexpected status (%s)", $h, $line);

3163

}

3164

last;

3165

}

3166

}

3167

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'})

3168

if $state ne 'results2';

3169

}

3170

}

3171

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

3172

3173

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

3174

## nic_dnspark_updateable

3175

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

3176

sub nic_dnspark_updateable {

3177

my $host = shift;

3178

my $update = 0;

3179

3180

if ($config{$host}{'mx'} ne $cache{$host}{'mx'}) {

3181

info("forcing updating %s because 'mx' has changed to %s.", $host, $config{$host}{'mx'});

3182

$update = 1;

3183

3184

} elsif ($config{$host}{'mx'} && ($config{$host}{'mxpri'} ne $cache{$host}{'mxpri'})) {

3185

info("forcing updating %s because 'mxpri' has changed to %s.", $host, $config{$host}{'mxpri'});

3186

$update = 1;

3187

}

3188

return $update;

3189

}

3190

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

3191

## nic_dnspark_examples

3192

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

3193

sub nic_dnspark_examples {

3194

return <<EoEXAMPLE;

3195

o 'dnspark'

3196

3197

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

3198

3199

Configuration variables applicable to the 'dnspark' protocol are:

3200

protocol=dnspark ##

3201

server=fqdn.of.service ## defaults to www.dnspark.com

3202

backupmx=no|yes ## indicates that DNSPark should be the secondary MX

3203

## for this domain or host.

3204

mx=any.host.domain ## a host MX'ing for this host or domain.

3205

mxpri=priority ## MX priority.

3206

login=service-login ## login name and password registered with the service

3207

password=service-password ##

3208

fully.qualified.host ## the host registered with the service.

3209

3210

Example ${program}.conf file entries:

3211

## single host update

3212

protocol=dnspark, \\

3213

login=my-dnspark.com-login, \\

3214

password=my-dnspark.com-password \\

3215

myhost.dnspark.com

3216

3217

## multiple host update with wildcard'ing mx, and backupmx

3218

protocol=dnspark, \\

3219

login=my-dnspark.com-login, \\

3220

password=my-dnspark.com-password, \\

3221

mx=a.host.willing.to.mx.for.me, \\

3222

mxpri=10, \\

3223

my-toplevel-domain.com,my-other-domain.com

3224

3225

## multiple host update to the custom DNS service

3226

protocol=dnspark, \\

3227

login=my-dnspark.com-login, \\

3228

password=my-dnspark.com-password \\

3229

my-toplevel-domain.com,my-other-domain.com

3230

EoEXAMPLE

3231

}

3232

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

3233

## nic_dnspark_update

3234

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

3235

sub nic_dnspark_update {

3236

debug("\nnic_dnspark_update -------------------");

3237

3238

## group hosts with identical attributes together

3239

## my %groups = group_hosts_by([ @_ ], [ qw(login password server wildcard mx backupmx) ]);

3240

3241

## each host is in a group by itself

3242

my %groups = map { $_ => [ $_ ] } @_;

3243

3244

my %errors = (

3245

'nochange' => 'No changes made to the hostname(s). Continual updates with no changes lead to blocked clients.',

3246

'nofqdn' => 'No valid FQDN (fully qualified domain name) was specified',

3247

'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.',

3248

'abuse' => 'The hostname specified has been blocked for abuse.',

3249

'unauth' => 'The username specified is not authorized to update this hostname and domain.',

3250

'blocked' => 'The dynamic update client (specified by the user-agent) has been blocked from the system.',

3251

'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.',

3252

);

3253

3254

## update each set of hosts that had similar configurations

3255

foreach my $sig (keys %groups) {

3256

my @hosts = @{$groups{$sig}};

3257

my $hosts = join(',', @hosts);

3258

my $h = $hosts[0];

3259

my $ip = $config{$h}{'wantip'};

3260

delete $config{$_}{'wantip'} foreach @hosts;

3261

3262

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

3263

verbose("UPDATE:","updating %s", $hosts);

3264

3265

#'http://www.dnspark.com:80/visitors/update.html?myip=10.20.30.40&hostname=test.burry.ca'

3266

3267

my $url;

3268

$url = "http://$config{$h}{'server'}/visitors/update.html";

3269

$url .= "?hostname=$hosts";

3270

$url .= "&myip=";

3271

$url .= $ip if $ip;

3272

3273

if ($config{$h}{'mx'}) {

3274

$url .= "&mx=$config{$h}{'mx'}";

3275

$url .= "&mxpri=" . $config{$h}{'mxpri'};

3276

}

3277

3278

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

3279

if (!defined($reply) || !$reply) {

3280

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});

3281

last;

3282

}

3283

last if !header_ok($hosts, $reply);

3284

3285

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

3286

my $state = 'header';

3287

foreach my $line (@reply) {

3288

if ($state eq 'header') {

3289

$state = 'body';

3290

3291

} elsif ($state eq 'body') {

3292

$state = 'results' if $line eq '';

3293

3294

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

3295

$state = 'results2';

3296

3297

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

3298

my $h = pop @hosts;

3299

3300

$config{$h}{'status'} = $status;

3301

if ($status eq 'ok') {

3302

$config{$h}{'ip'} = $ip;

3303

$config{$h}{'mtime'} = $now;

3304

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

3305

3306

} elsif ($status =~ /TOOSOON/) {

3307

## make sure we wait at least a little

3308

my ($wait, $units) = (5, 'm');

3309

my ($sec, $scale) = ($wait, 1);

3310

3311

($scale, $units) = (1, 'seconds') if $units eq 's';

3312

($scale, $units) = (60, 'minutes') if $units eq 'm';

3313

($scale, $units) = (60*60, 'hours') if $units eq 'h';

3314

$config{$h}{'wtime'} = $now + $sec;

3315

warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip);

3316

3317

} elsif (exists $errors{$status}) {

3318

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

3319

3320

} else {

3321

failed("updating %s: %s: unexpected status (%s)", $h, $line);

3322

}

3323

last;

3324

}

3325

}

3326

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'})

3327

if $state ne 'results2';

3328

}

3329

}

3330

3331

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

3332

3333

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

3334

## nic_namecheap_examples

3335

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

3336

sub nic_namecheap_examples {

3337

return <<EoEXAMPLE;

3338

3339

o 'namecheap'

3340

3341

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

3342

3343

Configuration variables applicable to the 'namecheap' protocol are:

3344

protocol=namecheap ##

3345

server=fqdn.of.service ## defaults to dynamicdns.park-your-domain.com

3346

login=service-login ## login name and password registered with the service

3347

password=service-password ##

3348

fully.qualified.host ## the host registered with the service.

3349

3350

Example ${program}.conf file entries:

3351

## single host update

3352

protocol=namecheap, \\

3353

login=my-namecheap.com-login, \\

3354

password=my-namecheap.com-password \\

3355

myhost.namecheap.com

3356

3357

EoEXAMPLE

3358

}

3359

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

3360

## nic_namecheap_update

3361

##

3362

## written by Dan Boardman

3363

##

3364

## based on http://www.namecheap.com/resources/help/index.asp?t=dynamicdns

3365

## needs this url to update:

3366

## http://dynamicdns.park-your-domain.com/update?host=host_name&

3367

## domain=domain.com&password=domain_password[&ip=your_ip]

3368

##

3369

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

3370

sub nic_namecheap_update {

3371

3372

3373

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

3374

3375

## update each configured host

3376

foreach my $h (@_) {

3377

my $ip = delete $config{$h}{'wantip'};

3378

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

3379

verbose("UPDATE:","updating %s", $h);

3380

3381

my $url;

3382

$url = "http://$config{$h}{'server'}/update";

3383

$url .= "?host=$h";

3384

$url .= "&domain=$config{$h}{'login'}";

3385

$url .= "&password=$config{$h}{'password'}";

3386

$url .= "&ip=";

3387

$url .= $ip if $ip;

3388

3389

my $reply = geturl(opt('proxy'), $url);

3390

if (!defined($reply) || !$reply) {

3391

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

3392

last;

3393

}

3394

last if !header_ok($h, $reply);

3395

3396

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

3397

if (grep /<ErrCount>0/i, @reply) {

3398

$config{$h}{'ip'} = $ip;

3399

$config{$h}{'mtime'} = $now;

3400

$config{$h}{'status'} = 'good';

3401

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

3402

} else {

3403

$config{$h}{'status'} = 'failed';

3404

warning("SENT: %s", $url) unless opt('verbose');

3405

warning("REPLIED: %s", $reply);

3406

failed("updating %s: Invalid reply.", $h);

3407

}

3408

}

3409

}

3410

3411

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

3412

3413

3414

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

3415

3416

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

3417

## nic_sitelutions_examples

3418

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

3419

sub nic_sitelutions_examples {

3420

return <<EoEXAMPLE;

3421

3422

o 'sitelutions'

3423

3424

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

3425

3426

Configuration variables applicable to the 'sitelutions' protocol are:

3427

protocol=sitelutions ##

3428

server=fqdn.of.service ## defaults to sitelutions.com

3429

login=service-login ## login name and password registered with the service

3430

password=service-password ##

3431

A_record_id ## Id of the A record for the host registered with the service.

3432

3433

Example ${program}.conf file entries:

3434

## single host update

3435

protocol=sitelutions, \\

3436

login=my-sitelutions.com-login, \\

3437

password=my-sitelutions.com-password \\

3438

my-sitelutions.com-id_of_A_record

3439

3440

EoEXAMPLE

3441

}

3442

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

3443

## nic_sitelutions_update

3444

##

3445

## written by Mike W. Smith

3446

##

3447

## based on http://www.sitelutions.com/help/dynamic_dns_clients#updatespec

3448

## needs this url to update:

3449

## https://www.sitelutions.com/dnsup?id=990331&user=myemail@mydomain.com&pass=SecretPass&ip=192.168.10.4

3450

## domain=domain.com&password=domain_password&ip=your_ip

3451

##

3452

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

3453

sub nic_sitelutions_update {

3454

3455

3456

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

3457

3458

## update each configured host

3459

foreach my $h (@_) {

3460

my $ip = delete $config{$h}{'wantip'};

3461

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

3462

verbose("UPDATE:","updating %s", $h);

3463

3464

my $url;

3465

$url = "http://$config{$h}{'server'}/dnsup";

3466

$url .= "?id=$h";

3467

$url .= "&user=$config{$h}{'login'}";

3468

$url .= "&pass=$config{$h}{'password'}";

3469

$url .= "&ip=";

3470

$url .= $ip if $ip;

3471

3472

my $reply = geturl(opt('proxy'), $url);

3473

if (!defined($reply) || !$reply) {

3474

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

3475

last;

3476

}

3477

last if !header_ok($h, $reply);

3478

3479

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

3480

if (grep /success/i, @reply) {

3481

$config{$h}{'ip'} = $ip;

3482

$config{$h}{'mtime'} = $now;

3483

$config{$h}{'status'} = 'good';

3484

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

3485

} else {

3486

$config{$h}{'status'} = 'failed';

3487

warning("SENT: %s", $url) unless opt('verbose');

3488

warning("REPLIED: %s", $reply);

3489

failed("updating %s: Invalid reply.", $h);

3490

}

3491

}

3492

}

3493

3494

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

3495

3496

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

3497

## nic_freedns_examples

3498

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

3499

sub nic_freedns_examples {

3500

return <<EoEXAMPLE;

3501

3502

o 'freedns'

3503

3504

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

3505

3506

Configuration variables applicable to the 'freedns' protocol are:

3507

protocol=freedns ##

3508

server=fqdn.of.service ## defaults to freedns.afraid.org

3509

login=service-login ## login name and password registered with the service

3510

password=service-password ##

3511

fully.qualified.host ## the host registered with the service.

3512

3513

Example ${program}.conf file entries:

3514

## single host update

3515

protocol=freedns, \\

3516

login=my-freedns.afraid.org-login, \\

3517

password=my-freedns.afraid.org-password \\

3518

myhost.afraid.com

3519

3520

EoEXAMPLE

3521

}

3522

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

3523

## nic_freedns_update

3524

##

3525

## written by John Haney

3526

##

3527

## based on http://freedns.afraid.org/api/

3528

## needs this url to update:

3529

## http://freedns.afraid.org/api/?action=getdyndns&sha=<sha1sum of login|password>

3530

## This returns a list of host|currentIP|updateURL lines.

3531

## Pick the line that matches myhost, and fetch the URL.

3532

## word 'Updated' for success, 'fail' for failure.

3533

##

3534

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

3535

sub nic_freedns_update {

3536

3537

3538

debug("\nnic_freedns_update -------------------");

3539

3540

## First get the list of updatable hosts

3541

my $url;

3542

$url = "http://$config{$_[0]}{'server'}/api/?action=getdyndns&sha=".&sha1_hex("$config{$_[0]}{'login'}|$config{$_[0]}{'password'}");

3543

my $reply = geturl(opt('proxy'), $url);

3544

if (!defined($reply) || !$reply || !header_ok($_[0], $reply)) {

3545

failed("updating %s: Could not connect to %s for site list.", $_[0], $url);

3546

return;

3547

}

3548

my @lines = split("\n", $reply);

3549

my %freedns_hosts;

3550

grep {

3551

my @rec = split(/\|/, $_);

3552

$freedns_hosts{$rec[0]} = \@rec if ($#rec > 0);

3553

} @lines;

3554

if (!keys %freedns_hosts) {

3555

failed("Could not get freedns update URLs from %s", $config{$_[0]}{'server'});

3556

return;

3557

}

3558

## update each configured host

3559

foreach my $h (@_) {

3560

if(!$h){ next };

3561

my $ip = delete $config{$h}{'wantip'};

3562

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

3563

verbose("UPDATE:","updating %s", $h);

3564

3565

if($ip eq $freedns_hosts{$h}->[1]) {

3566

$config{$h}{'ip'} = $ip;

3567

$config{$h}{'mtime'} = $now;

3568

$config{$h}{'status'} = 'good';

3569

success("update not necessary %s: good: IP address already set to %s", $h, $ip);

3570

} else {

3571

my $reply = geturl(opt('proxy'), $freedns_hosts{$h}->[2]);

3572

if (!defined($reply) || !$reply) {

3573

failed("updating %s: Could not connect to %s.", $h, $freedns_hosts{$h}->[2]);

3574

last;

3575

}

3576

if(!header_ok($h, $reply)) {

3577

$config{$h}{'status'} = 'failed';

3578

last;

3579

}

3580

3581

if($reply =~ /Updated.*$h.*to.*$ip/) {

3582

$config{$h}{'ip'} = $ip;

3583

$config{$h}{'mtime'} = $now;

3584

$config{$h}{'status'} = 'good';

3585

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

3586

} else {

3587

$config{$h}{'status'} = 'failed';

3588

warning("SENT: %s", $freedns_hosts{$h}->[2]) unless opt('verbose');

3589

warning("REPLIED: %s", $reply);

3590

failed("updating %s: Invalid reply.", $h);

3591

}

3592

}

3593

}

3594

}

3595

3596

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

3597

3598

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

3599

## nic_dtdns_examples

3600

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

3601

sub nic_dtdns_examples {

3602

return <<EoEXAMPLE;

3603

o 'dtdns'

3604

3605

The 'dtdns' protocol is the protocol used by the dynamic hostname services

3606

of the 'DtDNS' dns services. This is currently used by the free

3607

dynamic DNS service offered by www.dtdns.com.

3608

3609

Configuration variables applicable to the 'dtdns' protocol are:

3610

protocol=dtdns ##

3611

server=www.fqdn.of.service ## defaults to www.dtdns.com

3612

password=service-password ## password registered with the service

3613

client=name_of_updater ## defaults to $program (10 chars max, no spaces)

3614

fully.qualified.host ## the host registered with the service.

3615

3616

Example ${program}.conf file entries:

3617

## single host update

3618

protocol=dtdns, \\

3619

password=my-dydns.za.net-password, \\

3620

client=ddclient \\

3621

myhost.dtdns.net

3622

3623

EoEXAMPLE

3624

}

3625

3626

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

3627

## nic_dtdns_update

3628

## by Achim Franke

3629

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

3630

sub nic_dtdns_update {

3631

debug("\nnic_dtdns_update -------------------");

3632

3633

## update each configured host

3634

foreach my $h (@_) {

3635

my $ip = delete $config{$h}{'wantip'};

3636

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

3637

verbose("UPDATE:","updating %s", $h);

3638

3639

# Set the URL that we're going to to update

3640

my $url;

3641

$url = "http://$config{$h}{'server'}/api/autodns.cfm";

3642

$url .= "?id=";

3643

$url .= $h;

3644

$url .= "&pw=";

3645

$url .= $config{$h}{'password'};

3646

$url .= "&ip=";

3647

$url .= $ip;

3648

$url .= "&client=";

3649

$url .= $config{$h}{'client'};

3650

3651

# Try to get URL

3652

my $reply = geturl(opt('proxy'), $url);

3653

3654

# No response, declare as failed

3655

if (!defined($reply) || !$reply) {

3656

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

3657

last;

3658

}

3659

last if !header_ok($h, $reply);

3660

3661

# Response found, just declare as success (this is ugly, we need more error checking)

3662

if ($reply =~ /now\spoints\sto/)

3663

{

3664

$config{$h}{'ip'} = $ip;

3665

$config{$h}{'mtime'} = $now;

3666

$config{$h}{'status'} = 'good';

3667

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

3668

}

3669

else

3670

{

3671

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

3672

my $returned = pop(@reply);

3673

$config{$h}{'status'} = 'failed';

3674

failed("updating %s: Server said: '$returned'", $h);

3675

}

3676

}

3677

}

3678

3679

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

3680

# vim: ai ts=4 sw=4 tw=78 :

3681

3682

3683

__END__