{-# LANGUAGE DuplicateRecordFields #-}

-- |
-- Module      : Binja.AnalysisContext
-- Description : Central abstraction
-- License     : MIT
-- Maintainer  : hello@bloombit.dev
-- Stability   : alpha
--
-- @Binja.AnalysisContext@ extracts and lifts low level types from binary ninja into Beluga's central
-- abstraction. This is the recommended interface for most users.
--
-- [/Reasons not to use:/]
--
-- * Less data than AnalysisContext provides is required and have limited hardware.
-- * AnalysisContext is fixed to the SSA variant of Medium Level IL.
--
-- [/Reasons to use:/]
--
-- * Extracts and lifts the common types required by most program analysis in a single call.
-- * Abstracts away many low level FFI calls and types.
-- * Creates a single type that can be queried in pure functions (no further IO calls required for most analysis).
--   This lends itself to making things easier in creating parallel code.
module Binja.AnalysisContext
  ( Binja.AnalysisContext.create,
    Binja.AnalysisContext.symbolAt,
    Binja.AnalysisContext.callers,
    Binja.AnalysisContext.extractCallDestSymbol,
    Binja.AnalysisContext.close,
  )
where

import Binja.BinaryView
import Binja.ControlFlowGraph
import Binja.Function
import Binja.Mlil
import Binja.Types
import Data.Map as Map
import Data.Maybe (catMaybes)
import Data.Set as Set

-- |
--
-- Derive an AnalysisContext from a given filename and json-formatted binja options.
--
-- Warning: every function contains a MLIL SSA variant; otherwise this function will
-- throw an exception.
--
-- Suggested minimum settings:
--
--   * Set analysis.mode.maxFunctionSize to 0 (disables max function size)
--   * Set analysis.mode.maxFunctionAnalysisTime to 0 (disables timeouts)
--   * Set analysis.mode` to intermediate to disable HLIL generation
create ::
  -- | Filename to an executable or an existing binja database (bndb)
  String ->
  -- | Options in json format
  String ->
  IO AnalysisContext
create :: String -> String -> IO AnalysisContext
create String
filename String
options = do
  viewHandle' <- String -> String -> IO BNBinaryViewPtr
Binja.BinaryView.load String
filename String
options
  functions' <- Binja.BinaryView.functions viewHandle'
  functionContexts <- mapM createFunctionContext functions'
  symbols' <- Binja.BinaryView.symbols viewHandle'
  strings' <- catMaybes <$> Binja.BinaryView.strings viewHandle'
  pure
    AnalysisContext
      { viewHandle = viewHandle',
        functions = functionContexts,
        symbols = symbols',
        strings = strings'
      }

createFunctionContext :: BNFunctionPtr -> IO FunctionContext
createFunctionContext :: BNFunctionPtr -> IO FunctionContext
createFunctionContext BNFunctionPtr
handle' = do
  mlilSSAHandle <- BNFunctionPtr -> IO BNMlilSSAFunctionPtr
Binja.Function.mlilSSA BNFunctionPtr
handle'
  start' <- Binja.Function.start handle'
  symbol' <- Binja.Function.symbol handle'
  auto' <- Binja.Function.auto handle'
  instructions' <- Binja.Mlil.instructionsFromFuncNoChildren mlilSSAHandle
  ssaVariables' <- Binja.Function.ssaVars mlilSSAHandle
  ssaVarContext' <- Map.fromList <$> mapM (\BNSSAVariable
l -> BNSSAVariable
-> BNMlilSSAFunctionPtr -> IO (BNSSAVariable, SSAVariableContext)
createSSAVariableContext BNSSAVariable
l BNMlilSSAFunctionPtr
mlilSSAHandle) ssaVariables'
  aliasedVars' <- Binja.Function.aliasedVars mlilSSAHandle
  parameterVars' <- Binja.Function.parameterVars mlilSSAHandle
  architecture' <- Binja.Function.architecture mlilSSAHandle
  cfg' <- Binja.ControlFlowGraph.create mlilSSAHandle
  pure
    FunctionContext
      { handle = mlilSSAHandle,
        start = start',
        symbol = symbol',
        auto = auto',
        ssaVars = ssaVarContext',
        parameterVars = parameterVars',
        aliasedVars = aliasedVars',
        instructions = instructions',
        architecture = architecture',
        cfg = cfg'
      }

createSSAVariableContext :: BNSSAVariable -> BNMlilSSAFunctionPtr -> IO (BNSSAVariable, SSAVariableContext)
createSSAVariableContext :: BNSSAVariable
-> BNMlilSSAFunctionPtr -> IO (BNSSAVariable, SSAVariableContext)
createSSAVariableContext BNSSAVariable
var' BNMlilSSAFunctionPtr
func = do
  defSite' <- BNSSAVariable
-> BNMlilSSAFunctionPtr -> IO (Maybe MediumLevelILSSAInstruction)
Binja.Mlil.defSite BNSSAVariable
var' BNMlilSSAFunctionPtr
func
  useSites' <- Binja.Mlil.useSites var' func
  pure $ (var', SSAVariableContext {defSite = defSite', useSites = useSites'})

-- | Acquire the symbol at address if one exists.
symbolAt :: AnalysisContext -> Word64 -> Maybe Symbol
symbolAt :: AnalysisContext -> Word64 -> Maybe Symbol
symbolAt AnalysisContext {symbols :: AnalysisContext -> [Symbol]
symbols = [Symbol]
syms} Word64
requestAddr =
  case (Symbol -> Bool) -> [Symbol] -> [Symbol]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter ((Word64
requestAddr Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
==) (Word64 -> Bool) -> (Symbol -> Word64) -> Symbol -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Word64
address) [Symbol]
syms of
    [] -> Maybe Symbol
forall a. Maybe a
Nothing
    [Symbol
sym] -> Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just Symbol
sym
    [Symbol]
_ -> String -> Maybe Symbol
forall a. HasCallStack => String -> a
error (String -> Maybe Symbol) -> String -> Maybe Symbol
forall a b. (a -> b) -> a -> b
$ String
"Binja.AnalysisContext.symbolAt: Multiple symbols at: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
requestAddr

-- Convert Constant instruction to symbol if possible
constantToSymbol :: AnalysisContext -> Constant -> Maybe Symbol
constantToSymbol :: AnalysisContext -> Constant -> Maybe Symbol
constantToSymbol AnalysisContext
context (MediumLevelILConstPtr (MediumLevelILConstPtrRec {constant :: MediumLevelILConstPtrRec -> Int
constant = Int
c})) = do
  AnalysisContext -> Word64 -> Maybe Symbol
Binja.AnalysisContext.symbolAt AnalysisContext
context (Word64 -> Maybe Symbol) -> Word64 -> Maybe Symbol
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c
constantToSymbol AnalysisContext
context (MediumLevelILImport (MediumLevelILImportRec {constant :: MediumLevelILImportRec -> Int
constant = Int
c})) = do
  AnalysisContext -> Word64 -> Maybe Symbol
Binja.AnalysisContext.symbolAt AnalysisContext
context (Word64 -> Maybe Symbol) -> Word64 -> Maybe Symbol
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c
constantToSymbol AnalysisContext
_ (MediumLevelILConst (MediumLevelILConstRec {constant :: MediumLevelILConstRec -> Int
constant = Int
c})) = do
  String -> Maybe Symbol
forall a. HasCallStack => String -> a
error (String -> Maybe Symbol) -> String -> Maybe Symbol
forall a b. (a -> b) -> a -> b
$ String
"Unhandled constant: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c
constantToSymbol AnalysisContext
_ (MediumLevelILFloatConst MediumLevelILFloatConstRec {constant :: MediumLevelILFloatConstRec -> Double
constant = Double
c}) = do
  String -> Maybe Symbol
forall a. HasCallStack => String -> a
error (String -> Maybe Symbol) -> String -> Maybe Symbol
forall a b. (a -> b) -> a -> b
$ String
"Unhandled float constant: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
c
constantToSymbol AnalysisContext
_ (MediumLevelILConstData MediumLevelILConstDataRec {constant :: MediumLevelILConstDataRec -> BNDataBufferPtr
constant = BNDataBufferPtr
c}) = do
  String -> Maybe Symbol
forall a. HasCallStack => String -> a
error (String -> Maybe Symbol) -> String -> Maybe Symbol
forall a b. (a -> b) -> a -> b
$ String
"Unhandled constant data: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ BNDataBufferPtr -> String
forall a. Show a => a -> String
show BNDataBufferPtr
c
constantToSymbol AnalysisContext
context (MediumLevelILExternPtr MediumLevelILExternPtrRec {constant :: MediumLevelILExternPtrRec -> Int
constant = Int
c}) = do
  AnalysisContext -> Word64 -> Maybe Symbol
Binja.AnalysisContext.symbolAt AnalysisContext
context (Word64 -> Maybe Symbol) -> Word64 -> Maybe Symbol
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c

-- |
--  Given a call instruction attempt to recover the destination symbol (symbol that is called).
--  There are many patterns that could occur. Currently only constant destinations are supported.
--  In the future a cocktail of patterns will be supported. Further reading: <https://dl.acm.org/doi/10.1145/3622833 A Cocktail Approach to Practical Call Graph Construction>
extractCallDestSymbol :: AnalysisContext -> MediumLevelILSSAInstruction -> Maybe Symbol
extractCallDestSymbol :: AnalysisContext -> MediumLevelILSSAInstruction -> Maybe Symbol
extractCallDestSymbol AnalysisContext
context MediumLevelILSSAInstruction
callInst =
  case MediumLevelILSSAInstruction
callInst of
    Localcall Localcall
lc ->
      case Localcall
lc of
        (MediumLevelILCall MediumLevelILCallRec {dest :: MediumLevelILCallRec -> MediumLevelILSSAInstruction
dest = MediumLevelILSSAInstruction
d}) -> MediumLevelILSSAInstruction -> Maybe Symbol
processDest MediumLevelILSSAInstruction
d
        (MediumLevelILCallSsa MediumLevelILCallSsaRec {dest :: MediumLevelILCallSsaRec -> MediumLevelILSSAInstruction
dest = MediumLevelILSSAInstruction
d}) -> MediumLevelILSSAInstruction -> Maybe Symbol
processDest MediumLevelILSSAInstruction
d
        (MediumLevelILCallUntypedSsa MediumLevelILCallUntypedSsaRec {dest :: MediumLevelILCallUntypedSsaRec -> MediumLevelILSSAInstruction
dest = MediumLevelILSSAInstruction
d}) -> MediumLevelILSSAInstruction -> Maybe Symbol
processDest MediumLevelILSSAInstruction
d
        (MediumLevelILCallUntyped MediumLevelILCallUntypedRec {dest :: MediumLevelILCallUntypedRec -> MediumLevelILSSAInstruction
dest = MediumLevelILSSAInstruction
d}) -> MediumLevelILSSAInstruction -> Maybe Symbol
processDest MediumLevelILSSAInstruction
d
    Tailcall Tailcall
tc ->
      case Tailcall
tc of
        (MediumLevelILTailcallUntyped MediumLevelILTailcallUntypedRec {dest :: MediumLevelILTailcallUntypedRec -> MediumLevelILSSAInstruction
dest = MediumLevelILSSAInstruction
d}) -> MediumLevelILSSAInstruction -> Maybe Symbol
processDest MediumLevelILSSAInstruction
d
        (MediumLevelILTailcall MediumLevelILTailcallRec {dest :: MediumLevelILTailcallRec -> MediumLevelILSSAInstruction
dest = MediumLevelILSSAInstruction
d}) -> MediumLevelILSSAInstruction -> Maybe Symbol
processDest MediumLevelILSSAInstruction
d
        (MediumLevelILTailcallSsa MediumLevelILTailcallSsaRec {dest :: MediumLevelILTailcallSsaRec -> MediumLevelILSSAInstruction
dest = MediumLevelILSSAInstruction
d}) -> MediumLevelILSSAInstruction -> Maybe Symbol
processDest MediumLevelILSSAInstruction
d
        (MediumLevelILTailcallUntypedSsa MediumLevelILTailcallUntypedSsaRec {dest :: MediumLevelILTailcallUntypedSsaRec -> MediumLevelILSSAInstruction
dest = MediumLevelILSSAInstruction
d}) -> MediumLevelILSSAInstruction -> Maybe Symbol
processDest MediumLevelILSSAInstruction
d
    MediumLevelILSSAInstruction
_ -> String -> Maybe Symbol
forall a. HasCallStack => String -> a
error (String -> Maybe Symbol) -> String -> Maybe Symbol
forall a b. (a -> b) -> a -> b
$ String
"Binja.AnalysisContext.extractCallDestSymbol: unhandled instruction: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ MediumLevelILSSAInstruction -> String
forall a. Show a => a -> String
show MediumLevelILSSAInstruction
callInst
  where
    processDest :: MediumLevelILSSAInstruction -> Maybe Symbol
    processDest :: MediumLevelILSSAInstruction -> Maybe Symbol
processDest MediumLevelILSSAInstruction
dest' =
      case MediumLevelILSSAInstruction
dest' of
        Constant Constant
c -> AnalysisContext -> Constant -> Maybe Symbol
Binja.AnalysisContext.constantToSymbol AnalysisContext
context Constant
c
        MediumLevelILSSAInstruction
_ -> Maybe Symbol
forall a. Maybe a
Nothing

-- |
-- Given a function context iterate all instructions to:
--
--   * Find call instructions
--   * Resolve symbols which are called when possible via extractCallDestSymbol
--
-- __Assumption__: It is assumed the function context is present in the functions
-- field of AnalysisContext.
callers :: AnalysisContext -> FunctionContext -> Set.Set Symbol
callers :: AnalysisContext -> FunctionContext -> Set Symbol
callers AnalysisContext
analysisContext FunctionContext
functionContext =
  [Symbol] -> Set Symbol
forall a. Ord a => [a] -> Set a
Set.fromList ([Symbol] -> Set Symbol) -> [Symbol] -> Set Symbol
forall a b. (a -> b) -> a -> b
$
    [Maybe Symbol] -> [Symbol]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Symbol] -> [Symbol]) -> [Maybe Symbol] -> [Symbol]
forall a b. (a -> b) -> a -> b
$
      (MediumLevelILSSAInstruction -> Maybe Symbol)
-> [MediumLevelILSSAInstruction] -> [Maybe Symbol]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (AnalysisContext -> MediumLevelILSSAInstruction -> Maybe Symbol
Binja.AnalysisContext.extractCallDestSymbol AnalysisContext
analysisContext) ([MediumLevelILSSAInstruction] -> [Maybe Symbol])
-> [MediumLevelILSSAInstruction] -> [Maybe Symbol]
forall a b. (a -> b) -> a -> b
$
        (MediumLevelILSSAInstruction -> Bool)
-> [MediumLevelILSSAInstruction] -> [MediumLevelILSSAInstruction]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter MediumLevelILSSAInstruction -> Bool
isCall ([MediumLevelILSSAInstruction] -> [MediumLevelILSSAInstruction])
-> [MediumLevelILSSAInstruction] -> [MediumLevelILSSAInstruction]
forall a b. (a -> b) -> a -> b
$
          [[MediumLevelILSSAInstruction]] -> [MediumLevelILSSAInstruction]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MediumLevelILSSAInstruction]] -> [MediumLevelILSSAInstruction])
-> [[MediumLevelILSSAInstruction]] -> [MediumLevelILSSAInstruction]
forall a b. (a -> b) -> a -> b
$
            (MediumLevelILSSAInstruction -> [MediumLevelILSSAInstruction])
-> [MediumLevelILSSAInstruction] -> [[MediumLevelILSSAInstruction]]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map MediumLevelILSSAInstruction -> [MediumLevelILSSAInstruction]
Binja.Mlil.children ([MediumLevelILSSAInstruction] -> [[MediumLevelILSSAInstruction]])
-> [MediumLevelILSSAInstruction] -> [[MediumLevelILSSAInstruction]]
forall a b. (a -> b) -> a -> b
$
              FunctionContext -> [MediumLevelILSSAInstruction]
Binja.Types.instructions FunctionContext
functionContext
  where
    isCall :: MediumLevelILSSAInstruction -> Bool
    isCall :: MediumLevelILSSAInstruction -> Bool
isCall (Localcall Localcall
_) = Bool
True
    isCall (Tailcall Tailcall
_) = Bool
True
    isCall (Syscall Syscall
_) = Bool
True
    isCall MediumLevelILSSAInstruction
_ = Bool
False

-- |
--  Must be called once finished with an AnalysisContext to avoid handle leak.
--  Suggested pattern: <https://wiki.haskell.org/Bracket_pattern Bracket Pattern>
close :: AnalysisContext -> IO ()
close :: AnalysisContext -> IO ()
close = BNBinaryViewPtr -> IO ()
Binja.BinaryView.close (BNBinaryViewPtr -> IO ())
-> (AnalysisContext -> BNBinaryViewPtr) -> AnalysisContext -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnalysisContext -> BNBinaryViewPtr
viewHandle