← Back to branch summary

~kernevil/ubuntu/trusty/bind9/sdlz-hmac-keys

« back to all changes in this revision

Viewing changes to bin/tests/system/ans.pl

  • Committer: Package Import Robot
  • Author(s): LaMont Jones, Matthew Grant, LaMont Jones
  • Date: 2012-10-29 08:37:49 UTC
  • mfrom: (1.9.2)
  • Revision ID: package-import@ubuntu.com-20121029083749-r9inpzl0yuj9xdlu
Tags: 1:9.8.4.dfsg-1
[Matthew Grant]

* Turn off dlopen as it was causing test compile failures.
* Add missing library .postrm files for debhelper

[LaMont Jones]

* New upstream version
* soname fixup
* Ack NMUs

Show diffs side-by-side

added added

removed removed

Lines of Context:
bin/tests/system/ans.pl
1
1
#!/usr/bin/perl
2
2
#
3
 
# Copyright (C) 2011  Internet Systems Consortium, Inc. ("ISC")
 
3
# Copyright (C) 2011, 2012  Internet Systems Consortium, Inc. ("ISC")
4
4
#
5
5
# Permission to use, copy, modify, and/or distribute this software for any
6
6
# purpose with or without fee is hereby granted, provided that the above
14
14
# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
15
15
# PERFORMANCE OF THIS SOFTWARE.
16
16
 
17
 
# $Id: ans.pl,v 1.2.2.4 2011-03-18 04:40:30 each Exp $
 
17
# $Id: ans.pl,v 1.2.2.6 2012/02/22 23:46:35 tbox Exp $
18
18
 
19
19
#
20
20
# This is the name server from hell.  It provides canned
80
80
# XXX: we should also be able to specify IPv6
81
81
my $server_addr = "10.53.0.2";
82
82
if (@ARGV > 0) {
83
 
        $server_addr = @ARGV[0];
 
83
        $server_addr = @ARGV[0];
84
84
}
85
85
 
