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

[mldonkey-commits]

CVSROOT:        /sources/mldonkey
Module name:    mldonkey
Changes by:     spiralvoice <spiralvoice>       10/12/19 10:04:59

Modified files:
        distrib        : ChangeLog 
        src/daemon/common: commonFile.ml commonFile.mli 
                           commonInteractive.ml 
        src/networks/bittorrent: bTInteractive.ml 
        src/networks/direct_connect: dcClients.ml dcGlobals.ml 
                                     dcShared.ml 
        src/utils/cdk  : filename2.mli 

Log message:
        patch #7388

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1504&r2=1.1505
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonFile.ml?cvsroot=mldonkey&r1=1.80&r2=1.81
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonFile.mli?cvsroot=mldonkey&r1=1.33&r2=1.34
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonInteractive.ml?cvsroot=mldonkey&r1=1.109&r2=1.110
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/bittorrent/bTInteractive.ml?cvsroot=mldonkey&r1=1.162&r2=1.163
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/direct_connect/dcClients.ml?cvsroot=mldonkey&r1=1.21&r2=1.22
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/direct_connect/dcGlobals.ml?cvsroot=mldonkey&r1=1.18&r2=1.19
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/direct_connect/dcShared.ml?cvsroot=mldonkey&r1=1.9&r2=1.10
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/cdk/filename2.mli?cvsroot=mldonkey&r1=1.7&r2=1.8

Patches:
Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1504
retrieving revision 1.1505
diff -u -b -r1.1504 -r1.1505
--- distrib/ChangeLog   15 Nov 2010 19:08:17 -0000      1.1504
+++ distrib/ChangeLog   19 Dec 2010 10:04:58 -0000      1.1505
@@ -14,6 +14,9 @@
 ChangeLog
 =========
 
+2010/12/19
+7388: DC: fix sharing on Windows (ygrek)
+-------------------------------------------------------------------------------
 2010/11/15: version 3.0.6 = tag release-3-0-6
 
 2010/11/13

Index: src/daemon/common/commonFile.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonFile.ml,v
retrieving revision 1.80
retrieving revision 1.81
diff -u -b -r1.80 -r1.81
--- src/daemon/common/commonFile.ml     1 Nov 2010 17:09:28 -0000       1.80
+++ src/daemon/common/commonFile.ml     19 Dec 2010 10:04:58 -0000      1.81
@@ -1267,3 +1267,13 @@
   lprintf_nl2 ("[" ^ (file_network file).network_shortname ^
               "] [file_num " ^ (string_of_int (file_num file)) ^ "]" ^
               "[temp " ^ (file_disk_name file) ^ "]") fmt
+
+let concat_file dir filename =
+  let fs = Unix32.filesystem dir in
+  let namemax =
+    match Unix32.fnamelen dir with
+    | None -> 0
+    | Some v -> v
+  in
+  Filename.concat dir (Filename2.filesystem_compliant filename fs namemax)
+

