summaryrefslogtreecommitdiff
path: root/ss2017
diff options
context:
space:
mode:
Diffstat (limited to 'ss2017')
-rw-r--r--ss2017/cryptography/Sheet01/Sheet01.hs128
-rw-r--r--ss2017/cryptography/Sheet01/Sheet01.xojbin0 -> 273762 bytes
-rw-r--r--ss2017/cryptography/Sheet01/manifest6
-rw-r--r--ss2017/cryptography/Sheet01/math.pdfbin0 -> 616760 bytes
-rw-r--r--ss2017/cryptography/Sheet01/shell.nix13
-rw-r--r--ss2017/cryptography/Sheet01/substitution.txt (renamed from ss2017/cryptography/substitution.txt)0
-rw-r--r--ss2017/cryptography/Sheet01/vigenere.txt (renamed from ss2017/cryptography/vigenere.txt)0
7 files changed, 147 insertions, 0 deletions
diff --git a/ss2017/cryptography/Sheet01/Sheet01.hs b/ss2017/cryptography/Sheet01/Sheet01.hs
new file mode 100644
index 0000000..80c162d
--- /dev/null
+++ b/ss2017/cryptography/Sheet01/Sheet01.hs
@@ -0,0 +1,128 @@
1{-# LANGUAGE ViewPatterns, BangPatterns, TupleSections #-}
2
3import Data.List
4import Data.Set (Set)
5import qualified Data.Set as Set
6import Data.Map.Strict (Map)
7import qualified Data.Map.Strict as Map
8import Data.Char
9import Data.Maybe
10import Data.Ord
11import Data.Tuple
12import Data.Function
13
14import Data.Monoid
15
16import Debug.Trace
17
18import Control.Monad
19
20type Attack key = [Char] -> (key, String)
21type Distribution = Char -> Rational
22
23isLatin :: Char -> Bool
24isLatin c = 'a' <= c && c <= 'z'
25
26shift, unshift :: Integral n => Char -> n -> Char
27shift c (fromIntegral -> n) = toEnum $ (fromEnum c - fromEnum 'a') + (n `mod` 26)
28unshift c (fromIntegral -> n) = shift c (-n)
29
30shift', unshift' :: Char -> Char -> Char
31shift' c k = shift c $ fromEnum k - fromEnum 'a'
32unshift' c k = shift c $ fromEnum 'a' - fromEnum k
33
34-- shift :: Integral n => Char -> n -> Char
35-- shift c@(fromIntegral . fromEnum -> c') (toInteger -> by)
36-- = toEnum . fromIntegral $ a' + ((c' - a' + by) `mod` 26)
37-- where
38-- a = 'a'
39-- a' = fromIntegral $ fromEnum a
40
41main :: IO ()
42main = do
43 let
44 attack :: Show key => [Char] -> ([Char] -> (key, String)) -> [Char] -> IO ()
45 attack desc attack' cyphertext = do
46 putStrLn $ desc ++ "..."
47 let (k, plaintext) = attack' cyphertext
48 putStrLn $ "Key: " ++ show k
49 putStrLn plaintext
50
51 attack "Substitution" substitution =<< (filter isLatin <$> readFile "substitution.txt")
52 attack "Vigenere" vigenere =<< (filter isLatin <$> readFile "vigenere.txt")
53
54
55vigenere :: Attack [Char]
56vigenere cyphertext = (map key [0 .. keyLength - 1], zipWith unshift' [keyStream i | i <- [0..]] cyphertext)
57 where
58 statistic = multigraphs cyphertext
59 multigraphs' = map (\(k, v) -> (k, diff v)) . take 3 . sortOn (Down . length . snd) . filter (\(k, _) -> length k >= 3) $ Map.toDescList statistic
60 keyLengths = foldr count Map.empty . filter (not . null) . subsequences $ foldr (\(_, v) l -> v ++ l) [] multigraphs'
61 count occs
62 | gcd' == 1 = id
63 | otherwise = Map.alter (Just . succ . fromMaybe 0) gcd'
64 where
65 gcd' = foldl gcd 0 occs
66 keyLength = fst . head . sortOn (Down . snd) $ Map.assocs keyLengths
67 keyStream = key . (`mod` keyLength)
68 key n = fst . caesar $ do
69 i <- [0..(length cyphertext `div` keyLength)]
70 let i' = i * keyLength + n
71 guard $ i' < length cyphertext
72 return $ cyphertext !! i'
73
74caesar :: Attack Char
75caesar cyphertext = (closestKey, map (unshift' closestKey) cyphertext)
76 where
77 possibilities :: [(Char, Rational)]
78 possibilities = [(k, char $ (-) <$> english <*> findDist (map (unshift' k) cyphertext)) | k <- ['a' .. 'z']]
79 -- cDist = findDist cyphertext
80 -- possibilities = [(k, sum $ map (\c -> square $ english c - cDist c) mostCommon) | k <- ['a' .. 'z']]
81 -- mostCommon = take 3 . map fst $ sortOn (Down . snd) [(c, english c) | c <- ['a' .. 'z']]
82 closestKey = undefined -- head . map fst $ sortOn snd possibilities
83
84substitution :: Attack [(Char, Char)]
85substitution cyphertext = (key, map (\c -> fromMaybe ' ' . lookup c $ map swap key) cyphertext)
86 where
87 cDist = invert $ findDist cyphertext
88 english' = invert english
89 keyStream :: Int -> Char
90 keyStream i = (!! i) . map snd $ sortOn fst assoc
91 where
92 assoc = map (\((_, c1), (_, c2)) -> (c1, c2)) $ (zip `on` sortOn fst) english' cDist
93 key = [(toEnum $ fromEnum 'a' + i, keyStream i) | i <- [0..25]]
94
95multigraphs :: Ord a => [a] -> Map [a] [Int]
96multigraphs = multigraphs' Map.empty 0
97 where
98 multigraphs' acc _ [] = acc
99 multigraphs' acc i xs = let
100 inits' = take 3 . filter (not . null) $ inits xs
101 acc' = foldr (Map.alter (Just . (i :) . fromMaybe [])) acc inits'
102 in multigraphs' acc' (succ i) $ tail xs
103
104diff :: Num a => [a] -> [a]
105diff [] = []
106diff xs@(x:_) = tail $ diff' x xs
107 where
108 diff' _ [] = []
109 diff' r (x:xs) = (r - x) : diff' x xs
110
111english :: Distribution
112english = fromMaybe 0 . flip lookup dist
113 where
114 dist = [('a', 8.2 / 100), ('b', 1.5 / 100),('c', 2.8 / 100), ('d', 4.2 / 100), ('e', 12.7 / 100), ('f', 2.2 / 100), ('g', 2 / 100), ('h', 6.1 / 100), ('i', 7 / 100), ('j', 0.1 / 100), ('k', 0.8 / 100), ('l', 4 / 100), ('m', 2.4 / 100), ('n', 6.7 / 100), ('o', 7.5 / 100), ('p', 1.9 / 100),('q', 0.1 / 100), ('r', 6 / 100), ('s', 6.3 / 100), ('t', 9 / 100), ('u', 2.8 / 100), ('v', 1 / 100), ('w', 2.4 / 100), ('x', 2 / 100), ('y', 0.1 / 100), ('z', 0.2 / 100)]
115
116char :: Distribution -> Rational
117char f = sum $ map (square . f) ['a'..'z']
118
119square :: Num n => n -> n
120square = (*) <$> id <*> id
121
122findDist :: [Char] -> Distribution
123findDist text = (/ fromIntegral (length text)) . fromMaybe 0 . flip Map.lookup counts
124 where
125 counts = foldr (Map.alter $ Just . succ . fromMaybe 0) Map.empty text
126
127invert :: Distribution -> [(Rational, Char)]
128invert f = [(f c, c) | c <- ['a' .. 'z']]
diff --git a/ss2017/cryptography/Sheet01/Sheet01.xoj b/ss2017/cryptography/Sheet01/Sheet01.xoj
new file mode 100644
index 0000000..2878bd1
--- /dev/null
+++ b/ss2017/cryptography/Sheet01/Sheet01.xoj
Binary files differ
diff --git a/ss2017/cryptography/Sheet01/manifest b/ss2017/cryptography/Sheet01/manifest
new file mode 100644
index 0000000..6ab37a3
--- /dev/null
+++ b/ss2017/cryptography/Sheet01/manifest
@@ -0,0 +1,6 @@
1substitution.txt
2vigenere.txt
3shell.nix
4math.pdf
5Sheet01.hs
6manifest
diff --git a/ss2017/cryptography/Sheet01/math.pdf b/ss2017/cryptography/Sheet01/math.pdf
new file mode 100644
index 0000000..a85daa7
--- /dev/null
+++ b/ss2017/cryptography/Sheet01/math.pdf
Binary files differ
diff --git a/ss2017/cryptography/Sheet01/shell.nix b/ss2017/cryptography/Sheet01/shell.nix
new file mode 100644
index 0000000..5f84e18
--- /dev/null
+++ b/ss2017/cryptography/Sheet01/shell.nix
@@ -0,0 +1,13 @@
1{ pkgs ? (import <nixpkgs> {})
2}:
3
4pkgs.stdenv.mkDerivation rec {
5 name = "substitution-env";
6 buildInputs = [ (pkgs.haskellPackages.ghcWithPackages (p:
7 with p; [ case-insensitive containers
8 ]))
9 ];
10 shellHook = ''
11 export PROMPT_INFO="${name}"
12 '';
13}
diff --git a/ss2017/cryptography/substitution.txt b/ss2017/cryptography/Sheet01/substitution.txt
index ccd7f58..ccd7f58 100644
--- a/ss2017/cryptography/substitution.txt
+++ b/ss2017/cryptography/Sheet01/substitution.txt
diff --git a/ss2017/cryptography/vigenere.txt b/ss2017/cryptography/Sheet01/vigenere.txt
index 6ffbad3..6ffbad3 100644
--- a/ss2017/cryptography/vigenere.txt
+++ b/ss2017/cryptography/Sheet01/vigenere.txt