/[mldonkey]/mldonkey/src/daemon/common/commonInteractive.ml
ViewVC logotype

Diff of /mldonkey/src/daemon/common/commonInteractive.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.39 by spiralvoice, Thu Jul 7 00:25:45 2005 UTC revision 1.40 by spiralvoice, Sun Jul 10 23:19:16 2005 UTC
# Line 82  let file_commited_name incoming_dir file Line 82  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 _ -> ());
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
# Line 95  let file_commited_name incoming_dir file Line 95  let file_commited_name incoming_dir file
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
# Line 119  let file_commit file = Line 119  let file_commit file =
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
# Line 128  let file_commit file = Line 128  let file_commit file =
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;
# Line 141  anymore. *) Line 141  anymore. *)
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 ->
# Line 152  anymore. *) Line 152  anymore. *)
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... *)
# Line 215  let mail_for_completed_file file = Line 215  let mail_for_completed_file file =
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
# Line 268  let file_completed (file : file) = Line 268  let file_completed (file : file) =
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;
# Line 282  let file_completed (file : file) = Line 282  let file_completed (file : file) =
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
# Line 377  let contact_remove c = Line 377  let contact_remove c =
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
# Line 390  let time_of_sec sec = Line 390  let time_of_sec sec =
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";
# Line 424  let start_search user query buf = Line 424  let start_search user query buf =
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
# Line 438  let network_display_stats buf o = Line 438  let network_display_stats buf o =
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 ->
# Line 471  let print_connected_servers o = Line 471  let print_connected_servers o =
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
# Line 482  let send_custom_query user buf query arg Line 482  let send_custom_query user buf query arg
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        | _ ->        | _ ->
# Line 492  let send_custom_query user buf query arg Line 492  let send_custom_query user buf query arg
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    
# Line 561  let send_custom_query user buf query arg Line 561  let send_custom_query user buf query arg
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
# Line 581  let send_custom_query user buf query arg Line 581  let send_custom_query user buf query arg
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 _ ->
# Line 627  let send_custom_query user buf query arg Line 627  let send_custom_query user buf query arg
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
# Line 742  let del_item_from_fully_qualified_option Line 742  let del_item_from_fully_qualified_option
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
# Line 788  let _ = Line 788  let _ =
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;
# Line 819  and the ones with lowest priority in Fil Line 819  and the ones with lowest priority in Fil
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  **************************************************************)  **************************************************************)
# Line 836  let force_download_quotas () = Line 836  let force_download_quotas () =
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 *)
# Line 855  let force_download_quotas () = Line 855  let force_download_quotas () =
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
# Line 896  let force_download_quotas () = Line 896  let force_download_quotas () =
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    )    )

Legend:
Removed from v.1.39  
changed lines
  Added in v.1.40

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26