Voici le squlette d'un module servant à étudier les chiffrements par blocs étudiés en cours : ECB, CBC, CFB, César, chiffrement affine. Il ne reste plus qu'à l'étudier et le compléter...
Haskell
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} module CryptoSysteme where import Data.Char (ord,chr) import Data.List (sort, dropWhileEnd) ----------------------------------------------------------------- -- Classe de types pour manipuler des cryptosystèmes par Blocs ----------------------------------------------------------------- data Bit = O | I deriving (Show, Eq, Ord, Enum) b_plus :: Bit -> Bit -> Bit ... b_fois :: Bit -> Bit -> Bit ... bitToInteger :: Bit -> Integer ... instance Num Bit where (+) = ... (*) = ... negate x = x fromInteger 0 = O fromInteger 1 = I fromInteger k = fromInteger (k `mod` 2) abs x = x signum _ = 1 -- Blocs de bits de longueur fixée par le cryptosystème type Bloc = [Bit] class Cryptosys cle where longBloc :: cle -> Int encryptBloc :: cle -> Bloc -> Bloc decryptBloc :: cle -> Bloc -> Bloc decoupeEnBlocs :: Int -> [Bit] -> [Bloc] decoupeEnBlocs _ [] = [] decoupeEnBlocs n xs | (length xs) < n = [xs ++ [O | _ <- [1 .. n - (length xs)]]] | otherwise = paquet : (decoupeEnBlocs n paquets) where (paquet,paquets) = splitAt n xs enleveEspacesFin :: String -> String enleveEspacesFin = dropWhileEnd (== ' ') blocsToString :: [Bloc] -> String blocsToString bs = enleveEspacesFin $ map (chr'.toDec) (decoupeEnBlocs 7 (concat bs)) stringToBlocs :: (Cryptosys cle) => cle -> String -> [Bloc] stringToBlocs key cs = decoupeEnBlocs (longBloc key) $ concat $ map (toBin.ord') cs encryptStr :: (Cryptosys cle) => cle -> String -> String encryptStr kle cs = blocsToString $ map (encryptBloc kle) (stringToBlocs kle cs) decryptStr :: (Cryptosys cle) => cle -> String -> String ... messageTest :: String messageTest = map chr' [0..127] testCrypto :: (Cryptosys cle) => cle -> Bool testCrypto key = decryptStr key (encryptStr key messageTest) == messageTest ------------------------------------------------------------------ -- Code César : cryptosystème par blocs de 7 bits ------------------------------------------------------------------ type Cesar = Integer decaleCesar :: Cesar -> Bloc -> Bloc ... instance Cryptosys Cesar where ... ... ... cleCesar :: Cesar cleCesar = 3 -------------------------------------------------------------------- -- Code Affine : cryptosystème par blocs de 7 bits -------------------------------------------------------------------- -- une clé affine est la donnée de deux entiers type Affine = (Integer,Integer) -- crypte = a * clair + b decaleAffine :: Affine -> Bloc -> Bloc ... -- algo d'euclide étendu : retourne [u,v,pgcd a n] euclide :: Integer -> Integer -> [Integer] euclide a n = ... -- calcule de l'inverse de a modulo n invMod :: Integer -> Integer -> Integer invMod a n = ... -- clair = (crypte - b) * a^(-1) recaleAffine :: Affine -> Bloc -> Bloc recaleAffine cle c = ... instance Cryptosys Affine where ... ... ... cleAff :: Affine cleAff = (17,22) ------------------------------------------------------------------------ -- ECB : cryptosystème par blocs de taille variable ------------------------------------------------------------------------ -- une permutation sur [0,n] est donnée par les images de [0,n] type Permut = [Int] -- ECB est défini par la donnée d'une permutation type ECB = Permut -- Permutation d'un bloc de bits permutBloc :: Permut -> Bloc -> Bloc permutBloc perm bs = [... | ...] -- Renvoie la réciproque d'une permutation invPermut :: Permut -> Permut invPermut perm = map snd $ sort $ zip perm [0 .. (length perm - 1)] instance Cryptosys ECB where ... ... ... cleEcb :: ECB cleEcb = [2,0,3,1,5,4,6] cleEcb' :: ECB cleEcb' = [2,0,3,1] ------------------------------------------------------------------------ -- CBC : cryptosystème par blocs chaînés de taille variable ------------------------------------------------------------------------ ... ------------------------------------------------------------------------ -- CFB : cryptosystème par blocs chaînés avec registre de décalage ------------------------------------------------------------------------ ... ------------------------------------------------------------------- -- Français sous 7 bits -- On écrase les touches d'action avec les lettres accentuées ------------------------------------------------------------------- -- Réécrit un bloc de n bits en un bloc de 7 bits en rajoutant d'éventuels O à gauche -- Un bloc de longueur supérieur à 7 est tronqué septBits :: Bloc -> Bloc ... -- convertit un entier modulo 128 en un bloc de 7 bits toBin :: Integer -> Bloc ... -- convertir un bloc de 7 bits en un entier toDec :: Bloc -> Integer ... -- remape la table ASCII pour avoir des caractères dans [0,127] et l'espace vaut 0 chr' :: Integer -> Char chr' 0 = ' ' chr' 32 = 'à' chr' 1 = 'â' chr' 2 = 'é' chr' 3 = 'è' chr' 4 = 'ê' chr' 5 = 'ë' chr' 6 = 'î' chr' 7 = 'ï' chr' 8 = 'ô' chr' 9 = 'ö' chr' 10 = 'ù' chr' 11 = 'û' chr' 12 = 'ü' chr' 13 = 'ç' chr' 14 = 'æ' chr' 15 = 'œ' chr' 16 = 'À' chr' 17 = 'Â' chr' 18 = 'É' chr' 19 = 'È' chr' 20 = 'Ê' chr' 21 = 'Ë' chr' 22 = 'Î' chr' 23 = 'Ï' chr' 24 = 'Ô' chr' 25 = 'Ö' chr' 26 = 'Ù' chr' 27 = 'Û' chr' 28 = 'Ü' chr' 29 = 'Ç' chr' 30 = 'Æ' chr' 31 = 'Œ' chr' 127 = '€' chr' x = chr (fromInteger x) ord' :: Char -> Integer ord' 'à' = 32 ord' ' ' = 0 ord' 'â' = 1 ord' 'é' = 2 ord' 'è' = 3 ord' 'ê' = 4 ord' 'ë' = 5 ord' 'î' = 6 ord' 'ï' = 7 ord' 'ô' = 8 ord' 'ö' = 9 ord' 'ù' = 10 ord' 'û' = 11 ord' 'ü' = 12 ord' 'ç' = 13 ord' 'æ' = 14 ord' 'œ' = 15 ord' 'À' = 16 ord' 'Â' = 17 ord' 'É' = 18 ord' 'È' = 19 ord' 'Ê' = 20 ord' 'Ë' = 21 ord' 'Î' = 22 ord' 'Ï' = 23 ord' 'Ô' = 24 ord' 'Ö' = 25 ord' 'Ù' = 26 ord' 'Û' = 27 ord' 'Ü' = 28 ord' 'Ç' = 29 ord' 'Æ' = 30 ord' 'Œ' = 31 ord' '€' = 127 ord' x = fromIntegral (ord x)
Par exemple:
Haskell
λ> O + I I λ> toBin 13 [O,O,O,I,I,O,I] λ> toDec [I,O,I] 5 λ> septBits [I,O,I] [O,O,O,O,I,O,I] λ> stringToBlocs cleCesar "ab" [[I,I,O,O,O,O,I],[I,I,O,O,O,I,O]] λ> stringToBlocs cleAff "ab" [[I,I,O,O,O,O,I],[I,I,O,O,O,I,O]] λ> stringToBlocs cleEcb' "ab" [[I,I,O,O],[O,O,I,I],[I,O,O,O],[I,O,O,O]] λ> encryptStr cleCesar "Toute la Gaule est envahie ! Toute ? Toute !" "Wrxwh\232od\232Jdxoh\232hvw\232hqydklh\232$\232Wrxwh\232B\232Wrxwh\232$" λ> putStrLn $ encryptStr cleCesar "Toute la Gaule est envahie ! Toute ? Toute !" WrxwhèodèJdxohèhvwèhqydklhè$èWrxwhèBèWrxwhè$ λ> putStrLn $ encryptStr cleAff "Toute la Gaule est envahie ! Toute ? Toute !" *u[JKÎBïÎMï[BKÎK9JÎKdlï~œKÎGÎ*u[JKÎEÎ*u[JKÎG λ> putStrLn $ encryptStr cleEcb "Toute la Gaule est envahie ! Toute ? Toute !" b?kj+ :) ')k:+ +mj +>n)89+ ö b?kj+ _ b?kj+ ö λ> putStrLn $ encryptStr cleEcb' "Toute la Gaule est envahie ! Toute ? Toute !" c;yq.éSÉâûas;Ô!Èm\âÈ;_AT=Ô!éâæWskÔ!/âæWskÔ!é λ> putStrLn $ encryptStr cleCesar "aaaaaaaabbbbbbbb" ddddddddeeeeeeee λ> putStrLn $ encryptStr cleAff "aaaaaaaabbbbbbbb" ïïïïïïïïÔÔÔÔÔÔÔÔ λ> putStrLn $ encryptStr cleEcb "aaaaaaaabbbbbbbb" )))))))),,,,,,,, λ> putStrLn $ encryptStr cleEcb' "aaaaaaaabbbbbbbb" -ÉaR-ÉaR)SEÔ)SEÔ