diff --git a/Hdis86.hs b/Hdis86.hs --- a/Hdis86.hs +++ b/Hdis86.hs @@ -2,8 +2,9 @@ -- -- Exports the simplest, most high-level interface. module Hdis86 - ( module Hdis86.Types - , module Hdis86.Pure + ( disassemble + , disassembleMetadata + , module Hdis86.Types ) where import Hdis86.Types diff --git a/Hdis86/C.hsc b/Hdis86/C.hsc --- a/Hdis86/C.hsc +++ b/Hdis86/C.hsc @@ -5,7 +5,7 @@ -- | Bare import of the @udis86@ C library. -- -- This module is not recommended for most users. What you see is what you get. --- The modules @'Hdis86.IO'@ and @'Hdis86.Pure'@ provide a more Haskell-friendly +-- The modules "Hdis86.IO" and "Hdis86.Pure" provide a more Haskell-friendly -- interface to the same functionality. -- -- If you want to use this module, see the @udis86@ documentation: diff --git a/Hdis86/IO.hs b/Hdis86/IO.hs --- a/Hdis86/IO.hs +++ b/Hdis86/IO.hs @@ -12,7 +12,7 @@ -- this module's API is thoroughly imperative, but uses -- Haskellish types and automatic resource management. -- --- For a higher-level, @IO@-free API, see @'Hdis86.Pure'@. +-- For a higher-level, @IO@-free API, see "Hdis86.Pure". -- -- This module is fully thread-safe: any number of threads -- may manipulate one or several @'UD'@ objects at the same @@ -36,6 +36,7 @@ , getInstruction , getLength, getOffset , getHex, getBytes, getAssembly + , getMetadata -- * Configuration , setConfig @@ -310,6 +311,17 @@ getAssembly :: UD -> IO String getAssembly = flip withUDPtr $ \p -> C.insn_asm p >>= peekCString + +-- | Get all metadata about the current instruction, +-- along with the instruction itself. +getMetadata :: UD -> IO Metadata +getMetadata ud = Metadata + <$> getOffset ud + <*> getLength ud + <*> getHex ud + <*> getBytes ud + <*> getAssembly ud + <*> getInstruction ud -- | Skip the next /n/ bytes of the input. skip :: UD -> Word -> IO () diff --git a/Hdis86/Incremental.hs b/Hdis86/Incremental.hs new file mode 100644 --- /dev/null +++ b/Hdis86/Incremental.hs @@ -0,0 +1,60 @@ +-- | Incremental pure disassembly. +module Hdis86.Incremental + ( disassembleOne + , disassembleLazy + ) where + +import Hdis86.Types +import qualified Hdis86.Pure as P +import qualified Hdis86.IO as I + +import Data.Maybe + +import System.IO.Unsafe ( unsafePerformIO ) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL + +disOne :: Config -> BS.ByteString -> Maybe Metadata +disOne cfg bs = unsafePerformIO $ do + ud <- I.newUD + I.setInputBuffer ud bs + I.setConfig ud cfg + n <- I.advance ud + case n of + Just _ -> Just `fmap` I.getMetadata ud + Nothing -> return Nothing + +-- | Split a @'BS.ByteString'@ into an instruction and the remaining +-- @'BS.ByteString'@. +-- +-- Returns @'Nothing'@ if the input is empty or contains an +-- incomplete instruction. +disassembleOne :: Config -> BS.ByteString -> Maybe (Metadata, BS.ByteString) +disassembleOne cfg bs = disOne cfg bs >>= (fmap getRem . getMD) where + -- invalid instruction: distinguish from incomplete instruction + -- by appending 0x90 = nop + getMD m@Metadata { mdInst = i0@Inst { inOpcode = Iinvalid }, + mdBytes = ibs } + = case P.disassemble cfg (ibs `BS.snoc` 0x90) of + [i1, Inst [] Inop []] | i0 == i1 -> Just m + _ -> Nothing + + getMD m = Just m + + getRem m = (m, BS.drop (fromIntegral $ mdLength m) bs) + +-- | Disassemble a lazy @'BL.ByteString'@. +-- +-- The output is produced lazily. +disassembleLazy :: Config -> BL.ByteString -> [Metadata] +disassembleLazy cfg = go (cfgOrigin cfg) BS.empty . BL.toChunks where + go n bs chunks = let newcfg = cfg { cfgOrigin = n } in + case disassembleOne newcfg bs of + Just (md, bsrem) -> md : go nn bsrem chunks where + nn = n + fromIntegral (mdLength md) + + Nothing -> case chunks of + (x:xs) -> go n (bs `BS.append` x) xs + -- end of input; produce a final incomplete instruction if any + [] -> maybeToList $ disOne newcfg bs diff --git a/Hdis86/Internal/Map.hs b/Hdis86/Internal/Map.hs --- a/Hdis86/Internal/Map.hs +++ b/Hdis86/Internal/Map.hs @@ -1,5 +1,4 @@ -{-# OPTIONS_HADDOCK - hide #-} +-- | Internal module; use at your own risk. module Hdis86.Internal.Map ( UDTM, makeUDTM, lookupUDTM , register, opcode diff --git a/Hdis86/Pure.hs b/Hdis86/Pure.hs --- a/Hdis86/Pure.hs +++ b/Hdis86/Pure.hs @@ -1,11 +1,8 @@ -{-# LANGUAGE - DeriveDataTypeable #-} - -- | Interface to the @udis86@ disassembler. -- -- This is the simplest, most high-level interface. -- --- See @'Hdis86.IO'@ if you need more control or performance. +-- See "Hdis86.IO" if you need more control or performance. module Hdis86.Pure ( -- * Simple disassembly disassemble @@ -19,12 +16,6 @@ import Hdis86.IO ( UD ) import qualified Hdis86.IO as I -import Data.Typeable ( Typeable ) -import Data.Data ( Data ) - -import Control.Applicative -import Data.Word - import System.IO.Unsafe ( unsafePerformIO ) import qualified Data.ByteString as BS @@ -40,30 +31,14 @@ -- | Disassemble machine code. -- -- Common values for @'Config'@ such as @'intel32'@ or @'amd64'@ --- are provided in @'Hdis86.Types'@. +-- are provided in "Hdis86.Types". -- -- The output is produced lazily. disassemble :: Config -> BS.ByteString -> [Instruction] disassemble = disWith I.getInstruction --- | An instruction with full metadata. -data Metadata = Metadata - { mdOffset :: Word64 -- ^ Offset of the start of this instruction - , mdLength :: Word -- ^ Length of this instruction in bytes - , mdHex :: String -- ^ Hexadecimal representation of this instruction - , mdBytes :: BS.ByteString -- ^ Bytes that make up this instruction - , mdAssembly :: String -- ^ Assembly code for this instruction - , mdInst :: Instruction -- ^ The instruction itself - } deriving (Eq, Ord, Show, Read, Typeable, Data) - -- | Disassemble machine code, with full metadata. -- -- The output is produced lazily. disassembleMetadata :: Config -> BS.ByteString -> [Metadata] -disassembleMetadata = disWith $ \ud -> Metadata - <$> I.getOffset ud - <*> I.getLength ud - <*> I.getHex ud - <*> I.getBytes ud - <*> I.getAssembly ud - <*> I.getInstruction ud +disassembleMetadata = disWith I.getMetadata diff --git a/Hdis86/Types.hs b/Hdis86/Types.hs --- a/Hdis86/Types.hs +++ b/Hdis86/Types.hs @@ -1,5 +1,8 @@ {-# LANGUAGE - DeriveDataTypeable #-} + DeriveDataTypeable + , ScopedTypeVariables #-} +{-# OPTIONS_GHC + -fno-warn-orphans #-} -- | Types provided by the disassembler. module Hdis86.Types @@ -16,6 +19,9 @@ -- * Word sizes , WordSize(..), wordSize, bitsInWord + -- * Instruction with metadata + , Metadata(..) + -- * Configuration , Config(..) , Vendor(..), CPUMode(..), Syntax(..) @@ -33,7 +39,12 @@ import Data.Data ( Data ) import Data.Word import Data.Int +import Control.Applicative hiding ( Const ) +import qualified Data.ByteString as BS +import qualified Text.Read as R +import qualified Test.QuickCheck as Q + -- | Machine word sizes. -- -- Some fields, such as immediate operands, come in different @@ -151,10 +162,27 @@ -- -- The destination @'Operand'@ (if any) will precede the source -- @'Operand'@s. -data Instruction - = Inst [Prefix] Opcode [Operand] - deriving (Eq, Ord, Show, Read, Typeable, Data) +data Instruction = Inst + { inPrefixes :: [Prefix] + , inOpcode :: Opcode + , inOperands :: [Operand] + } deriving (Eq, Ord, Typeable, Data) +instance Show Instruction where + showsPrec p (Inst pfx opc opr) = showParen (p >= 11) body + where + body = foldr (.) id + [("Inst "++), showsPrec 11 pfx, (" "++), + showsPrec 11 opc, (" "++), showsPrec 11 opr] + +instance Read Instruction where + readsPrec d = R.readParen (d > 10) $ \r -> + [(Inst pfx opc opr, xd) + | ("Inst", xa) <- R.lex r + , (pfx, xb) <- readsPrec 11 xa + , (opc, xc) <- readsPrec 11 xb + , (opr, xd) <- readsPrec 11 xc] + -- | Prefixes, used to modify an instruction. data Prefix = Seg Segment -- ^ Segment override @@ -198,6 +226,16 @@ , iValue :: t -- ^ Immediate value, e.g @'Int64'@ or @'Word64'@ } deriving (Eq, Ord, Show, Read, Typeable, Data) +-- | An instruction with full metadata. +data Metadata = Metadata + { mdOffset :: Word64 -- ^ Offset of the start of this instruction + , mdLength :: Word -- ^ Length of this instruction in bytes + , mdHex :: String -- ^ Hexadecimal representation of this instruction + , mdBytes :: BS.ByteString -- ^ Bytes that make up this instruction + , mdAssembly :: String -- ^ Assembly code for this instruction + , mdInst :: Instruction -- ^ The instruction itself + } deriving (Eq, Ord, Show, Read, Typeable, Data) + -- | CPU vendors, supporting slightly different instruction sets. data Vendor = Intel @@ -231,3 +269,82 @@ intel64 = Config Intel Mode64 SyntaxNone 0 amd32 = Config AMD Mode32 SyntaxNone 0 amd64 = Config AMD Mode64 SyntaxNone 0 + + +-- QuickCheck properties + +_prop_Instruction_ReadShow :: Instruction -> Bool +_prop_Instruction_ReadShow i = read (show i) == i + + +-- QuickCheck instances + +arbEnum :: forall a. (Enum a, Bounded a) => Q.Gen a +arbEnum = toEnum <$> Q.choose (fromEnum lb, fromEnum ub) where + lb, ub :: a + (lb, ub) = (minBound, maxBound) + +instance Q.Arbitrary GPR where arbitrary = arbEnum +instance Q.Arbitrary Half where arbitrary = arbEnum +instance Q.Arbitrary Segment where arbitrary = arbEnum +instance Q.Arbitrary ControlRegister where arbitrary = arbEnum +instance Q.Arbitrary DebugRegister where arbitrary = arbEnum +instance Q.Arbitrary MMXRegister where arbitrary = arbEnum +instance Q.Arbitrary X87Register where arbitrary = arbEnum +instance Q.Arbitrary XMMRegister where arbitrary = arbEnum +instance Q.Arbitrary WordSize where arbitrary = arbEnum +instance Q.Arbitrary Vendor where arbitrary = arbEnum +instance Q.Arbitrary CPUMode where arbitrary = arbEnum +instance Q.Arbitrary Syntax where arbitrary = arbEnum +instance Q.Arbitrary Opcode where arbitrary = arbEnum + +instance Q.Arbitrary Register where + arbitrary = Q.oneof [ + pure RegNone + , pure RegIP + , Reg8 <$> Q.arbitrary <*> Q.arbitrary + , Reg16 <$> Q.arbitrary + , Reg32 <$> Q.arbitrary + , Reg64 <$> Q.arbitrary + , RegSeg <$> Q.arbitrary + , RegCtl <$> Q.arbitrary + , RegDbg <$> Q.arbitrary + , RegMMX <$> Q.arbitrary + , RegX87 <$> Q.arbitrary + , RegXMM <$> Q.arbitrary ] + +instance (Q.Arbitrary t) => Q.Arbitrary (Immediate t) where + arbitrary = Immediate <$> Q.arbitrary <*> Q.arbitrary + +instance Q.Arbitrary Pointer where + arbitrary = Pointer <$> Q.arbitrary <*> Q.arbitrary + +instance Q.Arbitrary Memory where + arbitrary = Memory <$> Q.arbitrary <*> Q.arbitrary <*> Q.arbitrary + <*> Q.arbitrary <*> Q.arbitrary + +instance Q.Arbitrary Operand where + arbitrary = Q.oneof [ + Mem <$> Q.arbitrary + , Reg <$> Q.arbitrary + , Ptr <$> Q.arbitrary + , Imm <$> Q.arbitrary + , Jump <$> Q.arbitrary + , Const <$> Q.arbitrary ] + +instance Q.Arbitrary Prefix where + arbitrary = Q.oneof ( + (Seg <$> Q.arbitrary) + : map pure [Rex, OperSize, AddrSize, Lock, Rep, RepE, RepNE] ) + +instance Q.Arbitrary Instruction where + arbitrary = do + np <- Q.choose (0,3) + no <- Q.choose (0,3) + Inst <$> Q.vectorOf np Q.arbitrary + <*> Q.arbitrary + <*> Q.vectorOf no Q.arbitrary + +instance Q.Arbitrary Config where + arbitrary = Config <$> Q.arbitrary <*> Q.arbitrary + <*> Q.arbitrary <*> Q.arbitrary diff --git a/hdis86.cabal b/hdis86.cabal --- a/hdis86.cabal +++ b/hdis86.cabal @@ -1,5 +1,5 @@ name: hdis86 -version: 0.1 +version: 0.2 license: BSD3 license-file: LICENSE synopsis: Interface to the udis86 disassembler for x86 and x86-64 / AMD64 @@ -8,7 +8,7 @@ maintainer: Keegan McAllister homepage: https://github.com/kmcallister/hdis86 build-type: Simple -cabal-version: >=1.2 +cabal-version: >=1.6 description: @hdis86@ is an interface to the @udis86@ disassembler, which decodes machine code for 16-, 32-, and 64-bit x86 and x86-64 / AMD64 processors. @hdis86@ @@ -30,7 +30,9 @@ . Many users can simply import @Hdis86@. . - + The @Incremental@ module provides disassembly of lazy @ByteString@s, and a + function for building other incremental operations. + . By default, @hdis86@ will statically link a built-in copy of @udis86-1.7@, which is provided by its author under a similar BSD license. See inside the tarball for more information. If you have @udis86@ installed on your system, @@ -40,10 +42,21 @@ This code is available on GitHub at . . The @udis86@ project website is located at . + . + New in version 0.2: + . + * Disassembly of lazy @ByteString@s + . + * A function for building other incremental operations + . + * Record selectors on @Instruction@ + . + * QuickCheck @Arbitrary@ instances for @Instruction@ and related types extra-source-files: tools/hdcli.hs , tools/gen_opcode.sh + , tools/test_lazy_bytestring.hs , udis86-1.7/libudis86/decode.h , udis86-1.7/libudis86/input.h , udis86-1.7/libudis86/syn.h @@ -65,15 +78,18 @@ Hdis86 , Hdis86.Types , Hdis86.Pure + , Hdis86.Incremental , Hdis86.IO , Hdis86.C - , Hdis86.Internal.Opcode , Hdis86.Internal.Map + other-modules: + Hdis86.Internal.Opcode ghc-options: -Wall build-depends: base >= 3 && < 5 , containers >= 0.3 , bytestring >= 0.9 + , QuickCheck >= 2.4 if flag(external-udis86) extra-libraries: udis86 @@ -87,3 +103,16 @@ udis86-1.7/libudis86/syn.c udis86-1.7/libudis86/syn-att.c udis86-1.7/libudis86/syn-intel.c + + other-extensions: + DeriveDataTypeable + , RecordWildCards + , NamedFieldPuns + , ViewPatterns + , ForeignFunctionInterface + , EmptyDataDecls + , ScopedTypeVariables + +source-repository head + type: git + location: git://github.com/kmcallister/hdis86.git diff --git a/tools/test_lazy_bytestring.hs b/tools/test_lazy_bytestring.hs new file mode 100644 --- /dev/null +++ b/tools/test_lazy_bytestring.hs @@ -0,0 +1,69 @@ +module Main(main) where + +{- Check correctness and speed of lazy ByteString disassembly + versus strict ByteString disassembly. + + $ for p in mwc-random clock groom; do cabal install $p; done + $ ghc --make -O test_lazy_bytestring.hs + $ ./test_lazy_bytestring +-} + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import qualified Data.Vector.Unboxed as V +import qualified System.Random.MWC as R +import qualified System.Posix.Clock as C + +import Control.Monad +import Control.Exception ( evaluate ) +import System.Exit +import System.IO +import Text.Groom +import Text.Printf + +import Hdis86 +import Hdis86.Incremental + +splitBS :: R.GenIO -> BS.ByteString -> IO [BS.ByteString] +splitBS _ bs | BS.length bs < 2 = return [bs] +splitBS gen bs = do + die <- R.uniformR (0,4) gen + if die == (0 :: Int) + then return [bs] + else do + i <- R.uniformR (1, BS.length bs - 1) gen + let (x,y) = BS.splitAt i bs + fmap (x:) (splitBS gen y) + +time :: IO () -> IO Double +time x = do + let get = C.getTime C.Monotonic + C.TimeSpec s0 ns0 <- get + x + C.TimeSpec s1 ns1 <- get + let scale = ((10 ** (-9)) *) . fromIntegral + return (fromIntegral (s1 - s0) + scale (ns1 - ns0)) + +main :: IO () +main = R.withSystemRandom $ \gen -> forever $ do + size <- R.uniformR (2^16, 2^21) gen + vec <- R.uniformVector gen size + let bs = BS.pack (V.toList vec) + chunks <- splitBS gen bs + let bl = BL.fromChunks chunks + _ <- evaluate (BS.length bs) + _ <- evaluate (BL.length bl) + + let ms = disassembleMetadata amd64 bs + ml = disassembleLazy amd64 bl + force = time . mapM_ (evaluate . inOpcode . mdInst) + ts <- force $ disassembleMetadata amd64 bs + tl <- force $ disassembleLazy amd64 bl + + _ <- printf "%4d kB in %3d chunks: %5.2f s / %5.2f s = %6.2f%% speed\n" + (size `div` 1024) (length chunks) ts tl (100 * ts / tl) + when (ms /= ml) $ do + hPutStr stderr "FAIL; check out.*\n" + writeFile "out.strict" $ groom ms + writeFile "out.lazy" $ groom ml + exitWith (ExitFailure 1)