patch #8106
[mldonkey.git] / src / networks / donkey / donkeyUdp.ml
blobb209a1bf07f898f131f1ea7588187b0b4294a7b1
1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
2 (*
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
20 open Printf2
21 open Md4
23 open CommonShared
24 open CommonServer
25 open CommonComplexOptions
26 open GuiProto
27 open CommonClient
28 open CommonFile
29 open CommonUser
30 open CommonSearch
31 open CommonTypes
32 open Options
33 open BasicSocket
34 open TcpBufferedSocket
35 open DonkeyMftp
36 open DonkeyOneFile
37 open DonkeyProtoCom
38 open DonkeyTypes
39 open DonkeyGlobals
40 open DonkeyComplexOptions
41 open DonkeyOptions
42 open CommonOptions
43 open DonkeyClient
44 open CommonGlobals
45 open DonkeyStats
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)
52 else
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;
58 List.iter (fun f ->
59 search_found false s f.f_md4 f.f_tags
60 ) t
61 (* search.search_handler (Waiting s.search_waiting) *)
63 let make_xs ss =
64 if !verbose_udp then lprintf "******** make_xs ********\n";
65 if ss.search_num <> !xs_last_search then
66 begin
67 xs_last_search := ss.search_num;
68 xs_servers_list := Hashtbl2.to_list servers_by_key;
69 end;
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 =
74 if n = 0 then
75 left, list
76 else
77 match list with
78 [] -> left, []
79 | s :: tail ->
80 if connection_last_conn s.server_connection_control > min_last_conn then
81 iter tail (n-1) (s :: left)
82 else
83 iter tail n 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;
90 List.iter (fun s ->
91 match s.server_sock with
92 Connection _ -> ()
93 | _ ->
94 let module M = DonkeyProtoServer in
95 let module Q = M.Query in
96 udp_server_send s (
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
103 else *)
104 Udp.QueryMultipleUdpReq ss.search_query);
105 ) before;
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)
116 with _ -> ()
117 end;
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;
126 if !files <> [] then
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
134 [] -> false
135 | s :: tail ->
136 udp_servers_list := tail;
137 (match s.server_sock with
138 Connection _ -> ()
139 | _ ->
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
145 else
146 old_servers := s :: !old_servers);
147 incr nservers;
150 true do
152 done;
154 if !new_servers <> [] then begin
155 let md4s = List.map (fun file -> file.file_md4) !files in
157 List.iter (fun s ->
158 let module Udp = DonkeyProtoUdp in
159 udp_server_send s (Udp.QueryLocationUdpReq md4s);
160 s.server_next_udp <- last_time () + !!min_reask_delay
161 ) !new_servers
162 end;
164 if !old_servers <> [] then
165 List.iter (fun file ->
166 if file_state file = FileDownloading then begin
167 (*(* USELESS NOW *)
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
174 List.iter (fun s ->
175 match s.server_sock with
176 None -> () (* assert false !!! *)
177 | Some sock ->
178 (try DonkeyServers.query_location file sock with _ -> ())
179 ) (connected_servers());
182 List.iter (fun s ->
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
187 | Connection _ -> ()
188 | _ -> udp_query_locations file s
189 ) !old_servers;
191 ) !current_files;
193 List.iter (fun s ->
194 s.server_next_udp <- last_time () + !!min_reask_delay
195 ) !old_servers;
196 if !udp_servers_list = [] then
197 udp_servers_list := Hashtbl2.to_list servers_by_key;
199 end removed by savannah patch #3616
202 with e ->
203 lprintf "extent_search: %s\n" (Printexc2.to_string e)
205 let add_user_friend s u =
206 let kind =
207 if Ip.usable u.user_ip then
208 Direct_address (u.user_ip, u.user_port)
209 else
210 begin
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)
214 | _ -> ()
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;
222 friend_add c
224 let udp_client_handler t p =
225 if !verbose_udp then
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
232 let s =
233 if !!update_server_list_server then
234 check_add_server ip (port-4)
235 else
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 (
240 last_time () - 121);
241 s.server_score <- s.server_score + 3;
242 s.server_failed_count <- 0;
244 | _ -> raise Not_found
246 match t with
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
257 List.iter (fun t ->
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
269 | _ -> false, 0L
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
292 | _ -> ());
293 (match t.M.lowid_users with
294 Some x when x > 0L -> s.server_lowid_users <- Some x
295 | _ -> ());
296 (match t.M.soft_limit with
297 Some x when x > 0L -> s.server_soft_limit <- Some x
298 | _ -> ());
299 (match t.M.hard_limit with
300 Some x when x > 0L -> s.server_hard_limit <- Some x
301 | _ -> ());
302 server_must_update s
303 end else
304 begin
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
317 | _ -> false, 0L
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 ->
324 match tag with
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
332 | _ -> ()
333 ) t.M.tags;
335 if s.server_tags = [] then
336 s.server_tags <- t.M.tags;
338 server_must_update s
339 end else
340 begin
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
350 None -> ()
351 | Some sock ->
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)
357 | _ ->
358 if !verbose_unexpected_messages then
359 lprintf "Unexpected UDP message: %s\n"
360 (DonkeyProtoUdp.print t)