~ubuntu-branches/ubuntu/wily/ddclient/wily : revision 33

1

#!/usr/bin/perl -w

2

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

3

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

4

# $Id: ddclient 106 2008-12-04 18:05:23Z 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 = "3.8.0";

24

my $programd = $0;

25

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

26

my $program = $programd;

27

$program =~ s/d$//;

28

my $now = time;

29

my $hostname = hostname();

30

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

31

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

32

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

33

my $msgs = '';

34

my $last_msgs = '';

35

36

use vars qw($file $lineno);

37

local $file = '';

38

local $lineno = '';

39

40

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

41

42

sub T_ANY {'any'};

43

sub T_STRING {'string'};

44

sub T_EMAIL {'e-mail address'};

45

sub T_NUMBER {'number'};

46

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

47

sub T_LOGIN {'login'};

48

sub T_PASSWD {'password'};

49

sub T_BOOL {'boolean value'};

50

sub T_FQDN {'fully qualified host name'};

51

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

52

sub T_FILE {'file name'};

53

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

54

sub T_PROTO {'protocol'}

55

sub T_USE {'ip strategy'}

56

sub T_IF {'interface'}

57

sub T_PROG {'program name'}

58

sub T_IP {'ip'}

59

sub T_POSTS {'postscript'};

60

61

## strategies for obtaining an ip address.

62

my %builtinweb = (

63

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

64

'Current IP Address:', },

65

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

66

);

67

my %builtinfw = (

68

'watchguard-soho' => {

69

'name' => 'Watchguard SOHO FW',

70

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

71

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

72

},

73

'netopia-r910' => {

74

'name' => 'Netopia R910 FW',

75

'url' => '/WanEvtLog',

76

'skip' => 'local:',

77

},

78

'smc-barricade' => {

79

'name' => 'SMC Barricade FW',

80

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

81

'skip' => 'IP Address',

82

},

83

'smc-barricade-alt' => {

84

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

85

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

86

'skip' => 'WAN IP',

87

},

88

'smc-barricade-7401bra' => {

89

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

90

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

91

'skip' => 'IP Address',

92

},

93

'netgear-rt3xx' => {

94

'name' => 'Netgear FW',

95

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

96

'skip' => 'IP Address',

97

},

98

'elsa-lancom-dsl10' => {

99

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

100

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

101

'skip' => 'IP.Address',

102

},

103

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

104

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

105

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

106

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

107

},

108

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

109

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

110

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

111

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

112

},

113

'linksys' => {

114

'name' => 'Linksys FW',

115

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

116

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

117

},

118

'linksys-ver2' => {

119

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

120

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

121

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

122

},

123

'linksys-ver3' => {

124

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

125

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

126

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

127

},

128

'linksys-wrt854g' => {

129

'name' => 'Linksys WRT854G FW',

130

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

131

'skip' => 'IP Address:',

132

},

133

'maxgate-ugate3x00' => {

134

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

135

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

136

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

137

},

138

'netcomm-nb3' => {

139

'name' => 'NetComm NB3',

140

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

141

'skip' => 'ppp-0',

142

},

143

'3com-3c886a' => {

144

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

145

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

146

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

147

},

148

'sohoware-nbg800' => {

149

'name' => 'SOHOWare BroadGuard NBG800',

150

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

151

'skip' => 'Internet IP',

152

},

153

'xsense-aero' => {

154

'name' => 'Xsense Aero',

155

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

156

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

157

},

158

'alcatel-stp' => {

159

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

160

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

161

'skip' => 'Brt',

162

},

163

'alcatel-510' => {

164

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

165

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

166

'skip' => 'ppp',

167

},

168

'allnet-1298' => {

169

'name' => 'Allnet 1298',

170

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

171

'skip' => 'WAN',

172

},

173

'3com-oc-remote812' => {

174

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

175

'url' => '/callEvent',

176

'skip' => '.*LOCAL',

177

},

178

'e-tech' => {

179

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

180

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

181

'skip' => 'Public IP Address',

182

},

183

'cayman-3220h' => {

184

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

185

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

186

'skip' => '.*inet',

187

},

188

'vigor-2200usb' => {

189

'name' => 'Vigor 2200 USB',

190

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

191

'skip' => 'PPPoA',

192

},

193

'dlink-614' => {

194

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

195

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

196

'skip' => 'WAN',

197

},

198

'dlink-604' => {

199

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

200

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

201

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

202

},

203

'olitec-SX200' => {

204

'name' => 'olitec-SX200',

205

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

206

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

207

},

208

'westell-6100' => {

209

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

210

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

211

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

212

},

213

'2wire' => {

214

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

215

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

216

'skip' => 'Internet Address:',

217

},

218

'linksys-rv042-wan1' => {

219

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

220

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

221

'skip' => 'WAN1 IP',

222

},

223

'linksys-rv042-wan2' => {

224

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

225

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

226

'skip' => 'WAN2 IP',

227

},

228

'netgear-rp614' => {

229

'name' => 'Netgear RP614 FW',

230

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

231

'skip' => 'IP Address',

232

},

233

'watchguard-edge-x' => {

234

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

235

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

236

'skip' => 'inet addr:',

237

},

238

'dlink-524' => {

239

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

240

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

241

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

242

},

243

'rtp300' => {

244

'name' => 'Linksys RTP300',

245

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

246

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

247

},

248

'netgear-wpn824' => {

249

'name' => 'Netgear WPN824 FW',

250

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

251

'skip' => 'IP Address',

252

},

253

'linksys-wcg200' => {

254

'name' => 'Linksys WCG200 FW',

255

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

256

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

257

},

258

'netgear-dg834g' => {

259

'name' => 'netgear-dg834g',

260

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

261

'skip' => '',

262

},

263

'netgear-wgt624' => {

264

'name' => 'Netgear WGT624',

265

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

266

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

267

},

268

'sveasoft' => {

269

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

270

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

271

'skip' => 'var wan_ip',

272

},

273

'smc-barricade-7004vbr' => {

274

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

275

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

276

'skip' => 'var wan_ip=',

277

},

278

'sitecom-dc202' => {

279

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

280

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

281

'skip' => 'Internet IP Address',

282

},

283

);

284

my %ip_strategies = (

285

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

286

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

287

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

288

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

289

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

290

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

291

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

292

);

293

sub ip_strategies_usage {

294

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

295

}

296

297

my %web_strategies = (

298

'dyndns'=> 1,

299

'dnspark'=> 1,

300

);

301

302

sub setv {

303

return {

304

'type' => shift,

305

'required' => shift,

306

'cache' => shift,

307

'config' => shift,

308

'default' => shift,

309

'minimum' => shift,

310

};

311

};

312

my %variables = (

313

'global-defaults' => {

314

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

315

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

316

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

317

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

318

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

319

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

320

321

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

322

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

323

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

324

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

325

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

326

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

327

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

328

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

329

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

330

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

331

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

332

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

333

334

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

335

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

336

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

337

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

338

339

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

340

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

341

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

342

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

343

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

344

345

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

346

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

347

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

348

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

349

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

350

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

351

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

352

353

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

354

},

355

'service-common-defaults' => {

356

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

357

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

358

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

359

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

360

361

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

362

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

363

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

364

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

365

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

366

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

367

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

368

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

369

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

370

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

371

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

372

373

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

374

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

375

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

376

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

377

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

378

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

379

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

380

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

381

382

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

383

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

384

},

385

'dyndns-common-defaults' => {

386

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

387

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

388

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

389

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

390

},

391

'easydns-common-defaults' => {

392

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

393

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

394

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

395

},

396

'dnspark-common-defaults' => {

397

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

398

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

399

},

400

'noip-common-defaults' => {

401

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

402

},

403

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

404

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

405

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

406

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

407

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

408

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

409

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

410

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

411

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

412

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

413

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

414

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

415

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

416

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

417

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

418

},

419

);

420

my %services = (

421

'dyndns1' => {

422

'updateable' => \&nic_dyndns2_updateable,

423

'update' => \&nic_dyndns1_update,

424

'examples' => \&nic_dyndns1_examples,

425

'variables' => merge(

426

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

427

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

428

),

429

},

430

'dyndns2' => {

431

'updateable' => \&nic_dyndns2_updateable,

432

'update' => \&nic_dyndns2_update,

433

'examples' => \&nic_dyndns2_examples,

434

'variables' => merge(

435

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

436

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

437

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

438

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

439

),

440

},

441

'noip' => {

442

'updateable' => undef,

443

'update' => \&nic_noip_update,

444

'examples' => \&nic_noip_examples,

445

'variables' => merge(

446

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

447

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

448

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

449

),

450

},

451

'concont' => {

452

'updateable' => undef,

453

'update' => \&nic_concont_update,

454

'examples' => \&nic_concont_examples,

455

'variables' => merge(

456

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

457

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

458

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

459

),

460

},

461

'dslreports1' => {

462

'updateable' => undef,

463

'update' => \&nic_dslreports1_update,

464

'examples' => \&nic_dslreports1_examples,

465

'variables' => merge(

466

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

467

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

468

),

469

},

470

'hammernode1' => {

471

'updateable' => undef,

472

'update' => \&nic_hammernode1_update,

473

'examples' => \&nic_hammernode1_examples,

474

'variables' => merge(

475

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

476

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

477

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

478

),

479

},

480

'zoneedit1' => {

481

'updateable' => undef,

482

'update' => \&nic_zoneedit1_update,

483

'examples' => \&nic_zoneedit1_examples,

484

'variables' => merge(

485

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

486

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

487

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

488

),

489

},

490

'easydns' => {

491

'updateable' => undef,

492

'update' => \&nic_easydns_update,

493

'examples' => \&nic_easydns_examples,

494

'variables' => merge(

495

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

496

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

497

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

498

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

499

),

500

},

501

'dnspark' => {

502

'updateable' => undef,

503

'update' => \&nic_dnspark_update,

504

'examples' => \&nic_dnspark_examples,

505

'variables' => merge(

506

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

507

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

508

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

509

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

510

),

511

},

512

'namecheap' => {

513

'updateable' => undef,

514

'update' => \&nic_namecheap_update,

515

'examples' => \&nic_namecheap_examples,

516

'variables' => merge(

517

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

518

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

519

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

520

),

521

},

522

'sitelutions' => {

523

'updateable' => undef,

524

'update' => \&nic_sitelutions_update,

525

'examples' => \&nic_sitelutions_examples,

526

'variables' => merge(

527

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

528

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

529

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

530

),

531

},

532

);

533

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

534

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

535

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

536

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

537

);

538

539

my @opt = (

540

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

541

"options are:",

542

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

543

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

544

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

545

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

546

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

547

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

548

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

549

"",

550

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

551

&ip_strategies_usage(),

552

"",

553

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

554

"",

555

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

556

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

557

"",

558

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

559

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

560

"",

561

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

562

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

563

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

564

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

565

"",

566

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

567

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

568

"",

569

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

570

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

571

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

572

"",

573

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

574

"",

575

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

576

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

577

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

578

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

579

580

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

581

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

582

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

583

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

584

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

585

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

586

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

587

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

588

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

589

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

590

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

591

592

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

593

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

594

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

595

"",

596

nic_examples(),

597

"$program version $version, ",

598

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

599

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

600

);

601

602

## process args

603

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

604

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

605

my $saved_cache = '';

606

