vestigia

Detect where execution depends on secrets.
git clone git://git.ppad.tech/vestigia.git
Log | Files | Refs | README | LICENSE

commit 6f6de0af575252d584a009333475ff3a19df7aa3
parent 5570e76dd4246b6fd6eb59a9091ddb6a347cfd23
Author: Jared Tobin <jared@jtobin.io>
Date:   Wed, 21 Oct 2026 09:46:34 +0400

trace: taint over every run, merged

memcheck sees the path a run takes, and traceOf ran the harness on
one secret, so a site on a path another secret took, a designed one
especially, was seen by neither instrument when the differential
trace saw it only as downstream of a branch. synthesis's TRACES.md
names it a follow-up.

`vestigia run --dir DIR` keeps a run: memcheck's XML, the objects the
harness's first mark wrote, and the harness's exit status (it
replaces --xml). `vestigia read` takes several such runs, or memcheck
XML files made elsewhere, and reports on them as one: a site is one
instruction and class, named by its address in its object where the
run's objects say, so that runs loading an object apart agree on it,
with its count over every run and the runs that reached it. A kept
run that marked no secret is refused, as `run` refuses it.

The report becomes vestigia/trace-v2: `runs` gives each run's
command, exit, valgrind, and objects, in place of the top-level
fields; each site lists its runs, and each unrelated error or fault
names its run. traceOf takes `runs`, a list of argument lists as
diffOf's is, keeps each run as run-K, and reads them together.

The probe harness gains a table index on a path the third secret
alone takes; the check finds it under taint, in that run alone.

Diffstat:
MCHANGELOG | 11+++++++----
MREADME.md | 21+++++++++++++--------
Mapp/Main.hs | 143++++++++++++++++++++++++++++++++++++++++++++++++++++---------------------------
Metc/probe/harness.c | 18+++++++++++++-----
Mlib/Vestigia/Trace.hs | 229+++++++++++++++++++++++++++++++++++++++++++++++--------------------------------
Mnix/lib.nix | 40++++++++++++++++++++++++----------------
Mnix/probe.nix | 19++++++++++++++-----
Mtest/Main.hs | 51++++++++++++++++++++++++++++++++++++++++-----------
8 files changed, 342 insertions(+), 190 deletions(-)

