xnyhps · November 16, 2013 08:12
diff --git a/gmail-sign.hs b/gmail-sign.hs
 {-# LANGUAGE OverloadedStrings #-}
 import OpenSSL.Digest.ByteString
 import OpenSSL.Digest (MessageDigest(..))

 import Data.ByteString.Base64
 import Data.ByteString (ByteString(..), unpack, append)
 import Data.ByteString.Char8 (pack)

 import Data.Char (ord)
 import Data.IORef

 (+++) = append

 hash = ...
 sender = ...
 sender_full = ...
 to = ...

 target = unpack $ case decode hash of
 	(Right x) -> x
 	(Left y) -> error y

 delimiters = ['\x00', '\x01', '\t', '\n', '\r', ' ', '!', '"', '#', '$', '%', '&', '\'', '(', ')', '*', '+', ',', '-', '.', '/', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', ':', ';', '<', '=', '>', '?', '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', '[', '\\', ']', '^', '_', '`', 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z', '{', '|', '}', '~']

 count_delimiters :: Int -> [ByteString]
 count_delimiters n = map pack $ sequence $ replicate n delimiters

 raw_message :: ByteString
 raw_message = ...

 message_options :: [ByteString]
 message_options = [raw_message, "<body>" +++ raw_message +++ "</body>"]

 from_options :: [ByteString]
 from_options = [sender_full, sender]

 to_options :: [ByteString]
 to_options = [to]

 filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
 filterM f [] = return []
 filterM f (x:xs) = do
 	b <- f x
 	if b
 	then do
 		xs' <- filterM f xs
 		return (x:xs')
 	else
 		filterM f xs

 orders =
 	[ \a b c -> (a, b, c)
 	, \a b c -> (a, c, b)
 	, \a b c -> (b, a, c)
 	, \a b c -> (b, c, a)
 	, \a b c -> (c, a, b)
 	, \a b c -> (c, b, a)]

 main :: IO ()
 main = do
 	{ ref <- newIORef 0
 	; mapM_ (\(del, (a, b, c)) -> do { d <- digest SHA1 (a +++ del +++ b +++ del +++ c)
 								     ; counter <- readIORef ref ; writeIORef ref (counter + 1)
 								     ; if (d == target)
 								       then print (del, a, b, c)
 								       else if (counter `mod` 100) == 0
 									       	then putStr ("\r" ++ (show counter))
 									       	else return ()
 								     })
 			[(d, o m f t) | m <- message_options
 						  , f <- from_options
 						  , t <- to_options
 						  , o <- orders
 						  , n <- [1, 2, 3, 4]
 						  , d <- count_delimiters n]
 	; return ()
 	}
	{-# LANGUAGE OverloadedStrings #-}
	import OpenSSL.Digest.ByteString
	import OpenSSL.Digest (MessageDigest(..))

	import Data.ByteString.Base64
	import Data.ByteString (ByteString(..), unpack, append)
	import Data.ByteString.Char8 (pack)

	import Data.Char (ord)
	import Data.IORef

	(+++) = append

	hash = ...
	sender = ...
	sender_full = ...
	to = ...

	target = unpack $ case decode hash of
	(Right x) -> x
	(Left y) -> error y

	delimiters = ['\x00', '\x01', '\t', '\n', '\r', ' ', '!', '"', '#', '$', '%', '&', '\'', '(', ')', '*', '+', ',', '-', '.', '/', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', ':', ';', '<', '=', '>', '?', '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', '[', '\\', ']', '^', '_', '`', 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z', '{', '\|', '}', '~']

	count_delimiters :: Int -> [ByteString]
	count_delimiters n = map pack $ sequence $ replicate n delimiters

	raw_message :: ByteString
	raw_message = ...

	message_options :: [ByteString]
	message_options = [raw_message, "<body>" +++ raw_message +++ "</body>"]

	from_options :: [ByteString]
	from_options = [sender_full, sender]

	to_options :: [ByteString]
	to_options = [to]

	filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
	filterM f [] = return []
	filterM f (x:xs) = do
	b <- f x
	if b
	then do
	xs' <- filterM f xs
	return (x:xs')
	else
	filterM f xs

	orders =
	[ \a b c -> (a, b, c)
	, \a b c -> (a, c, b)
	, \a b c -> (b, a, c)
	, \a b c -> (b, c, a)
	, \a b c -> (c, a, b)
	, \a b c -> (c, b, a)]

	main :: IO ()
	main = do
	{ ref <- newIORef 0
	; mapM_ (\(del, (a, b, c)) -> do { d <- digest SHA1 (a +++ del +++ b +++ del +++ c)
	; counter <- readIORef ref ; writeIORef ref (counter + 1)
	; if (d == target)
	then print (del, a, b, c)
	else if (counter `mod` 100) == 0
	then putStr ("\r" ++ (show counter))
	else return ()
	})
	[(d, o m f t) \| m <- message_options
	, f <- from_options
	, t <- to_options
	, o <- orders
	, n <- [1, 2, 3, 4]
	, d <- count_delimiters n]
	; return ()
	}