my %saved_opt = %opt;

607

$result = 'OK';

608

609

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

610

611

## process help option

612

if (opt('help')) {

613

*STDERR = *STDOUT;

614

usage(0);

615

}

616

617

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

618

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

619

init_config();

620

test_possible_ip() if opt('query');

621

622

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

623

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

624

}

625

my $caught_hup = 0;

626

my $caught_term = 0;

627

my $caught_kill = 0;

628

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

629

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

630

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

631

if (opt('daemon') && !opt('force')) {

632

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

633

my $pid = fork;

634

if ($pid < 0) {

635

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

636

exit -1;

637

} elsif ($pid) {

638

exit 0;

639

}

640

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

641

$opt{'syslog'} = 1;

642

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

643

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

644

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

645

646

write_pid();

647

}

648

649

umask 077;

650

my $daemon;

651

do {

652

$now = time;

653

$result = 'OK';

654

%opt = %saved_opt;

655

if (opt('help')) {

656

*STDERR = *STDOUT;

657

printf("Help found");

658

# usage();

659

}

660

661

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

662

init_config();

663

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

664

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

665

666

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

667

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

668

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

669

670

$daemon = $opt{'daemon'};

671

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

672

673

update_nics();

674

675

if ($daemon) {

676

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

677

sendmail();

678

679

my $left = $daemon;

680

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

681

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

682

683

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

684

$left -= sleep $delay;

685

}

686

$caught_hup = 0;

687

$result = 0;

688

689

} elsif (! scalar(%config)) {

690

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

691

$result = 1;

692

693

} else {

694

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

695

}

696

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

697

698

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

699

unlink_pid();

700

sendmail();

701

702

exit($result);

703

704

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

705

## runpostscript

706

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

707

708

sub runpostscript {

709

my ($ip) = @_;

710

711

if ( defined $globals{postscript} ) {

712

if ( -x $globals{postscript}) {

713

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

714

} else {

715

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

716

}

717

}

718

}

719

720

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

721

## update_nics

722

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

723

sub update_nics {

724

my %examined = ();

725

726

foreach my $s (sort keys %services) {

727

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

728

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

729

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

730

731

foreach my $h (sort keys %config) {

732

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

733

$examined{$h} = 1;

734

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

735

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

736

my $ip = get_ip($use);

737

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

738

warning("unable to determine IP address")

739

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

740

next;

741

}

742

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

743

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

744

next;

745

}

746

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

747

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

748

push @hosts, $h;

749

$ips{$ip} = $h;

750

}

751

if (@hosts) {

752

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

753

&$update(@hosts);

754

runpostscript(join ' ', keys %ips);

755

}

756

}

757

foreach my $h (sort keys %config) {

758

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

759

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

760

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

761

);

762

}

763

}

764

write_cache(opt('cache'));

765

}

766

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

767

## unlink_pid()

768

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

769

sub unlink_pid {

770

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

771

unlink opt('pid');

772

}

773

}

774

775

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

776

## write_pid()

777

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

778

sub write_pid {

779

my $file = opt('pid');

780

781

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

782

local *FD;

783

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

784

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

785

786

} else {

787

printf FD "$$\n";

788

close(FD);

789

}

790

}

791

}

792

793

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

794

## write_cache($file)

795

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

796

sub write_cache {

797

my ($file) = @_;

798

799

## merge the updated host entries into the cache.

800

foreach my $h (keys %config) {

801

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

802

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

803

804

} else {

805

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

806

}

807

}

808

809

## construct the cache file.

810

my $cache = "";

811

foreach my $h (sort keys %cache) {

812

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

813

814

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

815

}

816

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

817

818

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

819

if ($file) {

820

$saved_cache = undef;

821

local *FD;

822

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

823

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

824

}

825

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

826

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

827

printf FD $cache;

828

829

close(FD);

830

}

831

}

832

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

833

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

834

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

835

sub read_cache {

836

my $file = shift;

837

my $config = shift;

838

my $globals = {};

839

840

%{$config} = ();

841

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

842

if (-e $file) {

843

my %saved = %opt;

844

%opt = ();

845

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

846

%opt = %saved;

847

848

foreach my $h (keys %cache) {

849

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

850

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

851

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

852

}

853

}

854

}

855

}

856

}

857

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

858

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

859

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

860

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

861

sub parse_assignments {

862

my $rest = shift;

863

my @args = @_;

864

my %variables = ();

865

my ($name, $value);

866

867

while (1) {

868

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

869

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

870

if (defined $name) {

871

$variables{$name} = $value;

872

} else {

873

last;

874

}

875

}

876

return ($rest, %variables);

877

}

878

sub parse_assignment {

879

my $rest = shift;

880

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

881

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

882

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

883

884

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

885

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

886

887

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

888

$rest = substr($rest,1);

889

if ($escape) {

890

$value .= $c;

891

$escape = 0;

892

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

893

$escape = 1;

894

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

895

$quote = ''

896

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

897

$quote = $c;

898

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

899

last;

900

} else {

901

$value .= $c;

902

}

903

}

904

}

905

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

906

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

907

}

908

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

909

## read_config

910

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

911

sub read_config {

912

my $file = shift;

913

my $config = shift;

914

my $globals = shift;

915

my %globals = ();

916

917

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

918

}

919

sub _read_config {

920

my $config = shift;

921

my $globals = shift;

922

my $stamp = shift;

923

local $file = shift;

924

my %globals = @_;

925

my %config = ();

926

my $content = '';

927

928

local *FD;

929

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

930

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

931

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

932

}

933

# Check for only owner has any access to config file

934

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

935

if ($mode & 077) {

936

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

937

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

938

} else {

939

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

940

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

941

}

942

}

943

944

local $lineno = 0;

945

my $continuation = '';

946

my %passwords = ();

947

while (<FD>) {

948

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

949

950

$lineno++;

951

952

## check for the program version stamp

953

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

954

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

955

last;

956

}

957

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

958

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

959

}

960

961

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

962

963

## parsing passwords is special

964

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

965

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

966

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

967

$passwords{$key} = $value;

968

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

969

}

970

971

## remove comments

972

s/#.*//;

973

974

## handle continuation lines

975

$_ = "$continuation$_";

976

if (/\\$/) {

977

chop;

978

$continuation = $_;

979

next;

980

}

981

$continuation = '';

982

983

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

984

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

985

s/\s+/ /g; # canonify

986

next if /^$/;

987

988

## expected configuration line is:

989

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

990

my %locals;

991

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

992

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

993

my @args = split;

994

995

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

996

foreach my $k (keys %locals) {

997

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

998

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

999

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

1000

delete $locals{$k};

1001

} else {

1002

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

1003

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

1004

if (!defined($value)) {

1005

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

1006

delete $locals{$k};

1007

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

1008

}

1009

}

1010

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

1011

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

1012

}

1013

## accumulate globals

1014

if ($#args < 0) {

1015

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

1016

}

1017

1018

## process this host definition

1019

if (@args) {

1020

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

1021

1022

## add in any globals..

1023

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

1024

1025

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

1026

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

1027

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

1028

1029

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

1030

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

1031

## save a copy of the current globals

1032

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

1033

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

1034

}

1035

}

1036

%passwords = ();

1037

}

1038

close(FD);

1039

1040

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

1041

if $continuation;

1042

1043

%$globals = %globals;

1044

%$config = %config;

1045

1046

return $content;

1047

}

1048

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

1049

## init_config -

1050

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

1051

sub init_config {

1052

%opt = %saved_opt;

1053

1054

##

1055

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

1056

1057

## infer the IP strategy if possible

1058

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

1059

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

1060

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

1061

1062

## sanity check

1063

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

1064

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

1065

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

1066

1067

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

1068

1069

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

1070

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

1071

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

1072

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

1073

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

1074

}

1075

1076

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

1077

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

1078

## collect cmdline configuration options.

1079

my %options = ();

1080

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

1081

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

1082

$options{$name} = $var;

1083

}

1084

## determine hosts specified with -host

1085

my @hosts = ();

1086

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

1087

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

1088

push @hosts, $h;

1089

}

1090

}

1091

## and those in -options=...

1092

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

1093

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

1094

push @hosts, $h;

1095

}

1096

delete $options{'host'};

1097

}

1098

## merge options into host definitions or globals

1099

if (@hosts) {

1100

foreach my $h (@hosts) {

1101

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

1102

}

1103

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

1104

} else {

1105

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

1106

}

1107

}

1108

1109

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

1110

foreach my $o (keys %opt) {

1111

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

1112

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

1113

}

1114

}

1115

1116

## sanity check

1117

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

1118

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

1119

}

1120

1121

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

1122

my @hosts = keys %config;

1123

if (opt('host')) {

1124

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

1125

}

1126

if (opt('retry')) {

1127

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

1128

}

1129

1130

## remove any other hosts

1131

my %hosts;

1132

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

1133

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

1134

1135

## collect the cacheable variables.

1136

foreach my $proto (keys %services) {

1137

my @cacheable = ();

1138

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

1139

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

1140

}

1141

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

1142

}

1143

1144

## sanity check..

1145

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

1146

## first the globals...

1147

foreach my $k (keys %globals) {

1148

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

1149

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

1150

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

1151

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

1152

$value = default($k);

1153

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

1154

}

1155

$globals{$k} = $value;

1156

}

1157

1158

## now the host definitions...

1159

HOST:

1160

foreach my $h (keys %config) {

1161

my $proto;

1162

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

1163

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

1164

1165

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

1166

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

1167

delete $config{$h};

1168

1169

} else {

1170

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

1171

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

1172

1173

foreach my $k (keys %$svars) {

1174

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

1175

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

1176

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

1177

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

1178

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

1179

delete $config{$h};

1180

next HOST;

1181

}

1182

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

1183

1184

}

1185

$config{$h} = $conf;

1186

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

1187

}

1188

}

1189

}

1190

1191

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

1192

## usage

1193

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

1194

sub usage {

1195

my $exitcode = 1;

1196

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

1197

my $msg = '';

1198

if (@_) {

1199

my $format = shift;

1200

$msg .= sprintf $format, @_;

1201

1 while chomp($msg);

1202

$msg .= "\n";

1203

}

1204

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

1205

sendmail();

1206

exit $exitcode;

1207

}

1208

1209

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

1210

## process_args -

1211

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

1212

sub process_args {

1213

my @spec = ();

1214

my $usage = "";

1215

my %opts = ();

1216

1217

foreach (@_) {

1218

if (ref $_) {

1219

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

1220

my $value = default($key);

1221

1222

## add a option specifier

1223

push @spec, $key . $specifier;

1224

1225

## define the default value which can be overwritten later

1226

$opt{$key} = undef;

1227

1228

next unless $arg_usage;

1229

1230

## add a line to the usage;

1231

$usage .= " $arg_usage";

1232

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

1233

$usage .= " (default: ";

1234

if ($specifier eq '!') {

1235

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

1236

$usage .= $key;

1237

} else {

1238

$usage .= $value;

1239

}

1240

$usage .= ")";

1241

}

1242

$usage .= ".";

1243

} else {

1244

$usage .= $_;

1245

}

1246

$usage .= "\n";

1247

}

1248

## process the arguments

1249

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

1250

$opt{"help"} = 1;

1251

}

1252

return ($usage, %opt);

1253

}

1254

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

1255

