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

[mldonkey-commits]

CVSROOT:        /sources/mldonkey
Module name:    mldonkey
Changes by:     spiralvoice <spiralvoice>       10/07/18 10:59:20

Modified files:
        distrib        : ChangeLog 
        src/networks/direct_connect: dcInteractive.ml dcProtocol.ml 
                                     dcServers.ml 
        src/utils/cdk  : list2.ml list2.mli 

Log message:
        patch #7250

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1445&r2=1.1446
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/direct_connect/dcInteractive.ml?cvsroot=mldonkey&r1=1.38&r2=1.39
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/direct_connect/dcProtocol.ml?cvsroot=mldonkey&r1=1.11&r2=1.12
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/direct_connect/dcServers.ml?cvsroot=mldonkey&r1=1.20&r2=1.21
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/cdk/list2.ml?cvsroot=mldonkey&r1=1.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/cdk/list2.mli?cvsroot=mldonkey&r1=1.4&r2=1.5

Patches:
Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1445
retrieving revision 1.1446
diff -u -b -r1.1445 -r1.1446
--- distrib/ChangeLog   18 Jul 2010 10:58:36 -0000      1.1445
+++ distrib/ChangeLog   18 Jul 2010 10:59:19 -0000      1.1446
@@ -15,6 +15,7 @@
 =========
 
 2010/07/18
+7250: DC: discover self IP (ygrek)
 7249: DC: fix parsing MyINFO with non-latin nicks (ygrek)
 
 2010/07/17

Index: src/networks/direct_connect/dcInteractive.ml
===================================================================
RCS file: 
/sources/mldonkey/mldonkey/src/networks/direct_connect/dcInteractive.ml,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -b -r1.38 -r1.39
--- src/networks/direct_connect/dcInteractive.ml        24 May 2010 18:10:49 
-0000      1.38
+++ src/networks/direct_connect/dcInteractive.ml        18 Jul 2010 10:59:20 
-0000      1.39
@@ -92,7 +92,6 @@
 
 let exn_catch f x = try `Ok (f x) with exn -> `Exn exn
 let opt_default default = function None -> default | Some v -> v
-let filter_map f l = List.fold_left (fun acc x -> match f x with Some y -> y 
:: acc | None -> acc) [] l
 
 let parse_url url user group =
   match exn_catch parse_magnet_url url with
@@ -101,7 +100,7 @@
     if !verbose then
       lprintf_nl "Got magnet url %S" url;
     (* TODO multiple TTHs, multiple xt, automatic merge of downloads from 
different networks (?!) *) 
-    match filter_map (function TigerTree tth -> Some tth | _ -> None) 
magnet#uids with
+    match List2.filter_map (function TigerTree tth -> Some tth | _ -> None) 
magnet#uids with
     | [] -> "No TTH found in magnet url", false
     | tth::_ ->
       let _ = start_new_download None (TigerTree.to_string tth) "" magnet#name 
