├── .githooks └── pre-commit ├── .gitignore ├── LICENSE ├── README.md ├── TODO.md ├── app └── Main.hs ├── binsym.cabal ├── cabal.project ├── examples ├── prime-numbers │ ├── build.sh │ ├── extract-primes.awk │ ├── main.c │ └── start.S └── three-branches │ ├── build.sh │ ├── main.c │ └── start.S ├── src └── BinSym │ ├── ArchState.hs │ ├── Concolic.hs │ ├── Cond.hs │ ├── Interpreter.hs │ ├── Memory.hs │ ├── Store.hs │ ├── Symbolic.hs │ ├── Syscall.hs │ ├── Tracer.hs │ └── Util.hs └── test ├── ConcolicExpr.hs ├── Main.hs ├── Memory.hs ├── SymbolicExpr.hs ├── Tracer.hs └── Util.hs /.githooks/pre-commit: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | if ! command -v ormolu 1>/dev/null; then 4 | echo "error: ormolu is not installed" 1>&2 5 | exit 1 6 | fi 7 | 8 | out=$(git diff --cached --name-only app/ src/ test/ | xargs -r ormolu --mode check 2>&1) 9 | if [ $? -ne 0 ]; then 10 | printf "The following files need to be formated with 'ormolu':\n\n" 1>&2 11 | printf "%s\n" "${out}" | awk '/^(app|src|test)/ { printf("\t%s\n", $0) }' 1>&2 12 | exit 1 13 | fi 14 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist-newstyle/ 2 | examples/**/main 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2023 Group of Computer Architecture, University of Bremen 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included 12 | in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 17 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 18 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 19 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 20 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # BinSym 2 | 3 | Symbolic execution of [RISC-V] binary code based on formal instruction semantics. 4 | 5 | **More information:** https://doi.org/10.23919/DATE64628.2025.10993257 6 | 7 | ## About 8 | 9 | BinSym is a program analysis tool which enables symbolic execution of binary code. 10 | The majority of prior work on binary program analysis lifts/transforms binary code 11 | to an Intermediate Representation (IR) and then analysis this intermediate format. 12 | BinSym, on the other hand, operates directly on the binary-level and eliminates 13 | the need to perform binary lifting. This enables BinSym to capture and reason 14 | about low-level interactions (e.g. with the architectural state). Furthermore, 15 | through the utilization of formal instruction semantics, BinSym is more faithful 16 | to the ISA specification and eliminates the possibilities of errors and inaccuracies 17 | which may occur during the lifting step in prior work. 18 | 19 | The implementation of BinSym is based on our prior work on [LibRISCV]. 20 | Specifically, BinSym provides actual symbolic semantics for the abstract 21 | instruction semantics specified in LibRISCV. Or, in other words, BinSym is a 22 | symbolic free monad interpreter for LibRISCV. 23 | 24 | ## Installation 25 | 26 | BinSym has been developed for GHC 9.4.8 (newer versions may work too). Furthermore, 27 | installation requires [z3] to be available as a prerequisite. After installing z3, 28 | one can install BinSym by running the following commands: 29 | 30 | $ git clone https://github.com/agra-uni-bremen/binsym 31 | $ cd binsym 32 | $ cabal install 33 | 34 | This installs a `riscv-symex` binary into your PATH. This binary can be used for 35 | symbolic execution of RV32IM machine code. As described in the next section. 36 | 37 | ## Usage 38 | 39 | In order to explore 32-bit RISC-V machine code using `riscv-symex`, a symbolic 40 | value needs to be introduced into the simulation. Presently, this can be 41 | achieved through an `ECALL` which must be used from inside the software (i.e. 42 | the software must be modified to make use of this `ECALL`). In order to declare 43 | an unconstrained symbolic value via an `ECALL`, the following C code can be used: 44 | 45 | ```C 46 | void 47 | make_symbolic(void *ptr, size_t size) 48 | { 49 | __asm__ volatile ("li a7, 96\n" 50 | "mv a0, %0\n" 51 | "mv a1, %1\n" 52 | "ecall\n" 53 | : /* no output operands */ 54 | : "r" (ptr), "r" (size) 55 | : "a7", "a0", "a1"); 56 | } 57 | ``` 58 | 59 | BinSym executes the code until it finds the first invalid instruction; 60 | therefore, in order to terminate an execution path use something along the 61 | lines of `.word 0xffff` in your startup assembly file. A simple example 62 | program, which enumerates prime numbers symbolically, is available in the 63 | `examples/prime-numbers` directory. Presently, BinSym always explores the 64 | input space in its entirety. Furthermore, no error detection techniques 65 | have been integrated with BinSym yet. 66 | 67 | ## How To Cite 68 | 69 | This work was published in the [proceedings of DATE'25](https://doi.org/10.23919/DATE64628.2025.10993257), it can be cited as follows: 70 | 71 | ``` 72 | @misc{tempel2024binsym, 73 | author = {Sören Tempel and Tobias Brandt and Christoph Lüth and Christian Dietrich and Rolf Drechsler}, 74 | booktitle = {2025 Design, Automation \& Test in Europe Conference \& Exhibition (DATE)} 75 | title = {Accurate and Extensible Symbolic Execution of Binary Code based on Formal ISA Semantics}, 76 | year = {2025}, 77 | doi = {10.23919/DATE64628.2025.10993257}, 78 | } 79 | ``` 80 | 81 | [RISC-V]: https://riscv.org/ 82 | [LibRISCV]: https://github.com/agra-uni-bremen/libriscv 83 | [z3]: https://github.com/Z3Prover/z3 84 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | * [ ] Re-use `LibRISCV.Machine.Memory` instead of supplying a custom implementation 2 | * [ ] Use unconstrained symbolic values for uninitialized memory 3 | * [ ] Switch to new LibRISCV version based on BV instead of Word32 4 | * [ ] Refactor the public API of `SymEx.Concolic` 5 | * [ ] Test concrete execution and ensure that it works properly 6 | * [ ] Implement execution restarting 7 | * [ ] Refactor namespaces 8 | * [ ] Allow configuring seed for global random number generator via cmd-line argument 9 | * [ ] Rewrite Concolic.concretize 10 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TypeApplications #-} 3 | 4 | module Main where 5 | 6 | import BinSym.ArchState 7 | import BinSym.Concolic 8 | import BinSym.Interpreter 9 | import qualified BinSym.Memory as MEM 10 | import qualified BinSym.Store as S 11 | import BinSym.Tracer 12 | import Control.Monad (when) 13 | import Control.Monad.Freer (interpretM, runM) 14 | import Control.Monad.IO.Class (liftIO) 15 | import qualified Data.BitVector as BV 16 | import Data.IORef (newIORef, readIORef) 17 | import Data.Word (Word32) 18 | import LibRISCV (Address, RegIdx (SP), align) 19 | import LibRISCV.CmdLine (BasicArgs (BasicArgs, file, memAddr, memSize), basicArgs) 20 | import LibRISCV.Effects.Decoding.Default.Interpreter (defaultDecoding) 21 | import LibRISCV.Effects.Logging.Default.Interpreter (defaultLogging, noLogging) 22 | import LibRISCV.Effects.Operations.Default.Machine.Register (writeRegister) 23 | import LibRISCV.Loader (loadElf, readElf, startAddr) 24 | import LibRISCV.Semantics (buildAST) 25 | import Options.Applicative 26 | import System.Random (initStdGen, mkStdGen, setStdGen) 27 | import qualified Z3.Monad as Z3 28 | 29 | data SymbolicArgs = SymbolicArgs 30 | { randSeed :: Maybe Int, 31 | base :: BasicArgs 32 | } 33 | 34 | {- ORMOLU_DISABLE -} 35 | symbolicArgs :: Parser SymbolicArgs 36 | symbolicArgs = 37 | SymbolicArgs 38 | <$> optional 39 | (option auto 40 | ( long "random-seed" 41 | <> help "Seed for the random number generator")) 42 | <*> basicArgs 43 | {- ORMOLU_ENABLE -} 44 | 45 | ------------------------------------------------------------------------ 46 | 47 | -- TODO: Add proper data type to track all symbolic execution state. 48 | type EntryState = (MEM.Memory, Address) 49 | 50 | runPath :: BasicArgs -> EntryState -> S.Store -> Z3.Z3 ExecTrace 51 | runPath (BasicArgs memBegin size verbose putReg _) (mem, entry) store = do 52 | state <- liftIO $ fromMemory store mem 53 | let regs = getRegs state 54 | 55 | -- Let stack pointer start at end of memory by default. 56 | -- It must be possible to perform a LW with this address. 57 | let initalSP = align (memBegin + size - 1) 58 | 59 | instRef <- liftIO $ newIORef (0 :: Word32) 60 | let interpreter = 61 | interpretM (symBehavior state) 62 | . interpretM (symEval $ getTrace state) 63 | . interpretM (defaultDecoding @(Concolic BV.BV) instRef) 64 | . interpretM (if verbose then defaultLogging else noLogging) 65 | runM $ interpreter $ do 66 | liftIO $ writeRegister regs SP (mkConcrete initalSP) 67 | buildAST @32 (mkConcrete $ BV.bitVec 32 entry) 68 | 69 | ret <- liftIO $ readIORef (getTrace state) 70 | when putReg $ 71 | liftIO $ 72 | dumpState state 73 | pure ret 74 | 75 | runAll :: Tracer -> Int -> BasicArgs -> EntryState -> S.Store -> Z3.Z3 Int 76 | runAll tracer numPaths args es store = do 77 | liftIO $ putStrLn $ "\n##\n# " ++ show numPaths ++ "th concolic execution\n##\n" 78 | trace <- runPath args es store 79 | 80 | -- tracer' includes the trace of the last path. 81 | let tracer' = trackTrace tracer trace 82 | 83 | (model, nextTracer) <- findUnexplored tracer' 84 | case model of 85 | Nothing -> pure numPaths 86 | Just m -> do 87 | newStore <- S.fromModel m 88 | liftIO $ putStrLn ("\nNext assignment:\n" ++ show newStore) 89 | runAll nextTracer (numPaths + 1) args es newStore 90 | 91 | ------------------------------------------------------------------------ 92 | 93 | main' :: SymbolicArgs -> Z3.Z3 () 94 | main' (SymbolicArgs seed args@(BasicArgs {memAddr = ma, memSize = ms, file = fp})) = do 95 | -- Initial memory state, copied for each execution 96 | mem <- MEM.mkMemory ma ms 97 | elf <- liftIO $ readElf fp 98 | loadElf elf $ MEM.storeByteString mem 99 | entry <- liftIO $ startAddr elf 100 | 101 | -- Optional deterministic random number generation for debugging. 102 | stdgen <- case seed of 103 | Just x -> pure $ mkStdGen x 104 | Nothing -> initStdGen 105 | liftIO $ setStdGen stdgen 106 | 107 | numPaths <- runAll newTracer 1 args (mem, entry) S.empty 108 | liftIO $ putStrLn ("\n---\nUnique paths found: " ++ show numPaths) 109 | 110 | main :: IO () 111 | main = (Z3.evalZ3 . main') =<< execParser opts 112 | where 113 | opts = 114 | info 115 | (symbolicArgs <**> helper) 116 | ( fullDesc 117 | <> progDesc "Symbolic execution of RISC-V machine code" 118 | ) 119 | -------------------------------------------------------------------------------- /binsym.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: binsym 3 | version: 0.1.0.0 4 | synopsis: 5 | A symbolic execution tool for RISC-V machine code based on the formal LibRISCV ISA model 6 | 7 | license: MIT 8 | license-file: LICENSE 9 | author: Sören Tempel 10 | maintainer: tempel@uni-bremen.de 11 | copyright: (c) 2023 University of Bremen 12 | category: Development 13 | build-type: Simple 14 | 15 | common warnings 16 | ghc-options: -Wall 17 | 18 | library 19 | import: warnings 20 | hs-source-dirs: src 21 | default-language: Haskell2010 22 | 23 | exposed-modules: BinSym.Interpreter 24 | , BinSym.ArchState 25 | , BinSym.Util 26 | , BinSym.Memory 27 | , BinSym.Cond 28 | , BinSym.Symbolic 29 | , BinSym.Concolic 30 | , BinSym.Tracer 31 | , BinSym.Store 32 | , BinSym.Syscall 33 | 34 | build-depends: base >=4.15.0.0 35 | , random ^>=1.2.1.1 36 | , z3 37 | , libriscv 38 | , freer-simple 39 | , bytestring 40 | , array 41 | , containers 42 | , bv 43 | 44 | executable riscv-symex 45 | import: warnings 46 | main-is: Main.hs 47 | hs-source-dirs: app 48 | default-language: Haskell2010 49 | build-depends: 50 | base >=4.15.0.0 51 | , binsym 52 | , libriscv 53 | , optparse-applicative 54 | , random 55 | , freer-simple 56 | , z3 57 | , bv 58 | 59 | test-suite test 60 | import: warnings 61 | default-language: Haskell2010 62 | type: exitcode-stdio-1.0 63 | hs-source-dirs: test 64 | main-is: Main.hs 65 | 66 | other-modules: Util 67 | , Memory 68 | , SymbolicExpr 69 | , ConcolicExpr 70 | , Tracer 71 | 72 | build-depends: 73 | base >= 4.15.0.0 74 | , tasty ^>= 1.4.2.3 75 | , tasty-hunit ^>= 0.10.0.3 76 | , binsym 77 | , libriscv 78 | , z3 79 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: *.cabal 2 | 3 | source-repository-package 4 | type: git 5 | location: https://github.com/agra-uni-bremen/libriscv.git 6 | tag: fb3a8b992622e04b5cbf70e3726e4627bf639a6f 7 | 8 | source-repository-package 9 | type: git 10 | location: https://github.com/IagoAbal/haskell-z3.git 11 | tag: b77a17e5eeb7db82656bcbcd66c6e952207e69ca 12 | 13 | -- The template-haskell version constraint of freer-simple is too strict. 14 | -- 15 | -- See: https://github.com/lexi-lambda/freer-simple/issues/40#issuecomment-1438089449 16 | allow-newer: freer-simple:template-haskell 17 | 18 | -- On some versions of Alpine Linux, the text library fails to compile 19 | -- the vendored simdutf C code. Work around that by disabling the feature. 20 | constraints: text -simdutf 21 | -------------------------------------------------------------------------------- /examples/prime-numbers/build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | set -x 3 | riscv-none-elf-gcc -march=rv32i -mabi=ilp32 -nostartfiles -o main start.S main.c 4 | -------------------------------------------------------------------------------- /examples/prime-numbers/extract-primes.awk: -------------------------------------------------------------------------------- 1 | #!/usr/bin/awk -f 2 | 3 | BEGIN { 4 | is_prime = 0 5 | } 6 | 7 | /^A2 = 0x1/ { 8 | is_prime = 1 9 | } 10 | 11 | /^Next/ { 12 | is_prime = 0 13 | } 14 | 15 | /^A3 =/ { 16 | if (is_prime) 17 | print($3) 18 | } 19 | -------------------------------------------------------------------------------- /examples/prime-numbers/main.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | static void 4 | make_symbolic(volatile void *ptr, size_t size) 5 | { 6 | __asm__ volatile ("li a7, 96\n" 7 | "mv a0, %0\n" 8 | "mv a1, %1\n" 9 | "ecall\n" 10 | : /* no output operands */ 11 | : "r" (ptr), "r" (size) 12 | : "a7", "a0", "a1"); 13 | } 14 | 15 | static int 16 | first_divisor(unsigned int a) 17 | { 18 | unsigned int i; 19 | 20 | for (i = 2; i < a; i++) { 21 | if (a % i == 0) { 22 | return i; 23 | } 24 | } 25 | 26 | return a; 27 | } 28 | 29 | void 30 | main(void) 31 | { 32 | int a; 33 | register int is_prime asm("a2"); 34 | register int number asm("a3"); 35 | 36 | make_symbolic(&a, sizeof(a)); 37 | if (a <= 100) { 38 | if (a > 1 && first_divisor(a) == a) { 39 | is_prime = 1; 40 | number = a; 41 | } else { 42 | is_prime = 0; 43 | number = a; 44 | } 45 | } 46 | } 47 | -------------------------------------------------------------------------------- /examples/prime-numbers/start.S: -------------------------------------------------------------------------------- 1 | .globl _start 2 | .globl main 3 | 4 | _start: 5 | jal main 6 | .word 0xffff 7 | -------------------------------------------------------------------------------- /examples/three-branches/build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | set -x 3 | riscv-none-elf-gcc -march=rv32i -mabi=ilp32 -nostartfiles -o main start.S main.c 4 | -------------------------------------------------------------------------------- /examples/three-branches/main.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | static void 4 | make_symbolic(volatile void *ptr, size_t size) 5 | { 6 | __asm__ volatile ("li a7, 96\n" 7 | "mv a0, %0\n" 8 | "mv a1, %1\n" 9 | "ecall\n" 10 | : /* no output operands */ 11 | : "r" (ptr), "r" (size) 12 | : "a7", "a0", "a1"); 13 | } 14 | 15 | int main(void) { 16 | int a, b, r; 17 | 18 | make_symbolic(&a, sizeof(a)); 19 | make_symbolic(&b, sizeof(b)); 20 | 21 | if (a < b) { 22 | if (a < 5) { 23 | return 3; 24 | } else { 25 | return 2; 26 | } 27 | } else { 28 | return 1; 29 | } 30 | } 31 | -------------------------------------------------------------------------------- /examples/three-branches/start.S: -------------------------------------------------------------------------------- 1 | .globl _start 2 | .globl main 3 | 4 | _start: 5 | jal main 6 | .word 0xffff 7 | -------------------------------------------------------------------------------- /src/BinSym/ArchState.hs: -------------------------------------------------------------------------------- 1 | module BinSym.ArchState 2 | ( ArchState (..), 3 | mkArchState, 4 | fromMemory, 5 | dumpState, 6 | ) 7 | where 8 | 9 | import BinSym.Concolic 10 | import qualified BinSym.Memory as MEM 11 | import BinSym.Store (Store) 12 | import BinSym.Tracer (ExecTrace, newExecTrace) 13 | import Data.Array.IO (IOArray) 14 | import Data.IORef (IORef, newIORef) 15 | import Data.Word (Word32) 16 | import LibRISCV (Address) 17 | import qualified LibRISCV.Effects.Operations.Default.Machine.Register as REG 18 | import Numeric (showHex) 19 | 20 | data ArchState = MkArchState 21 | { getRegs :: REG.RegisterFile IOArray (Concolic Word32), 22 | getMem :: MEM.Memory, 23 | getTrace :: IORef ExecTrace, 24 | getStore :: Store 25 | } 26 | 27 | mkArchState :: Store -> Address -> Word32 -> IO ArchState 28 | mkArchState store memStart memSize = do 29 | mem <- MEM.mkMemory memStart memSize 30 | fromMemory store mem 31 | 32 | fromMemory :: Store -> MEM.Memory -> IO ArchState 33 | fromMemory store mem = do 34 | reg <- REG.mkRegFile $ mkConcrete 0 35 | ref <- newIORef newExecTrace 36 | pure $ MkArchState reg mem ref store 37 | 38 | dumpState :: ArchState -> IO () 39 | dumpState MkArchState {getRegs = r} = REG.dumpRegs (showHex . getConcrete) r >>= putStr 40 | -------------------------------------------------------------------------------- /src/BinSym/Concolic.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | -- Ignore orphan instance of FiniteBits for BV.BV. 3 | -- This instance has been proposed upstream . 4 | -- 5 | -- Unfortunately, we can't disable this warning only for this instance. 6 | -- See: https://gitlab.haskell.org/ghc/ghc/-/issues/602 7 | {-# OPTIONS_GHC -fno-warn-orphans #-} 8 | 9 | module BinSym.Concolic 10 | ( Concolic (..), 11 | mkConcolic, 12 | mkConcrete, 13 | hasSymbolic, 14 | getConcrete, 15 | getSymbolic, 16 | getSymbolicDef, 17 | mkUncons, 18 | evalE, 19 | ) 20 | where 21 | 22 | import qualified BinSym.Symbolic as S 23 | import qualified Data.BitVector as BV 24 | import Data.Bits (FiniteBits, finiteBitSize) 25 | import Data.Maybe (fromMaybe) 26 | import LibRISCV.Effects.Decoding.Default.Interpreter (Decodable (..)) 27 | import qualified LibRISCV.Effects.Expressions.Default.Interpreter as I 28 | import qualified LibRISCV.Effects.Expressions.Expr as E 29 | import qualified Z3.Monad as Z3 30 | 31 | -- Concolic is a tuple of a concrete value (as represented by 32 | -- LibRISCV.Machine.Interpreter) and an optional symbolic value as an 33 | -- SMT bit-vector (as represented by the Haskell Z3 bindings). 34 | -- 35 | -- See also: https://en.wikipedia.org/wiki/Concolic_testing 36 | data Concolic a 37 | = MkConcolic 38 | a -- Concrete value 39 | (Maybe Z3.AST) -- Symbolic value (bit-vector) 40 | 41 | instance Decodable (Concolic BV.BV) where 42 | fromWord = mkConcrete . BV.bitVec 32 43 | toWord = fromIntegral . getConcrete 44 | 45 | instance Functor Concolic where 46 | fmap fn (MkConcolic c s) = MkConcolic (fn c) s 47 | 48 | instance FiniteBits BV.BV where 49 | finiteBitSize = BV.width 50 | 51 | -- Create a new concolic value. 52 | mkConcolic :: a -> Maybe Z3.AST -> Concolic a 53 | mkConcolic = MkConcolic 54 | 55 | -- Create a concrete concolic value, i.e. a value without a symbolic part. 56 | mkConcrete :: a -> Concolic a 57 | mkConcrete v = MkConcolic v Nothing 58 | 59 | -- Create a concolic value with an unconstrained symbolic part. 60 | mkUncons :: (Z3.MonadZ3 z3, FiniteBits a) => a -> String -> z3 (Concolic a) 61 | mkUncons initial name = do 62 | symbol <- Z3.mkStringSymbol name 63 | symbolic <- Z3.mkBvVar symbol (finiteBitSize initial) 64 | pure $ mkConcolic initial (Just symbolic) 65 | 66 | -- True if the concolic value has a symbolic part. 67 | hasSymbolic :: Concolic a -> Bool 68 | hasSymbolic (MkConcolic _ Nothing) = False 69 | hasSymbolic (MkConcolic _ (Just _)) = True 70 | 71 | -- Extract the concrete part of a concolic value. 72 | getConcrete :: Concolic a -> a 73 | getConcrete (MkConcolic w _) = w 74 | 75 | -- Extract the optional symbolic part of a concolic value. 76 | getSymbolic :: Concolic a -> Maybe Z3.AST 77 | getSymbolic (MkConcolic _ s) = s 78 | 79 | -- Return a symbolic value for the concolic value, if the concolic value 80 | -- doesn't have a symbolic part then it's concrete part is converted to 81 | -- a Z3 bit-vector instead. 82 | getSymbolicDef :: (Z3.MonadZ3 z3, Integral a, FiniteBits a) => Concolic a -> z3 Z3.AST 83 | getSymbolicDef (MkConcolic c s) = do 84 | flip fromMaybe s <$> Z3.mkBitvector (finiteBitSize c) (fromIntegral c) 85 | 86 | ------------------------------------------------------------------------ 87 | 88 | -- Implementation of the LibRISCV expression language on concolic value. 89 | -- The implementation re-uses the existing implementation of the 90 | -- LibRISCV.Machine.Interpreter for the concrete part of the concolic 91 | -- value. For the symbolic part, the evalE implementation from the 92 | -- BinSym.Symbolic module is used. 93 | 94 | -- Perform an unary LibRISCV Expr operation on a concolic value. 95 | unaryOp :: 96 | (Z3.MonadZ3 z3) => 97 | E.Expr (Concolic BV.BV) -> 98 | (E.Expr BV.BV -> E.Expr BV.BV) -> 99 | (E.Expr Z3.AST -> E.Expr Z3.AST) -> 100 | z3 (Concolic BV.BV) 101 | unaryOp e fnConc fnSym = do 102 | (MkConcolic c s) <- evalE e 103 | 104 | let concrete = I.evalE (fnConc (E.FromImm c)) 105 | symbolic <- case s of 106 | Just x -> Just <$> S.evalE (fnSym (E.FromImm x)) 107 | Nothing -> pure Nothing 108 | 109 | pure $ MkConcolic concrete symbolic 110 | 111 | -- Perform a binary LibRISCV Expr operation on a concolic value. 112 | binaryOp :: 113 | (Z3.MonadZ3 z3) => 114 | E.Expr (Concolic BV.BV) -> 115 | E.Expr (Concolic BV.BV) -> 116 | (E.Expr BV.BV -> E.Expr BV.BV -> E.Expr BV.BV) -> 117 | (E.Expr Z3.AST -> E.Expr Z3.AST -> E.Expr Z3.AST) -> 118 | z3 (Concolic BV.BV) 119 | binaryOp e1 e2 fnConc fnSym = do 120 | conc1@(MkConcolic c1 _) <- evalE e1 121 | conc2@(MkConcolic c2 _) <- evalE e2 122 | 123 | let concrete = I.evalE (fnConc (E.FromImm c1) (E.FromImm c2)) 124 | if hasSymbolic conc1 || hasSymbolic conc2 125 | then do 126 | s1 <- getSymbolicDef conc1 127 | s2 <- getSymbolicDef conc2 128 | 129 | symbolic <- Just <$> S.evalE (fnSym (E.FromImm s1) (E.FromImm s2)) 130 | pure $ MkConcolic concrete symbolic 131 | else pure $ MkConcolic concrete Nothing 132 | 133 | {- ORMOLU_DISABLE -} 134 | -- Evaluate a LibRISCV expression on a 'Concolic' value. 135 | evalE :: Z3.MonadZ3 z3 => E.Expr (Concolic BV.BV) -> z3 (Concolic BV.BV) 136 | evalE (E.FromImm e) = pure e 137 | evalE (E.FromInt n v) = pure $ mkConcrete (BV.bitVec n v) 138 | evalE (E.ZExt n e) = unaryOp e (E.ZExt n) (E.ZExt n) 139 | evalE (E.SExt n e) = unaryOp e (E.SExt n) (E.SExt n) 140 | evalE (E.Extract i l e) = unaryOp e (E.Extract i l) (E.Extract i l) 141 | evalE (E.Add e1 e2) = binaryOp e1 e2 E.Add E.Add 142 | evalE (E.Sub e1 e2) = binaryOp e1 e2 E.Sub E.Sub 143 | evalE (E.Eq e1 e2) = binaryOp e1 e2 E.Eq E.Eq 144 | evalE (E.Slt e1 e2) = binaryOp e1 e2 E.Slt E.Slt 145 | evalE (E.Sge e1 e2) = binaryOp e1 e2 E.Sge E.Sge 146 | evalE (E.Ult e1 e2) = binaryOp e1 e2 E.Ult E.Ult 147 | evalE (E.Uge e1 e2) = binaryOp e1 e2 E.Uge E.Uge 148 | evalE (E.And e1 e2) = binaryOp e1 e2 E.And E.And 149 | evalE (E.Or e1 e2) = binaryOp e1 e2 E.Or E.Or 150 | evalE (E.Xor e1 e2) = binaryOp e1 e2 E.Xor E.Xor 151 | evalE (E.LShl e1 e2) = binaryOp e1 e2 E.LShl E.LShl 152 | evalE (E.LShr e1 e2) = binaryOp e1 e2 E.LShr E.LShr 153 | evalE (E.AShr e1 e2) = binaryOp e1 e2 E.AShr E.AShr 154 | evalE (E.Mul e1 e2) = binaryOp e1 e2 E.Mul E.Mul 155 | evalE (E.SDiv e1 e2) = binaryOp e1 e2 E.SDiv E.SDiv 156 | evalE (E.UDiv e1 e2) = binaryOp e1 e2 E.UDiv E.UDiv 157 | evalE (E.SRem e1 e2) = binaryOp e1 e2 E.SRem E.SRem 158 | evalE (E.URem e1 e2) = binaryOp e1 e2 E.URem E.URem 159 | {- ORMOLU_ENABLE -} 160 | -------------------------------------------------------------------------------- /src/BinSym/Cond.hs: -------------------------------------------------------------------------------- 1 | module BinSym.Cond (Condition, new, getAST, check, assert, fromResult) where 2 | 3 | import BinSym.Util (bvSize, mkSymWord32) 4 | import qualified Control.Exception as E 5 | import Data.Word (Word32) 6 | import qualified Z3.Monad as Z3 7 | 8 | newtype Condition = MkCond Z3.AST 9 | deriving (Show, Eq) 10 | 11 | trueConst :: Word32 12 | trueConst = 1 13 | 14 | falseConst :: Word32 15 | falseConst = 0 16 | 17 | -- Create a 32-bit Z3 bit-vector from a bool. 18 | fromBool :: (Z3.MonadZ3 z3) => Bool -> z3 Z3.AST 19 | fromBool True = mkSymWord32 trueConst 20 | fromBool False = mkSymWord32 falseConst 21 | 22 | ------------------------------------------------------------------------ 23 | 24 | -- Convert a Z3 result to a boolean, panic'ing on an unknown result. 25 | fromResult :: Z3.Result -> Bool 26 | fromResult Z3.Sat = True 27 | fromResult Z3.Unsat = False 28 | fromResult Z3.Undef = error "Z3 solver" "unknown result" 29 | 30 | -- Create a Z3 predicate from a Z3 bit-vector. 31 | new :: (Z3.MonadZ3 z3) => Bool -> Z3.AST -> z3 Condition 32 | new b cond = bvSize cond >>= \s -> E.assert (s == 32) new' 33 | where 34 | new' = MkCond <$> (fromBool b >>= Z3.mkEq cond) 35 | 36 | -- Extract the Z3 expression from a condition. 37 | getAST :: Condition -> Z3.AST 38 | getAST (MkCond ast) = ast 39 | 40 | -- Check if the given condition is satisfiable. 41 | check :: (Z3.MonadZ3 z3) => Condition -> z3 Bool 42 | check (MkCond cond) = do 43 | sort <- Z3.getSort cond >>= Z3.getSortKind 44 | E.assert (sort == Z3.Z3_BOOL_SORT) (check' cond) 45 | where 46 | check' cond' = fromResult <$> Z3.solverCheckAssumptions [cond'] 47 | 48 | -- Like Z3.assert but for the 'Condition' type. 49 | assert :: (Z3.MonadZ3 z3) => Condition -> z3 () 50 | assert (MkCond c) = Z3.assert c 51 | -------------------------------------------------------------------------------- /src/BinSym/Interpreter.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE RankNTypes #-} 7 | {-# LANGUAGE TypeFamilies #-} 8 | {-# LANGUAGE TypeOperators #-} 9 | 10 | module BinSym.Interpreter (symBehavior, symEval) where 11 | 12 | import BinSym.ArchState 13 | import BinSym.Concolic 14 | import qualified BinSym.Memory as MEM 15 | import BinSym.Syscall 16 | import BinSym.Tracer 17 | import Control.Monad.Freer 18 | import Control.Monad.IO.Class (liftIO) 19 | import qualified Data.BitVector as BV 20 | import Data.IORef (IORef, readIORef, writeIORef) 21 | import Data.Word (Word32) 22 | import LibRISCV (RegIdx (..)) 23 | import qualified LibRISCV.Effects.Expressions.Expr as E 24 | import LibRISCV.Effects.Expressions.Language 25 | import qualified LibRISCV.Effects.Operations.Default.Machine.Register as REG 26 | import LibRISCV.Effects.Operations.Language (Operations (..), Size (..), bitSize) 27 | import qualified Z3.Monad as Z3 28 | 29 | ------------------------------------------------------------------------ 30 | 31 | -- Convert a concolic value to a register index. This function assumes 32 | -- that a concolic value, used to index the register file, never has a 33 | -- symbolic part. 34 | getRegIdx :: Concolic BV.BV -> RegIdx 35 | getRegIdx = toEnum . fromIntegral . getConcrete 36 | 37 | -- Track a new branch in the execution trace. 38 | trackBranch :: (Z3.MonadZ3 z3) => IORef ExecTrace -> Bool -> Z3.AST -> z3 () 39 | trackBranch ref wasTrue cond = do 40 | trace <- liftIO $ readIORef ref 41 | let newTrace = appendBranch trace wasTrue (newBranch cond) 42 | liftIO $ writeIORef ref newTrace 43 | 44 | -- Concretize a concolic value with a potentially symbolic part. That 45 | -- is, if the concolic value has a symbolic part add a constraint to 46 | -- the execution trace which ensures that it matches the concrete part 47 | -- for this execution. 48 | concretize :: (Z3.MonadZ3 z3) => IORef ExecTrace -> Concolic BV.BV -> z3 Word32 49 | concretize ref value = do 50 | let conc = getConcrete value 51 | case getSymbolic value of 52 | Just s -> do 53 | eq <- Z3.mkBitvector 32 (fromIntegral conc) >>= Z3.mkEq s 54 | liftIO $ do 55 | trace <- readIORef ref 56 | writeIORef ref $ appendCons trace eq 57 | Nothing -> pure () 58 | pure $ fromIntegral conc 59 | 60 | -- Implementation of the LibRISCV Operations effect. 61 | symBehavior :: (Z3.MonadZ3 z3) => ArchState -> Operations (Concolic BV.BV) ~> z3 62 | symBehavior state@(MkArchState regFile mem ref _) = \case 63 | ReadRegister idx -> do 64 | word <- liftIO $ REG.readRegister regFile (getRegIdx idx) 65 | pure $ fmap (BV.bitVec 32) word 66 | WriteRegister idx value -> do 67 | let word = fmap fromIntegral value 68 | liftIO $ REG.writeRegister regFile (getRegIdx idx) word 69 | -- TODO: Refactor the Memory.hs for the new Load consturctor 70 | Load size a -> do 71 | addr <- concretize ref a 72 | case size of 73 | Byte -> fmap (BV.bitVec 8) <$> MEM.loadByte mem addr 74 | Half -> fmap (BV.bitVec 16) <$> MEM.loadHalf mem addr 75 | Word -> fmap (BV.bitVec 32) <$> MEM.loadWord mem addr 76 | -- TODO: Refactor the Memory.hs for the new Store consturctor 77 | Store size a v -> do 78 | addr <- concretize ref a 79 | 80 | -- TODO: Perform value truncation in Memory.hs 81 | -- Alternatively move the extract into the semantics description. 82 | trunc <- evalE (E.Extract 0 (bitSize size) $ E.FromImm v) 83 | 84 | case size of 85 | Byte -> MEM.storeByte mem addr (fmap fromIntegral trunc) 86 | Half -> MEM.storeHalf mem addr (fmap fromIntegral trunc) 87 | Word -> MEM.storeWord mem addr (fmap fromIntegral trunc) 88 | WritePC newPC -> do 89 | liftIO $ REG.writePC regFile (fromIntegral $ getConcrete newPC) 90 | ReadPC -> mkConcrete . BV.bitVec 32 <$> liftIO (REG.readPC regFile) 91 | Exception _ msg -> error "runtime exception" msg 92 | Ecall _ -> do 93 | sys <- liftIO $ REG.readRegister regFile A7 94 | execSyscall state (getConcrete sys) 95 | Ebreak _ -> liftIO $ putStrLn "EBREAK" 96 | 97 | -- Implementation of the LibRISCV expression language effect. 98 | -- 99 | -- This implementation assumes that the EvalBool constructor is 100 | -- only used for branch instruction and hence traces all evalCond 101 | -- invocations where the condition has a symbolic value. 102 | symEval :: (Z3.MonadZ3 z3) => IORef ExecTrace -> ExprEval (Concolic BV.BV) ~> z3 103 | symEval ref = \case 104 | Eval e -> evalE e 105 | IsTrue e -> do 106 | conc <- evalE e 107 | 108 | let mayBeTrue = getConcrete conc == 1 109 | case getSymbolic conc of 110 | Just br -> trackBranch ref mayBeTrue br 111 | Nothing -> pure () 112 | 113 | pure mayBeTrue 114 | IsFalse e -> do 115 | conc <- evalE e 116 | 117 | let mayBeFalse = getConcrete conc == 0 118 | case getSymbolic conc of 119 | Just br -> trackBranch ref (not mayBeFalse) br 120 | Nothing -> pure () 121 | 122 | pure mayBeFalse 123 | -------------------------------------------------------------------------------- /src/BinSym/Memory.hs: -------------------------------------------------------------------------------- 1 | -- TODO: Make this interoperable with LibRISCV.Machine.Memory 2 | module BinSym.Memory 3 | ( Memory, 4 | mkMemory, 5 | copyMemory, 6 | loadByte, 7 | loadHalf, 8 | loadWord, 9 | storeByte, 10 | storeHalf, 11 | storeWord, 12 | storeByteString, 13 | ) 14 | where 15 | 16 | import BinSym.Concolic 17 | import BinSym.Util 18 | import Control.Exception (assert) 19 | import Control.Monad.IO.Class (MonadIO, liftIO) 20 | import Data.Array.IO (IOArray, MArray (newArray), readArray, writeArray) 21 | import Data.Bits (FiniteBits, finiteBitSize) 22 | import qualified Data.ByteString.Lazy as BSL 23 | import Data.Word (Word16, Word32, Word8) 24 | import LibRISCV (Address) 25 | import qualified LibRISCV.Effects.Operations.Default.Machine.Memory as M 26 | import qualified Z3.Monad as Z3 27 | 28 | data Memory = MkMemory 29 | { startAddr :: Address, 30 | memArray :: IOArray Address (Concolic Word8) 31 | } 32 | 33 | mkMemory :: (MonadIO m) => Address -> Word32 -> m Memory 34 | mkMemory memStart size = do 35 | -- TODO: Use an unconstrained value for uninitialized memory 36 | ary <- liftIO $ newArray (0, size - 1) (mkConcrete 0) 37 | pure $ MkMemory memStart ary 38 | 39 | copyMemory :: (MonadIO m) => Memory -> m Memory 40 | copyMemory (MkMemory s a) = MkMemory s <$> liftIO (copyArray a) 41 | 42 | -- Translate global address to a memory-local address. 43 | toMemAddr :: Memory -> Address -> Address 44 | toMemAddr (MkMemory {startAddr = base}) addr = assert (addr >= base) (addr - base) 45 | 46 | ------------------------------------------------------------------------ 47 | 48 | mkBytes' :: (Z3.MonadZ3 z3) => Z3.AST -> z3 [Z3.AST] 49 | mkBytes' bv = do 50 | bitSize <- bvSize bv 51 | assert (bitSize `mod` 8 == 0) $ 52 | mapM (\n -> Z3.mkExtract ((n * 8) - 1) ((n - 1) * 8) bv) [1 .. bitSize `div` 8] 53 | 54 | mkWord' :: (Z3.MonadZ3 z3) => [Z3.AST] -> z3 Z3.AST 55 | mkWord' = foldM1 (flip Z3.mkConcat) 56 | 57 | mkBytes :: (Z3.MonadZ3 z3, Integral a, FiniteBits a) => Concolic a -> z3 [Concolic Word8] 58 | mkBytes c = do 59 | let concrete = M.mkBytes $ fromIntegral (getConcrete c) 60 | symbolic <- case getSymbolic c of 61 | Nothing -> pure $ replicate byteSize Nothing 62 | Just x -> map Just <$> mkBytes' x 63 | 64 | assert (length concrete == length symbolic) $ 65 | pure (zipWith mkConcolic concrete symbolic) 66 | where 67 | byteSize = 68 | let bitSize = finiteBitSize (getConcrete c) 69 | in assert (bitSize `mod` 8 == 0) (bitSize `div` 8) 70 | 71 | mkWord :: (Z3.MonadZ3 z3) => [Concolic Word8] -> z3 (Concolic Word32) 72 | mkWord bytes = do 73 | let concrete = M.mkWord $ map getConcrete bytes 74 | symbolic <- 75 | if any hasSymbolic bytes 76 | then Just <$> (mapM getSymbolicDef bytes >>= mkWord') 77 | else pure Nothing 78 | 79 | pure $ mkConcolic concrete symbolic 80 | 81 | ------------------------------------------------------------------------ 82 | 83 | loadByte :: (Z3.MonadZ3 z3) => Memory -> Address -> z3 (Concolic Word8) 84 | loadByte mem = liftIO . readArray (memArray mem) . toMemAddr mem 85 | 86 | loadBytes :: (Z3.MonadZ3 z3) => Memory -> Address -> Int -> z3 [Concolic Word8] 87 | loadBytes mem addr numBytes = 88 | let endAddr = fromIntegral numBytes + addr - 1 89 | in mapM (loadByte mem) [addr .. endAddr] 90 | 91 | loadHalf :: (Z3.MonadZ3 z3) => Memory -> Address -> z3 (Concolic Word16) 92 | loadHalf mem addr = loadBytes mem addr 2 >>= mkWord >>= pure . fmap fromIntegral 93 | 94 | loadWord :: (Z3.MonadZ3 z3) => Memory -> Address -> z3 (Concolic Word32) 95 | loadWord mem addr = loadBytes mem addr 4 >>= mkWord 96 | 97 | storeByte :: (Z3.MonadZ3 z3) => Memory -> Address -> Concolic Word8 -> z3 () 98 | storeByte m a = liftIO . writeArray (memArray m) (toMemAddr m a) 99 | 100 | storeBytes :: (Z3.MonadZ3 z3) => Memory -> Address -> [Concolic Word8] -> z3 () 101 | storeBytes m a = mapM_ (\(off, byte) -> storeByte m (a + off) byte) . zip [0 ..] 102 | 103 | storeHalf :: (Z3.MonadZ3 z3) => Memory -> Address -> Concolic Word16 -> z3 () 104 | storeHalf m a w = mkBytes w >>= storeBytes m a 105 | 106 | storeWord :: (Z3.MonadZ3 z3) => Memory -> Address -> Concolic Word32 -> z3 () 107 | storeWord m a w = mkBytes w >>= storeBytes m a 108 | 109 | storeByteString :: (Z3.MonadZ3 z3) => Memory -> Address -> BSL.ByteString -> z3 () 110 | storeByteString mem addr bs = 111 | mapM_ (\(off, val) -> storeByte mem (addr + off) (mkConcrete val)) $ 112 | zip [0 ..] $ 113 | BSL.unpack bs 114 | -------------------------------------------------------------------------------- /src/BinSym/Store.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeApplications #-} 2 | 3 | module BinSym.Store (Store, empty, fromModel, getConcolic, concolicBytes) where 4 | 5 | import BinSym.Concolic 6 | import Control.Exception (assert) 7 | import Control.Monad.IO.Class (MonadIO, liftIO) 8 | import Data.Bifunctor (second) 9 | import qualified Data.BitVector as BV 10 | import Data.List (intercalate) 11 | import qualified Data.Map.Strict as Map 12 | import Numeric (readHex) 13 | import System.Random (randomIO) 14 | import qualified Z3.Monad as Z3 15 | 16 | -- A variable store mapping variable names to concrete values. 17 | newtype Store = MkStore (Map.Map String BV.BV) 18 | 19 | instance Show Store where 20 | show (MkStore m) = 21 | intercalate "\n" $ 22 | map (\(k, v) -> k ++ "\t= " ++ show v) (Map.toList m) 23 | 24 | -- Create a new (empty) store. 25 | empty :: Store 26 | empty = MkStore Map.empty 27 | 28 | -- Parses the output of 'Z3.modelToString'. 29 | -- 30 | -- TODO: This is just a horrible hack, the proper solution to this 31 | -- issues requires figuring out how we can determine the variable 32 | -- names from the model using the Haskell Z3 bindings. 33 | -- 34 | -- See also: https://github.com/Z3Prover/z3/blob/1d62964c58991d78bccd9b8aa7d821f5aae77f74/src/model/model_v2_pp.cpp#L78-L81 35 | parseModel :: String -> [(String, BV.BV)] 36 | parseModel input = map (second fromZ3Hex . splitLine) (lines input) 37 | where 38 | -- Split "A0 -> #x00000001" into the ("A0, "#x00000001"). 39 | splitLine :: String -> (String, String) 40 | splitLine line = 41 | case words line of 42 | [var, _arrow, value] -> (var, value) 43 | _ -> error "unreachable" 44 | 45 | -- Parse an input string like "#x00000001" as 0x00000001. 46 | fromZ3Hex :: String -> BV.BV 47 | fromZ3Hex str = 48 | assert (length str > 2) $ 49 | let str' = drop 2 str 50 | nBits = (length str' `div` 2) * 8 51 | in case readHex @Integer str' of 52 | [(n, "")] -> BV.bitVec nBits n 53 | _ -> error "unexpected modelToString output" 54 | 55 | -- Create a variable store from a 'Z3.Model'. 56 | fromModel :: (Z3.MonadZ3 z3) => Z3.Model -> z3 Store 57 | fromModel m = Z3.modelToString m >>= (pure . MkStore . Map.fromList) . parseModel 58 | 59 | -- Lookup the variable name in the store, if it doesn't exist return a random value. 60 | getOrRand :: (MonadIO m) => Store -> String -> Int -> m BV.BV 61 | getOrRand (MkStore m) name size = do 62 | case Map.lookup name m of 63 | Just x -> pure x 64 | Nothing -> do liftIO (randomIO :: IO Integer) >>= pure . BV.bitVec size 65 | 66 | -- Obtain a unconstrained concolic value from the store. 67 | -- The concrete part is taken from the store or random. 68 | getConcolic :: (Z3.MonadZ3 z3) => Store -> String -> Int -> z3 (Concolic BV.BV) 69 | getConcolic store name size = getOrRand store name size >>= flip mkUncons name 70 | 71 | -- Obtain a list of concolic bytes from the store. 72 | -- The concrete part is taken from the store or random. 73 | concolicBytes :: (Z3.MonadZ3 z3) => Store -> String -> Int -> z3 [Concolic BV.BV] 74 | concolicBytes store name amount = 75 | mapM (\n -> getConcolic store (name ++ ":byte" ++ show n) 8) [1 .. amount] 76 | -------------------------------------------------------------------------------- /src/BinSym/Symbolic.hs: -------------------------------------------------------------------------------- 1 | module BinSym.Symbolic (evalE) where 2 | 3 | import BinSym.Util 4 | import Control.Exception (assert) 5 | import qualified LibRISCV.Effects.Expressions.Expr as E 6 | import qualified Z3.Monad as Z3 7 | 8 | -- Map a binary operation in the LibRISCV expression language to a Z3 operation. 9 | binOp :: (Z3.MonadZ3 z3) => E.Expr Z3.AST -> E.Expr Z3.AST -> (Z3.AST -> Z3.AST -> z3 Z3.AST) -> z3 Z3.AST 10 | binOp e1 e2 op = do 11 | bv1 <- evalE e1 12 | bv2 <- evalE e2 13 | op bv1 bv2 14 | 15 | {- ORMOLU_DISABLE -} 16 | evalE :: Z3.MonadZ3 z3 => E.Expr Z3.AST -> z3 Z3.AST 17 | evalE (E.FromImm e) = pure e 18 | evalE (E.FromInt n v) = Z3.mkBitvector n v 19 | evalE (E.ZExt n v) = evalE v >>= Z3.mkZeroExt n 20 | evalE (E.SExt n v) = evalE v >>= Z3.mkSignExt n 21 | evalE (E.Extract i len e) = evalE e >>= Z3.mkExtract (assert (len >= 1) $ i + (len - 1)) i 22 | evalE (E.Add e1 e2) = binOp e1 e2 Z3.mkBvadd 23 | evalE (E.Sub e1 e2) = binOp e1 e2 Z3.mkBvsub 24 | evalE (E.Eq e1 e2) = binOp e1 e2 Z3.mkEq >>= fromBool 25 | evalE (E.Slt e1 e2) = binOp e1 e2 Z3.mkBvslt >>= fromBool 26 | evalE (E.Sge e1 e2) = binOp e1 e2 Z3.mkBvsge >>= fromBool 27 | evalE (E.Ult e1 e2) = binOp e1 e2 Z3.mkBvult >>= fromBool 28 | evalE (E.Uge e1 e2) = binOp e1 e2 Z3.mkBvuge >>= fromBool 29 | evalE (E.And e1 e2) = binOp e1 e2 Z3.mkBvand 30 | evalE (E.Or e1 e2) = binOp e1 e2 Z3.mkBvor 31 | evalE (E.Xor e1 e2) = binOp e1 e2 Z3.mkBvxor 32 | evalE (E.LShl e1 e2) = binOp e1 e2 Z3.mkBvshl 33 | evalE (E.LShr e1 e2) = binOp e1 e2 Z3.mkBvlshr 34 | evalE (E.AShr e1 e2) = binOp e1 e2 Z3.mkBvashr 35 | evalE (E.Mul e1 e2) = binOp e1 e2 Z3.mkBvmul 36 | evalE (E.SDiv e1 e2) = binOp e1 e2 Z3.mkBvsdiv 37 | evalE (E.UDiv e1 e2) = binOp e1 e2 Z3.mkBvudiv 38 | evalE (E.SRem e1 e2) = binOp e1 e2 Z3.mkBvsrem 39 | evalE (E.URem e1 e2) = binOp e1 e2 Z3.mkBvurem 40 | {- ORMOLU_ENABLE -} 41 | -------------------------------------------------------------------------------- /src/BinSym/Syscall.hs: -------------------------------------------------------------------------------- 1 | module BinSym.Syscall (execSyscall) where 2 | 3 | import BinSym.ArchState 4 | import BinSym.Concolic 5 | import qualified BinSym.Memory as MEM 6 | import BinSym.Store (concolicBytes) 7 | import Control.Monad.IO.Class (liftIO) 8 | import Data.Word (Word32) 9 | import LibRISCV (Address, RegIdx (A0, A1)) 10 | import qualified LibRISCV.Effects.Operations.Default.Machine.Register as REG 11 | import Numeric (showHex) 12 | import System.Exit 13 | import qualified Z3.Monad as Z3 14 | 15 | sysExit :: Word32 -> IO () 16 | sysExit 0 = exitWith ExitSuccess 17 | sysExit c = exitWith (ExitFailure $ fromIntegral c) 18 | 19 | makeSymbolic :: (Z3.MonadZ3 z3) => ArchState -> Address -> Int -> z3 () 20 | makeSymbolic state addr size = do 21 | let name = "symbolicMemory<" ++ showHex addr ">" 22 | bytes <- concolicBytes (getStore state) name size 23 | 24 | -- TODO: Implement memory store on (Concolic BV.BV) 25 | let mem = getMem state 26 | mapM_ 27 | (\(n, x) -> MEM.storeByte mem (addr + n) (fmap fromIntegral x)) 28 | $ zip [0 ..] bytes 29 | 30 | execSyscall :: (Z3.MonadZ3 z3) => ArchState -> Word32 -> z3 () 31 | execSyscall state sysNum = do 32 | a0 <- getConcrete <$> liftIO (REG.readRegister (getRegs state) A0) 33 | a1 <- getConcrete <$> liftIO (REG.readRegister (getRegs state) A1) 34 | 35 | case sysNum of 36 | 93 -> liftIO $ sysExit a0 37 | 96 -> makeSymbolic state a0 (fromIntegral a1) 38 | _ -> liftIO $ fail "unknown syscall" 39 | -------------------------------------------------------------------------------- /src/BinSym/Tracer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | 3 | module BinSym.Tracer 4 | ( Branch, 5 | newBranch, 6 | ExecTrace, 7 | newExecTrace, 8 | appendBranch, 9 | appendCons, 10 | Tracer, 11 | newTracer, 12 | trackTrace, 13 | BTree (..), 14 | mkTree, 15 | addTrace, 16 | findUnexplored, 17 | ) 18 | where 19 | 20 | import qualified BinSym.Cond as Cond 21 | import BinSym.Util (prefixLength) 22 | import Control.Applicative ((<|>)) 23 | import qualified Z3.Monad as Z3 24 | 25 | -- Represents a branch condition in the executed code 26 | data Branch 27 | = MkBranch 28 | Bool -- Whether negation of the branch was attempted 29 | Z3.AST -- The symbolic branch condition 30 | deriving (Show, Eq) 31 | 32 | -- Create a new branch condition. 33 | newBranch :: Z3.AST -> Branch 34 | newBranch = MkBranch False 35 | 36 | -- Create a new branch from an existing branch, thereby updating its metadata. 37 | -- It is assumed that the condition, encoded in the branches, is equal. 38 | fromBranch :: Branch -> Branch -> Branch 39 | fromBranch (MkBranch wasNeg' _) (MkBranch wasNeg ast) = MkBranch (wasNeg || wasNeg') ast 40 | 41 | ------------------------------------------------------------------------ 42 | 43 | -- Represents a single execution through a program, tracking for each 44 | -- symbolic branch condition if it was 'True' or 'False'. 45 | type ExecTrace = [(Bool, Branch)] 46 | 47 | -- Create a new empty execution tree. 48 | newExecTrace :: ExecTrace 49 | newExecTrace = [] 50 | 51 | -- Append a branch to the execution trace, denoting via a 'Bool' 52 | -- if the branch was taken or if it was not taken. 53 | appendBranch :: ExecTrace -> Bool -> Branch -> ExecTrace 54 | appendBranch trace wasTrue branch = trace ++ [(wasTrue, branch)] 55 | 56 | -- Append a constraint to the execution tree. This constraint must 57 | -- be true and, contrary to appendBranch, negation will not be 58 | -- attempted for it. 59 | appendCons :: ExecTrace -> Z3.AST -> ExecTrace 60 | appendCons trace cons = trace ++ [(True, MkBranch True cons)] 61 | 62 | ------------------------------------------------------------------------ 63 | 64 | -- A binary tree. 65 | data BTree a = Node a (Maybe (BTree a)) (Maybe (BTree a)) | Leaf 66 | deriving (Show, Eq) 67 | 68 | -- Execution tree for the exeucted software, represented as follows: 69 | -- 70 | -- a 71 | -- True / \ False 72 | -- b … 73 | -- / \ 74 | -- N L 75 | -- 76 | -- where the edges indicate what happens if branch a is true/false. 77 | -- The left edge covers the true path while the right edge covers the 78 | -- false path. 79 | -- 80 | -- The Nothing (N) value indicates that a path has not been explored. 81 | -- In the example above the path `[(True, a), (True, b)]` has not been 82 | -- explored. A Leaf (L) node is used to indicate that a path has been 83 | -- explored but we haven't discored additional branches yet. In the 84 | -- example above the deepest path is hence `[(True a), (False, b)]`. 85 | type ExecTree = BTree Branch 86 | 87 | -- Returns 'True' if we can continue exploring on this branch node. 88 | -- This is the case if the node is either a 'Leaf' or 'Nothing'. 89 | canCont :: Maybe (BTree a) -> Bool 90 | canCont Nothing = True 91 | canCont (Just Leaf) = True 92 | canCont _ = False 93 | 94 | -- Create a new execution tree from a trace. 95 | mkTree :: ExecTrace -> ExecTree 96 | mkTree [] = Leaf 97 | mkTree [(wasTrue, br)] 98 | | wasTrue = Node br (Just Leaf) Nothing 99 | | otherwise = Node br Nothing (Just Leaf) 100 | mkTree ((True, br) : xs) = Node br (Just $ mkTree xs) Nothing 101 | mkTree ((False, br) : xs) = Node br Nothing (Just $ mkTree xs) 102 | 103 | -- Add a trace to an existing execution tree. The control flow 104 | -- in the trace must match the existing tree. If it diverges, 105 | -- an error is raised. 106 | -- 107 | -- This function prefers the branch nodes from the trace in the 108 | -- resulting 'ExecTree', thus allowing updating their metadata via 109 | -- this function. 110 | -- 111 | -- Assertion: The branch encode in the Node and the branch encoded in 112 | -- the trace should also be equal, regarding the encoded condition. 113 | addTrace :: ExecTree -> ExecTrace -> ExecTree 114 | addTrace tree [] = tree 115 | -- The trace takes the True branch and we have taken that previously. 116 | -- ↳ Recursively decent on that branch and look at remaining trace. 117 | addTrace (Node br' (Just tb) fb) ((True, br) : xs) = 118 | Node (fromBranch br' br) (Just $ addTrace tb xs) fb 119 | -- The trace takes the False branch and we have taken that previously. 120 | -- ↳ Recursively decent on that branch and look at remaining trace. 121 | addTrace (Node br' tb (Just fb)) ((False, br) : xs) = 122 | Node (fromBranch br' br) tb (Just $ addTrace fb xs) 123 | -- If the trace takes the True/False branch and we have not taken that 124 | -- yet (i.e. canCont is True) we insert the trace at that position. 125 | addTrace (Node br' tb fb) ((wasTrue, br) : xs) 126 | | canCont tb && wasTrue = Node (fromBranch br' br) (Just $ mkTree xs) fb 127 | | canCont fb && not wasTrue = Node (fromBranch br' br) tb (Just $ mkTree xs) 128 | | otherwise = error "unreachable" 129 | -- If we encounter a leaf, this part hasn't been explored yet. 130 | -- That is, we can just insert the trace "as is" at this point. 131 | addTrace Leaf trace = mkTree trace 132 | 133 | ------------------------------------------------------------------------ 134 | 135 | -- The 'Tracer' encapsulates data for the Dynamic Symbolic Execution (DSE) 136 | -- algorithm. Specifically for path selection and incremental solving. 137 | data Tracer 138 | = MkTracer 139 | ExecTree -- The current execution tree for the DSE algorithm 140 | ExecTrace -- The last solved trace, for incremental solving. 141 | 142 | -- Create a new empty 'Tracer' object without anything traced yet. 143 | newTracer :: Tracer 144 | newTracer = MkTracer (mkTree []) [] 145 | 146 | -- Track a new 'ExecTrace' in the 'Tracer'. 147 | trackTrace :: Tracer -> ExecTrace -> Tracer 148 | trackTrace (MkTracer tree t) trace = 149 | MkTracer (addTrace tree trace) t 150 | 151 | -- For a given execution trace, return an assignment (represented 152 | -- as a 'Z3.Model') which statisfies all symbolic branch conditions. 153 | -- If such an assignment does not exist, then 'Nothing' is returned. 154 | solveTrace :: (Z3.MonadZ3 z3) => Tracer -> ExecTrace -> z3 (Maybe Z3.Model) 155 | solveTrace (MkTracer _ oldTrace) newTrace = do 156 | -- In an 'ExecTrace' we consider the first n-1 as the path constraits, 157 | -- while the last element of an 'ExecTrace' is the condition that should 158 | -- be solved. 159 | let newCons = init newTrace 160 | let oldCons = if null oldTrace then [] else init oldTrace 161 | 162 | -- Determine the common prefix of the current trace and the old trace 163 | -- drop constraints beyond this common prefix from the current solver 164 | -- context. Thereby, keeping the common prefix and making use of Z3's 165 | -- incremental solving capabilities. 166 | let prefix = prefixLength newCons oldCons 167 | let toDrop = length oldCons - prefix 168 | Z3.solverPop toDrop 169 | 170 | -- Only enforce new constraints, i.e. those beyond the common prefix. 171 | assertTrace (drop prefix newCons) 172 | let (bool, MkBranch _ ast) = last newTrace 173 | 174 | isSAT <- Cond.new bool ast >>= Cond.check 175 | if isSAT 176 | then Just <$> Z3.solverGetModel 177 | else pure Nothing 178 | where 179 | -- Add all conditions enforced by the given 'ExecTrace' to 180 | -- the solver. Should only be called for n-1 elements of 181 | -- an 'ExecTrace' (i.e. the constraints). 182 | assertTrace [] = pure () 183 | assertTrace t = do 184 | conds <- mapM (\(b, MkBranch _ c) -> Cond.new b c) t 185 | mapM_ (\c -> Z3.solverPush >> Cond.assert c) conds 186 | 187 | -- Find an assignment (i.e. a 'Z3.Model') that causes exploration 188 | -- of a new execution path through the tested software. This 189 | -- function updates the metadata in the execution tree and thus 190 | -- returns a new execution tree, even if no satisfiable assignment 191 | -- was found. 192 | findUnexplored :: (Z3.MonadZ3 z3) => Tracer -> z3 (Maybe Z3.Model, Tracer) 193 | findUnexplored tracer@(MkTracer tree _) = do 194 | case negateBranch tree of 195 | Nothing -> pure (Nothing, tracer) 196 | Just nt -> do 197 | let nextTracer = MkTracer (addTrace tree nt) nt 198 | solveTrace tracer nt >>= \case 199 | Nothing -> findUnexplored nextTracer 200 | Just m -> pure (Just m, nextTracer) 201 | where 202 | -- Negate an unnegated branch in the execution tree and return an 203 | -- 'ExecTrace' which leads to an unexplored execution path. If no 204 | -- such path exists, then 'Nothing' is returned. If such a path 205 | -- exists a concrete variable assignment for it can be calculated 206 | -- using 'solveTrace'. 207 | -- 208 | -- The branch node metadata in the resulting 'ExecTree' is updated 209 | -- to reflect that negation of the selected branch node was attempted. 210 | -- If further branches are to be negated, the resulting trace should 211 | -- be added to the 'ExecTree' using 'addTrace' to update the metadata 212 | -- in the tree as well. 213 | negateBranch :: ExecTree -> Maybe ExecTrace 214 | negateBranch Leaf = Nothing 215 | negateBranch (Node (MkBranch wasNeg ast) Nothing _) 216 | | wasNeg = Nothing 217 | | otherwise = Just [(True, MkBranch True ast)] 218 | negateBranch (Node (MkBranch wasNeg ast) _ Nothing) 219 | | wasNeg = Nothing 220 | | otherwise = Just [(False, MkBranch True ast)] 221 | negateBranch (Node br (Just ifTrue) (Just ifFalse)) = 222 | do 223 | -- TODO: Randomly prefer either the left or right child 224 | (++) [(True, br)] <$> negateBranch ifTrue 225 | <|> (++) [(False, br)] <$> negateBranch ifFalse 226 | -------------------------------------------------------------------------------- /src/BinSym/Util.hs: -------------------------------------------------------------------------------- 1 | module BinSym.Util 2 | ( mkSymWord8, 3 | mkSymWord32, 4 | bvSize, 5 | fromBool, 6 | foldM1, 7 | copyArray, 8 | prefixLength, 9 | ) 10 | where 11 | 12 | import Control.Exception (assert) 13 | import Control.Monad (foldM) 14 | import Data.Array.Base (getNumElements, unsafeRead) 15 | import Data.Array.IO (MArray, getBounds, newListArray) 16 | import Data.Ix (Ix) 17 | import Data.Word (Word32, Word8) 18 | import qualified Z3.Monad as Z3 19 | 20 | -- Create a symbolic bitvector from a 'Word8'. 21 | mkSymWord8 :: (Z3.MonadZ3 z3) => Word8 -> z3 Z3.AST 22 | mkSymWord8 w = Z3.mkBitvector 8 (fromIntegral w) 23 | 24 | -- Create a symbolic bitvector from a 'Word32'. 25 | mkSymWord32 :: (Z3.MonadZ3 z3) => Word32 -> z3 Z3.AST 26 | mkSymWord32 w = Z3.mkBitvector 32 (fromIntegral w) 27 | 28 | -- Obtain the size for a bit-vector will crash 29 | -- if the given value is not a Z3 bit-vector. 30 | bvSize :: (Z3.MonadZ3 z3) => Z3.AST -> z3 Int 31 | bvSize ast = Z3.getSort ast >>= Z3.getBvSortSize 32 | 33 | -- Convert a predicate to a bitvector representing a truth/false 34 | -- value as defined for branch/compare instructions in RISC-V. 35 | fromBool :: (Z3.MonadZ3 z3) => Z3.AST -> z3 Z3.AST 36 | fromBool boolAst = do 37 | sort <- Z3.getSort boolAst >>= Z3.getSortKind 38 | assert (sort == Z3.Z3_BOOL_SORT) (fromBool' boolAst) 39 | where 40 | fromBool' boolAst' = do 41 | trueBV <- mkSymWord32 1 42 | falseBV <- mkSymWord32 0 43 | Z3.mkIte boolAst' trueBV falseBV 44 | 45 | -- A combination of foldM and foldl1. 46 | foldM1 :: (Monad m) => (a -> a -> m a) -> [a] -> m a 47 | foldM1 _ [] = error "empty list" 48 | foldM1 f (x : xs) = foldM f x xs 49 | 50 | -- Create a deep copy of a mutable array. 51 | copyArray :: (Ix i, MArray a e m) => a i e -> m (a i e) 52 | copyArray marr = do 53 | (l, u) <- getBounds marr 54 | n <- getNumElements marr 55 | es <- mapM (unsafeRead marr) [0 .. n - 1] 56 | newListArray (l, u) es 57 | 58 | -- Determine the length of the common prefix of two lists. 59 | prefixLength :: (Eq a) => [a] -> [a] -> Int 60 | prefixLength = prefixLength' 0 61 | where 62 | prefixLength' :: (Eq a) => Int -> [a] -> [a] -> Int 63 | prefixLength' n [] _ = n 64 | prefixLength' n _ [] = n 65 | prefixLength' n (x : xs) (y : ys) 66 | | x == y = prefixLength' (n + 1) xs ys 67 | | otherwise = n 68 | -------------------------------------------------------------------------------- /test/ConcolicExpr.hs: -------------------------------------------------------------------------------- 1 | module ConcolicExpr where 2 | 3 | import BinSym.Concolic 4 | import BinSym.Util (mkSymWord32) 5 | import Data.Maybe (fromJust) 6 | import qualified LibRISCV.Effects.Expressions.Expr as E 7 | import Test.Tasty 8 | import Test.Tasty.HUnit 9 | import Util 10 | import qualified Z3.Monad as Z3 11 | 12 | concolicTests :: TestTree 13 | concolicTests = 14 | testGroup 15 | "Concolic expression language tests" 16 | [ testCase "Add expression" $ do 17 | (c, Just s) <- Z3.evalZ3 $ do 18 | x <- mkSymbolic 4 <$> mkSymWord32 4 19 | y <- mkSymbolic 38 <$> mkSymWord32 38 20 | r <- evalE $ E.Add (E.FromImm x) (E.FromImm y) 21 | 22 | s <- getInt (fromJust $ getSymbolic r) 23 | pure (getConcrete r, s) 24 | 25 | assertEqual "Concrete part" 42 c 26 | assertEqual "Symbolic part" 42 s, 27 | testCase "Extract expression" $ do 28 | (c, Just s) <- Z3.evalZ3 $ do 29 | x <- mkSymbolic 0xdeadbeef <$> mkSymWord32 0xdeadbeef 30 | r <- evalE (E.Extract 0 16 $ E.FromImm x) 31 | 32 | s <- Z3.simplify (fromJust $ getSymbolic r) >>= getInt 33 | pure (getConcrete r, s) 34 | 35 | assertEqual "Concrete part" 0xbeef c 36 | assertEqual "Symbolic part" 0xbeef s 37 | ] 38 | -------------------------------------------------------------------------------- /test/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import ConcolicExpr 4 | import Memory 5 | import SymbolicExpr 6 | import Test.Tasty 7 | import Tracer 8 | 9 | main :: IO () 10 | main = defaultMain tests 11 | 12 | tests :: TestTree 13 | tests = 14 | testGroup 15 | "Tests" 16 | [ symbolicTests, 17 | concolicTests, 18 | memoryTests, 19 | tracerTests 20 | ] 21 | -------------------------------------------------------------------------------- /test/Memory.hs: -------------------------------------------------------------------------------- 1 | module Memory where 2 | 3 | import BinSym.Concolic 4 | import BinSym.Memory 5 | import BinSym.Util 6 | import Test.Tasty 7 | import Test.Tasty.HUnit 8 | import Util 9 | import qualified Z3.Monad as Z3 10 | 11 | memoryTests :: TestTree 12 | memoryTests = 13 | testGroup 14 | "Memory tests" 15 | [ testCase "Write and read byte" $ do 16 | (c, s) <- Z3.evalZ3 $ do 17 | mem <- mkMemory 0x0 512 18 | 19 | value <- mkSymbolic 0xab <$> mkSymWord8 0xab 20 | storeByte mem 0x0 value 21 | 22 | loadByte mem 0x0 >>= concPair 23 | 24 | assertEqual "concrete part" 0xab c 25 | assertEqual "symbolic part" 0xab s, 26 | testCase "Write and read word" $ do 27 | (c, s) <- Z3.evalZ3 $ do 28 | mem <- mkMemory 0x0 4 29 | 30 | value <- mkSymbolic 0xdeadbeef <$> mkSymWord32 0xdeadbeef 31 | storeWord mem 0x0 value 32 | 33 | loadWord mem 0x0 >>= concPair 34 | 35 | assertEqual "concrete part" 0xdeadbeef c 36 | assertEqual "symbolic part" 0xdeadbeef s, 37 | testCase "Load individual bytes of word" $ do 38 | lst <- Z3.evalZ3 $ do 39 | mem <- mkMemory 0x32 64 40 | 41 | value <- mkSymbolic 0xdeadbeef <$> mkSymWord32 0xdeadbeef 42 | storeWord mem 0x32 value 43 | 44 | concs <- mapM (\off -> loadByte mem (0x32 + off)) [0 .. 3] 45 | mapM concPair concs 46 | 47 | assertEqual "" [(0xef, 0xef), (0xbe, 0xbe), (0xad, 0xad), (0xde, 0xde)] lst, 48 | testCase "Single symbolic byte in word" $ do 49 | (c, s) <- Z3.evalZ3 $ do 50 | mem <- mkMemory 0x0 4 51 | 52 | let b0 = mkConcrete 0xde 53 | let b1 = mkConcrete 0xad 54 | b2 <- mkSymbolic 0xbe <$> mkSymWord8 0xff 55 | let b3 = mkConcrete 0xef 56 | 57 | storeByte mem 0x0 b3 58 | storeByte mem 0x1 b2 59 | storeByte mem 0x2 b1 60 | storeByte mem 0x3 b0 61 | 62 | loadWord mem 0x0 >>= concPair 63 | 64 | assertEqual "concrete part" 0xdeadbeef c 65 | assertEqual "symbolic part" 0xdeadffef s 66 | ] 67 | -------------------------------------------------------------------------------- /test/SymbolicExpr.hs: -------------------------------------------------------------------------------- 1 | module SymbolicExpr where 2 | 3 | import qualified BinSym.Cond as Cond 4 | import BinSym.Symbolic (evalE) 5 | import BinSym.Util 6 | import qualified LibRISCV.Effects.Expressions.Expr as E 7 | import Test.Tasty 8 | import Test.Tasty.HUnit 9 | import Util 10 | import qualified Z3.Monad as Z3 11 | 12 | symbolicTests :: TestTree 13 | symbolicTests = 14 | testGroup 15 | "Symbolic expression language tests" 16 | [ testCase "Equality expression" $ do 17 | (Just neq) <- Z3.evalZ3 $ do 18 | x <- mkSymWord32 42 19 | y <- mkSymWord32 23 20 | 21 | evalE (E.Eq (E.FromImm x) (E.FromImm y)) >>= getInt 22 | 23 | (Just eq) <- Z3.evalZ3 $ do 24 | x <- mkSymWord32 42 25 | y <- mkSymWord32 42 26 | 27 | evalE (E.Eq (E.FromImm x) (E.FromImm y)) >>= getInt 28 | 29 | assertEqual "must not be equal" 0 neq 30 | assertEqual "must be equal" 1 eq, 31 | testCase "Extract expression" $ do 32 | v <- Z3.evalZ3 $ do 33 | w <- mkSymWord32 0xdeadbeef 34 | evalE (E.Extract 0 16 $ E.FromImm w) >>= Z3.simplify >>= getWord32 35 | 36 | assertEqual "must be first half" 0xbeef v, 37 | testCase "Extract constant" $ do 38 | v <- Z3.evalZ3 $ do 39 | w <- mkSymWord32 42 40 | evalE (E.FromImm w) >>= getWord32 41 | 42 | assertEqual "" 42 v, 43 | testCase "Byte sign extension" $ do 44 | (Just v) <- Z3.evalZ3 $ do 45 | x <- mkSymWord8 0xef 46 | evalE (E.SExt 24 (E.FromImm x)) >>= getInt 47 | 48 | assertEqual "sign extended lsb" 0xffffffef v, 49 | testCase "Check statisfability" $ do 50 | res <- Z3.evalZ3 $ do 51 | x <- mkSymWord32 5 52 | y <- mkSymWord32 5 53 | 54 | eq <- evalE (E.Eq (E.FromImm x) (E.FromImm y)) 55 | f <- Cond.new True eq >>= Cond.check 56 | s <- Cond.new False eq >>= Cond.check 57 | pure (f, s) 58 | 59 | assertEqual "must be true" True (fst res) 60 | assertEqual "must not be false" False (snd res) 61 | ] 62 | -------------------------------------------------------------------------------- /test/Tracer.hs: -------------------------------------------------------------------------------- 1 | module Tracer where 2 | 3 | import BinSym.Tracer 4 | import BinSym.Util 5 | import Test.Tasty 6 | import Test.Tasty.HUnit 7 | import qualified Z3.Monad as Z3 8 | 9 | tracerTests :: TestTree 10 | tracerTests = 11 | testGroup 12 | "Tracer tests" 13 | [ testCase "Create a new tree from a trace" $ do 14 | (c, t) <- Z3.evalZ3 $ do 15 | cond <- mkSymWord32 1 16 | let trace = [(True, newBranch cond)] 17 | pure (cond, mkTree trace) 18 | 19 | assertEqual "" (Node (newBranch c) (Just Leaf) Nothing) t, 20 | testCase "Add trace to empty tree" $ do 21 | (c, t) <- Z3.evalZ3 $ do 22 | let tree = mkTree [] 23 | 24 | cond <- mkSymWord32 1 25 | let trace = [(True, newBranch cond)] 26 | pure (cond, addTrace tree trace) 27 | 28 | assertEqual "" (Node (newBranch c) (Just Leaf) Nothing) t, 29 | testCase "Explore unexplored false branch in root" $ do 30 | (c, t) <- Z3.evalZ3 $ do 31 | cond <- mkSymWord32 1 32 | let trace = [(True, newBranch cond)] 33 | 34 | let tree = mkTree trace 35 | let newTree = addTrace tree [(False, newBranch cond)] 36 | 37 | pure (cond, newTree) 38 | 39 | assertEqual "" (Node (newBranch c) (Just Leaf) (Just Leaf)) t, 40 | testCase "Follow path and explore new branch" $ do 41 | (c1, c2, t) <- Z3.evalZ3 $ do 42 | cond1 <- mkSymWord32 1 43 | cond2 <- mkSymWord32 0 44 | 45 | let trace = [(True, newBranch cond1)] 46 | let tree = mkTree trace 47 | 48 | let newTree = addTrace tree (appendBranch trace True $ newBranch cond2) 49 | pure (cond1, cond2, newTree) 50 | 51 | assertEqual 52 | "" 53 | ( Node 54 | (newBranch c1) 55 | ( Just 56 | ( Node 57 | (newBranch c2) 58 | (Just Leaf) 59 | Nothing 60 | ) 61 | ) 62 | Nothing 63 | ) 64 | t 65 | ] 66 | -------------------------------------------------------------------------------- /test/Util.hs: -------------------------------------------------------------------------------- 1 | module Util where 2 | 3 | import BinSym.Concolic 4 | import Data.Bits (FiniteBits) 5 | import Data.Maybe (catMaybes, fromJust) 6 | import Data.Word (Word32) 7 | import qualified Z3.Monad as Z3 8 | 9 | mkSymbolic :: a -> Z3.AST -> Concolic a 10 | mkSymbolic c s = MkConcolic c (Just s) 11 | 12 | concPair :: (Z3.MonadZ3 z3, FiniteBits a, Integral a) => Concolic a -> z3 (a, Integer) 13 | concPair conc = do 14 | s <- getInt (fromJust $ getSymbolic conc) 15 | let c = getConcrete conc 16 | pure (c, fromJust s) 17 | 18 | getInts :: (Z3.MonadZ3 z3) => [Z3.AST] -> z3 (Maybe [Integer]) 19 | getInts values = 20 | fmap snd $ Z3.withModel $ \m -> 21 | catMaybes <$> mapM (Z3.evalBv False m) values 22 | 23 | getInt :: (Z3.MonadZ3 z3) => Z3.AST -> z3 (Maybe Integer) 24 | getInt v = do 25 | ints <- getInts [v] 26 | pure $ head <$> ints 27 | 28 | -- Extract a Word32 from a Z3 bit-vector. 29 | getWord32 :: (Z3.MonadZ3 z3) => Z3.AST -> z3 Word32 30 | getWord32 ast = fromIntegral <$> Z3.getInt ast 31 | --------------------------------------------------------------------------------