86
86
# XXX: we should also be able to set the port numbers to listen on.
106
106
#my @answers = ();
107
107
my @rules;
108
108
sub handleUDP {
109
 
        my ($buf) = @_;
110
 
 
111
 
        my ($packet, $err) = new Net::DNS::Packet(\$buf, 0);
112
 
        $err and die $err;
113
 
 
114
 
        $packet->header->qr(1);
115
 
        $packet->header->aa(1);
116
 
 
117
 
        my @questions = $packet->question;
118
 
        my $qname = $questions[0]->qname;
119
 
        my $qtype = $questions[0]->qtype;
120
 
 
121
 
        # get the existing signature if any, and clear the additional section
122
 
        my $prev_tsig;
123
 
        while (my $rr = $packet->pop("additional")) {
124
 
                if ($rr->type eq "TSIG") {
125
 
                        $prev_tsig = $rr;
126
 
                }
127
 
        }
128
 
 
129
 
        my $r;
130
 
        foreach $r (@rules) {
131
 
                my $pattern = $r->{pattern};
 
109
        my ($buf) = @_;
 
110
 
 
111
        my ($request, $err) = new Net::DNS::Packet(\$buf, 0);
 
112
        $err and die $err;
 
113
 
 
114
        my @questions = $request->question;
 
115
        my $qname = $questions[0]->qname;
 
116
        my $qtype = $questions[0]->qtype;
 
117
        my $qclass = $questions[0]->qclass;
 
118
        my $id = $request->header->id;
 
119
 
 
120
        my $packet = new Net::DNS::Packet($qname, $qtype, $qclass);
 
121
        $packet->header->qr(1);
 
122
        $packet->header->aa(1);
 
123
        $packet->header->id($id);
 
124
 
 
125
        # get the existing signature if any, and clear the additional section
 
126
        my $prev_tsig;
 
127
        while (my $rr = $request->pop("additional")) {
 
128
                if ($rr->type eq "TSIG") {
 
129
                        $prev_tsig = $rr;
 
130
                }
 
131
        }
 
132
 
 
133
        my $r;
 
134
        foreach $r (@rules) {
 
135
                my $pattern = $r->{pattern};
132
136
                my($dbtype, $key_name, $key_data) = split(/ /,$pattern);
133
137
                print "[handleUDP] $dbtype, $key_name, $key_data \n";
134
 
                if ("$qname $qtype" =~ /$dbtype/) {
135
 
                        my $a;
136
 
                        foreach $a (@{$r->{answer}}) {
137
 
                                $packet->push("answer", $a);
138
 
                        }
 
138
                if ("$qname $qtype" =~ /$dbtype/) {
 
139
                        my $a;
 
140
                        foreach $a (@{$r->{answer}}) {
 
141
                                $packet->push("answer", $a);
 
142
                        }
139
143
                        if(defined($key_name) && defined($key_data)) {
140
144
                                # Sign the packet
141
145
                                print "  Signing the response with " .
142
 
                                      "$key_name/$key_data\n";
143
 
                                my $tsig = Net::DNS::RR->
144
 
                                        new("$key_name TSIG $key_data");
 
146
                                      "$key_name/$key_data\n";
 
147
                                my $tsig = Net::DNS::RR->
 
148
                                        new("$key_name TSIG $key_data");
145
149
 
146
 
                                # These kluges are necessary because Net::DNS
147
 
                                # doesn't know how to sign responses.  We
148
 
                                # clear compnames so that the TSIG key and
149
 
                                # algorithm name won't be compressed, and
150
 
                                # add one to arcount because the signing
151
 
                                # function will attempt to decrement it,
152
 
                                # which is incorrect in a response. Finally
153
 
                                # we set request_mac to the previous digest.
154
 
                                $packet->{"compnames"} = {};
155
 
                                $packet->{"header"}{"arcount"} += 1;
156
 
                                if (defined($prev_tsig)) {
157
 
                                        my $rmac = pack('n H*',
158
 
                                                $prev_tsig->mac_size,
159
 
                                                $prev_tsig->mac);
160
 
                                        $tsig->{"request_mac"} =
161
 
                                                unpack("H*", $rmac);
162
 
                                }
163
 
                                
 
150
                                # These kluges are necessary because Net::DNS
 
151
                                # doesn't know how to sign responses.  We
 
152
                                # clear compnames so that the TSIG key and
 
153
                                # algorithm name won't be compressed, and
 
154
                                # add one to arcount because the signing
 
155
                                # function will attempt to decrement it,
 
156
                                # which is incorrect in a response. Finally
 
157
                                # we set request_mac to the previous digest.
 
158
                                $packet->{"compnames"} = {};
 
159
                                $packet->{"header"}{"arcount"} += 1;
 
160
                                if (defined($prev_tsig)) {
 
161
                                        my $rmac = pack('n H*',
 
162
                                                $prev_tsig->mac_size,
 
163
                                                $prev_tsig->mac);
 
164
                                        $tsig->{"request_mac"} =
 
165
                                                unpack("H*", $rmac);
 
166
                                }
 
167
                                
164
168
                                $packet->sign_tsig($tsig);
165
169
                        }
166
 
                        last;
167
 
                }
168
 
        }
169
 
        #$packet->print;
 
170
                        last;
 
171
                }
 
172
        }
 
173
        #$packet->print;
170
174
 
171
 
        return $packet->data;
 
175
        return $packet->data;
172
176
}
173
177
 
174
178
# namelen:
175
179
# given a stream of data, reads a DNS-formatted name and returns its
176
180
# total length, thus making it possible to skip past it.
177
181
sub namelen {
178
 
        my ($data) = @_;
179
 
        my $len = 0;
180
 
        my $label_len = 0;
181
 
        do {
182
 
                $label_len = unpack("c", $data);
183
 
                $data = substr($data, $label_len + 1);
184
 
                $len += $label_len + 1;
185
 
        } while ($label_len != 0);
186
 
        return ($len);
 
182
        my ($data) = @_;
 
183
        my $len = 0;
 
184
        my $label_len = 0;
 
185
        do {
 
186
                $label_len = unpack("c", $data);
 
187
                $data = substr($data, $label_len + 1);
 
188
                $len += $label_len + 1;
 
189
        } while ($label_len != 0);
 
190
        return ($len);
187
191
}
188
192
 
