darkplaces-rcon-util (empty) → 0.1
raw patch · 13 files changed
+1685/−0 lines, 13 filesdep +ConfigFiledep +HostAndPortdep +basesetup-changed
Dependencies added: ConfigFile, HostAndPort, base, bytestring, containers, darkplaces-rcon, darkplaces-rcon-util, darkplaces-text, directory, filepath, haskeline, hspec, hspec-core, mtl, old-locale, optparse-applicative, text, time, utf8-string
Files
- LICENSE +339/−0
- Main.hs +226/−0
- Setup.hs +2/−0
- darkplaces-rcon-util.cabal +100/−0
- src/DRcon/CommandArgs.hs +156/−0
- src/DRcon/ConfigFile.hs +182/−0
- src/DRcon/EvalParser.hs +273/−0
- src/DRcon/Paths.hs +37/−0
- src/DRcon/Polyfills.hs +24/−0
- src/DRcon/Prompt.hs +183/−0
- src/DRcon/Version.hs +44/−0
- tests/DRcon/EvalParserSpec.hs +118/−0
- tests/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,339 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Lesser General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License along+ with this program; if not, write to the Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Lesser General+Public License instead of this License.
+ Main.hs view
@@ -0,0 +1,226 @@+module Main where+import DRcon.CommandArgs+import DRcon.ConfigFile+import DRcon.Paths+import DRcon.EvalParser+import DRcon.Prompt+import DRcon.Version (versionInfo)+import DarkPlaces.Rcon hiding (connect, send, getPassword)+import qualified DarkPlaces.Rcon as RCON+import DarkPlaces.Text+import Options.Applicative+import qualified Data.ByteString.Lazy as BL+import System.Timeout+import qualified Data.ByteString.UTF8 as BU+import Control.Monad.Error+import System.Console.Haskeline+import System.Console.Haskeline.History (historyLines)+import Control.Monad.State.Strict+import Data.Maybe+import qualified Data.Text as T+import Data.Text.Encoding as TE+import Text.Printf+import Data.Char (toUpper)+++data ReplState = ReplState {+ replLastCmd :: Maybe InputType,+ replColor :: Bool,+ replTimeout :: Float,+ replEncoding :: DecodeType,+ replPromp :: (String, Prompt),+ replConnection :: RconConnection,+ replName :: String+}+++type Repl m = InputT (StateT ReplState m)+++updateLastCmd :: (Monad m) => InputType -> Repl m ()+updateLastCmd cmd = lift $ modify (\s -> s {replLastCmd=Just cmd})+++newPrompt :: String -> (String, Prompt)+newPrompt str = (str, parsePrompt str)+++toMicroseconds :: Float -> Int+toMicroseconds v = round $ v * 1e6+++printRecv :: RconConnection -> (Float, Bool, DecodeType) -> BinStreamState -> IO ()+printRecv con parm@(time, color, enc) st = do+ mdata <- timeout (toMicroseconds time) $ RCON.recvRcon con+ let st_args = PrintStreamArgs {+ withColor=color,+ streamState=st,+ decodeFun=toUTF enc}++ case mdata of+ (Just r) -> printStreamDPText st_args (BL.fromStrict r) >>= printRecv con parm+ Nothing -> streamEnd color st+++rconExec :: DRconArgs -> String -> Bool -> IO ()+rconExec dargs command color = do+ con <- RCON.connect (connectInfo dargs)+ RCON.send con (BU.fromString command)+ printRecv con (time, color, enc) defaultStreamState+ RCON.close con+ where+ time = drconTimeout dargs+ enc = drconEncoding dargs+++getInputLineWithPrompt :: Repl IO (Maybe String)+getInputLineWithPrompt = do+ state <- lift get+ let prompt = snd $ replPromp state+ con = replConnection state+ name = replName state++ prompt_vars <- liftIO $ getPromptVars name con+ getInputLine $ renderPrompt prompt_vars prompt+++replLoop :: Repl IO ()+replLoop = handle (\Interrupt -> replLoop) $ withInterrupt $ do+ minput <- getInputLineWithPrompt+ case minput of+ Nothing -> lift (replConnection <$> get) >>= liftIO . RCON.close+ Just input -> case parseCommand input of+ Left e -> do+ outputStrLn $ show e+ replLoop+ Right a -> replAction a+++replAction :: InputType -> Repl IO ()+replAction cmd = case cmd of+ Empty -> replLoop+ Quit -> do+ con <- lift $ replConnection <$> get+ liftIO $ RCON.close con+ RepeatLast -> do+ last <- lift $ replLastCmd <$> get+ case last of+ Nothing -> outputStrLn noLastCmd >> replLoop+ Just last_cmd -> replAction last_cmd+ Help -> do+ outputStrLn $ T.unpack helpMessage+ updateLastCmd cmd+ replLoop+ ListVars -> do+ outputStrLn $ T.unpack helpVars+ updateLastCmd cmd+ replLoop+ Show var -> do+ con <- lift $ replConnection <$> get+ val <- showVar <$> case var of+ Mode -> liftIO $ SetMode <$> getMode con+ TimeDiff -> liftIO $ SetTimeDiff <$> getTimeDiff con+ Timeout -> lift $ SetTimeout . replTimeout <$> get+ Encoding -> lift $ SetEncoding . replEncoding <$> get+ Color -> lift $ SetColor . replColor <$> get+ PromptVar -> lift $ SetPrompt . fst . replPromp <$> get++ outputStrLn $ printf "%s: %s" (toTitle $ show var) val+ updateLastCmd cmd+ replLoop+ Set var_set -> do+ con <- lift $ replConnection <$> get+ case var_set of+ SetMode mode -> liftIO $ setMode con mode+ SetTimeDiff diff -> liftIO $ setTimeDiff con diff+ SetTimeout t -> lift $ modify (\s -> s {replTimeout=t})+ SetEncoding enc -> lift $ modify (\s -> s {replEncoding=enc})+ SetColor c -> lift $ modify (\s -> s {replColor=c})+ SetPrompt p -> lift $ modify (\s -> s {replPromp=newPrompt p})++ updateLastCmd cmd+ replLoop+ Version -> do+ outputStrLn versionInfo+ updateLastCmd cmd+ replLoop+ Login -> do+ pwd <- getPassword Nothing "Password: "+ con <- lift $ replConnection <$> get+ case pwd of+ (Just pass) -> liftIO $ RCON.setPassword con (BU.fromString pass)+ Nothing -> return ()+ replLoop+ History v -> do+ -- 10 is default value for history+ let num = fromMaybe 10 v+ history <- getHistory+ let h_lines = take num $ historyLines history+ forM_ h_lines $ outputStrLn . (replicate 2 ' ' ++)+ updateLastCmd cmd+ replLoop+ RconCommand command -> do+ rconEval $ TE.encodeUtf8 command+ updateLastCmd cmd+ replLoop+ where+ toTitle s = (\(f, e) -> map toUpper f ++ e) $ splitAt 1 s+ rconEval command = do+ repl_state <- lift get+ let time = replTimeout repl_state+ color = replColor repl_state+ enc = replEncoding repl_state+ con = replConnection repl_state++ liftIO $ RCON.send con command+ liftIO $ printRecv con (time, color, enc) defaultStreamState++ noLastCmd = "there is no last command to perform\n" +++ "use :? for help."+++rconRepl :: DRconArgs -> Bool -> IO ()+rconRepl dargs color = do+ con <- RCON.connect (connectInfo dargs)+ hist_path <- historyPath+ let base_settings = defaultSettings {historyFile=Just hist_path,+ autoAddHistory=True}+ let repl_state = ReplState {replLastCmd=Nothing,+ replColor=color,+ replTimeout=drconTimeout dargs,+ replEncoding=drconEncoding dargs,+ replPromp=newPrompt $ drconPrompt dargs,+ replConnection=con,+ replName=connectName dargs}++ let hline_settings = setComplete comp base_settings+ evalStateT (runInputT hline_settings replLoop) repl_state+ where+ compliter prev cmd = return $+ (simpleCompletion . T.unpack) <$> internalAutoComplete (T.pack prev) (T.pack cmd)+ comp = completeWordWithPrev Nothing " \t" compliter+++processArgs :: Maybe CommandArgs -> UtilError ()+processArgs Nothing = liftIO $ putStrLn versionInfo+processArgs (Just args) = do+ drcon_args <- rconConfigure (cliServerName args) (cliBaseArgs args)+ color <- liftIO $ case cliColor args of+ (Just c) -> return c+ Nothing -> supportColors++ case cliCommand args of+ (Just command) -> liftIO $ rconExec drcon_args command color+ Nothing -> liftIO $ rconRepl drcon_args color+++main :: IO ()+main = handleErrors . processArgs =<< execParser opts+ where+ opts = info (helper <*> maybeArgsParser)+ (fullDesc <> progDesc "Darkplaces rcon client utility")+ handleErrors me = do+ r <- runErrorT me+ case r of+ (Right ()) -> return ()+ (Left e) -> putStrLn e
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ darkplaces-rcon-util.cabal view
@@ -0,0 +1,100 @@+name: darkplaces-rcon-util+version: 0.1+synopsis: Darplaces rcon utility+homepage: https://github.com/bacher09/darkplaces-rcon+bug-reports: https://github.com/bacher09/darkplaces-rcon/issues+copyright: (c) Slava Bacherikov 2015+license: GPL-2+license-file: LICENSE+author: Slava Bacherikov+maintainer: slava@bacher09.org+category: Game+build-type: Simple+cabal-version: >=1.10+description:++ This is implementation of rcon shell for darkplaces engine.+ For more info visit https://github.com/bacher09/darkplaces-rcon/blob/master/darkplaces-rcon-util/README.md++flag LinuxStatic+ default: False+ description: Build static binary for linux++library+ exposed-modules: DRcon.CommandArgs,+ DRcon.ConfigFile,+ DRcon.Paths,+ DRcon.EvalParser,+ DRcon.Prompt,+ DRcon.Version++ other-modules: DRcon.Polyfills,+ Paths_darkplaces_rcon_util++ build-depends: base >=4.5 && <5,+ mtl >=2.0,+ bytestring >=0.10 && <0.11,+ time >=1.4 && <1.6,+ old-locale,+ optparse-applicative >= 0.10 && < 0.12,+ containers >= 0.5,+ utf8-string >=0.3,+ ConfigFile >=1.1,+ filepath,+ directory,+ HostAndPort,+ darkplaces-text >= 0.2,+ darkplaces-rcon,+ text >=1.0,+ haskeline >= 0.7++ ghc-options: -O2 -funbox-strict-fields -Wall -fno-warn-name-shadowing+ hs-source-dirs: src+ default-language: Haskell2010+ default-extensions: CPP+ cpp-options: -DCABAL_VERSION+++executable drcon+ main-is: Main.hs+ build-depends: base >=4.5 && <5,+ mtl >=2.0,+ bytestring >=0.10 && <0.11,+ optparse-applicative >= 0.10 && < 0.12,+ utf8-string >=0.3,+ darkplaces-text >= 0.2,+ darkplaces-rcon,+ darkplaces-rcon-util,+ text >=1.0,+ haskeline >= 0.7++ ghc-options: -O2 -funbox-strict-fields -Wall -fno-warn-name-shadowing+ default-language: Haskell2010++ if flag(LinuxStatic)+ ghc-options: -optl-static -optl-pthread+++test-suite rcon-util-tests+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Spec.hs++ other-modules: DRcon.EvalParserSpec++ build-depends: base >=4.7 && <4.8,+ bytestring >=0.10 && <0.11,+ darkplaces-rcon-util,+ darkplaces-rcon,+ darkplaces-text >= 0.2,+ text >=1.0,+ hspec-core,+ hspec++ ghc-options: -O2 -funbox-strict-fields -Wall -fno-warn-name-shadowing+++source-repository head+ type: git+ location: https://github.com/bacher09/darkplaces-rcon.git
+ src/DRcon/CommandArgs.hs view
@@ -0,0 +1,156 @@+module DRcon.CommandArgs (+ ProtocolOptions(..),+ BaseArgs(..),+ CommandArgs(..),+ parseRconMode,+ checkTimeout,+ parseEncoding,+ showEncoding,+ parseColorMode,+ argsParser,+ maybeArgsParser+) where+import Options.Applicative+import DarkPlaces.Text (DecodeType(..))+import DarkPlaces.Rcon hiding (connect, send)+import DRcon.Polyfills (readMaybe)+import Data.Tuple (swap)+import Data.Maybe (fromMaybe)+++data BaseArgs = BaseArgs {+ confServerString :: String,+ confPassword :: Maybe String,+ confMode :: Maybe RconMode,+ confTimeDiff :: Maybe Int,+ confTimeout :: Maybe Float,+ confEncoding :: Maybe DecodeType,+ confProtoOptions :: Maybe ProtocolOptions+} deriving(Show, Read, Eq)+++data CommandArgs = CommandArgs {+ cliServerName :: String,+ cliBaseArgs :: BaseArgs,+ cliColor :: Maybe Bool,+ cliCommand :: Maybe String+} deriving(Show, Read, Eq)+++eitherArgs :: Either String a -> ReadM a+eitherArgs (Right v) = return v+eitherArgs (Left msg) = readerError msg+++parseRconMode :: String -> Either String RconMode+parseRconMode ms = case readMaybe ms of+ Just x | x >= 0 && x < 3 -> Right $ toEnum x+ _ -> Left "value should be 0, 1 or 2"+++checkTimeout :: Float -> Either String Float+checkTimeout t+ | t > 0 = Right t+ | otherwise = Left "value should be bigger then 0"+++encodings :: [(String, DecodeType)]+encodings = [+ ("utf8", Utf8Lenient),+ ("utf8-lenient", Utf8Lenient),+ ("utf8-ignore", Utf8Ignore),+ ("utf8-strict", Utf8Strict),+ ("nexuiz", NexuizDecode)]+++parseEncoding :: String -> Either String DecodeType+parseEncoding encname = case lookup encname encodings of+ Just v -> Right v+ Nothing -> Left "Error bad decode type. Major values are ut8 and nexuiz"+++showEncoding :: DecodeType -> String+showEncoding enc = fromMaybe first $ lookup enc encLst+ where+ encLst = map swap encodings+ first = fst $ head encodings+++parseColorMode :: String -> ReadM (Maybe Bool)+parseColorMode mode_str+ | mode_str == "always" = return $ Just True+ | mode_str == "auto" = return Nothing+ | mode_str == "never" = return $ Just False+ | otherwise = readerError "value should be always, auto or never"+++protoOptionsParser :: Parser (Maybe ProtocolOptions)+protoOptionsParser =+ flag' (Just OnlyIPv4) (short '4' <> help "Forces to use IPv4 addresses only")+ <|> flag' (Just OnlyIPv6) (short '6' <> help "Forces to use IPv6 addresses only")+ <|> (pure Nothing)+++commandParser :: Parser String+commandParser = unwords <$> (some $ argument str (+ metavar "COMMAND"+ <> help "Command that will be sent to server"))+++argsParser :: Parser CommandArgs+argsParser = argsConstructor+ <$> protoOptionsParser+ <*> optional (strOption (+ short 'p'+ <> long "password"+ <> help "Server's password"+ <> metavar "PASSWORD"))+ <*> optional (option (str >>= eitherArgs . parseRconMode) (+ short 'm'+ <> long "mode"+ <> help "Use secure rcon, same as `rcon_secure' cvar, 1 is default"+ <> metavar "MODE"))+ <*> optional (option auto (+ short 'd'+ <> long "time-diff"+ <> help "Integer difference between client and server time, can be negative"+ <> metavar "TIMEDIFF"))+ <*> optional (option (auto >>= eitherArgs . checkTimeout) (+ short 't'+ <> long "timeout"+ <> help "How many time wait for response after send or previous response"+ <> metavar "TIMEOUT"))+ <*> optional (option (str >>= eitherArgs . parseEncoding) (+ short 'e'+ <> long "encoding"+ <> help "Server encoding. Major options is `utf8' and `nexuiz'"+ <> metavar "ENCODING"))+ <*> option (str >>= parseColorMode) (+ long "color"+ <> value Nothing+ <> help "Possible values are: `auto', `always' and `never'"+ <> metavar "COLOR_MODE")+ <*> argument str (+ help "Server to connect or config section"+ <> metavar "SERVER")+ <*> optional commandParser+ where+ argsConstructor protoOpt password mode tdiff tout enc color server cmd =+ let baseArgs = BaseArgs {confServerString=server,+ confPassword=password,+ confMode=mode,+ confTimeDiff=tdiff,+ confTimeout=tout,+ confEncoding=enc,+ confProtoOptions=protoOpt}+ in CommandArgs {cliServerName=server,+ cliBaseArgs=baseArgs,+ cliColor=color,+ cliCommand=cmd}+++maybeArgsParser :: Parser (Maybe CommandArgs)+maybeArgsParser = flag' Nothing (+ long "version"+ <> short 'V'+ <> hidden) <|> (Just <$> argsParser)
+ src/DRcon/ConfigFile.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE FlexibleContexts #-}+module DRcon.ConfigFile (+ DRconArgs(..),+ UtilError,+ rconConfigure+) where+import DRcon.CommandArgs+import DRcon.Paths+import DRcon.Prompt (defaultPrompt, promptEnvName, readPrompt)+import DRcon.Polyfills (lookupEnv)+import DarkPlaces.Text (DecodeType(..))+import Data.ConfigFile+import System.IO.Error (isDoesNotExistError)+import Control.Exception (tryJust)+import qualified Data.ByteString.UTF8 as BU+import Network.HostAndPort (defaultHostAndPort)+import DarkPlaces.Rcon hiding (connect, send, getPassword)+import System.Console.Haskeline+import Control.Monad.Error+import Control.Applicative+import Data.Maybe+import System.Exit+++data DRconArgs = DRconArgs {+ connectInfo :: RconInfo,+ connectName :: String,+ drconTimeout :: Float,+ drconEncoding :: DecodeType,+ drconPrompt :: String+} deriving (Show, Read, Eq)+++type UtilError = ErrorT String IO+++getMaybe :: (Get_C a, MonadError CPError m) => ConfigParser -> SectionSpec -> OptionSpec -> m (Maybe a)+getMaybe c sec opt = (Just `liftM` get c sec opt) `catchError` const (return Nothing)+++readConfig :: String -> UtilError (Maybe ConfigParser)+readConfig cpath = do+ r <- liftIO $ tryJust (guard . isDoesNotExistError) doRead++ case either (const Nothing) Just r of+ (Just (Right v)) -> return $ Just v+ (Just (Left _)) -> throwError "Error while parsing config file"+ Nothing -> return Nothing++ where+ doRead = liftIO $ readfile emptyCP cpath+++parseAddrFamily :: String -> Either String ProtocolOptions+parseAddrFamily val = case val of+ "any" -> Right BothProtocols+ "inet" -> Right OnlyIPv4+ "inet6" -> Right OnlyIPv6+ _ -> Left "Bad addrfamily, supported options: any, inet, inet6"+++getPrompt :: Maybe ConfigParser -> UtilError String+getPrompt mconf = do+ conf_prompt <- case mconf of+ Just c -> case getMaybe c "DEFAULT" "prompt" of+ Right v -> return v+ Left _ -> throwError "Error while parsing file"+ Nothing -> return Nothing++ env_prompt <- liftIO $ lookupEnv promptEnvName+ let prompt = fromMaybe defaultPrompt (conf_prompt <|> env_prompt)++ case readPrompt prompt of+ (Right v) -> return v+ (Left s) -> throwError s+++argsFromConfig :: (MonadError CPError m) => ConfigParser -> String -> m BaseArgs+argsFromConfig c name = do+ server <- if c `has_section` name+ then fromMaybe name `liftM` getMaybe c name "server"+ else return name++ password <- getMaybe c name "password"+ raw_mode <- getMaybe c name "mode"+ mode <- case parseRconMode <$> raw_mode of+ (Just (Right v)) -> return $ Just v+ (Just (Left e)) -> throwError (ParseError $ "Bad value for mode:" ++ e, "getmode")+ Nothing -> return Nothing++ diff <- getMaybe c name "diff"+ raw_timeout <- getMaybe c name "timeout"+ timeout <- case checkTimeout <$> raw_timeout of+ (Just (Right t)) -> return $ Just t+ (Just (Left e)) -> throwError (ParseError $ "Bad timeout:" ++ e, "gettimeout")+ Nothing -> return Nothing++ raw_enc <- getMaybe c name "encoding"+ enc <- case parseEncoding <$> raw_enc of+ (Just (Right t)) -> return $ Just t+ (Just (Left e)) -> throwError (ParseError $ "Bad encoding:" ++ e, "getencoding")+ Nothing -> return Nothing++ raw_protoopts <- getMaybe c name "addrfamily"+ proto_opts <- case parseAddrFamily <$> raw_protoopts of+ (Just (Right t)) -> return $ Just t+ (Just (Left e)) -> throwError (ParseError $ "Bad addrfamily:" ++ e, "getaddrfamily")+ Nothing -> return Nothing++ return $ BaseArgs {+ confServerString=server,+ confPassword=password,+ confMode=mode,+ confTimeDiff=diff,+ confTimeout=timeout,+ confEncoding=enc,+ confProtoOptions=proto_opts}+++getPasswordOrExit :: IO String+getPasswordOrExit = do+ mpassw <- runInputT defaultSettings tryGetPassword+ case mpassw of+ (Just p) -> return p+ Nothing -> exitSuccess+ where+ tryGetPassword = handle (\Interrupt -> liftIO exitSuccess) $ withInterrupt $+ getPassword Nothing "Password: "+++getDRconArgs :: String -> BaseArgs -> String -> UtilError DRconArgs+getDRconArgs name args prompt = do+ (host, port) <- case defaultHostAndPort "26000" server of+ Nothing -> throwError "Error while parsing server string"+ (Just v) -> return v++ password <- case confPassword args of+ Nothing -> liftIO $ getPasswordOrExit+ (Just v) -> return v++ let base_rcon = makeRcon host port (BU.fromString password)+ let rcon = base_rcon {rconMode=mode,+ rconTimeDiff=time_diff,+ rconProtoOpt=proto_opt}+ return $ DRconArgs {connectInfo=rcon,+ drconTimeout=time_out,+ drconEncoding=enc,+ connectName=name,+ drconPrompt=prompt}+ where+ server = confServerString args+ mode = fromMaybe TimeSecureRcon $ confMode args+ time_diff = fromMaybe 0 $ confTimeDiff args+ time_out = fromMaybe 1.5 $ confTimeout args+ enc = fromMaybe Utf8Lenient $ confEncoding args+ proto_opt = fromMaybe BothProtocols $ confProtoOptions args+++mergeArgs :: BaseArgs -> BaseArgs -> BaseArgs+mergeArgs f s = BaseArgs {+ confServerString = confServerString s,+ confPassword = merge confPassword,+ confMode = merge confMode,+ confTimeDiff = merge confTimeDiff,+ confTimeout = merge confTimeout,+ confEncoding = merge confEncoding,+ confProtoOptions = merge confProtoOptions}+ where+ merge fun = fun f <|> fun s+++rconConfigure :: String -> BaseArgs -> UtilError DRconArgs+rconConfigure name args = do+ config_file <- liftIO configPath+ mconf <- readConfig config_file+ new_args <- case argsFromConfig <$> mconf <*> pure name of+ Nothing -> return args+ (Just (Right c)) -> return $ mergeArgs args c+ (Just (Left _)) -> throwError "Error while parsing config"++ prompt <- getPrompt mconf+ getDRconArgs name new_args prompt
+ src/DRcon/EvalParser.hs view
@@ -0,0 +1,273 @@+{-# LANGUAGE OverloadedStrings #-}+module DRcon.EvalParser (+ CommandErrorType(..),+ EvalVar(..),+ VarValue(..),+ InputType(..),+ EvalCmd,+ parseCommand,+ internalAutoComplete,+ helpMessage,+ helpVars,+ showVar+) where++import Prelude hiding (break, concat)+import Data.Char (isSpace)+import Data.Maybe+import Data.Text hiding (filter, map)+import qualified Data.Text as T+import Data.Text.Read+import Control.Monad.Error+import Control.Applicative ((<$>))+import DRcon.CommandArgs (parseRconMode, parseEncoding, showEncoding)+import DRcon.Prompt (readPrompt)+import DarkPlaces.Rcon (RconMode)+import DarkPlaces.Text (DecodeType(..))+import Data.Monoid+import Text.Printf+++data CommandErrorType = UnknownCommand Text+ | WrongArgumentType Text Text+ | CommandTakesNoArgumens Text Text+ | OtherError Text+ deriving(Eq)+++data EvalVar = Mode+ | TimeDiff+ | Timeout+ | Encoding+ | Color+ | PromptVar+ deriving(Eq, Ord, Bounded, Enum)+++data VarValue = SetMode RconMode+ | SetTimeDiff Int+ | SetTimeout Float+ | SetEncoding DecodeType+ | SetColor Bool+ | SetPrompt String+ deriving(Eq)+++data InputType = Empty+ | Quit+ | Help+ | Version+ | RepeatLast+ | Login+ | ListVars+ | Show EvalVar+ | Set VarValue+ | History (Maybe Int)+ | RconCommand Text+ deriving(Show, Eq)+++type EvalCmd = Either CommandErrorType InputType+++instance Show CommandErrorType where+ show (UnknownCommand cmd) = printf badCmd $ unpack cmd+ where+ badCmd = "unknown command '%s'\nuse :? for help."++ show (WrongArgumentType cmd _) = case cmd of+ ":history" -> "Wrong argument\nSyntax: :history [n]"+ _ -> printf "Wrong argument for command \"%s\"" $ unpack cmd++ show (CommandTakesNoArgumens cmd _) = printf noArgs $ unpack cmd+ where+ noArgs = "Error: command \"%s\" takes no arguments"++ show (OtherError msg) = unpack msg+++instance Show EvalVar where+ show Mode = "mode"+ show TimeDiff = "timediff"+ show Timeout = "timeout"+ show Encoding = "encoding"+ show Color = "color"+ show PromptVar = "prompt"+++instance Show VarValue where+ show v = show (getVarName v) ++ " " ++ showVar v+++cmdInfo :: [(Text, Text)]+cmdInfo = [+ ("<rcon command>", "execute command via rcon"),+ (":", "repeat last command"),+ (":help, :?", "display list of commands"),+ (":history [n]", "show n (10 by default) last commands"),+ (":login", "promp for server password"),+ (":set", "list available options"),+ (":set <option>", "display option value"),+ (":set <option> <args>", "change option value"),+ (":quit", "quit from drcon"),+ (":version", "print program version")]+++-- list of commands in priority order+topLevelCommands :: [Text]+topLevelCommands = [":help", ":quit", ":set", ":login",+ ":history", ":version", ":", ":?"]+++helpMessage :: Text+helpMessage = " Available commands:\n\n" <> cmdList+ where+ cmdList = T.concat $ map (uncurry formatCmd) cmdInfo+ formatCmd name info = T.concat [+ T.replicate 3 " ",+ justifyLeft 28 ' ' name,+ info, "\n"]+++helpVars :: Text+helpVars = " Available vars:\n\n" <> varsList+ where+ varsList = intercalate "\n" $ map (T.replicate 3 " " `append`) varsText+ vars :: [EvalVar]+ vars = enumFromTo minBound maxBound+ varsText = map (pack . show) vars+++parseEvalVar :: Text -> Maybe EvalVar+parseEvalVar var = case var of+ "mode" -> Just Mode+ "timediff" -> Just TimeDiff+ "timeout" -> Just Timeout+ "encoding" -> Just Encoding+ "color" -> Just Color+ "prompt" -> Just PromptVar+ _ -> Nothing+++showBool :: Bool -> String+showBool True = "yes"+showBool False = "no"+++showVar :: VarValue -> String+showVar (SetMode m) = show $ fromEnum m+showVar (SetTimeDiff d) = show d+showVar (SetTimeout tm) = show tm+showVar (SetEncoding enc) = showEncoding enc+showVar (SetColor c) = showBool c+showVar (SetPrompt p) = show p+++getVarName :: VarValue -> EvalVar+getVarName (SetMode _) = Mode+getVarName (SetTimeDiff _) = TimeDiff+getVarName (SetTimeout _) = Timeout+getVarName (SetEncoding _) = Encoding+getVarName (SetColor _) = Color+getVarName (SetPrompt _) = PromptVar+++parseBool :: Text -> Either String Bool+parseBool val = case toLower val of+ "y" -> return True+ "n" -> return False+ "yes" -> return True+ "no" -> return False+ "true" -> return True+ "false" -> return False+ "1" -> return True+ "0" -> return False+ "on" -> return True+ "off" -> return False+ _ -> throwError "Value should be: yes or no"+++parseSetVar :: EvalVar -> Text -> Either String VarValue+parseSetVar Mode val = SetMode <$> parseRconMode (unpack val)+parseSetVar TimeDiff val = case signed decimal val of+ Right (num, "") -> return $ SetTimeDiff num+ _ -> throwError "Value shoud be decimal"++parseSetVar Timeout val = case rational val of+ Right (num, "") -> return $ SetTimeout num+ _ -> throwError "Value should be float"+parseSetVar Encoding val = SetEncoding <$> parseEncoding (unpack val)+parseSetVar Color val = SetColor <$> parseBool val+parseSetVar PromptVar val = SetPrompt <$> readPrompt (unpack val)+++disambiguate :: Text -> Maybe Text+disambiguate cmd+ | T.length cmd > 1 = listToMaybe search_cmds+ | otherwise = Nothing+ where+ search_cmds = filter (isPrefixOf cmd) topLevelCommands+++firstMap :: (a -> a) -> [a] -> [a]+firstMap _ [] = []+firstMap fun (x:xs) = fun x : xs+++internalAutoComplete :: Text -> Text -> [Text]+internalAutoComplete prev cmd = case prev_cmds of+ [] -> searchComp topLevelCommands+ [":set"] -> searchComp setVars+ [":set", "color"] -> searchComp bools+ [":set", "encoding"] -> searchComp encodings+ _ -> []+ where+ sprev = T.reverse $ strip prev+ prev_cmds = firstMap firstCmd $ T.words sprev+ firstCmd cmd = fromMaybe cmd $ disambiguate cmd+ vars :: [EvalVar]+ vars = enumFromTo minBound maxBound+ setVars = map (pack . show) vars+ searchComp = filter (isPrefixOf cmd)+ bools = map (pack . showBool) [True, False]+ encodings = map (pack . showEncoding) $ enumFromTo minBound maxBound+++parseCommand :: String -> EvalCmd+parseCommand command+ | tcommand == empty = return Empty+ | isPrefixOf ":" tcommand = parseInternalCommand dcmd (strip args)+ | otherwise = return $ RconCommand tcommand+ where+ tcommand = strip $ pack command+ (cmd, args) = break isSpace tcommand+ dcmd = fromMaybe cmd $ disambiguate cmd+++parseInternalCommand :: Text -> Text -> EvalCmd+parseInternalCommand ":quit" _ = return Quit+parseInternalCommand ":help" "" = return Help+parseInternalCommand ":?" "" = return Help+parseInternalCommand ":" "" = return RepeatLast+parseInternalCommand ":login" "" = return Login+parseInternalCommand ":version" "" = return Version+parseInternalCommand ":history" "" = return $ History Nothing+parseInternalCommand ":history" v = case decimal v of+ (Right (num, "")) -> return $ History (Just num)+ _ -> throwError $ WrongArgumentType ":history" v++parseInternalCommand ":set" "" = return ListVars+parseInternalCommand ":set" v = case margs of+ Just (var, "") -> return $ Show var+ Just (var, arg) -> either toErr return (Set <$> parseSetVar var arg)+ Nothing -> throwError $ WrongArgumentType ":set" v+ where+ (var_str, var_arg) = break isSpace v+ margs = (\v -> (v, strip var_arg)) <$> parseEvalVar var_str+ toErr = throwError . OtherError . pack++parseInternalCommand cmd args+ | cmd `elem` withoutArgs = throwError $ CommandTakesNoArgumens cmd args+ | otherwise = throwError $ UnknownCommand cmd+ where+ withoutArgs = [":", ":help", ":?", ":version", ":login"]
+ src/DRcon/Paths.hs view
@@ -0,0 +1,37 @@+module DRcon.Paths (+ configName,+ configDirPath,+ configPath,+ historyPath+) where++import System.Directory (getAppUserDataDirectory)+import System.FilePath+import DRcon.Polyfills (lookupEnv)+++configName :: String+configName = "drcon.ini"+++configDirPath :: IO String+configDirPath = do+ h_path <- lookupEnv "DRCON_HOME"+ case h_path of+ (Just path) -> return path+ Nothing -> getAppUserDataDirectory "drcon"+++configPath :: IO String+configPath = do+ path <- configDirPath+ return $ path </> configName+++historyPath :: IO String+historyPath = do+ m_path <- lookupEnv "DRCON_HISTFILE"+ config_dir <- configDirPath+ case m_path of+ (Just path) -> return path+ Nothing -> return $ config_dir </> "drcon_history"
+ src/DRcon/Polyfills.hs view
@@ -0,0 +1,24 @@+module DRcon.Polyfills (+ readMaybe,+ lookupEnv+) where+++#if MIN_VERSION_base(4,6,0)+import Text.Read (readMaybe)+import System.Environment (lookupEnv)+#else+import System.IO.Error (isDoesNotExistError)+import Control.Exception (catchJust)+import Control.Monad (guard)+import System.Environment (getEnv)++readMaybe :: Read a => String -> Maybe a+readMaybe s = case reads s of+ [(x, "")] -> Just x+ _ -> Nothing+++lookupEnv :: String -> IO (Maybe String)+lookupEnv name = catchJust (guard . isDoesNotExistError) (Just <$> getEnv name) (\e -> return Nothing)+#endif
+ src/DRcon/Prompt.hs view
@@ -0,0 +1,183 @@+module DRcon.Prompt (+ PromptVars(..),+ Prompt,+ parsePrompt,+ formatPrompt,+ renderPrompt,+ getPromptVars,+ readPrompt,+ defaultPrompt,+ promptEnvName+) where+import qualified Data.Map.Strict as SM+import Data.Tuple (swap)+import Data.Time.LocalTime+import Control.Monad.Error+import System.Locale (defaultTimeLocale)+import Data.Time.Format (formatTime)+import DarkPlaces.Rcon+import DRcon.Polyfills (readMaybe)+import DRcon.Version (versionStr, programName)+++data FormaterToken a = SimpleText a+ | ServerName+ | ServerHost+ | ServerPort+ | SystemTime+ | SystemTimeSeconds+ | SystemDate+ | ConnectMode+ | ProgramName+ | ProgramVersion+ deriving(Show, Read, Eq, Ord)+++data PromptVars = PromptVars {+ promptName :: String,+ promptHost :: String,+ promptPort :: String,+ promptTime :: String,+ promptTimeSeconds :: String,+ promptDate :: String,+ promptConnectMode :: String}+ deriving (Show, Read, Eq)+++type PromptToken = FormaterToken String+type PromptFormater = [PromptToken]+type TokenRender = (PromptToken -> String)+newtype Prompt = Prompt PromptFormater+ deriving (Eq)+++instance Show Prompt where+ show (Prompt ts) = show $ concatEscape $ map renderToken ts+++defaultPrompt :: String+defaultPrompt = "%P %N> "+++promptEnvName :: String+promptEnvName = "DRCON_PROMPT"+++formatSymbols :: [(Char, PromptToken)]+formatSymbols = [+ ('N', ServerName),+ ('h', ServerHost),+ ('p', ServerPort),+ ('T', SystemTime),+ ('*', SystemTimeSeconds),+ ('D', SystemDate),+ ('m', ConnectMode),+ ('P', ProgramName),+ ('v', ProgramVersion),+ ('%', SimpleText "%"),+ ('{', SimpleText "\ESC"), -- same as \ESC+ ('}', SimpleText "\STX")] -- same as \STX+++formatSymbolsMap :: SM.Map Char PromptToken+formatSymbolsMap = SM.fromList formatSymbols+++simpleParser :: String -> PromptFormater+simpleParser ('%':x:xs) = case maybeToken of+ Just t -> t : simpleParser xs+ Nothing -> case simpleParser (x:xs) of+ ((SimpleText str):ts) -> SimpleText ('%':str) : ts+ ts -> (SimpleText "%") : ts+ where+ maybeToken = SM.lookup x formatSymbolsMap++simpleParser (x:xs) = case simpleParser xs of+ ((SimpleText str):ts) -> SimpleText (x:str) : ts+ ts -> SimpleText (x:[]) : ts+simpleParser "" = []+++escapeChars :: String -> String+escapeChars ('%':x:xs) = case SM.lookup x formatSymbolsMap of+ Just _ -> '%':'%' : escapeChars (x:xs)+ Nothing -> '%' : escapeChars (x:xs)+escapeChars (x:xs) = x : escapeChars xs+escapeChars "" = ""+++appendEscape :: String -> String -> String+appendEscape "" s = s+appendEscape f "" = f+appendEscape f s+ | last_f == '%' = case SM.lookup head_s formatSymbolsMap of+ Just _ -> f ++ "%" ++ s+ Nothing -> f ++ s+ | otherwise = f ++ s+ where+ last_f = last f+ head_s = head s+++concatEscape :: [String] -> String+concatEscape = foldr appendEscape ""+++renderToken :: TokenRender+renderToken (SimpleText a) = escapeChars a+renderToken t = case SM.lookup t tokensMap of+ Just c -> '%':c:[]+ Nothing -> ""+ where+ tokensMap = SM.fromList $ map swap formatSymbols+++tokenRenderFrom :: PromptVars -> TokenRender+tokenRenderFrom _ (SimpleText a) = a+tokenRenderFrom v ServerName = promptName v+tokenRenderFrom v ServerHost = promptHost v+tokenRenderFrom v ServerPort = promptPort v+tokenRenderFrom v SystemTime = promptTime v+tokenRenderFrom v SystemTimeSeconds = promptTimeSeconds v+tokenRenderFrom v SystemDate = promptDate v+tokenRenderFrom v ConnectMode = promptConnectMode v+tokenRenderFrom _ ProgramName = programName+tokenRenderFrom _ ProgramVersion = versionStr+++formatPrompt :: TokenRender -> Prompt -> String+formatPrompt fun (Prompt prompt) = concatMap fun prompt+++parsePrompt :: String -> Prompt+parsePrompt = Prompt . simpleParser+++renderPrompt :: PromptVars -> Prompt -> String+renderPrompt vars prom = formatPrompt (tokenRenderFrom vars) prom+++getPromptVars :: String -> RconConnection -> IO PromptVars+getPromptVars name con = do+ date_time <- getZonedTime+ host <- getHost con+ port <- getPort con+ mode <- getMode con+ return PromptVars {promptName=name,+ promptHost=host,+ promptPort=port,+ promptTime=dateFormater date_time "%R",+ promptTimeSeconds=dateFormater date_time "%T",+ promptDate=dateFormater date_time "%F",+ promptConnectMode=show $ fromEnum mode}+ where+ dateFormater t f = formatTime defaultTimeLocale f t+++readPrompt :: String -> Either String String+readPrompt "" = return ""+readPrompt arg@('"':_) = case readMaybe arg of+ Just r -> return r+ Nothing -> throwError "Error parsing prompt"++readPrompt arg = readPrompt $ "\"" ++ arg ++ "\""
+ src/DRcon/Version.hs view
@@ -0,0 +1,44 @@+module DRcon.Version (+ versionStr,+ programName,+ versionInfo,+ licenseText+) where+import Text.Printf++#ifdef CABAL_VERSION+import Paths_darkplaces_rcon_util (version)+import Data.Version (showVersion)++versionStr = showVersion version+#else+versionStr = "dev"+#endif++versionStr :: String+++programName :: String+programName = "drcon"+++versionInfo :: String+versionInfo = printf "%s version %s\n" programName versionStr ++ licenseText+++licenseText :: String+licenseText = unlines ["Copyright (C) Slava Bacherikov",+ "",+ "This program is free software; you can redistribute it and/or",+ "modify it under the terms of the GNU General Public License",+ "as published by the Free Software Foundation; either version 2",+ "of the License, or (at your option) any later version.",+ "",+ "This program is distributed in the hope that it will be useful,",+ "but WITHOUT ANY WARRANTY; without even the implied warranty of",+ "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the",+ "GNU General Public License for more details.",+ "",+ "You should have received a copy of the GNU General Public License",+ "along with this program; if not, write to the Free Software",+ "Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA."]
+ tests/DRcon/EvalParserSpec.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE OverloadedStrings #-}+module DRcon.EvalParserSpec (+ spec+) where+import Test.Hspec+import DRcon.EvalParser+import DarkPlaces.Rcon+import DarkPlaces.Text (DecodeType(..))+import qualified Data.Text as T+import Data.Char (isSpace)+++spec :: Spec+spec = do+ describe "parseCommand" $ do+ it "check simple rcon commands" $ do+ "status" `cmdShouldBe` RconCommand "status"+ "sv_cmd lsmaps" `cmdShouldBe` RconCommand "sv_cmd lsmaps"+ "ls *.bsp" `cmdShouldBe` RconCommand "ls *.bsp"++ it "check empty input" $ do+ "" `cmdShouldBe` Empty+ -- input string with spaces+ " " `cmdShouldBe` Empty+ " " `cmdShouldBe` Empty+ "\n " `cmdShouldBe` Empty+ "\n \t" `cmdShouldBe` Empty++ it "check :quit internal command" $ do+ ":q" `cmdShouldBe` Quit+ ":qu" `cmdShouldBe` Quit+ ":qui" `cmdShouldBe` Quit+ ":quit" `cmdShouldBe` Quit+ -- quit accept any arguments+ ":q some vals" `cmdShouldBe` Quit++ it "check :help internal command" $ do+ ":?" `cmdShouldBe` Help+ ":h" `cmdShouldBe` Help+ ":he" `cmdShouldBe` Help+ ":help" `cmdShouldBe` Help+ -- help takes no argumens+ ":help haha" `cmdShouldErr` (CommandTakesNoArgumens ":help" "haha")++ it "check : internal command" $ do+ ":" `cmdShouldBe` RepeatLast+ ": " `cmdShouldBe` RepeatLast+ " : " `cmdShouldBe` RepeatLast+ "\t :" `cmdShouldBe` RepeatLast+ -- : takes no argumens+ ": help" `cmdShouldErr` (CommandTakesNoArgumens ":" "help")++ it "check :login internal command" $ do+ ":login" `cmdShouldBe` Login+ " :l" `cmdShouldBe` Login+ ":lo" `cmdShouldBe` Login+ " :log " `cmdShouldBe` Login+ ":l ogin" `cmdShouldErr` (CommandTakesNoArgumens ":login" "ogin")++ it "check :version internal command" $ do+ ":version" `cmdShouldBe` Version++ it "check :history internal command" $ do+ ":hi" `cmdShouldBe` (History Nothing)+ ":his" `cmdShouldBe` (History Nothing)+ ":history" `cmdShouldBe` (History Nothing)+ ":his 10" `cmdShouldBe` (History $ Just 10)+ ":history 12 " `cmdShouldBe` (History $ Just 12)+ ":history -2 " `cmdShouldErr` (WrongArgumentType ":history" "-2")+ ":history 2 4 " `cmdShouldErr` (WrongArgumentType ":history" "2 4")+ ":history 2.4 " `cmdShouldErr` (WrongArgumentType ":history" "2.4")+ ":history test " `cmdShouldErr` (WrongArgumentType ":history" "test")++ it "check :set internal command" $ do+ ":set" `cmdShouldBe` ListVars+ ":s" `cmdShouldBe` ListVars+ ":set mode" `cmdShouldBe` (Show Mode)+ ":set mode 2" `cmdShouldBe` (Set $ SetMode ChallangeSecureRcon)+ ":set mode 1" `cmdShouldBe` (Set $ SetMode TimeSecureRcon)+ ":set mode 0" `cmdShouldBe` (Set $ SetMode NonSecureRcon)++ ":set color no" `cmdShouldBe` (Set $ SetColor False)+ ":set color 0" `cmdShouldBe` (Set $ SetColor False)+ ":set color n" `cmdShouldBe` (Set $ SetColor False)+ ":s color false" `cmdShouldBe` (Set $ SetColor False)+ ":se color yes" `cmdShouldBe` (Set $ SetColor True)++ ":set encoding nexuiz" `cmdShouldBe` (Set $ SetEncoding NexuizDecode)++ describe "internalAutoComplete" $ do+ it "check autocomplete of base commands" $ do+ ":he" `shouldComplete` [":help"]+ ":h" `shouldComplete` [":history", ":help"]+ ":q" `shouldComplete` [":quit"]+ ":qu" `shouldComplete` [":quit"]+ ":lo" `shouldComplete` [":login"]+ ":s" `shouldComplete` [":set"]++ it "check autocomplete for :set options" $ do+ ":s mo" `shouldComplete` ["mode"]+ ":se mo" `shouldComplete` ["mode"]+ ":set mo" `shouldComplete` ["mode"]+ ":set co" `shouldComplete` ["color"]+ ":set prompt" `shouldComplete` ["prompt"]++ it "check autocomplete for :set option values" $ do+ ":s color " `shouldComplete` ["yes", "no"]+ ":s color y" `shouldComplete` ["yes"]+ ":s encoding n" `shouldComplete` ["nexuiz"]++ where+ cmdShouldBe cmd_str cmd_res = parseCommand cmd_str `shouldBe` (Right cmd_res)+ cmdShouldErr cmd_str cmd_res = parseCommand cmd_str `shouldBe` (Left cmd_res)+ shouldComplete text res = internalAutoComplete rprev cmd `shouldMatchList` res+ where+ rtext = T.reverse $ T.stripStart text+ (rcmd, rprev) = T.break isSpace rtext+ cmd = T.reverse rcmd
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}