package Net::DNS::RR::CERT; # # $Id: CERT.pm 388 2005-06-22 10:06:05Z olaf $ # # Written by Mike Schiraldi for VeriSign use strict; BEGIN { eval { require bytes; } } use vars qw(@ISA $VERSION); use MIME::Base64; @ISA = qw(Net::DNS::RR); $VERSION = (qw$LastChangedRevision: 388 $)[1]; my %formats = ( PKIX => 1, SPKI => 2, PGP => 3, URI => 253, OID => 254, ); my %r_formats = reverse %formats; my %algorithms = ( RSAMD5 => 1, DH => 2, DSA => 3, ECC => 4, INDIRECT => 252, PRIVATEDNS => 253, PRIVATEOID => 254, ); my %r_algorithms = reverse %algorithms; sub new { my ($class, $self, $data, $offset) = @_; if ($self->{"rdlength"} > 0) { my ($format, $tag, $algorithm) = unpack("\@$offset n2C", $$data); $offset += 2 * Net::DNS::INT16SZ() + 1; my $length = $self->{"rdlength"} - (2 * Net::DNS::INT16SZ() + 1); my $certificate = substr($$data, $offset, $length); $self->{"format"} = $format; $self->{"tag"} = $tag; $self->{"algorithm"} = $algorithm; $self->{"certificate"} = $certificate; } return bless $self, $class; } sub new_from_string { my ($class, $self, $string) = @_; $string or return bless $self, $class; my ($format, $tag, $algorithm, @rest) = split " ", $string; @rest or return bless $self, $class; # look up mnemonics # the "die"s may be rash, but proceeding would be dangerous if ($algorithm =~ /\D/) { $algorithm = $algorithms{$algorithm} || die "Unknown algorithm mnemonic: '$algorithm'"; } if ($format =~ /\D/) { $format = $formats{$format} || die "Unknown format mnemonic: '$format'"; } $self->{"format"} = $format; $self->{"tag"} = $tag; $self->{"algorithm"} = $algorithm; $self->{"certificate"} = MIME::Base64::decode(join('', @rest)); return bless $self, $class; } sub rdatastr { my $self = shift; my $rdatastr; if (exists $self->{"format"}) { my $cert = MIME::Base64::encode $self->{certificate}; $cert =~ s/\n//g; my $format = defined $r_formats{$self->{"format"}} ? $r_formats{$self->{"format"}} : $self->{"format"}; my $algorithm = defined $r_algorithms{$self->{algorithm}} ? $r_algorithms{$self->{algorithm}} : $self->{algorithm}; $rdatastr = "$format $self->{tag} $algorithm $cert"; } else { $rdatastr = ''; } return $rdatastr; } sub rr_rdata { my ($self, $packet, $offset) = @_; my $rdata = ""; if (exists $self->{"format"}) { $rdata .= pack("n2", $self->{"format"}, $self->{tag}); $rdata .= pack("C", $self->{algorithm}); $rdata .= $self->{certificate}; } return $rdata; } 1; __END__ =head1 NAME Net::DNS::RR::CERT - DNS CERT resource record =head1 SYNOPSIS C; =head1 DESCRIPTION Class for DNS Certificate (CERT) resource records. (see RFC 2538) =head1 METHODS =head2 format print "format = ", $rr->format, "\n"; Returns the format code for the certificate (in numeric form) =head2 tag print "tag = ", $rr->tag, "\n"; Returns the key tag for the public key in the certificate =head2 algorithm print "algorithm = ", $rr->algorithm, "\n"; Returns the algorithm used by the certificate (in numeric form) =head2 certificate print "certificate = ", $rr->certificate, "\n"; Returns the data comprising the certificate itself (in raw binary form) =head1 COPYRIGHT Copyright (c) 1997-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 SEE ALSO L, L, L, L, L, L, L, RFC 2782