[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Mldonkey-commits] mldonkey distrib/ChangeLog docs/multiuser.txt s...
|
From: |
mldonkey-commits |
|
Subject: |
[Mldonkey-commits] mldonkey distrib/ChangeLog docs/multiuser.txt s... |
|
Date: |
Thu, 09 Nov 2006 21:32:28 +0000 |
CVSROOT: /sources/mldonkey
Module name: mldonkey
Changes by: spiralvoice <spiralvoice> 06/11/09 21:32:28
Modified files:
distrib : ChangeLog
docs : multiuser.txt
src/daemon/common: commonComplexOptions.ml
commonComplexOptions.mli commonFile.ml
commonFile.mli commonGlobals.ml
commonInteractive.ml commonNetwork.mli
commonOptions.ml commonResult.mli
commonTypes.ml commonUserDb.ml guiDecoding.ml
src/daemon/driver: driverCommands.ml driverControlers.ml
driverInteractive.ml driverInterface.ml
src/gtk2/gui : guiRooms.ml guiUsers.ml
src/networks/bittorrent: bTGlobals.ml bTInteractive.ml
src/networks/donkey: donkeyGlobals.ml donkeyInteractive.ml
src/networks/fasttrack: fasttrackGlobals.ml
src/networks/fileTP: fileTPGlobals.ml fileTPInteractive.ml
src/networks/gnutella: gnutellaGlobals.ml
src/utils/cdk : printf2.ml printf2.mli
Log message:
patch #5526
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1079&r2=1.1080
http://cvs.savannah.gnu.org/viewcvs/mldonkey/docs/multiuser.txt?cvsroot=mldonkey&r1=1.1&r2=1.2
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonComplexOptions.ml?cvsroot=mldonkey&r1=1.64&r2=1.65
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonComplexOptions.mli?cvsroot=mldonkey&r1=1.19&r2=1.20
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonFile.ml?cvsroot=mldonkey&r1=1.67&r2=1.68
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonFile.mli?cvsroot=mldonkey&r1=1.28&r2=1.29
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonGlobals.ml?cvsroot=mldonkey&r1=1.72&r2=1.73
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonInteractive.ml?cvsroot=mldonkey&r1=1.83&r2=1.84
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonNetwork.mli?cvsroot=mldonkey&r1=1.17&r2=1.18
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonOptions.ml?cvsroot=mldonkey&r1=1.184&r2=1.185
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonResult.mli?cvsroot=mldonkey&r1=1.6&r2=1.7
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonTypes.ml?cvsroot=mldonkey&r1=1.59&r2=1.60
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonUserDb.ml?cvsroot=mldonkey&r1=1.6&r2=1.7
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/guiDecoding.ml?cvsroot=mldonkey&r1=1.63&r2=1.64
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/driver/driverCommands.ml?cvsroot=mldonkey&r1=1.192&r2=1.193
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/driver/driverControlers.ml?cvsroot=mldonkey&r1=1.91&r2=1.92
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/driver/driverInteractive.ml?cvsroot=mldonkey&r1=1.112&r2=1.113
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/driver/driverInterface.ml?cvsroot=mldonkey&r1=1.55&r2=1.56
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/gui/guiRooms.ml?cvsroot=mldonkey&r1=1.3&r2=1.4
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/gtk2/gui/guiUsers.ml?cvsroot=mldonkey&r1=1.3&r2=1.4
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/bittorrent/bTGlobals.ml?cvsroot=mldonkey&r1=1.70&r2=1.71
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/bittorrent/bTInteractive.ml?cvsroot=mldonkey&r1=1.120&r2=1.121
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/donkey/donkeyGlobals.ml?cvsroot=mldonkey&r1=1.102&r2=1.103
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/donkey/donkeyInteractive.ml?cvsroot=mldonkey&r1=1.133&r2=1.134
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/fasttrack/fasttrackGlobals.ml?cvsroot=mldonkey&r1=1.42&r2=1.43
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/fileTP/fileTPGlobals.ml?cvsroot=mldonkey&r1=1.29&r2=1.30
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/fileTP/fileTPInteractive.ml?cvsroot=mldonkey&r1=1.50&r2=1.51
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/gnutella/gnutellaGlobals.ml?cvsroot=mldonkey&r1=1.43&r2=1.44
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/cdk/printf2.ml?cvsroot=mldonkey&r1=1.20&r2=1.21
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/cdk/printf2.mli?cvsroot=mldonkey&r1=1.8&r2=1.9
Patches:
Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1079
retrieving revision 1.1080
diff -u -b -r1.1079 -r1.1080
--- distrib/ChangeLog 6 Nov 2006 18:06:08 -0000 1.1079
+++ distrib/ChangeLog 9 Nov 2006 21:32:25 -0000 1.1080
@@ -14,6 +14,39 @@
ChangeLog
=========
+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)
Index: docs/multiuser.txt
===================================================================
RCS file: /sources/mldonkey/mldonkey/docs/multiuser.txt,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -b -r1.1 -r1.2
--- docs/multiuser.txt 19 Sep 2006 17:07:42 -0000 1.1
+++ docs/multiuser.txt 9 Nov 2006 21:32:25 -0000 1.2
@@ -1,42 +1,45 @@
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 in provided
-by the daemon.
+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 one user which owns a downloading file,
-file_group means one group the file belongs to, file_owner must be a member of
+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
-- users2 is extended with these settings:
+- "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:
- user_groups = []
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
-only visible to the file_owner (and admins, of course).
+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. Globals option "mail"
+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 = ""
-Not implemented yet, planned feature is to have user specific directories
-below global incoming directories.
+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
@@ -50,9 +53,7 @@
- groups, new option
At least one group named "mldonkey" with group_admin = true must exist
-
-This option is not implemented yet
- group_mail = ""
+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".
@@ -63,37 +64,67 @@
---------
- 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 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 value user_default_group is used
+ 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>"
+chgrp <group> <num>
change group of download <num> to <group>, group = none for private file
-chown <user> "<num>"
+chown <user> <num>
change owner of download <num> to <user>
-groupadd <group> <admin: true | false> [<mail>]
-add new mldonkey group
+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
+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
+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
+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
@@ -107,13 +138,12 @@
Updating from a non-multiuser MLDonkey
======================================
-When updating all files have file_owner "admin" and file_group "mldonkey".
-All existing users 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.
+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
+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
@@ -125,19 +155,4 @@
To-Do
======
-- check on start-up of group "mldonkey" exists and if it has admin rights
-- implement groupdel + prevent deletion if group is in use
-- prevent groupdel if group is file_group of current downloads
-- prevent groupdel if group has members
-- implement user_commit_dir (work is done in multigroup_usercommit.patch)
- Besides supporting the option user_commit_dir the mechanism to choose
- incoming directory is changed.
- Incoming directories are saved in a list of directories in option
- shared_directories. They have a special sharing_strategy named
- incoming_directories (for BT multifile downloads only) or incoming_files.
- Current implementation uses the first directory with this stratagy found in
- the list.
- The new implementation (already done) iters the list of marked incoming
- directories until one is found with enough free space. If no usable directory
- is found, the file will stay in the list of files to be committed.
-- implement group_mail
+- Suggestions ?
Index: src/daemon/common/commonComplexOptions.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonComplexOptions.ml,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -b -r1.64 -r1.65
--- src/daemon/common/commonComplexOptions.ml 29 Oct 2006 18:58:59 -0000
1.64
+++ src/daemon/common/commonComplexOptions.ml 9 Nov 2006 21:32:25 -0000
1.65
@@ -109,41 +109,52 @@
get_value "file_release" value_to_bool
with _ -> ());
- let file_user = try
+ let file_user =
+ let filename = get_value "file_filename" value_to_string in
+ try
let u = get_value "file_owner" value_to_string in
- if user2_user_exist u then u else begin
+ begin
+ try
+ user2_user_find u
+ with Not_found ->
lprintf_nl "file_owner %s of %s does not exist, changing to %s"
- u (get_value "file_filename" value_to_string) admin_user;
+ u filename admin_user.user_name;
admin_user
end
- with _ -> admin_user
+ 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 = try
+ 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 ->
- if user2_group_exists g then
- if user2_user_is_group_member file_user g then
+ begin
+ try
+ let g = user2_group_find g in
+ if List.mem g file_user.user_groups then
Some g
- else begin
+ 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
- g
- (get_value "file_filename" value_to_string)
- (user2_print_user_default_group file_user);
- user2_user_default_group file_user
+ file_user.user_name g.group_name filename dgroup;
+ file_user.user_default_group
end
- else begin
- lprintf_nl "file_group %s of %s does not exist, changing
file_group of %s to user_default_group %s"
- g
- (get_value "file_filename" value_to_string)
- file_user
- (user2_print_user_default_group file_user);
- user2_user_default_group file_user
+ 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 _ -> user2_user_default_group file_user
+ 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;
@@ -184,8 +195,8 @@
(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)) ::
- ("file_group", option_to_stringvalue (file_group file)) ::
+ ("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)
)
@@ -972,7 +983,7 @@
let dirname_user =
match user with
| None -> ""
- | Some user -> (user2_user_find user).user_commit_dir
+ | Some user -> user.user_commit_dir
in
(*
Index: src/daemon/common/commonComplexOptions.mli
===================================================================
RCS file:
/sources/mldonkey/mldonkey/src/daemon/common/commonComplexOptions.mli,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -b -r1.19 -r1.20
--- src/daemon/common/commonComplexOptions.mli 29 Oct 2006 18:58:59 -0000
1.19
+++ src/daemon/common/commonComplexOptions.mli 9 Nov 2006 21:32:26 -0000
1.20
@@ -40,7 +40,7 @@
val shared_directories :
CommonTypes.shared_directory list Options.option_record
-val incoming_dir : bool -> ?user:string -> ?needed_space:int64 ->
?network:string -> 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
Index: src/daemon/common/commonFile.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonFile.ml,v
retrieving revision 1.67
retrieving revision 1.68
diff -u -b -r1.67 -r1.68
--- src/daemon/common/commonFile.ml 31 Oct 2006 15:40:05 -0000 1.67
+++ src/daemon/common/commonFile.ml 9 Nov 2006 21:32:26 -0000 1.68
@@ -42,8 +42,8 @@
(*************************************************************************)
type 'a file_impl = {
- mutable impl_file_owner : string;
- mutable impl_file_group : string option;
+ mutable impl_file_owner : userdb;
+ mutable impl_file_group : groupdb option;
mutable impl_file_update : int;
mutable impl_file_state : file_state;
@@ -234,16 +234,8 @@
let file_group file =
(as_file_impl file).impl_file_group
-let impl_group_text impl =
- match impl.impl_file_group with
- Some group -> group
- | None -> "None"
-
-let file_group_text file =
- impl_group_text (as_file_impl file)
-
-let user2_allow_file_admin file gui_user =
- user2_is_admin gui_user || file_owner file = gui_user
+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
@@ -278,37 +270,17 @@
let set_file_group file group =
(as_file_impl file).impl_file_group <- group
-let set_file_owner_safe file user new_owner =
- if (user2_user_exist new_owner) &&
- (user2_allow_file_admin file user) then
- begin
- set_file_owner file new_owner;
- true
- end
- else
- false
-
-let set_file_group_safe file gui_user new_group =
- if (user2_group_exists_option new_group) &&
- (user2_allow_file_admin file gui_user) then
- begin
- set_file_group file new_group;
- true
- end
- else
- false
-
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_user_dls_count user =
+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_group_dls_count group =
+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
@@ -712,10 +684,10 @@
("", "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_name then
+ if user2_allow_file_admin file o.conn_user.ui_user then
let optionlist = ref "" in
- user2_user_iter (fun user ->
- if user.user_name <> (file_owner file) then
+ 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;
);
@@ -735,25 +707,25 @@
^ "\\<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) (file_owner file)
+ ^ 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))];
+ 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_name &&
- user2_user_groups_safe o.conn_user.ui_user_name <> [] then
+ if user2_allow_file_admin file o.conn_user.ui_user &&
+ o.conn_user.ui_user.user_groups <> [] then
let optionlist =
- if (file_group_text file) = "None" then
+ if (file_group file) = None then
ref ""
else
ref "\\<option value=\\\"None\\\"\\>None\\</option\\>\n"
in
- user2_user_groups_iter o.conn_user.ui_user_name (fun group ->
- if group <> (file_group_text file) then
- optionlist := !optionlist ^ Printf.sprintf "\\<option
value=\\\"%s\\\"\\>%s\\</option\\>\n" group group;
+ 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");
@@ -772,14 +744,14 @@
^ "\\<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"
(file_group_text file) (file_group_text file)
+ ^ 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
+ Some group -> Printf.sprintf "%s" group.group_name
| None -> "None"))];
Printf.bprintf buf "\\</tr\\>\\<tr class=\\\"dl-%d\\\"\\>"
(html_mods_cntr ());
@@ -845,9 +817,9 @@
(Int64.to_string info.G.file_size)
(Int64.to_string info.G.file_downloaded)
(file_priority file)
- (file_owner file)
+ (file_owner file).user_name
(match file_group file with
- Some group -> Printf.sprintf "%s" group
+ Some group -> Printf.sprintf "%s" group.group_name
| None -> "private");
Printf.bprintf buf "Chunks: [%-s]\n"
(match info.G.file_chunks with
@@ -1243,8 +1215,8 @@
T.file_sub_files = [];
T.file_magic = impl.impl_file_magic;
T.file_comments = [];
- T.file_user = impl.impl_file_owner;
- T.file_group = (impl_group_text impl);
+ 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;
}
Index: src/daemon/common/commonFile.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonFile.mli,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -b -r1.28 -r1.29
--- src/daemon/common/commonFile.mli 25 Oct 2006 11:12:38 -0000 1.28
+++ src/daemon/common/commonFile.mli 9 Nov 2006 21:32:26 -0000 1.29
@@ -18,8 +18,8 @@
*)
type 'a file_impl = {
- mutable impl_file_owner : string;
- mutable impl_file_group : string option;
+ 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;
@@ -85,9 +85,9 @@
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 -> string -> unit
-val file_resume : CommonTypes.file -> string -> unit
-val set_file_release : CommonTypes.file -> bool -> string -> 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
@@ -146,15 +146,12 @@
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 -> string -> CommonTypes.file
list
-val user2_user_dls_count : string -> int
-val user2_group_dls_count : string -> int
-val user2_allow_file_admin : CommonTypes.file -> string -> bool
-val set_file_owner : CommonTypes.file -> string -> unit
-val set_file_owner_safe : CommonTypes.file -> string -> string -> bool
-val file_owner : CommonTypes.file -> string
-val set_file_group : CommonTypes.file -> string option -> unit
-val set_file_group_safe : CommonTypes.file -> string -> string option -> bool
-val file_group : CommonTypes.file -> string option
-val file_group_text : CommonTypes.file -> string
+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.72
retrieving revision 1.73
diff -u -b -r1.72 -r1.73
--- src/daemon/common/commonGlobals.ml 23 Sep 2006 20:29:46 -0000 1.72
+++ src/daemon/common/commonGlobals.ml 9 Nov 2006 21:32:26 -0000 1.73
@@ -499,7 +499,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 +513,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 +522,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
@@ -899,6 +899,12 @@
let intern_table = StringIntern.create 1000
let intern s = StringIntern.merge intern_table s
+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 _ =
Heap.add_memstat "CommonGlobals" (fun level buf ->
Index: src/daemon/common/commonInteractive.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonInteractive.ml,v
retrieving revision 1.83
retrieving revision 1.84
diff -u -b -r1.83 -r1.84
--- src/daemon/common/commonInteractive.ml 29 Oct 2006 18:58:59 -0000
1.83
+++ src/daemon/common/commonInteractive.ml 9 Nov 2006 21:32:26 -0000
1.84
@@ -181,8 +181,8 @@
("INCOMING", incoming);
("NETWORK", network.network_name);
("ED2K_HASH", (file_print_ed2k_link filename (file_size file)
info.G.file_md4));
- ("FILE_OWNER",(file_owner file));
- ("FILE_GROUP",(file_group_text file));
+ ("FILE_OWNER",(file_owner file).user_name);
+ ("FILE_GROUP",user2_print_group (file_group file));
]
with e ->
@@ -304,7 +304,7 @@
lprintf_nl "Exception in file_cancel: %s" (Printexc2.to_string e)
let mail_for_completed_file file =
- let usermail = user2_user_mail (file_owner file) in
+ let usermail = (file_owner file).user_mail in
if !!mail <> "" || usermail <> "" then begin
let module M = Mailer in
let info = file_info file in
@@ -339,7 +339,7 @@
in
let line6 =
- Printf.sprintf "\r\nUser/Group: %s:%s\r\n" (file_owner file)
(file_group_text file)
+ 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 =
@@ -520,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 user.ui_user_name in
+ result [] false user.ui_user in
List.iter start_download files;
"download started"
with
@@ -974,7 +974,7 @@
with Not_found ->
(owner, {
downloads_allowed =
- (match (user2_user_find owner).user_max_concurrent_downloads with
+ (match owner.user_max_concurrent_downloads with
| 0 -> None
| i -> Some i);
file_list = [f] }) :: acc
Index: src/daemon/common/commonNetwork.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonNetwork.mli,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -b -r1.17 -r1.18
--- src/daemon/common/commonNetwork.mli 1 Oct 2006 17:53:59 -0000 1.17
+++ src/daemon/common/commonNetwork.mli 9 Nov 2006 21:32:26 -0000 1.18
@@ -58,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 -> 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.184
retrieving revision 1.185
diff -u -b -r1.184 -r1.185
--- src/daemon/common/commonOptions.ml 25 Oct 2006 11:12:38 -0000 1.184
+++ src/daemon/common/commonOptions.ml 9 Nov 2006 21:32:26 -0000 1.185
@@ -742,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
Index: src/daemon/common/commonResult.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonResult.mli,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -b -r1.6 -r1.7
--- src/daemon/common/commonResult.mli 19 Sep 2006 17:07:42 -0000 1.6
+++ 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 -> string -> 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/commonTypes.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonTypes.ml,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -b -r1.59 -r1.60
--- src/daemon/common/commonTypes.ml 25 Oct 2006 11:12:38 -0000 1.59
+++ src/daemon/common/commonTypes.ml 9 Nov 2006 21:32:26 -0000 1.60
@@ -376,6 +376,8 @@
| ByNet
| ByAvail
| ByComments
+| ByUser
+| ByGroup
| NotSorted
type room_state =
@@ -468,7 +470,22 @@
| PorttestInProgress of int
| PorttestResult of int * string
-type network = {
+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;
@@ -496,7 +513,7 @@
mutable op_network_share : (
string -> string -> int64 -> unit);
mutable op_network_private_message : (string -> string -> unit);
- mutable op_network_parse_url : (string -> 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);
@@ -508,9 +525,9 @@
mutable op_network_info : (unit -> network_info);
mutable op_network_connected : (unit -> bool);
- mutable op_network_gui_message : (string -> string -> unit);
+ mutable op_network_gui_message : (string -> userdb -> unit);
- mutable op_network_download : (result_info -> string -> 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);
@@ -521,7 +538,7 @@
}
and ui_user = {
- ui_user_name : string;
+ ui_user : userdb;
mutable ui_user_searches : search list;
mutable ui_last_search : search option;
mutable ui_last_results : (int * result) list;
Index: src/daemon/common/commonUserDb.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonUserDb.ml,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -b -r1.6 -r1.7
--- src/daemon/common/commonUserDb.ml 19 Sep 2006 17:07:42 -0000 1.6
+++ src/daemon/common/commonUserDb.ml 9 Nov 2006 21:32:26 -0000 1.7
@@ -32,28 +32,6 @@
lprintf2 log_prefix fmt
(*************************************************************************)
-(* TYPES *)
-(*************************************************************************)
-
-type userdb = {
- user_name : string;
- user_pass : Md4.t;
- user_groups : string list;
- user_default_group : string option;
- user_mail : string;
- user_commit_dir : string;
- user_max_concurrent_downloads : int;
- }
-
-type groupdb = {
- group_name : string;
- group_mail : string;
- group_admin : bool;
- }
-
-exception User_has_downloads of int
-
-(*************************************************************************)
(* DEFAULTS *)
(*************************************************************************)
@@ -62,10 +40,34 @@
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 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 admin_user = "admin"
-let system_user_default_group = "mldonkey"
+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 *)
@@ -75,17 +77,12 @@
let value_to_group v =
match v with
- Options.Module assocs ->
+ | 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 _ -> system_user_default_group
- in
- let gmail =
- try
- get_value "group_mail" value_to_string
- with _ -> ""
+ with _ -> default_group_name
in
let gadmin =
try
@@ -93,7 +90,6 @@
with _ -> true
in
{ group_name = gname;
- group_mail = gmail;
group_admin = gadmin;
}
@@ -102,7 +98,6 @@
let group_to_value group =
Options.Module [
"group_name", string_to_value group.group_name;
- "group_mail", string_to_value group.group_mail;
"group_admin", bool_to_value group.group_admin;
]
@@ -116,45 +111,45 @@
group_admin = Are members of this group MLDonkey admins?
Only members of this group can change settings and see
uploads.
"
- (list_option GroupOption.t)
- [
- { group_name = system_user_default_group;
- group_mail = "";
- group_admin = true;
- };
- ]
+ (list_option GroupOption.t) [system_user_default_group]
(*************************************************************************)
(* Group database functions *)
(*************************************************************************)
-let user2_group_iter f =
- List.iter f !!grouplist
+let user2_groups_iter f =
+ List.iter f ((List.sort (fun g1 g2 -> compare g1.group_name g2.group_name))
!!grouplist)
-let user2_group_add name ?(mail = "") ?(admin = true) () =
+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_mail = mail;
group_admin = admin;
} in
- grouplist =:= new_group :: List.filter (fun g -> g.group_name <> name)
!!grouplist
+ update_group name (Some new_group)
-let user2_group_remove name =
- grouplist =:= List.filter (fun g -> g.group_name <> name) !!grouplist
+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 =
- try
- ignore (user2_group_find group);
- true
- with Not_found -> false
+ List.exists (fun g -> g.group_name = group) !!grouplist
-let user2_group_exists_option group =
- match group with
- None -> true
- | Some group -> user2_group_exists group
+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 *)
@@ -195,26 +190,27 @@
let ugroups =
try
let ugl = get_value "user_groups" (value_to_list
value_to_string) in
- List.filter (fun g -> user2_group_exists g) ugl
- with _ -> [system_user_default_group]
+ 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 ->
- if user2_group_exists udg then
- if List.mem udg ugroups then
- 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
- else begin
+ with Not_found ->
lprintf_nl "user_default_group %s of user %s does not
exist, setting to None" udg uname;
None
end
- with _ -> Some system_user_default_group
+ with Not_found -> Some system_user_default_group
in
{ user_name = uname;
user_pass = upass;
@@ -231,8 +227,8 @@
Options.Module [
"user_name", string_to_value user.user_name;
"user_pass", string_to_value (Md4.to_string user.user_pass);
- "user_groups", list_to_value string_to_value user.user_groups;
- "user_default_group", option_to_stringvalue user.user_default_group;
+ "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;
@@ -250,45 +246,42 @@
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)
- [ { user_name = admin_user;
- 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;
- } ]
+ (list_option UserOption.t) [admin_user]
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, blank_password]
+ [admin_user.user_name, blank_password]
(*************************************************************************)
(* User database functions *)
(*************************************************************************)
-let user2_user_iter f =
- List.iter f !!userlist
+let user2_users_iter f =
+ List.iter f ((List.sort (fun u1 u2 -> compare u1.user_name u2.user_name))
!!userlist)
-let user2_user_add name pass ?(groups = [system_user_default_group])
- ?(default_group = Some system_user_default_group)
+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.filter (fun g -> user2_group_exists g) groups)
- in
- if l = [] then
- [system_user_default_group]
- else l
+ 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 -> default_group
- | Some group -> if not (user2_group_exists group) then None else Some group
+ 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;
@@ -299,19 +292,16 @@
user_commit_dir = commit_dir;
user_max_concurrent_downloads = max_dl;
} in
- userlist =:= new_user :: List.filter (fun u -> u.user_name <> name)
!!userlist
+ update_user name (Some new_user)
let user2_user_remove user =
- userlist =:= List.filter (fun u -> u.user_name <> user) !!userlist
+ update_user user None
let user2_user_find user =
List.find (fun u -> u.user_name = user) !!userlist
-let user2_user_exist user =
- try
- ignore (user2_user_find user);
- true
- with Not_found -> false
+let user2_user_exists user =
+ List.exists (fun u -> u.user_name = user) !!userlist
(*************************************************************************)
(* User database functions / passwords *)
@@ -321,172 +311,94 @@
(user2_user_find user).user_pass
let user2_user_set_password user pass_string =
- let new_user = {
- (user2_user_find user) with
- user_pass = Md4.string pass_string
- } in
- userlist =:= new_user :: List.filter (fun u -> u.user_name <> user)
!!userlist
+ user.user_pass <- Md4.string pass_string
let valid_password user pass =
try
user2_user_password user = Md4.string pass
with Not_found -> false
-let empty_password user =
- valid_password user ""
+let has_empty_password user =
+ valid_password user.user_name ""
(*************************************************************************)
-(* User database functions / mail *)
+(* User database functions *)
(*************************************************************************)
-let user2_user_mail user =
- (user2_user_find user).user_mail
-
-let user2_print_user_mail user =
- try
- user2_user_mail user
- with Not_found -> ""
-
let user2_user_set_mail user mail =
- let new_user = {
- (user2_user_find user) with
- user_mail = mail
- } in
- userlist =:= new_user :: List.filter (fun u -> u.user_name <> user)
!!userlist
-
-(*************************************************************************)
-(* User database functions / concurrent downloads *)
-(*************************************************************************)
-
-let user2_user_dls user =
- (user2_user_find user).user_max_concurrent_downloads
+ user.user_mail <- mail
let user2_print_user_dls user =
- try
- let dls = user2_user_dls user in
- if dls = 0 then "unlimited"
- else (Printf.sprintf "%d" dls)
- with Not_found -> "unknown"
+ 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 =
- let new_user = {
- (user2_user_find user) with
- user_max_concurrent_downloads = dls
- } in
- userlist =:= new_user :: List.filter (fun u -> u.user_name <> user)
!!userlist
-
-(*************************************************************************)
-(* User database functions / commit dir *)
-(*************************************************************************)
+ user.user_max_concurrent_downloads <- dls
let user2_user_commit_dir user =
(user2_user_find user).user_commit_dir
-let user2_print_user_commit_dir user =
- try
- user2_user_commit_dir user
- with Not_found -> ""
-
let user2_user_set_commit_dir user dir =
- let new_user = {
- (user2_user_find user) with
- user_commit_dir = dir
- } in
- userlist =:= new_user :: List.filter (fun u -> u.user_name <> user)
!!userlist
+ user.user_commit_dir <- dir
(*************************************************************************)
(* User/Group database functions *)
(*************************************************************************)
-let user2_user_groups user =
- try
- (user2_user_find user).user_groups
- with Not_found -> failwith (Printf.sprintf "User %s does not exist" user)
-
-let user2_user_groups_safe user =
- try
- (user2_user_find user).user_groups
- with Not_found -> []
-
-let user2_user_groups_safe_default user =
- try
- (user2_user_find user).user_groups
- with Not_found -> [system_user_default_group]
+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 (user2_user_groups_safe user)
+ List.iter f (sort_groups_by_name user.user_groups)
-let user2_print_user_groups user =
- try
- let u = user2_user_find user in
- String.concat "," u.user_groups
- with Not_found -> ""
+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_user_default_group user =
- try
- (user2_user_find user).user_default_group
- with Not_found -> None
+let user2_print_group group =
+ match group with
+ None -> "none"
+ | Some group -> group.group_name
let user2_print_user_default_group user =
- try
- let u = user2_user_find user in
- match u.user_default_group with
- None -> "none"
- | Some group -> group
- with Not_found -> failwith (Printf.sprintf "User %s does not exist" 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 =
- if not (user2_group_exists group) then
- user2_group_add group ();
- try
- let u = user2_user_find user in
- user2_user_add
- u.user_name
- u.user_pass
- ?groups:(Some (List.append u.user_groups [group]))
- ?mail:(Some u.user_mail)
- with Not_found -> failwith (Printf.sprintf "User %s does not exist" user)
+ user.user_groups <- group :: user.user_groups
let user2_user_remove_group user group =
- try
- let u = user2_user_find user in
- user2_user_add
- u.user_name
- u.user_pass
- ?groups:(Some (List.filter (fun g -> not (g = group)) u.user_groups))
- ?mail:(Some u.user_mail)
- with Not_found -> failwith (Printf.sprintf "User %s does not exist" user)
+ user.user_groups <- List.filter ((<>) group) user.user_groups
-let user2_user_is_group_member user group =
- List.mem group (user2_user_groups_safe user)
+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 = admin_user ||
+ user.user_name = admin_user.user_name ||
List.exists (fun groupname ->
try
- (user2_group_find groupname).group_admin
+ groupname.group_admin
with Not_found -> false)
- (user2_user_groups_safe user)
+ user.user_groups
+(* could be expanded later *)
let user2_can_view_uploads user =
user2_is_admin user
-let user2_can_view_file gui_user file_owner file_group =
- user2_is_admin gui_user || gui_user = file_owner ||
+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 -> user2_user_is_group_member gui_user file_group)
-
-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
+ | Some file_group -> List.mem file_group user.user_groups)
(*************************************************************************)
(* Hooks *)
@@ -495,23 +407,38 @@
let _ =
set_after_load_hook users_ini (fun _ ->
List.iter (fun (user,pass) ->
- if not (user2_user_exist user) then begin
+ 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 =:= [];
- if not (user2_user_exist admin_user) then
+(* 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
- user2_user_add admin_user blank_password ();
- lprintf_nl "SECURITY INFO: user 'admin' has to be present, creating
with empty password!..."
+ 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_user_iter (fun user ->
+ user2_users_iter (fun user ->
users =:= (user.user_name, (user2_user_password user.user_name)) ::
!!users
)
);
Index: src/daemon/common/guiDecoding.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/guiDecoding.ml,v
retrieving revision 1.63
retrieving revision 1.64
diff -u -b -r1.63 -r1.64
--- src/daemon/common/guiDecoding.ml 31 Oct 2006 15:40:05 -0000 1.63
+++ src/daemon/common/guiDecoding.ml 9 Nov 2006 21:32:26 -0000 1.64
@@ -1053,7 +1053,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
Index: src/daemon/driver/driverCommands.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverCommands.ml,v
retrieving revision 1.192
retrieving revision 1.193
diff -u -b -r1.192 -r1.193
--- src/daemon/driver/driverCommands.ml 31 Oct 2006 15:40:05 -0000 1.192
+++ src/daemon/driver/driverCommands.ml 9 Nov 2006 21:32:26 -0000 1.193
@@ -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"
@@ -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\t\tload this file from the web\n"
+ ), "<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)";
@@ -759,7 +759,7 @@
server_remove s
) args;
Printf.sprintf (_b"%d servers removed") (List.length args)
- ), "<server numbers|all|blocked|disc> :\t\t\tremove server(s)
('all'/'blocked'/'disc' = all/IP blocked/disconnected 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
@@ -771,7 +771,7 @@
), "<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_name then
+ 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
@@ -1047,7 +1047,7 @@
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;
@@ -1056,23 +1056,21 @@
"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;
- let result =
- Printf.sprintf "new upload rate: %d | new download rate: %d"
- !!max_hard_upload_rate !!max_hard_download_rate
- in
- if o.conn_output = HTML then
- html_mods_table_one_row buf "serversTable" "servers" [
- ("", "srh", result); ]
+ 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
- Buffer.add_string buf result;
+ print_command_result o buf "You are not allowed to toggle bandwidth";
""
- ), ":\t\t\ttoggle between the two rate sets";
+ ), ":\t\t\t\ttoggle between the two rate sets";
"stats", Arg_none (fun o ->
let buf = o.conn_buf in
@@ -1153,15 +1151,29 @@
) , ":\t\t\t\tprint all networks";
"enable", Arg_one (fun num o ->
+ let buf = o.conn_buf in
+ if user2_is_admin o.conn_user.ui_user then
+ begin
let n = network_find_by_num (int_of_string num) in
network_enable n;
- _s "network enabled"
+ 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 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;
- _s "network disabled"
+ 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 ->
@@ -1367,7 +1379,7 @@
begin
let r = List.hd !forceable_download in
CommonNetwork.networks_iter (fun n ->
- ignore (n.op_network_download r o.conn_user.ui_user_name));
+ 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
@@ -1400,7 +1412,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;
@@ -1452,7 +1464,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 "");
@@ -1629,6 +1641,8 @@
strings_of_option html_mods_vd_network;
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;
@@ -1808,7 +1822,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 "");
@@ -2233,7 +2247,7 @@
"unshare", Arg_one (fun arg o ->
- if user2_is_admin o.conn_user.ui_user_name then begin
+ 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
@@ -2259,15 +2273,8 @@
"upstats", Arg_none (fun o ->
let buf = o.conn_buf in
-
- if not (user2_can_view_uploads o.conn_user.ui_user_name) then
- begin
- if use_html_mods o then
- html_mods_table_one_row buf "upstatsTable" "upstats" [
- ("", "srh", "You are not allowed to see upload statistics") ]
- else
+ 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"
- end
else
begin
let list = ref [] in
@@ -2282,14 +2289,8 @@
"links", Arg_none (fun o ->
let buf = o.conn_buf in
- if not (user2_can_view_uploads o.conn_user.ui_user_name) then
- begin
- if use_html_mods o then
- html_mods_table_one_row buf "upstatsTable" "upstats" [
- ("", "srh", "You are not allowed to see shared files list") ]
- else
- Printf.bprintf buf "You are not allowed to see shared files
list\n"
- end
+ 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
@@ -2318,35 +2319,19 @@
"uploaders", Arg_none (fun o ->
let buf = o.conn_buf in
- if not (user2_can_view_uploads o.conn_user.ui_user_name) then
- begin
- begin
- if use_html_mods o then
- html_mods_table_one_row buf "upstatsTable" "upstats" [
- ("", "srh", "You are not allowed to see uploaders list") ]
- else
- Printf.bprintf buf "You are not allowed to see uploaders
list\n";
- end;
- ""
- end
+ 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
@@ -2488,19 +2473,14 @@
) !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
@@ -2511,15 +2491,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
-
-
+ end;
+ ""
), ":\t\t\t\tshow users currently uploading";
@@ -2565,7 +2542,7 @@
"yes" | "y" | "true" ->
List.iter (fun file ->
try
- file_cancel file o.conn_user.ui_user_name
+ 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)
@@ -2602,7 +2579,7 @@
if not (List.memq num !to_cancel) then
to_cancel := num :: !to_cancel
in
- if args = ["all"] && user2_is_admin o.conn_user.ui_user_name then
+ if args = ["all"] && user2_is_admin o.conn_user.ui_user then
List.iter (fun file ->
file_cancel file
) !!files
@@ -2646,7 +2623,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\\>";
@@ -2672,7 +2649,7 @@
), "<num> :\t\t\tverify chunks of file <num>";
"pause", Arg_multiple (fun args o ->
- if args = ["all"] && user2_is_admin o.conn_user.ui_user_name then
+ if args = ["all"] && user2_is_admin o.conn_user.ui_user then
List.iter (fun file ->
file_pause file admin_user;
) !!files
@@ -2681,12 +2658,12 @@
let num = int_of_string num in
List.iter (fun file ->
if (as_file_impl file).impl_file_num = num then
- file_pause file o.conn_user.ui_user_name
+ 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"] && user2_is_admin o.conn_user.ui_user_name then
+ if args = ["all"] && user2_is_admin o.conn_user.ui_user then
List.iter (fun file ->
file_resume file admin_user
) !!files
@@ -2695,7 +2672,7 @@
let num = int_of_string num in
List.iter (fun file ->
if (as_file_impl file).impl_file_num = num then
- file_resume file o.conn_user.ui_user_name
+ file_resume file o.conn_user.ui_user
) !!files) args; ""
), "<num> :\t\t\t\tresume a paused download (use arg 'all' for all files)";
@@ -2703,7 +2680,7 @@
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_name;
+ 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"
@@ -2727,7 +2704,7 @@
"vd", Arg_multiple (fun args o ->
let buf = o.conn_buf in
- let list = user2_filter_files !!files o.conn_user.ui_user_name 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"] ->
@@ -2797,14 +2774,14 @@
"filenames_variability", Arg_none (fun o ->
let list = List2.tail_map file_info
- (user2_filter_files !!files o.conn_user.ui_user_name) in
+ (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 o.conn_user.ui_user_name
+ 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 ->
@@ -2812,7 +2789,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
o.conn_user.ui_user_name);
+ 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)
@@ -2829,44 +2806,42 @@
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 add_new_user user pass_string =
- if user2_is_admin o.conn_user.ui_user_name
- || o.conn_user.ui_user_name = (find_ui_user user).ui_user_name then
- try
- user2_user_set_password user pass_string;
+ 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)
- with Not_found ->
- user2_user_add user (Md4.string pass_string) ();
- print_command_result o buf (Printf.sprintf "User %s added with
default values" user)
+ end
else
- print_command_result o buf "You are not allowed to add users"
- in begin
- match args with
- user :: pass_string :: _ ->
- add_new_user user pass_string;
- | _ -> print_command_result o buf "Wrong syntax: use 'useradd user
pass'"
- end;
+ begin
+ user2_user_add user (Md4.string pass) ();
+ print_command_result o buf (Printf.sprintf "User %s added" user)
+ end
+ else
+ print_command_result o buf "You are not allowed to add users";
_s ""
), "<user> <passwd> :\t\tadd new mldonkey user/change user password";
"userdel", Arg_one (fun user o ->
let buf = o.conn_buf in
- if user <> o.conn_user.ui_user_name then
- if user2_is_admin o.conn_user.ui_user_name then
- if user = admin_user then
+ 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 n = user2_user_dls_count user in if n <> 0 then raise
(User_has_downloads n);
- ignore (user2_user_find user);
- ignore (user2_user_remove user);
+ 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)
- | User_has_downloads n -> print_command_result o buf
- (Printf.sprintf "User %s has %d downloads, can not delete"
user n)
else
print_command_result o buf "You are not allowed to remove users"
else
@@ -2874,25 +2849,118 @@
_s ""
), "<user> :\t\t\tremove a mldonkey user";
- "passwd", Arg_one (fun passwd o ->
+ "usergroupadd", Arg_two (fun user group o ->
let buf = o.conn_buf in
- let user = o.conn_user.ui_user_name in
+ if user2_is_admin o.conn_user.ui_user then
begin
try
- user2_user_set_password user passwd;
- print_command_result o buf (Printf.sprintf "Password of user %s
changed" user)
+ 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\tchange own password";
+ ), "<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_name
- || o.conn_user.ui_user_name = (find_ui_user user).ui_user_name then
+ if user2_is_admin o.conn_user.ui_user
+ || o.conn_user.ui_user.user_name = user then
begin
try
- user2_user_set_mail user mail;
+ 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
@@ -2902,79 +2970,108 @@
"userdls", Arg_two (fun user dls o ->
let buf = o.conn_buf in
- if user2_is_admin o.conn_user.ui_user_name
- || o.conn_user.ui_user_name = (find_ui_user user).ui_user_name then
+ if user2_is_admin o.conn_user.ui_user then
begin
try
- user2_user_set_dls user (int_of_string dls);
- print_command_result o buf (Printf.sprintf "User %s has now %s
downloads allowed" user (user2_print_user_dls user))
+ 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\tchange number of allowed concurrent downloads";
+ ), "<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_name
- || o.conn_user.ui_user_name = (find_ui_user user).ui_user_name then
+ if user2_is_admin o.conn_user.ui_user
+ || o.conn_user.ui_user.user_name = user then
begin
try
- user2_user_set_commit_dir user dir;
- print_command_result o buf (Printf.sprintf "User %s has new
commit dir %s" user (user2_print_user_commit_dir user))
+ 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_multiple (fun args o ->
+ "groupadd", Arg_two (fun group admin o ->
let buf = o.conn_buf in
- let add_new_group group admin mail =
- if user2_is_admin o.conn_user.ui_user_name then
+ let g_admin =
+ try
+ bool_of_string admin
+ with _ -> false
+ in
+ if user2_is_admin o.conn_user.ui_user then
if user2_group_exists group then
- print_command_result o buf (Printf.sprintf "Group %s already
exists, use groupmod for updates" group)
+ print_command_result o buf (Printf.sprintf "Group %s already
exists" group)
else
begin
- user2_group_add group ?mail:(Some mail) ?admin:(Some admin) ();
+ user2_group_add group g_admin;
print_command_result o buf (Printf.sprintf "Group %s added"
group)
end
else
- print_command_result o buf "You are not allowed to add group"
- in begin
- match args with
- group :: admin :: mail :: _ ->
- let a =
- try
- bool_of_string admin
- with _ -> false
- in
- add_new_group group a mail
- | group :: admin :: _ ->
- let a =
- try
- bool_of_string admin
- with _ -> false
- in
- add_new_group group a ""
- | _ -> print_command_result o buf "Wrong syntax: use 'groupadd group
true|false'"
- end;
+ print_command_result o buf "You are not allowed to add a group";
_s ""
- ), "<group> <admin: true | false> [<mail>] :\t\tadd new mldonkey group";
+ ), "<group> <admin: true | false>: add new mldonkey group";
-(* This does nothing, why is it here?
"groupdel", Arg_one (fun group o ->
let buf = o.conn_buf in
-(* if user2_is_admin o.conn_user.ui_user_name then _s ""
+ 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
- print_command_result o buf "You are not allowed to remove users"; *)
+ 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";
-*)
+
+ "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_name then begin
+ 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\\>
@@ -2993,7 +3090,7 @@
html_mods_table_header buf "sharesTable" "shares" [
( "0", "srh ac", "Click to remove user", "Remove" ) ;
( "0", "srh", "Username", "User" ) ;
- ( "0", "srh ac", "Admin", "Admin" ) ;
+ ( "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" ) ;
@@ -3002,38 +3099,48 @@
( "0", "srh ar", "Download count", "DLs" ) ];
let counter = ref 0 in
- user2_user_iter (fun user ->
+ user2_users_iter (fun user ->
incr counter;
- let u_dls = user2_user_dls_count user.user_name in
+ 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 && (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=\\\"\\\"
- class=\\\"srb\\\"\\>------\\</td\\>";
- Printf.bprintf buf
- "\\<td class=\\\"sr\\\"\\>%s\\</td\\>" user.user_name;
- Printf.bprintf buf
- "\\<td class=\\\"sr ac\\\"\\>%b\\</td\\>" (user2_is_admin
user.user_name);
- Printf.bprintf buf
- "\\<td class=\\\"sr\\\"\\>%s\\</td\\>"
(user2_print_user_groups user.user_name);
- Printf.bprintf buf
- "\\<td class=\\\"sr\\\"\\>%s\\</td\\>"
(user2_print_user_default_group user.user_name);
- Printf.bprintf buf
- "\\<td class=\\\"sr\\\"\\>%s\\</td\\>" (user2_print_user_mail
user.user_name);
- Printf.bprintf buf
- "\\<td class=\\\"sr\\\"\\>%s\\</td\\>"
(user2_print_user_commit_dir user.user_name);
- Printf.bprintf buf
- "\\<td class=\\\"sr ar\\\"\\>%s\\</td\\>"
(user2_print_user_dls user.user_name);
- Printf.bprintf buf
- "\\<td class=\\\"sr ar\\\"\\>%d\\</td\\>" u_dls
+ 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;
@@ -3053,38 +3160,51 @@
\\</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", "Admin group", "Admin" ) ;
- ( "0", "srh", "Mail address", "Email" ) ;
+ ( "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" ) ];
- let counter = ref 0 in
- user2_group_iter (fun group ->
- incr counter;
- let g_dls = user2_group_dls_count group.group_name in
- Printf.bprintf buf "\\<tr class=\\\"%s\\\"\\>"
- (if !counter mod 2 == 0 then "dl-1" else "dl-2");
- if g_dls = 0 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=\\\"\\\"
- class=\\\"srb\\\"\\>------\\</td\\>";
- Printf.bprintf buf
- "\\<td class=\\\"sr\\\"\\>%s\\</td\\>" group.group_name;
- Printf.bprintf buf
- "\\<td class=\\\"sr ac\\\"\\>%b\\</td\\>" group.group_admin;
- Printf.bprintf buf
- "\\<td class=\\\"sr\\\"\\>%s\\</td\\>" group.group_mail;
- Printf.bprintf buf
- "\\<td class=\\\"sr ar\\\"\\>%d\\</td\\>" g_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");
+
+ 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\\>";
@@ -3115,57 +3235,117 @@
) list
) list
end
- else
- begin
- Printf.bprintf buf "Users:\n";
- user2_user_iter (fun user ->
- Printf.bprintf buf " %s\n"
- user.user_name);
- Printf.bprintf buf "\nGroup:\n";
- user2_group_iter (fun group ->
- Printf.bprintf buf " %s\n"
- group.group_name);
- end;
+ 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 (String.concat " "
(user2_user_groups_safe o.conn_user.ui_user_name));
+ 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_name);
+ 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
- try
+ begin try
let file = file_find num in
- if set_file_group_safe file o.conn_user.ui_user_name (if
(String.lowercase group) = "none" then None else Some group) then
- Printf.sprintf (_b "Changed group of download %d to %s") num group
+ 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
- Printf.sprintf (_b "Could not change group of download %d to %s")
num group
- with e -> Printf.sprintf (_b "No file number %d, error %s") num
(Printexc2.to_string e)
- ), "<group> \"<num>\" :\t\tchange group of download <num> to <group>,
group = none for private file";
+ 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 new_owner filenum o ->
+ "chown", Arg_two (fun user filenum o ->
let num = int_of_string filenum in
+ begin
try
let file = file_find num in
- if set_file_owner_safe file o.conn_user.ui_user_name new_owner then
- Printf.sprintf (_b "Changed owner of download %d to %s") num
new_owner
+ 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
- Printf.sprintf (_b "Could not change owner of download %d to %s")
num new_owner
- with e -> Printf.sprintf (_b "No file number %d, error %s") num
(Printexc2.to_string e)
- ), "<user> \"<num>\" :\t\tchange owner of download <num> to <user>";
+ 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>";
]
Index: src/daemon/driver/driverControlers.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverControlers.ml,v
retrieving revision 1.91
retrieving revision 1.92
diff -u -b -r1.91 -r1.92
--- src/daemon/driver/driverControlers.ml 25 Oct 2006 11:12:38 -0000
1.91
+++ src/daemon/driver/driverControlers.ml 9 Nov 2006 21:32:26 -0000
1.92
@@ -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
@@ -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;
@@ -955,7 +955,7 @@
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;
@@ -1006,15 +1006,15 @@
"VDC" ->
let num = int_of_string value in
let file = file_find num in
- file_cancel file o.conn_user.ui_user_name
+ 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 o.conn_user.ui_user_name
+ 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 o.conn_user.ui_user_name
+ file_resume file o.conn_user.ui_user
| _ -> ()
) r.get_url.Url.args;
@@ -1099,7 +1099,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 -> ())
@@ -1271,7 +1271,7 @@
try
let num = int_of_string value in
let r = find_result num in
- let files = result_download r [] false
o.conn_user.ui_user_name in
+ let files = result_download r [] false
o.conn_user.ui_user in
List.iter CommonInteractive.start_download files;
let module M = CommonMessages in
@@ -1291,23 +1291,23 @@
"cancel" ->
let num = int_of_string value in
let file = file_find num in
- file_cancel file o.conn_user.ui_user_name
+ 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 o.conn_user.ui_user_name
+ 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 o.conn_user.ui_user_name
+ 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_name
+ 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_name
+ set_file_release file false o.conn_user.ui_user
| "sortby" ->
begin
match value with
@@ -1327,13 +1327,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 (user2_filter_files !!files
o.conn_user.ui_user_name) 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))
@@ -1348,7 +1350,7 @@
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 o.conn_user.ui_user_name));
+ 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')
@@ -1403,7 +1405,7 @@
| [ "setoption", _ ; "option", name; "value", value ] ->
html_open_page buf t r true;
- if user2_is_admin o.conn_user.ui_user_name 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"
Index: src/daemon/driver/driverInteractive.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverInteractive.ml,v
retrieving revision 1.112
retrieving revision 1.113
diff -u -b -r1.112 -r1.113
--- src/daemon/driver/driverInteractive.ml 25 Oct 2006 11:12:38 -0000
1.112
+++ src/daemon/driver/driverInteractive.ml 9 Nov 2006 21:32:26 -0000
1.113
@@ -54,7 +54,7 @@
let warning =
"SECURITY WARNING: user admin has an empty password, use command: useradd
admin password\n"
in
- if empty_password admin_user && !!allowed_ips <>
+ 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;
@@ -674,8 +674,16 @@
"\\<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
@@ -712,13 +720,16 @@
[|
(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)\\\"\\>"
+
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 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)
+ (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
@@ -796,6 +807,9 @@
(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)));
@@ -943,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
[|
@@ -960,6 +974,8 @@
"$nNum";
"Rele";
"Comm";
+ "User";
+ "Group";
"File";
" %";
" Done";
@@ -1006,6 +1022,8 @@
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)
@@ -1124,6 +1142,8 @@
| 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)
| NotSorted -> raise Not_found
in
Sort.list sorter list
@@ -1945,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")
);
Index: src/daemon/driver/driverInterface.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverInterface.ml,v
retrieving revision 1.55
retrieving revision 1.56
diff -u -b -r1.55 -r1.56
--- src/daemon/driver/driverInterface.ml 6 Oct 2006 15:57:18 -0000
1.55
+++ src/daemon/driver/driverInterface.ml 9 Nov 2006 21:32:26 -0000
1.56
@@ -246,7 +246,7 @@
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_name (file_owner file)
(file_group file) then
+ 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
@@ -431,7 +431,7 @@
(File_add_source_event (file,c))
:: gui.gui_events.gui_new_events
) sources
- ) (user2_filter_files !!files gui.gui_conn.conn_user.ui_user_name);
+ ) (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;
@@ -461,7 +461,7 @@
end
);
- if user2_can_view_uploads gui.gui_conn.conn_user.ui_user_name then
+ 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
);
@@ -470,11 +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_name then
+ 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_name then
+ 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
@@ -482,7 +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_name then
+ 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 ->
@@ -492,7 +492,7 @@
) (sections downloads_ini);
(* Options panels defined in users.ini *)
- 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
List.iter (fun s ->
let section = section_name s in
List.iter (fun o ->
@@ -502,7 +502,7 @@
) (sections users_ini);
(* Options panels defined in each plugin *)
- 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
networks_iter_all (fun r ->
let prefix = r.network_shortname ^ "-" in
List.iter (fun file ->
@@ -564,7 +564,7 @@
(File_add_source_event (file,c))
:: gui.gui_events.gui_new_events
) (file_active_sources file)
- ) (user2_filter_files !!files gui.gui_conn.conn_user.ui_user_name);
+ ) (user2_filter_files !!files gui.gui_conn.conn_user.ui_user);
end
@@ -623,7 +623,7 @@
) list
| P.SetOption (name, value) ->
- 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.set_fully_qualified_options name value
else
begin
@@ -654,7 +654,7 @@
end
| P.EnableNetwork (num, bool) ->
- 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
let n = network_find_by_num num in
if n.op_network_is_enabled () <> bool then
(try
@@ -681,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
@@ -731,7 +731,7 @@
| P.Download_query (filenames, num, force) ->
let r = find_result num in
- let files = result_download r filenames force
gui.gui_conn.conn_user.ui_user_name 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 ->
@@ -742,7 +742,7 @@
if not (networks_iter_until_true
(fun n ->
try
- let s,r = network_parse_url n url
gui.gui_conn.conn_user.ui_user_name 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);
@@ -776,13 +776,13 @@
query_networks url
| P.GetUploaders ->
- if user2_can_view_uploads gui.gui_conn.conn_user.ui_user_name
then
+ 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_name
then
+ 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)))
@@ -791,13 +791,13 @@
server_remove (server_find num)
| P.SaveOptions_query list ->
- 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
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) gui.gui_conn.conn_user.ui_user_name
+ file_cancel (file_find num) gui.gui_conn.conn_user.ui_user
| P.ViewUsers num ->
let s = server_find num in
@@ -881,7 +881,7 @@
client_connect c
| P.DisconnectClient num ->
- if user2_can_view_uploads gui.gui_conn.conn_user.ui_user_name
then
+ if user2_can_view_uploads gui.gui_conn.conn_user.ui_user then
let c = client_find num in
client_disconnect c
@@ -919,9 +919,9 @@
| P.SwitchDownload (num, resume) ->
let file = file_find num in
if resume then
- file_resume file gui.gui_conn.conn_user.ui_user_name
+ file_resume file gui.gui_conn.conn_user.ui_user
else
- file_pause file gui.gui_conn.conn_user.ui_user_name
+ file_pause file gui.gui_conn.conn_user.ui_user
| P.FindFriend user ->
networks_iter (fun n ->
@@ -1040,7 +1040,7 @@
| NetworkMessage (num, s) ->
let n = network_find_by_num num in
- n.op_network_gui_message s gui.gui_conn.conn_user.ui_user_name
+ 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
@@ -1050,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_name
then
+ if user2_can_view_uploads gui.gui_conn.conn_user.ui_user then
shared_iter (fun s ->
update_shared_info s;
)
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 -b -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/guiUsers.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/gtk2/gui/guiUsers.ml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -b -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/bTGlobals.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTGlobals.ml,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -b -r1.70 -r1.71
--- src/networks/bittorrent/bTGlobals.ml 26 Oct 2006 13:18:42 -0000
1.70
+++ src/networks/bittorrent/bTGlobals.ml 9 Nov 2006 21:32:27 -0000
1.71
@@ -290,7 +290,7 @@
} and file_impl = {
dummy_file_impl with
impl_file_owner = user;
- impl_file_group = CommonUserDb.user2_user_default_group 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;
@@ -356,7 +356,7 @@
} and file_impl = {
dummy_file_impl with
impl_file_owner = user;
- impl_file_group = CommonUserDb.user2_user_default_group user;
+ impl_file_group = user.user_default_group;
impl_file_fd = None;
impl_file_size = zero;
impl_file_downloaded = Int64.zero;
Index: src/networks/bittorrent/bTInteractive.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTInteractive.ml,v
retrieving revision 1.120
retrieving revision 1.121
diff -u -b -r1.120 -r1.121
--- src/networks/bittorrent/bTInteractive.ml 26 Oct 2006 13:18:42 -0000
1.120
+++ src/networks/bittorrent/bTInteractive.ml 9 Nov 2006 21:32:27 -0000
1.121
@@ -733,13 +733,16 @@
if not (Unix2.is_directory file) then
try
let user = fst (Unix32.owner file) in
- load_torrent_file file (if not (CommonUserDb.user2_user_exist user) then
CommonUserDb.admin_user else user);
+ 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 () =
@@ -1007,14 +1010,14 @@
), _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_name then begin
+ 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 CommonUserDb.print_command_result o o.conn_buf "You are not
allowed to use seeded_torrents";
+ 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";
@@ -1051,13 +1054,13 @@
let buf = o.conn_buf in
if Sys.file_exists url then
begin
- load_torrent_file url o.conn_user.ui_user_name;
+ 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 o.conn_user.ui_user_name)
in
+ let result = fst (op_network_parse_url url o.conn_user.ui_user) in
Printf.bprintf buf "%s\n" result
end;
_s ""
Index: src/networks/donkey/donkeyGlobals.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyGlobals.ml,v
retrieving revision 1.102
retrieving revision 1.103
diff -u -b -r1.102 -r1.103
--- src/networks/donkey/donkeyGlobals.ml 31 Oct 2006 15:40:06 -0000
1.102
+++ src/networks/donkey/donkeyGlobals.ml 9 Nov 2006 21:32:27 -0000
1.103
@@ -400,7 +400,7 @@
and file_impl = {
dummy_file_impl with
impl_file_owner = user;
- impl_file_group = CommonUserDb.user2_user_default_group user;
+ impl_file_group = user.user_default_group;
impl_file_val = file;
impl_file_ops = file_ops;
impl_file_age = last_time ();
Index: src/networks/donkey/donkeyInteractive.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyInteractive.ml,v
retrieving revision 1.133
retrieving revision 1.134
diff -u -b -r1.133 -r1.134
--- src/networks/donkey/donkeyInteractive.ml 31 Oct 2006 15:40:06 -0000
1.133
+++ src/networks/donkey/donkeyInteractive.ml 9 Nov 2006 21:32:27 -0000
1.134
@@ -323,7 +323,7 @@
(* 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 (Printf.sprintf (_b "File is already
in download queue of %s") (file_owner (as_file file))))
+ 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
@@ -788,7 +788,7 @@
"<port> :\t\t\t\tchange connection port";
"scan_temp", Arg_none (fun o ->
- if CommonUserDb.user2_is_admin o.conn_user.ui_user_name then begin
+ 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
@@ -888,17 +888,17 @@
if use_html_mods o then Printf.bprintf buf "\\</table\\>\\</div\\>";
"" end
else begin
- CommonUserDb.print_command_result o o.conn_buf "You are not allowed
to use scan_temp";
+ 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 ->
- if CommonUserDb.user2_is_admin o.conn_user.ui_user_name then begin
+ if CommonUserDb.user2_is_admin o.conn_user.ui_user then begin
DonkeySources.print o.conn_buf o.conn_output;
"" end
else begin
- CommonUserDb.print_command_result o o.conn_buf "You are not allowed
to list sources";
+ print_command_result o o.conn_buf "You are not allowed to list
sources";
"" end
), ":\t\t\t\tshow sources currently known";
@@ -931,7 +931,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 o.conn_user.ui_user_name 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";
Index: src/networks/fasttrack/fasttrackGlobals.ml
===================================================================
RCS file:
/sources/mldonkey/mldonkey/src/networks/fasttrack/fasttrackGlobals.ml,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -b -r1.42 -r1.43
--- src/networks/fasttrack/fasttrackGlobals.ml 19 Sep 2006 17:07:43 -0000
1.42
+++ src/networks/fasttrack/fasttrackGlobals.ml 9 Nov 2006 21:32:27 -0000
1.43
@@ -294,7 +294,7 @@
impl_file_size = file_size;
impl_file_downloaded = Int64.zero;
impl_file_owner = user;
- impl_file_group = CommonUserDb.user2_user_default_group user;
+ impl_file_group = user.user_default_group;
impl_file_val = file;
impl_file_ops = file_ops;
impl_file_age = last_time ();
Index: src/networks/fileTP/fileTPGlobals.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/fileTP/fileTPGlobals.ml,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -b -r1.29 -r1.30
--- src/networks/fileTP/fileTPGlobals.ml 19 Sep 2006 17:07:43 -0000
1.29
+++ src/networks/fileTP/fileTPGlobals.ml 9 Nov 2006 21:32:27 -0000
1.30
@@ -153,7 +153,7 @@
} and file_impl = {
dummy_file_impl with
impl_file_owner = user;
- impl_file_group = CommonUserDb.user2_user_default_group user;
+ impl_file_group = user.user_default_group;
impl_file_fd = Some t;
impl_file_size = zero;
impl_file_downloaded = zero;
Index: src/networks/fileTP/fileTPInteractive.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/fileTP/fileTPInteractive.ml,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -b -r1.50 -r1.51
--- src/networks/fileTP/fileTPInteractive.ml 1 Oct 2006 17:54:00 -0000
1.50
+++ src/networks/fileTP/fileTPInteractive.ml 9 Nov 2006 21:32:27 -0000
1.51
@@ -311,8 +311,8 @@
"http", "Network/FileTP", Arg_multiple (fun args o ->
try
(match args with
- url :: [referer] -> download_file url referer
o.conn_user.ui_user_name
- | [url] -> download_file url "" o.conn_user.ui_user_name
+ 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
Index: src/networks/gnutella/gnutellaGlobals.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/gnutella/gnutellaGlobals.ml,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -b -r1.43 -r1.44
--- src/networks/gnutella/gnutellaGlobals.ml 19 Sep 2006 17:07:43 -0000
1.43
+++ src/networks/gnutella/gnutellaGlobals.ml 9 Nov 2006 21:32:27 -0000
1.44
@@ -330,7 +330,7 @@
impl_file_size = file_size;
impl_file_downloaded = Int64.zero;
impl_file_owner = user;
- impl_file_group = CommonUserDb.user2_user_default_group user;
+ impl_file_group = user.user_default_group;
impl_file_val = file;
impl_file_ops = file_ops;
impl_file_age = last_time ();
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 -b -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 -b -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
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Mldonkey-commits] mldonkey distrib/ChangeLog docs/multiuser.txt s...,
mldonkey-commits <=