(opt_default 0L magnet#size) in

Index: src/networks/direct_connect/dcProtocol.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/direct_connect/dcProtocol.ml,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -b -r1.11 -r1.12
--- src/networks/direct_connect/dcProtocol.ml   18 Jul 2010 10:58:36 -0000      
1.11
+++ src/networks/direct_connect/dcProtocol.ml   18 Jul 2010 10:59:20 -0000      
1.12
@@ -927,23 +927,24 @@
     if !verbose_msg_clients then lprintf_nl "Sending: (%s)" (Buffer.contents 
buf)
   end
     
-module UserIP = struct (* TODO *)
+module UserIP = struct
   type t = string list
+
   let parse s = String2.split_simplify s '$' 
+
+  let parse_nameip =
+    List2.filter_map (fun s ->
+      match String2.split s ' ' with
+      | [name;addr] -> Some (dc_to_utf name, Ip.addr_of_string addr)
+      | _ -> None)
+
   let print st = 
     lprintf "UserIP list ("; 
-    List.iter (fun s -> lprintf "%s " s) st;
-    lprintf_nl " )" 
+    List.iter (fun s -> lprintf "%s " (dc_to_utf s)) st;
+    lprintf_nl ")"
+
   let write buf st = 
-    lprintf_nl "UserIP:";
-    Buffer.add_char buf ' ';
-    let rec iter s =
-      ( match s with
-      | [] -> lprintf_nl "UserIP: ()"
-      | hd :: [] -> lprintf_nl "UserIP: hd :: []  hd=%s" hd; Buffer.add_string 
buf hd
-      | hd :: tl ->  lprintf_nl "UserIP: hd :: tl  hd=%s" hd; Printf.bprintf 
buf "%s$$" hd; iter tl )
-    in 
-    iter st
+    Printf.bprintf buf "$UserIP %s" (String.concat "$$" (List.map utf_to_dc 
st))
   end
 
 (* Message type definitions and basic parsing *)  
@@ -1100,7 +1101,7 @@
   | UnknownReq t -> Buffer.add_string buf t
   | UGetBlockReq t -> UGetBlock.write buf t
   | UserCommandReq -> ()
-  | UserIPReq t -> Buffer.add_string buf "$UserIP"; UserIP.write buf t      
+  | UserIPReq t -> UserIP.write buf t
   | ValidateNickReq s -> Printf.bprintf buf "$ValidateNick %s" s
   | ValidateDenideReq s -> Buffer.add_string buf s
   | VersionReq s -> Printf.bprintf buf "$Version %s" s )

Index: src/networks/direct_connect/dcServers.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/direct_connect/dcServers.ml,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -b -r1.20 -r1.21
--- src/networks/direct_connect/dcServers.ml    17 Jul 2010 15:24:42 -0000      
1.20
+++ src/networks/direct_connect/dcServers.ml    18 Jul 2010 10:59:20 -0000      
1.21
@@ -461,18 +461,22 @@
   
   | UserIPReq st -> (* CHECK *)
       if !verbose_msg_servers then lprintf_nl "Received $UserIP";
-      List.iter ( fun nameip ->
-        lprintf_nl "UserIPReq: nameip=%s" nameip; 
-        match String2.split nameip ' ' with
-        | name :: ip :: [] -> 
-            (try
+      let st = UserIP.parse_nameip st in
+      List.iter begin fun (name,addr) ->
+        lprintf_nl "UserIP: %s %s" name (Ip.string_of_addr addr); 
+        try
+          if name = s.server_last_nick then
+          begin
+            match addr with 
+            | Ip.AddrIp ip -> lprintf_nl "Received self IP: %s" (Ip.to_string 
ip); last_high_id := ip
+            | Ip.AddrName _ -> ()
+          end;
               let u = search_user_by_name name in 
-              ( try u.user_ip <- Ip.addr_of_string ip with _ -> () );
+          u.user_ip <- addr;
               lprintf_nl "Added ip %s to user %s" (Ip.string_of_addr 
u.user_ip) u.user_nick
             with _ ->
-                if !verbose_unexpected_messages then lprintf_nl "No user by 
name %s" name )
-        | _ -> ()
-      ) st;
+          if !verbose_unexpected_messages then lprintf_nl "No user by name %s" 
name
+      end st
                     
   | ValidateDenideReq n ->  
       let errortxt = Printf.sprintf "Nick %s is already in use" n in

Index: src/utils/cdk/list2.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/list2.ml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- src/utils/cdk/list2.ml      18 Jul 2005 00:52:31 -0000      1.4
+++ src/utils/cdk/list2.ml      18 Jul 2010 10:59:20 -0000      1.5
@@ -116,3 +116,7 @@
     a.(p) <- tmp;
   done;
   Array.to_list a
+
+let filter_map f =
+  List.fold_left (fun acc x -> match f x with Some y -> y :: acc | None -> 
acc) []
+

Index: src/utils/cdk/list2.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/list2.mli,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- src/utils/cdk/list2.mli     18 Jul 2005 00:52:31 -0000      1.4
+++ src/utils/cdk/list2.mli     18 Jul 2010 10:59:20 -0000      1.5
@@ -45,3 +45,7 @@
 val max : 'a list -> 'a
 
 val shuffle: 'a list -> 'a list
\ No newline at end of file
+
+(** [filter_map f l] *)
+val filter_map : ('a -> 'b option) -> 'a list -> 'b list
+