« back to all changes in this revision
Viewing changes to NetPacket/TCP.pm
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Bazaar Package Importer
- Author(s): Cajus Pollmeier
- Date: 2009-06-24 10:11:00 UTC
- Revision ID: james.westby@ubuntu.com-20090624101100-mysadcke1taprhap
Tags: upstream-0.04
Import upstream version 0.04
added
removed
NetPacket/TCP.pm
1
#
2
# NetPacket::TCP - Decode and encode TCP (Transmission Control
3
# Protocol) packets.
4
#
5
# Comments/suggestions to tpot@samba.org
6
#
7
# Encode and checksumming part, Stephanie Wehner, atrak@itsx.com
8
#
9
# $Id: TCP.pm,v 1.16 2001/08/01 02:31:27 tpot Exp $
10
#
11
12
package NetPacket::TCP;
13
14
#
15
# Copyright (c) 2001 Tim Potter.
16
#
17
# This package is free software and is provided "as is" without express
18
# or implied warranty. It may be used, redistributed and/or modified
19
# under the terms of the Perl Artistic License (see
20
# http://www.perl.com/perl/misc/Artistic.html)
21
#
22
# Copyright (c) 1995,1996,1997,1998,1999 ANU and CSIRO on behalf of
23
# the participants in the CRC for Advanced Computational Systems
24
# ('ACSys').
25
#
26
# ACSys makes this software and all associated data and documentation
27
# ('Software') available free of charge. You may make copies of the
28
# Software but you must include all of this notice on any copy.
29
#
30
# The Software was developed for research purposes and ACSys does not
31
# warrant that it is error free or fit for any purpose. ACSys
32
# disclaims any liability for all claims, expenses, losses, damages
33
# and costs any user may incur as a result of using, copying or
34
# modifying the Software.
35
#
36
# Copyright (c) 2001 Stephanie Wehner
37
#
38
39
use strict;
40
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
41
use NetPacket;
42
43
my $myclass;
44
45
# TCP Flags
46
47
use constant FIN => 0x01;
48
use constant SYN => 0x02;
49
use constant RST => 0x04;
50
use constant PSH => 0x08;
51
use constant ACK => 0x10;
52
use constant URG => 0x20;
53
use constant ECE => 0x40;
54
use constant CWR => 0x80;
55
56
BEGIN {
57
$myclass = __PACKAGE__;
58
$VERSION = "0.04";
59
}
60
sub Version () { "$myclass v$VERSION" }
61
62
BEGIN {
63
@ISA = qw(Exporter NetPacket);
64
65
# Items to export into callers namespace by default
66
# (move infrequently used names to @EXPORT_OK below)
67
68
@EXPORT = qw(FIN SYN RST PSH ACK URG ECE CWR
69
);
70
71
# Other items we are prepared to export if requested
72
73
@EXPORT_OK = qw(tcp_strip
74
);
75
76
# Tags:
77
78
%EXPORT_TAGS = (
79
ALL => [@EXPORT, @EXPORT_OK],
80
strip => [qw(tcp_strip)],
81
);
82
83
}
84
85
#
86
# Strip header from packet and return the data contained in it
87
#
88
89
undef &tcp_strip;
90
*tcp_strip = \&strip;
91
92
sub strip {
93
my ($pkt, @rest) = @_;
94
95
my $tcp_obj = NetPacket::TCP->decode($pkt);
96
return $tcp_obj->{data};
97
}
98
99
#
100
# Decode the packet
101
#
102
103
sub decode {
104
my $class = shift;
105
my($pkt, $parent, @rest) = @_;
106
my $self = {};
107
108
# Class fields
109
110
$self->{_parent} = $parent;
111
$self->{_frame} = $pkt;
112
113
# Decode TCP packet
114
115
if (defined($pkt)) {
116
my $tmp;
117
118
($self->{src_port}, $self->{dest_port}, $self->{seqnum},
119
$self->{acknum}, $tmp, $self->{winsize}, $self->{cksum},
120
$self->{urg}, $self->{options}) =
121
unpack("nnNNnnnna*", $pkt);
122
123
# Extract flags
124
125
$self->{hlen} = ($tmp & 0xf000) >> 12;
126
$self->{reserved} = ($tmp & 0x0f00) >> 8;
127
$self->{flags} = $tmp & 0x00ff;
128
129
# Decode variable length header and remaining data
130
131
my $olen = $self->{hlen} - 5;
132
$olen = 0, if ($olen < 0); # Check for bad hlen
133
134
# Option length is number of 32 bit words
135
136
$olen = $olen * 4;
137
138
($self->{options}, $self->{data}) = unpack("a" . $olen .
139
"a*", $self->{options});
140
}
141
142
# Return a blessed object
143
144
bless($self, $class);
145
return $self;
146
}
147
148
#
149
# Encode a packet
150
#
151
152
sub encode {
153
154
my $self = shift;
155
my ($ip) = @_;
156
my ($packet,$tmp);
157
158
# First of all, fix the checksum
159
$self->checksum($ip);
160
161
$tmp = $self->{hlen} << 12;
162
$tmp = $tmp | (0x0f00 & ($self->{reserved} << 8));
163
$tmp = $tmp | (0x00ff & $self->{flags});
164
165
# Put the packet together
166
$packet = pack('n n N N n n n n a* a*',
167
$self->{src_port}, $self->{dest_port}, $self->{seqnum},
168
$self->{acknum}, $tmp, $self->{winsize}, $self->{cksum},
169
$self->{urg}, $self->{options},$self->{data});
170
171
return($packet);
172
173
}
174
175
#
176
# TCP Checksum
177
#
178
179
sub checksum {
180
181
my $self = shift;
182
my ($ip) = @_;
183
my ($packet,$zero,$tcplen,$tmp);
184
my ($src_ip, $dest_ip,$proto,$count);
185
186
$zero = 0;
187
$proto = 6;
188
$tcplen = ($self->{hlen} * 4)+ length($self->{data});
189
190
$tmp = $self->{hlen} << 12;
191
$tmp = $tmp | (0x0f00 & ($self->{reserved} << 8));
192
$tmp = $tmp | (0x00ff & $self->{flags});
193
194
# Pack pseudo-header for tcp checksum
195
196
$src_ip = gethostbyname($ip->{src_ip});
197
$dest_ip = gethostbyname($ip->{dest_ip});
198
199
$packet = pack('a4a4nnnnNNnnnna*a*',
200
$src_ip,$dest_ip,$proto,$tcplen,
201
$self->{src_port}, $self->{dest_port}, $self->{seqnum},
202
$self->{acknum}, $tmp, $self->{winsize}, $zero,
203
$self->{urg}, $self->{options},$self->{data});
204
205
$self->{cksum} = NetPacket::htons(NetPacket::in_cksum($packet));
206
}
207
208
#
209
# Module initialisation
210
#
211
212
1;
213
214
# autoloaded methods go after the END token (&& pod) below
215
216
__END__
217
218
=head1 NAME
219
220
C<NetPacket::TCP> - Assemble and disassemble TCP (Transmission Control
221
Protocol) packets.
222
223
=head1 SYNOPSIS
224
225
use NetPacket::TCP;
226
227
$tcp_obj = NetPacket::TCP->decode($raw_pkt);
228
$tcp_pkt = NetPacket::TCP->encode($ip_pkt);
229
$tcp_data = NetPacket::TCP::strip($raw_pkt);
230
231
=head1 DESCRIPTION
232
233
C<NetPacket::TCP> provides a set of routines for assembling and
234
disassembling packets using TCP (Transmission Control Protocol).
235
236
=head2 Methods
237
238
=over
239
240
=item C<NetPacket::TCP-E<gt>decode([RAW PACKET])>
241
242
Decode the raw packet data given and return an object containing
243
instance data. This method will quite happily decode garbage input.
244
It is the responsibility of the programmer to ensure valid packet data
245
is passed to this method.
246
247
=item C<NetPacket::TCP-E<gt>encode($ip_obj)>
248
249
Return a TCP packet encoded with the instance data specified.
250
Needs parts of the ip header contained in $ip_obj in order to calculate
251
the TCP checksum.
252
253
=back
254
255
=head2 Functions
256
257
=over
258
259
=item C<NetPacket::TCP::strip([RAW PACKET])>
260
261
Return the encapsulated data (or payload) contained in the TCP
262
packet. This data is suitable to be used as input for other
263
C<NetPacket::*> modules.
264
265
This function is equivalent to creating an object using the
266
C<decode()> constructor and returning the C<data> field of that
267
object.
268
269
=back
270
271
=head2 Instance data
272
273
The instance data for the C<NetPacket::TCP> object consists of
274
the following fields.
275
276
=over
277
278
=item src_port
279
280
The source TCP port for the packet.
281
282
=item dest_port
283
284
The destination TCP port for the packet.
285
286
=item seqnum
287
288
The TCP sequence number for this packet.
289
290
=item acknum
291
292
The TCP acknowledgement number for this packet.
293
294
=item hlen
295
296
The header length for this packet.
297
298
=item reserved
299
300
The 6-bit "reserved" space in the TCP header.
301
302
=item flags
303
304
Contains the urg, ack, psh, rst, syn, fin, ece and cwr flags for this packet.
305
306
=item winsize
307
308
The TCP window size for this packet.
309
310
=item cksum
311
312
The TCP checksum.
313
314
=item urg
315
316
The TCP urgent pointer.
317
318
=item options
319
320
Any TCP options for this packet in binary form.
321
322
=item data
323
324
The encapsulated data (payload) for this packet.
325
326
=back
327
328
=head2 Exports
329
330
=over
331
332
=item default
333
334
FIN SYN RST PSH ACK URG ECE CWR Can be used to set the appropriate flag.
335
336
=item exportable
337
338
tcp_strip
339
340
=item tags
341
342
The following tags group together related exportable items.
343
344
=over
345
346
=item C<:strip>
347
348
Import the strip function C<tcp_strip>.
349
350
=item C<:ALL>
351
352
All the above exportable items.
353
354
=back
355
356
=back
357
358
=head1 EXAMPLE
359
360
The following script is a primitive pop3 sniffer.
361
362
#!/usr/bin/perl -w
363
364
use strict;
365
use Net::PcapUtils;
366
use NetPacket::Ethernet qw(:strip);
367
use NetPacket::IP qw(:strip);
368
use NetPacket::TCP;
369
370
sub process_pkt {
371
my($arg, $hdr, $pkt) = @_;
372
373
my $tcp_obj = NetPacket::TCP->decode(ip_strip(eth_strip($pkt)));
374
375
if (($tcp_obj->{src_port} == 110) or ($tcp_obj->{dest_port} == 110)) {
376
print($tcp_obj->{data});
377
}
378
}
379
380
Net::PcapUtils::loop(\&process_pkt, FILTER => 'tcp');
381
382
The following uses NetPacket together with Net::Divert to add a syn
383
flag to all TCP packets passing through:
384
385
#!/usr/bin/perl
386
387
use Net::Divert;
388
use NetPacket::IP qw(IP_PROTO_TCP);
389
use NetPacket::TCP;
390
391
392
$divobj = Net::Divert->new('yourhostname',9999);
393
394
$divobj->getPackets(\&alterPacket);
395
396
sub alterPacket {
397
my($packet,$fwtag) = @_;
398
399
# decode the IP header
400
$ip_obj = NetPacket::IP->decode($packet);
401
402
# check if this is a TCP packet
403
if($ip_obj->{proto} == IP_PROTO_TCP) {
404
405
# decode the TCP header
406
$tcp_obj = NetPacket::TCP->decode($ip_obj->{data});
407
408
# set the syn flag
409
$tcp_obj->{flags} |= SYN;
410
411
# construct the new ip packet
412
$ip_obj->{data} = $tcp_obj->encode($ip_obj);
413
$packet = $ip_obj->encode;
414
415
}
416
417
# write it back out
418
$divobj->putPacket($packet,$fwtag);
419
}
420
421
422
=head1 TODO
423
424
=over
425
426
=item Assembly of TCP fragments into a data stream
427
428
=item Option processing
429
430
=item Nicer processing of TCP flags
431
432
=back
433
434
=head1 COPYRIGHT
435
436
Copyright (c) 2001 Tim Potter.
437
438
This package is free software and is provided "as is" without express
439
or implied warranty. It may be used, redistributed and/or modified
440
under the terms of the Perl Artistic License (see
441
http://www.perl.com/perl/misc/Artistic.html)
442
443
Copyright (c) 1995,1996,1997,1998,1999 ANU and CSIRO on behalf of
444
the participants in the CRC for Advanced Computational Systems
445
('ACSys').
446
447
ACSys makes this software and all associated data and documentation
448
('Software') available free of charge. You may make copies of the
449
Software but you must include all of this notice on any copy.
450
451
The Software was developed for research purposes and ACSys does not
452
warrant that it is error free or fit for any purpose. ACSys
453
disclaims any liability for all claims, expenses, losses, damages
454
and costs any user may incur as a result of using, copying or
455
modifying the Software.
456
457
=head1 AUTHOR
458
459
Tim Potter E<lt>tpot@samba.orgE<gt>
460
461
Stephanie Wehner E<lt>atrak@itsx.comE<gt>
462
463
=cut
464
465
# any real autoloaded methods go after this line
Loggerhead is a web-based interface for Breezy
Version: 2.0.1