189
193
# packetlen:
190
194
# given a stream of data, reads a DNS wire-format packet and returns
191
195
# its total length, making it possible to skip past it.
192
196
sub packetlen {
193
 
        my ($data) = @_;
194
 
        my $q;
195
 
        my $rr;
196
 
 
197
 
        my ($header, $offset) = Net::DNS::Header->parse(\$data);
198
 
        for (1 .. $header->qdcount) {
199
 
                ($q, $offset) = Net::DNS::Question->parse(\$data, $offset);
200
 
        }
201
 
        for (1 .. $header->ancount) {
202
 
                ($rr, $offset) = Net::DNS::RR->parse(\$data, $offset);
203
 
        }
204
 
        for (1 .. $header->nscount) {
205
 
                ($rr, $offset) = Net::DNS::RR->parse(\$data, $offset);
206
 
        }
207
 
        for (1 .. $header->arcount) {
208
 
                ($rr, $offset) = Net::DNS::RR->parse(\$data, $offset);
209
 
        }
210
 
        return $offset;
 
197
        my ($data) = @_;
 
198
        my $q;
 
199
        my $rr;
 
200
        my $header;
 
201
        my $offset;
 
202
 
 
203
        #
 
204
        # decode/encode were introduced in Net::DNS 0.68
 
205
        # parse is no longer a method and calling it here makes perl croak.
 
206
        #
 
207
        my $decode = 0;
 
208
        $decode = 1 if ($Net::DNS::VERSION >= 0.68);
 
209
 
 
210
        if ($decode) {
 
211
                ($header, $offset) = Net::DNS::Header->decode(\$data);
 
212
        } else {
 
213
                ($header, $offset) = Net::DNS::Header->parse(\$data);
 
214
        }
 
215
                
 
216
        for (1 .. $header->qdcount) {
 
217
                if ($decode) {
 
218
                        ($q, $offset) =
 
219
                                 Net::DNS::Question->decode(\$data, $offset);
 
220
                } else {
 
221
                        ($q, $offset) =
 
222
                                 Net::DNS::Question->parse(\$data, $offset);
 
223
                }
 
224
        }
 
225
        for (1 .. $header->ancount) {
 
226
                if ($decode) {
 
227
                        ($q, $offset) = Net::DNS::RR->decode(\$data, $offset);
 
228
                } else {
 
229
                        ($q, $offset) = Net::DNS::RR->parse(\$data, $offset);
 
230
                }
 
231
        }
 
232
        for (1 .. $header->nscount) {
 
233
                if ($decode) {
 
234
                        ($q, $offset) = Net::DNS::RR->decode(\$data, $offset);
 
235
                } else {
 
236
                        ($q, $offset) = Net::DNS::RR->parse(\$data, $offset);
 
237
                }
 
238
        }
 
239
        for (1 .. $header->arcount) {
 
240
                if ($decode) {
 
241
                        ($q, $offset) = Net::DNS::RR->decode(\$data, $offset);
 
242
                } else {
 
243
                        ($q, $offset) = Net::DNS::RR->parse(\$data, $offset);
 
244
                }
 
245
        }
 
246
        return $offset;
211
247
}
212
248
 