## test_possible_ip - print possible IPs

1256

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

1257

sub test_possible_ip {

1258

local $opt{'debug'} = 0;

1259

1260

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

1261

if defined opt('ip');

1262

1263

{

1264

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

1265

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

1266

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

1267

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

1268

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

1269

}

1270

}

1271

if (opt('fw')) {

1272

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

1273

foreach my $fw (sort keys %builtinfw) {

1274

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

1275

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

1276

}

1277

}

1278

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

1279

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

1280

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

1281

1282

}

1283

{

1284

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

1285

foreach my $web (sort keys %builtinweb) {

1286

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

1287

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

1288

}

1289

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

1290

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

1291

}

1292

if (opt('cmd')) {

1293

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

1294

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

1295

}

1296

exit 0 unless opt('debug');

1297

}

1298

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

1299

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

1300

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

1301

sub test_geturl {

1302

my $url = shift;

1303

1304

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

1305

print "URL $url\n";;

1306

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

1307

exit;

1308

}

1309

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

1310

## load_file

1311

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

1312

sub load_file {

1313

my $file = shift;

1314

my $buffer = '';

1315

1316

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

1317

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

1318

$file = $try if -f $try;

1319

}

1320

1321

local *FD;

1322

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

1323

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

1324

close(FD);

1325

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

1326

} else {

1327

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

1328

}

1329

return $buffer

1330

}

1331

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

1332

## save_file

1333

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

1334

sub save_file {

1335

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

1336

1337

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

1338

if (defined $opt) {

1339

my $i = 0;

1340

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

1341

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

1342

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

1343

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

1344

last if $a eq $b;

1345

}

1346

$i++;

1347

}

1348

$file = "$file-$i";

1349

}

1350

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

1351

local *FD;

1352

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

1353

print FD $buffer;

1354

close(FD);

1355

return $buffer;

1356

}

1357

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

1358

## print_opt

1359

## print_globals

1360

## print_config

1361

## print_cache

1362

## print_info

1363

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

1364

sub _print_hash {

1365

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

1366

my $value = $ptr;

1367

1368

if (! defined($ptr)) {

1369

$value = "<undefined>";

1370

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

1371

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

1372

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

1373

}

1374

return;

1375

}

1376

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

1377

}

1378

sub print_hash {

1379

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

1380

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

1381

_print_hash($string, $hash);

1382

}

1383

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

1384

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

1385

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

1386

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

1387

sub print_info {

1388

print_opt();

1389

print_globals();

1390

print_config();

1391

print_cache();

1392

}

1393

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

1394

## pipecmd - run an external command

1395

## logger

1396

## sendmail

1397

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

1398

sub pipecmd {

1399

my $cmd = shift;

1400

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

1401

my $ok = 0;

1402

1403

## remove trailing newlines

1404

1 while chomp($stdin);

1405

1406

## override when debugging.

1407

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

1408

1409

## execute the command.

1410

local *FD;

1411

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

1412

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

1413

1414

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

1415

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

1416

close(FD);

1417

1418

} elsif (! close(FD)) {

1419

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

1420

1421

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

1422

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

1423

1424

} else {

1425

$ok = 1;

1426

}

1427

return $ok;

1428

}

1429

sub logger {

1430

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

1431

my $facility = opt('facility');

1432

my $priority = opt('priority');

1433

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

1434

}

1435

return 1;

1436

}

1437

sub sendmail {

1438

my $recipients = opt('mail');

1439

1440

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

1441

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

1442

}

1443

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

1444

pipecmd("sendmail -oi $recipients",

1445

"To: $recipients",

1446

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

1447

"\r\n",

1448

$msgs,

1449

"",

1450

"regards,",

1451

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

1452

);

1453

}

1454

$last_msgs = $msgs;

1455

$msgs = '';

1456

}

1457

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

1458

## split_by_comma

1459

## merge

1460

## default

1461

## minimum

1462

## opt

1463

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

1464

sub split_by_comma {

1465

my $string = shift;

1466

1467

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

1468

return ();

1469

}

1470

sub merge {

1471

my %merged = ();

1472

foreach my $h (@_) {

1473

foreach my $k (keys %$h) {

1474

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

1475

}

1476

}

1477

return \%merged;

1478

}

1479

sub default {

1480

my $v = shift;

1481

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

1482

}

1483

sub minimum {

1484

my $v = shift;

1485

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

1486

}

1487

sub opt {

1488

my $v = shift;

1489

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

1490

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

1491

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

1492

return undef;

1493

}

1494

sub min {

1495

my $min = shift;

1496

foreach my $arg (@_) {

1497

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

1498

}

1499

return $min;

1500

}

1501

sub max {

1502

my $max = shift;

1503

foreach my $arg (@_) {

1504

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

1505

}

1506

return $max;

1507

}

1508

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

1509

## define

1510

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

1511

sub define {

1512

foreach (@_) {

1513

return $_ if defined $_;

1514

}

1515

return undef;

1516

}

1517

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

1518

## ynu

1519

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

1520

sub ynu {

1521

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

1522

1523

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

1524

return $yes if $value eq '1';

1525

foreach (qw(yes true)) {

1526

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

1527

}

1528

foreach (qw(no false)) {

1529

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

1530

}

1531

return $undef;

1532

}

1533

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

1534

## msg

1535

## debug

1536

## warning

1537

## fatal

1538

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

1539

sub _msg {

1540

my $log = shift;

1541

my $prefix = shift;

1542

my $format = shift;

1543

my $buffer = sprintf $format, @_;

1544

chomp($buffer);

1545

1546

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

1547

if ($file) {

1548

$prefix .= "file $file";

1549

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

1550

$prefix .= ": ";

1551

}

1552

if ($prefix) {

1553

$buffer = "$prefix$buffer";

1554

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

1555

}

1556

$buffer .= "\n";

1557

print $buffer;

1558

1559

$msgs .= $buffer if $log;

1560

logger($buffer) if $log;

1561

1562

}

1563

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

1564

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

1565

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

1566

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

1567

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

1568

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

1569

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

1570

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

1571

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

1572

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

1573

1574

sub prettyinterval {

1575

my $interval = shift;

1576

use integer;

1577

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

1578

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

1579

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

1580

my $d = $interval;

1581

1582

my $string = "";

1583

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

1584

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

1585

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

1586

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

1587

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

1588

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

1589

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

1590

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

1591

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

1592

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

1593

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

1594

return $string;

1595

}

1596

sub interval {

1597

my $value = shift;

1598

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

1599

$value = $1;

1600

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

1601

$value = $1 * 60;

1602

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

1603

$value = $1 * 60*60;

1604

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

1605

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

1606

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

1607

$value = undef;

1608

}

1609

return $value;

1610

}

1611

sub interval_expired {

1612

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

1613

1614

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

1615

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

1616

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

1617

1618

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

1619

}

1620

1621

1622

1623

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

1624

## check_value

1625

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

1626

sub check_value {

1627

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

1628

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

1629

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

1630

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

1631

1632

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

1633

;

1634

1635

} elsif ($type eq T_DELAY) {

1636

$value = interval($value);

1637

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

1638

1639

} elsif ($type eq T_NUMBER) {

1640

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

1641

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

1642

1643

} elsif ($type eq T_BOOL) {

1644

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

1645

$value = 1;

1646

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

1647

$value = 0;

1648

} else {

1649

return undef;

1650

}

1651

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

1652

$value = lc $value;

1653

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

1654

1655

} elsif ($type eq T_FQDNP) {

1656

$value = lc $value;

1657

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

1658

1659

} elsif ($type eq T_PROTO) {

1660

$value = lc $value;

1661

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

1662

1663

} elsif ($type eq T_USE) {

1664

$value = lc $value;

1665

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

1666

1667

} elsif ($type eq T_FILE) {

1668

return undef if $value eq "";

1669

1670

} elsif ($type eq T_IF) {

1671

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

1672

1673

} elsif ($type eq T_PROG) {

1674

return undef if $value eq "";

1675

1676

} elsif ($type eq T_LOGIN) {

1677

return undef if $value eq "";

1678

1679

# } elsif ($type eq T_PASSWD) {

1680

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

1681

1682

} elsif ($type eq T_IP) {

1683

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

1684

}

1685

return $value;

1686

}

1687

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

1688

## encode_base64 - from MIME::Base64

1689

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

1690

sub encode_base64 ($;$) {

1691

my $res = '';

1692

my $eol = $_[1];

1693

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

1694

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

1695

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

1696

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

1697

chop($res);

1698

}

1699

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

1700

1701

# fix padding at the end

1702

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

1703

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

1704

1705

# break encoded string into lines of no more than 76 characters each

1706

if (length $eol) {

1707

$res =~ s/(.{1,76})/$1$eol/g;

1708

}

1709

$res;

1710

}

1711

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

1712

## load_ssl_support

1713

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

1714

sub load_ssl_support {

1715

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

1716

unless ($ssl_loaded) {

1717

fatal(<<"EOM");

1718

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

1719

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

1720

EOM

1721

}

1722

import IO::Socket::SSL;

1723

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

1724

}

1725

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

1726

## geturl

1727

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

1728

sub geturl {

1729

my $proxy = shift || '';

1730

my $url = shift || '';

1731

my $login = shift || '';

1732

my $password = shift || '';

1733

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

1734

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

1735

1736

debug("proxy = $proxy");

1737

debug("url = $url");

1738

## canonify proxy and url

1739

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

1740

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

1741

$server = $url;

1742

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

1743

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

1744

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

1745

1746

debug("server = $server");

1747

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

1748

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

1749

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

1750

## always omit SSL for connections to local router

1751

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

1752

$use_ssl = 1;

1753

$default_port = 443;

1754

load_ssl_support;

1755

} else {

1756

$use_ssl = 0;

1757

$default_port = 80;

1758

}

1759

1760

## determine peer and port to use.

1761

$peer = $proxy || $server;

1762

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

1763

$port = $peer;

1764

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

1765

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

1766

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

1767

1768

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

1769

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

1770

1771

$request = "GET ";

1772

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

1773

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

1774

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

1775

1776

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

1777

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

1778

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

1779

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

1780

$request .= "\n";

1781

1782

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

1783

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

1784

1785

# local $^W = 0;

1786

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

1787

if (! opt('exec')) {

1788

debug("skipped network connection");

1789

verbose("SENDING:", $request);

1790

} elsif ($use_ssl) {

1791

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

1792

PeerAddr => $peer,

1793

PeerPort => $port,

1794

Proto => 'tcp',

1795

MultiHomed => 1,

1796

Timeout => opt('timeout'),

1797

);

1798

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

1799

} else {

1800

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

1801

PeerAddr => $peer,

1802

PeerPort => $port,

1803

Proto => 'tcp',

1804

MultiHomed => 1,

1805

Timeout => opt('timeout'),

1806

);

1807

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

1808

}

1809

1810

if (defined $sd) {

1811

## send the request to the http server

1812

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

1813

verbose("SENDING:", $request);

1814

1815

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

1816

my $result = syswrite $sd, $rq;

1817

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

1818

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

1819

1820

} else {

1821

my $timeout = 0;

1822

local $SIG{'ALRM'} = sub { $timeout = 1; };

1823

1824

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

1825

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

1826

while (!$timeout && ($_ = <$sd>)) {

1827

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

1828

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

1829

$reply .= $_ if defined $_;

1830

}

1831

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

1832

alarm(0);

1833

}

