1package NetPacket::IPX;
2BEGIN {
3  $NetPacket::IPX::AUTHORITY = 'cpan:YANICK';
4}
5# ABSTRACT: Assemble and disassemble IPX packets
6$NetPacket::IPX::VERSION = '1.6.0';
7use strict;
8use warnings;
9
10use parent qw(NetPacket);
11
12use Carp;
13
14sub new
15{
16	my ($class, %packet) = @_;
17
18	foreach my $key(qw(tc type dest_network dest_node dest_socket
19		src_network src_node src_socket data))
20	{
21		croak("Missing $key argument") unless(defined($packet{$key}));
22	}
23
24	croak("Invalid tc argument")    unless($packet{tc}   =~ m/^\d+$/ && $packet{tc}   <= 255);
25	croak("Invalid type argument")  unless($packet{type} =~ m/^\d+$/ && $packet{type} <= 255);
26
27	_check_address("destination", $packet{dest_network}, $packet{dest_node}, $packet{dest_socket});
28	_check_address("source",      $packet{src_network},  $packet{src_node},  $packet{src_socket});
29
30	return bless(\%packet, $class);
31}
32
33sub _check_address
34{
35	my ($direction, $network, $node, $socket) = @_;
36
37	my $OCTET = qr/[0-9A-F][0-9A-F]?/i;
38
39	croak("Invalid $direction network") unless($network =~ m/^$OCTET(:$OCTET){3}$/);
40	croak("Invalid $direction node")    unless($node =~ m/^$OCTET(:$OCTET){5}$/);
41	croak("Invalid $direction socket")  unless($socket =~ m/^\d+$/ && $socket <= 65535);
42}
43
44#
45# Decode the packet
46#
47
48sub decode
49{
50	my ($class, $pkt, $parent) = @_;
51
52	my $self = bless({
53		_parent => $parent,
54		_frame  => $pkt,
55	}, $class);
56
57	if(defined($pkt))
58	{
59		# Use array slices to capture the appropriate number of bytes
60		# from each address field.
61
62		my (
63			$checksum, $length, $tc, $type,
64			@dst_network, @dst_node, $dst_socket,
65			@src_network, @src_node, $src_socket,
66		);
67
68		(
69			$checksum, $length, $tc, $type,
70			@dst_network[0..3], @dst_node[0..5], $dst_socket,
71			@src_network[0..3], @src_node[0..5], $src_socket,
72		) = unpack("nnCC C4C6n C4C6n", $pkt);
73
74		$self->{tc}   = $tc;
75		$self->{type} = $type;
76
77		$self->{dest_network} = _addr_to_string(@dst_network);
78		$self->{dest_node}    = _addr_to_string(@dst_node);
79		$self->{dest_socket}  = $dst_socket;
80
81		$self->{src_network} = _addr_to_string(@src_network);
82		$self->{src_node}    = _addr_to_string(@src_node);
83		$self->{src_socket}  = $src_socket;
84
85		$self->{data} = substr($pkt, 30);
86	}
87
88	return $self;
89}
90
91#
92# Strip header from packet and return the data contained in it
93#
94
95sub strip {
96	my ($pkt) = @_;
97	return NetPacket::IPX->decode($pkt)->{data};
98}
99
100#
101# Encode a packet
102#
103
104sub encode
105{
106	my ($self) = @_;
107
108	return pack("nnCC", 0xFFFF, 30 + length($self->{data}), $self->{tc}, $self->{type})
109		._addr_from_string($self->{dest_network})
110		._addr_from_string($self->{dest_node})
111		.pack("n", $self->{dest_socket})
112		._addr_from_string($self->{src_network})
113		._addr_from_string($self->{src_node})
114		.pack("n", $self->{src_socket})
115		.$self->{data};
116}
117
118sub _addr_to_string
119{
120	my (@bytes) = @_;
121	return join(":", map { sprintf("%02X", $_) } @bytes);
122}
123
124sub _addr_from_string
125{
126	my ($string) = @_;
127	return join("", map { pack("C", hex($_)) } split(m/:/, $string));
128}
129
1301;
131
132__END__
133
134=pod
135
136=head1 NAME
137
138NetPacket::IPX - Assemble and disassemble IPX packets
139
140=head1 VERSION
141
142version 1.6.0
143
144=head1 SYNOPSIS
145
146  use NetPacket::IPX;
147
148  my $ipx = NetPacket::IPX->decode($raw_pkt);
149
150  my $raw_pkt = $ipx->encode();
151
152  my $ipx = NetPacket::IPX->new(
153	  tc   => 0,
154	  type => 1,
155
156	  dest_network => "00:00:00:01",
157	  dest_node    => "FF:FF:FF:FF:FF:FF",
158	  dest_socket  => 1234,
159
160	  src_network => "00:00:00:01",
161	  src_node    => "12:34:56:78:90:AB",
162	  src_socket  => 5678,
163
164	  data => "...",
165  );
166
167=head1 DESCRIPTION
168
169C<NetPacket::IPX> is a C<NetPacket> class for encoding and decoding IPX packets.
170
171=head1 METHODS
172
173=head2 decode($raw_pkt)
174
175Decode a packet and return a C<NetPacket::IPX> instance.
176
177=head2 encode()
178
179Return the encoded form of a C<NetPacket::IPX> instance.
180
181=head2 new(%options)
182
183Construct a C<NetPacket::IPX> instance with arbitrary contents. All arguments
184listed in the SYNOPSIS are mandatory.
185
186Throws an exception on missing/invalid arguments.
187
188=head1 INSTANCE DATA
189
190The following fields are available in a C<NetPacket::IPX> instance:
191
192=over
193
194=item tc
195
196Traffic Control field, the number of routers an IPX packet has passed through.
197
198=item type
199
200Type field.
201
202=item dest_network
203
204Destination network number, in the format C<XX:XX:XX:XX>.
205
206=item dest_node
207
208Destination node number, in the format C<XX:XX:XX:XX:XX:XX>.
209
210=item dest_socket
211
212Destination socket number.
213
214=item src_network
215
216Source network number, in the format C<XX:XX:XX:XX>.
217
218=item dest_node
219
220Source node number, in the format C<XX:XX:XX:XX:XX:XX>.
221
222=item dest_socket
223
224Source socket number.
225
226=item data
227
228Packet payload.
229
230=back
231
232=head1 COPYRIGHT
233
234Copyright (C) 2014 Daniel Collins
235
236This module is free software. You can redistribute it and/or
237modify it under the same terms as Perl itself.
238
239=head1 AUTHOR
240
241Daniel Collins E<lt>solemnwarning@solemnwarning.netE<gt>
242
243=cut
244