commit 03eec1f2ce8811a1762f98bf3edf1c5b4f4fde4d
parent 4304b5edc8b93688779bb49f3846d0a1993370a4
Author: Jared Tobin <jared@jtobin.io>
Date: Wed, 11 Feb 2026 14:19:16 +0400
feat: implement sidecar taint config for secret/public arguments (IMPL7)
Add JSON config file support to declare per-function secret/public
argument registers. The taint analysis seeds entry states accordingly,
enabling detection of secret-dependent memory accesses.
- Add TaintConfig and ArgPolicy types with FromJSON instances
- Add --taint-config (-t) CLI option to load config
- Implement seedArgs to seed entry taint from policy
- Add config-aware dataflow: runDataflowWithConfig, runInterProcWithConfig
- Add config-aware checks: checkCFGWithConfig, checkCFGInterProcWithConfig
- Add 8 tests for config parsing and taint seeding
Config format:
{"func_name": {"secret": ["X0"], "public": ["X1", "X2"]}}
Secret registers are marked Secret at function entry; taint flows
through mov/arithmetic to detect when secrets reach memory addresses.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
Diffstat:
7 files changed, 494 insertions(+), 18 deletions(-)
diff --git a/app/Main.hs b/app/Main.hs
@@ -2,10 +2,16 @@
module Main where
-import Audit.AArch64 (AuditResult(..), Violation(..), ViolationReason(..),
- auditFile, auditFileInterProc, parseFile, regName)
+import Audit.AArch64
+ ( AuditResult(..), Violation(..), ViolationReason(..)
+ , TaintConfig(..)
+ , auditFile, auditFileInterProc
+ , auditFileWithConfig, auditFileInterProcWithConfig
+ , parseFile, regName, loadTaintConfig
+ )
import Data.Aeson (encode)
import qualified Data.ByteString.Lazy.Char8 as BL
+import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
@@ -13,11 +19,12 @@ import Options.Applicative
import System.Exit (exitFailure, exitSuccess)
data Options = Options
- { optInput :: !FilePath
- , optJson :: !Bool
- , optQuiet :: !Bool
- , optInterProc :: !Bool
- , optParseOnly :: !Bool
+ { optInput :: !FilePath
+ , optJson :: !Bool
+ , optQuiet :: !Bool
+ , optInterProc :: !Bool
+ , optParseOnly :: !Bool
+ , optTaintConfig :: !(Maybe FilePath)
} deriving (Eq, Show)
optParser :: Parser Options
@@ -47,6 +54,12 @@ optParser = Options
( long "parse"
<> help "Parse only, no analysis"
)
+ <*> optional (strOption
+ ( long "taint-config"
+ <> short 't'
+ <> metavar "FILE"
+ <> help "JSON file with per-function taint policies"
+ ))
optInfo :: ParserInfo Options
optInfo = info (optParser <**> helper)
@@ -69,16 +82,35 @@ main = do
TIO.putStrLn $ "Parsed " <> T.pack (show n) <> " lines"
exitSuccess
else do
- let auditor = if optInterProc opts then auditFileInterProc else auditFile
- result <- auditor (optInput opts)
- case result of
+ -- Load taint config if provided
+ mcfg <- case optTaintConfig opts of
+ Nothing -> pure (Right emptyConfig)
+ Just path -> loadTaintConfig path
+ case mcfg of
Left err -> do
- TIO.putStrLn $ "Error: " <> err
+ TIO.putStrLn $ "Error loading taint config: " <> err
exitFailure
- Right ar ->
- if optJson opts
- then outputJson ar
- else outputText opts ar
+ Right cfg -> do
+ let auditor = selectAuditor opts cfg
+ result <- auditor (optInput opts)
+ case result of
+ Left err -> do
+ TIO.putStrLn $ "Error: " <> err
+ exitFailure
+ Right ar ->
+ if optJson opts
+ then outputJson ar
+ else outputText opts ar
+ where
+ emptyConfig = TaintConfig Map.empty
+
+ selectAuditor opts cfg
+ | hasConfig && optInterProc opts = auditFileInterProcWithConfig cfg
+ | hasConfig = auditFileWithConfig cfg
+ | optInterProc opts = auditFileInterProc
+ | otherwise = auditFile
+ where
+ hasConfig = not (Map.null (tcPolicies cfg))
outputJson :: AuditResult -> IO ()
outputJson ar = BL.putStrLn (encode (arViolations ar))
diff --git a/lib/Audit/AArch64.hs b/lib/Audit/AArch64.hs
@@ -33,6 +33,10 @@ module Audit.AArch64 (
, auditInterProc
, auditFile
, auditFileInterProc
+ , auditWithConfig
+ , auditInterProcWithConfig
+ , auditFileWithConfig
+ , auditFileInterProcWithConfig
, parseFile
-- * Results
@@ -42,6 +46,12 @@ module Audit.AArch64 (
, Reg
, regName
+ -- * Taint configuration
+ , TaintConfig(..)
+ , ArgPolicy(..)
+ , emptyArgPolicy
+ , loadTaintConfig
+
-- * Re-exports
, ParseError
, showParseError
@@ -50,7 +60,11 @@ module Audit.AArch64 (
import Audit.AArch64.CFG
import Audit.AArch64.Check
import Audit.AArch64.Parser
-import Audit.AArch64.Types (Reg, Violation(..), ViolationReason(..), regName)
+import Audit.AArch64.Types
+ ( Reg, Violation(..), ViolationReason(..), regName
+ , TaintConfig(..), ArgPolicy(..), emptyArgPolicy
+ )
+import Data.Aeson (eitherDecodeStrict')
import qualified Data.ByteString as BS
import Data.Text (Text)
import qualified Data.Text as T
@@ -100,3 +114,35 @@ parseFile path = do
case parseAsm src of
Left err -> pure (Left (T.pack (showParseError err)))
Right lns -> pure (Right (length lns))
+
+-- | Audit assembly source with taint config.
+auditWithConfig :: TaintConfig -> Text -> Text -> Either ParseError AuditResult
+auditWithConfig tcfg name src = do
+ lns <- parseAsm src
+ let cfg = buildCFG lns
+ pure (checkCFGWithConfig tcfg name cfg)
+
+-- | Audit with inter-procedural analysis and taint config.
+auditInterProcWithConfig :: TaintConfig -> Text -> Text
+ -> Either ParseError AuditResult
+auditInterProcWithConfig tcfg name src = do
+ lns <- parseAsm src
+ let cfg = buildCFG lns
+ pure (checkCFGInterProcWithConfig tcfg name cfg)
+
+-- | Audit an assembly file with taint config.
+auditFileWithConfig :: TaintConfig -> FilePath -> IO (Either Text AuditResult)
+auditFileWithConfig tcfg = auditFileWith (auditWithConfig tcfg)
+
+-- | Audit an assembly file with inter-procedural analysis and taint config.
+auditFileInterProcWithConfig :: TaintConfig -> FilePath
+ -> IO (Either Text AuditResult)
+auditFileInterProcWithConfig tcfg = auditFileWith (auditInterProcWithConfig tcfg)
+
+-- | Load a taint config from a JSON file.
+loadTaintConfig :: FilePath -> IO (Either Text TaintConfig)
+loadTaintConfig path = do
+ bs <- BS.readFile path
+ case eitherDecodeStrict' bs of
+ Left err -> pure (Left (T.pack err))
+ Right cfg -> pure (Right cfg)
diff --git a/lib/Audit/AArch64/Check.hs b/lib/Audit/AArch64/Check.hs
@@ -17,6 +17,8 @@ module Audit.AArch64.Check (
, checkBlock
, checkCFG
, checkCFGInterProc
+ , checkCFGWithConfig
+ , checkCFGInterProcWithConfig
, AuditResult(..)
) where
@@ -26,6 +28,7 @@ import Audit.AArch64.Types
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as Map
import Data.Text (Text)
+import Data.Maybe (fromMaybe)
-- | Result of auditing assembly.
data AuditResult = AuditResult
@@ -189,3 +192,43 @@ checkBlockWithSummary sym summaries st0 lns = go mempty st0 lns
Nothing -> analyzeLine l st
_ -> analyzeLine l st
in go (acc <> result) st' ls
+
+-- | Check entire CFG with taint config.
+checkCFGWithConfig :: TaintConfig -> Text -> CFG -> AuditResult
+checkCFGWithConfig tcfg sym cfg =
+ let inStates = runDataflowWithConfig tcfg cfg
+ blocks = cfgBlocks cfg
+ in mconcat
+ [ fst (checkBlock blockSym inState (bbLines bb))
+ | (idx, bb) <- zip [0..] blocks
+ , let blockSym = fromMaybe sym (bbLabel bb)
+ inState = IM.findWithDefault initTaintState idx inStates
+ ]
+
+-- | Check entire CFG with inter-procedural analysis and taint config.
+checkCFGInterProcWithConfig :: TaintConfig -> Text -> CFG -> AuditResult
+checkCFGInterProcWithConfig tcfg sym cfg =
+ let summaries = runInterProcWithConfig tcfg cfg
+ funcs = functionLabels cfg
+ in mconcat
+ [ checkFunctionWithConfig cfg tcfg sym func summaries
+ | func <- funcs
+ ]
+ where
+ checkFunctionWithConfig c tc s func summs =
+ let blockIdxs = functionBlocks c func
+ bs = cfgBlocks c
+ -- Seed entry state with function policy
+ baseEntry = initTaintState
+ entryState = case Map.lookup func (tcPolicies tc) of
+ Nothing -> baseEntry
+ Just policy -> seedArgs policy baseEntry
+ inStatesIM = runFunctionBlocksWithEntry c blockIdxs summs entryState
+ inStatesMap = IM.foldlWithKey' toMap Map.empty inStatesIM
+ in mconcat
+ [ fst (checkBlockWithSummary s summs inState (bbLines bb))
+ | idx <- blockIdxs
+ , let bb = bs !! idx
+ inState = Map.findWithDefault entryState idx inStatesMap
+ ]
+ toMap m k v = Map.insert k v m
diff --git a/lib/Audit/AArch64/Taint.hs b/lib/Audit/AArch64/Taint.hs
@@ -25,6 +25,7 @@ module Audit.AArch64.Taint (
, publicRoots
, joinTaintState
, runDataflow
+ , runDataflowWithConfig
-- * Function summaries
, FuncSummary(..)
, initSummary
@@ -33,10 +34,18 @@ module Audit.AArch64.Taint (
, runFunctionDataflow
, runFunctionBlocks
, runInterProc
+ , runInterProcWithConfig
+ , runFunctionBlocksWithEntry
+ -- * Entry taint seeding
+ , seedArgs
) where
import Audit.AArch64.CFG
import Audit.AArch64.Types
+ ( Reg(..), Instr(..), Line(..), Operand(..), AddrMode(..)
+ , Taint(..), joinTaint, Provenance(..), joinProvenance
+ , TaintConfig(..), ArgPolicy(..)
+ )
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
@@ -102,6 +111,26 @@ initTaintState = TaintState
, tsStackProv = IM.empty
}
+-- | Seed argument registers according to policy.
+-- Secret registers are marked Secret with ProvUnknown.
+-- Public registers are marked Public with ProvPublic.
+-- If a register appears in both lists, secret takes precedence.
+seedArgs :: ArgPolicy -> TaintState -> TaintState
+seedArgs policy st =
+ let -- Apply public first, then secret (so secret wins on overlap)
+ st1 = Set.foldr markPublic st (apPublic policy)
+ st2 = Set.foldr markSecret st1 (apSecret policy)
+ in st2
+ where
+ markPublic r s = s
+ { tsRegs = Map.insert r Public (tsRegs s)
+ , tsProv = Map.insert r ProvPublic (tsProv s)
+ }
+ markSecret r s = s
+ { tsRegs = Map.insert r Secret (tsRegs s)
+ , tsProv = Map.insert r ProvUnknown (tsProv s)
+ }
+
-- | Get the taint of a register.
getTaint :: Reg -> TaintState -> Taint
getTaint r st = Map.findWithDefault Unknown r (tsRegs st)
@@ -739,3 +768,145 @@ findCallers cfg target =
where
callGraph = buildCallGraph cfg
callees f = Map.findWithDefault [] f callGraph
+
+-- ---------------------------------------------------------------------
+-- Config-aware dataflow analysis
+
+-- | Run forward dataflow with taint config.
+-- Entry states are seeded according to function-specific policies.
+runDataflowWithConfig :: TaintConfig -> CFG -> IntMap TaintState
+runDataflowWithConfig tcfg cfg
+ | null (cfgBlocks cfg) = IM.empty
+ | otherwise = go initWorklist initIn IM.empty
+ where
+ blocks = cfgBlocks cfg
+ nBlocks = length blocks
+
+ -- Build a map from block index to entry taint state
+ -- Entry blocks of functions get their policy applied
+ initIn = IM.fromList
+ [ (i, entryState i bb)
+ | (i, bb) <- zip [0..] blocks
+ ]
+
+ entryState idx bb =
+ let base = initTaintState
+ in case bbLabel bb of
+ Nothing -> base
+ Just lbl ->
+ -- Check if this block is a function entry
+ case functionBlocks cfg lbl of
+ (entry:_) | entry == idx ->
+ case Map.lookup lbl (tcPolicies tcfg) of
+ Nothing -> base
+ Just policy -> seedArgs policy base
+ _ -> base
+
+ initWorklist = IS.fromList [0..nBlocks-1]
+
+ go worklist inStates outStates
+ | IS.null worklist = inStates
+ | otherwise =
+ let (idx, worklist') = IS.deleteFindMin worklist
+ bb = blocks !! idx
+ inState = IM.findWithDefault initTaintState idx inStates
+ outState = analyzeBlock (bbLines bb) inState
+ oldOut = IM.lookup idx outStates
+ changed = oldOut /= Just outState
+ outStates' = IM.insert idx outState outStates
+ succs = blockSuccessors cfg idx
+ (worklist'', inStates') = if changed
+ then propagate succs outState worklist' inStates
+ else (worklist', inStates)
+ in go worklist'' inStates' outStates'
+
+ propagate [] _ wl ins = (wl, ins)
+ propagate (s:ss) out wl ins =
+ let oldIn = IM.findWithDefault emptyTaintState s ins
+ newIn = joinTaintState oldIn out
+ ins' = IM.insert s newIn ins
+ wl' = if oldIn /= newIn then IS.insert s wl else wl
+ in propagate ss out wl' ins'
+
+-- | Run inter-procedural analysis with taint config.
+runInterProcWithConfig :: TaintConfig -> CFG -> Map Text FuncSummary
+runInterProcWithConfig tcfg cfg = go initSummaries (Set.fromList funcs)
+ where
+ funcs = functionLabels cfg
+ initSummaries = Map.fromList [(f, initSummary) | f <- funcs]
+
+ go summaries worklist
+ | Set.null worklist = summaries
+ | otherwise =
+ let (func, worklist') = Set.deleteFindMin worklist
+ blockIdxs = functionBlocks cfg func
+ outState = runFunctionDataflowWithConfig tcfg cfg func
+ blockIdxs summaries
+ newSumm = FuncSummary outState
+ oldSumm = Map.findWithDefault initSummary func summaries
+ changed = newSumm /= oldSumm
+ summaries' = Map.insert func newSumm summaries
+ callers = findCallers cfg func
+ worklist'' = if changed
+ then foldr Set.insert worklist' callers
+ else worklist'
+ in go summaries' worklist''
+
+-- | Run function dataflow with config-based entry seeding.
+runFunctionDataflowWithConfig :: TaintConfig -> CFG -> Text -> [Int]
+ -> Map Text FuncSummary -> TaintState
+runFunctionDataflowWithConfig tcfg cfg funcName blockIndices summaries =
+ let blocks = cfgBlocks cfg
+ -- Seed entry state with function policy
+ baseEntry = initTaintState
+ entryState = case Map.lookup funcName (tcPolicies tcfg) of
+ Nothing -> baseEntry
+ Just policy -> seedArgs policy baseEntry
+ inStates = runFunctionBlocksWithEntry cfg blockIndices summaries entryState
+ returnOuts =
+ [ analyzeBlockWithSummaries bb inState summaries
+ | i <- blockIndices
+ , let bb = blocks !! i
+ inState = IM.findWithDefault entryState i inStates
+ , endsWithRet bb
+ ]
+ in case returnOuts of
+ [] -> initTaintState
+ (o:os) -> foldl joinTaintState o os
+
+-- | Run function blocks with a custom entry state.
+runFunctionBlocksWithEntry :: CFG -> [Int] -> Map Text FuncSummary
+ -> TaintState -> IntMap TaintState
+runFunctionBlocksWithEntry _ [] _ _ = IM.empty
+runFunctionBlocksWithEntry cfg (entryIdx:rest) summaries entryState =
+ go initWorklist initIn IM.empty
+ where
+ blocks = cfgBlocks cfg
+ blockSet = IS.fromList (entryIdx:rest)
+
+ initIn = IM.singleton entryIdx entryState
+ initWorklist = IS.singleton entryIdx
+
+ go wl inStates outStates
+ | IS.null wl = inStates
+ | otherwise =
+ let (idx, wl') = IS.deleteFindMin wl
+ bb = blocks !! idx
+ inState = IM.findWithDefault entryState idx inStates
+ outState = analyzeBlockWithSummaries bb inState summaries
+ oldOut = IM.lookup idx outStates
+ changed = oldOut /= Just outState
+ outStates' = IM.insert idx outState outStates
+ succs = filter (`IS.member` blockSet) (blockSuccessors cfg idx)
+ (wl'', inStates') = if changed
+ then propagate succs outState wl' inStates
+ else (wl', inStates)
+ in go wl'' inStates' outStates'
+
+ propagate [] _ wl ins = (wl, ins)
+ propagate (s:ss) out wl ins =
+ let oldIn = IM.findWithDefault entryState s ins
+ newIn = joinTaintState oldIn out
+ ins' = IM.insert s newIn ins
+ wl' = if oldIn /= newIn then IS.insert s wl else wl
+ in propagate ss out wl' ins'
diff --git a/lib/Audit/AArch64/Types.hs b/lib/Audit/AArch64/Types.hs
@@ -14,6 +14,7 @@ module Audit.AArch64.Types (
-- * Registers
Reg(..)
, regName
+ , regFromText
-- * Operands and addressing
, Shift(..)
@@ -36,9 +37,18 @@ module Audit.AArch64.Types (
-- * Analysis results
, Violation(..)
, ViolationReason(..)
+
+ -- * Taint configuration
+ , TaintConfig(..)
+ , ArgPolicy(..)
+ , emptyArgPolicy
) where
-import Data.Aeson (ToJSON(..), (.=), object)
+import Data.Aeson (ToJSON(..), FromJSON(..), (.=), (.:?), object, withObject)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import Data.Set (Set)
+import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
@@ -83,6 +93,55 @@ instance ToJSON Reg where
regName :: Reg -> Text
regName r = T.toLower (T.pack (show r))
+-- | Parse a register from text (case-insensitive).
+regFromText :: Text -> Maybe Reg
+regFromText t = Map.lookup (T.toUpper t) regMap
+ where
+ regMap :: Map Text Reg
+ regMap = Map.fromList
+ [ ("X0", X0), ("X1", X1), ("X2", X2), ("X3", X3)
+ , ("X4", X4), ("X5", X5), ("X6", X6), ("X7", X7)
+ , ("X8", X8), ("X9", X9), ("X10", X10), ("X11", X11)
+ , ("X12", X12), ("X13", X13), ("X14", X14), ("X15", X15)
+ , ("X16", X16), ("X17", X17), ("X18", X18), ("X19", X19)
+ , ("X20", X20), ("X21", X21), ("X22", X22), ("X23", X23)
+ , ("X24", X24), ("X25", X25), ("X26", X26), ("X27", X27)
+ , ("X28", X28), ("X29", X29), ("X30", X30)
+ , ("W0", W0), ("W1", W1), ("W2", W2), ("W3", W3)
+ , ("W4", W4), ("W5", W5), ("W6", W6), ("W7", W7)
+ , ("W8", W8), ("W9", W9), ("W10", W10), ("W11", W11)
+ , ("W12", W12), ("W13", W13), ("W14", W14), ("W15", W15)
+ , ("W16", W16), ("W17", W17), ("W18", W18), ("W19", W19)
+ , ("W20", W20), ("W21", W21), ("W22", W22), ("W23", W23)
+ , ("W24", W24), ("W25", W25), ("W26", W26), ("W27", W27)
+ , ("W28", W28), ("W29", W29), ("W30", W30)
+ , ("SP", SP), ("XZR", XZR), ("WZR", WZR)
+ , ("D0", D0), ("D1", D1), ("D2", D2), ("D3", D3)
+ , ("D4", D4), ("D5", D5), ("D6", D6), ("D7", D7)
+ , ("D8", D8), ("D9", D9), ("D10", D10), ("D11", D11)
+ , ("D12", D12), ("D13", D13), ("D14", D14), ("D15", D15)
+ , ("D16", D16), ("D17", D17), ("D18", D18), ("D19", D19)
+ , ("D20", D20), ("D21", D21), ("D22", D22), ("D23", D23)
+ , ("D24", D24), ("D25", D25), ("D26", D26), ("D27", D27)
+ , ("D28", D28), ("D29", D29), ("D30", D30), ("D31", D31)
+ , ("S0", S0), ("S1", S1), ("S2", S2), ("S3", S3)
+ , ("S4", S4), ("S5", S5), ("S6", S6), ("S7", S7)
+ , ("S8", S8), ("S9", S9), ("S10", S10), ("S11", S11)
+ , ("S12", S12), ("S13", S13), ("S14", S14), ("S15", S15)
+ , ("S16", S16), ("S17", S17), ("S18", S18), ("S19", S19)
+ , ("S20", S20), ("S21", S21), ("S22", S22), ("S23", S23)
+ , ("S24", S24), ("S25", S25), ("S26", S26), ("S27", S27)
+ , ("S28", S28), ("S29", S29), ("S30", S30), ("S31", S31)
+ , ("Q0", Q0), ("Q1", Q1), ("Q2", Q2), ("Q3", Q3)
+ , ("Q4", Q4), ("Q5", Q5), ("Q6", Q6), ("Q7", Q7)
+ , ("Q8", Q8), ("Q9", Q9), ("Q10", Q10), ("Q11", Q11)
+ , ("Q12", Q12), ("Q13", Q13), ("Q14", Q14), ("Q15", Q15)
+ , ("Q16", Q16), ("Q17", Q17), ("Q18", Q18), ("Q19", Q19)
+ , ("Q20", Q20), ("Q21", Q21), ("Q22", Q22), ("Q23", Q23)
+ , ("Q24", Q24), ("Q25", Q25), ("Q26", Q26), ("Q27", Q27)
+ , ("Q28", Q28), ("Q29", Q29), ("Q30", Q30), ("Q31", Q31)
+ ]
+
-- | Shift operations for indexed addressing.
data Shift
= LSL !Int -- ^ Logical shift left
@@ -293,3 +352,39 @@ instance ToJSON Violation where
, "instr" .= show (vInstr v)
, "reason" .= vReason v
]
+
+-- | Per-function argument taint policy.
+-- Specifies which registers should be seeded as secret or public.
+data ArgPolicy = ArgPolicy
+ { apSecret :: !(Set Reg) -- ^ Registers to mark as Secret
+ , apPublic :: !(Set Reg) -- ^ Registers to mark as Public
+ } deriving (Eq, Show)
+
+-- | Empty argument policy (no overrides).
+emptyArgPolicy :: ArgPolicy
+emptyArgPolicy = ArgPolicy Set.empty Set.empty
+
+instance FromJSON ArgPolicy where
+ parseJSON = withObject "ArgPolicy" $ \o -> do
+ secretTexts <- o .:? "secret"
+ publicTexts <- o .:? "public"
+ let parseRegs :: Maybe [Text] -> Either Text (Set Reg)
+ parseRegs Nothing = Right Set.empty
+ parseRegs (Just ts) =
+ let parsed = map (\t -> (t, regFromText t)) ts
+ bad = [t | (t, Nothing) <- parsed]
+ in case bad of
+ [] -> Right $ Set.fromList [r | (_, Just r) <- parsed]
+ (b:_) -> Left $ "invalid register: " <> b
+ case (parseRegs secretTexts, parseRegs publicTexts) of
+ (Left e, _) -> fail (T.unpack e)
+ (_, Left e) -> fail (T.unpack e)
+ (Right s, Right p) -> pure $ ArgPolicy s p
+
+-- | Taint configuration: maps function symbols to argument policies.
+newtype TaintConfig = TaintConfig
+ { tcPolicies :: Map Text ArgPolicy
+ } deriving (Eq, Show)
+
+instance FromJSON TaintConfig where
+ parseJSON v = TaintConfig <$> parseJSON v
diff --git a/ppad-auditor.cabal b/ppad-auditor.cabal
@@ -48,6 +48,7 @@ executable auditor
aeson
, base
, bytestring
+ , containers
, optparse-applicative >= 0.16 && < 0.19
, ppad-auditor
, text
@@ -60,8 +61,10 @@ test-suite auditor-tests
ghc-options:
-rtsopts -Wall -O2
build-depends:
- base
+ aeson
+ , base
, bytestring
+ , containers
, ppad-auditor
, tasty
, tasty-hunit
diff --git a/test/Main.hs b/test/Main.hs
@@ -6,6 +6,10 @@ import Audit.AArch64
import Audit.AArch64.Parser
import Audit.AArch64.Taint
import Audit.AArch64.Types
+import Data.Aeson (eitherDecodeStrict')
+import qualified Data.ByteString.Char8 as B8
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
import qualified Data.Text as T
import Test.Tasty
import Test.Tasty.HUnit
@@ -17,6 +21,7 @@ main = defaultMain $ testGroup "ppad-auditor" [
, auditTests
, interprocTests
, provenanceTests
+ , taintConfigTests
]
-- Parser tests
@@ -462,3 +467,84 @@ provenanceTests = testGroup "Provenance" [
Left e -> assertFailure $ "parse failed: " ++ show e
Right ar -> assertEqual "one violation" 1 (length (arViolations ar))
]
+
+-- Taint config tests
+
+taintConfigTests :: TestTree
+taintConfigTests = testGroup "TaintConfig" [
+ testCase "parse valid config" $ do
+ let json = B8.pack "{\"foo\": {\"secret\": [\"X0\"], \"public\": [\"X1\"]}}"
+ case eitherDecodeStrict' json :: Either String TaintConfig of
+ Left e -> assertFailure $ "parse failed: " ++ e
+ Right cfg -> do
+ let policy = Map.lookup "foo" (tcPolicies cfg)
+ case policy of
+ Nothing -> assertFailure "missing policy for 'foo'"
+ Just p -> do
+ assertEqual "secret regs" (Set.singleton X0) (apSecret p)
+ assertEqual "public regs" (Set.singleton X1) (apPublic p)
+
+ , testCase "parse invalid register" $ do
+ let json = B8.pack "{\"foo\": {\"secret\": [\"INVALID\"]}}"
+ case eitherDecodeStrict' json :: Either String TaintConfig of
+ Left _ -> pure () -- Expected to fail
+ Right _ -> assertFailure "should have failed on invalid register"
+
+ , testCase "seedArgs marks secret" $ do
+ let policy = ArgPolicy (Set.singleton X0) Set.empty
+ st = seedArgs policy initTaintState
+ assertEqual "X0 is secret" Secret (getTaint X0 st)
+
+ , testCase "seedArgs marks public" $ do
+ let policy = ArgPolicy Set.empty (Set.singleton X0)
+ st = seedArgs policy initTaintState
+ assertEqual "X0 is public" Public (getTaint X0 st)
+
+ , testCase "secret takes precedence over public" $ do
+ let policy = ArgPolicy (Set.singleton X0) (Set.singleton X0)
+ st = seedArgs policy initTaintState
+ assertEqual "X0 is secret" Secret (getTaint X0 st)
+
+ , testCase "secret arg causes violation on indexed access" $ do
+ let src = T.unlines
+ [ "_mul_wnaf:"
+ , " ldr x8, [x20, x0]" -- x0 as index
+ , " ret"
+ ]
+ cfg = TaintConfig $ Map.singleton "_mul_wnaf"
+ (ArgPolicy (Set.singleton X0) Set.empty)
+ case auditWithConfig cfg "test" src of
+ Left e -> assertFailure $ "parse failed: " ++ show e
+ Right ar -> do
+ assertEqual "one violation" 1 (length (arViolations ar))
+ case arViolations ar of
+ [v] -> case vReason v of
+ SecretIndex X0 -> pure ()
+ other -> assertFailure $ "wrong reason: " ++ show other
+ _ -> assertFailure "expected one violation"
+
+ , testCase "public arg allows indexed access" $ do
+ let src = T.unlines
+ [ "_foo:"
+ , " ldr x8, [x20, x0]" -- x0 as index
+ , " ret"
+ ]
+ cfg = TaintConfig $ Map.singleton "_foo"
+ (ArgPolicy Set.empty (Set.singleton X0))
+ case auditWithConfig cfg "test" src of
+ Left e -> assertFailure $ "parse failed: " ++ show e
+ Right ar -> assertEqual "no violations" 0 (length (arViolations ar))
+
+ , testCase "interproc with config" $ do
+ let src = T.unlines
+ [ "_mul_wnaf:"
+ , " ldr x8, [x20, x0]" -- x0 as secret index -> violation
+ , " ret"
+ ]
+ cfg = TaintConfig $ Map.singleton "_mul_wnaf"
+ (ArgPolicy (Set.singleton X0) Set.empty)
+ case auditInterProcWithConfig cfg "test" src of
+ Left e -> assertFailure $ "parse failed: " ++ show e
+ Right ar -> do
+ assertEqual "one violation" 1 (length (arViolations ar))
+ ]
