rathena/tools/ladmin
Valaris 2178a86317 AS OF SVN REV. 5901, WE ARE NOW USING TRUNK. ALL UNTESTED BUGFIXES/FEATURES GO INTO TRUNK.
IF YOU HAVE A WORKING AND TESTED BUGFIX PUT IT INTO STABLE AS WELL AS TRUNK.  EVERYTHING ELSE
GOES INTO TRUNK AND WILL BE MERGED INTO STABLE BY VALARIS AND WIZPUTER. -- VALARIS


git-svn-id: https://svn.code.sf.net/p/rathena/svn/trunk@5094 54d463be-8e91-2dee-dedb-b68131a5f0ec
2006-01-29 16:10:48 +00:00

3793 lines
150 KiB
Perl

#!/usr/bin/perl
use POSIX;
##########################################################################
# EAthena login-server remote administration tool
# New ladamin by [Yor]
##########################################################################
#-------------------------------INSTRUCTIONS------------------------------
# Set the 4 variables below:
# IP of the login server.
# Port where the login-server listens incoming packets.
# Password of administration (same of config_athena.conf).
# Displayed language of the sofware (if not correct, english is used).
# IMPORTANT:
# Be sure that you authorize remote administration in login-server
# (see login_athena.conf, 'admin_state' parameter)
#-------------------------------------------------------------------------
my($loginserverip) = "127.0.0.1"; # IP of login-server
my($loginserverport) = 6900; # Port of login-server
my($loginserveradminpassword) = "admin"; # Administration password
my($connecttimeout) = 10; # Timeout of connection (in seconds)
my($passenc) = 2; # Encoding type of the password
my($defaultlanguage) = "E"; # Default language (F: Français/E: English)
# (if it's not 'F', default is English)
#-------------------------------------------------------------------------
# LIST of COMMANDs that you can type at the prompt:
# To use these commands you can only type only the first letters.
# You must type a minimum of letters (you can not type 'a',
# because ladmin doesn't know if it's for 'aide' or for 'add')
# <Example> q <= quit, li <= list, pass <= passwd, etc.
#
# Note: every time you must give a account_name, you can use "" or '' (spaces can be included)
#
# aide/help/?
# Display the description of the commands
# aide/help/? [command]
# Display the description of the specified command
#
# add <account_name> <sex> <password>
# Create an account with the default email (a@a.com).
# Concerning the sex, only the first letter is used (F or M).
# The e-mail is set to a@a.com (default e-mail). It's like to have no e-mail.
# When the password is omitted, the input is done without displaying of the pressed keys.
# <example> add testname Male testpass
#
# ban/banish yyyy/mm/dd hh:mm:ss <account name>
# Changes the final date of a banishment of an account.
# Same command of banset, except that account_name is at end
#
# banadd <account_name> <modifier>
# Adds or substracts time from the final date of a banishment of an account.
# Modifier is done as follows:
# Adjustment value (-1, 1, +1, etc...)
# Modified element:
# a or y: year
# m: month
# j or d: day
# h: hour
# mn: minute
# s: second
# <example> banadd testname +1m-2mn1s-6y
# this example adds 1 month and 1 second, and substracts 2 minutes and 6 years at the same time.
# NOTE: If you modify the final date of a non-banished account,
# you fix the final date to (actual time +- adjustments)
#
# banset <account_name> yyyy/mm/dd [hh:mm:ss]
# Changes the final date of a banishment of an account.
# Default time: 23:59:59
# banset <account_name> 0
# Set a non-banished account (0 = unbanished).
#
# block <account name>
# Set state 5 (You have been blocked by the GM Team) to an account.
# Same command of state <account_name> 5.
#
# check <account_name> <password>
# Check the validity of a password for an account
# NOTE: Server will never sends back a password.
# It's the only method you have to know if a password is correct.
# The other method is to have a ('physical') access to the accounts file.
#
# create <account_name> <sex> <email> <password>
# Like the 'add' command, but with e-mail moreover.
# <example> create testname Male my@mail.com testpass
#
# del <account name>
# Remove an account.
# This order requires confirmation. After confirmation, the account is deleted.
#
# email <account_name> <email>
# Modify the e-mail of an account.
#
# getcount
# Give the number of players online on all char-servers.
#
# gm <account_name> [GM_level]
# Modify the GM level of an account.
# Default value remove GM level (GM level = 0).
# <example> gm testname 80
#
# id <account name>
# Give the id of an account.
#
# info <account_id>
# Display complete information of an account.
#
# kami <message>
# Sends a broadcast message on all map-server (in yellow).
# kamib <message>
# Sends a broadcast message on all map-server (in blue).
#
# language <language>
# Change the language of displaying.
#
# list/ls [start_id [end_id]]
# Display a list of accounts.
# 'start_id', 'end_id': indicate end and start identifiers.
# Research by name is not possible with this command.
# <example> list 10 9999999
#
# listBan/lsBan [start_id [end_id]]
# Like list/ls, but only for accounts with state or banished
#
# listGM/lsGM [start_id [end_id]]
# Like list/ls, but only for GM accounts
#
# listOK/lsOK [start_id [end_id]]
# Like list/ls, but only for accounts without state and not banished
#
# memo <account_name> <memo>
# Modify the memo of an account.
# 'memo': it can have until 253 characters (with spaces or not).
#
# name <account_id>
# Give the name of an account.
#
# passwd <account_name> <new_password>
# Change the password of an account.
# When new password is omitted, the input is done without displaying of the pressed keys.
#
# quit/end/exit
# End of the program of administration
#
# reloadGM
# Reload GM configuration file
#
# search <expression>
# Seek accounts.
# Displays the accounts whose names correspond.
# search -r/-e/--expr/--regex <expression>
# Seek accounts by regular expression.
# Displays the accounts whose names correspond.
#
# sex <account_name> <sex>
# Modify the sex of an account.
# <example> sex testname Male
#
# state <account_name> <new_state> <error_message_#7>
# Change the state of an account.
# 'new_state': state is the state of the packet 0x006a + 1. The possibilities are:
# 0 = Account ok 6 = Your Game's EXE file is not the latest version
# 1 = Unregistered ID 7 = You are Prohibited to log in until %s
# 2 = Incorrect Password 8 = Server is jammed due to over populated
# 3 = This ID is expired 9 = No MSG
# 4 = Rejected from Server 100 = This ID has been totally erased
# 5 = You have been blocked by the GM Team
# all other values are 'No MSG', then use state 9 please.
# 'error_message_#7': message of the code error 6 = Your are Prohibited to log in until %s (packet 0x006a)
#
# timeadd <account_name> <modifier>
# Adds or substracts time from the validity limit of an account.
# Modifier is done as follows:
# Adjustment value (-1, 1, +1, etc...)
# Modified element:
# a or y: year
# m: month
# j or d: day
# h: hour
# mn: minute
# s: second
# <example> timeadd testname +1m-2mn1s-6y
# this example adds 1 month and 1 second, and substracts 2 minutes and 6 years at the same time.
# NOTE: You can not modify a unlimited validity limit.
# If you want modify it, you want probably create a limited validity limit.
# So, at first, you must set the validity limit to a date/time.
#
# timeset <account_name> yyyy/mm/dd [hh:mm:ss]
# Changes the validity limit of an account.
# Default time: 23:59:59
# timeset <account_name> 0
# Gives an unlimited validity limit (0 = unlimited).
#
# unban/unbanish <account name>
# Unban an account.
# Same command of banset 0.
#
# unblock <account name>
# Set state 0 (Account ok) to an account.
# Same command of state <account_name> 0.
#
# version
# Display the version of the login-server.
#
# who <account name>
# Displays complete information of an account.
#
#-------------------------------------------------------------------------
# Possibilities to execute ladmin in command line by usage of the software with a parameter:
# ./ladmin --mode param1 ...
#
# --makesymlink -- Create the symbolic links for a use in shell
# --add <account_name> <sex> <password> -- Create an account with the default email (or -a)
# --ban yyyy/mm/dd hh:mm:ss <account_name> -- Change the final date of a banishment of an account (or -b)
# --banadd <account_name> <modifier> -- Add or substract time from the final date of a banishment of an account (or - ba)
# --banset <account_name> yyyy/mm/dd [hh:mm:ss] -- Change the final date of a banishment of an account (or -bs)
# --banset <account_name> 0 -- Unbanish an account (or -bs)
# --block <account_name> -- Set state 5 to an account (or -bl)
# --check <account_name> <password> -- Check the validity of a password for an account (or -check)
# --create <account_name> <sex> <email> <password> -- Create an account with email (or -c)
# --del <account_name> -- Remove an account (or -d)
# --email <account_name> <email> -- Modify an email of an account (or -e)
# --getcount -- Give the number of players online on all char-servers (or -g)
# --gm <account_name> <GM_level> -- Change the GM level of an account (or -gm)
# --id <account_name> -- Give the id of an account (or -i)
# --info <account_id> -- Display complete information of an account (or -info)
# --kami <message> -- Sends a broadcast message on all map-server (in yellow).
# --kamib <message> -- Sends a broadcast message on all map-server (in blue).
# --language <language> -- Change the language of displaying (-lang).
# --list [First_id [Last_id]] -- Display a list of accounts (or -l)
# --listBan [start_id [end_id]] -- Display a list of accounts with state or banished (or -lBan)
# --listGM [First_id [Last_id]] -- Display a list of GM accounts (or -lGM)
# --listOK [start_id [end_id]] -- Display a list of accounts without state and not banished (or -lOK)
# --memo <account_name> <memo> -- Modify the memo of an account (or -e)
# --name <account_id> -- Give the name of an account (or -n)
# --passwd <account_name> <new_password> -- Change the password of an account (or -p)
# --reloadGM -- Reload GM configuration file (or -r)
# --search <expression> -- Seek accounts (or -s)
# --search -e/-r/--expr/--regex <expression> -- Seek accounts by REGEX (or -s)
# --sex <account_name> <sex> -- Change the sex of an account (or -sex)
# --state <account_name> <new_state> <error_message_#7> -- Change the state of an account (or -t)
# --timeadd <account_name> <modifier> -- Add or substract time from the validity limit of an account (or - ta)
# --timeset <account_name> yyyy/mm/dd [hh:mm:ss] -- Change the validify limit of an account (or -ts)
# --timeset <account_name> 0 -- Give a unlimited validity limit (or -ts)
# --unban/unbanish <account_name> -- Unban an account (or -uba)
# --unblock <account_name> -- Set state 0 to an account (or -ubl)
# --version -- Display the version of the login-server (or -v)
# --who <account_name> -- Display complete information of an account (or -w)
#
# <example> ./ladmin --addaccount testname Male testpass
#
#-------------------------------------------------------------------------
# Possibilities to execute ladmin with symbolic links in Shell
# To create the symbolic links, execute ladmin with the '-- makesymlink' option.
#
# addaccount <account_name> <sex> <password> -- Create an account with the default email
# banaccount yyyy/mm/dd hh:mm:ss <account_name> -- Change the final date of a banishment of an account
# banaddaccount <account_name> <modifier> -- Add or substract time from the final date of a banishment of an account
# bansetaccount <account_name> yyyy/mm/dd [hh:mm:ss] -- Change the final date of a banishment of an account
# bansetaccount <account_name> 0 -- Unbanish an account
# blockaccount <account_name> -- Set state 5 (blocked by the GM Team) to an account
# checkaccount <account_name> <password> -- Check the validity of a password for an account
# createaccount <account_name> <sex> <email> <password> -- Create an account with email
# delaccount <account_name> -- Remove an account
# emailaccount <account_name> <email> -- Modify an email of an account
# getcount -- Give the number of players online on all char-servers
# gmaccount <account_name> <GM_level> -- Change the GM level of an account
# idaccount <account_name> -- Give the id of an account
# infoaccount <account_id> -- Display complete information of an account
# kami <message> -- Sends a broadcast message on all map-server (in yellow).
# kamib <message> -- Sends a broadcast message on all map-server (in blue).
# ladminlanguage <language> -- Change the language of displaying.
# listaccount [First_id [Last_id]] -- Display a list of accounts
# listBanaccount [start_id [end_id]] -- Display a list of accounts with state or banished
# listGMaccount [First_id [Last_id]] -- Display a list of GM accounts
# listOKaccount [start_id [end_id]] -- Display a list of accounts without state and not banished
# loginserverversion -- Display the version of the login-server
# memoaccount <account_name> <memo> -- Modify the memo of an account
# nameaccount <account_id> -- Give the name of an account
# passwdaccount <account_name> <new_password> -- Change the password of an account
# reloadGM -- Reload GM configuration file
# searchaccount <expression> -- Seek accounts
# searchaccount -e/-r/--expr/--regex <expression> -- Seek accounts by REGEX
# sexaccount <account_name> <sex> -- Change the sex of an account (or -sex)
# stateaccount <account_name> <new_state> <error_message_#7> -- Change the state of an account
# timeaddaccount <account_name> <modifier> -- Add or substract time from the validity limit of an account
# timesetaccount <account_name> yyyy/mm/dd [hh:mm:ss] -- Change the validify limit of an account
# timesetaccount <account_name> 0 -- Give a unlimited validity limit
# unbanaccount <account_name> -- Unban an account
# unblockaccount <account_name> -- Set state 0 (Account ok) to an account
# whoaccount <account_name> -- Display complete information of an account
# <exemple> ./addaccount testname Male testpass
#
#-------------------------------------------------------------------------
# About the encoding:
#
# The Digest::MD5 module is necessary to use the encrypted password system.
# When the software cannot found the Digest::MD5 module,
# encoding is automatically disabled ($passenc=0), which allows
# to use this program in any cases.
#
#-------------------------------------------------------------------------
# How to use ladmin with UNIX:
#
# You excecute ladmin as a standard command.
# <Example of preparation to have an access to ladmin>
# $ mv ladmin ladmin_org
# $ nkf -eLu ladmin_org > ladmin
# $ chmod 700 ladmin
# <Example to start directly ladmin>
# $ perl ladmin
#
##########################################################################
use strict;
use IO::Socket;
use Term::ReadLine;
eval { use POSIX qw(:termios_h); };
eval { use Digest::MD5 qw(md5); } if $passenc;
$passenc = 0 if($@);
my($ver) = "1.00";
# Start of termios
my($termios, $orgterml, $termlecho, $termlnoecho) = ();
eval{
$termios = POSIX::Termios->new();
$termios->getattr(fileno(STDIN));
$orgterml = $termios->getlflag();
$termlecho = ECHO | ECHOK | ICANON;
$termlnoecho = $orgterml & ~$termlecho;
};
# Modification of termios for the displaying of passwords (no displays for pressed keys)
sub cbreak() {
if ($termios) {
$termios->setlflag($termlnoecho);
$termios->setcc(VTIME, 1);
$termios->setattr(fileno(STDIN), TCSANOW);
}
}
# Modification of termios to return at the normal displaying (after input of the passwords)
sub cooked() {
if ($termios) {
$termios->setlflag($orgterml);
$termios->setcc(VTIME,0);
$termios->setattr(fileno(STDIN),TCSANOW);
}
}
END{ cooked() }
if ($defaultlanguage eq "F") {
print "Outil d'administration à distance de eAthena V.$ver\n";
} else {
print "EAthena login-server administration tool V.$ver\n";
}
# Creation of the symbolic links for call of the program in line command of the shell
if ($ARGV[0] eq "--makesymlink") {
symlink $0, "loginserverversion";
symlink $0, "addaccount";
symlink $0, "banaccount";
symlink $0, "banaddaccount";
symlink $0, "bansetaccount";
symlink $0, "blockaccount";
symlink $0, "checkaccount";
symlink $0, "createaccount";
symlink $0, "delaccount";
symlink $0, "emailaccount";
symlink $0, "getcount";
symlink $0, "gmaccount";
symlink $0, "idaccount";
symlink $0, "infoaccount";
symlink $0, "kami";
symlink $0, "kamib";
symlink $0, "ladminlanguage";
symlink $0, "listaccount";
symlink $0, "listBanaccount";
symlink $0, "listGMaccount";
symlink $0, "listOKaccount";
symlink $0, "memoaccount";
symlink $0, "nameaccount";
symlink $0, "passwdaccount";
symlink $0, "reloadGM";
symlink $0, "searchaccount";
symlink $0, "sexaccount";
symlink $0, "stateaccount";
symlink $0, "timeaddaccount";
symlink $0, "timesetaccount";
symlink $0, "unbanaccount";
symlink $0, "unblockaccount";
symlink $0, "whoaccount";
if ($defaultlanguage eq "F") {
print "Liens symbliques créés.\n";
} else {
print "Symbolic links created.\n";
}
exit(0);
}
# Connection to the login-server
my($so,$er) = ();
eval{
$so = IO::Socket::INET->new(
PeerAddr=> $loginserverip,
PeerPort=> $loginserverport,
# Proto => "tcp",
Timeout => $connecttimeout) or $er = 1;
};
if ($er || $@) {
if ($defaultlanguage eq "F") {
print "\nImpossible de se connecter au serveur de login [${loginserverip}:$loginserverport] !\n";
} else {
print "\nImpossible to have a connection with the login-server [${loginserverip}:$loginserverport] !\n";
}
print "$!\n"; # Displaying of the error
exit(2);
}
# Sending the administration password
if ($passenc == 0) {
print $so pack("v2a24",0x7918,0,$loginserveradminpassword);
$so->flush();
} else {
print $so pack("v",0x791a);
$so->flush();
my($buf) = readso(4);
if (unpack("v",$buf) != 0x01dc) {
if ($defaultlanguage eq "F") {
print "Erreur au login (échec de la création de la clef md5).\n";
} else {
print "Error at login (failure of the md5 key creation).\n";
}
}
$buf = readso(unpack("x2v",$buf)-4);
my($md5bin) = md5(($passenc == 1) ? $buf.$loginserveradminpassword : $loginserveradminpassword.$buf);
print $so pack("v2a16",0x7918,$passenc,$md5bin);
$so->flush();
}
# Waiting of the server reply
my($buf) = readso(3);
if (unpack("v",$buf) != 0x7919 || unpack("x2c",$buf) != 0) {
if ($defaultlanguage eq "F") {
print "Erreur de login:\n";
print " - mot de passe incorrect,\n";
print " - système d'administration non activé, ou\n";
print " - IP non autorisée.\n";
} else {
print "Error at login:\n";
print " - incorrect password,\n";
print " - administration system not activated, or\n";
print " - unauthorised IP.\n";
}
quit();
exit(4);
}
if ($defaultlanguage eq "F") {
print "Connexion établie.\n";
} else {
print "Established connection.\n";
}
#-------------------------------------------------------------------------
# Here are checked the command lines with arguments and symbolic links (no prompt)
if ($0 =~ /addaccount$/ ||
(($ARGV[0] eq "-a" || $ARGV[0] eq "--add") && ((shift @ARGV), 1))) {
my($r) = addaccount($ARGV[0], $ARGV[1], $ARGV[2]);
quit();
exit($r);
} elsif ($0 =~ /banaccount$/ || $0 =~ /banishaccount$/ ||
(($ARGV[0] eq "-b" || $ARGV[0] eq "--ban" || $ARGV[0] eq "--banish") && ((shift @ARGV), 1))) {
my($r) = bansetaccount($ARGV[1], $ARGV[2], $ARGV[0]);
quit();
exit($r);
} elsif ($0 =~ /banaddaccount$/ ||
(($ARGV[0] eq "-ba" || $ARGV[0] eq "--banadd") && ((shift @ARGV), 1))) {
my($r) = banaddaccount($ARGV[0], $ARGV[1]);
quit();
exit($r);
} elsif ($0 =~ /bansetaccount$/ ||
(($ARGV[0] eq "-bs" || $ARGV[0] eq "--banset") && ((shift @ARGV), 1))) {
my($r) = bansetaccount($ARGV[0], $ARGV[1], $ARGV[2]);
quit();
exit($r);
} elsif ($0 =~ /blockaccount$/ ||
(($ARGV[0] eq "-bl" || $ARGV[0] eq "--block") && ((shift @ARGV), 1))) {
my($r) = changestate($ARGV[0], 5, "");
quit();
exit($r);
} elsif ($0 =~ /checkaccount$/ ||
(($ARGV[0] eq "-check" || $ARGV[0] eq "--check") && ((shift @ARGV), 1))) {
my($r) = checkaccount($ARGV[0], $ARGV[1]);
quit();
exit($r);
} elsif ($0 =~ /createaccount$/ ||
(($ARGV[0] eq "-c" || $ARGV[0] eq "--create") && ((shift @ARGV), 1))) {
my($r) = createaccount($ARGV[0], $ARGV[1], $ARGV[2], $ARGV[3]);
quit();
exit($r);
} elsif ($0 =~ /delaccount$/ ||
(($ARGV[0] eq "-d" || $ARGV[0] eq "--del") && ((shift @ARGV), 1))) {
my($r) = delaccount($ARGV[0]);
quit();
exit($r);
} elsif ($0 =~ /emailaccount$/ ||
(($ARGV[0] eq "-e" || $ARGV[0] eq "--email") && ((shift @ARGV), 1))) {
my($r) = changeemail($ARGV[0], $ARGV[1]);
quit();
exit($r);
} elsif ($0 =~ /getcount$/ ||
(($ARGV[0] eq "-g" || $ARGV[0] eq "--getcount") && ((shift @ARGV), 1))) {
my($r) = getlogincount();
quit();
exit($r);
} elsif ($0 =~ /gmaccount$/ ||
(($ARGV[0] eq "-gm" || $ARGV[0] eq "--gm") && ((shift @ARGV), 1))) {
my($r) = changegmlevel($ARGV[0], $ARGV[1]);
quit();
exit($r);
} elsif ($0 =~ /id$/ ||
(($ARGV[0] eq "-i" || $ARGV[0] eq "--id") && ((shift @ARGV), 1))) {
my($r) = idaccount($ARGV[0]);
quit();
exit($r);
} elsif ($0 =~ /infoaccount$/ ||
(($ARGV[0] eq "-info" || $ARGV[0] eq "--info") && ((shift @ARGV), 1))) {
my($r) = infoaccount($ARGV[0]);
quit();
exit($r);
} elsif ($0 =~ /kami$/ ||
(($ARGV[0] eq "-kami" || $ARGV[0] eq "--kami") && ((shift @ARGV), 1))) {
my($r) = sendbroadcast(0, $ARGV[0]);
quit();
exit($r);
} elsif ($0 =~ /kamib$/ ||
(($ARGV[0] eq "-kamib" || $ARGV[0] eq "--kamib") && ((shift @ARGV), 1))) {
my($r) = sendbroadcast(0x10, $ARGV[0]);
quit();
exit($r);
} elsif ($0 =~ /ladminlanguage$/ ||
(($ARGV[0] eq "-lang" || $ARGV[0] eq "--language") && ((shift @ARGV), 1))) {
my($r) = changelanguage($ARGV[0]);
quit();
exit($r);
} elsif ($0 =~ /listaccount$/ ||
(($ARGV[0] eq "-l" || $ARGV[0] eq "--list") && ((shift @ARGV), 1))) {
my($r) = listaccount(int($ARGV[0]), int($ARGV[1]), 0); # 0: to list all
quit();
exit($r);
} elsif ($0 =~ /listBanaccount$/ ||
(($ARGV[0] eq "-lBan" || $ARGV[0] eq "--listBan") && ((shift @ARGV), 1))) {
my($r) = listaccount(int($ARGV[0]), int($ARGV[1]), 3); # 3: to list only accounts with state or banished
quit();
exit($r);
} elsif ($0 =~ /listGMaccount$/ ||
(($ARGV[0] eq "-lGM" || $ARGV[0] eq "--listGM") && ((shift @ARGV), 1))) {
my($r) = listaccount(int($ARGV[0]), int($ARGV[1]), 1); # 1: to list only GM
quit();
exit($r);
} elsif ($0 =~ /listOKaccount$/ ||
(($ARGV[0] eq "-lOK" || $ARGV[0] eq "--listOK") && ((shift @ARGV), 1))) {
my($r) = listaccount(int($ARGV[0]), int($ARGV[1]), 4); # 4: to list only accounts without state and not banished
quit();
exit($r);
} elsif ($0 =~ /loginserverversion$/ ||
(($ARGV[0] eq "-v" || $ARGV[0] eq "--version") && ((shift @ARGV), 1))) {
my($r) = checkloginversion();
quit();
exit($r);
} elsif ($0 =~ /memoaccount$/ ||
(($ARGV[0] eq "-m" || $ARGV[0] eq "--memo") && ((shift @ARGV), 1))) {
my($r) = changememo($ARGV[0], $ARGV[1]);
quit();
exit($r);
} elsif ($0 =~ /nameaccount$/ ||
(($ARGV[0] eq "-n" || $ARGV[0] eq "--name") && ((shift @ARGV), 1))) {
my($r) = nameaccount(int($ARGV[0]));
quit();
exit($r);
} elsif ($0 =~ /passwdaccount$/ ||
(($ARGV[0] eq "-p" || $ARGV[0] eq "--passwd") && ((shift @ARGV), 1))) {
my($r) = changepasswd($ARGV[0], $ARGV[1]);
quit();
exit($r);
} elsif ($0 =~ /reloadGM$/ ||
(($ARGV[0] eq "-r" || $ARGV[0] eq "--reloadGM") && ((shift @ARGV), 1))) {
my($r) = reloadGM();
quit();
exit($r);
} elsif ($0 =~ /searchaccount$/ ||
(($ARGV[0] eq "-s" || $ARGV[0] eq "--search") && ((shift @ARGV), 1))) {
my($r) = searchaccount($ARGV[0], $ARGV[1]);
quit();
exit($r);
} elsif ($0 =~ /sexaccount$/ ||
(($ARGV[0] eq "-sex" || $ARGV[0] eq "--sex") && ((shift @ARGV), 1))) {
my($r) = changesex($ARGV[0], $ARGV[1]);
quit();
exit($r);
} elsif ($0 =~ /stateaccount$/ ||
(($ARGV[0] eq "-t" || $ARGV[0] eq "--state") && ((shift @ARGV), 1))) {
my($r) = changestate($ARGV[0], $ARGV[1], $ARGV[2]);
quit();
exit($r);
} elsif ($0 =~ /timeaddaccount$/ ||
(($ARGV[0] eq "-ta" || $ARGV[0] eq "--timeadd") && ((shift @ARGV), 1))) {
my($r) = timeaddaccount($ARGV[0], $ARGV[1]);
quit();
exit($r);
} elsif ($0 =~ /timesetaccount$/ ||
(($ARGV[0] eq "-ts" || $ARGV[0] eq "--timeset") && ((shift @ARGV), 1))) {
my($r) = timesetaccount($ARGV[0], $ARGV[1], $ARGV[2]);
quit();
exit($r);
} elsif ($0 =~ /unbanaccount$/ || $0 =~ /unbanishaccount$/ ||
(($ARGV[0] eq "-uba" || $ARGV[0] eq "--unban" || $ARGV[0] eq "--unbanish") && ((shift @ARGV), 1))) {
my($r) = bansetaccount($ARGV[0], 0, "");
quit();
exit($r);
} elsif ($0 =~ /unblockaccount$/ ||
(($ARGV[0] eq "-ubl" || $ARGV[0] eq "--unblock") && ((shift @ARGV), 1))) {
my($r) = changestate($ARGV[0], 0, "");
quit();
exit($r);
} elsif ($0 =~ /whoaccount$/ ||
(($ARGV[0] eq "-w" || $ARGV[0] eq "--who") && ((shift @ARGV), 1))) {
my($r) = whoaccount($ARGV[0]);
quit();
exit($r);
}
#-------------------------------------------------------------------------
if ($defaultlanguage eq "F") {
print "Lecture de la version du serveur de login...\n";
} else {
print "Reading of the version of the login-server...\n";
}
checkloginversion();
# Set the prompt line
my($term) = new Term::ReadLine "ladmin";
# Here begin the infinite loop to read prompts
while(1) {
# Displaying of the prompt
print "\n";
if ($defaultlanguage eq "F") {
printf "\033[32mPour afficher les commandes, tapez 'Entrée'.\033[0m\n";
} else {
printf "\033[32mTo list the commands, type 'enter'.\033[0m\n";
}
my($cmd) = $term->readline("ladmin> ");
# split and recovery of the input
chomp $cmd; # remove cariage return
$cmd =~ s/\x1b\[\d*\w//g; # remove (esc)[(number)(1alpha) = screen control sequence
$cmd =~ s/[\x00-\x1f]//g; # remove control char
my($command, $parameters) = split /\s+/,$cmd,2; # extract command and parameters
$command = lc($command); # command in lowercase
my(@paramlist) = split /\s+/,$parameters; # get list of parameters
if ($command eq "?" || $command eq "") {
$command = "aide" if ($defaultlanguage eq "F");
$command = "help" if ($defaultlanguage ne "F");
}
# Analyse of the command
eval {
# help
if ("aide" =~ /^\Q$command/ && $command ne "a") { # check 1 letter command: 'aide' or 'add'?
displayhelp("aide", $paramlist[0]);
} elsif ("help" =~ /^\Q$command/) {
displayhelp("help", $paramlist[0]);
# general commands
} elsif ("add" =~ /^\Q$command/ && $command ne "a") { # check 1 letter command: 'aide' or 'add'?
if (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)\s+(.*)/)) {
addaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> <sex> <password>
} elsif (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)/)) {
addaccount($paramlist[0], $paramlist[1], ""); # <account_name> <sex> <password>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)\s+(.*)/)) {
addaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> <sex> <password>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)/)) {
addaccount($paramlist[0], $paramlist[1], ""); # <account_name> <sex> <password>
} else {
@paramlist = split /\s+/,$parameters;
addaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> <sex> <password>
}
} elsif ($command eq "ban" || ("banish" =~ /^\Q$command/ && length($command) >= 4)) {
if (@paramlist = ($parameters =~ m/^(\S+)\s+(\S+)\s+"(.*)"/)) { # yyyy/mm/dd hh:mm:ss <account_name>
bansetaccount($paramlist[2], $paramlist[0], $paramlist[1]); # <account_name> yyyy/mm/dd [hh:mm:ss]
} elsif (@paramlist = ($parameters =~ m/^(\S+)\s+(\S+)\s+'(.*)'/)) { # yyyy/mm/dd hh:mm:ss <account_name>
bansetaccount($paramlist[2], $paramlist[0], $paramlist[1]); # <account_name> yyyy/mm/dd [hh:mm:ss]
} else {
@paramlist = split /\s+/,$parameters,3; # yyyy/mm/dd hh:mm:ss <account_name>
bansetaccount($paramlist[2], $paramlist[0], $paramlist[1]); # <account_name> yyyy/mm/dd [hh:mm:ss]
}
} elsif (("banadd" =~ /^\Q$command/ || $command eq "ba") && $command ne "b") { # check 1 letter command: 'ba' or 'bs'?
if (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)/)) {
banaddaccount($paramlist[0], $paramlist[1]); # <account_name> <modifier>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)/)) {
banaddaccount($paramlist[0], $paramlist[1]); # <account_name> <modifier>
} else {
@paramlist = split /\s+/,$parameters;
banaddaccount($paramlist[0], $paramlist[1]); # <account_name> <modifier>
}
} elsif (("banset" =~ /^\Q$command/ || $command eq "bs") && $command ne "b") { # check 1 letter command: 'ba' or 'bs'?
if (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)\s+(\S+)/)) {
bansetaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> yyyy/mm/dd [hh:mm:ss]
} elsif (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)/)) {
bansetaccount($paramlist[0], $paramlist[1], "23:59:59"); # <account_name> yyyy/mm/dd [hh:mm:ss]
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)\s+(\S+)/)) {
bansetaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> yyyy/mm/dd [hh:mm:ss]
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)/)) {
bansetaccount($paramlist[0], $paramlist[1], "23:59:59"); # <account_name> yyyy/mm/dd [hh:mm:ss]
} else {
@paramlist = split /\s+/,$parameters;
bansetaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> yyyy/mm/dd [hh:mm:ss]
}
} elsif ("block" =~ /^\Q$command/ && length($command) >= 2) {
if (@paramlist = ($parameters =~ m/^"(.*)"/)) {
changestate($paramlist[0], 5, ""); # <account_name> <new_state> <error_message_#7>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
changestate($paramlist[0], 5, ""); # <account_name> <new_state> <error_message_#7>
} else {
@paramlist = split /\s+/,$parameters,1;
changestate($paramlist[0], 5, ""); # <account_name> <new_state> <error_message_#7>
}
} elsif ("check" =~ /^\Q$command/ && $command ne "c") { # check 1 letter command: 'check' or 'create'?
if (@paramlist = ($parameters =~ m/^"(.*)"\s+(.*)/)) {
checkaccount($paramlist[0], $paramlist[1]); # <account_name> <password>
} elsif (@paramlist = ($parameters =~ m/^"(.*)"/)) {
checkaccount($paramlist[0], ""); # <account_name> <password>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(.*)/)) {
checkaccount($paramlist[0], $paramlist[1]); # <account_name> <password>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
checkaccount($paramlist[0], ""); # <account_name> <password>
} else {
@paramlist = split /\s+/,$parameters;
checkaccount($paramlist[0], $paramlist[1]); # <account_name> <password>
}
} elsif ("create" =~ /^\Q$command/ && $command ne "c") { # check 1 letter command: 'check' or 'create'?
if (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)\s+(\S+)\s+(.*)/)) {
createaccount($paramlist[0], $paramlist[1], $paramlist[2], $paramlist[3]); # <account_name> <sex> <email> <password>
} elsif (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)\s+(\S+)/)) {
createaccount($paramlist[0], $paramlist[1], $paramlist[2], ""); # <account_name> <sex> <email> <password>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)\s+(\S+)\s+(.*)/)) {
createaccount($paramlist[0], $paramlist[1], $paramlist[2], $paramlist[3]); # <account_name> <sex> <email> <password>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)\s+(\S+)/)) {
createaccount($paramlist[0], $paramlist[1], $paramlist[2], ""); # <account_name> <sex> <email> <password>
} else {
@paramlist = split /\s+/,$parameters;
createaccount($paramlist[0], $paramlist[1], $paramlist[2], $paramlist[3]); # <account_name> <sex> <email> <password>
}
} elsif ("del" =~ /^\Q$command/ || "delete" =~ /^\Q$command/) {
if (@paramlist = ($parameters =~ m/^"(.*)"/)) {
delaccount($paramlist[0]); # <account_name>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
delaccount($paramlist[0]); # <account_name>
} else {
@paramlist = split /\s+/,$parameters,1;
delaccount($paramlist[0]); # <account_name>
}
} elsif ("email" =~ /^\Q$command/ && $command ne "e") { # check 1 letter command: 'email', 'end' or 'exit'?
if (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)/)) {
changeemail($paramlist[0], $paramlist[1]); # <account_name> <email>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)/)) {
changeemail($paramlist[0], $paramlist[1]); # <account_name> <email>
} else {
@paramlist = split /\s+/,$parameters;
changeemail($paramlist[0], $paramlist[1]); # <account_name> <email>
}
} elsif ("getcount" =~ /^\Q$command/ && $command ne "g") { # check 1 letter command: 'getcount' or 'gm'?
getlogincount();
} elsif ("gm" =~ /^\Q$command/ && $command ne "g") { # check 1 letter command: 'getcount' or 'gm'?
if (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)/)) {
changegmlevel($paramlist[0], int($paramlist[1])); # <account_name> <GM_level>
} elsif (@paramlist = ($parameters =~ m/^"(.*)"/)) {
changegmlevel($paramlist[0], 0); # <account_name> <GM_level>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)/)) {
changegmlevel($paramlist[0], int($paramlist[1])); # <account_name> <GM_level>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
changegmlevel($paramlist[0], 0); # <account_name> <GM_level>
} else {
@paramlist = split /\s+/,$parameters;
changegmlevel($paramlist[0], int($paramlist[1])); # <account_name> <GM_level>
}
} elsif ("id" =~ /^\Q$command/ && $command ne "i") { # check 1 letter command: 'id' or 'info'?
if (@paramlist = ($parameters =~ m/^"(.*)"/)) {
idaccount($paramlist[0]); # <account_name>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
idaccount($paramlist[0]); # <account_name>
} else {
@paramlist = split /\s+/,$parameters,1;
idaccount($paramlist[0]); # <account_name>
}
} elsif ("info" =~ /^\Q$command/ && $command ne "i") { # check 1 letter command: 'id' or 'info'?
infoaccount(int($paramlist[0])); # <account_id>
} elsif ($command eq "kami") { # check all letters command: 'kami' or 'kamib'?
@paramlist = split /\s+/,$parameters,1;
sendbroadcast(0, $paramlist[0]); # <type> <message>
} elsif ($command eq "kamib") { # check all letters command: 'kami' or 'kamib'?
@paramlist = split /\s+/,$parameters,1;
sendbroadcast(0x10, $paramlist[0]); # <type> <message>
} elsif ("language" =~ /^\Q$command/ && $command ne "l") { # check 1 letter command: 'list' or 'language'?
changelanguage($paramlist[0]); # <language>
} elsif (("list" =~ /^\Q$command/ || $command eq "ls") && $command ne "l") { # check 1 letter command: 'list' or 'language'?
listaccount(int($paramlist[0]), int($paramlist[1]), 0); # [start_id [end_id]] 0: to list all
} 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'?
listaccount(int($paramlist[0]), int($paramlist[1]), 3); # [start_id [end_id]] 3: to list only accounts with state or banished
} 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'?
listaccount(int($paramlist[0]), int($paramlist[1]), 1); # [start_id [end_id]] 1: to list only GM
} 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'?
listaccount(int($paramlist[0]), int($paramlist[1]), 4); # [start_id [end_id]] 4: to list only accounts without state and not banished
} elsif ("memo" =~ /^\Q$command/) {
if (@paramlist = ($parameters =~ m/^"(.*)"\s+(.*)/)) {
changememo($paramlist[0], $paramlist[1]); # <account_name> <memo>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(.*)/)) {
changememo($paramlist[0], $paramlist[1]); # <account_name> <memo>
} else {
@paramlist = split /\s+/,$parameters,2;
changememo($paramlist[0], $paramlist[1]); # <account_name> <memo>
}
} elsif ("name" =~ /^\Q$command/) {
nameaccount(int($paramlist[0])); # <account_id>
} elsif ("passwd" =~ /^\Q$command/ || "password" =~ /^\Q$command/) {
if (@paramlist = ($parameters =~ m/^"(.*)"\s+(.*)/)) {
changepasswd($paramlist[0], $paramlist[1]); # <account_name> <new_password>
} elsif (@paramlist = ($parameters =~ m/^"(.*)"/)) {
changepasswd($paramlist[0], ""); # <account_name> <new_password>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(.*)/)) {
changepasswd($paramlist[0], $paramlist[1]); # <account_name> <new_password>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
changepasswd($paramlist[0], ""); # <account_name> <new_password>
} else {
@paramlist = split /\s+/,$parameters,2;
changepasswd($paramlist[0], $paramlist[1]); # <account_name> <new_password>
}
} elsif ("reloadgm" =~ /^\Q$command/) {
reloadGM();
} elsif ("search" =~ /^\Q$command/ && $command ne "s" && # check 1 letter command: 'search', 'state' or 'sex'?
$command ne "se") { # check 2 letters command: 'search' or 'sex'?
if (@paramlist = ($parameters =~ m/^(-{1,2}[re]\S*)\s+(.*)/)) {
searchaccount($paramlist[0], $paramlist[1]); # -r/-e/--expr/--regex <expression> | <expression>
} else {
@paramlist = split /\s+/,$parameters,1;
searchaccount($paramlist[0], ""); # -r/-e/--expr/--regex <expression> | <expression>
}
} elsif ("sex" =~ /^\Q$command/ && $command ne "s" && # check 1 letter command: 'search', 'state' or 'sex'?
$command ne "se") { # check 2 letters command: 'search' or 'sex'?
if (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)/)) {
changesex($paramlist[0], $paramlist[1]); # <account_name> <sex>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)/)) {
changesex($paramlist[0], $paramlist[1]); # <account_name> <sex>
} else {
@paramlist = split /\s+/,$parameters;
changesex($paramlist[0], $paramlist[1]); # <account_name> <sex>
}
} elsif ("state" =~ /^\Q$command/ && $command ne "s") { # check 1 letter command: 'search', 'state' or 'sex'?
if (@paramlist = ($parameters =~ m/^"(.*)"\s+(\d+)\s+(.*)/)) {
changestate($paramlist[0], int($paramlist[1]), $paramlist[2]); # <account_name> <new_state> <error_message_#7>
} elsif (@paramlist = ($parameters =~ m/^"(.*)"\s+(\d+)/)) {
changestate($paramlist[0], int($paramlist[1]), ""); # <account_name> <new_state> <error_message_#7>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\d+)\s+(.*)/)) {
changestate($paramlist[0], int($paramlist[1]), $paramlist[2]); # <account_name> <new_state> <error_message_#7>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\d+)/)) {
changestate($paramlist[0], int($paramlist[1]), ""); # <account_name> <new_state> <error_message_#7>
} else {
@paramlist = split /\s+/,$parameters,3;
changestate($paramlist[0], int($paramlist[1]), $paramlist[2]); # <account_name> <new_state> <error_message_#7>
}
} elsif (("timeadd" =~ /^\Q$command/ || $command eq "ta") && $command ne "t") { # check 1 letter command: 'ta' or 'ts'?
if (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)/)) {
timeaddaccount($paramlist[0], $paramlist[1]); # <account_name> <modifier>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)/)) {
timeaddaccount($paramlist[0], $paramlist[1]); # <account_name> <modifier>
} else {
@paramlist = split /\s+/,$parameters;
timeaddaccount($paramlist[0], $paramlist[1]); # <account_name> <modifier>
}
} elsif (("timeset" =~ /^\Q$command/ || $command eq "ts") && $command ne "t") { # check 1 letter command: 'ta' or 'ts'?
if (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)\s+(\S+)/)) {
timesetaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> yyyy/mm/dd [hh:mm:ss]
} elsif (@paramlist = ($parameters =~ m/^"(.*)"\s+(\S+)/)) {
timesetaccount($paramlist[0], $paramlist[1], "23:59:59"); # <account_name> yyyy/mm/dd [hh:mm:ss]
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)\s+(\S+)/)) {
timesetaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> yyyy/mm/dd [hh:mm:ss]
} elsif (@paramlist = ($parameters =~ m/^'(.*)'\s+(\S+)/)) {
timesetaccount($paramlist[0], $paramlist[1], "23:59:59"); # <account_name> yyyy/mm/dd [hh:mm:ss]
} else {
@paramlist = split /\s+/,$parameters;
timesetaccount($paramlist[0], $paramlist[1], $paramlist[2]); # <account_name> yyyy/mm/dd [hh:mm:ss]
}
} elsif ($command eq "unban" || ("unbanish" =~ /^\Q$command/ && length($command) >= 4)) {
if (@paramlist = ($parameters =~ m/^"(.*)"/)) {
bansetaccount($paramlist[0], 0, ""); # <account_name> yyyy/mm/dd [hh:mm:ss]
} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
bansetaccount($paramlist[0], 0, ""); # <account_name> yyyy/mm/dd [hh:mm:ss]
} else {
@paramlist = split /\s+/,$parameters,1;
bansetaccount($paramlist[0], 0, ""); # <account_name> yyyy/mm/dd [hh:mm:ss]
}
} elsif ("unblock" =~ /^\Q$command/ && length($command) >= 4) {
if (@paramlist = ($parameters =~ m/^"(.*)"/)) {
changestate($paramlist[0], 0, ""); # <account_name> <new_state> <error_message_#7>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
changestate($paramlist[0], 0, ""); # <account_name> <new_state> <error_message_#7>
} else {
@paramlist = split /\s+/,$parameters,1;
changestate($paramlist[0], 0, ""); # <account_name> <new_state> <error_message_#7>
}
} elsif ("version" =~ /^\Q$command/) {
checkloginversion();
} elsif ("who" =~ /^\Q$command/) {
if (@paramlist = ($parameters =~ m/^"(.*)"/)) {
whoaccount($paramlist[0]); # <account_name>
} elsif (@paramlist = ($parameters =~ m/^'(.*)'/)) {
whoaccount($paramlist[0]); # <account_name>
} else {
@paramlist = split /\s+/,$parameters,1;
whoaccount($paramlist[0]); # <account_name>
}
# quit
} elsif ("quit" =~ /^\Q$command/ ||
(("end" =~ /^\Q$command/ || "exit" =~ /^\Q$command/) && $command ne "e")) { # check 1 letter command: 'email', 'end' or 'exit'?
last;
# unknown command
} elsif ($command) {
if ($defaultlanguage eq "F") {
print "Commande inconnue [".$command."]\n";
} else {
print "Unknown command [".$command."]\n";
}
}
# $term->addhistory($cmd) if $command;
};
if ($@) {
if ($defaultlanguage eq "F") {
print "Erreur [".$command."]\n$@";
} else {
print "Error [".$command."]\n$@";
}
}
};
# End of the software
quit();
if ($defaultlanguage eq "F") {
print "Au revoir.\n";
} else {
print "Bye.\n";
}
exit(0);
#--------------------------------------------------------------------------
# Sub-function: Displaying of the version of the login-server
sub checkloginversion() {
print $so pack("v",30000); # 0x7530
$so->flush();
$buf = readso(10);
# Analyse du Packet
my($ret, $maver, $miver, $rev, $dev, $mod, $type, $mdver) = unpack("vc6v", $buf);
if ($ret != 30001) { #0x7531
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
exit(6);
}
print " Login-Server [$loginserverip:$loginserverport]\n";
printf " eAthena version %s-%d.%d", ("stable", "dev")[$dev], $maver, $miver;
printf " revision %d", $rev if $rev;
printf "%s%d.\n", ("", "-mod")[$mod], $mdver;
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: Displaying of the help
sub displayhelp() {
my($help, $receivedcommand) = @_;
my($command) = lc($receivedcommand); # command in lowercase
if ($command eq "") {
$command = "not a command"; # any value that is not a command
}
if ($command eq "?") {
$command = "aide" if ($defaultlanguage eq "F");
$command = "help" if ($defaultlanguage ne "F");
}
if ($help eq "aide") {
if ("aide" =~ /^\Q$command/ && $command ne "a") { # check 1 letter command: 'aide' or 'add'?
printf "aide/help/?\n";
printf " Affiche la description des commandes\n";
printf "aide/help/? [commande]\n";
printf " Affiche la description de la commande specifiée\n";
} elsif ("help" =~ /^\Q$command/) {
printf "aide/help/?\n";
printf " Display the description of the commands\n";
printf "aide/help/? [command]\n";
printf " Display the description of the specified command\n";
} elsif ("add" =~ /^\Q$command/ && $command ne "a") { # check 1 letter command: 'aide' or 'add'?
printf "add <nomcompte> <sexe> <motdepasse>\n";
printf " Crée un compte avec l'email par défaut (a\@a.com).\n";
printf " Concernant le sexe, seule la première lettre compte (F ou M).\n";
printf " L'e-mail est a\@a.com (e-mail par défaut). C'est comme n'avoir aucun e-mail.\n";
printf " Lorsque motdepasse est omis, la saisie se fait sans que la frappe se voit.\n";
printf " <exemple> add testname Male testpass\n";
} elsif ($command eq "ban" || ("banish" =~ /^\Q$command/ && length($command) >= 4)) {
printf "ban/banish aaaa/mm/jj hh:mm:ss <nomcompte>\n";
printf " Change la date de fin de bannissement d'un compte.\n";
printf " La différence avec banset est la position du nom du compte.\n";
} elsif (("banadd" =~ /^\Q$command/ || $command eq "ba") && $command ne "b") { # check 1 letter command: 'ba' or 'bs'?
printf "banadd <nomcompte> <Modificateur>\n";
printf " Ajoute ou soustrait du temps à la date de banissement d'un compte.\n";
printf " Les modificateurs sont construits comme suit:\n";
printf " Valeur d'ajustement (-1, 1, +1, etc...)\n";
printf " Elément modifié:\n";
printf " a ou y: année\n";
printf " m: mois\n";
printf " j ou d: jour\n";
printf " h: heure\n";
printf " mn: minute\n";
printf " s: seconde\n";
printf " <exemple> banadd testname +1m-2mn1s-6a\n";
printf " Cette exemple ajoute 1 mois et une seconde, et soustrait 2 minutes\n";
printf " et 6 ans dans le même temps.\n";
printf "NOTE: Si vous modifez la date de banissement d'un compte non bani,\n";
printf " vous indiquez comme date (le moment actuel +- les ajustements)\n";
} elsif (("banset" =~ /^\Q$command/ || $command eq "bs") && $command ne "b") { # check 1 letter command: 'ba' or 'bs'?
printf "banset <nomcompte> aaaa/mm/jj [hh:mm:ss]\n";
printf " Change la date de fin de bannissement d'un compte.\n";
printf " Heure par défaut: 23:59:59\n";
printf "banset <nomcompte> 0\n";
printf " Débanni un compte (0 = de-banni).\n";
} elsif ("block" =~ /^\Q$command/ && length($command) >= 2) {
printf "block <nom compte>\n";
printf " Place le status d'un compte à 5 (You have been blocked by the GM Team).\n";
printf " La commande est l'équivalent de state <nom_compte> 5.\n";
} elsif ("check" =~ /^\Q$command/ && $command ne "c") { # check 1 letter command: 'check' or 'create'?
printf "check <nomcompte> <motdepasse>\n";
printf " Vérifie la validité d'un mot de passe pour un compte\n";
printf " NOTE: Le serveur n'enverra jamais un mot de passe.\n";
printf " C'est la seule méthode que vous possédez pour savoir\n";
printf " si un mot de passe est le bon. L'autre méthode est\n";
printf " d'avoir un accès ('physique') au fichier des comptes.\n";
} elsif ("create" =~ /^\Q$command/ && $command ne "c") { # check 1 letter command: 'check' or 'create'?
printf "create <nomcompte> <sexe> <email> <motdepasse>\n";
printf " Comme la commande add, mais avec l'e-mail en plus.\n";
printf " <exemple> create testname Male mon\@mail.com testpass\n";
} elsif ("del" =~ /^\Q$command/ || "delete" =~ /^\Q$command/) {
printf "del <nomcompte>\n";
printf " Supprime un compte.\n";
printf " La commande demande confirmation. Après confirmation, le compte est détruit.\n";
} elsif ("email" =~ /^\Q$command/ && $command ne "e") { # check 1 letter command: 'email', 'end' or 'exit'?
printf "email <nomcompte> <email>\n";
printf " Modifie l'e-mail d'un compte.\n";
} elsif ("getcount" =~ /^\Q$command/ && $command ne "g") { # check 1 letter command: 'getcount' or 'gm'?
printf "getcount\n";
printf " Donne le nombre de joueurs en ligne par serveur de char.\n";
} elsif ("gm" =~ /^\Q$command/ && $command ne "g") { # check 1 letter command: 'getcount' or 'gm'?
printf "gm <nomcompte> [Niveau_GM]\n";
printf " Modifie le niveau de GM d'un compte.\n";
printf " Valeur par défaut: 0 (suppression du niveau de GM).\n";
printf " <exemple> gm nomtest 80\n";
} elsif ("id" =~ /^\Q$command/ && $command ne "i") { # check 1 letter command: 'id' or 'info'?
printf "id <nomcompte>\n";
printf " Donne l'id d'un compte.\n";
} elsif ("info" =~ /^\Q$command/ && $command ne "i") { # check 1 letter command: 'id' or 'info'?
printf "info <idcompte>\n";
printf " Affiche les informations sur un compte.\n";
} elsif ($command eq "kami") { # check all letters command: 'kami' or 'kamib'?
printf "kami <message>\n";
printf " Envoi un message général sur tous les serveurs de map (en jaune).\n";
} elsif ($command eq "kamib") { # check all letters command: 'kami' or 'kamib'?
printf "kamib <message>\n";
printf " Envoi un message général sur tous les serveurs de map (en bleu).\n";
} elsif ("language" =~ /^\Q$command/ && $command ne "l") { # check 1 letter command: 'list' or 'language'?
printf("language <langue>\n");
printf(" Change la langue d'affichage.\n");
printf(" Langues possibles: 'Français' ou 'English'.\n");
} elsif (("list" =~ /^\Q$command/ || $command eq "ls") && $command ne "l") { # check 1 letter command: 'list' or 'language'?
printf "list/ls [Premier_id [Dernier_id]]\n";
printf " Affiche une liste de comptes.\n";
printf " 'Premier_id', 'Dernier_id': indique les identifiants de départ et de fin.\n";
printf " La recherche par nom n'est pas possible avec cette commande.\n";
printf " <example> list 10 9999999\n";
} 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'?
printf "listBan/lsBan [Premier_id [Dernier_id]]\n";
printf " Comme list/ls, mais seulement pour les comptes GM avec un statut ou bannis.\n";
} 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'?
printf "listGM/lsGM [Premier_id [Dernier_id]]\n";
printf " Comme list/ls, mais seulement pour les comptes GM.\n";
} 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'?
printf "listOK/lsOK [Premier_id [Dernier_id]]\n";
printf " Comme list/ls, mais seulement pour les comptes sans statut et non bannis.\n";
} elsif ("memo" =~ /^\Q$command/) {
printf "memo <nomcompte> <memo>\n";
printf " Modifie le mémo d'un compte.\n";
printf " 'memo': Il peut avoir jusqu'à 253 caractères (avec des espaces ou non).\n";
} elsif ("name" =~ /^\Q$command/) {
printf "name <idcompte>\n";
printf " Donne le nom d'un compte.\n";
} elsif ("passwd" =~ /^\Q$command/ || "password" =~ /^\Q$command/) {
printf "passwd <nomcompte> <nouveaumotdepasse>\n";
printf " Change le mot de passe d'un compte.\n";
printf " Lorsque nouveaumotdepasse est omis,\n";
printf " la saisie se fait sans que la frappe ne se voit.\n";
} elsif ("reloadgm" =~ /^\Q$command/) {
printf "reloadGM\n";
printf " Reload GM configuration file\n";
} elsif ("search" =~ /^\Q$command/ && $command ne "s" && # check 1 letter command: 'search', 'state' or 'sex'?
$command ne "se") { # check 2 letters command: 'search' or 'sex'?
printf "search <expression>\n";
printf " Cherche des comptes.\n";
printf " Affiche les comptes dont les noms correspondent.\n";
printf "search -r/-e/--expr/--regex <expression>\n";
printf " Cherche des comptes par expression regulière.\n";
printf " Affiche les comptes dont les noms correspondent.\n";
} elsif ("sex" =~ /^\Q$command/ && $command ne "s" && # check 1 letter command: 'search', 'state' or 'sex'?
$command ne "se") { # check 2 letters command: 'search' or 'sex'?
printf "sex <nomcompte> <sexe>\n";
printf " Modifie le sexe d'un compte.\n";
printf " <exemple> sex testname Male\n";
} elsif ("state" =~ /^\Q$command/ && $command ne "s") { # check 1 letter command: 'search', 'state' or 'sex'?
printf "state <nomcompte> <nouveaustatut> <message_erreur_7>\n";
printf " Change le statut d'un compte.\n";
printf " 'nouveaustatut': Le statut est le même que celui du packet 0x006a + 1.\n";
printf " les possibilités sont:\n";
printf " 0 = Compte ok\n";
printf " 1 = Unregistered ID\n";
printf " 2 = Incorrect Password\n";
printf " 3 = This ID is expired\n";
printf " 4 = Rejected from Server\n";
printf " 5 = You have been blocked by the GM Team\n";
printf " 6 = Your Game's EXE file is not the latest version\n";
printf " 7 = You are Prohibited to log in until...\n";
printf " 8 = Server is jammed due to over populated\n";
printf " 9 = No MSG\n";
printf " 100 = This ID has been totally erased\n";
printf " all other values are 'No MSG', then use state 9 please.\n";
printf " 'message_erreur_7': message du code erreur 6 =\n";
printf " = Your are Prohibited to log in until... (packet 0x006a)\n";
} elsif (("timeadd" =~ /^\Q$command/ || $command eq "ta") && $command ne "t") { # check 1 letter command: 'ta' or 'ts'?
printf "timeadd <nomcompte> <modificateur>\n";
printf " Ajoute/soustrait du temps à la limite de validité d'un compte.\n";
printf " Le modificateur est composé comme suit:\n";
printf " Valeur modificatrice (-1, 1, +1, etc...)\n";
printf " Elément modifié:\n";
printf " a ou y: année\n";
printf " m: mois\n";
printf " j ou d: jour\n";
printf " h: heure\n";
printf " mn: minute\n";
printf " s: seconde\n";
printf " <exemple> timeadd testname +1m-2mn1s-6a\n";
printf " Cette exemple ajoute 1 mois et une seconde, et soustrait 2 minutes\n";
printf " et 6 ans dans le même temps.\n";
printf "NOTE: Vous ne pouvez pas modifier une limite de validité illimitée. Si vous\n";
printf " désirez le faire, c'est que vous voulez probablement créer un limite de\n";
printf " validité limitée. Donc, en premier, fixé une limite de valitidé.\n";
} elsif (("timeset" =~ /^\Q$command/ || $command eq "ts") && $command ne "t") { # check 1 letter command: 'ta' or 'ts'?
printf "timeset <nomcompte> aaaa/mm/jj [hh:mm:ss]\n";
printf " Change la limite de validité d'un compte.\n";
printf " Heure par défaut: 23:59:59\n";
printf "timeset <nomcompte> 0\n";
printf " Donne une limite de validité illimitée (0 = illimitée).\n";
} elsif ($command eq "unban" || ("unbanish" =~ /^\Q$command/ && length($command) >= 4)) {
printf "unban/unbanish <nom compte>\n";
printf " Ote le banissement d'un compte.\n";
printf " La commande est l'équivalent de banset <nom_compte> 0.\n";
} elsif ("unblock" =~ /^\Q$command/ && length($command) >= 4) {
printf "unblock <nom compte>\n";
printf " Place le status d'un compte à 0 (Compte ok).\n";
printf " La commande est l'équivalent de state <nom_compte> 0.\n";
} elsif ("version" =~ /^\Q$command/) {
printf "version\n";
printf " Affiche la version du login-serveur.\n";
} elsif ("who" =~ /^\Q$command/) {
printf "who <nomcompte>\n";
printf " Affiche les informations sur un compte.\n";
} elsif ("quit" =~ /^\Q$command/ ||
(("end" =~ /^\Q$command/ || "exit" =~ /^\Q$command/) && $command ne "e")) { # check 1 letter command: 'email', 'end' or 'exit'?\n";
printf "quit/end/exit\n";
printf " Fin du programme d'administration.\n";
} else {
if ($receivedcommand ne "") {
printf "Commande inconnue [%s] pour l'aide. Affichage de toutes les commandes.\n", $receivedcommand;
}
print << "ENDOFAIDE";
aide/help/? -- Affiche cet aide
aide/help/? [commande] -- Affiche l'aide de la commande
add <nomcompte> <sexe> <motdepasse> -- Crée un compte (sans email)
ban/banish aaaa/mm/jj hh:mm:ss <nomcompte>-- Change la date finale de banismnt
banadd/ba <nomcompte> <modificateur> -- Ajout/soustrait du temps à la
exemple: ba moncompte +1m-2mn1s-2y date finale de banissement
banset/bs <nomcompte> aaaa/mm/jj [hh:mm:ss] -- Change la date fin de banisemnt
banset/bs <nomcompte> 0 -- Dé-banis un compte.
block <nom compte> -- Mets le status d'un compte à 5 (blocked by the GM Team)
check <nomcompte> <motdepasse> -- Vérifie un mot de passe d'un compte
create <nomcompte> <sexe> <email> <motdepasse> -- Crée un compte (avec email)
del <nomcompte> -- Supprime un compte
email <nomcompte> <email> -- Modifie l'e-mail d'un compte
getcount -- Donne le nb de joueurs en ligne
gm <nomcompte> [Niveau_GM] -- Modifie le niveau de GM d'un compte
id <nomcompte> -- Donne l'id d'un compte
info <idcompte> -- Affiche les infos sur un compte
kami <message> -- Envoi un message général (en jaune)
kamib <message> -- Envoi un message général (en bleu)
language <langue> -- Change la langue d'affichage.
list/ls [Premier_id [Dernier_id] ] -- Affiche une liste de comptes
listBan/lsBan [Premier_id [Dernier_id] ]-- Affiche une liste de comptes
avec un statut ou bannis
listGM/lsGM [Premier_id [Dernier_id] ] -- Affiche une liste de comptes GM
listOK/lsOK [Premier_id [Dernier_id] ] -- Affiche une liste de comptes
sans status et non bannis
memo <nomcompte> <memo> -- Modifie le memo d'un compte
name <idcompte> -- Donne le nom d'un compte
passwd <nomcompte> <nouveaumotdepasse> -- Change le mot de passe d'un compte
quit/end/exit -- Fin du programme d'administation
reloadGM -- Recharger le fichier de config des GM
search <expression> -- Cherche des comptes
search -e/-r/--expr/--regex <expression> -- Cherche des comptes par REGEX
sex <nomcompte> <sexe> -- Modifie le sexe d'un compte
state <nomcompte> <nouveaustatut> <messageerr7> -- Change le statut d'1 compte
timeadd/ta <nomcompte> <modificateur> -- Ajout/soustrait du temps à la
exemple: ta moncompte +1m-2mn1s-2y limite de validité
timeset/ts <nomcompte> aaaa/mm/jj [hh:mm:ss] -- Change la limite de validité
timeset/ts <nomcompte> 0 -- limite de validité = illimitée
unban/unbanish <nom compte> -- Ote le banissement d'un compte
unblock <nom compte> -- Mets le status d'un compte à 0 (Compte ok)
version -- Donne la version du login-serveur
who <nomcompte> -- Affiche les infos sur un compte
ENDOFAIDE
printf(" Note: Pour les noms de compte avec des espaces, tapez \"<nom compte>\" (ou ').\n");
}
} else {
if ("aide" =~ /^\Q$command/ && $command ne "a") { # check 1 letter command: 'aide' or 'add'?
printf "aide/help/?\n";
printf " Display the description of the commands\n";
printf "aide/help/? [command]\n";
printf " Display the description of the specified command\n";
} elsif ("help" =~ /^\Q$command/) {
printf "aide/help/?\n";
printf " Display the description of the commands\n";
printf "aide/help/? [command]\n";
printf " Display the description of the specified command\n";
} elsif ("add" =~ /^\Q$command/ && $command ne "a") { # check 1 letter command: 'aide' or 'add'?
printf "add <account_name> <sex> <password>\n";
printf " Create an account with the default email (a\@a.com).\n";
printf " Concerning the sex, only the first letter is used (F or M).\n";
printf " The e-mail is set to a\@a.com (default e-mail). It's like to have no e-mail.\n";
printf " When the password is omitted,\n";
printf " the input is done without displaying of the pressed keys.\n";
printf " <example> add testname Male testpass\n";
} elsif ($command eq "ban" || ("banish" =~ /^\Q$command/ && length($command) >= 4)) {
printf "ban/banish yyyy/mm/dd hh:mm:ss <account_name>\n";
printf " Changes the final date of a banishment of an account.\n";
printf " The difference with banset is the position of the account name.\n";
} elsif (("banadd" =~ /^\Q$command/ || $command eq "ba") && $command ne "b") { # check 1 letter command: 'ba' or 'bs'?
printf "banadd <account_name> <modifier>\n";
printf " Adds or substracts time from the final date of a banishment of an account.\n";
printf " Modifier is done as follows:\n";
printf " Adjustment value (-1, 1, +1, etc...)\n";
printf " Modified element:\n";
printf " a or y: year\n";
printf " m: month\n";
printf " j or d: day\n";
printf " h: hour\n";
printf " mn: minute\n";
printf " s: second\n";
printf " <example> banadd testname +1m-2mn1s-6y\n";
printf " this example adds 1 month and 1 second, and substracts 2 minutes\n";
printf " and 6 years at the same time.\n";
printf "NOTE: If you modify the final date of a non-banished account,\n";
printf " you fix the final date to (actual time +- adjustments)\n";
} elsif (("banset" =~ /^\Q$command/ || $command eq "bs") && $command ne "b") { # check 1 letter command: 'ba' or 'bs'?
printf "banset <account_name> yyyy/mm/dd [hh:mm:ss]\n";
printf " Changes the final date of a banishment of an account.\n";
printf " Default time: 23:59:59\n";
printf "banset <account_name> 0\n";
printf " Set a non-banished account (0 = unbanished).\n";
} elsif ("block" =~ /^\Q$command/ && length($command) >= 2) {
printf "block <account name>\n";
printf " Set state 5 (You have been blocked by the GM Team) to an account.\n";
printf " Same command of state <account_name> 5.\n";
} elsif ("check" =~ /^\Q$command/ && $command ne "c") { # check 1 letter command: 'check' or 'create'?
printf "check <account_name> <password>\n";
printf " Check the validity of a password for an account.\n";
printf " NOTE: Server will never sends back a password.\n";
printf " It's the only method you have to know if a password is correct.\n";
printf " The other method is to have a ('physical') access to the accounts file.\n";
} elsif ("create" =~ /^\Q$command/ && $command ne "c") { # check 1 letter command: 'check' or 'create'?
printf "create <account_name> <sex> <email> <password>\n";
printf " Like the 'add' command, but with e-mail moreover.\n";
printf " <example> create testname Male my\@mail.com testpass\n";
} elsif ("del" =~ /^\Q$command/ || "delete" =~ /^\Q$command/) {
printf "del <account_name>\n";
printf " Remove an account.\n";
printf " This order requires confirmation. After confirmation, the account is deleted.\n";
} elsif ("email" =~ /^\Q$command/ && $command ne "e") { # check 1 letter command: 'email', 'end' or 'exit'?
printf "email <account_name> <email>\n";
printf " Modify the e-mail of an account.\n";
} elsif ("getcount" =~ /^\Q$command/ && $command ne "g") { # check 1 letter command: 'getcount' or 'gm'?
printf "getcount\n";
printf " Give the number of players online on all char-servers.\n";
} elsif ("gm" =~ /^\Q$command/ && $command ne "g") { # check 1 letter command: 'getcount' or 'gm'?
printf "gm <account_name> [GM_level]\n";
printf " Modify the GM level of an account.\n";
printf " Default value remove GM level (GM level = 0).\n";
printf " <example> gm testname 80\n";
} elsif ("id" =~ /^\Q$command/ && $command ne "i") { # check 1 letter command: 'id' or 'info'?
printf "id <account_name>\n";
printf " Give the id of an account.\n";
} elsif ("info" =~ /^\Q$command/ && $command ne "i") { # check 1 letter command: 'id' or 'info'?
printf "info <account_id>\n";
printf " Display complete information of an account.\n";
} elsif ($command eq "kami") { # check all letters command: 'kami' or 'kamib'?
printf "kami <message>\n";
printf " Sends a broadcast message on all map-server (in yellow).\n";
} elsif ($command eq "kamib") { # check all letters command: 'kami' or 'kamib'?
printf "kamib <message>\n";
printf " Sends a broadcast message on all map-server (in blue).\n";
} elsif ("language" =~ /^\Q$command/ && $command ne "l") { # check 1 letter command: 'list' or 'language'?
printf("language <language>\n");
printf(" Change the language of displaying.\n");
printf(" Possible languages: Français or English.\n");
} elsif (("list" =~ /^\Q$command/ || $command eq "ls") && $command ne "l") { # check 1 letter command: 'list' or 'language'?
printf "list/ls [start_id [end_id]]\n";
printf " Display a list of accounts.\n";
printf " 'start_id', 'end_id': indicate end and start identifiers.\n";
printf " Research by name is not possible with this command.\n";
printf " <example> list 10 9999999\n";
} 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'?
printf "listBan/lsBan [start_id [end_id]]\n";
printf " Like list/ls, but only for accounts with state or banished.\n";
} 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'?
printf "listGM/lsGM [start_id [end_id]]\n";
printf " Like list/ls, but only for GM accounts.\n";
} 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'?
printf "listOK/lsOK [start_id [end_id]]\n";
printf " Like list/ls, but only for accounts without state and not banished.\n";
} elsif ("memo" =~ /^\Q$command/) {
printf "memo <account_name> <memo>\n";
printf " Modify the memo of an account.\n";
printf " 'memo': it can have until 253 characters (with spaces or not).\n";
} elsif ("name" =~ /^\Q$command/) {
printf "name <account_id>\n";
printf " Give the name of an account.\n";
} elsif ("passwd" =~ /^\Q$command/ || "password" =~ /^\Q$command/) {
printf "passwd <account_name> <new_password>\n";
printf " Change the password of an account.\n";
printf " When new password is omitted,\n";
printf " the input is done without displaying of the pressed keys.\n";
} elsif ("reloadgm" =~ /^\Q$command/) {
printf "reloadGM\n";
printf " Reload GM configuration file\n";
} elsif ("search" =~ /^\Q$command/ && $command ne "s" && # check 1 letter command: 'search', 'state' or 'sex'?
$command ne "se") { # check 2 letters command: 'search' or 'sex'?
printf "search <expression>\n";
printf " Seek accounts.\n";
printf " Displays the accounts whose names correspond.\n";
printf "search -r/-e/--expr/--regex <expression>\n";
printf " Seek accounts by regular expression.\n";
printf " Displays the accounts whose names correspond.\n";
} elsif ("sex" =~ /^\Q$command/ && $command ne "s" && # check 1 letter command: 'search', 'state' or 'sex'?
$command ne "se") { # check 2 letters command: 'search' or 'sex'?
printf "sex <account_name> <sex>\n";
printf " Modify the sex of an account.\n";
printf " <example> sex testname Male\n";
} elsif ("state" =~ /^\Q$command/ && $command ne "s") { # check 1 letter command: 'search', 'state' or 'sex'?
printf "state <account_name> <new_state> <error_message_#7>\n";
printf " Change the state of an account.\n";
printf " 'new_state': state is the state of the packet 0x006a + 1.\n";
printf " The possibilities are:\n";
printf " 0 = Account ok\n";
printf " 1 = Unregistered ID\n";
printf " 2 = Incorrect Password\n";
printf " 3 = This ID is expired\n";
printf " 4 = Rejected from Server\n";
printf " 5 = You have been blocked by the GM Team\n";
printf " 6 = Your Game's EXE file is not the latest version\n";
printf " 7 = You are Prohibited to log in until...\n";
printf " 8 = Server is jammed due to over populated\n";
printf " 9 = No MSG\n";
printf " 100 = This ID has been totally erased\n";
printf " all other values are 'No MSG', then use state 9 please.\n";
printf " 'error_message_#7': message of the code error 6\n";
printf " = Your are Prohibited to log in until... (packet 0x006a)\n";
} elsif (("timeadd" =~ /^\Q$command/ || $command eq "ta") && $command ne "t") { # check 1 letter command: 'ta' or 'ts'?
printf "timeadd <account_name> <modifier>\n";
printf " Adds or substracts time from the validity limit of an account.\n";
printf " Modifier is done as follows:\n";
printf " Adjustment value (-1, 1, +1, etc...)\n";
printf " Modified element:\n";
printf " a or y: year\n";
printf " m: month\n";
printf " j or d: day\n";
printf " h: hour\n";
printf " mn: minute\n";
printf " s: second\n";
printf " <example> timeadd testname +1m-2mn1s-6y\n";
printf " this example adds 1 month and 1 second, and substracts 2 minutes\n";
printf " and 6 years at the same time.\n";
printf "NOTE: You can not modify a unlimited validity limit.\n";
printf " If you want modify it, you want probably create a limited validity limit.\n";
printf " So, at first, you must set the validity limit to a date/time.\n";
} elsif (("timeset" =~ /^\Q$command/ || $command eq "ts") && $command ne "t") { # check 1 letter command: 'ta' or 'ts'?
printf "timeset <account_name> yyyy/mm/dd [hh:mm:ss]\n";
printf " Changes the validity limit of an account.\n";
printf " Default time: 23:59:59\n";
printf "timeset <account_name> 0\n";
printf " Gives an unlimited validity limit (0 = unlimited).\n";
} elsif ($command eq "unban" || ("unbanish" =~ /^\Q$command/ && length($command) >= 4)) {
printf "unban/unbanish <account name>\n";
printf " Remove the banishment of an account.\n";
printf " This command works like banset <account_name> 0.\n";
} elsif ("unblock" =~ /^\Q$command/ && length($command) >= 4) {
printf "unblock <account name>\n";
printf " Set state 0 (Account ok) to an account.\n";
printf " This command works like state <account_name> 0.\n";
} elsif ("version" =~ /^\Q$command/) {
printf "version\n";
printf " Display the version of the login-server.\n";
} elsif ("who" =~ /^\Q$command/) {
printf "who <account_name>\n";
printf " Displays complete information of an account.\n";
} elsif ("quit" =~ /^\Q$command/ ||
(("end" =~ /^\Q$command/ || "exit" =~ /^\Q$command/) && $command ne "e")) { # check 1 letter command: 'email', 'end' or 'exit'?\n";
printf "quit/end/exit\n";
printf " End of the program of administration.\n";
} else {
if ($receivedcommand ne "") {
printf "Unknown command [%s] for help. Displaying of all commands.\n", $receivedcommand;
}
print << "ENDOFHELP";
aide/help/? -- Display this help
aide/help/? [command] -- Display the help of the command
add <account_name> <sex> <password> -- Create an account with default email
ban/banish yyyy/mm/dd hh:mm:ss <account_name> -- Change final date of a ban
banadd/ba <account_name> <modifier> -- Add or substract time from the final
example: ba apple +1m-2mn1s-2y date of a banishment of an account
banset/bs <account_name> yyyy/mm/dd [hh:mm:ss] -- Change final date of a ban
banset/bs <account_name> 0 -- Un-banish an account
block <account name> -- Set state 5 (blocked by the GM Team) to an account
check <account_name> <password> -- Check the validity of a password
create <account_name> <sex> <email> <passwrd> -- Create an account with email
del <account_name> -- Remove an account
email <account_name> <email> -- Modify an email of an account
getcount -- Give the number of players online
gm <account_name> [GM_level] -- Modify the GM level of an account
id <account_name> -- Give the id of an account
info <account_id> -- Display all information of an account
kami <message> -- Sends a broadcast message (in yellow)
kamib <message> -- Sends a broadcast message (in blue)
language <language> -- Change the language of displaying.
list/ls [First_id [Last_id]] -- Display a list of accounts
listBan/lsBan [First_id [Last_id]] -- Display a list of accounts
with state or banished
listGM/lsGM [First_id [Last_id]] -- Display a list of GM accounts
listOK/lsOK [First_id [Last_id]] -- Display a list of accounts
without state and not banished
memo <account_name> <memo> -- Modify the memo of an account
name <account_id> -- Give the name of an account
passwd <account_name> <new_password> -- Change the password of an account
quit/end/exit -- End of the program of administation
reloadGM -- Reload GM configuration file
search <expression> -- Seek accounts
search -e/-r/--expr/--regex <expressn> -- Seek accounts by regular-expression
sex <nomcompte> <sexe> -- Modify the sex of an account
state <account_name> <new_state> <error_message_#7> -- Change the state
timeadd/ta <account_name> <modifier> -- Add or substract time from the
example: ta apple +1m-2mn1s-2y validity limit of an account
timeset/ts <account_name> yyyy/mm/dd [hh:mm:ss] -- Change the validify limit
timeset/ts <account_name> 0 -- Give a unlimited validity limit
unban/unbanish <account name> -- Remove the banishment of an account
unblock <account name> -- Set state 0 (Account ok) to an account
version -- Gives the version of the login-server
who <account_name> -- Display all information of an account
ENDOFHELP
printf(" Note: To use spaces in an account name, type \"<account name>\" (or ').\n");
}
}
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: Displaying of the accounts list
sub listaccount() {
my($st, $ed, $listflag) = @_;
my($i);
my($n) = (0);
# 0123456789 01 01234567890123456789012301234 012345 0123456789012345678901234567
if ($defaultlanguage eq "F") {
print " id_compte GM nom_utilisateur sexe count statut\n";
} else {
print "account_id GM user_name sex count state\n";
}
print "-------------------------------------------------------------------------------\n";
while(1) {
print $so pack("vV2", 0x7920, $st, $ed);
$so->flush();
$buf = readso(4);
if (unpack("v", $buf) != 0x7921) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
exit(10);
}
my($len) = unpack("x2v", $buf);
last if ($len <= 4);
for($i = 4; $i < $len; $i += 38) {
my(@dat) = unpack("VCa24cVV", readso(38));
$st = $dat[0] + 1;
if ($listflag == 0 ||
($listflag == 1 && $dat[1] > 0) || # check GM flag
($listflag == 3 && $dat[5] != 0) || # check with state or banished
($listflag == 4 && $dat[5] == 0)) { # check without state and not banished
printf "%10d %2s %-24s%-5s %6d %-27s\n", $dat[0],
($dat[1] == 0 ? " " : $dat[1]),
$dat[2],
($defaultlanguage eq "F" ? ("Femme","Male","Servr")[$dat[3]] : ("Femal","Male","Servr")[$dat[3]]),
$dat[4],
(($defaultlanguage eq "F" ? "Compte Ok" : "Account OK"),
"Unregistered ID",
"Incorrect Password",
"This ID is expired",
"Rejected from Server",
"Blocked by the GM Team", # You have been blocked by the GM Team
"Your EXE file is too old", # Your Game's EXE file is not the latest version
"Banishement or\n Prohibited to login until %s", # You are Prohibited to log in until %s
"Server is over populated", # Server is jammed due to over populated
"No MSG",
"This ID is totally erased")[$dat[5] == 100 ? 10 : $dat[5]]; # This ID has been totally erased
$n++;
}
}
}
if ($defaultlanguage eq "F") {
if ($n == 0) {
print "Aucun compte trouvé.\n";
} elsif ($n == 1) {
print "1 compte trouvé.\n";
} else {
print "$n comptes trouvés.\n";
}
} else {
if ($n == 0) {
print "No account found.\n";
} elsif ($n == 1) {
print "1 account found.\n";
} else {
print "$n accounts found.\n";
}
}
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: add an account with the default e-mail
sub addaccount() {
my($userid, $sex, $passwd) = @_;
if ($userid eq "" || !defined($userid)) {
if ($defaultlanguage eq "F") {
print "Entrez un nom de compte svp.\n";
print "<exemple> add nomtest Male motdepassetest\n";
} else {
print "Please input an account name.\n";
print "<example> add testname Male testpass\n";
}
return 136;
}
if (verify_accountname($userid) == 0) {
return 102;
}
# if ($userid =~ /[^A-Za-z0-9\@-_]/) {
# if ($defaultlanguage eq "F") {
# print "Caractère interdit trouvé dans le nom du compte ".$`."[${&}]${'}\n";
# } else {
# print "Illegal character found in the account name ".$`."[${&}]${'}\n";
# }
# return 101;
# }
$sex = uc(substr($sex, 0, 1));
if ($sex !~ /^[MF]$/) {
if ($defaultlanguage eq "F") {
print "Sexe incorrect [$sex]. Entrez M ou F svp.\n";
} else {
print "Illegal gender [$sex]. Please input M or F.\n";
}
return 103;
}
if ($passwd eq "") {
return 108 if (($passwd = typepasswd()) eq "");
}
if (verify_password($passwd) == 0) {
return 104;
}
print $so pack("va24a24a1a40", 0x7930, $userid, $passwd, $sex, "");
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x7931) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 106;
}
$buf = readso(28);
if (unpack("V", $buf) == -1 || unpack("V", $buf) == 4294967295) {
if ($defaultlanguage eq "F") {
print "Echec à la création du compte [$userid]. Un compte identique existe déjà.\n";
} else {
print "Account [$userid] creation failed. Same account already exists.\n";
}
return 107;
} else {
if ($defaultlanguage eq "F") {
printf "Compte [$userid] créé avec succès [id: %d].\n", unpack("V",$buf);
} else {
printf "Account [$userid] is successfully created [id: %d].\n", unpack("V",$buf);
}
}
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: add an account with an e-mail
sub createaccount() {
my($userid, $sex, $email, $passwd) = @_;
if ($userid eq "") {
if ($defaultlanguage eq "F") {
print "Entrez un nom de compte svp.\n";
print "<exemple> create nomtest Male mon\@email.com motdepassetest\n";
} else {
print "Please input an account name.\n";
print "<example> create testname Male my\@mail.com testpass\n";
}
return 136;
}
if (verify_accountname($userid) == 0) {
return 102;
}
# if ($userid =~ /[^A-Za-z0-9\@-_]/) {
# if ($defaultlanguage eq "F") {
# print "Caractère interdit trouvé dans le nom du compte ".$`."[${&}]${'}\n";
# } else {
# print "Illegal character found in the account name ".$`."[${&}]${'}\n";
# }
# return 101;
# }
$sex = uc(substr($sex, 0, 1));
if ($sex !~ /^[MF]$/) {
if ($defaultlanguage eq "F") {
print "Sexe incorrect [$sex]. Entrez M ou F svp.\n";
} else {
print "Illegal gender [$sex]. Please input M or F.\n";
}
return 103;
}
if (length($email) < 3) {
if ($defaultlanguage eq "F") {
print "Email trop courte [$email]. Entrez une e-mail valide svp.\n";
} else {
print "Email is too short [$email]. Please input a valid e-mail.\n";
}
return 109;
}
if (length($email) > 39) {
if ($defaultlanguage eq "F") {
print "Email trop longue [$email]. Entrez une e-mail de 39 caractères maximum svp.\n";
} else {
print "Email is too long [$email]. Please input an e-mail with 39 bytes at the most.\n";
}
return 109;
}
if (verify_email($email) == 0) {
if ($defaultlanguage eq "F") {
print "Email incorrecte [$email]. Entrez une e-mail valide svp.\n";
} else {
print "Invalid email [$email]. Please input a valid e-mail.\n";
}
return 109;
}
if ($passwd eq "") {
return 108 if (($passwd = typepasswd()) eq "");
}
if (verify_password($passwd) == 0) {
return 104;
}
print $so pack("va24a24a1a40", 0x7930, $userid, $passwd, $sex, $email);
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x7931) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 106;
}
$buf = readso(28);
if (unpack("V", $buf) == -1 || unpack("V", $buf) == 4294967295) {
if ($defaultlanguage eq "F") {
print "Echec à la création du compte [$userid]. Un compte identique existe déjà.\n";
} else {
print "Account [$userid] creation failed. Same account already exists.\n";
}
return 107;
} else {
if ($defaultlanguage eq "F") {
printf "Compte [$userid] créé avec succès [id: %d].\n", unpack("V",$buf);
} else {
printf "Account [$userid] is successfully created [id: %d].\n", unpack("V",$buf);
}
}
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: deletion of an account
sub delaccount() {
my($userid) = @_;
if ($userid eq "") {
if ($defaultlanguage eq "F") {
print "Entrez un nom de compte svp.\n";
print "<exemple> del nomtestasupprimer\n";
} else {
print "Please input an account name.\n";
print "<example> del testnametodelete\n";
}
return 136;
}
if (verify_accountname($userid) == 0) {
return 102;
}
if ($defaultlanguage eq "F") {
print "** Etes-vous vraiment sûr de vouloir SUPPRIMER le compte [$userid]? (o/n) ";
} else {
print "** Are you really sure to DELETE account [$userid]? (y/n) ";
}
if (lc(substr(<STDIN>, 0, 1)) !~ /[oy]/) {
if ($defaultlanguage eq "F") {
print "Suppression annulée\n.";
} else {
print "Deletion canceled\n";
}
return 121;
}
print $so pack("va24", 0x7932, $userid);
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x7933) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 122;
}
$buf = readso(28);
my($id2, $name) = unpack("Va24", $buf);
while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
chop($name);
};
if ($id2 == -1 || $id2 == 4294967295) {
if ($defaultlanguage eq "F") {
print "Echec de la suppression du compte [$userid]. Le compte n'existe pas.\n";
} else {
print "Account [$userid] deletion failed. Account doesn't exist.\n";
}
return 123;
} else {
if ($defaultlanguage eq "F") {
print "Compte [$name][id: $id2] SUPPRIME avec succès.\n";
} else {
print "Account [$name][id: $id2] is successfully DELETED.\n";
}
}
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: modification of a password
sub changepasswd() {
my($userid, $passwd) = @_;
if ($userid eq "") {
if ($defaultlanguage eq "F") {
print "Entrez un nom de compte svp.\n";
print "<exemple> passwd nomtest nouveaumotdepasse\n";
} else {
print "Please input an account name.\n";
print "<example> passwd testname newpassword\n";
}
return 136;
}
if (verify_accountname($userid) == 0) {
return 102;
}
if ($passwd eq "") {
return 134 if (($passwd = typepasswd()) eq "");
}
if (verify_password($passwd) == 0) {
return 131;
}
print $so pack("va24a24", 0x7934, $userid,$passwd);
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x7935) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 132;
}
$buf = readso(28);
my($id2, $name) = unpack("Va24", $buf);
while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
chop($name);
};
if ($id2 == -1 || $id2 == 4294967295) {
if ($defaultlanguage eq "F") {
print "Echec de la modification du mot de passe du compte [$userid].\n";
print "Le compte [$userid] n'existe pas.\n";
} else {
print "Account [$userid] password changing failed.\n";
print "Account [$userid] doesn't exist.\n";
}
return 133;
} else {
if ($defaultlanguage eq "F") {
print "Modification du mot de passe du compte [$name][id: $id2] réussie.\n";
} else {
print "Account [$name][id: $id2] password successfully changed.\n";
}
}
return 130;
}
#--------------------------------------------------------------------------
# Sub-function: modification of an account e-mail
sub changeemail() {
my($userid, $email) = @_;
if ($userid eq "") {
if ($defaultlanguage eq "F") {
print "Entrez un nom de compte svp.\n";
print "<exemple> email testname nouveauemail\n";
} else {
print "Please input an account name.\n";
print "<example> email testname newemail\n";
}
return 136;
}
if (verify_accountname($userid) == 0) {
return 102;
}
if (length($email) < 3) {
if ($defaultlanguage eq "F") {
print "Email trop courte [$email]. Entrez une e-mail valide svp.\n";
} else {
print "Email is too short [$email]. Please input a valid e-mail.\n";
}
return 109;
}
if (length($email) > 39) {
if ($defaultlanguage eq "F") {
print "Email trop longue [$email]. Entrez une e-mail de 39 caractères maximum svp.\n";
} else {
print "Email is too long [$email]. Please input an e-mail with 39 bytes at the most.\n";
}
return 109;
}
if (verify_email($email) == 0) {
if ($defaultlanguage eq "F") {
print "Email incorrect [$email]. Entrez une e-mail valide svp.\n";
} else {
print "Invalid email [$email]. Please input a valid e-mail.\n";
}
return 109;
}
print $so pack("va24a40", 0x7940, $userid, $email);
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x7941) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 162;
}
$buf = readso(28);
my($id2, $name) = unpack("Va24", $buf);
while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
chop($name);
};
if ($id2 == -1 || $id2 == 4294967295) {
if ($defaultlanguage eq "F") {
print "Echec de la modification de l'e-mail du compte [$userid].\n";
print "Le compte [$userid] n'existe pas.\n";
} else {
print "Account [$userid] e-mail changing failed.\n";
print "Account [$userid] doesn't exist.\n";
}
return 133;
} else {
if ($defaultlanguage eq "F") {
print "Modification de l'e-mail du compte [$name][id: $id2] réussie.\n";
} else {
print "Account [$name][id: $id2] e-mail successfully changed.\n";
}
}
return 160;
}
#--------------------------------------------------------------------------
# Sub-function: search of accounts
sub searchaccount() {
my($p1, $p2) = @_;
my($exp) = ("");
if ($p1 eq "-e" || $p1 eq "-r" || $p1 eq "--regex" || $p1 eq "--expr") {
if ($p2 eq "") {
if ($defaultlanguage eq "F") {
print "Entrez une expression régulière ou utilisez 'ls' pour avoir tous les comptes.\n";
} else {
print "Input a regular expression or use 'ls' to obtain all accounts.\n";
}
return 141;
}
$exp = $p2;
} else {
if ($p1 eq "") {
if ($defaultlanguage eq "F") {
print "Entrez une chaîne ou utilisez 'ls' pour avoir tous les comptes.\n";
} else {
print "Input a string or use 'ls' to obtain all accounts.\n";
}
return 141;
}
my($c) = 0;
$exp = lc($p1);
$exp =~ s/([\@])/\\$1/g;
$c += $exp =~ s/([\-\[\]])/\\$1/g;
$c += $exp =~ s/([\*\?])/.$1/g;
$c += $exp =~ s/\\\[(.)\\\-(.)\\\]/[$1-$2]/g;
$exp = "^$exp\$" if $c;
}
if (eval{ "" =~ /$exp/; }, $@) {
if ($defaultlanguage eq "F") {
print "Expression régulière non reconnue.\n";
} else {
print "Regular-Expression compiling failed.\n";
}
return 141;
}
my($i);
my($n, $st) = (0, 0);
# 0123456789 01 01234567890123456789012301234 012345 0123456789012345678901234567
if ($defaultlanguage eq "F") {
print " id_compte GM nom_utilisateur sexe count statut\n";
} else {
print "account_id GM user_name sex count state\n";
}
print "-------------------------------------------------------------------------------\n";
while(1) {
print $so pack("vV2", 0x7920, $st, 0);
$so->flush();
$buf = readso(4);
if (unpack("v", $buf) != 0x7921) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
exit(10);
}
my($len) = unpack("x2v", $buf);
last if ($len <= 4);
for($i = 4; $i < $len; $i += 38) {
my(@dat) = unpack("VCa24cVV", readso(38));
$st = $dat[0] + 1;
next if (lc($dat[2]) !~ /$exp/);
printf "%10d %2s %-24s%-5s %6d %-27s\n", $dat[0],
($dat[1] == 0 ? " " : $dat[1]),
$dat[2],
($defaultlanguage eq "F" ? ("Femme","Male","Servr")[$dat[3]] : ("Femal","Male","Servr")[$dat[3]]),
$dat[4],
(($defaultlanguage eq "F" ? "Compte Ok" : "Account OK"),
"Unregistered ID",
"Incorrect Password",
"This ID is expired",
"Rejected from Server",
"Blocked by the GM Team", # You have been blocked by the GM Team
"Your EXE file is too old", # Your Game's EXE file is not the latest version
"Banishement or\n Prohibited to login until %s", # You are Prohibited to log in until %s
"Server is over populated", # Server is jammed due to over populated
"No MSG",
"This ID is totally erased")[$dat[5] == 100 ? 10 : $dat[5]]; # This ID has been totally erased
$n++;
}
}
if ($defaultlanguage eq "F") {
if ($n == 0) {
print "Aucun compte trouvé.\n";
} elsif ($n == 1) {
print "1 compte trouvé.\n";
} else {
print "$n comptes trouvés.\n";
}
} else {
if ($n == 0) {
print "No account found.\n";
} elsif ($n == 1) {
print "1 account found.\n";
} else {
print "$n accounts found.\n";
}
}
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: modify the sex of an account
sub changesex() {
my($userid, $sex) = @_;
if ($userid eq "" || !defined($userid)) {
if ($defaultlanguage eq "F") {
print "Entrez un nom de compte svp.\n";
print "<exemple> sex nomtest Male\n";
} else {
print "Please input an account name.\n";
print "<example> sex testname Male\n";
}
return 136;
}
if (verify_accountname($userid) == 0) {
return 102;
}
# if ($userid =~ /[^A-Za-z0-9\@-_]/) {
# if ($defaultlanguage eq "F") {
# print "Caractère interdit trouvé dans le nom du compte ".$`."[${&}]${'}\n";
# } else {
# print "Illegal character found in the account name ".$`."[${&}]${'}\n";
# }
# return 101;
# }
$sex = uc(substr($sex, 0, 1));
if ($sex !~ /^[MF]$/) {
if ($defaultlanguage eq "F") {
print "Sexe incorrect [$sex]. Entrez M ou F svp.\n";
} else {
print "Illegal gender [$sex]. Please input M or F.\n";
}
return 103;
}
print $so pack("va24a1", 0x793c, $userid, $sex);
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x793d) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 152;
}
$buf = readso(28);
my($id2, $name) = unpack("Va24", $buf);
while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
chop($name);
};
if ($id2 == -1 || $id2 == 4294967295) {
if ($defaultlanguage eq "F") {
print "Echec du changement du sexe du compte [$userid].\n";
print "Le compte n'existe pas ou le sexe est déjà celui demandé.\n";
} else {
print "Account [$userid] sex changing failed.\n";
print "Account doesn't exist or the sex is already the good sex.\n";
}
} else {
if ($defaultlanguage eq "F") {
print "Sexe du compte [$name][id: $id2] changé avec succès.\n";
} else {
print "Account [$name][id: $id2] sex successfully changed.\n";
}
}
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: modify the GM level of an account
sub changegmlevel() {
my($userid, $gm_level) = @_;
if ($userid eq "" || !defined($userid)) {
if ($defaultlanguage eq "F") {
print "Entrez un nom de compte svp.\n";
print "<exemple> gm nomtest 80\n";
} else {
print "Please input an account name.\n";
print "<example> gm testname 80\n";
}
return 136;
}
if (verify_accountname($userid) == 0) {
return 102;
}
# if ($userid =~ /[^A-Za-z0-9\@-_]/) {
# if ($defaultlanguage eq "F") {
# print "Caractère interdit trouvé dans le nom du compte ".$`."[${&}]${'}\n";
# } else {
# print "Illegal character found in the account name ".$`."[${&}]${'}\n";
# }
# return 101;
# }
$gm_level = int($gm_level);
if ($gm_level < 0 || $gm_level > 99) {
if ($defaultlanguage eq "F") {
print "Niveau de GM incorrect [$gm_level]. Entrez une valeur de 0 à 99 svp.\n";
} else {
print "Illegal GM level [$gm_level]. Please input a value from 0 to 99.\n";
}
return 103;
}
print $so pack("va24C", 0x793e, $userid, $gm_level);
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x793f) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 152;
}
$buf = readso(28);
my($id2, $name) = unpack("Va24", $buf);
while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
chop($name);
};
if ($id2 == -1 || $id2 == 4294967295) {
if ($defaultlanguage eq "F") {
print "Echec du changement du niveau de GM du compte [$userid].\n";
print "Le compte n'existe pas, le niveau de GM est déjà celui demandé,\n";
print "ou il est impossible de modifier le fichier des comptes GM.\n";
} else {
print "Account [$userid] GM level changing failed.\n";
print "Account doesn't exist, the GM level is already the good GM level,\n";
print "or it's impossible to modify the GM accounts file.\n";
}
} else {
if ($defaultlanguage eq "F") {
print "Niveau de GM du compte [$name][id: $id2] changé avec succès.\n";
} else {
print "Account [$name][id: $id2] GM level successfully changed.\n";
}
}
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: Modification of a state
sub changestate {
my($userid, $s, $error_message) = @_;
# Valid values: 0: ok, or value of the 0x006a packet + 1
if ($s eq "" || (($s < 0 || $s > 9) && $s != 100)) {
if ($defaultlanguage eq "F") {
print "Entrez une des valeurs suivantes svp:\n";
print " 0 = Compte ok 6 = Your Game's EXE file is not the latest version\n";
} else {
print "Please input one of these values:\n";
print " 0 = Account ok 6 = Your Game's EXE file is not the latest version\n";
}
print " 1 = Unregistered ID 7 = You are Prohibited to log in until %s\n";
print " 2 = Incorrect Password 8 = Server is jammed due to over populated\n";
print " 3 = This ID is expired 9 = No MSG\n";
print " 4 = Rejected from Server 100 = This ID has been totally erased\n";
print " 5 = You have been blocked by the GM Team\n";
if ($defaultlanguage eq "F") {
print "<exemples> state nomtest 5\n";
print " state nomtest 7 fin de votre ban\n";
print " block <nom du compte>\n";
print " unblock <nom du compte>\n";
} else {
print "<examples> state testname 5\n";
print " state testname 7 end of your ban\n";
print " block <account name>\n";
print " unblock <account name>\n";
}
return 151;
}
if ($userid eq "") {
if ($defaultlanguage eq "F") {
print "Entrez un nom de compte svp.\n";
print "<exemples> state nomtest 5\n";
print " state nomtest 7 fin de votre ban\n";
print " block <nom du compte>\n";
print " unblock <nom du compte>\n";
} else {
print "Please input an account name.\n";
print "<examples> state testname 5\n";
print " state testname 7 end of your ban\n";
print " block <account name>\n";
print " unblock <account name>\n";
}
return 136;
}
if (verify_accountname($userid) == 0) {
return 102;
}
if ($s != 7) {
$error_message = "-";
} else {
if (length($error_message) < 1) {
if ($defaultlanguage eq "F") {
print "Message d'erreur trop court. Entrez un message de 1-19 caractères.\n";
} else {
print "Error message is too short. Please input a message of 1-19 bytes.\n";
}
return 102;
}
if (length($error_message) > 19) {
if ($defaultlanguage eq "F") {
print "Message d'erreur trop long. Entrez un message de 1-19 caractères.\n";
} else {
print "Error message is too long. Please input a message of 1-19 bytes.\n";
}
return 102;
}
}
print $so pack("va24Va20", 0x7936, $userid, $s, $error_message);
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x7937) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 152;
}
$buf = readso(32);
my(@dat) = unpack("Va24V", $buf);
while (length($dat[1]) > 0 && substr($dat[1], length($dat[1])-1, 1) eq chr(0)) {
chop($dat[1]);
};
if ($dat[0] != -1 && $dat[0] != 4294967295) {
if ($defaultlanguage eq "F") {
print "Statut du compte [$dat[1]][id: $dat[0]] changé avec succès en [";
} else {
print "Account [$dat[1]][id: $dat[0]] state successfully changed in [";
}
print ((($defaultlanguage eq "F" ? "Compte Ok" : "Account OK"),
"Unregistered ID",
"Incorrect Password",
"This ID is expired",
"Rejected from Server",
"You have been blocked by the GM Team",
"Your Game's EXE file is not the latest version",
"You are Prohibited to log in until %s",
"Server is jammed due to over populated",
"No MSG",
"This ID has been totally erased")[$dat[2] == 100 ? 10 : $dat[2]]);
print "].\n";
} else {
if ($defaultlanguage eq "F") {
print "Echec du changement du statut du compte [$userid]. Le compte n'existe pas.\n";
} else {
print "Account [$userid] state changing failed. Account doesn't exist.\n";
}
}
}
#--------------------------------------------------------------------------
# Sub-function: Displaying of the number of online players
sub getlogincount {
# Request to the login-server
print $so pack("v", 0x7938);
$so->flush();
$buf = readso(4);
# Connection failed
if (unpack("v", $buf) != 0x7939) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
exit(3);
}
# Get length of the received packet
my($len) = unpack("x2v", $buf) - 4;
# Read information of the servers
if ($len < 1) {
if ($defaultlanguage eq "F") {
printf " Aucun serveur n'est connecté au login serveur.\n";
} else {
printf " No server is connected to the login-server.\n";
}
} else {
my(@slist) = ();
for(; $len > 0; $len -= 32) {
my($name, $count) = unpack("x6 a20 V", readso(32));
$name = substr($name, 0, index($name, "\0"));
push @slist, [ $name, $count ];
}
# Displaying of result
my($i);
if ($defaultlanguage eq "F") {
printf " Nombre de joueurs en ligne (serveur: nb):\n";
} else {
printf " Number of online players (server: number).\n";
}
foreach $i(@slist) {
printf " %-20s : %5d\n", $i->[0], $i->[1];
}
}
}
#--------------------------------------------------------------------------
# Sub-function: Modification of a memo field
sub changememo {
my($userid, $memo) = @_;
if ($userid eq "") {
if ($defaultlanguage eq "F") {
print "Entrez un nom de compte svp.\n";
print "<exemple> memo nomtest nouveau memo\n";
} else {
print "Please input an account name.\n";
print "<example> memo testname new memo\n";
}
return 136;
}
if (verify_accountname($userid) == 0) {
return 102;
}
if (length($memo) > 254) {
if ($defaultlanguage eq "F") {
print "Mémo trop long (".length($memo)." caractères).\n";
print "Entrez un mémo de 254 caractères maximum svp.\n";
} else {
print "Memo is too long (".length($memo)." characters).\n";
print "Please input a memo of 254 bytes at the maximum.\n";
}
return 102;
}
if (length($memo) == 0) {
print $so pack("va24v", 0x7942, $userid, 0);
} else {
print $so pack("va24va".length($memo), 0x7942, $userid, length($memo), $memo);
}
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x7943) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 152;
}
$buf = readso(28);
my($id2, $name) = unpack("Va24", $buf);
while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
chop($name);
};
if ($id2 == -1 || $id2 == 4294967295) {
if ($defaultlanguage eq "F") {
print "Echec du changement du mémo du compte [$userid]. Le compte n'existe pas.\n";
} else {
print "Account [$userid] memo changing failed. Account doesn't exist.\n";
}
} else {
if ($defaultlanguage eq "F") {
print "Mémo du compte [$name][id: $id2] changé avec succès.\n";
} else {
print "Account [$name][id: $id2] memo successfully changed.\n";
}
}
}
#--------------------------------------------------------------------------
# Sub-function: Request to obtain an account id
sub idaccount() {
my($userid) = @_;
if ($userid eq "") {
if ($defaultlanguage eq "F") {
print "Entrez un nom de compte svp.\n";
print "<exemple> id nomtest\n";
} else {
print "Please input an account name.\n";
print "<example> id testname\n";
}
return 136;
}
if (verify_accountname($userid) == 0) {
return 102;
}
print $so pack("va24", 0x7944, $userid);
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x7945) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 122;
}
$buf = readso(28);
my($id2, $name) = unpack("Va24", $buf);
while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
chop($name);
};
if ($id2 == -1 || $id2 == 4294967295) {
if ($defaultlanguage eq "F") {
print "Impossible de trouver l'id du compte [$userid]. Le compte n'existe pas.\n";
} else {
print "Unabled to find the account [$userid] id. Account doesn't exist.\n";
}
return 123;
} else {
if ($defaultlanguage eq "F") {
print "Le compte [$name] a pour id: $id2.\n";
} else {
print "The account [$name] have the id: $id2.\n";
}
}
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: Request to obtain an account name
sub nameaccount() {
my($id) = @_;
if ($id < 0) {
if ($defaultlanguage eq "F") {
print "Entrez un id ayant une valeur positive svp.\n";
} else {
print "Please input a positive value for the id.\n";
}
return 136;
}
print $so pack("vV", 0x7946, $id);
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x7947) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 122;
}
$buf = readso(28);
my($id2, $name) = unpack("Va24", $buf);
while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
chop($name);
};
if (length($name) == 0 || $name eq "") {
if ($defaultlanguage eq "F") {
print "Impossible de trouver le nom du compte [id: $id2]. Le compte n'existe pas.\n";
} else {
print "Unabled to find the account [id: $id2] name. Account doesn't exist.\n";
}
return 123;
} else {
if ($defaultlanguage eq "F") {
print "Le compte [id: $id2] a pour nom: $name.\n";
} else {
print "The account [id: $id2] have the name: $name.\n";
}
}
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: Set a validity limit of an account
sub timesetaccount() {
my($userid, $date, $time) = @_;
if ($userid eq "") {
if ($defaultlanguage eq "F") {
print "Entrez un nom de compte svp.\n";
print "<exemple>: timeset <nom_du_compte> aaaa/mm/jj [hh:mm:ss]\n";
print " timeset <nom_du_compte> 0 (0 = illimité)\n";
printf " Heure par défaut [hh:mm:ss]: 23:59:59\n";
} else {
print "Please input an account name.\n";
print "<example>: timeset <account_name> yyyy/mm/dd [hh:mm:ss]\n";
print " timeset <account_name> 0 (0 = unlimited)\n";
printf " Default time [hh:mm:ss]: 23:59:59\n";
}
return 136;
}
if (verify_accountname($userid) == 0) {
return 102;
}
my($year, $month, $day) = split(/[.\-\/]/, $date);
my($hour, $minute, $second) = split(/:/, $time);
if ($time eq "") {
$hour = 23;
$minute = 59;
$second = 59;
}
my($timestamp);
if ($year eq "" ||
($year != 0 && ($month eq "" || $day eq "" || $hour eq "" || $minute eq "" || $second eq ""))) {
if ($defaultlanguage eq "F") {
print "Entrez 0 ou une date et une heure svp (format: 0 ou aaaa/mm/jj hh:mm:ss).\n";
} else {
print "Please input 0 or a date and a time (format: 0 or yyyy/mm/dd hh:mm:ss).\n";
}
return 102;
}
if ($year == 0) {
$timestamp = 0;
} else {
if ($year < 70) {
$year = $year + 100;
}
if ($year >= 1900) {
$year = $year - 1900;
}
if ($month < 1 || $month > 12) {
if ($defaultlanguage eq "F") {
print "Entrez un mois correct svp (entre 1 et 12).\n";
} else {
print "Please give a correct value for the month (from 1 to 12).\n";
}
return 102;
}
$month = $month - 1;
if ($day < 1 || $day > 31) {
if ($defaultlanguage eq "F") {
print "Entrez un jour correct svp (entre 1 et 31).\n";
} else {
print "Please give a correct value for the day (from 1 to 31).\n";
}
return 102;
}
if ((($month == 3 || $month == 5 || $month == 8 || $month == 10) && $day > 30) ||
($month == 1 && $day > 29)) {
if ($defaultlanguage eq "F") {
print "Entrez un jour correct en fonction du mois svp.\n";
} else {
print "Please give a correct value for a day of this month.\n";
}
return 102;
}
if ($hour < 0 || $hour > 23) {
if ($defaultlanguage eq "F") {
print "Entrez une heure correcte svp (entre 0 et 23).\n";
} else {
print "Please give a correct value for the hour (from 0 to 23).\n";
}
return 102;
}
if ($minute < 0 || $minute > 59) {
if ($defaultlanguage eq "F") {
print "Entrez des minutes correctes svp (entre 0 et 59).\n";
} else {
print "Please give a correct value for the minutes (from 0 to 59).\n";
}
return 102;
}
if ($second < 0 || $second > 59) {
if ($defaultlanguage eq "F") {
print "Entrez des secondes correctes svp (entre 0 et 59).\n";
} else {
print "Please give a correct value for the seconds (from 0 to 59).\n";
}
return 102;
}
$timestamp = POSIX::mktime($second, $minute, $hour, $day, $month, $year, 0, 0, -1); # -1: no winter/summer time modification
if ($timestamp == undef) {
if ($defaultlanguage eq "F") {
print "Date incorrecte.\n";
print "Ajoutez 0 ou une date et une heure svp (format: 0 ou aaaa/mm/jj hh:mm:ss).\n";
} else {
print "Invalid date.\n";
print "Please add 0 or a date and a time (format: 0 or yyyy/mm/dd hh:mm:ss).\n";
}
return 102;
}
}
print $so pack("va24V", 0x7948, $userid, $timestamp);
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x7949) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 152;
}
$buf = readso(32);
my(@dat) = unpack("Va24V", $buf);
while (length($dat[1]) > 0 && substr($dat[1], length($dat[1])-1, 1) eq chr(0)) {
chop($dat[1]);
};
if ($dat[0] != -1 && $dat[0] != 4294967295) {
if ($defaultlanguage eq "F") {
print "Limite de validité du compte [$dat[1]][id: $dat[0]] changée avec succès ".
($dat[2] == 0 ? "en [illimité].\n" : "pour être jusqu'au ".(POSIX::ctime($dat[2])));
} else {
print "Validity Limit of the account [$dat[1]][id: $dat[0]] successfully changed ".
($dat[2] == 0 ? "to [unlimited].\n" : "to be until ".(POSIX::ctime($dat[2])));
}
# localtime($dat[2]) is also possible to display instead of POSIX::ctime.
} else {
if ($defaultlanguage eq "F") {
print "Echec du changement de la validité du compte [$userid]. Le compte n'existe pas.\n";
} else {
print "Account [$userid] validity limit changing failed. Account doesn't exist.\n";
}
}
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: Add/substract time to the validity limit of an account
sub timeaddaccount() {
my($userid, $modif) = @_;
if ($userid eq "") {
if ($defaultlanguage eq "F") {
print "Entrez un nom de compte svp.\n";
print " <exemple> timeadd nomtest +1m-2mn1s-6y\n";
print " Cette exemple ajoute 1 mois et 1 seconde, et soustrait 2 minutes\n";
print " et 6 ans dans le même temps.\n";
} else {
print "Please input an account name.\n";
print " <example> timeadd testname +1m-2mn1s-6y\n";
print " this example adds 1 month and 1 second, and substracts 2 minutes\n";
print " and 6 years at the same time.\n";
}
return 136;
}
if (verify_accountname($userid) == 0) {
return 102;
}
my($year, $month, $day) = (0, 0 ,0);
my($hour, $minute, $second) = (0, 0 ,0);
$modif = lc($modif);
while (length($modif) > 0) {
my($value) = int($modif);
if ($value == 0) {
$modif = substr($modif, 1);
} else {
if (substr($modif, 0, 1) =~ /[\-\+]/) {
$modif = substr($modif, 1);
}
while (length($modif) > 0 && substr($modif, 0, 1) =~ /[0-9]/) {
$modif = substr($modif, 1);
}
if (index($modif, "s") == 0) {
$second = $value;
$modif = substr($modif, 1);
} elsif (index($modif, "mn") == 0) {
$minute = $value;
$modif = substr($modif, 2);
} elsif (index($modif, "h") == 0) {
$hour = $value;
$modif = substr($modif, 1);
} elsif (index($modif, "d") == 0 || index($modif, "j") == 0) {
$day = $value;
$modif = substr($modif, 1);
} elsif (index($modif, "m") == 0) {
$month = $value;
$modif = substr($modif, 1);
} elsif (index($modif, "y") == 0 || index($modif, "a") == 0) {
$year = $value;
$modif = substr($modif, 1);
} else {
$modif = substr($modif, 1);
}
}
}
if ($defaultlanguage eq "F") {
print " année: $year\n";
print " mois: $month\n";
print " jour: $day\n";
print " heure: $hour\n";
print " minute: $minute\n";
print " seconde: $second\n";
} else {
print " year: $year\n";
print " month: $month\n";
print " day: $day\n";
print " hour: $hour\n";
print " minute: $minute\n";
print " second: $second\n";
}
if ($year == 0 && $month == 0 && $day == 0 && $hour == 0 && $minute == 0 && $second == 0) {
if ($defaultlanguage eq "F") {
print "Vous devez entrer un ajustement avec cette commande, svp:\n";
print " Valeur d'ajustement (-1, 1, +1, etc...)\n";
print " Element modifié:\n";
print " a ou y: année\n";
print " m: mois\n";
print " j ou d: jour\n";
print " h: heure\n";
print " mn: minute\n";
print " s: seconde\n";
print " <exemple> timeadd nomtest +1m-2mn1s-6y\n";
print " Cette exemple ajoute 1 mois et 1 seconde, et soustrait 2 minutes\n";
print " et 6 ans dans le même temps.\n";
} else {
print "Please give an adjustment with this command:\n";
print " Adjustment value (-1, 1, +1, etc...)\n";
print " Modified element:\n";
print " a or y: year\n";
print " m: month\n";
print " j or d: day\n";
print " h: hour\n";
print " mn: minute\n";
print " s: second\n";
print " <example> timeadd testname +1m-2mn1s-6y\n";
print " this example adds 1 month and 1 second, and substracts 2 minutes\n";
print " and 6 years at the same time.\n";
}
return 137;
}
if ($year > 127 || $year < -127) {
if ($defaultlanguage eq "F") {
print "Entrez un ajustement d'années correct (de -127 à 127), svp.\n";
} else {
print "Please give a correct adjustment for the years (from -127 to 127).\n";
}
return 137;
}
if ($month > 255 || $month < -255) {
if ($defaultlanguage eq "F") {
print "Entrez un ajustement de mois correct (de -255 à 255), svp.\n";
} else {
print "Please give a correct adjustment for the months (from -255 to 255).\n";
}
return 137;
}
if ($day > 32767 || $day < -32767) {
if ($defaultlanguage eq "F") {
print "Entrez un ajustement de jours correct (de -32767 à 32767), svp.\n";
} else {
print "Please give a correct adjustment for the days (from -32767 to 32767).\n";
}
return 137;
}
if ($hour > 32767 || $hour < -32767) {
if ($defaultlanguage eq "F") {
print "Entrez un ajustement d'heures correct (de -32767 à 32767), svp.\n";
} else {
print "Please give a correct adjustment for the hours (from -32767 to 32767).\n";
}
return 137;
}
if ($minute > 32767 || $minute < -32767) {
if ($defaultlanguage eq "F") {
print "Entrez un ajustement de minutes correct (de -32767 à 32767), svp.\n";
} else {
print "Please give a correct adjustment for the minutes (from -32767 to 32767).\n";
}
return 137;
}
if ($second > 32767 || $second < -32767) {
if ($defaultlanguage eq "F") {
print "Entrez un ajustement de secondes correct (de -32767 à 32767), svp.\n";
} else {
print "Please give a correct adjustment for the seconds (from -32767 to 32767).\n";
}
return 137;
}
print $so pack("va24vvvvvv", 0x7950, $userid, $year, $month, $day, $hour, $minute, $second);
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x7951) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 152;
}
$buf = readso(32);
my(@dat) = unpack("Va24V", $buf);
while (length($dat[1]) > 0 && substr($dat[1], length($dat[1])-1, 1) eq chr(0)) {
chop($dat[1]);
};
if ($dat[0] == -1 || $dat[0] == 4294967295) {
if ($defaultlanguage eq "F") {
print "Echec du changement de la validité du compte [$userid]. Le compte n'existe pas.\n";
} else {
print "Account [$userid] validity limit changing failed. Account doesn't exist.\n";
}
} elsif ($dat[2] == 0) {
if ($defaultlanguage eq "F") {
print "Limite de validité du compte [$dat[1]][id: $dat[0]] inchangée.\n";
print "Le compte a une validité illimitée ou\n";
print "la modification est impossible avec les ajustements demandés.\n";
} else {
print "Validity limit of the account [$dat[1]][id: $dat[0]] unchanged.\n";
print "The account have an unlimited validity limit or\n";
print "the changing is impossible with the proposed adjustments.\n";
}
} else {
if ($defaultlanguage eq "F") {
print "Limite de validité du compte [$dat[1]][id: $dat[0]] changée avec succès ".
($dat[2] == 0 ? "en [illimité].\n" : "pour être jusqu'au ".(POSIX::ctime($dat[2])));
} else {
print "Validity limit of the account [$dat[1]][id: $dat[0]] successfully changed ".
($dat[2] == 0 ? "to [unlimited].\n" : "to be until ".(POSIX::ctime($dat[2])));
}
# localtime($dat[2]) is also possible to display instead of POSIX::ctime.
}
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: Set the final date of a banishment of an account
sub bansetaccount() {
my($userid, $date, $time) = @_;
if ($userid eq "") {
if ($defaultlanguage eq "F") {
print "Entrez un nom de compte svp.\n";
print "<exemple>: banset <nom_du_compte> aaaa/mm/jj [hh:mm:ss]\n";
print " banset <nom_du_compte> 0 (0 = dé-bani)\n";
print " ban/banish aaaa/mm/jj hh:mm:ss <nom du compte>\n";
print " unban/unbanish <nom du compte>\n";
printf " Heure par défaut [hh:mm:ss]: 23:59:59\n";
} else {
print "Please input an account name.\n";
print "<example>: banset <account_name> yyyy/mm/dd [hh:mm:ss]\n";
print " banset <account_name> 0 (0 = un-banished)\n";
print " ban/banish yyyy/mm/dd hh:mm:ss <account name>\n";
print " unban/unbanish <account name>\n";
printf " Default time [hh:mm:ss]: 23:59:59\n";
}
return 136;
}
if (verify_accountname($userid) == 0) {
return 102;
}
my($year, $month, $day) = split(/[.\-\/]/, $date);
my($hour, $minute, $second) = split(/:/, $time);
if ($time eq "") {
$hour = 23;
$minute = 59;
$second = 59;
}
my($timestamp);
if ($year eq "" ||
($year != 0 && ($month eq "" || $day eq "" || $hour eq "" || $minute eq "" || $second eq ""))) {
if ($defaultlanguage eq "F") {
print "Entrez 0 ou une date et une heure svp (format: 0 ou aaaa/mm/jj hh:mm:ss).\n";
} else {
print "Please input 0 or a date and a time (format: 0 or yyyy/mm/dd hh:mm:ss).\n";
}
return 102;
}
if ($year == 0) {
$timestamp = 0;
} else {
if ($year < 70) {
$year = $year + 100;
}
if ($year >= 1900) {
$year = $year - 1900;
}
if ($month < 1 || $month > 12) {
if ($defaultlanguage eq "F") {
print "Entrez un mois correct svp (entre 1 et 12).\n";
} else {
print "Please give a correct value for the month (from 1 to 12).\n";
}
return 102;
}
$month = $month - 1;
if ($day < 1 || $day > 31) {
if ($defaultlanguage eq "F") {
print "Entrez un jour correct svp (entre 1 et 31).\n";
} else {
print "Please give a correct value for the day (from 1 to 31).\n";
}
return 102;
}
if ((($month == 3 || $month == 5 || $month == 8 || $month == 10) && $day > 30) ||
($month == 1 && $day > 29)) {
if ($defaultlanguage eq "F") {
print "Entrez un jour correct en fonction du mois svp.\n";
} else {
print "Please give a correct value for a day of this month.\n";
}
return 102;
}
if ($hour < 0 || $hour > 23) {
if ($defaultlanguage eq "F") {
print "Entrez une heure correcte svp (entre 0 et 23).\n";
} else {
print "Please give a correct value for the hour (from 0 to 23).\n";
}
return 102;
}
if ($minute < 0 || $minute > 59) {
if ($defaultlanguage eq "F") {
print "Entrez des minutes correctes svp (entre 0 et 59).\n";
} else {
print "Please give a correct value for the minutes (from 0 to 59).\n";
}
return 102;
}
if ($second < 0 || $second > 59) {
if ($defaultlanguage eq "F") {
print "Entrez des secondes correctes svp (entre 0 et 59).\n";
} else {
print "Please give a correct value for the seconds (from 0 to 59).\n";
}
return 102;
}
$timestamp = POSIX::mktime($second, $minute, $hour, $day, $month, $year, 0, 0, -1); # -1: no winter/summer time modification
if ($timestamp == undef) {
if ($defaultlanguage eq "F") {
print "Date incorrecte.\n";
print "Ajoutez 0 ou une date et une heure svp (format: 0 ou aaaa/mm/jj hh:mm:ss).\n";
} else {
print "Invalid date.\n";
print "Please add 0 or a date and a time (format: 0 or yyyy/mm/dd hh:mm:ss).\n";
}
return 102;
}
}
print $so pack("va24V", 0x794a, $userid, $timestamp);
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x794b) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 152;
}
$buf = readso(32);
my(@dat) = unpack("Va24V", $buf);
while (length($dat[1]) > 0 && substr($dat[1], length($dat[1])-1, 1) eq chr(0)) {
chop($dat[1]);
};
if ($dat[0] != -1 && $dat[0] != 4294967295) {
if ($defaultlanguage eq "F") {
print "Date finale de banissement du compte [$dat[1]][id: $dat[0]] changée avec succès ".
($dat[2] == 0 ? "en [dé-bannie].\n" : "pour être jusqu'au ".(POSIX::ctime($dat[2])));
} else {
print "Final date of banishment of the account [$dat[1]][id: $dat[0]] successfully changed ".
($dat[2] == 0 ? "to [unbanished].\n" : "to be until ".(POSIX::ctime($dat[2])));
}
# localtime($dat[2]) is also possible to display instead of POSIX::ctime.
} else {
if ($defaultlanguage eq "F") {
print "Echec du changement de la date finale de banissement du compte [$userid]. Le compte n'existe pas.\n";
} else {
print "Account [$userid] final date of banishment changing failed. Account doesn't exist.\n";
}
}
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: Add/substract time to the final date of a banishment of an account
sub banaddaccount() {
my($userid, $modif) = @_;
if ($userid eq "") {
if ($defaultlanguage eq "F") {
print "Entrez un nom de compte svp.\n";
print " <exemple> banadd nomtest +1m-2mn1s-6y\n";
print " Cette exemple ajoute 1 mois et 1 seconde, et soustrait 2 minutes\n";
print " et 6 ans dans le même temps.\n";
} else {
print "Please input an account name.\n";
print " <example> banadd testname +1m-2mn1s-6y\n";
print " this example adds 1 month and 1 second, and substracts 2 minutes\n";
print " and 6 years at the same time.\n";
}
return 136;
}
if (verify_accountname($userid) == 0) {
return 102;
}
my($year, $month, $day) = (0, 0 ,0);
my($hour, $minute, $second) = (0, 0 ,0);
$modif = lc($modif);
while (length($modif) > 0) {
my($value) = int($modif);
if ($value == 0) {
$modif = substr($modif, 1);
} else {
if (substr($modif, 0, 1) =~ /[\-\+]/) {
$modif = substr($modif, 1);
}
while (length($modif) > 0 && substr($modif, 0, 1) =~ /[0-9]/) {
$modif = substr($modif, 1);
}
if (index($modif, "s") == 0) {
$second = $value;
$modif = substr($modif, 1);
} elsif (index($modif, "mn") == 0) {
$minute = $value;
$modif = substr($modif, 2);
} elsif (index($modif, "h") == 0) {
$hour = $value;
$modif = substr($modif, 1);
} elsif (index($modif, "d") == 0 || index($modif, "j") == 0) {
$day = $value;
$modif = substr($modif, 1);
} elsif (index($modif, "m") == 0) {
$month = $value;
$modif = substr($modif, 1);
} elsif (index($modif, "y") == 0 || index($modif, "a") == 0) {
$year = $value;
$modif = substr($modif, 1);
} else {
$modif = substr($modif, 1);
}
}
}
if ($defaultlanguage eq "F") {
print " année: $year\n";
print " mois: $month\n";
print " jour: $day\n";
print " heure: $hour\n";
print " minute: $minute\n";
print " seconde: $second\n";
} else {
print " year: $year\n";
print " month: $month\n";
print " day: $day\n";
print " hour: $hour\n";
print " minute: $minute\n";
print " second: $second\n";
}
if ($year == 0 && $month == 0 && $day == 0 && $hour == 0 && $minute == 0 && $second == 0) {
if ($defaultlanguage eq "F") {
print "Vous devez entrer un ajustement avec cette commande, svp:\n";
print " Valeur d'ajustement (-1, 1, +1, etc...)\n";
print " Element modifié:\n";
print " a ou y: année\n";
print " m: mois\n";
print " j ou d: jour\n";
print " h: heure\n";
print " mn: minute\n";
print " s: seconde\n";
print " <exemple> banadd nomtest +1m-2mn1s-6y\n";
print " Cette exemple ajoute 1 mois et 1 seconde, et soustrait 2 minutes\n";
print " et 6 ans dans le même temps.\n";
} else {
print "Please give an adjustment with this command:\n";
print " Adjustment value (-1, 1, +1, etc...)\n";
print " Modified element:\n";
print " a or y: year\n";
print " m: month\n";
print " j or d: day\n";
print " h: hour\n";
print " mn: minute\n";
print " s: second\n";
print " <example> banadd testname +1m-2mn1s-6y\n";
print " this example adds 1 month and 1 second, and substracts 2 minutes\n";
print " and 6 years at the same time.\n";
}
return 137;
}
if ($year > 127 || $year < -127) {
if ($defaultlanguage eq "F") {
print "Entrez un ajustement d'années correct (de -127 à 127), svp.\n";
} else {
print "Please give a correct adjustment for the years (from -127 to 127).\n";
}
return 137;
}
if ($month > 255 || $month < -255) {
if ($defaultlanguage eq "F") {
print "Entrez un ajustement de mois correct (de -255 à 255), svp.\n";
} else {
print "Please give a correct adjustment for the months (from -255 to 255).\n";
}
return 137;
}
if ($day > 32767 || $day < -32767) {
if ($defaultlanguage eq "F") {
print "Entrez un ajustement de jours correct (de -32767 à 32767), svp.\n";
} else {
print "Please give a correct adjustment for the days (from -32767 to 32767).\n";
}
return 137;
}
if ($hour > 32767 || $hour < -32767) {
if ($defaultlanguage eq "F") {
print "Entrez un ajustement d'heures correct (de -32767 à 32767), svp.\n";
} else {
print "Please give a correct adjustment for the hours (from -32767 to 32767).\n";
}
return 137;
}
if ($minute > 32767 || $minute < -32767) {
if ($defaultlanguage eq "F") {
print "Entrez un ajustement de minutes correct (de -32767 à 32767), svp.\n";
} else {
print "Please give a correct adjustment for the minutes (from -32767 to 32767).\n";
}
return 137;
}
if ($second > 32767 || $second < -32767) {
if ($defaultlanguage eq "F") {
print "Entrez un ajustement de secondes correct (de -32767 à 32767), svp.\n";
} else {
print "Please give a correct adjustment for the seconds (from -32767 to 32767).\n";
}
return 137;
}
print $so pack("va24vvvvvv", 0x794c, $userid, $year, $month, $day, $hour, $minute, $second);
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x794d) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 152;
}
$buf = readso(32);
my(@dat) = unpack("Va24V", $buf);
while (length($dat[1]) > 0 && substr($dat[1], length($dat[1])-1, 1) eq chr(0)) {
chop($dat[1]);
};
if ($dat[0] == -1 || $dat[0] == 4294967295) {
if ($defaultlanguage eq "F") {
print "Echec du changement de la date finale de banissement du compte [$userid]. Le compte n'existe pas.\n";
} else {
print "Account [$userid] final date of banishment changing failed. Account doesn't exist.\n";
}
} else {
if ($defaultlanguage eq "F") {
print "Date finale de banissement du compte [$dat[1]][id: $dat[0]] changée avec succès ".
($dat[2] == 0 ? "en [dé-bannie].\n" : "pour être jusqu'au ".(POSIX::ctime($dat[2])));
} else {
print "Final date of banishment of the account [$dat[1]][id: $dat[0]] successfully changed ".
($dat[2] == 0 ? "to [unbanished].\n" : "to be until ".(POSIX::ctime($dat[2])));
}
# localtime($dat[2]) is also possible to display instead of POSIX::ctime.
}
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: Request to displaying information about an account (by its name)
sub whoaccount() {
my($userid) = @_;
if ($userid eq "") {
if ($defaultlanguage eq "F") {
print "Entrez un nom de compte svp.\n";
print "<exemple> who nomtest\n";
} else {
print "Please input an account name.\n";
print "<example> who testname\n";
}
return 136;
}
if (verify_accountname($userid) == 0) {
return 102;
}
print $so pack("va24", 0x7952, $userid);
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x7953) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 122;
}
my($id2, $GM_level, $name, $sex, $count, $status, $error_message, $last_login, $last_ip, $email, $validite, $ban_date, $memo_size) = unpack("VCa24cVVa20a24a16a40VVv", readso(148));
my($memo) = "";
if ($memo_size > 0) {
$memo = unpack("a".$memo_size, readso($memo_size));
}
while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
chop($name);
};
while (length($error_message) > 0 && substr($error_message, length($error_message)-1, 1) eq chr(0)) {
chop($error_message);
};
while (length($last_login) > 0 && substr($last_login, length($last_login)-1, 1) eq chr(0)) {
chop($last_login);
};
while (length($last_ip) > 0 && substr($last_ip, length($last_ip)-1, 1) eq chr(0)) {
chop($last_ip);
};
while (length($email) > 0 && substr($email, length($email)-1, 1) eq chr(0)) {
chop($email);
};
while (length($memo) > 0 && substr($memo, length($memo)-1, 1) eq chr(0)) {
chop($memo);
};
if ($id2 == -1 || $id2 == 4294967295) {
if ($defaultlanguage eq "F") {
print "Impossible de trouver le compte [$userid]. Le compte n'existe pas.\n";
} else {
print "Unabled to find the account [$userid]. Account doesn't exist.\n";
}
return 123;
} else {
if ($defaultlanguage eq "F") {
print "Le compte [$userid] a les caractéristiques suivantes:\n";
} else {
print "The account [$userid] is set with:\n";
}
if ($GM_level == 0) {
print " Id: $id2 (non-GM)\n";
} else {
if ($defaultlanguage eq "F") {
print " Id: $id2 (GM niveau $GM_level)\n";
} else {
print " Id: $id2 (GM level $GM_level)\n";
}
}
if ($defaultlanguage eq "F") {
print " Nom: '$name'\n";
print " Sexe: ".("Femme", "Male", "Serveur")[$sex]."\n";
} else {
print " Name: '$name'\n";
print " Sex: ".("Female", "Male", "Server")[$sex]."\n";
}
print " E-mail: $email\n";
if ($status == 7) {
print " Statut: 7 [You are Prohibited to log in until $error_message]\n";
} else {
print " Statut: $status [".(
($defaultlanguage eq "F" ? "Compte Ok" : "Account OK"),
"Unregistered ID",
"Incorrect Password",
"This ID is expired",
"Rejected from Server",
"You have been blocked by the GM Team",
"Your Game's EXE file is not the latest version",
"You are Prohibited to log in until %s",
"Server is jammed due to over populated",
"No MSG",
"This ID is totally erased")[$status == 100 ? 10 : $status]."]\n";
}
if ($defaultlanguage eq "F") {
print " Banissement: ".($ban_date == 0 ? "non banni.\n" : "jusqu'au ".(POSIX::ctime($ban_date)));
print " Compteur: $count connexion".("s", "")[$count > 1 ? 0 : 1]."\n";
print " Dernière connexion le: $last_login (ip: $last_ip)\n";
print " Limite de validité: ".($validite == 0 ? "illimité.\n" : "jusqu'au ".(POSIX::ctime($validite)));
} else {
print " Banishment: ".($ban_date == 0 ? "not banished.\n" : "until ".(POSIX::ctime($ban_date)));
print " Count: $count connection".("s", "")[$count > 1 ? 0 : 1]."\n";
print " Last connection at: $last_login (ip: $last_ip)\n";
print " Validity limit: ".($validite == 0 ? "unlimited.\n" : "until ".(POSIX::ctime($validite)));
}
print " Memo: '$memo'\n";
}
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: Request to displaying information about an account (by its id)
sub infoaccount() {
my($id) = @_;
if ($id < 0) {
if ($defaultlanguage eq "F") {
print "Entrez un id ayant une valeur positive svp.\n";
} else {
print "Please input a positive value for the id.\n";
}
return 136;
}
print $so pack("vV", 0x7954, $id);
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x7953) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 122;
}
my($id2, $GM_level, $name, $sex, $count, $status, $error_message, $last_login, $last_ip, $email, $validite, $ban_date, $memo_size) = unpack("VCa24cVVa20a24a16a40VVv", readso(148));
my($memo) = "";
if ($memo_size > 0) {
$memo = unpack("a".$memo_size, readso($memo_size));
}
while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
chop($name);
};
while (length($error_message) > 0 && substr($error_message, length($error_message)-1, 1) eq chr(0)) {
chop($error_message);
};
while (length($last_login) > 0 && substr($last_login, length($last_login)-1, 1) eq chr(0)) {
chop($last_login);
};
while (length($last_ip) > 0 && substr($last_ip, length($last_ip)-1, 1) eq chr(0)) {
chop($last_ip);
};
while (length($email) > 0 && substr($email, length($email)-1, 1) eq chr(0)) {
chop($email);
};
while (length($memo) > 0 && substr($memo, length($memo)-1, 1) eq chr(0)) {
chop($memo);
};
if (length($name) == 0 || $name eq "") {
if ($defaultlanguage eq "F") {
print "Impossible de trouver le nom du compte [id: $id2]. Le compte n'existe pas.\n";
} else {
print "Unabled to find the account [id: $id2] name. Account doesn't exist.\n";
}
return 123;
} else {
if ($defaultlanguage eq "F") {
print "Le compte [id: $id2] a les caractéristiques suivantes:\n";
} else {
print "The account [id: $id2] is set with:\n";
}
if ($GM_level == 0) {
print " Id: $id2 (non-GM)\n";
} else {
if ($defaultlanguage eq "F") {
print " Id: $id2 (GM niveau $GM_level)\n";
} else {
print " Id: $id2 (GM level $GM_level)\n";
}
}
if ($defaultlanguage eq "F") {
print " Nom: '$name'\n";
print " Sexe: ".("Femme", "Male", "Serveur")[$sex]."\n";
} else {
print " Name: '$name'\n";
print " Sex: ".("Female", "Male", "Server")[$sex]."\n";
}
print " E-mail: $email\n";
if ($status == 7) {
print " Statut: 7 [You are Prohibited to log in until $error_message]\n";
} else {
print " Statut: $status [".(
($defaultlanguage eq "F" ? "Compte Ok" : "Account OK"),
"Unregistered ID",
"Incorrect Password",
"This ID is expired",
"Rejected from Server",
"You have been blocked by the GM Team",
"Your Game's EXE file is not the latest version",
"You are Prohibited to log in until %s",
"Server is jammed due to over populated",
"No MSG",
"This ID is totally erased")[$status == 100 ? 10 : $status]."]\n";
}
if ($defaultlanguage eq "F") {
print " Banissement: ".($ban_date == 0 ? "non banni.\n" : "jusqu'au ".(POSIX::ctime($ban_date)));
print " Compteur: $count connexion".("s", "")[$count > 1 ? 0 : 1]."\n";
print " Dernière connexion le: $last_login (ip: $last_ip)\n";
print " Limite de validité: ".($validite == 0 ? "illimité.\n" : "jusqu'au ".(POSIX::ctime($validite)));
} else {
print " Banishment: ".($ban_date == 0 ? "not banished.\n" : "until ".(POSIX::ctime($ban_date)));
print " Count: $count connection".("s", "")[$count > 1 ? 0 : 1]."\n";
print " Last connection at: $last_login (ip: $last_ip)\n";
print " Validity limit: ".($validite == 0 ? "unlimited.\n" : "until ".(POSIX::ctime($validite)));
}
print " Memo: '$memo'\n";
}
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: Check the validity of a password
# (Note: never send back a password with login-server!! security of passwords)
sub checkaccount() {
my($userid, $passwd) = @_;
if ($userid eq "") {
if ($defaultlanguage eq "F") {
print "Entrez un nom de compte svp.\n";
print "<exemple> check testname motdepasse\n";
} else {
print "Please input an account name.\n";
print "<example> check testname password\n";
}
return 136;
}
if (verify_accountname($userid) == 0) {
return 102;
}
if ($passwd eq "") {
return 134 if (($passwd = typepasswd()) eq "");
}
if (verify_password($passwd) == 0) {
return 131;
}
print $so pack("va24a24", 0x793a, $userid,$passwd);
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x793b) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 132;
}
$buf = readso(28);
my($id2, $name) = unpack("Va24", $buf);
while (length($name) > 0 && substr($name, length($name)-1, 1) eq chr(0)) {
chop($name);
};
if ($id2 == -1 || $id2 == 4294967295) {
if ($defaultlanguage eq "F") {
print "Le compte [$userid] n'existe pas ou le mot de passe est incorrect.\n";
} else {
print "The account [$userid] doesn't exist or the password is incorrect.\n";
}
return 133;
} else {
if ($defaultlanguage eq "F") {
print "Le mot de passe donné correspond bien au compte [$name][id: $id2].\n";
} else {
print "The proposed password is correct for the account [$name][id: $id2].\n";
}
}
return 130;
}
#--------------------------------------------------------------------------
# Sub-function: Request to login-server to reload GM configuration file
sub reloadGM() {
print $so pack("v", 0x7955);
$so->flush();
if ($defaultlanguage eq "F") {
print "Demande de recharger le fichier de configuration des GM envoyée.\n";
print "Vérifiez les comptes GM actuels (après rechargement):\n";
} else {
print "Request to reload the GM configuration file sended.\n";
print "Check the actual GM accounts (after reloading):\n";
}
&listaccount(0, 0, 1); # 1: to list only GM
return 180;
}
#--------------------------------------------------------------------------
# Sub-function: Send a broadcast message
sub sendbroadcast() {
my($type, $message) = @_;
if ($message eq "" || length($message) == 0) {
if ($defaultlanguage eq "F") {
print "Entrez un message svp.\n";
if ($type == 0) {
print "<exemple> kami un message\n";
} else {
print "<exemple> kamib un message\n";
}
} else {
print "Please input a message.\n";
if ($type == 0) {
print "<example> kami a message\n";
} else {
print "<example> kamib a message\n";
}
}
return 136;
}
print $so pack("vvVa".length($message), 0x794e, $type, length($message), $message);
$so->flush();
$buf = readso(2);
if (unpack("v", $buf) != 0x794f) {
if ($defaultlanguage eq "F") {
print "Problème de connexion au serveur (réponse incorrecte).\n";
} else {
print "Connection error to the server (incorrect answer).\n";
}
return 152;
}
$buf = readso(2);
my($answer) = unpack("v", $buf);
if ($answer == -1 || $answer == 65535) {
if ($defaultlanguage eq "F") {
print "Echec de l'envoi du message. Aucun server de char en ligne.\n";
} else {
print "Message sending failed. No online char-server.\n";
}
} else {
if ($defaultlanguage eq "F") {
print "Message transmis au server de logins avec succès.\n";
} else {
print "Message successfully sended to login-server.\n";
}
}
}
#--------------------------------------------------------------------------
# Sub-function: Change language of displaying
sub changelanguage() {
my($language) = @_;
if ($language eq "" || length($language) == 0) {
if ($defaultlanguage == 'F') {
printf("Entrez une langue svp.\n");
printf("<exemple> language english\n");
printf(" language français\n");
} else {
printf("Please input a language.\n");
printf("<example> language english\n");
printf(" language français\n");
}
return 136;
}
$language = uc(substr($language, 0, 1));
if ($language =~ /^[EF]$/) {
$defaultlanguage = $language;
if ($defaultlanguage == 'F') {
printf("Changement de la langue d'affichage en Français.\n");
} else {
printf("Displaying language changed to English.\n");
}
} else {
if ($defaultlanguage == 'F') {
printf("Langue non paramétrée (langues possibles: 'Français' ou 'English').\n");
} else {
printf("Undefined language (possible languages: Français or English).\n");
}
}
return 0;
}
#--------------------------------------------------------------------------
# Sub-function: sending 'end of connection' packet
sub quit() {
print $so pack("v", 0x7532);
$so->flush();
}
#--------------------------------------------------------------------------
# Sub-function: Get datas from the socket
sub readso() {
my($len) = shift;
my($buf);
if (read($so, $buf, $len) < $len) {
if ($defaultlanguage eq "F") {
print "Erreur de lecture sur la Socket.\n";
} else {
print "Socket read error.\n";
}
exit(3);
}
return $buf;
}
#--------------------------------------------------------------------------
# Sub-function: Input of a password
sub typepasswd {
my($passwd1, $passwd2);
cbreak();
if ($defaultlanguage eq "F") {
print "Entrez le mot de passe > "; $passwd1 = <STDIN>; chomp($passwd1); print "\n";
print "Ré-entrez le mot de passe > "; $passwd2 = <STDIN>; chomp($passwd2); print "\n";
} else {
print "Type the password > "; $passwd1 = <STDIN>; chomp($passwd1); print "\n";
print "Verify the password > "; $passwd2 = <STDIN>; chomp($passwd2); print "\n";
}
cooked();
if ($passwd1 ne $passwd2) {
if ($defaultlanguage eq "F") {
print "Erreur de vérification du mot de passe: Saisissez le même mot de passe svp.\n";
} else {
print "Password verification failed. Please input same password.\n";
}
return "";
}
return $passwd1;
}
#--------------------------------------------------------------------------
# Sub-function: Return ordonal text of a number
sub makeordinal {
my($c) = shift;
if ($defaultlanguage eq "F") {
if ($c < 1) {
return $c;
}
return $c.("er", "ème")[$c == 1 ? 0 : 1];
} else {
if ($c % 10 < 4 && $c % 10 != 0 && ($c < 10 || $c > 20)) {
return $c.("st","nd","rd")[$c % 10 - 1];
}
return $c."th";
}
}
#--------------------------------------------------------------------------
# Sub-function: Test of the validity of an account name (return 0 if incorrect, and 1 if ok)
sub verify_accountname {
my($account_name) = @_; # Get the account_name
if ($account_name =~ /[\x00-\x1f]/) { # remove control char
my($c) = length($`) + 1;
if ($defaultlanguage eq "F") {
print "Caractère interdit trouvé dans le nom du compte (".makeordinal($c)." caractère).\n";
} else {
print "Illegal character found in the account name (".makeordinal($c)." character).\n";
}
return 0;
}
if (length($account_name) < 4) {
if ($defaultlanguage eq "F") {
print "Nom du compte trop court. Entrez un nom de compte de 4-23 caractères.\n";
} else {
print "Account name is too short. Please input an account name of 4-23 bytes.\n";
}
return 0;
}
if (length($account_name) > 23) {
if ($defaultlanguage eq "F") {
print "Nom du compte trop long. Entrez un nom de compte de 4-23 caractères.\n";
} else {
print "Account name is too long. Please input an account name of 4-23 bytes.\n";
}
return 0;
}
return 1;
}
#--------------------------------------------------------------------------
# Sub-function: Test of the validity of password (return 0 if incorrect, and 1 if ok)
sub verify_password {
my($password) = @_; # Get the password
if ($password =~ /[\x00-\x1f]/) {
my($c) = length($`) + 1;
if ($defaultlanguage eq "F") {
print "Caractère interdit trouvé dans le mot de passe (".makeordinal($c)." caractère).\n";
} else {
print "Illegal character found in the password (".makeordinal($c)." character).\n";
}
return 0;
}
if (length($password) < 4) {
if ($defaultlanguage eq "F") {
print "Mot de passe trop court. Entrez un mot de passe de 4-23 caractères.\n";
} else {
print "Password is too short. Please input a password of 4-23 bytes.\n";
}
return 0;
}
if (length($password) > 23) {
if ($defaultlanguage eq "F") {
print "Mot de passe trop long. Entrez un mot de passe de 4-23 caractères.\n";
} else {
print "Password is too long. Please input a password of 4-23 bytes.\n";
}
return 0;
}
return 1;
}
#--------------------------------------------------------------------------
# Sub-function: Test of the validity of an e-mail (return 0 if incorrect, and 1 if ok)
sub verify_email {
my($email) = @_; # Get the e-mail
# To ignore a '.' before the @ (wanadoo, a provider, do that)
$email =~ s/\.\@/\@/;
# If the e-mail is void, it's not correct -> return 0
if ($email eq '') {
return(0);
}
# If the e-mail have no "@", it's not correct -> return 0
if ($email !~ /\@/) {
return(0);
}
# If the e-mail have a ",", a space, a tab or a ";", it's not correct -> return 0
if ($email =~ /[\,|\s|\;]/) {
return(0)
};
# IF
# (the e-mail contains 2 "@", or ".." or "@." or starts or finishes by a ".")
# OR IF
# (the e-mail doesn't contain "@localhost" AND
# - it doesn't contain characters followed by "@" itself followed by letters itself followed by "." and 2 or more letters
# - or an IP address)
# -> so, it's not good ! (finish !)
if ($email =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)|(\.$)/ ||
($email !~ /^.+\@localhost$/ &&
$email !~ /^.+\@\[?(\w|[-.])+\.[a-zA-Z]{2,3}|[0-9]{1,3}\]?$/)) {
return(0); # non-valid email
} else {
# If not, the e-email address is correct
return(1); # valid email
}
}