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

1

#!/usr/bin/perl -w

2

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

3

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

4

# $Id: ddclient 157 2013-12-26 09:02:05Z wimpunk $

5

#

6

# DDCLIENT - a Perl client for updating DynDNS information

7

#

8

# Author: Paul Burry (paul+ddclient@burry.ca)

9

# ddclient-developers: see https://sourceforge.net/project/memberlist.php?group_id=116817

10

#

11

# website: http://ddclient.sf.net

12

#

13

# Support for multiple IP numbers added by

14

# Astaro AG, Ingo Schwarze <ischwarze-OOs/4mkCeqbQT0dZR+AlfA@public.gmane.org> September 16, 2008

15

#

16

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

17

require 5.004;

18

use strict;

19

use Getopt::Long;

20

use Sys::Hostname;

21

use IO::Socket;

22

23

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

24

25

my $version = "3.8.2";

26

my $programd = $0;

27

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

28

my $program = $programd;

29

$program =~ s/d$//;

30

my $now = time;

31

my $hostname = hostname();

32

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

33

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

34

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

35

my $msgs = '';

36

my $last_msgs = '';

37

38

use vars qw($file $lineno);

39

local $file = '';

40

local $lineno = '';

41

42

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

43

44

sub T_ANY {'any'};

45

sub T_STRING {'string'};

46

sub T_EMAIL {'e-mail address'};

47

sub T_NUMBER {'number'};

48

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

49

sub T_LOGIN {'login'};

50

sub T_PASSWD {'password'};

51

sub T_BOOL {'boolean value'};

52

sub T_FQDN {'fully qualified host name'};

53

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

54

sub T_FILE {'file name'};

55

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

56

sub T_PROTO {'protocol'}

57

sub T_USE {'ip strategy'}

58

sub T_IF {'interface'}

59

sub T_PROG {'program name'}

60

sub T_IP {'ip'}

61

sub T_POSTS {'postscript'};

62

63

## strategies for obtaining an ip address.

64

my %builtinweb = (

65

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

66

'Current IP Address:', },

67

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

68

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

69

);

70

my %builtinfw = (

71

'watchguard-soho' => {

72

'name' => 'Watchguard SOHO FW',

73

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

74

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

75

},

76

'netopia-r910' => {

77

'name' => 'Netopia R910 FW',

78

'url' => '/WanEvtLog',

79

'skip' => 'local:',

80

},

81

'smc-barricade' => {

82

'name' => 'SMC Barricade FW',

83

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

84

'skip' => 'IP Address',

85

},

86

'smc-barricade-alt' => {

87

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

88

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

89

'skip' => 'WAN IP',

90

},

91

'smc-barricade-alt' => {

92

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

93

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

94

'skip' => 'WAN IP',

95

},

96

'smc-barricade-7401bra' => {

97

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

98

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

99

'skip' => 'IP Address',

100

},

101

'netgear-rt3xx' => {

102

'name' => 'Netgear FW',

103

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

104

'skip' => 'IP Address',

105

},

106

'elsa-lancom-dsl10' => {

107

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

108

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

109

'skip' => 'IP.Address',

110

},

111

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

112

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

113

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

114

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

115

},

116

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

117

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

118

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

119

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

120

},

121

'linksys' => {

122

'name' => 'Linksys FW',

123

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

124

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

125

},

126

'linksys-ver2' => {

127

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

128

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

129

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

130

},

131

'linksys-ver3' => {

132

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

133

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

134

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

135

},

136

'linksys-wrt854g' => {

137

'name' => 'Linksys WRT854G FW',

138

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

139

'skip' => 'IP Address:',

140

},

141

'maxgate-ugate3x00' => {

142

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

143

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

144

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

145

},

146

'netcomm-nb3' => {

147

'name' => 'NetComm NB3',

148

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

149

'skip' => 'ppp-0',

150

},

151

'3com-3c886a' => {

152

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

153

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

154

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

155

},

156

'sohoware-nbg800' => {

157

'name' => 'SOHOWare BroadGuard NBG800',

158

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

159

'skip' => 'Internet IP',

160

},

161

'xsense-aero' => {

162

'name' => 'Xsense Aero',

163

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

164

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

165

},

166

'alcatel-stp' => {

167

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

168

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

169

'skip' => 'Brt',

170

},

171

'alcatel-510' => {

172

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

173

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

174

'skip' => 'ppp',

175

},

176

'allnet-1298' => {

177

'name' => 'Allnet 1298',

178

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

179

'skip' => 'WAN',

180

},

181

'3com-oc-remote812' => {

182

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

183

'url' => '/callEvent',

184

'skip' => '.*LOCAL',

185

},

186

'e-tech' => {

187

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

188

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

189

'skip' => 'Public IP Address',

190

},

191

'cayman-3220h' => {

192

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

193

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

194

'skip' => '.*inet',

195

},

196

'vigor-2200usb' => {

197

'name' => 'Vigor 2200 USB',

198

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

199

'skip' => 'PPPoA',

200

},

201

'dlink-614' => {

202

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

203

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

204

'skip' => 'WAN',

205

},

206

'dlink-604' => {

207

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

208

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

209

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

210

},

211

'olitec-SX200' => {

212

'name' => 'olitec-SX200',

213

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

214

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

215

},

216

'westell-6100' => {

217

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

218

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

219

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

220

},

221

'2wire' => {

222

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

223

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

224

'skip' => 'Internet Address:',

225

},

226

'linksys-rv042-wan1' => {

227

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

228

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

229

'skip' => 'WAN1 IP',

230

},

231

'linksys-rv042-wan2' => {

232

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

233

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

234

'skip' => 'WAN2 IP',

235

},

236

'netgear-rp614' => {

237

'name' => 'Netgear RP614 FW',

238

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

239

'skip' => 'IP Address',

240

},

241

'watchguard-edge-x' => {

242

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

243

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

244

'skip' => 'inet addr:',

245

},

246

'dlink-524' => {

247

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

248

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

249

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

250

},

251

'rtp300' => {

252

'name' => 'Linksys RTP300',

253

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

254

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

255

},

256

'netgear-wpn824' => {

257

'name' => 'Netgear WPN824 FW',

258

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

259

'skip' => 'IP Address',

260

},

261

'linksys-wcg200' => {

262

'name' => 'Linksys WCG200 FW',

263

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

264

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

265

},

266

'netgear-dg834g' => {

267

'name' => 'netgear-dg834g',

268

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

269

'skip' => '',

270

},

271

'netgear-wgt624' => {

272

'name' => 'Netgear WGT624',

273

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

274

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

275

},

276

'sveasoft' => {

277

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

278

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

279

'skip' => 'var wan_ip',

280

},

281

'smc-barricade-7004vbr' => {

282

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

283

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

284

'skip' => 'var wan_ip=',

285

},

286

'sitecom-dc202' => {

287

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

288

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

289

'skip' => 'Internet IP Address',

290

},

291

);

292

my %ip_strategies = (

293

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

294

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

295

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

296

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

297

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

298

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

299

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

300

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

301

);

302

sub ip_strategies_usage {

303

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

304

}

305

306

my %web_strategies = (

307

'dyndns'=> 1,

308

'dnspark'=> 1,

309

'loopia'=> 1,

310

);

311

312

sub setv {

313

return {

314

'type' => shift,

315

'required' => shift,

316

'cache' => shift,

317

'config' => shift,

318

'default' => shift,

319

'minimum' => shift,

320

};

321

};

322

my %variables = (

323

'global-defaults' => {

324

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

325

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

326

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

327

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

328

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

329

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

330

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

331

332

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

333

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

334

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

335

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

336

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

337

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

338

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

339

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

340

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

341

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

342

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

343

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

344

345

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

346

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

347

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

348

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

349

350

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

351

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

352

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

353

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

354

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

355

356

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

357

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

358

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

359

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

360

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

361

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

362

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

363

364

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

365

},

366

'service-common-defaults' => {

367

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

368

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

369

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

370

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

371

372

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

373

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

374

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

375

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

376

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

377

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

378

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

379

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

380

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

381

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

382

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

383

384

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

385

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

386

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

387

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

388

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

389

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

390

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

391

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

392

393

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

394

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

395

},

396

'dyndns-common-defaults' => {

397

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

398

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

399

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

400

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

401

},

402

'easydns-common-defaults' => {

403

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

404

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

405

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

406

},

407

'dnspark-common-defaults' => {

408

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

409

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

410

},

411

'noip-common-defaults' => {

412

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

413

},

414

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

415

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

416

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

417

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

418

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

419

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

420

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

421

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

422

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

423

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

424

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

425

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

426

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

427

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

428

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

429

},

430

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

431

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

432

},

433

'dtdns-common-defaults' => {

434

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

435

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

436

},

437

);

438

my %services = (

439

'dyndns1' => {

440

'updateable' => \&nic_dyndns2_updateable,

441

'update' => \&nic_dyndns1_update,

442

'examples' => \&nic_dyndns1_examples,

443

'variables' => merge(

444

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

445

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

446

),

447

},

448

'dyndns2' => {

449

'updateable' => \&nic_dyndns2_updateable,

450

'update' => \&nic_dyndns2_update,

451

'examples' => \&nic_dyndns2_examples,

452

'variables' => merge(

453

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

454

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

455

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

456

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

457

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

458

),

459

},

460

'noip' => {

461

'updateable' => undef,

462

'update' => \&nic_noip_update,

463

'examples' => \&nic_noip_examples,

464

'variables' => merge(

465

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

466

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

467

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

468

),

469

},

470

'concont' => {

471

'updateable' => undef,

472

'update' => \&nic_concont_update,

473

'examples' => \&nic_concont_examples,

474

'variables' => merge(

475

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

476

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

477

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

478

),

479

},

480

'dslreports1' => {

481

'updateable' => undef,

482

'update' => \&nic_dslreports1_update,

483

'examples' => \&nic_dslreports1_examples,

484

'variables' => merge(

485

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

486

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

487

),

488

},

489

'hammernode1' => {

490

'updateable' => undef,

491

'update' => \&nic_hammernode1_update,

492

'examples' => \&nic_hammernode1_examples,

493

'variables' => merge(

494

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

495

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

496

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

497

),

498

},

499

'zoneedit1' => {

500

'updateable' => undef,

501

'update' => \&nic_zoneedit1_update,

502

'examples' => \&nic_zoneedit1_examples,

503

'variables' => merge(

504

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

505

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

506

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

507

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

508

),

509

},

510

'easydns' => {

511

'updateable' => undef,

512

'update' => \&nic_easydns_update,

513

'examples' => \&nic_easydns_examples,

514

'variables' => merge(

515

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

516

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

517

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

518

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

519

),

520

},

521

'dnspark' => {

522

'updateable' => undef,

523

'update' => \&nic_dnspark_update,

524

'examples' => \&nic_dnspark_examples,

525

'variables' => merge(

526

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

527

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

528

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

529

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

530

),

531

},

532

'namecheap' => {

533

'updateable' => undef,

534

'update' => \&nic_namecheap_update,

535

'examples' => \&nic_namecheap_examples,

536

'variables' => merge(

537

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

538

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

539

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

540

),

541

},

542

'sitelutions' => {

543

'updateable' => undef,

544

'update' => \&nic_sitelutions_update,

545

'examples' => \&nic_sitelutions_examples,

546

'variables' => merge(

547

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

548

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

549

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

550

),

551

},

552

'freedns' => {

553

'updateable' => undef,

554

'update' => \&nic_freedns_update,

555

'examples' => \&nic_freedns_examples,

556

'variables' => merge(

557

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

558

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

559

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

560

),

561

},

562

'changeip' => {

563

'updateable' => undef,

564

'update' => \&nic_changeip_update,

565

'examples' => \&nic_changeip_examples,

566

'variables' => merge(

567

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

568

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

569

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

570

),

571

},

572

'dtdns' => {

573

'updateable' => undef,

574

'update' => \&nic_dtdns_update,

575

'examples' => \&nic_dtdns_examples,

576

'variables' => merge(

577

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

578

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

579

),

580

},

581

);

582

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

583

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

584

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

585

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

586

);

587

588

my @opt = (

589

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

590

"options are:",

591

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

592

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

593

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

594

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

595

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

596

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

597

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

598

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

599

"",

600

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

601

&ip_strategies_usage(),

602

"",

603

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

604

"",

605

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

606

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

607

"",

608

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

609

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

610

"",

611

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

612

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

613

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

614

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

615

"",

616

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

617

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

618

"",

619

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

620

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

621

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

622

"",

623

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

624

"",

625

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

626

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

627

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

628

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

629

630

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

631

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

632

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

633

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

634

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

635

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

636

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

637

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

638

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

639

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

640

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

641

642

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

643

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

644

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

645

"",

646

nic_examples(),

647

"$program version $version, ",

648

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

649

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

650

);

651

652

## process args

653

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

654

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

655

my $saved_cache = '';

656

my %saved_opt = %opt;

657

$result = 'OK';

658

659

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

660

661

## process help option

662

if (opt('help')) {

663

*STDERR = *STDOUT;

664

usage(0);

665

}

666

667

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

668

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

669

init_config();

670

test_possible_ip() if opt('query');

671

672

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

673

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

674

}

675

my $caught_hup = 0;

676

my $caught_term = 0;

677

my $caught_kill = 0;

678

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

679

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

680

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

681

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

682

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

683

