Hi. I've developed a bit of an interest in encryption as well as programming in Haskell since I last used this forum. So I decided to build a symmetric block cipher and test its properties to gain more of an understanding of such things. This is for research purposes as they say. I'm not planning to use it with any sensitive data, but I thought it would be interesting to set a little challenge. The code is below together with a description, an example ciphertext and key for demonstration. There is then another ciphertext which contains a Bitcoin address (holding 0.0148 BTC), its private key and some further text. Sorry the prize is so puny but I did say I'm not using sensitive data. So, if anyone is interested in this kind of thing feel free to go for the coin (which will stay there for at least 365 days) and leave any "constructive" comments.
-- Cipher 126 code by Steven Tinsley.
module Main where
import System.IO
import System.Environment
import Data.List
import Data.Bits
import Data.Array.IO
char_set = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789 /!\"£$%^&*()-_=+[]{};:'@#~\\|,.<>.?\n\t`¬¥èéùìòÇØøÅå§ÄÖÑÜ¿öñüà€©®½¾"
dec_bin1 :: Float -> Float -> [Int]
dec_bin1 d_num factor = if (d_num - factor) < 0 then 0 : dec_bin1 d_num (factor / 2)
else if (d_num - factor) == 0 then [1]
else 1 : dec_bin1 (d_num - factor) (factor / 2)
dec_bin0 :: [Int] -> [Int]
dec_bin0 [] = []
dec_bin0 (x:xs) = pad0 (dec_bin1 (fromIntegral x) 32) ++ dec_bin0 xs
pad0 :: [Int] -> [Int]
pad0 xs = take 6 (xs ++ [0, 0, 0, 0, 0, 0])
pad1 :: [Int] -> [Int]
pad1 xs = take 126 (xs ++ [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0])
pad2 :: [Char] -> [Char]
pad2 m =
let l = 21 - mod (length m) 21
p = " "
in
m ++ take l p
verify_key :: [Int] -> Int
verify_key [] = 126
verify_key (x:xs) =
if length (takeWhile (/= x) xs) == length xs then verify_key xs
else x
-- Converts the plaintext to the base 64 integer form used in the block cipher
conv_txt0 :: [Char] -> [Char] -> [Int]
conv_txt0 [] table = []
conv_txt0 (x:xs) table =
if length (takeWhile (/= x) table) < 63 then length (takeWhile (/= x) table) : conv_txt0 xs table
else [63, length (takeWhile (/= x) table) - 63] ++ conv_txt0 xs table
-- Converts the string form of key (2) to the base 126 integer form used in the block cipher
conv_txt1 :: [Char] -> [Char] -> [Int]
conv_txt1 [] table = []
conv_txt1 (x:xs) table =
let i0 = length (takeWhile (/= x) table)
i1 = length (takeWhile (/= xs !! 0) table)
in
if x == '/' then (63 + i1) : conv_txt1 (drop 1 xs) table
else i0 : conv_txt1 xs table
-- Converts the string form of key (1) to the base 64 integer form used in the block cipher
conv_txt2 :: [Char] -> [Char] -> [Int]
conv_txt2 [] table = []
conv_txt2 (x:xs) table = length (takeWhile (/= x) table) : conv_txt2 xs table
-- Converts the plaintext to the base 64 string form used in the stream cipher xor operation
conv_txt3 :: [Char] -> [Char] -> [Char]
conv_txt3 [] table = []
conv_txt3 (x:xs) table =
let i0 = length (takeWhile (/= x) table)
in
if i0 > 63 then ['/', table !! (i0 - 63)] ++ conv_txt3 xs table
else x : conv_txt3 xs table
-- Converts the base 64 string form output by the stream cipher to the base 126 plaintext form
conv_txt4 :: [Char] -> [Char] -> [Char]
conv_txt4 [] table = []
conv_txt4 (x:xs) table = if x == '/' && xs !! 0 == '/' then conv_txt4 (drop 1 xs) table
else if x == '/' then table !! (63 + length (takeWhile (/= xs !! 0) table)) : conv_txt4 (drop 1 xs) table
else x : conv_txt4 xs table
-- Converts the base 64 integer form output by the block cipher to base 64 string form
conv_seq0 :: [Int] -> [Char] -> [Char]
conv_seq0 [] table = []
conv_seq0 (x:xs) table = (table !! x) : conv_seq0 xs table
conv_seq1 :: [Int] -> [Char] -> [Char]
conv_seq1 [] table = []
conv_seq1 (x0:x1:xs) table =
if x0 == 63 then (table !! (63 + x1)) : conv_seq1 xs table
else (table !! x0) : conv_seq1 (x1:xs) table
-- These two functions implement the block cipher logic
sub_char :: [Int] -> [Int] -> [Int]
sub_char [] table = []
sub_char (x:xs) table = (table !! x) : sub_char xs table
swap_bit :: [Int] -> [Int] -> [Int]
swap_bit ptxt [] = []
swap_bit ptxt (x0:x1:x2:x3:x4:x5:xs) = (ptxt !! x0) * 32 + (ptxt !! x1) * 16 + (ptxt !! x2) * 8 + (ptxt !! x3) * 4 + (ptxt !! x4) * 2 + (ptxt !! x5) : swap_bit ptxt xs
conv_txt :: Char -> [Char] -> Int
conv_txt x table = length (takeWhile (/= x) table)
conv_seq :: Int -> [Char] -> Char
conv_seq x table = table !! x
-- These two functions implement the sequence counter used in stream cipher mode
gen_seed1 :: [Int] -> [Int]
gen_seed1 [] = []
gen_seed1 (x0:x1:x2:x3:x4:x5:xs) = (x0 * 32 + x1 * 16 + x2 * 8 + x3 * 4 + x4 * 2 + x5) : gen_seed1 xs
gen_seed0 :: Integer -> Integer -> [Int]
gen_seed0 p 0 = []
gen_seed0 p c = (gen_seed1 (pad1 (dec_bin1 (fromIntegral p) (2 ^ 125)))) ++ gen_seed0 (p + 1) (c - 1)
-- These three functions implement the xor operation used in stream cipher mode
xor2 :: [Int] -> [Int] -> Int
xor2 (x0:x1:x2:x3:x4:x5:xs) (y0:y1:y2:y3:y4:y5:ys) = 32 * (xor x0 y0) + 16 * (xor x1 y1) + 8 * (xor x2 y2) + 4 * (xor x3 y3) + 2 * (xor x4 y4) + (xor x5 y5)
xor1 :: Char -> Char -> Char
xor1 a b = conv_seq (xor2 (pad0 (dec_bin1 (fromIntegral (conv_txt a char_set)::Float) 32)) (pad0 (dec_bin1 (fromIntegral (conv_txt b char_set)::Float) 32))) char_set
xor0 :: [Char] -> [Char] -> [Char]
xor0 [] b = []
xor0 (x:xs) (y:ys) = (xor1 x y) : xor0 xs ys
encrypt1 :: [Int] -> [Int] -> [Int] -> Int -> Int -> [Int]
encrypt1 txt key1 key2 a b =
if a == b then txt
else encrypt1 (swap_bit (dec_bin0 (sub_char txt key1)) key2) key1 key2 a (b + 1)
encrypt0 :: [Int] -> [Int] -> [Int] -> Int -> [Char]
encrypt0 [] key1 key2 n = []
encrypt0 p_txt key1 key2 n =
if length p_txt < 21 then []
else (conv_seq0 (encrypt1 (take 21 p_txt) key1 key2 n 0) char_set) ++ encrypt0 (drop 21 p_txt) key1 key2 n
decrypt1 :: [Int] -> [Int] -> [Int] -> Int -> Int -> [Int]
decrypt1 txt key1 key2 a b =
if a == b then txt
else decrypt1 (sub_char (swap_bit (dec_bin0 txt) key2) key1) key1 key2 a (b + 1)
decrypt0 :: [Int] -> [Int] -> [Int] -> Int -> [Char]
decrypt0 [] key1 key2 n = []
decrypt0 c_txt key1 key2 n =
if length c_txt < 21 then []
else (conv_seq0 (decrypt1 (take 21 c_txt) key1 key2 n 0) char_set) ++ decrypt0 (drop 21 c_txt) key1 key2 n
main :: IO ()
main = do
a <- getArgs
if (a !! 0) == "s_encrypt" then do
h0 <- openFile (a !! 1) ReadMode
hSetEncoding h0 utf8
message <- hGetContents h0
h1 <- openFile (a !! 2) ReadMode
hSetEncoding h1 utf8
key <- hGetContents h1
if verify_key (conv_txt2 (take 64 key) char_set) < 126 then do
putStr "Part 1 of the key is invalid. Duplication: "
print (verify_key (conv_txt2 (take 64 key) char_set))
else if verify_key (conv_txt1 (drop 64 key) char_set) < 126 then do
putStr "Part 2 of the key is invalid. Duplication: "
print (verify_key (conv_txt1 (drop 64 key) char_set))
else do
h2 <- openFile (a !! 3) WriteMode
hSetEncoding h2 utf8
hPutStr h2 (xor0 (pad2 (conv_txt3 message char_set)) (encrypt0 (gen_seed0 0 (fromIntegral (div (length (pad2 (conv_txt3 message char_set))) 21))) (conv_txt2 (take 64 key) char_set) (conv_txt1 (drop 64 key) char_set) (read (a !! 4)::Int)))
hClose h2
hClose h0
hClose h1
else if (a !! 0) == "s_decrypt" then do
h0 <- openFile (a !! 1) ReadMode
hSetEncoding h0 utf8
message <- hGetContents h0
h1 <- openFile (a !! 2) ReadMode
hSetEncoding h1 utf8
key <- hGetContents h1
h2 <- openFile (a !! 3) WriteMode
hSetEncoding h2 utf8
hPutStr h2 (conv_txt4 (xor0 message (encrypt0 (gen_seed0 0 (fromIntegral (div (length message) 21))) (conv_txt2 (take 64 key) char_set) (conv_txt1 (drop 64 key) char_set) (read (a !! 4)::Int))) char_set)
hClose h0
hClose h1
hClose h2
else if (a !! 0) == "b_encrypt" then do
h0 <- openFile (a !! 1) ReadMode
hSetEncoding h0 utf8
message <- hGetContents h0
h1 <- openFile (a !! 2) ReadMode
hSetEncoding h1 utf8
key <- hGetContents h1
if verify_key (conv_txt2 (take 64 key) char_set) < 126 then do
putStr "Part 1 of the key is invalid. Duplication: "
print (verify_key (conv_txt2 (take 64 key) char_set))
else if verify_key (conv_txt1 (drop 64 key) char_set) < 126 then do
putStr "Part 2 of the key is invalid. Duplication: "
print (verify_key (conv_txt1 (drop 64 key) char_set))
else do
h2 <- openFile (a !! 3) WriteMode
hSetEncoding h2 utf8
hPutStr h2 (encrypt0 (conv_txt2 (pad2 (conv_txt3 message char_set)) char_set) (conv_txt2 (take 64 key) char_set) (conv_txt1 (drop 64 key) char_set) (read (a !! 4)::Int))
hClose h2
hClose h0
hClose h1
else if (a !! 0) == "b_decrypt" then do
h0 <- openFile (a !! 1) ReadMode
hSetEncoding h0 utf8
message <- hGetContents h0
h1 <- openFile (a !! 2) ReadMode
hSetEncoding h1 utf8
key0 <- hGetContents h1
h2 <- openFile (a !! 3) WriteMode
block <- newArray (0, 125) 0 :: IO (IOArray Int Int)
key1_ <- mod_key1 (conv_txt2 (take 64 key0) char_set) block 0
key1 <- mod_key0 key1_ [] 0 64
key2_ <- mod_key1 (conv_txt1 (drop 64 key0) char_set) block 0
key2 <- mod_key0 key2_ [] 0 126
hPutStr h2 (conv_txt4 (decrypt0 (conv_txt2 message char_set) key1 key2 (read (a !! 4)::Int)) char_set)
hClose h0
hClose h1
hClose h2
else putStrLn "Feature not implemented."
mod_key1 :: [Int] -> (IOArray Int Int) -> Int -> IO (IOArray Int Int)
mod_key1 [] inv_key c = return inv_key
mod_key1 (x:xs) inv_key c = do
writeArray inv_key x c
mod_key1 xs inv_key (c + 1)
mod_key0 :: (IOArray Int Int) -> [Int] -> Int -> Int -> IO [Int]
mod_key0 block lt c l = do
if c == l then return lt
else do
a <- readArray block c
mod_key0 block (lt ++ [a]) (c + 1) l
Description of the cipher
The algorithm is a symmetric block cipher with a 126 bit block size and approximately 999 bit keys. The current prototype can run in counter mode to produce a stream cipher or electronic code book mode, although due to the known weaknesses in this it is planned this will be replaced with cipher block chaining in the next version. The key is made up of two parts (1) and (2), each of which is converted internally to a sequence of numbers (seq (1) and seq (2)) with complexity of about 296 bits and 703 bits respectively. Key (1) is represented by a 64 character base 64 string within the character set:
ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789 / (reference set)
For example:
KJW3nQCRagYr25po1yxku0tZXbGdhSDOfec7qM496zPsAFHwj/BIUELTlN 8Vivm
Each character in the set can only appear once so there are 64! possible states. Each character is converted to a number from 0 – 63 depending on its position in the reference set. Key (2) is represented by a 189 character base 64 string within the reference set. The following scheme is used to convert key (2) to a sequence of numbers between 0 – 125 internally.
in a string [x0, x1, xs] (Haskell grammar)
if x0 is not '/ ' then return 0 to 62 depending on the position of x0 in the reference set. (case 1)
else return 63 + (0 to 62) depending on the position of x1 in the reference set (case 2). Run the process again starting with x1 in case 1 or the first character in xs in case 2.
As each possible number can only appear once in seq (2) there are 126! possible states. Key (1) and (2) are used in the Sub Character and Swap Bit steps described below, respectively. These steps are performed in the order (Sub Character, Swap Bit) for block encryption and in reverse for block decryption. This sequence can be run an arbitrary number of times set by the user. In the examples shown here 10 rounds are used, which on a 1.6 GHz Intel Celeron CPU yields about 64 k bit / s plaintext processed in counter mode.
Sub Character step
In this step the input block is divided into 21 6 bit values. Each value n is substituted with the nth value in seq (1).
Swap Bit step
In this step the input block is treated as a sequence of 126 bits. The position of the nth bit is changed to the value of the nth entry in seq (2).
Implementation
The prototype is written in Haskell and compiles on GHC in Haskell platform 2013.2.0.0. It accepts as plaintext strings of characters in the set:
ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789 /!\"£$%^&*()-_=+[]{};:'@#~\|,.<>.?\n\t`¬¥èéùìòÇØøÅå§ÄÖÑÜ¿öñüà€©®½¾
It returns a ciphertext within the reference set.
To use
For stream cipher mode encryption in the console run: [program file] s_encrypt [plaintext.txt] [key.txt] [ciphertext.txt] n (n = number of rounds)
For stream cipher mode decryption in the console run: [program file] s_decrypt [ciphertext.txt] [key.txt] [plaintext.txt] n (n = number of rounds)
Example ciphertext: aaDjBC28147bewcgNN9bbp2SVaB33nyEy1LoSDZ8g2ycOFTMoTobRkkMgzH6cX7djCtTxINXUkizph6XhljnyY0XfrgneIk9lNXk3HYGYLx3Bf9lrY4m4mj84w/pA9B4CCB7UGoSAwOODFewdrWskrmyVQxw4Hag1pwJv2vXzwzLqCzjrP7BmDfbN 2JN1o45zwwHXb3Moos1Vre9p0CWHaVL3Zrcw1eJlK9TE08OIDwfTVtrxEfbDqXtYeQsm3BuW7u2NC7lVs bfHxArHMw23w2toL8VJMeKmhpL7FCWr70lOsrGOMWsAC2xV4iKPnwpBvz0JaNVJX5h453u/b7sl18 U53UyVNy6JVpVaoJ SbOzftWbEqQWzxcvOJNXusfd9tyTJCWkmSX3htsSa6a1RWZgfManRw2ZBSA0ImYFBVCLkg2koQAHMcOHNEPsSQ/2isOpWQtYjOKb/ENpRqwiUP/Ha1H2niOVrU3R/r XnziIZYrWcOctoS//nbH4qJYM9HAkTVSwxHe lc1OygG/OYo /kPGqXXyPiv9Y218Ww1Qk1n7zpIlURLVHVIbZ36KMFF5sAH3dt6vb 3iRY8ecdRfIMOeAbkx8qAKrrhy/6TLGOfdUssN72qhGhp2Ym3ctpeyMoD9y oFzUpF LQog2Vj4kkj FKUzTZg2teYrEwU6CzfyX1FBXmTnxZ1x1GWCehLhksJTJxpTUVduW8EagWj8xiqKuf5mLiRIPCf2BhQjx7/FfJu3 BdbKOO/Bez5JsZGs/LGsJMvifib8mzJXWix1VniAoHzjTkQ1 c9QROpQU4N GWXTwQcmGCYtJrtnxyL0cZRZMjc96B93UhJxMUWWDiEsa/pmyyL15ZwKshazJEMUNUMt38FxemOjHYcVZ
Key: E1wXSsWrc25BJ98f7KtCudUmx3gFipYMVZ RyzbToqe6nDhHPON4l/GQAvIjkaL0m/c/N/SMK/W/XZPU/aFa/piYJ/m/ /r/v/1b/P/e3/2eQN/Y/k/4/sfr/nv/AHD/3ckw/g7Ono9/E/L/xyG/qjq/y/tA1g/R/F/O0/V/z/ZE/J/op4/DhC/Mt/jXV/d/B/b/H6/G/8/wW/C/5L2/fz/6R5/Txd/l/Q T/I/0/U8/i/uS/hu/7/KlB/9sI
Challenge ciphertext: GKjXqpq1iz/6OJ81WKNfOdcl5stnZlzI0NA88B/ASzvlB8mfzz66EckirfEvVMV6x30tdrTbe/oEqZdGUL/GCKIphqmW4x27oLtZtPUgVkuV75o WbfTDTYNWlSUmTTqHBhljMawa9a9IrXnpDg3ZKojlrSPPRNam6oyn44fU7oLaZMxJTDqM2BsfODeiGPfAtJw5Tl1onoCcrEyOYJiJnT53NSkFZmDQ52rO54j6UdBfeoBGZLFqurD1taqsHN3FZVZmjIY37ipvYDLlOXazkw44K1wV1j5tk8q9pP3iIP59SSNnK4r9gp09HAR0/ieNyZsKnDQujwZRXXsSlM/kFwEJdFgGsttNj7QJ77l9fuvkO3L3T0aHQfUwLQAtQXByAoc6/ lG/t7be9
Steven