line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::Gnutella::Connection;
|
2
|
1
|
|
|
1
|
|
506
|
use Net::Gnutella::Packet::Ping;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
23
|
|
3
|
1
|
|
|
1
|
|
584
|
use Net::Gnutella::Packet::Pong;
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
27
|
|
4
|
1
|
|
|
1
|
|
556
|
use Net::Gnutella::Packet::Push;
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
31
|
|
5
|
1
|
|
|
1
|
|
633
|
use Net::Gnutella::Packet::Query;
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
27
|
|
6
|
1
|
|
|
1
|
|
460
|
use Net::Gnutella::Packet::Reply;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
25
|
|
7
|
1
|
|
|
1
|
|
437
|
use Net::Gnutella::Event;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
8
|
1
|
|
|
1
|
|
903
|
use HTTP::Request;
|
|
1
|
|
|
|
|
657452
|
|
|
1
|
|
|
|
|
34
|
|
9
|
1
|
|
|
1
|
|
1052
|
use HTTP::Date;
|
|
1
|
|
|
|
|
233051
|
|
|
1
|
|
|
|
|
86
|
|
10
|
1
|
|
|
1
|
|
1047
|
use HTTP::Status;
|
|
1
|
|
|
|
|
7621
|
|
|
1
|
|
|
|
|
430
|
|
11
|
1
|
|
|
1
|
|
1407
|
use LWP::MediaTypes qw(guess_media_type);
|
|
1
|
|
|
|
|
26756
|
|
|
1
|
|
|
|
|
1016
|
|
12
|
1
|
|
|
1
|
|
4032
|
use URI::URL;
|
|
1
|
|
|
|
|
4230
|
|
|
1
|
|
|
|
|
64
|
|
13
|
1
|
|
|
1
|
|
882
|
use IO::File;
|
|
1
|
|
|
|
|
2209
|
|
|
1
|
|
|
|
|
144
|
|
14
|
1
|
|
|
1
|
|
9
|
use Carp qw(carp croak confess);
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
45
|
|
15
|
1
|
|
|
1
|
|
5
|
use strict;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
46
|
|
16
|
1
|
|
|
1
|
|
5
|
use vars qw/$VERSION $AUTOLOAD/;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
4821
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
$VERSION = $VERSION = "0.1";
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# Use AUTOHANDLER to supply generic attribute methods
|
21
|
|
|
|
|
|
|
#
|
22
|
|
|
|
|
|
|
sub AUTOLOAD {
|
23
|
0
|
|
|
0
|
|
|
my $self = shift;
|
24
|
0
|
|
|
|
|
|
my $attr = $AUTOLOAD;
|
25
|
0
|
|
|
|
|
|
$attr =~ s/.*:://;
|
26
|
0
|
0
|
|
|
|
|
return unless $attr =~ /[^A-Z]/; # skip DESTROY and all-cap methods
|
27
|
0
|
0
|
|
|
|
|
confess sprintf "invalid attribute method: %s->%s()", ref($self), $attr unless exists $self->{_attr}->{lc $attr};
|
28
|
0
|
0
|
|
|
|
|
$self->{_attr}->{lc $attr} = shift if @_;
|
29
|
0
|
|
|
|
|
|
return $self->{_attr}->{lc $attr};
|
30
|
|
|
|
|
|
|
}
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub disconnect {
|
33
|
0
|
|
|
0
|
0
|
|
my ($self, $type) = @_;
|
34
|
|
|
|
|
|
|
|
35
|
0
|
0
|
|
|
|
|
printf STDERR "+ Disconnecting socket (%s)\n", $type if $self->debug;
|
36
|
|
|
|
|
|
|
|
37
|
0
|
0
|
|
|
|
|
if ($type) {
|
38
|
0
|
|
|
|
|
|
my $event = Net::Gnutella::Event->new(
|
39
|
|
|
|
|
|
|
from => $self,
|
40
|
|
|
|
|
|
|
type => $type,
|
41
|
|
|
|
|
|
|
);
|
42
|
|
|
|
|
|
|
|
43
|
0
|
|
|
|
|
|
$self->parent->_handler($event);
|
44
|
|
|
|
|
|
|
}
|
45
|
|
|
|
|
|
|
|
46
|
0
|
|
|
|
|
|
$self->parent->_remove_fh($self->socket, "rw");
|
47
|
0
|
|
|
|
|
|
$self->readbuf("");
|
48
|
0
|
|
|
|
|
|
$self->writebuf("");
|
49
|
0
|
|
|
|
|
|
$self->connected(0);
|
50
|
0
|
|
|
|
|
|
$self->socket("");
|
51
|
|
|
|
|
|
|
}
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# ->forward( PACKET [, REPLY_PATH ] )
|
54
|
|
|
|
|
|
|
#
|
55
|
|
|
|
|
|
|
# Composes the packet and delivers it to all other ESTABLISHED connections
|
56
|
|
|
|
|
|
|
#
|
57
|
|
|
|
|
|
|
sub forward {
|
58
|
0
|
|
|
0
|
0
|
|
my ($self, $packet, $path) = @_;
|
59
|
|
|
|
|
|
|
|
60
|
0
|
0
|
0
|
|
|
|
unless ($packet && ref $packet) {
|
61
|
0
|
|
|
|
|
|
carp "Invalid argument to Net::Gnutella::Connection->forward";
|
62
|
|
|
|
|
|
|
}
|
63
|
|
|
|
|
|
|
|
64
|
0
|
|
|
|
|
|
my $data = $packet->format;
|
65
|
0
|
|
|
|
|
|
my $head = pack("L4CCCL", @{ $packet->msgid }, $packet->function, $packet->ttl, $packet->hops, length $data);
|
|
0
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
67
|
0
|
0
|
|
|
|
|
if ($path) {
|
68
|
0
|
0
|
|
|
|
|
if ($path ne $self) {
|
69
|
0
|
0
|
|
|
|
|
printf STDERR " - Returning down path to %s\n", $path->ip if $self->debug >= 2;
|
70
|
|
|
|
|
|
|
|
71
|
0
|
|
|
|
|
|
$path->_write_wrapper($head.$data);
|
72
|
|
|
|
|
|
|
}
|
73
|
|
|
|
|
|
|
} else {
|
74
|
0
|
|
|
|
|
|
foreach my $conn ($self->parent->connections) {
|
75
|
0
|
0
|
|
|
|
|
next if $conn eq $self;
|
76
|
0
|
0
|
|
|
|
|
next unless $conn->connected;
|
77
|
|
|
|
|
|
|
|
78
|
0
|
0
|
|
|
|
|
printf STDERR " - Forwarding to %s\n", $conn->ip if $self->debug >= 2;
|
79
|
|
|
|
|
|
|
|
80
|
0
|
|
|
|
|
|
$conn->_write_wrapper($head.$data);
|
81
|
|
|
|
|
|
|
}
|
82
|
|
|
|
|
|
|
}
|
83
|
|
|
|
|
|
|
}
|
84
|
|
|
|
|
|
|
|
85
|
0
|
|
|
0
|
0
|
|
sub is_outgoing { $_[0]->connected == 1 } # Outgoing
|
86
|
0
|
|
|
0
|
0
|
|
sub is_incoming { $_[0]->connected == 2 } # Incoming
|
87
|
0
|
|
|
0
|
0
|
|
sub is_established { $_[0]->connected == 3 } # Gnutella DATA Stream
|
88
|
0
|
|
|
0
|
0
|
|
sub is_http { $_[0]->connected == 4 } # HTTP Serving
|
89
|
0
|
|
|
0
|
0
|
|
sub is_upload { $_[0]->connected == 5 } # Sending file
|
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub new {
|
92
|
0
|
|
|
0
|
0
|
|
my $proto = shift;
|
93
|
0
|
|
|
|
|
|
my $parent = shift;
|
94
|
0
|
|
|
|
|
|
my %args = @_;
|
95
|
|
|
|
|
|
|
|
96
|
0
|
|
|
|
|
|
my $self = {
|
97
|
|
|
|
|
|
|
_handler => {},
|
98
|
|
|
|
|
|
|
_attr => {
|
99
|
|
|
|
|
|
|
parent => $parent,
|
100
|
|
|
|
|
|
|
debug => $parent->debug,
|
101
|
|
|
|
|
|
|
timeout => $parent->timeout,
|
102
|
|
|
|
|
|
|
socket => undef,
|
103
|
|
|
|
|
|
|
ip => '',
|
104
|
|
|
|
|
|
|
connected => 0,
|
105
|
|
|
|
|
|
|
readbuf => '',
|
106
|
|
|
|
|
|
|
writebuf => '',
|
107
|
|
|
|
|
|
|
error => '',
|
108
|
|
|
|
|
|
|
allow => 0,
|
109
|
|
|
|
|
|
|
msgid => [],
|
110
|
|
|
|
|
|
|
},
|
111
|
|
|
|
|
|
|
_msgid => {},
|
112
|
|
|
|
|
|
|
};
|
113
|
|
|
|
|
|
|
|
114
|
0
|
|
|
|
|
|
bless $self, $proto;
|
115
|
|
|
|
|
|
|
|
116
|
0
|
|
|
|
|
|
foreach my $key (keys %args) {
|
117
|
0
|
|
|
|
|
|
my $lkey = lc $key;
|
118
|
|
|
|
|
|
|
|
119
|
0
|
|
|
|
|
|
$self->$lkey($args{$key});
|
120
|
|
|
|
|
|
|
}
|
121
|
|
|
|
|
|
|
|
122
|
0
|
0
|
0
|
|
|
|
if ($self->connected and $self->socket) {
|
123
|
0
|
|
|
|
|
|
$self->parent->_add_fh($self->socket, $self->can("_read_socket"), "r", $self);
|
124
|
|
|
|
|
|
|
}
|
125
|
|
|
|
|
|
|
|
126
|
0
|
|
|
|
|
|
return $self;
|
127
|
|
|
|
|
|
|
}
|
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub send_error {
|
130
|
0
|
|
|
0
|
0
|
|
my ($self, $status, $error) = @_;
|
131
|
|
|
|
|
|
|
|
132
|
0
|
0
|
|
|
|
|
unless ($self->is_http) {
|
133
|
0
|
|
|
|
|
|
croak "Invalid state for ->send_error";
|
134
|
|
|
|
|
|
|
}
|
135
|
|
|
|
|
|
|
|
136
|
0
|
|
0
|
|
|
|
$status ||= RC_BAD_REQUEST;
|
137
|
0
|
|
0
|
|
|
|
$error ||= "";
|
138
|
|
|
|
|
|
|
|
139
|
0
|
|
|
|
|
|
my $message = status_message($status);
|
140
|
0
|
|
|
|
|
|
my $CRLF = "\r\n";
|
141
|
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
|
my $ip = "Unknown";
|
143
|
0
|
|
|
|
|
|
my $port = "Unknown";
|
144
|
|
|
|
|
|
|
|
145
|
0
|
|
|
|
|
|
my $body = <
|
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
$status $message
|
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
$message
|
151
|
|
|
|
|
|
|
$error
|
152
|
|
|
|
|
|
|
Net::Gnutella $VERSION Server at $ip Port $port
|
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
EOT
|
155
|
|
|
|
|
|
|
|
156
|
0
|
|
|
|
|
|
my $head;
|
157
|
0
|
|
|
|
|
|
$head .= sprintf "%s %s %s%s", "HTTP/1.0", $status, $message, $CRLF;
|
158
|
0
|
|
|
|
|
|
$head .= sprintf "Date: %s%s", time2str(time), $CRLF;
|
159
|
0
|
|
|
|
|
|
$head .= sprintf "Server: %s/%s%s", "Net-Gnutella", $VERSION, $CRLF;
|
160
|
0
|
|
|
|
|
|
$head .= sprintf "Content-Type: %s%s", "text/html", $CRLF;
|
161
|
0
|
|
|
|
|
|
$head .= sprintf "Content-Length: %s%s", length($body), $CRLF;
|
162
|
0
|
|
|
|
|
|
$head .= sprintf "%s", $CRLF;
|
163
|
|
|
|
|
|
|
|
164
|
0
|
|
|
|
|
|
$self->_write_wrapper($head.$body);
|
165
|
|
|
|
|
|
|
|
166
|
0
|
|
|
|
|
|
return;
|
167
|
|
|
|
|
|
|
}
|
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
sub send_file {
|
170
|
0
|
|
|
0
|
0
|
|
my ($self, $file, $offset) = @_;
|
171
|
|
|
|
|
|
|
|
172
|
0
|
0
|
|
|
|
|
unless ($self->is_http) {
|
173
|
0
|
|
|
|
|
|
croak "Invalid state for ->send_file";
|
174
|
|
|
|
|
|
|
}
|
175
|
|
|
|
|
|
|
|
176
|
0
|
0
|
|
|
|
|
if (-f $file) {
|
177
|
0
|
|
|
|
|
|
my ($ct, $ce) = guess_media_type($file);
|
178
|
0
|
|
|
|
|
|
my ($size, $mtime) = (stat _)[7,9];
|
179
|
|
|
|
|
|
|
|
180
|
0
|
0
|
|
|
|
|
my $fh = new IO::File $file or
|
181
|
|
|
|
|
|
|
return $self->send_error(RC_FORBIDDEN);
|
182
|
|
|
|
|
|
|
|
183
|
0
|
|
|
|
|
|
binmode($fh);
|
184
|
|
|
|
|
|
|
|
185
|
0
|
0
|
0
|
|
|
|
if ($offset && $offset > $size) {
|
|
|
0
|
|
|
|
|
|
186
|
0
|
|
|
|
|
|
$offset = 0;
|
187
|
|
|
|
|
|
|
} elsif ($offset) {
|
188
|
0
|
0
|
|
|
|
|
$fh->seek($offset, 0) or $offset = 0;
|
189
|
|
|
|
|
|
|
}
|
190
|
|
|
|
|
|
|
|
191
|
0
|
0
|
|
|
|
|
my $status = $offset ? RC_PARTIAL_CONTENT : RC_OK;
|
192
|
0
|
|
|
|
|
|
my $message = status_message($status);
|
193
|
0
|
|
|
|
|
|
my $CRLF = "\r\n";
|
194
|
|
|
|
|
|
|
|
195
|
0
|
|
|
|
|
|
my $head;
|
196
|
0
|
|
|
|
|
|
$head .= sprintf "%s %s %s%s", "HTTP/1.0", $status, $message, $CRLF;
|
197
|
0
|
|
|
|
|
|
$head .= sprintf "Date: %s%s", time2str(time), $CRLF;
|
198
|
0
|
|
|
|
|
|
$head .= sprintf "Server: %s/%s%s", "Net-Gnutella", $VERSION, $CRLF;
|
199
|
0
|
|
|
|
|
|
$head .= sprintf "Content-Type: %s%s", $ct, $CRLF;
|
200
|
0
|
0
|
|
|
|
|
$head .= sprintf "Content-Encoding: %s%s", $ce, $CRLF if $ce;
|
201
|
0
|
0
|
|
|
|
|
$head .= sprintf "Content-Length: %d%s", $offset ? $size - $offset : $size, $CRLF if $size;
|
|
|
0
|
|
|
|
|
|
202
|
0
|
0
|
|
|
|
|
$head .= sprintf "Content-Range: bytes %d-%d/%d%s", $offset, $size-1, $size, $CRLF if $offset;
|
203
|
0
|
0
|
|
|
|
|
$head .= sprintf "Last-Modified: %s%s", time2str($mtime), $CRLF if $mtime;
|
204
|
0
|
|
|
|
|
|
$head .= sprintf "%s", $CRLF;
|
205
|
|
|
|
|
|
|
|
206
|
0
|
|
|
|
|
|
$self->_write_wrapper($head, $fh);
|
207
|
0
|
|
|
|
|
|
$self->connected(5);
|
208
|
|
|
|
|
|
|
} else {
|
209
|
0
|
|
|
|
|
|
return $self->send_error(RC_NOT_FOUND);
|
210
|
|
|
|
|
|
|
}
|
211
|
|
|
|
|
|
|
|
212
|
0
|
|
|
|
|
|
return 1;
|
213
|
|
|
|
|
|
|
}
|
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
sub send_packet {
|
216
|
0
|
|
|
0
|
0
|
|
my ($self, $packet) = @_;
|
217
|
|
|
|
|
|
|
|
218
|
0
|
0
|
|
|
|
|
unless ($self->is_established) {
|
219
|
0
|
|
|
|
|
|
croak "Invalid state for ->send_packet";
|
220
|
|
|
|
|
|
|
}
|
221
|
|
|
|
|
|
|
|
222
|
0
|
0
|
0
|
|
|
|
unless ($packet && ref $packet) {
|
223
|
0
|
|
|
|
|
|
carp "Invalid argument to Net::Gnutella::Connection->send_packet";
|
224
|
|
|
|
|
|
|
}
|
225
|
|
|
|
|
|
|
|
226
|
0
|
0
|
|
|
|
|
printf STDERR "+ Sending packet '%s'\n", ref($packet) if $self->debug >= 2;
|
227
|
|
|
|
|
|
|
|
228
|
0
|
|
|
|
|
|
my @msgid = @{ $packet->msgid };
|
|
0
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
|
230
|
0
|
0
|
|
|
|
|
unless (scalar @msgid) {
|
231
|
0
|
|
|
|
|
|
@msgid = $self->_new_msgid;
|
232
|
|
|
|
|
|
|
}
|
233
|
|
|
|
|
|
|
|
234
|
0
|
|
|
|
|
|
my $data = $packet->format;
|
235
|
0
|
|
|
|
|
|
my $head = pack("L4CCCL", @msgid, $packet->function, $packet->ttl, $packet->hops, length $data);
|
236
|
|
|
|
|
|
|
|
237
|
0
|
|
|
|
|
|
$self->parent->_msgid_source(\@msgid, $self);
|
238
|
|
|
|
|
|
|
|
239
|
0
|
|
|
|
|
|
$self->_write_wrapper($head.$data);
|
240
|
|
|
|
|
|
|
|
241
|
0
|
|
|
|
|
|
return \@msgid;
|
242
|
|
|
|
|
|
|
}
|
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
sub send_page {
|
245
|
0
|
|
|
0
|
0
|
|
my ($self, $data) = @_;
|
246
|
|
|
|
|
|
|
|
247
|
0
|
0
|
|
|
|
|
unless ($self->is_http) {
|
248
|
0
|
|
|
|
|
|
croak "Invalid state in ->send_page";
|
249
|
|
|
|
|
|
|
}
|
250
|
|
|
|
|
|
|
|
251
|
0
|
|
|
|
|
|
my $status = RC_OK;
|
252
|
0
|
|
|
|
|
|
my $message = status_message($status);
|
253
|
0
|
|
|
|
|
|
my $CRLF = "\r\n";
|
254
|
|
|
|
|
|
|
|
255
|
0
|
|
|
|
|
|
my $head;
|
256
|
0
|
|
|
|
|
|
$head .= sprintf "%s %s %s%s", "HTTP/1.0", $status, $message, $CRLF;
|
257
|
0
|
|
|
|
|
|
$head .= sprintf "Date: %s%s", time2str(time), $CRLF;
|
258
|
0
|
|
|
|
|
|
$head .= sprintf "Server: %s/%s%s", "Net-Gnutella", $VERSION, $CRLF;
|
259
|
0
|
|
|
|
|
|
$head .= sprintf "Content-Type: %s%s", "text/html", $CRLF;
|
260
|
0
|
|
|
|
|
|
$head .= sprintf "Content-Length: %d%s", length($data), $CRLF;
|
261
|
0
|
|
|
|
|
|
$head .= sprintf "%s", $CRLF;
|
262
|
|
|
|
|
|
|
|
263
|
0
|
|
|
|
|
|
$self->_write_wrapper($head.$data);
|
264
|
|
|
|
|
|
|
}
|
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
sub _default {
|
267
|
0
|
|
|
0
|
|
|
my $self = shift;
|
268
|
0
|
|
|
|
|
|
my $event = shift;
|
269
|
|
|
|
|
|
|
|
270
|
0
|
|
|
|
|
|
my $type = $event->type;
|
271
|
0
|
|
|
|
|
|
my $packet = $event->packet;
|
272
|
|
|
|
|
|
|
|
273
|
0
|
0
|
|
|
|
|
printf STDERR "%s->%s: Handling event '%s'\n", ref($self), "_default", $type if $self->debug;
|
274
|
|
|
|
|
|
|
|
275
|
0
|
0
|
0
|
|
|
|
unless ($packet and ref($packet) =~ /^Net::Gnutella::Packet::/) {
|
276
|
0
|
|
|
|
|
|
return 1;
|
277
|
|
|
|
|
|
|
}
|
278
|
|
|
|
|
|
|
|
279
|
0
|
0
|
|
|
|
|
if ($packet->hops > 7) {
|
280
|
0
|
0
|
|
|
|
|
printf STDERR "+ Not forwarding, large hop count (%s)\n", $packet->hops if $self->debug;
|
281
|
0
|
|
|
|
|
|
return 1;
|
282
|
|
|
|
|
|
|
}
|
283
|
|
|
|
|
|
|
|
284
|
0
|
0
|
|
|
|
|
if ($packet->ttl > 50) {
|
285
|
0
|
0
|
|
|
|
|
printf STDERR "+ Not forwarding, large ttl (%s)\n", $packet->ttl if $self->debug;
|
286
|
0
|
|
|
|
|
|
return 1;
|
287
|
|
|
|
|
|
|
}
|
288
|
|
|
|
|
|
|
|
289
|
0
|
0
|
|
|
|
|
if ($packet->ttl > 7) {
|
290
|
0
|
|
|
|
|
|
$packet->ttl(7);
|
291
|
|
|
|
|
|
|
}
|
292
|
|
|
|
|
|
|
|
293
|
0
|
0
|
|
|
|
|
if ($packet->ttl <= 0) {
|
294
|
0
|
0
|
|
|
|
|
printf STDERR "+ Not forwarding, ttl <= 0 (%s)\n", $packet->ttl if $self->debug;
|
295
|
0
|
|
|
|
|
|
return 1;
|
296
|
|
|
|
|
|
|
} else {
|
297
|
0
|
|
|
|
|
|
$packet->ttl($packet->ttl - 1);
|
298
|
0
|
|
|
|
|
|
$packet->hops($packet->hops + 1);
|
299
|
|
|
|
|
|
|
}
|
300
|
|
|
|
|
|
|
|
301
|
0
|
0
|
|
|
|
|
if ($type eq "pong") {
|
302
|
0
|
|
|
|
|
|
$self->parent->_host_cache( join(":", $packet->ip_as_string, $packet->port) );
|
303
|
|
|
|
|
|
|
}
|
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
# Drop any routed replies which we haven't seen
|
306
|
|
|
|
|
|
|
# Drop any duplicate packets
|
307
|
|
|
|
|
|
|
#
|
308
|
0
|
0
|
|
|
|
|
if ($type =~ /^(ping|query|push)$/) {
|
|
|
0
|
|
|
|
|
|
309
|
0
|
0
|
|
|
|
|
if ($self->parent->_msgid_source($packet->msgid)) {
|
310
|
0
|
|
|
|
|
|
return; # duplicate
|
311
|
|
|
|
|
|
|
} else {
|
312
|
0
|
|
|
|
|
|
$self->parent->_msgid_source($packet->msgid, $self);
|
313
|
|
|
|
|
|
|
}
|
314
|
|
|
|
|
|
|
} elsif ($type =~ /^(pong|reply)$/) {
|
315
|
0
|
0
|
|
|
|
|
unless ($self->parent->_msgid_source($packet->msgid)) {
|
316
|
0
|
0
|
|
|
|
|
printf STDERR "+ Not forwarding, unseen msgid to routed type (%s)\n", join(":", @{$packet->msgid}) if $self->debug;
|
|
0
|
|
|
|
|
|
|
317
|
0
|
|
|
|
|
|
return;
|
318
|
|
|
|
|
|
|
}
|
319
|
|
|
|
|
|
|
}
|
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
# If the packet is a routed reply (pong and reply) and it didn't originate
|
322
|
|
|
|
|
|
|
# from this connection, forward it to the other connection.
|
323
|
|
|
|
|
|
|
#
|
324
|
|
|
|
|
|
|
# Otherwise, throw it at all the connections (broadcast).
|
325
|
|
|
|
|
|
|
#
|
326
|
0
|
0
|
|
|
|
|
if ($type =~ /^(pong|reply)$/) {
|
|
|
0
|
|
|
|
|
|
327
|
0
|
|
|
|
|
|
my $conn = $self->parent->_msgid_source($packet->msgid);
|
328
|
|
|
|
|
|
|
|
329
|
0
|
|
|
|
|
|
$self->forward($packet, $conn);
|
330
|
|
|
|
|
|
|
} elsif ($type =~ /^(ping|push|query)$/) {
|
331
|
0
|
|
|
|
|
|
$self->forward($packet);
|
332
|
|
|
|
|
|
|
}
|
333
|
|
|
|
|
|
|
|
334
|
0
|
|
|
|
|
|
return 1;
|
335
|
|
|
|
|
|
|
}
|
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
sub _new_msgid {
|
338
|
0
|
|
|
0
|
|
|
my $self = shift;
|
339
|
0
|
|
|
|
|
|
my $msgid = $self->msgid;
|
340
|
|
|
|
|
|
|
|
341
|
0
|
0
|
|
|
|
|
if (scalar @$msgid) {
|
342
|
0
|
|
|
|
|
|
$self->msgid([ $msgid->[0], $msgid->[1], $msgid->[2], ++$msgid->[3] ]);
|
343
|
|
|
|
|
|
|
} else {
|
344
|
0
|
|
|
|
|
|
$msgid = [ int rand(65536**2), int rand(65536**2), int rand(65536**2), int rand(65536**2) ];
|
345
|
|
|
|
|
|
|
|
346
|
0
|
|
|
|
|
|
$self->msgid($msgid);
|
347
|
|
|
|
|
|
|
}
|
348
|
|
|
|
|
|
|
|
349
|
0
|
0
|
|
|
|
|
return wantarray ? @$msgid : $msgid;
|
350
|
|
|
|
|
|
|
}
|
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
sub _read_socket {
|
353
|
0
|
|
|
0
|
|
|
my $self = shift;
|
354
|
0
|
|
|
|
|
|
my $buf = $self->readbuf;
|
355
|
|
|
|
|
|
|
|
356
|
0
|
|
|
|
|
|
local $SIG{PIPE} = 'IGNORE';
|
357
|
|
|
|
|
|
|
|
358
|
0
|
0
|
|
|
|
|
if ($self->is_outgoing) {
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
359
|
0
|
|
|
|
|
|
my $ret = $self->socket->sysread($buf, 13, length $buf);
|
360
|
|
|
|
|
|
|
|
361
|
0
|
0
|
|
|
|
|
if ($ret == 0) {
|
362
|
0
|
|
|
|
|
|
$self->disconnect;
|
363
|
0
|
|
|
|
|
|
return;
|
364
|
|
|
|
|
|
|
}
|
365
|
|
|
|
|
|
|
|
366
|
0
|
|
|
|
|
|
$self->readbuf($buf);
|
367
|
|
|
|
|
|
|
|
368
|
0
|
0
|
|
|
|
|
if ($buf eq "GNUTELLA OK\n\n") {
|
369
|
0
|
|
|
|
|
|
$self->readbuf("");
|
370
|
0
|
|
|
|
|
|
$self->connected(3); # ESTABLISHED
|
371
|
|
|
|
|
|
|
|
372
|
0
|
|
|
|
|
|
my $event = Net::Gnutella::Event->new(
|
373
|
|
|
|
|
|
|
from => $self,
|
374
|
|
|
|
|
|
|
type => "connected",
|
375
|
|
|
|
|
|
|
);
|
376
|
|
|
|
|
|
|
|
377
|
0
|
|
|
|
|
|
$self->parent->_handler($event);
|
378
|
|
|
|
|
|
|
|
379
|
0
|
|
|
|
|
|
return;
|
380
|
|
|
|
|
|
|
}
|
381
|
|
|
|
|
|
|
|
382
|
0
|
0
|
|
|
|
|
if (length $buf >= 13) {
|
383
|
0
|
|
|
|
|
|
$self->error("Invalid response");
|
384
|
0
|
|
|
|
|
|
$self->disconnect;
|
385
|
0
|
|
|
|
|
|
return;
|
386
|
|
|
|
|
|
|
}
|
387
|
|
|
|
|
|
|
} elsif ($self->is_incoming) {
|
388
|
0
|
|
|
|
|
|
my $ret = $self->socket->sysread($buf, 1, length $buf);
|
389
|
|
|
|
|
|
|
|
390
|
0
|
0
|
|
|
|
|
if ($ret == 0) {
|
391
|
0
|
|
|
|
|
|
$self->disconnect;
|
392
|
0
|
|
|
|
|
|
return;
|
393
|
|
|
|
|
|
|
}
|
394
|
|
|
|
|
|
|
|
395
|
0
|
|
|
|
|
|
$self->readbuf($buf);
|
396
|
|
|
|
|
|
|
|
397
|
0
|
0
|
|
|
|
|
if ($buf =~ /^\w+[^\012]+HTTP\/\d+\.\d+\015?\012/) {
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
398
|
0
|
0
|
|
|
|
|
if ($buf =~ /\015?\012\015?\012/) {
|
|
|
0
|
|
|
|
|
|
399
|
0
|
0
|
|
|
|
|
unless ($self->allow & 2) {
|
400
|
0
|
|
|
|
|
|
$self->disconnect;
|
401
|
0
|
|
|
|
|
|
return;
|
402
|
|
|
|
|
|
|
}
|
403
|
|
|
|
|
|
|
|
404
|
0
|
|
|
|
|
|
$self->readbuf("");
|
405
|
0
|
|
|
|
|
|
$self->connected(4); # HTTP
|
406
|
|
|
|
|
|
|
|
407
|
0
|
0
|
|
|
|
|
unless ($buf =~ s/^(\w+)[ \t]+(.+)[ \t]+(HTTP\/\d+\.\d+)[^\012]*\012//) {
|
408
|
0
|
|
|
|
|
|
$self->send_error(400); # BAD_REQUEST
|
409
|
0
|
|
|
|
|
|
$self->error("Bad request line");
|
410
|
0
|
|
|
|
|
|
return;
|
411
|
|
|
|
|
|
|
}
|
412
|
|
|
|
|
|
|
|
413
|
0
|
|
|
|
|
|
my $url = URI::URL->new($2);
|
414
|
0
|
|
|
|
|
|
my $request = HTTP::Request->new($1, $url);
|
415
|
|
|
|
|
|
|
|
416
|
0
|
|
|
|
|
|
my ($key, $val);
|
417
|
|
|
|
|
|
|
|
418
|
0
|
|
|
|
|
|
HEADER: while ($buf =~ s/^([^\012]*)\012//) {
|
419
|
0
|
|
|
|
|
|
$_ = $1;
|
420
|
0
|
|
|
|
|
|
s/\015$//;
|
421
|
|
|
|
|
|
|
|
422
|
0
|
0
|
|
|
|
|
if (/^([\w\-]+)\s*:\s*(.*)/) {
|
|
|
0
|
|
|
|
|
|
423
|
0
|
0
|
|
|
|
|
$request->push_header($key, $val) if $key;
|
424
|
0
|
|
|
|
|
|
($key, $val) = ($1, $2);
|
425
|
|
|
|
|
|
|
} elsif (/^\s+(.*)/) {
|
426
|
0
|
|
|
|
|
|
$val .= " $1";
|
427
|
|
|
|
|
|
|
} else {
|
428
|
0
|
|
|
|
|
|
last HEADER;
|
429
|
|
|
|
|
|
|
}
|
430
|
|
|
|
|
|
|
}
|
431
|
|
|
|
|
|
|
|
432
|
0
|
0
|
|
|
|
|
$request->push_header($key, $val) if $key;
|
433
|
|
|
|
|
|
|
|
434
|
0
|
|
|
|
|
|
my $event = Net::Gnutella::Event->new(
|
435
|
|
|
|
|
|
|
from => $self,
|
436
|
|
|
|
|
|
|
type => "download_req",
|
437
|
|
|
|
|
|
|
packet => $request,
|
438
|
|
|
|
|
|
|
);
|
439
|
|
|
|
|
|
|
|
440
|
0
|
|
|
|
|
|
$self->parent->_handler($event);
|
441
|
|
|
|
|
|
|
|
442
|
0
|
|
|
|
|
|
return;
|
443
|
|
|
|
|
|
|
} elsif (length($buf) > 1*1024) {
|
444
|
0
|
|
|
|
|
|
$self->disconnect;
|
445
|
0
|
|
|
|
|
|
$self->error("Very long header");
|
446
|
0
|
|
|
|
|
|
return;
|
447
|
|
|
|
|
|
|
}
|
448
|
|
|
|
|
|
|
} elsif ($buf =~ /^GNUTELLA CONNECT\/(\d+\.\d+)\015?\012\015?\012/) {
|
449
|
0
|
0
|
|
|
|
|
if ($1 le "0.4") {
|
450
|
0
|
0
|
|
|
|
|
unless ($self->allow & 1) {
|
451
|
0
|
|
|
|
|
|
$self->disconnect;
|
452
|
0
|
|
|
|
|
|
return;
|
453
|
|
|
|
|
|
|
}
|
454
|
|
|
|
|
|
|
|
455
|
0
|
|
|
|
|
|
$self->readbuf("");
|
456
|
0
|
|
|
|
|
|
$self->connected(3); # ESTABLISHED
|
457
|
|
|
|
|
|
|
|
458
|
0
|
|
|
|
|
|
$self->_write_wrapper("GNUTELLA OK\n\n");
|
459
|
|
|
|
|
|
|
|
460
|
0
|
|
|
|
|
|
my $event = Net::Gnutella::Event->new(
|
461
|
|
|
|
|
|
|
from => $self,
|
462
|
|
|
|
|
|
|
type => "connected",
|
463
|
|
|
|
|
|
|
);
|
464
|
|
|
|
|
|
|
|
465
|
0
|
|
|
|
|
|
$self->parent->_handler($event);
|
466
|
|
|
|
|
|
|
|
467
|
0
|
|
|
|
|
|
return;
|
468
|
|
|
|
|
|
|
} else {
|
469
|
0
|
|
|
|
|
|
$self->disconnect;
|
470
|
0
|
|
|
|
|
|
return;
|
471
|
|
|
|
|
|
|
}
|
472
|
|
|
|
|
|
|
} elsif (length($buf) > 1*1024) {
|
473
|
0
|
|
|
|
|
|
$self->disconnect;
|
474
|
0
|
|
|
|
|
|
$self->error("Very long first line");
|
475
|
0
|
|
|
|
|
|
return;
|
476
|
|
|
|
|
|
|
}
|
477
|
|
|
|
|
|
|
} elsif ($self->is_established) {
|
478
|
0
|
|
|
|
|
|
my $ret = $self->socket->sysread($buf, 256, length $buf);
|
479
|
|
|
|
|
|
|
|
480
|
0
|
0
|
|
|
|
|
if ($ret == 0) {
|
481
|
0
|
|
|
|
|
|
$self->disconnect("disconnect");
|
482
|
0
|
|
|
|
|
|
return;
|
483
|
|
|
|
|
|
|
}
|
484
|
|
|
|
|
|
|
|
485
|
0
|
|
|
|
|
|
$self->readbuf($buf);
|
486
|
|
|
|
|
|
|
|
487
|
0
|
0
|
|
|
|
|
printf STDERR " - Read %d bytes, buffer has %d bytes\n", $ret, length $buf if $self->debug;
|
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
PROCESS: {
|
490
|
0
|
0
|
|
|
|
|
if (length $buf < 23) {
|
|
0
|
|
|
|
|
|
|
491
|
0
|
|
|
|
|
|
last PROCESS;
|
492
|
|
|
|
|
|
|
}
|
493
|
|
|
|
|
|
|
|
494
|
0
|
|
|
|
|
|
my @msgid = unpack("L4", substr($buf, 0, 16));
|
495
|
0
|
|
|
|
|
|
my $func = unpack("C", substr($buf, 16, 1));
|
496
|
0
|
|
|
|
|
|
my $ttl = unpack("C", substr($buf, 17, 1));
|
497
|
0
|
|
|
|
|
|
my $hops = unpack("C", substr($buf, 18, 1));
|
498
|
0
|
|
|
|
|
|
my $len = unpack("L", substr($buf, 19, 4));
|
499
|
|
|
|
|
|
|
|
500
|
0
|
0
|
|
|
|
|
if (length($buf) < 23+$len) {
|
501
|
0
|
|
|
|
|
|
last PROCESS;
|
502
|
|
|
|
|
|
|
}
|
503
|
|
|
|
|
|
|
|
504
|
0
|
|
|
|
|
|
my $head = substr($buf, 0, 23, '');
|
505
|
0
|
|
|
|
|
|
my $data = substr($buf, 0, $len, '');
|
506
|
|
|
|
|
|
|
|
507
|
0
|
0
|
|
|
|
|
printf STDERR " - Full packet read, %d bytes left\n", length $buf if $self->debug;
|
508
|
|
|
|
|
|
|
|
509
|
0
|
|
|
|
|
|
my $class;
|
510
|
|
|
|
|
|
|
|
511
|
0
|
0
|
|
|
|
|
if ($func == 0) {
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
512
|
0
|
0
|
|
|
|
|
goto PROCESS if $len != 0;
|
513
|
0
|
|
|
|
|
|
$class = "Net::Gnutella::Packet::Ping";
|
514
|
|
|
|
|
|
|
} elsif ($func == 1) {
|
515
|
0
|
0
|
|
|
|
|
goto PROCESS if $len != 14;
|
516
|
0
|
|
|
|
|
|
$class = "Net::Gnutella::Packet::Pong";
|
517
|
|
|
|
|
|
|
} elsif ($func == 64) {
|
518
|
0
|
0
|
|
|
|
|
goto PROCESS if $len != 26;
|
519
|
0
|
|
|
|
|
|
$class = "Net::Gnutella::Packet::Push";
|
520
|
|
|
|
|
|
|
} elsif ($func == 128) {
|
521
|
0
|
0
|
|
|
|
|
goto PROCESS if $len >= 257;
|
522
|
0
|
|
|
|
|
|
$class = "Net::Gnutella::Packet::Query";
|
523
|
|
|
|
|
|
|
} elsif ($func == 129) {
|
524
|
0
|
0
|
|
|
|
|
goto PROCESS if $len >= 67_075;
|
525
|
0
|
|
|
|
|
|
$class = "Net::Gnutella::Packet::Reply";
|
526
|
|
|
|
|
|
|
} else {
|
527
|
0
|
|
|
|
|
|
goto PROCESS;
|
528
|
|
|
|
|
|
|
}
|
529
|
|
|
|
|
|
|
|
530
|
0
|
|
|
|
|
|
my $packet = $class->new(
|
531
|
|
|
|
|
|
|
Msgid => \@msgid,
|
532
|
|
|
|
|
|
|
Function => $func,
|
533
|
|
|
|
|
|
|
TTL => $ttl,
|
534
|
|
|
|
|
|
|
Hops => $hops,
|
535
|
|
|
|
|
|
|
Parse => $data,
|
536
|
|
|
|
|
|
|
);
|
537
|
|
|
|
|
|
|
|
538
|
0
|
|
|
|
|
|
my $event = Net::Gnutella::Event->new(
|
539
|
|
|
|
|
|
|
from => $self,
|
540
|
|
|
|
|
|
|
type => $func,
|
541
|
|
|
|
|
|
|
packet => $packet,
|
542
|
|
|
|
|
|
|
);
|
543
|
|
|
|
|
|
|
|
544
|
0
|
|
|
|
|
|
$self->parent->_handler($event);
|
545
|
|
|
|
|
|
|
|
546
|
0
|
|
|
|
|
|
goto PROCESS;
|
547
|
|
|
|
|
|
|
}
|
548
|
|
|
|
|
|
|
|
549
|
0
|
0
|
|
|
|
|
printf STDERR " - buffer has %d bytes\n\n", length $buf if $self->debug;
|
550
|
|
|
|
|
|
|
|
551
|
0
|
|
|
|
|
|
$self->readbuf($buf);
|
552
|
|
|
|
|
|
|
} else {
|
553
|
0
|
|
|
|
|
|
my $ret = $self->socket->sysread($buf, 16*1024, length($buf));
|
554
|
|
|
|
|
|
|
|
555
|
0
|
0
|
|
|
|
|
if ($self->is_upload) {
|
556
|
0
|
|
|
|
|
|
$self->disconnect("upload_error");
|
557
|
|
|
|
|
|
|
} else {
|
558
|
0
|
|
|
|
|
|
$self->disconnect;
|
559
|
|
|
|
|
|
|
}
|
560
|
|
|
|
|
|
|
}
|
561
|
|
|
|
|
|
|
|
562
|
0
|
|
|
|
|
|
return;
|
563
|
|
|
|
|
|
|
}
|
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
sub _write_socket {
|
566
|
0
|
|
|
0
|
|
|
my ($self, $sock, $fh) = @_;
|
567
|
0
|
|
|
|
|
|
my $buf = $self->writebuf;
|
568
|
|
|
|
|
|
|
|
569
|
0
|
|
|
|
|
|
local $SIG{PIPE} = 'IGNORE';
|
570
|
|
|
|
|
|
|
|
571
|
0
|
0
|
|
|
|
|
printf STDERR " - Writing to FH, bytes in buffer: %s\n", length($buf) if $self->debug;
|
572
|
|
|
|
|
|
|
|
573
|
0
|
0
|
|
|
|
|
if (length($buf) == 0) {
|
574
|
0
|
|
|
|
|
|
return;
|
575
|
|
|
|
|
|
|
}
|
576
|
|
|
|
|
|
|
|
577
|
0
|
|
|
|
|
|
my $len = $self->socket->syswrite($buf, length $buf);
|
578
|
|
|
|
|
|
|
|
579
|
0
|
0
|
|
|
|
|
if ($len == 0) {
|
580
|
0
|
|
|
|
|
|
$self->disconnect;
|
581
|
0
|
|
|
|
|
|
return;
|
582
|
|
|
|
|
|
|
}
|
583
|
|
|
|
|
|
|
|
584
|
0
|
|
|
|
|
|
substr($buf, 0, $len, '');
|
585
|
|
|
|
|
|
|
|
586
|
0
|
0
|
|
|
|
|
printf STDERR " - Wrote %d bytes, %d bytes left\n", $len, length($buf) if $self->debug;
|
587
|
|
|
|
|
|
|
|
588
|
0
|
0
|
0
|
|
|
|
if ($self->is_upload and defined $fh) {
|
589
|
0
|
|
|
|
|
|
printf "Buf length %d, pos %d\n", length $buf, tell($fh);
|
590
|
0
|
|
|
|
|
|
my $read = sysread($fh, $buf, (16*1024)-length($buf), length($buf));
|
591
|
0
|
|
|
|
|
|
printf "Reading [%s] [%d] [%d]\n", $fh, $read, tell($fh);
|
592
|
|
|
|
|
|
|
}
|
593
|
|
|
|
|
|
|
|
594
|
0
|
|
|
|
|
|
$self->writebuf($buf);
|
595
|
|
|
|
|
|
|
|
596
|
0
|
0
|
|
|
|
|
if (length($buf)) {
|
597
|
0
|
|
|
|
|
|
return;
|
598
|
|
|
|
|
|
|
}
|
599
|
|
|
|
|
|
|
|
600
|
0
|
|
|
|
|
|
$self->parent->_remove_fh($self->socket, "w");
|
601
|
|
|
|
|
|
|
|
602
|
0
|
0
|
0
|
|
|
|
if ($self->is_upload and $fh and ref($fh) eq "IO::File") {
|
|
|
0
|
0
|
|
|
|
|
603
|
0
|
|
|
|
|
|
$self->disconnect("download_complete");
|
604
|
|
|
|
|
|
|
} elsif ($self->is_http) {
|
605
|
0
|
|
|
|
|
|
$self->disconnect;
|
606
|
|
|
|
|
|
|
}
|
607
|
|
|
|
|
|
|
}
|
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
sub _write_wrapper {
|
610
|
0
|
|
|
0
|
|
|
my ($self, $data, @args) = @_;
|
611
|
0
|
|
|
|
|
|
my $buf = $self->writebuf;
|
612
|
|
|
|
|
|
|
|
613
|
0
|
|
|
|
|
|
$self->writebuf($buf.$data);
|
614
|
0
|
|
|
|
|
|
$self->parent->_add_fh($self->socket, $self->can("_write_socket"), "w", $self, @args);
|
615
|
|
|
|
|
|
|
}
|
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
1;
|