[Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co...

[mldonkey-commits]

CVSROOT:        /sources/mldonkey
Module name:    mldonkey
Changes by:     spiralvoice <spiralvoice>       07/06/30 17:54:11

Modified files:
        distrib        : ChangeLog 
        src/daemon/common: commonComplexOptions.ml 
                           commonComplexOptions.mli 
        src/networks/bittorrent: bTInteractive.ml bTMain.ml 

Log message:
        patch #6049

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1291&r2=1.1292
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonComplexOptions.ml?cvsroot=mldonkey&r1=1.77&r2=1.78
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonComplexOptions.mli?cvsroot=mldonkey&r1=1.20&r2=1.21
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/bittorrent/bTInteractive.ml?cvsroot=mldonkey&r1=1.139&r2=1.140
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/bittorrent/bTMain.ml?cvsroot=mldonkey&r1=1.24&r2=1.25

Patches:
Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1291
retrieving revision 1.1292
diff -u -b -r1.1291 -r1.1292
--- distrib/ChangeLog   26 Jun 2007 21:22:48 -0000      1.1291
+++ distrib/ChangeLog   30 Jun 2007 17:54:10 -0000      1.1292
@@ -14,6 +14,10 @@
 ChangeLog
 =========
 
+2007/06/30
+6049: BT: Support user_commit_dir when seeding,
+      reshare every share_scan_interval minutes
+
 2007/06/26
 Move docs/multiuser.txt to distrib/multiuser.txt
 6048: Make Ocaml 3.10.0 the default compiler

Index: src/daemon/common/commonComplexOptions.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonComplexOptions.ml,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -b -r1.77 -r1.78
--- src/daemon/common/commonComplexOptions.ml   17 Jun 2007 01:28:24 -0000      
1.77
+++ src/daemon/common/commonComplexOptions.ml   30 Jun 2007 17:54:10 -0000      
1.78
@@ -954,19 +954,45 @@
         [default_incoming_directories]
   | l -> l
 
+let shared_directories_including_user_commit () =
+(* This function is to be used in bTInteractive.try_share_file which is not 
recursive.
+   Its a replacement for !!shared_directories and provides the same list, but 
with
+   sub-directories added based on user_commit_dir.
+   This function works without disc access to avoid overhead. *)
+  let list = ref [] in
+  List.iter (fun s ->
+    let user_commit_dir_list = ref [] in
+    if (sharing_strategy s.shdir_strategy).sharing_incoming then
+      begin
+        user2_users_iter (fun u ->
+          if u.user_commit_dir <> "" then
+            user_commit_dir_list := !user_commit_dir_list @
+              [{
+                shdir_dirname = Filename.concat s.shdir_dirname 
u.user_commit_dir;
+                shdir_priority = s.shdir_priority;
+                shdir_networks = s.shdir_networks;
+                shdir_strategy = s.shdir_strategy;
+              }]
+        )
+      end;
+    list := !list @ [s] @ !user_commit_dir_list
+  ) !!shared_directories;
+  !list
+
 let incoming_dir usedir ?user ?needed_space ?network () =
 
-  let directories, dirname_user =
+  let directories =
+    if usedir then
+      search_incoming_directories ()
+    else
+      search_incoming_files ()
+  in
+
     let dirname_user =
       match user with
       | None -> ""
       | Some user -> user.user_commit_dir
     in
-    if usedir then
-      search_incoming_directories (), ""
-    else
-      search_incoming_files (), dirname_user
-  in
 
 (*
   let dirname_network =

Index: src/daemon/common/commonComplexOptions.mli
===================================================================
RCS file: 
/sources/mldonkey/mldonkey/src/daemon/common/commonComplexOptions.mli,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -b -r1.20 -r1.21
--- src/daemon/common/commonComplexOptions.mli  9 Nov 2006 21:32:26 -0000       
1.20
+++ src/daemon/common/commonComplexOptions.mli  30 Jun 2007 17:54:10 -0000      
1.21
@@ -43,6 +43,7 @@
 val incoming_dir : bool -> ?user:CommonTypes.userdb -> ?needed_space:int64 -> 
?network:string -> unit -> CommonTypes.shared_directory
 val search_incoming_files : unit -> CommonTypes.shared_directory list
 val search_incoming_directories : unit -> CommonTypes.shared_directory list
+val shared_directories_including_user_commit : unit -> 
CommonTypes.shared_directory list
   
 val sharing_only_directory : CommonTypes.sharing_strategy
 

Index: src/networks/bittorrent/bTInteractive.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTInteractive.ml,v
retrieving revision 1.139
retrieving revision 1.140
diff -u -b -r1.139 -r1.140
--- src/networks/bittorrent/bTInteractive.ml    17 Jun 2007 01:56:29 -0000      
1.139
+++ src/networks/bittorrent/bTInteractive.ml    30 Jun 2007 17:54:11 -0000      
1.140
@@ -740,7 +740,7 @@
             else
               iter tail
       in
-      iter !!shared_directories
+      iter (shared_directories_including_user_commit ())
     in
 
     let file = new_file file_id torrent torrent_diskname
@@ -761,11 +761,6 @@
         with _ ->
           (lprintf_nl "Failed to rename %s to %s"
               torrent_diskname new_torrent_diskname));
-(*
-      (try Sys.remove torrent_diskname with e ->
-          if !verbose_share then
-            lprintf_nl "Error: %s while removing torrent %s" 
(Printexc2.to_string e) s)
-*)
   | e ->
       lprintf_nl "Cannot share torrent %s for %s"
         torrent_diskname (Printexc2.to_string e)
@@ -774,13 +769,9 @@
   automatically contact the tracker. *)
 let share_files _ =
   if !verbose_share then lprintf_nl "share_files";
