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 / CERT.pm < prev    next >
Encoding:
Perl POD Document  |  2004-01-04  |  4.4 KB  |  185 lines
  1. package Net::DNS::RR::CERT;
  2. #
  3. # $Id: CERT.pm,v 2.101 2004/01/04 04:31:10 ctriv Exp $
  4. #
  5. # Written by Mike Schiraldi <raldi@research.netsol.com> for VeriSign
  6.  
  7. use strict;
  8. use vars qw(@ISA $VERSION);
  9.  
  10. use Net::DNS;
  11. use Net::DNS::Packet;
  12. use MIME::Base64;
  13.  
  14. @ISA     = qw(Net::DNS::RR);
  15. $VERSION = (qw$Revision: 2.101 $)[1];
  16.  
  17. my %formats = 
  18.     (
  19.      PKIX => 1,
  20.      SPKI => 2,
  21.      PGP  => 3,
  22.      URI  => 253,
  23.      OID  => 254,
  24.      );
  25.  
  26. my %r_formats = reverse %formats;
  27.  
  28. my %algorithms = 
  29.     (
  30.      RSAMD5     => 1,
  31.      DH         => 2,
  32.      DSA        => 3,
  33.      ECC        => 4,
  34.      INDIRECT   => 252,
  35.      PRIVATEDNS => 253,
  36.      PRIVATEOID => 254,
  37.      );
  38.  
  39. my %r_algorithms = reverse %algorithms;
  40.  
  41. sub new {
  42.     my ($class, $self, $data, $offset) = @_;
  43.         
  44.     if ($self->{"rdlength"} > 0) {
  45.                 my ($format, $tag, $algorithm) = 
  46.                     unpack("\@$offset n2C", $$data);
  47.  
  48.         $offset += 2 * &Net::DNS::INT16SZ + 1;
  49.         my $certificate = substr($$data, $offset);
  50.                 
  51.         $self->{"format"}      = $format;
  52.         $self->{"tag"}         = $tag;
  53.         $self->{"algorithm"}   = $algorithm;
  54.         $self->{"certificate"} = $certificate;
  55.     }
  56.         
  57.     return bless $self, $class;
  58. }
  59.  
  60. sub new_from_string {
  61.     my ($class, $self, $string) = @_;        
  62.     $string or return bless $self, $class;
  63.         
  64.         my ($format, $tag, $algorithm, @rest) = split " ", $string;        
  65.         @rest or return bless $self, $class;
  66.         
  67.         # look up mnemonics
  68.         # the "die"s may be rash, but proceeding would be dangerous
  69.         if ($algorithm =~ /\D/) {
  70.                 my $tmp = $algorithms{$algorithm};
  71.                 defined $tmp or die 
  72.                     "Unknown algorithm mnemonic: '$algorithm'";
  73.                 
  74.                 $algorithm = $tmp;
  75.         }
  76.         
  77.         if ($format =~ /\D/) {
  78.                 my $tmp = $formats{$format};
  79.                 defined $tmp or die 
  80.                     "Unknown format mnemonic: '$format'";
  81.                 
  82.                 $format = $tmp;
  83.         }
  84.         
  85.         $self->{"format"}      = $format;
  86.         $self->{"tag"}         = $tag;
  87.         $self->{"algorithm"}   = $algorithm;
  88.         $self->{"certificate"} = MIME::Base64::decode join '', @rest;
  89.         
  90.     return bless $self, $class;
  91. }
  92.  
  93. sub rdatastr {
  94.     my $self = shift;
  95.     my $rdatastr;
  96.         
  97.     if (exists $self->{"format"}) {
  98.                 my $cert = MIME::Base64::encode $self->{certificate};
  99.                 $cert =~ s/\n//g;
  100.                 
  101.                 my $format = defined $r_formats{$self->{"format"}} 
  102.                 ? $r_formats{$self->{"format"}} : $self->{"format"};
  103.                 
  104.                 my $algorithm = defined $r_algorithms{$self->{algorithm}} 
  105.                 ? $r_algorithms{$self->{algorithm}} : $self->{algorithm};
  106.                 
  107.                 $rdatastr = "$format $self->{tag} $algorithm $cert";
  108.     }
  109.     else {
  110.         $rdatastr = '';
  111.     }
  112.         
  113.     return $rdatastr;
  114. }
  115.  
  116. sub rr_rdata {
  117.     my ($self, $packet, $offset) = @_;
  118.     my $rdata = "";
  119.         
  120.     if (exists $self->{"format"}) {
  121.         $rdata .= pack("n2", $self->{"format"}, $self->{tag});
  122.         $rdata .= pack("C",  $self->{algorithm});
  123.         $rdata .= $self->{certificate};
  124.     }
  125.         
  126.     return $rdata;
  127. }
  128.  
  129. 1;
  130. __END__
  131.  
  132. =head1 NAME
  133.  
  134. Net::DNS::RR::CERT - DNS CERT resource record
  135.  
  136. =head1 SYNOPSIS
  137.  
  138. C<use Net::DNS::RR>;
  139.  
  140. =head1 DESCRIPTION
  141.  
  142. Class for DNS Certificate (CERT) resource records. (see RFC 2538)
  143.  
  144. =head1 METHODS
  145.  
  146. =head2 format
  147.  
  148.     print "format = ", $rr->format, "\n";
  149.  
  150. Returns the format code for the certificate (in numeric form)
  151.  
  152. =head2 tag
  153.  
  154.     print "tag = ", $rr->tag, "\n";
  155.  
  156. Returns the key tag for the public key in the certificate
  157.  
  158. =head2 algorithm
  159.  
  160.     print "algorithm = ", $rr->algorithm, "\n";
  161.  
  162. Returns the algorithm used by the certificate (in numeric form)
  163.  
  164. =head2 certificate
  165.  
  166.     print "certificate = ", $rr->certificate, "\n";
  167.  
  168. Returns the data comprising the certificate itself (in raw binary form)
  169.  
  170. =head1 COPYRIGHT
  171.  
  172. Copyright (c) 1997-2002 Michael Fuhr. 
  173.  
  174. Portions Copyright (c) 2002-2003 Chris Reinhardt.
  175.  
  176. All rights reserved.  This program is free software; you may redistribute
  177. it and/or modify it under the same terms as Perl itself.
  178.  
  179. =head1 SEE ALSO
  180.  
  181. L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
  182. L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
  183. RFC 2782
  184.  
  185.