1834

close($sd);

1835

if ($timeout) {

1836

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

1837

$reply = '';

1838

}

1839

$reply = '' if !defined $reply;

1840

}

1841

}

1842

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

1843

1844

## during testing simulate reading the URL

1845

if (opt('test')) {

1846

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

1847

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

1848

if (opt('exec')) {

1849

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

1850

} else {

1851

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

1852

}

1853

}

1854

1855

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

1856

return $reply;

1857

}

1858

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

1859

## get_ip

1860

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

1861

sub get_ip {

1862

my $use = lc shift;

1863

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

1864

$arg = '' unless $arg;

1865

1866

if ($use eq 'ip') {

1867

$ip = opt('ip');

1868

$arg = 'ip';

1869

1870

} elsif ($use eq 'if') {

1871

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

1872

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

1873

$reply = '' if $?;

1874

1875

} elsif ($use eq 'cmd') {

1876

if ($arg) {

1877

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

1878

$reply = `$arg`;

1879

$reply = '' if $?;

1880

}

1881

1882

} elsif ($use eq 'web') {

1883

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

1884

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

1885

1886

if (exists $builtinweb{$url}) {

1887

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

1888

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

1889

}

1890

$arg = $url;

1891

1892

if ($url) {

1893

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

1894

}

1895

1896

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

1897

# Stuff added to support Cisco router ip http daemon

1898

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

1899

# password theft. This is pretty harmless.

1900

my $queryif = opt('if');

1901

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

1902

1903

# Convert slashes to protected value "\/"

1904

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

1905

1906

# Protect special HTML characters (like '?')

1907

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

1908

1909

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

1910

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

1911

$arg = $url;

1912

1913

} else {

1914

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

1915

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

1916

1917

if (exists $builtinfw{$use}) {

1918

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

1919

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

1920

}

1921

$arg = $url;

1922

1923

if ($url) {

1924

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

1925

}

1926

}

1927

if (!defined $reply) {

1928

$reply = '';

1929

}

1930

if ($skip) {

1931

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

1932

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

1933

}

1934

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

1935

$ip = $1;

1936

}

1937

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

1938

$ip = undef;

1939

}

1940

1941

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

1942

return $ip;

1943

}

1944

1945

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

1946

## group_hosts_by

1947

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

1948

sub group_hosts_by {

1949

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

1950

1951

my %groups = ();

1952

foreach my $h (@$hosts) {

1953

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

1954

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

1955

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

1956

1957

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

1958

}

1959

return %groups;

1960

}

1961

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

1962

## nic_examples

1963

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

1964

sub nic_examples {

1965

my $examples = "";

1966

my $separator = "";

1967

foreach my $s (sort keys %services) {

1968

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

1969

my $example;

1970

1971

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

1972

chomp($example);

1973

$examples .= $example;

1974

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

1975

$separator = "\n";

1976

}

1977

}

1978

my $intro = <<EoEXAMPLE;

1979

== CONFIGURING ${program}

1980

1981

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

1982

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

1983

sequences of global variable definitions and host definitions.

1984

1985

Global definitions look like:

1986

name=value [,name=value]*

1987

1988

For example:

1989

daemon=5m

1990

use=if, if=eth0

1991

proxy=proxy.myisp.com

1992

protocol=dyndns2

1993

1994

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

1995

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

1996

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

1997

as seconds (600s), minutes (5m), hours (1h) or days (1d).

1998

1999

Host definitions look like:

2000

[name=value [,name=value]*]* a.host.domain [,b.host.domain] [login] [password]

2001

2002

For example:

2003

protocol=hammernode1, \\

2004

login=my-hn-login, password=my-hn-password myhost.hn.org

2005

login=my-login, password=my-password myhost.dyndns.org,my2nd.dyndns.org

2006

2007

specifies two host definitions.

2008

2009

The first definition will use the hammernode1 protocol,

2010

my-hn-login and my-hn-password to update the ip-address of

2011

myhost.hn.org and my2ndhost.hn.org.

2012

2013

The second host definition will use the current default protocol

2014

('dyndns2'), my-login and my-password to update the ip-address of

2015

myhost.dyndns.org and my2ndhost.dyndns.org.

2016

2017

The order of this sequence is significant because the values of any

2018

global variable definitions are bound to a host definition when the

2019

host definition is encountered.

2020

2021

See the sample-${program}.conf file for further examples.

2022

EoEXAMPLE

2023

$intro .= "\n== NIC specific variables and examples:\n$examples" if $examples;

2024

return $intro;

2025

}

2026

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

2027

## nic_updateable

2028

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

2029

