25 |
open BasicSocket |
open BasicSocket |
26 |
open Options |
open Options |
27 |
open TcpBufferedSocket |
open TcpBufferedSocket |
28 |
|
|
29 |
open CommonOptions |
open CommonOptions |
30 |
open CommonClient |
open CommonClient |
31 |
open CommonUser |
open CommonUser |
35 |
open CommonResult |
open CommonResult |
36 |
open CommonFile |
open CommonFile |
37 |
open CommonGlobals |
open CommonGlobals |
38 |
open CommonDownloads |
open CommonDownloads |
39 |
open CommonNetwork |
open CommonNetwork |
40 |
|
|
41 |
open FileTPTypes |
open FileTPTypes |
42 |
open FileTPOptions |
open FileTPOptions |
43 |
|
|
44 |
|
let network = new_network "FTP" "FileTP" |
|
|
|
|
let network = new_network "FTP" "FileTP" |
|
45 |
[ ] |
[ ] |
46 |
|
|
47 |
let connection_manager = network.network_connection_manager |
let connection_manager = network.network_connection_manager |
48 |
|
|
49 |
(* |
(* |
50 |
let (result_ops : result CommonResult.result_ops) = |
let (result_ops : result CommonResult.result_ops) = |
51 |
CommonResult.new_result_ops network |
CommonResult.new_result_ops network |
52 |
*) |
*) |
53 |
|
|
54 |
let (server_ops : server CommonServer.server_ops) = |
let (server_ops : server CommonServer.server_ops) = |
55 |
CommonServer.new_server_ops network |
CommonServer.new_server_ops network |
56 |
|
|
57 |
let (room_ops : server CommonRoom.room_ops) = |
let (room_ops : server CommonRoom.room_ops) = |
58 |
CommonRoom.new_room_ops network |
CommonRoom.new_room_ops network |
59 |
|
|
60 |
let (user_ops : user CommonUser.user_ops) = |
let (user_ops : user CommonUser.user_ops) = |
61 |
CommonUser.new_user_ops network |
CommonUser.new_user_ops network |
62 |
|
|
63 |
let (file_ops : file CommonFile.file_ops) = |
let (file_ops : file CommonFile.file_ops) = |
64 |
CommonFile.new_file_ops network |
CommonFile.new_file_ops network |
65 |
|
|
66 |
let (client_ops : client CommonClient.client_ops) = |
let (client_ops : client CommonClient.client_ops) = |
67 |
CommonClient.new_client_ops network |
CommonClient.new_client_ops network |
68 |
|
|
69 |
let as_client c = as_client c.client_client |
let as_client c = as_client c.client_client |
70 |
let as_file file = as_file file.file_file |
let as_file file = as_file file.file_file |
71 |
let file_size file = file.file_file.impl_file_size |
let file_size file = file.file_file.impl_file_size |
72 |
let file_downloaded file = file_downloaded (as_file file) |
let file_downloaded file = file_downloaded (as_file file) |
73 |
let file_age file = file.file_file.impl_file_age |
let file_age file = file.file_file.impl_file_age |
74 |
let file_fd file = file.file_file.impl_file_fd |
let file_fd file = file.file_file.impl_file_fd |
75 |
let file_disk_name file = file_disk_name (as_file file) |
let file_disk_name file = file_disk_name (as_file file) |
76 |
let file_best_name file = file_best_name (as_file file) |
let file_best_name file = file_best_name (as_file file) |
77 |
|
|
78 |
let current_files = ref ([] : FileTPTypes.file list) |
let current_files = ref ([] : FileTPTypes.file list) |
79 |
|
|
80 |
let listen_sock = ref (None : TcpServerSocket.t option) |
let listen_sock = ref (None : TcpServerSocket.t option) |
|
|
|
81 |
|
|
82 |
(* |
(* |
83 |
let redirector_connected = ref false |
let redirector_connected = ref false |
88 |
let files_by_uid = Hashtbl.create 13 |
let files_by_uid = Hashtbl.create 13 |
89 |
|
|
90 |
let clients_by_uid = Hashtbl.create 127 |
let clients_by_uid = Hashtbl.create 127 |
91 |
let protos_by_name = Hashtbl.create 13 |
let protos_by_name = Hashtbl.create 13 |
92 |
|
|
93 |
let find_proto (name : string) = |
let find_proto (name : string) = |
94 |
(Hashtbl.find protos_by_name name : tp_proto) |
(Hashtbl.find protos_by_name name : tp_proto) |
|
|
|
|
(*************************************************************** |
|
95 |
|
|
96 |
|
(*************************************************************** |
97 |
|
|
98 |
HOST SCHEDULER |
HOST SCHEDULER |
99 |
|
|
|
|
|
100 |
****************************************************************) |
****************************************************************) |
101 |
|
|
|
|
|
|
|
|
102 |
let min_range_size = megabyte |
let min_range_size = megabyte |
103 |
|
|
104 |
let set_file_size file size = |
let set_file_size file size = |
105 |
lprintf "set_file_size\n"; |
lprintf "set_file_size\n"; |
106 |
if file_size file = zero && size <> zero then begin |
if file_size file = zero && size <> zero then begin |
107 |
lprintf "Setting SWARMER\n"; |
lprintf "Setting SWARMER\n"; |
113 |
file.file_file.impl_file_size <- size; |
file.file_file.impl_file_size <- size; |
114 |
let file_temp = Unix32.filename (file_fd file) in |
let file_temp = Unix32.filename (file_fd file) in |
115 |
let kernel = Int64Swarmer.create_swarmer file_temp size min_range_size in |
let kernel = Int64Swarmer.create_swarmer file_temp size min_range_size in |
116 |
let swarmer = Int64Swarmer.create kernel (as_file file) |
let swarmer = Int64Swarmer.create kernel (as_file file) |
117 |
file_chunk_size in |
file_chunk_size in |
118 |
file.file_swarmer <- Some swarmer; |
file.file_swarmer <- Some swarmer; |
119 |
lprintf "Swarmer set\n"; |
lprintf "Swarmer set\n"; |
120 |
Int64Swarmer.set_verified swarmer (fun _ _ -> |
Int64Swarmer.set_verified swarmer (fun _ _ -> |
121 |
file_must_update (as_file file); |
file_must_update (as_file file); |
122 |
); |
); |
123 |
(* |
(* |
124 |
Int64Swarmer.set_writer swarmer (fun offset s pos len -> |
Int64Swarmer.set_writer swarmer (fun offset s pos len -> |
125 |
|
|
126 |
(* |
(* |
127 |
lprintf "DOWNLOADED: %d/%d/%d\n" pos len (String.length s); |
lprintf "DOWNLOADED: %d/%d/%d\n" pos len (String.length s); |
128 |
AnyEndian.dump_sub s pos len; |
AnyEndian.dump_sub s pos len; |
129 |
*) |
*) |
130 |
|
|
131 |
if !!CommonOptions.buffer_writes then |
if !!CommonOptions.buffer_writes then |
132 |
Unix32.buffered_write_copy (file_fd file) offset s pos len |
Unix32.buffered_write_copy (file_fd file) offset s pos len |
133 |
else |
else |
134 |
Unix32.write (file_fd file) offset s pos len |
Unix32.write (file_fd file) offset s pos len |
135 |
) *) |
) *) |
136 |
end |
end |
137 |
|
|
138 |
let new_file file_id file_name file_size = |
let new_file file_id file_name file_size = |
139 |
let file_temp = Filename.concat !!temp_directory |
let file_temp = Filename.concat !!temp_directory |
140 |
(Printf.sprintf "FileTP-%s" (Md4.to_string file_id)) in |
(Printf.sprintf "FileTP-%s" (Md4.to_string file_id)) in |
141 |
let t = Unix32.create_rw file_temp in |
let t = Unix32.create_rw file_temp in |
142 |
let rec file = { |
let rec file = { |
155 |
impl_file_downloaded = zero; |
impl_file_downloaded = zero; |
156 |
impl_file_val = file; |
impl_file_val = file; |
157 |
impl_file_ops = file_ops; |
impl_file_ops = file_ops; |
158 |
impl_file_age = last_time (); |
impl_file_age = last_time (); |
159 |
impl_file_best_name = Filename.basename file_name; |
impl_file_best_name = Filename.basename file_name; |
160 |
} |
} |
161 |
in |
in |
166 |
file |
file |
167 |
|
|
168 |
exception FileFound of file |
exception FileFound of file |
169 |
|
|
170 |
let new_file file_id file_name file_size = |
let new_file file_id file_name file_size = |
171 |
try |
try |
172 |
Hashtbl.find files_by_uid file_id |
Hashtbl.find files_by_uid file_id |
173 |
with _ -> |
with _ -> |
174 |
let file = new_file file_id file_name file_size in |
let file = new_file file_id file_name file_size in |
175 |
Hashtbl.add files_by_uid file_id file; |
Hashtbl.add files_by_uid file_id file; |
176 |
file |
file |
177 |
|
|
178 |
let new_client proto hostname port = |
let new_client proto hostname port = |
179 |
let key = (hostname,port) in |
let key = (hostname,port) in |
180 |
try |
try |
183 |
let rec c = { |
let rec c = { |
184 |
client_client = impl; |
client_client = impl; |
185 |
client_sock = NoConnection; |
client_sock = NoConnection; |
186 |
(* client_name = name; |
(* client_name = name; |
187 |
client_kind = None; *) |
client_kind = None; *) |
188 |
client_requests = []; |
client_requests = []; |
189 |
(* |
(* |
190 |
client_pos = Int32.zero; |
client_pos = Int32.zero; |
191 |
client_error = false; |
client_error = false; |
192 |
*) |
*) |
193 |
|
|
194 |
client_connection_control = new_connection_control (()); |
client_connection_control = new_connection_control (()); |
195 |
client_downloads = []; |
client_downloads = []; |
196 |
client_hostname = hostname; |
client_hostname = hostname; |
208 |
new_client impl; |
new_client impl; |
209 |
Hashtbl.add clients_by_uid key c; |
Hashtbl.add clients_by_uid key c; |
210 |
c |
c |
211 |
|
|
212 |
let add_download file c url = |
let add_download file c url = |
213 |
(* let r = new_result file.file_name (file_size file) in *) |
(* let r = new_result file.file_name (file_size file) in *) |
214 |
(* add_source r c.client_user index; *) |
(* add_source r c.client_user index; *) |
216 |
if not (List.memq c file.file_clients) then begin |
if not (List.memq c file.file_clients) then begin |
217 |
let chunks = [ Int64.zero, file_size file ] in |
let chunks = [ Int64.zero, file_size file ] in |
218 |
(* |
(* |
219 |
let bs = Int64Swarmer.register_uploader file.file_swarmer |
let bs = Int64Swarmer.register_uploader file.file_swarmer |
220 |
(Int64Swarmer.AvailableRanges chunks) in *) |
(Int64Swarmer.AvailableRanges chunks) in *) |
221 |
c.client_downloads <- c.client_downloads @ [{ |
c.client_downloads <- c.client_downloads @ [{ |
222 |
download_file = file; |
download_file = file; |
234 |
end; |
end; |
235 |
end |
end |
236 |
|
|
237 |
let rec find_download file list = |
let rec find_download file list = |
238 |
match list with |
match list with |
239 |
[] -> raise Not_found |
[] -> raise Not_found |
240 |
| d :: tail -> |
| d :: tail -> |
241 |
if d.download_file == file then d else find_download file tail |
if d.download_file == file then d else find_download file tail |
242 |
|
|
243 |
|
let rec find_download_by_index index list = |
|
let rec find_download_by_index index list = |
|
244 |
match list with |
match list with |
245 |
[] -> raise Not_found |
[] -> raise Not_found |
246 |
| d :: tail -> |
| d :: tail -> |
247 |
if d.download_url = index then |
if d.download_url = index then |
248 |
d |
d |
249 |
else |
else |
250 |
find_download_by_index index tail |
find_download_by_index index tail |
|
|
|
251 |
|
|
252 |
let remove_download file list = |
let remove_download file list = |
253 |
let rec iter file list rev = |
let rec iter file list rev = |
259 |
iter file tail (d :: rev) |
iter file tail (d :: rev) |
260 |
in |
in |
261 |
iter file list [] |
iter file list [] |
262 |
|
|
263 |
let file_state file = file_state (as_file file) |
let file_state file = file_state (as_file file) |
264 |
|
|
265 |
let file_num file = file_num (as_file file) |
let file_num file = file_num (as_file file) |
266 |
|
|
267 |
let file_must_update file = |
let file_must_update file = |
268 |
file_must_update (as_file file) |
file_must_update (as_file file) |
269 |
|
|
271 |
|
|
272 |
let set_client_state client state = |
let set_client_state client state = |
273 |
CommonClient.set_client_state (as_client client) state |
CommonClient.set_client_state (as_client client) state |
274 |
|
|
275 |
let set_client_disconnected client = |
let set_client_disconnected client = |
276 |
CommonClient.set_client_disconnected (as_client client) |
CommonClient.set_client_disconnected (as_client client) |
277 |
|
|
278 |
|
let remove_file file = |
|
let remove_file file = |
|
279 |
Hashtbl.remove files_by_uid file.file_id; |
Hashtbl.remove files_by_uid file.file_id; |
280 |
current_files := List2.removeq file !current_files |
current_files := List2.removeq file !current_files |
281 |
|
|
282 |
let udp_sock = ref (None : UdpSocket.t option) |
let udp_sock = ref (None : UdpSocket.t option) |
283 |
|
|
287 |
|
|
288 |
let old_client_name = ref "" |
let old_client_name = ref "" |
289 |
let ft_client_name = ref "" |
let ft_client_name = ref "" |
290 |
|
|
291 |
|
let client_name () = |
292 |
let client_name () = |
|
|
|
|
293 |
let name = !!global_login in |
let name = !!global_login in |
294 |
if name != !old_client_name then begin |
if name != !old_client_name then begin |
295 |
let len = String.length name in |
let len = String.length name in |
298 |
String2.replace_char !ft_client_name ' ' '_'; |
String2.replace_char !ft_client_name ' ' '_'; |
299 |
end; |
end; |
300 |
!ft_client_name |
!ft_client_name |
301 |
|
|
302 |
let file_chunk_size = 307200 |
let file_chunk_size = 307200 |
|
|
|
|
|
|