;

684

} elsif (opt('daemon')) {

685

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

686

my $pid = fork;

687

if ($pid < 0) {

688

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

689

exit -1;

690

} elsif ($pid) {

691

exit 0;

692

}

693

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

694

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

695

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

696

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

697

}

698

699

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

700

if(opt('daemon')) {

701

write_pid();

702

$opt{'syslog'} = 1;

703

}

704

705

umask 077;

706

my $daemon;

707

do {

708

$now = time;

709

$result = 'OK';

710

%opt = %saved_opt;

711

if (opt('help')) {

712

*STDERR = *STDOUT;

713

printf("Help found");

714

# usage();

715

}

716

717

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

718

init_config();

719

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

720

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

721

722

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

723

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

724

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

725

726

$daemon = $opt{'daemon'};

727

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

728

729

update_nics();

730

731

if ($daemon) {

732

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

733

sendmail();

734

735

my $left = $daemon;

736

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

737

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

738

739

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

740

$left -= sleep $delay;

741

# preventing deep sleep - see [bugs:#46]

742

if ($left > $daemon) {

743

$left = $daemon;

744

}

745

}

746

$caught_hup = 0;

747

$result = 0;

748

749

} elsif (! scalar(%config)) {

750

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

751

$result = 1;

752

753

} else {

754

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

755

}

756

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

757

758

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

759

unlink_pid();

760

sendmail();

761

762

exit($result);

763

764

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

765

## runpostscript

766

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

767

768

sub runpostscript {

769

my ($ip) = @_;

770

771

if ( defined $globals{postscript} ) {

772

if ( -x $globals{postscript}) {

773

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

774

} else {

775

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

776

}

777

}

778

}

779

780

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

781

## update_nics

782

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

783

sub update_nics {

784

my %examined = ();

785

my %iplist = ();

786

787

foreach my $s (sort keys %services) {

788

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

789

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

790

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

791

792

foreach my $h (sort keys %config) {

793

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

794

$examined{$h} = 1;

795

# we only do this once per 'use' and argument combination

796

my $use = opt('use', $h);

797

my $arg_ip = opt('ip', $h) || '';

798

my $arg_fw = opt('fw', $h) || '';

799

my $arg_if = opt('if', $h) || '';

800

my $arg_web = opt('web', $h) || '';

801

my $arg_cmd = opt('cmd', $h) || '';

802

my $ip = "";

803

if (exists $iplist{$use}{$arg_ip}{$arg_fw}{$arg_if}{$arg_web}{$arg_cmd}) {

804

$ip = $iplist{$use}{$arg_ip}{$arg_fw}{$arg_if}{$arg_web}{$arg_cmd};

805

} else {

806

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

807

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

808

warning("unable to determine IP address")

809

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

810

next;

811

}

812

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

813

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

814

next;

815

}

816

$iplist{$use}{$arg_ip}{$arg_fw}{$arg_if}{$arg_web}{$arg_cmd} = $ip;

817

}

818

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

819

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

820

push @hosts, $h;

821

$ips{$ip} = $h;

822

}

823

if (@hosts) {

824

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

825

&$update(@hosts);

826

runpostscript(join ' ', keys %ips);

827

}

828

}

829

foreach my $h (sort keys %config) {

830

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

831

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

832

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

833

);

834

}

835

}

836

write_cache(opt('cache'));

837

}

838

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

839

## unlink_pid()

840

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

841

sub unlink_pid {

842

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

843

unlink opt('pid');

844

}

845

}

846

847

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

848

## write_pid()

849

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

850

sub write_pid {

851

my $file = opt('pid');

852

853

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

854

local *FD;

855

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

856

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

857

858

} else {

859

printf FD "$$\n";

860

close(FD);

861

}

862

}

863

}

864

865

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

866

## write_cache($file)

867

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

868

sub write_cache {

869

my ($file) = @_;

870

871

## merge the updated host entries into the cache.

872

foreach my $h (keys %config) {

873

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

874

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

875

876

} else {

877

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

878

}

879

}

880

881

## construct the cache file.

882

my $cache = "";

883

foreach my $h (sort keys %cache) {

884

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

885

886

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

887

}

888

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

889

890

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

891

if ($file) {

892

$saved_cache = undef;

893

local *FD;

894

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

895

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

896

}

897

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

898

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

899

printf FD $cache;

900

901

close(FD);

902

}

903

}

904

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

905

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

906

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

907

sub read_cache {

908

my $file = shift;

909

my $config = shift;

910

my $globals = {};

911

912

%{$config} = ();

913

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

914

if (-e $file) {

915

my %saved = %opt;

916

%opt = ();

917

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

918

%opt = %saved;

919

920

foreach my $h (keys %cache) {

921

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

922

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

923

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

924

}

925

}

926

}

927

}

928

}

929

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

930

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

931

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

932

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

933

sub parse_assignments {

934

my $rest = shift;

935

my @args = @_;

936

my %variables = ();

937

my ($name, $value);

938

939

while (1) {

940

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

941

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

942

if (defined $name) {

943

$variables{$name} = $value;

944

} else {

945

last;

946

}

947

}

948

return ($rest, %variables);

949

}

950

sub parse_assignment {

951

my $rest = shift;

952

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

953

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

954

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

955

956

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

957

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

958

959

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

960

$rest = substr($rest,1);

961

if ($escape) {

962

$value .= $c;

963

$escape = 0;

964

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

965

$escape = 1;

966

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

967

$quote = ''

968

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

969

$quote = $c;

970

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

971

last;

972

} else {

973

$value .= $c;

974

}

975

}

976

}

977

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

978

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

979

}

980

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

981

## read_config

982

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

983

sub read_config {

984

my $file = shift;

985

my $config = shift;

986

my $globals = shift;

987

my %globals = ();

988

989

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

990

}

991

sub _read_config {

992

my $config = shift;

993

my $globals = shift;

994

my $stamp = shift;

995

local $file = shift;

996

my %globals = @_;

997

my %config = ();

998

my $content = '';

999

1000

local *FD;

1001

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

1002

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

1003

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

1004

}

1005

# Check for only owner has any access to config file

1006

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

1007

if ($mode & 077) {

1008

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

1009

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

1010

} else {

1011

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

1012

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

1013

}

1014

}

1015

1016

local $lineno = 0;

1017

my $continuation = '';

1018

my %passwords = ();

1019

while (<FD>) {

1020

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

1021

1022

$lineno++;

1023

1024

## check for the program version stamp

1025

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

1026

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

1027

last;

1028

}

1029

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

1030

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

1031

}

1032

1033

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

1034

1035

## parsing passwords is special

1036

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

1037

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

1038

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

1039

$passwords{$key} = $value;

1040

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

1041

}

1042

1043

## remove comments

1044

s/#.*//;

1045

1046

## handle continuation lines

1047

$_ = "$continuation$_";

1048

if (/\\$/) {

1049

chop;

1050

$continuation = $_;

1051

next;

1052

}

1053

$continuation = '';

1054

1055

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

1056

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

1057

s/\s+/ /g; # canonify

1058

next if /^$/;

1059

1060

## expected configuration line is:

1061

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

1062

my %locals;

1063

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

1064

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

1065

my @args = split;

1066

1067

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

1068

foreach my $k (keys %locals) {

1069

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

1070

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

1071

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

1072

delete $locals{$k};

1073

} else {

1074

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

1075

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

1076

if (!defined($value)) {

1077

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

1078

delete $locals{$k};

1079

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

1080

}

1081

}

1082

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

1083

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

1084

}

1085

## accumulate globals

1086

if ($#args < 0) {

1087

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

1088

}

1089

1090

## process this host definition

1091

if (@args) {

1092

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

1093

1094

## add in any globals..

1095

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

1096

1097

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

1098

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

1099

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

1100

1101

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

1102

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

1103

## save a copy of the current globals

1104

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

1105

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

1106

}

1107

}

1108

%passwords = ();

1109

}

1110

close(FD);

1111

1112

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

1113

if $continuation;

1114

1115

%$globals = %globals;

1116

%$config = %config;

1117

1118

return $content;

1119

}

1120

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

1121

## init_config -

1122

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

1123

sub init_config {

1124

%opt = %saved_opt;

1125

1126

##

1127

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

1128

1129

## infer the IP strategy if possible

1130

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

1131

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

1132

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

1133

1134

## sanity check

1135

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

1136

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

1137

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

1138

1139

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

1140

1141

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

1142

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

1143

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

1144

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

1145

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

1146

}

1147

1148

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

1149

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

1150

## collect cmdline configuration options.

1151

my %options = ();

1152

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

1153

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

1154

$options{$name} = $var;

1155

}

1156

## determine hosts specified with -host

1157

my @hosts = ();

1158

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

1159

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

1160

push @hosts, $h;

1161

}

1162

}

1163

## and those in -options=...

1164

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

1165

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

1166

push @hosts, $h;

1167

}

1168

delete $options{'host'};

1169

}

1170

## merge options into host definitions or globals

1171

if (@hosts) {

1172

foreach my $h (@hosts) {

1173

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

1174

}

1175

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

1176

} else {

1177

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

1178

}

1179

}

1180

1181

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

1182

foreach my $o (keys %opt) {

1183

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

1184

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

1185

}

1186

}

1187

1188

## sanity check

1189

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

1190

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

1191

}

1192

1193

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

1194

my @hosts = keys %config;

1195

if (opt('host')) {

1196

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

1197

}

1198

if (opt('retry')) {

1199

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

1200

}

1201

1202

## remove any other hosts

1203

my %hosts;

1204

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

1205

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

1206

1207

## collect the cacheable variables.

1208

foreach my $proto (keys %services) {

1209

my @cacheable = ();

1210

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

1211

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

1212

}

1213

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

1214

}

1215

1216

## sanity check..

1217

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

1218

## first the globals...

1219

foreach my $k (keys %globals) {

1220

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

1221

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

1222

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

1223

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

1224

$value = default($k);

1225

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

1226

}

1227

$globals{$k} = $value;

1228

}

1229

1230

## now the host definitions...

1231

HOST:

1232

foreach my $h (keys %config) {

1233

my $proto;

1234

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

1235

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

1236

1237

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

1238

1239

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

1240

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

1241

delete $config{$h};

1242

1243

} else {

1244

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

1245

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

1246

1247

foreach my $k (keys %$svars) {

1248

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

1249

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

1250

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

1251

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

1252

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

1253

delete $config{$h};

1254

next HOST;

1255

}

1256

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

1257

1258

}

1259

$config{$h} = $conf;

1260

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

1261

}

1262

}

1263

}

1264

1265

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

1266

## usage

1267

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

1268

sub usage {

1269

my $exitcode = 1;

1270

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

1271

my $msg = '';

1272

if (@_) {

1273

my $format = shift;

1274

$msg .= sprintf $format, @_;

1275

1 while chomp($msg);

1276

$msg .= "\n";

1277

}

1278

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

1279

sendmail();

1280

exit $exitcode;

1281

}

1282

1283

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

1284

## process_args -

1285

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

1286

sub process_args {

1287

my @spec = ();

1288

my $usage = "";

1289

my %opts = ();

1290

1291

foreach (@_) {

1292

if (ref $_) {

1293

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

1294

my $value = default($key);

1295

1296

## add a option specifier

1297

push @spec, $key . $specifier;

1298

1299

## define the default value which can be overwritten later

1300

$opt{$key} = undef;

1301

1302

next unless $arg_usage;

1303

1304

## add a line to the usage;

1305

$usage .= " $arg_usage";

1306

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

1307

$usage .= " (default: ";

1308

if ($specifier eq '!') {

1309

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

1310

$usage .= $key;

1311

} else {

1312

$usage .= $value;

1313

}

1314

$usage .= ")";

1315

}

1316

$usage .= ".";

1317

} else {

1318

$usage .= $_;

1319

}

1320

$usage .= "\n";

1321

}

1322

## process the arguments

1323

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

1324

$opt{"help"} = 1;

1325

}

1326

return ($usage, %opt);

1327

}

1328

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

1329

## test_possible_ip - print possible IPs

1330

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

1331

sub test_possible_ip {

1332

local $opt{'debug'} = 0;

1333

1334

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

1335

if defined opt('ip');

1336

1337

{

1338

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

1339

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

1340

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

1341

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

1342

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

1343

}

1344

}

1345

if (opt('fw')) {

1346

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

1347

foreach my $fw (sort keys %builtinfw) {

1348

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

1349

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

1350

}

1351

}

1352

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

1353

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

1354

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

1355

1356

}

1357

{

1358

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

1359

foreach my $web (sort keys %builtinweb) {

1360

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

1361

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

1362

}

1363

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

1364

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

1365

}

1366

if (opt('cmd')) {

1367

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

1368

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

1369

}

1370

exit 0 unless opt('debug');

1371

}

1372

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

1373

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

1374

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

1375

sub test_geturl {

1376

my $url = shift;

1377

1378

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

1379

print "URL $url\n";;

1380

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

1381

exit;

1382

}

1383

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

1384

## load_file

1385

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

1386

sub load_file {

1387

my $file = shift;

1388

my $buffer = '';

1389

1390

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

1391

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

1392

$file = $try if -f $try;

1393

}

1394

1395

local *FD;

1396

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

1397

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

1398

close(FD);

1399

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

1400

} else {

1401

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

1402

}

1403

return $buffer

1404

}

1405

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