sub nic_updateable {

2030

my $host = shift;

2031

my $sub = shift;

2032

my $update = 0;

2033

my $ip = $config{$host}{'wantip'};

2034

2035

if ($config{$host}{'login'} eq '') {

2036

warning("null login name specified for host %s.", $host);

2037

2038

} elsif ($config{$host}{'password'} eq '') {

2039

warning("null password specified for host %s.", $host);

2040

2041

} elsif ($opt{'force'}) {

2042

info("forcing update of %s.", $host);

2043

$update = 1;

2044

2045

} elsif (!exists($cache{$host})) {

2046

info("forcing updating %s because no cached entry exists.", $host);

2047

$update = 1;

2048

2049

} elsif ($cache{$host}{'wtime'} && $cache{$host}{'wtime'} > $now) {

2050

warning("cannot update %s from %s to %s until after %s.",

2051

$host,

2052

($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'), $ip,

2053

prettytime($cache{$host}{'wtime'})

2054

);

2055

2056

} elsif ($cache{$host}{'mtime'} && interval_expired($host, 'mtime', 'max-interval')) {

2057

warning("forcing update of %s from %s to %s; %s since last update on %s.",

2058

$host,

2059

($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'), $ip,

2060

prettyinterval($config{$host}{'max-interval'}),

2061

prettytime($cache{$host}{'mtime'})

2062

);

2063

$update = 1;

2064

2065

} elsif ((!exists($cache{$host}{'ip'})) ||

2066

("$cache{$host}{'ip'}" ne "$ip")) {

2067

if (($cache{$host}{'status'} eq 'good') &&

2068

!interval_expired($host, 'mtime', 'min-interval')) {

2069

2070

warning("skipping update of %s from %s to %s.\nlast updated %s.\nWait at least %s between update attempts.",

2071

$host,

2072

($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'),

2073

$ip,

2074

($cache{$host}{'mtime'} ? prettytime($cache{$host}{'mtime'}) : '<never>'),

2075

prettyinterval($config{$host}{'min-interval'})

2076

)

2077

if opt('verbose') || !define($cache{$host}{'warned-min-interval'}, 0);

2078

2079

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

2080

2081

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

2082

2083

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.",

2084

$host,

2085

($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'),

2086

$ip,

2087

($cache{$host}{'mtime'} ? prettytime($cache{$host}{'mtime'}) : '<never>'),

2088

($cache{$host}{'atime'} ? prettytime($cache{$host}{'atime'}) : '<never>'),

2089

prettyinterval($config{$host}{'min-error-interval'})

2090

)

2091

if opt('verbose') || !define($cache{$host}{'warned-min-error-interval'}, 0);

2092

2093

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

2094

2095

} else {

2096

$update = 1;

2097

}

2098

2099

} elsif (defined($sub) && &$sub($host)) {

2100

$update = 1;

2101

2102

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

2103

($cache{$host}{'wildcard'} ne $config{$host}{'wildcard'}) ||

2104

($cache{$host}{'mx'} ne $config{$host}{'mx'}) ||

2105

($cache{$host}{'backupmx'} ne $config{$host}{'backupmx'})) {

2106

info("updating %s because host settings have been changed.", $host);

2107

$update = 1;

2108

2109

} else {

2110

success("%s: skipped: IP address was already set to %s.", $host, $ip)

2111

if opt('verbose');

2112

}

2113

$config{$host}{'status'} = define($cache{$host}{'status'},'');

2114

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

2115

if ($update) {

2116

$config{$host}{'status'} = 'noconnect';

2117

$config{$host}{'atime'} = $now;

2118

$config{$host}{'wtime'} = 0;

2119

$config{$host}{'warned-min-interval'} = 0;

2120

$config{$host}{'warned-min-error-interval'} = 0;

2121

2122

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

2123

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

2124

}

2125

2126

return $update;

2127

}

2128

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

2129

## header_ok

2130

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

2131

sub header_ok {

2132

my ($host, $line) = @_;

2133

my $ok = 0;

2134

2135

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

2136

my $result = $1;

2137

2138

if ($result eq '200') {

2139

$ok = 1;

2140

2141

} elsif ($result eq '401') {

2142

failed("updating %s: authorization failed (%s)", $host, $line);

2143

}

2144

2145

} else {

2146

failed("updating %s: unexpected line (%s)", $host, $line);

2147

}

2148

return $ok;

2149

}

2150

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

2151

## nic_dyndns1_examples

2152

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

2153

sub nic_dyndns1_examples {

2154

return <<EoEXAMPLE;

2155

o 'dyndns1'

2156

2157

The 'dyndns1' protocol is a deprecated protocol used by the free dynamic

2158

DNS service offered by www.dyndns.org. The 'dyndns2' should be used to

2159

update the www.dyndns.org service. However, other services are also

2160

using this protocol so support is still provided by ${program}.

2161

2162

Configuration variables applicable to the 'dyndns1' protocol are:

2163

protocol=dyndns1 ##

2164

server=fqdn.of.service ## defaults to members.dyndns.org

2165

backupmx=no|yes ## indicates that this host is the primary MX for the domain.

2166

mx=any.host.domain ## a host MX'ing for this host definition.

2167

wildcard=no|yes ## add a DNS wildcard CNAME record that points to {host}

2168

login=service-login ## login name and password registered with the service

2169

password=service-password ##

2170

fully.qualified.host ## the host registered with the service.

2171

2172

Example ${program}.conf file entries:

2173

## single host update

2174

protocol=dyndns1, \\

2175

login=my-dyndns.org-login, \\

2176

password=my-dyndns.org-password \\

2177

myhost.dyndns.org

2178

2179

## multiple host update with wildcard'ing mx, and backupmx

2180

protocol=dyndns1, \\

2181

login=my-dyndns.org-login, \\

2182

password=my-dyndns.org-password, \\

2183

mx=a.host.willing.to.mx.for.me,backupmx=yes,wildcard=yes \\

2184

myhost.dyndns.org,my2ndhost.dyndns.org

2185

EoEXAMPLE

2186

}

2187

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

2188

## nic_dyndns1_update

2189

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

2190

sub nic_dyndns1_update {

2191

debug("\nnic_dyndns1_update -------------------");

2192

## update each configured host

2193

foreach my $h (@_) {

2194

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

2195

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

2196

verbose("UPDATE:","updating %s", $h);

2197

2198

my $url;

2199

$url = "http://$config{$h}{'server'}/nic/";

2200

$url .= ynu($config{$h}{'static'}, 'statdns', 'dyndns', 'dyndns');

2201

$url .= "?action=edit&started=1&hostname=YES&host_id=$h";

2202

$url .= "&myip=";

2203

$url .= $ip if $ip;

2204

$url .= "&wildcard=ON" if ynu($config{$h}{'wildcard'}, 1, 0, 0);

2205

if ($config{$h}{'mx'}) {

2206

$url .= "&mx=$config{$h}{'mx'}";

2207

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

2208

}

2209

2210

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

2211

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

2212

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

2213

next;

2214

}

2215

last if !header_ok($h, $reply);

2216

2217

my @reply = split /\n/, $reply;

2218

my ($title, $return_code, $error_code) = ('','','');

2219

foreach my $line (@reply) {

2220

$title = $1 if $line =~ m%<TITLE>\s*(.*)\s*</TITLE>%i;

2221

$return_code = $1 if $line =~ m%^return\s+code\s*:\s*(.*)\s*$%i;

2222

$error_code = $1 if $line =~ m%^error\s+code\s*:\s*(.*)\s*$%i;

2223

}

2224

2225

if ($return_code ne 'NOERROR' || $error_code ne 'NOERROR' || !$title) {

2226

$config{$h}{'status'} = 'failed';

2227

$title = "incomplete response from $config{$h}{server}" unless $title;

2228

warning("SENT: %s", $url) unless opt('verbose');

2229

warning("REPLIED: %s", $reply);

2230

failed("updating %s: %s", $h, $title);

2231

2232

} else {

2233

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

2234

$config{$h}{'mtime'} = $now;

2235

$config{$h}{'status'} = 'good';

2236

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

2237

}

2238

}

2239

}

2240

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

2241

## nic_dyndns2_updateable

2242

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

2243

sub nic_dyndns2_updateable {

2244

my $host = shift;

2245

my $update = 0;

2246

2247

if ($config{$host}{'mx'} ne $cache{$host}{'mx'}) {

2248

info("forcing updating %s because 'mx' has changed to %s.", $host, $config{$host}{'mx'});

2249

$update = 1;

2250

2251

} elsif ($config{$host}{'mx'} && (ynu($config{$host}{'backupmx'},1,2,3) ne ynu($config{$host}{'backupmx'},1,2,3))) {

2252

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

2253

$update = 1;

2254

2255

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

2256

2257

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

2258

$update = 1;

2259

2260

}

2261

return $update;

2262

}

2263

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

2264

## nic_dyndns2_examples

2265

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

2266

sub nic_dyndns2_examples {

2267

return <<EoEXAMPLE;

2268

o 'dyndns2'

2269

2270

The 'dyndns2' protocol is a newer low-bandwidth protocol used by a

2271

free dynamic DNS service offered by www.dyndns.org. It supports

2272

features of the older 'dyndns1' in addition to others. [These will be

2273

supported in a future version of ${program}.]

2274

2275

Configuration variables applicable to the 'dyndns2' protocol are:

2276

protocol=dyndns2 ##

2277

server=fqdn.of.service ## defaults to members.dyndns.org

2278

backupmx=no|yes ## indicates that this host is the primary MX for the domain.

2279

static=no|yes ## indicates that this host has a static IP address.

2280

custom=no|yes ## indicates that this host is a 'custom' top-level domain name.

2281

mx=any.host.domain ## a host MX'ing for this host definition.

2282

wildcard=no|yes ## add a DNS wildcard CNAME record that points to {host}

2283

login=service-login ## login name and password registered with the service

2284

password=service-password ##

2285

fully.qualified.host ## the host registered with the service.

2286

2287

Example ${program}.conf file entries:

2288

## single host update

2289

protocol=dyndns2, \\

2290

login=my-dyndns.org-login, \\

2291

password=my-dyndns.org-password \\

2292

myhost.dyndns.org

2293

2294

## multiple host update with wildcard'ing mx, and backupmx

2295

protocol=dyndns2, \\

2296

login=my-dyndns.org-login, \\

2297

password=my-dyndns.org-password, \\

2298

mx=a.host.willing.to.mx.for.me,backupmx=yes,wildcard=yes \\

2299

myhost.dyndns.org,my2ndhost.dyndns.org

2300

2301

## multiple host update to the custom DNS service

2302

protocol=dyndns2, \\

2303

login=my-dyndns.org-login, \\

2304

password=my-dyndns.org-password \\

2305

my-toplevel-domain.com,my-other-domain.com

2306

EoEXAMPLE

2307

}

2308

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

2309

## nic_dyndns2_update

2310

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

2311

sub nic_dyndns2_update {

2312

debug("\nnic_dyndns2_update -------------------");

2313

2314

## group hosts with identical attributes together

2315

my %groups = group_hosts_by([ @_ ], [ qw(login password server static custom wildcard mx backupmx) ]);

2316

2317

my %errors = (

2318

'badauth' => 'Bad authorization (username or password)',

2319

'badsys' => 'The system parameter given was not valid',

2320

2321

'notfqdn' => 'A Fully-Qualified Domain Name was not provided',

2322

'nohost' => 'The hostname specified does not exist in the database',

2323

'!yours' => 'The hostname specified exists, but not under the username currently being used',

2324

'!donator' => 'The offline setting was set, when the user is not a donator',

2325

'!active' => 'The hostname specified is in a Custom DNS domain which has not yet been activated.',

2326

'abuse', => 'The hostname specified is blocked for abuse; you should receive an email notification ' .

2327

'which provides an unblock request link. More info can be found on ' .

2328

'https://www.dyndns.com/support/abuse.html',

2329

2330

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

2331

'dnserr' => 'System error: DNS error encountered. Contact support@dyndns.org',

2332

2333

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

2334

);

2335

2336

## update each set of hosts that had similar configurations

2337

foreach my $sig (keys %groups) {

2338

my @hosts = @{$groups{$sig}};

2339

my $hosts = join(',', @hosts);

2340

my $h = $hosts[0];

2341

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

2342

delete $config{$_}{'wantip'} foreach @hosts;

2343

2344

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

2345

verbose("UPDATE:","updating %s", $hosts);

2346

2347

## Select the DynDNS system to update

2348

my $url = "http://$config{$h}{'server'}/nic/update?system=";

2349

if ($config{$h}{'custom'}) {

2350

warning("updating %s: 'custom' and 'static' may not be used together. ('static' ignored)", $hosts)

2351

if $config{$h}{'static'};

2352

# warning("updating %s: 'custom' and 'offline' may not be used together. ('offline' ignored)", $hosts)

2353

# if $config{$h}{'offline'};

2354

$url .= 'custom';

2355

2356

} elsif ($config{$h}{'static'}) {

2357

# warning("updating %s: 'static' and 'offline' may not be used together. ('offline' ignored)", $hosts)

2358

# if $config{$h}{'offline'};

2359

$url .= 'statdns';

2360

2361

} else {

2362

$url .= 'dyndns';

2363

}

2364

2365

$url .= "&hostname=$hosts";

2366

$url .= "&myip=";

2367

$url .= $ip if $ip;

2368

2369

## some args are not valid for a custom domain.

2370

$url .= "&wildcard=ON" if ynu($config{$h}{'wildcard'}, 1, 0, 0);

2371

if ($config{$h}{'mx'}) {

2372

$url .= "&mx=$config{$h}{'mx'}";

2373

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

2374

}

2375

2376

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

2377

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

2378

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});

2379

last;

2380

}

2381

last if !header_ok($hosts, $reply);

2382

2383

my @reply = split /\n/, $reply;

2384

my $state = 'header';

2385

foreach my $line (@reply) {

2386

if ($state eq 'header') {

2387

$state = 'body';

2388

2389

} elsif ($state eq 'body') {

2390

$state = 'results' if $line eq '';

2391

2392

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

2393

$state = 'results2';

2394

2395

my ($status, $ip) = split / /, lc $line;

2396

my $h = shift @hosts;

2397

2398

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

2399

if ($status eq 'good') {

2400

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

2401

$config{$h}{'mtime'} = $now;

2402

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

2403

2404

} elsif (exists $errors{$status}) {

2405

if ($status eq 'nochg') {

2406

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

2407

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

2408

$config{$h}{'mtime'} = $now;

2409

$config{$h}{'status'} = 'good';

2410

2411

} else {

2412

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

2413

}

2414

2415

} elsif ($status =~ /w(\d+)(.)/) {

2416

my ($wait, $units) = ($1, lc $2);

2417

my ($sec, $scale) = ($wait, 1);

2418

2419

($scale, $units) = (1, 'seconds') if $units eq 's';

2420

($scale, $units) = (60, 'minutes') if $units eq 'm';

2421

($scale, $units) = (60*60, 'hours') if $units eq 'h';

2422

2423

$sec = $wait * $scale;

2424

$config{$h}{'wtime'} = $now + $sec;

2425

warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip);

2426

2427

} else {

2428

failed("updating %s: %s: unexpected status (%s)", $h, $line);

2429

}

2430

}

2431

}

2432

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'})

2433

if $state ne 'results2';

2434

}

2435

}

2436

2437

2438

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

2439

## nic_noip_update

2440

## Note: uses same features as nic_dyndns2_update, less return codes

2441

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

2442

sub nic_noip_update {

2443

debug("\nnic_noip_update -------------------");

2444

2445

## group hosts with identical attributes together

2446

my %groups = group_hosts_by([ @_ ], [ qw(login password server static custom wildcard mx backupmx) ]);

2447

2448

my %errors = (

2449

'badauth' => 'Invalid username or password',

2450

'badagent' => 'Invalid user agent',

2451

'nohost' => 'The hostname specified does not exist in the database',

2452

'!donator' => 'The offline setting was set, when the user is not a donator',

2453

'abuse', => 'The hostname specified is blocked for abuse; open a trouble ticket at http://www.no-ip.com',

2454

'numhost' => 'System error: Too many or too few hosts found. open a trouble ticket at http://www.no-ip.com',

2455

'dnserr' => 'System error: DNS error encountered. Contact support@dyndns.org',

2456

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

2457

);

2458

2459

## update each set of hosts that had similar configurations

2460

foreach my $sig (keys %groups) {

2461

my @hosts = @{$groups{$sig}};

2462

my $hosts = join(',', @hosts);

2463

my $h = $hosts[0];

2464

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

2465

delete $config{$_}{'wantip'} foreach @hosts;

2466

2467

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

2468

verbose("UPDATE:","updating %s", $hosts);

2469

2470

my $url = "http://$config{$h}{'server'}/nic/update?system=";

2471

$url .= 'noip';

2472

$url .= "&hostname=$hosts";

2473

$url .= "&myip=";

2474

$url .= $ip if $ip;

2475

2476

2477

print "here..." . $config{$h}{'login'} . " --> " . $config{$h}{'password'} . "\n";

2478

2479

2480

my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'});

2481

if (!defined($reply) || !$reply) {

2482

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});

2483

last;

2484

}

2485

last if !header_ok($hosts, $reply);

2486

2487

my @reply = split /\n/, $reply;

2488

my $state = 'header';

2489

