[Mldonkey-commits] mldonkey distrib/ChangeLog src/networks/bittorr...

[mldonkey-commits]

CVSROOT:        /sources/mldonkey
Module name:    mldonkey
Changes by:     spiralvoice <spiralvoice>       10/05/24 18:08:18

Modified files:
        distrib        : ChangeLog 
        src/networks/bittorrent: bTInteractive.ml bTTracker.ml 

Log message:
        patch #7202

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1434&r2=1.1435
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/bittorrent/bTInteractive.ml?cvsroot=mldonkey&r1=1.154&r2=1.155
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/bittorrent/bTTracker.ml?cvsroot=mldonkey&r1=1.32&r2=1.33

Patches:
Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1434
retrieving revision 1.1435
diff -u -b -r1.1434 -r1.1435
--- distrib/ChangeLog   24 May 2010 18:06:56 -0000      1.1434
+++ distrib/ChangeLog   24 May 2010 18:08:17 -0000      1.1435
@@ -15,6 +15,10 @@
 =========
 
 2010/05/24
+7202: BT: Improve internal tracker (ygrek)
+- continue tracking files even if there are no requests
+- better logging and error reporting
+- remove peer from peers list when it sends 'stopped' event
 7203: Fix linking with binutils-gold
 
 2010/05/23

Index: src/networks/bittorrent/bTInteractive.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTInteractive.ml,v
retrieving revision 1.154
retrieving revision 1.155
diff -u -b -r1.154 -r1.155
--- src/networks/bittorrent/bTInteractive.ml    11 Apr 2010 10:45:24 -0000      
1.154
+++ src/networks/bittorrent/bTInteractive.ml    24 May 2010 18:08:17 -0000      
1.155
@@ -779,7 +779,7 @@
     if !verbose_share then 
       lprintf_file_nl (as_file file) "Sharing file %s" filename;
     BTClients.talk_to_tracker file false;
-    Some filename
+    `Ok torrent_diskname
   with
   | Not_found ->
       (* if the torrent is still there while the file is gone, remove the 
torrent *)
@@ -788,16 +788,18 @@
         Filename.concat old_directory
           (Filename.basename torrent_diskname)
       in
-      (try
+      begin try
           Unix2.rename torrent_diskname new_torrent_diskname;
-          Some new_torrent_diskname
+          `Ok new_torrent_diskname
         with _ ->
-          (lprintf_nl "Failed to rename %s to %s" torrent_diskname 
new_torrent_diskname);
-           None
-          )
+          let msg = Printf.sprintf "Failed to rename %S to %S" 
torrent_diskname new_torrent_diskname in
+          lprintf_nl "%s" msg;
+          `Err msg
+      end
   | e ->
-      lprintf_nl "Cannot share torrent %s for %s" torrent_diskname 
(Printexc2.to_string e);
-      None
+      let msg = Printf.sprintf "Cannot share %S - exn %s" torrent_diskname 
(Printexc2.to_string e) in
+      lprintf_nl "%s" msg;
+      `Err msg
 
 (* Call one minute after start, and then every 20 minutes. Should
   automatically contact the tracker. *)
@@ -1041,10 +1043,10 @@
   let is_private = 0 in
   let file_id = BTTorrent.generate_torrent announce torrent comment 
(Int64.of_int is_private) filename in
   match try_share_file torrent with 
