-
Notifications
You must be signed in to change notification settings - Fork 20
/
Encryption.hs
147 lines (125 loc) · 7.39 KB
/
Encryption.hs
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
----------------------------------------------------------------------------------------------------
---- Øèôðîâàíèå, äåøèôðîâàíèå è êðèïòîãðàôè÷åñêèé PRNG. ----
---- Ïðîöåäóðà generateEncryption äîáàâëÿåò ê öåïî÷êå àëãîðèòìîâ ñæàòèÿ àëãîðèòì(û) øèôðîâàíèÿ. ----
---- Ïðîöåäóðà generateDecryption äîáàâëÿåò êëþ÷è ê çàïèñè àëãîðèòìà ñæàòèÿ+øèôðîâàíèÿ, ----
---- Ïðîöåäóðà generateRandomBytes âîçâðàùàåò ïîñëåäîâàòåëüíîñòü êðèïò. ñëó÷àéíûõ áàéò ----
----------------------------------------------------------------------------------------------------
module Encryption (generateEncryption, generateDecryption, generateRandomBytes) where
import Prelude hiding (catch)
import Control.Concurrent
import Control.Monad
import Data.Char
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Ptr
import System.IO.Unsafe
import EncryptionLib
import Utils
import Errors
import Compression
---------------------------------------------------------------------------------------------------
---- Øèôðîâàíèå è äåøèôðîâàíèå --------------------------------------------------------------------
---------------------------------------------------------------------------------------------------
-- |Âîçâðàùàåò äâå ôóíêöèè, äîáàâëÿþùèå ê ìåòîäó ñæàòèÿ àëãîðèòì øèôðîâàíèÿ:
-- ïåðâàÿ âêëþ÷àåò êëþ÷ øèôðîâàíèÿ (äëÿ ðåàëüíîãî èñïîëüçîâàíèÿ)
-- âòîðàÿ òîëüêî âñïîìîãàòåëüíûå äàííûå (äëÿ ñîõðàíåíèÿ â àðõèâå)
generateEncryption encryption password = do
addRandomness
result <- foreach (split_compressor encryption) $ \algorithm -> do
initVector <- generateRandomBytes (encryptionGet "ivSize" algorithm)
salt <- generateRandomBytes (encryptionGet "keySize" algorithm)
let numIterations = encryptionGet "numIterations" algorithm
checkCodeSize = 2
(key, checkCode) = deriveKey algorithm password salt numIterations checkCodeSize
return (algorithm++":k"++encode16 key++":i"++encode16 initVector
,algorithm++":s"++encode16 salt++":c"++encode16 checkCode
++":i"++encode16 initVector)
return ((++map fst result), (++map snd result))
-- |Îáðàáîòàòü compressor, ïðî÷èòàííûé èç àðõèâà, äîáàâèâ ê íåìó èíôîðìàöèþ,
-- íåîáõîäèìóþ äëÿ ðàñøèôðîâêè
generateDecryption compressor decryption_info = mapM addKey compressor where
-- Îáðàáîòàòü àëãîðèòì øèôðîâàíèÿ, äîáàâèâ ê íåìó key, âûâåäåííûé
-- èç çàäàííîãî ïîëüçîâàòåëåì ïàðîëÿ è salt, ñîõðàí¸ííîãî â ïàðàìåòðàõ àëãîðèòìà
addKey algorithm | not (isEncryption algorithm)
= return (Just algorithm) -- non-encryption algorithm stays untouched
| otherwise = do
-- Âûäåëèì èç çàïèñè àëãîðèòìà ïàðàìåòðû, íåîáõîäèìûå äëÿ âû÷èñëåíèÿ è ïðîâåðêè êëþ÷à
let name:params = split_method algorithm
param c = params .$map (splitAt 1) .$lookup c -- íàéòè çíà÷åíèå ïàðàìåòðà ñ
salt = param "s" `defaultVal` (error$ algorithm++" doesn't include salt") .$decode16
checkCode = param "c" `defaultVal` "" .$decode16
numIterations = param "n" `defaultVal` (error$ algorithm++" doesn't include numIterations") .$readInt
-- Âîñïîëüçóåìñÿ ñïèñêîì ïàðîëåé ðàñïàêîâêèè è, åñëè ïðèä¸òñÿ,
-- äîáàâèì â íåãî íîâûå ïàðîëè, ââåä¸ííûå ïîëüçîâàòåëåì
let (dont_ask_passwords, mvar_passwords, keyfiles, ask_decryption_password, bad_decryption_password) = decryption_info
modifyMVar mvar_passwords $ \passwords -> do
passwords_list <- ref passwords
-- Ïîïðîáîâàòü ðàñøèôðîâêó ñî âñåìè âîçìîæíûìè keyfiles è çàòåì áåç íèõ
let checkPwd password = firstJust$ map doCheck (keyfiles++[""])
where -- Åñëè âåðèôèêàöèÿ ïî checkCode óñïåøíà, òî âîçâðàùàåì íàéäåííûé êëþ÷ àëãîðèòìà øèôðîâàíèÿ, èíà÷å - Nothing
doCheck keyfile = recheckCode==checkCode &&& Just key
-- Âû÷èñëèì êëþ÷ ðàñøèôðîâêè key è recheckCode, èñïîëüçóåìûé äëÿ áûñòðîé ïðîâåðêè ïðàâèëüíîñòè ïàðîëÿ
where (key, recheckCode) = deriveKey algorithm (password++keyfile) salt numIterations (length checkCode)
-- Ïðîöåäóðà ïîäáîðà ïàðîëÿ äëÿ ðàñøèôðîâêè áëîêà.
-- Êàæäûé âåðîÿòíûé ïàðîëü ïðîâåðÿåòñÿ ñ ïîìîùüþ checkPwd.
-- Åñëè íè îäèí èç óæå èçâåñòíûõ ïàðîëåé íå ïîäîø¸ë, òî ìû çàïðàøèâàåì ó ïîëüçîâàòåëÿ íîâûå
let findDecryptionKey (password:pwds) = do
case (checkPwd password) of -- Åñëè âåðèôèêàöèÿ â checkPwd ïðîøëà óñïåøíî
Just key -> return (Just key) -- òî âîçâðàùàåì íàéäåííûé êëþ÷ àëãîðèòìà øèôðîâàíèÿ
Nothing -> findDecryptionKey pwds -- èíà÷å - ïðîáóåì ñëåäóþùèå ïàðîëè
findDecryptionKey [] = do -- Ñþäà ìû ïîïàäàåì åñëè íè îäèí ñòàðûé ïàðîëü íå ïîäîø¸ë
-- Åñëè èñïîëüçîâàíà îïöèÿ -p-/-op- èëè ïîëüçîâàòåëü ââåä¸ò ïóñòóþ ñòðîêó -
-- çíà÷èò, ýòîò áëîê ðàñøèôðîâàòü íàì íå óäàñòñÿ
if dont_ask_passwords then return Nothing else do
password <- ask_decryption_password
if password=="" then return Nothing else do
-- Äîáàâèì íîâûé ïàðîëü â ñïèñîê ïàðîëåé, ïðîâåðÿåìûõ ïðè ðàñïàêîâêå
passwords_list .= (password:)
case (checkPwd password) of -- Åñëè âåðèôèêàöèÿ â checkPwd ïðîøëà óñïåøíî
Just key -> return (Just key) -- òî âîçâðàùàåì íàéäåííûé êëþ÷ àëãîðèòìà øèôðîâàíèÿ
Nothing -> do bad_decryption_password -- èíà÷å - çàïðàøèâàåì äðóãîé ïàðîëü
findDecryptionKey []
--
key <- findDecryptionKey passwords
pl <- val passwords_list
return (pl, key.$fmap (\key -> algorithm++":k"++encode16 key))
-- |Âûâåñòè èç password+salt êëþ÷ øèôðîâàíèÿ è êîä ïðîâåðêè
deriveKey algorithm password salt numIterations checkCodeSize =
splitAt keySize $ pbkdf2Hmac password salt numIterations (keySize+checkCodeSize)
where keySize = encryptionGet "keySize" algorithm
-- |Check action result and abort on (internal) error
check test msg action = do
res <- action
unless (test res) (fail$ "Error in "++msg)
-- |OK return code for LibTomCrypt library
aCRYPT_OK = 0
---------------------------------------------------------------------------------------------------
---- Êðèïòîãðàôè÷åñêèé ãåíåðàòîð ñëó÷àéíûõ ïîñëåäîâàòåëüíîñòåé áàéò -------------------------------
---------------------------------------------------------------------------------------------------
-- |Äîáàâèòü ñëó÷àéíóþ èíôîðìàöèþ, ïîëó÷åííóþ îò ÎÑ, â PRNG
addRandomness = withMVar prng_state addRandomnessTo
addRandomnessTo prng = do
let size = 4096
allocaBytes size $ \buf -> do
bytes <- systemRandomData buf (i size)
check (==aCRYPT_OK) "prng_add_entropy" $
prng_add_entropy buf (i bytes) prng
-- |Ñãåíåðèòü ñëó÷àéíóþ ïîñëåäîâàòåëüíîñòü áàéò óêàçàííîé äëèíû
generateRandomBytes bytes = do
withMVar prng_state $ \prng -> do
allocaBytes bytes $ \buf -> do
check (==i bytes) "prng_read" $
prng_read buf (i bytes) prng
peekCAStringLen (buf, bytes)
-- |Ïåðåìåííàÿ, õðàíÿùàÿ ñîñòîÿíèå PRNG
{-# NOINLINE prng_state #-}
prng_state :: MVar (Ptr CChar)
prng_state = unsafePerformIO $ do
prng <- mallocBytes (i prng_size)
prng_start prng
addRandomnessTo prng
newMVar prng
-- |Fill buffer with system-generated pseudo-random data
foreign import ccall unsafe "Environment.h systemRandomData"
systemRandomData :: Ptr CChar -> CInt -> IO CInt