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

[mldonkey-commits]

CVSROOT:        /sources/mldonkey
Module name:    mldonkey
Changes by:     spiralvoice <spiralvoice>       10/07/17 15:24:42

Modified files:
        distrib        : ChangeLog 
        src/networks/direct_connect: dcGlobals.ml dcServers.ml 

Log message:
        patch #7248

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1443&r2=1.1444
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/direct_connect/dcGlobals.ml?cvsroot=mldonkey&r1=1.16&r2=1.17
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/direct_connect/dcServers.ml?cvsroot=mldonkey&r1=1.19&r2=1.20

Patches:
Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1443
retrieving revision 1.1444
diff -u -b -r1.1443 -r1.1444
--- distrib/ChangeLog   17 Jul 2010 10:18:07 -0000      1.1443
+++ distrib/ChangeLog   17 Jul 2010 15:24:42 -0000      1.1444
@@ -15,6 +15,7 @@
 =========
 
 2010/07/17
+7248: DC: correctly parse dchub:// entries in xml hublist (ygrek)
 7247: BT tracker: remember tracked files after restart (ygrek)
 
 2010/07/16

Index: src/networks/direct_connect/dcGlobals.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/direct_connect/dcGlobals.ml,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -b -r1.16 -r1.17
--- src/networks/direct_connect/dcGlobals.ml    24 May 2010 18:10:49 -0000      
1.16
+++ src/networks/direct_connect/dcGlobals.ml    17 Jul 2010 15:24:42 -0000      
1.17
@@ -968,7 +968,7 @@
 (* Return hub state text *)
 let dc_hubstate_to_text s =
   (match s.server_hub_state with
-  | Waiting -> "Waiting"
+  | Waiting -> "Not connected"
   | User -> "User"
   | Vipped -> "Vip"
   | Opped -> "Op" )

Index: src/networks/direct_connect/dcServers.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/direct_connect/dcServers.ml,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -b -r1.19 -r1.20
--- src/networks/direct_connect/dcServers.ml    23 May 2010 09:12:15 -0000      
1.19
+++ src/networks/direct_connect/dcServers.ml    17 Jul 2010 15:24:42 -0000      
1.20
@@ -571,9 +571,21 @@
     let l = List.filter (xml_tag name) xs in
     xml_select t (List.concat (List.map Xml.children l))
 
+let ssplit s sub =
+  try
+    let n = String2.search_from s 0 sub in
+    Some (String2.before s n, String2.after s (n + String.length sub))
+  with
+    _ -> None
+
 let parse_address s =
-  try Scanf.sscanf s "dchub://%s@:%u" (fun s n -> s,n)
-  with _ -> try Scanf.sscanf s "%s@:%u" (fun s n -> s,n) with _ -> s,411
+  let s = match ssplit (String.lowercase s) "://" with
+  | Some ("dchub",s) -> s
+  | None -> s
+  | Some (("adc"|"adcs"),_) -> failwith "ADC not supported"
+  | Some (proto,_) -> failwith (Printf.sprintf "Unsupported protocol %S" proto)
+  in
+  try Scanf.sscanf s "%s@:%u" (fun s n -> s,n) with _ -> s,411
 
 let make_hublist_from_xml x =
   let make_hub x =
@@ -590,7 +602,11 @@
     }
   in
   let l = xml_select ["hublist";"hubs";"hub"] [x] in
-  let l' = List.fold_left (fun acc x -> try make_hub x :: acc with _ -> acc) 
[] l in
+  let add_hub acc x = 
+    try make_hub x :: acc
+    with exn -> lprintf_nl "Skipping hublist entry : %s" (Printexc2.to_string 
exn); acc
+  in
+  let l' = List.fold_left add_hub [] l in
   if !verbose_msg_servers then
     lprintf_nl "Found %u valid (of %u total) servers in hublist" (List.length 
l') (List.length l);
   l'