GaloisInc/macaw
1
1
Fork 0
mirror of https://github.com/GaloisInc/macaw.git synced 2024-11-23 16:35:02 +03:00
Code Issues Projects Releases Wiki Activity

Add support for additional ARM relocations.

Browse Source
This commit is contained in:
Joe Hendrix 2019-08-01 09:43:36 -07:00
parent 7342970d3d
commit dfd92b047a
No known key found for this signature in database
GPG Key ID: 8DFA5FF784098C4F
1 changed files with 395 additions and 284 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

679
base/src/Data/Macaw/Memory/ElfLoader.hs
View File

@ -43,7 +43,6 @@ import qualified Data.ByteString.Lazy as L
import Data.Either
import Data.ElfEdit
( ElfWordType
, ElfIntType
, Elf
, elfSections
, elfLayout
@ -144,8 +143,10 @@ data RelocationError
-- ^ We do not support this type of relocation.
| RelocationFileUnsupported
-- ^ We do not allow relocations to refer to the "file" as in Elf.
| RelocationInvalidAddend !String !Integer
| RelocationInvalidAddend !String !Integer !SymbolIdentifier
-- ^ The relocation type given does not allow the adddend with the given value.
| RelocationEvenAddend !String !Integer !BSC.ByteString !Integer
-- ^ The relocation type must have an even addend.
| RelocationDynamicError Elf.DynamicError
-- ^ Parsing the dynamic section failed when resolving a symbol.
@ -156,12 +157,16 @@ instance Show RelocationError where
"A relocation entry referred to invalid 0 symbol index."
show (RelocationBadSymbolIndex idx) =
"A relocation entry referred to invalid symbol index " ++ show idx ++ "."
show (RelocationUnsupportedType _tp) =
"Unsupported relocation type."
show (RelocationUnsupportedType tp) =
"Unsupported relocation type " ++ tp
show RelocationFileUnsupported =
"Do not support relocations referring to file entry."
show (RelocationInvalidAddend tp v) =
"Do not support addend of " ++ show v ++ " with relocation type " ++ tp ++ "."
show (RelocationEvenAddend tp addr sym addend) =
let tgt = show sym ++ " + " ++ show addend
in "The " ++ tp ++ " relocation applied to " ++ show addr
++ " with target " ++ tgt ++ " must have an even addend."
show (RelocationInvalidAddend tp v sym) =
"Do not support addend of " ++ show v ++ " with relocation type " ++ tp ++ " to " ++ show sym ++ "."
show (RelocationDynamicError e) = show e
------------------------------------------------------------------------
@ -187,9 +192,19 @@ data MemLoadWarning
| MultipleRelocationTables
-- ^ Issued if the file contains multiple relocation tables.
| RelocationParseFailure !String
| DynamicTagsOutOfRange !Elf.ElfDynamicTag !Elf.ElfDynamicTag !Word64 !Word64
-- ^ The range referenced by the dynamic tags was range.
| DynamicTagPairMismatch !Elf.ElfDynamicTag !Elf.ElfDynamicTag
-- ^ We expected either both tags or neither.
| DynamicMultipleTags !Elf.ElfDynamicTag
-- ^ We expected at most a single value of the given tag, but failed multiple.
| AndroidRelWithNonzeroAddend
-- ^ The `DT_ANDROID_REL` section contains Android relocations with non-zero addends.
| AndroidRelDecodingError !Elf.ElfDynamicTag !Elf.AndroidDecodeError
-- ^ We could not decode the table identified by the given dynamic tag.
| MultipleRelocationsAtAddr !Word64
-- ^ Multiple relocations at the given offset
| IgnoreRelocation !Integer !String !RelocationError
| IgnoreRelocation !RelocationError
-- ^ @IgnoreRelocation idx tp err@ warns we ignored the location at index @idx@ due to @err@.
--
-- @tp@ is a string representing the type which we print, because usually errors come because
@ -234,11 +249,21 @@ instance Show MemLoadWarning where
"File contains multiple relocation tables; these are being merged."
show (RelocationParseFailure msg) =
"Error parsing relocations: " ++ msg
show (IgnoreRelocation idx typeName err) =
"Ignoring relocation " ++ show idx ++ " with type " ++ typeName ++ ": " ++ show err
show (DynamicTagsOutOfRange offTag szTag off sz) =
show offTag ++ " and " ++ show szTag ++ " referenced a range [" ++ show (toInteger off)
++ " to " ++ show (toInteger off + toInteger sz) ++ "that is outside the file bounds."
show (DynamicTagPairMismatch foundTag notfoundTag) =
"Found " ++ show foundTag ++ " but missing " ++ show notfoundTag ++ "."
show (DynamicMultipleTags tag) =
"Multiple values assigned to " ++ show tag ++ " in dynamic information."
show AndroidRelWithNonzeroAddend =
"The DT_ANDROID_REL region in the dynamic is ignoring relocations with non-zero addends."
show (AndroidRelDecodingError tag nm) =
"The " ++ show tag ++ " region generated decoding error: " ++ show nm
show (MultipleRelocationsAtAddr addr) =
"Multiple relocations modify " ++ showHex addr "."
show (IgnoreRelocation err) =
show err
data MemLoaderState w = MLS { _mlsMemory :: !(Memory w)
, mlsEndianness :: !Endianness
@ -318,123 +343,6 @@ runSymbolResolver m = do
symbolWarning :: MemLoadWarning -> SymbolResolver ()
symbolWarning w = modify $ \l -> w:l
------------------------------------------------------------------------
-- Defined symbol resolution
resolveDefinedSymbolPrec :: SymbolName -> Elf.ElfSymbolBinding -> SymbolResolver SymbolPrecedence
resolveDefinedSymbolPrec _ Elf.STB_LOCAL =
pure SymbolLocal
resolveDefinedSymbolPrec _ Elf.STB_WEAK =
pure SymbolWeak
resolveDefinedSymbolPrec _ Elf.STB_GLOBAL =
pure SymbolStrong
resolveDefinedSymbolPrec nm bnd = do
symbolWarning $ UnknownDefinedSymbolBinding nm bnd
pure SymbolStrong
symbolDefTypeMap :: Map Elf.ElfSymbolType SymbolDefType
symbolDefTypeMap = Map.fromList
[ (,) Elf.STT_OBJECT SymbolDefObject
, (,) Elf.STT_FUNC SymbolDefFunc
, (,) Elf.STT_TLS SymbolDefThreadLocal
, (,) Elf.STT_GNU_IFUNC SymbolDefIFunc
, (,) Elf.STT_NOTYPE SymbolDefNoType
]
mkDefinedSymbol :: SymbolName
-> Elf.ElfSymbolBinding
-> SymbolDefType
-> SymbolResolver SymbolBinding
mkDefinedSymbol nm bnd tp = do
prec <- resolveDefinedSymbolPrec nm bnd
pure $! DefinedSymbol prec tp
resolveDefinedSymbolDef :: ElfSymbolTableEntry wtp
-> SymbolResolver SymbolBinding
resolveDefinedSymbolDef sym = do
let nm = Elf.steName sym
let bnd = Elf.steBind sym
let idx = Elf.steIndex sym
case Elf.steType sym of
Elf.STT_SECTION
| idx < Elf.SHN_LOPROC -> do
when (nm /= "") $
symbolWarning $ ExpectedSectionSymbolNameEmpty nm
when (bnd /= Elf.STB_LOCAL) $
symbolWarning ExpectedSectionSymbolLocal
pure $ SymbolSection (Elf.fromElfSectionIndex idx)
| otherwise -> do
symbolWarning $ InvalidSectionSymbolIndex idx
mkDefinedSymbol nm bnd SymbolDefUnknown
Elf.STT_FILE -> do
pure $ SymbolFile nm
tp -> do
dtp <-
case Map.lookup tp symbolDefTypeMap of
Just dtp ->
pure dtp
Nothing -> do
symbolWarning $ UnknownDefinedSymbolType nm tp
pure SymbolDefUnknown
mkDefinedSymbol nm bnd dtp
------------------------------------------------------------------------
-- Resolve symbols from elf info
resolveUndefinedSymbolReq :: SymbolName
-> Elf.ElfSymbolBinding
-> SymbolResolver SymbolRequirement
resolveUndefinedSymbolReq _ Elf.STB_WEAK =
pure SymbolOptional
resolveUndefinedSymbolReq _ Elf.STB_GLOBAL =
pure SymbolRequired
resolveUndefinedSymbolReq nm bnd = do
symbolWarning $ UnknownUndefinedSymbolBinding nm bnd
pure SymbolRequired
resolveUndefinedSymbolType :: SymbolName -> Elf.ElfSymbolType -> SymbolResolver SymbolUndefType
resolveUndefinedSymbolType nm tp =
case tp of
Elf.STT_NOTYPE -> pure SymbolUndefNoType
Elf.STT_OBJECT -> pure SymbolUndefObject
Elf.STT_FUNC -> pure SymbolUndefFunc
Elf.STT_TLS -> pure SymbolUndefThreadLocal
_ -> do
symbolWarning $ UnknownUndefinedSymbolType nm tp
pure SymbolUndefNoType
------------------------------------------------------------------------
-- Resolve symbol information
-- | Create a symbol ref from Elf versioned symbol from a shared
-- object or executable.
mkSymbolRef :: ElfSymbolTableEntry wtp
-> SymbolVersion -- ^ Version to use for symbol.
-> SymbolResolver SymbolInfo
mkSymbolRef sym ver = seq sym $ seq ver $ do
let nm = Elf.steName sym
def <-
case Elf.steIndex sym of
Elf.SHN_UNDEF -> do
UndefinedSymbol
<$> resolveUndefinedSymbolReq nm (Elf.steBind sym)
<*> resolveUndefinedSymbolType nm (Elf.steType sym)
Elf.SHN_ABS -> do
resolveDefinedSymbolDef sym
Elf.SHN_COMMON -> do
resolveDefinedSymbolDef sym
idx | idx < Elf.SHN_LOPROC -> do
resolveDefinedSymbolDef sym
idx -> do
symbolWarning $ UnsupportedProcessorSpecificSymbolIndex nm idx
UndefinedSymbol SymbolRequired
<$> resolveUndefinedSymbolType nm (Elf.steType sym)
pure $!
SymbolInfo { symbolName = Elf.steName sym
, symbolVersion = ver
, symbolDef = def
}
------------------------------------------------------------------------
-- SymbolTable
@ -445,15 +353,42 @@ mkSymbolRef sym ver = seq sym $ seq ver $ do
-- section doesn't provide an explicit number of symbol table
-- elements, and we decided not to depend on meta data such as section
-- names that could be stripped from executables/shared objects.
newtype SymbolTable = SymbolTable { resolveSymbol :: Word32 -> SymbolResolver SymbolInfo }
data SymbolTable w
= NoSymbolTable
| StaticSymbolTable !(V.Vector (ElfSymbolTableEntry (Elf.ElfWordType w)))
| DynamicSymbolTable !(Elf.DynamicSection w)
-- | Construct a symbol table that just reports a missing symbol table error on lookups.
noSymTab :: SymbolTable
noSymTab = SymbolTable $ \_symIdx -> throwError MissingSymbolTable
-- | Take a symbol entry and symbol version and return the identifier.
resolveSymbolId :: ElfSymbolTableEntry wtp
-> SymbolVersion
-> SymbolResolver SymbolIdentifier
resolveSymbolId sym ver = do
let nm = Elf.steName sym
let idx = Elf.steIndex sym
case Elf.steType sym of
Elf.STT_SECTION
| idx < Elf.SHN_LOPROC -> do
when (nm /= "") $
symbolWarning $ ExpectedSectionSymbolNameEmpty nm
when (Elf.steBind sym /= Elf.STB_LOCAL) $
symbolWarning ExpectedSectionSymbolLocal
pure $ SectionIdentifier (Elf.fromElfSectionIndex idx)
| otherwise -> do
symbolWarning $ InvalidSectionSymbolIndex idx
pure $ SymbolRelocation nm ver
Elf.STT_FILE -> do
throwError RelocationFileUnsupported
_tp -> do
when (idx >= Elf.SHN_LOPROC && idx `notElem` [Elf.SHN_ABS, Elf.SHN_COMMON]) $ do
symbolWarning $ UnsupportedProcessorSpecificSymbolIndex nm idx
pure $ SymbolRelocation nm ver
-- | Construct symbol table from a static list of symbol table entries.
staticSymTab :: V.Vector (ElfSymbolTableEntry tp) -> SymbolTable
staticSymTab entries = SymbolTable $ \symIdx -> do
resolveSymbol :: SymbolTable w
-> Word32
-> SymbolResolver (ElfSymbolTableEntry (Elf.ElfWordType w), SymbolVersion)
resolveSymbol NoSymbolTable _symIdx =
throwError MissingSymbolTable
resolveSymbol (StaticSymbolTable entries) symIdx = do
when (symIdx == 0) $
throwError RelocationZeroSymbol
case entries V.!? fromIntegral symIdx of
@ -471,13 +406,10 @@ staticSymTab entries = SymbolTable $ \symIdx -> do
-- Otherwise "@" appears in the symbol, and this is a non-default symbol.
| otherwise =
ObjectNonDefaultSymbol (BSC.drop (i+1) nm)
mkSymbolRef (sym { Elf.steName = BSC.take i nm }) ver
pure (sym { Elf.steName = BSC.take i nm }, ver)
Nothing -> do
mkSymbolRef sym UnversionedSymbol
-- | Use dynamic section to create symbol table function.
dynamicSymbolTable :: Elf.DynamicSection w -> SymbolTable
dynamicSymbolTable ds = SymbolTable $ \symIdx -> do
pure (sym, UnversionedSymbol)
resolveSymbol (DynamicSymbolTable ds) symIdx = do
when (symIdx == 0) $
throwError RelocationZeroSymbol
case Elf.dynSymEntry ds symIdx of
@ -487,7 +419,7 @@ dynamicSymbolTable ds = SymbolTable $ \symIdx -> do
Elf.VersionLocal -> UnversionedSymbol
Elf.VersionGlobal -> UnversionedSymbol
Elf.VersionSpecific elfVer -> VersionedSymbol (Elf.verFile elfVer) (Elf.verName elfVer)
mkSymbolRef sym ver
pure (sym, ver)
------------------------------------------------------------------------
-- Relocations
@ -501,7 +433,7 @@ type RelocationResolver tp
= Maybe SegmentIndex
-- ^ Index of segment in which this relocation will be applied if this is
-- a dynamic relocation, and `Nothing` otherwise.
-> SymbolTable
-> SymbolTable (Elf.RelocationWidth tp)
-> Elf.RelEntry tp
-- ^ Relocation information
-> MemWord (Elf.RelocationWidth tp)
@ -518,29 +450,26 @@ data SomeRelocationResolver w
. (Elf.IsRelocationType tp, w ~ Elf.RelocationWidth tp)
=> SomeRelocationResolver (RelocationResolver tp)
-- T is 1 if the target symbol S has type STT_FUNC and the symbol addresses a Thumb instruction; it is 0 otherwise.
-- | This attempts to resolve an index in the symbol table to the
-- identifier information needed to resolve its loaded address.
resolveRelocationSym :: SymbolTable
resolveRelocationSym :: SymbolTable w
-- ^ A vector mapping symbol indices to the
-- associated symbol information.
-> Word32
-- ^ Index in the symbol table this refers to.
-> SymbolResolver SymbolIdentifier
resolveRelocationSym symtab symIdx = do
sym <- resolveSymbol symtab symIdx
case symbolDef sym of
DefinedSymbol{} ->
pure $ SymbolRelocation (symbolName sym) (symbolVersion sym)
SymbolSection idx ->
pure $ SectionIdentifier idx
SymbolFile _ ->
throwError RelocationFileUnsupported
UndefinedSymbol{} ->
pure $ SymbolRelocation (symbolName sym) (symbolVersion sym)
(symEntry, ver) <- resolveSymbol symtab symIdx
resolveSymbolId symEntry ver
-- | Attempt to resolve an X86_64 specific symbol.
relaTargetX86_64 :: Maybe SegmentIndex
-> SymbolTable -- ^ Symbol table to look up symbols in/
-> SymbolTable 64
-- ^ Symbol table to look up symbols in/
-> Elf.RelEntry Elf.X86_64_RelocationType
-> MemWord 64
-- ^ Addend to add to symbol.
@ -632,33 +561,51 @@ relaTargetX86_64 _ symtab rel addend _isRel =
tp -> throwError $ RelocationUnsupportedType (show tp)
-- | Generate an absolute 32-bit relocation.
relocARM32Abs :: Endianness
-> SymbolTable 32 -- ^ Symbol table
-> Elf.RelEntry Elf.ARM32_RelocationType -- ^ Relocation entry
-> MemWord 32
-> SymbolResolver (Relocation 32)
relocARM32Abs end symtab rel addend = do
(symEntry, ver) <- resolveSymbol symtab (Elf.relSym rel)
sym <- resolveSymbolId symEntry ver
-- These relocation relocations can apply to code or data, but we
-- want to ensure relocations do not change the thumb bit
-- of the symbol.
when (Elf.steType symEntry == Elf.STT_FUNC && addend `testBit` 0) $ do
let tp = show (Elf.relType rel)
let addr = toInteger (Elf.relAddr rel)
throwError $
RelocationEvenAddend tp addr (Elf.steName symEntry) (toInteger addend)
pure $! Relocation { relocationSym = sym
, relocationOffset = addend
, relocationIsRel = False
, relocationSize = 4
, relocationIsSigned = False
, relocationEndianness = end
, relocationJumpSlot = False
}
-- | Attempt to resolve an X86_64 specific symbol.
relaTargetARM32 :: Endianness
-- ^ Endianness of relocations
-> Maybe SegmentIndex
-- ^ Index of segment for dynamic relocations
-> SymbolTable -- ^ Symbol table
-> Elf.RelEntry Elf.ARM32_RelocationType -- ^ Relocaiton entry
-> MemWord 32
-- ^ Addend of symbol
-> RelFlag
-> SymbolResolver (Relocation 32)
-> Maybe SegmentIndex
-- ^ Index of segment for dynamic relocations
-> SymbolTable 32 -- ^ Symbol table
-> Elf.RelEntry Elf.ARM32_RelocationType -- ^ Relocation entry
-> MemWord 32
-- ^ Addend of symbol
-> RelFlag
-> SymbolResolver (Relocation 32)
relaTargetARM32 end msegIndex symtab rel addend relFlag =
case Elf.relType rel of
-- A static 32-bit absolute relocation
Elf.R_ARM_ABS32 -> do
relocARM32Abs end symtab rel addend
-- A dynamic 32-bit absolute relocation that typically applies to data.
Elf.R_ARM_GLOB_DAT -> do
sym <- resolveRelocationSym symtab (Elf.relSym rel)
-- Check that least-significant bit of addend is 0 so that we do
-- not change thumb bit of symbol.
when (addend `testBit` 0) $ do
throwError $ RelocationInvalidAddend (show (Elf.relType rel)) (toInteger addend)
pure $! Relocation { relocationSym = sym
, relocationOffset = addend
, relocationIsRel = False
, relocationSize = 4
, relocationIsSigned = False
, relocationEndianness = end
, relocationJumpSlot = False
}
relocARM32Abs end symtab rel addend
Elf.R_ARM_RELATIVE -> do
-- This relocation has the value B(S) + A where
-- - A is the addend for the relocation, and
@ -686,7 +633,6 @@ relaTargetARM32 end msegIndex symtab rel addend relFlag =
pure $! SegmentBaseAddr idx
else do
resolveRelocationSym symtab (Elf.relSym rel)
pure $! Relocation { relocationSym = sym
, relocationOffset = addend - fromIntegral linktimeAddr
, relocationIsRel = False
@ -698,15 +644,13 @@ relaTargetARM32 end msegIndex symtab rel addend relFlag =
Elf.R_ARM_JUMP_SLOT -> do
-- This is a PLT relocation
sym <- resolveRelocationSym symtab (Elf.relSym rel)
let actualAddend =
case relFlag of
IsRel -> 0
IsRela -> addend
-- Check that addend is 0 so that we do not change thumb bit of symbol.
when (actualAddend /= 0) $ do
throwError $ RelocationInvalidAddend (show (Elf.relType rel)) (toInteger actualAddend)
-- For rela entries, check that addend is 0
-- N.B. Rel entries read from the target bits, and these typically point to the
-- start of the PLT, but are otherwise ignored for relocation purposes.
when (relFlag == IsRela && addend /= 0) $ do
throwError $ RelocationInvalidAddend (show (Elf.relType rel)) (toInteger addend) sym
pure $! Relocation { relocationSym = sym
, relocationOffset = actualAddend
, relocationOffset = 0
, relocationIsRel = False
, relocationSize = 4
, relocationIsSigned = False
@ -716,37 +660,103 @@ relaTargetARM32 end msegIndex symtab rel addend relFlag =
tp -> do
throwError $ RelocationUnsupportedType (show tp)
-- | Attempt to resolve an X86_64 specific symbol.
relaTargetARM64 :: Endianness
-- ^ Endianness of relocations
-> Maybe SegmentIndex
-- ^ Index of segment for dynamic relocations
-> SymbolTable -- ^ Symbol table
-> SymbolTable 64 -- ^ Symbol table
-> Elf.RelEntry Elf.AArch64_RelocationType -- ^ Relocaiton entry
-> MemWord 64
-- ^ Addend of symbol
-> RelFlag
-> SymbolResolver (Relocation 64)
relaTargetARM64 end _msegIndex symtab rel addend relFlag =
relaTargetARM64 end msegIndex symtab rel addend relFlag =
case Elf.relType rel of
Elf.R_AARCH64_ABS64 -> do
sym <- resolveRelocationSym symtab (Elf.relSym rel)
pure $! Relocation { relocationSym = sym
, relocationOffset = addend
, relocationIsRel = False
, relocationSize = 8
, relocationIsSigned = False
, relocationEndianness = end
, relocationJumpSlot = False
}
Elf.R_AARCH64_GLOB_DAT -> do
sym <- resolveRelocationSym symtab (Elf.relSym rel)
pure $! Relocation { relocationSym = sym
, relocationOffset = addend
, relocationIsRel = False
, relocationSize = 8
, relocationIsSigned = False
, relocationEndianness = end
, relocationJumpSlot = False
}
Elf.R_AARCH64_RELATIVE -> do
-- This relocation has the value B(S) + A where
-- - A is the addend for the relocation, and
-- - B(S) with S ≠ 0 resolves to the difference between the
-- address at which the segment defining the symbol S was
-- loaded and the address at which it was linked.
-- - B(S) with S = 0 resolves to the difference between the
-- address at which the segment being relocated was loaded
-- and the address at which it was linked.
--
-- Since the address at which it was linked is a constant, we
-- create a non-relative address but subtract the link address
-- from the offset.
-- Get the address at which it was linked so we can subtract from offset.
let linktimeAddr = Elf.relAddr rel
-- Resolve the symbol using the index in the relocation.
sym <-
if Elf.relSym rel == 0 then do
case msegIndex of
Nothing -> do
throwError $ RelocationZeroSymbol
Just idx ->
pure $! SegmentBaseAddr idx
else do
resolveRelocationSym symtab (Elf.relSym rel)
pure $! Relocation { relocationSym = sym
, relocationOffset = addend - fromIntegral linktimeAddr
, relocationIsRel = False
, relocationSize = 8
, relocationIsSigned = False
, relocationEndianness = end
, relocationJumpSlot = False
}
Elf.R_AARCH64_JUMP_SLOT -> do
-- This is a PLT relocation
sym <- resolveRelocationSym symtab (Elf.relSym rel)
let actualAddend =
case relFlag of
IsRel -> 0
IsRela -> addend
-- Check that addend is 0
when (actualAddend /= 0) $ do
throwError $ RelocationInvalidAddend (show (Elf.relType rel)) (toInteger actualAddend)
-- For rela entries, check that addend is 0
-- N.B. Rel entries read from the target bits, and these typically point to the
-- start of the PLT, but are otherwise ignored for relocation purposes.
when (relFlag == IsRela && addend /= 0) $ do
throwError $ RelocationInvalidAddend (show (Elf.relType rel)) (toInteger addend) sym
pure $! Relocation { relocationSym = sym
, relocationOffset = actualAddend
, relocationOffset = 0
, relocationIsRel = False
, relocationSize = 8
, relocationIsSigned = False
, relocationEndianness = end
, relocationJumpSlot = True
}
Elf.R_AARCH64_GLOB_DAT -> do
sym <- resolveRelocationSym symtab (Elf.relSym rel)
pure $! Relocation { relocationSym = sym
, relocationOffset = addend
, relocationIsRel = False
, relocationSize = 8
, relocationIsSigned = False
, relocationEndianness = end
, relocationJumpSlot = False
}
tp -> do
throwError $ RelocationUnsupportedType (show tp)
@ -777,17 +787,17 @@ resolveRela :: ( MemWidth w
, Elf.IsRelocationType tp
, Integral (Elf.ElfIntType w)
)
=> SymbolTable
=> SymbolTable w
-> RelocationResolver tp
-> Integer -- ^ Index of relocation
-> Elf.RelaEntry tp
-> ResolveFn (MemLoader w) w
resolveRela symtab resolver relaIdx rela msegIdx _ = do
resolveRela symtab resolver _relaIdx rela msegIdx _ = do
er <- runSymbolResolver $
resolver msegIdx symtab (Elf.relaToRel rela) (fromIntegral (Elf.relaAddend rela)) IsRela
case er of
Left e -> do
addWarning (IgnoreRelocation relaIdx (show (Elf.relaType rela)) e)
addWarning (IgnoreRelocation e)
pure Nothing
Right r -> do
pure $ Just r
@ -797,12 +807,12 @@ resolveRel :: ( MemWidth w
, Elf.IsRelocationType tp
)
=> Endianness -- ^ Endianness of Elf file
-> SymbolTable -- ^ Symbol table
-> SymbolTable w -- ^ Symbol table
-> RelocationResolver tp
-> Integer -- ^ Index of relocation
-> Elf.RelEntry tp
-> ResolveFn (MemLoader w) w
resolveRel end symtab resolver relIdx rel msegIdx bytes = do
resolveRel end symtab resolver _relIdx rel msegIdx bytes = do
-- Get the number of bits in the addend
let bits = Elf.relocTargetBits (Elf.relType rel)
-- Compute the addended by masking off the low order bits, and
@ -819,7 +829,7 @@ resolveRel end symtab resolver relIdx rel msegIdx bytes = do
er <- runSymbolResolver $ resolver msegIdx symtab rel (fromInteger saddend) IsRel
case er of
Left e -> do
addWarning (IgnoreRelocation relIdx (show (Elf.relType rel)) e)
addWarning (IgnoreRelocation e)
pure Nothing
Right r -> do
pure $ Just r
@ -830,77 +840,63 @@ relocTargetBytes :: (Elf.IsRelocationType tp, MemWidth (Elf.RelocationWidth tp))
relocTargetBytes tp = fromIntegral $ (Elf.relocTargetBits tp + 7) `shiftR` 3
relocFromRela :: ( Elf.IsRelocationType tp
, w ~ Elf.RelocationWidth tp
, MemWidth w
, Integral (ElfIntType w)
, Integral (ElfWordType w)
)
=> SymbolTable
-> RelocationResolver tp
-> Integer -- ^ Index of relocation entry for error reporting
-> Elf.RelaEntry tp
-> (MemWord w, RelocEntry (MemLoader w) w)
relocFromRela symtab resolver idx r =
( fromIntegral (Elf.relaAddr r)
, RelocEntry { relocEntrySize = relocTargetBytes (Elf.relaType r)
, applyReloc = resolveRela symtab resolver idx r
}
)
relocFromRel :: ( Elf.IsRelocationType tp
, w ~ Elf.RelocationWidth tp
, MemWidth w
, Integral (ElfWordType w)
)
=> Endianness
-> SymbolTable
-> RelocationResolver tp
-> Integer -- ^ Index of relocation entry for error reporting.
-> Elf.RelEntry tp
-> (MemWord w, RelocEntry (MemLoader w) w)
relocFromRel end symtab resolver idx r =
( fromIntegral (Elf.relAddr r)
, RelocEntry { relocEntrySize = relocTargetBytes (Elf.relType r)
, applyReloc = resolveRel end symtab resolver idx r
}
)
-- | Maps address that relocations apply to to the relocation information.
type RelocMap w = Map (MemWord w) (RelocEntry (MemLoader w) w)
-- | Add a relocation entry to the map.
addRelocEntry :: RelocMap w
-> (MemWord w, RelocEntry (MemLoader w) w)
-> MemWord w
-> RelocEntry (MemLoader w) w
-> MemLoader w (RelocMap w)
addRelocEntry m (addr, e) =
addRelocEntry m addr e =
case Map.insertLookupWithKey (\_k _new old -> old) addr e m of
(Nothing, m') -> pure m'
(Just _, _) -> do
addWarning $ MultipleRelocationsAtAddr (memWordValue addr)
pure m
addRelocEntries :: RelocMap w
-> [(MemWord w, RelocEntry (MemLoader w) w)]
-> MemLoader w (RelocMap w)
addRelocEntries = foldlM addRelocEntry
-- | Add a relocation entry to the map.
addRelaEntry :: (Elf.IsRelocationType tp, w ~ Elf.RelocationWidth tp)
=> SymbolTable w
-> RelocationResolver tp
-> (Integer, RelocMap w)
-> Elf.RelaEntry tp
-> MemLoader w (Integer, RelocMap w)
addRelaEntry symtab resolver (idx,m) r = do
w <- uses mlsMemory memAddrWidth
reprConstraints w $ do
let addr = fromIntegral (Elf.relaAddr r)
e = RelocEntry { relocEntrySize = relocTargetBytes (Elf.relaType r)
, applyReloc = resolveRela symtab resolver idx r
}
(idx+1,) <$> addRelocEntry m addr e
addRelaEntries :: (Elf.IsRelocationType tp, w ~ Elf.RelocationWidth tp)
=> RelocMap w
-> SymbolTable w
-- ^ Map from symbol indices to associated symbol
-> RelocationResolver tp
-- Resolver for relocations
-> [Elf.RelaEntry tp]
-- ^ Buffer containing relocation entries in Rel format
-> MemLoader w (RelocMap w)
addRelaEntries m symtab resolver entries = do
snd <$> foldlM (addRelaEntry symtab resolver) (0,m) entries
-- | Add rela relocation entries to map.
addRelaEntries :: (Elf.IsRelocationType tp, w ~ Elf.RelocationWidth tp)
=> RelocMap w
-> Elf.ElfData
addElfRelaEntries :: (Elf.IsRelocationType tp, w ~ Elf.RelocationWidth tp)
=> RelocMap w
-> Elf.ElfData
-- ^ Endianness
-> RelocationResolver tp
-> SymbolTable
-- ^ Map from symbol indices to associated symbol
-> Maybe L.ByteString
-- ^ Buffer containing relocation entries in Rela format
-> MemLoader w (RelocMap w)
addRelaEntries m _ _ _ Nothing =
-> RelocationResolver tp
-> SymbolTable w
-- ^ Map from symbol indices to associated symbol
-> Maybe L.ByteString
-- ^ Buffer containing relocation entries in Rela format
-> MemLoader w (RelocMap w)
addElfRelaEntries m _ _ _ Nothing =
pure m
addRelaEntries m dta resolver symtab (Just relaBuffer) = do
addElfRelaEntries m dta resolver symtab (Just relaBuffer) = do
w <- uses mlsMemory memAddrWidth
reprConstraints w $ do
case Elf.elfRelaEntries dta relaBuffer of
@ -908,23 +904,53 @@ addRelaEntries m dta resolver symtab (Just relaBuffer) = do
addWarning (RelocationParseFailure msg)
pure m
Right entries -> do
addRelocEntries m $
zipWith (relocFromRela symtab resolver) [0..] entries
addRelaEntries m symtab resolver entries
-- | Add a relocation entry to the map.
addRelEntry :: (Elf.IsRelocationType tp, w ~ Elf.RelocationWidth tp)
=> Endianness
-> SymbolTable w
-> RelocationResolver tp
-> (Integer, RelocMap w)
-> Elf.RelEntry tp
-> MemLoader w (Integer, RelocMap w)
addRelEntry end symtab resolver (idx,m) r = do
w <- uses mlsMemory memAddrWidth
reprConstraints w $ do
let addr = fromIntegral (Elf.relAddr r)
e = RelocEntry { relocEntrySize = relocTargetBytes (Elf.relType r)
, applyReloc = resolveRel end symtab resolver idx r
}
(idx+1,) <$> addRelocEntry m addr e
-- | Add rel relocation entries to map.
addRelEntries :: (Elf.IsRelocationType tp, w ~ Elf.RelocationWidth tp)
=> RelocMap w
-> Elf.ElfData
-- ^ Endianness
-> RelocationResolver tp
-> SymbolTable
-- ^ Endianness
-> SymbolTable w
-- ^ Map from symbol indices to associated symbol
-> Maybe L.ByteString
-> RelocationResolver tp
-- Resolver for relocations
-> [Elf.RelEntry tp]
-- ^ Buffer containing relocation entries in Rel format
-> MemLoader w (RelocMap w)
addRelEntries m _ _ _ Nothing =
addRelEntries m dta symtab resolver entries =
snd <$> foldlM (addRelEntry (toEndianness dta) symtab resolver) (0,m) entries
-- | Add rel relocation entries to map.
addElfRelEntries :: (Elf.IsRelocationType tp, w ~ Elf.RelocationWidth tp)
=> RelocMap w
-> Elf.ElfData
-- ^ Endianness
-> RelocationResolver tp
-> SymbolTable w
-- ^ Map from symbol indices to associated symbol
-> Maybe L.ByteString
-- ^ Buffer containing relocation entries in Rel format
-> MemLoader w (RelocMap w)
addElfRelEntries m _ _ _ Nothing =
pure m
addRelEntries m dta resolver symtab (Just relBuffer) = do
addElfRelEntries m dta resolver symtab (Just relBuffer) = do
w <- uses mlsMemory memAddrWidth
reprConstraints w $ do
case Elf.elfRelEntries dta relBuffer of
@ -932,8 +958,7 @@ addRelEntries m dta resolver symtab (Just relBuffer) = do
addWarning (RelocationParseFailure msg)
pure Map.empty
Right entries -> do
addRelocEntries m $
zipWith (relocFromRel (toEndianness dta) symtab resolver) [0..] entries
addRelEntries m dta symtab resolver entries
-- | This checks a computation that returns a dynamic error or succeeds.
runDynamic :: Either Elf.DynamicError a -> MemLoader w a
@ -941,6 +966,68 @@ runDynamic (Left e) = throwError (FormatDynamicError e)
runDynamic (Right r) = pure r
-- | Attempt to extract bytestring from region identified by two tags,
-- and call a continuation if succesful or return a default value if not.
withDynamicBytes :: Elf.DynamicMap w -- ^ Dynamic map
-> Elf.VirtAddrMap w -- ^ Virtual address map for loading files.
-> Elf.ElfDynamicTag -- ^ Offset
-> Elf.ElfDynamicTag -- ^ Size
-> a -- ^ Value to return if loading fails.
-> (L.ByteString -> MemLoader w a)
-- ^ Continutation to run with bytes.
-> MemLoader w a
withDynamicBytes dmap virtMap offTag sizeTag failVal cont = do
case (Map.findWithDefault [] offTag dmap, Map.findWithDefault [] sizeTag dmap) of
([off], [sz]) -> do
w <- uses mlsMemory memAddrWidth
reprConstraints w $
case Elf.lookupVirtAddrContents off virtMap of
Just relocStartBytes
| toInteger (L.length relocStartBytes) >= toInteger sz ->
cont $ L.take (fromIntegral sz) relocStartBytes
_ -> do
addWarning $ DynamicTagsOutOfRange offTag sizeTag (fromIntegral off) (fromIntegral sz)
pure failVal
(_:_:_, _) -> do
addWarning $ DynamicMultipleTags offTag
pure failVal
(_, _:_:_) -> do
addWarning $ DynamicMultipleTags sizeTag
pure failVal
([_], []) -> do
addWarning $ DynamicTagPairMismatch offTag sizeTag
pure failVal
([], [_]) -> do
addWarning $ DynamicTagPairMismatch sizeTag offTag
pure failVal
([], []) ->
pure failVal
-- | Attempt to extract relocations in Android's compressed format
-- from a region identified by two tags, and call a continuation if
-- succesful or return a default value if not.
withAndroidRelaEntries :: ( w ~ Elf.RelocationWidth tp
, Elf.IsRelocationType tp
)
=> Elf.DynamicMap w -- ^ Dynamic map
-> Elf.VirtAddrMap w -- ^ Virtual address map for loading files.
-> Elf.ElfDynamicTag -- ^ Offset
-> Elf.ElfDynamicTag -- ^ Size
-> a -- ^ Value to return if loading fails.
-> (V.Vector (Elf.RelaEntry tp) -> MemLoader w a)
-- ^ Continutation to run with bytes.
-> MemLoader w a
withAndroidRelaEntries dmap virtMap offTag sizeTag failVal cont = do
withDynamicBytes dmap virtMap offTag sizeTag failVal $ \bytes -> do
w <- uses mlsMemory memAddrWidth
reprConstraints w $
case Elf.decodeAndroidRelaEntries (L.toStrict bytes) of
Left e -> do
addWarning $ AndroidRelDecodingError offTag e
pure failVal
Right v ->
cont v
-- | Create a relocation map from the dynamic loader information.
dynamicRelocationMap :: Elf.ElfHeader w
-> [Elf.Phdr w]
@ -954,6 +1041,8 @@ dynamicRelocationMap hdr ph contents =
addWarning MultipleDynamicSegments
w <- uses mlsMemory memAddrWidth
reprConstraints w $
-- Build virtual address map so that we can resolve
-- elf virtual addresses to their program header offset.
case Elf.virtAddrMap contents ph of
Nothing -> do
addWarning OverlappingLoadableSegments
@ -964,38 +1053,60 @@ dynamicRelocationMap hdr ph contents =
dynSection <- runDynamic $
Elf.dynamicEntries (Elf.headerData hdr) (Elf.headerClass hdr) virtMap dynContents
let dta = Elf.headerData hdr
SomeRelocationResolver resolver <- getRelocationResolver hdr
let symtab = dynamicSymbolTable dynSection
SomeRelocationResolver (resolver :: RelocationResolver tp) <- getRelocationResolver hdr
let symtab = DynamicSymbolTable dynSection
-- Parse relocations
mRelBuffer <- runDynamic $ Elf.dynRelBuffer dynSection
mRelaBuffer <- runDynamic $ Elf.dynRelaBuffer dynSection
relocs0 <- addRelaEntries Map.empty dta resolver symtab mRelaBuffer
relocs1 <- addRelEntries relocs0 dta resolver symtab mRelBuffer
let rc0 = if isJust mRelaBuffer then 1 else 0
relocs0 <- addElfRelaEntries Map.empty dta resolver symtab mRelaBuffer
when (isJust mRelBuffer && isJust mRelaBuffer) $ do
mRelBuffer <- runDynamic $ Elf.dynRelBuffer dynSection
let rc1 = if isJust mRelBuffer then 1 else 0
relocs1 <-addElfRelEntries relocs0 dta resolver symtab mRelBuffer
let dmap = Elf.dynMap dynSection
(rc2,relocs2) <- do
let relocMap = relocs1
let offTag = Elf.DT_ANDROID_RELA
let sizeTag = Elf.DT_ANDROID_RELASZ
withAndroidRelaEntries dmap virtMap offTag sizeTag (0,relocMap) $ \entryVec -> do
let entries = V.toList entryVec
relocMap' <- addRelaEntries relocMap symtab resolver entries
pure (1, relocMap')
(rc3,relocs3) <- do
let relocMap = relocs2
let offTag = Elf.DT_ANDROID_REL
let sizeTag = Elf.DT_ANDROID_RELSZ
withAndroidRelaEntries dmap virtMap offTag sizeTag (0,relocMap) $ \entryVec -> do
when (any (\r -> Elf.relaAddend r /= 0) entryVec) $ do
addWarning $ AndroidRelWithNonzeroAddend
let entries = V.toList $ Elf.relaToRel <$> entryVec
relocMap' <- addRelEntries relocMap dta symtab resolver entries
pure (1, relocMap')
when (rc0 + rc1 + rc2 + rc3 > (1 :: Int)) $ do
addWarning $ MultipleRelocationTables
case Elf.dynPLTRel dynSection of
Left e -> do
addWarning $ RelocationParseFailure (show e)
pure $! relocs1
Right Elf.PLTEmpty -> do
Right Elf.PLTEmpty ->
pure $! relocs1
Right (Elf.PLTRel entries) -> do
addRelocEntries relocs1 $
zipWith (relocFromRel (toEndianness dta) symtab resolver) [0..] entries
Right (Elf.PLTRela entries) -> do
addRelocEntries relocs1 $
zipWith (relocFromRela symtab resolver) [0..] entries
Right (Elf.PLTRel entries) ->
addRelEntries relocs3 dta symtab resolver entries
Right (Elf.PLTRela entries) ->
addRelaEntries relocs3 symtab resolver entries
------------------------------------------------------------------------
-- Elf segment loading
reprConstraints :: AddrWidthRepr w
-> ((Bits (ElfWordType w)
, Bounded (Elf.ElfIntType w)
, Integral (Elf.ElfIntType w)
, Integral (ElfWordType w)
, Bounded (Elf.ElfWordType w)
, Integral (Elf.ElfWordType w)
, Show (ElfWordType w)
, MemWidth w) => a)
-> a
@ -1158,7 +1269,7 @@ findSection sectionMap nm =
-- | Add a section to the current memory
insertAllocatedSection :: Elf.ElfHeader w
-> SymbolTable
-> SymbolTable w
-> SectionNameMap w
-> RegionIndex
-- ^ Region for section (should be unique)
@ -1195,8 +1306,8 @@ insertAllocatedSection hdr symtab sectionMap regIdx nm = do
addWarning $ MultipleRelocationTables
relocMap <- do
let dta = Elf.headerData hdr
m1 <- addRelaEntries Map.empty dta resolver symtab mRelaBuffer
addRelEntries m1 dta resolver symtab mRelBuffer
m1 <- addElfRelaEntries Map.empty dta resolver symtab mRelaBuffer
addElfRelEntries m1 dta resolver symtab mRelBuffer
seg <-
memSegment relocMap regIdx 0 Nothing (fromIntegral base) flags bytes (fromIntegral secSize)
-- Load memory segment.
@ -1224,12 +1335,12 @@ memoryForElfSections e = do
symtab <-
case Elf.elfSymtab e of
[] ->
pure $ noSymTab
pure $ NoSymbolTable
elfSymTab:_rest -> do
let entries = Elf.elfSymbolTableEntries elfSymTab
-- let lclCnt = fromIntegral $ Elf.elfSymbolTableLocalEntries elfSymTab
-- Create an unversioned symbol from symbol table.
pure (staticSymTab entries)
pure (StaticSymbolTable entries)
-- Insert sections
forM_ (zip [1..] allocatedSectionInfo) $ \(idx, (nm,_)) -> do