1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- 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 Control.Monad (foldM, forM_)
import Crypto.Hash
import Crypto.Internal.Compat
import Crypto.Random.Types
import Data.Bits
import Data.Word
import Foreign.Ptr
import Foreign.Storable
import Crypto.Internal.ByteArray (ByteArray, Bytes, MemView (..))
import qualified Crypto.Internal.ByteArray as B
import Data.Memory.PtrMethods (memCopy, memSet)
-- | 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
:: (ByteArray ba, HashAlgorithm hash, DRG rng)
=> hash
-- ^ Hash algorithm to use as diffuser
-> rng
-- ^ Random generator to use
-> Int
-- ^ Number of times to diffuse the data.
-> ba
-- ^ original data to diffuse.
-> (ba, rng)
-- ^ The diffused data
{-# NOINLINE split #-}
split hashAlg rng expandTimes src
| expandTimes <= 1 = error "invalid expandTimes value"
| otherwise = unsafeDoIO $ do
(rng', bs) <- B.allocRet diffusedLen runOp
return (bs, rng')
where
diffusedLen = blockSize * expandTimes
blockSize = B.length src
runOp dstPtr = do
let lastBlock = dstPtr `plusPtr` (blockSize * (expandTimes - 1))
memSet lastBlock 0 blockSize
let randomBlockPtrs = map (plusPtr dstPtr . (*) blockSize) [0 .. (expandTimes - 2)]
rng' <- foldM fillRandomBlock rng randomBlockPtrs
mapM_ (addRandomBlock lastBlock) randomBlockPtrs
B.withByteArray src $ \srcPtr -> xorMem srcPtr lastBlock blockSize
return rng'
addRandomBlock lastBlock blockPtr = do
xorMem blockPtr lastBlock blockSize
diffuse hashAlg lastBlock blockSize
fillRandomBlock g blockPtr = do
let (rand :: Bytes, g') = randomBytesGenerate blockSize g
B.withByteArray rand $ \randPtr -> memCopy blockPtr randPtr blockSize
return g'
-- | Merge previously diffused data back to the original data.
merge
:: (ByteArray ba, HashAlgorithm hash)
=> hash
-- ^ Hash algorithm used as diffuser
-> Int
-- ^ Number of times to un-diffuse the data
-> ba
-- ^ Diffused data
-> ba
-- ^ Original data
{-# NOINLINE merge #-}
merge hashAlg expandTimes bs
| r /= 0 = error "diffused data not a multiple of expandTimes"
| originalSize <= 0 = error "diffused data null"
| otherwise = B.allocAndFreeze originalSize $ \dstPtr ->
B.withByteArray bs $ \srcPtr -> do
memSet dstPtr 0 originalSize
forM_ [0 .. (expandTimes - 2)] $ \i -> do
xorMem (srcPtr `plusPtr` (i * originalSize)) dstPtr originalSize
diffuse hashAlg 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 hash
=> hash
-- ^ Hash function to use as diffuser
-> Ptr Word8
-- ^ buffer to diffuse, modify in place
-> Int
-- ^ length of buffer to diffuse
-> IO ()
diffuse hashAlg src sz = loop src 0
where
(full, pad) = sz `quotRem` digestSize
loop s i
| i < full = do
h <- hashBlock i s digestSize
B.withByteArray h $ \hPtr -> memCopy s hPtr digestSize
loop (s `plusPtr` digestSize) (i + 1)
| pad /= 0 = do
h <- hashBlock i s pad
B.withByteArray h $ \hPtr -> memCopy s hPtr pad
return ()
| otherwise = return ()
digestSize = hashDigestSize hashAlg
-- Hash [ BE32(n), (p .. p+hashSz) ]
hashBlock n p hashSz = do
let ctx = hashInitWith hashAlg
return $! hashFinalize $ hashUpdate (hashUpdate ctx (be32 n)) (MemView p hashSz)
be32 :: Int -> Bytes
be32 n = B.allocAndFreeze 4 $ \ptr -> do
poke ptr (f8 (n `shiftR` 24))
poke (ptr `plusPtr` 1) (f8 (n `shiftR` 16))
poke (ptr `plusPtr` 2) (f8 (n `shiftR` 8))
poke (ptr `plusPtr` 3) (f8 n)
where
f8 :: Int -> Word8
f8 = fromIntegral
|
