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