foreach my $line (@reply) {

2490

if ($state eq 'header') {

2491

$state = 'body';

2492

2493

} elsif ($state eq 'body') {

2494

$state = 'results' if $line eq '';

2495

2496

} elsif ($state =~ /^results/) {

2497

$state = 'results2';

2498

2499

my ($status, $ip) = split / /, lc $line;

2500

my $h = shift @hosts;

2501

2502

$config{$h}{'status'} = $status;

2503

if ($status eq 'good') {

2504

$config{$h}{'ip'} = $ip;

2505

$config{$h}{'mtime'} = $now;

2506

success("updating %s: %s: IP address set to %s", $h, $status, $ip);

2507

2508

} elsif (exists $errors{$status}) {

2509

if ($status eq 'nochg') {

2510

warning("updating %s: %s: %s", $h, $status, $errors{$status});

2511

$config{$h}{'ip'} = $ip;

2512

$config{$h}{'mtime'} = $now;

2513

$config{$h}{'status'} = 'good';

2514

2515

} else {

2516

failed("updating %s: %s: %s", $h, $status, $errors{$status});

2517

}

2518

2519

} elsif ($status =~ /w(\d+)(.)/) {

2520

my ($wait, $units) = ($1, lc $2);

2521

my ($sec, $scale) = ($wait, 1);

2522

2523

($scale, $units) = (1, 'seconds') if $units eq 's';

2524

($scale, $units) = (60, 'minutes') if $units eq 'm';

2525

($scale, $units) = (60*60, 'hours') if $units eq 'h';

2526

2527

$sec = $wait * $scale;

2528

$config{$h}{'wtime'} = $now + $sec;

2529

warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip);

2530

2531

} else {

2532

failed("updating %s: %s: unexpected status (%s)", $h, $line);

2533

}

2534

}

2535

}

2536

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'})

2537

if $state ne 'results2';

2538

}

2539

}

2540

######################################################################

2541

## nic_noip_examples

2542

######################################################################

2543

sub nic_noip_examples {

2544

return <<EoEXAMPLE;

2545

o 'noip'

2546

2547

The 'No-IP Compatible' protocol is used to make dynamic dns updates

2548

over an http request. Details of the protocol are outlined at:

2549

http://www.no-ip.com/integrate/

2550

2551

Configuration variables applicable to the 'noip' protocol are:

2552

protocol=noip ##

2553

server=fqdn.of.service ## defaults to dynupdate.no-ip.com

2554

login=service-login ## login name and password registered with the service

2555

password=service-password ##

2556

fully.qualified.host ## the host registered with the service.

2557

2558

Example ${program}.conf file entries:

2559

## single host update

2560

protocol=noip, \\

2561

login=userlogin\@domain.com, \\

2562

password=noip-password \\

2563

myhost.no-ip.biz

2564

2565

2566

EoEXAMPLE

2567

}

2568

2569

######################################################################

2570

## nic_concont_examples

2571

######################################################################

2572

sub nic_concont_examples {

2573

return <<EoEXAMPLE;

2574

o 'concont'

2575

2576

The 'concont' protocol is the protocol used by the content management

2577

system ConCont's dydns module. This is currently used by the free

2578

dynamic DNS service offered by Tyrmida at www.dydns.za.net

2579

2580

Configuration variables applicable to the 'concont' protocol are:

2581

protocol=concont ##

2582

server=www.fqdn.of.service ## for example www.dydns.za.net (for most add a www)

2583

login=service-login ## login registered with the service

2584

password=service-password ## password registered with the service

2585

mx=mail.server.fqdn ## fqdn of the server handling domain\'s mail (leave out for none)

2586

wildcard=yes|no ## set yes for wild (*.host.domain) support

2587

fully.qualified.host ## the host registered with the service.

2588

2589

Example ${program}.conf file entries:

2590

## single host update

2591

protocol=concont, \\

2592

login=dydns.za.net, \\

2593

password=my-dydns.za.net-password, \\

2594

mx=mailserver.fqdn, \\

2595

wildcard=yes \\

2596

myhost.hn.org

2597

2598

EoEXAMPLE

2599

}

2600

######################################################################

2601

## nic_concont_update

2602

######################################################################

2603

sub nic_concont_update {

2604

debug("\nnic_concont_update -------------------");

2605

2606

## update each configured host

2607

foreach my $h (@_) {

2608

my $ip = delete $config{$h}{'wantip'};

2609

info("setting IP address to %s for %s", $ip, $h);

2610

verbose("UPDATE:","updating %s", $h);

2611

2612

# Set the URL that we're going to to update

2613

my $url;

2614

$url = "http://$config{$h}{'server'}/modules/dydns/update.php";

2615

$url .= "?username=";

2616

$url .= $config{$h}{'login'};

2617

$url .= "&password=";

2618

$url .= $config{$h}{'password'};

2619

$url .= "&wildcard=";

2620

$url .= $config{$h}{'wildcard'};

2621

$url .= "&mx=";

2622

$url .= $config{$h}{'mx'};

2623

$url .= "&host=";

2624

$url .= $h;

2625

$url .= "&ip=";

2626

$url .= $ip;

2627

2628

# Try to get URL

2629

my $reply = geturl(opt('proxy'), $url);

2630

2631

# No response, declare as failed

2632

if (!defined($reply) || !$reply) {

2633

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

2634

last;

2635

}

2636

last if !header_ok($h, $reply);

2637

2638

# Response found, just declare as success (this is ugly, we need more error checking)

2639

if ($reply =~ /SUCCESS/)

2640

{

2641

$config{$h}{'ip'} = $ip;

2642

$config{$h}{'mtime'} = $now;

2643

$config{$h}{'status'} = 'good';

2644

success("updating %s: good: IP address set to %s", $h, $ip);

2645

}

2646

else

2647

{

2648

my @reply = split /\n/, $reply;

2649

my $returned = pop(@reply);

2650

$config{$h}{'status'} = 'failed';

2651

failed("updating %s: Server said: '$returned'", $h);

2652

}

2653

}

2654

}

2655

######################################################################

2656

## nic_dslreports1_examples

2657

######################################################################

2658

sub nic_dslreports1_examples {

2659

return <<EoEXAMPLE;

2660

o 'dslreports1'

2661

2662

The 'dslreports1' protocol is used by a free DSL monitoring service

2663

offered by www.dslreports.com.

2664

2665

Configuration variables applicable to the 'dslreports1' protocol are:

2666

protocol=dslreports1 ##

2667

server=fqdn.of.service ## defaults to www.dslreports.com

2668

login=service-login ## login name and password registered with the service

2669

password=service-password ##

2670

unique-number ## the host registered with the service.

2671

2672

Example ${program}.conf file entries:

2673

## single host update

2674

protocol=dslreports1, \\

2675

server=www.dslreports.com, \\

2676

login=my-dslreports-login, \\

2677

password=my-dslreports-password \\

2678

123456

2679

2680

Note: DSL Reports uses a unique number as the host name. This number

2681

can be found on the Monitor Control web page.

2682

EoEXAMPLE

2683

}

2684

######################################################################

2685

## nic_dslreports1_update

2686

######################################################################

2687

sub nic_dslreports1_update {

2688

debug("\nnic_dslreports1_update -------------------");

2689

## update each configured host

2690

foreach my $h (@_) {

2691

my $ip = delete $config{$h}{'wantip'};

2692

info("setting IP address to %s for %s", $ip, $h);

2693

verbose("UPDATE:","updating %s", $h);

2694

2695

my $url;

2696

$url = "http://$config{$h}{'server'}/nic/";

2697

$url .= ynu($config{$h}{'static'}, 'statdns', 'dyndns', 'dyndns');

2698

$url .= "?action=edit&started=1&hostname=YES&host_id=$h";

2699

$url .= "&myip=";

2700

$url .= $ip if $ip;

2701

2702

my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'});

2703

if (!defined($reply) || !$reply) {

2704

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

2705

next;

2706

}

2707

2708

my @reply = split /\n/, $reply;

2709

my $return_code = '';

2710

foreach my $line (@reply) {

2711

$return_code = $1 if $line =~ m%^return\s+code\s*:\s*(.*)\s*$%i;

2712

}

2713

2714

if ($return_code !~ /NOERROR/) {

2715

$config{$h}{'status'} = 'failed';

2716

warning("SENT: %s", $url) unless opt('verbose');

2717

warning("REPLIED: %s", $reply);

2718

failed("updating %s", $h);

2719

2720

} else {

2721

$config{$h}{'ip'} = $ip;

2722

$config{$h}{'mtime'} = $now;

2723

$config{$h}{'status'} = 'good';

2724

success("updating %s: %s: IP address set to %s", $h, $return_code, $ip);

2725

}

2726

}

2727

}

2728

######################################################################

2729

## nic_hammernode1_examples

2730

######################################################################

2731

sub nic_hammernode1_examples {

2732

return <<EoEXAMPLE;

2733

o 'hammernode1'

2734

2735

The 'hammernode1' protocol is the protocol used by the free dynamic

2736

DNS service offered by Hammernode at www.hn.org

2737

2738

Configuration variables applicable to the 'hammernode1' protocol are:

2739

protocol=hammernode1 ##

2740

server=fqdn.of.service ## defaults to members.dyndns.org

2741

login=service-login ## login name and password registered with the service

2742

password=service-password ##

2743

fully.qualified.host ## the host registered with the service.

2744

2745

Example ${program}.conf file entries:

2746

## single host update

2747

protocol=hammernode1, \\

2748

login=my-hn.org-login, \\

2749

password=my-hn.org-password \\

2750

myhost.hn.org

2751

2752

## multiple host update

2753

protocol=hammernode1, \\

2754

login=my-hn.org-login, \\

2755

password=my-hn.org-password, \\

2756

myhost.hn.org,my2ndhost.hn.org

2757

EoEXAMPLE

2758

}

2759

######################################################################

2760

## nic_hammernode1_update

2761

######################################################################

2762

sub nic_hammernode1_update {

2763

debug("\nnic_hammernode1_update -------------------");

2764

2765

## update each configured host

2766

foreach my $h (@_) {

2767

my $ip = delete $config{$h}{'wantip'};

2768

info("setting IP address to %s for %s", $ip, $h);

2769

verbose("UPDATE:","updating %s", $h);

2770

2771

my $url;

2772

$url = "http://$config{$h}{'server'}/vanity/update";

2773

$url .= "?ver=1";

2774

$url .= "&ip=";

2775

$url .= $ip if $ip;

2776

2777

my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'});

2778

if (!defined($reply) || !$reply) {

2779

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

2780

last;

2781

}

2782

last if !header_ok($h, $reply);

2783

2784

my @reply = split /\n/, $reply;

2785

if (grep //i, @reply) {

2786

$config{$h}{'ip'} = $ip;

2787

$config{$h}{'mtime'} = $now;

2788

$config{$h}{'status'} = 'good';

2789

success("updating %s: good: IP address set to %s", $h, $ip);

2790

} else {

2791

$config{$h}{'status'} = 'failed';

2792

warning("SENT: %s", $url) unless opt('verbose');

2793

warning("REPLIED: %s", $reply);

2794

failed("updating %s: Invalid reply.", $h);

2795

}

2796

}

2797

}

2798

######################################################################

2799

## nic_zoneedit1_examples

2800

######################################################################

2801

sub nic_zoneedit1_examples {

2802

return <<EoEXAMPLE;

2803

o 'zoneedit1'

2804

2805

The 'zoneedit1' protocol is used by a DNS service offered by

2806

www.zoneedit.com.

2807

2808

Configuration variables applicable to the 'zoneedit1' protocol are:

2809

protocol=zoneedit1 ##

2810

server=fqdn.of.service ## defaults to www.zoneedit.com

2811

login=service-login ## login name and password registered with the service

2812

password=service-password ##

2813

your.domain.name ## the host registered with the service.

2814

2815

Example ${program}.conf file entries:

2816

## single host update

2817

protocol=zoneedit1, \\

2818

server=dynamic.zoneedit.com, \\

2819

login=my-zoneedit-login, \\

2820

password=my-zoneedit-password \\

2821

my.domain.name

2822

EoEXAMPLE

2823

}

