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