23 |
open Misc |
open Misc |
24 |
open Printf2 |
open Printf2 |
25 |
open CommonOptions |
open CommonOptions |
26 |
open BasicSocket |
open BasicSocket |
27 |
open TcpBufferedSocket |
open TcpBufferedSocket |
28 |
open Options |
open Options |
29 |
|
|
30 |
open CommonClient |
open CommonClient |
31 |
open CommonServer |
open CommonServer |
32 |
open CommonNetwork |
open CommonNetwork |
39 |
open CommonServer |
open CommonServer |
40 |
open CommonTypes |
open CommonTypes |
41 |
open CommonComplexOptions |
open CommonComplexOptions |
42 |
|
|
43 |
|
|
|
|
|
44 |
(************* ADD/REMOVE FUNCTIONS ************) |
(************* ADD/REMOVE FUNCTIONS ************) |
45 |
let check_forbidden_chars (uc : Charset.uchar) = |
let check_forbidden_chars (uc : Charset.uchar) = |
46 |
match uc with |
match uc with |
78 |
done; |
done; |
79 |
Charset.to_locale (Buffer.contents buf) |
Charset.to_locale (Buffer.contents buf) |
80 |
|
|
81 |
let file_commited_name incoming_dir file = |
let file_commited_name incoming_dir file = |
82 |
let network = file_network file in |
let network = file_network file in |
83 |
let best_name = file_best_name file in |
let best_name = file_best_name file in |
84 |
(try Unix2.safe_mkdir incoming_dir with _ -> ()); |
(try Unix2.safe_mkdir incoming_dir with _ -> ()); |
96 |
iter 1 |
iter 1 |
97 |
else new_name in |
else new_name in |
98 |
new_name |
new_name |
99 |
|
|
100 |
(******** |
(******** |
101 |
These two functions 'file_commit' and 'file_cancel' should be the two only |
These two functions 'file_commit' and 'file_cancel' should be the two only |
102 |
functions in mldonkey able to destroy a file, the first one by moving it, |
functions in mldonkey able to destroy a file, the first one by moving it, |
106 |
file has already been moved to the incoming/ directory under its new |
file has already been moved to the incoming/ directory under its new |
107 |
name. |
name. |
108 |
*) |
*) |
109 |
|
|
110 |
let file_commit file = |
let file_commit file = |
111 |
let impl = as_file_impl file in |
let impl = as_file_impl file in |
112 |
if impl.impl_file_state = FileDownloaded then |
if impl.impl_file_state = FileDownloaded then |
120 |
else |
else |
121 |
incoming_files () |
incoming_files () |
122 |
in |
in |
123 |
let new_name = file_commited_name |
let new_name = file_commited_name |
124 |
incoming.shdir_dirname file in |
incoming.shdir_dirname file in |
125 |
if Unix2.is_directory file_name then |
if Unix2.is_directory file_name then |
126 |
Unix2.safe_mkdir new_name; |
Unix2.safe_mkdir new_name; |
127 |
(try |
(try |
128 |
set_file_disk_name file new_name; |
set_file_disk_name file new_name; |
129 |
if Unix2.is_directory new_name then |
if Unix2.is_directory new_name then |
130 |
Unix.chmod new_name (Misc.int_of_octal_string !!create_dir_mask); |
Unix.chmod new_name (Misc.int_of_octal_string !!create_dir_mask); |
131 |
let best_name = file_best_name file in |
let best_name = file_best_name file in |
132 |
Unix32.destroy (file_fd file); |
Unix32.destroy (file_fd file); |
133 |
if !verbose_files then lprintf "commonInteractive.file_commit: destroyed\n"; |
if !verbose_files then lprintf_nl "commonInteractive.file_commit: destroyed"; |
134 |
if Unix2.is_directory file_name then Unix2.remove_all_directory file_name; |
if Unix2.is_directory file_name then Unix2.remove_all_directory file_name; |
135 |
let impl = as_file_impl file in |
let impl = as_file_impl file in |
136 |
|
|
137 |
(* When the commit action is called, the file is supposed not to exist |
(* When the commit action is called, the file is supposed not to exist |
138 |
anymore. *) |
anymore. *) |
139 |
impl.impl_file_ops.op_file_commit impl.impl_file_val new_name; |
impl.impl_file_ops.op_file_commit impl.impl_file_val new_name; |
140 |
|
|
141 |
begin |
begin |
142 |
try |
try |
143 |
if not (Unix2.is_directory new_name) then |
if not (Unix2.is_directory new_name) then |
145 |
incoming.shdir_dirname incoming.shdir_priority |
incoming.shdir_dirname incoming.shdir_priority |
146 |
best_name new_name); |
best_name new_name); |
147 |
with e -> |
with e -> |
148 |
lprintf "Exception %s while trying to share commited file\n" |
lprintf_nl "Exception %s while trying to share commited file" |
149 |
(Printexc2.to_string e); |
(Printexc2.to_string e); |
150 |
end; |
end; |
151 |
|
|
152 |
update_file_state impl FileShared; |
update_file_state impl FileShared; |
153 |
done_files =:= List2.removeq file !!done_files; |
done_files =:= List2.removeq file !!done_files; |
154 |
files =:= List2.removeq file !!files; |
files =:= List2.removeq file !!files; |
155 |
|
|
156 |
if !verbose_files then lprintf "commonInteractive.file_commit: going to secondaries...\n"; |
if !verbose_files then lprintf_nl "commonInteractive.file_commit: going to secondaries..."; |
157 |
List.iter (fun file -> |
List.iter (fun file -> |
158 |
(* Commit the file first, and share it after... *) |
(* Commit the file first, and share it after... *) |
159 |
try |
try |
162 |
impl.impl_file_ops.op_file_cancel impl.impl_file_val; |
impl.impl_file_ops.op_file_cancel impl.impl_file_val; |
163 |
done_files =:= List2.removeq file !!done_files; |
done_files =:= List2.removeq file !!done_files; |
164 |
files =:= List2.removeq file !!files; |
files =:= List2.removeq file !!files; |
165 |
|
|
166 |
with e -> |
with e -> |
167 |
lprintf "Exception %s in file_commit secondaries\n" (Printexc2.to_string e); |
lprintf_nl "Exception %s in file_commit secondaries" (Printexc2.to_string e); |
168 |
) secondary_files |
) secondary_files |
169 |
with e -> |
with e -> |
170 |
lprintf "Exception in file_commit: %s\n" (Printexc2.to_string e)) |
lprintf_nl "Exception in file_commit: %s" (Printexc2.to_string e)) |
171 |
| _ -> assert false |
| _ -> assert false |
172 |
|
|
173 |
let file_cancel file = |
let file_cancel file = |
174 |
try |
try |
175 |
let impl = as_file_impl file in |
let impl = as_file_impl file in |
176 |
if impl.impl_file_state <> FileCancelled then |
if impl.impl_file_state <> FileCancelled then |
177 |
let subfiles = file_files file in |
let subfiles = file_files file in |
178 |
if file != List.hd subfiles then |
if file != List.hd subfiles then |
179 |
failwith "Cannot cancel non primary file"; |
failwith "Cannot cancel non primary file"; |
183 |
impl.impl_file_ops.op_file_cancel impl.impl_file_val; |
impl.impl_file_ops.op_file_cancel impl.impl_file_val; |
184 |
files =:= List2.removeq file !!files; |
files =:= List2.removeq file !!files; |
185 |
with e -> |
with e -> |
186 |
lprintf "Exception %s in file_cancel\n" (Printexc2.to_string e); |
lprintf_nl "Exception %s in file_cancel" (Printexc2.to_string e); |
187 |
) subfiles; |
) subfiles; |
188 |
(try |
(try |
189 |
let fd = file_fd file in |
let fd = file_fd file in |
190 |
if fd != Unix32.bad_fd then Unix32.remove (file_fd file) |
if fd != Unix32.bad_fd then Unix32.remove (file_fd file) |
191 |
with e -> |
with e -> |
192 |
lprintf "Sys.remove %s exception %s\n" |
lprintf_nl "Sys.remove %s exception %s" |
193 |
(file_disk_name file) |
(file_disk_name file) |
194 |
(Printexc2.to_string e); ); |
(Printexc2.to_string e); ); |
195 |
Unix32.destroy (file_fd file); |
Unix32.destroy (file_fd file); |
196 |
with e -> |
with e -> |
197 |
lprintf "Exception in file_cancel: %s\n" (Printexc2.to_string e) |
lprintf_nl "Exception in file_cancel: %s" (Printexc2.to_string e) |
198 |
|
|
199 |
let time_to_string time = |
let time_to_string time = |
200 |
let days = time / 60 / 60 / 24 in |
let days = time / 60 / 60 / 24 in |
223 |
in |
in |
224 |
|
|
225 |
let line3 = if (file_comment file) <> "" then |
let line3 = if (file_comment file) <> "" then |
226 |
Printf.sprintf "\r\nComment: %s\r\n" (file_comment file) |
Printf.sprintf "\r\nComment: %s\r\n" (file_comment file) |
227 |
else |
else |
228 |
Printf.sprintf ""; |
Printf.sprintf ""; |
229 |
in |
in |
232 |
Printf.sprintf "[mldonkey] file received - %s" |
Printf.sprintf "[mldonkey] file received - %s" |
233 |
(file_best_name file) |
(file_best_name file) |
234 |
else |
else |
235 |
Printf.sprintf "mldonkey, file received"; |
Printf.sprintf "mldonkey, file received"; |
236 |
in |
in |
237 |
|
|
238 |
let line4 = if !!url_in_mail <> "" then |
let line4 = if !!url_in_mail <> "" then |
239 |
Printf.sprintf "\r\n<%s/%s>\r\n" !!url_in_mail (Url.encode (file_best_name file)) |
Printf.sprintf "\r\n<%s/%s>\r\n" !!url_in_mail (Url.encode (file_best_name file)) |
240 |
else |
else |
241 |
Printf.sprintf ""; |
Printf.sprintf ""; |
242 |
in |
in |
243 |
|
|
244 |
let mail = { |
let mail = { |
245 |
M.mail_to = !!mail; |
M.mail_to = !!mail; |
246 |
M.mail_from = !!mail; |
M.mail_from = !!mail; |
252 |
let chat_for_completed_file file = |
let chat_for_completed_file file = |
253 |
CommonChat.send_warning_for_downloaded_file (file_best_name file) |
CommonChat.send_warning_for_downloaded_file (file_best_name file) |
254 |
|
|
|
|
|
255 |
let file_completed (file : file) = |
let file_completed (file : file) = |
256 |
try |
try |
257 |
let impl = as_file_impl file in |
let impl = as_file_impl file in |
258 |
if impl.impl_file_state = FileDownloading then begin |
if impl.impl_file_state = FileDownloading then begin |
259 |
files =:= List2.removeq file !!files; |
files =:= List2.removeq file !!files; |
260 |
done_files =:= file :: !!done_files; |
done_files =:= file :: !!done_files; |
261 |
update_file_state impl FileDownloaded; |
update_file_state impl FileDownloaded; |
262 |
let file_name = file_disk_name file in |
let file_name = file_disk_name file in |
263 |
let file_id = Filename.basename file_name in |
let file_id = Filename.basename file_name in |
264 |
ignore (CommonShared.new_shared "completed" 0 ( |
ignore (CommonShared.new_shared "completed" 0 ( |
265 |
file_best_name file ) file_name); |
file_best_name file ) file_name); |
266 |
(try mail_for_completed_file file with e -> |
(try mail_for_completed_file file with e -> |
267 |
lprintf "Exception %s in sendmail\n" (Printexc2.to_string e); |
lprintf_nl "Exception %s in sendmail" (Printexc2.to_string e); |
268 |
); |
); |
269 |
if !!CommonOptions.chat_warning_for_downloaded then |
if !!CommonOptions.chat_warning_for_downloaded then |
270 |
chat_for_completed_file file; |
chat_for_completed_file file; |
277 |
Int64.to_string (file_size file); |
Int64.to_string (file_size file); |
278 |
file_best_name file |
file_best_name file |
279 |
|] |
|] |
|
|
|
280 |
end |
end |
|
|
|
|
|
|
281 |
end |
end |
282 |
with e -> |
with e -> |
283 |
lprintf "Exception in file_completed: %s\n" (Printexc2.to_string e) |
lprintf_nl "Exception in file_completed: %s" (Printexc2.to_string e) |
284 |
|
|
285 |
let file_add impl state = |
let file_add impl state = |
286 |
try |
try |
287 |
let file = as_file impl in |
let file = as_file impl in |
297 |
| FileAborted _ |
| FileAborted _ |
298 |
| FileDownloading |
| FileDownloading |
299 |
| FileQueued |
| FileQueued |
300 |
| FilePaused -> |
| FilePaused -> |
301 |
files =:= file :: !!files); |
files =:= file :: !!files); |
302 |
update_file_state impl state |
update_file_state impl state |
303 |
end |
end |
304 |
with e -> |
with e -> |
305 |
lprintf "Exception in file_add: %s\n" (Printexc2.to_string e) |
lprintf_nl "Exception in file_add: %s" (Printexc2.to_string e) |
306 |
|
|
307 |
let server_remove server = |
let server_remove server = |
308 |
try |
try |
309 |
let impl = as_server_impl server in |
let impl = as_server_impl server in |
314 |
servers =:= Intmap.remove (server_num server) !!servers; |
servers =:= Intmap.remove (server_num server) !!servers; |
315 |
end |
end |
316 |
with e -> |
with e -> |
317 |
lprintf "Exception in server_remove: %s\n" (Printexc2.to_string e) |
lprintf_nl "Exception in server_remove: %s" (Printexc2.to_string e) |
318 |
|
|
319 |
let server_add impl = |
let server_add impl = |
320 |
let server = as_server impl in |
let server = as_server impl in |
321 |
if impl.impl_server_state = NewHost then begin |
if impl.impl_server_state = NewHost then begin |
333 |
contacts := List2.removeq c !contacts; |
contacts := List2.removeq c !contacts; |
334 |
impl.impl_client_ops.op_client_browse impl.impl_client_val true |
impl.impl_client_ops.op_client_browse impl.impl_client_val true |
335 |
end |
end |
336 |
|
|
337 |
(* Maybe we should not add the client to the contact list and completely remove |
(* Maybe we should not add the client to the contact list and completely remove |
338 |
it ? *) |
it ? *) |
339 |
let friend_remove c = |
let friend_remove c = |
350 |
client_must_update c; |
client_must_update c; |
351 |
contacts := List2.removeq c !contacts; |
contacts := List2.removeq c !contacts; |
352 |
impl.impl_client_ops.op_client_clear_files impl.impl_client_val |
impl.impl_client_ops.op_client_clear_files impl.impl_client_val |
353 |
end |
end |
354 |
|
|
355 |
with e -> |
with e -> |
356 |
lprintf "Exception in friend_remove: %s\n" (Printexc2.to_string e) |
lprintf_nl "Exception in friend_remove: %s" (Printexc2.to_string e) |
357 |
|
|
358 |
let contact_add c = |
let contact_add c = |
359 |
let impl = as_client_impl c in |
let impl = as_client_impl c in |
360 |
if not (is_friend c || is_contact c) then begin |
if not (is_friend c || is_contact c) then begin |
363 |
contacts := c :: !contacts; |
contacts := c :: !contacts; |
364 |
impl.impl_client_ops.op_client_browse impl.impl_client_val true |
impl.impl_client_ops.op_client_browse impl.impl_client_val true |
365 |
end |
end |
366 |
|
|
367 |
let contact_remove c = |
let contact_remove c = |
368 |
try |
try |
369 |
let impl = as_client_impl c in |
let impl = as_client_impl c in |
374 |
impl.impl_client_ops.op_client_clear_files impl.impl_client_val |
impl.impl_client_ops.op_client_clear_files impl.impl_client_val |
375 |
end |
end |
376 |
with e -> |
with e -> |
377 |
lprintf "Exception in contact_remove: %s\n" (Printexc2.to_string e) |
lprintf_nl "Exception in contact_remove: %s" (Printexc2.to_string e) |
378 |
|
|
379 |
|
|
|
|
|
|
|
|
|
|
|
380 |
let time_of_sec sec = |
let time_of_sec sec = |
381 |
let hours = sec / 60 / 60 in |
let hours = sec / 60 / 60 in |
382 |
let rest = sec - hours * 60 * 60 in |
let rest = sec - hours * 60 * 60 in |
383 |
let minutes = rest / 60 in |
let minutes = rest / 60 in |
384 |
let seconds = rest - minutes * 60 in |
let seconds = rest - minutes * 60 in |
385 |
if hours > 0 then Printf.sprintf "%d:%02d:%02d" hours minutes seconds |
if hours > 0 then Printf.sprintf "%d:%02d:%02d" hours minutes seconds |
386 |
else if minutes > 0 then Printf.sprintf "%d:%02d" minutes seconds |
else if minutes > 0 then Printf.sprintf "%d:%02d" minutes seconds |
387 |
else Printf.sprintf "00:%02d" seconds |
else Printf.sprintf "00:%02d" seconds |
388 |
|
|
389 |
|
|
|
|
|
390 |
let display_vd = ref false |
let display_vd = ref false |
391 |
|
|
392 |
let start_download file = |
let start_download file = |
398 |
"-file"; |
"-file"; |
399 |
string_of_int (CommonFile.file_num file); |
string_of_int (CommonFile.file_num file); |
400 |
|] |
|] |
401 |
|
|
402 |
let download_file o arg = |
let download_file o arg = |
403 |
let user = o.conn_user in |
let user = o.conn_user in |
404 |
let buf = o.conn_buf in |
let buf = o.conn_buf in |
407 |
match user.ui_last_search with |
match user.ui_last_search with |
408 |
None -> "no last search" |
None -> "no last search" |
409 |
| Some s -> |
| Some s -> |
410 |
let result = List.assoc (int_of_string arg) user.ui_last_results in |
let result = List.assoc (int_of_string arg) user.ui_last_results in |
411 |
let files = CommonResult.result_download |
let files = CommonResult.result_download |
412 |
result [] false in |
result [] false in |
413 |
List.iter start_download files; |
List.iter start_download files; |
414 |
"download started" |
"download started" |
416 |
| Failure s -> s |
| Failure s -> s |
417 |
| _ -> "could not start download" |
| _ -> "could not start download" |
418 |
) |
) |
419 |
|
|
420 |
let start_search user query buf = |
let start_search user query buf = |
421 |
let s = CommonSearch.new_search user query in |
let s = CommonSearch.new_search user query in |
422 |
begin |
begin |
495 |
| Q_KEYWORDS _ -> |
| Q_KEYWORDS _ -> |
496 |
let value = get_arg "keywords" in |
let value = get_arg "keywords" in |
497 |
want_and_not andnot (fun w -> QHasWord w) QNone value |
want_and_not andnot (fun w -> QHasWord w) QNone value |
498 |
|
|
499 |
| Q_AND list -> |
| Q_AND list -> |
500 |
begin |
begin |
501 |
let ands = ref [] in |
let ands = ref [] in |
507 |
| q1 :: tail -> |
| q1 :: tail -> |
508 |
List.fold_left (fun q1 q2 -> QAnd (q1,q2)) q1 tail |
List.fold_left (fun q1 q2 -> QAnd (q1,q2)) q1 tail |
509 |
end |
end |
510 |
|
|
511 |
| Q_HIDDEN list -> |
| Q_HIDDEN list -> |
512 |
begin |
begin |
513 |
let ands = ref [] in |
let ands = ref [] in |
519 |
| q1 :: tail -> |
| q1 :: tail -> |
520 |
List.fold_left (fun q1 q2 -> QAnd (q1,q2)) q1 tail |
List.fold_left (fun q1 q2 -> QAnd (q1,q2)) q1 tail |
521 |
end |
end |
522 |
|
|
523 |
| Q_OR list -> |
| Q_OR list -> |
524 |
begin |
begin |
525 |
let ands = ref [] in |
let ands = ref [] in |
531 |
| q1 :: tail -> |
| q1 :: tail -> |
532 |
List.fold_left (fun q1 q2 -> QOr (q1,q2)) q1 tail |
List.fold_left (fun q1 q2 -> QOr (q1,q2)) q1 tail |
533 |
end |
end |
534 |
|
|
535 |
| Q_ANDNOT (q1, q2) -> |
| Q_ANDNOT (q1, q2) -> |
536 |
begin |
begin |
537 |
let r1 = iter q1 in |
let r1 = iter q1 in |
539 |
QAndNot(r1, iter q2) |
QAndNot(r1, iter q2) |
540 |
with Not_found -> r1 |
with Not_found -> r1 |
541 |
end |
end |
542 |
|
|
543 |
| Q_MODULE (s, q) -> iter q |
| Q_MODULE (s, q) -> iter q |
544 |
|
|
545 |
| Q_MINSIZE _ -> |
| Q_MINSIZE _ -> |
546 |
let minsize = get_arg "minsize" in |
let minsize = get_arg "minsize" in |
547 |
let unit = get_arg "minsize_unit" in |
let unit = get_arg "minsize_unit" in |
549 |
let minsize = Int64.of_string minsize in |
let minsize = Int64.of_string minsize in |
550 |
let unit = Int64.of_string unit in |
let unit = Int64.of_string unit in |
551 |
QHasMinVal (Field_Size, Int64.mul minsize unit) |
QHasMinVal (Field_Size, Int64.mul minsize unit) |
552 |
|
|
553 |
| Q_MAXSIZE _ -> |
| Q_MAXSIZE _ -> |
554 |
let maxsize = get_arg "maxsize" in |
let maxsize = get_arg "maxsize" in |
555 |
let unit = get_arg "maxsize_unit" in |
let unit = get_arg "maxsize_unit" in |
557 |
let maxsize = Int64.of_string maxsize in |
let maxsize = Int64.of_string maxsize in |
558 |
let unit = Int64.of_string unit in |
let unit = Int64.of_string unit in |
559 |
QHasMaxVal (Field_Size, Int64.mul maxsize unit) |
QHasMaxVal (Field_Size, Int64.mul maxsize unit) |
560 |
|
|
561 |
| Q_FORMAT _ -> |
| Q_FORMAT _ -> |
562 |
let format = get_arg "format" in |
let format = get_arg "format" in |
563 |
let format_propose = get_arg "format_propose" in |
let format_propose = get_arg "format_propose" in |
568 |
want_comb_not andnot |
want_comb_not andnot |
569 |
or_comb |
or_comb |
570 |
(fun w -> QHasField(Field_Format, w)) QNone format |
(fun w -> QHasField(Field_Format, w)) QNone format |
571 |
|
|
572 |
| Q_MEDIA _ -> |
| Q_MEDIA _ -> |
573 |
let media = get_arg "media" in |
let media = get_arg "media" in |
574 |
let media_propose = get_arg "media_propose" in |
let media_propose = get_arg "media_propose" in |
575 |
let media = if media = "" then |
let media = if media = "" then |
576 |
if media_propose = "" then raise Not_found |
if media_propose = "" then raise Not_found |
577 |
else media_propose |
else media_propose |
578 |
else media in |
else media in |
579 |
QHasField(Field_Type, media) |
QHasField(Field_Type, media) |
580 |
|
|
581 |
| Q_MP3_ARTIST _ -> |
| Q_MP3_ARTIST _ -> |
582 |
let artist = get_arg "artist" in |
let artist = get_arg "artist" in |
583 |
if artist = "" then raise Not_found; |
if artist = "" then raise Not_found; |
584 |
want_comb_not andnot and_comb |
want_comb_not andnot and_comb |
585 |
(fun w -> QHasField(Field_Artist, w)) QNone artist |
(fun w -> QHasField(Field_Artist, w)) QNone artist |
586 |
|
|
587 |
| Q_MP3_TITLE _ -> |
| Q_MP3_TITLE _ -> |
588 |
let title = get_arg "title" in |
let title = get_arg "title" in |
589 |
if title = "" then raise Not_found; |
if title = "" then raise Not_found; |
590 |
want_comb_not andnot and_comb |
want_comb_not andnot and_comb |
591 |
(fun w -> QHasField(Field_Title, w)) QNone title |
(fun w -> QHasField(Field_Title, w)) QNone title |
592 |
|
|
593 |
| Q_MP3_ALBUM _ -> |
| Q_MP3_ALBUM _ -> |
594 |
let album = get_arg "album" in |
let album = get_arg "album" in |
595 |
if album = "" then raise Not_found; |
if album = "" then raise Not_found; |
596 |
want_comb_not andnot and_comb |
want_comb_not andnot and_comb |
597 |
(fun w -> QHasField(Field_Album, w)) QNone album |
(fun w -> QHasField(Field_Album, w)) QNone album |
598 |
|
|
599 |
| Q_MP3_BITRATE _ -> |
| Q_MP3_BITRATE _ -> |
600 |
let bitrate = get_arg "bitrate" in |
let bitrate = get_arg "bitrate" in |
601 |
if bitrate = "" then raise Not_found; |
if bitrate = "" then raise Not_found; |
602 |
QHasMinVal(Field_UNKNOWN "bitrate", Int64.of_string bitrate) |
QHasMinVal(Field_UNKNOWN "bitrate", Int64.of_string bitrate) |
603 |
|
|
604 |
in |
in |
605 |
try |
try |
606 |
let request = CommonIndexing.simplify_query (iter q) in |
let request = CommonIndexing.simplify_query (iter q) in |
607 |
Printf.bprintf buf "Sending query !!!"; |
Printf.bprintf buf "Sending query !!!"; |
608 |
|
|
609 |
let s = |
let s = |
610 |
let module G = GuiTypes in |
let module G = GuiTypes in |
611 |
{ G.search_num = 0; |
{ G.search_num = 0; |
612 |
G.search_query = request; |
G.search_query = request; |
622 |
ignore (start_search user s buf) |
ignore (start_search user s buf) |
623 |
with |
with |
624 |
Not_found -> |
Not_found -> |
625 |
Printf.bprintf buf "Void query %s" query |
Printf.bprintf buf "Void query %s" query |
626 |
with |
with |
627 |
Not_found -> |
Not_found -> |
628 |
Printf.bprintf buf "No such custom search %s" query |
Printf.bprintf buf "No such custom search %s" query |
629 |
| Exit -> () |
| Exit -> () |
639 |
let prefix = r.network_shortname ^ "-" in |
let prefix = r.network_shortname ^ "-" in |
640 |
let args = simple_options prefix opfile in |
let args = simple_options prefix opfile in |
641 |
args |
args |
642 |
|
|
643 |
let all_simple_options () = |
let all_simple_options () = |
644 |
let options = ref (sort_options |
let options = ref (sort_options |
645 |
(simple_options "" downloads_ini) |
(simple_options "" downloads_ini) |
646 |
) |
) |
647 |
in |
in |
648 |
networks_iter_all (fun r -> |
networks_iter_all (fun r -> |
649 |
List.iter (fun opfile -> |
List.iter (fun opfile -> |
650 |
options := !options @ (opfile_args r opfile) |
options := !options @ (opfile_args r opfile) |
651 |
) |
) |
652 |
r.network_config_file |
r.network_config_file |
653 |
); |
); |
654 |
!options |
!options |
655 |
|
|
656 |
let parse_simple_options args = |
let parse_simple_options args = |
657 |
let v = all_simple_options () in |
let v = all_simple_options () in |
658 |
match args with |
match args with |
659 |
[] -> v |
[] -> v |
660 |
| args -> |
| args -> |
661 |
let match_star = Str.regexp "\\*" in |
let match_star = Str.regexp "\\*" in |
662 |
let options_filter = Str.regexp ("^\\(" |
let options_filter = Str.regexp ("^\\(" |
663 |
^ (List.fold_left (fun acc a -> acc |
^ (List.fold_left (fun acc a -> acc |
664 |
^ (if acc <> "" then "\\|" else "") |
^ (if acc <> "" then "\\|" else "") |
665 |
^ (Str.global_replace match_star ".*" a)) "" args) |
^ (Str.global_replace match_star ".*" a)) "" args) |
666 |
^ "\\)$") in |
^ "\\)$") in |
667 |
List.filter (fun o -> Str.string_match options_filter o.option_name 0) v |
List.filter (fun o -> Str.string_match options_filter o.option_name 0) v |
668 |
|
|
690 |
!names |
!names |
691 |
|
|
692 |
let apply_on_fully_qualified_options name f = |
let apply_on_fully_qualified_options name f = |
693 |
if !verbose then lprintf "For option %s\n" name; |
if !verbose then lprintf_nl "For option %s" name; |
694 |
let rec iter prefix opfile = |
let rec iter prefix opfile = |
695 |
let args = simple_options prefix opfile in |
let args = simple_options prefix opfile in |
696 |
List.iter (fun o -> |
List.iter (fun o -> |
713 |
false |
false |
714 |
with Exit -> true |
with Exit -> true |
715 |
)) then begin |
)) then begin |
716 |
lprintf "Could not set option %s\n" name; |
lprintf_nl "Could not set option %s" name; |
717 |
raise Not_found |
raise Not_found |
718 |
end |
end |
719 |
with Exit -> () |
with Exit -> () |
|
|
|
720 |
|
|
721 |
let set_fully_qualified_options name value = |
let set_fully_qualified_options name value = |
722 |
apply_on_fully_qualified_options name (fun opfile old_name old_value -> |
apply_on_fully_qualified_options name (fun opfile old_name old_value -> |
736 |
let add_item_to_fully_qualified_options name value = |
let add_item_to_fully_qualified_options name value = |
737 |
() |
() |
738 |
|
|
739 |
let del_item_from_fully_qualified_options name value = |
let del_item_from_fully_qualified_options name value = |
740 |
() |
() |
741 |
|
|
742 |
let keywords_of_query query = |
let keywords_of_query query = |
743 |
let keywords = ref [] in |
let keywords = ref [] in |
744 |
|
|
745 |
let rec iter q = |
let rec iter q = |
746 |
match q with |
match q with |
747 |
| QOr (q1,q2) |
| QOr (q1,q2) |
771 |
| _ -> () |
| _ -> () |
772 |
end |
end |
773 |
| QNone -> |
| QNone -> |
774 |
lprintf "LimewireInteractive.start_search: QNone in query\n"; |
lprintf_nl "LimewireInteractive.start_search: QNone in query"; |
775 |
() |
() |
776 |
in |
in |
777 |
iter query; |
iter query; |
778 |
!keywords |
!keywords |
779 |
|
|
780 |
let gui_options_panels = ref ([] : (string * (string * string * string) list) list) |
let gui_options_panels = ref ([] : (string * (string * string * string) list) list) |
781 |
|
|
782 |
let register_gui_options_panel name panel = |
let register_gui_options_panel name panel = |
783 |
if not (List.mem_assoc name !gui_options_panels) then |
if not (List.mem_assoc name !gui_options_panels) then |
784 |
gui_options_panels := (name, panel) :: !gui_options_panels |
gui_options_panels := (name, panel) :: !gui_options_panels |
785 |
|
|
|
|
|
786 |
let _ = |
let _ = |
787 |
add_infinite_timer filter_search_delay (fun _ -> |
add_infinite_timer filter_search_delay (fun _ -> |
788 |
(* if !!filter_search then *) begin |
(* if !!filter_search then *) begin |
794 |
end; |
end; |
795 |
CommonSearch.Filter.clear (); |
CommonSearch.Filter.clear (); |
796 |
) |
) |
797 |
|
|
798 |
let search_add_result filter s r = |
let search_add_result filter s r = |
799 |
if !CommonSearch.clean_local_search <> 0 then |
if !CommonSearch.clean_local_search <> 0 then |
800 |
CommonSearch.Local.add r; |
CommonSearch.Local.add r; |
806 |
CommonSearch.Filter.add r |
CommonSearch.Filter.add r |
807 |
|
|
808 |
let main_options = ref ([] : (string * Arg.spec * string) list) |
let main_options = ref ([] : (string * Arg.spec * string) list) |
809 |
|
|
810 |
let add_main_options list = |
let add_main_options list = |
811 |
main_options := !main_options @ list |
main_options := !main_options @ list |
812 |
|
|
813 |
|
|
814 |
(************************************************************* |
(************************************************************* |
815 |
|
|
816 |
Every minute, sort the files by priority, and test if the |
Every minute, sort the files by priority, and test if the |
821 |
In the future, we could try to mix this with the multi-users |
In the future, we could try to mix this with the multi-users |
822 |
system to give some fairness between downloads of different |
system to give some fairness between downloads of different |
823 |
users. |
users. |
824 |
|
|
825 |
**************************************************************) |
**************************************************************) |
826 |
|
|
827 |
open CommonFile |
open CommonFile |
828 |
|
|
829 |
let force_download_quotas () = |
let force_download_quotas () = |
830 |
let files = List.sort (fun f1 f2 -> |
let files = List.sort (fun f1 f2 -> |
831 |
let v = file_priority f2 - file_priority f1 in |
let v = file_priority f2 - file_priority f1 in |
832 |
if v <> 0 then v else begin |
if v <> 0 then v else begin |
833 |
(** |
(** |
851 |
end |
end |
852 |
) |
) |
853 |
!!CommonComplexOptions.files in |
!!CommonComplexOptions.files in |
854 |
|
|
855 |
let rec iter list priority files ndownloads nqueued = |
let rec iter list priority files ndownloads nqueued = |
856 |
match list, files with |
match list, files with |
857 |
[], [] -> () |
[], [] -> () |
867 |
iter tail (file_priority f) (f :: files) ndownloads (nqueued+1) |
iter tail (file_priority f) (f :: files) ndownloads (nqueued+1) |
868 |
| _ -> |
| _ -> |
869 |
iter tail (file_priority f) files ndownloads nqueued |
iter tail (file_priority f) files ndownloads nqueued |
870 |
|
|
871 |
and iter_line list priority files ndownloads nqueued = |
and iter_line list priority files ndownloads nqueued = |
872 |
if ndownloads > !!max_concurrent_downloads then |
if ndownloads > !!max_concurrent_downloads then |
873 |
match files with |
match files with |
874 |
[] -> assert false |
[] -> assert false |
887 |
FileQueued -> |
FileQueued -> |
888 |
set_file_state f FileDownloading; |
set_file_state f FileDownloading; |
889 |
iter_line list priority tail (ndownloads+1) (nqueued-1) |
iter_line list priority tail (ndownloads+1) (nqueued-1) |
890 |
| _ -> iter_line list priority tail ndownloads nqueued |
| _ -> iter_line list priority tail ndownloads nqueued |
891 |
else |
else |
892 |
iter list priority [] ndownloads nqueued |
iter list priority [] ndownloads nqueued |
893 |
|
|
894 |
in |
in |
895 |
iter files max_int [] 0 0 |
iter files max_int [] 0 0 |
896 |
|
|
897 |
let _ = |
let _ = |
898 |
option_hook max_concurrent_downloads (fun _ -> |
option_hook max_concurrent_downloads (fun _ -> |
899 |
force_download_quotas () |
force_download_quotas () |