213
249
# sign_tcp_continuation:
222
258
# the unwanted data from the digest before calling the default sign_hmac
223
259
# function.
224
260
sub sign_tcp_continuation {
225
 
        my ($key, $data) = @_;
226
 
 
227
 
        # copy out first two bytes: size of the previous MAC
228
 
        my $rmacsize = unpack("n", $data);
229
 
        $data = substr($data, 2);
230
 
 
231
 
        # copy out previous MAC
232
 
        my $rmac = substr($data, 0, $rmacsize);
233
 
        $data = substr($data, $rmacsize);
234
 
 
235
 
        # try parsing out the packet information
236
 
        my $plen = packetlen($data);
237
 
        my $pdata = substr($data, 0, $plen);
238
 
        $data = substr($data, $plen);
239
 
 
240
 
        # remove the keyname, ttl, class, and algorithm name
241
 
        $data = substr($data, namelen($data));
242
 
        $data = substr($data, 6);
243
 
        $data = substr($data, namelen($data));
244
 
 
245
 
        # preserve the TSIG data
246
 
        my $tdata = substr($data, 0, 8);
247
 
 
248
 
        # prepare a new digest and sign with it
249
 
        $data = pack("n", $rmacsize) . $rmac . $pdata . $tdata;
250
 
        return Net::DNS::RR::TSIG::sign_hmac($key, $data);
 
261
        my ($key, $data) = @_;
 
262
 
 
263
        # copy out first two bytes: size of the previous MAC
 
264
        my $rmacsize = unpack("n", $data);
 
265
        $data = substr($data, 2);
 
266
 
 
267
        # copy out previous MAC
 
268
        my $rmac = substr($data, 0, $rmacsize);
 
269
        $data = substr($data, $rmacsize);
 
270
 
 
271
        # try parsing out the packet information
 
272
        my $plen = packetlen($data);
 
273
        my $pdata = substr($data, 0, $plen);
 
274
        $data = substr($data, $plen);
 
275
 
 
276
        # remove the keyname, ttl, class, and algorithm name
 
277
        $data = substr($data, namelen($data));
 
278
        $data = substr($data, 6);
 
279
        $data = substr($data, namelen($data));
 
280
 
 
281
        # preserve the TSIG data
 
282
        my $tdata = substr($data, 0, 8);
 
283
 
 
284
        # prepare a new digest and sign with it
 
285
        $data = pack("n", $rmacsize) . $rmac . $pdata . $tdata;
 
286
        return Net::DNS::RR::TSIG::sign_hmac($key, $data);
251
287
}
252
288
 
