patch #7308
[mldonkey.git] / src / networks / direct_connect / dcMain.ml
blob9449d5d79013760b8bf377ab6f51a879f41952ae
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
19 open Printf2
21 open Options
22 open BasicSocket
23 open CommonTypes
24 open CommonGlobals
25 open CommonNetwork
26 open CommonOptions
27 open CommonServer
29 open DcTypes
30 open DcGlobals
31 open DcOptions
32 open DcShared
33 open DcProtocol
34 open DcServers
35 open DcClients
37 let log_prefix = "[dcM]"
39 let lprintf_nl fmt =
40 lprintf_nl2 log_prefix fmt
42 let do_once_after_start () =
43 if not !once_create_filelist then begin
44 once_create_filelist := true;
45 DcShared.create_filelist ()
46 end;
47 if not !once_connect_to_servers then begin
48 once_connect_to_servers := true;
49 DcServers.autoconnect_to_servers ()
50 end
52 let hash_timer () =
53 if !dc_config_files_loaded then begin
54 DcShared.dc_check_hashed_files ();
55 end
57 let five_sec_timer () =
58 if !!autosearch_by_tth then begin
59 DcClients.create_autosearch ()
60 end
62 let one_hour_timer () =
63 DcShared.create_filelist ()
65 let half_hour_timer () =
66 DcServers.send_myinfo_connected_servers ()
68 let one_min_timer () =
69 DcClients.try_to_resume_files ()
71 let five_min_timer () =
72 DcGlobals.check_all_passive_users ();
73 DcServers.autoconnect_to_servers ()
75 let is_enabled = ref false
77 let disable enabler () =
78 if !enabler then begin
79 is_enabled := false;
80 enabler := false;
81 Hashtbl2.safe_iter (fun s -> disconnect_server s Closed_by_user) servers_by_ip;
82 List.iter (fun c ->
83 match c.client_sock with
84 | Connection sock -> TcpBufferedSocket.close sock Closed_by_user
85 | _ -> ()
86 ) !clients_list;
87 (match !dc_tcp_listen_sock with
88 | None -> ()
89 | Some sock ->
90 dc_tcp_listen_sock := None;
91 TcpServerSocket.close sock Closed_by_user);
92 (match !dc_udp_sock with
93 | None -> ()
94 | Some sock ->
95 dc_udp_sock := None;
96 UdpSocket.close sock Closed_by_user);
97 if !!enable_directconnect then enable_directconnect =:= false
98 end
100 let enable () =
101 if not !is_enabled then
102 let enabler = ref true in
103 is_enabled := true;
104 network.op_network_disable <- disable enabler;
106 if not !!enable_directconnect then enable_directconnect =:= true;
108 Unix2.safe_mkdir directconnect_directory;
109 Unix2.safe_mkdir filelist_directory;
110 Unix2.can_write_to_directory directconnect_directory;
111 Unix2.can_write_to_directory filelist_directory;
113 (match DcClients.create_udp_socket (); with (* UDP listening socket *)
114 | Some sock -> ()
115 | None -> failwith "Could not create udp socket" ); (* TCP listening socket *)
116 (match DcClients.create_tcp_socket () with
117 | Some sock -> ()
118 | None -> failwith "Could not create tcp socket" );
120 add_session_timer enabler 60. one_min_timer;
121 add_session_timer enabler 300. five_min_timer;
122 add_session_timer enabler 1800. half_hour_timer;
123 add_session_timer enabler 3600. one_hour_timer;
124 add_session_timer enabler 0.2 hash_timer;
125 add_session_timer enabler 5.0 five_sec_timer;
128 (* list of todos here... *)
131 add_timer 60.0 (fun timer -> do_once_after_start ());
133 (* add_session_timer enabler 300. (fun timer ->
134 DcServers.recover_files_clients ()
137 add_session_timer enabler 20. (fun timer ->
138 DcServers.recover_files_searches ()
146 let _ =
147 network.op_network_is_enabled <- (fun _ -> !!CommonOptions.enable_directconnect);
148 option_hook enable_directconnect (fun _ ->
149 if !CommonOptions.start_running_plugins then
150 if !!enable_directconnect then network_enable network
151 else network_disable network);
152 network.network_config_file <- [directconnect_ini];
153 network.op_network_enable <- enable;
154 network.op_network_info <- (fun n ->
156 network_netnum = network.network_num;
157 network_config_filename = (match network.network_config_file with
158 [] -> "" | opfile :: _ -> options_file_name opfile);
159 network_netname = network.network_name;
160 network_netflags = network.network_flags;
161 network_enabled = network.op_network_is_enabled ();
162 network_uploaded = Int64.zero;
163 network_downloaded = Int64.zero;
164 network_connected_servers = List.length !connected_servers;
166 network.op_network_search <- (fun q buf -> (* DC search function *)
167 let query = q.search_query in
168 let module S = DcProtocol.Search in
169 let words = ref [] in
170 let filetype = ref 1 in
171 let sizelimit = ref NoLimit in
172 let rec iter q =
173 (match q with
174 | QOr (q1,q2)
175 | QAnd (q1,q2) -> iter q1; iter q2
176 | QAndNot (q1,q2) -> iter q1
177 | QHasWord w -> words := w :: !words
178 | QHasField (field, w) ->
179 (match field with
180 | Field_Type ->
181 (* 1 for any file type
182 2 for audio files ("mp3", "mp2", "wav", "au", "rm", "mid", "sm")
183 3 for compressed files ("zip", "arj", "rar", "lzh", "gz", "z", "arc", "pak")
184 4 for documents ("doc", "txt", "wri", "pdf", "ps", "tex")
185 5 for executables ("pm", "exe", "bat", "com")
186 6 for pictures ("gif", "jpg", "jpeg", "bmp", "pcx", "png", "wmf", "psd")
187 7 for video ("mpg", "mpeg", "avi", "asf", "mov")
188 8 for folders
189 9 for TTH *)
190 (match w with
191 | "Audio" -> filetype := 2
192 | "Video" -> filetype := 7
193 | "Doc" -> filetype := 4
194 | "TTH" -> filetype := 9
195 | _ -> if !verbose_msg_clients then lprintf_nl "Unknown search type [%s]" w )
196 | _ -> () (*words := w :: !words*) )
197 | QHasMinVal (field, value) ->
198 (match field with
199 | Field_Size -> sizelimit := AtLeast value
200 | _ -> () )
201 | QHasMaxVal (field, value) ->
202 (match field with
203 | Field_Size -> sizelimit := AtMost value
204 | _ -> () )
205 | QNone ->
206 if !verbose_unexpected_messages then
207 lprintf_nl "DcInteractive.start_search: QNone in query";
208 () )
210 iter query;
212 let words = String2.unsplit !words ' ' in
213 dc_with_connected_servers (fun s -> DcClients.server_send_search s q 1 words);
215 network.op_network_connected <- (fun _ ->
216 !connected_servers <> []
218 network.op_network_parse_url <- (fun url user group -> DcInteractive.parse_url url user group);
219 network.op_network_download <- (fun r _ _ -> DcInteractive.start_result_download r);
220 network.op_network_ports <- (fun _ ->
222 !!dc_port, "client_port TCP+UDP";
224 network.op_network_recover_temp <- (fun _ -> ());
225 network.op_network_save_sources <- (fun _ -> ());
226 network.op_network_update_options <- (fun _ -> ());
227 network.op_network_add_server <- (fun addr port ->
228 as_server (new_server addr (Ip.ip_of_addr addr) port).server_server (*DNS *)
230 network.op_network_connected_servers <- (fun _ ->
231 List2.tail_map (fun s -> as_server s.server_server) !connected_servers
233 network.op_network_private_message <- (fun _ _ -> ());
234 network.op_network_connect_servers <- (fun _ -> ());
235 network.op_network_forget_search <- (fun _ -> ());
236 network.op_network_close_search <- (fun _ -> ());
237 network.op_network_extend_search <- (fun _ _ -> ());
238 network.op_network_clean_servers <- (fun _ -> ());
239 network.op_network_gui_message <- (fun _ _ -> ());
240 network.op_network_display_stats <- (fun _ -> ());
241 (* network.op_network_clean_exit <- (fun _ -> lprintf_nl "Received (op_network_clean_exit)"; ()); *)
242 network.op_network_reset <- (fun _ -> ());
243 network.op_network_porttest_result <- (fun _ -> PorttestNotAvailable);
244 network.op_network_check_upload_slots <- (fun _ -> ());
246 CommonInteractive.register_gui_options_panel "DC" gui_dc_options_panel;
249 let _ =
250 network.op_network_porttest_result <- (fun _ -> PorttestNotAvailable);
251 network.op_network_save_sources <- (fun _ -> ());
252 as_server (new_server ip port).server_server