dump: Add subcommand to dump PLT stubs

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,

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

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

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

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"

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