1406

## save_file

1407

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

1408

sub save_file {

1409

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

1410

1411

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

1412

if (defined $opt) {

1413

my $i = 0;

1414

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

1415

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

1416

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

1417

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

1418

last if $a eq $b;

1419

}

1420

$i++;

1421

}

1422

$file = "$file-$i";

1423

}

1424

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

1425

local *FD;

1426

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

1427

print FD $buffer;

1428

close(FD);

1429

return $buffer;

1430

}

1431

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

1432

## print_opt

1433

## print_globals

1434

## print_config

1435

## print_cache

1436

## print_info

1437

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

1438

sub _print_hash {

1439

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

1440

my $value = $ptr;

1441

1442

if (! defined($ptr)) {

1443

$value = "<undefined>";

1444

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

1445

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

1446

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

1447

}

1448

return;

1449

}

1450

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

1451

}

1452

sub print_hash {

1453

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

1454

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

1455

_print_hash($string, $hash);

1456

}

1457

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

1458

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

1459

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

1460

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

1461

sub print_info {

1462

print_opt();

1463

print_globals();

1464

print_config();

1465

print_cache();

1466

}

1467

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

1468

## pipecmd - run an external command

1469

## logger

1470

## sendmail

1471

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

1472

sub pipecmd {

1473

my $cmd = shift;

1474

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

1475

my $ok = 0;

1476

1477

## remove trailing newlines

1478

1 while chomp($stdin);

1479

1480

## override when debugging.

1481

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

1482

1483

## execute the command.

1484

local *FD;

1485

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

1486

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

1487

1488

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

1489

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

1490

close(FD);

1491

1492

} elsif (! close(FD)) {

1493

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

1494

1495

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

1496

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

1497

1498

} else {

1499

$ok = 1;

1500

}

1501

return $ok;

1502

}

1503

sub logger {

1504

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

1505

my $facility = opt('facility');

1506

my $priority = opt('priority');

1507

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

1508

}

1509

return 1;

1510

}

1511

sub sendmail {

1512

my $recipients = opt('mail');

1513

1514

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

1515

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

1516

}

1517

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

1518

pipecmd("sendmail -oi $recipients",

1519

"To: $recipients",

1520

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

1521

"\r\n",

1522

$msgs,

1523

"",

1524

"regards,",

1525

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

1526

);

1527

}

1528

$last_msgs = $msgs;

1529

$msgs = '';

1530

}

1531

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

1532

## split_by_comma

1533

## merge

1534

## default

1535

## minimum

1536

## opt

1537

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

1538

sub split_by_comma {

1539

my $string = shift;

1540

1541

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

1542

return ();

1543

}

1544

sub merge {

1545

my %merged = ();

1546

foreach my $h (@_) {

1547

foreach my $k (keys %$h) {

1548

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

1549

}

1550

}

1551

return \%merged;

1552

}

1553

sub default {

1554

my $v = shift;

1555

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

1556

}

1557

sub minimum {

1558

my $v = shift;

1559

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

1560

}

1561

sub opt {

1562

my $v = shift;

1563

my $h = shift;

1564

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

1565

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

1566

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

1567

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

1568

return undef;

1569

}

1570

sub min {

1571

my $min = shift;

1572

foreach my $arg (@_) {

1573

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

1574

}

1575

return $min;

1576

}

1577

sub max {

1578

my $max = shift;

1579

foreach my $arg (@_) {

1580

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

1581

}

1582

return $max;

1583

}

1584

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

1585

## define

1586

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

1587

sub define {

1588

foreach (@_) {

1589

return $_ if defined $_;

1590

}

1591

return undef;

1592

}

1593

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

1594

## ynu

1595

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

1596

sub ynu {

1597

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

1598

1599

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

1600

return $yes if $value eq '1';

1601

foreach (qw(yes true)) {

1602

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

1603

}

1604

foreach (qw(no false)) {

1605

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

1606

}

1607

return $undef;

1608

}

1609

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

1610

## msg

1611

## debug

1612

## warning

1613

## fatal

1614

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

1615

sub _msg {

1616

my $log = shift;

1617

my $prefix = shift;

1618

my $format = shift;

1619

my $buffer = sprintf $format, @_;

1620

chomp($buffer);

1621

1622

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

1623

if ($file) {

1624

$prefix .= "file $file";

1625

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

1626

$prefix .= ": ";

1627

}

1628

if ($prefix) {

1629

$buffer = "$prefix$buffer";

1630

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

1631

}

1632

$buffer .= "\n";

1633

print $buffer;

1634

1635

$msgs .= $buffer if $log;

1636

logger($buffer) if $log;

1637

1638

}

1639

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

1640

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

1641

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

1642

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

1643

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

1644

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

1645

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

1646

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

1647

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

1648

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

1649

1650

sub prettyinterval {

1651

my $interval = shift;

1652

use integer;

1653

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

1654

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

1655

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

1656

my $d = $interval;

1657

1658

my $string = "";

1659

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

1660

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

1661

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

1662

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

1663

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

1664

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

1665

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

1666

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

1667

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

1668

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

1669

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

1670

return $string;

1671

}

1672

sub interval {

1673

my $value = shift;

1674

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

1675

$value = $1;

1676

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

1677

$value = $1 * 60;

1678

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

1679

$value = $1 * 60*60;

1680

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

1681

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

1682

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

1683

$value = undef;

1684

}

1685

return $value;

1686

}

1687

sub interval_expired {

1688

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

1689

1690

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

1691

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

1692

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

1693

1694

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

1695

}

1696

1697

1698

1699

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

1700

## check_value

1701

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

1702

sub check_value {

1703

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

1704

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

1705

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

1706

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

1707

1708

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

1709

;

1710

1711

} elsif ($type eq T_DELAY) {

1712

$value = interval($value);

1713

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

1714

1715

} elsif ($type eq T_NUMBER) {

1716

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

1717

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

1718

1719

} elsif ($type eq T_BOOL) {

1720

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

1721

$value = 1;

1722

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

1723

$value = 0;

1724

} else {

1725

return undef;

1726

}

1727

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

1728

$value = lc $value;

1729

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

1730

1731

} elsif ($type eq T_FQDNP) {

1732

$value = lc $value;

1733

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

1734

1735

} elsif ($type eq T_PROTO) {

1736

$value = lc $value;

1737

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

1738

1739

} elsif ($type eq T_USE) {

1740

$value = lc $value;

1741

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

1742

1743

} elsif ($type eq T_FILE) {

1744

return undef if $value eq "";

1745

1746

} elsif ($type eq T_IF) {

1747

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

1748

1749

} elsif ($type eq T_PROG) {

1750

return undef if $value eq "";

1751

1752

} elsif ($type eq T_LOGIN) {

1753

return undef if $value eq "";

1754

1755

# } elsif ($type eq T_PASSWD) {

1756

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

1757

1758

} elsif ($type eq T_IP) {

1759

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

1760

}

1761

return $value;

1762

}

1763

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

1764

## encode_base64 - from MIME::Base64

1765

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

1766

sub encode_base64 ($;$) {

1767

my $res = '';

1768

my $eol = $_[1];

1769

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

1770

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

1771

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

1772

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

1773

chop($res);

1774

}

1775

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

1776

1777

# fix padding at the end

1778

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

1779

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

1780

$res;

1781

}

1782

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

1783

## load_ssl_support

1784

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

1785

sub load_ssl_support {

1786

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

1787

unless ($ssl_loaded) {

1788

fatal(<<"EOM");

1789

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

1790

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

1791

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

1792

EOM

1793

}

1794

import IO::Socket::SSL;

1795

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

1796

}

1797

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

1798

## load_sha1_support

1799

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

1800

sub load_sha1_support {

1801

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

1802

my $sha_loaded = eval {require Digest::SHA};

1803

unless ($sha1_loaded || $sha_loaded) {

1804

fatal(<<"EOM");

1805

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

1806

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

1807

EOM

1808

}

1809

if($sha1_loaded) {

1810

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

1811

} elsif($sha_loaded) {

1812

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

1813

}

1814

}

1815

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

1816

## geturl

1817

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

1818

sub geturl {

1819

my $proxy = shift || '';

1820

my $url = shift || '';

1821

my $login = shift || '';

1822

my $password = shift || '';

1823

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

1824

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

1825

1826

debug("proxy = $proxy");

1827

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

1828

## canonify proxy and url

1829

my $force_ssl;

1830

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

1831

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

1832

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

1833

$server = $url;

1834

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

1835

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

1836

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

1837

1838

debug("server = $server");

1839

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

1840

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

1841

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

1842

## always omit SSL for connections to local router

1843

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

1844

$use_ssl = 1;

1845

$default_port = 443;

1846

load_ssl_support;

1847

} else {

1848

$use_ssl = 0;

1849

$default_port = 80;

1850

}

1851

1852

## determine peer and port to use.

1853

$peer = $proxy || $server;

1854

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

1855

$port = $peer;

1856

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

1857

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

1858

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

1859

1860

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

1861

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

1862

1863

$request = "GET ";

1864

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

1865

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

1866

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

1867

1868

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

1869

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

1870

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

1871

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

1872

$request .= "\n";

1873

1874

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

1875

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

1876

1877

# local $^W = 0;

1878

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

1879

if (! opt('exec')) {

1880

debug("skipped network connection");

1881

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

1882

} elsif ($use_ssl) {

1883

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

1884

PeerAddr => $peer,

1885

PeerPort => $port,

1886

Proto => 'tcp',

1887

MultiHomed => 1,

1888

Timeout => opt('timeout'),

1889

);

1890

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

1891

} else {

1892

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

1893

PeerAddr => $peer,

1894

PeerPort => $port,

1895

Proto => 'tcp',

1896

MultiHomed => 1,

1897

Timeout => opt('timeout'),

1898

);

1899

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

1900

}

1901

1902

if (defined $sd) {

1903

## send the request to the http server

1904

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

1905

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

1906

1907

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

1908

my $result = syswrite $sd, $rq;

1909

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

1910

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

1911

} else {

1912

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

1913

eval {

1914

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

1915

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

1916

while ($_ = <$sd>) {

1917

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

1918

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

1919

$reply .= $_ if defined $_;

1920

}

1921

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

1922

alarm(0);

1923

}

1924

};

1925

close($sd);

1926

1927

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

1928

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

1929

$reply = '';

1930

}

1931

$reply = '' if !defined $reply;

1932

}

1933

}

1934

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

1935

1936

## during testing simulate reading the URL

1937

if (opt('test')) {

1938

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

1939

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

1940

if (opt('exec')) {

1941

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

1942

} else {

1943

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

1944

}

1945

}

1946

1947

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

1948

return $reply;

1949

}

1950

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

1951

## get_ip

1952

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

1953

sub get_ip {

1954

my $use = lc shift;

1955

my $h = shift;

1956

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

1957

$arg = '' unless $arg;

1958

1959

if ($use eq 'ip') {

1960

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

1961

$arg = 'ip';

1962

1963

} elsif ($use eq 'if') {

1964

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

1965

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

1966

$reply = `ip addr list dev $arg 2> /dev/null` if $?;

1967

$reply = '' if $?;

1968

1969

} elsif ($use eq 'cmd') {

1970

if ($arg) {

1971

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

1972

$reply = `$arg`;

1973

$reply = '' if $?;

1974

}

1975

1976

} elsif ($use eq 'web') {

1977

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

1978

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

1979

1980

if (exists $builtinweb{$url}) {

1981

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

1982

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

1983

}

1984

$arg = $url;

1985

1986

if ($url) {

1987

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

1988

}

1989

1990

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

1991

# Stuff added to support Cisco router ip http daemon

1992

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

1993

# password theft. This is pretty harmless.

1994

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

1995

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

1996

1997

# Convert slashes to protected value "\/"

1998

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

1999

2000

# Protect special HTML characters (like '?')

2001

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

2002

2003

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

2004

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

2005

$arg = $url;

2006

2007

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

2008

# Stuff added to support Cisco ASA ip https daemon

2009

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

2010

# password theft. This is pretty harmless.

2011

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

2012

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

2013

2014

# Convert slashes to protected value "\/"

2015

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

2016

2017

# Protect special HTML characters (like '?')

2018

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

2019

2020

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

2021

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

2022

$arg = $url;

2023

2024

} else {

2025

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

2026

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

2027

2028

if (exists $builtinfw{$use}) {

2029

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

2030

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

2031

}

2032

$arg = $url;

2033

2034

if ($url) {

2035

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

2036

}

2037

}

2038

if (!defined $reply) {

2039

$reply = '';

2040

}

2041

if ($skip) {

2042

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

2043

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

2044

}

2045

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

2046

$ip = $1;

2047

}

2048

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

2049

$ip = undef;

2050

}

2051

2052

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

2053

return $ip;

2054

}

2055

2056

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

2057

## group_hosts_by

2058

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

2059

sub group_hosts_by {

2060

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

2061

2062

my %groups = ();

2063

foreach my $h (@$hosts) {

2064

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

2065

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

2066

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

2067

2068

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

2069

}

2070

return %groups;

2071

}

2072

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

2073

## nic_examples

2074

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

2075

sub nic_examples {

2076

my $examples = "";

2077

my $separator = "";

2078

foreach my $s (sort keys %services) {

2079

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

2080

my $example;

2081

2082

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

2083

chomp($example);

2084

$examples .= $example;

2085

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

2086

$separator = "\n";

2087

}

2088

}