2824

2825

######################################################################

2826

## nic_zoneedit1_updateable

2827

######################################################################

2828

sub nic_zoneedit1_updateable {

2829

return 0;

2830

}

2831

2832

######################################################################

2833

## nic_zoneedit1_update

2834

# <SUCCESS CODE="200" TEXT="Update succeeded." ZONE="trialdomain.com" IP="127.0.0.12">

2835

# <SUCCESS CODE="201" TEXT="No records need updating." ZONE="bannedware.com">

2836

# <ERROR CODE="701" TEXT="Zone is not set up in this account." ZONE="bad.com">

2837

######################################################################

2838

sub nic_zoneedit1_update {

2839

debug("\nnic_zoneedit1_update -------------------");

2840

2841

## group hosts with identical attributes together

2842

my %groups = group_hosts_by([ @_ ], [ qw(login password server) ]);

2843

2844

## update each set of hosts that had similar configurations

2845

foreach my $sig (keys %groups) {

2846

my @hosts = @{$groups{$sig}};

2847

my $hosts = join(',', @hosts);

2848

my $h = $hosts[0];

2849

my $ip = $config{$h}{'wantip'};

2850

delete $config{$_}{'wantip'} foreach @hosts;

2851

2852

info("setting IP address to %s for %s", $ip, $hosts);

2853

verbose("UPDATE:","updating %s", $hosts);

2854

2855

my $url = '';

2856

$url .= "http://$config{$h}{'server'}/auth/dynamic.html";

2857

$url .= "?host=$hosts";

2858

$url .= "&dnsto=$ip" if $ip;

2859

2860

my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'});

2861

if (!defined($reply) || !$reply) {

2862

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});

2863

last;

2864

}

2865

last if !header_ok($hosts, $reply);

2866

2867

my @reply = split /\n/, $reply;

2868

foreach my $line (@reply) {

2869

if ($line =~ /^[^<]*<(SUCCESS|ERROR)\s+([^>]+)>(.*)/) {

2870

my ($status, $assignments, $rest) = ($1, $2, $3);

2871

my ($left, %var) = parse_assignments($assignments);

2872

2873

if (keys %var) {

2874

my ($status_code, $status_text, $status_ip) = ('999', '', $ip);

2875

$status_code = $var{'CODE'} if exists $var{'CODE'};

2876

$status_text = $var{'TEXT'} if exists $var{'TEXT'};

2877

$status_ip = $var{'IP'} if exists $var{'IP'};

2878

2879

if ($status eq 'SUCCESS' || ($status eq 'ERROR' && $var{'CODE'} eq '707')) {

2880

$config{$h}{'ip'} = $status_ip;

2881

$config{$h}{'mtime'} = $now;

2882

$config{$h}{'status'} = 'good';

2883

2884

success("updating %s: IP address set to %s (%s: %s)", $h, $ip, $status_code, $status_text);

2885

2886

} else {

2887

$config{$h}{'status'} = 'failed';

2888

failed("updating %s: %s: %s", $h, $status_code, $status_text);

2889

}

2890

shift @hosts;

2891

$h = $hosts[0];

2892

$hosts = join(',', @hosts);

2893

}

2894

$line = $rest;

2895

redo if $line;

2896

}

2897

}

2898

failed("updating %s: no response from %s", $hosts, $config{$h}{'server'})

2899

if @hosts;

2900

}

2901

}

2902

######################################################################

2903

## nic_easydns_updateable

2904

######################################################################

2905

sub nic_easydns_updateable {

2906

my $host = shift;

2907

my $update = 0;

2908

2909

if ($config{$host}{'mx'} ne $cache{$host}{'mx'}) {

2910

info("forcing updating %s because 'mx' has changed to %s.", $host, $config{$host}{'mx'});

2911

$update = 1;

2912

2913

} elsif ($config{$host}{'mx'} && (ynu($config{$host}{'backupmx'},1,2,3) ne ynu($config{$host}{'backupmx'},1,2,3))) {

2914

info("forcing updating %s because 'backupmx' has changed to %s.", $host, ynu($config{$host}{'backupmx'},"YES","NO","NO"));

2915

$update = 1;

2916

2917

} elsif ($config{$host}{'static'} ne $cache{$host}{'static'}) {

2918

2919

info("forcing updating %s because 'static' has changed to %s.", $host, ynu($config{$host}{'static'},"YES","NO","NO"));

2920

$update = 1;

2921

2922

}

2923

return $update;

2924

}

2925

######################################################################

2926

## nic_easydns_examples

2927

######################################################################

2928

sub nic_easydns_examples {

2929

return <<EoEXAMPLE;

2930

o 'easydns'

2931

2932

The 'easydns' protocol is used by the for fee DNS service offered

2933

by www.easydns.com.

2934

2935

Configuration variables applicable to the 'easydns' protocol are:

2936

protocol=easydns ##

2937

server=fqdn.of.service ## defaults to members.easydns.com

2938

backupmx=no|yes ## indicates that EasyDNS should be the secondary MX

2939

## for this domain or host.

2940

mx=any.host.domain ## a host MX'ing for this host or domain.

2941

wildcard=no|yes ## add a DNS wildcard CNAME record that points to {host}

2942

login=service-login ## login name and password registered with the service

2943

password=service-password ##

2944

fully.qualified.host ## the host registered with the service.

2945

2946

Example ${program}.conf file entries:

2947

## single host update

2948

protocol=easydns, \\

2949

login=my-easydns.com-login, \\

2950

password=my-easydns.com-password \\

2951

myhost.easydns.com

2952

2953

## multiple host update with wildcard'ing mx, and backupmx

2954

protocol=easydns, \\

2955

login=my-easydns.com-login, \\

2956

password=my-easydns.com-password, \\

2957

mx=a.host.willing.to.mx.for.me, \\

2958

backupmx=yes, \\

2959

wildcard=yes \\

2960

my-toplevel-domain.com,my-other-domain.com

2961

2962

## multiple host update to the custom DNS service

2963

protocol=easydns, \\

2964

login=my-easydns.com-login, \\

2965

password=my-easydns.com-password \\

2966

my-toplevel-domain.com,my-other-domain.com

2967

EoEXAMPLE

2968

}

2969

######################################################################

2970

## nic_easydns_update

2971

######################################################################

2972

sub nic_easydns_update {

2973

debug("\nnic_easydns_update -------------------");

2974

2975

## group hosts with identical attributes together

2976

## my %groups = group_hosts_by([ @_ ], [ qw(login password server wildcard mx backupmx) ]);

2977

2978

## each host is in a group by itself

2979

my %groups = map { $_ => [ $_ ] } @_;

2980

2981

my %errors = (

2982

'NOACCESS' => 'Authentication failed. This happens if the username/password OR host or domain are wrong.',

2983

'NOSERVICE'=> 'Dynamic DNS is not turned on for this domain.',

2984

'ILLEGAL' => 'Client sent data that is not allowed in a dynamic DNS update.',

2985

'TOOSOON' => 'Update frequency is too short.',

2986

);

2987

2988

## update each set of hosts that had similar configurations

2989

foreach my $sig (keys %groups) {

2990

my @hosts = @{$groups{$sig}};

2991

my $hosts = join(',', @hosts);

2992

my $h = $hosts[0];

2993

my $ip = $config{$h}{'wantip'};

2994

delete $config{$_}{'wantip'} foreach @hosts;

2995

2996

info("setting IP address to %s for %s", $ip, $hosts);

2997

verbose("UPDATE:","updating %s", $hosts);

2998

2999

#'http://members.easydns.com/dyn/dyndns.php?hostname=test.burry.ca&myip=10.20.30.40&wildcard=ON'

3000

3001

my $url;

3002

$url = "http://$config{$h}{'server'}/dyn/dyndns.php?";

3003

$url .= "hostname=$hosts";

3004

$url .= "&myip=";

3005

$url .= $ip if $ip;

3006

$url .= "&wildcard=" . ynu($config{$h}{'wildcard'}, 'ON', 'OFF', 'OFF') if defined $config{$h}{'wildcard'};

3007

3008

if ($config{$h}{'mx'}) {

3009

$url .= "&mx=$config{$h}{'mx'}";

3010

$url .= "&backmx=" . ynu($config{$h}{'backupmx'}, 'YES', 'NO');

3011

}

3012

3013

my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'});

3014

if (!defined($reply) || !$reply) {

3015

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});

3016

last;

3017

}

3018

last if !header_ok($hosts, $reply);

3019

3020

my @reply = split /\n/, $reply;

3021

my $state = 'header';

3022

foreach my $line (@reply) {

3023

if ($state eq 'header') {

3024

$state = 'body';

3025

3026

} elsif ($state eq 'body') {

3027

$state = 'results' if $line eq '';

3028

3029

} elsif ($state =~ /^results/) {

3030

$state = 'results2';

3031

3032

my ($status) = $line =~ /^(\S*)\b.*/;

3033

my $h = shift @hosts;

3034

3035

$config{$h}{'status'} = $status;

3036

if ($status eq 'NOERROR') {

3037

$config{$h}{'ip'} = $ip;

3038

$config{$h}{'mtime'} = $now;

3039

success("updating %s: %s: IP address set to %s", $h, $status, $ip);

3040

3041

} elsif ($status =~ /TOOSOON/) {

3042

## make sure we wait at least a little

3043

my ($wait, $units) = (5, 'm');

3044

my ($sec, $scale) = ($wait, 1);

3045

3046

($scale, $units) = (1, 'seconds') if $units eq 's';

3047

($scale, $units) = (60, 'minutes') if $units eq 'm';

3048

($scale, $units) = (60*60, 'hours') if $units eq 'h';

3049

$config{$h}{'wtime'} = $now + $sec;

3050

warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip);

3051

3052

} elsif (exists $errors{$status}) {

3053

failed("updating %s: %s: %s", $h, $line, $errors{$status});

3054

3055

} else {

3056

failed("updating %s: %s: unexpected status (%s)", $h, $line);

3057

}

3058

last;

3059

}

3060

}

3061

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'})

3062

if $state ne 'results2';

3063

}

3064

}

3065

######################################################################

3066

3067

######################################################################

3068

## nic_dnspark_updateable

3069

######################################################################

3070

sub nic_dnspark_updateable {

3071

my $host = shift;

3072

my $update = 0;

3073

3074

if ($config{$host}{'mx'} ne $cache{$host}{'mx'}) {

3075

info("forcing updating %s because 'mx' has changed to %s.", $host, $config{$host}{'mx'});

3076

$update = 1;

3077

3078

} elsif ($config{$host}{'mx'} && ($config{$host}{'mxpri'} ne $cache{$host}{'mxpri'})) {

3079

info("forcing updating %s because 'mxpri' has changed to %s.", $host, $config{$host}{'mxpri'});

3080

$update = 1;

3081

}

3082

return $update;

3083

}

3084

######################################################################

3085

## nic_dnspark_examples

3086

######################################################################

3087