-  List.iter (fun dir ->
-      let filenames = Unix2.list_directory dir in
       List.iter (fun file ->
-          let filename = Filename.concat dir file in
-          try_share_file filename
-      ) filenames
-  ) [seeded_directory];
+    try_share_file (Filename.concat seeded_directory file)
+  ) (Unix2.list_directory seeded_directory);
   let shared_files_copy = !current_files in
  (* if the torrent is gone while the file is still shared, remove the share *)
   List.iter (fun file ->

Index: src/networks/bittorrent/bTMain.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTMain.ml,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -b -r1.24 -r1.25
--- src/networks/bittorrent/bTMain.ml   26 Nov 2006 13:54:09 -0000      1.24
+++ src/networks/bittorrent/bTMain.ml   30 Jun 2007 17:54:11 -0000      1.25
@@ -55,22 +55,14 @@
     end
 
 let enable () =
-  (* lprintf "enable\n"; *)
   if not !is_enabled then
     let enabler = ref true in
-    (* lprintf "enabling...\n"; *)
-    Unix2.safe_mkdir torrents_directory;
-    Unix2.safe_mkdir seeded_directory;
-    Unix2.safe_mkdir tracked_directory;
-    Unix2.safe_mkdir downloads_directory;
-    Unix2.safe_mkdir old_directory;
-    Unix2.safe_mkdir new_torrents_directory;
-    Unix2.can_write_to_directory torrents_directory;
-    Unix2.can_write_to_directory seeded_directory;
-    Unix2.can_write_to_directory tracked_directory;
-    Unix2.can_write_to_directory downloads_directory;
-    Unix2.can_write_to_directory old_directory;
-    Unix2.can_write_to_directory new_torrents_directory;
+    List.iter (fun dir ->
+      Unix2.safe_mkdir dir;
+      Unix2.can_write_to_directory dir;
+    )  [torrents_directory; seeded_directory;
+        tracked_directory; downloads_directory;
+        old_directory; new_torrents_directory];
     is_enabled := true;
     if !!BTTracker.tracker_port = !!client_port then
       begin
@@ -84,8 +76,8 @@
         with e ->
             lprintf "Exception in BTTracker.start_tracker: %s\n"
               (Printexc2.to_string e));
-    add_session_timer enabler 300. (fun _ ->
-        BTInteractive.share_files ();
+    add_session_timer enabler ((float_of_int !!share_scan_interval) *. 60.)
+      (fun _ -> BTInteractive.share_files ();
     );
     if !!import_new_torrents_interval <> 0. then
     add_session_timer enabler !!import_new_torrents_interval (fun _ ->
@@ -96,22 +88,6 @@
     network.op_network_disable <- disable enabler;
 
     if not !!enable_bittorrent then enable_bittorrent =:= true;
-(*
-  List.iter (fun s ->
-      try
-        let ip = Ip.from_name s in
-        redirectors_ips := ip :: !redirectors_ips
-      with _ -> ()
-  ) !!redirectors;
-*)
-
-(*
-  Hashtbl.iter (fun _ file ->
-      if file_state file <> FileDownloaded then
-        current_files := file :: !current_files
-  ) files_by_key;
-*)
-
 
     BTClients.recover_files ();
     add_session_timer enabler 60.0 (fun timer ->