diff -urN Net-DNS-2002-10-10.orig/lib/Net/DNS.pm Net-DNS-2002-10-10/lib/Net/DNS.pm --- Net-DNS-2002-10-10.orig/lib/Net/DNS.pm 2002-10-02 16:01:34.000000000 +1000 +++ Net-DNS-2002-10-10/lib/Net/DNS.pm 2002-10-14 08:45:42.000000000 +1000 @@ -87,6 +87,7 @@ "UID" => 101, # non-standard "GID" => 102, # non-standard "UNSPEC" => 103, # non-standard + "TKEY" => 249, # RFC 2930 "TSIG" => 250, # RFC 2931 "IXFR" => 251, # RFC 1995 "AXFR" => 252, # RFC 1035 diff -urN Net-DNS-2002-10-10.orig/lib/Net/DNS/RR.pm Net-DNS-2002-10-10/lib/Net/DNS/RR.pm --- Net-DNS-2002-10-10.orig/lib/Net/DNS/RR.pm 2002-08-21 10:10:55.000000000 +1000 +++ Net-DNS-2002-10-10/lib/Net/DNS/RR.pm 2002-10-14 08:46:17.000000000 +1000 @@ -69,6 +69,7 @@ RT SOA SRV + TKEY TSIG TXT X25 @@ -493,8 +494,8 @@ my $data; - # Don't compress TSIG names and don't mess with EDNS0 packets - if (uc($self->{"type"}) eq "TSIG") { + # Don't compress TSIG or TKEY names and don't mess with EDNS0 packets + if (uc($self->{"type"}) eq "TSIG" || uc($self->{"type"}) eq "TKEY") { my $tmp_packet = Net::DNS::Packet->new(""); $data = $tmp_packet->dn_comp($self->{"name"}, 0); } elsif (uc($self->{"type"}) eq "OPT") { diff -urN Net-DNS-2002-10-10.orig/lib/Net/DNS/RR/TKEY.pm Net-DNS-2002-10-10/lib/Net/DNS/RR/TKEY.pm --- Net-DNS-2002-10-10.orig/lib/Net/DNS/RR/TKEY.pm Thu Jan 01 10:00:00 1970 +++ Net-DNS-2002-10-10/lib/Net/DNS/RR/TKEY.pm Mon Oct 14 10:17:49 2002 @@ -0,0 +1,212 @@ +package Net::DNS::RR::TKEY; + +use strict; +use vars qw(@ISA); + +use Net::DNS::Packet; +use Digest::HMAC_MD5; +use MIME::Base64; + +@ISA = qw(Net::DNS::RR); + +sub new { + my ($class, $self, $data, $offset) = @_; + + # if we have some data then we are parsing an incoming TKEY packet + # see RFC2930 for the packet format + if ($self->{"rdlength"} > 0) { + my $alg; + ($alg, $offset) = Net::DNS::Packet::dn_expand($data, $offset); + $self->{"algorithm"} = $alg; + + my ($inception, $expiration) = unpack("\@$offset NN", $$data); + $self->{"inception"} = $inception; + $self->{"expiration"} = $expiration; + $offset += &Net::DNS::INT32SZ + &Net::DNS::INT32SZ; + + my ($mode, $error) = unpack("\@$offset nn", $$data); + $self->{"mode"} = $mode; + $self->{"error"} = $error; + $offset += &Net::DNS::INT16SZ + &Net::DNS::INT16SZ; + + my ($key_len) = unpack("\@$offset n", $$data); + $offset += &Net::DNS::INT16SZ; + my $key = substr($$data, $offset, $key_len); + $self->{"key"} = $key; + $offset += $key_len; + + my ($other_len) = unpack("\@$offset n", $$data); + $offset += &Net::DNS::INT16SZ; + my $otherdata = substr($$data, $offset, $other_len); + $self->{"other_data"} = $otherdata; + $offset += $other_len; + } + + return bless $self, $class; +} + +sub new_from_string { + my ($class, $self, $string) = @_; + + if ($string && ($string =~ /^(.*)$/)) { + $self->{"key"} = $1; + } + + $self->{"algorithm"} = "gss.microsoft.com"; + $self->{"inception"} = time; + $self->{"expiration"} = time + 24*60*60; + $self->{"mode"} = 3; # GSSAPI + $self->{"error"} = 0; + $self->{"other_len"} = 0; + $self->{"other_data"} = ""; + + 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 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 = "; no data"; + } + + return $rdatastr; +} + +sub rr_rdata { + my ($self, $packet, $offset) = @_; + my $rdata = ""; + + $packet->{"compnames"} = {}; + $rdata .= $packet->dn_comp($self->{"algorithm"}, 0); + $rdata .= pack("N", $self->{"inception"}); + $rdata .= pack("N", $self->{"expiration"}); + $rdata .= pack("n", $self->{"mode"}); + $rdata .= pack("n", 0); # error + $rdata .= pack("n", length($self->{"key"})); + $rdata .= $self->{"key"}; + $rdata .= pack("n", length($self->{"other_data"})); + $rdata .= $self->{"other_data"}; + + return $rdata; +} + +1; +__END__ + +=head1 NAME + +Net::DNS::RR::TKEY - DNS TKEY resource record + +=head1 SYNOPSIS + +C; + +=head1 DESCRIPTION + +Class for DNS TKEY 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 default algorithm is gss.microsoft.com + +=head2 inception + + $rr->inception(time); + print "inception = ", $rr->inception, "\n"; + +Gets or sets the inception time as the number of seconds since 1 Jan 1970 +00:00:00 UTC. + +The default inception time is the current time. + +=head2 expiration + + $rr->expiration(time); + print "expiration = ", $rr->expiration, "\n"; + +Gets or sets the expiration time as the number of seconds since 1 Jan 1970 +00:00:00 UTC. + +The default expiration time is the current time plus 1 day. + +=head2 mode + + $rr->mode(3); + print "mode = ", $rr->mode, "\n"; + +Sets the key mode (see rfc2930). The default is 3 which corresponds to GSSAPI + +=head2 error + + print "error = ", $rr->error, "\n"; + +Returns the RCODE covering TKEY processing. See RFC 2930 for details. + +=head2 other_len + + print "other len = ", $rr->other_len, "\n"; + +Returns the length of the Other Data. Should be zero. + +=head2 other_data + + print "other data = ", $rr->other_data, "\n"; + +Returns the Other Data. This field should be empty. + +=head1 BUGS + +This code has not been extensively tested. Use with caution on +production systems. See http://samba.org/ftp/samba/tsig-gss/ for an +example usage. + +=head1 COPYRIGHT + +Copyright (c) 2000 Andrew Tridgell. All rights reserved. This program +is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +=head1 ACKNOWLEDGMENT + +The Net::DNS::RR::TKEY module is based on the TSIG module by Michael +Fuhr and Chris Turbeville. + +=head1 SEE ALSO + +L, L, L, L, +L, L, L, +RFC 2845 + +=cut + diff -urN Net-DNS-2002-10-10.orig/lib/Net/DNS/RR/TSIG.pm Net-DNS-2002-10-10/lib/Net/DNS/RR/TSIG.pm --- Net-DNS-2002-10-10.orig/lib/Net/DNS/RR/TSIG.pm 2002-02-13 15:07:50.000000000 +1100 +++ Net-DNS-2002-10-10/lib/Net/DNS/RR/TSIG.pm 2002-10-14 13:21:21.000000000 +1000 @@ -14,6 +14,20 @@ @ISA = qw(Net::DNS::RR); +# 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) = @_; @@ -66,6 +80,7 @@ $self->{"error"} = 0; $self->{"other_len"} = 0; $self->{"other_data"} = ""; + $self->{"sign_func"} = \&sign_hmac; # RFC 2845 Section 2.3 $self->{"class"} = "ANY"; @@ -118,62 +133,64 @@ 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); + + 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 ($hmac, $newpacket, $newoffset, $key, $sigdata); my $rdata = ""; if (exists $self->{"key"}) { - $key = $self->{"key"}; - $key =~ s/ //g; - $key = decode_base64($key); - - $hmac = Digest::HMAC_MD5->new($key); - bless($newpacket = {},"Net::DNS::Packet"); - $newoffset = $offset; - %{$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"} = {}; - - my $sigdata; - - # 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"}; - - $hmac->add($sigdata); + # form the data to be signed + my $sigdata = $self->sig_data($packet); - $self->{"mac"} = $hmac->digest; + # and call the signing function + $self->{"mac"} = $self->{"sign_func"}($self->{"key"}, $sigdata); $self->{"mac_size"} = length($self->{"mac"}); - # Don't compress the algorithm name. - $tmppacket->{"compnames"} = {}; - $rdata .= $tmppacket->dn_comp($self->{"algorithm"}, 0); + # 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"}); @@ -280,6 +297,30 @@ 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 = shift; + my $data = shift; + some_digest_algorithm($key, $data); + } + + $tsig->sign_func = \&my_sign_fn; + +This sets the signing function to be used for this TSIG record. See +http://samba.org/ftp/samba/tsig-gss/ for an example of how this can be +used. + +The default signing function is HMAC-MD5. + =head1 BUGS This code is still under development. Use with caution on production @@ -290,7 +331,9 @@ ignores the upper 16 bits; this will cause problems for times later than 19 Jan 2038 03:14:07 UTC. -The only algorithm currently supported is HMAC-MD5.SIG-ALG.REG.INT. +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 @@ -301,7 +344,9 @@ =head1 ACKNOWLEDGMENT Most of the code in the Net::DNS::RR::TSIG module was contributed -by Chris Turbeville. +by Chris Turbeville. + +Support for external signing functions was added by Andrew Tridgell. =head1 SEE ALSO diff -urN Net-DNS-2002-10-10.orig/lib/Net/DNS/Resolver.pm Net-DNS-2002-10-10/lib/Net/DNS/Resolver.pm --- Net-DNS-2002-10-10.orig/lib/Net/DNS/Resolver.pm 2002-09-20 17:01:59.000000000 +1000 +++ Net-DNS-2002-10-10/lib/Net/DNS/Resolver.pm 2002-10-14 09:33:19.000000000 +1000 @@ -708,14 +708,11 @@ print ';; sending ', length($packet_data), " bytes\n" if $self->{'debug'}; - unless ($sock->send($lenmsg)) { - $self->errorstring($!); - print ";; ERROR: send_tcp: length send failed: $!\n" - if $self->{'debug'}; - next; - } - - unless ($sock->send($packet_data)) { + # note that we send the length and packet data in a single call + # as this produces a single TCP packet rather than two. This + # is more efficient and also makes things much nicer for sniffers. + # (ethereal doesn't seem to reassemble DNS over TCP correctly) + unless ($sock->send($lenmsg . $packet_data)) { $self->errorstring($!); print ";; ERROR: send_tcp: data send failed: $!\n" if $self->{'debug'}; diff -urN Net-DNS-2002-10-10.orig/t/09-tkey.t Net-DNS-2002-10-10/t/09-tkey.t --- Net-DNS-2002-10-10.orig/t/09-tkey.t Thu Jan 01 10:00:00 1970 +++ Net-DNS-2002-10-10/t/09-tkey.t Mon Oct 14 13:20:22 2002 @@ -0,0 +1,100 @@ +use Test::More tests => 7; +use strict; +use Digest::HMAC_MD5; + +BEGIN { use_ok('Net::DNS'); } #1 + + +sub is_empty { + my ($string) = @_; + return ($string eq "; no data" || $string eq "; rdlength = 0"); +} + +#------------------------------------------------------------------------------ +# Canned data. +#------------------------------------------------------------------------------ + +my $zone = "example.com"; +my $name = "123456789-test"; +my $class = "IN"; +my $type = "TKEY"; +my $algorithm = "fake.algorithm.example.com"; +my $key = "fake key"; +my $inception = 100000; # use a strange fixed inception time to give a fixed + # checksum +my $expiration = $inception + 24*60*60; + +my $rr = undef; + +#------------------------------------------------------------------------------ +# Packet creation. +#------------------------------------------------------------------------------ + +$rr = Net::DNS::RR->new(Name => "$name", + Type => "TKEY", + TTL => 0, + Class => "ANY", + algorithm => $algorithm, + inception => $inception, + expiration => $expiration, + mode => 3, # GSSAPI + key => "fake key", + other_data => "", + ); + +my $packet = Net::DNS::Packet->new("$name", "TKEY", "IN"); +$packet->push("answer", $rr); + +my $z = ($packet->zone)[0]; + +ok($packet, 'new() returned packet'); #2 +is($packet->header->opcode, 'QUERY', 'header opcode correct'); #3 +is($z->zname, $name, 'zname correct'); #4 +is($z->zclass, "IN", 'zclass correct'); #5 +is($z->ztype, 'TKEY', 'ztype correct'); #6 + + +#------------------------------------------------------------------------------ +# create a signed TKEY query packet using an external signing function +# and compare it to a known good result. This effectively tests the +# sign_func and sig_data methods of TSIG as well. +#------------------------------------------------------------------------------ + +sub fake_sign { + my ($key, $data) = @_; + + my $hmac = Digest::HMAC_MD5->new($key); + $hmac->add($data); + + return $hmac->hexdigest; +} + +my $tsig = Net::DNS::RR->new( + Name => $name, + Type => "TSIG", + TTL => 0, + Class => "ANY", + Algorithm => $algorithm, + Time_Signed => $inception + 1, + Fudge => 36000, + Mac_Size => 0, + Mac => "", + Key => $key, + Sign_Func => \&fake_sign, + Other_Len => 0, + Other_Data => "", + Error => 0, + ); + +$packet->push("additional", $tsig); + +# use a fixed packet id so we get a known checksum +$packet->header->{'id'} = 1234; + +# create the packet - this will fill in the 'mac' field +my $raw_packet = $packet->data; + +is(($packet->additional)[0]->mac, + "6365643161343964663364643264656131306638303633626465366236643465", + 'MAC correct'); +