diff options
| author | lioux <lioux@FreeBSD.org> | 2006-12-25 14:14:03 +0800 |
|---|---|---|
| committer | lioux <lioux@FreeBSD.org> | 2006-12-25 14:14:03 +0800 |
| commit | 2a9bb9cc21e9d618a5ead8b6da10d9419fde8b3b (patch) | |
| tree | 595a1abdee79f64b4ff0ab782a82da4e6dbace99 /net-p2p | |
| parent | e7871d619fde6798da3e5474cf0ed67d0a8fc5e6 (diff) | |
| download | freebsd-ports-gnome-2a9bb9cc21e9d618a5ead8b6da10d9419fde8b3b.tar.gz freebsd-ports-gnome-2a9bb9cc21e9d618a5ead8b6da10d9419fde8b3b.tar.zst freebsd-ports-gnome-2a9bb9cc21e9d618a5ead8b6da10d9419fde8b3b.zip | |
Update to 2.8.2 cvs release as of date 2006122500
Diffstat (limited to 'net-p2p')
| -rw-r--r-- | net-p2p/mldonkey-devel/Makefile | 3 | ||||
| -rw-r--r-- | net-p2p/mldonkey-devel/distinfo | 6 | ||||
| -rw-r--r-- | net-p2p/mldonkey-devel/files/patch-cvs-2006112100 | 19589 | ||||
| -rw-r--r-- | net-p2p/mldonkey-devel/files/patch-cvs-2006122500 | 7533 |
4 files changed, 7537 insertions, 19594 deletions
diff --git a/net-p2p/mldonkey-devel/Makefile b/net-p2p/mldonkey-devel/Makefile index cdd6239d59b1..3ee991f06a35 100644 --- a/net-p2p/mldonkey-devel/Makefile +++ b/net-p2p/mldonkey-devel/Makefile @@ -6,8 +6,7 @@ # PORTNAME= mldonkey -PORTVERSION= 2.8.1 -PORTREVISION= 3 +PORTVERSION= 2.8.2 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 23d93aa2219e..adbd3292e7b7 100644 --- a/net-p2p/mldonkey-devel/distinfo +++ b/net-p2p/mldonkey-devel/distinfo @@ -1,3 +1,3 @@ -MD5 (mldonkey-2.8.1.tar.bz2) = 10452ad305f105d0d0761977f825694d -SHA256 (mldonkey-2.8.1.tar.bz2) = 6ac802a918bb71c47e06193936b07d4ea161dc68d35853793986d0b6b51fa3c4 -SIZE (mldonkey-2.8.1.tar.bz2) = 2642676 +MD5 (mldonkey-2.8.2.tar.bz2) = 123aeb79a3ca91a4943b59f044e98d4a +SHA256 (mldonkey-2.8.2.tar.bz2) = 51efc1c339b8cbafde93f4444f18e4243f41008b1c4107a41602542e9eeaa68e +SIZE (mldonkey-2.8.2.tar.bz2) = 2652074 diff --git a/net-p2p/mldonkey-devel/files/patch-cvs-2006112100 b/net-p2p/mldonkey-devel/files/patch-cvs-2006112100 deleted file mode 100644 index 6a153b3b328d..000000000000 --- a/net-p2p/mldonkey-devel/files/patch-cvs-2006112100 +++ /dev/null @@ -1,19589 +0,0 @@ -Index: config/Makefile.config.in -=================================================================== -RCS file: /sources/mldonkey/mldonkey/config/Makefile.config.in,v -retrieving revision 1.62 -retrieving revision 1.63 -diff -u -r1.62 -r1.63 ---- config/Makefile.config.in 26 Aug 2006 12:04:25 -0000 1.62 -+++ config/Makefile.config.in 23 Oct 2006 12:18:27 -0000 1.63 -@@ -58,6 +58,7 @@ - GD_JPG=@GD_JPG@ - GD_PNG=@GD_PNG@ - GD_LIBS=@GD_LIBS@ -+GD_STATIC_LIBS=@GD_STATIC_LIBS@ - GD_CFLAGS=@GD_CFLAGS@ - GD_LDFLAGS=@GD_LDFLAGS@ - -Index: config/Makefile.in -=================================================================== -RCS file: /sources/mldonkey/mldonkey/config/Makefile.in,v -retrieving revision 1.169 -retrieving revision 1.173 -diff -u -r1.169 -r1.173 ---- config/Makefile.in 16 Aug 2006 19:08:21 -0000 1.169 -+++ config/Makefile.in 21 Nov 2006 22:29:58 -0000 1.173 -@@ -206,8 +206,6 @@ - $(NET)/cobs.ml \ - $(NET)/terminal.ml - --# $(NET)/tcpClientSocket.ml -- - XML_SRCS= \ - $(XML)/xml_types.ml $(XML)/xml_parser.mly $(XML)/xml_lexer.mll \ - $(XML)/xml_dtd.ml $(XML)/xmlParser.ml $(XML)/xml.ml -@@ -435,7 +433,6 @@ - $(SRC_BITTORRENT)/bTStats.ml \ - $(SRC_BITTORRENT)/bTTracker.ml \ - $(SRC_BITTORRENT)/bTChooser.ml \ -- $(SRC_BITTORRENT)/bTShare.ml \ - $(SRC_BITTORRENT)/bTClients.ml \ - $(SRC_BITTORRENT)/bTInteractive.ml \ - $(SRC_BITTORRENT)/bTMain.ml -@@ -530,6 +527,9 @@ - - ifeq ("$(GD)", "yes") - GD_LIBS_flags=-cclib "-lgd $(GD_LIBS)" -ccopt "$(GD_LDFLAGS)" -+ ifneq ("$(GD_STATIC_LIBS)", "") -+ GD_STATIC_LIBS_opt=-cclib "-lgd $(GD_STATIC_LIBS)" -ccopt "$(GD_LDFLAGS)" -+ endif - DRIVER_SRCS= \ - $(CDK)/gd.ml \ - $(CDK)/gdstubs.c \ -@@ -1921,7 +1921,7 @@ - ./svg_converter.byte $@ - - .ml.cmx : -- $(OCAMLOPT) $(DEVFLAGS) $(PLUGIN_FLAG) $(OFLAGS) $(INCLUDES) -c $< -+ $(OCAMLOPT) $(DEVFLAGSOPT) $(DEVFLAGS) $(PLUGIN_FLAG) $(OFLAGS) $(INCLUDES) -c $< - - .ml.cmo : - $(OCAMLC) $(DEVFLAGS) $(OFLAGS) $(INCLUDES) -c $< -Index: config/configure.in -=================================================================== -RCS file: /sources/mldonkey/mldonkey/config/configure.in,v -retrieving revision 1.283 -retrieving revision 1.288 -diff -u -r1.283 -r1.288 ---- config/configure.in 17 Sep 2006 18:42:57 -0000 1.283 -+++ config/configure.in 31 Oct 2006 15:40:05 -0000 1.288 -@@ -143,7 +143,7 @@ - SYSTEM=hpux - ;; - *darwin*|*rhapsody*|*macosx*) -- SYSTEM=macosx -+ SYSTEM=macos - AC_CHECK_PROG(SED, sed, sed) - if test "$ac_cv_prog_SED" = "sed"; then - FIX_BROKEN_CPP="| sed -n '/^\#pragma/!p'" -@@ -234,7 +234,7 @@ - AC_CHECK_PROG(CUT, cut, cut) - if test "$ac_cv_prog_CUT" = "cut"; then - SUB_VERSION3="CVS" -- if [ test "$SYSTEM" = "freebsd"] || [ test "$SYSTEM" = "netbsd"] || ( [ test "$SYSTEM" = "macosx" ] && [ test "$ac_cv_prog_STAT" != "gstat" ] ); then -+ if [ test "$SYSTEM" = "freebsd"] || [ test "$SYSTEM" = "netbsd"] || ( [ test "$SYSTEM" = "macos" ] && [ test "$ac_cv_prog_STAT" != "gstat" ] ); then - SCM_VERSION=`$STAT -f "%Sm" ./CVS/Entries | $SED -e 's/\(.*\) \(.*\) \(.*\) \(.*\)/\4-\1-\2 \3/'` - else - if [ test "$SYSTEM" = "openbsd"]; then -@@ -279,9 +279,9 @@ - MLDONKEY_VERSION=$MLDONKEY_VERSION.$SUB_VERSION3 - fi - --REQUIRED_OCAML=3.09.2 -+REQUIRED_OCAML=3.09.3 - DOWNLOAD_OCAML_MAJOR=3.09 --DOWNLOAD_OCAML=3.09.2 -+DOWNLOAD_OCAML=3.09.3 - - REQUIRED_LABLGTK=1.2.7 - -@@ -477,9 +477,10 @@ - - AC_PATH_PROG(OCAMLC,ocamlc.opt,"",[$LOCAL_DIR/bin:$PATH]) - AC_CHECK_TOOL(OCAMLC,ocamlc,ocamlrun ocamlc) -+AC_PATH_PROG(CAMLP4, camlp4,"",[$LOCAL_DIR/bin:$PATH]) - - BUILD_OCAML=no --if [ test -z "$OCAMLC" ] || [ test "$REQUIRED_OCAML" = "CVS" ]; then -+if [ test -z "$OCAMLC" ] || [ test -z "$CAMLP4" ] || [ test "$REQUIRED_OCAML" = "CVS" ]; then - BUILD_OCAML=yes - else - OCAMLVERSION=`$OCAMLC -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` -@@ -487,7 +488,7 @@ - "$REQUIRED_OCAML"*) ;; - 3.09.0*) ;; - 3.09.1*) ;; -- 3.09.3*) ;; -+ 3.09.2*) ;; - 3.08.4*) ;; - 3.08.3*) ;; - *) -@@ -640,7 +641,7 @@ - "$REQUIRED_OCAML"*) ;; - 3.09.0*) ;; - 3.09.1*) ;; -- 3.09.3*) ;; -+ 3.09.2*) ;; - 3.08.4*) ;; - 3.08.3*) ;; - *) -@@ -789,6 +790,10 @@ - AC_CHECK_PROG(GDLIBCONFIG, gdlib-config, gdlib-config) - if test "$ac_cv_prog_GDLIBCONFIG" = "gdlib-config"; then - GD_LIBS=`$GDLIBCONFIG --libs` -+ $GDLIBCONFIG --static-libs > /dev/null 2>&1 -+ if test "$?" = "0"; then -+ GD_STATIC_LIBS=`$GDLIBCONFIG --static-libs` -+ fi - GD_LIBS2="$LIBS -lgd $GD_LIBS" - LIBS=$GD_LIBS2 - GD_CFLAGS=`$GDLIBCONFIG --cflags` -@@ -1330,11 +1335,6 @@ - echo "---------------------------------------------------------" - fi - --case "$OCAMLVERSION" in -- 3.06* | 3.07* | 3.08* ) TYPE_FORMAT="";; -- *) TYPE_FORMAT="type ('a,'b,'c) ml_format = ('a,'b, 'c,'c) format4 type ('a,'b,'c) format = ('a,'b, 'c) ml_format";; --esac -- - if test "$OS_FILES" = "mingw"; then - OCAMLDEP_OPTIONS="-slash" - fi -@@ -1351,7 +1351,6 @@ - AC_SUBST(CXX) - AC_SUBST(FIX_BROKEN_CPP) - AC_SUBST(CONFIG_INCLUDES) --AC_SUBST(TYPE_FORMAT) - AC_SUBST(OCAMLC) - AC_SUBST(OCAMLLIB) - AC_SUBST(OCAMLOPT) -@@ -1411,6 +1410,7 @@ - AC_SUBST(GD_PNG) - AC_SUBST(GDGRAPHICS) - AC_SUBST(GD_LIBS) -+AC_SUBST(GD_STATIC_LIBS) - AC_SUBST(GD_CFLAGS) - AC_SUBST(GD_LDFLAGS) - AC_SUBST(BZIP2) -Index: config/mldonkey.rc.in -=================================================================== -RCS file: /sources/mldonkey/mldonkey/config/mldonkey.rc.in,v -retrieving revision 1.6 -retrieving revision 1.7 -diff -u -r1.6 -r1.7 ---- config/mldonkey.rc.in 19 Jul 2005 19:01:38 -0000 1.6 -+++ config/mldonkey.rc.in 1 Oct 2006 17:46:11 -0000 1.7 -@@ -18,17 +18,16 @@ - { - BLOCK "000004b0" // LANG_NEUTRAL,UNICODE_CP - { -- VALUE "Comments","MLdonkey is distributed under the terms of the GNU General Public License Version 2. Sourcecode is available at http://www.mldonkey.net\000" -- VALUE "CompanyName", "mldonkey team\000" -- VALUE "FileDescription", "MLdonkey - multiuser P2P daemon\000" -- VALUE "FileVersion", "\000" -- VALUE "InternalName", "Counter Counter\000" -- VALUE "LegalCopyright", " (C) 2000-2005 mldonkey team (see README)\000" -- // VALUE "LegalTrademarks"," "\000" -- VALUE "OriginalFilename", "mlnet.exe\000" -- VALUE "ProductName", "MLdonkey - multiuser P2P daemon\000" -- VALUE "ProductVersion", "\000" -- VALUE "SpecialBuild","\000" -+ VALUE "Comments", "MLdonkey is distributed under the terms of the GNU General Public License Version 2. Sourcecode is available at http://mldonkey.sf.net" -+ VALUE "CompanyName", "MLdonkey team, http://mldonkey.sf.net" -+ VALUE "FileDescription", "MLdonkey - multiuser P2P daemon" -+ VALUE "FileVersion", "@MLDONKEY_VERSION@" -+ VALUE "InternalName", "MLdonkey" -+ VALUE "LegalCopyright", "Copyright © 2000-2006 MLdonkey team (see README)" -+ VALUE "OriginalFilename", "mlnet.exe" -+ VALUE "ProductName", "MLdonkey - multiuser P2P daemon" -+ VALUE "ProductVersion", "@MLDONKEY_VERSION@" -+ VALUE "SpecialBuild", "" - } - } - BLOCK "VarFileInfo" -Index: distrib/Authors.txt -=================================================================== -RCS file: /sources/mldonkey/mldonkey/distrib/Authors.txt,v -retrieving revision 1.5 -retrieving revision 1.6 -diff -u -r1.5 -r1.6 ---- distrib/Authors.txt 4 Feb 2006 22:26:36 -0000 1.5 -+++ distrib/Authors.txt 23 Oct 2006 12:58:35 -0000 1.6 -@@ -36,12 +36,9 @@ - Schlumpf - su_blanc - bogeyman -- --rlimit code taken from Ocaml-annexlib: --Shawn Wagner <raevnos@pennmush.org> --http://raevnos.pennmush.org/code/extlib/ -- --Fasttrack plugin from giFT-fasttrack: --Markus Kern -+jave - - This product includes GeoLite data created by MaxMind, available from http://maxmind.com/ -+ -+A complete overview about 3rd party libraries used can be found here: -+http://mldonkey.sourceforge.net/3rdParty -Index: distrib/Bugs.txt -=================================================================== -RCS file: /sources/mldonkey/mldonkey/distrib/Bugs.txt,v -retrieving revision 1.2 -retrieving revision 1.3 -diff -u -r1.2 -r1.3 ---- distrib/Bugs.txt 4 Feb 2004 12:13:36 -0000 1.2 -+++ distrib/Bugs.txt 23 Oct 2006 12:58:35 -0000 1.3 -@@ -1,7 +1,9 @@ --Before feeling a bug report form on -- http://savannah.gnu.org/bugs/?group=mldonkey -+Before sending a bug report form on -+ http://savannah.nongnu.org/bugs/?group=mldonkey - please, check that the bug is not already registered (then, add a comment). - -+To send a feature request please use the Task tracker -+ http://savannah.nongnu.org/task/?group=mldonkey - -------------------------------------------------------------------------- - If you think your bug is a very important one, and nobody has fixed it in a - long time, it might be that we don't have enough information to reproduce it -Index: distrib/ChangeLog -=================================================================== -RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v -retrieving revision 1.1015 -retrieving revision 1.1108 -diff -u -r1.1015 -r1.1108 ---- distrib/ChangeLog 17 Sep 2006 18:42:57 -0000 1.1015 -+++ distrib/ChangeLog 21 Nov 2006 22:34:33 -0000 1.1108 -@@ -14,6 +14,280 @@ - ChangeLog - ========= - -+2006/11/21 -+5579: Remove BasicSocket.[mini|maxi], replace them with Pervasives functions -+- small fix for DonkeyOptions.max_allowed_connected_servers -+5578: Remove unused files -+- src/utils/net/tcpClientSocket.ml -+- src/utils/net/tcpClientSocket.mli -+- src/utils/net/tcpSocket.mli -+5577: EDK: Send correct SUI tags -+- sometimes MLDonkey sent SUI=true tag when CryptoPP was not linked -+ -+2006/11/20 -+5568: EDK: Support CIDR and IP ranges in server_black_list (pango) -+5574: allowed_ips: Fix list usage when 0.0.0.0/0 is part of the list (pango) -+5570: Some log messages in gettext module (Schlumpf) -+5569: HTML: Fix display bug in server list after js popups -+ introduced by patch #5549 (Schlumpf) -+5564: HTML: Remove non-working option use_html_frames (Schlumpf) -+5563: EDK: Fix broken log message when master server changes (Schlumpf) -+ -+2006/11/15 -+5556: web_infos: new option rss_preprocessor used for fixing broken RSS feeds, -+ safer process spawning for command "!" (pango) -+- broken feeds like http://thepiratebay.org/rss.php?cat=D601 can now be parsed -+ directly using (for example) xmllint, if a feed can not be read be MLDonkey -+ its piped through rss_preprocessor and read again -+5560: EDK: Parse some more server.met fields, log unknown server tags -+ -+2006/11/14 -+5424: web_infos/rss: shell:// type url -+5549: EDK: Parse all data from server.met, new HTML javascript popup -+5553: EDK/OV/KAD: small updates (bogeyman) -+- EDK: log unknown client tags with verbosity mct -+- OV/KAD: ignore OvernetPeerNotFound and log number of peers every -+ 60 secs when logging -+5551: web_infos: Fix mtime detection, old files were not updated -+5550: debug_fileinfo: Print [a|c|m]time values -+5530: GD: Improve graph output (skeeve, Schlumpf) -+- html_mods_vd_gfx_h_grid_variable -+ "Stretch hourly until at program start", default true -+- html_mods_vd_gfx_h_grid_time -+ "Max hours on time scale per grid (0 = no limit)", default 0 -+- html_mods_vd_gfx_subgrid -+ "Number of shown subgrids on graph (0 = no subgrids)", default 0 -+ -+2006/11/13 -+5548: New search parameters: "-and", "-or", "-not", removed "-without" -+ (Schlumpf) -+5546: Some sharing updates -+- solved bug 10957, updating the prio of an already shared dir is now possible -+- fix bug where missing shared dirs with strategy incoming_* where not recreated -+- remove "network = []" from downloads.ini, currently not supported -+- created workaround to fix bug on MinGW: no files were shared. Introduced by -+ patch 5475, but source of problem is Ocaml bug 4159 -+5547: HTML: Fix unicode display in vd & upstats javascript popups -+ -+2006/11/12 -+5545: EDK: Do not show empty server message lines in GUI -+5509: Common: Merge file_print functions, -+ BT: print BT-specific source infos in Telnet (thx to jave) -+5544: Clean up code to avoid otags warnings (pango) -+5543: Improve exception handling, fix some indentions (pango) -+5542: CommonSources: Work-around division-by-zero bug in Ocaml -+ on Alpha platform (pango) -+ -+2006/11/09 -+5526: Multiuser: Internal restructuring, new commands -+- from ftp://ftp.berlios.de/pub/mldonkey/pango/userdb-cleanups_v2.patch (pango) -+ - create commonUserDb.mli to protect userdb data from other modules -+ - cleanups -+- replace strings in commonFile with multiuser commonTypes.userdb/groupdb -+- implement security checks when core starts -+ - user "admin" must exist -+ - group "mldonkey" must exist and must have admin status -+- update HTML interface, command "users" -+ - create link to remove a group from a user -+ - create link to change group admin status -+ - new column group members -+- Telnet: Show all data in command "users" -+- do not allow removal of users or groups with downloads, -+ groups with members, user "admin" and group "mldonkey" -+- filter files shown with command "downloaders" -+- fixed bug where wrong group list was displayed in HTML, vd #file_num -+- Display user and groups columns -+ new options html_mods_vd_user & html_mods_vd_group to en-/disable display in HTML, vd -+ - Javascript popups show User:Group infos -+ - Telnet support -+- implement new commands -+ - usergroupadd <user> <group> : add a group to a mldonkey user -+ - usergroupdel user> <group> : remove a group from a mldonkey user -+ - userdgroup <user> <group|None> : change user default group -+ - groupdel <group> : remove an unused mldonkey group -+ - groupadmin <group> <true|false> : change group admin status -+- Restrict commands to admin users: -+ - bw_toggle -+ - enable -+ - disable -+ -+2006/11/06 -+5527: mlguistarter: print correct syntax (fixes Debian bug #396754) -+ -+2006/11/05 -+5481: Overnet: Small updates -+- do not print opcode 18 (OvernetNoResult) as unknown message -+- parse bcp type bcp://xxxxxxxxxxxxxxxxxxxxxxxxxxx:ip:tcpport:udpport -+- print debug log message when a new source was added -+5513: HTML: Let webinterface work in a HTML frame (ported from Knockers Mulus) -+- third button row does not work yet, patches welcome -+5521: BT: Fix non-working EDK upload when BT is enabled, -+ introduced by patch 5461 -+ -+2006/10/31 -+5508: OV/KAD eMule style search and some small fixes (bogeyman) -+5486: UDP bandwidth monitor fix (bogeyman) -+5505: EDK: Support aMule/Hydranode style OS_INFO tag -+ -+2006/10/30 -+5488: Multiuser: New commands -+- groups -> displays groups of the logged-in user -+- dgroup -> displays default group of the logged-in user -+- restrict command "unshare" to admin users -+ -+2006/10/29 -+5475: Multiuser: Implement user_commit_dir -+- directories with strategy incoming_files are shared recursively now -+- support several directories with incoming_* strategies, use the -+ first one with enough space to commit the finished file -+ -+2006/10/27 -+5499: Configure: find camlp4 in local, fix patch 5479 (dunk) -+ -+2006/10/26 -+5477: BT: Add downloads to share list after core restart -+ -+2006/10/25 -+5474: updated bw_toggle -+- fix cosmetic bug, wrong values were displayed -+ as a result if option_hook changed values -+5489: HTML: Improve serverlist display (Schlumpf) -+5487: Update URLs, change mldonkey.net to mldonkey.org -+5485: HTML: Print sharing strategies in command "shares" -+5461: Release slot, fix missing filenames in upstats -+- Each downloading file can be set to status "Release", this can -+ be done by clicking the "R" column in HTML, Transfers or by -+ using the new "release <file_num>" command to toggle the state. -+- A new option max_release_slots exists, default 20% of the default -+ 5 max_upload_slots. This means 1 upload slot is available per default -+ and granted for files with status "Release" when requested. -+- Show filenames in pending upload slots list -+5484: Fix DNS test, test other domains besides www.mldonkey.net -+ -+2006/10/23 -+5474: New command bw_toggle (ported from Knockers Mulus client) -+- two new options: max_hard_upload_rate_2 and max_hard_download_rate_2 -+- new command bw_toggle, quickly switch between two bandwidth options -+5480: Update Mozilla protocol handler, cleanup docs in distrib/ -+5479: Configure: Force presence of camlp4 -+5478: Support gdlib-config --static-libs function (new on Debian Etch) -+5476: Urladd: Change default period to 0 (load file only when core starts) -+ -+2006/10/21 -+5473: Log: Redirect CryptoPP messages to MLDonkey logfile (Schlumpf) -+5472: Urladd: New optional parameter period (in hours) (thx to Schlumpf) -+5471: HTML: New colums for pending slots list: SUI, GeoIP, Filename -+5470: Options: New type percent_option, values are bound to be >= 0 and <= 100 -+5469: HTML: Implement 404 error page for unknown URLs -+ -+2006/10/20 -+5419: EDK: Re-implement titanesel.ws links - service is up again (thx to sk38) -+ -+2006/10/13 -+5458: OV/KAD: tweak and bugfix the search (bogeyman) -+ -+2006/10/12 -+5454: OV/KAD: Block blocked ips + small Overnet updates (bogeyman) -+5451: HTML: clickable new messages indicator (jave) -+ -+2006/10/09 -+5428: HTML: Fix style sheet errors (rwruck) -+5446: EDK: Small update for EDK publish patch 5430 -+- new option max_published_files -+ maximum number of files published to servers per minute, eMule default 200 -+- bug fix for patch 5430, publish also to non-preferred servers -+ -+2006/10/08 -+5430: EDK: Improve file publishing -+- publish no more than 200 files/minute to avoid server-side blacklisting, -+ eMule uses the same limit, -+ least published files are published first (thx to pango) -+- respect server hard_limit, never publish more files to servers -+- HTML: in server list display number of files published by server, by clicking -+ on this number the list of files is displayed (new command server_shares num) -+- HTML: diplay master server status, only master server are used for publishing -+- HTML: in upstats display number of server the file was published to, -+ also display server name + IP in javascript popup -+- bug fix: properly update DonkeyGlobals.master_server to be used in -+ DonkeyClient.read_first_message, this is used when replying to non-Overnet -+ clients so they know to which server MLdonkey is connected to, -+- remove development option become_master_delay -+5445: Self-test charset conversion, disable conversion if test fails -+5444: BT: Correctly display client connected time, -+ also allow correct upload speed calculation (tradie) -+5443: BT: do not allow connections with ourselves (tradie) -+ -+2006/10/06 -+5442: BT: Verbose error messages when torrent is sent from GUI, -+ BT-multiuser: Protect command seeded_torrents -+5441: BT: Re-enable all trackers when file is resumed -+5440: HTML: Strip CR from multiline dllink input to fix FileTP filenames -+ -+2006/10/03 -+5439: Increase required ocaml version to 3.09.3 (schlumpf), -+ remove old TYPE_FORMAT stuff needed for Ocaml < 3.06 (pango) -+ -+2006/10/02 -+5297: In addition to previous patch 5297 force conversion of allowed_ips to -+ IP blocklist when $MLDONKEY_DIR points to an existing directory -+ and ini files are created for the first time -+5429: Fix compile bug in Ocaml 3.08.3 (thx to eike for reporting) -+ -+2006/10/01 -+5404: New command porttest, support for eMule- and Azureus-style porttest -+ (thx to pango for Azureus result parsing) -+5421: HTML: Add "Users" to options frame (unease) -+5429: New common lprintf_file_nl function -+5432: Updates and fixes for the Win resource file (schlumpf) -+ -+2006/09/26 -+5407: BT: Improve handling of tracker error messages -+- print additional information in telnet, vd #num already present in HTML -+- show tracker errors in Telnet and HTML popups over tracker info lines -+- pause torrents with no valid trackers left -+5336: EDK: Fix lowid support (krissn) -+5427: EDK: Increase hash speed when threads are available (pango) -+ -+2006/09/25 -+5426: CommonSources: Reduce CPU load when refilling queues -+ of many non-BT downloads (pango) -+5425: FileTP: Support options file_started_cmd and pause_new_downloads -+5423: Print warning for empty admin password only if allowed_ips was altered -+5422: Command "sources": Display only downloading files -+ -+2006/09/24 -+5405: BT: Use field "encoding" from .torrent to convert strings to UTF-8 -+5419: EDK: Remove titanesel.ws links -+5418: Gnutella/G2/Fasttrack: Support client_bind_addr -+5417: Edonkey comments: Telnet support, UTF-8 output in HTML -+5416: Makefile.in: New variable $DEVFLAGSOPT for .cmx files (jave) -+5415: New command option: rem disc - remove all disconnected servers -+ -+2006/09/23 -+5414: Edonkey comments, update gui prot, some bt peer ids (zet) -+- Reimplement edonkey file comments with ratings (ro) -+ (fixes exploitable DOS introduced in patch #5371) -+- Add options "comments_filter", "max_comments_per_file", "max_comment_length" -+- GUI protocol updated for comments, stats, libmagic, users/groups -+- BT: Identify some more peer ids, as well as the reserved bits -+- Fix some html code and other bugs -+- Minor code cleanup -+ -+2006/09/22 -+5411: Portinfo: Rename gift_port to gift_port GUI -+ -+2006/09/19 -+5406: Multiuser: Small bug fixed in recover_temp (mu2.patch) -+5406: Main multiuser patch, see docs/multiuser.txt for details -+ thx to jave, pango, zet and many other people who have helped -+ to make this work possible -+- this patch is experimental, if it breaks, you can keep the pieces;-) -+- multigroup_usercommit.patch and multigroup_su.patch are not included -+- this patch is still not finished, the To-Do list in docs/multiuser.txt -+ is still long, also GUI protocol updates have to be implemented. -+ To manage users, groups and files, its best to use the HTML interface, -+ multiuser commands can also be used in Telnet interface. -+------------------------------------------------------------------------------- - 2006/09/17 version 2.8.1 = tag release-2-8-1 - 5401: Fix question whether to compile Ocaml with some bash versions (pango) - 5400: Allow use of Ocaml 3.09.3, keep 3.09.2 as default -Index: distrib/Developers.txt -=================================================================== -RCS file: /sources/mldonkey/mldonkey/distrib/Developers.txt,v -retrieving revision 1.7 -retrieving revision 1.8 -diff -u -r1.7 -r1.8 ---- distrib/Developers.txt 2 May 2005 17:50:33 -0000 1.7 -+++ distrib/Developers.txt 23 Oct 2006 12:58:35 -0000 1.8 -@@ -1,5 +1,5 @@ - -- Yes, we are looking for developpers. If you have some programming skills, -+ Yes, we are looking for developers. If you have some programming skills, - you are welcome to help the development of mldonkey. There are different ways - to help us. You can see a bug, or a missing feature, and fix it, and then - send us a patch. If you want to spend more time, you can fix a lot of bugs, or -Index: distrib/FAQ.html -=================================================================== -RCS file: distrib/FAQ.html -diff -N distrib/FAQ.html ---- distrib/FAQ.html 2 May 2005 17:50:33 -0000 1.6 -+++ /dev/null 1 Jan 1970 00:00:00 -0000 -@@ -1,1129 +0,0 @@ --<html> --<head> --<META name="robots" content="noindex, nofollow"> --<title>mldonkey FAQ</title> --</head> --<body bgcolor="#ffffff"> -- -- --<center> -- -- <H1> <a href=index.html> mldonkey </a>: Frequently Asked Questions </H1> -- -- -- <a href=faq.html> English </a>, -- <a href=faq.html.de> Deutsch </a>, -- <a href=faq.html.fr> Francais </a> --o <a href=faq.html.es>Español</a> -- --</center> -- --<ol> -- -- <a name=index_back> -- <li> <h3> Background </h3> </a> -- <ol> -- <li> <strong> <a href=#back1> What is mldonkey ? </a> </strong> -- <li> <strong> <a href=#back2> Why use Objective-Caml to program mldonkey ? </a> </strong> -- <li> <strong> <a href=#back3> Where can I find support on mldonkey ? </a> </strong> -- <li> <strong> <a href=#back4> Where can I download mldonkey ? </a> </strong> -- <li> <strong> <a href=#back5> Where can I find mldonkey for Windows ? </a> </strong> -- <li> <strong> <a href=#back6> What's new with MLdonkey 2.00 ? </a> </strong> -- </ol> -- -- <a name=index_run> -- <li> <h3> Running mldonkey </h3> </a> -- -- <ol> -- <li> <strong> <a href=#run1> How should I start mldonkey ? </a> </strong> -- <li> <strong> <a href=#run2> How can I control mldonkey ? </a> </strong> -- <li> <strong> <a href=#run3> Where/what are mldonkey configuration files ? </a> </strong> -- <li> <strong> <a href=#run4> How can I control the bandwidth used by mldonkey ? </a> </strong> -- <li> <strong> <a href=#run5> When I modify an option in the config file, mldonkey overwrites it with its old value ? </a> </strong> -- <li> <strong> <a href=#run6> Where are the files I have downloaded with mldonkey ? </a> </strong> -- <li> <strong> <a href=#run7> Why does MLdonkey automatically pause some of my downloads ? </a> </strong> -- <li> <strong> <a href=#run8> How can I reach mldonkey WEB interface --if my firewall only allows port 80 ? </a> </strong> -- </ol> -- -- <a name=index_gui> -- <li> <h3> Running the GTK GUI </h3> </a> -- -- <ol> -- <li> <strong> <a href=#gui1> When I start the GUI, I get a lot of error messages, and the GUI terminates with a "Segmentation Fault" ? </a> </strong> -- <li> <strong> <a href=#gui2> I can't connect to mldonkey from a remote host, neither by telnet, WWW or the GUI ? </a> </strong> -- <li> <strong> <a href=#gui3> The GUI is immediatly disconnected from the core, or keeps connecting and disconnecting very fast ? </a> </strong> -- </ol> -- -- <a name=index_build> -- <li> <h3> Building mldonkey </h3> </a> -- -- <ol> -- <li> <strong> <a href=#build1> How can I download the latest sources of mldonkey ? </a> </strong> -- <li> <strong> <a href=#build2> What do I need to compile mldonkey on my system ? </a> </strong> -- <li> <strong> <a href=#build3> How do I compile mldonkey on my system ? </a> </strong> -- <li> <strong> <a href=#build4> I just updated from CVS, and I get an error while compiling ? </a> </strong> -- </ol> -- -- <a name=index_edonkey> -- <li> <h3> The eDonkey plugin </h3> </a> -- -- <ol> -- <li> <strong> <a href=#edonkey0> What is the eDonkey network ? </a> </strong> -- <li> <strong> <a href=#edonkey1> Why can't mldonkey connect to any server ? </a> </strong> -- <li> <strong> <a href=#edonkey2> How can I import my old edonkey files under mldonkey ? </a> </strong> -- <li> <strong> <a href=#edonkey3> Where can I find files on eDonkey without searching on servers ? </a> </strong> -- <li> <strong> <a href=#edonkey4> Why does mldonkey only connect 5 --servers, whereas <tt> max_connected_servers </tt> is greater ? </a> </strong> -- <li> <strong> <a href=#edonkey5> What's about Overnet ? </a> </strong> -- <li> <strong> <a href=#edonkey6> I'm behind a firewall, what should I do ? </a> </strong> -- <li> <strong> <a href=#edonkey7> How can I share multiple directories ? </a> </strong> -- </ol> -- -- <a name=index_soulseek> -- <li> <h3> The Soulseek plugin </h3> </a> -- -- <ol> -- <li> <strong> <a href=#slsk0> What is the Soulseek network ? </a> </strong> -- <li> <strong> <a href=#slsk1> I can't connect to the server ? </a> </strong> -- </ol> -- -- <a name=index_limewire> -- <li> <h3> The LimeWire plugin </h3> -- -- <ol> -- <li> <strong> <a href=#limewire0> What is the LimeWire network ? </a> </strong> -- <li> <strong> <a href=#limewire1> When I search for files, I receive unrelated results ? </a> </strong> -- </ol> -- -- <li> <h3> The other plugins </h3> -- <ol> -- <li> <strong> <a href=#other1> What is the current Development Status of --mldonkey plugins ? </a> </strong> -- </ol> --</ol> -- -- -- -- -- -- --<ol> -- --<hr> --<li> <h2> Background </H2> -- --<ol> -- <li> <h3> <a name=back1> What is mldonkey ? </a> </h3> -- --Formerly, mldonkey was a Linux client for the eDonkey network, built from --a reverse-engineered version of the protocol. Now, it is also able to connect --to multiple networks (gnutella, Direct-Connect, Soulseek, etc). -- --<p> --MLdonkey runs on most Unix clones: Linux (x86, alpha, sparc), Mac OS X, --Solaris x86, Free/OpenBSD, etc. -- --<p> -- --It runs as a daemon, in the background, that can run, downloading and sharing --files, 24 hours a day. You can interact with your mldonkey daemon, either --locally or remotely, by a telnet interface, a WEB interface or a GTK --GUI. Other GUIs have also been created for mldonkey. -- -- <li> <h3> <a name=back2> Why use Objective-Caml to program mldonkey ? </a> </h3> -- --Most programmers associate functional languages with languages theory, --lambda-calculus, recursivity, and non-mutable variables, ie the most --boring lectures at university. -- --<p> -- Fortunately, Objective-Caml is not only a functional language: it also --provides many other programming paradigms, such as imperative constructs --(<tt>while</tt> and <tt>for</tt> loops, mutable variables, records), --object-oriented constructs, and a powerful C-interface. Moreover, its --native-code compiler carefully checks your program for typing errors (no --more segfaults !), and produces a very efficient code (even faster than C --on many examples). -- --<p> --If you don't believe me, check the following links: --<ul> --<li> --<a href="http://www.bagley.org/~doug/shootout/"> A comparison between many languages </a> --<li> Two Objective Caml programs win first and second prizes at the --<a href="http://www.cs.cornell.edu/icfp/"> ICFP'2000 programming contest </a>, -- to write a ray-tracer program. --<li> An Objective Caml program ranks first at the --<a href="http://www.cs.virginia.edu/~jks6b/icfp/"> ICFP'1999 programming contest </a>. --</ul> -- --<li> <h3> <a name=back3> Where can I find support on mldonkey ? </a> </h3> -- --The first place is the --<a href="http://savannah.nongnu.org/projects/mldonkey/"> MLdonkey Project Site</a> -- where you will find: -- --<ul> -- <li> The <a href="mailto:mldonkey-users@mail.freesoftware.fsf.org"> --mldonkey-users@mail.freesoftware.fsf.org </a> Mailing-list, where you can --either contact the developpers or ask other users for advises. -- <li> The --<a href="http://savannah.nongnu.org/bugs/?group=mldonkey"> Bug Report --system </a> -- to report bugs appearing when running mldonkey. -- <li> The --<a href="http://savannah.nongnu.org/support/?group=mldonkey"> --Support system </a> where you can ask for support in running mldonkey. --</ul> -- --<p> You can also try to read/post in the --<a href="http://www.mldonkeyworld.com/"> -- MLDonkey Forums </a> or on the IRC Channel #mldonkey on irc.freenode.net . -- -- <li> <h3> <a name=back4> Where can I download mldonkey ? </a> </h3> -- --The latest stable binaries can be downloaded from the --<a href="http://savannah.nongnu.org/download/mldonkey/"> -- Project Download page </a>. -- --If you want a more recent version of mldonkey, you need to check out the --sources from the CVS, and compile it yourself. --See <a href=#index_build> Building Mldonkey </a> for help. -- --<li> <h3> <a name=back5> Where can I find mldonkey for Windows ? </a> </h3> -- --MLdonkey does not run very well under Cygwin on Windows. Moreover, there --is no native port of MLdonkey to Windows, so you will not be able to run --it on these systems. -- -- <p> -- -- If you have some knowledge of MinGW, you might try to compile -- Objective-Caml and mldonkey. It would probably run better than under -- Cygwin. Note that mldonkey does not use threads, and the select call -- is only used to descriminate between sockets (read/write/connect/accept). -- --<li> <h3> <a name=back6> What's new with MLdonkey 2.00 ? </a> </h3> -- -- If you were using MLdonkey 1.16, you might be interested in knowing what is new -- with MLdonkey 2.00. Here are the main improvements: -- -- <ul> -- -- <li> Overnet support. -- <li> Completely New GUI: upload panel, icons, configuration of many options. -- <li> Post-filtering of results (see Overnet or LimeWire plugins). -- <li> Multi-networks support (sources and CVS only). -- <li> Many bug fixes: memory leak, "too many open file descrs", sharing, -- upload/download rates, ... -- </ul> -- --</ol> -- --<hr> --<li> <h2> Running mldonkey </H2> -- --<ol> -- --<li> <H3> <a name=run1> How should I start mldonkey ? </a> </H3> -- --mldonkey will install its configuration files in the directory where you --start it. So, first, choose the right directory, where you want it to run. --Then, copy the "servers.ini" file that is in the distribution in this --directory. I suppose here that mldonkey is started in its directory. -- --Start mldonkey with: -- --<pre> --./mldonkey --</pre> -- --It should display some debug info. DON'T CLOSE THE TERMINAL WHERE IT --WAS STARTED, otherwise it might get blocked on terminal output. -- -- Once you are sure it works correctly, you can dump the debug info in a file --(but it can become very big) or better in /dev/null, the next time you --start it: -- --<pre> --./mldonkey &> /dev/null --</pre> -- --<li> <h3> <a name=run2> How can I control mldonkey ? </a> </h3> -- -- You have three different ways to control the mldonkey daemon (note that, by --default, mldonkey is configured to accept only control connections from the --host running mldonkey (<a href=#gui2> more info </a>)): -- --<ul> -- --<li> The telnet interface: the telnet interface allows you to control --mldonkey locally or remotely from a terminal with simple commands: --<pre> --telnet localhost 4000 --</pre> --where <tt> localhost </tt> is the host running mldonkey and 4000 is the --default port for the telnet interface. -- --<p> --There are many commands available. Use the <tt> help </tt> command to --display all of them. -- --<li> The WEB interface: the WEB interface allows you to control mldonkey --through your favorite navigator. The default url is: -- --<pre> --http://localhost:4080/ --</pre> -- --where <tt> localhost </tt> is the host running mldonkey and 4080 is the --default port for the WEB interface. -- --<li> The GTK GUI: you can use a powerful GTK interface to control mldonkey. --It is called <tt> mldonkey_gui </tt>. Use the File::Setting menu to --configure how to connect to your mldonkey daemon. -- -- --</ul> -- --<li> <h3> <a name=run3> Where/what are mldonkey configuration files ? </a> </h3> -- --MLdonkey creates its configuration files in the directory where it is --started. All of them terminate with a .ini extension. You should not --modify them while mldonkey is running since it periodically overwrites --them. Instead you should either stop it, or modify the options using one of --the interfaces. -- --<ul> -- --<li> <tt> downloads.ini </tt> : the basic options (and historically, the --edonkey plugin options) --<li> <tt> files.ini </tt> : the list of files being currently downloaded, --and informations needed to recover the download after a stop. --<li> <tt> servers.ini </tt> : the list of all known servers for all networks. --<li> <tt> friends.ini </tt> : the list of your friends (peers you like to --browse files) on all networks. -- --<li> Other configuration files are used by mldonkey plugins, normally one --per network. -- --<li> <tt> ~/.mldonkey_gui.ini </tt> : the GUI configuration file is the --only one which is not stored in the mldonkey directory. -- --</ul> -- --<li> <h3> <a name=run4> How can I control the bandwidth used by mldonkey ? </a> </H3> -- --There are two options in the downloads.ini file: max_hard_upload_rate and --max_hard_download_rate. Setting these options to 0 means that there are no --limits. They are expressed in kilobytes/second (not kilobits/second !). --The upload limit both applies to the files which are downloaded from you, --and for the messages you send to ask for files: be careful not to limit --your upload too much ! -- --<p> --<table border="1" cellpadding="5" align=center> -- --<tr> --<td align=center> </td> --<td align=center colspan=2> Low Bandwidth Usage </td> --<td align=center colspan=2> High Bandwidth Usage </td> --</tr> -- --<tr> --<td align=center> Your Connection Type </td> --<td align=center> max_hard_upload_rate </td> --<td align=center> max_hard_download_rate </td> --<td align=center> max_hard_upload_rate </td> --<td align=center> max_hard_download_rate </td> --</tr> -- --</tr> --<td> T1 and more </td> --<td align=center> 50 </td> --<td align=center> 0 </td> --<td align=center> 0 </td> --<td align=center> 0 </td> --</tr> -- --</tr> --<td> Cable/ADSL 512/128 kbs </td> --<td align=center> 2 </td> --<td align=center> 6 </td> --<td align=center> 6 </td> --<td align=center> 12 </td> --</tr> -- --</tr> -- --If you have troubles with these values, find the best one corresponding to --your link and send us the information to fix this table ! -- --</table> -- --<li> <h3> <a name=run5> When I modify an option in the config file, mldonkey overwrites it --with its old value ? </a> </h3> -- --There are two cases: --<ul> -- <li> When you edit a config file, mldonkey must not run. Indeed, mldonkey --saves its configuration periodically, overwritting any changes made in the --files. -- <li> Be careful with the syntax. If mldonkey can't parse the config file, it --will generate a new file with the old values for all options that couldn't --be read correctly. You must remember that you must put filenames and directory --names between "" (they are not always required if there are no special --characters inside the name (such as spaces, slashes, etc...), so mldonkey can --remove them in some cases). -- --</ul> -- --<li> <h3> <a name=run6> Where are the files I have downloaded with --mldonkey ? </a> </h3> -- --Files being currently downloaded are temporarily stored in the <tt> --temp/ </tt> directory at the level of mldonkey config files. Files in this --directory are identified by their MD4 (for edonkey files) or by a random --identifier. -- --<p> When the download of a file is finished, the file is added to a list --of files that have to be "committed". These files are not renamed, so they --are still kept in the temp directory. -- -- <p> To move finished downloads into the <tt> incoming/ </tt> directory with --their final name, you need to use the command <tt> commit </tt> in the --telnet, or the "Save" buttons in the GUI. -- --<li> <h3> <a name=run7> Why does MLdonkey automatically pause some of my downloads ? </a> </h3> -- -- When mldonkey receives data for a file from the network, it tries to write --this data in the file in the temp/ directory. If, for some reason, it cannot --write the data, it immediatly pauses the file. -- --<p> This can happen for different reasons: -- --<ul> -- <li> You have no space left on the disk. You can verify it with the "df" -- command, and free some space for the downloads to continue. -- <li> The user running mldonkey has not write permissions to write in -- your temp/ directory, or on the file temporary file. --</ul> -- --<li> <h3> <a name=run8> How can I reach mldonkey WEB interface --if my firewall only allows port 80 ? </a> </h3> -- --If you want to access the WEB interface (port 4080) through a firewall, --and the firewall only allows port 80, and you don't want to run mldonkey --as root, you can set up the apache WEB server to redirect requests to mldonkey: -- --<ul> -- <li> Edit your "httpd.conf" : Insert the following lines somewhere in the --"Section 2: main server configuration": -- --<pre> --RewriteEngine on --ProxyRequests on --RewriteRule /mldonkey http://localhost:4080/$1 [P,L] --RewriteRule /(submit.*) http://localhost:4080/$1 [P,L] --RewriteRule /(files.*) http://localhost:4080/$1 [P,L] --ProxyPassReverse /(.*) http://localhost:4080/$1 --</pre> -- --where, of course, <tt> localhost </tt> is your mldonkey host, and <tt> --4080 </tt> is the <tt> http_port </tt> of mldonkey. -- --<li> With these rules, <tt> http://aaa.bbb.ccc.ddd/mldonkey </tt>, --where <tt>aaa.bbb.ccc.ddd</tt> is the IP address of the host running the --apache server, should connect to your mldonkey. -- --</ul> -- --</ol> -- --<hr> --<li> <h2> Running the GTK GUI </h2> -- --<ol> -- --<li> <H3> <a name=gui1> When I start the GUI, I get a lot of error messages, --and the GUI terminates with a "Segmentation Fault" ? </a> </H3> -- --You probably use the "static" binary of mldonkey GUI. Download the --"shared" binaries from this site, and use that GUI. This bug is caused by --an incompatibility between the statically linked GTK library and the --themes installed on your distribution. -- --<li> <H3> <a name=gui2> I can't connect to mldonkey from a remote host, --neither by telnet, WWW or the GUI ? </a> </H3> -- --You need to modify the "allowed_ips" option in the downloads.ini file to --define which hosts are allowed to control your mldonkey core. -- --You can either stop mldonkey, and edit the downloads.ini file: -- --<pre> --allowed_ips = ["127.0.0.1"; "192.168.255.255"; "65.64.43.63"] --</pre> -- --for example allows your localhost (127.0.0.1) to control mldonkey, all the --hosts from the network 192.168.*.*, and the host 65.64.43.63. -- --If you don't want to stop mldonkey, just connect locally with the telnet, --and type: -- --<pre> --set allowed_ips "127.0.0.1 192.168.255.255 65.64.43.63" --</pre> -- --<li> <h3> <a name=gui3> The GUI is immediatly disconnected from the core, or keeps connecting and disconnecting very fast ? </a> </h3> -- --There are two cases to consider: -- --<ul> -- --<li> You have set a password in the core to access it through the GUI: you --must enter the password in the GUI too (use the <tt> Files :: Settings --</tt> menu for that. -- -- <li> You have two GUIs connected to the same core: the core (1.99 and --later) only allows one GUI to be connected simultaneously. When you connect, --it immediatly disconnects the previous GUI. This can only work if the --previous GUI does not try to reconnect automatically: <tt> mldonkey_gui </tt> --will not reconnect, but maybe you are using another contributed GUI, which --tries to automatically reconnect, and make the core disconnect your GUI ? --Then, tell its author to remove this feature or to put an option to disable --it. -- --</ul> -- --</ol> -- --<hr> --<li> <h2> Building mldonkey </h2> -- --<ol> -- <li> <h3> <a name=build1> How can I download the latest sources --of mldonkey ? </a> </h3> -- -- Checkout the sources of mldonkey from the --<a href="http://savannah.nongnu.org/cvs/?group_id=1409"> CVS repository </a>. --Here is the standard procedure: -- --<!-- --or download the --<a href="http://freesoftware.fsf.org/cvs.backups/mldonkey.tar.gz"> --CVS tarball --</a> (be careful, . ----> -- --<pre> --cvs -d:pserver:anoncvs@subversions.gnu.org:/cvsroot/mldonkey login --(password: just hit enter) --cvs -z3 -d:pserver:anoncvs@subversions.gnu.org:/cvsroot/mldonkey co mldonkey --</pre> -- -- -- <li> <h3> <a name=build2> What do I need to compile mldonkey on my system ? </a> </h3> -- -- You need ocaml-3.06 (<a href="http://caml.inria.fr/ocaml/distrib.html"> --Ocaml site </a>) installed -- for the code -- and <a href="http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/lablgtk.html"> --lablgtk </a> compiled in native code with ocaml 3.06 for the GTK gui. -- --The easiest way is to download binaries for your system. Otherwise, use --the following lines to install them: -- --<ul> -- <li> Installing Objective-Caml 3.06 in <tt>/usr/local/bin</tt> -- --<pre> -- ~/tmp> tar zxf ocaml-3.06.tar.gz -- ~/tmp> cd ocaml-3.06 -- ~/tmp/ocaml-3.06> ./configure -- ~/tmp/ocaml-3.06> make world opt opt.opt -- ~/tmp/ocaml-3.06> make install --</pre> -- --<li> LablGTK 1.2.3 for example -- --<pre> -- ~/tmp> tar zxf lablgtk-1.2.3.tar.gz -- ~/tmp> cd lablgtk-1.2.3 -- ~/tmp/lablgtk-1.2.3> make configure -- ~/tmp/lablgtk-1.2.3> make -- ~/tmp/lablgtk-1.2.3> make opt -- ~/tmp/lablgtk-1.2.3> make install --</pre> -- --Do not forget the "make opt" which is required to get a native-code version --of the libraries. -- --</ul> -- -- <li> <h3> <a name=build3> How do I compile mldonkey on my system ? </a> </h3> -- -- -- To compile the core, you just need to use the following commands: -- <pre> -- cd mldonkey -- ./configure [...options...] -- make depend -- make -- </pre> -- -- You should now have a "mldonkey" executable ... No "make install" is -- provided. -- --<p> If you get strange errors from make, you probably need to use "gmake" --on your system. -- -- <p> -- You can use the following options for the configure: --<ul> --<li> --enable-batch : install Objective-Caml and Lablgtk locally just --to be able to compile mldonkey. --<li> --disable-multinet: allows you to only compile support for edonkey --<li> --disable-opennap: allows you to remove support for Open Napster --<li> --disable-limewire: allows you to remove support for LimeWire --<li> --disable-directconnect: allows you to remove support for Direct Connect --<li> --disable-soulseek: allows you to remove support for SoulSeek --<li> --disable-openft: allows you to remove support for OpenFT --<li> --disable-donkey: allows you to remove support for eDonkey --</ul> -- --<li> <h3> <a name=build4> I just updated from CVS, and I get an error while compiling ? </a> </h3> -- -- After an update from the CVS, you MUST restart the configure script, and --rebuild the dependencies: -- -- <pre> -- cd mldonkey -- cvs login -- cvs -z3 up -d -- ./configure [...options...] -- make depend -- make -- </pre> -- -- If the error messages are related to camlzip, a workaround is to edit --manually the file <tt> config/Makefile.config </tt>, and to change the line --<tt> ZLIB=no </tt> and <tt> SOULSEEK=no </tt> (only soulseek requires --camlzip). -- --</ol> -- --<hr> --<li> <h2> The eDonkey plugin </h2> -- --<ol> -- --<li> <H3> <a name=edonkey0> What is the eDonkey network ? </a> </H3> -- -- The <a href="http://www.edonkey2000.com"> eDonkey network </a> is a network --specialized in sharing really big files (between 0 to 1.4 GB). -- --<p> --This network offers a set of characteristics that cannot be found on other networks: --<ul> -- <li> Files can be downloaded from different sources at the same time. -- <li> Files are identified by uniq identifiers (MD4) that can be used to find -- new sources for a file. -- <li> Files are checked using checksums, and chunks (9MB) that are corrupted -- are downloaded again. -- <li> Files chunks can be downloaded in any order. -- <li> Files are shared as soon as a checked chunk has been downloaded, to -- speed up the spreading of files. --</ul> -- --<li> <H3> <a name=edonkey1> Why can't mldonkey connect to any server ? </a> </H3> -- --<ul> -- <li> First, check that you have some servers known by mldonkey: connect --to mldonkey by telnet (telnet localhost 4000) and use the "vma" command to --display all known servers. -- <li> If you have no servers known, you need to add a list of servers for --mldonkey to connect to them: you can either: -- <ul> -- <li> Manually add them in the telnet :) -- <li> Import a Windows server.met file (downloaded on the WEB): -- use the "servers" command in the telnet, for example: -- --<pre> --servers "/mnt/windows/bureau/edonkey server list/server.met" --</pre> -- -- <li> You can restart mldonkey after copying the "servers.ini" file that --was in the distribution. -- </ul> -- <li> If you already have a list of known servers, maybe the list is not --up-to-date, and maybe the servers are full. Try to add some new servers --like above. --</ul> -- --<li> <h3> <a name=edonkey2> How can I import my old edonkey files under mldonkey ? </a> </h3> -- --<ul> -- <li> Use the <tt>import</tt> command with the donkey directory containing your old --config as parameter. If your old edonkey was running on --<tt> /home/bidule/edonkey </tt> (mldonkey should find a "pref.met" file in --this directory), you can send the following command on mldonkey console: -- --<pre> --import "/home/bidule/edonkey" --</pre> -- -- <li> This might not work for a Windows configuration, since the absolute --path under windows is not the same as under linux (different mount points). --In this case, retry this command, but before, make sure that: -- --<ul> -- <li> The files you want to import are in a "temp" directory, inside the --directory you give to the "import" command. -- <li> Remove the "pref.met" file, so that mldonkey does not try to use the --temp directory specified in this file. --</ul> -- --</ul> -- -- <li> <h3> <a name=edonkey3> Where can I find files on eDonkey without searching on servers ? </a> </h3> -- -- There are two kinds of WEB sites where you can find <a href=#edonkey4> --ed2k:// links </a> for files on eDonkey: -- --<ul> -- <li> Recommandation Engines: on these Web sites, you will find commented -- files, that you are sure to find complete on the eDonkey network. -- --<ul> -- <li> The most famous is <a href="http://www.sharereactor.com"> Share --Reactor </a> --</ul> -- -- <li> Search Engines: these Web sites allow you to search for files --that are currently available on some servers. However, you have no --guaranty they are complete: -- --<ul> -- <li> <a href="http://www.filedonkey.com"> File Donkey </a> -- <li> <a href="http://www.jigle.com"> Jigle </a> --</ul> --</ul> -- -- <li> <h3> <a name=edonkey4> Why does mldonkey only connect 5 --servers, whereas <tt> max_connected_servers </tt> is greater ? </a> </h3> -- --Being connected to several servers can be useful to spread the files you --are uploading, and to initially find more sources to begin a download. -- --<p> However, each server on which you are connected is not available for --another user. For this reason, you should not stay connected to too many --servers. mldonkey enforces this policy by limiting to 5 the number of --servers on which you remain connected for a long time, whatever the value --of <tt> max_connected_servers </tt> is. -- --<p> Thus, you should simply see <tt> max_connected_servers </tt> as the --number of servers mldonkey tries to connect concurrently to at the --startup, not as the number of servers he will remain connected to. -- --<li> <h3> <a name=edonkey5> What's about Overnet ? </a> </h3> -- -- <a href="http://www.overnet.com"> Overnet </a> is a network using the same -- download protocol as edonkey, but a different -- <a href="http://citeseer.nj.nec.com/529075.html"> search/localisation protocol </a>, -- that doesn't need servers. -- -- <p> -- -- MLdonkey 2.00 is able to search for files and sources on Overnet. For that, you must -- make sure that: -- -- <ol> -- -- <li> The "overnet_search_sources" and "overnet_search_keywords" options are set to -- true. -- -- <li> You have a (recent) list of Overnet peers that you can connect to. For that, you -- can: -- -- <ul> -- <li> Use the "servers.ini" file from the most recent distribution of mldonkey. It -- contains a long list of Overnet peers. -- -- <li> Use the "boot IP PORT" command, to add a new peer. -- -- <li> Use the "ovweb URL" command, to download a .ocl file from url URL -- containing a list of recent peers. -- -- </ul> -- -- You can use the "ovstats" command, to display how many peers you have been able -- to connect to (well, they have replied to a connect UDP packet). -- -- <li> If you have enabled "overnet_search_keywords", replies to search can arrive from -- Overnet peers. These results are not very accurate (they only need to match only -- one of the keywords, instead of all for example). -- -- <p> -- -- As for all networks, you can activate post-filtering of results (very useful on -- Gnutella too): set the "filter_search" option to true, and maybe the "filter_search_delay" -- option (period between results updates in seconds). Then, only results matching exactly -- your query will be displayed. -- -- </ol> -- -- <li> <h3> <a name=edonkey6> I'm behind a firewall, what should I do ? </a> </h3> -- --MLdonkey uses two ports for incoming connections, one on TCP (default is --4662) and the other one for UDP (4666). Thus, you should open these ports --in your firewall, and forward them to the computer running mldonkey. More --generally, you can do that for all ports between 4660 and 4670. -- --<p> Allowing incoming connections is important as it is the only way for --you to connect other sources which are behind a firewall. -- --<p> If you have no control on the firewall, and your administrator blocks --port 4660 to 4670, you should change the port used by mldonkey in the configuration --file <tt> downloads.ini </tt> : <tt> port </tt> is the TCP port, while the --UDP port is always computed as <tt> port + 4 </tt>. -- --<li> <h3> <a name=edonkey7> How can I share multiple directories ? </a> </h3> -- --Just edit the <tt> shared_directories </tt> option in <tt> downloads.ini </tt>: -- --<pre> --shared_directories = [ "/usr/share/documents"; "/usr/share/videos"] --</pre> -- --</ol> -- -- --<hr> --<li> <h2> The Soulseek plugin </h2> -- --<ol> -- --<li> <H3> <a name=slsk0> What is the Soulseek network ? </a> </H3> -- --The <a href="http://www.soulseek.org"> Soulseek Network </a> is a network --similar to Napster. -- -- <p> You connect on a single server, and there, you can search for (mainly --audio) files, you can join rooms to chat with other users, and you can browse --other users files. -- --<li> <H3> <a name=slsk1> Why can't mldonkey connect to any server ? </a> </H3> -- --There is only one server on Soulseek, and the one you have in soulseek.ini --is probably not up-to-date. Normally, mldonkey will download another one, so --that you will have to servers in your list of servers. -- --<p> --By default, mldonkey_gui does not display the servers you are not --connected to. So you have to use the "Display All Servers" button, and ask --mldonkey to try to connect to the second soulseek server. -- --<p> --Currently, the server is <tt> mail.slsk.org </tt>, port 2242. -- --<p> --Mldonkey behavior will be improved to automatically connect to the current -- server from the soulseek site Web page. -- --</ol> -- --<hr> --<li> <h2> The LimeWire plugin </h2> -- --<ol> -- -- <li> <h3> <a name=limewire0> What is the LimeWire network ? </a> </h3> -- -- The <a href="http://www.limewire.org"> LimeWire network </a> is a --network built upon the <a href="http://www.gnutella.org"> Gnutella network </a>. -- --<p> --The main difference is that all nodes in this network do not broadcast each --received message to its neighbours. Instead, special nodes, called --ultra-peers, with higher connectivity are dedicated for this task, whereas --other smaller nodes (such as mldonkey) only connect and ask ultra-peers. -- --<p> --Currently, the LimeWire support in MLdonkey also allows mldonkey client to --use <a href="http://www.gnucleus.org"> Gnucleus </a>, --<a href="http://www.morpheus.com"> Morpheus </a>, and MyNapster --ultra-peers as servers. -- --<p> --On this network, you can mainly search for small files, you have no way to --chat nor browse other peers. -- -- <li> <h3> <a name=limewire1> When I search for files, I receive unrelated results ? </a> </h3> -- --On Gnutella, there is no specified protocol for asking complex queries to --other peers. Instead, each peer is free to interpret your query as it --wants and reply what it wants. -- --<p> --In particular, multiple-words queries are often understood as logical-or --queries between words, ie each document that contains at least one word is returned. -- --<p> -- As for Overnet, you can activate post-filtering of sources. Then, results -- which are received are checked by mldonkey against the query and only displayed if -- they are accurate. Post-Filtering is activated by setting the "filter_search" option -- to true, and modifying the "filter_search_delay" depending on the period you -- want between updates (for example, 30 means that results will be added only every -- 30 seconds). -- --</ol> -- --<hr> --<li> <h2> The other plugins </h2> -- --<ol> --<li> <h3> <a name=other1> What is the current Development Status of --mldonkey plugins ? </a> </h3> -- -- The current Development Status of mldonkey (in the CVS) at 2002/09/09 is --shown on the following table (also have a look at the --<a href="http://savannah.nongnu.org/cgi-bin/viewcvs/*checkout*/mldonkey/mldonkey/distrib/ChangeLog?rev=HEAD&content-type=text/plain"> --ChangeLog --</a>) -- -- --<table border="1" cellpadding="5"> --<tr bgcolor="#80FF80"> --<td align=center width="12%"> Features </td> --<td align=center width="9%"> <a href=http://www.edonkey2000.com/> eDonkey </a> </td> --<td align=center width="9%"> <a href=http://www.neo-modus.com/> Direct --Connect </a> </td> --<td align=center width="9%"> <a href=http://opennap.sourceforge.net/> Open --Napster </a> </td> --<td align=center width="9%"> <a href=http://www.limewire.org> Gnutella --LimeWire </a> </td> --<td align=center width="9%"> <a href=http://www.slsk.org> Soulseek </a> </td> --<td align=center width="9%"> <a href=http://gift.sourceforge.net> OpenFT </a> </td> --</tr> -- -- --<tr> --<td> Download Server List </td> --<td align=center> 1.16 </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> </td> --</tr> -- -- --<tr> --<td> Server Connect </td> --<td align=center> 1.16 </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --</tr> -- -- --<tr> --<td> View Server Users </td> --<td align=center> 1.16 </td> --<td align=center> CVS </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --</tr> -- --<tr bgcolor=yellow> --<td> Search Files </td> --<td align=center> 1.16 </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> (web) </td> --<td align=center> CVS </td> --</tr> -- --<tr> --<td> Browse Peer </td> --<td align=center> 1.16 </td> --<td align=center> CVS </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> CVS </td> --<td align=center> </td> --<td align=center> </td> --</tr> -- --<tr bgcolor=yellow> --<td> Download Files </td> --<td align=center> 1.16 </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --</tr> -- --<tr> --<td> Recover Files </td> --<td align=center> 1.16 </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> </td> --<td align=center> CVS </td> --<td align=center> </td> --</tr> -- --<tr> --<td> Recover Sources </td> --<td align=center> 1.16 </td> --<td align=center> CVS </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --</tr> -- --<tr> --<td> Pause Downloads </td> --<td align=center> 1.16 </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> CVS </td> --<td align=center> </td> --</tr> -- --<tr> --<td> Cancel Downloads </td> --<td align=center> 1.16 (not CVS) </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> CVS </td> --<td align=center> </td> --</tr> -- -- --<tr bgcolor=yellow> --<td> Upload Files </td> --<td align=center> 1.16 </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --</tr> -- -- --<tr> --<td> Upload File List </td> --<td align=center> 1.16 </td> --<td align=center> CVS </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --</tr> -- -- --<tr> --<td> Friends </td> --<td align=center> 1.16 </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --</tr> -- --<tr> --<td> Public Messages </td> --<td align=center> </td> --<td align=center> CVS </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> CVS </td> --<td align=center> </td> --<td align=center> </td> --</tr> -- -- --<tr> --<td> Private Messages </td> --<td align=center> 1.16 </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --</tr> -- --<tr> --<td> Import Windows Config </td> --<td align=center> 1.16 </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --<td align=center> </td> --</tr> -- --<tr> --<td> Config File </td> --<td align=center> downloads.ini </td> --<td align=center> directconnect.ini </td> --<td align=center> opennap.ini </td> --<td align=center> limewire.ini </td> --<td align=center> soulseek.ini </td> --<td align=center> openft.ini </td> --</tr> -- --<tr> --<td> Disable Network </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --<td align=center> CVS </td> --</tr> -- --</table> -- -- --</ol> -- --</ol> -- --<p> -- --If you have any comments, if you want to add some questions, or improve --this FAQ, send a mail to <a href="mailto:mldonkey@mldonkey.net"> --mldonkey@mldonkey.net </a> -- --</body> --</html> -Index: distrib/Install.txt -=================================================================== -RCS file: /sources/mldonkey/mldonkey/distrib/Install.txt,v -retrieving revision 1.10 -retrieving revision 1.11 -diff -u -r1.10 -r1.11 ---- distrib/Install.txt 3 Feb 2006 00:45:15 -0000 1.10 -+++ distrib/Install.txt 23 Oct 2006 12:58:35 -0000 1.11 -@@ -63,17 +63,17 @@ - is compiled. - - ------------------------------------------------------------------------ --1) Installing required tools: Objective-Caml 3.08.3 and LablGTK -+1) Installing required tools: Objective-Caml 3.09.3 and LablGTK - -- 1.1) Objective-Caml 3.08.4 (from http://pauillac.inria.fr/caml) -+ 1.1) Objective-Caml 3.09.3 (from http://pauillac.inria.fr/caml) - -- ~/tmp> wget http://caml.inria.fr/distrib/ocaml-3.08/ocaml-3.08.4.tar.gz -- ~/tmp> tar zxf ocaml-3.08.4.tar.gz -- ~/tmp> cd ocaml-3.08.4 -+ ~/tmp> wget http://caml.inria.fr/distrib/ocaml-3.09/ocaml-3.09.3.tar.gz -+ ~/tmp> tar zxf ocaml-3.09.3.tar.gz -+ ~/tmp> cd ocaml-3.09.3 - -- ~/tmp/ocaml-3.08.4> ./configure -- ~/tmp/ocaml-3.08.4> make world.opt -- ~/tmp/ocaml-3.08.4> make install -+ ~/tmp/ocaml-3.09.3> ./configure -+ ~/tmp/ocaml-3.09.3> make world.opt -+ ~/tmp/ocaml-3.09.3> make install - - 1.2.1) LablGTK 1.2.7 for GTK1 - (from http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/lablgtk.html) -@@ -86,22 +86,22 @@ - ~/tmp/lablgtk-1.2.7> make opt - ~/tmp/lablgtk-1.2.7> make install - -- 1.2.2) LablGTK-2.4.0 for GTK2 -+ 1.2.2) LablGTK-2.6.0 for GTK2 - (from http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/lablgtk.html) - -- ~/tmp> wget http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/dist/lablgtk-2.4.0.tar.gz -- ~/tmp> tar zxf lablgtk-2.4.0.tar.gz -- ~/tmp> cd lablgtk-2.4.0 -- ~/tmp/lablgtk-2.4.0> ./configure -- ~/tmp/lablgtk-2.4.0> make world -- ~/tmp/lablgtk-2.4.0> make install -+ ~/tmp> wget http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/dist/lablgtk-2.6.0.tar.gz -+ ~/tmp> tar zxf lablgtk-2.6.0.tar.gz -+ ~/tmp> cd lablgtk-2.6.0 -+ ~/tmp/lablgtk-2.6.0> ./configure -+ ~/tmp/lablgtk-2.6.0> make world -+ ~/tmp/lablgtk-2.6.0> make install - - 2) Compiling mldonkey with GUI: - - To build GTK1 newgui: ./configure --enable-gui=newgui1 - To build GTK1 oldgui: ./configure --enable-gui=oldgui - To build GTK2 GUI: ./configure --enable-gui[=newgui2] -- lablgtk-1.2.7 and lablgtk-2.4.0 can both be installed at the same time. -+ lablgtk-1.2.7 and lablgtk-2.6.0 can both be installed at the same time. - - ~/tmp/mldonkey> make - -Index: distrib/Readme.txt -=================================================================== -RCS file: distrib/Readme.txt -diff -N distrib/Readme.txt ---- distrib/Readme.txt 1 May 2005 17:43:11 -0000 1.16 -+++ /dev/null 1 Jan 1970 00:00:00 -0000 -@@ -1,433 +0,0 @@ -- *** THIS FILE IS OUTDATED. PLEASE HAVE A LOOK AT THE *** -- *** WIKI PAGE FOR BASIC INFORMATION ABOUT INSTALLING *** -- -- -- MLDonkey -- ======== -- --Release: 1.16 --Authors: [b8]_bavard (Communication engine) and [b8]_Zoggy (GUI) -- -- MLDonkey is a door to the 'donkey' network, a decentralized network used to --exchange big files on the Internet. It is written in a wonderful language, --called Objective-Caml, and present most features of the basic Windows donkey --client, plus some more: -- - It should work on most UNIX-compatible platforms. -- - You can remotely command your client, either by telnet, on a WEB browser, -- or with the GTK interface. -- - You can connect to several servers, and each search will query all the -- connected servers. -- - You can select mp3s by bitrates in queries (useful ?). -- - You can select the name of a downloaded file before moving it to your -- incoming directory. -- - You can have several queries in the graphical user interface at the same -- time. -- - You can remember your old queries results in the command-line interface. -- - You can search in the history of all files you have seen on the network. -- -- --USAGE: --====== -- -- This package contains three files: 'mldonkey', 'mldonkey_gui' and --servers.ini'. -- --'mldonkey' is the main program, a daemon which is used to download files. --It takes no argument, and outputs some debugging messages on his terminal, --so you should not close it. So, to start your program in the background, --you can use: -- --prompt> ./mldonkey > mldonkey.log & -- -- 'mldonkey' expects to find several .ini files in the directory --where it is started. You can use the file provided in this package, or your --old one if you already used 'mldonkey' before. It contains a list of servers --that were available when the release was done. You can edit 'downloads.ini' --to modify its parameters before starting 'mldonkey', but you can also --modify the parameters in the graphical user interface 'mldonkey_gui'. -- -- 'mldonkey_gui', the graphical user interface, can be started by: -- --prompt> ./mldonkey_gui & -- -- 'mldonkey_gui' doesn't need to be started in the same directory as --'mldonkey'. Without parameters, it expects to find 'mldonkey' running on the --same computer on the default port. If you started 'mldonkey' on another --computer, you should specify the hostname (myhost.mydomain.mydot for example) --on the command line: -- --prompt> ./mldonkey_gui myhost.mydomain.mydot -- -- If you also modified the GUI port, you can also specify it (here 9999 for --example) on the command line: -- --prompt> ./mldonkey_gui myhost.mydomain.mydot 9999 -- -- You can also start the GUI, and modify these settings in the Options panel, --and then try to reconnect. This is anyway necessary if you have put a --password. -- -- Instead of using the GUI, you can also telnet to the daemon: -- --prompt> telnet localhost 4000 -- --(on your local computer) or -- --prompt> telnet myhost.mydomain.mydot -- --(if the client was started on that host). -- --Using the config the standard core : --=================================== -- Connect to mldonkey by telnet: -- --prompt> telnet localhost 4000 -- -- Use the 'import' command with the donkey directory containing your old --config as parameter. -- --import '/.../donkey2000' -- -- All the files which were currently downloading will be moved to mldonkey --temp directory, and the server list will be imported too. -- -- If you only want to import the server.met file, use the 'servers' command: -- --servers '/.../donkey2000/server.met' -- -- Filenames containing special characters (such as spaces) should be put --inside ''. -- -- --Frequently Asked Questions --========================== -- --*) How can I contact the authors ? ------------------------------------ -- --You can reach us for a short time on -- -- mldonkey@mldonkey.net -- mldonkey-users@non-gnu.org -- --Please don't bother us too much with questions on how to use mldonkey. We --prefer bug reports, containing USEFUL information to find the bug. You can --also submit bugs on the savannah WEB site: -- -- http://www.freesoftware.fsf.org/mldonkey/ -- --For advices on how to use mldonkey, you can check several forums: -- -- http://www.mldonkeyworld.com/ -- http://www.mldonkey.org/ (German forum) -- --*) What about the sources ? What about the protocol ? ------------------------------------------------------- -- --All sources are available on the savannah WEB site: -- -- http://www.freesoftware.fsf.org/mldonkey/ -- --*) The GUI/telnet/WEB can't connect to the core. ------------------------------------------------- -- --Since version 1.12, there is an option to control which computers can --connect to mldonkey: allowed_ips -- --By default, this option only allows your local computer to connect to the --core. You can change this either by editing the downloads.ini file, or, in --the console, using the -- --set allowed_ips '127.0.0.1 A.B.C.D ...' -- --command, where A.B.C.D ... are IP addresses separated by spaces. -- --*) I added a password, and now the connection between the client and -- the GUI is immediatly aborded at startup. What should I do ? ---------------------------------------------------------------- -- -- Start the GUI. In the Options panel, type your password, and ENTER. -- Then reconnect to the client (menu or CTRL-R). -- --*) How can I see the upload information ? ------------------------------------------- -- --In mldonkey, you cannot directly know the current upload state of your --core. There is a 'upstats' command which can be used to get sorted --information on the files which have been requested. -- --Two options are used to control upload: --- 'max_upload_rate' controls the maximal bandwidth you accept to provide --on upload. The minimun is 1 (kB/s). --- 'shared_directories' is the list of directories that you want to share. --By default, the list is empty, since the temp/ and incoming/ dirs are always --shared. -- --You can also disable upload for short periods of time with the 'nu' command. --Before you must have ran mldonkey at least 5*m minutes if you want to --disable upload for m minutes. You cannot disable upload for more than --5 hours per day. Your credit can be displayed with the 'vu' command. -- --*) How can I modify parameters that don't appear in the GUI nor in the --command-line client ? ------------------------ -- --mldonkey uses a file called 'downloads.ini'. You must stop your donkey client --(use the Kill menu in the GUI or the 'kill' command in the telnet client). --Then, edit this file and change the values of the options you want. -- --Some options can also be modified by the 'set' command (in the command-line --client or in the console of the GUI). These options appear when you use --the 'vo' command. -- --*) How can I communicate with the client ? -------------------------------------------- -- --There are three ways to communicate with the client. In all the cases, you --can run the client on one computer and control it from another computer. --In these examples, we suppose they both run on the local computer 'localhost': -- -- 1) Use the GUI, called 'mldonkey_gui': -- --prompt> ./mldonkey_gui localhost -- -- 2) Use the command-line client: -- --prompt> telnet localhost 4000 -- -- 3) Use a WEB browser: -- --prompt> lynx http://localhost:4080/ -- --*) How can use the GUI on MacOS X ? ------------------------------------- -- --First, you need to have an X server installed. See for more information: -- -- http://fink.sourceforge.net/doc/x11/index.php -- --You will find a script in the tar file to start the GUI, that set the --correct library path for most systems. If it doesn't work, you need to --modify it according to your non-standard configuration. -- --*) Previewing doesn't work ? ------------------------------ -- --mldonkey tries to start a script, specified by the 'previewer' option. --By default, this option calls 'mldonkey_previewer', which must be in your --path. Its first arg is the name of the file on the local disk, while its --second arg is the name of the file on the donkey network. -- --*) I started mldonkey, and it didn't connect to any server ! ------------------------------------------------------------- -- --Depending on your list of servers, the process of finding a server available --can take a while. You can try to modify some options, such as the server --connection timeout or the delay between connections attempts. If you know --a good server, use 'c 34' if 34 is for example the number of the server --in the list 'vma'. You can also select some servers in the GUI, and use the --connect button/menu. -- --*) Which ports should I open on my firewall ? ---------------------------------------------- -- --By default, mldonkey uses ports 4662 for tcp connections, and port 4666 for --udp connections. If you change the tcp port, udp port will be tcp_port + 4. --Therefore, you should allow your firewall to send incoming connections and --messages on these ports to your local network. -- -- --Help on the command-line interface --================================== -- --In a different shell, telnet to your application by: -- --prompt> telnet localhost 4000 -- --4000 is the default port for connecting with the command-line client. --Command-line client is disabled if you have set a password. -- --Then, use ? to find some help on available commands. Some commands are only --available in the graphical interface (setting options for example), others --only in the command-line interface (import of old donkey config for example). -- --Here is the output of the help command for version 1.12: --n <ip> [<port>]: add a server --vu : view upload credits --nu <m> : disable upload during <m> minutes (multiple of 5) --import <dirname> : import the config from dirname --x <num> : disconnect from server --servers <filename> : add the servers from a server.met file --commit : move downloaded files to incoming directory --vd <num>: view file info --reshare : check shared files for removal --vm : list connected servers --vma : list all known servers --q : close telnet --kill : save and kill the server --save : save --d <size> <md4> : download this file --upstats : statistics on upload --port <port> : change connection port --vo : print options --set <option_name> <option_value> : change option value --vr [<num>]: view results of a search --forget <num> : forget search <num> --ls <query> : local search --s <query> : search for files -- -- With special args: -- -minsize <size> -- -maxsize <size> -- -media <Video|Audio|...> -- -Video -- -Audio -- -format <format> -- -field <field> <fieldvalue> -- -not <word> -- -and <word> -- -or <word> : -- --vs : view all queries --cancel <num> : cancel download --xs : extended search --clh : clear local history --c [<num>]: connect to more servers (or to server <num>) -- -- --Help on the graphical user interface --==================================== --1. Servers page: -- --The server page presents the list of known servers. For each server, the list --provides information on its IP address, port, connexion status, name, --description, number of users and number of files. -- --The list is automatically updated when new servers are discovered. MLDonkey --tries to automatically connect to servers until enough (see the --'Max connected servers' option) of them have replied. -- --To add a server: enter its IP and Port, and press the 'Add server' button. --To remove a server: select the server, and click the 'Remove' button. --To connect a server: select the server, and click the 'Connect' button. --To view server users: select the server, and click the 'View Users' button. -- If the list of users is already available, it is automatically displayed in -- the list on the right when the server is selected. --To add some user to your friend list: select the users, and click the -- 'Add to friends' button. Direct users (those with a valid IP address) -- are immediatly added, while others are only added when they are -- connected. --The 'Connect more servers' button: if not enough servers are connected, -- you can click this button to speed connections to servers. --The 'Remove old servers' button: this button allows to clean the list of -- servers which have not been connected for a while (see the -- 'Max server age' option). -- --2. Downloads page: -- --When you select a file, its full name is displayed under the list of --files. A bar indicates which chunks of the file are available: --red means the chunks is not available and blue is for chunks which are --available on only one client. Black is for chunks that are available on --several clients, whereas green means you already have the chunk. --Chunks are 9mb of consecutive bytes in the file. -- --You can put ed2k:// URLs (those found on www.sharereactor.com) in the --upper entry (after the ed2k: label). Press ENTER then. -- --If you started a download and lost the config files for some reason, you can --recover it in the upper right entry (Recover MD4) if it is still present under --this MD4 in your temp/ directory. -- --When selecting a file in the 'Downloading' list, the GUI will display the list --of its locations on the right side. You can select some of these locations, --and click the 'Add to friends' button to add them to your friends. -- --When a download is finished, files are displayed in the 'Downloaded' list. --You can use the 'Save all files' button to move these files to your --incoming/ directory. This is not done automatically. You can also click on the --right button of the mouse to have a contextual menu where you can select the --name of the file. You can edit the tags of mp3 too in this menu. -- --3. Friends page: -- --Friends are displayed on the left, with the list of their files on the --right. You can remove a friend by selecting it and clicking the 'Remove' --button. You can also search all connected servers for a friend by --putting its name in the 'Find Friend' entry and pressing ENTER. -- --You can select files in the list on the right, then click --'Download Selected Files' to add them to your download list. -- --4. Queries page: -- --'Max Hits' is not working yet. -- --Use the 'Stop' button to stop receiving results for a query. -- --5. Options page: -- --This page can be used to update the simple options of the configuration --file 'downloads.ini', which can be found in the directory where --'donkey_downloads' was started. -- --Interesting options are: -- --'Name': your name on the donkey network. -- --'Max Connected Servers': the maximum number of servers you can remain --connected to. This is an old option, that was useful before UDP packets. --1 is now enough, since all servers will eventually be searched by UDP. -- --'Upload limit': default is 30 kB/s (good for ADSL/Cable). You can't set it -- under 1kB/s. If you have a large bandwith, set it to 500 kB/s or + -- --'Client hostname': the name of the host were your client is running if not -- the same host as the graphical interface. -- --'Password': the password used to control your client. -- --The different ports that can be modified in the Option panel can be used to --allow several clients to run on the same computer. Moreover, several user --interfaces can connect to the same client at the same time (command-line --interfaces and graphical interfaces). -- --6. Console -- --In the console, you have access to the command-line commands. -- --Using auxiliary programs for local indexation (in development) --============================================= -- --mldonkey now uses auxiliary programs to help find results to search. --Currently, two types of programs are supported: -- --- Finder (set by the 'local_index_find_cmd' option) -- The finder receives a query on its standard input, and replies by -- the results on its standard output. -- --Query format: the query finishes with 'end_query' on one line. On each line --of the query, there is one keyword, a colon :, and a value. Keywords are: -- words, minsize, maxsize, minrate, media, format, title, album, artist -- --Result format: the result finishes with 'end result' on one line. On each line --of the result, there is one keyword, a colon :, and a value. --Keywords are: -- Required: md4, size -- Optional: name, format, type, string_tag, int_tag -- --There can be several name, string_tag, int_tag lines. The value on the --string_tag line should be the name of the tag, a colon : and the value of --the tag. Idem for int_tag, but the value should be an integer. -- --- Indexer (set by the 'local_index_add_cmd' option) --The indexer is called each time a new result is received by mldonkey, --and the result is given on its standard input in the same format as specified --above. It can be used to add the result to the index that is used by the --Finder. -- --Known bugs: --=========== -- * When clicking on the columns it sorts on that column, when -- clicking again it should do a reverse sort on it, but it doesn't. -- -Index: distrib/Todo.txt -=================================================================== -RCS file: /sources/mldonkey/mldonkey/distrib/Todo.txt,v -retrieving revision 1.10 -retrieving revision 1.11 -diff -u -r1.10 -r1.11 ---- distrib/Todo.txt 1 Nov 2004 11:22:59 -0000 1.10 -+++ distrib/Todo.txt 23 Oct 2006 12:58:35 -0000 1.11 -@@ -9,15 +9,6 @@ - (1) Why is the QRT sent so often ? - (2) Implement PUSH in Gnutella and Fasttrack - --(9) When a file is commited, it should not be shared anymore in temp/. -- Moreover, in temp, it should not be shared under is URN name. --(10) CANCEL A FILE, AND RESTART THE DOWNLOAD: <<<<<<<<< -- -- -- -- -- --Before 2.6: - * Re-implement contributors in CommonSwarming - * Re-implement already downloaded files. - -@@ -27,7 +18,6 @@ - downloaded chunks for itself or the primary network. - * Does the PartialChunk strategy work ? - * Why are chunks verified before completeness ? -- * After a while, shared files are not shared anymore ! why ??? - * When a connection succeeds and downloads, we should retry the connection - ASAP. - * How to remove servers from disabled networks ? -@@ -61,30 +51,14 @@ - - BUGS: - --* "FT not respecting max sources per file settings" --http://savannah.nongnu.org/bugs/index.php?func=detailitem&item_id=3761 --FT plugin AFAIK has no limits regarding the size of the serverlist -- --* FT plugin is not able to get a list of working peers --http://savannah.nongnu.org/bugs/index.php?func=detailitem&item_id=7776 -- --* "Search results appear in the wrong search" --http://savannah.nongnu.org/bugs/index.php?func=detailitem&item_id=6956 -- - Flush buffers after do_at_exit (wait 5 secondes after exit ?). --Share only on some networks. --Add information in the GIU protocol on who uploads what. - Send relative times in the GUI protocol --IP blocking in net/ : http://www.peerguardian.net/pgipdb/guarding.p2p - - ************************************************************************ - Edonkey: -- * Extension to download small files immediatly (files smaller than 10k for -- example) - * Verify that make_xs is always synchronized with sources searches. - * Add command 'export_temp' so that they can be used from emule/edonkey - * EmuleMobile ? -- * BUG: commited files are not shared - * BUG: MLdonkey client generates "Exceeding Block Boundaries" errors which - loses bandwidth - * Implement more Emule packets -@@ -93,8 +67,6 @@ - OP_REASKACK (0x91) (size=2) - OP_FILENOTFOUND (0x92) - * Extended search doesnot work after connect because no ping was sent. -- * BUG: Cancel and Redownload doesnot work -- * BUG: Files randomly pause - - BitTorrent: - * Implement file availability as in edonkey. -@@ -113,7 +85,6 @@ - downloading clients - - Gnutella2: -- * Why doesn't TigerTree work on Mac ? - * Allow browsing other clients. - * ADD urn:sha1:<HASH> and urn:tree:tiger/:<HASH> to QRT - * Search using all URI (ed2k, etc...) -@@ -124,6 +95,7 @@ - * Send more information in HTTP/1.1 headers (alt-locs, thex) - - Soulseek: -+ * Network does currently not work due to missing bindings with common module - * In case of Message from server LOGIN FAILURE INVALIDPASS - prevent any new reconnection without changing the password. Done ? - + Implement more of the protocol -@@ -138,10 +110,12 @@ - + Display the number of new message per room - - Opennap: -+ * Network does currently not work due to missing bindings with common module - * Register files on server - * Implement Upload completely - - Direct-Connect: -+ * Network does currently not work due to missing bindings with common module - * Implement Upload completely - * How do you know your IP in Direct-Connect if you are behind a firewall - * Send replies to active searches -@@ -154,110 +128,12 @@ - Core: - * LittleEndian: is buf_int correct with negative values - * Change ClientKind so that it does not depend on edonkey anymore. -- * Configurable map to translate characters appearing in the file names. - * BUG: What happens when the writes are buffered, mtime does not correspond to - the real value ? We should probably call Unix2.flush_all before saving - the config. -- * Download one file from multiple networks: -- 1) A download must be started on a verified network (donkey, bittorrent -- or gnutella) -- 2) Complementary downloads can be started from other networks: -- 2a) Start a download as attached to a main download -- 2b) The attached download does not create a main file, but a set of -- chunks that are potentially downloaded -- 2c) If the download of the attached file is finished, and the file -- can be verified, then the attchaed download can be permuted -- with the main download (the attached download becomes the main -- download, and reciprocally). -- * Associate kinds with networks, and only download useful urls -- * Make difference between Subscribe and Submit searches clear: Submit -- searches all networks and stops when all servers have replied. -- Subscribe is a long term search, it should query the servers -- periodically, and display new results (and probably save them). -- Not implemented yet anyway. - * CD get and Collections -- * Change temporary files names to allow recover on all networks. -- * Socks 5 support - * The core sends more File_info messages than File_downloaded, which is - not normal ! - * Send messages to GUI with a classifier (to be able to display messages - in different consoles, server console, download console, clients console) - --*********************************************************************** --GUI: -- * Suppress all classes in newgui: object-oriented programming makes -- modifying the GUI even harder, and is not useful at all. We should -- replace classes by simple records when possible. -- * Give more information on why a connection failed: we should now at -- which stage a connection has failed, when it was, and when was the -- last correct connection. -- * Interactive downloads (popups for one file with progress bar): for -- example, it could be used when starting a download under bittorrent -- (use a network flag to say when it should be used ?) from a -- WEB navigator so that the user see a popup from the GUI immediatly -- and see the progress of the download (as does the python bittorrent). -- * Change the color of tabs when things change -- * Add information about: -- * When a download was started and when a file was last seen _complete_: -- 3d/8d : we have been downloading this file for 8 days, and -- saw it complete three days ago -- --/8d : idem, but we have never seen it complete -- -- --*********************************************************************** -- -- And bug reports -- --*********************************************************************** --Fasttrack --========= --FT not respecting max sources per file settings --http://savannah.nongnu.org/bugs/?func=detailitem&item_id=3761 -- -- --GUI bugs --======== --"max hits" doesn't work --http://savannah.nongnu.org/bugs/index.php?func=detailitem&item_id=3675 -- --Source-state error in GUI --http://savannah.nongnu.org/bugs/?func=detailitem&item_id=2443 -- --Commited file is not removed from GUI --http://savannah.nongnu.org/bugs/?func=detailitem&item_id=3705 -- --Right click to file option save doesn't show all file names --http://savannah.nongnu.org/bugs/?func=detailitem&item_id=3179 -- --"old" gtk gui column sizes --http://savannah.nongnu.org/bugs/?func=detailitem&item_id=6917 -- -- --HTML_mods bugs --============== --Cancel and Pause-"Feature" at same time --http://savannah.nongnu.org/bugs/?func=detailitem&item_id=3227 -- -- --Requests for GUI enhancements --============================= --Change the serach-for field into a combo box --http://savannah.nongnu.org/bugs/index.php?func=detailitem&item_id=3445 -- --Remember current tab on exit --http://savannah.nongnu.org/bugs/index.php?func=detailitem&item_id=3476 -- --Better GUI for identifying what files are in good states --http://savannah.nongnu.org/bugs/index.php?func=detailitem&item_id=4316 -- --ed2k-links of all files available (might be best for html_mods) --https://savannah.nongnu.org/bugs/index.php?func=detailitem&item_id=4378 -- -- --Others --====== --Wrong filename used when downloading ed2k links? (Patch attached) --http://savannah.nongnu.org/bugs/index.php?func=detailitem&item_id=4080 -- --Handling of foreign characters --http://savannah.nongnu.org/bugs/index.php?func=detailitem&item_id=4154 -Index: distrib/ed2k_mozilla/README -=================================================================== -RCS file: /sources/mldonkey/mldonkey/distrib/ed2k_mozilla/README,v -retrieving revision 1.7 -retrieving revision 1.8 -diff -u -r1.7 -r1.8 ---- distrib/ed2k_mozilla/README 14 Dec 2005 20:15:39 -0000 1.7 -+++ distrib/ed2k_mozilla/README 23 Oct 2006 12:58:35 -0000 1.8 -@@ -1,10 +1,10 @@ --Mozilla MLdonkey/eMule Protocol Handler 1.7 --Copyright (C) 2003 - 2005 Simon Peter <dn.tlp@gmx.net> -+Firefox MLdonkey/eMule Protocol Handler 1.8 -+Copyright (C) 2003 - 2006 Simon Peter <dn.tlp@gmx.net> - - Description: - ------------ --This is a protocol handler for Mozilla and Firefox (see --www.mozilla.org) that forwards some link types to a running MLdonkey -+This is a protocol handler for Firefox 1.5 and later (see -+www.mozilla.com) that forwards some link types to a running MLdonkey - (see www.mldonkey.net) or eMule (see www.emule-project.net) client. - - Supported protocols are ed2k:, magnet: and sig2dat:. For eMule, only -@@ -15,13 +15,13 @@ - specific questions to Dan Fritz. - - The protocol handler is implemented in JavaScript and should run on --any platform supported by Mozilla and Firefox. -+any platform supported by Firefox. - - Prerequisites: - -------------- - The Web interface of your Donkey client must be enabled and access for --the host this extension should be running on must be enabled in order --for this extension to work. -+the host, this extension should be running on, must be enabled in -+order for this extension to work. - - For eMule, it is advised that you set your web interface template to - default (eMule.tmpl). It may work with other templates but this has -@@ -29,8 +29,8 @@ - - Installation: - ------------- --Just open the .xpi installer file in Mozilla/Firefox and follow the --on-screen instructions. -+Just open the .xpi installer file in Firefox and follow the on-screen -+instructions. - - If you are on a UNIX derivative system (e.g. Linux, BSD, MacOS X and - the like) and like to install this extension for all users on your -@@ -51,48 +51,34 @@ - - Configuration: - -------------- --The protocol handler is configurable through Mozilla's preferences --scheme. The preferences can be set in multiple ways, depending on your --browser version. -- --For Mozilla 1.3, newer versions and Firefox, the preferences are --accessible by visiting the URL "about:config" inside the browser. This --opens a page containing a table of all available preference --options. Right clicking on the table opens a menu to create, modify --and reset the options. Note that the preference defaults of this --protocol handler are internal and NOT visible initially in the list! --To set your own preferences, you have to create them. -- --For Mozilla versions below 1.3, you can set the preferences by --creating a file 'user.js' in your profile directory (this is --$HOME/.mozilla/default/<profile>/ on UNIX systems, where <profile> has --to be replaced by some cryptic string -- just look in that directory) --and set the options there by adding lines of the form: --user_pref("option", "value"); to it. -+The protocol handler is GUI configurable through Firefox' extensions -+menu, for Firefox versions 1.5 and later. Go to the extensions menu, -+by clicking on Tools->Extensions from the main bar of pull-down -+menus. There, select the MLdonkey Protocol Handler and click on -+Options. A GUI configuration dialog should pop up, which allows you to -+set all options. The following preference options are available: - --The following preference options are available: -- --Option: network.mldonkey.server -+Option: Server - Default: localhost - Description: Hostname on which MLdonkey/eMule is running - --Option: network.mldonkey.port -+Option: Port - Default: 4080 --Description: Port of the MLdonkey/eMule WEB service -+Description: Port of the MLdonkey/eMule web service - --Option: network.mldonkey.pass -+Option: Password - Default: (empty) - Description: Password for eMule clients (MLdonkey is handled --automatically by Mozilla's password manager) -+automatically by Firefox' password manager) - --Option: network.mldonkey.mode -+Option: Mode - Default: mldonkey - Description: Donkey client to send the data to. This can be set to --'mldonkey' or 'emule' (without the quotes) to talk to an MLdonkey or --an eMule client, respectively. -+'mldonkey', 'emule' (without the quotes) to talk to an MLdonkey or -+eMule client, respectively. - --All these options are string options. Remember to restart your browser --before any of them can take effect! -+Remember to restart your browser before any of these options can take -+effect! - - Deinstallation: - --------------- -@@ -100,16 +86,25 @@ - the extensions dialog by clicking on Extensions in the Tools - menu. Select the plugin there and click on Uninstall. - --On Mozilla, you have to manually deinstall the plugin by removing the --file 'ed2kprotocol.js' from Mozilla's components directory. On a UNIX --system, this normally is /usr/lib/mozilla/components. -- - News: - ----- -+Changes for version 1.8: -+- Support for GUI configuration through Firefox' extensions menu -+ (thanks to David Ciecierski <dawid.ciecierski@googlemail.com>). -+ -+ ATTENTION upgraders: If you manually set configuration options -+ through the about:config dialog for a previous version of this -+ extension, you first have to go to this dialog and reset all user -+ set options back to their defaults in order to be able to use the -+ new GUI configuration dialog! -+ -+- Since this version, only Firefox version 1.5 and higher is -+ supported. -+ - Changes for version 1.7: - - eMule communication is now faster (thanks to ZZ -- http://forum.emule-project.net/index.php?showuser=9079) --- Added support for eMule 0.46a -+ http://forum.emule-project.net/index.php?showuser=9079). -+- Added support for eMule 0.46a. - - eMule response is now displayed in the same way as MLdonkey - responses. - -@@ -161,13 +156,14 @@ - - The Initial Developer of the Original Code is - Simon Peter <dn.tlp@gmx.net>. --Portions created by the Initial Developer are Copyright (C) 2003 - 2005 -+Portions created by the Initial Developer are Copyright (C) 2003 - 2006 - the Initial Developer. All Rights Reserved. - - Contributor(s): - Sven Koch - Len Walter <len@unsw.edu.au> - Dan Fritz <templar_of_ni@yahoo.se> -+David Ciecierski <dawid.ciecierski@gmail.com> - - 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: distrib/ed2k_mozilla/mldonkey_protocol_handler-1.7.xpi -=================================================================== -RCS file: distrib/ed2k_mozilla/mldonkey_protocol_handler-1.7.xpi -diff -N distrib/ed2k_mozilla/mldonkey_protocol_handler-1.7.xpi -Binary files /tmp/cvspWYDF7 and /dev/null differ -Index: distrib/ed2k_mozilla/mldonkey_protocol_handler-1.8.xpi -=================================================================== -RCS file: distrib/ed2k_mozilla/mldonkey_protocol_handler-1.8.xpi -diff -N distrib/ed2k_mozilla/mldonkey_protocol_handler-1.8.xpi -Binary files /dev/null and /tmp/cvsJexOXS differ -Index: distrib/ed2k_mozilla/src/contents.rdf -=================================================================== -RCS file: distrib/ed2k_mozilla/src/contents.rdf -diff -N distrib/ed2k_mozilla/src/contents.rdf ---- distrib/ed2k_mozilla/src/contents.rdf 8 Jun 2003 12:48:08 -0000 1.2 -+++ /dev/null 1 Jan 1970 00:00:00 -0000 -@@ -1,13 +0,0 @@ --<?xml version="1.0"?> --<RDF:RDF xmlns:RDF="http://www.w3.org/1999/02/22-rdf-syntax-ns#" -- xmlns:chrome="http://www.mozilla.org/rdf/chrome#"> -- --<!-- list all the packages being supplied --> -- <RDF:Seq about="urn:mozilla:package:root"> -- <RDF:li resource="urn:mozilla:package:hdl"/> -- </RDF:Seq> <!-- package information --> -- <RDF:Description about="urn:mozilla:package:ed2k" -- chrome:displayName="Mozilla MLdonkey Protocol Handler" -- chrome:author="Simon Peter <dn.tlp@gmx.net>" -- chrome:name="ed2k"> -- </RDF:Description> </RDF:RDF> -Index: distrib/ed2k_mozilla/src/install.js -=================================================================== -RCS file: distrib/ed2k_mozilla/src/install.js -diff -N distrib/ed2k_mozilla/src/install.js ---- distrib/ed2k_mozilla/src/install.js 14 Dec 2005 20:15:39 -0000 1.7 -+++ /dev/null 1 Jan 1970 00:00:00 -0000 -@@ -1,56 +0,0 @@ --/* -*- Mode: Java; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
--/* ***** BEGIN LICENSE BLOCK *****
-- * Version: MPL 1.1/GPL 2.0/LGPL 2.1
-- *
-- * The contents of this file are subject to the Mozilla Public License Version
-- * 1.1 (the "License"); you may not use this file except in compliance with
-- * the License. You may obtain a copy of the License at
-- * http://www.mozilla.org/MPL/
-- *
-- * Software distributed under the License is distributed on an "AS IS" basis,
-- * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
-- * for the specific language governing rights and limitations under the
-- * License.
-- *
-- * The Original Code is the MLdonkey protocol handler installer.
-- *
-- * The Initial Developer of the Original Code is
-- * Simon Peter <dn.tlp@gmx.net>.
-- * Portions created by the Initial Developer are Copyright (C) 2003 - 2005
-- * the Initial Developer. All Rights Reserved.
-- *
-- * Contributor(s):
-- * Len Walter <len@unsw.edu.au>
-- *
-- * 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
-- * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
-- * in which case the provisions of the GPL or the LGPL are applicable instead
-- * of those above. If you wish to allow use of your version of this file only
-- * under the terms of either the GPL or the LGPL, and not to allow others to
-- * use your version of this file under the terms of the MPL, indicate your
-- * decision by deleting the provisions above and replace them with the notice
-- * and other provisions required by the GPL or the LGPL. If you do not delete
-- * the provisions above, a recipient may use your version of this file under
-- * the terms of any one of the MPL, the GPL or the LGPL.
-- *
-- * ***** END LICENSE BLOCK ***** */
--
--const G_MSG = "Mozilla MLdonkey Protocol Handler 1.6";
--const G_NAME = "ed2k";
--const G_VER = "1.7";
--
--var err = initInstall(G_MSG, G_NAME, G_VER);
--logComment("initInstall: " + err);
--
--addFile("protocol handler", "components/ed2kprotocol.js", getFolder("Components"), "");
--
--// needed for older versions to see the new component
--var f = getFolder("Program", "component.reg");
--if (File.exists(f)) File.remove(f);
--
--err = getLastError();
--if (err==SUCCESS)
-- performInstall();
--else
-- cancelInstall(err);
-Index: distrib/ed2k_mozilla/src/install.rdf -=================================================================== -RCS file: distrib/ed2k_mozilla/src/install.rdf -diff -N distrib/ed2k_mozilla/src/install.rdf ---- distrib/ed2k_mozilla/src/install.rdf 14 Dec 2005 20:15:40 -0000 1.3 -+++ /dev/null 1 Jan 1970 00:00:00 -0000 -@@ -1,29 +0,0 @@ --<?xml version="1.0"?> -- --<RDF xmlns="http://www.w3.org/1999/02/22-rdf-syntax-ns#" -- xmlns:em="http://www.mozilla.org/2004/em-rdf#"> -- -- <Description about="urn:mozilla:install-manifest"> -- <em:id>{bc72206d-b3ce-4b49-88b9-d59b388a0cde}</em:id> -- <em:version>1.7</em:version> -- -- <!-- Target Application this extension can install into, -- with minimum and maximum supported versions. --> -- <em:targetApplication> -- <Description> -- <em:id>{ec8030f7-c20a-464f-9b0e-13a3a9e97384}</em:id> -- <em:minVersion>0.7</em:minVersion> -- <em:maxVersion>1.9</em:maxVersion> -- </Description> -- </em:targetApplication> -- -- <!-- Front End MetaData --> -- <em:name>Mozilla MLdonkey Protocol Handler</em:name> -- <em:description>Mozilla/Firefox MLdonkey Protocol Handler</em:description> -- <em:creator>Simon Peter</em:creator> -- <em:contributor>Len Walter</em:contributor> -- <em:contributor>Sven Koch</em:contributor> -- <em:contributor>Dan Fritz</em:contributor> -- <em:homepageURL>http://www.informatik.uni-oldenburg.de/~dyna/mldonkey/</em:homepageURL> -- </Description> --</RDF> -Index: distrib/ed2k_mozilla/src/components/ed2kprotocol.js -=================================================================== -RCS file: distrib/ed2k_mozilla/src/components/ed2kprotocol.js -diff -N distrib/ed2k_mozilla/src/components/ed2kprotocol.js ---- distrib/ed2k_mozilla/src/components/ed2kprotocol.js 14 Dec 2005 20:15:40 -0000 1.3 -+++ /dev/null 1 Jan 1970 00:00:00 -0000 -@@ -1,251 +0,0 @@ --/* -*- Mode: Java; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */ --/* ***** BEGIN LICENSE BLOCK ***** -- * Version: MPL 1.1/GPL 2.0/LGPL 2.1 -- * -- * The contents of this file are subject to the Mozilla Public License Version -- * 1.1 (the "License"); you may not use this file except in compliance with -- * the License. You may obtain a copy of the License at -- * http://www.mozilla.org/MPL/ -- * -- * Software distributed under the License is distributed on an "AS IS" basis, -- * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License -- * for the specific language governing rights and limitations under the -- * License. -- * -- * The Original Code is the MLdonkey protocol handler 1.7. -- * -- * The Initial Developer of the Original Code is -- * Simon Peter <dn.tlp@gmx.net>. -- * Portions created by the Initial Developer are Copyright (C) 2003 - 2005 -- * the Initial Developer. All Rights Reserved. -- * -- * Contributor(s): -- * Sven Koch -- * Len Walter <len@unsw.edu.au> -- * Dan Fritz (eMule bindings) -- * -- * 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 -- * the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), -- * in which case the provisions of the GPL or the LGPL are applicable instead -- * of those above. If you wish to allow use of your version of this file only -- * under the terms of either the GPL or the LGPL, and not to allow others to -- * use your version of this file under the terms of the MPL, indicate your -- * decision by deleting the provisions above and replace them with the notice -- * and other provisions required by the GPL or the LGPL. If you do not delete -- * the provisions above, a recipient may use your version of this file under -- * the terms of any one of the MPL, the GPL or the LGPL. -- * -- * ***** END LICENSE BLOCK ***** */ -- --/***** Defines *****/ -- --// components defined in this file --const ED2KPROT_HANDLER_CONTRACTID = -- "@mozilla.org/network/protocol;1?name=ed2k"; --const ED2KPROT_HANDLER_CID = -- Components.ID("{af8d664a-d002-438f-84a3-01f3a8ff325b}"); -- --const MAGNETPROT_HANDLER_CONTRACTID = -- "@mozilla.org/network/protocol;1?name=magnet"; --const MAGNETPROT_HANDLER_CID = -- Components.ID("{3e022170-58b0-4548-ba4c-1f47d54c7767}"); -- --const SIG2DATPROT_HANDLER_CONTRACTID = -- "@mozilla.org/network/protocol;1?name=sig2dat"; --const SIG2DATPROT_HANDLER_CID = -- Components.ID("{2a2e71ea-e857-4c71-9c93-04ff681df88a}"); -- --// components used in this file --const NS_IOSERVICE_CID = "{9ac9e770-18bc-11d3-9337-00104ba0fd40}"; --const NS_PREFSERVICE_CONTRACTID = "@mozilla.org/preferences-service;1"; --const URI_CONTRACTID = "@mozilla.org/network/simple-uri;1"; --const NS_WINDOWWATCHER_CONTRACTID = "@mozilla.org/embedcomp/window-watcher;1"; --const INPUTSTREAMCHANNEL_CONTRACTID = "@mozilla.org/network/input-stream-channel;1"; -- --// interfaces used in this file --const nsIProtocolHandler = Components.interfaces.nsIProtocolHandler; --const nsIURI = Components.interfaces.nsIURI; --const nsISupports = Components.interfaces.nsISupports; --const nsIIOService = Components.interfaces.nsIIOService; --const nsIPrefService = Components.interfaces.nsIPrefService; --const nsIWindowWatcher = Components.interfaces.nsIWindowWatcher; --const nsIChannel = Components.interfaces.nsIChannel; -- --// some misc. constants --const PREF_BRANCH = "network.mldonkey."; --const WND_WIDTH = 320; --const WND_HEIGHT = 200; -- --const WND_EMULE_WIDTH = 450; --const WND_EMULE_HEIGHT = 75; -- --// configuration (and defaults) --cfgServer = "localhost"; --cfgPort = "4080"; --myWnd = null; --cfgMode = "mldonkey" --cfgPass = "" -- --/***** MLdonkeyProtocolHandler *****/ -- --function MLdonkeyProtocolHandler(scheme) --{ -- this.scheme = scheme; -- this.readPreferences(PREF_BRANCH); --} -- --// attribute defaults --MLdonkeyProtocolHandler.prototype.defaultPort = -1; --MLdonkeyProtocolHandler.prototype.protocolFlags = nsIProtocolHandler.URI_NORELATIVE; -- --MLdonkeyProtocolHandler.prototype.allowPort = function(aPort, aScheme) --{ -- return false; --} -- --MLdonkeyProtocolHandler.prototype.newURI = function(aSpec, aCharset, aBaseURI) --{ -- var uri = Components.classes[URI_CONTRACTID].createInstance(nsIURI); -- uri.spec = aSpec; -- return uri; --} -- --MLdonkeyProtocolHandler.prototype.newChannel = function(aURI) --{ -- var myUri = ""; -- var myTitle = ""; -- var myWidth = WND_WIDTH; -- var myHeight = WND_HEIGHT -- -- if (cfgMode == "mldonkey") { -- myTitle = "MLDonkey"; -- -- // rewrite the URI into a http URL to the mldonkey client -- myURI = "http://"; -- // if(cfgUser != "") myURI += cfgUser + ":" + cfgPass + "@"; -- myURI += cfgServer + ":" + cfgPort + "/submit?q=dllink+" + -- encodeURIComponent(decodeURI(aURI.spec)); -- } else { -- // eMule mode -- myTitle = "eMule"; -- myWidth = WND_EMULE_WIDTH; -- myHeight = WND_EMULE_HEIGHT -- -- // rewrite the URI into a http URL to the eMule client -- myURI = "http://"; -- myURI += cfgServer + ":" + cfgPort + "/?w=password&p=" + cfgPass; -- myURI += "&cat=0&c=" + encodeURIComponent(decodeURI(aURI.spec)); -- } -- -- // open up a window with our newly generated http URL -- var wwatch = Components.classes[NS_WINDOWWATCHER_CONTRACTID].getService(nsIWindowWatcher); -- if(myWnd == null || myWnd.closed == true) -- myWnd = wwatch.openWindow(wwatch.activeWindow, myURI, myTitle, -- "width=" + myWidth + ", height=" + myHeight, null); -- else -- myWnd.location.href = myURI; -- -- // return a fake empty channel so current window doesn't change -- var chan = Components.classes[INPUTSTREAMCHANNEL_CONTRACTID].createInstance(nsIChannel); -- return chan; --} -- --MLdonkeyProtocolHandler.prototype.readPreferences = function(pref_branch) --{ -- // get preferences branch -- var PrefService = Components.classes[NS_PREFSERVICE_CONTRACTID].getService(nsIPrefService); -- var myPrefs = PrefService.getBranch(null); // Mozilla bug #107617 -- -- // read preferences (if available) -- if(myPrefs.getPrefType(pref_branch + "server") == myPrefs.PREF_STRING) -- cfgServer = myPrefs.getCharPref(pref_branch + "server"); -- if(myPrefs.getPrefType(pref_branch + "port") == myPrefs.PREF_STRING) -- cfgPort = myPrefs.getCharPref(pref_branch + "port"); -- if(myPrefs.getPrefType(pref_branch + "mode") == myPrefs.PREF_STRING) -- cfgMode = myPrefs.getCharPref(pref_branch + "mode"); -- if(myPrefs.getPrefType(pref_branch + "pass") == myPrefs.PREF_STRING) -- cfgPass = myPrefs.getCharPref(pref_branch + "pass"); --} -- --/***** MLdonkeyProtocolHandlerFactory *****/ -- --function MLdonkeyProtocolHandlerFactory(scheme) --{ -- this.scheme = scheme; --} -- --MLdonkeyProtocolHandlerFactory.prototype.createInstance = function(outer, iid) --{ -- if(outer != null) throw Components.results.NS_ERROR_NO_AGGREGATION; -- -- if(!iid.equals(nsIProtocolHandler) && !iid.equals(nsISupports)) -- throw Components.results.NS_ERROR_INVALID_ARG; -- -- return new MLdonkeyProtocolHandler(this.scheme); --} -- --var factory_ed2k = new MLdonkeyProtocolHandlerFactory("ed2k"); --var factory_magnet = new MLdonkeyProtocolHandlerFactory("magnet"); --var factory_sig2dat = new MLdonkeyProtocolHandlerFactory("sig2dat"); -- --/***** Ed2kzillaModule *****/ -- --var Ed2kzillaModule = new Object(); -- --Ed2kzillaModule.registerSelf = function(compMgr, fileSpec, location, type) --{ -- compMgr = compMgr.QueryInterface(Components.interfaces.nsIComponentRegistrar); -- -- // register ed2k protocol handler -- compMgr.registerFactoryLocation(ED2KPROT_HANDLER_CID, -- "ED2K protocol handler", -- ED2KPROT_HANDLER_CONTRACTID, -- fileSpec, location, type); -- -- // register magnet protocol handler -- compMgr.registerFactoryLocation(MAGNETPROT_HANDLER_CID, -- "Magnet protocol handler", -- MAGNETPROT_HANDLER_CONTRACTID, -- fileSpec, location, type); -- -- // register sig2dat protocol handler -- compMgr.registerFactoryLocation(SIG2DATPROT_HANDLER_CID, -- "Sig2dat protocol handler", -- SIG2DATPROT_HANDLER_CONTRACTID, -- fileSpec, location, type); --} -- --Ed2kzillaModule.unregisterSelf = function(compMgr, fileSpec, location) --{ -- compMgr = compMgr.QueryInterface(Components.interfaces.nsIComponentRegistrar); -- -- // unregister our components -- compMgr.unregisterFactoryLocation(ED2KPROT_HANDLER_CID, fileSpec); -- compMgr.unregisterFactoryLocation(MAGNETPROT_HANDLER_CID, fileSpec); -- compMgr.unregisterFactoryLocation(SIG2DATPROT_HANDLER_CID, fileSpec); --} -- --Ed2kzillaModule.getClassObject = function(compMgr, cid, iid) --{ -- if(!iid.equals(Components.interfaces.nsIFactory)) -- throw Components.results.NS_ERROR_NOT_IMPLEMENTED; -- -- if(cid.equals(ED2KPROT_HANDLER_CID)) return factory_ed2k; -- if(cid.equals(MAGNETPROT_HANDLER_CID)) return factory_magnet; -- if(cid.equals(SIG2DATPROT_HANDLER_CID)) return factory_sig2dat; -- -- throw Components.results.NS_ERROR_NO_INTERFACE; --} -- --Ed2kzillaModule.canUnload = function(compMgr) --{ -- return true; // our objects can be unloaded --} -- --/***** Entrypoint *****/ -- --function NSGetModule(compMgr, fileSpec) --{ -- return Ed2kzillaModule; --} -Index: distrib/html_themes/ease/commands.html -=================================================================== -RCS file: /sources/mldonkey/mldonkey/distrib/html_themes/ease/commands.html,v -retrieving revision 1.1 -retrieving revision 1.2 -diff -u -r1.1 -r1.2 ---- distrib/html_themes/ease/commands.html 14 Jan 2004 20:43:57 -0000 1.1 -+++ distrib/html_themes/ease/commands.html 25 Oct 2006 11:34:45 -0000 1.2 -@@ -57,14 +57,14 @@ - class="bu bbig bbig2" - onMouseOver="mOvr(this,'mOvr1');" - onMouseOut="mOut(this);" --onClick="top.output.location.href='http://www.mldonkey.net/'">Homepage -+onClick="top.output.location.href='http://www.mldonkey.org/'">Homepage - </td> - <td - title="English/German support forums" - class="bu bbig bbig2" - onMouseOver="mOvr(this,'mOvr1');" - onMouseOut="mOut(this);" --onClick="top.output.location.href='http://www.mldonkeyworld.com/'">Forums -+onClick="top.output.location.href='http://www.mldonkey.org/'">Forums - </td> - <td - title="Kill/Close the MLdonkey core" -Index: distrib/html_themes/old/commands.html -=================================================================== -RCS file: /sources/mldonkey/mldonkey/distrib/html_themes/old/commands.html,v -retrieving revision 1.1 -retrieving revision 1.2 -diff -u -r1.1 -r1.2 ---- distrib/html_themes/old/commands.html 14 Jan 2004 20:43:57 -0000 1.1 -+++ distrib/html_themes/old/commands.html 25 Oct 2006 11:34:45 -0000 1.2 -@@ -13,14 +13,14 @@ - class="bu bsmall1 b2" - onMouseOver="mOvr(this,'mOvr1');" - onMouseOut="mOut(this);" --onClick="top.output.location.href='http://www.mldonkey.net/'">Homepage -+onClick="top.output.location.href='http://www.mldonkey.org/'">Homepage - </td> - <td - title="English/German support forums" - class="bu bsmall1 b2" - onMouseOver="mOvr(this,'mOvr1');" - onMouseOut="mOut(this);" --onClick="top.output.location.href='http://www.mldonkeyworld.com/'">Forums -+onClick="top.output.location.href='http://www.mldonkey.org/'">Forums - </td> - <td - title="Options" -Index: docs/multiuser.txt -=================================================================== -RCS file: docs/multiuser.txt -diff -N docs/multiuser.txt ---- /dev/null 1 Jan 1970 00:00:00 -0000 -+++ docs/multiuser.txt 9 Nov 2006 21:32:25 -0000 1.2 -@@ -0,0 +1,158 @@ -+Description of multiuser patch -+============================== -+This file provides some HowTos and internals about the new multiuser -+functionality of MLDonkey. The goal is to provide a p2p-service to be -+used by more than user and where each user has its own environment -+provided by the daemon. -+ -+Some basics and definitions -+=========================== -+User "admin" and all users belonging to a group where group_admin = true can -+see all files in any case and can use all functions of MLDonkey. -+ -+file_owner in this text means the user which owns a downloading file, -+file_group means the group the file belongs to, file_owner must be a member of -+this group, both values are saved in files.ini. -+ -+New options (displayed options are default values) -+================================================== -+users.ini -+--------- -+- "users" is kept unchanged for compatibility, all users from "users2" -+ are saved in "users" as well, so password are updated. -+- "users2" is extended with these settings: -+ -+A list of groups the user belongs to, this user can view all files -+which belong to one of the groups -+ user_groups = [] -+ -+The default group of the user, the user must also be a member of this -+group. File_group of new downloads started by the user are automatically -+assigned to this value. This value can be None, this means the file is a -+private one only visible to the file_owner (and admins, of course). -+ user_default_group = mldonkey -+ -+E-mail address to sent commit notifications to. Global option "mail" -+can still be used for admins, if both addresses match only one mail is sent. -+ user_mail = "" -+ -+Commit files to <incoming>/<user_commit_dir> -+The current incoming directory is appended with user_commit_dir. -+All incoming dirs are shared recursively now to share these files -+committed into user specific dirs. -+ user_commit_dir = "" -+ -+Like global option max_concurrent_downloads this implements a user-specific -+limit of the maximum number of concurrent files a user can download. Other -+downloads are queued, this is done by round-robin. If the sum of -+user_max_concurrent_downloads from all users is bigger than -+max_concurrent_downloads less downloads than user_max_concurrent_downloads -+are in downloading state. 0 means no user-specific limit. -+Users can change file priorities the control which files are not queued. -+ user_max_concurrent_downloads = 0 -+ -+- groups, new option -+At least one group named "mldonkey" with group_admin = true must exist -+and will be re-created on startup if missing. -+ -+Option to control if the group has admin rights. All users belonging to such a -+group have the same rights as user "admin". -+ group_admin = true -+ -+ -+files.ini -+--------- -+- each file has two new options in files.ini -+file_owner: the incoming directory of the owner is used for commit, -+ if the user does not exist "admin" is used. If this data -+ field does not exist, the file will belong to user "admin". -+file_group: default value for a new download is user_default_group -+ if file_owner is not member of file_group or the group does not -+ exist, the user_default_group of file_owner is used. -+ -+downloads.ini -+------------- -+These two options control the display of user/group column in HTML, vd -+ html_mods_vd_user false -+ html_mods_vd_group false -+ -+ -+Commands to control multiuser features/data -+=========================================== -+chgrp <group> <num> -+change group of download <num> to <group>, group = none for private file -+ -+chown <user> <num> -+change owner of download <num> to <user> -+ -+dgroup -+print default group of logged-in user -+ -+groupadd <group> <admin: true | false> -+add new mldonkey group, only admin users can use this command -+ -+groupadmin <group> <admin: true | false> -+change group admin status, only admin users can use this command -+ -+groupdel <group> -+remove an unused mldonkey group, only admin users can use this command -+only possible if group has no members -+ -+groups -+print groups of logged-in user -+ -+passwd <passwd> -+change own password -+ -+useradd <user> <passwd> -+add new mldonkey user/change user password, only admin users can use this command -+ -+usercommit <user> <dir> -+change user specific commit directory -+ -+userdel <user> -+remove a mldonkey user, only admin users can use this command, user "admin" can not be removed -+deleting a user is only possible if the user does not own any downloads -+ -+userdgroup <user> <group|None> -+change user default group -+ -+userdls <user> <num> -+change number of allowed concurrent downloads, only admin users can use this command -+ -+usergroupadd <user> <group> -+add a group to a mldonkey user, only admin users can use this command -+ -+usergroupdel <user> <group> -+remove a group from a mldonkey user -+ -+usermail <user> <mail> -+change user mail address -+ -+users -+use this command in HTML interface for a small GUI to control users -+ -+whoami -+print logged-in user name -+ -+ -+Updating from a non-multiuser MLDonkey -+====================================== -+When updating all files will have file_owner "admin" and file_group "mldonkey". -+All existing users will have user_default_group = "mldonkey" and -+user_groups = ["mldonkey"]. This means all users can use all features of -+MLDonkey and see all files in use by MLDonkey core, just like before. -+ -+To hide user downloads from each other, create a new group with -+group_admin = false and assign all users to this group and remove them -+from all admin groups -+ -+ -+Additional features -+=================== -+- file_completed_cmd has new environment variables $FILE_OWNER and $FILE_GROUP -+- remove option enable_user_config, replaced by membership of admin groups -+ -+To-Do -+====== -+- Suggestions ? -Index: packages/rpm/mldonkey.spec.in -=================================================================== -RCS file: /sources/mldonkey/mldonkey/packages/rpm/mldonkey.spec.in,v -retrieving revision 1.5 -retrieving revision 1.6 -diff -u -r1.5 -r1.6 ---- packages/rpm/mldonkey.spec.in 27 Jun 2006 10:38:34 -0000 1.5 -+++ packages/rpm/mldonkey.spec.in 25 Oct 2006 11:34:45 -0000 1.6 -@@ -8,7 +8,7 @@ - Summary: %{summary} - License: GPL - Source0: %{name}.sources.tar.bz2 --URL: http://www.mldonkey.net/ -+URL: http://www.mldonkey.org - Group: System/Servers - BuildRoot: %{_tmppath}/%{name}-buildroot - -Index: packages/slackware/slack-desc -=================================================================== -RCS file: /sources/mldonkey/mldonkey/packages/slackware/slack-desc,v -retrieving revision 1.1 -retrieving revision 1.2 -diff -u -r1.1 -r1.2 ---- packages/slackware/slack-desc 5 Nov 2005 16:21:25 -0000 1.1 -+++ packages/slackware/slack-desc 25 Oct 2006 11:34:46 -0000 1.2 -@@ -6,6 +6,5 @@ - mldonkey: Overnet, Bittorrent, Gnutella (Bearshare, Limewire, etc), Gnutella2 - mldonkey: (Shareaza), Fasttrack (Kazaa, Imesh, Grobster), Soulseek, etc. - mldonkey: --mldonkey: http://www.mldonkey.net - mldonkey: http://www.mldonkey.org - mldonkey: -Index: src/daemon/common/commonClient.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonClient.ml,v -retrieving revision 1.30 -retrieving revision 1.33 -diff -u -r1.30 -r1.33 ---- src/daemon/common/commonClient.ml 14 Sep 2006 17:31:00 -0000 1.30 -+++ src/daemon/common/commonClient.ml 5 Nov 2006 14:09:38 -0000 1.33 -@@ -33,9 +33,8 @@ - mutable impl_client_type : client_type; - mutable impl_client_state : host_state; - mutable impl_client_update : int; -- mutable impl_client_has_slot : bool; -- mutable impl_client_has_friend_slot : bool; -- mutable impl_client_upload : shared option; -+ mutable impl_client_slot : slot_kind; -+ mutable impl_client_upload : file option; - mutable impl_client_num : int; - mutable impl_client_val : 'a; - mutable impl_client_ops : 'a client_ops; -@@ -102,8 +101,7 @@ - impl_client_type = 0; - impl_client_state = NewHost; - impl_client_update = 1; -- impl_client_has_slot = false; -- impl_client_has_friend_slot = false; -+ impl_client_slot = NoSlot; - impl_client_upload = None; - impl_client_num = 0; - impl_client_val = 0; -@@ -322,24 +320,26 @@ - let set_initialized c = - set_client_type c (client_type c lor client_initialized_tag) - --let client_has_a_slot c = -- (as_client_impl c).impl_client_has_slot -+let client_slot c = -+ (as_client_impl c).impl_client_slot - --let client_has_a_friend_slot c = -- (as_client_impl c).impl_client_has_friend_slot -+let client_has_a_slot c = -+ match (as_client_impl c).impl_client_slot with -+ NoSlot -> false -+ | _ -> true - - let client_upload c = - (as_client_impl c).impl_client_upload - - let set_client_upload c sh = -- (as_client_impl c).impl_client_upload <- sh; -+ (as_client_impl c).impl_client_upload <- Some sh; - client_must_update c - --let set_client_has_a_slot c b = -+let set_client_has_a_slot c slot = - let impl = as_client_impl c in -- if not b && impl.impl_client_has_slot then begin -- impl.impl_client_has_slot <- false; -- impl.impl_client_has_friend_slot <- false; -+ match slot with -+ NoSlot -> if client_has_a_slot c then begin -+ impl.impl_client_slot <- NoSlot; - uploaders := Intmap.remove (client_num c) !uploaders; - client_must_update c; - (* -@@ -353,17 +353,15 @@ - *) - Unix32.close_all () - end -- else -- if b && not impl.impl_client_has_slot then begin -+ | slot -> if not (client_has_a_slot c) then begin - uploaders := Intmap.add (client_num c) c !uploaders; -- impl.impl_client_has_slot <- true; -- impl.impl_client_has_friend_slot <- is_friend c; -+ impl.impl_client_slot <- slot; - client_must_update c - end - - let set_client_disconnected c reason = - let impl = as_client_impl c in -- set_client_has_a_slot c false; -+ set_client_has_a_slot c NoSlot; - - match impl.impl_client_state with - Connected n -> set_client_state c (NotConnected (reason, n)) -@@ -402,6 +400,7 @@ - let counter = ref 0 in - H.iter (fun _ -> incr counter) clients_by_num; - Printf.bprintf buf " clients: %d\n" !counter; -+ Printf.bprintf buf " uploaders: %d\n" (Intmap.length !uploaders); - ) - - let clients_get_all () = -@@ -473,7 +472,7 @@ - client_disconnect c; - if !verbose then lprintf_nl "disconnected client %d: [%s %s] %s after %d %s of silence." - (client_num c) -- i.GuiTypes.client_software -+ (GuiTypes.client_software i.GuiTypes.client_software i.GuiTypes.client_os) - i.GuiTypes.client_release - i.GuiTypes.client_name - ctime -@@ -498,6 +497,7 @@ - T.client_connect_time = BasicSocket.last_time (); - T.client_kind = Indirect_location ("", Md4.Md4.null, Ip.null, 0); - T.client_software = ""; -+ T.client_os = None; - T.client_release = ""; - T.client_emulemod = ""; - T.client_downloaded = 0L; -Index: src/daemon/common/commonClient.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonClient.mli,v -retrieving revision 1.12 -retrieving revision 1.13 -diff -u -r1.12 -r1.13 ---- src/daemon/common/commonClient.mli 16 Aug 2006 19:12:08 -0000 1.12 -+++ src/daemon/common/commonClient.mli 25 Oct 2006 11:12:38 -0000 1.13 -@@ -2,9 +2,8 @@ - mutable impl_client_type : CommonTypes.client_type; - mutable impl_client_state : CommonTypes.host_state; - mutable impl_client_update : int; -- mutable impl_client_has_slot : bool; -- mutable impl_client_has_friend_slot : bool; -- mutable impl_client_upload : CommonTypes.shared option; -+ mutable impl_client_slot : CommonTypes.slot_kind; -+ mutable impl_client_upload : CommonTypes.file option; - mutable impl_client_num : int; - mutable impl_client_val : 'a; - mutable impl_client_ops : 'a client_ops; -@@ -70,11 +69,11 @@ - val check_client_implementations : unit -> unit - val client_can_upload : CommonTypes.client -> int -> unit - val client_enter_upload_queue : CommonTypes.client -> unit --val client_upload : CommonTypes.client -> CommonTypes.shared option --val set_client_upload : CommonTypes.client -> CommonTypes.shared option -> unit -+val client_upload : CommonTypes.client -> CommonTypes.file option -+val set_client_upload : CommonTypes.client -> CommonTypes.file -> unit -+val client_slot : CommonTypes.client -> CommonTypes.slot_kind - val client_has_a_slot : CommonTypes.client -> bool --val client_has_a_friend_slot : CommonTypes.client -> bool --val set_client_has_a_slot : CommonTypes.client -> bool -> unit -+val set_client_has_a_slot : CommonTypes.client -> CommonTypes.slot_kind -> unit - - val uploaders : CommonTypes.client Intmap.t ref - -Index: src/daemon/common/commonComplexOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonComplexOptions.ml,v -retrieving revision 1.60 -retrieving revision 1.69 -diff -u -r1.60 -r1.69 ---- src/daemon/common/commonComplexOptions.ml 1 Sep 2006 16:22:14 -0000 1.60 -+++ src/daemon/common/commonComplexOptions.ml 21 Nov 2006 22:34:33 -0000 1.69 -@@ -27,6 +27,7 @@ - open CommonServer - open CommonNetwork - open CommonOptions -+open CommonUserDb - open CommonTypes - open CommonFile - open Gettext -@@ -102,6 +103,61 @@ - impl.impl_file_age <- - normalize_time (get_value "file_age" value_to_int) - with _ -> ()); -+ -+ (try -+ impl.impl_file_release <- -+ get_value "file_release" value_to_bool -+ with _ -> ()); -+ -+ let file_user = -+ let filename = get_value "file_filename" value_to_string in -+ try -+ let u = get_value "file_owner" value_to_string in -+ begin -+ try -+ user2_user_find u -+ with Not_found -> -+ lprintf_nl "file_owner %s of %s does not exist, changing to %s" -+ u filename admin_user.user_name; -+ admin_user -+ end -+ with Not_found -> -+ lprintf_nl "file_owner of %s is empty, changing to %s" -+ filename admin_user.user_name; -+ admin_user -+ in -+ set_file_owner file file_user; -+ -+ let file_group = -+ let filename = get_value "file_filename" value_to_string in -+ let dgroup = user2_print_user_default_group file_user in -+ try -+ match (get_value "file_group" stringvalue_to_option) with -+ None -> None -+ | Some g -> -+ begin -+ try -+ let g = user2_group_find g in -+ if List.mem g file_user.user_groups then -+ Some g -+ else -+ begin -+ lprintf_nl "file_owner %s is not member of file_group %s, changing file_group of %s to user_default_group %s" -+ file_user.user_name g.group_name filename dgroup; -+ file_user.user_default_group -+ end -+ with Not_found -> -+ lprintf_nl "file_group %s of %s not found, changing to user_default_group %s of user %s" -+ g filename dgroup file_user.user_name; -+ file_user.user_default_group -+ end -+ with Not_found -> -+ lprintf_nl "file_group of %s is empty, changing to user_default_group %s of user %s" -+ filename dgroup file_user.user_name; -+ file_user.user_default_group -+ in -+ set_file_group file file_group; -+ - set_file_state file file_state; - - (try -@@ -138,6 +194,9 @@ - ("file_filenames", List - (List.map string_to_value impl.impl_file_filenames)) :: - ("file_age", IntValue (Int64.of_int impl.impl_file_age)) :: -+ ("file_release", bool_to_value impl.impl_file_release) :: -+ ("file_owner", string_to_value (file_owner file).user_name) :: -+ ("file_group", option_to_stringvalue (match file_group file with Some g -> Some g.group_name | None -> None)) :: - (file_to_option file) - ) - -@@ -512,7 +571,7 @@ - "-movies", "avi -minsize 650000000 -1cd"; - "-mp3s", "mp3 -minsize 3000000 -maxsize 10000000"; - "-albums", "album -minsize 30000000 -maxsize 150000000"; -- "-nosex", "-without xxx"; -+ "-nosex", "-not xxx"; - ] - - let customized_queries = -@@ -664,7 +723,7 @@ - sharing_directories = false; - sharing_extensions = []; - sharing_recursive = false; -- sharing_minsize = Int64.one; -+ sharing_minsize = zero; - sharing_maxsize = Int64.max_int; - } - -@@ -673,7 +732,7 @@ - sharing_directories = true; - sharing_extensions = []; - sharing_recursive = false; -- sharing_minsize = Int64.one; -+ sharing_minsize = zero; - sharing_maxsize = Int64.max_int; - } - -@@ -681,8 +740,8 @@ - sharing_incoming = true; - sharing_directories = false; - sharing_extensions = []; -- sharing_recursive = false; -- sharing_minsize = Int64.one; -+ sharing_recursive = true; -+ sharing_minsize = zero; - sharing_maxsize = Int64.max_int; - } - -@@ -691,7 +750,7 @@ - sharing_directories = true; - sharing_extensions = []; - sharing_recursive = false; -- sharing_minsize = Int64.one; -+ sharing_minsize = zero; - sharing_maxsize = Int64.max_int; - } - -@@ -726,7 +785,7 @@ - sharing_directories = false; - sharing_extensions = []; - sharing_recursive = true; -- sharing_minsize = Int64.one; -+ sharing_minsize = zero; - sharing_maxsize = Int64.max_int; - }; - -@@ -758,7 +817,7 @@ - - ) - --let sharing_strategies name = -+let sharing_strategy name = - match name with - | "incoming_files" -> sharing_incoming_files - | "incoming_directories" -> sharing_incoming_directories -@@ -790,16 +849,18 @@ - in - let shdir_priority = get_value_safe "priority" value_to_int 0 - in -+(* - let shdir_networks = get_value_safe "networks" - (value_to_list value_to_string) [] - in -+*) - let shdir_strategy = get_value_safe "strategy" - value_to_string "only_directory" - in - { - shdir_dirname = shdir_dirname; - shdir_strategy = shdir_strategy; -- shdir_networks = shdir_networks; -+ shdir_networks = []; (* shdir_networks; *) - shdir_priority = shdir_priority; - } - end -@@ -825,8 +886,10 @@ - let shared_directory_to_value s = - let list = [ - "dirname", filename_to_value s.shdir_dirname; -+(* - "networks", - list_to_value string_to_value s.shdir_networks; -+*) - "strategy", - string_to_value s.shdir_strategy; - "priority", int_to_value s.shdir_priority; -@@ -839,8 +902,21 @@ - shared_directory_to_value - - end -- -- -+ -+let default_incoming_files = { -+ shdir_dirname = Filename.concat "incoming" "files"; -+ shdir_priority = 0; -+ shdir_networks = []; -+ shdir_strategy = "incoming_files"; -+ } -+ -+let default_incoming_directories = { -+ shdir_dirname = Filename.concat "incoming" "directories"; -+ shdir_priority = 0; -+ shdir_networks = []; -+ shdir_strategy = "incoming_directories"; -+ } -+ - let shared_directories = - define_option CommonOptions.path_section ["shared_directories" ] - " Incoming and shared directories. -@@ -852,8 +928,8 @@ - Finished BT multifile downloads are committed to the first directory - with strategy incoming_directories. Other downloads are committed - to the first directory with the strategy incoming_files. -- If more than one directory has one of the incoming_* strategies -- it will be ignored on commit, but they are shared nonetheless. -+ MLdonkey searches all shared_directories with incoming_* strategies -+ on commit and uses the first one with enough free diskspace. - Other strategies can be found in searches.ini, section customized_sharing." - (list_option SharedDirectoryOption.t) - [ -@@ -863,64 +939,92 @@ - shdir_networks = []; - shdir_strategy = "all_files"; - }; -- { -- shdir_dirname = "incoming/files"; -- shdir_priority = 0; -- shdir_networks = []; -- shdir_strategy = "incoming_files"; -- }; -- { -- shdir_dirname = "incoming/directories"; -- shdir_priority = 0; -- shdir_networks = []; -- shdir_strategy = "incoming_directories"; -- } -+ default_incoming_files; -+ default_incoming_directories; - ] - - - let search_incoming_files () = -- try -- List.find (fun s -> s.shdir_strategy = "incoming_files") -- !!shared_directories -- with Not_found -> -- let dirname = Filename.concat "incoming" "files" in -- let s = { -- shdir_dirname = dirname; -- shdir_priority = 0; -- shdir_networks = []; -- shdir_strategy = "incoming_files"; -- } -- in -- shared_directories =:= s :: !!shared_directories; -- s -- --let incoming_files () = -- let dir = search_incoming_files () in -- Unix2.safe_mkdir dir.shdir_dirname; -- Unix2.can_write_to_directory dir.shdir_dirname; -- dir -+ let list = -+ List.filter (fun s -> s.shdir_strategy = "incoming_files") !!shared_directories -+ in -+ match list with -+ | [] -> shared_directories =:= default_incoming_files :: !!shared_directories; -+ [default_incoming_files] -+ | l -> l - - let search_incoming_directories () = -- try -- List.find (fun s -> s.shdir_strategy = "incoming_directories") -- !!shared_directories -- with Not_found -> -- let dirname = Filename.concat "incoming" "directories" in -- let s = { -- shdir_dirname = dirname; -- shdir_priority = 0; -- shdir_networks = []; -- shdir_strategy = "incoming_directories"; -- } -- in -- shared_directories =:= s :: !!shared_directories; -- s -+ let list = -+ List.filter (fun s -> s.shdir_strategy = "incoming_directories") !!shared_directories -+ in -+ match list with -+ | [] -> shared_directories =:= default_incoming_directories :: !!shared_directories; -+ [default_incoming_directories] -+ | l -> l -+ -+exception Incoming_full -+ -+let incoming_dir usedir ?user ?needed_space ?network () = -+ -+ let directories = -+ if usedir then -+ search_incoming_directories () -+ else -+ search_incoming_files () -+ in -+ -+ let dirname_user = -+ match user with -+ | None -> "" -+ | Some user -> user.user_commit_dir -+ in -+ -+(* -+ let dirname_network = -+ match network with -+ | None -> "" -+ | Some network -> network -+ in -+*) -+(* todo: make the dir naming order user configurable *) -+ let compute_dir_name dir = -+ let dirname = Filename2.normalize (Filename.concat dir dirname_user) in -+(* let dirname = Filename.concat dirname dirname_network in *) -+ dirname -+ in -+ -+ let checkdir = -+ 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 -+ begin -+ match needed_space with -+ | None -> true -+ | Some needed_space -> -+ match Unix32.diskfree dirname with -+ Some v -> v >= needed_space -+ | _ -> true -+ end -+ else true -+ with _ -> true -+ ) directories -+ with Not_found -> raise Incoming_full; -+ in -+ -+ let newdir = { -+ shdir_dirname = (compute_dir_name checkdir.shdir_dirname); -+ shdir_priority = checkdir.shdir_priority; -+ shdir_networks = checkdir.shdir_networks; -+ shdir_strategy = checkdir.shdir_strategy; -+ } -+ in -+ Unix2.safe_mkdir newdir.shdir_dirname; -+ Unix2.can_write_to_directory newdir.shdir_dirname; -+ newdir - --let incoming_directories () = -- let dir = search_incoming_directories () in -- Unix2.safe_mkdir dir.shdir_dirname; -- Unix2.can_write_to_directory dir.shdir_dirname; -- dir - - let _ = - (* Check the definition of the incoming_files and incoming_directories in -@@ -929,8 +1033,8 @@ - option_hook shared_directories (fun _ -> - if not !verification then begin - verification := true; -- ignore (incoming_files ()); -- ignore (incoming_directories ()); -+ ignore (incoming_dir false ()); -+ ignore (incoming_dir true ()); - verification := false - end - ) -@@ -1038,19 +1142,15 @@ - Pervasives.really_input ic s 0 size; - header, s) in - Tar.output otar header s -- with e -> -- let error = Printexc2.to_string e in -- if error = "Gzip.Error(\"error during compression\")" -- && Autoconf.windows && arg = "fasttrack.ini" then begin -- (* for whatever reason this error is raised on Windows, -- but fasttrack.ini is stored correctly *) -- if !verbose then -- lprintf_nl "Tar: Windows specific pseudo error %s in %s" error arg -- end -- else begin -+ with -+ | (Gzip.Error "error during compression") as e when Autoconf.windows && arg = "fasttrack.ini" -> -+ (* for whatever reason this error is raised on Windows, -+ but fasttrack.ini is stored correctly *) -+ if !verbose then -+ lprintf_nl "Tar: Windows specific pseudo error %s in %s" (Printexc2.to_string e) arg -+ | e -> - failed_files := arg :: !failed_files; -- lprintf_nl "Tar: error %s in %s" error arg -- end -+ lprintf_nl "Tar: error %s in %s" (Printexc2.to_string e) arg - ) files); - if !failed_files <> [] then - failwith (Printf.sprintf "Tar: error backing up %s" -@@ -1141,7 +1241,7 @@ - let reserved_fds = 40 in (* ini files, dynamic libs, etc. *) - - let total_files = (* maximum number of files in use at the same time *) -- (maxi (List.length !!files) !!max_concurrent_downloads) + !!max_upload_slots + reserved_fds -+ (max (List.length !!files) !!max_concurrent_downloads) + !!max_upload_slots + reserved_fds - in - - let wanted_socks = !!max_opened_connections + total_files in -@@ -1158,7 +1258,7 @@ - else - begin - let new_max_opened_connections = -- maxi (max_all_sockets - total_files) (max_all_sockets / 2) -+ max (max_all_sockets - total_files) (max_all_sockets / 2) - in - lprintf_nl "max_opened_connections is set too high (%d), reducing to %d" - !!max_opened_connections new_max_opened_connections; -Index: src/daemon/common/commonComplexOptions.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonComplexOptions.mli,v -retrieving revision 1.17 -retrieving revision 1.20 -diff -u -r1.17 -r1.20 ---- src/daemon/common/commonComplexOptions.mli 19 Mar 2006 17:38:08 -0000 1.17 -+++ src/daemon/common/commonComplexOptions.mli 9 Nov 2006 21:32:26 -0000 1.20 -@@ -34,15 +34,15 @@ - (string * CommonTypes.query_entry) list - val special_queries : (string * string) list Options.option_record - --val sharing_strategies : string -> CommonTypes.sharing_strategy -+val sharing_strategies : (string * CommonTypes.sharing_strategy) list Options.option_record -+val sharing_strategy : string -> CommonTypes.sharing_strategy - - val shared_directories : - CommonTypes.shared_directory list Options.option_record - --val incoming_files : unit -> CommonTypes.shared_directory --val incoming_directories : unit -> CommonTypes.shared_directory --val search_incoming_files : unit -> CommonTypes.shared_directory --val search_incoming_directories : unit -> CommonTypes.shared_directory -+val incoming_dir : bool -> ?user:CommonTypes.userdb -> ?needed_space:int64 -> ?network:string -> unit -> CommonTypes.shared_directory -+val search_incoming_files : unit -> CommonTypes.shared_directory list -+val search_incoming_directories : unit -> CommonTypes.shared_directory list - - val sharing_only_directory : CommonTypes.sharing_strategy - -Index: src/daemon/common/commonFile.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonFile.ml,v -retrieving revision 1.60 -retrieving revision 1.70 -diff -u -r1.60 -r1.70 ---- src/daemon/common/commonFile.ml 5 Sep 2006 14:18:24 -0000 1.60 -+++ src/daemon/common/commonFile.ml 15 Nov 2006 12:37:13 -0000 1.70 -@@ -25,6 +25,7 @@ - open CommonTypes - open CommonOptions - open CommonGlobals -+open CommonUserDb - - let log_prefix = "[cF]" - -@@ -41,10 +42,12 @@ - (*************************************************************************) - - type 'a file_impl = { -+ mutable impl_file_owner : userdb; -+ mutable impl_file_group : groupdb option; - mutable impl_file_update : int; - mutable impl_file_state : file_state; - -- mutable impl_file_comment : string list; -+ mutable impl_file_comment : string; - mutable impl_file_num : int; - mutable impl_file_val : 'a; - mutable impl_file_ops : 'a file_ops; -@@ -59,6 +62,7 @@ - mutable impl_file_filenames : string list; - mutable impl_file_magic : string option; - mutable impl_file_priority: int; (* normal = 0, low < 0, high > 0 *) -+ mutable impl_file_release : bool; - mutable impl_file_last_seen : int; - mutable impl_file_probable_name : string option; - } -@@ -75,6 +79,7 @@ - has been changed. The method should not perform the move, just know that - it will happen soon. *) - mutable op_file_save_as : ('a -> string -> unit); -+ mutable op_file_shared : ('a -> CommonTypes.shared option); - mutable op_file_to_option : ('a -> (string * option_value) list); - mutable op_file_cancel : ('a -> unit); - mutable op_file_pause : ('a -> unit); -@@ -85,9 +90,10 @@ - mutable op_file_recover : ('a -> unit); - mutable op_file_all_sources : ('a -> client list); - mutable op_file_active_sources : ('a -> client list); -+ mutable op_file_comment : ('a -> string); - mutable op_file_set_priority : ('a -> int -> unit); -- mutable op_file_print_html : ('a -> Buffer.t -> unit); -- mutable op_file_print_sources_html : ('a -> Buffer.t -> unit); -+ mutable op_file_print : ('a -> CommonTypes.ui_conn -> unit); -+ mutable op_file_print_sources : ('a -> CommonTypes.ui_conn -> unit); - mutable op_file_files : ('a -> 'a file_impl -> file list); - (* added in 2.5.27 to remove use of network names in global modules *) - mutable op_file_debug : ('a -> string); -@@ -130,9 +136,12 @@ - impl_file_filenames = []; - impl_file_magic = None; - impl_file_priority = 0; -+ impl_file_release = false; - impl_file_last_seen = 0; -- impl_file_comment = []; -+ impl_file_comment = ""; - impl_file_probable_name = None; -+ impl_file_owner = admin_user; -+ impl_file_group = Some system_user_default_group; - } - - let dummy_file = as_file dummy_file_impl -@@ -198,16 +207,18 @@ - let file = as_file_impl file in - file.impl_file_ops.op_file_to_option file.impl_file_val - -- (* --let file_print (file : file) buf = -- let file = as_file_impl file in -- file.impl_file_ops.op_file_print file.impl_file_val buf -- *) -- - let file_save_as (file : file) name = - let file = as_file_impl file in - file.impl_file_ops.op_file_save_as file.impl_file_val name - -+let file_shared (file : file) = -+ let file = as_file_impl file in -+ file.impl_file_ops.op_file_shared file.impl_file_val -+ -+let file_comment (file : file) = -+ let file = as_file_impl file in -+ file.impl_file_ops.op_file_comment file.impl_file_val -+ - let file_network (file : file) = - let file = as_file_impl file in - file.impl_file_ops.op_file_network -@@ -216,7 +227,17 @@ - let file = as_file_impl file in - file.impl_file_ops.op_file_info file.impl_file_val - --let file_pause (file : file) = -+let file_owner file = -+ (as_file_impl file).impl_file_owner -+ -+let file_group file = -+ (as_file_impl file).impl_file_group -+ -+let user2_allow_file_admin file user = -+ user2_is_admin user || file_owner file = user -+ -+let file_pause (file : file) user = -+ if user2_allow_file_admin file user then - let file = as_file_impl file in - match file.impl_file_state with - | FileDownloading | FileQueued -> -@@ -224,7 +245,8 @@ - file.impl_file_ops.op_file_pause file.impl_file_val - | _ -> () - --let file_resume (file : file) = -+let file_resume (file : file) user = -+ if user2_allow_file_admin file user then - let file = as_file_impl file in - match file.impl_file_state with - | FilePaused | FileAborted _ -> -@@ -232,20 +254,47 @@ - file.impl_file_ops.op_file_resume file.impl_file_val - | _ -> () - -+let set_file_release file status user = -+ if user2_allow_file_admin file user then -+ let impl = as_file_impl file in -+ impl.impl_file_release <- status -+ -+let file_release (file: file) = -+ let impl = as_file_impl file in -+ impl.impl_file_release -+ -+let set_file_owner file owner = -+ (as_file_impl file).impl_file_owner <- owner -+ -+let set_file_group file group = -+ (as_file_impl file).impl_file_group <- group -+ -+let user2_filter_files files gui_user = -+ let newlist = List.filter -+ (fun file -> user2_can_view_file gui_user (file_owner file) (file_group file)) files in -+ newlist -+ -+let user2_num_user_dls user = -+ let n = ref 0 in -+ H.iter (fun f -> if file_owner f = user then incr n) files_by_num; -+ !n -+ -+let user2_num_group_dls group = -+ let n = ref 0 in -+ H.iter (fun f -> if file_group f = Some group then incr n) files_by_num; -+ !n -+ - let set_file_state file state = - let impl = as_file_impl file in - update_file_state impl state - - let set_file_comment file comment = -- if not (List.mem comment (as_file_impl file).impl_file_comment) then -- (as_file_impl file).impl_file_comment <- -- (as_file_impl file).impl_file_comment @ [(HashComments.merge file_comments comment)] -+ let impl = as_file_impl file in -+ impl.impl_file_comment <- comment - - let file_comment file = -- (as_file_impl file).impl_file_comment -- --let file_comment_length file = -- List.length (as_file_impl file).impl_file_comment -+ let impl = as_file_impl file in -+ impl.impl_file_comment - - let file_best_name (file : file) = - let file = as_file_impl file in -@@ -316,7 +365,9 @@ - try impl.impl_file_ops.op_file_active_sources impl.impl_file_val with _ -> [] - - (* Default for networks that don't implement it *) --let default_file_print_sources_html file buf = -+let default_file_print_sources file o = -+ let buf = o.conn_buf in -+ if use_html_mods o then begin - let cfile = as_file file in - let allsources = ref (file_all_sources cfile) in - if List.length !allsources > 0 then begin -@@ -346,7 +397,8 @@ - ("", "sr br ar", Printf.sprintf "%d" (client_num c)); - ("", "sr br", cinfo.GuiTypes.client_name); - ("", "sr br", addr); -- ("", "sr br", cinfo.GuiTypes.client_software); -+ (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)); ]; - -@@ -357,16 +409,26 @@ - Printf.bprintf buf "\\</table\\>\\</div\\>\\<br\\>"; - - end -+ end -+ else -+ let cfile = as_file file in -+ let srcs = ref (file_all_sources cfile) in -+ Printf.bprintf buf "%d sources:\n" (List.length !srcs); -+ let print_source c = -+ Printf.bprintf buf " [%4d] " (client_num c); -+ client_bprint c buf; -+ in -+ List.iter print_source !srcs; -+ () - -- --let file_print_sources_html (file : file) buf = -+let file_print_sources (file : file) conn = - let file = as_file_impl file in -- try file.impl_file_ops.op_file_print_sources_html file.impl_file_val buf with _ -> -- default_file_print_sources_html file buf -+ try file.impl_file_ops.op_file_print_sources file.impl_file_val conn with _ -> -+ default_file_print_sources file conn - --let file_print_html file buf = -+let file_print file o = - let impl = as_file_impl file in -- impl.impl_file_ops.op_file_print_html impl.impl_file_val buf -+ impl.impl_file_ops.op_file_print impl.impl_file_val o - - let file_find num = - H.find files_by_num (as_file { -@@ -469,7 +531,9 @@ - let set_file_magic file magic = - match magic with - None -> () -- | Some magic -> (as_file_impl file).impl_file_magic <- Some (HashMagic.merge files_magic magic) -+ | Some magic -> -+ (as_file_impl file).impl_file_magic <- Some (intern magic); -+ file_must_update file - - let check_magic file = - let check file = -@@ -488,9 +552,10 @@ - impl.impl_file_last_seen <- age - - let file_preview (file : file) = -- let cmd = Printf.sprintf "%s \"%s\" \"%s\"" !!previewer -- (file_disk_name file) (file_best_name file) in -- ignore (Sys.command cmd) -+ ignore( -+ Unix.create_process !!previewer -+ [| Filename2.basename !!previewer; file_disk_name file; file_best_name file |] -+ Unix.stdin Unix.stdout Unix.stderr) - - (*************************************************************************) - (* *) -@@ -627,6 +692,77 @@ - ("", "sr", Printf.sprintf "%d" (file_priority file)) ]; - - Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); -+ if user2_allow_file_admin file o.conn_user.ui_user then -+ let optionlist = ref "" in -+ user2_users_iter (fun user -> -+ if user <> (file_owner file) then -+ optionlist := !optionlist ^ Printf.sprintf "\\<option value=\\\"%s\\\"\\>%s\\</option\\>\n" user.user_name user.user_name; -+ ); -+ -+ html_mods_td buf [("Change file owner by selecting an alternate user", "sr br", "User"); -+ ("Change owner", "sr", Printf.sprintf " -+\\<script type=\\\"text/javascript\\\"\\> -+\\<!-- -+function submitChownForm(i) { -+var formID = document.getElementById(\\\"chownForm\\\" + i) -+var v = formID.newOwner.value; -+parent.fstatus.location.href='submit?q=chown+'+v+'+%d'; -+} -+//--\\> -+\\</script\\>" (file_num file) -+ ^ "\\<table border=0 cellspacing=0 cellpadding=0\\>\\<tr\\>" -+ ^ "\\<form name=\\\"chownForm1\\\" id=\\\"chownForm1\\\" action=\\\"javascript:submitChownForm(1);\\\"\\>" -+ ^ "\\<td\\>" -+ ^ "\\<select name=\\\"newOwner\\\" id=\\\"newOwner\\\" " -+ ^ "style=\\\"padding: 0px; font-size: 10px; font-family: verdana\\\" onchange=\\\"this.form.submit()\\\"\\>" -+ ^ Printf.sprintf "\\<option value=\\\"%s\\\" selected\\>%s\\</option\\>\n" (file_owner file).user_name (file_owner file).user_name -+ ^ !optionlist ^ "\\</select\\>\\</td\\>\\</form\\>\\</tr\\>\\</table\\>" -+ ) ]; -+ -+ else -+ html_mods_td buf [("File owner", "sr br", "User"); ("", "sr", (file_owner file).user_name)]; -+ -+ Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); -+ if user2_allow_file_admin file o.conn_user.ui_user && -+ o.conn_user.ui_user.user_groups <> [] then -+ let optionlist = -+ if (file_group file) = None then -+ ref "" -+ else -+ ref "\\<option value=\\\"None\\\"\\>None\\</option\\>\n" -+ in -+ user2_user_groups_iter (file_owner file) (fun group -> -+ if Some group <> (file_group file) then -+ optionlist := !optionlist ^ Printf.sprintf "\\<option value=\\\"%s\\\"\\>%s\\</option\\>\n" group.group_name group.group_name; -+ ); -+ -+ html_mods_td buf [("Change file group by selecting an alternate group", "sr br", "Group"); -+ ("Change group", "sr", Printf.sprintf " -+\\<script type=\\\"text/javascript\\\"\\> -+\\<!-- -+function submitChgrpForm(i) { -+var formID = document.getElementById(\\\"chgrpForm\\\" + i) -+var v = formID.newGroup.value; -+parent.fstatus.location.href='submit?q=chgrp+'+v+'+%d'; -+} -+//--\\> -+\\</script\\>" (file_num file) -+ ^ "\\<table border=0 cellspacing=0 cellpadding=0\\>\\<tr\\>" -+ ^ "\\<form name=\\\"chgrpForm1\\\" id=\\\"chgrpForm1\\\" action=\\\"javascript:submitChgrpForm(1);\\\"\\>" -+ ^ "\\<td\\>" -+ ^ "\\<select name=\\\"newGroup\\\" id=\\\"newGroup\\\" " -+ ^ "style=\\\"padding: 0px; font-size: 10px; font-family: verdana\\\" onchange=\\\"this.form.submit()\\\"\\>" -+ ^ Printf.sprintf "\\<option value=\\\"%s\\\" selected\\>%s\\</option\\>\n" (user2_print_group (file_group file)) (user2_print_group (file_group file)) -+ ^ !optionlist ^ "\\</select\\>\\</td\\>\\</form\\>\\</tr\\>\\</table\\>" -+ ) ]; -+ -+ else -+ html_mods_td buf [("File group", "sr br", "Group"); -+ ("", "sr", (match file_group file with -+ Some group -> Printf.sprintf "%s" group.group_name -+ | None -> "None"))]; -+ -+ Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); - html_mods_td buf [ - ("Number of file sources", "sr br", "Sources"); - ("", "sr", Printf.sprintf "%d" (List.length srcs)) ]; -@@ -671,30 +807,14 @@ - ("", "sr", magic) ] - | _ -> ()); - -- ( -- if file_comment file <> [] then -- begin -- let list_header = ref true in -- List.iter (fun s -> -- Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); -- if !list_header then html_mods_td buf [ -- ("File comments", "sr br", "File comments"); -- ("", "sr", s) ] -- else -- html_mods_td buf [ -- ("", "sr br", ""); -- ("", "sr", s) ]; -- if !list_header then list_header := false) (file_comment file); -- end); -- -- file_print_html file buf; -+ file_print file o; - - Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>"; - Printf.bprintf buf "\\</td\\>\\</tr\\>\\</table\\>\\</div\\>\\<br\\>"; - - end else - begin -- Printf.bprintf buf "[%-s %5d]\n%s\n%s%s\nTotal %10s\nPartial %10s\npriority %d\n" -+ Printf.bprintf buf "[%-s %5d]\n%s\n%s%s\nTotal %10s\nPartial %10s\npriority %d\nOwner/Group: %s/%s\n" - n.network_name - (file_num file) - (shorten (file_best_name file) 80) -@@ -704,7 +824,11 @@ - (string_of_uids info.G.file_uids) - (Int64.to_string info.G.file_size) - (Int64.to_string info.G.file_downloaded) -- (file_priority file); -+ (file_priority file) -+ (file_owner file).user_name -+ (match file_group file with -+ Some group -> Printf.sprintf "%s" group.group_name -+ | None -> "private"); - Printf.bprintf buf "Chunks: [%-s]\n" - (match info.G.file_chunks with - | None -> "" -@@ -713,24 +837,12 @@ - None -> () - | Some filename -> - Printf.bprintf buf "Probable name: %s\n" filename); -- List.iter (fun name -> Printf.bprintf buf " (%s)\n" name) info.G.file_names -+ List.iter (fun name -> Printf.bprintf buf " (%s)\n" name) info.G.file_names; -+ file_print file o - end; - - (try -- -- if !!print_all_sources then begin -- if use_html_mods o then -- file_print_sources_html file buf -- else begin -- Printf.bprintf buf "%d sources:\n" (List.length srcs); -- let print_source c = -- Printf.bprintf buf " [%4d] " (client_num c); -- client_bprint c buf; -- in -- List.iter print_source srcs; -- end; -- end -- -+ if !!print_all_sources then file_print_sources file o - with _ -> ()) - - let file_print_ed2k_link filename filesize md4hash = -@@ -869,6 +981,7 @@ - op_file_commit = (fun _ _ -> ni_ok network "file_commit"); - op_file_save_as = (fun _ _ -> ni_ok network "file_save_as"); - (* op_file_print = (fun _ _ -> ni_ok network "file_print"); *) -+ op_file_shared = (fun _ -> None); - op_file_to_option = (fun _ -> fni network "file_to_option"); - op_file_cancel = (fun _ -> ni_ok network "file_cancel"); - op_file_info = (fun _ -> fni network "file_info"); -@@ -881,9 +994,10 @@ - op_file_set_format = (fun _ -> fni network "file_set_format"); - op_file_all_sources = (fun _ -> fni network "file_all_sources"); - op_file_active_sources = (fun _ -> fni network "file_active_sources"); -+ op_file_comment = (fun _ -> ni_ok network "file_comment"; ""); - op_file_set_priority = (fun _ _ -> ni_ok network "file_set_priority"); -- op_file_print_html = (fun _ _ -> ni_ok network "file_print_html"); -- op_file_print_sources_html = (fun _ _ -> fni network "file_print_sources_html"); -+ op_file_print = (fun _ _ -> ni_ok network "file_print_html"); -+ op_file_print_sources = (fun _ _ -> fni network "file_print_sources"); - op_file_debug = (fun _ -> ""); - op_file_proposed_filenames = (fun impl -> []); - } -@@ -906,6 +1020,8 @@ - lprintf_nl "op_file_commit"; - if c.op_file_save_as == cc.op_file_save_as then - lprintf_nl "op_file_save_as"; -+ if c.op_file_shared == cc.op_file_shared then -+ lprintf_nl "op_file_shared"; - if c.op_file_cancel == cc.op_file_cancel then - lprintf_nl "op_file_cancel"; - if c.op_file_pause == cc.op_file_pause then -@@ -924,10 +1040,10 @@ - lprintf_nl "op_file_all_sources"; - if c.op_file_active_sources == cc.op_file_active_sources then - lprintf_nl "op_file_active_sources"; -- if c.op_file_print_html == cc.op_file_print_html then -- lprintf_nl "op_file_print_html"; -- if c.op_file_print_sources_html == cc.op_file_print_sources_html then -- lprintf_nl "op_file_print_sources_html"; -+ if c.op_file_print == cc.op_file_print then -+ lprintf_nl "op_file_print"; -+ if c.op_file_print_sources == cc.op_file_print_sources then -+ lprintf_nl "op_file_print_sources"; - ) !files_ops; - lprint_newline () - -@@ -949,12 +1065,6 @@ - ) files_by_num; - Printf.bprintf buf " files: %d\n" !counter; - Printf.bprintf buf " files_ops: %d\n" (List.length !files_ops); -- let counter = ref 0 in -- HashMagic.iter (fun _ -> incr counter) files_magic; -- Printf.bprintf buf " files_magic: %d\n" !counter; -- let counter = ref 0 in -- HashComments.iter (fun _ -> incr counter) file_comments; -- Printf.bprintf buf " files_comments: %d\n" !counter - ) - - -@@ -1072,7 +1182,7 @@ - let module T = GuiTypes in - { - T.file_fields = T.Fields_file_info.all; -- T.file_comment = ""; -+ T.file_comment = impl.impl_file_comment; - T.file_name = impl.impl_file_best_name; - T.file_names = impl.impl_file_filenames; - T.file_num = impl.impl_file_num; -@@ -1095,4 +1205,14 @@ - T.file_chunks_age = [||]; - T.file_uids = []; - T.file_sub_files = []; -+ T.file_magic = impl.impl_file_magic; -+ T.file_comments = []; -+ T.file_user = impl.impl_file_owner.user_name; -+ T.file_group = user2_print_group impl.impl_file_group; -+ T.file_release = impl.impl_file_release; - } -+ -+let lprintf_file_nl file fmt = -+ lprintf_nl2 ("[" ^ (file_network file).network_shortname ^ -+ "] [file_num " ^ (string_of_int (file_num file)) ^ "]" ^ -+ "[temp " ^ (file_disk_name file) ^ "]") fmt -Index: src/daemon/common/commonFile.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonFile.mli,v -retrieving revision 1.20 -retrieving revision 1.30 -diff -u -r1.20 -r1.30 ---- src/daemon/common/commonFile.mli 5 Sep 2006 14:18:24 -0000 1.20 -+++ src/daemon/common/commonFile.mli 12 Nov 2006 12:44:24 -0000 1.30 -@@ -18,10 +18,12 @@ - *) - - type 'a file_impl = { -+ mutable impl_file_owner : CommonTypes.userdb; -+ mutable impl_file_group : CommonTypes.groupdb option; - mutable impl_file_update : int; - mutable impl_file_state : CommonTypes.file_state; - -- mutable impl_file_comment : string list; -+ mutable impl_file_comment : string; - mutable impl_file_num : int; - mutable impl_file_val : 'a; - mutable impl_file_ops : 'a file_ops; -@@ -36,6 +38,7 @@ - mutable impl_file_filenames : string list; - mutable impl_file_magic : string option; - mutable impl_file_priority : int; -+ mutable impl_file_release : bool; - mutable impl_file_last_seen : int; - mutable impl_file_probable_name : string option; - } -@@ -43,6 +46,7 @@ - mutable op_file_network : CommonTypes.network; - mutable op_file_commit : 'a -> string -> unit; - mutable op_file_save_as : 'a -> string -> unit; -+ mutable op_file_shared : 'a -> CommonTypes.shared option; - mutable op_file_to_option : 'a -> (string * Options.option_value) list; - mutable op_file_cancel : 'a -> unit; - mutable op_file_pause : 'a -> unit; -@@ -53,9 +57,10 @@ - mutable op_file_recover : 'a -> unit; - mutable op_file_all_sources : 'a -> CommonTypes.client list; - mutable op_file_active_sources : 'a -> CommonTypes.client list; -+ mutable op_file_comment : 'a -> string; - mutable op_file_set_priority : 'a -> int -> unit; -- mutable op_file_print_html: 'a -> Buffer.t -> unit; -- mutable op_file_print_sources_html : 'a -> Buffer.t -> unit; -+ mutable op_file_print: 'a -> CommonTypes.ui_conn -> unit; -+ mutable op_file_print_sources : 'a -> CommonTypes.ui_conn -> unit; - mutable op_file_files : ('a -> 'a file_impl -> CommonTypes.file list); - mutable op_file_debug : 'a -> string; - mutable op_file_proposed_filenames : 'a -> string list; -@@ -75,10 +80,14 @@ - val update_file_state : 'a file_impl -> CommonTypes.file_state -> unit - val file_to_option : CommonTypes.file -> (string * Options.option_value) list - val file_save_as : CommonTypes.file -> string -> unit -+val file_shared : CommonTypes.file -> CommonTypes.shared option -+val file_comment : CommonTypes.file -> string - val file_network : CommonTypes.file -> CommonTypes.network - val file_info : CommonTypes.file -> GuiTypes.file_info --val file_pause : CommonTypes.file -> unit --val file_resume : CommonTypes.file -> unit -+val file_pause : CommonTypes.file -> CommonTypes.userdb -> unit -+val file_resume : CommonTypes.file -> CommonTypes.userdb -> unit -+val set_file_release : CommonTypes.file -> bool -> CommonTypes.userdb -> unit -+val file_release : CommonTypes.file -> bool - val set_file_state : CommonTypes.file -> CommonTypes.file_state -> unit - val file_best_name : CommonTypes.file -> string - val set_file_best_name : CommonTypes.file -> string -> string -> int -> unit -@@ -90,7 +99,7 @@ - val file_preview : CommonTypes.file -> unit - val file_all_sources : CommonTypes.file -> CommonTypes.client list - val file_active_sources : CommonTypes.file -> CommonTypes.client list --val file_print_sources_html : CommonTypes.file -> Buffer.t -> unit -+val file_print_sources : CommonTypes.file -> CommonTypes.ui_conn -> unit - val files_ops : (int file_ops * int file_ops) list ref - val new_file_ops : CommonTypes.network -> 'a file_ops - val check_file_implementations : unit -> unit -@@ -118,8 +127,7 @@ - val set_file_last_seen : CommonTypes.file -> int -> unit - val file_debug : CommonTypes.file -> string - val set_file_comment : CommonTypes.file -> string -> unit --val file_comment : CommonTypes.file -> string list --val file_comment_length : CommonTypes.file -> int -+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 -@@ -136,3 +144,13 @@ - - val forceable_download : CommonTypes.result_info list ref - val impl_file_info : 'a file_impl -> GuiTypes.file_info -+ -+val user2_filter_files : CommonTypes.file list -> CommonTypes.userdb -> CommonTypes.file list -+val user2_num_user_dls : CommonTypes.userdb -> int -+val user2_num_group_dls : CommonTypes.groupdb -> int -+val user2_allow_file_admin : CommonTypes.file -> CommonTypes.userdb -> bool -+val set_file_owner : CommonTypes.file -> CommonTypes.userdb -> unit -+val file_owner : CommonTypes.file -> CommonTypes.userdb -+val set_file_group : CommonTypes.file -> CommonTypes.groupdb option -> unit -+val file_group : CommonTypes.file -> CommonTypes.groupdb option -+val lprintf_file_nl : CommonTypes.file -> ('a, unit, unit) Pervasives.format -> 'a -Index: src/daemon/common/commonGlobals.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonGlobals.ml,v -retrieving revision 1.71 -retrieving revision 1.76 -diff -u -r1.71 -r1.76 ---- src/daemon/common/commonGlobals.ml 16 Sep 2006 15:36:08 -0000 1.71 -+++ src/daemon/common/commonGlobals.ml 21 Nov 2006 22:34:33 -0000 1.76 -@@ -117,7 +117,7 @@ - with e -> slen - in - let diff_len_utf8_ascii = slen - len in -- let max_len = maxi limit 10 in -+ let max_len = max limit 10 in - if len > max_len then - let prefix = String.sub name 0 (max_len - 7 + diff_len_utf8_ascii) in - let suffix = String.sub name (len - 4 + diff_len_utf8_ascii) 4 in -@@ -177,7 +177,7 @@ - cc.control_state <- cc.control_state + 1 - - let connection_next_try cc = -- cc.control_last_try + mini (cc.control_min_reask * cc.control_state) -+ cc.control_last_try + min (cc.control_min_reask * cc.control_state) - cc.control_min_reask - - let connection_can_try cc = -@@ -238,7 +238,7 @@ - float_of_int (if !!max_hard_upload_rate = 0 then - 10000 * 1024 - else -- maxi (!!max_hard_upload_rate * 1024) 1024) *. 0.90; -+ max (!!max_hard_upload_rate * 1024) 1024) *. 0.90; - ); - option_hook max_hard_download_rate (fun _ -> - check_ul_dl_ratio (); -@@ -481,17 +481,18 @@ - - let log_chat_message i num n s = - Fifo.put chat_message_fifo (last_time(),i,num,n,s); -- try -+ (try - Unix2.tryopen_write_gen !messages_log [Open_creat; Open_wronly; Open_append] - 0o600 (fun oc -> - Printf.fprintf oc "%s: %s (%s): %s\n" (Date.simple (BasicSocket.date_of_int (last_time ()))) n i s) - with e -> - lprintf_nl "[ERROR] Exception %s while trying to log message to %s" -- (Printexc2.to_string e) !messages_log; -+ (Printexc2.to_string e) !messages_log); - - while (Fifo.length chat_message_fifo) > !!html_mods_max_messages do - ignore(Fifo.take chat_message_fifo) - done -+ - let last_message_log = ref 0 - - -@@ -499,7 +500,7 @@ - let debug_clients = ref Intset.empty - - let default_user = { -- ui_user_name = CommonUserDb.admin_user; -+ ui_user = CommonUserDb.admin_user; - ui_user_searches = []; - ui_last_search = None; - ui_last_results = []; -@@ -513,7 +514,7 @@ - match list with - [] -> - let u = { -- ui_user_name = user; -+ ui_user = (CommonUserDb.user2_user_find user); - ui_user_searches = []; - ui_last_search = None; - ui_last_results = []; -@@ -522,7 +523,7 @@ - ui_users := u :: !ui_users; - u - | u :: tail -> -- if u.ui_user_name = user then u else iter tail -+ if u.ui_user = (CommonUserDb.user2_user_find user) then u else iter tail - in - iter !ui_users - -@@ -617,8 +618,12 @@ - put time sample short_delay_bandwidth_samples; - trimto 5 short_delay_bandwidth_samples - -+let history_step = 5 - let history_size = 720 -+let history_h_step = history_size * history_step - let history_h_size = 720 -+let history_timeflag = ref 0. -+let history_h_timeflag = ref 0. - - let upload_history = Fifo.create () - let download_history = Fifo.create () -@@ -637,7 +642,7 @@ - let update_download_history () = - Fifo.put download_history (download_usage ()); - let len = ref (Fifo.length download_history) in -- while !len > history_size do -+ while !len > history_size+1 do - ignore (Fifo.take download_history); - decr len - done -@@ -645,7 +650,7 @@ - let update_upload_history () = - Fifo.put upload_history (upload_usage ()); - let len = ref (Fifo.length upload_history) in -- while !len > history_size do -+ while !len > history_size+1 do - ignore (Fifo.take upload_history); - decr len - done -@@ -653,7 +658,7 @@ - let update_h_download_history () = - Fifo.put download_h_history ((List.fold_left (+) 0 (Fifo.to_list download_history)) / ((Fifo.length download_history))); - let len = ref (Fifo.length download_h_history) in -- while !len > history_h_size do -+ while !len > history_h_size+1 do - ignore (Fifo.take download_h_history); - decr len - done -@@ -661,19 +666,19 @@ - let update_h_upload_history () = - Fifo.put upload_h_history ((List.fold_left (+) 0 (Fifo.to_list upload_history)) / ((Fifo.length upload_history))); - let len = ref (Fifo.length upload_h_history) in -- while !len > history_h_size do -+ while !len > history_h_size+1 do - ignore (Fifo.take upload_h_history); - decr len - done - - let detected_link_capacity link = -- List.fold_left maxi 0 (Fifo.to_list link) -+ List.fold_left max 0 (Fifo.to_list link) - - let detected_uplink_capacity () = -- List.fold_left maxi 0 (Fifo.to_list upload_history) -+ List.fold_left max 0 (Fifo.to_list upload_history) - - let detected_downlink_capacity () = -- List.fold_left maxi 0 (Fifo.to_list download_history) -+ List.fold_left max 0 (Fifo.to_list download_history) - - - let new_tag name v = -@@ -890,18 +895,36 @@ - activity := new_activity () - ) - --module HashMagic = Weak.Make(struct -+module StringIntern = Weak.Make(struct - type t = string - let hash s = Hashtbl.hash s - let equal x y = x = y - end) - --let files_magic = HashMagic.create 100 -+let intern_table = StringIntern.create 1000 -+let intern s = StringIntern.merge intern_table s - --module HashComments = Weak.Make(struct -- type t = string -- let hash s = Hashtbl.hash s -- let equal x y = x = y -- end) -+let print_command_result o buf result = -+ if use_html_mods o then -+ html_mods_table_one_row buf "serversTable" "servers" [ -+ ("", "srh", result); ] -+ else -+ Printf.bprintf buf "%s" result - --let file_comments = HashComments.create 1000 -+let _ = -+ Heap.add_memstat "CommonGlobals" (fun level buf -> -+ let counter = ref 0 in -+ StringIntern.iter (fun f -> incr counter;) intern_table; -+ Printf.bprintf buf " intern_table: %d\n" !counter; -+ Printf.bprintf buf " core_gui_fifo: %d\n" (Fifo.length core_gui_fifo); -+ Printf.bprintf buf " gui_core_fifo: %d\n" (Fifo.length gui_core_fifo); -+ Printf.bprintf buf " chat_message_fifo: %d\n" (Fifo.length chat_message_fifo); -+ Printf.bprintf buf " upload_history: %d\n" (Fifo.length upload_history); -+ Printf.bprintf buf " download_history: %d\n" (Fifo.length download_history); -+ Printf.bprintf buf " upload_h_history: %d\n" (Fifo.length upload_h_history); -+ Printf.bprintf buf " download_h_history: %d\n" (Fifo.length download_h_history); -+ Printf.bprintf buf " bandwidth_samples: %d\n" (Fifo.length bandwidth_samples); -+ Printf.bprintf buf " short_delay_bandwidth_samples: %d\n" (Fifo.length short_delay_bandwidth_samples); -+ Printf.bprintf buf " dummy_sample: %d\n" (Array.length dummy_sample); -+ Printf.bprintf buf " activities: %d\n" (Fifo.length activities); -+ ) -Index: src/daemon/common/commonInteractive.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonInteractive.ml,v -retrieving revision 1.80 -retrieving revision 1.84 -diff -u -r1.80 -r1.84 ---- src/daemon/common/commonInteractive.ml 5 Sep 2006 14:18:24 -0000 1.80 -+++ src/daemon/common/commonInteractive.ml 9 Nov 2006 21:32:26 -0000 1.84 -@@ -40,6 +40,7 @@ - open CommonServer - open CommonTypes - open CommonComplexOptions -+open CommonUserDb - - let log_prefix = "[cInt]" - -@@ -179,7 +180,11 @@ - ("DLFILES", string_of_int (List.length !!files)); - ("INCOMING", incoming); - ("NETWORK", network.network_name); -- ("ED2K_HASH", (file_print_ed2k_link filename (file_size file) info.G.file_md4))] -+ ("ED2K_HASH", (file_print_ed2k_link filename (file_size file) info.G.file_md4)); -+ ("FILE_OWNER",(file_owner file).user_name); -+ ("FILE_GROUP",user2_print_group (file_group file)); -+ ] -+ - with e -> - lprintf_nl "Exception %s while executing %s" - (Printexc2.to_string e) !!file_completed_cmd -@@ -207,26 +212,13 @@ - (try - let file_name = file_disk_name file in - let incoming = -- if Unix2.is_directory file_name then -- incoming_directories () -- else -- incoming_files () -+ incoming_dir -+ (Unix2.is_directory file_name) -+ ~needed_space:(file_size file) -+ ~user:(file_owner file) -+ () - in - --(* check if temp_directory and incoming are on different partitions *) -- if (Unix.stat incoming.shdir_dirname).Unix.st_dev <> -- (Unix.stat !!temp_directory).Unix.st_dev -- then -- begin -- match Unix32.diskfree incoming.shdir_dirname with -- Some v -> if v < (file_size file) then begin -- send_dirfull_warning incoming.shdir_dirname true -- (Printf.sprintf "can not commit %s" (file_best_name file)); -- raise Incoming_full -- end -- | _ -> () -- end; -- - let new_name = file_commited_name incoming.shdir_dirname file in - if Unix2.is_directory file_name then begin - Unix2.safe_mkdir new_name; -@@ -275,11 +267,15 @@ - with e -> - lprintf_nl "Exception %s in file_commit secondaries" (Printexc2.to_string e); - ) secondary_files -- with e -> -- lprintf_nl "Exception in file_commit: %s" (Printexc2.to_string e)) -+ with -+ Incoming_full -> -+ send_dirfull_warning "" true -+ (Printf.sprintf "all incoming dirs are full, can not commit %s" (file_best_name file)) -+ | e -> lprintf_nl "Exception in file_commit: %s" (Printexc2.to_string e)) - | _ -> assert false - --let file_cancel file = -+let file_cancel file user = -+ if user2_allow_file_admin file user then - try - let impl = as_file_impl file in - if impl.impl_file_state <> FileCancelled then -@@ -308,7 +304,8 @@ - lprintf_nl "Exception in file_cancel: %s" (Printexc2.to_string e) - - let mail_for_completed_file file = -- if !!mail <> "" then -+ let usermail = (file_owner file).user_mail in -+ if !!mail <> "" || usermail <> "" then begin - let module M = Mailer in - let info = file_info file in - let line1 = "mldonkey has completed the download of:\r\n\r\n" in -@@ -320,11 +317,8 @@ - (let age = (BasicSocket.last_time ()) - info.G.file_age in Date.time_to_string age "verbose") - in - -- let line3 = if (file_comment file) = [] then "" else -- let buf = Buffer.create 1000 in -- Printf.bprintf buf "\r\nComments:\r\n"; -- List.iter (fun s -> Printf.bprintf buf "%s\r\n" s;) (file_comment file); -- Buffer.contents buf -+ let line3 = if (file_comment file) = "" then "" else -+ Printf.sprintf "\r\nComment: %s\r\n" (file_comment file) - in - - let subject = if !!filename_in_subject then -@@ -333,12 +327,8 @@ - Printf.sprintf "mldonkey@%s, file received" (Unix.gethostname ()) - in - -- let incoming = -- if Unix2.is_directory (file_disk_name file) then -- incoming_directories () -- else -- incoming_files () -- in -+(* TODO: This information can be wrong *) -+ 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)) -@@ -348,13 +338,22 @@ - Printf.sprintf "\r\nauto_commit is disabled, file is not committed to incoming" - in - -- let mail = { -- M.mail_to = !!mail; -- M.mail_from = !!mail; -+ let line6 = -+ Printf.sprintf "\r\nUser/Group: %s:%s\r\n" (file_owner file).user_name (user2_print_group (file_group file)) -+ in -+ -+ let send_mail address admin = -+ let mail = { -+ M.mail_to = address; -+ M.mail_from = address; - M.mail_subject = subject; -- M.mail_body = line1 ^ line2 ^ line3 ^ line4 ^ line5; -+ M.mail_body = line1 ^ line2 ^ line3 ^ line4 ^ line5 ^ (if admin then line6 else ""); - } in -- M.sendmail !!smtp_server !!smtp_port !!add_mail_brackets mail -+ M.sendmail !!smtp_server !!smtp_port !!add_mail_brackets mail -+ in -+ if !!mail <> "" then send_mail !!mail true; (* Multiuser ToDo: this mail is for the admin user, optional? *) -+ if usermail <> "" && usermail <> !!mail then (try send_mail usermail false with Not_found -> ()) -+ end - - let file_completed (file : file) = - try -@@ -502,7 +501,7 @@ - let display_bw_stats = ref false - - let start_download file = -- if !!pause_new_downloads then file_pause file; -+ if !!pause_new_downloads then file_pause file admin_user; - if !!file_started_cmd <> "" then - MlUnix.fork_and_exec !!file_started_cmd - [| -@@ -521,7 +520,7 @@ - | Some s -> - let result = List.assoc (int_of_string arg) user.ui_last_results in - let files = CommonResult.result_download -- result [] false in -+ result [] false user.ui_user in - List.iter start_download files; - "download started" - with -@@ -940,92 +939,123 @@ - and the ones with lowest priority in FileQueued state, if there - is a max_concurrent_downloads constraint. - --In the future, we could try to mix this with the multi-users --system to give some fairness between downloads of different --users. -- - **************************************************************) - - open CommonFile - -+type user_file_list = { -+ file_list : file list; -+ downloads_allowed : int option; -+} -+ - let force_download_quotas () = -- let files = List.sort (fun f1 f2 -> -- let v = file_priority f2 - file_priority f1 in -- if v <> 0 then v else -- (** -- * [egs] do not start downloading -- * a small file against an already active download -- **) -- let d1 = file_downloaded f1 in -- let d2 = file_downloaded f2 in -- if d1 = 0L && d2 > 0L then 1 -- else -- if d1 > 0L && d2 = 0L then -1 -- else -- (* Try to download in priority files with fewer bytes missing -- Rationale: once completed, it may allow to recover some disk space *) -- let r1 = file_size f1 -- d1 in -- let r2 = file_size f2 -- d2 in -- if r1 = r2 then 0 else -- if r2 < r1 then 1 else -1 -- ) !!CommonComplexOptions.files in -- -- (** move running and queued downloads from [list] to [files] -- accumulator, until a drop of priority (or end of list) is -- encountered; Then submit the batches of downloads with same -- priority to [iter_line]. -- -- @param ndownloads number of running downloads no longer in [list] -- @param nqueued number of queued downloads in [files] -- *) -- let rec iter list priority files ndownloads nqueued = -- match list, files with -- | [], [] -> () -- | [], _ -> -- iter_line list priority files ndownloads nqueued -- | f :: tail , _ :: _ when file_priority f < priority -> -- iter_line list priority files ndownloads nqueued -- | f :: tail, files -> -- match file_state f with -- | FileDownloading -> -- iter tail (file_priority f) (f :: files) (ndownloads+1) nqueued -- | FileQueued -> -- iter tail (file_priority f) (f :: files) ndownloads (nqueued+1) -- | _ -> -- iter tail (file_priority f) files ndownloads nqueued -- -- (** queue or unqueue downloads from [files] list to match quotas *) -- and iter_line list priority files ndownloads nqueued = -- if ndownloads > !!max_concurrent_downloads then -- match files with -- | [] -> assert false -- | f :: tail -> -- match file_state f with -- | FileDownloading -> -- set_file_state f FileQueued; -- iter_line list priority tail (ndownloads-1) nqueued -- | _ -> iter_line list priority tail ndownloads (nqueued-1) -- else -- if ndownloads < !!max_concurrent_downloads && nqueued > 0 then -- match files with -- | [] -> assert false -- | f :: tail -> -- match file_state f with -- | FileQueued -> -- set_file_state f FileDownloading; -- iter_line list priority tail (ndownloads+1) (nqueued-1) -- | _ -> iter_line list priority tail ndownloads nqueued -- else -- iter list priority [] ndownloads 0 - -- in -- if not !all_temp_queued then -- iter files max_int [] 0 0 -+ let queue_files files = -+ List.iter (fun file -> -+ if file_state file = FileDownloading then -+ set_file_state file FileQueued -+ ) files in -+ -+ let queue_user_file_list (_user, user_file_list) = -+ queue_files user_file_list.file_list in -+ -+ if !all_temp_queued then -+ queue_files !!CommonComplexOptions.files - else -- List.iter (fun f -> -- if file_state f = FileDownloading then -- set_file_state f FileQueued -- ) files -+ -+ (* create the assoc list of downloads of each user *) -+ let files_by_user = List.fold_left (fun acc f -> -+ let owner = CommonFile.file_owner f in -+ try -+ let owner_file_list = List.assoc owner acc in -+ (owner, { owner_file_list with -+ file_list = f :: owner_file_list.file_list }) :: -+ List.remove_assoc owner acc -+ with Not_found -> -+ (owner, { -+ downloads_allowed = -+ (match owner.user_max_concurrent_downloads with -+ | 0 -> None -+ | i -> Some i); -+ file_list = [f] }) :: acc -+ ) [] !!CommonComplexOptions.files in -+ -+ (* sort each user's list separately *) -+ let files_by_user = List.map (fun (owner, owner_file_list) -> -+ owner, { owner_file_list with -+ file_list = List.sort (fun f1 f2 -> -+ let v = compare (file_priority f2) (file_priority f1) in -+ if v <> 0 then v else -+ (* [egs] do not start downloading a small file -+ against an already active download *) -+ let d1 = file_downloaded f1 in -+ let d2 = file_downloaded f2 in -+ let active1 = d1 > 0L in -+ let active2 = d2 > 0L in -+ if not active1 && active2 then 1 -+ else if active1 && not active2 then -1 -+ else -+ (* Try to download in priority files with fewer bytes missing -+ Rationale: once completed, it may allow to recover some disk space *) -+ let remaining1 = file_size f1 -- d1 in -+ let remaining2 = file_size f2 -- d2 in -+ compare remaining1 remaining2 -+ ) owner_file_list.file_list } -+ ) files_by_user in -+ -+ (* sort the assoc list itself with user with highest quota first *) -+ let files_by_user = -+ List.sort (fun (_owner1, { downloads_allowed = allowed1 }) -+ (_owner2, { downloads_allowed = allowed2 }) -> -+ match allowed1, allowed2 with -+ | None, None -> 0 -+ | None, _ -> -1 -+ | _, None -> 1 -+ | Some allowed1, Some allowed2 -> compare allowed2 allowed1 -+ ) files_by_user in -+ -+ (* serve users round-robin, starting with the one with highest quota *) -+ let rec iter downloads_left to_serve served = -+ if downloads_left = 0 then begin -+ List.iter queue_user_file_list to_serve; -+ List.iter queue_user_file_list served -+ end else -+ match to_serve with -+ | [] -> -+ if served = [] then () (* nothing left to rotate *) -+ else (* new round *) -+ iter downloads_left served [] -+ | (_owner, { file_list = [] }) :: others -> -+ (* user satisfied, remove from lists *) -+ iter downloads_left others served -+ | ((_owner, { downloads_allowed = Some 0 }) as first) :: others -> -+ (* reached quota, remove from future rounds *) -+ queue_user_file_list first; -+ iter downloads_left others served -+ | (owner, { file_list = first_file :: other_files; -+ downloads_allowed = allowed }) :: others -> -+ let is_downloading = -+ match file_state first_file with -+ | FileDownloading -> true -+ | FileQueued -> -+ set_file_state first_file FileDownloading; -+ true -+ | _ -> false in -+ if is_downloading then -+ iter (downloads_left - 1) others -+ ((owner, { -+ file_list = other_files; -+ downloads_allowed = match allowed with -+ | None -> None -+ | Some i -> Some (i - 1) -+ }) :: served) -+ else -+ iter downloads_left others -+ ((owner, { -+ file_list = other_files; -+ downloads_allowed = allowed -+ }) :: served) in -+ iter !!max_concurrent_downloads files_by_user [] - - let _ = - option_hook max_concurrent_downloads (fun _ -> -Index: src/daemon/common/commonMessages.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonMessages.ml,v -retrieving revision 1.55 -retrieving revision 1.60 -diff -u -r1.55 -r1.60 ---- src/daemon/common/commonMessages.ml 26 Aug 2006 12:05:53 -0000 1.55 -+++ src/daemon/common/commonMessages.ml 5 Nov 2006 14:11:29 -0000 1.60 -@@ -47,103 +47,354 @@ - string_option - " - body { --background: @color_background@; margin-top: 3px; margin-left: 5px; margin-right: 5px; --font-family: Verdana, sans-serif; font-size: 12px; --scrollbar-face-color: @color_scrollbar_face@; scrollbar-shadow-color: @color_scrollbar_face@; --scrollbar-highlight-color: @color_scrollbar_highlight@; scrollbar-3dlight-color: @color_some_scrollbar@; --scrollbar-darkshadow-color: @color_some_scrollbar@; scrollbar-track-color: @color_background@; --scrollbar-arrow-color: @color_some_scrollbar@; } --table.commands { border: @color_general_border@ solid 1px; background: @color_background@ } --table.topcommands { background: @color_background@; border: @color_general_border@ solid 1px; border-top: @color_scrollbar_highlight@ solid 1px; border-left: @color_scrollbar_highlight@ solid 1px; } --pre { color: @color_general_text@; font-family: Courier, Arial, Helvetica, sans-serif; font-size: 12px; } --p { color: @color_general_text@; font-family: Verdana, Courier, Arial, Helvetica, sans-serif; font-size: 12px; } --input.txt { background: @color_input_text@ } --input.txt2 { background: @color_bbig_background@; --font: 12px courier; padding: 0px; --width: 38px; height: 18px; line-height: 14px; color: @color_general_text@; --border-right: @color_some_border@ 2px solid; border-top: @color_general_border@ 1px solid; border-left: @color_general_border@ 1px solid; border-bottom: @color_some_border@ 2px solid; } --input.but2 { background: @color_bsmall3@; --border: 0px; padding: 0px; font: bold 10px verdana; --width: 36px; height: 14px; } --input.but { background: @color_input_button@ }; -- --a:link,a:active,a:visited { text-decoration: none; font-face: verdana; --font-size: 10px; color: @color_anchor@; } --a:hover { color: @color_anchor_hover@; text-decoration: underline;} -+ background: @color_background@; -+ margin-top: 3px; -+ margin-left: 5px; -+ margin-right: 5px; -+ font-family: Verdana, sans-serif; -+ font-size: 12px; -+ } -+table.commands { -+ border: @color_general_border@ solid 1px; -+ background: @color_background@; -+ } -+table.topcommands { -+ background: @color_background@; -+ border: @color_general_border@ solid 1px; -+ border-top: @color_scrollbar_highlight@ solid 1px; -+ border-left: @color_scrollbar_highlight@ solid 1px; -+ } -+pre { -+ color: @color_general_text@; -+ font-family: Courier, Arial, Helvetica, sans-serif; -+ font-size: 12px; -+ } -+p { -+ color: @color_general_text@; -+ font-family: Verdana, Courier, Arial, Helvetica, sans-serif; -+ font-size: 12px; -+ } -+input.txt { -+ background: @color_input_text@; -+ } -+input.txt2 { -+ background: @color_bbig_background@; -+ font: 12px courier; -+ padding: 0px; -+ width: 38px; -+ height: 18px; -+ line-height: 14px; -+ color: @color_general_text@; -+ border-right: @color_some_border@ 2px solid; -+ border-top: @color_general_border@ 1px solid; -+ border-left: @color_general_border@ 1px solid; -+ border-bottom: @color_some_border@ 2px solid; -+ } -+input.but2 { -+ background: @color_bsmall3@; -+ border: 0px; -+ padding: 0px; -+ font: bold 10px verdana; -+ width: 36px; -+ height: 14px; -+ } -+input.but { -+ background: @color_input_button@; -+ } -+a:link, a:active, a:visited { -+ text-decoration: none; -+ font-family: verdana; -+ font-size: 10px; -+ color: @color_anchor@; -+ } -+a:hover { -+ color: @color_anchor_hover@; -+ text-decoration: underline; -+ } - .bu { --vertical-align: middle; white-space: nowrap; --background: @color_chunk3@; color: @color_foreground_text_for_top_buttons@; --font-family: Verdana; font-size: 9px; line-height: 12px; --margin-top: 0px; margin-bottom: 0px; --padding-left: 6px; padding-right: 6px; padding-top: 1px; padding-bottom: 1px; --border: @color_some_border@ 0px solid; } -+ vertical-align: middle; -+ white-space: nowrap; -+ background: @color_chunk3@; -+ color: @color_foreground_text_for_top_buttons@; -+ font-family: Verdana; -+ font-size: 9px; -+ line-height: 12px; -+ margin-top: 0px; -+ margin-bottom: 0px; -+ padding-left: 6px; -+ padding-right: 6px; -+ padding-top: 1px; -+ padding-bottom: 1px; -+ border: @color_some_border@ 0px solid; -+ } - .bbig { --text-align: center; font-size: 10px; font-family: Verdana; font-weight: 500; --border-top: @color_scrollbar_highlight@ 1px solid; border-left: @color_scrollbar_highlight@ 1px solid; border-bottom: @color_general_border@ 1px solid; border-right: @color_general_border@ 1px solid; --padding-left: 4px; padding-right: 4px; padding-top: 1px; padding-bottom: 1px; --color: @color_general_text@; background: @color_bbig_background@; } -+ text-align: center; -+ font-size: 10px; -+ font-family: Verdana; -+ font-weight: 500; -+ border-top: @color_scrollbar_highlight@ 1px solid; -+ border-left: @color_scrollbar_highlight@ 1px solid; -+ border-bottom: @color_general_border@ 1px solid; -+ border-right: @color_general_border@ 1px solid; -+ padding-left: 4px; -+ padding-right: 4px; -+ padding-top: 1px; -+ padding-bottom: 1px; -+ color: @color_general_text@; -+ background: @color_bbig_background@; -+ } - .bbigm { --text-align: center; font: bold 10px verdana; --border-top: @color_scrollbar_highlight@ 1px solid; border-left: @color_scrollbar_highlight@ 1px solid; border-bottom: @color_general_border@ 1px solid; border-right: @color_general_border@ 1px solid; --padding-left: 4px; padding-right: 4px; padding-top: 1px; padding-bottom: 1px; --color: @color_general_text@; background: @color_bsmall3@; } --.bsmall { background: @color_bsmall_back@; } --.bsmall1 { background: @color_bbig_background@; } --.bsmall2 { background: @color_bsmall2@; } --.bsmall3 { background: @color_bsmall3@; } --.bbig2 { background: @color_bsmall3@; } --.bbig3 { background: @color_scrollbar_face@; } --.b1 { border-left: @color_border_of_top_buttons@ solid 1px; border-top: @color_border_of_top_buttons@ solid 1px; border-right: @color_border_of_top_buttons@ solid 1px; border-bottom: @color_border_of_top_buttons@ solid 1px; } --.b2 { border-left: @color_border_of_top_buttons@ solid 0px; border-top: @color_border_of_top_buttons@ solid 1px; border-right: @color_border_of_top_buttons@ solid 1px; border-bottom: @color_border_of_top_buttons@ solid 1px; } --.b3 { border-left: @color_border_of_top_buttons@ solid 1px; border-top: @color_border_of_top_buttons@ solid 0px; border-right: @color_border_of_top_buttons@ solid 1px; border-bottom: @color_border_of_top_buttons@ solid 1px; } --.b4 { border-left: @color_border_of_top_buttons@ solid 0px; border-top: @color_border_of_top_buttons@ solid 0px; border-right: @color_border_of_top_buttons@ solid 1px; border-bottom: @color_border_of_top_buttons@ solid 1px; } --.bb1 { border-left: @color_general_border@ solid 1px; border-top: @color_scrollbar_highlight@ solid 1px; border-right: @color_scrollbar_highlight@ solid 1px; border-bottom: @color_general_border@ solid 1px; } --.bb2 { border-left: @color_big_buttons_and_border_highlight@ solid 1px; border-top: @color_scrollbar_highlight@ solid 1px; border-right: @color_scrollbar_highlight@ solid 0px; border-bottom: @color_general_border@ solid 1px; } --.bb3 { border-left: @color_big_buttons_and_border_highlight@ solid 1px; border-top: @color_scrollbar_highlight@ solid 1px; border-right: @color_general_border@ solid 0px; border-bottom: @color_general_border@ solid 0px; } --.bb4 { border-left: @color_big_buttons_and_border_highlight@ solid 1px; border-top: @color_scrollbar_highlight@ solid 1px; border-right: @color_general_border@ solid 1px; border-bottom: @color_general_border@ solid 0px; } --.src { border-left: @color_general_border@ solid 0px; border-top: @color_general_border@ solid 0px; border-right: @color_general_border@ solid 1px; border-bottom: @color_general_border@ solid 1px; } --.srctd { font-family: Verdana; font-size: 8px; } --td.fbig { color: @color_general_text@; cursor: pointer; padding-left: 2px; padding-right: 2px; font-family: Verdana; font-size: 10px; background: @color_fbig_background@; --border-top: @color_general_border@ solid 1px; border-left: @color_general_border@ solid 1px; } --td.pr { border-right: @color_general_border@ solid 1px; } --td.fbigb { border-top: @color_general_border@ solid 0px; border-bottom: @color_general_border@ solid 1px; } --td.fbigpad { padding-top: 2px; padding-bottom: 2px; } --td, tr {font-size: 12px; font-face: verdana; } --td.sr { white-space: nowrap; padding-top: 2px; padding-bottom: 2px; padding-left: 4px; padding-right: 4px; font-family: verdana; font-size: 10px; color: @color_general_text@; } --td.srp { white-space: nowrap; padding-top: 2px; padding-bottom: 2px; padding-left: 0px; padding-right: 4px; font-family: verdana; font-size: 10px; color: @color_one_td_text@; } --td.srw { padding-top: 2px; padding-bottom: 2px; padding-left: 4px; padding-right: 4px; font-family: verdana; font-size: 10px; color: @color_general_text@; } --td.srh { cursor: pointer; vertical-align: top; background: @color_table_header_background@; white-space: nowrap; padding-top: 2px; padding-bottom: 2px; padding-left: 4px; padding-right: 4px; --font-family: verdana; font-size: 10px; color: @color_general_text@; } --td.total { border-top: @color_general_border@ solid 1px; border-bottom: @color_general_border@ solid 1px; } --tr.dl-1, td.dl-1 { background: @color_dl1_back@; } --tr.dl-2, td.dl-2 { background: @color_dl2_back@; } --.mOvr1, tr.mOvr1 {background: @color_mOver1_back@; cursor: pointer; } --.mOvr2, tr.mOvr2 {background: @color_mOver2_back@; cursor: pointer; } --.mOvr3, tr.mOvr3 {background: @color_mOver3_back@; cursor: pointer; } -+ text-align: center; -+ font: bold 10px verdana; -+ border-top: @color_scrollbar_highlight@ 1px solid; -+ border-left: @color_scrollbar_highlight@ 1px solid; -+ border-bottom: @color_general_border@ 1px solid; -+ border-right: @color_general_border@ 1px solid; -+ padding-left: 4px; -+ padding-right: 4px; -+ padding-top: 1px; -+ padding-bottom: 1px; -+ color: @color_general_text@; -+ background: @color_bsmall3@; -+ } -+.bsmall { -+ background: @color_bsmall_back@; -+ } -+.bsmall1 { -+ background: @color_bbig_background@; -+ } -+.bsmall2 { -+ background: @color_bsmall2@; -+ } -+.bsmall3 { -+ background: @color_bsmall3@; -+ } -+.bbig2 { -+ background: @color_bsmall3@; -+ } -+.bbig3 { -+ background: @color_scrollbar_face@; -+ } -+.b1 { -+ border-left: @color_border_of_top_buttons@ solid 1px; -+ border-top: @color_border_of_top_buttons@ solid 1px; -+ border-right: @color_border_of_top_buttons@ solid 1px; -+ border-bottom: @color_border_of_top_buttons@ solid 1px; -+ } -+.b2 { -+ border-left: @color_border_of_top_buttons@ solid 0px; -+ border-top: @color_border_of_top_buttons@ solid 1px; -+ border-right: @color_border_of_top_buttons@ solid 1px; -+ border-bottom: @color_border_of_top_buttons@ solid 1px; -+ } -+.b3 { -+ border-left: @color_border_of_top_buttons@ solid 1px; -+ border-top: @color_border_of_top_buttons@ solid 0px; -+ border-right: @color_border_of_top_buttons@ solid 1px; -+ border-bottom: @color_border_of_top_buttons@ solid 1px; -+ } -+.b4 { -+ border-left: @color_border_of_top_buttons@ solid 0px; -+ border-top: @color_border_of_top_buttons@ solid 0px; -+ border-right: @color_border_of_top_buttons@ solid 1px; -+ border-bottom: @color_border_of_top_buttons@ solid 1px; -+ } -+.bb1 { -+ border-left: @color_general_border@ solid 1px; -+ border-top: @color_scrollbar_highlight@ solid 1px; -+ border-right: @color_scrollbar_highlight@ solid 1px; -+ border-bottom: @color_general_border@ solid 1px; -+ } -+.bb2 { -+ border-left: @color_big_buttons_and_border_highlight@ solid 1px; -+ border-top: @color_scrollbar_highlight@ solid 1px; -+ border-right: @color_scrollbar_highlight@ solid 0px; -+ border-bottom: @color_general_border@ solid 1px; -+ } -+.bb3 { -+ border-left: @color_big_buttons_and_border_highlight@ solid 1px; -+ border-top: @color_scrollbar_highlight@ solid 1px; -+ border-right: @color_general_border@ solid 0px; -+ border-bottom: @color_general_border@ solid 0px; -+ } -+.bb4 { -+ border-left: @color_big_buttons_and_border_highlight@ solid 1px; -+ border-top: @color_scrollbar_highlight@ solid 1px; -+ border-right: @color_general_border@ solid 1px; -+ border-bottom: @color_general_border@ solid 0px; -+ } -+.src { -+ border-left: @color_general_border@ solid 0px; -+ border-top: @color_general_border@ solid 0px; -+ border-right: @color_general_border@ solid 1px; -+ border-bottom: @color_general_border@ solid 1px; -+ } -+.srctd { -+ font-family: Verdana; -+ font-size: 8px; -+ } -+td.fbig { -+ color: @color_general_text@; -+ cursor: pointer; -+ padding-left: 2px; -+ padding-right: 2px; -+ font-family: Verdana; -+ font-size: 10px; -+ background: @color_fbig_background@; -+ border-top: @color_general_border@ solid 1px; -+ border-left: @color_general_border@ solid 1px; -+ } -+td.pr { -+ border-right: @color_general_border@ solid 1px; -+ } -+td.fbigb { -+ border-top: @color_general_border@ solid 0px; -+ border-bottom: @color_general_border@ solid 1px; -+ } -+td.fbigpad { -+ padding-top: 2px; -+ padding-bottom: 2px; -+ } -+td, tr { -+ font-size: 12px; -+ font-family: verdana; -+ } -+td.sr { -+ white-space: nowrap; -+ padding-top: 2px; -+ padding-bottom: 2px; -+ padding-left: 4px; -+ padding-right: 4px; -+ font-family: verdana; -+ font-size: 10px; -+ color: @color_general_text@; -+ } -+td.srp { -+ white-space: nowrap; -+ padding-top: 2px; -+ padding-bottom: 2px; -+ padding-left: 0px; -+ padding-right: 4px; -+ font-family: verdana; -+ font-size: 10px; -+ color: @color_one_td_text@; -+ } -+td.srw { -+ padding-top: 2px; -+ padding-bottom: 2px; -+ padding-left: 4px; -+ padding-right: 4px; -+ font-family: verdana; -+ font-size: 10px; -+ color: @color_general_text@; -+ } -+td.srh { -+ cursor: pointer; -+ vertical-align: top; -+ background: @color_table_header_background@; -+ white-space: nowrap; -+ padding-top: 2px; -+ padding-bottom: 2px; -+ padding-left: 4px; -+ padding-right: 4px; -+ font-family: verdana; -+ font-size: 10px; -+ color: @color_general_text@; -+ } -+td.total { -+ border-top: @color_general_border@ solid 1px; -+ border-bottom: @color_general_border@ solid 1px; -+ } -+tr.dl-1, td.dl-1 { -+ background: @color_dl1_back@; -+ } -+tr.dl-2, td.dl-2 { -+ background: @color_dl2_back@; -+ } -+.mOvr1, tr.mOvr1 { -+ background: @color_mOver1_back@; -+ cursor: pointer; -+ } -+.mOvr2, tr.mOvr2 { -+ background: @color_mOver2_back@; -+ cursor: pointer; -+ } -+.mOvr3, tr.mOvr3 { -+ background: @color_mOver3_back@; -+ cursor: pointer; -+ } - table.uploaders, table.friends, table.bw_stats, table.vo, table.cs, table.servers, - table.shares, table.downloaders, table.scan_temp, table.upstats, table.messages, - table.shares, table.vc, table.results, table.networkInfo, table.memstats { -- margin-right: auto; -- margin-left: auto; -- border: 1; -- border: @color_general_border@ solid 1px; -- border-collapse: collapse; } --table.sourcesInfo, table.serversC { width: 100%; margin-right: auto; margin-left: auto; border: 1; border: @color_general_border@ solid 1px; border-collapse: collapse; } --table.sources {border: 1; border: @color_general_border@ solid 1px; border-collapse: collapse; } --table.main { margin-right: auto; margin-left: auto; } -+ margin-right: auto; -+ margin-left: auto; -+ border: @color_general_border@ solid 1px; -+ border-collapse: collapse; -+ } -+table.sourcesInfo, table.serversC { -+ width: 100%; -+ margin-right: auto; -+ margin-left: auto; -+ border: @color_general_border@ solid 1px; -+ border-collapse: collapse; -+ } -+table.sources { -+ border: @color_general_border@ solid 1px; -+ border-collapse: collapse; -+ } -+table.main { -+ margin-right: auto; -+ margin-left: auto; -+ } - div.main, div.uploaders, div.friends, div.cs, div.shares, div.upstats, div.servers, div.serversC, div.vo, --div.downloaders, div.messages, div.vc, div.bw_stats, div.scan_temp, div.results, div.memstats { text-align: center; } --td.srb { padding-top: 1px; padding-bottom: 1px; font-size: 10px; font-family: Verdana; white-space: nowrap; border-right: @color_general_border@ solid 1px; border-bottom: @color_general_border@ solid 1px; --border-left: @color_general_border@ solid 1px; border-top: @color_general_border@ solid 0px; padding-left: 3px; padding-right: 3px; } --td.act { font-size: 10px; font-weight: 700; } --td.br {border-right: @color_general_border@ dotted 1px;} --td.ar {text-align: right;} --td.al {text-align: left;} --td.ac {text-align: center;} --td.chunk0 { height:12px; background: @color_chunk0@} --td.chunk1 { height:12px; background: @color_chunk1@} --td.chunk2 { height:12px; background: @color_chunk2@} --td.chunk3 { height:12px; background: @color_chunk3@} -+div.downloaders, div.messages, div.vc, div.bw_stats, div.scan_temp, div.results, div.memstats { -+ text-align: center; -+ } -+td.srb { -+ padding-top: 1px; -+ padding-bottom: 1px; -+ font-size: 10px; -+ font-family: Verdana; -+ white-space: nowrap; -+ border-right: @color_general_border@ solid 1px; -+ border-bottom: @color_general_border@ solid 1px; -+ border-left: @color_general_border@ solid 1px; -+ border-top: @color_general_border@ solid 0px; -+ padding-left: 3px; -+ padding-right: 3px; -+ } -+td.act { -+ font-size: 10px; -+ font-weight: 700; -+ } -+td.br { -+ border-right: @color_general_border@ dotted 1px; -+ } -+td.ar { -+ text-align: right; -+ } -+td.al { -+ text-align: left; -+ } -+td.ac { -+ text-align: center; -+ } -+td.chunk0 { -+ height: 12px; -+ background: @color_chunk0@; -+ } -+td.chunk1 { -+ height: 12px; -+ background: @color_chunk1@; -+ } -+td.chunk2 { -+ height: 12px; -+ background: @color_chunk2@; -+ } -+td.chunk3 { -+ height: 12px; -+ background: @color_chunk3@; -+ } - " - - let html_js_mods0 = define_option message_section ["html_js_mods0"] -@@ -161,23 +412,28 @@ - src.className=mOvrClass; - } - function mSub(target,cmd) { -- if (target != \"\") { -- if (cmd==\"kill\") { -- if (confirm(\"Are you sure?\")) { -- top[target].location.href=\"submit?q=\" + cmd; -- } -- } else { -- if (cmd.substring(0,6)==\"custom\") {top[target].location.href=\"submit?\" + cmd;} -- else {top[target].location.href=\"submit?q=\" + cmd; -- } -+if (target != '') { -+ if (cmd=='kill') { -+ if (confirm('Are you sure?')) { -+ parent.document.getElementsByName(target).item(0).src='submit?q=' + cmd; -+ } -+ } -+ else { -+ if (cmd.substring(0,6)=='custom') { -+ parent.document.getElementsByName(target).item(0).src='submit?' + cmd; -+ } -+ else { -+ parent.document.getElementsByName(target).item(0).src='submit?q=' + cmd; -+ } - } -- } else { -- location.href=\"submit?q=\" + cmd; -- } -+} -+else { -+ parent.document.getElementsByName(target).item(0).src='submit?q=' + cmd; -+} - } - function showTab(t){ -- for (i=1; i<=6; i++) document.getElementById(\"tab\" + i).style.display = \"none\"; -- document.getElementById(\"tab\" + t).style.display = \"block\"; -+ for (i=1; i<=6; i++) document.getElementById('tab' + i).style.display = 'none'; -+ document.getElementById(\"tab\" + t).style.display = 'block'; - } - var _tabLast=null; - function _rObj (s,ar) { -@@ -415,41 +671,168 @@ - "Download CSS - style 0" - string_option - " --body{ background-color:@color_vd_page_background@;color: @color_general_text@; font-family: Verdana, Arial, Helvetica, sans-serif;font-size: 13px; margin-top: 10px; margin: 2;} --td,pre { color: @color_general_text@; font-family: Verdana, Arial, Helvetica, sans-serif; font-size: 10px; } --table.downloaders { margin-right: auto; margin-left: auto; border: 1; border: @color_general_border@ solid 1px; } --div.main { text-align: center; } --table.main { margin-right: auto; margin-left: auto; } --td.loaded{ padding-top: 0px; padding-bottom: 0px; background-color:@color_vd_downloaded@; font-size:1px; line-height: 2px; } --td.remain{ padding-top: 0px; padding-bottom: 0px; background-color:@color_vd_remaining@; font-size:1px; line-height: 2px; } --td.downloaded{ font-family: Verdana; font-weight: 500; font-size: 12px; color: @color_general_text@; } --td.dl { white-space: nowrap; padding-top: 2px; padding-bottom: 2px; padding-left: 5px; padding-right: 5px; font-family: verdana; font-size: 10px; color: @color_general_text@; } --td.dlheader { cursor: pointer; color: @color_general_text@; font-family: Verdana, serif; font-size: 10px; --border-bottom: solid 1px; background: @color_table_header_background@; padding-left: 3px; --padding-right: 3px; } --input.checkbox { background: @color_table_header_background@; vertical-align: middle; height: 10px; width: 10px; } --td.sr { white-space: nowrap; padding-top: 2px; padding-bottom: 2px; padding-left: 5px; padding-right: 5px; font-family: verdana; font-size: 10px; color: @color_general_text@; } --table { cellspacing: 0; cellpadding: 0; } --td.ar { text-align: right; } --td.al { text-align: left; } --td.ac { text-align: center; } --td.brs { border-right: @color_general_border@ solid 1px; padding-left: 2px; padding-right: 2px; text-align: center; } --td.np { padding-left: 2px; padding-right: 0px; text-align: center; } --td.big { border-top: @color_general_border@ solid 1px; border-left: @color_general_border@ solid 1px; } --td.pr { border-right: @color_general_border@ solid 1px; } --.bigbutton { color: @color_general_text@; font-family: Verdana, serif; font-size: 10px; background: @color_background@; border: @color_background@ solid 1px; cursor: pointer; } -+body { -+ background-color: @color_vd_page_background@; -+ color: @color_general_text@; -+ font-family: Verdana, Arial, Helvetica, sans-serif; -+ font-size: 13px; -+ margin-top: 10px; -+ margin: 2; -+ } -+td, pre { -+ color: @color_general_text@; -+ font-family: Verdana, Arial, Helvetica, sans-serif; -+ font-size: 10px; -+ } -+table.downloaders { -+ margin-right: auto; -+ margin-left: auto; -+ border: @color_general_border@ solid 1px; -+ } -+div.main { -+ text-align: center; -+ } -+table.main { -+ margin-right: auto; -+ margin-left: auto; -+ } -+td.loaded { -+ padding-top: 0px; -+ padding-bottom: 0px; -+ background-color: @color_vd_downloaded@; -+ font-size: 1px; -+ line-height: 2px; -+ } -+td.remain { -+ padding-top: 0px; -+ padding-bottom: 0px; -+ background-color: @color_vd_remaining@; -+ font-size: 1px; -+ line-height: 2px; -+ } -+td.downloaded { -+ font-family: Verdana; -+ font-weight: 500; -+ font-size: 12px; -+ color: @color_general_text@; -+ } -+td.dl { -+ white-space: nowrap; -+ padding-top: 2px; -+ padding-bottom: 2px; -+ padding-left: 5px; -+ padding-right: 5px; -+ font-family: verdana; -+ font-size: 10px; -+ color: @color_general_text@; -+ } -+td.dlheader { -+ cursor: pointer; -+ color: @color_general_text@; -+ font-family: Verdana, serif; -+ font-size: 10px; -+ border-bottom: solid 1px; -+ background: @color_table_header_background@; -+ padding-left: 3px; -+ padding-right: 3px; -+ } -+input.checkbox { -+ background: @color_table_header_background@; -+ vertical-align: middle; -+ height: 10px; -+ width: 10px; -+ } -+td.sr { -+ white-space: nowrap; -+ padding-top: 2px; -+ padding-bottom: 2px; -+ padding-left: 5px; -+ padding-right: 5px; -+ font-family: verdana; -+ font-size: 10px; -+ color: @color_general_text@; -+ } -+table { -+ border-spacing: 0px; -+ } -+td { -+ padding: 0px; -+ } -+td.ar { -+ text-align: right; -+ } -+td.al { -+ text-align: left; -+ } -+td.ac { -+ text-align: center; -+ } -+td.brs { -+ border-right: @color_general_border@ solid 1px; -+ padding-left: 2px; -+ padding-right: 2px; -+ text-align: center; -+ } -+td.np { -+ padding-left: 2px; -+ padding-right: 0px; -+ text-align: center; -+ } -+td.big { -+ border-top: @color_general_border@ solid 1px; -+ border-left: @color_general_border@ solid 1px; -+ } -+td.pr { -+ border-right: @color_general_border@ solid 1px; -+ } -+.bigbutton { -+ color: @color_general_text@; -+ font-family: Verdana, serif; -+ font-size: 10px; -+ background: @color_background@; -+ border: @color_background@ solid 1px; -+ cursor: pointer; -+ } - .headbutton { -- font-family: Verdana, serif; font-size: 10px; border: @color_table_header_background@ solid 1px; background: @color_table_header_background@; -- padding-left: 5px; padding-right: 5px; cursor: pointer; } --tr.dl-1 { background: @color_dl1_back@; } --tr.dl-2 { background: @color_dl2_back@; } --tr.mOvrDL, .mOvrDL { background: @color_mOver1_back@; cursor: pointer; } --input { font-family: tahoma; font-size: 10px; } --a{ text-decoration: none; font-weight: bold;} --a:link,a:active,a:visited { color: @color_download_anchor@; } --a:hover { color: @color_download_anchor_hover@; text-decoration: underline; } --a.extern:visited,a.extern:hover,a.extern:active { color: @color_external_anchor@; } --.extern:hover { color: @color_external_anchor_hover@; } -+ font-family: Verdana, serif; -+ font-size: 10px; -+ border: @color_table_header_background@ solid 1px; -+ background: @color_table_header_background@; -+ padding-left: 5px; -+ padding-right: 5px; -+ cursor: pointer; -+ } -+tr.dl-1 { -+ background: @color_dl1_back@; -+ } -+tr.dl-2 { -+ background: @color_dl2_back@; -+ } -+tr.mOvrDL, .mOvrDL { -+ background: @color_mOver1_back@; -+ cursor: pointer; -+ } -+input { -+ font-family: tahoma; -+ font-size: 10px; -+ } -+a { -+ text-decoration: none; -+ font-weight: bold; -+ } -+a:link,a:active,a:visited { -+ color: @color_download_anchor@; -+ } -+a:hover { -+ color: @color_download_anchor_hover@; -+ text-decoration: underline; -+ } -+a.extern:visited,a.extern:hover,a.extern:active { -+ color: @color_external_anchor@; -+ } -+.extern:hover { -+ color: @color_external_anchor_hover@; -+ } - " - - let download_html_js_mods0 = define_option message_section ["download_html_js_mods0"] -@@ -598,6 +981,9 @@ - <TD class=\"bu bbig\" title=\"Bandwidth statistics (set html_mods_bw_refresh_delay)\" - onMouseOver=\"mOvr(this,'mOvr1');\" onMouseOut=\"mOut(this);\" - onClick=\"mSub('fstatus','bw_stats');mSub('output','gdstats')\">Bandwidth stats</TD> -+<TD class=\"bu bbig\" title=\"Bandwidth toggle\" -+onMouseOver=\"mOvr(this,'mOvr1');\" onMouseOut=\"mOut(this);\" -+onClick=\"mSub('fstatus','bw_stats');mSub('output','bw_toggle')\">Bandwidth toggle</TD> - </TR></TBODY></TABLE></DIV> - - <DIV ID=\"tab2\" style=\"display: none\"> -@@ -693,6 +1079,9 @@ - <TD class=\"bu bbig\" title=\"Settings\" - onMouseOver=\"mOvr(this,'mOvr1');\" onMouseOut=\"mOut(this);\" - onClick=\"mSub('fstatus','version');mSub('output','voo+1')\">Settings</TD> -+<TD class=\"bu bbig\" title=\"Users\" -+onMouseOver=\"mOvr(this,'mOvr1');\" onMouseOut=\"mOut(this);\" -+onclick=\"mSub('fstatus','version');mSub('output','users')\">Users</TD> - <TD class=\"bu bbig\" title=\"View/edit shared directories\" - onMouseOver=\"mOvr(this,'mOvr1');\" onMouseOut=\"mOut(this);\" - onClick=\"mSub('fstatus','version');mSub('output','shares')\">Shares</TD> -@@ -827,7 +1216,7 @@ - " - <table width=\"100%\" border=\"0\"> - <tr> --<td align=\"left\" valign=\"middle\" width=\"*\"><a href=\"http://www.mldonkey.net/\" $O><b>MLDonkey Home</b></a></td> -+<td align=\"left\" valign=\"middle\" width=\"*\"><a href=\"http://www.mldonkey.org/\" $O><b>MLDonkey Home</b></a></td> - <form action=\"submit\" $O name=\"cmdFormular\" onSubmit=\"return CheckInput();\"> - <td><input type=\"text\" name=\"q\" size=60 value=\"\"></td> - <td><input type=\"submit\" value=\"Execute\"></td> -@@ -861,7 +1250,7 @@ - <td><a href=\"submit?q=commit\" onMouseOver=\"window.status='Move finished downloads to incoming directory';return true;\" onMouseOut=\"window.status='';return true;\" onFocus=\"this.blur();\" $S>Commit</a></td> - <td><a href=\"submit?q=vr\" onMouseOver=\"window.status='View results to your queries';return true;\" onMouseOut=\"window.status='';return true;\" onFocus=\"this.blur();\" $O>Search results</a></td> - <td><a href=\"submit?q=ovweb\" onMouseOver=\"window.status='Boot Overnet peers from http list';return true;\" onMouseOut=\"window.status='';return true;\" onFocus=\"this.blur();\" $S>Load Overnet peers</a></td> --<td><a class=\"extern\" href=\"http://www.mldonkeyworld.com/\" onMouseOver=\"window.status='MLDonkey World';return true;\" onMouseOut=\"window.status='';return true;\" onFocus=\"this.blur();\" $O>English forum</a></td> -+<td><a class=\"extern\" href=\"http://mldonkey.sf.net/forums/\" onMouseOver=\"window.status='MLDonkey World';return true;\" onMouseOut=\"window.status='';return true;\" onFocus=\"this.blur();\" $O>English forum</a></td> - <td><a class=\"extern\" href=\"http://www.mldonkey.org/\" onMouseOver=\"window.status='German Forum';return true;\" onMouseOut=\"window.status='';return true;\" onFocus=\"this.blur();\" $O>German forum</a></td> - <td><a href=\"submit?q=kill\" onMouseOver=\"window.status='Save and quit MLDonkey';return true;\" onMouseOut=\"window.status='';return true;\" onFocus=\"this.blur();\" $O>Kill MLDonkey</a></td> - </tr> -@@ -1051,8 +1440,8 @@ - color_vd_remaining = "#000"; - color_general_text = "#000"; - color_general_border = "#000"; -- color_anchor = "#000"; -- color_anchor_hover = "#000"; -+ color_anchor = "#0000ff"; -+ color_anchor_hover = "#0000ff"; - color_download_anchor = "#000"; - color_download_anchor_hover = "#000"; - color_external_anchor = "#000"; -@@ -1094,8 +1483,8 @@ - color_vd_remaining = "#EEE"; - color_general_text = "#000"; - color_general_border = "#000"; -- color_anchor = "#000"; -- color_anchor_hover = "#000"; -+ color_anchor = "#0000ff"; -+ color_anchor_hover = "#0000ff"; - color_download_anchor = "#000"; - color_download_anchor_hover = "#000"; - color_external_anchor = "#000"; -@@ -1134,8 +1523,8 @@ - color_vd_remaining = "#EEE"; - color_general_text = "#000"; - color_general_border = "#000"; -- color_anchor = "#000"; -- color_anchor_hover = "#000"; -+ color_anchor = "#0000ff"; -+ color_anchor_hover = "#0000ff"; - color_download_anchor = "#000"; - color_download_anchor_hover = "#000"; - color_external_anchor = "#000"; -@@ -1174,8 +1563,8 @@ - color_vd_remaining = "#EEE"; - color_general_text = "#000"; - color_general_border = "#000"; -- color_anchor = "#000"; -- color_anchor_hover = "#000"; -+ color_anchor = "#0000ff"; -+ color_anchor_hover = "#0000ff"; - color_download_anchor = "#000"; - color_download_anchor_hover = "#000"; - color_external_anchor = "#000"; -@@ -1214,8 +1603,8 @@ - color_vd_remaining = "#EEE"; - color_general_text = "#000"; - color_general_border = "#000"; -- color_anchor = "#000"; -- color_anchor_hover = "#000"; -+ color_anchor = "#0000ff"; -+ color_anchor_hover = "#0000ff"; - color_download_anchor = "#000"; - color_download_anchor_hover = "#000"; - color_external_anchor = "#000"; -@@ -1254,8 +1643,8 @@ - color_vd_remaining = "#EEE"; - color_general_text = "#000"; - color_general_border = "#000"; -- color_anchor = "#000"; -- color_anchor_hover = "#000"; -+ color_anchor = "#0000ff"; -+ color_anchor_hover = "#0000ff"; - color_download_anchor = "#000"; - color_download_anchor_hover = "#000"; - color_external_anchor = "#000"; -@@ -1294,8 +1683,8 @@ - color_vd_remaining = "#EEE"; - color_general_text = "#000"; - color_general_border = "#000"; -- color_anchor = "#000"; -- color_anchor_hover = "#000"; -+ color_anchor = "#0000ff"; -+ color_anchor_hover = "#0000ff"; - color_download_anchor = "#000"; - color_download_anchor_hover = "#000"; - color_external_anchor = "#000"; -@@ -1334,8 +1723,8 @@ - color_vd_remaining = "#EEE"; - color_general_text = "#D4C9B7"; - color_general_border = "#000"; -- color_anchor = "#000"; -- color_anchor_hover = "#000"; -+ color_anchor = "#0000ff"; -+ color_anchor_hover = "#0000ff"; - color_download_anchor = "#000"; - color_download_anchor_hover = "#000"; - color_external_anchor = "#000"; -@@ -1374,8 +1763,8 @@ - color_vd_remaining = "#EEE"; - color_general_text = "#D4C9B7"; - color_general_border = "#000"; -- color_anchor = "#000"; -- color_anchor_hover = "#000"; -+ color_anchor = "#0000ff"; -+ color_anchor_hover = "#0000ff"; - color_download_anchor = "#000"; - color_download_anchor_hover = "#000"; - color_external_anchor = "#000"; -Index: src/daemon/common/commonNetwork.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonNetwork.ml,v -retrieving revision 1.29 -retrieving revision 1.32 -diff -u -r1.29 -r1.32 ---- src/daemon/common/commonNetwork.ml 5 Sep 2006 14:15:19 -0000 1.29 -+++ src/daemon/common/commonNetwork.ml 1 Oct 2006 17:53:59 -0000 1.32 -@@ -99,6 +99,8 @@ - lprintf_nl "op_network_clean_servers"; - if c.op_network_display_stats == cc.op_network_display_stats then - lprintf_nl "op_network_display_stats"; -+ if c.op_network_stat_info_list == cc.op_network_stat_info_list then -+ lprintf_nl "op_network_stat_info_list"; - if c.op_network_info == cc.op_network_info then - lprintf_nl "op_network_info"; - if c.op_network_clean_exit == cc.op_network_clean_exit then -@@ -107,6 +109,10 @@ - lprintf_nl "op_network_reset"; - if c.op_network_ports == cc.op_network_ports then - lprintf_nl "op_network_ports"; -+ if c.op_network_porttest_start == cc.op_network_porttest_start then -+ lprintf_nl "op_network_porttest_start"; -+ if c.op_network_porttest_result == cc.op_network_porttest_result then -+ lprintf_nl "op_network_porttest_result"; - ) !networks_ops; - lprint_newline () - -@@ -127,6 +133,8 @@ - let network_clean_exit n = try n.op_network_clean_exit () with _ -> true - let network_reset n = try n.op_network_reset () with _ -> () - let network_ports n = n.op_network_ports () -+let network_porttest_start n = n.op_network_porttest_start () -+let network_porttest_result n = n.op_network_porttest_result () - - let networks_iter f = - List.iter (fun r -> -@@ -257,7 +265,7 @@ - op_network_update_options = (fun _ -> ni_ok name "update_options"); - op_network_disable = (fun _ -> ni_ok name "disable"); - op_network_server_of_option = (fun _ -> fni name "op_network_server_of_option"); -- op_network_file_of_option = (fun _ _ -> fni name "op_network_file_of_option"); -+ op_network_file_of_option = (fun _ _ _ -> fni name "op_network_file_of_option"); - op_network_client_of_option = (fun _ -> fni name "op_network_client_of_option"); - op_network_recover_temp = (fun _ -> ni_ok name "recover_temp"); - op_network_search = (fun _ _ -> ni_ok name "search"); -@@ -268,16 +276,19 @@ - op_network_close_search = (fun _ -> ni_ok name "close_search"); - op_network_extend_search = (fun _ _ -> ni_ok name "extend search"); - op_network_clean_servers = (fun _ -> ni_ok name "clean servers"); -- op_network_parse_url = (fun _ -> ni_ok name "parse_url"; "", false); -+ op_network_parse_url = (fun _ _ -> ni_ok name "parse_url"; "", false); - op_network_info = (fun _ -> fni name "network_info"); - op_network_connected = (fun _ -> ni_ok name "connected"; false); - op_network_add_server = (fun _ -> fni name "op_network_add_server"); -- op_network_gui_message = (fun _ -> ni_ok name "gui_message"); -- op_network_download = (fun _ -> fni name "network_download"); -+ op_network_gui_message = (fun _ _ -> ni_ok name "gui_message"); -+ op_network_download = (fun _ _ -> fni name "network_download"); - op_network_display_stats = (fun _ _ -> ni_ok name "display_stats"); -+ op_network_stat_info_list = (fun _ -> []); - op_network_clean_exit = (fun _ -> true); - op_network_reset = (fun _ -> ni_ok name "reset"); - op_network_ports = (fun _ -> ni_ok name "ports"; []); -+ op_network_porttest_start = (fun _ -> ni_ok name "porttest_start"); -+ op_network_porttest_result = (fun _ -> fni name "porttest_result"); - } - in - let rr = (Obj.magic r: network) in -Index: src/daemon/common/commonNetwork.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonNetwork.mli,v -retrieving revision 1.15 -retrieving revision 1.18 -diff -u -r1.15 -r1.18 ---- src/daemon/common/commonNetwork.mli 5 Sep 2006 14:15:19 -0000 1.15 -+++ src/daemon/common/commonNetwork.mli 9 Nov 2006 21:32:26 -0000 1.18 -@@ -48,6 +48,8 @@ - val register_commands : (string * string * CommonTypes.arg_kind * string) list -> unit - val network_connect_servers : CommonTypes.network -> unit - val network_ports : CommonTypes.network -> (int * string) list -+val network_porttest_start : CommonTypes.network -> unit -+val network_porttest_result : CommonTypes.network -> CommonTypes.network_porttest - val network_forget_search : CommonTypes.network -> CommonTypes.search -> unit - val network_close_search : CommonTypes.network -> CommonTypes.search -> unit - val network_private_message : CommonTypes.network -> string -> string -> unit -@@ -56,6 +58,6 @@ - CommonTypes.search -> CommonTypes.extend_search -> unit - val network_connected : CommonTypes.network -> bool - val network_clean_servers : CommonTypes.network -> unit --val network_parse_url : CommonTypes.network -> string -> string * bool -+val network_parse_url : CommonTypes.network -> string -> CommonTypes.userdb -> string * bool - val network_info : CommonTypes.network -> CommonTypes.network_info - val commands_by_kind : (string, (string * string) list ref) Hashtbl.t -Index: src/daemon/common/commonOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonOptions.ml,v -retrieving revision 1.176 -retrieving revision 1.189 -diff -u -r1.176 -r1.189 ---- src/daemon/common/commonOptions.ml 16 Sep 2006 15:36:59 -0000 1.176 -+++ src/daemon/common/commonOptions.ml 21 Nov 2006 22:34:33 -0000 1.189 -@@ -145,7 +145,8 @@ - end; - - lprintf_nl "MLDonkey is working in %s" file_basedir; -- if not (Sys.file_exists file_basedir) then begin -+ if not (Sys.file_exists file_basedir) || -+ not (Sys.file_exists (Filename.concat file_basedir "downloads.ini")) then begin - lprint_newline (); - lprintf_nl "creating new MLDonkey base directory in %s\n" file_basedir; - created_new_base_directory := Some file_basedir -@@ -199,6 +200,11 @@ - exit 2 - end; - -+ (* Charset conversion self-test *) -+ let filename = "abcdefghijklmnopqrstuvwxyz" in -+ let conv_filename = Charset.to_locale filename in -+ if filename <> conv_filename then Charset.conversion_enabled := false; -+ - Unix2.can_write_to_directory (Filename2.temp_directory ()); - - if (String2.starts_with (Filename.basename Sys.argv.(0)) "mlnet") then begin -@@ -333,9 +339,7 @@ - - Options.set_string_wrappers ip_range_list_option - (fun list -> -- List.fold_left (fun s ip -> -- Printf.sprintf "%s %s" (Ip.string_of_range ip) s -- ) "" list -+ String.concat " " (List.map Ip.string_of_range (List.rev list)) - ) - (fun s -> - let list = String2.tokens s in -@@ -357,6 +361,7 @@ - String2.tokens - - let is_not_spam = ref (fun _ -> true) -+let is_not_comment_spam = ref (fun _ -> true) - - - -@@ -578,6 +583,14 @@ - < 4 -> download limited to upload * 3" - int_option 50 - -+let max_hard_upload_rate_2 = define_option current_section ["max_hard_upload_rate_2"] -+ "Second maximal upload rate for easy toggling (use bw_toggle)" -+ int_option 5 -+ -+let max_hard_download_rate_2 = define_option current_section ["max_hard_download_rate_2"] -+ "Second maximal download rate for easy toggling (use bw_toggle)" -+ int_option 20 -+ - let max_opened_connections = define_option current_section ["max_opened_connections"] - "Maximal number of opened connections" - int_option 200 -@@ -590,6 +603,10 @@ - "How many slots can be used for upload" - int_option 5 - -+let max_release_slots = define_option current_section ["max_release_slots"] -+ "How many percent of upload slots can be used for downloading files tagged as release" -+ percent_option 20 -+ - let friends_upload_slot = define_option current_section ["friends_upload_slot"] - "Set aside a single reserved slot to upload to friends" - bool_option true -@@ -725,6 +742,14 @@ - "Whether to display the Comments column in vd output" - bool_option true - -+let html_mods_vd_user = define_expert_option current_section ["html_mods_vd_user"] -+ "Whether to display the User column in vd output" -+ bool_option false -+ -+let html_mods_vd_group = define_expert_option current_section ["html_mods_vd_group"] -+ "Whether to display the Group column in vd output" -+ bool_option false -+ - let html_mods_vd_active_sources = define_expert_option current_section ["html_mods_vd_active_sources"] - "Whether to display the Active Sources column in vd output" - bool_option true -@@ -774,13 +799,25 @@ - bool_option true - - let html_mods_vd_gfx_x_size = define_expert_option current_section ["html_mods_vd_gfx_x_size"] -- "Graph x size in vd output ( 320 < x < 3600 )" -- int_option 630 -+ "Graph x size in vd output ( 365 < x < 3665 )" -+ int_option 795 - - let html_mods_vd_gfx_y_size = define_expert_option current_section ["html_mods_vd_gfx_y_size"] - "Graph y size in vd output ( 200 < y < 1200 )" - int_option 200 - -+let html_mods_vd_gfx_h_dynamic = define_expert_option current_section ["html_mods_vd_gfx_h_dymamic"] -+ "Dynamic grid width, start with 1 h/grid, maximum html_mods_vd_gfx_h_grid_time h/grid" -+ bool_option true -+ -+let html_mods_vd_gfx_h_grid_time = define_expert_option current_section ["html_mods_vd_gfx_h_grid_time"] -+ "Max hours on time scale per grid (0 = no limit)" -+ int_option 0 -+ -+let html_mods_vd_gfx_subgrid = define_expert_option current_section ["html_mods_vd_gfx_subgrid"] -+ "Number of shown subgrids on graph (0 = no subgrids)" -+ int_option 0 -+ - let html_mods_vd_gfx_tag = define_expert_option current_section ["html_mods_vd_gfx_tag"] - "Draw tag graph" - bool_option false -@@ -986,6 +1023,10 @@ - "URLs of RSS feeds" - (list_option Url.option) [] - -+let rss_preprocessor = define_expert_option current_section ["rss_preprocessor"] -+ "If MLDonkey can not read broken RSS feeds, use this program to preprocess them" -+ string_option "xmllint" -+ - let ip_blocking_descriptions = define_expert_option current_section ["ip_blocking_descriptions"] - "Keep IP blocking ranges descriptions in memory" - bool_option false -@@ -1288,10 +1329,6 @@ - ones in allowed_commands" - bool_option false - --let enable_user_config = define_option current_section ["enable_user_config"] -- "Are all users allowed to change MLDonkey options?" -- bool_option true -- - let allow_browse_share = define_option current_section ["allow_browse_share"] - "Allow others to browse our share list (0: none, 1: friends only, 2: everyone" - allow_browse_share_option 1 -@@ -1300,6 +1337,10 @@ - "Regexp of messages to filter out, example: string1|string2|string3" - string_option "Your client is connecting too fast" - -+let comments_filter = define_option current_section ["comments_filter"] -+ "Regexp of comments to filter out, example: string1|string2|string3" -+ string_option "http://|https://|www\\." -+ - - - -@@ -1417,10 +1458,6 @@ - "The realm shown when connecting with a WEB browser" - string_option "MLdonkey" - --let use_html_frames = define_expert_option current_section ["use_html_frames"] -- "This option controls whether the WEB interface should use frames or not" -- bool_option true -- - let html_frame_border = define_expert_option current_section ["html_frame_border"] - "This option controls whether the WEB interface should show frame borders or not" - bool_option true -@@ -1516,7 +1553,7 @@ - - let compaction_overhead = define_expert_option current_section ["compaction_overhead"] - "The percentage of free memory before a compaction is triggered" -- int_option 25 -+ percent_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 -@@ -1524,7 +1561,7 @@ - unreachable blocks. It is expressed as a percentage of the memory used - for live data. The GC will work more (use more CPU time and collect - blocks more eagerly) if space_overhead is smaller." -- int_option 80 -+ percent_option 80 - - let max_displayed_results = define_expert_option current_section ["max_displayed_results"] - "Maximal number of results displayed for a search" -@@ -1535,6 +1572,13 @@ - int_option 14 - - -+let max_comments_per_file = define_expert_option current_section ["max_comments_per_file"] -+ "Maximum number of comments per file" -+ int_option 100 -+ -+let max_comment_length = define_expert_option current_section ["max_comment_length"] -+ "Maximum length of file comments" -+ int_option 256 - - - (*************************************************************************) -@@ -1748,7 +1792,7 @@ - (!!minor_heap_size * 1024) }; - ); - option_hook client_buffer_size (fun _ -> -- TcpBufferedSocket.max_buffer_size := maxi 10000000 !!client_buffer_size -+ TcpBufferedSocket.max_buffer_size := max 10000000 !!client_buffer_size - ); - if Autoconf.has_gd then - option_hook html_mods_vd_gfx_png (fun _ -> -@@ -1908,14 +1952,25 @@ - in aux 0 - - let _ = -- option_hook messages_filter (fun _ -> -- is_not_spam := if !!messages_filter <> "" then -- let r = Str.regexp_case_fold (quote_unquote_bars !!messages_filter) in -- (fun s -> try -+ let regex_fun str = -+ if str <> "" then -+ let r = Str.regexp_case_fold (quote_unquote_bars str) in -+ (fun s -> -+ try - ignore (Str.search_forward r s 0); - false -- with Not_found -> true) -- else (fun _ -> true)) -+ with Not_found -> true -+ ) -+ else (fun _ -> true) -+ in -+ -+ option_hook messages_filter (fun _ -> -+ is_not_spam := regex_fun !!messages_filter -+ ); -+ -+ option_hook comments_filter (fun _ -> -+ is_not_comment_spam := regex_fun !!comments_filter -+ ) - - let http_proxy = ref None - -Index: src/daemon/common/commonResult.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonResult.ml,v -retrieving revision 1.9 -retrieving revision 1.10 -diff -u -r1.9 -r1.10 ---- src/daemon/common/commonResult.ml 17 May 2006 08:52:43 -0000 1.9 -+++ src/daemon/common/commonResult.ml 19 Sep 2006 17:07:42 -0000 1.10 -@@ -142,13 +142,13 @@ - result_source_network = 0; - } - --let result_download rs names force = -+let result_download rs names force user = - let r = IndexedResults.get_result rs in - let files = ref [] in - CommonNetwork.networks_iter (fun n -> - (* Temporarily download results only from the network that returned the result *) - if (n.network_num = r.result_source_network) then -- files := (n.op_network_download r) :: !files -+ files := (n.op_network_download r user) :: !files - ); - !files - -Index: src/daemon/common/commonResult.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonResult.mli,v -retrieving revision 1.5 -retrieving revision 1.7 -diff -u -r1.5 -r1.7 ---- src/daemon/common/commonResult.mli 12 May 2006 21:02:38 -0000 1.5 -+++ src/daemon/common/commonResult.mli 9 Nov 2006 21:32:26 -0000 1.7 -@@ -78,7 +78,7 @@ - val find_result : int -> StoredResult.stored_result - val dummy_result : CommonTypes.result_info - val result_download : -- StoredResult.stored_result -> 'a -> 'b -> CommonTypes.file list -+ StoredResult.stored_result -> 'a -> 'b -> CommonTypes.userdb -> CommonTypes.file list - val results_iter : (int -> StoredResult.stored_result -> unit) -> unit - val update_result : StoredResult.result -> unit - val update_result2 : -Index: src/daemon/common/commonSearch.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonSearch.ml,v -retrieving revision 1.17 -retrieving revision 1.18 -diff -u -r1.17 -r1.18 ---- src/daemon/common/commonSearch.ml 19 Jan 2006 00:44:47 -0000 1.17 -+++ src/daemon/common/commonSearch.ml 13 Nov 2006 13:14:49 -0000 1.18 -@@ -117,8 +117,12 @@ - | "-network" :: name :: args -> - net := (network_find_by_name name).network_num; - iter args q -- | "-without" :: name :: args -> -+ | "-not" :: name :: args -> - iter args ((QAndNot (QHasWord name, QHasWord name)) :: q) -+ | "-and" :: name :: args -> -+ iter args ((QAnd (QHasWord name, QHasWord name)) :: q) -+ | "-or" :: name :: args -> -+ iter args ((QOr (QHasWord name, QHasWord name)) :: q) - | s :: args -> - if s.[0] = '-' then - let args = -@@ -134,16 +138,19 @@ - iter args ((QHasWord(s)) :: q) - in - let q = iter args [] in -- (match q with -+ (match (List.rev q) with - [] -> failwith "Void query" -- | [QAndNot _] -> failwith "Bad without query" - | q1 :: tail -> - List.fold_left (fun q1 q2 -> - match q2 with -- QAndNot (QHasWord x,_) -> -+ QAndNot (QHasWord x, _) -> - QAndNot (q1, QHasWord x) -+ | QAnd (QHasWord x, _) -> -+ QAnd (q1, QHasWord x) -+ | QOr (QHasWord x, _) -> -+ QOr (q1, QHasWord x) - | _ -> -- QAnd (q1,q2) -+ QAnd (q1,q2) - ) q1 tail), !net - - -Index: src/daemon/common/commonServer.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonServer.ml,v -retrieving revision 1.33 -retrieving revision 1.38 -diff -u -r1.33 -r1.38 ---- src/daemon/common/commonServer.ml 6 Aug 2006 13:59:05 -0000 1.33 -+++ src/daemon/common/commonServer.ml 19 Nov 2006 23:04:25 -0000 1.38 -@@ -53,6 +53,7 @@ - mutable op_server_connect : ('a -> unit); - mutable op_server_disconnect : ('a -> unit); - mutable op_server_users : ('a -> user list); -+ mutable op_server_published : ('a -> file list); - mutable op_server_query_users : ('a -> unit); - mutable op_server_find_user : ('a -> string -> unit); - mutable op_server_cid : ('a -> Ip.t); -@@ -108,12 +109,15 @@ - T.server_users = None; - T.server_banner = ""; - T.server_preferred = false; -+ T.server_master = false; - T.server_version = ""; - T.server_max_users = 0L; - T.server_soft_limit = 0L; - T.server_hard_limit = 0L; - T.server_lowid_users = 0L; - T.server_ping = 0; -+ T.server_published_files = 0; -+ T.server_features = None; - } - - let server_num s = -@@ -183,6 +187,10 @@ - let s = as_server_impl s in - s.impl_server_ops.op_server_users s.impl_server_val - -+let server_published s = -+ let s = as_server_impl s in -+ s.impl_server_ops.op_server_published s.impl_server_val -+ - let server_cid s = - let s = as_server_impl s in - s.impl_server_ops.op_server_cid s.impl_server_val -@@ -212,6 +220,7 @@ - op_server_disconnect = (fun _ -> ni_ok network "server_disconnect"); - op_server_find_user = (fun _ -> fni network "find_user"); - op_server_query_users = (fun _ -> ni_ok network "query_users"); -+ op_server_published = (fun _ -> fni network "published"); - op_server_users = (fun _ -> fni network "users"); - op_server_cid = (fun _ -> fni network "cid"); - op_server_low_id = (fun _ -> fni network "low_id"); -@@ -362,24 +371,30 @@ - info.G.server_banner - - let server_print_html_header buf ext = -+ if !!html_mods_use_js_tooltips then Printf.bprintf buf -+"\\<div id=\\\"object1\\\" style=\\\"position:absolute; background-color:#FFFFDD;color:black;border-color:black;border-width:20px;font-size:8pt; visibility:visible; left:25px; top: -+-100px; z-index:+1\\\" onmouseover=\\\"overdiv=1;\\\" onmouseout=\\\"overdiv=0; setTimeout(\\\'hideLayer()\\\',1000)\\\"\\>\\ \\</div\\>"; -+ - html_mods_table_header buf "serversTable" (Printf.sprintf "servers%s" ext) ([ - ( "1", "srh", "Server number", "#" ) ; - ( "0", "srh", "Connect|Disconnect", "C/D" ) ; - ( "0", "srh", "Remove", "Rem" ) ; - ( "0", "srh", "Preferred", "P" ) ; -+ ( "0", "srh", "Master servers", "M" ) ; - ( "0", "srh", "[Hi]gh or [Lo]w ID", "ID" ) ; - ( "0", "srh", "Network name", "Network" ) ; - ( "0", "srh", "Connection status", "Status" ) ; -- ] @ (if !Geoip.active then [( "0", "srh", "Country Code/Name", "CC" )] else []) @ [ - ( "0", "srh br", "IP address", "IP address" ) ; -+ ] @ (if !Geoip.active then [( "0", "srh br", "Country Code/Name", "CC" )] else []) @ [ - ( "1", "srh ar", "Number of connected users", "Users" ) ; - ( "1", "srh ar br", "Max number of users", "MaxUsers" ) ; - ( "1", "srh ar br", "LowID users", "LowID" ) ; -- ( "1", "srh ar br", "Number of files indexed on server", "Files" ) ; -+ ( "1", "srh ar", "Number of files indexed on server", "Files" ); -+ ( "1", "srh ar br", "Number of published files on server", "Publ" ); - ( "1", "srh ar", "Soft file limit", "Soft" ) ; - ( "1", "srh ar br", "Hard file limit", "Hard" ) ; - ( "0", "srh ar br", "Ping (ms)", "Ping" ) ; -- ( "0", "srh", "Server version", "Version" ) ; -+ ( "0", "srh br", "Server version", "Version" ) ; - ( "0", "srh", "Server name", "Name" ) ; - ( "0", "srh", "Server details", "Details" ) ]) - -@@ -397,80 +412,79 @@ - let buf = o.conn_buf in - - if use_html_mods o then begin -- let snum = (server_num s) in -+ let snum = (server_num s) in -+ let ip_port_string = -+ Printf.sprintf "%s:%s%s" -+ (Ip.string_of_addr info.G.server_addr) -+ (string_of_int info.G.server_port) -+ (if info.G.server_realport <> 0 -+ then "(" ^ (string_of_int info.G.server_realport) ^ ")" -+ else "" -+ ) -+ in -+ -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"" -+ (html_mods_cntr ()); -+ -+ (if !!html_mods_use_js_tooltips then -+ Printf.bprintf buf " onMouseOver=\\\"mOvr(this);setTimeout('popLayer(\\\\\'%s %s<br>%s\\\\\')',%d);setTimeout('hideLayer()',%d);return true;\\\" onMouseOut=\\\"mOut(this);hideLayer();setTimeout('hideLayer()',%d)\\\"\\>" -+ info.G.server_name ip_port_string -+ (match info.G.server_features with -+ | None -> "" -+ | Some f -> "server features: " ^ f) -+ !!html_mods_js_tooltips_wait -+ !!html_mods_js_tooltips_timeout -+ !!html_mods_js_tooltips_wait); - -- Printf.bprintf buf " -- \\<tr class=\\\"dl-%d\\\"\\> -- \\<td class=\\\"srb\\\" %s \\>%d\\</td\\> -- %s -- %s -- %s -- \\<td class=\\\"sr\\\" %s\\</td\\> -- \\<td class=\\\"sr\\\"\\>%s\\</td\\> -- \\<td class=\\\"sr\\\"\\>%s\\</td\\> -- %s -- \\<td class=\\\"sr br\\\"\\>%s:%s\\</td\\> -- \\<td class=\\\"sr ar\\\"\\>%Ld\\</td\\> -- \\<td class=\\\"sr ar br\\\"\\>%Ld\\</td\\> -- \\<td class=\\\"sr ar br\\\"\\>%Ld\\</td\\> -- \\<td class=\\\"sr ar br\\\"\\>%Ld\\</td\\> -- \\<td class=\\\"sr ar\\\"\\>%Ld\\</td\\> -- \\<td class=\\\"sr ar br\\\"\\>%Ld\\</td\\> -- \\<td class=\\\"sr ar br\\\"\\>%d\\</td\\> -- \\<td class=\\\"sr br\\\"\\>%s\\</td\\> -- \\<td class=\\\"sr\\\"\\>%s\\</td\\> -- \\<td width=\\\"100%%\\\" class=\\\"sr\\\"\\>%s\\</td\\>\\</tr\\>\n" -- (html_mods_cntr ()) -+ Printf.bprintf buf -+" \\<td class=\\\"srb\\\" %s \\>%d\\</td\\> %s %s %s" - (match impl.impl_server_state with -- Connected _ -> Printf.sprintf "title=\\\"Server Banner\\\" -- onMouseOver=\\\"mOvr(this);\\\" -- onMouseOut=\\\"mOut(this);\\\" -- onClick=\\\"location.href='submit?q=server_banner+%d'\\\"" snum -+ Connected _ -> -+ Printf.sprintf "title=\\\"Server Banner\\\" -+ onClick=\\\"location.href='submit?q=server_banner+%d'\\\"" -+ snum - | _ -> "") - snum - ( -- if server_blocked s && (match impl.impl_server_state with -- NotConnected _ -> true -- | _ -> false) then "\\<td class=\\\"srb\\\"\\>blk\\</td\\>" else -- Printf.sprintf -- "\\<TD class=\\\"srb\\\" onMouseOver=\\\"mOvr(this);\\\" -- onMouseOut=\\\"mOut(this);\\\" title=\\\"Connect|Disconnect\\\" -- onClick=\\\"parent.fstatus.location.href='submit?q=%s+%d'\\\"\\>%s\\</TD\\>" -- (match impl.impl_server_state with -- NotConnected _ -> "c" -- | _ -> "x") -+ let not_connected = -+ match impl.impl_server_state with -+ | NotConnected _ -> true -+ | _ -> false -+ in -+ if server_blocked s && not_connected -+ then "\\<td class=\\\"srb\\\"\\>blk\\</td\\>" -+ else Printf.sprintf -+ "\\<td class=\\\"srb\\\" title=\\\"Connect|Disconnect\\\" -+ onClick=\\\"parent.fstatus.location.href='submit?q=%s+%d'\\\"\\>%s\\</td\\>" -+ (if not_connected then "c" else "x") - snum -- (match impl.impl_server_state with -- NotConnected _ -> "Conn" -- | _ -> "Disc") -+ (if not_connected then "Conn" else "Disc") - ) - ( - Printf.sprintf -- "\\<TD class=\\\"srb\\\" onMouseOver=\\\"mOvr(this);\\\" -- onMouseOut=\\\"mOut(this);\\\" title=\\\"Remove server\\\" -- onClick=\\\"parent.fstatus.location.href='submit?q=rem+%d'\\\"\\>Rem\\</TD\\>" -+ "\\<td class=\\\"srb\\\" title=\\\"Remove server\\\" -+ onClick=\\\"parent.fstatus.location.href='submit?q=rem+%d'\\\"\\>Rem\\</td\\>" - snum - ) - ( - if info.G.server_preferred then begin - Printf.sprintf -- "\\<TD class=\\\"srb\\\" onMouseOver=\\\"mOvr(this);\\\" -- onMouseOut=\\\"mOut(this);\\\" title=\\\"Unset preferred\\\" -- onClick=\\\"parent.fstatus.location.href='submit?q=preferred+false+%s'\\\"\\>T\\</TD\\>" -+ "\\<td class=\\\"srb\\\" title=\\\"Unset preferred\\\" -+ onClick=\\\"parent.fstatus.location.href='submit?q=preferred+false+%s'\\\"\\>P\\</td\\>" - (Ip.string_of_addr info.G.server_addr) - end else begin - Printf.sprintf -- "\\<TD class=\\\"srb\\\" onMouseOver=\\\"mOvr(this);\\\" -- onMouseOut=\\\"mOut(this);\\\" title=\\\"Set preferred\\\" -- onClick=\\\"parent.fstatus.location.href='submit?q=preferred+true+%s'\\\"\\>F\\</TD\\>" -+ "\\<td class=\\\"srb\\\" title=\\\"Set preferred\\\" -+ onClick=\\\"parent.fstatus.location.href='submit?q=preferred+true+%s'\\\"\\>-\\</td\\>" - (Ip.string_of_addr info.G.server_addr) - end -- ) -- (if n.network_name = "Donkey" then -- begin -+ ); -+ -+ let id_title, id_text = -+ match n.network_name with -+ "Donkey" -> begin - match impl.impl_server_state with -- | Connected _ -> -- begin -+ Connected _ -> begin - let cid = (server_cid s) in - let (label,shortlabel,our_ip) = - if not (server_low_id s) then -@@ -478,49 +492,58 @@ - (if !!set_client_ip <> cid then - Printf.sprintf "(clientIP: %s)" - (Ip.to_string !!set_client_ip) -- else "" -- ) -- ) -- else -- ("LowID","Lo","") -+ else "")) -+ else ("LowID","Lo","") - in -- Printf.sprintf -- "title=\\\"%s: %s = %s %s\\\" \\>%s" -+ Printf.sprintf "%s: %s = %s %s" - label - (Int64.to_string (Ip.to_int64 (Ip.rev cid))) - (Ip.to_string cid) - our_ip -- shortlabel -+ ,shortlabel - end -- | _ -> "\\>" -+ | _ -> "","" - end -- else "\\>" -- ) -- n.network_name -- (match impl.impl_server_state with -- NotConnected _ -> if server_blocked s then "IP blocked" -- else (string_of_connection_state impl.impl_server_state) -- | _ -> (string_of_connection_state impl.impl_server_state)) -- (if !Geoip.active then -- Printf.sprintf "\\<td class=\\\"sr\\\" title=\\\"%s\\\" \\>%s\\</td\\>" cn cc -- else "") -- (Ip.string_of_addr info.G.server_addr) -- (Printf.sprintf "%s%s" -- (string_of_int info.G.server_port) -- (if info.G.server_realport <> 0 -- then "(" ^ (string_of_int info.G.server_realport) ^ ")" -- else "")) -- info.G.server_nusers -- info.G.server_max_users -- info.G.server_lowid_users -- info.G.server_nfiles -- info.G.server_soft_limit -- info.G.server_hard_limit -- info.G.server_ping -- info.G.server_version -- info.G.server_name -- info.G.server_description -+ | _ -> "","" -+ in -+ -+ let server_state_string = -+ match impl.impl_server_state with -+ NotConnected _ when server_blocked s -> "IP blocked" -+ | _ -> string_of_connection_state impl.impl_server_state -+ in -+ -+ let cc,cn = Geoip.get_country (Ip.ip_of_addr info.G.server_addr) in -+ html_mods_td buf ([ -+ ("", "srb", if info.G.server_master then "M" else "-"); -+ (id_title, "sr", id_text); -+ ("", "sr", n.network_name); -+ ("", "sr", server_state_string); -+ ("", "sr br", ip_port_string); -+ ] @ (if !Geoip.active then [(cn, "sr br", cc)] else []) @ [ -+ ("", "sr ar", if info.G.server_nusers = Int64.zero then "" else Printf.sprintf "%Ld" info.G.server_nusers); -+ ("", "sr ar br", if info.G.server_max_users = Int64.zero then "" else Printf.sprintf "%Ld" info.G.server_max_users); -+ ("", "sr ar br", if info.G.server_lowid_users = Int64.zero then "" else Printf.sprintf "%Ld" info.G.server_lowid_users); -+ ("", "sr ar", if info.G.server_nfiles = Int64.zero then "" else Printf.sprintf "%Ld" info.G.server_nfiles)]); -+ -+ if info.G.server_published_files = 0 then -+ html_mods_td buf ([("", "sr br", "")]) -+ else -+ Printf.bprintf buf -+"\\<TD class=\\\"sr br\\\" title=\\\"Show published files\\\" -+onClick=\\\"location.href='submit?q=server_shares+%d'\\\"\\>%d\\</TD\\>" -+ snum info.G.server_published_files; -+ -+ html_mods_td buf ([ -+ ("", "sr ar", if info.G.server_soft_limit = Int64.zero then "" else Printf.sprintf "%Ld" info.G.server_soft_limit); -+ ("", "sr ar br", if info.G.server_hard_limit = Int64.zero then "" else Printf.sprintf "%Ld" info.G.server_hard_limit); -+ ("", "sr ar br", if info.G.server_ping = 0 then "" else Printf.sprintf "%d" info.G.server_ping); -+ ("", "sr br", info.G.server_version); -+ ("", "sr", info.G.server_name); -+ ]); - -+ Printf.bprintf buf "\\<td width=\\\"100%%\\\" class=\\\"sr\\\"\\>%s\\</td\\>\\</tr\\>\n" -+ info.G.server_description; - end - else - begin -Index: src/daemon/common/commonShared.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonShared.ml,v -retrieving revision 1.33 -retrieving revision 1.37 -diff -u -r1.33 -r1.37 ---- src/daemon/common/commonShared.ml 12 Jun 2006 20:47:21 -0000 1.33 -+++ src/daemon/common/commonShared.ml 29 Oct 2006 18:58:59 -0000 1.37 -@@ -43,7 +43,8 @@ - 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_magic : string option; -+ mutable impl_shared_servers : CommonTypes.server list; - } - - and 'a shared_ops = { -@@ -214,6 +215,7 @@ - impl_shared_id = Md4.null; - impl_shared_requests = 0; - impl_shared_magic = None; -+ impl_shared_servers = [] - } - - -@@ -235,17 +237,17 @@ - - let shared_scan_directory shared_dir local_dir = - let incoming_files_inode = -- ((Unix.stat ((CommonComplexOptions.incoming_files ()).shdir_dirname)).Unix.st_ino) -+ ((Unix.stat ((CommonComplexOptions.incoming_dir false ()).shdir_dirname)).Unix.st_ino) - in - let incoming_directories_inode = -- ((Unix.stat ((CommonComplexOptions.incoming_directories ()).shdir_dirname)).Unix.st_ino) -+ ((Unix.stat ((CommonComplexOptions.incoming_dir true ()).shdir_dirname)).Unix.st_ino) - in - let temp_directory_inode = - ((Unix.stat !!temp_directory).Unix.st_ino) - in - let dirname = shared_dir.shdir_dirname in - let strategy = -- CommonComplexOptions.sharing_strategies shared_dir.shdir_strategy in -+ CommonComplexOptions.sharing_strategy shared_dir.shdir_strategy in - let dirname = - if Filename.is_relative dirname then - Filename.concat file_basedir dirname -@@ -352,6 +354,7 @@ - T.shared_requests = impl.impl_shared_requests; - T.shared_uids = []; - T.shared_sub_files = []; -+ T.shared_magic = impl.impl_shared_magic; - } - - let shared_info s = -Index: src/daemon/common/commonShared.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonShared.mli,v -retrieving revision 1.7 -retrieving revision 1.8 -diff -u -r1.7 -r1.8 ---- src/daemon/common/commonShared.mli 12 Jun 2006 20:47:21 -0000 1.7 -+++ src/daemon/common/commonShared.mli 8 Oct 2006 14:20:21 -0000 1.8 -@@ -9,7 +9,8 @@ - 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_magic : string option; -+ mutable impl_shared_servers : CommonTypes.server list; - } - and 'a shared_ops = { - mutable op_shared_info : 'a -> GuiTypes.shared_info; -Index: src/daemon/common/commonSources.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonSources.ml,v -retrieving revision 1.35 -retrieving revision 1.39 -diff -u -r1.35 -r1.39 ---- src/daemon/common/commonSources.ml 8 Apr 2006 02:16:21 -0000 1.35 -+++ src/daemon/common/commonSources.ml 21 Nov 2006 22:34:33 -0000 1.39 -@@ -531,7 +531,7 @@ - Sort.list - (fun f1 f2 -> - file_best_name (f1.manager_file ()) < file_best_name (f2.manager_file ()) -- ) !file_sources_managers -+ ) (List.filter (fun m -> file_state (m.manager_file ()) = FileDownloading) !file_sources_managers) - in - (* Files *) - List.iter (fun m -> -@@ -1739,6 +1739,8 @@ - | _ -> () - ) !file_sources_managers; - -+ if !files <> [] then begin -+ - (* 'normalize' to 0 priorities*) - sum_priority := !sum_priority + (!nfiles * (-(!min_priority))); - (* update priorities to be > 0 *) -@@ -1758,7 +1760,7 @@ - - (* calc sources queue size - at least 3 sources per file*) -- let nsources = maxi (!nfiles*3) -+ 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*) -@@ -1768,99 +1770,93 @@ - (* - iter through files to queue sources - flist_todo : next files to test -- flist_done : already tested files - assigned : number of sources already queued -- pos : position in file list -- len : length of file list - 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 flist_todo flist_done assigned pos len looped = -- if pos==len || assigned>nsources then -- begin -- (* -- assigned>nsources stop! -- pos=len we are at the end of file list -- *) -- (* Cleanup some sources *) -- List.iter -- (fun m -> -- let f = m.manager_file () in -- if file_state f = FileDownloading then -- begin -- let remove_old q t = begin -- 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); -- end 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; -- end -- ) !file_sources_managers; -- (* 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 assigned + em < nsources && looped>0 then -- (* -- if assigned < nsources restart to fill -- reorder todo files by highest priority first -- allow at most looped re-iter of list to not loop endlessly -- *) -- iter_files (List.rev flist_done) [] (assigned + em) 0 len (looped-1) -- end -- else -- begin -- (* 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 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; -+ let rec iter_files assigned looped = - -- let fp = List.hd flist_todo in -- let file = snd fp and -- prio = fst fp in -- 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 -- iter_files (List.tl flist_todo) (fp::flist_done) -- (assigned + took + !extr) (pos+1) len looped -- end -- in -- iter_files !files [] 0 0 (List.length !files) 3; -+ (* 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 -+ 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) -+ -+ | [] -> -+ 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 -+ -+ 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 -@@ -1890,6 +1886,8 @@ - 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 -Index: src/daemon/common/commonStats.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonStats.ml,v -retrieving revision 1.3 -retrieving revision 1.4 -diff -u -r1.3 -r1.4 ---- src/daemon/common/commonStats.ml 26 Aug 2006 12:05:53 -0000 1.3 -+++ src/daemon/common/commonStats.ml 23 Sep 2006 20:29:46 -0000 1.4 -@@ -87,12 +87,16 @@ - done; - s - --let brandlist_int_to_string l i = -+let brandlist_int_to_2string l i = - if List.length l > i then -- let (_,ls,_) = List.nth l i in -- ls -+ let (_,ls,ss) = List.nth l i in -+ ls,ss - else -- "Total" -+ "Total","Ttl" -+ -+let brandlist_int_to_string l i = -+ let (ls,_) = brandlist_int_to_2string l i in -+ ls - - let print_stats_old buf arr l tl uptime = - -@@ -234,6 +238,26 @@ - ( "1", "srh", "Total uploads:downloads ratio", "U:DL" ); - ] - -+let stats_list l arr = -+ let sl = ref [] in -+ for i = 0 to (Array.length arr) - 1 do -+ let r = arr.(i) in -+ if r.brand_seen > 0 then begin -+ let ls,ss = brandlist_int_to_2string l i in -+ let s = { -+ string_long = ls; -+ string_short = ss; -+ seen = r.brand_seen; -+ banned = r.brand_banned; -+ filerequest = r.brand_filerequest; -+ download = r.brand_download; -+ upload = r.brand_upload; -+ } in -+ sl := s :: !sl -+ end -+ done; -+ !sl -+ - let print_stats_html_mods buf arr l tl uptime = - - let stats_all = build_all arr in -Index: src/daemon/common/commonTypes.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonTypes.ml,v -retrieving revision 1.55 -retrieving revision 1.62 -diff -u -r1.55 -r1.62 ---- src/daemon/common/commonTypes.ml 5 Sep 2006 14:18:24 -0000 1.55 -+++ src/daemon/common/commonTypes.ml 13 Nov 2006 13:10:17 -0000 1.62 -@@ -88,6 +88,9 @@ - string_of_uid_sep uid "_" - - exception Illegal_urn of string -+exception Torrent_already_exists -+exception Torrent_can_not_be_used -+ - let uid_of_string s = - let s = String.lowercase s in - let urn = String2.before s 4 in -@@ -347,7 +350,7 @@ - - type shared_directory = { - shdir_dirname : string; -- shdir_priority : int; -+ mutable shdir_priority : int; - shdir_strategy : string; - shdir_networks : string list; - } -@@ -376,6 +379,8 @@ - | ByNet - | ByAvail - | ByComments -+| ByUser -+| ByGroup - | NotSorted - - type room_state = -@@ -452,7 +457,38 @@ - ExtendSearchLocally - | ExtendSearchRemotely - --type network = { -+type network_stat_info = { -+ mutable string_long : string; -+ mutable string_short : string; -+ mutable seen : int; -+ mutable banned : int; -+ mutable filerequest : int; -+ mutable download : Int64.t; -+ mutable upload : Int64.t; -+} -+ -+type network_porttest = -+ PorttestNotAvailable -+| PorttestNotStarted -+| PorttestInProgress of int -+| PorttestResult of int * string -+ -+type groupdb = { -+ group_name : string; -+ mutable group_admin : bool; -+} -+ -+and userdb = { -+ user_name : string; -+ mutable user_pass : Md4.t; -+ mutable user_groups : groupdb list; -+ mutable user_default_group : groupdb option; -+ mutable user_mail : string; -+ mutable user_commit_dir : string; -+ mutable user_max_concurrent_downloads : int; -+} -+ -+and network = { - network_name : string; - network_num : int; - network_connection_manager : TcpBufferedSocket.connection_manager; -@@ -480,7 +516,7 @@ - mutable op_network_share : ( - string -> string -> int64 -> unit); - mutable op_network_private_message : (string -> string -> unit); -- mutable op_network_parse_url : (string -> string * bool); -+ mutable op_network_parse_url : (string -> userdb -> string * bool); - mutable op_network_connect_servers : (unit -> unit); - - mutable op_network_search : (search -> Buffer.t -> unit); -@@ -492,17 +528,20 @@ - mutable op_network_info : (unit -> network_info); - - mutable op_network_connected : (unit -> bool); -- mutable op_network_gui_message : (string -> unit); -+ mutable op_network_gui_message : (string -> userdb -> unit); - -- mutable op_network_download : (result_info -> file); -+ mutable op_network_download : (result_info -> userdb -> file); - mutable op_network_display_stats : (Buffer.t -> ui_conn -> unit); -+ mutable op_network_stat_info_list : unit -> (string * int * (network_stat_info list)) list; - mutable op_network_clean_exit : (unit -> bool); - mutable op_network_reset : (unit -> unit); - mutable op_network_ports : (unit -> (int * string) list); -+ mutable op_network_porttest_start : (unit -> unit); -+ mutable op_network_porttest_result : (unit -> network_porttest); - } - --and ui_user = { -- ui_user_name : string; -+and ui_user = { -+ ui_user : userdb; - mutable ui_user_searches : search list; - mutable ui_last_search : search option; - mutable ui_last_results : (int * result) list; -@@ -887,3 +926,20 @@ - f : string -> string -> unit; - description : string - } -+ -+type slot_kind = -+ NoSlot -+| FriendSlot -+| ReleaseSlot -+| SmallFileSlot -+| NormalSlot -+| PrioSlot of string -+ -+let string_of_slot_kind slot_kind short = -+ match slot_kind with -+ NoSlot -> "NoSlot" -+ | FriendSlot -> "FriendSlot" -+ | ReleaseSlot -> "ReleaseSlot" -+ | SmallFileSlot -> "SmallFileSlot" -+ | NormalSlot -> if short then "" else "NormalSlot" -+ | PrioSlot dir -> Printf.sprintf "Prio %s" dir -Index: src/daemon/common/commonUploads.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonUploads.ml,v -retrieving revision 1.45 -retrieving revision 1.51 -diff -u -r1.45 -r1.51 ---- src/daemon/common/commonUploads.ml 5 Sep 2006 14:15:19 -0000 1.45 -+++ src/daemon/common/commonUploads.ml 21 Nov 2006 22:34:33 -0000 1.51 -@@ -244,7 +244,7 @@ - !!http_port, "http_port"; - !!telnet_port, "telnet_port"; - !!gui_port, "gui_port"; -- !!gift_port, "gift_port"; -+ !!gift_port, "gift_port GUI"; - ]); - network.op_network_connected_servers <- (fun _ -> []) - -@@ -279,15 +279,6 @@ - let shared_counter = ref (Int64.zero) - let shared_files = Hashtbl.create 13 - --let _ = -- Heap.add_memstat "CommonUploads" (fun level buf -> -- Printf.bprintf buf " infos_by_name: %d\n" (Hashtbl.length infos_by_name); -- Printf.bprintf buf " shareds_by_uid: %d\n" (Hashtbl.length shareds_by_uid); -- Printf.bprintf buf " shareds_by_id: %d\n" (Hashtbl.length shareds_by_id); -- Printf.bprintf buf " shared_files: %d\n" (Hashtbl.length shared_files); -- ) -- -- - let new_shared_dir dirname = { - shared_dirname = dirname; - shared_files = []; -@@ -695,7 +686,8 @@ - impl_shared_ops = shared_ops; - impl_shared_val = sh; - impl_shared_requests = 0; -- impl_shared_magic = None -+ impl_shared_magic = None; -+ impl_shared_servers = []; - } - and sh = { - shared_info = index; -@@ -838,14 +830,7 @@ - end - else - if not (Intmap.mem (client_num c) !pending_slots_map) then -- begin --(* This is useless since it is the goal of the pending_slots_map -- else if Fifo.mem pending_slots_fifo (client_num c) then begin -- lprintf "Avoided inserting a client twice in pending slots\n"; -- -- end else *) -- pending_slots_map := Intmap.add (client_num c) c !pending_slots_map; -- end -+ pending_slots_map := Intmap.add (client_num c) c !pending_slots_map - - let remove_pending_slot c = - if Intmap.mem (client_num c) !pending_slots_map then -@@ -853,11 +838,11 @@ - - let rec give_a_slot c = - remove_pending_slot c; -- if not (client_is_connected c) then begin -- find_pending_slot () -- end -- else begin -- set_client_has_a_slot c true; -+ if not (client_is_connected c) then -+ find_pending_slot () -+ else -+ begin -+ set_client_has_a_slot c NormalSlot; - client_enter_upload_queue c - end - -@@ -872,36 +857,47 @@ - with _ -> () - - let add_pending_slot c = -- let csh = client_upload c in -+ let client_upload c = -+ match client_upload c with -+ None -> raise Not_found -+ | Some file -> file -+ in -+ let csh = file_shared (client_upload c) in - let cdir = shared_dir csh in - let cprio = ref (shared_prio csh) in - let cfriend = ref (if is_friend c && !!friends_upload_slot then 1 else 0) in - let csmallfiles = ref (match csh with - | None -> 0 - | Some sh -> if shared_size sh <= !!small_files_slot_limit then 1 else 0) in -- (* if cdir <> "" then -- lprintf "Testing cdir %s\n" cdir; *) -+ let allowed_release_slots = -+ ref (Misc.percentage_of_ints !!max_upload_slots !!max_release_slots) in -+ -+(* check current upload slots for already used special slots *) - Intmap.iter (fun _ c -> -- let sh = client_upload c in -- if shared_dir sh = cdir then decr cprio; -- if client_has_a_friend_slot c then decr cfriend; -- match sh with -- | None -> () -- | Some sh -> -- if shared_size sh <= !!small_files_slot_limit then -- decr csmallfiles; -- ) !CommonClient.uploaders; -- (* if cdir <> "" then -- lprintf "Testing cprio %d cfriend %d csmallfiles\n" -- !cprio !cfriend !csmallfiles; *) -- if !cprio > 0 || !cfriend > 0 || !csmallfiles > 0 then begin -- remove_pending_slot c; -- if client_is_connected c then begin -- set_client_has_a_slot c true; -- client_enter_upload_queue c -- end -- end else -- add_pending_slot c -+ if shared_dir (file_shared (client_upload c)) = cdir then -+ decr cprio; -+ match client_slot c with -+ ReleaseSlot -> decr allowed_release_slots -+ | FriendSlot -> decr cfriend -+ | SmallFileSlot -> decr csmallfiles -+ | _ -> ()) !CommonClient.uploaders; -+ -+ let slot_type = -+ if file_release (client_upload c) && !allowed_release_slots > 0 then Some ReleaseSlot else -+ if !cfriend > 0 then Some FriendSlot else -+ if !csmallfiles > 0 then Some SmallFileSlot else -+ if !cprio > 0 then Some (PrioSlot cdir) else -+ None -+ in -+ match slot_type with -+ Some slot -> -+ remove_pending_slot c; -+ if client_is_connected c then -+ begin -+ set_client_has_a_slot c slot; -+ client_enter_upload_queue c -+ end -+ | None -> add_pending_slot c - - let static_refill_upload_slots () = - let len = Intmap.length !CommonClient.uploaders in -@@ -938,7 +934,7 @@ - estimated_capacity - else - (* max_hard_upload_rate lowered manually,... *) -- mini estimated_capacity (!!max_hard_upload_rate * 1024) in -+ min estimated_capacity (!!max_hard_upload_rate * 1024) in - if !verbose_upload then - lprintf_nl "usage: %d(%d) capacity: %d" - (short_delay_upload_usage ()) -@@ -966,34 +962,18 @@ - end - - let turn = ref (-1) --let turn_h = ref (-1) - - let refill_upload_slots () = - incr turn; - if !turn = 5 then - turn := 0; -- if !turn_h = 360 then -- turn_h := 0; - if !!dynamic_slots then begin - if !turn = 0 then - (* call every 5s *) - dynamic_refill_upload_slots () - end else - (* call every 1s *) -- static_refill_upload_slots (); -- -- if !turn = 0 then begin -- (* call every 5s *) -- incr turn_h; -- update_download_history (); -- update_upload_history () -- end; -- -- if !turn_h = 0 then begin -- (* call every 720 * 5s *) -- update_h_download_history (); -- update_h_upload_history () -- end -+ static_refill_upload_slots () - - let consume_bandwidth len = - streaming_left := !streaming_left - len -@@ -1067,3 +1047,12 @@ - | l -> l - in - get_name_keywords -+ -+let _ = -+ Heap.add_memstat "CommonUploads" (fun level buf -> -+ Printf.bprintf buf " infos_by_name: %d\n" (Hashtbl.length infos_by_name); -+ Printf.bprintf buf " shareds_by_uid: %d\n" (Hashtbl.length shareds_by_uid); -+ Printf.bprintf buf " shareds_by_id: %d\n" (Hashtbl.length shareds_by_id); -+ Printf.bprintf buf " shared_files: %d\n" (Hashtbl.length shared_files); -+ Printf.bprintf buf " pending_slots: %d\n" (Intmap.length !pending_slots_map); -+ ) -Index: src/daemon/common/commonUserDb.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonUserDb.ml,v -retrieving revision 1.5 -retrieving revision 1.7 -diff -u -r1.5 -r1.7 ---- src/daemon/common/commonUserDb.ml 12 Aug 2006 20:36:14 -0000 1.5 -+++ src/daemon/common/commonUserDb.ml 9 Nov 2006 21:32:26 -0000 1.7 -@@ -31,18 +31,130 @@ - let lprintf_n fmt = - lprintf2 log_prefix fmt - --type userdb = { -- user_name : string; -- user_pass : Md4.t; -- user_mail : string; -- } -+(*************************************************************************) -+(* DEFAULTS *) -+(*************************************************************************) - --let admin_user = "admin" -+let users_ini = create_options_file "users.ini" -+ -+let users2_section = file_section users_ini ["Users"] "User accounts on the core (new format)" -+let users_section = file_section users_ini ["Users"] "User accounts on the core (old format)" - --let user2_is_admin user = user = admin_user -+let dummy_group = { -+ group_name = ""; -+ group_admin = true; -+} -+ -+let default_group_name = "mldonkey" -+let system_user_default_group = { -+ dummy_group with -+ group_name = default_group_name -+} - - let blank_password = Md4.string "" - -+let dummy_user = { -+ user_name = ""; -+ user_pass = blank_password; -+ user_groups = [system_user_default_group]; -+ user_default_group = Some system_user_default_group; -+ user_mail = ""; -+ user_commit_dir = ""; -+ user_max_concurrent_downloads = 0; -+} -+ -+let admin_user_name = "admin" -+let admin_user = { -+ dummy_user with -+ user_name = admin_user_name; -+} -+ -+(*************************************************************************) -+(* GroupOption *) -+(*************************************************************************) -+ -+module GroupOption = struct -+ -+ let value_to_group v = -+ match v with -+ | Options.Module assocs -> -+ let get_value name conv = conv (List.assoc name assocs) in -+ let gname = -+ try -+ get_value "group_name" value_to_string -+ with _ -> default_group_name -+ in -+ let gadmin = -+ try -+ get_value "group_admin" value_to_bool -+ with _ -> true -+ in -+ { group_name = gname; -+ group_admin = gadmin; -+ } -+ -+ | _ -> failwith "Options: not a valid group" -+ -+ let group_to_value group = -+ Options.Module [ -+ "group_name", string_to_value group.group_name; -+ "group_admin", bool_to_value group.group_admin; -+ ] -+ -+ let t = define_option_class "Groups" value_to_group group_to_value -+ -+ end -+ -+let grouplist = define_option users2_section ["groups"] -+ "The groups that are defined on this core. -+ -+group_admin = Are members of this group MLDonkey admins? -+ Only members of this group can change settings and see uploads. -+" -+ (list_option GroupOption.t) [system_user_default_group] -+ -+(*************************************************************************) -+(* Group database functions *) -+(*************************************************************************) -+ -+let user2_groups_iter f = -+ List.iter f ((List.sort (fun g1 g2 -> compare g1.group_name g2.group_name)) !!grouplist) -+ -+let update_group name new_group = -+ let other_groups = List.filter (fun g -> g.group_name <> name) !!grouplist in -+ grouplist =:= -+ match new_group with -+ | None -> other_groups -+ | Some new_group -> new_group :: other_groups -+ -+let user2_group_add name admin = -+ let new_group = { -+ group_name = name; -+ group_admin = admin; -+ } in -+ update_group name (Some new_group) -+ -+let user2_group_remove group = -+ update_group group.group_name None -+ -+let user2_group_find group = -+ List.find (fun g -> g.group_name = group) !!grouplist -+ -+let user2_group_exists group = -+ List.exists (fun g -> g.group_name = group) !!grouplist -+ -+let user2_default_group_matches_group dgroup group = -+ match dgroup with -+ None -> false -+ | Some g -> group = g -+ -+let user2_group_admin group admin = -+ group.group_admin <- admin -+ -+(*************************************************************************) -+(* UserOption *) -+(*************************************************************************) -+ - module UserOption = struct - - let value_to_user v = -@@ -65,9 +177,49 @@ - get_value "user_mail" value_to_string - with _ -> "" - in -+ let ucdir = -+ try -+ get_value "user_commit_dir" value_to_string -+ with _ -> "" -+ in -+ let umaxdl = -+ try -+ get_value "user_max_concurrent_downloads" value_to_int -+ with _ -> 0 -+ in -+ let ugroups = -+ try -+ let ugl = get_value "user_groups" (value_to_list value_to_string) in -+ List.map user2_group_find ugl -+ with Not_found -> [system_user_default_group] -+ in -+ let udgroup = -+ try -+ match get_value "user_default_group" stringvalue_to_option with -+ None -> None -+ | Some udg -> -+ begin try -+ let g = user2_group_find udg in -+ if List.mem g ugroups then -+ Some g -+ else begin -+ lprintf_nl "User %s is not member of group %s, setting user_default_group to None" uname udg; -+ None -+ end -+ with Not_found -> -+ lprintf_nl "user_default_group %s of user %s does not exist, setting to None" udg uname; -+ None -+ end -+ with Not_found -> Some system_user_default_group -+ in - { user_name = uname; - user_pass = upass; -- user_mail = umail; } -+ user_groups = ugroups; -+ user_default_group = udgroup; -+ user_mail = umail; -+ user_commit_dir = ucdir; -+ user_max_concurrent_downloads = umaxdl; -+ } - - | _ -> failwith "Options: not a valid user" - -@@ -75,94 +227,220 @@ - Options.Module [ - "user_name", string_to_value user.user_name; - "user_pass", string_to_value (Md4.to_string user.user_pass); -- "user_mail", string_to_value user.user_mail; ] -+ "user_groups", list_to_value (fun v -> string_to_value v.group_name) user.user_groups; -+ "user_default_group", option_to_stringvalue (match user.user_default_group with Some g -> Some g.group_name | None -> None); -+ "user_mail", string_to_value user.user_mail; -+ "user_commit_dir", string_to_value user.user_commit_dir; -+ "user_max_concurrent_downloads", int_to_value user.user_max_concurrent_downloads; -+ ] - - let t = define_option_class "Users" value_to_user user_to_value - - end - --let users_ini = create_options_file "users.ini" -- --let users_section = file_section users_ini ["Users"] "User accounts on the core" --let users2_section = file_section users_ini ["Users"] "User accounts on the core (new format)" -- --let users = define_option users_section ["users"] -- "Depreciated option, kept for compatibility reasons - used by MLDonkey < 2.7.5" -- (list_option (tuple2_option (string_option, Md4.option))) -- [] -- - let userlist = define_option users2_section ["users2"] - "The users that are defined on this core. The default user is - called 'admin', and uses an empty password. To create new users, --login as admin in mldonkey, and use the 'useradd' command." -- (list_option UserOption.t) -- [ { user_name = admin_user; -- user_pass = blank_password; -- user_mail = "" } ] -+login as admin in mldonkey, and use the 'useradd' command. - --let users2 = Hashtbl.create 10 -+user_groups = Files belonging to one of these groups can be seen by the user. -+user_default_group = New downloads by this user will belong to this group. -+user_commit_dir = Commit files to <incoming>/<user_commit_dir> -+user_mail = Address used to sent confirmation mails after comitting a download -+user_max_concurrent_downloads = Maximum number of downloads allowed, 0 = unlimited -+" -+ (list_option UserOption.t) [admin_user] - --let user2_iter f = -- Hashtbl.iter f users2 -+let users = define_option users_section ["users"] -+ "Depreciated option, kept for compatibility reasons - used by MLDonkey < 2.7.5" -+ (list_option (tuple2_option (string_option, Md4.option))) -+ [admin_user.user_name, blank_password] - --let user2_add name pass mail = -- let u = { -+(*************************************************************************) -+(* User database functions *) -+(*************************************************************************) -+ -+let user2_users_iter f = -+ List.iter f ((List.sort (fun u1 u2 -> compare u1.user_name u2.user_name)) !!userlist) -+ -+let update_user name new_user = -+ let other_users = List.filter (fun u -> u.user_name <> name) !!userlist in -+ userlist =:= -+ match new_user with -+ | None -> other_users -+ | Some new_user -> new_user :: other_users -+ -+let user2_user_add name pass ?(groups = [default_group_name]) -+ ?(default_group = Some default_group_name) -+ ?(mail = "") ?(commit_dir = "") ?(max_dl = 0) () = -+ (* shouldn't we warn admin about already existing user ? *) -+ let groups = -+ let l = List.map user2_group_find (List.filter user2_group_exists groups) in -+ if l = [] then [system_user_default_group] else l -+ in -+ let default_group = -+ match default_group with -+ None -> None -+ | Some group -> if not (user2_group_exists group) then None else Some (user2_group_find group) -+ in -+ let new_user = { - user_name = name; - user_pass = pass; -- user_mail = mail -+ user_groups = groups; -+ user_default_group = default_group; -+ user_mail = mail; -+ user_commit_dir = commit_dir; -+ user_max_concurrent_downloads = max_dl; - } in -- Hashtbl.replace users2 name u; -- u -+ update_user name (Some new_user) - --let user2_remove user = -- Hashtbl.remove users2 user -+let user2_user_remove user = -+ update_user user None - --let user2_find user = -- try -- Hashtbl.find users2 user -- with Not_found -> failwith (Printf.sprintf "User %s does not exist" user) -+let user2_user_find user = -+ List.find (fun u -> u.user_name = user) !!userlist - --let user2_password user = -- try -- let u = user2_find user in -- u.user_pass -- with Not_found -> failwith (Printf.sprintf "User %s does not exist" user) -+let user2_user_exists user = -+ List.exists (fun u -> u.user_name = user) !!userlist - --let user2_mail user = -- try -- let u = user2_find user in -- u.user_mail -- with Not_found -> failwith (Printf.sprintf "User %s does not exist" user) -+(*************************************************************************) -+(* User database functions / passwords *) -+(*************************************************************************) -+ -+let user2_user_password user = -+ (user2_user_find user).user_pass -+ -+let user2_user_set_password user pass_string = -+ user.user_pass <- Md4.string pass_string - - let valid_password user pass = - try -- user2_password user = Md4.string pass -- with e -> false -+ user2_user_password user = Md4.string pass -+ with Not_found -> false - --let empty_password user = -- try -- let p = user2_password user in -- p = blank_password -- with _ -> false -+let has_empty_password user = -+ valid_password user.user_name "" -+ -+(*************************************************************************) -+(* User database functions *) -+(*************************************************************************) -+ -+let user2_user_set_mail user mail = -+ user.user_mail <- mail -+ -+let user2_print_user_dls user = -+ let dls = user.user_max_concurrent_downloads in -+ if dls = 0 then "unlimited" else string_of_int dls -+ -+let user2_user_set_dls user dls = -+ user.user_max_concurrent_downloads <- dls -+ -+let user2_user_commit_dir user = -+ (user2_user_find user).user_commit_dir -+ -+let user2_user_set_commit_dir user dir = -+ user.user_commit_dir <- dir -+ -+(*************************************************************************) -+(* User/Group database functions *) -+(*************************************************************************) -+ -+let sort_groups_by_name gl = -+ List.sort (fun g1 g2 -> compare g1.group_name g2.group_name) gl -+ -+let user2_user_groups_iter user f = -+ List.iter f (sort_groups_by_name user.user_groups) -+ -+let user2_print_user_groups sep user = -+ String.concat sep (List.map (fun g -> g.group_name) (sort_groups_by_name user.user_groups)) -+ -+let user2_print_group group = -+ match group with -+ None -> "none" -+ | Some group -> group.group_name -+ -+let user2_print_user_default_group user = -+ user2_print_group user.user_default_group -+ -+let user2_user_set_default_group user group = -+ user.user_default_group <- group -+ -+let user2_user_add_group user group = -+ user.user_groups <- group :: user.user_groups -+ -+let user2_user_remove_group user group = -+ user.user_groups <- List.filter ((<>) group) user.user_groups -+ -+let user2_num_group_members group = -+ let counter = ref 0 in -+ user2_users_iter (fun u -> -+ user2_user_groups_iter u (fun g -> -+ if g = group then incr counter)); -+ !counter -+ -+(*************************************************************************) -+(* Access rights *) -+(*************************************************************************) -+ -+let user2_is_admin user = -+ user.user_name = admin_user.user_name || -+ List.exists (fun groupname -> -+ try -+ groupname.group_admin -+ with Not_found -> false) -+ user.user_groups -+ -+(* could be expanded later *) -+let user2_can_view_uploads user = -+ user2_is_admin user -+ -+let user2_can_view_file user file_owner file_group = -+ user2_is_admin user || user = file_owner || -+ (match file_group with -+ | None -> false -+ | Some file_group -> List.mem file_group user.user_groups) -+ -+(*************************************************************************) -+(* Hooks *) -+(*************************************************************************) - - let _ = - set_after_load_hook users_ini (fun _ -> -- List.iter (fun user -> -- ignore (user2_add user.user_name user.user_pass user.user_mail) -- ) !!userlist; -- userlist =:= []; -- if !!users <> [] then begin -- lprintf_nl "converting %d users to new format" (List.length !!users); -- List.iter (fun (user,pass) -> ignore (user2_add user pass "")) !!users; -- users =:= [] -- end -+ List.iter (fun (user,pass) -> -+ if not (user2_user_exists user) then begin -+ user2_user_add user pass (); -+ lprintf_nl "converted user %s to new format" user -+ end) !!users; -+(* clean !!users to avoid saving users more than once *) -+ users =:= []; -+(* Security and default checks -+ - user "admin" must exist, it has hard-coded admin rights independent of group membership -+ - group "mldonkey" must exist and must have admin status *) -+ if not (user2_user_exists admin_user.user_name) then -+ begin -+ user2_user_add admin_user.user_name blank_password (); -+ lprintf_nl "SECURITY INFO: user 'admin' has to be present, creating with empty password..." -+ end; -+ begin -+ try -+ let g = user2_group_find default_group_name in -+ if not g.group_admin then -+ begin -+ user2_group_admin g true; -+ lprintf_nl "SECURITY INFO: group 'mldonkey' must have admin status, updating..." -+ end -+ with Not_found -> -+ user2_group_add default_group_name true; -+ lprintf_nl "SECURITY INFO: group 'mldonkey' has to be present, creating with admin rights..." -+ end - ); -+ -+(* This code provides backward-compatibility for older MLDonkey clients *) -+(* reading new user db and copying the values into old user db !!users *) - set_before_save_hook users_ini (fun _ -> -- user2_iter (fun _ user -> -- userlist =:= (user2_find user.user_name) :: !!userlist; -- users =:= (user.user_name, (user2_password user.user_name)) :: !!users -- ) -+ user2_users_iter (fun user -> -+ users =:= (user.user_name, (user2_user_password user.user_name)) :: !!users -+ ) - ); -- set_after_save_hook users_ini (fun _ -> -- userlist =:= []; -- users =:= []) -+(* clean !!users to avoid saving users more than once *) -+ set_after_save_hook users_ini (fun _ -> users =:= []) -Index: src/daemon/common/commonWeb.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonWeb.ml,v -retrieving revision 1.33 -retrieving revision 1.36 -diff -u -r1.33 -r1.36 ---- src/daemon/common/commonWeb.ml 14 Jul 2006 13:24:23 -0000 1.33 -+++ src/daemon/common/commonWeb.ml 15 Nov 2006 12:37:13 -0000 1.36 -@@ -57,7 +57,8 @@ - let kind_record = { f = f; description = descr } in - file_kinds := (kind, kind_record) :: !file_kinds - --let mldonkey_wget url f = -+ -+let mldonkey_wget_url url f = - let module H = Http_client in - let r = { - H.basic_request with -@@ -100,27 +101,21 @@ - match !date with - None -> H.wget r f - | Some date -> -- let html_time = -- begin try -- let t = Date.time_of_string date in -- r.H.req_save_to_file_time <- t; -- Unix.gmtime t -- with e -> -- let t = Unix.time () in -- r.H.req_save_to_file_time <- t; -- Unix.gmtime t -- end -- in - let file = Filename.concat "web_infos" (Filename.basename r.H.req_url.Url.short_file) in -+ r.H.req_save_to_file_time <- (begin try -+ Date.time_of_string date -+ with e -> -+ Unix.time () -+ end); - if not (Sys.file_exists file) then - H.wget r f - else - begin - let file_date = Unix.LargeFile.stat file in -- let file_time = Unix.gmtime file_date.Unix.LargeFile.st_mtime in -- if html_time <= file_time then -+ if r.H.req_save_to_file_time <= file_date.Unix.LargeFile.st_mtime then - begin -- lprintf_nl (_b "using local version of %s, HTML header (%s)") file date; -+ lprintf_nl (_b "using local version of %s (%s), HTML header (%s)") -+ file (Date.to_full_string file_date.Unix.LargeFile.st_mtime) date; - (f file : unit) - end - else -@@ -135,6 +130,19 @@ - (Printexc2.to_string e) url - end - -+let mldonkey_wget_shell url f = -+ let command_urlencoded = Str.string_after url 8 in -+ let command = Url.decode command_urlencoded in -+ let filename = Filename.temp_file "wget_" ".tmp" in -+ Sys.command (Printf.sprintf "%s > %s" command filename); -+ (f filename : unit) -+ -+let mldonkey_wget url f = -+ if Str.string_match (Str.regexp "shell://") url 0 then -+ mldonkey_wget_shell url f -+ else -+ mldonkey_wget_url url f -+ - let load_url can_fail kind url = - let f = - try -@@ -184,13 +192,47 @@ - - let rss_feeds = Hashtbl.create 10 - -- - let _ = - add_web_kind "rss" "Syndication feeds to get periodically updated data" - (fun url filename -> - lprintf_nl (_b "parsing feed %s (rss)") url; -- let c = Rss.channel_of_file filename in -- (try Sys.remove filename with _ -> ()); -+ let c = -+ (try -+ let rss_c = Rss.channel_of_file filename in -+ (try Sys.remove filename with _ -> ()); -+ rss_c -+ with Xml.Error _ -> -+ lprintf_nl (_b "found buggy feed, preprocessing with %s and trying again") !!rss_preprocessor; -+ (try -+ let pipe_out, pipe_in = Unix.pipe () in -+ let pid = Unix.create_process !!rss_preprocessor [| !!rss_preprocessor; filename |] -+ Unix.stdin pipe_in pipe_in in -+ Unix.close pipe_in; -+ let output = Buffer.create 1024 in -+ let buffersize = 1024 in -+ let buffer = String.create buffersize in -+ (try -+ while true do -+ let nread = Unix.read pipe_out buffer 0 buffersize in -+ if nread = 0 then raise End_of_file; -+ Buffer.add_substring output buffer 0 nread -+ done -+ with -+ | End_of_file -> () -+ | Unix.Unix_error (code, f, arg) -> -+ lprintf_nl "%s failed: %s" !!rss_preprocessor (Unix.error_message code)); -+ (try Unix.close pipe_out with _ -> ()); -+ (try Sys.remove filename with _ -> ()); -+ let _pid, _ = Unix.waitpid [] pid in -+ let result = Buffer.contents output in -+ if result = "" then begin -+ lprintf_nl (_b "%s produced empty content for feed %s, program missing?") !!rss_preprocessor url; -+ raise Not_found -+ end; -+ Rss.channel_of_string result -+ with Unix.Unix_error (code, f, arg) -> -+ lprintf_nl (_b "%s failed: %s") !!rss_preprocessor (Unix.error_message code); raise Not_found)) -+ in - let feed = - try Hashtbl.find rss_feeds url with - Not_found -> -Index: src/daemon/common/guiDecoding.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/guiDecoding.ml,v -retrieving revision 1.59 -retrieving revision 1.65 -diff -u -r1.59 -r1.65 ---- src/daemon/common/guiDecoding.ml 1 Sep 2006 16:22:14 -0000 1.59 -+++ src/daemon/common/guiDecoding.ml 14 Nov 2006 18:42:59 -0000 1.65 -@@ -506,13 +506,29 @@ - let get_int_pos s pos = - get_int s pos, pos + 4 - --let get_sub_files s pos = -+let get_sub_files proto s pos = - get_list (fun s pos -> - let name, pos = get_string s pos in - let size, pos = get_int64 s pos, pos+8 in -- (name, size, Some ""), pos -+ let magic, pos = -+ if proto > 40 then -+ get_string s pos -+ else -+ "", pos -+ in -+ (name, size, Some magic), pos - ) s pos - -+let get_file_comments proto s pos = -+ get_list (fun s pos -> -+ let ip, pos = get_ip2 proto s pos in -+ let name, pos = get_string s pos in -+ let rating, pos = get_uint8 s pos, pos+1 in -+ let comment, pos = get_string s pos in -+ (ip, name, rating, comment), pos -+ ) s pos -+ -+ - let get_file proto s pos = - let num = get_int s pos in - let net = get_int s (pos+4) in -@@ -557,10 +573,31 @@ - in - let sub_files, pos = - if proto > 35 then -- get_sub_files s pos -+ get_sub_files proto s pos - else [], pos - in -- -+ let magic, pos = -+ if proto > 40 then -+ let ms, pos = get_string s pos -+ in Some ms, pos -+ else -+ Some "", pos -+ in -+ let comments, pos = -+ if proto > 40 then -+ get_file_comments proto s pos -+ else [], pos -+ in -+ let user, pos = -+ if proto > 40 -+ then get_string s pos -+ else "", pos -+ in -+ let group, pos = -+ if proto > 40 -+ then get_string s pos -+ else "", pos -+ in - (* - assert (num = file_info_test.file_num); - assert (net = file_info_test.file_network); -@@ -609,6 +646,11 @@ - file_priority = priority; - file_uids = uids; - file_sub_files = sub_files; -+ file_magic = magic; -+ file_comments = comments; -+ file_user = user; -+ file_group = group; -+ file_release = false; - }, pos - - let get_host_state proto s pos = -@@ -709,12 +751,15 @@ - server_banner = ""; - server_users = None; - server_preferred = preferred; -+ server_master = false; - server_version = ve; - server_max_users = ma; - server_lowid_users = lo; - server_soft_limit = so; - server_hard_limit = ha; - server_ping = pi; -+ server_published_files = 0; -+ server_features = None; - }, pos - - let get_client_type s pos = -@@ -768,6 +813,7 @@ - client_files = None; - client_connect_time = 0; - client_software = ""; -+ client_os = None; - client_release = ""; - client_emulemod = ""; - client_downloaded = zero; -@@ -826,6 +872,7 @@ - client_files = None; - client_connect_time = connect_time; - client_software = software; -+ client_os = None; - client_release = release; - client_emulemod = emulemod; - client_downloaded = downloaded; -@@ -940,6 +987,7 @@ - shared_requests = requests; - shared_uids = []; - shared_sub_files = []; -+ shared_magic = Some ""; - } - - let get_shared_info_version_10 proto s pos = -@@ -957,9 +1005,16 @@ - in - let sub_files, pos = - if proto > 36 then -- get_sub_files s pos -+ get_sub_files proto s pos - else [], pos - in -+ let magic, pos = -+ if proto > 40 then -+ let ms, pos = get_string s (pos) in -+ Some ms, pos -+ else -+ Some "", pos -+ in - { - shared_num = num; - shared_network = network; -@@ -969,6 +1024,7 @@ - shared_requests = requests; - shared_uids = uids; - shared_sub_files = sub_files; -+ shared_magic = magic; - } - - -@@ -998,7 +1054,7 @@ - | 5 - | 52 -> - if proto < 14 then -- let pass = fst (get_string s 2) in Password (CommonUserDb.admin_user, pass) -+ let pass = fst (get_string s 2) in Password (CommonUserDb.admin_user.CommonTypes.user_name, pass) - else - let pass,pos = get_string s 2 in - let login,pos = get_string s pos in -@@ -1262,6 +1318,10 @@ - let b = get_bool s 6 in - ServerSetPreferred (num, b) - -+ | 68 -> -+ let num = get_int s 2 in -+ GetStats num -+ - | _ -> - lprintf_nl "FROM GUI:Unknown message %d" opcode; - raise FromGuiMessageNotImplemented -Index: src/daemon/common/guiEncoding.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/guiEncoding.ml,v -retrieving revision 1.57 -retrieving revision 1.59 -diff -u -r1.57 -r1.59 ---- src/daemon/common/guiEncoding.ml 1 Sep 2006 16:22:14 -0000 1.57 -+++ src/daemon/common/guiEncoding.ml 31 Oct 2006 15:40:05 -0000 1.59 -@@ -542,10 +542,25 @@ - buf_int8 buf 18; - buf_string buf x - --let buf_sub_files buf l = -- buf_list buf (fun buf (name, size, _) -> -+let magic_string m = -+ match m with -+ Some s -> s -+ | None -> "" -+ -+let buf_sub_files proto buf l = -+ buf_list buf (fun buf (name, size, magic) -> - buf_string buf name; -- buf_int64 buf size -+ buf_int64 buf size; -+ if proto > 40 then -+ buf_string buf (magic_string magic) -+ ) l -+ -+let buf_file_comments proto buf l = -+ buf_list buf (fun buf (ip, name, rating, comment) -> -+ buf_ip2 proto buf ip; -+ buf_string buf name; -+ buf_int8 buf rating; -+ buf_string buf comment; - ) l - - let buf_file proto buf f = -@@ -587,7 +602,13 @@ - if proto > 30 then - buf_list buf buf_uid f.file_uids; - if proto > 35 then -- buf_sub_files buf f.file_sub_files -+ buf_sub_files proto buf f.file_sub_files; -+ if proto > 40 then begin -+ buf_string buf (magic_string f.file_magic); -+ buf_file_comments proto buf f.file_comments; -+ buf_string buf f.file_user; -+ buf_string buf f.file_group; -+ end - - let buf_addr proto buf addr = - (match addr with -@@ -645,7 +666,7 @@ - buf_int buf c.client_chat_port - end else - begin -- buf_string buf c.client_software; -+ buf_string buf (client_software_short c.client_software c.client_os); - buf_int64 buf c.client_downloaded; - buf_int64 buf c.client_uploaded; - (match c.client_upload with -@@ -727,8 +748,23 @@ - else - buf_list buf buf_uid s.shared_uids; - if proto > 36 then -- buf_sub_files buf s.shared_sub_files -- -+ buf_sub_files proto buf s.shared_sub_files; -+ if proto > 40 then -+ buf_string buf (magic_string s.shared_magic) -+ -+let buf_stat_info proto buf n = -+ buf_string buf n.string_long; -+ buf_string buf n.string_short; -+ buf_int buf n.seen; -+ buf_int buf n.banned; -+ buf_int buf n.filerequest; -+ buf_int64 buf n.download; -+ buf_int64 buf n.upload -+ -+let buf_stat_info_list proto buf (s,i,l) = -+ buf_string buf s; -+ buf_int buf i; -+ buf_list2 proto buf buf_stat_info l - - (*************** - -@@ -1004,6 +1040,13 @@ - - | GiftServerAttach _ -> assert false - | GiftServerStats _ -> assert false -+ -+ | Stats (num, l) -> -+ let proto = proto.(59) in -+ buf_opcode buf 59; -+ buf_int buf num; -+ buf_list2 proto buf buf_stat_info_list l -+ - with e -> - lprintf "GuiEncoding.to_gui: Exception %s\n" - (Printexc2.to_string e) -@@ -1217,6 +1260,9 @@ - buf_opcode buf 67; - buf_int buf num; - buf_bool buf preferred -+ | GetStats n -> -+ buf_opcode buf 68; -+ buf_int buf n - - with e -> - lprintf "GuiEncoding.from_gui: Exception %s\n" -Index: src/daemon/common/guiProto.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/guiProto.ml,v -retrieving revision 1.24 -retrieving revision 1.25 -diff -u -r1.24 -r1.25 ---- src/daemon/common/guiProto.ml 16 Jan 2006 16:05:14 -0000 1.24 -+++ src/daemon/common/guiProto.ml 23 Sep 2006 20:29:46 -0000 1.25 -@@ -29,9 +29,9 @@ - - let gui_extension_poll = 1 - --let to_gui_last_opcode = 58 --let from_gui_last_opcode = 67 --let best_gui_version = 40 -+let to_gui_last_opcode = 59 -+let from_gui_last_opcode = 68 -+let best_gui_version = 41 - - (* I will try to report all changes to the protocol here: send me patches - if I don't ! -@@ -166,6 +166,7 @@ - (* Understood by core protocol 32 *) - | ServerRename of (int * string) - | ServerSetPreferred of (int * bool) -+| GetStats of int - - type to_gui = - (* This message is the first message sent by the core *) -@@ -233,6 +234,7 @@ - - | GiftServerAttach of string * string - | GiftServerStats of (string * string * string * string) list -+| Stats of int * (string * int * network_stat_info list) list - - - let string_of_from_gui t = -@@ -311,6 +313,7 @@ - - | ServerRename _ -> "ServerRename" - | ServerSetPreferred _ -> "ServerSetPreferred" -+ | GetStats _ -> "GetStats" - - let string_of_to_gui t = - match t with -@@ -380,6 +383,7 @@ - - | GiftServerAttach _ -> "GiftServerAttach" - | GiftServerStats _ -> "GiftServerStats" -+ | Stats _ -> "Stats" - - type gui_record = { - mutable gui_num : int; -Index: src/daemon/common/guiTypes.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/common/guiTypes.ml,v -retrieving revision 1.29 -retrieving revision 1.34 -diff -u -r1.29 -r1.34 ---- src/daemon/common/guiTypes.ml 1 Sep 2006 16:22:14 -0000 1.29 -+++ src/daemon/common/guiTypes.ml 14 Nov 2006 18:42:59 -0000 1.34 -@@ -136,6 +136,11 @@ - mutable file_priority : int; - mutable file_uids : Uid.t list; - mutable file_sub_files : (string * int64 * string option) list; -+ mutable file_magic : string option; -+ mutable file_comments : (Ip.t * string * int * string) list; -+ mutable file_user : string; -+ mutable file_group : string; -+ mutable file_release : bool; - } - - type user_info = { -@@ -165,12 +170,15 @@ - mutable server_users : int list option; - mutable server_banner : string; - mutable server_preferred : bool; -+ mutable server_master : bool; - mutable server_version : string; - mutable server_max_users : int64; - mutable server_soft_limit : int64; - mutable server_hard_limit : int64; - mutable server_lowid_users : int64; - mutable server_ping : int; -+ mutable server_published_files : int; -+ mutable server_features : string option; - - } - -@@ -208,6 +216,7 @@ - mutable client_chat_port : int; - mutable client_connect_time : int; - mutable client_software : string; -+ mutable client_os : string option; - mutable client_release : string; - mutable client_emulemod : string; - mutable client_downloaded : int64; -@@ -240,9 +249,32 @@ - mutable shared_requests : int; - mutable shared_uids : Uid.t list; (* net file UID *) - mutable shared_sub_files : (string * int64 * string option) list; -+ mutable shared_magic : string option; - } - - -+let osinfo_short i = -+ match i with -+ Some s when -+ s = "linux" || -+ s = "netbsd" || -+ s = "macos" || -+ s = "freebsd" || -+ s = "windows" -> Some (String.sub s 0 1) -+ | _ -> i -+ -+let client_software_short software os = -+ software ^ -+ match osinfo_short os with -+ Some s -> "/" ^ s -+ | None -> "" -+ -+let client_software software os = -+ software ^ -+ match os with -+ Some s -> "/" ^ s -+ | None -> "" -+ - let add_file tree dirname r = - let path = Filename2.path_of_filename dirname in - -@@ -326,5 +358,10 @@ - file_priority = 0; - file_uids = []; - file_sub_files = []; -+ file_magic = Some ""; -+ file_comments = []; -+ file_user = ""; -+ file_group = ""; -+ file_release = false; - } - -Index: src/daemon/driver/driverCommands.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverCommands.ml,v -retrieving revision 1.175 -retrieving revision 1.199 -diff -u -r1.175 -r1.199 ---- src/daemon/driver/driverCommands.ml 16 Sep 2006 09:38:59 -0000 1.175 -+++ src/daemon/driver/driverCommands.ml 21 Nov 2006 22:34:33 -0000 1.199 -@@ -325,7 +325,7 @@ - ), ":\t\t\t\t\t$bclose telnet$n"; - - "kill", Arg_none (fun o -> -- if user2_is_admin o.conn_user.ui_user_name then -+ if user2_is_admin o.conn_user.ui_user then - begin - CommonInteractive.clean_exit 0; - _s "exit" -@@ -334,12 +334,18 @@ - _s "You are not allowed to kill MLDonkey" - ), ":\t\t\t\t\t$bsave and kill the server$n"; - -- "urladd", Arg_two (fun kind url o -> -- web_infos_add kind 1 url; -+ "urladd", Arg_multiple (fun args o -> -+ let (kind, url, period) = match args with -+ | [kind; url; period] -> kind, url, int_of_string period -+ | [kind; url] -> kind, url, 0 -+ | _ -> failwith "Bad number of arguments" -+ in -+ web_infos_add kind period url; - CommonWeb.load_url true kind url; - "url added to web_infos. downloading now" -- ), "<kind> <url> :\t\t\tload this file from the web\n" -- ^"\t\t\t\t\tkind is either server.met (if the downloaded file is a server.met)"; -+ ), "<kind> <url> [<period>]:\t\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)"; - - "urlremove", Arg_one (fun url o -> - if web_infos_exists url then -@@ -400,7 +406,7 @@ - client_print c o; - if use_html_mods o then - html_mods_td buf ([ -- ("", "sr", i.client_software); -+ (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 [])); -@@ -736,6 +742,16 @@ - end - ) !!servers; - Printf.sprintf (_b "Removed %d blocked servers") !counter -+ | ["disc"] -> -+ Intmap.iter (fun _ s -> -+ match server_state s with -+ NotConnected _ -> -+ begin -+ server_remove s; -+ incr counter -+ end -+ | _ -> ()) !!servers; -+ Printf.sprintf (_b "Removed %d disconnected servers") !counter - | _ -> - List.iter (fun num -> - let num = int_of_string num in -@@ -743,7 +759,7 @@ - server_remove s - ) args; - Printf.sprintf (_b"%d servers removed") (List.length args) -- ), "<server numbers> :\t\t\tremove server (use 'all' for all servers, 'blocked' for all IP blocked servers)"; -+ ), "<server numbers|all|blocked|disc> :\tremove server(s) ('all'/'blocked'/'disc' = all/IP blocked/disconnected servers)"; - - "server_banner", Arg_one (fun num o -> - let num = int_of_string num in -@@ -754,6 +770,23 @@ - "" - ), "<num> :\t\t\tprint banner of connected server <num>"; - -+ "server_shares", Arg_one (fun num o -> -+ if user2_is_admin o.conn_user.ui_user then -+ let s = server_find (int_of_string num) in -+ (match server_state s with -+ Connected _ -> let list = ref [] in -+ List.iter (fun f -> -+ match file_shared f with -+ None -> () -+ | Some sh -> list := (as_shared_impl sh) :: !list) -+ (server_published s); -+ print_upstats o !list (Some s) -+ | _ -> () -+ ) -+ else print_command_result o o.conn_buf "You are not allowed to use this command"; -+ _s "" -+ ), "<num> :\t\t\tshow list of files published on server <num>"; -+ - "c", Arg_multiple (fun args o -> - let buf = o.conn_buf in - match args with -@@ -959,7 +992,7 @@ - let num = int_of_string num in - - if num > 0 then (* we want to disable upload for a short time *) -- let num = mini !CommonUploads.upload_credit num in -+ let num = min !CommonUploads.upload_credit num in - CommonUploads.has_upload := !CommonUploads.has_upload + num; - CommonUploads.upload_credit := !CommonUploads.upload_credit - num; - Printf.sprintf -@@ -970,7 +1003,7 @@ - if num < 0 && !CommonUploads.has_upload > 0 then - (* we want to restart upload probably *) - let num = - num in -- let num = mini num !CommonUploads.has_upload in -+ let num = min num !CommonUploads.has_upload in - CommonUploads.has_upload := !CommonUploads.has_upload - num; - CommonUploads.upload_credit := !CommonUploads.upload_credit + num; - Printf.sprintf -@@ -1014,13 +1047,31 @@ - Printf.bprintf buf "\\</tr\\>\\</table\\>\\</td\\>\\</tr\\>\\</table\\>\\</div\\>"; - - Printf.bprintf buf "\\<script type=\\\"text/javascript\\\"\\>window.parent.document.title='(D:%.1f) (U:%.1f) | %s | %s'\\</script\\>" -- dlkbs ulkbs o.conn_user.ui_user_name (CommonGlobals.version ()) -+ dlkbs ulkbs o.conn_user.ui_user.user_name (CommonGlobals.version ()) - end - else - DriverInteractive.print_bw_stats buf; - "" - ), ":\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 -+ max_hard_upload_rate_2 =:= !!max_hard_upload_rate; -+ 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 -+ "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"; -+ "" -+ ), ":\t\t\t\ttoggle between the two rate sets"; -+ - "stats", Arg_none (fun o -> - let buf = o.conn_buf in - CommonInteractive.network_display_stats buf o; -@@ -1053,16 +1104,43 @@ - "!", Arg_multiple (fun arg o -> - if !!allow_any_command then - match arg with -- c :: tail -> -- let args = String2.unsplit tail ' ' in -+ c :: args -> - let cmd = try List.assoc c !!allowed_commands with Not_found -> c in -- let tmp = Filename.temp_file "com" ".out" in -- let ret = Sys.command (Printf.sprintf "%s %s > %s" -- cmd args tmp) in -- let output = File.to_string tmp in -- Sys.remove tmp; -- Printf.sprintf (_b "%s\n---------------- Exited with code %d") output ret -- | _ -> _s "no command given" -+ (try -+ let pipe_out, pipe_in = Unix.pipe () in -+ let pid = Unix.create_process cmd -+ (Array.of_list (Filename2.basename c :: args)) -+ Unix.stdin pipe_in pipe_in in -+ Unix.close pipe_in; -+ (* can't close pipe_out in the already forked+executed process... *) -+ let output = Buffer.create 1024 in -+ let buffersize = 1024 in -+ let buffer = String.create buffersize in -+ (try -+ while true do -+ let nread = Unix.read pipe_out buffer 0 buffersize in -+ if nread = 0 then raise End_of_file; -+ Buffer.add_substring output buffer 0 nread -+ done -+ with -+ | End_of_file -> () -+ | Unix.Unix_error (code, f, arg) -> -+ lprintf_nl "%s failed%s: %s" f (if arg = "" then "" else " on " ^ arg) (Unix.error_message code)); -+ (try Unix.close pipe_out with _ -> ()); -+ let _pid, status = Unix.waitpid [] pid in -+ Printf.sprintf (_b "%s\n---------------- %s") -+ (Buffer.contents output) -+ (match status with -+ | Unix.WEXITED exitcode -> -+ Printf.sprintf "Exited with code %d" exitcode -+ | Unix.WSIGNALED signal -> -+ Printf.sprintf "Was killed by signal %d" signal -+ | Unix.WSTOPPED signal -> (* does it matter for us ? *) -+ Printf.sprintf "Was stopped by signal %d" signal) -+ -+ with Unix.Unix_error (code, f, arg) -> -+ Printf.sprintf "%s failed%s: %s" f (if arg = "" then "" else " on " ^ arg) (Unix.error_message code)) -+ | [] -> _s "no command given" - else - match arg with - [arg] -> -@@ -1100,17 +1178,44 @@ - ) , ":\t\t\t\tprint all networks"; - - "enable", Arg_one (fun num o -> -- let n = network_find_by_num (int_of_string num) in -- network_enable n; -- _s "network enabled" -+ 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" -+ end -+ else -+ print_command_result o buf "You are not allowed to enable networks"; -+ _s "" - ) , "<num> :\t\t\t\tenable a particular network"; - - "disable", Arg_one (fun num o -> -- let n = network_find_by_num (int_of_string num) in -- network_disable n; -- _s "network disabled" -+ 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" -+ end -+ else -+ print_command_result o buf "You are not allowed to disable networks"; -+ _s "" - ) , "<num> :\t\t\t\tdisable a particular network"; - -+ "porttest", Arg_none (fun o -> -+ let buf = o.conn_buf 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"; -+ "" -+ ) , ":\t\t\t\tstart network porttest"; -+ - ] - - (*************************************************************************) -@@ -1301,7 +1406,7 @@ - begin - let r = List.hd !forceable_download in - CommonNetwork.networks_iter (fun n -> -- ignore(n.op_network_download r)); -+ ignore (n.op_network_download r o.conn_user.ui_user)); - - let output = (if o.conn_output = HTML then begin - let buf = Buffer.create 100 in -@@ -1334,7 +1439,7 @@ - [ - - "set", Arg_two (fun name value o -> -- if user2_is_admin o.conn_user.ui_user_name then begin -+ if user2_is_admin o.conn_user.ui_user then begin - try - try - CommonInteractive.set_fully_qualified_options name value; -@@ -1371,7 +1476,7 @@ - if use_html_mods o then begin - - if !!html_mods_use_js_helptext then -- Printf.bprintf buf "\\<div id=\\\"object1\\\" style=\\\"position:absolute; background-color:FFFFDD;color:black;border-color:black;border-width:20;font-size:8pt; visibility:show; left:25px; top:-100px; z-index:+1\\\" onmouseover=\\\"overdiv=1;\\\" onmouseout=\\\"overdiv=0; setTimeout(\\\'hideLayer()\\\',1000)\\\"\\>\\ \\</div\\>"; -+ Printf.bprintf buf "\\<div id=\\\"object1\\\" style=\\\"position:absolute; background-color:#FFFFDD;color:black;border-color:black;border-width:20px;font-size:8pt; visibility:visible; left:25px; top:-100px; z-index:+1\\\" onmouseover=\\\"overdiv=1;\\\" onmouseout=\\\"overdiv=0; setTimeout(\\\'hideLayer()\\\',1000)\\\"\\>\\ \\</div\\>"; - - Printf.bprintf buf "\\<div class=\\\"friends\\\"\\>\\<table class=main cellspacing=0 cellpadding=0\\> - \\<tr\\>\\<td\\> -@@ -1386,7 +1491,7 @@ - \\</tr\\>\\</table\\> - \\</td\\>\\</tr\\> - \\<tr\\>\\<td\\>" --(if (user2_is_admin o.conn_user.ui_user_name) then -+(if (user2_is_admin o.conn_user.ui_user) then - "\\<td nowrap title=\\\"Show users Tab where you can add/remove Users\\\" class=\\\"fbig fbigpad\\\"\\>\\<a onclick=\\\"javascript:window.location.href='submit?q=users'\\\"\\>Users\\</a\\>\\</td\\>" - else ""); - -@@ -1406,7 +1511,7 @@ - - Printf.bprintf buf "\\</td\\>\\</tr\\>\\<tr\\>\\<td\\>\\<table cellspacing=0 cellpadding=0 width=100%%\\>\\<tr\\>\\<td class=downloaded width=100%%\\>\\</td\\> - \\<td nowrap title=\\\"Toggle option helptext from javascript popup to html table\\\" class=\\\"fbig fbigb pr fbigpad\\\"\\> --\\<a onclick=\\\"javascript: {parent.fstatus.location.href='submit?q=set+html_mods_use_js_helptext+%s'; setTimeout('window.location.replace(window.location.href)',1000);return true;}\\\"\\>Toggle js_helptext\\</a\\> -+\\<a onclick=\\\"javascript: {parent.fstatus.location.href='submit?q=set+html_mods_use_js_helptext+%s'; setTimeout('window.location.replace(window.location.href)',1000);return true;}\\\"\\>toggle js_helptext\\</a\\> - \\</td\\>\\</tr\\>\\</table\\>\\</td\\>\\</tr\\>\\</table\\>\\</div\\>\\</br\\>" (if !!html_mods_use_js_helptext then "false" else "true"); - - html_mods_table_one_row buf "downloaderTable" "downloaders" [ -@@ -1461,7 +1566,7 @@ - let mtabs = ref 1 in - - if !!html_mods_use_js_helptext then -- Printf.bprintf buf "\\<div id=\\\"object1\\\" style=\\\"position:absolute; background-color:FFFFDD;color:black;border-color:black;border-width:20;font-size:8pt; visibility:show; left:25px; top:-100px; z-index:+1\\\" onmouseover=\\\"overdiv=1;\\\" onmouseout=\\\"overdiv=0; setTimeout(\\\'hideLayer()\\\',1000)\\\"\\>\\ \\</div\\>"; -+ Printf.bprintf buf "\\<div id=\\\"object1\\\" style=\\\"position:absolute; background-color:#FFFFDD;color:black;border-color:black;border-width:20px;font-size:8pt; visibility:visible; left:25px; top:-100px; z-index:+1\\\" onmouseover=\\\"overdiv=1;\\\" onmouseout=\\\"overdiv=0; setTimeout(\\\'hideLayer()\\\',1000)\\\"\\>\\ \\</div\\>"; - - Printf.bprintf buf "\\<div class=\\\"vo\\\"\\>\\<table class=main cellspacing=0 cellpadding=0\\> - \\<tr\\>\\<td\\> -@@ -1531,12 +1636,13 @@ - strings_of_option global_login; - strings_of_option set_client_ip; - strings_of_option force_client_ip; -- strings_of_option run_as_user; -- strings_of_option run_as_useruid; - strings_of_option max_upload_slots; -+ strings_of_option max_release_slots; - strings_of_option dynamic_slots; - strings_of_option max_hard_upload_rate; - strings_of_option max_hard_download_rate; -+ strings_of_option max_hard_upload_rate_2; -+ strings_of_option max_hard_download_rate_2; - strings_of_option max_opened_connections; - strings_of_option max_indirect_connections; - strings_of_option max_connections_per_second; -@@ -1560,16 +1666,16 @@ - strings_of_option html_mods_use_relative_availability; - strings_of_option html_mods_human_readable; - strings_of_option html_mods_vd_network; -- strings_of_option html_mods_vd_comments; - strings_of_option html_mods_vd_active_sources; - strings_of_option html_mods_vd_age; -+ strings_of_option html_mods_vd_user; -+ strings_of_option html_mods_vd_group; - strings_of_option html_mods_vd_last; - strings_of_option html_mods_vd_prio; - strings_of_option html_mods_show_pending; - strings_of_option html_mods_load_message_file; - strings_of_option html_mods_max_messages; - strings_of_option html_mods_bw_refresh_delay; -- strings_of_option use_html_frames; - strings_of_option html_frame_border; - strings_of_option html_checkbox_vd_file_list; - strings_of_option html_checkbox_search_file_list; -@@ -1598,6 +1704,9 @@ - strings_of_option html_mods_vd_gfx_mean; - strings_of_option html_mods_vd_gfx_transparent; - strings_of_option html_mods_vd_gfx_h; -+ strings_of_option html_mods_vd_gfx_h_dynamic; -+ strings_of_option html_mods_vd_gfx_h_grid_time; -+ strings_of_option html_mods_vd_gfx_subgrid; - strings_of_option html_mods_vd_gfx_x_size; - strings_of_option html_mods_vd_gfx_y_size; - strings_of_option html_mods_vd_gfx_tag; -@@ -1702,8 +1811,10 @@ - | 8 -> - [ - strings_of_option term_ansi; -- strings_of_option enable_user_config; -+ strings_of_option run_as_user; -+ strings_of_option run_as_useruid; - strings_of_option messages_filter; -+ strings_of_option comments_filter; - strings_of_option max_displayed_results; - strings_of_option max_name_len; - strings_of_option max_filenames; -@@ -1740,7 +1851,7 @@ - \\<select id=\\\"modsStyle\\\" name=\\\"modsStyle\\\" - style=\\\"padding: 0px; font-size: 10px; font-family: verdana\\\" onchange=\\\"this.form.submit()\\\"\\> - \\<option value=\\\"0\\\"\\>style/theme\n" --(if (user2_is_admin o.conn_user.ui_user_name) then -+(if (user2_is_admin o.conn_user.ui_user) then - "\\<td nowrap title=\\\"Show users Tab where you can add/remove Users\\\" class=\\\"fbig fbigb\\\"\\>\\<a onclick=\\\"javascript:window.location.href='submit?q=users'\\\"\\>Users\\</a\\>\\</td\\>" - else ""); - -@@ -1762,7 +1873,7 @@ - \\<td class=downloaded width=100%%\\>\\</td\\> - \\<td nowrap title=\\\"Change to simple Webinterface without html_mods\\\" class=\\\"fbig fbigb fbigpad\\\"\\>\\<a onclick=\\\"javascript:window.location.href='submit?q=html_mods'\\\"\\>toggle html_mods\\</a\\>\\</td\\> - \\<td nowrap title=\\\"Toggle option helptext from javascript popup to html table\\\" class=\\\"fbig fbigb pr fbigpad\\\"\\> --\\<a onclick=\\\"javascript: {parent.fstatus.location.href='submit?q=set+html_mods_use_js_helptext+%s'; setTimeout('window.location.replace(window.location.href)',1000);return true;}\\\"\\>Toggle js_helptext\\</a\\> -+\\<a onclick=\\\"javascript: {parent.fstatus.location.href='submit?q=set+html_mods_use_js_helptext+%s'; setTimeout('window.location.replace(window.location.href)',1000);return true;}\\\"\\>toggle js_helptext\\</a\\> - \\</td\\>\\</tr\\>\\</table\\>\\</td\\>\\</tr\\>\\</table\\>\\</div\\>\\</br\\>" (if !!html_mods_use_js_helptext then "false" else "true"); - html_mods_table_one_row buf "downloaderTable" "downloaders" [ - ("", "srh", "!! press ENTER to send changes to core !!"); ]; -@@ -1782,7 +1893,7 @@ - \\<table cellspacing=0 cellpadding=0 width=100%%\\>\\<tr\\> - \\<td class=downloaded width=100%%\\>\\</td\\> - \\<td nowrap class=\\\"fbig pr\\\"\\>\\<a onclick=\\\"javascript: { -- var getdir = prompt('Input: <kind> <URL>','server.met URL') -+ var getdir = prompt('Input: <kind> <URL> [<period>]','server.met URL') - parent.fstatus.location.href='submit?q=urladd+' + encodeURIComponent(getdir); - setTimeout('window.location.reload()',1000); - }\\\"\\>Add URL\\</a\\> -@@ -1988,6 +2099,9 @@ - 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 user,group = Unix32.owner arg in - Printf.bprintf buf "username %s\n" user; - Printf.bprintf buf "groupname %s\n" group; -@@ -2030,7 +2144,7 @@ - \\<table cellspacing=0 cellpadding=0 width=100%%\\>\\<tr\\> - \\<td class=downloaded width=100%%\\>\\</td\\> - \\<td nowrap class=\\\"fbig pr\\\"\\>\\<a onclick=\\\"javascript: { -- var getdir = prompt('Input: <priority#> <directory> (surround dir with quotes if necessary)','0 /home/mldonkey/share') -+ var getdir = prompt('Input: <priority#> <directory> [<strategy>] (surround dir with quotes if necessary)','0 /home/mldonkey/share') - parent.fstatus.location.href='submit?q=share+' + encodeURIComponent(getdir); - setTimeout('window.location.reload()',1000); - }\\\"\\>Add Share\\</a\\> -@@ -2049,12 +2163,10 @@ - ( "1", "srh ar", "% free", "% free" ) ; - ( "0", "srh", "Filesystem", "FS" ) ]; - -- let counter = ref 0 in -- -+ html_mods_cntr_init (); - List.iter (fun shared_dir -> - let dir = shared_dir.shdir_dirname in -- incr counter; -- Printf.bprintf buf "\\<tr class=\\\"%s\\\"\\> -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\> - \\<td title=\\\"Click to unshare this directory\\\" - onMouseOver=\\\"mOvr(this);\\\" - onMouseOut=\\\"mOut(this);\\\" -@@ -2069,7 +2181,7 @@ - \\<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") -+ (html_mods_cntr ()) - (Url.encode dir) - shared_dir.shdir_priority - dir -@@ -2088,7 +2200,38 @@ - !!shared_directories; - - Printf.bprintf buf "\\</table\\>\\</td\\>\\<tr\\>\\</table\\>\\</div\\>\\<P\\>"; -- print_option_help o shared_directories -+ print_option_help o shared_directories; -+ Printf.bprintf buf "\\<P\\>"; -+ -+ html_mods_big_header_start buf "sharesTable" ["Share strategies"]; -+ html_mods_table_header buf "sharesTable" "shares" [ -+ ( "0", "srh", "Name", "Name" ) ; -+ ( "0", "srh", "Incoming", "Incoming" ) ; -+ ( "0", "srh", "Directories", "Directories" ) ; -+ ( "0", "srh", "Recursive", "Recursive" ) ; -+ ( "0", "srh", "Minsize", "Minsize" ) ; -+ ( "0", "srh", "Maxsize", "Maxsize" ) ; -+ ( "0", "srh", "Extensions", "Extensions" ) ]; -+ -+ html_mods_cntr_init (); -+ -+ let int64_print v = -+ if v = Int64.max_int then "unlimited" else Int64ops.int64_to_human_readable v in -+ -+ List.iter (fun (s,t) -> -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); -+ html_mods_td buf [ -+ ("", "sr", s); -+ ("", "sr", string_of_bool t.sharing_incoming); -+ ("", "sr", string_of_bool t.sharing_directories); -+ ("", "sr", string_of_bool t.sharing_recursive); -+ ("", "sr", (int64_print t.sharing_minsize)); -+ ("", "sr", (int64_print t.sharing_maxsize)); -+ ("", "sr", (String.concat " " t.sharing_extensions)); -+ ]; -+ Printf.bprintf buf "\\</tr\\>\n" -+ ) !!sharing_strategies; -+ - end - else - begin -@@ -2119,23 +2262,29 @@ - } in - - if Unix2.is_directory arg then -- if not (List.mem shdir !!shared_directories) then begin -+ begin -+ try -+ let d = List.find (fun d -> d.shdir_dirname = arg) !!shared_directories in -+ let old_prio = d.shdir_priority in -+ d.shdir_priority <- prio; -+ Printf.sprintf "prio of %s changed from %d to %d" -+ d.shdir_dirname old_prio d.shdir_priority -+ with Not_found -> - shared_directories =:= shdir :: !!shared_directories; - shared_add_directory shdir; -- "directory added" -- end (* else -- if not (List.mem (arg, prio) !!shared_directories) then begin -- shared_directories =:= (arg, prio) :: List.remove_assoc arg !!shared_directories; -- shared_add_directory (arg, prio); -- "prio changed" -- end *) else -- "directory already shared" -+ Printf.sprintf "directory %s added%s" -+ shdir.shdir_dirname -+ (if shdir.shdir_priority <> 0 then -+ Printf.sprintf " with prio %d" shdir.shdir_priority -+ else "") -+ end - else - "no such directory" - ), "<priority> <dir> [<strategy>] :\tshare directory <dir> with <priority> [and sharing strategy <strategy>]"; - - "unshare", Arg_one (fun arg o -> - -+ if user2_is_admin o.conn_user.ui_user then begin - let found = ref false in - shared_directories =:= List.filter (fun sd -> - let diff = sd.shdir_dirname <> arg in -@@ -2154,118 +2303,33 @@ - _s "directory removed" - end else - _s "directory already unshared" -- -- ), "<dir> :\t\t\t\tshare directory <dir>"; -+ end -+ else -+ _s "You are not allowed to unshare directories" -+ ), "<dir> :\t\t\t\tunshare directory <dir>"; - - "upstats", Arg_none (fun o -> - let buf = o.conn_buf in -- -- if use_html_mods o then begin -- --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:20;font-size:8pt; visibility:show; left:25px; top: ---100px; z-index:+1\\\" onmouseover=\\\"overdiv=1;\\\" onmouseout=\\\"overdiv=0; setTimeout(\\\'hideLayer()\\\',1000)\\\"\\>\\ \\</div\\>"; -- -- Printf.bprintf buf "\\<div class=\\\"upstats\\\"\\>"; -- html_mods_table_one_row buf "upstatsTable" "upstats" [ -- ("", "srh", Printf.sprintf "Session: %s uploaded | Shared(%d): %s\n" -- (size_of_int64 !upload_counter) !nshared_files (size_of_int64 !nshared_bytes)); ] -- end -- else begin -- Printf.bprintf buf "Upload statistics:\n"; -- Printf.bprintf buf "Session: %s uploaded | Shared(%d): %s\n" -- (size_of_int64 !upload_counter) !nshared_files (size_of_int64 !nshared_bytes) -- end; -- let list = ref [] in -- shared_iter (fun s -> -- let impl = as_shared_impl s in -- list := impl :: !list -- ); -- -- if use_html_mods o then -- html_mods_table_header buf "upstatsTable" "upstats" [ -- ( "1", "srh", "Total file requests", "Reqs" ) ; -- ( "1", "srh", "Total bytes sent", "Total" ) ; -- ( "1", "srh", "Upload Ratio", "UPRatio" ) ; -- ( "0", "srh", "Preview", "P" ) ; -- ( "0", "srh", "Filename", "Filename" ); -- ( "0", "srh", "Statistic links", "Stats" ) ] -+ 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" - else -- begin -- Printf.bprintf buf " Requests | Bytes | Uploaded | File\n"; -- Printf.bprintf buf "----------+----------+----------+----------------------------------------------------\n"; -- end; -- -- let counter = ref 0 in -- -- 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 ) -- ) !list in -- -- List.iter (fun impl -> -- if use_html_mods o then -- begin -- incr counter; -- -- let ed2k = file_print_ed2k_link -- (Filename.basename impl.impl_shared_codedname) -- impl.impl_shared_size impl.impl_shared_id in -- -- Printf.bprintf buf "\\<tr class=\\\"%s\\\"" -- (if (!counter mod 2 == 0) then "dl-1" else "dl-2";); -- -- (if !!html_mods_use_js_tooltips then -- Printf.bprintf buf " onMouseOver=\\\"mOvr(this);setTimeout('popLayer(\\\\\'%s<br>%s\\\\\')',%d);setTimeout('hideLayer()',%d);return true;\\\" onMouseOut=\\\"mOut(this);hideLayer();setTimeout('hideLayer()',%d)\\\"\\>" -- (Http_server.html_real_escaped (Filename.basename impl.impl_shared_codedname)) -- (match impl.impl_shared_magic with -- None -> "" -- | Some magic -> "File type: " ^ (Http_server.html_real_escaped magic) ^ "<br>") -- !!html_mods_js_tooltips_wait -- !!html_mods_js_tooltips_timeout -- !!html_mods_js_tooltips_wait -- else Printf.bprintf buf " onMouseOver=\\\"mOvr(this);return true;\\\" onMouseOut=\\\"mOut(this);\\\"\\>"); -- -- 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); -- ("", "sr ar", Printf.sprintf "%5.1f" ( if size < 1.0 then 0.0 else (uploaded *. 100.) /. size)); -- ("", "sr", Printf.sprintf "\\<a href=\\\"preview_upload?q=%d\\\"\\>P\\</a\\>" -- impl.impl_shared_num); -- ("", "sr", (if impl.impl_shared_id = Md4.null then -- (Filename.basename impl.impl_shared_codedname) -- else -- Printf.sprintf "\\<a href=\\\"%s\\\"\\>%s\\</a\\>" -- ed2k (shorten (Filename.basename impl.impl_shared_codedname) !!max_name_len))); -- ("", "sr", (if impl.impl_shared_id = Md4.null then "" else -- Printf.sprintf "\\<a href=\\\"http://tothbenedek.hu/ed2kstats/ed2k?hash=%s\\\"\\>%s\\</a\\> --\\<a href=\\\"http://ed2k.titanesel.ws/ed2k.php?hash=%s\\\"\\>%s\\</a\\> --\\<a href=\\\"http://bitzi.com/lookup/ed2k:%s\\\"\\>%s\\</a\\>" -- (Md4.to_string impl.impl_shared_id) "T1" -- (Md4.to_string impl.impl_shared_id) "T2" -- (Md4.to_string impl.impl_shared_id) "B")) ]; -- Printf.bprintf buf "\\</tr\\>\n"; -- end -- else -- Printf.bprintf buf "%9d | %8s | %7s%% | %-50s\n" -- (impl.impl_shared_requests) -- (size_of_int64 impl.impl_shared_uploaded) -- (Printf.sprintf "%3.1f" ((Int64.to_float impl.impl_shared_uploaded *. 100.) /. Int64.to_float impl.impl_shared_size)) -- (shorten (Filename.basename impl.impl_shared_codedname) !!max_name_len); -- ) list; -- -- if use_html_mods o then Printf.bprintf buf "\\</table\\>\\</div\\>\\</div\\>"; -- -- -+ begin -+ let list = ref [] in -+ shared_iter (fun s -> -+ let impl = as_shared_impl s in -+ list := impl :: !list -+ ); -+ print_upstats o !list None; -+ end; - _s "" - ), ":\t\t\t\tstatistics on upload"; - - "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" -+ else begin -+ - let list = ref [] in - shared_iter (fun s -> - let impl = as_shared_impl s in -@@ -2285,28 +2349,26 @@ - (Filename.basename impl.impl_shared_codedname) - impl.impl_shared_size impl.impl_shared_id); - ) list; -+ end; - "Done" - ), ":\t\t\t\t\tlist links of shared files"; - - "uploaders", Arg_none (fun o -> - let buf = o.conn_buf in - -- let nuploaders = Intmap.length !uploaders 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" -+ else begin - -+ let nuploaders = Intmap.length !uploaders in - if use_html_mods o then -- - begin -- - let counter = ref 0 in - 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 - (Fifo.length CommonUploads.upload_clients) - (Intmap.length !CommonUploads.pending_slots_map)); ]; --(* Printf.bprintf buf "\\<div class=\\\"uploaders\\\"\\>Total upload slots: %d (%d) | Pending slots: %d\n" nuploaders -- (Fifo.length CommonUploads.upload_clients) -- (Intmap.length !CommonUploads.pending_slots_map); -- *) - if nuploaders > 0 then - - begin -@@ -2327,6 +2389,7 @@ - @ [ - ( "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", "Slot kind", "Slot" ) ; - ( "0", "srh", "Filename", "Filename" ) ]); - - List.iter (fun c -> -@@ -2359,15 +2422,22 @@ - ("", "sr", ips); - ] @ (if !Geoip.active then [(cn, "sr", cc)] else []) @ [ - ("", "sr", Printf.sprintf "%d" (((last_time ()) - i.client_connect_time) / 60)); -- ("", "sr", i.client_software); -+ (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 []) - @ [ - ("", "sr ar", size_of_int64 i.client_downloaded); - ("", "sr ar", size_of_int64 i.client_uploaded); -+ (let text1, text2 = -+ match client_slot c with -+ | FriendSlot -> "Friend", "F" -+ | ReleaseSlot -> "Release", "R" -+ | SmallFileSlot -> "Small file", "S" -+ | PrioSlot dir -> "Prio dir: " ^ dir, "P" -+ | _ -> "", "" in text1, "sr ar", text2); - ("", "sr", (match i.client_upload with -- Some cu -> cu -+ Some f -> shorten f !!max_name_len - | None -> "") ) ]); - - Printf.bprintf buf "\\</tr\\>" -@@ -2388,6 +2458,9 @@ - ( "0", "srh", "Network", "Network" ) ; - ( "0", "srh", "Connection type [I]ndirect [D]irect", "C" ) ; - ( "0", "srh", "Client name", "Client name" ) ; -+ ( "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 []) @ [ - ( "0", "srh", "Client brand", "CB" ) ; - ( "0", "srh", "Client release", "CR" ) ; - ] @ -@@ -2395,12 +2468,13 @@ - @ [ - ( "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", "IP address", "IP address" ) ]); -+ ( "0", "srh", "Filename", "Filename" ) ]); - - Intmap.iter (fun cnum c -> - - 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\\\" -@@ -2414,33 +2488,36 @@ - client_print_html c o; - - html_mods_td buf ([ -- ("", "sr", i.client_software); -+ ("", "sr", (match i.client_sui_verified with -+ | None -> "N" -+ | Some b -> if b then "P" else "F" -+ )); -+ ("", "sr", ips); -+ ] @ (if !Geoip.active then [(cn, "sr", cc)] else []) @ [ -+ (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 []) - @ [ - ("", "sr ar", size_of_int64 i.client_downloaded); - ("", "sr ar", size_of_int64 i.client_uploaded); -- ("", "sr", string_of_kind i.client_kind); ]); -+ ("", "sr", (match i.client_upload with -+ Some f -> shorten f !!max_name_len -+ | None -> "") ) ]); - - Printf.bprintf buf "\\</tr\\>"; - with _ -> (); - - ) !CommonUploads.pending_slots_map; - Printf.bprintf buf "\\</table\\>\\</div\\>"; -- - end; -- -- Printf.bprintf buf "\\</div\\>"; -- "" -+ Printf.bprintf buf "\\</div\\>" - end - else - begin -- - Intmap.iter (fun _ c -> - 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); - match i.client_upload with -@@ -2451,14 +2528,12 @@ - Printf.bprintf buf "no info on client %d\n" (client_num c ) - ) !uploaders; - -- Printf.sprintf "Total upload slots: %d (%d) | Pending slots: %d\n" nuploaders -+ Printf.bprintf buf "Total upload slots: %d (%d) | Pending slots: %d\n" nuploaders - (Fifo.length CommonUploads.upload_clients) - (Intmap.length !CommonUploads.pending_slots_map); -- -- - end -- -- -+ end; -+ "" - ), ":\t\t\t\tshow users currently uploading"; - - -@@ -2504,7 +2579,7 @@ - "yes" | "y" | "true" -> - List.iter (fun file -> - try -- file_cancel file -+ file_cancel file o.conn_user.ui_user - with e -> - lprintf "Exception %s in cancel file %d\n" - (Printexc2.to_string e) (file_num file) -@@ -2541,7 +2616,7 @@ - if not (List.memq num !to_cancel) then - to_cancel := num :: !to_cancel - in -- if args = ["all"] then -+ if args = ["all"] && user2_is_admin o.conn_user.ui_user then - List.iter (fun file -> - file_cancel file - ) !!files -@@ -2585,7 +2660,7 @@ - List.iter - (fun file -> - if (CommonFile.file_downloaders file o !counter) then counter := 0 else counter := 1; -- ) !!files; -+ ) (user2_filter_files !!files o.conn_user.ui_user); - - if use_html_mods o then Printf.bprintf buf "\\</table\\>\\</div\\>"; - -@@ -2611,35 +2686,46 @@ - ), "<num> :\t\t\tverify chunks of file <num>"; - - "pause", Arg_multiple (fun args o -> -- if args = ["all"] then -+ if args = ["all"] && user2_is_admin o.conn_user.ui_user then - List.iter (fun file -> -- file_pause file; -+ file_pause file admin_user; - ) !!files - else - List.iter (fun num -> - let num = int_of_string num in - List.iter (fun file -> -- if (as_file_impl file).impl_file_num = num then begin -- file_pause file -- end -+ 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)"; - - "resume", Arg_multiple (fun args o -> -- if args = ["all"] then -+ if args = ["all"] && user2_is_admin o.conn_user.ui_user then - List.iter (fun file -> -- file_resume file -+ file_resume file admin_user - ) !!files - else - List.iter (fun num -> - let num = int_of_string num in - List.iter (fun file -> -- if (as_file_impl file).impl_file_num = num then begin -- file_resume file -- end -+ 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)"; - -+ "release", Arg_one (fun arg o -> -+ let num = int_of_string arg in -+ let file = file_find num in -+ let old_state = file_release file in -+ set_file_release file (not (file_release file)) o.conn_user.ui_user; -+ Printf.sprintf "%s, file: %s" -+ (match old_state, file_release file with -+ true, false -> "deactivated release state" -+ | false, true -> "activated release state" -+ | _ -> "unchanged status, enough rights?") -+ (shorten (file_best_name file) !!max_name_len) -+ ), "<num> :\t\t\t\tchange release state of a download"; -+ - "commit", Arg_none (fun o -> - List.iter (fun file -> - file_commit file -@@ -2655,20 +2741,19 @@ - - "vd", Arg_multiple (fun args o -> - let buf = o.conn_buf in -+ let list = user2_filter_files !!files o.conn_user.ui_user in -+ let filelist = List2.tail_map file_info list in - match args with - | ["queued"] -> -- let list = List2.tail_map file_info !!files in -- let list = List.filter ( fun f -> f.file_state = FileQueued ) list in -+ let list = List.filter ( fun f -> f.file_state = FileQueued ) filelist in - DriverInteractive.display_active_file_list buf o list; - "" - | ["paused"] -> -- let list = List2.tail_map file_info !!files in -- let list = List.filter ( fun f -> f.file_state = FilePaused ) list in -+ let list = List.filter ( fun f -> f.file_state = FilePaused ) filelist in - DriverInteractive.display_active_file_list buf o list; - "" - | ["downloading"] -> -- let list = List2.tail_map file_info !!files in -- let list = List.filter ( fun f -> f.file_state = FileDownloading ) list in -+ let list = List.filter ( fun f -> f.file_state = FileDownloading ) filelist in - DriverInteractive.display_file_list buf o list; - "" - | [arg] -> -@@ -2696,15 +2781,14 @@ - List.iter - (fun file -> if (as_file_impl file).impl_file_num = num then - CommonFile.file_print file o) -- !!files; -+ list; - List.iter - (fun file -> if (as_file_impl file).impl_file_num = num then - CommonFile.file_print file o) - !!done_files; - "" - | _ -> -- let list = List2.tail_map file_info !!files in -- DriverInteractive.display_file_list buf o list; -+ DriverInteractive.display_file_list buf o filelist; - "" - ), "[<num>|queued|paused|downloading] :\t$bview file info for download <num>, or lists of queued, paused or downloading files, or all downloads if no argument given$n"; - -@@ -2726,14 +2810,15 @@ - ), "<num> \"<new name>\" :\t\tchange name of download <num> to <new name>"; - - "filenames_variability", Arg_none (fun o -> -- let list = List2.tail_map file_info !!files in -+ let list = List2.tail_map file_info -+ (user2_filter_files !!files o.conn_user.ui_user) in - DriverInteractive.filenames_variability o list; - _s "done" - ), ":\t\t\ttell which files have several very different names"; - - "dllink", Arg_multiple (fun args o -> - let url = String2.unsplit args ' ' in -- dllink_parse (o.conn_output = HTML) url -+ dllink_parse (o.conn_output = HTML) url o.conn_user.ui_user - ), "<link> :\t\t\t\tdownload ed2k, sig2dat, torrent or other link"; - - "dllinks", Arg_one (fun arg o -> -@@ -2741,7 +2826,7 @@ - let file = File.to_string arg in - let lines = String2.split_simplify file '\n' in - List.iter (fun line -> -- Buffer.add_string result (dllink_parse (o.conn_output = HTML) line); -+ Buffer.add_string result (dllink_parse (o.conn_output = HTML) line o.conn_user.ui_user); - Buffer.add_string result (if o.conn_output = HTML then "\\<P\\>" else "\n") - ) lines; - (Buffer.contents result) -@@ -2758,67 +2843,272 @@ - let _ = - register_commands "Driver/Users" [ - -- "useradd", Arg_multiple (fun args o -> -+ "useradd", Arg_two (fun user pass o -> - let buf = o.conn_buf in -- let print_result o result = -- if o.conn_output = HTML then -- html_mods_table_one_row buf "serversTable" "servers" [ -- ("", "srh", result); ] -- else -- Printf.bprintf buf "%s" result -- in -- let add_new_user user pass mail = -- if o.conn_user == default_user -- || o.conn_user == (find_ui_user user) then -- try -- ignore (user2_find user); -- ignore (user2_add user (Md4.string pass) ""); -- print_result o (Printf.sprintf "Password of user %s changed" user) -- with _ -> -- ignore (user2_add user (Md4.string pass) ""); -- print_result o (Printf.sprintf "User %s added" user) -+ 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) -+ end -+ else -+ begin -+ user2_user_add user (Md4.string pass) (); -+ print_command_result o buf (Printf.sprintf "User %s added" user) -+ end - else -- print_result o "Only 'admin' is allowed to add users" -- in begin -- match args with -- user :: pass :: mail :: _ -> -- add_new_user user pass mail -- | user :: pass :: _ -> -- add_new_user user pass ""; -- | _ -> print_result o "Wrong syntax: use 'useradd user pass <mail>'" -- end; -+ print_command_result o buf "You are not allowed to add users"; - _s "" -- ), "<user> <passwd> [<mail>] :\tadd new mldonkey user/change user password"; -+ ), "<user> <passwd> :\t\tadd new mldonkey user/change user password"; - - "userdel", Arg_one (fun user o -> - let buf = o.conn_buf in -- let print_result o result = -- if o.conn_output = HTML then -- html_mods_table_one_row buf "serversTable" "servers" [ -- ("", "srh", result); ] -+ 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" -+ 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 -+ (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) -+ with -+ Not_found -> print_command_result o buf (Printf.sprintf "User %s does not exist" user) - else -- Printf.bprintf buf "%s" result -+ print_command_result o buf "You are not allowed to remove users" -+ else -+ print_command_result o buf "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 -+ let u = user2_user_find user in -+ begin -+ 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) -+ end -+ with Not_found -> print_command_result o buf (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"; -+ _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 -+ try -+ let u = user2_user_find user in -+ begin -+ 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) -+ 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) -+ else -+ begin -+ let counter = ref 0 in -+ List.iter (fun f -> -+ if file_owner f = u && file_group f = Some g then -+ begin -+ incr counter; -+ set_file_group f u.user_default_group -+ 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" -+ 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) -+ end -+ with Not_found -> print_command_result o buf (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"; -+ _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 -+ try -+ let u = user2_user_find user in -+ begin -+ try -+ let g = if String.lowercase group = "none" then None else Some (user2_group_find group) in -+ let update_dgroup () = -+ match g with -+ None -> true -+ | Some g1 when List.mem g1 u.user_groups -> true -+ | _ -> false -+ in -+ 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)) -+ 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) -+ end -+ with Not_found -> print_command_result o buf (Printf.sprintf "User %s does not exist" user) -+ end -+ else -+ print_command_result o buf "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) -+ 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) -+ end -+ else print_command_result o buf "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) -+ end -+ else print_command_result o buf "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) -+ end -+ else print_command_result o buf "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 -+ with _ -> false - in -- if o.conn_user == default_user then -- if user = admin_user then -- print_result o "User 'admin' can not be removed" -+ 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) - else -- try -- ignore (user2_find user); -- ignore (user2_remove user); -- print_result o (Printf.sprintf "User %s removed" user) -- with _ -> -- print_result o (Printf.sprintf "User %s not found" user) -+ begin -+ user2_group_add group g_admin; -+ print_command_result o buf (Printf.sprintf "Group %s added" group) -+ end - else -- print_result o "Only 'admin' is allowed to remove users"; -+ print_command_result o buf "You are not allowed to add a group"; - _s "" -- ), "<user> :\t\t\tremove a mldonkey user"; -+ ), "<group> <admin: true | false>: add 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 -+ let g = user2_group_find group in -+ 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 -+ (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 -+ (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) -+ else -+ begin -+ user2_group_remove g; -+ print_command_result o buf (Printf.sprintf "Removed group %s" group) -+ end -+ with Not_found -> print_command_result o buf (Printf.sprintf "Group %s does not exist" group) -+ end -+ else -+ print_command_result o buf "You are not allowed to remove users"; -+ _s "" -+ ), "<group> :\t\t\tremove an unused mldonkey group"; - -- "users", Arg_none (fun o -> -- if o.conn_user == default_user then -+ "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) -+ 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) -+ end -+ with Not_found -> print_command_result o buf (Printf.sprintf "Group %s does not exist" group) -+ end -+ else -+ print_command_result o buf "You are not allowed to change group admin status"; -+ _s "" -+ ), "<group> <true|false> :\tchange group admin status"; - -+ "users", Arg_none (fun o -> - let buf = o.conn_buf in -+ if user2_is_admin o.conn_user.ui_user then begin - - if use_html_mods o then begin - Printf.bprintf buf "\\<div class=\\\"shares\\\"\\>\\<table class=main cellspacing=0 cellpadding=0\\> -@@ -2831,55 +3121,269 @@ - var outstr = getdir.replace(reg, '+'); - parent.fstatus.location.href='submit?q=useradd+' + outstr; - setTimeout('window.location.reload()',1000); -- }\\\"\\>Add User\\</a\\> --\\</td\\> --\\</tr\\>\\</table\\> --\\</td\\>\\</tr\\> --\\<tr\\>\\<td\\>"; -+ }\\\"\\>Add user\\</a\\> -+\\</td\\>\\</tr\\>\\</table\\>\\</td\\>\\</tr\\>\\<tr\\>\\<td\\>"; - - html_mods_table_header buf "sharesTable" "shares" [ - ( "0", "srh ac", "Click to remove user", "Remove" ) ; -- ( "0", "srh", "User", "Username" ) ]; -+ ( "0", "srh", "Username", "User" ) ; -+ ( "0", "srh ac", "Only member of admin groups have admin rights", "Admin" ) ; -+ ( "0", "srh", "Member of groups", "Groups" ) ; -+ ( "0", "srh", "Default group", "Default group" ) ; -+ ( "0", "srh", "Mail address", "Email" ) ; -+ ( "0", "srh", "Commit dir", "Commit dir" ) ; -+ ( "0", "srh ar", "Download quota", "Max DLs" ) ; -+ ( "0", "srh ar", "Download count", "DLs" ) ]; - - let counter = ref 0 in -- -- user2_iter (fun name user -> -+ 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"); -- if user.user_name <> admin_user then Printf.bprintf buf " -- \\<td title=\\\"Click to remove user\\\" -- onMouseOver=\\\"mOvr(this);\\\" -- onMouseOut=\\\"mOut(this);\\\" -- onClick=\\\'javascript:{ -- parent.fstatus.location.href=\\\"submit?q=userdel+\\\\\\\"%s\\\\\\\"\\\"; -- setTimeout(\\\"window.location.reload()\\\",1000);}' -- class=\\\"srb\\\"\\>Remove\\</td\\>" user.user_name -- else Printf.bprintf buf " -- \\<td title=\\\"\\\" -- class=\\\"srb\\\"\\>------\\</td\\>"; -- Printf.bprintf buf -- "\\<td class=\\\"sr\\\"\\>%s\\</td\\>\\</tr\\>" user.user_name -+ if user <> admin_user && (u_dls = 0) then Printf.bprintf buf -+"\\<td title=\\\"Click to remove user\\\" -+onMouseOver=\\\"mOvr(this);\\\" -+onMouseOut=\\\"mOut(this);\\\" -+onClick=\\\'javascript:{ -+parent.fstatus.location.href=\\\"submit?q=userdel+\\\\\\\"%s\\\\\\\"\\\"; -+setTimeout(\\\"window.location.reload()\\\",1000);}' -+class=\\\"srb\\\"\\>Remove\\</td\\>" user.user_name -+ else Printf.bprintf buf -+"\\<td title=\\\"%s\\\" -+class=\\\"srb\\\"\\>------\\</td\\>" -+ (if user.user_name = admin_user.user_name then "Admin user can not be removed" else -+ if u_dls <> 0 then Printf.sprintf "User has %d download%s" u_dls -+ (Printf2.print_plural_s u_dls) else ""); -+ html_mods_td buf [ -+ ("", "sr", user.user_name); -+ ("", "sr ac", Printf.sprintf "%b" (user2_is_admin user)); -+ ("Click to remove group", "sr", -+ let buf1 = Buffer.create 100 in -+ user2_user_groups_iter user (fun group -> -+ if user2_default_group_matches_group user.user_default_group group then -+ Printf.bprintf buf1 "%s " group.group_name -+ else -+ Printf.bprintf buf1 -+"\\<a onMouseOver=\\\"mOvr(this);\\\" -+onMouseOut=\\\"mOut(this);\\\" -+onClick=\\\'javascript:{ -+parent.fstatus.location.href=\\\"submit?q=usergroupdel+\\\\\\\"%s\\\\\\\"+\\\\\\\"%s\\\\\\\"\\\"; -+setTimeout(\\\"window.location.reload()\\\",1000);}' -+class=\\\"srb\\\"\\>%s\\</a\\> " user.user_name group.group_name group.group_name -+ ); -+ Buffer.contents buf1); -+ ("", "sr", user2_print_user_default_group user); -+ ("", "sr", user.user_mail); -+ ("", "sr", user.user_commit_dir); -+ ("", "sr ar", user2_print_user_dls user); -+ ("", "sr ar", string_of_int u_dls)]; - ); -+ Printf.bprintf buf "\\</table\\>\\</td\\>\\<tr\\>\\</table\\>\\</div\\>\\<P\\>"; -+ print_option_help o userlist; -+ Printf.bprintf buf "\\<P\\>"; -+ -+ 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 pr\\\"\\>\\<a onclick=\\\"javascript: { -+ var getdir = prompt('Input: <group> <admin: true|false> [<mail>]','group true') -+ var reg = new RegExp (' ', 'gi') ; -+ var outstr = getdir.replace(reg, '+'); -+ parent.fstatus.location.href='submit?q=groupadd+' + outstr; -+ setTimeout('window.location.reload()',1000); -+ }\\\"\\>Add group\\</a\\> -+\\</td\\>\\</tr\\>\\</table\\>\\</td\\>\\</tr\\>\\<tr\\>\\<td\\>"; -+ -+ html_mods_table_header buf "sharesTable" "shares" [ -+ ( "0", "srh ac", "Click to remove group", "Remove" ); -+ ( "0", "srh", "Groupname", "Group" ); -+ ( "0", "srh ac", "Click to change status", "Admin" ); -+ ( "0", "srh ar", "Member count", "Mem" ); -+ ( "0", "srh ar", "Download count", "DLs" ) ]; -+ -+ html_mods_cntr_init (); -+ user2_groups_iter (fun group -> -+ let g_dls = user2_num_group_dls group in -+ let g_mem = user2_num_group_members group in -+ let is_sys_group = group.group_name = system_user_default_group.group_name in -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); -+ if g_dls = 0 && g_mem = 0 && not is_sys_group then Printf.bprintf buf -+"\\<td title=\\\"Click to remove group\\\" -+onMouseOver=\\\"mOvr(this);\\\" onMouseOut=\\\"mOut(this);\\\" onClick=\\\'javascript:{ -+parent.fstatus.location.href=\\\"submit?q=groupdel+\\\\\\\"%s\\\\\\\"\\\"; -+setTimeout(\\\"window.location.reload()\\\",1000);}' -+class=\\\"srb\\\"\\>Remove\\</td\\>" group.group_name -+ else -+ Printf.bprintf buf "\\<td title=\\\"%s\\\" class=\\\"srb\\\"\\>------\\</td\\>" -+ (if g_dls <> 0 then Printf.sprintf "Group is assigned to %d download%s" -+ g_dls (Printf2.print_plural_s g_dls) else -+ if g_mem <> 0 then Printf.sprintf "Group has %d member%s" -+ g_mem (Printf2.print_plural_s g_mem) else -+ if is_sys_group then "System group can not be removed" else ""); -+ -+ html_mods_td buf [("", "sr", group.group_name)]; -+ -+ if is_sys_group then -+ html_mods_td buf [("System group, can not change state", "sr ac", Printf.sprintf "%b" group.group_admin)] -+ else Printf.bprintf buf -+"\\<td title=\\\"Change admin status\\\" -+onMouseOver=\\\"mOvr(this);\\\" onMouseOut=\\\"mOut(this);\\\" onClick=\\\'javascript:{ -+parent.fstatus.location.href=\\\"submit?q=groupadmin+\\\\\\\"%s\\\\\\\"+\\\\\\\"%s\\\\\\\"\\\"; -+setTimeout(\\\"window.location.reload()\\\",1000);}' -+class=\\\"sr ac\\\"\\>%s\\</td\\>" -+ group.group_name -+ (if group.group_admin then "false" else "true") -+ (if group.group_admin then "true" else "false"); - -- Printf.bprintf buf "\\</table\\>\\</td\\>\\<tr\\>\\</table\\>\\</div\\>"; -+ html_mods_td buf [ -+ ("", "sr ar", Printf.sprintf "%d" (user2_num_group_members group)); -+ ("", "sr ar", Printf.sprintf "%d" g_dls); -+ ]); -+ -+ Printf.bprintf buf "\\</table\\>\\</td\\>\\<tr\\>\\</table\\>\\</div\\>\\<P\\>"; -+ print_option_help o grouplist; -+ Printf.bprintf buf "\\<P\\>"; -+ -+ Buffer.add_string buf "\\<div class=\\\"cs\\\"\\>"; -+ html_mods_table_header buf "helpTable" "results" []; -+ Buffer.add_string buf "\\<tr\\>"; -+ html_mods_td buf [ -+ ("", "srh", ""); -+ ("", "srh", "Commands to manipulate user data"); -+ ("", "srh", ""); ]; -+ Buffer.add_string buf "\\</tr\\>"; -+ html_mods_cntr_init (); -+ let list = Hashtbl2.to_list2 commands_by_kind in -+ let list = List.sort (fun (s1,_) (s2,_) -> compare s1 s2) list in -+ List.iter (fun (s,list) -> -+ if s = "Driver/Users" then -+ let list = List.sort (fun (s1,_) (s2,_) -> compare s1 s2) !list in -+ List.iter (fun (cmd, help) -> -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); -+ html_mods_td buf [ -+ ("", "sr", "\\<a href=\\\"submit?q=" ^ cmd ^ -+ "\\\"\\>" ^ cmd ^ "\\</a\\>"); -+ ("", "srw", Str.global_replace (Str.regexp "\n") "\\<br\\>" help); -+ ("", "sr", "\\<a href=\\\"http://mldonkey.sourceforge.net/" ^ (String2.upp_initial cmd) ^ -+ "\\\"\\>wiki\\</a\\>"); ]; -+ Printf.bprintf buf "\\</tr\\>\n" -+ ) list -+ ) list - end -- else -- begin -- Printf.bprintf buf "Users:\n"; -- user2_iter (fun name user -> -- Printf.bprintf buf " %s\n" -- user.user_name); -- end; -- "" -- else -- _s "Only 'admin' is allowed to list users" -- ), ":\t\t\t\t\tprint users"; -+ else begin -+ let list = ref [] in -+ user2_users_iter (fun user -> list := [| -+ user.user_name; -+ Printf.sprintf "%b" (user2_is_admin user); -+ (user2_print_user_groups " " user); -+ (user2_print_user_default_group user); -+ user.user_mail; -+ user.user_commit_dir; -+ (user2_print_user_dls user); -+ (string_of_int (user2_num_user_dls user)); -+ |] :: !list ); -+ print_table_text buf -+ [| -+ Align_Left; Align_Left; Align_Left; Align_Left; Align_Left; Align_Left; Align_Right; Align_Right |] -+ [| -+ "User"; -+ "Admin"; -+ "Groups"; -+ "Dgroup"; -+ "Email"; -+ "Commit dir"; -+ "Max dls"; -+ "Dls"; -+ |] (List.rev !list); -+ Printf.bprintf buf "\n"; -+ let list = ref [] in -+ user2_groups_iter (fun group -> list := [| -+ group.group_name; -+ Printf.sprintf "%b" group.group_admin; -+ (string_of_int (user2_num_group_members group)); -+ (string_of_int (user2_num_group_dls group)); -+ |] :: !list ); -+ print_table_text buf -+ [| -+ Align_Left; Align_Left; Align_Right; Align_Right |] -+ [| -+ "Group"; -+ "Admin"; -+ "Members"; -+ "Downloads"; -+ |] (List.rev !list); -+ end -+ end else print_command_result o buf "You are not allowed to list users"; -+ _s "" -+ ), "\t\t\t\t\tprint users"; - - "whoami", Arg_none (fun o -> -- print_command_result o o.conn_buf o.conn_user.ui_user_name; -+ print_command_result o o.conn_buf o.conn_user.ui_user.user_name; - _s "" - ), "\t\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); -+ _s "" -+ ), "\t\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); -+ _s "" -+ ), "\t\t\t\t\tprint default group of logged-in user"; -+ -+ "chgrp", Arg_two (fun group filenum o -> -+ let num = int_of_string filenum in -+ begin try -+ 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) -+ end -+ else -+ begin -+ try -+ let g = user2_group_find group in -+ if user2_allow_file_admin file o.conn_user.ui_user && -+ 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) -+ 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) -+ end -+ with Not_found -> print_command_result o o.conn_buf (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"; -+ -+ "chown", Arg_two (fun user filenum o -> -+ let num = int_of_string filenum in -+ begin -+ try -+ let file = file_find num in -+ begin -+ try -+ let u = user2_user_find user in -+ 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) -+ 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) -+ end -+ with Not_found -> print_command_result o o.conn_buf (Printf.sprintf (_b "File %d not found") num) -+ end; -+ _s "" -+ ), "<user> <num> :\t\t\tchange owner of download <num> to <user>"; -+ - ] - - -@@ -3021,7 +3525,6 @@ - html_mods =:= true; - html_mods_style =:= 0; - commands_frame_height =:= CommonMessages.styles.(!!html_mods_style).frame_height; -- use_html_frames =:= true; - CommonMessages.colour_changer() ; - end; - -@@ -3039,7 +3542,6 @@ - end - else begin - html_mods =:= true; -- use_html_frames =:= true; - html_mods_theme =:= ""; - let num = int_of_string (List.hd args) in - -@@ -3130,8 +3632,7 @@ - "" - end - else begin --(* html_mods =:= true; -- use_html_frames =:= true; *) -+(* html_mods =:= true; *) - html_mods_theme =:= List.hd args; - "\\<script type=\\\"text/javascript\\\"\\>top.window.location.reload();\\</script\\>" - end -Index: src/daemon/driver/driverControlers.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverControlers.ml,v -retrieving revision 1.85 -retrieving revision 1.93 -diff -u -r1.85 -r1.93 ---- src/daemon/driver/driverControlers.ml 12 Sep 2006 22:47:11 -0000 1.85 -+++ src/daemon/driver/driverControlers.ml 19 Nov 2006 23:03:42 -0000 1.93 -@@ -310,7 +310,7 @@ - let user, pass = - match args with - [] -> failwith "Usage: auth <user> <password>" -- | [s1] -> admin_user, s1 -+ | [s1] -> admin_user.CommonTypes.user_name, s1 - | user :: pass :: _ -> user, pass - in - if valid_password user pass then begin -@@ -320,7 +320,7 @@ - let module M = CommonMessages in - Buffer.add_string buf M.full_access; - (match DriverInteractive.real_startup_message () with -- Some s -> Buffer.add_string buf s; -+ Some s -> Buffer.add_string buf ("\n" ^ s); - | None -> ()); - end else - let module M = CommonMessages in -@@ -581,7 +581,7 @@ - "telnet connection" - s in - let telnet = { -- telnet_auth = ref (empty_password admin_user); -+ telnet_auth = ref (has_empty_password admin_user); - telnet_iac = false; - telnet_wait = 0; - telnet_buffer = Buffer.create 100; -@@ -775,14 +775,6 @@ - really_input file s 0 size; - s) - --let add_simple_commands buf = -- let this_page = "commands.html" in -- Buffer.add_string buf ( -- if !!html_mods_theme != "" && theme_page_exists this_page then -- read_theme_page this_page else -- if !!html_mods then !!CommonMessages.web_common_header_mods0 -- else !!CommonMessages.web_common_header_old) -- - let http_add_gen_header r = - add_reply_header r "Server" "MLdonkey"; - add_reply_header r "Connection" "close" -@@ -883,9 +875,7 @@ - else !!CommonMessages.html_header_old); - - Buffer.add_string buf "</head>\n"; -- if open_body then Buffer.add_string buf "<body>\n"; -- if not !!use_html_frames then add_simple_commands buf; -- () -+ if open_body then Buffer.add_string buf "<body>\n" - - let html_close_page buf close_body = - if close_body then Buffer.add_string buf "</body>\n"; -@@ -955,12 +945,18 @@ - List.iter (fun (arg, value) -> Printf.bprintf b " %s %s" arg value) r.get_url.Url.args; - if Buffer.contents b <> "" then Printf.sprintf "(%s)" (Buffer.contents b) else ""); - -- let user = if r.options.login = "" then admin_user else r.options.login in -+ let user = if r.options.login = "" then admin_user.CommonTypes.user_name else r.options.login in - if not (valid_password user r.options.passwd) then begin - clear_page buf; - http_file_type := HTM; -- Buffer.add_string buf (snd(Http_server.error_page "401" "" "" (Ip.to_string (TcpBufferedSocket.my_ip r.sock)) (string_of_int !!http_port) None)); -- need_auth r !!http_realm -+ let _, error_text_long, header = Http_server.error_page "401" "" "" -+ (Ip.to_string (TcpBufferedSocket.my_ip r.sock)) -+ (string_of_int !!http_port) None in -+ Buffer.add_string buf error_text_long; -+ r.reply_head <- header; -+ r.reply_headers <- [ -+ "Connection", "close"; -+ "WWW-Authenticate", Printf.sprintf "Basic realm=\"%s\"" !!http_realm] - end - else - begin -@@ -1000,15 +996,15 @@ - "VDC" -> - let num = int_of_string value in - let file = file_find num in -- file_cancel file -+ file_cancel file o.conn_user.ui_user - | "VDP" -> - let num = int_of_string value in - let file = file_find num in -- file_pause file -+ file_pause file o.conn_user.ui_user - | "VDR" -> - let num = int_of_string value in - let file = file_find num in -- file_resume file -+ file_resume file o.conn_user.ui_user - | _ -> () - ) r.get_url.Url.args; - -@@ -1048,7 +1044,6 @@ - if !!html_mods then !!CommonMessages.multidllink_mods0 - else !!CommonMessages.multidllink_old) - | "" | "index.html" -> -- if !!use_html_frames then begin - html_open_page buf t r false; - let this_page = "frames.html" in - if !!html_mods_theme != "" && theme_page_exists this_page then -@@ -1079,9 +1074,7 @@ - </frameset> - <frame name=\"output\" src=\"oneframe.html\"> - </frameset> --" !!commands_frame_height; -- end else -- html_open_page buf t r true -+" !!commands_frame_height - | "complex_search.html" -> - html_open_page buf t r true; - CommonSearch.complex_search buf -@@ -1093,7 +1086,7 @@ - Buffer.add_string buf (Printf.sprintf "<br><div align=\"center\"><h3>%s %s</h3></div>" - (Printf.sprintf (_b "Welcome to MLDonkey")) Autoconf.current_version); - if !!motd_html <> "" then Buffer.add_string buf !!motd_html; -- if user2_is_admin o.conn_user.ui_user_name then -+ if user2_is_admin o.conn_user.ui_user then - (match DriverInteractive.real_startup_message () with - Some s -> Buffer.add_string buf (Printf.sprintf "<p><pre><b><h3>%s</b></h3></pre>" s); - | None -> ()) -@@ -1265,7 +1258,7 @@ - try - let num = int_of_string value in - let r = find_result num in -- let files = result_download r [] false in -+ let files = result_download r [] false o.conn_user.ui_user in - List.iter CommonInteractive.start_download files; - - let module M = CommonMessages in -@@ -1285,15 +1278,23 @@ - "cancel" -> - let num = int_of_string value in - let file = file_find num in -- file_cancel file -+ file_cancel file o.conn_user.ui_user - | "pause" -> - let num = int_of_string value in - let file = file_find num in -- file_pause file -+ file_pause file o.conn_user.ui_user - | "resume" -> - let num = int_of_string value in - let file = file_find num in -- file_resume file -+ file_resume file o.conn_user.ui_user -+ | "release" -> -+ let num = int_of_string value in -+ let file = file_find num in -+ set_file_release file true o.conn_user.ui_user -+ | "norelease" -> -+ let num = int_of_string value in -+ let file = file_find num in -+ set_file_release file false o.conn_user.ui_user - | "sortby" -> - begin - match value with -@@ -1313,13 +1314,15 @@ - | "N" -> o.conn_sortvd <- ByNet - | "Avail" -> o.conn_sortvd <- ByAvail - | "Cm" -> o.conn_sortvd <- ByComments -+ | "User" -> o.conn_sortvd <- ByUser -+ | "Group" -> o.conn_sortvd <- ByGroup - | _ -> () - end - | _ -> () - ) r.get_url.Url.args; - let b = Buffer.create 10000 in - -- let list = (List2.tail_map file_info !!files) in -+ let list = List2.tail_map file_info (user2_filter_files !!files o.conn_user.ui_user) in - DriverInteractive.display_file_list b o list; - html_open_page buf t r true; - Buffer.add_string buf (html_escaped (Buffer.contents b)) -@@ -1331,9 +1334,10 @@ - | [ "jvcmd", "multidllink" ; "links", links] -> - html_open_page buf t r true; - List.iter (fun url -> -- if url <> "\013" && url <> "" then -+ let url = fst (String2.cut_at url '\013') in -+ if url <> "" then - begin -- Buffer.add_string buf (html_escaped (dllink_parse (o.conn_output = HTML) url)); -+ Buffer.add_string buf (html_escaped (dllink_parse (o.conn_output = HTML) url o.conn_user.ui_user)); - Buffer.add_string buf (html_escaped "\\<P\\>") - end - ) (String2.split links '\n') -@@ -1388,7 +1392,7 @@ - - | [ "setoption", _ ; "option", name; "value", value ] -> - html_open_page buf t r true; -- if (o.conn_user == default_user) || !!enable_user_config then -+ if user2_is_admin o.conn_user.ui_user then - begin - CommonInteractive.set_fully_qualified_options name value; - Buffer.add_string buf "Option value changed" -@@ -1489,11 +1493,34 @@ - read_theme_page this_page else - if !!html_mods then !!CommonMessages.download_html_js_mods0 - else !!CommonMessages.download_html_js_old) -- | cmd -> -- html_open_page buf t r true; -- Printf.bprintf buf "No page named %s" (html_escaped cmd) -+ | "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 -> Printf.bprintf buf "404 Not found" -+ | Not_found -> -+ let _, error_text_long, header = Http_server.error_page "404" "" "" -+ (Ip.to_string (TcpBufferedSocket.my_ip r.sock)) -+ (string_of_int !!http_port) -+ (Some (Url_not_found r.get_url.Url.full_file)) in -+ r.reply_head <- header; -+ Buffer.add_string buf error_text_long - | e -> - Printf.bprintf buf "\nException %s\n" (Printexc2.to_string e); - r.reply_stream <- None -@@ -1501,11 +1528,11 @@ - - let s = - match !http_file_type with -- HTM -> html_close_page buf false; dollar_escape o !!use_html_frames (Buffer.contents buf) -- | MLHTM -> html_close_page buf true; dollar_escape o !!use_html_frames (Buffer.contents buf) -+ HTM -> html_close_page buf false; dollar_escape o true (Buffer.contents buf) -+ | MLHTM -> html_close_page buf true; dollar_escape o true (Buffer.contents buf) - | TXT -+ | UNK - | BIN -> Buffer.contents buf -- | UNK -> "Unknown type for content :" ^ (Buffer.contents buf) - in - r.reply_content <- - if !http_file_type <> BIN && !!html_use_gzip then -Index: src/daemon/driver/driverGraphics_gd.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverGraphics_gd.ml,v -retrieving revision 1.1 -retrieving revision 1.2 -diff -u -r1.1 -r1.2 ---- src/daemon/driver/driverGraphics_gd.ml 25 Jan 2006 22:44:08 -0000 1.1 -+++ src/daemon/driver/driverGraphics_gd.ml 14 Nov 2006 11:23:11 -0000 1.2 -@@ -47,14 +47,6 @@ - - module Graphics : Graphics = struct - --(* some thoughts --type gfx_settings = { -- win_x : int; -- win_y : int; -- vtext : string; -- } --*) -- - (* some defs *) - let reverse lst = - let rec reverseAux lst acc = -@@ -73,144 +65,146 @@ - | [x] -> x - | x::xs -> max x (maxlist xs) - -+(* set some vars *) - --(* set some vars *) --let samples_time = 5 --let samples_h_time = 720 -+let history_time = history_size * history_step -+let history_h_time = history_h_size * history_h_step -+ -+(* define margins *) -+let left_margin = 20 -+let right_margin = 45 -+let top_margin = 16 -+let bottom_margin = 24 - - (* set _x and _y with boundaries *) --let tag_x() = if !!html_mods_vd_gfx_tag_x_size < 130 then 130 -- else if !!html_mods_vd_gfx_tag_x_size > 3600 then 3600 -- else !!html_mods_vd_gfx_tag_x_size --let tag_y() = if !!html_mods_vd_gfx_tag_y_size < 50 then 50 -- else if !!html_mods_vd_gfx_tag_y_size > 1200 then 1200 -- else !!html_mods_vd_gfx_tag_y_size --let win_x() = if !!html_mods_vd_gfx_x_size < 320 then 320 -- else if !!html_mods_vd_gfx_x_size > 3600 then 3600 -- else !!html_mods_vd_gfx_x_size --let win_y() = if !!html_mods_vd_gfx_y_size < 200 then 200 -- else if !!html_mods_vd_gfx_y_size > 1200 then 1200 -- else !!html_mods_vd_gfx_y_size -- --let vtext = "0" --let x_divisions() = (win_x()) / 80 --let y_divisions() = (win_y()) / 30 --let x_fdivisions() = float_of_int (x_divisions()) --let y_fdivisions() = float_of_int (y_divisions()) -- --(* todo: limit to 4 max *) --let xmult = 1 --let xgmult = 16 --(* todo: limit to 4 max *) --let ymult = 1 --let xdivisions() = (x_divisions()) * xmult --let fxdivisions() = float_of_int (xdivisions()) --let xgdivisions() = (x_divisions()) * xgmult --let fxgdivisions() = float_of_int (xgdivisions()) --let ydivisions() = (y_divisions()) * ymult --let fydivisions() = float_of_int (ydivisions()) --let vmax_auto() = if detected_downlink_capacity () < detected_uplink_capacity () then -- (detected_uplink_capacity ()) -+let tag_x () = min (max 130 !!html_mods_vd_gfx_tag_x_size) 3600 -+let tag_y () = min (max 50 !!html_mods_vd_gfx_tag_y_size) 1200 -+let win_x () = min (max 365 !!html_mods_vd_gfx_x_size) 3665 -+let win_y () = min (max 200 !!html_mods_vd_gfx_y_size) 1200 -+ -+let round_down x = -+ let values = [120; 60; 30; 15; 12; 10; 6; 4; 3; 2; 1; 0] in -+ max 1 (List.find ((>=) x) values) -+ -+let round_up x = -+ let v = min x 120 in -+ let values = [0; 1; 2; 3; 4; 5; 10; 15; 30; 60; 120] in -+ List.find ((<=) v) values -+ -+let round_h_up x = -+ let v = min x 840 in -+ let values = [1; 2; 3; 4; 5; 10; 15; 30; 60; 120; 180; 240; 300; 360; 480; 720; 1440; 2880; 4320; 5760; 7200; 8640; 10080; 11520; 12960; 14400; 15840; 17280; 18720; 20160; 30240; 40320; 50400; 60480; 70560; 80640; 90720] in -+ List.find ((<=) v) values -+ -+let round_h_down x = -+ let values = [90720; 80640; 70560; 60480; 50400; 40320; 30240; 20160; 18720; 17280; 15840; 14400; 12960; 11520; 10080; 8640; 7200; 5760; 4320; 2880; 1440; 720; 480; 360; 300; 240; 180; 120; 60; 30; 15; 10; 5; 4; 3; 2; 1; 0] in -+ max 1 (List.find ((>=) x) values) -+ -+(* calculate x-values *) -+let x_time_per_grid() = 60 * round_up (history_time / (60 * ((win_x () - left_margin - right_margin) / 60))) -+let x_divisions () = history_time / (x_time_per_grid ()) -+let x_fdivisions () = float_of_int (x_divisions ()) -+ -+let x_h_time_per_grid g = max history_h_step ( -+ if !!html_mods_vd_gfx_h_dynamic then -+ begin -+ if !!html_mods_vd_gfx_h_grid_time >= 1 then -+ min (round_h_down (!!html_mods_vd_gfx_h_grid_time * 60)) -+ (min -+ ((round_h_up ((((Fifo.length g) + x_divisions () - 2) / (x_divisions())) * history_h_step/60 )) * 60) -+ ((round_h_down ( history_h_time / (60 * x_divisions()) )) * 60)) -+ else -+ min ((round_h_up ((((Fifo.length g) + x_divisions () - 2) / (x_divisions ())) * history_h_step / 60)) * 60) -+ ((round_h_down (history_h_time / (60 * x_divisions ()) )) * 60) -+ end - else -- (detected_downlink_capacity ()) -+ if !!html_mods_vd_gfx_h_grid_time >= 1 then -+ round_h_down (!!html_mods_vd_gfx_h_grid_time * 60) -+ else -+ round_h_down (history_h_time / (60 * x_divisions ()))) - - let vmax link = (detected_link_capacity link) - --let vx() = (fxgdivisions()) /. (x_fdivisions()) --let vy() = (((float_of_int(vmax_auto())) /. 1024.) +. 2.) /. (y_fdivisions()) --let vy_m link = (((float_of_int(vmax link)) /. 1024.) +. 2.) /. (y_fdivisions()) -+let x_h_time g = (x_divisions() * x_h_time_per_grid g) -+let x_h_values g = ((x_h_time g) / history_h_step) - --(* define margins *) --let left_margin = 20 --let right_margin = 45 --let top_margin = 16 --let bottom_margin = 20 -+(* calculate y-values *) -+let y_divisions () = ((win_y() - top_margin - bottom_margin)) / 50 * 2 -+let y_fdivisions () = float_of_int (y_divisions()) -+ -+let vmax_auto () = max (detected_uplink_capacity()) (detected_downlink_capacity()) - - let samples_size = win_x() - (left_margin + right_margin) - - let xbl = left_margin - let xbr() = win_x() - right_margin - let xbs() = xbr() - xbl --let ybt = top_margin --let ybb() = win_y() - bottom_margin -+let ybt = (top_margin / 2) * 2 -+let ybb() = ((win_y () - bottom_margin) / 2) * 2 - 1 - let ybs() = ybb() - ybt - let vdt() = float_of_int(ybs()) /. float_of_int(vmax_auto()) - let vdt_m link = float_of_int(ybs()) /. float_of_int(vmax link) --let vdt_stack link = float_of_int(ybs() / 2) /. float_of_int(vmax link) -+let vdt_stack link = float_of_int((ybs() / 2)-1) /. float_of_int(vmax link) - - let ttl = ref "" - let vl = ref "" - let hl = ref "" - --let graph_length g = -- if (Fifo.length g) < (xgdivisions()) then -- ((Fifo.length g) - 1) -- else -- (xgdivisions()) -- --let datas_length g = -- ((Fifo.length g)) -- --let l_max g = -- (List.fold_left max 0 (Fifo.to_list g)) -- --let datas = Array.create history_size 0 -- -+let l_max g = (List.fold_left max 0 (Fifo.to_list g)) - - let draw_borders mypic gcolor = -- let my_y = (ybb()) in -- let fx x = int_of_float ((((float_of_int x) /. (fxdivisions())) *. (float_of_int(xbs()))) +. (float_of_int xbl)) in -- let my_x = (xbr()) in -- let fy x = int_of_float ((((float_of_int x) /. (fydivisions())) *. (float_of_int(ybs()))) +. (float_of_int ybt)) in -- mypic#line ~x1:(fx 0) ~y1:ybt ~x2:(fx 0) ~y2:my_y gcolor; -- mypic#line ~x1:(fx (xdivisions())) ~y1:ybt ~x2:(fx (xdivisions())) ~y2:my_y gcolor; -- mypic#line ~x1:xbl ~y1:(fy 0) ~x2:my_x ~y2:(fy 0) gcolor; -- mypic#line ~x1:xbl ~y1:(fy (ydivisions())) ~x2:my_x ~y2:(fy (ydivisions())) gcolor -+ mypic#line ~x1:(xbl-1) ~y1:(ybt-1) ~x2:(xbl-1) ~y2:(ybb()+1) gcolor; -+ mypic#line ~x1:(xbr()+1) ~y1:(ybt-1) ~x2:(xbr()+1) ~y2:(ybb()+1) gcolor; -+ mypic#line ~x1:(xbl-1) ~y1:(ybt-1) ~x2:(xbr()+1) ~y2:(ybt-1) gcolor; -+ mypic#line ~x1:(xbl-1) ~y1:(ybb()+1) ~x2:(xbr()+1) ~y2:(ybb()+1) gcolor - - let draw_stack_borders mypic gcolor = -- let my_y = (ybb()) in -- let fx x = int_of_float ((((float_of_int x) /. (fxdivisions())) *. (float_of_int(xbs()))) +. (float_of_int xbl)) in -- let my_x = (xbr()) in -- let fy x = int_of_float ((((float_of_int x) /. (fydivisions())) *. (float_of_int(ybs()))) +. (float_of_int ybt)) in -- mypic#line ~x1:(fx 0) ~y1:ybt ~x2:(fx 0) ~y2:my_y gcolor; -- mypic#line ~x1:(fx (xdivisions())) ~y1:ybt ~x2:(fx (xdivisions())) ~y2:my_y gcolor; -- mypic#line ~x1:xbl ~y1:(fy 0) ~x2:my_x ~y2:(fy 0) gcolor; -- mypic#line ~x1:xbl ~y1:(fy (ydivisions())) ~x2:my_x ~y2:(fy (ydivisions())) gcolor; -- mypic#line ~x1:xbl ~y1:(my_y - ((my_y - ybt) / 2)) ~x2:my_x ~y2:(my_y - ((my_y - ybt) / 2)) gcolor -+ draw_borders mypic gcolor; -+ mypic#line ~x1:(xbl-1) ~y1:(ybt+ybs()/2) ~x2:(xbr()+1) ~y2:(ybt+ybs()/2) gcolor - --let draw_x_grid mypic gcolor = -+let draw_x_grid mypic gcolor gcolor2 my_xdivisons = -+ let my_sdivisions = max 1 !!html_mods_vd_gfx_subgrid in -+ let my_xsdivisons = xbs() / my_xdivisons / my_sdivisions in - let my_y = (ybb()) in -- let fx x = int_of_float ((((float_of_int x) /. (fxdivisions())) *. (float_of_int(xbs()))) +. (float_of_int xbl)) in -- for n = 1 to xdivisions() - 1 do -- mypic#dashed_line ~x1:(fx n) ~y1:ybt ~x2:(fx n) ~y2:my_y gcolor; -+ let fx x = (((x * xbs()) / my_xdivisons) + xbl + 2) in -+ let fxs x y = (fx x + my_xsdivisons * y) in -+ for n = 1 to my_xdivisons - 1 do -+ (*mypic#string ~font:Gd.Font.small ~x:(fx n) ~y:(2) ~s:(string_of_int (fx n)) gcolor;*) -+ mypic#dashed_line ~x1:(fx n) ~y1:(ybt) ~x2:(fx n) ~y2:my_y gcolor; -+ done; -+ if my_sdivisions > 1 then -+ for n = 0 to my_xdivisons - 1 do -+ for m = 1 to my_sdivisions - 1 do -+ mypic#dashed_line ~x1:(fxs n m) ~y1:(ybt) ~x2:(fxs n m) ~y2:my_y gcolor2; -+ done; - done - - let draw_y_grid mypic gcolor = -- let my_x = (xbr()) in -- let fy x = int_of_float ((((float_of_int x) /. (fydivisions())) *. (float_of_int(ybs()))) +. (float_of_int ybt)) in -- for n = 1 to ydivisions() - 1 do -- mypic#dashed_line ~x1:xbl ~y1:(fy n) ~x2:my_x ~y2:(fy n) gcolor; -- done -+ let fy x = (((x * ybs()) / y_divisions()) + ybt) in -+ for n = 1 to y_divisions() - 1 do -+ mypic#dashed_line ~x1:xbl ~y1:(fy n) ~x2:(xbr()) ~y2:(fy n) gcolor; -+ done - - let draw_arrow mypic gcolor = -- let my_x = (xbr()) in -- let my_y = (ybb()) in -+ let my_x = (xbr()+1) in -+ let my_y = (ybb()+1) in - mypic#line ~x1:(my_x - 4) ~y1:(my_y + 4) ~x2:(my_x + 4) ~y2:(my_y) gcolor; - mypic#line ~x1:(my_x - 4) ~y1:(my_y - 4) ~x2:(my_x + 4) ~y2:(my_y) gcolor; - mypic#line ~x1:(my_x - 4) ~y1:(my_y - 4) ~x2:(my_x - 4) ~y2:(my_y + 4) gcolor; - mypic#fill ~x:(my_x - 1) ~y:(my_y - 1) gcolor; -+ mypic#fill ~x:(my_x - 3) ~y:(my_y - 1) gcolor; - mypic#fill ~x:(my_x - 1) ~y:(my_y + 1) gcolor; - mypic#fill ~x:(my_x + 1) ~y:(my_y) gcolor - - let draw_tag mypic title gdown gup gcolor = - let my_sum gl = List.fold_left (+) 0 (Fifo.to_list gl) in -- let meanx gl = ((float_of_int (my_sum gl)) /. (float_of_int ((Fifo.length gl) - 1))) in -+ let meanx gl = ((float_of_int (my_sum gl)) /. (float_of_int (Fifo.length gl))) in - let down_bw = (string_of_float (float_of_int(int_of_float((meanx gdown) /. 1024. *. 100.)) /. 100.)) in - let up_bw = (string_of_float (float_of_int(int_of_float((meanx gup) /. 1024. *. 100.)) /. 100.)) in - let bw_d = "Dl: " ^ down_bw ^ "KB/s " - and bw_u = "Ul: " ^ up_bw ^ "KB/s" in - if !!html_mods_vd_gfx_tag_enable_title then -- mypic#string ~font:Gd.Font.giant ~x:!!html_mods_vd_gfx_tag_title_x_pos ~y:!!html_mods_vd_gfx_tag_title_y_pos ~s:title gcolor; -+ mypic#string ~font:Gd.Font.giant ~x:!!html_mods_vd_gfx_tag_title_x_pos ~y:!!html_mods_vd_gfx_tag_title_y_pos ~s:title gcolor; - mypic#string ~font:Gd.Font.giant ~x:!!html_mods_vd_gfx_tag_dl_x_pos ~y:!!html_mods_vd_gfx_tag_dl_y_pos ~s:bw_d gcolor; - mypic#string ~font:Gd.Font.giant ~x:!!html_mods_vd_gfx_tag_ul_x_pos ~y:!!html_mods_vd_gfx_tag_ul_y_pos ~s:bw_u gcolor - -@@ -218,16 +212,16 @@ - mypic#string_up ~font:Gd.Font.giant ~x:2 ~y:((win_y / 2) + (((String.length title) * 8) / 2)) ~s:title gcolor - - let draw_top_legend mypic title tcolor gcolor scolor win_y = -- mypic#line ~x1:(xbl + 1) ~y1:9 ~x2:(xbl + 11) ~y2:9 scolor; -+ mypic#line ~x1:xbl ~y1:9 ~x2:(xbl + 10) ~y2:9 scolor; - mypic#line ~x1:xbl ~y1:8 ~x2:(xbl + 10) ~y2:8 gcolor; - mypic#string ~font:Gd.Font.small ~x:(xbl + 16) ~y:2 ~s:title tcolor - - let draw_dual_top_legend mypic titlel tcolorl gcolorl scolorl titler tcolorr gcolorr scolorr win_y = - let my_x = (xbr()) in -- mypic#line ~x1:(xbl + 1) ~y1:9 ~x2:(xbl + 11) ~y2:9 scolorl; -+ mypic#line ~x1:xbl ~y1:9 ~x2:(xbl + 10) ~y2:9 scolorl; - mypic#line ~x1:xbl ~y1:8 ~x2:(xbl + 10) ~y2:8 gcolorl; - mypic#string ~font:Gd.Font.small ~x:(xbl + 16) ~y:2 ~s:titlel tcolorl; -- mypic#line ~x1:(my_x - 1) ~y1:9 ~x2:(my_x - 11) ~y2:9 scolorr; -+ mypic#line ~x1:my_x ~y1:9 ~x2:(my_x - 10) ~y2:9 scolorr; - mypic#line ~x1:my_x ~y1:8 ~x2:(my_x - 10) ~y2:8 gcolorr; - mypic#string ~font:Gd.Font.small ~x:(my_x - (((String.length titler) * 8)) - 2) ~y:2 ~s:titler tcolorr - -@@ -246,7 +240,7 @@ - let my_y = (ybb() - (ybs() / 2)) in - let fy x = int_of_float ((float_of_int my_y) -. (((float_of_int x) /. (y_fdivisions())) *. (float_of_int(ybs())))) in - let vtext n = (string_of_float (float_of_int(int_of_float((float_of_int (my_y - (fy n))) /. (vdt_stack g) /. 1024. *. 100.)) /. 100.)) in -- for n = 1 to ((y_divisions()) - 1) do -+ for n = 1 to ((y_divisions()) / 2) do - mypic#string ~font:Gd.Font.small ~x:(my_x + 5) ~y:((fy n) - 12 + offset) ~s:(vtext n) gcolor; - done; - mypic#string ~font:Gd.Font.small ~x:(my_x + 5) ~y:((fy (y_divisions())) - 5) ~s:(legend_text) lcolor -@@ -256,151 +250,145 @@ - let my_y = (ybb() - (ybs() / 2)) in - let fy x = int_of_float ((float_of_int my_y) +. (((float_of_int x) /. (y_fdivisions())) *. (float_of_int(ybs())))) in - let vtext n = (string_of_float (float_of_int(int_of_float((float_of_int ((fy n) - my_y)) /. (vdt_stack g) /. 1024. *. 100.)) /. 100.)) in -- for n = 1 to ((y_divisions()) - 1) do -- mypic#string ~font:Gd.Font.small ~x:(my_x + 5) ~y:((fy n) - 12 + offset) ~s:(vtext n) gcolor; -- done; -- mypic#string ~font:Gd.Font.small ~x:(my_x + 5) ~y:((fy (y_divisions())) - 5) ~s:(legend_text) lcolor -+ for n = 1 to ((y_divisions()) / 2) do -+ mypic#string ~font:Gd.Font.small ~x:(my_x + 5) ~y:((fy n) - 12 + offset) ~s:(vtext n) gcolor; -+ done; -+ mypic#string ~font:Gd.Font.small ~x:(my_x + 5) ~y:((fy (y_divisions())) - 5) ~s:(legend_text) lcolor - --let draw_h_legend mypic g legend_text gcolor my_time = -+let draw_h_legend mypic g legend_text gcolor my_time basetime show_days = - let my_x = (xbr()) in -- let my_x2 = (xbs()) in - let my_y = (ybb()) in -- let fx x = int_of_float((float_of_int my_x) -. (((float_of_int x) /. (x_fdivisions())) *. (float_of_int my_x2))) in -- (* and vtext n = (string_of_int (int_of_float((float_of_int(n))*. vx ))) in *) -- let basetime = Unix.gettimeofday () in -- let timer n = Unix.localtime (basetime -. ((float_of_int(n)) *. float_of_int(my_time) *. vx())) in -+ let fx x = my_x + 4 - (x * (xbs ()) / x_divisions ()) in - let time_string n = -- let time = timer n in -- let h0 = string_of_int(time.Unix.tm_hour ) and (* H *) -- m0 = string_of_int(time.Unix.tm_min ) and (* M *) -- s0 = string_of_int(time.Unix.tm_sec ) in (* S *) -- (if String.length h0 = 2 then h0 else "0"^h0) ^":"^ -- (if String.length m0 = 2 then m0 else "0"^m0) ^":"^ -- (if String.length s0 = 2 then s0 else "0"^s0) in -- -- for n = 1 to ((x_divisions()) - 1) do -- mypic#string ~font:Gd.Font.small ~x:((fx n) - ((String.length (time_string n) * 5) / 2)) ~y:(my_y + 5) ~s:(time_string n) gcolor; -- done; -- mypic#string ~font:Gd.Font.small ~x:((fx (x_divisions())) - ((String.length (legend_text) * 4) / 2)) ~y:(my_y + 5) ~s:(legend_text) gcolor -+ let time = Unix.localtime (basetime -. float_of_int(n * my_time / x_divisions ())) in -+ Printf.sprintf "%02d:%02d:%02d" time.Unix.tm_hour time.Unix.tm_min time.Unix.tm_sec -+ 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_mon time.Unix.tm_mday -+ in -+ if show_days then -+ begin -+ for n = 0 to (x_divisions() - 1) do -+ mypic#string ~font:Gd.Font.small ~x:((fx n) - (String.length (time_string n) * 3) ) ~y:(my_y + 1) ~s:(time_string n) gcolor; -+ mypic#string ~font:Gd.Font.small ~x:((fx n) - (String.length (day_string n) * 3) ) ~y:(my_y + 11) ~s:(day_string n) gcolor; -+ done; -+ mypic#string ~font:Gd.Font.small ~x:(4) ~y:(my_y + 2) ~s:(legend_text) gcolor; -+ mypic#string ~font:Gd.Font.small ~x:(4) ~y:(my_y + 11) ~s:("t(DD.MM.)") gcolor -+ end -+ else -+ begin -+ for n = 0 to (x_divisions() - 1) do -+ mypic#string ~font:Gd.Font.small ~x:((fx n) - (String.length (time_string n) * 3) ) ~y:(my_y + 5) ~s:(time_string n) gcolor; -+ done; -+ mypic#string ~font:Gd.Font.small ~x:(4) ~y:(my_y + 5) ~s:(legend_text) gcolor -+ end - --let draw_load mypic g my_color shadow_color = -+let draw_load mypic g my_color shadow_color my_samples = - let my_x = (xbr()) in -- let my_x2 = (xbs()) in - let my_y = (ybb()) in -+ let my_s = min ((Fifo.length g)-1) my_samples in -+ let my_s2 = xbs() / my_samples / 4 in - let datas g n = List.nth (List.rev (Fifo.to_list g)) n in -- let fx x = int_of_float((float_of_int my_x) -. (((float_of_int x) /. (fxgdivisions())) *. (float_of_int my_x2))) -+ let fx x = my_x - (x * (xbs ()) / my_samples) - and y_c1 n = (my_y - (int_of_float(float_of_int(datas g n) *. (vdt_m g)))) - and y_c2 n = (my_y - (int_of_float(float_of_int(datas g (n+1)) *. (vdt_m g)))) in - (if !!html_mods_vd_gfx_fill then begin -- mypic#line ~x1:(fx 0) ~y1:my_y -- ~x2:(fx 0) ~y2:(if y_c1 0 >= my_y - 3 then -- ((y_c1 0) - 3) else ((y_c1 0))) shadow_color; -- for n = 0 to ((graph_length(g)) - 1) do -- (* trick to make sure filling will not fail *) -- if n = ((graph_length(g)) - 1) then -- mypic#line ~x1:((fx n)) ~y1:(if y_c1 n >= my_y - 3 then -- ((y_c1 n) - 3) else ((y_c1 n))) ~x2:((fx (n+1))) ~y2:((y_c2 n)) shadow_color -- else begin -- mypic#line ~x1:((fx n)) ~y1:(if y_c1 n >= my_y - 3 then -- ((y_c1 n) - 3) else ((y_c1 n))) -- ~x2:((fx (n+1))) ~y2:(if y_c2 n >= my_y - 3 then -- ((y_c2 n) - 3) else ((y_c2 n))) shadow_color -- end -- done; -+ if my_s2 = 0 then -+ for n = 0 to my_s - 1 do -+ mypic#line ~x1:(fx n) ~y1:(min (my_y-1)(y_c1 n)) ~x2:(fx(n+1)) ~y2:(min (my_y-2)(y_c2 n)) shadow_color -+ done -+ else -+ for n = 0 to my_s - 1 do -+ mypic#line ~x1: (fx n) ~y1:(min (my_y - 1) (y_c1 n)) ~x2:((fx(n + 1)) + my_s2) ~y2:(min (my_y - 1) (y_c1 n)) shadow_color; -+ mypic#line ~x1:((fx(n + 1)) + my_s2) ~y1:(min (my_y - 1) (y_c1 n)) ~x2: (fx(n + 1)) ~y2:(min (my_y - 1) (y_c2 n)) shadow_color -+ done; -+ if (fx my_s) > (xbl + 1) then -+ mypic#line ~x1:(fx my_s) ~y1:(min (my_y - 1) (y_c1 my_s)) ~x2:(fx my_s) ~y2:(my_y) shadow_color; - mypic#fill ~x:(my_x - 1) ~y:(my_y - 1) my_color; - end - else begin -- for n = 0 to ((graph_length(g)) - 1) do -- mypic#line ~x1:((fx n) + 1) ~y1:((y_c1 n) + 1) ~x2:((fx (n+1)) + 1) ~y2:((y_c2 n) + 1) shadow_color; -- mypic#line ~x1:(fx n) ~y1:(y_c1 n) ~x2:(fx (n+1)) ~y2:(y_c2 n) my_color -- done; -+ if my_s2 = 0 then -+ for n = 0 to my_s - 1 do -+ mypic#line ~x1:((fx n)+1) ~y1:((y_c1 n)+1) ~x2:((fx (n+1))+1) ~y2:((y_c2 n)+1) shadow_color; -+ mypic#line ~x1:( fx n) ~y1:(y_c1 n) ~x2:( fx (n+1)) ~y2:(y_c2 n) my_color -+ done -+ else -+ for n = 0 to my_s - 1 do -+ mypic#line ~x1:((fx n) + 1) ~y1:((y_c1 n)+1) ~x2:((fx(n + 1)) + 1 + my_s2) ~y2:((y_c1 n) + 1) shadow_color; -+ mypic#line ~x1:((fx(n + 1)) + 1 + my_s2) ~y1:((y_c1 n)+1) ~x2:((fx(n + 1)) + 1) ~y2:((y_c2 n) + 1) shadow_color; -+ mypic#line ~x1: (fx n) ~y1: (y_c1 n) ~x2:((fx(n + 1)) + my_s2) ~y2: (y_c1 n) my_color; -+ mypic#line ~x1:((fx(n + 1)) + my_s2) ~y1: (y_c1 n) ~x2:( fx(n + 1)) ~y2: (y_c2 n) my_color -+ done; - end - ) - --let draw_stack_download mypic g my_color shadow_color = -+let draw_stack_download mypic g my_color shadow_color my_samples = - let my_x = (xbr()) in - let my_x2 = (xbs()) in -- let my_y = (ybb() - (ybs() / 2)) in -+ let my_y = (ybt -1 + (ybs() / 2)) in -+ let my_s = min ((Fifo.length g)-1) my_samples in - let datas g n = List.nth (List.rev (Fifo.to_list g)) n in -- let fx x = int_of_float((float_of_int my_x) -. (((float_of_int x) /. (fxgdivisions())) *. (float_of_int my_x2))) -- and y_c1 n = (my_y - (int_of_float(float_of_int(datas g n) *. (vdt_stack g)))) -- and y_c2 n = (my_y - (int_of_float(float_of_int(datas g (n+1)) *. (vdt_stack g)))) in -+ let fx x = my_x - (x * my_x2 / my_samples) and -+ y_c1 n = my_y - int_of_float(float_of_int(datas g n) *. (vdt_stack g)) and -+ y_c2 n = my_y - int_of_float(float_of_int(datas g (n+1)) *. (vdt_stack g)) -+ in - (if !!html_mods_vd_gfx_fill then begin -- mypic#line ~x1:(fx 0) ~y1:my_y -- ~x2:(fx 0) ~y2:(if y_c1 0 >= my_y - 3 then -- ((y_c1 0) - 3) else ((y_c1 0))) shadow_color; -- for n = 0 to ((graph_length(g)) - 1) do -- (* trick to make sure filling will not fail *) -- if n = ((graph_length(g)) - 1) then -- mypic#line ~x1:((fx n)) ~y1:(if y_c1 n >= my_y - 2 then -- ((y_c1 n) - 2) else ((y_c1 n))) ~x2:((fx (n+1))) ~y2:((y_c2 n)) shadow_color -- else begin -- mypic#line ~x1:((fx n)) ~y1:(if y_c1 n >= my_y - 2 then -- ((y_c1 n) - 2) else ((y_c1 n))) -- ~x2:((fx (n+1))) ~y2:(if y_c2 n >= my_y - 2 then -- ((y_c2 n) - 2) else ((y_c2 n))) shadow_color -- end -+ for n = 0 to my_s - 1 do -+ mypic#line ~x1:(fx n) ~y1:(min (my_y-1) (y_c1 n)) ~x2:(fx(n+1)) ~y2:(min (my_y-1) (y_c2 n)) shadow_color - done; -- mypic#fill ~x:(my_x - 1) ~y:(my_y - 1) my_color; -+ if (fx my_s) > (xbl+1) then -+ mypic#line ~x1:(fx my_s) ~y1:(my_y) ~x2:(fx my_s) ~y2:(min (my_y) (y_c1 my_s)) shadow_color; -+ mypic#fill ~x:(my_x) ~y:(my_y) my_color; - end - else begin -- for n = 0 to ((graph_length(g)) - 1) do -- mypic#line ~x1:((fx n) + 1) ~y1:((y_c1 n) + 1) ~x2:((fx (n+1)) + 1) ~y2:((y_c2 n) + 1) shadow_color; -+ for n = 0 to my_s - 1 do -+ mypic#line ~x1:((fx n)+1) ~y1:((y_c1 n)+1) ~x2:((fx (n+1))+1) ~y2:((y_c2 n)+1) shadow_color; - mypic#line ~x1:(fx n) ~y1:(y_c1 n) ~x2:(fx (n+1)) ~y2:(y_c2 n) my_color - done; - end - ) - --let draw_stack_upload mypic g my_color shadow_color = -+let draw_stack_upload mypic g my_color shadow_color my_samples = - let my_x = (xbr()) in - let my_x2 = (xbs()) in -- let my_y = (ybb() - (ybs() / 2)) in -+ let my_y = (ybt + 1 + (ybs() / 2)) in -+ let my_s = min ((Fifo.length g)-1) my_samples in - let datas g n = List.nth (List.rev (Fifo.to_list g)) n in -- let fx x = int_of_float((float_of_int my_x) -. (((float_of_int x) /. (fxgdivisions())) *. (float_of_int my_x2))) -+ let fx x = my_x - (x * my_x2 / my_samples) - and y_c1 n = (my_y + (int_of_float(float_of_int(datas g n) *. (vdt_stack g)))) - and y_c2 n = (my_y + (int_of_float(float_of_int(datas g (n+1)) *. (vdt_stack g)))) in - (if !!html_mods_vd_gfx_fill then begin -- mypic#line ~x1:(fx 0) ~y1:my_y -- ~x2:(fx 0) ~y2:(if y_c1 0 >= my_y - 3 then -- ((y_c1 0) - 3) else ((y_c1 0))) shadow_color; -- for n = 0 to ((graph_length(g)) - 1) do -- (* trick to make sure filling will not fail *) -- if n = ((graph_length(g)) - 1) then -- mypic#line ~x1:((fx n)) ~y1:(if y_c1 n >= my_y + 2 then -- ((y_c1 n) + 2) else ((y_c1 n))) ~x2:((fx (n+1))) ~y2:((y_c2 n)) shadow_color -- else begin -- mypic#line ~x1:((fx n)) ~y1:(if y_c1 n >= my_y + 2 then -- ((y_c1 n) + 2) else ((y_c1 n))) -- ~x2:((fx (n+1))) ~y2:(if y_c2 n >= my_y + 2 then -- ((y_c2 n) + 2) else ((y_c2 n))) shadow_color -- end -+ for n = 0 to my_s - 1 do -+ mypic#line ~x1:(fx n) ~y1:(max (my_y+1) (y_c1 n)) ~x2:(fx(n+1)) ~y2:(max (my_y+1) (y_c2 n)) shadow_color - done; -- mypic#fill ~x:(my_x - 1) ~y:(my_y + 1) my_color; -+ if (fx my_s) > xbl+1 then -+ mypic#line ~x1:(fx my_s) ~y1:(my_y) ~x2:(fx my_s) ~y2:(max my_y (y_c1 my_s)) shadow_color; -+ mypic#fill ~x:(my_x) ~y:(my_y) my_color - end - else begin -- for n = 0 to ((graph_length(g)) - 1) do -- mypic#line ~x1:((fx n) + 1) ~y1:((y_c1 n) + 1) ~x2:((fx (n+1)) + 1) ~y2:((y_c2 n) + 1) shadow_color; -- mypic#line ~x1:(fx n) ~y1:(y_c1 n) ~x2:(fx (n+1)) ~y2:(y_c2 n) my_color -+ for n = 0 to my_s - 1 do -+ mypic#line ~x1:((fx n)+1) ~y1:(max (my_y+1)((y_c1 n)+1)) ~x2:((fx (n+1))+1) ~y2:(max (my_y+1)((y_c2 n)+1)) shadow_color; -+ mypic#line ~x1:( fx n) ~y1:(max (my_y+1)(y_c1 n)) ~x2:( fx (n+1)) ~y2:(max (my_y+1)(y_c2 n)) my_color - done; - end - ) - -- --let draw_mean_line mypic g my_color gcolor = -- let my_x2 = (xbs()) -- and my_y = (ybb()) in -+let draw_mean_line mypic g my_color shadow_color tcolor = - let my_sum gl = List.fold_left (+) 0 (Fifo.to_list gl) in - let meanx() = ((float_of_int (my_sum g)) /. (float_of_int ((Fifo.length g)))) in -- let ypos = (my_y - (int_of_float((meanx()) *. (vdt_m g)))) in -+ let ypos = (ybb() - int_of_float(meanx() *. vdt_m g)) in - let vtext = (string_of_float (float_of_int(int_of_float(meanx() /. 1024. *. 100.)) /. 100.)) in -- mypic#line ~x1:xbl ~y1:(ypos - 1) ~x2:(xbl + my_x2 / 10) ~y2:(ypos - 1) my_color; -- mypic#line ~x1:xbl ~y1:(ypos) ~x2:(xbl + my_x2 / 10) ~y2:(ypos) gcolor; -- mypic#string ~font:Gd.Font.small ~x:(xbl + 5) ~y:((ypos) + 2) ~s:(vtext) gcolor -+ mypic#line ~x1:(xbl) ~y1:(ypos) ~x2:(xbl+1+ xbs() / x_divisions()) ~y2:(ypos) my_color; -+ if ypos+1 < ybb() then -+ mypic#line ~x1:(xbl) ~y1:(ypos+1) ~x2:(xbl+1+ xbs() / x_divisions()) ~y2:(ypos+1) shadow_color; -+ mypic#string ~font:Gd.Font.small ~x:(xbl) ~y:(ypos +2 ) ~s:(vtext) tcolor - - let draw_mygraph mypic ttl top_title vl hl g = - (* init pic *) - ( - let g_y = win_y() in -+ let mypic = Gd.create ~x:(win_x()) ~y:g_y in - (* set colors *) - let black = mypic#colors#black in - let red = mypic#colors#red in -@@ -412,11 +400,11 @@ - draw_title mypic ttl black g_y; - draw_top_legend mypic top_title black red darkgrey g_y; - draw_v_legend mypic g vl black black 0; -- draw_h_legend mypic g hl black samples_time; -- draw_load mypic g green darkgrey; -- draw_x_grid mypic black; -+ draw_h_legend mypic g hl black history_time !history_timeflag false; -+ draw_load mypic g green darkgrey history_size; -+ draw_x_grid mypic black darkgrey (x_divisions()); - draw_y_grid mypic black; -- (* draw_mean_line mypic gdown green black; *) -+ (* draw_mean_line mypic gdown green darkgrey black; *) - ) - - (* end of declarations *) -@@ -444,13 +432,13 @@ - draw_borders mypic black; - draw_title mypic ttl black win_y; - draw_v_legend mypic vl black black 0; -- draw_h_legend mypic gdown hl black samples_time; -- draw_load mypic gdown green darkgrey; -- draw_load mypic gup red darkgrey; -- draw_x_grid mypic black; -+ draw_h_legend mypic gdown hl black history_time !history_timeflag false; -+ draw_load mypic gdown green darkgrey history_size; -+ draw_load mypic gup red darkgrey history_size; -+ draw_x_grid mypic black darkgrey (x_divisions()); - draw_y_grid mypic black; - --(* draw_mean_line mypic gdown green black;*) -+ (* draw_mean_line mypic gdown green darkgrey black;*) - (* mypic#out_as_jpeg "line.jpg" ~quality:90; *) - - *) -@@ -477,16 +465,16 @@ - (* draw graph *) - draw_title mypic ttl black g_y; - draw_dual_top_legend mypic "download" black green darkgrey "upload" black red darkgrey g_y; -- draw_h_legend mypic gdown hl black samples_time; -+ draw_h_legend mypic gdown hl black history_time !history_timeflag false; - (if !!html_mods_vd_gfx_stack then begin - draw_stack_borders mypic black; - draw_stack_v_top_legend mypic gdown vl black darkgreen 5; - draw_stack_v_bottom_legend mypic gup vl black darkred 5; - (* enable filling for stack graph *) - if not !!html_mods_vd_gfx_fill then html_mods_vd_gfx_fill =:= true; -- draw_stack_download mypic gdown green darkgrey; -- draw_stack_upload mypic gup red darkgrey; -- draw_x_grid mypic black; -+ draw_stack_download mypic gdown green darkgrey history_size; -+ draw_stack_upload mypic gup red darkgrey history_size; -+ draw_x_grid mypic black darkgrey (x_divisions()); - draw_y_grid mypic black - end - else begin -@@ -494,13 +482,13 @@ - draw_v_legend mypic gdown vl black darkgreen 0; - draw_v_legend mypic gup vl black darkred 10; - if !!html_mods_vd_gfx_fill then html_mods_vd_gfx_fill =:= false; -- draw_load mypic gdown green darkgrey; -- draw_load mypic gup red darkgrey; -- draw_x_grid mypic black; -- draw_y_grid mypic black; -+ draw_load mypic gdown green darkgrey history_size; -+ draw_load mypic gup red darkgrey history_size; -+ draw_x_grid mypic black darkgrey (x_divisions()); -+ draw_y_grid mypic black; - (if !!html_mods_vd_gfx_mean then -- draw_mean_line mypic gdown green black; -- draw_mean_line mypic gup red black -+ draw_mean_line mypic gdown green darkgrey black; -+ draw_mean_line mypic gup red darkgrey black - ); - end); - draw_arrow mypic darkred; -@@ -514,9 +502,8 @@ - let do_draw_down_pic ttl top_title vl hl gdown = - (* init pic *) - ( -- let g_x = win_x() in - let g_y = win_y() in -- let mypic = Gd.create ~x:g_x ~y:g_y in -+ let mypic = Gd.create ~x:(win_x()) ~y:g_y in - - (* set colors *) - let white = mypic#colors#white in -@@ -532,13 +519,13 @@ - draw_title mypic ttl black g_y; - draw_top_legend mypic top_title black green darkgrey g_y; - draw_v_legend mypic gdown vl black black 6; -- draw_h_legend mypic gdown hl black samples_time; -- draw_load mypic gdown green darkgrey; -- draw_x_grid mypic black; -+ draw_h_legend mypic gdown hl black history_time !history_timeflag false; -+ draw_load mypic gdown green darkgrey history_size; -+ draw_x_grid mypic black darkgrey (x_divisions()); - draw_y_grid mypic black; - draw_arrow mypic darkred; - if !!html_mods_vd_gfx_mean then -- draw_mean_line mypic gdown green black; -+ draw_mean_line mypic gdown green darkgrey black; - - (if !!html_mods_vd_gfx_png then - mypic#save_as_png "bw_download.png" -@@ -550,9 +537,8 @@ - let do_draw_up_pic ttl top_title vl hl gup = - (* init pic *) - ( -- let g_x = win_x() in - let g_y = win_y() in -- let mypic = Gd.create ~x:g_x ~y:g_y in -+ let mypic = Gd.create ~x:(win_x()) ~y:g_y in - - (* set colors *) - let white = mypic#colors#white in -@@ -568,13 +554,13 @@ - draw_title mypic ttl black g_y; - draw_top_legend mypic top_title black red darkgrey g_y; - draw_v_legend mypic gup vl black black 6; -- draw_h_legend mypic gup hl black samples_time; -- draw_load mypic gup red darkgrey; -- draw_x_grid mypic black; -+ draw_h_legend mypic gup hl black history_time !history_timeflag false; -+ draw_load mypic gup red darkgrey history_size; -+ draw_x_grid mypic black darkgrey (x_divisions()); - draw_y_grid mypic black; - draw_arrow mypic darkred; - if !!html_mods_vd_gfx_mean then -- draw_mean_line mypic gup red black; -+ draw_mean_line mypic gup red darkgrey black; - - (if !!html_mods_vd_gfx_png then - mypic#save_as_png "bw_upload.png" -@@ -588,7 +574,8 @@ - ( - let g_y = win_y() in - let mypic = Gd.create ~x:(win_x()) ~y:g_y in -- -+ let x_legend_days = (int_of_float !history_h_timeflag) mod 86400 < (x_h_time gdown) in -+ - (* set colors *) - let white = mypic#colors#white in - let black = mypic#colors#black in -@@ -606,16 +593,16 @@ - draw_dual_top_legend mypic "download" black green darkgrey "upload" black red darkgrey g_y; - draw_v_legend mypic gdown vl black darkgreen 0; - draw_v_legend mypic gup vl black darkred 10; -- draw_h_legend mypic gdown hl black samples_h_time; -+ draw_h_legend mypic gup hl black (x_h_time gdown) !history_h_timeflag x_legend_days; - if !!html_mods_vd_gfx_fill then html_mods_vd_gfx_fill =:= false; -- draw_load mypic gdown green darkgrey; -- draw_load mypic gup red darkgrey; -- draw_x_grid mypic black; -+ draw_load mypic gdown green darkgrey (x_h_values gdown); -+ draw_load mypic gup red darkgrey (x_h_values gdown); -+ draw_x_grid mypic black darkgrey (x_divisions()); - draw_y_grid mypic black; - draw_arrow mypic darkred; - (if !!html_mods_vd_gfx_mean then -- draw_mean_line mypic gdown green black; -- draw_mean_line mypic gup red black -+ draw_mean_line mypic gdown green darkgrey black; -+ draw_mean_line mypic gup red darkgrey black - ); - (if !!html_mods_vd_gfx_png then - mypic#save_as_png "bw_h_updown.png" -@@ -627,9 +614,9 @@ - let do_draw_down_h_pic ttl top_title vl hl gdown = - (* init pic *) - ( -- let g_x = win_x() in - let g_y = win_y() in -- let mypic = Gd.create ~x:g_x ~y:g_y in -+ let mypic = Gd.create ~x:(win_x()) ~y:g_y in -+ let x_legend_days = (int_of_float !history_h_timeflag) mod 86400 < (x_h_time gdown) in - - (* set colors *) - let white = mypic#colors#white in -@@ -645,13 +632,13 @@ - draw_title mypic ttl black g_y; - draw_top_legend mypic top_title black green darkgrey g_y; - draw_v_legend mypic gdown vl black black 6; -- draw_h_legend mypic gdown hl black samples_h_time; -- draw_load mypic gdown green darkgrey; -- draw_x_grid mypic black; -+ draw_h_legend mypic gdown hl black (x_h_time gdown) !history_h_timeflag x_legend_days; -+ draw_load mypic gdown green darkgrey (x_h_values gdown); -+ draw_x_grid mypic black darkgrey (x_divisions()); - draw_y_grid mypic black; - draw_arrow mypic darkred; - if !!html_mods_vd_gfx_mean then -- draw_mean_line mypic gdown green black; -+ draw_mean_line mypic gdown green darkgrey black; - - (if !!html_mods_vd_gfx_png then - mypic#save_as_png "bw_h_download.png" -@@ -663,9 +650,9 @@ - let do_draw_up_h_pic ttl top_title vl hl gup = - (* init pic *) - ( -- let g_x = win_x() in - let g_y = win_y() in -- let mypic = Gd.create ~x:g_x ~y:g_y in -+ let x_legend_days = (int_of_float !history_h_timeflag) mod 86400 < (x_h_time gup) in -+ let mypic = Gd.create ~x:(win_x()) ~y:g_y in - - (* set colors *) - let white = mypic#colors#white in -@@ -681,13 +668,13 @@ - draw_title mypic ttl black g_y; - draw_top_legend mypic top_title black red darkgrey g_y; - draw_v_legend mypic gup vl black black 6; -- draw_h_legend mypic gup hl black samples_h_time; -- draw_load mypic gup red darkgrey; -- draw_x_grid mypic black; -+ draw_h_legend mypic gup hl black (x_h_time gup) !history_h_timeflag x_legend_days; -+ draw_load mypic gup red darkgrey (x_h_values gup); -+ draw_x_grid mypic black darkgrey (x_divisions()); - draw_y_grid mypic black; - draw_arrow mypic darkred; - if !!html_mods_vd_gfx_mean then -- draw_mean_line mypic gup red black; -+ draw_mean_line mypic gup red darkgrey black; - - (if !!html_mods_vd_gfx_png then - mypic#save_as_png "bw_h_upload.png" -Index: src/daemon/driver/driverInteractive.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverInteractive.ml,v -retrieving revision 1.101 -retrieving revision 1.115 -diff -u -r1.101 -r1.115 ---- src/daemon/driver/driverInteractive.ml 7 Sep 2006 10:55:11 -0000 1.101 -+++ src/daemon/driver/driverInteractive.ml 21 Nov 2006 22:34:33 -0000 1.115 -@@ -21,6 +21,8 @@ - - open Printf2 - open CommonClient -+open CommonShared -+open CommonServer - open CommonNetwork - open CommonResult - open CommonFile -@@ -49,19 +51,11 @@ - lprintf2 log_prefix fmt - - let verify_user_admin () = -- let empty_pwd = ref false in -- begin try -- if user2_password admin_user = blank_password then -- empty_pwd := true -- with e -> -- lprintf_nl (_b "SECURITY INFO: user 'admin' has to be present, creating..."); -- empty_pwd := true; -- ignore (user2_add admin_user blank_password "") -- end; - let warning = - "SECURITY WARNING: user admin has an empty password, use command: useradd admin password\n" - in -- if !empty_pwd && not !!enable_user_config then -+ if has_empty_password admin_user && !!allowed_ips <> -+ [(Ip.range_of_string (strings_of_option allowed_ips).option_default)] then - begin - lprintf_n "%s" warning; - warning -@@ -83,6 +77,7 @@ - let s = - !startup_message ^ (verify_user_admin ()) ^ (check_supported_os ()) - ^ (if not !dns_works then "DNS resolution does not work\n" else "") -+ ^ (if not !Charset.conversion_enabled then "Charset conversion does not work, disabled\n" else "") - ^ (match !created_new_base_directory with - None -> "" - | Some dir -> (Printf.sprintf "MLDonkey created a new home directory in %s\n" dir)) -@@ -239,6 +234,8 @@ - then file_availability f - else string_availability f.file_availability - -+let number_of_comments f = -+ List.length f.file_comments - - (* WARNING: these computations are much more expensive as they seem. - We use the ShortLazy to avoid recomputing the result too many times, -@@ -575,7 +572,7 @@ - Printf.bprintf buf "\\</form\\>" - - -- let print_file_html_mods buf guifiles = -+let print_file_html_mods buf guifiles = - - if (List.length guifiles) > 0 then begin - let tsize = ref Int64.zero in -@@ -636,7 +633,7 @@ - \\<div class=main\\>"; - - 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:20;font-size:8pt; visibility:show; left:25px; top: -+"\\<div id=\\\"object1\\\" style=\\\"position:absolute; background-color:#FFFFDD;color:black;border-color:black;border-width:20px;font-size:8pt; visibility:visible; left:25px; top: - -100px; z-index:+1\\\" onmouseover=\\\"overdiv=1;\\\" onmouseout=\\\"overdiv=0; setTimeout(\\\'hideLayer()\\\',1000)\\\"\\>\\ \\</div\\>"; - - Printf.bprintf buf "\\<form id=\\\"selectForm\\\" name=\\\"selectForm\\\" action=\\\"files\\\"\\> -@@ -660,7 +657,8 @@ - - \\<td title=\\\"Pause\\\" class=\\\"dlheader np\\\"\\>P\\</td\\> - \\<td title=\\\"Resume\\\" class=\\\"dlheader np\\\"\\>R\\</td\\> --\\<td title=\\\"Cancel\\\" class=\\\"dlheader brs\\\"\\>C\\</td\\>" -+\\<td title=\\\"Cancel\\\" class=\\\"dlheader brs\\\"\\>C\\</td\\> -+\\<td title=\\\"Click to switch release status\\\" class=\\\"dlheader brs\\\"\\>R\\</td\\>" - (if !qnum > 0 then begin - Printf.sprintf "title=\\\"Active(%d): %s/%s | Queued(%d): %s/%s\\\"" - (List.length guifiles - !qnum) (size_of_int64 (!tdl -- !qdl)) (size_of_int64 (!tsize -- !qsize)) -@@ -670,17 +668,24 @@ - (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\\\"\\>(+%d)\\ \\</td\\>" !unread !unread else ""); -+if !unread > 0 then Printf.sprintf "\\<td class=downloaded title=\\\"%d unread messages\\\"\\>\\<a onClick=\\\"mSub('fstatus','version');mSub('output','message')\\\"\\>(+%d)\\</a\\>\\ \\</td\\>" !unread !unread else ""); - - if !!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\\>"; - - Printf.bprintf buf --"\\<td title=\\\"Sort by filename\\\" class=dlheader\\>\\<input class=headbutton type=submit value=File name=sortby\\>\\</td\\> --\\<td title=\\\"Sort by size\\\" class=dlheader\\>\\<input class=headbutton type=submit value=Size name=sortby\\>\\</td\\> -+"\\<td title=\\\"Sort by filename\\\" class=dlheader\\>\\<input class=headbutton type=submit value=File name=sortby\\>\\</td\\>"; -+ -+if !!html_mods_vd_user then Printf.bprintf buf -+"\\<td title=\\\"Sort by user\\\" class=dlheader\\>\\<input class=headbutton type=submit value=User name=sortby\\>\\</td\\>"; -+ -+if !!html_mods_vd_group then Printf.bprintf buf -+"\\<td title=\\\"Sort by group\\\" class=dlheader\\>\\<input class=headbutton type=submit value=Group name=sortby\\>\\</td\\>"; -+ -+Printf.bprintf buf -+"\\<td title=\\\"Sort by size\\\" class=dlheader\\>\\<input class=headbutton type=submit value=Size name=sortby\\>\\</td\\> - \\<td title=\\\"Sort by size downloaded\\\" class=dlheader\\>\\<input class=\\\"headbutton ar\\\" type=submit value=DLed name=sortby\\>\\</td\\> - \\<td title=\\\"Sort by percent\\\" class=dlheader\\>\\<input class=headbutton type=submit value=%% name=sortby\\>\\</td\\>"; -- - if !!html_mods_vd_comments then Printf.bprintf buf - "\\<td title=\\\"Sort by comments\\\" class=dlheader\\>\\<input style=\\\"padding-left: 0px; padding-right: 0px;\\\" class=headbutton type=submit value=Cm name=sortby\\>\\</td\\>"; - -@@ -715,26 +720,36 @@ - [| - (if !!html_mods_use_js_tooltips then - Printf.sprintf " -- onMouseOver=\\\"mOvr(this);setTimeout('popLayer(\\\\\'%s<br>%sFile#: %d<br>Network: %s%s\\\\\')',%d);setTimeout('hideLayer()',%d);return true;\\\" onMouseOut=\\\"mOut(this);hideLayer();setTimeout('hideLayer()',%d)\\\"\\>" -- (Http_server.html_real_escaped file.file_name) -+ onMouseOver=\\\"mOvr(this);setTimeout('popLayer(\\\\\'%s<br>%sFile#: %d<br>Network: %s<br>User%s %s%s%s\\\\\')',%d);setTimeout('hideLayer()',%d);return true;\\\" onMouseOut=\\\"mOut(this);hideLayer();setTimeout('hideLayer()',%d)\\\"\\>" -+ (Http_server.html_real_escaped (Charset.to_utf8 file.file_name)) - (match file_magic (file_find file.file_num) with - None -> "" - | Some magic -> "File type: " ^ (Http_server.html_real_escaped magic) ^ "<br>") - file.file_num - (net_name file) -- (let comments = file_comment (file_find file.file_num) in -- if comments = [] then "" else -+ (if file.file_group = "none" then "" else ":Group") -+ file.file_user -+ (if file.file_group = "none" then "" else Printf.sprintf ":%s" file.file_group) -+ -+ (if file.file_comments = [] then "" else - begin -- let buf1 = Buffer.create 100 in -- Printf.bprintf buf1 "<br><br>Comments:<br>"; -- List.iter (fun s -> Printf.bprintf buf1 "%s<br>" (Http_server.html_real_escaped s)) comments; -+ let num_comments = number_of_comments file in -+ let buf1 = Buffer.create (!!max_comment_length * num_comments) in -+ Printf.bprintf buf1 "<br><br>Comments(%d):<br>" (num_comments); -+ let comments = -+ if List.length file.file_comments > 5 then -+ fst (List2.cut 5 file.file_comments) @ [Ip.null, "", 0, (_s "MLDonkey note: click file for more comments")] -+ else -+ file.file_comments -+ in -+ List.iter (fun (_,_,_,s) -> Printf.bprintf buf1 "%s<br>" (Http_server.html_real_escaped (Charset.to_utf8 s))) comments; - Buffer.contents buf1 - end) -+ - !!html_mods_js_tooltips_wait - !!html_mods_js_tooltips_timeout - !!html_mods_js_tooltips_wait -- else Printf.sprintf " -- onMouseOver=\\\"mOvr(this);return true;\\\" onMouseOut=\\\"mOut(this);\\\"\\>"); -+ else Printf.sprintf " onMouseOver=\\\"mOvr(this);return true;\\\" onMouseOut=\\\"mOut(this);\\\"\\>"); - - (if downloading file then - Printf.sprintf "\\<td class=\\\"dl al np\\\"\\>\\<input class=checkbox name=pause type=checkbox value=%d\\>\\</td\\> -@@ -749,6 +764,10 @@ - file.file_num - file.file_num); - -+ Printf.sprintf "\\<td onClick=\\\"location.href='files?%s=%d';return true;\\\" class=\\\"dl al brs\\\"\\>\\%s\\</td\\>" -+ (if file.file_release then "norelease" else "release") -+ file.file_num (if file.file_release then "R" else "-"); -+ - (if !!html_mods_vd_network then - Printf.sprintf "\\<td onClick=\\\"location.href='submit?q=vd+%d';return true;\\\" - title=\\\"%s\\\" class=\\\"dl al\\\"\\>%s\\</td\\>" -@@ -772,14 +791,14 @@ - (truncate ( (1. -. downloaded /. size) *. 100.)) - else - Printf.sprintf "\\<TD onClick=\\\"location.href='submit?q=vd+%d';return true;\\\" -- title=\\\"[File#: %d] [Net: %s]%s\\\" class=\\\"dl al\\\"\\>%s\\<br\\> -+ title=\\\"[File#: %d] [Net: %s] [Comments: %d]%s\\\" class=\\\"dl al\\\"\\>%s\\<br\\> - \\<table cellpadding=0 cellspacing=0 width=100%%\\>\\<tr\\> - \\<td class=\\\"loaded\\\" style=\\\"height:%dpx\\\" width=\\\"%d%%\\\"\\> \\</td\\> - \\<td class=\\\"remain\\\" style=\\\"height:%dpx\\\" width=\\\"%d%%\\\"\\> \\</td\\> - \\</tr\\>\\</table\\>\\</td\\>" - file.file_num - file.file_num -- (net_name file) -+ (net_name file) (number_of_comments file) - (if !!max_name_len < String.length file.file_name then " " ^ file.file_name else "") - (short_name file) - (!!html_vd_barheight) -@@ -788,14 +807,16 @@ - (truncate ( (1. -. downloaded /. size) *. 100.))); - ); - -+ (if !!html_mods_vd_user then ctd file.file_num file.file_user else ""); -+ (if !!html_mods_vd_group then ctd file.file_num file.file_group else ""); -+ - (ctd file.file_num (size_of_int64 file.file_size)); - (ctd file.file_num (size_of_int64 file.file_downloaded)); - (ctd file.file_num (Printf.sprintf "%.1f" (percent file))); - - (if !!html_mods_vd_comments then -- Printf.sprintf "\\<td onClick=\\\"location.href='submit?q=vd+%d';return true;\\\" -- class=\\\"dl al\\\"\\>%d\\</td\\>" -- file.file_num (file_comment_length (file_find file.file_num)) else ""); -+ ctd file.file_num (Printf.sprintf "%d" (number_of_comments file)) -+ else ""); - - (ctd file.file_num (Printf.sprintf "%d" (number_of_sources file))); - -@@ -936,7 +957,7 @@ - else - print_table buf - [| -- Align_Left; Align_Left; Align_Right; Align_Right; -+ Align_Left; Align_Left; Align_Right; Align_Left; Align_Left; Align_Left; - Align_Right; Align_Right; Align_Right |] - (if format.conn_output = HTML then - [| -@@ -951,6 +972,10 @@ - |] else - [| - "$nNum"; -+ "Rele"; -+ "Comm"; -+ "User"; -+ "Group"; - "File"; - " %"; - " Done"; -@@ -995,6 +1020,10 @@ - file.file_num - (if downloading file then "PAUSE" else "RESUME") - else "")); -+ (Printf.sprintf "%s" (if file.file_release then "R" else "-")); -+ (Printf.sprintf "%4d" (number_of_comments file)); -+ file.file_user; -+ file.file_group; - (short_name file); - (Printf.sprintf "%3.1f" (percent file)); - (if !!improved_telnet then (print_human_readable file file.file_downloaded) -@@ -1112,7 +1141,9 @@ - | 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 -> file_comment_length (file_find f1.file_num) >= file_comment_length (file_find f2.file_num)) -+ | 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) - | NotSorted -> raise Not_found - in - Sort.list sorter list -@@ -1158,7 +1189,7 @@ - let counter = ref 0 in - if use_html_mods o then - begin -- 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:20;font-size:8pt; visibility:show; left:25px; top:-100px; z-index:+1\\\" onmouseover=\\\"overdiv=1;\\\" onmouseout=\\\"overdiv=0; setTimeout(\\\'hideLayer()\\\',1000)\\\"\\>\\ \\</div\\>\n"; -+ if !!html_mods_use_js_tooltips then Printf.bprintf buf "\\<div id=\\\"object1\\\" style=\\\"position:absolute; background-color:#FFFFDD;color:black;border-color:black;border-width:20px;font-size:8pt; visibility:visible; left:25px; top:-100px; z-index:+1\\\" onmouseover=\\\"overdiv=1;\\\" onmouseout=\\\"overdiv=0; setTimeout(\\\'hideLayer()\\\',1000)\\\"\\>\\ \\</div\\>\n"; - html_mods_table_header_colspan buf "resultsTable" "results" [ - ( "1", "0", "srh", "Network", "Network" ) ; - ( "1", "0", "srh", "File", "File (mouseover)" ) ; -@@ -1703,7 +1734,8 @@ - ( "0", "srh br", "Has search", "Search" ) ; - ( "0", "srh br", "Has chat", "Chat" ) ; - ( "0", "srh br", "Has rooms", "Rooms" ) ; -- ( "0", "srh", "Has multinet", "Multinet" ) ] -+ ( "0", "srh", "Has multinet", "Multinet" ) ; -+ ( "0", "srh", "Has porttest", "Porttest" ) ] - - let print_network_modules buf o = - let buf = o.conn_buf in -@@ -1718,6 +1750,10 @@ - if not (List.mem VirtualNetwork n.network_flags) then - try - let net_has e = if List.mem e n.network_flags then "yes" else "" in -+ let net_has_porttest () = -+ match network_porttest_result n with -+ PorttestNotAvailable -> "" -+ | _ -> "yes" in - Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); - html_mods_td buf [ - ("", "sr br", n.network_name); -@@ -1728,7 +1764,8 @@ - ("", "sr br", net_has NetworkHasSearch); - ("", "sr br", net_has NetworkHasChat); - ("", "sr br", net_has NetworkHasRooms); -- ("", "sr" , net_has NetworkHasMultinet); ]; -+ ("", "sr br", net_has NetworkHasMultinet); -+ ("", "sr" , (net_has_porttest ())); ]; - Printf.bprintf buf "\\</tr\\>"; - with _ -> () - ); -@@ -1867,7 +1904,8 @@ - tack list - ( - "Features:\t", -- (if BasicSocket.has_threads () then "threads" else "no-threads") ^ -+ ("multiuser") ^ -+ (if BasicSocket.has_threads () then " threads" else " no-threads") ^ - (let s = Zlib.zlib_version_num () in - Printf.sprintf " zlib%s" (if s <> "" then "-" ^ s else "")) ^ - (if Autoconf.bzip2 then -@@ -1886,7 +1924,10 @@ - " gd(jpg)" - | _, false, false -> - " gd(neither jpg nor png ?)") ^ -- (if Autoconf.has_iconv then " iconv" else " no-iconv") ^ -+ (match Autoconf.has_iconv, !Charset.conversion_enabled with -+ | true, true -> " iconv(active)" -+ | true, false -> " iconv(inactive)" -+ | false, _ -> " no-iconv") ^ - (match Autoconf.magic, !Autoconf.magic_works with - | true, true -> " magic(active)" - | true, false -> " magic(inactive)" -@@ -1924,8 +1965,8 @@ - ( - "User:\t\t", - Printf.sprintf "%s (%s) - uptime: %s" -- o.conn_user.ui_user_name -- (if empty_password o.conn_user.ui_user_name then "Warning: empty Password" -+ o.conn_user.ui_user.user_name -+ (if has_empty_password o.conn_user.ui_user then "Warning: empty Password" - else "PW Protected") - (Date.time_to_string (last_time () - start_time) "verbose") - ); -@@ -2089,8 +2130,8 @@ - let len_dir = ref 9 in - let len_strategy = ref 29 in (* "shared (incoming_directories)" *) - List.iter ( fun (dir, strategy) -> -- len_dir := maxi !len_dir (String.length dir); -- len_strategy := maxi !len_strategy (String.length strategy) -+ len_dir := max !len_dir (String.length dir); -+ len_strategy := max !len_strategy (String.length strategy) - ) !list; - let fill_dir = String.make (!len_dir - 9) ' ' in - let fill_dir_line = String.make (!len_dir - 9) '-' in -@@ -2139,8 +2180,8 @@ - end - else - Printf.bprintf buf "%-*s|%-*s|%8s|%8s|%5s|%-s\n" -- (maxi !len_dir (!len_dir - String.length dir)) dir -- (maxi !len_strategy (!len_strategy - String.length strategy)) strategy -+ (max !len_dir (!len_dir - String.length dir)) dir -+ (max !len_strategy (!len_strategy - String.length strategy)) strategy - diskused diskfree percentfree filesystem - ) !list; - if html then -@@ -2186,11 +2227,11 @@ - if html then Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>\\</div\\>"; - Buffer.contents buf - --let dllink_query_networks html url = -+let dllink_query_networks html url user = - let result = ref [] in - if not (networks_iter_until_true (fun n -> - try -- let s,r = network_parse_url n url in -+ let s,r = network_parse_url n url user in - if s = "" then - r - else -@@ -2208,7 +2249,7 @@ - else - dllink_print_result html url "Added link" !result - --let dllink_parse html url = -+let dllink_parse html url user = - if (String2.starts_with url "http") then ( - let u = Url.of_string url in - let module H = Http_client in -@@ -2242,21 +2283,14 @@ - let concat_headers = - (List.fold_right (fun (n, c) t -> n ^ ": " ^ c ^ "\n" ^ t) headers "") - in -- ignore (dllink_query_networks html concat_headers) -+ ignore (dllink_query_networks html concat_headers user) - ); - dllink_print_result html url "Parsing HTTP url" []) - else - if (String2.starts_with url "ftp") then -- dllink_query_networks html (Printf.sprintf "Location: %s" url) -+ dllink_query_networks html (Printf.sprintf "Location: %s" url) user - else -- dllink_query_networks html url -- --let print_command_result o buf result = -- if use_html_mods o then -- html_mods_table_one_row buf "serversTable" "servers" [ -- ("", "srh", result); ] -- else -- Printf.bprintf buf "%s" result -+ dllink_query_networks html url user - - module UnionFind = struct - type t = int array -@@ -2378,3 +2412,119 @@ - shorten fileinfo.file_name 80; - string_of_int nc |] - ) sorted_score_list) -+ -+let print_upstats o list server = -+ let buf = o.conn_buf in -+ if use_html_mods o then -+ begin -+ if !!html_mods_use_js_tooltips then Printf.bprintf buf -+"\\<div id=\\\"object1\\\" style=\\\"position:absolute; background-color:#FFFFDD;color:black;border-color:black;border-width:20px;font-size:8pt; visibility:visible; left:25px; top: -+-100px; z-index:+1\\\" onmouseover=\\\"overdiv=1;\\\" onmouseout=\\\"overdiv=0; setTimeout(\\\'hideLayer()\\\',1000)\\\"\\>\\ \\</div\\>"; -+ -+ Printf.bprintf buf "\\<div class=\\\"upstats\\\"\\>"; -+ match server with -+ None -> -+ html_mods_table_one_row buf "upstatsTable" "upstats" [ -+ ("", "srh", Printf.sprintf "Session: %s uploaded | Shared(%d): %s\n" -+ (size_of_int64 !upload_counter) !nshared_files (size_of_int64 !nshared_bytes)); ] -+ | Some s -> let info = server_info s in -+ html_mods_table_one_row buf "upstatsTable" "upstats" [ -+ ("", "srh", Printf.sprintf "%d files shared on %s (%s:%s)" -+ info.G.server_published_files info.G.server_name -+ (Ip.string_of_addr info.G.server_addr) -+ (string_of_int info.G.server_port)); ] -+ end -+ else -+ begin -+ Printf.bprintf buf "Upload statistics:\n"; -+ Printf.bprintf buf "Session: %s uploaded | Shared(%d): %s\n" -+ (size_of_int64 !upload_counter) !nshared_files (size_of_int64 !nshared_bytes) -+ end; -+ -+ if use_html_mods o then -+ html_mods_table_header buf "upstatsTable" "upstats" [ -+ ( "1", "srh", "Total file requests", "Reqs" ) ; -+ ( "1", "srh", "Total bytes sent", "Total" ) ; -+ ( "1", "srh", "Upload Ratio", "UPRatio" ) ; -+ ( "0", "srh", "Preview", "P" ) ; -+ ( "0", "srh", "Filename", "Filename" ); -+ ( "0", "srh", "Statistic links", "Stats" ); -+ ( "0", "srh", "Published on servers", "Publ" ) ] -+ else -+ begin -+ Printf.bprintf buf " Requests | Bytes | Uploaded | File\n"; -+ Printf.bprintf buf "----------+----------+----------+----------------------------------------------------\n"; -+ 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 ) -+ ) list in -+ -+ List.iter (fun impl -> -+ if use_html_mods o then -+ begin -+ let published = List.length impl.impl_shared_servers in -+ let ed2k = file_print_ed2k_link -+ (Filename.basename impl.impl_shared_codedname) -+ impl.impl_shared_size impl.impl_shared_id in -+ -+ Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"" (html_mods_cntr ()); -+ (if !!html_mods_use_js_tooltips then -+ Printf.bprintf buf " onMouseOver=\\\"mOvr(this);setTimeout('popLayer(\\\\\'%s<br>%s%s\\\\\')',%d);setTimeout('hideLayer()',%d);return true;\\\" onMouseOut=\\\"mOut(this);hideLayer();setTimeout('hideLayer()',%d)\\\"\\>" -+ (Http_server.html_real_escaped (Filename.basename (Charset.to_utf8 impl.impl_shared_codedname))) -+ (match impl.impl_shared_magic with -+ None -> "" -+ | 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" -+ published (if published = 1 then "server" else "servers") -+ (let listbuf = Buffer.create 100 in -+ List.iter (fun s -> let info = server_info s in -+ Printf.bprintf listbuf "%s (%s:%s%s)<br>" -+ info.server_name -+ (Ip.string_of_addr info.server_addr) -+ (string_of_int info.server_port) -+ (if info.server_realport <> 0 -+ then "(" ^ (string_of_int info.server_realport) ^ ")" else "") -+ ) impl.impl_shared_servers; -+ Buffer.contents listbuf)) -+ !!html_mods_js_tooltips_wait -+ !!html_mods_js_tooltips_timeout -+ !!html_mods_js_tooltips_wait -+ else Printf.bprintf buf " onMouseOver=\\\"mOvr(this);return true;\\\" onMouseOut=\\\"mOut(this);\\\"\\>"); -+ -+ 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); -+ ("", "sr ar", Printf.sprintf "%5.1f" ( if size < 1.0 then 0.0 else (uploaded *. 100.) /. size)); -+ ("", "sr", Printf.sprintf "\\<a href=\\\"preview_upload?q=%d\\\"\\>P\\</a\\>" impl.impl_shared_num); -+ ("", "sr", (if impl.impl_shared_id = Md4.null then -+ (Filename.basename impl.impl_shared_codedname) -+ else -+ Printf.sprintf "\\<a href=\\\"%s\\\"\\>%s\\</a\\>" -+ ed2k (shorten (Filename.basename impl.impl_shared_codedname) !!max_name_len))); -+ ("", "sr", (if impl.impl_shared_id = Md4.null then "" else -+ Printf.sprintf "\\<a href=\\\"http://tothbenedek.hu/ed2kstats/ed2k?hash=%s\\\"\\>%s\\</a\\> -+\\<a href=\\\"http://ed2k.titanesel.ws/ed2k.php?hash=%s\\\"\\>%s\\</a\\> -+\\<a href=\\\"http://bitzi.com/lookup/ed2k:%s\\\"\\>%s\\</a\\>" -+ (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 ) ]; -+ Printf.bprintf buf "\\</tr\\>\n"; -+ end -+ else -+ Printf.bprintf buf "%9d | %8s | %7s%% | %-50s\n" -+ (impl.impl_shared_requests) -+ (size_of_int64 impl.impl_shared_uploaded) -+ (Printf.sprintf "%3.1f" ((Int64.to_float impl.impl_shared_uploaded *. 100.) /. Int64.to_float impl.impl_shared_size)) -+ (shorten (Filename.basename impl.impl_shared_codedname) !!max_name_len) -+ ) list; -+ -+ if use_html_mods o then Printf.bprintf buf "\\</table\\>\\</div\\>\\</div\\>" -Index: src/daemon/driver/driverInterface.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverInterface.ml,v -retrieving revision 1.52 -retrieving revision 1.60 -diff -u -r1.52 -r1.60 ---- src/daemon/driver/driverInterface.ml 12 Aug 2006 20:36:14 -0000 1.52 -+++ src/daemon/driver/driverInterface.ml 21 Nov 2006 22:34:33 -0000 1.60 -@@ -246,6 +246,8 @@ - - let send_update_file gui file_num update = - let file = file_find file_num in -+ if user2_can_view_file gui.gui_conn.conn_user.ui_user (file_owner file) (file_group file) then -+ begin - let impl = as_file_impl file in - let file_info = if update then - P.File_info (file_info file) -@@ -256,6 +258,7 @@ - impl.impl_file_last_seen) - in - gui_send gui file_info -+ end - - let send_update_user gui user_num update = - let user = user_find user_num in -@@ -428,7 +431,7 @@ - (File_add_source_event (file,c)) - :: gui.gui_events.gui_new_events - ) sources -- ) !!files; -+ ) (user2_filter_files !!files gui.gui_conn.conn_user.ui_user); - - List.iter (fun file -> - addevent gui.gui_events.gui_files (file_num file) true; -@@ -458,6 +461,7 @@ - end - ); - -+ if user2_can_view_uploads gui.gui_conn.conn_user.ui_user then - shared_iter (fun s -> - addevent gui.gui_events.gui_shared_files (shared_num s) true - ); -@@ -466,8 +470,11 @@ - 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)); -+ -+ 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 -@@ -475,6 +482,7 @@ - gui_send gui (P.Options_info args)) r.network_config_file); - - (* Options panels defined in downloads.ini *) -+ if user2_is_admin gui.gui_conn.conn_user.ui_user then - List.iter (fun s -> - let section = section_name s in - List.iter (fun o -> -@@ -484,6 +492,7 @@ - ) (sections downloads_ini); - - (* Options panels defined in users.ini *) -+ if user2_is_admin gui.gui_conn.conn_user.ui_user then - List.iter (fun s -> - let section = section_name s in - List.iter (fun o -> -@@ -493,6 +502,7 @@ - ) (sections users_ini); - - (* Options panels defined in each plugin *) -+ if user2_is_admin gui.gui_conn.conn_user.ui_user then - networks_iter_all (fun r -> - let prefix = r.network_shortname ^ "-" in - List.iter (fun file -> -@@ -554,7 +564,7 @@ - (File_add_source_event (file,c)) - :: gui.gui_events.gui_new_events - ) (file_active_sources file) -- ) !!files; -+ ) (user2_filter_files !!files gui.gui_conn.conn_user.ui_user); - - end - -@@ -613,7 +623,7 @@ - ) list - - | P.SetOption (name, value) -> -- if user2_is_admin gui.gui_conn.conn_user.ui_user_name || !!enable_user_config then -+ if user2_is_admin gui.gui_conn.conn_user.ui_user then - CommonInteractive.set_fully_qualified_options name value - else - begin -@@ -644,6 +654,7 @@ - end - - | P.EnableNetwork (num, bool) -> -+ if user2_is_admin gui.gui_conn.conn_user.ui_user then - let n = network_find_by_num num in - if n.op_network_is_enabled () <> bool then - (try -@@ -670,7 +681,7 @@ - network_extend_search r s e) - - | P.KillServer -> -- if user2_is_admin gui.gui_conn.conn_user.ui_user_name then -+ if user2_is_admin gui.gui_conn.conn_user.ui_user then - CommonInteractive.clean_exit 0 - else - begin -@@ -689,7 +700,7 @@ - add_timer 60. (fun _ -> - gui_send gui (Search_waiting (search_num, 0)) - ); -- gui.gui_id_counter <- maxi gui.gui_id_counter search_num; -+ gui.gui_id_counter <- max gui.gui_id_counter search_num; - - let user = gui.gui_conn.conn_user in - let query = -@@ -720,7 +731,7 @@ - - | P.Download_query (filenames, num, force) -> - let r = find_result num in -- let files = result_download r filenames force in -+ let files = result_download r filenames force gui.gui_conn.conn_user.ui_user in - List.iter CommonInteractive.start_download files - - | P.ConnectMore_query -> -@@ -731,7 +742,7 @@ - if not (networks_iter_until_true - (fun n -> - try -- let s,r = network_parse_url n url in r -+ let s,r = network_parse_url n url gui.gui_conn.conn_user.ui_user in r - with e -> - lprintf "Exception %s for network %s\n" - (Printexc2.to_string e) (n.network_name); -@@ -765,11 +776,13 @@ - query_networks url - - | P.GetUploaders -> -+ if user2_can_view_uploads gui.gui_conn.conn_user.ui_user then - gui_send gui (P.Uploaders - (List2.tail_map (fun c -> client_num c) - (Intmap.to_list !uploaders))) - - | P.GetPending -> -+ if user2_can_view_uploads gui.gui_conn.conn_user.ui_user then - gui_send gui (P.Pending ( - List2.tail_map (fun c -> client_num c) - (Intmap.to_list !CommonUploads.pending_slots_map))) -@@ -778,13 +791,13 @@ - server_remove (server_find num) - - | P.SaveOptions_query list -> -- -+ if user2_is_admin gui.gui_conn.conn_user.ui_user then - List.iter (fun (name, value) -> - CommonInteractive.set_fully_qualified_options name value) list; - DriverInteractive.save_config () - - | P.RemoveDownload_query num -> -- file_cancel (file_find num) -+ file_cancel (file_find num) gui.gui_conn.conn_user.ui_user - - | P.ViewUsers num -> - let s = server_find num in -@@ -868,6 +881,7 @@ - client_connect c - - | P.DisconnectClient num -> -+ if user2_can_view_uploads gui.gui_conn.conn_user.ui_user then - let c = client_find num in - client_disconnect c - -@@ -905,9 +919,9 @@ - | P.SwitchDownload (num, resume) -> - let file = file_find num in - if resume then -- file_resume file -+ file_resume file gui.gui_conn.conn_user.ui_user - else -- file_pause file -+ file_pause file gui.gui_conn.conn_user.ui_user - - | P.FindFriend user -> - networks_iter (fun n -> -@@ -1026,7 +1040,7 @@ - - | NetworkMessage (num, s) -> - let n = network_find_by_num num in -- n.op_network_gui_message s -+ n.op_network_gui_message s gui.gui_conn.conn_user.ui_user - - | AddServer_query (num, ip, port) -> - let n = network_find_by_num num in -@@ -1036,7 +1050,7 @@ - let s = n.op_network_add_server (Ip.addr_of_ip ip) port in - server_connect s - | RefreshUploadStats -> -- -+ if user2_can_view_uploads gui.gui_conn.conn_user.ui_user then - shared_iter (fun s -> - update_shared_info s; - ) -@@ -1044,6 +1058,11 @@ - | P.GetVersion -> - gui_send gui (P.Version Autoconf.current_version) - -+ | P.GetStats num -> -+ let n = network_find_by_num num in -+ let l = n.op_network_stat_info_list () in -+ gui_send gui (P.Stats (num, l)) -+ - | P.GiftAttach (profile, version, client) -> - let user, pass = - try -@@ -1080,13 +1099,13 @@ - with - Failure s -> - gui_send gui (Console (Printf.sprintf "Failure: %s\n" s)) -+ | Torrent_can_not_be_used -> -+ gui_send gui (Console (Printf.sprintf "\nError: This torrent does not have valid tracker URLs\n")) -+ | Torrent_already_exists -> -+ gui_send gui (Console (Printf.sprintf "\nError: This torrent is already in download queue\n")) - | e -> -- let error_text = Printexc2.to_string e in -- if error_text = "BTInteractive.Torrent_can_not_be_used" then -- gui_send gui (Console (Printf.sprintf "\nError: This torrent does not have valid tracker URLs\n")) -- else -- gui_send gui (Console (Printf.sprintf "from_gui: exception %s for message %s\n" -- (Printexc2.to_string e) (GuiProto.string_of_from_gui t))) -+ gui_send gui (Console (Printf.sprintf "from_gui: exception %s for message %s\n" -+ (Printexc2.to_string e) (GuiProto.string_of_from_gui t))) - - let gui_events () = - { -Index: src/daemon/driver/driverMain.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverMain.ml,v -retrieving revision 1.125 -retrieving revision 1.132 -diff -u -r1.125 -r1.132 ---- src/daemon/driver/driverMain.ml 5 Sep 2006 14:15:19 -0000 1.125 -+++ src/daemon/driver/driverMain.ml 19 Nov 2006 23:04:59 -0000 1.132 -@@ -84,7 +84,7 @@ - update_link_stats () - with e -> - lprintf_nl (_b "Exception %s") (Printexc2.to_string e)); -- (try -+ (try - CommonUploads.refill_upload_slots () - with e -> - lprintf_nl (_b "Exception %s") (Printexc2.to_string e)); -@@ -102,7 +102,8 @@ - | Some dir -> allowed_ips =:= !!allowed_ips - ); - -- if !!http_port <> 0 then begin try -+ if !!http_port <> 0 then begin -+ try - ignore (DriverControlers.create_http_handler ()); - with e -> - lprintf_nl (_b "Exception %s while starting HTTP interface") -@@ -218,7 +219,6 @@ - (try - Options.load downloads_ini; - Options.load users_ini; -- ignore (DriverInteractive.verify_user_admin ()); - DriverInteractive.hdd_check () - with e -> - lprintf_nl "Exception %s during options load" (Printexc2.to_string e); -@@ -341,15 +341,18 @@ - CommonGlobals.exit_properly 71 - end; - -- ( -- let hostname = "www.mldonkey.net" in -- try -- ignore(Ip.from_name hostname); -- DriverInteractive.dns_works := true -- with e -> -- lprintf (_b "\nDNS resolution does not work! Looking up %s failed with %s.") -- hostname (Printexc2.to_string e); -- lprintf " -+ ( let resolve_name hostname = -+ try -+ ignore (Ip.from_name hostname); -+ true -+ with _ -> false -+ in -+ let hostnames = -+ ["www.mldonkey.org"; "mldonkey.sf.net"; "www.mldonkey.net"; "www.google.com"] -+ in -+ DriverInteractive.dns_works := List.exists resolve_name hostnames; -+ -+ if not !DriverInteractive.dns_works then lprintf " - The core therefore is unable to get eDonkey serverlists and loading - .torrent files via dllink from websites is also impossible. - If you are using MLDonkey in a chroot environment you should -@@ -382,6 +385,9 @@ - end - end - ); -+ if not !Charset.conversion_enabled then -+ lprintf_nl (_b "Self-test failed, charset conversion disabled."); -+ - load_config (); - - add_infinite_option_timer download_sample_rate CommonFile.sample_timer; -@@ -399,7 +405,7 @@ - save_results =:= old_save_results; - end; - -- lprintf_nl (_b "Check http://www.mldonkey.net/ for updates"); -+ lprintf_nl (_b "Check http://www.mldonkey.org for updates"); - networks_iter (fun r -> network_load_complex_options r); - lprintf_nl (_b "enabling networks: "); - networks_iter (fun r -> -@@ -413,7 +419,7 @@ - lprintf_nl (_b "---- enabling interfaces ----"); - List.iter (fun (p,s) -> if p <> 0 then lprintf_nl "using port %d (%s)" p s) - (network_ports (network_find_by_name "Global Shares")); -- lprintf (_b "%sdisabled networks: ") (log_time ()); -+ lprintf (_b "%s[dMain] disabled networks: ") (log_time ()); - let found = ref false in - networks_iter_all (fun r -> - if not (network_is_enabled r) then -@@ -440,6 +446,23 @@ - add_infinite_timer 0.1 CommonUploads.upload_download_timer; - add_infinite_timer !!buffer_writes_delay (fun _ -> Unix32.flush ()); - -+ history_timeflag := (Unix.time()); -+ update_download_history (); -+ update_upload_history (); -+ history_h_timeflag := (Unix.time()); -+ update_h_download_history (); -+ update_h_upload_history (); -+ -+ add_infinite_timer (float_of_int history_step) (fun timer -> -+ history_timeflag := (Unix.time()); -+ update_download_history (); -+ update_upload_history ()); -+ -+ add_infinite_timer (float_of_int history_h_step) (fun timer -> -+ history_h_timeflag := (Unix.time()); -+ update_h_download_history (); -+ update_h_upload_history ()); -+ - if Autoconf.system = "mingw" then - add_infinite_timer 1. (fun timer -> - MlUnix.set_console_title (DriverInteractive.console_topic ())); -Index: src/gtk/gui/gui_messages.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/gtk/gui/gui_messages.ml,v -retrieving revision 1.7 -retrieving revision 1.8 -diff -u -r1.7 -r1.8 ---- src/gtk/gui/gui_messages.ml 5 Aug 2005 00:56:13 -0000 1.7 -+++ src/gtk/gui/gui_messages.ml 25 Oct 2006 11:34:46 -0000 1.8 -@@ -493,7 +493,7 @@ - ======== - - Release: %s --Authors: MLDonkey project, http://www.mldonkey.net/ -+Authors: MLDonkey project, http://www.mldonkey.org - - This documentation file is now obsolete. Read the FAQ instead (either - on the project WEB site or in the FAQ.html file). -@@ -503,9 +503,7 @@ - IRC channel: irc.freenode.net, chat #mldonkey - - Web sites: --http://www.mldonkey.net/ Official site, bug reports --http://www.mldonkeyworld.com/ English forum --http://www.mldonkey.org/ German forum -+http://www.mldonkey.org Official site - - Mailing-lists: - mldonkey-users@nongnu.org -Index: src/gtk/newgui/gui_friends.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/gtk/newgui/gui_friends.ml,v -retrieving revision 1.17 -retrieving revision 1.19 -diff -u -r1.17 -r1.19 ---- src/gtk/newgui/gui_friends.ml 21 Aug 2006 10:45:51 -0000 1.17 -+++ src/gtk/newgui/gui_friends.ml 31 Oct 2006 15:40:05 -0000 1.19 -@@ -72,7 +72,7 @@ - if len > maxlen then - (String.sub s 0 (maxlen-3)) ^ "..." - else if s = "" then -- "http://www.mldonkey.net/" -+ "http://www.mldonkey.org/" - else s - - let state_pix state = -@@ -430,6 +430,7 @@ - client_chat_port = 0; - client_connect_time = c.gclient_connect_time; - client_software = c.gclient_software; -+ client_os = None; - client_release = c.gclient_release; - client_emulemod = c.gclient_emulemod; - client_downloaded = c.gclient_downloaded; -@@ -637,6 +638,7 @@ - client_chat_port = 0; - client_connect_time = c.gclient_connect_time; - client_software = c.gclient_software; -+ client_os = None; - client_release = c.gclient_release; - client_emulemod = c.gclient_emulemod; - client_downloaded = c.gclient_downloaded; -Index: src/gtk/newgui/gui_installer_base.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/gtk/newgui/gui_installer_base.ml,v -retrieving revision 1.5 -retrieving revision 1.6 -diff -u -r1.5 -r1.6 ---- src/gtk/newgui/gui_installer_base.ml 1 Nov 2004 11:22:59 -0000 1.5 -+++ src/gtk/newgui/gui_installer_base.ml 12 Nov 2006 12:42:55 -0000 1.6 -@@ -0,0 +1 @@ -+let () = () -Index: src/gtk/newgui/gui_main.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/gtk/newgui/gui_main.ml,v -retrieving revision 1.18 -retrieving revision 1.19 -diff -u -r1.18 -r1.19 ---- src/gtk/newgui/gui_main.ml 27 Jun 2006 10:38:35 -0000 1.18 -+++ src/gtk/newgui/gui_main.ml 31 Oct 2006 15:40:05 -0000 1.19 -@@ -460,6 +460,7 @@ - | GiftServerAttach _ - | GiftServerStats _ -> assert false - | Version _ -+ | Stats (_, _) - | Search _ -> () - - with e -> -Index: src/gtk/newgui/gui_messages.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/gtk/newgui/gui_messages.ml,v -retrieving revision 1.12 -retrieving revision 1.13 -diff -u -r1.12 -r1.13 ---- src/gtk/newgui/gui_messages.ml 27 Jun 2006 10:38:35 -0000 1.12 -+++ src/gtk/newgui/gui_messages.ml 25 Oct 2006 11:34:46 -0000 1.13 -@@ -1645,7 +1645,7 @@ - ======== - - Release: %s --Authors: MLDonkey project, http://www.mldonkey.net/ -+Authors: MLDonkey project, http://www.mldonkey.org - - This documentation file is now obsolete. Read the FAQ instead (either - on the project WEB site or in the FAQ.html file). -@@ -1655,9 +1655,7 @@ - IRC channel: irc.freenode.net, chat #mldonkey - - Web sites: --http://www.mldonkey.net/ Official site, bug reports --http://www.mldonkeyworld.com/ English forum --http://www.mldonkey.org/ German forum -+http://www.mldonkey.org Official site - - Mailing-lists: - mldonkey-users@nongnu.org -Index: src/gtk/newgui/gui_misc.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/gtk/newgui/gui_misc.ml,v -retrieving revision 1.6 -retrieving revision 1.7 -diff -u -r1.6 -r1.7 ---- src/gtk/newgui/gui_misc.ml 16 Oct 2005 20:42:52 -0000 1.6 -+++ src/gtk/newgui/gui_misc.ml 25 Oct 2006 11:34:46 -0000 1.7 -@@ -44,7 +44,7 @@ - - let short_name n = - let n = if n="" then -- "http://www.mldonkey.net/" -+ "http://www.mldonkey.org" - else n - in - let len = String.length n in -Index: src/gtk2/gui/guiMessages.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/gtk2/gui/guiMessages.ml,v -retrieving revision 1.12 -retrieving revision 1.13 -diff -u -r1.12 -r1.13 ---- src/gtk2/gui/guiMessages.ml 1 Sep 2006 16:22:14 -0000 1.12 -+++ src/gtk2/gui/guiMessages.ml 25 Oct 2006 11:34:46 -0000 1.13 -@@ -1258,7 +1258,7 @@ - ======== - - Release: %s --Authors: MLDonkey project, http://www.mldonkey.net/ -+Authors: MLDonkey project, http://www.mldonkey.org/ - - This documentation file is now obsolete. Read the FAQ instead (either - on the project WEB site or in the FAQ.html file). -@@ -1268,9 +1268,7 @@ - IRC channel: irc.freenode.net, chat #mldonkey - - Web sites: --http://www.mldonkey.net/ Official site, bug reports --http://www.mldonkeyworld.com/ English forum --http://www.mldonkey.org/ German forum -+http://www.mldonkey.org Official site - - Mailing-lists: - mldonkey-users@nongnu.org -Index: src/gtk2/gui/guiRooms.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/gtk2/gui/guiRooms.ml,v -retrieving revision 1.3 -retrieving revision 1.4 -diff -u -r1.3 -r1.4 ---- src/gtk2/gui/guiRooms.ml 12 Nov 2005 11:16:36 -0000 1.3 -+++ src/gtk2/gui/guiRooms.ml 9 Nov 2006 21:32:26 -0000 1.4 -@@ -524,7 +524,7 @@ - let find_user_name user_num = - try - let u = Hashtbl.find G.users user_num in -- u.user_name -+ u.GuiTypes.user_name - with _ -> raise Not_found - - let message_from_server s = -Index: src/gtk2/gui/guiStarter.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/gtk2/gui/guiStarter.ml,v -retrieving revision 1.3 -retrieving revision 1.4 -diff -u -r1.3 -r1.4 ---- src/gtk2/gui/guiStarter.ml 31 Oct 2005 18:34:02 -0000 1.3 -+++ src/gtk2/gui/guiStarter.ml 6 Nov 2006 18:06:08 -0000 1.4 -@@ -22,6 +22,17 @@ - let _s_ x = (_s x) ^ ":" - - let main () = -+ let arg_1 = -+ try -+ Sys.argv.(1) -+ with _ -> "" -+ in -+ if not (Sys.file_exists arg_1) then -+ begin -+ if arg_1 <> "" then Printf.printf "File %s not found\n%!" arg_1; -+ Printf.printf "Syntax: mlguistarter FILE\n%!"; -+ exit 0 -+ end; - ignore (GMain.Main.init ()); - let window = GWindow.window - ~title:(_s "MLdonkey GUI starter") -@@ -57,7 +68,7 @@ - ignore (wb_5#connect#clicked ~callback: - (fun () -> - window#destroy (); -- ignore (Sys.command (Printf.sprintf "%s &" Sys.argv.(1))); -+ ignore (Sys.command (Printf.sprintf "%s &" arg_1)); - )); - ignore (wb_6#connect#clicked ~callback: - (fun () -> -Index: src/gtk2/gui/guiUsers.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/gtk2/gui/guiUsers.ml,v -retrieving revision 1.3 -retrieving revision 1.4 -diff -u -r1.3 -r1.4 ---- src/gtk2/gui/guiUsers.ml 12 Nov 2005 11:16:36 -0000 1.3 -+++ src/gtk2/gui/guiUsers.ml 9 Nov 2006 21:32:26 -0000 1.4 -@@ -184,7 +184,7 @@ - (*************************************************************************) - - method from_item row (u : user_info) = -- store#set ~row ~column:user_name (U.utf8_of u.user_name); -+ store#set ~row ~column:user_name (U.utf8_of u.GuiTypes.user_name); - store#set ~row ~column:user_ip_port (Mi.ip_to_string u.user_ip u.user_port); - store#set ~row ~column:user_md4 (Md4.to_string u.user_md4); - store#set ~row ~column:user_tags (Mi.tags_to_string u.user_tags) -@@ -262,7 +262,7 @@ - let u1 = user_of_key k1 in - let u2 = user_of_key k2 in - match c with -- Col_user_name -> compare (String.lowercase u1.user_name) (String.lowercase u2.user_name) -+ Col_user_name -> compare (String.lowercase u1.GuiTypes.user_name) (String.lowercase u2.GuiTypes.user_name) - | Col_user_addr -> compare u1.user_ip u2.user_ip - | Col_user_tags -> compare u1.user_tags u2.user_tags - | Col_user_md4 -> compare u1.user_md4 u2.user_md4 -Index: src/networks/bittorrent/bTClients.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTClients.ml,v -retrieving revision 1.77 -retrieving revision 1.84 -diff -u -r1.77 -r1.84 ---- src/networks/bittorrent/bTClients.ml 16 Sep 2006 09:47:17 -0000 1.77 -+++ src/networks/bittorrent/bTClients.ml 5 Nov 2006 14:09:38 -0000 1.84 -@@ -131,14 +131,24 @@ - in - - let enabled_trackers = -- let enabled_trackers = List.filter (fun t -> t.tracker_enabled) file.file_trackers in -+ let enabled_trackers = List.filter (fun t -> tracker_is_enabled t) file.file_trackers in - if enabled_trackers <> [] then enabled_trackers - else begin - (* if there is no tracker left, do something ? *) - if !verbose_msg_servers then -- lprintf_nl "No trackers left, reenabling all of them..."; -- List.iter (fun t -> t.tracker_enabled <- can_handle_tracker t) file.file_trackers; -- file.file_trackers -+ lprintf_nl "No trackers left for %s, reenabling all of them..." (file_best_name (as_file file)); -+ List.iter (fun t -> -+ match t.tracker_status with -+ (* only re-enable after normal error *) -+ Disabled _ -> t.tracker_status <- Enabled -+ | _ -> ()) file.file_trackers; -+ let enabled_trackers = List.filter (fun t -> t.tracker_status = Enabled) file.file_trackers in -+ if enabled_trackers = [] && (file_state file) <> FilePaused then -+ begin -+ file_pause (as_file file) CommonUserDb.admin_user; -+ lprintf_file_nl (as_file file) "Paused %s, no usable trackers left" (file_best_name (as_file file)) -+ end; -+ file.file_trackers; - end in - - List.iter (fun t -> -@@ -155,13 +165,12 @@ - t.tracker_last_conn + !!min_tracker_reask_interval < last_time() )) - then - begin -- (* if we already tried to connect but failed, remove tracker *) -+ (* if we already tried to connect but failed, disable tracker, but allow re-enabling *) - if file.file_tracker_connected && t.tracker_last_clients_num = 0 && - t.tracker_last_conn < 1 then begin - if !verbose_msg_servers then - lprintf_nl "Request error from tracker: disabling %s" t.tracker_url; -- t.tracker_enabled <- false; -- (* remove_tracker t.tracker_url file *) -+ t.tracker_status <- Disabled (intern "MLDonkey: Request error from tracker") - end - (* Send request to tracker *) - else begin -@@ -205,6 +214,15 @@ - t.tracker_url (t.tracker_interval - (last_time () - t.tracker_last_conn)) file.file_name - ) enabled_trackers - -+let start_upload c = -+ set_client_upload (as_client c) (as_file c.client_file); -+ set_client_has_a_slot (as_client c) NormalSlot; -+ Rate.update_no_change c.client_downloaded_rate; -+ Rate.update_no_change c.client_upload_rate; -+ c.client_last_optimist <- last_time(); -+ client_enter_upload_queue (as_client c); -+ send_client c Unchoke -+ - (** In this function we decide which peers will be - uploaders. We send a choke message to current uploaders - that are not in the next uploaders list. We send Unchoke -@@ -216,21 +234,14 @@ - (*Send choke if a current_uploader is not in next_uploaders*) - List.iter ( fun c -> if ((List.mem c !next_uploaders)==false) then - begin -- set_client_has_a_slot (as_client c) false; -+ set_client_has_a_slot (as_client c) NoSlot; - (*we will let him finish his download and choke him on next_request*) - end - ) !current_uploaders; - - (*don't send Choke if new uploader is already an uploaders *) -- List.iter ( fun c -> if ((List.mem c !current_uploaders)==false) then -- begin -- set_client_has_a_slot (as_client c) true; -- Rate.update_no_change c.client_downloaded_rate; -- Rate.update_no_change c.client_upload_rate; -- c.client_last_optimist <- last_time(); -- client_enter_upload_queue (as_client c); -- send_client c Unchoke; -- end -+ List.iter ( fun c -> -+ if not (List.mem c !current_uploaders) then start_upload c - ) !next_uploaders; - current_uploaders := !next_uploaders - -@@ -322,7 +333,7 @@ - if not ( !must_keep && (client_has_a_slot (as_client c) || c.client_interested)) then - begin - if !verbose_msg_clients then -- lprintf_file_nl file "disconnect since download is finished"; -+ lprintf_file_nl (as_file file) "disconnect since download is finished"; - disconnect_client c Closed_by_user - end - ) file.file_clients -@@ -414,6 +425,17 @@ - - let counter = ref 0 - -+let parse_reserved rbits c = -+ let has_bit pos h = Char.code rbits.[pos] land h <> 0 in -+ -+ c.client_dht <- has_bit 7 0x01; -+ c.client_cache_extension <- has_bit 7 0x02; -+ c.client_fast_extension <- has_bit 7 0x04; -+ -+ c.client_utorrent_extension <- has_bit 5 0x10; -+ -+ c.client_azureus_messaging_protocol <- has_bit 0 0x80 -+ - - (** This function is called to parse the first message that - a client send. -@@ -428,7 +450,7 @@ - (* removed: @param peer_id The hash (sha1) of the client. (Should be checked) - *) - let rec client_parse_header counter cc init_sent gconn sock -- (proto, file_id) = -+ (proto, rbits, file_id) = - try - set_lifetime sock 600.; - if !verbose_msg_clients then -@@ -436,12 +458,12 @@ - - let file = Hashtbl.find files_by_uid file_id in - if !verbose_msg_clients then -- lprintf_file_nl file "file found"; -+ lprintf_file_nl (as_file file) "file found"; - let c = - match !cc with - None -> - let c = new_client file Sha1.null (TcpBufferedSocket.peer_addr sock) in -- if !verbose_connect then lprintf_file_nl file "Client %d: incoming connection" (client_num c); -+ if !verbose_connect then lprintf_file_nl (as_file file) "Client %d: incoming connection" (client_num c); - cc := Some c; - c - | Some c -> -@@ -482,6 +504,8 @@ - (Ip.to_string ip) port; - end; - -+ parse_reserved rbits c; -+ - (match c.client_sock with - NoConnection -> - if !verbose_msg_clients then begin -@@ -603,9 +627,8 @@ - - let num, x,y, r = - -- if !verbose_msg_clients then begin -- lprintf_file_nl file "CLIENT %d: Finding new range to send" (client_num c); -- end; -+ if !verbose_msg_clients then -+ lprintf_file_nl (as_file file) "CLIENT %d: Finding new range to send" (client_num c); - - if !verbose_swarming then begin - lprintf_n "Current download:\n Current chunks: "; -@@ -638,7 +661,7 @@ - - lprint_newline (); - -- lprintf_file_nl file "Finding Range:"; -+ lprintf_file_nl (as_file file) "Finding Range:"; - end; - - try -@@ -653,7 +676,7 @@ - - | None -> - -- if !verbose_swarming then lprintf_file_nl file "No block"; -+ if !verbose_swarming then lprintf_file_nl (as_file file) "No block"; - update_client_bitmap c; - (try CommonSwarming.verify_one_chunk swarmer with _ -> ()); - (*Find a free block in the swarmer*) -@@ -707,7 +730,7 @@ - number. Only matters with merged downloads, and even then other - clients didn't seem to care (?), so the bug remained hidden *) - if !verbose_swarming then -- lprintf_file_nl file "Asking %d For Range %Ld-%Ld" chunk x y; -+ lprintf_file_nl (as_file file) "Asking %d For Range %Ld-%Ld" chunk x y; - - chunk, x -- file.file_piece_size ** Int64.of_int chunk, y -- x, r - -@@ -742,12 +765,12 @@ - send_client c (Request (num,x,y)); - - if !verbose_msg_clients then -- lprintf_file_nl file "CLIENT %d: Asking %s For Range %Ld-%Ld" -+ lprintf_file_nl (as_file file) "CLIENT %d: Asking %s For Range %Ld-%Ld" - (client_num c) (Sha1.to_string c.client_uid) x y - - with Not_found -> - if not (CommonSwarming.check_finished swarmer) && !verbose_download then -- lprintf_file_nl file "BTClient.get_from_client ERROR: can't find a block to download and file is not yet finished for file : %s..." file.file_name -+ lprintf_file_nl (as_file file) "BTClient.get_from_client ERROR: can't find a block to download and file is not yet finished for file : %s..." file.file_name - - - (** In this function we match a message sent by a client -@@ -799,10 +822,10 @@ - - if !verbose_msg_clients then - (match c.client_ranges_sent with -- [] -> lprintf_file_nl file "EMPTY Ranges !!!" -+ [] -> lprintf_file_nl (as_file file) "EMPTY Ranges !!!" - | (p1,p2,r) :: _ -> - let (x,y) = CommonSwarming.range_range r in -- lprintf_file_nl file "Current range from %s : %Ld [%d] (asked %Ld-%Ld[%Ld-%Ld])" -+ lprintf_file_nl (as_file file) "Current range from %s : %Ld [%d] (asked %Ld-%Ld[%Ld-%Ld])" - (brand_to_string c.client_brand) position len - p1 p2 x y - ); -@@ -822,10 +845,10 @@ - Rate.update c.client_downloaded_rate (float_of_int len); - if !verbose_msg_clients then - (match c.client_ranges_sent with -- [] -> lprintf_file_nl file "EMPTY Ranges !!!" -+ [] -> lprintf_file_nl (as_file file) "EMPTY Ranges !!!" - | (p1,p2,r) :: _ -> - let (x,y) = CommonSwarming.range_range r in -- lprintf_file_nl file "Received %Ld [%d] %Ld-%Ld[%Ld-%Ld] -> %Ld" -+ lprintf_file_nl (as_file file) "Received %Ld [%d] %Ld-%Ld[%Ld-%Ld] -> %Ld" - position len - p1 p2 x y - (new_downloaded -- old_downloaded) -@@ -852,12 +875,7 @@ - *) - current_uploaders := c::(!current_uploaders); - c.client_sent_choke <- false; -- set_client_has_a_slot (as_client c) true; -- Rate.update_no_change c.client_downloaded_rate; -- Rate.update_no_change c.client_upload_rate; -- c.client_last_optimist <- last_time(); -- client_enter_upload_queue (as_client c); -- send_client c Unchoke; -+ start_upload c - end; - - (* Check if the client is still interesting for us... *) -@@ -865,6 +883,7 @@ - - | PeerID p -> - (* Disconnect if that is ourselves. *) -+ c.client_uid <- Sha1.direct_of_string p; - if not (c.client_uid = !!client_uid) then - begin - let brand, release = parse_software p in -@@ -873,7 +892,6 @@ - (* TODO : enable it - c.client_release <- (parse_release p c.client_brand); - *) -- c.client_uid <- Sha1.direct_of_string p; - - if (List.length !current_uploaders < (!!max_bt_uploaders-1)) && - (List.mem c (!current_uploaders)) == false then -@@ -882,12 +900,7 @@ - don't miss the opportunity if we can *) - current_uploaders := c::(!current_uploaders); - c.client_sent_choke <- false; -- set_client_has_a_slot (as_client c) true; -- Rate.update_no_change c.client_downloaded_rate; -- Rate.update_no_change c.client_upload_rate; -- c.client_last_optimist <- last_time(); -- client_enter_upload_queue (as_client c); -- send_client c Unchoke; -+ start_upload c - end - else - begin -@@ -911,7 +924,7 @@ - let nbits = String.length p * 8 in - - if nbits < npieces then begin -- lprintf_file_nl file "Error: expected bitfield of atleast %d but got %d" npieces nbits; -+ lprintf_file_nl (as_file file) "Error: expected bitfield of atleast %d but got %d" npieces nbits; - disconnect_client c (Closed_for_error "Wrong bitfield length") - end else begin - -@@ -934,7 +947,7 @@ - send_interested c; - - if !verbose_msg_clients then -- lprintf_file_nl file "New BitField Registered"; -+ lprintf_file_nl (as_file file) "New BitField Registered"; - - (* for i = 1 to max_range_requests - List.length c.client_ranges do - (try get_from_client sock c with _ -> ()) -@@ -1003,7 +1016,7 @@ - (* Afaik this is no protocol violation and happens if the client - didn't send a client bitmap after the handshake. *) - let (ip,port) = c.client_host in -- if !verbose_msg_clients then lprintf_file_nl file "%s:%d with software %s : Choke send, but no client bitmap" -+ if !verbose_msg_clients then lprintf_file_nl (as_file file) "%s:%d with software %s : Choke send, but no client bitmap" - (Ip.to_string ip) port (brand_to_string c.client_brand) - | Some up -> - CommonSwarming.clear_uploader_intervals up -@@ -1068,10 +1081,10 @@ - c.client_upload_requests <- List2.remove_first (n, pos, len) c.client_upload_requests - else - if !verbose_msg_clients then -- lprintf_file_nl file "Error: received cancel request but client has no slot" -+ lprintf_file_nl (as_file file) "Error: received cancel request but client has no slot" - - with e -> -- lprintf_file_nl file "Error %s while handling MESSAGE: %s" (Printexc2.to_string e) (TcpMessages.to_string msg) -+ lprintf_file_nl (as_file file) "Error %s while handling MESSAGE: %s" (Printexc2.to_string e) (TcpMessages.to_string msg) - - - (** The function used to connect to a client. -@@ -1136,7 +1149,7 @@ - let file = c.client_file in - - if !verbose_msg_clients then -- lprintf_file_nl file "READY TO DOWNLOAD FILE"; -+ lprintf_file_nl (as_file file) "READY TO DOWNLOAD FILE"; - - send_init !!client_uid file.file_id sock; - (* Fabrice: Initialize the client bitmap and uploader fields to <> None *) -@@ -1284,7 +1297,7 @@ - with _ -> ()) - with e -> - if !verbose_connect then -- lprintf_file_nl file "Exception %s in resume_clients" (Printexc2.to_string e) -+ lprintf_file_nl (as_file file) "Exception %s in resume_clients" (Printexc2.to_string e) - ) file.file_clients - - (** Check if the value replied by the tracker is correct. -@@ -1321,13 +1334,13 @@ - let tracker_reply = - try - File.to_string filename -- with e -> lprintf_file_nl file "Empty reply from tracker"; "" -+ with e -> lprintf_file_nl (as_file file) "Empty reply from tracker"; "" - in - let v = - match tracker_reply with - | "" -> - if !verbose_connect then -- lprintf_file_nl file "Empty reply from tracker"; -+ lprintf_file_nl (as_file file) "Empty reply from tracker"; - Bencode.decode "" - | _ -> Bencode.decode tracker_reply - in -@@ -1339,13 +1352,12 @@ - List.iter (fun (key,value) -> - match (key, value) with - | String "failure reason", String failure -> -- (* On failure, remove the faulty tracker from file.file_trackers list *) -- t.tracker_enabled <- false; -- (* remove_tracker t.tracker_url file; *) -- lprintf_file_nl file "Failure from Tracker %s in file: %s Reason: %s\nBT: Tracker %s disabled for failure" -+ (* On failure, disable the tracker and forbid re-enabling *) -+ t.tracker_status <- Disabled_failure (intern failure); -+ lprintf_file_nl (as_file file) "Failure from Tracker %s in file: %s Reason: %s\nBT: Tracker %s disabled for failure" - t.tracker_url file.file_name (Charset.to_utf8 failure) t.tracker_url - | String "warning message", String warning -> -- lprintf_file_nl file "Warning from Tracker %s in file: %s Reason: %s" t.tracker_url file.file_name warning -+ lprintf_file_nl (as_file file) "Warning from Tracker %s in file: %s Reason: %s" t.tracker_url file.file_name warning - | String "interval", Int n -> - t.tracker_interval <- chk_keyval (Bencode.print key) n t.tracker_url file.file_name; - (* in case we don't receive "min interval" *) -@@ -1376,11 +1388,11 @@ - | String "key", String n -> - t.tracker_key <- n; - if !verbose_msg_clients then -- lprintf_file_nl file "%s in file: %s has key: %s" t.tracker_url file.file_name n -+ lprintf_file_nl (as_file file) "%s in file: %s has key: %s" t.tracker_url file.file_name n - | String "tracker id", String n -> - t.tracker_id <- n; - if !verbose_msg_clients then -- lprintf_file_nl file "%s in file: %s has tracker id %s" t.tracker_url file.file_name n -+ lprintf_file_nl (as_file file) "%s in file: %s has tracker id %s" t.tracker_url file.file_name n - - | String "peers", List list -> - List.iter (fun v -> -@@ -1412,13 +1424,13 @@ - None -> true - | Some reason -> - if !verbose_connect then -- lprintf_file_nl file "%s:%d blocked: %s" -+ lprintf_file_nl (as_file file) "%s:%d blocked: %s" - (Ip.to_string !peer_ip) !port reason; - false) - then - let _ = new_client file !peer_id (!peer_ip,!port) - in -- if !verbose_sources > 1 then lprintf_file_nl file "Received %s:%d" (Ip.to_string !peer_ip) -+ if !verbose_sources > 1 then lprintf_file_nl (as_file file) "Received %s:%d" (Ip.to_string !peer_ip) - !port; - () - | _ -> assert false -@@ -1439,12 +1451,12 @@ - | String "private", Int n -> () - (* TODO: if set to 1, disable peer exchange *) - -- | _ -> lprintf_file_nl file "received unknown entry in answer from tracker: %s : %s" (Bencode.print key) (Bencode.print value) -+ | _ -> lprintf_file_nl (as_file file) "received unknown entry in answer from tracker: %s : %s" (Bencode.print key) (Bencode.print value) - ) list; - (*Now, that we have added new clients to a file, it's time - to connect to them*) - if !verbose_sources > 0 then -- lprintf_file_nl file "get_sources_from_tracker: got %i source(s) for file %s" -+ lprintf_file_nl (as_file file) "get_sources_from_tracker: got %i source(s) for file %s" - t.tracker_last_clients_num file.file_name; - resume_clients file - -@@ -1473,7 +1485,7 @@ - (try - connect_trackers file "" (fun _ _ -> ()) with _ -> ()) - | FilePaused -> () (*when we are paused we do nothing, not even logging this vvvv*) -- | s -> lprintf_file_nl file "Other state %s!!" (string_of_state s) -+ | s -> lprintf_file_nl (as_file file) "Other state %s!!" (string_of_state s) - ) !current_files - - let upload_buffer = String.create 100000 -@@ -1554,13 +1566,12 @@ - iter_upload sock c - ) - -- --(** Probably useless now --*) - let file_resume file = -- (*useless with no saving of sources -- resume_clients file; -- *) -+ List.iter (fun t -> -+ match t.tracker_status with -+ Enabled -> () -+ | _ -> t.tracker_status <- Enabled -+ ) file.file_trackers; - (try get_sources_from_tracker file with _ -> ()) - - -@@ -1573,7 +1584,7 @@ - if file.file_tracker_connected then - begin - connect_trackers file "stopped" (fun _ _ -> -- lprintf_file_nl file "Tracker return: stopped %s" file.file_name; -+ lprintf_file_nl (as_file file) "Tracker return: stopped %s" file.file_name; - file.file_tracker_connected <- false) - end - -Index: src/networks/bittorrent/bTComplexOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTComplexOptions.ml,v -retrieving revision 1.36 -retrieving revision 1.38 -diff -u -r1.36 -r1.38 ---- src/networks/bittorrent/bTComplexOptions.ml 16 Sep 2006 09:47:17 -0000 1.36 -+++ src/networks/bittorrent/bTComplexOptions.ml 1 Oct 2006 17:47:11 -0000 1.38 -@@ -183,8 +183,9 @@ - (Printf.sprintf "BT-%s" (Sha1.to_string file_id)) in - file_temp - in -- let file = new_file file_id torrent torrent_diskname file_temp file_state in -- -+ let file = new_file file_id torrent torrent_diskname -+ file_temp file_state CommonUserDb.admin_user in -+ - let file_uploaded = try - value_to_int64 (List.assoc "file_uploaded" assocs) - with _ -> zero -@@ -249,7 +250,7 @@ - CommonSwarming.frontend_to_value swarmer assocs - with - e -> -- lprintf_file_nl file "exception %s in file_to_value" -+ lprintf_file_nl (as_file file) "exception %s in file_to_value" - (Printexc2.to_string e); raise e - - -Index: src/networks/bittorrent/bTGlobals.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTGlobals.ml,v -retrieving revision 1.63 -retrieving revision 1.71 -diff -u -r1.63 -r1.71 ---- src/networks/bittorrent/bTGlobals.ml 16 Sep 2006 09:47:17 -0000 1.63 -+++ src/networks/bittorrent/bTGlobals.ml 9 Nov 2006 21:32:27 -0000 1.71 -@@ -31,6 +31,7 @@ - open CommonServer - open CommonResult - open CommonFile -+open CommonShared - open BasicSocket - open CommonGlobals - open Options -@@ -107,6 +108,45 @@ - let (client_ops : client CommonClient.client_ops) = - CommonClient.new_client_ops network - -+let must_share_file file codedname has_old_impl = -+ match file.file_shared with -+ | Some _ -> () -+ | None -> -+ begin -+ let impl = { -+ impl_shared_update = 1; -+ impl_shared_fullname = file_disk_name file; -+ impl_shared_codedname = codedname; -+ impl_shared_size = file_size file; -+ impl_shared_id = Md4.null; -+ impl_shared_num = 0; -+ impl_shared_uploaded = Int64.zero; -+ impl_shared_ops = shared_ops; -+ impl_shared_val = file; -+ impl_shared_requests = 0; -+ impl_shared_magic = None; -+ impl_shared_servers = []; -+ } in -+ file.file_shared <- Some impl; -+ incr CommonGlobals.nshared_files; -+ CommonShared.shared_calculate_total_bytes (); -+ match has_old_impl with -+ None -> update_shared_num impl -+ | Some old_impl -> replace_shared old_impl impl -+ end -+ -+let must_share_file file = must_share_file file (file_best_name (as_file file)) None -+ -+let unshare_file file = -+ match file.file_shared with -+ None -> () -+ | Some s -> -+ begin -+ file.file_shared <- None; -+ decr CommonGlobals.nshared_files; -+ CommonShared.shared_calculate_total_bytes () -+ end -+ - module DO = CommonOptions - - let current_files = ref ([] : BTTypes.file list) -@@ -126,10 +166,6 @@ - let lprintf_nl fmt = - lprintf_nl2 log_prefix fmt - --let lprintf_file_nl file fmt = -- lprintf_nl2 (log_prefix^" [file_num "^(string_of_int (file_num file))^"]") fmt -- -- - let lprintf_n fmt = - lprintf2 log_prefix fmt - -@@ -217,13 +253,14 @@ - tracker_torrent_last_dl_req = 0; - tracker_id = ""; - tracker_key = ""; -- tracker_enabled = true -+ tracker_status = Enabled - } in -- t.tracker_enabled <- can_handle_tracker t; -+ if not (can_handle_tracker t) then -+ t.tracker_status <- Disabled_mld (intern "Tracker type not supported"); - file.file_trackers <- t :: file.file_trackers; - set_trackers file q - --let new_file file_id t torrent_diskname file_temp file_state = -+let new_file file_id t torrent_diskname file_temp file_state user = - try - Hashtbl.find files_by_uid file_id - with Not_found -> -@@ -233,7 +270,7 @@ - file_file = file_impl; - file_piece_size = t.torrent_piece_size; - file_id = file_id; -- file_name = t.torrent_name; -+ file_name = Charset.safe_convert t.torrent_encoding t.torrent_name; - file_comment = t.torrent_comment; - file_created_by = t.torrent_created_by; - file_creation_date = t.torrent_creation_date; -@@ -252,6 +289,8 @@ - file_shared = None; - } and file_impl = { - dummy_file_impl with -+ impl_file_owner = user; -+ impl_file_group = user.user_default_group; - impl_file_fd = Some file_fd; - impl_file_size = t.torrent_length; - impl_file_downloaded = Int64.zero; -@@ -296,18 +335,18 @@ - current_files := file :: !current_files; - Hashtbl.add files_by_uid file_id file; - file_add file_impl file_state; --(* lprintf "ADD FILE TO DOWNLOAD LIST\n"; *) -+ must_share_file file; - file - --let new_download file_id t torrent_diskname = -+let new_download file_id t torrent_diskname user = - let file_temp = Filename.concat !!DO.temp_directory - (Printf.sprintf "BT-%s" (Sha1.to_string file_id)) in -- new_file file_id t torrent_diskname file_temp FileDownloading -+ new_file file_id t torrent_diskname file_temp FileDownloading user - - let ft_by_num = Hashtbl.create 13 - let ft_counter = ref 0 - --let new_ft file_name = -+let new_ft file_name user = - incr ft_counter; - let rec ft = { - ft_file = file_impl; -@@ -316,6 +355,8 @@ - ft_retry = (fun _ -> ()); - } and file_impl = { - dummy_file_impl with -+ impl_file_owner = user; -+ impl_file_group = user.user_default_group; - impl_file_fd = None; - impl_file_size = zero; - impl_file_downloaded = Int64.zero; -@@ -419,6 +460,11 @@ - | "TR" -> Brand_transmission - | "HN" -> Brand_hydranode - | "RT" -> Brand_retriever -+ | "PC" -> Brand_cachelogic -+ | "ES" -> Brand_electricsheep -+ | "qB" -> Brand_qbittorrent -+ | "QT" -> Brand_qt4 -+ | "UL" -> Brand_uleecher - | _ -> Brand_unknown - in - if brand = Brand_unknown then None else -@@ -450,6 +496,7 @@ - | "A" -> Brand_abc - | "U" -> Brand_upnp - | "O" -> Brand_osprey -+ | "R" -> Brand_tribler - | _ -> Brand_unknown - in - let bv = ref None in -@@ -742,7 +789,7 @@ - client_downloaded = zero; - client_upload_rate = Rate.new_rate (); - client_downloaded_rate = Rate.new_rate (); -- client_optimist_time=0; -+ client_connect_time = last_time (); - client_blocks_sent = []; - client_new_chunks = []; - client_good = false; -@@ -753,6 +800,11 @@ - client_incoming = false; - client_registered_bitfield = false; - client_last_optimist = 0; -+ client_dht = false; -+ client_cache_extension = false; -+ client_fast_extension = false; -+ client_utorrent_extension = false; -+ client_azureus_messaging_protocol = false; - } and impl = { - dummy_client_impl with - impl_client_val = c; -@@ -789,6 +841,11 @@ - lprintf_nl "New tracker list :%s" tracker.tracker_url - ) file.file_trackers - -+let tracker_is_enabled t = -+ match t.tracker_status with -+ Enabled -> true -+ | _ -> false -+ - let torrents_directory = "torrents" - let new_torrents_directory = Filename.concat torrents_directory "incoming" - let downloads_directory = Filename.concat torrents_directory "downloads" -Index: src/networks/bittorrent/bTInteractive.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTInteractive.ml,v -retrieving revision 1.108 -retrieving revision 1.123 -diff -u -r1.108 -r1.123 ---- src/networks/bittorrent/bTInteractive.ml 16 Sep 2006 09:47:17 -0000 1.108 -+++ src/networks/bittorrent/bTInteractive.ml 12 Nov 2006 14:17:45 -0000 1.123 -@@ -52,8 +52,34 @@ - - module VB = VerificationBitmap - --exception Already_exists --exception Torrent_can_not_be_used -+let porttest_result = ref PorttestNotStarted -+ -+let interpret_azureus_porttest s = -+ let failure_message fmt = -+ Printf.sprintf ("Port test failure, " ^^ fmt) in -+ try -+ let value = decode s in -+ match value with -+ | Dictionary alist -> -+ (try -+ match List.assoc (String "result") alist with -+ | Int 1L -> "Port test OK!" -+ | Int 0L -> -+ (try -+ match List.assoc (String "reason") alist with -+ | String reason -> failure_message "%s" reason -+ | _ -> raise Not_found -+ with Not_found -> -+ failure_message "%s" "no reason given") -+ | Int status -> -+ failure_message "unknown status code (%Ld)" status -+ | _ -> raise Not_found -+ with Not_found -> -+ failure_message "%s" "no status given") -+ | _ -> -+ failure_message "unexpected value type %s" (Bencode.print value) -+ with _ -> -+ failure_message "%s" "broken bencoded value" - - let op_file_all_sources file = - let list = ref [] in -@@ -101,7 +127,7 @@ - set_file_state file FileShared; - - if Unix32.destroyed (file_fd file) then -- if !verbose then lprintf_file_nl file "op_file_commit: FD is destroyed... repairing"; -+ if !verbose then lprintf_file_nl (as_file file) "op_file_commit: FD is destroyed... repairing"; - - (* During the commit operation, for security, the file_fd is destroyed. So - we create it again to be able to share this file again. *) -@@ -110,7 +136,7 @@ - (create_temp_file new_name (List.map (fun (file,size,_) -> (file,size)) file.file_files) (file_state file)); - - if Unix32.destroyed (file_fd file) then -- lprintf_file_nl file "op_file_commit: FD is destroyed... could not repair!"; -+ lprintf_file_nl (as_file file) "op_file_commit: FD is destroyed... could not repair!"; - - let new_torrent_diskname = - Filename.concat seeded_directory -@@ -119,20 +145,20 @@ - (try - Unix2.rename file.file_torrent_diskname new_torrent_diskname; - with _ -> -- (lprintf_file_nl file "op_file_commit: failed to rename %s to %s" -+ (lprintf_file_nl (as_file file) "op_file_commit: failed to rename %s to %s" - file.file_torrent_diskname new_torrent_diskname)); - file.file_torrent_diskname <- new_torrent_diskname; - - end - --let op_file_print_html file buf = -- -- html_mods_cntr_init (); -+let op_file_print file o = - -+ let buf = o.conn_buf in -+ if use_html_mods o then begin - Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); - html_mods_td buf [ - ("Filename", "sr br", "Filename"); -- ("", "sr", file.file_name) ]; -+ ("", "sr", (Charset.safe_convert file.file_encoding file.file_name)) ]; - - Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); - html_mods_td buf [ -@@ -143,24 +169,27 @@ - ]; - - Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); -- html_mods_td buf [ -- ("Tracker(s)", "sr br", "Tracker(s)"); -- ("", "sr", -- (let enabled_tracker_string = ref "" in -- let disabled_tracker_string = ref "" in -- List.iter (fun tracker -> -- if tracker.tracker_enabled then -- enabled_tracker_string := !enabled_tracker_string ^ (shorten tracker.tracker_url !!max_name_len) ^ " " -- else -- disabled_tracker_string := !disabled_tracker_string ^ (shorten tracker.tracker_url !!max_name_len) ^ " " -- ) file.file_trackers; -- (!enabled_tracker_string ^ (if !disabled_tracker_string <> "" then " - disabled: " ^ !disabled_tracker_string else "")))) ]; -- -- 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, "") -+ in -+ html_mods_td buf [ -+ (if not !tracker_header_printed then -+ ("Tracker(s) (mouseover for errors)", "sr br", "Tracker(s)") -+ else -+ ("", "sr br", "")); -+ (tracker_error, "sr", tracker_text)]; -+ Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); -+ tracker_header_printed := true; -+ ) file.file_trackers; - - html_mods_td buf [ - ("Torrent Filename", "sr br", "Torrent Fname"); -- ("", "sr", file.file_torrent_diskname) ]; -+ ("", "sr", (Charset.safe_convert file.file_encoding file.file_torrent_diskname)) ]; - - Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); - -@@ -168,14 +197,14 @@ - ("Comment", "sr br", "Comment"); - ("", "sr", match file.file_comment with - "" -> "-" -- | _ -> file.file_comment) ]; -+ | _ -> (Charset.safe_convert file.file_encoding file.file_comment)) ]; - - Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); - html_mods_td buf [ - ("Created by", "sr br", "Created by"); - ("", "sr", match file.file_created_by with - "" -> "-" -- | _ -> file.file_created_by) ]; -+ | _ -> (Charset.safe_convert file.file_encoding file.file_created_by)) ]; - - Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); - html_mods_td buf [ -@@ -187,7 +216,7 @@ - ("Modified by", "sr br", "Modified by"); - ("", "sr", match file.file_modified_by with - "" -> "-" -- | _ -> file.file_modified_by) ]; -+ | _ -> (Charset.safe_convert file.file_encoding file.file_modified_by)) ]; - - Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); - html_mods_td buf [ -@@ -200,7 +229,7 @@ - match l with - | [] -> () - | t :: q -> -- if not t.tracker_enabled then print_first_tracker q -+ if not (tracker_is_enabled t) then print_first_tracker q - else begin - Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); - html_mods_td buf [ -@@ -262,24 +291,42 @@ - end in - print_first_tracker file.file_trackers; - -+ (* This is bad. Magic info should be automatically filled in when -+ the corresponding chunks complete. (see CommonSwarming) -+ -+ This code only fills in the magic info for subfiles when a user -+ manually performs a "vd #". (interfaces out of sync) -+ -+ Magic info for shared files with subfiles is missing as well? -+ *) -+ if !Autoconf.magic_works then begin - let check_magic file = - match Magic.M.magic_fileinfo file false with - None -> None -- | Some s -> Some (HashMagic.merge CommonGlobals.files_magic s) -+ | Some s -> Some (intern s) - in -+ let fdn = file_disk_name file in -+ let new_file_files = ref [] in -+ -+ List.iter (fun (f, s, m) -> -+ let subfile = Filename.concat fdn f in -+ new_file_files := (f,s, check_magic subfile) :: !new_file_files; -+ ) file.file_files; -+ -+ file.file_files <- List.rev !new_file_files; -+ file_must_update file; (* Send update to guis *) -+ -+ end; -+ (* -- End bad -- *) -+ - let cntr = ref 0 in -- List.iter (fun (filename, size, _) -> -+ List.iter (fun (filename, size, magic) -> - Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()); - let fs = Printf.sprintf "File %d" !cntr in - let magic_string = -- if !Autoconf.magic_works then -- begin -- let subfile = Filename.concat (file_disk_name file) filename in -- match check_magic subfile with -+ match magic with - None -> "" -- | Some magic -> Printf.sprintf " / %s" magic -- end -- else "" -+ | Some m -> Printf.sprintf " / %s" m; - in - html_mods_td buf [ - (fs, "sr br", fs); -@@ -287,8 +334,68 @@ - ]; - incr cntr; - ) file.file_files -+ end else begin - --let op_file_print_sources_html file buf = -+ Printf.bprintf buf "Trackers:\n"; -+ List.iter (fun tracker -> -+ match tracker.tracker_status with -+ Disabled s | Disabled_mld s | Disabled_failure s -> -+ Printf.bprintf buf "%s, disabled: %s\n" tracker.tracker_url s -+ | _ -> Printf.bprintf buf "%s\n" tracker.tracker_url -+ ) file.file_trackers; -+ let s = Charset.safe_convert file.file_encoding file.file_torrent_diskname in -+ if s <> "" then Printf.bprintf buf "Torrent diskname: %s\n" s; -+ let s = Charset.safe_convert file.file_encoding file.file_comment in -+ if s <> "" then Printf.bprintf buf "Comment: %s\n" s; -+ let s = Charset.safe_convert file.file_encoding file.file_created_by in -+ if s <> "" then Printf.bprintf buf "Created by %s\n" s; -+ let s = Date.to_string (Int64.to_float file.file_creation_date) in -+ if s <> "" then Printf.bprintf buf "Creation date: %s\n" s; -+ let s = Charset.safe_convert file.file_encoding file.file_modified_by in -+ if s <> "" then Printf.bprintf buf "Modified by %s\n" s; -+ if file.file_encoding <> "" then Printf.bprintf buf "Encoding: %s\n" file.file_encoding; -+ if file.file_files <> [] then Printf.bprintf buf "Subfiles: %d\n" (List.length file.file_files); -+ let cntr = ref 0 in -+ List.iter (fun (filename, size, magic) -> -+ incr cntr; -+ let magic_string = -+ match magic with -+ None -> "" -+ | Some m -> Printf.sprintf " / %s" m; -+ in -+ Printf.bprintf buf "File %d: %s (%Ld bytes)%s\n" !cntr filename size magic_string -+ ) file.file_files -+ end -+ -+let op_file_print_sources file o = -+ let buf = o.conn_buf in -+ -+(* redefine functions for telnet output *) -+ let html_mods_td buf l = -+ if use_html_mods o then -+ html_mods_td buf l -+ else -+ (* List *) -+ List.iter (fun (t,c,d) -> -+ (* Title Class Value *) -+ Printf.bprintf buf "%s " -+ d; -+ ) l -+ in -+ let html_mods_table_header buf n c l = -+ if use_html_mods o then -+ html_mods_table_header buf n c l -+ else -+ if List.length l > 0 then begin -+ Printf.bprintf buf "\n"; -+ List.iter (fun (w,x,y,z) -> -+ (* Sort Class Title Value *) -+ Printf.bprintf buf "%s " -+ z; -+ ) l; -+ Printf.bprintf buf "\n" -+ end -+ in - - if Hashtbl.length file.file_clients > 0 then begin - -@@ -312,10 +419,15 @@ - ( "0", "srh ar", "Incoming [T]rue, [F]alse", "I" ); - ( "0", "srh br ar", "Registered bitfield [T]rue, [F]alse", "B" ); - -- ( "0", "srh ar", "Optimist Time", "O" ); -+ ( "0", "srh ar", "Connect Time", "T" ); - ( "0", "srh ar", "Last optimist", "L.Opt" ); - ( "0", "srh br ar", "Num try", "N" ); - -+ ( "0", "srh", "DHT [T]rue, [F]alse", "D" ); -+ ( "0", "srh", "Cache extensions [T]rue, [F]alse", "C" ); -+ ( "0", "srh", "Fast extensions [T]rue, [F]alse", "F" ); -+ ( "0", "srh", "uTorrent extensions [T]rue, [F]alse", "U" ); -+ ( "0", "srh br", "Azureus messaging protocol [T]rue, [F]alse", "A" ); - (* - ( "0", "srh", "Bitmap (absent|partial|present|verified)", (colored_chunks - (Array.init (String.length info.G.file_chunks) -@@ -334,8 +446,10 @@ - html_mods_table_header buf "sourcesTable" "sources al" header_list; - - Hashtbl.iter (fun _ c -> -+ if use_html_mods o then - Printf.bprintf buf "\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr()); - -+ let btos b = if b then "T" else "F" in - let cc,cn = Geoip.get_country (fst c.client_host) in - let td_list = [ - ("", "sr br ar", Printf.sprintf "%d" (client_num c)); -@@ -346,25 +460,31 @@ - ] @ (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", (if c.client_interested then "T" else "F")); -- ("", "sr", (if c.client_choked then "T" else "F")); -+ ("", "sr", (btos c.client_interested)); -+ ("", "sr", (btos c.client_choked)); - ("", "sr br ar", (Int64.to_string c.client_allowed_to_write)); - (* This is way too slow for 1000's of chunks on a page with 100's of sources - ("", "sr", (CommonFile.colored_chunks (Array.init (String.length c.client_bitmap) - (fun i -> (if c.client_bitmap.[i] = '1' then 2 else 0)) )) ); - *) -- ("", "sr", (if c.client_interesting then "T" else "F")); -- ("", "sr", (if c.client_alrd_sent_interested then "T" else "F")); -- ("", "br sr", (if c.client_alrd_sent_notinterested then "T" else "F")); -- -- ("", "sr", (if c.client_good then "T" else "F")); -- ("", "sr", (if c.client_incoming then "T" else "F")); -- ("", "br sr", (if c.client_registered_bitfield then "T" else "F")); -+ ("", "sr", (btos c.client_interesting)); -+ ("", "sr", (btos c.client_alrd_sent_interested)); -+ ("", "br sr", (btos c.client_alrd_sent_notinterested)); -+ -+ ("", "sr", (btos c.client_good)); -+ ("", "sr", (btos c.client_incoming)); -+ ("", "br sr", (btos c.client_registered_bitfield)); - -- ("", "sr", Printf.sprintf "%d" c.client_optimist_time); -+ ("", "sr", Printf.sprintf "%d" c.client_connect_time); - ("", "ar sr", string_of_date c.client_last_optimist); - ("", "br sr", Printf.sprintf "%d" c.client_num_try); - -+ ("", "sr", (btos c.client_dht)); -+ ("", "sr", (btos c.client_cache_extension)); -+ ("", "sr", (btos c.client_fast_extension)); -+ ("", "sr", (btos c.client_utorrent_extension)); -+ ("", "br sr", (btos c.client_azureus_messaging_protocol)); -+ - ("", "sr ar", (let fc = ref 0 in - (match c.client_bitmap with - None -> () -@@ -374,19 +494,21 @@ - ] in - - html_mods_td buf td_list; -- Printf.bprintf buf "\\</tr\\>"; -+ if use_html_mods o then Printf.bprintf buf "\\</tr\\>" -+ else Printf.bprintf buf "\n"; - - ) file.file_clients; - -- Printf.bprintf buf "\\</table\\>\\</div\\>\\<br\\>"; -+ if use_html_mods o then Printf.bprintf buf "\\</table\\>\\</div\\>\\<br\\>" -+ else Printf.bprintf buf "\n"; - - end - - let op_file_check file = -- lprintf_file_nl file "Checking chunks of %s" file.file_name; -+ lprintf_file_nl (as_file file) "Checking chunks of %s" file.file_name; - match file.file_swarmer with - None -> -- lprintf_file_nl file "verify_chunks: no swarmer to verify chunks" -+ lprintf_file_nl (as_file file) "verify_chunks: no swarmer to verify chunks" - | Some swarmer -> - CommonSwarming.verify_all_chunks_immediately swarmer - -@@ -434,6 +556,7 @@ - P.file_sub_files = file.file_files; - P.file_active_sources = List.length (op_file_active_sources file); - P.file_all_sources = (Hashtbl.length file.file_clients); -+ P.file_comment = file.file_comment; - } - - let op_ft_info ft = -@@ -443,7 +566,7 @@ - { - P.file_fields = P.Fields_file_info.all; - -- P.file_comment = ""; -+ P.file_comment = file_comment (as_ft ft); - P.file_name = ft.ft_filename; - P.file_num = ft_num ft; - P.file_network = network.network_num; -@@ -465,11 +588,16 @@ - P.file_priority = 0; - P.file_uids = []; - P.file_sub_files = []; -+ P.file_magic = None; -+ P.file_comments = []; -+ P.file_user = ""; -+ P.file_group = ""; -+ P.file_release = file_release (as_ft ft); - } - - - --let load_torrent_string s = -+let load_torrent_string s user = - let file_id, torrent = BTTorrent.decode_torrent s in - - (* Save the torrent, because we later want to put -@@ -488,20 +616,19 @@ - if Sys.file_exists torrent_diskname then - begin - if !verbose then lprintf_nl "load_torrent_string: %s already exists, ignoring" torrent_diskname; -- raise Already_exists -+ raise Torrent_already_exists - end; - File.from_string torrent_diskname s; - - if !verbose then - lprintf_nl "Starting torrent download with diskname: %s" - torrent_diskname; -- let file = new_download file_id torrent torrent_diskname in -+ let file = new_download file_id torrent torrent_diskname user in - BTClients.get_sources_from_tracker file; -- BTShare.must_share_file file; - CommonInteractive.start_download (file_find (file_num file)); - file - --let load_torrent_file filename = -+let load_torrent_file filename user = - if !verbose then - lprintf_nl "load_torrent_file %s" filename; - let s = File.to_string filename in -@@ -510,27 +637,27 @@ - if Sys.file_exists filename - && (Filename.dirname filename) = downloads_directory then - Sys.remove filename; -- ignore (load_torrent_string s) -+ ignore (load_torrent_string s user) - - let parse_tracker_reply file t filename = - (*This is the function which will be called by the http client - for parsing the response*) - (* Interested only in interval*) -- if !verbose_msg_servers then lprintf_file_nl file "Filename %s" filename; -+ if !verbose_msg_servers then lprintf_file_nl (as_file file) "Filename %s" filename; - let tracker_reply = - try - File.to_string filename -- with e -> lprintf_file_nl file "Empty reply from tracker"; "" -+ with e -> lprintf_file_nl (as_file file) "Empty reply from tracker"; "" - in - let v = - match tracker_reply with - | "" -> - if !verbose_connect then -- lprintf_file_nl file "Empty reply from tracker"; -+ lprintf_file_nl (as_file file) "Empty reply from tracker"; - Bencode.decode "" - | _ -> Bencode.decode tracker_reply - in -- if !verbose_msg_servers then lprintf_file_nl file "Received: %s" (Bencode.print v); -+ if !verbose_msg_servers then lprintf_file_nl (as_file file) "Received: %s" (Bencode.print v); - t.tracker_interval <- 600; - match v with - Dictionary list -> -@@ -538,9 +665,9 @@ - match (key, value) with - String "interval", Int n -> - t.tracker_interval <- Int64.to_int n; -- if !verbose_msg_servers then lprintf_file_nl file ".. interval %d .." t.tracker_interval -+ if !verbose_msg_servers then lprintf_file_nl (as_file file) ".. interval %d .." t.tracker_interval - | String "failure reason", String failure -> -- lprintf_file_nl file "Failure from Tracker in file: %s Reason: %s" file.file_name failure -+ lprintf_file_nl (as_file file) "Failure from Tracker in file: %s Reason: %s" file.file_name failure - (*TODO: merge with f from get_sources_from_tracker and parse the rest of the answer, too. - also connect to the sources we receive or instruct tracker to send none, perhaps based - on an config option. firewalled people could activate the option and then seed torrents, too.*) -@@ -559,7 +686,7 @@ - match list with - [] -> raise Not_found - | sh :: tail -> -- let s = sharing_strategies sh.shdir_strategy in -+ let s = sharing_strategy sh.shdir_strategy in - if match torrent.torrent_files with - [] -> not s.sharing_directories - | _ -> s.sharing_directories then -@@ -576,9 +703,8 @@ - in - - let file = new_file file_id torrent torrent_diskname -- filename FileShared in -- BTShare.must_share_file file; -- if !verbose_share then lprintf_file_nl file "Sharing file %s" filename; -+ filename FileShared CommonUserDb.admin_user in -+ if !verbose_share then lprintf_file_nl (as_file file) "Sharing file %s" filename; - BTClients.connect_trackers file "started" - (parse_tracker_reply file) - with -@@ -636,13 +762,17 @@ - let file_basename = Filename.basename file in - if not (Unix2.is_directory file) then - try -- load_torrent_file file; -+ let user = fst (Unix32.owner file) in -+ load_torrent_file file (try CommonUserDb.user2_user_find user with Not_found -> CommonUserDb.admin_user); - (try Sys.remove file with _ -> ()) - with - Torrent_can_not_be_used -> - Unix2.rename file (Filename.concat old_directory file_basename); - lprintf_nl "Torrent %s does not have valid tracker URLs, moved to torrents/old ..." file_basename -- | e -> lprintf_nl "Error %s in scan_new_torrents_directory for %s" (Printexc2.to_string e) file_basename -+ | e -> -+ Unix2.rename file (Filename.concat old_directory file_basename); -+ lprintf_nl "Error %s in scan_new_torrents_directory for %s, moved to torrents/old ..." -+ (Printexc2.to_string e) file_basename - ) filenames - - let retry_all_ft () = -@@ -651,12 +781,12 @@ - lprintf_nl "ft_retry: exception %s" (Printexc2.to_string e) - ) ft_by_num - --let load_torrent_from_web r ft = -+let load_torrent_from_web r user ft = - let module H = Http_client in - H.wget r (fun filename -> - if ft_state ft = FileDownloading then begin -- load_torrent_file filename; -- file_cancel (as_ft ft) -+ load_torrent_file filename user; -+ file_cancel (as_ft ft) CommonUserDb.admin_user - end) - - let valid_torrent_extension url = -@@ -669,7 +799,7 @@ - let b = Str.group_end 1 in - String.sub text a (b - a) - --let op_network_parse_url url = -+let op_network_parse_url url user = - let location_regexp = "Location: \\(.*\\)" in - try - let real_url = get_regexp_string url (Str.regexp location_regexp) in -@@ -700,13 +830,13 @@ - ) "" cookies - ) ] - with Not_found -> []); -- H.req_max_retry = 10; -+ H.req_max_retry = 10; - } in - - let file_diskname = Filename.basename u.Url.short_file in -- let ft = new_ft file_diskname in -- ft.ft_retry <- load_torrent_from_web r ; -- load_torrent_from_web r ft; -+ let ft = new_ft file_diskname user in -+ ft.ft_retry <- (load_torrent_from_web r user); -+ load_torrent_from_web r user ft; - "started download", true - ) - else -@@ -717,10 +847,10 @@ - try - if !verbose then lprintf_nl "Not_found and trying to load %s" url; - try -- load_torrent_file url; -+ load_torrent_file url user; - "", true - with -- Already_exists -> "A torrent with this name is already in the download queue", false -+ Torrent_already_exists -> "A torrent with this name is already in the download queue", false - | Torrent_can_not_be_used -> "This torrent does not have valid tracker URLs", false - with e -> - lprintf_nl "Exception %s while 2nd loading" (Printexc2.to_string e); -@@ -753,6 +883,7 @@ - P.client_downloaded = c.client_downloaded; - P.client_uploaded = c.client_uploaded; - P.client_upload = Some (c.client_file.file_name); -+ P.client_connect_time = c.client_connect_time; - - } - -@@ -909,12 +1040,15 @@ - ), _s ":\t\t\t\tprint all .torrent files on this server"; - - "seeded_torrents", "Network/Bittorrent", Arg_none (fun o -> -+ if CommonUserDb.user2_is_admin o.conn_user.ui_user then begin - List.iter (fun file -> - if file_state file = FileShared then - Printf.bprintf o.conn_buf "%s [%s]\n" file.file_name (Int64.to_string file.file_uploaded) - ) !current_files; - _s "done" -- -+ end else -+ begin print_command_result o o.conn_buf "You are not allowed to use seeded_torrents"; -+ "" end - ), _s ":\t\t\tprint all seeded .torrent files on this server"; - - "reshare_torrents", "Network/Bittorrent", Arg_none (fun o -> -@@ -950,13 +1084,13 @@ - let buf = o.conn_buf in - if Sys.file_exists url then - begin -- load_torrent_file url; -+ load_torrent_file url o.conn_user.ui_user; - Printf.bprintf buf "loaded file %s\n" url - end - else - begin - let url = "Location: " ^ url ^ "\nContent-Type: application/x-bittorrent" in -- let result = fst (op_network_parse_url url) in -+ let result = fst (op_network_parse_url url o.conn_user.ui_user) in - Printf.bprintf buf "%s\n" result - end; - _s "" -@@ -986,7 +1120,7 @@ - Hashtbl.iter (fun _ file -> - if file_num file = num then begin - if !verbose then -- lprintf_file_nl file "adding trackers for file %i" num; -+ lprintf_file_nl (as_file file) "adding trackers for file %i" num; - set_trackers file !urls; - raise Exit - end -@@ -1031,12 +1165,18 @@ - open LittleEndian - open GuiDecoding - --let op_gui_message s = -+let op_gui_message s user = - match get_int16 s 0 with - 0 -> - let text = String.sub s 2 (String.length s - 2) in - if !verbose then lprintf_nl "received torrent from gui..."; -- ignore (load_torrent_string text) -+ (try -+ ignore (load_torrent_string text user) -+ with e -> (match e with -+ Torrent_can_not_be_used -> lprintf_nl "Loading torrent from GUI: this torrent can not be used" -+ | Torrent_already_exists -> lprintf_nl "Loading torrent from GUI: this torrent is already in download queue" -+ | _ -> ()); -+ raise e) - | 1 -> (* 34+ *) - let n = get_int s 2 in - let a, pos = get_string s 6 in -@@ -1057,12 +1197,17 @@ - file_ops.op_file_active_sources <- op_file_active_sources; - file_ops.op_file_debug <- op_file_debug; - file_ops.op_file_commit <- op_file_commit; -- file_ops.op_file_print_html <- op_file_print_html; -- file_ops.op_file_print_sources_html <- op_file_print_sources_html; -+ file_ops.op_file_print <- op_file_print; -+ file_ops.op_file_print_sources <- op_file_print_sources; - file_ops.op_file_check <- op_file_check; - file_ops.op_file_cancel <- op_file_cancel; - file_ops.op_file_info <- op_file_info; - file_ops.op_file_save_as <- (fun file name -> ()); -+ file_ops.op_file_shared <- (fun file -> -+ match file.file_shared with -+ None -> None -+ | Some sh -> Some (as_shared sh) -+ ); - - network.op_network_gui_message <- op_gui_message; - network.op_network_connected <- op_network_connected; -@@ -1072,7 +1217,7 @@ - network.op_network_forget_search <- (fun s -> ()); - network.op_network_connect_servers <- (fun s -> ()); - network.op_network_search <- (fun ss buf -> ()); -- network.op_network_download <- (fun r -> dummy_file); -+ network.op_network_download <- (fun r user -> dummy_file); - network.op_network_recover_temp <- (fun s -> ()); - let clean_exit_started = ref false in - network.op_network_clean_exit <- (fun s -> -@@ -1090,7 +1235,25 @@ - !!client_port, "client_port TCP"; - !!BTTracker.tracker_port, "tracker_port TCP"; - ]); -- -+ network.op_network_porttest_result <- (fun _ -> !porttest_result); -+ network.op_network_porttest_start <- (fun _ -> -+ let module H = Http_client in -+ azureus_porttest_random := (Random.int 100000); -+ porttest_result := PorttestInProgress (last_time ()); -+ let r = { -+ H.basic_request with -+ H.req_url = -+ Url.of_string (Printf.sprintf -+ "http://azureus.aelitis.com/natcheck.php?port=%d&check=azureus_rand_%d" -+ !!client_port !azureus_porttest_random); -+ H.req_proxy = !CommonOptions.http_proxy; -+ H.req_user_agent = get_user_agent (); -+ } in -+ H.wget r (fun file -> -+ let result = interpret_azureus_porttest (File.to_string file) in -+ porttest_result := PorttestResult (last_time (), result) -+ ) -+ ); - client_ops.op_client_info <- op_client_info; - client_ops.op_client_connect <- op_client_connect; - client_ops.op_client_disconnect <- op_client_disconnect; -@@ -1101,8 +1264,8 @@ - CommonNetwork.register_commands commands; - - shared_ops.op_shared_unshare <- (fun file -> -- (if !verbose_share then lprintf_file_nl file "unshare file"); -- BTShare.unshare_file file); -+ (if !verbose_share then lprintf_file_nl (as_file file) "unshare file"); -+ BTGlobals.unshare_file file); - shared_ops.op_shared_info <- (fun file -> - let module T = GuiTypes in - match file.file_shared with -Index: src/networks/bittorrent/bTProtocol.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTProtocol.ml,v -retrieving revision 1.25 -retrieving revision 1.27 -diff -u -r1.25 -r1.27 ---- src/networks/bittorrent/bTProtocol.ml 15 Dec 2005 19:41:46 -0000 1.25 -+++ src/networks/bittorrent/bTProtocol.ml 1 Oct 2006 17:54:00 -0000 1.27 -@@ -231,9 +231,16 @@ - open AnyEndian - open BTTypes - -+let log_prefix = "[BT]" -+ -+let lprintf_nl fmt = -+ lprintf_nl2 log_prefix fmt -+ -+let azureus_porttest_random = ref 0 -+ - type ghandler = - BTHeader of (gconn -> TcpBufferedSocket.t -> -- (string * Sha1.t) -> unit) -+ (string * string * Sha1.t) -> unit) - | Reader of (gconn -> TcpBufferedSocket.t -> unit) - - and gconn = { -@@ -538,9 +545,13 @@ - let file_id = Sha1.direct_of_string - (String.sub b.buf (b.pos+9+slen) 20) in - let proto,pos = get_string8 b.buf b.pos in -+ let rbits = (String.sub b.buf (b.pos+pos) 8) in - buf_used b (slen+29); -- h gconn sock (proto, file_id); -+ h gconn sock (proto, rbits, file_id); - end -+ else -+ if (String.sub b.buf b.pos (min b.len 100)) = "NATCHECK_HANDSHAKE" then -+ write_string sock (Printf.sprintf "azureus_rand_%d" !azureus_porttest_random) - else if (TcpBufferedSocket.closed sock) then - let (ip,port) = (TcpBufferedSocket.peer_addr sock) in - lprintf_nl "bt-handshake: closed sock from %s:%d b.len:%i slen:%i" -Index: src/networks/bittorrent/bTShare.ml -=================================================================== -RCS file: src/networks/bittorrent/bTShare.ml -diff -N src/networks/bittorrent/bTShare.ml ---- src/networks/bittorrent/bTShare.ml 12 May 2006 21:08:30 -0000 1.3 -+++ /dev/null 1 Jan 1970 00:00:00 -0000 -@@ -1,67 +0,0 @@ --(* Copyright 2001, 2002, 2005 b8_bavard, b8_fee_carabine, INRIA *) --(* -- This file is part of mldonkey. -- -- mldonkey is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- mldonkey is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with mldonkey; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --*) -- --open CommonGlobals --open Printf2 --open Md4 --open CommonDownloads --open CommonFile --open CommonShared --open CommonTypes --open Options --open BTTypes --open BTGlobals -- --let must_share_file file codedname has_old_impl = -- match file.file_shared with -- | Some _ -> () -- | None -> -- begin -- let impl = { -- impl_shared_update = 1; -- impl_shared_fullname = file_disk_name file; -- impl_shared_codedname = codedname; -- impl_shared_size = file_size file; -- impl_shared_id = Md4.null; -- impl_shared_num = 0; -- impl_shared_uploaded = Int64.zero; -- impl_shared_ops = shared_ops; -- impl_shared_val = file; -- impl_shared_requests = 0; -- impl_shared_magic = None; -- } in -- file.file_shared <- Some impl; -- incr CommonGlobals.nshared_files; -- CommonShared.shared_calculate_total_bytes (); -- match has_old_impl with -- None -> update_shared_num impl -- | Some old_impl -> replace_shared old_impl impl -- end -- --let must_share_file file = must_share_file file (file_best_name (as_file file)) None -- --let unshare_file file = -- match file.file_shared with -- None -> () -- | Some s -> -- begin -- file.file_shared <- None; -- decr CommonGlobals.nshared_files; -- CommonShared.shared_calculate_total_bytes () -- end -Index: src/networks/bittorrent/bTStats.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTStats.ml,v -retrieving revision 1.7 -retrieving revision 1.8 -diff -u -r1.7 -r1.8 ---- src/networks/bittorrent/bTStats.ml 26 Jan 2006 10:34:53 -0000 1.7 -+++ src/networks/bittorrent/bTStats.ml 23 Sep 2006 20:29:47 -0000 1.8 -@@ -93,6 +93,14 @@ - let _ = - network.op_network_display_stats <- (fun buf o -> print_stats o New); - -+ network.op_network_stat_info_list <- (fun _ -> -+ let l1 = stats_list brand_list stats_array in -+ let l2 = stats_list brand_list !!gstats_array in -+ let u1 = BasicSocket.last_time () - BasicSocket.start_time in -+ let u2 = (guptime() + u1) in -+ [("Session clients", u1, l1); ("Global clients", u2, l2)] -+ ); -+ - register_commands - [ - "client_stats_bt", "Network/Bittorrent",Arg_none (fun o -> -Index: src/networks/bittorrent/bTTypes.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTTypes.ml,v -retrieving revision 1.36 -retrieving revision 1.39 -diff -u -r1.36 -r1.39 ---- src/networks/bittorrent/bTTypes.ml 12 Sep 2006 22:44:52 -0000 1.36 -+++ src/networks/bittorrent/bTTypes.ml 8 Oct 2006 14:02:05 -0000 1.39 -@@ -104,6 +104,14 @@ - | Brand_retriever - | Brand_osprey - | Brand_rufus -+| Brand_tribler -+| Brand_cachelogic -+| Brand_electricsheep -+| Brand_qbittorrent -+| Brand_qt4 -+| Brand_uleecher -+ -+ - - let brand_list = [ - ( Brand_unknown , "unknown" , "unk" ) ; -@@ -163,6 +171,12 @@ - ( Brand_retriever , "Retriever" , "ret" ) ; - ( Brand_osprey , "Osprey permaseed" , "osp" ) ; - ( Brand_rufus , "Rufus" , "ruf" ) ; -+ ( Brand_tribler , "Tribler" , "trb" ) ; -+ ( Brand_cachelogic , "CacheLogic" , "cl" ) ; -+ ( Brand_electricsheep , "Electric sheep" , "els" ) ; -+ ( Brand_qbittorrent , "qBittorrent" , "qbt" ) ; -+ ( Brand_qt4 , "QT4" , "qt4" ) ; -+ ( Brand_uleecher , "uLeecher!" , "ul!" ) ; - ] - - let brand_count = List.length brand_list -@@ -176,6 +190,12 @@ - let brand_to_int brand = - find_int_of_brand brand brand_list - -+type tracker_status = -+ Enabled -+| Disabled of string -+| Disabled_mld of string -+| Disabled_failure of string -+ - type client = { - client_client : client CommonClient.client_impl; - mutable client_file : file; -@@ -207,7 +227,7 @@ - mutable client_downloaded_rate : Rate.t; - mutable client_downloaded : int64; - mutable client_uploaded : int64; -- mutable client_optimist_time : int; -+ mutable client_connect_time : int; - - mutable client_blocks_sent : int list; - mutable client_good : bool; -@@ -218,6 +238,13 @@ - mutable client_incoming : bool; - mutable client_registered_bitfield : bool; - mutable client_last_optimist : int; -+ -+ mutable client_dht : bool; -+ mutable client_cache_extension : bool; -+ mutable client_fast_extension : bool; -+ mutable client_utorrent_extension : bool; -+ mutable client_azureus_messaging_protocol : bool; -+ - } - - and tracker_info = { -@@ -233,7 +260,7 @@ - mutable tracker_torrent_last_dl_req : int; - mutable tracker_id : string; - mutable tracker_key : string; -- mutable tracker_enabled : bool; -+ mutable tracker_status : tracker_status; - } - - and file = { -Index: src/networks/direct_connect/dcClients.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/direct_connect/dcClients.ml,v -retrieving revision 1.12 -retrieving revision 1.13 -diff -u -r1.12 -r1.13 ---- src/networks/direct_connect/dcClients.ml 10 Apr 2006 19:16:36 -0000 1.12 -+++ src/networks/direct_connect/dcClients.ml 21 Nov 2006 22:34:33 -0000 1.13 -@@ -273,7 +273,7 @@ - let rec refill sock = - lprintf "FILL SOCKET"; lprint_newline (); - let len = remaining_to_write sock in -- let can = maxi (8192 - len) 0 in -+ let can = max (8192 - len) 0 in - if can > 0 then - match c.client_download with - DcUploadList list -> -@@ -281,7 +281,7 @@ - let slen = String.length list in - let pos = Int64.to_int c.client_pos in - if pos < slen then begin -- let send_len = mini (slen - pos) can in -+ let send_len = min (slen - pos) can in - lprintf "Sending %d" send_len; lprint_newline (); - TcpBufferedSocket.write sock list pos send_len; - lprintf "sent"; lprint_newline (); -Index: src/networks/direct_connect/dcInteractive.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/direct_connect/dcInteractive.ml,v -retrieving revision 1.27 -retrieving revision 1.28 -diff -u -r1.27 -r1.28 ---- src/networks/direct_connect/dcInteractive.ml 5 Sep 2006 14:15:19 -0000 1.27 -+++ src/networks/direct_connect/dcInteractive.ml 1 Oct 2006 17:54:00 -0000 1.28 -@@ -380,6 +380,7 @@ - [ - !!dc_port, "client_port"; - ]); -+ network.op_network_porttest_result <- (fun _ -> PorttestNotAvailable); - network.op_network_recover_temp <- (fun s -> ()); - network.op_network_load_complex_options <- (fun _ -> ()); - network.op_network_save_complex_options <- (fun _ -> ()); -Index: src/networks/direct_connect/dcProtocol.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/direct_connect/dcProtocol.ml,v -retrieving revision 1.4 -retrieving revision 1.5 -diff -u -r1.4 -r1.5 ---- src/networks/direct_connect/dcProtocol.ml 6 Sep 2005 11:24:59 -0000 1.4 -+++ src/networks/direct_connect/dcProtocol.ml 12 Nov 2006 12:42:55 -0000 1.5 -@@ -601,7 +601,7 @@ - module MultiConnectToMe = NickAndAddr(struct let msg = "MultiConnectToMe" end) - - module Msg = struct -- type t = () -+ type t = unit - - let parse s = () - -@@ -950,4 +950,4 @@ - in - iter 0 shared_tree; - Buffer.contents buf -- -\ No newline at end of file -+ -Index: src/networks/donkey/donkeyClient.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyClient.ml,v -retrieving revision 1.99 -retrieving revision 1.109 -diff -u -r1.99 -r1.109 ---- src/networks/donkey/donkeyClient.ml 5 Sep 2006 14:18:24 -0000 1.99 -+++ src/networks/donkey/donkeyClient.ml 21 Nov 2006 22:34:33 -0000 1.109 -@@ -80,7 +80,7 @@ - (* 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, port, ip ) -+ Indirect_address ( serverIP, serverPort, id_of_ip ip, 0, Ip.null ) - else - raise Not_found - with _ -> -@@ -192,9 +192,13 @@ - M.AvailableSlotReq Q.t); - - if !verbose then -- lprintf_nl "New uploader %s" -- (full_client_identifier c); -- -+ lprintf_nl "New uploader %s%s%s" -+ (full_client_identifier c) -+ (let slot_text = string_of_slot_kind (client_slot (as_client c)) true in -+ if slot_text = "" then "" else Printf.sprintf "(%s)" slot_text) -+ (match client_upload (as_client c) with -+ None -> "" -+ | Some f -> Printf.sprintf " for file %s" (CommonFile.file_best_name f)) - ) - in - client_ops.op_client_enter_upload_queue <- client_enter_upload_queue -@@ -262,7 +266,7 @@ - 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) false; -+ set_client_has_a_slot (as_client c) NoSlot; - (* connection_failed c.client_connection_control; *) - (try TcpBufferedSocket.close sock reason with _ -> ()); - -@@ -673,6 +677,11 @@ - DonkeyProtoClient.update_emule_proto_from_miscoptions1 - c.client_emule_proto i - ) -+ | Field_UNKNOWN "emule_compatoptions" -> -+ for_int_tag tag (fun i -> -+ DonkeyProtoClient.update_emule_proto_from_compatoptions -+ c.client_emule_proto i -+ ); - | Field_UNKNOWN "emule_version" -> - for_int_tag tag (fun i -> - c.client_emule_proto.emule_version <- i; -@@ -686,8 +695,9 @@ - | Field_UNKNOWN "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) - ) tags - - let update_emule_proto_from_tags c tags = -@@ -727,9 +737,15 @@ - | Field_UNKNOWN "mod_version" -> - let s = to_lowercase (string_of_tag_value tag.tag_value) in - parse_mod_version s c; -+ -+ | Field_UNKNOWN "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_clients then -- lprintf_nl "Unknown Emule tag: [%s]" (escaped_string_of_field tag) -+ if !verbose_msg_clienttags then -+ lprintf_nl "Unknown Emule tag: [%s] (update_emule_proto_from_tags)" (escaped_string_of_field tag) - ) tags - - let fight_disguised_mods c = -@@ -743,6 +759,19 @@ - if c.client_brand = Brand_emuleplus && c.client_brand_mod = Brand_mod_plus then - c.client_brand_mod <- Brand_mod_unknown - -+let request_osinfo c = -+ if c.client_emule_proto.emule_osinfosupport = 1 && not c.client_osinfo_sent then -+ begin -+ let emule_osinfo = { -+ emule_info with -+ DonkeyProtoClient.EmuleClientInfo.protversion = 255; -+ DonkeyProtoClient.EmuleClientInfo.tags = [ -+ string_tag (Field_UNKNOWN "os_info") (String2.upp_initial Autoconf.system); -+ ]} in -+ client_send c (DonkeyProtoClient.EmuleClientInfoReq emule_osinfo); -+ c.client_osinfo_sent <- true -+ end -+ - let rec query_id ip port id = - let client_ip = client_ip None in - -@@ -1049,14 +1078,14 @@ - let process_mule_info c t = - update_emule_proto_from_tags c t; - update_emule_release c; -- if !!enable_sui -+ client_must_update c; -+ if sec_ident_enabled () - && (c.client_md4 <> Md4.null) - && (c.client_sent_challenge == Int64.zero) - && (c.client_emule_proto.emule_secident > 0) - then begin -- if !verbose_msg_clients then begin -+ if !verbose_msg_clients then - lprintf_nl "%s [process_mule_info] [verify_ident]" (full_client_identifier c); -- end; - verify_ident c - end - -@@ -1108,7 +1137,7 @@ - - init_client_after_first_message sock c; - -- set_client_has_a_slot (as_client c) false; -+ set_client_has_a_slot (as_client c) NoSlot; - - let module CR = M.Connect in - -@@ -1178,14 +1207,10 @@ - if !!emule_mods_count then - identify_client_brand_mod c t.CI.tags; - -- (* TODO : remove this comment -- ERR! i think the peer support eep if it send an emule client info -- PLUS this message is sent _before_ we received an md4 so -- client_brand is unknown here. -- if supports_eep c.client_brand then begin -- *) -- let module E = M.EmuleClientInfo in -- client_send c (M.EmuleClientInfoReplyReq emule_info) -+ let module E = M.EmuleClientInfo in -+ client_send c (M.EmuleClientInfoReplyReq emule_info); -+ request_osinfo c; -+ - - | M.EmuleClientInfoReplyReq t -> - -@@ -1272,9 +1297,6 @@ - (Printexc2.to_string e); - end; - -- | M.EmuleFileDescReq (rate, comment) -> -- if comment <> "" then set_file_comment c.client_last_asked_file comment -- - | M.AvailableSlotReq _ -> - set_lifetime sock active_lifetime; - set_rtimeout sock !!queued_timeout; -@@ -1367,8 +1389,11 @@ - end else *) - CommonUploads.add_pending_slot (as_client c); - if !verbose_upload then -- lprintf_nl "donkeyClient: uploader couldn't get a slot: %s" -- (full_client_identifier c); -+ lprintf_nl "added to pending slots: %s %s" -+ (full_client_identifier c) -+ (match client_upload (as_client c) with -+ None -> "" -+ | Some f -> CommonFile.file_best_name f); - (* end *) - - | M.CloseSlotReq _ -> -@@ -1424,6 +1449,28 @@ - with _ -> () - end - -+ | M.EmuleFileDescReq t -> -+ begin -+ match c.client_last_file_req_md4 with -+ Some md4 -> -+ begin -+ try -+ let file = find_file md4 in -+ let module Q = M.EmuleFileDesc in -+ let slen = String.length t.Q.comment in -+ if slen > 0 && slen <= !!max_comment_length && (!is_not_comment_spam) t.Q.comment then begin -+ (* Disallow dups from single IP, but allow comment updates *) -+ file.file_comments <- List.filter (fun (i,_,_,_) -> i <> c.client_ip) file.file_comments; -+ if List.length file.file_comments < !!max_comments_per_file then begin -+ file.file_comments <- (c.client_ip, c.client_name, t.Q.rating, (intern t.Q.comment)) :: file.file_comments; -+ file_must_update file; -+ end; -+ end -+ with _ -> () -+ end -+ | None -> () -+ end -+ - | M.QueryChunksReplyReq t -> - let module Q = M.QueryChunksReply in - begin -@@ -1675,7 +1722,7 @@ - shared_must_update_downloaded (as_shared impl); - impl.impl_shared_requests <- impl.impl_shared_requests + 1); - request_for c file sock; -- set_client_upload (as_client c) (shared_of_file file); -+ set_client_upload (as_client c) (as_file file); - client_send c ( - let module Q = M.QueryFileReply in - let filename = file_best_name file in -@@ -1708,7 +1755,7 @@ - end - - | M.EmuleSignatureReq t -> -- if !!enable_sui then -+ if sec_ident_enabled () then - begin - let module Q = M.EmuleSignatureReq in - -@@ -1763,7 +1810,7 @@ - end - - | M.EmulePublicKeyReq t -> -- if !!enable_sui then -+ if sec_ident_enabled () then - begin - let module Q = M.EmulePublicKeyReq in - (match c.client_public_key with -@@ -1788,12 +1835,11 @@ - ); - end - else -- if !verbose_msg_clients then begin -- lprintf_nl "%s [EPubKeyReq] [DISABLED]" (full_client_identifier c) ; -- end -+ if !verbose_msg_clients then -+ lprintf_nl "%s [EPubKeyReq] [DISABLED]" (full_client_identifier c); - - | M.EmuleSecIdentStateReq t -> -- if !!enable_sui then -+ if sec_ident_enabled () then - begin - let module Q = M.EmuleSecIdentStateReq in - -@@ -1816,9 +1862,8 @@ - then send_signature c; - - end else -- if !verbose_msg_clients then begin -- lprintf_nl "%s [ESecIdentStateReq] [DISABLED]" (full_client_identifier c) ; -- end -+ if !verbose_msg_clients then -+ lprintf_nl "%s [ESecIdentStateReq] [DISABLED]" (full_client_identifier c); - - | M.EmuleRequestSourcesReplyReq t -> - (* lprintf "Emule sent sources\n"; *) -@@ -1964,7 +2009,7 @@ - let module Q = M.QueryBloc in - let file = find_file t.Q.md4 in - let prio = (file_priority file) in -- let client_upload_lifetime = ref ((maxi 0 !!upload_lifetime) * 60) in -+ let client_upload_lifetime = ref ((max 0 !!upload_lifetime) * 60) in - begin - - if !!dynamic_upload_lifetime -@@ -2011,7 +2056,7 @@ - new_chunk up t.Q.start_pos2 t.Q.end_pos2; - new_chunk up t.Q.start_pos3 t.Q.end_pos3; - c.client_upload <- Some up; -- set_client_upload (as_client c) (shared_of_file file); -+ 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 -@@ -2107,7 +2152,7 @@ - (* c.client_block <- None; *) - (* c.client_zones <- []; *) - c.client_file_queue <- []; -- set_client_has_a_slot (as_client c) false; -+ set_client_has_a_slot (as_client c) NoSlot; - c.client_upload <- None; - c.client_rank <- 0; - c.client_requests_received <- 0; -@@ -2118,7 +2163,8 @@ - let module M = DonkeyProtoClient in - - if !verbose_msg_clients then begin -- lprintf_nl "Message from incoming client"; -+ lprintf_nl "Message from incoming client %s:%d" -+ (Ip.to_string (peer_ip sock)) (peer_port sock); - M.print m; - end; - -@@ -2224,6 +2270,7 @@ - client_send c (M.EmuleClientInfoReq emule_info) - end; - -+ request_osinfo c; - client_send c ( - let module M = DonkeyProtoClient in - let module C = M.Connect in -@@ -2261,7 +2308,14 @@ - | M.NewUserIDReq _ -> - lprintf_nl "NewUserIDReq: "; M.print m; - None -- -+ -+ | M.EmulePortTestReq t -> -+ porttest_sock := Some sock; -+ set_closer sock (fun _ _ -> porttest_sock := None); -+ set_lifetime sock 30.; -+ write_string sock (client_msg_to_string (emule_proto ()) m); -+ None -+ - | _ -> - if !verbose_unknown_messages then - begin -@@ -2446,11 +2500,11 @@ - (if is_connecting_server then - ( try - let s = Hashtbl.find servers_by_key from_ip in -- Printf.sprintf " %s (%s)" s.server_name (Ip.to_string s.server_ip) -+ Printf.sprintf " %s (%s)" s.server_name (string_of_server s) - with _ -> - try - let s = Hashtbl.find servers_by_key connecting_server in -- Printf.sprintf " %s (%s)" s.server_name (Ip.to_string s.server_ip) -+ Printf.sprintf " %s (%s)" s.server_name (string_of_server s) - with _ -> "Unknown server" - ) - else "" -@@ -2510,7 +2564,6 @@ - try - let c = find_client_by_key s_uid in - let file = find_file (Md4.of_string file_uid) in -- c.client_last_asked_file <- (as_file file); - c.client_requests_sent <- c.client_requests_sent + 1; - let module M = DonkeyProtoClient in - -@@ -2538,6 +2591,7 @@ - (* TODO build the extension if needed *) - M.QueryFile.emule_extension = emule_extension; - }); -+ c.client_last_file_req_md4 <- Some file.file_md4; - let know_file_chunks = List.exists (fun (f,_,_) -> f == file) c.client_file_queue in - if not know_file_chunks then - DonkeyProtoCom.client_send c ( -@@ -2560,7 +2614,7 @@ - | Invalid_address _ -> () - | Indirect_address (server_ip, server_port, id, port, real_ip) -> - -- if low_id server_ip && Ip.reachable server_ip then -+ if Ip.reachable server_ip then - query_id server_ip server_port id; - - with e -> -@@ -2598,7 +2652,7 @@ - (CommonClient.as_client c.client_client); - - with -- Not_found -> () -+ | Not_found -> () - | e -> - if !verbose then - lprintf_nl "add_location: exception %s" (Printexc2.to_string e) -@@ -2613,9 +2667,9 @@ - (CommonClient.as_client c.client_client); - - with -- Not_found -> () -+ | Not_found -> () - | e -> - if !verbose then - lprintf_nl "remove_location for file_md4 %s: exception %s" -- file_uid (Printexc2.to_string e) -+ file_uid (Printexc2.to_string e) - ) -Index: src/networks/donkey/donkeyComplexOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyComplexOptions.ml,v -retrieving revision 1.57 -retrieving revision 1.59 -diff -u -r1.57 -r1.59 ---- src/networks/donkey/donkeyComplexOptions.ml 5 Sep 2006 14:15:19 -0000 1.57 -+++ src/networks/donkey/donkeyComplexOptions.ml 21 Nov 2006 22:34:33 -0000 1.59 -@@ -193,7 +193,7 @@ - with _ -> ()); - (try - connection_set_last_conn l.server_connection_control -- (normalize_time (mini (get_value "server_age" value_to_int) -+ (normalize_time (min (get_value "server_age" value_to_int) - (BasicSocket.last_time ()))); - with _ -> ()); - as_server l.server_server -@@ -273,7 +273,7 @@ - in - - let file = DonkeyGlobals.new_file file_diskname file_state -- (Md4.of_string file_md4) file_size "" true in -+ (Md4.of_string file_md4) file_size "" true CommonUserDb.admin_user in - - (try - set_file_best_name (as_file file) -Index: src/networks/donkey/donkeyFiles.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyFiles.ml,v -retrieving revision 1.20 -retrieving revision 1.22 -diff -u -r1.20 -r1.22 ---- src/networks/donkey/donkeyFiles.ml 19 May 2006 23:43:54 -0000 1.20 -+++ src/networks/donkey/donkeyFiles.ml 21 Nov 2006 22:34:33 -0000 1.22 -@@ -79,8 +79,8 @@ - (* let len_int = Int32.to_int len in *) - try - if !verbose_upload then -- lprintf_nl "send_small_block (%s) %Ld %d" -- (full_client_identifier c) -+ lprintf_nl "Sending %s to %s, begin %Ld len %d" -+ (file_best_name file) (full_client_identifier c) - (begin_pos) (len_int); - - let msg = -@@ -130,12 +130,12 @@ - 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 = mini msg_block_size_int per_client in -+ let msg_block_size_int = min msg_block_size_int per_client in - if max_len <= msg_block_size_int then - (* last block from chunk *) - begin - if !verbose_upload then -- lprintf_nl "END OF CHUNK (%d) %Ld" max_len up.up_end_chunk; -+ 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; - up.up_chunks <- chunks; - let per_client = per_client - max_len in -@@ -165,7 +165,7 @@ - do_if_connected c.client_source.DonkeySources.source_sock (fun sock -> - (* lprintf "upload_to_client %d connected\n" (maxi max_msg_size size); *) - -- let size = mini max_msg_size size in -+ let size = min max_msg_size size in - send_client_block c sock size; - (match c.client_upload with - None -> () -Index: src/networks/donkey/donkeyGlobals.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyGlobals.ml,v -retrieving revision 1.96 -retrieving revision 1.107 -diff -u -r1.96 -r1.107 ---- src/networks/donkey/donkeyGlobals.ml 16 Sep 2006 15:36:59 -0000 1.96 -+++ src/networks/donkey/donkeyGlobals.ml 21 Nov 2006 21:38:00 -0000 1.107 -@@ -125,8 +125,6 @@ - let tag_server = 201 - let tag_file = 202 - --let page_size = 4096L -- - let donkey_download_counter = ref Int64.zero - let donkey_upload_counter = ref Int64.zero - -@@ -140,6 +138,8 @@ - E.tags = []; - } - -+let sec_ident_enabled () = !!enable_sui && (Autoconf.donkey_sui_works ()) -+ - let overnet_connectreply_tags = ref ([] : tag list) - let overnet_connect_tags = ref ([] : tag list) - -@@ -184,8 +184,7 @@ - let master_server = ref (None: DonkeyTypes.server option) - let udp_sock = ref (None: UdpSocket.t option) - let listen_sock = ref (None : TcpServerSocket.t option) --let reversed_sock = ref (None : TcpServerSocket.t option) --let new_shared = ref false -+let porttest_sock = ref (None : TcpBufferedSocket.t option) - - (*************************************************************************) - (* *) -@@ -230,7 +229,6 @@ - let shared_files_info = (Hashtbl.create 127 - : (string * int64 * float, shared_file_info) Hashtbl.t) - let shared_files = ref ([] : file_to_share list) --let new_shared_files = ref [] - - let udp_servers_replies = (Hashtbl.create 127 : (Md4.t, server) Hashtbl.t) - -@@ -311,7 +309,7 @@ - set_file_best_name file best_name "" 0 - with Not_found -> () - --let new_file file_diskname file_state md4 file_size filename writable = -+let new_file file_diskname file_state md4 file_size filename writable user = - - try - let file = find_file md4 in -@@ -379,8 +377,8 @@ - (try - Unix32.remove t - with e -> -- lprintf_nl "Unix32.remove %s exception %s" -- (file_diskname) (Printexc2.to_string e)); -+ lprintf_nl "Unix32.remove %s exception %s" -+ (file_diskname) (Printexc2.to_string e)); - Unix32.destroy t; - failwith (Printf.sprintf "file size %s is too big, exception: %s" - (size_of_int64 file_size) (Printexc2.to_string e)) -@@ -398,10 +396,13 @@ - file_computed_md4s = Array.of_list md4s; - file_format = FormatNotComputed 0; - file_sources = DonkeySources.create_file_sources_manager -- (Md4.to_string md4) -+ (Md4.to_string md4); -+ file_comments = []; - } - and file_impl = { - dummy_file_impl with -+ impl_file_owner = user; -+ impl_file_group = user.user_default_group; - impl_file_val = file; - impl_file_ops = file_ops; - impl_file_age = last_time (); -@@ -427,10 +428,7 @@ - Verification (Array.of_list (List.map (fun md4 -> Ed2k md4) md4s)) - ); - CommonSwarming.set_verified swarmer (fun nblocks num -> -- if nblocks = 1 then begin -- new_shared_files := file :: !new_shared_files; -- file_must_update file -- end) -+ if nblocks = 1 then file_must_update file) - ); - - update_best_name file; -@@ -466,7 +464,10 @@ - let is_black_address ip port = - !!black_list && not (low_id ip) && ( - (* lprintf "is black ="; *) -- not (Ip.reachable ip) || (Ip.matches ip !!server_black_list) || -+ not (Ip.reachable ip) || -+ (match Ip_set.match_ip !server_black_list_set ip with -+ | Some br -> true -+ | None -> false) || - (List.mem port !!port_black_list) || - (match !Ip.banned ip with - None -> false -@@ -513,13 +514,27 @@ - server_id_requests = Fifo.create (); - server_flags = 0; - server_has_zlib = false; -+ server_has_newtags = false; -+ server_has_unicode = false; -+ server_has_related_search = false; -+ server_has_tag_integer = false; -+ server_has_largefiles = false; -+ server_has_udp_obfuscation = false; -+ server_has_tcp_obfuscation = false; - server_version = ""; - server_lowid_users = None; - server_soft_limit = None; - server_hard_limit = None; -+ server_obfuscation_port_tcp = None; -+ server_obfuscation_port_udp = None; -+ server_udp_key = None; -+ server_udp_keyip = None; -+ server_sent_shared = []; - server_max_users = None; - server_last_ping = 0.; - server_ping = 0; -+ server_dynip = ""; -+ server_auxportslist = ""; - - } - and server_impl = -@@ -565,11 +580,11 @@ - client_file_queue = []; - client_tags = []; - client_name = ""; -- client_last_asked_file = dummy_file; - client_all_files = None; - client_rating = 0; - client_brand = Brand_unknown; - client_brand_mod = Brand_mod_unknown; -+ client_osinfo = None; - client_checked = false; - client_connected = false; - client_downloaded = Int64.zero; -@@ -592,6 +607,8 @@ - client_sent_challenge = Int64.zero; - client_public_key = None; - client_sui_verified = None; -+ client_last_file_req_md4 = None; -+ client_osinfo_sent = false; - } and - client_impl = { - dummy_client_impl with -@@ -604,7 +621,9 @@ - - let create_client key = - let module D = DonkeyProtoClient in -- let s = DonkeySources.find_source_by_uid key in -+ let s = DonkeySources.find_source_by_uid (match key with -+ Indirect_address (server_ip, server_port, id, port, real_ip) -> Indirect_address (server_ip, server_port, id, 0, Ip.null) -+ | _ -> key) in - let rec c = { - client_client = client_impl; - client_kind = key; -@@ -616,11 +635,11 @@ - client_file_queue = []; - client_tags = []; - client_name = ""; -- client_last_asked_file = dummy_file; - client_all_files = None; - client_rating = 0; - client_brand = Brand_unknown; - client_brand_mod = Brand_mod_unknown; -+ client_osinfo = None; - client_checked = false; - client_connected = false; - client_downloaded = Int64.zero; -@@ -643,6 +662,8 @@ - client_sent_challenge = Int64.zero; - client_public_key = None; - client_sui_verified = None; -+ client_last_file_req_md4 = None; -+ client_osinfo_sent = false; - } and client_impl = { - dummy_client_impl with - impl_client_val = c; -@@ -656,17 +677,27 @@ - clients_root := c :: !clients_root; - c - -+exception ClientFound of client -+let find_client_by_key key = -+ try -+ H.iter (fun c -> -+ if (match c.client_kind with -+ Indirect_address (server_ip, server_port, id, port, real_ip) -> Indirect_address (server_ip, server_port, id, 0, Ip.null) -+ | _ -> c.client_kind) = (match key with -+ Indirect_address (server_ip, server_port, id, port, real_ip) -> Indirect_address (server_ip, server_port, id, 0, Ip.null) -+ | _ -> key) then raise (ClientFound c) -+ ) clients_by_kind; -+ raise Not_found -+ with ClientFound c -> c -+ - let new_client key = - try -- H.find clients_by_kind { dummy_client with client_kind = key } -+ find_client_by_key key - with _ -> - create_client key - - let create_client = () - --let find_client_by_key key = -- H.find clients_by_kind { dummy_client with client_kind = key } -- - let client_type c = - client_type (as_client c) - -@@ -687,6 +718,8 @@ - | Invalid_address _ -> "" - ) - -+let string_of_server s = -+ Printf.sprintf "%s:%d" (Ip.to_string s.server_ip) s.server_port - - let set_client_name c name md4 = - if name <> c.client_name || c.client_md4 <> md4 then begin -@@ -798,7 +831,6 @@ - Printf.bprintf buf " udp_servers_list: %d\n" (List.length !udp_servers_list); - Printf.bprintf buf " interesting_clients: %d\n" (List.length !interesting_clients); - Printf.bprintf buf " shared_files: %d\n" (List.length !shared_files); -- Printf.bprintf buf " new_shared_files: %d\n" (List.length !new_shared_files); - Printf.bprintf buf " servers_by_key: %d\n" (Hashtbl.length servers_by_key); - Printf.bprintf buf " banned_ips: %d\n" (Hashtbl.length banned_ips); - Printf.bprintf buf " old_requests: %d\n" (Hashtbl.length old_requests); -Index: src/networks/donkey/donkeyImport.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyImport.ml,v -retrieving revision 1.9 -retrieving revision 1.10 -diff -u -r1.9 -r1.10 ---- src/networks/donkey/donkeyImport.ml 3 Apr 2006 20:50:09 -0000 1.9 -+++ src/networks/donkey/donkeyImport.ml 14 Nov 2006 18:42:59 -0000 1.10 -@@ -54,14 +54,28 @@ - - - let names_of_tag = -+(* eMule sourcefile opcodes.h //server.met *) - [ -- "\001", Field_UNKNOWN "name"; -- "\015", Field_UNKNOWN "port"; -- "\016", Field_UNKNOWN "ip"; -- "\012", Field_UNKNOWN "ping"; -- "\014", Field_UNKNOWN "prof"; -- "\013", Field_UNKNOWN "history"; -- "\011", Field_UNKNOWN "description"; -+ "\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 *) - ] - - -Index: src/networks/donkey/donkeyInteractive.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyInteractive.ml,v -retrieving revision 1.122 -retrieving revision 1.138 -diff -u -r1.122 -r1.138 ---- src/networks/donkey/donkeyInteractive.ml 5 Sep 2006 14:18:24 -0000 1.122 -+++ src/networks/donkey/donkeyInteractive.ml 20 Nov 2006 22:48:43 -0000 1.138 -@@ -21,6 +21,8 @@ - open Printf2 - open Md4 - open Options -+open LittleEndian -+open AnyEndian - - open BasicSocket - open TcpBufferedSocket -@@ -60,8 +62,15 @@ - let _s x = _s "DonkeyInteractive" x - let _b x = _b "DonkeyInteractive" x - -+let porttest_result = ref PorttestNotStarted -+ - module VB = VerificationBitmap - -+let log_prefix = "[EDK]" -+ -+let lprintf_nl fmt = -+ lprintf_nl2 log_prefix fmt -+ - let result_name r = - match r.result_names with - [] -> None -@@ -104,12 +113,49 @@ - 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_UNKNOWN "name"; tag_value = String s } -> - server.server_name <- s; - | { tag_name = Field_UNKNOWN "description" ; tag_value = String s } -> - server.server_description <- s -- | _ -> () -- ) r.S.tags -+ | { tag_name = Field_UNKNOWN "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 } -> -+ server.server_ping <- (Int64.to_int s) -+ | { tag_name = Field_UNKNOWN "dynip" ; tag_value = String s } -> -+ server.server_dynip <- s -+ | { tag_name = Field_UNKNOWN "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 } -> -+ (match server.server_nfiles with -+ | None -> server.server_nfiles <- Some s | _ -> ()) -+ | { tag_name = Field_UNKNOWN "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 } -> -+ (match server.server_soft_limit with -+ | None -> server.server_soft_limit <- Some s | _ -> ()) -+ | { tag_name = Field_UNKNOWN "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 } -> -+ server.server_auxportslist <- s -+ | { tag_name = Field_UNKNOWN "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 } -> -+ (match server.server_obfuscation_port_tcp with -+ | None -> server.server_obfuscation_port_tcp <- Some (Int64.to_int s) | _ -> ()) -+ | { tag_name = Field_UNKNOWN "udpportobfuscation" ; tag_value = Uint64 s } -> -+ (match server.server_obfuscation_port_udp with -+ | None -> server.server_obfuscation_port_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 } -> () -+ | _ -> lprintf_nl "parsing server.met, unknown field %s" (string_of_tag tag) -+ ) r.S.tags; -+ server_must_update server - with _ -> () - ) ss; - List.length ss -@@ -181,14 +227,11 @@ - ) - - let already_done = Failure (Printf.sprintf (_b "File already downloaded (use 'force_download' if necessary)")) -- - let no_download_to_force = Failure (Printf.sprintf (_b "No forceable download found")) -+exception Already_downloading of string -+exception Already_shared of string - --let already_downloading = Failure (Printf.sprintf (_b "File is already in download queue")) -- --let already_shared = Failure (Printf.sprintf (_b "File is already shared")) -- --let really_query_download filename size md4 location old_file absents = -+let really_query_download filename size md4 location old_file absents user = - - begin - try -@@ -226,7 +269,7 @@ - end; - - (* TODO RESULT let other_names = DonkeyIndexer.find_names md4 in *) -- let file = new_file file_diskname FileDownloading md4 size filename true in -+ let file = new_file file_diskname FileDownloading md4 size filename true user in - begin - match absents with - None -> () -@@ -295,7 +338,7 @@ - ); - as_file file - --let query_download filename size md4 location old_file absents force = -+let query_download filename size md4 location old_file absents force user = - if force then - if !forceable_download = [] then - raise no_download_to_force -@@ -303,20 +346,23 @@ - begin - let f = List.hd !forceable_download in - forceable_download := []; -- really_query_download (List.hd f.result_names) f.result_size md4 None None None -+ really_query_download (List.hd f.result_names) f.result_size md4 None None None user - end - else - begin - try - let file = find_file md4 in - if (file_state file) = FileShared then -- raise already_shared -+ raise (Already_shared (Printf.sprintf (_b "File is already shared%s") -+ (match file.file_shared with -+ None -> "" -+ | Some sh -> (" in " ^ (Filename2.dirname sh.impl_shared_fullname))))) - else - begin - (* jave TODO: if a user currently not downloading this file is requesting the download add this user - to the list of users currently downloading this file *) - forceable_download := []; -- raise already_downloading -+ raise (Already_downloading (Printf.sprintf (_b "File is already in download queue of %s") (file_owner (as_file file)).CommonTypes.user_name)) - end - with Not_found -> - begin -@@ -336,19 +382,19 @@ - else - begin - forceable_download := []; -- really_query_download filename size md4 location old_file absents -+ really_query_download filename size md4 location old_file absents user - end - end - end - --let result_download r filenames force = -+let result_download r filenames force user = - let rec iter uids = - match uids with - [] -> raise IgnoreNetwork - | uid :: tail -> - match Uid.to_uid uid with - Ed2k md4 -> -- query_download (List.hd filenames) r.result_size md4 None None None force -+ query_download (List.hd filenames) r.result_size md4 None None None force user - | _ -> iter tail - in - iter r.result_uids -@@ -391,7 +437,7 @@ - (match !filename_met with - None -> filename - | Some s -> s) !size f.P.md4 None -- (Some filename) (Some (List.rev f.P.absents))); -+ (Some filename) (Some (List.rev f.P.absents)) CommonUserDb.admin_user); - with _ -> () - ) list - -@@ -508,7 +554,7 @@ - - - --let parse_donkey_url url = -+let parse_donkey_url url user = - let url = Str.global_replace (Str.regexp "|sources,") "|sources|" url in - match String2.split url '|' with - (* TODO RESULT *) -@@ -536,7 +582,7 @@ - begin - try - let file = query_download name (Int64.of_string size) -- (Md4.of_string md4) None None None false in -+ (Md4.of_string md4) None None None false user in - let new_file = find_file (Md4.of_string md4) in - CommonInteractive.start_download file; - if !new_sources <> [] then -@@ -547,7 +593,10 @@ - (Printf.sprintf (_b "added %d sources to new download") (List.length !new_sources)), true - end - else "", true -- with e -> (Printexc2.to_string e), false -+ with -+ Already_downloading (s) -+ | Already_shared (s) -> s, false -+ | e -> (Printexc2.to_string e), false - end - end - | "ed2k://" :: "file" :: name :: size :: md4 :: _ -@@ -566,12 +615,14 @@ - in - begin try - let file = query_download name (Int64.of_string size) -- (Md4.of_string md4) None None None false; -+ (Md4.of_string md4) None None None false user; - in - CommonInteractive.start_download file; - "", true -- with e -> -- (Printexc2.to_string e), false -+ with -+ Already_downloading (s) -+ | Already_shared (s) -> s, false -+ | e -> (Printexc2.to_string e), false - end - | "ed2k://" :: "server" :: ip :: port :: _ - | "server" :: ip :: port :: _ -> -@@ -713,8 +764,8 @@ - "id", Arg_none (fun o -> - let buf = o.conn_buf in - List.iter (fun s -> -- Printf.bprintf buf "For %s:%d (%s) ---> %s\n" -- (Ip.to_string s.server_ip) s.server_port s.server_name -+ Printf.bprintf buf "For %s (%s) ---> %s\n" -+ (string_of_server s) s.server_name - (match s.server_cid with - None -> "waiting" - | Some ip -> -@@ -764,11 +815,11 @@ - - "bs", Arg_multiple (fun args o -> - List.iter (fun arg -> -- let ip = Ip.of_string arg in -- server_black_list =:= ip :: !!server_black_list; -+ let range = Ip.range_of_string arg in -+ server_black_list =:= range :: !!server_black_list; - ) args; - "done" -- ), "<ip1> <ip2> ... :\t\t\tadd these IPs to the servers black list"; -+ ), "<range1> <range2> ... :\t\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 -> - donkey_port =:= int_of_string arg; -@@ -776,6 +827,7 @@ - "<port> :\t\t\t\tchange connection port"; - - "scan_temp", Arg_none (fun o -> -+ if CommonUserDb.user2_is_admin o.conn_user.ui_user then begin - let buf = o.conn_buf in - let list = Unix2.list_directory !!temp_directory in - -@@ -873,24 +925,22 @@ - ) list; - - 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"; -+ "" end - -- "" - ), ":\t\t\t\tprint temp directory content"; - - "sources", Arg_none (fun o -> -- let buf = o.conn_buf in -- DonkeySources.print buf o.conn_output; -- "" -+ if CommonUserDb.user2_is_admin o.conn_user.ui_user then begin -+ 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"; -+ "" end - ), ":\t\t\t\tshow sources currently known"; - -- (* -- "update_sources", Arg_none (fun o -> -- let buf = o.conn_buf in -- DonkeySources.recompute_ready_sources (); -- "done" -- ), ":\t\t\trecompute order of connections to sources (experimental)"; --*) -- - "xs", Arg_none (fun o -> - let buf = o.conn_buf in - if !xs_last_search >= 0 then begin -@@ -920,7 +970,7 @@ - (* TODO RESULT *) - "dd", Arg_two(fun size md4 o -> - let file = query_download md4 (Int64.of_string size) -- (Md4.of_string md4) None None None false in -+ (Md4.of_string md4) None None None false o.conn_user.ui_user in - CommonInteractive.start_download file; - "download started" - ), "<size> <md4> :\t\t\tdownload from size and md4"; -@@ -1003,8 +1053,8 @@ - with - Not_found -> () - ); -- network.op_network_download <- (fun r -> -- result_download r r.result_names r.result_force -+ network.op_network_download <- (fun r user -> -+ result_download r r.result_names r.result_force user - ) - - module P = GuiTypes -@@ -1042,6 +1092,7 @@ - P.file_format = file.file_format; - P.file_chunks_age = last_seen; - P.file_uids = [Uid.create (Ed2k file.file_md4)]; -+ P.file_comments = file.file_comments - } in - v - with e -> -@@ -1066,13 +1117,28 @@ - P.server_description = s.server_description; - P.server_banner = s.server_banner; - P.server_preferred = s.server_preferred; -+ P.server_master = s.server_master; -+ P.server_published_files = (List.length s.server_sent_shared); - P.server_version = s.server_version; - P.server_max_users = (match s.server_max_users with None -> 0L | Some v -> v); - P.server_soft_limit = (match s.server_soft_limit with None -> 0L | Some v -> v); - P.server_hard_limit = (match s.server_hard_limit with None -> 0L | Some v -> v); - P.server_lowid_users = (match s.server_lowid_users with None -> 0L | Some v -> v); - P.server_ping = s.server_ping; -- -+ P.server_features = let temp_buf = Buffer.create 100 in -+ if s.server_has_zlib then Printf.bprintf temp_buf "zlib "; -+ if s.server_has_newtags then Printf.bprintf temp_buf "newtags "; -+ if s.server_has_unicode then Printf.bprintf temp_buf "unicode "; -+ if s.server_has_related_search then Printf.bprintf temp_buf "related_search "; -+ if s.server_has_tag_integer then Printf.bprintf temp_buf "tag_integer "; -+ if s.server_has_largefiles then Printf.bprintf temp_buf "largefiles "; -+ (match s.server_obfuscation_port_tcp with -+ | Some p -> Printf.bprintf temp_buf "tcp_obfuscation(%d) " p | _ -> ()); -+ (match s.server_obfuscation_port_udp with -+ | Some p -> Printf.bprintf temp_buf "udp_obfuscation(%d) " p | _ -> ()); -+ if s.server_auxportslist <> "" then Printf.bprintf temp_buf "auxportslist %s " s.server_auxportslist; -+ if s.server_dynip <> "" then Printf.bprintf temp_buf "dynip %s " s.server_dynip; -+ if Buffer.contents temp_buf <> "" then Some (Buffer.contents temp_buf) else None; - } - else raise Not_found - ) -@@ -1125,14 +1191,15 @@ - P.client_rating = c.client_rating; - P.client_connect_time = c.client_connect_time; - P.client_software = brand_to_string_short c.client_brand; -+ 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_upload = -- (match c.client_upload with -- Some cu -> Some (file_best_name cu.up_file) -+ (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; - } -@@ -1165,6 +1232,9 @@ - server_ops.op_server_users <- (fun s -> - List2.tail_map (fun u -> as_user u.user_user) s.server_users) ; - -+ server_ops.op_server_published <- (fun s -> -+ List.map (fun f -> as_file f) s.server_sent_shared); -+ - server_ops.op_server_cid <- (fun s -> ip_of_server_cid s); - - server_ops.op_server_low_id <- (fun s -> low_id (ip_of_server_cid s)); -@@ -1184,6 +1254,11 @@ - add_file_filenames (as_file file) name; - set_file_best_name (as_file file) name "" 0 - ); -+ file_ops.op_file_shared <- (fun file -> -+ match file.file_shared with -+ None -> None -+ | Some sh -> Some (as_shared sh) -+ ); - file_ops.op_file_set_format <- (fun file format -> - file.file_format <- format); - file_ops.op_file_check <- op_file_check; -@@ -1208,10 +1283,16 @@ - ) file.file_sources; - !list - ); -- file_ops.op_file_print_html <- (fun file buf -> -- -- html_mods_cntr_init (); -+ file_ops.op_file_print <- (fun file o -> - -+ let buf = o.conn_buf in -+ if not (use_html_mods o) then begin -+ let cntr = ref 0 in -+ List.iter (fun (ip, n, r, c) -> -+ incr cntr; -+ Printf.bprintf buf -+ "Comment %d: Rating(%d): %s (%s/%s)\n" !cntr r (Charset.to_utf8 c) n (Ip.to_string ip)) file.file_comments -+ end else begin - let tr () = - Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>" (html_mods_cntr ()) - in -@@ -1223,6 +1304,16 @@ - (Md4.to_string file.file_md4) (Md4.to_string file.file_md4) - ) ]; - -+ let cntr = ref 0 in -+ List.iter (fun (ip, n, r, c) -> -+ incr cntr; -+ tr (); -+ html_mods_td buf [ -+ ("Comment", "sr br", Printf.sprintf "Comment %d" !cntr); -+ ("User rating and comment", "sr", Printf.sprintf "Rating(%d): %s (%s/%s)" r (Charset.to_utf8 c) n (Ip.to_string ip)); -+ ]; -+ ) file.file_comments; -+ - tr (); - html_mods_td buf [ - ("File History Links", "sr br", "File History"); -@@ -1257,19 +1348,22 @@ - //--\\> - \\</script\\>" (file_num file) - -- ^ "\\<table border=0 cellspacing=0 cellpadding=0\\>\\<tr\\>\\<td\\>" -+ ^ "\\<table border=0 cellspacing=0 cellpadding=0\\>\\<tr\\>" - ^ "\\<form name=\\\"renameForm1\\\" id=\\\"renameForm1\\\" action=\\\"javascript:submitRenameForm(1);\\\"\\>" -+ ^ "\\<td\\>" - ^ "\\<select name=\\\"newName\\\" id=\\\"newName\\\" onchange=\\\"javascript:renameForm2.newName.value=renameForm1.newName.options[renameForm1.newName.selectedIndex].value;this.form.submit();\\\"\\>" - ^ Printf.sprintf "\\<option value=\\\"%s\\\" selected\\>%s\n" (file_best_name file) (file_best_name file) - ^ !optionlist -- ^ "\\</select\\>\\</td\\>\\</tr\\>\\</form\\>\\<tr\\>\\<td\\>\\<form name=\\\"renameForm2\\\" id=\\\"renameForm2\\\" action=\\\"javascript:submitRenameForm(2);\\\"\\>" -- ^ "\\<input name=\\\"newName\\\" type=text size=" ^ input_size ^ " value=\\\"" ^ (file_best_name file) ^ "\\\"\\>\\</input\\>\\</td\\>\\</tr\\>\\</form\\>\\</table\\>" -+ ^ "\\</select\\>\\</td\\>\\</form\\>\\</tr\\>\\<tr\\>\\<form name=\\\"renameForm2\\\" id=\\\"renameForm2\\\" action=\\\"javascript:submitRenameForm(2);\\\"\\>" -+ ^ "\\<td\\>" -+ ^ "\\<input name=\\\"newName\\\" type=text size=" ^ input_size ^ " value=\\\"" ^ (file_best_name file) ^ "\\\"\\>\\</input\\>\\</td\\>\\</form\\>\\</tr\\>\\</table\\>" - ) ]; -- -- -+ end - ); -- file_ops.op_file_print_sources_html <- (fun file buf -> -+ file_ops.op_file_print_sources <- (fun file o -> - -+ if not (use_html_mods o) then raise Not_found; -+ let buf = o.conn_buf in - let sources_list = ref [] in - DonkeySources.iter_relevant_sources (fun s -> - let s_uid = s.DonkeySources.source_uid in -@@ -1362,7 +1456,8 @@ - ((string_of_connection_state (client_state c)), "sr", - (short_string_of_connection_state (client_state c)) ); - (String.escaped c.client_name, "sr", client_short_name c.client_name); -- (brand_to_string c.client_brand, "sr", brand_to_string_short c.client_brand); -+ (client_software (brand_to_string c.client_brand) c.client_osinfo, "sr", -+ client_software_short (brand_to_string_short c.client_brand) c.client_osinfo); - ("", "sr", c.client_emule_proto.emule_release); - - ] @ -@@ -1456,7 +1551,7 @@ - let size = Unix32.getsize file_diskname in - if size <> zero then - begin -- ignore (really_query_download (Md4.to_string md4) size md4 None (Some file_diskname) None); -+ ignore (really_query_download (Md4.to_string md4) size md4 None (Some file_diskname) None CommonUserDb.admin_user); - recover_md4s md4 - end - -@@ -1508,6 +1603,28 @@ - network.op_network_reset <- (fun _ -> ()); - - network.op_network_close_search <- (fun s -> ()); -+ network.op_network_porttest_start <- (fun _ -> -+ porttest_result := PorttestInProgress (last_time ()); -+ let module H = Http_client in -+ let r = { H.basic_request with -+ H.req_url = Url.of_string -+ (Printf.sprintf "http://porttest.emule-project.net:81/ct_noframe.php?lang=&tcpport=%d&udpport=%d" -+ !!donkey_port (!!donkey_port + 4)); -+ H.req_proxy = !CommonOptions.http_proxy; -+ H.req_max_retry = 10; -+ H.req_user_agent = get_user_agent () } in -+ H.wget r (fun file -> -+ Unix2.tryopen_read file (fun cin -> -+ try -+ while true do -+ let line = input_line cin in -+ try -+ if Str.string_match (Str.regexp "^<P>Testing IP") line 0 then -+ porttest_result := PorttestResult (last_time (), line) -+ with _ -> () -+ done -+ with End_of_file -> ()) -+ )); - network.op_network_forget_search <- forget_search - - (* emule<->mldonkey disconnects during chat, and this doesn't seem to auto reconnect -@@ -1685,18 +1802,17 @@ - (fun url filename -> - if !!enable_donkey && !!update_server_list_server_met then - begin -- lprintf_n "server.met loaded from %s" url; -+ lprintf_nl "server.met loaded from %s" url; - begin - try - let s = unpack_server_met filename url in - let nservers = List.length (Hashtbl2.to_list servers_by_key) in - let n = load_server_met s in - if s <> filename then Sys.remove s; -- lprintf ", %d servers found, %d new ones inserted" -+ lprintf_nl "%d servers found, %d new ones inserted" - n ((List.length (Hashtbl2.to_list servers_by_key)) - nservers) - with _ -> () - end; -- lprint_newline () - end - else - if not !!enable_donkey then -Index: src/networks/donkey/donkeyMain.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyMain.ml,v -retrieving revision 1.57 -retrieving revision 1.61 -diff -u -r1.57 -r1.61 ---- src/networks/donkey/donkeyMain.ml 5 Sep 2006 14:15:20 -0000 1.57 -+++ src/networks/donkey/donkeyMain.ml 21 Nov 2006 21:38:00 -0000 1.61 -@@ -69,7 +69,6 @@ - clean_join_queue_tables () - - let fivemin_timer timer = -- DonkeyShare.send_new_shared (); - clients_root := [] - - let second_timer timer = -@@ -95,10 +94,7 @@ - (try - DonkeyServers.query_locations_timer (); - with _ -> ()); -- (List.iter (fun file -> DonkeyShare.must_share_file file) !new_shared_files; -- new_shared_files := []) --(* DonkeyIndexer.add_to_local_index_timer () *) -- -+ DonkeyShare.send_new_shared () - - let local_login () = - if !!login = "" then !!global_login else !!login -@@ -118,10 +114,6 @@ - | Some sock -> - listen_sock := None; - TcpServerSocket.close sock Closed_by_user); -- (match !reversed_sock with None -> () -- | Some sock -> -- reversed_sock := None; -- TcpServerSocket.close sock Closed_by_user); - (match !udp_sock with None -> () - | Some sock -> - udp_sock := None; -@@ -136,11 +128,12 @@ - let module D = DonkeyProtoClient in - let m = D.mldonkey_emule_proto in - -- let secident = if !!enable_sui then 3 else 0 in -+ let secident = if sec_ident_enabled () then 3 else 0 in - m.emule_secident <- secident; - m.emule_features <- secident; - - let emule_miscoptions1 = D.emule_miscoptions1 m in -+ let emule_compatoptions = D.emule_compatoptions m in - client_to_client_tags := - [ - string_tag (Field_UNKNOWN "name") (local_login ()); -@@ -149,6 +142,7 @@ - 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; -+ int_tag (Field_UNKNOWN "emule_compatoptions") emule_compatoptions; - ]; - - let extended = ref 0x04 in (* support of auxport *) -@@ -302,9 +296,7 @@ - - Options.option_hook global_login reset_tags; - Options.option_hook login reset_tags; -- Options.option_hook enable_sui ( fun _ -> -- if not (Autoconf.donkey_sui_works ()) && !!enable_sui then enable_sui =:= false; -- reset_tags ()); -+ Options.option_hook enable_sui reset_tags; - - (**** START TIMERS ****) - add_session_option_timer enabler check_client_connections_delay -@@ -392,6 +384,8 @@ - !overnet_port_info, "overnet_port TCP+UDP"; - !kademlia_port_info, "kademlia_port UDP"; - ]); -+ network.op_network_porttest_result <- -+ (fun _ -> !DonkeyInteractive.porttest_result); - CommonInteractive.register_gui_options_panel "eDonkey" - gui_donkey_options_panel; - CommonInteractive.register_gui_options_panel "Overnet" -Index: src/networks/donkey/donkeyOneFile.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyOneFile.ml,v -retrieving revision 1.42 -retrieving revision 1.46 -diff -u -r1.42 -r1.46 ---- src/networks/donkey/donkeyOneFile.ml 8 Aug 2006 23:55:28 -0000 1.42 -+++ src/networks/donkey/donkeyOneFile.ml 21 Nov 2006 22:34:34 -0000 1.46 -@@ -100,7 +100,7 @@ - end - - let remove_client_slot c = -- set_client_has_a_slot (as_client c) false; -+ set_client_has_a_slot (as_client c) NoSlot; - client_send c ( - let module M = DonkeyProtoClient in - let module Q = M.CloseSlot in -@@ -111,8 +111,11 @@ - match file.file_shared with - None -> () - | Some s -> -- if !verbose_share then -- lprintf_nl "unshare_file %s" file.file_diskname; -+ if !verbose_share || !verbose then -+ lprintf_nl "Unsharing file %s" (file_best_name file); -+ List.iter (fun s -> -+ s.server_sent_shared <- List2.removeq file s.server_sent_shared; -+ ) (connected_servers ()); - file.file_shared <- None; - decr nshared_files; - CommonShared.shared_calculate_total_bytes (); -@@ -269,7 +272,7 @@ - | _ -> assert false - in - let msg = M.QueryBlocReq msg in -- set_read_power sock (!!upload_power + maxi 0 (file_priority file)); -+ set_read_power sock (!!upload_power + max 0 (file_priority file)); - (* lprintf "QUEUE DOWNLOAD REQUEST\n"; *) - (* CommonUploads.queue_download_request (fun _ -> *) - client_send c msg -@@ -435,7 +438,7 @@ - (file_best_name file) (Printexc2.to_string e) in - Printf2.lprint_string m; - CommonEvent.add_event (Console_message_event m); -- file_pause (as_file file); -+ file_pause (as_file file) CommonUserDb.admin_user; - raise e - end - -Index: src/networks/donkey/donkeyOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyOptions.ml,v -retrieving revision 1.52 -retrieving revision 1.56 -diff -u -r1.52 -r1.56 ---- src/networks/donkey/donkeyOptions.ml 4 Sep 2006 21:30:27 -0000 1.52 -+++ src/networks/donkey/donkeyOptions.ml 21 Nov 2006 22:34:34 -0000 1.56 -@@ -45,6 +45,10 @@ - "The number of servers you want to stay connected to" - int_option 3 - -+let max_allowed_connected_servers () = -+ min (int_of_string ((strings_of_option max_connected_servers).option_default)) -+ !!max_connected_servers -+ - let reliable_sources = define_option donkey_section ["reliable_sources"] - "Should mldonkey try to detect sources responsible for corruption and ban them, currently disabled" - bool_option true -@@ -53,13 +57,16 @@ - "Should mldonkey try to detect sources masquerading as others and ban them" - bool_option true - --let max_allowed_connected_servers () = -- BasicSocket.mini 5 !!max_connected_servers -- - let server_black_list = define_option donkey_section ["server_black_list"] -- "A list of server IP to remove from server list. -+ "A list of server IP to remove from server list. Can contain single IPs, CIDR ranges, or begin-end ranges. - Servers on this list can't be added, and will eventually be removed" -- (list_option Ip.option) [] -+ CommonOptions.ip_range_list_option [] -+ -+let server_black_list_set = ref Ip_set.BL_Empty -+ -+let () = -+ option_hook server_black_list (fun _ -> -+ server_black_list_set := Ip_set.of_list !!server_black_list) - - let force_high_id = define_option donkey_section ["force_high_id"] - "immediately close connection to servers that don't grant a High ID" -@@ -100,8 +107,7 @@ - int_option 1 - - let walker_server_lifetime = define_expert_option donkey_section ["walker_server_lifetime"] -- "The maximal delay a connection with a server should last when walking -- through the list (should be greater than become_master_delay)" -+ "The maximal delay a connection with a server should last when walking through the list" - int_option 300 - - let log_clients_on_console = define_expert_option donkey_section ["log_clients_on_console"] -@@ -247,6 +253,10 @@ - "min connected users for each server" - int_option 0 - -+let max_published_files = define_option donkey_section ["max_published_files"] -+ "maximum number of files published to servers per minute, eMule default 200" -+ int_option 200 -+ - let login = define_option donkey_section ["login"] - "login of client on eDonkey network (nothing default to global one)" - string_option "" -@@ -260,10 +270,6 @@ - "port for overnet" - int_option (2000 + Random.int 20000) - --let become_master_delay = define_expert_option donkey_section ["become_master_delay"] -- "(only for development tests)" -- int_option 120 -- - let options_version = define_expert_option donkey_section ["options_version"] - "(internal option)" - int_option 3 -Index: src/networks/donkey/donkeyOvernet.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyOvernet.ml,v -retrieving revision 1.68 -retrieving revision 1.74 -diff -u -r1.68 -r1.74 ---- src/networks/donkey/donkeyOvernet.ml 5 Sep 2006 14:15:20 -0000 1.68 -+++ src/networks/donkey/donkeyOvernet.ml 14 Nov 2006 16:35:53 -0000 1.74 -@@ -270,6 +270,13 @@ - end - ) - -+module KnownPeers = Weak.Make(struct -+ type t = peer -+ let hash c = Hashtbl.hash (c.peer_ip, c.peer_port) -+ let equal x y = x.peer_port = y.peer_port -+ && x.peer_ip = y.peer_ip -+ end) -+ - type search_for = - | FileSearch of file - | KeywordSearch of CommonTypes.search -@@ -293,14 +300,22 @@ - search_md4 : Md4.t; - mutable search_kind : search_for; - -- search_waiting_peers : peer Fifo.t array; -- search_asked_peers : peer Fifo.t array; -- search_ok_peers : peer Fifo.t array; -+(* Peer queues of the search *) -+(* Stage 1: This peers we know for this search *) -+ search_peers : peer Fifo.t array; -+(* Stage 2: We send a OvernetSearch *) -+ search_asked_peers : KnownPeers.t; -+(* Stage 3: We received from this peer a OvernetSearchReply *) -+ search_ok_peers : KnownPeers.t; -+(* Stage 4: We picked peers from search_ok_peers and send them a -+ OvernetSearch.*Results *) -+ search_result_asked_peers : KnownPeers.t; - - mutable search_queries : int; - mutable search_requests : int; - mutable search_start : int; -- mutable search_last_query : int; -+ mutable search_lifetime : int; -+ mutable search_last_recv : int; - mutable search_results : (Md4.t, tag list) Hashtbl.t; - mutable search_nresults : int; (* number of results messages *) - mutable search_hits : int; (* number of diff results *) -@@ -347,11 +362,10 @@ - *********************************************************************) - - let max_peers_per_bucket = 20 --let max_peers_per_prebucket = 40 --(* how many peers a search may ask for more search peers *) --let max_search_queries = 50 --(* how many peers we ask for results *) --let max_search_requests = 20 -+let max_peers_per_prebucket = 20 -+(* number of peers a search start with *) -+(* get_any_peers and get_closest_peers change the order of the peers in the bucket fifo *) -+let init_peers_per_search = ((max_peers_per_bucket*2)/3) - let max_boot_peers = 200 - - let is_enabled = ref false -@@ -451,7 +465,16 @@ - let pre_connected_peers = ref 0 - - let is_overnet_ip ip = -- Ip.usable ip && Ip.of_string "1.0.0.0" <> ip -+ let is_not_banned ip = -+ match !Ip.banned ip with -+ None -> true -+ | Some reason -> -+ if !verbose_overnet then -+ lprintf_nl "%s blocked: %s" -+ (Ip.to_string ip) reason; -+ false -+ in -+ Ip.usable ip && Ip.of_string "1.0.0.0" <> ip && is_not_banned ip - - module LimitedList = struct - -@@ -557,13 +580,6 @@ - let prebuckets = Array.init 129 (fun _ -> Fifo.create ()) - - let to_ping = ref [] --module KnownPeers = Weak.Make(struct -- type t = peer -- let hash c = Hashtbl.hash (c.peer_ip, c.peer_port) -- let equal x y = x.peer_port = y.peer_port -- && x.peer_ip = y.peer_ip -- end) -- - let known_peers = KnownPeers.create 1023 - - (* -@@ -607,17 +623,11 @@ - let bucket_number md4 = - common_bits md4 !!overnet_md4 - -- (* --(* TODO: this structure MUST disappear. It is not Kademlia ! *) --let global_peers : (Md4.t, peer) Hashtbl.t array Options.option_record = -- raise Not_found -- *) -- --(*let firewalled_overnet_peers = Hashtbl.create 13*) -- - let search_hits = ref 0 - let source_hits = ref 0 - -+(* when we created the searches for all files last time*) -+let last_check_current_downloads = ref 0 - - let udp_sock = ref None - -@@ -756,12 +766,16 @@ - match !udp_sock with - None -> () - | Some sock -> -+(* Why check this? Because it may have been blocked since it was added *) -+ if ip <> Ip.localhost && is_overnet_ip ip && port <> 0 then - Proto.udp_send sock ip port false msg - - let udp_send_ping ip port msg = - match !udp_sock with - None -> () - | Some sock -> -+(* Why check this? Because it may have been blocked since it was added *) -+ if ip <> Ip.localhost && is_overnet_ip ip && port <> 0 then - Proto.udp_send sock ip port true msg - - let udp_send p msg = -@@ -802,7 +816,12 @@ - if bucket < !n_used_buckets && bucket <> 128 && - p.peer_md4 <> Md4.null then begin - -- if Fifo.length prebuckets.(bucket) = max_peers_per_prebucket then -+(* If this is a good peer add it directly to the bucket. Helps at startup *) -+ if p.peer_kind < 3 && Fifo.length buckets.(bucket) < max_peers_per_bucket then begin -+ Fifo.put buckets.(bucket) p; -+ incr connected_peers; -+ end -+ else if Fifo.length prebuckets.(bucket) >= max_peers_per_prebucket then - begin - let pp = Fifo.take prebuckets.(bucket) in - Fifo.put prebuckets.(bucket) -@@ -847,11 +866,10 @@ - if n > 0 then - let p = Fifo.take fifo in - Fifo.put fifo p; -- (* kind < 4 so we do not send too much requests and avoid dead contacts not -+ (* kind < 3 so we do not send too much requests and avoid dead contacts not - yet removed because of timeouts *) - (* TODO: Keep order? Then we need a in_use flag? *) -- if p.peer_kind < 4 && p.peer_expire > last_time () && -- p.peer_last_send <> 0 then begin -+ if p.peer_kind < 3 && p.peer_expire > last_time () then begin - if !verbose_overnet then begin - lprintf_nl "Adding good search peer %s:%d" - (Ip.to_string p.peer_ip) p.peer_port; -@@ -928,50 +946,59 @@ - if p.peer_ip <> Ip.localhost && is_overnet_ip p.peer_ip && - p.peer_port <> 0 && p.peer_created <> 0 then begin - let nbits = common_bits p.peer_md4 s.search_md4 in -- begin -+(* Don't add ourself *) -+ if not (nbits = 128 && s.search_kind == FillBuckets) then begin - try -- Fifo.iter (fun pp -> -+ let is_in pp = - if pp.peer_ip = p.peer_ip && - pp.peer_port = p.peer_port then - raise Exit -- ) s.search_waiting_peers.(nbits); -- Fifo.put s.search_waiting_peers.(nbits) p; -+ in -+ Fifo.iter is_in s.search_peers.(nbits); -+ Fifo.put s.search_peers.(nbits) p; - with Exit -> () - end - end - - let create_search kind md4 = - if !verbose_overnet then lprintf_nl "create_search"; -- let starttime = last_time () + (2 * List.length !overnet_searches) in -+ let starttime = last_time () + (3 * List.length !overnet_searches) in - let s = ref { - search_md4 = md4; - search_kind = kind; - search_queries = 0; - search_requests = 0; -- search_waiting_peers = Array.init 129 (fun _ -> Fifo.create ()); -- search_asked_peers = Array.init 129 (fun _ -> Fifo.create ()); -- search_ok_peers = Array.init 129 (fun _ -> Fifo.create ()); -+ search_peers = Array.init 129 (fun _ -> Fifo.create ()); -+ search_asked_peers = KnownPeers.create 129; -+ search_ok_peers = KnownPeers.create 129; -+ search_result_asked_peers = KnownPeers.create 129; -+(* taken from eMule0.47c-Sources/srchybrid/kademlia/kademlia/Defines.h *) -+ search_lifetime = (match kind with -+ _ -> 45 );(* SEARCH_LIFETIME *) - search_start = (match kind with - KeywordSearch s -> last_time () - | FillBuckets -> last_time () - | FileSearch s -> starttime); -- search_last_query = (match kind with -- KeywordSearch s -> last_time () -- | FillBuckets -> last_time () -- | FileSearch s -> starttime); -+ search_last_recv = last_time (); - search_hits = 0; - search_nresults = 0; - search_results = Hashtbl.create 64; - } in -- List.iter (fun ss -> -- if ss.search_md4 = !s.search_md4 && (search_for_equals ss.search_kind !s.search_kind) then begin -- ss.search_start <- !s.search_start; -- s := ss; -- end -- ) !overnet_searches; -- List.iter (add_search_peer !s) (get_closest_peers md4 max_search_queries); -- if !verbose_overnet then lprintf_nl "create_search done"; -- overnet_searches := !s :: !overnet_searches; -+ begin try -+ List.iter (fun ss -> -+ if ss.search_md4 = !s.search_md4 && (search_for_equals ss.search_kind !s.search_kind) then begin -+(* ss.search_start <- !s.search_start; *) -+ s := ss; -+ raise Exit; -+ end -+ ) !overnet_searches; -+ begin match kind with -+ FillBuckets -> List.iter (add_search_peer !s) (get_any_peers init_peers_per_search) -+ | _ -> List.iter (add_search_peer !s) (get_closest_peers md4 init_peers_per_search) -+ end; -+ if !verbose_overnet then lprintf_nl "create_search done"; -+ overnet_searches := !s :: !overnet_searches; -+ with Exit -> () end; - !s - - let create_keyword_search w s = -@@ -979,6 +1006,54 @@ - let search = create_search (KeywordSearch s) md4 in - search - -+(* query the best todo peers of a search s or ask it for results *) -+let rec overnet_search_iter s nbits todo = -+ let nresults = match s.search_kind with -+ FillBuckets -> 10 -+ | _ -> 2 -+ in -+ if nbits >= 0 then -+ let len = Fifo.length s.search_peers.(nbits) in -+ if len > 0 then -+ let process_peer p = -+ if not (KnownPeers.mem s.search_asked_peers p) then begin -+(* Not asked: send a OvernetSearch *) -+ checking_kind p; -+ udp_send p (OvernetSearch (nresults, s.search_md4, Some p.peer_md4)); -+ s.search_queries <- s.search_queries + 1; -+ KnownPeers.add s.search_asked_peers p; -+ raise Exit; -+ end -+ else if (KnownPeers.mem s.search_ok_peers p) && -+ not (KnownPeers.mem s.search_result_asked_peers p) then begin -+(* Is ok but we did not request a result yet *) -+ let kind = match s.search_kind with -+ FillBuckets -> Search_for_file -+ | FileSearch _ -> Search_for_file -+ | _ -> Search_for_keyword None -+ in -+ checking_kind p; -+ udp_send p ( OvernetGetSearchResults (s.search_md4, kind, 0, 100)); -+ s.search_requests <- s.search_requests + 1; -+ KnownPeers.add s.search_result_asked_peers p; -+ raise Exit; -+ end -+ (* raised an Exit if we send something to the peer *) -+ in -+ try -+ Fifo.iter process_peer s.search_peers.(nbits); -+ overnet_search_iter s (nbits-1) todo; -+ with Exit -> -+ (if todo > 1 then overnet_search_iter s nbits (todo - 1)) -+ else -+ overnet_search_iter s (nbits-1) todo -+ else -+ begin -+ if !verbose_overnet then -+ lprintf_nl "overnet_search_iter: call add_search_peer"; -+ List.iter (add_search_peer s) (get_closest_peers s.search_md4 init_peers_per_search); -+ end -+ - let ip_of_udp_packet p = - match p.UdpSocket.udp_addr with - Unix.ADDR_INET (inet, port) -> -@@ -1005,7 +1080,7 @@ - - | OvernetConnect p -> - if is_overnet_ip sender.peer_ip && sender.peer_port <> 0 then -- let sender = new_peer { p with peer_ip = other_ip } in -+ let sender = new_peer { p with peer_ip = other_ip; peer_kind = 2 } in - (* let sender = new_peer { p with peer_port = other_port ; peer_ip = other_ip } in *) - new_peer_message sender; - udp_send sender (OvernetConnectReply (get_any_peers 20)) -@@ -1014,7 +1089,6 @@ - if !verbose_overnet then - lprintf_nl "Connect: invalid IP %s:%d received from %s:%d" - (Ip.to_string p.peer_ip) p.peer_port (Ip.to_string other_ip) other_port; -- failwith "Message not understood" - end - - | OvernetConnectReply ps -> -@@ -1023,7 +1097,8 @@ - match list with - [] -> () - | [p] -> -- let sender = new_peer { p with peer_ip = other_ip } in -+ (* last one is always the peer itself *) -+ let sender = new_peer { p with peer_ip = other_ip; peer_kind = 2 } in - new_peer_message sender - | p :: tail -> - let _ = new_peer p in -@@ -1032,7 +1107,7 @@ - iter ps; - - | OvernetPublicize p -> -- let sender = new_peer { p with peer_ip = other_ip } in -+ let sender = new_peer { p with peer_ip = other_ip; peer_kind = 2 } in - new_peer_message sender; - if is_overnet_ip sender.peer_ip && sender.peer_port <> 0 then - udp_send sender (OvernetPublicized (Some (my_peer ()))) -@@ -1040,7 +1115,6 @@ - if !verbose_overnet then - lprintf_nl "Publicize: invalid IP %s:%d received from %s:%d" - (Ip.to_string p.peer_ip) p.peer_port (Ip.to_string other_ip) other_port; -- failwith "Message not understood" - end - - | OvernetPublicized None -> -@@ -1049,6 +1123,9 @@ - | OvernetPublicized (Some p) -> - () - -+ | OvernetNoResult (md4) -> -+ () -+ - | OvernetSearch (nresults, md4, from_who) -> - let peers = get_closest_peers md4 nresults in - udp_send sender (OvernetSearchReply (md4,peers)) -@@ -1059,8 +1136,10 @@ - List.iter (fun s -> - if s.search_md4 = md4 then begin - List.iter (add_search_peer s) peers; -- let nbits = common_bits sender.peer_md4 s.search_md4 in -- Fifo.put s.search_ok_peers.(nbits) sender; -+ KnownPeers.add s.search_ok_peers sender; -+ s.search_last_recv <- last_time (); -+ (* Now ask the next best peer *) -+ overnet_search_iter s 128 1; - end - ) !overnet_searches; - -@@ -1113,6 +1192,9 @@ - if is_overnet_ip ip && port <> 0 then - let s = DonkeySources.find_source_by_uid - (Direct_address (ip, port)) in -+ if !verbose_overnet then -+ lprintf_nl "added new source %s:%d for file %s" -+ (Ip.to_string ip) port (Md4.to_string md4); - incr source_hits; - DonkeySources.set_request_result s - file.file_sources File_new_source; -@@ -1167,18 +1249,18 @@ - (* send the answer *) - | OvernetGetMyIP other_port -> - if !verbose_overnet && debug_client other_ip then -- lprintf_nl "GET MY IP (port=%d)\n" other_port; -+ lprintf_nl "GET MY IP (port=%d)" other_port; - (* FIXME : should be able to flush the UDP buffer*) - udp_send sender (OvernetGetMyIPResult other_ip); - udp_send sender OvernetGetMyIPDone - - | OvernetGetMyIPResult(ip) -> - if !verbose_overnet && debug_client other_ip then -- lprintf_nl "GET MY IP RESULT (%s)\n" (Ip.to_string ip) -+ lprintf_nl "GET MY IP RESULT (%s)" (Ip.to_string ip) - - | OvernetGetMyIPDone -> - if !verbose_overnet && debug_client other_ip then -- lprintf_nl "GET MY IP DONE\n" -+ lprintf_nl "GET MY IP DONE" - - | OvernetPeerNotFound peer -> - begin -@@ -1186,24 +1268,34 @@ - lprintf_nl "Peer NOT FOUND %s (%s:%d) kind: %d (msg 33)" - (Md4.to_string peer.peer_md4) (Ip.to_string peer.peer_ip) - peer.peer_port peer.peer_kind; -+(* We ignore OvernetPeerNotFound, the original client sends this message very often (even if the peer is alive) - let dp = { dummy_peer with peer_port = peer.peer_port ; peer_ip = peer.peer_ip } in - if KnownPeers.mem known_peers dp - then begin --(* remove it from the prebuckets and known_peers only *) -+(* remove it from the buckets, put it into prebuckets and set kind to 3 *) - try - for i = 0 to !n_used_buckets do -- let b = prebuckets.(i) in -+ let b = buckets.(i) in -+ let pb = prebuckets.(i) in - for j = 1 to Fifo.length b do - let p = Fifo.take b in - if p.peer_ip = peer.peer_ip && - p.peer_port = peer.peer_port then begin -- decr pre_connected_peers; -- KnownPeers.remove known_peers dp; -+ decr connected_peers; -+ if !pre_connected_peers < max_peers_per_prebucket then begin -+ incr pre_connected_peers; -+ Fifo.put pb p; -+ p.peer_kind <- 3; -+ end -+ else begin if !verbose_overnet then lprintf_nl "peernotfound: removing %s:%d" (Ip.to_string p.peer_ip) p.peer_port; -+ KnownPeers.remove known_peers p; -+ end - end else Fifo.put b p - done; - done; - with Exit -> (); - end; -+*) - end - - | OvernetUnknown21 peer -> -@@ -1215,77 +1307,19 @@ - - | _ -> failwith "Message not understood" - --let query_next_peers () = -- let overnet_query_peer_period = int_of_float !!overnet_query_peer_period in -- let timeout = last_time () - overnet_query_peer_period in -+(* Start unstarted searches, retry stalled searches *) -+let overnet_search_tick () = - List.iter (fun s -> -- let nresults = match s.search_kind with -- FillBuckets -> 10 -- | _ -> 2 -- in -- -- let rec iter nbits todo = -- if nbits >= 0 then -- let len = Fifo.length s.search_waiting_peers.(nbits) in -- if len > 0 then -- let p = Fifo.take s.search_waiting_peers.(nbits) in -- -- if p.peer_last_send < timeout then begin -- checking_kind p; -- udp_send p (OvernetSearch (nresults, s.search_md4, Some p.peer_md4)); -- s.search_queries <- s.search_queries + 1; -- Fifo.put s.search_asked_peers.(nbits) p; -- -- (if todo > 1 then iter nbits (todo - 1)) -- end else -- iter nbits todo -- else -- iter (nbits-1) todo -- else -- if s.search_queries < max_search_queries then -- List.iter (fun p -> -- add_search_peer s p -- ) (get_closest_peers s.search_md4 max_search_queries) -- in -- if s.search_last_query < timeout then begin -- s.search_last_query <- s.search_last_query + overnet_query_peer_period; --(* Query next search peers *) -- if s.search_queries < max_search_queries then -- (if s.search_queries = 0 then -- iter 128 3 -- else -- iter 128 2); --(* Request next results *) -- if s.search_requests < max_search_requests then begin -- let nrequests = -- match s.search_kind with -- FillBuckets -> 0 -- | FileSearch _ -> 1 -- | KeywordSearch _ -> 5 -- in -- for i = 1 to nrequests do -- try -- for j = 128 downto 5 do -- if Fifo.length s.search_ok_peers.(j) > 0 then -- let p = Fifo.take s.search_ok_peers.(j) in -- if p.peer_last_send < timeout then begin -- checking_kind p; -- udp_send p ( -- OvernetGetSearchResults (s.search_md4, -- (match s.search_kind with -- FillBuckets -> Search_for_file -- | FileSearch _ -> Search_for_file -- | _ -> Search_for_keyword None -- ), 0, 100)); -- s.search_requests <- s.search_requests + 1; -- raise Exit -- end else -- Fifo.put s.search_ok_peers.(j) p -- done -- with Exit -> () -- done -- end -- end; -+(* Start a search, if search_start is reached *) -+ if (s.search_lifetime + s.search_start - 20) > last_time () && -+ s.search_start < last_time () then begin -+ (if s.search_queries = 0 then -+ overnet_search_iter s 128 3 -+ else if (s.search_last_recv + 3) < last_time () then -+(* The search has stalled. We do what eMule call a JumpStart *) -+(* FIXME: with implemented firewalling this should be 1 peer not 2*) -+ overnet_search_iter s 128 2); -+ end - ) !overnet_searches - - let recover_file file = -@@ -1305,7 +1339,8 @@ - for j = 1 to Fifo.length b do - let p = Fifo.take b in - (* bad peers have kind = 4 and did not respond within peer_expire *) -- if not (p.peer_kind = 4 && p.peer_expire <= last_time ()) then -+ (* Why check is_overnet_ip? Because it may have been blocked since it was added *) -+ if not (p.peer_kind = 4 && p.peer_expire <= last_time ()) && is_overnet_ip p.peer_ip then - Fifo.put b p - else - begin -@@ -1335,7 +1370,9 @@ - incr connected_peers; - decr pre_connected_peers; - (* bad peers are removed *) -- end else if p.peer_kind = 4 && p.peer_expire <= last_time () then begin -+ (* Why check is_overnet_ip? Because it may have been blocked since it was added *) -+ end else if (p.peer_kind = 4 && p.peer_expire <= last_time ()) || -+ not (is_overnet_ip p.peer_ip) then begin - decr pre_connected_peers; - KnownPeers.remove known_peers p; - if !verbose_overnet then lprintf_nl "update_bucket2: removing %s:%d" (Ip.to_string p.peer_ip) p.peer_port; -@@ -1418,14 +1455,13 @@ - - (* copy all boot_peers to unknown_peers *) - LimitedList.iter (fun (ip, port) -> -- LimitedList.add unknown_peers (ip, port) -+ if ip <> Ip.localhost && is_overnet_ip ip && port <> 0 then -+ LimitedList.add unknown_peers (ip, port) - ) !!boot_peers; - - add_session_timer enabler 1. (fun _ -> - if !!enable_overnet then begin --(* Searches have a search_last_query controlled by !!overnet_query_peer_period *) --(* Here also the result request a done *) -- query_next_peers (); -+ overnet_search_tick (); - - let my_peer = my_peer () in - -@@ -1437,7 +1473,7 @@ - | p :: tail -> - (* do not hammer a peer, we could have send already a search reqeust - since to_ping is rebuild at least every 60 seconds *) -- if (last_time () - p.peer_last_send) > 60 then begin -+ if (last_time () - p.peer_last_send) > 61 then begin - checking_kind p; - udp_send p (OvernetPublicize my_peer); - end; -@@ -1445,12 +1481,20 @@ - end; - in - process_to_ping (); -+(* When we start with 50 searches and no peers, we have to update the buckets -+ fast, otherwise we cannot add search peers (rest: sanity check) *) -+ begin -+ if !connected_peers < 20 && !pre_connected_peers <> 0 && -+ LimitedList.length unknown_peers <> 0 then -+ update_buckets (); -+ compute_to_ping (); -+ end; - (* Send OvernetConnects and ping more peers *) - (* TODO: How does eMule it? are 50 ok? *) - begin - try -- if !connected_peers < 50 then -- for i = 1 to 4 do -+ if !connected_peers < 10 then -+ for i = 1 to 2 do - process_to_ping (); - done; - (* Do not send too much OvernetConnect, there is no use *) -@@ -1476,12 +1520,25 @@ - - compute_to_ping (); - -- let l = last_time () - 180 in --(* remove searches that are older than 3 minutes *) -+(* remove searches that are older than their lifetime *) - overnet_searches := List.filter (fun s -> -- s.search_requests < max_search_requests && -- s.search_start > l -+ (* s.search_lifetime + s.search_start > last_time () *) -+(*DEBUG:show longer *) 360 + s.search_start > last_time () - ) !overnet_searches; -+ -+ (* FIXE: Dump latencies to logfile *) -+ if !verbose_overnet then ignore (UdpSocket.get_latencies (ref true)); -+ -+ if !verbose_overnet then begin -+ lprintf_nl "%d peers (prebucket: %d peers)" !connected_peers !pre_connected_peers; -+ for i = 0 to !n_used_buckets do -+ if (Fifo.length buckets.(i)) <> 0 || (Fifo.length prebuckets.(i)) <> 0 then -+ lprintf_nl "bucket[%d] : %d peers (prebucket %d)" -+ i (Fifo.length buckets.(i)) (Fifo.length prebuckets.(i)); -+ done; -+ lprintf_nl "unknown_peers: %d" (LimitedList.length unknown_peers); -+ lprintf_nl "boot_peers: %d" (LimitedList.length !!boot_peers); -+ end; - ); - - (* every 15min for light operations *) -@@ -1489,12 +1546,18 @@ - if !!enable_overnet then begin - let _ = create_search FillBuckets !!overnet_md4 in - check_current_downloads (); -+ last_check_current_downloads := last_time (); - end - ); - - begin -- let _ = create_search FillBuckets !!overnet_md4 in - check_current_downloads (); -+(* Delay the first normal searches, so we can fill the buckets first *) -+ List.iter (fun s -> -+ s.search_start <- s.search_start + 30; -+ ) !overnet_searches; -+ ignore (create_search FillBuckets !!overnet_md4); -+ last_check_current_downloads := last_time (); - end; - - add_infinite_timer 1800. (fun _ -> -@@ -1571,6 +1634,28 @@ - (List.map (fun (command, args, help) -> - command_prefix ^ command, args, help) - [ -+ "dump_searches", Arg_none (fun o -> -+ let buf = o.conn_buf in -+ List.iter ( fun s -> -+ Printf.bprintf buf "Search %s for %s\nrequests:%d queries:%d seconds alive:%d lifetime:%d\n" -+ (match s.search_kind with -+ KeywordSearch _ -> "keyword" -+ | FileSearch _ -> "file" -+ | FillBuckets -> "fillbuckets" ) -+ (Md4.to_string s.search_md4) s.search_requests s.search_queries (last_time ()-s.search_start) s.search_lifetime; -+ let pp p = print_peer buf p in -+ Printf.bprintf buf "search_peers\n"; -+ Array.iter (fun a -> Fifo.iter (fun p -> pp p) a) s.search_peers; -+ Printf.bprintf buf "search_asked_peers\n"; -+ KnownPeers.iter pp s.search_asked_peers; -+ Printf.bprintf buf "search_ok_peers\n"; -+ KnownPeers.iter pp s.search_ok_peers; -+ Printf.bprintf buf "search_result_asked_peers\n"; -+ KnownPeers.iter pp s.search_result_asked_peers; -+ Printf.bprintf buf "\n"; -+ ) !overnet_searches; -+ "" -+ ), ("<bucket_nr> :\t\tdumps a search (Devel)"); - "dump_bucket", Arg_one (fun i o -> - let i = int_of_string i in - let i = min i !n_used_buckets in -@@ -1593,7 +1678,7 @@ - Fifo.put pb p; - done; - "" -- ), ("<bucket_nr> :\t\tdumps a bucket"); -+ ), ("<bucket_nr> :\t\tdumps a bucket (Devel)"); - - "dump_known_peers", Arg_none (fun o -> - let buf = o.conn_buf in -@@ -1604,7 +1689,7 @@ - print_peer buf p; - ) known_peers; - "" -- ), (":\t\t\tdumps known_peers"); -+ ), (":\t\t\tdumps known_peers (Devel)"); - - "boot", Arg_two (fun ip port o -> - let ip = Ip.from_name ip in -@@ -1648,6 +1733,8 @@ - Printf.bprintf buf "\\<tr\\>"; - html_mods_td buf [ - ("", "srh", Printf.sprintf "%s statistics" command_prefix_to_net); -+ ("", "srh", Printf.sprintf "Last file search started %d seconds ago\n" -+ (last_time () - !last_check_current_downloads)); - ("", "srh", Printf.sprintf "Search hits: %d\n" !search_hits); - ("", "srh", Printf.sprintf "Source hits: %d\n" !source_hits); ]; - Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>\n"; -@@ -1656,6 +1743,8 @@ - begin - Printf.bprintf buf "%s statistics:\n" - (command_prefix_to_net); -+ Printf.bprintf buf " Last file search started %d seconds ago\n" -+ (last_time () - !last_check_current_downloads); - Printf.bprintf buf " Search hits: %d\n" !search_hits; - Printf.bprintf buf " Source hits: %d\n" !source_hits; - end; -@@ -1675,35 +1764,44 @@ - Printf.bprintf buf "\\</tr\\>"; - Printf.bprintf buf "\\<tr class=\\\"dl-1\\\"\\>"; - html_mods_td buf [ -- ("", "sr", Printf.sprintf "requests:%d queries:%d search_last_query:%d\n" s.search_requests s.search_queries s.search_last_query); ]; -+ ("", "sr", Printf.sprintf "requests:%d queries:%d seconds alive:%d lifetime:%d\n" -+ s.search_requests s.search_queries (last_time ()-s.search_start) s.search_lifetime); ]; - Printf.bprintf buf "\\</tr\\>"; - end - else -- Printf.bprintf buf "Search %s for %s\nrequests:%d queries:%d search_last_query:%d\n" -+ Printf.bprintf buf "Search %s for %s\nrequests:%d queries:%d seconds alive:%d lifetime:%d\n" - (match s.search_kind with - KeywordSearch _ -> "keyword" - | FileSearch _ -> "file" - | FillBuckets -> "fillbuckets" ) -- (Md4.to_string s.search_md4) s.search_requests s.search_queries s.search_last_query; -+ (Md4.to_string s.search_md4) s.search_requests s.search_queries (last_time ()-s.search_start) s.search_lifetime; - for i = 128 downto 0 do -- let npeers = Fifo.length s.search_waiting_peers.(i) in -- let nasked = Fifo.length s.search_asked_peers.(i) in -- let nok = Fifo.length s.search_ok_peers.(i) in -+ let npeers = Fifo.length s.search_peers.(i) in -+ let count = ref 0 in -+ let cp p = if (common_bits p.peer_md4 s.search_md4) = i then count := !count + 1 in -+ KnownPeers.iter cp s.search_asked_peers; -+ let nasked = !count in -+ count := 0; -+ KnownPeers.iter cp s.search_ok_peers; -+ let nok = !count in -+ count := 0; -+ KnownPeers.iter cp s.search_result_asked_peers; -+ let nres = !count in - if npeers > 0 || nasked > 0 then - if o.conn_output = HTML then - begin - Printf.bprintf buf "\\<tr class=\\\"dl-1\\\"\\>"; - html_mods_td buf [ - ("", "sr", -- Printf.sprintf "nbits[%d] = %d peer(s) not asked, %d peer(s) asked, %d peer(s) ok" -- i npeers nasked nok); ]; -+ Printf.sprintf "nbits[%d] = %d peer(s) total, %d peer(s) asked, %d peer(s) ok, %d peer(s) result asked" -+ i npeers nasked nok nres); ]; - Printf.bprintf buf "\\</tr\\>"; - - end - else - Printf.bprintf buf -- " nbits[%d] = %d peers not asked, %d peers asked\n" -- i npeers nasked -+ " nbits[%d] = %d peer(s) total, %d peer(s) asked, %d peer(s) ok, %d peer(s) result asked\n" -+ i npeers nasked nok nres - done; - if o.conn_output = HTML then - Printf.bprintf buf "\\</table\\>\\</div\\>\n"; -@@ -1864,18 +1962,6 @@ - - let forget_search ss = - begin --(* reset the Hashtbls and Fifos *) -- List.iter ( fun s -> -- match s.search_kind with -- KeywordSearch sss when ss == sss -> -- begin -- Array.iter (fun a -> Fifo.clear a) s.search_waiting_peers; -- Array.iter (fun a -> Fifo.clear a) s.search_asked_peers; -- Array.iter (fun a -> Fifo.clear a) s.search_ok_peers; -- Hashtbl.clear s.search_results; -- end -- | _ -> () -- ) !overnet_searches; - (* Remove from overnet_searches *) - overnet_searches := List.filter (fun s -> - match s.search_kind with -@@ -1885,18 +1971,6 @@ - - let cancel_recover_file file = - begin --(* reset the Hashtbls and Fifos *) -- List.iter ( fun s -> -- match s.search_kind with -- FileSearch f when f == file -> -- begin -- Array.iter (fun a -> Fifo.clear a) s.search_waiting_peers; -- Array.iter (fun a -> Fifo.clear a) s.search_asked_peers; -- Array.iter (fun a -> Fifo.clear a) s.search_ok_peers; -- Hashtbl.clear s.search_results; -- end -- | _ -> () -- ) !overnet_searches; - (* Remove from overnet_searches *) - overnet_searches := List.filter (fun s -> - match s.search_kind with -@@ -1954,8 +2028,8 @@ - Printf.bprintf buf " unknown_peers: %d\n" (LimitedList.length unknown_peers); - update_buckets (); - Printf.bprintf buf " boot_peers: %d\n" (LimitedList.length !!boot_peers); -- Printf.bprintf buf " %d buckets with %d peers and %d prebucket peers\n" -- !n_used_buckets !connected_peers !pre_connected_peers; -+ Printf.bprintf buf " %d peers and %d prebucket peers\n" -+ !connected_peers !pre_connected_peers; - - Printf.bprintf buf " Search hits: %d\n" !search_hits; - Printf.bprintf buf " Source hits: %d\n" !source_hits; -@@ -1970,27 +2044,19 @@ - - - Printf.bprintf buf " to_ping: %d\n" (List.length !to_ping); -- let n_search_waiting_peers = ref 0 in -- let n_search_asked_peers = ref 0 in -- let n_search_ok_peers = ref 0 in -+ let n_search_peers = ref 0 in - let n_search_results = ref 0 in - let n_overnet_searches = ref 0 in - List.iter ( fun s -> - for i = 128 downto 0 do -- n_search_waiting_peers := -- !n_search_waiting_peers + (Fifo.length s.search_waiting_peers.(i)); -- n_search_asked_peers := -- !n_search_asked_peers + (Fifo.length s.search_asked_peers.(i)); -- n_search_ok_peers := -- !n_search_ok_peers + (Fifo.length s.search_ok_peers.(i)); -+ n_search_peers := -+ !n_search_peers + (Fifo.length s.search_peers.(i)); - n_search_results := - !n_search_results + (Hashtbl.length s.search_results); - done; - incr n_overnet_searches - ) !overnet_searches; -- Printf.bprintf buf " n_search_waiting_peers: %d\n" !n_search_waiting_peers; -- Printf.bprintf buf " n_search_asked_peers: %d\n" !n_search_asked_peers; -- Printf.bprintf buf " n_search_ok_peers: %d\n" !n_search_ok_peers; -+ Printf.bprintf buf " n_search_peers: %d\n" !n_search_peers; - Printf.bprintf buf " n_search_results: %d\n" !n_search_results; - Printf.bprintf buf " n_overnet_searches: %d\n" !n_overnet_searches; - ); -Index: src/networks/donkey/donkeyProtoClient.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyProtoClient.ml,v -retrieving revision 1.36 -retrieving revision 1.39 -diff -u -r1.36 -r1.39 ---- src/networks/donkey/donkeyProtoClient.ml 5 Sep 2006 14:18:24 -0000 1.36 -+++ src/networks/donkey/donkeyProtoClient.ml 31 Oct 2006 15:40:06 -0000 1.39 -@@ -51,6 +51,7 @@ - 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_sourceexchange = 2; (* 2 : +client_md4 3 : +IdHybrid (emule Kademlia?)*) - emule_multipacket = 0; (* 1 *) -@@ -85,6 +86,12 @@ - m.emule_multipacket <- (o lsr 1) land 0x1; - m.emule_supportpreview <- (o lsr 0) land 0x1 - -+let emule_compatoptions m = -+ (m.emule_osinfosupport lsl 0) -+ -+let update_emule_proto_from_compatoptions m o = -+ m.emule_osinfosupport <- (o lsr 0) land 0x1 -+ - let extendedrequest e = - min e.emule_extendedrequest mldonkey_emule_proto.emule_extendedrequest - -@@ -133,6 +140,7 @@ - "\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"; -@@ -799,7 +807,7 @@ - "\135", "mod_lsd"; - "\136", "mod_lsd_version"; - "\144", "mod_lovelace_version"; -- "\148", "mod_oxy"; -+ "\148", "os_info"; (* reused by aMule to transfer client OS type *) - "\153", "mod_plus"; - "\160", "mod_wombat"; - "\161", "dev_wombat"; -@@ -1044,6 +1052,43 @@ - done - - end -+module EmuleFileDesc = struct -+ -+ type t = { -+ rating : int; -+ comment : string; -+ } -+ -+ let parse len s = -+ let rating = get_uint8 s 1 in -+ let (comment, _) = get_string32 s 2 in -+ { -+ rating = rating; -+ comment = comment; -+ } -+ -+ let print t = -+ lprintf_nl "EmuleFileDesc [%d][%s]" t.rating t.comment -+ -+ let write buf t = -+ buf_int8 buf t.rating; -+ buf_string buf t.comment -+ end -+ -+ -+module EmulePortTestReq = struct -+ -+ type t = string -+ -+ let print s = -+ lprintf_nl "Emule porttest request %s" (String.escaped s) -+ -+ let parse s = s -+ -+ let write buf = -+ buf_int8 buf 0x12 -+ -+ end - - type t = - | ConnectReq of Connect.t -@@ -1081,13 +1126,14 @@ - | EmuleQueueRankingReq of EmuleQueueRanking.t - | EmuleRequestSourcesReq of EmuleRequestSources.t - | EmuleRequestSourcesReplyReq of EmuleRequestSourcesReply.t --| EmuleFileDescReq of int * string -+| EmuleFileDescReq of EmuleFileDesc.t - | EmulePublicKeyReq of EmulePublicKeyReq.t - | EmuleSignatureReq of EmuleSignatureReq.t - | EmuleSecIdentStateReq of EmuleSecIdentStateReq.t - | EmuleMultiPacketReq of Md4.t * t list - | EmuleMultiPacketAnswerReq of Md4.t * t list - | EmuleCompressedPart of Md4.t * int64 * int64 * string -+| EmulePortTestReq of EmulePortTestReq.t - - let rec print t = - begin -@@ -1133,8 +1179,8 @@ - | EmuleRequestSourcesReplyReq t -> - EmuleRequestSourcesReply.print t - -- | EmuleFileDescReq (rating, comment) -> -- lprintf "EMULE FILE DESC %s" comment -+ | EmuleFileDescReq t -> -+ EmuleFileDesc.print t - - | EmuleMultiPacketReq (md4, list) -> - lprintf_nl "EmuleMultiPacket for %s:" (Md4.to_string md4); -@@ -1155,11 +1201,11 @@ - 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) -- -+ | EmulePortTestReq t -> -+ EmulePortTestReq.print t - | UnknownReq (opcode, s) -> - let len = String.length s in - lprintf_nl "UnknownReq: magic (%d), opcode (%d) len (%d)" opcode -@@ -1195,10 +1241,7 @@ - - | 0x60 (* 96 *) -> EmuleQueueRankingReq (EmuleQueueRanking.parse len s) - -- | 0x61 (* 97 *) -> -- let rating = get_uint8 s 1 in -- let (comment,_) = get_string32 s 2 in -- EmuleFileDescReq (rating, comment) -+ | 0x61 (* 97 *) -> EmuleFileDescReq (EmuleFileDesc.parse len s) - - | 0x81 (* 129 *) -> EmuleRequestSourcesReq (EmuleRequestSources.parse len s) - | 0x82 (* 130 *) -> -@@ -1294,6 +1337,9 @@ - in - EmuleMultiPacketAnswerReq (md4, iter s 17 len) - -+ | 0xfe (* 254 *) -> -+ EmulePortTestReq s -+ - | code -> - if !CommonOptions.verbose_unknown_messages then - lprintf_nl "EDK: unknown eMule message %d" code; -@@ -1514,11 +1560,9 @@ - | EmuleRequestSourcesReplyReq t -> - buf_int8 buf 0x82; - EmuleRequestSourcesReply.write emule buf t -- | EmuleFileDescReq (rating, comment) -> -+ | EmuleFileDescReq t -> - buf_int8 buf 0x61; -- buf_int8 buf rating; -- buf_string buf comment -- -+ EmuleFileDesc.write buf t - | EmuleCompressedPart (md4, statpos, newsize, bloc) -> - buf_int8 buf 0x40; - buf_md4 buf md4; -@@ -1578,6 +1622,10 @@ - buf_int8 buf 0x85; - EmulePublicKeyReq.write buf t - -+ | EmulePortTestReq t -> -+ buf_int8 buf 0xfe; -+ EmulePortTestReq.write buf; -+ - | UnknownReq (opcode, s) -> - Buffer.add_string buf s - -Index: src/networks/donkey/donkeyProtoCom.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyProtoCom.ml,v -retrieving revision 1.32 -retrieving revision 1.33 -diff -u -r1.32 -r1.33 ---- src/networks/donkey/donkeyProtoCom.ml 19 May 2006 23:43:54 -0000 1.32 -+++ src/networks/donkey/donkeyProtoCom.ml 8 Oct 2006 14:20:22 -0000 1.33 -@@ -341,7 +341,7 @@ - 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) -- (if compressed then "(zlib)" else ""); -+ (if compressed then " (zlib)" else ""); - Buffer.reset buf; - let s_c = - if compressed then -Index: src/networks/donkey/donkeyProtoKademlia.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyProtoKademlia.ml,v -retrieving revision 1.20 -retrieving revision 1.21 -diff -u -r1.20 -r1.21 ---- src/networks/donkey/donkeyProtoKademlia.ml 19 May 2006 23:43:54 -0000 1.20 -+++ src/networks/donkey/donkeyProtoKademlia.ml 31 Oct 2006 15:42:48 -0000 1.21 -@@ -45,6 +45,7 @@ - - let names_of_tag = - [ -+ "\243", Field_UNKNOWN "encryption"; (* 0xF3 *) - "\248", Field_UNKNOWN "buddyhash"; (* 0xF8 *) - "\249", Field_UNKNOWN "clientlowid"; (* 0xF9 *) - "\250", Field_UNKNOWN "serverport"; (* 0xFA *) -Index: src/networks/donkey/donkeyProtoOvernet.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyProtoOvernet.ml,v -retrieving revision 1.30 -retrieving revision 1.31 -diff -u -r1.30 -r1.31 ---- src/networks/donkey/donkeyProtoOvernet.ml 19 May 2006 23:43:54 -0000 1.30 -+++ src/networks/donkey/donkeyProtoOvernet.ml 5 Nov 2006 14:13:51 -0000 1.31 -@@ -189,15 +189,21 @@ - match tag.tag_name with - Field_UNKNOWN "loc" -> - for_string_tag tag (fun bcp -> -- if !verbose_overnet then -- lprintf_nl "loc tag : [%s]" bcp; -+ if !verbose_overnet then lprintf_nl "loc tag : [%s]" bcp; - if String2.starts_with bcp "bcp://" then - let bcp2 = String.sub bcp 6 (String.length bcp - 6) - in - match String2.split_simplify bcp2 ':' with -+ | [_;ip;udpport;tcpport] -> -+ if !verbose_overnet then -+ lprintf_nl "Received BCP type 3 %s" bcp; -+ peer_ip := Ip.of_string ip; -+ peer_udpport := int_of_string udpport; -+ peer_tcpport := int_of_string tcpport; -+ - | [_;ip;port] -> - if !verbose_overnet then -- lprintf_nl "Received BCP type 2 %s" -+ lprintf_nl "Received BCP type 2 %s, ignoring" - bcp; - - (* FIXME: A firewalled peer... -Index: src/networks/donkey/donkeyProtoServer.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyProtoServer.ml,v -retrieving revision 1.21 -retrieving revision 1.22 -diff -u -r1.21 -r1.22 ---- src/networks/donkey/donkeyProtoServer.ml 6 Oct 2005 10:21:09 -0000 1.21 -+++ src/networks/donkey/donkeyProtoServer.ml 14 Nov 2006 18:42:59 -0000 1.22 -@@ -154,22 +154,30 @@ - module SetID = struct - type t = { - ip : Ip.t; -+ port : int option; - zlib : bool; -- port : int option -+ newtags : bool; -+ unicode : bool; -+ related_search : bool; -+ tag_integer : bool; -+ largefiles : bool; -+ udp_obfuscation : bool; -+ tcp_obfuscation : bool; - } - - let parse len s = -- let ip = get_ip s 1 in -- let zlib = (0x01 land get_int s 5) = 0x01 in -- let port = -- if len <= 9 then -- None -- else -- Some (get_int s 9) in -+ let flags = get_int s 5 in - { -- ip = ip; -- zlib = zlib; -- port = port; -+ ip = get_ip s 1; -+ port = if len <= 9 then None else Some (get_int s 9); -+ zlib = 0x01 land flags = 0x01; -+ newtags = 0x08 land flags = 0x08; -+ unicode = 0x10 land flags = 0x10; -+ related_search = 0x40 land flags = 0x40; -+ tag_integer = 0x80 land flags = 0x80; -+ largefiles = 0x100 land flags = 0x100; -+ udp_obfuscation = 0x200 land flags = 0x200; -+ tcp_obfuscation = 0x400 land flags = 0x400; - } - - let print t = -Index: src/networks/donkey/donkeyProtoUdp.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyProtoUdp.ml,v -retrieving revision 1.14 -retrieving revision 1.15 -diff -u -r1.14 -r1.15 ---- src/networks/donkey/donkeyProtoUdp.ml 16 Jan 2006 16:05:14 -0000 1.14 -+++ src/networks/donkey/donkeyProtoUdp.ml 1 Oct 2006 17:54:00 -0000 1.15 -@@ -455,6 +455,7 @@ - | EmuleReaskAckUdpReq of Md4.t - | EmuleFileNotFoundUdpReq - | EmuleQueueFullUdpReq -+| EmulePortTestReq - - | UnknownUdpReq of int * string - -@@ -484,6 +485,7 @@ - | 145 -> EmuleReaskAckUdpReq (get_md4 s 1) - (* | 146 -> EmuleFileNotFoundUdpReq *) - | 147 -> EmuleQueueFullUdpReq -+ | 254 -> EmulePortTestReq - - | _ -> raise Exit - with -@@ -524,6 +526,8 @@ - Printf.bprintf b "EmuleFileNotFoundUdpReq" - | EmuleQueueFullUdpReq -> - Printf.bprintf b "EmuleQueueFullUdpReq" -+ | EmulePortTestReq -> -+ Printf.bprintf b "EmulePortTestReq" - - | UnknownUdpReq (magic, s) -> - Printf.bprintf b "UnknownReq magic %d\n" magic; -@@ -613,6 +617,14 @@ - buf_int8 buf 53; - QueryIDReplyUdp.write buf t - -+ | EmulePortTestReq -> -+ buf_int8 buf 2; -+ buf_int8 buf 0; -+ buf_int8 buf 0; -+ buf_int8 buf 0; -+ buf_int8 buf 0xfe; -+ buf_int8 buf 0x31 -+ - | EmuleQueueFullUdpReq - | EmuleFileNotFoundUdpReq - | EmuleReaskAckUdpReq _ -Index: src/networks/donkey/donkeyServers.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyServers.ml,v -retrieving revision 1.59 -retrieving revision 1.66 -diff -u -r1.59 -r1.66 ---- src/networks/donkey/donkeyServers.ml 1 Sep 2006 16:25:15 -0000 1.59 -+++ src/networks/donkey/donkeyServers.ml 21 Nov 2006 22:34:34 -0000 1.66 -@@ -34,6 +34,7 @@ - open CommonOptions - open CommonGlobals - open CommonSources -+open CommonShared - - open DonkeyMftp - open DonkeyImport -@@ -210,6 +211,35 @@ - - - let disconnect_server s reason = -+ let choose_new_master_server s = -+ match !DonkeyGlobals.master_server with -+ | Some ss when s == ss -> -+ DonkeyGlobals.master_server := None; -+ (try -+ DonkeyGlobals.master_server := -+ Some (List.find (fun s -> s.server_master) !servers_list); -+ if !verbose_location then begin -+ match !DonkeyGlobals.master_server with -+ | Some ns -> -+ lprintf_nl "changed main master server from %s (%s) to %s (%s)" -+ ss.server_name (string_of_server ss) ns.server_name (string_of_server ns) -+ | _ -> () -+ end -+ with Not_found -> ()) -+ | _ -> (); -+ in -+(* remove this server from the list of servers a file was published to *) -+ let remove_server_from_shared_files s = -+ List.iter (fun file -> -+ shared_iter (fun sh -> -+ let impl = as_shared_impl sh in -+ impl.impl_shared_servers <- -+ List2.removeq (as_server s.server_server) impl.impl_shared_servers) -+ ) s.server_sent_shared; -+ s.server_sent_shared <- [] -+ in -+ choose_new_master_server s; -+ remove_server_from_shared_files s; - match s.server_sock with - NoConnection -> () - | ConnectionWaiting token -> -@@ -225,16 +255,11 @@ - s.server_users <- []; - set_server_state s (NotConnected (reason, -1)); - s.server_master <- false; -- (match !DonkeyGlobals.master_server with -- | Some ss when s == ss -> -- DonkeyGlobals.master_server := None; -- | _ -> ()); - s.server_banner <- ""; - s.server_sent_all_queries <- false; - remove_connecting_server s; - remove_connected_server s - -- - let server_handler s sock event = - match event with - BASIC_EVENT (CLOSED r) -> -@@ -259,6 +284,13 @@ - match t with - M.SetIDReq t -> - s.server_has_zlib <- t.M.SetID.zlib; -+ s.server_has_newtags <- t.M.SetID.newtags; -+ s.server_has_unicode <- t.M.SetID.unicode; -+ s.server_has_related_search <- t.M.SetID.related_search; -+ s.server_has_tag_integer <- t.M.SetID.tag_integer; -+ s.server_has_largefiles <- t.M.SetID.largefiles; -+ s.server_has_udp_obfuscation <- t.M.SetID.udp_obfuscation; -+ s.server_has_tcp_obfuscation <- t.M.SetID.tcp_obfuscation; - if low_id t.M.SetID.ip && !!force_high_id then - disconnect_server s (Closed_for_error "Low ID") - else begin -@@ -281,23 +313,24 @@ - end - - | M.MessageReq msg -> -+ if msg <> "" then begin - if !last_message_sender <> server_num s then begin -- let server_header = Printf.sprintf "\n+-- From server %s [%s:%d] ------" -- s.server_name (Ip.to_string s.server_ip) s.server_port in -+ let server_header = Printf.sprintf "\n+-- From server %s [%s] ------" -+ s.server_name (string_of_server s) in - CommonEvent.add_event (Console_message_event (Printf.sprintf "%s\n" server_header)); - if !CommonOptions.verbose_msg_servers then -- lprintf_nl "%s" server_header; -+ lprintf_nl "%s" server_header; - last_message_sender := server_num s - end; - s.server_banner <- s.server_banner ^ Printf.sprintf "%s\n" msg; - let msg = Printf.sprintf "| %s" msg in - CommonEvent.add_event (Console_message_event (Printf.sprintf "%s\n" msg)); -- if !CommonOptions.verbose_msg_servers then -- lprintf_nl "%s" msg -+ if !CommonOptions.verbose_msg_servers then lprintf_nl "%s" msg -+ end - - | M.ServerListReq l -> - if !!update_server_list_server then begin -- if !verbose_msg_servers then lprintf_nl "Received serverlist from server"; -+ if !verbose_msg_servers then lprintf_nl "Received %d servers from server" (List.length l); - let module Q = M.ServerList in - List.iter (fun s -> - safe_add_server s.Q.ip s.Q.port -@@ -318,7 +351,7 @@ - s.server_name <- name - | { tag_name = Field_UNKNOWN "description"; tag_value = String desc } -> - s.server_description <- desc -- | _ -> () -+ | _ -> lprintf_nl "parsing donkeyServers.ServerInfo, unknown field %s" (string_of_tag tag) - ) s.server_tags; - - (* nice and ugly, but it doesn't require any new fields *) -@@ -339,8 +372,8 @@ - s.server_nfiles <- Some (Int64.of_int files); - if (users < !!min_users_on_server && not s.server_preferred) then - begin -- lprintf_nl "%s:%d remove server min_users_on_server limit hit!" -- (Ip.to_string s.server_ip) s.server_port; -+ lprintf_nl "%s remove server min_users_on_server limit hit!" -+ (string_of_server s); - - disconnect_server s Closed_for_timeout; - server_remove (as_server s.server_server); -@@ -618,8 +651,7 @@ - if ls < min_last_conn && s.server_sock = NoConnection - && not s.server_preferred then begin - if !verbose then -- lprintf_nl "old servers: Server too old: %s:%d" -- (Ip.to_string s.server_ip) s.server_port; -+ lprintf_nl "old servers: Server too old: %s" (string_of_server s); - - to_remove := s :: !to_remove - end -@@ -674,16 +706,14 @@ - if connection_can_try s.server_connection_control then - begin - if !verbose then -- lprintf_nl "WALKER: try connect %s" -- (Ip.to_string s.server_ip); -+ lprintf_nl "WALKER: try connect %s" (string_of_server s); - connect_server s - end - else - begin - delayed_list := s :: !delayed_list; - if !verbose then -- lprintf_nl "WALKER: connect %s delayed" -- (Ip.to_string s.server_ip); -+ lprintf_nl "WALKER: connect %s delayed" (string_of_server s); - end - | _ -> () - -@@ -749,13 +779,13 @@ - match s.server_sock with - | Connection _ -> - if !verbose_location then begin -- if !tag2 then begin -+ if !tag2 then begin - lprintf_n "master servers (old):"; -- tag1 := false; -- tag2 := false -- end; -- lprintf " %s" (Ip.to_string s.server_ip) -- end; -+ tag1 := false; -+ tag2 := false -+ end; -+ lprintf " %s" (string_of_server s) -+ end; - masters := s :: !masters - | _ -> s.server_master <- false - ) server_list; -@@ -772,8 +802,7 @@ - masters := s :: !masters; - masters := List.rev (List.sort compare_servers !masters); - -- server_send_share s.server_has_zlib sock -- (DonkeyShare.all_shared ()) -+ DonkeyGlobals.master_server := Some s; - ) - in - -@@ -786,7 +815,7 @@ - if !nconnected_servers > max_allowed_connected_servers then - begin - if !verbose_location then -- lprintf_nl "master servers: disconnect %s" (Ip.to_string s.server_ip); -+ lprintf_nl "master servers: disconnect %s" (string_of_server s); - nconnected_servers := !nconnected_servers - 3; - do_if_connected s.server_sock (fun sock -> - (* We will disconnect from this server. -@@ -805,23 +834,17 @@ - - connection_last_conn s.server_connection_control - in - if !verbose_location then -- lprintf_nl "master servers: Checking ip:%s, users: %Ld, ct:%d" -- (Ip.to_string s.server_ip) -- (match s.server_nusers with None -> 0L | Some v -> v) -- connection_time; -- if not s.server_master -- && (s.server_preferred -- || connection_time > !!become_master_delay -- ) -- then -+ lprintf_nl "master servers: Checking %s, users: %Ld, ct:%d" -+ (string_of_server s) -+ (match s.server_nusers with None -> 0L | Some v -> v) -+ connection_time; -+ if not s.server_master then - begin -- if (!nmasters < max_allowed_connected_servers) then -- begin -- if !verbose_location then -- lprintf_nl "master servers: raising %s" -- (Ip.to_string s.server_ip); -+ if (!nmasters < max_allowed_connected_servers) then begin -+ if !verbose_location then -+ lprintf_nl "master servers: raising %s" (string_of_server s); - make_master s -- end -+ end - else if s.server_sent_all_queries then - match !masters with - [] -> disconnect_old_server s -@@ -838,7 +861,7 @@ - or is a preferred one *) - if (s.server_preferred && not ss.server_preferred) - || (!!keep_best_server -- && mini ((Int64.to_int ss_nusers) + 1000) -+ && min ((Int64.to_int ss_nusers) + 1000) - ((Int64.to_int ss_nusers) * 5) - < (Int64.to_int s_nusers) - ) -@@ -847,7 +870,7 @@ - if !verbose_location then - lprintf_nl - "master servers: raising %s, disconnected %s" -- (Ip.to_string s.server_ip) (Ip.to_string ss.server_ip); -+ (string_of_server s) (string_of_server ss); - ss.server_master <- false; - masters := tail; - make_master s -Index: src/networks/donkey/donkeyShare.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyShare.ml,v -retrieving revision 1.50 -retrieving revision 1.55 -diff -u -r1.50 -r1.55 ---- src/networks/donkey/donkeyShare.ml 1 Sep 2006 16:22:15 -0000 1.50 -+++ src/networks/donkey/donkeyShare.ml 9 Oct 2006 16:17:19 -0000 1.55 -@@ -39,18 +39,15 @@ - - module VB = VerificationBitmap - --let new_shared_files = ref [] -- - let must_share_file file codedname has_old_impl = - match file.file_shared with - | Some _ -> () - | None -> -- new_shared := true; - let full_name = file_disk_name file in - let magic = - match Magic.M.magic_fileinfo full_name false with - None -> None -- | Some magic -> Some (HashMagic.merge files_magic magic) -+ | Some magic -> Some (intern magic) - in - - let impl = { -@@ -65,9 +62,9 @@ - impl_shared_val = file; - impl_shared_requests = 0; - impl_shared_magic = magic; -+ impl_shared_servers = [] - } in - file.file_shared <- Some impl; -- new_shared_files := file :: !new_shared_files; - incr CommonGlobals.nshared_files; - CommonShared.shared_calculate_total_bytes (); - match has_old_impl with -@@ -99,7 +96,7 @@ - lprintf_nl "Sharing file with MD4: %s" (Md4.to_string md4); - - let file = new_file sh.sh_name FileShared md4 sh.sh_size -- "" false in -+ "" false CommonUserDb.admin_user in - must_share_file file codedname old_impl; - file.file_computed_md4s <- md4s; - add_file_filenames (as_file file) (Filename.basename sh.sh_name); -@@ -162,41 +159,69 @@ - None -> () - | Some _ -> shared_files := file :: !shared_files - ) files_by_md4; -- if !verbose_share then lprintf_nl "%d files shared" (List.length !shared_files); -+ if !verbose_share then lprintf_nl "scanned shared files, %d files found" (List.length !shared_files); - !shared_files - --(* Check whether new files are shared, and send them to connected servers. -- Do it only once per 5 minutes to prevent sending to many times all files. -- Change: Just send *new* shared files to servers, they never forget a -- clients files until disconnection. -- Should I only do it for master servers, no ? --*) -+(* publish shared files to servers, called once per minute *) - let send_new_shared () = -- let tag = ref false in -- if !new_shared then -- begin -- new_shared := false; -- if !new_shared_files <> [] then -- begin -- List.iter (fun s -> -- if s.server_master then -- begin -- if !verbose_share || !verbose then -- lprintf_nl "send_new_shared: found master server %s:%d" -- (Ip.to_string s.server_ip) s.server_port; -- tag := true; -- do_if_connected s.server_sock (fun sock -> -- server_send_share s.server_has_zlib sock !new_shared_files) -- end -- ) (connected_servers ()); -- if !tag && (!verbose_share || !verbose) then -- lprintf_nl "send_new_shared: Sent %d new shared files to servers" -- (List.length !new_shared_files); -- new_shared_files := [] -- end -- else -- lprintf_nl "donkey send_new_share: No new shared files to send to servers" -- end -+(* sort list to publish least published files first *) -+ let ( |> ) x f = f x in -+ let all_shared = -+ all_shared () -+ |> List.map (fun e -> -+ (match e.file_shared with -+ Some s -> List.length s.impl_shared_servers -+ | _ -> 0) , e) -+ |> List.sort (fun (a,_) (b,_) -> compare a b) -+ |> List.map snd -+ in -+ -+(* iter through connected servers *) -+ List.iter (fun s -> -+ -+(* publish files only on master servers and do not publish more files than hard limit allows *) -+ if s.server_master && -+ (match s.server_hard_limit with -+ Some v when (Int64.to_int v) < List.length s.server_sent_shared -> false -+ | _ -> true) then -+ -+(* iter through all shared files and check if the file is already published on the current server -+ build a list of files_to_send with yet unpublished files *) -+ begin -+ let files_to_send = ref [] 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 -+ files_to_send := f :: !files_to_send -+ | _ -> () (* this case never happens *) -+ ) all_shared; -+ -+ if !files_to_send <> [] then -+ begin -+ if !verbose_share || !verbose then -+ lprintf_nl "publishing %d new files to %s (holds %d files)" -+ (List.length !files_to_send) (string_of_server s) -+ (List.length s.server_sent_shared); -+ -+(* publish files on server *) -+ do_if_connected s.server_sock (fun sock -> -+ server_send_share s.server_has_zlib sock !files_to_send); -+ -+(* append new published files to server structure *) -+ s.server_sent_shared <- !files_to_send @ s.server_sent_shared; -+ -+(* iter through published files and append current server *) -+ List.iter (fun file -> -+ match file.file_shared with -+ Some impl -> impl.impl_shared_servers <- -+ impl.impl_shared_servers @ [(CommonServer.as_server s.server_server)] -+ | _ -> ()) !files_to_send -+ -+ end -+ end -+ ) (connected_servers ()); - - (* - The problem: sh.shared_fd might be closed during the execution of the -@@ -209,7 +234,7 @@ - let computing = ref false - - (* Compute (at most) one MD4 chunk if needed. *) --let check_shared_files () = -+let rec check_shared_files () = - let module M = CommonHasher in - if not !computing then - match !shared_files with -@@ -259,7 +284,11 @@ - new_file_to_share s sh.shared_shared.impl_shared_codedname (Some sh.shared_shared); - end - else -- job_creater () -+ job_creater (); -+ (* only try back-to-back hashing if hashing is -+ handled by a separate thread *) -+ if BasicSocket.has_threads () then -+ check_shared_files () - ) - with - Wrong_file_size (real,computed) -> -@@ -307,7 +336,7 @@ - let magic = - match Magic.M.magic_fileinfo fullname false with - None -> None -- | Some magic -> Some (HashMagic.merge files_magic magic) -+ | Some magic -> Some (intern magic) - in - - let rec impl = { -@@ -322,6 +351,7 @@ - impl_shared_val = pre_shared; - impl_shared_requests = 0; - impl_shared_magic = magic; -+ impl_shared_servers = []; - } and - pre_shared = { - shared_shared = impl; -Index: src/networks/donkey/donkeyStats.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyStats.ml,v -retrieving revision 1.24 -retrieving revision 1.25 -diff -u -r1.24 -r1.25 ---- src/networks/donkey/donkeyStats.ml 26 Jan 2006 10:34:53 -0000 1.24 -+++ src/networks/donkey/donkeyStats.ml 23 Sep 2006 20:29:47 -0000 1.25 -@@ -170,6 +170,21 @@ - let _ = - network.op_network_display_stats <- (fun buf o -> print_stats o New false); - -+ network.op_network_stat_info_list <- (fun _ -> -+ let r = ref [] in -+ let l1 = stats_list brand_list stats_array in -+ let l2 = stats_list brand_list !!gstats_array in -+ let u1 = BasicSocket.last_time () - !start_session in -+ let u2 = (guptime() + u1) in -+ r := [("Session clients", u1, l1); ("Global clients", u2, l2)]; -+ if !!emule_mods_count then begin -+ let l3 = stats_list brand_mod_list stats_mod_array in -+ let l4 = stats_list brand_mod_list !!gstats_mod_array in -+ r := !r @ [ ("Session mods", u1, l3); ("Global mods", u2, l4)] -+ end; -+ !r -+ ); -+ - register_commands - [ - "client_stats", "Network/Donkey",Arg_none (fun o -> -Index: src/networks/donkey/donkeySui1.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeySui1.ml,v -retrieving revision 1.1 -retrieving revision 1.2 -diff -u -r1.1 -r1.2 ---- src/networks/donkey/donkeySui1.ml 26 Jan 2006 00:25:25 -0000 1.1 -+++ src/networks/donkey/donkeySui1.ml 21 Oct 2006 20:01:23 -0000 1.2 -@@ -30,3 +30,8 @@ - external create_signature : string -> int -> int64 -> int -> int64 -> string = "ml_createSignature" - external verify_signature : string -> int -> string -> int -> int64 -> int -> int64 -> bool = "ml_verifySignature_bytecode" "ml_verifySignature" - end -+ -+let ext_lprintf_nl msg = -+ if !CommonOptions.verbose_unexpected_messages then Printf2.lprintf_nl ("%s") msg -+ -+let _ = Callback.register "ml_lprintf_nl" ext_lprintf_nl -Index: src/networks/donkey/donkeyTypes.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyTypes.ml,v -retrieving revision 1.47 -retrieving revision 1.51 -diff -u -r1.47 -r1.51 ---- src/networks/donkey/donkeyTypes.ml 5 Sep 2006 14:18:24 -0000 1.47 -+++ src/networks/donkey/donkeyTypes.ml 14 Nov 2006 18:42:59 -0000 1.51 -@@ -39,6 +39,7 @@ - mutable emule_secident : int; - mutable emule_noviewshared : int; - mutable emule_supportpreview : int; -+ mutable emule_osinfosupport : int; - - mutable emule_compression : int; - mutable emule_sourceexchange : int; -@@ -430,7 +431,21 @@ - | Invalid_address _ -> failwith "Invalid address" - end) - --type server = (*[]*){ -+type file = { -+ file_file : file CommonFile.file_impl; -+ file_md4 : Md4.t; -+ mutable file_swarmer : CommonSwarming.t option; -+ mutable file_nchunks : int; -+ mutable file_nchunk_hashes : int; -+ mutable file_diskname : string; -+ mutable file_computed_md4s : Md4.t array; -+ mutable file_format : format; -+ mutable file_shared : file CommonShared.shared_impl option; -+ mutable file_sources : DonkeySources.file_sources_manager; -+ mutable file_comments : (Ip.t * string * int * string) list; -+ } -+ -+and server = (*[]*){ - mutable server_server : server CommonServer.server_impl; - mutable server_ip : Ip.t; - mutable server_cid : Ip.t option; -@@ -463,6 +478,19 @@ - mutable server_waiting_queries : file list; - mutable server_sent_all_queries : bool; - mutable server_has_zlib : bool; -+ mutable server_has_newtags : bool; -+ mutable server_has_unicode : bool; -+ mutable server_has_related_search : bool; -+ mutable server_has_tag_integer : bool; -+ mutable server_has_largefiles : bool; -+ mutable server_has_udp_obfuscation : bool; -+ mutable server_has_tcp_obfuscation : bool; -+ mutable server_obfuscation_port_tcp : int option; -+ mutable server_obfuscation_port_udp : int option; -+ mutable server_udp_key : int option; -+ mutable server_udp_keyip : Ip.t option; -+ mutable server_dynip : string; -+ mutable server_auxportslist : string; - - mutable server_flags : int; - mutable server_version : string; -@@ -470,6 +498,7 @@ - mutable server_soft_limit : int64 option; - mutable server_hard_limit : int64 option; - mutable server_max_users : int64 option; -+ mutable server_sent_shared : file list - } - - -@@ -519,7 +548,6 @@ - CommonSwarming.uploader - ) list; - mutable client_all_files : result list option; -- mutable client_last_asked_file : CommonTypes.file; - mutable client_tags: CommonTypes.tag list; - mutable client_name : string; - mutable client_rating : int ; -@@ -531,6 +559,8 @@ - mutable client_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; -@@ -549,6 +579,7 @@ - mutable client_req_challenge : Int64.t; - mutable client_public_key : string option; - mutable client_sui_verified : bool option; -+ mutable client_last_file_req_md4 : Md4.t option; - } - - and compressed_parts = { -@@ -579,19 +610,6 @@ - int * (* last connection attempt *) - int (* booked client num *) - --and file = { -- file_file : file CommonFile.file_impl; -- file_md4 : Md4.t; -- mutable file_swarmer : CommonSwarming.t option; -- mutable file_nchunks : int; -- mutable file_nchunk_hashes : int; -- mutable file_diskname : string; -- mutable file_computed_md4s : Md4.t array; -- mutable file_format : format; -- mutable file_shared : file CommonShared.shared_impl option; -- mutable file_sources : DonkeySources.file_sources_manager; -- } -- - and file_to_share = { - shared_name : string; - shared_size : int64; -@@ -674,6 +692,7 @@ - emule_secident = 0; - emule_noviewshared = 0; - emule_supportpreview = 0; -+ emule_osinfosupport = 0; - - emule_compression = 0; (* 1 *) - emule_sourceexchange = 0; (* 3 *) -Index: src/networks/donkey/donkeyUdp.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyUdp.ml,v -retrieving revision 1.23 -retrieving revision 1.25 -diff -u -r1.23 -r1.25 ---- src/networks/donkey/donkeyUdp.ml 1 Sep 2006 16:25:15 -0000 1.23 -+++ src/networks/donkey/donkeyUdp.ml 15 Nov 2006 12:34:30 -0000 1.25 -@@ -223,7 +223,7 @@ - - let udp_client_handler t p = - if !verbose_udp then -- lprintf "Received UDP message:\n%s\n" (Udp.print t); -+ lprintf_nl "Received UDP message:\n%s" (Udp.print t); - - let udp_from_server p = - match p.UdpSocket.udp_addr with -@@ -296,7 +296,11 @@ - s.server_name <- name - | { tag_name = Field_UNKNOWN "description"; tag_value = String desc } -> - s.server_description <- desc -- | _ -> () -+ | { tag_name = Field_UNKNOWN "auxportslist" ; tag_value = String aux } -> -+ s.server_auxportslist <- aux -+ | { tag_name = Field_UNKNOWN "dynip" ; tag_value = String dynip } -> -+ s.server_dynip <- dynip -+ | _ -> lprintf_nl "parsing Udp.ServerDescReplyUdp, unknown field %s" (string_of_tag tag) - ) t.M.tags; - - if s.server_tags = [] then -@@ -306,6 +310,15 @@ - - | Udp.EmuleReaskFilePingUdpReq t -> () - -+ | Udp.EmulePortTestReq -> -+ (match !porttest_sock with -+ None -> () -+ | Some sock -> -+ let s = Buffer.create 10 in -+ DonkeyProtoUdp.write s Udp.EmulePortTestReq; -+ TcpBufferedSocket.write_string sock (Buffer.contents s); -+ porttest_sock := None) -+ - | _ -> - if !verbose_unexpected_messages then - lprintf "Unexpected UDP message: %s\n" -Index: src/networks/fasttrack/fasttrackGlobals.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fasttrack/fasttrackGlobals.ml,v -retrieving revision 1.41 -retrieving revision 1.43 -diff -u -r1.41 -r1.43 ---- src/networks/fasttrack/fasttrackGlobals.ml 1 Sep 2006 16:22:15 -0000 1.41 -+++ src/networks/fasttrack/fasttrackGlobals.ml 9 Nov 2006 21:32:27 -0000 1.43 -@@ -267,7 +267,7 @@ - - let min_range_size = megabyte - --let new_file file_temporary file_name file_size file_hash = -+let new_file file_temporary file_name file_size file_hash user = - let file_temp = Filename.concat !!temp_directory file_temporary in - (* (Printf.sprintf "FT-%s" (Md4.to_string file_id)) in *) - let t = Unix32.create_rw file_temp in -@@ -293,6 +293,8 @@ - impl_file_fd = Some t; - impl_file_size = file_size; - impl_file_downloaded = Int64.zero; -+ impl_file_owner = user; -+ impl_file_group = user.user_default_group; - impl_file_val = file; - impl_file_ops = file_ops; - impl_file_age = last_time (); -@@ -335,7 +337,7 @@ - - exception FileFound of file - --let new_file file_id file_name file_size file_uids = -+let new_file file_id file_name file_size file_uids user = - let file = ref None in - List.iter (fun uid -> - match Uid.to_uid uid with -@@ -343,7 +345,7 @@ - file := Some (try - Hashtbl.find files_by_uid file_hash - with _ -> -- let file = new_file file_id file_name file_size file_hash in -+ let file = new_file file_id file_name file_size file_hash user in - Hashtbl.add files_by_uid file_hash file; - file) - | _ -> () -Index: src/networks/fasttrack/fasttrackPandora.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fasttrack/fasttrackPandora.ml,v -retrieving revision 1.9 -retrieving revision 1.10 -diff -u -r1.9 -r1.10 ---- src/networks/fasttrack/fasttrackPandora.ml 14 Dec 2005 21:17:46 -0000 1.9 -+++ src/networks/fasttrack/fasttrackPandora.ml 21 Nov 2006 22:34:34 -0000 1.10 -@@ -223,7 +223,7 @@ - let check1 = check_xinu s (pos + 5 + len1) len (depth+1) in - let check2 = check_xinu s (pos + 5 + len2) len (depth+1) in - -- maxi check0 (maxi check1 check2) -+ max check0 (max check1 check2) - else depth - | _ -> -10 - -Index: src/networks/fasttrack/fasttrackServers.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fasttrack/fasttrackServers.ml,v -retrieving revision 1.29 -retrieving revision 1.30 -diff -u -r1.29 -r1.30 ---- src/networks/fasttrack/fasttrackServers.ml 19 May 2006 23:43:54 -0000 1.29 -+++ src/networks/fasttrack/fasttrackServers.ml 19 Sep 2006 17:07:43 -0000 1.30 -@@ -322,7 +322,7 @@ - ) file.file_searches - ) !connected_servers - --let really_download_file (r : CommonTypes.result_info) = -+let really_download_file (r : CommonTypes.result_info) user = - let rec iter uids = - match uids with - uid :: tail -> -@@ -334,7 +334,7 @@ - let hash,file_temp = iter r.result_uids in - - let file = new_file file_temp (List.hd r.result_names) -- r.result_size [Uid.create (Md5Ext hash)] in -+ r.result_size [Uid.create (Md5Ext hash)] user in - if !verbose then - lprintf "DOWNLOAD FILE %s\n" file.file_name; - if not (List.memq file !current_files) then begin -Index: src/networks/fileTP/fileTPClients.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fileTP/fileTPClients.ml,v -retrieving revision 1.22 -retrieving revision 1.23 -diff -u -r1.22 -r1.23 ---- src/networks/fileTP/fileTPClients.ml 8 Aug 2006 23:55:28 -0000 1.22 -+++ src/networks/fileTP/fileTPClients.ml 19 Sep 2006 17:07:43 -0000 1.23 -@@ -63,9 +63,9 @@ - if (filesize = 0L || !!chunk_size = 0) then 1 - else Int64.to_int ((filesize) // (min_range_size file)) + 5 - --let pause_for_cause f r = -+let pause_for_cause f r user = - lprintf_nl "Pausing file %s (%s)" (file_best_name f) r; -- file_pause (as_file f) -+ file_pause (as_file f) user - - let disconnect_client c r = - match c.client_sock with -Index: src/networks/fileTP/fileTPComplexOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fileTP/fileTPComplexOptions.ml,v -retrieving revision 1.16 -retrieving revision 1.17 -diff -u -r1.16 -r1.17 ---- src/networks/fileTP/fileTPComplexOptions.ml 25 May 2006 19:47:25 -0000 1.16 -+++ src/networks/fileTP/fileTPComplexOptions.ml 19 Sep 2006 17:07:43 -0000 1.17 -@@ -78,8 +78,7 @@ - Md4.of_string (get_value "file_id" value_to_string) - with _ -> failwith "Bad file_id" - in -- -- let file = new_file file_id file_name file_size in -+ let file = new_file file_id file_name file_size CommonUserDb.admin_user in - - (match file.file_swarmer with - None -> () -Index: src/networks/fileTP/fileTPFTP.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fileTP/fileTPFTP.ml,v -retrieving revision 1.13 -retrieving revision 1.14 -diff -u -r1.13 -r1.14 ---- src/networks/fileTP/fileTPFTP.ml 30 May 2006 10:54:14 -0000 1.13 -+++ src/networks/fileTP/fileTPFTP.ml 19 Sep 2006 17:07:43 -0000 1.14 -@@ -278,13 +278,13 @@ - | "530 " -> - let reason = String.sub line 4 (slen - 4) in - if not (retry_530 reason) then begin -- pause_for_cause d.download_file "530"; -+ pause_for_cause d.download_file "530" CommonUserDb.admin_user; - end else begin - c.client_reconnect <- true; - end; - disconnect_client c Closed_by_user; - | "550 " -> -- pause_for_cause d.download_file "550"; -+ pause_for_cause d.download_file "550" CommonUserDb.admin_user; - disconnect_client c Closed_by_user; - | _ -> - if !verbose then lprintf_nl "Unexpected line %s" line; -@@ -443,11 +443,11 @@ - | "530 " -> - let reason = String.sub line 4 (slen - 4) in - if not (retry_530 reason) then begin -- pause_for_cause file "530"; -+ pause_for_cause file "530" CommonUserDb.admin_user; - end; - close sock Closed_by_user; - | "550 " -> -- pause_for_cause file "550"; -+ pause_for_cause file "550" CommonUserDb.admin_user; - close sock Closed_by_user; - | _ -> - if !verbose then lprintf_nl "Unexpected line %s" line; -Index: src/networks/fileTP/fileTPGlobals.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fileTP/fileTPGlobals.ml,v -retrieving revision 1.28 -retrieving revision 1.30 -diff -u -r1.28 -r1.30 ---- src/networks/fileTP/fileTPGlobals.ml 1 Sep 2006 16:22:15 -0000 1.28 -+++ src/networks/fileTP/fileTPGlobals.ml 9 Nov 2006 21:32:27 -0000 1.30 -@@ -138,7 +138,7 @@ - file_must_update (as_file file); - end - --let new_file file_id file_name file_size = -+let new_file file_id file_name file_size user = - let file_temp = Filename.concat !!temp_directory - (Printf.sprintf "FileTP-%s" (Md4.to_string file_id)) in - let t = Unix32.create_rw file_temp in -@@ -152,6 +152,8 @@ - file_nconnected_clients = 0; - } and file_impl = { - dummy_file_impl with -+ impl_file_owner = user; -+ impl_file_group = user.user_default_group; - impl_file_fd = Some t; - impl_file_size = zero; - impl_file_downloaded = zero; -@@ -168,11 +170,11 @@ - (* lprintf "ADD FILE TO DOWNLOAD LIST\n"; *) - file - --let new_file file_id file_name file_size = -+let new_file file_id file_name file_size users = - try - Hashtbl.find files_by_uid file_id - with _ -> -- let file = new_file file_id file_name file_size in -+ let file = new_file file_id file_name file_size users in - Hashtbl.add files_by_uid file_id file; - file - -Index: src/networks/fileTP/fileTPHTTP.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fileTP/fileTPHTTP.ml,v -retrieving revision 1.25 -retrieving revision 1.26 -diff -u -r1.25 -r1.26 ---- src/networks/fileTP/fileTPHTTP.ml 10 Aug 2006 17:41:20 -0000 1.25 -+++ src/networks/fileTP/fileTPHTTP.ml 19 Sep 2006 17:07:43 -0000 1.26 -@@ -174,7 +174,7 @@ - end; - - if code < 200 || code > 299 then begin -- pause_for_cause file (Printf.sprintf "%d" code); -+ pause_for_cause file (Printf.sprintf "%d" code) CommonUserDb.admin_user; - failwith "Bad HTTP code"; - end; - -@@ -386,7 +386,7 @@ - (fun c -> - match c with - x when x < 200 || x > 299 -> -- pause_for_cause file (string_of_int x); -+ pause_for_cause file (string_of_int x) CommonUserDb.admin_user; - | _ -> () - ) - -Index: src/networks/fileTP/fileTPInteractive.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/fileTP/fileTPInteractive.ml,v -retrieving revision 1.46 -retrieving revision 1.52 -diff -u -r1.46 -r1.52 ---- src/networks/fileTP/fileTPInteractive.ml 5 Sep 2006 15:32:17 -0000 1.46 -+++ src/networks/fileTP/fileTPInteractive.ml 12 Nov 2006 12:44:24 -0000 1.52 -@@ -234,7 +234,7 @@ - - let previous_url = ref "" - --let download_file url referer = -+let download_file url referer user = - let u = Url.of_string url in - - if List.mem u !!old_files && !previous_url <> url then begin -@@ -242,7 +242,7 @@ - failwith "URL already downloaded: repeat command again to force"; - end; - -- let file = new_file (Md4.random ()) u.Url.full_file zero in -+ let file = new_file (Md4.random ()) u.Url.full_file zero user in - - if !verbose then - lprintf_nl "Started new download: %s from %s" (file_best_name file) url; -@@ -250,6 +250,7 @@ - current_files := file :: !current_files; - end; - -+ CommonInteractive.start_download (as_file file); - download_file_from_mirror file u referer; - find_mirrors file u - -@@ -276,7 +277,7 @@ - It returns true if this file can be handled by fileTP, - and false otherwise. - *) --let op_network_parse_url url = -+let op_network_parse_url url user = - let location_regexp = "Location: \\(.*\\)" in - let real_url = get_regexp_string url (Str.regexp location_regexp) in - if (is_http_torrent url real_url) && !!enable_bittorrent then -@@ -286,7 +287,7 @@ - let length_regexp = "Content-Length: \\(.*\\)" in - try let length = get_regexp_int url (Str.regexp length_regexp) in - if (length > 0) then begin -- download_file real_url ""; "started FileTP download", true -+ download_file real_url "" user; "started FileTP download", true - end - else "can not parse Content-Length", false - with Not_found -> -@@ -295,7 +296,7 @@ - else - if (String2.check_prefix real_url "ftp://") || - (String2.check_prefix real_url "ssh://") then ( -- download_file real_url ""; -+ download_file url "" user; - "started FileTP download", true) - else - "invalid URL", false -@@ -310,8 +311,8 @@ - "http", "Network/FileTP", Arg_multiple (fun args o -> - try - (match args with -- url :: [referer] -> download_file url referer -- | [url] -> download_file url "" -+ url :: [referer] -> download_file url referer o.conn_user.ui_user -+ | [url] -> download_file url "" o.conn_user.ui_user - | _ -> raise Not_found); - let buf = o.conn_buf in - if o.conn_output = HTML then -@@ -405,7 +406,7 @@ - CommonNetwork.register_commands commands; - network.op_network_share <- (fun fullname codedname size -> ()); - network.op_network_search <- (fun ss buf -> ()); -- network.op_network_download <- (fun r -> dummy_file); -+ network.op_network_download <- (fun r user -> dummy_file); - file_ops.op_file_commit <- (fun file new_name -> clean_stop file); - file_ops.op_file_pause <- (fun file -> - List.iter (fun c -> -@@ -416,9 +417,10 @@ - ) file.file_clients - ); - file_ops.op_file_resume <- (fun file -> ()); -- file_ops.op_file_print_html <- (fun file buf -> ()); -+ file_ops.op_file_print <- (fun file buf -> ()); - network.op_network_close_search <- (fun s -> ()); - network.op_network_forget_search <- (fun s -> ()); - network.op_network_connect_servers <- (fun s -> ()); - network.op_network_reset <- (fun _ -> ()); -+ network.op_network_porttest_result <- (fun _ -> PorttestNotAvailable); - network.op_network_recover_temp <- (fun s -> ()) -Index: src/networks/gnutella/gnutellaClients.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/gnutella/gnutellaClients.ml,v -retrieving revision 1.43 -retrieving revision 1.45 -diff -u -r1.43 -r1.45 ---- src/networks/gnutella/gnutellaClients.ml 8 Aug 2006 23:55:28 -0000 1.43 -+++ src/networks/gnutella/gnutellaClients.ml 21 Nov 2006 22:34:34 -0000 1.45 -@@ -997,7 +997,7 @@ - if get_request then - let pos = uc.uc_chunk_pos in - let to_write = uc.uc_chunk_end -- pos in -- let rlen = mini (max_refill sock) (Int64.to_int to_write) in -+ let rlen = min (max_refill sock) (Int64.to_int to_write) in - if !verbose_msg_clients then - lprintf "[GUP] to_write: %d/%Ld/%d\n" rlen to_write - (remaining_to_write sock); -@@ -1041,7 +1041,7 @@ - let listen () = - try - let sock = TcpServerSocket.create "gnutella client server" -- Unix.inet_addr_any -+ (Ip.to_inet_addr !!client_bind_addr) - !!client_port - (fun sock event -> - match event with -Index: src/networks/gnutella/gnutellaComplexOptions.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/gnutella/gnutellaComplexOptions.ml,v -retrieving revision 1.28 -retrieving revision 1.29 -diff -u -r1.28 -r1.29 ---- src/networks/gnutella/gnutellaComplexOptions.ml 25 May 2006 19:47:25 -0000 1.28 -+++ src/networks/gnutella/gnutellaComplexOptions.ml 19 Sep 2006 17:07:43 -0000 1.29 -@@ -130,7 +130,7 @@ - file_uids := hash :: !file_uids; - with _ -> ()); - -- let file = new_file file_temp file_name file_size !file_uids in -+ let file = new_file file_temp file_name file_size !file_uids CommonUserDb.admin_user in - - (try - file.file_ttr <- Some (get_value "file_ttr" (value_to_array -Index: src/networks/gnutella/gnutellaGlobals.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/gnutella/gnutellaGlobals.ml,v -retrieving revision 1.42 -retrieving revision 1.44 -diff -u -r1.42 -r1.44 ---- src/networks/gnutella/gnutellaGlobals.ml 1 Sep 2006 16:22:15 -0000 1.42 -+++ src/networks/gnutella/gnutellaGlobals.ml 9 Nov 2006 21:32:27 -0000 1.44 -@@ -310,7 +310,7 @@ - let megabyte = Int64.of_int (1024 * 1024) - let megabytes10 = Int64.of_int (10 * 1024 * 1024) - --let new_file file_temporary file_name file_size file_uids = -+let new_file file_temporary file_name file_size file_uids user = - let file_temp = Filename.concat !!temp_directory file_temporary in - let t = Unix32.create_rw file_temp in - let rec file = { -@@ -329,6 +329,8 @@ - impl_file_fd = Some t; - impl_file_size = file_size; - impl_file_downloaded = Int64.zero; -+ impl_file_owner = user; -+ impl_file_group = user.user_default_group; - impl_file_val = file; - impl_file_ops = file_ops; - impl_file_age = last_time (); -@@ -357,7 +359,7 @@ - - exception FileFound of file - --let new_file file_id file_name file_size file_uids = -+let new_file file_id file_name file_size file_uids user = - (* if file_uids = [] then - try Hashtbl.find files_by_key (file_name, file_size) with - _ -> -@@ -370,7 +372,7 @@ - try raise (FileFound (Hashtbl.find files_by_uid uid)) - with Not_found -> () - ) file_uids; -- let file = new_file file_id file_name file_size file_uids in -+ let file = new_file file_id file_name file_size file_uids user in - List.iter (fun uid -> - if !verbose then - lprintf "Adding file %s\n" (Uid.to_string uid); -Index: src/networks/gnutella/gnutellaHandler.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/gnutella/gnutellaHandler.ml,v -retrieving revision 1.15 -retrieving revision 1.16 -diff -u -r1.15 -r1.16 ---- src/networks/gnutella/gnutellaHandler.ml 28 Aug 2006 18:19:16 -0000 1.15 -+++ src/networks/gnutella/gnutellaHandler.ml 21 Nov 2006 22:34:34 -0000 1.16 -@@ -180,7 +180,7 @@ - let module M = QueryReply in - let module C = CommonUploads in - let replies = ref [] in -- for i = 0 to mini (Array.length files - 1) 9 do -+ for i = 0 to min (Array.length files - 1) 9 do - let sh, info = files.(i) in - let infos = ref [] in - List.iter (fun uid -> -Index: src/networks/gnutella/gnutellaInteractive.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/gnutella/gnutellaInteractive.ml,v -retrieving revision 1.63 -retrieving revision 1.67 -diff -u -r1.63 -r1.67 ---- src/networks/gnutella/gnutellaInteractive.ml 5 Sep 2006 15:32:17 -0000 1.63 -+++ src/networks/gnutella/gnutellaInteractive.ml 12 Nov 2006 12:44:24 -0000 1.67 -@@ -77,8 +77,8 @@ - if file_state file = FileDownloading then - GnutellaServers.really_recover_file file - --let download_file r = -- let file = GnutellaServers.really_download_file r in -+let download_file r user = -+ let file = GnutellaServers.really_download_file r user in - recover_file file; - as_file file - -@@ -219,6 +219,7 @@ - [ - !!client_port, "client_port TCP+UDP"; - ]); -+ network.op_network_porttest_result <- (fun _ -> PorttestNotAvailable); - network.op_network_share <- (fun fullname codedname size -> - (* - lprintf "*************** op_network_share %s\n -@@ -241,8 +242,8 @@ - end - ); - (* TODO RESULT *) -- network.op_network_download <- (fun r -> -- result_download r -+ network.op_network_download <- (fun r user -> -+ result_download r user - ) - - let file_num file = -@@ -288,7 +289,7 @@ - module P = GuiTypes - - let _ = -- file_ops.op_file_print_html <- (fun file buf -> ()); -+ file_ops.op_file_print <- (fun file buf -> ()); - file_ops.op_file_cancel <- (fun file -> - CommonSwarming.remove_swarmer file.file_swarmer; - file.file_swarmer <- None; -@@ -370,7 +371,7 @@ - List2.tail_map (fun s -> as_server s.server_server) - !connected_servers - ); -- network.op_network_parse_url <- (fun url -> -+ network.op_network_parse_url <- (fun url user -> - match String2.split (String.escaped url) '|' with - | "gnut://" :: "server" :: ip :: port :: _ -> - let ip = Ip.addr_of_string ip in -@@ -402,7 +403,7 @@ - (* Start a download for this file *) - let rs = new_result name size [] uids [] in - let r = IndexedResults.get_result rs in -- let file = download_file r in -+ let file = download_file r user in - CommonInteractive.start_download file; - "started Gnutella download", true - end -Index: src/networks/gnutella/gnutellaServers.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/gnutella/gnutellaServers.ml,v -retrieving revision 1.28 -retrieving revision 1.29 -diff -u -r1.28 -r1.29 ---- src/networks/gnutella/gnutellaServers.ml 19 May 2006 23:43:55 -0000 1.28 -+++ src/networks/gnutella/gnutellaServers.ml 19 Sep 2006 17:07:43 -0000 1.29 -@@ -678,14 +678,14 @@ - (* *) - (*************************************************************************) - --let really_download_file (r : result_info) = -+let really_download_file (r : result_info) user = - if !verbose then - lprintf "download_file\n"; - let file_temp = match r.result_uids with - [] -> assert false - | uid :: _ -> Uid.to_file_string uid in - let file = new_file file_temp -- (List.hd r.result_names) r.result_size r.result_uids in -+ (List.hd r.result_names) r.result_size r.result_uids user in - if !verbose then - lprintf "DOWNLOAD FILE %s\n" file.file_name; - if not (List.memq file !current_files) then begin -Index: src/networks/opennap/opennapClients.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/opennap/opennapClients.ml,v -retrieving revision 1.10 -retrieving revision 1.11 -diff -u -r1.10 -r1.11 ---- src/networks/opennap/opennapClients.ml 10 Apr 2006 19:16:36 -0000 1.10 -+++ src/networks/opennap/opennapClients.ml 12 Nov 2006 12:36:14 -0000 1.11 -@@ -69,8 +69,8 @@ - (try file_completed (as_file file.file_file) - with e -> - lprintf "Exception %s in file completed" -- (Printexc2.to_string e) -- ; lprint_newline ()); -+ (Printexc2.to_string e); -+ lprint_newline ()); - current_files := List2.removeq file !current_files; - old_files =:= (file.file_name, file_size file) :: !!old_files; - List.iter (fun c -> -@@ -357,4 +357,4 @@ - lprintf "Exception %s while init limewire server" - (Printexc2.to_string e); - lprint_newline () -- -\ No newline at end of file -+ -Index: src/networks/opennap/opennapInteractive.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/opennap/opennapInteractive.ml,v -retrieving revision 1.25 -retrieving revision 1.26 -diff -u -r1.25 -r1.26 ---- src/networks/opennap/opennapInteractive.ml 5 Sep 2006 14:15:20 -0000 1.25 -+++ src/networks/opennap/opennapInteractive.ml 1 Oct 2006 17:54:00 -0000 1.26 -@@ -241,6 +241,7 @@ - [ - !!client_port, "client_port TCP"; - ]); -+ network.op_network_porttest_result <- (fun _ -> PorttestNotAvailable); - - network.op_network_recover_temp <- (fun s -> ()); - -Index: src/networks/opennap/opennapProtocol.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/opennap/opennapProtocol.ml,v -retrieving revision 1.4 -retrieving revision 1.5 -diff -u -r1.4 -r1.5 ---- src/networks/opennap/opennapProtocol.ml 16 Oct 2005 20:42:54 -0000 1.4 -+++ src/networks/opennap/opennapProtocol.ml 12 Nov 2006 12:42:55 -0000 1.5 -@@ -771,7 +771,7 @@ - end - - module Msg = struct -- type t = () -+ type t = unit - - let parse s = () - -Index: src/networks/soulseek/slskInteractive.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/networks/soulseek/slskInteractive.ml,v -retrieving revision 1.23 -retrieving revision 1.24 -diff -u -r1.23 -r1.24 ---- src/networks/soulseek/slskInteractive.ml 5 Sep 2006 14:15:20 -0000 1.23 -+++ src/networks/soulseek/slskInteractive.ml 1 Oct 2006 17:54:00 -0000 1.24 -@@ -182,6 +182,7 @@ - - let _ = - network.op_network_ports <- (fun _ -> []); -+ network.op_network_porttest_result <- (fun _ -> PorttestNotAvailable); - network.op_network_recover_temp <- (fun s -> ()); - network.op_network_load_complex_options <- (fun _ -> ()); - network.op_network_download <- (fun r -> -Index: src/utils/cdk/filename2.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/filename2.ml,v -retrieving revision 1.5 -retrieving revision 1.6 -diff -u -r1.5 -r1.6 ---- src/utils/cdk/filename2.ml 20 Jul 2006 15:30:21 -0000 1.5 -+++ src/utils/cdk/filename2.ml 31 Oct 2006 15:40:06 -0000 1.6 -@@ -196,7 +196,7 @@ - let sys_checked_name = - if Autoconf.windows then - windows_compliant name -- else if Autoconf.system = "macosx" then -+ else if Autoconf.system = "macos" then - macosx_compliant name - else - posix_compliant name in -Index: src/utils/cdk/printf2.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/printf2.ml,v -retrieving revision 1.20 -retrieving revision 1.21 -diff -u -r1.20 -r1.21 ---- src/utils/cdk/printf2.ml 24 Jul 2006 20:15:16 -0000 1.20 -+++ src/utils/cdk/printf2.ml 9 Nov 2006 21:32:27 -0000 1.21 -@@ -395,3 +395,6 @@ - - let html_mods_cntr_init () = - html_mods_counter := true -+ -+let print_plural_s v = -+ if v > 1 then "s" else "" -Index: src/utils/cdk/printf2.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/printf2.mli,v -retrieving revision 1.8 -retrieving revision 1.9 -diff -u -r1.8 -r1.9 ---- src/utils/cdk/printf2.mli 24 Jul 2006 20:15:16 -0000 1.8 -+++ src/utils/cdk/printf2.mli 9 Nov 2006 21:32:27 -0000 1.9 -@@ -56,4 +56,4 @@ - val html_mods_td : Buffer.t -> (string * string * string) list -> unit - val html_mods_cntr_init : unit -> unit - val html_mods_cntr : unit -> int -- -+val print_plural_s : int -> string -Index: src/utils/lib/CryptoPP.cc -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/CryptoPP.cc,v -retrieving revision 1.5 -retrieving revision 1.6 -diff -u -r1.5 -r1.6 ---- src/utils/lib/CryptoPP.cc 2 Dec 2005 12:01:44 -0000 1.5 -+++ src/utils/lib/CryptoPP.cc 21 Oct 2006 20:01:23 -0000 1.6 -@@ -9515,6 +9515,8 @@ - static byte m_publicKey[MAXPUBKEYSIZE+1]; - static unsigned long m_publicKeyLen = 0; - -+void cc_lprintf_nl(const char * msg); -+ - void crypto_exit () { - if (s_signer) { - delete (Signer*) s_signer; -@@ -9539,7 +9541,9 @@ - buf[myString.size()] = 0; - - } catch(const CryptoPP::Exception& e) { -- std::cerr << "createKey: " << e.what() << std::endl; -+ char buf[256]="[CryptoPP] createKey: "; -+ strcat(buf, e.what()); -+ cc_lprintf_nl(buf); - } - - } -@@ -9570,7 +9574,9 @@ - result = m_publicKeyLen; - - } catch(const CryptoPP::Exception& e) { -- std::cerr << "loadKey: " << e.what() << std::endl; -+ char buf[256]="[CryptoPP] loadKey: "; -+ strcat(buf, e.what()); -+ cc_lprintf_nl(buf); - } - - return result; -@@ -9585,7 +9591,7 @@ - - - if (s_signer == NULL) { -- std::cerr << "createSignature: No signer" << std::endl; -+ cc_lprintf_nl("createSignature: No signer"); - return result; - } - -@@ -9612,7 +9618,9 @@ - result = aSink.TotalPutLength(); - - } catch(const CryptoPP::Exception& e) { -- std::cerr << "createSignature: " << e.what() << std::endl; -+ char buf[256]="[CryptoPP] createSignature: "; -+ strcat(buf, e.what()); -+ cc_lprintf_nl(buf); - } - - return result; -@@ -9640,11 +9648,12 @@ - PokeUInt32(bArray+m_publicKeyLen+4,ip); - PokeUInt8(bArray+m_publicKeyLen+4+4,ipType); - } -- - result = pubKey.VerifyMessage(bArray, m_publicKeyLen+4+extra, sig, sigLen); - - } catch(const CryptoPP::Exception& e) { -- std::cerr << "verifySignature: " << e.what() << std::endl; -+ char buf[256]="[CryptoPP] verifySignature: "; -+ strcat(buf, e.what()); -+ cc_lprintf_nl(buf); - } - - return result ? 1 : 0; -Index: src/utils/lib/CryptoPP_stubs.c -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/CryptoPP_stubs.c,v -retrieving revision 1.2 -retrieving revision 1.3 -diff -u -r1.2 -r1.3 ---- src/utils/lib/CryptoPP_stubs.c 29 Jan 2006 19:50:33 -0000 1.2 -+++ src/utils/lib/CryptoPP_stubs.c 21 Oct 2006 20:01:23 -0000 1.3 -@@ -17,10 +17,6 @@ - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - */ - --#include <string.h> --#include <caml/mlvalues.h> --#include <caml/alloc.h> -- - #include "CryptoPP_stubs.h" - - -@@ -87,3 +83,11 @@ - ml_verifySignature_bytecode(value *argv, int argn) { - return ml_verifySignature(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6]); - } -+ -+void cc_lprintf_nl(const char * msg) -+{ -+ static value * caml_func = NULL; -+ if (caml_func == NULL) caml_func = caml_named_value("ml_lprintf_nl"); -+ caml_callback(*caml_func, caml_copy_string(msg)); -+} -+ -Index: src/utils/lib/CryptoPP_stubs.h -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/CryptoPP_stubs.h,v -retrieving revision 1.2 -retrieving revision 1.3 -diff -u -r1.2 -r1.3 ---- src/utils/lib/CryptoPP_stubs.h 29 Jan 2006 19:50:33 -0000 1.2 -+++ src/utils/lib/CryptoPP_stubs.h 21 Oct 2006 20:01:23 -0000 1.3 -@@ -20,6 +20,11 @@ - - #include "../../../config/config.h" - -+#include <string.h> -+#include <caml/mlvalues.h> -+#include <caml/alloc.h> -+#include <caml/callback.h> -+ - #if defined (HAVE_STDINT_H) - #include <stdint.h> - #endif -Index: src/utils/lib/autoconf.ml.new.in -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/autoconf.ml.new.in,v -retrieving revision 1.25 -retrieving revision 1.26 -diff -u -r1.25 -r1.26 ---- src/utils/lib/autoconf.ml.new.in 10 Aug 2006 17:41:20 -0000 1.25 -+++ src/utils/lib/autoconf.ml.new.in 3 Oct 2006 15:23:08 -0000 1.26 -@@ -52,5 +52,3 @@ - let zlib__uncompress_string2 s = Zlib.uncompress_string2 s - let zlib__compress_string s = Zlib.compress_string s - let zlib__gzip_string s = Zlib.gzip_string s -- --@TYPE_FORMAT@ -Index: src/utils/lib/charset.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/charset.ml,v -retrieving revision 1.7 -retrieving revision 1.9 -diff -u -r1.7 -r1.9 ---- src/utils/lib/charset.ml 14 Sep 2006 17:40:29 -0000 1.7 -+++ src/utils/lib/charset.ml 8 Oct 2006 14:12:13 -0000 1.9 -@@ -172,7 +172,7 @@ - (**********************************************************************************) - - (* taken from camomile *) --(* $Id: charset.ml,v 1.7 2006/09/14 17:40:29 spiralvoice Exp $ *) -+(* $Id: charset.ml,v 1.9 2006/10/08 14:12:13 spiralvoice Exp $ *) - (* Copyright 2002, 2003 Yamagata Yoriyuki. distributed with LGPL *) - - let utf8_look s i = -@@ -254,7 +254,7 @@ - (**********************************************************************************) - - (* taken from camomile *) --(* $Id: charset.ml,v 1.7 2006/09/14 17:40:29 spiralvoice Exp $ *) -+(* $Id: charset.ml,v 1.9 2006/10/08 14:12:13 spiralvoice Exp $ *) - (* Copyright 2002, 2003 Yamagata Yoriyuki. distributed with LGPL *) - - let rec length_aux s c i = -@@ -281,7 +281,7 @@ - - - (* taken from camomile *) --(* $Id: charset.ml,v 1.7 2006/09/14 17:40:29 spiralvoice Exp $ *) -+(* $Id: charset.ml,v 1.9 2006/10/08 14:12:13 spiralvoice Exp $ *) - (* Copyright 2002, 2003 Yamagata Yoriyuki. distributed with LGPL *) - - external uint_code : uchar -> int = "%identity" -@@ -1810,6 +1810,8 @@ - (* *) - (**********************************************************************************) - -+let conversion_enabled = ref true -+ - let convert ~from_charset ~to_charset s = - if s <> "" then begin - let t = charset_to_string to_charset in -@@ -1817,6 +1819,17 @@ - convert_string s t f - end else s - -+let safe_convert enc s = -+ match enc with -+ "" -> s -+ | enc -> -+ try -+ convert -+ ~from_charset: (charset_from_string enc) -+ ~to_charset: (charset_from_string "UTF-8") -+ s -+ with _ -> s -+ - (**********************************************************************************) - (* *) - (* slow_encode_from_utf8 *) -@@ -1898,7 +1911,7 @@ - (**********************************************************************************) - - let to_locale s = -- if s = "" -+ if s = "" || not !conversion_enabled - then s - else begin - let s = to_utf8 s in -Index: src/utils/lib/charset.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/charset.mli,v -retrieving revision 1.3 -retrieving revision 1.5 -diff -u -r1.3 -r1.5 ---- src/utils/lib/charset.mli 1 Aug 2005 20:09:13 -0000 1.3 -+++ src/utils/lib/charset.mli 8 Oct 2006 14:12:14 -0000 1.5 -@@ -141,6 +141,7 @@ - (** [convert ~from_charset ~to_charset s] - raise CharsetError if the string s is not entirely convertible. *) - val convert : from_charset : charset -> to_charset : charset -> string -> string -+val safe_convert: string -> string -> string - - (** [is_utf8 s] - returns TRUE if s is a valid UTF-8, otherwise returns FALSE. -@@ -171,3 +172,4 @@ - - val default_language : string - val locstr : string -+val conversion_enabled : bool ref -Index: src/utils/lib/gettext.ml4 -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/gettext.ml4,v -retrieving revision 1.8 -retrieving revision 1.9 -diff -u -r1.8 -r1.9 ---- src/utils/lib/gettext.ml4 24 Jul 2006 20:12:32 -0000 1.8 -+++ src/utils/lib/gettext.ml4 19 Nov 2006 23:04:59 -0000 1.9 -@@ -20,6 +20,14 @@ - open Printf2 - open Autoconf - -+let log_prefix = "[Gettext]" -+ -+let lprintf_nl fmt = -+ lprintf_nl2 log_prefix fmt -+ -+let lprintf_n fmt = -+ lprintf2 log_prefix fmt -+ - type expected_types = - Type_int - | Type_char -@@ -291,7 +299,7 @@ - !verified.(index) <- true; - true - end else begin -- lprintf "Bad format for %s\n" translated; -+ lprintf_nl "Bad format for %s\n" translated; - save_strings_file := true; - !translation.(index) <- no_translation; - false -@@ -359,7 +367,7 @@ - - save_strings_file := false) - with e -> -- lprintf "Gettext.save_strings: Error %s\n\n" -+ lprintf_nl "save_strings: Error %s" - (Printexc2.to_string e) - open Genlex2 - -@@ -404,7 +412,7 @@ - parse_file stream - with e -> - strings_file_error := true; -- lprintf "Gettext.set_strings_file: Exception %s in %s at pos %d\n" -+ lprintf_nl "set_strings_file: Exception %s in %s at pos %d" - (Printexc2.to_string e) filename (Stream.count s)) - with e -> - save_strings_file := true); -@@ -420,7 +428,7 @@ - let strings = Hashtbl.create 111 in - - let translate1 s0 s1 = -- lprintf "translate0 %s\n" s0; -+ lprintf_nl "translate0 %s" s0; - Hashtbl.add strings s0 s1 - in - -@@ -444,18 +452,18 @@ - parse_file stream - with e -> - strings_file_error := true; -- lprintf "Gettext.set_strings_file: Exception %s in %s at pos %d\n" -+ lprintf_nl "set_strings_file: Exception %s in %s at pos %d" - (Printexc2.to_string e) f1 (Stream.count s)) - with e -> - save_strings_file := true; -- lprintf "Gettext.set_strings_file: no message file found. Creating one\n"); -+ lprintf_nl "set_strings_file: no message file found. Creating one"); - - let translate2 s0 s1 = - try -- lprintf "translate2 %s\n" s0; -+ lprintf_nl "translate2 %s" s0; - let s0 = Hashtbl.find strings s0 in - translate "Former Translation" s0 s1 -- with _ -> lprintf "No translation for %s\n" s0 -+ with _ -> lprintf_nl "No translation for %s" s0 - in - - let rec parse_file = (parser -@@ -477,11 +485,11 @@ - parse_file stream - with e -> - strings_file_error := true; -- lprintf "Gettext.set_strings_file: Exception %s in %s at pos %d\n" -+ lprintf_nl "set_strings_file: Exception %s in %s at pos %d" - (Printexc2.to_string e) f2 (Stream.count s)) - with e -> - save_strings_file := true; -- lprintf "Gettext.set_strings_file: no message file found. Creating one\n" -+ lprintf_nl "set_strings_file: no message file found. Creating one" - - - with _ -> () -Index: src/utils/lib/int64ops.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/int64ops.ml,v -retrieving revision 1.3 -retrieving revision 1.4 -diff -u -r1.3 -r1.4 ---- src/utils/lib/int64ops.ml 15 Jul 2006 11:52:54 -0000 1.3 -+++ src/utils/lib/int64ops.ml 25 Oct 2006 11:14:02 -0000 1.4 -@@ -50,3 +50,12 @@ - let round_up64 x y = - ((Int64.pred (x ++ y)) // y) ** y - -+let int64_to_human_readable size = -+ if Int64.to_float size >= 1024. && Int64.to_float size < 1048576. then -+ (Printf.sprintf "%5.1f%s" (Int64.to_float size /. 1024.) ("kb") ) -+ else if size >= Int64.of_float 1048576. && Int64.to_float size < 1073741824. then -+ (Printf.sprintf "%5.1f%s" (Int64.to_float size /. 1048576.) ("mb") ) -+ else if size >= Int64.of_float 1073741824. then -+ (Printf.sprintf "%5.1f%s" (Int64.to_float size /. 1073741824.) ("gb") ) -+ else -+ (Printf.sprintf "%8s%s" (Int64.to_string size) ("b") ) -Index: src/utils/lib/misc.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/misc.ml,v -retrieving revision 1.6 -retrieving revision 1.7 -diff -u -r1.6 -r1.7 ---- src/utils/lib/misc.ml 3 Apr 2006 20:50:09 -0000 1.6 -+++ src/utils/lib/misc.ml 25 Oct 2006 11:12:38 -0000 1.7 -@@ -49,6 +49,10 @@ - let s = string_of_int num in - int_of_string ("0b" ^ s) - -+let percentage_of_ints v percent = -+ int_of_float ( -+ (float_of_int v *. float_of_int percent /. 100.0) +. 0.5) -+ - let zip_extract_entry ifile e = - if e.Zip.is_directory then begin - try -Index: src/utils/lib/options.ml4 -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/options.ml4,v -retrieving revision 1.21 -retrieving revision 1.22 -diff -u -r1.21 -r1.22 ---- src/utils/lib/options.ml4 31 May 2006 22:26:05 -0000 1.21 -+++ src/utils/lib/options.ml4 21 Oct 2006 19:35:54 -0000 1.22 -@@ -514,6 +514,13 @@ - let int_to_value i = IntValue (Int64.of_int i) - let int64_to_value i = IntValue i - -+let percent_to_value i = IntValue (Int64.of_int i) -+let value_to_percent v = -+ match Int64.to_int (value_to_int64 v) with -+ v when v < 0 -> 0 -+ | v when v > 100 -> 100 -+ | v -> v -+ - (* The Pervasives version is too restrictive *) - let bool_of_string s = - match String.lowercase s with -@@ -729,6 +736,7 @@ - - let int_option = define_option_class "Int" value_to_int int_to_value - let int64_option = define_option_class "Int64" value_to_int64 int64_to_value -+let percent_option = define_option_class "Int" value_to_percent percent_to_value - - - let bool_option = define_option_class "Bool" value_to_bool bool_to_value -Index: src/utils/lib/options.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/lib/options.mli,v -retrieving revision 1.9 -retrieving revision 1.10 -diff -u -r1.9 -r1.10 ---- src/utils/lib/options.mli 31 May 2006 22:26:05 -0000 1.9 -+++ src/utils/lib/options.mli 21 Oct 2006 19:35:54 -0000 1.10 -@@ -90,6 +90,7 @@ - val font_option : string option_class - val int_option : int option_class - val int64_option : int64 option_class -+val percent_option : int option_class - val bool_option : bool option_class - val float_option : float option_class - val path_option : string list option_class -@@ -157,6 +158,8 @@ - val int_to_value : int -> option_value - val value_to_int64 : option_value -> int64 - val int64_to_value : int64 -> option_value -+val value_to_percent : option_value -> int -+val percent_to_value : int -> option_value - val bool_of_string : string -> bool - val value_to_bool : option_value -> bool - val bool_to_value : bool -> option_value -Index: src/utils/net/basicSocket.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/net/basicSocket.ml,v -retrieving revision 1.30 -retrieving revision 1.31 -diff -u -r1.30 -r1.31 ---- src/utils/net/basicSocket.ml 17 May 2006 08:52:44 -0000 1.30 -+++ src/utils/net/basicSocket.ml 21 Nov 2006 22:34:34 -0000 1.31 -@@ -204,15 +204,9 @@ - let minf (x: float) (y: float) = - if x > y then y else x - --let mini (x: int) (y: int) = -- if x > y then y else x -- - let maxf (x: float) (y: float) = - if x < y then y else x - --let maxi (x: int) (y: int) = -- if x < y then y else x -- - (*************************************************************************) - (* *) - (* Some functions *) -Index: src/utils/net/basicSocket.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/net/basicSocket.mli,v -retrieving revision 1.15 -retrieving revision 1.16 -diff -u -r1.15 -r1.16 ---- src/utils/net/basicSocket.mli 28 Oct 2005 08:21:49 -0000 1.15 -+++ src/utils/net/basicSocket.mli 21 Nov 2006 22:34:34 -0000 1.16 -@@ -75,9 +75,7 @@ - - val stats : Buffer.t -> t -> unit - --val mini : int -> int -> int - val minf : float -> float -> float --val maxi : int -> int -> int - val maxf : float -> float -> float - - val set_allow_write : t -> bool ref -> unit -Index: src/utils/net/http_client.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/net/http_client.ml,v -retrieving revision 1.33 -retrieving revision 1.35 -diff -u -r1.33 -r1.35 ---- src/utils/net/http_client.ml 30 May 2006 10:54:14 -0000 1.33 -+++ src/utils/net/http_client.ml 21 Nov 2006 22:34:34 -0000 1.35 -@@ -62,7 +62,7 @@ - lprintf_nl2 log_prefix fmt - - let basic_request = { -- req_url = Url.of_string "http://www.mldonkey.net/"; -+ req_url = Url.of_string "http://www.mldonkey.org/"; - req_referer = None; - req_save_to_file_time = 0.; - req_request = GET; -@@ -170,7 +170,7 @@ - let b = TcpBufferedSocket.buf sock in - let end_pos = b.pos + b.len in - let new_pos = end_pos - nread in -- let new_pos = maxi 0 (new_pos - 1) in -+ let new_pos = max 0 (new_pos - 1) in - (* - lprintf "received [%s]" (String.escaped - (String.sub b.buf new_pos nread)); -@@ -380,7 +380,7 @@ - if nread > 0 then begin - let left = - if maxlen >= 0 then -- mini (maxlen - !file_size) nread -+ min (maxlen - !file_size) nread - else nread - in - Buffer.add_string file_buf (String.sub buf.buf buf.pos left); -@@ -452,7 +452,7 @@ - if nread > 0 then begin - let left = - if maxlen >= 0 then -- mini (maxlen - !file_size) nread -+ min (maxlen - !file_size) nread - else nread - in - Buffer.add_string file_buf (String.sub buf.buf buf.pos left); -Index: src/utils/net/http_server.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/net/http_server.ml,v -retrieving revision 1.33 -retrieving revision 1.36 -diff -u -r1.33 -r1.36 ---- src/utils/net/http_server.ml 27 Jul 2006 21:45:06 -0000 1.33 -+++ src/utils/net/http_server.ml 21 Nov 2006 22:34:34 -0000 1.36 -@@ -95,6 +95,7 @@ - type error_reason = - | Blocked - | Not_allowed -+| Url_not_found of string - - type header = - Unknown of string * string -@@ -234,11 +235,13 @@ - | "403" -> "Forbidden", - (match reason with - Some Not_allowed -> Printf.sprintf --"<p>Connection from %s rejected (see downloads.ini, <a href=\"http://mldonkey.sourceforge.net/Allowed_ips\">allowed_ips</a>)</p>\n" -+"<p>Connection from %s rejected (see downloads.ini, <a href=\"http://mldonkey.sourceforge.net/Allowed_ips\">allowed_ips</a>)</p>" - from_ip - | Some Blocked -> Printf.sprintf "IP %s is blocked, its part of the used IP blocklist " from_ip -- | None -> "") -- | _ -> Printf.sprintf "Unknown %s" code, "" -+ | _ -> "") -+ | "404" -> "Not found", Printf.sprintf "The requested URL %swas not found on this server." -+ (match reason with Some (Url_not_found url) -> url ^ " " | _ -> "") -+ | _ -> Printf.sprintf "Unknown error %s" code, "" - in - let reject_message = Printf.sprintf - "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n<html> -@@ -250,7 +253,8 @@ - Printf.sprintf - "HTTP/1.1 %s %s\nMLDonkey/%s\nConnection: close - Content-Type: text/html; charset=iso-8859-1\nContent-length: %d\r\n" -- code error_text Autoconf.current_version (String.length reject_message), reject_message -+ code error_text Autoconf.current_version (String.length reject_message), reject_message, -+ Printf.sprintf "%s %s" code error_text - - let parse_head sock s = - let h = split_head s in -@@ -681,13 +685,6 @@ - at_write_end buf.fd_task shutdown - *) - --let need_auth r name = -- r.reply_head <- "401 Unauthorized"; -- r.reply_headers <- [ -- "Connection", "close"; -- "WWW-Authenticate", Printf.sprintf "Basic realm=\"%s\"" name -- ] -- - (* - let simple_give_auth psread pswrite request = - try -@@ -788,7 +785,7 @@ - let b = TcpBufferedSocket.buf sock in - let end_pos = b.pos + b.len in - let new_pos = end_pos - nread in -- let new_pos = maxi 0 (new_pos - 1) in -+ let new_pos = max 0 (new_pos - 1) in - (* lprintf "received [%s]\n" (String.escaped - (String.sub b.buf new_pos nread)); - log commented out *) - let rec iter i = -@@ -860,7 +857,7 @@ - (if ip_is_blocked from_ip then "IP is blocked" else "see allowed_ips setting"); - let token = create_token unlimited_connection_manager in - let sock = TcpBufferedSocket.create_simple token "http connection" s in -- let s1,s2 = error_page "403" -+ let s1,s2,_ = error_page "403" - (Ip.to_string from_ip) - (string_of_int from_port) - (Ip.to_string (TcpBufferedSocket.my_ip sock)) -Index: src/utils/net/http_server.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/net/http_server.mli,v -retrieving revision 1.9 -retrieving revision 1.10 -diff -u -r1.9 -r1.10 ---- src/utils/net/http_server.mli 27 Jul 2006 21:45:06 -0000 1.9 -+++ src/utils/net/http_server.mli 21 Oct 2006 19:35:09 -0000 1.10 -@@ -17,7 +17,7 @@ - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - *) - type auth = No_auth | Read_auth | Write_auth --type error_reason = Blocked | Not_allowed -+type error_reason = Blocked | Not_allowed | Url_not_found of string - and header = - Unknown of string * string - | Referer of Url.url -@@ -67,7 +67,6 @@ - } - - val create : config -> TcpServerSocket.t --val need_auth : request -> string -> unit - val html_escaped : string -> string - val html_real_escaped : string -> string - -@@ -79,4 +78,4 @@ - - val request_range : request -> int64 * (int64 option) - val parse_range : string -> int64 * int64 option * int64 option --val error_page : string -> string -> string -> string -> string -> error_reason option -> string * string -+val error_page : string -> string -> string -> string -> string -> error_reason option -> string * string * string -Index: src/utils/net/ip_set.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/net/ip_set.ml,v -retrieving revision 1.29 -retrieving revision 1.31 -diff -u -r1.29 -r1.31 ---- src/utils/net/ip_set.ml 27 Jul 2006 21:45:06 -0000 1.29 -+++ src/utils/net/ip_set.ml 20 Nov 2006 22:34:40 -0000 1.31 -@@ -259,14 +259,14 @@ - find_in_zip q in - find_in_zip filenames_list - with e -> -- lprintf_nl "Exception %s while extracting %s from %s" -+ lprintf_nl "Exception %s while extracting %s from %s" - (Printexc2.to_string e) - (String.concat "/" filenames_list) - filename; -- lprintf_nl "One of the mentioned files has to be present in the zip file"; -+ lprintf_nl "One of the mentioned files has to be present in the zip file"; - bl_empty) - with e -> -- lprintf_nl "Exception %s while opening %s" -+ lprintf_nl "Exception %s while opening %s" - (Printexc2.to_string e) - filename; - bl_empty) -@@ -281,12 +281,12 @@ - let s = Misc.archive_extract filename filetype in - load_merge bl_empty s true - with e -> -- lprintf_nl "Exception %s while extracting from %s" -+ lprintf_nl "Exception %s while extracting from %s" - (Printexc2.to_string e) filename; - bl_empty) - | ".tar.bz2" | ".p2p.tar.bz2" | ".dat.tar.bz2" - | ".tar.gz" | ".p2p.tar.gz" | ".dat.tar.gz" -> -- lprintf_nl "tar files are not (yet) supported, please untar %s" filename; -+ lprintf_nl "tar files are not (yet) supported, please untar %s" filename; - bl_empty - | _ -> load_merge bl_empty filename false - else -@@ -296,6 +296,7 @@ - end - - let of_list l = -+ bl_optimize ( - List.fold_left (fun acc r -> - let range = - match r with -@@ -314,7 +315,7 @@ - blocking_end = Ip.broadcast_address ip mask } - in - add_range acc range -- ) BL_Empty l -+ ) BL_Empty l) - - let print_list buf bl = - let rec print_list_aux bl = -Index: src/utils/net/tcpBufferedSocket.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/net/tcpBufferedSocket.ml,v -retrieving revision 1.43 -retrieving revision 1.45 -diff -u -r1.43 -r1.45 ---- src/utils/net/tcpBufferedSocket.ml 3 Apr 2006 20:50:09 -0000 1.43 -+++ src/utils/net/tcpBufferedSocket.ml 21 Nov 2006 22:34:34 -0000 1.45 -@@ -319,7 +319,7 @@ - forecast_download t 0 - - let best_packet_size nbytes = -- let nbytes = maxi nbytes !minimal_packet_size in -+ let nbytes = max nbytes !minimal_packet_size in - let nip_packets = 1 + nbytes / !mtu_packet_size in - let headers = nip_packets * !ip_packet_size in - let nframes = 1 + (nbytes + headers) / packet_frame_size in -@@ -411,7 +411,7 @@ - lprintf "[TCP_BS]: BUFFER OVERFLOW %d+%d> %d " b.len len b.max_buf_size ; - - lprintf "MESSAGE: ["; -- for i = pos1 to pos1 + (mini len 20) - 1 do -+ for i = pos1 to pos1 + (min len 20) - 1 do - lprintf "(%d)" (int_of_char s.[i]); - done; - if len > 20 then lprintf "..."; -@@ -422,7 +422,7 @@ - socket !!! *) - end - else -- let new_len = mini (maxi (2 * max_len) (b.len + len)) b.max_buf_size in -+ let new_len = min (max (2 * max_len) (b.len + len)) b.max_buf_size in - (* if t.monitored then - (lprintf "Allocate new for %d\n" len; ); *) - let new_buf = String.create new_len in -@@ -631,8 +631,8 @@ - buf_len - b.len - ) - else -- let new_len = mini -- (maxi -+ let new_len = min -+ (max - (2 * buf_len) (b.len + min_read_size)) b.max_buf_size - in - let new_buf = String.create new_len in -@@ -645,7 +645,7 @@ - in - b.buf, b.pos+b.len, can_write_in_buffer - in -- let can_read = mini max_len buffer_len in -+ let can_read = min max_len buffer_len in - if can_read > 0 then - let old_len = b.len in - let nread = try -@@ -684,8 +684,8 @@ - end else - b.len <- b.len + nread; - (* lprintf " %d\n" nread; *) -- b.min_buf_size <- mini b.max_buf_size ( -- maxi (nread + nread / 2) min_read_size); -+ b.min_buf_size <- min b.max_buf_size ( -+ max (nread + nread / 2) min_read_size); - - (* - if nread = can_read then begin -@@ -804,12 +804,9 @@ - | Some bc -> - if bc.total_bytes = 0 then - can_write_handler t sock t.wbuf.len -- else begin --(* lprintf "DELAYED\n"; *) -- if bc.remaining_bytes > 0 then begin -- bc.connections <- t :: bc.connections; -- bc.nconnections <- t.write_power + bc.nconnections -- end -+ else begin -+ bc.connections <- t :: bc.connections; -+ bc.nconnections <- t.write_power + bc.nconnections - end - end - -@@ -1680,9 +1677,9 @@ - - List.iter (fun t -> - if bc.remaining_bytes > 0 then -- let nconnections = maxi bc.nconnections 1 in -- let can_read = maxi 1 (bc.remaining_bytes / nconnections) in -- let can_read = maxi !ip_packet_size (can_read * t.read_power) in -+ let nconnections = max bc.nconnections 1 in -+ let can_read = max 1 (bc.remaining_bytes / nconnections) in -+ let can_read = max !ip_packet_size (can_read * t.read_power) in - (try - (* lprintf "allow to read %d\n" can_read; *) - can_read_handler t t.sock_in can_read -@@ -1731,14 +1728,14 @@ - end; - List.iter (fun t -> - if bc.remaining_bytes > 0 then -- let nconnections = maxi bc.nconnections 1 in -- let can_write = maxi 1 (bc.remaining_bytes / nconnections) in -+ let nconnections = max bc.nconnections 1 in -+ let can_write = max 1 (bc.remaining_bytes / nconnections) in - let can_write = best_packet_size (can_write * t.write_power) - in - let old_nwrite = t.nwrite in - (try - (* lprintf "WRITE\n"; *) -- can_write_handler t t.sock_out (mini can_write t.wbuf.len) -+ can_write_handler t t.sock_out (min can_write t.wbuf.len) - with _ -> ()); - bc.remaining_bytes <- bc.remaining_bytes - - t.nwrite + old_nwrite; -@@ -1749,7 +1746,7 @@ - t.name (sock_num t.sock_out) (remaining_to_write t) - end - ) bc.connections; --(* if bc.remaining_bytes > 0 then bc.allow_io := false; *) -+(* if bc.remaining_bytes > 0 then bc.allow_io := false; *) - end; - if !verbose_bandwidth > 2 then begin - -Index: src/utils/net/tcpBufferedSocket.mli -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/net/tcpBufferedSocket.mli,v -retrieving revision 1.15 -retrieving revision 1.16 -diff -u -r1.15 -r1.16 ---- src/utils/net/tcpBufferedSocket.mli 28 Jun 2005 22:45:57 -0000 1.15 -+++ src/utils/net/tcpBufferedSocket.mli 31 Oct 2006 15:41:55 -0000 1.16 -@@ -79,6 +79,9 @@ - val set_max_output_buffer : t -> int -> unit - val can_write : t -> bool - val can_write_len : t -> int -> bool -+val register_download : t -> int -> unit -+val register_upload : t -> int -> unit -+val register_bytes : bandwidth_controler option -> int -> unit - - val set_monitored : t -> bool -> unit - val monitored : t -> bool -Index: src/utils/net/tcpClientSocket.ml -=================================================================== -RCS file: src/utils/net/tcpClientSocket.ml -diff -N src/utils/net/tcpClientSocket.ml ---- src/utils/net/tcpClientSocket.ml 6 Dec 2005 20:26:40 -0000 1.12 -+++ /dev/null 1 Jan 1970 00:00:00 -0000 -@@ -1,789 +0,0 @@ --(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *) --(* -- This file is part of mldonkey. -- -- mldonkey is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- mldonkey is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with mldonkey; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --*) -- --open Printf2 --open BasicSocket -- --(* let _ = Unix2.init () *) -- --type event = -- WRITE_DONE --| CAN_REFILL --| BUFFER_OVERFLOW --| READ_DONE of int --| BASIC_EVENT of BasicSocket.event -- --type buf = { -- mutable buf : string; -- mutable pos : int; -- mutable len : int; -- mutable max_buf_size:int; -- } -- --type t = { -- mutable sock : BasicSocket.t; -- mutable rbuf : buf; -- mutable wfifo : string Fifo.t; -- mutable wlen : int; -- mutable wfbuf : buf; -- mutable event_handler : handler; -- mutable error : string; -- mutable nread : int; -- mutable nwrite : int; -- mutable monitored : bool; -- -- mutable read_control : bandwidth_controler option; -- mutable write_control : bandwidth_controler option; -- mutable write_power : int; -- mutable read_power : int; -- } -- --and handler = t -> event -> unit -- --and bandwidth_controler = { -- mutable remaining_bytes : int; -- mutable total_bytes : int; -- mutable nconnections : int; -- mutable connections : t list; -- allow_io : bool ref; -- mutable last_remaining : int; -- mutable moved_bytes : int64; -- } -- -- --let tcp_uploaded_bytes = ref Int64.zero --let tcp_downloaded_bytes = ref Int64.zero -- --let nread t = t.nread -- --let min_buffer_read = 500 --let min_read_size = min_buffer_read - 100 -- --let old_strings_size = 20 --let old_strings = Array.create old_strings_size "" --let old_strings_len = ref 0 -- --let new_string () = -- if !old_strings_len > 0 then begin -- decr old_strings_len; -- let s = old_strings.(!old_strings_len) in -- old_strings.(!old_strings_len) <- ""; -- s -- end else -- String.create min_buffer_read -- --let delete_string s = -- if !old_strings_len < old_strings_size && -- String.length s = min_buffer_read then begin -- old_strings.(!old_strings_len) <- s; -- incr old_strings_len; -- end -- --let close t s = --(* -- if t.monitored then begin -- lprintf "close with %s %s" t.error s; lprint_newline (); --end; --*) -- begin -- try -- delete_string t.rbuf.buf; -- t.rbuf.buf <- ""; -- t.wfbuf.buf <- ""; -- close t.sock (Printf.sprintf "%s after %d/%d" s t.nread t.nwrite) -- with e -> -- lprintf "Exception %s in TcpBufferedSocket.close\n" -- (Printexc2.to_string e); -- raise e -- end -- --let shutdown t s = -- (* -- if t.monitored then begin -- lprintf "shutdown"; lprint_newline (); --end; -- *) -- (try BasicSocket.shutdown t.sock s with e -> -- lprintf "exception %s in shutdown\n" (Printexc2.to_string e)); -- (try close t s with e -> -- lprintf "exception %s in shutdown\n" (Printexc2.to_string e)) -- --let buf_create max = -- { -- buf = ""; -- pos = 0; -- len = 0; -- max_buf_size = max; -- } -- --let error t = t.error -- -- --let set_reader t f = -- let old_handler = t.event_handler in -- let handler t ev = --(* if t.monitored then (lprintf "set_reader handler"; lprint_newline ()); *) -- match ev with -- READ_DONE nread -> --(* lprintf "READ_DONE %d" nread; lprint_newline (); *) -- f t nread -- |_ -> old_handler t ev -- in -- t.event_handler <- handler -- --let set_closer t f = -- let old_handler = t.event_handler in -- let handler t ev = --(* if t.monitored then (lprintf "set_closer handler"; lprint_newline ()); *) -- match ev with -- BASIC_EVENT (CLOSED s) -> --(* lprintf "READ_DONE %d" nread; lprint_newline (); *) -- f t s -- |_ -> old_handler t ev -- in -- t.event_handler <- handler -- -- --let buf_used t nused = -- let b = t.rbuf in -- if nused = b.len then -- ( b.len <- 0; -- b.pos <- 0; -- delete_string b.buf; -- b.buf <- ""; -- ) -- else -- (b.len <- b.len - nused; b.pos <- b.pos + nused) -- --let set_handler t event handler = -- let old_handler = t.event_handler in -- let handler t ev = --(* if t.monitored then (lprintf "set_handler handler"; lprint_newline ()); *) -- if ev = event then -- handler t -- else -- old_handler t ev -- in -- t.event_handler <- handler -- --let set_refill t f = -- set_handler t CAN_REFILL f; -- if t.wlen = 0 then (try f t with _ -> ()) -- --let buf t = t.rbuf --let sock t = t.sock -- --let closed t = closed t.sock -- --let buf_add t b s pos1 len = -- let curpos = b.pos + b.len in -- let max_len = -- if b.buf = "" then -- begin -- b.buf <- new_string (); -- min_buffer_read -- end else -- String.length b.buf in -- if max_len - curpos < len then (* resize before blit *) -- if b.len + len < max_len then (* just move to 0 *) -- begin -- String.blit b.buf b.pos b.buf 0 b.len; -- String.blit s pos1 b.buf b.len len; -- b.len <- b.len + len; -- b.pos <- 0; -- end -- else -- if b.len + len > b.max_buf_size then begin -- lprintf "BUFFER OVERFLOW %d+%d> %d\n" b.len len b.max_buf_size ; -- -- lprintf "MESSAGE ["; -- for i = pos1 to pos1 + (mini len 20) - 1 do -- lprintf "(%d)" (int_of_char s.[i]); -- done; -- if len > 20 then lprintf "..."; -- lprintf "]\n"; -- -- t.event_handler t BUFFER_OVERFLOW; -- end -- else -- let new_len = mini (maxi (2 * max_len) (b.len + len)) b.max_buf_size in --(* if t.monitored then -- (lprintf "Allocate new for %d" len; lprint_newline ()); *) -- let new_buf = String.create new_len in -- String.blit b.buf b.pos new_buf 0 b.len; -- String.blit s pos1 new_buf b.len len; -- b.len <- b.len + len; -- b.pos <- 0; -- if max_len = min_buffer_read then delete_string b.buf; --(* if t.monitored then -- (lprintf "new buffer allocated"; lprint_newline ()); *) -- b.buf <- new_buf -- else begin -- String.blit s pos1 b.buf curpos len; -- b.len <- b.len + len -- end -- --let write t s = () --let write_uniq t s = () -- -- (* --let write t s pos1 len = --(* lprintf "want_write %d" len; lprint_newline (); *) -- if len > 0 && not (closed t) then -- let pos2 = pos1 + len in -- let b = t.wbuf in -- let pos1 = -- if b.len = 0 && (match t.write_control with -- None -> --(* lprintf "NO CONTROL"; lprint_newline (); *) -- true -- | Some bc -> --(* lprintf "LIMIT %d" bc.total_bytes; lprint_newline (); *) -- bc.total_bytes = 0) -- then -- try --(* lprintf "try write %d" len; lprint_newline (); *) -- let fd = fd t.sock in -- let nw = Unix.write fd s pos1 len in --(* if t.monitored then begin -- lprintf "write: direct written %d" nw; lprint_newline (); --end; *) -- tcp_uploaded_bytes := !tcp_uploaded_bytes ++ (Int64.of_int nw); -- (match t.write_control with -- None -> () -- | Some bc -> -- bc.moved_bytes <- bc.moved_bytes ++ (Int64.of_int nw)); -- t.nwrite <- t.nwrite + nw; -- if nw = 0 then (close t "closed on write"; pos2) else -- pos1 + nw -- with -- Unix.Unix_error ((Unix.EWOULDBLOCK | Unix.EAGAIN | Unix.ENOTCONN), _, _) -> pos1 -- | e -> -- t.error <- Printf.sprintf "Write Error: %s" (Printexc2.to_string e); -- close t t.error; -- --(* lprintf "exce %s in read" (Printexc2.to_string e); lprint_newline (); *) -- raise e -- -- else pos1 -- in -- if pos2 > pos1 then -- let sock = t.sock in -- must_write sock true; -- buf_add t b s pos1 (pos2 - pos1) -- --let write_string t s = write t s 0 (String.length s) -- *) -- --let dummy_sock = Obj.magic 0 -- --let exn_exit = Exit -- --let can_read_handler t sock max_len = -- let b = t.rbuf in -- let curpos = b.pos + b.len in -- let can_read = -- if b.buf = "" then begin -- b.buf <- new_string (); -- min_buffer_read -- end -- else -- if max_len - curpos < min_read_size then -- if b.len + min_read_size > b.max_buf_size then -- ( -- t.event_handler t BUFFER_OVERFLOW; -- lprintf "[OVERFLOW] in %s" (info sock); -- close t "buffer overflow"; -- raise exn_exit; -- 0 -- ) -- else -- if b.len + min_read_size < max_len then -- ( -- String.blit b.buf b.pos b.buf 0 b.len; -- b.pos <- 0; -- max_len - b.len -- ) -- else -- let new_len = mini -- (maxi -- (2 * max_len) (b.len + min_read_size)) b.max_buf_size -- in -- let new_buf = String.create new_len in -- String.blit b.buf b.pos new_buf 0 b.len; -- b.pos <- 0; -- b.buf <- new_buf; -- new_len - b.len -- else -- max_len - curpos -- in -- let can_read = mini max_len can_read in -- if can_read > 0 then -- let nread = try --(* lprintf "try read %d" can_read; lprint_newline ();*) -- Unix.read (fd sock) b.buf (b.pos + b.len) can_read -- with -- Unix.Unix_error((Unix.EWOULDBLOCK | Unix.EAGAIN), _,_) as e -> raise e -- | e -> -- t.error <- Printf.sprintf "Can Read Error: %s" (Printexc2.to_string e); -- close t t.error; -- --(* lprintf "exce %s in read" (Printexc2.to_string e); lprint_newline (); *) -- raise e -- -- in -- tcp_downloaded_bytes := !tcp_downloaded_bytes ++ (Int64.of_int nread); -- (match t.read_control with -- None -> () | Some bc -> -- bc.moved_bytes <- bc.moved_bytes ++ (Int64.of_int nread)); -- -- t.nread <- t.nread + nread; -- if nread = 0 then begin -- close t "closed on read"; -- end else begin -- let curpos = b.pos in -- b.len <- b.len + nread; -- try --(* if t.monitored then -- (lprintf "event handler READ DONE"; lprint_newline ()); *) -- t.event_handler t (READ_DONE nread); -- with -- | e -> --(* if t.monitored then -- (lprintf "Exception in READ DONE"; lprint_newline ()); *) -- t.error <- Printf.sprintf "READ_DONE Error: %s" (Printexc2.to_string e); -- close t t.error; -- --(* lprintf "exce %s in read" (Printexc2.to_string e); lprint_newline (); *) -- raise e -- end -- --let can_write_handler t sock max_len = -- (* --(* if t.monitored then ( -- lprintf "CAN_WRITE (%d)" t.wbuf.len; lprint_newline (); -- ); *) -- let b = t.wbuf in -- if b.len > 0 then -- begin -- try --(* lprintf "try write %d/%d" max_len t.wbuf.len; lprint_newline (); *) -- let fd = fd sock in -- let nw = Unix.write fd b.buf b.pos max_len in -- --(* if t.monitored then --(lprintf "written %d" nw; lprint_newline ()); *) -- tcp_uploaded_bytes := !tcp_uploaded_bytes ++ (Int64.of_int nw); -- (match t.write_control with -- None -> () -- | Some bc -> -- bc.moved_bytes <- bc.moved_bytes ++ (Int64.of_int nw)); -- t.nwrite <- t.nwrite + nw; -- b.len <- b.len - nw; -- b.pos <- b.pos + nw; -- if nw = 0 then close t "closed on write" else -- if b.len = 0 then begin -- b.pos <- 0; -- delete_string b.buf; -- b.buf <- ""; -- end -- with -- Unix.Unix_error((Unix.EWOULDBLOCK | Unix.EAGAIN), _,_) as e -> raise e -- | e -> -- t.error <- Printf.sprintf "Can Write Error: %s" (Printexc2.to_string e); -- close t t.error; -- --(* lprintf "exce %s in read" (Printexc2.to_string e); lprint_newline (); *) -- raise e -- -- end; -- if not (closed t) then begin -- t.event_handler t CAN_REFILL; -- if b.len = 0 then begin -- delete_string b.buf; -- b.pos <- 0; -- must_write t.sock false; -- t.event_handler t WRITE_DONE -- end -- end --*) -- () -- --let remaining_to_write t = t.wlen -- --let tcp_handler t sock event = -- match event with -- | CAN_READ -> --(* lprintf "CAN_READ"; lprint_newline (); *) -- begin -- match t.read_control with -- None -> -- can_read_handler t sock (String.length t.rbuf.buf) -- | Some bc -> -- if bc.total_bytes = 0 then -- can_read_handler t sock (String.length t.rbuf.buf) -- else begin --(* lprintf "DELAYED"; lprint_newline (); *) -- if bc.remaining_bytes > 0 then -- begin -- bc.connections <- t :: bc.connections; -- bc.nconnections <- t.read_power + bc.nconnections -- end -- end -- end -- | CAN_WRITE -> --(* lprintf "CAN_WRITE"; lprint_newline (); *) -- begin -- match t.write_control with -- None -> -- can_write_handler t sock t.wlen -- | Some bc -> -- if bc.total_bytes = 0 then -- can_write_handler t sock t.wlen -- else begin --(* lprintf "DELAYED"; lprint_newline (); *) -- if bc.remaining_bytes > 0 then begin -- bc.connections <- t :: bc.connections; -- bc.nconnections <- t.write_power + bc.nconnections -- end -- end -- end -- | _ -> t.event_handler t (BASIC_EVENT event) -- --let read_bandwidth_controlers = ref [] --let write_bandwidth_controlers = ref [] -- --let _ = -- Heap.add_memstat "tcpClientSocket" (fun level buf -> -- Printf.bprintf buf " read_bandwidth_controlers: %d\n" (List.length !read_bandwidth_controlers); -- Printf.bprintf buf " write_bandwidth_controlers: %d\n" (List.length !write_bandwidth_controlers); -- ) -- --let create_read_bandwidth_controler rate = -- let bc = { -- remaining_bytes = rate; -- total_bytes = rate; -- nconnections = 0; -- connections = []; -- allow_io = ref true; -- last_remaining = 0; -- moved_bytes = Int64.zero; -- } in -- read_bandwidth_controlers := bc :: !read_bandwidth_controlers; -- bc -- --let create_write_bandwidth_controler rate = -- let bc = { -- remaining_bytes = rate; -- total_bytes = rate; -- nconnections = 0; -- connections = []; -- allow_io = ref true; -- last_remaining = 0; -- moved_bytes = Int64.zero; -- } in -- write_bandwidth_controlers := bc :: !write_bandwidth_controlers; -- bc -- --let change_rate bc rate = -- bc.total_bytes <- rate -- --let bandwidth_controler t sock = -- (match t.read_control with -- None -> () -- | Some bc -> -- must_read sock (bc.total_bytes = 0 || bc.remaining_bytes > 0)); -- (match t.write_control with -- None -> () -- | Some bc -> -- must_write sock ((bc.total_bytes = 0 || bc.remaining_bytes > 0) -- && t.wlen > 0)) -- --let set_read_controler t bc = -- t.read_control <- Some bc; --(* set_before_select t.sock (bandwidth_controler t); *) -- set_allow_read t.sock bc.allow_io; -- bandwidth_controler t t.sock -- --let set_write_controler t bc = -- t.write_control <- Some bc; --(* set_before_select t.sock (bandwidth_controler t); *) -- set_allow_write t.sock bc.allow_io; -- bandwidth_controler t t.sock -- --let max_buffer_size = ref 1000000 -- --let dump_socket t buf = -- print_socket buf t.sock; -- Printf.bprintf buf "rbuf: %d/%d wbuf: %d/%d\n" t.rbuf.len (String.length t.rbuf.buf) t.wlen (String.length t.wfbuf.buf) -- --let create name fd handler = -- if !debug then begin -- lprintf_nl "[fd %d %s]\n" (Obj.magic fd) name; -- end; -- MlUnix.set_close_on_exec fd; -- let t = { -- sock = dummy_sock; -- rbuf = buf_create !max_buffer_size; -- wfbuf = buf_create !max_buffer_size; -- event_handler = handler; -- error = ""; -- nread = 0; -- nwrite = 0; -- monitored = false; -- read_control = None; -- write_control = None; -- write_power = 1; -- read_power = 1; -- wlen = 0; -- wfifo = Fifo.create (); -- } in -- let sock = BasicSocket.create name fd (tcp_handler t) in -- let name = (fun () -> -- Printf.sprintf "%s (nread: %d nwritten: %d) [U %s,D %s]" name t.nread t.nwrite -- (string_of_bool (t.read_control <> None)) -- (string_of_bool (t.write_control <> None)); -- ; -- ) in -- set_printer sock name; -- set_dump_info sock (dump_socket t); -- t.sock <- sock; -- t -- --let create_blocking name fd handler = -- MlUnix.set_close_on_exec fd; -- let t = { -- sock = dummy_sock; -- rbuf = buf_create !max_buffer_size; -- wfbuf = buf_create !max_buffer_size; -- event_handler = handler; -- error = ""; -- nread = 0; -- nwrite = 0; -- monitored = false; -- read_control = None; -- write_control = None; -- write_power = 1; -- read_power = 1; -- wlen = 0; -- wfifo = Fifo.create (); -- } in -- let sock = create_blocking name fd (tcp_handler t) in -- t.sock <- sock; -- set_dump_info sock (dump_socket t); -- t -- --let create_simple name fd = -- create name fd (fun _ _ -> ()) -- --let connect name host port handler = -- try --(* lprintf "CONNECT tcpClientSocket\n"; *) -- let s = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in -- let t = create name s handler in -- must_write (sock t) true; -- try -- Unix.connect s (Unix.ADDR_INET(host,port)); -- t -- with -- Unix.Unix_error((Unix.EINPROGRESS|Unix.EINTR),_,_) -> t -- | Unix.Unix_error (Unix.ENETUNREACH,_,_) as e -> -- close t "connect failed"; -- raise e -- | e -> -- lprintf "For host %s port %d\n" -- (Unix.string_of_inet_addr host) port; -- close t "connect failed"; -- raise e -- with e -> -- lprintf "+++ Exception BEFORE CONNECT %s\n" (Printexc2.to_string e); -- raise e -- -- -- --let set_max_write_buffer t len = -- t.wfbuf.max_buf_size <- len; -- t.rbuf.max_buf_size <- len -- --let can_write t = -- t.wlen = 0 -- --let can_write_len t len = --(* lprintf "CAN WRITE %d > %d + %d" t.wbuf.max_buf_size t.wbuf.len len; lprint_newline (); *) -- t.wfbuf.max_buf_size > t.wlen + len -- --let close_after_write t = -- if t.wlen = 0 then begin -- shutdown t "close after write" -- end -- else -- set_handler t WRITE_DONE (fun t -> -- shutdown t "close after write") -- --let set_monitored t = -- t.monitored <- true -- -- --let _ = -- add_infinite_timer 1.0 (fun timer -> -- List.iter (fun bc -> -- bc.last_remaining <- bc.remaining_bytes; -- bc.remaining_bytes <- bc.total_bytes; -- if bc.remaining_bytes > 0 then bc.allow_io := true --(* lprintf "READ remaining_bytes: %d" bc.remaining_bytes; *) -- ) !read_bandwidth_controlers; -- List.iter (fun bc -> -- bc.last_remaining <- bc.remaining_bytes; -- bc.remaining_bytes <- bc.total_bytes; -- if bc.remaining_bytes > 0 then bc.allow_io := true; -- (* -- lprintf "WRITE remaining_bytes: %d" bc.remaining_bytes; -- lprint_newline (); *) -- ) !write_bandwidth_controlers -- ); -- -- set_before_select_hook (fun _ -> -- List.iter (fun bc -> -- bc.allow_io := (bc.total_bytes = 0 || bc.remaining_bytes > 0); -- ) !read_bandwidth_controlers; -- List.iter (fun bc -> -- bc.allow_io := (bc.total_bytes = 0 || bc.remaining_bytes > 0); -- ) !write_bandwidth_controlers; -- ); -- -- set_after_select_hook (fun _ -> -- List.iter (fun bc -> -- List.iter (fun t -> -- if bc.remaining_bytes > 0 then -- let can_read = maxi 1 (bc.remaining_bytes / bc.nconnections) in -- let can_read = can_read * t.read_power in -- let old_nread = t.nread in -- (try -- can_read_handler t t.sock (mini can_read -- (String.length t.rbuf.buf)) -- with _ -> ()); -- bc.remaining_bytes <- bc.remaining_bytes - -- t.nread + old_nread; -- bc.nconnections <- bc.nconnections - t.read_power; -- ) bc.connections; -- if bc.remaining_bytes > 0 then bc.allow_io := false; -- bc.connections <- []; -- bc.nconnections <- 0; -- ) !read_bandwidth_controlers; -- List.iter (fun bc -> -- List.iter (fun t -> -- if bc.remaining_bytes > 0 then -- let can_write = maxi 1 (bc.remaining_bytes / bc.nconnections) in -- let can_write = can_write * t.write_power in -- let old_nwrite = t.nwrite in -- (try --(* lprintf "WRITE"; lprint_newline (); *) -- can_write_handler t t.sock (mini can_write t.wlen) -- with _ -> ()); -- bc.remaining_bytes <- bc.remaining_bytes - -- t.nwrite + old_nwrite; -- bc.nconnections <- bc.nconnections - t.write_power; -- ) bc.connections; -- if bc.remaining_bytes > 0 then bc.allow_io := false; -- bc.connections <- []; -- bc.nconnections <- 0; -- ) !write_bandwidth_controlers -- ) -- -- --let my_ip t = -- let fd = fd t.sock in -- match Unix.getsockname fd with -- Unix.ADDR_INET (ip, port) -> Ip.of_inet_addr ip -- | _ -> raise Not_found -- --let stats buf t = -- BasicSocket.stats buf t.sock; -- Printf.bprintf buf " rbuf size: %d/%d\n" (String.length t.rbuf.buf) -- t.rbuf.max_buf_size; -- Printf.bprintf buf " wbuf size: %d/%d\n" (t.wlen) -- t.wfbuf.max_buf_size -- --let buf_size t = -- (String.length t.rbuf.buf), -- (String.length t.wfbuf.buf) -- --let can_fill t = -- t.wlen < (t.wfbuf.max_buf_size / 2) -- --let if_possible bc len = -- bc.total_bytes = 0 || -- if bc.last_remaining >= len then begin -- bc.last_remaining <- bc.last_remaining - len; -- true; -- end else false -- --let set_rtimeout s t = set_rtimeout (sock s) t --let set_wtimeout s t = set_wtimeout (sock s) t -- --open LittleEndian -- --let internal_buf = Buffer.create 17000 -- --let simple_send_buf buf sock = () -- (* -- let s = Buffer.contents buf in -- Buffer.reset buf; -- buf_int8 buf 228; -- let len = String.length s in -- buf_int buf len; -- write sock (Buffer.contents buf) 0 5; -- write sock s 0 len --*) -- --let value_send sock m = () -- (* -- Buffer.reset internal_buf; -- Buffer.add_string internal_buf (Marshal.to_string m []); -- simple_send_buf internal_buf sock --*) -- --let value_handler f sock nread = () -- (* -- let b = buf sock in -- try -- while b.len >= 5 do -- let msg_len = get_int b.buf (b.pos+1) in -- if b.len >= 5 + msg_len then -- begin -- let s = String.sub b.buf (b.pos+5) msg_len in -- let t = Marshal.from_string s 0 in -- buf_used sock (msg_len + 5); -- f t sock; -- () -- end -- else raise Not_found -- done -- with Not_found -> () -- *) -- -- -- --let set_write_power t p = t.write_power <- p --let set_read_power t p = t.read_power <- p -- --let set_lifetime s = set_lifetime (sock s) -- --let moved_bytes bc = bc.moved_bytes -- -Index: src/utils/net/tcpClientSocket.mli -=================================================================== -RCS file: src/utils/net/tcpClientSocket.mli -diff -N src/utils/net/tcpClientSocket.mli ---- src/utils/net/tcpClientSocket.mli 22 Apr 2003 22:33:40 -0000 1.1 -+++ /dev/null 1 Jan 1970 00:00:00 -0000 -@@ -1,108 +0,0 @@ --(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *) --(* -- This file is part of mldonkey. -- -- mldonkey is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- mldonkey is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with mldonkey; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --*) --type event = -- WRITE_DONE -- | CAN_REFILL -- | BUFFER_OVERFLOW -- | READ_DONE of int -- | BASIC_EVENT of BasicSocket.event -- --and buf = { -- mutable buf : string; -- mutable pos : int; -- mutable len : int; -- mutable max_buf_size : int; -- } -- --type t -- --type bandwidth_controler = { -- mutable remaining_bytes : int; -- mutable total_bytes : int; -- mutable nconnections : int; -- mutable connections : t list; -- allow_io : bool ref; -- mutable last_remaining : int; -- mutable moved_bytes : int64; -- } -- -- --and handler = t -> event -> unit -- --val max_buffer_size : int ref -- --val sock: t -> BasicSocket.t --val create : string -> Unix.file_descr -> handler -> t --val create_simple : string -> Unix.file_descr -> t --val create_blocking : string -> Unix.file_descr -> handler -> t --val buf : t -> buf --val set_reader : t -> (t -> int -> unit) -> unit --val buf_used : t -> int -> unit --val set_handler : t -> event -> (t -> unit) -> unit --val set_refill : t -> (t -> unit) -> unit --val write: t -> string -> unit --val write_uniq: t -> string -> unit --val connect: string -> Unix.inet_addr -> int -> handler -> t --val close : t -> string -> unit --val closed : t -> bool --val shutdown : t -> string -> unit --val error: t -> string --val tcp_handler: t -> BasicSocket.t -> BasicSocket.event -> unit --val set_closer : t -> (t -> string -> unit) -> unit --val nread : t -> int --val set_max_write_buffer : t -> int -> unit --val can_write : t -> bool --val can_write_len : t -> int -> bool --val set_monitored : t -> unit -- --val close_after_write : t -> unit -- --val create_read_bandwidth_controler : int -> bandwidth_controler --val create_write_bandwidth_controler : int -> bandwidth_controler --val set_read_controler : t -> bandwidth_controler -> unit --val set_write_controler : t -> bandwidth_controler -> unit --val change_rate : bandwidth_controler -> int -> unit -- -- --val my_ip : t -> Ip.t -- --val stats : Buffer.t -> t -> unit --val buf_size : t -> int * int --val can_fill : t -> bool -- --val if_possible : bandwidth_controler -> int -> bool -- --val set_rtimeout : t -> float -> unit --val set_wtimeout : t -> float -> unit -- --val internal_buf : Buffer.t --val value_send : t -> 'a -> unit --val value_handler : ('a -> t -> unit) -> t -> int -> unit -- --val set_write_power : t -> int -> unit --val set_read_power : t -> int -> unit -- --val remaining_to_write : t -> int -- --val set_lifetime : t -> float -> unit -- --val tcp_uploaded_bytes : int64 ref --val tcp_downloaded_bytes : int64 ref --val moved_bytes : bandwidth_controler -> int64 -- -Index: src/utils/net/tcpSocket.mli -=================================================================== -RCS file: src/utils/net/tcpSocket.mli -diff -N src/utils/net/tcpSocket.mli ---- src/utils/net/tcpSocket.mli 22 Apr 2003 22:33:40 -0000 1.1 -+++ /dev/null 1 Jan 1970 00:00:00 -0000 -@@ -1,44 +0,0 @@ --(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *) --(* -- This file is part of mldonkey. -- -- mldonkey is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- mldonkey is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with mldonkey; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --*) --type event = -- WRITE_DONE -- | CAN_REFILL -- | BUFFER_OVERFLOW -- | READ_DONE of int -- | BASIC_EVENT of BasicSocket.event -- --and buf = { -- mutable buf : string; -- mutable pos : int; -- mutable len : int; -- mutable max_buf_size : int; -- } -- --type t -- --and handler = t -> event -> unit -- --val sock: t -> BasicSocket.t --val create : Unix.file_descr -> handler -> t --val buf : t -> buf --val set_reader : t -> (t -> int -> unit) -> unit --val buf_used : t -> int -> unit --val set_handler : t -> event -> (t -> unit) -> unit --val set_refill : t -> (t -> unit) -> unit --val write: t -> string -> int -> int -> unit -\ No newline at end of file -Index: src/utils/net/udpSocket.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/src/utils/net/udpSocket.ml,v -retrieving revision 1.20 -retrieving revision 1.22 -diff -u -r1.20 -r1.22 ---- src/utils/net/udpSocket.ml 14 Dec 2005 21:17:47 -0000 1.20 -+++ src/utils/net/udpSocket.ml 21 Nov 2006 22:34:34 -0000 1.22 -@@ -23,6 +23,14 @@ - open AnyEndian - open LittleEndian - -+let log_prefix = "[udpSock]" -+ -+let lprintf_nl fmt = -+ lprintf_nl2 log_prefix fmt -+ -+let lprintf_n fmt = -+ lprintf2 log_prefix fmt -+ - type event = - WRITE_DONE - | CAN_REFILL -@@ -131,6 +139,7 @@ - mutable allow_io : bool ref; - mutable count : int; - mutable base_time : int; -+ mutable tcp_bc : TcpBufferedSocket.bandwidth_controler; - } - - and handler = t -> event -> unit -@@ -190,10 +199,10 @@ - lprintf_nl "ADDR_UNIX (%s)" s; - end - --let max_delayed_send = 30 -+let max_delayed_send = 1 - - let write t ping s ip port = --(* lprintf "UDP write to %s:%d\n" (Ip.to_string ip) port; *) -+(* lprintf_nl "UDP write to %s:%d" (Ip.to_string ip) port; *) - if not (closed t) && t.wlist_size < !max_wlist_size then - let s, addr = match t.socks_local with - None -> s, Unix.ADDR_INET(Ip.to_inet_addr ip, port) -@@ -219,16 +228,19 @@ - let _ = - try - if ping then declare_ping ip; -- ignore(Unix.sendto (fd sock) s 0 len [] addr) -+ ignore(Unix.sendto (fd sock) s 0 len [] addr); -+ if !verbose_bandwidth > 1 then begin -+ lprintf_nl "[BW2] direct send udp %d bytes (write)" len; -+ end; - with e -> -- lprintf "Exception in sendto %s:%d\n" (Ip.to_string ip) port; -+ lprintf_nl "Exception in sendto %s:%d" (Ip.to_string ip) port; - raise e - in - udp_uploaded_bytes := !udp_uploaded_bytes ++ (Int64.of_int len); - () - (* --lprintf "UDP sent [%s]" (String.escaped --(String.sub s pos len)); lprint_newline (); -+lprintf_nl "UDP sent [%s]" (String.escaped -+(String.sub s pos len)); - *) - with - Unix.Unix_error ((Unix.EWOULDBLOCK | Unix.ENOBUFS), _, _) -> -@@ -240,7 +252,7 @@ - t.wlist_size <- t.wlist_size + String.length s; - must_write sock true; - | e -> -- lprintf "Exception %s in sendto\n" -+ lprintf_nl "Exception %s in sendto" - (Printexc2.to_string e); - print_addr addr; - raise e -@@ -265,6 +277,10 @@ - t.wlist_size <- t.wlist_size + String.length s; - must_write t.sock true; - end -+ else -+ if !debug then begin -+ lprintf_nl "UDP DROPPED in write"; -+ end - - let dummy_sock = Obj.magic 0 - -@@ -278,11 +294,16 @@ - begin try - ignore (local_sendto (fd sock) p); - udp_uploaded_bytes := !udp_uploaded_bytes ++ (Int64.of_int len); -+ if !verbose_bandwidth > 1 then begin -+ lprintf_nl "[BW2] direct send udp %d bytes (iter_write_no_bc)" len; -+ end - with -- Unix.Unix_error ((Unix.EWOULDBLOCK | Unix.ENOBUFS), _, _) as e -> raise e -+ Unix.Unix_error ((Unix.EWOULDBLOCK | Unix.ENOBUFS), _, _) as e -> -+ lprintf_nl "Exception %s in sendto next" (Printexc2.to_string e); -+ raise e - | e -> - if !debug then -- lprintf "Exception %s in sendto next\n" -+ lprintf_nl "Exception %s in sendto next" - (Printexc2.to_string e) - end; - iter_write_no_bc t sock -@@ -302,23 +323,27 @@ - t.wlist_size <- t.wlist_size - String.length p.udp_content; - if time < bc.base_time then begin - if !debug then begin -- lprintf "[UDP DROPPED]"; -+ lprintf_nl "UDP DROPPED in iter_write"; - end; - iter_write t sock bc - end else - let len = String.length p.udp_content in - begin try -- -- - ignore (local_sendto (fd sock) p); - udp_uploaded_bytes := !udp_uploaded_bytes ++ (Int64.of_int len); - bc.remaining_bytes <- bc.remaining_bytes - (len + - !TcpBufferedSocket.ip_packet_size) ; -+ TcpBufferedSocket.register_bytes (Some bc.tcp_bc) len; -+ if !verbose_bandwidth > 1 then begin -+ lprintf_nl "[BW2] bc send udp %d bytes" len; -+ end; - with -- Unix.Unix_error ((Unix.EWOULDBLOCK | Unix.ENOBUFS), _, _) as e -> raise e -+ Unix.Unix_error ((Unix.EWOULDBLOCK | Unix.ENOBUFS), _, _) as e -> -+ lprintf_nl "Exception %s in sendto next" (Printexc2.to_string e); -+ raise e - | e -> - if !debug then -- lprintf "Exception %s in sendto next\n" -+ lprintf_nl "Exception %s in sendto next" - (Printexc2.to_string e) - end; - iter_write t sock bc -@@ -418,26 +443,28 @@ - allow_io = ref false; - count = 0; - base_time = 0; -+ tcp_bc = tcp_bc; - } in - let udp_user total n = --(* -- if !BasicSocket.debug then begin -- lprintf "udp_user %d/%d" n total; lprint_newline (); -- end; *) -- let n = if total = 0 then 100000 else n in -+ if !verbose_bandwidth > 0 then -+ lprintf_nl "udp_user %d/%d" n total; -+(* let n = if total = 0 then 100000 else n in *) - udp_bc.base_time <- udp_bc.base_time + 1; - if udp_bc.count = 0 then begin - udp_bc.count <- 10; - TcpBufferedSocket.set_lost_bytes tcp_bc udp_bc.remaining_bytes - udp_bc.base_time; -- udp_bc.remaining_bytes <- 0; - end; - udp_bc.count <- udp_bc.count - 1; - udp_bc.total_bytes <- total; -- udp_bc.remaining_bytes <- udp_bc.remaining_bytes + n; -+ udp_bc.remaining_bytes <- total / 2; -+(* udp_bc.remaining_bytes <- udp_bc.remaining_bytes + n; *) - if total <> 0 && udp_bc.remaining_bytes > total then - udp_bc.remaining_bytes <- total; - udp_bc.allow_io := udp_bc.remaining_bytes > 0; -+ if !verbose_bandwidth > 0 then -+ lprintf_nl "udp_bc count:%d total_bytes:%d remaining_bytes:%d" -+ udp_bc.count udp_bc.total_bytes udp_bc.remaining_bytes; - in - TcpBufferedSocket.set_remaining_bytes_user tcp_bc udp_user; - udp_bc -@@ -510,8 +537,8 @@ - - MlUnix.set_nonblock fd; - with e -> -- lprintf "[SOCKS] proxy error prevent creation of UDP socket: %s" -- (Printexc2.to_string e); lprint_newline (); -+ lprintf_nl "[SOCKS] proxy error prevent creation of UDP socket: %s" -+ (Printexc2.to_string e); - close t "socks proxy error"; raise e - *) - -@@ -524,7 +551,7 @@ - ) latencies; - LittleEndian.buf_int b !counter; - Hashtbl.iter (fun ip (latency, samples) -> -- if !verbose then lprintf " Latency UDP: %s -> %d (%d samples)\n" (Ip.to_string ip) !latency !samples; -+ if !verbose then lprintf_nl " Latency UDP: %s -> %d (%d samples)" (Ip.to_string ip) !latency !samples; - LittleEndian.buf_ip b ip; - LittleEndian.buf_int16 b !latency; - LittleEndian.buf_int16 b !samples; -Index: tools/make_torrent.ml -=================================================================== -RCS file: /sources/mldonkey/mldonkey/tools/make_torrent.ml,v -retrieving revision 1.8 -retrieving revision 1.9 -diff -u -r1.8 -r1.9 ---- tools/make_torrent.ml 9 Jan 2006 00:25:59 -0000 1.8 -+++ tools/make_torrent.ml 25 Oct 2006 11:34:46 -0000 1.9 -@@ -203,7 +203,7 @@ - "Quick Howto:\n" ^ - "- create a new torrent:\n" ^ - "make_torrent -tracker http://ip:port/announce -torrent file.torrent " ^ -- "-comment \"www.mldonkey.net\" -create file\n\n" ^ -+ "-comment \"www.mldonkey.org\" -create file\n\n" ^ - "- change the tracker of a torrent file:\n" ^ - "make_torrent -tracker http://ip:port/tracker -torrent myfile.torrent -change\n\n" ^ - "- print the infos of a torrent file:\n" ^ diff --git a/net-p2p/mldonkey-devel/files/patch-cvs-2006122500 b/net-p2p/mldonkey-devel/files/patch-cvs-2006122500 new file mode 100644 index 000000000000..6a80f449e25e --- /dev/null +++ b/net-p2p/mldonkey-devel/files/patch-cvs-2006122500 @@ -0,0 +1,7533 @@ +Index: config/Makefile.in +=================================================================== +RCS file: /sources/mldonkey/mldonkey/config/Makefile.in,v +retrieving revision 1.173 +retrieving revision 1.174 +diff -u -r1.173 -r1.174 +--- config/Makefile.in 21 Nov 2006 22:29:58 -0000 1.173 ++++ config/Makefile.in 28 Nov 2006 23:58:01 -0000 1.174 +@@ -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) +Index: distrib/ChangeLog +=================================================================== +RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v +retrieving revision 1.1118 +retrieving revision 1.1133 +diff -u -r1.1118 -r1.1133 +--- distrib/ChangeLog 28 Nov 2006 23:17:31 -0000 1.1118 ++++ distrib/ChangeLog 8 Dec 2006 12:26:24 -0000 1.1133 +@@ -14,6 +14,45 @@ + ChangeLog + ========= + ++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: src/daemon/common/commonClient.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonClient.ml,v +retrieving revision 1.33 +retrieving revision 1.34 +diff -u -r1.33 -r1.34 +--- src/daemon/common/commonClient.ml 5 Nov 2006 14:09:38 -0000 1.33 ++++ src/daemon/common/commonClient.ml 2 Dec 2006 12:35:45 -0000 1.34 +@@ -467,16 +467,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 +@@ -500,8 +499,10 @@ + 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; + } +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.78 +diff -u -r1.77 -r1.78 +--- src/daemon/common/commonGlobals.ml 28 Nov 2006 23:15:21 -0000 1.77 ++++ src/daemon/common/commonGlobals.ml 3 Dec 2006 20:49:42 -0000 1.78 +@@ -405,6 +405,7 @@ + | Field_Lastseencomplete -> "lastcompl" + | Field_Medialength -> "mlen" + | Field_Mediacodec -> "mediacodec" ++ | Field_KNOWN s -> s + | Field_UNKNOWN s -> s + + let field_of_string t = +@@ -426,10 +427,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 +440,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 + [] -> () +Index: src/daemon/common/commonInteractive.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonInteractive.ml,v +retrieving revision 1.85 +retrieving revision 1.87 +diff -u -r1.85 -r1.87 +--- src/daemon/common/commonInteractive.ml 26 Nov 2006 13:54:09 -0000 1.85 ++++ src/daemon/common/commonInteractive.ml 3 Dec 2006 20:49:42 -0000 1.87 +@@ -222,7 +222,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 *) +@@ -714,7 +714,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 +@@ -874,14 +874,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/commonOptions.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonOptions.ml,v +retrieving revision 1.190 +retrieving revision 1.193 +diff -u -r1.190 -r1.193 +--- src/daemon/common/commonOptions.ml 28 Nov 2006 23:15:21 -0000 1.190 ++++ src/daemon/common/commonOptions.ml 8 Dec 2006 12:26:24 -0000 1.193 +@@ -1267,8 +1267,16 @@ + "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"] ++ "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"] +@@ -1497,9 +1505,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"] +@@ -1558,7 +1569,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 +@@ -1708,6 +1719,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 +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.38 +diff -u -r1.37 -r1.38 +--- src/daemon/common/commonShared.ml 29 Oct 2006 18:58:59 -0000 1.37 ++++ src/daemon/common/commonShared.ml 3 Dec 2006 20:57:56 -0000 1.38 +@@ -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 = [] + } + +@@ -354,7 +365,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.11 +diff -u -r1.10 -r1.11 +--- src/daemon/common/commonSources.mli 8 Apr 2006 02:16:21 -0000 1.10 ++++ src/daemon/common/commonSources.mli 3 Dec 2006 20:47:12 -0000 1.11 +@@ -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/commonTypes.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonTypes.ml,v +retrieving revision 1.64 +retrieving revision 1.65 +diff -u -r1.64 -r1.65 +--- src/daemon/common/commonTypes.ml 26 Nov 2006 16:36:29 -0000 1.64 ++++ src/daemon/common/commonTypes.ml 3 Dec 2006 20:49:42 -0000 1.65 +@@ -265,6 +265,7 @@ + | 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/guiDecoding.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/daemon/common/guiDecoding.ml,v +retrieving revision 1.66 +retrieving revision 1.67 +diff -u -r1.66 -r1.67 +--- src/daemon/common/guiDecoding.ml 26 Nov 2006 13:54:09 -0000 1.66 ++++ src/daemon/common/guiDecoding.ml 2 Dec 2006 12:35:45 -0000 1.67 +@@ -816,8 +816,10 @@ + 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 = ""; *) +@@ -875,8 +877,10 @@ + 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; *) +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.35 +diff -u -r1.34 -r1.35 +--- src/daemon/common/guiTypes.ml 14 Nov 2006 18:42:59 -0000 1.34 ++++ src/daemon/common/guiTypes.ml 2 Dec 2006 12:35:45 -0000 1.35 +@@ -219,8 +219,10 @@ + 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; *) +Index: src/daemon/driver/driverCommands.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverCommands.ml,v +retrieving revision 1.202 +retrieving revision 1.209 +diff -u -r1.202 -r1.209 +--- src/daemon/driver/driverCommands.ml 28 Nov 2006 23:15:21 -0000 1.202 ++++ src/daemon/driver/driverCommands.ml 8 Dec 2006 12:26:24 -0000 1.209 +@@ -343,7 +343,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)"; + +@@ -390,7 +390,12 @@ + ( "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 []) ++ @ [ ++ ( "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 + let all_clients_list = clients_get_all () in +@@ -409,7 +414,12 @@ + (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 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; +@@ -423,7 +433,7 @@ + client_print c o; + ) 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 ()); +@@ -848,7 +858,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 +906,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 +@@ -1362,7 +1372,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; + "" +@@ -1767,6 +1777,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 +1788,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; +@@ -2415,8 +2427,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" ) ]); + +@@ -2432,7 +2446,7 @@ + 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) /. ++ ( 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 +2469,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 +2510,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 -> +@@ -2527,8 +2545,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 +2567,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 +2678,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 +2699,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 +2747,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 +2761,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 +@@ -3080,7 +3102,7 @@ + else + print_command_result o buf "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 +@@ -3345,22 +3367,22 @@ + end + end else print_command_result o buf "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; + _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); + _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); + _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 +3390,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 o.conn_buf (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) + end + else + begin +@@ -3401,7 +3428,19 @@ + 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 o.conn_buf (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 o.conn_buf (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 o.conn_buf (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) +Index: src/daemon/driver/driverInteractive.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverInteractive.ml,v +retrieving revision 1.118 +retrieving revision 1.122 +diff -u -r1.118 -r1.122 +--- src/daemon/driver/driverInteractive.ml 28 Nov 2006 23:17:31 -0000 1.118 ++++ src/daemon/driver/driverInteractive.ml 3 Dec 2006 20:57:56 -0000 1.122 +@@ -1115,7 +1115,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 +1125,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 +@@ -1259,7 +1268,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 +1284,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 +1340,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 +1392,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 +1499,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 +1713,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; +@@ -2448,7 +2457,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 +2467,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 +2485,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 +2509,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 +2526,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/driverMain.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverMain.ml,v +retrieving revision 1.133 +retrieving revision 1.134 +diff -u -r1.133 -r1.134 +--- src/daemon/driver/driverMain.ml 28 Nov 2006 23:15:21 -0000 1.133 ++++ src/daemon/driver/driverMain.ml 8 Dec 2006 12:26:25 -0000 1.134 +@@ -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 (); +@@ -446,6 +445,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/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.21 +diff -u -r1.20 -r1.21 +--- src/gtk/newgui/gui_friends.ml 28 Nov 2006 12:58:11 -0000 1.20 ++++ src/gtk/newgui/gui_friends.ml 2 Dec 2006 12:35:46 -0000 1.21 +@@ -435,8 +435,10 @@ + 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_sock_addr = c.gclient_sock_addr;*) +@@ -457,8 +459,8 @@ + 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 +496,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 +@@ -643,8 +645,10 @@ + 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_sock_addr = string_of_kind c.gclient_kind; *) +@@ -665,8 +669,8 @@ + 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 +715,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/guiMisc.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/gtk2/gui/guiMisc.ml,v +retrieving revision 1.20 +retrieving revision 1.22 +diff -u -r1.20 -r1.22 +--- src/gtk2/gui/guiMisc.ml 28 Nov 2006 12:58:11 -0000 1.20 ++++ src/gtk2/gui/guiMisc.ml 3 Dec 2006 20:49:42 -0000 1.22 +@@ -1055,7 +1055,7 @@ + | Field_Mediacodec -> "codec" + | Field_Lastseencomplete -> "lastseencompl" + | Field_Filerating -> "rating" +- | Field_UNKNOWN s -> U.simple_utf8_of s ++ | Field_KNOWN s -> U.simple_utf8_of s + + let tags_to_string tags = + let s = ref "" in +@@ -1276,8 +1276,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.125 +diff -u -r1.123 -r1.125 +--- src/networks/bittorrent/bTInteractive.ml 12 Nov 2006 14:17:45 -0000 1.123 ++++ src/networks/bittorrent/bTInteractive.ml 3 Dec 2006 20:57:56 -0000 1.125 +@@ -406,8 +406,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 +460,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 +884,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 +912,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 +954,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 + +@@ -1263,6 +1271,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/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/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/donkey/donkeyClient.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyClient.ml,v +retrieving revision 1.110 +retrieving revision 1.114 +diff -u -r1.110 -r1.114 +--- src/networks/donkey/donkeyClient.ml 26 Nov 2006 16:36:29 -0000 1.110 ++++ src/networks/donkey/donkeyClient.ml 3 Dec 2006 20:49:42 -0000 1.114 +@@ -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)) +@@ -245,18 +248,22 @@ + 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 "") ++ let log_print cc = 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)" ++ (size_of_int64 c.client_session_downloaded) ++ (size_of_int64 c.client_total_downloaded) else "") + in + if c.client_debug || +- (!verbose && (c.client_uploaded > 0L || c.client_downloaded > 0L)) then ++ (!verbose && (c.client_session_uploaded > 0L || c.client_session_downloaded > 0L)) then + log_print c; + + c.client_comp <- None; +@@ -599,7 +606,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 +@@ -661,33 +668,40 @@ + 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" -> + 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" -> + 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 +711,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 +787,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 +@@ -1160,7 +1176,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; +@@ -2018,13 +2034,13 @@ + begin + + if !!dynamic_upload_lifetime +- && c.client_uploaded > c.client_downloaded +- && c.client_uploaded > Int64.of_int !!dynamic_upload_threshold ** zone_size ++ && 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); ++ ** c.client_session_downloaded // c.client_session_uploaded); + if last_time() > c.client_connect_time + + !client_upload_lifetime + 5 * prio then + begin +@@ -2193,7 +2209,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/donkeyGlobals.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyGlobals.ml,v +retrieving revision 1.110 +retrieving revision 1.112 +diff -u -r1.110 -r1.112 +--- src/networks/donkey/donkeyGlobals.ml 26 Nov 2006 16:36:29 -0000 1.110 ++++ src/networks/donkey/donkeyGlobals.ml 4 Dec 2006 12:00:19 -0000 1.112 +@@ -595,8 +595,10 @@ + 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; +@@ -650,8 +652,10 @@ + 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; +@@ -1018,6 +1022,6 @@ + let full_client_identifier c = + Printf.sprintf "%s (%s%s) '%s'" + (Ip.to_string c.client_ip) +- (brand_to_string_short c.client_brand) ++ (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.145 +diff -u -r1.140 -r1.145 +--- src/networks/donkey/donkeyInteractive.ml 26 Nov 2006 17:27:40 -0000 1.140 ++++ src/networks/donkey/donkeyInteractive.ml 6 Dec 2006 22:33:05 -0000 1.145 +@@ -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; + +@@ -447,16 +448,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"; +@@ -797,7 +798,7 @@ + ) !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 -> + let preferred = bool_of_string arg1 in +@@ -809,7 +810,7 @@ + end + ) servers_by_key; + "ok" +- ), "<true/false> <ip> :\t\tset the server with this IP as preferred"; ++ ), "<true|false> <ip> :\t\tset the server with this IP as preferred"; + + "bs", Arg_multiple (fun args o -> + List.iter (fun arg -> +@@ -817,7 +818,7 @@ + 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)"; ++ ), "<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 -> + donkey_port =:= int_of_string arg; +@@ -1195,9 +1196,10 @@ + 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) +@@ -1396,8 +1398,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 +1480,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))); +@@ -1698,10 +1704,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 +1760,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 +1782,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.64 +diff -u -r1.63 -r1.64 +--- src/networks/donkey/donkeyMain.ml 26 Nov 2006 16:36:29 -0000 1.63 ++++ src/networks/donkey/donkeyMain.ml 3 Dec 2006 20:49:42 -0000 1.64 +@@ -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 *) +@@ -161,42 +161,42 @@ + + 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 () = +Index: src/networks/donkey/donkeyMftp.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyMftp.ml,v +retrieving revision 1.13 +retrieving revision 1.15 +diff -u -r1.13 -r1.15 +--- src/networks/donkey/donkeyMftp.ml 9 Feb 2006 11:45:12 -0000 1.13 ++++ src/networks/donkey/donkeyMftp.ml 4 Dec 2006 12:00:19 -0000 1.15 +@@ -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 + +@@ -223,3 +225,75 @@ + "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"; ++ "\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?"; ++ ++ "\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/donkeyPandora.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyPandora.ml,v +retrieving revision 1.7 +retrieving revision 1.8 +diff -u -r1.7 -r1.8 +--- src/networks/donkey/donkeyPandora.ml 3 Apr 2006 20:50:09 -0000 1.7 ++++ src/networks/donkey/donkeyPandora.ml 3 Dec 2006 20:49:42 -0000 1.8 +@@ -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,7 +138,7 @@ + + 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 -> + update_emule_proto_from_miscoptions1 emule v +Index: src/networks/donkey/donkeyProtoClient.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyProtoClient.ml,v +retrieving revision 1.40 +retrieving revision 1.42 +diff -u -r1.40 -r1.42 +--- src/networks/donkey/donkeyProtoClient.ml 26 Nov 2006 16:36:29 -0000 1.40 ++++ src/networks/donkey/donkeyProtoClient.ml 3 Dec 2006 20:49:42 -0000 1.42 +@@ -39,41 +39,84 @@ + (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 *) ++ 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 *) ++ emule_require_crypt = 0; ++ emule_request_crypt = 0; ++ emule_support_crypt = 0; ++ emule_extmultipacket = 0; ++ emule_largefiles = 0; ++ 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 = +@@ -83,23 +126,24 @@ + *) + Int64.zero + +-let update_emule_proto_from_miscoptions1 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 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 +190,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 +@@ -787,49 +818,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 +Index: src/networks/donkey/donkeyProtoCom.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyProtoCom.ml,v +retrieving revision 1.33 +retrieving revision 1.34 +diff -u -r1.33 -r1.34 +--- src/networks/donkey/donkeyProtoCom.ml 8 Oct 2006 14:20:22 -0000 1.33 ++++ src/networks/donkey/donkeyProtoCom.ml 2 Dec 2006 12:35:46 -0000 1.34 +@@ -339,8 +339,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.25 +diff -u -r1.23 -r1.25 +--- src/networks/donkey/donkeyProtoServer.ml 26 Nov 2006 16:36:29 -0000 1.23 ++++ src/networks/donkey/donkeyProtoServer.ml 3 Dec 2006 20:49:42 -0000 1.25 +@@ -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 = +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.56 +diff -u -r1.55 -r1.56 +--- src/networks/donkey/donkeyShare.ml 9 Oct 2006 16:17:19 -0000 1.55 ++++ src/networks/donkey/donkeyShare.ml 3 Dec 2006 20:57:56 -0000 1.56 +@@ -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; +@@ -333,12 +328,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 +339,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.54 +diff -u -r1.52 -r1.54 +--- src/networks/donkey/donkeyTypes.ml 26 Nov 2006 16:36:29 -0000 1.52 ++++ src/networks/donkey/donkeyTypes.ml 2 Dec 2006 12:35:46 -0000 1.54 +@@ -33,20 +33,32 @@ + lprintf2 log_prefix fmt + + 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 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 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 = +@@ -557,8 +569,10 @@ + 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; +@@ -688,20 +702,32 @@ + 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 *) ++ 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 *) ++ 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 () = +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.18 +diff -u -r1.17 -r1.18 +--- src/networks/fasttrack/fasttrackProto.ml 28 Aug 2006 18:19:16 -0000 1.17 ++++ src/networks/fasttrack/fasttrackProto.ml 3 Dec 2006 20:49:42 -0000 1.18 +@@ -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,8 @@ + | Field_Lastseencomplete + | Field_Mediacodec + | Field_Medialength +- | Field_UNKNOWN _ -> ++ | Field_UNKNOWN _ ++ | Field_KNOWN _ -> + string_tag tag s + + +@@ -433,7 +434,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 +459,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 +870,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 +917,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 +1940,7 @@ + | Field_Artist + | Field_Title + | Field_Codec ++ | Field_KNOWN _ + | Field_UNKNOWN _ + | Field_Filename -> + tags := (Substring, string_tag field w) :: !tags +@@ -1957,14 +1959,14 @@ + 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/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/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/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/utils/cdk/sort2.ml +=================================================================== +RCS file: src/utils/cdk/sort2.ml +diff -N src/utils/cdk/sort2.ml +--- src/utils/cdk/sort2.ml 22 Apr 2003 22:33:39 -0000 1.1 ++++ /dev/null 1 Jan 1970 00:00:00 -0000 +@@ -1,97 +0,0 @@ +-(***********************************************************************) +-(* *) +-(* Objective Caml *) +-(* *) +-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +-(* *) +-(* Copyright 1996 Institut National de Recherche en Informatique et *) +-(* en Automatique. All rights reserved. This file is distributed *) +-(* under the terms of the GNU Library General Public License, with *) +-(* the special exception on linking described in file ../LICENSE. *) +-(* *) +-(***********************************************************************) +- +-(* Merging and sorting *) +- +-open Array +- +- (* +-let rec merge order l1 l2 = +- match l1 with +- [] -> l2 +- | h1 :: t1 -> +- match l2 with +- [] -> l1 +- | h2 :: t2 -> +- if order h1 h2 +- then h1 :: merge order t1 l2 +- else h2 :: merge order l1 t2 +- +-let list order l = +- let rec initlist = function +- [] -> [] +- | [e] -> [[e]] +- | e1::e2::rest -> +- (if order e1 e2 then [e1;e2] else [e2;e1]) :: initlist rest in +- let rec merge2 = function +- l1::l2::rest -> merge order l1 l2 :: merge2 rest +- | x -> x in +- let rec mergeall = function +- [] -> [] +- | [l] -> l +- | llist -> mergeall (merge2 llist) in +- mergeall(initlist l) +- *) +- +-let swap arr i j = +- let tmp = unsafe_get arr i in +- unsafe_set arr i (unsafe_get arr j); +- unsafe_set arr j tmp +- +-let subarray cmp arr pos len = +- let rec qsort lo hi = +- if hi - lo >= 6 then begin +- let mid = (lo + hi) lsr 1 in +- (* Select median value from among LO, MID, and HI. Rearrange +- LO and HI so the three values are sorted. This lowers the +- probability of picking a pathological pivot. It also +- avoids extra comparisons on i and j in the two tight "while" +- loops below. *) +- if cmp (unsafe_get arr mid) (unsafe_get arr lo) <= 0 then swap arr mid lo; +- if cmp (unsafe_get arr hi) (unsafe_get arr mid) <= 0 then begin +- swap arr mid hi; +- if cmp (unsafe_get arr mid) (unsafe_get arr lo) <= 0 then swap arr mid lo +- end; +- let pivot = unsafe_get arr mid in +- let i = ref (lo + 1) and j = ref (hi - 1) in +- if not (cmp pivot (unsafe_get arr hi) <= 0) +- || not (cmp (unsafe_get arr lo) pivot <= 0) +- then raise (Invalid_argument "Sort.array"); +- while !i < !j do +- while not (cmp pivot (unsafe_get arr !i) <= 0) do incr i done; +- while not (cmp (unsafe_get arr !j) pivot <= 0) do decr j done; +- if !i < !j then swap arr !i !j; +- incr i; decr j +- done; +- (* Recursion on smaller half, tail-call on larger half *) +- if !j - lo <= hi - !i then begin +- qsort lo !j; qsort !i hi +- end else begin +- qsort !i hi; qsort lo !j +- end +- end in +- qsort pos (pos+len-1); +- (* Finish sorting by insertion sort *) +- for i = pos+1 to pos+len - 1 do +- let val_i = (unsafe_get arr i) in +- if not (cmp (unsafe_get arr (i - 1)) val_i <= 0) then begin +- unsafe_set arr i (unsafe_get arr (i - 1)); +- let j = ref (i - 1) in +- while !j >= 1 && not (cmp (unsafe_get arr (!j - 1)) val_i <= 0) do +- unsafe_set arr !j (unsafe_get arr (!j - 1)); +- decr j +- done; +- unsafe_set arr !j val_i +- end +- done +- +Index: src/utils/cdk/sort2.mli +=================================================================== +RCS file: src/utils/cdk/sort2.mli +diff -N src/utils/cdk/sort2.mli +--- src/utils/cdk/sort2.mli 22 Apr 2003 22:33:39 -0000 1.1 ++++ /dev/null 1 Jan 1970 00:00:00 -0000 +@@ -1,43 +0,0 @@ +-(***********************************************************************) +-(* *) +-(* Objective Caml *) +-(* *) +-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +-(* *) +-(* Copyright 1996 Institut National de Recherche en Informatique et *) +-(* en Automatique. All rights reserved. This file is distributed *) +-(* under the terms of the GNU Library General Public License, with *) +-(* the special exception on linking described in file ../LICENSE. *) +-(* *) +-(***********************************************************************) +- +-(** Sorting and merging lists. +- +- @deprecated This module is obsolete and exists only for backward +- compatibility. +- The sorting functions in {!Array} and {!List} should be used instead. +- The new functions are faster and use less memory. +-*) +- +-(* +-val list : ('a -> 'a -> bool) -> 'a list -> 'a list +-(** Sort a list in increasing order according to an ordering predicate. +- The predicate should return [true] if its first argument is +- less than or equal to its second argument. *) +-*) +- +-val subarray : ('a -> 'a -> int) -> 'a array -> int -> int -> unit +-(** Sort an array in increasing order according to an +- ordering predicate. +- The predicate should return [true] if its first argument is +- less than or equal to its second argument. +- The array is sorted in place. *) +- +- (* +-val merge : ('a -> 'a -> bool) -> 'a list -> 'a list -> 'a list +-(** Merge two lists according to the given predicate. +- Assuming the two argument lists are sorted according to the +- predicate, [merge] returns a sorted list containing the elements +- from the two lists. The behavior is undefined if the two +- argument lists were not sorted. *) +-*) +Index: src/utils/cdk/string2.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/string2.ml,v +retrieving revision 1.9 +retrieving revision 1.10 +diff -u -r1.9 -r1.10 +--- src/utils/cdk/string2.ml 20 Jul 2006 15:30:21 -0000 1.9 ++++ src/utils/cdk/string2.ml 3 Dec 2006 20:49:43 -0000 1.10 +@@ -322,3 +322,9 @@ + 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 +Index: src/utils/cdk/string2.mli +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/string2.mli,v +retrieving revision 1.10 +retrieving revision 1.11 +diff -u -r1.10 -r1.11 +--- src/utils/cdk/string2.mli 20 Jul 2006 15:30:21 -0000 1.10 ++++ src/utils/cdk/string2.mli 3 Dec 2006 20:49:43 -0000 1.11 +@@ -103,3 +103,4 @@ + 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 +Index: src/utils/cdk/unix2.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/unix2.ml,v +retrieving revision 1.31 +retrieving revision 1.32 +diff -u -r1.31 -r1.32 +--- src/utils/cdk/unix2.ml 12 Aug 2006 20:36:14 -0000 1.31 ++++ src/utils/cdk/unix2.ml 28 Nov 2006 23:52:17 -0000 1.32 +@@ -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.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.st_uid stats.Unix.st_gid ++ with e -> lprintf_nl "copy: failed to preserve owner"); ++ (try Unix.fchmod descr stats.Unix.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/lib/unix32.ml +=================================================================== +RCS file: /sources/mldonkey/mldonkey/src/utils/lib/unix32.ml,v +retrieving revision 1.65 +retrieving revision 1.66 +diff -u -r1.65 -r1.66 +--- src/utils/lib/unix32.ml 15 Jul 2006 11:52:54 -0000 1.65 ++++ src/utils/lib/unix32.ml 28 Nov 2006 23:52:18 -0000 1.66 +@@ -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 -> +@@ -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 *) + |