File: TSIG.pm

package info (click to toggle)
libnet-dns-perl 0.59-1etch1
  • links: PTS
  • area: main
  • in suites: etch
  • size: 828 kB
  • ctags: 400
  • sloc: perl: 6,650; sh: 220; ansic: 101; makefile: 60
file content (353 lines) | stat: -rw-r--r-- 8,834 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
package Net::DNS::RR::TSIG;
#
# $Id: TSIG.pm 388 2005-06-22 10:06:05Z olaf $
#
use strict;
BEGIN { 
    eval { require bytes; }
} 
use vars qw(@ISA $VERSION);

use Digest::HMAC_MD5;
use MIME::Base64;

use constant DEFAULT_ALGORITHM => "HMAC-MD5.SIG-ALG.REG.INT";
use constant DEFAULT_FUDGE     => 300;

@ISA     = qw(Net::DNS::RR);
$VERSION = (qw$LastChangedRevision: 388 $)[1];

# a signing function for the HMAC-MD5 algorithm. This can be overridden using
# the sign_func element
sub sign_hmac {
	my ($key, $data) = @_;

	$key =~ s/ //g;
	$key = decode_base64($key);

	my $hmac = Digest::HMAC_MD5->new($key);
	$hmac->add($data);

	return $hmac->digest;
}

sub new {
	my ($class, $self, $data, $offset) = @_;

	if ($self->{"rdlength"} > 0) {
		($self->{"algorithm"}, $offset) = Net::DNS::Packet::dn_expand($data, $offset);

		my ($time_high, $time_low) = unpack("\@$offset nN", $$data);
		$self->{"time_signed"} = $time_low;	# bug
		$offset += Net::DNS::INT16SZ() + Net::DNS::INT32SZ();

		@{$self}{qw(fudge mac_size)} = unpack("\@$offset nn", $$data);
		$offset += Net::DNS::INT16SZ() + Net::DNS::INT16SZ();

		$self->{"mac"} = substr($$data, $offset, $self->{'mac_size'});
		$offset += $self->{'mac_size'};

		@{$self}{qw(original_id error other_len)} = unpack("\@$offset nnn", $$data);
		$offset += Net::DNS::INT16SZ() * 3;

		my $odata = substr($$data, $offset, $self->{'other_len'});
		my ($odata_high, $odata_low) = unpack("nN", $odata);
		$self->{"other_data"} = $odata_low;
	}

	return bless $self, $class;
}

sub new_from_string {
	my ($class, $self, $string) = @_;

	if ($string && ($string =~ /^(.*)$/)) {
		$self->{"key"}     = $1;
	}

	$self->{"algorithm"}   = DEFAULT_ALGORITHM;
	$self->{"time_signed"} = time;
	$self->{"fudge"}       = DEFAULT_FUDGE;
	$self->{"mac_size"}    = 0;
	$self->{"mac"}         = "";
	$self->{"original_id"} = 0;
	$self->{"error"}       = 0;
	$self->{"other_len"}   = 0;
	$self->{"other_data"}  = "";
	$self->{"sign_func"}   = \&sign_hmac;

	# RFC 2845 Section 2.3
	$self->{"class"} = "ANY";

	return bless $self, $class;
}

sub error {
	my $self = shift;

	my $rcode;
	my $error = $self->{"error"};

	if (defined($error)) {
		$rcode = $Net::DNS::rcodesbyval{$error} || $error;
	}

	return $rcode;
}

sub mac_size {
	my $self = shift;
	return length(defined($self->{"mac"}) ? $self->{"mac"} : "");
}

sub mac {
	my $self = shift;
	my $mac = unpack("H*", $self->{"mac"}) if defined($self->{"mac"});
	return $mac;
}

sub rdatastr {
	my $self = shift;

	my $error = $self->error;
	$error = "UNDEFINED" unless defined $error;

	my $rdatastr;

	if (exists $self->{"algorithm"}) {
		$rdatastr = "$self->{algorithm}. $error";
		if ($self->{"other_len"} && defined($self->{"other_data"})) {
			$rdatastr .= " $self->{other_data}";
		}
	} else {
		$rdatastr = "";
	}

	return $rdatastr;
}

# return the data that needs to be signed/verified. This is useful for
# external TSIG verification routines
sub sig_data {
	my ($self, $packet) = @_;
	my ($newpacket, $sigdata);

	# XXX this is horrible.  $pkt = Net::DNS::Packet->clone($packet); maybe?
	bless($newpacket = {},"Net::DNS::Packet");
	%{$newpacket} = %{$packet};
	bless($newpacket->{"header"} = {},"Net::DNS::Header");
	$newpacket->{"additional"} = [];
	%{$newpacket->{"header"}} = %{$packet->{"header"}};
	@{$newpacket->{"additional"}} = @{$packet->{"additional"}};
	shift(@{$newpacket->{"additional"}});
	$newpacket->{"header"}{"arcount"}--;
	$newpacket->{"compnames"} = {};

	# Add the request MAC if present (used to validate responses).
	$sigdata .= pack("H*", $self->{"request_mac"})
	    if $self->{"request_mac"};

	$sigdata .= $newpacket->data;

	# Don't compress the record (key) name.
	my $tmppacket = Net::DNS::Packet->new("");
	$sigdata .= $tmppacket->dn_comp(lc($self->{"name"}), 0);
	
	$sigdata .= pack("n", $Net::DNS::classesbyname{uc($self->{"class"})});
	$sigdata .= pack("N", $self->{"ttl"});
	
	# Don't compress the algorithm name.
	$tmppacket->{"compnames"} = {};
	$sigdata .= $tmppacket->dn_comp(lc($self->{"algorithm"}), 0);
	
	$sigdata .= pack("nN", 0, $self->{"time_signed"});	# bug
	$sigdata .= pack("n", $self->{"fudge"});
	$sigdata .= pack("nn", $self->{"error"}, $self->{"other_len"});
	
	$sigdata .= pack("nN", 0, $self->{"other_data"})
	    if $self->{"other_data"};
	
	return $sigdata;
}

