commit 4a6f3a6ad8cb49b48c71191a41d94bdf18e271e3
parent 70ad704ffd5bd9000441e69539fbfc3e34f74104
Author: Jared Tobin <jared@jtobin.io>
Date: Thu, 26 Feb 2026 16:35:30 +0400
feat: assume STG stack slots are public by default
GHC's STG stack holds closure pointers and return addresses, which are
inherently public (addresses, not secret data). This adds a configurable
assumption that untracked STG stack slots default to Public/ProvPublic/KindPtr.
- Add tcAssumeStgPublic to TaintConfig (default: True)
- Add tsAssumeStgPublic to TaintState, threaded through dataflow
- Add --assume-stg-private CLI flag to restore conservative behavior
- Update setTaintLoadStgStack to use the assumption for defaults
This eliminates false positives from STG stack loads at function entry,
such as the x22 violation in continuation blocks that load arguments
from [x20, #offset].
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
Diffstat:
4 files changed, 202 insertions(+), 137 deletions(-)
diff --git a/app/Main.hs b/app/Main.hs
@@ -44,7 +44,8 @@ data Options = Options
, optZSymbol :: !(Maybe Text)
, optListSymbols :: !Bool
, optSymbolFilter :: !(Maybe Text)
- , optCallers :: !Bool
+ , optCallers :: !Bool
+ , optAssumeStgPrivate :: !Bool
} deriving (Eq, Show)
optParser :: Parser Options
@@ -126,6 +127,10 @@ optParser = Options
<> short 'c'
<> help "Show callers instead of callees (use with --symbol)"
)
+ <*> switch
+ ( long "assume-stg-private"
+ <> help "Treat untracked STG stack slots as private (default: public)"
+ )
optInfo :: ParserInfo Options
optInfo = info (optParser <**> helper)
@@ -185,8 +190,11 @@ main = do
Left err -> do
TIO.putStrLn $ "Error loading taint config: " <> err
exitFailure
- Right cfg -> do
- let auditor = selectAuditor opts' cfg
+ Right baseCfg -> do
+ -- Apply CLI flag for STG assumption (--assume-stg-private overrides)
+ let assumeStg = not (optAssumeStgPrivate opts')
+ cfg = baseCfg { tcAssumeStgPublic = assumeStg }
+ auditor = selectAuditor opts' cfg
result <- auditor (optInput opts')
case result of
Left err -> do
@@ -197,15 +205,17 @@ main = do
then outputJson opts' ar
else outputText opts' ar
where
- emptyConfig = TaintConfig Map.empty
+ emptyConfig = TaintConfig Map.empty True
selectAuditor opts cfg
- | hasConfig && optInterProc opts = auditFileInterProcWithConfig cfg
- | hasConfig = auditFileWithConfig cfg
- | optInterProc opts = auditFileInterProc
- | otherwise = auditFile
+ | needsConfig && optInterProc opts = auditFileInterProcWithConfig cfg
+ | needsConfig = auditFileWithConfig cfg
+ | optInterProc opts = auditFileInterProc
+ | otherwise = auditFile
where
- hasConfig = not (Map.null (tcPolicies cfg))
+ -- Use config path if we have policies OR non-default STG assumption
+ needsConfig = not (Map.null (tcPolicies cfg))
+ || not (tcAssumeStgPublic cfg)
outputJson :: Options -> AuditResult -> IO ()
outputJson opts ar =
diff --git a/lib/Audit/AArch64/Taint.hs b/lib/Audit/AArch64/Taint.hs
@@ -15,8 +15,9 @@
-- secret-derived values are flagged when used in memory addressing.
module Audit.AArch64.Taint (
- TaintState
+ TaintState(..)
, initTaintState
+ , initTaintStateWith
, analyzeLine
, analyzeBlock
, getTaint
@@ -95,6 +96,8 @@ data TaintState = TaintState
-- ^ Coarse heap kind bucket
, tsHeapSlots :: !(Map (Reg, Int) (Taint, Provenance, RegKind))
-- ^ Refined heap slots keyed by (base register, offset)
+ , tsAssumeStgPublic :: !Bool
+ -- ^ Assume untracked STG stack slots are public pointers
} deriving (Eq, Show)
-- | GHC 9.10.3 AArch64 public root registers.
@@ -123,41 +126,53 @@ publicRoots =
]
-- | Empty taint state (no known taints).
+-- Assumes STG stack slots are public by default.
emptyTaintState :: TaintState
-emptyTaintState = TaintState
- { tsRegs = Map.empty
- , tsStack = IM.empty
- , tsProv = Map.empty
- , tsStackProv = IM.empty
- , tsKind = Map.empty
- , tsStackKind = IM.empty
- , tsStgStack = IM.empty
- , tsStgStackProv = IM.empty
- , tsStgStackKind = IM.empty
- , tsHeapTaint = Unknown
- , tsHeapProv = ProvUnknown
- , tsHeapKind = KindUnknown
- , tsHeapSlots = Map.empty
+emptyTaintState = emptyTaintStateWith True
+
+-- | Empty taint state with configurable STG assumption.
+emptyTaintStateWith :: Bool -> TaintState
+emptyTaintStateWith assumeStgPublic = TaintState
+ { tsRegs = Map.empty
+ , tsStack = IM.empty
+ , tsProv = Map.empty
+ , tsStackProv = IM.empty
+ , tsKind = Map.empty
+ , tsStackKind = IM.empty
+ , tsStgStack = IM.empty
+ , tsStgStackProv = IM.empty
+ , tsStgStackKind = IM.empty
+ , tsHeapTaint = Unknown
+ , tsHeapProv = ProvUnknown
+ , tsHeapKind = KindUnknown
+ , tsHeapSlots = Map.empty
+ , tsAssumeStgPublic = assumeStgPublic
}
-- | Initial taint state with public roots marked.
-- Public roots are marked as Ptr kind (they are pointers).
-- Heap bucket starts Unknown (conservative for untracked memory).
+-- Assumes STG stack slots are public by default.
initTaintState :: TaintState
-initTaintState = TaintState
- { tsRegs = Map.fromList [(r, Public) | r <- publicRoots]
- , tsStack = IM.empty
- , tsProv = Map.fromList [(r, ProvPublic) | r <- publicRoots]
- , tsStackProv = IM.empty
- , tsKind = Map.fromList [(r, KindPtr) | r <- publicRoots]
- , tsStackKind = IM.empty
- , tsStgStack = IM.empty
- , tsStgStackProv = IM.empty
- , tsStgStackKind = IM.empty
- , tsHeapTaint = Unknown
- , tsHeapProv = ProvUnknown
- , tsHeapKind = KindUnknown
- , tsHeapSlots = Map.empty
+initTaintState = initTaintStateWith True
+
+-- | Initial taint state with configurable STG assumption.
+initTaintStateWith :: Bool -> TaintState
+initTaintStateWith assumeStgPublic = TaintState
+ { tsRegs = Map.fromList [(r, Public) | r <- publicRoots]
+ , tsStack = IM.empty
+ , tsProv = Map.fromList [(r, ProvPublic) | r <- publicRoots]
+ , tsStackProv = IM.empty
+ , tsKind = Map.fromList [(r, KindPtr) | r <- publicRoots]
+ , tsStackKind = IM.empty
+ , tsStgStack = IM.empty
+ , tsStgStackProv = IM.empty
+ , tsStgStackKind = IM.empty
+ , tsHeapTaint = Unknown
+ , tsHeapProv = ProvUnknown
+ , tsHeapKind = KindUnknown
+ , tsHeapSlots = Map.empty
+ , tsAssumeStgPublic = assumeStgPublic
}
-- | Seed argument registers and STG stack slots according to policy.
@@ -605,15 +620,21 @@ getHeapSlot :: Reg -> Int -> TaintState -> Maybe (Taint, Provenance, RegKind)
getHeapSlot base off st = Map.lookup (base, off) (tsHeapSlots st)
-- | Set taint for a loaded value from a known STG stack slot.
--- If we have tracked taint/provenance/kind at this offset, use it; else Unknown.
+-- If we have tracked taint/provenance/kind at this offset, use it.
+-- Otherwise, use the STG assumption: if tsAssumeStgPublic is True,
+-- untracked slots default to Public/ProvPublic/KindPtr (closure pointers);
+-- if False, they default to Unknown/ProvUnknown/KindUnknown.
-- Public roots always get Public/ProvPublic/KindPtr.
setTaintLoadStgStack :: Reg -> Int -> TaintState -> TaintState
setTaintLoadStgStack dst offset st
| isPublicRoot dst = setTaintProvKind dst Public ProvPublic KindPtr st
| otherwise =
- let taint = IM.findWithDefault Unknown offset (tsStgStack st)
- prov = IM.findWithDefault ProvUnknown offset (tsStgStackProv st)
- kind = IM.findWithDefault KindUnknown offset (tsStgStackKind st)
+ let (defT, defP, defK) = if tsAssumeStgPublic st
+ then (Public, ProvPublic, KindPtr)
+ else (Unknown, ProvUnknown, KindUnknown)
+ taint = IM.findWithDefault defT offset (tsStgStack st)
+ prov = IM.findWithDefault defP offset (tsStgStackProv st)
+ kind = IM.findWithDefault defK offset (tsStgStackKind st)
in setTaintProvKind dst taint prov kind st
where
isPublicRoot r = r `elem` publicRoots
@@ -953,20 +974,21 @@ invalidateCallerSaved st = st
-- Stack slots (SP and STG), provenance, kinds, and heap bucket are also joined.
joinTaintState :: TaintState -> TaintState -> TaintState
joinTaintState a b = TaintState
- { tsRegs = Map.unionWith joinTaint (tsRegs a) (tsRegs b)
- , tsStack = IM.unionWith joinTaint (tsStack a) (tsStack b)
- , tsProv = Map.unionWith joinProvenance (tsProv a) (tsProv b)
- , tsStackProv = IM.unionWith joinProvenance (tsStackProv a) (tsStackProv b)
- , tsKind = Map.unionWith joinKind (tsKind a) (tsKind b)
- , tsStackKind = IM.unionWith joinKind (tsStackKind a) (tsStackKind b)
- , tsStgStack = IM.unionWith joinTaint (tsStgStack a) (tsStgStack b)
- , tsStgStackProv = IM.unionWith joinProvenance (tsStgStackProv a)
- (tsStgStackProv b)
- , tsStgStackKind = IM.unionWith joinKind (tsStgStackKind a) (tsStgStackKind b)
- , tsHeapTaint = joinTaint (tsHeapTaint a) (tsHeapTaint b)
- , tsHeapProv = joinProvenance (tsHeapProv a) (tsHeapProv b)
- , tsHeapKind = joinKind (tsHeapKind a) (tsHeapKind b)
- , tsHeapSlots = Map.unionWith joinSlot (tsHeapSlots a) (tsHeapSlots b)
+ { tsRegs = Map.unionWith joinTaint (tsRegs a) (tsRegs b)
+ , tsStack = IM.unionWith joinTaint (tsStack a) (tsStack b)
+ , tsProv = Map.unionWith joinProvenance (tsProv a) (tsProv b)
+ , tsStackProv = IM.unionWith joinProvenance (tsStackProv a) (tsStackProv b)
+ , tsKind = Map.unionWith joinKind (tsKind a) (tsKind b)
+ , tsStackKind = IM.unionWith joinKind (tsStackKind a) (tsStackKind b)
+ , tsStgStack = IM.unionWith joinTaint (tsStgStack a) (tsStgStack b)
+ , tsStgStackProv = IM.unionWith joinProvenance (tsStgStackProv a)
+ (tsStgStackProv b)
+ , tsStgStackKind = IM.unionWith joinKind (tsStgStackKind a) (tsStgStackKind b)
+ , tsHeapTaint = joinTaint (tsHeapTaint a) (tsHeapTaint b)
+ , tsHeapProv = joinProvenance (tsHeapProv a) (tsHeapProv b)
+ , tsHeapKind = joinKind (tsHeapKind a) (tsHeapKind b)
+ , tsHeapSlots = Map.unionWith joinSlot (tsHeapSlots a) (tsHeapSlots b)
+ , tsAssumeStgPublic = tsAssumeStgPublic a -- Config flag, should be same in both
}
where
joinSlot (t1, p1, k1) (t2, p2, k2) =
@@ -1024,20 +1046,25 @@ newtype FuncSummary = FuncSummary { summaryState :: TaintState }
-- | Initial conservative summary: all caller-saved are Unknown.
initSummary :: FuncSummary
-initSummary = FuncSummary $ TaintState
- { tsRegs = Map.fromList [ (r, Unknown) | r <- callerSavedRegs ]
- , tsStack = IM.empty
- , tsProv = Map.fromList [ (r, ProvUnknown) | r <- callerSavedRegs ]
- , tsStackProv = IM.empty
- , tsKind = Map.fromList [ (r, KindUnknown) | r <- callerSavedRegs ]
- , tsStackKind = IM.empty
- , tsStgStack = IM.empty
- , tsStgStackProv = IM.empty
- , tsStgStackKind = IM.empty
- , tsHeapTaint = Unknown
- , tsHeapProv = ProvUnknown
- , tsHeapKind = KindUnknown
- , tsHeapSlots = Map.empty
+initSummary = initSummaryWith True
+
+-- | Initial summary with configurable STG assumption.
+initSummaryWith :: Bool -> FuncSummary
+initSummaryWith assumeStgPublic = FuncSummary $ TaintState
+ { tsRegs = Map.fromList [ (r, Unknown) | r <- callerSavedRegs ]
+ , tsStack = IM.empty
+ , tsProv = Map.fromList [ (r, ProvUnknown) | r <- callerSavedRegs ]
+ , tsStackProv = IM.empty
+ , tsKind = Map.fromList [ (r, KindUnknown) | r <- callerSavedRegs ]
+ , tsStackKind = IM.empty
+ , tsStgStack = IM.empty
+ , tsStgStackProv = IM.empty
+ , tsStgStackKind = IM.empty
+ , tsHeapTaint = Unknown
+ , tsHeapProv = ProvUnknown
+ , tsHeapKind = KindUnknown
+ , tsHeapSlots = Map.empty
+ , tsAssumeStgPublic = assumeStgPublic
}
-- | Caller-saved registers per AArch64 ABI.
@@ -1187,12 +1214,16 @@ runInterProc cfg = go initSummaries (Set.fromList funcs)
-- | Run forward dataflow with taint config.
-- Entry states are seeded according to function-specific policies.
+-- Uses tcAssumeStgPublic from config for STG stack assumption.
runDataflowWithConfig :: TaintConfig -> CFG -> IntMap TaintState
runDataflowWithConfig tcfg cfg
| nBlocks == 0 = IM.empty
| otherwise = go initWorklist initIn IM.empty
where
nBlocks = cfgBlockCount cfg
+ assumeStg = tcAssumeStgPublic tcfg
+ baseState = initTaintStateWith assumeStg
+ emptyState = emptyTaintStateWith assumeStg
-- Build a map from block index to entry taint state
-- Entry blocks of functions get their policy applied
@@ -1202,17 +1233,16 @@ runDataflowWithConfig tcfg cfg
]
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
+ case bbLabel bb of
+ Nothing -> baseState
+ 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 -> baseState
+ Just policy -> seedArgs policy baseState
+ _ -> baseState
initWorklist = IS.fromList [0..nBlocks-1]
@@ -1221,7 +1251,7 @@ runDataflowWithConfig tcfg cfg
| otherwise =
let (idx, worklist') = IS.deleteFindMin worklist
bb = indexBlock cfg idx
- inState = IM.findWithDefault initTaintState idx inStates
+ inState = IM.findWithDefault baseState idx inStates
outState = analyzeBlock (bbLines bb) inState
oldOut = IM.lookup idx outStates
changed = oldOut /= Just outState
@@ -1234,7 +1264,7 @@ runDataflowWithConfig tcfg cfg
propagate [] _ wl ins = (wl, ins)
propagate (s:ss) out wl ins =
- let oldIn = IM.findWithDefault emptyTaintState s ins
+ let oldIn = IM.findWithDefault emptyState s ins
newIn = joinTaintState oldIn out
ins' = IM.insert s newIn ins
wl' = if oldIn /= newIn then IS.insert s wl else wl
@@ -1242,11 +1272,14 @@ runDataflowWithConfig tcfg cfg
-- | Run inter-procedural analysis with taint config.
-- Precomputes caches for function blocks and callers.
+-- Uses tcAssumeStgPublic from config for STG stack assumption.
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]
+ assumeStg = tcAssumeStgPublic tcfg
+ baseSummary = initSummaryWith assumeStg
+ initSummaries = Map.fromList [(f, baseSummary) | f <- funcs]
-- Precompute caches once
funcBlocksCache = buildFunctionBlocksMap cfg
@@ -1263,7 +1296,7 @@ runInterProcWithConfig tcfg cfg = go initSummaries (Set.fromList funcs)
outState = runFunctionDataflowWithConfig tcfg cfg func
blockIdxs summaries
newSumm = FuncSummary outState
- oldSumm = Map.findWithDefault initSummary func summaries
+ oldSumm = Map.findWithDefault baseSummary func summaries
changed = newSumm /= oldSumm
summaries' = Map.insert func newSumm summaries
callers = lookupCallers func
@@ -1273,11 +1306,13 @@ runInterProcWithConfig tcfg cfg = go initSummaries (Set.fromList funcs)
in go summaries' worklist''
-- | Run function dataflow with config-based entry seeding.
+-- Uses tcAssumeStgPublic from config for STG stack assumption.
runFunctionDataflowWithConfig :: TaintConfig -> CFG -> Text -> [Int]
-> Map Text FuncSummary -> TaintState
runFunctionDataflowWithConfig tcfg cfg funcName blockIndices summaries =
- let -- Seed entry state with function policy
- baseEntry = initTaintState
+ let assumeStg = tcAssumeStgPublic tcfg
+ -- Seed entry state with function policy
+ baseEntry = initTaintStateWith assumeStg
entryState = case Map.lookup funcName (tcPolicies tcfg) of
Nothing -> baseEntry
Just policy -> seedArgs policy baseEntry
@@ -1290,10 +1325,11 @@ runFunctionDataflowWithConfig tcfg cfg funcName blockIndices summaries =
, endsWithRet bb
]
in case returnOuts of
- [] -> initTaintState
+ [] -> baseEntry
(o:os) -> foldl' joinTaintState o os
-- | Run function blocks with a custom entry state.
+-- Inherits STG assumption from entryState.
runFunctionBlocksWithEntry :: CFG -> [Int] -> Map Text FuncSummary
-> TaintState -> IntMap TaintState
runFunctionBlocksWithEntry _ [] _ _ = IM.empty
@@ -1301,6 +1337,7 @@ runFunctionBlocksWithEntry cfg (entryIdx:rest) summaries entryState =
go initWorklist initIn IM.empty
where
blockSet = IS.fromList (entryIdx:rest)
+ emptyState = emptyTaintStateWith (tsAssumeStgPublic entryState)
initIn = IM.singleton entryIdx entryState
initWorklist = IS.singleton entryIdx
@@ -1323,7 +1360,7 @@ runFunctionBlocksWithEntry cfg (entryIdx:rest) summaries entryState =
propagate [] _ wl ins = (wl, ins)
propagate (s:ss) out wl ins =
- let oldIn = IM.findWithDefault emptyTaintState s ins
+ let oldIn = IM.findWithDefault emptyState s ins
newIn = joinTaintState oldIn out
ins' = IM.insert s newIn ins
wl' = if oldIn /= newIn then IS.insert s wl else wl
diff --git a/lib/Audit/AArch64/Types.hs b/lib/Audit/AArch64/Types.hs
@@ -45,6 +45,7 @@ module Audit.AArch64.Types (
-- * Taint configuration
, TaintConfig(..)
+ , defaultTaintConfig
, ArgPolicy(..)
, emptyArgPolicy
) where
@@ -434,9 +435,24 @@ instance FromJSON ArgPolicy where
(parseInts stgSecretInts) (parseInts stgPublicInts)
-- | Taint configuration: maps function symbols to argument policies.
-newtype TaintConfig = TaintConfig
- { tcPolicies :: Map Text ArgPolicy
+-- Also controls global analysis assumptions.
+data TaintConfig = TaintConfig
+ { tcPolicies :: !(Map Text ArgPolicy)
+ -- ^ Per-function argument taint policies
+ , tcAssumeStgPublic :: !Bool
+ -- ^ Assume untracked STG stack slots are public pointers (default: True).
+ -- GHC's STG stack holds closure pointers and return addresses, which are
+ -- inherently public. Set to False for paranoid mode.
} deriving (Eq, Show)
+-- | Default taint config with no policies and STG-public assumption on.
+defaultTaintConfig :: TaintConfig
+defaultTaintConfig = TaintConfig
+ { tcPolicies = Map.empty
+ , tcAssumeStgPublic = True
+ }
+
instance FromJSON TaintConfig where
- parseJSON v = TaintConfig <$> parseJSON v
+ parseJSON v = do
+ policies <- parseJSON v
+ pure $ TaintConfig policies True
diff --git a/test/Main.hs b/test/Main.hs
@@ -219,7 +219,8 @@ taintTests = testGroup "Taint" [
assertEqual "result is unknown" Unknown (getTaint X0 st')
, testCase "load makes unknown" $ do
- let st = initTaintState
+ -- Use initTaintStateWith False to test without STG-public assumption
+ let st = initTaintStateWith False
l = Line 1 Nothing (Just (Ldr X0 (BaseImm X20 0)))
st' = analyzeLine l st
assertEqual "loaded value is unknown" Unknown (getTaint X0 st')
@@ -259,8 +260,8 @@ auditTests = testGroup "Audit" [
, testCase "bad: secret-derived index" $ do
let src = T.unlines
[ "foo:"
- , " ldr x0, [x20]" -- x0 = unknown (loaded value)
- , " ldr x1, [x21, x0]" -- x0 as index -> violation
+ , " ldr x0, [x21]" -- x0 = unknown (loaded from heap)
+ , " ldr x1, [x20, x0]" -- x0 as index -> violation
, " ret"
]
case audit "test" src of
@@ -300,10 +301,10 @@ auditTests = testGroup "Audit" [
Right ar -> assertEqual "no violations" 0 (length (arViolations ar))
, testCase "bad: cross-block unknown taint" $ do
- -- x8 is loaded (unknown) in block A, used as base in block B
+ -- x8 is loaded from heap (unknown) in block A, used as base in block B
let src = T.unlines
[ "blockA:"
- , " ldr x8, [x20]" -- x8 becomes unknown
+ , " ldr x8, [x21]" -- x8 becomes unknown (from heap)
, " cbz x0, blockB"
, "blockB:"
, " ldr x1, [x8]" -- x8 as base should trigger violation
@@ -394,7 +395,7 @@ auditTests = testGroup "Audit" [
-- Unknown value stored to stack, then reloaded, should stay unknown
let src = T.unlines
[ "foo:"
- , " ldr x8, [x20]" -- x8 = unknown (loaded from heap)
+ , " ldr x8, [x21]" -- x8 = unknown (loaded from heap)
, " str x8, [sp, #16]" -- Store unknown to stack slot
, " ldr x9, [sp, #16]" -- Reload the unknown value
, " ldr x0, [x9]" -- Use as base - violation!
@@ -430,7 +431,7 @@ auditTests = testGroup "Audit" [
-- even with public provenance, should not be usable as base
let src = T.unlines
[ "foo:"
- , " ldr x8, [x20]" -- x8 = Unknown, ProvUnknown, KindScalar
+ , " ldr x8, [x21]" -- x8 = Unknown, ProvUnknown (from heap)
, " add x8, x20, x8" -- x8 = Unknown, ProvPublic, KindScalar
, " str x8, [sp, #16]" -- Spill scalar to stack
, " ldr x9, [sp, #16]" -- Reload: Unknown, ProvPublic, KindScalar
@@ -466,7 +467,7 @@ auditTests = testGroup "Audit" [
-- Unknown value stored to STG stack, then reloaded, stays unknown
let src = T.unlines
[ "foo:"
- , " ldr x8, [x20]" -- x8 = unknown (loaded from STG stack)
+ , " ldr x8, [x21]" -- x8 = unknown (loaded from heap)
, " str x8, [x20, #16]" -- Store unknown to STG stack slot
, " ldr x9, [x20, #16]" -- Reload the unknown value
, " ldr x0, [x9]" -- Use as base - violation!
@@ -535,8 +536,8 @@ auditTests = testGroup "Audit" [
, " ldr x1, [x20, x9]" -- Use loaded value as index -> violation
, " ret"
]
- cfg = TaintConfig $ Map.singleton "_foo"
- (ArgPolicy (Set.singleton X0) Set.empty Set.empty Set.empty)
+ cfg = TaintConfig (Map.singleton "_foo"
+ (ArgPolicy (Set.singleton X0) Set.empty Set.empty Set.empty)) True
case auditWithConfig cfg "test" src of
Left e -> assertFailure $ "parse failed: " ++ show e
Right ar -> do
@@ -559,8 +560,8 @@ auditTests = testGroup "Audit" [
, " ldr x1, [x20, x9]" -- Use as index -> violation
, " ret"
]
- cfg = TaintConfig $ Map.singleton "_foo"
- (ArgPolicy (Set.singleton X0) Set.empty Set.empty Set.empty)
+ cfg = TaintConfig (Map.singleton "_foo"
+ (ArgPolicy (Set.singleton X0) Set.empty Set.empty Set.empty)) True
case auditWithConfig cfg "test" src of
Left e -> assertFailure $ "parse failed: " ++ show e
Right ar -> do
@@ -584,8 +585,8 @@ auditTests = testGroup "Audit" [
, " ldr x10, [x9]" -- Use as base - should be safe
, " ret"
]
- cfg = TaintConfig $ Map.singleton "_foo"
- (ArgPolicy (Set.singleton X0) Set.empty Set.empty Set.empty)
+ cfg = TaintConfig (Map.singleton "_foo"
+ (ArgPolicy (Set.singleton X0) Set.empty Set.empty Set.empty)) True
case auditWithConfig cfg "test" src of
Left e -> assertFailure $ "parse failed: " ++ show e
Right ar -> assertEqual "no violations" 0 (length (arViolations ar))
@@ -602,8 +603,8 @@ auditTests = testGroup "Audit" [
, " ldr x10, [x20, x9]" -- Use as index -> violation
, " ret"
]
- cfg = TaintConfig $ Map.singleton "_foo"
- (ArgPolicy (Set.singleton X0) Set.empty Set.empty Set.empty)
+ cfg = TaintConfig (Map.singleton "_foo"
+ (ArgPolicy (Set.singleton X0) Set.empty Set.empty Set.empty)) True
case auditWithConfig cfg "test" src of
Left e -> assertFailure $ "parse failed: " ++ show e
Right ar -> do
@@ -624,8 +625,8 @@ auditTests = testGroup "Audit" [
, " ldr x10, [x20, x9]" -- Use as index -> violation
, " ret"
]
- cfg = TaintConfig $ Map.singleton "_foo"
- (ArgPolicy (Set.singleton X0) Set.empty Set.empty Set.empty)
+ cfg = TaintConfig (Map.singleton "_foo"
+ (ArgPolicy (Set.singleton X0) Set.empty Set.empty Set.empty)) True
case auditWithConfig cfg "test" src of
Left e -> assertFailure $ "parse failed: " ++ show e
Right ar -> do
@@ -723,7 +724,7 @@ interprocTests = testGroup "InterProc" [
-- callee loads into x0; caller uses x0 after call
let src = T.unlines
[ "_callee:"
- , " ldr x0, [x20]" -- x0 = unknown (loaded)
+ , " ldr x0, [x21]" -- x0 = unknown (loaded from heap)
, " ret"
, "_caller:"
, " bl _callee"
@@ -829,7 +830,7 @@ provenanceTests = testGroup "Provenance" [
-- Untagging a register with ProvUnknown doesn't make it safe
let src = T.unlines
[ "foo:"
- , " ldr x8, [x20]" -- x8 = Unknown, ProvUnknown
+ , " ldr x8, [x21]" -- x8 = Unknown, ProvUnknown (from heap)
, " and x8, x8, #-8" -- untag doesn't upgrade ProvUnknown
, " ldr x0, [x8]" -- violation: x8 is Unknown, ProvUnknown
, " ret"
@@ -844,7 +845,7 @@ provenanceTests = testGroup "Provenance" [
-- This is the key case that kind tracking prevents.
let src = T.unlines
[ "foo:"
- , " ldr x8, [x20]" -- x8 = Unknown, ProvUnknown, KindScalar
+ , " ldr x8, [x21]" -- x8 = Unknown, ProvUnknown (from heap)
, " add x9, x20, x8" -- x9 = Unknown, ProvPublic, KindScalar
, " ldr x0, [x9]" -- violation: x9 is scalar, not pointer
, " ret"
@@ -903,8 +904,8 @@ taintConfigTests = testGroup "TaintConfig" [
, " ldr x8, [x20, x0]" -- x0 as index
, " ret"
]
- cfg = TaintConfig $ Map.singleton "_mul_wnaf"
- (ArgPolicy (Set.singleton X0) Set.empty Set.empty Set.empty)
+ cfg = TaintConfig (Map.singleton "_mul_wnaf"
+ (ArgPolicy (Set.singleton X0) Set.empty Set.empty Set.empty)) True
case auditWithConfig cfg "test" src of
Left e -> assertFailure $ "parse failed: " ++ show e
Right ar -> do
@@ -921,8 +922,8 @@ taintConfigTests = testGroup "TaintConfig" [
, " ldr x8, [x20, x0]" -- x0 as index
, " ret"
]
- cfg = TaintConfig $ Map.singleton "_foo"
- (ArgPolicy Set.empty (Set.singleton X0) Set.empty Set.empty)
+ cfg = TaintConfig (Map.singleton "_foo"
+ (ArgPolicy Set.empty (Set.singleton X0) Set.empty Set.empty)) True
case auditWithConfig cfg "test" src of
Left e -> assertFailure $ "parse failed: " ++ show e
Right ar -> assertEqual "no violations" 0 (length (arViolations ar))
@@ -933,8 +934,8 @@ taintConfigTests = testGroup "TaintConfig" [
, " ldr x8, [x20, x0]" -- x0 as secret index -> violation
, " ret"
]
- cfg = TaintConfig $ Map.singleton "_mul_wnaf"
- (ArgPolicy (Set.singleton X0) Set.empty Set.empty Set.empty)
+ cfg = TaintConfig (Map.singleton "_mul_wnaf"
+ (ArgPolicy (Set.singleton X0) Set.empty Set.empty Set.empty)) True
case auditInterProcWithConfig cfg "test" src of
Left e -> assertFailure $ "parse failed: " ++ show e
Right ar -> do
@@ -969,8 +970,8 @@ taintConfigTests = testGroup "TaintConfig" [
, " ldr x9, [x21, x8]" -- Use as index -> violation
, " ret"
]
- cfg = TaintConfig $ Map.singleton "_foo"
- (ArgPolicy Set.empty Set.empty (Set.singleton 8) Set.empty)
+ cfg = TaintConfig (Map.singleton "_foo"
+ (ArgPolicy Set.empty Set.empty (Set.singleton 8) Set.empty)) True
case auditWithConfig cfg "test" src of
Left e -> assertFailure $ "parse failed: " ++ show e
Right ar -> do
@@ -989,8 +990,8 @@ taintConfigTests = testGroup "TaintConfig" [
, " ldr x9, [x21, x8]" -- Use as index -> should be safe
, " ret"
]
- cfg = TaintConfig $ Map.singleton "_foo"
- (ArgPolicy Set.empty Set.empty Set.empty (Set.singleton 16))
+ cfg = TaintConfig (Map.singleton "_foo"
+ (ArgPolicy Set.empty Set.empty Set.empty (Set.singleton 16))) True
case auditWithConfig cfg "test" src of
Left e -> assertFailure $ "parse failed: " ++ show e
Right ar -> assertEqual "no violations" 0 (length (arViolations ar))
@@ -1003,9 +1004,9 @@ taintConfigTests = testGroup "TaintConfig" [
, " ldr x9, [x21, x8]" -- Use as index -> violation (secret wins)
, " ret"
]
- cfg = TaintConfig $ Map.singleton "_foo"
+ cfg = TaintConfig (Map.singleton "_foo"
(ArgPolicy Set.empty Set.empty
- (Set.singleton 8) (Set.singleton 8))
+ (Set.singleton 8) (Set.singleton 8))) True
case auditWithConfig cfg "test" src of
Left e -> assertFailure $ "parse failed: " ++ show e
Right ar -> do
@@ -1027,8 +1028,8 @@ taintConfigTests = testGroup "TaintConfig" [
, " ldr x9, [x21, x8]" -- Use as index -> violation
, " ret"
]
- cfg = TaintConfig $ Map.singleton "_foo"
- (ArgPolicy Set.empty Set.empty (Set.singleton 8) Set.empty)
+ cfg = TaintConfig (Map.singleton "_foo"
+ (ArgPolicy Set.empty Set.empty (Set.singleton 8) Set.empty)) True
case auditWithConfig cfg "test" src of
Left e -> assertFailure $ "parse failed: " ++ show e
Right ar -> do
@@ -1049,8 +1050,8 @@ taintConfigTests = testGroup "TaintConfig" [
, " ldr x9, [x21, x8]" -- Use as index -> violation
, " ret"
]
- cfg = TaintConfig $ Map.singleton "_foo"
- (ArgPolicy Set.empty Set.empty (Set.singleton 24) Set.empty)
+ cfg = TaintConfig (Map.singleton "_foo"
+ (ArgPolicy Set.empty Set.empty (Set.singleton 24) Set.empty)) True
case auditWithConfig cfg "test" src of
Left e -> assertFailure $ "parse failed: " ++ show e
Right ar -> do
@@ -1063,22 +1064,23 @@ taintConfigTests = testGroup "TaintConfig" [
, testCase "stg slot cleared on non-constant x20 update" $ do
-- Secret at offset 8, then x20 updated non-constantly
- -- Should clear slot map, load yields unknown (not secret)
- -- Note: x20 itself becomes unknown, causing a base violation too
+ -- Should clear slot map. With STG-public assumption, load yields public.
+ -- Note: x20 itself becomes unknown, causing a base violation
let src = T.unlines
[ "_foo:"
, " add x20, x20, x1" -- Non-constant update clears map, x20 unknown
- , " ldr x8, [x20, #8]" -- Unknown base x20 + load yields unknown
- , " ldr x9, [x21, x8]" -- Use as index -> unknown violation
+ , " ldr x8, [x20, #8]" -- Unknown base x20, load yields public (STG)
+ , " ldr x9, [x21, x8]" -- x8 is public, no index violation
, " ret"
]
- cfg = TaintConfig $ Map.singleton "_foo"
- (ArgPolicy Set.empty Set.empty (Set.singleton 8) Set.empty)
+ cfg = TaintConfig (Map.singleton "_foo"
+ (ArgPolicy Set.empty Set.empty (Set.singleton 8) Set.empty)) True
case auditWithConfig cfg "test" src of
Left e -> assertFailure $ "parse failed: " ++ show e
Right ar -> do
- -- Two violations: unknown base x20, unknown index x8
- assertEqual "two violations" 2 (length (arViolations ar))
+ -- One violation: unknown base x20
+ -- (x8 is public due to STG-public assumption after map clear)
+ assertEqual "one violation" 1 (length (arViolations ar))
]
-- NCT scanner tests