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 _ -> ()); |
85 |
let new_name = |
let new_name = |
86 |
Filename.concat incoming_dir (canonize_basename best_name) |
Filename.concat incoming_dir (canonize_basename best_name) |
87 |
in |
in |
88 |
let new_name = |
let new_name = |
89 |
if Sys.file_exists new_name then |
if Sys.file_exists new_name then |
90 |
let rec iter num = |
let rec iter num = |
91 |
let new_name = Printf.sprintf "%s.%d" new_name num in |
let new_name = Printf.sprintf "%s.%d" new_name num in |
95 |
in |
in |
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, |
103 |
the second one by deleting it. |
the second one by deleting it. |
104 |
|
|
105 |
Note that when the network specific file_commit function is called, the |
Note that when the network specific file_commit function is called, the |
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 |
119 |
incoming_directories () |
incoming_directories () |
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 |
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_nl "commonInteractive.file_commit: destroyed"; |
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; |
141 |
begin |
begin |
142 |
try |
try |
143 |
if not (Unix2.is_directory new_name) then |
if not (Unix2.is_directory new_name) then |
144 |
ignore (CommonShared.new_shared |
ignore (CommonShared.new_shared |
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 -> |
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_nl "commonInteractive.file_commit: going to secondaries..."; |
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... *) |
215 |
let info = file_info file in |
let info = file_info file in |
216 |
let line1 = "mldonkey has completed the download of:\r\n\r\n" in |
let line1 = "mldonkey has completed the download of:\r\n\r\n" in |
217 |
|
|
218 |
let line2 = Printf.sprintf "\r\nFile: %s\r\nSize: %Ld bytes\r\nHash: %s\r\nFile was downloaded in%s\r\n" |
let line2 = Printf.sprintf "\r\nFile: %s\r\nSize: %Ld bytes\r\nHash: %s\r\nFile was downloaded in%s\r\n" |
219 |
(file_best_name file) |
(file_best_name file) |
220 |
(file_size file) |
(file_size file) |
221 |
(string_of_uids info.G.file_uids) |
(string_of_uids info.G.file_uids) |
222 |
(let age = (BasicSocket.last_time ()) - info.G.file_age in time_to_string age) |
(let age = (BasicSocket.last_time ()) - info.G.file_age in time_to_string age) |
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 |
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; |
271 |
|
|
272 |
if !!file_completed_cmd <> "" then begin |
if !!file_completed_cmd <> "" then begin |
273 |
MlUnix.fork_and_exec !!file_completed_cmd |
MlUnix.fork_and_exec !!file_completed_cmd |
274 |
[| |
[| |
275 |
file_name; |
file_name; |
276 |
file_id; |
file_id; |
282 |
with e -> |
with e -> |
283 |
lprintf_nl "Exception in file_completed: %s" (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 |
288 |
if impl.impl_file_state = FileNew then begin |
if impl.impl_file_state = FileNew then begin |
289 |
update_file_num impl; |
update_file_num impl; |
290 |
(match state with |
(match state with |
291 |
FileDownloaded -> |
FileDownloaded -> |
292 |
done_files =:= file :: !!done_files; |
done_files =:= file :: !!done_files; |
293 |
| FileShared |
| FileShared |
294 |
| FileNew |
| FileNew |
295 |
| FileCancelled -> () |
| FileCancelled -> () |
296 |
|
|
297 |
| FileAborted _ |
| FileAborted _ |
298 |
| FileDownloading |
| FileDownloading |
299 |
| FileQueued |
| FileQueued |
377 |
lprintf_nl "Exception in contact_remove: %s" (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 |
390 |
let display_vd = ref false |
let display_vd = ref false |
391 |
|
|
392 |
let start_download file = |
let start_download file = |
393 |
|
|
394 |
if !!file_started_cmd <> "" then |
if !!file_started_cmd <> "" then |
395 |
MlUnix.fork_and_exec !!file_started_cmd |
MlUnix.fork_and_exec !!file_started_cmd |
396 |
[| |
[| |
397 |
!!file_started_cmd; |
!!file_started_cmd; |
398 |
"-file"; |
"-file"; |
424 |
LocalSearch -> |
LocalSearch -> |
425 |
CommonSearch.local_search s |
CommonSearch.local_search s |
426 |
| _ -> |
| _ -> |
427 |
networks_iter (fun r -> |
networks_iter (fun r -> |
428 |
if query.GuiTypes.search_network = 0 || |
if query.GuiTypes.search_network = 0 || |
429 |
r.network_num = query.GuiTypes.search_network |
r.network_num = query.GuiTypes.search_network |
430 |
then |
then |
438 |
if List.mem NetworkHasStats r.network_flags then |
if List.mem NetworkHasStats r.network_flags then |
439 |
r.op_network_display_stats buf o |
r.op_network_display_stats buf o |
440 |
with _ -> ()) |
with _ -> ()) |
441 |
|
|
442 |
let print_connected_servers o = |
let print_connected_servers o = |
443 |
let buf = o.conn_buf in |
let buf = o.conn_buf in |
444 |
networks_iter (fun r -> |
networks_iter (fun r -> |
471 |
Printf.bprintf buf "Exception %s in print_connected_servers" |
Printf.bprintf buf "Exception %s in print_connected_servers" |
472 |
(Printexc2.to_string e); |
(Printexc2.to_string e); |
473 |
) |
) |
474 |
|
|
475 |
let send_custom_query user buf query args = |
let send_custom_query user buf query args = |
476 |
try |
try |
477 |
let q = List.assoc query (CommonComplexOptions.customized_queries()) in |
let q = List.assoc query (CommonComplexOptions.customized_queries()) in |
482 |
(label, value) :: tail -> |
(label, value) :: tail -> |
483 |
args := tail; |
args := tail; |
484 |
if label = arg_name then value else begin |
if label = arg_name then value else begin |
485 |
Printf.bprintf buf "Error expecting argument %s instead of %s" arg_name label; |
Printf.bprintf buf "Error expecting argument %s instead of %s" arg_name label; |
486 |
raise Exit |
raise Exit |
487 |
end |
end |
488 |
| _ -> |
| _ -> |
492 |
let rec iter q = |
let rec iter q = |
493 |
match q with |
match q with |
494 |
| Q_COMBO _ -> assert false |
| Q_COMBO _ -> assert false |
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 |
|
|
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 |
564 |
let format = if format = "" then |
let format = if format = "" then |
565 |
if format_propose = "" then raise Not_found |
if format_propose = "" then raise Not_found |
566 |
else format_propose |
else format_propose |
567 |
else format in |
else format in |
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 _ -> |
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 -> () |
630 |
| e -> |
| e -> |
631 |
Printf.bprintf buf "Error %s while parsing request" |
Printf.bprintf buf "Error %s while parsing request" |
632 |
(Printexc2.to_string e) |
(Printexc2.to_string e) |
633 |
|
|
634 |
let sort_options l = |
let sort_options l = |
635 |
List.sort (fun o1 o2 -> |
List.sort (fun o1 o2 -> |
636 |
String.compare o1.option_name o2.option_name) l |
String.compare o1.option_name o2.option_name) l |
637 |
|
|
638 |
let opfile_args r opfile = |
let opfile_args r opfile = |
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 |
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) |
748 |
| QAnd (q1, q2) -> iter q1; iter q2 |
| QAnd (q1, q2) -> iter q1; iter q2 |
749 |
| QAndNot (q1,q2) -> iter q1 |
| QAndNot (q1,q2) -> iter q1 |
750 |
| QHasWord w -> keywords := (String2.split_simplify w ' ') @ !keywords |
| QHasWord w -> keywords := (String2.split_simplify w ' ') @ !keywords |
751 |
| QHasField(field, w) -> |
| QHasField(field, w) -> |
752 |
begin |
begin |
788 |
(* if !!filter_search then *) begin |
(* if !!filter_search then *) begin |
789 |
(* lprintf "Filter search results\n"; *) |
(* lprintf "Filter search results\n"; *) |
790 |
List.iter (fun user -> |
List.iter (fun user -> |
791 |
List.iter (fun s -> CommonSearch.Filter.find s) |
List.iter (fun s -> CommonSearch.Filter.find s) |
792 |
user.ui_user_searches; |
user.ui_user_searches; |
793 |
) !ui_users |
) !ui_users |
794 |
end; |
end; |
819 |
is a max_concurrent_downloads constraint. |
is a max_concurrent_downloads constraint. |
820 |
|
|
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 |
**************************************************************) |
**************************************************************) |
836 |
**) |
**) |
837 |
let d1 = file_downloaded f1 in |
let d1 = file_downloaded f1 in |
838 |
let d2 = file_downloaded f2 in |
let d2 = file_downloaded f2 in |
839 |
if (d1=0L ) && (d2 > 0L) |
if (d1=0L ) && (d2 > 0L) |
840 |
then 1 |
then 1 |
841 |
else if ( d2=0L ) && (d1 > 0L) |
else if ( d2=0L ) && (d1 > 0L) |
842 |
then -1 |
then -1 |
843 |
else begin |
else begin |
844 |
(* Try to download in priority files with fewer bytes missing |
(* Try to download in priority files with fewer bytes missing |
845 |
Rationale: once completed, it may allow to recover some disk space *) |
Rationale: once completed, it may allow to recover some disk space *) |
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 |
[], [] -> () |
[], [] -> () |
858 |
| [], _ -> |
| [], _ -> |
859 |
iter_line list priority files ndownloads nqueued |
iter_line list priority files ndownloads nqueued |
860 |
| f :: tail , _ :: _ when file_priority f < priority -> |
| f :: tail , _ :: _ when file_priority f < priority -> |
861 |
iter_line list priority files ndownloads nqueued |
iter_line list priority files ndownloads nqueued |
896 |
|
|
897 |
let _ = |
let _ = |
898 |
option_hook max_concurrent_downloads (fun _ -> |
option_hook max_concurrent_downloads (fun _ -> |
899 |
force_download_quotas () |
force_download_quotas () |
900 |
) |
) |