sub rr_rdata {
	my ($self, $packet, $offset) = @_;
	my $rdata = "";

	if (exists $self->{"key"}) {
		# form the data to be signed
		my $sigdata = $self->sig_data($packet);

		# and call the signing function
		$self->{"mac"} = &{$self->{"sign_func"}}($self->{"key"}, $sigdata);
		$self->{"mac_size"} = length($self->{"mac"});

		# construct the signed TSIG record
		$packet->{"compnames"} = {};
		$rdata .= $packet->dn_comp($self->{"algorithm"}, 0);

		$rdata .= pack("nN", 0, $self->{"time_signed"});	# bug
		$rdata .= pack("nn", $self->{"fudge"}, $self->{"mac_size"});
		$rdata .= $self->{"mac"};

		$rdata .= pack("nnn",($packet->{"header"}->{"id"},
		                      $self->{"error"},
		                      $self->{"other_len"}));

		$rdata .= pack("nN", 0, $self->{"other_data"})
		    if $self->{"other_data"};
	}

	return $rdata;
}

1;
__END__

=head1 NAME

Net::DNS::RR::TSIG - DNS TSIG resource record

=head1 SYNOPSIS

C<use Net::DNS::RR>;

=head1 DESCRIPTION

Class for DNS Transaction Signature (TSIG) resource records.

=head1 METHODS

=head2 algorithm

    $rr->algorithm($algorithm_name);
    print "algorithm = ", $rr->algorithm, "\n";

Gets or sets the domain name that specifies the name of the algorithm.
The only algorithm currently supported is HMAC-MD5.SIG-ALG.REG.INT.

=head2 time_signed

    $rr->time_signed(time);
    print "time signed = ", $rr->time_signed, "\n";

Gets or sets the signing time as the number of seconds since 1 Jan 1970
00:00:00 UTC.

The default signing time is the current time.

=head2 fudge

    $rr->fudge(60);
    print "fudge = ", $rr->fudge, "\n";

Gets or sets the "fudge", i.e., the seconds of error permitted in the
signing time.

The default fudge is 300 seconds.

=head2 mac_size

    print "MAC size = ", $rr->mac_size, "\n";

Returns the number of octets in the message authentication code (MAC).
The programmer must call a Net::DNS::Packet object's data method
before this will return anything meaningful.

=head2 mac

    print "MAC = ", $rr->mac, "\n";

Returns the message authentication code (MAC) as a string of hex
characters.  The programmer must call a Net::DNS::Packet object's
data method before this will return anything meaningful.

=head2 original_id

    $rr->original_id(12345);
    print "original ID = ", $rr->original_id, "\n";

Gets or sets the original message ID.

=head2 error

    print "error = ", $rr->error, "\n";

Returns the RCODE covering TSIG processing.  Common values are
NOERROR, BADSIG, BADKEY, and BADTIME.  See RFC 2845 for details.

=head2 other_len

    print "other len = ", $rr->other_len, "\n";

Returns the length of the Other Data.  Should be zero unless the
error is BADTIME.

=head2 other_data

    print "other data = ", $rr->other_data, "\n";

Returns the Other Data.  This field should be empty unless the
error is BADTIME, in which case it will contain the server's
time as the number of seconds since 1 Jan 1970 00:00:00 UTC.

=head2 sig_data

     my $sigdata = $tsig->sig_data($packet);

Returns the packet packed according to RFC2845 in a form for signing. This
is only needed if you want to supply an external signing function, such as is 
needed for TSIG-GSS. 

=head2 sign_func

     sub my_sign_fn($$) {
	     my ($key, $data) = @_;
	     
	     return some_digest_algorithm($key, $data);
     }

     $tsig->sign_func(\&my_sign_fn);

This sets the signing function to be used for this TSIG record. 

The default signing function is HMAC-MD5.

=head1 BUGS

This code is still under development.  Use with caution on production
systems.

The time_signed and other_data fields should be 48-bit unsigned
integers (RFC 2845, Sections 2.3 and 4.5.2).  The current implementation
ignores the upper 16 bits; this will cause problems for times later
than 19 Jan 2038 03:14:07 UTC.

The only builtin algorithm currently supported is
HMAC-MD5.SIG-ALG.REG.INT. You can use other algorithms by supplying an
appropriate sign_func.

=head1 COPYRIGHT

Copyright (c) 2002 Michael Fuhr. 

Portions Copyright (c) 2002-2004 Chris Reinhardt.

All rights reserved.  This program is free software; you may redistribute
it and/or modify it under the same terms as Perl itself.

=head1 ACKNOWLEDGMENT

Most of the code in the Net::DNS::RR::TSIG module was contributed
by Chris Turbeville. 

Support for external signing functions was added by Andrew Tridgell.

=head1 SEE ALSO

L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
RFC 2845

=cut