Si vous constatez la perte de tickets, de commentaires ou de projets, veuillez consulter la page https://status.framasoft.org/incident/626.

Commit 32b0f51a authored by Vicente Parra Hurtado's avatar Vicente Parra Hurtado 💬

Alpha 0.3.1

parent 083f3746
import NukeBull
import EncrypText
import System.Environment
import Data.Char
import Data.Word
import Data.Maybe
import System.Random
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Text.IO as TIO
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as BS
main = do
(comando:_) <- getArgs
case comando of
"encrypt" -> do
(_:fileName10:fileName20:_) <- getArgs
let fileName1 = "Keys/" ++ fileName10 ++ ".key"
let fileName2 = "CryptMsg/" ++ fileName20 ++ ".cryptext"
-- Read Password = 128 bytes = 16 vectorIV + 32 AES256 + 16 Cipher Lv.3.1 + 64 Cipher Lv 3.2
source <- B.readFile fileName1
-- Text to crypt
putStrLn "Text to Encrypt ( Maximum number of characters: 127 ) (ASCII 217 ┘ Forbidden)"
textoOn <- TIO.getLine
if T.length (textoOn) > 127
then putStrLn $ " Yours Characters are: " ++ (show(T.length (textoOn))) ++" (Number Maximun of characters are 127) "
else do
g <- newStdGen
g <- newStdGen
texto <- encryptext (E.encodeUtf8 textoOn) source g
putStrLn "Loading Password -------------- is Ok"
putStrLn "Encrypting Text --------------- is Ok"
let base64 = BS.encode texto
putStrLn "Encoding Base64 --------------- is Ok"
B.writeFile fileName2 base64
putStrLn "Writing Encrypted File -------- is OK"
putStrLn ""
putStrLn ""
putStrLn "================================================================="
putStrLn "===== N N U U K K EEEE BBB U U L L ====="
putStrLn "===== NN N U U K K E B B U U L L ====="
putStrLn "===== N N N U U KK EEE BBB U U L L ====="
putStrLn "===== N NN U U K K E B B U U L L ====="
putStrLn "===== N N UUUU K K EEEE BBB UUUU LLLL LLLL ====="
putStrLn "================================================================="
putStrLn ""
putStrLn ""
putStrLn (" Your text has been encrypted in " ++ (show(fileName2)))
putStrLn ""
"decrypt" -> do
(_:fileName10:fileName20:_) <- getArgs
let fileName1 = "Keys/" ++ fileName10 ++ ".key"
let fileName2 = "CryptMsg/" ++ fileName20 ++ ".cryptext"
-- Read Password = 128 bytes = 16 vectorIV + 32 AES256 + 16 Cipher Lv.3.1 + 64 RandomGen Lv 3.2
source <- B.readFile fileName1
-- Decrypt
code <- B.readFile fileName2
let base64 = BS.decodeLenient code
if B.length base64 == 256
then do
text <- decryptext base64 source
-- The 217 ASCII is the end of the text
let textoInt = B.elemIndex 217 text
--TIO.putStrLn (E.decodeUtf8(B.take (fromJust textoInt) text))
putStrLn ""
putStrLn ""
putStrLn "================================================================="
putStrLn "===== N N U U K K EEEE BBB U U L L ====="
putStrLn "===== NN N U U K K E B B U U L L ====="
putStrLn "===== N N N U U KK EEE BBB U U L L ====="
putStrLn "===== N NN U U K K E B B U U L L ====="
putStrLn "===== N N UUUU K K EEEE BBB UUUU LLLL LLLL ====="
putStrLn "================================================================="
putStrLn ""
putStrLn " Decrypted Text: "
putStrLn ""
TIO.putStrLn (E.decodeUtf8(B.take (fromJust textoInt) text))
putStrLn ""
else do
-- No More
putStrLn "Is it a Cryptext File?"
otherwise ->do
putStrLn "Arguments Is Not Valid"
putStrLn "Used: encrypt FileName(Password) FileName (Crypt Msg)"
putStrLn "Used: decrypt FileName(Password) FileName (Crypt Msg)"
module EncrypText
(encryptext
,decryptext
) where
import NukeBull
import System.Random
import Crypto.Cipher.AES (AES256)
import Crypto.Cipher.Types (BlockCipher(..), Cipher(..),IV, makeIV)
import Crypto.Error (throwCryptoError)
import qualified Data.ByteString as B
-- Text length =128
encryptext :: (RandomGen g) => B.ByteString -> B.ByteString -> g -> IO B.ByteString
encryptext msg password g = do
let vectorIV = B.pack ( take 16 $ B.unpack password )
let key = B.pack (take 32 ( drop 16 $ B.unpack password ))
let passwordL31 = B.pack (take 16 ( drop 48 $ B.unpack password ))
let rows = passwordRows $ B.unpack passwordL31
let cols = passwordCols $ B.unpack passwordL31
let pass = B.pack( take 16 ( drop 64 $ B.unpack password ))
let pass2 = B.pack( take 16 ( drop 80 $ B.unpack password ))
let pass3 = B.pack( take 16 ( drop 96 $ B.unpack password ))
let pass4 = B.pack( take 16 ( drop 112 $ B.unpack password ))
let text = entrophyBS 128 msg g
let mInitIV = makeIV vectorIV
case mInitIV of
Nothing -> error "Failed to generate and initialization vector."
Just initIV -> do
let texto = encryptAES256 key initIV text
let textoMatrix = orderLv3 16 (B.unpack texto) rows cols pass pass2 pass3 pass4
return textoMatrix
-- Text length =128
decryptext :: B.ByteString -> B.ByteString -> IO B.ByteString
decryptext msg password = do
--hola
let vectorIV = B.pack ( take 16 $ B.unpack password )
let key = B.pack (take 32 ( drop 16 $ B.unpack password ))
let passwordL31 = B.pack (take 16 ( drop 48 $ B.unpack password ))
let rows = passwordRows $ B.unpack passwordL31
let cols = passwordCols $ B.unpack passwordL31
let pass = B.pack( take 16 ( drop 64 $ B.unpack password ))
let pass2 = B.pack( take 16 ( drop 80 $ B.unpack password ))
let pass3 = B.pack( take 16 ( drop 96 $ B.unpack password ))
let pass4 = B.pack( take 16 ( drop 112 $ B.unpack password ))
let mInitIV = makeIV vectorIV
case mInitIV of
Nothing -> error "Failed to generate and initialization vector."
Just initIV -> do
let textoMatrix = orderLv3Inv 16 (B.unpack msg) rows cols pass pass2 pass3 pass4
let dtext = decryptAES256 key initIV (textoMatrix)
let text = decryptEntrophy 128 dtext
return text
import NukeBull (noOrder,randomBytesString)
import System.Environment
import Data.Word
import Data.Bits
import System.Random
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as BS
generator :: (RandomGen g ) => Int -> Int -> g -> [Int]
generator n m g = take n $ randomRs (0,m) g
choose :: Int -> B.ByteString -> B.ByteString
choose n b = B.drop (n-1) (B.take n b )
ordercrazy :: Int -> [Word8] ->[Int] -> [Int] -> [Word8]
ordercrazy 1 c s1 s2 = noOrder c s1 s2
ordercrazy n c s1 s2 = noOrder ( ordercrazy (n-1) c s1 s2 )s1 s2
crazyloop :: (RandomGen g) => Int -> Int -> g -> IO B.ByteString
crazyloop n m g = do
g <- newStdGen
let poll = randomBytesString m g
g <- newStdGen
let droping = generator n (m-1) g
let password = B.concat ( map (\x -> B.drop x (B.take (x+1) poll)) droping )
return password
main = do
(comando:_) <- getArgs
case comando of
"lazy" -> do
(_:fileName10:_) <- getArgs
let fileName1 = "Keys/" ++ fileName10 ++ ".key"
-- Password = 128 bytes = 16 vectorIV + 32 AES256 + 16 Cipher Lv.3.1 + 64 RandomGen Lv 3.2
g <- getStdGen
g <- newStdGen
let passwords = randomBytesString 128 g
B.writeFile fileName1 passwords
putStrLn "Creating vectorIV ------------- OK"
putStrLn "Creating AES256 Key ----------- OK"
putStrLn "Creating Password Lv. 3.1 ----- OK"
putStrLn "Creating Password Lv. 3.2 ----- OK"
putStrLn "Writing Password --------------- OK"
"crazy" -> do
(_:fileName10:_) <- getArgs
let fileName1a = "Keys/" ++ fileName10 ++ "a.key"
let fileName1b = "Keys/" ++ fileName10 ++ "b.key"
let fileName1 = "Keys/" ++ fileName10 ++ ".key"
-- Read Password = 128 bytes = 16 vectorIV + 32 AES256 + 16 Cipher Lv.3.1 + 64 RandomGen Lv 3.2
putStrLn "Creating Random Poll --------------------------- OK"
putStrLn "Please wait, Millions of bits Playing ---------- OK"
g <- getStdGen
g <- newStdGen
password1 <- crazyloop 32 1048576 g
g <- newStdGen
password2 <- crazyloop 32 1048576 g
g <- newStdGen
password3 <- crazyloop 32 1048576 g
g <- newStdGen
password4 <- crazyloop 32 1048576 g
g <- newStdGen
password5 <- crazyloop 32 1048576 g
g <- newStdGen
password6 <- crazyloop 32 1048576 g
g <- newStdGen
password7 <- crazyloop 32 1048576 g
g <- newStdGen
password8 <- crazyloop 32 1048576 g
let passwords = B.unpack(password1) ++ B.unpack(password2) ++ B.unpack(password3) ++ B.unpack(password4) ++ B.unpack(password5) ++ B.unpack(password6) ++ B.unpack(password7) ++ B.unpack(password8)
g <- newStdGen
let rows = generator 32 15 g
g <- newStdGen
let cols = generator 32 15 g
let password = B.take 128 (B.pack (ordercrazy 30 passwords rows cols))
let passworda = B.drop 128 (B.pack (ordercrazy 30 passwords rows cols))
let passwordb = B.pack (B.zipWith (xor) ( password) ( passworda))
B.writeFile fileName1 password
let base64a = BS.encode passworda
let base64b = BS.encode passwordb
B.writeFile fileName1a base64a
B.writeFile fileName1b base64b
putStrLn ""
putStrLn ""
putStrLn "================================================================="
putStrLn "===== N N U U K K EEEE BBB U U L L ====="
putStrLn "===== NN N U U K K E B B U U L L ====="
putStrLn "===== N N N U U KK EEE BBB U U L L ====="
putStrLn "===== N NN U U K K E B B U U L L ====="
putStrLn "===== N N UUUU K K EEEE BBB UUUU LLLL LLLL ====="
putStrLn "================================================================="
putStrLn ""
putStrLn (" Your password has been created in " ++ (show(fileName1)))
putStrLn (" Two Complementary keys in " ++ (show(fileName1a)) ++" and "++ (show(fileName1a)))
putStrLn ""
putStrLn ""
"xor" -> do
(_:fileName10:_) <- getArgs
let fileName1 = "Keys/" ++ fileName10 ++ ".key"
let fileName1a = "Keys/" ++ fileName10 ++ "a.key"
let fileName1b = "Keys/" ++ fileName10 ++ "b.key"
base64a <- B.readFile fileName1a
let keya = BS.decodeLenient base64a
base64b <- B.readFile fileName1b
let keyb = BS.decodeLenient base64b
let password = B.pack (B.zipWith (xor) ( keya) (keyb))
B.writeFile fileName1 password
putStrLn ""
putStrLn ""
putStrLn "================================================================="
putStrLn "===== N N U U K K EEEE BBB U U L L ====="
putStrLn "===== NN N U U K K E B B U U L L ====="
putStrLn "===== N N N U U KK EEE BBB U U L L ====="
putStrLn "===== N NN U U K K E B B U U L L ====="
putStrLn "===== N N UUUU K K EEEE BBB UUUU LLLL LLLL ====="
putStrLn "================================================================="
putStrLn ""
putStrLn (" Your password has been created in " ++ (show(fileName1)))
putStrLn ""
"info" -> do
putStrLn "stack exec KeyGen-exe [Argument] FileName (Password) without extension"
putStrLn "Arguments:"
putStrLn "lazy - It is a basic Random Numbers Gen :: stack exec KeyGen-exe lazy FileName"
putStrLn "crazy - It is the Paranoid Random Number Gen :: stack exec KeyGen-exe crazy FileName"
putStrLn "xor - Joins the two complementary passwords :: stack exec KeyGen-exe xor FileName"
otherwise ->do
putStrLn "Arguments Is Not Valid"
putStrLn "Used: stack exec KeyGen-exe lazy FileName(Password)"
putStrLn "Used: stack exec KeyGen-exe crazy FileName(Password)"
putStrLn "Used: stack exec KeyGen-exe xor FileName(Password)"
module NukeBull
(generator256
,randomBytes
,randomBytesString
,entrophyBS
,encryptAES256
,decryptAES256
,decryptEntrophy
,noOrder
,passwordRows
,passwordCols,
orderLv3,
orderLv3Inv
) where
import System.Random
import Data.List
import Data.Word
import Data.Bits
import Data.Char
import qualified Data.ByteString as B
import Crypto.Cipher.AES (AES256)
import Crypto.Cipher.Types (BlockCipher(..), Cipher(..),IV, makeIV)
import Crypto.Error (throwCryptoError)
import Crypto.Random(getSystemDRG, randomBytesGenerate)
import Crypto.KDF.Scrypt (generate, Parameters(..))
-- Randon generator, Int List Numbers (0-255)
-- Need Random g for init (g <- getStdGen, g <- newStdGen)
generator256 :: (RandomGen g ) => Int -> g -> [Int]
generator256 n g = take n $ randomRs (0,255) g
-- Gen n random Word8
-- Need Random g for init (g <- getStdGen, g <- newStdGen)
randomBytes :: (RandomGen g) => Int -> g -> [Word8]
randomBytes 0 _ = []
randomBytes n g = map fromIntegral (generator256 n g)
-- Gen Random ByteString n
-- Need Random g for init (g <- getStdGen, g <- newStdGen)
randomBytesString :: (RandomGen g) => Int -> g -> B.ByteString
randomBytesString n g = B.pack $ randomBytes n g
---- Expand text
-- Extend the text for 127 bits
-- Char '217' is the character control
extendW8 :: (RandomGen g ) => Int -> [Word8] -> g -> [Word8]
extendW8 n a g
| n > B.length (B.pack a) = a ++ [217] ++ (B.unpack (B.take (n -1 - B.length (B.pack a)) (randomBytesString n g)))
| n <= B.length (B.pack a) = a
--- extendW8 version Bytetring
extendBS :: (RandomGen g ) => Int -> B.ByteString -> g -> B.ByteString
extendBS n a g = B.pack (extendW8 n (B.unpack a) g)
-- Need Random g for init (g <- getStdGen, g <- newStdGen)
-- Random n xor [(extendW8 n a) xor (Random n)]
entrophyW8 :: (RandomGen g) => Int -> [Word8] -> g -> [Word8]
entrophyW8 n a g = if n > B.length (B.pack a) then
let (g1,g2) = split g
a1 = extendW8 n a g1
a2 = randomBytes n g2
in a2 ++ (zipWith xor a1 a2)
else a
-- entrophyW8 Bytestring version
entrophyBS :: (RandomGen g) => Int -> B.ByteString -> g -> B.ByteString
entrophyBS n a g = B.pack $ entrophyW8 n (B.unpack a ) g
-- entrophyBS decrypt function
decryptEntrophy :: Int -> B.ByteString -> B.ByteString
decryptEntrophy n a =
let a1 = B.unpack $ B.take n a
a2 = B.unpack $ B.drop n a
in B.pack (zipWith xor a1 a2)
-- AES ciPher Lv2
encryptAES256 :: B.ByteString -> IV AES256 -> B.ByteString -> B.ByteString
encryptAES256 key cIV plainData = cbcEncrypt ctx cIV plainData
where ctx :: AES256
ctx = throwCryptoError $ cipherInit key
decryptAES256 :: B.ByteString -> IV AES256 -> B.ByteString -> B.ByteString
decryptAES256 key cIV plainData = cbcDecrypt ctx cIV plainData
where ctx :: AES256
ctx = throwCryptoError $ cipherInit key
-- Coling Parcival's key derivation function
-- Parameters
paramN = 32:: Word64
paramR = 8
paramP = 1
paramKeyLen = 256
--Scrypt KDF - Coling Parcival's key derivation function
deriveKey :: B.ByteString -> B.ByteString -> B.ByteString
deriveKey password salt = generate params password salt
where params = Parameters {n = paramN, r = paramR, p = paramP, outputLength = paramKeyLen}
-- Transform bytes 8bits in two number (0-15) (4 bits numbers)
-- Similary hexadecimal transform
passwordRows :: [Word8] -> [Int]
passwordRows x = map (`div` 16) (map fromIntegral x)
passwordCols :: [Word8] -> [Int]
passwordCols x = map (`mod` 16) (map fromIntegral x)
-- Matrix translations n = Int deplazament , a = (list Word8) 'for 16 element'
moveBytes :: Int -> [Word8] -> [Word8]
moveBytes n [] = []
moveBytes n a = drop n a ++ take n a
-- moveBytes inverse 'for 16 element'
moveInvBytes :: Int-> [Word8] -> [Word8]
moveInvBytes n [] = []
moveInvBytes n a = drop (16-n) a ++ take (16-n) a
-- moveBytes and moveInvBytes Matrix 16*16 version
rotFileBytes :: [Int]-> [[Word8]] -> [[Word8]]
rotFileBytes x y = [ moveBytes (x !! n) (y !! n) | n <- [0..15]]
rotFileInvBytes :: [Int]-> [[Word8]] -> [[Word8]]
rotFileInvBytes x y = [ moveInvBytes (x !! n) (y !! n) | n <- [0..15]]
-- Generate a Matrix 16x16 [[Word8]] with 256 bytes [Word8]
matrixBytes :: [Word8] -> [[Word8]]
matrixBytes [] = []
matrixBytes x = [ take 16 (drop (n*16) x)| n <- [0..15]]
-- Generate a 256 bytes Word8 with Matrix 16x16
matrix :: [[Word8]] -> [Word8]
matrix [] = []
matrix (x:xs) = x ++ matrix xs
-- Transpose matrix
matrixTransBytes = transpose.matrixBytes
-- Moving elements in Matrix 16x16 s1 move files and s2 move colums
noOrder :: [Word8] ->[Int] -> [Int] -> [Word8]
noOrder c s1 s2 = matrix (matrixTransBytes (matrix (rotFileBytes s2 (matrixTransBytes (matrix (rotFileBytes s1 (matrixBytes c)))))))
-- noOrder decrypt
noOrderInv :: [Word8] ->[Int] -> [Int] -> [Word8]
noOrderInv c s1 s2 = matrix (rotFileInvBytes s1 (matrixBytes ( matrix (matrixTransBytes (matrix (rotFileInvBytes s2 (matrixTransBytes c)))))))
-- 16 interactions, interaction number n
noOrderLv3 ::Int -> [Word8] ->[Int] -> [Int] -> B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString
noOrderLv3 n c s1 s2 pass pass2 pass3 pass4 = B.pack ( B.zipWith (xor) (passL3 n pass pass2 pass3 pass4) (B.pack (noOrder c s1 s2)))
-- noOrderLv3 decrypt
-- 16 interactions, interaction number n
noOrderLv3Inv :: Int -> [Word8] ->[Int] -> [Int] -> B.ByteString -> B.ByteString-> B.ByteString -> B.ByteString -> B.ByteString
noOrderLv3Inv n c s1 s2 pass pass2 pass3 pass4 = B.pack (noOrderInv (B.zipWith (xor) (passL3 (17 - n) pass pass2 pass3 pass4) (B.pack c) ) s1 s2)
-- All Interactions (16 = n)
orderLv3 :: Int -> [Word8] ->[Int] -> [Int] -> B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString
orderLv3 1 c s1 s2 pass pass2 pass3 pass4 = noOrderLv3 1 c s1 s2 pass pass2 pass3 pass4
orderLv3 n c s1 s2 pass pass2 pass3 pass4 = noOrderLv3 n (B.unpack(orderLv3 (n-1) c s1 s2 pass pass2 pass3 pass4)) s1 s2 pass pass2 pass3 pass4
-- orderLv3 decrypt
orderLv3Inv :: Int -> [Word8] ->[Int] -> [Int] -> B.ByteString-> B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString
orderLv3Inv 1 c s1 s2 pass pass2 pass3 pass4 = noOrderLv3Inv 1 c s1 s2 pass pass2 pass3 pass4
orderLv3Inv n c s1 s2 pass pass2 pass3 pass4 = noOrderLv3Inv n (B.unpack(orderLv3Inv (n-1) c s1 s2 pass pass2 pass3 pass4)) s1 s2 pass pass2 pass3 pass4
-- Pass 256 Lv 1 for adiction
-- This funtions gen matrix 256 (16*16) bytes for n = 16, With two 16 bytes ByteString keys
passMatrixRow :: Int -> B.ByteString -> B.ByteString
passMatrixRow n a = B.concatMap (B.replicate n) a
passMatrixCols :: Int -> B.ByteString -> B.ByteString
passMatrixCols 1 a = a
passMatrixCols n a = B.pack ( (B.unpack (passMatrixRow (n-1) a)) ++ (B.unpack a))
passMatrix :: Int -> B.ByteString -> B.ByteString -> B.ByteString
passMatrix n a b = B.pack ( B.zipWith (xor) (passMatrixRow n a) (passMatrixCols n b) )
-- Gen n keys of 256 bytes using Scrypt KDF - Coling Parcival's key derivation function
-- In this aplication used 4*16 bytes keys and passMatrix
-- first and second kays gen password 256bytes for Scrypt KDF
-- third y fourth keys gen 16 salt for Scrypt KDF
passL3 :: Int -> B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString -> B.ByteString
passL3 n a b c d = deriveKey (passMatrix 16 a b) (B.pack (take 16 (drop (16*(n-1)) (B.unpack (passMatrix 16 c d) ) ) ) )
\ No newline at end of file
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment