Actualización del Archivo DES

[lolimarq]

Hola a todos una chica me apoyo y logro incorporar la función que me
habían recomendado al código y la función funciona para encriptar
alfanumericos pero ella no supo hacer la inversa para completarlo

aqui se los envio

_________

{-# LANGUAGE FlexibleInstances #-}

import Data.Word
import Data.Bits

type Rotacion = Int
type Llave = Word64
type Mensaje = Word64
type Enc = Word64

type BitsX = [Bool]
type Bits4 = [Bool]
type Bits6 = [Bool]
type Bits32 = [Bool]
type Bits48 = [Bool]
type Bits56 = [Bool]
type Bits64 = [Bool]

instance Num [Bool]

instance Bits [Bool] where
a `xor` b = (zipWith (\x y -> (not x && y) || (x && not y)) a b)
rotate bits rot = drop rot' bits ++ take rot' bits
where rot' = rot `mod` (length bits)

-- | Encriptación Des básica tomando una Llave, un bloque de texto
plano y lo transforma en un texto encriptada de acuerdo al estándar.

encriptar :: Word64 -> Word64 -> Word64
encriptar = flip encrip_des

-- | Caso contrario. Dada una Llave y un texto encriptado se realiza
la conversión del Mensaje.
desencriptar :: Word64 -> Word64 -> Word64
desencriptar = flip desencrip_des



bitify :: Word64 -> Bits64
bitify w = map (\b -> w .&. (shiftL 1 b) /= 0) [63,62..0]

unbitify :: Bits64 -> Word64
unbitify bs = foldl (\i b -> if b then 1 + shiftL i 1 else shiftL i 1)
0 bs

-- | Realizar la siguiente permutación en la clave de 64 bits
-- |reduciéndose la misma a 56 bits (El bit 1, el más
-- |significativo, de la clave transformada es el bit 57 de la
-- |clave original, el bit 2 pasa a ser el bit 49, etc.).
permutacion_inicial :: Bits64 -> Bits64
permutacion_inicial mb = map ((!!) mb) i
where i = [57, 49, 41, 33, 25, 17, 9, 1, 59, 51, 43, 35, 27, 19, 11,
3,
61, 53, 45, 37, 29, 21, 13, 5, 63, 55, 47, 39, 31, 23, 15,
7,
56, 48, 40, 32, 24, 16, 8, 0, 58, 50, 42, 34, 26, 18, 10,
2,
60, 52, 44, 36, 28, 20, 12, 4, 62, 54, 46, 38, 30, 22, 14,
6]
-- los bit que se le quitan (8)son de paridad
transformar_Llave :: Bits64 -> Bits56
transformar_Llave kb = map ((!!) kb) i
where i = [56, 48, 40, 32, 24, 16, 8, 0, 57, 49, 41, 33, 25, 17,
9, 1, 58, 50, 42, 34, 26, 18, 10, 2, 59, 51, 43, 35,
62, 54, 46, 38, 30, 22, 14, 6, 61, 53, 45, 37, 29, 21,
13, 5, 60, 52, 44, 36, 28, 20, 12, 4, 27, 19, 11, 3]

encrip_des :: Mensaje -> Llave -> Enc
encrip_des = hacer_encrip_des
[1,2,4,6,8,10,12,14,15,17,19,21,23,25,27,28]

desencrip_des :: Mensaje -> Llave -> Enc
desencrip_des = hacer_encrip_des
[28,27,25,23,21,19,17,15,14,12,10,8,6,4,2,1]

hacer_encrip_des :: [Rotacion] -> Mensaje -> Llave -> Enc
hacer_encrip_des rots m k = des_trabajo rots (takeDrop 32 mb) kb
where kb = transformar_Llave $ bitify k
mb = permutacion_inicial $ bitify m

des_trabajo :: [Rotacion] -> (Bits32, Bits32) -> Bits56 -> Enc
des_trabajo [] (ml, mr) _ = unbitify $ final_perm $ (mr ++ ml)
des_trabajo (r:rs) mb kb = des_trabajo rs mb' kb
where mb' = hacer_la_ronda r mb kb

hacer_la_ronda :: Rotacion -> (Bits32, Bits32) -> Bits56 -> (Bits32,
Bits32)
hacer_la_ronda r (ml, mr) kb = (mr, m')
where kb' = get_Llave kb r
comp_kb = compression_permutation kb'
expa_mr = expansion_permutation mr
res = comp_kb `xor` expa_mr
res' = tail $ iterate (trans 6) ([], res)
trans n (_, b) = (take n b, drop n b)
res_s = concat $ zipWith (\f (x,_) -> f x) [caja_des_1,
caja_des_2,
caja_des_3,
caja_des_4,
caja_des_5,
caja_des_6,
caja_des_7,
caja_des_8] res'
res_p = p_box res_s
m' = res_p `xor` ml

get_Llave :: Bits56 -> Rotacion -> Bits56
get_Llave kb r = kb'
where (kl, kr) = takeDrop 28 kb
kb' = rotateL kl r ++ rotateL kr r

compression_permutation :: Bits56 -> Bits48
compression_permutation kb = map ((!!) kb) i
where i = [13, 16, 10, 23, 0, 4, 2, 27, 14, 5, 20, 9,
22, 18, 11, 3, 25, 7, 15, 6, 26, 19, 12, 1,
40, 51, 30, 36, 46, 54, 29, 39, 50, 44, 32, 47,
43, 48, 38, 55, 33, 52, 45, 41, 49, 35, 28, 31]

expansion_permutation :: Bits32 -> Bits48
expansion_permutation mb = map ((!!) mb) i
where i = [31, 0, 1, 2, 3, 4, 3, 4, 5, 6, 7, 8,
7, 8, 9, 10, 11, 12, 11, 12, 13, 14, 15, 16,
15, 16, 17, 18, 19, 20, 19, 20, 21, 22, 23, 24,
23, 24, 25, 26, 27, 28, 27, 28, 29, 30, 31, 0]

caja_des :: [[Word8]] -> Bits6 -> Bits4
caja_des s [a,b,c,d,e,f] = to_bool 4 $ (s !! row) !! col
where row = sum $ zipWith numericise [a,f] [1, 0]
col = sum $ zipWith numericise [b,c,d,e] [3, 2, 1, 0]
numericise = (\x y -> if x then 2^y else 0)
to_bool 0 _ = []
to_bool n i = ((i .&. 8) == 8):to_bool (n-1) (shiftL i 1)

caja_des_1 :: Bits6 -> Bits4
caja_des_1 = caja_des i
where i = [[14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9,
0, 7],
[ 0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5,
3, 8],
[ 4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10,
5, 0],
[15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0,
6, 13]]

caja_des_2 :: Bits6 -> Bits4
caja_des_2 = caja_des i
where i = [[15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0,
5, 10],
[3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9,
11, 5],
[0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3,
2, 15],
[13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5,
14, 9]]

caja_des_3 :: Bits6 -> Bits4
caja_des_3 = caja_des i
where i = [[10, 0, 9, 14 , 6, 3, 15, 5, 1, 13, 12, 7, 11, 4,
2, 8],
[13, 7, 0, 9, 3, 4, 6, 10, 2, 8, 5, 14, 12, 11,
15, 1],
[13, 6, 4, 9, 8, 15, 3, 0, 11, 1, 2, 12, 5, 10,
14, 7],
[1, 10, 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5,
2, 12]]

caja_des_4 :: Bits6 -> Bits4
caja_des_4 = caja_des i
where i = [[7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12,
4, 15],
[13, 8, 11, 5, 6, 15, 0, 3, 4, 7, 2, 12, 1, 10,
14, 9],
[10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2,
8, 4],
[3, 15, 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7,
2, 14]]

caja_des_5 :: Bits6 -> Bits4
caja_des_5 = caja_des i
where i = [[2, 12, 4, 1, 7, 10, 11, 6, 8, 5, 3, 15, 13, 0,
14, 9],
[14, 11, 2, 12, 4, 7, 13, 1, 5, 0, 15, 10, 3, 9,
8, 6],
[4, 2, 1, 11, 10, 13, 7, 8, 15, 9, 12, 5, 6, 3,
0, 14],
[11, 8, 12, 7, 1, 14, 2, 13, 6, 15, 0, 9, 10, 4,
5, 3]]

caja_des_6 :: Bits6 -> Bits4
caja_des_6 = caja_des i
where i = [[12, 1, 10, 15, 9, 2, 6, 8, 0, 13, 3, 4, 14, 7,
5, 11],
[10, 15, 4, 2, 7, 12, 9, 5, 6, 1, 13, 14, 0, 11,
3, 8],
[9, 14, 15, 5, 2, 8, 12, 3, 7, 0, 4, 10, 1, 13,
11, 6],
[4, 3, 2, 12, 9, 5, 15, 10, 11, 14, 1, 7, 6, 0,
8, 13]]

caja_des_7 :: Bits6 -> Bits4
caja_des_7 = caja_des i
where i = [[4, 11, 2, 14, 15, 0, 8, 13, 3, 12, 9, 7, 5, 10,
6, 1],
[13, 0, 11, 7, 4, 9, 1, 10, 14, 3, 5, 12, 2, 15,
8, 6],
[1, 4, 11, 13, 12, 3, 7, 14, 10, 15, 6, 8, 0, 5,
9, 2],
[6, 11, 13, 8, 1, 4, 10, 7, 9, 5, 0, 15, 14, 2,
3, 12]]

caja_des_8 :: Bits6 -> Bits4
caja_des_8 = caja_des i
where i = [[13, 2, 8, 4, 6, 15, 11, 1, 10, 9, 3, 14, 5, 0,
12, 7],
[1, 15, 13, 8, 10, 3, 7, 4, 12, 5, 6, 11, 0, 14,
9, 2],
[7, 11, 4, 1, 9, 12, 14, 2, 0, 6, 10, 13, 15, 3,
5, 8],
[2, 1, 14, 7, 4, 10, 8, 13, 15, 12, 9, 0, 3, 5,
6, 11]]

p_box :: Bits32 -> Bits32
p_box kb = map ((!!) kb) i
where i = [15, 6, 19, 20, 28, 11, 27, 16, 0, 14, 22, 25, 4, 17,
30, 9,
1, 7, 23, 13, 31, 26, 2, 8, 18, 12, 29, 5, 21, 10, 3,
24]

final_perm :: Bits64 -> Bits64
final_perm kb = map ((!!) kb) i
where i = [39, 7, 47, 15, 55, 23, 63, 31, 38, 6, 46, 14, 54, 22, 62,
30,
37, 5, 45, 13, 53, 21, 61, 29, 36, 4, 44, 12, 52, 20, 60,
28,
35, 3, 43, 11, 51, 19, 59, 27, 34, 2, 42, 10, 50, 18, 58,
26,
33, 1, 41, 9, 49, 17, 57, 25, 32, 0, 40 , 8, 48, 16, 56,
24]

takeDrop :: Int -> [a] -> ([a], [a])
takeDrop _ [] = ([], [])
takeDrop 0 xs = ([], xs)
takeDrop n (x:xs) = (x:ys, zs)
where (ys, zs) = takeDrop (n-1) xs

[Juan Jose Olivera]

Hola no logro ver en este codigo que mandaste la funcion incorporada por tu amiga, por fa manda el codigo con la funcion, de todas maneras he logrado tambien incorporar el codigo , pero me gustaria ver el otro. pues no estoy completamente seguro de que lo que hice funcione como deberia.

saludos

JJ

[Juan Jose Olivera]

Tambien he encontrado esto googleando

http://userpages.umbc.edu/~mabzug1/cs/md5/md5.html
saludos

JJ

El 26 de noviembre de 2009 18:27, lolimarq <loli...@gmail.com> escribió:

[Lolimar Quintana]

Aqui es donde la muchacha incorporo la otra funcion en el primero no estaba import Data Word
y en este si el primero solo estaba definido para bit.

esa en la función nueva incorporada solo que falta el caso contrario desemcriptar

--
Lolimar Quintana
Cel. 0414-1245710

[Lolimar Quintana]

disculpa es este el archivo y lo que incorporo fue data char

El 26 de noviembre de 2009 23:10, Juan Jose Olivera <jota.j...@gmail.com> escribió:

[carlos gomez]

Lo que necesitas es una funcion que convierta una lista de Word64 a String, pues ya tienes lo inverso.

-- carlos

2009/11/27 Lolimar Quintana <loli...@gmail.com>

[Lolimar Quintana]

Si pero no sé como hacerlo y ese precisamente es mi problema . Porque debo presentar mañana la solución me la dió una persona quien me indicó como hacerlo pero yo no conseguia ni siquiera colocar el código una amiga lo incorporó sobre lo que tenía pero no supo ayudarme con el caso contrario.

quedando asi el codigo

[carlos gomez]

Estoy intentado hacerlo, cuando termine te digo y si no tambien.

[Lolimar Quintana]

Muchas gracias Carlos este es el comentario que me hizo la chica

____________________

Esto es lo que logre hacer ahora puedes llamar a la funcion encritpar pasandole por ejemplo

Main > encriptar "abc" "Hola"
7517156910108888505
Main> desencriptar "abc" 7517156910108888505
44929   

osea q encriptar y desencriptar bien

ya que 44929 es lo que devuelve la funcion del profesor cuando le paso "Hola"

He tratado de hacer el proceso inverso de Words64 -> [Integer]  pero con la funcion que el aplica no es sencilla porque son sumas sucesivas de exponente segun la cantidad de letras que tenga entonces conchale no es tan sencillo convertirlo

Si el te pasa la funcion inversa me la pasas sería más fácil agregarla y estaría listo

___________________________

Para mi lo importante es que trabaje con valores alfanumericos como son los ejemplos del propio algoritmo en este documento pdf que te envio. Los ejemplos estan en la ultima pagina y nuevamente gracias

[carlos gomez]

ya casi lo tengo hecho, el problema esta al sacar el modulo de un numero grande. Voy a ver como lo arreglo.

2009/11/27 Lolimar Quintana <loli...@gmail.com>

[carlos gomez]

Si convertimos a Word64 a la lista [1,2,3,4,5,6,7,8]  tenemos 2739136

para volverlo a su anterior lista he usado:

func num 0 = []

func num n = e : func ((num-e) `div` 8) (n-1)

    where e = num `mod` 8

llamando de esta manera: func 2739136 8 

Esto me devuelve [0,0,7,5,4,3,2,1]

Es esto problema de sacar el modulo de numeros grandes?

2009/11/27 carlos gomez <carli...@gmail.com>

[carlos gomez]

El problema anterior no es por el modulo, sino que la respuesta es correcta.

Podriamos arreglarlo asi:

func64 num 0 = []

func64 num n = e : func64 ((num-e) `div` 8) (n-1)

    where e = if m == 0 

                   then 8

                   else m

            m = num `mod` 8

Y tendriamos una respuesta correcta. Pero surge otro problema, resulta que lo anterior solo es valido para secuencias de numeros,

y no da resultados correctos para otras secuencias, y peor aun si el numero es divisible entre 8.

Conclusion: hay que buscar otra manera de volver a la lista de enteros, osea otra ves desde cero!!!

Bueno, Lolimar Quintana, hasta ahi he llegado. Si encuentro algun resultado te comento por este medio, eso es todo por hoy (seria bueno que si logras resolverlo no comentes tambien).

-- carlos

2009/11/27 carlos gomez <carli...@gmail.com>

[carlos gomez]

Buscando en la red, encontre la funcion que hace la conversion de [word64] -> String, asi que lo puse en el codigo que teniamos. y ya funciona correctamente.

te envio:

des.hs   -> lo que tenias + lo agregado

hdes.hs  -> codigo de donde saque las funciones

Las pruebas las hice de la siguiente manera:

# ghci des.hs

*Main> encriptarCadena 12 "carlos"

[10286780430136248083]

*Main> desencriptarCadena 12 it

"carlos\NUL\NUL"

*Main> 

Ahora, las funciones que aumente son estas:

-------------------------------------------------------

preparePlaintext :: [Char] -> [Word64]
preparePlaintext text = text64 (to64 text)
                        where
                           to64 = map (fromIntegral . ord)

                           text64 [] = []
                           text64 ns = let
                                            (x,rest) = splitAt 8 ns
                                            w64 = foldl1 shiftOr (reverse x)
                                            shiftOr k r = (k `shiftL` 8) .|. r
                                       in
                                            w64 : text64 rest

readPlaintext :: [Word64] -> [Char]
readPlaintext text = concatMap to8 text
                     where
                        to8 = map (chr . fromIntegral) . take 8 . from64
                        from64 = unfoldr (\k -> Just (k .&. 0xff, k `shiftR` 8))
-------------------------------------------------------

La fuente de donde las saque: http://vandreev.wordpress.com/2007/06/18/feistel-ciphers-and-des-in-haskell/

Espero te hayan servido estas cosas, la proxima ves, creo que seria mejor primero dar una vuelta por la red antes de hacer el propio.

[Lolimar Quintana]

Gracias carlos voy a verificar, aun sigo aqui trababando con lo de la exposicion si te preguntaran a ti que es la dificutad de programar esto en haskell que dirias. o mejor dicho que dificultad le encontraste

[Lolimar Quintana]

Aqui está el último archivo del código

[Juan Jose Olivera]

Ok, para que la llave pueda ser una cadena tienes que convertir la llave tambien a word64, para esto basta pasarle el preparePlaintext y sacarle el resulta de la lista(es una lista de un solo elemento), lo mismo para el descifrar.

Las funciones son encriptarCadena2 y desencriptarCadena2


saludos

JJ