2089

my $intro = <<EoEXAMPLE;

2090

== CONFIGURING ${program}

2091

2092

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

2093

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

2094

sequences of global variable definitions and host definitions.

2095

2096

Global definitions look like:

2097

name=value [,name=value]*

2098

2099

For example:

2100

daemon=5m

2101

use=if, if=eth0

2102

proxy=proxy.myisp.com

2103

protocol=dyndns2

2104

2105

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

2106

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

2107

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

2108

as seconds (600s), minutes (5m), hours (1h) or days (1d).

2109

2110

Host definitions look like:

2111

[name=value [,name=value]*]* a.host.domain [,b.host.domain] [login] [password]

2112

2113

For example:

2114

protocol=hammernode1, \\

2115

login=my-hn-login, password=my-hn-password myhost.hn.org

2116

login=my-login, password=my-password myhost.dyndns.org,my2nd.dyndns.org

2117

2118

specifies two host definitions.

2119

2120

The first definition will use the hammernode1 protocol,

2121

my-hn-login and my-hn-password to update the ip-address of

2122

myhost.hn.org and my2ndhost.hn.org.

2123

2124

The second host definition will use the current default protocol

2125

('dyndns2'), my-login and my-password to update the ip-address of

2126

myhost.dyndns.org and my2ndhost.dyndns.org.

2127

2128

The order of this sequence is significant because the values of any

2129

global variable definitions are bound to a host definition when the

2130

host definition is encountered.

2131

2132

See the sample-${program}.conf file for further examples.

2133

EoEXAMPLE

2134

$intro .= "\n== NIC specific variables and examples:\n$examples" if $examples;

2135

return $intro;

2136

}

2137

######################################################################

2138

## nic_updateable

2139

######################################################################

2140

sub nic_updateable {

2141

my $host = shift;

2142

my $sub = shift;

2143

my $update = 0;

2144

my $ip = $config{$host}{'wantip'};

2145

2146

if ($config{$host}{'login'} eq '') {

2147

warning("null login name specified for host %s.", $host);

2148

2149

} elsif ($config{$host}{'password'} eq '') {

2150

warning("null password specified for host %s.", $host);

2151

2152

} elsif ($opt{'force'}) {

2153

info("forcing update of %s.", $host);

2154

$update = 1;

2155

2156

} elsif (!exists($cache{$host})) {

2157

info("forcing updating %s because no cached entry exists.", $host);

2158

$update = 1;

2159

2160

} elsif ($cache{$host}{'wtime'} && $cache{$host}{'wtime'} > $now) {

2161

warning("cannot update %s from %s to %s until after %s.",

2162

$host,

2163

($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'), $ip,

2164

prettytime($cache{$host}{'wtime'})

2165

);

2166

2167

} elsif ($cache{$host}{'mtime'} && interval_expired($host, 'mtime', 'max-interval')) {

2168

warning("forcing update of %s from %s to %s; %s since last update on %s.",

2169

$host,

2170

($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'), $ip,

2171

prettyinterval($config{$host}{'max-interval'}),

2172

prettytime($cache{$host}{'mtime'})

2173

);

2174

$update = 1;

2175

2176

} elsif ((!exists($cache{$host}{'ip'})) ||

2177

("$cache{$host}{'ip'}" ne "$ip")) {

2178

if (($cache{$host}{'status'} eq 'good') &&

2179

!interval_expired($host, 'mtime', 'min-interval')) {

2180

2181

warning("skipping update of %s from %s to %s.\nlast updated %s.\nWait at least %s between update attempts.",

2182

$host,

2183

($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'),

2184

$ip,

2185

($cache{$host}{'mtime'} ? prettytime($cache{$host}{'mtime'}) : '<never>'),

2186

prettyinterval($config{$host}{'min-interval'})

2187

)

2188

if opt('verbose') || !define($cache{$host}{'warned-min-interval'}, 0);

2189

2190

$cache{$host}{'warned-min-interval'} = $now;

2191

2192

} elsif (($cache{$host}{'status'} ne 'good') && !interval_expired($host, 'atime', 'min-error-interval')) {

2193

2194

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.",

2195

$host,

2196

($cache{$host}{'ip'} ? $cache{$host}{'ip'} : '<nothing>'),

2197

$ip,

2198

($cache{$host}{'mtime'} ? prettytime($cache{$host}{'mtime'}) : '<never>'),

2199

($cache{$host}{'atime'} ? prettytime($cache{$host}{'atime'}) : '<never>'),

2200

prettyinterval($config{$host}{'min-error-interval'})

2201

)

2202

if opt('verbose') || !define($cache{$host}{'warned-min-error-interval'}, 0);

2203

2204

$cache{$host}{'warned-min-error-interval'} = $now;

2205

2206

} else {

2207

$update = 1;

2208

}

2209

2210

} elsif (defined($sub) && &$sub($host)) {

2211

$update = 1;

2212

} elsif ((defined($cache{$host}{'static'}) && defined($config{$host}{'static'}) &&

2213

($cache{$host}{'static'} ne $config{$host}{'static'})) ||

2214

(defined($cache{$host}{'wildcard'}) && defined($config{$host}{'wildcard'}) &&

2215

($cache{$host}{'wildcard'} ne $config{$host}{'wildcard'})) ||

2216

(defined($cache{$host}{'mx'}) && defined($config{$host}{'mx'}) &&

2217

($cache{$host}{'mx'} ne $config{$host}{'mx'})) ||

2218

(defined($cache{$host}{'backupmx'}) && defined($config{$host}{'backupmx'}) &&

2219

($cache{$host}{'backupmx'} ne $config{$host}{'backupmx'})) ) {

2220

info("updating %s because host settings have been changed.", $host);

2221

$update = 1;

2222

2223

} else {

2224

success("%s: skipped: IP address was already set to %s.", $host, $ip)

2225

if opt('verbose');

2226

}

2227

$config{$host}{'status'} = define($cache{$host}{'status'},'');

2228

$config{$host}{'update'} = $update;

2229

if ($update) {

2230

$config{$host}{'status'} = 'noconnect';

2231

$config{$host}{'atime'} = $now;

2232

$config{$host}{'wtime'} = 0;

2233

$config{$host}{'warned-min-interval'} = 0;

2234

$config{$host}{'warned-min-error-interval'} = 0;

2235

2236

delete $cache{$host}{'warned-min-interval'};

2237

delete $cache{$host}{'warned-min-error-interval'};

2238

}

2239

2240

return $update;

2241

}

2242

######################################################################

2243

## header_ok

2244

######################################################################

2245

sub header_ok {

2246

my ($host, $line) = @_;

2247

my $ok = 0;

2248

2249

if ($line =~ m%^s*HTTP/1.*\s+(\d+)%i) {

2250

my $result = $1;

2251

2252

if ($result eq '200') {

2253

$ok = 1;

2254

2255

} elsif ($result eq '401') {

2256

failed("updating %s: authorization failed (%s)", $host, $line);

2257

}

2258

2259

} else {

2260

failed("updating %s: unexpected line (%s)", $host, $line);

2261

}

2262

return $ok;

2263

}

2264

######################################################################

2265

## nic_dyndns1_examples

2266

######################################################################

2267

sub nic_dyndns1_examples {

2268

return <<EoEXAMPLE;

2269

o 'dyndns1'

2270

2271

The 'dyndns1' protocol is a deprecated protocol used by the free dynamic

2272

DNS service offered by www.dyndns.org. The 'dyndns2' should be used to

2273

update the www.dyndns.org service. However, other services are also

2274

using this protocol so support is still provided by ${program}.

2275

2276

Configuration variables applicable to the 'dyndns1' protocol are:

2277

protocol=dyndns1 ##

2278

server=fqdn.of.service ## defaults to members.dyndns.org

2279

backupmx=no|yes ## indicates that this host is the primary MX for the domain.

2280

mx=any.host.domain ## a host MX'ing for this host definition.

2281

wildcard=no|yes ## add a DNS wildcard CNAME record that points to {host}

2282

login=service-login ## login name and password registered with the service

2283

password=service-password ##

2284

fully.qualified.host ## the host registered with the service.

2285

2286

Example ${program}.conf file entries:

2287

## single host update

2288

protocol=dyndns1, \\

2289

login=my-dyndns.org-login, \\

2290

password=my-dyndns.org-password \\

2291

myhost.dyndns.org

2292

2293

## multiple host update with wildcard'ing mx, and backupmx

2294

protocol=dyndns1, \\

2295

login=my-dyndns.org-login, \\

2296

password=my-dyndns.org-password, \\

2297

mx=a.host.willing.to.mx.for.me,backupmx=yes,wildcard=yes \\

2298

myhost.dyndns.org,my2ndhost.dyndns.org

2299

EoEXAMPLE

2300

}

2301

######################################################################

2302

## nic_dyndns1_update

2303

######################################################################

2304

sub nic_dyndns1_update {

2305

debug("\nnic_dyndns1_update -------------------");

2306

## update each configured host

2307

foreach my $h (@_) {

2308

my $ip = delete $config{$h}{'wantip'};

2309

info("setting IP address to %s for %s", $ip, $h);

2310

verbose("UPDATE:","updating %s", $h);

2311

2312

my $url;

2313

$url = "http://$config{$h}{'server'}/nic/";

2314

$url .= ynu($config{$h}{'static'}, 'statdns', 'dyndns', 'dyndns');

2315

$url .= "?action=edit&started=1&hostname=YES&host_id=$h";

2316

$url .= "&myip=";

2317

$url .= $ip if $ip;

2318

$url .= "&wildcard=ON" if ynu($config{$h}{'wildcard'}, 1, 0, 0);

2319

if ($config{$h}{'mx'}) {

2320

$url .= "&mx=$config{$h}{'mx'}";

2321

$url .= "&backmx=" . ynu($config{$h}{'backupmx'}, 'YES', 'NO');

2322

}

2323

2324

my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'});

2325

if (!defined($reply) || !$reply) {

2326

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

2327

next;

2328

}

2329

last if !header_ok($h, $reply);

2330

2331

my @reply = split /\n/, $reply;

2332

my ($title, $return_code, $error_code) = ('','','');

2333

foreach my $line (@reply) {

2334

$title = $1 if $line =~ m%<TITLE>\s*(.*)\s*</TITLE>%i;

2335

$return_code = $1 if $line =~ m%^return\s+code\s*:\s*(.*)\s*$%i;

2336

$error_code = $1 if $line =~ m%^error\s+code\s*:\s*(.*)\s*$%i;

2337

}

2338

2339

if ($return_code ne 'NOERROR' || $error_code ne 'NOERROR' || !$title) {

2340

$config{$h}{'status'} = 'failed';

2341

$title = "incomplete response from $config{$h}{server}" unless $title;

2342

warning("SENT: %s", $url) unless opt('verbose');

2343

warning("REPLIED: %s", $reply);

2344

failed("updating %s: %s", $h, $title);

2345

2346

} else {

2347

$config{$h}{'ip'} = $ip;

2348

$config{$h}{'mtime'} = $now;

2349

$config{$h}{'status'} = 'good';

2350

success("updating %s: %s: IP address set to %s (%s)", $h, $return_code, $ip, $title);

2351

}

2352

}

2353

}

2354

######################################################################

2355

## nic_dyndns2_updateable

2356

######################################################################

2357

sub nic_dyndns2_updateable {

2358

my $host = shift;

2359

my $update = 0;

2360

2361

if ($config{$host}{'mx'} ne $cache{$host}{'mx'}) {

2362

info("forcing updating %s because 'mx' has changed to %s.", $host, $config{$host}{'mx'});

2363

$update = 1;

2364

2365

} elsif ($config{$host}{'mx'} && (ynu($config{$host}{'backupmx'},1,2,3) ne ynu($config{$host}{'backupmx'},1,2,3))) {

2366

info("forcing updating %s because 'backupmx' has changed to %s.", $host, ynu($config{$host}{'backupmx'},"YES","NO","NO"));

2367

$update = 1;

2368

2369

} elsif ($config{$host}{'static'} ne $cache{$host}{'static'}) {

2370

2371

info("forcing updating %s because 'static' has changed to %s.", $host, ynu($config{$host}{'static'},"YES","NO","NO"));

2372

$update = 1;

2373

2374

}

2375

return $update;

2376

}

2377

######################################################################

2378

## nic_dyndns2_examples

2379

######################################################################

2380

sub nic_dyndns2_examples {

2381

return <<EoEXAMPLE;

2382

o 'dyndns2'

2383

2384

The 'dyndns2' protocol is a newer low-bandwidth protocol used by a

2385

free dynamic DNS service offered by www.dyndns.org. It supports

2386

features of the older 'dyndns1' in addition to others. [These will be

2387

supported in a future version of ${program}.]

2388

2389

Configuration variables applicable to the 'dyndns2' protocol are:

2390

protocol=dyndns2 ##

2391

server=fqdn.of.service ## defaults to members.dyndns.org

2392

script=/path/to/script ## defaults to /nic/update

2393

backupmx=no|yes ## indicates that this host is the primary MX for the domain.

2394

static=no|yes ## indicates that this host has a static IP address.

2395

custom=no|yes ## indicates that this host is a 'custom' top-level domain name.

2396

mx=any.host.domain ## a host MX'ing for this host definition.

2397

wildcard=no|yes ## add a DNS wildcard CNAME record that points to {host}

2398

login=service-login ## login name and password registered with the service

2399

password=service-password ##

2400

fully.qualified.host ## the host registered with the service.

2401

2402

Example ${program}.conf file entries:

2403

## single host update

2404

protocol=dyndns2, \\

2405

login=my-dyndns.org-login, \\

2406

password=my-dyndns.org-password \\

2407

myhost.dyndns.org

2408

2409

## multiple host update with wildcard'ing mx, and backupmx

2410

protocol=dyndns2, \\

2411

login=my-dyndns.org-login, \\

2412

password=my-dyndns.org-password, \\

2413

mx=a.host.willing.to.mx.for.me,backupmx=yes,wildcard=yes \\

2414

myhost.dyndns.org,my2ndhost.dyndns.org

2415

2416

## multiple host update to the custom DNS service

2417

protocol=dyndns2, \\

2418

login=my-dyndns.org-login, \\

2419

password=my-dyndns.org-password \\

2420

my-toplevel-domain.com,my-other-domain.com

2421

EoEXAMPLE

2422

}

2423

######################################################################

2424

## nic_dyndns2_update

2425

######################################################################

2426

sub nic_dyndns2_update {

2427

debug("\nnic_dyndns2_update -------------------");

2428

2429

## group hosts with identical attributes together

2430

my %groups = group_hosts_by([ @_ ], [ qw(login password server static custom wildcard mx backupmx) ]);

2431

2432

my %errors = (

2433

'badauth' => 'Bad authorization (username or password)',

2434

'badsys' => 'The system parameter given was not valid',

2435

2436

'notfqdn' => 'A Fully-Qualified Domain Name was not provided',

2437

'nohost' => 'The hostname specified does not exist in the database',

2438

'!yours' => 'The hostname specified exists, but not under the username currently being used',

2439

'!donator' => 'The offline setting was set, when the user is not a donator',

2440

'!active' => 'The hostname specified is in a Custom DNS domain which has not yet been activated.',

2441

'abuse', => 'The hostname specified is blocked for abuse; you should receive an email notification ' .

2442

'which provides an unblock request link. More info can be found on ' .

2443

'https://www.dyndns.com/support/abuse.html',

2444

2445

'numhost' => 'System error: Too many or too few hosts found. Contact support@dyndns.org',

2446

'dnserr' => 'System error: DNS error encountered. Contact support@dyndns.org',

2447

2448

'nochg' => 'No update required; unnecessary attempts to change to the current address are considered abusive',

2449

);

2450

2451

## update each set of hosts that had similar configurations

2452

foreach my $sig (keys %groups) {

2453

my @hosts = @{$groups{$sig}};

2454

my $hosts = join(',', @hosts);

2455

my $h = $hosts[0];

2456

my $ip = $config{$h}{'wantip'};

2457

delete $config{$_}{'wantip'} foreach @hosts;

2458

2459

info("setting IP address to %s for %s", $ip, $hosts);

2460

verbose("UPDATE:","updating %s", $hosts);

2461

2462

## Select the DynDNS system to update

2463

my $url = "http://$config{$h}{'server'}$config{$h}{'script'}?system=";

2464

if ($config{$h}{'custom'}) {

2465

warning("updating %s: 'custom' and 'static' may not be used together. ('static' ignored)", $hosts)

2466

if $config{$h}{'static'};

2467

# warning("updating %s: 'custom' and 'offline' may not be used together. ('offline' ignored)", $hosts)

2468

# if $config{$h}{'offline'};

2469

$url .= 'custom';

2470

2471

} elsif ($config{$h}{'static'}) {

2472

# warning("updating %s: 'static' and 'offline' may not be used together. ('offline' ignored)", $hosts)

2473

# if $config{$h}{'offline'};

2474

$url .= 'statdns';

2475

2476

} else {

2477

$url .= 'dyndns';

2478

}

2479

2480

$url .= "&hostname=$hosts";

2481

$url .= "&myip=";

2482

$url .= $ip if $ip;

2483

2484

## some args are not valid for a custom domain.

2485

$url .= "&wildcard=ON" if ynu($config{$h}{'wildcard'}, 1, 0, 0);

2486

if ($config{$h}{'mx'}) {

2487

$url .= "&mx=$config{$h}{'mx'}";

2488

$url .= "&backmx=" . ynu($config{$h}{'backupmx'}, 'YES', 'NO');

2489

}

2490

2491

my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'});

2492

if (!defined($reply) || !$reply) {

2493

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});

2494

last;

2495

}

2496

last if !header_ok($hosts, $reply);

2497

2498

my @reply = split /\n/, $reply;

2499

my $state = 'header';

2500

my $returnedip = $ip;

2501

2502

foreach my $line (@reply) {

2503

if ($state eq 'header') {

2504

$state = 'body';

2505

2506

} elsif ($state eq 'body') {

2507

$state = 'results' if $line eq '';

2508

2509

} elsif ($state =~ /^results/) {

2510

$state = 'results2';

2511

2512

# bug #10: some dyndns providers does not return the IP so

2513

# we can't use the returned IP

2514

my ($status, $returnedip) = split / /, lc $line;

2515

$ip = $returnedip if (not $ip);

2516

my $h = shift @hosts;

2517

2518

$config{$h}{'status'} = $status;

2519

if ($status eq 'good') {

2520

$config{$h}{'ip'} = $ip;

2521

$config{$h}{'mtime'} = $now;

2522

success("updating %s: %s: IP address set to %s", $h, $status, $ip);

2523

2524

} elsif (exists $errors{$status}) {

2525

if ($status eq 'nochg') {

2526

warning("updating %s: %s: %s", $h, $status, $errors{$status});

2527

$config{$h}{'ip'} = $ip;

2528

$config{$h}{'mtime'} = $now;

2529

$config{$h}{'status'} = 'good';

2530

2531

} else {

2532

failed("updating %s: %s: %s", $h, $status, $errors{$status});

2533

}

2534

2535

} elsif ($status =~ /w(\d+)(.)/) {

2536

my ($wait, $units) = ($1, lc $2);

2537

my ($sec, $scale) = ($wait, 1);

2538

2539

($scale, $units) = (1, 'seconds') if $units eq 's';

2540

($scale, $units) = (60, 'minutes') if $units eq 'm';

2541

($scale, $units) = (60*60, 'hours') if $units eq 'h';

2542

2543

$sec = $wait * $scale;

2544

$config{$h}{'wtime'} = $now + $sec;

2545

warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip);

2546

2547

} else {

2548

failed("updating %s: %s: unexpected status (%s)", $h, $line);

2549

}

2550

}

2551

}

2552

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'})

2553

if $state ne 'results2';

2554

}

