/[mldonkey]/mldonkey/src/daemon/common/commonWeb.ml
ViewVC logotype

Diff of /mldonkey/src/daemon/common/commonWeb.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.13 by spiralvoice, Thu Jul 7 00:25:45 2005 UTC revision 1.14 by spiralvoice, Sun Jul 10 23:19:16 2005 UTC
# Line 169  let gen_redirector_packet () = Line 169  let gen_redirector_packet () =
169  (*                                                                       *)  (*                                                                       *)
170  (*                         connect_redirector                            *)  (*                         connect_redirector                            *)
171  (*                                                                       *)  (*                                                                       *)
172  (*************************************************************************)  (*************************************************************************)
173          
174  let propagation_socket = UdpSocket.create_sendonly ()    let propagation_socket = UdpSocket.create_sendonly ()
175  let counter = ref 1  let counter = ref 1
176      
177  let connect_redirector () =  let connect_redirector () =
178    if !!propagate_servers then begin    if !!propagate_servers then begin
179        decr counter;        decr counter;
180        if !counter = 0 then begin        if !counter = 0 then begin
181            counter := 6;            counter := 6;
182            let s = gen_redirector_packet () in            let s = gen_redirector_packet () in
183            try                        try
184              let name, port = !!mlnet_redirector in              let name, port = !!mlnet_redirector in
185              UdpSocket.write propagation_socket false s (Ip.from_name name) port;              UdpSocket.write propagation_socket false s (Ip.from_name name) port;
186                
187            with e ->            with e ->
188                lprintf_nl "Exception %s in udp_sendonly" (Printexc2.to_string e);                lprintf_nl "Exception %s in udp_sendonly" (Printexc2.to_string e);
189          end                end
190      end      end
191    
         
192  (*************************************************************************)  (*************************************************************************)
193  (*                                                                       *)  (*                                                                       *)
194  (*                         load_web_infos                                *)  (*                         load_web_infos                                *)
195  (*                                                                       *)  (*                                                                       *)
196  (*************************************************************************)  (*************************************************************************)
197    
198  let load_web_infos () =  let load_web_infos () =
199  (* Try to connect the redirector to get interesting information, since we  (* Try to connect the redirector to get interesting information, since we
# Line 219  support the charge, at least, currently. Line 218  support the charge, at least, currently.
218          set_reader sock (cut_messages (fun opcode s ->          set_reader sock (cut_messages (fun opcode s ->
219                if !verbose_redirector then lprintf "redirector info received\n";                if !verbose_redirector then lprintf "redirector info received\n";
220                let module L = LittleEndian in                let module L = LittleEndian in
221                  
222                let motd_html_s, pos = L.get_string16 s 2 in                let motd_html_s, pos = L.get_string16 s 2 in
223                let pos = if motd_html_s <> "XX" then                let pos = if motd_html_s <> "XX" then
224                    let servers_met_s, pos = L.get_string16 s pos in                    let servers_met_s, pos = L.get_string16 s pos in
# Line 227  support the charge, at least, currently. Line 226  support the charge, at least, currently.
226                    let peers_dat_s, pos = L.get_string16 s pos in                    let peers_dat_s, pos = L.get_string16 s pos in
227                    let motd_conf_s, pos = L.get_string16 s pos in                    let motd_conf_s, pos = L.get_string16 s pos in
228                    let peers_kad_s, pos = L.get_string16 s pos in                    let peers_kad_s, pos = L.get_string16 s pos in
229                      
230                    motd_html =:= motd_html_s;                    motd_html =:= motd_html_s;
231                      
232                    let servers_met_file = Filename.temp_file "servers" ".met" in                    let servers_met_file = Filename.temp_file "servers" ".met" in
233                    File.from_string servers_met_file servers_met_s;                    File.from_string servers_met_file servers_met_s;
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                    load_file "ocl" peers_ocl_file;                    load_file "ocl" peers_ocl_file;
# Line 241  support the charge, at least, currently. Line 240  support the charge, at least, currently.
240                    let peers_dat_file = Filename.temp_file "contacts" ".dat" in                    let peers_dat_file = Filename.temp_file "contacts" ".dat" in
241                    File.from_string peers_dat_file peers_dat_s;                    File.from_string peers_dat_file peers_dat_s;
242                    load_file "contact.dat" peers_dat_file;                    load_file "contact.dat" peers_dat_file;
243                      
244                    let motd_conf_file = Filename.temp_file "motd" ".conf" in                    let motd_conf_file = Filename.temp_file "motd" ".conf" in
245                    File.from_string motd_conf_file motd_conf_s;                    File.from_string motd_conf_file motd_conf_s;
246                    load_file "motd.conf" motd_conf_file;                                  load_file "motd.conf" motd_conf_file;
247                      
248                    let peers_kad_file = Filename.temp_file "peers" ".kad" in                    let peers_kad_file = Filename.temp_file "peers" ".kad" in
249                    File.from_string peers_kad_file peers_kad_s;                    File.from_string peers_kad_file peers_kad_s;
250                    load_file "kad" peers_kad_file;                    load_file "kad" peers_kad_file;
251                      
252                    pos                    pos
253                  else                  else
254                    
255                                    let get_item s pos =
                 let get_item s pos =  
256                    let kind, pos = get_string32 s pos in                    let kind, pos = get_string32 s pos in
257                    let file, pos = get_string32 s pos in                    let file, pos = get_string32 s pos in
258                    (kind, file), pos                    (kind, file), pos
# Line 269  support the charge, at least, currently. Line 267  support the charge, at least, currently.
267                in                in
268                let ip = L.get_ip s pos in                let ip = L.get_ip s pos in
269                last_high_id := ip;                last_high_id := ip;
270                  
271                lprintf "Redirector info loaded (IP set to %s)\n"                lprintf "Redirector info loaded (IP set to %s)\n"
272                  (Ip.to_string ip);                  (Ip.to_string ip);
273                TcpBufferedSocket.set_lifetime sock 30.;                TcpBufferedSocket.set_lifetime sock 30.;
274              
             
275            ));            ));
276          write_string sock packet          write_string sock packet
277            
278        with e ->        with e ->
279            lprintf "Exception %s while connecting redirector\n"            lprintf "Exception %s while connecting redirector\n"
280              (Printexc2.to_string e)              (Printexc2.to_string e)
281    );    );
282      
     
