1#!/usr/bin/perl 2# 3# Copyright (C) 2004, 2007, 2012 Internet Systems Consortium, Inc. ("ISC") 4# Copyright (C) 2000, 2001 Internet Software Consortium. 5# 6# Permission to use, copy, modify, and/or distribute this software for any 7# purpose with or without fee is hereby granted, provided that the above 8# copyright notice and this permission notice appear in all copies. 9# 10# THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH 11# REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY 12# AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT, 13# INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM 14# LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE 15# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR 16# PERFORMANCE OF THIS SOFTWARE. 17 18# 19# Dynamic update test suite. 20# 21# Usage: 22# 23# perl update_test.pl [-s server] [-p port] zone 24# 25# The server defaults to 127.0.0.1. 26# The port defaults to 53. 27# 28# The "Special NS rules" tests will only work correctly if the 29# zone has no NS records to begin with, or alternatively has a 30# single NS record pointing at the name "ns1" (relative to 31# the zone name). 32# 33# Installation notes: 34# 35# This program uses the Net::DNS::Resolver module. 36# You can install it by saying 37# 38# perl -MCPAN -e "install Net::DNS" 39# 40# Id: update_test.pl,v 1.10 2007/06/19 23:47:04 tbox Exp 41# 42 43use Getopt::Std; 44use Net::DNS; 45use Net::DNS::Update; 46use Net::DNS::Resolver; 47 48$opt_s = "127.0.0.1"; 49$opt_p = 53; 50 51getopt('s:p:'); 52 53$res = new Net::DNS::Resolver; 54$res->nameservers($opt_s); 55$res->port($opt_p); 56$res->defnames(0); # Do not append default domain. 57 58@ARGV == 1 or die 59 "usage: perl update_test.pl [-s server] [-p port] zone\n"; 60 61$zone = shift @ARGV; 62 63my $failures = 0; 64 65sub assert { 66 my ($cond, $explanation) = @_; 67 if (!$cond) { 68 print "I:Test Failed: $explanation ***\n"; 69 $failures++ 70 } 71} 72 73sub test { 74 my ($expected, @records) = @_; 75 76 my $update = new Net::DNS::Update("$zone"); 77 78 foreach $rec (@records) { 79 $update->push(@$rec); 80 } 81 82 $reply = $res->send($update); 83 84 # Did it work? 85 if (defined $reply) { 86 my $rcode = $reply->header->rcode; 87 assert($rcode eq $expected, "expected $expected, got $rcode"); 88 } else { 89 print "I:Update failed: ", $res->errorstring, "\n"; 90 } 91} 92 93sub section { 94 my ($msg) = @_; 95 print "I:$msg\n"; 96} 97 98section("Delete any leftovers from previous tests"); 99test("NOERROR", ["update", rr_del("a.$zone")]); 100test("NOERROR", ["update", rr_del("b.$zone")]); 101test("NOERROR", ["update", rr_del("c.$zone")]); 102test("NOERROR", ["update", rr_del("d.$zone")]); 103test("NOERROR", ["update", rr_del("e.$zone")]); 104test("NOERROR", ["update", rr_del("f.$zone")]); 105test("NOERROR", ["update", rr_del("ns.s.$zone")]); 106test("NOERROR", ["update", rr_del("s.$zone")]); 107test("NOERROR", ["update", rr_del("t.$zone")]); 108test("NOERROR", ["update", rr_del("*.$zone")]); 109test("NOERROR", ["update", rr_del("u.$zone")]); 110test("NOERROR", ["update", rr_del("a.u.$zone")]); 111test("NOERROR", ["update", rr_del("b.u.$zone")]); 112 113section("Simple prerequisites in the absence of data"); 114# Name is in Use 115test("NXDOMAIN", ["pre", yxdomain("a.$zone")]); 116# RRset exists (value independent) 117test("NXRRSET", ["pre", yxrrset("a.$zone A")]); 118# Name is not in use 119test("NOERROR", ["pre", nxdomain("a.$zone")]); 120# RRset does not exist 121test("NOERROR", ["pre", nxrrset("a.$zone A")]); 122# RRset exists (value dependent) 123test("NXRRSET", ["pre", yxrrset("a.$zone A 73.80.65.49")]); 124 125 126section ("Simple creation of data"); 127test("NOERROR", ["update", rr_add("a.$zone 300 A 73.80.65.49")]); 128 129section ("Simple prerequisites in the presence of data"); 130# Name is in use 131test("NOERROR", ["pre", yxdomain("a.$zone")]); 132# RRset exists (value independent) 133test("NOERROR", ["pre", yxrrset("a.$zone A")]); 134# Name is not in use 135test("YXDOMAIN", ["pre", nxdomain("a.$zone")]); 136# RRset does not exist 137test("YXRRSET", ["pre", nxrrset("a.$zone A")]); 138# RRset exists (value dependent) 139test("NOERROR", ["pre", yxrrset("a.$zone A 73.80.65.49")]); 140 141# 142# Merging of RRsets 143# 144test("NOERROR", ["update", rr_add("a.$zone 300 A 73.80.65.50")]); 145 146section("Detailed tests of \"RRset exists (value dependent)\" prerequisites"); 147test("NOERROR", ["pre", 148 yxrrset("a.$zone A 73.80.65.49"), 149 yxrrset("a.$zone A 73.80.65.50")]); 150test("NOERROR", ["pre", 151 yxrrset("a.$zone A 73.80.65.50"), 152 yxrrset("a.$zone A 73.80.65.49")]); 153test("NXRRSET", ["pre", yxrrset("a.$zone A 73.80.65.49")]); 154test("NXRRSET", ["pre", yxrrset("a.$zone A 73.80.65.50")]); 155test("NXRRSET", ["pre", 156 yxrrset("a.$zone A 73.80.65.49"), 157 yxrrset("a.$zone A 73.80.65.50"), 158 yxrrset("a.$zone A 73.80.65.51")]); 159 160 161section("Torture test of \"RRset exists (value dependent)\" prerequisites."); 162 163test("NOERROR", ["update", 164 rr_add("e.$zone 300 A 73.80.65.49"), 165 rr_add("e.$zone 300 TXT 'one'"), 166 rr_add("e.$zone 300 A 73.80.65.50")]); 167test("NOERROR", ["update", 168 rr_add("e.$zone 300 A 73.80.65.52"), 169 rr_add("f.$zone 300 A 73.80.65.52"), 170 rr_add("e.$zone 300 A 73.80.65.51")]); 171test("NOERROR", ["update", 172 rr_add("e.$zone 300 TXT 'three'"), 173 rr_add("e.$zone 300 TXT 'two'")]); 174test("NOERROR", ["update", 175 rr_add("e.$zone 300 MX 10 mail.$zone")]); 176 177test("NOERROR", ["pre", 178 yxrrset("e.$zone A 73.80.65.52"), 179 yxrrset("e.$zone TXT 'two'"), 180 yxrrset("e.$zone A 73.80.65.51"), 181 yxrrset("e.$zone TXT 'three'"), 182 yxrrset("e.$zone A 73.80.65.50"), 183 yxrrset("f.$zone A 73.80.65.52"), 184 yxrrset("e.$zone A 73.80.65.49"), 185 yxrrset("e.$zone TXT 'one'")]); 186 187 188section("Subtraction of RRsets"); 189test("NOERROR", ["update", rr_del("a.$zone A 73.80.65.49")]); 190test("NOERROR", ["pre", 191 yxrrset("a.$zone A 73.80.65.50")]); 192 193test("NOERROR", ["update", rr_del("a.$zone A 73.80.65.50")]); 194test("NOERROR", ["pre", nxrrset("a.$zone A")]); 195test("NOERROR", ["pre", nxdomain("a.$zone")]); 196 197section("Other forms of deletion"); 198test("NOERROR", ["update", rr_add("a.$zone 300 A 73.80.65.49")]); 199test("NOERROR", ["update", rr_add("a.$zone 300 A 73.80.65.50")]); 200test("NOERROR", ["update", rr_add("a.$zone 300 MX 10 mail.$zone")]); 201test("NOERROR", ["update", rr_del("a.$zone A")]); 202test("NOERROR", ["pre", nxrrset("a.$zone A")]); 203test("NOERROR", ["update", rr_add("a.$zone 300 A 73.80.65.49")]); 204test("NOERROR", ["update", rr_add("a.$zone 300 A 73.80.65.50")]); 205test("NOERROR", ["update", rr_del("a.$zone")]); 206test("NOERROR", ["pre", nxdomain("a.$zone")]); 207 208section("Case insensitivity"); 209test("NOERROR", ["update", rr_add("a.$zone 300 PTR foo.net.")]); 210test("NOERROR", ["pre", yxrrset("A.$zone PTR fOo.NeT.")]); 211 212section("Special CNAME rules"); 213test("NOERROR", ["update", rr_add("b.$zone 300 CNAME foo.net.")]); 214test("NOERROR", ["update", rr_add("b.$zone 300 A 73.80.65.49")]); 215test("NOERROR", ["pre", yxrrset("b.$zone CNAME foo.net.")]); 216test("NOERROR", ["pre", nxrrset("b.$zone A")]); 217 218test("NOERROR", ["update", rr_add("c.$zone 300 A 73.80.65.49")]); 219test("NOERROR", ["update", rr_add("c.$zone 300 CNAME foo.net.")]); 220test("NOERROR", ["pre", yxrrset("c.$zone A")]); 221test("NOERROR", ["pre", nxrrset("c.$zone CNAME")]); 222 223# XXX should test with SIG, KEY, NXT, too. 224 225# 226# Currently commented out because Net::DNS does not properly 227# support WKS records. 228# 229#section("Special WKS rules"); 230#test("NOERROR", ["update", rr_add("c.$zone 300 WKS 73.80.65.49 TCP telnet ftp")]); 231#test("NOERROR", ["update", rr_add("c.$zone 300 WKS 73.80.65.49 UDP telnet ftp")]); 232#test("NOERROR", ["update", rr_add("c.$zone 300 WKS 73.80.65.50 TCP telnet ftp")]); 233#test("NOERROR", ["update", rr_add("c.$zone 300 WKS 73.80.65.49 TCP smtp")]); 234#test("NOERROR", ["pre", 235# yxrrset("c.$zone WKS 73.80.65.49 TCP smtp"), 236# yxrrset("c.$zone WKS 73.80.65.49 UDP telnet ftp"), 237# yxrrset("c.$zone WKS 73.80.65.50 TCP telnet ftp")]); 238 239 240section("Special NS rules"); 241 242# Deleting the last NS record using "Delete an RR from an RRset" 243# should fail at the zone apex and work elsewhere. The pseudocode 244# in RFC2136 says it should fail everywhere, but this is in conflict 245# with the actual text. 246 247# Apex 248test("NOERROR", ["update", 249 rr_add("$zone 300 NS ns1.$zone"), 250 rr_add("$zone 300 NS ns2.$zone")]); 251test("NOERROR", ["update", rr_del("$zone NS ns1.$zone")]); 252test("NOERROR", ["update", rr_del("$zone NS ns2.$zone")]); 253test("NOERROR", ["pre", 254 yxrrset("$zone NS ns2.$zone")]); 255 256# Non-apex 257test("NOERROR", ["update", rr_add("n.$zone 300 NS ns1.$zone")]); 258test("NOERROR", ["update", rr_del("n.$zone NS ns1.$zone")]); 259test("NOERROR", ["pre", nxrrset("n.$zone NS")]); 260 261# Other ways of deleting NS records should also fail at the apex 262# and work elsewhere. 263 264# Non-apex 265test("NOERROR", ["update", rr_add("n.$zone 300 NS ns1.$zone")]); 266test("NOERROR", ["update", rr_del("n.$zone NS")]); 267test("NOERROR", ["pre", nxrrset("n.$zone NS")]); 268 269test("NOERROR", ["update", rr_add("n.$zone 300 NS ns1.$zone")]); 270test("NOERROR", ["pre", yxrrset("n.$zone NS")]); 271test("NOERROR", ["update", rr_del("n.$zone")]); 272test("NOERROR", ["pre", nxrrset("n.$zone NS")]); 273 274# Apex 275test("NOERROR", ["update", rr_del("$zone NS")]); 276test("NOERROR", ["pre", 277 yxrrset("$zone NS ns2.$zone")]); 278 279test("NOERROR", ["update", rr_del("$zone")]); 280test("NOERROR", ["pre", 281 yxrrset("$zone NS ns2.$zone")]); 282 283# They should not touch the SOA, either. 284 285test("NOERROR", ["update", rr_del("$zone SOA")]); 286test("NOERROR", ["pre", yxrrset("$zone SOA")]); 287 288 289section("Idempotency"); 290 291test("NOERROR", ["update", rr_add("d.$zone 300 A 73.80.65.49")]); 292test("NOERROR", ["pre", yxrrset("d.$zone A 73.80.65.49")]); 293test("NOERROR", ["update", 294 rr_add("d.$zone 300 A 73.80.65.49"), 295 rr_del("d.$zone A")]); 296test("NOERROR", ["pre", nxrrset("d.$zone A")]); 297 298test("NOERROR", ["update", rr_del("d.$zone A 73.80.65.49")]); 299test("NOERROR", ["pre", nxrrset("d.$zone A")]); 300test("NOERROR", ["update", 301 rr_del("d.$zone A"), 302 rr_add("d.$zone 300 A 73.80.65.49")]); 303 304test("NOERROR", ["pre", yxrrset("d.$zone A")]); 305 306section("Out-of-zone prerequisites and updates"); 307test("NOTZONE", ["pre", yxrrset("a.somewhere.else. A 73.80.65.49")]); 308test("NOTZONE", ["update", rr_add("a.somewhere.else. 300 A 73.80.65.49")]); 309 310 311section("Glue"); 312test("NOERROR", ["update", rr_add("s.$zone 300 NS ns.s.$zone")]); 313test("NOERROR", ["update", rr_add("ns.s.$zone 300 A 73.80.65.49")]); 314test("NOERROR", ["pre", yxrrset("ns.s.$zone A 73.80.65.49")]); 315 316section("Wildcards"); 317test("NOERROR", ["update", rr_add("*.$zone 300 MX 10 mail.$zone")]); 318test("NOERROR", ["pre", yxrrset("*.$zone MX 10 mail.$zone")]); 319test("NXRRSET", ["pre", yxrrset("w.$zone MX 10 mail.$zone")]); 320test("NOERROR", ["pre", nxrrset("w.$zone MX")]); 321test("NOERROR", ["pre", nxdomain("w.$zone")]); 322 323 324section("SOA serial handling"); 325 326my $soatimers = "20 20 1814400 3600"; 327 328# Get the current SOA serial number. 329my $query = $res->query($zone, "SOA"); 330my ($old_soa) = $query->answer; 331 332my $old_serial = $old_soa->serial; 333 334# Increment it by 10. 335my $new_serial = $old_serial + 10; 336if ($new_serial > 0xFFFFFFFF) { 337 $new_serial -= 0x80000000; 338 $new_serial -= 0x80000000; 339} 340 341# Replace the SOA with a new one. 342test("NOERROR", ["update", rr_add("$zone 300 SOA mname1. . $new_serial $soatimers")]); 343 344# Check that the SOA really got replaced. 345($db_soa) = $res->query($zone, "SOA")->answer; 346assert($db_soa->mname eq "mname1"); 347 348# Check that attempts to decrement the serial number are ignored. 349$new_serial = $old_serial - 10; 350if ($new_serial < 0) { 351 $new_serial += 0x80000000; 352 $new_serial += 0x80000000; 353} 354test("NOERROR", ["update", rr_add("$zone 300 SOA mname2. . $new_serial $soatimers")]); 355assert($db_soa->mname eq "mname1"); 356 357# Check that attempts to leave the serial number unchanged are ignored. 358($old_soa) = $res->query($zone, "SOA")->answer; 359$old_serial = $old_soa->serial; 360test("NOERROR", ["update", rr_add("$zone 300 SOA mname3. . $old_serial " . 361 $soatimers)]); 362($db_soa) = $res->query($zone, "SOA")->answer; 363assert($db_soa->mname eq "mname1"); 364 365# 366# Currently commented out because Net::DNS does not properly 367# support multiple strings in TXT records. 368# 369#section("Big data"); 370#test("NOERROR", ["update", rr_add("a.$zone 300 TXT aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc")]); 371#test("NOERROR", ["update", rr_del("a.$zone TXT aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc")]); 372test("NOERROR", ["update", rr_add("a.$zone 300 TXT " . ("foo " x 3))]); 373 374section("Updating TTLs only"); 375 376test("NOERROR", ["update", rr_add("t.$zone 300 A 73.80.65.49")]); 377($a) = $res->query("t.$zone", "A")->answer; 378$ttl = $a->ttl; 379assert($ttl == 300, "incorrect TTL value $ttl != 300"); 380test("NOERROR", ["update", 381 rr_del("t.$zone A 73.80.65.49"), 382 rr_add("t.$zone 301 A 73.80.65.49")]); 383($a) = $res->query("t.$zone", "A")->answer; 384$ttl = $a->ttl; 385assert($ttl == 301, "incorrect TTL value $ttl != 301"); 386 387# Add an RR that is identical to an existing one except for the TTL. 388# RFC2136 is not clear about what this should do; it says "duplicate RRs 389# will be silently ignored" but is an RR differing only in TTL 390# to be considered a duplicate or not? The test assumes that it 391# should not be considered a duplicate. 392test("NOERROR", ["update", rr_add("t.$zone 302 A 73.80.65.50")]); 393($a) = $res->query("t.$zone", "A")->answer; 394$ttl = $a->ttl; 395assert($ttl == 302, "incorrect TTL value $ttl != 302"); 396 397section("TTL normalization"); 398 399# The desired behaviour is that the old RRs get their TTL 400# changed to match the new one. RFC2136 does not explicitly 401# specify this, but I think it makes more sense than the 402# alternatives. 403 404test("NOERROR", ["update", rr_add("t.$zone 303 A 73.80.65.51")]); 405(@answers) = $res->query("t.$zone", "A")->answer; 406$nanswers = scalar @answers; 407assert($nanswers == 3, "wrong number of answers $nanswers != 3"); 408foreach $a (@answers) { 409 $ttl = $a->ttl; 410 assert($ttl == 303, "incorrect TTL value $ttl != 303"); 411} 412 413section("Obscuring existing data by zone cut"); 414test("NOERROR", ["update", rr_add("a.u.$zone 300 A 73.80.65.49")]); 415test("NOERROR", ["update", rr_add("b.u.$zone 300 A 73.80.65.49")]); 416test("NOERROR", ["update", rr_add("u.$zone 300 TXT txt-not-in-nxt")]); 417test("NOERROR", ["update", rr_add("u.$zone 300 NS ns.u.$zone")]); 418 419test("NOERROR", ["update", rr_del("u.$zone NS ns.u.$zone")]); 420 421if ($failures) { 422 print "I:$failures tests failed.\n"; 423} else { 424 print "I:All tests successful.\n"; 425} 426exit $failures; 427