253
289
sub handleTCP {
254
290
        my ($buf) = @_;
255
291
 
256
 
        my ($packet, $err) = new Net::DNS::Packet(\$buf, 0);
 
292
        my ($request, $err) = new Net::DNS::Packet(\$buf, 0);
257
293
        $err and die $err;
258
294
        
 
295
        my @questions = $request->question;
 
296
        my $qname = $questions[0]->qname;
 
297
        my $qtype = $questions[0]->qtype;
 
298
        my $qclass = $questions[0]->qclass;
 
299
        my $id = $request->header->id;
 
300
 
 
301
        my $packet = new Net::DNS::Packet($qname, $qtype, $qclass);
259
302
        $packet->header->qr(1);
260
303
        $packet->header->aa(1);
261
 
        
262
 
        my @questions = $packet->question;
263
 
        my $qname = $questions[0]->qname;
264
 
        my $qtype = $questions[0]->qtype;
 
304
        $packet->header->id($id);
265
305
 
266
 
        # get the existing signature if any, and clear the additional section
267
 
        my $prev_tsig;
268
 
        my $signer;
269
 
        while (my $rr = $packet->pop("additional")) {
270
 
                if ($rr->type eq "TSIG") {
271
 
                        $prev_tsig = $rr;
272
 
                }
273
 
        }
 
306
        # get the existing signature if any, and clear the additional section
 
307
        my $prev_tsig;
 
308
        my $signer;
 
309
        while (my $rr = $request->pop("additional")) {
 
310
                if ($rr->type eq "TSIG") {
 
311
                        $prev_tsig = $rr;
 
312
                }
 
313
        }
274
314
 
275
315
        my @results = ();
276
316
        my $count_these = 0;
289
329
                        if(defined($key_name) && defined($key_data)) {
290
330
                                # sign the packet
291
331
                                print "  Signing the data with " . 
292
 
                                      "$key_name/$key_data\n";
293
 
 
294
 
                                my $tsig = Net::DNS::RR->
295
 
                                        new("$key_name TSIG $key_data");
296
 
 
297
 
                                # These kluges are necessary because Net::DNS
298
 
                                # doesn't know how to sign responses.  We
299
 
                                # clear compnames so that the TSIG key and
300
 
                                # algorithm name won't be compressed, and
301
 
                                # add one to arcount because the signing
302
 
                                # function will attempt to decrement it,
303
 
                                # which is incorrect in a response. Finally
304
 
                                # we set request_mac to the previous digest.
305
 
                                $packet->{"compnames"} = {};
306
 
                                $packet->{"header"}{"arcount"} += 1;
307
 
                                if (defined($prev_tsig)) {
308
 
                                        my $rmac = pack('n H*',
309
 
                                                $prev_tsig->mac_size,
310
 
                                                $prev_tsig->mac);
311
 
                                        $tsig->{"request_mac"} =
312
 
                                                unpack("H*", $rmac);
313
 
                                }
314
 
                                
315
 
                                $tsig->sign_func($signer) if defined($signer);
 
332
                                      "$key_name/$key_data\n";
 
333
 
 
334
                                my $tsig = Net::DNS::RR->
 
335
                                        new("$key_name TSIG $key_data");
 
336
 
 
337
                                # These kluges are necessary because Net::DNS
 
338
                                # doesn't know how to sign responses.  We
 
339
                                # clear compnames so that the TSIG key and
 
340
                                # algorithm name won't be compressed, and
 
341
                                # add one to arcount because the signing
 
342
                                # function will attempt to decrement it,
 
343
                                # which is incorrect in a response. Finally
 
344
                                # we set request_mac to the previous digest.
 
345
                                $packet->{"compnames"} = {};
 
346
                                $packet->{"header"}{"arcount"} += 1;
 
347
                                if (defined($prev_tsig)) {
 
348
                                        my $rmac = pack('n H*',
 
349
                                                $prev_tsig->mac_size,
 
350
                                                $prev_tsig->mac);
 
351
                                        $tsig->{"request_mac"} =
 
352
                                                unpack("H*", $rmac);
 
353
                                }
 
354
                                
 
355
                                $tsig->sign_func($signer) if defined($signer);
316
356
                                $packet->sign_tsig($tsig);
317
 
                                $signer = \&sign_tcp_continuation;
 
357
                                $signer = \&sign_tcp_continuation;
318
358
 
319
 
                                my $copy =
320
 
                                        Net::DNS::Packet->new(\($packet->data));
321
 
                                $prev_tsig = $copy->pop("additional");
 
359
                                my $copy =
 
360
                                        Net::DNS::Packet->new(\($packet->data));
 
361
                                $prev_tsig = $copy->pop("additional");
322
362
                        }
323
363
                        #$packet->print;
324
364
                        push(@results,$packet->data);
325
 
                        $packet = new Net::DNS::Packet(\$buf, 0);
 
365
                        $packet = new Net::DNS::Packet($qname, $qtype, $qclass);
326
366
                        $packet->header->qr(1);
327
367
                        $packet->header->aa(1);
 
368
                        $packet->header->id($id);
328
369
                }
329
370
        }
330
371
        print " A total of $count_these patterns matched\n";
358
399
                        }
359
400
                }
360
401
                $conn->close;
361
 
                #print Dumper(@rules);
362
 
                #print "+=+=+ $rules[0]->{'pattern'}\n";
363
 
                #print "+=+=+ $rules[0]->{'answer'}->[0]->{'rname'}\n";
364
 
                #print "+=+=+ $rules[0]->{'answer'}->[0]\n";
 
402
                #print Dumper(@rules);
 
403
                #print "+=+=+ $rules[0]->{'pattern'}\n";
 
404
                #print "+=+=+ $rules[0]->{'answer'}->[0]->{'rname'}\n";
 
405
                #print "+=+=+ $rules[0]->{'answer'}->[0]\n";
365
406
        } elsif (vec($rout, fileno($udpsock), 1)) {
366
407
                printf "UDP request\n";
367
408
                my $buf;