/[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.38 by spiralvoice, Tue Jul 5 12:26:40 2005 UTC revision 1.39 by spiralvoice, Thu Jul 7 00:25:45 2005 UTC
# Line 23  open Int64ops Line 23  open Int64ops
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
# Line 39  open CommonResult Line 39  open CommonResult
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
# Line 79  let canonize_basename name = Line 78  let canonize_basename name =
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 _ -> ());
# Line 97  let file_commited_name incoming_dir file Line 96  let file_commited_name incoming_dir file
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,
# Line 107  Note that when the network specific file Line 106  Note that when the network specific file
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
# Line 121  let file_commit file = Line 120  let file_commit file =
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
# Line 146  anymore. *) Line 145  anymore. *)
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
# Line 163  anymore. *) Line 162  anymore. *)
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";
# Line 184  let file_cancel file = Line 183  let file_cancel 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
# Line 224  let mail_for_completed_file file = Line 223  let mail_for_completed_file file =
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
# Line 233  let mail_for_completed_file file = Line 232  let mail_for_completed_file file =
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;
# Line 253  let mail_for_completed_file file = Line 252  let mail_for_completed_file file =
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;
# Line 279  let file_completed (file : file) = Line 277  let file_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
# Line 302  let file_add impl state = Line 297  let file_add impl state =
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
# Line 319  let server_remove server = Line 314  let server_remove server =
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
# Line 338  let friend_add c = Line 333  let friend_add c =
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 =
# Line 355  let friend_remove c = Line 350  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
# Line 368  let contact_add c = Line 363  let contact_add c =
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
# Line 379  let contact_remove c = Line 374  let contact_remove c =
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 =
# Line 406  let start_download file = Line 398  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
# Line 415  let download_file o arg = Line 407  let download_file o arg =
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"
# Line 424  let download_file o arg = Line 416  let download_file o arg =
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
# Line 503  let send_custom_query user buf query arg Line 495  let send_custom_query user buf query arg
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
# Line 515  let send_custom_query user buf query arg Line 507  let send_custom_query user buf query arg
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
# Line 527  let send_custom_query user buf query arg Line 519  let send_custom_query user buf query arg
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
# Line 539  let send_custom_query user buf query arg Line 531  let send_custom_query user buf query arg
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
# Line 547  let send_custom_query user buf query arg Line 539  let send_custom_query user buf query arg
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
# Line 557  let send_custom_query user buf query arg Line 549  let send_custom_query user buf query arg
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
# Line 565  let send_custom_query user buf query arg Line 557  let send_custom_query user buf query arg
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
# Line 576  let send_custom_query user buf query arg Line 568  let send_custom_query user buf query arg
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;
# Line 630  let send_custom_query user buf query arg Line 622  let send_custom_query user buf query arg
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 -> ()
# Line 647  let opfile_args r opfile = Line 639  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
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    
# Line 698  let all_active_network_opfile_network_na Line 690  let all_active_network_opfile_network_na
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 ->
# Line 721  let apply_on_fully_qualified_options nam Line 713  let apply_on_fully_qualified_options nam
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 ->
# Line 745  let get_fully_qualified_options name = Line 736  let get_fully_qualified_options name =
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)
# Line 780  let keywords_of_query query = Line 771  let keywords_of_query query =
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
# Line 804  let _ = Line 794  let _ =
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;
# Line 816  let search_add_result filter s r = Line 806  let search_add_result filter s 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
# Line 831  is a max_concurrent_downloads constraint Line 821  is a max_concurrent_downloads constraint
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            (**            (**
# Line 861  let force_download_quotas () = Line 851  let force_download_quotas () =
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        [], [] -> ()        [], [] -> ()
# Line 877  let force_download_quotas () = Line 867  let force_download_quotas () =
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
# Line 897  let force_download_quotas () = Line 887  let force_download_quotas () =
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 ()  

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

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