2555

}

2556

2557

2558

######################################################################

2559

## nic_noip_update

2560

## Note: uses same features as nic_dyndns2_update, less return codes

2561

######################################################################

2562

sub nic_noip_update {

2563

debug("\nnic_noip_update -------------------");

2564

2565

## group hosts with identical attributes together

2566

my %groups = group_hosts_by([ @_ ], [ qw(login password server static custom wildcard mx backupmx) ]);

2567

2568

my %errors = (

2569

'badauth' => 'Invalid username or password',

2570

'badagent' => 'Invalid user agent',

2571

'nohost' => 'The hostname specified does not exist in the database',

2572

'!donator' => 'The offline setting was set, when the user is not a donator',

2573

'abuse', => 'The hostname specified is blocked for abuse; open a trouble ticket at http://www.no-ip.com',

2574

'numhost' => 'System error: Too many or too few hosts found. open a trouble ticket at http://www.no-ip.com',

2575

'dnserr' => 'System error: DNS error encountered. Contact support@dyndns.org',

2576

'nochg' => 'No update required; unnecessary attempts to change to the current address are considered abusive',

2577

);

2578

2579

## update each set of hosts that had similar configurations

2580

foreach my $sig (keys %groups) {

2581

my @hosts = @{$groups{$sig}};

2582

my $hosts = join(',', @hosts);

2583

my $h = $hosts[0];

2584

my $ip = $config{$h}{'wantip'};

2585

delete $config{$_}{'wantip'} foreach @hosts;

2586

2587

info("setting IP address to %s for %s", $ip, $hosts);

2588

verbose("UPDATE:","updating %s", $hosts);

2589

2590

my $url = "http://$config{$h}{'server'}/nic/update?system=";

2591

$url .= 'noip';

2592

$url .= "&hostname=$hosts";

2593

$url .= "&myip=";

2594

$url .= $ip if $ip;

2595

2596

2597

print "here..." . $config{$h}{'login'} . " --> " . $config{$h}{'password'} . "\n";

2598

2599

2600

my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'});

2601

if (!defined($reply) || !$reply) {

2602

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});

2603

last;

2604

}

2605

last if !header_ok($hosts, $reply);

2606

2607

my @reply = split /\n/, $reply;

2608

my $state = 'header';

2609

foreach my $line (@reply) {

2610

if ($state eq 'header') {

2611

$state = 'body';

2612

2613

} elsif ($state eq 'body') {

2614

$state = 'results' if $line eq '';

2615

2616

} elsif ($state =~ /^results/) {

2617

$state = 'results2';

2618

2619

my ($status, $ip) = split / /, lc $line;

2620

my $h = shift @hosts;

2621

2622

$config{$h}{'status'} = $status;

2623

if ($status eq 'good') {

2624

$config{$h}{'ip'} = $ip;

2625

$config{$h}{'mtime'} = $now;

2626

success("updating %s: %s: IP address set to %s", $h, $status, $ip);

2627

2628

} elsif (exists $errors{$status}) {

2629

if ($status eq 'nochg') {

2630

warning("updating %s: %s: %s", $h, $status, $errors{$status});

2631

$config{$h}{'ip'} = $ip;

2632

$config{$h}{'mtime'} = $now;

2633

$config{$h}{'status'} = 'good';

2634

2635

} else {

2636

failed("updating %s: %s: %s", $h, $status, $errors{$status});

2637

}

2638

2639

} elsif ($status =~ /w(\d+)(.)/) {

2640

my ($wait, $units) = ($1, lc $2);

2641

my ($sec, $scale) = ($wait, 1);

2642

2643

($scale, $units) = (1, 'seconds') if $units eq 's';

2644

($scale, $units) = (60, 'minutes') if $units eq 'm';

2645

($scale, $units) = (60*60, 'hours') if $units eq 'h';

2646

2647

$sec = $wait * $scale;

2648

$config{$h}{'wtime'} = $now + $sec;

2649

warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip);

2650

2651

} else {

2652

failed("updating %s: %s: unexpected status (%s)", $h, $line);

2653

}

2654

}

2655

}

2656

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'})

2657

if $state ne 'results2';

2658

}

2659

}

2660

######################################################################

2661

## nic_noip_examples

2662

######################################################################

2663

sub nic_noip_examples {

2664

return <<EoEXAMPLE;

2665

o 'noip'

2666

2667

The 'No-IP Compatible' protocol is used to make dynamic dns updates

2668

over an http request. Details of the protocol are outlined at:

2669

http://www.no-ip.com/integrate/

2670

2671

Configuration variables applicable to the 'noip' protocol are:

2672

protocol=noip ##

2673

server=fqdn.of.service ## defaults to dynupdate.no-ip.com

2674

login=service-login ## login name and password registered with the service

2675

password=service-password ##

2676

fully.qualified.host ## the host registered with the service.

2677

2678

Example ${program}.conf file entries:

2679

## single host update

2680

protocol=noip, \\

2681

login=userlogin\@domain.com, \\

2682

password=noip-password \\

2683

myhost.no-ip.biz

2684

2685

2686

EoEXAMPLE

2687

}

2688

2689

######################################################################

2690

## nic_concont_examples

2691

######################################################################

2692

sub nic_concont_examples {

2693

return <<EoEXAMPLE;

2694

o 'concont'

2695

2696

The 'concont' protocol is the protocol used by the content management

2697

system ConCont's dydns module. This is currently used by the free

2698

dynamic DNS service offered by Tyrmida at www.dydns.za.net

2699

2700

Configuration variables applicable to the 'concont' protocol are:

2701

protocol=concont ##

2702

server=www.fqdn.of.service ## for example www.dydns.za.net (for most add a www)

2703

login=service-login ## login registered with the service

2704

password=service-password ## password registered with the service

2705

mx=mail.server.fqdn ## fqdn of the server handling domain\'s mail (leave out for none)

2706

wildcard=yes|no ## set yes for wild (*.host.domain) support

2707

fully.qualified.host ## the host registered with the service.

2708

2709

Example ${program}.conf file entries:

2710

## single host update

2711

protocol=concont, \\

2712

login=dydns.za.net, \\

2713

password=my-dydns.za.net-password, \\

2714

mx=mailserver.fqdn, \\

2715

wildcard=yes \\

2716

myhost.hn.org

2717

2718

EoEXAMPLE

2719

}

2720

######################################################################

2721

## nic_concont_update

2722

######################################################################

2723

