{-
-----------------------------------------------------------------------------
--
-- (c) The University of Glasgow 2015
--
-- ELF format tools
--
-----------------------------------------------------------------------------
-}

module Elf (
    readElfSectionByName,
    readElfNoteAsString,
    makeElfNote
  ) where

import GhcPrelude

import AsmUtils
import Exception
import DynFlags
import ErrUtils
import Maybes     (MaybeT(..),runMaybeT)
import Util       (charToC)
import Outputable (text,hcat,SDoc)

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

{- Note [ELF specification]
   ~~~~~~~~~~~~~~~~~~~~~~~~

   ELF (Executable and Linking Format) is described in the System V Application
   Binary Interface (or ABI). The latter is composed of two parts: a generic
   part and a processor specific part. The generic ABI describes the parts of
   the interface that remain constant across all hardware implementations of
   System V.

   The latest release of the specification of the generic ABI is the version
   4.1 from March 18, 1997:

     - http://www.sco.com/developers/devspecs/gabi41.pdf

   Since 1997, snapshots of the draft for the "next" version are published:

     - http://www.sco.com/developers/gabi/

   Quoting the notice on the website: "There is more than one instance of these
   chapters to permit references to older instances to remain valid. All
   modifications to these chapters are forward-compatible, so that correct use
   of an older specification will not be invalidated by a newer instance.
   Approximately on a yearly basis, a new instance will be saved, as it reaches
   what appears to be a stable state."

   Nevertheless we will see that since 1998 it is not true for Note sections.

   Many ELF sections
   -----------------

   ELF-4.1: the normal section number fields in ELF are limited to 16 bits,
   which runs out of bits when you try to cram in more sections than that. Two
   fields are concerned: the one containing the number of the sections and the
   one containing the index of the section that contains section's names. (The
   same thing applies to the field containing the number of segments, but we
   don't care about it here).

   ELF-next: to solve this, theses fields in the ELF header have an escape
   value (different for each case), and the actual section number is stashed
   into unused fields in the first section header.

   We support this extension as it is forward-compatible with ELF-4.1.
   Moreover, GHC may generate objects with a lot of sections with the
   "function-sections" feature (one section per function).

   Note sections
   -------------

   Sections with type "note" (SHT_NOTE in the specification) are used to add
   arbitrary data into an ELF file. An entry in a note section is composed of a
   name, a type and a value.

   ELF-4.1: "The note information in sections and program header elements holds
   any number of entries, each of which is an array of 4-byte words in the
   format of the target processor." Each entry has the following format:
         | namesz |   Word32: size of the name string (including the ending \0)
         | descsz |   Word32: size of the value
         |  type  |   Word32: type of the note
         |  name  |   Name string (with \0 padding to ensure 4-byte alignment)
         |  ...   |
         |  desc  |   Value (with \0 padding to ensure 4-byte alignment)
         |  ...   |

   ELF-next: "The note information in sections and program header elements
   holds a variable amount of entries. In 64-bit objects (files with
   e_ident[EI_CLASS] equal to ELFCLASS64), each entry is an array of 8-byte
   words in the format of the target processor. In 32-bit objects (files with
   e_ident[EI_CLASS] equal to ELFCLASS32), each entry is an array of 4-byte
   words in the format of the target processor." (from 1998-2015 snapshots)

   This is not forward-compatible with ELF-4.1. In practice, for almost all
   platforms namesz, descz and type fields are 4-byte words for both 32-bit and
   64-bit objects (see elf.h and readelf source code).

   The only exception in readelf source code is for IA_64 machines with OpenVMS
   OS: "This OS has so many departures from the ELF standard that we test it at
   many places" (comment for is_ia64_vms() in readelf.c). In this case, namesz,
   descsz and type fields are 8-byte words and name and value fields are padded
   to ensure 8-byte alignment.

   We don't support this platform in the following code. Reading a note section
   could be done easily (by testing Machine and OS fields in the ELF header).
   Writing a note section, however, requires that we generate a different
   assembly code for GAS depending on the target platform and this is a little
   bit more involved.

-}


