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

[mldonkey-commits]

CVSROOT:        /sources/mldonkey
Module name:    mldonkey
Changes by:     spiralvoice <spiralvoice>       07/01/08 12:26:38

Modified files:
        distrib        : ChangeLog 
        src/networks/donkey: donkeyClient.ml donkeyFiles.ml 
                             donkeyTypes.ml 

Log message:
        patch #5664

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1141&r2=1.1142
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/donkey/donkeyClient.ml?cvsroot=mldonkey&r1=1.117&r2=1.118
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/donkey/donkeyFiles.ml?cvsroot=mldonkey&r1=1.23&r2=1.24
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/donkey/donkeyTypes.ml?cvsroot=mldonkey&r1=1.56&r2=1.57

Patches:
Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1141
retrieving revision 1.1142
diff -u -b -r1.1141 -r1.1142
--- distrib/ChangeLog   8 Jan 2007 12:20:40 -0000       1.1141
+++ distrib/ChangeLog   8 Jan 2007 12:26:38 -0000       1.1142
@@ -15,6 +15,8 @@
 =========
 
 2007/01/08
+5664: EDK: Avoid uploading data more than due
+      to eMules rotating block requests (pango)
 5596: EDK: New option upload_full_chunks (thx to TripleM)
 - If the new option upload_full_chunks is set to true, each client is
   allowed to receive one chunk, this setting overrides upload_lifetime.

Index: src/networks/donkey/donkeyClient.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyClient.ml,v
retrieving revision 1.117
retrieving revision 1.118
diff -u -b -r1.117 -r1.118
--- src/networks/donkey/donkeyClient.ml 8 Jan 2007 12:20:40 -0000       1.117
+++ src/networks/donkey/donkeyClient.ml 8 Jan 2007 12:26:38 -0000       1.118
@@ -416,15 +416,17 @@
   
 let new_chunk up begin_pos end_pos =
   if begin_pos <> end_pos then
-    let pair = (begin_pos, end_pos) in
-    (match up.up_chunks with
-        [] ->
+    let chunk = (begin_pos, end_pos) in
+    (* the zone requested is already "in the pipe" *)
+    if not (List.mem chunk up.up_flying_chunks) then
+      match up.up_chunks with
+      | [] ->
           up.up_pos <- begin_pos;
           up.up_end_chunk <- end_pos;
-          up.up_chunks <- [pair];
-      | chunks ->
-          if not (List.mem pair chunks) then
-            up.up_chunks <- chunks @ [pair])
+          up.up_chunks <- [chunk];
+      | up_chunks ->
+          if not (List.mem chunk up_chunks) then
+            up.up_chunks <- up_chunks @ [chunk]
   
 let identify_client_brand c =
   if c.client_brand = Brand_unknown then
@@ -2034,13 +2036,21 @@
         set_rtimeout sock !!upload_timeout;
 
         let up, waiting = match c.client_upload with
-            Some ({ up_file = f } as up) when f == file ->  up, up.up_waiting
+          | Some ({ up_file = f } as up) when f == file ->
+             (* zones are received in the order they're sent, so we
+                know that the oldest of the zones "in fly" must have
+                been received when this QueryBlockReq was sent *)
+             (match up.up_flying_chunks with
+              | [] -> () 
+              | _ :: q -> up.up_flying_chunks <- q);
+             up, up.up_waiting
           | Some old_up ->
               {
                 up_file = file;
                 up_pos = Int64.zero;
                 up_end_chunk = Int64.zero;
                 up_chunks = [];
+               up_flying_chunks = [];
                 up_waiting = old_up.up_waiting;
               }, old_up.up_waiting
           | _ ->
@@ -2049,6 +2059,7 @@
                 up_pos = Int64.zero;
                 up_end_chunk = Int64.zero;
                 up_chunks = [];
+               up_flying_chunks = [];
                 up_waiting = false;
               }, false
         in
@@ -2136,12 +2147,12 @@
 let init_client sock c =
   set_handler sock WRITE_DONE (fun s ->
       match c.client_upload with
-        None -> ()
-      | Some up ->
+      | Some ({ up_chunks = _ :: _ } as up) ->
           if not up.up_waiting && !CommonUploads.has_upload = 0 then begin
               up.up_waiting <- true;
               CommonUploads.ready_for_upload (as_client c)
             end
+      | _ -> ()
   );
 (*
   set_handler sock (BASIC_EVENT RTIMEOUT) (fun s ->

Index: src/networks/donkey/donkeyFiles.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyFiles.ml,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -b -r1.23 -r1.24
--- src/networks/donkey/donkeyFiles.ml  6 Jan 2007 18:15:17 -0000       1.23
+++ src/networks/donkey/donkeyFiles.ml  8 Jan 2007 12:26:38 -0000       1.24
@@ -127,7 +127,7 @@
 (*      lprintf "send_client_block\n"; *)
       if per_client > 0 && CommonUploads.can_write_len sock max_msg_size then
         match c.client_upload with
-        | Some ({ up_chunks = _ :: chunks } as up)  ->
+        | Some ({ up_chunks = current_chunk :: chunks } as up)  ->
             if up.up_file.file_shared = None then begin
 (* Is there a message to warn that a file is not shared anymore ? *)
                 c.client_upload <- None;
@@ -138,16 +138,17 @@
             if max_len <= msg_block_size_int then
 (* last block from chunk *)
               begin
+                send_small_block c sock up.up_file up.up_pos max_len;
                 if !verbose_upload then
                     lprintf_nl "End of chunk (%d) %Ld %s" max_len 
up.up_end_chunk (file_best_name up.up_file);
-                send_small_block c sock up.up_file up.up_pos max_len;
+               up.up_flying_chunks <- up.up_flying_chunks @ [current_chunk];
                 up.up_chunks <- chunks;
                 let per_client = per_client - max_len in
                 match chunks with
-                  [] -> 
+               | [] -> 
                     if !verbose_upload then
-                        lprintf_nl "NO CHUNKS";
-                    c.client_upload <- None;
+                        lprintf_nl "NO MORE CHUNKS";
+                   up.up_waiting <- false;
                 | (begin_pos, end_pos) :: _ ->
                     up.up_pos <- begin_pos;
                     up.up_end_chunk <- end_pos;
@@ -172,10 +173,10 @@
           let size = min max_msg_size size in
           send_client_block c sock size;
            (match c.client_upload with
-              None -> ()
-            | Some up ->
+            | Some ({ up_chunks = _ :: _ }) ->
                 if !CommonUploads.has_upload = 0 then
                   CommonUploads.ready_for_upload (as_client c)
+           | _ -> ()
           )
       )
     let _ =

Index: src/networks/donkey/donkeyTypes.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyTypes.ml,v
retrieving revision 1.56
retrieving revision 1.57
diff -u -b -r1.56 -r1.57
--- src/networks/donkey/donkeyTypes.ml  8 Jan 2007 11:06:42 -0000       1.56
+++ src/networks/donkey/donkeyTypes.ml  8 Jan 2007 12:26:38 -0000       1.57
@@ -608,6 +608,8 @@
     mutable up_pos : int64;
     mutable up_end_chunk : int64;
     mutable up_chunks : (int64 * int64) list;
+    (* zones sent but not yet received by other peer, oldest first *)
+    mutable up_flying_chunks : (int64 * int64) list; 
     mutable up_waiting : bool;
   }