1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
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 CommonInteractive
30 open CommonComplexOptions
46 let network = new_network
"SLSK" "Soulseek"
54 let connection_manager = network.network_connection_manager
57 let (result_ops : result CommonResult.result_ops) =
58 CommonResult.new_result_ops network
61 let (server_ops
: server
CommonServer.server_ops
) =
62 CommonServer.new_server_ops
network
64 let (room_ops
: room
CommonRoom.room_ops
) =
65 CommonRoom.new_room_ops
network
67 let (user_ops
: user
CommonUser.user_ops
) =
68 CommonUser.new_user_ops
network
70 let (file_ops
: file
CommonFile.file_ops
) =
71 CommonFile.new_file_ops
network
73 let (client_ops
: client
CommonClient.client_ops
) =
74 CommonClient.new_client_ops
network
79 if !!login
= "" then !!CommonOptions.global_login
else !!login
81 let set_server_state s state
=
82 set_server_state (as_server s
.server_server
) state
83 let set_client_state s state
=
84 set_client_state (as_client s
.client_client
) state
85 let set_room_state s state
=
86 set_room_state (as_room s
.room_room
) state
87 let server_num s
= server_num (as_server s
.server_server
)
88 let file_num s
= file_num (as_file s
.file_file
)
89 let server_state s
= server_state (as_server s
.server_server
)
90 let file_state s
= file_state (as_file s
.file_file
)
91 let server_must_update s
= server_must_update (as_server s
.server_server
)
92 let file_must_update s
= file_must_update (as_file s
.file_file
)
93 let user_num u
= user_num (as_user u
.user_user
)
95 let file_size file
= file
.file_file
.impl_file_size
96 let file_downloaded file
= file_downloaded (as_file file
.file_file
)
97 let file_age file
= file
.file_file
.impl_file_age
98 let file_fd file
= file_fd (as_file file
.file_file
)
101 client_type (as_client c
.client_client
)
103 let nknown_servers = ref 0
104 let connected_servers = ref ([] : server list
)
106 let servers_by_addr = Hashtbl.create
13
108 let new_server addr port
=
110 Hashtbl.find
servers_by_addr (addr
, port
)
114 server_server
= server_impl
;
115 server_name
= "<unknown>";
117 server_nusers
= Int64.zero
;
119 server_connection_control
= new_connection_control
();
120 server_sock
= NoConnection
;
123 server_last_nick
= "";
124 server_search
= None
;
125 server_search_timeout
= 0.0;
129 dummy_server_impl
with
131 impl_server_ops
= server_ops
;
133 server_add server_impl
;
134 Hashtbl.add
servers_by_addr (addr
, port
) h;
137 let searches = ref ([] : (int * CommonTypes.search
) list
)
139 let clients_by_name = Hashtbl.create
113
141 let users_by_name = Hashtbl.create
113
143 let results_by_file = Hashtbl.create
111
147 Hashtbl.find
users_by_name name
151 user_user
= user_impl
;
155 impl_user_ops
= user_ops
;
156 impl_user_val
= user;
159 Hashtbl.add
users_by_name name
user;
163 let new_client name
=
165 Hashtbl.find
clients_by_name name
167 let u = new_user name
in
169 client_client
= impl
;
170 client_peer_sock
= NoConnection
;
171 client_downloads
= [];
172 client_result_socks
= [];
176 client_all_files
= None
;
177 client_receiving
= Int64.zero
;
178 client_connection_control
= new_connection_control
();
180 client_requests
= [];
182 dummy_client_impl
with
184 impl_client_ops
= client_ops
;
185 impl_client_upload
= None
;
188 Hashtbl.add
clients_by_name name
c;
192 let result_sources = Hashtbl.create
1000
194 let add_result_source r
(s
: user) (index
: string) =
197 Hashtbl.find
result_sources r
.stored_result_num
200 Hashtbl.add
result_sources r
.stored_result_num
ss;
203 let key = (s
, index
) in
204 if not
(List.mem
key !ss) then begin
208 let new_result filename filesize
=
209 let basename = Filename2.basename filename
in
210 let key = (basename, filesize
) in
212 Hashtbl.find
results_by_file key
216 result_names
= [basename];
217 result_size
= filesize
;
219 let rs = update_result_num
r in
220 Hashtbl.add
results_by_file key rs;
223 let rooms_by_name = Hashtbl.create
13
227 Hashtbl.find
rooms_by_name name
230 room_room
= room_impl
;
238 impl_room_val
= room;
239 impl_room_ops
= room_ops
;
240 impl_room_state
= RoomPaused
;
244 Hashtbl.add
rooms_by_name name
room;
248 let files_by_key = Hashtbl.create
47
250 let current_files = ref []
252 let min_range_size = megabyte
254 let new_file file_id name
file_size =
255 let file_chunk_size =
257 1L ++ file_size // (max
5L (1L ++ file_size // (megabytes
5)))
260 let file_temp = Filename.concat
!!temp_directory
261 (Printf.sprintf
"SK-%s" (Md4.to_string file_id
)) in
264 Unix32.getsize
file_temp
268 let t = Unix32.create_rw
file_temp in
270 file_file
= file_impl
;
276 impl_file_fd
= Some
t;
277 impl_file_size
= file_size;
278 impl_file_val
= file;
279 impl_file_ops
= file_ops
;
280 impl_file_age
= last_time
();
281 impl_file_best_name
= name
;
285 if current_size = file_size then
289 let kernel = CommonSwarming.create_swarmer
file_temp file_size in
290 let swarmer = CommonSwarming.create
kernel (as_file
file.file_file
) file_chunk_size in
291 file.file_swarmer
<- Some
swarmer;
292 CommonSwarming.set_verifier
swarmer ForceVerification
;
293 CommonSwarming.set_verified
swarmer (fun _ _
-> file_must_update file);
294 current_files := file :: !current_files;
298 file_add file_impl
state;
301 let new_file file_id name
file_size =
302 let key = String.lowercase name
in
304 Hashtbl.find
files_by_key key
306 let file = new_file file_id
key file_size in
307 Hashtbl.add
files_by_key key file;
310 let find_file file_name
file_size =
311 Hashtbl.find
files_by_key (String.lowercase file_name
)
315 let add_file_client file user filename
=
316 let c = new_client user.user_nick
in
317 if not
(List.memq
c file.file_clients
) then begin
318 file.file_clients
<- c :: file.file_clients
;
319 c.client_files
<- (file, filename
) :: c.client_files
;
320 file_add_source
(as_file
file.file_file
) (as_client
c.client_client
)