sub nic_dnspark_examples {

3088

return <<EoEXAMPLE;

3089

o 'dnspark'

3090

3091

The 'dnspark' protocol is used by DNS service offered by www.dnspark.com.

3092

3093

Configuration variables applicable to the 'dnspark' protocol are:

3094

protocol=dnspark ##

3095

server=fqdn.of.service ## defaults to www.dnspark.com

3096

backupmx=no|yes ## indicates that DNSPark should be the secondary MX

3097

## for this domain or host.

3098

mx=any.host.domain ## a host MX'ing for this host or domain.

3099

mxpri=priority ## MX priority.

3100

login=service-login ## login name and password registered with the service

3101

password=service-password ##

3102

fully.qualified.host ## the host registered with the service.

3103

3104

Example ${program}.conf file entries:

3105

## single host update

3106

protocol=dnspark, \\

3107

login=my-dnspark.com-login, \\

3108

password=my-dnspark.com-password \\

3109

myhost.dnspark.com

3110

3111

## multiple host update with wildcard'ing mx, and backupmx

3112

protocol=dnspark, \\

3113

login=my-dnspark.com-login, \\

3114

password=my-dnspark.com-password, \\

3115

mx=a.host.willing.to.mx.for.me, \\

3116

mxpri=10, \\

3117

my-toplevel-domain.com,my-other-domain.com

3118

3119

## multiple host update to the custom DNS service

3120

protocol=dnspark, \\

3121

login=my-dnspark.com-login, \\

3122

password=my-dnspark.com-password \\

3123

my-toplevel-domain.com,my-other-domain.com

3124

EoEXAMPLE

3125

}

3126

######################################################################

3127

## nic_dnspark_update

3128

######################################################################

3129

sub nic_dnspark_update {

3130

debug("\nnic_dnspark_update -------------------");

3131

3132

## group hosts with identical attributes together

3133

## my %groups = group_hosts_by([ @_ ], [ qw(login password server wildcard mx backupmx) ]);

3134

3135

## each host is in a group by itself

3136

my %groups = map { $_ => [ $_ ] } @_;

3137

3138

my %errors = (

3139

'nochange' => 'No changes made to the hostname(s). Continual updates with no changes lead to blocked clients.',

3140

'nofqdn' => 'No valid FQDN (fully qualified domain name) was specified',

3141

'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.',

3142

'abuse' => 'The hostname specified has been blocked for abuse.',

3143

'unauth' => 'The username specified is not authorized to update this hostname and domain.',

3144

'blocked' => 'The dynamic update client (specified by the user-agent) has been blocked from the system.',

3145

'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.',

3146

);

3147

3148

## update each set of hosts that had similar configurations

3149

foreach my $sig (keys %groups) {

3150

my @hosts = @{$groups{$sig}};

3151

my $hosts = join(',', @hosts);

3152

my $h = $hosts[0];

3153

my $ip = $config{$h}{'wantip'};

3154

delete $config{$_}{'wantip'} foreach @hosts;

3155

3156

info("setting IP address to %s for %s", $ip, $hosts);

3157

verbose("UPDATE:","updating %s", $hosts);

3158

3159

#'http://www.dnspark.com:80/visitors/update.html?myip=10.20.30.40&hostname=test.burry.ca'

3160

3161

my $url;

3162

$url = "http://$config{$h}{'server'}/visitors/update.html";

3163

$url .= "?hostname=$hosts";

3164

$url .= "&myip=";

3165

$url .= $ip if $ip;

3166

3167

if ($config{$h}{'mx'}) {

3168

$url .= "&mx=$config{$h}{'mx'}";

3169

$url .= "&mxpri=" . $config{$h}{'mxpri'};

3170

}

3171

3172

my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'});

3173

if (!defined($reply) || !$reply) {

3174

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});

3175

last;

3176

}

3177

last if !header_ok($hosts, $reply);

3178

3179

my @reply = split /\n/, $reply;

3180

my $state = 'header';

3181

foreach my $line (@reply) {

3182

if ($state eq 'header') {

3183

$state = 'body';

3184

3185

} elsif ($state eq 'body') {

3186

$state = 'results' if $line eq '';

3187

3188

} elsif ($state =~ /^results/) {

3189

$state = 'results2';

3190

3191

my ($status) = $line =~ /^(\S*)\b.*/;

3192

my $h = pop @hosts;

3193

3194

$config{$h}{'status'} = $status;

3195

if ($status eq 'ok') {

3196

$config{$h}{'ip'} = $ip;

3197

$config{$h}{'mtime'} = $now;

3198

success("updating %s: %s: IP address set to %s", $h, $status, $ip);

3199

3200

} elsif ($status =~ /TOOSOON/) {

3201

## make sure we wait at least a little

3202

my ($wait, $units) = (5, 'm');

3203

my ($sec, $scale) = ($wait, 1);

3204

3205

($scale, $units) = (1, 'seconds') if $units eq 's';

3206

($scale, $units) = (60, 'minutes') if $units eq 'm';

3207

($scale, $units) = (60*60, 'hours') if $units eq 'h';

3208

$config{$h}{'wtime'} = $now + $sec;

3209

warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip);

3210

3211

} elsif (exists $errors{$status}) {

3212

failed("updating %s: %s: %s", $h, $line, $errors{$status});

3213

3214

} else {

3215

failed("updating %s: %s: unexpected status (%s)", $h, $line);

3216

}

3217

last;

3218

}

3219

}

3220

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'})

3221

if $state ne 'results2';

3222

}

3223

}

3224

3225

######################################################################

3226

3227

######################################################################

3228

## nic_namecheap_examples

3229

######################################################################

3230

sub nic_namecheap_examples {

3231

return <<EoEXAMPLE;

3232

3233

o 'namecheap'

3234

3235

The 'namecheap' protocol is used by DNS service offered by www.namecheap.com.

3236

3237

Configuration variables applicable to the 'namecheap' protocol are:

3238

protocol=namecheap ##

3239

server=fqdn.of.service ## defaults to dynamicdns.park-your-domain.com

3240

login=service-login ## login name and password registered with the service

3241

password=service-password ##

3242

fully.qualified.host ## the host registered with the service.

3243

3244

Example ${program}.conf file entries:

3245

## single host update

3246

protocol=namecheap, \\

3247

login=my-namecheap.com-login, \\

3248

password=my-namecheap.com-password \\

3249

myhost.namecheap.com

3250

3251

EoEXAMPLE

3252

}

3253

######################################################################

3254

## nic_namecheap_update

3255

##

3256

## written by Dan Boardman

3257

##

3258

## based on http://www.namecheap.com/resources/help/index.asp?t=dynamicdns

3259

## needs this url to update:

3260

## http://dynamicdns.park-your-domain.com/update?host=host_name&

3261

## domain=domain.com&password=domain_password[&ip=your_ip]

3262

##

3263

######################################################################

3264

sub nic_namecheap_update {

3265

3266

3267

debug("\nnic_namecheap1_update -------------------");

3268

3269

## update each configured host

3270

foreach my $h (@_) {

3271

my $ip = delete $config{$h}{'wantip'};

3272

info("setting IP address to %s for %s", $ip, $h);

3273

verbose("UPDATE:","updating %s", $h);

3274

3275

my $url;

3276

$url = "http://$config{$h}{'server'}/update";

3277

$url .= "?host=$h";

3278

$url .= "&domain=$config{$h}{'login'}";

3279

$url .= "&password=$config{$h}{'password'}";

3280

$url .= "&ip=";

3281

$url .= $ip if $ip;

3282

3283

my $reply = geturl(opt('proxy'), $url);

3284

if (!defined($reply) || !$reply) {

3285

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

3286

last;

3287

}

3288

last if !header_ok($h, $reply);

3289

3290

my @reply = split /\n/, $reply;

3291

if (grep /<ErrCount>0/i, @reply) {

3292

$config{$h}{'ip'} = $ip;

3293

$config{$h}{'mtime'} = $now;

3294

$config{$h}{'status'} = 'good';

3295

success("updating %s: good: IP address set to %s", $h, $ip);

3296

} else {

3297

$config{$h}{'status'} = 'failed';

3298

warning("SENT: %s", $url) unless opt('verbose');

3299

warning("REPLIED: %s", $reply);

3300

failed("updating %s: Invalid reply.", $h);

3301

}

3302

}

3303

}

3304

3305

######################################################################

3306

3307

3308

######################################################################

3309

3310

######################################################################

3311

## nic_sitelutions_examples

3312

######################################################################

3313

sub nic_sitelutions_examples {

3314

return <<EoEXAMPLE;

3315

3316

o 'sitelutions'

3317

3318

The 'sitelutions' protocol is used by DNS services offered by www.sitelutions.com.

3319

3320

Configuration variables applicable to the 'sitelutions' protocol are:

3321

protocol=sitelutions ##

3322

server=fqdn.of.service ## defaults to sitelutions.com

3323

login=service-login ## login name and password registered with the service

3324

password=service-password ##

3325

A_record_id ## Id of the A record for the host registered with the service.

3326

3327

Example ${program}.conf file entries:

3328

## single host update

3329

protocol=sitelutions, \\

3330

login=my-sitelutions.com-login, \\

3331

password=my-sitelutions.com-password \\

3332

my-sitelutions.com-id_of_A_record

3333

3334

EoEXAMPLE

3335

}

3336

######################################################################

3337

## nic_sitelutions_update

3338

##

3339

## written by Mike W. Smith

3340

##

3341

## based on http://www.sitelutions.com/help/dynamic_dns_clients#updatespec

3342

## needs this url to update:

3343

## https://www.sitelutions.com/dnsup?id=990331&user=myemail@mydomain.com&pass=SecretPass&ip=192.168.10.4

3344

## domain=domain.com&password=domain_password&ip=your_ip

3345

##

3346

######################################################################

3347

sub nic_sitelutions_update {

3348

3349

3350

debug("\nnic_sitelutions_update -------------------");

3351

3352

## update each configured host

3353

foreach my $h (@_) {

3354

my $ip = delete $config{$h}{'wantip'};

3355

info("setting IP address to %s for %s", $ip, $h);

3356

verbose("UPDATE:","updating %s", $h);

3357

3358

my $url;

3359

$url = "http://$config{$h}{'server'}/dnsup";

3360

$url .= "?id=$h";

3361

$url .= "&user=$config{$h}{'login'}";

3362

$url .= "&pass=$config{$h}{'password'}";

3363

$url .= "&ip=";

3364

$url .= $ip if $ip;

3365

3366

my $reply = geturl(opt('proxy'), $url);

3367

if (!defined($reply) || !$reply) {

3368

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

3369

last;

3370

}

3371

last if !header_ok($h, $reply);

3372

3373

my @reply = split /\n/, $reply;

3374

if (grep /success/i, @reply) {

3375

$config{$h}{'ip'} = $ip;

3376

$config{$h}{'mtime'} = $now;

3377

$config{$h}{'status'} = 'good';

3378

success("updating %s: good: IP address set to %s", $h, $ip);

3379

} else {

3380

$config{$h}{'status'} = 'failed';

3381

warning("SENT: %s", $url) unless opt('verbose');

3382

warning("REPLIED: %s", $reply);

3383

failed("updating %s: Invalid reply.", $h);

3384

}

3385

}

3386

}

3387

3388

######################################################################

3389

# vim: ai ts=4 sw=4 tw=78 :

3390

3391

3392

__END__