Permalink
Browse files

initial import from hackage

  • Loading branch information...
1 parent 5d6f12e commit af433823b0dbed019d998fd215122e7721571633 Alexander Bernauer committed Jun 19, 2012
Showing with 342 additions and 0 deletions.
  1. +2 −0 .gitignore
  2. +198 −0 GDBMI.hs
  3. +26 −0 LICENSE
  4. +4 −0 Setup.lhs
  5. +89 −0 Test.hs
  6. +21 −0 hgdbmi.cabal
  7. +2 −0 setup
View
2 .gitignore
@@ -0,0 +1,2 @@
+cabal-dev
+dist
View
198 GDBMI.hs
@@ -0,0 +1,198 @@
+-- hgdbmi: a Haskell interface to GDB/MI.
+-- Copyright (C) 2008 Evan Martin <martine@danga.com>
+
+-- |GDB\/MI lets programs drive GDB. It can be used, for example, by GDB
+-- frontends. This module wraps attaching GDB to a process and parsing the
+-- (surprisingly complicated) GDB\/MI output.
+
+module GDBMI (
+ GDB,
+ attach,
+ detach,
+
+ runCommand,
+ GDBCommand(..),
+ MIOutput(..),
+ MIOOB(..),
+ MIResult(..),
+ MIKeyVal,
+ MIValue(..),
+
+ parse
+) where
+
+import System.IO
+import System.Posix.IO (createPipe, fdToHandle)
+import System.Posix.Types (ProcessID)
+import System.Process (runProcess, ProcessHandle)
+import Text.ParserCombinators.Parsec hiding (parse)
+import qualified Text.ParserCombinators.Parsec as Parsec (parse)
+
+-- |A connection to a GDB process.
+data GDB = GDB {
+ gdbPid :: ProcessHandle,
+ gdbCommand :: Handle,
+ gdbResponse :: Handle
+}
+
+-- |A GDB command. CLICommand is any command you'd normally type at the GDB
+-- prompt. MICommand are more machine-parsing friendly commands; see the
+-- GDB\/MI docs for details.
+data GDBCommand = CLICommand String
+ | MICommand String -- ^TODO: expand this to support arguments.
+
+-- |The output of running a GDB command. Output is a collection of Out-Of-Band
+-- messages (such as logging information) and an optional final result.
+data MIOutput = MIOutput [MIOOB] (Maybe MIResult) deriving Show
+
+-- |The type of OOB mesages. (TODO: many of these aren't properly parsed yet.)
+data MIOOB =
+ MIStatus String -- ^Contains on-going status information about the progress
+ -- of a slow operation.
+ | MIExec String -- ^Contains asynchronous state change on the target
+ -- (stopped, started, disappeared).
+ | MINotify String -- ^Contains supplementary information that the client
+ -- should handle (e.g., a new breakpoint information).
+ | MIConsole String -- ^Output that should be displayed as is in the console.
+ -- It is the textual response to a CLI command.
+ | MITarget String -- ^The output produced by the target program.
+ | MILog String -- ^Output text coming from GDB's internals, for instance
+ -- messages that should be displayed as part of an error
+ -- log.
+ deriving (Eq, Show)
+
+-- |The type of the GDB result. (TODO: many result types aren't implemented
+-- yet.)
+data MIResult =
+ MIDone [MIKeyVal] -- ^The synchronous operation was successful,
+ -- along with potential key-value return data.
+ | MIError String -- ^The operation failed. The string contains the
+ -- corresponding error message.
+ deriving (Eq, Show)
+
+-- |A key-value pair output from GDB.
+type MIKeyVal = (String, MIValue)
+
+-- |The type of a GDB "value", used in the output of structured data.
+data MIValue =
+ MIString String
+ | MITuple [MIKeyVal]
+ deriving (Eq, Show)
+
+-- |Attach to a process, returning an error or the 'GDB' connection and its
+-- initial output.
+attach :: Maybe FilePath -- ^Working directory for GDB. (Important if the
+ -- process has loaded libraries from relative paths.)
+ -> ProcessID
+ -> IO (Either String (GDB, MIOutput))
+attach workdir pid = do
+ (commandR, commandW) <- createPipe >>= asHandles
+ (responseR, responseW) <- createPipe >>= asHandles
+ phandle <- runProcess "gdb" ["--interpreter", "mi", "-p", show pid]
+ workdir Nothing{-env-}
+ (Just commandR) -- stdin
+ (Just responseW) -- stdout
+ Nothing -- stderr
+ mapM_ (`hSetBuffering` LineBuffering) [commandW, responseR]
+ let gdb = GDB phandle commandW responseR
+ resp <- readResponse gdb
+ case resp of
+ Left err -> return $ Left err
+ Right ok -> return $ Right (gdb, ok)
+ where
+ asHandles (f1, f2) = do
+ h1 <- fdToHandle f1; h2 <- fdToHandle f2; return (h1, h2)
+
+-- |Close a 'GDB' connection.
+detach :: GDB -> IO ()
+-- TODO: we don't examine the result code, because our parser wants each
+-- response to be terminated by the "(gdb) " prompt, which this lacks.
+detach gdb = hPutStrLn (gdbCommand gdb) "-gdb-exit"
+
+-- |Run a GDB command.
+runCommand :: GDBCommand -> GDB -> IO (Either String MIOutput)
+runCommand cmd gdb = do
+ hPutStrLn (gdbCommand gdb) (cmdStr cmd)
+ readResponse gdb
+ where
+ cmdStr (CLICommand str) = str
+ cmdStr (MICommand str) = '-' : str
+
+readResponse :: GDB -> IO (Either String MIOutput)
+readResponse gdb = do
+ resp <- readResponseLines
+ case parse "output" (unlines resp) of
+ Left err -> return $ Left (show err)
+ Right out -> return $ Right out
+ where
+ readResponseLines :: IO [String]
+ readResponseLines = do
+ line <- hGetLine (gdbResponse gdb)
+ if line == "(gdb) "
+ then return []
+ else do rest <- readResponseLines
+ return (line:rest)
+
+-- Our Parsec parsers all start with p_.
+
+-- Parse the main ouptut from GDB.
+p_output = do
+ oob <- p_oob `sepEndBy` newline
+ res <- optionMaybe p_result
+ eof
+ return $ MIOutput oob res
+-- Parse an "OOB" message from GDB.
+p_oob = p_console <|> p_log
+-- Parse a console OOB message from GDB.
+p_console = do char '~'; str <- p_cstring; return $ MIConsole str
+-- Parse a log OOB message from GDB.
+p_log = do char '&'; str <- p_cstring; return $ MILog str
+
+-- Parse a result message from GDB.
+p_result = do
+ char '^'
+ res <- p_done <|> p_error
+ newline; return res
+ where
+ -- Parse a done result message from GDB.
+ p_done = do
+ string "done"
+ res <- (do char ','; p_keyval `sepBy` char ',') <|> return []
+ return $ MIDone res
+ -- Parse a error result message from GDB.
+ p_error = do
+ string "error"
+ char ','
+ -- XXX: The GDB/MI docs say this should be just a cstring, but my GDB
+ -- doesn't agree.
+ string "msg=" -- Hack here; perhaps it's really like the "done" output?
+ err <- p_cstring
+ return $ MIError err
+
+-- Parse a key=val output ("result") from GDB.
+p_keyval = do var <- p_var; char '='; val <- p_val; return $ (var, val) where
+ p_var = many1 (letter <|> char '-') -- XXX: this is underspecified.
+ p_val = p_const <|> p_tuple
+ p_const = do str <- p_cstring; return $ MIString str
+ p_tuple = do
+ vals <- tuplewrap $ p_keyval `sepBy` char ','
+ return $ MITuple vals
+ -- It's unclear why they have []-style tuples and {}-style tuples...
+ tuplewrap p = between (char '{') (char '}') p
+ <|> between (char '[') (char ']') p
+
+-- Parse a C-style string (underspecified by the GDB manual).
+p_cstring = between (char '"') (char '"') (many p_cchar) where
+ p_cchar = p_cbackslash
+ <|> noneOf "\""
+ p_cbackslash = do
+ char '\\'
+ c <- anyChar
+ case c of
+ '\\' -> return '\\'
+ 'n' -> return '\n'
+ '"' -> return '"'
+ _ -> fail $ "unknown backslash escape: " ++ show c
+
+-- |An interface to the output parser. Just used for testing.
+parse = Parsec.parse p_output
View
26 LICENSE
@@ -0,0 +1,26 @@
+Copyright (c) 2008 Evan Martin <martine@danga.com>
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+* Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+* Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+* Neither the name of the author nor the names of contributors may be
+ used to endorse or promote products derived from this software without
+ specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
View
4 Setup.lhs
@@ -0,0 +1,4 @@
+#! /usr/bin/env runhaskell
+
+> import Distribution.Simple
+> main = defaultMain
View
89 Test.hs
@@ -0,0 +1,89 @@
+-- hgdbmi: a Haskell interface to GDB/MI.
+-- Copyright (C) 2008 Evan Martin <martine@danga.com>
+
+import GDBMI
+import Test.HUnit
+
+startupText =
+ "~\"GNU gdb 6.7.1-debian\\n\"\n" ++
+ "~\"Copyright (C) 2007 Free Software Foundation, Inc.\\n\"\n" ++
+ "~\"License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>\\n\"\n" ++
+ "~\"This is free software: you are free to change and redistribute it.\\n\"\n" ++
+ "~\"There is NO WARRANTY, to the extent permitted by law. Type \\\"show copying\\\"\\n\"\n" ++
+ "~\"and \\\"show warranty\\\" for details.\\n\"\n" ++
+ "~\"This GDB was configured as \\\"i486-linux-gnu\\\".\\n\"\n" ++
+ "~\"Attaching to process 8902\\n\"\n" ++
+ "~\"Reading symbols from /home/martine/projects/c-repl/dist/build/child...\"\n" ++
+ "~\"done.\\n\"\n" ++
+ "~\"Using host libthread_db library \\\"/lib/tls/i686/cmov/libthread_db.so.1\\\".\\n\"\n" ++
+ "~\"Reading symbols from /lib/tls/i686/cmov/libdl.so.2...\"\n" ++
+ "~\"done.\\n\"\n" ++
+ "~\"Loaded symbols for /lib/tls/i686/cmov/libdl.so.2\\n\"\n" ++
+ "~\"Reading symbols from /lib/tls/i686/cmov/libc.so.6...\"\n" ++
+ "~\"done.\\n\"\n" ++
+ "~\"Loaded symbols for /lib/tls/i686/cmov/libc.so.6\\n\"\n" ++
+ "~\"Reading symbols from /lib/ld-linux.so.2...\"\n" ++
+ "~\"done.\\n\"\n" ++
+ "~\"Loaded symbols for /lib/ld-linux.so.2\\n\"\n" ++
+ "~\"Reading symbols from /home/martine/projects/c-repl/.c-repl/dl1.so...\"\n" ++
+ "~\"done.\\n\"\n" ++
+ "~\"Loaded symbols for ./.c-repl/dl1.so\\n\"\n"
+
+testStartup = test $
+ case GDBMI.parse "startup" startupText of
+ Left err -> assertFailure $ show err
+ Right (MIOutput info result) -> do
+ assertEqual "oob line count" 23 (length info)
+ assertEqual "oob first line"
+ (MIConsole "GNU gdb 6.7.1-debian\n") (head info)
+
+printText =
+ "&\"p x\\n\"\n" ++
+ "~\"$1 = 3\"\n" ++
+ "~\"\n\"\n" ++
+ "^done,thread-id=\"0\",frame={addr=\"0xb7f0a410\",func=\"__kernel_vsyscall\",args=[]}\n"
+
+testPrint = test $
+ case GDBMI.parse "parse 'p x' output" printText of
+ Left err -> assertFailure $ show err
+ Right (MIOutput info result) -> do
+ assertEqual "oob line count" 3 (length info)
+ assertEqual "oob first line" (MILog "p x\n") (head info)
+ case result of
+ Just (MIDone tuples) -> do
+ assertEqual "done tuple #1" ("thread-id", MIString "0") (head tuples)
+ case lookup "frame" tuples of
+ Just (MITuple frame) ->
+ assertEqual "done tuple #4" ("args", MITuple []) (last frame)
+ _ -> assertFailure $ "couldn't find 'frame'"
+ _ ->
+ assertFailure $ "expected done result, got " ++ show result
+
+errorPrintText =
+ "&\"p y\\n\"\n" ++
+ "&\"No symbol \\\"y\\\" in current context.\\n\"\n" ++
+ "^error,msg=\"No symbol \\\"y\\\" in current context.\"\n"
+
+testErrorPrint = test $
+ case GDBMI.parse "parse 'p y' error output" errorPrintText of
+ Left err -> assertFailure $ show err
+ Right (MIOutput info result) -> do
+ assertEqual "oob line count" 2 (length info)
+ assertEqual "oob first line" (MILog "p y\n") (head info)
+ assertEqual "result"
+ (Just (MIError "No symbol \"y\" in current context.")) result
+
+varCreateText = "^done,name=\"vx\",numchild=\"0\",value=\"4\",type=\"int\"\n"
+
+testVarCreate = test $
+ case GDBMI.parse "parse 'var-create' output" varCreateText of
+ Left err -> assertFailure $ show err
+ Right (MIOutput info result) -> do
+ assertEqual "no oob info" 0 (length info)
+ assertEqual "result"
+ (Just (MIDone [("name", MIString "vx"), ("numchild", MIString "0"),
+ ("value", MIString "4"), ("type", MIString "int")]))
+ result
+
+main =
+ runTestTT $ TestList [testStartup, testPrint, testErrorPrint, testVarCreate]
View
21 hgdbmi.cabal
@@ -0,0 +1,21 @@
+Cabal-Version: >= 1.2
+Build-Type: Simple
+Name: hgdbmi
+Version: 0.2
+Synopsis: GDBMI interface (program-driven control of GDB)
+Description:
+ GDB\/MI lets programs drive GDB. It can be used, for example, by GDB
+ frontends. This module wraps attaching GDB to a process and parsing the
+ (surprisingly complicated) GDB\/MI output.
+Category: Development
+License: BSD3
+License-File: LICENSE
+Author: Evan Martin
+Maintainer: martine@danga.com
+Copyright: (c) 2008 Evan Martin <martine@danga.com>
+Homepage: http://neugierig.org/software/darcs/browse/?r=hgdbmi;a=summary
+Extra-Source-Files: Test.hs
+
+Library
+ Build-Depends: base, parsec, process, unix
+ Exposed-Modules: GDBMI
View
2 setup
@@ -0,0 +1,2 @@
+export PATH=/home/alex/code/ghc-7.4.1/install/bin:/home/alex/code/haskell-platform-2012.2.0.0/install/bin:/home/alex/.cabal/bin:/home/alex/local/bin:$PATH
+export GHC_PACKAGE_PATH=`pwd`/cabal-dev/packages-7.4.1.conf/:

0 comments on commit af43382

Please sign in to comment.