commit ac535035c890f552caef6783768c881067b3d538
parent 4e45a8f45f3bc928db14b206a961df11ba506a75
Author: Jared Tobin <jared@jtobin.io>
Date: Fri, 13 Feb 2026 07:46:53 +0400
refactor: show GHC runtime findings in parens instead of filtering
Instead of completely hiding GHC runtime patterns, now:
- All findings are shown in output
- GHC runtime patterns displayed in parentheses
- Only non-GHC-runtime findings counted in totals
- Removed --filter-ghc-runtime flag (no longer needed)
This gives better visibility while still highlighting what matters.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
Diffstat:
3 files changed, 96 insertions(+), 75 deletions(-)
diff --git a/app/Main.hs b/app/Main.hs
@@ -5,7 +5,8 @@ module Main where
import Audit.AArch64
( AuditResult(..), Violation(..), ViolationReason(..)
, TaintConfig(..)
- , NctReason(..), NctFinding(..)
+ , NctReason(..), NctFinding(..), nctLine, nctInstr, nctReason
+ , LineMap, isGhcRuntimeFinding
, auditFile, auditFileInterProc
, auditFileWithConfig, auditFileInterProcWithConfig
, parseFile, regName, loadTaintConfig
@@ -31,7 +32,6 @@ data Options = Options
, optDisplayUnknown :: !Bool
, optScanNct :: !Bool
, optNctDetail :: !Bool
- , optFilterGhc :: !Bool
} deriving (Eq, Show)
optParser :: Parser Options
@@ -80,10 +80,6 @@ optParser = Options
( long "nct-detail"
<> help "Show per-instruction details in NCT scan mode"
)
- <*> switch
- ( long "filter-ghc-runtime"
- <> help "Filter GHC runtime patterns (heap/tag checks) in NCT scan"
- )
optInfo :: ParserInfo Options
optInfo = info (optParser <**> helper)
@@ -107,13 +103,13 @@ main = do
exitSuccess
else if optScanNct opts
then do
- result <- scanNctFile (optFilterGhc opts) (optInput opts)
+ result <- scanNctFile (optInput opts)
case result of
Left err -> do
TIO.putStrLn $ "Error: " <> err
exitFailure
- Right findings ->
- outputNct opts findings
+ Right (lineMap, findings) ->
+ outputNct opts lineMap findings
else do
-- Load taint config if provided
mcfg <- case optTaintConfig opts of
@@ -172,40 +168,54 @@ outputText opts ar = do
else exitFailure
-- | Output NCT scan results.
-outputNct :: Options -> Map.Map Text [NctFinding] -> IO ()
-outputNct opts findings = do
+outputNct :: Options -> LineMap -> Map.Map Text [NctFinding] -> IO ()
+outputNct opts lineMap findings = do
let syms = Map.toList findings
- total = sum (map (length . snd) syms)
+ -- Count only non-GHC-runtime findings
+ countReal = length . filter (not . isGhcRuntimeFinding lineMap)
+ realCounts = map (countReal . snd) syms
+ total = sum realCounts
+ -- Filter to functions with real findings for the count
+ realFuncs = length (filter (> 0) realCounts)
if optNctDetail opts
- then mapM_ printNctDetail syms
- else mapM_ printNctSummary syms
+ then mapM_ (printNctDetail lineMap) syms
+ else mapM_ (printNctSummary lineMap) syms
if optQuiet opts
then pure ()
else do
TIO.putStrLn ""
- TIO.putStrLn $ "Functions scanned: " <> T.pack (show (length syms))
+ TIO.putStrLn $ "Functions scanned: " <> T.pack (show realFuncs)
TIO.putStrLn $ "NCT findings: " <> T.pack (show total)
if total == 0
then exitSuccess
else exitFailure
-printNctSummary :: (Text, [NctFinding]) -> IO ()
-printNctSummary (sym, fs) = do
- TIO.putStrLn $ sym <> ": " <> T.pack (show (length fs))
- mapM_ printFindingIndented fs
+printNctSummary :: LineMap -> (Text, [NctFinding]) -> IO ()
+printNctSummary lineMap (sym, fs) = do
+ let realCount = length (filter (not . isGhcRuntimeFinding lineMap) fs)
+ TIO.putStrLn $ sym <> ": " <> T.pack (show realCount)
+ mapM_ (printFindingIndented lineMap) fs
-printFindingIndented :: NctFinding -> IO ()
-printFindingIndented f = TIO.putStrLn $
- " " <> T.pack (show (nctLine f)) <> ": "
- <> nctReasonText (nctReason f) <> ": " <> instrText (nctInstr f)
+printFindingIndented :: LineMap -> NctFinding -> IO ()
+printFindingIndented lineMap f =
+ let isGhc = isGhcRuntimeFinding lineMap f
+ content = T.pack (show (nctLine f)) <> ": "
+ <> nctReasonText (nctReason f) <> ": " <> instrText (nctInstr f)
+ line = if isGhc
+ then " (" <> content <> ")"
+ else " " <> content
+ in TIO.putStrLn line
-printNctDetail :: (Text, [NctFinding]) -> IO ()
-printNctDetail (sym, fs) = mapM_ (printFinding sym) fs
+printNctDetail :: LineMap -> (Text, [NctFinding]) -> IO ()
+printNctDetail lineMap (sym, fs) = mapM_ (printFinding lineMap sym) fs
-printFinding :: Text -> NctFinding -> IO ()
-printFinding sym f = TIO.putStrLn $
- sym <> ":" <> T.pack (show (nctLine f)) <> ": "
- <> nctReasonText (nctReason f) <> ": " <> instrText (nctInstr f)
+printFinding :: LineMap -> Text -> NctFinding -> IO ()
+printFinding lineMap sym f =
+ let isGhc = isGhcRuntimeFinding lineMap f
+ content = sym <> ":" <> T.pack (show (nctLine f)) <> ": "
+ <> nctReasonText (nctReason f) <> ": " <> instrText (nctInstr f)
+ line = if isGhc then "(" <> content <> ")" else content
+ in TIO.putStrLn line
nctReasonText :: NctReason -> Text
nctReasonText r = case r of
diff --git a/lib/Audit/AArch64.hs b/lib/Audit/AArch64.hs
@@ -42,9 +42,13 @@ module Audit.AArch64 (
-- * NCT scanner
, scanNct
, scanNctFile
- , filterGhcRuntime
, NctReason(..)
, NctFinding(..)
+ -- ** GHC runtime classification
+ , LineMap
+ , buildLineMap
+ , isGhcRuntimeFinding
+ , filterGhcRuntime
-- * Results
, AuditResult(..)
@@ -67,7 +71,9 @@ module Audit.AArch64 (
import Audit.AArch64.CFG
import Audit.AArch64.Check
import Audit.AArch64.NCT
- (NctReason(..), NctFinding(..), scanNct, filterGhcRuntime)
+ ( NctReason(..), NctFinding(..), scanNct
+ , LineMap, buildLineMap, isGhcRuntimeFinding, filterGhcRuntime
+ )
import Audit.AArch64.Parser
import Audit.AArch64.Types
( Reg, Violation(..), ViolationReason(..), regName
@@ -158,13 +164,11 @@ loadTaintConfig path = do
Right cfg -> pure (Right cfg)
-- | Scan an assembly file for non-constant-time instructions.
--- When the first argument is True, filters out common GHC runtime patterns
--- (heap checks, tag checks, closure entry) that are not CT-relevant.
+-- Returns a LineMap (for GHC runtime classification) and the findings.
scanNctFile
- :: Bool -- ^ Filter GHC runtime patterns
- -> FilePath
- -> IO (Either Text (Map.Map Text [NctFinding]))
-scanNctFile filterGhc path = do
+ :: FilePath
+ -> IO (Either Text (LineMap, Map.Map Text [NctFinding]))
+scanNctFile path = do
bs <- BS.readFile path
case decodeUtf8' bs of
Left err -> pure (Left (T.pack (show err)))
@@ -172,8 +176,6 @@ scanNctFile filterGhc path = do
case parseAsm src of
Left err -> pure (Left (T.pack (showParseError err)))
Right lns ->
- let findings = scanNct lns
- filtered = if filterGhc
- then filterGhcRuntime lns findings
- else findings
- in pure (Right filtered)
+ let lineMap = buildLineMap lns
+ findings = scanNct lns
+ in pure (Right (lineMap, findings))
diff --git a/lib/Audit/AArch64/NCT.hs b/lib/Audit/AArch64/NCT.hs
@@ -18,7 +18,10 @@ module Audit.AArch64.NCT (
, NctFinding(..)
-- * Scanner
, scanNct
- -- * Filtering
+ -- * GHC runtime classification
+ , LineMap
+ , buildLineMap
+ , isGhcRuntimeFinding
, filterGhcRuntime
) where
@@ -141,9 +144,16 @@ checkRegIndexAddr addr = case addr of
BaseRegExtend _ _ _ -> Just RegIndexAddr
_ -> Nothing
--- | Filter out GHC runtime patterns from NCT findings.
+-- | Line number to Line map for efficient lookup.
+type LineMap = IntMap Line
+
+-- | Build a line map from parsed lines for O(1) lookup.
+buildLineMap :: [Line] -> LineMap
+buildLineMap lns = IntMap.fromList [(lineNum l, l) | l <- lns]
+
+-- | Check if a finding is a GHC runtime pattern.
--
--- Recognizes and removes:
+-- Recognizes:
--
-- * Heap checks: @cmp <reg>, x28@ followed by conditional branch
-- (x28 is GHC's heap limit register)
@@ -153,41 +163,29 @@ checkRegIndexAddr addr = case addr of
--
-- * Closure entry: @ldr x8, [<reg>]@ followed by @blr x8@
-- (entering closure via info pointer)
-filterGhcRuntime :: [Line] -> Map Text [NctFinding] -> Map Text [NctFinding]
-filterGhcRuntime lns findings = Map.mapMaybe filterFindings findings
+isGhcRuntimeFinding :: LineMap -> NctFinding -> Bool
+isGhcRuntimeFinding lineMap f = case nctReason f of
+ CondBranch -> isHeapCheck || isTagCheck
+ IndirectBranch -> isClosureEntry
+ _ -> False
where
- -- Build line number -> Line map for O(1) lookup
- lineMap :: IntMap Line
- lineMap = IntMap.fromList [(lineNum l, l) | l <- lns]
-
- filterFindings :: [NctFinding] -> Maybe [NctFinding]
- filterFindings fs =
- let fs' = filter (not . isGhcRuntime) fs
- in if null fs' then Nothing else Just fs'
-
- isGhcRuntime :: NctFinding -> Bool
- isGhcRuntime f = case nctReason f of
- CondBranch -> isHeapCheck f || isTagCheck f
- IndirectBranch -> isClosureEntry f
- _ -> False
-
-- Check if conditional branch is a heap check (prev: cmp <r>, x28)
- isHeapCheck :: NctFinding -> Bool
- isHeapCheck f = case prevInstr f of
+ isHeapCheck :: Bool
+ isHeapCheck = case prevInstr of
Just (Cmp _ (OpReg X28)) -> True
_ -> False
-- Check if conditional branch is a tag check (prev: tst <r>, #7)
- isTagCheck :: NctFinding -> Bool
- isTagCheck f = case prevInstr f of
+ isTagCheck :: Bool
+ isTagCheck = case prevInstr of
Just (Tst _ (OpImm 7)) -> True
_ -> False
-- Check if blr x8 is closure entry (recent: ldr/ldur x8, [...])
-- Look back up to 3 instructions to account for intervening loads
- isClosureEntry :: NctFinding -> Bool
- isClosureEntry f = case nctInstr f of
- Blr X8 -> any isX8Load (recentInstrs 3 f)
+ isClosureEntry :: Bool
+ isClosureEntry = case nctInstr f of
+ Blr X8 -> any isX8Load recentInstrs
_ -> False
isX8Load :: Instr -> Bool
@@ -197,16 +195,27 @@ filterGhcRuntime lns findings = Map.mapMaybe filterFindings findings
_ -> False
-- Get instruction from preceding line
- prevInstr :: NctFinding -> Maybe Instr
- prevInstr f = do
+ prevInstr :: Maybe Instr
+ prevInstr = do
prevLine <- IntMap.lookup (nctLine f - 1) lineMap
lineInstr prevLine
- -- Get up to n recent instructions before finding
- recentInstrs :: Int -> NctFinding -> [Instr]
- recentInstrs n f =
+ -- Get up to 3 recent instructions before finding
+ recentInstrs :: [Instr]
+ recentInstrs =
[ instr
- | offset <- [1..n]
+ | offset <- [1..3]
, Just ln <- [IntMap.lookup (nctLine f - offset) lineMap]
, Just instr <- [lineInstr ln]
]
+
+-- | Filter out GHC runtime patterns from NCT findings.
+filterGhcRuntime :: [Line] -> Map Text [NctFinding] -> Map Text [NctFinding]
+filterGhcRuntime lns findings = Map.mapMaybe filterFindings findings
+ where
+ lineMap = buildLineMap lns
+
+ filterFindings :: [NctFinding] -> Maybe [NctFinding]
+ filterFindings fs =
+ let fs' = filter (not . isGhcRuntimeFinding lineMap) fs
+ in if null fs' then Nothing else Just fs'
