module GHC.SysTools.Elf (
readElfSectionByName,
readElfNoteAsString,
makeElfNote
) where
import GHC.Prelude
import GHC.Utils.Asm
import GHC.Utils.Exception
import GHC.Driver.Session
import GHC.Platform
import GHC.Utils.Error
import GHC.Data.Maybe (MaybeT(..),runMaybeT)
import GHC.Utils.Misc (charToC)
import GHC.Utils.Outputable (text,hcat)
import GHC.Utils.Logger
import Control.Monad (when)
import Data.Binary.Get
import Data.Word
import Data.Char (ord)
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Lazy.Char8 as B8
data =
{ ElfHeader -> Get Word16
gw16 :: Get Word16
, ElfHeader -> Get Word32
gw32 :: Get Word32
, ElfHeader -> Get Word64
gwN :: Get Word64
, ElfHeader -> Int
wordSize :: Int
}
readElfHeader :: Logger -> DynFlags -> ByteString -> IO (Maybe ElfHeader)
Logger
logger DynFlags
dflags ByteString
bs = Get (Maybe ElfHeader) -> ByteString -> IO (Maybe ElfHeader)
forall a. Get a -> ByteString -> IO a
runGetOrThrow Get (Maybe ElfHeader)
getHeader ByteString
bs IO (Maybe ElfHeader)
-> (IOException -> IO (Maybe ElfHeader)) -> IO (Maybe ElfHeader)
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> do
Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
3 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text (String
"Unable to read ELF header")
Maybe ElfHeader -> IO (Maybe ElfHeader)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ElfHeader
forall a. Maybe a
Nothing
where
getHeader :: Get (Maybe ElfHeader)
getHeader = do
Word32
magic <- Get Word32
getWord32be
Word8
ws <- Get Word8
getWord8
Word8
endian <- Get Word8
getWord8
Word8
version <- Get Word8
getWord8
Int -> Get ()
skip Int
9
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
magic Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0x7F454C46 Bool -> Bool -> Bool
|| Word8
version Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
1) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid ELF header"
case (Word8
ws, Word8
endian) of
(Word8
1,Word8
1) -> Maybe ElfHeader -> Get (Maybe ElfHeader)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ElfHeader -> Get (Maybe ElfHeader))
-> (ElfHeader -> Maybe ElfHeader)
-> ElfHeader
-> Get (Maybe ElfHeader)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElfHeader -> Maybe ElfHeader
forall a. a -> Maybe a
Just (ElfHeader -> Get (Maybe ElfHeader))
-> ElfHeader -> Get (Maybe ElfHeader)
forall a b. (a -> b) -> a -> b
$ Get Word16 -> Get Word32 -> Get Word64 -> Int -> ElfHeader
ElfHeader
Get Word16
getWord16le
Get Word32
getWord32le
((Word32 -> Word64) -> Get Word32 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Word32
getWord32le) Int
4
(Word8
1,Word8
2) -> Maybe ElfHeader -> Get (Maybe ElfHeader)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ElfHeader -> Get (Maybe ElfHeader))
-> (ElfHeader -> Maybe ElfHeader)
-> ElfHeader
-> Get (Maybe ElfHeader)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElfHeader -> Maybe ElfHeader
forall a. a -> Maybe a
Just (ElfHeader -> Get (Maybe ElfHeader))
-> ElfHeader -> Get (Maybe ElfHeader)
forall a b. (a -> b) -> a -> b
$ Get Word16 -> Get Word32 -> Get Word64 -> Int -> ElfHeader
ElfHeader
Get Word16
getWord16be
Get Word32
getWord32be
((Word32 -> Word64) -> Get Word32 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Word32
getWord32be) Int
4
(Word8
2,Word8
1) -> Maybe ElfHeader -> Get (Maybe ElfHeader)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ElfHeader -> Get (Maybe ElfHeader))
-> (ElfHeader -> Maybe ElfHeader)
-> ElfHeader
-> Get (Maybe ElfHeader)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElfHeader -> Maybe ElfHeader
forall a. a -> Maybe a
Just (ElfHeader -> Get (Maybe ElfHeader))
-> ElfHeader -> Get (Maybe ElfHeader)
forall a b. (a -> b) -> a -> b
$ Get Word16 -> Get Word32 -> Get Word64 -> Int -> ElfHeader
ElfHeader
Get Word16
getWord16le
Get Word32
getWord32le
((Word64 -> Word64) -> Get Word64 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Word64
getWord64le) Int
8
(Word8
2,Word8
2) -> Maybe ElfHeader -> Get (Maybe ElfHeader)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ElfHeader -> Get (Maybe ElfHeader))
-> (ElfHeader -> Maybe ElfHeader)
-> ElfHeader
-> Get (Maybe ElfHeader)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElfHeader -> Maybe ElfHeader
forall a. a -> Maybe a
Just (ElfHeader -> Get (Maybe ElfHeader))
-> ElfHeader -> Get (Maybe ElfHeader)
forall a b. (a -> b) -> a -> b
$ Get Word16 -> Get Word32 -> Get Word64 -> Int -> ElfHeader
ElfHeader
Get Word16
getWord16be
Get Word32
getWord32be
((Word64 -> Word64) -> Get Word64 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Word64
getWord64be) Int
8
(Word8, Word8)
_ -> String -> Get (Maybe ElfHeader)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid ELF header"
data SectionTable = SectionTable
{ SectionTable -> Word64
sectionTableOffset :: Word64
, SectionTable -> Word16
sectionEntrySize :: Word16
, SectionTable -> Word64
sectionEntryCount :: Word64
, SectionTable -> Word32
sectionNameIndex :: Word32
}
readElfSectionTable :: Logger
-> DynFlags
-> ElfHeader
-> ByteString
-> IO (Maybe SectionTable)
readElfSectionTable :: Logger
-> DynFlags -> ElfHeader -> ByteString -> IO (Maybe SectionTable)
readElfSectionTable Logger
logger DynFlags
dflags ElfHeader
hdr ByteString
bs = IO (Maybe SectionTable)
action IO (Maybe SectionTable)
-> (IOException -> IO (Maybe SectionTable))
-> IO (Maybe SectionTable)
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> do
Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
3 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text (String
"Unable to read ELF section table")
Maybe SectionTable -> IO (Maybe SectionTable)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SectionTable
forall a. Maybe a
Nothing
where
getSectionTable :: Get SectionTable
getSectionTable :: Get SectionTable
getSectionTable = do
Int -> Get ()
skip (Int
24 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*ElfHeader -> Int
wordSize ElfHeader
hdr)
Word64
secTableOffset <- ElfHeader -> Get Word64
gwN ElfHeader
hdr
Int -> Get ()
skip Int
10
Word16
entrySize <- ElfHeader -> Get Word16
gw16 ElfHeader
hdr
Word16
entryCount <- ElfHeader -> Get Word16
gw16 ElfHeader
hdr
Word16
secNameIndex <- ElfHeader -> Get Word16
gw16 ElfHeader
hdr
SectionTable -> Get SectionTable
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word16 -> Word64 -> Word32 -> SectionTable
SectionTable Word64
secTableOffset Word16
entrySize
(Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
entryCount)
(Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
secNameIndex))
action :: IO (Maybe SectionTable)
action = do
SectionTable
secTable <- Get SectionTable -> ByteString -> IO SectionTable
forall a. Get a -> ByteString -> IO a
runGetOrThrow Get SectionTable
getSectionTable ByteString
bs
let
offSize0 :: Int64
offSize0 = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ SectionTable -> Word64
sectionTableOffset SectionTable
secTable Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
8
Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
3 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ElfHeader -> Int
wordSize ElfHeader
hdr)
offLink0 :: Int64
offLink0 = Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Int64
offSize0 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ElfHeader -> Int
wordSize ElfHeader
hdr)
Word64
entryCount' <- if SectionTable -> Word64
sectionEntryCount SectionTable
secTable Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0
then Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return (SectionTable -> Word64
sectionEntryCount SectionTable
secTable)
else Get Word64 -> ByteString -> IO Word64
forall a. Get a -> ByteString -> IO a
runGetOrThrow (ElfHeader -> Get Word64
gwN ElfHeader
hdr) (Int64 -> ByteString -> ByteString
LBS.drop Int64
offSize0 ByteString
bs)
Word32
entryNameIndex' <- if SectionTable -> Word32
sectionNameIndex SectionTable
secTable Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0xffff
then Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (SectionTable -> Word32
sectionNameIndex SectionTable
secTable)
else Get Word32 -> ByteString -> IO Word32
forall a. Get a -> ByteString -> IO a
runGetOrThrow (ElfHeader -> Get Word32
gw32 ElfHeader
hdr) (Int64 -> ByteString -> ByteString
LBS.drop Int64
offLink0 ByteString
bs)
Maybe SectionTable -> IO (Maybe SectionTable)
forall (m :: * -> *) a. Monad m => a -> m a
return (SectionTable -> Maybe SectionTable
forall a. a -> Maybe a
Just (SectionTable -> Maybe SectionTable)
-> SectionTable -> Maybe SectionTable
forall a b. (a -> b) -> a -> b
$ SectionTable
secTable
{ sectionEntryCount :: Word64
sectionEntryCount = Word64
entryCount'
, sectionNameIndex :: Word32
sectionNameIndex = Word32
entryNameIndex'
})
data Section = Section
{ Section -> ByteString
entryName :: ByteString
, Section -> ByteString
entryBS :: ByteString
}
readElfSectionByIndex :: Logger
-> DynFlags
-> ElfHeader
-> SectionTable
-> Word64
-> ByteString
-> IO (Maybe Section)
readElfSectionByIndex :: Logger
-> DynFlags
-> ElfHeader
-> SectionTable
-> Word64
-> ByteString
-> IO (Maybe Section)
readElfSectionByIndex Logger
logger DynFlags
dflags ElfHeader
hdr SectionTable
secTable Word64
i ByteString
bs = IO (Maybe Section)
action IO (Maybe Section)
-> (IOException -> IO (Maybe Section)) -> IO (Maybe Section)
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> do
Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
3 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text (String
"Unable to read ELF section")
Maybe Section -> IO (Maybe Section)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Section
forall a. Maybe a
Nothing
where
getEntry :: Get (Word32, ByteString)
getEntry = do
Word32
nameIndex <- ElfHeader -> Get Word32
gw32 ElfHeader
hdr
Int -> Get ()
skip (Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*ElfHeader -> Int
wordSize ElfHeader
hdr)
Int64
offset <- (Word64 -> Int64) -> Get Word64 -> Get Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Get Word64 -> Get Int64) -> Get Word64 -> Get Int64
forall a b. (a -> b) -> a -> b
$ ElfHeader -> Get Word64
gwN ElfHeader
hdr
Int64
size <- (Word64 -> Int64) -> Get Word64 -> Get Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Get Word64 -> Get Int64) -> Get Word64 -> Get Int64
forall a b. (a -> b) -> a -> b
$ ElfHeader -> Get Word64
gwN ElfHeader
hdr
let bs' :: ByteString
bs' = Int64 -> ByteString -> ByteString
LBS.take Int64
size (Int64 -> ByteString -> ByteString
LBS.drop Int64
offset ByteString
bs)
(Word32, ByteString) -> Get (Word32, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
nameIndex,ByteString
bs')
getEntryByIndex :: Word64 -> IO (Word32, ByteString)
getEntryByIndex Word64
x = Get (Word32, ByteString) -> ByteString -> IO (Word32, ByteString)
forall a. Get a -> ByteString -> IO a
runGetOrThrow Get (Word32, ByteString)
getEntry ByteString
bs'
where
bs' :: ByteString
bs' = Int64 -> ByteString -> ByteString
LBS.drop Int64
off ByteString
bs
off :: Int64
off = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ SectionTable -> Word64
sectionTableOffset SectionTable
secTable Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+
Word64
x Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SectionTable -> Word16
sectionEntrySize SectionTable
secTable)
getEntryName :: Int64 -> IO ByteString
getEntryName Int64
nameIndex = do
let idx :: Word64
idx = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SectionTable -> Word32
sectionNameIndex SectionTable
secTable)
(Word32
_,ByteString
nameTable) <- Word64 -> IO (Word32, ByteString)
getEntryByIndex Word64
idx
let bs' :: ByteString
bs' = Int64 -> ByteString -> ByteString
LBS.drop Int64
nameIndex ByteString
nameTable
Get ByteString -> ByteString -> IO ByteString
forall a. Get a -> ByteString -> IO a
runGetOrThrow Get ByteString
getLazyByteStringNul ByteString
bs'
action :: IO (Maybe Section)
action = do
(Word32
nameIndex,ByteString
bs') <- Word64 -> IO (Word32, ByteString)
getEntryByIndex (Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i)
ByteString
name <- Int64 -> IO ByteString
getEntryName (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nameIndex)
Maybe Section -> IO (Maybe Section)
forall (m :: * -> *) a. Monad m => a -> m a
return (Section -> Maybe Section
forall a. a -> Maybe a
Just (Section -> Maybe Section) -> Section -> Maybe Section
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Section
Section ByteString
name ByteString
bs')
findSectionFromName :: Logger
-> DynFlags
-> ElfHeader
-> SectionTable
-> String
-> ByteString
-> IO (Maybe ByteString)
findSectionFromName :: Logger
-> DynFlags
-> ElfHeader
-> SectionTable
-> String
-> ByteString
-> IO (Maybe ByteString)
findSectionFromName Logger
logger DynFlags
dflags ElfHeader
hdr SectionTable
secTable String
name ByteString
bs =
[Word64] -> IO (Maybe ByteString)
rec [Word64
0..SectionTable -> Word64
sectionEntryCount SectionTable
secTable Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1]
where
name' :: ByteString
name' = String -> ByteString
B8.pack String
name
rec :: [Word64] -> IO (Maybe ByteString)
rec [] = Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
rec (Word64
x:[Word64]
xs) = do
Maybe Section
me <- Logger
-> DynFlags
-> ElfHeader
-> SectionTable
-> Word64
-> ByteString
-> IO (Maybe Section)
readElfSectionByIndex Logger
logger DynFlags
dflags ElfHeader
hdr SectionTable
secTable Word64
x ByteString
bs
case Maybe Section
me of
Just Section
e | Section -> ByteString
entryName Section
e ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
name' -> Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Section -> ByteString
entryBS Section
e))
Maybe Section
_ -> [Word64] -> IO (Maybe ByteString)
rec [Word64]
xs
readElfSectionByName :: Logger
-> DynFlags
-> ByteString
-> String
-> IO (Maybe LBS.ByteString)
readElfSectionByName :: Logger -> DynFlags -> ByteString -> String -> IO (Maybe ByteString)
readElfSectionByName Logger
logger DynFlags
dflags ByteString
bs String
name = IO (Maybe ByteString)
action IO (Maybe ByteString)
-> (IOException -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> do
Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
3 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text (String
"Unable to read ELF section \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"")
Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
where
action :: IO (Maybe ByteString)
action = MaybeT IO ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO ByteString -> IO (Maybe ByteString))
-> MaybeT IO ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ do
ElfHeader
hdr <- IO (Maybe ElfHeader) -> MaybeT IO ElfHeader
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe ElfHeader) -> MaybeT IO ElfHeader)
-> IO (Maybe ElfHeader) -> MaybeT IO ElfHeader
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> ByteString -> IO (Maybe ElfHeader)
readElfHeader Logger
logger DynFlags
dflags ByteString
bs
SectionTable
secTable <- IO (Maybe SectionTable) -> MaybeT IO SectionTable
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe SectionTable) -> MaybeT IO SectionTable)
-> IO (Maybe SectionTable) -> MaybeT IO SectionTable
forall a b. (a -> b) -> a -> b
$ Logger
-> DynFlags -> ElfHeader -> ByteString -> IO (Maybe SectionTable)
readElfSectionTable Logger
logger DynFlags
dflags ElfHeader
hdr ByteString
bs
IO (Maybe ByteString) -> MaybeT IO ByteString
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe ByteString) -> MaybeT IO ByteString)
-> IO (Maybe ByteString) -> MaybeT IO ByteString
forall a b. (a -> b) -> a -> b
$ Logger
-> DynFlags
-> ElfHeader
-> SectionTable
-> String
-> ByteString
-> IO (Maybe ByteString)
findSectionFromName Logger
logger DynFlags
dflags ElfHeader
hdr SectionTable
secTable String
name ByteString
bs
readElfNoteBS :: Logger
-> DynFlags
-> ByteString
-> String
-> String
-> IO (Maybe LBS.ByteString)
readElfNoteBS :: Logger
-> DynFlags
-> ByteString
-> String
-> String
-> IO (Maybe ByteString)
readElfNoteBS Logger
logger DynFlags
dflags ByteString
bs String
sectionName String
noteId = IO (Maybe ByteString)
action IO (Maybe ByteString)
-> (IOException -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> do
Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
3 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text (String
"Unable to read ELF note \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
noteId String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\" in section \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sectionName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"")
Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
where
align :: Int64 -> Get ()
align Int64
n = do
Int64
m <- Get Int64
bytesRead
if Int64
m Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` Int64
n Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0
then () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else Int -> Get ()
skip Int
1 Get () -> Get () -> Get ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> Get ()
align Int64
n
noteId' :: ByteString
noteId' = String -> ByteString
B8.pack String
noteId
findNote :: ElfHeader -> Get (Maybe ByteString)
findNote ElfHeader
hdr = do
Int64 -> Get ()
align Int64
4
Word32
namesz <- ElfHeader -> Get Word32
gw32 ElfHeader
hdr
Word32
descsz <- ElfHeader -> Get Word32
gw32 ElfHeader
hdr
Word32
_ <- ElfHeader -> Get Word32
gw32 ElfHeader
hdr
ByteString
name <- if Word32
namesz Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
then ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
LBS.empty
else Get ByteString
getLazyByteStringNul
Int64 -> Get ()
align Int64
4
ByteString
desc <- if Word32
descsz Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
then ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
LBS.empty
else Int64 -> Get ByteString
getLazyByteString (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
descsz)
if ByteString
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
noteId'
then Maybe ByteString -> Get (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> Get (Maybe ByteString))
-> Maybe ByteString -> Get (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
desc
else ElfHeader -> Get (Maybe ByteString)
findNote ElfHeader
hdr
action :: IO (Maybe ByteString)
action = MaybeT IO ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO ByteString -> IO (Maybe ByteString))
-> MaybeT IO ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ do
ElfHeader
hdr <- IO (Maybe ElfHeader) -> MaybeT IO ElfHeader
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe ElfHeader) -> MaybeT IO ElfHeader)
-> IO (Maybe ElfHeader) -> MaybeT IO ElfHeader
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> ByteString -> IO (Maybe ElfHeader)
readElfHeader Logger
logger DynFlags
dflags ByteString
bs
ByteString
sec <- IO (Maybe ByteString) -> MaybeT IO ByteString
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe ByteString) -> MaybeT IO ByteString)
-> IO (Maybe ByteString) -> MaybeT IO ByteString
forall a b. (a -> b) -> a -> b
$ Logger -> DynFlags -> ByteString -> String -> IO (Maybe ByteString)
readElfSectionByName Logger
logger DynFlags
dflags ByteString
bs String
sectionName
IO (Maybe ByteString) -> MaybeT IO ByteString
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe ByteString) -> MaybeT IO ByteString)
-> IO (Maybe ByteString) -> MaybeT IO ByteString
forall a b. (a -> b) -> a -> b
$ Get (Maybe ByteString) -> ByteString -> IO (Maybe ByteString)
forall a. Get a -> ByteString -> IO a
runGetOrThrow (ElfHeader -> Get (Maybe ByteString)
findNote ElfHeader
hdr) ByteString
sec
readElfNoteAsString :: Logger
-> DynFlags
-> FilePath
-> String
-> String
-> IO (Maybe String)
readElfNoteAsString :: Logger
-> DynFlags -> String -> String -> String -> IO (Maybe String)
readElfNoteAsString Logger
logger DynFlags
dflags String
path String
sectionName String
noteId = IO (Maybe String)
action IO (Maybe String)
-> (IOException -> IO (Maybe String)) -> IO (Maybe String)
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
_ -> do
Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
3 (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
text (String
"Unable to read ELF note \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
noteId String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\" in section \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sectionName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"")
Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
where
action :: IO (Maybe String)
action = do
ByteString
bs <- String -> IO ByteString
LBS.readFile String
path
Maybe ByteString
note <- Logger
-> DynFlags
-> ByteString
-> String
-> String
-> IO (Maybe ByteString)
readElfNoteBS Logger
logger DynFlags
dflags ByteString
bs String
sectionName String
noteId
Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString -> String) -> Maybe ByteString -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
B8.unpack Maybe ByteString
note)
makeElfNote :: Platform -> String -> String -> Word32 -> String -> SDoc
makeElfNote :: Platform -> String -> String -> Word32 -> String -> SDoc
makeElfNote Platform
platform String
sectionName String
noteName Word32
typ String
contents = [SDoc] -> SDoc
hcat [
String -> SDoc
text String
"\t.section ",
String -> SDoc
text String
sectionName,
String -> SDoc
text String
",\"\",",
Platform -> String -> SDoc
sectionType Platform
platform String
"note",
String -> SDoc
text String
"\n",
String -> SDoc
text String
"\t.balign 4\n",
Int -> SDoc
forall a. Show a => a -> SDoc
asWord32 (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
noteName Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1),
Int -> SDoc
forall a. Show a => a -> SDoc
asWord32 (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
contents),
Word32 -> SDoc
forall a. Show a => a -> SDoc
asWord32 Word32
typ,
String -> SDoc
text String
"\t.asciz \"",
String -> SDoc
text String
noteName,
String -> SDoc
text String
"\"\n",
String -> SDoc
text String
"\t.balign 4\n",
String -> SDoc
text String
"\t.ascii \"",
String -> SDoc
text (String -> String
escape String
contents),
String -> SDoc
text String
"\"\n",
String -> SDoc
text String
"\t.balign 4\n"]
where
escape :: String -> String
escape :: String -> String
escape = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Word8 -> String
charToC(Word8 -> String) -> (Char -> Word8) -> Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Int
ord)
asWord32 :: Show a => a -> SDoc
asWord32 :: forall a. Show a => a -> SDoc
asWord32 a
x = [SDoc] -> SDoc
hcat [
String -> SDoc
text String
"\t.4byte ",
String -> SDoc
text (a -> String
forall a. Show a => a -> String
show a
x),
String -> SDoc
text String
"\n"]
runGetOrThrow :: Get a -> LBS.ByteString -> IO a
runGetOrThrow :: forall a. Get a -> ByteString -> IO a
runGetOrThrow Get a
g ByteString
bs = case Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail Get a
g ByteString
bs of
Left (ByteString, Int64, String)
_ -> String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Error while reading file"
Right (ByteString
_,Int64
_,a
a) -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a