sub nic_concont_update {

2724

debug("\nnic_concont_update -------------------");

2725

2726

## update each configured host

2727

foreach my $h (@_) {

2728

my $ip = delete $config{$h}{'wantip'};

2729

info("setting IP address to %s for %s", $ip, $h);

2730

verbose("UPDATE:","updating %s", $h);

2731

2732

# Set the URL that we're going to to update

2733

my $url;

2734

$url = "http://$config{$h}{'server'}/modules/dydns/update.php";

2735

$url .= "?username=";

2736

$url .= $config{$h}{'login'};

2737

$url .= "&password=";

2738

$url .= $config{$h}{'password'};

2739

$url .= "&wildcard=";

2740

$url .= $config{$h}{'wildcard'};

2741

$url .= "&mx=";

2742

$url .= $config{$h}{'mx'};

2743

$url .= "&host=";

2744

$url .= $h;

2745

$url .= "&ip=";

2746

$url .= $ip;

2747

2748

# Try to get URL

2749

my $reply = geturl(opt('proxy'), $url);

2750

2751

# No response, declare as failed

2752

if (!defined($reply) || !$reply) {

2753

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

2754

last;

2755

}

2756

last if !header_ok($h, $reply);

2757

2758

# Response found, just declare as success (this is ugly, we need more error checking)

2759

if ($reply =~ /SUCCESS/)

2760

{

2761

$config{$h}{'ip'} = $ip;

2762

$config{$h}{'mtime'} = $now;

2763

$config{$h}{'status'} = 'good';

2764

success("updating %s: good: IP address set to %s", $h, $ip);

2765

}

2766

else

2767

{

2768

my @reply = split /\n/, $reply;

2769

my $returned = pop(@reply);

2770

$config{$h}{'status'} = 'failed';

2771

failed("updating %s: Server said: '$returned'", $h);

2772

}

2773

}

2774

}

2775

######################################################################

2776

## nic_dslreports1_examples

2777

######################################################################

2778

sub nic_dslreports1_examples {

2779

return <<EoEXAMPLE;

2780

o 'dslreports1'

2781

2782

The 'dslreports1' protocol is used by a free DSL monitoring service

2783

offered by www.dslreports.com.

2784

2785

Configuration variables applicable to the 'dslreports1' protocol are:

2786

protocol=dslreports1 ##

2787

server=fqdn.of.service ## defaults to www.dslreports.com

2788

login=service-login ## login name and password registered with the service

2789

password=service-password ##

2790

unique-number ## the host registered with the service.

2791

2792

Example ${program}.conf file entries:

2793

## single host update

2794

protocol=dslreports1, \\

2795

server=www.dslreports.com, \\

2796

login=my-dslreports-login, \\

2797

password=my-dslreports-password \\

2798

123456

2799

2800

Note: DSL Reports uses a unique number as the host name. This number

2801

can be found on the Monitor Control web page.

2802

EoEXAMPLE

2803

}

2804

######################################################################

2805

## nic_dslreports1_update

2806

######################################################################

2807

sub nic_dslreports1_update {

2808

debug("\nnic_dslreports1_update -------------------");

2809

## update each configured host

2810

foreach my $h (@_) {

2811

my $ip = delete $config{$h}{'wantip'};

2812

info("setting IP address to %s for %s", $ip, $h);

2813

verbose("UPDATE:","updating %s", $h);

2814

2815

my $url;

2816

$url = "http://$config{$h}{'server'}/nic/";

2817

$url .= ynu($config{$h}{'static'}, 'statdns', 'dyndns', 'dyndns');

2818

$url .= "?action=edit&started=1&hostname=YES&host_id=$h";

2819

$url .= "&myip=";

2820

$url .= $ip if $ip;

2821

2822

my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'});

2823

if (!defined($reply) || !$reply) {

2824

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

2825

next;

2826

}

2827

2828

my @reply = split /\n/, $reply;

2829

my $return_code = '';

2830

foreach my $line (@reply) {

2831

$return_code = $1 if $line =~ m%^return\s+code\s*:\s*(.*)\s*$%i;

2832

}

2833

2834

if ($return_code !~ /NOERROR/) {

2835

$config{$h}{'status'} = 'failed';

2836

warning("SENT: %s", $url) unless opt('verbose');

2837

warning("REPLIED: %s", $reply);

2838

failed("updating %s", $h);

2839

2840

} else {

2841

$config{$h}{'ip'} = $ip;

2842

$config{$h}{'mtime'} = $now;

2843

$config{$h}{'status'} = 'good';

2844

success("updating %s: %s: IP address set to %s", $h, $return_code, $ip);

2845

}

2846

}

2847

}

2848

######################################################################

2849

## nic_hammernode1_examples

2850

######################################################################

2851

sub nic_hammernode1_examples {

2852

return <<EoEXAMPLE;

2853

o 'hammernode1'

2854

2855

The 'hammernode1' protocol is the protocol used by the free dynamic

2856

DNS service offered by Hammernode at www.hn.org

2857

2858

Configuration variables applicable to the 'hammernode1' protocol are:

2859

protocol=hammernode1 ##

2860

server=fqdn.of.service ## defaults to members.dyndns.org

2861

login=service-login ## login name and password registered with the service

2862

password=service-password ##

2863

fully.qualified.host ## the host registered with the service.

2864

2865

Example ${program}.conf file entries:

2866

## single host update

2867

protocol=hammernode1, \\

2868

login=my-hn.org-login, \\

2869

password=my-hn.org-password \\

2870

myhost.hn.org

2871

2872

## multiple host update

2873

protocol=hammernode1, \\

2874

login=my-hn.org-login, \\

2875

password=my-hn.org-password, \\

2876

myhost.hn.org,my2ndhost.hn.org

2877

EoEXAMPLE

2878

}

2879

######################################################################

2880

## nic_hammernode1_update

2881

######################################################################

2882

sub nic_hammernode1_update {

2883

debug("\nnic_hammernode1_update -------------------");

2884

2885

## update each configured host

2886

foreach my $h (@_) {

2887

my $ip = delete $config{$h}{'wantip'};

2888

info("setting IP address to %s for %s", $ip, $h);

2889

verbose("UPDATE:","updating %s", $h);

2890

2891

my $url;

2892

$url = "http://$config{$h}{'server'}/vanity/update";

2893

$url .= "?ver=1";

2894

$url .= "&ip=";

2895

$url .= $ip if $ip;

2896

2897

my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'});

2898

if (!defined($reply) || !$reply) {

2899

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

2900

last;

2901

}

2902

last if !header_ok($h, $reply);

2903

2904

my @reply = split /\n/, $reply;

2905

if (grep //i, @reply) {

2906

$config{$h}{'ip'} = $ip;

2907

$config{$h}{'mtime'} = $now;

2908

$config{$h}{'status'} = 'good';

2909

success("updating %s: good: IP address set to %s", $h, $ip);

2910

} else {

2911

$config{$h}{'status'} = 'failed';

2912

warning("SENT: %s", $url) unless opt('verbose');

2913

warning("REPLIED: %s", $reply);

2914

failed("updating %s: Invalid reply.", $h);

2915

}

2916

}

2917

}

2918

######################################################################

2919

## nic_zoneedit1_examples

2920

######################################################################

2921

sub nic_zoneedit1_examples {

2922

return <<EoEXAMPLE;

2923

o 'zoneedit1'

2924

2925

The 'zoneedit1' protocol is used by a DNS service offered by

2926

www.zoneedit.com.

2927

2928

Configuration variables applicable to the 'zoneedit1' protocol are:

2929

protocol=zoneedit1 ##

2930

server=fqdn.of.service ## defaults to www.zoneedit.com

2931

zone=zone-where-domains-are ## only needed if 1 or more subdomains are deeper

2932

## than 1 level in relation to the zone where it

2933

## is defined. For example, b.foo.com in a zone

2934

## foo.com doesn't need this, but a.b.foo.com in

2935

## the same zone needs zone=foo.com

2936

login=service-login ## login name and password registered with the service

2937

password=service-password ##

2938

your.domain.name ## the host registered with the service.

2939

2940

Example ${program}.conf file entries:

2941

## single host update

2942

protocol=zoneedit1, \\

2943

server=dynamic.zoneedit.com, \\

2944

zone=zone-where-domains-are, \\

2945

login=my-zoneedit-login, \\

2946

password=my-zoneedit-password \\

2947

my.domain.name

2948

EoEXAMPLE

2949

}

2950

2951

######################################################################

2952

## nic_zoneedit1_updateable

2953

######################################################################

2954

sub nic_zoneedit1_updateable {

2955

return 0;

2956

}

2957

2958

######################################################################

2959

## nic_zoneedit1_update

2960

# <SUCCESS CODE="200" TEXT="Update succeeded." ZONE="trialdomain.com" IP="127.0.0.12">

2961

# <SUCCESS CODE="201" TEXT="No records need updating." ZONE="bannedware.com">

2962

# <ERROR CODE="701" TEXT="Zone is not set up in this account." ZONE="bad.com">

2963

######################################################################

2964

sub nic_zoneedit1_update {

2965

debug("\nnic_zoneedit1_update -------------------");

2966

2967

## group hosts with identical attributes together

2968

my %groups = group_hosts_by([ @_ ], [ qw(login password server zone) ]);

2969

2970

## update each set of hosts that had similar configurations

2971

foreach my $sig (keys %groups) {

2972

my @hosts = @{$groups{$sig}};

2973

my $hosts = join(',', @hosts);

2974

my $h = $hosts[0];

2975

my $ip = $config{$h}{'wantip'};

2976

delete $config{$_}{'wantip'} foreach @hosts;

2977

2978

info("setting IP address to %s for %s", $ip, $hosts);

2979

verbose("UPDATE:","updating %s", $hosts);

2980

2981

my $url = '';

2982

$url .= "http://$config{$h}{'server'}/auth/dynamic.html";

2983

$url .= "?host=$hosts";

2984

$url .= "&dnsto=$ip" if $ip;

2985

$url .= "&zone=$config{$h}{'zone'}" if defined $config{$h}{'zone'};

2986

2987

my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'});

2988

if (!defined($reply) || !$reply) {

2989

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});

2990

last;

2991

}

2992

last if !header_ok($hosts, $reply);

2993

2994

my @reply = split /\n/, $reply;

2995

foreach my $line (@reply) {

2996

if ($line =~ /^[^<]*<(SUCCESS|ERROR)\s+([^>]+)>(.*)/) {

2997

my ($status, $assignments, $rest) = ($1, $2, $3);

2998

my ($left, %var) = parse_assignments($assignments);

2999

3000

if (keys %var) {

3001

my ($status_code, $status_text, $status_ip) = ('999', '', $ip);

3002

$status_code = $var{'CODE'} if exists $var{'CODE'};

3003

$status_text = $var{'TEXT'} if exists $var{'TEXT'};

3004

$status_ip = $var{'IP'} if exists $var{'IP'};

3005

3006

if ($status eq 'SUCCESS' || ($status eq 'ERROR' && $var{'CODE'} eq '707')) {

3007

$config{$h}{'ip'} = $status_ip;

3008

$config{$h}{'mtime'} = $now;

3009

$config{$h}{'status'} = 'good';

3010

3011

success("updating %s: IP address set to %s (%s: %s)", $h, $ip, $status_code, $status_text);

3012

3013

} else {

3014

$config{$h}{'status'} = 'failed';

3015

failed("updating %s: %s: %s", $h, $status_code, $status_text);

3016

}

3017

shift @hosts;

3018

$h = $hosts[0];

3019

$hosts = join(',', @hosts);

3020

}

3021

$line = $rest;

3022

redo if $line;

3023

}

3024

}

3025

failed("updating %s: no response from %s", $hosts, $config{$h}{'server'})

3026

if @hosts;

3027

}

3028

}

3029

######################################################################

3030

## nic_easydns_updateable

3031

######################################################################

3032

sub nic_easydns_updateable {

3033

my $host = shift;

3034

my $update = 0;

3035

3036

if ($config{$host}{'mx'} ne $cache{$host}{'mx'}) {

3037

info("forcing updating %s because 'mx' has changed to %s.", $host, $config{$host}{'mx'});

3038

$update = 1;

3039

3040

} elsif ($config{$host}{'mx'} && (ynu($config{$host}{'backupmx'},1,2,3) ne ynu($config{$host}{'backupmx'},1,2,3))) {

3041

info("forcing updating %s because 'backupmx' has changed to %s.", $host, ynu($config{$host}{'backupmx'},"YES","NO","NO"));

3042

$update = 1;

3043

3044

} elsif ($config{$host}{'static'} ne $cache{$host}{'static'}) {

3045

3046

info("forcing updating %s because 'static' has changed to %s.", $host, ynu($config{$host}{'static'},"YES","NO","NO"));

3047

$update = 1;

3048

3049

}

3050

return $update;

3051

}

3052

######################################################################

3053

## nic_easydns_examples

3054

######################################################################

3055

