line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sniffer::Connection; |
2
|
4
|
|
|
4
|
|
24
|
use strict; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
202
|
|
3
|
4
|
|
|
4
|
|
27
|
use base 'Class::Accessor'; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
3569
|
|
4
|
4
|
|
|
4
|
|
10888
|
use Carp qw(carp croak); |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
478
|
|
5
|
4
|
|
|
4
|
|
2415
|
use NetPacket::TCP; |
|
4
|
|
|
|
|
14465
|
|
|
4
|
|
|
|
|
474
|
|
6
|
4
|
|
|
4
|
|
1002
|
use Data::Dumper; |
|
4
|
|
|
|
|
9185
|
|
|
4
|
|
|
|
|
344
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 NAME |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
Sniffer::Connection - contain basic information about a TCP connection |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 SYNOPSIS |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
my $conn = Sniffer::Connection->new( |
15
|
|
|
|
|
|
|
tcp => $packet, |
16
|
|
|
|
|
|
|
sent_data => sub { $self->sent_data(@_) }, |
17
|
|
|
|
|
|
|
received_data => sub { $self->received_data(@_) }, |
18
|
|
|
|
|
|
|
closed => sub {}, |
19
|
|
|
|
|
|
|
teardown => sub { $self->closed->($self) }, |
20
|
|
|
|
|
|
|
log => sub { print $_[0] }, |
21
|
|
|
|
|
|
|
)); |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
This module will try to give you the ordered |
24
|
|
|
|
|
|
|
data stream from a TCP connection. You supply |
25
|
|
|
|
|
|
|
callbacks for the data. The data is returned |
26
|
|
|
|
|
|
|
as the ACK-packets are seen for it. |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
As the TCP-reordering is cooked out by me, it |
29
|
|
|
|
|
|
|
likely has bugs, but I have used this module |
30
|
|
|
|
|
|
|
for sniffing some out-of-order TCP connection. |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=cut |
33
|
|
|
|
|
|
|
|
34
|
4
|
|
|
4
|
|
41
|
use vars qw($VERSION); |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
6175
|
|
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
$VERSION = '0.24'; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
my @callbacks = qw(sent_data received_data closed teardown log); |
39
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors(qw( |
40
|
|
|
|
|
|
|
src_port dest_port |
41
|
|
|
|
|
|
|
src_host dest_host |
42
|
|
|
|
|
|
|
status last_ack window last_activity |
43
|
|
|
|
|
|
|
sequence_start ack_start |
44
|
|
|
|
|
|
|
), @callbacks); |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
sub new { |
47
|
0
|
|
|
0
|
1
|
|
my($class,%args) = @_; |
48
|
|
|
|
|
|
|
|
49
|
0
|
|
|
|
|
|
my $packet = delete $args{tcp}; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# Set up dummy callbacks as the default |
52
|
0
|
|
0
|
0
|
|
|
for (@callbacks) { $args{$_} ||= sub {}; }; |
|
0
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
#$args{last_ack} ||= { src => undef, dest => undef }; |
55
|
0
|
|
0
|
|
|
|
$args{window} ||= { src => {}, dest => {} }; |
56
|
|
|
|
|
|
|
# will contain unacknowledged tcp packets |
57
|
|
|
|
|
|
|
|
58
|
0
|
|
|
|
|
|
my $self = $class->SUPER::new(\%args); |
59
|
|
|
|
|
|
|
|
60
|
0
|
0
|
|
|
|
|
if ($packet) { |
61
|
0
|
|
|
|
|
|
$self->handle_packet($packet); |
62
|
|
|
|
|
|
|
}; |
63
|
|
|
|
|
|
|
|
64
|
0
|
|
|
|
|
|
$self; |
65
|
|
|
|
|
|
|
}; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head2 C<< $conn->init_from_packet TCP >> |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
Initializes the connection data from a packet. |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=cut |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub init_from_packet { |
74
|
0
|
|
|
0
|
1
|
|
my ($self, $tcp) = @_; |
75
|
0
|
|
|
|
|
|
$self->sequence_start( $tcp->{seqnum} ); |
76
|
0
|
|
|
|
|
|
$self->ack_start( $tcp->{acknum} ); |
77
|
0
|
|
|
|
|
|
$self->src_port($tcp->{src_port}); |
78
|
0
|
|
|
|
|
|
$self->dest_port($tcp->{dest_port}); |
79
|
|
|
|
|
|
|
}; |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=head2 C<< $conn->handle_packet TCP [, TIMESTAMP] >> |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
Handles a packet and updates the status |
84
|
|
|
|
|
|
|
according to the packet. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
The optional TIMESTAMP parameter allows you to attach |
87
|
|
|
|
|
|
|
a timestamp (in seconds since the epoch) to the packet |
88
|
|
|
|
|
|
|
if you have a capture file with timestamps. It defaults |
89
|
|
|
|
|
|
|
to the value of C |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=cut |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
my $count; |
94
|
|
|
|
|
|
|
sub handle_packet { |
95
|
0
|
|
|
0
|
1
|
|
my ($self, $tcp, $timestamp) = @_; |
96
|
|
|
|
|
|
|
|
97
|
0
|
0
|
|
|
|
|
if ($self->flow eq '-:-') { |
98
|
0
|
|
|
|
|
|
$self->init_from_packet($tcp); |
99
|
|
|
|
|
|
|
}; |
100
|
0
|
0
|
0
|
|
|
|
if ($self->ack_start == 0 and $tcp->{acknum}) { |
101
|
0
|
|
|
|
|
|
$self->ack_start( $tcp->{acknum} ); |
102
|
|
|
|
|
|
|
}; |
103
|
|
|
|
|
|
|
|
104
|
0
|
|
|
|
|
|
my $key = $self->flow; |
105
|
0
|
|
|
|
|
|
my @dir = ('src', 'dest'); |
106
|
0
|
0
|
|
|
|
|
if ($self->signature($tcp) ne $key) { |
107
|
0
|
|
|
|
|
|
@dir = reverse @dir; |
108
|
|
|
|
|
|
|
}; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# Overwrite older sequence numbers |
111
|
0
|
|
|
|
|
|
$self->window->{$dir[0]}->{ $tcp->{seqnum} } = $tcp; |
112
|
|
|
|
|
|
|
#warn sprintf "%d: %d SEQ: %d ACK: %d", $count++, $tcp->{src_port}, $tcp->{seqnum} - $self->sequence_start, $tcp->{acknum} - $self->ack_start; |
113
|
|
|
|
|
|
|
|
114
|
0
|
|
|
|
|
|
$self->flush_window($dir[1], $tcp->{acknum}); |
115
|
0
|
|
|
|
|
|
$self->update_activity($timestamp); |
116
|
0
|
0
|
|
|
|
|
if (scalar keys %{$self->window->{$dir[1]}} > 32) { |
|
0
|
|
|
|
|
|
|
117
|
0
|
|
|
|
|
|
warn sprintf "$key ($dir[1]): %s packets unacknowledged.", scalar keys %{$self->window->{$dir[1]}}; |
|
0
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
}; |
119
|
|
|
|
|
|
|
}; |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub flush_window { |
122
|
0
|
|
|
0
|
0
|
|
my ($self,$part,$ack) = @_; |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
|
my $window = $self->window->{$part}; |
125
|
0
|
|
|
|
|
|
my @seqnums = grep { $_ <= $ack } (sort keys %$window); |
|
0
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
#{ |
128
|
|
|
|
|
|
|
# local $" = ","; |
129
|
|
|
|
|
|
|
# print "Handling ",(scalar @seqnums)," packets (@seqnums).\n"; |
130
|
|
|
|
|
|
|
#}; |
131
|
|
|
|
|
|
|
|
132
|
0
|
|
|
|
|
|
my @packets = map { delete $window->{$_} } @seqnums; |
|
0
|
|
|
|
|
|
|
133
|
0
|
|
|
|
|
|
for my $tcp (@packets) { |
134
|
0
|
|
|
|
|
|
my $status = $self->status; |
135
|
0
|
0
|
|
|
|
|
die "Didn't find a window for every seqnum ..." |
136
|
|
|
|
|
|
|
unless $tcp; |
137
|
|
|
|
|
|
|
|
138
|
0
|
|
|
|
|
|
$self->log->( sprintf "Initial %08b %s", $tcp->{flags}, tcp_flags($tcp->{flags}) ); |
139
|
|
|
|
|
|
|
|
140
|
0
|
0
|
0
|
|
|
|
if (not defined $status) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
141
|
0
|
0
|
|
|
|
|
if ($tcp->{flags} == SYN) { |
142
|
0
|
|
|
|
|
|
$self->init_from_packet($tcp); |
143
|
0
|
|
|
|
|
|
$self->log->("New connection initiated"); |
144
|
0
|
|
|
|
|
|
$self->status("SYN"); |
145
|
0
|
|
|
|
|
|
next; |
146
|
|
|
|
|
|
|
} else { |
147
|
0
|
|
|
|
|
|
$self->log->("Not a SYN packet (ignored)"); |
148
|
|
|
|
|
|
|
next |
149
|
0
|
|
|
|
|
|
}; |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
} elsif ($status eq 'SYN') { |
152
|
|
|
|
|
|
|
# We want a SYN_ACK packet now |
153
|
0
|
0
|
|
|
|
|
if ($tcp->{flags} == SYN+ACK) { |
154
|
0
|
|
|
|
|
|
$self->log->("New connection acknowledged"); |
155
|
0
|
0
|
|
|
|
|
if ($status ne "SYN") { |
156
|
0
|
|
|
|
|
|
print "!!! Connection status is $status, expected SYN\n"; |
157
|
|
|
|
|
|
|
}; |
158
|
0
|
|
|
|
|
|
$self->status("SYN_ACK"); |
159
|
|
|
|
|
|
|
next |
160
|
0
|
|
|
|
|
|
} else { |
161
|
|
|
|
|
|
|
# silently drop the packet for now |
162
|
|
|
|
|
|
|
# If we are in SYN state but didn't get a SYN ACK, emit a warning |
163
|
|
|
|
|
|
|
next |
164
|
|
|
|
|
|
|
# $self->log->("!!! Connection status is SYN, ignoring packet"); |
165
|
0
|
|
|
|
|
|
}; |
166
|
|
|
|
|
|
|
} elsif ($status eq 'ACK' or $status eq 'SYN_ACK') { |
167
|
0
|
|
|
|
|
|
my $data = $tcp->{data}; |
168
|
0
|
|
|
|
|
|
my $key = $self->flow; |
169
|
|
|
|
|
|
|
|
170
|
0
|
0
|
|
|
|
|
if (length $data) { |
171
|
0
|
|
|
|
|
|
my $flow = 'sent_data'; |
172
|
0
|
0
|
|
|
|
|
$flow = 'received_data' |
173
|
|
|
|
|
|
|
if ($self->flow ne $self->signature($tcp)); |
174
|
0
|
|
|
|
|
|
$self->$flow->($data,$self,$tcp); |
175
|
|
|
|
|
|
|
}; |
176
|
0
|
0
|
|
|
|
|
$self->status('ACK') |
177
|
|
|
|
|
|
|
if $status ne 'ACK'; |
178
|
|
|
|
|
|
|
} elsif ($status eq 'CLOSE') { |
179
|
0
|
|
|
|
|
|
$self->log->("Connection close acknowledged"); |
180
|
0
|
|
|
|
|
|
$self->teardown->($self); |
181
|
|
|
|
|
|
|
#return |
182
|
|
|
|
|
|
|
next |
183
|
0
|
|
|
|
|
|
}; |
184
|
|
|
|
|
|
|
|
185
|
0
|
0
|
|
|
|
|
if ($tcp->{flags} & FIN) { |
186
|
0
|
|
|
|
|
|
$self->log->("Connection closed"); |
187
|
0
|
|
|
|
|
|
$self->status("CLOSE"); |
188
|
0
|
|
|
|
|
|
$self->closed->($self); |
189
|
|
|
|
|
|
|
}; |
190
|
|
|
|
|
|
|
}; |
191
|
|
|
|
|
|
|
}; |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
sub as_string { |
194
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
195
|
0
|
|
|
|
|
|
sprintf "%s / %s", $self->flow, $self->status; |
196
|
|
|
|
|
|
|
}; |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
sub flow { |
199
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
200
|
0
|
|
0
|
|
|
|
join ":", ($self->src_port||"-"), ($self->dest_port||"-") |
|
|
|
0
|
|
|
|
|
201
|
|
|
|
|
|
|
}; |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
sub signature { |
204
|
0
|
|
|
0
|
0
|
|
my ($class,$packet) = @_; |
205
|
0
|
|
|
|
|
|
join ":", $packet->{src_port}, $packet->{dest_port}; |
206
|
|
|
|
|
|
|
}; |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
sub tcp_flags { |
209
|
0
|
|
|
0
|
0
|
|
my ($val) = @_; |
210
|
0
|
|
|
|
|
|
my $idx = 0; |
211
|
0
|
0
|
|
|
|
|
join " ", map { $val & 2**$idx++ ? uc : lc } (qw(FIN SYN RST PSH ACK URG ECN CWR)); |
|
0
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
}; |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=head2 C<< last_activity >> |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
Returns the timestamp in epoch seconds of the last activity of the socket. |
217
|
|
|
|
|
|
|
This can be convenient to determine if a connection has gone stale. |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
This timestamp should be fed in via C if it is available. |
220
|
|
|
|
|
|
|
Capturing via C and C |
221
|
|
|
|
|
|
|
supplies the correct L timestamps and thus will reproduce |
222
|
|
|
|
|
|
|
all sessions faithfully. |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=head2 C<< update_activity [TIMESTAMP] >> |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
Updates C and supplies a default |
227
|
|
|
|
|
|
|
timestamp of C |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=cut |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
sub update_activity { |
232
|
0
|
|
|
0
|
1
|
|
my ($self,$timestamp) = @_; |
233
|
0
|
|
0
|
|
|
|
$timestamp ||= time; |
234
|
0
|
|
|
|
|
|
$self->last_activity($timestamp); |
235
|
|
|
|
|
|
|
}; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
1; |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=head1 TODO |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=over 4 |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
=item * |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
Implement a (configurable?) timeout (of say 5 minutes) after which connections |
246
|
|
|
|
|
|
|
get auto-closed to reduce resource usage. |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=item * |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
Data can only be forwarded after there has been |
251
|
|
|
|
|
|
|
the ACK packet for it! |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=back |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=head1 BUGS |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
The whole module suite has almost no tests. |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
If you experience problems, I supply me with a complete, |
260
|
|
|
|
|
|
|
relevant packet dump as the included C creates. Even |
261
|
|
|
|
|
|
|
better, supply me with (failing) tests. |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=head1 AUTHOR |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
Max Maischein (corion@cpan.org) |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=head1 COPYRIGHT |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
Copyright (C) 2005-2011 Max Maischein. All Rights Reserved. |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
This code is free software; you can redistribute it and/or modify it |
272
|
|
|
|
|
|
|
under the same terms as Perl itself. |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
=cut |