ladmin 146 KB

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