Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- import Control.Monad
- import System.Exit
- import System.IO
- import MyUtils
- import Ciphers.Caesar
- import Ciphers.Vigenere
- import Ciphers.ADFGVX
- import Codebreaking.Cryptanalysis
- import Codebreaking.VigenereCrack
- caesarEncryption = do
- clearAll
- putStrLn ""
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "Enter the shift number:"
- shift <- getLine
- putStrLn "Enter the message:"
- message <- getLine
- let shift_int = (read shift :: Int) --convert input to int
- let ciphertext = caesarShift shift_int message
- clearAll
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "Ciphertext:"
- print (ciphertext)
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "Press any key to return to the main menu."
- input <- getLine
- main
- vigenereEncryption = do
- clearAll
- putStrLn ""
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "Enter the desired keyword:"
- key <- getLine
- putStrLn "Enter the message:"
- message <- getLine
- let ciphertext = vigenereEncrypt key message
- clearAll
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn ("Ciphertext:")
- print (ciphertext)
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "Press any key to return to the main menu."
- input <- getLine
- main
- adfgvxEncryption = do
- clearAll
- putStrLn ""
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "The program will now read the substitution key from my_grid.txt."
- putStrLn "Do you want to change it (y/n)?"
- input1 <- getLine
- when (input1 == "y") (do createSubstitutionKey; putStrLn "Substitution key created.")
- handle <- openFile "my_grid.txt" ReadMode
- substitution_key <- hGetContents handle
- putStrLn "Enter the desired keyword:"
- key <- getLine
- putStrLn "Enter the message:"
- message <- getLine
- let ciphertext = adfgvxEncrypt substitution_key key message
- clearAll
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn ("Ciphertext:")
- print (ciphertext)
- putStrLn "nDon't forget to share the substitution key with the recipient"
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "Press any key to return to the main menu."
- input2 <- getLine
- main
- caesar_decryption = do
- clearAll
- putStrLn ""
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "Enter the shift number:"
- shift <- getLine
- putStrLn "Enter the message:"
- message <- getLine
- let shift_int = (read shift :: Int) --convert input to int
- let plaintext = caesarShift (-shift_int) message
- clearAll
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "Plaintext:"
- print (plaintext)
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "Press any key to return to the main menu."
- input <- getLine
- main
- vigenereDecryption = do
- clearAll
- putStrLn ""
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "Enter the keyword:"
- key <- getLine
- putStrLn "Enter the message:"
- message <- getLine
- let plaintext = vigenereDecrypt key message
- clearAll
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn ("Plaintext:")
- print (plaintext)
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "Press any key to return to the main menu."
- input <- getLine
- main
- adfgvxDecryption = do
- clearAll
- putStrLn ""
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "The program will now read the substitution key from my_grid.txt."
- handle <- openFile "my_grid.txt" ReadMode
- substitution_key <- hGetContents handle
- putStrLn "Enter the keyword:"
- key <- getLine
- putStrLn "Enter the message:"
- message <- getLine
- let plaintext = adfgvxDecrypt substitution_key key message
- clearAll
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn ("Plaintext:")
- print (plaintext)
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "Press any key to return to the main menu."
- input <- getLine
- main
- decryption = do
- clearAll
- putStrLn ""
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "::1 - Caesar's cipher ::"
- putStrLn "::2 - Vigenere's cipher ::"
- putStrLn "::3 - ADFGVX ::"
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "::r - Return e - Exit ::"
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- input <- getLine
- case input of
- "1" -> caesar_decryption
- "2" -> vigenereDecryption
- "3" -> adfgvxDecryption
- "r" -> main
- "e" -> exitSuccess
- otherwise -> do
- putStrLn ""
- putStrLn ("Please enter a valid option")
- encryption
- encryption = do
- clearAll
- putStrLn ""
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "::1 - Caesar's cipher ::"
- putStrLn "::2 - Vigenere's cipher ::"
- putStrLn "::3 - ADFGVX ::"
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "::r - Return e - Exit ::"
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- input <- getLine
- case input of
- "1" -> caesarEncryption
- "2" -> vigenereEncryption
- "3" -> adfgvxEncryption
- "r" -> main
- "e" -> exitSuccess
- otherwise -> do
- putStrLn ""
- putStrLn ("Please enter a valid option")
- encryption
- tools :: String -> String -> IO()
- tools ciphertext guess = forever $ do
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "Ciphertext:"
- print (ciphertext)
- putStrLn ""
- putStrLn "My guess:"
- print (guess)
- putStrLn ""
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "::0 - Display the letter frequency in descending order ::"
- putStrLn "::1 - Break Caesar's cipher ::"
- putStrLn "::2 - Break Vigenere's cipher (Babbage/Kasiski Algorithm) ::"
- putStrLn "::3 - Get repeated substrings ::"
- putStrLn "::4 - Count the occurrences of a substring ::"
- putStrLn "::5 - Count the occurrences of a letter immediately before/after other letters ::"
- putStrLn "::6 - Count the occurrences of a letter immediately before other letters ::"
- putStrLn "::7 - Count the occurrences of a letter immediately after other letters ::"
- putStrLn "::8 - Substitute a letter by another in the ciphertext ::"
- putStrLn "::r - Return ::"
- putStrLn "::e - Exit ::"
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- input <- getLine
- case input of
- "0" -> do
- putStrLn ""
- putStrLn "Letter frequency:"
- print (sortAlphabetCount ciphertext)
- putStrLn ""
- "1" -> do
- putStrLn ""
- print(breakCaesar ciphertext)
- putStrLn ""
- "2" -> do
- putStrLn ""
- putStrLn "For this tool to work it is necessary to find some substrings that have multiple occurrences along the ciphertext."
- crackVigenere ciphertext
- "3" -> do
- putStrLn ""
- putStrLn "Enter the minimum size of the substrings to be searched for:"
- min_size <- getLine
- putStrLn "Enter the maximum size of the substrings to be searched for:"
- max_size <- getLine
- let min_size_int = (read min_size :: Int)
- max_size_int = (read max_size :: Int)
- putStrLn "Repeated substrings:"
- print (repeatedSubs min_size_int max_size_int ciphertext)
- "4" -> do
- putStrLn ""
- putStrLn "Enter the substring:"
- substring <- getLine
- putStrLn "Occurrences:"
- print(countSubstring substring ciphertext)
- putStrLn ""
- "5" -> do
- putStrLn ""
- putStrLn "Enter the letter(between ''):"
- letter <- getLine
- let letter_char = (read letter :: Char)
- putStrLn "Occurrences:"
- print(countAllNeighbours letter_char ciphertext)
- putStrLn ""
- "6" -> do
- putStrLn ""
- putStrLn "Enter the letter(between ''):"
- letter <- getLine
- let letter_char = (read letter :: Char)
- putStrLn "Occurrences:"
- print(countAllBefore letter_char ciphertext)
- putStrLn ""
- "7" -> do
- putStrLn ""
- putStrLn "Enter the letter(between ''):"
- letter <- getLine
- let letter_char = (read letter :: Char)
- putStrLn "Occurrences:"
- print(countAllAfter letter_char ciphertext)
- putStrLn ""
- "8" -> do
- putStrLn ""
- putStrLn "Enter the letter(between '') you wish to substitute:"
- letter1 <- getLine
- let letter1_char = (read letter1 :: Char)
- putStrLn "Enter the letter(beween '') to substitute by:"
- letter2 <- getLine
- let letter2_char = (read letter2 :: Char)
- new_ciphertext = substitute letter1_char letter2_char guess
- putStrLn "New ciphertext:"
- print(new_ciphertext)
- tools ciphertext new_ciphertext
- "r" -> main
- "e" -> exitSuccess
- otherwise -> do
- putStrLn ""
- putStrLn ("Please enter a valid option")
- tools ciphertext guess
- crack = do
- clearAll
- putStrLn ""
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "Enter the message:"
- ciphertext <- getLine
- tools ciphertext ciphertext
- main = forever $ do
- clearAll
- putStrLn ""
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn ":: /$$$$$$ /$$$$$$ /$$$$$$$$ ::"
- putStrLn ":: /$$__ $$ /$$__ $$ |__ $$__/ ::"
- putStrLn "::| $$ __/ /$$ /$$ | $$ __/ /$$ /$$| $$ ::"
- putStrLn "::| $$ |__/|__/| $$ |__/|__/| $$ ::"
- putStrLn "::| $$ | $$ | $$ ::"
- putStrLn "::| $$ $$ /$$ /$$| $$ $$ /$$ /$$| $$ ::"
- putStrLn "::| $$$$$$/|__/|__/| $$$$$$/|__/|__/| $$ ::"
- putStrLn ":: |______/ |______/ |__/ ::"
- putStrLn "::::::::Classic Cryptography Toolbox:::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn ":: ::"
- putStrLn "::What would you like to do? ::"
- putStrLn ":: ::"
- putStrLn "::1 - Encrypt a message ::"
- putStrLn "::2 - Decrypt a message ::"
- putStrLn "::3 - Cryptanalyse an encrypted message ::"
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- putStrLn "::e - Exit ::"
- putStrLn ":::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::"
- input <- getLine
- case input of
- "1" -> encryption
- "2" -> decryption
- "3" -> crack
- "e" -> exitSuccess
- otherwise -> do
- putStrLn ""
- putStrLn ("Please enter a valid option")
- main
- module MyUtils where
- import Data.Char
- import Data.List
- import System.Console.ANSI
- import System.Random
- --lowercase letter to int conversion
- let2int :: Char -> Int
- let2int c = ord c - ord 'a'
- --int to lowercase letter conversion
- int2let :: Int -> Char
- int2let n = chr(ord 'a' + n)
- --converts an entire string an array of ints (each char -> int)
- text2ints :: String -> [Int]
- text2ints xs = map (let2int) xs
- --convrets an array of ints into a string (each int -> char)
- ints2text :: [Int] -> String
- ints2text xs = map (int2let) xs
- --shifts the given lowercase letter n positions
- shift :: Int -> Char -> Char
- shift n c |isLower c = int2let((let2int c + n) `mod` 26)
- |otherwise = c
- --gets the factors of n
- factors :: Int -> [Int]
- factors n = [x |x<-[2..n], n`mod`x == 0]
- --deletes all occurrences of an element within a list
- deleteAll :: Eq a => a -> [a] -> [a]
- deleteAll x s = filter (/=x) s
- --gives a list of all the elements that have multiple occurrences within a list
- equals :: Eq a => [a] -> [a]
- equals [] = []
- equals (x:xs)
- |elem x xs = x : equals (deleteAll x xs)
- |otherwise = equals xs
- --gives a list of all the elements that are common to all the lists within a list of lists
- commonElems :: Eq a => [[a]] -> [a]
- commonElems l = equals [x | y<-l, x<-y, length (filter (elem x) l) == length l]
- --gives a list of all the factors in common to all the integers in a list
- commonFactors :: [Int] -> [Int]
- commonFactors xs
- |length xs == 1 = factors (head (xs))
- |otherwise = commonElems [factors x | x<-xs]
- --gives a list of the indexes of each occurrence of a substring within a string
- matchIndices :: (Eq a, Num b, Enum b) => [a] -> [a] -> [b]
- matchIndices needle = map fst . filter (isPrefixOf needle . snd) . zip [0..] . tails
- --gives a list of the lengths between each consecutive occurrences of a substring within a string
- spaceBetween :: String -> String -> [Int]
- spaceBetween needle = diffs . matchIndices needle -- calculates the difference between each consecutive index
- where diffs xs = zipWith (flip(-)) xs (tail xs)
- --count the space between the first occurrence of a subtring and the next occurrence within a string
- repeatSpacing :: String -> String -> Int
- repeatSpacing substring ciphertext
- |spaceBetween substring ciphertext == [] = 0
- |otherwise = head (spaceBetween (substring) (ciphertext))
- --gives a list of the lengths between the first occurrence of multiple substrings and the next respective occurrence
- multRepeatSpacing :: [String] -> String -> [Int]
- multRepeatSpacing substrings ciphertext = [y | x<-substrings, y<-[repeatSpacing x ciphertext]]
- --gets all chars n chars away from each other
- getSpacedLetters :: Int -> String -> String
- getSpacedLetters n (x:xs)
- |n > length xs = [x]
- |otherwise = x : getSpacedLetters n (drop (n-1) xs)
- --gets all chars "size" chars away from each other starting from the nth position
- getNthSpacedLetters :: Int -> Int -> String -> String
- getNthSpacedLetters size n s
- |n > length s = ""
- |otherwise = getSpacedLetters size (drop (n-1) s)
- --removes all tuples with x as fst
- removeAllTuplesByInt :: Int -> [(a,Int)] -> [(a,Int)]
- removeAllTuplesByInt x [] = []
- removeAllTuplesByInt x list
- |snd (head list) /= x = head list : removeAllTuplesByInt x (tail list)
- |otherwise = removeAllTuplesByInt x (tail list)
- --gets the index of a char in a dictionary of type [(Char,Integer)]
- getDictIndex :: Eq a => a -> [(a,Integer)] -> Integer
- getDictIndex c [key]
- |c == fst key = snd key
- |otherwise = error "no such element"
- getDictIndex c dict
- |c == fst (head dict) = snd (head dict)
- |otherwise = getDictIndex c (tail dict)
- --gives a list of the elements in a list withou repeating them
- delRepeated :: Eq a => [a] -> [a]
- delRepeated [] = []
- delRepeated list = x : delRepeated (deleteAll x (tail list))
- where x = head list
- --clears the terminal and sets the cursor position to 0 0
- clearAll :: IO()
- clearAll = do
- clearScreen
- setCursorPosition 0 0
- --converts something of type a into the corresponding value of type b in a dictionary of the type [(b,a)]
- convertTo :: Eq a => a -> [(b,a)]-> b
- convertTo x [] = error ("int not found in the dict")
- convertTo x dict
- |x == (snd (head dict)) = fst (head dict)
- |otherwise = convertTo x (tail dict)
- convertFrom :: Eq a => a -> [(a,b)] -> b
- convertFrom x [] = error ("not found in the dict")
- convertFrom x dict
- |x == (fst (head dict)) = snd (head dict)
- |otherwise = convertFrom x (tail dict)
- --converts an entire list into the corresponding dictionary values
- toDictValue :: Eq a => [a] -> [(b,a)] -> [b]
- toDictValue ns dict = map (x -> convertTo x dict) ns
- --generates a list of different random integers from n1 to n2 of size n2
- genRandNrs :: Integer -> Integer -> IO([Integer])
- genRandNrs n1 n2 = do
- g <- newStdGen
- return (take (fromIntegral n2) (nub (randomRs (n1,n2) g :: [Integer])))
- --groups the given list in a list of lists in, n by n
- groupN:: Int -> [a] -> [[a]]
- groupN 0 _ = []
- groupN size [] = []
- groupN size s = (take (size) s) : groupN size (drop size s)
- module Codebreaking.Cryptanalysis where
- import Data.Char
- import Data.List
- import Data.Function
- import MyUtils
- alphabet = "abcdefghijklmnopqrstuvwxyz"
- --most to least frequent letters in english with respective index
- etaoin = zip "etaoinshrdlcumwfgypbvkjxqz" [1..]
- en_letter_most_freq = "etaoin" --most frequent english letters
- en_letter_least_freq = "vkjxqz" --least frequent english letters
- --counts the number of ocurrences of a char in a string
- count :: Char -> String -> Int
- count a [x]
- |a == x = 1
- |otherwise = 0
- count a (x:xs)
- |a == x = 1 + count a xs
- |otherwise = count a xs
- --counts the numbers of ocurrences of a string in another string
- countSubstring :: String -> String -> Int
- countSubstring s1 s2
- |length s1 > length s2 = 0
- |take (length s1) s2 == s1 = 1 + countSubstring s1 (drop 1 s2)
- |otherwise = countSubstring s1 (drop 1 s2)
- --given a number m and a string, finds all the substrings with size n that have multiple occurrences on the given string
- repeatedSubsBySize :: Int -> String -> [String]
- repeatedSubsBySize n [] = []
- repeatedSubsBySize n s
- |countSubstring (take n s) s > 1 = (take n s) : repeatedSubsBySize n (drop 1 s)
- |otherwise = repeatedSubsBySize n (drop 1 s)
- --finds all the substrings with sizes between n1 and n2 that have multiple occurrences on the given string
- repeatedSubs :: Int -> Int -> String -> [String]
- repeatedSubs n1 n2 [] = []
- repeatedSubs n1 n2 s = [sub | n<-[n1..n2], sub<-repeatedSubsBySize n s]
- --counts the number of ocurrences of each letter of the alphabet in a string
- countAlphabet :: String -> [(Char, Int)]
- countAlphabet s = [(letter,occurs) | letter<-alphabet, occurs<-[count letter s]]
- --outputs the result of count alphabet from the most frequent letter to the least
- sortAlphabetCount :: String -> [(Char, Int)]
- sortAlphabetCount s = reverse (sortOn (snd) (countAlphabet s))
- --substitutes all occurrences of c1 by c2 on the given string
- substitute :: Char -> Char -> String -> String
- substitute c1 c2 [] = []
- substitute c1 c2 (x:xs)
- |c1 == x = toUpper c2 : substitute c1 c2 xs
- |otherwise = x : substitute c1 c2 xs
- --counts the occurrences of c1 immediately before c2
- countBefore :: Char -> Char -> String -> Int
- countBefore c1 c2 [x] = 0
- countBefore c1 c2 (x:xs)
- |head xs == c2 && x == c1 = 1 + countBefore c1 c2 xs
- |otherwise = 0 + countBefore c1 c2 xs
- --counts the occurrences of c1 immediately after c2
- countAfter :: Char -> Char -> String -> Int
- countAfter c1 c2 [x] = 0
- countAfter c1 c2 (x:xs)
- |x == c2 && head xs == c1 = 1 + countAfter c1 c2 xs
- |otherwise = 0 + countAfter c1 c2 xs
- -- counts the ocurrences of c1 immediately before or after c2
- countNeighbours :: Char -> Char -> String -> Int
- countNeighbours c1 c2 s = (countBefore c1 c2 s) + (countAfter c1 c2 s)
- --counts the occurrences of c immediately before or after every letter of the alphabet
- countAllNeighbours :: Char -> String -> [(Char, Int)]
- countAllNeighbours c s = [(letter, occurs) | letter<-alphabet, occurs<-[countNeighbours c letter s]]
- --counts the occurrences of c immediately before every letter of the alphabet
- countAllBefore :: Char -> String -> [(Char, Int)]
- countAllBefore c s = [(letter, occurs) | letter<-alphabet, occurs<-[countBefore c letter s]]
- --counts the occurrences of c immediately after every letter of the alphabet
- countAllAfter :: Char -> String -> [(Char, Int)]
- countAllAfter c s = [(letter, occurs) | letter<-alphabet, occurs<-[countAfter c letter s]]
- --attributes a letter frequency score to the first 6 letters in a string
- matchFreqScoreFirst :: String -> Int
- matchFreqScoreFirst [] = 0
- matchFreqScoreFirst s
- |elem (head sorted_first) en_letter_most_freq = 1 + matchFreqScoreFirst (drop 1 sorted_first)
- |otherwise = 0 + matchFreqScoreFirst (drop 1 sorted_first)
- where sorted_first = take 6 s
- --attributes a letter frequency score to the last 6 letters in a string
- matchFreqScoreLast :: String -> Int
- matchFreqScoreLast [] = 0
- matchFreqScoreLast s
- |elem (head sorted_last) en_letter_least_freq = 1 + matchFreqScoreLast (drop 1 sorted_last)
- |otherwise = 0 + matchFreqScoreLast (drop 1 sorted_last)
- where sorted_last = take 6 (reverse s)
- --sorts the strings in the tuple in reverse ETAOIN order
- reverseEtaoinSortFreqs :: [(Int, String)] -> [(Int, String)]
- reverseEtaoinSortFreqs [] = []
- reverseEtaoinSortFreqs [x]
- |length (snd x) > 1 = [(fst x, reverseEtaoinSort (snd x))]
- |otherwise = [x]
- reverseEtaoinSortFreqs (x:xs)
- |length (snd x) > 1 = (fst x, reverseEtaoinSort (snd x)) : reverseEtaoinSortFreqs xs
- |otherwise = x : reverseEtaoinSortFreqs xs
- --gives a list of frequencies and the respective group of letters
- sortFreqToLetters :: String -> [(Int, String)]
- sortFreqToLetters s = reverseEtaoinSortFreqs [(snd (head gr), map fst gr) | gr <- groupBy ((==) `on` snd) (sorted_freqs)]
- where
- sorted_freqs = (sortAlphabetCount s)
- --inserts a letter in a "reverse_etaoin" ordered string keeping its order
- reverseEtaoinInsert :: Char -> String -> String
- reverseEtaoinInsert c [] = [c]
- reverseEtaoinInsert c (x:xs)
- |(getDictIndex c etaoin) > (getDictIndex x etaoin) = c : x : xs
- |otherwise = x : reverseEtaoinInsert c xs
- --sorts a string in reverse ETAOIN order
- reverseEtaoinSort :: String -> String
- reverseEtaoinSort [] = []
- reverseEtaoinSort (x:xs) = reverseEtaoinInsert x (reverseEtaoinSort xs)
- --gives the 2 highest ints in lust of (Char,Int)
- getHighestFreqScores :: [(Char,Int)] -> [Int]
- getHighestFreqScores scores = [maximum (map (snd) scores),maximum (map (snd) rest)]
- where rest = removeAllTuplesByInt (maximum (map (snd) scores)) scores
- --outputs the letters corresponding to the given highest freq scores
- getHighestLetters :: [Int] -> [(Char,Int)] -> String
- getHighestLetters highest_scores [] = []
- getHighestLetters highest_scores scores
- |elem (snd (head scores)) highest_scores = fst (head scores) : getHighestLetters highest_scores (tail scores)
- |otherwise = getHighestLetters highest_scores (tail scores)
- --given a reverse_etaoin sorted string, attributes a frequency match score
- matchFreqScore :: String -> Int
- matchFreqScore s = matchFreqScoreFirst s + matchFreqScoreLast s
- --gets the reverse etaoin sorted string of a string
- sortedEtaoinString :: String -> String
- sortedEtaoinString x = concat (map (snd) (init (sortFreqToLetters x)))
- module Ciphers.Caesar where
- import MyUtils
- import Data.Char
- --encrypts(n) or decrypts(-n)
- caesarShift :: Int -> String -> String
- caesarShift n xs = [shift n x | x <- map (toLower) xs]
- --given a string, shifts it 26 times and generates a list with all of the shifted strings
- --one of the elements might mean something
- breakCaesar :: String -> [String]
- breakCaesar xs = [s | n<-[(0)..(25)], s<- [caesarShift (-n) (map (toLower) xs)]]
- module Ciphers.Vigenere where
- import MyUtils
- import Data.Char
- --encrypts the plaintext with the given key
- vigenereEncrypt :: String -> String -> String
- vigenereEncrypt key plaintext = ints2text result
- where result = map (`mod` 26) (zipWith (+) keyCycle intPlainText)
- keyCycle = (cycle(text2ints key))
- intPlainText = text2ints (map (toLower) (filter (isAlphaNum) plaintext))
- --decrypts the ciphertext with the given key
- vigenereDecrypt :: String -> String -> String
- vigenereDecrypt key ciphertext = ints2text result
- where result = map (`mod` 26) (zipWith (-) intciphertext keyCycle)
- keyCycle = (cycle(text2ints key))
- intciphertext = text2ints (map (toLower)(filter (isAlphaNum) ciphertext))
- module Ciphers.ADFGVX where
- import Control.Monad
- import System.Directory
- import Data.List
- import Data.Char
- import Data.Maybe
- import MyUtils
- grid = sequence ["adfgvx","adfgvx"]
- alpha_nums = zip ['a'..'z'] [1..] ++ zip ['0'..'9'] [27..]
- --creates a file with a random substitution key
- createSubstitutionKey :: IO()
- createSubstitutionKey = do
- let filename = "my_grid.txt"
- fileExists <- doesFileExist (filename)
- when fileExists (removeFile filename)
- rands <- genRandNrs 1 36--random list of alpha_nums indexes
- writeFile filename (toDictValue rands alpha_nums)
- --fills the ADFGVX grid with the given string
- fillGrid :: String -> [(String,Char)]
- fillGrid s = zip grid s
- --substitutes all chars in a string for their respecive value in the ADFGVX grid
- substitutionStep :: String -> [(String,Char)] -> String
- substitutionStep plaintext filled_grid = concat (toDictValue plaintext filled_grid)
- --attributes each letter in the ciphertext to each letter of the key in a cyclic fashion
- --if the the ciphertext leaves blank spaces on the gird, fills it with encrypted 'a's
- createKeyGrid :: String -> String -> [(Char,Char)]
- createKeyGrid key ciphertext = zip (cycle key) fit_ciphertext
- where fit_ciphertext = if length (ciphertext) `mod` length (key) == 0 then ciphertext else ciphertext ++ replicate (rest) 'a'
- rest = length key - length (ciphertext) `mod` length (key)
- --sorts the key grid columns in alphabetical order
- sortKeyGrid :: String -> [(Char,Char)] -> [(Char,Char)]
- sortKeyGrid key [] = []
- sortKeyGrid key keygrid = sortOn (fst) (take (length key) keygrid) ++ (sortKeyGrid key (drop (length key) keygrid))
- --ouputs the key grid with the columns as lines
- groupByCols :: Eq a => [(a,b)] -> [(a,b)]
- groupByCols [] = []
- groupByCols [x] = [x]
- groupByCols (x:xs) = [x] ++ (filter (t -> fst(t) == fst(x)) xs) ++ groupByCols (filter (t2 -> fst(t2) /= fst(x)) xs)
- --gives the elements of the key grid as a string
- transpositionStep :: String -> [(Char,Char)] -> String
- transpositionStep key keygrid = map (snd) (groupByCols sorted_keygrid)
- where sorted_keygrid = sortKeyGrid key keygrid
- --given a key, sorts the key and fills the grid the same way it was on the encryption process
- recreateKeyGrid :: String -> String -> [(Char,String)]
- recreateKeyGrid key ciphertext = zip (sorted_key) (groupN nrows ciphertext)
- where nrows = cipher_text_size `div` key_size
- sorted_key = sort key
- cipher_text_size = length ciphertext
- key_size = length key
- --sorts the columns of the grid by the order of the password
- unSortKeyGrid :: String -> [(Char,String)] -> [(Char,String)]
- unSortKeyGrid key [] = []
- unSortKeyGrid key keygrid = found : unSortKeyGrid (drop 1 key) (delete found keygrid)
- where found = fromJust (find (x -> fst(x) == head key) keygrid)
- --get the untransposed text from the unsorted grid
- getPreCipherText :: [(Char,String)] -> [String]
- getPreCipherText keygrid = groupN 2 [s | n<-[1..nrows], s<-getNthSpacedLetters (nrows) n gridstring]--(map (head) (map (snd) keygrid)) ++ getPreCipherText (map (tail) (map (snd) keygrid))
- where gridstring = concat (map (snd) keygrid)
- nrows = length (snd (head keygrid))
- --converts the untransposed text into plaintext
- getPlainText :: [String] -> [(String,Char)] -> String
- getPlainText preciphertext adfgvxgrid = map (x -> convertFrom x adfgvxgrid) preciphertext
- --encryption algorithm
- adfgvxEncrypt :: String -> String -> String -> String
- adfgvxEncrypt substitution_key key plaintext = transpositionStep key keygrid
- where keygrid = createKeyGrid key ciphertext1
- ciphertext1 = substitutionStep (filter (isAlphaNum) (map (toLower) plaintext)) my_grid
- my_grid = fillGrid substitution_key
- --decryption algorithm
- adfgvxDecrypt :: String -> String -> String -> String
- adfgvxDecrypt substitution_key key ciphertext = getPlainText preciphertext my_grid
- where my_grid = fillGrid substitution_key
- preciphertext = getPreCipherText (unSortKeyGrid key keygrid)
- keygrid = recreateKeyGrid key ciphertext
- module Codebreaking.VigenereCrack where
- import Ciphers.Caesar
- import Ciphers.Vigenere
- import Codebreaking.Cryptanalysis
- import MyUtils
- import Control.Monad
- import System.Exit
- import System.Console.ANSI
- import Control.Concurrent
- import Data.Function
- --given two numbers representing the min and max size of the substrings that may repeat along the ciphertext and the ciphertext gives a list of all the possible lengths of the vigenere key
- guessKeyLength :: Int -> Int -> String -> [Int]
- guessKeyLength n1 n2 ciphertext = commonFactors (multRepeatSpacing (repeatedSubs n1 n2 ciphertext) ciphertext)
- --given a list of possible keysizes and the ciphertext, splits the ciphertext into subkey parts for each possible keysize
- groupBySubkeys :: [Int] -> String -> [(Int,String)]
- groupBySubkeys sizes ciphertext = [(keysize,x) | keysize<-sizes, n<-[1..keysize], x<-[getNthSpacedLetters keysize n ciphertext]]
- --attributes a frequency score to each caesar shift of the string
- subkeyScores :: String -> [(Char,Int)]
- subkeyScores s = zip alphabet [matchFreqScore shifted | shifted <- map (sortedEtaoinString) (breakCaesar s)]
- --filters the most likely subkeys out of the string
- filterSubkey :: (Int,String) -> (Int,String)
- filterSubkey subkey_group = (keysize, candidates)
- where keysize = fst subkey_group
- string = snd subkey_group
- candidates = getHighestLetters (getHighestFreqScores (subkeyScores (string))) (subkeyScores (string))
- --outputs the possible subkeys for each position of each possible key size
- possibleSubkeys :: [(Int,String)] -> [(Int,String)]
- possibleSubkeys subkey_groups = map (filterSubkey) subkey_groups
- --given a keysize, ouputs the components of the key
- getKeysizeGroup :: Int -> [(Int,String)] -> [(Int,String)]
- getKeysizeGroup x group = filter (i -> fst i == x) group
- --given a list of possible subkeys and the respective keysize, gives a list of all the keys for all the possible keysizes
- possibleKeys :: [(Int,String)] -> [String]
- possibleKeys subkeys = [ key | keysize <- keysizes, key<-keys keysize]
- where keysizes = delRepeated (map (fst) subkeys)
- keys x = sequence (map (snd) (getKeysizeGroup x subkeys))
- --tries all the keys
- bruteForceKeys :: [String] -> String -> IO()
- bruteForceKeys [] ciphertext = putStrLn "nDone"
- bruteForceKeys keys ciphertext = do
- let key = head keys
- putStrLn ""
- putStrLn ("Attempting with key: " ++ key ++ " :")
- threadDelay 500000
- print(vigenereDecrypt key ciphertext)
- bruteForceKeys (drop 1 keys) ciphertext
- --kasiski Algorithm
- --user interaction
- crackVigenere :: String -> IO()
- crackVigenere ciphertext = do
- putStrLn "Enter min size of repeated words:"
- readMin <- getLine
- putStrLn "Enter max size of repeated words:"
- readMax <- getLine
- let minsize = (read readMin :: Int)
- maxsize = (read readMax :: Int)
- let key_lengths = guessKeyLength minsize maxsize ciphertext
- --putStrLn "Possible key lengths:"
- clearAll
- putStrLn "Possible keys:"
- putStrLn "Calculating possible key lengths..."
- --print (key_lengths)
- let subkey_groups = groupBySubkeys key_lengths ciphertext
- --putStrLn "Subkey groups for each possible key size:"
- --print (subkey_groups)
- let subkeys = possibleSubkeys subkey_groups
- --putStrLn "Possible subkeys:"
- --print (subkeys)
- let keys = possibleKeys subkeys
- print (keys)
- forever $ do
- putStrLn "1 - Try a key"
- putStrLn "2 - Brute-force attack"
- putStrLn "r - Retry"
- putStrLn "e - Exit"
- input <- getLine
- case input of
- "1" -> do
- key <- getLine
- let plaintext = vigenereDecrypt key ciphertext
- print (plaintext)
- "2" -> bruteForceKeys keys ciphertext
- "r" -> crackVigenere ciphertext
- "e" -> exitSuccess
- otherwise -> do
- putStrLn "Please enter a valid option."
- exitFailure
- ```
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement