foxdec-0.1.0.0: Formally Verified x86-64 Decompilation
Safe HaskellNone
LanguageHaskell2010

Data.SymbolicExpression

Description

A datatype for symbolic predicates, tailored to storing information on equalities between the current values stored in state parts (lhs) and constant expressions (rhs).

Synopsis

Documentation

data StatePart Source #

A statepart is either a register or a region in memory

Constructors

SP_StackPointer String

The stack pointer of the given function

SP_Reg Register

A register

SP_Mem SimpleExpr Int

A region with a symbolic address and an immediate size.

Instances

Instances details
Eq StatePart Source # 
Instance details

Defined in Data.SymbolicExpression

Ord StatePart Source # 
Instance details

Defined in Data.SymbolicExpression

Show StatePart Source # 
Instance details

Defined in Data.SymbolicExpression

Generic StatePart Source # 
Instance details

Defined in Data.SymbolicExpression

Associated Types

type Rep StatePart :: Type -> Type #

ToJSON StatePart Source # 
Instance details

Defined in OutputGeneration.JSON

ToJSONKey StatePart Source # 
Instance details

Defined in OutputGeneration.JSON

Serialize StatePart Source # 
Instance details

Defined in Data.SymbolicExpression

NFData StatePart Source # 
Instance details

Defined in Data.SymbolicExpression

Methods

rnf :: StatePart -> () #

type Rep StatePart Source # 
Instance details

Defined in Data.SymbolicExpression

data SimpleExpr Source #

A symbolic expression with as leafs either immediates, variables, live values of stateparts, or malloced addresses. A variable is a constant representing some initial value, e.g., RDI_0, or [RSP_0,8]_0. A statepart evaluates to its current value, e.g., RDI or [RSP,8].

Constructors

SE_Immediate Word64

An immediate word

SE_Var StatePart

A variable representing the initial value stored in the statepart (e.g., RSP0)

SE_StatePart StatePart

The value stored currently in the statepart

SE_Malloc (Maybe Word64) (Maybe String)

A malloc return value with possibly an ID

SE_Op Operator Int [SimpleExpr]

Application of an Operator to the list of arguments

SE_Bit Int SimpleExpr

Taking the lower bits of a value

SE_SExtend Int Int SimpleExpr

Sign extension

SE_Overwrite Int SimpleExpr SimpleExpr

Overwriting certain bits of a value with bits from another value

Bottom BotTyp

Bottom (unknown value)

Instances

Instances details
Eq SimpleExpr Source # 
Instance details

Defined in Data.SymbolicExpression

Ord SimpleExpr Source # 
Instance details

Defined in Data.SymbolicExpression

Show SimpleExpr Source # 
Instance details

Defined in Data.SymbolicExpression

Generic SimpleExpr Source # 
Instance details

Defined in Data.SymbolicExpression

Associated Types

type Rep SimpleExpr :: Type -> Type #

ToJSON SimpleExpr Source # 
Instance details

Defined in OutputGeneration.JSON

Serialize SimpleExpr Source # 
Instance details

Defined in Data.SymbolicExpression

NFData SimpleExpr Source # 
Instance details

Defined in Data.SymbolicExpression

Methods

rnf :: SimpleExpr -> () #

type Rep SimpleExpr Source # 
Instance details

Defined in Data.SymbolicExpression

type Rep SimpleExpr = D1 ('MetaData "SimpleExpr" "Data.SymbolicExpression" "foxdec-0.1.0.0-F8J4QQ8bsQELJyhc4kJb0m" 'False) (((C1 ('MetaCons "SE_Immediate" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Word64)) :+: C1 ('MetaCons "SE_Var" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 StatePart))) :+: (C1 ('MetaCons "SE_StatePart" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 StatePart)) :+: C1 ('MetaCons "SE_Malloc" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe Word64)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe String))))) :+: ((C1 ('MetaCons "SE_Op" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Operator) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 [SimpleExpr]))) :+: C1 ('MetaCons "SE_Bit" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 SimpleExpr))) :+: (C1 ('MetaCons "SE_SExtend" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 SimpleExpr))) :+: (C1 ('MetaCons "SE_Overwrite" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Int) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 SimpleExpr) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 SimpleExpr))) :+: C1 ('MetaCons "Bottom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 BotTyp))))))

data FlagStatus Source #

Symbolically represent the status of all flags in the current state

Constructors

None

No information known, flags could have any value

FS_CMP (Maybe Bool) Operand Operand

The flags are set by the x86 CMP instruction applied to the given operands.

Instances

Instances details
Eq FlagStatus Source # 
Instance details

Defined in Data.SymbolicExpression

Ord FlagStatus Source # 
Instance details

Defined in Data.SymbolicExpression

Show FlagStatus Source # 
Instance details

Defined in Data.SymbolicExpression

Generic FlagStatus Source # 
Instance details

Defined in Data.SymbolicExpression

Associated Types

type Rep FlagStatus :: Type -> Type #

Serialize FlagStatus Source # 
Instance details

Defined in Data.SymbolicExpression

NFData FlagStatus Source # 
Instance details

Defined in Data.SymbolicExpression

Methods

rnf :: FlagStatus -> () #

type Rep FlagStatus Source # 
Instance details

Defined in Data.SymbolicExpression

data BotTyp Source #

Bot represents an unknown (bottom) value. We annotate each occurence of Bot with a BotTyp. This type indicates where the bottom value originates from. The latter six are all equal, we just use them for debugging and information. They indicate that the value is unknown, but was computed using the set of sources.

Constructors

FromNonDeterminism (NESet SimpleExpr)

The expression evaluates to one of the expressions in the set

FromPointerBases (NESet PointerBase)

The expression is a pointer-computation with known base(s)

FromCall String

Return value of a function call

FromSources (NESet BotSrc)

The expression is some computation based on sources.

FromOverlap (NESet BotSrc)

A read from two possibly overlapping regions

FromMemWrite (NESet BotSrc)

A write to two possibly overlapping regions

FromSemantics (NESet BotSrc)

An instruction with unknown semantics

FromBitMode (NESet BotSrc)

Should not happen, but if a register writes to a registeralias with unknown bit size

FromUninitializedMemory (NESet BotSrc)

Reading from memory not written to yet

Instances

Instances details
Eq BotTyp Source # 
Instance details

Defined in Data.SymbolicExpression

Methods

(==) :: BotTyp -> BotTyp -> Bool #

(/=) :: BotTyp -> BotTyp -> Bool #

Ord BotTyp Source # 
Instance details

Defined in Data.SymbolicExpression

Show BotTyp Source # 
Instance details

Defined in Data.SymbolicExpression

Generic BotTyp Source # 
Instance details

Defined in Data.SymbolicExpression

Associated Types

type Rep BotTyp :: Type -> Type #

Methods

from :: BotTyp -> Rep BotTyp x #

to :: Rep BotTyp x -> BotTyp #

ToJSON BotTyp Source # 
Instance details

Defined in OutputGeneration.JSON

Serialize BotTyp Source # 
Instance details

Defined in Data.SymbolicExpression

NFData BotTyp Source # 
Instance details

Defined in Data.SymbolicExpression

Methods

rnf :: BotTyp -> () #

type Rep BotTyp Source # 
Instance details

Defined in Data.SymbolicExpression

type Rep BotTyp = D1 ('MetaData "BotTyp" "Data.SymbolicExpression" "foxdec-0.1.0.0-F8J4QQ8bsQELJyhc4kJb0m" 'False) (((C1 ('MetaCons "FromNonDeterminism" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (NESet SimpleExpr))) :+: C1 ('MetaCons "FromPointerBases" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (NESet PointerBase)))) :+: (C1 ('MetaCons "FromCall" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 String)) :+: C1 ('MetaCons "FromSources" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (NESet BotSrc))))) :+: ((C1 ('MetaCons "FromOverlap" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (NESet BotSrc))) :+: C1 ('MetaCons "FromMemWrite" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (NESet BotSrc)))) :+: (C1 ('MetaCons "FromSemantics" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (NESet BotSrc))) :+: (C1 ('MetaCons "FromBitMode" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (NESet BotSrc))) :+: C1 ('MetaCons "FromUninitializedMemory" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (NESet BotSrc)))))))

data BotSrc Source #

Sources that may be used to compute an expression. That is, the inputs to an expression.

Constructors

Src_Var StatePart

An initial variable, i.e., a constant

Src_StackPointer String

The stack pointer of the given function

Src_Malloc (Maybe Word64) (Maybe String)

A malloced address

Src_ImmediateAddress Word64

An immediate used in the computation of the pointer

Src_Function String

A return value from a function

Src_Mem (NESet BotSrc)

reading from memory

Src_ImmediateConstants

Some immediate value

Instances

Instances details
Eq BotSrc Source # 
Instance details

Defined in Data.SymbolicExpression

Methods

(==) :: BotSrc -> BotSrc -> Bool #

(/=) :: BotSrc -> BotSrc -> Bool #

Ord BotSrc Source # 
Instance details

Defined in Data.SymbolicExpression

Show BotSrc Source # 
Instance details

Defined in Data.SymbolicExpression

Generic BotSrc Source # 
Instance details

Defined in Data.SymbolicExpression

Associated Types

type Rep BotSrc :: Type -> Type #

Methods

from :: BotSrc -> Rep BotSrc x #

to :: Rep BotSrc x -> BotSrc #

ToJSON BotSrc Source # 
Instance details

Defined in OutputGeneration.JSON

Serialize BotSrc Source # 
Instance details

Defined in Data.SymbolicExpression

NFData BotSrc Source # 
Instance details

Defined in Data.SymbolicExpression

Methods

rnf :: BotSrc -> () #

type Rep BotSrc Source # 
Instance details

Defined in Data.SymbolicExpression

data Operator Source #

An operator is a pure operation over bit-vectors, annotated with the bit-size of its operands. For example, Plus 64 denotes 64-bit addition. Udiv and Times are operators op type w -> w -> w with all words same length. Div and Div_Rem are operators of type w -> w -> w -> w performing concatenation of the first two words and then doing division/remainder.

Constructors

Minus 
Plus 
Times 
And 
Or 
Xor 
Not 
Bsr 
Div_Rem 
Div 
Shl 
Shr 
Sar 
Udiv 
Ror 
Rol 
Bswap 
Pextr 

Instances

Instances details
Eq Operator Source # 
Instance details

Defined in Data.SymbolicExpression

Ord Operator Source # 
Instance details

Defined in Data.SymbolicExpression

Show Operator Source # 
Instance details

Defined in Data.SymbolicExpression

Generic Operator Source # 
Instance details

Defined in Data.SymbolicExpression

Associated Types

type Rep Operator :: Type -> Type #

Methods

from :: Operator -> Rep Operator x #

to :: Rep Operator x -> Operator #

ToJSON Operator Source # 
Instance details

Defined in OutputGeneration.JSON

Serialize Operator Source # 
Instance details

Defined in Data.SymbolicExpression

NFData Operator Source # 
Instance details

Defined in Data.SymbolicExpression

Methods

rnf :: Operator -> () #

type Rep Operator Source # 
Instance details

Defined in Data.SymbolicExpression

type Rep Operator = D1 ('MetaData "Operator" "Data.SymbolicExpression" "foxdec-0.1.0.0-F8J4QQ8bsQELJyhc4kJb0m" 'False) ((((C1 ('MetaCons "Minus" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Plus" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Times" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "And" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Or" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Xor" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Not" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Bsr" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Div_Rem" 'PrefixI 'False) (U1 :: Type -> Type))))) :+: (((C1 ('MetaCons "Div" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Shl" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Shr" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Sar" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Udiv" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Ror" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Rol" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Bswap" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Pextr" 'PrefixI 'False) (U1 :: Type -> Type))))))

