#!/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
}
}