-  | None -> failwith "Cannot share file"
-  | Some path -> 
-    Filename.concat (Sys.getcwd ()) path,
-    try `Ok (BTTracker.track_torrent basename file_id) with exn -> `Exn 
(Printexc2.to_string exn)
+  | `Err msg -> failwith msg
+  | `Ok torrent_path ->
+    Filename.concat (Sys.getcwd ()) torrent_path,
+    try `Ok (BTTracker.track_torrent basename file_id) with exn -> `Err 
(Printexc2.to_string exn)
 
 let text fmt = Printf.ksprintf (fun s -> `Text s) fmt
 let link name url = `Link (name,url)
@@ -1103,7 +1105,7 @@
           `Break;
           (match url with
           | `Ok url -> link "Download" url
-          | `Exn s -> text "Not tracked : %s" s);
+          | `Err s -> text "Not tracked : %s" s);
           `Break
         ]
       with 

Index: src/networks/bittorrent/bTTracker.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTTracker.ml,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -b -r1.32 -r1.33
--- src/networks/bittorrent/bTTracker.ml        11 Apr 2010 10:45:25 -0000      
1.32
+++ src/networks/bittorrent/bTTracker.ml        24 May 2010 18:08:17 -0000      
1.33
@@ -162,6 +162,8 @@
         tracker_last = (int_of_float (Unix.gettimeofday ()));
       } in
     incr ntracked_files;
+    if !verbose_msg_servers then
+      lprintf_nl "Start tracking torrent [%s]" (Sha1.to_hexa info_hash);
     Hashtbl.add tracked_files info_hash tracker;
     tracker
   else
@@ -182,7 +184,10 @@
 
 let track_torrent filename info_hash =
   check_tracker ();
-  if not (Hashtbl.mem tracked_files info_hash) then ignore (new_tracker 
info_hash);
+  if (Hashtbl.mem tracked_files info_hash) then
+    (if !verbose_msg_servers then lprintf_nl "Torrent [%s] is already tracked" 
(Sha1.to_hexa info_hash))
+  else
+    ignore (new_tracker info_hash);
   tracker_url filename
 
 let get_default_tracker () =
@@ -193,19 +198,19 @@
 let reply_has_tracker r info_hash peer_id peer_ip peer_port peer_key peer_left 
peer_event numwant no_peer_id  =
 
   if !verbose_msg_servers then
-    lprintf_nl "tracker contacted for [%s]" (Sha1.to_hexa info_hash);
+    lprintf_nl "Tracker contacted for [%s]" (Sha1.to_hexa info_hash);
   let tracker = try
       Hashtbl.find tracked_files info_hash
     with Not_found ->
         if !!tracker_force_local_torrents then begin
-            lprintf_nl "Tracker rejected announce request for torrent [%s]\n" 
(Sha1.to_hexa info_hash);
+            lprintf_nl "Tracker rejected announce request for torrent [%s]" 
(Sha1.to_hexa info_hash);
             failwith "Unknown torrent"
           end;
         lprintf_nl "[BT] Need new tracker";
         new_tracker info_hash
   in
 
-  let _ =
+  let peer =
     try
       let peer =
         Hashtbl.find tracker.tracker_table peer_id
@@ -245,6 +250,8 @@
         void_message
     (* Reply with clients that could not connect to this tracker otherwise *)
     | "stopped" ->
+        Hashtbl.remove tracker.tracker_table peer_id;
+        Fifo.remove tracker.tracker_peers peer;
         if peer_left > 0 then
           tracker.tracker_incomplete <- tracker.tracker_incomplete - 1
         else
@@ -618,35 +625,27 @@
 (* Every 600 seconds, refresh the peers list *)
 let clean_tracker_timer () =
   let time_threshold = last_time () - 3600 in
-  let trackers = ref [] in
 
-  if !verbose_msg_servers then lprintf_nl "clean_tracker_timer";
+  if !verbose_msg_servers then 
+    lprintf_nl "clean_tracker_timer - purging old peers";
   Hashtbl.iter (fun _ tracker ->
-      let list = ref [] in
       let old_peers = ref [] in
       Hashtbl.iter (fun _ peer ->
           if peer.peer_active < time_threshold then
             old_peers := peer :: !old_peers
-          else
+          (*else
           if Ip.usable peer.peer_ip then
-            list := peer :: !list)
+            list := peer :: !list*))
       tracker.tracker_table;
       List.iter (fun p ->
           Hashtbl.remove tracker.tracker_table p.peer_id
       ) !old_peers;
       Fifo.clear tracker.tracker_peers;
-      if !list <> [] then begin
-          List.iter (fun p -> Fifo.put tracker.tracker_peers p) !list;
-          trackers := tracker :: !trackers;
-        end;
-  ) tracked_files;
-
-  Hashtbl.clear tracked_files;
-  List.iter (fun t ->
-      Hashtbl.add tracked_files t.tracker_id t
-  ) !trackers
+      (* sync peers list *)
+      Hashtbl.iter (fun _ peer -> Fifo.put tracker.tracker_peers peer) 
tracker.tracker_table;
+  ) tracked_files
 
-let _ =
+let () =
   add_infinite_timer 600. clean_tracker_timer