module Main where import Control.Monad import Data.Char import Data.List import Data.Maybe (fromMaybe) import System.Console.GetOpt import System.Environment import System.Exit import System.IO import System.Random import Data.Elocrypt version :: String termLen :: Int termHeight :: Int version = "elocrypt 2.1.0" termLen = 80 termHeight = 10 data Options = Options { optCapitals :: Bool, -- Include capital letters? optDigits :: Bool, -- Inlcude digits? optLength :: Int, -- Size of the password(s) optMaxLength :: Int, optNumber :: Maybe Int, -- Number of passwords to generate optPassType :: PassType, -- Generate passwords or passphrases optSpecials :: Bool, -- Include special characters? optHelp :: Bool, optVersion :: Bool } deriving (Show) data PassType = Phrase | Word deriving (Eq, Show) defaultOptions :: Options defaultOptions = Options { optCapitals = False , optDigits = False , optLength = 8 , optMaxLength = 10 , optNumber = Nothing , optPassType = Word , optSpecials = False , optHelp = False , optVersion = False } options :: [OptDescr (Options -> Options)] options = [ Option ['c'] ["capitals"] (NoArg (\o -> o { optCapitals = True })) "Include at least one capital letter" , Option ['d'] ["digits"] (NoArg (\o -> o { optDigits = True })) "Include numerals" , Option ['s'] ["symbols"] (NoArg (\o -> o { optSpecials = True })) "Include special characters" , Option ['n'] ["number"] (ReqArg (\n o -> o { optNumber = Just (read n) }) "NUMBER") "The number of passwords to generate" , Option ['p'] ["passphrase"] (NoArg (\o -> o { optPassType = Phrase })) "Generate passphrases instead of passwords" , Option ['h'] ["help"] (NoArg (\o -> o { optHelp = True })) "Show this help" , Option ['v'] ["version"] (NoArg (\o -> o { optVersion = True })) "Show version and exit" ] main :: IO () main = do args <- getArgs opts <- elocryptOpts args gen <- getStdGen when (optHelp opts) $ do hPutStrLn stderr usage exitSuccess when (optVersion opts) $ do hPutStrLn stderr version exitSuccess when (optLength opts == 0) exitSuccess -- Nothing to do putStrLn (generate opts gen) elocryptOpts :: [String] -> IO Options elocryptOpts args = do (opts, nonopts) <- elocryptOpts' args return $ case nonopts of (o : os : _) -> opts { optLength = read o, optMaxLength = read os } (o : _) -> opts { optLength = read o } [] -> opts elocryptOpts' :: [String] -> IO (Options, [String]) elocryptOpts' args = case getOpt Permute options args of (opts, nonopts, []) -> do let opts' = foldl (flip id) defaultOptions opts return (opts', nonopts) (_, _, errs) -> do hPutStrLn stderr (concat errs) hPutStrLn stderr usage exitFailure generate :: RandomGen g => Options -> g -> String generate opts@Options { optPassType = Word } = passwords opts generate opts@Options { optPassType = Phrase } = passphrases opts passwords :: RandomGen g => Options -> g -> String passwords opts@Options { optLength = len, optNumber = n } gen = format " " . groupWith splitAt' width " " $ ps where ps = newPasswords len num (getGenOptions opts) gen cols = columns len num = fromMaybe (nWords cols) n width = max termLen (len + 2) passphrases :: RandomGen g => Options -> g -> String passphrases opts@Options { optCapitals = caps, optLength = minLen, optMaxLength = maxLen, optNumber = n } gen = format " " . take lines' . groupWith splitAt' width " " $ passphrase where passphrase = newPassphrase words' minLen maxLen (getGenOptions opts) gen words' = columns minLen * lines' width = max termLen (maxLen + 1) lines' = fromMaybe termHeight n getGenOptions :: Options -> GenOptions getGenOptions opts = genOptions { genCapitals = optCapitals opts, genDigits = optDigits opts, genSpecials = optSpecials opts } usage :: String usage = usageInfo (intercalate "\n" headerLines) options where headerLines = [ "Usage: elocrypt [option...] length" , " elocrypt -p [option...] min-length max-length" ] -- Utilities -- Calculate the number of passwords to print per line columns :: Int -> Int columns len | len <= termLen - 2 = termLen `div` (len + 2) | otherwise = 1 -- Format a 2D list of Strings, -- 1 list per line format :: String -> [[String]] -> String format sep = intercalate "\n" . map (intercalate sep) -- Calculate the number of words to print nWords :: Int -> Int nWords cols = termHeight * cols -- Group a 2D array with a function by total length groupWith :: (Int -> [a] -> [[a]] -> ([[a]], [[a]])) -> Int -> [a] -> [[a]] -> [[[a]]] groupWith _ _ _ [] = [] groupWith f i sep ls | null groups = [[head ls]] | otherwise = groups where groups = groupWith' f i sep ls groupWith' :: (Int -> [a] -> [[a]] -> ([[a]], [[a]])) -> Int -> [a] -> [[a]] -> [[[a]]] groupWith' _ _ _ [] = [] groupWith' f i sep ls = g : groupWith f i sep ls' where (g, ls') = f i sep ls -- Split a 2D array by the total length splitAt' :: Int -> [a] -> [[a]] -> ([[a]], [[a]]) splitAt' 0 _ ls = ([], ls) splitAt' _ _ [] = ([], []) splitAt' n sep (l : ls) | n >= length l + sl = (l : xs, xs') | otherwise = ([], l : ls) where (xs, xs') = splitAt' (n - length l - sl) sep ls sl = length sep