Context Navigation

ladmin @ 10

Revision 1, 150.1 kB (checked in by jinshiro, 17 years ago)

Line
1	#!/usr/bin/perl
2	use POSIX;
3	##########################################################################
4	# EAthena login-server remote administration tool
5	# New ladamin by [Yor]
6	##########################################################################
7	#-------------------------------INSTRUCTIONS------------------------------
8	# Set the 4 variables below:
9	# IP of the login server.
10	# Port where the login-server listens incoming packets.
11	# Password of administration (same of config_athena.conf).
12	# Displayed language of the sofware (if not correct, english is used).
13	# IMPORTANT:
14	# Be sure that you authorize remote administration in login-server
15	# (see login_athena.conf, 'admin_state' parameter)
16	#-------------------------------------------------------------------------
17	my($loginserverip) = "127.0.0.1"; # IP of login-server
18	my($loginserverport) = 6900; # Port of login-server
19	my($loginserveradminpassword) = "admin"; # Administration password
20	my($connecttimeout) = 10; # Timeout of connection (in seconds)
21	my($passenc) = 2; # Encoding type of the password
22	my($defaultlanguage) = "E"; # Default language (F: Français/E: English)
23	# (if it's not 'F', default is English)
24
25	#-------------------------------------------------------------------------
26	# LIST of COMMANDs that you can type at the prompt:
27	# To use these commands you can only type only the first letters.
28	# You must type a minimum of letters (you can not type 'a',
29	# because ladmin doesn't know if it's for 'aide' or for 'add')
30	# <Example> q <= quit, li <= list, pass <= passwd, etc.
31	#
32	# Note: every time you must give a account_name, you can use "" or '' (spaces can be included)
33	#
34	# aide/help/?
35	# Display the description of the commands
36	# aide/help/? [command]
37	# Display the description of the specified command
38	#
39	# add <account_name> <sex> <password>
40	# Create an account with the default email (a@a.com).
41	# Concerning the sex, only the first letter is used (F or M).
42	# The e-mail is set to a@a.com (default e-mail). It's like to have no e-mail.
43	# When the password is omitted, the input is done without displaying of the pressed keys.
44	# <example> add testname Male testpass
45	#
46	# ban/banish yyyy/mm/dd hh:mm:ss <account name>
47	# Changes the final date of a banishment of an account.
48	# Same command of banset, except that account_name is at end
49	#
50	# banadd <account_name> <modifier>
51	# Adds or substracts time from the final date of a banishment of an account.
52	# Modifier is done as follows:
53	# Adjustment value (-1, 1, +1, etc...)
54	# Modified element:
55	# a or y: year
56	# m: month
57	# j or d: day
58	# h: hour
59	# mn: minute
60	# s: second
61	# <example> banadd testname +1m-2mn1s-6y
62	# this example adds 1 month and 1 second, and substracts 2 minutes and 6 years at the same time.
63	# NOTE: If you modify the final date of a non-banished account,
64	# you fix the final date to (actual time +- adjustments)
65	#
66	# banset <account_name> yyyy/mm/dd [hh:mm:ss]
67	# Changes the final date of a banishment of an account.
68	# Default time: 23:59:59
69	# banset <account_name> 0
70	# Set a non-banished account (0 = unbanished).
71	#
72	# block <account name>
73	# Set state 5 (You have been blocked by the GM Team) to an account.
74	# Same command of state <account_name> 5.
75	#
76	# check <account_name> <password>
77	# Check the validity of a password for an account
78	# NOTE: Server will never sends back a password.
79	# It's the only method you have to know if a password is correct.
80	# The other method is to have a ('physical') access to the accounts file.
81	#
82	# create <account_name> <sex> <email> <password>
83	# Like the 'add' command, but with e-mail moreover.
84	# <example> create testname Male my@mail.com testpass
85	#
86	# del <account name>
87	# Remove an account.
88	# This order requires confirmation. After confirmation, the account is deleted.
89	#
90	# email <account_name> <email>
91	# Modify the e-mail of an account.
92	#
93	# getcount
94	# Give the number of players online on all char-servers.
95	#
96	# gm <account_name> [GM_level]
97	# Modify the GM level of an account.
98	# Default value remove GM level (GM level = 0).
99	# <example> gm testname 80
100	#
101	# id <account name>
102	# Give the id of an account.
103	#
104	# info <account_id>
105	# Display complete information of an account.
106	#
107	# kami <message>
108	# Sends a broadcast message on all map-server (in yellow).
109	# kamib <message>
110	# Sends a broadcast message on all map-server (in blue).
111	#
112	# language <language>
113	# Change the language of displaying.
114	#
115	# list/ls [start_id [end_id]]
116	# Display a list of accounts.
117	# 'start_id', 'end_id': indicate end and start identifiers.
118	# Research by name is not possible with this command.
119	# <example> list 10 9999999
120	#
121	# listBan/lsBan [start_id [end_id]]
122	# Like list/ls, but only for accounts with state or banished
123	#
124	# listGM/lsGM [start_id [end_id]]
125	# Like list/ls, but only for GM accounts
126	#
127	# listOK/lsOK [start_id [end_id]]
128	# Like list/ls, but only for accounts without state and not banished
129	#
130	# memo <account_name> <memo>
131	# Modify the memo of an account.
132	# 'memo': it can have until 253 characters (with spaces or not).
133	#
134	# name <account_id>
135	# Give the name of an account.
136	#
137	# passwd <account_name> <new_password>
138	# Change the password of an account.
139	# When new password is omitted, the input is done without displaying of the pressed keys.
140	#
141	# quit/end/exit
142	# End of the program of administration
143	#
144	# reloadGM
145	# Reload GM configuration file
146	#
147	# search <expression>
148	# Seek accounts.
149	# Displays the accounts whose names correspond.
150	# search -r/-e/--expr/--regex <expression>
151	# Seek accounts by regular expression.
152	# Displays the accounts whose names correspond.
153	#
154	# sex <account_name> <sex>
155	# Modify the sex of an account.
156	# <example> sex testname Male
157	#
158	# state <account_name> <new_state> <error_message_#7>
159	# Change the state of an account.
160	# 'new_state': state is the state of the packet 0x006a + 1. The possibilities are:
161	# 0 = Account ok 6 = Your Game's EXE file is not the latest version
162	# 1 = Unregistered ID 7 = You are Prohibited to log in until %s
163	# 2 = Incorrect Password 8 = Server is jammed due to over populated
164	# 3 = This ID is expired 9 = No MSG
165	# 4 = Rejected from Server 100 = This ID has been totally erased
166	# 5 = You have been blocked by the GM Team
167	# all other values are 'No MSG', then use state 9 please.
168	# 'error_message_#7': message of the code error 6 = Your are Prohibited to log in until %s (packet 0x006a)
169	#
170	# timeadd <account_name> <modifier>
171	# Adds or substracts time from the validity limit of an account.
172	# Modifier is done as follows:
173	# Adjustment value (-1, 1, +1, etc...)
174	# Modified element:
175	# a or y: year
176	# m: month
177	# j or d: day
178	# h: hour
179	# mn: minute
180	# s: second
181	# <example> timeadd testname +1m-2mn1s-6y
182	# this example adds 1 month and 1 second, and substracts 2 minutes and 6 years at the same time.
183	# NOTE: You can not modify a unlimited validity limit.
184	# If you want modify it, you want probably create a limited validity limit.
185	# So, at first, you must set the validity limit to a date/time.
186	#
187	# timeset <account_name> yyyy/mm/dd [hh:mm:ss]
188	# Changes the validity limit of an account.
189	# Default time: 23:59:59
190	# timeset <account_name> 0
191	# Gives an unlimited validity limit (0 = unlimited).
192	#
193	# unban/unbanish <account name>
194	# Unban an account.
195	# Same command of banset 0.
196	#
197	# unblock <account name>
198	# Set state 0 (Account ok) to an account.
199	# Same command of state <account_name> 0.
200	#
201	# version
202	# Display the version of the login-server.
203	#
204	# who <account name>
205	# Displays complete information of an account.
206	#
207	#-------------------------------------------------------------------------
208	# Possibilities to execute ladmin in command line by usage of the software with a parameter:
209	# ./ladmin --mode param1 ...
210	#
211	# --makesymlink -- Create the symbolic links for a use in shell
212	# --add <account_name> <sex> <password> -- Create an account with the default email (or -a)
213	# --ban yyyy/mm/dd hh:mm:ss <account_name> -- Change the final date of a banishment of an account (or -b)
214	# --banadd <account_name> <modifier> -- Add or substract time from the final date of a banishment of an account (or - ba)
215	# --banset <account_name> yyyy/mm/dd [hh:mm:ss] -- Change the final date of a banishment of an account (or -bs)
216	# --banset <account_name> 0 -- Unbanish an account (or -bs)
217	# --block <account_name> -- Set state 5 to an account (or -bl)
218	# --check <account_name> <password> -- Check the validity of a password for an account (or -check)
219	# --create <account_name> <sex> <email> <password> -- Create an account with email (or -c)
220	# --del <account_name> -- Remove an account (or -d)
221	# --email <account_name> <email> -- Modify an email of an account (or -e)
222	# --getcount -- Give the number of players online on all char-servers (or -g)
223	# --gm <account_name> <GM_level> -- Change the GM level of an account (or -gm)
224	# --id <account_name> -- Give the id of an account (or -i)
225	# --info <account_id> -- Display complete information of an account (or -info)
226	# --kami <message> -- Sends a broadcast message on all map-server (in yellow).
227	# --kamib <message> -- Sends a broadcast message on all map-server (in blue).
228	# --language <language> -- Change the language of displaying (-lang).
229	# --list [First_id [Last_id]] -- Display a list of accounts (or -l)
230	# --listBan [start_id [end_id]] -- Display a list of accounts with state or banished (or -lBan)
231	# --listGM [First_id [Last_id]] -- Display a list of GM accounts (or -lGM)
232	# --listOK [start_id [end_id]] -- Display a list of accounts without state and not banished (or -lOK)
233	# --memo <account_name> <memo> -- Modify the memo of an account (or -e)
234	# --name <account_id> -- Give the name of an account (or -n)
235	# --passwd <account_name> <new_password> -- Change the password of an account (or -p)
236	# --reloadGM -- Reload GM configuration file (or -r)
237	# --search <expression> -- Seek accounts (or -s)
238	# --search -e/-r/--expr/--regex <expression> -- Seek accounts by REGEX (or -s)
239	# --sex <account_name> <sex> -- Change the sex of an account (or -sex)
240	# --state <account_name> <new_state> <error_message_#7> -- Change the state of an account (or -t)
241	# --timeadd <account_name> <modifier> -- Add or substract time from the validity limit of an account (or - ta)
242	# --timeset <account_name> yyyy/mm/dd [hh:mm:ss] -- Change the validify limit of an account (or -ts)
243	# --timeset <account_name> 0 -- Give a unlimited validity limit (or -ts)
244	# --unban/unbanish <account_name> -- Unban an account (or -uba)
245	# --unblock <account_name> -- Set state 0 to an account (or -ubl)
246	# --version -- Display the version of the login-server (or -v)
247	# --who <account_name> -- Display complete information of an account (or -w)
248	#
249	# <example> ./ladmin --addaccount testname Male testpass
250	#
251	#-------------------------------------------------------------------------
252	# Possibilities to execute ladmin with symbolic links in Shell
253	# To create the symbolic links, execute ladmin with the '-- makesymlink' option.
254	#
255	# addaccount <account_name> <sex> <password> -- Create an account with the default email
256	# banaccount yyyy/mm/dd hh:mm:ss <account_name> -- Change the final date of a banishment of an account
257	# banaddaccount <account_name> <modifier> -- Add or substract time from the final date of a banishment of an account
258	# bansetaccount <account_name> yyyy/mm/dd [hh:mm:ss] -- Change the final date of a banishment of an account
259	# bansetaccount <account_name> 0 -- Unbanish an account
260	# blockaccount <account_name> -- Set state 5 (blocked by the GM Team) to an account
261	# checkaccount <account_name> <password> -- Check the validity of a password for an account
262	# createaccount <account_name> <sex> <email> <password> -- Create an account with email
263	# delaccount <account_name> -- Remove an account
264	# emailaccount <account_name> <email> -- Modify an email of an account
265	# getcount -- Give the number of players online on all char-servers
266	# gmaccount <account_name> <GM_level> -- Change the GM level of an account
267	# idaccount <account_name> -- Give the id of an account
268	# infoaccount <account_id> -- Display complete information of an account
269	# kami <message> -- Sends a broadcast message on all map-server (in yellow).
270	# kamib <message> -- Sends a broadcast message on all map-server (in blue).
271	# ladminlanguage <language> -- Change the language of displaying.
272	# listaccount [First_id [Last_id]] -- Display a list of accounts
273	# listBanaccount [start_id [end_id]] -- Display a list of accounts with state or banished
274	# listGMaccount [First_id [Last_id]] -- Display a list of GM accounts
275	# listOKaccount [start_id [end_id]] -- Display a list of accounts without state and not banished
276	# loginserverversion -- Display the version of the login-server
277	# memoaccount <account_name> <memo> -- Modify the memo of an account
278	# nameaccount <account_id> -- Give the name of an account
279	# passwdaccount <account_name> <new_password> -- Change the password of an account
280	# reloadGM -- Reload GM configuration file
281	# searchaccount <expression> -- Seek accounts
282	# searchaccount -e/-r/--expr/--regex <expression> -- Seek accounts by REGEX
283	# sexaccount <account_name> <sex> -- Change the sex of an account (or -sex)
284	# stateaccount <account_name> <new_state> <error_message_#7> -- Change the state of an account
285	# timeaddaccount <account_name> <modifier> -- Add or substract time from the validity limit of an account
286	# timesetaccount <account_name> yyyy/mm/dd [hh:mm:ss] -- Change the validify limit of an account
287	# timesetaccount <account_name> 0 -- Give a unlimited validity limit
288	# unbanaccount <account_name> -- Unban an account
289	# unblockaccount <account_name> -- Set state 0 (Account ok) to an account
290	# whoaccount <account_name> -- Display complete information of an account
291	# <exemple> ./addaccount testname Male testpass
292	#
293	#-------------------------------------------------------------------------
294	# About the encoding:
295	#
296	# The Digest::MD5 module is necessary to use the encrypted password system.
297	# When the software cannot found the Digest::MD5 module,
298	# encoding is automatically disabled ($passenc=0), which allows
299	# to use this program in any cases.
300	#
301	#-------------------------------------------------------------------------
302	# How to use ladmin with UNIX:
303	#
304	# You excecute ladmin as a standard command.
305	# <Example of preparation to have an access to ladmin>
306	# $ mv ladmin ladmin_org
307	# $ nkf -eLu ladmin_org > ladmin
308	# $ chmod 700 ladmin
309	# <Example to start directly ladmin>
310	# $ perl ladmin
311	#
312	##########################################################################
313
314
315	use strict;
316	use IO::Socket;
317	use Term::ReadLine;
318	eval { use POSIX qw(:termios_h); };
319	eval { use Digest::MD5 qw(md5); } if $passenc;
320	$passenc = 0 if($@);
321
322	my($ver) = "1.00";
323
324	# Start of termios
325	my($termios, $orgterml, $termlecho, $termlnoecho) = ();
326	eval{
327	$termios = POSIX::Termios->new();
328	$termios->getattr(fileno(STDIN));
329	$orgterml = $termios->getlflag();
330	$termlecho = ECHO \| ECHOK \| ICANON;
331	$termlnoecho = $orgterml & ~$termlecho;
332	};
333
334	# Modification of termios for the displaying of passwords (no displays for pressed keys)
335	sub cbreak() {
336	if ($termios) {
337	$termios->setlflag($termlnoecho);
338	$termios->setcc(VTIME, 1);
339	$termios->setattr(fileno(STDIN), TCSANOW);
340	}
341	}
342	# Modification of termios to return at the normal displaying (after input of the passwords)
343	sub cooked() {
344	if ($termios) {
345	$termios->setlflag($orgterml);
346	$termios->setcc(VTIME,0);
347	$termios->setattr(fileno(STDIN),TCSANOW);
348	}
349	}
350	END{ cooked() }
351
352	if ($defaultlanguage eq "F") {
353	print "Outil d'administration à distance de eAthena V.$ver\n";
354	} else {
355	print "EAthena login-server administration tool V.$ver\n";
356	}
357
358	# Creation of the symbolic links for call of the program in line command of the shell
359	if ($ARGV[0] eq "--makesymlink") {
360	symlink $0, "loginserverversion";
361	symlink $0, "addaccount";
362	symlink $0, "banaccount";
363	symlink $0, "banaddaccount";
364	symlink $0, "bansetaccount";
365	symlink $0, "blockaccount";
366	symlink $0, "checkaccount";
367	symlink $0, "createaccount";
368	symlink $0, "delaccount";
369	symlink $0, "emailaccount";
370	symlink $0, "getcount";
371	symlink $0, "gmaccount";
372	symlink $0, "idaccount";
373	symlink $0, "infoaccount";
374	symlink $0, "kami";
375	symlink $0, "kamib";
376	symlink $0, "ladminlanguage";
377	symlink $0, "listaccount";
378	symlink $0, "listBanaccount";
379	symlink $0, "listGMaccount";
380	symlink $0, "listOKaccount";
381	symlink $0, "memoaccount";
382	symlink $0, "nameaccount";
383	symlink $0, "passwdaccount";
384	symlink $0, "reloadGM";
385	symlink $0, "searchaccount";
386	symlink $0, "sexaccount";
387	symlink $0, "stateaccount";
388	symlink $0, "timeaddaccount";
389	symlink $0, "timesetaccount";
390	symlink $0, "unbanaccount";
391	symlink $0, "unblockaccount";
392	symlink $0, "whoaccount";
393	if ($defaultlanguage eq "F") {
394	print "Liens symbliques créés.\n";
395	} else {
396	print "Symbolic links created.\n";
397	}
398	exit(0);
399	}
400
401	# Connection to the login-server
402	my($so,$er) = ();
403	eval{
404	$so = IO::Socket::INET->new(
405	PeerAddr=> $loginserverip,
406	PeerPort=> $loginserverport,
407	# Proto => "tcp",
408	Timeout => $connecttimeout) or $er = 1;
409	};
410	if ($er \|\| $@) {
411	if ($defaultlanguage eq "F") {
412	print "\nImpossible de se connecter au serveur de login [${loginserverip}:$loginserverport] !\n";
413	} else {
414	print "\nImpossible to have a connection with the login-server [${loginserverip}:$loginserverport] !\n";
415	}
416	print "$!\n"; # Displaying of the error
417	exit(2);
418	}
419
420	# Sending the administration password
421	if ($passenc == 0) {
422	print $so pack("v2a24",0x7918,0,$loginserveradminpassword);
423	$so->flush();
424	} else {
425	print $so pack("v",0x791a);
426	$so->flush();
427	my($buf) = readso(4);
428	if (unpack("v",$buf) != 0x01dc) {
429	if ($defaultlanguage eq "F") {
430	print "Erreur au login (échec de la création de la clef md5).\n";
431	} else {
432	print "Error at login (failure of the md5 key creation).\n";
433	}
434	}
435	$buf = readso(unpack("x2v",$buf)-4);
436	my($md5bin) = md5(($passenc == 1) ? $buf.$loginserveradminpassword : $loginserveradminpassword.$buf);
437	print $so pack("v2a16",0x7918,$passenc,$md5bin);
438	$so->flush();
439	}
440
441	# Waiting of the server reply
442	my($buf) = readso(3);
443
444	if (unpack("v",$buf) != 0x7919 \|\| unpack("x2c",$buf) != 0) {
445	if ($defaultlanguage eq "F") {
446	print "Erreur de login:\n";
447	print " - mot de passe incorrect,\n";
448	print " - système d'administration non activé, ou\n";
449	print " - IP non autorisée.\n";
450	} else {
451	print "Error at login:\n";
452	print " - incorrect password,\n";
453	print " - administration system not activated, or\n";
454	print " - unauthorised IP.\n";
455	}
456	quit();
457	exit(4);
458	}
459
460	if ($defaultlanguage eq "F") {
461	print "Connexion établie.\n";
462	} else {
463	print "Established connection.\n";
464	}
465
466	#-------------------------------------------------------------------------
467	# Here are checked the command lines with arguments and symbolic links (no prompt)
468
469	if ($0 =~ /addaccount$/ \|\|
470	(($ARGV[0] eq "-a" \|\| $ARGV[0] eq "--add") && ((shift @ARGV), 1))) {
471	my($r) = addaccount($ARGV[0], $ARGV[1], $ARGV[2]);
472	quit();
473	exit($r);
474	} elsif ($0 =~ /banaccount$/ \|\| $0 =~ /banishaccount$/ \|\|
475	(($ARGV[0] eq "-b" \|\| $ARGV[0] eq "--ban" \|\| $ARGV[0] eq "--banish") && ((shift @ARGV), 1))) {
476	my($r) = bansetaccount($ARGV[1], $ARGV[2], $ARGV[0]);
477	quit();
478	exit($r);
479	} elsif ($0 =~ /banaddaccount$/ \|\|
480	(($ARGV[0] eq "-ba" \|\| $ARGV[0] eq "--banadd") && ((shift @ARGV), 1))) {
481	my($r) = banaddaccount($ARGV[0], $ARGV[1]);
482	quit();
483	exit($r);
484	} elsif ($0 =~ /bansetaccount$/ \|\|
485	(($ARGV[0] eq "-bs" \|\| $ARGV[0] eq "--banset") && ((shift @ARGV), 1))) {
486	my($r) = bansetaccount($ARGV[0], $ARGV[1], $ARGV[2]);
487	quit();
488	exit($r);
489	} elsif ($0 =~ /blockaccount$/ \|\|
490	(($ARGV[0] eq "-bl" \|\| $ARGV[0] eq "--block") && ((shift @ARGV), 1))) {
491	my($r) = changestate($ARGV[0], 5, "");
492	quit();
493	exit($r);
494	} elsif ($0 =~ /checkaccount$/ \|\|
495	(($ARGV[0] eq "-check" \|\| $ARGV[0] eq "--check") && ((shift @ARGV), 1))) {
496	my($r) = checkaccount($ARGV[0], $ARGV[1]);
497	quit();
498	exit($r);
499	} elsif ($0 =~ /createaccount$/ \|\|
500	(($ARGV[0] eq "-c" \|\| $ARGV[0] eq "--create") && ((shift @ARGV), 1))) {
501	my($r) = createaccount($ARGV[0], $ARGV[1], $ARGV[2], $ARGV[3]);
502	quit();
503	exit($r);
504	} elsif ($0 =~ /delaccount$/ \|\|
505	(($ARGV[0] eq "-d" \|\| $ARGV[0] eq "--del") && ((shift @ARGV), 1))) {
506	my($r) = delaccount($ARGV[0]);
507	quit();
508	exit($r);
509	} elsif ($0 =~ /emailaccount$/ \|\|
510	(($ARGV[0] eq "-e" \|\| $ARGV[0] eq "--email") && ((shift @ARGV), 1))) {
511	my($r) = changeemail($ARGV[0], $ARGV[1]);
512	quit();
513	exit($r);
514	} elsif ($0 =~ /getcount$/ \|\|
515	(($ARGV[0] eq "-g" \|\| $ARGV[0] eq "--getcount") && ((shift @ARGV), 1))) {
516	my($r) = getlogincount();
517	quit();
518	exit($r);
519	} elsif ($0 =~ /gmaccount$/ \|\|
520	(($ARGV[0] eq "-gm" \|\| $ARGV[0] eq "--gm") && ((shift @ARGV), 1))) {
521	my($r) = changegmlevel($ARGV[0], $ARGV[1]);
522	quit();
523	exit($r);
524	} elsif ($0 =~ /id$/ \|\|
525	(($ARGV[0] eq "-i" \|\| $ARGV[0] eq "--id") && ((shift @ARGV), 1))) {
526	my($r) = idaccount($ARGV[0]);
527	quit();
528	exit($r);
529	} elsif ($0 =~ /infoaccount$/ \|\|
530	(($ARGV[0] eq "-info" \|\| $ARGV[0] eq "--info") && ((shift @ARGV), 1))) {
531	my($r) = infoaccount($ARGV[0]);
532	quit();
533	exit($r);
534	} elsif ($0 =~ /kami$/ \|\|
535	(($ARGV[0] eq "-kami" \|\| $ARGV[0] eq "--kami") && ((shift @ARGV), 1))) {
536	my($r) = sendbroadcast(0, $ARGV[0]);
537	quit();
538	exit($r);
539	} elsif ($0 =~ /kamib$/ \|\|
540	(($ARGV[0] eq "-kamib" \|\| $ARGV[0] eq "--kamib") && ((shift @ARGV), 1))) {
541	my($r) = sendbroadcast(0x10, $ARGV[0]);
542	quit();
543	exit($r);
544	} elsif ($0 =~ /ladminlanguage$/ \|\|
545	(($ARGV[0] eq "-lang" \|\| $ARGV[0] eq "--language") && ((shift @ARGV), 1))) {
546	my($r) = changelanguage($ARGV[0]);
547	quit();
548	exit($r);
549	} elsif ($0 =~ /listaccount$/ \|\|
550	(($ARGV[0] eq "-l" \|\| $ARGV[0] eq "--list") && ((shift @ARGV), 1))) {
551	my($r) = listaccount(int($ARGV[0]), int($ARGV[1]), 0); # 0: to list all
552	quit();
553	exit($r);
554	} elsif ($0 =~ /listBanaccount$/ \|\|
555	(($ARGV[0] eq "-lBan" \|\| $ARGV[0] eq "--listBan") && ((shift @ARGV), 1))) {
556	my($r) = listaccount(int($ARGV[0]), int($ARGV[1]), 3); # 3: to list only accounts with state or banished
557	quit();
558	exit($r);
559	} elsif ($0 =~ /listGMaccount$/ \|\|
560	(($ARGV[0] eq "-lGM" \|\| $ARGV[0] eq "--listGM") && ((shift @ARGV), 1))) {
561	my($r) = listaccount(int($ARGV[0]), int($ARGV[1]), 1); # 1: to list only GM
562	quit();
563	exit($r);
564	} elsif ($0 =~ /listOKaccount$/ \|\|
565	(($ARGV[0] eq "-lOK" \|\| $ARGV[0] eq "--listOK") && ((shift @ARGV), 1))) {
566	my($r) = listaccount(int($ARGV[0]), int($ARGV[1]), 4); # 4: to list only accounts without state and not banished
567	quit();
568	exit($r);
569	} elsif ($0 =~ /loginserverversion$/ \|\|
570	(($ARGV[0] eq "-v" \|\| $ARGV[0] eq "--version") && ((shift @ARGV), 1))) {
571	my($r) = checkloginversion();
572	quit();
573	exit($r);
574	} elsif ($0 =~ /memoaccount$/ \|\|
575	(($ARGV[0] eq "-m" \|\| $ARGV[0] eq "--memo") && ((shift @ARGV), 1))) {
576	my($r) = changememo($ARGV[0], $ARGV[1]);
577	quit();
578	exit($r);
579	} elsif ($0 =~ /nameaccount$/ \|\|
580	(($ARGV[0] eq "-n" \|\| $ARGV[0] eq "--name") && ((shift @ARGV), 1))) {
581	my($r) = nameaccount(int($ARGV[0]));
582	quit();
583	exit($r);
584	} elsif ($0 =~ /passwdaccount$/ \|\|
585	(($ARGV[0] eq "-p" \|\| $ARGV[0] eq "--passwd") && ((shift @ARGV), 1))) {
586	my($r) = changepasswd($ARGV[0], $ARGV[1]);
587	quit();
588	exit($r);
589	} elsif ($0 =~ /reloadGM$/ \|\|
590	(($ARGV[0] eq "-r" \|\| $ARGV[0] eq "--reloadGM") && ((shift @ARGV), 1))) {
591	my($r) = reloadGM();
592	quit();
593	exit($r);
594	} elsif ($0 =~ /searchaccount$/ \|\|
595	(($ARGV[0] eq "-s" \|\| $ARGV[0] eq "--search") && ((shift @ARGV), 1))) {
596	my($r) = searchaccount($ARGV[0], $ARGV[1]);
597	quit();
598	exit($r);
599	} elsif ($0 =~ /sexaccount$/ \|\|
600	(($ARGV[0] eq "-sex" \|\| $ARGV[0] eq "--sex") && ((shift @ARGV), 1))) {
601	my($r) = changesex($ARGV[0], $ARGV[1]);
602	quit();
603	exit($r);
604	} elsif ($0 =~ /stateaccount$/ \|\|
605	(($ARGV[0] eq "-t" \|\| $ARGV[0] eq "--state") && ((shift @ARGV), 1))) {
606	my($r) = changestate($ARGV[0], $ARGV[1], $ARGV[2]);
607	quit();
608	exit($r);
609	} elsif ($0 =~ /timeaddaccount$/ \|\|
610	(($ARGV[0] eq "-ta" \|\| $ARGV[0] eq "--timeadd") && ((shift @ARGV), 1))) {
611	my($r) = timeaddaccount($ARGV[0], $ARGV[1]);
612	quit();
613	exit($r);
614	} elsif ($0 =~ /timesetaccount$/ \|\|
615	(($ARGV[0] eq "-ts" \|\| $ARGV[0] eq "--timeset") && ((shift @ARGV), 1))) {
616	my($r) = timesetaccount($ARGV[0], $ARGV[1], $ARGV[2]);
617	quit();
618	exit($r);
619	} elsif ($0 =~ /unbanaccount$/ \|\| $0 =~ /unbanishaccount$/ \|\|
620	(($ARGV[0] eq "-uba" \|\| $ARGV[0] eq "--unban" \|\| $ARGV[0] eq "--unbanish") && ((shift @ARGV), 1))) {
621	my($r) = bansetaccount($ARGV[0], 0, "");
622	quit();
623	exit($r);
624	} elsif ($0 =~ /unblockaccount$/ \|\|
625	(($ARGV[0] eq "-ubl" \|\| $ARGV[0] eq "--unblock") && ((shift @ARGV), 1))) {
626	my($r) = changestate($ARGV[0], 0, "");
627	quit();
628	exit($r);
629	} elsif ($0 =~ /whoaccount$/ \|\|
630	(($ARGV[0] eq "-w" \|\| $ARGV[0] eq "--who") && ((shift @ARGV), 1))) {
631	my($r) = whoaccount($ARGV[0]);
632	quit();
633	exit($r);
634	}
635
636	#-------------------------------------------------------------------------
637	if ($defaultlanguage eq "F") {
638	print "Lecture de la version du serveur de login...\n";
639	} else {
640	print "Reading of the version of the login-server...\n";
641	}
642	checkloginversion();
643
644	# Set the prompt line
645	my($term) = new Term::ReadLine "ladmin";
646
647	# Here begin the infinite loop to read prompts
648	while(1) {
649	# Displaying of the prompt
650	print "\n";
651	if ($defaultlanguage eq "F") {
652	printf "\033[32mPour afficher les commandes, tapez 'Entrée'.\033[0m\n";
653	} else {
654	printf "\033[32mTo list the commands, type 'enter'.\033[0m\n";
655	}
656	my($cmd) = $term->readline("ladmin> ");
657	# split and recovery of the input
658	chomp $cmd; # remove cariage return
659	$cmd =~ s/\x1b\[\d*\w//g; # remove (esc)[(number)(1alpha) = screen control sequence
660	$cmd =~ s/[\x00-\x1f]//g; # remove control char
661	my($command, $parameters) = split /\s+/,$cmd,2; # extract command and parameters
662	$command = lc($command); # command in lowercase
663	my(@paramlist) = split /\s+/,$parameters; # get list of parameters
664
665	if ($command eq "?" \|\| $command eq "") {
666	$command = "aide" if ($defaultlanguage eq "F");
667	$command = "help" if ($defaultlanguage ne "F");
668	}
669
670	# Analyse of the command
671	eval {
672	# help
673	if ("aide" =~ /^\Q$command/ && $command ne "a") { # check 1 letter command: 'aide' or 'add'?
674	displayhelp("aide", $paramlist[0]);
675	} elsif ("help" =~ /^\Q$command/) {
676	displayhelp("help", $paramlist[0]);
677
678	# general commands
679	} elsif ("add" =~ /^\Q$command/ && $command ne "a") { # check 1 letter command: 'aide' or 'add'?
680	if (@paramlist = ($parameters =~ m/^"(.)"\s+(\S+)\s+(.)/)) {
681	addaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> <sex> <password>
682	} elsif (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)/)) {
683	addaccount($paramlist[0], $paramlist[1], ""); # <account_name> <sex> <password>
684	} elsif (@paramlist = ($parameters =~ m/^'(.)'\s+(\S+)\s+(.)/)) {
685	addaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> <sex> <password>
686	} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)/)) {
687	addaccount($paramlist[0], $paramlist[1], ""); # <account_name> <sex> <password>
688	} else {
689	@paramlist = split /\s+/,$parameters;
690	addaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> <sex> <password>
691	}
692
693	} elsif ($command eq "ban" \|\| ("banish" =~ /^\Q$command/ && length($command) >= 4)) {
694	if (@paramlist = ($parameters =~ m/^(\S+)\s+(\S+)\s+"(.*)"/)) { # yyyy/mm/dd hh:mm:ss <account_name>
695	bansetaccount($paramlist[2], $paramlist[0], $paramlist[1]); # <account_name> yyyy/mm/dd [hh:mm:ss]
696	} elsif (@paramlist = ($parameters =~ m/^(\S+)\s+(\S+)\s+'(.*)'/)) { # yyyy/mm/dd hh:mm:ss <account_name>
697	bansetaccount($paramlist[2], $paramlist[0], $paramlist[1]); # <account_name> yyyy/mm/dd [hh:mm:ss]
698	} else {
699	@paramlist = split /\s+/,$parameters,3; # yyyy/mm/dd hh:mm:ss <account_name>
700	bansetaccount($paramlist[2], $paramlist[0], $paramlist[1]); # <account_name> yyyy/mm/dd [hh:mm:ss]
701	}
702
703	} elsif (("banadd" =~ /^\Q$command/ \|\| $command eq "ba") && $command ne "b") { # check 1 letter command: 'ba' or 'bs'?
704	if (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)/)) {
705	banaddaccount($paramlist[0], $paramlist[1]); # <account_name> <modifier>
706	} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)/)) {
707	banaddaccount($paramlist[0], $paramlist[1]); # <account_name> <modifier>
708	} else {
709	@paramlist = split /\s+/,$parameters;
710	banaddaccount($paramlist[0], $paramlist[1]); # <account_name> <modifier>
711	}
712
713	} elsif (("banset" =~ /^\Q$command/ \|\| $command eq "bs") && $command ne "b") { # check 1 letter command: 'ba' or 'bs'?
714	if (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)\s+(\S+)/)) {
715	bansetaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> yyyy/mm/dd [hh:mm:ss]
716	} elsif (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)/)) {
717	bansetaccount($paramlist[0], $paramlist[1], "23:59:59"); # <account_name> yyyy/mm/dd [hh:mm:ss]
718	} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)\s+(\S+)/)) {
719	bansetaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> yyyy/mm/dd [hh:mm:ss]
720	} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)/)) {
721	bansetaccount($paramlist[0], $paramlist[1], "23:59:59"); # <account_name> yyyy/mm/dd [hh:mm:ss]
722	} else {
723	@paramlist = split /\s+/,$parameters;
724	bansetaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> yyyy/mm/dd [hh:mm:ss]
725	}
726
727	} elsif ("block" =~ /^\Q$command/ && length($command) >= 2) {
728	if (@paramlist = ($parameters =~ m/^"(.*)"/)) {
729	changestate($paramlist[0], 5, ""); # <account_name> <new_state> <error_message_#7>
730	} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
731	changestate($paramlist[0], 5, ""); # <account_name> <new_state> <error_message_#7>
732	} else {
733	@paramlist = split /\s+/,$parameters,1;
734	changestate($paramlist[0], 5, ""); # <account_name> <new_state> <error_message_#7>
735	}
736
737	} elsif ("check" =~ /^\Q$command/ && $command ne "c") { # check 1 letter command: 'check' or 'create'?
738	if (@paramlist = ($parameters =~ m/^"(.)"\s+(.)/)) {
739	checkaccount($paramlist[0], $paramlist[1]); # <account_name> <password>
740	} elsif (@paramlist = ($parameters =~ m/^"(.*)"/)) {
741	checkaccount($paramlist[0], ""); # <account_name> <password>
742	} elsif (@paramlist = ($parameters =~ m/^'(.)'\s+(.)/)) {
743	checkaccount($paramlist[0], $paramlist[1]); # <account_name> <password>
744	} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
745	checkaccount($paramlist[0], ""); # <account_name> <password>
746	} else {
747	@paramlist = split /\s+/,$parameters;
748	checkaccount($paramlist[0], $paramlist[1]); # <account_name> <password>
749	}
750
751	} elsif ("create" =~ /^\Q$command/ && $command ne "c") { # check 1 letter command: 'check' or 'create'?
752	if (@paramlist = ($parameters =~ m/^"(.)"\s+(\S+)\s+(\S+)\s+(.)/)) {
753	createaccount($paramlist[0], $paramlist[1], $paramlist[2], $paramlist[3]); # <account_name> <sex> <email> <password>
754	} elsif (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)\s+(\S+)/)) {
755	createaccount($paramlist[0], $paramlist[1], $paramlist[2], ""); # <account_name> <sex> <email> <password>
756	} elsif (@paramlist = ($parameters =~ m/^'(.)'\s+(\S+)\s+(\S+)\s+(.)/)) {
757	createaccount($paramlist[0], $paramlist[1], $paramlist[2], $paramlist[3]); # <account_name> <sex> <email> <password>
758	} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)\s+(\S+)/)) {
759	createaccount($paramlist[0], $paramlist[1], $paramlist[2], ""); # <account_name> <sex> <email> <password>
760	} else {
761	@paramlist = split /\s+/,$parameters;
762	createaccount($paramlist[0], $paramlist[1], $paramlist[2], $paramlist[3]); # <account_name> <sex> <email> <password>
763	}
764
765	} elsif ("del" =~ /^\Q$command/ \|\| "delete" =~ /^\Q$command/) {
766	if (@paramlist = ($parameters =~ m/^"(.*)"/)) {
767	delaccount($paramlist[0]); # <account_name>
768	} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
769	delaccount($paramlist[0]); # <account_name>
770	} else {
771	@paramlist = split /\s+/,$parameters,1;
772	delaccount($paramlist[0]); # <account_name>
773	}
774
775	} elsif ("email" =~ /^\Q$command/ && $command ne "e") { # check 1 letter command: 'email', 'end' or 'exit'?
776	if (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)/)) {
777	changeemail($paramlist[0], $paramlist[1]); # <account_name> <email>
778	} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)/)) {
779	changeemail($paramlist[0], $paramlist[1]); # <account_name> <email>
780	} else {
781	@paramlist = split /\s+/,$parameters;
782	changeemail($paramlist[0], $paramlist[1]); # <account_name> <email>
783	}
784
785	} elsif ("getcount" =~ /^\Q$command/ && $command ne "g") { # check 1 letter command: 'getcount' or 'gm'?
786	getlogincount();
787
788	} elsif ("gm" =~ /^\Q$command/ && $command ne "g") { # check 1 letter command: 'getcount' or 'gm'?
789	if (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)/)) {
790	changegmlevel($paramlist[0], int($paramlist[1])); # <account_name> <GM_level>
791	} elsif (@paramlist = ($parameters =~ m/^"(.*)"/)) {
792	changegmlevel($paramlist[0], 0); # <account_name> <GM_level>
793	} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)/)) {
794	changegmlevel($paramlist[0], int($paramlist[1])); # <account_name> <GM_level>
795	} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
796	changegmlevel($paramlist[0], 0); # <account_name> <GM_level>
797	} else {
798	@paramlist = split /\s+/,$parameters;
799	changegmlevel($paramlist[0], int($paramlist[1])); # <account_name> <GM_level>
800	}
801
802	} elsif ("id" =~ /^\Q$command/ && $command ne "i") { # check 1 letter command: 'id' or 'info'?
803	if (@paramlist = ($parameters =~ m/^"(.*)"/)) {
804	idaccount($paramlist[0]); # <account_name>
805	} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
806	idaccount($paramlist[0]); # <account_name>
807	} else {
808	@paramlist = split /\s+/,$parameters,1;
809	idaccount($paramlist[0]); # <account_name>
810	}
811
812	} elsif ("info" =~ /^\Q$command/ && $command ne "i") { # check 1 letter command: 'id' or 'info'?
813	infoaccount(int($paramlist[0])); # <account_id>
814
815	} elsif ($command eq "kami") { # check all letters command: 'kami' or 'kamib'?
816	@paramlist = split /\s+/,$parameters,1;
817	sendbroadcast(0, $paramlist[0]); # <type> <message>
818
819	} elsif ($command eq "kamib") { # check all letters command: 'kami' or 'kamib'?
820	@paramlist = split /\s+/,$parameters,1;
821	sendbroadcast(0x10, $paramlist[0]); # <type> <message>
822
823	} elsif ("language" =~ /^\Q$command/ && $command ne "l") { # check 1 letter command: 'list' or 'language'?
824	changelanguage($paramlist[0]); # <language>
825
826	} elsif (("list" =~ /^\Q$command/ \|\| $command eq "ls") && $command ne "l") { # check 1 letter command: 'list' or 'language'?
827	listaccount(int($paramlist[0]), int($paramlist[1]), 0); # [start_id [end_id]] 0: to list all
828
829	} elsif (("listban" =~ /^\Q$command/ \|\| $command eq "lsban") && $command ne "l") { # need to specificaly write Ban to have this list # check 1 letter command: 'list' or 'language'?
830	listaccount(int($paramlist[0]), int($paramlist[1]), 3); # [start_id [end_id]] 3: to list only accounts with state or banished
831
832	} elsif (("listgm" =~ /^\Q$command/ \|\| $command eq "lsgm") && $command ne "l") { # need to specificaly write GM to have this list # check 1 letter command: 'list' or 'language'?
833	listaccount(int($paramlist[0]), int($paramlist[1]), 1); # [start_id [end_id]] 1: to list only GM
834
835	} elsif (("listok" =~ /^\Q$command/ \|\| $command eq "lsok") && $command ne "l") { # need to specificaly write OK to have this list # check 1 letter command: 'list' or 'language'?
836	listaccount(int($paramlist[0]), int($paramlist[1]), 4); # [start_id [end_id]] 4: to list only accounts without state and not banished
837
838	} elsif ("memo" =~ /^\Q$command/) {
839	if (@paramlist = ($parameters =~ m/^"(.)"\s+(.)/)) {
840	changememo($paramlist[0], $paramlist[1]); # <account_name> <memo>
841	} elsif (@paramlist = ($parameters =~ m/^'(.)'\s+(.)/)) {
842	changememo($paramlist[0], $paramlist[1]); # <account_name> <memo>
843	} else {
844	@paramlist = split /\s+/,$parameters,2;
845	changememo($paramlist[0], $paramlist[1]); # <account_name> <memo>
846	}
847
848	} elsif ("name" =~ /^\Q$command/) {
849	nameaccount(int($paramlist[0])); # <account_id>
850
851	} elsif ("passwd" =~ /^\Q$command/ \|\| "password" =~ /^\Q$command/) {
852	if (@paramlist = ($parameters =~ m/^"(.)"\s+(.)/)) {
853	changepasswd($paramlist[0], $paramlist[1]); # <account_name> <new_password>
854	} elsif (@paramlist = ($parameters =~ m/^"(.*)"/)) {
855	changepasswd($paramlist[0], ""); # <account_name> <new_password>
856	} elsif (@paramlist = ($parameters =~ m/^'(.)'\s+(.)/)) {
857	changepasswd($paramlist[0], $paramlist[1]); # <account_name> <new_password>
858	} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
859	changepasswd($paramlist[0], ""); # <account_name> <new_password>
860	} else {
861	@paramlist = split /\s+/,$parameters,2;
862	changepasswd($paramlist[0], $paramlist[1]); # <account_name> <new_password>
863	}
864
865	} elsif ("reloadgm" =~ /^\Q$command/) {
866	reloadGM();
867
868	} elsif ("search" =~ /^\Q$command/ && $command ne "s" && # check 1 letter command: 'search', 'state' or 'sex'?
869	$command ne "se") { # check 2 letters command: 'search' or 'sex'?
870	if (@paramlist = ($parameters =~ m/^(-{1,2}[re]\S)\s+(.)/)) {
871	searchaccount($paramlist[0], $paramlist[1]); # -r/-e/--expr/--regex <expression> \| <expression>
872	} else {
873	@paramlist = split /\s+/,$parameters,1;
874	searchaccount($paramlist[0], ""); # -r/-e/--expr/--regex <expression> \| <expression>
875	}
876
877	} elsif ("sex" =~ /^\Q$command/ && $command ne "s" && # check 1 letter command: 'search', 'state' or 'sex'?
878	$command ne "se") { # check 2 letters command: 'search' or 'sex'?
879	if (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)/)) {
880	changesex($paramlist[0], $paramlist[1]); # <account_name> <sex>
881	} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)/)) {
882	changesex($paramlist[0], $paramlist[1]); # <account_name> <sex>
883	} else {
884	@paramlist = split /\s+/,$parameters;
885	changesex($paramlist[0], $paramlist[1]); # <account_name> <sex>
886	}
887
888	} elsif ("state" =~ /^\Q$command/ && $command ne "s") { # check 1 letter command: 'search', 'state' or 'sex'?
889	if (@paramlist = ($parameters =~ m/^"(.)"\s+(\d+)\s+(.)/)) {
890	changestate($paramlist[0], int($paramlist[1]), $paramlist[2]); # <account_name> <new_state> <error_message_#7>
891	} elsif (@paramlist = ($parameters =~ m/^"(.*)"\s+(\d+)/)) {
892	changestate($paramlist[0], int($paramlist[1]), ""); # <account_name> <new_state> <error_message_#7>
893	} elsif (@paramlist = ($parameters =~ m/^'(.)'\s+(\d+)\s+(.)/)) {
894	changestate($paramlist[0], int($paramlist[1]), $paramlist[2]); # <account_name> <new_state> <error_message_#7>
895	} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\d+)/)) {
896	changestate($paramlist[0], int($paramlist[1]), ""); # <account_name> <new_state> <error_message_#7>
897	} else {
898	@paramlist = split /\s+/,$parameters,3;
899	changestate($paramlist[0], int($paramlist[1]), $paramlist[2]); # <account_name> <new_state> <error_message_#7>
900	}
901
902	} elsif (("timeadd" =~ /^\Q$command/ \|\| $command eq "ta") && $command ne "t") { # check 1 letter command: 'ta' or 'ts'?
903	if (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)/)) {
904	timeaddaccount($paramlist[0], $paramlist[1]); # <account_name> <modifier>
905	} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)/)) {
906	timeaddaccount($paramlist[0], $paramlist[1]); # <account_name> <modifier>
907	} else {
908	@paramlist = split /\s+/,$parameters;
909	timeaddaccount($paramlist[0], $paramlist[1]); # <account_name> <modifier>
910	}
911
912	} elsif (("timeset" =~ /^\Q$command/ \|\| $command eq "ts") && $command ne "t") { # check 1 letter command: 'ta' or 'ts'?
913	if (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)\s+(\S+)/)) {
914	timesetaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> yyyy/mm/dd [hh:mm:ss]
915	} elsif (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)/)) {
916	timesetaccount($paramlist[0], $paramlist[1], "23:59:59"); # <account_name> yyyy/mm/dd [hh:mm:ss]
917	} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)\s+(\S+)/)) {
918	timesetaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> yyyy/mm/dd [hh:mm:ss]
919	} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)/)) {
920	timesetaccount($paramlist[0], $paramlist[1], "23:59:59"); # <account_name> yyyy/mm/dd [hh:mm:ss]
921	} else {
922	@paramlist = split /\s+/,$parameters;
923	timesetaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> yyyy/mm/dd [hh:mm:ss]
924	}
925
926	} elsif ($command eq "unban" \|\| ("unbanish" =~ /^\Q$command/ && length($command) >= 4)) {
927	if (@paramlist = ($parameters =~ m/^"(.*)"/)) {
928	bansetaccount($paramlist[0], 0, ""); # <account_name> yyyy/mm/dd [hh:mm:ss]
929	} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
930	bansetaccount($paramlist[0], 0, ""); # <account_name> yyyy/mm/dd [hh:mm:ss]
931	} else {
932	@paramlist = split /\s+/,$parameters,1;
933	bansetaccount($paramlist[0], 0, ""); # <account_name> yyyy/mm/dd [hh:mm:ss]
934	}
935
936	} elsif ("unblock" =~ /^\Q$command/ && length($command) >= 4) {
937	if (@paramlist = ($parameters =~ m/^"(.*)"/)) {
938	changestate($paramlist[0], 0, ""); # <account_name> <new_state> <error_message_#7>
939	} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
940	changestate($paramlist[0], 0, ""); # <account_name> <new_state> <error_message_#7>
941	} else {
942	@paramlist = split /\s+/,$parameters,1;
943	changestate($paramlist[0], 0, ""); # <account_name> <new_state> <error_message_#7>
944	}
945
946	} elsif ("version" =~ /^\Q$command/) {
947	checkloginversion();
948
949	} elsif ("who" =~ /^\Q$command/) {
950	if (@paramlist = ($parameters =~ m/^"(.*)"/)) {
951	whoaccount($paramlist[0]); # <account_name>
952	} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
953	whoaccount($paramlist[0]); # <account_name>
954	} else {
955	@paramlist = split /\s+/,$parameters,1;
956	whoaccount($paramlist[0]); # <account_name>
957	}
958
959	# quit
960	} elsif ("quit" =~ /^\Q$command/ \|\|
961	(("end" =~ /^\Q$command/ \|\| "exit" =~ /^\Q$command/) && $command ne "e")) { # check 1 letter command: 'email', 'end' or 'exit'?
962	last;
963
964	# unknown command
965	} elsif ($command) {
966	if ($defaultlanguage eq "F") {
967	print "Commande inconnue [".$command."]\n";
968	} else {
969	print "Unknown command [".$command."]\n";
970	}
971	}
972	# $term->addhistory($cmd) if $command;
973	};
974	if ($@) {
975	if ($defaultlanguage eq "F") {
976	print "Erreur [".$command."]\n$@";
977	} else {
978	print "Error [".$command."]\n$@";
979	}
980	}
981	};
982
983	# End of the software
984	quit();
985
986	if ($defaultlanguage eq "F") {
987	print "Au revoir.\n";
988	} else {
989	print "Bye.\n";
990	}
991	exit(0);
992
993	#--------------------------------------------------------------------------
994
995	# Sub-function: Displaying of the version of the login-server
996	sub checkloginversion() {
997	print $so pack("v",30000); # 0x7530
998	$so->flush();
999	$buf = readso(10);
1000	# Analyse du Packet
1001	my($ret, $maver, $miver, $rev, $dev, $mod, $type, $mdver) = unpack("vc6v", $buf);
1002	if ($ret != 30001) { #0x7531
1003	if ($defaultlanguage eq "F") {
1004	print "Problème de connexion au serveur (réponse incorrecte).\n";
1005	} else {
1006	print "Connection error to the server (incorrect answer).\n";
1007	}
1008	exit(6);
1009	}
1010
1011	print " Login-Server [$loginserverip:$loginserverport]\n";
1012	printf " eAthena version %s-%d.%d", ("stable", "dev")[$dev], $maver, $miver;
1013	printf " revision %d", $rev if $rev;
1014	printf "%s%d.\n", ("", "-mod")[$mod], $mdver;
1015	return 0;
1016	}
1017
1018	#--------------------------------------------------------------------------
1019
1020	# Sub-function: Displaying of the help
1021	sub displayhelp() {
1022	my($help, $receivedcommand) = @_;
1023
1024	my($command) = lc($receivedcommand); # command in lowercase
1025
1026	if ($command eq "") {
1027	$command = "not a command"; # any value that is not a command
1028	}
1029
1030	if ($command eq "?") {
1031	$command = "aide" if ($defaultlanguage eq "F");
1032	$command = "help" if ($defaultlanguage ne "F");
1033	}
1034
1035	if ($help eq "aide") {
1036	if ("aide" =~ /^\Q$command/ && $command ne "a") { # check 1 letter command: 'aide' or 'add'?
1037	printf "aide/help/?\n";
1038	printf " Affiche la description des commandes\n";
1039	printf "aide/help/? [commande]\n";
1040	printf " Affiche la description de la commande specifiée\n";
1041	} elsif ("help" =~ /^\Q$command/) {
1042	printf "aide/help/?\n";
1043	printf " Display the description of the commands\n";
1044	printf "aide/help/? [command]\n";
1045	printf " Display the description of the specified command\n";
1046	} elsif ("add" =~ /^\Q$command/ && $command ne "a") { # check 1 letter command: 'aide' or 'add'?
1047	printf "add <nomcompte> <sexe> <motdepasse>\n";
1048	printf " Crée un compte avec l'email par défaut (a\@a.com).\n";
1049	printf " Concernant le sexe, seule la première lettre compte (F ou M).\n";
1050	printf " L'e-mail est a\@a.com (e-mail par défaut). C'est comme n'avoir aucun e-mail.\n";
1051	printf " Lorsque motdepasse est omis, la saisie se fait sans que la frappe se voit.\n";
1052	printf " <exemple> add testname Male testpass\n";
1053	} elsif ($command eq "ban" \|\| ("banish" =~ /^\Q$command/ && length($command) >= 4)) {
1054	printf "ban/banish aaaa/mm/jj hh:mm:ss <nomcompte>\n";
1055	printf " Change la date de fin de bannissement d'un compte.\n";
1056	printf " La différence avec banset est la position du nom du compte.\n";
1057	} elsif (("banadd" =~ /^\Q$command/ \|\| $command eq "ba") && $command ne "b") { # check 1 letter command: 'ba' or 'bs'?
1058	printf "banadd <nomcompte> <Modificateur>\n";
1059	printf " Ajoute ou soustrait du temps à la date de banissement d'un compte.\n";
1060	printf " Les modificateurs sont construits comme suit:\n";
1061	printf " Valeur d'ajustement (-1, 1, +1, etc...)\n";
1062	printf " Elément modifié:\n";
1063	printf " a ou y: année\n";
1064	printf " m: mois\n";
1065	printf " j ou d: jour\n";
1066	printf " h: heure\n";
1067	printf " mn: minute\n";
1068	printf " s: seconde\n";
1069	printf " <exemple> banadd testname +1m-2mn1s-6a\n";
1070	printf " Cette exemple ajoute 1 mois et une seconde, et soustrait 2 minutes\n";
1071	printf " et 6 ans dans le même temps.\n";
1072	printf "NOTE: Si vous modifez la date de banissement d'un compte non bani,\n";
1073	printf " vous indiquez comme date (le moment actuel +- les ajustements)\n";
1074	} elsif (("banset" =~ /^\Q$command/ \|\| $command eq "bs") && $command ne "b") { # check 1 letter command: 'ba' or 'bs'?
1075	printf "banset <nomcompte> aaaa/mm/jj [hh:mm:ss]\n";
1076	printf " Change la date de fin de bannissement d'un compte.\n";
1077	printf " Heure par défaut: 23:59:59\n";
1078	printf "banset <nomcompte> 0\n";
1079	printf " Débanni un compte (0 = de-banni).\n";
1080	} elsif ("block" =~ /^\Q$command/ && length($command) >= 2) {
1081	printf "block <nom compte>\n";
1082	printf " Place le status d'un compte à 5 (You have been blocked by the GM Team).\n";
1083	printf " La commande est l'équivalent de state <nom_compte> 5.\n";
1084	} elsif ("check" =~ /^\Q$command/ && $command ne "c") { # check 1 letter command: 'check' or 'create'?
1085	printf "check <nomcompte> <motdepasse>\n";
1086	printf " Vérifie la validité d'un mot de passe pour un compte\n";
1087	printf " NOTE: Le serveur n'enverra jamais un mot de passe.\n";
1088	printf " C'est la seule méthode que vous possédez pour savoir\n";
1089	printf " si un mot de passe est le bon. L'autre méthode est\n";
1090	printf " d'avoir un accès ('physique') au fichier des comptes.\n";
1091	} elsif ("create" =~ /^\Q$command/ && $command ne "c") { # check 1 letter command: 'check' or 'create'?
1092	printf "create <nomcompte> <sexe> <email> <motdepasse>\n";
1093	printf " Comme la commande add, mais avec l'e-mail en plus.\n";
1094	printf " <exemple> create testname Male mon\@mail.com testpass\n";
1095	} elsif ("del" =~ /^\Q$command/ \|\| "delete" =~ /^\Q$command/) {
1096	printf "del <nomcompte>\n";
1097	printf " Supprime un compte.\n";
1098	printf " La commande demande confirmation. Après confirmation, le compte est détruit.\n";
1099	} elsif ("email" =~ /^\Q$command/ && $command ne "e") { # check 1 letter command: 'email', 'end' or 'exit'?
1100	printf "email <nomcompte> <email>\n";
1101	printf " Modifie l'e-mail d'un compte.\n";
1102	} elsif ("getcount" =~ /^\Q$command/ && $command ne "g") { # check 1 letter command: 'getcount' or 'gm'?
1103	printf "getcount\n";
1104	printf " Donne le nombre de joueurs en ligne par serveur de char.\n";
1105	} elsif ("gm" =~ /^\Q$command/ && $command ne "g") { # check 1 letter command: 'getcount' or 'gm'?
1106	printf "gm <nomcompte> [Niveau_GM]\n";
1107	printf " Modifie le niveau de GM d'un compte.\n";
1108	printf " Valeur par défaut: 0 (suppression du niveau de GM).\n";
1109	printf " <exemple> gm nomtest 80\n";
1110	} elsif ("id" =~ /^\Q$command/ && $command ne "i") { # check 1 letter command: 'id' or 'info'?
1111	printf "id <nomcompte>\n";
1112	printf " Donne l'id d'un compte.\n";
1113	} elsif ("info" =~ /^\Q$command/ && $command ne "i") { # check 1 letter command: 'id' or 'info'?
1114	printf "info <idcompte>\n";
1115	printf " Affiche les informations sur un compte.\n";
1116	} elsif ($command eq "kami") { # check all letters command: 'kami' or 'kamib'?
1117	printf "kami <message>\n";
1118	printf " Envoi un message général sur tous les serveurs de map (en jaune).\n";
1119	} elsif ($command eq "kamib") { # check all letters command: 'kami' or 'kamib'?
1120	printf "kamib <message>\n";
1121	printf " Envoi un message général sur tous les serveurs de map (en bleu).\n";
1122	} elsif ("language" =~ /^\Q$command/ && $command ne "l") { # check 1 letter command: 'list' or 'language'?
1123	printf("language <langue>\n");
1124	printf(" Change la langue d'affichage.\n");
1125	printf(" Langues possibles: 'Français' ou 'English'.\n");
1126	} elsif (("list" =~ /^\Q$command/ \|\| $command eq "ls") && $command ne "l") { # check 1 letter command: 'list' or 'language'?
1127	printf "list/ls [Premier_id [Dernier_id]]\n";
1128	printf " Affiche une liste de comptes.\n";
1129	printf " 'Premier_id', 'Dernier_id': indique les identifiants de départ et de fin.\n";
1130	printf " La recherche par nom n'est pas possible avec cette commande.\n";
1131	printf " <example> list 10 9999999\n";
1132	} elsif (("listban" =~ /^\Q$command/ \|\| $command eq "lsban") && $command ne "l") { # need to specificaly write Ban to have this list # check 1 letter command: 'list' or 'language'?
1133	printf "listBan/lsBan [Premier_id [Dernier_id]]\n";
1134	printf " Comme list/ls, mais seulement pour les comptes GM avec un statut ou bannis.\n";
1135	} elsif (("listgm" =~ /^\Q$command/ \|\| $command eq "lsgm") && $command ne "l") { # need to specificaly write GM to have this list # check 1 letter command: 'list' or 'language'?
1136	printf "listGM/lsGM [Premier_id [Dernier_id]]\n";
1137	printf " Comme list/ls, mais seulement pour les comptes GM.\n";
1138	} elsif (("listok" =~ /^\Q$command/ \|\| $command eq "lsok") && $command ne "l") { # need to specificaly write OK to have this list # check 1 letter command: 'list' or 'language'?
1139	printf "listOK/lsOK [Premier_id [Dernier_id]]\n";
1140	printf " Comme list/ls, mais seulement pour les comptes sans statut et non bannis.\n";
1141	} elsif ("memo" =~ /^\Q$command/) {
1142	printf "memo <nomcompte> <memo>\n";
1143	printf " Modifie le mémo d'un compte.\n";
1144	printf " 'memo': Il peut avoir jusqu'à 253 caractères (avec des espaces ou non).\n";
1145	} elsif ("name" =~ /^\Q$command/) {
1146	printf "name <idcompte>\n";
1147	printf " Donne le nom d'un compte.\n";
1148	} elsif ("passwd" =~ /^\Q$command/ \|\| "password" =~ /^\Q$command/) {
1149	printf "passwd <nomcompte> <nouveaumotdepasse>\n";
1150	printf " Change le mot de passe d'un compte.\n";
1151	printf " Lorsque nouveaumotdepasse est omis,\n";
1152	printf " la saisie se fait sans que la frappe ne se voit.\n";
1153	} elsif ("reloadgm" =~ /^\Q$command/) {
1154	printf "reloadGM\n";
1155	printf " Reload GM configuration file\n";
1156	} elsif ("search" =~ /^\Q$command/ && $command ne "s" && # check 1 letter command: 'search', 'state' or 'sex'?
1157	$command ne "se") { # check 2 letters command: 'search' or 'sex'?
1158	printf "search <expression>\n";
1159	printf " Cherche des comptes.\n";
1160	printf " Affiche les comptes dont les noms correspondent.\n";
1161	printf "search -r/-e/--expr/--regex <expression>\n";
1162	printf " Cherche des comptes par expression regulière.\n";
1163	printf " Affiche les comptes dont les noms correspondent.\n";
1164	} elsif ("sex" =~ /^\Q$command/ && $command ne "s" && # check 1 letter command: 'search', 'state' or 'sex'?
1165	$command ne "se") { # check 2 letters command: 'search' or 'sex'?
1166	printf "sex <nomcompte> <sexe>\n";
1167	printf " Modifie le sexe d'un compte.\n";
1168	printf " <exemple> sex testname Male\n";
1169	} elsif ("state" =~ /^\Q$command/ && $command ne "s") { # check 1 letter command: 'search', 'state' or 'sex'?
1170	printf "state <nomcompte> <nouveaustatut> <message_erreur_7>\n";
1171	printf " Change le statut d'un compte.\n";
1172	printf " 'nouveaustatut': Le statut est le même que celui du packet 0x006a + 1.\n";
1173	printf " les possibilités sont:\n";
1174	printf " 0 = Compte ok\n";
1175	printf " 1 = Unregistered ID\n";
1176	printf " 2 = Incorrect Password\n";
1177	printf " 3 = This ID is expired\n";
1178	printf " 4 = Rejected from Server\n";
1179	printf " 5 = You have been blocked by the GM Team\n";
1180	printf " 6 = Your Game's EXE file is not the latest version\n";
1181	printf " 7 = You are Prohibited to log in until...\n";
1182	printf " 8 = Server is jammed due to over populated\n";
1183	printf " 9 = No MSG\n";
1184	printf " 100 = This ID has been totally erased\n";
1185	printf " all other values are 'No MSG', then use state 9 please.\n";
1186	printf " 'message_erreur_7': message du code erreur 6 =\n";
1187	printf " = Your are Prohibited to log in until... (packet 0x006a)\n";
1188	} elsif (("timeadd" =~ /^\Q$command/ \|\| $command eq "ta") && $command ne "t") { # check 1 letter command: 'ta' or 'ts'?
1189	printf "timeadd <nomcompte> <modificateur>\n";
1190	printf " Ajoute/soustrait du temps à la limite de validité d'un compte.\n";
1191	printf " Le modificateur est composé comme suit:\n";
1192	printf " Valeur modificatrice (-1, 1, +1, etc...)\n";
1193	printf " Elément modifié:\n";
1194	printf " a ou y: année\n";
1195	printf " m: mois\n";
1196	printf " j ou d: jour\n";
1197	printf " h: heure\n";
1198	printf " mn: minute\n";
1199	printf " s: seconde\n";
1200	printf " <exemple> timeadd testname +1m-2mn1s-6a\n";
1201	printf " Cette exemple ajoute 1 mois et une seconde, et soustrait 2 minutes\n";
1202	printf " et 6 ans dans le même temps.\n";
1203	printf "NOTE: Vous ne pouvez pas modifier une limite de validité illimitée. Si vous\n";
1204	printf " désirez le faire, c'est que vous voulez probablement créer un limite de\n";
1205	printf " validité limitée. Donc, en premier, fixé une limite de valitidé.\n";
1206	} elsif (("timeset" =~ /^\Q$command/ \|\| $command eq "ts") && $command ne "t") { # check 1 letter command: 'ta' or 'ts'?
1207	printf "timeset <nomcompte> aaaa/mm/jj [hh:mm:ss]\n";
1208	printf " Change la limite de validité d'un compte.\n";
1209	printf " Heure par défaut: 23:59:59\n";
1210	printf "timeset <nomcompte> 0\n";
1211	printf " Donne une limite de validité illimitée (0 = illimitée).\n";
1212	} elsif ($command eq "unban" \|\| ("unbanish" =~ /^\Q$command/ && length($command) >= 4)) {
1213	printf "unban/unbanish <nom compte>\n";
1214	printf " Ote le banissement d'un compte.\n";
1215	printf " La commande est l'équivalent de banset <nom_compte> 0.\n";
1216	} elsif ("unblock" =~ /^\Q$command/ && length($command) >= 4) {
1217	printf "unblock <nom compte>\n";
1218	printf " Place le status d'un compte à 0 (Compte ok).\n";
1219	printf " La commande est l'équivalent de state <nom_compte> 0.\n";
1220	} elsif ("version" =~ /^\Q$command/) {
1221	printf "version\n";
1222	printf " Affiche la version du login-serveur.\n";
1223	} elsif ("who" =~ /^\Q$command/) {
1224	printf "who <nomcompte>\n";
1225	printf " Affiche les informations sur un compte.\n";
1226	} elsif ("quit" =~ /^\Q$command/ \|\|
1227	(("end" =~ /^\Q$command/ \|\| "exit" =~ /^\Q$command/) && $command ne "e")) { # check 1 letter command: 'email', 'end' or 'exit'?\n";
1228	printf "quit/end/exit\n";
1229	printf " Fin du programme d'administration.\n";
1230	} else {
1231	if ($receivedcommand ne "") {
1232	printf "Commande inconnue [%s] pour l'aide. Affichage de toutes les commandes.\n", $receivedcommand;
1233	}
1234	print << "ENDOFAIDE";
1235	aide/help/? -- Affiche cet aide
1236	aide/help/? [commande] -- Affiche l'aide de la commande
1237	add <nomcompte> <sexe> <motdepasse> -- Crée un compte (sans email)
1238	ban/banish aaaa/mm/jj hh:mm:ss <nomcompte>-- Change la date finale de banismnt
1239	banadd/ba <nomcompte> <modificateur> -- Ajout/soustrait du temps à la
1240	exemple: ba moncompte +1m-2mn1s-2y date finale de banissement
1241	banset/bs <nomcompte> aaaa/mm/jj [hh:mm:ss] -- Change la date fin de banisemnt
1242	banset/bs <nomcompte> 0 -- Dé-banis un compte.
1243	block <nom compte> -- Mets le status d'un compte à 5 (blocked by the GM Team)
1244	check <nomcompte> <motdepasse> -- Vérifie un mot de passe d'un compte
1245	create <nomcompte> <sexe> <email> <motdepasse> -- Crée un compte (avec email)
1246	del <nomcompte> -- Supprime un compte
1247	email <nomcompte> <email> -- Modifie l'e-mail d'un compte
1248	getcount -- Donne le nb de joueurs en ligne
1249	gm <nomcompte> [Niveau_GM] -- Modifie le niveau de GM d'un compte
1250	id <nomcompte> -- Donne l'id d'un compte
1251	info <idcompte> -- Affiche les infos sur un compte
1252	kami <message> -- Envoi un message général (en jaune)
1253	kamib <message> -- Envoi un message général (en bleu)
1254	language <langue> -- Change la langue d'affichage.
1255	list/ls [Premier_id [Dernier_id] ] -- Affiche une liste de comptes
1256	listBan/lsBan [Premier_id [Dernier_id] ]-- Affiche une liste de comptes
1257	avec un statut ou bannis
1258	listGM/lsGM [Premier_id [Dernier_id] ] -- Affiche une liste de comptes GM
1259	listOK/lsOK [Premier_id [Dernier_id] ] -- Affiche une liste de comptes
1260	sans status et non bannis
1261	memo <nomcompte> <memo> -- Modifie le memo d'un compte
1262	name <idcompte> -- Donne le nom d'un compte
1263	passwd <nomcompte> <nouveaumotdepasse> -- Change le mot de passe d'un compte
1264	quit/end/exit -- Fin du programme d'administation
1265	reloadGM -- Recharger le fichier de config des GM
1266	search <expression> -- Cherche des comptes
1267	search -e/-r/--expr/--regex <expression> -- Cherche des comptes par REGEX
1268	sex <nomcompte> <sexe> -- Modifie le sexe d'un compte
1269	state <nomcompte> <nouveaustatut> <messageerr7> -- Change le statut d'1 compte
1270	timeadd/ta <nomcompte> <modificateur> -- Ajout/soustrait du temps à la
1271	exemple: ta moncompte +1m-2mn1s-2y limite de validité
1272	timeset/ts <nomcompte> aaaa/mm/jj [hh:mm:ss] -- Change la limite de validité
1273	timeset/ts <nomcompte> 0 -- limite de validité = illimitée
1274	unban/unbanish <nom compte> -- Ote le banissement d'un compte
1275	unblock <nom compte> -- Mets le status d'un compte à 0 (Compte ok)
1276	version -- Donne la version du login-serveur
1277	who <nomcompte> -- Affiche les infos sur un compte
1278	ENDOFAIDE
1279	printf(" Note: Pour les noms de compte avec des espaces, tapez \"<nom compte>\" (ou ').\n");
1280	}
1281	} else {
1282	if ("aide" =~ /^\Q$command/ && $command ne "a") { # check 1 letter command: 'aide' or 'add'?
1283	printf "aide/help/?\n";
1284	printf " Display the description of the commands\n";
1285	printf "aide/help/? [command]\n";
1286	printf " Display the description of the specified command\n";
1287	} elsif ("help" =~ /^\Q$command/) {
1288	printf "aide/help/?\n";
1289	printf " Display the description of the commands\n";
1290	printf "aide/help/? [command]\n";
1291	printf " Display the description of the specified command\n";
1292	} elsif ("add" =~ /^\Q$command/ && $command ne "a") { # check 1 letter command: 'aide' or 'add'?
1293	printf "add <account_name> <sex> <password>\n";
1294	printf " Create an account with the default email (a\@a.com).\n";
1295	printf " Concerning the sex, only the first letter is used (F or M).\n";
1296	printf " The e-mail is set to a\@a.com (default e-mail). It's like to have no e-mail.\n";
1297	printf " When the password is omitted,\n";
1298	printf " the input is done without displaying of the pressed keys.\n";
1299	printf " <example> add testname Male testpass\n";
1300	} elsif ($command eq "ban" \|\| ("banish" =~ /^\Q$command/ && length($command) >= 4)) {
1301	printf "ban/banish yyyy/mm/dd hh:mm:ss <account_name>\n";
1302	printf " Changes the final date of a banishment of an account.\n";
1303	printf " The difference with banset is the position of the account name.\n";
1304	} elsif (("banadd" =~ /^\Q$command/ \|\| $command eq "ba") && $command ne "b") { # check 1 letter command: 'ba' or 'bs'?
1305	printf "banadd <account_name> <modifier>\n";
1306	printf " Adds or substracts time from the final date of a banishment of an account.\n";
1307	printf " Modifier is done as follows:\n";
1308	printf " Adjustment value (-1, 1, +1, etc...)\n";
1309	printf " Modified element:\n";
1310	printf " a or y: year\n";
1311	printf " m: month\n";
1312	printf " j or d: day\n";
1313	printf " h: hour\n";
1314	printf " mn: minute\n";
1315	printf " s: second\n";
1316	printf " <example> banadd testname +1m-2mn1s-6y\n";
1317	printf " this example adds 1 month and 1 second, and substracts 2 minutes\n";
1318	printf " and 6 years at the same time.\n";
1319	printf "NOTE: If you modify the final date of a non-banished account,\n";
1320	printf " you fix the final date to (actual time +- adjustments)\n";
1321	} elsif (("banset" =~ /^\Q$command/ \|\| $command eq "bs") && $command ne "b") { # check 1 letter command: 'ba' or 'bs'?
1322	printf "banset <account_name> yyyy/mm/dd [hh:mm:ss]\n";
1323	printf " Changes the final date of a banishment of an account.\n";
1324	printf " Default time: 23:59:59\n";
1325	printf "banset <account_name> 0\n";
1326	printf " Set a non-banished account (0 = unbanished).\n";
1327	} elsif ("block" =~ /^\Q$command/ && length($command) >= 2) {
1328	printf "block <account name>\n";
1329	printf " Set state 5 (You have been blocked by the GM Team) to an account.\n";
1330	printf " Same command of state <account_name> 5.\n";
1331	} elsif ("check" =~ /^\Q$command/ && $command ne "c") { # check 1 letter command: 'check' or 'create'?
1332	printf "check <account_name> <password>\n";
1333	printf " Check the validity of a password for an account.\n";
1334	printf " NOTE: Server will never sends back a password.\n";
1335	printf " It's the only method you have to know if a password is correct.\n";
1336	printf " The other method is to have a ('physical') access to the accounts file.\n";
1337	} elsif ("create" =~ /^\Q$command/ && $command ne "c") { # check 1 letter command: 'check' or 'create'?
1338	printf "create <account_name> <sex> <email> <password>\n";
1339	printf " Like the 'add' command, but with e-mail moreover.\n";
1340	printf " <example> create testname Male my\@mail.com testpass\n";
1341	} elsif ("del" =~ /^\Q$command/ \|\| "delete" =~ /^\Q$command/) {
1342	printf "del <account_name>\n";
1343	printf " Remove an account.\n";
1344	printf " This order requires confirmation. After confirmation, the account is deleted.\n";
1345	} elsif ("email" =~ /^\Q$command/ && $command ne "e") { # check 1 letter command: 'email', 'end' or 'exit'?
1346	printf "email <account_name> <email>\n";
1347	printf " Modify the e-mail of an account.\n";
1348	} elsif ("getcount" =~ /^\Q$command/ && $command ne "g") { # check 1 letter command: 'getcount' or 'gm'?
1349	printf "getcount\n";
1350	printf " Give the number of players online on all char-servers.\n";
1351	} elsif ("gm" =~ /^\Q$command/ && $command ne "g") { # check 1 letter command: 'getcount' or 'gm'?
1352	printf "gm <account_name> [GM_level]\n";
1353	printf " Modify the GM level of an account.\n";
1354	printf " Default value remove GM level (GM level = 0).\n";
1355	printf " <example> gm testname 80\n";
1356	} elsif ("id" =~ /^\Q$command/ && $command ne "i") { # check 1 letter command: 'id' or 'info'?
1357	printf "id <account_name>\n";
1358	printf " Give the id of an account.\n";
1359	} elsif ("info" =~ /^\Q$command/ && $command ne "i") { # check 1 letter command: 'id' or 'info'?
1360	printf "info <account_id>\n";
1361	printf " Display complete information of an account.\n";
1362	} elsif ($command eq "kami") { # check all letters command: 'kami' or 'kamib'?
1363	printf "kami <message>\n";
1364	printf " Sends a broadcast message on all map-server (in yellow).\n";
1365	} elsif ($command eq "kamib") { # check all letters command: 'kami' or 'kamib'?
1366	printf "kamib <message>\n";
1367	printf " Sends a broadcast message on all map-server (in blue).\n";
1368	} elsif ("language" =~ /^\Q$command/ && $command ne "l") { # check 1 letter command: 'list' or 'language'?
1369	printf("language <language>\n");
1370	printf(" Change the language of displaying.\n");
1371	printf(" Possible languages: Français or English.\n");
1372	} elsif (("list" =~ /^\Q$command/ \|\| $command eq "ls") && $command ne "l") { # check 1 letter command: 'list' or 'language'?
1373	printf "list/ls [start_id [end_id]]\n";
1374	printf " Display a list of accounts.\n";
1375	printf " 'start_id', 'end_id': indicate end and start identifiers.\n";
1376	printf " Research by name is not possible with this command.\n";
1377	printf " <example> list 10 9999999\n";
1378	} elsif (("listban" =~ /^\Q$command/ \|\| $command eq "lsban") && $command ne "l") { # need to specificaly write Ban to have this list # check 1 letter command: 'list' or 'language'?
1379	printf "listBan/lsBan [start_id [end_id]]\n";
1380	printf " Like list/ls, but only for accounts with state or banished.\n";
1381	} elsif (("listgm" =~ /^\Q$command/ \|\| $command eq "lsgm") && $command ne "l") { # need to specificaly write GM to have this list # check 1 letter command: 'list' or 'language'?
1382	printf "listGM/lsGM [start_id [end_id]]\n";
1383	printf " Like list/ls, but only for GM accounts.\n";
1384	} elsif (("listok" =~ /^\Q$command/ \|\| $command eq "lsok") && $command ne "l") { # need to specificaly write OK to have this list # check 1 letter command: 'list' or 'language'?
1385	printf "listOK/lsOK [start_id [end_id]]\n";
1386	printf " Like list/ls, but only for accounts without state and not banished.\n";
1387	} elsif ("memo" =~ /^\Q$command/) {
1388	printf "memo <account_name> <memo>\n";
1389	printf " Modify the memo of an account.\n";
1390	printf " 'memo': it can have until 253 characters (with spaces or not).\n";
1391	} elsif ("name" =~ /^\Q$command/) {
1392	printf "name <account_id>\n";
1393	printf " Give the name of an account.\n";
1394	} elsif ("passwd" =~ /^\Q$command/ \|\| "password" =~ /^\Q$command/) {
1395	printf "passwd <account_name> <new_password>\n";
1396	printf " Change the password of an account.\n";
1397	printf " When new password is omitted,\n";
1398	printf " the input is done without displaying of the pressed keys.\n";
1399	} elsif ("reloadgm" =~ /^\Q$command/) {
1400	printf "reloadGM\n";
1401	printf " Reload GM configuration file\n";
1402	} elsif ("search" =~ /^\Q$command/ && $command ne "s" && # check 1 letter command: 'search', 'state' or 'sex'?
1403	$command ne "se") { # check 2 letters command: 'search' or 'sex'?
1404	printf "search <expression>\n";
1405	printf " Seek accounts.\n";
1406	printf " Displays the accounts whose names correspond.\n";
1407	printf "search -r/-e/--expr/--regex <expression>\n";
1408	printf " Seek accounts by regular expression.\n";
1409	printf " Displays the accounts whose names correspond.\n";
1410	} elsif ("sex" =~ /^\Q$command/ && $command ne "s" && # check 1 letter command: 'search', 'state' or 'sex'?
1411	$command ne "se") { # check 2 letters command: 'search' or 'sex'?
1412	printf "sex <account_name> <sex>\n";
1413	printf " Modify the sex of an account.\n";
1414	printf " <example> sex testname Male\n";
1415	} elsif ("state" =~ /^\Q$command/ && $command ne "s") { # check 1 letter command: 'search', 'state' or 'sex'?
1416	printf "state <account_name> <new_state> <error_message_#7>\n";
1417	printf " Change the state of an account.\n";
1418	printf " 'new_state': state is the state of the packet 0x006a + 1.\n";
1419	printf " The possibilities are:\n";
1420	printf " 0 = Account ok\n";
1421	printf " 1 = Unregistered ID\n";
1422	printf " 2 = Incorrect Password\n";
1423	printf " 3 = This ID is expired\n";
1424	printf " 4 = Rejected from Server\n";
1425	printf " 5 = You have been blocked by the GM Team\n";
1426	printf " 6 = Your Game's EXE file is not the latest version\n";
1427	printf " 7 = You are Prohibited to log in until...\n";
1428	printf " 8 = Server is jammed due to over populated\n";
1429	printf " 9 = No MSG\n";
1430	printf " 100 = This ID has been totally erased\n";
1431	printf " all other values are 'No MSG', then use state 9 please.\n";
1432	printf " 'error_message_#7': message of the code error 6\n";
1433	printf " = Your are Prohibited to log in until... (packet 0x006a)\n";
1434	} elsif (("timeadd" =~ /^\Q$command/ \|\| $command eq "ta") && $command ne "t") { # check 1 letter command: 'ta' or 'ts'?
1435	printf "timeadd <account_name> <modifier>\n";
1436	printf " Adds or substracts time from the validity limit of an account.\n";
1437	printf " Modifier is done as follows:\n";
1438	printf " Adjustment value (-1, 1, +1, etc...)\n";
1439	printf " Modified element:\n";
1440	printf " a or y: year\n";
1441	printf " m: month\n";
1442	printf " j or d: day\n";
1443	printf " h: hour\n";
1444	printf " mn: minute\n";
1445	printf " s: second\n";
1446	printf " <example> timeadd testname +1m-2mn1s-6y\n";
1447	printf " this example adds 1 month and 1 second, and substracts 2 minutes\n";
1448	printf " and 6 years at the same time.\n";
1449	printf "NOTE: You can not modify a unlimited validity limit.\n";
1450	printf " If you want modify it, you want probably create a limited validity limit.\n";
1451	printf " So, at first, you must set the validity limit to a date/time.\n";
1452	} elsif (("timeset" =~ /^\Q$command/ \|\| $command eq "ts") && $command ne "t") { # check 1 letter command: 'ta' or 'ts'?
1453	printf "timeset <account_name> yyyy/mm/dd [hh:mm:ss]\n";
1454	printf " Changes the validity limit of an account.\n";
1455	printf " Default time: 23:59:59\n";
1456	printf "timeset <account_name> 0\n";
1457	printf " Gives an unlimited validity limit (0 = unlimited).\n";
1458	} elsif ($command eq "unban" \|\| ("unbanish" =~ /^\Q$command/ && length($command) >= 4)) {
1459	printf "unban/unbanish <account name>\n";
1460	printf " Remove the banishment of an account.\n";
1461	printf " This command works like banset <account_name> 0.\n";
1462	} elsif ("unblock" =~ /^\Q$command/ && length($command) >= 4) {
1463	printf "unblock <account name>\n";
1464	printf " Set state 0 (Account ok) to an account.\n";
1465	printf " This command works like state <account_name> 0.\n";
1466	} elsif ("version" =~ /^\Q$command/) {
1467	printf "version\n";
1468	printf " Display the version of the login-server.\n";
1469	} elsif ("who" =~ /^\Q$command/) {
1470	printf "who <account_name>\n";
1471	printf " Displays complete information of an account.\n";
1472	} elsif ("quit" =~ /^\Q$command/ \|\|
1473	(("end" =~ /^\Q$command/ \|\| "exit" =~ /^\Q$command/) && $command ne "e")) { # check 1 letter command: 'email', 'end' or 'exit'?\n";
1474	printf "quit/end/exit\n";
1475	printf " End of the program of administration.\n";
1476	} else {
1477	if ($receivedcommand ne "") {
1478	printf "Unknown command [%s] for help. Displaying of all commands.\n", $receivedcommand;
1479	}
1480	print << "ENDOFHELP";
1481	aide/help/? -- Display this help
1482	aide/help/? [command] -- Display the help of the command
1483	add <account_name> <sex> <password> -- Create an account with default email
1484	ban/banish yyyy/mm/dd hh:mm:ss <account_name> -- Change final date of a ban
1485	banadd/ba <account_name> <modifier> -- Add or substract time from the final
1486	example: ba apple +1m-2mn1s-2y date of a banishment of an account
1487	banset/bs <account_name> yyyy/mm/dd [hh:mm:ss] -- Change final date of a ban
1488	banset/bs <account_name> 0 -- Un-banish an account
1489	block <account name> -- Set state 5 (blocked by the GM Team) to an account
1490	check <account_name> <password> -- Check the validity of a password
1491	create <account_name> <sex> <email> <passwrd> -- Create an account with email
1492	del <account_name> -- Remove an account
1493	email <account_name> <email> -- Modify an email of an account
1494	getcount -- Give the number of players online
1495	gm <account_name> [GM_level] -- Modify the GM level of an account
1496	id <account_name> -- Give the id of an account
1497	info <account_id> -- Display all information of an account
1498	kami <message> -- Sends a broadcast message (in yellow)
1499	kamib <message> -- Sends a broadcast message (in blue)
1500	language <language> -- Change the language of displaying.
1501	list/ls [First_id [Last_id]] -- Display a list of accounts
1502	listBan/lsBan [First_id [Last_id]] -- Display a list of accounts
1503	with state or banished
1504	listGM/lsGM [First_id [Last_id]] -- Display a list of GM accounts
1505	listOK/lsOK [First_id [Last_id]] -- Display a list of accounts
1506	without state and not banished
1507	memo <account_name> <memo> -- Modify the memo of an account
1508	name <account_id> -- Give the name of an account
1509	passwd <account_name> <new_password> -- Change the password of an account
1510	quit/end/exit -- End of the program of administation
1511	reloadGM -- Reload GM configuration file
1512	search <expression> -- Seek accounts
1513	search -e/-r/--expr/--regex <expressn> -- Seek accounts by regular-expression
1514	sex <nomcompte> <sexe> -- Modify the sex of an account
1515	state <account_name> <new_state> <error_message_#7> -- Change the state
1516	timeadd/ta <account_name> <modifier> -- Add or substract time from the
1517	example: ta apple +1m-2mn1s-2y validity limit of an account
1518	timeset/ts <account_name> yyyy/mm/dd [hh:mm:ss] -- Change the validify limit
1519	timeset/ts <account_name> 0 -- Give a unlimited validity limit
1520	unban/unbanish <account name> -- Remove the banishment of an account
1521	unblock <account name> -- Set state 0 (Account ok) to an account
1522	version -- Gives the version of the login-server
1523	who <account_name> -- Display all information of an account
1524	ENDOFHELP
1525	printf(" Note: To use spaces in an account name, type \"<account name>\" (or ').\n");
1526	}
1527	}
1528
1529	return 0;
1530	}
1531	#--------------------------------------------------------------------------
1532
1533	# Sub-function: Displaying of the accounts list
1534	sub listaccount() {
1535	my($st, $ed, $listflag) = @_;
1536	my($i);
1537	my($n) = (0);
1538	# 0123456789 01 01234567890123456789012301234 012345 0123456789012345678901234567
1539	if ($defaultlanguage eq "F") {
1540	print " id_compte GM nom_utilisateur sexe count statut\n";
1541	} else {
1542	print "account_id GM user_name sex count state\n";
1543	}
1544	print "-------------------------------------------------------------------------------\n";
1545	while(1) {
1546	print $so pack("vV2", 0x7920, $st, $ed);
1547	$so->flush();
1548	$buf = readso(4);
1549	if (unpack("v", $buf) != 0x7921) {
1550	if ($defaultlanguage eq "F") {
1551	print "Problème de connexion au serveur (réponse incorrecte).\n";
1552	} else {
1553	print "Connection error to the server (incorrect answer).\n";
1554	}
1555	exit(10);
1556	}
1557	my($len) = unpack("x2v", $buf);
1558	last if ($len <= 4);
1559	for($i = 4; $i < $len; $i += 38) {
1560	my(@dat) = unpack("VCa24cVV", readso(38));
1561	$st = $dat[0] + 1;
1562	if ($listflag == 0 \|\|
1563	($listflag == 1 && $dat[1] > 0) \|\| # check GM flag
1564	($listflag == 3 && $dat[5] != 0) \|\| # check with state or banished
1565	($listflag == 4 && $dat[5] == 0)) { # check without state and not banished
1566	printf "%10d %2s %-24s%-5s %6d %-27s\n", $dat[0],
1567	($dat[1] == 0 ? " " : $dat[1]),
1568	$dat[2],
1569	($defaultlanguage eq "F" ? ("Femme","Male","Servr")[$dat[3]] : ("Femal","Male","Servr")[$dat[3]]),
1570	$dat[4],
1571	(($defaultlanguage eq "F" ? "Compte Ok" : "Account OK"),
1572	"Unregistered ID",
1573	"Incorrect Password",
1574	"This ID is expired",
1575	"Rejected from Server",
1576	"Blocked by the GM Team", # You have been blocked by the GM Team
1577	"Your EXE file is too old", # Your Game's EXE file is not the latest version
1578	"Banishement or\n Prohibited to login until %s", # You are Prohibited to log in until %s
1579	"Server is over populated", # Server is jammed due to over populated
1580	"No MSG",
1581	"This ID is totally erased")[$dat[5] == 100 ? 10 : $dat[5]]; # This ID has been totally erased
1582	$n++;
1583	}
1584	}
1585	}
1586	if ($defaultlanguage eq "F") {
1587	if ($n == 0) {
1588	print "Aucun compte trouvé.\n";
1589	} elsif ($n == 1) {
1590	print "1 compte trouvé.\n";
1591	} else {
1592	print "$n comptes trouvés.\n";
1593	}
1594	} else {
1595	if ($n == 0) {
1596	print "No account found.\n";
1597	} elsif ($n == 1) {
1598	print "1 account found.\n";
1599	} else {
1600	print "$n accounts found.\n";
1601	}
1602	}
1603	return 0;
1604	}
1605
1606	#--------------------------------------------------------------------------
1607
1608	# Sub-function: add an account with the default e-mail
1609	sub addaccount() {
1610	my($userid, $sex, $passwd) = @_;
1611	if ($userid eq "" \|\| !defined($userid)) {
1612	if ($defaultlanguage eq "F") {
1613	print "Entrez un nom de compte svp.\n";
1614	print "<exemple> add nomtest Male motdepassetest\n";
1615	} else {
1616	print "Please input an account name.\n";
1617	print "<example> add testname Male testpass\n";
1618	}
1619	return 136;
1620	}
1621	if (verify_accountname($userid) == 0) {
1622	return 102;
1623	}
1624	# if ($userid =~ /[^A-Za-z0-9\@-_]/) {
1625	# if ($defaultlanguage eq "F") {
1626	# print "Caractère interdit trouvé dans le nom du compte ".$`."[${&}]${'}\n";
1627	# } else {
1628	# print "Illegal character found in the account name ".$`."[${&}]${'}\n";
1629	# }
1630	# return 101;
1631	# }
1632	$sex = uc(substr($sex, 0, 1));
1633	if ($sex !~ /^[MF]$/) {
1634	if ($defaultlanguage eq "F") {
1635	print "Sexe incorrect [$sex]. Entrez M ou F svp.\n";
1636	} else {
1637	print "Illegal gender [$sex]. Please input M or F.\n";
1638	}
1639	return 103;
1640	}
1641	if ($passwd eq "") {
1642	return 108 if (($passwd = typepasswd()) eq "");
1643	}
1644	if (verify_password($passwd) == 0) {
1645	return 104;
1646	}
1647	print $so pack("va24a24a1a40", 0x7930, $userid, $passwd, $sex, "");
1648	$so->flush();
1649	$buf = readso(2);
1650	if (unpack("v", $buf) != 0x7931) {
1651	if ($defaultlanguage eq "F") {
1652	print "Problème de connexion au serveur (réponse incorrecte).\n";
1653	} else {
1654	print "Connection error to the server (incorrect answer).\n";
1655	}
1656	return 106;
1657	}
1658	$buf = readso(28);
1659	if (unpack("V", $buf) == -1 \|\| unpack("V", $buf) == 4294967295) {
1660	if ($defaultlanguage eq "F") {
1661	print "Echec à la création du compte [$userid]. Un compte identique existe déjà.\n";
1662	} else {
1663	print "Account [$userid] creation failed. Same account already exists.\n";
1664	}
1665	return 107;
1666	} else {
1667	if ($defaultlanguage eq "F") {
1668	printf "Compte [$userid] créé avec succès [id: %d].\n", unpack("V",$buf);
1669	} else {
1670	printf "Account [$userid] is successfully created [id: %d].\n", unpack("V",$buf);
1671	}
1672	}
1673	return 0;
1674	}
1675
1676	#--------------------------------------------------------------------------
1677
1678	# Sub-function: add an account with an e-mail
1679	sub createaccount() {
1680	my($userid, $sex, $email, $passwd) = @_;
1681	if ($userid eq "") {
1682	if ($defaultlanguage eq "F") {
1683	print "Entrez un nom de compte svp.\n";
1684	print "<exemple> create nomtest Male mon\@email.com motdepassetest\n";
1685	} else {
1686	print "Please input an account name.\n";
1687	print "<example> create testname Male my\@mail.com testpass\n";
1688	}
1689	return 136;
1690	}
1691	if (verify_accountname($userid) == 0) {
1692	return 102;
1693	}
1694	# if ($userid =~ /[^A-Za-z0-9\@-_]/) {
1695	# if ($defaultlanguage eq "F") {
1696	# print "Caractère interdit trouvé dans le nom du compte ".$`."[${&}]${'}\n";
1697	# } else {
1698	# print "Illegal character found in the account name ".$`."[${&}]${'}\n";
1699	# }
1700	# return 101;
1701	# }
1702	$sex = uc(substr($sex, 0, 1));
1703	if ($sex !~ /^[MF]$/) {
1704	if ($defaultlanguage eq "F") {
1705	print "Sexe incorrect [$sex]. Entrez M ou F svp.\n";
1706	} else {
1707	print "Illegal gender [$sex]. Please input M or F.\n";
1708	}
1709	return 103;
1710	}
1711	if (length($email) < 3) {
1712	if ($defaultlanguage eq "F") {
1713	print "Email trop courte [$email]. Entrez une e-mail valide svp.\n";
1714	} else {
1715	print "Email is too short [$email]. Please input a valid e-mail.\n";
1716	}
1717	return 109;
1718	}
1719	if (length($email) > 39) {
1720	if ($defaultlanguage eq "F") {
1721	print "Email trop longue [$email]. Entrez une e-mail de 39 caractères maximum svp.\n";
1722	} else {
1723	print "Email is too long [$email]. Please input an e-mail with 39 bytes at the most.\n";
1724	}
1725	return 109;
1726	}
1727	if (verify_email($email) == 0) {
1728	if ($defaultlanguage eq "F") {
1729	print "Email incorrecte [$email]. Entrez une e-mail valide svp.\n";
1730	} else {
1731	print "Invalid email [$email]. Please input a valid e-mail.\n";
1732	}
1733	return 109;
1734	}
1735	if ($passwd eq "") {
1736	return 108 if (($passwd = typepasswd()) eq "");
1737	}
1738	if (verify_password($passwd) == 0) {
1739	return 104;
1740	}
1741	print $so pack("va24a24a1a40", 0x7930, $userid, $passwd, $sex, $email);
1742	$so->flush();
1743	$buf = readso(2);
1744	if (unpack("v", $buf) != 0x7931) {
1745	if ($defaultlanguage eq "F") {
1746	print "Problème de connexion au serveur (réponse incorrecte).\n";
1747	} else {
1748	print "Connection error to the server (incorrect answer).\n";
1749	}
1750	return 106;
1751	}
1752	$buf = readso(28);
1753	if (unpack("V", $buf) == -1 \|\| unpack("V", $buf) == 4294967295) {
1754	if ($defaultlanguage eq "F") {
1755	print "Echec à la création du compte [$userid]. Un compte identique existe déjà.\n";
1756	} else {
1757	print "Account [$userid] creation failed. Same account already exists.\n";
1758	}
1759	return 107;
1760	} else {
1761	if ($defaultlanguage eq "F") {
1762	printf "Compte [$userid] créé avec succès [id: %d].\n", unpack("V",$buf);
1763	} else {
1764	printf "Account [$userid] is successfully created [id: %d].\n", unpack("V",$buf);
1765	}
1766	}
1767	return 0;
1768	}
1769
1770	#--------------------------------------------------------------------------
1771
1772	# Sub-function: deletion of an account
1773	sub delaccount() {
1774	my($userid) = @_;
1775	if ($userid eq "") {
1776	if ($defaultlanguage eq "F") {
1777	print "Entrez un nom de compte svp.\n";
1778	print "<exemple> del nomtestasupprimer\n";
1779	} else {
1780	print "Please input an account name.\n";
1781	print "<example> del testnametodelete\n";
1782	}
1783	return 136;
1784	}
1785	if (verify_accountname($userid) == 0) {
1786	return 102;
1787	}
1788	if ($defaultlanguage eq "F") {
1789	print "** Etes-vous vraiment sûr de vouloir SUPPRIMER le compte [$userid]? (o/n) ";
1790	} else {
1791	print "** Are you really sure to DELETE account [$userid]? (y/n) ";
1792	}
1793	if (lc(substr(<STDIN>, 0, 1)) !~ /[oy]/) {
1794	if ($defaultlanguage eq "F") {
1795	print "Suppression annulée\n.";
1796	} else {
1797	print "Deletion canceled\n";
1798	}
1799	return 121;
1800	}
1801	print $so pack("va24", 0x7932, $userid);
1802	$so->flush();
1803	$buf = readso(2);
1804	if (unpack("v", $buf) != 0x7933) {
1805	if ($defaultlanguage eq "F") {
1806	print "Problème de connexion au serveur (réponse incorrecte).\n";
1807	} else {
1808	print "Connection error to the server (incorrect answer).\n";
1809	}
1810	return 122;
1811	}
1812	$buf = readso(28);
1813	my($id2, $name) = unpack("Va24", $buf);
1814	while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
1815	chop($name);
1816	};
1817	if ($id2 == -1 \|\| $id2 == 4294967295) {
1818	if ($defaultlanguage eq "F") {
1819	print "Echec de la suppression du compte [$userid]. Le compte n'existe pas.\n";
1820	} else {
1821	print "Account [$userid] deletion failed. Account doesn't exist.\n";
1822	}
1823	return 123;
1824	} else {
1825	if ($defaultlanguage eq "F") {
1826	print "Compte [$name][id: $id2] SUPPRIME avec succès.\n";
1827	} else {
1828	print "Account [$name][id: $id2] is successfully DELETED.\n";
1829	}
1830	}
1831	return 0;
1832	}
1833
1834	#--------------------------------------------------------------------------
1835
1836	# Sub-function: modification of a password
1837	sub changepasswd() {
1838	my($userid, $passwd) = @_;
1839	if ($userid eq "") {
1840	if ($defaultlanguage eq "F") {
1841	print "Entrez un nom de compte svp.\n";
1842	print "<exemple> passwd nomtest nouveaumotdepasse\n";
1843	} else {
1844	print "Please input an account name.\n";
1845	print "<example> passwd testname newpassword\n";
1846	}
1847	return 136;
1848	}
1849	if (verify_accountname($userid) == 0) {
1850	return 102;
1851	}
1852	if ($passwd eq "") {
1853	return 134 if (($passwd = typepasswd()) eq "");
1854	}
1855	if (verify_password($passwd) == 0) {
1856	return 131;
1857	}
1858	print $so pack("va24a24", 0x7934, $userid,$passwd);
1859	$so->flush();
1860	$buf = readso(2);
1861	if (unpack("v", $buf) != 0x7935) {
1862	if ($defaultlanguage eq "F") {
1863	print "Problème de connexion au serveur (réponse incorrecte).\n";
1864	} else {
1865	print "Connection error to the server (incorrect answer).\n";
1866	}
1867	return 132;
1868	}
1869	$buf = readso(28);
1870	my($id2, $name) = unpack("Va24", $buf);
1871	while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
1872	chop($name);
1873	};
1874	if ($id2 == -1 \|\| $id2 == 4294967295) {
1875	if ($defaultlanguage eq "F") {
1876	print "Echec de la modification du mot de passe du compte [$userid].\n";
1877	print "Le compte [$userid] n'existe pas.\n";
1878	} else {
1879	print "Account [$userid] password changing failed.\n";
1880	print "Account [$userid] doesn't exist.\n";
1881	}
1882	return 133;
1883	} else {
1884	if ($defaultlanguage eq "F") {
1885	print "Modification du mot de passe du compte [$name][id: $id2] réussie.\n";
1886	} else {
1887	print "Account [$name][id: $id2] password successfully changed.\n";
1888	}
1889	}
1890	return 130;
1891	}
1892
1893	#--------------------------------------------------------------------------
1894
1895	# Sub-function: modification of an account e-mail
1896	sub changeemail() {
1897	my($userid, $email) = @_;
1898	if ($userid eq "") {
1899	if ($defaultlanguage eq "F") {
1900	print "Entrez un nom de compte svp.\n";
1901	print "<exemple> email testname nouveauemail\n";
1902	} else {
1903	print "Please input an account name.\n";
1904	print "<example> email testname newemail\n";
1905	}
1906	return 136;
1907	}
1908	if (verify_accountname($userid) == 0) {
1909	return 102;
1910	}
1911	if (length($email) < 3) {
1912	if ($defaultlanguage eq "F") {
1913	print "Email trop courte [$email]. Entrez une e-mail valide svp.\n";
1914	} else {
1915	print "Email is too short [$email]. Please input a valid e-mail.\n";
1916	}
1917	return 109;
1918	}
1919	if (length($email) > 39) {
1920	if ($defaultlanguage eq "F") {
1921	print "Email trop longue [$email]. Entrez une e-mail de 39 caractères maximum svp.\n";
1922	} else {
1923	print "Email is too long [$email]. Please input an e-mail with 39 bytes at the most.\n";
1924	}
1925	return 109;
1926	}
1927	if (verify_email($email) == 0) {
1928	if ($defaultlanguage eq "F") {
1929	print "Email incorrect [$email]. Entrez une e-mail valide svp.\n";
1930	} else {
1931	print "Invalid email [$email]. Please input a valid e-mail.\n";
1932	}
1933	return 109;
1934	}
1935	print $so pack("va24a40", 0x7940, $userid, $email);
1936	$so->flush();
1937	$buf = readso(2);
1938	if (unpack("v", $buf) != 0x7941) {
1939	if ($defaultlanguage eq "F") {
1940	print "Problème de connexion au serveur (réponse incorrecte).\n";
1941	} else {
1942	print "Connection error to the server (incorrect answer).\n";
1943	}
1944	return 162;
1945	}
1946	$buf = readso(28);
1947	my($id2, $name) = unpack("Va24", $buf);
1948	while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
1949	chop($name);
1950	};
1951	if ($id2 == -1 \|\| $id2 == 4294967295) {
1952	if ($defaultlanguage eq "F") {
1953	print "Echec de la modification de l'e-mail du compte [$userid].\n";
1954	print "Le compte [$userid] n'existe pas.\n";
1955	} else {
1956	print "Account [$userid] e-mail changing failed.\n";
1957	print "Account [$userid] doesn't exist.\n";
1958	}
1959	return 133;
1960	} else {
1961	if ($defaultlanguage eq "F") {
1962	print "Modification de l'e-mail du compte [$name][id: $id2] réussie.\n";
1963	} else {
1964	print "Account [$name][id: $id2] e-mail successfully changed.\n";
1965	}
1966	}
1967	return 160;
1968	}
1969
1970	#--------------------------------------------------------------------------
1971
1972	# Sub-function: search of accounts
1973	sub searchaccount() {
1974	my($p1, $p2) = @_;
1975	my($exp) = ("");
1976	if ($p1 eq "-e" \|\| $p1 eq "-r" \|\| $p1 eq "--regex" \|\| $p1 eq "--expr") {
1977	if ($p2 eq "") {
1978	if ($defaultlanguage eq "F") {
1979	print "Entrez une expression régulière ou utilisez 'ls' pour avoir tous les comptes.\n";
1980	} else {
1981	print "Input a regular expression or use 'ls' to obtain all accounts.\n";
1982	}
1983	return 141;
1984	}
1985	$exp = $p2;
1986	} else {
1987	if ($p1 eq "") {
1988	if ($defaultlanguage eq "F") {
1989	print "Entrez une chaîne ou utilisez 'ls' pour avoir tous les comptes.\n";
1990	} else {
1991	print "Input a string or use 'ls' to obtain all accounts.\n";
1992	}
1993	return 141;
1994	}
1995	my($c) = 0;
1996	$exp = lc($p1);
1997	$exp =~ s/([\@])/\\$1/g;
1998	$c += $exp =~ s/([\-\[\]])/\\$1/g;
1999	$c += $exp =~ s/([\*\?])/.$1/g;
2000	$c += $exp =~ s/\\\[(.)\\\-(.)\\\]/[$1-$2]/g;
2001	$exp = "^$exp\$" if $c;
2002	}
2003	if (eval{ "" =~ /$exp/; }, $@) {
2004	if ($defaultlanguage eq "F") {
2005	print "Expression régulière non reconnue.\n";
2006	} else {
2007	print "Regular-Expression compiling failed.\n";
2008	}
2009	return 141;
2010	}
2011	my($i);
2012	my($n, $st) = (0, 0);
2013	# 0123456789 01 01234567890123456789012301234 012345 0123456789012345678901234567
2014	if ($defaultlanguage eq "F") {
2015	print " id_compte GM nom_utilisateur sexe count statut\n";
2016	} else {
2017	print "account_id GM user_name sex count state\n";
2018	}
2019	print "-------------------------------------------------------------------------------\n";
2020	while(1) {
2021	print $so pack("vV2", 0x7920, $st, 0);
2022	$so->flush();
2023	$buf = readso(4);
2024	if (unpack("v", $buf) != 0x7921) {
2025	if ($defaultlanguage eq "F") {
2026	print "Problème de connexion au serveur (réponse incorrecte).\n";
2027	} else {
2028	print "Connection error to the server (incorrect answer).\n";
2029	}
2030	exit(10);
2031	}
2032	my($len) = unpack("x2v", $buf);
2033	last if ($len <= 4);
2034	for($i = 4; $i < $len; $i += 38) {
2035	my(@dat) = unpack("VCa24cVV", readso(38));
2036	$st = $dat[0] + 1;
2037	next if (lc($dat[2]) !~ /$exp/);
2038	printf "%10d %2s %-24s%-5s %6d %-27s\n", $dat[0],
2039	($dat[1] == 0 ? " " : $dat[1]),
2040	$dat[2],
2041	($defaultlanguage eq "F" ? ("Femme","Male","Servr")[$dat[3]] : ("Femal","Male","Servr")[$dat[3]]),
2042	$dat[4],
2043	(($defaultlanguage eq "F" ? "Compte Ok" : "Account OK"),
2044	"Unregistered ID",
2045	"Incorrect Password",
2046	"This ID is expired",
2047	"Rejected from Server",
2048	"Blocked by the GM Team", # You have been blocked by the GM Team
2049	"Your EXE file is too old", # Your Game's EXE file is not the latest version
2050	"Banishement or\n Prohibited to login until %s", # You are Prohibited to log in until %s
2051	"Server is over populated", # Server is jammed due to over populated
2052	"No MSG",
2053	"This ID is totally erased")[$dat[5] == 100 ? 10 : $dat[5]]; # This ID has been totally erased
2054	$n++;
2055	}
2056	}
2057	if ($defaultlanguage eq "F") {
2058	if ($n == 0) {
2059	print "Aucun compte trouvé.\n";
2060	} elsif ($n == 1) {
2061	print "1 compte trouvé.\n";
2062	} else {
2063	print "$n comptes trouvés.\n";
2064	}
2065	} else {
2066	if ($n == 0) {
2067	print "No account found.\n";
2068	} elsif ($n == 1) {
2069	print "1 account found.\n";
2070	} else {
2071	print "$n accounts found.\n";
2072	}
2073	}
2074	return 0;
2075	}
2076
2077	#--------------------------------------------------------------------------
2078
2079	# Sub-function: modify the sex of an account
2080	sub changesex() {
2081	my($userid, $sex) = @_;
2082	if ($userid eq "" \|\| !defined($userid)) {
2083	if ($defaultlanguage eq "F") {
2084	print "Entrez un nom de compte svp.\n";
2085	print "<exemple> sex nomtest Male\n";
2086	} else {
2087	print "Please input an account name.\n";
2088	print "<example> sex testname Male\n";
2089	}
2090	return 136;
2091	}
2092	if (verify_accountname($userid) == 0) {
2093	return 102;
2094	}
2095	# if ($userid =~ /[^A-Za-z0-9\@-_]/) {
2096	# if ($defaultlanguage eq "F") {
2097	# print "Caractère interdit trouvé dans le nom du compte ".$`."[${&}]${'}\n";
2098	# } else {
2099	# print "Illegal character found in the account name ".$`."[${&}]${'}\n";
2100	# }
2101	# return 101;
2102	# }
2103	$sex = uc(substr($sex, 0, 1));
2104	if ($sex !~ /^[MF]$/) {
2105	if ($defaultlanguage eq "F") {
2106	print "Sexe incorrect [$sex]. Entrez M ou F svp.\n";
2107	} else {
2108	print "Illegal gender [$sex]. Please input M or F.\n";
2109	}
2110	return 103;
2111	}
2112	print $so pack("va24a1", 0x793c, $userid, $sex);
2113	$so->flush();
2114	$buf = readso(2);
2115	if (unpack("v", $buf) != 0x793d) {
2116	if ($defaultlanguage eq "F") {
2117	print "Problème de connexion au serveur (réponse incorrecte).\n";
2118	} else {
2119	print "Connection error to the server (incorrect answer).\n";
2120	}
2121	return 152;
2122	}
2123	$buf = readso(28);
2124	my($id2, $name) = unpack("Va24", $buf);
2125	while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
2126	chop($name);
2127	};
2128	if ($id2 == -1 \|\| $id2 == 4294967295) {
2129	if ($defaultlanguage eq "F") {
2130	print "Echec du changement du sexe du compte [$userid].\n";
2131	print "Le compte n'existe pas ou le sexe est déjà celui demandé.\n";
2132	} else {
2133	print "Account [$userid] sex changing failed.\n";
2134	print "Account doesn't exist or the sex is already the good sex.\n";
2135	}
2136	} else {
2137	if ($defaultlanguage eq "F") {
2138	print "Sexe du compte [$name][id: $id2] changé avec succès.\n";
2139	} else {
2140	print "Account [$name][id: $id2] sex successfully changed.\n";
2141	}
2142	}
2143	return 0;
2144	}
2145
2146	#--------------------------------------------------------------------------
2147
2148	# Sub-function: modify the GM level of an account
2149	sub changegmlevel() {
2150	my($userid, $gm_level) = @_;
2151	if ($userid eq "" \|\| !defined($userid)) {
2152	if ($defaultlanguage eq "F") {
2153	print "Entrez un nom de compte svp.\n";
2154	print "<exemple> gm nomtest 80\n";
2155	} else {
2156	print "Please input an account name.\n";
2157	print "<example> gm testname 80\n";
2158	}
2159	return 136;
2160	}
2161	if (verify_accountname($userid) == 0) {
2162	return 102;
2163	}
2164	# if ($userid =~ /[^A-Za-z0-9\@-_]/) {
2165	# if ($defaultlanguage eq "F") {
2166	# print "Caractère interdit trouvé dans le nom du compte ".$`."[${&}]${'}\n";
2167	# } else {
2168	# print "Illegal character found in the account name ".$`."[${&}]${'}\n";
2169	# }
2170	# return 101;
2171	# }
2172	$gm_level = int($gm_level);
2173	if ($gm_level < 0 \|\| $gm_level > 99) {
2174	if ($defaultlanguage eq "F") {
2175	print "Niveau de GM incorrect [$gm_level]. Entrez une valeur de 0 à 99 svp.\n";
2176	} else {
2177	print "Illegal GM level [$gm_level]. Please input a value from 0 to 99.\n";
2178	}
2179	return 103;
2180	}
2181	print $so pack("va24C", 0x793e, $userid, $gm_level);
2182	$so->flush();
2183	$buf = readso(2);
2184	if (unpack("v", $buf) != 0x793f) {
2185	if ($defaultlanguage eq "F") {
2186	print "Problème de connexion au serveur (réponse incorrecte).\n";
2187	} else {
2188	print "Connection error to the server (incorrect answer).\n";
2189	}
2190	return 152;
2191	}
2192	$buf = readso(28);
2193	my($id2, $name) = unpack("Va24", $buf);
2194	while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
2195	chop($name);
2196	};
2197	if ($id2 == -1 \|\| $id2 == 4294967295) {
2198	if ($defaultlanguage eq "F") {
2199	print "Echec du changement du niveau de GM du compte [$userid].\n";
2200	print "Le compte n'existe pas, le niveau de GM est déjà celui demandé,\n";
2201	print "ou il est impossible de modifier le fichier des comptes GM.\n";
2202	} else {
2203	print "Account [$userid] GM level changing failed.\n";
2204	print "Account doesn't exist, the GM level is already the good GM level,\n";
2205	print "or it's impossible to modify the GM accounts file.\n";
2206	}
2207	} else {
2208	if ($defaultlanguage eq "F") {
2209	print "Niveau de GM du compte [$name][id: $id2] changé avec succès.\n";
2210	} else {
2211	print "Account [$name][id: $id2] GM level successfully changed.\n";
2212	}
2213	}
2214	return 0;
2215	}
2216
2217	#--------------------------------------------------------------------------
2218
2219	# Sub-function: Modification of a state
2220	sub changestate {
2221	my($userid, $s, $error_message) = @_;
2222	# Valid values: 0: ok, or value of the 0x006a packet + 1
2223	if ($s eq "" \|\| (($s < 0 \|\| $s > 9) && $s != 100)) {
2224	if ($defaultlanguage eq "F") {
2225	print "Entrez une des valeurs suivantes svp:\n";
2226	print " 0 = Compte ok 6 = Your Game's EXE file is not the latest version\n";
2227	} else {
2228	print "Please input one of these values:\n";
2229	print " 0 = Account ok 6 = Your Game's EXE file is not the latest version\n";
2230	}
2231	print " 1 = Unregistered ID 7 = You are Prohibited to log in until %s\n";
2232	print " 2 = Incorrect Password 8 = Server is jammed due to over populated\n";
2233	print " 3 = This ID is expired 9 = No MSG\n";
2234	print " 4 = Rejected from Server 100 = This ID has been totally erased\n";
2235	print " 5 = You have been blocked by the GM Team\n";
2236	if ($defaultlanguage eq "F") {
2237	print "<exemples> state nomtest 5\n";
2238	print " state nomtest 7 fin de votre ban\n";
2239	print " block <nom du compte>\n";
2240	print " unblock <nom du compte>\n";
2241	} else {
2242	print "<examples> state testname 5\n";
2243	print " state testname 7 end of your ban\n";
2244	print " block <account name>\n";
2245	print " unblock <account name>\n";
2246	}
2247	return 151;
2248	}
2249	if ($userid eq "") {
2250	if ($defaultlanguage eq "F") {
2251	print "Entrez un nom de compte svp.\n";
2252	print "<exemples> state nomtest 5\n";
2253	print " state nomtest 7 fin de votre ban\n";
2254	print " block <nom du compte>\n";
2255	print " unblock <nom du compte>\n";
2256	} else {
2257	print "Please input an account name.\n";
2258	print "<examples> state testname 5\n";
2259	print " state testname 7 end of your ban\n";
2260	print " block <account name>\n";
2261	print " unblock <account name>\n";
2262	}
2263	return 136;
2264	}
2265	if (verify_accountname($userid) == 0) {
2266	return 102;
2267	}
2268	if ($s != 7) {
2269	$error_message = "-";
2270	} else {
2271	if (length($error_message) < 1) {
2272	if ($defaultlanguage eq "F") {
2273	print "Message d'erreur trop court. Entrez un message de 1-19 caractères.\n";
2274	} else {
2275	print "Error message is too short. Please input a message of 1-19 bytes.\n";
2276	}
2277	return 102;
2278	}
2279	if (length($error_message) > 19) {
2280	if ($defaultlanguage eq "F") {
2281	print "Message d'erreur trop long. Entrez un message de 1-19 caractères.\n";
2282	} else {
2283	print "Error message is too long. Please input a message of 1-19 bytes.\n";
2284	}
2285	return 102;
2286	}
2287	}
2288	print $so pack("va24Va20", 0x7936, $userid, $s, $error_message);
2289	$so->flush();
2290	$buf = readso(2);
2291	if (unpack("v", $buf) != 0x7937) {
2292	if ($defaultlanguage eq "F") {
2293	print "Problème de connexion au serveur (réponse incorrecte).\n";
2294	} else {
2295	print "Connection error to the server (incorrect answer).\n";
2296	}
2297	return 152;
2298	}
2299	$buf = readso(32);
2300	my(@dat) = unpack("Va24V", $buf);
2301	while (length($dat[1]) > 0 && substr($dat[1], length($dat[1])-1, 1) eq chr(0)) {
2302	chop($dat[1]);
2303	};
2304	if ($dat[0] != -1 && $dat[0] != 4294967295) {
2305	if ($defaultlanguage eq "F") {
2306	print "Statut du compte [$dat[1]][id: $dat[0]] changé avec succès en [";
2307	} else {
2308	print "Account [$dat[1]][id: $dat[0]] state successfully changed in [";
2309	}
2310	print ((($defaultlanguage eq "F" ? "Compte Ok" : "Account OK"),
2311	"Unregistered ID",
2312	"Incorrect Password",
2313	"This ID is expired",
2314	"Rejected from Server",
2315	"You have been blocked by the GM Team",
2316	"Your Game's EXE file is not the latest version",
2317	"You are Prohibited to log in until %s",
2318	"Server is jammed due to over populated",
2319	"No MSG",
2320	"This ID has been totally erased")[$dat[2] == 100 ? 10 : $dat[2]]);
2321	print "].\n";
2322	} else {
2323	if ($defaultlanguage eq "F") {
2324	print "Echec du changement du statut du compte [$userid]. Le compte n'existe pas.\n";
2325	} else {
2326	print "Account [$userid] state changing failed. Account doesn't exist.\n";
2327	}
2328	}
2329	}
2330
2331	#--------------------------------------------------------------------------
2332
2333	# Sub-function: Displaying of the number of online players
2334	sub getlogincount {
2335	# Request to the login-server
2336	print $so pack("v", 0x7938);
2337	$so->flush();
2338
2339	$buf = readso(4);
2340	# Connection failed
2341	if (unpack("v", $buf) != 0x7939) {
2342	if ($defaultlanguage eq "F") {
2343	print "Problème de connexion au serveur (réponse incorrecte).\n";
2344	} else {
2345	print "Connection error to the server (incorrect answer).\n";
2346	}
2347	exit(3);
2348	}
2349
2350	# Get length of the received packet
2351	my($len) = unpack("x2v", $buf) - 4;
2352
2353	# Read information of the servers
2354	if ($len < 1) {
2355	if ($defaultlanguage eq "F") {
2356	printf " Aucun serveur n'est connecté au login serveur.\n";
2357	} else {
2358	printf " No server is connected to the login-server.\n";
2359	}
2360	} else {
2361	my(@slist) = ();
2362	for(; $len > 0; $len -= 32) {
2363	my($name, $count) = unpack("x6 a20 V", readso(32));
2364	$name = substr($name, 0, index($name, "\0"));
2365	push @slist, [ $name, $count ];
2366	}
2367	# Displaying of result
2368	my($i);
2369	if ($defaultlanguage eq "F") {
2370	printf " Nombre de joueurs en ligne (serveur: nb):\n";
2371	} else {
2372	printf " Number of online players (server: number).\n";
2373	}
2374	foreach $i(@slist) {
2375	printf " %-20s : %5d\n", $i->[0], $i->[1];
2376	}
2377	}
2378	}
2379
2380	#--------------------------------------------------------------------------
2381
2382	# Sub-function: Modification of a memo field
2383	sub changememo {
2384	my($userid, $memo) = @_;
2385	if ($userid eq "") {
2386	if ($defaultlanguage eq "F") {
2387	print "Entrez un nom de compte svp.\n";
2388	print "<exemple> memo nomtest nouveau memo\n";
2389	} else {
2390	print "Please input an account name.\n";
2391	print "<example> memo testname new memo\n";
2392	}
2393	return 136;
2394	}
2395	if (verify_accountname($userid) == 0) {
2396	return 102;
2397	}
2398	if (length($memo) > 254) {
2399	if ($defaultlanguage eq "F") {
2400	print "Mémo trop long (".length($memo)." caractères).\n";
2401	print "Entrez un mémo de 254 caractères maximum svp.\n";
2402	} else {
2403	print "Memo is too long (".length($memo)." characters).\n";
2404	print "Please input a memo of 254 bytes at the maximum.\n";
2405	}
2406	return 102;
2407	}
2408	if (length($memo) == 0) {
2409	print $so pack("va24v", 0x7942, $userid, 0);
2410	} else {
2411	print $so pack("va24va".length($memo), 0x7942, $userid, length($memo), $memo);
2412	}
2413	$so->flush();
2414	$buf = readso(2);
2415	if (unpack("v", $buf) != 0x7943) {
2416	if ($defaultlanguage eq "F") {
2417	print "Problème de connexion au serveur (réponse incorrecte).\n";
2418	} else {
2419	print "Connection error to the server (incorrect answer).\n";
2420	}
2421	return 152;
2422	}
2423	$buf = readso(28);
2424	my($id2, $name) = unpack("Va24", $buf);
2425	while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
2426	chop($name);
2427	};
2428	if ($id2 == -1 \|\| $id2 == 4294967295) {
2429	if ($defaultlanguage eq "F") {
2430	print "Echec du changement du mémo du compte [$userid]. Le compte n'existe pas.\n";
2431	} else {
2432	print "Account [$userid] memo changing failed. Account doesn't exist.\n";
2433	}
2434	} else {
2435	if ($defaultlanguage eq "F") {
2436	print "Mémo du compte [$name][id: $id2] changé avec succès.\n";
2437	} else {
2438	print "Account [$name][id: $id2] memo successfully changed.\n";
2439	}
2440	}
2441	}
2442
2443	#--------------------------------------------------------------------------
2444
2445	# Sub-function: Request to obtain an account id
2446	sub idaccount() {
2447	my($userid) = @_;
2448	if ($userid eq "") {
2449	if ($defaultlanguage eq "F") {
2450	print "Entrez un nom de compte svp.\n";
2451	print "<exemple> id nomtest\n";
2452	} else {
2453	print "Please input an account name.\n";
2454	print "<example> id testname\n";
2455	}
2456	return 136;
2457	}
2458	if (verify_accountname($userid) == 0) {
2459	return 102;
2460	}
2461	print $so pack("va24", 0x7944, $userid);
2462	$so->flush();
2463	$buf = readso(2);
2464	if (unpack("v", $buf) != 0x7945) {
2465	if ($defaultlanguage eq "F") {
2466	print "Problème de connexion au serveur (réponse incorrecte).\n";
2467	} else {
2468	print "Connection error to the server (incorrect answer).\n";
2469	}
2470	return 122;
2471	}
2472	$buf = readso(28);
2473	my($id2, $name) = unpack("Va24", $buf);
2474	while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
2475	chop($name);
2476	};
2477	if ($id2 == -1 \|\| $id2 == 4294967295) {
2478	if ($defaultlanguage eq "F") {
2479	print "Impossible de trouver l'id du compte [$userid]. Le compte n'existe pas.\n";
2480	} else {
2481	print "Unabled to find the account [$userid] id. Account doesn't exist.\n";
2482	}
2483	return 123;
2484	} else {
2485	if ($defaultlanguage eq "F") {
2486	print "Le compte [$name] a pour id: $id2.\n";
2487	} else {
2488	print "The account [$name] have the id: $id2.\n";
2489	}
2490	}
2491	return 0;
2492	}
2493
2494	#--------------------------------------------------------------------------
2495
2496	# Sub-function: Request to obtain an account name
2497	sub nameaccount() {
2498	my($id) = @_;
2499	if ($id < 0) {
2500	if ($defaultlanguage eq "F") {
2501	print "Entrez un id ayant une valeur positive svp.\n";
2502	} else {
2503	print "Please input a positive value for the id.\n";
2504	}
2505	return 136;
2506	}
2507	print $so pack("vV", 0x7946, $id);
2508	$so->flush();
2509	$buf = readso(2);
2510	if (unpack("v", $buf) != 0x7947) {
2511	if ($defaultlanguage eq "F") {
2512	print "Problème de connexion au serveur (réponse incorrecte).\n";
2513	} else {
2514	print "Connection error to the server (incorrect answer).\n";
2515	}
2516	return 122;
2517	}
2518	$buf = readso(28);
2519	my($id2, $name) = unpack("Va24", $buf);
2520	while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
2521	chop($name);
2522	};
2523	if (length($name) == 0 \|\| $name eq "") {
2524	if ($defaultlanguage eq "F") {
2525	print "Impossible de trouver le nom du compte [id: $id2]. Le compte n'existe pas.\n";
2526	} else {
2527	print "Unabled to find the account [id: $id2] name. Account doesn't exist.\n";
2528	}
2529	return 123;
2530	} else {
2531	if ($defaultlanguage eq "F") {
2532	print "Le compte [id: $id2] a pour nom: $name.\n";
2533	} else {
2534	print "The account [id: $id2] have the name: $name.\n";
2535	}
2536	}
2537	return 0;
2538	}
2539
2540	#--------------------------------------------------------------------------
2541
2542	# Sub-function: Set a validity limit of an account
2543	sub timesetaccount() {
2544	my($userid, $date, $time) = @_;
2545	if ($userid eq "") {
2546	if ($defaultlanguage eq "F") {
2547	print "Entrez un nom de compte svp.\n";
2548	print "<exemple>: timeset <nom_du_compte> aaaa/mm/jj [hh:mm:ss]\n";
2549	print " timeset <nom_du_compte> 0 (0 = illimité)\n";
2550	printf " Heure par défaut [hh:mm:ss]: 23:59:59\n";
2551	} else {
2552	print "Please input an account name.\n";
2553	print "<example>: timeset <account_name> yyyy/mm/dd [hh:mm:ss]\n";
2554	print " timeset <account_name> 0 (0 = unlimited)\n";
2555	printf " Default time [hh:mm:ss]: 23:59:59\n";
2556	}
2557	return 136;
2558	}
2559	if (verify_accountname($userid) == 0) {
2560	return 102;
2561	}
2562	my($year, $month, $day) = split(/[.\-\/]/, $date);
2563	my($hour, $minute, $second) = split(/:/, $time);
2564	if ($time eq "") {
2565	$hour = 23;
2566	$minute = 59;
2567	$second = 59;
2568	}
2569	my($timestamp);
2570	if ($year eq "" \|\|
2571	($year != 0 && ($month eq "" \|\| $day eq "" \|\| $hour eq "" \|\| $minute eq "" \|\| $second eq ""))) {
2572	if ($defaultlanguage eq "F") {
2573	print "Entrez 0 ou une date et une heure svp (format: 0 ou aaaa/mm/jj hh:mm:ss).\n";
2574	} else {
2575	print "Please input 0 or a date and a time (format: 0 or yyyy/mm/dd hh:mm:ss).\n";
2576	}
2577	return 102;
2578	}
2579	if ($year == 0) {
2580	$timestamp = 0;
2581	} else {
2582	if ($year < 70) {
2583	$year = $year + 100;
2584	}
2585	if ($year >= 1900) {
2586	$year = $year - 1900;
2587	}
2588	if ($month < 1 \|\| $month > 12) {
2589	if ($defaultlanguage eq "F") {
2590	print "Entrez un mois correct svp (entre 1 et 12).\n";
2591	} else {
2592	print "Please give a correct value for the month (from 1 to 12).\n";
2593	}
2594	return 102;
2595	}
2596	$month = $month - 1;
2597	if ($day < 1 \|\| $day > 31) {
2598	if ($defaultlanguage eq "F") {
2599	print "Entrez un jour correct svp (entre 1 et 31).\n";
2600	} else {
2601	print "Please give a correct value for the day (from 1 to 31).\n";
2602	}
2603	return 102;
2604	}
2605	if ((($month == 3 \|\| $month == 5 \|\| $month == 8 \|\| $month == 10) && $day > 30) \|\|
2606	($month == 1 && $day > 29)) {
2607	if ($defaultlanguage eq "F") {
2608	print "Entrez un jour correct en fonction du mois svp.\n";
2609	} else {
2610	print "Please give a correct value for a day of this month.\n";
2611	}
2612	return 102;
2613	}
2614	if ($hour < 0 \|\| $hour > 23) {
2615	if ($defaultlanguage eq "F") {
2616	print "Entrez une heure correcte svp (entre 0 et 23).\n";
2617	} else {
2618	print "Please give a correct value for the hour (from 0 to 23).\n";
2619	}
2620	return 102;
2621	}
2622	if ($minute < 0 \|\| $minute > 59) {
2623	if ($defaultlanguage eq "F") {
2624	print "Entrez des minutes correctes svp (entre 0 et 59).\n";
2625	} else {
2626	print "Please give a correct value for the minutes (from 0 to 59).\n";
2627	}
2628	return 102;
2629	}
2630	if ($second < 0 \|\| $second > 59) {
2631	if ($defaultlanguage eq "F") {
2632	print "Entrez des secondes correctes svp (entre 0 et 59).\n";
2633	} else {
2634	print "Please give a correct value for the seconds (from 0 to 59).\n";
2635	}
2636	return 102;
2637	}
2638	$timestamp = POSIX::mktime($second, $minute, $hour, $day, $month, $year, 0, 0, -1); # -1: no winter/summer time modification
2639	if ($timestamp == undef) {
2640	if ($defaultlanguage eq "F") {
2641	print "Date incorrecte.\n";
2642	print "Ajoutez 0 ou une date et une heure svp (format: 0 ou aaaa/mm/jj hh:mm:ss).\n";
2643	} else {
2644	print "Invalid date.\n";
2645	print "Please add 0 or a date and a time (format: 0 or yyyy/mm/dd hh:mm:ss).\n";
2646	}
2647	return 102;
2648	}
2649	}
2650
2651	print $so pack("va24V", 0x7948, $userid, $timestamp);
2652	$so->flush();
2653	$buf = readso(2);
2654	if (unpack("v", $buf) != 0x7949) {
2655	if ($defaultlanguage eq "F") {
2656	print "Problème de connexion au serveur (réponse incorrecte).\n";
2657	} else {
2658	print "Connection error to the server (incorrect answer).\n";
2659	}
2660	return 152;
2661	}
2662	$buf = readso(32);
2663	my(@dat) = unpack("Va24V", $buf);
2664	while (length($dat[1]) > 0 && substr($dat[1], length($dat[1])-1, 1) eq chr(0)) {
2665	chop($dat[1]);
2666	};
2667	if ($dat[0] != -1 && $dat[0] != 4294967295) {
2668	if ($defaultlanguage eq "F") {
2669	print "Limite de validité du compte [$dat[1]][id: $dat[0]] changée avec succès ".
2670	($dat[2] == 0 ? "en [illimité].\n" : "pour être jusqu'au ".(POSIX::ctime($dat[2])));
2671	} else {
2672	print "Validity Limit of the account [$dat[1]][id: $dat[0]] successfully changed ".
2673	($dat[2] == 0 ? "to [unlimited].\n" : "to be until ".(POSIX::ctime($dat[2])));
2674	}
2675	# localtime($dat[2]) is also possible to display instead of POSIX::ctime.
2676	} else {
2677	if ($defaultlanguage eq "F") {
2678	print "Echec du changement de la validité du compte [$userid]. Le compte n'existe pas.\n";
2679	} else {
2680	print "Account [$userid] validity limit changing failed. Account doesn't exist.\n";
2681	}
2682	}
2683
2684	return 0;
2685	}
2686
2687	#--------------------------------------------------------------------------
2688
2689	# Sub-function: Add/substract time to the validity limit of an account
2690	sub timeaddaccount() {
2691	my($userid, $modif) = @_;
2692	if ($userid eq "") {
2693	if ($defaultlanguage eq "F") {
2694	print "Entrez un nom de compte svp.\n";
2695	print " <exemple> timeadd nomtest +1m-2mn1s-6y\n";
2696	print " Cette exemple ajoute 1 mois et 1 seconde, et soustrait 2 minutes\n";
2697	print " et 6 ans dans le même temps.\n";
2698	} else {
2699	print "Please input an account name.\n";
2700	print " <example> timeadd testname +1m-2mn1s-6y\n";
2701	print " this example adds 1 month and 1 second, and substracts 2 minutes\n";
2702	print " and 6 years at the same time.\n";
2703	}
2704	return 136;
2705	}
2706	if (verify_accountname($userid) == 0) {
2707	return 102;
2708	}
2709	my($year, $month, $day) = (0, 0 ,0);
2710	my($hour, $minute, $second) = (0, 0 ,0);
2711
2712	$modif = lc($modif);
2713	while (length($modif) > 0) {
2714	my($value) = int($modif);
2715	if ($value == 0) {
2716	$modif = substr($modif, 1);
2717	} else {
2718	if (substr($modif, 0, 1) =~ /[\-\+]/) {
2719	$modif = substr($modif, 1);
2720	}
2721	while (length($modif) > 0 && substr($modif, 0, 1) =~ /[0-9]/) {
2722	$modif = substr($modif, 1);
2723	}
2724	if (index($modif, "s") == 0) {
2725	$second = $value;
2726	$modif = substr($modif, 1);
2727	} elsif (index($modif, "mn") == 0) {
2728	$minute = $value;
2729	$modif = substr($modif, 2);
2730	} elsif (index($modif, "h") == 0) {
2731	$hour = $value;
2732	$modif = substr($modif, 1);
2733	} elsif (index($modif, "d") == 0 \|\| index($modif, "j") == 0) {
2734	$day = $value;
2735	$modif = substr($modif, 1);
2736	} elsif (index($modif, "m") == 0) {
2737	$month = $value;
2738	$modif = substr($modif, 1);
2739	} elsif (index($modif, "y") == 0 \|\| index($modif, "a") == 0) {
2740	$year = $value;
2741	$modif = substr($modif, 1);
2742	} else {
2743	$modif = substr($modif, 1);
2744	}
2745	}
2746	}
2747
2748	if ($defaultlanguage eq "F") {
2749	print " année: $year\n";
2750	print " mois: $month\n";
2751	print " jour: $day\n";
2752	print " heure: $hour\n";
2753	print " minute: $minute\n";
2754	print " seconde: $second\n";
2755	} else {
2756	print " year: $year\n";
2757	print " month: $month\n";
2758	print " day: $day\n";
2759	print " hour: $hour\n";
2760	print " minute: $minute\n";
2761	print " second: $second\n";
2762	}
2763
2764	if ($year == 0 && $month == 0 && $day == 0 && $hour == 0 && $minute == 0 && $second == 0) {
2765	if ($defaultlanguage eq "F") {
2766	print "Vous devez entrer un ajustement avec cette commande, svp:\n";
2767	print " Valeur d'ajustement (-1, 1, +1, etc...)\n";
2768	print " Element modifié:\n";
2769	print " a ou y: année\n";
2770	print " m: mois\n";
2771	print " j ou d: jour\n";
2772	print " h: heure\n";
2773	print " mn: minute\n";
2774	print " s: seconde\n";
2775	print " <exemple> timeadd nomtest +1m-2mn1s-6y\n";
2776	print " Cette exemple ajoute 1 mois et 1 seconde, et soustrait 2 minutes\n";
2777	print " et 6 ans dans le même temps.\n";
2778	} else {
2779	print "Please give an adjustment with this command:\n";
2780	print " Adjustment value (-1, 1, +1, etc...)\n";
2781	print " Modified element:\n";
2782	print " a or y: year\n";
2783	print " m: month\n";
2784	print " j or d: day\n";
2785	print " h: hour\n";
2786	print " mn: minute\n";
2787	print " s: second\n";
2788	print " <example> timeadd testname +1m-2mn1s-6y\n";
2789	print " this example adds 1 month and 1 second, and substracts 2 minutes\n";
2790	print " and 6 years at the same time.\n";
2791	}
2792	return 137;
2793	}
2794	if ($year > 127 \|\| $year < -127) {
2795	if ($defaultlanguage eq "F") {
2796	print "Entrez un ajustement d'années correct (de -127 à 127), svp.\n";
2797	} else {
2798	print "Please give a correct adjustment for the years (from -127 to 127).\n";
2799	}
2800	return 137;
2801	}
2802	if ($month > 255 \|\| $month < -255) {
2803	if ($defaultlanguage eq "F") {
2804	print "Entrez un ajustement de mois correct (de -255 à 255), svp.\n";
2805	} else {
2806	print "Please give a correct adjustment for the months (from -255 to 255).\n";
2807	}
2808	return 137;
2809	}
2810	if ($day > 32767 \|\| $day < -32767) {
2811	if ($defaultlanguage eq "F") {
2812	print "Entrez un ajustement de jours correct (de -32767 à 32767), svp.\n";
2813	} else {
2814	print "Please give a correct adjustment for the days (from -32767 to 32767).\n";
2815	}
2816	return 137;
2817	}
2818	if ($hour > 32767 \|\| $hour < -32767) {
2819	if ($defaultlanguage eq "F") {
2820	print "Entrez un ajustement d'heures correct (de -32767 à 32767), svp.\n";
2821	} else {
2822	print "Please give a correct adjustment for the hours (from -32767 to 32767).\n";
2823	}
2824	return 137;
2825	}
2826	if ($minute > 32767 \|\| $minute < -32767) {
2827	if ($defaultlanguage eq "F") {
2828	print "Entrez un ajustement de minutes correct (de -32767 à 32767), svp.\n";
2829	} else {
2830	print "Please give a correct adjustment for the minutes (from -32767 to 32767).\n";
2831	}
2832	return 137;
2833	}
2834	if ($second > 32767 \|\| $second < -32767) {
2835	if ($defaultlanguage eq "F") {
2836	print "Entrez un ajustement de secondes correct (de -32767 à 32767), svp.\n";
2837	} else {
2838	print "Please give a correct adjustment for the seconds (from -32767 to 32767).\n";
2839	}
2840	return 137;
2841	}
2842
2843	print $so pack("va24vvvvvv", 0x7950, $userid, $year, $month, $day, $hour, $minute, $second);
2844	$so->flush();
2845	$buf = readso(2);
2846	if (unpack("v", $buf) != 0x7951) {
2847	if ($defaultlanguage eq "F") {
2848	print "Problème de connexion au serveur (réponse incorrecte).\n";
2849	} else {
2850	print "Connection error to the server (incorrect answer).\n";
2851	}
2852	return 152;
2853	}
2854	$buf = readso(32);
2855	my(@dat) = unpack("Va24V", $buf);
2856	while (length($dat[1]) > 0 && substr($dat[1], length($dat[1])-1, 1) eq chr(0)) {
2857	chop($dat[1]);
2858	};
2859	if ($dat[0] == -1 \|\| $dat[0] == 4294967295) {
2860	if ($defaultlanguage eq "F") {
2861	print "Echec du changement de la validité du compte [$userid]. Le compte n'existe pas.\n";
2862	} else {
2863	print "Account [$userid] validity limit changing failed. Account doesn't exist.\n";
2864	}
2865	} elsif ($dat[2] == 0) {
2866	if ($defaultlanguage eq "F") {
2867	print "Limite de validité du compte [$dat[1]][id: $dat[0]] inchangée.\n";
2868	print "Le compte a une validité illimitée ou\n";
2869	print "la modification est impossible avec les ajustements demandés.\n";
2870	} else {
2871	print "Validity limit of the account [$dat[1]][id: $dat[0]] unchanged.\n";
2872	print "The account have an unlimited validity limit or\n";
2873	print "the changing is impossible with the proposed adjustments.\n";
2874	}
2875	} else {
2876	if ($defaultlanguage eq "F") {
2877	print "Limite de validité du compte [$dat[1]][id: $dat[0]] changée avec succès ".
2878	($dat[2] == 0 ? "en [illimité].\n" : "pour être jusqu'au ".(POSIX::ctime($dat[2])));
2879	} else {
2880	print "Validity limit of the account [$dat[1]][id: $dat[0]] successfully changed ".
2881	($dat[2] == 0 ? "to [unlimited].\n" : "to be until ".(POSIX::ctime($dat[2])));
2882	}
2883	# localtime($dat[2]) is also possible to display instead of POSIX::ctime.
2884	}
2885
2886	return 0;
2887	}
2888
2889	#--------------------------------------------------------------------------
2890
2891	# Sub-function: Set the final date of a banishment of an account
2892	sub bansetaccount() {
2893	my($userid, $date, $time) = @_;
2894	if ($userid eq "") {
2895	if ($defaultlanguage eq "F") {
2896	print "Entrez un nom de compte svp.\n";
2897	print "<exemple>: banset <nom_du_compte> aaaa/mm/jj [hh:mm:ss]\n";
2898	print " banset <nom_du_compte> 0 (0 = dé-bani)\n";
2899	print " ban/banish aaaa/mm/jj hh:mm:ss <nom du compte>\n";
2900	print " unban/unbanish <nom du compte>\n";
2901	printf " Heure par défaut [hh:mm:ss]: 23:59:59\n";
2902	} else {
2903	print "Please input an account name.\n";
2904	print "<example>: banset <account_name> yyyy/mm/dd [hh:mm:ss]\n";
2905	print " banset <account_name> 0 (0 = un-banished)\n";
2906	print " ban/banish yyyy/mm/dd hh:mm:ss <account name>\n";
2907	print " unban/unbanish <account name>\n";
2908	printf " Default time [hh:mm:ss]: 23:59:59\n";
2909	}
2910	return 136;
2911	}
2912	if (verify_accountname($userid) == 0) {
2913	return 102;
2914	}
2915	my($year, $month, $day) = split(/[.\-\/]/, $date);
2916	my($hour, $minute, $second) = split(/:/, $time);
2917	if ($time eq "") {
2918	$hour = 23;
2919	$minute = 59;
2920	$second = 59;
2921	}
2922	my($timestamp);
2923	if ($year eq "" \|\|
2924	($year != 0 && ($month eq "" \|\| $day eq "" \|\| $hour eq "" \|\| $minute eq "" \|\| $second eq ""))) {
2925	if ($defaultlanguage eq "F") {
2926	print "Entrez 0 ou une date et une heure svp (format: 0 ou aaaa/mm/jj hh:mm:ss).\n";
2927	} else {
2928	print "Please input 0 or a date and a time (format: 0 or yyyy/mm/dd hh:mm:ss).\n";
2929	}
2930	return 102;
2931	}
2932	if ($year == 0) {
2933	$timestamp = 0;
2934	} else {
2935	if ($year < 70) {
2936	$year = $year + 100;
2937	}
2938	if ($year >= 1900) {
2939	$year = $year - 1900;
2940	}
2941	if ($month < 1 \|\| $month > 12) {
2942	if ($defaultlanguage eq "F") {
2943	print "Entrez un mois correct svp (entre 1 et 12).\n";
2944	} else {
2945	print "Please give a correct value for the month (from 1 to 12).\n";
2946	}
2947	return 102;
2948	}
2949	$month = $month - 1;
2950	if ($day < 1 \|\| $day > 31) {
2951	if ($defaultlanguage eq "F") {
2952	print "Entrez un jour correct svp (entre 1 et 31).\n";
2953	} else {
2954	print "Please give a correct value for the day (from 1 to 31).\n";
2955	}
2956	return 102;
2957	}
2958	if ((($month == 3 \|\| $month == 5 \|\| $month == 8 \|\| $month == 10) && $day > 30) \|\|
2959	($month == 1 && $day > 29)) {
2960	if ($defaultlanguage eq "F") {
2961	print "Entrez un jour correct en fonction du mois svp.\n";
2962	} else {
2963	print "Please give a correct value for a day of this month.\n";
2964	}
2965	return 102;
2966	}
2967	if ($hour < 0 \|\| $hour > 23) {
2968	if ($defaultlanguage eq "F") {
2969	print "Entrez une heure correcte svp (entre 0 et 23).\n";
2970	} else {
2971	print "Please give a correct value for the hour (from 0 to 23).\n";
2972	}
2973	return 102;
2974	}
2975	if ($minute < 0 \|\| $minute > 59) {
2976	if ($defaultlanguage eq "F") {
2977	print "Entrez des minutes correctes svp (entre 0 et 59).\n";
2978	} else {
2979	print "Please give a correct value for the minutes (from 0 to 59).\n";
2980	}
2981	return 102;
2982	}
2983	if ($second < 0 \|\| $second > 59) {
2984	if ($defaultlanguage eq "F") {
2985	print "Entrez des secondes correctes svp (entre 0 et 59).\n";
2986	} else {
2987	print "Please give a correct value for the seconds (from 0 to 59).\n";
2988	}
2989	return 102;
2990	}
2991	$timestamp = POSIX::mktime($second, $minute, $hour, $day, $month, $year, 0, 0, -1); # -1: no winter/summer time modification
2992	if ($timestamp == undef) {
2993	if ($defaultlanguage eq "F") {
2994	print "Date incorrecte.\n";
2995	print "Ajoutez 0 ou une date et une heure svp (format: 0 ou aaaa/mm/jj hh:mm:ss).\n";
2996	} else {
2997	print "Invalid date.\n";
2998	print "Please add 0 or a date and a time (format: 0 or yyyy/mm/dd hh:mm:ss).\n";
2999	}
3000	return 102;
3001	}
3002	}
3003
3004	print $so pack("va24V", 0x794a, $userid, $timestamp);
3005	$so->flush();
3006	$buf = readso(2);
3007	if (unpack("v", $buf) != 0x794b) {
3008	if ($defaultlanguage eq "F") {
3009	print "Problème de connexion au serveur (réponse incorrecte).\n";
3010	} else {
3011	print "Connection error to the server (incorrect answer).\n";
3012	}
3013	return 152;
3014	}
3015	$buf = readso(32);
3016	my(@dat) = unpack("Va24V", $buf);
3017	while (length($dat[1]) > 0 && substr($dat[1], length($dat[1])-1, 1) eq chr(0)) {
3018	chop($dat[1]);
3019	};
3020	if ($dat[0] != -1 && $dat[0] != 4294967295) {
3021	if ($defaultlanguage eq "F") {
3022	print "Date finale de banissement du compte [$dat[1]][id: $dat[0]] changée avec succès ".
3023	($dat[2] == 0 ? "en [dé-bannie].\n" : "pour être jusqu'au ".(POSIX::ctime($dat[2])));
3024	} else {
3025	print "Final date of banishment of the account [$dat[1]][id: $dat[0]] successfully changed ".
3026	($dat[2] == 0 ? "to [unbanished].\n" : "to be until ".(POSIX::ctime($dat[2])));
3027	}
3028	# localtime($dat[2]) is also possible to display instead of POSIX::ctime.
3029	} else {
3030	if ($defaultlanguage eq "F") {
3031	print "Echec du changement de la date finale de banissement du compte [$userid]. Le compte n'existe pas.\n";
3032	} else {
3033	print "Account [$userid] final date of banishment changing failed. Account doesn't exist.\n";
3034	}
3035	}
3036
3037	return 0;
3038	}
3039
3040	#--------------------------------------------------------------------------
3041
3042	# Sub-function: Add/substract time to the final date of a banishment of an account
3043	sub banaddaccount() {
3044	my($userid, $modif) = @_;
3045	if ($userid eq "") {
3046	if ($defaultlanguage eq "F") {
3047	print "Entrez un nom de compte svp.\n";
3048	print " <exemple> banadd nomtest +1m-2mn1s-6y\n";
3049	print " Cette exemple ajoute 1 mois et 1 seconde, et soustrait 2 minutes\n";
3050	print " et 6 ans dans le même temps.\n";
3051	} else {
3052	print "Please input an account name.\n";
3053	print " <example> banadd testname +1m-2mn1s-6y\n";
3054	print " this example adds 1 month and 1 second, and substracts 2 minutes\n";
3055	print " and 6 years at the same time.\n";
3056	}
3057	return 136;
3058	}
3059	if (verify_accountname($userid) == 0) {
3060	return 102;
3061	}
3062	my($year, $month, $day) = (0, 0 ,0);
3063	my($hour, $minute, $second) = (0, 0 ,0);
3064
3065	$modif = lc($modif);
3066	while (length($modif) > 0) {
3067	my($value) = int($modif);
3068	if ($value == 0) {
3069	$modif = substr($modif, 1);
3070	} else {
3071	if (substr($modif, 0, 1) =~ /[\-\+]/) {
3072	$modif = substr($modif, 1);
3073	}
3074	while (length($modif) > 0 && substr($modif, 0, 1) =~ /[0-9]/) {
3075	$modif = substr($modif, 1);
3076	}
3077	if (index($modif, "s") == 0) {
3078	$second = $value;
3079	$modif = substr($modif, 1);
3080	} elsif (index($modif, "mn") == 0) {
3081	$minute = $value;
3082	$modif = substr($modif, 2);
3083	} elsif (index($modif, "h") == 0) {
3084	$hour = $value;
3085	$modif = substr($modif, 1);
3086	} elsif (index($modif, "d") == 0 \|\| index($modif, "j") == 0) {
3087	$day = $value;
3088	$modif = substr($modif, 1);
3089	} elsif (index($modif, "m") == 0) {
3090	$month = $value;
3091	$modif = substr($modif, 1);
3092	} elsif (index($modif, "y") == 0 \|\| index($modif, "a") == 0) {
3093	$year = $value;
3094	$modif = substr($modif, 1);
3095	} else {
3096	$modif = substr($modif, 1);
3097	}
3098	}
3099	}
3100
3101	if ($defaultlanguage eq "F") {
3102	print " année: $year\n";
3103	print " mois: $month\n";
3104	print " jour: $day\n";
3105	print " heure: $hour\n";
3106	print " minute: $minute\n";
3107	print " seconde: $second\n";
3108	} else {
3109	print " year: $year\n";
3110	print " month: $month\n";
3111	print " day: $day\n";
3112	print " hour: $hour\n";
3113	print " minute: $minute\n";
3114	print " second: $second\n";
3115	}
3116
3117	if ($year == 0 && $month == 0 && $day == 0 && $hour == 0 && $minute == 0 && $second == 0) {
3118	if ($defaultlanguage eq "F") {
3119	print "Vous devez entrer un ajustement avec cette commande, svp:\n";
3120	print " Valeur d'ajustement (-1, 1, +1, etc...)\n";
3121	print " Element modifié:\n";
3122	print " a ou y: année\n";
3123	print " m: mois\n";
3124	print " j ou d: jour\n";
3125	print " h: heure\n";
3126	print " mn: minute\n";
3127	print " s: seconde\n";
3128	print " <exemple> banadd nomtest +1m-2mn1s-6y\n";
3129	print " Cette exemple ajoute 1 mois et 1 seconde, et soustrait 2 minutes\n";
3130	print " et 6 ans dans le même temps.\n";
3131	} else {
3132	print "Please give an adjustment with this command:\n";
3133	print " Adjustment value (-1, 1, +1, etc...)\n";
3134	print " Modified element:\n";
3135	print " a or y: year\n";
3136	print " m: month\n";
3137	print " j or d: day\n";
3138	print " h: hour\n";
3139	print " mn: minute\n";
3140	print " s: second\n";
3141	print " <example> banadd testname +1m-2mn1s-6y\n";
3142	print " this example adds 1 month and 1 second, and substracts 2 minutes\n";
3143	print " and 6 years at the same time.\n";
3144	}
3145	return 137;
3146	}
3147	if ($year > 127 \|\| $year < -127) {
3148	if ($defaultlanguage eq "F") {
3149	print "Entrez un ajustement d'années correct (de -127 à 127), svp.\n";
3150	} else {
3151	print "Please give a correct adjustment for the years (from -127 to 127).\n";
3152	}
3153	return 137;
3154	}
3155	if ($month > 255 \|\| $month < -255) {
3156	if ($defaultlanguage eq "F") {
3157	print "Entrez un ajustement de mois correct (de -255 à 255), svp.\n";
3158	} else {
3159	print "Please give a correct adjustment for the months (from -255 to 255).\n";
3160	}
3161	return 137;
3162	}
3163	if ($day > 32767 \|\| $day < -32767) {
3164	if ($defaultlanguage eq "F") {
3165	print "Entrez un ajustement de jours correct (de -32767 à 32767), svp.\n";
3166	} else {
3167	print "Please give a correct adjustment for the days (from -32767 to 32767).\n";
3168	}
3169	return 137;
3170	}
3171	if ($hour > 32767 \|\| $hour < -32767) {
3172	if ($defaultlanguage eq "F") {
3173	print "Entrez un ajustement d'heures correct (de -32767 à 32767), svp.\n";
3174	} else {
3175	print "Please give a correct adjustment for the hours (from -32767 to 32767).\n";
3176	}
3177	return 137;
3178	}
3179	if ($minute > 32767 \|\| $minute < -32767) {
3180	if ($defaultlanguage eq "F") {
3181	print "Entrez un ajustement de minutes correct (de -32767 à 32767), svp.\n";
3182	} else {
3183	print "Please give a correct adjustment for the minutes (from -32767 to 32767).\n";
3184	}
3185	return 137;
3186	}
3187	if ($second > 32767 \|\| $second < -32767) {
3188	if ($defaultlanguage eq "F") {
3189	print "Entrez un ajustement de secondes correct (de -32767 à 32767), svp.\n";
3190	} else {
3191	print "Please give a correct adjustment for the seconds (from -32767 to 32767).\n";
3192	}
3193	return 137;
3194	}
3195
3196	print $so pack("va24vvvvvv", 0x794c, $userid, $year, $month, $day, $hour, $minute, $second);
3197	$so->flush();
3198	$buf = readso(2);
3199	if (unpack("v", $buf) != 0x794d) {
3200	if ($defaultlanguage eq "F") {
3201	print "Problème de connexion au serveur (réponse incorrecte).\n";
3202	} else {
3203	print "Connection error to the server (incorrect answer).\n";
3204	}
3205	return 152;
3206	}
3207	$buf = readso(32);
3208	my(@dat) = unpack("Va24V", $buf);
3209	while (length($dat[1]) > 0 && substr($dat[1], length($dat[1])-1, 1) eq chr(0)) {
3210	chop($dat[1]);
3211	};
3212	if ($dat[0] == -1 \|\| $dat[0] == 4294967295) {
3213	if ($defaultlanguage eq "F") {
3214	print "Echec du changement de la date finale de banissement du compte [$userid]. Le compte n'existe pas.\n";
3215	} else {
3216	print "Account [$userid] final date of banishment changing failed. Account doesn't exist.\n";
3217	}
3218	} else {
3219	if ($defaultlanguage eq "F") {
3220	print "Date finale de banissement du compte [$dat[1]][id: $dat[0]] changée avec succès ".
3221	($dat[2] == 0 ? "en [dé-bannie].\n" : "pour être jusqu'au ".(POSIX::ctime($dat[2])));
3222	} else {
3223	print "Final date of banishment of the account [$dat[1]][id: $dat[0]] successfully changed ".
3224	($dat[2] == 0 ? "to [unbanished].\n" : "to be until ".(POSIX::ctime($dat[2])));
3225	}
3226	# localtime($dat[2]) is also possible to display instead of POSIX::ctime.
3227	}
3228
3229	return 0;
3230	}
3231
3232	#--------------------------------------------------------------------------
3233
3234	# Sub-function: Request to displaying information about an account (by its name)
3235	sub whoaccount() {
3236	my($userid) = @_;
3237	if ($userid eq "") {
3238	if ($defaultlanguage eq "F") {
3239	print "Entrez un nom de compte svp.\n";
3240	print "<exemple> who nomtest\n";
3241	} else {
3242	print "Please input an account name.\n";
3243	print "<example> who testname\n";
3244	}
3245	return 136;
3246	}
3247	if (verify_accountname($userid) == 0) {
3248	return 102;
3249	}
3250
3251	print $so pack("va24", 0x7952, $userid);
3252	$so->flush();
3253
3254	$buf = readso(2);
3255	if (unpack("v", $buf) != 0x7953) {
3256	if ($defaultlanguage eq "F") {
3257	print "Problème de connexion au serveur (réponse incorrecte).\n";
3258	} else {
3259	print "Connection error to the server (incorrect answer).\n";
3260	}
3261	return 122;
3262	}
3263	my($id2, $GM_level, $name, $sex, $count, $status, $error_message, $last_login, $last_ip, $email, $validite, $ban_date, $memo_size) = unpack("VCa24cVVa20a24a16a40VVv", readso(148));
3264	my($memo) = "";
3265	if ($memo_size > 0) {
3266	$memo = unpack("a".$memo_size, readso($memo_size));
3267	}
3268	while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
3269	chop($name);
3270	};
3271	while (length($error_message) > 0 && substr($error_message, length($error_message)-1, 1) eq chr(0)) {
3272	chop($error_message);
3273	};
3274	while (length($last_login) > 0 && substr($last_login, length($last_login)-1, 1) eq chr(0)) {
3275	chop($last_login);
3276	};
3277	while (length($last_ip) > 0 && substr($last_ip, length($last_ip)-1, 1) eq chr(0)) {
3278	chop($last_ip);
3279	};
3280	while (length($email) > 0 && substr($email, length($email)-1, 1) eq chr(0)) {
3281	chop($email);
3282	};
3283	while (length($memo) > 0 && substr($memo, length($memo)-1, 1) eq chr(0)) {
3284	chop($memo);
3285	};
3286
3287	if ($id2 == -1 \|\| $id2 == 4294967295) {
3288	if ($defaultlanguage eq "F") {
3289	print "Impossible de trouver le compte [$userid]. Le compte n'existe pas.\n";
3290	} else {
3291	print "Unabled to find the account [$userid]. Account doesn't exist.\n";
3292	}
3293	return 123;
3294	} else {
3295	if ($defaultlanguage eq "F") {
3296	print "Le compte [$userid] a les caractéristiques suivantes:\n";
3297	} else {
3298	print "The account [$userid] is set with:\n";
3299	}
3300	if ($GM_level == 0) {
3301	print " Id: $id2 (non-GM)\n";
3302	} else {
3303	if ($defaultlanguage eq "F") {
3304	print " Id: $id2 (GM niveau $GM_level)\n";
3305	} else {
3306	print " Id: $id2 (GM level $GM_level)\n";
3307	}
3308	}
3309	if ($defaultlanguage eq "F") {
3310	print " Nom: '$name'\n";
3311	print " Sexe: ".("Femme", "Male", "Serveur")[$sex]."\n";
3312	} else {
3313	print " Name: '$name'\n";
3314	print " Sex: ".("Female", "Male", "Server")[$sex]."\n";
3315	}
3316	print " E-mail: $email\n";
3317	if ($status == 7) {
3318	print " Statut: 7 [You are Prohibited to log in until $error_message]\n";
3319	} else {
3320	print " Statut: $status [".(
3321	($defaultlanguage eq "F" ? "Compte Ok" : "Account OK"),
3322	"Unregistered ID",
3323	"Incorrect Password",
3324	"This ID is expired",
3325	"Rejected from Server",
3326	"You have been blocked by the GM Team",
3327	"Your Game's EXE file is not the latest version",
3328	"You are Prohibited to log in until %s",
3329	"Server is jammed due to over populated",
3330	"No MSG",
3331	"This ID is totally erased")[$status == 100 ? 10 : $status]."]\n";
3332	}
3333	if ($defaultlanguage eq "F") {
3334	print " Banissement: ".($ban_date == 0 ? "non banni.\n" : "jusqu'au ".(POSIX::ctime($ban_date)));
3335	print " Compteur: $count connexion".("s", "")[$count > 1 ? 0 : 1]."\n";
3336	print " Dernière connexion le: $last_login (ip: $last_ip)\n";
3337	print " Limite de validité: ".($validite == 0 ? "illimité.\n" : "jusqu'au ".(POSIX::ctime($validite)));
3338	} else {
3339	print " Banishment: ".($ban_date == 0 ? "not banished.\n" : "until ".(POSIX::ctime($ban_date)));
3340	print " Count: $count connection".("s", "")[$count > 1 ? 0 : 1]."\n";
3341	print " Last connection at: $last_login (ip: $last_ip)\n";
3342	print " Validity limit: ".($validite == 0 ? "unlimited.\n" : "until ".(POSIX::ctime($validite)));
3343	}
3344	print " Memo: '$memo'\n";
3345	}
3346	return 0;
3347	}
3348
3349	#--------------------------------------------------------------------------
3350
3351	# Sub-function: Request to displaying information about an account (by its id)
3352	sub infoaccount() {
3353	my($id) = @_;
3354	if ($id < 0) {
3355	if ($defaultlanguage eq "F") {
3356	print "Entrez un id ayant une valeur positive svp.\n";
3357	} else {
3358	print "Please input a positive value for the id.\n";
3359	}
3360	return 136;
3361	}
3362
3363	print $so pack("vV", 0x7954, $id);
3364	$so->flush();
3365
3366	$buf = readso(2);
3367	if (unpack("v", $buf) != 0x7953) {
3368	if ($defaultlanguage eq "F") {
3369	print "Problème de connexion au serveur (réponse incorrecte).\n";
3370	} else {
3371	print "Connection error to the server (incorrect answer).\n";
3372	}
3373	return 122;
3374	}
3375	my($id2, $GM_level, $name, $sex, $count, $status, $error_message, $last_login, $last_ip, $email, $validite, $ban_date, $memo_size) = unpack("VCa24cVVa20a24a16a40VVv", readso(148));
3376	my($memo) = "";
3377	if ($memo_size > 0) {
3378	$memo = unpack("a".$memo_size, readso($memo_size));
3379	}
3380	while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
3381	chop($name);
3382	};
3383	while (length($error_message) > 0 && substr($error_message, length($error_message)-1, 1) eq chr(0)) {
3384	chop($error_message);
3385	};
3386	while (length($last_login) > 0 && substr($last_login, length($last_login)-1, 1) eq chr(0)) {
3387	chop($last_login);
3388	};
3389	while (length($last_ip) > 0 && substr($last_ip, length($last_ip)-1, 1) eq chr(0)) {
3390	chop($last_ip);
3391	};
3392	while (length($email) > 0 && substr($email, length($email)-1, 1) eq chr(0)) {
3393	chop($email);
3394	};
3395	while (length($memo) > 0 && substr($memo, length($memo)-1, 1) eq chr(0)) {
3396	chop($memo);
3397	};
3398
3399	if (length($name) == 0 \|\| $name eq "") {
3400	if ($defaultlanguage eq "F") {
3401	print "Impossible de trouver le nom du compte [id: $id2]. Le compte n'existe pas.\n";
3402	} else {
3403	print "Unabled to find the account [id: $id2] name. Account doesn't exist.\n";
3404	}
3405	return 123;
3406	} else {
3407	if ($defaultlanguage eq "F") {
3408	print "Le compte [id: $id2] a les caractéristiques suivantes:\n";
3409	} else {
3410	print "The account [id: $id2] is set with:\n";
3411	}
3412	if ($GM_level == 0) {
3413	print " Id: $id2 (non-GM)\n";
3414	} else {
3415	if ($defaultlanguage eq "F") {
3416	print " Id: $id2 (GM niveau $GM_level)\n";
3417	} else {
3418	print " Id: $id2 (GM level $GM_level)\n";
3419	}
3420	}
3421	if ($defaultlanguage eq "F") {
3422	print " Nom: '$name'\n";
3423	print " Sexe: ".("Femme", "Male", "Serveur")[$sex]."\n";
3424	} else {
3425	print " Name: '$name'\n";
3426	print " Sex: ".("Female", "Male", "Server")[$sex]."\n";
3427	}
3428	print " E-mail: $email\n";
3429	if ($status == 7) {
3430	print " Statut: 7 [You are Prohibited to log in until $error_message]\n";
3431	} else {
3432	print " Statut: $status [".(
3433	($defaultlanguage eq "F" ? "Compte Ok" : "Account OK"),
3434	"Unregistered ID",
3435	"Incorrect Password",
3436	"This ID is expired",
3437	"Rejected from Server",
3438	"You have been blocked by the GM Team",
3439	"Your Game's EXE file is not the latest version",
3440	"You are Prohibited to log in until %s",
3441	"Server is jammed due to over populated",
3442	"No MSG",
3443	"This ID is totally erased")[$status == 100 ? 10 : $status]."]\n";
3444	}
3445	if ($defaultlanguage eq "F") {
3446	print " Banissement: ".($ban_date == 0 ? "non banni.\n" : "jusqu'au ".(POSIX::ctime($ban_date)));
3447	print " Compteur: $count connexion".("s", "")[$count > 1 ? 0 : 1]."\n";
3448	print " Dernière connexion le: $last_login (ip: $last_ip)\n";
3449	print " Limite de validité: ".($validite == 0 ? "illimité.\n" : "jusqu'au ".(POSIX::ctime($validite)));
3450	} else {
3451	print " Banishment: ".($ban_date == 0 ? "not banished.\n" : "until ".(POSIX::ctime($ban_date)));
3452	print " Count: $count connection".("s", "")[$count > 1 ? 0 : 1]."\n";
3453	print " Last connection at: $last_login (ip: $last_ip)\n";
3454	print " Validity limit: ".($validite == 0 ? "unlimited.\n" : "until ".(POSIX::ctime($validite)));
3455	}
3456	print " Memo: '$memo'\n";
3457	}
3458	return 0;
3459	}
3460
3461	#--------------------------------------------------------------------------
3462
3463	# Sub-function: Check the validity of a password
3464	# (Note: never send back a password with login-server!! security of passwords)
3465	sub checkaccount() {
3466	my($userid, $passwd) = @_;
3467	if ($userid eq "") {
3468	if ($defaultlanguage eq "F") {
3469	print "Entrez un nom de compte svp.\n";
3470	print "<exemple> check testname motdepasse\n";
3471	} else {
3472	print "Please input an account name.\n";
3473	print "<example> check testname password\n";
3474	}
3475	return 136;
3476	}
3477	if (verify_accountname($userid) == 0) {
3478	return 102;
3479	}
3480	if ($passwd eq "") {
3481	return 134 if (($passwd = typepasswd()) eq "");
3482	}
3483	if (verify_password($passwd) == 0) {
3484	return 131;
3485	}
3486	print $so pack("va24a24", 0x793a, $userid,$passwd);
3487	$so->flush();
3488	$buf = readso(2);
3489	if (unpack("v", $buf) != 0x793b) {
3490	if ($defaultlanguage eq "F") {
3491	print "Problème de connexion au serveur (réponse incorrecte).\n";
3492	} else {
3493	print "Connection error to the server (incorrect answer).\n";
3494	}
3495	return 132;
3496	}
3497	$buf = readso(28);
3498	my($id2, $name) = unpack("Va24", $buf);
3499	while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
3500	chop($name);
3501	};
3502	if ($id2 == -1 \|\| $id2 == 4294967295) {
3503	if ($defaultlanguage eq "F") {
3504	print "Le compte [$userid] n'existe pas ou le mot de passe est incorrect.\n";
3505	} else {
3506	print "The account [$userid] doesn't exist or the password is incorrect.\n";
3507	}
3508	return 133;
3509	} else {
3510	if ($defaultlanguage eq "F") {
3511	print "Le mot de passe donné correspond bien au compte [$name][id: $id2].\n";
3512	} else {
3513	print "The proposed password is correct for the account [$name][id: $id2].\n";
3514	}
3515	}
3516	return 130;
3517	}
3518
3519	#--------------------------------------------------------------------------
3520
3521	# Sub-function: Request to login-server to reload GM configuration file
3522	sub reloadGM() {
3523	print $so pack("v", 0x7955);
3524	$so->flush();
3525	if ($defaultlanguage eq "F") {
3526	print "Demande de recharger le fichier de configuration des GM envoyée.\n";
3527	print "Vérifiez les comptes GM actuels (après rechargement):\n";
3528	} else {
3529	print "Request to reload the GM configuration file sended.\n";
3530	print "Check the actual GM accounts (after reloading):\n";
3531	}
3532	&listaccount(0, 0, 1); # 1: to list only GM
3533	return 180;
3534	}
3535
3536	#--------------------------------------------------------------------------
3537
3538	# Sub-function: Send a broadcast message
3539	sub sendbroadcast() {
3540	my($type, $message) = @_;
3541	if ($message eq "" \|\| length($message) == 0) {
3542	if ($defaultlanguage eq "F") {
3543	print "Entrez un message svp.\n";
3544	if ($type == 0) {
3545	print "<exemple> kami un message\n";
3546	} else {
3547	print "<exemple> kamib un message\n";
3548	}
3549	} else {
3550	print "Please input a message.\n";
3551	if ($type == 0) {
3552	print "<example> kami a message\n";
3553	} else {
3554	print "<example> kamib a message\n";
3555	}
3556	}
3557	return 136;
3558	}
3559
3560	print $so pack("vvVa".length($message), 0x794e, $type, length($message), $message);
3561	$so->flush();
3562	$buf = readso(2);
3563	if (unpack("v", $buf) != 0x794f) {
3564	if ($defaultlanguage eq "F") {
3565	print "Problème de connexion au serveur (réponse incorrecte).\n";
3566	} else {
3567	print "Connection error to the server (incorrect answer).\n";
3568	}
3569	return 152;
3570	}
3571	$buf = readso(2);
3572	my($answer) = unpack("v", $buf);
3573	if ($answer == -1 \|\| $answer == 65535) {
3574	if ($defaultlanguage eq "F") {
3575	print "Echec de l'envoi du message. Aucun server de char en ligne.\n";
3576	} else {
3577	print "Message sending failed. No online char-server.\n";
3578	}
3579	} else {
3580	if ($defaultlanguage eq "F") {
3581	print "Message transmis au server de logins avec succès.\n";
3582	} else {
3583	print "Message successfully sended to login-server.\n";
3584	}
3585	}
3586	}
3587
3588	#--------------------------------------------------------------------------
3589
3590	# Sub-function: Change language of displaying
3591	sub changelanguage() {
3592	my($language) = @_;
3593	if ($language eq "" \|\| length($language) == 0) {
3594	if ($defaultlanguage == 'F') {
3595	printf("Entrez une langue svp.\n");
3596	printf("<exemple> language english\n");
3597	printf(" language français\n");
3598	} else {
3599	printf("Please input a language.\n");
3600	printf("<example> language english\n");
3601	printf(" language français\n");
3602	}
3603	return 136;
3604	}
3605
3606	$language = uc(substr($language, 0, 1));
3607	if ($language =~ /^[EF]$/) {
3608	$defaultlanguage = $language;
3609	if ($defaultlanguage == 'F') {
3610	printf("Changement de la langue d'affichage en Français.\n");
3611	} else {
3612	printf("Displaying language changed to English.\n");
3613	}
3614	} else {
3615	if ($defaultlanguage == 'F') {
3616	printf("Langue non paramétrée (langues possibles: 'Français' ou 'English').\n");
3617	} else {
3618	printf("Undefined language (possible languages: Français or English).\n");
3619	}
3620	}
3621
3622	return 0;
3623	}
3624
3625	#--------------------------------------------------------------------------
3626
3627	# Sub-function: sending 'end of connection' packet
3628	sub quit() {
3629	print $so pack("v", 0x7532);
3630	$so->flush();
3631	}
3632
3633	#--------------------------------------------------------------------------
3634
3635	# Sub-function: Get datas from the socket
3636	sub readso() {
3637	my($len) = shift;
3638	my($buf);
3639	if (read($so, $buf, $len) < $len) {
3640	if ($defaultlanguage eq "F") {
3641	print "Erreur de lecture sur la Socket.\n";
3642	} else {
3643	print "Socket read error.\n";
3644	}
3645	exit(3);
3646	}
3647	return $buf;
3648	}
3649
3650	#--------------------------------------------------------------------------
3651
3652	# Sub-function: Input of a password
3653	sub typepasswd {
3654	my($passwd1, $passwd2);
3655	cbreak();
3656	if ($defaultlanguage eq "F") {
3657	print "Entrez le mot de passe > "; $passwd1 = <STDIN>; chomp($passwd1); print "\n";
3658	print "Ré-entrez le mot de passe > "; $passwd2 = <STDIN>; chomp($passwd2); print "\n";
3659	} else {
3660	print "Type the password > "; $passwd1 = <STDIN>; chomp($passwd1); print "\n";
3661	print "Verify the password > "; $passwd2 = <STDIN>; chomp($passwd2); print "\n";
3662	}
3663	cooked();
3664	if ($passwd1 ne $passwd2) {
3665	if ($defaultlanguage eq "F") {
3666	print "Erreur de vérification du mot de passe: Saisissez le même mot de passe svp.\n";
3667	} else {
3668	print "Password verification failed. Please input same password.\n";
3669	}
3670	return "";
3671	}
3672	return $passwd1;
3673	}
3674
3675	#--------------------------------------------------------------------------
3676
3677	# Sub-function: Return ordonal text of a number
3678	sub makeordinal {
3679	my($c) = shift;
3680	if ($defaultlanguage eq "F") {
3681	if ($c < 1) {
3682	return $c;
3683	}
3684	return $c.("er", "ème")[$c == 1 ? 0 : 1];
3685	} else {
3686	if ($c % 10 < 4 && $c % 10 != 0 && ($c < 10 \|\| $c > 20)) {
3687	return $c.("st","nd","rd")[$c % 10 - 1];
3688	}
3689	return $c."th";
3690	}
3691	}
3692
3693	#--------------------------------------------------------------------------
3694
3695	# Sub-function: Test of the validity of an account name (return 0 if incorrect, and 1 if ok)
3696	sub verify_accountname {
3697	my($account_name) = @_; # Get the account_name
3698	if ($account_name =~ /[\x00-\x1f]/) { # remove control char
3699	my($c) = length($`) + 1;
3700	if ($defaultlanguage eq "F") {
3701	print "Caractère interdit trouvé dans le nom du compte (".makeordinal($c)." caractère).\n";
3702	} else {
3703	print "Illegal character found in the account name (".makeordinal($c)." character).\n";
3704	}
3705	return 0;
3706	}
3707	if (length($account_name) < 4) {
3708	if ($defaultlanguage eq "F") {
3709	print "Nom du compte trop court. Entrez un nom de compte de 4-23 caractères.\n";
3710	} else {
3711	print "Account name is too short. Please input an account name of 4-23 bytes.\n";
3712	}
3713	return 0;
3714	}
3715	if (length($account_name) > 23) {
3716	if ($defaultlanguage eq "F") {
3717	print "Nom du compte trop long. Entrez un nom de compte de 4-23 caractères.\n";
3718	} else {
3719	print "Account name is too long. Please input an account name of 4-23 bytes.\n";
3720	}
3721	return 0;
3722	}
3723	return 1;
3724	}
3725
3726	#--------------------------------------------------------------------------
3727
3728	# Sub-function: Test of the validity of password (return 0 if incorrect, and 1 if ok)
3729	sub verify_password {
3730	my($password) = @_; # Get the password
3731	if ($password =~ /[\x00-\x1f]/) {
3732	my($c) = length($`) + 1;
3733	if ($defaultlanguage eq "F") {
3734	print "Caractère interdit trouvé dans le mot de passe (".makeordinal($c)." caractère).\n";
3735	} else {
3736	print "Illegal character found in the password (".makeordinal($c)." character).\n";
3737	}
3738	return 0;
3739	}
3740	if (length($password) < 4) {
3741	if ($defaultlanguage eq "F") {
3742	print "Mot de passe trop court. Entrez un mot de passe de 4-23 caractères.\n";
3743	} else {
3744	print "Password is too short. Please input a password of 4-23 bytes.\n";
3745	}
3746	return 0;
3747	}
3748	if (length($password) > 23) {
3749	if ($defaultlanguage eq "F") {
3750	print "Mot de passe trop long. Entrez un mot de passe de 4-23 caractères.\n";
3751	} else {
3752	print "Password is too long. Please input a password of 4-23 bytes.\n";
3753	}
3754	return 0;
3755	}
3756	return 1;
3757	}
3758
3759	#--------------------------------------------------------------------------
3760
3761	# Sub-function: Test of the validity of an e-mail (return 0 if incorrect, and 1 if ok)
3762	sub verify_email {
3763	my($email) = @_; # Get the e-mail
3764	# To ignore a '.' before the @ (wanadoo, a provider, do that)
3765	$email =~ s/\.\@/\@/;
3766	# If the e-mail is void, it's not correct -> return 0
3767	if ($email eq '') {
3768	return(0);
3769	}
3770	# If the e-mail have no "@", it's not correct -> return 0
3771	if ($email !~ /\@/) {
3772	return(0);
3773	}
3774	# If the e-mail have a ",", a space, a tab or a ";", it's not correct -> return 0
3775	if ($email =~ /[\,\|\s\|\;]/) {
3776	return(0)
3777	};
3778	# IF
3779	# (the e-mail contains 2 "@", or ".." or "@." or starts or finishes by a ".")
3780	# OR IF
3781	# (the e-mail doesn't contain "@localhost" AND
3782	# - it doesn't contain characters followed by "@" itself followed by letters itself followed by "." and 2 or more letters
3783	# - or an IP address)
3784	# -> so, it's not good ! (finish !)
3785	if ($email =~ /(@.*@)\|(\.\.)\|(@\.)\|(\.@)\|(^\.)\|(\.$)/ \|\|
3786	($email !~ /^.+\@localhost$/ &&
3787	$email !~ /^.+\@\[?(\w\|[-.])+\.[a-zA-Z]{2,3}\|[0-9]{1,3}\]?$/)) {
3788	return(0); # non-valid email
3789	} else {
3790	# If not, the e-email address is correct
3791	return(1); # valid email
3792	}
3793	}

Note: See TracBrowser for help on using the browser.

Context Navigation

root/tools/ladmin @ 10

Download in other formats: