19 |
|
|
20 |
open Options |
open Options |
21 |
open Printf2 |
open Printf2 |
22 |
|
|
23 |
open AnyEndian |
open AnyEndian |
24 |
open LittleEndian |
open LittleEndian |
25 |
|
|
26 |
open BasicSocket |
open BasicSocket |
27 |
open TcpBufferedSocket |
open TcpBufferedSocket |
28 |
|
|
29 |
open CommonGlobals |
open CommonGlobals |
30 |
open CommonOptions |
open CommonOptions |
31 |
open CommonTypes |
open CommonTypes |
32 |
|
|
33 |
let days = ref 0 |
let days = ref 0 |
34 |
let hours = ref 0 |
let hours = ref 0 |
35 |
|
|
36 |
(*************************************************************************) |
(*************************************************************************) |
37 |
(* *) |
(* *) |
38 |
(* load_url *) |
(* load_url *) |
39 |
(* *) |
(* *) |
40 |
(*************************************************************************) |
(*************************************************************************) |
41 |
|
|
42 |
let file_kinds = ref [] |
let file_kinds = ref [] |
43 |
|
|
44 |
let add_web_kind kind f = |
let add_web_kind kind f = |
45 |
file_kinds := (kind,f) :: !file_kinds |
file_kinds := (kind,f) :: !file_kinds |
46 |
|
|
47 |
let mldonkey_wget url f = |
let mldonkey_wget url f = |
48 |
let module H = Http_client in |
let module H = Http_client in |
49 |
let r = { |
let r = { |
50 |
H.basic_request with |
H.basic_request with |
51 |
H.req_url = Url.of_string url; |
H.req_url = Url.of_string url; |
52 |
H.req_proxy = !CommonOptions.http_proxy; |
H.req_proxy = !CommonOptions.http_proxy; |
53 |
H.req_user_agent = |
H.req_user_agent = |
54 |
Printf.sprintf "MLdonkey/%s" Autoconf.current_version; |
Printf.sprintf "MLdonkey/%s" Autoconf.current_version; |
55 |
} in |
} in |
56 |
|
|
57 |
H.wget r f |
H.wget r f |
58 |
|
|
|
|
|
59 |
let load_url kind url = |
let load_url kind url = |
60 |
lprintf_nl "CommonWeb: QUERY URL %s" url; |
lprintf_nl "CommonWeb: QUERY URL %s" url; |
61 |
let f = |
let f = |
62 |
try |
try |
63 |
(List.assoc kind !file_kinds) url |
(List.assoc kind !file_kinds) url |
64 |
with e -> failwith (Printf.sprintf "Unknown kind [%s]" kind) |
with e -> failwith (Printf.sprintf "Unknown kind [%s]" kind) |
65 |
in |
in |
66 |
try |
try |
67 |
mldonkey_wget url f |
mldonkey_wget url f |
68 |
with e -> failwith (Printf.sprintf "Exception %s while loading %s" |
with e -> failwith (Printf.sprintf "Exception %s while loading %s" |
69 |
(Printexc2.to_string e) url) |
(Printexc2.to_string e) url) |
70 |
|
|
71 |
let load_file kind file = |
let load_file kind file = |
72 |
try |
try |
73 |
(List.assoc kind !file_kinds) file file |
(List.assoc kind !file_kinds) file file |
74 |
with e -> |
with e -> |
75 |
lprintf_nl "Exception %s while loading kind %s" |
lprintf_nl "Exception %s while loading kind %s" |
76 |
(Printexc2.to_string e) |
(Printexc2.to_string e) |
77 |
kind |
kind |
78 |
|
|
80 |
(* *) |
(* *) |
81 |
(* cut_messages (internal) *) |
(* cut_messages (internal) *) |
82 |
(* *) |
(* *) |
83 |
(*************************************************************************) |
(*************************************************************************) |
84 |
|
|
85 |
let cut_messages f sock nread = |
let cut_messages f sock nread = |
86 |
let b = buf sock in |
let b = buf sock in |
87 |
try |
try |
97 |
else raise Not_found |
else raise Not_found |
98 |
done |
done |
99 |
with Not_found -> () |
with Not_found -> () |
100 |
|
|
101 |
|
|
102 |
(*************************************************************************) |
(*************************************************************************) |
103 |
(* *) |
(* *) |
104 |
(* add_redirector_info *) |
(* add_redirector_info *) |
105 |
(* *) |
(* *) |
106 |
(*************************************************************************) |
(*************************************************************************) |
107 |
|
|
108 |
(* Learn how many people are using mldonkey at a current time, and which |
(* Learn how many people are using mldonkey at a current time, and which |
109 |
servers they are connected to --> build a database of servers |
servers they are connected to --> build a database of servers |
110 |
|
|
111 |
Now, get some more information: |
Now, get some more information: |
113 |
- How much data is shared ? |
- How much data is shared ? |
114 |
|
|
115 |
Note that the exact content/type/name of the files is not sent, nor |
Note that the exact content/type/name of the files is not sent, nor |
116 |
any private information. Just for statistics. Can be disabled in the |
any private information. Just for statistics. Can be disabled in the |
117 |
downloads.ini config file anyway. |
downloads.ini config file anyway. |
118 |
*) |
*) |
119 |
let buf = TcpBufferedSocket.internal_buf |
let buf = TcpBufferedSocket.internal_buf |
125 |
let buf_string buf s = |
let buf_string buf s = |
126 |
buf_int16 buf (String.length s); |
buf_int16 buf (String.length s); |
127 |
Buffer.add_string buf s |
Buffer.add_string buf s |
128 |
|
|
129 |
let redirector_infos = ref [] |
let redirector_infos = ref [] |
130 |
let add_redirector_info (n : string) (f : Buffer.t -> unit) = |
let add_redirector_info (n : string) (f : Buffer.t -> unit) = |
131 |
redirector_infos := (n,f) :: !redirector_infos |
redirector_infos := (n,f) :: !redirector_infos |
132 |
|
|
133 |
let gen_redirector_packet () = |
let gen_redirector_packet () = |
134 |
|
|
135 |
let infos = |
let infos = |
136 |
List.map (fun (n,f) -> |
List.map (fun (n,f) -> |
137 |
n, |
n, |
138 |
( Buffer.clear buf; |
( Buffer.clear buf; |
139 |
f buf; |
f buf; |
140 |
Buffer.contents buf) |
Buffer.contents buf) |
141 |
) !redirector_infos in |
) !redirector_infos in |
142 |
|
|
143 |
Buffer.clear buf; |
Buffer.clear buf; |
144 |
buf_int8 buf 212; (* udp_magic *) |
buf_int8 buf 212; (* udp_magic *) |
145 |
buf_int8 buf 2; (* type of data sent *) |
buf_int8 buf 2; (* type of data sent *) |
155 |
buf_int16 buf !!max_hard_download_rate; |
buf_int16 buf !!max_hard_download_rate; |
156 |
buf_int buf (compute_lost_byte upload_control); |
buf_int buf (compute_lost_byte upload_control); |
157 |
buf_int buf (compute_lost_byte download_control); |
buf_int buf (compute_lost_byte download_control); |
158 |
|
|
159 |
buf_list (fun buf (n,s) -> |
buf_list (fun buf (n,s) -> |
160 |
buf_string buf n; |
buf_string buf n; |
161 |
buf_string buf s |
buf_string buf s |
162 |
) buf infos; |
) buf infos; |
163 |
|
|
164 |
let s = Buffer.contents buf in |
let s = Buffer.contents buf in |
165 |
s |
s |
166 |
|
|
167 |
(*************************************************************************) |
(*************************************************************************) |
202 |
let packet = gen_redirector_packet () in |
let packet = gen_redirector_packet () in |
203 |
Ip.async_ip name (fun ip -> |
Ip.async_ip name (fun ip -> |
204 |
try |
try |
205 |
if !verbose_redirector then lprintf "connecting to redirector\n"; |
if !verbose_redirector then lprintf_nl "connecting to redirector"; |
206 |
let token = create_token unlimited_connection_manager in |
let token = create_token unlimited_connection_manager in |
207 |
let sock = TcpBufferedSocket.connect token "connect redirector" |
let sock = TcpBufferedSocket.connect token "connect redirector" |
208 |
(Ip.to_inet_addr ip) port |
(Ip.to_inet_addr ip) port |
209 |
(fun sock event -> |
(fun sock event -> |
210 |
match event with |
match event with |
211 |
| BASIC_EVENT (LTIMEOUT | RTIMEOUT) -> |
| BASIC_EVENT (LTIMEOUT | RTIMEOUT) -> |
212 |
TcpBufferedSocket.close sock Closed_for_timeout |
TcpBufferedSocket.close sock Closed_for_timeout |
213 |
| _ -> ()) |
| _ -> ()) |
214 |
in |
in |
215 |
TcpBufferedSocket.set_rtimeout sock 30.; |
TcpBufferedSocket.set_rtimeout sock 30.; |
216 |
let to_read = ref [] in |
let to_read = ref [] in |
217 |
set_reader sock (cut_messages (fun opcode s -> |
set_reader sock (cut_messages (fun opcode s -> |
218 |
if !verbose_redirector then lprintf "redirector info received\n"; |
if !verbose_redirector then lprintf_nl "redirector info received"; |
219 |
let module L = LittleEndian in |
let module L = LittleEndian in |
220 |
|
|
221 |
let motd_html_s, pos = L.get_string16 s 2 in |
let motd_html_s, pos = L.get_string16 s 2 in |
222 |
let pos = if motd_html_s <> "XX" then |
let pos = if motd_html_s <> "XX" then |
223 |
let servers_met_s, pos = L.get_string16 s pos in |
let servers_met_s, pos = L.get_string16 s pos in |
224 |
let peers_ocl_s, pos = L.get_string16 s pos in |
let peers_ocl_s, pos = L.get_string16 s pos in |
225 |
let peers_dat_s, pos = L.get_string16 s pos in |
let peers_dat_s, pos = L.get_string16 s pos in |
230 |
|
|
231 |
let servers_met_file = Filename.temp_file "servers" ".met" in |
let servers_met_file = Filename.temp_file "servers" ".met" in |
232 |
File.from_string servers_met_file servers_met_s; |
File.from_string servers_met_file servers_met_s; |
233 |
|
if !!enable_donkey then |
234 |
load_file "servers.met" servers_met_file; |
load_file "servers.met" servers_met_file; |
235 |
|
|
236 |
let peers_ocl_file = Filename.temp_file "peers" ".ocl" in |
let peers_ocl_file = Filename.temp_file "peers" ".ocl" in |
237 |
File.from_string peers_ocl_file peers_ocl_s; |
File.from_string peers_ocl_file peers_ocl_s; |
238 |
|
if !!enable_overnet then |
239 |
load_file "ocl" peers_ocl_file; |
load_file "ocl" peers_ocl_file; |
240 |
|
|
241 |
let peers_dat_file = Filename.temp_file "contacts" ".dat" in |
let peers_dat_file = Filename.temp_file "contacts" ".dat" in |
242 |
File.from_string peers_dat_file peers_dat_s; |
File.from_string peers_dat_file peers_dat_s; |
243 |
|
if !!enable_overnet then |
244 |
load_file "contact.dat" peers_dat_file; |
load_file "contact.dat" peers_dat_file; |
245 |
|
|
246 |
let motd_conf_file = Filename.temp_file "motd" ".conf" in |
let motd_conf_file = Filename.temp_file "motd" ".conf" in |
249 |
|
|
250 |
let peers_kad_file = Filename.temp_file "peers" ".kad" in |
let peers_kad_file = Filename.temp_file "peers" ".kad" in |
251 |
File.from_string peers_kad_file peers_kad_s; |
File.from_string peers_kad_file peers_kad_s; |
252 |
|
if !!enable_kademlia then |
253 |
load_file "kad" peers_kad_file; |
load_file "kad" peers_kad_file; |
254 |
|
|
255 |
pos |
pos |
278 |
)); |
)); |
279 |
write_string sock packet |
write_string sock packet |
280 |
|
|
281 |
with e -> |
with e -> |
282 |
lprintf "Exception %s while connecting redirector\n" |
lprintf "Exception %s while connecting redirector\n" |
283 |
(Printexc2.to_string e) |
(Printexc2.to_string e) |
284 |
); |
); |
288 |
load_url "motd.conf" (Filename.concat !!network_update_url "motd.conf"); |
load_url "motd.conf" (Filename.concat !!network_update_url "motd.conf"); |
289 |
end; |
end; |
290 |
List.iter (fun (kind, period, url) -> |
List.iter (fun (kind, period, url) -> |
291 |
if !days mod period = 0 then load_url kind url |
if !days mod period = 0 then |
292 |
) !!CommonOptions.web_infos |
match kind with |
293 |
|
| "contact.dat" -> if !!enable_overnet then load_url kind url |
294 |
|
| "guarding.p2p" -> load_url kind url |
295 |
|
| "kad" -> if !!enable_kademlia then load_url kind url |
296 |
|
| "ocl" -> if !!enable_overnet then load_url kind url |
297 |
|
| "server.met" -> if !!enable_donkey then load_url kind url |
298 |
|
| _ -> lprintf_nl "unparsed kind to refresh: %s" kind; load_url kind url |
299 |
|
) !!CommonOptions.web_infos |
300 |
|
|
301 |
type rss_feed = { |
type rss_feed = { |
302 |
mutable rss_date : int; |
mutable rss_date : int; |
303 |
mutable rss_value : Rss.channel; |
mutable rss_value : Rss.channel; |
304 |
} |
} |
305 |
|
|
306 |
let rss_feeds = Hashtbl.create 10 |
let rss_feeds = Hashtbl.create 10 |
307 |
|
|
308 |
|
|
309 |
let _ = |
let _ = |
310 |
add_web_kind "rss" (fun url filename -> |
add_web_kind "rss" (fun url filename -> |
311 |
let c = Rss.channel_of_file filename in |
let c = Rss.channel_of_file filename in |
312 |
let feed = |
let feed = |
313 |
try Hashtbl.find rss_feeds url with |
try Hashtbl.find rss_feeds url with |
314 |
Not_found -> |
Not_found -> |
315 |
let feed = { |
let feed = { |
330 |
let _ = |
let _ = |
331 |
(* Latency block *) |
(* Latency block *) |
332 |
add_redirector_info "LTCY" (fun buf -> |
add_redirector_info "LTCY" (fun buf -> |
333 |
|
|
334 |
if not !initialized then begin |
if not !initialized then begin |
335 |
tcp_latencies_block := TcpBufferedSocket.get_latencies verbose_redirector; |
tcp_latencies_block := TcpBufferedSocket.get_latencies verbose_redirector; |
336 |
udp_latencies_block := UdpSocket.get_latencies verbose_redirector; |
udp_latencies_block := UdpSocket.get_latencies verbose_redirector; |
351 |
tcp_latencies_block := TcpBufferedSocket.get_latencies verbose_redirector; |
tcp_latencies_block := TcpBufferedSocket.get_latencies verbose_redirector; |
352 |
udp_latencies_block := UdpSocket.get_latencies verbose_redirector; |
udp_latencies_block := UdpSocket.get_latencies verbose_redirector; |
353 |
) |
) |
|
|
|