sub nic_easydns_examples {

3056

return <<EoEXAMPLE;

3057

o 'easydns'

3058

3059

The 'easydns' protocol is used by the for fee DNS service offered

3060

by www.easydns.com.

3061

3062

Configuration variables applicable to the 'easydns' protocol are:

3063

protocol=easydns ##

3064

server=fqdn.of.service ## defaults to members.easydns.com

3065

backupmx=no|yes ## indicates that EasyDNS should be the secondary MX

3066

## for this domain or host.

3067

mx=any.host.domain ## a host MX'ing for this host or domain.

3068

wildcard=no|yes ## add a DNS wildcard CNAME record that points to {host}

3069

login=service-login ## login name and password registered with the service

3070

password=service-password ##

3071

fully.qualified.host ## the host registered with the service.

3072

3073

Example ${program}.conf file entries:

3074

## single host update

3075

protocol=easydns, \\

3076

login=my-easydns.com-login, \\

3077

password=my-easydns.com-password \\

3078

myhost.easydns.com

3079

3080

## multiple host update with wildcard'ing mx, and backupmx

3081

protocol=easydns, \\

3082

login=my-easydns.com-login, \\

3083

password=my-easydns.com-password, \\

3084

mx=a.host.willing.to.mx.for.me, \\

3085

backupmx=yes, \\

3086

wildcard=yes \\

3087

my-toplevel-domain.com,my-other-domain.com

3088

3089

## multiple host update to the custom DNS service

3090

protocol=easydns, \\

3091

login=my-easydns.com-login, \\

3092

password=my-easydns.com-password \\

3093

my-toplevel-domain.com,my-other-domain.com

3094

EoEXAMPLE

3095

}

3096

######################################################################

3097

## nic_easydns_update

3098

######################################################################

3099

sub nic_easydns_update {

3100

debug("\nnic_easydns_update -------------------");

3101

3102

## group hosts with identical attributes together

3103

## my %groups = group_hosts_by([ @_ ], [ qw(login password server wildcard mx backupmx) ]);

3104

3105

## each host is in a group by itself

3106

my %groups = map { $_ => [ $_ ] } @_;

3107

3108

my %errors = (

3109

'NOACCESS' => 'Authentication failed. This happens if the username/password OR host or domain are wrong.',

3110

'NOSERVICE'=> 'Dynamic DNS is not turned on for this domain.',

3111

'ILLEGAL' => 'Client sent data that is not allowed in a dynamic DNS update.',

3112

'TOOSOON' => 'Update frequency is too short.',

3113

);

3114

3115

## update each set of hosts that had similar configurations

3116

foreach my $sig (keys %groups) {

3117

my @hosts = @{$groups{$sig}};

3118

my $hosts = join(',', @hosts);

3119

my $h = $hosts[0];

3120

my $ip = $config{$h}{'wantip'};

3121

delete $config{$_}{'wantip'} foreach @hosts;

3122

3123

info("setting IP address to %s for %s", $ip, $hosts);

3124

verbose("UPDATE:","updating %s", $hosts);

3125

3126

#'http://members.easydns.com/dyn/dyndns.php?hostname=test.burry.ca&myip=10.20.30.40&wildcard=ON'

3127

3128

my $url;

3129

$url = "http://$config{$h}{'server'}/dyn/dyndns.php?";

3130

$url .= "hostname=$hosts";

3131

$url .= "&myip=";

3132

$url .= $ip if $ip;

3133

$url .= "&wildcard=" . ynu($config{$h}{'wildcard'}, 'ON', 'OFF', 'OFF') if defined $config{$h}{'wildcard'};

3134

3135

if ($config{$h}{'mx'}) {

3136

$url .= "&mx=$config{$h}{'mx'}";

3137

$url .= "&backmx=" . ynu($config{$h}{'backupmx'}, 'YES', 'NO');

3138

}

3139

3140

my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'});

3141

if (!defined($reply) || !$reply) {

3142

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});

3143

last;

3144

}

3145

last if !header_ok($hosts, $reply);

3146

3147

my @reply = split /\n/, $reply;

3148

my $state = 'header';

3149

foreach my $line (@reply) {

3150

if ($state eq 'header') {

3151

$state = 'body';

3152

3153

} elsif ($state eq 'body') {

3154

$state = 'results' if $line eq '';

3155

3156

} elsif ($state =~ /^results/) {

3157

$state = 'results2';

3158

3159

my ($status) = $line =~ /^(\S*)\b.*/;

3160

my $h = shift @hosts;

3161

3162

$config{$h}{'status'} = $status;

3163

if ($status eq 'NOERROR') {

3164

$config{$h}{'ip'} = $ip;

3165

$config{$h}{'mtime'} = $now;

3166

success("updating %s: %s: IP address set to %s", $h, $status, $ip);

3167

3168

} elsif ($status =~ /TOOSOON/) {

3169

## make sure we wait at least a little

3170

my ($wait, $units) = (5, 'm');

3171

my ($sec, $scale) = ($wait, 1);

3172

3173

($scale, $units) = (1, 'seconds') if $units eq 's';

3174

($scale, $units) = (60, 'minutes') if $units eq 'm';

3175

($scale, $units) = (60*60, 'hours') if $units eq 'h';

3176

$config{$h}{'wtime'} = $now + $sec;

3177

warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip);

3178

3179

} elsif (exists $errors{$status}) {

3180

failed("updating %s: %s: %s", $h, $line, $errors{$status});

3181

3182

} else {

3183

failed("updating %s: %s: unexpected status (%s)", $h, $line);

3184

}

3185

last;

3186

}

3187

}

3188

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'})

3189

if $state ne 'results2';

3190

}

3191

}

3192

######################################################################

3193

3194

######################################################################

3195

## nic_dnspark_updateable

3196

######################################################################

3197

sub nic_dnspark_updateable {

3198

my $host = shift;

3199

my $update = 0;

3200

3201

if ($config{$host}{'mx'} ne $cache{$host}{'mx'}) {

3202

info("forcing updating %s because 'mx' has changed to %s.", $host, $config{$host}{'mx'});

3203

$update = 1;

3204

3205

} elsif ($config{$host}{'mx'} && ($config{$host}{'mxpri'} ne $cache{$host}{'mxpri'})) {

3206

info("forcing updating %s because 'mxpri' has changed to %s.", $host, $config{$host}{'mxpri'});

3207

$update = 1;

3208

}

3209

return $update;

3210

}

3211

######################################################################

3212

## nic_dnspark_examples

3213

######################################################################

3214

sub nic_dnspark_examples {

3215

return <<EoEXAMPLE;

3216

o 'dnspark'

3217

3218

The 'dnspark' protocol is used by DNS service offered by www.dnspark.com.

3219

3220

Configuration variables applicable to the 'dnspark' protocol are:

3221

protocol=dnspark ##

3222

server=fqdn.of.service ## defaults to www.dnspark.com

3223

backupmx=no|yes ## indicates that DNSPark should be the secondary MX

3224

## for this domain or host.

3225

mx=any.host.domain ## a host MX'ing for this host or domain.

3226

mxpri=priority ## MX priority.

3227

login=service-login ## login name and password registered with the service

3228

password=service-password ##

3229

fully.qualified.host ## the host registered with the service.

3230

3231

Example ${program}.conf file entries:

3232

## single host update

3233

protocol=dnspark, \\

3234

login=my-dnspark.com-login, \\

3235

password=my-dnspark.com-password \\

3236

myhost.dnspark.com

3237

3238

## multiple host update with wildcard'ing mx, and backupmx

3239

protocol=dnspark, \\

3240

login=my-dnspark.com-login, \\

3241

password=my-dnspark.com-password, \\

3242

mx=a.host.willing.to.mx.for.me, \\

3243

mxpri=10, \\

3244

my-toplevel-domain.com,my-other-domain.com

3245

3246

## multiple host update to the custom DNS service

3247

protocol=dnspark, \\

3248

login=my-dnspark.com-login, \\

3249

password=my-dnspark.com-password \\

3250

my-toplevel-domain.com,my-other-domain.com

3251

EoEXAMPLE

3252

}

3253

######################################################################

3254

## nic_dnspark_update

3255

######################################################################

3256

sub nic_dnspark_update {

3257

debug("\nnic_dnspark_update -------------------");

3258

3259

## group hosts with identical attributes together

3260

## my %groups = group_hosts_by([ @_ ], [ qw(login password server wildcard mx backupmx) ]);

3261

3262

## each host is in a group by itself

3263

my %groups = map { $_ => [ $_ ] } @_;

3264

3265

my %errors = (

3266

'nochange' => 'No changes made to the hostname(s). Continual updates with no changes lead to blocked clients.',

3267

'nofqdn' => 'No valid FQDN (fully qualified domain name) was specified',

3268

'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.',

3269

'abuse' => 'The hostname specified has been blocked for abuse.',

3270

'unauth' => 'The username specified is not authorized to update this hostname and domain.',

3271

'blocked' => 'The dynamic update client (specified by the user-agent) has been blocked from the system.',

3272

'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.',

3273

);

3274

3275

## update each set of hosts that had similar configurations

3276

foreach my $sig (keys %groups) {

3277

my @hosts = @{$groups{$sig}};

3278

my $hosts = join(',', @hosts);

3279

my $h = $hosts[0];

3280

my $ip = $config{$h}{'wantip'};

3281

delete $config{$_}{'wantip'} foreach @hosts;

3282

3283

info("setting IP address to %s for %s", $ip, $hosts);

3284

verbose("UPDATE:","updating %s", $hosts);

3285

3286

#'http://www.dnspark.com:80/visitors/update.html?myip=10.20.30.40&hostname=test.burry.ca'

3287

3288

my $url;

3289

$url = "http://$config{$h}{'server'}/visitors/update.html";

3290

$url .= "?hostname=$hosts";

3291

$url .= "&myip=";

3292

$url .= $ip if $ip;

3293

3294

if ($config{$h}{'mx'}) {

3295

$url .= "&mx=$config{$h}{'mx'}";

3296

$url .= "&mxpri=" . $config{$h}{'mxpri'};

3297

}

3298

3299

my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'});

3300

if (!defined($reply) || !$reply) {

3301

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'});

3302

last;

3303

}

3304

last if !header_ok($hosts, $reply);

3305

3306

my @reply = split /\n/, $reply;

3307

my $state = 'header';

3308

foreach my $line (@reply) {

3309

if ($state eq 'header') {

3310

$state = 'body';

3311

3312

} elsif ($state eq 'body') {

3313

$state = 'results' if $line eq '';

3314

3315

} elsif ($state =~ /^results/) {

3316

$state = 'results2';

3317

3318

my ($status) = $line =~ /^(\S*)\b.*/;

3319

my $h = pop @hosts;

3320

3321

$config{$h}{'status'} = $status;

3322

if ($status eq 'ok') {

3323

$config{$h}{'ip'} = $ip;

3324

$config{$h}{'mtime'} = $now;

3325

success("updating %s: %s: IP address set to %s", $h, $status, $ip);

3326

3327

} elsif ($status =~ /TOOSOON/) {

3328

## make sure we wait at least a little

3329

my ($wait, $units) = (5, 'm');

3330

my ($sec, $scale) = ($wait, 1);

3331

3332

($scale, $units) = (1, 'seconds') if $units eq 's';

3333

($scale, $units) = (60, 'minutes') if $units eq 'm';

3334

($scale, $units) = (60*60, 'hours') if $units eq 'h';

3335

$config{$h}{'wtime'} = $now + $sec;

3336

warning("updating %s: %s: wait $wait $units before further updates", $h, $status, $ip);

3337

3338

} elsif (exists $errors{$status}) {

3339

failed("updating %s: %s: %s", $h, $line, $errors{$status});

3340

3341

} else {

3342

failed("updating %s: %s: unexpected status (%s)", $h, $line);

3343

}

3344

last;

3345

}

3346

}

3347

failed("updating %s: Could not connect to %s.", $hosts, $config{$h}{'server'})

3348

if $state ne 'results2';

3349

}

3350

}

3351

3352

######################################################################

3353

3354

######################################################################

3355

## nic_namecheap_examples

3356

######################################################################

3357

sub nic_namecheap_examples {

3358

return <<EoEXAMPLE;

3359

3360

o 'namecheap'

3361

3362

The 'namecheap' protocol is used by DNS service offered by www.namecheap.com.

3363

3364

Configuration variables applicable to the 'namecheap' protocol are:

3365

protocol=namecheap ##

3366

server=fqdn.of.service ## defaults to dynamicdns.park-your-domain.com

3367

login=service-login ## login name and password registered with the service

3368

password=service-password ##

3369

fully.qualified.host ## the host registered with the service.

3370

3371

Example ${program}.conf file entries:

3372

## single host update

3373

protocol=namecheap, \\

3374

login=my-namecheap.com-login, \\

3375

password=my-namecheap.com-password \\

3376

myhost.namecheap.com

3377

3378

EoEXAMPLE

3379

}

3380

######################################################################

3381

## nic_namecheap_update

3382

##

3383

## written by Dan Boardman

3384

##

3385

## based on http://www.namecheap.com/resources/help/index.asp?t=dynamicdns

3386

## needs this url to update:

3387

## http://dynamicdns.park-your-domain.com/update?host=host_name&

3388

## domain=domain.com&password=domain_password[&ip=your_ip]

3389

##

3390

######################################################################

3391

sub nic_namecheap_update {

3392

3393

3394

debug("\nnic_namecheap1_update -------------------");

3395

3396

## update each configured host

3397

foreach my $h (@_) {

3398

my $ip = delete $config{$h}{'wantip'};

3399

info("setting IP address to %s for %s", $ip, $h);

3400

verbose("UPDATE:","updating %s", $h);

3401

3402

my $url;

3403

$url = "http://$config{$h}{'server'}/update";

3404

$url .= "?host=$h";

3405

$url .= "&domain=$config{$h}{'login'}";

3406

$url .= "&password=$config{$h}{'password'}";

3407

$url .= "&ip=";

3408

$url .= $ip if $ip;

3409

3410

my $reply = geturl(opt('proxy'), $url);

3411

if (!defined($reply) || !$reply) {

3412

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

3413

last;

3414

}

3415

last if !header_ok($h, $reply);

3416

3417

my @reply = split /\n/, $reply;

3418

if (grep /<ErrCount>0/i, @reply) {

3419

$config{$h}{'ip'} = $ip;

3420

$config{$h}{'mtime'} = $now;

3421

$config{$h}{'status'} = 'good';

3422

success("updating %s: good: IP address set to %s", $h, $ip);

3423

} else {

3424

$config{$h}{'status'} = 'failed';

3425

warning("SENT: %s", $url) unless opt('verbose');

3426

warning("REPLIED: %s", $reply);

3427

failed("updating %s: Invalid reply.", $h);

3428

}

3429

}

3430

}