diff --git a/CHANGELOG b/CHANGELOG @@ -8,9 +8,11 @@ * `vestigia run`: the harness under memcheck with the secret's bytes undefined, reporting each branch, address, and integer division operand computed from them, the last through a - memcheck patch, each at its own instruction - (vestigia/trace-v1); `vestigia read` reports from memcheck's - XML. + memcheck patch, each at its own instruction; `--dir` keeps the + run, and `vestigia read` reports on several kept runs, or + memcheck XML made elsewhere, as one (vestigia/trace-v2: each + run with its command, exit, and objects, each site with the + runs that reached it). * `vestigia record` and `vestigia diff`: the harness under QEMU with vestigia's plugin, its leakage trace summarised per instruction, and where runs differing only in the secret @@ -34,7 +36,8 @@ not repeat the first run's arguments; a guest that starts a second thread is stopped and its dump refused. A taint run that marked no secret is refused. - * `traceOf` and `diffOf` run either as a derivation; + * `traceOf` and `diffOf` run either as a derivation, over a list + of runs; `nix/lib.nix` holds them for any package set, with the version the command reports. * `--object` keeps a taint run's sites (`run`, `read`, and diff --git a/README.md b/README.md @@ -49,10 +49,14 @@ control 0x4875cd2 MontConfig::from_bigint montgomery_backend.rs:359 x8 control 0x4875cf9 cmp<4> mod.rs:565 x4 ... control 0x4878d4d next<&[u64]> bits.rs:32 x982 -12 secret-dependent site(s); 0 unrelated; 0 fault(s) +12 secret-dependent site(s) over 1 run(s); 0 unrelated; 0 fault(s) ``` -`vestigia read FILE.xml` reports on a memcheck run made elsewhere. +memcheck sees only the path a run takes, so trace a harness on +several secrets: `run --dir DIR` keeps a run (memcheck's XML, where +the harness's objects loaded, its exit status), and `vestigia read +DIR...` reports on such runs as one, each site with the runs that +reached it. `read` takes a memcheck XML file made elsewhere too. `--object TEXT` keeps the sites in objects whose path contains TEXT. ### Differential traces: `vestigia record` and `vestigia diff` @@ -112,10 +116,11 @@ first run's arguments. ### As derivations The flake's `lib.<system>` holds `traceOf` and `diffOf`, which run -either instrument as a derivation; an `x86_64-linux` run executes on -any builder for that system, and its report is cached. `diffOf` -repeats the first run as its control. `nix/lib.nix` holds the same -for a consumer's own nixpkgs, beside `version`. +either instrument as a derivation over a list of runs; an +`x86_64-linux` run executes on any builder for that system, and its +report is cached. `diffOf` repeats the first run as its control. +`nix/lib.nix` holds the same for a consumer's own nixpkgs, beside +`version`. ```nix vestigia.lib.x86_64-linux.diffOf { @@ -126,8 +131,8 @@ vestigia.lib.x86_64-linux.diffOf { } ``` -The output holds `trace.json` (`vestigia/trace-v1`) or `diff.json` -(`vestigia/diff-v3`), the raw memcheck XML or plugin dumps, what the +The output holds `trace.json` (`vestigia/trace-v2`) or `diff.json` +(`vestigia/diff-v3`), the runs kept or the plugin's dumps, what the harness printed, and the wall time. ## Two instruments diff --git a/app/Main.hs b/app/Main.hs @@ -26,10 +26,13 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding.Error as TEE import qualified Data.Text.IO as TIO -import System.Directory (getTemporaryDirectory, removeFile) +import System.Directory + (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, + getTemporaryDirectory, removeFile) import System.Environment (getArgs, getEnvironment, lookupEnv) import System.Exit (ExitCode(..), exitWith) -import System.FilePath (takeFileName) +import System.FilePath (takeFileName, (</>)) +import Text.Read (readMaybe) import System.IO (IOMode(..), hClose, hPutStrLn, openTempFile, stderr, withBinaryFile) import System.Process (proc, waitForProcess, withCreateProcess) @@ -42,14 +45,14 @@ import Vestigia.Diff readDump, restrictTo, runApart) import Vestigia.Json (encode) import Vestigia.Layout (fixLayout) -import Vestigia.Memcheck (readMemcheck) +import Vestigia.Memcheck (Memcheck, readMemcheck) import Vestigia.Symbol (symbolize) import Vestigia.Trace - (readObjects, sitesIn, trace, traceJson, traceSummary, withObjects) + (Taint(..), readObjects, sitesIn, trace, traceJson, traceSummary) data Opts = Opts { oValgrind :: !(Maybe FilePath) - , oXml :: !(Maybe FilePath) + , oDir :: !(Maybe FilePath) , oOut :: !(Maybe FilePath) , oQemu :: !(Maybe FilePath) , oPlugin :: !(Maybe FilePath) @@ -69,8 +72,8 @@ main = do Right (_, []) -> usage "run: no program given" Left e -> usage e ("read" : rest) -> case options rest of - Right (o, [ xml ]) -> readXml o xml - Right _ -> usage "read: one XML file expected" + Right (o, runs@(_ : _)) -> readRuns o runs + Right _ -> usage "read: a run or memcheck XML file expected" Left e -> usage e ("record" : rest) -> case options rest of Right (o, prog : progArgs) -> record o prog progArgs @@ -88,9 +91,9 @@ usage e = do hPutStrLn stderr ("vestigia: " <> e) hPutStrLn stderr $ unlines [ "usage:" - , " vestigia run [--valgrind PATH] [--xml FILE] [--out FILE] \ + , " vestigia run [--valgrind PATH] [--dir DIR] [--out FILE] \ \[--object TEXT]... -- PROGRAM [ARG...]" - , " vestigia read [--out FILE] [--object TEXT]... FILE.xml" + , " vestigia read [--out FILE] [--object TEXT]... RUN..." , " vestigia record [--qemu PATH] [--plugin PATH] --dump FILE \ \-- PROGRAM [ARG...]" , " vestigia diff [--out FILE] [--addr2line PATH] \ @@ -98,8 +101,10 @@ usage e = do \DUMP DUMP..." , "" , "run executes PROGRAM under memcheck, which reports every" - , "branch and address that depended on bytes the program marked" - , "secret (vestigia.h), and writes the report (vestigia/trace-v1)." + , "branch, address, and division that depended on bytes the" + , "program marked secret (vestigia.h), and writes the report" + , "(vestigia/trace-v2); --dir keeps the run in DIR. read reports" + , "on runs kept so, or memcheck XML files made elsewhere, as one." , "valgrind is --valgrind, else $VESTIGIA_VALGRIND, else on PATH." , "--object keeps sites in objects whose path contains TEXT." , "" @@ -126,7 +131,7 @@ options = go (Opts Nothing Nothing Nothing Nothing Nothing Nothing go o xs = case xs of ("--" : rest) -> Right (o, rest) ("--valgrind" : p : rest) -> go o { oValgrind = Just p } rest - ("--xml" : p : rest) -> go o { oXml = Just p } rest + ("--dir" : p : rest) -> go o { oDir = Just p } rest ("--out" : p : rest) -> go o { oOut = Just p } rest ("--qemu" : p : rest) -> go o { oQemu = Just p } rest ("--plugin" : p : rest) -> go o { oPlugin = Just p } rest @@ -163,22 +168,30 @@ memcheckArgs xml = , "--child-silent-after-fork=yes" ] +-- a run kept in a directory (run --dir): memcheck's XML, the objects +-- the harness's first mark wrote (vestigia.h), and the harness's +-- exit status +runXml, runObjects, runExit :: FilePath -> FilePath +runXml d = d </> "memcheck.xml" +runObjects d = d </> "objects" +runExit d = d </> "exit" + run :: Opts -> FilePath -> [String] -> IO () run o prog progArgs = do env <- lookupEnv "VESTIGIA_VALGRIND" let valgrind = maybe (maybe "valgrind" id env) id (oValgrind o) - (xml, temporary) <- case oXml o of - Just p -> pure (p, False) + (xml, objects) <- case oDir o of + Just d -> do + createDirectoryIfMissing True d + writeFile (runObjects d) "" + pure (runXml d, runObjects d) Nothing -> do tmp <- getTemporaryDirectory (p, h) <- openTempFile tmp "vestigia.xml" hClose h - pure (p, True) - -- where the harness's loader put its objects, which the - -- harness's first mark writes (vestigia.h) - tmp <- getTemporaryDirectory - (objects, oh) <- openTempFile tmp "vestigia-objects" - hClose oh + (q, oh) <- openTempFile tmp "vestigia-objects" + hClose oh + pure (p, q) environment <- getEnvironment r <- try (withCreateProcess (proc valgrind (memcheckArgs xml <> (prog : progArgs))) @@ -192,45 +205,79 @@ run o prog progArgs = do <> show (e :: IOException)) exitWith (ExitFailure 2) Right c -> pure c - otext <- TIO.readFile objects - os <- case readObjects otext of - Left e -> do - hPutStrLn stderr ("vestigia: " <> objects <> ": " <> e) - exitWith (ExitFailure 2) - Right v -> pure v - removeFile objects - -- no objects written, no secret marked: a run that found nothing - -- because nothing was secret is no evidence, and is refused - when (null os) $ do - hPutStrLn stderr "vestigia: the harness marked no secret \ - \(vestigia_secret was never called on any bytes); its run \ - \says nothing" - exitWith (ExitFailure 2) - report o (Just (exitStatus code)) os xml - if temporary then removeFile xml else pure () + t <- case oDir o of + Just d -> do + writeFile (runExit d) (show (exitStatus code) <> "\n") + readRun d + Nothing -> do + os <- markedObjects objects + mc <- readXml xml + removeFile objects + removeFile xml + pure (Taint "run" mc os (Just (exitStatus code))) + report o [ t ] exitStatus :: ExitCode -> Int exitStatus c = case c of ExitSuccess -> 0 ExitFailure n -> n -readXml :: Opts -> FilePath -> IO () -readXml o xml = report o Nothing [] xml +-- runs kept by run --dir, or memcheck XML files made elsewhere, of +-- which nothing more is known +readRuns :: Opts -> [FilePath] -> IO () +readRuns o paths = do + ts <- traverse (\p -> do + kept <- doesDirectoryExist p + if kept + then readRun p + else do + mc <- readXml p + pure (Taint (T.pack (takeFileName p)) mc [] Nothing)) + paths + report o ts + +readRun :: FilePath -> IO Taint +readRun d = do + os <- markedObjects (runObjects d) + mc <- readXml (runXml d) + known <- doesFileExist (runExit d) + exit <- if known + then fmap (readMaybe . takeWhile (/= '\n')) (readFile (runExit d)) + else pure Nothing + pure (Taint (T.pack (takeFileName d)) mc os exit) -report :: Opts -> Maybe Int -> [(Integer, T.Text)] -> FilePath -> IO () -report o exit os xml = do +-- the objects a run's harness reported where it marked its secret; +-- none written, no secret marked: a run that found nothing because +-- nothing was secret is no evidence, and is refused +markedObjects :: FilePath -> IO [(Integer, T.Text)] +markedObjects p = do + t <- TIO.readFile p + case readObjects t of + Left e -> do + hPutStrLn stderr ("vestigia: " <> p <> ": " <> e) + exitWith (ExitFailure 2) + Right [] -> do + hPutStrLn stderr ("vestigia: " <> p <> ": the harness marked \ + \no secret (vestigia_secret was never called on any bytes); \ + \its run says nothing") + exitWith (ExitFailure 2) + Right os -> pure os + +readXml :: FilePath -> IO Memcheck +readXml xml = do bytes <- BS.readFile xml - let txt = TE.decodeUtf8With TEE.lenientDecode bytes - case readMemcheck txt of + case readMemcheck (TE.decodeUtf8With TEE.lenientDecode bytes) of Left e -> do hPutStrLn stderr ("vestigia: " <> xml <> ": " <> e) exitWith (ExitFailure 2) - Right mc -> do - let tr = sitesIn (oObjects o) (withObjects os (trace mc)) - doc = encode - (traceJson (T.pack (showVersion version)) exit tr) - maybe (TIO.putStr doc) (\p -> TIO.writeFile p doc) (oOut o) - TIO.hPutStr stderr (traceSummary tr) + Right mc -> pure mc + +report :: Opts -> [Taint] -> IO () +report o ts = do + let tr = sitesIn (oObjects o) (trace ts) + doc = encode (traceJson (T.pack (showVersion version)) tr) + maybe (TIO.putStr doc) (\p -> TIO.writeFile p doc) (oOut o) + TIO.hPutStr stderr (traceSummary tr) -- a tool named by its option, else its environment variable, else -- the given default diff --git a/etc/probe/harness.c b/etc/probe/harness.c @@ -8,7 +8,8 @@ * Its secret, the first argument in hex (of one width for every * secret, so that runs lay out alike), reaches a loop's bound, a * table index, which of two calls a helper returns to, a dividend, - * and a divisor; a constant-time select reaches none of them. + * a divisor, and, on a path the third secret alone takes, another + * table index; a constant-time select reaches none of them. */ #include <stdio.h> #include <stdlib.h> @@ -71,6 +72,12 @@ __attribute__((noinline)) unsigned divide_memory(unsigned s) { #endif } +/* a table index on a path one secret takes */ +__attribute__((noinline)) unsigned rare(unsigned s) { + if ((s & 0xffu) == 0xc3u) return table[(s >> 1) & 0xffu]; + return 0; +} + __attribute__((noinline)) unsigned ct(unsigned s, unsigned p) { unsigned m = 0u - (p & 1u); return (s & m) | (~s & ~m); @@ -78,7 +85,7 @@ __attribute__((noinline)) unsigned ct(unsigned s, unsigned p) { int main(int argc, char **argv) { unsigned s = (unsigned)strtoul(argc > 1 ? argv[1] : "0", NULL, 16); - unsigned out[6]; + unsigned out[7]; for (int i = 0; i < 256; i++) table[i] = (unsigned char)i; vestigia_secret(&s, sizeof s); out[0] = branchy(s); @@ -86,9 +93,10 @@ int main(int argc, char **argv) { out[2] = calls(s); out[3] = divide(s); out[4] = divide_memory(s); - out[5] = ct(s, 1); + out[5] = rare(s); + out[6] = ct(s, 1); vestigia_public(out, sizeof out); - printf("%u %u %u %u %u %u\n", out[0], out[1], out[2], out[3], out[4], - out[5]); + printf("%u %u %u %u %u %u %u\n", out[0], out[1], out[2], out[3], + out[4], out[5], out[6]); return 0; } diff --git a/lib/Vestigia/Trace.hs b/lib/Vestigia/Trace.hs @@ -17,14 +17,21 @@ -- is kept apart as `unrelated`, and memory errors as `faults`: -- neither says anything about the secret. Leak reports say nothing -- about the execution and are dropped. +-- +-- memcheck sees the path a run took, so runs of one harness on +-- several secrets are read together: a site is one instruction and +-- class however many runs reached it, with the runs that did. Where +-- a run's objects are known, a site is named by its address in its +-- object, so runs that loaded an object apart still agree on it. module Vestigia.Trace ( Class(..) + , Taint(..) + , Located(..) , Site(..) , Trace(..) , trace , sitesIn - , withObjects , readObjects , objectOffset , traceJson @@ -48,25 +55,44 @@ data Class = | Syscall deriving (Eq, Ord, Show) --- | One instruction that depended on a secret, with every stack --- that reached it. +-- | One run under memcheck: its name, what memcheck reported, where +-- the harness's loader put each object (its load bias and path, +-- as the harness reported them; none for a report made +-- elsewhere), and the harness's exit status, where known. +data Taint = Taint { + tnName :: !T.Text + , tnMemcheck :: !Memcheck + , tnObjects :: ![(Integer, T.Text)] + , tnExit :: !(Maybe Int) + } deriving (Eq, Show) + +-- | A frame, with its address in its object where its run's objects +-- say. +data Located = Located { + lcFrame :: !Frame + , lcOffset :: !(Maybe Integer) + } deriving (Eq, Show) + +-- | One instruction that depended on a secret: where, as the first +-- run to reach it saw it; how many times, over every run; the runs +-- that reached it, as indices into the runs; and every stack that +-- did. data Site = Site { siClass :: !Class - , siFrame :: !Frame + , siAt :: !Located , siCount :: !Int - , siStacks :: ![[Frame]] + , siRuns :: ![Int] + , siStacks :: ![[Located]] } deriving (Eq, Show) --- | A run's sites, in the order first reported, and what memcheck --- reported that says nothing about the secret. +-- | Runs' sites, in the order first reported, and what memcheck +-- reported that says nothing about the secret, each with the +-- index of the run that reported it. data Trace = Trace { - trRun :: !Memcheck + trRuns :: ![Taint] , trSites :: ![Site] - , trUnrelated :: ![MemError] - , trFaults :: ![MemError] - -- | where the harness's loader put each object: its load bias - -- and path, as the harness reported them - , trObjects :: ![(Integer, T.Text)] + , trUnrelated :: ![(Int, MemError)] + , trFaults :: ![(Int, MemError)] } deriving (Eq, Show) classText :: Class -> T.Text @@ -86,43 +112,54 @@ classify e = case (meOrigin e, meKind e) of _ -> Nothing uninitialised :: MemError -> Bool -uninitialised e = - meKind e `elem` - [ "UninitCondition", "UninitValue", "UninitOperand", "SyscallParam" ] +uninitialised e = meKind e `elem` + [ "UninitCondition", "UninitValue", "UninitOperand", "SyscallParam" ] --- | The run's leakage. Sites are one per instruction and class: +-- | The runs' leakage. Sites are one per instruction and class: -- memcheck reports one context per distinct stack, and the --- instruction is what depended on the secret, whatever called --- it. -trace :: Memcheck -> Trace -trace mc = Trace { - trRun = mc +-- instruction is what depended on the secret, whatever called it +-- and in whichever run. +trace :: [Taint] -> Trace +trace ts = Trace { + trRuns = ts , trSites = [ Site { siClass = c - , siFrame = top - , siCount = sum (fmap (meCount . snd) xs) - , siStacks = L.nub (fmap (meStack . snd) xs) + , siAt = at + , siCount = sum [ meCount e | (_, e, _) <- xs ] + , siRuns = L.nub [ k | (k, _, _) <- xs ] + , siStacks = L.nubBy (\a b -> fmap ident a == fmap ident b) + [ st | (_, _, st) <- xs ] } - | k@(c, _) <- order - , Just xs@((top, _) : _) <- [ M.lookup k grouped ] ] + | key@(c, _) <- L.nub (fmap fst tagged) + , Just xs@((_, _, at : _) : _) <- [ M.lookup key grouped ] ] , trUnrelated = - [ e | e <- mcErrors mc, uninitialised e - , classify e == Nothing ] + [ (k, e) | (k, t) <- runs, e <- mcErrors (tnMemcheck t) + , uninitialised e, classify e == Nothing ] , trFaults = - [ e | e <- mcErrors mc, not (uninitialised e) - , not ("Leak_" `T.isPrefixOf` meKind e) ] - , trObjects = [] + [ (k, e) | (k, t) <- runs, e <- mcErrors (tnMemcheck t) + , not (uninitialised e) + , not ("Leak_" `T.isPrefixOf` meKind e) ] } where + runs = zip [ 0 .. ] ts tagged = - [ ((c, top), e) - | e <- mcErrors mc + [ ((c, ident top), (k, e, st)) + | (k, t) <- runs + , e <- mcErrors (tnMemcheck t) , Just c <- [ classify e ] - , (top : _) <- [ meStack e ] ] - order = L.nub (fmap (\((c, top), _) -> (c, frIp top)) tagged) + , let st = fmap (locate (tnObjects t)) (meStack e) + , (top : _) <- [ st ] ] grouped = M.fromListWith (flip (<>)) - [ ((c, frIp top), [ (top, e) ]) | ((c, top), e) <- tagged ] + [ (key, [ v ]) | (key, v) <- tagged ] + -- an instruction is its address in its object where that is + -- known, else its address in the run + ident (Located f off) = + ( frObj f, maybe (Left (frIp f)) Right off, frFn f, frFile f + , frLine f ) + +locate :: [(Integer, T.Text)] -> Frame -> Located +locate os f = Located f (objectOffset os f) -- | Only the sites in objects whose path contains one of the given -- texts, as a differential run keeps its origins; every site when @@ -132,15 +169,10 @@ sitesIn ts tr | null ts = tr | otherwise = tr { trSites = filter inside (trSites tr) } where - inside s = case frObj (siFrame s) of + inside s = case frObj (lcFrame (siAt s)) of Just o -> any (`T.isInfixOf` o) ts Nothing -> False --- | The trace with the harness's map of its objects, by which each --- frame is named by its address in its object. -withObjects :: [(Integer, T.Text)] -> Trace -> Trace -withObjects os tr = tr { trObjects = os } - -- | The objects file the harness's first mark writes: a load bias -- (hex) and a path per line. -- @@ -171,16 +203,24 @@ objectOffset os f = do (x : _) -> x [] -> p --- | The report: @vestigia/trace-v1@. -traceJson :: T.Text -> Maybe Int -> Trace -> Value -traceJson version exit tr = Object - [ ("schema", String "vestigia/trace-v1") +-- | The report: @vestigia/trace-v2@. +traceJson :: T.Text -> Trace -> Value +traceJson version tr = Object + [ ("schema", String "vestigia/trace-v2") , ("tool", Object [ ("name", String "vestigia") , ("version", String version) ]) - , ("valgrind", maybe Null String (mcVersion mc)) - , ("command", Array (fmap String (mcCommand mc))) - , ("finished", Bool (mcFinished mc)) - , ("exit", maybe Null (Number . toInteger) exit) + , ("runs", Array + [ Object + [ ("name", String (tnName t)) + , ("valgrind", maybe Null String (mcVersion mc)) + , ("command", Array (fmap String (mcCommand mc))) + , ("finished", Bool (mcFinished mc)) + , ("exit", maybe Null (Number . toInteger) (tnExit t)) + , ("objects", Array + [ Object [ ("base", String (hex b)), ("path", String p) ] + | (b, p) <- tnObjects t ]) + ] + | t <- trRuns tr, let mc = tnMemcheck t ]) , ("summary", Object [ ("control", count Control) , ("address", count Address) @@ -189,48 +229,45 @@ traceJson version exit tr = Object , ("unrelated", Number (toInteger (length (trUnrelated tr)))) , ("faults", Number (toInteger (length (trFaults tr)))) ]) - , ("objects", Array - [ Object [ ("base", String (hex b)), ("path", String p) ] - | (b, p) <- trObjects tr ]) - , ("sites", Array (fmap (siteJson os) (trSites tr))) - , ("unrelated", Array (fmap (errorJson os) (trUnrelated tr))) - , ("faults", Array (fmap (errorJson os) (trFaults tr))) + , ("sites", Array (fmap siteJson (trSites tr))) + , ("unrelated", Array (fmap errorJson (trUnrelated tr))) + , ("faults", Array (fmap errorJson (trFaults tr))) ] where - os = trObjects tr - mc = trRun tr count c = Number (toInteger (length [ () | s <- trSites tr, siClass s == c ])) + name k = case drop k (trRuns tr) of + (t : _) -> String (tnName t) + [] -> String (T.pack (show k)) + objectsOf k = case drop k (trRuns tr) of + (t : _) -> tnObjects t + [] -> [] + siteJson s = Object $ + [ ("class", String (classText (siClass s))) ] + <> locatedFields (siAt s) + <> [ ("count", Number (toInteger (siCount s))) + , ("runs", Array (fmap name (siRuns s))) + , ("stacks", Array [ Array (fmap (Object . locatedFields) st) + | st <- siStacks s ]) + ] + errorJson (k, e) = Object + [ ("run", name k) + , ("kind", String (meKind e)) + , ("what", String (meWhat e)) + , ("origin", case meOrigin e of + ClientRequest _ -> String "client request" + OtherOrigin w _ -> String w + NoOrigin -> Null) + , ("count", Number (toInteger (meCount e))) + , ("stack", Array (fmap (Object . locatedFields + . locate (objectsOf k)) (meStack e))) + ] -siteJson :: [(Integer, T.Text)] -> Site -> Value -siteJson os s = Object $ - [ ("class", String (classText (siClass s))) ] - <> frameFields os (siFrame s) - <> [ ("count", Number (toInteger (siCount s))) - , ("stacks", Array [ Array (fmap (frameJson os) st) - | st <- siStacks s ]) - ] - -errorJson :: [(Integer, T.Text)] -> MemError -> Value -errorJson os e = Object - [ ("kind", String (meKind e)) - , ("what", String (meWhat e)) - , ("origin", case meOrigin e of - ClientRequest _ -> String "client request" - OtherOrigin w _ -> String w - NoOrigin -> Null) - , ("count", Number (toInteger (meCount e))) - , ("stack", Array (fmap (frameJson os) (meStack e))) - ] - -frameJson :: [(Integer, T.Text)] -> Frame -> Value -frameJson os = Object . frameFields os - -frameFields :: [(Integer, T.Text)] -> Frame -> [(T.Text, Value)] -frameFields os f = +locatedFields :: Located -> [(T.Text, Value)] +locatedFields (Located f off) = [ ("ip", String (hex (frIp f))) , ("object", maybe Null String (frObj f)) - , ("offset", maybe Null (String . hex) (objectOffset os f)) + , ("offset", maybe Null (String . hex) off) , ("function", maybe Null String (frFn f)) , ("file", maybe Null String (frFile f)) , ("line", maybe Null (Number . toInteger) (frLine f)) @@ -239,21 +276,27 @@ frameFields os f = hex :: Integer -> T.Text hex n = "0x" <> T.pack (showHex n "") --- | One line per site, for a reader at a terminal. +-- | One line per site, for a reader at a terminal: with how many runs +-- reached it, where there were several. traceSummary :: Trace -> T.Text traceSummary tr = T.unlines $ - [ T.intercalate " " + [ T.intercalate " " $ [ classText (siClass s) - , hex (frIp (siFrame s)) - , maybe "?" id (frFn (siFrame s)) - , location (siFrame s) + , hex (frIp f) + , maybe "?" id (frFn f) + , location f , "x" <> T.pack (show (siCount s)) ] - | s <- trSites tr ] + <> [ T.pack (show (length (siRuns s))) <> "/" + <> T.pack (show runs) <> " runs" + | runs > 1 ] + | s <- trSites tr, let f = lcFrame (siAt s) ] <> [ T.pack (show (length (trSites tr))) <> " secret-dependent \ - \site(s); " <> T.pack (show (length (trUnrelated tr))) + \site(s) over " <> T.pack (show runs) <> " run(s); " + <> T.pack (show (length (trUnrelated tr))) <> " unrelated; " <> T.pack (show (length (trFaults tr))) <> " fault(s)" ] where + runs = length (trRuns tr) location f = case (frFile f, frLine f) of (Just p, Just l) -> base p <> ":" <> T.pack (show l) (Just p, Nothing) -> base p diff --git a/nix/lib.nix b/nix/lib.nix @@ -70,28 +70,36 @@ let ln -s ${include}/include $out/include ''; - # one harness run under memcheck, as a derivation: its report, - # memcheck's XML, and what the harness printed. `objects` keeps - # sites in objects whose path contains one of them. A harness that - # fails still leaves a report of what ran; a run vestigia could - # not read fails the build. - traceOf = { name, harness, args ? [ ], objects ? [ ] }: + # runs of one harness under memcheck, as a derivation: each run + # kept (run-K: memcheck's XML, the objects its harness reported, + # its exit status, its own report), what each printed, and the + # report over all of them. `runs` is a list of argument lists, the + # secrets of the trace; memcheck sees only the path a run takes, so + # each run adds the sites on its own. `objects` keeps sites in + # objects whose path contains one of them. A harness that fails + # still leaves a report of what ran; a run vestigia could not read + # fails the build. + traceOf = { name, harness, runs, objects ? [ ] }: pkgs.runCommand "vestigia-trace-${name}" { } '' mkdir -p $out start=$(date +%s%N) - set +e - ${vestigia}/bin/vestigia run \ - --xml $out/memcheck.xml --out $out/trace.json \ + ${lib.concatImapStrings (k: args: '' + set +e + ${vestigia}/bin/vestigia run --dir $out/run-${toString k} \ + --out $out/run-${toString k}/trace.json \ + -- ${harness} ${lib.escapeShellArgs args} \ + > $out/stdout-${toString k} 2> $out/stderr-${toString k} + echo $? > $out/status-${toString k} + set -e + '') runs} + ${vestigia}/bin/vestigia read --out $out/trace.json \ ${lib.concatMapStrings (o: "--object ${lib.escapeShellArg o} ") - objects}-- ${harness} ${lib.escapeShellArgs args} \ - > $out/stdout 2> $out/stderr - echo $? > $out/status - set -e - echo $(( ($(date +%s%N) - start) / 1000000 )) > $out/milliseconds - test -s $out/trace.json || { - cat $out/stderr >&2 + objects}${lib.concatImapStrings (k: _: + "$out/run-${toString k} ") runs} 2> $out/summary || { + cat $out/summary >&2 exit 1 } + echo $(( ($(date +%s%N) - start) / 1000000 )) > $out/milliseconds ''; # runs of one harness that differ only in a secret, each diff --git a/nix/probe.nix b/nix/probe.nix @@ -37,7 +37,7 @@ let trace = vestigia.traceOf { name = "probe"; harness = "${probe}/bin/probe"; - args = [ (builtins.head secrets) ]; + runs = map (s: [ s ]) secrets; inherit objects; }; @@ -51,12 +51,13 @@ let # each report's (class, function) pairs in the harness, sorted expected = { - trace = [ [ "address" "lookup" ] [ "control" "branchy" ] - [ "control" "calls" ] [ "operand" "divide" ] + trace = [ [ "address" "lookup" ] [ "address" "rare" ] + [ "control" "branchy" ] [ "control" "calls" ] + [ "control" "rare" ] [ "operand" "divide" ] [ "operand" "divide_memory" ] ]; diff = [ [ "address" "lookup" ] [ "control" "branchy" ] - [ "control" "calls" ] [ "operand" "divide" ] - [ "operand" "divide_memory" ] ]; + [ "control" "calls" ] [ "control" "rare" ] + [ "operand" "divide" ] [ "operand" "divide_memory" ] ]; }; in pkgs.runCommand "vestigia-probe-check" { @@ -76,6 +77,14 @@ pkgs.runCommand "vestigia-probe-check" { '[.origins[] | [.class, .frames[0].function]] | unique' \ '${builtins.toJSON expected.diff}' + # every secret is traced under taint, and the table index on the + # third secret's path is that run's alone + check ${trace}/trace.json '[.runs[] | .exit]' '[0,0,0]' + check ${trace}/trace.json \ + '[.sites[] | select(.function == "rare" and .class == "address") + | .runs]' \ + '[["run-3"]]' + # both instruments name each instruction they both saw by one # address: a division memcheck reports where it divides, not at the # memory access before it diff --git a/test/Main.hs b/test/Main.hs @@ -79,21 +79,19 @@ memcheckTests = testGroup "memcheck" traceTests :: TestTree traceTests = testGroup "trace" [ testCase "the probe's secret addresses are its sites" $ do - tr <- trace <$> fixture "probe.xml" - fmap (\s -> (siClass s, frFn (siFrame s), frLine (siFrame s))) - (trSites tr) + tr <- one <$> fixture "probe.xml" + fmap (\s -> (siClass s, frFn (at s), frLine (at s))) (trSites tr) @?= [ (Address, Just "lookup", Just 16) , (Address, Just "main", Just 33) ] trUnrelated tr @?= [] trFaults tr @?= [] , testCase "only a secret's descendants are sites" $ do - tr <- trace <$> either assertFailure pure (readMemcheck mixed) - fmap (\s -> (siClass s, frIp (siFrame s), siCount s)) - (trSites tr) + tr <- one <$> either assertFailure pure (readMemcheck mixed) + fmap (\s -> (siClass s, frIp (at s), siCount s)) (trSites tr) @?= [ (Control, 0x10, 5) ] - fmap meKind (trUnrelated tr) @?= [ "UninitValue" ] - fmap meKind (trFaults tr) @?= [ "InvalidRead" ] + fmap (meKind . snd) (trUnrelated tr) @?= [ "UninitValue" ] + fmap (meKind . snd) (trFaults tr) @?= [ "InvalidRead" ] , testCase "a frame is named by its address in its object" $ do os <- either assertFailure pure @@ -109,16 +107,39 @@ traceTests = testGroup "trace" objectOffset os (f "/lib/libc.so.6" 0x7000) @?= Nothing , testCase "a site is kept to the objects named" $ do - tr <- trace <$> fixture "probe.xml" + tr <- one <$> fixture "probe.xml" length (trSites (sitesIn [ "probe" ] tr)) @?= 2 trSites (sitesIn [ "libc" ] tr) @?= [] length (trSites (sitesIn [] tr)) @?= 2 , testCase "one site per instruction, whatever called it" $ do - tr <- trace <$> either assertFailure pure (readMemcheck twoCallers) - fmap (\s -> (frIp (siFrame s), siCount s, length (siStacks s))) + tr <- one <$> either assertFailure pure (readMemcheck twoCallers) + fmap (\s -> (frIp (at s), siCount s, length (siStacks s))) (trSites tr) @?= [ (0x10, 7, 2) ] + + , testCase "runs' sites are one per instruction, with their runs" $ do + a <- either assertFailure pure (readMemcheck mixed) + b <- either assertFailure pure (readMemcheck twoCallers) + -- the same object loaded 0x100 higher in the second run: its + -- branch at 0x110 is the first run's at 0x10 + let obj = "/lib.so" + inObj mc = mc { mcErrors = + [ e { meStack = [ f { frObj = Just obj } + | f <- meStack e ] } + | e <- mcErrors mc ] } + moved mc = mc { mcErrors = + [ e { meStack = [ f { frIp = frIp f + 0x100 } + | f <- meStack e ] } + | e <- mcErrors mc ] } + tr = trace + [ Taint "a" (inObj a) [ (0, obj) ] (Just 0) + , Taint "b" (moved (inObj b)) [ (0x100, obj) ] (Just 1) ] + fmap (\s -> (siClass s, lcOffset (siAt s), siCount s, siRuns s + , length (siStacks s))) + (trSites tr) + @?= [ (Control, Just 0x10, 5 + 7, [ 0, 1 ], 1 + 2) ] + fmap fst (trUnrelated tr) @?= [ 0 ] ] diffTests :: TestTree @@ -375,6 +396,14 @@ jsonTests = testGroup "json" @?= "{\n \"b\": 1,\n \"a\": \"q\\\"\\n\\u0001\"\n}\n" ] +-- a trace of one run, of which memcheck's report is all that is +-- known +one :: Memcheck -> Trace +one mc = trace [ Taint "run" mc [] Nothing ] + +at :: Site -> Frame +at = lcFrame . siAt + fixture :: FilePath -> IO Memcheck fixture f = do b <- BS.readFile ("test/fixtures/" <> f)