[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Mldonkey-commits] mldonkey config/Makefile.in distrib/ChangeLog s...
|
From: |
mldonkey-commits |
|
Subject: |
[Mldonkey-commits] mldonkey config/Makefile.in distrib/ChangeLog s... |
|
Date: |
Sun, 23 May 2010 09:12:15 +0000 |
CVSROOT: /sources/mldonkey
Module name: mldonkey
Changes by: spiralvoice <spiralvoice> 10/05/23 09:12:15
Modified files:
config : Makefile.in
distrib : ChangeLog
src/daemon/common: commonGlobals.ml commonInteractive.ml
commonMultimedia.ml commonOptions.ml
guiEncoding.ml
src/daemon/driver: driverInteractive.ml driverMain.ml
src/networks/bittorrent: bTClients.ml bTTorrent.ml
src/networks/direct_connect: dcInteractive.ml dcOptions.ml
dcProtocol.ml dcServers.ml
dcShared.ml
src/utils/lib : charset.ml charset.mli gettext.ml4
Log message:
patch #7180
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/config/Makefile.in?cvsroot=mldonkey&r1=1.187&r2=1.188
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1431&r2=1.1432
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonGlobals.ml?cvsroot=mldonkey&r1=1.89&r2=1.90
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonInteractive.ml?cvsroot=mldonkey&r1=1.106&r2=1.107
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonMultimedia.ml?cvsroot=mldonkey&r1=1.15&r2=1.16
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonOptions.ml?cvsroot=mldonkey&r1=1.231&r2=1.232
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/guiEncoding.ml?cvsroot=mldonkey&r1=1.63&r2=1.64
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/driver/driverInteractive.ml?cvsroot=mldonkey&r1=1.139&r2=1.140
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/driver/driverMain.ml?cvsroot=mldonkey&r1=1.144&r2=1.145
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/bittorrent/bTClients.ml?cvsroot=mldonkey&r1=1.104&r2=1.105
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/bittorrent/bTTorrent.ml?cvsroot=mldonkey&r1=1.20&r2=1.21
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/direct_connect/dcInteractive.ml?cvsroot=mldonkey&r1=1.35&r2=1.36
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/direct_connect/dcOptions.ml?cvsroot=mldonkey&r1=1.11&r2=1.12
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/direct_connect/dcProtocol.ml?cvsroot=mldonkey&r1=1.7&r2=1.8
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/direct_connect/dcServers.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.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/lib/charset.ml?cvsroot=mldonkey&r1=1.9&r2=1.10
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/lib/charset.mli?cvsroot=mldonkey&r1=1.5&r2=1.6
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/lib/gettext.ml4?cvsroot=mldonkey&r1=1.10&r2=1.11
Patches:
Index: config/Makefile.in
===================================================================
RCS file: /sources/mldonkey/mldonkey/config/Makefile.in,v
retrieving revision 1.187
retrieving revision 1.188
diff -u -b -r1.187 -r1.188
--- config/Makefile.in 27 Mar 2010 16:18:17 -0000 1.187
+++ config/Makefile.in 23 May 2010 09:12:14 -0000 1.188
@@ -483,9 +483,9 @@
$(SRC_DIRECTCONNECT)/che3.ml \
$(SRC_DIRECTCONNECT)/dcGlobals.ml \
$(SRC_DIRECTCONNECT)/dcComplexOptions.ml \
+ $(SRC_DIRECTCONNECT)/dcProtocol.ml \
$(SRC_DIRECTCONNECT)/dcShared.ml \
$(SRC_DIRECTCONNECT)/dcKey.ml \
- $(SRC_DIRECTCONNECT)/dcProtocol.ml \
$(SRC_DIRECTCONNECT)/dcClients.ml \
$(SRC_DIRECTCONNECT)/dcServers.ml \
$(SRC_DIRECTCONNECT)/dcInteractive.ml \
Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1431
retrieving revision 1.1432
diff -u -b -r1.1431 -r1.1432
--- distrib/ChangeLog 23 May 2010 09:05:06 -0000 1.1431
+++ distrib/ChangeLog 23 May 2010 09:12:14 -0000 1.1432
@@ -14,6 +14,8 @@
ChangeLog
=========
+7180: DC: better encoding handling (ygrek)
+- new option default_encoding for communications with hubs, default CP1252
7181: HTML: Fix sorting of friends' file list (ygrek)
7200: Allow compilation with upcoming Ocaml 3.12
-------------------------------------------------------------------------------
Index: src/daemon/common/commonGlobals.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonGlobals.ml,v
retrieving revision 1.89
retrieving revision 1.90
diff -u -b -r1.89 -r1.90
--- src/daemon/common/commonGlobals.ml 1 Sep 2008 07:19:03 -0000 1.89
+++ src/daemon/common/commonGlobals.ml 23 May 2010 09:12:14 -0000 1.90
@@ -111,7 +111,7 @@
let shorten str limit =
(* TODO: we should change all strings to utf8 when
they come into the core instead. *)
- let name = Charset.to_utf8 (* String.escaped *) str in
+ let name = Charset.Locale.to_utf8 (* String.escaped *) str in
let slen = String.length str in
let len =
try
Index: src/daemon/common/commonInteractive.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonInteractive.ml,v
retrieving revision 1.106
retrieving revision 1.107
diff -u -b -r1.106 -r1.107
--- src/daemon/common/commonInteractive.ml 1 Sep 2008 07:36:49 -0000
1.106
+++ src/daemon/common/commonInteractive.ml 23 May 2010 09:12:14 -0000
1.107
@@ -67,7 +67,7 @@
let canonize_basename name =
let buf = Buffer.create 100 in
- let uname = Charset.to_utf8 name in
+ let uname = Charset.Locale.to_utf8 name in
for i = 0 to Charset.utf8_length uname - 1 do
(* replace chars on users request *)
let uc = Charset.utf8_get uname i in
@@ -85,7 +85,7 @@
end
done;
if not Autoconf.windows then
- Charset.to_locale (Buffer.contents buf)
+ Charset.Locale.to_locale (Buffer.contents buf)
else
Buffer.contents buf (* Windows uses patched Ocaml which always uses
Unicode chars *)
Index: src/daemon/common/commonMultimedia.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonMultimedia.ml,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -b -r1.15 -r1.16
--- src/daemon/common/commonMultimedia.ml 4 Mar 2007 21:28:53 -0000
1.15
+++ src/daemon/common/commonMultimedia.ml 23 May 2010 09:12:14 -0000
1.16
@@ -626,7 +626,7 @@
let get_info file =
let file =
if Autoconf.windows then
- Charset.to_locale (file)
+ Charset.Locale.to_locale (file)
else
file
in
Index: src/daemon/common/commonOptions.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonOptions.ml,v
retrieving revision 1.231
retrieving revision 1.232
diff -u -b -r1.231 -r1.232
--- src/daemon/common/commonOptions.ml 25 Apr 2010 13:17:28 -0000 1.231
+++ src/daemon/common/commonOptions.ml 23 May 2010 09:12:14 -0000 1.232
@@ -131,11 +131,11 @@
let min_reserved_fds = 50
let min_connections = 50
-let _ =
+let () =
lprintf_nl "Starting MLDonkey %s ... " Autoconf.current_version;
let ulof_old = Unix2.c_getdtablesize () in
lprintf_nl "Language %s, locale %s, ulimit for open files %d"
- Charset.default_language Charset.locstr ulof_old;
+ Charset.Locale.default_language Charset.Locale.locale_string ulof_old;
let nofile = Unix2.ml_getrlimit Unix2.RLIMIT_NOFILE in
if nofile.Unix2.rlim_max > 0 && nofile.Unix2.rlim_max >
nofile.Unix2.rlim_cur then
@@ -208,8 +208,8 @@
(* Charset conversion self-test *)
let filename = "abcdefghijklmnopqrstuvwxyz" in
- let conv_filename = Charset.to_locale filename in
- if filename <> conv_filename then Charset.conversion_enabled := false;
+ let conv_filename = Charset.Locale.to_locale filename in
+ if filename <> conv_filename then Charset.Locale.conversion_enabled := false;
(try
ignore (Sys.getenv "MLDONKEY_TEMP")
Index: src/daemon/common/guiEncoding.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/guiEncoding.ml,v
retrieving revision 1.63
retrieving revision 1.64
diff -u -b -r1.63 -r1.64
--- src/daemon/common/guiEncoding.ml 26 May 2007 23:21:47 -0000 1.63
+++ src/daemon/common/guiEncoding.ml 23 May 2010 09:12:14 -0000 1.64
@@ -77,7 +77,7 @@
let buf_string buf s =
(* charset conversion could generate longer strings *)
- let s = Charset.to_utf8 s in
+ let s = Charset.Locale.to_utf8 s in
let len = String.length s in
if len < 0xffff then begin
buf_int16 buf len;
Index: src/daemon/driver/driverInteractive.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverInteractive.ml,v
retrieving revision 1.139
retrieving revision 1.140
diff -u -b -r1.139 -r1.140
--- src/daemon/driver/driverInteractive.ml 22 Oct 2009 19:56:43 -0000
1.139
+++ src/daemon/driver/driverInteractive.ml 23 May 2010 09:12:14 -0000
1.140
@@ -76,7 +76,7 @@
let s =
!startup_message ^ (verify_user_admin ()) ^ (check_supported_os ())
^ (if not !dns_works then "DNS resolution does not work\n" else "")
- ^ (if not !Charset.conversion_enabled then "Charset conversion does not
work, disabled\n" else "")
+ ^ (if not !Charset.Locale.conversion_enabled then "Charset conversion does
not work, disabled\n" else "")
^ (match !created_new_base_directory with
None -> ""
| Some dir -> (Printf.sprintf "MLDonkey created a new home directory in
%s\n" dir))
@@ -718,7 +718,7 @@
(if !!html_mods_use_js_tooltips then
Printf.sprintf "
onMouseOver=\\\"mOvr(this);setTimeout('popLayer(\\\\\'%s<br>%sFile#:
%d<br>Network: %s<br>User%s
%s%s%s\\\\\')',%d);setTimeout('hideLayer()',%d);return true;\\\"
onMouseOut=\\\"mOut(this);hideLayer();setTimeout('hideLayer()',%d)\\\"\\>"
- (Http_server.html_real_escaped (Charset.to_utf8
file.file_name))
+ (Http_server.html_real_escaped (Charset.Locale.to_utf8
file.file_name))
(match file_magic (file_find file.file_num) with
None -> ""
| Some magic -> "File type: " ^
(Http_server.html_real_escaped magic) ^ "<br>")
@@ -739,7 +739,7 @@
else
file.file_comments
in
- List.iter (fun (_,_,_,s) -> Printf.bprintf buf1 "%s<br>"
(Http_server.html_real_escaped (Charset.to_utf8 s))) comments;
+ List.iter (fun (_,_,_,s) -> Printf.bprintf buf1 "%s<br>"
(Http_server.html_real_escaped (Charset.Locale.to_utf8 s))) comments;
Buffer.contents buf1
end)
@@ -1932,7 +1932,7 @@
" gd(jpg)"
| _, false, false ->
" gd(neither jpg nor png ?)") ^
- (match Autoconf.has_iconv, !Charset.conversion_enabled with
+ (match Autoconf.has_iconv, !Charset.Locale.conversion_enabled with
| true, true -> " iconv(active)"
| true, false -> " iconv(inactive)"
| false, _ -> " no-iconv") ^
@@ -2047,8 +2047,8 @@
(
"",
Printf.sprintf "\t\t language: %s - locale: %s - UTC offset: %s"
- Charset.default_language
- Charset.locstr
+ Charset.Locale.default_language
+ Charset.Locale.locale_string
(Rss_date.mk_timezone (Unix.time ()))
);
tack list
@@ -2492,7 +2492,7 @@
Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"" (html_mods_cntr ());
(if !!html_mods_use_js_tooltips then
Printf.bprintf buf "
onMouseOver=\\\"mOvr(this);setTimeout('popLayer(\\\\\'%s<br>%s%s\\\\\')',%d);setTimeout('hideLayer()',%d);return
true;\\\"
onMouseOut=\\\"mOut(this);hideLayer();setTimeout('hideLayer()',%d)\\\"\\>"
- (Http_server.html_real_escaped (Filename.basename (Charset.to_utf8
impl.impl_shared_codedname)))
+ (Http_server.html_real_escaped (Filename.basename
(Charset.Locale.to_utf8 impl.impl_shared_codedname)))
(match impl.impl_shared_file with
None -> "no file info"
| Some file -> match file_magic file with | None -> "no magic"
Index: src/daemon/driver/driverMain.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverMain.ml,v
retrieving revision 1.144
retrieving revision 1.145
diff -u -b -r1.144 -r1.145
--- src/daemon/driver/driverMain.ml 6 Feb 2008 20:39:53 -0000 1.144
+++ src/daemon/driver/driverMain.ml 23 May 2010 09:12:14 -0000 1.145
@@ -418,7 +418,7 @@
end
end
);
- if not !Charset.conversion_enabled then
+ if not !Charset.Locale.conversion_enabled then
lprintf_nl (_b "Self-test failed, charset conversion disabled.");
load_config ();
Index: src/networks/bittorrent/bTClients.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTClients.ml,v
retrieving revision 1.104
retrieving revision 1.105
diff -u -b -r1.104 -r1.105
--- src/networks/bittorrent/bTClients.ml 4 Apr 2010 09:16:28 -0000
1.104
+++ src/networks/bittorrent/bTClients.ml 23 May 2010 09:12:14 -0000
1.105
@@ -1364,7 +1364,7 @@
lprintf_file_nl (as_file file) "Failure no. %d%s from Tracker %s for
file: %s Reason: %s"
num
(if !!tracker_retries = 0 then "" else Printf.sprintf "/%d"
!!tracker_retries)
- t.tracker_url file.file_name (Charset.to_utf8 reason)
+ t.tracker_url file.file_name (Charset.Locale.to_utf8 reason)
in
match exn_catch File.to_string filename with
| `Exn _ | `Ok "" -> tracker_failed "empty reply"
Index: src/networks/bittorrent/bTTorrent.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTTorrent.ml,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -b -r1.20 -r1.21
--- src/networks/bittorrent/bTTorrent.ml 4 Apr 2010 09:16:01 -0000
1.20
+++ src/networks/bittorrent/bTTorrent.ml 23 May 2010 09:12:14 -0000
1.21
@@ -434,7 +434,7 @@
{
torrent_name = basename;
torrent_filename = "";
- torrent_name_utf8 = Charset.to_utf8 basename;
+ torrent_name_utf8 = Charset.Locale.to_utf8 basename;
torrent_length = length;
torrent_announce = announce;
torrent_announce_list = announce_list;
Index: src/networks/direct_connect/dcInteractive.ml
===================================================================
RCS file:
/sources/mldonkey/mldonkey/src/networks/direct_connect/dcInteractive.ml,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -b -r1.35 -r1.36
--- src/networks/direct_connect/dcInteractive.ml 4 Apr 2010 09:14:47
-0000 1.35
+++ src/networks/direct_connect/dcInteractive.ml 23 May 2010 09:12:14
-0000 1.36
@@ -1198,7 +1198,8 @@
if (extension = mylist_ext) then begin (* parse
MyList.DcLst *)
(try
let s = file_to_che3_to_string (Filename.concat filelist_directory
filename) in
- let s = Charset.to_utf8 s in
+ if not (Charset.is_utf8 s) then lprintf_nl "not utf8 : %S" s;
+ let s = Charset.Locale.to_utf8 s in (* really needed? *)
(try
String2.replace_char s char13 '\n';
let lines = String2.split_simplify s '\n' in
Index: src/networks/direct_connect/dcOptions.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/direct_connect/dcOptions.ml,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -b -r1.11 -r1.12
--- src/networks/direct_connect/dcOptions.ml 4 Apr 2010 09:14:47 -0000
1.11
+++ src/networks/direct_connect/dcOptions.ml 23 May 2010 09:12:14 -0000
1.12
@@ -47,6 +47,10 @@
(list_option (tuple3_option (string_option, string_option, string_option)))
[]
+let default_encoding = define_option directconnect_section ["default_encoding"]
+ "Default encoding to use for communications with hubs
(CP1251,UTF-8,ISO-8859-1,etc)"
+ string_option "CP1252"
+
let search_timeout = define_option directconnect_section
["search_timeout"]
"The time a search is active"
Index: src/networks/direct_connect/dcProtocol.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/direct_connect/dcProtocol.ml,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -b -r1.7 -r1.8
--- src/networks/direct_connect/dcProtocol.ml 25 Apr 2010 13:19:53 -0000
1.7
+++ src/networks/direct_connect/dcProtocol.ml 23 May 2010 09:12:14 -0000
1.8
@@ -23,6 +23,7 @@
open DcTypes
open DcGlobals
open TcpBufferedSocket
+open Options
(*open AnyEndian*)
let log_prefix = "[dcPro]"
@@ -85,18 +86,28 @@
let write buf t = Printf.bprintf buf "$%s" M.msg
end
-module SimpleNick = functor(M: sig val msg : string end) -> struct
- type t = string
- let parse nick = Charset.to_utf8 nick
- let print t = lprintf_nl "%s (%s)" M.msg t
- let write buf t = Printf.bprintf buf " %s" (Charset.convert Charset.UTF_8
Charset.CP1252 t)
-end
+(* DC uses 1-byte encodings *)
+(* Probably better convert to/from utf at transport layer!? *)
+
+let utf_to_dc s =
+ (* FIXME need hub-specific encodings *)
+(* Charset.convert Charset.UTF_8 Charset.CP1252 s *)
+ try
+ Charset.convert Charset.UTF_8 (Charset.charset_from_string
!!DcOptions.default_encoding) s
+ with
+ _ -> Charset.Locale.to_locale s
+
+let dc_to_utf s =
+ try
+ Charset.convert (Charset.charset_from_string !!DcOptions.default_encoding)
Charset.UTF_8 s
+ with
+ _ -> Charset.Locale.to_utf8 s
-module SimpleNick2 = functor(M: sig val msg : string end) -> struct
+module SimpleCmd(M: sig val msg : string end) = struct
type t = string
- let parse nick = Charset.to_utf8 nick
+ let parse nick = dc_to_utf nick
let print t = lprintf_nl "%s (%s)" M.msg t
- let write buf t = Printf.bprintf buf "$%s %s" M.msg (Charset.convert
Charset.UTF_8 Charset.CP1252 t)
+ let write buf t = Printf.bprintf buf "$%s %s" M.msg (utf_to_dc t)
end
(*module NickAndAddr (M: sig val msg : string end) = struct
@@ -120,7 +131,7 @@
type t = string list
let parse t =
let list = String2.split_simplify t '$' in
- let list = List.rev_map (fun nick -> Charset.to_utf8 nick) list in
+ let list = List.rev_map (fun nick -> dc_to_utf nick) list in
list
let print t =
lprintf "%s list ( " M.cmd;
@@ -128,10 +139,9 @@
lprintf_nl " )"
let write buf t =
Buffer.add_char buf ' ';
- List.iter (fun nick -> Printf.bprintf buf "%s %s$$" M.cmd (Charset.convert
Charset.UTF_8 Charset.CP1252 nick)) t
+ List.iter (fun nick -> Printf.bprintf buf "%s %s$$" M.cmd (utf_to_dc
nick)) t
end
-
(* Command modules *)
module Adc = functor (A: sig val command : string end) -> struct
@@ -270,13 +280,13 @@
| _ -> raise Not_found
in
let (ip,port) = String2.cut_at senderip ':' in {
- nick = Charset.to_utf8 snick;
+ nick = dc_to_utf snick;
ip = Ip.of_string ip;
port = int_of_string port;
}
let print t = lprintf_nl "$ConnectToMe %s %s:%d" t.nick (Ip.to_string t.ip)
t.port
let write buf t =
- Printf.bprintf buf " %s %s:%d" (Charset.convert Charset.UTF_8
Charset.CP1252 t.nick) (Ip.to_string t.ip) t.port;
+ Printf.bprintf buf " %s %s:%d" (utf_to_dc t.nick) (Ip.to_string t.ip)
t.port;
if !verbose_msg_clients then lprintf_nl "Sending: (%s)" (Buffer.contents
buf);
end
@@ -319,7 +329,7 @@
let write buf t = Printf.bprintf buf "$FileLength %Ld" t
end
-module ForceMove = SimpleNick(struct let msg = "ForceMove" end)
+module ForceMove = SimpleCmd(struct let msg = "ForceMove" end)
module Get = struct
type t = {
@@ -329,25 +339,19 @@
let parse s =
let len = String.length s in
let pos = String.rindex s '$' in {
- filename = Charset.to_utf8 (String.sub s 0 pos);
+ filename = dc_to_utf (String.sub s 0 pos);
pos = Int64.of_string (String.sub s (pos+1) (len-pos-1));
}
let print t = lprintf_nl "Get [%s] %Ld" t.filename t.pos
let write buf t =
- Printf.bprintf buf "$Get %s$%Ld" (Charset.convert Charset.UTF_8
Charset.CP1252 t.filename) t.pos;
+ Printf.bprintf buf "$Get %s$%Ld" (utf_to_dc t.filename) t.pos;
if !verbose_msg_clients then lprintf_nl "Sending: (%s)" (Buffer.contents
buf)
end
module GetListLen = Empty2(struct let msg = "GetListLen" end)
-module Hello = SimpleNick (struct let msg = "Hello" end)
-
-module HubName = struct
- type t = string
- let parse name = Charset.to_utf8 name
- let print t = lprintf_nl "Hub name (%s)" t
- let write buf t = Printf.bprintf buf " %s" (Charset.convert Charset.UTF_8
Charset.CP1252 t)
- end
+module Hello = SimpleCmd(struct let msg = "Hello" end)
+module HubName = SimpleCmd(struct let msg = "HubName" end)
module Key = struct
type t = {
@@ -394,20 +398,18 @@
let from = String2.replace from char60 empty_string in
let from = String2.replace from char62 empty_string in
let m = dc_decode_chat m in
- let m = Charset.to_utf8 m in
- { from = from; message = m }
+ { from = dc_to_utf from; message = dc_to_utf m }
| _ -> raise Not_found )
end else begin
let m = dc_decode_chat m in
- let m = Charset.to_utf8 m in
- { from = "-"; message = m }
+ { from = "-"; message = dc_to_utf m }
end
end
let print t = lprintf_nl "<Message> (%s) (%s)" t.from t.message
let write buf t =
- let m = Charset.convert Charset.UTF_8 Charset.CP1252 t.message in
+ let m = utf_to_dc t.message in
let m = dc_encode_chat m in
- Printf.bprintf buf "<%s> %s" t.from m
+ Printf.bprintf buf "<%s> %s" (utf_to_dc t.from) m
end
module MyINFO = struct
@@ -476,6 +478,7 @@
let l = String.length str in
if (l > 2) then
(match str.[0] with
+ | 'v' (* GreylinkDC++ *)
| 'V' -> (try version := String2.after str 2 with _ -> ()
)
| 'M' -> if (str.[2] = 'P') then mode := 'P'
| 'H' ->
@@ -494,7 +497,7 @@
) (String2.split tags ',');
{ (* pass this info record
as result.. *)
dest = dest;
- nick = Charset.to_utf8 nick;
+ nick = dc_to_utf nick;
description = tagline;
client_brand = client;
version = !version;
@@ -527,14 +530,11 @@
(char_of_int t.flag) t.email t.sharesize
end
-module MyNick = SimpleNick2 (struct let msg = "MyNick" end)
-
+module MyNick = SimpleCmd(struct let msg = "MyNick" end)
+module Quit = SimpleCmd(struct let msg = "Quit" end)
module NickList = SimpleNickList (struct let cmd = "NickList" end)
-
module OpList = SimpleNickList (struct let cmd = "OpList" end)
-module Quit = SimpleNick(struct let msg = "Quit" end)
-
module RevConnectToMe = struct
type t = {
dest : string;
@@ -542,12 +542,12 @@
}
let parse s =
let (orig , dest) = String2.cut_at s ' ' in {
- dest = Charset.to_utf8 dest;
- orig = Charset.to_utf8 orig;
+ dest = dc_to_utf dest;
+ orig = dc_to_utf orig;
}
let print t = lprintf_nl "$RevConnectToMe %s %s" t.orig t.dest
- let write buf t = Printf.bprintf buf "$RevConnectToMe %s %s"
- (Charset.convert Charset.UTF_8 Charset.CP1252 t.orig) (Charset.convert
Charset.UTF_8 Charset.CP1252 t.dest);
+ let write buf t =
+ Printf.bprintf buf "$RevConnectToMe %s %s" (utf_to_dc t.orig) (utf_to_dc
t.dest);
if !verbose_msg_clients then lprintf_nl "Sending: (%s)" (Buffer.contents
buf)
end
@@ -603,7 +603,7 @@
let passive , nick , ip , port =
(match String2.splitn orig ':' 1 with
| ["Hub" ; nick] ->
- true, Charset.to_utf8 nick, empty_string, empty_string
+ true, dc_to_utf nick, empty_string, empty_string
| [ip ; port] ->
false, empty_string, ip, port
| _ -> raise Not_found )
@@ -620,7 +620,7 @@
String.lowercase !s
end
in
- let words = Charset.to_utf8 words in
+ let words = dc_to_utf words in
let size =
(match has_size, size_kind with
| "T", "T" -> AtMost (Int64.of_float (float_of_string size))
@@ -643,8 +643,7 @@
let print t = lprintf_nl "$Search %s %s %d %s" t.nick t.ip t.filetype
t.words_or_tth
let write buf t =
Printf.bprintf buf " %s %c?%c?%s?%d?%s"
- (if t.passive then "Hub:" ^ (Charset.convert Charset.UTF_8
Charset.CP1252 t.nick) else
- t.ip ^ ":" ^ t.port )
+ (if t.passive then "Hub:" ^ (utf_to_dc t.nick) else t.ip ^ ":" ^ t.port )
(if t.sizelimit = NoLimit then 'F' else 'T')
(match t.sizelimit with
| AtMost _ -> 'T'
@@ -662,7 +661,7 @@
!s
end
in
- Charset.convert Charset.UTF_8 Charset.CP1252 words );
+ utf_to_dc words);
(*if !verbose_msg_clients then lprintf_nl "Sending: (%s)" (Buffer.contents
buf)*)
end
@@ -704,8 +703,8 @@
else begin
(try
let pos = String.rindex filename_with_dir char92 in
- Charset.to_utf8 (String.sub filename_with_dir 0 pos) ,
- Charset.to_utf8 (String2.after filename_with_dir (pos+1))
+ dc_to_utf (String.sub filename_with_dir 0 pos) ,
+ dc_to_utf (String2.after filename_with_dir (pos+1))
with _ -> "" , filename_with_dir )
end
in
@@ -716,7 +715,7 @@
let get_server_and_tth str = (* function for
separation of TTH and servername *)
(match String2.splitn str ':' 1 with (* the <server_name>
is replaced with TTH:<tth_hash> *)
| ["TTH" ; tiger_root] -> tiger_root, ""
- | [server_name] -> "", (Charset.to_utf8 server_name)
+ | [server_name] -> "", (dc_to_utf server_name)
| _ -> "","" )
in
let server_name, tth, ip, port =
@@ -739,7 +738,7 @@
server_name, tth, "", "" )
in
{
- owner = Charset.to_utf8 owner;
+ owner = dc_to_utf owner;
directory = directory;
filename = filename;
filesize = ( try Int64.of_string size with _ ->
Int64.of_int 0 );
@@ -763,13 +762,13 @@
(* opendchub-0.6.7/src/commands.c: * $SR fromnick filename\5filesize
openslots/totalslots\5hubname (hubip:hubport)\5tonick| */ *)
let write buf t =
Printf.bprintf buf " %s %s\\%s%c%s %d/%d%cTTH:%s (%s:%s)"
- (Charset.convert Charset.UTF_8 Charset.CP1252 t.owner)
- (Charset.convert Charset.UTF_8 Charset.CP1252 t.directory)
- (Charset.convert Charset.UTF_8 Charset.CP1252 t.filename) char5
(Int64.to_string t.filesize)
+ (utf_to_dc t.owner)
+ (utf_to_dc t.directory)
+ (utf_to_dc t.filename) char5 (Int64.to_string t.filesize)
t.open_slots t.all_slots char5 t.tth t.server_ip t.server_port;
(match t.to_nick with
| None -> ()
- | Some nick -> Printf.bprintf buf "%c%s" char5 (Charset.convert
Charset.UTF_8 Charset.CP1252 nick) );
+ | Some nick -> Printf.bprintf buf "%c%s" char5 (utf_to_dc nick) );
(*if !verbose_msg_clients then lprintf_nl "Sending: (%s)" (Buffer.contents
buf)*)
end
@@ -891,19 +890,19 @@
let m = dc_decode_chat message in
m
in {
- dest = Charset.to_utf8 dest;
- from = Charset.to_utf8 from;
- message = Charset.to_utf8 m;
+ dest = dc_to_utf dest;
+ from = dc_to_utf from;
+ message = dc_to_utf m;
}
| _ -> raise Not_found )
end
let print t = lprintf_nl "$To (%s) (%s) (%s)" t.dest t.from t.message
let write buf t =
let m = dc_encode_chat t.message in
- let from = Charset.convert Charset.UTF_8 Charset.CP1252 t.from in
+ let from = utf_to_dc t.from in
Printf.bprintf buf " %s From: %s $<%s> %s"
- (Charset.convert Charset.UTF_8 Charset.CP1252 t.dest) from from
- (Charset.convert Charset.UTF_8 Charset.CP1252 m)
+ (utf_to_dc t.dest) from from
+ (utf_to_dc m)
end
module UGetBlock = struct
@@ -915,10 +914,7 @@
let parse s =
(match String2.splitn s ' ' 2 with
| [pos; bytes; filename ] ->
- let filename =
- if Charset.is_utf8 filename then filename
- else Charset.to_utf8 filename
- in
+ let filename = dc_to_utf filename in
{
ufilename = filename;
ubytes = Int64.of_string bytes;
@@ -1021,7 +1017,7 @@
| "$GetNickList" -> GetNickListReq
| "$Hello" -> HelloReq (Hello.parse args)
| "$HubName" -> HubNameReq (HubName.parse args)
- | "$HubTopic" -> HubTopicReq (Charset.to_utf8 args)
+ | "$HubTopic" -> HubTopicReq (dc_to_utf args)
| "$Key" -> KeyReq (Key.parse args)
| "$Lock" -> LockReq (Lock.parse args)
| "$LogedIn" -> LogedInReq args
@@ -1070,17 +1066,17 @@
| CanceledReq -> Canceled.write buf ()
| ConnectToMeReq t -> Buffer.add_string buf "$ConnectToMe";
ConnectToMe.write buf t
| DirectionReq t -> Direction.write buf t
- | ErrorReq s -> Printf.bprintf buf "$Error <%s>" (Charset.convert
Charset.UTF_8 Charset.CP1252 s)
+ | ErrorReq s -> Printf.bprintf buf "$Error <%s>" (utf_to_dc s)
| FailedReq s -> Printf.bprintf buf "$Failed <%s>" s (*UTF8*)
| FileLengthReq t -> FileLength.write buf t
- | ForceMoveReq t -> Buffer.add_string buf "$ForceMove"; ForceMove.write buf t
+ | ForceMoveReq t -> ForceMove.write buf t
| GetListLenReq -> GetListLen.write buf ()
| GetNickListReq -> Buffer.add_string buf "$GetNickList"
| GetPassReq -> ()
| GetReq t -> Get.write buf t
- | HelloReq t -> Buffer.add_string buf "$Hello"; Hello.write buf t
+ | HelloReq t -> Hello.write buf t
| HubIsFullReq -> ()
- | HubNameReq t -> Buffer.add_string buf "$HubName"; HubName.write buf t
+ | HubNameReq t -> HubName.write buf t
| HubTopicReq s -> ()
| LockReq t -> Buffer.add_string buf "$Lock"; Lock.write buf t
| LogedInReq s -> ()
@@ -1094,7 +1090,7 @@
| MyPassReq s -> Printf.bprintf buf "$MyPass %s" s
| NickListReq t -> NickList.write buf t
| OpListReq t -> OpList.write buf t
- | QuitReq t -> Buffer.add_string buf "$Quit"; Quit.write buf t
+ | QuitReq t -> Quit.write buf t
| RevConnectToMeReq t -> RevConnectToMe.write buf t
| SearchReq t -> Buffer.add_string buf "$Search"; Search.write buf t
| SendReq -> Send.write buf ()
Index: src/networks/direct_connect/dcServers.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/direct_connect/dcServers.ml,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -b -r1.18 -r1.19
--- src/networks/direct_connect/dcServers.ml 4 Apr 2010 09:14:47 -0000
1.18
+++ src/networks/direct_connect/dcServers.ml 23 May 2010 09:12:15 -0000
1.19
@@ -171,7 +171,8 @@
(match m with
| BadPassReq ->
- if !verbose_msg_servers then lprintf_nl "Bad password for server: %s"
(Ip.string_of_addr s.server_addr);
+ if !verbose_msg_servers then
+ lprintf_nl "Bad password for %S on %s" s.server_last_nick
(Ip.string_of_addr s.server_addr);
s.server_hub_state <- User
| ConnectToMeReq t -> (* client is unknown at this moment until $MyNick is
received *)
@@ -189,7 +190,8 @@
if !verbose_unexpected_messages then lprintf_nl "%s in ConnectToMe
sending" (Printexc2.to_string e) )
| ForceMoveReq t ->
- disconnect_server s (Closed_for_error "Forcemove command received");
+ lprintf_nl "Received ForceMove(%S) from %s" t (Ip.string_of_addr
s.server_addr);
+ disconnect_server s (Closed_for_error "Forcemove command received")
| GetPassReq -> (* After password request from hub ... *)
let addr = Ip.string_of_addr s.server_addr in
@@ -545,10 +547,10 @@
end;
incr counter;
let r = {
- dc_name = Charset.to_utf8 server_name;
+ dc_name = Charset.Locale.to_utf8 server_name;
dc_ip = Ip.addr_of_string !addr;
dc_port = !port;
- dc_info = Charset.to_utf8 server_info;
+ dc_info = Charset.Locale.to_utf8 server_info;
dc_nusers = !nusers;
} in
hublist := r :: !hublist
@@ -575,9 +577,9 @@
let make_hublist_from_xml x =
let make_hub x =
- let name = Charset.to_utf8 (Xml.attrib x "Name") in
+ let name = Charset.Locale.to_utf8 (Xml.attrib x "Name") in
let (address,port) = parse_address (Xml.attrib x "Address") in
- let info = Charset.to_utf8 (Xml.attrib x "Description") in
+ let info = Charset.Locale.to_utf8 (Xml.attrib x "Description") in
let nusers = int_of_string (Xml.attrib x "Users") in
{
dc_name = name;
Index: src/networks/direct_connect/dcShared.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/direct_connect/dcShared.ml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- src/networks/direct_connect/dcShared.ml 8 Apr 2010 19:01:34 -0000
1.4
+++ src/networks/direct_connect/dcShared.ml 23 May 2010 09:12:15 -0000
1.5
@@ -134,7 +134,7 @@
(* Compress string to Che3 and write to file *)
let string_to_che3_to_file str filename =
(try
- let s = Che3.compress (Charset.convert Charset.UTF_8 Charset.CP1252 str) in
+ let s = Che3.compress (DcProtocol.utf_to_dc str) in
let wlen = 4096 in
(*let str = String.create slen in*)
let slen = String.length s in
Index: src/utils/lib/charset.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/lib/charset.ml,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -b -r1.9 -r1.10
--- src/utils/lib/charset.ml 8 Oct 2006 14:12:13 -0000 1.9
+++ src/utils/lib/charset.ml 23 May 2010 09:12:15 -0000 1.10
@@ -172,7 +172,7 @@
(**********************************************************************************)
(* taken from camomile *)
-(* $Id: charset.ml,v 1.9 2006/10/08 14:12:13 spiralvoice Exp $ *)
+(* $Id: charset.ml,v 1.10 2010/05/23 09:12:15 spiralvoice Exp $ *)
(* Copyright 2002, 2003 Yamagata Yoriyuki. distributed with LGPL *)
let utf8_look s i =
@@ -254,7 +254,7 @@
(**********************************************************************************)
(* taken from camomile *)
-(* $Id: charset.ml,v 1.9 2006/10/08 14:12:13 spiralvoice Exp $ *)
+(* $Id: charset.ml,v 1.10 2010/05/23 09:12:15 spiralvoice Exp $ *)
(* Copyright 2002, 2003 Yamagata Yoriyuki. distributed with LGPL *)
let rec length_aux s c i =
@@ -281,7 +281,7 @@
(* taken from camomile *)
-(* $Id: charset.ml,v 1.9 2006/10/08 14:12:13 spiralvoice Exp $ *)
+(* $Id: charset.ml,v 1.10 2010/05/23 09:12:15 spiralvoice Exp $ *)
(* Copyright 2002, 2003 Yamagata Yoriyuki. distributed with LGPL *)
external uint_code : uchar -> int = "%identity"
@@ -1646,21 +1646,42 @@
[I_863; CP863; IBM863; CSIBM863];
]
-let locale =
+let convert ~from_charset ~to_charset s =
+ if s <> "" then begin
+ let t = charset_to_string to_charset in
+ let f = charset_to_string from_charset in
+ convert_string s t f
+ end else s
+
+let safe_convert enc s =
+ match enc with
+ | "" -> s
+ | enc ->
try
- let cs = get_charset () in
- charset_from_string cs
- with _ -> ASCII
+ convert
+ ~from_charset: (charset_from_string enc)
+ ~to_charset:UTF_8
+ s
+ with _ -> s
+
+(* Locale specific conversions *)
+module Locale = struct
-let locstr =
+(* FIXME move away! *)
+let () =
(* block signals until core started correctly *)
(MlUnix.set_signal Sys.sigint
(Sys.Signal_handle (fun _ -> ())));
(MlUnix.set_signal Sys.sigterm
- (Sys.Signal_handle (fun _ -> ())));
+ (Sys.Signal_handle (fun _ -> ())))
- let s = charset_to_string locale in
- s
+let locale =
+ try
+ let cs = get_charset () in
+ charset_from_string cs
+ with _ -> ASCII
+
+let locale_string = charset_to_string locale
let (enc_list : string list ref) = ref []
let nenc = ref 0
@@ -1699,12 +1720,6 @@
]
*)
-(**********************************************************************************)
-(*
*)
-(* charset_list_from_language
*)
-(*
*)
-(**********************************************************************************)
-
(* See
http://www.gnu.org/software/gettext/manual/html_chapter/gettext_15.html#SEC221
* The strategy is not perfect. Any comment to improve it, is highly
appreciated.
* The charset list shall be improved according to the language detected on the
@@ -1788,12 +1803,6 @@
in
List.flatten !li
-(**********************************************************************************)
-(*
*)
-(* set_default_charset_list
*)
-(*
*)
-(**********************************************************************************)
-
let set_default_charset_list (lang : string) =
(* Let's get rid of charset aliases *)
let l = List.map (fun li -> List.hd li) (charset_list_from_language lang) in
@@ -1804,38 +1813,8 @@
) !enc_list; *)
nenc := List.length !enc_list
-(**********************************************************************************)
-(*
*)
-(* convert
*)
-(*
*)
-(**********************************************************************************)
-
let conversion_enabled = ref true
-let convert ~from_charset ~to_charset s =
- if s <> "" then begin
- let t = charset_to_string to_charset in
- let f = charset_to_string from_charset in
- convert_string s t f
- end else s
-
-let safe_convert enc s =
- match enc with
- "" -> s
- | enc ->
- try
- convert
- ~from_charset: (charset_from_string enc)
- ~to_charset: (charset_from_string "UTF-8")
- s
- with _ -> s
-
-(**********************************************************************************)
-(*
*)
-(* slow_encode_from_utf8
*)
-(*
*)
-(**********************************************************************************)
-
let slow_encode_from_utf8 s to_codeset =
let us = ref "" in
let slen = utf8_length s in
@@ -1853,12 +1832,6 @@
done;
!us
-(**********************************************************************************)
-(*
*)
-(* slow_encode
*)
-(*
*)
-(**********************************************************************************)
-
let slow_encode s to_codeset =
if is_utf8 s
then slow_encode_from_utf8 s to_codeset
@@ -1867,19 +1840,13 @@
let slen = String.length s in
for i = 0 to (slen - 1) do
try
- us := !us ^ (convert_string (String.sub s i 1) to_codeset locstr)
+ us := !us ^ (convert_string (String.sub s i 1) to_codeset
locale_string)
with _ ->
us := !us ^ char_const
done;
!us
end
-(**********************************************************************************)
-(*
*)
-(* fast_encode
*)
-(*
*)
-(**********************************************************************************)
-
let fast_encode s to_codeset =
let rec iter i n =
if i = n
@@ -1891,12 +1858,6 @@
with _ -> iter (i + 1) !nenc
in iter 0 !nenc
-(**********************************************************************************)
-(*
*)
-(* to_utf8
*)
-(*
*)
-(**********************************************************************************)
-
let to_utf8 s =
if s = ""
then s
@@ -1904,12 +1865,6 @@
then s
else fast_encode s "UTF-8"
-(**********************************************************************************)
-(*
*)
-(* to_locale
*)
-(*
*)
-(**********************************************************************************)
-
let to_locale s =
if s = "" || not !conversion_enabled
then s
@@ -1920,11 +1875,14 @@
| _ ->
begin
try
- convert_string s locstr "UTF-8"
+ convert_string s locale_string "UTF-8"
with _ ->
- slow_encode_from_utf8 s locstr
+ slow_encode_from_utf8 s locale_string
end
end
-let _ =
+let () =
set_default_charset_list default_language
+
+end (* Locale *)
+
Index: src/utils/lib/charset.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/lib/charset.mli,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- src/utils/lib/charset.mli 8 Oct 2006 14:12:14 -0000 1.5
+++ src/utils/lib/charset.mli 23 May 2010 09:12:15 -0000 1.6
@@ -138,9 +138,18 @@
| I_869 | CP_GR | CP869 | IBM869 | CSIBM869
| CP1125
+(** @return ASCII if nothing matches *)
+val charset_from_string : string -> charset
+
+val charset_to_string : charset -> string
+
(** [convert ~from_charset ~to_charset s]
- raise CharsetError if the string s is not entirely convertible. *)
+ @raise CharsetError if the string s is not entirely convertible. *)
val convert : from_charset : charset -> to_charset : charset -> string ->
string
+
+(** [safe_convert enc s] convert [s] from encoding [enc] to UTF-8.
+ Return unmodified string if conversion fails.
+ *)
val safe_convert: string -> string -> string
(** [is_utf8 s]
@@ -149,14 +158,6 @@
to test their validity for strings from untrusted origins. *)
val is_utf8 : string -> bool
-(** [to_utf8 s]
- Converts the input string to UTF-8. *)
-val to_utf8 : string -> string
-
-(** [to_locale s]
- Converts the input string to the encoding of the current locale. *)
-val to_locale : string -> string
-
(** [utf8_get s n]
returns [n]-th Unicode character of [s].
The call requires O(n)-time. *)
@@ -170,6 +171,20 @@
add one Unicode character to the buffer. *)
val add_uchar : Buffer.t -> uchar -> unit
+(** Locale dependent conversions *)
+module Locale : sig
+
+(** [to_utf8 s]
+ Converts the input string to UTF-8. *)
+val to_utf8 : string -> string
+
+(** [to_locale s]
+ Converts the input string to the encoding of the current locale. *)
+val to_locale : string -> string
+
val default_language : string
-val locstr : string
+val locale_string : string
val conversion_enabled : bool ref
+
+end
+
Index: src/utils/lib/gettext.ml4
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/lib/gettext.ml4,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -b -r1.10 -r1.11
--- src/utils/lib/gettext.ml4 25 Mar 2007 12:37:09 -0000 1.10
+++ src/utils/lib/gettext.ml4 23 May 2010 09:12:15 -0000 1.11
@@ -388,7 +388,7 @@
let filename =
let extension = try
Unix.getenv "LANG"
- with _ -> (Charset.default_language ^ "_" ^ Charset.locstr)
+ with _ -> (Charset.Locale.default_language ^ "_" ^
Charset.Locale.locale_string)
in
Printf.sprintf "%s.%s" filename extension
in
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Mldonkey-commits] mldonkey config/Makefile.in distrib/ChangeLog s...,
mldonkey-commits <=