line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package NetPacket::TCP; |
2
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:YANICK'; |
3
|
|
|
|
|
|
|
# ABSTRACT: Assemble and disassemble TCP (Transmission Control Protocol) packets. |
4
|
|
|
|
|
|
|
$NetPacket::TCP::VERSION = '1.7.2'; |
5
|
3
|
|
|
3
|
|
71695
|
use strict; |
|
3
|
|
|
|
|
15
|
|
|
3
|
|
|
|
|
126
|
|
6
|
3
|
|
|
3
|
|
16
|
use warnings; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
82
|
|
7
|
|
|
|
|
|
|
|
8
|
3
|
|
|
3
|
|
434
|
use parent 'NetPacket'; |
|
3
|
|
|
|
|
323
|
|
|
3
|
|
|
|
|
15
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
# TCP Flags |
11
|
|
|
|
|
|
|
|
12
|
3
|
|
|
3
|
|
155
|
use constant FIN => 0x01; |
|
3
|
|
|
|
|
20
|
|
|
3
|
|
|
|
|
214
|
|
13
|
3
|
|
|
3
|
|
18
|
use constant SYN => 0x02; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
166
|
|
14
|
3
|
|
|
3
|
|
19
|
use constant RST => 0x04; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
132
|
|
15
|
3
|
|
|
3
|
|
17
|
use constant PSH => 0x08; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
143
|
|
16
|
3
|
|
|
3
|
|
18
|
use constant ACK => 0x10; |
|
3
|
|
|
|
|
13
|
|
|
3
|
|
|
|
|
204
|
|
17
|
3
|
|
|
3
|
|
30
|
use constant URG => 0x20; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
194
|
|
18
|
3
|
|
|
3
|
|
21
|
use constant ECE => 0x40; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
158
|
|
19
|
3
|
|
|
3
|
|
18
|
use constant CWR => 0x80; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
1710
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
our @EXPORT = qw(FIN SYN RST PSH ACK URG ECE CWR); |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
our @EXPORT_OK = qw(tcp_strip ); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( |
26
|
|
|
|
|
|
|
ALL => [@EXPORT, @EXPORT_OK], |
27
|
|
|
|
|
|
|
strip => [qw(tcp_strip)], |
28
|
|
|
|
|
|
|
); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# |
31
|
|
|
|
|
|
|
# Strip header from packet and return the data contained in it |
32
|
|
|
|
|
|
|
# |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub tcp_strip { |
35
|
0
|
|
|
0
|
0
|
0
|
goto \&strip; |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub strip { |
39
|
0
|
|
|
0
|
1
|
0
|
my ($pkt) = @_; |
40
|
|
|
|
|
|
|
|
41
|
0
|
|
|
|
|
0
|
my $tcp_obj = NetPacket::TCP->decode($pkt); |
42
|
0
|
|
|
|
|
0
|
return $tcp_obj->{data}; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# |
46
|
|
|
|
|
|
|
# Decode the packet |
47
|
|
|
|
|
|
|
# |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub decode { |
50
|
3
|
|
|
3
|
1
|
16
|
my $class = shift; |
51
|
3
|
|
|
|
|
8
|
my($pkt, $parent) = @_; |
52
|
3
|
|
|
|
|
5
|
my $self = {}; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# Class fields |
55
|
|
|
|
|
|
|
|
56
|
3
|
|
|
|
|
7
|
$self->{_parent} = $parent; |
57
|
3
|
|
|
|
|
5
|
$self->{_frame} = $pkt; |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# Decode TCP packet |
60
|
|
|
|
|
|
|
|
61
|
3
|
50
|
|
|
|
8
|
if (defined($pkt)) { |
62
|
3
|
|
|
|
|
4
|
my $tmp; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
($self->{src_port}, $self->{dest_port}, $self->{seqnum}, |
65
|
|
|
|
|
|
|
$self->{acknum}, $tmp, $self->{winsize}, $self->{cksum}, |
66
|
3
|
|
|
|
|
19
|
$self->{urg}, $self->{options}) = |
67
|
|
|
|
|
|
|
unpack("nnNNnnnna*", $pkt); |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# Extract flags |
70
|
|
|
|
|
|
|
|
71
|
3
|
|
|
|
|
8
|
$self->{hlen} = ($tmp & 0xf000) >> 12; |
72
|
3
|
|
|
|
|
5
|
$self->{reserved} = ($tmp & 0x0f00) >> 8; |
73
|
3
|
|
|
|
|
5
|
$self->{flags} = $tmp & 0x00ff; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
# Decode variable length header and remaining data |
76
|
|
|
|
|
|
|
|
77
|
3
|
|
|
|
|
6
|
my $olen = $self->{hlen} - 5; |
78
|
3
|
50
|
|
|
|
7
|
$olen = 0 if $olen < 0; # Check for bad hlen |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# Option length is number of 32 bit words |
81
|
|
|
|
|
|
|
|
82
|
3
|
|
|
|
|
5
|
$olen *= 4; |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
( $self->{options}, $self->{data} ) |
85
|
3
|
|
|
|
|
13
|
= unpack( 'a' . $olen . 'a*', $self->{options}); |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# Return a blessed object |
89
|
|
|
|
|
|
|
|
90
|
3
|
|
|
|
|
5
|
bless($self, $class); |
91
|
3
|
|
|
|
|
18
|
return $self; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
# |
95
|
|
|
|
|
|
|
# Encode a packet |
96
|
|
|
|
|
|
|
# |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub encode { |
99
|
|
|
|
|
|
|
|
100
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
101
|
0
|
|
|
|
|
0
|
my ($ip) = @_; |
102
|
0
|
|
|
|
|
0
|
my ($packet,$tmp); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
# First of all, fix the checksum |
105
|
0
|
|
|
|
|
0
|
$self->checksum($ip); |
106
|
|
|
|
|
|
|
|
107
|
0
|
|
|
|
|
0
|
$tmp = $self->{hlen} << 12; |
108
|
0
|
|
|
|
|
0
|
$tmp = $tmp | (0x0f00 & ($self->{reserved} << 8)); |
109
|
0
|
|
|
|
|
0
|
$tmp = $tmp | (0x00ff & $self->{flags}); |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# Put the packet together |
112
|
|
|
|
|
|
|
$packet = pack('n n N N n n n n a* a*', |
113
|
|
|
|
|
|
|
$self->{src_port}, $self->{dest_port}, $self->{seqnum}, |
114
|
|
|
|
|
|
|
$self->{acknum}, $tmp, $self->{winsize}, $self->{cksum}, |
115
|
0
|
|
|
|
|
0
|
$self->{urg}, $self->{options},$self->{data}); |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
|
118
|
0
|
|
|
|
|
0
|
return($packet); |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# |
123
|
|
|
|
|
|
|
# TCP Checksum |
124
|
|
|
|
|
|
|
# |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub checksum { |
127
|
|
|
|
|
|
|
|
128
|
2
|
|
|
2
|
0
|
96
|
my $self = shift; |
129
|
2
|
|
|
|
|
4
|
my ($ip) = @_; |
130
|
2
|
|
|
|
|
8
|
my ($packet,$zero,$tcplen,$tmp); |
131
|
2
|
|
|
|
|
0
|
my ($src_ip, $dest_ip,$proto); |
132
|
|
|
|
|
|
|
|
133
|
2
|
|
|
|
|
4
|
$zero = 0; |
134
|
2
|
|
|
|
|
4
|
$proto = 6; |
135
|
2
|
|
|
|
|
11
|
$tcplen = ($self->{hlen} * 4)+ length($self->{data}); |
136
|
|
|
|
|
|
|
|
137
|
3
|
|
|
3
|
|
25
|
no warnings qw/ uninitialized /; |
|
3
|
|
|
|
|
13
|
|
|
3
|
|
|
|
|
1913
|
|
138
|
2
|
|
|
|
|
5
|
$tmp = $self->{hlen} << 12; |
139
|
2
|
|
|
|
|
6
|
$tmp = $tmp | (0x0f00 & ($self->{reserved} << 8)); |
140
|
2
|
|
|
|
|
4
|
$tmp = $tmp | (0x00ff & $self->{flags}); |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
# Pack pseudo-header for tcp checksum |
143
|
|
|
|
|
|
|
|
144
|
2
|
50
|
|
|
|
16
|
if ($ip->isa('NetPacket::IPv6')) { |
145
|
0
|
|
|
|
|
0
|
$packet = $ip->pseudo_header($tcplen, $proto); |
146
|
|
|
|
|
|
|
} else { |
147
|
2
|
|
|
|
|
95
|
$src_ip = gethostbyname($ip->{src_ip}); |
148
|
2
|
|
|
|
|
51
|
$dest_ip = gethostbyname($ip->{dest_ip}); |
149
|
|
|
|
|
|
|
|
150
|
2
|
|
|
|
|
17
|
$packet = pack('a4a4nn',$src_ip,$dest_ip,$proto,$tcplen); |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
$packet .= pack('nnNNnnnna*a*', |
154
|
|
|
|
|
|
|
$self->{src_port}, $self->{dest_port}, $self->{seqnum}, |
155
|
|
|
|
|
|
|
$self->{acknum}, $tmp, $self->{winsize}, $zero, |
156
|
2
|
|
|
|
|
13
|
$self->{urg}, $self->{options},$self->{data}); |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
# pad packet if odd-sized |
159
|
2
|
100
|
|
|
|
8
|
$packet .= "\x00" if length( $packet ) % 2; |
160
|
|
|
|
|
|
|
|
161
|
2
|
|
|
|
|
8
|
$self->{cksum} = NetPacket::htons(NetPacket::in_cksum($packet)); |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
sub parse_tcp_options { |
165
|
|
|
|
|
|
|
# |
166
|
|
|
|
|
|
|
# dissect tcp options header. see: |
167
|
|
|
|
|
|
|
# http://www.networksorcery.com/enp/protocol/tcp.htm#Options |
168
|
|
|
|
|
|
|
# |
169
|
|
|
|
|
|
|
# we create an byte array from the options header |
170
|
|
|
|
|
|
|
# and iterate through that. If we find an option |
171
|
|
|
|
|
|
|
# kind number we act accordingly (sometimes it has |
172
|
|
|
|
|
|
|
# a fixed length, sometimes a variable one). |
173
|
|
|
|
|
|
|
# once we've got the option stored, we shift the |
174
|
|
|
|
|
|
|
# bytes we fetched away from the byte array and |
175
|
|
|
|
|
|
|
# re-enter the loop. |
176
|
|
|
|
|
|
|
|
177
|
2
|
|
|
2
|
1
|
660
|
my $self = shift; |
178
|
|
|
|
|
|
|
|
179
|
2
|
|
|
|
|
8
|
my $opts = $self->{options}; |
180
|
2
|
|
|
|
|
11
|
my @bytes = split //, $opts; |
181
|
2
|
|
|
|
|
4
|
my %options; |
182
|
|
|
|
|
|
|
my $size; |
183
|
10
|
|
|
|
|
15
|
ENTRY: |
184
|
|
|
|
|
|
|
$size = $#bytes; |
185
|
10
|
|
|
|
|
19
|
foreach my $byte (@bytes) { |
186
|
8
|
|
|
|
|
15
|
my $kind = unpack('C', $byte); |
187
|
8
|
100
|
|
|
|
28
|
if($kind == 2) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
188
|
|
|
|
|
|
|
# MSS. |
189
|
|
|
|
|
|
|
# next byte is size, set to 4 |
190
|
|
|
|
|
|
|
# next 2 bytes are mss value 16 bit unsigned short |
191
|
1
|
|
|
|
|
3
|
$options{mss} = unpack('n', $bytes[2] . $bytes[3]); |
192
|
1
|
|
|
|
|
2
|
shift @bytes; |
193
|
1
|
|
|
|
|
2
|
shift @bytes; |
194
|
1
|
|
|
|
|
2
|
shift @bytes; |
195
|
1
|
|
|
|
|
1
|
shift @bytes; |
196
|
1
|
|
|
|
|
58
|
goto ENTRY; |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
elsif ($kind == 1) { |
199
|
|
|
|
|
|
|
# a noop |
200
|
3
|
|
|
|
|
5
|
shift @bytes; |
201
|
3
|
|
|
|
|
39
|
goto ENTRY; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
elsif ($kind == 3) { |
204
|
|
|
|
|
|
|
# Windows Scale Factor |
205
|
|
|
|
|
|
|
# next byte is size, set to 3 |
206
|
|
|
|
|
|
|
# next byte is shift count, 8 bit unsigned |
207
|
1
|
|
|
|
|
2
|
$options{ws} = unpack('C', $bytes[2]); |
208
|
1
|
|
|
|
|
2
|
shift @bytes; |
209
|
1
|
|
|
|
|
1
|
shift @bytes; |
210
|
1
|
|
|
|
|
2
|
shift @bytes; |
211
|
1
|
|
|
|
|
7
|
goto ENTRY; |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
elsif ($kind == 4) { |
214
|
|
|
|
|
|
|
# SACK Permitted |
215
|
|
|
|
|
|
|
# next byte is length |
216
|
1
|
|
|
|
|
2
|
$options{sack} = unpack('C', $bytes[1]); |
217
|
1
|
|
|
|
|
2
|
shift @bytes; |
218
|
1
|
|
|
|
|
2
|
shift @bytes; |
219
|
1
|
|
|
|
|
8
|
goto ENTRY; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
elsif ($kind == 5) { |
222
|
|
|
|
|
|
|
# SACK Blocks |
223
|
|
|
|
|
|
|
# next byte is length, 2 + (number of blocks * 8) |
224
|
|
|
|
|
|
|
# in every block, |
225
|
|
|
|
|
|
|
# former 4 bytes is SACK left edge, 32 bit unsigned int |
226
|
|
|
|
|
|
|
# latter 4 bytes is SACK right edge, 32 bit unsigned int |
227
|
0
|
|
|
|
|
0
|
my $block_num = (unpack('C', $bytes[1]) - 2) / 8; |
228
|
0
|
|
|
|
|
0
|
shift @bytes; |
229
|
0
|
|
|
|
|
0
|
shift @bytes; |
230
|
0
|
|
|
|
|
0
|
my @sack_blocks; |
231
|
0
|
|
|
|
|
0
|
for (1..$block_num) { |
232
|
0
|
|
|
|
|
0
|
push @sack_blocks, [unpack('N', join '', @bytes[0..3]), |
233
|
|
|
|
|
|
|
unpack('N', join '', @bytes[4..7])]; |
234
|
0
|
|
|
|
|
0
|
shift @bytes; |
235
|
0
|
|
|
|
|
0
|
shift @bytes; |
236
|
0
|
|
|
|
|
0
|
shift @bytes; |
237
|
0
|
|
|
|
|
0
|
shift @bytes; |
238
|
0
|
|
|
|
|
0
|
shift @bytes; |
239
|
0
|
|
|
|
|
0
|
shift @bytes; |
240
|
0
|
|
|
|
|
0
|
shift @bytes; |
241
|
0
|
|
|
|
|
0
|
shift @bytes; |
242
|
|
|
|
|
|
|
} |
243
|
0
|
|
|
|
|
0
|
$options{sack_blocks} = \@sack_blocks; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
elsif ($kind == 8) { |
246
|
|
|
|
|
|
|
# timestamp |
247
|
|
|
|
|
|
|
# next byte is length, set to 10 |
248
|
|
|
|
|
|
|
# next 4 byte is timestamp, 32 bit unsigned int |
249
|
|
|
|
|
|
|
# next 4 byte is timestamp echo reply, 32 bit unsigned int |
250
|
2
|
|
|
|
|
7
|
$options{ts} = unpack('N', join '', @bytes[2..5]); |
251
|
2
|
|
|
|
|
5
|
$options{er} = unpack('N', join '', @bytes[6,7,8,9]); |
252
|
2
|
|
|
|
|
4
|
shift @bytes; |
253
|
2
|
|
|
|
|
2
|
shift @bytes; |
254
|
2
|
|
|
|
|
3
|
shift @bytes; |
255
|
2
|
|
|
|
|
3
|
shift @bytes; |
256
|
2
|
|
|
|
|
3
|
shift @bytes; |
257
|
2
|
|
|
|
|
3
|
shift @bytes; |
258
|
2
|
|
|
|
|
2
|
shift @bytes; |
259
|
2
|
|
|
|
|
3
|
shift @bytes; |
260
|
2
|
|
|
|
|
3
|
shift @bytes; |
261
|
2
|
|
|
|
|
3
|
shift @bytes; |
262
|
2
|
|
|
|
|
16
|
goto ENTRY; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
} |
265
|
2
|
50
|
|
|
|
16
|
return wantarray ? %options : \%options; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
# |
268
|
|
|
|
|
|
|
# Module initialisation |
269
|
|
|
|
|
|
|
# |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
1; |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
# autoloaded methods go after the END token (&& pod) below |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
__END__ |