From e081826c9a27f1a31ffbfb092706aa2b638f9053 Mon Sep 17 00:00:00 2001 From: Your Name Date: Thu, 10 Oct 2024 11:09:19 -0400 Subject: [PATCH] dump: Add subcommand to dump PLT stubs --- .../macaw-aarch32-symbolic.cabal | 2 - macaw-aarch32-symbolic/tools/Dump.hs | 33 +--- macaw-dump/macaw-dump.cabal | 3 + macaw-dump/src/Data/Macaw/Dump.hs | 124 ++------------ macaw-dump/src/Data/Macaw/Dump/CLI.hs | 48 ++++-- macaw-dump/src/Data/Macaw/Dump/CLIUtils.hs | 44 +++++ macaw-dump/src/Data/Macaw/Dump/Discover.hs | 160 ++++++++++++++++++ macaw-dump/src/Data/Macaw/Dump/Plt.hs | 46 +++++ macaw-ppc-symbolic/macaw-ppc-symbolic.cabal | 3 - macaw-ppc-symbolic/tools/Dump.hs | 44 +---- 10 files changed, 317 insertions(+), 190 deletions(-) create mode 100644 macaw-dump/src/Data/Macaw/Dump/CLIUtils.hs create mode 100644 macaw-dump/src/Data/Macaw/Dump/Discover.hs create mode 100644 macaw-dump/src/Data/Macaw/Dump/Plt.hs diff --git a/macaw-aarch32-symbolic/macaw-aarch32-symbolic.cabal b/macaw-aarch32-symbolic/macaw-aarch32-symbolic.cabal index 6e0d7b7a..ae3fa00d 100644 --- a/macaw-aarch32-symbolic/macaw-aarch32-symbolic.cabal +++ b/macaw-aarch32-symbolic/macaw-aarch32-symbolic.cabal @@ -53,9 +53,7 @@ executable macaw-aarch32-dump ghc-options: -Wall -Wcompat build-depends: base, - bytestring, containers, - elf-edit, macaw-aarch32, macaw-aarch32-symbolic, macaw-dump, diff --git a/macaw-aarch32-symbolic/tools/Dump.hs b/macaw-aarch32-symbolic/tools/Dump.hs index 9a46307c..a11a6ca5 100644 --- a/macaw-aarch32-symbolic/tools/Dump.hs +++ b/macaw-aarch32-symbolic/tools/Dump.hs @@ -1,41 +1,18 @@ -{-# LANGUAGE GADTs #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE TypeApplications #-} module Main (main) where -import Data.ByteString qualified as BS -import Data.ElfEdit qualified as EE import Data.Macaw.AArch32.Symbolic () import Data.Macaw.ARM qualified as MA import Data.Macaw.Dump qualified as MD -import Data.Macaw.Dump.CLI qualified as MDC import Data.Macaw.Symbolic qualified as MS import Data.Proxy (Proxy(..)) -import Data.Set qualified as Set -import System.Exit qualified as Exit -import System.IO qualified as IO - -die :: String -> IO a -die msg = do - IO.hPutStrLn IO.stderr msg - Exit.exitFailure main :: IO () main = do - cli <- MDC.parseCli - let exePath = MDC.cliBinPath cli - bytes <- BS.readFile exePath - case EE.decodeElfHeaderInfo bytes of - Left (_, msg) -> die ("Error parsing ELF header from file '" ++ exePath ++ "': " ++ msg) - Right (EE.SomeElf ehi) -> do - case EE.headerClass (EE.header ehi) of - EE.ELFCLASS32 -> do - let symbs = Set.fromList (MDC.cliSymbols cli) - discState <- MD.runDiscovery ehi MA.arm_linux_info symbs - archVals <- - case MS.archVals (Proxy @MA.ARM) Nothing of - Just archVals -> pure archVals - Nothing -> error "impossible" - MD.displayCfgs exePath discState archVals (MDC.cliPrintCrucible cli) - EE.ELFCLASS64 -> die "Only 32-bit ARM is supported" + archVals <- + case MS.archVals (Proxy @MA.ARM) Nothing of + Just archVals -> pure archVals + Nothing -> error "impossible" + MD.main MA.arm_linux_info archVals MA.armPLTStubInfo diff --git a/macaw-dump/macaw-dump.cabal b/macaw-dump/macaw-dump.cabal index cfe3f639..31f0d0dd 100644 --- a/macaw-dump/macaw-dump.cabal +++ b/macaw-dump/macaw-dump.cabal @@ -107,3 +107,6 @@ library exposed-modules: Data.Macaw.Dump Data.Macaw.Dump.CLI + Data.Macaw.Dump.CLIUtils + Data.Macaw.Dump.Discover + Data.Macaw.Dump.Plt diff --git a/macaw-dump/src/Data/Macaw/Dump.hs b/macaw-dump/src/Data/Macaw/Dump.hs index 5a267eb1..6cbfc6ea 100644 --- a/macaw-dump/src/Data/Macaw/Dump.hs +++ b/macaw-dump/src/Data/Macaw/Dump.hs @@ -1,125 +1,35 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} {-# LANGUAGE ImportQualifiedPost #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-} module Data.Macaw.Dump - ( DumpException - , runDiscovery - , displayCfgs + ( main ) where -import Control.Exception qualified as X -import Control.Lens qualified as Lens -import Control.Monad qualified as Monad -import Data.ByteString qualified as BS import Data.ElfEdit qualified as EE -import Data.Foldable qualified as F -import Data.Set qualified as Set import Data.Macaw.Architecture.Info qualified as MAI +import Data.Macaw.Dump.CLI qualified as MDC +import Data.Macaw.Dump.Discover qualified as MDD +import Data.Macaw.Dump.Plt qualified as MDP import Data.Macaw.CFG qualified as MC -import Data.Macaw.Discovery qualified as MD -import Data.Macaw.Memory.ElfLoader qualified as MEL -import Data.Macaw.Memory.LoadCommon qualified as MML -import Data.Macaw.Memory qualified as MM +import Data.Macaw.Memory.ElfLoader.PLTStubs qualified as MMEP import Data.Macaw.Symbolic qualified as MS -import Data.Map qualified as Map -import Data.Parameterized.Some (Some(Some)) -import Data.Text.Encoding.Error qualified as Text -import Data.Text.Encoding qualified as Text -import Data.Text qualified as Text -import Lang.Crucible.Analysis.Postdom qualified as CAP -import Lang.Crucible.CFG.Core qualified as CCC import Lang.Crucible.CFG.Extension qualified as CCE -import Lang.Crucible.FunctionHandle qualified as CFH -import Prettyprinter qualified as PP -import System.IO qualified as IO -import What4.FunctionName qualified as WF -import What4.ProgramLoc qualified as WPL -data DumpException = ELFResolutionError String - deriving Show - -instance X.Exception DumpException - - --- | Convert machine addresses into What4 positions. --- --- When possible, we map to the structured 'WPL.BinaryPos' type. However, some --- 'MM.MemSegmentOff' cannot be mapped to an absolute position (e.g., some --- addresses from shared libraries are in non-trivial segments). In those cases, --- we map to the unstructured 'WPL.Others' with a sufficiently descriptive string. --- --- TODO: import from `Testing` -posFn :: (MM.MemWidth w) => Text.Text -> MM.MemSegmentOff w -> WPL.Position -posFn binaryName segOff = - case MM.segoffAsAbsoluteAddr segOff of - Just mw -> WPL.BinaryPos binaryName (fromIntegral mw) - Nothing -> WPL.OtherPos (binaryName <> Text.pack ": " <> Text.pack (show segOff)) - --- | Load an ELF file into a macaw 'MM.Memory' (and symbols) --- --- Prints warnings to stderr. -loadELF :: - MML.LoadOptions -> - EE.ElfHeaderInfo w -> - IO (MM.Memory w, [MEL.MemSymbol w]) -loadELF loadOpts ehi = do - case MEL.resolveElfContents loadOpts ehi of - Left err -> X.throwIO (ELFResolutionError err) - Right (warnings, mem, _mentry, nameAddrList) -> do - F.forM_ warnings $ \w -> do - IO.hPutStrLn IO.stderr ("WARN: " ++ w) - return (mem, nameAddrList) - --- | Run discovery on the provided symbols, or all if none are provided -runDiscovery :: - forall arch w. - ( MC.ArchAddrWidth arch ~ w +main :: + ( MS.GenArchInfo MS.LLVMMemory arch + , CCE.IsSyntaxExtension (MS.MacawExt arch) , MC.ArchConstraints arch - , MM.MemWidth w + , MC.ArchAddrWidth arch ~ EE.RelocationWidth reloc + , EE.IsRelocationType reloc ) => - EE.ElfHeaderInfo w -> MAI.ArchitectureInfo arch -> - Set.Set BS.ByteString -> - IO (MD.DiscoveryState arch) -runDiscovery headerInfo archInfo symbols = do - (mem, nameAddrList) <- loadELF MML.defaultLoadOptions headerInfo - let addrSymMap = - Map.fromList - [ (MEL.memSymbolStart msym, name) - | msym <- nameAddrList - , let name = MEL.memSymbolName msym - , Set.null symbols || Set.member name symbols - ] - pure (MD.cfgFromAddrs archInfo mem addrSymMap (Map.keys addrSymMap) []) - -displayCfgs :: - ( MC.ArchConstraints arch - , MS.GenArchInfo MS.LLVMMemory arch - , CCE.IsSyntaxExtension (MS.MacawExt arch) - ) => - FilePath -> - MD.DiscoveryState arch -> MS.GenArchVals mem arch -> - -- | Also print Crucible CFG? - Bool -> + MMEP.PLTStubInfo reloc -> IO () -displayCfgs path discState archVals printCrucible = do - let funInfos = discState Lens.^. MD.funInfo - halloc <- CFH.newHandleAllocator - F.for_ (Map.toList funInfos) $ \(_addr, Some info) -> do - IO.print (PP.pretty info) - Monad.when printCrucible $ do - let pos = posFn (Text.pack path) - let funName = - WF.functionNameFromText $ - Text.decodeUtf8With Text.lenientDecode $ - MD.discoveredFunName info - CCC.SomeCFG ssa <- - MS.mkFunCFG (MS.archFunctions archVals) halloc funName pos info - IO.print (CCC.ppCFG' True (CAP.postdomInfo ssa) ssa) +main archInfo archVals pltStubInfo = do + cli <- MDC.parseCli + case MDC.cliCommand cli of + MDC.CommandDiscover cfg -> MDD.discover archInfo archVals cfg + MDC.CommandPlt cfg -> MDP.plt archInfo pltStubInfo cfg diff --git a/macaw-dump/src/Data/Macaw/Dump/CLI.hs b/macaw-dump/src/Data/Macaw/Dump/CLI.hs index 13f197e4..4ac10786 100644 --- a/macaw-dump/src/Data/Macaw/Dump/CLI.hs +++ b/macaw-dump/src/Data/Macaw/Dump/CLI.hs @@ -4,32 +4,52 @@ module Data.Macaw.Dump.CLI ( Cli(..) + , Command(..) , parseCli ) where import Control.Applicative ((<**>)) -import Data.ByteString (ByteString) +import Data.Macaw.Dump.Discover qualified as MDD +import Data.Macaw.Dump.Plt qualified as MDP import Options.Applicative qualified as Opt +data Command + = CommandDiscover MDD.DiscoverConfig + | CommandPlt MDP.PltConfig + +command :: Opt.Parser Command +command = + Opt.subparser $ + mconcat + [ cmdDiscover + , cmdPlt + ] + where + cmdDiscover :: Opt.Mod Opt.CommandFields Command + cmdDiscover = do + Opt.command + "discover" + (Opt.info (CommandDiscover <$> MDD.discoverConfig) (Opt.progDesc "Perform code discovery and print CFGs")) + + cmdPlt :: Opt.Mod Opt.CommandFields Command + cmdPlt = do + Opt.command + "plt" + (Opt.info (CommandPlt <$> MDP.pltConfig) (Opt.progDesc "Display PLT stubs")) + data Cli = Cli - { -- Arguments - cliBinPath :: FilePath - , cliSymbols :: [ByteString] - -- Options - , cliPrintCrucible :: Bool - } deriving Show - -opts :: Opt.Parser Cli -opts = do - cliBinPath <- Opt.strArgument (Opt.help "filename of binary" <> Opt.metavar "FILENAME" ) - cliSymbols <- Opt.many $ Opt.strArgument (Opt.help "function name" <> Opt.metavar "SYMBOL") - cliPrintCrucible <- Opt.switch (Opt.long "crucible" <> Opt.help "output Crucible CFGs") + { cliCommand :: Command + } + +cli :: Opt.Parser Cli +cli = do + cliCommand <- command pure Cli{..} cliInfo :: Opt.ParserInfo Cli cliInfo = Opt.info - (opts <**> Opt.helper) + (cli <**> Opt.helper) ( Opt.fullDesc <> Opt.header "A tool to display internal Macaw data structures" diff --git a/macaw-dump/src/Data/Macaw/Dump/CLIUtils.hs b/macaw-dump/src/Data/Macaw/Dump/CLIUtils.hs new file mode 100644 index 00000000..4d9032db --- /dev/null +++ b/macaw-dump/src/Data/Macaw/Dump/CLIUtils.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ImportQualifiedPost #-} + +module Data.Macaw.Dump.CLIUtils + ( binOpt + , die + , loadElf + ) where + +import Data.ByteString qualified as BS +import Data.ElfEdit qualified as EE +import Data.Macaw.Architecture.Info qualified as MAI +import Data.Macaw.CFG qualified as MC +import Data.Macaw.Memory qualified as MM +import Options.Applicative qualified as Opt +import System.Exit qualified as Exit +import System.IO qualified as IO + +binOpt :: Opt.Parser FilePath +binOpt = Opt.strArgument (Opt.help "filename of binary" <> Opt.metavar "FILENAME" ) + +die :: String -> IO a +die msg = do + IO.hPutStrLn IO.stderr msg + Exit.exitFailure + +loadElf :: + MAI.ArchitectureInfo arch -> + FilePath -> + IO (EE.ElfHeaderInfo (MC.ArchAddrWidth arch)) +loadElf archInfo elfPath = do + bytes <- BS.readFile elfPath + case EE.decodeElfHeaderInfo bytes of + Left (_, msg) -> die ("Error parsing ELF header from file '" ++ elfPath ++ "': " ++ msg) + Right (EE.SomeElf ehi) -> do + case MAI.archAddrWidth archInfo of + MM.Addr32 -> + case EE.headerClass (EE.header ehi) of + EE.ELFCLASS32 -> pure ehi + EE.ELFCLASS64 -> die "Expected 32-bit ELF file, found 64-bit" + MM.Addr64 -> + case EE.headerClass (EE.header ehi) of + EE.ELFCLASS32 -> die "Expected 64-bit ELF file, found 32-bit" + EE.ELFCLASS64 -> pure ehi diff --git a/macaw-dump/src/Data/Macaw/Dump/Discover.hs b/macaw-dump/src/Data/Macaw/Dump/Discover.hs new file mode 100644 index 00000000..604e7f14 --- /dev/null +++ b/macaw-dump/src/Data/Macaw/Dump/Discover.hs @@ -0,0 +1,160 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} + +module Data.Macaw.Dump.Discover + ( DiscoverException + , DiscoverConfig(..) + , discoverConfig + , discover + ) where + +import Control.Exception qualified as X +import Control.Lens qualified as Lens +import Control.Monad qualified as Monad +import Data.ByteString qualified as BS +import Data.ElfEdit qualified as EE +import Data.Foldable qualified as F +import Data.Set qualified as Set +import Data.Macaw.Architecture.Info qualified as MAI +import Data.Macaw.CFG qualified as MC +import Data.Macaw.Dump.CLIUtils qualified as MDCU +import Data.Macaw.Discovery qualified as MD +import Data.Macaw.Memory.ElfLoader qualified as MEL +import Data.Macaw.Memory.LoadCommon qualified as MML +import Data.Macaw.Memory qualified as MM +import Data.Macaw.Symbolic qualified as MS +import Data.Map qualified as Map +import Data.Parameterized.Some (Some(Some)) +import Data.Text.Encoding.Error qualified as Text +import Data.Text.Encoding qualified as Text +import Data.Text qualified as Text +import Lang.Crucible.Analysis.Postdom qualified as CAP +import Lang.Crucible.CFG.Core qualified as CCC +import Lang.Crucible.CFG.Extension qualified as CCE +import Lang.Crucible.FunctionHandle qualified as CFH +import Options.Applicative qualified as Opt +import Prettyprinter qualified as PP +import System.IO qualified as IO +import What4.FunctionName qualified as WF +import What4.ProgramLoc qualified as WPL + +data DiscoverException = ELFResolutionError String + deriving Show + +instance X.Exception DiscoverException + + +-- | Convert machine addresses into What4 positions. +-- +-- When possible, we map to the structured 'WPL.BinaryPos' type. However, some +-- 'MM.MemSegmentOff' cannot be mapped to an absolute position (e.g., some +-- addresses from shared libraries are in non-trivial segments). In those cases, +-- we map to the unstructured 'WPL.Others' with a sufficiently descriptive string. +-- +-- TODO: import from `Testing` +posFn :: (MM.MemWidth w) => Text.Text -> MM.MemSegmentOff w -> WPL.Position +posFn binaryName segOff = + case MM.segoffAsAbsoluteAddr segOff of + Just mw -> WPL.BinaryPos binaryName (fromIntegral mw) + Nothing -> WPL.OtherPos (binaryName <> Text.pack ": " <> Text.pack (show segOff)) + +-- | Load an ELF file into a macaw 'MM.Memory' (and symbols) +-- +-- Prints warnings to stderr. +loadELF :: + MML.LoadOptions -> + EE.ElfHeaderInfo w -> + IO (MM.Memory w, [MEL.MemSymbol w]) +loadELF loadOpts ehi = do + case MEL.resolveElfContents loadOpts ehi of + Left err -> X.throwIO (ELFResolutionError err) + Right (warnings, mem, _mentry, nameAddrList) -> do + F.forM_ warnings $ \w -> do + IO.hPutStrLn IO.stderr ("WARN: " ++ w) + return (mem, nameAddrList) + +-- | Run discovery on the provided symbols, or all if none are provided +runDiscovery :: + forall arch w. + ( MC.ArchAddrWidth arch ~ w + , MC.ArchConstraints arch + , MM.MemWidth w + ) => + EE.ElfHeaderInfo w -> + MAI.ArchitectureInfo arch -> + Set.Set BS.ByteString -> + IO (MD.DiscoveryState arch) +runDiscovery headerInfo archInfo symbols = do + (mem, nameAddrList) <- loadELF MML.defaultLoadOptions headerInfo + let addrSymMap = + Map.fromList + [ (MEL.memSymbolStart msym, name) + | msym <- nameAddrList + , let name = MEL.memSymbolName msym + , Set.null symbols || Set.member name symbols + ] + pure (MD.cfgFromAddrs archInfo mem addrSymMap (Map.keys addrSymMap) []) + +displayCfgs :: + ( MC.ArchConstraints arch + , MS.GenArchInfo MS.LLVMMemory arch + , CCE.IsSyntaxExtension (MS.MacawExt arch) + ) => + FilePath -> + MD.DiscoveryState arch -> + MS.GenArchVals mem arch -> + -- | Also print Crucible CFG? + Bool -> + IO () +displayCfgs path discState archVals printCrucible = do + let funInfos = discState Lens.^. MD.funInfo + halloc <- CFH.newHandleAllocator + F.for_ (Map.toList funInfos) $ \(_addr, Some info) -> do + IO.print (PP.pretty info) + Monad.when printCrucible $ do + let pos = posFn (Text.pack path) + let funName = + WF.functionNameFromText $ + Text.decodeUtf8With Text.lenientDecode $ + MD.discoveredFunName info + CCC.SomeCFG ssa <- + MS.mkFunCFG (MS.archFunctions archVals) halloc funName pos info + IO.print (CCC.ppCFG' True (CAP.postdomInfo ssa) ssa) + +data DiscoverConfig = DiscoverConfig + { -- Arguments + discBinPath :: FilePath + , discSymbols :: [BS.ByteString] + -- Options + , discPrintCrucible :: Bool + } + +discoverConfig :: Opt.Parser DiscoverConfig +discoverConfig = + DiscoverConfig + <$> MDCU.binOpt + <*> Opt.many (Opt.strArgument (Opt.help "function name" <> Opt.metavar "SYMBOL")) + <*> Opt.switch (Opt.long "crucible" <> Opt.help "output Crucible CFGs") + +discover :: + ( MC.ArchConstraints arch + , MS.GenArchInfo MS.LLVMMemory arch + , CCE.IsSyntaxExtension (MS.MacawExt arch) + , MC.ArchConstraints arch + , MM.MemWidth (MC.ArchAddrWidth arch) + ) => + MAI.ArchitectureInfo arch -> + MS.GenArchVals mem arch -> + DiscoverConfig -> + IO () +discover archInfo archVals cfg = do + ehi <- MDCU.loadElf archInfo (discBinPath cfg) + let symbs = Set.fromList (discSymbols cfg) + discState <- runDiscovery ehi archInfo symbs + displayCfgs (discBinPath cfg) discState archVals (discPrintCrucible cfg) diff --git a/macaw-dump/src/Data/Macaw/Dump/Plt.hs b/macaw-dump/src/Data/Macaw/Dump/Plt.hs new file mode 100644 index 00000000..c20e9ffa --- /dev/null +++ b/macaw-dump/src/Data/Macaw/Dump/Plt.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE TypeOperators #-} + +module Data.Macaw.Dump.Plt + ( PltConfig(..) + , pltConfig + , plt + ) where + +import Data.ElfEdit qualified as EE +import Data.Foldable qualified as F +import Data.Map qualified as Map +import Data.Macaw.Architecture.Info qualified as MAI +import Data.Macaw.CFG qualified as MC +import Data.Macaw.Dump.CLIUtils qualified as MDCU +import Data.Macaw.Memory.ElfLoader.PLTStubs as MMEP +import Data.Macaw.Memory.LoadCommon qualified as MML +import Data.Macaw.Memory qualified as MM +import Options.Applicative qualified as Opt +import Prettyprinter as PP +import System.IO qualified as IO + +data PltConfig = PltConfig + { pltBinPath :: FilePath + } + +pltConfig :: Opt.Parser PltConfig +pltConfig = + PltConfig + <$> MDCU.binOpt + +plt :: + ( MC.ArchAddrWidth arch ~ EE.RelocationWidth reloc + , MM.MemWidth (MC.ArchAddrWidth arch) + , EE.IsRelocationType reloc + ) => + MAI.ArchitectureInfo arch -> + MMEP.PLTStubInfo reloc -> + PltConfig -> + IO () +plt archInfo pltStubInfo cfg = do + ehi <- MDCU.loadElf archInfo (pltBinPath cfg) + let pltStubMap = MMEP.pltStubSymbols pltStubInfo MML.defaultLoadOptions ehi + F.for_ (Map.toAscList pltStubMap) $ \(addr, (symtabEntry, _)) -> do + IO.print (PP.pretty addr PP.<> PP.pretty ":" PP.<+> PP.viaShow (EE.steName symtabEntry)) diff --git a/macaw-ppc-symbolic/macaw-ppc-symbolic.cabal b/macaw-ppc-symbolic/macaw-ppc-symbolic.cabal index def50fa0..a1a20d8e 100644 --- a/macaw-ppc-symbolic/macaw-ppc-symbolic.cabal +++ b/macaw-ppc-symbolic/macaw-ppc-symbolic.cabal @@ -50,12 +50,9 @@ executable macaw-ppc-dump ghc-options: -Wall -Wcompat build-depends: base, - bytestring, - containers, elf-edit, macaw-base, macaw-dump, - macaw-loader, macaw-ppc, macaw-ppc-symbolic, macaw-symbolic diff --git a/macaw-ppc-symbolic/tools/Dump.hs b/macaw-ppc-symbolic/tools/Dump.hs index aa5640d5..f90070fd 100644 --- a/macaw-ppc-symbolic/tools/Dump.hs +++ b/macaw-ppc-symbolic/tools/Dump.hs @@ -4,48 +4,20 @@ module Main (main) where -import Data.ByteString qualified as BS import Data.ElfEdit qualified as EE -import Data.Macaw.BinaryLoader qualified as MBL -import Data.Macaw.Dump.CLI qualified as MDC import Data.Macaw.Dump qualified as MD -import Data.Macaw.Memory.ElfLoader qualified as MM +import Data.Macaw.Memory.ElfLoader.PLTStubs qualified as MMEP import Data.Macaw.PPC qualified as PPC import Data.Macaw.PPC.Symbolic () import Data.Macaw.Symbolic qualified as MS import Data.Proxy (Proxy(..)) -import Data.Set qualified as Set -import System.Exit qualified as Exit -import System.IO qualified as IO - -die :: String -> IO a -die msg = do - IO.hPutStrLn IO.stderr msg - Exit.exitFailure main :: IO () main = do - cli <- MDC.parseCli - let exePath = MDC.cliBinPath cli - bytes <- BS.readFile exePath - case EE.decodeElfHeaderInfo bytes of - Left (_, msg) -> die ("Error parsing ELF header from file '" ++ exePath ++ "': " ++ msg) - Right (EE.SomeElf ehi) -> do - let symbs = Set.fromList (MDC.cliSymbols cli) - case EE.headerClass (EE.header ehi) of - EE.ELFCLASS32 -> do - discState <- MD.runDiscovery ehi PPC.ppc32_linux_info symbs - archVals <- - case MS.archVals (Proxy @PPC.PPC32) Nothing of - Just archVals -> pure archVals - Nothing -> error "impossible" - MD.displayCfgs exePath discState archVals (MDC.cliPrintCrucible cli) - EE.ELFCLASS64 -> do - loadedBinary <- MBL.loadBinary MM.defaultLoadOptions ehi - let archInfo = PPC.ppc64_linux_info loadedBinary - discState <- MD.runDiscovery ehi archInfo symbs - archVals <- - case MS.archVals (Proxy @PPC.PPC64) Nothing of - Just archVals -> pure archVals - Nothing -> error "impossible" - MD.displayCfgs exePath discState archVals (MDC.cliPrintCrucible cli) + archVals <- + case MS.archVals (Proxy @PPC.PPC32) Nothing of + Just archVals -> pure archVals + Nothing -> error "impossible" + let pltStubInfo :: MMEP.PLTStubInfo EE.PPC32_RelocationType + pltStubInfo = error "PLT stub discovery is not supported on PPC" + MD.main PPC.ppc32_linux_info archVals pltStubInfo