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