aboutsummaryrefslogtreecommitdiff
path: root/net-p2p
diff options
context:
space:
mode:
authorMario Sergio Fujikawa Ferreira <lioux@FreeBSD.org>2007-02-15 21:51:43 +0000
committerMario Sergio Fujikawa Ferreira <lioux@FreeBSD.org>2007-02-15 21:51:43 +0000
commit0d63536a30f882b726efca2cf39d8639ce04026e (patch)
treeedcdae885a17b0485986b59337c78c6b6ab9bcbf /net-p2p
parent2589edca5932ffe418748a10d9146d079375349e (diff)
downloadports-0d63536a30f882b726efca2cf39d8639ce04026e.tar.gz
ports-0d63536a30f882b726efca2cf39d8639ce04026e.zip
Update to 2.8.3
Notes
Notes: svn path=/head/; revision=185259
Diffstat (limited to 'net-p2p')
-rw-r--r--net-p2p/mldonkey-devel/Makefile3
-rw-r--r--net-p2p/mldonkey-devel/distinfo6
-rw-r--r--net-p2p/mldonkey-devel/files/patch-cvs-200702100011901
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&amp;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\\>\\&nbsp;\\</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\\>\\&nbsp;\\</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)\\\"\\>\\&nbsp;\\</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");
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-19 10:06:27 +0000