afis (empty) → 0.1.0

raw patch · 6 files changed

+307/−0 lines, 6 filesdep +HUnitdep +QuickCheckdep +afissetup-changed

Dependencies added: HUnit, QuickCheck, afis, base, byteable, bytedump, bytestring, crypto-random-api, cryptohash, mtl, packer, test-framework, test-framework-hunit, test-framework-quickcheck2

Files

Crypto/Data/AFIS.hs +141/−0
LICENSE +27/−0
README.md +4/−0
Setup.hs +2/−0
afis.cabal +53/−0
tests/Tests.hs +80/−0

+ Crypto/Data/AFIS.hs view

@@ -0,0 +1,141 @@+-- |+-- Module      : Crypto.Data.AFIS+-- License     : BSD-style+-- Maintainer  : Vincent Hanquez <vincent@snarc.org>+-- Stability   : experimental+-- Portability : unknown+--+-- haskell implementation of the Anti-forensic information splitter+-- available in LUKS. <http://clemens.endorphin.org/AFsplitter>+--+-- The algorithm bloats an arbitrary secret with many bits that are necessary for+-- the recovery of the key (merge), and allow greater way to permanently+-- destroy a key stored on disk.+--+module Crypto.Data.AFIS+    ( split+    , merge+    ) where++import Crypto.Hash+import Crypto.Random.API+import Control.Monad (forM_, foldM)+import Data.ByteString (ByteString)+import Data.Byteable+import Data.Packer+import Data.Tuple+import Data.Word+import Data.Bits+import Foreign.Storable+import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr, newForeignPtr_)+import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as B++import System.IO.Unsafe (unsafePerformIO)++-- | Split data to diffused data, using a random generator and+-- an hash algorithm.+--+-- the diffused data will consist of random data for (expandTimes-1)+-- then the last block will be xor of the accumulated random data diffused by+-- the hash algorithm.+--+-- ----------+-- -  orig  -+-- ----------+--+-- ---------- ---------- --------------+-- - rand1  - - rand2  - - orig ^ acc -+-- ---------- ---------- --------------+--+-- where acc is :+--   acc(n+1) = hash (n ++ rand(n)) ^ acc(n)+--+split :: (HashAlgorithm a, CPRG rng)+      => HashFunctionBS a  -- ^ Hash function to use as diffuser+      -> rng               -- ^ Random generator to use+      -> Int               -- ^ Number of times to diffuse the data.+      -> ByteString        -- ^ original data to diffuse.+      -> (ByteString, rng) -- ^ The diffused data+{-# NOINLINE split #-}+split hashF rng expandTimes src+    | expandTimes <= 1 = error "invalid expandTimes value"+    | otherwise        = unsafePerformIO $ do+        fptr <- B.mallocByteString diffusedLen+        rng' <- withForeignPtr fptr runOp+        return (B.fromForeignPtr fptr 0 diffusedLen, rng')+  where diffusedLen = blockSize * expandTimes+        blockSize   = B.length src+        runOp dstPtr = do+            let lastBlock = dstPtr `plusPtr` (blockSize * (expandTimes-1))+            B.memset lastBlock 0 (fromIntegral blockSize)+            let randomBlockPtrs = map (plusPtr dstPtr . (*) blockSize) [0..(expandTimes-2)]+            rng' <- foldM fillRandomBlock rng randomBlockPtrs+            mapM_ (addRandomBlock lastBlock) randomBlockPtrs+            withBytePtr src $ \srcPtr -> xorMem srcPtr lastBlock blockSize+            return rng'+        addRandomBlock lastBlock blockPtr = do+            xorMem blockPtr lastBlock blockSize+            diffuse hashF lastBlock blockSize+        fillRandomBlock g blockPtr = do+            let (rand, g') = genRandomBytes blockSize g+            withBytePtr rand $ \randPtr -> B.memcpy blockPtr randPtr blockSize+            return g'++-- | Merge previously diffused data back to the original data.+merge :: HashAlgorithm a+      => HashFunctionBS a -- ^ Hash function used as diffuser+      -> Int              -- ^ Number of times to un-diffuse the data+      -> ByteString       -- ^ Diffused data+      -> ByteString       -- ^ Original data+{-# NOINLINE merge #-}+merge hashF expandTimes bs+    | r /= 0            = error "diffused data not a multiple of expandTimes"+    | originalSize <= 0 = error "diffused data null"+    | otherwise         = unsafePerformIO $ B.create originalSize $ \dstPtr ->+        withBytePtr bs $ \srcPtr -> do+        B.memset dstPtr 0 (fromIntegral originalSize)+        forM_ [0..(expandTimes-2)] $ \i -> do+            xorMem (srcPtr `plusPtr` (i * originalSize)) dstPtr originalSize+            diffuse hashF dstPtr originalSize+        xorMem (srcPtr `plusPtr` ((expandTimes-1) * originalSize)) dstPtr originalSize+        return ()+  where (originalSize,r) = len `quotRem` expandTimes+        len              = B.length bs++-- | inplace Xor with an input+-- dst = src `xor` dst+xorMem :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()+xorMem src dst sz+    | sz `mod` 64 == 0 = loop 8 (castPtr src :: Ptr Word64) (castPtr dst) sz+    | sz `mod` 32 == 0 = loop 4 (castPtr src :: Ptr Word32) (castPtr dst) sz+    | otherwise        = loop 1 (src :: Ptr Word8) dst sz+  where loop _    _ _ 0 = return ()+        loop incr s d n = do a <- peek s+                             b <- peek d+                             poke d (a `xor` b)+                             loop incr (s `plusPtr` incr) (d `plusPtr` incr) (n-incr)++diffuse :: HashAlgorithm a+        => HashFunctionBS a -- ^ Hash function to use as diffuser+        -> Ptr Word8+        -> Int+        -> IO ()+diffuse hashF src sz = loop src 0+  where (full,pad) = sz `quotRem` digestSize +        loop s i | i < full = do h <- hashBlock i `fmap` byteStringOfPtr s digestSize+                                 withBytePtr h $ \hPtr -> B.memcpy s hPtr digestSize+                                 loop (s `plusPtr` digestSize) (i+1)+                 | pad /= 0 = do h <- hashBlock i `fmap` byteStringOfPtr s pad+                                 withBytePtr h $ \hPtr -> B.memcpy s hPtr pad+                                 return ()+                 | otherwise = return ()++        digestSize = B.length $ digestToByteString $ hashF B.empty++        byteStringOfPtr :: Ptr Word8 -> Int -> IO ByteString+        byteStringOfPtr ptr sz = newForeignPtr_ ptr >>= \fptr -> return $ B.fromForeignPtr fptr 0 sz++        hashBlock n src =+            digestToByteString $ hashF $ runPacking (B.length src+4) (putWord32BE (fromIntegral n) >> putBytes src)

