xnyhps/gmail-sign.hs

## 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 ()
	}