-- | ELF header
--
-- The ELF header indicates the native word size (32-bit or 64-bit) and the
-- endianness of the target machine. We directly store getters for words of
-- different sizes as it is more convenient to use. We also store the word size
-- as it is useful to skip some uninteresting fields.
--
-- Other information such as the target machine and OS are left out as we don't
-- use them yet. We could add them in the future if we ever need them.
data ElfHeader = ElfHeader
   { ElfHeader -> Get Word16
gw16     :: Get Word16   -- ^ Get a Word16 with the correct endianness
   , ElfHeader -> Get Word32
gw32     :: Get Word32   -- ^ Get a Word32 with the correct endianness
   , ElfHeader -> Get Word64
gwN      :: Get Word64   -- ^ Get a Word with the correct word size
                              --   and endianness
   , ElfHeader -> Int
wordSize :: Int          -- ^ Word size in bytes
   }


-- | Read the ELF header
readElfHeader :: DynFlags -> ByteString -> IO (Maybe ElfHeader)
readElfHeader :: DynFlags -> ByteString -> IO (Maybe ElfHeader)
readElfHeader 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
    DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
3 (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> MsgDoc
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  -- skip OSABI, ABI version and padding
      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
          -- ELF 32, little endian
          (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
          -- ELF 32, big endian
          (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
          -- ELF 64, little endian
          (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
          -- ELF 64, big endian
          (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"


------------------
-- SECTIONS
------------------


-- | Description of the section table
data SectionTable = SectionTable
  { SectionTable -> Word64
sectionTableOffset :: Word64  -- ^ offset of the table describing sections
  , SectionTable -> Word16
sectionEntrySize   :: Word16  -- ^ size of an entry in the section table
  , SectionTable -> Word64
sectionEntryCount  :: Word64  -- ^ number of sections
  , SectionTable -> Word32
sectionNameIndex   :: Word32  -- ^ index of a special section which
                                  --   contains section's names
  }

-- | Read the ELF section table
readElfSectionTable :: DynFlags
                    -> ElfHeader
                    -> ByteString
                    -> IO (Maybe SectionTable)

readElfSectionTable :: DynFlags -> ElfHeader -> ByteString -> IO (Maybe SectionTable)
readElfSectionTable 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
    DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
3 (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> MsgDoc
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) -- skip header and some other fields
      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
      -- In some cases, the number of entries and the index of the section
      -- containing section's names must be found in unused fields of the first
      -- section entry (see Note [ELF specification])
      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'
        })


-- | A section
data Section = Section
  { Section -> ByteString
entryName :: ByteString   -- ^ Name of the section
  , Section -> ByteString
entryBS   :: ByteString   -- ^ Content of the section
  }

-- | Read a ELF section
readElfSectionByIndex :: DynFlags
                      -> ElfHeader
                      -> SectionTable
                      -> Word64
                      -> ByteString
                      -> IO (Maybe Section)

readElfSectionByIndex :: DynFlags
-> ElfHeader
-> SectionTable
-> Word64
-> ByteString
-> IO (Maybe Section)
readElfSectionByIndex 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
    DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
3 (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> MsgDoc
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
    -- read an entry from the section table
    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')

    -- read the entry with the given index in the section table
    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)

    -- Get the name of a section
    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')


-- | Find a section from its name. Return the section contents.
--
-- We do not perform any check on the section type.
findSectionFromName :: DynFlags
                    -> ElfHeader
                    -> SectionTable
                    -> String
                    -> ByteString
                    -> IO (Maybe ByteString)
findSectionFromName :: DynFlags
-> ElfHeader
-> SectionTable
-> String
-> ByteString
-> IO (Maybe ByteString)
findSectionFromName 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
    -- convert the required section name into a ByteString to perform
    -- ByteString comparison instead of String comparison
    name' :: ByteString
name' = String -> ByteString
B8.pack String
name

    -- compare recursively each section name and return the contents of
    -- the matching one, if any
    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 <- DynFlags
-> ElfHeader
-> SectionTable
-> Word64
-> ByteString
-> IO (Maybe Section)
readElfSectionByIndex 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


-- | Given a section name, read its contents as a ByteString.
--
-- If the section isn't found or if there is any parsing error, we return
-- Nothing
readElfSectionByName :: DynFlags
                     -> ByteString
                     -> String
                     -> IO (Maybe LBS.ByteString)

readElfSectionByName :: DynFlags -> ByteString -> String -> IO (Maybe ByteString)
readElfSectionByName 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
    DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
3 (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> MsgDoc
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
$ DynFlags -> ByteString -> IO (Maybe ElfHeader)
readElfHeader 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
$ DynFlags -> ElfHeader -> ByteString -> IO (Maybe SectionTable)
readElfSectionTable 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
$ DynFlags
-> ElfHeader
-> SectionTable
-> String
-> ByteString
-> IO (Maybe ByteString)
findSectionFromName DynFlags
dflags ElfHeader
hdr SectionTable
secTable String
name ByteString
bs

------------------
-- NOTE SECTIONS
------------------

-- | read a Note as a ByteString
--
-- If you try to read a note from a section which does not support the Note
-- format, the parsing is likely to fail and Nothing will be returned
readElfNoteBS :: DynFlags
              -> ByteString
              -> String
              -> String
              -> IO (Maybe LBS.ByteString)

readElfNoteBS :: DynFlags -> ByteString -> String -> String -> IO (Maybe ByteString)
readElfNoteBS 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
    DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
3 (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
         String -> MsgDoc
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 the getter on n bytes
    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 as a bytestring
    noteId' :: ByteString
noteId' = String -> ByteString
B8.pack String
noteId

    -- read notes recursively until the one with a valid identifier is found
    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 -- we don't use the note type
      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
$ DynFlags -> ByteString -> IO (Maybe ElfHeader)
readElfHeader 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
$ DynFlags -> ByteString -> String -> IO (Maybe ByteString)
readElfSectionByName 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

-- | read a Note as a String
--
-- If you try to read a note from a section which does not support the Note
-- format, the parsing is likely to fail and Nothing will be returned
readElfNoteAsString :: DynFlags
                    -> FilePath
                    -> String
                    -> String
                    -> IO (Maybe String)

readElfNoteAsString :: DynFlags -> String -> String -> String -> IO (Maybe String)
readElfNoteAsString 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
    DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
3 (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
         String -> MsgDoc
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 <- DynFlags -> ByteString -> String -> String -> IO (Maybe ByteString)
readElfNoteBS 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)


-- | Generate the GAS code to create a Note section
--
-- Header fields for notes are 32-bit long (see Note [ELF specification]).
--
-- It seems there is no easy way to force GNU AS to generate a 32-bit word in
-- every case. Hence we use .int directive to create them: however "The byte
-- order and bit size of the number depends on what kind of target the assembly
-- is for." (https://sourceware.org/binutils/docs/as/Int.html#Int)
--
-- If we add new target platforms, we need to check that the generated words
-- are 32-bit long, otherwise we need to use platform specific directives to
-- force 32-bit .int in asWord32.
makeElfNote :: String -> String -> Word32 -> String -> SDoc
makeElfNote :: String -> String -> Word32 -> String -> MsgDoc
makeElfNote String
sectionName String
noteName Word32
typ String
contents = [MsgDoc] -> MsgDoc
hcat [
    String -> MsgDoc
text String
"\t.section ",
    String -> MsgDoc
text String
sectionName,
    String -> MsgDoc
text String
",\"\",",
    String -> MsgDoc
sectionType String
"note",
    String -> MsgDoc
text String
"\n",

    -- note name length (+ 1 for ending \0)
    Int -> MsgDoc
forall a. Show a => a -> MsgDoc
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),

    -- note contents size
    Int -> MsgDoc
forall a. Show a => a -> MsgDoc
asWord32 (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
contents),

    -- note type
    Word32 -> MsgDoc
forall a. Show a => a -> MsgDoc
asWord32 Word32
typ,

    -- note name (.asciz for \0 ending string) + padding
    String -> MsgDoc
text String
"\t.asciz \"",
    String -> MsgDoc
text String
noteName,
    String -> MsgDoc
text String
"\"\n",
    String -> MsgDoc
text String
"\t.align 4\n",

    -- note contents (.ascii to avoid ending \0) + padding
    String -> MsgDoc
text String
"\t.ascii \"",
    String -> MsgDoc
text (String -> String
escape String
contents),
    String -> MsgDoc
text String
"\"\n",
    String -> MsgDoc
text String
"\t.align 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 :: a -> MsgDoc
asWord32 a
x = [MsgDoc] -> MsgDoc
hcat [
      String -> MsgDoc
text String
"\t.int ",
      String -> MsgDoc
text (a -> String
forall a. Show a => a -> String
show a
x),
      String -> MsgDoc
text String
"\n"]


------------------
-- Helpers
------------------

-- | runGet in IO monad that throws an IOException on failure
runGetOrThrow :: Get a -> LBS.ByteString -> IO a
runGetOrThrow :: 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