1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
3 This file is part of mldonkey.
5 mldonkey is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
10 mldonkey is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with mldonkey; if not, write to the Free Software
17 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
25 open CommonComplexOptions
34 open TcpBufferedSocket
40 open DonkeyComplexOptions
47 module Udp
= DonkeyProtoUdp
49 let udp_server_send_query_location s l
=
50 if s
.server_has_get_sources2
then
51 udp_server_send s
(Udp.QueryLocationUdpReq2 l
)
53 udp_server_send s
(Udp.QueryLocationUdpReq
(List.map
(fun (md4
,_
) -> md4
) l
))
55 let search_handler s t
=
56 let waiting = s
.search_waiting
- 1 in
57 s
.search_waiting
<- waiting;
59 search_found
false s f
.f_md4 f
.f_tags
61 (* search.search_handler (Waiting s.search_waiting) *)
64 if !verbose_udp
then lprintf
"******** make_xs ********\n";
65 if ss
.search_num
<> !xs_last_search
then
67 xs_last_search
:= ss
.search_num
;
68 xs_servers_list
:= Hashtbl2.to_list servers_by_key
;
71 let cut_for_udp_send max_servers list
=
72 let min_last_conn = last_time
() - 8 * 3600 in
73 let rec iter list n left
=
80 if connection_last_conn s
.server_connection_control
> min_last_conn then
81 iter tail
(n
-1) (s
:: left
)
85 iter list max_servers
[]
87 let before, after
= cut_for_udp_send !!max_xs_packets
!xs_servers_list
in
88 xs_servers_list
:= after
;
91 match s
.server_sock
with
94 let module M
= DonkeyProtoServer
in
95 let module Q
= M.Query
in
97 (* By default, send the MultipleUdp !!! we have to set
98 server_send_multiple_replies to true by default, and change it to false
99 when receiving an old ping.
101 if server_send_multiple_replies s then
102 Udp.QueryUdpReq ss.search_query
104 Udp.QueryMultipleUdpReq ss
.search_query
);
107 if !verbose_overnet
then lprintf
"===================== STARTING SEARCH ON OVERNET =========\n";
108 DonkeyProtoOvernet.Overnet.overnet_search ss
;
109 DonkeyProtoKademlia.Kademlia.overnet_search ss
111 let extent_search () =
113 if !xs_last_search
>= 0 then begin
115 make_xs (search_find
!xs_last_search
)
120 start removed by savannah patch #3616
121 let files = ref [] in
122 List.iter (fun file ->
123 if file_state file = FileDownloading then
124 files := file :: !files) !current_files;
128 let old_servers = ref [] in
129 let new_servers = ref [] in
130 let nservers = ref 0 in
132 while !nservers < !!max_udp_sends &&
133 match !udp_servers_list with
136 udp_servers_list := tail;
137 (match s.server_sock with
141 connection_last_conn s.server_connection_control + 3600*8 > last_time () &&
142 s.server_next_udp <= last_time () then begin
143 (if server_accept_multiple_getsources s then
144 new_servers := s :: !new_servers
146 old_servers := s :: !old_servers);
154 if !new_servers <> [] then begin
155 let md4s = List.map (fun file -> file.file_md4) !files in
158 let module Udp = DonkeyProtoUdp in
159 udp_server_send s (Udp.QueryLocationUdpReq md4s);
160 s.server_next_udp <- last_time () + !!min_reask_delay
164 if !old_servers <> [] then
165 List.iter (fun file ->
166 if file_state file = FileDownloading then begin
168 Intmap.iter (fun _ c
->
169 try connect_client
!!client_ip
[file
] c
with _
-> ())
170 file
.file_known_locations
;
173 (* now, it is done in donkeySources
175 match s.server_sock with
176 None -> () (* assert false !!! *)
178 (try DonkeyServers.query_location file sock
with _
-> ())
179 ) (connected_servers
());
184 connection_last_conn s
.server_connection_control
+ 3600*8 > last_time
() &&
185 s
.server_next_udp
<= last_time
() then
186 match s
.server_sock
with
188 | _
-> udp_query_locations file s
194 s
.server_next_udp
<- last_time
() + !!min_reask_delay
196 if !udp_servers_list
= [] then
197 udp_servers_list
:= Hashtbl2.to_list servers_by_key
;
199 end removed by savannah patch #
3616
203 lprintf
"extent_search: %s\n" (Printexc2.to_string e
)
205 let add_user_friend s u
=
207 if Ip.usable u
.user_ip
then
208 Direct_address
(u
.user_ip
, u
.user_port
)
211 ( match s
.server_sock
, server_state s
with
212 Connection sock
, (Connected _
|Connected_downloading _
) ->
213 query_id s
.server_ip s
.server_port
(id_of_ip u
.user_ip
)
216 Invalid_address
(u
.user_name
, Md4.to_string u
.user_md4
)
219 let c = new_client
kind None
in
220 c.client_tags
<- u
.user_tags
;
221 set_client_name
c u
.user_name u
.user_md4
;
224 let udp_client_handler t p
=
226 lprintf_nl
"Received UDP message:\n%s" (Udp.print t
);
228 let udp_from_server p
=
229 match p
.UdpSocket.udp_addr
with
230 | Unix.ADDR_INET
(ip
, port
) ->
231 let ip = Ip.of_inet_addr
ip in
233 if !!update_server_list_server
then
234 check_add_server
ip (port
-4)
236 find_server
ip (port
-4) in
237 (* set last_conn, but add a 2 minutes offset to prevent
238 staying connected to this server *)
239 connection_set_last_conn
s.server_connection_control
(
241 s.server_score
<- s.server_score
+ 3;
242 s.server_failed_count
<- 0;
244 | _
-> raise Not_found
247 | Udp.QueryLocationReplyUdpReq t
->
248 (* lprintf "Received location by UDP\n"; *)
249 let s = udp_from_server p
in
250 List.iter (query_locations_reply
s) t
252 | Udp.QueryReplyUdpReq t
->
253 (* lprintf "Received file by UDP\n"; *)
254 if !xs_last_search
>= 0 then
255 let ss = search_find
!xs_last_search
in
256 let s = udp_from_server p
in
258 Hashtbl.add udp_servers_replies t
.f_md4
s;
259 search_handler ss [t
]
262 | Udp.PingServerReplyUdpReq t
->
263 let s = udp_from_server p
in
264 let module M
= Udp.PingServerReplyUdp
in
265 let check_challenge, challenge_v
=
266 match s.server_udp_ping_challenge
with
267 | Some challenge
when challenge
= t
.M.challenge
-> true, challenge
268 | Some challenge
-> false, challenge
271 if check_challenge then begin
272 UdpSocket.declare_pong
s.server_ip
;
273 let now = Unix.gettimeofday
() in
274 s.server_ping
<- int_of_float
((now -. s.server_last_ping
) *. 1000.);
275 s.server_udp_ping_challenge
<- None
;
276 s.server_has_get_sources
<- t
.M.get_sources
;
277 s.server_has_get_files
<- t
.M.get_files
;
278 s.server_has_newtags
<- t
.M.newtags
;
279 s.server_has_unicode
<- t
.M.unicode
;
280 s.server_has_get_sources2
<- t
.M.get_sources2
;
281 s.server_has_largefiles
<- t
.M.largefiles
;
282 (match s.server_obfuscation_udp
with
283 | None
-> if t
.M.udp_obfuscation
then s.server_obfuscation_udp
<- Some
0
284 | Some p
-> if not t
.M.udp_obfuscation
then s.server_obfuscation_udp
<- None
);
285 (match s.server_obfuscation_tcp
with
286 | None
-> if t
.M.tcp_obfuscation
then s.server_obfuscation_tcp
<- Some
0
287 | Some p
-> if not t
.M.tcp_obfuscation
then s.server_obfuscation_tcp
<- None
);
288 if t
.M.files > 0L then s.server_nfiles
<- Some t
.M.files;
289 if t
.M.users
> 0L then s.server_nusers
<- Some t
.M.users
;
290 (match t
.M.max_users
with
291 Some x
when x
> 0L -> s.server_max_users
<- Some x
293 (match t
.M.lowid_users
with
294 Some x
when x
> 0L -> s.server_lowid_users
<- Some x
296 (match t
.M.soft_limit
with
297 Some x
when x
> 0L -> s.server_soft_limit
<- Some x
299 (match t
.M.hard_limit
with
300 Some x
when x
> 0L -> s.server_hard_limit
<- Some x
305 lprintf_nl
"received PingServerReply from %s with invalid challenge: %Ld <> %Ld"
306 (string_of_server
s) challenge_v t
.M.challenge
;
307 s.server_udp_ping_challenge
<- None
;
310 | Udp.ServerDescReplyUdpReq t
->
311 let module M
= Udp.ServerDescReplyUdp
in
312 let s = udp_from_server p
in
313 let check_challenge, challenge_v
=
314 match s.server_udp_desc_challenge
with
315 | Some challenge
when challenge
= t
.M.challenge
-> true, challenge
316 | Some challenge
-> false, challenge
319 if check_challenge then begin
320 s.server_name
<- t
.M.name
;
321 s.server_description
<- t
.M.desc
;
322 s.server_udp_desc_challenge
<- None
;
323 List.iter (fun tag
->
325 { tag_name
= Field_KNOWN
"version"; tag_value
= Uint64 i
} ->
326 let i = Int64.to_int
i in
327 s.server_version
<- Printf.sprintf
"%d.%d" (i lsr 16) (i land 0xFFFF);
328 | { tag_name
= Field_KNOWN
"auxportslist" ; tag_value
= String aux
} ->
329 s.server_auxportslist
<- aux
330 | { tag_name
= Field_KNOWN
"dynip" ; tag_value
= String dynip
} ->
331 s.server_dynip
<- dynip
335 if s.server_tags
= [] then
336 s.server_tags
<- t
.M.tags
;
341 lprintf_nl
"received ServerDescReply from %s with invalid challenge: %Ld <> %Ld"
342 (string_of_server
s) challenge_v t
.M.challenge
;
343 s.server_udp_desc_challenge
<- None
;
346 | Udp.EmuleReaskFilePingUdpReq t
-> ()
348 | Udp.EmulePortTestReq
->
349 (match !porttest_sock
with
352 let s = Buffer.create
10 in
353 DonkeyProtoUdp.write
s Udp.EmulePortTestReq
;
354 TcpBufferedSocket.write_string sock
(Buffer.contents
s);
355 porttest_sock
:= None
)
358 if !verbose_unexpected_messages
then
359 lprintf
"Unexpected UDP message: %s\n"
360 (DonkeyProtoUdp.print t
)