vestigia

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

Harness.hs (2758B)

      1 {-# LANGUAGE ForeignFunctionInterface #-}
      2 
      3 -- | ppad-poly1305 under vestigia: each run draws a fresh one-time
      4 --   key, marked secret, and MACs a fixed set of public messages,
      5 --   comparing each tag with a public candidate.
      6 --
      7 --   usage: harness [RUNS [SEED]]
      8 --
      9 --   SEED (hex) seeds the keys alone; the messages and candidates
     10 --   come from a fixed stream, so runs that differ in SEED differ
     11 --   only in their keys.
     12 
     13 module Main (
     14     main
     15   ) where
     16 
     17 import Control.Monad (forM_)
     18 import qualified Crypto.MAC.Poly1305 as P
     19 import Data.Bits (shiftR, xor)
     20 import qualified Data.ByteString as BS
     21 import qualified Data.ByteString.Unsafe as BU
     22 import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef)
     23 import Data.Word (Word64)
     24 import Foreign.C.Types (CSize(..))
     25 import Foreign.Ptr (Ptr, castPtr)
     26 import Numeric (readHex)
     27 import System.Environment (getArgs)
     28 
     29 foreign import ccall unsafe "vestigia_secret"
     30   c_secret :: Ptr () -> CSize -> IO ()
     31 
     32 foreign import ccall unsafe "vestigia_public"
     33   c_public :: Ptr () -> CSize -> IO ()
     34 
     35 mark :: (Ptr () -> CSize -> IO ()) -> BS.ByteString -> IO ()
     36 mark f bs =
     37   BU.unsafeUseAsCStringLen bs (\(p, n) -> f (castPtr p) (fromIntegral n))
     38 
     39 splitmix :: Word64 -> (Word64, Word64)
     40 splitmix s0 =
     41   let s = s0 + 0x9e3779b97f4a7c15
     42       z1 = (s `xor` (s `shiftR` 30)) * 0xbf58476d1ce4e5b9
     43       z2 = (z1 `xor` (z1 `shiftR` 27)) * 0x94d049bb133111eb
     44   in (z2 `xor` (z2 `shiftR` 31), s)
     45 
     46 bytes :: Int -> Word64 -> (BS.ByteString, Word64)
     47 bytes n s0 = go n s0 []
     48   where
     49     go 0 s acc = (BS.pack (reverse acc), s)
     50     go k s acc =
     51       let (x, s') = splitmix s in go (k - 1) s' (fromIntegral x : acc)
     52 
     53 -- message lengths around the 16-byte block: empty, short final
     54 -- chunks, exact blocks
     55 lengths :: [Int]
     56 lengths = [ 0, 1, 15, 16, 17, 31, 32, 33, 64, 100 ]
     57 
     58 main :: IO ()
     59 main = do
     60   args <- getArgs
     61   let runs = case args of
     62         (r : _) | [ (n, "") ] <- reads r -> n
     63         _ -> 2 :: Int
     64       seed = case args of
     65         (_ : s : _) | [ (n, "") ] <- readHex s -> n
     66         _ -> 1
     67   let (messages, _) = foldr
     68         (\l (ms, s) -> let (m, s') = bytes l s in (m : ms, s'))
     69         ([], 0x0123456789abcdef) lengths
     70       candidates = [ fst (bytes 16 (0xfeed + fromIntegral k))
     71                    | k <- [ 0 .. length lengths - 1 ] ]
     72   secrets <- newIORef seed
     73   matches <- newIORef (0 :: Int)
     74   forM_ [ 1 .. runs ] $ \_ -> do
     75     s <- readIORef secrets
     76     let (key, s') = bytes 32 s
     77     writeIORef secrets s'
     78     mark c_secret key
     79     forM_ (zip messages candidates) $ \(m, c) -> case P.mac key m of
     80       Just t -> do
     81         let ok = t == P.MAC c
     82         modifyIORef' matches (+ fromEnum ok)
     83       Nothing -> pure ()
     84   n <- readIORef matches
     85   putStrLn (show runs <> " run(s), " <> show n <> " match(es)")