+ LICENSE view

@@ -0,0 +1,27 @@+Copyright (c) 2013 Vincent hanquez <vincent@snarc.org>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,4 @@+afis+=======++Documentation: [afis on hackage](http://hackage.haskell.org/package/afis)

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ afis.cabal view

@@ -0,0 +1,53 @@+Name:                afis+Version:             0.1.0+Synopsis:            Anti-forensic Information Splitter+Description:         Anti-forensic Information Splitter as defined for LUKS+License:             BSD3+License-file:        LICENSE+Copyright:           Vincent Hanquez <vincent@snarc.org>+Author:              Vincent Hanquez <vincent@snarc.org>+Maintainer:          vincent@snarc.org+Category:            Cryptography,Data+Stability:           experimental+Build-Type:          Simple+Homepage:            http://github.com/vincenthz/hs-afis+Cabal-Version:       >=1.8+data-files:          README.md++Library+  Build-Depends:     base >= 3 && < 5+                   , bytestring+                   , cryptohash+                   , crypto-random-api+                   , packer+                   , byteable+                   , bytedump+  Exposed-modules:   Crypto.Data.AFIS++--Executable           afis+--  Main-Is:           afis.hs+--  ghc-options:       -Wall -fno-warn-missing-signatures+--  Hs-Source-Dirs:    .+--  Build-depends:     base >= 4 && < 5++Test-Suite test-afis+  type:              exitcode-stdio-1.0+  hs-source-dirs:    tests+  Main-is:           Tests.hs+  Build-Depends:     base >= 3 && < 5+                   , mtl+                   , QuickCheck >= 2+                   , HUnit+                   , test-framework+                   , test-framework-quickcheck2+                   , test-framework-hunit+                   , afis+                   , crypto-random-api+                   , cryptohash+                   , bytestring+                   , bytedump+  ghc-options:       -Wall -fno-warn-orphans -fno-warn-missing-signatures++source-repository head+  type: git+  location: git://github.com/vincenthz/hs-afis

+ tests/Tests.hs view

@@ -0,0 +1,80 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ExistentialQuantification #-}+module Main where++import Control.Applicative+import Control.Monad++import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit++import Test.QuickCheck+import Test.QuickCheck.Test+import Test.Framework.Providers.QuickCheck2 (testProperty)++import qualified Crypto.Data.AFIS as AFIS+import Crypto.Hash+import Crypto.Random.API+import qualified Data.ByteString as B++import Text.Bytedump++mergeVec =+    [ (3+      , hash :: HashFunctionBS SHA1+      , "\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02\x02"+      , "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\xd4\x76\xc8\x58\xbd\xf0\x15\xbe\x9f\x40\xe3\x65\x20\x1c\x9c\xb8\xd8\x1c\x16\x64"+      )+    , (3+      , hash :: HashFunctionBS SHA1+      , "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17"+      , "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\xd6\x75\xc8\x59\xbb\xf7\x11\xbb\x95\x4b\xeb\x6c\x2e\x13\x90\xb5\xca\x0f\x06\x75\x17\x70\x39\x28"+      )+    ]++mergeKATs = map toProp $ zip mergeVec [0..]+  where toProp ((nbExpands, hashF, expected, dat), i) =+            testCase ("merge " ++ show i) (expected @=? AFIS.merge hashF nbExpands dat)++data AFISParams = forall a . HashAlgorithm a => AFISParams B.ByteString Int (HashFunctionBS a) FakeRNG++instance Show AFISParams where+    show (AFISParams dat expand _ _) = "data: " ++ show dat ++ " expanded: " ++ show expand++data FakeRNG = FakeRNG Int B.ByteString++instance CPRG FakeRNG where+    cprgNeedReseed _ = NeverReseed+    cprgSupplyEntropy b2 (FakeRNG o b) = FakeRNG o (B.append b b2)+    cprgGenBytes n (FakeRNG o b)+        | n > B.length b - o = (B.take n $ B.drop o (B.concat $ replicate 10 b), FakeRNG 0 b)+        | otherwise          = (B.take n $ B.drop o b, FakeRNG (o+n) b)++instance Arbitrary AFISParams where+    arbitrary = AFISParams <$> arbitraryBS <*> choose (2,2) <*> elements [hash :: HashFunctionBS SHA1] <*> arbitraryRandom+      where arbitraryBS = choose (3,46) >>= \sz -> B.pack <$> replicateM sz arbitrary +            arbitraryRandom = choose (1024,4096) >>= \sz -> FakeRNG 0 . B.pack <$> replicateM sz arbitrary++tests =+    [ testGroup "KAT merge" mergeKATs+    , testProperty "merge.split == id" $ \(AFISParams bs e hf rng) -> (AFIS.merge hf e $ fst (AFIS.split hf rng e bs)) `assertEq` bs+    ]++assertEq :: B.ByteString -> B.ByteString -> Bool+assertEq b1 b2 | b1 /= b2  = error ("b1: " ++ show b1 ++ " b2: " ++ show b2)+               | otherwise = True++main = defaultMain tests+{-+    let hf    = hash :: HashFunctionBS SHA1+        e     = 4+        bs    = B.pack [1,2,3,4,5,1,2]+        (z,_) = AFIS.split hf (FakeRNG 0 $ B.replicate 4000 3) e bs+        bs2   = AFIS.merge hf e z+    when (bs /= bs2) $ do+        putStrLn ("bs : " ++ dumpRawBS bs)+        putStrLn ("z  : " ++ dumpRawBS z)+        putStrLn ("bs2: " ++ dumpRawBS bs2)+-}