diff options
Diffstat (limited to 'net-p2p')
| -rw-r--r-- | net-p2p/mldonkey-devel/Makefile | 3 | ||||
| -rw-r--r-- | net-p2p/mldonkey-devel/distinfo | 6 | ||||
| -rw-r--r-- | net-p2p/mldonkey-devel/files/patch-cvs-2007021000 | 11901 |
3 files changed, 4 insertions, 11906 deletions
diff --git a/net-p2p/mldonkey-devel/Makefile b/net-p2p/mldonkey-devel/Makefile index 28198b9ff535..bbbec00f39f1 100644 --- a/net-p2p/mldonkey-devel/Makefile +++ b/net-p2p/mldonkey-devel/Makefile @@ -6,8 +6,7 @@ # PORTNAME= mldonkey -PORTVERSION= 2.8.2 -PORTREVISION= 1 +PORTVERSION= 2.8.3 CATEGORIES+= net-p2p MASTER_SITES= ${MASTER_SITE_SOURCEFORGE_EXTENDED} \ ${MASTER_SITE_SAVANNAH} diff --git a/net-p2p/mldonkey-devel/distinfo b/net-p2p/mldonkey-devel/distinfo index adbd3292e7b7..555fdd148cb7 100644 --- a/net-p2p/mldonkey-devel/distinfo +++ b/net-p2p/mldonkey-devel/distinfo @@ -1,3 +1,3 @@ -MD5 (mldonkey-2.8.2.tar.bz2) = 123aeb79a3ca91a4943b59f044e98d4a -SHA256 (mldonkey-2.8.2.tar.bz2) = 51efc1c339b8cbafde93f4444f18e4243f41008b1c4107a41602542e9eeaa68e -SIZE (mldonkey-2.8.2.tar.bz2) = 2652074 +MD5 (mldonkey-2.8.3.tar.bz2) = 415eec223b97f50e6bbc4126980b3836 +SHA256 (mldonkey-2.8.3.tar.bz2) = 454860f3dddd7e72eb97bcb57a7d2aef9b509cf0d989e0dc0c2f5f38b335663f +SIZE (mldonkey-2.8.3.tar.bz2) = 2659818 diff --git a/net-p2p/mldonkey-devel/files/patch-cvs-2007021000 b/net-p2p/mldonkey-devel/files/patch-cvs-2007021000 deleted file mode 100644 index 4e406feb06d5..000000000000 --- a/net-p2p/mldonkey-devel/files/patch-cvs-2007021000 +++ /dev/null @@ -1,11901 +0,0 @@ -Index: config/Makefile.in -=================================================================== -RCS file: /sources/mldonkey/mldonkey/config/Makefile.in,v -retrieving revision 1.173 -retrieving revision 1.175 -diff -u -r1.173 -r1.175 ---- config/Makefile.in 21 Nov 2006 22:29:58 -0000 1.173 -+++ config/Makefile.in 15 Jan 2007 18:27:21 -0000 1.175 -@@ -148,7 +148,7 @@ - $(CDK)/filepath.ml $(CDK)/string2.ml \ - $(CDK)/filename2.ml $(CDK)/list2.ml $(CDK)/hashtbl2.ml \ - $(CDK)/unix2.ml $(CDK)/file.ml \ -- $(CDK)/heap_c.c $(CDK)/array2.ml $(CDK)/sort2.ml -+ $(CDK)/heap_c.c $(CDK)/array2.ml - - ifneq ("$(PTHREAD_CFLAGS)" , "") - CFLAGS += $(PTHREAD_CFLAGS) -@@ -1245,7 +1245,7 @@ - $(PROGRESS_SRCS) $(MAIN_SRCS) - - TARGETS += mlgui$(EXE) mlguistarter$(EXE) --ifeq ("$(GUI)", "newgui") -+ifeq ("$(GUI)", "newgui1") - TARGETS += mlprogress$(EXE) - endif - -Index: config/configure.in -=================================================================== -RCS file: /sources/mldonkey/mldonkey/config/configure.in,v -retrieving revision 1.289 -retrieving revision 1.290 -diff -u -r1.289 -r1.290 ---- config/configure.in 28 Nov 2006 23:17:31 -0000 1.289 -+++ config/configure.in 11 Jan 2007 12:15:37 -0000 1.290 -@@ -1257,7 +1257,7 @@ - else - echo "Do you want this script to try to download and install $LABLGTK_NAME" - echo "LOCALLY in mldonkey directory ?" -- if test "$BATCH" = "no"; then read i; else i=yes; fi -+ if test "$BATCH" = "no"; then read i <&1; else i=yes; fi - case "$i" in - y* | Y*) - -Index: distrib/ChangeLog -=================================================================== -RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v -retrieving revision 1.1118 -retrieving revision 1.1174 -diff -u -r1.1118 -r1.1174 ---- distrib/ChangeLog 28 Nov 2006 23:17:31 -0000 1.1118 -+++ distrib/ChangeLog 6 Feb 2007 22:26:58 -0000 1.1174 -@@ -14,6 +14,142 @@ - ChangeLog - ========= - -+2007/02/06 -+5719: Unix2: Fix copying files > 1GB (1073741823 bytes), -+ bug was introduced by patch 5589 after release of 2.8.2 -+ -+2007/02/04 -+5724: http_client: Retry GET request if HEAD request returns http error 400 -+5723: HTML: print tracker errors in html table at 'vd <num>' (Schlumpf) -+5722: HTML: use Printf2.html_mods_cntr () for table row classes (Schlumpf) -+5720: Swarmer: block choice algorithm 2 from patch 5141 is new default -+- remove swarming_block_selection_algorithm = 1 -+ because it finishes chunks too slowly -+- remove swarming_block_selection_algorithm = 3 from TripleM -+ because it uses too much CPU power. -+- remove option swarming_block_selection_algorithm, hard-coded default is now 2 -+- remove option block_switching, hard-coded default is now true -+ -+2007/01/30 -+5717: Optimize function print_command_result -+ -+2007/01/28 -+5715: Improve porttest (Schlumpf) -+- use 'porttest' command to start the network porttest the first time, -+ after this to see the results -+- new command 'force_porttest' to force an new porttest -+- improve html porttest output and make it also available in telnet -+5716: EDK: Do not send share list to servers with state Connecting -+5713: HTML: show messages link in vd clickable (Schlumpf) -+ -+2007/01/25 -+5712: Multiuser: New verbosity "com" to log commands by non-admin users -+5711: Multiuser: Block commands preferred, bs, bp, port for non-admin users -+5642: Swarmer: swarming_block_selection_algorithm = 3 (TripleM) -+- this new algorithm select always the rarest choice, if average availability -+ is below 5, or one choice_availability is below average availability -+- added a hashtable to store blockmaps of uploaders for a given swarmer -+- long term memory usage has to be observed -+5710: Swarmer: Fix chunk propagation (pango) -+ -+2007/01/21 -+5693: "voo changed" prints changed options only, useful for support (Schlumpf) -+5698: EDK: fix display of porttest result images (Schlumpf) -+5699: Multiuser: Fix wrong file path (user_commit_dir) in notification mail -+5695: Command "set": better error text if option does not exist -+5694: Fix small typo in buildinfo -+ -+2007/01/17 -+5673: New core start parameter: -useradd "user pass", needed for Debian package -+5678: New options for command force_web_infos: kind/URL (thx to Schlumpf) -+ -+2007/01/15 -+5691: EDK: Recognize compatibleclient 60: IMPmule (imp-project.net) -+5689: EDK: Log downloading file name when client disconnects -+5684: GUI: Fix build of mlprogress (Alt linux) -+5677: Options: New concept of option types, fix non-admin Sancho http preview -+ -+2007/01/11 -+5665: EDK: Support compressed upload, implement file read cache (TripleM) -+new options: -+- ED2K_upload_compression to enable compressed upload, default true -+- ED2K_upload_compression_threshold, default 2000 bytes -+ Size difference in bytes between one zone (180 kBytes) and its compressed -+ counterpart, which has to occure, to send compressed parts instead of plain. -+- ED2K_upload_compression_level, Zlib compression level, default 9 -+- ED2K_upload_compression_table_size, default 20 -+5669: HTML: Add HTML headers to prohibit browser-side caching (Schlumpf) -+5671: Configure: Fix question whether to compile lablgtk, same as patch 5401 -+5675: Updated Mozilla protocol handler to version 1.10 -+ -+2007/01/08 -+5666: New option upload_complete_chunks (TripleM) -+- default false, if true, each client is allowed to complete only one chunk, -+ independent, if it is empty or partial. this setting overrides -+ upload_full_chunks and dynamic_upload_lifetime, but is, as a failsafe, -+ limited by upload_lifetime (should be set reasonable high) -+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. -+ Well, not exactly one chunk. eMule has this code in opcode.h: -+ #define SESSIONMAXTRANS (PARTSIZE+20*1024) // -+ "Try to send complete chunks" always sends this amount of data -+ MLdonkey now does the same, if upload_full_chunks is true and client A got -+ 9728000+20*1024 bytes during the current session its upload slot will be -+ revoked unless pending slots are empty. -+5619: EDK: Print network specific infos in command "vc <num>", -+ remove unneeded fields from client structures -+5627: commonHasher: fix wrong arg types from several functions (Schlumpf) -+5626: MinGW: fix missing declarations and wrong pointer -+ initialization in stubs_c.c (Schlumpf) -+ -+2007/01/06 -+5599: EDK: Support for files >4GB (TripleM, pango) -+- this patch does not include >4GB support for Kademlia -+5660: Swarming: Enable wrongly disabled select block memoization (pango) -+5659: GD: Fix wrong months display (skeeve) -+ -+2006/12/08 -+5617: New option share_scan_interval -+- how often (in minutes) should MLDonkey scan all shared directories -+ for new/removed files, default one minute -+- on slow machines raise the interval to a higher value to reduce CPU load -+- to force a re-scan of shared directories use command "reshare" -+ -+2006/12/06 -+5613: Another longhelp cleanup (anhi) -+5615: EDK: Parse more fields from server.met files -+ -+2006/12/04 -+5612: EDK: OP_HELLO tag 0x75, print os_info in logfile -+ -+2006/12/03 -+5602: HTML: Display share status in upstats -+5609: New field type Field_KNOWN, EDK: recognize more HELLO/EmuleInfo tags -+5610: CommonSources: Cleanups and reformatting the code (pango) -+ -+2006/12/02 -+5608: Multiuser, chgrp: Prevent change of file_group to None -+ if the user is not file_owner -+5607: Multiuser, chown: Change file_group to user_default_group -+ if the new user is not member of file_group -+5606: Introduce display of session transfer values -+- new columns for session up-/download -+- send session values to GUIs -+ -+2006/12/01 -+5605: HTML: Fix search list display when html_checkbox_search_file_list = true -+ -+2006/11/29 -+5598: Remove use of deprecated sort module, remove unused sort2.ml* (pango) -+5589: New option create_file_mode, -+ rename create_dir_mask to create_dir_mode (pango) -+5595: EDK: Fully parse emule_miscoptions1/2 -+5594: EDK: If update_server_list_client true, add yet unknown server -+ of lowid clients -+------------------------------------------------------------------------------- - 2006/11/29 version 2.8.2 = tag release-2-8-2 - 5597: GD: New option html_mods_vd_gfx_h_intervall - (compute values for hourly graph every x minutes) (skeeve) -Index: distrib/ed2k_mozilla/README -=================================================================== -RCS file: /sources/mldonkey/mldonkey/distrib/ed2k_mozilla/README,v -retrieving revision 1.8 -retrieving revision 1.9 -diff -u -r1.8 -r1.9 ---- distrib/ed2k_mozilla/README 23 Oct 2006 12:58:35 -0000 1.8 -+++ distrib/ed2k_mozilla/README 11 Jan 2007 12:14:48 -0000 1.9 -@@ -1,4 +1,4 @@ --Firefox MLdonkey/eMule Protocol Handler 1.8 -+Firefox MLdonkey/eMule Protocol Handler 1.10 - Copyright (C) 2003 - 2006 Simon Peter <dn.tlp@gmx.net> - - Description: -@@ -88,9 +88,16 @@ - - News: - ----- -+Changes for version 1.10: -+- Fixed another problem with the port GUI configuration option (thanks -+ to Toni Cunat). -+ -+Changes for version 1.9: -+- Fixed port GUI configuration option (thanks to Dennis Plöger). -+ - Changes for version 1.8: - - Support for GUI configuration through Firefox' extensions menu -- (thanks to David Ciecierski <dawid.ciecierski@googlemail.com>). -+ (thanks to David Ciecierski). - - ATTENTION upgraders: If you manually set configuration options - through the about:config dialog for a previous version of this -@@ -119,7 +126,7 @@ - - Changes for version 1.4: - - Added compatibility for the new component system of Firefox 0.9 -- (thanks to Len Walter <len@unsw.edu.au>). -+ (thanks to Len Walter). - - Username is now empty by default. - - Changes for version 1.3: -@@ -161,9 +168,10 @@ - - Contributor(s): - Sven Koch --Len Walter <len@unsw.edu.au> --Dan Fritz <templar_of_ni@yahoo.se> --David Ciecierski <dawid.ciecierski@gmail.com> -+Len Walter -+Dan Fritz -+David Ciecierski -+Dennis Plöger - - Alternatively, the contents of this file may be used under the terms of - either the GNU General Public License Version 2 or later (the "GPL"), or -Index: src/daemon/common/commonClient.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonClient.ml,v -retrieving revision 1.33 -retrieving revision 1.35 -diff -u -r1.33 -r1.35 ---- src/daemon/common/commonClient.ml 5 Nov 2006 14:09:38 -0000 1.33 -+++ src/daemon/common/commonClient.ml 8 Jan 2007 11:06:42 -0000 1.35 -@@ -76,6 +76,9 @@ - mutable op_client_dprint_html : ('a -> CommonTypes.ui_conn -> - CommonTypes.file -> string -> bool); - -+(* used to print network specific client infos *) -+ mutable op_client_print_info : ('a -> CommonTypes.ui_conn -> unit); -+ - mutable op_client_debug : ('a -> bool -> unit); - - mutable op_client_can_upload : ('a -> int -> unit); -@@ -159,6 +162,10 @@ - let client = as_client_impl client in - client.impl_client_ops.op_client_dprint_html client.impl_client_val o file str - -+let client_print_info (client: client) o = -+ let c = as_client_impl client in -+ c.impl_client_ops.op_client_print_info c.impl_client_val o -+ - let client_connect client= - let client = as_client_impl client in - client.impl_client_ops.op_client_connect client.impl_client_val -@@ -188,7 +195,7 @@ - s - - let fni n m = failwith (ni n m) -- let ni_ok n m = ignore (ni n m) -+let ni_ok n m = ignore (ni n m) - - let clients_ops = ref [] - -@@ -207,6 +214,7 @@ - op_client_bprint = (fun _ _ -> ni_ok network "client_bprint"); - op_client_dprint = (fun _ _ _ -> ni_ok network "client_dprint"); - op_client_dprint_html = (fun _ _ _ _ -> fni network "client_dprint_html"); -+ op_client_print_info = (fun _ _ -> fni network "client_print_info"); - op_client_can_upload = (fun _ _ -> ni_ok network "client_can_upload"); - op_client_enter_upload_queue = (fun _ -> ni_ok network "client_enter_upload_queue"); - } in -@@ -467,16 +475,15 @@ - try - let i = client_info c in - let ctime = ((BasicSocket.last_time ()) - i.GuiTypes.client_connect_time) / 60 in -- if i.GuiTypes.client_uploaded = Int64.zero && ctime > 1 then -+ if i.GuiTypes.client_session_uploaded = Int64.zero && ctime > 1 then - begin - client_disconnect c; -- if !verbose then lprintf_nl "disconnected client %d: [%s %s] %s after %d %s of silence." -+ if !verbose then lprintf_nl "disconnected client %d: [%s %s] %s after %d minute%s of silence." - (client_num c) - (GuiTypes.client_software i.GuiTypes.client_software i.GuiTypes.client_os) - i.GuiTypes.client_release - i.GuiTypes.client_name -- ctime -- (if ctime = 1 then "minute" else "minutes") -+ ctime (Printf2.print_plural_s ctime) - end - with _ -> () - ) !uploaders -@@ -491,7 +498,6 @@ - T.client_tags = []; - T.client_name = ""; - T.client_network = 0; -- T.client_files = None; - T.client_rating = 0; - T.client_chat_port = 0; - T.client_connect_time = BasicSocket.last_time (); -@@ -500,8 +506,11 @@ - T.client_os = None; - T.client_release = ""; - T.client_emulemod = ""; -- T.client_downloaded = 0L; -- T.client_uploaded = 0L; -+ T.client_total_downloaded = 0L; -+ T.client_total_uploaded = 0L; -+ T.client_session_downloaded = 0L; -+ T.client_session_uploaded = 0L; - T.client_upload = None; - T.client_sui_verified = None; -+ T.client_file_queue = []; - } -Index: src/daemon/common/commonClient.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonClient.mli,v -retrieving revision 1.13 -retrieving revision 1.14 -diff -u -r1.13 -r1.14 ---- src/daemon/common/commonClient.mli 25 Oct 2006 11:12:38 -0000 1.13 -+++ src/daemon/common/commonClient.mli 8 Jan 2007 11:06:42 -0000 1.14 -@@ -24,12 +24,14 @@ - 'a -> CommonTypes.ui_conn -> CommonTypes.file -> unit; - mutable op_client_dprint_html : - 'a -> CommonTypes.ui_conn -> CommonTypes.file -> string -> bool; -+ mutable op_client_print_info : 'a -> CommonTypes.ui_conn -> unit; - mutable op_client_debug : 'a -> bool -> unit; - mutable op_client_can_upload : 'a -> int -> unit; - mutable op_client_enter_upload_queue : 'a -> unit; - } - val client_print_html : CommonTypes.client -> CommonTypes.ui_conn -> unit - val client_print : CommonTypes.client -> CommonTypes.ui_conn -> unit -+val client_print_info : CommonTypes.client -> CommonTypes.ui_conn -> unit - val client_must_update : CommonTypes.client -> unit - val client_info : CommonTypes.client -> GuiTypes.client_info - val client_say : CommonTypes.client -> string -> unit -Index: src/daemon/common/commonComplexOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonComplexOptions.ml,v -retrieving revision 1.69 -retrieving revision 1.70 -diff -u -r1.69 -r1.70 ---- src/daemon/common/commonComplexOptions.ml 21 Nov 2006 22:34:33 -0000 1.69 -+++ src/daemon/common/commonComplexOptions.ml 6 Feb 2007 22:26:58 -0000 1.70 -@@ -962,8 +962,6 @@ - [default_incoming_directories] - | l -> l - --exception Incoming_full -- - let incoming_dir usedir ?user ?needed_space ?network () = - - let directories = -@@ -994,12 +992,13 @@ - in - - let checkdir = -+ let module U = Unix.LargeFile in - try - List.find (fun d -> - let dirname = compute_dir_name d.shdir_dirname in - (* check if temp_directory and incoming are on different partitions *) - try -- if (Unix.stat dirname).Unix.st_dev <> (Unix.stat !!temp_directory).Unix.st_dev then -+ if (U.stat dirname).U.st_dev <> (U.stat !!temp_directory).U.st_dev then - begin - match needed_space with - | None -> true -@@ -1100,8 +1099,9 @@ - Unix2.tryopen_write_zip archive (fun oc -> - List.iter (fun file -> - try -- let s = Unix.stat file in -- Zip.copy_file_to_entry file oc ~level:9 ~mtime:s.Unix.st_mtime file -+ let module U = Unix.LargeFile in -+ let s = U.stat file in -+ Zip.copy_file_to_entry file oc ~level:9 ~mtime:s.U.st_mtime file - with e -> - failwith (Printf.sprintf "Zip: error %s in %s" (Printexc2.to_string e) file) - ) files) -Index: src/daemon/common/commonFile.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonFile.ml,v -retrieving revision 1.70 -retrieving revision 1.71 -diff -u -r1.70 -r1.71 ---- src/daemon/common/commonFile.ml 15 Nov 2006 12:37:13 -0000 1.70 -+++ src/daemon/common/commonFile.ml 2 Dec 2006 12:35:45 -0000 1.71 -@@ -399,8 +399,8 @@ - ("", "sr br", addr); - (GuiTypes.client_software cinfo.GuiTypes.client_software cinfo.GuiTypes.client_os, - "sr br", GuiTypes.client_software_short cinfo.GuiTypes.client_software cinfo.GuiTypes.client_os); -- ("", "sr ar", (size_of_int64 cinfo.GuiTypes.client_uploaded)); -- ("", "sr ar br", (size_of_int64 cinfo.GuiTypes.client_downloaded)); ]; -+ ("", "sr ar", (size_of_int64 cinfo.GuiTypes.client_total_uploaded)); -+ ("", "sr ar br", (size_of_int64 cinfo.GuiTypes.client_total_downloaded)); ]; - - Printf.bprintf buf "\\</tr\\>"; - -Index: src/daemon/common/commonFile.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonFile.mli,v -retrieving revision 1.30 -retrieving revision 1.31 -diff -u -r1.30 -r1.31 ---- src/daemon/common/commonFile.mli 12 Nov 2006 12:44:24 -0000 1.30 -+++ src/daemon/common/commonFile.mli 3 Dec 2006 20:57:56 -0000 1.31 -@@ -129,7 +129,6 @@ - val set_file_comment : CommonTypes.file -> string -> unit - val file_comment : CommonTypes.file -> string - val file_magic : CommonTypes.file -> string option --val set_file_magic : CommonTypes.file -> string option -> unit - val check_magic : CommonTypes.file -> unit - val recover_bytes : CommonTypes.file -> (int64 * int64) list - val file_write : CommonTypes.file -> int64 -> string -> int -> int -> unit -Index: src/daemon/common/commonGlobals.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonGlobals.ml,v -retrieving revision 1.77 -retrieving revision 1.81 -diff -u -r1.77 -r1.81 ---- src/daemon/common/commonGlobals.ml 28 Nov 2006 23:15:21 -0000 1.77 -+++ src/daemon/common/commonGlobals.ml 6 Feb 2007 22:26:58 -0000 1.81 -@@ -263,6 +263,7 @@ - let user_socks = ref ([] : TcpBufferedSocket.t list) - let dialog_history = ref ([] : (int * string * string) list ) - -+exception Incoming_full - - let want_and_not andnot f none value = - (* lprintf "want_and_not [%s]\n" value; *) -@@ -398,6 +399,7 @@ - | Field_Completesources -> "completesources" - | Field_Filename -> "filename" - | Field_Size -> "size" -+ | Field_Size_Hi -> "size_hi" - | Field_Uid -> "uid" - | Field_Bitrate -> "bitrate" - | Field_Codec -> "codec" -@@ -405,6 +407,7 @@ - | Field_Lastseencomplete -> "lastcompl" - | Field_Medialength -> "mlen" - | Field_Mediacodec -> "mediacodec" -+ | Field_KNOWN s -> s - | Field_UNKNOWN s -> s - - let field_of_string t = -@@ -419,6 +422,7 @@ - | "completesources" -> Field_Completesources - | "filename" -> Field_Filename - | "size" -> Field_Size -+ | "size_hi" -> Field_Size_Hi - | "uid" -> Field_Uid - | "bitrate" -> Field_Bitrate - | "codec" -> Field_Codec -@@ -426,10 +430,11 @@ - | "lastcompl" -> Field_Lastseencomplete - | "mlen" -> Field_Medialength - | "mediacodec" -> Field_Mediacodec -- | _ -> Field_UNKNOWN t -+ | _ -> Field_KNOWN t - - let escaped_string_of_field tag = - match tag.tag_name with -+ | Field_KNOWN s -> String.escaped s - | Field_UNKNOWN s -> String.escaped s - | t -> string_of_field t - -@@ -438,6 +443,10 @@ - Printf.sprintf " \"%s\" = %s" (escaped_string_of_field tag) - (string_of_tag_value tag.tag_value) - -+let hexstring_of_tag tag = -+ Printf.sprintf " \"%s\" = %s" (String2.hex_string_of_string (escaped_string_of_field tag)) -+ (string_of_tag_value tag.tag_value) -+ - let rec print_tags tags = - match tags with - [] -> () -@@ -916,12 +925,12 @@ - let intern_table = StringIntern.create 1000 - let intern s = StringIntern.merge intern_table s - --let print_command_result o buf result = -+let print_command_result o result = - if use_html_mods o then -- html_mods_table_one_row buf "serversTable" "servers" [ -+ html_mods_table_one_row o.conn_buf "serversTable" "servers" [ - ("", "srh", result); ] - else -- Printf.bprintf buf "%s" result -+ Printf.bprintf o.conn_buf "%s" result - - let _ = - Heap.add_memstat "CommonGlobals" (fun level buf -> -Index: src/daemon/common/commonHasher.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonHasher.ml,v -retrieving revision 1.9 -retrieving revision 1.10 -diff -u -r1.9 -r1.10 ---- src/daemon/common/commonHasher.ml 18 Mar 2006 18:35:54 -0000 1.9 -+++ src/daemon/common/commonHasher.ml 15 Jan 2007 18:28:03 -0000 1.10 -@@ -20,6 +20,14 @@ - open Printf2 - open CommonOptions - -+let log_prefix = "[cHa]" -+ -+let lprintf_nl fmt = -+ lprintf_nl2 log_prefix fmt -+ -+let lprintf_n fmt = -+ lprintf2 log_prefix fmt -+ - type hash_method = MD4 | MD5 | SHA1 | TIGER - - type 'a job = { -@@ -46,14 +54,14 @@ - | None -> raise Not_found - | Some (job, fd) -> - if job_done job then begin -- if !verbose_md4 then lprintf_nl "[cHa] Finished %s job %s %Ld %Ld" -+ if !verbose_md4 then lprintf_nl "Finished %s job %s %Ld %Ld" - (match job.job_method with - MD5 -> "MD5" | TIGER -> "TIGER" | SHA1 -> "SHA1" | MD4 -> "MD4") - job.job_name job.job_begin job.job_len; - current_job := None; - Unix.close fd; - (try job.job_handler job with e -> -- lprintf_nl "[cHa] exception %s in job_handler" -+ lprintf_nl "exception %s in job_handler" - (Printexc2.to_string e); - ); - raise Not_found -@@ -72,7 +80,7 @@ - current_job := Some (job, fd); - job_start job fd; - with e -> -- lprintf_nl "[cHa] Exception %s in starting job" -+ lprintf_nl "Exception %s in starting job" - (Printexc2.to_string e); - ) - -Index: src/daemon/common/commonHasher_c.c -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonHasher_c.c,v -retrieving revision 1.11 -retrieving revision 1.12 -diff -u -r1.11 -r1.12 ---- src/daemon/common/commonHasher_c.c 9 Jan 2006 00:25:58 -0000 1.11 -+++ src/daemon/common/commonHasher_c.c 8 Jan 2007 11:03:09 -0000 1.12 -@@ -335,20 +335,20 @@ - long bsize; - switch(job_method) { - case METHOD_MD4: -- md4_unsafe64_fd_direct(job_fd, job_begin_pos, job_len, job_result); -+ md4_unsafe64_fd_direct(job_fd, job_begin_pos, job_len, p_job_result); - break; - - case METHOD_MD5: -- md5_unsafe64_fd_direct(job_fd, job_begin_pos, job_len, job_result); -+ md5_unsafe64_fd_direct(job_fd, job_begin_pos, job_len, p_job_result); - break; - - case METHOD_SHA1: -- sha1_unsafe64_fd_direct(job_fd, job_begin_pos, job_len, job_result); -+ sha1_unsafe64_fd_direct(job_fd, job_begin_pos, job_len, p_job_result); - break; - - case METHOD_TIGER: - bsize = tiger_block_size(job_len); -- tiger_tree_fd(job_fd, job_len, 0, bsize, job_result); -+ tiger_tree_fd(job_fd, job_len, 0, bsize, p_job_result); - break; - - default: -Index: src/daemon/common/commonInteractive.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonInteractive.ml,v -retrieving revision 1.85 -retrieving revision 1.90 -diff -u -r1.85 -r1.90 ---- src/daemon/common/commonInteractive.ml 26 Nov 2006 13:54:09 -0000 1.85 -+++ src/daemon/common/commonInteractive.ml 6 Feb 2007 22:26:58 -0000 1.90 -@@ -200,8 +200,6 @@ - name. - *) - --exception Incoming_full -- - let file_commit file = - let impl = as_file_impl file in - if impl.impl_file_state = FileDownloaded then -@@ -222,7 +220,7 @@ - let new_name = file_commited_name incoming.shdir_dirname file in - if Unix2.is_directory file_name then begin - Unix2.safe_mkdir new_name; -- Unix2.chmod new_name (Misc.int_of_octal_string !!create_dir_mask) -+ Unix2.chmod new_name !Unix32.create_dir_mode; - end; - - (* the next line really moves the file *) -@@ -331,7 +329,12 @@ - let incoming = incoming_dir (Unix2.is_directory (file_disk_name file)) () in - - let line4 = if !!url_in_mail = "" then "" else -- Printf.sprintf "\r\n<%s/%s/%s>\r\n" !!url_in_mail incoming.shdir_dirname (Url.encode (file_best_name file)) -+ Printf.sprintf "\r\n<%s/%s%s/%s>\r\n" -+ !!url_in_mail -+ incoming.shdir_dirname -+ (if (file_owner file).user_commit_dir = "" then "" -+ else Printf.sprintf "/%s" (file_owner file).user_commit_dir) -+ (Url.encode (file_best_name file)) - in - - let line5 = if !!auto_commit then "" else -@@ -714,7 +717,7 @@ - | Q_MP3_BITRATE _ -> - let bitrate = get_arg "bitrate" in - if bitrate = "" then raise Not_found; -- QHasMinVal(Field_UNKNOWN "bitrate", Int64.of_string bitrate) -+ QHasMinVal(Field_KNOWN "bitrate", Int64.of_string bitrate) - - in - try -@@ -752,12 +755,11 @@ - - let opfile_args r opfile = - let prefix = r.network_shortname ^ "-" in -- let args = simple_options prefix opfile in -- args -+ simple_options prefix opfile true - - let all_simple_options () = - let options = ref (sort_options -- (simple_options "" downloads_ini) -+ (simple_options "" downloads_ini true) - ) - in - networks_iter_all (fun r -> -@@ -807,7 +809,7 @@ - let apply_on_fully_qualified_options name f = - if !verbose then lprintf_nl "Change option %s" name; - let rec iter prefix opfile = -- let args = simple_options prefix opfile in -+ let args = simple_options prefix opfile true in - List.iter (fun o -> - (* lprintf "Compare [%s] [%s]\n" o.option_name name; *) - if o.option_name = name then -@@ -874,14 +876,14 @@ - | QHasMinVal (field, value) -> - begin - match field with -- Field_UNKNOWN "bitrate" -+ Field_KNOWN "bitrate" - | Field_Size - | _ -> () - end - | QHasMaxVal (field, value) -> - begin - match field with -- Field_UNKNOWN "bitrate" -+ Field_KNOWN "bitrate" - | Field_Size - | _ -> () - end -Index: src/daemon/common/commonMessages.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonMessages.ml,v -retrieving revision 1.60 -retrieving revision 1.62 -diff -u -r1.60 -r1.62 ---- src/daemon/common/commonMessages.ml 5 Nov 2006 14:11:29 -0000 1.60 -+++ src/daemon/common/commonMessages.ml 28 Jan 2007 20:39:59 -0000 1.62 -@@ -661,6 +661,8 @@ - <title>MLdonkey: Web Interface</title> - <meta name=\"generator\" content=\"MLDonkey\" /> - <meta name=\"robots\" content=\"noindex,nofollow\" /> -+<meta http-equiv=\"Expires\" content=\"-1\" /> -+<meta http-equiv=\"Pragma\" content=\"no-cache\" /> - <link rel=\"shortcut icon\" href=\"favicon.ico\" type=\"image/x-icon\" /> - <link href=\"h.css\" rel=\"stylesheet\" type=\"text/css\" /> - <script type=\"text/javascript\" src=\"i.js\"> -@@ -1117,6 +1119,9 @@ - <TD class=\"bu bbig\" title=\"Sysinfo\" - onMouseOver=\"mOvr(this,'mOvr1');\" onMouseOut=\"mOut(this);\" - onClick=\"mSub('output','sysinfo')\">Sysinfo</TD> -+<TD class=\"bu bbig\" title=\"Porttest\" -+onMouseOver=\"mOvr(this,'mOvr1');\" onMouseOut=\"mOut(this);\" -+onClick=\"mSub('output','porttest')\">Porttest</TD> - <TD class=\"bu bbig\" title=\"View ChangeLog\" - onMouseOver=\"mOvr(this,'mOvr1');\" onMouseOut=\"mOut(this);\" - onClick=\"top.output.location.href='http://savannah.nongnu.org/cgi-bin/viewcvs/mldonkey/mldonkey/distrib/ChangeLog?rev=HEAD&content-type=text/vnd.viewcvs-markup'\">ChangeLog</TD> -Index: src/daemon/common/commonOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonOptions.ml,v -retrieving revision 1.190 -retrieving revision 1.197 -diff -u -r1.190 -r1.197 ---- src/daemon/common/commonOptions.ml 28 Nov 2006 23:15:21 -0000 1.190 -+++ src/daemon/common/commonOptions.ml 4 Feb 2007 17:19:50 -0000 1.197 -@@ -273,14 +273,15 @@ - end - end - --let define_option a b ?desc c d e = -+let define_option a b ?desc ?restart ?public ?internal c d e = - match desc with -- None -> define_option a b (_s c) d e -- | Some desc -> define_option a b ~desc: (_s desc) (_s c) d e --let define_expert_option a b ?desc c d e = -+ None -> define_option a b (_s c) d e ?restart ?public ?internal -+ | Some desc -> define_option a b ~desc: (_s desc) (_s c) d e ?restart ?public ?internal -+ -+let define_expert_option a b ?desc ?restart ?public ?internal c d e = - match desc with -- None -> define_expert_option a b (_s c) d e -- | Some desc -> define_expert_option a b ~desc: (_s desc) (_s c) d e -+ None -> define_expert_option a b (_s c) d e ?restart ?public ?internal -+ | Some desc -> define_expert_option a b ~desc: (_s desc) (_s c) d e ?restart ?public ?internal - - let string_list_option = define_option_class "String" - (fun v -> -@@ -478,34 +479,42 @@ - - let gui_port = define_option current_section ["gui_port"] - ~desc: "The port to connect the GUI" -+ ~restart: true - "port for Graphical Interfaces" - int_option 4001 - - let gift_port = define_option current_section ["gift_port"] - ~desc: "The port to connect for GiFT GUIs." -+ ~restart: true - "port for GiFT Graphical Interfaces interaction. It was 1213, but the default is - now 0 for disabled, because it does not check for a password." - int_option 0 - - let http_port = define_option current_section ["http_port"] - ~desc: "The port to connect via HTTP" -+ ~public: true -+ ~restart: true - "The port used to connect to your client with a WEB browser" - int_option 4080 - - let telnet_port = define_option current_section ["telnet_port"] - ~desc: "The port to connect via telnet" -+ ~restart: true - "port for user interaction" - int_option 4000 - - let http_bind_addr = define_expert_option current_section ["http_bind_addr"] -+ ~restart: true - "The IP address used to bind the http server" - Ip.option (Ip.any) - - let gui_bind_addr = define_expert_option current_section ["gui_bind_addr"] -+ ~restart: true - "The IP address used to bind the gui server" - Ip.option (Ip.of_inet_addr Unix.inet_addr_any) - - let telnet_bind_addr = define_expert_option current_section ["telnet_bind_addr"] -+ ~restart: true - "The IP address used to bind the telnet server" - Ip.option (Ip.of_inet_addr Unix.inet_addr_any) - -@@ -552,6 +561,7 @@ - swarming : debug swarming - hc : http_client messages - hs : http_server messages -+ com : commands by non-admin users - act : debug activity - bw : debug bandwidth - unexp : debug unexpected messages" -@@ -807,6 +817,7 @@ - int_option 200 - - let html_mods_vd_gfx_h_intervall = define_expert_option current_section ["html_mods_vd_gfx_h_intervall"] -+ ~restart: true - "compute values for hourly graph every 1,2,3,4,5,10,15,20,30,60 min - Changes to this option require a core restart." - int_option 60 -@@ -1176,15 +1187,6 @@ - "How many sources to use to download each chunk" - int_option 3 - --let swarming_block_selection_algorithm = define_expert_option current_section ["swarming_block_selection_algorithm"] -- "What algorithm to use to select blocks (currently 1 or 2)" -- int_option 1 -- --let block_switching = define_expert_option current_section ["block_switching"] -- "Allows swarmer to switch a source to another block if current block is already -- totally selected by other sources" -- bool_option true -- - let max_recover_gap = define_option current_section ["max_recover_zeroes_gap"] - "The maximal length of zero bytes between non-zero bytes in a file that - should be interpreted as downloaded during a recovery" -@@ -1225,12 +1227,14 @@ - let current_section = startup_section - - let run_as_user = define_option current_section ["run_as_user"] -+ ~restart: true - "The login of the user you want mldonkey to run as, after the ports - have been bound (can be use not to run with root priviledges when - a port < 1024 is needed)" - string_option "" - - let run_as_useruid = define_option current_section ["run_as_useruid"] -+ ~restart: true - "The UID of the user (0=disabled) you want mldonkey to run as, after the ports - have been bound (can be use not to run with root priviledges when - a port < 1024 is needed)" -@@ -1249,6 +1253,7 @@ - bool_option true - - let config_files_security_space = define_expert_option current_section ["config_files_security_space"] -+ ~restart: true - "How many megabytes should MLdonkey keep for saving configuration files." - int_option 10 - -@@ -1267,8 +1272,17 @@ - "The directory where temporary files should be put" - string_option "temp" - --let create_dir_mask = define_option current_section ["create_dir_mask"] -- "New directories in incoming_directories are created with these rights" -+let share_scan_interval = define_option current_section ["share_scan_interval"] -+ ~restart: true -+ "How often (in minutes) should MLDonkey scan all shared directories for new/removed files" -+ int_option 1 -+ -+let create_file_mode = define_option current_section ["create_file_mode"] -+ "New download files are created with these rights (in octal)" -+ string_option "664" -+ -+let create_dir_mode = define_option current_section ["create_dir_mode"] -+ "New directories in incoming_directories are created with these rights (in octal)" - string_option "755" - - let create_file_sparse = define_option current_section ["create_file_sparse"] -@@ -1374,6 +1388,7 @@ - bool_option false - - let buffer_writes_delay = define_expert_option current_section ["buffer_writes_delay"] -+ ~restart: true - "Buffer writes and flush after buffer_writes_delay seconds (experimental)" - float_option 30. - -@@ -1484,6 +1499,7 @@ - int_option 120 - - let client_bind_addr = define_option current_section ["client_bind_addr"] -+ ~restart: true - "The IP address used to bind the p2p clients" - Ip.option (Ip.of_inet_addr Unix.inet_addr_any) - -@@ -1497,9 +1513,12 @@ - TcpBufferedSocket.copy_read_buffer := !!copy_read_buffer - ) - --let _ = -- option_hook create_dir_mask (fun _ -> -- Unix32.create_dir_mask := !!create_dir_mask -+let () = -+ option_hook create_file_mode (fun _ -> -+ Unix32.create_file_mode := Misc.int_of_octal_string !!create_file_mode -+ ); -+ option_hook create_dir_mode (fun _ -> -+ Unix32.create_dir_mode := Misc.int_of_octal_string !!create_dir_mode - ) - - let create_mlsubmit = define_expert_option current_section ["create_mlsubmit"] -@@ -1531,6 +1550,7 @@ - int_option 500000 - - let save_options_delay = define_expert_option current_section ["save_options_delay"] -+ ~restart: true - "The delay between two saves of the 'downloads.ini' file (default is 15 minutes). - Changes to this option require a core restart." - float_option 900.0 -@@ -1540,6 +1560,7 @@ - float_option 30. - - let download_sample_rate = define_expert_option current_section ["download_sample_rate"] -+ ~restart: true - "The delay between one glance at a file and another" - float_option 1. - -@@ -1558,7 +1579,7 @@ - - let compaction_overhead = define_expert_option current_section ["compaction_overhead"] - "The percentage of free memory before a compaction is triggered" -- percent_option 25 -+ int_option 25 - - let space_overhead = define_expert_option current_section ["space_overhead"] - "The major GC speed is computed from this parameter. This is the memory -@@ -1573,6 +1594,7 @@ - int_option 1000 - - let options_version = define_expert_option current_section ["options_version"] -+ ~internal: true - "(internal option)" - int_option 14 - -@@ -1708,6 +1730,9 @@ - option_hook min_reask_delay (fun _ -> - if !!min_reask_delay < 600 then min_reask_delay =:= 600 - ); -+ option_hook share_scan_interval (fun _ -> -+ if !!share_scan_interval < 1 then share_scan_interval =:= 1 -+ ); - option_hook global_login (fun _ -> - let len = String.length !!global_login in - let prefix = "mldonkey_" in -@@ -1742,11 +1767,6 @@ - close_log () - end - ); -- option_hook swarming_block_selection_algorithm (fun _ -> -- match !!swarming_block_selection_algorithm with -- | 1 | 2 -> () -- | _ -> swarming_block_selection_algorithm =:= 1; -- ); - option_hook max_upload_slots (fun _ -> - if !!max_upload_slots < 3 then - max_upload_slots =:= 3); -@@ -1830,6 +1850,7 @@ - let verbose_supernode = ref false - let verbose_swarming = ref false - let verbose_activity = ref false -+let verbose_user_commands = ref false - let verbose_unexpected_messages = ref false - - let set_all v = -@@ -1858,6 +1879,7 @@ - Http_client.verbose := v; - Http_server.verbose := v; - verbose_activity := v; -+ verbose_user_commands := v; - verbose_unexpected_messages := v - - let _ = -@@ -1893,6 +1915,7 @@ - | "act" -> verbose_activity := true - | "bw" -> incr BasicSocket.verbose_bandwidth - | "unexp" -> verbose_unexpected_messages := true -+ | "com" -> verbose_user_commands := true - - | "all" -> - -Index: src/daemon/common/commonSearch.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonSearch.ml,v -retrieving revision 1.19 -retrieving revision 1.20 -diff -u -r1.19 -r1.20 ---- src/daemon/common/commonSearch.ml 26 Nov 2006 13:54:09 -0000 1.19 -+++ src/daemon/common/commonSearch.ml 3 Dec 2006 20:49:42 -0000 1.20 -@@ -113,7 +113,7 @@ - | "-album" :: format :: args -> - iter args ((QHasField(Field_Album, format)) :: q) - | "-field" :: field :: format :: args -> -- iter args ((QHasField(Field_UNKNOWN field, format)) :: q) -+ iter args ((QHasField(Field_KNOWN field, format)) :: q) - | "-network" :: name :: args -> - net := (network_find_by_name name).network_num; - iter args q -@@ -892,7 +892,7 @@ - try - let bitrate = Int64.of_string s - in -- QHasMinVal(Field_UNKNOWN "bitrate", bitrate) -+ QHasMinVal(Field_KNOWN "bitrate", bitrate) - with _ -> QNone - end - -Index: src/daemon/common/commonServer.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonServer.ml,v -retrieving revision 1.39 -retrieving revision 1.40 -diff -u -r1.39 -r1.40 ---- src/daemon/common/commonServer.ml 26 Nov 2006 16:36:29 -0000 1.39 -+++ src/daemon/common/commonServer.ml 28 Nov 2006 23:58:02 -0000 1.40 -@@ -306,8 +306,8 @@ - (try impl.impl_server_ops.op_server_sort impl.impl_server_val - with _ -> 0); - ) servers_by_num; -- Sort.list (fun s1 s2 -> -- (as_server_impl s1).impl_server_sort >= (as_server_impl s2).impl_server_sort -+ List.sort (fun s1 s2 -> -+ compare (as_server_impl s2).impl_server_sort (as_server_impl s1).impl_server_sort - ) !list - - let server_iter f = -Index: src/daemon/common/commonShared.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonShared.ml,v -retrieving revision 1.37 -retrieving revision 1.39 -diff -u -r1.37 -r1.39 ---- src/daemon/common/commonShared.ml 29 Oct 2006 18:58:59 -0000 1.37 -+++ src/daemon/common/commonShared.ml 6 Feb 2007 22:26:58 -0000 1.39 -@@ -43,13 +43,14 @@ - mutable impl_shared_size : int64; - mutable impl_shared_id : Md4.t; - mutable impl_shared_requests : int; -- mutable impl_shared_magic : string option; -+ mutable impl_shared_file : CommonTypes.file option; - mutable impl_shared_servers : CommonTypes.server list; - } - - and 'a shared_ops = { - mutable op_shared_info : ('a -> GuiTypes.shared_info); - mutable op_shared_unshare : ('a -> unit); -+ mutable op_shared_state : (CommonTypes.file -> CommonTypes.ui_conn -> string); - } - - let as_shared (shared : 'a shared_impl) = -@@ -180,6 +181,14 @@ - shared_remove impl; - try impl.impl_shared_ops.op_shared_unshare impl.impl_shared_val with _ -> () - -+let shared_state s o = -+ let impl = as_shared_impl s in -+ try -+ match impl.impl_shared_file with -+ | None -> "" -+ | Some f -> impl.impl_shared_ops.op_shared_state f o -+ with _ -> "" -+ - let shared_dir = function - | None -> "" - | Some sh -> -@@ -198,6 +207,7 @@ - let new_shared_ops network = { - op_shared_unshare = (fun _ -> ni_ok network "shared_unshare"); - op_shared_info = (fun _ -> fni network "shared_info"); -+ op_shared_state = (fun _ _ -> fni network "shared_state"); - } - - let dummy_shared = { -@@ -209,12 +219,13 @@ - impl_shared_ops = { - op_shared_unshare = (fun _ -> raise Not_found); - op_shared_info = (fun _ -> raise Not_found); -+ op_shared_state = (fun _ _ -> raise Not_found); - }; - impl_shared_uploaded = zero; - impl_shared_size = zero; - impl_shared_id = Md4.null; - impl_shared_requests = 0; -- impl_shared_magic = None; -+ impl_shared_file = None; - impl_shared_servers = [] - } - -@@ -236,14 +247,15 @@ - waiting_directories := (shared_dir, local_dir) :: !waiting_directories - - let shared_scan_directory shared_dir local_dir = -+ let module U = Unix.LargeFile in - let incoming_files_inode = -- ((Unix.stat ((CommonComplexOptions.incoming_dir false ()).shdir_dirname)).Unix.st_ino) -+ ((U.stat ((CommonComplexOptions.incoming_dir false ()).shdir_dirname)).U.st_ino) - in - let incoming_directories_inode = -- ((Unix.stat ((CommonComplexOptions.incoming_dir true ()).shdir_dirname)).Unix.st_ino) -+ ((U.stat ((CommonComplexOptions.incoming_dir true ()).shdir_dirname)).U.st_ino) - in - let temp_directory_inode = -- ((Unix.stat !!temp_directory).Unix.st_ino) -+ ((U.stat !!temp_directory).U.st_ino) - in - let dirname = shared_dir.shdir_dirname in - let strategy = -@@ -354,7 +366,10 @@ - T.shared_requests = impl.impl_shared_requests; - T.shared_uids = []; - T.shared_sub_files = []; -- T.shared_magic = impl.impl_shared_magic; -+ T.shared_magic = -+ match impl.impl_shared_file with -+ | None -> None -+ | Some f -> CommonFile.file_magic f; - } - - let shared_info s = -Index: src/daemon/common/commonShared.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonShared.mli,v -retrieving revision 1.8 -retrieving revision 1.9 -diff -u -r1.8 -r1.9 ---- src/daemon/common/commonShared.mli 8 Oct 2006 14:20:21 -0000 1.8 -+++ src/daemon/common/commonShared.mli 3 Dec 2006 20:57:56 -0000 1.9 -@@ -9,12 +9,13 @@ - mutable impl_shared_size : int64; - mutable impl_shared_id : Md4.Md4.t; - mutable impl_shared_requests : int; -- mutable impl_shared_magic : string option; -+ mutable impl_shared_file : CommonTypes.file option; - mutable impl_shared_servers : CommonTypes.server list; - } - and 'a shared_ops = { - mutable op_shared_info : 'a -> GuiTypes.shared_info; - mutable op_shared_unshare : 'a -> unit; -+ mutable op_shared_state : CommonTypes.file -> CommonTypes.ui_conn -> string; - } - - val dirnames_prio : (string * int) list ref -@@ -50,5 +51,4 @@ - val shared_check_files : unit -> unit - val impl_shared_info : 'a shared_impl -> GuiTypes.shared_info - val shared_info : CommonTypes.shared -> GuiTypes.shared_info -- -- -+val shared_state : CommonTypes.shared -> CommonTypes.ui_conn -> string -Index: src/daemon/common/commonSources.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonSources.ml,v -retrieving revision 1.39 -retrieving revision 1.41 -diff -u -r1.39 -r1.41 ---- src/daemon/common/commonSources.ml 21 Nov 2006 22:34:33 -0000 1.39 -+++ src/daemon/common/commonSources.ml 3 Dec 2006 20:47:12 -0000 1.41 -@@ -99,25 +99,25 @@ - let busy_sources_queue = 10 - - let queue_name = [| -- "new_sources"; -- "good_sources"; -- "ready_saved_sources"; -- "waiting_saved_sources"; -- "old_sources1"; -- "old_sources2"; -- "old_sources3"; -- "do_not_try_queue"; -- "connected_sources"; -- "connecting_sources"; -- "busy_sources"; -- |] -+ "new_sources"; -+ "good_sources"; -+ "ready_saved_sources"; -+ "waiting_saved_sources"; -+ "old_sources1"; -+ "old_sources2"; -+ "old_sources3"; -+ "do_not_try_queue"; -+ "connected_sources"; -+ "connecting_sources"; -+ "busy_sources"; -+|] - - - let nqueues = Array.length queue_name - - let queue_period = Array.create nqueues 600 - --let _ = -+let () = - queue_period.(new_sources_queue) <- 0; - queue_period.(connected_sources_queue) <- 0; - queue_period.(connecting_sources_queue) <- 0; -@@ -178,57 +178,57 @@ - (* *) - (*************************************************************************) - -- type source = { -- source_uid : M.source_uid; -- mutable source_files : file_request list; -+ type source = { -+ source_uid : M.source_uid; -+ mutable source_files : file_request list; - - (* the 'source_score' increases with failures in connections *) -- mutable source_score : int; -+ mutable source_score : int; - - (* the 'source_num' that should be used to create the client corresponding to - this source *) -- mutable source_num : int; -+ mutable source_num : int; - - (* the 'source_age' is the time of the last successful connection *) -- mutable source_age : int; -+ mutable source_age : int; - - (* the 'source_connecting' indicates that this source is currently in the - process of being connected. *) -- mutable source_last_attempt : int; -- mutable source_sock : tcp_connection; -+ mutable source_last_attempt : int; -+ mutable source_sock : tcp_connection; - -- mutable source_brand : M.source_brand; -- } -+ mutable source_brand : M.source_brand; -+ } - -- and file_request = { -- request_file : file_sources_manager; -- mutable request_queue : int; -- mutable request_time : int; -- mutable request_score : int; -- } -- -- and file_sources_manager = { -- manager_uid : string; -- mutable manager_sources : source Queues.Queue.t array; -- mutable manager_active_sources : int; -- mutable manager_all_sources : int; -- mutable manager_file : (unit -> file); -- } -- -- and functions = { -- mutable function_connect: (M.source_uid -> unit); -- mutable function_query: (M.source_uid -> string -> unit); -- -- mutable function_string_to_manager: (string -> file_sources_manager); -- -- mutable function_max_connections_per_second : (unit -> int); -- mutable function_max_sources_per_file : (unit -> int); -- -- mutable function_add_location : -- (M.source_uid -> string -> unit); -- mutable function_remove_location : -- (M.source_uid -> string -> unit); -- } -+ and file_request = { -+ request_file : file_sources_manager; -+ mutable request_queue : int; -+ mutable request_time : int; -+ mutable request_score : int; -+ } -+ -+ and file_sources_manager = { -+ manager_uid : string; -+ mutable manager_sources : source Queues.Queue.t array; -+ mutable manager_active_sources : int; -+ mutable manager_all_sources : int; -+ mutable manager_file : (unit -> file); -+ } -+ -+ and functions = { -+ mutable function_connect: (M.source_uid -> unit); -+ mutable function_query: (M.source_uid -> string -> unit); -+ -+ mutable function_string_to_manager: (string -> file_sources_manager); -+ -+ mutable function_max_connections_per_second : (unit -> int); -+ mutable function_max_sources_per_file : (unit -> int); -+ -+ mutable function_add_location : -+ (M.source_uid -> string -> unit); -+ mutable function_remove_location : -+ (M.source_uid -> string -> unit); -+ } - - (*************************************************************************) - (* *) -@@ -236,24 +236,22 @@ - (* *) - (*************************************************************************) - -- module HS = Weak.Make(struct -- type t = source -- let hash s = Hashtbl.hash s.source_uid -- -- let equal x y = x.source_uid = y.source_uid -- end) -- -- module H = Weak.Make(struct -- type t = source -- let hash s = Hashtbl.hash s.source_num -- -- let equal x y = x.source_num = y.source_num -- end) -- -- module SourcesQueueCreate = Queues.Make(struct -- type t = source -- let compare s1 s2 = compare s1.source_uid s2.source_uid -- end) -+ module HS = Weak.Make(struct -+ type t = source -+ let hash s = Hashtbl.hash s.source_uid -+ let equal x y = x.source_uid = y.source_uid -+ end) -+ -+ module H = Weak.Make(struct -+ type t = source -+ let hash s = Hashtbl.hash s.source_num -+ let equal x y = x.source_num = y.source_num -+ end) -+ -+ module SourcesQueueCreate = Queues.Make(struct -+ type t = source -+ let compare s1 s2 = compare s1.source_uid s2.source_uid -+ end) - - (*************************************************************************) - (* *) -@@ -261,40 +259,39 @@ - (* *) - (*************************************************************************) - -- let dummy_source = { -- source_uid = M.dummy_source_uid; -- source_files = []; -+ let dummy_source = { -+ source_uid = M.dummy_source_uid; -+ source_files = []; -+ -+ source_num = 0; -+ source_score = 0; -+ source_age = 0; -+ source_last_attempt = 0; -+ source_sock = NoConnection; -+ -+ source_brand = M.dummy_source_brand; -+ } -+ -+ let last_refill = ref 0 -+ -+ let not_implemented s _ = -+ failwith (Printf.sprintf "CommonSources.%s not implemented" s) -+ -+ let functions = { -+ function_connect = not_implemented "function_connect"; -+ function_query = not_implemented "function_query"; -+ function_string_to_manager = not_implemented -+ "function_string_to_manager"; -+ -+ function_max_connections_per_second = (fun _ -> -+ !!max_connections_per_second); -+ function_max_sources_per_file = (fun _ -> 10); -+ -+ function_add_location = not_implemented "function_add_location"; -+ function_remove_location = not_implemented "function_remove_location"; -+ } - -- source_num = 0; -- source_score = 0; -- source_age = 0; -- source_last_attempt = 0; -- source_sock = NoConnection; -- -- source_brand = M.dummy_source_brand; -- } -- -- let last_refill = ref 0 -- -- let not_implemented s _ = -- failwith (Printf.sprintf "CommonSources.%s not implemented" s) -- -- let functions = { -- function_connect = not_implemented "function_connect"; -- function_query = not_implemented "function_query"; -- function_string_to_manager = not_implemented -- "function_string_to_manager"; -- -- function_max_connections_per_second = (fun _ -> -- !!max_connections_per_second); -- function_max_sources_per_file = (fun _ -> 10); -- -- function_add_location = not_implemented "function_add_location"; -- function_remove_location = not_implemented "function_remove_location"; -- -- } -- -- let indirect_connections = ref 0 -+ let indirect_connections = ref 0 - - (*************************************************************************) - (* *) -@@ -302,19 +299,19 @@ - (* *) - (*************************************************************************) - -- let sources_by_uid = HS.create 13557 -- let sources_by_num = H.create 13557 -- -- let file_sources_managers = ref [] -+ let sources_by_uid = HS.create 13557 -+ let sources_by_num = H.create 13557 - -- let connecting_sources = Fifo.create () -+ let file_sources_managers = ref [] - -- let next_direct_sources = Fifo.create () -- let next_indirect_sources = ref [] -+ let connecting_sources = Fifo.create () - -+ let next_direct_sources = Fifo.create () -+ let next_indirect_sources = ref [] -+ - -- let active_queue q = -- q >= connected_sources_queue && q <= busy_sources_queue -+ let active_queue q = -+ q >= connected_sources_queue && q <= busy_sources_queue - - (*************************************************************************) - (* *) -@@ -322,10 +319,10 @@ - (* *) - (*************************************************************************) - -- let request_score r = r.request_score -+ let request_score r = r.request_score - -- let set_score_part r score = -- r.request_score <- score -+ let set_score_part r score = -+ r.request_score <- score - - - (*************************************************************************) -@@ -334,20 +331,20 @@ - (* *) - (*************************************************************************) - --let rec find_throttled_queue queue = -- if queue_period.(queue) > 0 || queue = old_sources3_queue then -- queue -- else -- find_throttled_queue (queue + 1) -- --let get_throttle_delay m q throttled = -- if throttled then -- (max 0 -- (queue_period.(q) -- - (file_priority (m.manager_file ())) -- + Queue.length m.manager_sources.(connected_sources_queue)) -- ) -- else 0 -+ let rec find_throttled_queue queue = -+ if queue_period.(queue) > 0 || queue = old_sources3_queue then -+ queue -+ else -+ find_throttled_queue (queue + 1) -+ -+ let get_throttle_delay m q throttled = -+ if throttled then -+ (max 0 -+ (queue_period.(q) -+ - (file_priority (m.manager_file ())) -+ + Queue.length m.manager_sources.(connected_sources_queue)) -+ ) -+ else 0 - - (* - * determine the number of (throttled) ready sources for a manager queue -@@ -357,49 +354,45 @@ - But that function really needs to be fast. - Also, this works because Queues are based on Sets, and that Set.iter - gives elements in increasing keys order *) --exception BreakOutOfLoop -+ exception BreakOutOfLoop - --let count_file_ready_sources m q throttled = -- let ready_count = ref 0 in -- let throttle_delay = get_throttle_delay m q throttled in -- let ready_threshold = last_time () - !!min_reask_delay - throttle_delay in -- (try -- Queue.iter -- (fun ( time, s ) -> -- if time >= ready_threshold then -- raise BreakOutOfLoop; -- incr ready_count -- ) m.manager_sources.( q ) -- with BreakOutOfLoop -> ()); -- !ready_count -+ let count_file_ready_sources m q throttled = -+ let ready_count = ref 0 in -+ let throttle_delay = get_throttle_delay m q throttled in -+ let ready_threshold = -+ last_time () - !!min_reask_delay - throttle_delay in -+ (try -+ Queue.iter -+ (fun (time, s) -> -+ if time >= ready_threshold then raise BreakOutOfLoop; -+ incr ready_count -+ ) m.manager_sources.(q) -+ with BreakOutOfLoop -> ()); -+ !ready_count - - (* - * determine the total number of ready sources for all downloading files per queue - *) --let count_ready_sources queue throttled = -- let ready_count = ref 0 in -- List.iter -- (fun m -> -- let f = m.manager_file () in -- if file_state f = FileDownloading then -- ready_count := !ready_count + count_file_ready_sources m queue throttled -- ) !file_sources_managers; -- !ready_count -- -- --let rec find_max_overloaded q managers = -- let current_max = ref (-1) in -- let remaining_managers = ref [] in -- List.iter -- (fun m -> -- let ready_sources = count_file_ready_sources m q true in -- if ready_sources > !current_max then begin -- current_max := ready_sources; -- remaining_managers := [m] -- end else if ready_sources = !current_max then -- remaining_managers := m :: !remaining_managers -- ) managers; -- !remaining_managers -+ let count_ready_sources queue throttled = -+ List.fold_left (fun ready_count m -> -+ let f = m.manager_file () in -+ if file_state f = FileDownloading then -+ ready_count + count_file_ready_sources m queue throttled -+ else ready_count -+ ) 0 !file_sources_managers -+ -+ -+ let rec find_max_overloaded q managers = -+ let _, remaining_managers = -+ List.fold_left (fun ((current_max, remaining_managers) as acc) m -> -+ let ready_sources = count_file_ready_sources m q true in -+ if ready_sources > current_max then -+ (ready_sources, [m]) -+ else if ready_sources = current_max then -+ (current_max, m :: remaining_managers) -+ else acc -+ ) (-1, []) managers in -+ remaining_managers - - - (*************************************************************************) -@@ -408,19 +401,20 @@ - (* *) - (*************************************************************************) - -- let print_source buf s = -- Printf.bprintf buf "Source %d:\n" s.source_num; -- Printf.bprintf buf " score: %d\n" s.source_score; -- if s.source_age <> 0 then -- Printf.bprintf buf " age: %d\n" s.source_age; -- if s.source_last_attempt <> 0 then -- Printf.bprintf buf " last_attemps: %d" s.source_last_attempt; -- List.iter (fun r -> -- Printf.bprintf buf " File %s\n" (file_best_name (r.request_file.manager_file ())); -- Printf.bprintf buf " Score: %d\n" r.request_score; -- if r.request_time <> 0 then -- Printf.bprintf buf " Time: %d\n" r.request_time; -- ) s.source_files -+ let print_source buf s = -+ Printf.bprintf buf "Source %d:\n" s.source_num; -+ Printf.bprintf buf " score: %d\n" s.source_score; -+ if s.source_age <> 0 then -+ Printf.bprintf buf " age: %d\n" s.source_age; -+ if s.source_last_attempt <> 0 then -+ Printf.bprintf buf " last_attemps: %d" s.source_last_attempt; -+ List.iter (fun r -> -+ Printf.bprintf buf " File %s\n" -+ (file_best_name (r.request_file.manager_file ())); -+ Printf.bprintf buf " Score: %d\n" r.request_score; -+ if r.request_time <> 0 then -+ Printf.bprintf buf " Time: %d\n" r.request_time; -+ ) s.source_files - - - (* -@@ -429,33 +423,34 @@ - * - *) - -- let need_new_sources file = -- let ready_count = ref 0 in -- for i = good_sources_queue to old_sources1_queue do -- let lookin = file.manager_sources.( i ) in -- let ready_threshold = last_time () - !!min_reask_delay in -- Queue.iter -- (fun (time, s) -> -- if time < ready_threshold then -- incr ready_count -- ) lookin -- done; -- (* let work_count = !ready_count + -- (Queue.length ( file.manager_sources.( new_sources_queue ) )) + -- (Queue.length ( file.manager_sources.( connected_sources_queue ) )) -- in *) -- let f = file.manager_file () in -- (* lprintf "commonSources: need_new_source: ready= %d new= %d con= %d prio= %d %s\n" -- !readyCount -- (Queue.length ( file.manager_sources.( new_sources_queue ) ) ) -- (Queue.length ( file.manager_sources.( connected_sources_queue ) ) ) -- (file_priority f) -- (if (file_priority f) + 20 > workCount then "we need" else "have enough"); -- *) -- (* (file_priority f) + 20 > work_count *) -- (* let max_s = functions.function_max_sources_per_file () in -- (file_priority f)*(max_s/20) + max_s > !all_ready_s + new_s *) -- (file_priority f) + 20 > !ready_count -+ let need_new_sources file = -+ let ready_threshold = last_time () - !!min_reask_delay in -+ let ready_count = ref 0 in -+ for i = good_sources_queue to old_sources1_queue do -+ let lookin = file.manager_sources.(i) in -+ try -+ Queue.iter (fun (time, s) -> -+ if time >= ready_threshold then raise BreakOutOfLoop; -+ incr ready_count -+ ) lookin -+ with BreakOutOfLoop -> () -+ done; -+ (* let work_count = !ready_count + -+ (Queue.length ( file.manager_sources.( new_sources_queue ) )) + -+ (Queue.length ( file.manager_sources.( connected_sources_queue ) )) -+ in *) -+ let f = file.manager_file () in -+ (* lprintf "commonSources: need_new_source: ready= %d new= %d con= %d prio= %d %s\n" -+ !readyCount -+ (Queue.length ( file.manager_sources.( new_sources_queue ) ) ) -+ (Queue.length ( file.manager_sources.( connected_sources_queue ) ) ) -+ (file_priority f) -+ (if (file_priority f) + 20 > workCount then "we need" else "have enough"); -+ *) -+ (* (file_priority f) + 20 > work_count *) -+ (* let max_s = functions.function_max_sources_per_file () in -+ (file_priority f)*(max_s/20) + max_s > !all_ready_s + new_s *) -+ (file_priority f) + 20 > !ready_count - - - (*************************************************************************) -@@ -465,444 +460,405 @@ - (*************************************************************************) - - -- let print buf output_type = -- let pos_to_string v = -- (if v > 0 then string_of_int(v) else "-") -- in -- -- html_mods_cntr_init(); -- let mycntr = ref 1 in -- -- let html_tr () = begin -- mycntr := html_mods_cntr(); -- Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" (!mycntr) -- end -- in -- let html_tr_same () = Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" (!mycntr) in -- -- (* Header *) -- if output_type = HTML then -- begin -- -- let header = Printf.sprintf "File sources per manager queue (%d)" (List.length !file_sources_managers) in -- -- Printf.bprintf buf "\\<div class=results\\>"; -- html_mods_table_header buf "sourcesTable" "sources" []; -- Printf.bprintf buf "\\<tr\\>"; -- html_mods_td buf [ -- ("", "srh", "Statistics on sources "); -- ("", "srh", "@ " ^ log_time ()); -- ("", "srh", header); ]; -- Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>\n"; -- -- html_mods_table_header buf "sourcesTable" "sources" [ -- ( "0", "srh br", "New sources", Printf.sprintf "New(%d)" new_sources_queue ); -- ( "0", "srh br", "Good sources", Printf.sprintf "Good(%d)" good_sources_queue ); -- ( "0", "srh br", "Ready saved sources", Printf.sprintf "Ready(%d)" ready_saved_sources_queue); -- ( "0", "srh br", "Waiting saved sources", Printf.sprintf "Wait(%d)" waiting_saved_sources_queue); -- ( "0", "srh br", "Old sources 1", Printf.sprintf "Old1(%d)" old_sources1_queue ); -- ( "0", "srh br", "Old sources 2", Printf.sprintf "Old2(%d)" old_sources2_queue ); -- ( "0", "srh br", "Old sources 3", Printf.sprintf "Old3(%d)" old_sources3_queue ); -- ( "0", "srh br", "Do not try sources", Printf.sprintf "nTry(%d)" do_not_try_queue ); -- ( "0", "srh br", "Connected sources", Printf.sprintf "Conn(%d)" connected_sources_queue ); -- ( "0", "srh br", "Connecting sources", Printf.sprintf "Cing(%d)" connecting_sources_queue ); -- ( "0", "srh br", "Busy sources", Printf.sprintf "Busy(%d)" busy_sources_queue ); -- ( "0", "srh br", "Total sources", "All" ); -- ( "0", "srh br", "Filename", "Name" ); ]; -- end -- else -- begin -- Printf.bprintf buf "Statistics on sources: time %d\n" (last_time ()); -- Printf.bprintf buf "File sources per manager queue(%d):\n" (List.length !file_sources_managers); -- Printf.bprintf buf "new good redy wait old1 old2 old3 ntry conn cing busy all\n"; -- (* "9999 9999 9999 9999 9999 9999 9999 9999 9999 9999 9999 9999" -- 11*5 chars -- one row each: all,indirect,ready*) -- end; -- -- let nsources_per_queue = Array.create nqueues 0 in -- let nready_per_queue = Array.create nqueues 0 in -- let nindirect_per_queue = Array.create nqueues 0 in -- let ninvalid_per_queue = Array.create nqueues 0 in -- let nall = ref 0 in -- let naact = ref 0 in -- let naneed = ref 0 in -- let my_file_sources_managers = -- Sort.list -- (fun f1 f2 -> -- file_best_name (f1.manager_file ()) < file_best_name (f2.manager_file ()) -- ) (List.filter (fun m -> file_state (m.manager_file ()) = FileDownloading) !file_sources_managers) -- in -- (* Files *) -- List.iter (fun m -> -- let name = file_best_name (m.manager_file ()) in -- if m.manager_all_sources <> 0 then -- begin -- let anready = ref 0 in -- let antready = ref 0 in -- let anindirect = ref 0 in -- let aninvalid = ref 0 in -- let slist = ref [] in -- let sreadylist = ref [] in -- let streadylist = ref [] in -- let sindirectlist = ref [] in -- let sinvalidlist = ref [] in -- let sready = ref "" in -- let stready = ref "" in -- let sindirect = ref "" in -- let sinvalid = ref "" in -- (* Queues *) -- for i = 0 to nqueues -1 do -- let q = m.manager_sources.(i) in -- if output_type = HTML then -- slist := !slist @ [ -- ("", "sr ar br", (pos_to_string (Queue.length q))); ] -- else -- Printf.bprintf buf "%4d " (Queue.length q); -- -- let nready = ref 0 in -- let nindirect = ref 0 in -- let ninvalid = ref 0 in -- let nsources = ref 0 in -- let ready_threshold = last_time () - !!min_reask_delay in -- (* Sources *) -- Queue.iter (fun (time, s) -> -- incr nsources; -- if M.indirect_source s.source_uid then -- incr nindirect -- else if not (M.direct_source s.source_uid) then -- incr ninvalid; -- if time < ready_threshold then -- incr nready -- else if i = new_sources_queue then -- begin -- Printf.bprintf buf "ERROR: Source is not ready in new_sources_queue !\n"; -- print_source buf s -- end -- ) q; -- -- if output_type = HTML then -- begin -- sreadylist := !sreadylist @ [ -- ("", "sr ar br", (pos_to_string (Queue.length q))); ] ; -- streadylist := !streadylist @ [ -- ("", "sr ar br", (pos_to_string (count_file_ready_sources m i true))); ] ; -- sindirectlist := !sindirectlist @ [ -- ("", "sr ar br", (pos_to_string !nindirect)); ] ; -- sinvalidlist := !sinvalidlist @ [ -- ("", "sr ar br", (pos_to_string !ninvalid)); ] ; -- end -- else -- begin -- sready := Printf.sprintf "%s%4d " !sready !nready; -- stready := Printf.sprintf "%s%4d " !stready (count_file_ready_sources m i true); -- sindirect := Printf.sprintf "%s%4d " !sindirect !nindirect; -- sinvalid := Printf.sprintf "%s%4d " !sinvalid !ninvalid -- end; -- -- anready := !anready + !nready; -- antready := !antready + (count_file_ready_sources m i true); -- anindirect := !anindirect + !nindirect; -- aninvalid := !aninvalid + !ninvalid; -- nready_per_queue.(i) <- nready_per_queue.(i) + !nready; -- nindirect_per_queue.(i) <- nindirect_per_queue.(i) + !nindirect; -- ninvalid_per_queue.(i) <- ninvalid_per_queue.(i) + !ninvalid; -- nsources_per_queue.(i) <- nsources_per_queue.(i) + !nsources; -- -- done; (* end Queues *) -- -- if output_type = HTML then -- begin -- html_tr (); -- html_mods_td buf ( -- !slist -- @ [ ("", "sr ar br", Printf.sprintf "%d" m.manager_all_sources); ] -- @ [ ("Filename", "sr", (shorten name !!max_name_len)); ] ); -- -- Printf.bprintf buf "\\</tr\\>\n"; -- -- html_tr_same (); -- html_mods_td buf ( -- !sreadylist -- @ [ ("", "sr ar br", Printf.sprintf "%d" !anready); ] -- @ [ ("", "sr", ((Printf.sprintf "ready with %d active" m.manager_active_sources) -- ^ (if file_state (m.manager_file ()) = FileDownloading -- && need_new_sources m then -- begin -- incr naneed; -- " and needs sources" -- end -- else "") -- )); -- ] -- ); -- Printf.bprintf buf "\\</tr\\>\n"; -- -- html_tr_same (); -- -- html_mods_td buf ( -- !streadylist -- @ [ ("", "sr ar br", Printf.sprintf "%d" !antready); ] -- @ [("", "sr", "throttled ready"); ] -- ); -- -- Printf.bprintf buf "\\</tr\\>\n"; -- -- (if !anindirect <> 0 then -- begin -- html_tr_same (); -- html_mods_td buf ( -- !sindirectlist -- @ [ ("", "sr ar br", Printf.sprintf "%d" !anindirect); ] -- @ [ ("", "sr", "indirect"); ] -- ); -- Printf.bprintf buf "\\</tr\\>\n"; -- end -- ); -- -- (if !aninvalid <> 0 then -- begin -- html_tr_same (); -- html_mods_td buf ( -- !sinvalidlist -- @ [ ("", "sr ar br", Printf.sprintf "%d" !aninvalid); ] -- @ [ ("", "sr", "invalid"); ] -- ); -- Printf.bprintf buf "\\</tr\\>\n"; -- end -- ); -- end -- else -- begin -- Printf.bprintf buf "%4d %s\n" m.manager_all_sources name; -- Printf.bprintf buf "%s%4d ready %d active%s\n" !sready !anready m.manager_active_sources -- (if file_state (m.manager_file ()) = FileDownloading && need_new_sources m then -- begin -- incr naneed; -- " needs sources" -- end -- else -- "" -- ); -- Printf.bprintf buf "%s%4d throttled ready\n" !stready !antready; -- if !anindirect <> 0 then -- Printf.bprintf buf "%s%4d indirect\n" !sindirect !anindirect; -- if !aninvalid <> 0 then -- Printf.bprintf buf "%s%4d invalid\n" !sinvalid !aninvalid; -- end; -- -- nall := !nall + m.manager_all_sources; -- naact := !naact + m.manager_active_sources; -- end -- else -- begin -- -- if output_type = HTML then -- begin -- html_tr (); -- -- html_mods_td buf [ -- ("", "sr ar br", "-"); ("", "sr ar br", ""); ("", "sr ar br", ""); -- ("", "sr ar br", ""); ("", "sr ar br", ""); ("", "sr ar br", ""); -- ("", "sr ar br", ""); ("", "sr ar br", ""); ("", "sr ar br", ""); -- ("", "sr ar br", ""); ("", "sr ar br", ""); ("", "sr ar br", ""); -- ("", "sr br", (shorten name !!max_name_len)); -- ]; -- Printf.bprintf buf "\\</tr\\>\n"; -- end -- else -- Printf.bprintf buf "None %55s%s\n" ("") name; -- if file_state (m.manager_file ()) = FileDownloading && need_new_sources m then -- incr naneed; -- end -- ) my_file_sources_managers; (* end Files *) -- -- (* next Header *) -- if output_type = HTML then -- begin -- Printf.bprintf buf "\\</table\\>\\</div\\>\n"; -- -- html_mods_table_header buf "sourcesTable" "sources" [ -- ( "0", "srh", "New sources", "New" ); -- ( "0", "srh", "Good sources", "Good" ); -- ( "0", "srh", "Ready sources", "Ready" ); -- ( "0", "srh", "Waiting sources", "Wait" ); -- ( "0", "srh", "Old sources 1", "Old1" ); -- ( "0", "srh", "Old sources 2", "Old2" ); -- ( "0", "srh", "Old sources 3", "Old3" ); -- ( "0", "srh", "Do not try", "nTry" ); -- ( "0", "srh", "Connected sources", "Conn" ); -- ( "0", "srh", "Connecting sources", "Cing" ); -- ( "0", "srh", "Busy sources", "Busy" ); -- ( "0", "srh", "Total sources", "All" ); -- ( "0", "srh", "Type", "Type" ); ]; -- -- end -- else -- Printf.bprintf buf "new good redy wait old1 old2 old3 ntry conn cing busy all\n"; -- -- let slist = ref [] in -- let sreadylist = ref [] in -- let streadylist = ref [] in -- let sindirectlist = ref [] in -- let sinvalidlist = ref [] in -- let speriodlist = ref [] in -- let sready = ref "" in -- let stready = ref "" in -- let sindirect = ref "" in -- let sinvalid = ref "" in -- let speriod = ref "" in -- let anready = ref 0 in -- let antready = ref 0 in -- let anindirect = ref 0 in -- let aninvalid = ref 0 in -- (* Queues *) -- for i = 0 to nqueues - 1 do -- if output_type = HTML then -- begin -- slist := !slist @ [ -- ("", "sr ar", (pos_to_string nsources_per_queue.(i))); ] ; -- sreadylist := !sreadylist @ [ -- ("", "sr ar", (pos_to_string nready_per_queue.(i))); ] ; -- anready := !anready + nready_per_queue.(i); -- streadylist := !streadylist @ [ -- ("", "sr ar", (pos_to_string (count_ready_sources i true))); ] ; -- antready := !antready + (count_ready_sources i true); -- sindirectlist := !sindirectlist @ [ -- ("", "sr ar", (pos_to_string nindirect_per_queue.(i))); ] ; -- anindirect := !anindirect + nindirect_per_queue.(i); -- sinvalidlist := !sinvalidlist @ [ -- ("", "sr ar", (pos_to_string ninvalid_per_queue.(i))); ] ; -- aninvalid := !aninvalid + ninvalid_per_queue.(i); -- speriodlist := !speriodlist @ [ -- ("", "sr ar", (pos_to_string queue_period.(i))); ] ; -- end -- else -- begin -- Printf.bprintf buf "%4d " nsources_per_queue.(i); -- sready := Printf.sprintf "%s%4d " !sready nready_per_queue.(i); -- anready := !anready + nready_per_queue.(i); -- stready := Printf.sprintf "%s%4d " !stready (count_ready_sources i true); -- antready := !antready + (count_ready_sources i true); -- sindirect := Printf.sprintf "%s%4d " !sindirect nindirect_per_queue.(i); -- anindirect := !anindirect + nindirect_per_queue.(i); -- sinvalid := Printf.sprintf "%s%4d " !sinvalid ninvalid_per_queue.(i); -- aninvalid := !aninvalid + ninvalid_per_queue.(i); -- speriod := Printf.sprintf "%s%4d " !speriod queue_period.(i); -- end; -- done; (* end Queues *) -- -- let nsources = ref 0 in -- let nroq = ref 0 in -- HS.iter (fun s -> -- incr nsources; -- List.iter (fun r -> -- if r.request_queue = outside_queue then -- incr nroq; -- ) s.source_files; -- ) sources_by_uid; -- -- if output_type = HTML then -- begin -- html_tr(); -- html_mods_td buf ( -- !slist -- @ [ ("", "sr ar", Printf.sprintf "%d" !nall); ] -- @ [("", "sr", Printf.sprintf "all source managers (%d by UID) (%d ROQ)" !nsources !nroq);] -- ); -- Printf.bprintf buf "\\</tr\\>\n"; -- -- html_tr (); -- html_mods_td buf ( -- !sreadylist -- @ [ ("", "sr ar", Printf.sprintf "%d" !anready); ] -- @ [ ("", "sr", Printf.sprintf "ready with %d active and %i need sources" !naact !naneed); ] -- ); -- Printf.bprintf buf "\\</tr\\>\n"; -- -- html_tr(); -- html_mods_td buf ( -- !streadylist -- @ [ ("", "sr ar", Printf.sprintf "%d" !antready); ] -- @ [ ("", "sr", "throttled ready"); ] -- ); -- Printf.bprintf buf "\\</tr\\>\n"; -- -- (if !anindirect <> 0 then -- begin -- html_tr (); -- html_mods_td buf ( -- !sindirectlist -- @ [ ("", "sr ar", Printf.sprintf "%d" !anindirect); ] -- @ [ ("", "sr", "indirect"); ] -- ); -- Printf.bprintf buf "\\</tr\\>\n"; -- end -- ); -- -- (if !aninvalid <> 0 then -- begin -- html_tr (); -- html_mods_td buf ( -- !sinvalidlist -- @ [ ("", "sr ar", Printf.sprintf "%d" !aninvalid); ] -- @ [ ("", "sr", "invalid"); ] -- ); -- Printf.bprintf buf "\\</tr\\>\n"; -- end -- ); -- -- html_tr (); -- html_mods_td buf ( -- !speriodlist -- @ [ ("", "sr", "") ] -- @ [("", "sr", "period"); ] -- ); -- Printf.bprintf buf "\\</tr\\>\n"; -- -- Printf.bprintf buf "\\</table\\>\\</div\\>\n"; -- end -- else -- begin -- Printf.bprintf buf "%4d all source managers (%d by UID) (%d ROQ)\n" !nall !nsources !nroq; -- Printf.bprintf buf "%s%4d ready %d active %i need sources\n" !sready !anready !naact !naneed; -- Printf.bprintf buf "%s%4d throttled ready\n" !stready !antready; -- if !anindirect <> 0 then -- Printf.bprintf buf "%s%4d indirect\n" !sindirect !anindirect; -- if !aninvalid <> 0 then -- Printf.bprintf buf "%s%4d invalid\n" !sinvalid !aninvalid; -- Printf.bprintf buf "%s period\n" !speriod; -- end; -- let nconnected = ref 0 in -- Fifo.iter -- (fun (_,s) -> -- if s.source_last_attempt = 0 then incr nconnected; -- ) connecting_sources; -- if output_type = HTML then -- begin -- html_mods_table_header buf "sourcesTable" "sources" [ -- ( "0", "srh", "Connecting sources", "Connecting sources" ); -- ( "0", "srh", "Next direct sources", "Next direct sources" ); -- ( "0", "srh", "Next indirect sources", "Next indirect sources" ); ]; -- Printf.bprintf buf "\\<tr class=\\\"dl-1\\\"\\>"; -- html_mods_td buf [ -- ("", "sr", (Printf.sprintf "%d entries" (Fifo.length connecting_sources)) ^ -- (if !nconnected > 0 then Printf.sprintf " (connected: %d)" !nconnected else (""))); -- ("", "sr", Printf.sprintf "%d entries" (Fifo.length next_direct_sources)); -- ("", "sr", Printf.sprintf "%d entries" (List.length !next_indirect_sources)); ]; -- Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>\n\\</div\\>" -- end -- else -- begin -- Printf.bprintf buf "Connecting Sources: %d entries" -- (Fifo.length connecting_sources); -- if !nconnected > 0 then Printf.bprintf buf " (connected: %d)" !nconnected; -- Printf.bprintf buf "\n"; -- Printf.bprintf buf "Next Direct Sources: %d entries\n" -- (Fifo.length next_direct_sources); -- Printf.bprintf buf "Next Indirect Sources: %d entries\n" -- (List.length !next_indirect_sources) -- end -+ let print buf output_type = -+ let pos_to_string v = -+ if v > 0 then string_of_int v else "-" in -+ -+ html_mods_cntr_init (); -+ let mycntr = ref 1 in -+ -+ let html_tr () = -+ mycntr := html_mods_cntr (); -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" !mycntr in -+ -+ let html_tr_same () = -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" !mycntr in -+ -+ (* Header *) -+ if output_type = HTML then -+ let header = Printf.sprintf "File sources per manager queue (%d)" -+ (List.length !file_sources_managers) in -+ -+ Printf.bprintf buf "\\<div class=results\\>"; -+ html_mods_table_header buf "sourcesTable" "sources" []; -+ Printf.bprintf buf "\\<tr\\>"; -+ html_mods_td buf [ -+ ("", "srh", "Statistics on sources "); -+ ("", "srh", "@ " ^ log_time ()); -+ ("", "srh", header); ]; -+ Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>\n"; -+ -+ html_mods_table_header buf "sourcesTable" "sources" [ -+ ( "0", "srh br", "New sources", -+ Printf.sprintf "New(%d)" new_sources_queue ); -+ ( "0", "srh br", "Good sources", -+ Printf.sprintf "Good(%d)" good_sources_queue ); -+ ( "0", "srh br", "Ready saved sources", -+ Printf.sprintf "Ready(%d)" ready_saved_sources_queue); -+ ( "0", "srh br", "Waiting saved sources", -+ Printf.sprintf "Wait(%d)" waiting_saved_sources_queue); -+ ( "0", "srh br", "Old sources 1", -+ Printf.sprintf "Old1(%d)" old_sources1_queue ); -+ ( "0", "srh br", "Old sources 2", -+ Printf.sprintf "Old2(%d)" old_sources2_queue ); -+ ( "0", "srh br", "Old sources 3", -+ Printf.sprintf "Old3(%d)" old_sources3_queue ); -+ ( "0", "srh br", "Do not try sources", -+ Printf.sprintf "nTry(%d)" do_not_try_queue ); -+ ( "0", "srh br", "Connected sources", -+ Printf.sprintf "Conn(%d)" connected_sources_queue ); -+ ( "0", "srh br", "Connecting sources", -+ Printf.sprintf "Cing(%d)" connecting_sources_queue ); -+ ( "0", "srh br", "Busy sources", -+ Printf.sprintf "Busy(%d)" busy_sources_queue ); -+ ( "0", "srh br", "Total sources", "All" ); -+ ( "0", "srh br", "Filename", "Name" ); ]; -+ else begin -+ Printf.bprintf buf "Statistics on sources: time %d\n" (last_time ()); -+ Printf.bprintf buf "File sources per manager queue(%d):\n" -+ (List.length !file_sources_managers); -+ Printf.bprintf buf "new good redy wait old1 old2 old3 ntry conn cing busy all\n"; -+ (* "9999 9999 9999 9999 9999 9999 9999 9999 9999 9999 9999 9999" -+ 11*5 chars -+ one row each: all,indirect,ready *) -+ end; -+ -+ let list_sum = List.fold_left (+) 0 in -+ -+ let nsources_per_queue = Array.create nqueues 0 in -+ let nready_per_queue = Array.create nqueues 0 in -+ let nindirect_per_queue = Array.create nqueues 0 in -+ let ninvalid_per_queue = Array.create nqueues 0 in -+ let nall = ref 0 in -+ let naact = ref 0 in -+ let naneed = ref 0 in -+ let downloading_managers = -+ List.filter (fun m -> -+ file_state (m.manager_file ()) = FileDownloading -+ ) !file_sources_managers in -+ let my_file_sources_managers = -+ List.sort (fun f1 f2 -> -+ let best_name1 = file_best_name (f1.manager_file ()) in -+ let best_name2 = file_best_name (f2.manager_file ()) in -+ String.compare best_name1 best_name2 -+ ) downloading_managers in -+ (* Files *) -+ let ready_threshold = last_time () - !!min_reask_delay in -+ List.iter (fun m -> -+ let name = file_best_name (m.manager_file ()) in -+ let need_sources = need_new_sources m in -+ if need_sources then incr naneed; -+ -+ if m.manager_all_sources <> 0 then begin -+ let slist = ref [] in -+ let sreadylist = ref [] in -+ let streadylist = ref [] in -+ let sindirectlist = ref [] in -+ let sinvalidlist = ref [] in -+ (* Queues *) -+ Array.iteri (fun i q -> -+ let nready = ref 0 in -+ let ntready = count_file_ready_sources m i true in -+ let nindirect = ref 0 in -+ let ninvalid = ref 0 in -+ let nsources = ref 0 in -+ (* Sources *) -+ Queue.iter (fun (time, s) -> -+ incr nsources; -+ if M.indirect_source s.source_uid then incr nindirect -+ else if not (M.direct_source s.source_uid) then incr ninvalid; -+ if time < ready_threshold then incr nready -+ else if i = new_sources_queue then begin -+ Printf.bprintf buf "ERROR: Source is not ready in new_sources_queue !\n"; -+ print_source buf s -+ end -+ ) q; -+ -+ slist := Queue.length q :: !slist; -+ sreadylist := !nready :: !sreadylist; -+ streadylist := ntready :: !streadylist; -+ sindirectlist := !nindirect :: !sindirectlist; -+ sinvalidlist := !ninvalid :: !sinvalidlist; -+ -+ nready_per_queue.(i) <- nready_per_queue.(i) + !nready; -+ nindirect_per_queue.(i) <- nindirect_per_queue.(i) + !nindirect; -+ ninvalid_per_queue.(i) <- ninvalid_per_queue.(i) + !ninvalid; -+ nsources_per_queue.(i) <- nsources_per_queue.(i) + !nsources; -+ ) m.manager_sources; (* end Queues *) -+ -+ let slist = List.rev !slist in -+ let sreadylist = List.rev !sreadylist in -+ let streadylist = List.rev !streadylist in -+ let sindirectlist = List.rev !sindirectlist in -+ let sinvalidlist = List.rev !sinvalidlist in -+ -+ if output_type = HTML then begin -+ html_tr (); -+ html_mods_td buf ( -+ (List.map (fun qlength -> -+ ("", "sr ar br", pos_to_string qlength)) slist) @ -+ [ ("", "sr ar br", string_of_int m.manager_all_sources); -+ ("Filename", "sr", shorten name !!max_name_len); ] ); -+ -+ Printf.bprintf buf "\\</tr\\>\n"; -+ -+ html_tr_same (); -+ html_mods_td buf ( -+ (List.map (fun sready -> -+ ("", "sr ar br", pos_to_string sready)) sreadylist) @ -+ [ ("", "sr ar br", Printf.sprintf "%d" (list_sum sreadylist)); -+ ("", "sr", Printf.sprintf "ready with %d active%s" -+ m.manager_active_sources -+ (if need_sources then " and needs sources" -+ else "")) ] ); -+ Printf.bprintf buf "\\</tr\\>\n"; -+ -+ html_tr_same (); -+ html_mods_td buf ( -+ (List.map (fun sready -> -+ ("", "sr ar br", pos_to_string sready)) streadylist) @ -+ [ ("", "sr ar br", string_of_int (list_sum streadylist)); -+ ("", "sr", "throttled ready"); ] ); -+ Printf.bprintf buf "\\</tr\\>\n"; -+ -+ let anindirect = list_sum sindirectlist in -+ if anindirect <> 0 then begin -+ html_tr_same (); -+ html_mods_td buf ( -+ (List.map (fun sready -> -+ ("", "sr ar br", pos_to_string sready)) sindirectlist) @ -+ [ ("", "sr ar br", string_of_int anindirect); -+ ("", "sr", "indirect"); ] ); -+ Printf.bprintf buf "\\</tr\\>\n"; -+ end; -+ -+ let aninvalid = list_sum sinvalidlist in -+ if aninvalid <> 0 then begin -+ html_tr_same (); -+ html_mods_td buf ( -+ (List.map (fun sready -> -+ ("", "sr ar br", pos_to_string sready)) sinvalidlist) @ -+ [ ("", "sr ar br", string_of_int aninvalid); -+ ("", "sr", "invalid"); ] ); -+ Printf.bprintf buf "\\</tr\\>\n"; -+ end; -+ end -+ else begin -+ List.iter (Printf.bprintf buf "%4d ") slist; -+ Printf.bprintf buf "%4d %s\n" m.manager_all_sources name; -+ List.iter (Printf.bprintf buf "%4d ") sreadylist; -+ Printf.bprintf buf "%4d ready %d active%s\n" -+ (list_sum sreadylist) m.manager_active_sources -+ (if need_sources then " needs sources" -+ else ""); -+ List.iter (Printf.bprintf buf "%4d ") streadylist; -+ Printf.bprintf buf "%4d throttled ready\n" -+ (list_sum streadylist); -+ let anindirect = list_sum sindirectlist in -+ if anindirect <> 0 then begin -+ List.iter (Printf.bprintf buf "%4d ") sindirectlist; -+ Printf.bprintf buf "%4d indirect\n" anindirect; -+ end; -+ let aninvalid = list_sum sinvalidlist in -+ if aninvalid <> 0 then begin -+ List.iter (Printf.bprintf buf "%4d ") sinvalidlist; -+ Printf.bprintf buf "%4d invalid\n" aninvalid; -+ end -+ end; -+ -+ nall := !nall + m.manager_all_sources; -+ naact := !naact + m.manager_active_sources; -+ end -+ else begin (* m.manager_all_sources = 0 *) -+ if output_type = HTML then begin -+ html_tr (); -+ -+ html_mods_td buf [ -+ ("", "sr ar br", "-"); ("", "sr ar br", ""); -+ ("", "sr ar br", ""); ("", "sr ar br", ""); -+ ("", "sr ar br", ""); ("", "sr ar br", ""); -+ ("", "sr ar br", ""); ("", "sr ar br", ""); -+ ("", "sr ar br", ""); ("", "sr ar br", ""); -+ ("", "sr ar br", ""); ("", "sr ar br", ""); -+ ("", "sr br", shorten name !!max_name_len); ]; -+ Printf.bprintf buf "\\</tr\\>\n"; -+ end -+ else Printf.bprintf buf "None %55s%s\n" "" name; -+ end -+ ) my_file_sources_managers; (* end Files *) -+ -+ (* next Header *) -+ if output_type = HTML then begin -+ Printf.bprintf buf "\\</table\\>\\</div\\>\n"; -+ -+ html_mods_table_header buf "sourcesTable" "sources" [ -+ ( "0", "srh", "New sources", "New" ); -+ ( "0", "srh", "Good sources", "Good" ); -+ ( "0", "srh", "Ready sources", "Ready" ); -+ ( "0", "srh", "Waiting sources", "Wait" ); -+ ( "0", "srh", "Old sources 1", "Old1" ); -+ ( "0", "srh", "Old sources 2", "Old2" ); -+ ( "0", "srh", "Old sources 3", "Old3" ); -+ ( "0", "srh", "Do not try", "nTry" ); -+ ( "0", "srh", "Connected sources", "Conn" ); -+ ( "0", "srh", "Connecting sources", "Cing" ); -+ ( "0", "srh", "Busy sources", "Busy" ); -+ ( "0", "srh", "Total sources", "All" ); -+ ( "0", "srh", "Type", "Type" ); ]; -+ -+ end -+ else -+ Printf.bprintf buf "new good redy wait old1 old2 old3 ntry conn cing busy all\n"; -+ -+ let slist = ref [] in -+ let sreadylist = ref [] in -+ let streadylist = ref [] in -+ let sindirectlist = ref [] in -+ let sinvalidlist = ref [] in -+ let speriodlist = ref [] in -+ (* Queues *) -+ for i = 0 to nqueues - 1 do -+ slist := nsources_per_queue.(i) :: !slist; -+ sreadylist := nready_per_queue.(i) :: !sreadylist; -+ streadylist := count_ready_sources i true :: !streadylist; -+ sindirectlist := nindirect_per_queue.(i) :: !sindirectlist; -+ sinvalidlist := ninvalid_per_queue.(i) :: !sinvalidlist; -+ speriodlist := queue_period.(i) :: !speriodlist; -+ done; (* end Queues *) -+ -+ let nsources = ref 0 in -+ let nroq = ref 0 in -+ HS.iter (fun s -> -+ incr nsources; -+ List.iter (fun r -> -+ if r.request_queue = outside_queue then -+ incr nroq; -+ ) s.source_files; -+ ) sources_by_uid; -+ -+ let slist = List.rev !slist in -+ let sreadylist = List.rev !sreadylist in -+ let streadylist = List.rev !streadylist in -+ let sindirectlist = List.rev !sindirectlist in -+ let sinvalidlist = List.rev !sinvalidlist in -+ let speriodlist = List.rev !speriodlist in -+ -+ if output_type = HTML then begin -+ html_tr (); -+ html_mods_td buf ( -+ (List.map (fun q -> -+ ("", "sr ar", pos_to_string q)) slist) @ -+ [ ("", "sr ar", Printf.sprintf "%d" !nall); -+ ("", "sr", -+ Printf.sprintf "all source managers (%d by UID) (%d ROQ)" -+ !nsources !nroq);] ); -+ Printf.bprintf buf "\\</tr\\>\n"; -+ -+ html_tr (); -+ html_mods_td buf ( -+ (List.map (fun sready -> -+ ("", "sr ar", pos_to_string sready)) sreadylist) @ -+ [ ("", "sr ar", Printf.sprintf "%d" (list_sum sreadylist)); -+ ("", "sr", -+ Printf.sprintf "ready with %d active and %i need sources" -+ !naact !naneed); ] ); -+ Printf.bprintf buf "\\</tr\\>\n"; -+ -+ html_tr (); -+ html_mods_td buf ( -+ (List.map (fun sready -> -+ ("", "sr ar", pos_to_string sready)) streadylist) @ -+ [ ("", "sr ar", Printf.sprintf "%d" (list_sum streadylist)); -+ ("", "sr", "throttled ready"); ] ); -+ Printf.bprintf buf "\\</tr\\>\n"; -+ -+ let anindirect = list_sum sindirectlist in -+ if anindirect <> 0 then begin -+ html_tr (); -+ html_mods_td buf ( -+ (List.map (fun sready -> -+ ("", "sr ar", pos_to_string sready)) sindirectlist) @ -+ [ ("", "sr ar", Printf.sprintf "%d" anindirect); -+ ("", "sr", "indirect"); ] ); -+ Printf.bprintf buf "\\</tr\\>\n"; -+ end; -+ -+ let aninvalid = list_sum sinvalidlist in -+ if aninvalid <> 0 then begin -+ html_tr (); -+ html_mods_td buf ( -+ (List.map (fun sready -> -+ ("", "sr ar", pos_to_string sready)) sinvalidlist) @ -+ [ ("", "sr ar", Printf.sprintf "%d" aninvalid); -+ ("", "sr", "invalid"); ] ); -+ Printf.bprintf buf "\\</tr\\>\n"; -+ end; -+ -+ html_tr (); -+ html_mods_td buf ( -+ (List.map (fun sready -> -+ ("", "sr ar", pos_to_string sready)) speriodlist) @ -+ [ ("", "sr", ""); -+ ("", "sr", "period"); ] ); -+ Printf.bprintf buf "\\</tr\\>\n"; -+ -+ Printf.bprintf buf "\\</table\\>\\</div\\>\n"; -+ end -+ else begin -+ List.iter (Printf.bprintf buf "%4d ") slist; -+ Printf.bprintf buf "%4d all source managers (%d by UID) (%d ROQ)\n" -+ !nall !nsources !nroq; -+ List.iter (Printf.bprintf buf "%4d ") sreadylist; -+ Printf.bprintf buf "%4d ready %d active %i need sources\n" -+ (list_sum sreadylist) !naact !naneed; -+ List.iter (Printf.bprintf buf "%4d ") streadylist; -+ Printf.bprintf buf "%4d throttled ready\n" (list_sum streadylist); -+ let anindirect = list_sum sindirectlist in -+ if anindirect <> 0 then begin -+ List.iter (Printf.bprintf buf "%4d ") sindirectlist; -+ Printf.bprintf buf "%4d indirect\n" anindirect; -+ end; -+ let aninvalid = list_sum sinvalidlist in -+ if aninvalid <> 0 then begin -+ List.iter (Printf.bprintf buf "%4d ") sinvalidlist; -+ Printf.bprintf buf "%4d invalid\n" aninvalid; -+ end; -+ List.iter (Printf.bprintf buf "%4d ") speriodlist; -+ Printf.bprintf buf " period\n"; -+ end; -+ -+ let nconnected = ref 0 in -+ Fifo.iter (fun (_, s) -> -+ if s.source_last_attempt = 0 then incr nconnected; -+ ) connecting_sources; -+ if output_type = HTML then begin -+ html_mods_table_header buf "sourcesTable" "sources" [ -+ ( "0", "srh", "Connecting sources", "Connecting sources" ); -+ ( "0", "srh", "Next direct sources", "Next direct sources" ); -+ ( "0", "srh", "Next indirect sources", "Next indirect sources" ); ]; -+ Printf.bprintf buf "\\<tr class=\\\"dl-1\\\"\\>"; -+ html_mods_td buf [ -+ ("", "sr", (Printf.sprintf "%d entries" -+ (Fifo.length connecting_sources)) ^ -+ (if !nconnected > 0 then -+ Printf.sprintf " (connected: %d)" !nconnected else "")); -+ ("", "sr", Printf.sprintf "%d entries" -+ (Fifo.length next_direct_sources)); -+ ("", "sr", Printf.sprintf "%d entries" -+ (List.length !next_indirect_sources)); ]; -+ Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>\n\\</div\\>" -+ end -+ else begin -+ Printf.bprintf buf "Connecting Sources: %d entries" -+ (Fifo.length connecting_sources); -+ if !nconnected > 0 then -+ Printf.bprintf buf " (connected: %d)" !nconnected; -+ Printf.bprintf buf "\n"; -+ Printf.bprintf buf "Next Direct Sources: %d entries\n" -+ (Fifo.length next_direct_sources); -+ Printf.bprintf buf "Next Indirect Sources: %d entries\n" -+ (List.length !next_indirect_sources) -+ end - - - (*************************************************************************) -@@ -911,55 +867,41 @@ - (* *) - (*************************************************************************) - -- let reschedule_source_for_file saved s r = -- if r.request_queue = outside_queue then -- let queue = -- if r.request_score = not_found_score then -- do_not_try_queue -- else if s.source_last_attempt <> 0 then -- connecting_sources_queue -- else -- match s.source_sock with -- | (NoConnection | ConnectionWaiting _) -> -- (* State (1) *) -- (* Two things matter: the global score and the local score *) -- if s.source_score < 1 then -- (* 2.5.25, replaced expected_score by -- found_score, so that sources which -- only have the file are not put in -- good_sources_queue, unless they have -- an interesting chunk AND not a bad -- rank. *) -- if r.request_score > found_score then -- if saved then -- if -- r.request_time + !!min_reask_delay < last_time () -- then -- ready_saved_sources_queue -- else -- waiting_saved_sources_queue -- else -- if r.request_score = initial_new_source_score then -- new_sources_queue -- else -- good_sources_queue -- else -- if r.request_score >= new_source_score then -- old_sources1_queue -- else -- old_sources2_queue -- else -- if s.source_score < 5 then -- old_sources3_queue -- else -- do_not_try_queue -- -- | Connection _ -> -- (* State (3) *) -- if r.request_time = 0 then -- busy_sources_queue -- else -- connected_sources_queue -+ let reschedule_source_for_file saved s r = -+ if r.request_queue = outside_queue then -+ let queue = -+ if r.request_score = not_found_score then do_not_try_queue -+ else if s.source_last_attempt <> 0 then connecting_sources_queue -+ else -+ match s.source_sock with -+ | (NoConnection | ConnectionWaiting _) -> -+ (* State (1) *) -+ (* Two things matter: the global score and the local score *) -+ if s.source_score < 1 then -+ (* 2.5.25, replaced expected_score by -+ found_score, so that sources which -+ only have the file are not put in -+ good_sources_queue, unless they have -+ an interesting chunk AND not a bad -+ rank. *) -+ if r.request_score > found_score then -+ if saved then -+ if r.request_time + !!min_reask_delay < last_time () then -+ ready_saved_sources_queue -+ else waiting_saved_sources_queue -+ else if r.request_score = initial_new_source_score then -+ new_sources_queue -+ else good_sources_queue -+ else if r.request_score >= new_source_score then -+ old_sources1_queue -+ else old_sources2_queue -+ else if s.source_score < 5 then old_sources3_queue -+ else do_not_try_queue -+ -+ | Connection _ -> -+ (* State (3) *) -+ if r.request_time = 0 then busy_sources_queue -+ else connected_sources_queue - in - let m = r.request_file in - if !verbose_sources > 1 then -@@ -977,18 +919,18 @@ - (* *) - (*************************************************************************) - -- let iter_all_sources f m = -- Array.iter (fun q -> -- Queue.iter (fun (_,s) -> f s) q -- ) m.manager_sources -+ let iter_all_sources f m = -+ Array.iter (fun q -> -+ Queue.iter (fun (_, s) -> f s) q -+ ) m.manager_sources - - (*************************************************************************) - (* iter_qualified_sources *) - (* Only these sources should be used in sourceexchage *) - (*************************************************************************) -- let iter_qualified_sources f m = -- let q = m.manager_sources.(good_sources_queue) in -- Queue.iter (fun (_,s) -> f s) q -+ let iter_qualified_sources f m = -+ let q = m.manager_sources.(good_sources_queue) in -+ Queue.iter (fun (_, s) -> f s) q - - (*************************************************************************) - (* *) -@@ -996,23 +938,23 @@ - (* *) - (*************************************************************************) - -- let iter_active_sources f m = -- for i = connected_sources_queue to busy_sources_queue do -- let q = m.manager_sources.(i) in -- Queue.iter (fun (_,s) -> f s) q -- done -+ let iter_active_sources f m = -+ for i = connected_sources_queue to busy_sources_queue do -+ let q = m.manager_sources.(i) in -+ Queue.iter (fun (_, s) -> f s) q -+ done - - (*************************************************************************) - (* *) - (* iter_relevant_sources *) - (* *) - (*************************************************************************) -- let iter_relevant_sources f m = -- List.iter (fun i -> -- if i < nqueues then -- let q = m.manager_sources.(i) in -- Queue.iter (fun (_,s) -> f s) q -- ) !!relevant_queues -+ let iter_relevant_sources f m = -+ List.iter (fun i -> -+ if i < nqueues then -+ let q = m.manager_sources.(i) in -+ Queue.iter (fun (_, s) -> f s) q -+ ) !!relevant_queues - - (*************************************************************************) - (* *) -@@ -1020,8 +962,8 @@ - (* *) - (*************************************************************************) - -- let set_source_brand s brand = -- s.source_brand <- brand -+ let set_source_brand s brand = -+ s.source_brand <- brand - - (*************************************************************************) - (* *) -@@ -1029,7 +971,7 @@ - (* *) - (*************************************************************************) - -- let source_brand s = s.source_brand -+ let source_brand s = s.source_brand - - (*************************************************************************) - (* *) -@@ -1037,20 +979,20 @@ - (* *) - (*************************************************************************) - -- let remove_from_queue s r = -- if r.request_queue <> outside_queue then begin -- if !verbose_sources > 1 then -- lprintf_nl "[cSrc] Remove source %d from queue %s" s.source_num -- queue_name.(r.request_queue); -- -- let m = r.request_file in -- if active_queue r.request_queue then -- m.manager_active_sources <- m.manager_active_sources - 1; -- Queue.remove r.request_file.manager_sources.(r.request_queue) -- (r.request_time, s); -- r.request_queue <- outside_queue; -- m.manager_all_sources <- m.manager_all_sources - 1 -- end -+ let remove_from_queue s r = -+ if r.request_queue <> outside_queue then begin -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] Remove source %d from queue %s" s.source_num -+ queue_name.(r.request_queue); -+ -+ let m = r.request_file in -+ if active_queue r.request_queue then -+ m.manager_active_sources <- m.manager_active_sources - 1; -+ Queue.remove r.request_file.manager_sources.(r.request_queue) -+ (r.request_time, s); -+ r.request_queue <- outside_queue; -+ m.manager_all_sources <- m.manager_all_sources - 1 -+ end - - (*************************************************************************) - (* *) -@@ -1059,15 +1001,15 @@ - (*************************************************************************) - - (* From state (1) to state (2) *) -- let source_connecting s = -- s.source_last_attempt <- last_time (); -- Fifo.put connecting_sources (s.source_last_attempt, s); -- List.iter (fun r -> -- if r.request_queue <> outside_queue then begin -- remove_from_queue s r; -- reschedule_source_for_file false s r; -- end -- ) s.source_files -+ let source_connecting s = -+ s.source_last_attempt <- last_time (); -+ Fifo.put connecting_sources (s.source_last_attempt, s); -+ List.iter (fun r -> -+ if r.request_queue <> outside_queue then begin -+ remove_from_queue s r; -+ reschedule_source_for_file false s r; -+ end -+ ) s.source_files - - - (*************************************************************************) -@@ -1076,18 +1018,17 @@ - (* *) - (*************************************************************************) - -- let source_query s r = -- remove_from_queue s r; -- if r.request_score > not_found_score then -- (* query_files will query all files for a source, check that we are -- realy downloading! example source s has file f1 and file f2, -- file f2 is paused we connect because of f1 and then query both -- files f1 and f2 ... and yes, we do a cleanup ... but a timed one, -- so we can't be sure *) -- if r.request_score > not_found_score -- && file_state (r.request_file.manager_file ()) = FileDownloading -- then -- begin -+ let source_query s r = -+ remove_from_queue s r; -+ if r.request_score > not_found_score then -+ (* query_files will query all files for a source, check that we are -+ realy downloading! example source s has file f1 and file f2, -+ file f2 is paused we connect because of f1 and then query both -+ files f1 and f2 ... and yes, we do a cleanup ... but a timed one, -+ so we can't be sure *) -+ if r.request_score > not_found_score && -+ file_state (r.request_file.manager_file ()) = FileDownloading -+ then begin - r.request_time <- 0; (* The source is ready for this request *) - reschedule_source_for_file false s r; (* put it in busy_sources_queue *) - (try -@@ -1104,30 +1045,30 @@ - (*************************************************************************) - - (* From state (2) to state (3) *) -- let source_connected s = -- s.source_score <- 0; -- s.source_age <- last_time (); -- s.source_last_attempt <- 0; -- List.iter (fun r -> -+ let source_connected s = -+ s.source_score <- 0; -+ s.source_age <- last_time (); -+ s.source_last_attempt <- 0; -+ List.iter (fun r -> - (* lprintf "SOURCE> request: "; *) -- if r.request_queue <> outside_queue then begin -+ if r.request_queue <> outside_queue then begin - (* lprintf "score %d/%d last query %s\n" - r.request_score possible_score - (if r.request_time = 0 then "never" else - Printf.sprintf "%d secs" - (last_time () - r.request_time)); *) -- remove_from_queue s r; -- if r.request_score > possible_score && -- r.request_time + !!min_reask_delay < last_time () then -- source_query s r; -- (try -- let m = r.request_file in -- functions.function_add_location s.source_uid -- m.manager_uid with _ -> ()); -- reschedule_source_for_file false s r -- end (* else -- lprintf "outside queue\n" *) -- ) s.source_files -+ remove_from_queue s r; -+ if r.request_score > possible_score && -+ r.request_time + !!min_reask_delay < last_time () then -+ source_query s r; -+ (try -+ let m = r.request_file in -+ functions.function_add_location s.source_uid -+ m.manager_uid with _ -> ()); -+ reschedule_source_for_file false s r -+ end -+ (* else lprintf "outside queue\n" *) -+ ) s.source_files - - (*************************************************************************) - (* *) -@@ -1136,53 +1077,49 @@ - (*************************************************************************) - - (* From states (1) or (2) to state (3) *) -- let source_disconnected s = -- (match s.source_sock with -- NoConnection -> () -- | ConnectionWaiting token -> -- cancel_token token; -- s.source_sock <- NoConnection -- | Connection sock -> -- close sock Closed_for_timeout -- ); -- let connecting = s.source_last_attempt <> 0 in -- (* source_last_attempt set to time, on connect_reply set -- to zero. if we never reached connect_reply, the ip is -- dead. Then we think we were *not* trying to connect -- later on ... -- *) -- s.source_last_attempt <- 0; -- List.iter (fun r -> -- if r.request_queue <> outside_queue then -- begin -- remove_from_queue s r; -- if connecting then -- begin -- r.request_time <- last_time (); -- if r.request_score = initial_new_source_score then -- set_score_part r new_source_score -- end -- else -- begin -- if r.request_time = 0 then -- (* we think we were not connecting, -- but in some cases we were! and -- now we imidiately reconnect for -- that file, on a dead IP?? -- r.request_time <- last_time () - 600; -- try this instead: -- *) -- r.request_time <- last_time (); -- (try -- let m = r.request_file in -- functions.function_remove_location s.source_uid -- m.manager_uid -- with _ -> () -- ) -- end; -- reschedule_source_for_file false s r; -- end; -- ) s.source_files -+ let source_disconnected s = -+ (match s.source_sock with -+ | NoConnection -> () -+ | ConnectionWaiting token -> -+ cancel_token token; -+ s.source_sock <- NoConnection -+ | Connection sock -> -+ close sock Closed_for_timeout -+ ); -+ let connecting = s.source_last_attempt <> 0 in -+ (* source_last_attempt set to time, on connect_reply set -+ to zero. if we never reached connect_reply, the ip is -+ dead. Then we think we were *not* trying to connect -+ later on ... -+ *) -+ s.source_last_attempt <- 0; -+ List.iter (fun r -> -+ if r.request_queue <> outside_queue then begin -+ remove_from_queue s r; -+ if connecting then begin -+ r.request_time <- last_time (); -+ if r.request_score = initial_new_source_score then -+ set_score_part r new_source_score -+ end -+ else begin -+ if r.request_time = 0 then -+ (* we think we were not connecting, -+ but in some cases we were! and -+ now we imidiately reconnect for -+ that file, on a dead IP?? -+ r.request_time <- last_time () - 600; -+ try this instead: -+ *) -+ r.request_time <- last_time (); -+ (try -+ let m = r.request_file in -+ functions.function_remove_location s.source_uid -+ m.manager_uid -+ with _ -> ()) -+ end; -+ reschedule_source_for_file false s r; -+ end; -+ ) s.source_files - - (*************************************************************************) - (* *) -@@ -1190,11 +1127,11 @@ - (* *) - (*************************************************************************) - -- let connect_source s = -- if !verbose_sources > 1 then -- lprintf_nl "[cSrc] connect_source"; -- s.source_score <- s.source_score + 1; -- functions.function_connect s.source_uid -+ let connect_source s = -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] connect_source"; -+ s.source_score <- s.source_score + 1; -+ functions.function_connect s.source_uid - - (*************************************************************************) - (* *) -@@ -1202,40 +1139,40 @@ - (* *) - (*************************************************************************) - -- let create_queues () = -- let queues = [| -- (* New sources *) -- (* We should change this to 'oldest_last' to improve Queue.remove *) -- (* instead of lifo *) -- SourcesQueueCreate.oldest_last (); -- (* Good sources *) -- (* We should change this to 'oldest_first' to improve Queue.remove *) -- (* instead of fifo *) -- SourcesQueueCreate.oldest_first (); -- (* Ready saved sources *) -- SourcesQueueCreate.oldest_last (); -- (* Waiting saved sources *) -- SourcesQueueCreate.oldest_first (); -- (* Old sources *) -- (* We should change this to 'oldest_first' to improve Queue.remove *) -- (* instead of fifo *) -- SourcesQueueCreate.oldest_first (); -- SourcesQueueCreate.oldest_first (); -- SourcesQueueCreate.oldest_first (); -- (* do_not_try *) -- SourcesQueueCreate.oldest_first (); -- (* Connected Sources *) -- SourcesQueueCreate.oldest_first (); -- (* Connecting Sources *) -- SourcesQueueCreate.oldest_first (); -- (* Busy Sources *) -- SourcesQueueCreate.oldest_first (); -- |] in -- if Array.length queues <> Array.length queue_name then begin -- lprintf_nl "[cSrc] Fatal error in CommonSources.create_queues"; -- exit 2; -- end; -- queues -+ let create_queues () = -+ let queues = [| -+ (* New sources *) -+ (* We should change this to 'oldest_last' to improve Queue.remove *) -+ (* instead of lifo *) -+ SourcesQueueCreate.oldest_last (); -+ (* Good sources *) -+ (* We should change this to 'oldest_first' to improve Queue.remove *) -+ (* instead of fifo *) -+ SourcesQueueCreate.oldest_first (); -+ (* Ready saved sources *) -+ SourcesQueueCreate.oldest_last (); -+ (* Waiting saved sources *) -+ SourcesQueueCreate.oldest_first (); -+ (* Old sources *) -+ (* We should change this to 'oldest_first' to improve Queue.remove *) -+ (* instead of fifo *) -+ SourcesQueueCreate.oldest_first (); -+ SourcesQueueCreate.oldest_first (); -+ SourcesQueueCreate.oldest_first (); -+ (* do_not_try *) -+ SourcesQueueCreate.oldest_first (); -+ (* Connected Sources *) -+ SourcesQueueCreate.oldest_first (); -+ (* Connecting Sources *) -+ SourcesQueueCreate.oldest_first (); -+ (* Busy Sources *) -+ SourcesQueueCreate.oldest_first (); -+ |] in -+ if Array.length queues <> Array.length queue_name then begin -+ lprintf_nl "[cSrc] Fatal error in CommonSources.create_queues"; -+ exit 2; -+ end; -+ queues - - (*************************************************************************) - (* *) -@@ -1243,16 +1180,16 @@ - (* *) - (*************************************************************************) - -- let create_file_sources_manager file_uid = -- let m = { -- manager_uid = file_uid; -- manager_file = not_implemented "manager_file"; -- manager_all_sources = 0; -- manager_active_sources = 0; -- manager_sources = create_queues (); -- } in -- file_sources_managers := m :: !file_sources_managers; -- m -+ let create_file_sources_manager file_uid = -+ let m = { -+ manager_uid = file_uid; -+ manager_file = not_implemented "manager_file"; -+ manager_all_sources = 0; -+ manager_active_sources = 0; -+ manager_sources = create_queues (); -+ } in -+ file_sources_managers := m :: !file_sources_managers; -+ m - - (*************************************************************************) - (* *) -@@ -1260,17 +1197,13 @@ - (* *) - (*************************************************************************) - -- let remove_file_sources_manager m = -- -- iter_all_sources (fun s -> -- s.source_files <- List.filter (fun r -> -- r.request_file != m -- ) s.source_files; -- ) m; -- -- m.manager_sources <- create_queues (); -- -- file_sources_managers := List2.removeq m !file_sources_managers -+ let remove_file_sources_manager m = -+ iter_all_sources (fun s -> -+ s.source_files <- -+ List.filter (fun r -> r.request_file != m) s.source_files; -+ ) m; -+ m.manager_sources <- create_queues (); -+ file_sources_managers := List2.removeq m !file_sources_managers - - - (*************************************************************************) -@@ -1278,9 +1211,9 @@ - (* number_of_sources *) - (* *) - (*************************************************************************) --(* get number of sources for a file*) -- let number_of_sources f = -- f.manager_all_sources -+ (* get number of sources for a file*) -+ let number_of_sources f = -+ f.manager_all_sources - - (*************************************************************************) - (* *) -@@ -1288,27 +1221,24 @@ - (* *) - (*************************************************************************) - -- let find_source_by_uid uid = -- try -- let finder = { dummy_source with source_uid = uid } in -- let s = HS.find sources_by_uid finder in -- s -- -- with _ -> -- if !verbose_sources > 1 then -- lprintf_nl "[cSrc] Creating new source"; -- let n = CommonClient.book_client_num () in -- let s = { dummy_source with -- source_uid = uid; -- source_age = 0; -- source_num = n; -- source_files = []; -- } in -- -- -- HS.add sources_by_uid s; -- H.add sources_by_num s; -- s -+ let find_source_by_uid uid = -+ try -+ let finder = { dummy_source with source_uid = uid } in -+ HS.find sources_by_uid finder -+ -+ with Not_found -> -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] Creating new source"; -+ let n = CommonClient.book_client_num () in -+ let s = { dummy_source with -+ source_uid = uid; -+ source_age = 0; -+ source_num = n; -+ source_files = []; -+ } in -+ HS.add sources_by_uid s; -+ H.add sources_by_num s; -+ s - - (*************************************************************************) - (* *) -@@ -1316,10 +1246,9 @@ - (* *) - (*************************************************************************) - -- let find_source_by_num num = -- let finder = { dummy_source with source_num = num } in -- let s = H.find sources_by_num finder in -- s -+ let find_source_by_num num = -+ let finder = { dummy_source with source_num = num } in -+ H.find sources_by_num finder - - (*************************************************************************) - (* *) -@@ -1327,15 +1256,15 @@ - (* *) - (*************************************************************************) - -- let rec iter_has_request rs file = -- match rs with -- [] -> raise Not_found -- | r :: tail -> -- if r.request_file == file then r else -- iter_has_request tail file -+ let rec iter_has_request rs file = -+ match rs with -+ | [] -> raise Not_found -+ | r :: tail -> -+ if r.request_file == file then r -+ else iter_has_request tail file - -- let find_request s file = -- iter_has_request s.source_files file -+ let find_request s file = -+ iter_has_request s.source_files file - - (*************************************************************************) - (* *) -@@ -1343,15 +1272,15 @@ - (* *) - (*************************************************************************) - -- let find_request_result s file = -- let r = find_request s file in -- let score = r.request_score in -- if score <= not_found_score then File_not_found else -- if score <= possible_score then File_possible else -- if score <= found_score then File_found else -- if score <= chunk_score then File_chunk else -- if score <= initial_new_source_score then File_new_source else -- assert false -+ let find_request_result s file = -+ let r = find_request s file in -+ let score = r.request_score in -+ if score <= not_found_score then File_not_found -+ else if score <= possible_score then File_possible -+ else if score <= found_score then File_found -+ else if score <= chunk_score then File_chunk -+ else if score <= initial_new_source_score then File_new_source -+ else assert false - - (*************************************************************************) - (* *) -@@ -1359,35 +1288,31 @@ - (* *) - (*************************************************************************) - -- let check_time time = -- if time = 0 then -- last_time () - 650 -- else -- time (* changed 2.5.24 *) -- -- let add_request s file time = -- let r = -- try -- let r = find_request s file in -- remove_from_queue s r; -- set_score_part r (if r.request_score = initial_new_source_score then -- new_source_score -- else -- r.request_score - 1); -- r.request_time <- check_time time; -- r -- with Not_found -> -- let r = { -- request_file = file; -- request_time = check_time time; -- request_score = possible_score; -- request_queue = outside_queue; -- } in -- s.source_files <- r :: s.source_files; -- r -- in -- reschedule_source_for_file false s r; -- r -+ let check_time time = -+ if time = 0 then last_time () - 650 -+ else time (* changed 2.5.24 *) -+ -+ let add_request s file time = -+ let r = -+ try -+ let r = find_request s file in -+ remove_from_queue s r; -+ set_score_part r (if r.request_score = initial_new_source_score then -+ new_source_score -+ else r.request_score - 1); -+ r.request_time <- check_time time; -+ r -+ with Not_found -> -+ let r = { -+ request_file = file; -+ request_time = check_time time; -+ request_score = possible_score; -+ request_queue = outside_queue; -+ } in -+ s.source_files <- r :: s.source_files; -+ r in -+ reschedule_source_for_file false s r; -+ r - - (*************************************************************************) - (* *) -@@ -1395,40 +1320,39 @@ - (* *) - (*************************************************************************) - -- let rec set_request_score s file score = -- try -- let r = find_request s file in -- if (not ( -+ let rec set_request_score s file score = -+ try -+ let r = find_request s file in -+ if (not ( - (* If a request has been done in the last half-hour, and the source is - announced as new, just forget it. : why half-hour? - trying min_reask_delay *) -- score = initial_new_source_score && -- r.request_time + !!min_reask_delay > last_time () -- )) -+ score = initial_new_source_score && -+ r.request_time + !!min_reask_delay > last_time () -+ )) || - (* If a file has been paused, and resumed, it is flagged outside_queue / not_found_score in - clean_sources, but really should be re-added to the queues as soon as possible (while retaining - its request_time) or it is skipped for far too long (if it is even found again) - reschedule - now puts new_source_score in old1 *) -- || (score = initial_new_source_score -- && r.request_queue = outside_queue) then -- let score = -- if score = initial_new_source_score -- then new_source_score -- else score -- in -- if r.request_queue < connected_sources_queue then -- remove_from_queue s r; -- set_score_part r score; -- reschedule_source_for_file false s r; -- with Not_found -> -- let r = { -- request_file = file; -- request_time = check_time 0; -- request_score = possible_score; -- request_queue = outside_queue; -- } in -- set_score_part r score; -- s.source_files <- r :: s.source_files; -- reschedule_source_for_file false s r -+ (score = initial_new_source_score && -+ r.request_queue = outside_queue) then -+ let score = -+ if score = initial_new_source_score -+ then new_source_score -+ else score in -+ if r.request_queue < connected_sources_queue then -+ remove_from_queue s r; -+ set_score_part r score; -+ reschedule_source_for_file false s r; -+ with Not_found -> -+ let r = { -+ request_file = file; -+ request_time = check_time 0; -+ request_score = possible_score; -+ request_queue = outside_queue; -+ } in -+ set_score_part r score; -+ s.source_files <- r :: s.source_files; -+ reschedule_source_for_file false s r - - (*************************************************************************) - (* *) -@@ -1436,9 +1360,10 @@ - (* *) - (*************************************************************************) - -- let set_request_result s file result = -- set_request_score s file (match result with -- File_not_found -> not_found_score -+ let set_request_result s file result = -+ set_request_score s file -+ (match result with -+ | File_not_found -> not_found_score - | File_found -> found_score - | File_chunk -> chunk_score - | File_upload -> upload_score -@@ -1451,29 +1376,27 @@ - (* *) - (*************************************************************************) - -- let source_to_value s assocs = -- let requests = ref [] in -- List.iter (fun r -> -- if r.request_score > possible_score then -- -- requests := -- (SmallList -- [once_value (string_to_value r.request_file.manager_uid); -- int_to_value r.request_score; -- int_to_value r.request_time] -- ) :: -- !requests -- ) s.source_files; -- if !requests = [] then raise Exit; -- ( -- ("sscore", int_to_value s.source_score ) :: -- ("addr", M.source_uid_to_value s.source_uid ) :: -- ("brand", M.source_brand_to_value s.source_brand ) :: -- ("files", smalllist_to_value (fun s -> s) -- !requests) :: -- ("age", int_to_value s.source_age ) :: -- assocs -- ) -+ let source_to_value s assocs = -+ let requests = ref [] in -+ List.iter (fun r -> -+ if r.request_score > possible_score then -+ requests := -+ (SmallList -+ [once_value (string_to_value r.request_file.manager_uid); -+ int_to_value r.request_score; -+ int_to_value r.request_time] -+ ) :: !requests -+ ) s.source_files; -+ if !requests = [] then raise Exit; -+ ( -+ ("sscore", int_to_value s.source_score ) :: -+ ("addr", M.source_uid_to_value s.source_uid ) :: -+ ("brand", M.source_brand_to_value s.source_brand ) :: -+ ("files", smalllist_to_value (fun s -> s) -+ !requests) :: -+ ("age", int_to_value s.source_age ) :: -+ assocs -+ ) - - - (*************************************************************************) -@@ -1482,15 +1405,15 @@ - (* *) - (*************************************************************************) - -- let query_file s file = -- if file_state (file.manager_file ()) = FileDownloading then -- let r = find_request s file in -- if r.request_time + !!min_reask_delay <= last_time () then -- -- (* There is really no need to query a not found source again -- for the file ... not even after an hour! *) -- if r.request_score > not_found_score then -- source_query s r -+ let query_file s file = -+ if file_state (file.manager_file ()) = FileDownloading then -+ let r = find_request s file in -+ if r.request_time + !!min_reask_delay <= last_time () then -+ -+ (* There is really no need to query a not found source again -+ for the file ... not even after an hour! *) -+ if r.request_score > not_found_score then -+ source_query s r - - - (*************************************************************************) -@@ -1498,11 +1421,11 @@ - (* query_files *) - (* *) - (*************************************************************************) --(* Query a source for all of its known files*) -- let query_files s = -- List.iter (fun f -> -- query_file s f.request_file; -- ) s.source_files -+ (* Query a source for all of its known files*) -+ let query_files s = -+ List.iter (fun f -> -+ query_file s f.request_file; -+ ) s.source_files - - - (*************************************************************************) -@@ -1511,23 +1434,23 @@ - (* *) - (*************************************************************************) - -- let add_saved_source_request s uid score time = -- if !verbose_sources > 1 then -- lprintf_nl "[cSrc] Request %s %d %d" uid score time; -- let file = -- try -- functions.function_string_to_manager uid -- with e -> -- if !verbose_sources > 0 then -- lprintf_nl "[cSrc] CommonSources: add_saved_source_request -> %s not found" uid; -- raise e -- in -- let r = add_request s file time in -- set_score_part r score; -- reschedule_source_for_file true s r; -- if !verbose_sources > 1 then -- lprintf_nl "[cSrc] Put saved source %d in queue %s" s.source_num -- queue_name.(r.request_queue) -+ let add_saved_source_request s uid score time = -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] Request %s %d %d" uid score time; -+ let file = -+ try -+ functions.function_string_to_manager uid -+ with e -> -+ if !verbose_sources > 0 then -+ lprintf_nl "[cSrc] CommonSources: add_saved_source_request -> %s not found" uid; -+ raise e -+ in -+ let r = add_request s file time in -+ set_score_part r score; -+ reschedule_source_for_file true s r; -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] Put saved source %d in queue %s" s.source_num -+ queue_name.(r.request_queue) - - (*************************************************************************) - (* *) -@@ -1535,79 +1458,73 @@ - (* *) - (*************************************************************************) - -- let value_to_source assocs = -+ let value_to_source assocs = - (* lprintf "(1) value_to_source\n"; *) -- let get_value name conv = conv (List.assoc name assocs) in -+ let get_value name conv = conv (List.assoc name assocs) in - -- let addr = get_value "addr" M.value_to_source_uid in -- let files = get_value "files" -- (value_to_list (fun s -> s)) in -- -- let last_conn = -- try get_value "age" value_to_int with _ -> 0 -- in -- -- let score = try get_value "sscore" value_to_int with _ -> 0 in -- let brand = try get_value "brand" M.value_to_source_brand with _ -> -- M.dummy_source_brand in -- -- if !verbose_sources > 1 then -- lprintf_nl "[cSrc] New source from value"; -- let s = find_source_by_uid addr in -- s.source_score <- score; -- s.source_age <- last_conn; -- s.source_brand <- brand; -+ let addr = get_value "addr" M.value_to_source_uid in -+ let files = get_value "files" -+ (value_to_list (fun s -> s)) in -+ -+ let last_conn = -+ try get_value "age" value_to_int with _ -> 0 in -+ -+ let score = try get_value "sscore" value_to_int with _ -> 0 in -+ let brand = try get_value "brand" M.value_to_source_brand with _ -> -+ M.dummy_source_brand in -+ -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] New source from value"; -+ let s = find_source_by_uid addr in -+ s.source_score <- score; -+ s.source_age <- last_conn; -+ s.source_brand <- brand; - - (* lprintf "(2) value_to_source \n"; *) - -- let rec iter v = -- match v with -- OnceValue v -> iter v -- | List [uid; score; time] | SmallList [uid; score; time] -> -- (try -- let uid = value_to_string uid in -- let score = value_to_int score in -- let time = value_to_int time in -+ let rec iter v = -+ match v with -+ | OnceValue v -> iter v -+ | List [uid; score; time] | SmallList [uid; score; time] -> -+ (try -+ let uid = value_to_string uid in -+ let score = value_to_int score in -+ let time = value_to_int time in - - (* added in 2.5.27 to fix a bug introduced in 2.5.25 *) -- let score = -- if score land 0xffff = 0 then score asr 16 else score -- in -+ let score = -+ if score land 0xffff = 0 then score asr 16 else score in - - (* lprintf "(3) value_to_source \n"; *) - -- add_saved_source_request s uid score time -+ add_saved_source_request s uid score time - -- with e -> -- if !verbose_sources > 1 then begin -- lprintf_nl "[cSrc] CommonSources.value_to_source: exception %s in iter request" -- (Printexc2.to_string e); -- end -- ) -- | (StringValue _) as uid -> -- (try -- let uid = value_to_string uid in -+ with e -> -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] CommonSources.value_to_source: exception %s in iter request" -+ (Printexc2.to_string e)) -+ -+ | (StringValue _) as uid -> -+ (try -+ let uid = value_to_string uid in - (* lprintf "(4) value_to_source \n"; *) - -- let score = 0 in -- let time = 0 in -- add_saved_source_request s uid score time -- -- with e -> -- if !verbose_sources > 1 then begin -- lprintf_nl "[cSrc] CommonSources.value_to_source: exception %s in iter request" -- (Printexc2.to_string e); -- end -- ) -- | _ -> assert false -- -- in -+ let score = 0 in -+ let time = 0 in -+ add_saved_source_request s uid score time -+ -+ with e -> -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] CommonSources.value_to_source: exception %s in iter request" -+ (Printexc2.to_string e)) -+ -+ | _ -> assert false -+ -+ in - (* lprintf "(5) value_to_source \n"; *) -- -- List.iter iter files; -+ List.iter iter files; - (* lprintf "(6) value_to_source \n"; *) -- -- raise SideEffectOption -+ raise SideEffectOption - - (*************************************************************************) - (* *) -@@ -1615,7 +1532,7 @@ - (* *) - (*************************************************************************) - -- let refill_sources () = -+ let refill_sources () = - - (* Wait for 9 seconds before refilling, since we put at least 10 seconds - of clients in the previous bucket. -@@ -1624,279 +1541,257 @@ - we may have failed to fill the queue with what was available - if !last_refill + 8 < last_time () then - *) -- try -- last_refill := last_time (); -- if !verbose_sources > 0 then begin -- lprintf_nl "[cSrc] CommonSources.refill_sources BEFORE:"; -- let buf = Buffer.create 100 in -- print buf TEXT; -- lprintf "%s\n" (Buffer.contents buf); -- end; -- -- (* -- how much consecutive sources in the queue a file can have -- source_f1|source_f1|source_f1|source_f2... -- <- - - - - - - 3 - - - - - -> -- 10 for finer priority scaling -- *) -- let max_consecutive = 10 in -- -- (* -- get at most nsources direct sources from a file -- return number of sources found,new queue position -- *) -- let rec get_sources nsource m queue took = -- (* do_not_try == avoid source bounceback, i.e. a dustbin *) -- if queue >= do_not_try_queue || nsource <= 0 then -- (* we tried all queue or found enough sources, good bye!*) -- took -- else -- let q = m.manager_sources.(queue) in -- if Queue.length q > 0 then -- let (request_time, s) = Queue.head q in -- let throttled = queue_period.(queue) > 0 && nsource > 1 in -- let throttle_delay = get_throttle_delay m queue throttled in -- if request_time + !!min_reask_delay + throttle_delay < last_time () then -- begin -- if !verbose_sources > 1 then -- lprintf_nl "[cSrc] Sources: take source from Queue[%s] for %s" -- queue_name.(queue) -- (file_best_name (m.manager_file ())); -- (* put in the connecting queue*) -- source_connecting s; -- if M.direct_source s.source_uid then -- begin -- Fifo.put next_direct_sources s; -- (* we found a direct source try again in the _same_ queue *) -- get_sources (nsource-1) m queue (took+1) -- end -- else -- begin -- next_indirect_sources := s :: !next_indirect_sources; -- (* we found an indirect source try again in the _same_ -- queue. indirect sources are "for free". *) -- get_sources nsource m queue took -- end -- end -- else -- begin -- if !verbose_sources > 1 then -- lprintf_nl "[cSrc] Source of queue %s is not ready for %s" -- queue_name.(queue) (file_best_name (m.manager_file ())); -- (* too early to take sources in this queue try again in the _next_ queue*) -- if queue_period.(queue) = 0 then -- (* queue not throttled, try next queue *) -- let to_take = -- (* a maximum of just one source from old3 queue *) -- if queue+1 >= old_sources3_queue then -- (min 1 nsource) -- else -- nsource -- in -- get_sources to_take m (queue+1) took -- else -- (* throttled queue, and no ready sources ... *) -- if nsource = 1 then -- (* nsource = 1 not even a ready source without throttle-delay *) -- get_sources 0 m (queue) took -- (* exit here *) -- else -- (* finaly try to take at least one source, regardless of throttles *) -- get_sources 1 m (queue) took -- end -- else -- begin -- if !verbose_sources > 1 then -- lprintf_nl "[cSrc] Queue %s is empty for %s" -- queue_name.(queue) (file_best_name (m.manager_file ())); -- (* no sources in this queue try again in the _next_ queue *) -- let to_take = -- (* a maximum of just one source from old3 queue *) -- if queue+1 >= old_sources3_queue then -- (min 1 nsource) -- else -- nsource -- in -- get_sources to_take m (queue+1) took -- end -- in -- -- (* recalc list if there's no new file*) -- (* Fill only with sources from files being downloaded *) -+ try -+ last_refill := last_time (); -+ if !verbose_sources > 0 then begin -+ lprintf_nl "[cSrc] CommonSources.refill_sources BEFORE:"; -+ let buf = Buffer.create 100 in -+ print buf TEXT; -+ lprintf "%s\n" (Buffer.contents buf); -+ end; -+ -+ (* -+ how much consecutive sources in the queue a file can have -+ source_f1|source_f1|source_f1|source_f2... -+ <- - - - - - - 3 - - - - - -> -+ 10 for finer priority scaling -+ *) -+ let max_consecutive = 10 in - -- let nfiles = ref 0 in -- let files = ref [] in -- let min_priority = ref 0 in -- let sum_priority = ref 0 in -- List.iter (fun m -> -- match file_state (m.manager_file ()) with -- FileDownloading -> -- let priority = file_priority (m.manager_file ()) in -- min_priority := min !min_priority priority; -- sum_priority := !sum_priority + priority; -- files := (priority, m ) :: !files; -- incr nfiles -- | _ -> () -- ) !file_sources_managers; -- -- if !files <> [] then begin -- -- (* 'normalize' to 0 priorities*) -- sum_priority := !sum_priority + (!nfiles * (-(!min_priority))); -- (* update priorities to be > 0 *) -- files := List.map ( fun (p,f) -> -- let np = p - (!min_priority) in -- if np==0 then -- begin -- sum_priority := !sum_priority + 1; -- (1,f) -+ (* -+ get at most nsources direct sources from a file -+ return number of sources found,new queue position -+ *) -+ let rec get_sources nsource m queue took = -+ (* do_not_try == avoid source bounceback, i.e. a dustbin *) -+ if queue >= do_not_try_queue || nsource <= 0 then -+ (* we tried all queue or found enough sources, good bye!*) -+ took -+ else -+ let q = m.manager_sources.(queue) in -+ if Queue.length q > 0 then -+ let (request_time, s) = Queue.head q in -+ let throttled = queue_period.(queue) > 0 && nsource > 1 in -+ let throttle_delay = get_throttle_delay m queue throttled in -+ if request_time + !!min_reask_delay + throttle_delay < last_time () then begin -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] Sources: take source from Queue[%s] for %s" -+ queue_name.(queue) -+ (file_best_name (m.manager_file ())); -+ (* put in the connecting queue*) -+ source_connecting s; -+ if M.direct_source s.source_uid then begin -+ Fifo.put next_direct_sources s; -+ (* we found a direct source try again in the _same_ queue *) -+ get_sources (nsource-1) m queue (took+1) - end -- else -- (np,f) -- ) !files; -- -- (*sort by highest priority*) -- files := List.sort (fun (p1,_) (p2,_) -> compare p2 p1) !files; -- -- (* calc sources queue size -- at least 3 sources per file*) -- let nsources = max (!nfiles*3) -- (functions.function_max_connections_per_second () * 10) in -- -- (* calc how much sources a file can get according to its priority*) -- let sources_per_prio = (float_of_int nsources) /. (float_of_int !sum_priority) in -- -- -- (* -- iter through files to queue sources -- flist_todo : next files to test -- assigned : number of sources already queued -- looped : number of times we allow to loop try to fill queue of sources -+ else begin -+ next_indirect_sources := s :: !next_indirect_sources; -+ (* we found an indirect source try again in the _same_ -+ queue. indirect sources are "for free". *) -+ get_sources nsource m queue took -+ end -+ end -+ else begin -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] Source of queue %s is not ready for %s" -+ queue_name.(queue) (file_best_name (m.manager_file ())); -+ (* too early to take sources in this queue try again in the _next_ queue*) -+ if queue_period.(queue) = 0 then -+ (* queue not throttled, try next queue *) -+ let to_take = -+ (* a maximum of just one source from old3 queue *) -+ if queue+1 >= old_sources3_queue then min 1 nsource -+ else nsource in -+ get_sources to_take m (queue+1) took -+ else -+ (* throttled queue, and no ready sources ... *) -+ if nsource = 1 then -+ (* nsource = 1 not even a ready source without throttle-delay *) -+ get_sources 0 m (queue) took -+ (* exit here *) -+ else -+ (* finaly try to take at least one source, regardless of throttles *) -+ get_sources 1 m (queue) took -+ end -+ else begin -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] Queue %s is empty for %s" -+ queue_name.(queue) (file_best_name (m.manager_file ())); -+ (* no sources in this queue try again in the _next_ queue *) -+ let to_take = -+ (* a maximum of just one source from old3 queue *) -+ if queue+1 >= old_sources3_queue then min 1 nsource -+ else nsource in -+ get_sources to_take m (queue+1) took -+ end in -+ -+ (* recalc list if there's no new file*) -+ (* Fill only with sources from files being downloaded *) -+ -+ let nfiles = ref 0 in -+ let files = ref [] in -+ let min_priority = ref 0 in -+ let sum_priority = ref 0 in -+ List.iter (fun m -> -+ match file_state (m.manager_file ()) with -+ | FileDownloading -> -+ let priority = file_priority (m.manager_file ()) in -+ min_priority := min !min_priority priority; -+ sum_priority := !sum_priority + priority; -+ files := (priority, m ) :: !files; -+ incr nfiles -+ | _ -> () ) !file_sources_managers; -+ -+ if !files <> [] then begin -+ -+ (* 'normalize' to 0 priorities*) -+ sum_priority := !sum_priority + (!nfiles * (-(!min_priority))); -+ (* update priorities to be > 0 *) -+ files := List.map (fun (p, f) -> -+ let np = p - (!min_priority) in -+ if np = 0 then begin -+ incr sum_priority; -+ (1, f) -+ end -+ else (np, f) ) !files; -+ -+ (*sort by highest priority*) -+ files := List.sort (fun (p1,_) (p2,_) -> compare p2 p1) !files; -+ -+ (* calc sources queue size -+ at least 3 sources per file*) -+ let nsources = max (!nfiles * 3) -+ (functions.function_max_connections_per_second () * 10) in -+ -+ (* calc how much sources a file can get according to its priority*) -+ let sources_per_prio = -+ (float_of_int nsources) /. (float_of_int !sum_priority) in -+ -+ -+ (* -+ iter through files to queue sources -+ flist_todo : next files to test -+ assigned : number of sources already queued -+ looped : number of times we allow to loop try to fill queue of sources - (how hard we try to fill queue) -- *) -- let rec iter_files assigned looped = -+ *) -+ let rec iter_files assigned looped = - -- (* throw in new sources at high pace and do not care -- about them in get_sources, this avoids "locking" a -- file's queue sources with thousands of new sources -- from SE *) -- let try_some_new_sources () = -- let extr = ref 0 in -- List.iter -- (fun m -> -- let f = m.manager_file () in -- let q = m.manager_sources.(new_sources_queue) in -- if file_state f = FileDownloading && Queue.length q > 0 then -+ (* throw in new sources at high pace and do not care -+ about them in get_sources, this avoids "locking" a -+ file's queue sources with thousands of new sources -+ from SE *) -+ let try_some_new_sources () = -+ let extr = ref 0 in -+ List.iter (fun m -> -+ let f = m.manager_file () in -+ let q = m.manager_sources.(new_sources_queue) in -+ if file_state f = FileDownloading && Queue.length q > 0 then -+ let (request_time, s) = Queue.head q in -+ source_connecting s; -+ if M.direct_source s.source_uid then begin -+ incr extr; -+ Fifo.put next_direct_sources s -+ end -+ else -+ next_indirect_sources := s :: !next_indirect_sources -+ ) !file_sources_managers; -+ !extr in -+ -+ let cleanup_some_old_sources () = -+ (* Cleanup some sources *) -+ List.iter (fun m -> -+ let f = m.manager_file () in -+ if file_state f = FileDownloading then -+ let remove_old q t = -+ if Queue.length q > 0 then - let (request_time, s) = Queue.head q in -- source_connecting s; -- if M.direct_source s.source_uid then begin -- incr extr; -- Fifo.put next_direct_sources s -- end -- else -- next_indirect_sources := s :: !next_indirect_sources -- ) !file_sources_managers; -- !extr in -- -- let cleanup_some_old_sources () = -- (* Cleanup some sources *) -- List.iter -- (fun m -> -- let f = m.manager_file () in -- if file_state f = FileDownloading then -- let remove_old q t = -- if Queue.length q > 0 then -- let (request_time, s) = Queue.head q in -- if request_time + t < last_time () then -- remove_from_queue s (find_request s m) in -+ if request_time + t < last_time () then -+ remove_from_queue s (find_request s m) in - -- remove_old m.manager_sources.(do_not_try_queue) 14400; -- remove_old m.manager_sources.(old_sources3_queue) 2400; -- remove_old m.manager_sources.(old_sources2_queue) 1200 -- ) !file_sources_managers in -- -- let rec aux flist_todo assigned = -- if assigned >= nsources then -- cleanup_some_old_sources () -- else -- match flist_todo with -- | (prio, file) :: t -> -- let tt = min (truncate (sources_per_prio *. (float_of_int prio))) -- max_consecutive in -- let to_take = max tt 1 in -- (* allow at least one source per file : -- we will overflow a bit the expected next_direct_sources length -- but it's for the good cause : not 'starving' some files -- *) -- let took = get_sources to_take file good_sources_queue 0 in -- aux t (assigned + took) -+ remove_old m.manager_sources.(do_not_try_queue) 14400; -+ remove_old m.manager_sources.(old_sources3_queue) 2400; -+ remove_old m.manager_sources.(old_sources2_queue) 1200 -+ ) !file_sources_managers in -+ -+ let rec aux flist_todo assigned = -+ if assigned >= nsources then cleanup_some_old_sources () -+ else -+ match flist_todo with -+ | (prio, file) :: t -> -+ let tt = -+ min (truncate (sources_per_prio *. (float_of_int prio))) -+ max_consecutive in -+ let to_take = max tt 1 in -+ (* allow at least one source per file : -+ we will overflow a bit the expected next_direct_sources length -+ but it's for the good cause : not 'starving' some files -+ *) -+ let took = get_sources to_take file good_sources_queue 0 in -+ aux t (assigned + took) - -- | [] -> -- cleanup_some_old_sources (); -+ | [] -> -+ cleanup_some_old_sources (); - -- (* more power to the "runaway" (most overloaded) file, pick extra sources *) -- let em = -- let q = find_throttled_queue good_sources_queue in -- if queue_period.(q) > 0 then -- let max_overloaded = -- List.hd (find_max_overloaded q !file_sources_managers) in -- let overhead = -- count_file_ready_sources max_overloaded q true in -- if overhead > 0 then -- get_sources max_consecutive max_overloaded good_sources_queue 0 -- else 0 -- else 0 in -+ (* more power to the "runaway" (most overloaded) file, pick extra sources *) -+ let em = -+ let q = find_throttled_queue good_sources_queue in -+ if queue_period.(q) > 0 then -+ let max_overloaded = -+ List.hd (find_max_overloaded q !file_sources_managers) in -+ let overhead = -+ count_file_ready_sources max_overloaded q true in -+ if overhead > 0 then -+ get_sources max_consecutive max_overloaded good_sources_queue 0 -+ else 0 -+ else 0 in - -- if looped > 0 then -- (* allow at most looped re-iter of list to not -- loop endlessly *) -- iter_files (assigned + em) (looped - 1) -- in -- let extr = try_some_new_sources () in -- aux !files (assigned + extr) -- -- in -- iter_files 0 3; -- -- (* adjust queue throttling *) -- let all_ready = ref 0 in -- List.iter -- (fun q -> -- let queue_throttled_ready = count_ready_sources q true in -- let queue_ready = count_ready_sources q false in -- all_ready := !all_ready + queue_throttled_ready; -- if !all_ready > nsources && queue_throttled_ready > 0 then -- (* no need, to increase period on a queue without ready sources *) -- begin -- (* lprintf "commonSources: increasing queue throttling for (ar=%d rc=%d qr=%d) %s\n" !allReady nsources queueReady queue_name.(q); *) -- queue_period.( q ) <- queue_period.( q ) + 1 -- end -- else -- begin -- if queue_ready = 0 then -- begin -- (* lprintf "commonSources: resetting queue throttling to 0 (ar=%d rc=%d qr=%d) %s\n" !allReady nsources queueReady queue_name.(q); *) -- queue_period.( q ) <- 0 -- end -- else -- begin -- (* lprintf "commonSources: decreasing queue throttling for (ar=%d rc=%d qr=%d) %s\n" !allReady nsources queueReady queue_name.(q); *) -- queue_period.( q ) <- max 0 (queue_period.( q ) - 1) -- end -- end -- ) [ good_sources_queue; old_sources1_queue; old_sources2_queue; old_sources3_queue ]; -- -- end; -- -- if !verbose_sources > 0 then begin -- lprintf_nl "[cSrc] CommonSources.refill_sources AFTER:"; -- let buf = Buffer.create 100 in -- print buf TEXT; -- lprintf "%s\n" (Buffer.contents buf); -- end; -- with e -> -- lprintf_nl "[cSrc] Exception %s in refill_sources" -- (Printexc2.to_string e) -+ if looped > 0 then -+ (* allow at most looped re-iter of list to not -+ loop endlessly *) -+ iter_files (assigned + em) (looped - 1) -+ in -+ let extr = try_some_new_sources () in -+ aux !files (assigned + extr) -+ -+ in -+ iter_files 0 3; -+ -+ (* adjust queue throttling *) -+ let all_ready = ref 0 in -+ List.iter (fun q -> -+ let queue_throttled_ready = count_ready_sources q true in -+ let queue_ready = count_ready_sources q false in -+ all_ready := !all_ready + queue_throttled_ready; -+ if !all_ready > nsources && queue_throttled_ready > 0 then begin -+ (* no need, to increase period on a queue without ready sources *) -+ (* lprintf "commonSources: increasing queue throttling for (ar=%d rc=%d qr=%d) %s\n" !allReady nsources queueReady queue_name.(q); *) -+ queue_period.( q ) <- queue_period.( q ) + 1 -+ end -+ else begin -+ if queue_ready = 0 then begin -+ (* lprintf "commonSources: resetting queue throttling to 0 (ar=%d rc=%d qr=%d) %s\n" !allReady nsources queueReady queue_name.(q); *) -+ queue_period.( q ) <- 0 -+ end -+ else begin -+ (* lprintf "commonSources: decreasing queue throttling for (ar=%d rc=%d qr=%d) %s\n" !allReady nsources queueReady queue_name.(q); *) -+ queue_period.( q ) <- max 0 (queue_period.( q ) - 1) -+ end -+ end -+ ) [ good_sources_queue; old_sources1_queue; old_sources2_queue; old_sources3_queue ]; -+ -+ end; -+ -+ if !verbose_sources > 0 then begin -+ lprintf_nl "[cSrc] CommonSources.refill_sources AFTER:"; -+ let buf = Buffer.create 100 in -+ print buf TEXT; -+ lprintf "%s\n" (Buffer.contents buf); -+ end; -+ with e -> -+ lprintf_nl "[cSrc] Exception %s in refill_sources" -+ (Printexc2.to_string e) - - - (*************************************************************************) -@@ -1904,19 +1799,17 @@ - (* clean_sources helper *) - (* *) - (*************************************************************************) --let put_all_outside_queue m q queue = -- let _, s = Queue.take q in -- m.manager_all_sources <- m.manager_all_sources - 1; -- if active_queue queue then -- m.manager_active_sources <- m.manager_active_sources - 1; -- List.iter -- (fun r -> -- if r.request_file == m then -- begin -- r.request_queue <- outside_queue; -- set_score_part r not_found_score -- end -- ) s.source_files -+ let put_all_outside_queue m q queue = -+ let _, s = Queue.take q in -+ m.manager_all_sources <- m.manager_all_sources - 1; -+ if active_queue queue then -+ m.manager_active_sources <- m.manager_active_sources - 1; -+ List.iter (fun r -> -+ if r.request_file == m then begin -+ r.request_queue <- outside_queue; -+ set_score_part r not_found_score -+ end -+ ) s.source_files - - (*************************************************************************) - (* *) -@@ -1924,48 +1817,44 @@ - (* *) - (*************************************************************************) - -- let clean_sources () = -- (* Maybe this should be dependant on the file (priority, state,...) ? *) -- let max_sources_per_file = functions.function_max_sources_per_file () in -- List.iter -- (fun m -> -- match file_state (m.manager_file ()) with -- FileDownloading -> -- let nsources = m.manager_all_sources in -- if nsources > max_sources_per_file then -- let rec iter nsources q queue = -- if nsources > 0 then -- if Queue.length q > 0 -- && queue <> good_sources_queue -- then -- begin -- put_all_outside_queue m q queue; -- iter (nsources-1) q queue -- end -- else -- let do_iter q = iter nsources m.manager_sources.(q) q in -+ let clean_sources () = -+ (* Maybe this should be dependant on the file (priority, state,...) ? *) -+ let max_sources_per_file = functions.function_max_sources_per_file () in -+ List.iter (fun m -> -+ match file_state (m.manager_file ()) with -+ | FileDownloading -> -+ let nsources = m.manager_all_sources in -+ if nsources > max_sources_per_file then -+ let rec iter nsources q queue = -+ if nsources > 0 then -+ if Queue.length q > 0 && -+ queue <> good_sources_queue then begin -+ put_all_outside_queue m q queue; -+ iter (nsources-1) q queue -+ end -+ else -+ let do_iter q = iter nsources m.manager_sources.(q) q in - -- if queue = old_sources1_queue then do_iter do_not_try_queue else -- if queue = do_not_try_queue then do_iter new_sources_queue else -- if queue = new_sources_queue then do_iter waiting_saved_sources_queue else -- if queue > good_sources_queue then do_iter (queue-1) -- -- in -- iter (nsources - max_sources_per_file) (m.manager_sources.(old_sources3_queue)) old_sources3_queue -- -- | _ -> -- let rec iter q queue = -- if Queue.length q > 0 then -- begin -- put_all_outside_queue m q queue; -- iter q queue -- end -- else -- if queue > 0 then -- iter m.manager_sources.(queue-1) (queue-1) -- in -- iter (m.manager_sources.(do_not_try_queue)) do_not_try_queue -- ) !file_sources_managers -+ if queue = old_sources1_queue then do_iter do_not_try_queue -+ else if queue = do_not_try_queue then do_iter new_sources_queue -+ else if queue = new_sources_queue then do_iter waiting_saved_sources_queue -+ else if queue > good_sources_queue then do_iter (queue-1) -+ -+ in -+ iter (nsources - max_sources_per_file) (m.manager_sources.(old_sources3_queue)) old_sources3_queue -+ -+ | _ -> -+ let rec iter q queue = -+ if Queue.length q > 0 then begin -+ put_all_outside_queue m q queue; -+ iter q queue -+ end -+ else -+ if queue > 0 then -+ iter m.manager_sources.(queue-1) (queue-1) -+ in -+ iter (m.manager_sources.(do_not_try_queue)) do_not_try_queue -+ ) !file_sources_managers - - (*************************************************************************) - (* *) -@@ -1973,101 +1862,98 @@ - (* *) - (*************************************************************************) - -- let connect_sources connection_manager = -+ let connect_sources connection_manager = - -- if !verbose_sources > 1 then -- lprintf_nl "[cSrc] connect_sources"; -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] connect_sources"; - (* After 2 minutes, consider that connections attempted should be revoked. *) - -- if !verbose_sources > 1 then -- lprintf_nl "[cSrc] revoke connecting sources..."; -- let rec iter () = -- if not (Fifo.empty connecting_sources) then -- let (time, s) = Fifo.head connecting_sources in -- if time <> s.source_last_attempt then begin -- ignore (Fifo.take connecting_sources); -- iter () -- end else -- if time + 120 < last_time () then begin -- ignore (Fifo.take connecting_sources); -- if s.source_last_attempt <> 0 then source_disconnected s; -- iter () -- end -- in -- iter (); -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] revoke connecting sources..."; -+ let rec iter () = -+ if not (Fifo.empty connecting_sources) then -+ let (time, s) = Fifo.head connecting_sources in -+ if time <> s.source_last_attempt then begin -+ ignore (Fifo.take connecting_sources); -+ iter () -+ end -+ else if time + 120 < last_time () then begin -+ ignore (Fifo.take connecting_sources); -+ if s.source_last_attempt <> 0 then source_disconnected s; -+ iter () -+ end -+ in -+ iter (); - - (* First, require !!max_connections_per_second sources to connect to us. - The probability is very high they won't be able to connect to us. *) - -- if !verbose_sources > 1 then -- lprintf_nl "[cSrc] connect indirect sources..."; -- let (first_sources, last_sources) = -- List2.cut !!max_connections_per_second !next_indirect_sources in -- next_indirect_sources := last_sources; -- List.iter (fun s -> -- ignore (connect_source s)) first_sources; -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] connect indirect sources..."; -+ let (first_sources, last_sources) = -+ List2.cut !!max_connections_per_second !next_indirect_sources in -+ next_indirect_sources := last_sources; -+ List.iter (fun s -> -+ ignore (connect_source s)) first_sources; - - (* Second, for every file being downloaded, query sources that are already - connected if needed *) -- if !verbose_sources > 1 then -- lprintf_nl "[cSrc] query connected sources..."; -- List.iter (fun m -> -- match file_state (m.manager_file ()) with -- FileDownloading -> -- let q = m.manager_sources.(connected_sources_queue) in -- let rec iter () = -- if Queue.length q > 0 then -- let (time, s) = Queue.head q in -- if time + !!min_reask_delay < last_time () then begin -- -- let r = find_request s m in -- (* lprintf "commonSources: connect_sources: second place for source_query !?\n"; *) -- (* isn't that here pretty useless? *) -- source_query s r; -- (* After this step, the source is -- either in 'busy_sources_queue', -- if for some reason, the request -- could not be sent, or in -- 'connected_sources_queue' at the -- tail if the request could be sent. -- This seems thus safe. -- *) -- iter () -- end -- in -- iter () -- | _ -> () -- ) !file_sources_managers; -- -- if !verbose_sources > 1 then -- lprintf_nl "[cSrc] connect to sources..."; --(* Finally, connect to available sources *) -- try -- let max_sources = functions.function_max_connections_per_second () in -- if !verbose_sources > 1 then -- lprintf_nl "[cSrc] max_sources: %d" max_sources; -- let rec iter nsources refilled = -- if nsources > 0 && can_open_connection connection_manager then -- if Fifo.length next_direct_sources > 0 then -- let s = Fifo.take next_direct_sources in -- connect_source s; -- let nsources = match s.source_sock with -- NoConnection -> -- if !verbose_sources > 1 then -- lprintf_nl "[cSrc] not connected"; nsources -- | _ -> nsources-1 -- in -- iter nsources refilled -- else -- if not refilled then begin -- refill_sources (); -- iter nsources true -- end -- in -- iter max_sources false; -- if !verbose_sources > 1 then -- lprintf_nl "[cSrc] done connect_sources"; -- with Exit -> () -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] query connected sources..."; -+ List.iter (fun m -> -+ match file_state (m.manager_file ()) with -+ | FileDownloading -> -+ let q = m.manager_sources.(connected_sources_queue) in -+ let rec iter () = -+ if Queue.length q > 0 then -+ let (time, s) = Queue.head q in -+ if time + !!min_reask_delay < last_time () then begin -+ -+ let r = find_request s m in -+ (* lprintf "commonSources: connect_sources: second place for source_query !?\n"; *) -+ (* isn't that here pretty useless? *) -+ source_query s r; -+ (* After this step, the source is -+ either in 'busy_sources_queue', -+ if for some reason, the request -+ could not be sent, or in -+ 'connected_sources_queue' at the -+ tail if the request could be sent. -+ This seems thus safe. -+ *) -+ iter () -+ end in -+ iter () -+ | _ -> () -+ ) !file_sources_managers; -+ -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] connect to sources..."; -+ (* Finally, connect to available sources *) -+ try -+ let max_sources = functions.function_max_connections_per_second () in -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] max_sources: %d" max_sources; -+ let rec iter nsources refilled = -+ if nsources > 0 && can_open_connection connection_manager then -+ if Fifo.length next_direct_sources > 0 then -+ let s = Fifo.take next_direct_sources in -+ connect_source s; -+ let nsources = -+ match s.source_sock with -+ | NoConnection -> -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] not connected"; nsources -+ | _ -> nsources - 1 in -+ iter nsources refilled -+ else if not refilled then begin -+ refill_sources (); -+ iter nsources true -+ end in -+ iter max_sources false; -+ if !verbose_sources > 1 then -+ lprintf_nl "[cSrc] done connect_sources"; -+ with Exit -> () - - - -@@ -2077,36 +1963,34 @@ - (* *) - (*************************************************************************) - -- let value_to_module f v = -- match v with -- Module list -> f list -- | _ -> failwith "Option should be a module" -+ let value_to_module f v = -+ match v with -+ | Module list -> f list -+ | _ -> failwith "Option should be a module" - -- let option = define_option_class "Source" -- (fun v -> -+ let option = define_option_class "Source" -+ (fun v -> - (* lprintf "(n) source !!\n"; *) -- value_to_module value_to_source v) -- (fun s -> Module (source_to_value s [])) -+ value_to_module value_to_source v) -+ (fun s -> Module (source_to_value s [])) - -- let file_sources_option = ref None -+ let file_sources_option = ref None - -- let attach_sources_to_file section = -+ let attach_sources_to_file section = - (* lprintf "attach_sources_to_file\n"; *) -- let sources = match !file_sources_option with -- None -> -+ let sources = match !file_sources_option with -+ | None -> - (* lprintf "attaching sources this time\n"; *) -- let sources = define_option section -- ["sources"] "" (listiter_option option) [] -- in -+ let sources = define_option section -+ ["sources"] "" (listiter_option option) [] in - (* lprintf "done\n"; *) -- file_sources_option := Some sources; -- sources -- | Some sources -> sources -- in -- sources =:= []; -- HS.iter (fun s -> sources =:= s :: !!sources) sources_by_uid; -+ file_sources_option := Some sources; -+ sources -+ | Some sources -> sources in -+ sources =:= []; -+ HS.iter (fun s -> sources =:= s :: !!sources) sources_by_uid; - -- (fun _ -> sources =:= []) -+ (fun _ -> sources =:= []) - - - (*************************************************************************) -@@ -2115,82 +1999,70 @@ - (* *) - (*************************************************************************) - -- let _ = -- Heap.add_memstat M.module_name (fun level buf -> -+ let () = -+ Heap.add_memstat M.module_name (fun level buf -> - -- let nsources_per_queue = Array.create nqueues 0 in -- let nready_per_queue = Array.create nqueues 0 in -- List.iter (fun m -> -- for i = 0 to nqueues -1 do -- let q = m.manager_sources.(i) in -- let nready = ref 0 in -- let nsources = ref 0 in -- let ready_threshold = last_time () - !!min_reask_delay in -- Queue.iter (fun (time, s) -> -- incr nsources; -- if time < ready_threshold then -- incr nready -- else -- if i = new_sources_queue then begin -- Printf.bprintf buf "ERROR: Source is not ready in new_sources_queue !\n"; -- print_source buf s -- end -- ) q; -- nsources_per_queue.(i) <- nsources_per_queue.(i) + !nsources; -- nready_per_queue.(i) <- nready_per_queue.(i) + !nready; -- done -- ) !file_sources_managers; -- -- Printf.bprintf buf "\nFor all managers (%d):\n" (List.length !file_sources_managers); -- for i = 0 to nqueues - 1 do -- Printf.bprintf buf " Queue[%s]: %d entries (%d ready)\n" -- queue_name.(i) nsources_per_queue.(i) nready_per_queue.(i); -- -- done; -- -- let nsources = ref 0 in -- HS.iter (fun _ -> incr nsources) sources_by_uid; -- Printf.bprintf buf "Sources by UID table: %d entries\n" !nsources; -- Printf.bprintf buf "Sources by UID table stats: %d %d %d %d %d %d\n" -- ((fun (n,_,_,_,_,_) -> n)(HS.stats sources_by_uid)) -- ((fun (_,n,_,_,_,_) -> n)(HS.stats sources_by_uid)) -- ((fun (_,_,n,_,_,_) -> n)(HS.stats sources_by_uid)) -- ((fun (_,_,_,n,_,_) -> n)(HS.stats sources_by_uid)) -- ((fun (_,_,_,_,n,_) -> n)(HS.stats sources_by_uid)) -- ((fun (_,_,_,_,_,n) -> n)(HS.stats sources_by_uid)) -- ; -+ let nsources_per_queue = Array.create nqueues 0 in -+ let nready_per_queue = Array.create nqueues 0 in -+ List.iter (fun m -> -+ for i = 0 to nqueues -1 do -+ let q = m.manager_sources.(i) in -+ let nready = ref 0 in -+ let nsources = ref 0 in -+ let ready_threshold = last_time () - !!min_reask_delay in -+ Queue.iter (fun (time, s) -> -+ incr nsources; -+ if time < ready_threshold then incr nready -+ else if i = new_sources_queue then begin -+ Printf.bprintf buf "ERROR: Source is not ready in new_sources_queue !\n"; -+ print_source buf s -+ end -+ ) q; -+ nsources_per_queue.(i) <- nsources_per_queue.(i) + !nsources; -+ nready_per_queue.(i) <- nready_per_queue.(i) + !nready; -+ done -+ ) !file_sources_managers; -+ -+ Printf.bprintf buf "\nFor all managers (%d):\n" (List.length !file_sources_managers); -+ for i = 0 to nqueues - 1 do -+ Printf.bprintf buf " Queue[%s]: %d entries (%d ready)\n" -+ queue_name.(i) nsources_per_queue.(i) nready_per_queue.(i); -+ done; -+ -+ let nsources = ref 0 in -+ HS.iter (fun _ -> incr nsources) sources_by_uid; -+ Printf.bprintf buf "Sources by UID table: %d entries\n" !nsources; -+ let a1, a2, a3, a4, a5, a6 = HS.stats sources_by_uid in -+ Printf.bprintf buf "Sources by UID table stats: %d %d %d %d %d %d\n" -+ a1 a2 a3 a4 a5 a6; - -- nsources := 0; -- H.iter (fun _ -> incr nsources) sources_by_num; -- Printf.bprintf buf "Sources by NUM table: %d entries\n" !nsources; -- Printf.bprintf buf "Sources by NUM table stats: %d %d %d %d %d %d\n" -- ((fun (n,_,_,_,_,_) -> n)(H.stats sources_by_num)) -- ((fun (_,n,_,_,_,_) -> n)(H.stats sources_by_num)) -- ((fun (_,_,n,_,_,_) -> n)(H.stats sources_by_num)) -- ((fun (_,_,_,n,_,_) -> n)(H.stats sources_by_num)) -- ((fun (_,_,_,_,n,_) -> n)(H.stats sources_by_num)) -- ((fun (_,_,_,_,_,n) -> n)(H.stats sources_by_num)) -- ; -- -- Printf.bprintf buf "Used indirect connections: %d\n" -- !indirect_connections; -- -- let nconnected = ref 0 in -- Fifo.iter (fun (_,s) -> -- if s.source_last_attempt = 0 then incr nconnected; -- ) connecting_sources; -- Printf.bprintf buf "Connecting Sources: %d entries" -- (Fifo.length connecting_sources); -- if !nconnected > 0 then Printf.bprintf buf " (connected: %d)" !nconnected; -- Printf.bprintf buf "\n"; -- -- Printf.bprintf buf "Next Direct Sources: %d entries\n" -- (Fifo.length next_direct_sources); -- -- Printf.bprintf buf "Next Indirect Sources: %d entries\n" -- (List.length !next_indirect_sources) -- ) -+ nsources := 0; -+ H.iter (fun _ -> incr nsources) sources_by_num; -+ Printf.bprintf buf "Sources by NUM table: %d entries\n" !nsources; -+ let a1, a2, a3, a4, a5, a6 = H.stats sources_by_num in -+ Printf.bprintf buf "Sources by NUM table stats: %d %d %d %d %d %d\n" -+ a1 a2 a3 a4 a5 a6; -+ -+ Printf.bprintf buf "Used indirect connections: %d\n" -+ !indirect_connections; -+ -+ let nconnected = ref 0 in -+ Fifo.iter (fun (_, s) -> -+ if s.source_last_attempt = 0 then incr nconnected; -+ ) connecting_sources; -+ Printf.bprintf buf "Connecting Sources: %d entries" -+ (Fifo.length connecting_sources); -+ if !nconnected > 0 then -+ Printf.bprintf buf " (connected: %d)" !nconnected; -+ Printf.bprintf buf "\n"; -+ -+ Printf.bprintf buf "Next Direct Sources: %d entries\n" -+ (Fifo.length next_direct_sources); -+ -+ Printf.bprintf buf "Next Indirect Sources: %d entries\n" -+ (List.length !next_indirect_sources) -+ ) - -- end) -+ end) - - -Index: src/daemon/common/commonSources.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonSources.mli,v -retrieving revision 1.10 -retrieving revision 1.12 -diff -u -r1.10 -r1.12 ---- src/daemon/common/commonSources.mli 8 Apr 2006 02:16:21 -0000 1.10 -+++ src/daemon/common/commonSources.mli 8 Jan 2007 11:06:42 -0000 1.12 -@@ -16,18 +16,7 @@ - along with mldonkey; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - *) -- --open Queues --open Printf2 --open Md4 --open Options --open BasicSocket -- --open TcpBufferedSocket --open CommonFile --open CommonOptions - open CommonTypes -- - - type request_result = - | File_possible (* we asked, but didn't know *) -@@ -38,17 +27,16 @@ - | File_upload (* we uploaded from this client *) - (* | File_unknown We don't know anything *) - -- (* -+(* - val initial_new_source_score : int - val new_source_score : int - val not_found_score : int --val possible_score : int - val found_score : int - val chunk_score : int - val upload_score : int - *) - val possible_score : int -- -+ - module Make(M: - - -@@ -62,24 +50,25 @@ - (*************************************************************************) - (*************************************************************************) - -- sig -- -- val module_name : string -- -- type source_uid -- val dummy_source_uid : source_uid -- val source_uid_to_value: source_uid -> Options.option_value -- val value_to_source_uid: Options.option_value -> source_uid -- -- type source_brand -- val dummy_source_brand : source_brand -- val source_brand_to_value: source_brand -> Options.option_value -- val value_to_source_brand: Options.option_value -> source_brand -+ sig -+ val module_name : string -+ -+ type source_uid -+ -+ val dummy_source_uid : source_uid -+ val source_uid_to_value: source_uid -> Options.option_value -+ val value_to_source_uid: Options.option_value -> source_uid -+ -+ type source_brand -+ -+ val dummy_source_brand : source_brand -+ val source_brand_to_value: source_brand -> Options.option_value -+ val value_to_source_brand: Options.option_value -> source_brand - -- val direct_source : source_uid -> bool -- val indirect_source : source_uid -> bool -- end) : ( -- sig -+ val direct_source : source_uid -> bool -+ val indirect_source : source_uid -> bool -+ end) : ( -+ sig - - (*************************************************************************) - (*************************************************************************) -@@ -91,95 +80,95 @@ - (*************************************************************************) - (*************************************************************************) - -- type source = { -- source_uid : M.source_uid; -- mutable source_files : file_request list; -- mutable source_score : int; -- mutable source_num : int; -- mutable source_age : int; -- mutable source_last_attempt : int; -- mutable source_sock : tcp_connection; -- mutable source_brand : M.source_brand; -- } -- -- and file_request = { -- request_file : file_sources_manager; -- mutable request_queue : int; -- mutable request_time : int; -- mutable request_score : int; -- } -- -- and file_sources_manager = { -- manager_uid : string; -- mutable manager_sources : source Queues.Queue.t array; -- mutable manager_active_sources : int; -- mutable manager_all_sources : int; -- mutable manager_file : (unit -> file); -- } -+ type source = { -+ source_uid : M.source_uid; -+ mutable source_files : file_request list; -+ mutable source_score : int; -+ mutable source_num : int; -+ mutable source_age : int; -+ mutable source_last_attempt : int; -+ mutable source_sock : tcp_connection; -+ mutable source_brand : M.source_brand; -+ } -+ -+ and file_request = { -+ request_file : file_sources_manager; -+ mutable request_queue : int; -+ mutable request_time : int; -+ mutable request_score : int; -+ } -+ -+ and file_sources_manager = { -+ manager_uid : string; -+ mutable manager_sources : source Queues.Queue.t array; -+ mutable manager_active_sources : int; -+ mutable manager_all_sources : int; -+ mutable manager_file : (unit -> file); -+ } -+ -+ and functions = { -+ mutable function_connect: (M.source_uid -> unit); -+ mutable function_query: (M.source_uid -> string -> unit); -+ mutable function_string_to_manager: (string -> file_sources_manager); -+ mutable function_max_connections_per_second : (unit -> int); -+ mutable function_max_sources_per_file : (unit -> int); - -- and functions = { -- mutable function_connect: (M.source_uid -> unit); -- mutable function_query: (M.source_uid -> string -> unit); -- mutable function_string_to_manager: (string -> file_sources_manager); -- mutable function_max_connections_per_second : (unit -> int); -- mutable function_max_sources_per_file : (unit -> int); -- -- mutable function_add_location : -- (M.source_uid -> string -> unit); -- mutable function_remove_location : -- (M.source_uid -> string -> unit); -- } -- -- val functions : functions -- -- val create_file_sources_manager : -- string -> file_sources_manager -- val remove_file_sources_manager : -- file_sources_manager -> unit -- val number_of_sources : -- file_sources_manager -> int -- -+ mutable function_add_location : -+ (M.source_uid -> string -> unit); -+ mutable function_remove_location : -+ (M.source_uid -> string -> unit); -+ } -+ -+ val functions : functions -+ -+ val create_file_sources_manager : string -> file_sources_manager -+ val remove_file_sources_manager : file_sources_manager -> unit -+(* -+ val number_of_sources : file_sources_manager -> int -+*) - (* Find a given source *) -- val find_source_by_uid : M.source_uid -> source -- val find_source_by_num : int -> source - -+ val find_source_by_uid : M.source_uid -> source -+(* -+ val find_source_by_num : int -> source -+*) - (* Feed-back on sources *) -- val source_connected : source -> unit -- val source_disconnected : source -> unit -- val add_request : -- source -> file_sources_manager -> int -> file_request -- -- val set_request_result : -- source -> file_sources_manager -> request_result -> unit -- val find_request : -- source -> file_sources_manager -> file_request -- val find_request_result : -- source -> file_sources_manager -> request_result -+ val source_connected : source -> unit -+ val source_disconnected : source -> unit -+ -+ val add_request : source -> file_sources_manager -> int -> file_request -+ val set_request_result : -+ source -> file_sources_manager -> request_result -> unit -+ val find_request : source -> file_sources_manager -> file_request -+ val find_request_result : source -> file_sources_manager -> request_result -+ -+ val need_new_sources : file_sources_manager -> bool - -- val need_new_sources : file_sources_manager -> bool -- - (* Connect sources every second *) -- val connect_sources : TcpBufferedSocket.connection_manager -> unit -- -- val attach_sources_to_file : Options.options_section -> (unit -> unit) -- -- val print : Buffer.t -> CommonTypes.output_type -> unit -- -- val indirect_connections : int ref -- -- val dummy_source : source -- -- val query_file : source -> file_sources_manager -> unit -- val query_files : source -> unit -- -- val clean_sources : unit -> unit -- -- val iter_all_sources : (source -> unit) -> file_sources_manager -> unit -- val iter_active_sources : (source -> unit) -> file_sources_manager -> unit -- val iter_qualified_sources : (source -> unit) -> file_sources_manager -> unit -- val iter_relevant_sources : (source -> unit) -> file_sources_manager -> unit -- -- val source_brand : source -> M.source_brand -- val set_source_brand : source -> M.source_brand -> unit -- end) -- -+ val connect_sources : TcpBufferedSocket.connection_manager -> unit -+ -+ val attach_sources_to_file : Options.options_section -> (unit -> unit) -+ -+ val print : Buffer.t -> CommonTypes.output_type -> unit -+ -+ val indirect_connections : int ref -+ -+ val dummy_source : source -+(* -+ val query_file : source -> file_sources_manager -> unit -+*) -+ val query_files : source -> unit -+ -+ val clean_sources : unit -> unit -+ -+ val iter_all_sources : (source -> unit) -> file_sources_manager -> unit -+ val iter_active_sources : (source -> unit) -> file_sources_manager -> unit -+ val iter_qualified_sources : -+ (source -> unit) -> file_sources_manager -> unit -+ val iter_relevant_sources : -+ (source -> unit) -> file_sources_manager -> unit -+ -+ val source_brand : source -> M.source_brand -+ val set_source_brand : source -> M.source_brand -> unit -+ end) -+ -Index: src/daemon/common/commonSwarming.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonSwarming.ml,v -retrieving revision 1.54 -retrieving revision 1.58 -diff -u -r1.54 -r1.58 ---- src/daemon/common/commonSwarming.ml 14 Sep 2006 17:34:34 -0000 1.54 -+++ src/daemon/common/commonSwarming.ml 4 Feb 2007 17:19:50 -0000 1.58 -@@ -2080,7 +2080,7 @@ - (* memoize some results *) - let memoization_calls = ref 0 in - let memoization_hits = ref 0 in -- let debug_memoization = true in -+ let debug_memoization = false in - let memoize h f p = - incr memoization_calls; - try -@@ -2126,10 +2126,8 @@ - let data_per_source = 9728000L // (Int64.of_int !!sources_per_chunk) in - - let need_to_complete_some_blocks_quickly = -- match !!swarming_block_selection_algorithm with -- | 1 -> true -- | 2 -> verification_available && t.t_nverified_chunks < 2 -- | _ -> assert false in -+ verification_available && t.t_nverified_chunks < 2 -+ in - - let create_choice n b = - let block_begin = compute_block_begin s b in -@@ -2201,66 +2199,7 @@ - (choice_availability c) - (choice_preallocated c) in - -- (** > 0 == c1 is best, < 0 = c2 is best, 0 == they're equivalent *) -- let compare_choices1 c1 c2 = -- -- (* avoid overly unbalanced situations *) -- let cmp = -- if choice_remaining_per_uploader c1 < data_per_source || -- choice_remaining_per_uploader c2 < data_per_source then -- compare (choice_remaining_per_uploader c1) -- (choice_remaining_per_uploader c2) else 0 in -- if cmp <> 0 then cmp else -- -- (* Do what Master asked for *) -- let cmp = compare (choice_user_priority c1) -- (choice_user_priority c2) in -- if cmp <> 0 then cmp else -- -- (* Pick really rare gems: if average availability of all -- blocks is higher than 5 connected sources, pick in -- priority blocks present in at most 3 connected sources; -- is that too restrictive ? *) -- let cmp = -- if not need_to_complete_some_blocks_quickly && -- mean_availability > 5 && -- (choice_availability c1 <= 3 || choice_availability c2 <= 3) then -- compare (choice_availability c2) (choice_availability c1) -- else 0 in -- if cmp <> 0 then cmp else -- -- (* try to quickly complete (and validate) chunks; -- if there's only one frontend, each chunk has only one -- block, and looking at siblings make no sense *) -- let cmp = -- if verification_available && several_frontends then -- compare (choice_other_remaining c2) -- (choice_other_remaining c1) -- else 0 in -- if cmp <> 0 then cmp else -- -- (* try to quickly complete blocks *) -- let cmp = -- match choice_unselected_remaining c1, -- choice_unselected_remaining c2 with -- | 0L, 0L -> 0 -- | 0L, _ -> -1 -- | _, 0L -> 1 -- | ur1, ur2 -> compare ur2 ur1 in -- if cmp <> 0 then cmp else -- -- (* pick blocks that won't require allocating more disk space *) -- let cmp = -- match choice_preallocated c1, choice_preallocated c2 with -- | true, false -> 1 -- | false, true -> -1 -- | _ -> 0 in -- if cmp <> 0 then cmp else -- -- (* Can't tell *) -- 0 in -- -- let compare_choices2 c1 c2 = -+ let compare_choices c1 c2 = - (* "RULES" *) - (* Avoid stepping on each other's feet *) - let cmp = -@@ -2330,12 +2269,6 @@ - (* Can't tell *) - 0 in - -- let compare_choices = -- match !!swarming_block_selection_algorithm with -- | 1 -> compare_choices1 -- | 2 -> compare_choices2 -- | _ -> assert false in -- - (* compare a new chunk against a list of best choices numbers (and a - specimen of best choice) *) - let keep_best_chunks chunk_blocks_indexes best_choices specimen = -@@ -2382,9 +2315,7 @@ - currently they're taken care of by linear_select_block - fallback below *) - -- if debug_all then begin -- print_choice specimen -- end; -+ if debug_all then print_choice specimen; - - try - let blocks = -@@ -2690,7 +2621,6 @@ - iter dummy_ranges_cluster b.up_block.block_ranges b more_blocks in - if not (is_dummy_cluster best_cluster) && - best_cluster.cluster_nuploading > 0 && -- !!block_switching && - (file_downloaded t.t_file < file_size t.t_file ** 98L // 100L) then begin - (* it seems they're only sucky choices left on that block, is - there really nothing else better elsewhere ? *) -@@ -2935,18 +2865,14 @@ - mutable occurrence_missing : chunk_occurrence list; - } - --let propagate_chunk t1 pos1 size destinations copy_data = -+let propagate_chunk t1 pos1 size destinations = - List.iter (fun (t2, j2, pos2) -> - if t1.t_num <> t2.t_num || pos1 <> pos2 then begin - if !verbose then lprintf_nl "Should propagate chunk from %s %Ld to %s %Ld [%Ld]" - (file_best_name t1.t_file) pos1 - (file_best_name t2.t_file) pos2 size; -- (* small catch here: if we don't really copy the data *and* -- chunk content is not the expected value, the chunk will be -- verified each time *) -- if copy_data then -- Unix32.copy_chunk (file_fd t1.t_file) (file_fd t2.t_file) -- pos1 pos2 (Int64.to_int size); -+ Unix32.copy_chunk (file_fd t1.t_file) (file_fd t2.t_file) -+ pos1 pos2 (Int64.to_int size); - set_frontend_state_complete t2 j2 - end - ) destinations -@@ -2954,10 +2880,6 @@ - let dummy_chunk_occurrences () = - { occurrence_present = []; occurrence_missing = [] } - --(* Compute the digest of zeroed chunks to avoid copying them *) --let known_chunks_sizes : (int64, unit) Hashtbl.t = Hashtbl.create 5 --let zeroed_chunks_hashes : (uid_type, unit) Hashtbl.t = Hashtbl.create 5 -- - let duplicate_chunks () = - let chunks = Hashtbl.create 100 in - HS.iter (fun s -> -@@ -2971,25 +2893,6 @@ - chunk_uid = uids.(j); - chunk_size = min (s.s_size -- pos) t.t_chunk_size; - } in -- (try -- ignore (Hashtbl.find known_chunks_sizes c.chunk_size) -- with Not_found -> -- (* new chunk size, compute hashes for zeroed chunk of -- that size. -- No chunk size is bigger than 16MB I hope *) -- if c.chunk_size < Int64.of_int (16 * 1024 * 1024) then begin -- let chunk_size = Int64.to_int c.chunk_size in -- let zeroed_buffer = String.make chunk_size '\000' in -- -- Hashtbl.add zeroed_chunks_hashes -- (Ed2k (Md4.Md4.string zeroed_buffer)) (); -- Hashtbl.add zeroed_chunks_hashes -- (Sha1 (Md4.Sha1.string zeroed_buffer)) (); -- Hashtbl.add zeroed_chunks_hashes -- (TigerTree (Md4.TigerTree.string zeroed_buffer)) () -- end; -- Hashtbl.add known_chunks_sizes c.chunk_size (); -- ); - let occurrences = - try - Hashtbl.find chunks c -@@ -3012,19 +2915,14 @@ - ) s.s_networks - ) swarmers_by_name; - Hashtbl.iter (fun c occurrences -> -+ (* we need a verified chunk to copy over the others *) - match occurrences.occurrence_present, occurrences.occurrence_missing with - | _ , [] - | [], _ -> () - | (t, _, pos) :: _, missing -> -- let is_zeroed_chunk = -- try -- ignore(Hashtbl.find zeroed_chunks_hashes c.chunk_uid); -- false -- with Not_found -> true in -- propagate_chunk t pos c.chunk_size missing (not is_zeroed_chunk) -+ propagate_chunk t pos c.chunk_size missing - ) chunks - -- - let set_verifier t f = - t.t_verifier <- f; - (* TODO: check that false as t_primary is a good value to start with *) -Index: src/daemon/common/commonTypes.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonTypes.ml,v -retrieving revision 1.64 -retrieving revision 1.66 -diff -u -r1.64 -r1.66 ---- src/daemon/common/commonTypes.ml 26 Nov 2006 16:36:29 -0000 1.64 -+++ src/daemon/common/commonTypes.ml 6 Jan 2007 18:15:17 -0000 1.66 -@@ -260,11 +260,13 @@ - | Field_Completesources (* "completesources" *) - | Field_Filename (* "filename" *) - | Field_Size -+| Field_Size_Hi - | Field_Uid - | Field_Filerating - | Field_Lastseencomplete - | Field_Mediacodec - | Field_Medialength -+| Field_KNOWN of string - | Field_UNKNOWN of string - - type tag = { -Index: src/daemon/common/commonUploads.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonUploads.ml,v -retrieving revision 1.52 -retrieving revision 1.53 -diff -u -r1.52 -r1.53 ---- src/daemon/common/commonUploads.ml 26 Nov 2006 13:54:09 -0000 1.52 -+++ src/daemon/common/commonUploads.ml 3 Dec 2006 20:57:56 -0000 1.53 -@@ -687,7 +687,7 @@ - impl_shared_ops = shared_ops; - impl_shared_val = sh; - impl_shared_requests = 0; -- impl_shared_magic = None; -+ impl_shared_file = None; - impl_shared_servers = []; - } - and sh = { -Index: src/daemon/common/commonWeb.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonWeb.ml,v -retrieving revision 1.37 -retrieving revision 1.38 -diff -u -r1.37 -r1.38 ---- src/daemon/common/commonWeb.ml 26 Nov 2006 13:54:09 -0000 1.37 -+++ src/daemon/common/commonWeb.ml 17 Jan 2007 18:51:41 -0000 1.38 -@@ -150,7 +150,7 @@ - with e -> failwith (Printf.sprintf "Unknown kind [%s]" kind) - in - try -- lprintf_nl (_b "saving %s (%s)") kind url; -+ lprintf_nl (_b "request %s (%s)") kind url; - mldonkey_wget url f - with e -> - if can_fail then -Index: src/daemon/common/guiDecoding.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/guiDecoding.ml,v -retrieving revision 1.66 -retrieving revision 1.69 -diff -u -r1.66 -r1.69 ---- src/daemon/common/guiDecoding.ml 26 Nov 2006 13:54:09 -0000 1.66 -+++ src/daemon/common/guiDecoding.ml 15 Jan 2007 18:26:27 -0000 1.69 -@@ -810,17 +810,18 @@ - client_name = name; - client_rating = rating; - client_chat_port = chat_port; -- client_files = None; - client_connect_time = 0; - client_software = ""; - client_os = None; - client_release = ""; - client_emulemod = ""; -- client_downloaded = zero; -- client_uploaded = zero; -+ client_total_downloaded = zero; -+ client_total_uploaded = zero; -+ client_session_downloaded = zero; -+ client_session_uploaded = zero; - client_upload = None; - client_sui_verified = None; --(* client_sock_addr = ""; *) -+ client_file_queue = []; - }, pos+8 - else - let num = get_int s pos in -@@ -869,17 +870,18 @@ - client_name = name; - client_rating = rating; - client_chat_port = 0; -- client_files = None; - client_connect_time = connect_time; - client_software = software; - client_os = None; - client_release = release; - client_emulemod = emulemod; -- client_downloaded = downloaded; -- client_uploaded = uploaded; -+ client_total_downloaded = downloaded; -+ client_total_uploaded = uploaded; -+ client_session_downloaded = 0L; -+ client_session_uploaded = 0L; - client_upload = upload; - client_sui_verified = verified; --(* client_sock_addr = sock_addr; *) -+ client_file_queue = []; - }, pos - - let default_flags = [ -@@ -1349,6 +1351,9 @@ - M.option_help = ""; - M.option_type = ""; - M.option_advanced = false; -+ M.option_restart = false; -+ M.option_public = false; -+ M.option_internal = false; - } - - let to_gui (proto : int array) opcode s = -@@ -1567,6 +1572,9 @@ - M.option_value = value; - M.option_default = default; - M.option_advanced = advanced; -+ M.option_restart = false; -+ M.option_public = false; -+ M.option_internal = false; - } - else - let optype = -@@ -1628,6 +1636,9 @@ - M.option_value = value; - M.option_default = default; - M.option_advanced = advanced; -+ M.option_restart = false; -+ M.option_public = false; -+ M.option_internal = false; - } - else - let optype = -Index: src/daemon/common/guiEncoding.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/guiEncoding.ml,v -retrieving revision 1.61 -retrieving revision 1.62 -diff -u -r1.61 -r1.62 ---- src/daemon/common/guiEncoding.ml 26 Nov 2006 16:36:29 -0000 1.61 -+++ src/daemon/common/guiEncoding.ml 2 Dec 2006 12:35:45 -0000 1.62 -@@ -669,8 +669,8 @@ - end else - begin - buf_string buf (client_software_short c.client_software c.client_os); -- buf_int64 buf c.client_downloaded; -- buf_int64 buf c.client_uploaded; -+ buf_int64 buf c.client_session_downloaded; -+ buf_int64 buf c.client_session_uploaded; - (match c.client_upload with - Some s -> buf_string buf s - | None -> buf_string buf ""); -Index: src/daemon/common/guiTypes.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/guiTypes.ml,v -retrieving revision 1.34 -retrieving revision 1.36 -diff -u -r1.34 -r1.36 ---- src/daemon/common/guiTypes.ml 14 Nov 2006 18:42:59 -0000 1.34 -+++ src/daemon/common/guiTypes.ml 8 Jan 2007 11:06:42 -0000 1.36 -@@ -211,7 +211,6 @@ - mutable client_type : client_type; - mutable client_tags: CommonTypes.tag list; - mutable client_name : string; -- mutable client_files: file_tree option; - mutable client_rating : int; - mutable client_chat_port : int; - mutable client_connect_time : int; -@@ -219,11 +218,13 @@ - mutable client_os : string option; - mutable client_release : string; - mutable client_emulemod : string; -- mutable client_downloaded : int64; -- mutable client_uploaded : int64; -+ mutable client_total_downloaded : int64; -+ mutable client_total_uploaded : int64; -+ mutable client_session_downloaded : int64; -+ mutable client_session_uploaded : int64; - mutable client_upload : string option; - mutable client_sui_verified : bool option; --(* mutable client_sock_addr : string; *) -+ mutable client_file_queue : CommonTypes.file list; - } - - type client_stats = { -Index: src/daemon/driver/driverCommands.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverCommands.ml,v -retrieving revision 1.202 -retrieving revision 1.220 -diff -u -r1.202 -r1.220 ---- src/daemon/driver/driverCommands.ml 28 Nov 2006 23:15:21 -0000 1.202 -+++ src/daemon/driver/driverCommands.ml 6 Feb 2007 22:26:58 -0000 1.220 -@@ -78,7 +78,12 @@ - [] -> - Gettext.buftext buf no_such_command cmd - | (command, _, arg_kind, help) :: tail -> -- if command = cmd then -+ if command = cmd then begin -+ if !verbose_user_commands && not (user2_is_admin output.conn_user.ui_user) then -+ lprintf_nl "user %s issued command %s%s" -+ output.conn_user.ui_user.user_name -+ cmd -+ (if args = [] then "" else ", args " ^ String.concat " " args); - Buffer.add_string buf ( - match arg_kind, args with - Arg_none f, [] -> f output -@@ -88,6 +93,7 @@ - | Arg_three f, [a1;a2;a3] -> f a1 a2 a3 output - | _ -> bad_number_of_args command help - ) -+ end - else - iter tail - in -@@ -100,20 +106,21 @@ - html_mods_table_header buf "upstatsTable" "upstats" [ - ( "0", "srh", "Option name", "Name (Help=mouseOver)" ) ; - ( "0", "srh", "Option value", "Value (press ENTER to save)" ) ; -- ( "0", "srh", "Option default", "Default" ) ] -+ ( "0", "srh", "Option default", "Default" ); -+ ( "0", "srh", "Option type", "Type" ); -+ ] - else - html_mods_table_header buf "voTable" "vo" [ - ( "0", "srh", "Option name", "Name" ) ; - ( "0", "srh", "Option value", "Value (press ENTER to save)" ) ; - ( "0", "srh", "Option default", "Default" ) ; -+ ( "0", "srh", "Option type", "Type" ); - ( "0", "srh", "Option description", "Help" ) ]; - -- let counter = ref 0 in -+ html_mods_cntr_init (); - - List.iter (fun o -> -- incr counter; -- if (!counter mod 2 == 0) then Printf.bprintf buf "\\<tr class=\\\"dl-1\\\"" -- else Printf.bprintf buf "\\<tr class=\\\"dl-2\\\""; -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"" (html_mods_cntr ()); - - if !!html_mods_use_js_helptext then - Printf.bprintf buf " onMouseOver=\\\"mOvr(this);setTimeout('popLayer(\\\\\'%s\\\\\')',%d);setTimeout('hideLayer()',%d);return true;\\\" onMouseOut=\\\"mOut(this);hideLayer();setTimeout('hideLayer()',%d)\\\"\\>" -@@ -121,27 +128,20 @@ - else - Printf.bprintf buf "\\>"; - -- if String.contains o.option_value '\n' then begin -+ if String.contains o.option_value '\n' then - Printf.bprintf buf "\\<td class=\\\"sr\\\"\\> -- \\<a href=\\\"http://mldonkey.sourceforge.net/%s\\\"\\>%s\\</a\\> -- \\<form action=\\\"submit\\\" target=\\\"$S\\\" onsubmit=\\\"javascript: {setTimeout('window.location.replace(window.location.href)',500);}\\\"\\> -- \\<input type=hidden name=setoption value=q\\>\\<input type=hidden name=option value=%s\\>\\</td\\> -- \\<td\\>\\<textarea name=value rows=5 cols=20 wrap=virtual\\>%s\\</textarea\\> -- \\<input type=submit value=Modify\\>\\</td\\>\\</form\\> -- \\<td class=\\\"sr\\\"\\>%s\\</td\\>" -- (String2.upp_initial o.option_name) o.option_name o.option_name o.option_value o.option_default; -- -- if not !!html_mods_use_js_helptext then -- Printf.bprintf buf "\\<td class=\\\"sr\\\"\\>%s\\</td\\>" (Str.global_replace (Str.regexp "\n") "\\<br\\>" o.option_help); -- -- Printf.bprintf buf "\\</tr\\>" -- end -- -- else begin -+\\<a href=\\\"http://mldonkey.sourceforge.net/%s\\\"\\>%s\\</a\\> -+\\<form action=\\\"submit\\\" target=\\\"$S\\\" onsubmit=\\\"javascript: {setTimeout('window.location.replace(window.location.href)',500);}\\\"\\> -+\\<input type=hidden name=setoption value=q\\>\\<input type=hidden name=option value=%s\\>\\</td\\> -+\\<td\\>\\<textarea name=value rows=5 cols=20 wrap=virtual\\>%s\\</textarea\\> -+\\<input type=submit value=Modify\\>" -+ (String2.upp_initial o.option_name) o.option_name o.option_name o.option_value -+ else -+ begin - Printf.bprintf buf "\\<td class=\\\"sr\\\"\\> -- \\<a href=\\\"http://mldonkey.sourceforge.net/%s\\\"\\>%s\\</a\\>\\</td\\> -- \\<td class=\\\"sr\\\"\\>\\<form action=\\\"submit\\\" target=\\\"$S\\\" onsubmit=\\\"javascript: {setTimeout('window.location.replace(window.location.href)',500);}\\\"\\> -- \\<input type=hidden name=setoption value=q\\>\\<input type=hidden name=option value=%s\\>" -+\\<a href=\\\"http://mldonkey.sourceforge.net/%s\\\"\\>%s\\</a\\>\\</td\\> -+\\<td class=\\\"sr\\\"\\>\\<form action=\\\"submit\\\" target=\\\"$S\\\" onsubmit=\\\"javascript: {setTimeout('window.location.replace(window.location.href)',500);}\\\"\\> -+\\<input type=hidden name=setoption value=q\\>\\<input type=hidden name=option value=%s\\>" - (String2.upp_initial o.option_name) o.option_name o.option_name; - - if o.option_value = "true" || o.option_value = "false" then -@@ -153,14 +153,15 @@ - Printf.bprintf buf "\\<input style=\\\"font-family: verdana; font-size: 10px;\\\" - type=text name=value size=20 value=\\\"%s\\\"\\>" - o.option_value; -- -- Printf.bprintf buf "\\</td\\>\\</form\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>" (shorten o.option_default 40); -- -- if not !!html_mods_use_js_helptext then -- Printf.bprintf buf "\\<td class=\\\"sr\\\"\\>%s\\</td\\>" (Str.global_replace (Str.regexp "\n") "\\<br\\>" o.option_help); -- -- Printf.bprintf buf "\\</tr\\>" - end; -+ Printf.bprintf buf "\\</td\\>\\</form\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>" (shorten o.option_default 40); -+ Printf.bprintf buf "\\<td class=\\\"sr\\\"\\>%s\\</td\\>" -+ ((if o.option_restart then Printf.sprintf "restart " else "") ^ -+ (if o.option_internal then Printf.sprintf "internal " else "") ^ -+ (if o.option_public then Printf.sprintf "public " else "")); -+ if not !!html_mods_use_js_helptext then -+ Printf.bprintf buf "\\<td class=\\\"sr\\\"\\>%s\\</td\\>" (Str.global_replace (Str.regexp "\n") "\\<br\\>" o.option_help); -+ Printf.bprintf buf "\\</tr\\>" - - )list; - Printf.bprintf buf "\\</table\\>\\</div\\>" -@@ -208,11 +209,9 @@ - ( "0", "srh", "Weekdays", "Weekdays" ) ; - ( "0", "srh", "Hours", "Hours" ) ; - ( "0", "srh", "Command", "Command" ) ] ; -- let counter = ref 0 in -+ html_mods_cntr_init (); - List.iter (fun (wdays, hours, command) -> -- incr counter; -- if (!counter mod 2 == 0) then Printf.bprintf buf "\\<tr class=\\\"dl-1\\\"\\>" -- else Printf.bprintf buf "\\<tr class=\\\"dl-2\\\"\\>"; -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); - let wdays_string = ref "" in - let hours_string = ref "" in - List.iter (fun day -> -@@ -343,7 +342,7 @@ - web_infos_add kind period url; - CommonWeb.load_url true kind url; - "url added to web_infos. downloading now" -- ), "<kind> <url> [<period>]:\t\tload this file from the web\n" -+ ), "<kind> <url> [<period>] :\tload this file from the web\n" - ^"\t\t\t\t\tkind is either server.met (if the downloaded file is a server.met)\n" - ^"\t\t\t\t\tperiod is the period between updates (in hours, default 0 = only loaded at startup)"; - -@@ -357,10 +356,23 @@ - "URL does not exists in web_infos" - ), "<url> :\t\t\tremove URL from web_infos"; - -- "force_web_infos", Arg_none (fun o -> -- CommonWeb.load_web_infos false true; -- "downloading all web_infos URLs" -- ), ":\t\t\tforce downloading all web_infos URLs"; -+ "force_web_infos", Arg_multiple (fun args o -> -+ (match args with -+ | [] -> CommonWeb.load_web_infos false true; -+ "requesting all web_infos files" -+ | args -> let list = ref [] in -+ List.iter (fun arg -> -+ List.iter (fun (kind, _, url) -> -+ if kind = arg || url = arg then begin -+ CommonWeb.load_url false kind url; -+ list := arg :: !list -+ end -+ ) !!web_infos) args; -+ if !list = [] then -+ Printf.sprintf "found no web_infos entries for %s" (String.concat " " args) -+ else -+ Printf.sprintf "requesting web_infos %s" (String.concat " " !list)) -+ ), "[<list of kind|URL>] :\tre-download web_infos, leave empty to re-download all"; - - "recover_temp", Arg_none (fun o -> - networks_iter (fun r -> -@@ -378,9 +390,8 @@ - ), ":\t\t\t\trecover lost files from temp directory"; - - "vc", Arg_multiple (fun args o -> -+ let buf = o.conn_buf in - if args = ["all"] then begin -- let buf = o.conn_buf in -- - if use_html_mods o then html_mods_table_header buf "vcTable" "vc" ([ - ( "1", "srh ac", "Client number", "Num" ) ; - ( "0", "srh", "Network", "Network" ) ; -@@ -390,29 +401,40 @@ - ( "0", "srh", "Client brand", "CB" ) ; - ( "0", "srh", "Client release", "CR" ) ; - ] @ -- (if !!emule_mods_count then [( "0", "srh", "eMule MOD", "EM" )] else [])); -+ (if !!emule_mods_count then [( "0", "srh", "eMule MOD", "EM" )] else []) -+ @ [ -+ ( "0", "srh", "Client file queue", "Q" ) ; -+ ( "1", "srh ar", "Total UL bytes to this client for all files", "tUL" ) ; -+ ( "1", "srh ar br", "Total DL bytes from this client for all files", "tDL" ) ; -+ ( "1", "srh ar", "Session UL bytes to this client for all files", "sUL" ) ; -+ ( "1", "srh ar", "Session DL bytes from this client for all files", "sDL" )]); - -- let counter = ref 0 in -+ html_mods_cntr_init (); - let all_clients_list = clients_get_all () in - List.iter (fun num -> - let c = client_find num in - let i = client_info c in -- if use_html_mods o then Printf.bprintf buf "\\<tr class=\\\"%s\\\" -+ if use_html_mods o then Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\" - title=\\\"Add as friend\\\" - onClick=\\\"parent.fstatus.location.href='submit?q=friend_add+%d'\\\" - onMouseOver=\\\"mOvr(this);\\\" - onMouseOut=\\\"mOut(this);\\\"\\>" -- (if (!counter mod 2 == 0) then "dl-1" else "dl-2") num; -+ (html_mods_cntr ()) num; - client_print c o; - if use_html_mods o then - html_mods_td buf ([ - (client_software i.client_software i.client_os, "sr", client_software_short i.client_software i.client_os); - ("", "sr", i.client_release); - ] @ -- (if !!emule_mods_count then [("", "sr", i.client_emulemod)] else [])); -+ (if !!emule_mods_count then [("", "sr", i.client_emulemod)] else []) -+ @ [ -+ ("", "sr", Printf.sprintf "%d" (List.length i.client_file_queue)); -+ ("", "sr ar", (size_of_int64 i.client_total_uploaded)); -+ ("", "sr ar br", (size_of_int64 i.client_total_downloaded)); -+ ("", "sr ar", (size_of_int64 i.client_session_uploaded)); -+ ("", "sr ar", (size_of_int64 i.client_session_downloaded))]); - if use_html_mods o then Printf.bprintf buf "\\</tr\\>" - else Printf.bprintf buf "\n"; -- incr counter; - ) all_clients_list; - if use_html_mods o then Printf.bprintf buf "\\</table\\>\\</div\\>"; - end -@@ -420,18 +442,18 @@ - List.iter (fun num -> - let num = int_of_string num in - let c = client_find num in -- client_print c o; -+ try client_print_info c o with e -> print_command_result o (Printexc2.to_string e); - ) args; - "" -- ), "<num> :\t\t\t\tview client (use arg 'all' for all clients)"; -+ ), "<num|all> :\t\t\t\tview client (use arg 'all' for all clients)"; - - "version", Arg_none (fun o -> -- print_command_result o o.conn_buf (CommonGlobals.version ()); -+ print_command_result o (CommonGlobals.version ()); - "" - ), ":\t\t\t\tprint mldonkey version"; - - "uptime", Arg_none (fun o -> -- print_command_result o o.conn_buf (log_time () ^ "- up " ^ -+ print_command_result o (log_time () ^ "- up " ^ - Date.time_to_string (last_time () - start_time) "verbose"); - "" - ), ":\t\t\t\tcore uptime"; -@@ -497,7 +519,7 @@ - - "message_log", Arg_multiple (fun args o -> - let buf = o.conn_buf in -- let counter = ref 0 in -+ html_mods_cntr_init (); - - (match args with - [arg] -> -@@ -531,8 +553,8 @@ - - Fifo.iter (fun (t,i,num,n,s) -> - if use_html_mods o then begin -- Printf.bprintf buf "\\<tr class=\\\"%s\\\"\\>" -- (if (!counter mod 2 == 0) then "dl-1" else "dl-2"); -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" -+ (html_mods_cntr ()); - html_mods_td buf [ - ("", "sr", Date.simple (BasicSocket.date_of_int t)); - ("", "sr", i); -@@ -544,7 +566,6 @@ - else - Printf.bprintf buf "\n%s [client #%d] %s(%s): %s\n" - (Date.simple (BasicSocket.date_of_int t)) num n i s; -- incr counter; - ) chat_message_fifo; - if use_html_mods o then Printf.bprintf buf - "\\</table\\>\\</div\\>\\</div\\>"; -@@ -783,7 +804,7 @@ - print_upstats o !list (Some s) - | _ -> () - ) -- else print_command_result o o.conn_buf "You are not allowed to use this command"; -+ else print_command_result o "You are not allowed to use this command"; - _s "" - ), "<num> :\t\t\tshow list of files published on server <num>"; - -@@ -824,7 +845,7 @@ - | _ -> false - in - let print_result v = -- print_command_result o o.conn_buf -+ print_command_result o - (Printf.sprintf (_b "Disconnected %d server%s") !counter (Printf2.print_plural_s !counter)) - in - match args with -@@ -848,7 +869,7 @@ - ) args; - print_result !counter; - "" -- ), "<server numbers|all> :\t\t\t\tdisconnect from server(s)"; -+ ), "<server numbers|all> :\t\tdisconnect from server(s)"; - - ] - -@@ -896,7 +917,7 @@ - ) args; - Printf.sprintf (_b "%d friends removed") (List.length args) - end -- ), "<client numbers> :\tremove friend (use arg 'all' for all friends)"; -+ ), "<client numbers|all> :\tremove friend (use arg 'all' for all friends)"; - - "friends", Arg_none (fun o -> - let buf = o.conn_buf in -@@ -930,19 +951,18 @@ - ( "0", "srh", "Name", "Name" ) ; - ( "0", "srh", "State", "State" ) ] ; - end; -- let counter = ref 0 in -+ html_mods_cntr_init (); - List.iter (fun c -> - let i = client_info c in - let n = network_find_by_num i.client_network in - if use_html_mods o then - begin - -- Printf.bprintf buf "\\<tr class=\\\"%s\\\" -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\" - onMouseOver=\\\"mOvr(this);\\\" - onMouseOut=\\\"mOut(this);\\\"\\>" -- (if (!counter mod 2 == 0) then "dl-1" else "dl-2"); -+ (html_mods_cntr ()); - -- incr counter; - Printf.bprintf buf " - \\<td title=\\\"Client number\\\" - onClick=\\\"location.href='submit?q=files+%d'\\\" -@@ -1082,7 +1102,6 @@ - ), ":\t\t\t\tprint current bandwidth stats"; - - "bw_toggle", Arg_none (fun o -> -- let buf = o.conn_buf in - if user2_is_admin o.conn_user.ui_user then begin - let ul_bkp = !!max_hard_upload_rate_2 in - let dl_bkp = !!max_hard_download_rate_2 in -@@ -1090,12 +1109,12 @@ - max_hard_download_rate_2 =:= !!max_hard_download_rate; - max_hard_upload_rate =:= ul_bkp; - max_hard_download_rate =:= dl_bkp; -- print_command_result o buf (Printf.sprintf -+ print_command_result o (Printf.sprintf - "new upload rate: %d | new download rate: %d" - !!max_hard_upload_rate !!max_hard_download_rate) - end - else -- print_command_result o buf "You are not allowed to toggle bandwidth"; -+ print_command_result o "You are not allowed to toggle bandwidth"; - "" - ), ":\t\t\t\ttoggle between the two rate sets"; - -@@ -1205,43 +1224,87 @@ - ) , ":\t\t\t\tprint all networks"; - - "enable", Arg_one (fun num o -> -- let buf = o.conn_buf in - if user2_is_admin o.conn_user.ui_user then - begin - let n = network_find_by_num (int_of_string num) in - network_enable n; -- print_command_result o buf "network enabled" -+ print_command_result o "network enabled" - end - else -- print_command_result o buf "You are not allowed to enable networks"; -+ print_command_result o "You are not allowed to enable networks"; - _s "" - ) , "<num> :\t\t\t\tenable a particular network"; - - "disable", Arg_one (fun num o -> -- let buf = o.conn_buf in - if user2_is_admin o.conn_user.ui_user then - begin - let n = network_find_by_num (int_of_string num) in - network_disable n; -- print_command_result o buf "network disabled" -+ print_command_result o "network disabled" - end - else -- print_command_result o buf "You are not allowed to disable networks"; -+ print_command_result o "You are not allowed to disable networks"; - _s "" - ) , "<num> :\t\t\t\tdisable a particular network"; -+ -+ "force_porttest", Arg_none (fun o -> -+ networks_iter (fun n -> -+ match network_porttest_result n with -+ | PorttestNotAvailable -> () -+ | _ -> network_porttest_start n; -+ ); -+ if use_html_mods o then -+ print_command_result o "porttest started, use command -+ \\<u\\>\\<a onclick=\\\"javascript:window.location.href='submit?q=porttest'\\\"\\>porttest\\</a\\>\\</u\\> to see results" -+ else -+ print_command_result o "porttest started, use command 'porttest' to see results"; -+ "" -+ ) , ":\t\t\tforce start network porttest"; - - "porttest", Arg_none (fun o -> - let buf = o.conn_buf in -+ let age time = Date.time_to_string (BasicSocket.last_time () - time) "verbose" in -+ let list = ref [] in -+ let put_list e = list := e :: !list in - networks_iter (fun n -> -- match network_porttest_result n with -- PorttestNotAvailable -> () -- | _ -> network_porttest_start n); -- if o.conn_output = HTML then -- Printf.bprintf buf "Click this \\<a href=\\\"porttest\\\"\\>link\\</a\\> to see results" -- else -- Printf.bprintf buf "Test started, you need a HTML browser to display results"; -+ match network_porttest_result n with -+ | PorttestNotAvailable -> -+ put_list (n.network_name , "Porttest not available") -+ | PorttestNotStarted -> -+ put_list (n.network_name , "Porttest started"); -+ network_porttest_start n -+ | PorttestInProgress time -> -+ put_list (n.network_name , Printf.sprintf "Porttest in progress, started %s ago" (age time)) -+ | PorttestResult (time, s) -> -+ put_list (n.network_name , Printf.sprintf "Porttest finished %s ago \n%s" (age time) s) -+ ); -+ if use_html_mods o then begin -+ Printf.bprintf buf "\\<div class=\\\"shares\\\"\\>\\<table class=main cellspacing=0 cellpadding=0\\> -+ \\<tr\\>\\<td\\>\\<table cellspacing=0 cellpadding=0 width=100%%\\> -+ \\<tr\\>\\<td class=downloaded width=100%%\\>\\</td\\> -+ \\<td nowrap class=\\\"fbig\\\"\\> -+ \\<a onclick=\\\"javascript:window.location.href='submit?q=force_porttest'\\\"\\>Restart porttest\\</a\\>\\</td\\> -+ \\<td nowrap class=\\\"fbig pr\\\"\\> -+ \\<a onclick=\\\"javascript:window.location.reload()\\\"\\>Refresh results\\</a\\>\\</td\\> -+ \\</tr\\>\\</table\\>\\</td\\>\\</tr\\>\\<tr\\>\\<td\\>"; -+ html_mods_table_header buf "sharesTable" "shares" [ -+ ( "0", "srh", "Network", "Network" ) ; -+ ( "0", "srh", "Result", "Result" ) ] -+ end; -+ html_mods_cntr_init (); -+ List.iter (fun (net, result) -> -+ if use_html_mods o then -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\</tr\\>" -+ (html_mods_cntr ()) net (Str.global_replace (Str.regexp "\n") "\\<br\\>" result) -+ else -+ Printf.bprintf buf "----- %s: -----\n%s\n\n" net result; -+ ) !list; -+ if use_html_mods o then -+ Printf.bprintf buf "\\</table\\>\\</div\\>\\</td\\>\\</tr\\>\\</table\\>" -+ else -+ Printf.bprintf buf "\n\nuse command 'porttest' again to refresh the results \nuse command 'force_porttest' to force a new porttest"; - "" -- ) , ":\t\t\t\tstart network porttest"; -+ ) , ":\t\t\t\tprint network porttest results"; - - ] - -@@ -1362,7 +1425,7 @@ - (if s.search_waiting = 0 then _s "done" else - string_of_int s.search_waiting) - s.search_nresults -- ) (Sort.list (fun f1 f2 -> f1.search_num < f2.search_num) -+ ) (List.sort (fun f1 f2 -> compare f1.search_num f2.search_num) - user.ui_user_searches) - end; - "" -@@ -1475,8 +1538,9 @@ - with _ -> - Options.set_simple_option downloads_ini name value; - Printf.sprintf "option %s value changed" name -- with e -> -- Printf.sprintf "Error %s" (Printexc2.to_string e) -+ with -+ | Not_found -> Printf.sprintf "Option %s does not exist" name -+ | e -> Printf.sprintf "Error %s" (Printexc2.to_string e) - end - else - _s "You are not allowed to change options" -@@ -1569,6 +1633,9 @@ - - "voo", Arg_multiple (fun args o -> - let buf = o.conn_buf in -+ let changed_list = List.sort (fun d1 d2 -> compare d1 d2) (List.filter (fun o -> -+ o.option_value <> o.option_default && not (String2.starts_with o.option_name "enable_") -+ ) (CommonInteractive.all_simple_options ())) in - if use_html_mods o then begin - - Printf.bprintf buf "\\<script type=\\\"text/javascript\\\"\\> -@@ -1612,7 +1679,8 @@ - ("Files", "File related options") ; - ("Mail", "eMail information options") ; - ("Net", "activate/deaktivate Networks, some TCP/IP & IP blocking options") ; -- ("Misc", "miscellaneous") ]; -+ ("Misc", "miscellaneous") ; -+ ("changed", "Show changed options") ]; - - Printf.bprintf buf " - \\<td nowrap title=\\\"Show all options\\\" class=\\\"fbig\\\"\\>\\<a onclick=\\\"javascript:window.location.href='submit?q=voo'\\\"\\>All\\</a\\>\\</td\\> -@@ -1650,9 +1718,11 @@ - - list_options_html o ( - match args with -- [] | _ :: _ :: _ -> -- let v= CommonInteractive.all_simple_options () in -- v -+ | [] | _ :: _ :: _ -> -+ CommonInteractive.all_simple_options () -+ -+ | ["changed"] -> -+ changed_list - - | [arg] -> - try -@@ -1767,6 +1837,7 @@ - [ - strings_of_option previewer; - strings_of_option temp_directory; -+ strings_of_option share_scan_interval; - strings_of_option hdd_temp_minfree; - strings_of_option hdd_temp_stop_core; - strings_of_option hdd_coredir_minfree; -@@ -1777,7 +1848,8 @@ - strings_of_option allow_browse_share; - strings_of_option auto_commit; - strings_of_option pause_new_downloads; -- strings_of_option create_dir_mask; -+ strings_of_option create_file_mode; -+ strings_of_option create_dir_mode; - strings_of_option create_file_sparse; - strings_of_option log_file; - strings_of_option log_file_size; -@@ -1854,6 +1926,8 @@ - strings_of_option backup_options_generations; - strings_of_option small_files_slot_limit; - ] -+ | 9 -> -+ changed_list - - | _ -> - let v = CommonInteractive.some_simple_options (tab - !mtabs) in -@@ -1908,10 +1982,13 @@ - end - - else begin -- list_options o (CommonInteractive.parse_simple_options args) -+ match args with -+ | [] | _ :: _ :: _ -> list_options o (CommonInteractive.all_simple_options ()) -+ | ["9"] | ["changed"] -> list_options o changed_list -+ | [_] -> list_options o (CommonInteractive.parse_simple_options args); - end; - "" -- ), ":\t\t\t\t\tprint all options"; -+ ), "[<option>|changed]:\t\t\tprint options (use * as wildcard), 'changed' prints all changed options, leave empty to print all options"; - - "vwi", Arg_none (fun o -> - let buf = o.conn_buf in -@@ -1920,6 +1997,8 @@ - \\<tr\\>\\<td\\> - \\<table cellspacing=0 cellpadding=0 width=100%%\\>\\<tr\\> - \\<td class=downloaded width=100%%\\>\\</td\\> -+\\<td nowrap title=\\\"force downloading all web_infos files\\\" class=\\\"fbig\\\"\\> -+\\<a onclick=\\\"javascript: {parent.fstatus.location.href='submit?q=force_web_infos';}\\\"\\>Re-download all\\</a\\> - \\<td nowrap class=\\\"fbig pr\\\"\\>\\<a onclick=\\\"javascript: { - var getdir = prompt('Input: <kind> <URL> [<period>]','server.met URL') - parent.fstatus.location.href='submit?q=urladd+' + encodeURIComponent(getdir); -@@ -1937,16 +2016,14 @@ - - html_mods_table_header buf "web_infoTable" "vo" [ - ( "0", "srh ac", "Click to remove URL", "Remove" ) ; -+ ( "0", "srh", "Download now", "DL" ) ; - ( "0", "srh", "Option type", "Type" ) ; - ( "0", "srh", "Option delay", "Delay" ) ; - ( "0", "srh", "Option value", "Value" ) ] ; - -- let counter = ref 0 in -- -+ html_mods_cntr_init (); - List.iter (fun (kind, period, url) -> -- incr counter; -- Printf.bprintf buf "\\<tr class=\\\"%s\\\"\\>" -- (if !counter mod 2 == 0 then "dl-1" else "dl-2"); -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); - Printf.bprintf buf " - \\<td title=\\\"Click to remove URL\\\" - onMouseOver=\\\"mOvr(this);\\\" -@@ -1955,6 +2032,13 @@ - parent.fstatus.location.href=\\\"submit?q=urlremove+\\\\\\\"%s\\\\\\\"\\\" - setTimeout(\\\"window.location.reload()\\\",1000);}' - class=\\\"srb\\\"\\>Remove\\</td\\>" (Url.encode url); -+ Printf.bprintf buf " -+ \\<td title=\\\"Download now\\\" -+ onMouseOver=\\\"mOvr(this);\\\" -+ onMouseOut=\\\"mOut(this);\\\" -+ onClick=\\\'javascript:{ -+ parent.fstatus.location.href=\\\"submit?q=force_web_infos+\\\\\\\"%s\\\\\\\"\\\";}' -+ class=\\\"srb\\\"\\>DL\\</td\\>" (Url.encode url); - Printf.bprintf buf " - \\<td title=\\\"%s\\\" class=\\\"sr\\\"\\>%s\\</td\\> - \\<td class=\\\"sr\\\"\\>%d\\</td\\>" url kind period; -@@ -1969,11 +2053,9 @@ - ( "0", "srh", "Web kind", "Kind" ); - ( "0", "srh", "Description", "Type" ) ]; - -- let counter = ref 0 in -+ html_mods_cntr_init (); - List.iter (fun (kind, data) -> -- incr counter; -- Printf.bprintf buf "\\<tr class=\\\"%s\\\"\\>" -- (if !counter mod 2 == 0 then "dl-1" else "dl-2"); -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); - Printf.bprintf buf " - \\<td class=\\\"sr\\\"\\>%s\\</td\\> - \\<td class=\\\"sr\\\"\\>%s\\</td\\>" kind data.description -@@ -2094,9 +2176,9 @@ - | Some p -> Printf.sprintf "%d%%" p in - Printf.bprintf buf "percentused %s\n" (print_percento (Unix32.percentused arg)); - Printf.bprintf buf "percentfree %s\n" (print_percento (Unix32.percentfree arg)); -- let stat = Unix.stat arg in -- Printf.bprintf buf "\nstat_device %d\n" stat.Unix.st_dev; -- Printf.bprintf buf "stat_inode %d\n" stat.Unix.st_ino; -+ let stat = Unix.LargeFile.stat arg in -+ Printf.bprintf buf "\nstat_device %d\n" stat.Unix.LargeFile.st_dev; -+ Printf.bprintf buf "stat_inode %d\n" stat.Unix.LargeFile.st_ino; - - _s "" - ), "debug command (example: disk .)"; -@@ -2121,15 +2203,16 @@ - "debug_fileinfo", Arg_one (fun arg o -> - let buf = o.conn_buf in - (try -- let s = Unix.stat arg in -- Printf.bprintf buf "st_dev %d\n" s.Unix.st_dev; -- Printf.bprintf buf "st_ino %d\n" s.Unix.st_ino; -- Printf.bprintf buf "st_uid %d\n" s.Unix.st_uid; -- Printf.bprintf buf "st_gid %d\n" s.Unix.st_gid; -- Printf.bprintf buf "st_size %d\n" s.Unix.st_size; -- Printf.bprintf buf "st_atime %s\n" (Date.to_full_string s.Unix.st_atime); -- Printf.bprintf buf "st_mtime %s\n" (Date.to_full_string s.Unix.st_mtime); -- Printf.bprintf buf "st_ctime %s\n" (Date.to_full_string s.Unix.st_ctime); -+ let module U = Unix.LargeFile in -+ let s = U.stat arg in -+ Printf.bprintf buf "st_dev %d\n" s.U.st_dev; -+ Printf.bprintf buf "st_ino %d\n" s.U.st_ino; -+ Printf.bprintf buf "st_uid %d\n" s.U.st_uid; -+ Printf.bprintf buf "st_gid %d\n" s.U.st_gid; -+ Printf.bprintf buf "st_size %Ld\n" s.U.st_size; -+ Printf.bprintf buf "st_atime %s\n" (Date.to_full_string s.U.st_atime); -+ Printf.bprintf buf "st_mtime %s\n" (Date.to_full_string s.U.st_mtime); -+ Printf.bprintf buf "st_ctime %s\n" (Date.to_full_string s.U.st_ctime); - let user,group = Unix32.owner arg in - Printf.bprintf buf "username %s\n" user; - Printf.bprintf buf "groupname %s\n" group; -@@ -2337,9 +2420,8 @@ - ), "<dir> :\t\t\t\tunshare directory <dir>"; - - "upstats", Arg_none (fun o -> -- let buf = o.conn_buf in - if not (user2_can_view_uploads o.conn_user.ui_user) then -- print_command_result o buf "You are not allowed to see upload statistics" -+ print_command_result o "You are not allowed to see upload statistics" - else - begin - let list = ref [] in -@@ -2355,7 +2437,7 @@ - "links", Arg_none (fun o -> - let buf = o.conn_buf in - if not (user2_can_view_uploads o.conn_user.ui_user) then -- print_command_result o o.conn_buf "You are not allowed to see shared files list" -+ print_command_result o "You are not allowed to see shared files list" - else begin - - let list = ref [] in -@@ -2385,13 +2467,13 @@ - let buf = o.conn_buf in - - if not (user2_can_view_uploads o.conn_user.ui_user) then -- print_command_result o buf "You are not allowed to see uploaders list" -+ print_command_result o "You are not allowed to see uploaders list" - else begin - - let nuploaders = Intmap.length !uploaders in - if use_html_mods o then - begin -- let counter = ref 0 in -+ html_mods_cntr_init (); - Printf.bprintf buf "\\<div class=\\\"uploaders\\\"\\>"; - html_mods_table_one_row buf "uploadersTable" "uploaders" [ - ("", "srh", Printf.sprintf "Total upload slots: %d (%d) | Pending slots: %d\n" nuploaders -@@ -2415,8 +2497,10 @@ - ] @ - (if !!emule_mods_count then [( "0", "srh", "eMule MOD", "EM" )] else []) - @ [ -- ( "0", "srh ar", "Total DL bytes from this client for all files", "DL" ) ; -- ( "0", "srh ar", "Total UL bytes to this client for all files", "UL" ) ; -+ ( "0", "srh ar", "Total DL bytes from this client for all files", "tDL" ) ; -+ ( "0", "srh ar", "Total UL bytes to this client for all files", "tUL" ) ; -+ ( "0", "srh ar", "Session DL bytes from this client for all files", "sDL" ) ; -+ ( "0", "srh ar", "Session UL bytes to this client for all files", "sUL" ) ; - ( "0", "srh ar", "Slot kind", "Slot" ) ; - ( "0", "srh", "Filename", "Filename" ) ]); - -@@ -2424,15 +2508,14 @@ - try - let i = client_info c in - if is_connected i.client_state then begin -- incr counter; - -- Printf.bprintf buf "\\<tr class=\\\"%s\\\" -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\" - title=\\\"[%d] Add as friend (avg: %.1f KB/s)\\\" - onMouseOver=\\\"mOvr(this);\\\" - onMouseOut=\\\"mOut(this);\\\" - onClick=\\\"parent.fstatus.location.href='submit?q=friend_add+%d'\\\"\\>" -- ( if (!counter mod 2 == 0) then "dl-1" else "dl-2";) (client_num c) -- ( float_of_int (Int64.to_int i.client_uploaded / 1024) /. -+ (html_mods_cntr ()) (client_num c) -+ ( float_of_int (Int64.to_int i.client_session_uploaded / 1024) /. - float_of_int (max 1 ((last_time ()) - i.client_connect_time)) ) - (client_num c); - -@@ -2455,8 +2538,10 @@ - ] @ - (if !!emule_mods_count then [("", "sr", i.client_emulemod)] else []) - @ [ -- ("", "sr ar", size_of_int64 i.client_downloaded); -- ("", "sr ar", size_of_int64 i.client_uploaded); -+ ("", "sr ar", size_of_int64 i.client_total_downloaded); -+ ("", "sr ar", size_of_int64 i.client_total_uploaded); -+ ("", "sr ar", size_of_int64 i.client_session_downloaded); -+ ("", "sr ar", size_of_int64 i.client_session_uploaded); - (let text1, text2 = - match client_slot c with - | FriendSlot -> "Friend", "F" -@@ -2494,8 +2579,10 @@ - ] @ - (if !!emule_mods_count then [( "0", "srh", "eMule MOD", "EM" )] else []) - @ [ -- ( "0", "srh ar", "Total DL bytes from this client for all files", "DL" ) ; -- ( "0", "srh ar", "Total UL bytes to this client for all files", "UL" ) ; -+ ( "0", "srh ar", "Total DL bytes from this client for all files", "tDL" ) ; -+ ( "0", "srh ar", "Total UL bytes to this client for all files", "tUL" ) ; -+ ( "0", "srh ar", "Session DL bytes from this client for all files", "sDL" ) ; -+ ( "0", "srh ar", "Session UL bytes to this client for all files", "sUL" ) ; - ( "0", "srh", "Filename", "Filename" ) ]); - - Intmap.iter (fun cnum c -> -@@ -2503,12 +2590,11 @@ - try - let i = client_info c in - let ips,cc,cn = string_of_kind_geo i.client_kind in -- incr counter; - -- Printf.bprintf buf "\\<tr class=\\\"%s\\\" -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\" - title=\\\"Add as Friend\\\" onMouseOver=\\\"mOvr(this);\\\" onMouseOut=\\\"mOut(this);\\\" - onClick=\\\"parent.fstatus.location.href='submit?q=friend_add+%d'\\\"\\>" -- ( if (!counter mod 2 == 0) then "dl-1" else "dl-2";) cnum; -+ (html_mods_cntr ()) cnum; - - html_mods_td buf [ - ("", "sr", Printf.sprintf "%d" (client_num c)); ]; -@@ -2527,8 +2613,10 @@ - ] @ - (if !!emule_mods_count then [("", "sr", i.client_emulemod )] else []) - @ [ -- ("", "sr ar", size_of_int64 i.client_downloaded); -- ("", "sr ar", size_of_int64 i.client_uploaded); -+ ("", "sr ar", size_of_int64 i.client_total_downloaded); -+ ("", "sr ar", size_of_int64 i.client_total_uploaded); -+ ("", "sr ar", size_of_int64 i.client_session_downloaded); -+ ("", "sr ar", size_of_int64 i.client_session_uploaded); - ("", "sr", (match i.client_upload with - Some f -> shorten f !!max_name_len - | None -> "") ) ]); -@@ -2547,7 +2635,7 @@ - try - let i = client_info c in - client_print c o; -- Printf.bprintf buf "client: %s downloaded: %s uploaded: %s\n" i.client_software (Int64.to_string i.client_downloaded) (Int64.to_string i.client_uploaded); -+ Printf.bprintf buf "client: %s downloaded: %s uploaded: %s\n" i.client_software (Int64.to_string i.client_total_downloaded) (Int64.to_string i.client_total_uploaded); - match i.client_upload with - Some cu -> - Printf.bprintf buf " filename: %s\n" cu -@@ -2658,7 +2746,7 @@ - end - ) !!files) args; - files_to_cancel o -- ), "<num> :\t\t\t\tcancel download (use arg 'all' for all files)"; -+ ), "<num|all> :\t\t\tcancel download (use arg 'all' for all files)"; - - "downloaders", Arg_none (fun o -> - let buf = o.conn_buf in -@@ -2679,8 +2767,10 @@ - ( "0", "srh", "Secure User Identification [N]one, [P]assed, [F]ailed", "S" ) ; - ( "0", "srh", "IP address", "IP address" ) ; - ] @ (if !Geoip.active then [( "0", "srh", "Country Code/Name", "CC" )] else []) @ [ -- ( "1", "srh ar", "Total UL bytes to this client for all files", "UL" ) ; -- ( "1", "srh ar", "Total DL bytes from this client for all files", "DL" ) ; -+ ( "1", "srh ar", "Total UL bytes to this client for all files", "tUL"); -+ ( "1", "srh ar", "Total DL bytes from this client for all files", "tDL"); -+ ( "1", "srh ar", "Session UL bytes to this client for all files", "sUL"); -+ ( "1", "srh ar", "Session DL bytes from this client for all files", "sDL"); - ( "0", "srh", "Filename", "Filename" ) ]); - - let counter = ref 0 in -@@ -2725,7 +2815,7 @@ - if (as_file_impl file).impl_file_num = num then - file_pause file o.conn_user.ui_user - ) !!files) args; "" -- ), "<num> :\t\t\t\tpause a download (use arg 'all' for all files)"; -+ ), "<num|all> :\t\t\tpause a download (use arg 'all' for all files)"; - - "resume", Arg_multiple (fun args o -> - if args = ["all"] && user2_is_admin o.conn_user.ui_user then -@@ -2739,7 +2829,7 @@ - if (as_file_impl file).impl_file_num = num then - file_resume file o.conn_user.ui_user - ) !!files) args; "" -- ), "<num> :\t\t\t\tresume a paused download (use arg 'all' for all files)"; -+ ), "<num|all> :\t\t\tresume a paused download (use arg 'all' for all files)"; - - "release", Arg_one (fun arg o -> - let num = int_of_string arg in -@@ -2792,10 +2882,10 @@ - Printf.bprintf buf "\\<div class=\\\"sourcesTable al\\\"\\>\\<table cellspacing=0 cellpadding=0\\> - \\<tr\\>\\<td\\> - \\<table cellspacing=0 cellpadding=0 width=100%%\\>\\<tr\\> -- \\<td nowrap class=\\\"fbig\\\"\\>\\<a href=\\\"files\\\"\\>Display all files\\</a\\>\\</td\\> -- \\<td nowrap class=\\\"fbig\\\"\\>\\<a href=\\\"submit?q=verify_chunks+%d\\\"\\>Verify chunks\\</a\\>\\</td\\> -- \\<td nowrap class=\\\"fbig\\\"\\>\\<a href=\\\"preview_download?q=%d\\\"\\>Preview\\</a\\>\\</td\\> -- \\<td nowrap class=\\\"fbig pr\\\"\\>\\<a href=\\\"javascript:window.location.reload()\\\"\\>Reload\\</a\\>\\</td\\> -+ \\<td nowrap class=\\\"fbig\\\"\\>\\<a onclick=\\\"javascript:window.location.href='files'\\\"\\>Display all files\\</a\\>\\</td\\> -+ \\<td nowrap class=\\\"fbig\\\"\\>\\<a onClick=\\\"javascript:parent.fstatus.location.href='submit?q=verify_chunks+%d'\\\"\\>Verify chunks\\</a\\>\\</td\\> -+ \\<td nowrap class=\\\"fbig\\\"\\>\\<a onClick=\\\"javascript:parent.fstatus.location.href='preview_download?q=%d'\\\"\\>Preview\\</a\\>\\</td\\> -+ \\<td nowrap class=\\\"fbig pr\\\"\\>\\<a onclick=\\\"javascript:window.location.reload()\\\"\\>Reload\\</a\\>\\</td\\> - \\<td class=downloaded width=100%%\\>\\</td\\> - \\</tr\\>\\</table\\> - \\</td\\>\\</tr\\> -@@ -2872,50 +2962,47 @@ - register_commands "Driver/Users" [ - - "useradd", Arg_two (fun user pass o -> -- let buf = o.conn_buf in - if user2_is_admin o.conn_user.ui_user - || o.conn_user.ui_user.user_name = user then - if user2_user_exists user then - begin - user2_user_set_password (user2_user_find user) pass; -- print_command_result o buf (Printf.sprintf "Password of user %s changed" user) -+ print_command_result o (Printf.sprintf "Password of user %s changed" user) - end - else - begin - user2_user_add user (Md4.string pass) (); -- print_command_result o buf (Printf.sprintf "User %s added" user) -+ print_command_result o (Printf.sprintf "User %s added" user) - end - else -- print_command_result o buf "You are not allowed to add users"; -+ print_command_result o "You are not allowed to add users"; - _s "" - ), "<user> <passwd> :\t\tadd new mldonkey user/change user password"; - - "userdel", Arg_one (fun user o -> -- let buf = o.conn_buf in - if user <> o.conn_user.ui_user.user_name then - if user2_is_admin o.conn_user.ui_user then - if user = admin_user.user_name then -- print_command_result o buf "User 'admin' can not be removed" -+ print_command_result o "User 'admin' can not be removed" - else - try - let u = user2_user_find user in - let n = user2_num_user_dls u in -- if n <> 0 then print_command_result o buf -+ if n <> 0 then print_command_result o - (Printf.sprintf "User %s has %d downloads, can not delete" user n) - else - user2_user_remove user; -- print_command_result o buf (Printf.sprintf "User %s removed" user) -+ print_command_result o (Printf.sprintf "User %s removed" user) - with -- Not_found -> print_command_result o buf (Printf.sprintf "User %s does not exist" user) -+ Not_found -> print_command_result o (Printf.sprintf "User %s does not exist" user) - else -- print_command_result o buf "You are not allowed to remove users" -+ print_command_result o "You are not allowed to remove users" - else -- print_command_result o buf "You can not remove yourself"; -+ print_command_result o "You can not remove yourself"; - _s "" - ), "<user> :\t\t\tremove a mldonkey user"; - - "usergroupadd", Arg_two (fun user group o -> -- let buf = o.conn_buf in - if user2_is_admin o.conn_user.ui_user then - begin - try -@@ -2924,18 +3011,17 @@ - try - let g = user2_group_find group in - user2_user_add_group u g; -- print_command_result o buf (Printf.sprintf "Added group %s to user %s" g.group_name u.user_name) -- with Not_found -> print_command_result o buf (Printf.sprintf "Group %s does not exist" group) -+ print_command_result o (Printf.sprintf "Added group %s to user %s" g.group_name u.user_name) -+ with Not_found -> print_command_result o (Printf.sprintf "Group %s does not exist" group) - end -- with Not_found -> print_command_result o buf (Printf.sprintf "User %s does not exist" user) -+ with Not_found -> print_command_result o (Printf.sprintf "User %s does not exist" user) - end - else -- print_command_result o buf "You are not allowed to add groups to a user"; -+ print_command_result o "You are not allowed to add groups to a user"; - _s "" - ), "<user> <group> :\t\tadd a group to a mldonkey user"; - - "usergroupdel", Arg_two (fun user group o -> -- let buf = o.conn_buf in - if user2_is_admin o.conn_user.ui_user - || o.conn_user.ui_user.user_name = user then - begin -@@ -2945,10 +3031,10 @@ - try - let g = user2_group_find group in - if not (List.mem g u.user_groups) then -- print_command_result o buf (Printf.sprintf "User %s is not member of group %s" user group) -+ print_command_result o (Printf.sprintf "User %s is not member of group %s" user group) - else - if Some g = u.user_default_group then -- print_command_result o buf (Printf.sprintf "Group %s is default group of user %s, can not remove. Use command userdgroup to change default_group." group user) -+ print_command_result o (Printf.sprintf "Group %s is default group of user %s, can not remove. Use command userdgroup to change default_group." group user) - else - begin - let counter = ref 0 in -@@ -2960,23 +3046,22 @@ - end - ) !!files; - user2_user_remove_group (user2_user_find user) (user2_group_find group); -- print_command_result o buf (Printf.sprintf "Removed group %s from user %s%s" -+ print_command_result o (Printf.sprintf "Removed group %s from user %s%s" - group user - (if !counter = 0 then "" else Printf.sprintf ", changed file_group of %d file%s to default_group %s" - !counter (Printf2.print_plural_s !counter) (user2_print_group u.user_default_group))) - end -- with Not_found -> print_command_result o buf (Printf.sprintf "Group %s does not exist" group) -+ with Not_found -> print_command_result o (Printf.sprintf "Group %s does not exist" group) - end -- with Not_found -> print_command_result o buf (Printf.sprintf "User %s does not exist" user) -+ with Not_found -> print_command_result o (Printf.sprintf "User %s does not exist" user) - end - - else -- print_command_result o buf "You are not allowed to remove groups from a user"; -+ print_command_result o "You are not allowed to remove groups from a user"; - _s "" - ), "<user> <group> :\t\tremove a group from a mldonkey user"; - - "userdgroup", Arg_two (fun user group o -> -- let buf = o.conn_buf in - if user2_is_admin o.conn_user.ui_user - || o.conn_user.ui_user.user_name = user then - begin -@@ -2994,76 +3079,71 @@ - if update_dgroup () then - begin - user2_user_set_default_group u g; -- print_command_result o buf (Printf.sprintf "Changed default group of user %s to group %s" u.user_name (user2_print_user_default_group u)) -+ print_command_result o (Printf.sprintf "Changed default group of user %s to group %s" u.user_name (user2_print_user_default_group u)) - end -- else print_command_result o buf (Printf.sprintf "User %s is not member of group %s" u.user_name group) -- with Not_found -> print_command_result o buf (Printf.sprintf "Group %s does not exist" group) -+ else print_command_result o (Printf.sprintf "User %s is not member of group %s" u.user_name group) -+ with Not_found -> print_command_result o (Printf.sprintf "Group %s does not exist" group) - end -- with Not_found -> print_command_result o buf (Printf.sprintf "User %s does not exist" user) -+ with Not_found -> print_command_result o (Printf.sprintf "User %s does not exist" user) - end - else -- print_command_result o buf "You are not allowed to change default group"; -+ print_command_result o "You are not allowed to change default group"; - _s "" - ), "<user> <group|None> :\tchange user default group"; - - "passwd", Arg_one (fun passwd o -> -- let buf = o.conn_buf in - begin - try - let u = user2_user_find o.conn_user.ui_user.user_name in - user2_user_set_password u passwd; -- print_command_result o buf (Printf.sprintf "Password of user %s changed" u.user_name) -- with Not_found -> print_command_result o buf (Printf.sprintf "User %s does not exist" o.conn_user.ui_user.user_name) -+ print_command_result o (Printf.sprintf "Password of user %s changed" u.user_name) -+ with Not_found -> print_command_result o (Printf.sprintf "User %s does not exist" o.conn_user.ui_user.user_name) - end; - _s "" - ), "<passwd> :\t\t\tchange own password"; - - "usermail", Arg_two (fun user mail o -> -- let buf = o.conn_buf in - if user2_is_admin o.conn_user.ui_user - || o.conn_user.ui_user.user_name = user then - begin - try - let u = user2_user_find user in - user2_user_set_mail u mail; -- print_command_result o buf (Printf.sprintf "User %s has new mail %s" user mail) -- with Not_found -> print_command_result o buf (Printf.sprintf "User %s does not exist" user) -+ print_command_result o (Printf.sprintf "User %s has new mail %s" user mail) -+ with Not_found -> print_command_result o (Printf.sprintf "User %s does not exist" user) - end -- else print_command_result o buf "You are not allowed to change mail addresses"; -+ else print_command_result o "You are not allowed to change mail addresses"; - _s "" - ), "<user> <mail> :\t\tchange user mail address"; - - "userdls", Arg_two (fun user dls o -> -- let buf = o.conn_buf in - if user2_is_admin o.conn_user.ui_user then - begin - try - let u = user2_user_find user in - user2_user_set_dls u (int_of_string dls); -- print_command_result o buf (Printf.sprintf "User %s has now %s downloads allowed" user (user2_print_user_dls (user2_user_find user))) -- with Not_found -> print_command_result o buf (Printf.sprintf "User %s does not exist" user) -+ print_command_result o (Printf.sprintf "User %s has now %s downloads allowed" user (user2_print_user_dls (user2_user_find user))) -+ with Not_found -> print_command_result o (Printf.sprintf "User %s does not exist" user) - end -- else print_command_result o buf "You are not allowed to change this value"; -+ else print_command_result o "You are not allowed to change this value"; - _s "" - ), "<user> <num> :\t\t\tchange number of allowed concurrent downloads"; - - "usercommit", Arg_two (fun user dir o -> -- let buf = o.conn_buf in - if user2_is_admin o.conn_user.ui_user - || o.conn_user.ui_user.user_name = user then - begin - try - let u = user2_user_find user in - user2_user_set_commit_dir u dir; -- print_command_result o buf (Printf.sprintf "User %s has new commit dir %s" u.user_name u.user_commit_dir) -- with Not_found -> print_command_result o buf (Printf.sprintf "User %s does not exist" user) -+ print_command_result o (Printf.sprintf "User %s has new commit dir %s" u.user_name u.user_commit_dir) -+ with Not_found -> print_command_result o (Printf.sprintf "User %s does not exist" user) - end -- else print_command_result o buf "You are not allowed to change this value"; -+ else print_command_result o "You are not allowed to change this value"; - _s "" - ), "<user> <dir> :\t\tchange user specific commit directory"; - - "groupadd", Arg_two (fun group admin o -> -- let buf = o.conn_buf in - let g_admin = - try - bool_of_string admin -@@ -3071,19 +3151,18 @@ - in - if user2_is_admin o.conn_user.ui_user then - if user2_group_exists group then -- print_command_result o buf (Printf.sprintf "Group %s already exists" group) -+ print_command_result o (Printf.sprintf "Group %s already exists" group) - else - begin - user2_group_add group g_admin; -- print_command_result o buf (Printf.sprintf "Group %s added" group) -+ print_command_result o (Printf.sprintf "Group %s added" group) - end - else -- print_command_result o buf "You are not allowed to add a group"; -+ print_command_result o "You are not allowed to add a group"; - _s "" -- ), "<group> <admin: true | false>: add new mldonkey group"; -+ ), "<group> <admin: true|false> :\tadd new mldonkey group"; - - "groupdel", Arg_one (fun group o -> -- let buf = o.conn_buf in - if user2_is_admin o.conn_user.ui_user then - begin - try -@@ -3091,46 +3170,45 @@ - let g_dls = user2_num_group_dls g in - let g_mem = user2_num_group_members g in - if g_dls <> 0 then -- print_command_result o buf -+ print_command_result o - (Printf.sprintf "Can not remove group %s, it has %d download%s" - group g_dls (Printf2.print_plural_s g_dls)) - else - if g_mem <> 0 then -- print_command_result o buf -+ print_command_result o - (Printf.sprintf "Can not remove group %s, it has %d member%s" - group g_mem (Printf2.print_plural_s g_mem)) - else - if g.group_name = system_user_default_group.group_name then -- print_command_result o buf (Printf.sprintf "Can not remove system group %s" group) -+ print_command_result o (Printf.sprintf "Can not remove system group %s" group) - else - begin - user2_group_remove g; -- print_command_result o buf (Printf.sprintf "Removed group %s" group) -+ print_command_result o (Printf.sprintf "Removed group %s" group) - end -- with Not_found -> print_command_result o buf (Printf.sprintf "Group %s does not exist" group) -+ with Not_found -> print_command_result o (Printf.sprintf "Group %s does not exist" group) - end - else -- print_command_result o buf "You are not allowed to remove users"; -+ print_command_result o "You are not allowed to remove users"; - _s "" - ), "<group> :\t\t\tremove an unused mldonkey group"; - - "groupadmin", Arg_two (fun group admin o -> -- let buf = o.conn_buf in - if user2_is_admin o.conn_user.ui_user then - begin - try - let g = user2_group_find group in - if g.group_name = system_user_default_group.group_name then -- print_command_result o buf (Printf.sprintf "Can not change state of system group %s" group) -+ print_command_result o (Printf.sprintf "Can not change state of system group %s" group) - else - begin - user2_group_admin g (bool_of_string admin); -- print_command_result o buf (Printf.sprintf "Changed admin status of group %s to %b" g.group_name g.group_admin) -+ print_command_result o (Printf.sprintf "Changed admin status of group %s to %b" g.group_name g.group_admin) - end -- with Not_found -> print_command_result o buf (Printf.sprintf "Group %s does not exist" group) -+ with Not_found -> print_command_result o (Printf.sprintf "Group %s does not exist" group) - end - else -- print_command_result o buf "You are not allowed to change group admin status"; -+ print_command_result o "You are not allowed to change group admin status"; - _s "" - ), "<group> <true|false> :\tchange group admin status"; - -@@ -3163,12 +3241,11 @@ - ( "0", "srh ar", "Download quota", "Max DLs" ) ; - ( "0", "srh ar", "Download count", "DLs" ) ]; - -- let counter = ref 0 in -+ html_mods_cntr_init (); - user2_users_iter (fun user -> -- incr counter; - let u_dls = user2_num_user_dls user in -- Printf.bprintf buf "\\<tr class=\\\"%s\\\"\\>" -- (if !counter mod 2 == 0 then "dl-1" else "dl-2"); -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" -+ (html_mods_cntr ()); - if user <> admin_user && (u_dls = 0) then Printf.bprintf buf - "\\<td title=\\\"Click to remove user\\\" - onMouseOver=\\\"mOvr(this);\\\" -@@ -3343,24 +3420,24 @@ - "Downloads"; - |] (List.rev !list); - end -- end else print_command_result o buf "You are not allowed to list users"; -+ end else print_command_result o "You are not allowed to list users"; - _s "" -- ), "\t\t\t\t\tprint users"; -+ ), ":\t\t\t\t\tprint users"; - - "whoami", Arg_none (fun o -> -- print_command_result o o.conn_buf o.conn_user.ui_user.user_name; -+ print_command_result o o.conn_user.ui_user.user_name; - _s "" -- ), "\t\t\t\t\tprint logged-in user name"; -+ ), ":\t\t\t\tprint logged-in user name"; - - "groups", Arg_none (fun o -> -- print_command_result o o.conn_buf (user2_print_user_groups " " o.conn_user.ui_user); -+ print_command_result o (user2_print_user_groups " " o.conn_user.ui_user); - _s "" -- ), "\t\t\t\t\tprint groups of logged-in user"; -+ ), ":\t\t\t\tprint groups of logged-in user"; - - "dgroup", Arg_none (fun o -> -- print_command_result o o.conn_buf (user2_print_user_default_group o.conn_user.ui_user); -+ print_command_result o (user2_print_user_default_group o.conn_user.ui_user); - _s "" -- ), "\t\t\t\t\tprint default group of logged-in user"; -+ ), ":\t\t\t\tprint default group of logged-in user"; - - "chgrp", Arg_two (fun group filenum o -> - let num = int_of_string filenum in -@@ -3368,8 +3445,13 @@ - let file = file_find num in - if String.lowercase group = "none" then - begin -- set_file_group file None; -- print_command_result o o.conn_buf (Printf.sprintf (_b "Changed group of download %d to %s") num group) -+ if user2_allow_file_admin file o.conn_user.ui_user then -+ begin -+ set_file_group file None; -+ print_command_result o (Printf.sprintf (_b "Changed group of download %d to %s") num group) -+ end -+ else -+ print_command_result o (Printf.sprintf (_b "You are not allowed to change group of download %d to %s") num group) - end - else - begin -@@ -3379,13 +3461,13 @@ - List.mem g (file_owner file).user_groups then - begin - set_file_group file (Some g); -- print_command_result o o.conn_buf (Printf.sprintf (_b "Changed group of download %d to %s") num group) -+ print_command_result o (Printf.sprintf (_b "Changed group of download %d to %s") num group) - end - else -- print_command_result o o.conn_buf (Printf.sprintf (_b "You are not allowed to change group of download %d to %s") num group) -- with Not_found -> print_command_result o o.conn_buf (Printf.sprintf (_b "Group %s not found") group) -+ print_command_result o (Printf.sprintf (_b "You are not allowed to change group of download %d to %s") num group) -+ with Not_found -> print_command_result o (Printf.sprintf (_b "Group %s not found") group) - end -- with Not_found -> print_command_result o o.conn_buf (Printf.sprintf (_b "File %d not found") num) -+ with Not_found -> print_command_result o (Printf.sprintf (_b "File %d not found") num) - end; - _s "" - ), "<group> <num> :\t\t\tchange group of download <num> to <group>, use group = none for private file"; -@@ -3401,13 +3483,25 @@ - if user2_allow_file_admin file o.conn_user.ui_user then - begin - set_file_owner file u; -- print_command_result o o.conn_buf (Printf.sprintf (_b "Changed owner of download %d to %s") num user) -+ match file_group file with -+ | None -> -+ print_command_result o (Printf.sprintf (_b "Changed owner of download %d to %s") num user) -+ | Some g -> -+ if List.mem g u.user_groups then -+ print_command_result o (Printf.sprintf (_b "Changed owner of download %d to %s") num user) -+ else -+ begin -+ set_file_group file u.user_default_group; -+ print_command_result o (Printf.sprintf -+ (_b "owner %s is not member of file_group %s, changing file_group to user_default_group %s") -+ user g.group_name (user2_print_user_default_group u)) -+ end - end - else -- print_command_result o o.conn_buf (Printf.sprintf (_b "You are not allowed to change owner of download %d to %s") num user) -- with Not_found -> print_command_result o o.conn_buf (Printf.sprintf (_b "User %s not found") user) -+ print_command_result o (Printf.sprintf (_b "You are not allowed to change owner of download %d to %s") num user) -+ with Not_found -> print_command_result o (Printf.sprintf (_b "User %s not found") user) - end -- with Not_found -> print_command_result o o.conn_buf (Printf.sprintf (_b "File %d not found") num) -+ with Not_found -> print_command_result o (Printf.sprintf (_b "File %d not found") num) - end; - _s "" - ), "<user> <num> :\t\t\tchange owner of download <num> to <user>"; -Index: src/daemon/driver/driverControlers.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverControlers.ml,v -retrieving revision 1.93 -retrieving revision 1.96 -diff -u -r1.93 -r1.96 ---- src/daemon/driver/driverControlers.ml 19 Nov 2006 23:03:42 -0000 1.93 -+++ src/daemon/driver/driverControlers.ml 28 Jan 2007 20:39:59 -0000 1.96 -@@ -1493,25 +1493,6 @@ - read_theme_page this_page else - if !!html_mods then !!CommonMessages.download_html_js_mods0 - else !!CommonMessages.download_html_js_old) -- | "porttest" -> -- html_open_page buf t r true; -- let age time = -- Date.time_to_string (BasicSocket.last_time () - time) "verbose" in -- networks_iter (fun n -> -- let result = -- match network_porttest_result n with -- PorttestNotAvailable -> None -- | PorttestNotStarted -> Some "porttest not started" -- | PorttestInProgress time -> -- Some (Printf.sprintf "porttest started %s ago" (age time)) -- | PorttestResult (time, s) -> -- Some (Printf.sprintf "porttest finished %s ago, %s" (age time) s) -- in -- (match result with -- None -> () -- | Some result -> -- Printf.bprintf buf "%s:<br> %s<br>\n" n.network_name result)); -- Printf.bprintf buf "<br><br><a href=\"porttest\">Reload</a>" - | _ -> raise Not_found - with - | Not_found -> -Index: src/daemon/driver/driverGraphics_gd.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverGraphics_gd.ml,v -retrieving revision 1.3 -retrieving revision 1.4 -diff -u -r1.3 -r1.4 ---- src/daemon/driver/driverGraphics_gd.ml 28 Nov 2006 23:15:21 -0000 1.3 -+++ src/daemon/driver/driverGraphics_gd.ml 6 Jan 2007 17:31:48 -0000 1.4 -@@ -264,7 +264,7 @@ - in - let day_string n = - let time = Unix.localtime (basetime -. float_of_int(n * my_time / x_divisions ())) in -- Printf.sprintf "%02d.%02d." time.Unix.tm_mday time.Unix.tm_mon -+ Printf.sprintf "%02d.%02d." time.Unix.tm_mday (time.Unix.tm_mon + 1) - in - if show_days then - begin -Index: src/daemon/driver/driverInteractive.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverInteractive.ml,v -retrieving revision 1.118 -retrieving revision 1.126 -diff -u -r1.118 -r1.126 ---- src/daemon/driver/driverInteractive.ml 28 Nov 2006 23:17:31 -0000 1.118 -+++ src/daemon/driver/driverInteractive.ml 6 Feb 2007 22:26:58 -0000 1.126 -@@ -391,13 +391,10 @@ - - let print_table_html_mods buf lines = - -- let counter = ref 0 in -+ html_mods_cntr_init (); - - List.iter (fun line -> -- if (!counter mod 2 == 0) then Printf.bprintf buf "\\<tr class=dl-1" -- else Printf.bprintf buf "\\<tr class=dl-2"; -- incr counter; -- -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"" (html_mods_cntr ()); - Array.iter (fun data -> - Printf.bprintf buf "%s" data; - ) line; -@@ -668,7 +665,7 @@ - (List.length guifiles) (size_of_int64 !tdl) (size_of_int64 !tsize) (!trate /. 1024.) - (let unread = ref 0 in - Fifo.iter (fun (t,i,num,n,s) -> if t > !last_message_log then incr unread) chat_message_fifo; --if !unread > 0 then Printf.sprintf "\\<td class=downloaded title=\\\"%d unread messages\\\"\\>\\<a onClick=\\\"mSub('fstatus','version');mSub('output','message')\\\"\\>(+%d)\\</a\\>\\ \\</td\\>" !unread !unread else ""); -+if !unread > 0 then Printf.sprintf "\\<td onMouseOver=\\\"mOvr(this);\\\" onMouseOut=\\\"mOut(this);\\\" class=downloaded title=\\\"%d unread messages\\\"\\>\\<a onClick=\\\"mSub('fstatus','version');mSub('output','message')\\\"\\>(+%d)\\</a\\>\\ \\</td\\>" !unread !unread else ""); - - if !!html_mods_vd_network then Printf.bprintf buf - "\\<td title=\\\"Sort by network\\\" class=dlheader\\>\\<input style=\\\"padding-left: 0px; padding-right: 0px;\\\" class=headbutton type=submit value=N name=sortby\\>\\</td\\>"; -@@ -1115,7 +1112,8 @@ - - if o.conn_output <> HTML && !!improved_telnet then - begin -- let list = Sort.list (fun f1 f2 -> percent f1 >= percent f2) list in -+ let list = -+ List.sort (fun f1 f2 -> compare (percent f2) (percent f1)) list in - simple_print_file_list false buf list o - end - else -@@ -1124,29 +1122,37 @@ - let sorter = - match o.conn_sortvd with - -- | BySize -> (fun f1 f2 -> f1.file_size >= f2.file_size) -+ | BySize -> (fun f1 f2 -> compare f2.file_size f1.file_size) - | ByRate -> (fun f1 f2 -> -- if stalled f1 then false else -- if stalled f2 then true else -- f1.file_download_rate >= f2.file_download_rate -- ) -- | ByName -> (fun f1 f2 -> String.lowercase f1.file_name <= String.lowercase f2.file_name) -- | ByDone -> (fun f1 f2 -> f1.file_downloaded >= f2.file_downloaded) -- | ByPriority -> (fun f1 f2 -> f1.file_priority >= f2.file_priority) -- | BySources -> (fun f1 f2 -> (number_of_sources f1) >= (number_of_sources f2)) -- | ByASources -> (fun f1 f2 -> (number_of_active_sources f1) >= (number_of_active_sources f2)) -- | ByPercent -> (fun f1 f2 -> percent f1 >= percent f2) -- | ByETA -> (fun f1 f2 -> calc_file_eta f1 <= calc_file_eta f2) -- | ByAge -> (fun f1 f2 -> f1.file_age >= f2.file_age) -- | ByLast -> (fun f1 f2 -> f1.file_last_seen >= f2.file_last_seen) -- | ByNet -> (fun f1 f2 -> net_name f1 <= net_name f2) -- | ByAvail -> (fun f1 f2 -> get_file_availability f1 >= get_file_availability f2) -- | ByComments -> (fun f1 f2 -> (number_of_comments f1) >= (number_of_comments f2)) -- | ByUser -> (fun f1 f2 -> f1.file_user <= f2.file_user) -- | ByGroup -> (fun f1 f2 -> f1.file_group <= f2.file_group) -+ if stalled f1 then 1 else -+ if stalled f2 then -1 else -+ compare f2.file_download_rate f1.file_download_rate) -+ | ByName -> (fun f1 f2 -> String.compare -+ (String.lowercase f1.file_name) -+ (String.lowercase f2.file_name)) -+ | ByDone -> (fun f1 f2 -> -+ compare f2.file_downloaded f1.file_downloaded) -+ | ByPriority -> (fun f1 f2 -> -+ compare f2.file_priority f1.file_priority) -+ | BySources -> (fun f1 f2 -> compare -+ (number_of_sources f2) (number_of_sources f1)) -+ | ByASources -> (fun f1 f2 -> -+ compare (number_of_active_sources f2) -+ (number_of_active_sources f1)) -+ | ByPercent -> (fun f1 f2 -> compare (percent f2) (percent f1)) -+ | ByETA -> (fun f1 f2 -> compare (calc_file_eta f1) (calc_file_eta f2)) -+ | ByAge -> (fun f1 f2 -> compare f2.file_age f1.file_age) -+ | ByLast -> (fun f1 f2 -> compare f2.file_last_seen f1.file_last_seen) -+ | ByNet -> (fun f1 f2 -> compare (net_name f1) (net_name f2)) -+ | ByAvail -> (fun f1 f2 -> compare -+ (get_file_availability f2) (get_file_availability f1)) -+ | ByComments -> (fun f1 f2 -> compare -+ (number_of_comments f2) (number_of_comments f1)) -+ | ByUser -> (fun f1 f2 -> compare f1.file_user f2.file_user) -+ | ByGroup -> (fun f1 f2 -> compare f1.file_group f2.file_group) - | NotSorted -> raise Not_found - in -- Sort.list sorter list -+ List.sort sorter list - with _ -> list - in - simple_print_file_list false buf list o -@@ -1191,6 +1197,7 @@ - let counter = ref 0 in - if use_html_mods o then - begin -+ html_mods_cntr_init (); - if !!html_mods_use_js_tooltips then Printf.bprintf buf "\\<div id=\\\"object1\\\" style=\\\"position:absolute; background-color:#FFFFDD;color:black;border-color:black;border-width:20px;font-size:8pt; visibility:visible; left:25px; top:-100px; z-index:+1\\\" onmouseover=\\\"overdiv=1;\\\" onmouseout=\\\"overdiv=0; setTimeout(\\\'hideLayer()\\\',1000)\\\"\\>\\ \\</div\\>\n"; - html_mods_table_header_colspan buf "resultsTable" "results" [ - ( "1", "0", "srh", "Network", "Network" ) ; -@@ -1211,10 +1218,7 @@ - if !counter >= !!max_displayed_results then raise Exit; - - if use_html_mods o then -- begin -- if (!counter mod 2 == 0) then Printf.bprintf buf "\\<tr class=\\\"dl-1\\\"\\>" -- else Printf.bprintf buf "\\<tr class=\\\"dl-2\\\"\\>"; -- end; -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); - - user.ui_last_results <- (!counter, rs) :: user.ui_last_results; - let network_name = -@@ -1259,7 +1263,7 @@ - let nl = ref false in - List.iter (fun t -> - match t.tag_name with -- | Field_UNKNOWN "FTH" | Field_UNKNOWN "urn" -> () -+ | Field_KNOWN "FTH" | Field_KNOWN "urn" -> () - | _ -> - Buffer.add_string buf ((if !nl then "<br>" else begin nl := true;"" end) ^ - escaped_string_of_field t ^ ": " ^ get_tag_value t); -@@ -1275,7 +1279,7 @@ - let nl = ref false in - List.iter (fun t -> - match t.tag_name with -- | Field_UNKNOWN "FTH" | Field_UNKNOWN "urn" -> () -+ | Field_KNOWN "FTH" | Field_KNOWN "urn" -> () - | _ -> - Buffer.add_string buf ((if !nl then "\n" else begin nl := true;"" end) ^ - "|| (" ^ -@@ -1331,8 +1335,8 @@ - let cformat = ref "" in - List.iter (fun t -> - (match t.tag_name with -- | Field_UNKNOWN "urn" -- | Field_UNKNOWN "FTH" -> hash := get_tag_value t -+ | Field_KNOWN "urn" -+ | Field_KNOWN "FTH" -> hash := get_tag_value t - | Field_Availability -> cavail := get_tag_value t - | Field_Completesources -> csource := get_tag_value t - | Field_Length -> clength := get_tag_value t -@@ -1383,9 +1387,9 @@ - | Field_Format - | Field_Bitrate - (* TODO : "urn" shouldn't be some kind of Field_Uid of Gnutella ? *) -- | Field_UNKNOWN "urn" -+ | Field_KNOWN "urn" - (* TODO : "FTH" shouldn't be some kind of Field_Uid of Fasttrack ? *) -- | Field_UNKNOWN "FTH" -> () -+ | Field_KNOWN "FTH" -> () - | _ -> - Buffer.add_string buf ("\\<span title=\\\"" ^ - get_tag_value t ^ "\\\"\\>(" ^ -@@ -1490,9 +1494,9 @@ - user.ui_last_results <- (!counter, rs) :: user.ui_last_results; - files := [| - -+ (Printf.sprintf "[%5d]\\<input name=d type=checkbox value=%d\\>" !counter r.result_num); - (Int64.to_string r.result_size); - (string_of_int avail); -- (Printf.sprintf "[%5d]\\<input name=d type=checkbox value=%d\\>" !counter r.result_num); - - ( - let names = r.result_names in -@@ -1704,8 +1708,8 @@ - Intmap.iter (fun r_num (avail,rs) -> - let r = IndexedResults.get_result rs in - results := (rs, r, !avail) :: !results) s.search_results; -- let results = Sort.list (fun (_, r1,_) (_, r2,_) -> -- r1.result_size > r2.result_size -+ let results = List.sort (fun (_, r1,_) (_, r2,_) -> -+ compare r2.result_size r1.result_size - ) !results in - - Printf.bprintf buf "Result of search %d\n" s.search_num; -@@ -1877,7 +1881,7 @@ - ); - tack list - ( -- "Build on:\t", -+ "Built on:\t", - Autoconf.build_system ^ " (" ^ Unix2.endianness () ^ ")" ^ - (if Autoconf.glibc_version = "" then "" - else -@@ -1941,12 +1945,11 @@ - ( "0", "srh", "", "" ) ] - else - Printf.bprintf buf "\n\t--Buildinfo--\n"; -- let counter = ref 0 in -+ html_mods_cntr_init (); - List.iter (fun (desc, text) -> -- incr counter; - if html then -- Printf.bprintf buf "\\<tr class=\\\"%s\\\"\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\</tr\\>" -- (if !counter mod 2 = 0 then "dl-1" else "dl-2") desc text -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\</tr\\>" -+ (html_mods_cntr ()) desc text - else - Printf.bprintf buf "%s %s\n" desc text; - ) list; -@@ -2036,10 +2039,11 @@ - tack list - ( - "", -- Printf.sprintf "\t\t max_string_length: %d - word_size: %d - max_array_length: %d" -+ Printf.sprintf "\t\t max_string_length: %d - word_size: %d - max_array_length: %d - max_int: %d" - Sys.max_string_length - Sys.word_size - Sys.max_array_length -+ Pervasives.max_int - ); - tack list - ( -@@ -2060,12 +2064,11 @@ - ( "0", "srh", "", "" ) ] - else - Printf.bprintf buf "\n\t--Runinfo--\n"; -- let counter = ref 0 in -+ html_mods_cntr_init (); - List.iter (fun (desc, text) -> -- incr counter; - if html then -- Printf.bprintf buf "\\<tr class=\\\"%s\\\"\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\</tr\\>" -- (if !counter mod 2 = 0 then "dl-1" else "dl-2") desc text -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\</tr\\>" -+ (html_mods_cntr ()) desc text - else - Printf.bprintf buf "%s %s\n" desc text; - ) list; -@@ -2136,7 +2139,7 @@ - let fill_dir_line = String.make (!len_dir - 9) '-' in - let fill_strategy = String.make (!len_strategy - 4) ' ' in - let fill_strategy_line = String.make (!len_strategy - 4) '-' in -- let counter = ref 0 in -+ html_mods_cntr_init (); - if html then - html_mods_table_header buf "sharesTable" "shares" [ - ( "0", "srh", "Directory", "Directory" ) ; -@@ -2154,7 +2157,6 @@ - fill_dir_line fill_strategy_line; - end; - List.iter (fun (dir, strategy) -> -- incr counter; - let diskused = - match Unix32.diskused dir with - | None -> Printf.sprintf "---" -@@ -2172,11 +2174,10 @@ - in - let filesystem = Unix32.filesystem dir in - if html then -- begin -- Printf.bprintf buf "\\<tr class=\\\"%s\\\"\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\<td class=\\\"sr ar\\\"\\>%s\\</td\\>\\<td class=\\\"sr ar\\\"\\>%s\\</td\\>\\<td class=\\\"sr ar\\\"\\>%s\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\</tr\\>" -- (if !counter mod 2 = 0 then "dl-1" else "dl-2") -- dir strategy diskused diskfree percentfree filesystem -- end -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\> -+ \\<td class=\\\"sr ar\\\"\\>%s\\</td\\>\\<td class=\\\"sr ar\\\"\\>%s\\</td\\> -+ \\<td class=\\\"sr ar\\\"\\>%s\\</td\\>\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\</tr\\>" -+ (html_mods_cntr ()) dir strategy diskused diskfree percentfree filesystem - else - Printf.bprintf buf "%-*s|%-*s|%8s|%8s|%5s|%-s\n" - (max !len_dir (!len_dir - String.length dir)) dir -@@ -2448,7 +2449,9 @@ - ( "0", "srh", "Preview", "P" ) ; - ( "0", "srh", "Filename", "Filename" ); - ( "0", "srh", "Statistic links", "Stats" ); -- ( "0", "srh", "Published on servers", "Publ" ) ] -+ ( "0", "srh", "Published on servers", "Publ" ); -+ ( "0", "srh", "Share status", "Status" ) -+ ] - else - begin - Printf.bprintf buf " Requests | Bytes | Uploaded | File\n"; -@@ -2456,10 +2459,10 @@ - end; - - html_mods_cntr_init (); -- let list = Sort.list (fun f1 f2 -> -- (f1.impl_shared_requests = f2.impl_shared_requests && -- f1.impl_shared_uploaded > f2.impl_shared_uploaded) || -- (f1.impl_shared_requests > f2.impl_shared_requests ) -+ let list = List.sort (fun f1 f2 -> -+ let c = compare f2.impl_shared_requests f1.impl_shared_requests in -+ if c <> 0 then c else -+ compare f2.impl_shared_uploaded f1.impl_shared_uploaded - ) list in - - List.iter (fun impl -> -@@ -2474,8 +2477,9 @@ - (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))) -- (match impl.impl_shared_magic with -- None -> "" -+ (match impl.impl_shared_file with -+ None -> "no file info" -+ | Some file -> match file_magic file with | None -> "no magic" - | Some magic -> "File type: " ^ (Http_server.html_real_escaped magic) ^ "<br>") - (if impl.impl_shared_servers = [] then "" else - Printf.sprintf "<br>Published on %d %s<br>%s" -@@ -2497,7 +2501,6 @@ - - let uploaded = Int64.to_float impl.impl_shared_uploaded in - let size = Int64.to_float impl.impl_shared_size in -- - html_mods_td buf [ - ("", "sr ar", Printf.sprintf "%d" impl.impl_shared_requests); - ("", "sr ar", size_of_int64 impl.impl_shared_uploaded); -@@ -2515,7 +2518,9 @@ - (Md4.to_string impl.impl_shared_id) "T1" - (Md4.to_string impl.impl_shared_id) "T2" - (Md4.to_string impl.impl_shared_id) "B")); -- ("", "sr ar", Printf.sprintf "%d" published ) ]; -+ ("", "sr ar", Printf.sprintf "%d" published); -+ ("", "sr", shared_state (as_shared impl) o); -+ ]; - Printf.bprintf buf "\\</tr\\>\n"; - end - else -Index: src/daemon/driver/driverInterface.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverInterface.ml,v -retrieving revision 1.61 -retrieving revision 1.63 -diff -u -r1.61 -r1.63 ---- src/daemon/driver/driverInterface.ml 26 Nov 2006 13:54:09 -0000 1.61 -+++ src/daemon/driver/driverInterface.ml 25 Jan 2007 13:29:05 -0000 1.63 -@@ -470,15 +470,13 @@ - gui.gui_events.gui_new_events <- ev :: gui.gui_events.gui_new_events - ) console_messages; - -- if user2_is_admin gui.gui_conn.conn_user.ui_user then - gui_send gui ( -- P.Options_info (simple_options "" downloads_ini)); -+ P.Options_info (simple_options "" downloads_ini (user2_is_admin gui.gui_conn.conn_user.ui_user))); - -- if user2_is_admin gui.gui_conn.conn_user.ui_user then - networks_iter_all (fun r -> - List.iter (fun opfile -> - let prefix = r.network_shortname ^ "-" in -- let args = simple_options prefix opfile in -+ let args = simple_options prefix opfile (user2_is_admin gui.gui_conn.conn_user.ui_user) in - gui_send gui (P.Options_info args)) r.network_config_file); - - (* Options panels defined in downloads.ini *) -@@ -1091,8 +1089,18 @@ - let s = server_find num in - server_rename s name - | P.ServerSetPreferred (num, preferred) -> -- let s = server_find num in -- server_set_preferred s preferred -+ if user2_is_admin gui.gui_conn.conn_user.ui_user then -+ server_set_preferred (server_find num) preferred -+ else -+ begin -+ let o = gui.gui_conn in -+ let buf = o.conn_buf in -+ Buffer.reset buf; -+ Buffer.add_string buf "\nYou are not allowed to change preferred status\n"; -+ gui_send gui (P.Console ( -+ DriverControlers.dollar_escape o false -+ (Buffer.contents buf))) -+ end - - with - Failure s -> -Index: src/daemon/driver/driverMain.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverMain.ml,v -retrieving revision 1.133 -retrieving revision 1.135 -diff -u -r1.133 -r1.135 ---- src/daemon/driver/driverMain.ml 28 Nov 2006 23:15:21 -0000 1.133 -+++ src/daemon/driver/driverMain.ml 17 Jan 2007 18:53:28 -0000 1.135 -@@ -54,7 +54,6 @@ - - let minute_timer () = - DriverInteractive.hdd_check (); -- CommonShared.shared_check_files (); - CommonUploads.upload_credit_timer (); - CommonInteractive.force_download_quotas (); - CommonResult.dummy_result.result_time <- last_time (); -@@ -306,6 +305,23 @@ - "-pid", Arg.String (fun s -> pid := s; - ), - _s ": directory for pid file"; -+ "-useradd", Arg.Rest (fun s -> -+ (match String2.split s ' ' with -+ | user :: pass :: _ -> -+ if user2_user_exists user then -+ begin -+ user2_user_set_password (user2_user_find user) pass; -+ Printf.printf "%sPassword of user %s changed\n%!" (log_time ()) user -+ end -+ else -+ begin -+ user2_user_add user (Md4.Md4.string pass) (); -+ Printf.printf "%sUser %s added\n%!" (log_time ()) user -+ end; -+ Options.save_with_help_private users_ini; -+ Printf.printf "%sSaved changes to users.ini\n%!" (log_time ()) -+ | _ -> raise (Arg.Bad "invalid syntax")); -+ exit 0), _s "\"<user> <pass>\" : create user/change password"; - ] @ - !more_args - @ -@@ -446,6 +462,10 @@ - add_infinite_timer 0.1 CommonUploads.upload_download_timer; - add_infinite_timer !!buffer_writes_delay (fun _ -> Unix32.flush ()); - -+ add_infinite_timer ((float_of_int !!share_scan_interval) *. 60.) -+ (fun _ -> CommonShared.shared_check_files ()); -+ CommonShared.shared_check_files (); -+ - history_timeflag := (Unix.time()); - update_download_history (); - update_upload_history (); -Index: src/gtk/gui/gui_friends.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/gtk/gui/gui_friends.ml,v -retrieving revision 1.7 -retrieving revision 1.8 -diff -u -r1.7 -r1.8 ---- src/gtk/gui/gui_friends.ml 28 Nov 2006 12:58:10 -0000 1.7 -+++ src/gtk/gui/gui_friends.ml 8 Jan 2007 14:07:55 -0000 1.8 -@@ -61,10 +61,7 @@ - | BlackListedHost -> gettext M.black_listed, Some !!O.color_not_connected - - let string_color_of_client friend_tab c = -- match c.client_files with -- Some _ when friend_tab -> -- gettext M.o_col_files_listed, Some !!O.color_downloading -- | _ -> string_color_of_state c.client_state -+ string_color_of_state c.client_state - - let shorten maxlen s = - let len = String.length s in -@@ -256,14 +253,7 @@ - Gui_com.send (GuiProto.FindFriend s) - - method on_select c = -- match c.client_files with -- None -> --(* lprintf "No file for friend %d" c.client_num; lprint_newline (); *) - Gui_com.send (GuiProto.GetClient_files c.client_num) -- | Some tree -> --(* lprintf "%d files for friend %d" (List.length l) c.client_num; -- lprint_newline (); *) -- box_files#update_tree (Some tree) - - method on_deselect f = - box_files#update_tree None -@@ -284,8 +274,6 @@ - method h_update_friend f_new = - try - let (row, f) = self#find_client f_new.client_num in -- if f_new.client_files <> None then -- f.client_files <- f_new.client_files; - f.client_state <- f_new.client_state; - f.client_type <- f_new.client_type; - f.client_rating <- f_new.client_rating; -@@ -426,8 +414,6 @@ - self#remove_item row c - end else - let _ = () in -- if c_new.client_files <> None then -- c.client_files <- c_new.client_files; - c.client_state <- c_new.client_state; - c.client_rating <- c_new.client_rating; - c.client_name <- c_new.client_name; -Index: src/gtk/gui/gui_main.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/gtk/gui/gui_main.ml,v -retrieving revision 1.14 -retrieving revision 1.15 -diff -u -r1.14 -r1.15 ---- src/gtk/gui/gui_main.ml 27 Jun 2006 10:38:35 -0000 1.14 -+++ src/gtk/gui/gui_main.ml 8 Jan 2007 14:07:55 -0000 1.15 -@@ -127,7 +127,6 @@ - if is_in_locations then - gui#tab_downloads#h_update_location c; - -- if c.client_files <> None then cc.client_files <- c.client_files; - cc.client_state <- c.client_state; - - if c.client_state = RemovedHost then begin -@@ -420,13 +419,11 @@ - try - let c = Hashtbl.find G.locations num in - try -- let tree = match c.client_files with -- None -> { file_tree_list = []; file_tree_name = "" } -- | Some tree -> { tree with file_tree_list = tree.file_tree_list } -- in -- -+ let tree = { file_tree_list = []; file_tree_name = "" } in - add_file tree dirname file; -+(* - ignore (canon_client gui { c with client_files = Some tree }) -+*) - - with _ -> - (* lprintf "File already there"; lprint_newline (); *) -@@ -519,6 +516,7 @@ - - | Search s -> () - | Version _ -> () -+ | Stats (_, _) -> () - - with e -> - lprintf "Exception %s in reader\n" (Printexc2.to_string e) -Index: src/gtk/newgui/gui_downloads.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/gtk/newgui/gui_downloads.ml,v -retrieving revision 1.18 -retrieving revision 1.19 -diff -u -r1.18 -r1.19 ---- src/gtk/newgui/gui_downloads.ml 28 Nov 2006 12:58:11 -0000 1.18 -+++ src/gtk/newgui/gui_downloads.ml 2 Dec 2006 12:35:46 -0000 1.19 -@@ -1389,8 +1389,8 @@ - else (c.client_software ^ - " - " ^ - c.client_emulemod))]; -- child.data.gfile_size <- c.client_uploaded; -- child.data.gfile_downloaded <- c.client_downloaded; -+ child.data.gfile_size <- c.client_total_uploaded; -+ child.data.gfile_downloaded <- c.client_total_downloaded; - child.data.gfile_state <- client_to_general_state c.client_state (List.hd f.data.gfile_num); - child.data.gfile_chunks <- f.data.gfile_chunks; - child.data.gfile_name <- -@@ -1412,8 +1412,8 @@ - " - " ^ - c.client_emulemod]; - f.data.gfile_state <- client_to_general_state c.client_state file_num; -- f.data.gfile_size <- c.client_uploaded; -- f.data.gfile_downloaded <- c.client_downloaded; -+ f.data.gfile_size <- c.client_total_uploaded; -+ f.data.gfile_downloaded <- c.client_total_downloaded; - if f.data.gfile_type <> c.client_type then - begin - f.data.gfile_type <- c.client_type; -Index: src/gtk/newgui/gui_friends.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/gtk/newgui/gui_friends.ml,v -retrieving revision 1.20 -retrieving revision 1.22 -diff -u -r1.20 -r1.22 ---- src/gtk/newgui/gui_friends.ml 28 Nov 2006 12:58:11 -0000 1.20 -+++ src/gtk/newgui/gui_friends.ml 8 Jan 2007 14:07:55 -0000 1.22 -@@ -89,9 +89,7 @@ - | BlackListedHost -> O.gdk_pix M.o_xpm_blacklistedhost - - let client_pix c = -- match c.client_files with -- Some l -> O.gdk_pix M.o_xpm_files_listed -- | _ -> state_pix c.client_state -+ state_pix c.client_state - - - let type_pix t = -@@ -427,7 +425,6 @@ - client_type = c.gclient_type; - client_tags = c.gclient_tags; - client_name = c.gclient_name; -- client_files = c.gclient_files; - client_rating = c.gclient_rating; - client_chat_port = 0; - client_connect_time = c.gclient_connect_time; -@@ -435,10 +432,13 @@ - client_os = None; - client_release = c.gclient_release; - client_emulemod = c.gclient_emulemod; -- client_downloaded = c.gclient_downloaded; -- client_uploaded = c.gclient_uploaded; -+ client_total_downloaded = c.gclient_downloaded; -+ client_total_uploaded = c.gclient_uploaded; -+ client_session_downloaded = 0L; -+ client_session_uploaded = 0L; - client_upload = c.gclient_upload; - client_sui_verified = None; -+ client_file_queue = []; - (* client_sock_addr = c.gclient_sock_addr;*) - } - -@@ -451,14 +451,14 @@ - gclient_type = c.client_type; - gclient_tags = c.client_tags; - gclient_name = c.client_name; -- gclient_files = c.client_files; -+ gclient_files = None; - gclient_rating = c.client_rating; - gclient_connect_time = (BasicSocket.last_time () - c.client_connect_time); - gclient_software = c.client_software; - gclient_release = c.client_release; - gclient_emulemod = c.client_emulemod; -- gclient_downloaded = c.client_downloaded; -- gclient_uploaded = c.client_uploaded; -+ gclient_downloaded = c.client_total_downloaded; -+ gclient_uploaded = c.client_total_uploaded; - gclient_upload = c.client_upload; - gclient_sock_addr = string_of_kind c.client_kind; - gclient_net_pixmap = -@@ -494,8 +494,8 @@ - f.gclient_software <- f_new.client_software; - f.gclient_release <- f_new.client_release; - f.gclient_emulemod <- f_new.client_emulemod; -- f.gclient_downloaded <- f_new.client_downloaded; -- f.gclient_uploaded <- f_new.client_uploaded; -+ f.gclient_downloaded <- f_new.client_total_downloaded; -+ f.gclient_uploaded <- f_new.client_total_uploaded; - f.gclient_upload <- f_new.client_upload; - f.gclient_sock_addr <- string_of_kind f_new.client_kind; - if box_friends_is_visible then self#update_row f row -@@ -635,7 +635,6 @@ - client_type = c.gclient_type; - client_tags = c.gclient_tags; - client_name = c.gclient_name; -- client_files = c.gclient_files; - client_rating = c.gclient_rating; - client_chat_port = 0; - client_connect_time = c.gclient_connect_time; -@@ -643,10 +642,13 @@ - client_os = None; - client_release = c.gclient_release; - client_emulemod = c.gclient_emulemod; -- client_downloaded = c.gclient_downloaded; -- client_uploaded = c.gclient_uploaded; -+ client_total_downloaded = c.gclient_downloaded; -+ client_total_uploaded = c.gclient_uploaded; -+ client_session_downloaded = 0L; -+ client_session_uploaded = 0L; - client_upload = c.gclient_upload; - client_sui_verified = None; -+ client_file_queue = []; - (* client_sock_addr = string_of_kind c.gclient_kind; *) - } - -@@ -659,14 +661,14 @@ - gclient_type = c.client_type; - gclient_tags = c.client_tags; - gclient_name = c.client_name; -- gclient_files = c.client_files; -+ gclient_files = None; - gclient_rating = c.client_rating; - gclient_connect_time = (BasicSocket.last_time () - c.client_connect_time); - gclient_software = c.client_software; - gclient_release = c.client_release; - gclient_emulemod = c.client_emulemod; -- gclient_downloaded = c.client_downloaded; -- gclient_uploaded = c.client_uploaded; -+ gclient_downloaded = c.client_total_downloaded; -+ gclient_uploaded = c.client_total_uploaded; - gclient_upload = c.client_upload; - gclient_sock_addr = string_of_kind c.client_kind; - gclient_net_pixmap = -@@ -711,9 +713,9 @@ - c.gclient_kind <- c_new.client_kind; - c.gclient_tags <- c_new.client_tags; - c.gclient_software <- c_new.client_software; -- c.gclient_downloaded <- c_new.client_downloaded; -+ c.gclient_downloaded <- c_new.client_total_downloaded; - c.gclient_emulemod <- c_new.client_emulemod; -- c.gclient_uploaded <- c_new.client_uploaded; -+ c.gclient_uploaded <- c_new.client_total_uploaded; - c.gclient_upload <- c_new.client_upload; - c.gclient_sock_addr <- string_of_kind c_new.client_kind; - (if icons_are_used && (c.gclient_type <> c_new.client_type) -Index: src/gtk/newgui/gui_results.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/gtk/newgui/gui_results.ml,v -retrieving revision 1.10 -retrieving revision 1.11 -diff -u -r1.10 -r1.11 ---- src/gtk/newgui/gui_results.ml 20 Jul 2006 16:56:42 -0000 1.10 -+++ src/gtk/newgui/gui_results.ml 3 Dec 2006 20:49:42 -0000 1.11 -@@ -289,7 +289,7 @@ - let value = ref "" in - List.iter (fun t -> - match t.tag_name with -- Field_UNKNOWN "codec" -> value := string_of_tag_value t.tag_value -+ Field_KNOWN "codec" -> value := string_of_tag_value t.tag_value - | _ -> () - ) tags; - !value -@@ -298,7 +298,7 @@ - let value = ref 0 in - List.iter (fun t -> - match t.tag_name with -- Field_UNKNOWN "bitrate" -> value := int_of_tag_value t.tag_value -+ Field_KNOWN "bitrate" -> value := int_of_tag_value t.tag_value - | _ -> () - ) tags; - !value -Index: src/gtk2/gui/guiMain.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/gtk2/gui/guiMain.ml,v -retrieving revision 1.9 -retrieving revision 1.10 -diff -u -r1.9 -r1.10 ---- src/gtk2/gui/guiMain.ml 29 Jun 2006 15:56:44 -0000 1.9 -+++ src/gtk2/gui/guiMain.ml 8 Jan 2007 14:07:55 -0000 1.10 -@@ -456,6 +456,7 @@ - | GiftServerStats _ -> assert false - | Search s -> () - | Version v -> () -+ | Stats (_, _) -> () - - with e -> - Printf2.lprintf "Exception %s in reader\n" (Printexc2.to_string e) -Index: src/gtk2/gui/guiMisc.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/gtk2/gui/guiMisc.ml,v -retrieving revision 1.20 -retrieving revision 1.24 -diff -u -r1.20 -r1.24 ---- src/gtk2/gui/guiMisc.ml 28 Nov 2006 12:58:11 -0000 1.20 -+++ src/gtk2/gui/guiMisc.ml 8 Jan 2007 14:07:55 -0000 1.24 -@@ -1050,11 +1050,13 @@ - | Field_Completesources -> "completesources" - | Field_Filename -> "filename" - | Field_Size -> "size" -+ | Field_Size_Hi -> "size_hi" - | Field_Uid -> "uid" - | Field_Medialength -> "length" - | Field_Mediacodec -> "codec" - | Field_Lastseencomplete -> "lastseencompl" - | Field_Filerating -> "rating" -+ | Field_KNOWN s -> U.simple_utf8_of s - | Field_UNKNOWN s -> U.simple_utf8_of s - - let tags_to_string tags = -@@ -1276,8 +1278,8 @@ - source_connect_time = BasicSocket.last_time () - c.client_connect_time; - source_last_seen = BasicSocket.current_time (); - source_software = concat_strings c.client_software (concat_strings c.client_emulemod c.client_release); -- source_downloaded = c.client_downloaded; -- source_uploaded = c.client_uploaded; -+ source_downloaded = c.client_total_downloaded; -+ source_uploaded = c.client_total_uploaded; - source_upload_rate = 0.; - source_download_rate = 0.; - source_upload = c.client_upload; -Index: src/networks/bittorrent/bTClients.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTClients.ml,v -retrieving revision 1.84 -retrieving revision 1.85 -diff -u -r1.84 -r1.85 ---- src/networks/bittorrent/bTClients.ml 5 Nov 2006 14:09:38 -0000 1.84 -+++ src/networks/bittorrent/bTClients.ml 2 Dec 2006 12:35:46 -0000 1.85 -@@ -272,6 +272,8 @@ - try - (* List.iter (fun r -> CommonSwarming.free_range r) c.client_ranges; *) - set_client_disconnected c reason; -+ c.client_session_downloaded <- 0L; -+ c.client_session_uploaded <- 0L; - (try if c.client_good then count_seen c with _ -> ()); - (* this is not useful already done in the match - (try close sock reason with _ -> ()); *) -Index: src/networks/bittorrent/bTGlobals.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTGlobals.ml,v -retrieving revision 1.72 -retrieving revision 1.74 -diff -u -r1.72 -r1.74 ---- src/networks/bittorrent/bTGlobals.ml 26 Nov 2006 13:19:31 -0000 1.72 -+++ src/networks/bittorrent/bTGlobals.ml 3 Dec 2006 20:57:56 -0000 1.74 -@@ -124,7 +124,7 @@ - impl_shared_ops = shared_ops; - impl_shared_val = file; - impl_shared_requests = 0; -- impl_shared_magic = None; -+ impl_shared_file = Some (as_file file); - impl_shared_servers = []; - } in - file.file_shared <- Some impl; -@@ -786,8 +786,10 @@ - client_release = release; - client_bitmap = None; - client_allowed_to_write = zero; -- client_uploaded = zero; -- client_downloaded = zero; -+ client_total_uploaded = zero; -+ client_total_downloaded = zero; -+ client_session_uploaded = zero; -+ client_session_downloaded = zero; - client_upload_rate = Rate.new_rate (); - client_downloaded_rate = Rate.new_rate (); - client_connect_time = last_time (); -Index: src/networks/bittorrent/bTInteractive.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTInteractive.ml,v -retrieving revision 1.123 -retrieving revision 1.127 -diff -u -r1.123 -r1.127 ---- src/networks/bittorrent/bTInteractive.ml 12 Nov 2006 14:17:45 -0000 1.123 -+++ src/networks/bittorrent/bTInteractive.ml 4 Feb 2007 17:22:18 -0000 1.127 -@@ -171,18 +171,21 @@ - Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); - let tracker_header_printed = ref false in - List.iter (fun tracker -> -- let tracker_text, tracker_error = -- (match tracker.tracker_status with -- Disabled s | Disabled_mld s | Disabled_failure s -> -- Printf.sprintf "disabled: %s" tracker.tracker_url, s -- | _ -> tracker.tracker_url, "") -+ let tracker_text = -+ match tracker.tracker_status with -+ | Disabled s | Disabled_mld s | Disabled_failure s -> -+ Printf.sprintf "\\<font color=\\\"red\\\"\\>disabled: %s\\<br\\>\\--error: %s\\</font\\>" tracker.tracker_url s -+ | _ -> -+ Printf.sprintf "enabled: %s" tracker.tracker_url -+ - in - html_mods_td buf [ - (if not !tracker_header_printed then -- ("Tracker(s) (mouseover for errors)", "sr br", "Tracker(s)") -+ ("Tracker(s)", "sr br", "Tracker(s)") - else -- ("", "sr br", "")); -- (tracker_error, "sr", tracker_text)]; -+ ("", "sr br", "") -+ ); -+ (tracker.tracker_url, "sr", tracker_text)]; - Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); - tracker_header_printed := true; - ) file.file_trackers; -@@ -406,8 +409,10 @@ - ( "0", "srh", "IP address", "IP address" ) ; - ( "0", "srh br ar", "Port", "Port" ) ; - ] @ (if !Geoip.active then [( "0", "srh br ar", "Country Code/Name", "CC" )] else []) @ [ -- ( "1", "srh ar", "Total UL bytes to this client for all files", "UL" ) ; -- ( "1", "srh ar br", "Total DL bytes from this client for all files", "DL" ) ; -+ ( "1", "srh ar", "Total UL bytes to this client for all files", "tUL" ) ; -+ ( "1", "srh ar br", "Total DL bytes from this client for all files", "tDL" ) ; -+ ( "1", "srh ar", "Session UL bytes to this client for all files", "sUL" ) ; -+ ( "1", "srh ar br", "Session DL bytes from this client for all files", "sDL" ) ; - ( "0", "srh ar", "Interested [T]rue, [F]alse", "I" ) ; - ( "0", "srh ar", "Choked [T]rue, [F]alse", "C" ) ; - ( "1", "srh br ar", "Allowed to write", "A" ) ; -@@ -458,8 +463,10 @@ - ("", "sr", (Ip.to_string (fst c.client_host))); - ("", "sr br ar", Printf.sprintf "%d" (snd c.client_host)); - ] @ (if !Geoip.active then [( cn, "sr br", cc)] else []) @ [ -- ("", "sr ar", (size_of_int64 c.client_uploaded)); -- ("", "sr ar br", (size_of_int64 c.client_downloaded)); -+ ("", "sr ar", (size_of_int64 c.client_total_uploaded)); -+ ("", "sr ar br", (size_of_int64 c.client_total_downloaded)); -+ ("", "sr ar", (size_of_int64 c.client_session_uploaded)); -+ ("", "sr ar br", (size_of_int64 c.client_session_downloaded)); - ("", "sr", (btos c.client_interested)); - ("", "sr", (btos c.client_choked)); - ("", "sr br ar", (Int64.to_string c.client_allowed_to_write)); -@@ -880,8 +887,10 @@ - P.client_name = (Printf.sprintf "%s:%d" (Ip.to_string ip) port); - P.client_software = (brand_to_string c.client_brand); - P.client_release = c.client_release; -- P.client_downloaded = c.client_downloaded; -- P.client_uploaded = c.client_uploaded; -+ P.client_total_downloaded = c.client_total_downloaded; -+ P.client_total_uploaded = c.client_total_uploaded; -+ P.client_session_downloaded = c.client_session_downloaded; -+ P.client_session_uploaded = c.client_session_uploaded; - P.client_upload = Some (c.client_file.file_name); - P.client_connect_time = c.client_connect_time; - -@@ -906,11 +915,11 @@ - let cc = as_client c in - client_print cc o; - Printf.bprintf buf (_b "\n%18sDown : %-10s Uploaded: %-10s Ratio: %s%1.1f (%s)\n") "" -- (Int64.to_string c.client_downloaded) -- (Int64.to_string c.client_uploaded) -- (if c.client_downloaded > c.client_uploaded then "-" else "+") -- (if c.client_uploaded > Int64.zero then -- Int64.to_float (c.client_downloaded // c.client_uploaded) -+ (Int64.to_string c.client_total_downloaded) -+ (Int64.to_string c.client_total_uploaded) -+ (if c.client_total_downloaded > c.client_total_uploaded then "-" else "+") -+ (if c.client_total_uploaded > Int64.zero then -+ Int64.to_float (c.client_total_downloaded // c.client_total_uploaded) - else 1.) - ("BT"); - (Printf.bprintf buf (_b "%18sFile : %s\n") "" info.GuiTypes.file_name) -@@ -948,8 +957,10 @@ - ("", "sr", "N"); - ("", "sr", (Ip.to_string (fst c.client_host))); - ] @ (if !Geoip.active then [(cn, "sr", cc)] else []) @ [ -- ("", "sr ar", (size_of_int64 c.client_uploaded)); -- ("", "sr ar", (size_of_int64 c.client_downloaded)); -+ ("", "sr ar", (size_of_int64 c.client_total_uploaded)); -+ ("", "sr ar", (size_of_int64 c.client_total_downloaded)); -+ ("", "sr ar", (size_of_int64 c.client_session_uploaded)); -+ ("", "sr ar", (size_of_int64 c.client_session_downloaded)); - ("", "sr", info.GuiTypes.file_name); ]); - true - -@@ -1047,7 +1058,7 @@ - ) !current_files; - _s "done" - end else -- begin print_command_result o o.conn_buf "You are not allowed to use seeded_torrents"; -+ begin print_command_result o "You are not allowed to use seeded_torrents"; - "" end - ), _s ":\t\t\tprint all seeded .torrent files on this server"; - -@@ -1263,6 +1274,9 @@ - - CommonNetwork.register_commands commands; - -+ shared_ops.op_shared_state <- (fun file o -> -+ "no BT data" -+ ); - shared_ops.op_shared_unshare <- (fun file -> - (if !verbose_share then lprintf_file_nl (as_file file) "unshare file"); - BTGlobals.unshare_file file); -Index: src/networks/bittorrent/bTOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTOptions.ml,v -retrieving revision 1.30 -retrieving revision 1.31 -diff -u -r1.30 -r1.31 ---- src/networks/bittorrent/bTOptions.ml 21 Aug 2006 18:30:15 -0000 1.30 -+++ src/networks/bittorrent/bTOptions.ml 15 Jan 2007 18:26:27 -0000 1.31 -@@ -26,6 +26,7 @@ - let bittorrent_section = file_section bittorrent_ini ["Bittorrent"] "Bittorrent options" - - let client_port = define_option bittorrent_section ["client_port"] -+ ~restart: true - "The port to bind the client to" - int_option 6882 - -@@ -99,6 +100,7 @@ - int_option (-1) - - let import_new_torrents_interval = define_option bittorrent_section ["import_new_torrents_interval"] -+ ~restart: true - "Interval in seconds 'torrents/incoming' is scanned for new torrent files to be downloaded, - 0 to deactivate, changes require restart" - float_option 60. -@@ -130,6 +132,7 @@ - string_option "default" - - let options_version = define_option bittorrent_section ["options_version"] -+ ~internal: true - "(internal option)" - int_option 0 - -Index: src/networks/bittorrent/bTStats.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTStats.ml,v -retrieving revision 1.8 -retrieving revision 1.9 -diff -u -r1.8 -r1.9 ---- src/networks/bittorrent/bTStats.ml 23 Sep 2006 20:29:47 -0000 1.8 -+++ src/networks/bittorrent/bTStats.ml 2 Dec 2006 12:35:46 -0000 1.9 -@@ -57,7 +57,8 @@ - stats_array.(i).brand_download <- stats_array.(i).brand_download ++ v; - !!gstats_array.(i).brand_download <- !!gstats_array.(i).brand_download ++ v; - -- c.client_downloaded <- c.client_downloaded ++ v; -+ c.client_total_downloaded <- c.client_total_downloaded ++ v; -+ c.client_session_downloaded <- c.client_session_downloaded ++ v; - bt_download_counter := !bt_download_counter ++ v; - global_count_download network v - -@@ -66,7 +67,8 @@ - stats_array.(i).brand_upload <- stats_array.(i).brand_upload ++ v; - !!gstats_array.(i).brand_upload <- !!gstats_array.(i).brand_upload ++ v; - -- c.client_uploaded <- c.client_uploaded ++ v; -+ c.client_total_uploaded <- c.client_total_uploaded ++ v; -+ c.client_session_uploaded <- c.client_session_uploaded ++ v; - bt_upload_counter := !bt_upload_counter ++ v; - global_count_upload network v - -Index: src/networks/bittorrent/bTTracker.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTTracker.ml,v -retrieving revision 1.25 -retrieving revision 1.26 -diff -u -r1.25 -r1.26 ---- src/networks/bittorrent/bTTracker.ml 27 Jul 2006 21:45:05 -0000 1.25 -+++ src/networks/bittorrent/bTTracker.ml 15 Jan 2007 18:26:27 -0000 1.26 -@@ -96,6 +96,7 @@ - let ntracked_files = ref 0 - - let tracker_port = define_option bittorrent_section ["tracker_port"] -+ ~restart: true - "The port to bind the tracker to" - int_option 6881 - -Index: src/networks/bittorrent/bTTypes.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTTypes.ml,v -retrieving revision 1.40 -retrieving revision 1.41 -diff -u -r1.40 -r1.41 ---- src/networks/bittorrent/bTTypes.ml 26 Nov 2006 13:19:31 -0000 1.40 -+++ src/networks/bittorrent/bTTypes.ml 2 Dec 2006 12:35:46 -0000 1.41 -@@ -227,8 +227,10 @@ - mutable client_allowed_to_write : int64; - mutable client_upload_rate : Rate.t; - mutable client_downloaded_rate : Rate.t; -- mutable client_downloaded : int64; -- mutable client_uploaded : int64; -+ mutable client_total_downloaded : int64; -+ mutable client_total_uploaded : int64; -+ mutable client_session_downloaded : int64; -+ mutable client_session_uploaded : int64; - mutable client_connect_time : int; - - mutable client_blocks_sent : int list; -Index: src/networks/direct_connect/dcInteractive.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/direct_connect/dcInteractive.ml,v -retrieving revision 1.28 -retrieving revision 1.29 -diff -u -r1.28 -r1.29 ---- src/networks/direct_connect/dcInteractive.ml 1 Oct 2006 17:54:00 -0000 1.28 -+++ src/networks/direct_connect/dcInteractive.ml 3 Dec 2006 20:49:42 -0000 1.29 -@@ -248,13 +248,13 @@ - P.user_tags = ( - let list = if user.user_data > 1. then - [ -- { tag_name = Field_UNKNOWN "link"; tag_value = String user.user_link }; -- { tag_name = Field_UNKNOWN "shared"; tag_value = String ( -+ { tag_name = Field_KNOWN "link"; tag_value = String user.user_link }; -+ { tag_name = Field_KNOWN "shared"; tag_value = String ( - Printf.sprintf "%12.0f" user.user_data) } - ] else [] - in - if user.user_admin then -- { tag_name = Field_UNKNOWN "admin"; tag_value = String "admin" } :: list -+ { tag_name = Field_KNOWN "admin"; tag_value = String "admin" } :: list - else list - ); - -Index: src/networks/direct_connect/dcOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/direct_connect/dcOptions.ml,v -retrieving revision 1.7 -retrieving revision 1.8 -diff -u -r1.7 -r1.8 ---- src/networks/direct_connect/dcOptions.ml 5 Nov 2005 16:23:40 -0000 1.7 -+++ src/networks/direct_connect/dcOptions.ml 15 Jan 2007 18:26:27 -0000 1.8 -@@ -57,6 +57,7 @@ - - - let dc_port = define_option directconnect_section ["client_port"] -+ ~restart: true - "The port to bind the client to" - int_option 4444 - -@@ -88,6 +89,7 @@ - string_option "Pk=mldc" - - let options_version = define_option directconnect_section ["options_version"] -+ ~internal: true - "(internal option)" - int_option 0 - -Index: src/networks/donkey/donkeyClient.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyClient.ml,v -retrieving revision 1.110 -retrieving revision 1.121 -diff -u -r1.110 -r1.121 ---- src/networks/donkey/donkeyClient.ml 26 Nov 2006 16:36:29 -0000 1.110 -+++ src/networks/donkey/donkeyClient.ml 15 Jan 2007 21:32:56 -0000 1.121 -@@ -68,40 +68,43 @@ - (*************************************************************************) - (* adding a source to the source-management *) - (*************************************************************************) --let add_source file ip port serverIP serverPort = -- (* man, we are receiving sources from some clients even when we release *) -- if (file_state file) = FileDownloading then -- try -- let uid = -- if low_id ip then -- (* indirect address *) -- begin -- try -- (* without server, we can't request a callback *) -- let s = Hashtbl.find servers_by_key serverIP in -- if serverPort = s.server_port then -- Indirect_address ( serverIP, serverPort, id_of_ip ip, 0, Ip.null ) -- else -- raise Not_found -- with _ -> -- raise Not_found -- end -+let add_source file ip tcp_port serverIP serverPort = -+ (* man, we are receiving sources from some clients even when we release *) -+ if (file_state file) = FileDownloading then -+ try -+ let uid = -+ if low_id ip then -+ begin -+ try -+ (* without server, we can't request a callback *) -+ let s = Hashtbl.find servers_by_key serverIP in -+ if serverPort = s.server_port then -+ Indirect_address (serverIP, serverPort, id_of_ip ip, 0, Ip.null) - else -- (* direct adsdess *) -- if Ip.usable ip then -- if not ( is_black_address ip port ) then -- if not ( Hashtbl.mem banned_ips ip) then -- Direct_address ( ip, port ) -- else -- raise Not_found -- else -- raise Not_found -- else -- raise Not_found -- in -- let s = DonkeySources.find_source_by_uid uid in -- DonkeySources.set_request_result s file.file_sources File_new_source; -- with Not_found -> () -+ raise Not_found -+ with Not_found -> -+ if !!update_server_list_client then -+ begin -+ ignore (check_add_server serverIP serverPort); -+ Indirect_address (serverIP, serverPort, id_of_ip ip, 0, Ip.null) -+ end -+ else raise Not_found -+ end -+ else -+ if Ip.usable ip then -+ if not ( is_black_address ip tcp_port ) then -+ if not ( Hashtbl.mem banned_ips ip) then -+ Direct_address ( ip, tcp_port ) -+ else -+ raise Not_found -+ else -+ raise Not_found -+ else -+ raise Not_found -+ in -+ let s = DonkeySources.find_source_by_uid uid in -+ DonkeySources.set_request_result s file.file_sources File_new_source; -+ with Not_found -> () - - let is_banned c sock = - c.client_banned <- Hashtbl.mem banned_ips (fst (peer_addr sock)) -@@ -112,7 +115,7 @@ - match cb with - Brand_lmule | Brand_newemule | Brand_cdonkey | - Brand_emuleplus | Brand_hydranode | Brand_mldonkey3 | -- Brand_shareaza | Brand_amule | Brand_lphant | Brand_verycd -> true -+ Brand_shareaza | Brand_amule | Brand_lphant | Brand_verycd | Brand_imp -> true - | _ -> false - - let ban_client c sock msg = -@@ -245,20 +248,7 @@ - c.client_source.DonkeySources.source_sock <- NoConnection - | Connection sock -> - (try -- let log_print cc = -- lprintf_nl "Client[%d] %s disconnected, connected %s%s%s" -- (client_num cc) -- (full_client_identifier cc) -- (Date.time_to_string (last_time () - cc.client_connect_time) "verbose") -- (if cc.client_uploaded > 0L then -- Printf.sprintf ", send %s" (size_of_int64 cc.client_uploaded) else "") -- (if cc.client_downloaded > 0L then -- Printf.sprintf ", rec %s" (size_of_int64 cc.client_downloaded) else "") -- in -- if c.client_debug || -- (!verbose && (c.client_uploaded > 0L || c.client_downloaded > 0L)) then -- log_print c; -- -+ DonkeyOneFile.remove_client_slot c; - c.client_comp <- None; - (try if c.client_checked then count_seen c with _ -> ()); - (try if !!log_clients_on_console && c.client_name <> "" then -@@ -266,43 +256,34 @@ - c.client_connect_time <- 0; - (try Hashtbl.remove connected_clients c.client_md4 with _ -> ()); - (try CommonUploads.remove_pending_slot (as_client c) with _ -> ()); -- set_client_has_a_slot (as_client c) NoSlot; --(* connection_failed c.client_connection_control; *) - (try TcpBufferedSocket.close sock reason with _ -> ()); - - (* Remove the Connected and NoLimit tags *) - set_client_type c (client_type c - land (lnot (client_initialized_tag lor client_nolimit_tag))); --(* c.client_chunks <- [||];*) - c.client_source.DonkeySources.source_sock <- NoConnection; - save_join_queue c; - c.client_slot <- SlotNotAsked; -- let files = c.client_file_queue in - -- (try DonkeyOneFile.clean_current_download c with _ -> ()); -+(* clean_client_zones: clean all structures related to downloads when -+ a client disconnects *) -+ (try -+ match c.client_download with -+ | None -> () -+ | Some (file, up) -> -+ CommonSwarming.unregister_uploader up; -+ c.client_download <- None -+ with _ -> ()); - - List.iter (fun (file, chunks, up) -> - try CommonSwarming.unregister_uploader up with _ -> () -- ) -- files; -+ ) c.client_file_queue; -+ - c.client_file_queue <- []; -- if c.client_upload != None then CommonUploads.refill_upload_slots (); -+ c.client_session_downloaded <- 0L; - - with e -> lprintf_nl "Exception %s in disconnect_client" - (Printexc2.to_string e)); --(* lprintf "Client %d to source:" (client_num c); -- List.iter (fun r -> -- lprint_char ( -- match r.request_result with -- | File_chunk -> 'C' -- | File_upload -> 'U' -- | File_not_found -> '-' -- | File_found -> '+' -- | File_possible -> '?' -- | File_expected -> '!' -- | File_new_source -> 'n' -- )) c.client_files; -- lprintf "\n"; *) - set_client_disconnected c reason; - DonkeySources.source_disconnected c.client_source - -@@ -441,16 +422,24 @@ - - - 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 req_size = end_pos -- begin_pos in -+ let req_location = (begin_pos ++ end_pos) // (2L ** block_size) in -+ if !verbose_upload then -+ lprintf_nl "new block: (%Ld,%Ld) size %Ld chunk #%Ld" begin_pos end_pos req_size req_location; -+ if (req_size < Int64.zero) || (req_size > zone_size) || ((up.up_current <> req_location) && (req_size <> Int64.zero)) then -+ up.up_finish <- true; -+ if ((not up.up_finish) || (not !!upload_complete_chunks)) && (req_size > Int64.zero) && (req_size <= zone_size) then -+ 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 -@@ -599,7 +588,7 @@ - List.iter (fun tag -> - let s = to_lowercase (string_of_tag_value tag.tag_value) in - match tag.tag_name with -- Field_UNKNOWN "mod_version" -> -+ Field_KNOWN "mod_version" -> - begin - let rec iter i len = - if i < len then -@@ -647,6 +636,7 @@ - | 6 -> Brand_hydranode - | 10 -> Brand_mldonkey3 - | 20 -> Brand_lphant -+ | 60 -> Brand_imp - | 240 -> Brand_verycd - | _ -> Brand_unknown - -@@ -661,33 +651,42 @@ - iter 0 (Array.length mod_array) - - let update_client_from_tags c tags = -+ let module M = DonkeyProtoClient in - List.iter (fun tag -> - match tag.tag_name with -- | Field_UNKNOWN "name" -> () -- | Field_UNKNOWN "version" -> () -- | Field_UNKNOWN "emule_udpports" -> -+ | Field_KNOWN "emule_udpports" -> - for_two_int16_tag tag (fun ed2k_port kad_port -> - (* Kademlia: we should use this client to bootstrap Kademlia *) - if kad_port <> 0 && !!enable_kademlia then - DonkeyProtoKademlia.Kademlia.bootstrap - c.client_ip kad_port - ) -- | Field_UNKNOWN "emule_miscoptions1" -> -+ | Field_KNOWN "emule_miscoptions1" -> -+ c.client_emule_proto.received_miscoptions1 <- true; - for_int64_tag tag (fun i -> -- DonkeyProtoClient.update_emule_proto_from_miscoptions1 -- c.client_emule_proto i -+ M.update_emule_proto_from_miscoptions1 -+ c.client_emule_proto i; -+ if !verbose_msg_clients || c.client_debug then -+ lprintf_nl "miscoptions1 from client %s\n%s" -+ (full_client_identifier c) -+ (M.print_emule_proto_miscoptions1 c.client_emule_proto) - ) -- | Field_UNKNOWN "emule_miscoptions2" -> -+ | Field_KNOWN "emule_miscoptions2" -> -+ c.client_emule_proto.received_miscoptions2 <- true; - for_int64_tag tag (fun i -> -- DonkeyProtoClient.update_emule_proto_from_miscoptions2 -- c.client_emule_proto i -+ M.update_emule_proto_from_miscoptions2 -+ c.client_emule_proto i; -+ if !verbose_msg_clients || c.client_debug then -+ lprintf_nl "miscoptions2 from client %s\n%s" -+ (full_client_identifier c) -+ (M.print_emule_proto_miscoptions2 c.client_emule_proto) - ) -- | Field_UNKNOWN "emule_compatoptions" -> -+ | Field_KNOWN "emule_compatoptions" -> - for_int_tag tag (fun i -> -- DonkeyProtoClient.update_emule_proto_from_compatoptions -+ M.update_emule_proto_from_compatoptions - c.client_emule_proto i - ) -- | Field_UNKNOWN "emule_version" -> -+ | Field_KNOWN "emule_version" -> - for_int_tag tag (fun i -> - c.client_emule_proto.emule_version <- i; - let compatibleclient = (i lsr 24) in -@@ -697,60 +696,62 @@ - if c.client_brand = Brand_unknown then - lprintf_nl "[emule_version] Brand_unknown %s" (full_client_identifier c); - ) -- | Field_UNKNOWN "mod_version" -> -+ | Field_KNOWN "mod_version" -> - let s = to_lowercase (string_of_tag_value tag.tag_value) in - parse_mod_version s c -- | _ -> -- if !verbose_msg_clienttags then -- lprintf_nl "Unknown Emule tag: [%s] (update_client_from_tags)" (escaped_string_of_field tag) -+ | Field_KNOWN _ -> if !verbose_unknown_messages then -+ lprintf_nl "update_client_from_tags, known tag: [%s] (%s)" (string_of_tag tag) (full_client_identifier c) -+ | _ -> if not (DonkeySources.source_brand c.client_source) then -+ lprintf_nl "update_client_from_tags, unknown tag: [%s] (%s) %s" -+ (hexstring_of_tag tag) (full_client_identifier c) (string_of_tags_list tags) - ) tags - - let update_emule_proto_from_tags c tags = - List.iter (fun tag -> - match tag.tag_name with -- Field_UNKNOWN "compatibleclient" -> -+ Field_KNOWN "compatibleclient" -> - for_int_tag tag (fun i -> - c.client_brand <- parse_compatible_client i c.client_brand; - if c.client_brand = Brand_unknown then - lprintf_nl "unknown compatibleclient %d (%s) (please report to dev team)" i (full_client_identifier c) - ) -- | Field_UNKNOWN "compression" -> -+ | Field_KNOWN "compression" -> - for_int_tag tag (fun i -> - c.client_emule_proto.emule_compression <- i - ) -- | Field_UNKNOWN "udpver" -> -+ | Field_KNOWN "udpver" -> - for_int_tag tag (fun i -> - c.client_emule_proto.emule_udpver <- i - ) -- | Field_UNKNOWN "udpport" -> () -- | Field_UNKNOWN "sourceexchange" -> -+ | Field_KNOWN "sourceexchange" -> - for_int_tag tag (fun i -> - c.client_emule_proto.emule_sourceexchange <- i - ) -- | Field_UNKNOWN "comments" -> -+ | Field_KNOWN "comments" -> - for_int_tag tag (fun i -> - c.client_emule_proto.emule_comments <- i - ) -- | Field_UNKNOWN "extendedrequest" -> -+ | Field_KNOWN "extendedrequest" -> - for_int_tag tag (fun i -> - c.client_emule_proto.emule_extendedrequest <- i - ) -- | Field_UNKNOWN "features" -> -+ | Field_KNOWN "features" -> - for_int_tag tag (fun i -> - c.client_emule_proto.emule_secident <- i land 0x3 - ) -- | Field_UNKNOWN "mod_version" -> -- let s = to_lowercase (string_of_tag_value tag.tag_value) in -- parse_mod_version s c; -+ | Field_KNOWN "mod_version" -> -+ parse_mod_version (to_lowercase (string_of_tag_value tag.tag_value)) c; - -- | Field_UNKNOWN "os_info" -> -+ | Field_KNOWN "os_info" -> - let s = to_lowercase (string_of_tag_value tag.tag_value) in - (match c.client_osinfo with - Some _ -> () - | _ -> if s <> "" then c.client_osinfo <- Some s) -- | _ -> -- if !verbose_msg_clienttags then -- lprintf_nl "Unknown Emule tag: [%s] (update_emule_proto_from_tags)" (escaped_string_of_field tag) -+ | Field_KNOWN _ -> if !verbose_unknown_messages then -+ lprintf_nl "update_emule_proto_from_tags, known tag: [%s] (%s)" (string_of_tag tag) (full_client_identifier c) -+ | _ -> if not (DonkeySources.source_brand c.client_source) then -+ lprintf_nl "update_emule_proto_from_tags, unknown tag: [%s] (%s) %s" -+ (hexstring_of_tag tag) (full_client_identifier c) (string_of_tags_list tags) - ) tags - - let fight_disguised_mods c = -@@ -771,7 +772,7 @@ - emule_info with - DonkeyProtoClient.EmuleClientInfo.protversion = 255; - DonkeyProtoClient.EmuleClientInfo.tags = [ -- string_tag (Field_UNKNOWN "os_info") (String2.upp_initial Autoconf.system); -+ string_tag (Field_KNOWN "os_info") (String2.upp_initial Autoconf.system); - ]} in - client_send c (DonkeyProtoClient.EmuleClientInfoReq emule_osinfo); - c.client_osinfo_sent <- true -@@ -1128,7 +1129,7 @@ - let module M = DonkeyProtoClient in - - if !verbose_msg_clients || c.client_debug then begin -- lprintf_nl "Message from %s" (string_of_client c); -+ lprintf_nl "Message from %s" (full_client_identifier c); - M.print t; - end; - -@@ -1160,7 +1161,7 @@ - - List.iter (fun tag -> - match tag with -- { tag_name = Field_UNKNOWN "name"; tag_value = String s } -> -+ { tag_name = Field_KNOWN "name"; tag_value = String s } -> - set_client_name c s t.CR.md4 - | _ -> () - ) c.client_tags; -@@ -1401,7 +1402,7 @@ - | Some f -> CommonFile.file_best_name f); - (* end *) - -- | M.CloseSlotReq _ -> -+ | M.OutOfPartsReq _ -> - set_client_state c (Connected 0); - begin - match c.client_download with -@@ -1411,7 +1412,7 @@ - lprintf_nl "Slot closed during download"; - CommonSwarming.clear_uploader_ranges up - end; --(* DonkeyOneFile.clean_current_download c; *) -+ c.client_session_downloaded <- 0L; - c.client_slot <- SlotNotAsked; - (* OK, the slot is closed, but what should we do now ????? *) - begin -@@ -1419,7 +1420,7 @@ - [] -> () - | _ -> - if !verbose_download then -- lprintf_nl "CloseSlotReq"; -+ lprintf_nl "OutOfPartsReq"; - DonkeyOneFile.request_slot c; - set_rtimeout sock !!queued_timeout; - end -@@ -1560,8 +1561,7 @@ - (* if file.file_exists then verify_chunks file *) - end - -- -- | M.EmuleCompressedPart (md4, statpos, newsize, bloc) -> -+ | M.EmuleCompressedPart t -> - - set_lifetime sock active_lifetime; - if !!reliable_sources && -@@ -1572,12 +1572,13 @@ - raise Not_found - end; - -+ let module Q = M.EmuleCompressedPart in - let comp = match c.client_comp with - None -> - let comp = { -- comp_md4 = md4; -- comp_pos = statpos; -- comp_total = Int64.to_int newsize; -+ comp_md4 = t.Q.md4; -+ comp_pos = t.Q.statpos; -+ comp_total = Int64.to_int t.Q.newsize; - comp_len = 0; - comp_blocs = []; - } in -@@ -1585,8 +1586,8 @@ - comp - | Some comp -> comp - in -- comp.comp_blocs <- bloc :: comp.comp_blocs; -- comp.comp_len <- comp.comp_len + String.length bloc; -+ comp.comp_blocs <- t.Q.bloc :: comp.comp_blocs; -+ comp.comp_len <- comp.comp_len + String.length t.Q.bloc; - - (* lprintf "Comp bloc: %d/%d\n" comp.comp_len comp.comp_total; *) - if comp.comp_len = comp.comp_total then begin -@@ -2008,44 +2009,65 @@ - | M.QueryBlocReq t when !CommonUploads.has_upload = 0 && - client_has_a_slot (as_client c) -> - -- if !verbose_upload then -- lprintf_nl "donkeyClient: uploader %s ask for block" (full_client_identifier c); -- - let module Q = M.QueryBloc in -- let file = find_file t.Q.md4 in -+ let file = find_file t.Q.md4 in -+ -+ if !verbose_upload then lprintf_nl "donkeyClient: uploader %s asks for %s" -+ (full_client_identifier c) (file_best_name file); -+ - let prio = (file_priority file) in - let client_upload_lifetime = ref ((max 0 !!upload_lifetime) * 60) in -- begin - -- if !!dynamic_upload_lifetime -- && c.client_uploaded > c.client_downloaded -- && c.client_uploaded > Int64.of_int !!dynamic_upload_threshold ** zone_size -+ if !!dynamic_upload_lifetime && not !!upload_complete_chunks -+ && c.client_session_uploaded > c.client_session_downloaded -+ && c.client_session_uploaded > Int64.of_int !!dynamic_upload_threshold ** zone_size - then - client_upload_lifetime := - Int64.to_int - (Int64.of_int !client_upload_lifetime -- ** c.client_downloaded // c.client_uploaded); -- if last_time() > c.client_connect_time + -- !client_upload_lifetime + 5 * prio then -- begin -+ ** c.client_session_downloaded // c.client_session_uploaded); - --(* And what happens if we were downloading from this client also ? *) -- -- disconnect_client c (Closed_for_error "Upload lifetime expired"); -+ let client_received_enough c = -+ if !!upload_full_chunks && not !!upload_complete_chunks then -+ c.client_session_uploaded > (block_size ++ 20L ** 1024L) -+ else -+ last_time() > c.client_connect_time + !client_upload_lifetime + 5 * prio -+ in -+ -+ begin -+ if client_received_enough c then -+ if Intmap.length !CommonUploads.pending_slots_map = 0 then -+ begin -+ if !verbose_upload then lprintf_nl -+ "donkeyClient: not closing upload slot of %s (%s), pending slots empty, sending next block..." -+ (full_client_identifier c) (file_best_name file) -+ end -+ else begin -+ DonkeyOneFile.remove_client_slot c; - raise Not_found - end; -- -+ - set_lifetime sock active_lifetime; - 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_current = Int64.zero; -+ up_finish = true; - up_waiting = old_up.up_waiting; - }, old_up.up_waiting - | _ -> -@@ -2054,18 +2076,31 @@ - up_pos = Int64.zero; - up_end_chunk = Int64.zero; - up_chunks = []; -+ up_flying_chunks = []; -+ up_current = ((t.Q.start_pos1 ++ t.Q.end_pos1) // (2L ** block_size)); -+ up_finish = false; - up_waiting = false; - }, false - in - new_chunk up t.Q.start_pos1 t.Q.end_pos1; - new_chunk up t.Q.start_pos2 t.Q.end_pos2; - new_chunk up t.Q.start_pos3 t.Q.end_pos3; -+ (match up.up_chunks with -+ [] -> -+(* it should never happen here, that a client with up.up_finish = false -+ has an empty block queue *) -+ if up.up_finish && !!upload_complete_chunks then -+ begin -+ DonkeyOneFile.remove_client_slot c; -+ raise Not_found -+ end; -+ | chunks -> - c.client_upload <- Some up; - set_client_upload (as_client c) (as_file file); - if not waiting && !CommonUploads.has_upload = 0 then begin - CommonUploads.ready_for_upload (as_client c); - up.up_waiting <- true -- end -+ end) - end; - if !verbose_upload then lprintf_nl "QueryBloc treated" - -@@ -2141,12 +2176,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 -> -@@ -2193,7 +2228,7 @@ - let name = ref "" in - List.iter (fun tag -> - match tag with -- { tag_name = Field_UNKNOWN "name"; tag_value = String s } -> name := s -+ { tag_name = Field_KNOWN "name"; tag_value = String s } -> name := s - | _ -> () - ) t.CR.tags; - -Index: src/networks/donkey/donkeyComplexOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyComplexOptions.ml,v -retrieving revision 1.61 -retrieving revision 1.62 -diff -u -r1.61 -r1.62 ---- src/networks/donkey/donkeyComplexOptions.ml 28 Nov 2006 11:56:12 -0000 1.61 -+++ src/networks/donkey/donkeyComplexOptions.ml 6 Jan 2007 18:15:17 -0000 1.62 -@@ -559,6 +559,8 @@ - r.result_size <- v; - | { tag_name = Field_Size; tag_value = (Uint16 v| Uint8 v) } -> - r.result_size <- Int64.of_int v; -+ | { tag_name = Field_Size_Hi; tag_value = Uint8 v } -> -+ r.result_size <- Int64.logor r.result_size (Int64.shift_left (Int64.of_int v) 32); - | { tag_name = Field_Format; tag_value = String s } -> - r.result_tags <- tag :: r.result_tags; - r.result_format <- s -Index: src/networks/donkey/donkeyFiles.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyFiles.ml,v -retrieving revision 1.22 -retrieving revision 1.27 -diff -u -r1.22 -r1.27 ---- src/networks/donkey/donkeyFiles.ml 21 Nov 2006 22:34:33 -0000 1.22 -+++ src/networks/donkey/donkeyFiles.ml 15 Jan 2007 18:28:03 -0000 1.27 -@@ -61,6 +61,51 @@ - where nseconds = Fifo.length upload_clients - - *) -+exception Cache_table_hit of string * string -+type cache_entry = { -+ md4 : Md4.t; -+ begin_offset : int64; -+ end_offset : int64; -+ cached_part : string; -+ comp_part : string -+ } -+let cache_table_index = ref 0 -+let cache_table_size = !!upload_compression_table_size -+let ( cache_table : cache_entry Weak.t ) = Weak.create cache_table_size -+let cached_load file begin_offset end_offset compress= -+ try -+ for i = 0 to cache_table_size-1 do -+ match Weak.get cache_table i with -+ Some ({md4=md4;begin_offset=bo;end_offset=eo;cached_part=cached_file;comp_part=cached_comp}) when (md4 = file.file_md4) && (bo=begin_offset) && (eo=end_offset) -> -+ if !verbose_upload then -+ lprintf_nl "Cache Hit for %s (%Ld,%Ld)" (file_best_name file) begin_offset end_offset; -+ if (compress && (String.length cached_comp > 0)) || not compress then raise (Cache_table_hit(cached_file,cached_comp)) -+ | _ -> () -+ done; -+ let entry_length = Int64.to_int(end_offset -- begin_offset) in -+ let cached_file = String.create entry_length in -+ Unix32.read (file_fd file) begin_offset cached_file 0 entry_length; -+ let cached_comp = if compress then -+ Zlib.compress_string ~level:!!upload_compression_level cached_file -+ else -+ "" -+ in -+ cache_table_index := (!cache_table_index + 1) mod cache_table_size; -+ let (entry : cache_entry)={ -+ md4=file.file_md4; -+ begin_offset=begin_offset; -+ end_offset=end_offset; -+ cached_part=cached_file; -+ comp_part=cached_comp} in -+ Weak.set cache_table !cache_table_index (Some entry); -+ if !verbose_upload then -+ lprintf_nl "Cache Miss for %s (%Ld,%Ld) orig.len %d comp.len %d" (file_best_name file) begin_offset end_offset (String.length cached_file) (String.length cached_comp); -+ Some (cached_file,cached_comp) -+ with -+ | Cache_table_hit (cached_file,cached_comp) -> Some (cached_file,cached_comp) -+ | End_of_file -> if !verbose then lprintf_nl -+ "End_of_file in cached_load file %s size %Ld begin %Ld end %Ld" (file_best_name file) (file_size file) begin_offset end_offset; None -+ - - module NewUpload = struct - -@@ -74,14 +119,12 @@ - M.CloseSlotReq Q.t) - *) - -- let rec send_small_block c sock file begin_pos len_int = --(* lprintf "send_small_block %d\n" len_int; *) --(* let len_int = Int32.to_int len in *) -+ let rec send_small_block_plain c sock file begin_offset cfile pos len_int sixtyfour = - try - if !verbose_upload then -- lprintf_nl "Sending %s to %s, begin %Ld len %d" -+ lprintf_nl "Sending plain %s to %s, begin_offset %Ld pos %d len %d" - (file_best_name file) (full_client_identifier c) -- (begin_pos) (len_int); -+ (begin_offset) (pos) (len_int); - - let msg = - ( -@@ -89,8 +132,9 @@ - let module B = M.Bloc in - M.BlocReq { - B.md4 = file.file_md4; -- B.start_pos = begin_pos; -- B.end_pos = begin_pos ++ (Int64.of_int len_int); -+ B.usesixtyfour = sixtyfour; -+ B.start_pos = begin_offset ++ (Int64.of_int pos); -+ B.end_pos = begin_offset ++ (Int64.of_int(pos + len_int)); - B.bloc_str = ""; - B.bloc_begin = 0; - B.bloc_len = 0; -@@ -101,7 +145,7 @@ - let upload_buffer = String.create (slen + len_int) in - String.blit s 0 upload_buffer 0 slen; - DonkeyProtoCom.new_string msg upload_buffer; -- Unix32.read (file_fd file) begin_pos upload_buffer slen len_int; -+ String.blit cfile pos upload_buffer slen len_int; - let uploaded = Int64.of_int len_int in - count_upload c uploaded; - CommonUploads.consume_bandwidth len_int; -@@ -114,36 +158,95 @@ - write_string sock upload_buffer; - check_end_upload c sock - with -- End_of_file -> lprintf_nl "Can not send file %s to %s, file removed?" -+ | e -> if !verbose then lprintf_nl -+ "Exception %s in send_small_block_plain" (Printexc2.to_string e) -+ -+ let rec send_small_block_compressed c sock file begin_offset ccomp pos len_int pay_len sixtyfour = -+ try -+ if !verbose_upload then -+ lprintf_nl "Sending compressed %s to %s, begin_offset %Ld pos %d len %d" - (file_best_name file) (full_client_identifier c) -+ (begin_offset) (pos) (len_int); -+ -+ let msg = -+ ( -+ let module M = DonkeyProtoClient in -+ let module B = M.EmuleCompressedPart in -+ M.EmuleCompressedPart { -+ B.md4 = file.file_md4; -+ B.usesixtyfour = sixtyfour; -+ B.statpos = begin_offset; -+ B.newsize = Int64.of_int pay_len; -+ B.bloc = ""; -+ } -+ ) in -+ let s = client_msg_to_string c.client_emule_proto msg in -+ let slen = String.length s in -+ let upload_buffer = String.create (slen + len_int) in -+ String.blit s 0 upload_buffer 0 slen; -+ DonkeyProtoCom.new_string msg upload_buffer; -+ String.blit ccomp pos upload_buffer slen len_int; -+ CommonUploads.consume_bandwidth len_int; -+ -+ write_string sock upload_buffer; -+ check_end_upload c sock -+ with - | e -> if !verbose then lprintf_nl -- "Exception %s in send_small_block" (Printexc2.to_string e) -+ "Exception %s in send_small_block_compressed" (Printexc2.to_string e) - - let rec send_client_block c sock per_client = --(* lprintf "send_client_block\n"; *) -+ try - if per_client > 0 && CommonUploads.can_write_len sock max_msg_size then - match c.client_upload with -- | Some ({ up_chunks = _ :: chunks } as up) -> -- if up.up_file.file_shared = None then begin -+ | Some ({ up_chunks = (begin_offset,end_offset) :: chunks } as up) -> -+ if file_is_largefile up.up_file && c.client_emule_proto.emule_largefiles <> 1 then begin -+ DonkeyOneFile.remove_client_slot c; -+ lprintf_nl "File %s is too large for %s." (file_best_name up.up_file) (full_client_identifier c); -+ end else -+ if up.up_file.file_shared = None then - (* Is there a message to warn that a file is not shared anymore ? *) -- c.client_upload <- None; -- end else -- let max_len = up.up_end_chunk -- up.up_pos in -- let max_len = Int64.to_int max_len in -- let msg_block_size_int = min msg_block_size_int per_client in -- if max_len <= msg_block_size_int then -+ DonkeyOneFile.remove_client_slot c -+ else -+ let compress = !!upload_compression && (c.client_emule_proto.emule_compression <> 0) in -+ let cfile,ccomp = match cached_load up.up_file begin_offset end_offset compress with -+ Some (cached_file,cached_comp) -> cached_file,cached_comp -+ | _ -> "","" -+ in -+ let compressed = compress && ((String.length ccomp) + !!upload_compression_threshold < (String.length cfile)) in -+ let pay_len = if compressed then (String.length ccomp) else (String.length cfile) in -+ let pos = Int64.to_int (up.up_pos -- begin_offset) in -+ let max_len = pay_len - pos in -+ let allowed_msg_block_size_int = min msg_block_size_int per_client in -+ let sixtyfour = end_offset >= old_max_emule_file_size in -+ if max_len <= allowed_msg_block_size_int then - (* last block from chunk *) - begin -+ if compressed then -+ begin -+ send_small_block_compressed c sock up.up_file begin_offset ccomp pos max_len pay_len sixtyfour; -+ let uploaded = end_offset -- begin_offset in -+ count_upload c uploaded; -+ (match up.up_file.file_shared with None -> () -+ | Some impl -> -+ shared_must_update_downloaded (as_shared impl); -+ impl.impl_shared_uploaded <- -+ impl.impl_shared_uploaded ++ uploaded) -+ end -+ else -+ send_small_block_plain c sock up.up_file begin_offset cfile pos max_len sixtyfour -+ ; - 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; -+ lprintf_nl "End of chunk %Ld %Ld %s" begin_offset end_offset (file_best_name up.up_file); -+ up.up_flying_chunks <- up.up_flying_chunks @ [(begin_offset,end_offset)]; - 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; -+ if up.up_finish && !!upload_complete_chunks then -+ DonkeyOneFile.remove_client_slot c; - | (begin_pos, end_pos) :: _ -> - up.up_pos <- begin_pos; - up.up_end_chunk <- end_pos; -@@ -151,14 +254,25 @@ - end - else - (* small block from chunk *) -+ if allowed_msg_block_size_int >= msg_block_size_int then -+ begin -+ if compressed then - begin -- send_small_block c sock up.up_file up.up_pos -- msg_block_size_int; -+ send_small_block_compressed c sock up.up_file begin_offset ccomp pos msg_block_size_int pay_len sixtyfour; -+ end -+ else -+ begin -+ send_small_block_plain c sock up.up_file begin_offset cfile pos msg_block_size_int sixtyfour; -+ end -+ ; - up.up_pos <- up.up_pos ++ (Int64.of_int msg_block_size_int); - let per_client = per_client-msg_block_size_int in - send_client_block c sock per_client - end - | _ -> () -+ with -+ | e -> if !verbose then lprintf_nl -+ "Exception %s in send_client_block" (Printexc2.to_string e) - - let upload_to_client c size = - (* lprintf "upload_to_client %d\n" size; *) -@@ -168,10 +282,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/donkeyGlobals.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyGlobals.ml,v -retrieving revision 1.110 -retrieving revision 1.115 -diff -u -r1.110 -r1.115 ---- src/networks/donkey/donkeyGlobals.ml 26 Nov 2006 16:36:29 -0000 1.110 -+++ src/networks/donkey/donkeyGlobals.ml 28 Jan 2007 20:26:46 -0000 1.115 -@@ -104,6 +104,7 @@ - let as_file file = as_file file.file_file - let file_priority file = file.file_file.impl_file_priority - let file_size file = file.file_file.impl_file_size -+let file_is_largefile f = file_size f > old_max_emule_file_size - let file_downloaded file = file_downloaded (as_file file) - let file_age file = file.file_file.impl_file_age - let file_fd file = file_fd (as_file file) -@@ -287,6 +288,12 @@ - - let connected_servers () = !connected_server_list - -+let logged_in_servers () = -+List.filter (fun s -> -+ match server_state s with -+ | Connected _ -> true -+ | _ -> false) !connected_server_list -+ - let get_udp_sock () = - match !udp_sock with - None -> failwith "No UDP socket" -@@ -595,16 +602,15 @@ - client_osinfo = None; - client_checked = false; - client_connected = false; -- client_downloaded = Int64.zero; -- client_uploaded = Int64.zero; -+ client_session_downloaded = Int64.zero; -+ client_session_uploaded = Int64.zero; -+ client_total_downloaded = Int64.zero; -+ client_total_uploaded = Int64.zero; - client_banned = false; -- client_score = 0; -- client_next_queue = 0; - client_rank = 0; - client_connect_time = 0; - client_requests_sent = 0; - client_requests_received = 0; -- client_indirect_address = None; - client_slot = SlotNotAsked; - client_debug = false; - client_pending_messages = []; -@@ -650,16 +656,15 @@ - client_osinfo = None; - client_checked = false; - client_connected = false; -- client_downloaded = Int64.zero; -- client_uploaded = Int64.zero; -+ client_total_downloaded = Int64.zero; -+ client_total_uploaded = Int64.zero; -+ client_session_downloaded = Int64.zero; -+ client_session_uploaded = Int64.zero; - client_banned = false; -- client_score = 0; -- client_next_queue = 0; - client_rank = 0; - client_connect_time = 0; - client_requests_received = 0; - client_requests_sent = 0; -- client_indirect_address = None; - client_slot = SlotNotAsked; - client_debug = Intset.mem s.DonkeySources.source_num !debug_clients; - client_pending_messages = []; -@@ -715,17 +720,6 @@ - let friend_add c = - friend_add (as_client c) - --let string_of_client c = -- Printf.sprintf "client[%d] %s(%s) %s" (client_num c) -- c.client_name (brand_to_string c.client_brand) -- (match c.client_kind with -- Indirect_address (server_ip, server_port, ip, port, real_ip) -> -- Printf.sprintf " I[%s:%d]" (Ip.to_string real_ip) port; -- | Direct_address (ip,port) -> -- Printf.sprintf " D[%s:%d]" (Ip.to_string ip) port; -- | Invalid_address _ -> "" -- ) -- - let string_of_server s = - Printf.sprintf "%s:%d" (Ip.to_string s.server_ip) s.server_port - -@@ -1017,7 +1011,13 @@ - - let full_client_identifier c = - Printf.sprintf "%s (%s%s) '%s'" -- (Ip.to_string c.client_ip) -- (brand_to_string_short c.client_brand) -+ (match c.client_kind with -+ Indirect_address (server_ip, server_port, ip, port, real_ip) -> -+ Printf.sprintf "%s:%d(lowID, server:%s:%d]" -+ (Ip.to_string real_ip) port (Ip.to_string server_ip) server_port; -+ | Direct_address (ip,port) -> -+ Printf.sprintf "%s:%d" (Ip.to_string ip) port; -+ | Invalid_address _ -> " invalid IP") -+ (GuiTypes.client_software_short (brand_to_string_short c.client_brand) c.client_osinfo) - (if c.client_emule_proto.emule_release = "" then "" else " " ^ c.client_emule_proto.emule_release) - (String.escaped c.client_name) -Index: src/networks/donkey/donkeyImport.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyImport.ml,v -retrieving revision 1.10 -retrieving revision 1.12 -diff -u -r1.10 -r1.12 ---- src/networks/donkey/donkeyImport.ml 14 Nov 2006 18:42:59 -0000 1.10 -+++ src/networks/donkey/donkeyImport.ml 6 Dec 2006 00:49:14 -0000 1.12 -@@ -56,26 +56,32 @@ - let names_of_tag = - (* eMule sourcefile opcodes.h //server.met *) - [ -- "\001", Field_UNKNOWN "name"; (* 0x01 string *) -- "\011", Field_UNKNOWN "description"; (* 0x0B string *) -- "\012", Field_UNKNOWN "ping"; (* 0x0C uint32 *) -- "\013", Field_UNKNOWN "history"; (* 0x0D ST_FAIL *) -- "\014", Field_UNKNOWN "prof"; (* 0x0E ST_PREFERENCE *) -- "\015", Field_UNKNOWN "port"; (* 0x0F uint32 *) -- "\016", Field_UNKNOWN "ip"; (* 0x10 uint32 *) -- "\133", Field_UNKNOWN "dynip"; (* 0x85 string *) -- "\135", Field_UNKNOWN "maxusers"; (* 0x87 uint32 *) -- "\136", Field_UNKNOWN "softfiles"; (* 0x88 uint32 *) -- "\137", Field_UNKNOWN "hardfiles"; (* 0x89 uint32 *) -- "\144", Field_UNKNOWN "lastping"; (* 0x90 uint32 *) -- "\145", Field_UNKNOWN "version"; (* 0x91 string|uint32 *) -- "\146", Field_UNKNOWN "udpflags"; (* 0x92 uint32 *) -- "\147", Field_UNKNOWN "auxportslist"; (* 0x93 string *) -- "\148", Field_UNKNOWN "lowidusers"; (* 0x94 uint32 *) -- "\149", Field_UNKNOWN "udpkey"; (* 0x95 uint32 *) -- "\150", Field_UNKNOWN "udpkeyip"; (* 0x96 uint32 *) -- "\151", Field_UNKNOWN "tcpportobfuscation"; (* 0x97 uint16 *) -- "\152", Field_UNKNOWN "udpportobfuscation"; (* 0x98 uint16 *) -+ "\001", Field_KNOWN "name"; (* 0x01 string *) -+ "\011", Field_KNOWN "description"; (* 0x0B string *) -+ "\012", Field_KNOWN "ping"; (* 0x0C uint32 *) -+ "\013", Field_KNOWN "history"; (* 0x0D ST_FAIL *) -+ "\014", Field_KNOWN "prof"; (* 0x0E ST_PREFERENCE *) -+ "\015", Field_KNOWN "port"; (* 0x0F uint32 *) -+ "\016", Field_KNOWN "ip"; (* 0x10 uint32 *) -+ "\133", Field_KNOWN "dynip"; (* 0x85 string *) -+ "\135", Field_KNOWN "maxusers"; (* 0x87 uint32 *) -+ "maxusers", Field_KNOWN "maxusers"; -+ "\136", Field_KNOWN "softfiles"; (* 0x88 uint32 *) -+ "\137", Field_KNOWN "hardfiles"; (* 0x89 uint32 *) -+ "\144", Field_KNOWN "lastping"; (* 0x90 uint32 *) -+ "\145", Field_KNOWN "version"; (* 0x91 string|uint32 *) -+ "\146", Field_KNOWN "udpflags"; (* 0x92 uint32 *) -+ "\147", Field_KNOWN "auxportslist"; (* 0x93 string *) -+ "\148", Field_KNOWN "lowusers"; (* 0x94 uint32 *) -+ "lowusers", Field_KNOWN "lowusers"; -+ "\149", Field_KNOWN "udpkey"; (* 0x95 uint32 *) -+ "\150", Field_KNOWN "udpkeyip"; (* 0x96 uint32 *) -+ "\151", Field_KNOWN "tcpportobfuscation"; (* 0x97 uint16 *) -+ "\152", Field_KNOWN "udpportobfuscation"; (* 0x98 uint16 *) -+ "files", Field_KNOWN "files"; -+ "users", Field_KNOWN "users"; -+ "country", Field_KNOWN "country"; -+ "refs", Field_KNOWN "refs"; - ] - - -@@ -204,12 +210,12 @@ - - let names_of_tag = - [ -- "\008", Field_UNKNOWN "downloaded"; -- "\018", Field_UNKNOWN "diskname"; -- "\019", Field_UNKNOWN "priority"; -- "\020", Field_UNKNOWN "status"; -- "\t", Field_UNKNOWN "start_pos"; -- "\n", Field_UNKNOWN "absent"; -+ "\008", Field_KNOWN "downloaded"; -+ "\018", Field_KNOWN "diskname"; -+ "\019", Field_KNOWN "priority"; -+ "\020", Field_KNOWN "status"; -+ "\t", Field_KNOWN "start_pos"; -+ "\n", Field_KNOWN "absent"; - ] @ file_common_tags - - -@@ -231,8 +237,8 @@ - List.iter (fun tag -> - let s = tag.tag_name in - match s, tag.tag_value with -- Field_UNKNOWN "start_pos", Uint64 p -> start_pos := p; -- | Field_UNKNOWN "absent", Uint64 p -> -+ Field_KNOWN "start_pos", Uint64 p -> start_pos := p; -+ | Field_KNOWN "absent", Uint64 p -> - absents := (!start_pos, p) :: !absents; - | _ -> () - ) tags; -@@ -285,9 +291,9 @@ - - let names_of_client_tag = - [ -- "\001", Field_UNKNOWN "name"; -- "\017", Field_UNKNOWN "version"; -- "\015", Field_UNKNOWN "port"; -+ "\001", Field_KNOWN "name"; -+ "\017", Field_KNOWN "version"; -+ "\015", Field_KNOWN "port"; - ] - - let names_of_option_tag = [] -Index: src/networks/donkey/donkeyInteractive.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyInteractive.ml,v -retrieving revision 1.140 -retrieving revision 1.149 -diff -u -r1.140 -r1.149 ---- src/networks/donkey/donkeyInteractive.ml 26 Nov 2006 17:27:40 -0000 1.140 -+++ src/networks/donkey/donkeyInteractive.ml 30 Jan 2007 21:23:01 -0000 1.149 -@@ -113,44 +113,44 @@ - let server = check_add_server r.S.ip r.S.port in - List.iter (fun tag -> - match tag with -- | { tag_name = Field_UNKNOWN "name"; tag_value = String s } -> -+ | { tag_name = Field_KNOWN "name"; tag_value = String s } -> - server.server_name <- s; -- | { tag_name = Field_UNKNOWN "description" ; tag_value = String s } -> -+ | { tag_name = Field_KNOWN "description" ; tag_value = String s } -> - server.server_description <- s -- | { tag_name = Field_UNKNOWN "version" ; tag_value = Uint64 s } -> -+ | { tag_name = Field_KNOWN "version" ; tag_value = Uint64 s } -> - server.server_version <- Printf.sprintf "%d.%d" - ((Int64.to_int s) lsr 16) ((Int64.to_int s) land 0xFFFF) -- | { tag_name = Field_UNKNOWN "ping" ; tag_value = Uint64 s } -> -+ | { tag_name = Field_KNOWN "ping" ; tag_value = Uint64 s } -> - server.server_ping <- (Int64.to_int s) -- | { tag_name = Field_UNKNOWN "dynip" ; tag_value = String s } -> -+ | { tag_name = Field_KNOWN "dynip" ; tag_value = String s } -> - server.server_dynip <- s -- | { tag_name = Field_UNKNOWN "users" ; tag_value = Uint64 s } -> -+ | { tag_name = Field_KNOWN "users" ; tag_value = Uint64 s } -> - (match server.server_nusers with - | None -> server.server_nusers <- Some s | _ -> ()) -- | { tag_name = Field_UNKNOWN "files" ; tag_value = Uint64 s } -> -+ | { tag_name = Field_KNOWN "files" ; tag_value = Uint64 s } -> - (match server.server_nfiles with - | None -> server.server_nfiles <- Some s | _ -> ()) -- | { tag_name = Field_UNKNOWN "maxusers" ; tag_value = Uint64 s } -> -+ | { tag_name = Field_KNOWN "maxusers" ; tag_value = Uint64 s } -> - (match server.server_max_users with - | None -> server.server_max_users <- Some s | _ -> ()) -- | { tag_name = Field_UNKNOWN "softfiles" ; tag_value = Uint64 s } -> -+ | { tag_name = Field_KNOWN "softfiles" ; tag_value = Uint64 s } -> - (match server.server_soft_limit with - | None -> server.server_soft_limit <- Some s | _ -> ()) -- | { tag_name = Field_UNKNOWN "hardfiles" ; tag_value = Uint64 s } -> -+ | { tag_name = Field_KNOWN "hardfiles" ; tag_value = Uint64 s } -> - (match server.server_hard_limit with - | None -> server.server_hard_limit <- Some s | _ -> ()) -- | { tag_name = Field_UNKNOWN "auxportslist" ; tag_value = String s } -> -+ | { tag_name = Field_KNOWN "auxportslist" ; tag_value = String s } -> - server.server_auxportslist <- s -- | { tag_name = Field_UNKNOWN "lowusers" ; tag_value = Uint64 s } -> -+ | { tag_name = Field_KNOWN "lowusers" ; tag_value = Uint64 s } -> - (match server.server_lowid_users with - | None -> server.server_lowid_users <- Some s | _ -> ()) -- | { tag_name = Field_UNKNOWN "tcpportobfuscation" ; tag_value = Uint64 s } -> -+ | { tag_name = Field_KNOWN "tcpportobfuscation" ; tag_value = Uint64 s } -> - server.server_obfuscation_tcp <- Some (Int64.to_int s) -- | { tag_name = Field_UNKNOWN "udpportobfuscation" ; tag_value = Uint64 s } -> -+ | { tag_name = Field_KNOWN "udpportobfuscation" ; tag_value = Uint64 s } -> - server.server_obfuscation_udp <- Some (Int64.to_int s) -- | { tag_name = Field_UNKNOWN "country" ; tag_value = String s } -> () -- | { tag_name = Field_UNKNOWN "udpflags" ; tag_value = Uint64 s } -> () -- | { tag_name = Field_UNKNOWN "refs" ; tag_value = Uint64 s } -> () -+ | { tag_name = Field_KNOWN "country" ; tag_value = String s } -> () -+ | { tag_name = Field_KNOWN "udpflags" ; tag_value = Uint64 s } -> () -+ | { tag_name = Field_KNOWN "refs" ; tag_value = Uint64 s } -> () - | _ -> lprintf_nl "parsing server.met, unknown field %s" (string_of_tag tag) - ) r.S.tags; - server_must_update server -@@ -275,7 +275,8 @@ - match file.file_swarmer with - None -> assert false - | Some swarmer -> -- let absents = Sort.list (fun (p1,_) (p2,_) -> p1 <= p2) absents in -+ let absents = -+ List.sort (fun (p1, _) (p2, _) -> compare p1 p2) absents in - CommonSwarming.set_absent swarmer absents - end; - -@@ -429,6 +430,8 @@ - filename_met := Some s; - | { tag_name = Field_Size; tag_value = Uint64 v } -> - size := v -+ | { tag_name = Field_Size_Hi; tag_value = Uint64 v } -> -+ size := Int64.logor !size (Int64.shift_left v 32) - | _ -> () - ) f.P.tags; - ignore (really_query_download -@@ -447,16 +450,16 @@ - - List.iter (fun tag -> - match tag with -- | { tag_name = Field_UNKNOWN "name"; tag_value = String s } -> -+ | { tag_name = Field_KNOWN "name"; tag_value = String s } -> - login =:= s -- | { tag_name = Field_UNKNOWN "port"; tag_value = Uint64 v } -> -+ | { tag_name = Field_KNOWN "port"; tag_value = Uint64 v } -> - donkey_port =:= Int64.to_int v - | _ -> () - ) ct; - - List.iter (fun tag -> - match tag with -- | { tag_name = Field_UNKNOWN "temp"; tag_value = String s } -> -+ | { tag_name = Field_KNOWN "temp"; tag_value = String s } -> - if Sys.file_exists s then (* be careful on that *) - temp_dir := s - else (lprintf_nl "Bad temp directory, using default"; -@@ -559,8 +562,9 @@ - | "ed2k://" :: "file" :: name :: size :: md4 :: "/" :: "sources" :: sources :: _ - | "file" :: name :: size :: md4 :: "/" :: "sources" :: sources :: _ -> - (* ed2k://|file|Wikipedia_3.3_noimages.iso|2666311680|747735CD46B61DA92973E9A8840A9C99|/|sources,62.143.4.124:4662|/ *) -- if Int64.of_string size >= 4294967295L then -- (Printf.sprintf (_b "Files > 4GB are not allowed")), false -+ if Int64.of_string size >= max_emule_file_size then -+ (Printf.sprintf (_b "Files > %s are not allowed") -+ (Int64ops.int64_to_human_readable max_emule_file_size)), false - else - begin - let md4 = if String.length md4 > 32 then -@@ -599,8 +603,9 @@ - end - | "ed2k://" :: "file" :: name :: size :: md4 :: _ - | "file" :: name :: size :: md4 :: _ -> -- if Int64.of_string size >= 4294967295L then -- (Printf.sprintf (_b "Files > 4GB are not allowed")), false -+ if Int64.of_string size >= max_emule_file_size then -+ (Printf.sprintf (_b "Files > %s are not allowed") -+ (Int64ops.int64_to_human_readable max_emule_file_size)), false - else - let md4 = if String.length md4 > 32 then - String.sub md4 0 32 else md4 in -@@ -797,9 +802,10 @@ - ) !current_files - ) args; - "" -- ) , "<f1> < f2> ... :\t\ttry to recover these files at byte level"; -+ ) , "<f1> <f2> ... :\t\ttry to recover these files at byte level"; - - "preferred", Arg_two (fun arg1 arg2 o -> -+ if CommonUserDb.user2_is_admin o.conn_user.ui_user then - let preferred = bool_of_string arg1 in - let ip = Ip.of_string arg2 in - Hashtbl.iter (fun ip_s s -> -@@ -809,19 +815,28 @@ - end - ) servers_by_key; - "ok" -- ), "<true/false> <ip> :\t\tset the server with this IP as preferred"; -+ else -+ _s "You are not allowed to change preferred status" -+ ), "<true|false> <ip> :\t\tset the server with this IP as preferred"; - - "bs", Arg_multiple (fun args o -> -+ if CommonUserDb.user2_is_admin o.conn_user.ui_user then begin - List.iter (fun arg -> - let range = Ip.range_of_string arg in - server_black_list =:= range :: !!server_black_list; - ) args; - "done" -- ), "<range1> <range2> ... :\t\t\tadd these IPs to the servers black list (can be single IPs, CIDR ranges or begin-end ranges)"; -+ end else -+ _s "You are not allowed to blacklist servers" -+ ), "<range1> <range2> ... :\t\tadd these IPs to the servers black list (can be single IPs, CIDR ranges or begin-end ranges)"; - - "port", Arg_one (fun arg o -> -+ if CommonUserDb.user2_is_admin o.conn_user.ui_user then begin - donkey_port =:= int_of_string arg; -- "new port will change at next restart"), -+ "new port will change at next restart" -+ end else -+ _s "You are not allowed to change connection port" -+ ), - "<port> :\t\t\t\tchange connection port"; - - "scan_temp", Arg_none (fun o -> -@@ -925,7 +940,7 @@ - if use_html_mods o then Printf.bprintf buf "\\</table\\>\\</div\\>"; - "" end - else begin -- print_command_result o o.conn_buf "You are not allowed to use scan_temp"; -+ print_command_result o "You are not allowed to use scan_temp"; - "" end - - ), ":\t\t\t\tprint temp directory content"; -@@ -935,7 +950,7 @@ - DonkeySources.print o.conn_buf o.conn_output; - "" end - else begin -- print_command_result o o.conn_buf "You are not allowed to list sources"; -+ print_command_result o "You are not allowed to list sources"; - "" end - ), ":\t\t\t\tshow sources currently known"; - -@@ -991,11 +1006,14 @@ - ), ":\t\t\t\treset client_md4/client_private_key to random values"; - - "bp", Arg_multiple (fun args o -> -+ if CommonUserDb.user2_is_admin o.conn_user.ui_user then begin - List.iter (fun arg -> - let port = int_of_string arg in - port_black_list =:= port :: !!port_black_list; - ) args; - "done" -+ end else -+ _s "You are not allowed to blacklist ports" - ), "<port1> <port2> ... :\t\tadd these ports to the port black list"; - ] - -@@ -1195,14 +1213,16 @@ - P.client_os = c.client_osinfo; - P.client_release = c.client_emule_proto.emule_release; - P.client_emulemod = brand_mod_to_string_short c.client_brand_mod; -- P.client_downloaded = c.client_downloaded; -- P.client_uploaded = c.client_uploaded; --(* P.client_source.source_sock_addr = (); *) -+ P.client_total_downloaded = c.client_total_downloaded; -+ P.client_total_uploaded = c.client_total_uploaded; -+ P.client_session_downloaded = c.client_session_downloaded; -+ P.client_session_uploaded = c.client_session_uploaded; - P.client_upload = - (match client_upload (as_client c) with - Some f -> Some (CommonFile.file_best_name f) - | None -> None); - P.client_sui_verified = c.client_sui_verified; -+ P.client_file_queue = List.map (fun (file,_,_) -> as_file file) c.client_file_queue - } - ); - client_ops.op_client_debug <- (fun c debug -> -@@ -1396,8 +1416,10 @@ - ( "0", "srh", "Secure User Identification [N]one, [P]assed, [F]ailed", "S" ) ; - ( "0", "srh br", "IP address", "IP address" ) ; - ] @ (if !Geoip.active then [( "0", "srh br", "Country Code/Name", "CC" )] else []) @ [ -- ( "1", "srh ar", "Total UL bytes to this client for all files", "UL" ) ; -- ( "1", "srh ar br", "Total DL bytes from this client for all files", "DL" ) ; -+ ( "1", "srh ar", "Total UL bytes to this client for all files", "tUL" ) ; -+ ( "1", "srh ar br", "Total DL bytes from this client for all files", "tDL" ) ; -+ ( "1", "srh ar", "Session UL bytes to this client for all files", "sUL" ) ; -+ ( "1", "srh ar br", "Session DL bytes from this client for all files", "sDL" ) ; - ( "1", "srh ar", "Your queue rank on this client", "Rnk" ) ; - ( "1", "srh ar br", "Source score", "Scr" ) ; - ( "1", "srh ar br", "Last ok", "LO" ) ; -@@ -1476,8 +1498,10 @@ - )); - ("", "sr br", ip_string); - ] @ (if !Geoip.active then [(cn, "sr br", cc)] else []) @ [ -- ("", "sr ar", (size_of_int64 c.client_uploaded)); -- ("", "sr ar br", (size_of_int64 c.client_downloaded)); -+ ("", "sr ar", (size_of_int64 c.client_total_uploaded)); -+ ("", "sr ar br", (size_of_int64 c.client_total_downloaded)); -+ ("", "sr ar", (size_of_int64 c.client_session_uploaded)); -+ ("", "sr ar br", (size_of_int64 c.client_session_downloaded)); - ("", "sr ar", Printf.sprintf "%d" c.client_rank); - ("", "sr ar br", Printf.sprintf "%d" c.client_source.DonkeySources.source_score); - ("", "sr ar br", (string_of_date (c.client_source.DonkeySources.source_age))); -@@ -1679,6 +1703,68 @@ - c.client_name - (string_of_date (c.client_source.DonkeySources.source_age)) - ); -+ client_ops.op_client_print_info <- (fun c o -> -+ let buf = o.conn_buf in -+ let ip_string,cc,cn = get_ips_cc_cn c in -+ -+ Printf.bprintf buf "Client %d: %s\n" -+ (client_num c) -+ (full_client_identifier c); -+ ( -+ match c.client_osinfo with -+ | Some i -> Printf.bprintf buf " osinfo: %s\n" i -+ | None -> () -+ ); -+ Printf.bprintf buf " state: %s, rank: %d\n" -+ (string_of_connection_state (client_state c)) c.client_rank; -+ if !Geoip.active then Printf.bprintf buf " country: %s: %s\n" cc cn; -+ Printf.bprintf buf " MD4: %s\n" (Md4.to_string c.client_md4); -+ Printf.bprintf buf " downloaded\n"; -+ Printf.bprintf buf " - session %s\n" (size_of_int64 c.client_session_downloaded); -+ Printf.bprintf buf " - total %s\n" (size_of_int64 c.client_total_downloaded); -+ ( -+ match c.client_download with -+ | Some (f,_) -> Printf.bprintf buf " downloading file %s\n" (file_best_name f) -+ | None -> Printf.bprintf buf " not downloading\n" -+ ); -+ Printf.bprintf buf " uploaded\n"; -+ Printf.bprintf buf " - session %s\n" (size_of_int64 c.client_session_uploaded); -+ Printf.bprintf buf " - total %s\n" (size_of_int64 c.client_total_uploaded); -+ ( -+ match c.client_upload with -+ | Some u -> Printf.bprintf buf " uploading file %s\n" (file_best_name u.up_file) -+ | _ -> Printf.bprintf buf " not uploading\n" -+ ); -+ Printf.bprintf buf " SUI %s\n" ( -+ match c.client_sui_verified with -+ | None -> "not supported" -+ | Some b -> if b then "passed" else "failed" -+ ); -+ Printf.bprintf buf " kind: %s\n" ( -+ match c.client_kind with -+ | Direct_address (ip,port) -> -+ Printf.sprintf "highID %s:%d" (Ip.to_string ip) port -+ | Indirect_address (server_ip, server_port, id, port, real_ip) -> -+ Printf.sprintf "lowID %s:%d, server %s:%d" -+ (Ip.to_string real_ip) port (Ip.to_string server_ip) server_port -+ | Invalid_address (name,md4) -> Printf.sprintf "invalid" -+ ); -+ if c.client_emule_proto.received_miscoptions1 then -+ Printf.bprintf buf "\nmiscoptions1:\n%s" (DonkeyProtoClient.print_emule_proto_miscoptions1 c.client_emule_proto) -+ else -+ Printf.bprintf buf "no miscoptions1 received\n"; -+ if c.client_emule_proto.received_miscoptions2 then -+ Printf.bprintf buf "miscoptions2:\n%s" (DonkeyProtoClient.print_emule_proto_miscoptions2 c.client_emule_proto) -+ else -+ Printf.bprintf buf "no miscoptions2 received\n"; -+ List.iter (fun (file,_,_) -> Printf.bprintf buf "\nQueue: %s" (file_best_name file)) c.client_file_queue; -+ List.iter (fun r -> -+ Printf.bprintf buf "\nSource file: %s, score %d, request time %d" -+ (CommonFile.file_best_name (r.DonkeySources.request_file.DonkeySources.manager_file ())) -+ r.DonkeySources.request_score -+ r.DonkeySources.request_time; -+ ) c.client_source.DonkeySources.source_files; -+ ); - client_ops.op_client_dprint <- (fun c o file -> - let info = file_info file in - let buf = o.conn_buf in -@@ -1698,10 +1784,10 @@ - Direct_address (ip,port) -> (Ip.to_string ip) - | _ -> (string_of_client_addr c)); - Printf.bprintf buf "\n%14sDown : %-10s Uploaded: %-10s Ratio: %s%1.1f (%s)\n" "" -- (Int64.to_string c.client_downloaded) -- (Int64.to_string c.client_uploaded) -- (if c.client_downloaded > c.client_uploaded then "-" else "+") -- (if c.client_uploaded > Int64.zero then (Int64.to_float (Int64.div c.client_downloaded c.client_uploaded)) else (1.)) -+ (Int64.to_string c.client_total_downloaded) -+ (Int64.to_string c.client_total_uploaded) -+ (if c.client_total_downloaded > c.client_total_uploaded then "-" else "+") -+ (if c.client_total_uploaded > Int64.zero then (Int64.to_float (Int64.div c.client_total_downloaded c.client_total_uploaded)) else (1.)) - (brand_to_string c.client_brand); - (Printf.bprintf buf "%14sFile : %s\n" "" info.GuiTypes.file_name); - end; -@@ -1754,8 +1840,10 @@ - )); - ("", "sr", ip_string); - ] @ (if !Geoip.active then [(cn, "sr", cc)] else []) @ [ -- ("", "sr ar", (size_of_int64 c.client_uploaded)); -- ("", "sr ar", (size_of_int64 c.client_downloaded)); -+ ("", "sr ar", (size_of_int64 c.client_total_uploaded)); -+ ("", "sr ar", (size_of_int64 c.client_total_downloaded)); -+ ("", "sr ar", (size_of_int64 c.client_session_uploaded)); -+ ("", "sr ar", (size_of_int64 c.client_session_downloaded)); - ("", "sr", info.GuiTypes.file_name) ]); - - Printf.bprintf buf "\\</tr\\>"; -@@ -1774,6 +1862,29 @@ - ) - - let _ = -+ shared_ops.op_shared_state <- (fun f o -> -+ match CommonFile.file_state f with -+ | FileShared -> -+ (match file_shared f with -+ | None -> "no file_shared info" -+ | Some f -> -+ let pre_share1_dir = -+ String2.replace (Filename2.dirname (as_shared_impl f).impl_shared_fullname) '\\' "/" in -+ let pre_share2_dir = -+ try -+ String2.after pre_share1_dir -+ (String2.search_from -+ (Filename2.dirname (as_shared_impl f).impl_shared_fullname) 0 (Sys.getcwd ()) + -+ String.length (Sys.getcwd ())) -+ with Not_found -> pre_share1_dir -+ in -+ let dir = -+ if String2.check_prefix pre_share2_dir "/" then String2.after pre_share2_dir 1 else pre_share2_dir in -+ if o.conn_output = HTML then -+ Printf.sprintf "\\<a href=\\\"submit?q=debug_dir+%s\\\"\\>%s\\</a\\>" (Http_server.html_real_escaped dir) (Http_server.html_real_escaped dir) -+ else Printf.sprintf "Shared in %s" dir) -+ | state -> string_of_state state -+ ); - shared_ops.op_shared_unshare <- (fun file -> - unshare_file file; - (* Should we or not ??? *) -Index: src/networks/donkey/donkeyMain.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyMain.ml,v -retrieving revision 1.63 -retrieving revision 1.67 -diff -u -r1.63 -r1.67 ---- src/networks/donkey/donkeyMain.ml 26 Nov 2006 16:36:29 -0000 1.63 -+++ src/networks/donkey/donkeyMain.ml 28 Jan 2007 20:39:59 -0000 1.67 -@@ -137,14 +137,14 @@ - let emule_compatoptions = D.emule_compatoptions m in - client_to_client_tags := - [ -- string_tag (Field_UNKNOWN "name") (local_login ()); -- int_tag (Field_UNKNOWN "port") !!donkey_port; -- int_tag (Field_UNKNOWN "version") protocol_version; -- int_tag (Field_UNKNOWN "emule_udpports") (!!donkey_port+4); -- int_tag (Field_UNKNOWN "emule_version") m.emule_version; -- int64_tag (Field_UNKNOWN "emule_miscoptions1") emule_miscoptions1; -- int64_tag (Field_UNKNOWN "emule_miscoptions2") emule_miscoptions2; -- int_tag (Field_UNKNOWN "emule_compatoptions") emule_compatoptions; -+ string_tag (Field_KNOWN "name") (local_login ()); -+ int_tag (Field_KNOWN "port") !!donkey_port; -+ int_tag (Field_KNOWN "version") protocol_version; -+ int_tag (Field_KNOWN "emule_udpports") (!!donkey_port+4); -+ int_tag (Field_KNOWN "emule_version") m.emule_version; -+ int64_tag (Field_KNOWN "emule_miscoptions1") emule_miscoptions1; -+ int64_tag (Field_KNOWN "emule_miscoptions2") emule_miscoptions2; -+ int_tag (Field_KNOWN "emule_compatoptions") emule_compatoptions; - ]; - - (* server capabilities *) -@@ -154,49 +154,49 @@ - extended := !extended lor 0x04; (* support of auxport *) - extended := !extended lor 0x08; (* newtags *) - (*extended := !extended lor 0x10; (* unicode *) *) --(*extended := !extended lor 0x100; (* files > 4GB *) *) -+ extended := !extended lor 0x100; (* files > 4GB *) - (*extended := !extended lor 0x200; (* support crypt *) *) - (*extended := !extended lor 0x400; (* request crypt *) *) - (*extended := !extended lor 0x800; (* require crypt *) *) - - client_to_server_tags := - [ -- string_tag (Field_UNKNOWN "name") (local_login ()); -- int_tag (Field_UNKNOWN "version") protocol_version; -- int_tag (Field_UNKNOWN "extended") !extended; -- int_tag (Field_UNKNOWN "emule_version") m.emule_version; -+ string_tag (Field_KNOWN "name") (local_login ()); -+ int_tag (Field_KNOWN "version") protocol_version; -+ int_tag (Field_KNOWN "extended") !extended; -+ int_tag (Field_KNOWN "emule_version") m.emule_version; - ]; - - client_to_server_reply_tags := - [ -- string_tag (Field_UNKNOWN "name") (local_login ()); -- int_tag (Field_UNKNOWN "version") protocol_version; -- int_tag (Field_UNKNOWN "emule_udpports") (!!donkey_port+4); -- int64_tag (Field_UNKNOWN "emule_miscoptions1") emule_miscoptions1; -- int64_tag (Field_UNKNOWN "emule_miscoptions2") emule_miscoptions2; -- int_tag (Field_UNKNOWN "emule_version") m.emule_version; -+ string_tag (Field_KNOWN "name") (local_login ()); -+ int_tag (Field_KNOWN "version") protocol_version; -+ int_tag (Field_KNOWN "emule_udpports") (!!donkey_port+4); -+ int64_tag (Field_KNOWN "emule_miscoptions1") emule_miscoptions1; -+ int64_tag (Field_KNOWN "emule_miscoptions2") emule_miscoptions2; -+ int_tag (Field_KNOWN "emule_version") m.emule_version; - ]; - - emule_info.DonkeyProtoClient.EmuleClientInfo.tags <- [ -- int_tag (Field_UNKNOWN "compression") m.emule_compression; -- int_tag (Field_UNKNOWN "udpver") m.emule_udpver; -- int_tag (Field_UNKNOWN "udpport") (!!donkey_port+4); -- int_tag (Field_UNKNOWN "sourceexchange") m.emule_sourceexchange; -- int_tag (Field_UNKNOWN "comments") m.emule_comments; -- int_tag (Field_UNKNOWN "compatibleclient") !DonkeyProtoClient.compatibleclient; -- int_tag (Field_UNKNOWN "extendedrequest") m.emule_extendedrequest; -- int_tag (Field_UNKNOWN "features") m.emule_features; -+ int_tag (Field_KNOWN "compression") m.emule_compression; -+ int_tag (Field_KNOWN "udpver") m.emule_udpver; -+ int_tag (Field_KNOWN "udpport") (!!donkey_port+4); -+ int_tag (Field_KNOWN "sourceexchange") m.emule_sourceexchange; -+ int_tag (Field_KNOWN "comments") m.emule_comments; -+ int_tag (Field_KNOWN "compatibleclient") !DonkeyProtoClient.compatibleclient; -+ int_tag (Field_KNOWN "extendedrequest") m.emule_extendedrequest; -+ int_tag (Field_KNOWN "features") m.emule_features; - - ]; - overnet_connect_tags := - [ -- string_tag (Field_UNKNOWN "name") (local_login ()); -- int_tag (Field_UNKNOWN "version") !!DonkeyProtoOvernet.overnet_protocol_connect_version; -+ string_tag (Field_KNOWN "name") (local_login ()); -+ int_tag (Field_KNOWN "version") !!DonkeyProtoOvernet.overnet_protocol_connect_version; - ]; - overnet_connectreply_tags := - [ -- string_tag (Field_UNKNOWN "name") (local_login ()); -- int_tag (Field_UNKNOWN "version") !!DonkeyProtoOvernet.overnet_protocol_connectreply_version; -+ string_tag (Field_KNOWN "name") (local_login ()); -+ int_tag (Field_KNOWN "version") !!DonkeyProtoOvernet.overnet_protocol_connectreply_version; - ] - - let enable () = -@@ -405,7 +405,10 @@ - !kademlia_port_info, "kademlia_port UDP"; - ]); - network.op_network_porttest_result <- -- (fun _ -> !DonkeyInteractive.porttest_result); -+ (fun _ -> match !DonkeyInteractive.porttest_result with -+ | PorttestResult (time, s) -> -+ PorttestResult (time, (String2.dehtmlize s)) -+ | _ -> !DonkeyInteractive.porttest_result); - CommonInteractive.register_gui_options_panel "eDonkey" - gui_donkey_options_panel; - CommonInteractive.register_gui_options_panel "Overnet" -Index: src/networks/donkey/donkeyMftp.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyMftp.ml,v -retrieving revision 1.13 -retrieving revision 1.17 -diff -u -r1.13 -r1.17 ---- src/networks/donkey/donkeyMftp.ml 9 Feb 2006 11:45:12 -0000 1.13 -+++ src/networks/donkey/donkeyMftp.ml 15 Jan 2007 21:32:56 -0000 1.17 -@@ -179,7 +179,9 @@ - List.assoc name names_of_tag - with Not_found -> - (* lprintf "Unknown tag \"%s\"\n" (String.escaped name); *) -- field_of_string name); -+ match field_of_string name with -+ | Field_KNOWN s -> Field_UNKNOWN s -+ | field -> field); - tag_value = v - }, pos - -@@ -211,6 +213,7 @@ - "\005", Field_Lastseencomplete; - "\021", Field_Availability; - "\048", Field_Completesources; -+ "\058", Field_Size_Hi; - "\208", Field_Artist; - "\209", Field_Album; - "\210", Field_Title; -@@ -223,3 +226,77 @@ - "Album", Field_Album; - "Title", Field_Title; - ] -+ -+let client_common_tags = -+ [ -+ "\001", "name"; -+ "\015", "port"; -+ "\017", "version"; -+ "\031", "udpport"; -+ "\032", "compression"; -+ "\033", "udpport"; -+ "\034", "udpver"; -+ "\035", "sourceexchange"; -+ "\036", "comments"; -+ "\037", "extendedrequest"; -+ "\038", "compatibleclient"; -+ "\039", "features"; -+ "\059", "extrainfo"; -+ "\060", "downloadtime"; -+ "\061", "incompleteparts"; -+ "\062", "l2hac"; -+ "\063", "realparts"; -+ "\065", "mod_unknown41"; -+ "\066", "mod_unknown42"; -+ "\067", "mod_unknown43"; -+ "\078", "neo_features"; -+ "\084", "mod_featureset"; -+ "\085", "mod_version"; -+ "\086", "mod_protocol"; -+ "\090", "mod_bowlfish"; -+ "\092", "mod_secure_community"; -+ "\093", "mod_unknown0x5d"; -+ "\096", "mod_unknown0x60"; -+ "\100", "mod_unknown0x64"; -+ "\102", "mod_fusion"; -+ "\103", "mod_fusion_version"; -+ -+(* http://forums.shareaza.com/showthread.php?threadid=37323&perpage=15&pagenumber=2 *) -+ "\105", "edonkeyclc serverip?"; -+ "\106", "edonkeyclc serverport?"; -+ -+ "\108", "mod_unknown0x6c"; -+ "\117", "mod_unknown0x75"; (* http://emule-project.net @ NewMule *) -+ "\118", "mod_unknown0x76"; -+ "\119", "mod_tarod"; -+ "\120", "mod_tarod_version"; -+ "\121", "mod_morph"; -+ "\128", "mod_morph_version"; -+ "\130", "mod_mortillo"; -+ "\131", "mod_mortillo_version"; -+ "\132", "chanblard_version"; -+ "\133", "signature"; -+ "\134", "cache"; -+ "\135", "mod_lsd"; -+ "\136", "mod_lsd_version"; -+ "\144", "mod_lovelace_version"; -+ "\148", "os_info"; (* reused by aMule to transfer client OS type *) -+ "\153", "mod_plus"; -+ "\160", "mod_wombat"; -+ "\161", "dev_wombat"; -+ "\170", "koizo"; (* http://sourceforge.net/projects/koizo *) -+ "\205", "mod_unknown0xcd"; -+ "\224", "isp_bypass"; -+ "\225", "nat_tunneling"; -+ "\239", "emule_compatoptions"; -+ "\240", "nat_security"; -+ "\249", "emule_udpports"; -+ "\250", "emule_miscoptions1"; -+ "\251", "emule_version"; -+ "\252", "buddy_ip"; -+ "\253", "buddy_udp"; -+ "\254", "emule_miscoptions2"; -+ "pr", "edonkeyclc horde"; -+ "wombia", "wombat a"; -+ "wombib", "wombat b"; -+ ] -Index: src/networks/donkey/donkeyMftp.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyMftp.mli,v -retrieving revision 1.6 -retrieving revision 1.7 -diff -u -r1.6 -r1.7 ---- src/networks/donkey/donkeyMftp.mli 19 Jan 2006 00:44:47 -0000 1.6 -+++ src/networks/donkey/donkeyMftp.mli 3 Dec 2006 20:49:42 -0000 1.7 -@@ -51,4 +51,5 @@ - val print : t -> unit - val write : Buffer.t -> t -> unit - end --val file_common_tags : (string * CommonTypes.field) list -\ No newline at end of file -+val file_common_tags : (string * CommonTypes.field) list -+val client_common_tags : (string * string) list -Index: src/networks/donkey/donkeyOneFile.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyOneFile.ml,v -retrieving revision 1.46 -retrieving revision 1.49 -diff -u -r1.46 -r1.49 ---- src/networks/donkey/donkeyOneFile.ml 21 Nov 2006 22:34:34 -0000 1.46 -+++ src/networks/donkey/donkeyOneFile.ml 15 Jan 2007 18:28:03 -0000 1.49 -@@ -100,11 +100,30 @@ - end - - let remove_client_slot c = -+ if c.client_debug || ( -+ !verbose && -+ (c.client_session_uploaded > 0L || c.client_session_downloaded > 0L)) then -+ lprintf_nl "Client[%d] %s disconnected, connected %s%s%s" -+ (client_num c) (full_client_identifier c) -+ (Date.time_to_string (last_time () - c.client_connect_time) "verbose") -+ (if c.client_total_uploaded > 0L then -+ Printf.sprintf ", send %s (%s)%s" -+ (size_of_int64 c.client_session_uploaded) -+ (size_of_int64 c.client_total_uploaded) -+ (match client_upload (as_client c) with | None -> "" -+ | Some f -> " of " ^ (CommonFile.file_best_name f)) else "") -+ (if c.client_total_downloaded > 0L then -+ Printf.sprintf ", rec %s (%s)%s" -+ (size_of_int64 c.client_session_downloaded) -+ (size_of_int64 c.client_total_downloaded) -+ (match c.client_download with | None -> "" -+ | Some (f,_) -> " of " ^ (file_best_name f)) else ""); - set_client_has_a_slot (as_client c) NoSlot; - client_send c ( - let module M = DonkeyProtoClient in -- let module Q = M.CloseSlot in -- M.CloseSlotReq Q.t); -+ let module Q = M.OutOfParts in -+ M.OutOfPartsReq Q.t); -+ c.client_session_uploaded <- 0L; - c.client_upload <- None - - let unshare_file file = -@@ -218,16 +237,17 @@ - - (* let next_file _ = failwith "next_file not implemented" *) - --(* clean_client_zones: clean all structures related to downloads when -- a client disconnects *) --let clean_current_download c = -- match c.client_download with -- None -> () -- | Some (file, up) -> -- CommonSwarming.unregister_uploader up; -- c.client_download <- None -- - let send_get_range_request c file ranges = -+ let rec check_large (rangelist : (int64 * int64 * range) list) = -+ match rangelist with -+ | [] -> false -+ | (x,y,_ : (int64 * int64 * range))::tail_range -> -+ (x > old_max_emule_file_size) || (y > old_max_emule_file_size) || (check_large tail_range) -+ in -+ let is_large_request = check_large ranges in -+ if file_is_largefile file && c.client_emule_proto.emule_largefiles <> 1 then -+ lprintf_nl "File %s is too large for %s." (file_best_name file) (full_client_identifier c) -+ else - match c.client_source.DonkeySources.source_sock with - | Connection sock -> - -@@ -239,6 +259,7 @@ - [x1,y1,_] -> - { - Q.md4 = file.file_md4; -+ Q.usesixtyfour = is_large_request; - Q.start_pos1 = x1; - Q.end_pos1 = y1; - Q.start_pos2 = zero; -@@ -250,6 +271,7 @@ - | [x1,y1,_; x2,y2,_] -> - { - Q.md4 = file.file_md4; -+ Q.usesixtyfour = is_large_request; - Q.start_pos1 = x1; - Q.end_pos1 = y1; - Q.start_pos2 = x2; -@@ -261,6 +283,7 @@ - | [x1,y1,_; x2,y2,_; x3,y3,_ ] -> - { - Q.md4 = file.file_md4; -+ Q.usesixtyfour = is_large_request; - Q.start_pos1 = x1; - Q.end_pos1 = y1; - Q.start_pos2 = x2; -@@ -377,9 +400,7 @@ - or start querying blocks if already in the queue *) - let request_slot c = - if c.client_slot = SlotNotAsked then begin -- if !verbose_download then begin -- lprintf_nl "start_download"; -- end; -+ if !verbose_download then lprintf_nl "start_download"; - do_if_connected c.client_source.DonkeySources.source_sock (fun sock -> - sort_file_queue c; - match c.client_file_queue with -@@ -472,8 +493,9 @@ - match tag with - { tag_name = Field_Filename; tag_value = String s } -> file_name := s - | { tag_name = Field_Size; tag_value = Uint64 v } -> file_size := v -- | { tag_name = Field_Availability; -- tag_value = (Uint64 v| Fint64 v) } -> -+ | { tag_name = Field_Size_Hi; tag_value = Uint8 v } -> -+ file_size := Int64.logor !file_size (Int64.shift_left (Int64.of_int v) 32) -+ | { tag_name = Field_Availability; tag_value = (Uint64 v| Fint64 v) } -> - availability := Int64.to_int v; new_tags := tag :: !new_tags - | _ -> new_tags := tag :: !new_tags - ) tags; -Index: src/networks/donkey/donkeyOneFile.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyOneFile.mli,v -retrieving revision 1.7 -retrieving revision 1.8 -diff -u -r1.7 -r1.8 ---- src/networks/donkey/donkeyOneFile.mli 12 Nov 2005 11:20:21 -0000 1.7 -+++ src/networks/donkey/donkeyOneFile.mli 15 Jan 2007 18:28:03 -0000 1.8 -@@ -20,7 +20,6 @@ - open CommonSwarming - open Md4 - --val clean_current_download : DonkeyTypes.client -> unit - val get_from_client : DonkeyTypes.client -> unit - val request_slot : DonkeyTypes.client -> unit - val check_files_downloaded : unit -> unit -Index: src/networks/donkey/donkeyOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyOptions.ml,v -retrieving revision 1.57 -retrieving revision 1.61 -diff -u -r1.57 -r1.61 ---- src/networks/donkey/donkeyOptions.ml 26 Nov 2006 16:36:29 -0000 1.57 -+++ src/networks/donkey/donkeyOptions.ml 15 Jan 2007 18:26:27 -0000 1.61 -@@ -30,6 +30,7 @@ - int_option 30 - - let donkey_port = define_option donkey_section ["port"] -+ ~restart: true - "The port used for connection by other donkey clients." - int_option (2000 + Random.int 20000) - -@@ -174,6 +175,16 @@ - "How long a downloading client can stay in my upload queue (in minutes >5)" - int_option 90 - -+let upload_full_chunks = define_expert_option donkey_section ["upload_full_chunks"] -+ "If true, each client is allowed to receive one chunk, this setting overrides upload_lifetime" -+ bool_option false -+ -+let upload_complete_chunks = define_expert_option donkey_section ["upload_complete_chunks"] -+ "If true, each client is allowed to complete only one chunk, independent, if it is empty or -+ partial. this setting overrides upload_full_chunks and dynamic_upload_lifetime, -+ but is, as a failsafe, limited by upload_lifetime (should be set reasonable high)" -+ bool_option false -+ - let dynamic_upload_lifetime = define_expert_option donkey_section ["dynamic_upload_lifetime"] - "Each client upload lifetime depends on download-upload ratio" - bool_option false -@@ -182,6 +193,48 @@ - "Uploaded zones (1 zone = 180 kBytes) needed to enable the dynamic upload lifetime" - int_option 10 - -+let upload_compression = define_expert_option donkey_section ["upload_compression"] -+ "Enables compressed upload as part of the protocol" -+ bool_option true -+ -+let upload_compression_threshold = define_expert_option donkey_section ["upload_compression_threshold"] -+ "Sizedifference in bytes between one zone (180 kBytes) and its compressed -+ counterpart, which has to occure, to send compressed parts instead of plain." -+ int_option 2000 -+ -+let _ = -+ option_hook upload_compression_threshold (fun _ -> -+ if !!upload_compression_threshold < 0 then -+ upload_compression_threshold =:= 0 -+ ) -+ -+let upload_compression_level = define_expert_option donkey_section ["upload_compression_level"] -+ "Level of the used zlibcompression. allowed are values between 0 and 9. higher -+ level means better compression, but higher cpu usage too. (emules default -+ compression level for compressed parts is 9)" -+ int_option 9 -+ -+let _ = -+ option_hook upload_compression_level (fun _ -> -+ if !!upload_compression_level < 0 -+ || !!upload_compression_level > 9 then -+ upload_compression_level =:= 9 -+ ) -+ -+let upload_compression_table_size = define_expert_option donkey_section ["upload_compression_table_size"] -+ ~restart: true -+ "Size of the cache table in entries (ca. 2 * 180 kbytes). zones have to be -+ compressed at once, but only parts of it are sent at a time (10 kbytes). -+ to reduce diskaccess and repeated compression to a minimum, size should be -+ at least the number of total upload slots. restart of core is required." -+ int_option 20 -+ -+let _ = -+ option_hook upload_compression_table_size (fun _ -> -+ if !!upload_compression_table_size < 1 then -+ upload_compression_table_size =:= 1 -+ ) -+ - let connected_server_timeout = define_expert_option donkey_section ["connected_server_timeout"] - "How long can a silent server stay connected" - float_option 1800. -@@ -200,6 +253,7 @@ - int_option 2 - - let remove_old_servers_delay = define_expert_option donkey_section ["remove_old_servers_delay"] -+ ~restart: true - "How often should remove old donkey servers (see max_server_age) be called - (in seconds, 0 to disable)" - float_option 900. -@@ -267,10 +321,12 @@ - "Overnet options" - - let overnet_port = define_option overnet_section [overnet_options_section_name; "port"] -+ ~restart: true - "port for overnet" - int_option (2000 + Random.int 20000) - - let options_version = define_expert_option donkey_section ["options_version"] -+ ~internal: true - "(internal option)" - int_option 3 - -Index: src/networks/donkey/donkeyPandora.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyPandora.ml,v -retrieving revision 1.7 -retrieving revision 1.9 -diff -u -r1.7 -r1.9 ---- src/networks/donkey/donkeyPandora.ml 3 Apr 2006 20:50:09 -0000 1.7 -+++ src/networks/donkey/donkeyPandora.ml 6 Jan 2007 18:15:17 -0000 1.9 -@@ -98,23 +98,23 @@ - let update_emule_proto_from_tags e tags = - List.iter (fun tag -> - match tag.tag_name with -- | Field_UNKNOWN "compression" -> -+ | Field_KNOWN "compression" -> - for_int_tag tag (fun i -> - e.emule_compression <- i) -- | Field_UNKNOWN "udpver" -> -+ | Field_KNOWN "udpver" -> - for_int_tag tag (fun i -> - e.emule_udpver <- i) -- | Field_UNKNOWN "udpport" -> () -- | Field_UNKNOWN "sourceexchange" -> -+ | Field_KNOWN "udpport" -> () -+ | Field_KNOWN "sourceexchange" -> - for_int_tag tag (fun i -> - e.emule_sourceexchange <- i) -- | Field_UNKNOWN "comments" -> -+ | Field_KNOWN "comments" -> - for_int_tag tag (fun i -> - e.emule_comments <- i) -- | Field_UNKNOWN "extendedrequest" -> -+ | Field_KNOWN "extendedrequest" -> - for_int_tag tag (fun i -> - e.emule_extendedrequest <- i) -- | Field_UNKNOWN "features" -> -+ | Field_KNOWN "features" -> - for_int_tag tag (fun i -> - e.emule_secident <- i land 0x3) - | s -> -@@ -138,12 +138,23 @@ - - begin - try -- let options = find_tag (Field_UNKNOWN "emule_miscoptions1") tags in -+ let options = find_tag (Field_KNOWN "emule_miscoptions1") tags in -+ ( - match options with -- Uint64 v | Fint64 v -> -+ | Uint64 v | Fint64 v -> - update_emule_proto_from_miscoptions1 emule v - | _ -> - lprintf "CANNOT INTERPRETE EMULE OPTIONS\n" -+ ); -+ -+ let options2 = find_tag (Field_KNOWN "emule_miscoptions2") tags in -+ ( -+ match options2 with -+ | Uint64 v | Fint64 v -> -+ update_emule_proto_from_miscoptions2 emule v -+ | _ -> -+ lprintf "CANNOT INTERPRETE EMULE OPTIONS2\n" -+ ); - - with _ -> () - end; -@@ -151,14 +162,14 @@ - | P.UnknownReq (227,_) -> - emule.emule_extendedrequest <- -1 - -- | P.EmuleCompressedPart (md4, statpos, newsize, bloc) -> -+ | P.EmuleCompressedPart t -> - - let comp = match c.client_comp with - None -> - let comp = { -- comp_md4 = md4; -- comp_pos = statpos; -- comp_total = Int64.to_int newsize; -+ comp_md4 = t.EmuleCompressedPart.md4; -+ comp_pos = t.EmuleCompressedPart.statpos; -+ comp_total = Int64.to_int t.EmuleCompressedPart.newsize; - comp_len = 0; - comp_blocs = []; - } in -@@ -166,8 +177,8 @@ - comp - | Some comp -> comp - in -- comp.comp_blocs <- bloc :: comp.comp_blocs; -- comp.comp_len <- comp.comp_len + String.length bloc; -+ comp.comp_blocs <- t.EmuleCompressedPart.bloc :: comp.comp_blocs; -+ comp.comp_len <- comp.comp_len + String.length t.EmuleCompressedPart.bloc; - - (* lprintf "Comp bloc: %d/%d\n" comp.comp_len comp.comp_total; *) - if comp.comp_len = comp.comp_total then begin -Index: src/networks/donkey/donkeyProtoClient.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyProtoClient.ml,v -retrieving revision 1.40 -retrieving revision 1.45 -diff -u -r1.40 -r1.45 ---- src/networks/donkey/donkeyProtoClient.ml 26 Nov 2006 16:36:29 -0000 1.40 -+++ src/networks/donkey/donkeyProtoClient.ml 8 Jan 2007 12:20:40 -0000 1.45 -@@ -39,67 +39,110 @@ - (int_of_string(Autoconf.minor_version) lsl 10) lor - (int_of_string(Autoconf.sub_version) lsl 7) - --(* TODO : update this --I downgraded some of those to get better results : --We don't use emule udp extension, client_md4 in sourceexchange or complete sources in --file request *) - let mldonkey_emule_proto = - { -- emule_comments = 1; - emule_version = get_emule_version (); - emule_release = ""; -- emule_secident = 3; (* Emule uses v1 if advertising both, v2 if only advertising 2 *) -- emule_noviewshared = 0; -- emule_supportpreview = 0; - emule_osinfosupport = 1; -- emule_compression = 1; (* 1 *) -+ emule_features = 3; -+ -+(* emule_miscoptions1 *) -+ received_miscoptions1 = false; -+ emule_aich = 0; -+ emule_unicode = 0; -+ emule_udpver = 0; -+ emule_compression = 1; -+ emule_secident = 3; (* Emule uses v1 if advertising both, v2 if only advertising 2 *) - emule_sourceexchange = 2; (* 2 : +client_md4 3 : +IdHybrid (emule Kademlia?)*) -- emule_multipacket = 0; (* 1 *) - emule_extendedrequest = 1; (* 1: +file_status 2: +ncomplete_sources*) -- emule_features = 3; (* 3 *) -- emule_udpver = 0; (* 4 *) -+ emule_comments = 1; -+ emule_peercache = 0; -+ emule_noviewshared = 0; -+ emule_multipacket = 0; -+ emule_supportpreview = 0; -+ -+(* emule_miscoptions2 *) -+ received_miscoptions2 = false; -+ emule_require_crypt = 0; -+ emule_request_crypt = 0; -+ emule_support_crypt = 0; -+ emule_extmultipacket = 0; -+ emule_largefiles = 1; -+ emule_kad_version = 0; - } - - let emule_miscoptions1 m = - let o = -+ (m.emule_aich lsl 29) lor -+ (m.emule_unicode lsl 28) lor - (m.emule_udpver lsl 24) lor - (m.emule_compression lsl 20) lor - (m.emule_secident lsl 16) lor - (m.emule_sourceexchange lsl 12) lor - (m.emule_extendedrequest lsl 8) lor - (m.emule_comments lsl 4) lor -+ (m.emule_peercache lsl 3) lor - (m.emule_noviewshared lsl 2) lor - (m.emule_multipacket lsl 1) lor - (m.emule_supportpreview lsl 0) - in - Int64.of_int o - -+let update_emule_proto_from_miscoptions1 m o = -+ let o = Int64.to_int o in -+ m.emule_aich <- (o lsr 29) land 0x7; -+ m.emule_unicode <- (o lsr 28) land 0xf; -+ m.emule_udpver <- (o lsr 24) land 0xf; -+ m.emule_compression <- (o lsr 20) land 0xf; -+ m.emule_secident <- (o lsr 16) land 0xf; -+ m.emule_sourceexchange <- (o lsr 12) land 0xf; -+ m.emule_extendedrequest <- (o lsr 8) land 0xf; -+ m.emule_comments <- (o lsr 4) land 0xf; -+ m.emule_peercache <- (o lsr 3) land 0x1; -+ m.emule_noviewshared <- (o lsr 2) land 0x1; -+ m.emule_multipacket <- (o lsr 1) land 0x1; -+ m.emule_supportpreview <- (o lsr 0) land 0x1 -+ -+let print_emule_proto_miscoptions1 m = -+ let buf = Buffer.create 50 in -+ if m.emule_aich <> 0 then Printf.bprintf buf " aich %d\n" m.emule_aich; -+ if m.emule_unicode <> 0 then Printf.bprintf buf " unicode %d\n" m.emule_unicode; -+ if m.emule_udpver <> 0 then Printf.bprintf buf " udpver %d\n" m.emule_udpver; -+ if m.emule_compression <> 0 then Printf.bprintf buf " compression %d\n" m.emule_compression; -+ if m.emule_secident <> 0 then Printf.bprintf buf " secident %d\n" m.emule_secident; -+ if m.emule_sourceexchange <> 0 then Printf.bprintf buf " sourceexchange %d\n" m.emule_sourceexchange; -+ if m.emule_extendedrequest <> 0 then Printf.bprintf buf " extendedrequest %d\n" m.emule_extendedrequest; -+ if m.emule_comments <> 0 then Printf.bprintf buf " comments %d\n" m.emule_comments; -+ if m.emule_peercache <> 0 then Printf.bprintf buf " peercache %d\n" m.emule_peercache; -+ if m.emule_noviewshared <> 0 then Printf.bprintf buf " noviewshared %d\n" m.emule_noviewshared; -+ if m.emule_multipacket <> 0 then Printf.bprintf buf " multipacket %d\n" m.emule_multipacket; -+ if m.emule_supportpreview <> 0 then Printf.bprintf buf " supportpreview %d\n" m.emule_supportpreview; -+ Buffer.contents buf -+ - let emule_miscoptions2 m = --(* - let o = - (m.emule_largefiles lsl 4) - in - Int64.of_int o --*) -- Int64.zero - --let update_emule_proto_from_miscoptions1 m o = -+let update_emule_proto_from_miscoptions2 m o = - let o = Int64.to_int o in -- m.emule_udpver <- (o lsr 24) land 0xf; -- m.emule_compression <- (o lsr 20) land 0xf; -- m.emule_secident <- (o lsr 16) land 0xf; -- m.emule_sourceexchange <- (o lsr 12) land 0xf; -- m.emule_extendedrequest <- (o lsr 8) land 0xf; -- m.emule_comments <- (o lsr 4) land 0xf; -- m.emule_noviewshared <- (o lsr 2) land 0x1; -- m.emule_multipacket <- (o lsr 1) land 0x1; -- m.emule_supportpreview <- (o lsr 0) land 0x1 -- --let update_emule_proto_from_miscoptions2 m o = () --(* -- let o = Int64.to_int o in -- m.emule_largefiles <- (o lsr 4) land 0x1 --*) -+ m.emule_require_crypt <- (o lsr 9) land 0x1; -+ m.emule_request_crypt <- (o lsr 8) land 0x1; -+ m.emule_support_crypt <- (o lsr 7) land 0x1; -+ m.emule_extmultipacket <- (o lsr 5) land 0x1; -+ m.emule_largefiles <- (o lsr 4) land 0x1; -+ m.emule_kad_version <- (o lsr 0) land 0xf -+ -+let print_emule_proto_miscoptions2 m = -+ let buf = Buffer.create 50 in -+ if m.emule_require_crypt <> 0 then Printf.bprintf buf " require_crypt %d\n" m.emule_require_crypt; -+ if m.emule_request_crypt <> 0 then Printf.bprintf buf " request_crypt %d\n" m.emule_request_crypt; -+ if m.emule_support_crypt <> 0 then Printf.bprintf buf " support_crypt %d\n" m.emule_support_crypt; -+ if m.emule_extmultipacket <> 0 then Printf.bprintf buf " extmultipacket %d\n" m.emule_extmultipacket; -+ if m.emule_largefiles <> 0 then Printf.bprintf buf " largefiles %d\n" m.emule_largefiles; -+ if m.emule_kad_version <> 0 then Printf.bprintf buf " kad_version %d\n" m.emule_kad_version; -+ Buffer.contents buf - - let emule_compatoptions m = - (m.emule_osinfosupport lsl 0) -@@ -146,23 +189,10 @@ - left_bytes : string; - } - -+ let names_of_tag = client_common_tags -+ - let names_of_tag = -- [ -- "\001", Field_UNKNOWN "name"; -- "\015", Field_UNKNOWN "port"; -- "\017", Field_UNKNOWN "version"; -- "\031", Field_UNKNOWN "udpport"; -- "\060", Field_UNKNOWN "downloadtime"; -- "\061", Field_UNKNOWN "incompleteparts"; -- "\085", Field_UNKNOWN "mod_version"; -- "\239", Field_UNKNOWN "emule_compatoptions"; -- "\249", Field_UNKNOWN "emule_udpports"; -- "\250", Field_UNKNOWN "emule_miscoptions1"; -- "\251", Field_UNKNOWN "emule_version"; -- "\252", Field_UNKNOWN "buddy_ip"; -- "\253", Field_UNKNOWN "buddy_udp"; -- "\254", Field_UNKNOWN "emule_miscoptions2"; -- ] -+ List.map (fun (v, name) -> (v, Field_KNOWN name)) names_of_tag - - let parse reply len s = - let hash_len, pos = if not reply then get_uint8 s 1, 2 else -1, 1 in -@@ -388,7 +418,6 @@ - - let print t = - lprintf_nl "CHUNKS for %s" (Md4.to_string t.md4); -- lprint_string " "; - lprintf_nl "%s\n" (Bitv.to_string t.chunks) - - let write buf t = -@@ -423,7 +452,7 @@ - } - - let print t = -- lprintf_nl "CHUNKS for %s" (Md4.to_string t.md4); -+ lprintf_nl "CHUNKSMd4 for %s" (Md4.to_string t.md4); - lprint_string " "; - Array.iter (fun b -> - lprintf " %s" (Md4.to_string b)) -@@ -462,6 +491,7 @@ - module Bloc = struct - type t = { - md4 : Md4.t; -+ usesixtyfour : bool; - start_pos : int64; - end_pos: int64; - bloc_str: string; -@@ -469,14 +499,15 @@ - bloc_len : int; - } - -- let parse len s = -+ let parse usesixtyfour len s = - { - md4 = get_md4 s 1; -- start_pos = get_uint64_32 s 17; -- end_pos = get_uint64_32 s 21; -+ usesixtyfour = usesixtyfour; -+ start_pos = if usesixtyfour then get_int64 s 17 else get_uint64_32 s 17; -+ end_pos = if usesixtyfour then get_int64 s 25 else get_uint64_32 s 21; - bloc_str = s; -- bloc_begin = 25; -- bloc_len = len - 25; -+ bloc_begin = if usesixtyfour then 33 else 25; -+ bloc_len = if usesixtyfour then len - 33 else len - 25; - } - - let print t = -@@ -487,14 +518,15 @@ - - let write buf t = - buf_md4 buf t.md4; -- buf_int64_32 buf t.start_pos; -- buf_int64_32 buf t.end_pos; -+ if t.usesixtyfour then buf_int64 buf t.start_pos else buf_int64_32 buf t.start_pos; -+ if t.usesixtyfour then buf_int64 buf t.end_pos else buf_int64_32 buf t.end_pos; - Buffer.add_substring buf t.bloc_str t.bloc_begin t.bloc_len - end - - module QueryBloc = struct - type t = { - md4 : Md4.t; -+ usesixtyfour : bool; - start_pos1 : int64; (* 180 ko *) - end_pos1: int64; - start_pos2 : int64; -@@ -503,15 +535,16 @@ - end_pos3: int64; - } - -- let parse len s = -+ let parse usesixtyfour len s = - { - md4 = get_md4 s 1; -- start_pos1 = get_uint64_32 s 17; -- end_pos1 = get_uint64_32 s 29; -- start_pos2 = get_uint64_32 s 21; -- end_pos2 = get_uint64_32 s 33; -- start_pos3 = get_uint64_32 s 25; -- end_pos3 = get_uint64_32 s 37; -+ usesixtyfour = usesixtyfour; -+ start_pos1 = if usesixtyfour then get_int64 s 17 else get_uint64_32 s 17; -+ end_pos1 = if usesixtyfour then get_int64 s 41 else get_uint64_32 s 29; -+ start_pos2 = if usesixtyfour then get_int64 s 25 else get_uint64_32 s 21; -+ end_pos2 = if usesixtyfour then get_int64 s 49 else get_uint64_32 s 33; -+ start_pos3 = if usesixtyfour then get_int64 s 33 else get_uint64_32 s 25; -+ end_pos3 = if usesixtyfour then get_int64 s 57 else get_uint64_32 s 37; - } - - let print t = -@@ -523,12 +556,12 @@ - - let write buf t = - buf_md4 buf t.md4; -- buf_int64_32 buf t.start_pos1; -- buf_int64_32 buf t.start_pos2; -- buf_int64_32 buf t.start_pos3; -- buf_int64_32 buf t.end_pos1; -- buf_int64_32 buf t.end_pos2; -- buf_int64_32 buf t.end_pos3 -+ if t.usesixtyfour then buf_int64 buf t.start_pos1 else buf_int64_32 buf t.start_pos1; -+ if t.usesixtyfour then buf_int64 buf t.start_pos2 else buf_int64_32 buf t.start_pos2; -+ if t.usesixtyfour then buf_int64 buf t.start_pos3 else buf_int64_32 buf t.start_pos3; -+ if t.usesixtyfour then buf_int64 buf t.end_pos1 else buf_int64_32 buf t.end_pos1; -+ if t.usesixtyfour then buf_int64 buf t.end_pos2 else buf_int64_32 buf t.end_pos2; -+ if t.usesixtyfour then buf_int64 buf t.end_pos3 else buf_int64_32 buf t.end_pos3 - end - - let unit = () -@@ -554,7 +587,7 @@ - - module AvailableSlot = NoArg(struct let m = "AvailableSlot" end) - module ReleaseSlot = NoArg(struct let m = "ReleaseSlot" end) --module CloseSlot = NoArg(struct let m = "CloseSlot" end) -+module OutOfParts = NoArg(struct let m = "OutOfParts" end) - module ViewFiles = NoArg(struct let m = "VIEW FILES" end) - module ViewDirs = NoArg(struct let m = "VIEW DIRS" end) - -@@ -787,49 +820,10 @@ - mutable tags : tag list; - } - -- let names_of_tag = -- [ -- "\032", "compression"; -- "\033", "udpport"; -- "\034", "udpver"; -- "\035", "sourceexchange"; -- "\036", "comments"; -- "\037", "extendedrequest"; -- "\038", "compatibleclient"; -- "\039", "features"; -- "\060", "downloadtime"; -- "\061", "incompleteparts"; -- "\062", "l2hac"; -- "\065", "mod_unknown41"; -- "\066", "mod_unknown42"; -- "\067", "mod_unknown43"; -- "\084", "mod_featureset"; -- "\086", "mod_protocol"; -- "\085", "mod_version"; -- "\090", "mod_bowlfish"; -- "\092", "mod_secure_community"; -- "\102", "mod_fusion"; -- "\103", "mod_fusion_version"; -- "\119", "mod_tarod"; -- "\120", "mod_tarod_version"; -- "\121", "mod_morph"; -- "\128", "mod_morph_version"; -- "\130", "mod_mortillo"; -- "\131", "mod_mortillo_version"; -- "\132", "chanblard_version"; -- "\133", "signature"; -- "\134", "cache"; -- "\135", "mod_lsd"; -- "\136", "mod_lsd_version"; -- "\144", "mod_lovelace_version"; -- "\148", "os_info"; (* reused by aMule to transfer client OS type *) -- "\153", "mod_plus"; -- "\160", "mod_wombat"; -- "\161", "dev_wombat"; -- ] -+ let names_of_tag = client_common_tags - - let names_of_tag = -- List.map (fun (v, name) -> (v, Field_UNKNOWN name)) names_of_tag -+ List.map (fun (v, name) -> (v, Field_KNOWN name)) names_of_tag - - let parse len s = - let version = get_uint8 s 1 in -@@ -1090,6 +1084,35 @@ - buf_string buf t.comment - end - -+module EmuleCompressedPart = struct -+ -+ type t = { -+ md4 : Md4.t; -+ usesixtyfour : bool; -+ statpos : int64; -+ newsize : int64; -+ bloc : string; -+ } -+ -+ let parse usesixtyfour len s = -+ { -+ md4 = get_md4 s 1; -+ usesixtyfour = usesixtyfour; -+ statpos = if usesixtyfour then get_int64 s 17 else get_uint64_32 s 17; -+ newsize = if usesixtyfour then get_uint64_32 s 25 else get_uint64_32 s 21; -+ bloc = if usesixtyfour then String.sub s 29 (len-29) else String.sub s 25 (len-25) -+ } -+ -+ let print t = -+ lprintf_nl "EmuleCompressedPart for %s %Ld %Ld len %d" -+ (Md4.to_string t.md4) t.statpos t.newsize (String.length t.bloc) -+ -+ let write buf t = -+ buf_md4 buf t.md4; -+ if t.usesixtyfour then buf_int64 buf t.statpos else buf_int64_32 buf t.statpos; -+ buf_int64_32 buf t.newsize; -+ Buffer.add_string buf t.bloc -+ end - - module EmulePortTestReq = struct - -@@ -1115,7 +1138,7 @@ - | JoinQueueReq of JoinQueue.t (* sent before queryBloc *) - | AvailableSlotReq of AvailableSlot.t - | ReleaseSlotReq of ReleaseSlot.t --| CloseSlotReq of CloseSlot.t -+| OutOfPartsReq of OutOfParts.t - | QueryChunksReq of QueryChunks.t - | QueryChunksReplyReq of QueryChunksReply.t - | QueryChunkMd4Req of QueryChunkMd4.t -@@ -1147,7 +1170,7 @@ - | EmuleSecIdentStateReq of EmuleSecIdentStateReq.t - | EmuleMultiPacketReq of Md4.t * t list - | EmuleMultiPacketAnswerReq of Md4.t * t list --| EmuleCompressedPart of Md4.t * int64 * int64 * string -+| EmuleCompressedPart of EmuleCompressedPart.t - | EmulePortTestReq of EmulePortTestReq.t - - let rec print t = -@@ -1162,7 +1185,7 @@ - | JoinQueueReq t -> JoinQueue.print t - | AvailableSlotReq t -> AvailableSlot.print t - | ReleaseSlotReq t -> ReleaseSlot.print t -- | CloseSlotReq t -> CloseSlot.print t -+ | OutOfPartsReq t -> OutOfParts.print t - | QueryChunksReq t -> QueryChunks.print t - | QueryChunksReplyReq t -> QueryChunksReply.print t - | QueryChunkMd4Req t -> QueryChunkMd4.print t -@@ -1216,9 +1239,8 @@ - EmuleSignatureReq.print t - | EmulePublicKeyReq t -> - EmulePublicKeyReq.print t -- | EmuleCompressedPart (md4, statpos, newsize, bloc) -> -- lprintf_nl "EmuleCompressedPart for %s %Ld %Ld len %d" -- (Md4.to_string md4) statpos newsize (String.length bloc) -+ | EmuleCompressedPart t -> -+ EmuleCompressedPart.print t - | EmulePortTestReq t -> - EmulePortTestReq.print t - | UnknownReq (opcode, s) -> -@@ -1265,11 +1287,7 @@ - - | 0x40 (* 64 *) -> - (* OP_COMPRESSEDPART *) -- let md4 = get_md4 s 1 in -- let statpos = get_uint64_32 s 17 in -- let newsize = get_uint64_32 s 21 in -- let bloc = String.sub s 25 (len-25) in -- EmuleCompressedPart (md4, statpos, newsize, bloc) -+ EmuleCompressedPart (EmuleCompressedPart.parse false len s) - - | 0x85 (* 133 *) -> - EmulePublicKeyReq(EmulePublicKeyReq.parse len s) -@@ -1352,6 +1370,10 @@ - in - EmuleMultiPacketAnswerReq (md4, iter s 17 len) - -+ | 0xa1 (* 161 *) -> (* OP_COMPRESSEDPART_I64 *) -+ EmuleCompressedPart (EmuleCompressedPart.parse true len s) -+ | 0xa2 -> BlocReq (Bloc.parse true len s) (* OP_SENDINGPART_I64 *) -+ | 0xa3 -> QueryBlocReq (QueryBloc.parse true len s) (*OP_REQUESTPARTS_I64 *) - | 0xfe (* 254 *) -> - EmulePortTestReq s - -@@ -1377,8 +1399,8 @@ - begin - match opcode with - | 1 -> ConnectReq (Connect.parse false len s) -- | 70 -> BlocReq (Bloc.parse len s) -- | 71 -> QueryBlocReq (QueryBloc.parse len s) -+ | 70 -> BlocReq (Bloc.parse false len s) -+ | 71 -> QueryBlocReq (QueryBloc.parse false len s) - | 72 -> NoSuchFileReq (NoSuchFile.parse len s) - | 73 -> EndOfDownloadReq (EndOfDownload.parse len s) - | 74 -> ViewFilesReq (ViewFiles.parse len s) -@@ -1396,8 +1418,8 @@ - | 85 -> AvailableSlotReq (AvailableSlot.parse len s) - (* ReleaseSlot: the upload is finished *) - | 86 -> ReleaseSlotReq (ReleaseSlot.parse len s) --(* CloseSlot: the upload slot is not available *) -- | 87 -> CloseSlotReq (CloseSlot.parse len s) -+(* OutOfParts: the upload slot is not available *) -+ | 87 -> OutOfPartsReq (OutOfParts.parse len s) - | 88 -> QueryFileReq (QueryFile.parse emule_version len s) - | 89 -> QueryFileReplyReq (QueryFileReply.parse len s) - | 92 -> QueueRankReq (QueueRank.parse len s) -@@ -1470,6 +1492,8 @@ - | EmuleQueueRankingReq _ - | EmuleCompressedPart _ - -> 0xC5 -+ | QueryBlocReq t when t.QueryBloc.usesixtyfour -> 0xC5 -+ | BlocReq t when t.Bloc.usesixtyfour -> 0xC5 - | _ - -> 227 - in -@@ -1491,10 +1515,10 @@ - buf_int8 buf 77; - OtherLocations.write buf t - | QueryBlocReq t -> -- buf_int8 buf 71; -+ buf_int8 buf (if t.QueryBloc.usesixtyfour then 0xa3 else 71); - QueryBloc.write buf t - | BlocReq t -> -- buf_int8 buf 70; -+ buf_int8 buf (if t.Bloc.usesixtyfour then 0xa2 else 70); - Bloc.write buf t - | JoinQueueReq t -> - buf_int8 buf 84; -@@ -1517,9 +1541,9 @@ - | ReleaseSlotReq t -> - buf_int8 buf 86; - ReleaseSlot.write buf t -- | CloseSlotReq t -> -+ | OutOfPartsReq t -> - buf_int8 buf 87; -- CloseSlot.write buf t -+ OutOfParts.write buf t - | ViewFilesReq t -> - buf_int8 buf 74; - ViewFiles.write buf t -@@ -1578,13 +1602,9 @@ - | EmuleFileDescReq t -> - buf_int8 buf 0x61; - EmuleFileDesc.write buf t -- | EmuleCompressedPart (md4, statpos, newsize, bloc) -> -- buf_int8 buf 0x40; -- buf_md4 buf md4; -- buf_int64_32 buf statpos; -- buf_int64_32 buf newsize; -- Buffer.add_string buf bloc -- -+ | EmuleCompressedPart t -> -+ buf_int8 buf (if t.EmuleCompressedPart.usesixtyfour then 0xa1 else 0x40); -+ EmuleCompressedPart.write buf t - | EmuleMultiPacketReq (md4, list) -> - buf_int8 buf 0x92; - buf_md4 buf md4; -Index: src/networks/donkey/donkeyProtoCom.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyProtoCom.ml,v -retrieving revision 1.33 -retrieving revision 1.36 -diff -u -r1.33 -r1.36 ---- src/networks/donkey/donkeyProtoCom.ml 8 Oct 2006 14:20:22 -0000 1.33 -+++ src/networks/donkey/donkeyProtoCom.ml 8 Jan 2007 11:06:42 -0000 1.36 -@@ -79,14 +79,7 @@ - let client_send c m = - let emule_version = c.client_emule_proto in - if !verbose_msg_clients || c.client_debug then begin -- lprintf_nl "Sent to client[%d] %s(%s) %s" (client_num c) -- c.client_name (brand_to_string c.client_brand) -- (match c.client_kind with -- Indirect_address (server_ip, server_port, ip, port, real_ip) -> -- Printf.sprintf "[%s:%d]" (Ip.to_string (ip_of_id ip)) port -- | Direct_address (ip,port) -> Printf.sprintf "[%s:%d]" (Ip.to_string ip) port -- | Invalid_address _ -> "" -- ); -+ lprintf_nl "Sent to client %s" (full_client_identifier c); - DonkeyProtoClient.print m; - lprint_newline (); - end; -@@ -234,7 +227,8 @@ - if !verbose_share then lprintf_nl "tag_file: Sharing %s" name; - name - )):: -- (int64_tag Field_Size file.file_file.impl_file_size) :: -+ (int64_tag Field_Size_Hi (Int64.shift_right_logical file.file_file.impl_file_size 32)) :: -+ (int64_tag Field_Size (Int64.logand file.file_file.impl_file_size 0xffffffffL)) :: - ( - (match file.file_format with - FormatNotComputed next_time when -@@ -339,8 +333,8 @@ - str_int s 0 nfiles; - let s = String.sub s 0 prev_len in - if !verbose_share || !verbose then -- lprintf_nl "Sending %d share(s) to server %s:%d%s" -- nfiles (Ip.to_string (peer_ip sock)) (peer_port sock) -+ lprintf_nl "Sending %d share%s to server %s:%d%s" -+ nfiles (Printf2.print_plural_s nfiles) (Ip.to_string (peer_ip sock)) (peer_port sock) - (if compressed then " (zlib)" else ""); - Buffer.reset buf; - let s_c = -Index: src/networks/donkey/donkeyProtoKademlia.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyProtoKademlia.ml,v -retrieving revision 1.21 -retrieving revision 1.22 -diff -u -r1.21 -r1.22 ---- src/networks/donkey/donkeyProtoKademlia.ml 31 Oct 2006 15:42:48 -0000 1.21 -+++ src/networks/donkey/donkeyProtoKademlia.ml 3 Dec 2006 20:49:42 -0000 1.22 -@@ -45,15 +45,15 @@ - - let names_of_tag = - [ -- "\243", Field_UNKNOWN "encryption"; (* 0xF3 *) -- "\248", Field_UNKNOWN "buddyhash"; (* 0xF8 *) -- "\249", Field_UNKNOWN "clientlowid"; (* 0xF9 *) -- "\250", Field_UNKNOWN "serverport"; (* 0xFA *) -- "\251", Field_UNKNOWN "serverip"; (* 0xFB *) -- "\252", Field_UNKNOWN "sourceuport"; (* 0xFC *) -- "\253", Field_UNKNOWN "sourceport"; (* 0xFD *) -- "\254", Field_UNKNOWN "sourceip"; (* 0xFE *) -- "\255", Field_UNKNOWN "sourcetype"; (* 0xFF *) -+ "\243", Field_KNOWN "encryption"; (* 0xF3 *) -+ "\248", Field_KNOWN "buddyhash"; (* 0xF8 *) -+ "\249", Field_KNOWN "clientlowid"; (* 0xF9 *) -+ "\250", Field_KNOWN "serverport"; (* 0xFA *) -+ "\251", Field_KNOWN "serverip"; (* 0xFB *) -+ "\252", Field_KNOWN "sourceuport"; (* 0xFC *) -+ "\253", Field_KNOWN "sourceport"; (* 0xFD *) -+ "\254", Field_KNOWN "sourceip"; (* 0xFE *) -+ "\255", Field_KNOWN "sourcetype"; (* 0xFF *) - ] @ file_common_tags - - (* This fucking Emule implementation uses 4 32-bits integers instead of -@@ -248,17 +248,17 @@ - let peer_kind = ref 0 in - List.iter (fun tag -> - match tag.tag_name with -- Field_UNKNOWN "sourceport" -> -+ Field_KNOWN "sourceport" -> - for_int_tag tag (fun port -> - peer_tcpport := port) -- | Field_UNKNOWN "sourceuport" -> -+ | Field_KNOWN "sourceuport" -> - for_int_tag tag (fun port -> - peer_udpport := port) -- | Field_UNKNOWN "sourceip" -> -+ | Field_KNOWN "sourceip" -> - for_int64_tag tag (fun ip -> - peer_ip := Ip.of_int64 ip - ) -- | Field_UNKNOWN "sourcetype" -> -+ | Field_KNOWN "sourcetype" -> - for_int_tag tag (fun kind -> - peer_kind := 3) - | _ -> -@@ -333,7 +333,7 @@ - (_, first_tags) :: _ -> - let sources = ref false in - List.iter (fun tag -> -- if tag.tag_name = Field_UNKNOWN "sourceport" then sources := true; -+ if tag.tag_name = Field_KNOWN "sourceport" then sources := true; - ) first_tags; - if !sources then - let peers = get_peers_from_results Ip.null 0 answers in -@@ -359,7 +359,7 @@ - (_, first_tags) :: _ -> - let sources = ref false in - List.iter (fun tag -> -- if tag.tag_name = Field_UNKNOWN "sourceport" then sources := true; -+ if tag.tag_name = Field_KNOWN "sourceport" then sources := true; - ) first_tags; - if !sources then - let peers = get_peers_from_results ip port answers in -Index: src/networks/donkey/donkeyProtoOvernet.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyProtoOvernet.ml,v -retrieving revision 1.31 -retrieving revision 1.32 -diff -u -r1.31 -r1.32 ---- src/networks/donkey/donkeyProtoOvernet.ml 5 Nov 2006 14:13:51 -0000 1.31 -+++ src/networks/donkey/donkeyProtoOvernet.ml 3 Dec 2006 20:49:42 -0000 1.32 -@@ -40,7 +40,9 @@ - let lprintf_n fmt = - lprintf2 log_prefix fmt - -- let names_of_tag = file_common_tags -+ let names_of_tag = [ -+ "loc", Field_KNOWN "loc"; -+ ] @ file_common_tags - - let buf_peer buf p = - buf_md4 buf p.peer_md4; -@@ -187,7 +189,7 @@ - let peer_tcpport = ref 0 in - List.iter (fun tag -> - match tag.tag_name with -- Field_UNKNOWN "loc" -> -+ Field_KNOWN "loc" -> - for_string_tag tag (fun bcp -> - if !verbose_overnet then lprintf_nl "loc tag : [%s]" bcp; - if String2.starts_with bcp "bcp://" then -@@ -295,7 +297,7 @@ - let r_tags, pos = get_tags s 32 names_of_tag in - let sources = ref false in - List.iter (fun tag -> -- if tag.tag_name = Field_UNKNOWN "loc" then sources := true; -+ if tag.tag_name = Field_KNOWN "loc" then sources := true; - ) r_tags; - if !sources then - let peer = get_peer_from_result ip port r_md4 r_tags in -@@ -311,7 +313,7 @@ - let r_tags, pos = get_tags s 32 names_of_tag in - let sources = ref false in - List.iter (fun tag -> -- if tag.tag_name = Field_UNKNOWN "loc" then sources := true; -+ if tag.tag_name = Field_KNOWN "loc" then sources := true; - ) r_tags; - if !sources then - let peer = get_peer_from_result ip port r_md4 r_tags in -Index: src/networks/donkey/donkeyProtoServer.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyProtoServer.ml,v -retrieving revision 1.23 -retrieving revision 1.26 -diff -u -r1.23 -r1.26 ---- src/networks/donkey/donkeyProtoServer.ml 26 Nov 2006 16:36:29 -0000 1.23 -+++ src/networks/donkey/donkeyProtoServer.ml 6 Jan 2007 18:15:17 -0000 1.26 -@@ -28,31 +28,6 @@ - open DonkeyTypes - open DonkeyMftp - --(* --let field_of_tagname s = -- match s with -- | "size" -> Field_Size -- | "filename" -> Field_Filename -- | "Artist" -> Field_Artist -- | "Album" -> Field_Album -- | "Title" -> Field_Title -- | "format" -> Field_Format -- | "type" -> Field_Type -- | s -> Field_UNKNOWN s -- --let tagname_of_field field = -- match field with -- Field_Size -> "size" -- | Field_Filename -> "filename" -- | Field_Artist -> "Artist" -- | Field_Album -> "Album" -- | Field_Title -> "Title" -- | Field_Format -> "format" -- | Field_Type -> "type" -- | Field_Uid -> "uid" -- | Field_unknown s -> s --*) -- - module Connect = struct - type t = { - md4 : Md4.t; -@@ -63,10 +38,10 @@ - - let names_of_tag = - [ -- "\001", Field_UNKNOWN "name"; (* CT_NAME 0x01 *) -- "\017", Field_UNKNOWN "version"; (* CT_VERSION 0x11 *) -- "\032", Field_UNKNOWN "extended"; (* CT_SERVER_FLAGS 0x20 *) -- "\251", Field_UNKNOWN "emule_version"; (* CT_EMULE_VERSION 0xfb *) -+ "\001", Field_KNOWN "name"; (* CT_NAME 0x01 *) -+ "\017", Field_KNOWN "version"; (* CT_VERSION 0x11 *) -+ "\032", Field_KNOWN "extended"; (* CT_SERVER_FLAGS 0x20 *) -+ "\251", Field_KNOWN "emule_version"; (* CT_EMULE_VERSION 0xfb *) - ] - - let parse len s = -@@ -388,8 +363,8 @@ - - let names_of_tag = - [ -- "\001", Field_UNKNOWN "name"; -- "\011", Field_UNKNOWN "description"; -+ "\001", Field_KNOWN "name"; -+ "\011", Field_KNOWN "description"; - ] - - let parse len s = -@@ -760,9 +735,9 @@ - - let names_of_tag = - [ -- "\001", Field_UNKNOWN "name"; -- "\017", Field_UNKNOWN "version"; -- "\015", Field_UNKNOWN "port"; -+ "\001", Field_KNOWN "name"; -+ "\017", Field_KNOWN "version"; -+ "\015", Field_KNOWN "port"; - ] - - let rec parse_clients s pos nclients left = -@@ -833,7 +808,13 @@ - Printf.bprintf oc "QUERY LOCATION OF %s [%Ld]\n" (Md4.to_string t.md4) t.size - - let write buf t = -- buf_md4 buf t.md4; buf_int64_32 buf t.size -+ buf_md4 buf t.md4; -+ if t.size > old_max_emule_file_size then -+ begin -+ buf_int64_32 buf 0L; buf_int64 buf t.size -+ end -+ else -+ buf_int64_32 buf t.size - end - - module QueryLocationReply = struct -Index: src/networks/donkey/donkeyProtoUdp.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyProtoUdp.ml,v -retrieving revision 1.16 -retrieving revision 1.17 -diff -u -r1.16 -r1.17 ---- src/networks/donkey/donkeyProtoUdp.ml 26 Nov 2006 16:36:29 -0000 1.16 -+++ src/networks/donkey/donkeyProtoUdp.ml 3 Dec 2006 20:49:42 -0000 1.17 -@@ -233,22 +233,22 @@ - } - - let names_of_tag = [ -- "\001", Field_UNKNOWN "servername"; -- "\011", Field_UNKNOWN "description"; -- "\012", Field_UNKNOWN "ping"; -- "\013", Field_UNKNOWN "fail"; -- "\014", Field_UNKNOWN "preference"; -- "\015", Field_UNKNOWN "port"; -- "\016", Field_UNKNOWN "ip"; -- "\133", Field_UNKNOWN "dynip"; -- "\135", Field_UNKNOWN "maxusers"; -- "\136", Field_UNKNOWN "softfiles"; -- "\137", Field_UNKNOWN "hardfiles"; -- "\144", Field_UNKNOWN "lastping"; -- "\145", Field_UNKNOWN "version"; -- "\146", Field_UNKNOWN "udpflags"; -- "\147", Field_UNKNOWN "auxportslist"; -- "\148", Field_UNKNOWN "lowidusers"; -+ "\001", Field_KNOWN "servername"; -+ "\011", Field_KNOWN "description"; -+ "\012", Field_KNOWN "ping"; -+ "\013", Field_KNOWN "fail"; -+ "\014", Field_KNOWN "preference"; -+ "\015", Field_KNOWN "port"; -+ "\016", Field_KNOWN "ip"; -+ "\133", Field_KNOWN "dynip"; -+ "\135", Field_KNOWN "maxusers"; -+ "\136", Field_KNOWN "softfiles"; -+ "\137", Field_KNOWN "hardfiles"; -+ "\144", Field_KNOWN "lastping"; -+ "\145", Field_KNOWN "version"; -+ "\146", Field_KNOWN "udpflags"; -+ "\147", Field_KNOWN "auxportslist"; -+ "\148", Field_KNOWN "lowidusers"; - ] - - let parse1 len s challenge = -@@ -267,9 +267,9 @@ - let desc = ref "" in - List.iter (fun tag -> - match tag with -- | { tag_name = Field_UNKNOWN "servername"; tag_value = String v } -> -+ | { tag_name = Field_KNOWN "servername"; tag_value = String v } -> - name := v -- | { tag_name = Field_UNKNOWN "description"; tag_value = String v } -> -+ | { tag_name = Field_KNOWN "description"; tag_value = String v } -> - desc := v - | _ -> () - ) stags; -Index: src/networks/donkey/donkeyServers.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyServers.ml,v -retrieving revision 1.68 -retrieving revision 1.69 -diff -u -r1.68 -r1.69 ---- src/networks/donkey/donkeyServers.ml 26 Nov 2006 16:36:29 -0000 1.68 -+++ src/networks/donkey/donkeyServers.ml 3 Dec 2006 20:49:42 -0000 1.69 -@@ -399,9 +399,9 @@ - List.iter ( - fun tag -> - match tag with -- { tag_name = Field_UNKNOWN "name"; tag_value = String name } -> -+ { tag_name = Field_KNOWN "name"; tag_value = String name } -> - s.server_name <- name -- | { tag_name = Field_UNKNOWN "description"; tag_value = String desc } -> -+ | { tag_name = Field_KNOWN "description"; tag_value = String desc } -> - s.server_description <- desc - | _ -> lprintf_nl "parsing donkeyServers.ServerInfo, unknown field %s" (string_of_tag tag) - ) s.server_tags -@@ -504,7 +504,7 @@ - user_add user_impl; - List.iter (fun tag -> - match tag with -- { tag_name = Field_UNKNOWN "name"; tag_value = String s } -> -+ { tag_name = Field_KNOWN "name"; tag_value = String s } -> - user.user_name <- s - | _ -> () - ) user.user_tags; -Index: src/networks/donkey/donkeyShare.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyShare.ml,v -retrieving revision 1.55 -retrieving revision 1.58 -diff -u -r1.55 -r1.58 ---- src/networks/donkey/donkeyShare.ml 9 Oct 2006 16:17:19 -0000 1.55 -+++ src/networks/donkey/donkeyShare.ml 28 Jan 2007 20:26:46 -0000 1.58 -@@ -44,12 +44,7 @@ - | Some _ -> () - | None -> - let full_name = file_disk_name file in -- let magic = -- match Magic.M.magic_fileinfo full_name false with -- None -> None -- | Some magic -> Some (intern magic) -- in -- -+ check_magic (as_file file); - let impl = { - impl_shared_update = 1; - impl_shared_fullname = full_name; -@@ -61,7 +56,7 @@ - impl_shared_ops = shared_ops; - impl_shared_val = file; - impl_shared_requests = 0; -- impl_shared_magic = magic; -+ impl_shared_file = Some (as_file file); - impl_shared_servers = [] - } in - file.file_shared <- Some impl; -@@ -189,12 +184,17 @@ - build a list of files_to_send with yet unpublished files *) - begin - let files_to_send = ref [] in -+ let can_publish f = not (file_is_largefile f && not s.server_has_largefiles) in - List.iter (fun f -> - match f.file_shared with - Some impl -> - if not (List.mem (CommonServer.as_server s.server_server) impl.impl_shared_servers) -- && List.length !files_to_send < !!max_published_files then -+ && List.length !files_to_send < !!max_published_files && can_publish f then - files_to_send := f :: !files_to_send -+ else -+ if not (can_publish f) then -+ lprintf_nl "Can not publish largefile %s because server %s does not support largefiles" -+ (file_best_name f) (string_of_server s) - | _ -> () (* this case never happens *) - ) all_shared; - -@@ -221,7 +221,7 @@ - - end - end -- ) (connected_servers ()); -+ ) (logged_in_servers ()); - - (* - The problem: sh.shared_fd might be closed during the execution of the -@@ -333,12 +333,6 @@ - let found = ref false in - List.iter (fun sh -> if sh.shared_name = fullname then found := true) !shared_files; - if not !found then begin -- let magic = -- match Magic.M.magic_fileinfo fullname false with -- None -> None -- | Some magic -> Some (intern magic) -- in -- - let rec impl = { - impl_shared_update = 1; - impl_shared_fullname = fullname; -@@ -350,7 +344,7 @@ - impl_shared_id = Md4.null; - impl_shared_val = pre_shared; - impl_shared_requests = 0; -- impl_shared_magic = magic; -+ impl_shared_file = None; - impl_shared_servers = []; - } and - pre_shared = { -Index: src/networks/donkey/donkeyStats.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyStats.ml,v -retrieving revision 1.25 -retrieving revision 1.26 -diff -u -r1.25 -r1.26 ---- src/networks/donkey/donkeyStats.ml 23 Sep 2006 20:29:47 -0000 1.25 -+++ src/networks/donkey/donkeyStats.ml 2 Dec 2006 12:35:46 -0000 1.26 -@@ -85,7 +85,8 @@ - !!gstats_mod_array.(i).brand_download <- !!gstats_mod_array.(i).brand_download ++ v; - end; - -- c.client_downloaded <- c.client_downloaded ++ v; -+ c.client_total_downloaded <- c.client_total_downloaded ++ v; -+ c.client_session_downloaded <- c.client_session_downloaded ++ v; - donkey_download_counter := !donkey_download_counter ++ v; - global_count_download network v - -@@ -100,7 +101,8 @@ - !!gstats_mod_array.(i).brand_upload <- !!gstats_mod_array.(i).brand_upload ++ v; - end; - -- c.client_uploaded <- c.client_uploaded ++ v; -+ c.client_total_uploaded <- c.client_total_uploaded ++ v; -+ c.client_session_uploaded <- c.client_session_uploaded ++ v; - donkey_upload_counter := !donkey_upload_counter ++ v; - global_count_upload network v - -Index: src/networks/donkey/donkeyTypes.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyTypes.ml,v -retrieving revision 1.52 -retrieving revision 1.59 -diff -u -r1.52 -r1.59 ---- src/networks/donkey/donkeyTypes.ml 26 Nov 2006 16:36:29 -0000 1.52 -+++ src/networks/donkey/donkeyTypes.ml 15 Jan 2007 21:32:56 -0000 1.59 -@@ -32,21 +32,37 @@ - let lprintf_n fmt = - lprintf2 log_prefix fmt - -+exception Donkey_large_file -+ - type emule_proto = { -- mutable emule_comments : int; - mutable emule_version : int; - mutable emule_release : string; -- mutable emule_secident : int; -- mutable emule_noviewshared : int; -- mutable emule_supportpreview : int; - mutable emule_osinfosupport : int; -+ mutable emule_features : int; - -+(* emule_miscoptions1 *) -+ mutable received_miscoptions1 : bool; -+ mutable emule_aich : int; -+ mutable emule_unicode : int; -+ mutable emule_udpver : int; - mutable emule_compression : int; -+ mutable emule_secident : int; - mutable emule_sourceexchange : int; -- mutable emule_multipacket : int; - mutable emule_extendedrequest : int; -- mutable emule_features : int; -- mutable emule_udpver : int; -+ mutable emule_comments : int; -+ mutable emule_peercache : int; -+ mutable emule_noviewshared : int; -+ mutable emule_multipacket : int; -+ mutable emule_supportpreview : int; -+ -+(* emule_miscoptions2 *) -+ mutable received_miscoptions2 : bool; -+ mutable emule_require_crypt : int; -+ mutable emule_request_crypt : int; -+ mutable emule_support_crypt : int; -+ mutable emule_extmultipacket : int; -+ mutable emule_largefiles : int; -+ mutable emule_kad_version : int; - } - - type emule_tag_name = -@@ -69,15 +85,6 @@ - mutable nwarnings : int; - } - --type client_score = -- Client_not_connected --| Client_has_file --| Client_has_priority_file --| Client_has_chunk --| Client_has_priority_chunk --| Client_has_upload --| Client_has_priority_upload -- - type reliability = - Reliability_neutral - | Reliability_reliable -@@ -100,6 +107,7 @@ - | Brand_emuleplus - | Brand_hydranode - | Brand_verycd -+| Brand_imp - - let brand_list = [ - ( Brand_unknown , "unknown" , "unk" ) ; -@@ -118,6 +126,7 @@ - ( Brand_emuleplus , "ePlus" , "eM+" ) ; - ( Brand_hydranode , "Hydra" , "Hyd" ) ; - ( Brand_verycd , "VeryCD" , "VCD" ) ; -+ ( Brand_imp , "IMPmule" , "IMP" ) ; - ] - - let brand_count = List.length brand_list -@@ -557,20 +566,19 @@ - mutable client_checked : bool; - mutable client_connected : bool; - (* statistics *) -- mutable client_downloaded : Int64.t; -- mutable client_uploaded : Int64.t; -+ mutable client_session_downloaded : Int64.t; -+ mutable client_session_uploaded : Int64.t; -+ mutable client_total_downloaded : Int64.t; -+ mutable client_total_uploaded : Int64.t; - mutable client_brand : brand; - mutable client_brand_mod : brand_mod; - mutable client_osinfo_sent : bool; - mutable client_osinfo : string option; - mutable client_banned : bool; -- mutable client_score : int; -- mutable client_next_queue : int; - mutable client_rank : int; - mutable client_connect_time : int; - mutable client_requests_received : int; - mutable client_requests_sent: int; -- mutable client_indirect_address : (Ip.t * Ip.t * int) option; - mutable client_slot : slot_status; - mutable client_debug : bool; - mutable client_pending_messages: string list; -@@ -602,6 +610,10 @@ - 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_current : int64; -+ mutable up_finish : bool; - mutable up_waiting : bool; - } - -@@ -688,21 +700,41 @@ - CommonServer.server_state (as_server server.server_server) - - let dummy_emule_proto = { -- emule_comments = 0; - emule_version = 0; - emule_release = ""; -- emule_secident = 0; -- emule_noviewshared = 0; -- emule_supportpreview = 0; - emule_osinfosupport = 0; -+ emule_features = 0; - -+(* emule_miscoptions1 *) -+ received_miscoptions1 = false; -+ emule_aich = 0; -+ emule_unicode = 0; -+ emule_udpver = 0; - emule_compression = 0; (* 1 *) -+ emule_secident = 0; - emule_sourceexchange = 0; (* 3 *) -- emule_multipacket = 0; (* 1 *) - emule_extendedrequest = 0; (* 2 *) -- emule_features = 0; (* 3 *) -- emule_udpver = 0; (* 4 *) -+ emule_comments = 0; -+ emule_peercache = 0; -+ emule_noviewshared = 0; -+ emule_multipacket = 0; -+ emule_supportpreview = 0; -+ -+(* emule_miscoptions2 *) -+ received_miscoptions2 = false; -+ emule_require_crypt = 0; -+ emule_request_crypt = 0; -+ emule_support_crypt = 0; -+ emule_extmultipacket = 0; -+ emule_largefiles = 0; -+ emule_kad_version = 0; - } - - let emule_proto () = - { dummy_emule_proto with emule_version = 0 } -+ -+let old_max_emule_file_size = 4290048000L -+(* #define OLD_MAX_EMULE_FILE_SIZE 4290048000ui64 // (4294967295/PARTSIZE)*PARTSIZE = ~4GB *) -+ -+let max_emule_file_size = 0x4000000000L -+(* #define MAX_EMULE_FILE_SIZE 0x4000000000ui64 // = 2^38 = 256GB *) -Index: src/networks/donkey/donkeyUdp.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyUdp.ml,v -retrieving revision 1.26 -retrieving revision 1.27 -diff -u -r1.26 -r1.27 ---- src/networks/donkey/donkeyUdp.ml 26 Nov 2006 16:36:29 -0000 1.26 -+++ src/networks/donkey/donkeyUdp.ml 3 Dec 2006 20:49:42 -0000 1.27 -@@ -322,12 +322,12 @@ - s.server_udp_desc_challenge <- None; - List.iter (fun tag -> - match tag with -- { tag_name = Field_UNKNOWN "version"; tag_value = Uint64 i } -> -+ { tag_name = Field_KNOWN "version"; tag_value = Uint64 i } -> - let i = Int64.to_int i in - s.server_version <- Printf.sprintf "%d.%d" (i lsr 16) (i land 0xFFFF); -- | { tag_name = Field_UNKNOWN "auxportslist" ; tag_value = String aux } -> -+ | { tag_name = Field_KNOWN "auxportslist" ; tag_value = String aux } -> - s.server_auxportslist <- aux -- | { tag_name = Field_UNKNOWN "dynip" ; tag_value = String dynip } -> -+ | { tag_name = Field_KNOWN "dynip" ; tag_value = String dynip } -> - s.server_dynip <- dynip - | _ -> () - ) t.M.tags; -Index: src/networks/fasttrack/fasttrackNetwork.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fasttrack/fasttrackNetwork.ml,v -retrieving revision 1.2 -retrieving revision 1.3 -diff -u -r1.2 -r1.3 ---- src/networks/fasttrack/fasttrackNetwork.ml 7 Aug 2005 12:57:22 -0000 1.2 -+++ src/networks/fasttrack/fasttrackNetwork.ml 3 Dec 2006 20:49:42 -0000 1.3 -@@ -34,30 +34,30 @@ - (* any = 0 *) - let name_of_tag = - [ -- Field_UNKNOWN "any", 0; -- Field_UNKNOWN "year", 1; -+ Field_KNOWN "any", 0; -+ Field_KNOWN "year", 1; - Field_Filename, 2; - Field_Uid, 3; - Field_Title, 4; -- Field_UNKNOWN "time", 5; -+ Field_KNOWN "time", 5; - Field_Artist, 6; - Field_Album, 8; -- Field_UNKNOWN "language", 0x0A; -- Field_UNKNOWN "keywords", 0x0C; -- Field_UNKNOWN "resolution", 0x0D; -- Field_UNKNOWN "genre", 0x0E; -- Field_UNKNOWN "OS", 0x10; -- Field_UNKNOWN "bitdepth", 0x11; -+ Field_KNOWN "language", 0x0A; -+ Field_KNOWN "keywords", 0x0C; -+ Field_KNOWN "resolution", 0x0D; -+ Field_KNOWN "genre", 0x0E; -+ Field_KNOWN "OS", 0x10; -+ Field_KNOWN "bitdepth", 0x11; - Field_Type, 0x12; -- Field_UNKNOWN "quality", 0x15; -- Field_UNKNOWN "version", 0x18; -- Field_UNKNOWN "comment", 0x1A; -+ Field_KNOWN "quality", 0x15; -+ Field_KNOWN "version", 0x18; -+ Field_KNOWN "comment", 0x1A; - Field_Codec, 0x1C; (* "divx" *) -- Field_UNKNOWN "rating", 0x1D; -+ Field_KNOWN "rating", 0x1D; - Field_Size, 0x21; - Field_Type, 0x22; (* "movie", "video clip",... *) -- Field_UNKNOWN "49", 49; -- Field_UNKNOWN "53", 53; -+ Field_KNOWN "49", 49; -+ Field_KNOWN "53", 53; - ] - - type cipher -Index: src/networks/fasttrack/fasttrackProto.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fasttrack/fasttrackProto.ml,v -retrieving revision 1.17 -retrieving revision 1.19 -diff -u -r1.17 -r1.19 ---- src/networks/fasttrack/fasttrackProto.ml 28 Aug 2006 18:19:16 -0000 1.17 -+++ src/networks/fasttrack/fasttrackProto.ml 6 Jan 2007 18:15:17 -0000 1.19 -@@ -108,30 +108,30 @@ - - let tag_of_tag tag s = - match tag with -- | Field_UNKNOWN "any" -+ | Field_KNOWN "any" - | Field_Filename - | Field_Uid - | Field_Title -- | Field_UNKNOWN "time" -+ | Field_KNOWN "time" - | Field_Artist - | Field_Album -- | Field_UNKNOWN "language" -- | Field_UNKNOWN "keywords" -- | Field_UNKNOWN "genre" -- | Field_UNKNOWN "OS" -+ | Field_KNOWN "language" -+ | Field_KNOWN "keywords" -+ | Field_KNOWN "genre" -+ | Field_KNOWN "OS" - | Field_Type -- | Field_UNKNOWN "version" -- | Field_UNKNOWN "comment" -+ | Field_KNOWN "version" -+ | Field_KNOWN "comment" - | Field_Codec -> - string_tag tag s -- | Field_UNKNOWN "bitdepth" -- | Field_UNKNOWN "year" -- | Field_UNKNOWN "rating" -- | Field_UNKNOWN "quality" -+ | Field_KNOWN "bitdepth" -+ | Field_KNOWN "year" -+ | Field_KNOWN "rating" -+ | Field_KNOWN "quality" - | Field_Size -> - let s, _ = get_dynint s 0 in - int64_tag tag s -- | Field_UNKNOWN "resolution" -> -+ | Field_KNOWN "resolution" -> - let n1, pos = get_dynint s 0 in - let n2, pos = get_dynint s pos in - { tag_name = tag; tag_value = Pair (n1, n2) } -@@ -145,7 +145,9 @@ - | Field_Lastseencomplete - | Field_Mediacodec - | Field_Medialength -- | Field_UNKNOWN _ -> -+ | Field_Size_Hi -+ | Field_UNKNOWN _ -+ | Field_KNOWN _ -> - string_tag tag s - - -@@ -433,7 +435,7 @@ - - let tags = - if words <> "" then -- (Substring, string_tag (Field_UNKNOWN "any") words) :: tags -+ (Substring, string_tag (Field_KNOWN "any") words) :: tags - else tags in - buf_int8 b (List.length tags); - -@@ -458,7 +460,7 @@ - buf_int8 b ( - try List.assoc tag name_of_tag with - _ -> match tag with -- Field_UNKNOWN n -> int_of_string n -+ Field_KNOWN n -> int_of_string n - | _ -> assert false); - buf_string b s; - ) tags; -@@ -869,7 +871,7 @@ - let tag = try - List2.assoc_inv tag name_of_tag - with _ -> -- Field_UNKNOWN (string_of_int tag) -+ Field_KNOWN (string_of_int tag) - in - iter_tags (pos + tag_len) (n-1) - ((new_tag tag tagdata) :: tags) -@@ -916,7 +918,7 @@ - List2.assoc_inv tag name_of_tag - with Not_found -> - lprintf "WARNING Unknown tag %d\n" tag; -- Field_UNKNOWN (string_of_int tag) -+ Field_KNOWN (string_of_int tag) - in - let v, pos = get_string m (pos+2) in - let tag = tag_of_tag tag v in -@@ -1939,6 +1941,7 @@ - | Field_Artist - | Field_Title - | Field_Codec -+ | Field_KNOWN _ - | Field_UNKNOWN _ - | Field_Filename -> - tags := (Substring, string_tag field w) :: !tags -@@ -1951,20 +1954,21 @@ - | Field_Lastseencomplete - | Field_Mediacodec - | Field_Medialength -+ | Field_Size_Hi - | Field_Size -> () - end - | QHasMinVal (field, value) -> - begin - match field with - | Field_Size -- | Field_UNKNOWN _ -+ | Field_KNOWN _ - -> tags := (AtLeast, int64_tag field value) :: !tags - | _ -> () - end - | QHasMaxVal (field, value) -> - begin - match field with -- | Field_UNKNOWN _ -+ | Field_KNOWN _ - | Field_Size -> - tags := (AtMost, int64_tag field value) :: !tags - | _ -> () -Index: src/networks/fileTP/fileTPClients.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fileTP/fileTPClients.ml,v -retrieving revision 1.23 -retrieving revision 1.24 -diff -u -r1.23 -r1.24 ---- src/networks/fileTP/fileTPClients.ml 19 Sep 2006 17:07:43 -0000 1.23 -+++ src/networks/fileTP/fileTPClients.ml 2 Dec 2006 12:35:46 -0000 1.24 -@@ -74,6 +74,7 @@ - if !verbose_msg_clients then - lprintf_nl "Disconnected from source"; - c.client_requests <- []; -+ c.client_session_downloaded <- 0L; - connection_failed c.client_connection_control; - set_client_disconnected c r; - close sock r; -Index: src/networks/fileTP/fileTPFTP.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fileTP/fileTPFTP.ml,v -retrieving revision 1.14 -retrieving revision 1.15 -diff -u -r1.14 -r1.15 ---- src/networks/fileTP/fileTPFTP.ml 19 Sep 2006 17:07:43 -0000 1.14 -+++ src/networks/fileTP/fileTPFTP.ml 2 Dec 2006 12:35:46 -0000 1.15 -@@ -108,7 +108,8 @@ - CommonSwarming.received up !counter_pos b.buf b.pos to_read_int; - let new_downloaded = CommonSwarming.downloaded swarmer in - -- c.client_downloaded <- c.client_downloaded ++ (new_downloaded -- old_downloaded); -+ c.client_total_downloaded <- c.client_total_downloaded ++ (new_downloaded -- old_downloaded); -+ c.client_session_downloaded <- c.client_session_downloaded ++ (new_downloaded -- old_downloaded); - client_must_update (as_client c); - - if new_downloaded = file_size file then -Index: src/networks/fileTP/fileTPGlobals.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fileTP/fileTPGlobals.ml,v -retrieving revision 1.30 -retrieving revision 1.31 -diff -u -r1.30 -r1.31 ---- src/networks/fileTP/fileTPGlobals.ml 9 Nov 2006 21:32:27 -0000 1.30 -+++ src/networks/fileTP/fileTPGlobals.ml 2 Dec 2006 12:35:46 -0000 1.31 -@@ -192,7 +192,8 @@ - client_hostname = hostname; - client_referer = referer; - client_port = port; -- client_downloaded = zero; -+ client_total_downloaded = zero; -+ client_session_downloaded = zero; - client_reconnect = false; - client_in_queues = []; - client_connected_for = None; -Index: src/networks/fileTP/fileTPHTTP.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fileTP/fileTPHTTP.ml,v -retrieving revision 1.26 -retrieving revision 1.27 -diff -u -r1.26 -r1.27 ---- src/networks/fileTP/fileTPHTTP.ml 19 Sep 2006 17:07:43 -0000 1.26 -+++ src/networks/fileTP/fileTPHTTP.ml 2 Dec 2006 12:35:46 -0000 1.27 -@@ -288,7 +288,8 @@ - CommonSwarming.received up !counter_pos b.buf b.pos to_read_int; - let new_downloaded = CommonSwarming.downloaded swarmer in - -- c.client_downloaded <- c.client_downloaded ++ (new_downloaded -- old_downloaded); -+ c.client_total_downloaded <- c.client_total_downloaded ++ (new_downloaded -- old_downloaded); -+ c.client_session_downloaded <- c.client_session_downloaded ++ (new_downloaded -- old_downloaded); - client_must_update (as_client c); - - if new_downloaded = file_size file then -Index: src/networks/fileTP/fileTPInteractive.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fileTP/fileTPInteractive.ml,v -retrieving revision 1.52 -retrieving revision 1.53 -diff -u -r1.52 -r1.53 ---- src/networks/fileTP/fileTPInteractive.ml 12 Nov 2006 12:44:24 -0000 1.52 -+++ src/networks/fileTP/fileTPInteractive.ml 2 Dec 2006 12:35:46 -0000 1.53 -@@ -123,7 +123,8 @@ - P.client_num = (client_num (as_client c)); - P.client_connect_time = BasicSocket.last_time (); - P.client_software = c.client_software; -- P.client_downloaded = c.client_downloaded; -+ P.client_total_downloaded = c.client_total_downloaded; -+ P.client_session_downloaded = c.client_session_downloaded; - } - ); - client_ops.op_client_bprint <- (fun c buf -> -@@ -141,8 +142,8 @@ - client_print cc o; - Printf.bprintf buf "client: %s downloaded: %s uploaded: %s" - cinfo.GuiTypes.client_software -- (Int64.to_string cinfo.GuiTypes.client_downloaded) -- (Int64.to_string cinfo.GuiTypes.client_uploaded); -+ (Int64.to_string cinfo.GuiTypes.client_total_downloaded) -+ (Int64.to_string cinfo.GuiTypes.client_total_uploaded); - Printf.bprintf buf "\nfilename: %s\n\n" info.GuiTypes.file_name; - ); - client_ops.op_client_dprint_html <- (fun c o file str -> -@@ -183,8 +184,10 @@ - ("", "sr", "N"); - ("", "sr", Printf.sprintf "%s:%d" (Ip.to_string client_ip) client_port); - ] @ (if !Geoip.active then [(cname, "sr", ccode)] else []) @ [ -- ("", "sr ar", (size_of_int64 cinfo.GuiTypes.client_uploaded)); -- ("", "sr ar", (size_of_int64 cinfo.GuiTypes.client_downloaded)); -+ ("", "sr ar", (size_of_int64 cinfo.GuiTypes.client_total_uploaded)); -+ ("", "sr ar", (size_of_int64 cinfo.GuiTypes.client_total_downloaded)); -+ ("", "sr ar", (size_of_int64 cinfo.GuiTypes.client_session_uploaded)); -+ ("", "sr ar", (size_of_int64 cinfo.GuiTypes.client_session_downloaded)); - ("", "sr", info.GuiTypes.file_name); ]); - true - ) -Index: src/networks/fileTP/fileTPOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fileTP/fileTPOptions.ml,v -retrieving revision 1.11 -retrieving revision 1.12 -diff -u -r1.11 -r1.12 ---- src/networks/fileTP/fileTPOptions.ml 30 May 2006 10:54:14 -0000 1.11 -+++ src/networks/fileTP/fileTPOptions.ml 15 Jan 2007 18:26:27 -0000 1.12 -@@ -55,6 +55,7 @@ - string_option "range" - - let options_version = define_option fileTP_section ["options_version"] -+ ~internal: true - "(internal option)" - int_option 0 - -Index: src/networks/fileTP/fileTPSSH.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fileTP/fileTPSSH.ml,v -retrieving revision 1.10 -retrieving revision 1.11 -diff -u -r1.10 -r1.11 ---- src/networks/fileTP/fileTPSSH.ml 30 May 2006 10:54:14 -0000 1.10 -+++ src/networks/fileTP/fileTPSSH.ml 2 Dec 2006 12:35:46 -0000 1.11 -@@ -103,7 +103,8 @@ - let new_downloaded = - CommonSwarming.downloaded swarmer in - -- c.client_downloaded <- c.client_downloaded ++ (new_downloaded -- old_downloaded); -+ c.client_session_downloaded <- c.client_session_downloaded ++ (new_downloaded -- old_downloaded); -+ c.client_total_downloaded <- c.client_total_downloaded ++ (new_downloaded -- old_downloaded); - client_must_update (as_client c); - - if new_downloaded = file_size file then -Index: src/networks/fileTP/fileTPTypes.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fileTP/fileTPTypes.ml,v -retrieving revision 1.13 -retrieving revision 1.14 -diff -u -r1.13 -r1.14 ---- src/networks/fileTP/fileTPTypes.ml 1 Sep 2006 16:22:15 -0000 1.13 -+++ src/networks/fileTP/fileTPTypes.ml 2 Dec 2006 12:35:46 -0000 1.14 -@@ -32,7 +32,8 @@ - mutable client_referer : string; - mutable client_downloads : download list; - mutable client_in_queues : file list; -- mutable client_downloaded : int64; -+ mutable client_total_downloaded : int64; -+ mutable client_session_downloaded : int64; - mutable client_connection_control : connection_control; - mutable client_sock : tcp_connection; - mutable client_requests : download list; -Index: src/networks/gnutella/gnutellaInteractive.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/gnutella/gnutellaInteractive.ml,v -retrieving revision 1.67 -retrieving revision 1.68 -diff -u -r1.67 -r1.68 ---- src/networks/gnutella/gnutellaInteractive.ml 12 Nov 2006 12:44:24 -0000 1.67 -+++ src/networks/gnutella/gnutellaInteractive.ml 2 Dec 2006 12:35:46 -0000 1.68 -@@ -442,8 +442,8 @@ - client_print cc o; - Printf.bprintf buf "client: %s downloaded: %s uploaded: %s" - "gN" (* cinfo.GuiTypes.client_software *) -- (Int64.to_string cinfo.GuiTypes.client_downloaded) -- (Int64.to_string cinfo.GuiTypes.client_uploaded); -+ (Int64.to_string cinfo.GuiTypes.client_total_downloaded) -+ (Int64.to_string cinfo.GuiTypes.client_total_uploaded); - Printf.bprintf buf "\nfilename: %s\n\n" info.GuiTypes.file_name; - ); - client_ops.op_client_dprint_html <- (fun c o file str -> -@@ -477,8 +477,10 @@ - ("", "sr", "N"); - ("", "sr", (string_of_kind cinfo.GuiTypes.client_kind)); - ] @ (if !Geoip.active then [("?", "sr", "?")] else []) @ [ -- ("", "sr ar", (size_of_int64 cinfo.GuiTypes.client_uploaded)); -- ("", "sr ar", (size_of_int64 cinfo.GuiTypes.client_downloaded)); -+ ("", "sr ar", (size_of_int64 cinfo.GuiTypes.client_total_uploaded)); -+ ("", "sr ar", (size_of_int64 cinfo.GuiTypes.client_total_downloaded)); -+ ("", "sr ar", (size_of_int64 cinfo.GuiTypes.client_session_uploaded)); -+ ("", "sr ar", (size_of_int64 cinfo.GuiTypes.client_session_downloaded)); - ("", "sr", info.GuiTypes.file_name); ]); - true - ) -Index: src/networks/gnutella/gnutellaOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/gnutella/gnutellaOptions.ml,v -retrieving revision 1.20 -retrieving revision 1.21 -diff -u -r1.20 -r1.21 ---- src/networks/gnutella/gnutellaOptions.ml 12 May 2006 21:02:38 -0000 1.20 -+++ src/networks/gnutella/gnutellaOptions.ml 15 Jan 2007 18:26:27 -0000 1.21 -@@ -37,6 +37,7 @@ - if !!max_ultrapeers > 10 then max_ultrapeers =:= 10) - - let client_port = define_option gnutella_section ["client_port"] -+ ~restart: true - "The port to bind the client to" - int_option GnutellaNetwork.port - -@@ -155,6 +156,7 @@ - string_option "" - - let options_version = define_option gnutella_section ["options_version"] -+ ~internal: true - "(internal option)" - int_option 0 - -Index: src/networks/openFT/openFTOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/openFT/openFTOptions.ml,v -retrieving revision 1.4 -retrieving revision 1.5 -diff -u -r1.4 -r1.5 ---- src/networks/openFT/openFTOptions.ml 5 Nov 2005 16:23:41 -0000 1.4 -+++ src/networks/openFT/openFTOptions.ml 15 Jan 2007 18:26:27 -0000 1.5 -@@ -27,10 +27,12 @@ - int_option 5 - - let port = define_option openft_ini ["client_port"] -+ ~restart: true - "The port to bind the client to" - int_option 1215 - - let http_port = define_option openft_ini ["http_port"] -+ ~restart: true - "The port to bind the client to for downloads" - int_option 1216 - -@@ -43,6 +45,7 @@ - int_option 20 - - let options_version = define_option openft_ini ["options_version"] -+ ~internal: true - "(internal option)" - int_option 0 - -Index: src/networks/opennap/opennapInteractive.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/opennap/opennapInteractive.ml,v -retrieving revision 1.26 -retrieving revision 1.27 -diff -u -r1.26 -r1.27 ---- src/networks/opennap/opennapInteractive.ml 1 Oct 2006 17:54:00 -0000 1.26 -+++ src/networks/opennap/opennapInteractive.ml 3 Dec 2006 20:49:42 -0000 1.27 -@@ -78,7 +78,7 @@ - | QHasMinVal (field, value) -> - begin - match field with -- Field_UNKNOWN "bitrate" -> -+ Field_KNOWN "bitrate" -> - { t with S.bitrate = Some (Int64.to_int value, OP.AtLeast) }; - | Field_Size -> t - | _ -> t -@@ -86,7 +86,7 @@ - | QHasMaxVal (field, value) -> - begin - match field with -- Field_UNKNOWN "bitrate" -> -+ Field_KNOWN "bitrate" -> - { t with S.bitrate = Some (Int64.to_int value, OP.AtBest) }; - | Field_Size -> t - | _ -> t -Index: src/networks/opennap/opennapOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/opennap/opennapOptions.ml,v -retrieving revision 1.11 -retrieving revision 1.12 -diff -u -r1.11 -r1.12 ---- src/networks/opennap/opennapOptions.ml 5 Nov 2005 16:23:41 -0000 1.11 -+++ src/networks/opennap/opennapOptions.ml 15 Jan 2007 18:26:27 -0000 1.12 -@@ -27,6 +27,7 @@ - let opennap_section = file_section opennap_ini ["Opennap"] "Opennap options" - - let client_port = define_option opennap_section ["client_port"] -+ ~restart: true - "The port to bind the client to" - int_option 6699 - -@@ -63,6 +64,7 @@ - int_option 400 - - let options_version = define_expert_option opennap_section ["options_version"] -+ ~internal: true - "(internal option)" - int_option 0 - -Index: src/networks/server/serverUdp.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/server/serverUdp.ml,v -retrieving revision 1.2 -retrieving revision 1.3 -diff -u -r1.2 -r1.3 ---- src/networks/server/serverUdp.ml 16 Oct 2005 20:42:54 -0000 1.2 -+++ src/networks/server/serverUdp.ml 28 Nov 2006 23:58:02 -0000 1.3 -@@ -431,7 +431,7 @@ - else - dead_servers := s :: !dead_servers - ) DonkeyGlobals.servers_by_key; -- let alive_servers = Sort.list (fun s1 s2 -> -+ let alive_servers = List.sort (fun s1 s2 -> - s1.DonkeyTypes.server_last_message >= - s2.DonkeyTypes.server_last_message - ) !alive_servers in -Index: src/networks/soulseek/slskOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/soulseek/slskOptions.ml,v -retrieving revision 1.9 -retrieving revision 1.10 -diff -u -r1.9 -r1.10 ---- src/networks/soulseek/slskOptions.ml 5 Nov 2005 16:23:41 -0000 1.9 -+++ src/networks/soulseek/slskOptions.ml 15 Jan 2007 18:26:27 -0000 1.10 -@@ -46,6 +46,7 @@ - *) - - let slsk_port = define_option soulseek_section ["client_port"] -+ ~restart: true - "The port to bind the client to" - int_option 2234 - -@@ -74,6 +75,7 @@ - "the last token used for a query is saved here" int_option 1 - - let options_version = define_option soulseek_section ["options_version"] -+ ~internal: true - "(internal option)" - int_option 0 - -Index: src/utils/cdk/string2.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/string2.ml,v -retrieving revision 1.9 -retrieving revision 1.11 -diff -u -r1.9 -r1.11 ---- src/utils/cdk/string2.ml 20 Jul 2006 15:30:21 -0000 1.9 -+++ src/utils/cdk/string2.ml 28 Jan 2007 20:39:59 -0000 1.11 -@@ -322,3 +322,19 @@ - i >= l || p s.[i] && aux (i+1) in - aux 0 - -+let hex_string_of_string s = -+ let buf = Buffer.create 100 in -+ String.iter (fun c -> -+ Printf.bprintf buf "%02x " (int_of_char c) -+ ) s; -+ Buffer.contents buf -+ -+let ( |> ) x f = f x -+ -+let dehtmlize = -+ let br_regexp = Str.regexp_case_fold "<br>" in -+ let tag_regexp = Str.regexp "<[^>]*>" in -+ fun s -> -+ s -+ |> Str.global_replace br_regexp "\n" -+ |> Str.global_replace tag_regexp "" -Index: src/utils/cdk/string2.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/string2.mli,v -retrieving revision 1.10 -retrieving revision 1.12 -diff -u -r1.10 -r1.12 ---- src/utils/cdk/string2.mli 20 Jul 2006 15:30:21 -0000 1.10 -+++ src/utils/cdk/string2.mli 28 Jan 2007 20:39:59 -0000 1.12 -@@ -103,3 +103,8 @@ - val exists: (char -> bool) -> string -> bool - val existsi: (int -> char -> bool) -> string -> bool - val for_all: (char -> bool) -> string -> bool -+val hex_string_of_string : string -> string -+ -+(* [dehtmlize s] replace all <br> with \n and remove all remaining html tags from string [s] *) -+val dehtmlize: string -> string -+ -Index: src/utils/cdk/unix2.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/unix2.ml,v -retrieving revision 1.31 -retrieving revision 1.33 -diff -u -r1.31 -r1.33 ---- src/utils/cdk/unix2.ml 12 Aug 2006 20:36:14 -0000 1.31 -+++ src/utils/cdk/unix2.ml 6 Feb 2007 22:26:59 -0000 1.33 -@@ -78,10 +78,10 @@ - with End_of_file -> ()) - - let is_directory filename = -- try let s = Unix.stat filename in s.st_kind = S_DIR with _ -> false -+ try let s = Unix.LargeFile.stat filename in s.LargeFile.st_kind = S_DIR with _ -> false - - let is_link filename = -- try let s = Unix.lstat filename in s.st_kind = S_LNK with _ -> false -+ try let s = Unix.LargeFile.lstat filename in s.LargeFile.st_kind = S_LNK with _ -> false - - let chmod f o = - try -@@ -89,7 +89,7 @@ - with e -> - lprintf_nl "warning: chmod failed on %s: %s" f (Printexc2.to_string e) - --let rec safe_mkdir dir = -+let rec safe_mkdir ?(mode = 0o775) dir = - if Sys.file_exists dir then begin - if not (is_directory dir) then - failwith (Printf.sprintf "%s already exists but is not a directory" dir) -@@ -112,7 +112,7 @@ - let predir = Filename.dirname dir in - if predir <> dir then safe_mkdir predir; - try -- Unix.mkdir dir 0o775 -+ Unix.mkdir dir mode - with - Unix.Unix_error (EEXIST, _, _) -> () - | e -> lprintf_nl "error %s for directory %s" (Printexc2.to_string e) dir; exit 73 -@@ -136,7 +136,13 @@ - - let copy oldname newname = - tryopen_read_bin oldname (fun ic -> -+ let stats = Unix.LargeFile.fstat (Unix.descr_of_in_channel ic) in - tryopen_write_bin newname (fun oc -> -+ let descr = Unix.descr_of_out_channel oc in -+ (try Unix.fchown descr stats.Unix.LargeFile.st_uid stats.Unix.LargeFile.st_gid -+ with e -> lprintf_nl "copy: failed to preserve owner"); -+ (try Unix.fchmod descr stats.Unix.LargeFile.st_perm -+ with e -> lprintf_nl "copy: failed to preserve mode"); - let buffer_len = 8192 in - let buffer = String.create buffer_len in - let rec copy_file () = -Index: src/utils/cdk/zip.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/zip.ml,v -retrieving revision 1.7 -retrieving revision 1.8 -diff -u -r1.7 -r1.8 ---- src/utils/cdk/zip.ml 20 Jul 2006 11:33:58 -0000 1.7 -+++ src/utils/cdk/zip.ml 6 Feb 2007 22:26:59 -0000 1.8 -@@ -10,7 +10,7 @@ - (* *) - (***********************************************************************) - --(* $Id: zip.ml,v 1.7 2006/07/20 11:33:58 spiralvoice Exp $ *) -+(* $Id: zip.ml,v 1.8 2007/02/06 22:26:59 spiralvoice Exp $ *) - - (* Module [Zip]: reading and writing ZIP archives *) - -@@ -544,7 +544,7 @@ - match mtime with - Some t -> mtime - | None -> -- try Some((Unix.stat infilename).Unix.st_mtime) -+ try Some((Unix.LargeFile.stat infilename).Unix.LargeFile.st_mtime) - with Unix.Unix_error(_,_,_) -> None in - try - copy_channel_to_entry ic ofile ~extra ~comment ~level ?mtime:mtime' name; -Index: src/utils/lib/misc.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/misc.ml,v -retrieving revision 1.7 -retrieving revision 1.8 -diff -u -r1.7 -r1.8 ---- src/utils/lib/misc.ml 25 Oct 2006 11:12:38 -0000 1.7 -+++ src/utils/lib/misc.ml 6 Feb 2007 22:26:59 -0000 1.8 -@@ -67,12 +67,13 @@ - List.iter (zip_extract_entry ic) (Zip.entries ic)) - - let rec zip_add_entry oc file = -- let s = Unix.stat file in -- match s.Unix.st_kind with -+ let module U = Unix.LargeFile in -+ let s = U.stat file in -+ match s.U.st_kind with - Unix.S_REG -> -- Zip.copy_file_to_entry file oc ~mtime:s.Unix.st_mtime file -+ Zip.copy_file_to_entry file oc ~mtime:s.U.st_mtime file - | Unix.S_DIR -> -- Zip.add_entry "" oc ~mtime:s.Unix.st_mtime -+ Zip.add_entry "" oc ~mtime:s.U.st_mtime - (if Filename.check_suffix file "/" then file else file ^ "/"); - Unix2.tryopen_dir file (fun d -> - try -Index: src/utils/lib/options.ml4 -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/options.ml4,v -retrieving revision 1.22 -retrieving revision 1.23 -diff -u -r1.22 -r1.23 ---- src/utils/lib/options.ml4 21 Oct 2006 19:35:54 -0000 1.22 -+++ src/utils/lib/options.ml4 15 Jan 2007 18:26:27 -0000 1.23 -@@ -61,6 +61,9 @@ - mutable option_hooks : (unit -> unit) list; - option_section : options_section; - option_advanced : bool; -+ option_restart : bool; -+ option_public : bool; -+ option_internal : bool; - } - and options_file = - { mutable file_name : string; -@@ -137,6 +140,7 @@ - - let define_simple_option - normalp (section : options_section) (option_name : string list) desc -+ restart public internal - (option_help : string) (option_class : 'a option_class) - (default_value : 'a) (advanced : bool) = - let desc = match desc with None -> "" | Some s -> s in -@@ -145,6 +149,9 @@ - option_class = option_class; option_value = default_value; - option_default = default_value; - option_hooks = []; option_section = section; -+ option_restart = (match restart with None -> false | Some v -> v); -+ option_public = (match public with None -> false | Some v -> v); -+ option_internal = (match internal with None -> false | Some v -> v); - option_advanced = advanced; option_desc = desc; } - in - section.section_options <- -@@ -168,16 +175,16 @@ - let define_header_option - opfile option_name option_help option_class default_value = - define_simple_option false (List.hd opfile.file_sections) -- option_name None option_help option_class -+ option_name None None None None option_help option_class - default_value false - --let define_option opfile option_name ?desc option_help option_class default_value = -- define_simple_option true opfile option_name desc option_help option_class -+let define_option opfile option_name ?desc ?restart ?public ?internal option_help option_class default_value = -+ define_simple_option true opfile option_name desc restart public internal option_help option_class - default_value false - - let define_expert_option -- opfile option_name ?desc option_help option_class default_value = -- define_simple_option true opfile option_name desc option_help option_class -+ opfile option_name ?desc ?restart ?public ?internal option_help option_class default_value = -+ define_simple_option true opfile option_name desc restart public internal option_help option_class - default_value true - - -@@ -379,12 +386,16 @@ - let rec save_module indent oc list = - let subm = ref [] in - List.iter -- (fun (name, help, value) -> -+ (fun (name, help, restart, internal, value) -> - match name with - [] -> assert false - | [name] -> - if !with_help && help <> "" then - Printf.fprintf oc "\n\t(* %s *)\n" (tabulate help); -+ if restart then -+ Printf.fprintf oc "\t(* changing this option requires restart of MLDonkey core *)\n"; -+ if internal then -+ Printf.fprintf oc "\t(* Do not change this option, internal use only! *)\n"; - Printf.fprintf oc "%s %s = " indent (safe_string name); - save_value indent oc value; - Printf.fprintf oc "\n" -@@ -393,7 +404,7 @@ - try List.assoc m !subm with - e -> let p = ref [] in subm := (m, p) :: !subm; p - in -- p := (tail, help, value) :: !p) -+ p := (tail, help, restart, internal, value) :: !p) - list; - List.iter - (fun (m, p) -> -@@ -804,6 +815,7 @@ - - let option_to_value o = - o.option_name, o.option_help, -+ o.option_restart, o.option_internal, - (try o.option_class.to_value o.option_value with - e -> - lprintf "Error while saving option \"%s\": %s\n" -@@ -1045,29 +1057,6 @@ - let help = o.option_help in if help = "" then "No Help Available" else help - let advanced o = o.option_advanced - --(* --let simple_options opfile = -- let list = ref [] in -- List.iter (fun s -> -- List.iter -- (fun o -> -- match o.option_name with -- [] | _ :: _ :: _ -> () -- | [name] -> -- match o.option_class.to_value o.option_value with -- Module _ | SmallList _ | List _ | DelayedValue _ -> -- begin match o.option_class.string_wrappers with -- None -> () -- | Some (to_string, from_string) -> -- list := (name, to_string o.option_value) :: !list -- end -- | v -> list := (name, safe_value_to_string v) :: !list) -- s.section_options) -- opfile.file_sections; -- !list --*) -- -- - let get_option opfile name = - (* lprintf "get_option [%s]\n" name;*) - let rec iter name list sections = -@@ -1140,6 +1129,9 @@ - option_advanced : bool; - option_default : string; - option_type : string; -+ option_restart : bool; -+ option_public : bool; -+ option_internal : bool; - } - - end -@@ -1173,13 +1165,17 @@ - M.option_advanced = o.option_advanced; - M.option_help = o.option_help; - M.option_type = o.option_class.class_name; -+ M.option_restart = o.option_restart; -+ M.option_public = o.option_public; -+ M.option_internal = o.option_internal; - } - --let simple_options prefix opfile = -+let simple_options prefix opfile admin = - let list = ref [] in - List.iter (fun s -> - List.iter - (fun o -> -+ if admin || o.option_public then - try list := strings_of_option prefix o :: !list with _ -> ()) - s.section_options) - opfile.file_sections; -@@ -1195,7 +1191,7 @@ - set_simple_option opfile oi.M.option_name s), - Printf.sprintf "<string> : \t%s (current: %s)" - oi.M.option_help oi.M.option_value) -- (simple_options prefix opfile) -+ (simple_options prefix opfile true) - - let prefixed_args prefix file = - List.map -@@ -1224,6 +1220,9 @@ - option_advanced : bool; - option_default : string; - option_type : string; -+ option_restart : bool; -+ option_public : bool; -+ option_internal : bool; - } - - let iter_section f s = -Index: src/utils/lib/options.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/options.mli,v -retrieving revision 1.10 -retrieving revision 1.11 -diff -u -r1.10 -r1.11 ---- src/utils/lib/options.mli 21 Oct 2006 19:35:54 -0000 1.10 -+++ src/utils/lib/options.mli 15 Jan 2007 18:26:27 -0000 1.11 -@@ -43,6 +43,9 @@ - option_advanced : bool; - option_default : string; - option_type : string; -+ option_restart : bool; (* changing this option requires a restart *) -+ option_public : bool; (* send this option to GUIs even for non-admin users *) -+ option_internal : bool; (* this option should not be changed by users *) - } - - exception SideEffectOption -@@ -77,9 +80,11 @@ - (*4 Creating options *) - val define_option : options_section -> - string list -> ?desc: string -> -+ ?restart: bool -> ?public: bool -> ?internal: bool -> - string -> 'a option_class -> 'a -> 'a option_record - val define_expert_option : options_section -> - string list -> ?desc: string -> -+ ?restart: bool -> ?public: bool -> ?internal: bool -> - string -> 'a option_class -> 'a -> 'a option_record - val define_header_option : options_file -> - string list -> string -> 'a option_class -> 'a -> 'a option_record -@@ -183,7 +188,7 @@ - val value_to_filename : option_value -> string - - val set_simple_option : options_file -> string -> string -> unit --val simple_options : string -> options_file -> option_info list -+val simple_options : string -> options_file -> bool -> option_info list - val get_simple_option : options_file -> string -> string - val set_option_hook : options_file -> string -> (unit -> unit) -> unit - -Index: src/utils/lib/os_stubs.h -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/os_stubs.h,v -retrieving revision 1.16 -retrieving revision 1.17 -diff -u -r1.16 -r1.17 ---- src/utils/lib/os_stubs.h 5 Sep 2006 14:19:10 -0000 1.16 -+++ src/utils/lib/os_stubs.h 8 Jan 2007 11:02:08 -0000 1.17 -@@ -34,6 +34,7 @@ - typedef SOCKET OS_SOCKET;
- typedef unsigned int uint;
- extern void win32_maperr(unsigned long errcode);
-+unsigned char * utf8_to_utf16(const char * str);
-
- /*******************************************************************
-
-Index: src/utils/lib/stubs_c.c -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/stubs_c.c,v -retrieving revision 1.42 -retrieving revision 1.43 -diff -u -r1.42 -r1.43 ---- src/utils/lib/stubs_c.c 15 Aug 2006 11:32:51 -0000 1.42 -+++ src/utils/lib/stubs_c.c 8 Jan 2007 11:02:08 -0000 1.43 -@@ -954,7 +954,7 @@ - FARPROC f; - int retval = 0; - WCHAR tmp [MAX_PATH], resolved_path [MAX_PATH]; -- WCHAR * wpath=utf8_to_utf16(path); -+ WCHAR * wpath = (WCHAR *)utf8_to_utf16(path); - realpath(wpath, resolved_path); - free(wpath); - if (!resolved_path) -Index: src/utils/lib/syslog.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/syslog.ml,v -retrieving revision 1.2 -retrieving revision 1.3 -diff -u -r1.2 -r1.3 ---- src/utils/lib/syslog.ml 24 Jul 2006 20:15:16 -0000 1.2 -+++ src/utils/lib/syslog.ml 6 Feb 2007 22:26:59 -0000 1.3 -@@ -124,10 +124,11 @@ - } - - let open_connection loginfo = -+ let module U = Unix.LargeFile in - match loginfo.logpath with - "" -> raise (Syslog_error "unable to find the syslog socket or pipe, is syslogd running?") - | logpath -> -- (match (Unix.stat logpath).Unix.st_kind with -+ (match (U.stat logpath).U.st_kind with - Unix.S_SOCK -> - let logaddr = Unix.ADDR_UNIX logpath in - (try -Index: src/utils/lib/unix32.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/unix32.ml,v -retrieving revision 1.65 -retrieving revision 1.67 -diff -u -r1.65 -r1.67 ---- src/utils/lib/unix32.ml 15 Jul 2006 11:52:54 -0000 1.65 -+++ src/utils/lib/unix32.ml 6 Feb 2007 22:26:59 -0000 1.67 -@@ -31,15 +31,14 @@ - - let max_buffered = ref (Int64.of_int (1024 * 1024)) - --let create_dir_mask = ref "755" -+let create_file_mode = ref 0o664 -+let create_dir_mode = ref 0o755 - let verbose = ref false - let max_cache_size = ref 50 - - let mini (x: int) (y: int) = - if x > y then y else x - --let rights = 0o664 -- - let ro_flag = [Unix.O_RDONLY] - let rw_flag = [Unix.O_RDWR] - let rw_creat_flag = [Unix.O_CREAT; Unix.O_RDWR] -@@ -121,7 +120,8 @@ - try - if t.writable then - Unix.openfile t.filename -- (if creat then rw_creat_flag else rw_flag) rights -+ (if creat then rw_creat_flag else rw_flag) -+ !create_file_mode - else - Unix.openfile t.filename ro_flag 0o400 - with e -> -@@ -206,9 +206,9 @@ - let owner t = - try - check_destroyed t; -- let s = Unix.fstat (local_force_fd t) in -- let user = Unix.getpwuid s.Unix.st_uid in -- let group = Unix.getgrgid s.Unix.st_gid in -+ let s = Unix.LargeFile.fstat (local_force_fd t) in -+ let user = Unix.getpwuid s.Unix.LargeFile.st_uid in -+ let group = Unix.getgrgid s.Unix.LargeFile.st_gid in - user.Unix.pw_name, group.Unix.gr_name - with e -> - if !verbose then lprintf_nl "Exception in FDCache.owner %s: %s" -@@ -254,9 +254,9 @@ - check_destroyed t; - close t; - (let d = (Filename.dirname (Filename.concat f file)) in -- Unix2.safe_mkdir d; -- Unix2.chmod d (Misc.int_of_octal_string !create_dir_mask); -- Unix2.can_write_to_directory d); -+ Unix2.safe_mkdir d; -+ Unix2.chmod d !create_dir_mode; -+ Unix2.can_write_to_directory d); - (try - Unix2.rename t.filename (Filename.concat f file); - with -Index: src/utils/lib/unix32.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/unix32.mli,v -retrieving revision 1.23 -retrieving revision 1.24 -diff -u -r1.23 -r1.24 ---- src/utils/lib/unix32.mli 6 Mar 2006 18:02:16 -0000 1.23 -+++ src/utils/lib/unix32.mli 28 Nov 2006 23:52:18 -0000 1.24 -@@ -26,7 +26,8 @@ - val uname : unit -> string - val os_supported : unit -> bool - --val create_dir_mask : string ref -+val create_file_mode : int ref -+val create_dir_mode : int ref - val close : t -> unit - (* val force_fd : t -> Unix.file_descr *) - -Index: src/utils/net/http_client.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/net/http_client.ml,v -retrieving revision 1.35 -retrieving revision 1.36 -diff -u -r1.35 -r1.36 ---- src/utils/net/http_client.ml 21 Nov 2006 22:34:34 -0000 1.35 -+++ src/utils/net/http_client.ml 4 Feb 2007 17:27:45 -0000 1.36 -@@ -334,6 +334,14 @@ - raise Not_found - end - -+ | 400 when r.req_request = HEAD -> -+ lprintf_nl "Error 400 received for HEAD %s, re-try GET" (Url.to_string_no_args r.req_url); -+ let r2 = { -+ r with -+ req_request = GET; -+ } in -+ get_page r2 content_handler f ferr -+ - | 404 -> - lprintf_nl "404: Not found for: %s" (Url.to_string_no_args r.req_url); - close sock (Closed_for_error "bad reply"); |