hscrack.hs

import Data.Char
import Data.String.Utils
import Data.List

import System.Environment
import System.Exit
import System.Cmd

import Control.Concurrent
import Control.Concurrent.MVar
import Control.Monad

import GHC.IOBase


-- Example:
--
-- Try all possible case combinations of "foobar" as passphrase for the
-- gpg-encrypted file encrypted-file.gpg on two worker threads.
--
-- TRY_GPG_PASSWORD='gpg -q -d --batch --passphrase %% encrypted-file.gpg' 
--
-- ./hscrack "$TRY_GPG_PASSWORD >/dev/null 2>&1" cases foobar 2


main = getArgs >>= parseArgs


parseArgs args =
    case args of
        [template, strategy, base, n] -> run template strategy base (read n)
        [template, strategy, base]    -> run template strategy base 1
        _ -> getProgName >>= putStrLn . usage >> exitFailure


run template strategy base threads =
    mapM forkWorker (chunks candidates threads) >>= wait

    where
        candidates = nub $ strategyF strategy base
        command = flip (replace "%%") template . quoteArg

        forkWorker xs = do
            mvar <- newEmptyMVar
            forkIO (mapM_ tryPassword xs >> putMVar mvar ())
            return mvar

        wait = mapM_ takeMVar

        chunks xs 0 = [xs]
        chunks xs n =
            if length xs < n
                then chunks xs (length xs)
                else chunk : chunks rest (n - 1)
            where
                (chunk, rest) = splitAt (length xs `div` n) xs

        tryPassword candidate = do
            success <- tryCommand $ command candidate
            when success $ putStrLn candidate


quoteArg s =
    let quote '"'  = "\\\""
        quote '\\' = "\\\\"
        quote x    = [x]
    in "\"" ++ concatMap quote s ++ "\""


usage name = "Usage: " ++ name ++ " <command> <strategy> <template> [threads]"


tryCommand command =
    liftM isSuccess (system command)
    where
        isSuccess ExitSuccess = True
        isSuccess _           = False


strategyF "cases"         = cases
strategyF "permute"       = permutations
strategyF "cases.permute" = concatMap permutations . cases
-- Add more passphrase generator functions here...
strategyF strategy        = error $ "unknown strategy: " ++ strategy


cases [] = [""]
cases (x:xs) =
    let rest = cases xs
    in map ((:) (toLower x)) rest ++ map ((:) (toUpper x)) rest