Index: src/daemon/common/commonFile.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonFile.mli,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -b -r1.33 -r1.34
--- src/daemon/common/commonFile.mli    17 Jun 2007 01:56:29 -0000      1.33
+++ src/daemon/common/commonFile.mli    19 Dec 2010 10:04:58 -0000      1.34
@@ -157,3 +157,7 @@
 val set_file_group : CommonTypes.file -> CommonTypes.groupdb option -> unit
 val file_group : CommonTypes.file -> CommonTypes.groupdb option
 val lprintf_file_nl : CommonTypes.file -> ('a, unit, unit) Pervasives.format 
-> 'a
+
+(** [concat_file dir filename] sanitizes [filename] and appends it to [dir] *)
+val concat_file : string -> string -> string
+

Index: src/daemon/common/commonInteractive.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonInteractive.ml,v
retrieving revision 1.109
retrieving revision 1.110
diff -u -b -r1.109 -r1.110
--- src/daemon/common/commonInteractive.ml      1 Nov 2010 17:19:23 -0000       
1.109
+++ src/daemon/common/commonInteractive.ml      19 Dec 2010 10:04:58 -0000      
1.110
@@ -151,7 +151,7 @@
       in
       iter 1
     else new_name in
-  set_file_best_name file (file_best_name file) "" 0;
+  set_file_best_name file (file_best_name file) fs namemax;
   Filename.concat incoming_dir new_name
 
 let script_for_file file incoming new_name =

Index: src/networks/bittorrent/bTInteractive.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTInteractive.ml,v
retrieving revision 1.162
retrieving revision 1.163
diff -u -b -r1.162 -r1.163
--- src/networks/bittorrent/bTInteractive.ml    1 Nov 2010 17:09:29 -0000       
1.162
+++ src/networks/bittorrent/bTInteractive.ml    19 Dec 2010 10:04:58 -0000      
1.163
@@ -703,16 +703,7 @@
     (if torrent.torrent_announce_list <> [] then torrent.torrent_announce_list 
else [torrent.torrent_announce]);
   if not !torrent_is_usable then raise (Torrent_can_not_be_used 
torrent.torrent_name);
 
-  let torrent_diskname =
-    let fs = Unix32.filesystem downloads_directory in
-    let namemax =
-      match Unix32.fnamelen downloads_directory with
-      | None -> 0
-      | Some v -> v
-    in
-    Filename.concat downloads_directory
-    (Filename2.filesystem_compliant torrent.torrent_name fs namemax) ^ 
".torrent"
-    in
+  let torrent_diskname = CommonFile.concat_file downloads_directory 
(torrent.torrent_name ^ ".torrent") in
   if Sys.file_exists torrent_diskname then
     begin
       if !verbose then lprintf_nl "load_torrent_string: %s already exists, 
ignoring" torrent_diskname;

Index: src/networks/direct_connect/dcClients.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/direct_connect/dcClients.ml,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -b -r1.21 -r1.22
--- src/networks/direct_connect/dcClients.ml    23 Oct 2010 18:19:21 -0000      
1.21
+++ src/networks/direct_connect/dcClients.ml    19 Dec 2010 10:04:58 -0000      
1.22
@@ -944,8 +944,8 @@
           let mylist = try DcShared.make_xml_mylist (DcShared.find_dir_exn 
dir) 
             with exn -> failwith (Printf.sprintf "PartialList %s : %s" dir 
(Printexc2.to_string exn))
           in 
-          let filename = Filename.concat directconnect_directory
-            (Printf.sprintf "mylist.%s.partial.xml.bz2" 
(DcGlobals.safe_filename (clients_username c)))
+          let filename = CommonFile.concat_file directconnect_directory
+            (Printf.sprintf "mylist.%s.partial.xml.bz2" (clients_username c))
           in
           DcShared.buffer_to_bz2_to_file mylist filename;
           c.client_state <- DcUploadListStarting filename;

Index: src/networks/direct_connect/dcGlobals.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/direct_connect/dcGlobals.ml,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -b -r1.18 -r1.19
--- src/networks/direct_connect/dcGlobals.ml    8 Sep 2010 16:26:05 -0000       
1.18
+++ src/networks/direct_connect/dcGlobals.ml    19 Dec 2010 10:04:58 -0000      
1.19
@@ -502,17 +502,6 @@
   } in
   file
 
-(* FIXME review *)
-let safe_filename s =
-  let s = String.copy s in
-  for i = 0 to String.length s - 1 do
-    match s.[i] with
-    | c when Char.code c < 32 -> s.[i] <- '_'
-    | '.' | '/' | '\\' | ':' -> s.[i] <- '_'
-    | _ -> ()
-  done;
-  s
-
 (* Return existing file or create new one *)     
 let new_file tiger_root (directory:string) (filename:string) (file_size:int64) 
=
   (try
@@ -527,12 +516,12 @@
       if !verbose_download then lprintf_nl "File exists: (%s) (%s)" 
f.file_directory f.file_name;
       f 
   with _ ->
-      let temp_filename = safe_filename
+      let temp_filename =
         (match tiger_root with
         | "" -> Printf.sprintf "DC_%s_%s" directory filename
         | _ -> Printf.sprintf "DC_%s" tiger_root)
       in 
-      let fullname = Filename.concat !!temp_directory temp_filename in
+      let fullname = CommonFile.concat_file !!temp_directory temp_filename in
       let temp_file = Unix32.create_rw fullname in
       let current_size = 
         (try

Index: src/networks/direct_connect/dcShared.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/direct_connect/dcShared.ml,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -b -r1.9 -r1.10
--- src/networks/direct_connect/dcShared.ml     23 Oct 2010 18:19:21 -0000      
1.9
+++ src/networks/direct_connect/dcShared.ml     19 Dec 2010 10:04:58 -0000      
1.10
@@ -322,6 +322,12 @@
 
 let _ = 
   network.op_network_share <- (fun fullname codedname size -> (* this is 
called once/60s with all shared files *)
+    (* file path in DC network should use '/' as separator, convert local path 
accordingly *)
+    let codedname =
+      match Filename2.slash with
+      | '/' -> codedname
+      | c -> let s = String.copy codedname in String2.replace_char s c '/'; s
+    in
     (try
       let dcsh = Hashtbl.find dc_shared_files_by_fullname fullname in
       if (dcsh.dc_shared_size = size) then begin            (* if size is 
correct... *)

Index: src/utils/cdk/filename2.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/filename2.mli,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -b -r1.7 -r1.8
--- src/utils/cdk/filename2.mli 31 Mar 2008 07:58:16 -0000      1.7
+++ src/utils/cdk/filename2.mli 19 Dec 2010 10:04:58 -0000      1.8
@@ -17,6 +17,9 @@
     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)
 
+val slash : char
+(** character used as a directory separator in file paths *)
+
 val dirname : string -> string 
 (*d [dirname filename] returns the dirname of [filename] after normalization *)