3431

3432

######################################################################

3433

3434

3435

######################################################################

3436

3437

######################################################################

3438

## nic_sitelutions_examples

3439

######################################################################

3440

sub nic_sitelutions_examples {

3441

return <<EoEXAMPLE;

3442

3443

o 'sitelutions'

3444

3445

The 'sitelutions' protocol is used by DNS services offered by www.sitelutions.com.

3446

3447

Configuration variables applicable to the 'sitelutions' protocol are:

3448

protocol=sitelutions ##

3449

server=fqdn.of.service ## defaults to sitelutions.com

3450

login=service-login ## login name and password registered with the service

3451

password=service-password ##

3452

A_record_id ## Id of the A record for the host registered with the service.

3453

3454

Example ${program}.conf file entries:

3455

## single host update

3456

protocol=sitelutions, \\

3457

login=my-sitelutions.com-login, \\

3458

password=my-sitelutions.com-password \\

3459

my-sitelutions.com-id_of_A_record

3460

3461

EoEXAMPLE

3462

}

3463

######################################################################

3464

## nic_sitelutions_update

3465

##

3466

## written by Mike W. Smith

3467

##

3468

## based on http://www.sitelutions.com/help/dynamic_dns_clients#updatespec

3469

## needs this url to update:

3470

## https://www.sitelutions.com/dnsup?id=990331&user=myemail@mydomain.com&pass=SecretPass&ip=192.168.10.4

3471

## domain=domain.com&password=domain_password&ip=your_ip

3472

##

3473

######################################################################

3474

sub nic_sitelutions_update {

3475

3476

3477

debug("\nnic_sitelutions_update -------------------");

3478

3479

## update each configured host

3480

foreach my $h (@_) {

3481

my $ip = delete $config{$h}{'wantip'};

3482

info("setting IP address to %s for %s", $ip, $h);

3483

verbose("UPDATE:","updating %s", $h);

3484

3485

my $url;

3486

$url = "http://$config{$h}{'server'}/dnsup";

3487

$url .= "?id=$h";

3488

$url .= "&user=$config{$h}{'login'}";

3489

$url .= "&pass=$config{$h}{'password'}";

3490

$url .= "&ip=";

3491

$url .= $ip if $ip;

3492

3493

my $reply = geturl(opt('proxy'), $url);

3494

if (!defined($reply) || !$reply) {

3495

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

3496

last;

3497

}

3498

last if !header_ok($h, $reply);

3499

3500

my @reply = split /\n/, $reply;

3501

if (grep /success/i, @reply) {

3502

$config{$h}{'ip'} = $ip;

3503

$config{$h}{'mtime'} = $now;

3504

$config{$h}{'status'} = 'good';

3505

success("updating %s: good: IP address set to %s", $h, $ip);

3506

} else {

3507

$config{$h}{'status'} = 'failed';

3508

warning("SENT: %s", $url) unless opt('verbose');

3509

warning("REPLIED: %s", $reply);

3510

failed("updating %s: Invalid reply.", $h);

3511

}

3512

}

3513

}

3514

3515

######################################################################

3516

3517

######################################################################

3518

## nic_freedns_examples

3519

######################################################################

3520

sub nic_freedns_examples {

3521

return <<EoEXAMPLE;

3522

3523

o 'freedns'

3524

3525

The 'freedns' protocol is used by DNS services offered by freedns.afraid.org.

3526

3527

Configuration variables applicable to the 'freedns' protocol are:

3528

protocol=freedns ##

3529

server=fqdn.of.service ## defaults to freedns.afraid.org

3530

login=service-login ## login name and password registered with the service

3531

password=service-password ##

3532

fully.qualified.host ## the host registered with the service.

3533

3534

Example ${program}.conf file entries:

3535

## single host update

3536

protocol=freedns, \\

3537

login=my-freedns.afraid.org-login, \\

3538

password=my-freedns.afraid.org-password \\

3539

myhost.afraid.com

3540

3541

EoEXAMPLE

3542

}

3543

######################################################################

3544

## nic_freedns_update

3545

##

3546

## written by John Haney

3547

##

3548

## based on http://freedns.afraid.org/api/

3549

## needs this url to update:

3550

## http://freedns.afraid.org/api/?action=getdyndns&sha=<sha1sum of login|password>

3551

## This returns a list of host|currentIP|updateURL lines.

3552

## Pick the line that matches myhost, and fetch the URL.

3553

## word 'Updated' for success, 'fail' for failure.

3554

##

3555

######################################################################

3556

sub nic_freedns_update {

3557

3558

3559

debug("\nnic_freedns_update -------------------");

3560

3561

## First get the list of updatable hosts

3562

my $url;

3563

$url = "http://$config{$_[0]}{'server'}/api/?action=getdyndns&sha=".&sha1_hex("$config{$_[0]}{'login'}|$config{$_[0]}{'password'}");

3564

my $reply = geturl(opt('proxy'), $url);

3565

if (!defined($reply) || !$reply || !header_ok($_[0], $reply)) {

3566

failed("updating %s: Could not connect to %s for site list.", $_[0], $url);

3567

return;

3568

}

3569

my @lines = split("\n", $reply);

3570

my %freedns_hosts;

3571

grep {

3572

my @rec = split(/\|/, $_);

3573

$freedns_hosts{$rec[0]} = \@rec if ($#rec > 0);

3574

} @lines;

3575

if (!keys %freedns_hosts) {

3576

failed("Could not get freedns update URLs from %s", $config{$_[0]}{'server'});

3577

return;

3578

}

3579

## update each configured host

3580

foreach my $h (@_) {

3581

if(!$h){ next };

3582

my $ip = delete $config{$h}{'wantip'};

3583

info("setting IP address to %s for %s", $ip, $h);

3584

verbose("UPDATE:","updating %s", $h);

3585

3586

if($ip eq $freedns_hosts{$h}->[1]) {

3587

$config{$h}{'ip'} = $ip;

3588

$config{$h}{'mtime'} = $now;

3589

$config{$h}{'status'} = 'good';

3590

success("update not necessary %s: good: IP address already set to %s", $h, $ip);

3591

} else {

3592

my $reply = geturl(opt('proxy'), $freedns_hosts{$h}->[2]);

3593

if (!defined($reply) || !$reply) {

3594

failed("updating %s: Could not connect to %s.", $h, $freedns_hosts{$h}->[2]);

3595

last;

3596

}

3597

if(!header_ok($h, $reply)) {

3598

$config{$h}{'status'} = 'failed';

3599

last;

3600

}

3601

3602

if($reply =~ /Updated.*$h.*to.*$ip/) {

3603

$config{$h}{'ip'} = $ip;

3604

$config{$h}{'mtime'} = $now;

3605

$config{$h}{'status'} = 'good';

3606

success("updating %s: good: IP address set to %s", $h, $ip);

3607

} else {

3608

$config{$h}{'status'} = 'failed';

3609

warning("SENT: %s", $freedns_hosts{$h}->[2]) unless opt('verbose');

3610

warning("REPLIED: %s", $reply);

3611

failed("updating %s: Invalid reply.", $h);

3612

}

3613

}

3614

}

3615

}

3616

3617

######################################################################

3618

## nic_changeip_examples

3619

######################################################################

3620

sub nic_changeip_examples {

3621

return <<EoEXAMPLE;

3622

3623

o 'changeip'

3624

3625

The 'changeip' protocol is used by DNS services offered by changeip.com.

3626

3627

Configuration variables applicable to the 'changeip' protocol are:

3628

protocol=changeip ##

3629

server=fqdn.of.service ## defaults to nic.changeip.com

3630

login=service-login ## login name and password registered with the service

3631

password=service-password ##

3632

fully.qualified.host ## the host registered with the service.

3633

3634

Example ${program}.conf file entries:

3635

## single host update

3636

protocol=changeip, \\

3637

login=my-my-changeip.com-login, \\

3638

password=my-changeip.com-password \\

3639

myhost.changeip.org

3640

3641

EoEXAMPLE

3642

}

3643

3644

######################################################################

3645

## nic_changeip_update

3646

##

3647

## adapted by Michele Giorato

3648

##

3649

## https://nic.ChangeIP.com/nic/update?hostname=host.example.org&myip=66.185.162.19

3650

##

3651

######################################################################

3652

sub nic_changeip_update {

3653

3654

3655

debug("\nnic_changeip_update -------------------");

3656

3657

## update each configured host

3658

foreach my $h (@_) {

3659

my $ip = delete $config{$h}{'wantip'};

3660

info("setting IP address to %s for %s", $ip, $h);

3661

verbose("UPDATE:","updating %s", $h);

3662

3663

my $url;

3664

$url = "http://$config{$h}{'server'}/nic/update";

3665

$url .= "?hostname=$h";

3666

$url .= "&ip=";

3667

$url .= $ip if $ip;

3668

3669

my $reply = geturl(opt('proxy'), $url, $config{$h}{'login'}, $config{$h}{'password'});

3670

if (!defined($reply) || !$reply) {

3671

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

3672

last;

3673

}

3674

last if !header_ok($h, $reply);

3675

3676

my @reply = split /\n/, $reply;

3677

if (grep /success/i, @reply) {

3678

$config{$h}{'ip'} = $ip;

3679

$config{$h}{'mtime'} = $now;

3680

$config{$h}{'status'} = 'good';

3681

success("updating %s: good: IP address set to %s", $h, $ip);

3682

} else {

3683

$config{$h}{'status'} = 'failed';

3684

warning("SENT: %s", $url) unless opt('verbose');

3685

warning("REPLIED: %s", $reply);

3686

failed("updating %s: Invalid reply.", $h);

3687

}

3688

}

3689

}

3690

3691

######################################################################

3692

## nic_dtdns_examples

3693

######################################################################

3694

sub nic_dtdns_examples {

3695

return <<EoEXAMPLE;

3696

o 'dtdns'

3697

3698

The 'dtdns' protocol is the protocol used by the dynamic hostname services

3699

of the 'DtDNS' dns services. This is currently used by the free

3700

dynamic DNS service offered by www.dtdns.com.

3701

3702

Configuration variables applicable to the 'dtdns' protocol are:

3703

protocol=dtdns ##

3704

server=www.fqdn.of.service ## defaults to www.dtdns.com

3705

password=service-password ## password registered with the service

3706

client=name_of_updater ## defaults to $program (10 chars max, no spaces)

3707

fully.qualified.host ## the host registered with the service.

3708

3709

Example ${program}.conf file entries:

3710

## single host update

3711

protocol=dtdns, \\

3712

password=my-dydns.za.net-password, \\

3713

client=ddclient \\

3714

myhost.dtdns.net

3715

3716

EoEXAMPLE

3717

}

3718

3719

######################################################################

3720

## nic_dtdns_update

3721

## by Achim Franke

3722

######################################################################

3723

sub nic_dtdns_update {

3724

debug("\nnic_dtdns_update -------------------");

3725

3726

## update each configured host

3727

foreach my $h (@_) {

3728

my $ip = delete $config{$h}{'wantip'};

3729

info("setting IP address to %s for %s", $ip, $h);

3730

verbose("UPDATE:","updating %s", $h);

3731

3732

# Set the URL that we're going to to update

3733

my $url;

3734

$url = "http://$config{$h}{'server'}/api/autodns.cfm";

3735

$url .= "?id=";

3736

$url .= $h;

3737

$url .= "&pw=";

3738

$url .= $config{$h}{'password'};

3739

$url .= "&ip=";

3740

$url .= $ip;

3741

$url .= "&client=";

3742

$url .= $config{$h}{'client'};

3743

3744

# Try to get URL

3745

my $reply = geturl(opt('proxy'), $url);

3746

3747

# No response, declare as failed

3748

if (!defined($reply) || !$reply) {

3749

failed("updating %s: Could not connect to %s.", $h, $config{$h}{'server'});

3750

last;

3751

}

3752

last if !header_ok($h, $reply);

3753

3754

# Response found, just declare as success (this is ugly, we need more error checking)

3755

if ($reply =~ /now\spoints\sto/)

3756

{

3757

$config{$h}{'ip'} = $ip;

3758

$config{$h}{'mtime'} = $now;

3759

$config{$h}{'status'} = 'good';

3760

success("updating %s: good: IP address set to %s", $h, $ip);

3761

}

3762

else

3763

{

3764

my @reply = split /\n/, $reply;

3765

my $returned = pop(@reply);

3766

$config{$h}{'status'} = 'failed';

3767

failed("updating %s: Server said: '$returned'", $h);

3768

}

3769

}

3770

}

3771

3772

######################################################################

3773

# vim: ai ts=4 sw=4 tw=78 :

3774

3775

3776

__END__