1package Net::DNS::RR::NSAP; 2# 3# $Id: NSAP.pm 388 2005-06-22 10:06:05Z olaf $ 4# 5use strict; 6BEGIN { 7 eval { require bytes; } 8} 9use vars qw(@ISA $VERSION); 10 11@ISA = qw(Net::DNS::RR); 12$VERSION = (qw$LastChangedRevision: 388 $)[1]; 13 14sub new { 15 my ($class, $self, $data, $offset) = @_; 16 17 if ($self->{"rdlength"} > 0) { 18 my $afi = unpack("\@$offset C", $$data); 19 $self->{"afi"} = sprintf("%02x", $afi); 20 ++$offset; 21 22 if ($self->{"afi"} eq "47") { 23 my @idi = unpack("\@$offset C2", $$data); 24 $offset += 2; 25 26 my $dfi = unpack("\@$offset C", $$data); 27 $offset += 1; 28 29 my @aa = unpack("\@$offset C3", $$data); 30 $offset += 3; 31 32 my @rsvd = unpack("\@$offset C2", $$data); 33 $offset += 2; 34 35 my @rd = unpack("\@$offset C2", $$data); 36 $offset += 2; 37 38 my @area = unpack("\@$offset C2", $$data); 39 $offset += 2; 40 41 my @id = unpack("\@$offset C6", $$data); 42 $offset += 6; 43 44 my $sel = unpack("\@$offset C", $$data); 45 $offset += 1; 46 47 $self->{"idi"} = sprintf("%02x" x 2, @idi); 48 $self->{"dfi"} = sprintf("%02x" x 1, $dfi); 49 $self->{"aa"} = sprintf("%02x" x 3, @aa); 50 $self->{"rsvd"} = sprintf("%02x" x 2, @rsvd); 51 $self->{"rd"} = sprintf("%02x" x 2, @rd); 52 $self->{"area"} = sprintf("%02x" x 2, @area); 53 $self->{"id"} = sprintf("%02x" x 6, @id); 54 $self->{"sel"} = sprintf("%02x" x 1, $sel); 55 56 } else { 57 # What to do for unsupported versions? 58 } 59 } 60 61 return bless $self, $class; 62} 63 64sub new_from_string { 65 my ($class, $self, $string) = @_; 66 67 if ($string) { 68 $string =~ s/\.//g; # remove all dots. 69 $string =~ s/^0x//; # remove leading 0x 70 71 if ($string =~ /^[a-zA-Z0-9]{40}$/) { 72 @{ $self }{ qw(afi idi dfi aa rsvd rd area id sel) } = 73 unpack("A2A4A2A6A4A4A4A12A2", $string); 74 } 75 } 76 77 return bless $self, $class; 78} 79 80 81sub idp { 82 my $self = shift; 83 84 return join('', $self->{"afi"}, 85 $self->{"idi"}); 86} 87 88sub dsp { 89 my $self = shift; 90 91 return join('', 92 $self->{"dfi"}, 93 $self->{"aa"}, 94 $self->rsvd, 95 $self->{"rd"}, 96 $self->{"area"}, 97 $self->{"id"}, 98 $self->{"sel"}); 99} 100 101sub rsvd { 102 my $self = shift; 103 104 return exists $self->{"rsvd"} ? $self->{"rsvd"} : "0000"; 105} 106 107sub rdatastr { 108 my $self = shift; 109 my $rdatastr; 110 111 if (exists $self->{"afi"}) { 112 if ($self->{"afi"} eq "47") { 113 $rdatastr = join('', $self->idp, $self->dsp); 114 } else { 115 $rdatastr = "; AFI $self->{'afi'} not supported"; 116 } 117 } else { 118 $rdatastr = ''; 119 } 120 121 return $rdatastr; 122} 123 124sub rr_rdata { 125 my $self = shift; 126 my $rdata = ""; 127 128 if (exists $self->{"afi"}) { 129 $rdata .= pack("C", hex($self->{"afi"})); 130 131 if ($self->{"afi"} eq "47") { 132 $rdata .= str2bcd($self->{"idi"}, 2); 133 $rdata .= str2bcd($self->{"dfi"}, 1); 134 $rdata .= str2bcd($self->{"aa"}, 3); 135 $rdata .= str2bcd(0, 2); # rsvd 136 $rdata .= str2bcd($self->{"rd"}, 2); 137 $rdata .= str2bcd($self->{"area"}, 2); 138 $rdata .= str2bcd($self->{"id"}, 6); 139 $rdata .= str2bcd($self->{"sel"}, 1); 140 } 141 142 # Checks for other versions would go here. 143 } 144 145 return $rdata; 146} 147 148#------------------------------------------------------------------------------ 149# Usage: str2bcd(STRING, NUM_BYTES) 150# 151# Takes a string representing a hex number of arbitrary length and 152# returns an equivalent BCD string of NUM_BYTES length (with 153# NUM_BYTES * 2 digits), adding leading zeros if necessary. 154#------------------------------------------------------------------------------ 155 156# This can't be the best way.... 157sub str2bcd { 158 my ($string, $bytes) = @_; 159 my $retval = ""; 160 161 my $digits = $bytes * 2; 162 $string = sprintf("%${digits}s", $string); 163 $string =~ tr/ /0/; 164 165 my $i; 166 for ($i = 0; $i < $bytes; ++$i) { 167 my $bcd = substr($string, $i*2, 2); 168 $retval .= pack("C", hex $bcd); 169 } 170 171 return $retval; 172} 173 1741; 175__END__ 176 177=head1 NAME 178 179Net::DNS::RR::NSAP - DNS NSAP resource record 180 181=head1 SYNOPSIS 182 183C<use Net::DNS::RR>; 184 185=head1 DESCRIPTION 186 187Class for DNS Network Service Access Point (NSAP) resource records. 188 189=head1 METHODS 190 191=head2 idp 192 193 print "idp = ", $rr->idp, "\n"; 194 195Returns the RR's initial domain part (the AFI and IDI fields). 196 197=head2 dsp 198 199 print "dsp = ", $rr->dsp, "\n"; 200 201Returns the RR's domain specific part (the DFI, AA, Rsvd, RD, Area, 202ID, and SEL fields). 203 204=head2 afi 205 206 print "afi = ", $rr->afi, "\n"; 207 208Returns the RR's authority and format identifier. C<Net::DNS> 209currently supports only AFI 47 (GOSIP Version 2). 210 211=head2 idi 212 213 print "idi = ", $rr->idi, "\n"; 214 215Returns the RR's initial domain identifier. 216 217=head2 dfi 218 219 print "dfi = ", $rr->dfi, "\n"; 220 221Returns the RR's DSP format identifier. 222 223=head2 aa 224 225 print "aa = ", $rr->aa, "\n"; 226 227Returns the RR's administrative authority. 228 229=head2 rsvd 230 231 print "rsvd = ", $rr->rsvd, "\n"; 232 233Returns the RR's reserved field. 234 235=head2 rd 236 237 print "rd = ", $rr->rd, "\n"; 238 239Returns the RR's routing domain identifier. 240 241=head2 area 242 243 print "area = ", $rr->area, "\n"; 244 245Returns the RR's area identifier. 246 247=head2 id 248 249 print "id = ", $rr->id, "\n"; 250 251Returns the RR's system identifier. 252 253=head2 sel 254 255 print "sel = ", $rr->sel, "\n"; 256 257Returns the RR's NSAP selector. 258 259=head1 COPYRIGHT 260 261Copyright (c) 1997-2002 Michael Fuhr. 262 263Portions Copyright (c) 2002-2004 Chris Reinhardt. 264 265All rights reserved. This program is free software; you may redistribute 266it and/or modify it under the same terms as Perl itself.. 267 268=head1 SEE ALSO 269 270L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>, 271L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>, 272RFC 1706. 273 274=cut 275