283    if !!network_update_url <> "" then begin    if !!network_update_url <> "" then begin
284      load_url "motd.html" (Filename.concat !!network_update_url "motd.html");      load_url "motd.html" (Filename.concat !!network_update_url "motd.html");
285      load_url "motd.conf" (Filename.concat !!network_update_url "motd.conf");      load_url "motd.conf" (Filename.concat !!network_update_url "motd.conf");
# Line 299  type rss_feed = { Line 295  type rss_feed = {
295            
296  let rss_feeds = Hashtbl.create 10  let rss_feeds = Hashtbl.create 10
297    
298      
299  let _ =  let _ =
300    add_web_kind "rss" (fun url filename ->    add_web_kind "rss" (fun url filename ->
301        let c = Rss.channel_of_file filename in        let c = Rss.channel_of_file filename in
# Line 320  let _ = Line 316  let _ =
316  let initialized = ref false  let initialized = ref false
317  let tcp_latencies_block = ref ""  let tcp_latencies_block = ref ""
318  let udp_latencies_block = ref ""  let udp_latencies_block = ref ""
319      
320  let _ =  let _ =
321  (* Latency block *)  (* Latency block *)
322    add_redirector_info "LTCY" (fun buf ->    add_redirector_info "LTCY" (fun buf ->
# Line 330  let _ = Line 326  let _ =
326            udp_latencies_block := UdpSocket.get_latencies verbose_redirector;            udp_latencies_block := UdpSocket.get_latencies verbose_redirector;
327            initialized := true;            initialized := true;
328          end;          end;
329          
330        buf_int buf !!loop_delay;        buf_int buf !!loop_delay;
331          
332  (* TCP block *)  (* TCP block *)
333        Buffer.add_string buf !tcp_latencies_block;        Buffer.add_string buf !tcp_latencies_block;
334          
335  (* UDP block *)  (* UDP block *)
336        Buffer.add_string buf !udp_latencies_block;        Buffer.add_string buf !udp_latencies_block;
337    );    );

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26