data PointerBase Source #

A pointerbase is a positive addend of a symbolic expression that may represent a pointer.

Constructors

StackPointer String

The stack frame of the given function

Malloc (Maybe Word64) (Maybe String)

A malloc (at the heap) at a given address (hash is unused for now)

GlobalAddress Word64

A global address in the range of the sections of the binary.

PointerToSymbol Word64 String

An address with an associated symbol.

ThreadLocalStorage

A pointer to the thread-local-storage (e.g., FS register)

Instances

Instances details
Eq PointerBase Source # 
Instance details

Defined in Data.SymbolicExpression

Ord PointerBase Source # 
Instance details

Defined in Data.SymbolicExpression

Show PointerBase Source # 
Instance details

Defined in Data.SymbolicExpression

Generic PointerBase Source # 
Instance details

Defined in Data.SymbolicExpression

Associated Types

type Rep PointerBase :: Type -> Type #

ToJSON PointerBase Source # 
Instance details

Defined in OutputGeneration.JSON

Serialize PointerBase Source # 
Instance details

Defined in Data.SymbolicExpression

NFData PointerBase Source # 
Instance details

Defined in Data.SymbolicExpression

Methods

rnf :: PointerBase -> () #

type Rep PointerBase Source # 
Instance details

Defined in Data.SymbolicExpression

is_immediate :: SimpleExpr -> Bool Source #

Returns true iff the expression is an immediate value

is_mem_sp :: StatePart -> Bool Source #

Is the statepart memory?

is_reg_sp :: StatePart -> Bool Source #

Is the statepart a register?

contains_bot :: SimpleExpr -> Bool Source #

Returns true iff the expression contains Bot

contains_bot_sp :: StatePart -> Bool Source #

Returns true iff the statepart contains Bot

all_bot_satisfy :: (BotTyp -> Bool) -> SimpleExpr -> Bool Source #

concatMap function p over all bottom values in the expression

simp :: SimpleExpr -> SimpleExpr Source #

Simplification of symbolic expressions.

Must always produce an expression logically equivalent to the original.

pp_expr :: SimpleExpr -> [Char] Source #

Pretty print expression, showing Bottom expressions only as Bot

sextend_32_64 :: (Bits p, Num p) => p -> p Source #

Sign-extension from 32 to 64 bits

sextend_16_64 :: (Bits p, Num p) => p -> p Source #

Sign-extension from 16 to 64 bits

sextend_8_64 :: (Bits p, Num p) => p -> p Source #

Sign-extension from 8 to 64 bits