diff --git a/Crypto/Data/AFIS.hs b/Crypto/Data/AFIS.hs new file mode 100644 --- /dev/null +++ b/Crypto/Data/AFIS.hs @@ -0,0 +1,141 @@ +-- | +-- Module : Crypto.Data.AFIS +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- haskell implementation of the Anti-forensic information splitter +-- available in LUKS. +-- +-- 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) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2013 Vincent hanquez + +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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +afis +======= + +Documentation: [afis on hackage](http://hackage.haskell.org/package/afis) diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/afis.cabal b/afis.cabal new file mode 100644 --- /dev/null +++ b/afis.cabal @@ -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 +Author: Vincent Hanquez +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 diff --git a/tests/Tests.hs b/tests/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/Tests.hs @@ -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) +-}