[Pkg-ocaml-maint-commits] r1463 - in
trunk/packages/mldonkey/trunk/debian: . utils xml-man
Sylvain LE GALL
gildor-guest at costa.debian.org
Wed Jul 20 21:06:16 UTC 2005
Author: gildor-guest
Date: 2005-07-20 21:06:16 +0000 (Wed, 20 Jul 2005)
New Revision: 1463
Modified:
trunk/packages/mldonkey/trunk/debian/TODO
trunk/packages/mldonkey/trunk/debian/utils/common_options.ml
trunk/packages/mldonkey/trunk/debian/utils/mldonkey_users.ml
trunk/packages/mldonkey/trunk/debian/xml-man/Makefile
trunk/packages/mldonkey/trunk/debian/xml-man/mldonkey_files.xml
trunk/packages/mldonkey/trunk/debian/xml-man/mldonkey_users.xml
Log:
Add options required to extract users section from downloads.ini -- SLG
Modified: trunk/packages/mldonkey/trunk/debian/TODO
===================================================================
--- trunk/packages/mldonkey/trunk/debian/TODO 2005-07-18 23:19:31 UTC (rev 1462)
+++ trunk/packages/mldonkey/trunk/debian/TODO 2005-07-20 21:06:16 UTC (rev 1463)
@@ -29,4 +29,3 @@
* Split downloads.ini in users.ini
* Handle the fasttrack split in postinst
-
Modified: trunk/packages/mldonkey/trunk/debian/utils/common_options.ml
===================================================================
--- trunk/packages/mldonkey/trunk/debian/utils/common_options.ml 2005-07-18 23:19:31 UTC (rev 1462)
+++ trunk/packages/mldonkey/trunk/debian/utils/common_options.ml 2005-07-20 21:06:16 UTC (rev 1463)
@@ -31,18 +31,17 @@
()
in
print_value vl
-
-let save_option filename fl =
- let file = open_out filename
- in
+;;
+
+let output_option chn fl =
let rec save_one_option f =
match f with
Comment(s,tl_f) ->
- Printf.fprintf file "%s\n\n" s;
+ Printf.fprintf chn "%s\n\n" s;
save_one_option tl_f
| Options(v,tl_f) ->
save_var v;
- Printf.fprintf file "\n";
+ Printf.fprintf chn "\n";
save_one_option tl_f
| Eof ->
()
@@ -50,34 +49,34 @@
save_var v =
match v with
StringId(s,o) ->
- Printf.fprintf file "\"%s\" = " s;
+ Printf.fprintf chn "\"%s\" = " s;
save_value o;
- Printf.fprintf file "\n"
+ Printf.fprintf chn "\n"
| Id(s,o) ->
- Printf.fprintf file "%s = " s;
+ Printf.fprintf chn "%s = " s;
save_value o;
- Printf.fprintf file "\n"
+ Printf.fprintf chn "\n"
and
save_value v =
match v with
ValModule(f) ->
- Printf.fprintf file "{\n";
+ Printf.fprintf chn "{\n";
save_one_option f;
- Printf.fprintf file "}"
+ Printf.fprintf chn "}"
| ValInt(i) ->
- Printf.fprintf file "%s" (Int64.to_string i);
+ Printf.fprintf chn "%s" (Int64.to_string i);
| ValFloat(f) ->
- Printf.fprintf file "%f" f;
+ Printf.fprintf chn "%f" f;
| ValList(lst) ->
- Printf.fprintf file "[\n";
+ Printf.fprintf chn "[\n";
save_list lst;
- Printf.fprintf file "]"
+ Printf.fprintf chn "]"
| ValString(s) ->
- Printf.fprintf file "\"%s\"" s
+ Printf.fprintf chn "\"%s\"" s
| ValChar(s) ->
- Printf.fprintf file "'%s'" s
+ Printf.fprintf chn "'%s'" s
| ValIdent(s) ->
- Printf.fprintf file "%s" s
+ Printf.fprintf chn "%s" s
and
save_list l =
match l with
@@ -85,50 +84,55 @@
save_value itm
| itm :: tl_lst ->
save_value itm;
- Printf.fprintf file ";\n";
+ Printf.fprintf chn ";\n";
save_list tl_lst
| [] ->
()
in
- save_one_option fl;
- close_out file
-
+ save_one_option fl
+;;
-
+let save_option filename fl =
+ let chn = open_out filename
+ in
+ output_option chn fl;
+ close_out chn
+;;
+
let load_option filename =
let file = open_in filename
in
let lexbuf = Lexing.from_channel file
in
try
- lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with
- pos_fname = filename;
- pos_lnum = 1;
- pos_bol = 0;
- };
- let res = Parse_options.main Lexer_options.token lexbuf
- in
- close_in file;
- res
+ lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with
+ pos_fname = filename;
+ pos_lnum = 1;
+ pos_bol = 0;
+ };
+ let res = Parse_options.main Lexer_options.token lexbuf
+ in
+ close_in file;
+ res
with
- Parsing.Parse_error
- | Failure "int_of_string" ->
- let start_position =
- Lexing.lexeme_start_p lexbuf
- in
- let end_position =
- Lexing.lexeme_end_p lexbuf
- in
- Printf.fprintf stderr
- ( "Unable to parse file: %s\n"
- ^^"Last word seen : %S\n"
- ^^"Position : line %d, char. %d-%d\n" )
- (start_position.pos_fname)
- (Lexing.lexeme lexbuf)
- (start_position.pos_lnum)
- (start_position.pos_cnum - start_position.pos_bol)
- (end_position.pos_cnum - start_position.pos_bol);
- raise Parsing.Parse_error
+ Parsing.Parse_error
+ | Failure "int_of_string" ->
+ let start_position =
+ Lexing.lexeme_start_p lexbuf
+ in
+ let end_position =
+ Lexing.lexeme_end_p lexbuf
+ in
+ Printf.fprintf stderr
+ ( "Unable to parse file: %s\n"
+ ^^"Last word seen : %S\n"
+ ^^"Position : line %d, char. %d-%d\n" )
+ (start_position.pos_fname)
+ (Lexing.lexeme lexbuf)
+ (start_position.pos_lnum)
+ (start_position.pos_cnum - start_position.pos_bol)
+ (end_position.pos_cnum - start_position.pos_bol);
+ raise Parsing.Parse_error
;;
let parse_option str =
@@ -145,8 +149,8 @@
"-" ^ (string_of_int (Lexing.lexeme_end lexbuf)));
print_newline ();
raise Parsing.Parse_error
+;;
-
let rec find_option id fl =
match fl with
Comment(_,f) ->
@@ -160,39 +164,43 @@
| Eof ->
raise Not_found
-let replace_option (op:options) fl =
+let replace_option op fl =
let rec replace_one_option id vl is_replaced f =
match f with
- Comment(s,f) ->
- Comment(s,(replace_one_option id vl is_replaced f))
- | Options(StringId(x,opv),f) ->
- let (nvl,replaced) =
- if x = id then
- (vl,true)
- else
- (opv,is_replaced)
- in
- Options(StringId(x,nvl), replace_one_option id vl replaced f)
- | Options(Id(x,opv), f) ->
- let (nvl,replaced) =
- if x = id then
- (vl,true)
- else
- (opv,is_replaced)
- in
- Options(Id(x,nvl), replace_one_option id vl replaced f)
+ Comment(s,f) ->
+ Comment(s,(replace_one_option id vl is_replaced f))
+ | Options(StringId(x,opv),f) when x = id ->
+ Options(StringId(x,vl), replace_one_option id vl true f)
+ | Options(Id(x,opv),f) when x = id ->
+ Options(Id(x,vl), replace_one_option id vl true f)
+ | Options(x,f) ->
+ Options(x, replace_one_option id vl is_replaced f)
+ | Eof when not is_replaced ->
+ Options(op, Eof)
| Eof ->
- if not is_replaced then
- Options(op, Eof)
- else
Eof
in
let (nid,nvl) =
match op with
StringId(x,opv)
| Id(x,opv) ->
- (x,opv)
+ (x,opv)
in
replace_one_option nid nvl false fl
+;;
-
+let remove_option id fl =
+ let rec remove_one_option id fl =
+ match fl with
+ Comment(s,nfl) ->
+ Comment(s,(remove_one_option id nfl))
+ | Options(StringId(x,_),nfl)
+ | Options(Id(x,_), nfl) when x = id ->
+ remove_one_option id nfl
+ | Options(x, nfl) ->
+ Options(x, remove_one_option id nfl)
+ | Eof ->
+ Eof
+ in
+ remove_one_option id fl
+;;
Modified: trunk/packages/mldonkey/trunk/debian/utils/mldonkey_users.ml
===================================================================
--- trunk/packages/mldonkey/trunk/debian/utils/mldonkey_users.ml 2005-07-18 23:19:31 UTC (rev 1462)
+++ trunk/packages/mldonkey/trunk/debian/utils/mldonkey_users.ml 2005-07-20 21:06:16 UTC (rev 1463)
@@ -6,20 +6,19 @@
| Add of string * (string option)
| Del of string
| List
+ | TestUsersSection
+ | DumpUsersSection
+ | StripUsersSection
exception No_downloads_ini
exception Invalid_format
let encrypt x = Md4.Md4.to_string (Md4.Md4.string x)
+;;
let empty_password = ""
+;;
-module MapString = Map.Make
-( struct
- type t = string
- let compare = compare
-end )
-
let _ =
let action = ref List
in
@@ -30,51 +29,61 @@
let quiet = ref false
in
let _ = Arg.parse [
- ("--add", Arg.String ( fun x -> action := Add (x,None) ),
- "Add the specified user, prompt or use password set with -p");
- ("--del", Arg.String ( fun x -> action := Del (x) ),
- "Delete the specified user");
- ("--check", Arg.String ( fun x -> action := Check (x,None) ),
- "Check if specified user has an empty password, a password specified with -p or exist");
- ("--list", Arg.Unit ( fun () -> action := List ),
- "List all user");
+ ("--add", Arg.String (fun x -> action := Add (x,None)),
+ "Add the specified user, prompt or use password set with -p.");
+ ("--del", Arg.String (fun x -> action := Del (x) ),
+ "Delete the specified user.");
+ ("--check", Arg.String (fun x -> action := Check (x,None)),
+ "Check if specified user has an empty password, a password specified with"
+ ^" -p or exist.");
+ ("--list", Arg.Unit (fun () -> action := List),
+ "List all users.");
+ ("--test-users-section", Arg.Unit (fun () -> action := TestUsersSection),
+ "Check the presence of a users section.");
+ ("--dump-users-section", Arg.Unit (fun () -> action := DumpUsersSection),
+ "Print the users section.");
+ ("--strip-users-section", Arg.Unit (fun () -> action := StripUsersSection),
+ "Print the specified file without the users section.");
("-f", Arg.String ( fun x -> filename := Some x ),
- "Which downloads.ini to use");
+ "Which downloads.ini to use.");
("-p", Arg.String ( fun x -> password := Some x ),
- "Set the password");
+ "Set the password.");
("-q", Arg.Set quiet,
- "Run quietly");
+ "Run quietly.");
]
( fun _ -> () )
"Usage mldonkey_users [options] where options are :"
in
let real_action =
match (!action,!password) with
- ( List, _ ) -> List
- | ( Del x, _ ) -> Del x
- | ( Add( x, _ ), y ) -> Add ( x, y )
- | ( Check( x, _ ), y ) -> Check ( x, y )
+ (List, _) -> List
+ | (Del x, _) -> Del x
+ | (Add(x, _), y) -> Add ( x, y )
+ | (Check(x, _), y) -> Check ( x, y )
+ | (TestUsersSection, _) -> TestUsersSection
+ | (DumpUsersSection, _) -> DumpUsersSection
+ | (StripUsersSection, _) -> StripUsersSection
in
let file =
match !filename with
- Some(x) ->
+ Some(x) ->
x
| None ->
raise No_downloads_ini
in
- let users =
- let add_one_user map users_option_entry =
+ let load_users file =
+ let add_one_user lst users_option_entry =
match users_option_entry with
- ValList([ValString(user);ValString(password)])
- |ValList([ValString(user); ValChar(password)])
- |ValList([ValString(user); ValIdent(password)])
- |ValList([ ValChar(user);ValString(password)])
- |ValList([ ValChar(user); ValChar(password)])
- |ValList([ ValChar(user); ValIdent(password)])
- |ValList([ ValIdent(user);ValString(password)])
- |ValList([ ValIdent(user); ValChar(password)])
- |ValList([ ValIdent(user); ValIdent(password)]) ->
- MapString.add user password map
+ ValList([ValString(user);ValString(password)])
+ | ValList([ValString(user); ValChar(password)])
+ | ValList([ValString(user); ValIdent(password)])
+ | ValList([ ValChar(user);ValString(password)])
+ | ValList([ ValChar(user); ValChar(password)])
+ | ValList([ ValChar(user); ValIdent(password)])
+ | ValList([ ValIdent(user);ValString(password)])
+ | ValList([ ValIdent(user); ValChar(password)])
+ | ValList([ ValIdent(user); ValIdent(password)]) ->
+ (user,password)::lst
| _ ->
raise Invalid_format
in
@@ -86,15 +95,15 @@
in
match users_option with
ValList lst ->
- List.fold_left add_one_user MapString.empty lst
+ List.fold_left add_one_user [] lst
| _ ->
raise Invalid_format
in
- let save_users new_users =
- let save_one_user user password other_users =
+ let save_users file new_users =
+ let save_one_user other_users (user,password) =
ValList([ ValIdent(user);ValString(password)]) :: other_users
in
- let all_users = MapString.fold save_one_user new_users []
+ let all_users = List.fold_left save_one_user [] new_users
in
let new_option =
Id ("users", ValList(all_users))
@@ -105,58 +114,48 @@
if !quiet then
()
else
- begin
- print_string x;
- print_newline ()
- end
+ (
+ print_string x;
+ print_newline ()
+ )
in
+ let fatal x =
+ debug x;
+ exit 1
+ in
match real_action with
- List ->
- begin
- MapString.iter ( fun x y -> print_string x; print_newline () ) users;
- exit 0
- end
+ List ->
+ List.iter (fun (x,y) -> print_string x; print_newline ())
+ (load_users file)
| Check(user,Some(password)) ->
begin
try
- let real_password = MapString.find user users
+ let real_password = List.assoc user (load_users file)
in
if real_password = ( encrypt password ) then
- begin
- debug "Found matching user"; exit 0
- end
+ debug "Found matching user"
else
- begin
- debug "User exists but bad password"; exit 1
- end
+ fatal "User exists but bad password"
with Not_found ->
- begin
- debug "User not found"; exit 1
- end
+ fatal "User not found"
end
| Check(user,None) ->
begin
try
- let real_password = MapString.find user users
+ let real_password = List.assoc user (load_users file)
in
if real_password = ( encrypt empty_password ) then
- begin
- debug "This user has an empty password"; exit 1
- end
+ fatal "This user has an empty password"
else
- begin
- debug "This user has a good password"; exit 0
- end
+ debug "This user has a good password"
with Not_found ->
- begin
- debug "User not found"; exit 1
- end
+ fatal "User not found"
end
| Add(user,Some(password)) ->
- begin
- save_users (MapString.add user ( encrypt password ) users);
- exit 0
- end
+ save_users file (
+ (user,encrypt password)
+ ::(List.remove_assoc user (load_users file))
+ )
| Add(user,None) ->
begin
let password =
@@ -168,22 +167,44 @@
read_line ()
in
if password = confirm_password then
- begin
- save_users ( MapString.add user ( encrypt password ) users);
- debug "New user/password saved"; exit 0
- end
+ (
+ save_users file (
+ (user,encrypt password)
+ ::(List.remove_assoc user (load_users file))
+ );
+ debug "New user/password saved"
+ )
else
- begin
- debug "Password and confirmation do not match"; exit 1
- end
+ fatal "Password and confirmation do not match"
end
| Del(user) ->
begin
try
- save_users ( MapString.remove user users );
- exit 0
+ save_users file (List.remove_assoc user (load_users file));
with Not_found ->
+ fatal "User not found"
+ end
+ | TestUsersSection ->
begin
- debug "User not found"; exit 1
+ try
+ let _ = find_option "users" (load_option file)
+ in
+ ()
+ with Not_found ->
+ fatal "Cannot find users section"
end
- end
+ | DumpUsersSection ->
+ begin
+ try
+ let users_section = find_option "users" (load_option file)
+ in
+ output_option stdout (Options(Id("users",users_section), Eof))
+ with Not_found ->
+ fatal "Cannot find users section"
+ end
+ | StripUsersSection ->
+ begin
+ let stripped_options = remove_option "users" (load_option file)
+ in
+ output_option stdout stripped_options
+ end
Modified: trunk/packages/mldonkey/trunk/debian/xml-man/Makefile
===================================================================
--- trunk/packages/mldonkey/trunk/debian/xml-man/Makefile 2005-07-18 23:19:31 UTC (rev 1462)
+++ trunk/packages/mldonkey/trunk/debian/xml-man/Makefile 2005-07-20 21:06:16 UTC (rev 1463)
@@ -5,4 +5,4 @@
all: mlgui.1 mlguistarter.1 mlnet.1 mldonkey_options.1 mldonkey_server.1 mldonkey_command.1 mldonkey_submit.1 mldonkey_users.1 mldonkey_files.1 mldonkey_create_chroot.1
clean:
- rm -rf *.1
+ rm -rf *.1 *.8
Modified: trunk/packages/mldonkey/trunk/debian/xml-man/mldonkey_files.xml
===================================================================
--- trunk/packages/mldonkey/trunk/debian/xml-man/mldonkey_files.xml 2005-07-18 23:19:31 UTC (rev 1462)
+++ trunk/packages/mldonkey/trunk/debian/xml-man/mldonkey_files.xml 2005-07-20 21:06:16 UTC (rev 1463)
@@ -27,6 +27,7 @@
&dhprg;
<option>--join</option>
<option>--split<arg>network_name</arg></option>
+ <option>--test<arg>network_name</arg></option>
<option>-f0<arg>file</arg></option>
<option>-f1<arg>file</arg></option>
<option>-f2<arg>file</arg></option>
@@ -95,10 +96,12 @@
<varlistentry>
<term><option>--test <arg>network_name</arg></option></term>
<listitem>
- <para>This command will search file source entry
- concerning the network <arg>network_name</arg> in the
- <option>-f0</option> file. If one file comes from the
- given network, the exit code will be 0 else 1.
+ <para>
+ This command will search file source entry
+ concerning the network <arg>network_name</arg> in the
+ <option>-f0</option> file. If one file comes from the
+ given network, the exit code will be 0 else 1.
+ </para>
</listitem>
</varlistentry>
Modified: trunk/packages/mldonkey/trunk/debian/xml-man/mldonkey_users.xml
===================================================================
--- trunk/packages/mldonkey/trunk/debian/xml-man/mldonkey_users.xml 2005-07-18 23:19:31 UTC (rev 1462)
+++ trunk/packages/mldonkey/trunk/debian/xml-man/mldonkey_users.xml 2005-07-20 21:06:16 UTC (rev 1463)
@@ -29,6 +29,9 @@
<option>--del <arg>name</arg></option>
<option>--check <arg>name</arg></option>
<option>--list</option>
+ <option>--test-users-section</option>
+ <option>--dump-users-section</option>
+ <option>--strip-users-section</option>
<option>-p <arg>password</arg></option>
<option>-f <arg>file</arg></option>
<option>-q</option>
@@ -99,10 +102,41 @@
<para>List all user managed by the file used.</para>
</listitem>
</varlistentry>
+ <varlistentry>
+ <term><option>--test-users-section</option></term>
+ <listitem>
+ <para>
+ Check for the presence of a users section. If a users section is found
+ in the given file, exit with an error code of 0 else exit with an error
+ code of 1.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><option>--dump-users-section</option></term>
+ <listitem>
+ <para>
+ Print on the standard output the users section.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><option>--strip-users-section</option></term>
+ <listitem>
+ <para>
+ Print on the standard output all the given file, without the users
+ section.
+ </para>
+ </listitem>
+ </varlistentry>
</variablelist>
- <para>The action <option>--add</option>, <option>--del</option>, <option>--check</option> and
- <option>--list</option> are exclusive. You can only perform one at the same time.</para>
+ <para>
+ The action <option>--add</option>, <option>--del</option>, <option>--check</option>,
+ <option>--list</option>, <option>--test-users-section</option>,
+ <option>--dump-users-section</option> and <option>--strip-users-section</option>
+ are exclusive. You can only perform one at the same time.
+ </para>
</refsect1>
@@ -123,6 +157,11 @@
empty string, an error code of 1 is returned. Otherwise, it returns an error code of 0 ( no
error )</para>
+ <para>
+ During <option>--test-users-section</option>, if a section if found an error code of 0 is returned.
+ Otherwise an error code of 1 is returned.
+ </para>
+
</refsect1>
&author;
More information about the Pkg-ocaml-maint-commits
mailing list