home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / TSIG.pm < prev    next >
Encoding:
Perl POD Document  |  2004-01-04  |  8.9 KB  |  352 lines
  1. package Net::DNS::RR::TSIG;
  2. #
  3. # $Id: TSIG.pm,v 2.101 2004/01/04 04:31:11 ctriv Exp $
  4. #
  5. use strict;
  6. use vars qw(@ISA $VERSION);
  7.  
  8. use Net::DNS::Packet;
  9. use Digest::HMAC_MD5;
  10. use MIME::Base64;
  11.  
  12. use constant DEFAULT_ALGORITHM => "HMAC-MD5.SIG-ALG.REG.INT";
  13. use constant DEFAULT_FUDGE     => 300;
  14.  
  15. @ISA     = qw(Net::DNS::RR);
  16. $VERSION = (qw$Revision: 2.101 $)[1];
  17.  
  18. # a signing function for the HMAC-MD5 algorithm. This can be overridden using
  19. # the sign_func element
  20. sub sign_hmac {
  21.     my ($key, $data) = @_;
  22.  
  23.     $key =~ s/ //g;
  24.     $key = decode_base64($key);
  25.  
  26.     my $hmac = Digest::HMAC_MD5->new($key);
  27.     $hmac->add($data);
  28.  
  29.     return $hmac->digest;
  30. }
  31.  
  32. sub new {
  33.     my ($class, $self, $data, $offset) = @_;
  34.  
  35.     if ($self->{"rdlength"} > 0) {
  36.         ($self->{"algorithm"}, $offset) = Net::DNS::Packet::dn_expand($data, $offset);
  37.  
  38.         my ($time_high, $time_low) = unpack("\@$offset nN", $$data);
  39.         $self->{"time_signed"} = $time_low;    # bug
  40.         $offset += &Net::DNS::INT16SZ + &Net::DNS::INT32SZ;
  41.  
  42.         @{$self}{qw(fudge mac_size)} = unpack("\@$offset nn", $$data);
  43.         $offset += &Net::DNS::INT16SZ + &Net::DNS::INT16SZ;
  44.  
  45.         $self->{"mac"} = substr($$data, $offset, $self->{'mac_size'});
  46.         $offset += $self->{'mac_size'};
  47.  
  48.         @{$self}{qw(original_id error other_len)} = unpack("\@$offset nnn", $$data);
  49.         $offset += &Net::DNS::INT16SZ * 3;
  50.  
  51.         my $odata = substr($$data, $offset, $self->{'other_len'});
  52.         my ($odata_high, $odata_low) = unpack("nN", $odata);
  53.         $self->{"other_data"} = $odata_low;
  54.     }
  55.  
  56.     return bless $self, $class;
  57. }
  58.  
  59. sub new_from_string {
  60.     my ($class, $self, $string) = @_;
  61.  
  62.     if ($string && ($string =~ /^(.*)$/)) {
  63.         $self->{"key"}     = $1;
  64.     }
  65.  
  66.     $self->{"algorithm"}   = DEFAULT_ALGORITHM;
  67.     $self->{"time_signed"} = time;
  68.     $self->{"fudge"}       = DEFAULT_FUDGE;
  69.     $self->{"mac_size"}    = 0;
  70.     $self->{"mac"}         = "";
  71.     $self->{"original_id"} = 0;
  72.     $self->{"error"}       = 0;
  73.     $self->{"other_len"}   = 0;
  74.     $self->{"other_data"}  = "";
  75.     $self->{"sign_func"}   = \&sign_hmac;
  76.  
  77.     # RFC 2845 Section 2.3
  78.     $self->{"class"} = "ANY";
  79.  
  80.     return bless $self, $class;
  81. }
  82.  
  83. sub error {
  84.     my $self = shift;
  85.  
  86.     my $rcode;
  87.     my $error = $self->{"error"};
  88.  
  89.     if (defined($error)) {
  90.         $rcode = $Net::DNS::rcodesbyval{$error} || $error;
  91.     }
  92.  
  93.     return $rcode;
  94. }
  95.  
  96. sub mac_size {
  97.     my $self = shift;
  98.     return length(defined($self->{"mac"}) ? $self->{"mac"} : "");
  99. }
  100.  
  101. sub mac {
  102.     my $self = shift;
  103.     my $mac = unpack("H*", $self->{"mac"}) if defined($self->{"mac"});
  104.     return $mac;
  105. }
  106.  
  107. sub rdatastr {
  108.     my $self = shift;
  109.  
  110.     my $error = $self->error;
  111.     $error = "UNDEFINED" unless defined $error;
  112.  
  113.     my $rdatastr;
  114.  
  115.     if (exists $self->{"algorithm"}) {
  116.         $rdatastr = "$self->{algorithm}. $error";
  117.         if ($self->{"other_len"} && defined($self->{"other_data"})) {
  118.             $rdatastr .= " $self->{other_data}";
  119.         }
  120.     } else {
  121.         $rdatastr = "";
  122.     }
  123.  
  124.     return $rdatastr;
  125. }
  126.  
  127. # return the data that needs to be signed/verified. This is useful for
  128. # external TSIG verification routines
  129. sub sig_data {
  130.     my ($self, $packet) = @_;
  131.     my ($newpacket, $sigdata);
  132.  
  133.     # XXX this is horrible.  $pkt = Net::DNS::Packet->clone($packet); maybe?
  134.     bless($newpacket = {},"Net::DNS::Packet");
  135.     %{$newpacket} = %{$packet};
  136.     bless($newpacket->{"header"} = {},"Net::DNS::Header");
  137.     $newpacket->{"additional"} = [];
  138.     %{$newpacket->{"header"}} = %{$packet->{"header"}};
  139.     @{$newpacket->{"additional"}} = @{$packet->{"additional"}};
  140.     shift(@{$newpacket->{"additional"}});
  141.     $newpacket->{"header"}{"arcount"}--;
  142.     $newpacket->{"compnames"} = {};
  143.  
  144.     # Add the request MAC if present (used to validate responses).
  145.     $sigdata .= pack("H*", $self->{"request_mac"})
  146.         if $self->{"request_mac"};
  147.  
  148.     $sigdata .= $newpacket->data;
  149.  
  150.     # Don't compress the record (key) name.
  151.     my $tmppacket = Net::DNS::Packet->new("");
  152.     $sigdata .= $tmppacket->dn_comp(lc($self->{"name"}), 0);
  153.     
  154.     $sigdata .= pack("n", $Net::DNS::classesbyname{uc($self->{"class"})});
  155.     $sigdata .= pack("N", $self->{"ttl"});
  156.     
  157.     # Don't compress the algorithm name.
  158.     $tmppacket->{"compnames"} = {};
  159.     $sigdata .= $tmppacket->dn_comp(lc($self->{"algorithm"}), 0);
  160.     
  161.     $sigdata .= pack("nN", 0, $self->{"time_signed"});    # bug
  162.     $sigdata .= pack("n", $self->{"fudge"});
  163.     $sigdata .= pack("nn", $self->{"error"}, $self->{"other_len"});
  164.     
  165.     $sigdata .= pack("nN", 0, $self->{"other_data"})
  166.         if $self->{"other_data"};
  167.     
  168.     return $sigdata;
  169. }
  170.  
  171. sub rr_rdata {
  172.     my ($self, $packet, $offset) = @_;
  173.     my $rdata = "";
  174.  
  175.     if (exists $self->{"key"}) {
  176.         # form the data to be signed
  177.         my $sigdata = $self->sig_data($packet);
  178.  
  179.         # and call the signing function
  180.         $self->{"mac"} = &{$self->{"sign_func"}}($self->{"key"}, $sigdata);
  181.         $self->{"mac_size"} = length($self->{"mac"});
  182.  
  183.         # construct the signed TSIG record
  184.         $packet->{"compnames"} = {};
  185.         $rdata .= $packet->dn_comp($self->{"algorithm"}, 0);
  186.  
  187.         $rdata .= pack("nN", 0, $self->{"time_signed"});    # bug
  188.         $rdata .= pack("nn", $self->{"fudge"}, $self->{"mac_size"});
  189.         $rdata .= $self->{"mac"};
  190.  
  191.         $rdata .= pack("nnn",($packet->{"header"}->{"id"},
  192.                               $self->{"error"},
  193.                               $self->{"other_len"}));
  194.  
  195.         $rdata .= pack("nN", 0, $self->{"other_data"})
  196.             if $self->{"other_data"};
  197.     }
  198.  
  199.     return $rdata;
  200. }
  201.  
  202. 1;
  203. __END__
  204.  
  205. =head1 NAME
  206.  
  207. Net::DNS::RR::TSIG - DNS TSIG resource record
  208.  
  209. =head1 SYNOPSIS
  210.  
  211. C<use Net::DNS::RR>;
  212.  
  213. =head1 DESCRIPTION
  214.  
  215. Class for DNS Transaction Signature (TSIG) resource records.
  216.  
  217. =head1 METHODS
  218.  
  219. =head2 algorithm
  220.  
  221.     $rr->algorithm($algorithm_name);
  222.     print "algorithm = ", $rr->algorithm, "\n";
  223.  
  224. Gets or sets the domain name that specifies the name of the algorithm.
  225. The only algorithm currently supported is HMAC-MD5.SIG-ALG.REG.INT.
  226.  
  227. =head2 time_signed
  228.  
  229.     $rr->time_signed(time);
  230.     print "time signed = ", $rr->time_signed, "\n";
  231.  
  232. Gets or sets the signing time as the number of seconds since 1 Jan 1970
  233. 00:00:00 UTC.
  234.  
  235. The default signing time is the current time.
  236.  
  237. =head2 fudge
  238.  
  239.     $rr->fudge(60);
  240.     print "fudge = ", $rr->fudge, "\n";
  241.  
  242. Gets or sets the "fudge", i.e., the seconds of error permitted in the
  243. signing time.
  244.  
  245. The default fudge is 300 seconds.
  246.  
  247. =head2 mac_size
  248.  
  249.     print "MAC size = ", $rr->mac_size, "\n";
  250.  
  251. Returns the number of octets in the message authentication code (MAC).
  252. The programmer must call a Net::DNS::Packet object's data method
  253. before this will return anything meaningful.
  254.  
  255. =head2 mac
  256.  
  257.     print "MAC = ", $rr->mac, "\n";
  258.  
  259. Returns the message authentication code (MAC) as a string of hex
  260. characters.  The programmer must call a Net::DNS::Packet object's
  261. data method before this will return anything meaningful.
  262.  
  263. =head2 original_id
  264.  
  265.     $rr->original_id(12345);
  266.     print "original ID = ", $rr->original_id, "\n";
  267.  
  268. Gets or sets the original message ID.
  269.  
  270. =head2 error
  271.  
  272.     print "error = ", $rr->error, "\n";
  273.  
  274. Returns the RCODE covering TSIG processing.  Common values are
  275. NOERROR, BADSIG, BADKEY, and BADTIME.  See RFC 2845 for details.
  276.  
  277. =head2 other_len
  278.  
  279.     print "other len = ", $rr->other_len, "\n";
  280.  
  281. Returns the length of the Other Data.  Should be zero unless the
  282. error is BADTIME.
  283.  
  284. =head2 other_data
  285.  
  286.     print "other data = ", $rr->other_data, "\n";
  287.  
  288. Returns the Other Data.  This field should be empty unless the
  289. error is BADTIME, in which case it will contain the server's
  290. time as the number of seconds since 1 Jan 1970 00:00:00 UTC.
  291.  
  292. =head2 sig_data
  293.  
  294.      my $sigdata = $tsig->sig_data($packet);
  295.  
  296. Returns the packet packed according to RFC2845 in a form for signing. This
  297. is only needed if you want to supply an external signing function, such as is 
  298. needed for TSIG-GSS. 
  299.  
  300. =head2 sign_func
  301.  
  302.      sub my_sign_fn($$) {
  303.          my ($key, $data) = @_;
  304.          
  305.          return some_digest_algorithm($key, $data);
  306.      }
  307.  
  308.      $tsig->sign_func(\&my_sign_fn);
  309.  
  310. This sets the signing function to be used for this TSIG record. 
  311.  
  312. The default signing function is HMAC-MD5.
  313.  
  314. =head1 BUGS
  315.  
  316. This code is still under development.  Use with caution on production
  317. systems.
  318.  
  319. The time_signed and other_data fields should be 48-bit unsigned
  320. integers (RFC 2845, Sections 2.3 and 4.5.2).  The current implementation
  321. ignores the upper 16 bits; this will cause problems for times later
  322. than 19 Jan 2038 03:14:07 UTC.
  323.  
  324. The only builtin algorithm currently supported is
  325. HMAC-MD5.SIG-ALG.REG.INT. You can use other algorithms by supplying an
  326. appropriate sign_func.
  327.  
  328. =head1 COPYRIGHT
  329.  
  330. Copyright (c) 2002 Michael Fuhr. 
  331.  
  332. Portions Copyright (c) 2002-2003 Chris Reinhardt.
  333.  
  334. All rights reserved.  This program is free software; you may redistribute
  335. it and/or modify it under the same terms as Perl itself.
  336.  
  337. =head1 ACKNOWLEDGMENT
  338.  
  339. Most of the code in the Net::DNS::RR::TSIG module was contributed
  340. by Chris Turbeville. 
  341.  
  342. Support for external signing functions was added by Andrew Tridgell.
  343.  
  344. =head1 SEE ALSO
  345.  
  346. L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
  347. L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
  348. RFC 2845
  349.  
  350. =cut
  351.  
  352.