[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Mldonkey-commits] Changes to mldonkey/src/networks/donkey/donkeyServers
|
From: |
mldonkey-commits |
|
Subject: |
[Mldonkey-commits] Changes to mldonkey/src/networks/donkey/donkeyServers.ml |
|
Date: |
Mon, 08 Aug 2005 12:47:43 -0400 |
Index: mldonkey/src/networks/donkey/donkeyServers.ml
diff -u mldonkey/src/networks/donkey/donkeyServers.ml:1.36
mldonkey/src/networks/donkey/donkeyServers.ml:1.37
--- mldonkey/src/networks/donkey/donkeyServers.ml:1.36 Fri Jul 22 14:32:12 2005
+++ mldonkey/src/networks/donkey/donkeyServers.ml Mon Aug 8 16:47:31 2005
@@ -30,7 +30,7 @@
open CommonComplexOptions
open CommonServer
open CommonOptions
-open CommonTypes
+open CommonTypes
open CommonOptions
open CommonGlobals
open CommonSources
@@ -61,7 +61,7 @@
*
* add_query_location (file) (server) -> add file as head to Queue of server
* fill_query_queue (server) -> fill Queue with files to request
- * get_query_files (server) (number) -> strip (number) files from Queue
+ * get_query_files (server) (number) -> strip (number) files from Queue
* and return them
*)
@@ -75,12 +75,12 @@
) !current_files in
(* shuffle list so we don't ask all Servers for the same file at once *)
- let rand_prio = List.map (fun f ->
+ let rand_prio = List.map (fun f ->
file_priority f + Random.int 100
) downloading in
let joined = List.combine downloading rand_prio in
- let queries, _ = List.split (
+ let queries, _ = List.split (
List.sort (
fun (_,p1) (_,p2) -> p2 - p1
) joined
@@ -94,7 +94,7 @@
if n>0 then
begin
match server.server_waiting_queries with
- [] ->
+ [] ->
fill_query_queue server;
[]
(* iter (mini n (List.length server.server_waiting_queries) ) *)
@@ -102,7 +102,7 @@
server.server_waiting_queries <- files;
if files = [] then
server.server_sent_all_queries <- true;
-
+
if file_state file = FileDownloading
&& DonkeySources.need_new_sources file.file_sources
then
@@ -124,22 +124,22 @@
do_if_connected server.server_sock (
fun sock ->
List.iter (
- fun file ->
+ fun file ->
if !verbose_location then
lprintf_nl () "TCP: Query Location of %s"
(file_best_name file);
let module M = DonkeyProtoServer in
- server_send sock ( M.QueryLocationReq file.file_md4 )
+ server_send sock ( M.QueryLocationReq file.file_md4 )
) (get_query_files server files_queries_per_minute);
)
end
- else
- server.server_queries_credit <- server.server_queries_credit - 1
+ else
+ server.server_queries_credit <- server.server_queries_credit - 1
)(connected_servers());;
-(*
+(*
*
* Function to handle UDP Queries for Sources to Server
*
@@ -151,27 +151,27 @@
let nservers = ref 0 in
while !nservers < udp_max_ask (* ask only (udp_max_ask) servers *)
&& (match !udp_servers_list with
- [] ->
+ [] ->
udp_servers_list := Hashtbl2.to_list servers_by_key;
false
- | s :: tail ->
+ | s :: tail ->
udp_servers_list := tail;
(match s.server_sock with
Connection _ -> ()
- | _ ->
- if connection_last_conn s.server_connection_control +
3600*1
+ | _ ->
+ if connection_last_conn s.server_connection_control +
3600*1
> last_time () &&
- s.server_next_udp <= last_time () then
+ s.server_next_udp <= last_time () then
begin
if server_accept_multiple_getsources s then
new_servers := s :: !new_servers
else
old_servers := s :: !old_servers;
-
+
incr nservers;
end
);
- true
+ true
)
do
()
@@ -185,20 +185,20 @@
List.iter (
fun s ->
let md4s = List.map (
- fun file ->
- file.file_md4;
+ fun file ->
+ file.file_md4;
) (get_query_files s udp_requests_new)
- in
+ in
udp_server_send s (Udp.QueryLocationUdpReq md4s);
s.server_next_udp <- last_time () + udp_requests_wait;
) !new_servers;
-
+
(* query "old servers", they need one packet per request *)
List.iter (
- fun s ->
+ fun s ->
let list = get_query_files s udp_requests_old in
- List.iter (
- fun file ->
+ List.iter (
+ fun file ->
udp_server_send s (Udp.QueryLocationUdpReq [file.file_md4]);
s.server_next_udp <- last_time () + udp_requests_wait
) list;
@@ -208,8 +208,6 @@
lprintf_nl () "udp_query_sources: %s" (Printexc2.to_string e)
-
-
let disconnect_server s reason =
match s.server_sock with
NoConnection -> ()
@@ -222,7 +220,7 @@
TcpBufferedSocket.close sock reason;
(*
lprintf "%s:%d CLOSED received by server\n"
- (Ip.to_string s.server_ip) s.server_port;
+ (Ip.to_string s.server_ip) s.server_port;
*)
connection_failed (s.server_connection_control);
s.server_sock <- NoConnection;
@@ -239,7 +237,7 @@
remove_connected_server s
-let server_handler s sock event =
+let server_handler s sock event =
match event with
BASIC_EVENT (CLOSED r) ->
disconnect_server s r
@@ -248,21 +246,18 @@
| _ -> ()
-
-
-
let last_message_sender = ref (-1)
-
+
let client_to_server s t sock =
let module M = DonkeyProtoServer in
-
+
s.server_last_message <- last_time ();
-
+
if !verbose_msg_servers then begin
lprintf_nl () "Message from server:";
DonkeyProtoServer.print t; lprint_newline ()
end;
-
+
match t with
M.SetIDReq t ->
s.server_has_zlib <- t.M.SetID.zlib;
@@ -272,20 +267,20 @@
s.server_cid <- Some t.M.SetID.ip;
s.server_realport <- t.M.SetID.port;
(* disconnect after (connected_server_timeout) seconds of silence *)
- set_rtimeout sock !!connected_server_timeout;
+ set_rtimeout sock !!connected_server_timeout;
set_server_state s Connected_initiating;
s.server_score <- s.server_score + 5;
connection_ok (s.server_connection_control);
-
+
server_send sock (
let module A = M.AckID in
M.AckIDReq A.t
);
-
+
if not (low_id t.M.SetID.ip) && !!use_server_ip then
last_high_id := t.M.SetID.ip;
end
-
+
| M.MessageReq msg ->
if !last_message_sender <> server_num s then begin
let server_header = Printf.sprintf "\n+-- From server %s [%s:%d]
------\n"
@@ -296,7 +291,7 @@
s.server_banner <- s.server_banner ^ Printf.sprintf "%s\n" msg;
let msg = Printf.sprintf "| %s\n" msg in
CommonEvent.add_event (Console_message_event msg)
-
+
| M.ServerListReq l ->
if !verbose then lprintf_nl () "donkeyServers: Received serverlist";
if !!update_server_list_server then
@@ -304,14 +299,14 @@
List.iter (fun s ->
safe_add_server s.Q.ip s.Q.port
) l
-
+
| M.ServerInfoReq t ->
s.server_score <- s.server_score + 1;
s.server_tags <- t.M.ServerInfo.tags;
List.iter (
fun tag ->
match tag with
- { tag_name = Field_UNKNOWN "name"; tag_value = String name } ->
+ { tag_name = Field_UNKNOWN "name"; tag_value = String name } ->
s.server_name <- name
| { tag_name = Field_UNKNOWN "description"; tag_value = String
desc } ->
s.server_description <- desc
@@ -320,7 +315,7 @@
printf_char 'S';
(* nice and ugly, but it doesn't require any new fields *)
- set_server_state s (Connected
+ set_server_state s (Connected
( match s.server_cid with
Some t -> (match Ip.to_ints t with
| _, _, _, 0 -> (-1)
@@ -341,15 +336,15 @@
begin
lprintf_nl () "%s:%d remove server min_users_on_server limit hit!"
(Ip.to_string s.server_ip) s.server_port;
-
+
disconnect_server s Closed_for_timeout;
server_remove (as_server s.server_server);
end;
server_must_update s
-
- | M.QueryIDReplyReq t ->
+
+ | M.QueryIDReplyReq t ->
(* This can either be a reply to a QueryID or a indirect request for
- connection from another client. In this case, we should immediatly
+ connection from another client. In this case, we should immediatly
connect. *)
if !verbose then lprintf_nl () "QueryIDReplyReq: received";
let module Q = M.QueryIDReply in
@@ -360,9 +355,9 @@
| Some file ->
if !verbose then
lprintf_nl () "QueryIDReplyReq: This was a QueryID reply !?";
- let s = DonkeySources.find_source_by_uid
+ let s = DonkeySources.find_source_by_uid
(Direct_address (t.Q.ip, t.Q.port)) in
- DonkeySources.set_request_result s file.file_sources
+ DonkeySources.set_request_result s file.file_sources
File_new_source
with _ ->
if !verbose then
@@ -376,7 +371,7 @@
if !verbose then
lprintf_nl () "QueryIDFailedReq:";
ignore (Fifo.take s.server_id_requests)
-
+
| M.QueryReplyReq t ->
let rec iter () =
let search = try
@@ -389,20 +384,20 @@
search.search_nresults < search.search_max_hits then
begin
server_send sock M.QueryMoreResultsReq;
- Fifo.put s.server_search_queries search
+ Fifo.put s.server_search_queries search
end;
DonkeyUdp.search_handler search t
with Already_done -> iter ()
in
iter ()
-
+
| M.Mldonkey_NotificationReq (num, t) ->
let s = search_find num in
List.iter (
fun f ->
DonkeyOneFile.search_found false s f.f_md4 f.f_tags
) t
-
+
| M.QueryUsersReplyReq t ->
let module M = DonkeyProtoServer in
let module Q = M.QueryUsersReply in
@@ -423,8 +418,8 @@
user_ip = cl.Q.ip;
user_port = cl.Q.port;
user_tags = cl.Q.tags;
- user_server = s;
- }
+ user_server = s;
+ }
and user_impl = {
dummy_user_impl with
impl_user_val = user;
@@ -434,25 +429,25 @@
user_add user_impl;
List.iter (fun tag ->
match tag with
- { tag_name = Field_UNKNOWN "name"; tag_value = String s } ->
+ { tag_name = Field_UNKNOWN "name"; tag_value = String s } ->
user.user_name <- s
| _ -> ()
) user.user_tags;
-
+
if add_to_friend then DonkeyUdp.add_user_friend s user;
-
+
s.server_users <- user :: s.server_users;
(* lprintf "SERVER NEW USER\n"; *)
server_new_user (as_server s.server_server) (as_user user.user_user);
) t;
server_must_update s
-
- | M.QueryLocationReplyReq t ->
+
+ | M.QueryLocationReplyReq t ->
DonkeyClient.query_locations_reply s t
-
- | _ ->
+
+ | _ ->
()
-
+
let connect_server s =
if !!enable_servers && can_open_connection connection_manager
&& (not !!connect_only_preferred_server || s.server_preferred)
@@ -466,19 +461,19 @@
try
(* lprintf "CONNECTING ONE SERVER\n"; *)
connection_try s.server_connection_control;
- printf_char 's';
+ printf_char 's';
let sock = TcpBufferedSocket.connect token "donkey to server"
- (Ip.to_inet_addr s.server_ip) s.server_port
+ (Ip.to_inet_addr s.server_ip) s.server_port
(server_handler s) (*
DonkeyProtoCom.server_msg_to_string*) in
s.server_cid <- None (*client_ip (Some sock) *);
set_server_state s Connecting;
set_read_controler sock download_control;
set_write_controler sock upload_control;
-
+
set_reader sock (DonkeyProtoCom.cut_messages
DonkeyProtoServer.parse
(client_to_server s));
set_rtimeout sock !!server_connection_timeout;
-
+
Fifo.clear s.server_id_requests;
s.server_waiting_queries <- [];
s.server_queries_credit <- 0;
@@ -495,23 +490,23 @@
}
);
add_connected_server s;
- with e ->
+ with e ->
(*
lprintf "%s:%d IMMEDIAT DISCONNECT \n"
- (Ip.to_string s.server_ip) s.server_port;
+ (Ip.to_string s.server_ip) s.server_port;
lprintf "DISCONNECTED IMMEDIATLY\n";
*)
disconnect_server s (Closed_for_exception e)
)
- in
+ in
s.server_sock <- ConnectionWaiting token
- | _ -> ()
-
+ | _ -> ()
+
let print_empty_list = ref true
(* [restart] prevents infinite looping when [servers_list] contains only
uninteresting servers. *)
-
+
let rec connect_one_server restart =
(* lprintf "connect_one_server\n"; *)
if can_open_connection connection_manager then
@@ -529,18 +524,18 @@
lprintf_nl () "You should either use the one provided with
mldonkey";
lprintf_nl () "or import one from the WEB";
end;
-
+
raise Not_found;
end;
- (* sort the servers list so that last connected servers are
+ (* sort the servers list so that last connected servers are
connected first (ie decreasing order of last connections) *)
servers_list := List.sort (fun s1 s2 ->
- compare
- (connection_last_conn s2.server_connection_control)
+ compare
+ (connection_last_conn s2.server_connection_control)
(connection_last_conn s1.server_connection_control)
) !servers_list;
-
+
connect_one_server false;
end
| s :: list ->
@@ -549,16 +544,15 @@
begin
(* connect to server *)
match s.server_sock with
- | NoConnection when s.server_score >= 0 ->
+ | NoConnection when s.server_score >= 0 ->
connect_server s
- | _ ->
+ | _ ->
connect_one_server restart
end
-
let force_check_server_connections user =
(* lprintf "force_check_server_connections\n"; *)
- if user || !nservers < max_allowed_connected_servers () then
+ if user || !nservers < max_allowed_connected_servers () then
let rec iter n =
try
if n > 0 && can_open_connection connection_manager then begin
@@ -568,18 +562,17 @@
with Not_found -> ()
in
let num = ( if user
- then !!max_connected_servers
- else max_allowed_connected_servers () ) - !nservers
+ then !!max_connected_servers
+ else max_allowed_connected_servers () ) - !nservers
in
iter num
-
-
+
let rec check_server_connections () =
force_check_server_connections false
-(*
- * clean serverlist
+(*
+ * clean serverlist
*)
let remove_old_servers () =
if !verbose then lprintf_nl () "REMOVE OLD SERVERS";
@@ -603,30 +596,30 @@
) servers_by_key;
let t2 = Unix.gettimeofday () in
if !verbose then lprintf_nl () "Delay to detect black-listed servers: %2.2f"
(t2 -. t1);
-
+
if List.length !to_keep > !!min_left_servers then begin
let array = Array.of_list !to_keep in
Array.sort (fun (ls1,_) (ls2,_) ->
if ls1 = ls2 then 0 else if ls1 > ls2 then -1 else 1
) array;
- if !verbose then
+ if !verbose then
for i = 0 to Array.length array - 1 do
let ls, s = array.(i) in
lprintf_nl () "server %d last_conn %d" (server_num s) ls;
-
+
done;
let min_last_conn = last_time () - !!max_server_age * Date.day_in_secs in
-
+
for i = Array.length array - 1 downto !!min_left_servers do
let ls, s = array.(i) in
- if ls < min_last_conn && s.server_sock = NoConnection
+ if ls < min_last_conn && s.server_sock = NoConnection
&& not s.server_preferred then begin
if !verbose then begin
- lprintf_nl () "Server too old: %s:%d"
+ lprintf_nl () "Server too old: %s:%d"
(Ip.to_string s.server_ip) s.server_port;
-
+
end;
to_remove := s :: !to_remove
end
@@ -644,30 +637,30 @@
if (List.length !to_remove) > 0 || !verbose then
lprintf_nl () "Removed %d old edonkey servers." (List.length !to_remove)
-
-(* Keep connecting to servers in the background. Don't stay connected to
+
+(* Keep connecting to servers in the background. Don't stay connected to
them , and don't send your shared files list *)
let walker_list = ref []
let delayed_list = ref []
let next_walker_start = ref 0
-
+
(* one call every 5 seconds, so 12/minute, 720/hour *)
-let walker_timer () =
-
+let walker_timer () =
+
if !!servers_walking_period > 0 &&
!nservers < max_allowed_connected_servers () + !!max_walker_servers then
-
+
match !walker_list with
[] ->
- if !delayed_list <> [] then
+ if !delayed_list <> [] then
begin
walker_list := !delayed_list;
delayed_list := []
- end
+ end
else
- if last_time () > !next_walker_start then
+ if last_time () > !next_walker_start then
begin
- next_walker_start :=
+ next_walker_start :=
last_time () + !!servers_walking_period * 3600;
Hashtbl.iter (
@@ -679,7 +672,7 @@
| s :: tail ->
walker_list := tail;
match s.server_sock with
- NoConnection ->
+ NoConnection ->
if connection_can_try s.server_connection_control then
begin
if !verbose then
@@ -695,21 +688,21 @@
(Ip.to_string s.server_ip);
end
| _ -> ()
-
-(* Keep connecting to servers in the background. Don't stay connected to
+
+(* Keep connecting to servers in the background. Don't stay connected to
them , and don't send your shared files list *)
let udp_walker_list = ref []
let next_udp_walker_start = ref 0
-
+
(* one call every second, so 3600/hour, must wait one hour before
-restarting
+restarting
Each client issues 1 packet/4hour, so 100000 clients means 25000/hour,
7 packets/second = 7 * 40 bytes = 280 B/s ...
*)
-
+
let udp_ping = String.create 6
-
-let udp_walker_timer () =
+
+let udp_walker_timer () =
match !udp_walker_list with
[] ->
if last_time () > !next_udp_walker_start then begin
@@ -731,16 +724,16 @@
if n = 0 then
Int64.to_int (s1.server_nusers -- s2.server_nusers)
else n
-
+
(* check connected servers *)
let update_master_servers _ =
let server_list = List.sort compare_servers (connected_servers ()) in
let masters = ref [] in
List.iter (
fun s ->
- if s.server_master then
+ if s.server_master then
match s.server_sock with
- | Connection _ ->
+ | Connection _ ->
if !verbose then begin
lprintf_nl () "MASTER: OLD MASTER %s" (Ip.to_string
s.server_ip);
end;
@@ -748,30 +741,30 @@
| _ -> s.server_master <- false
) server_list;
let nmasters = ref (List.length !masters) in
-
+
if !verbose then
lprintf_nl () "MASTER: nmaster %d" !nmasters;
-
+
let make_master s =
(* normal servers don't have our SHARE, so send list if it becomes a
master *)
do_if_connected s.server_sock (fun sock ->
if !verbose then
- lprintf_nl () " MASTER: %s" (Ip.to_string s.server_ip);
+ lprintf_nl () " MASTER: %s" (Ip.to_string s.server_ip);
s.server_master <- true;
incr nmasters;
-
+
(* Put the server in the list of servers, and update the list *)
masters := s :: !masters;
masters := List.rev (List.sort compare_servers !masters);
-
+
server_send_share s.server_has_zlib sock
- (DonkeyShare.all_shared ())
+ (DonkeyShare.all_shared ())
)
in
-
+
let max_allowed_connected_servers = max_allowed_connected_servers () in
let nconnected_servers = ref 0 in
-
+
let disconnect_old_server s =
(* disconnect a server we are connected to for too long if we have too many
connections *)
@@ -786,10 +779,10 @@
set_lifetime sock 5.);
end
in
-
+
List.iter
(fun s ->
- do_if_connected s.server_sock
+ do_if_connected s.server_sock
(fun _ ->
incr nconnected_servers;
let connection_time =
@@ -798,7 +791,7 @@
in
if !verbose then
lprintf_nl () "MASTER: Checking ip:%s ct:%d" (Ip.to_string
s.server_ip) connection_time;
- if not s.server_master
+ if not s.server_master
&& (s.server_preferred
|| connection_time > !!become_master_delay
|| !!immediate_master
@@ -847,15 +840,15 @@
open LittleEndian
-
-let _ =
+
+let _ =
udp_ping.[0] <- char_of_int 0xe3;
udp_ping.[1] <- char_of_int 0x96;
udp_ping.[2] <- char_of_int (Random.int 256);
udp_ping.[3] <- char_of_int (Random.int 256);
udp_ping.[4] <- char_of_int 0xAA;
udp_ping.[5] <- char_of_int 0x55;
-
+
CommonWeb.add_redirector_info "DKSV" (fun buf ->
buf_list (fun buf s ->
buf_ip buf s.server_ip;
@@ -863,7 +856,6 @@
) buf (connected_servers ())
);
- server_ops.op_server_sort <- ( fun s ->
+ server_ops.op_server_sort <- ( fun s ->
(3600 * s.server_score) + connection_last_conn s.server_connection_control
)
-
- [Mldonkey-commits] Changes to mldonkey/src/networks/donkey/donkeyServers.ml,
mldonkey-commits <=