wordpass 0.3.0.0 → 0.4.0.0
raw patch · 6 files changed
+128/−32 lines, 6 filesdep +deepseqdep +filepathdep +unix-compat
Dependencies added: deepseq, filepath, unix-compat
Files
- Data/Random/Choice.hs +22/−0
- Data/Random/Vector.hs +11/−0
- README.md +12/−1
- WordPass.hs +62/−28
- changelog +7/−0
- wordpass.cabal +14/−3
+ Data/Random/Choice.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE FlexibleContexts #-}+-- | Main module generating passwords.+module Data.Random.Choice(randomChoice) where++import Data.Ratio+import Data.Random.RVar+import Data.Random.Distribution+import Data.Random.Distribution.Uniform++-- | Performs random choice between two RVar values.+-- Input is a _ratio_ of the _relative_ probabilities between first and+-- second option (A/B).+randomChoice :: (Fractional r, Ord r, Data.Random.Distribution.Distribution Uniform r) => r ->+ RVar b -> RVar b -> RVar b+randomChoice ratio variantA variantB = do draw <- uniform 0 1+ if draw >= probabilityOfVariantA+ then variantA+ else variantB+ where+ probabilityOfVariantA = 1/(1+1/ratio)++
+ Data/Random/Vector.hs view
@@ -0,0 +1,11 @@+module Data.Random.Vector(randomElement) where++import Data.Random.RVar+import Data.Random.Distribution.Uniform+import qualified Data.Vector as V+import Control.Applicative++-- | Take a random element of a vector.+randomElement :: V.Vector a -> RVar a+randomElement words = (words V.!) <$> uniform 0 (V.length words - 1)+
README.md view
@@ -3,6 +3,17 @@ Dictionary-based password generator. +[](https://travis-ci.org/mjgajda/wordpass)+[](https://hackage.haskell.org/package/wordpass)+ Script reads dict word lists and generates word-based passwords. Uses dictionaries from /usr/share/dict by default.-Inspired by [Xkcd comic](http://xkcd.com/936/). +Inspired by [Xkcd comic](http://xkcd.com/936/).++Program also prints how many words have been read, and indicates estimated+password space size in bits.++Using just four words from default English dictionary of ~50k words will+give approximately 90 bits of entropy. Lucky speakers of languages with+rich inflection like Polish (over 3 million words) can easily up this to+over 110 bits of entropy.
WordPass.hs view
@@ -1,53 +1,82 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction #-} -- | Main module generating passwords. module Main where +import Data.Ratio import System.IO (hFlush, stdout)-import System.Directory(getDirectoryContents)+import System.Directory+import System.FilePath ((</>), takeDirectory) import qualified Data.Text as Text import qualified Data.Text.IO as Text import Data.Text(Text) import qualified Data.Set as Set+import Data.Set (Set) import Data.Char (isAlpha, isPunctuation, isSymbol) import Data.Random.RVar import Data.Random.Sample import Data.Random.RVar.Enum+import Data.Random.Choice+import Data.Random.Vector+import Data.Random.Source.DevRandom import Data.Random.Distribution import Data.Random.Distribution.Uniform import Data.Random.Source.IO import qualified Data.Vector as V import Control.Applicative-import Control.Monad (replicateM, foldM)+import Control.Monad (replicateM, foldM, filterM)+import Control.DeepSeq import HFlags+import System.PosixCompat +type WordList = Set.Set Text++-- | Try to resolve symbolic link chain for given filename.+resolveSymbolicLink s = do b <- isSymbolicLink `fmap` getSymbolicLinkStatus s+ if b+ then do newPath <- readSymbolicLink s+ resolveSymbolicLink $! takeDirectory s </> newPath + else return s+ -- | Reads a dict format to get a list of unique words without any special -- chars.-readDict :: FilePath -> IO (V.Vector Text)+readDict :: FilePath -> IO WordList readDict filename = do input <- Text.readFile filename- return $! V.fromList . Set.toList . Set.fromList . map stripTails . Text.lines $! input+ return $! Set.fromList . map stripTails . Text.lines $! input where stripTails = head . Text.split (not . isAlpha) -- | Find all plausible dictionaries in a given directory-dictFiles dir = postprocess `fmap`- getDirectoryContents dir+dictFiles dir = do candidates <- preprocess `fmap` prefilter `fmap`+ getDirectoryContents dir+ resolvedCandidates <- uniquify `fmap` mapM resolveSymbolicLink candidates+ result <- filterM checkPerms resolvedCandidates+ print result+ return result where- postprocess = map ((dir ++ "/") ++) . filter (not . (=='.') . head)---- | Default directory where to look for the word lists.-+ preprocess = map ((dir ++ "/") ++)+ prefilter = filter (not . (`elem` ".~_") . head) . filter (not . ("README" `isPrefixOf`))+ checkPerms filename = do perms <- getPermissions filename+ return $! readable perms &&+ not (executable perms) &&+ not (searchable perms)+ uniquify = Set.toList . Set.fromList+ isPrefixOf "" a = True+ isPrefixOf bs "" = False+ isPrefixOf (b:bs) (c:cs) | b == c = isPrefixOf bs cs+ isPrefixOf _ _ = False -- | Read a set of dictionaries and put the together. readDicts filenames = do putStr $ "Reading " ++ show (length filenames) ++ " files"- result <- (V.fromList . Set.toList) `fmap` foldM action Set.empty filenames+ result <- foldM action Set.empty filenames putStrLn "" return result where action currentSet filename = do newSet <- readDict filename+ let result = newSet `Set.union` currentSet putStr "." hFlush stdout- return $! Set.fromList (V.toList newSet) `Set.union` currentSet+ result `deepseq` return result -- | Read all dictionaries from a given directory. readDictDir dirname = dictFiles dirname >>= readDicts@@ -56,10 +85,6 @@ defaultDictionary :: FilePath defaultDictionary = "/usr/share/dict/british-english" --- | Take a random element of a vector.-randomElement :: V.Vector a -> RVar a-randomElement words = (words V.!) <$> uniform 0 (V.length words - 1)- -- | Pick a random password, given a words list, and a number of words it will contain. randomPassword :: V.Vector Text -> Int -> RVar Text randomPassword words numWords = do ws <- replicateM numWords $ randomElement words@@ -69,19 +94,22 @@ -- | Estimate strength of random password with given inputs. randomPasswordStrength words numWords = fromIntegral numWords * logBase 2 wordStrength where- wordStrength = fromIntegral $ V.length words * (32 + 100)+ wordStrength = fromIntegral $ V.length words * (numSymbols + numNumericSeparators) +numSymbols = V.length symbolChars -- 32+numNumericSeparators = 100+ -- * Random separators -- | Randomly pick a word separator as a two-digit number, or a symbol -- character. randomSeparator :: RVar Text-randomSeparator = do b <- uniform False True- if b then symbolSeparator- else numericSeparator+randomSeparator = randomChoice ratio randomSymbolSeparator randomNumericSeparator+ where+ ratio = numSymbols % numNumericSeparators -- | Two-digit number as a separator 10^2 = 6.6 bits of entropy.-numericSeparator :: RVar Text-numericSeparator = Text.pack <$> show <$> uniform 0 (99 :: Int)+randomNumericSeparator :: RVar Text+randomNumericSeparator = Text.pack <$> show <$> uniform 0 (numNumericSeparators :: Int) -- | Conjunction of two unary predicates (|||) :: (t -> Bool) -> (t -> Bool) -> t -> Bool@@ -93,8 +121,8 @@ symbolChars = V.fromList $ filter (isSymbol ||| isPunctuation) $ map toEnum [0..127] -- | Text with random symbol character, 5 bits of entropy-symbolSeparator :: RVar Text-symbolSeparator = Text.singleton <$> randomElement symbolChars+randomSymbolSeparator :: RVar Text+randomSymbolSeparator = Text.singleton <$> randomElement symbolChars -- * Command-line flags -- | Number of words per password@@ -110,17 +138,23 @@ defineFlag "l:wordlist" ("" :: FilePath) "Select particular dictionary (filepath)." -- | Read wordlist given by explict filepath, or search for all wordlists in a given directory.-selectWordList :: FilePath -> FilePath -> IO (V.Vector Text)+selectWordList :: FilePath -> FilePath -> IO WordList selectWordList "" dir = readDictDir dir selectWordList filename _ = readDict filename +-- | Pick specific wordlist.+defineFlag "r:pseudorandom" (False :: Bool) "Generate passwords using StdRandom generator, instead of DevRandom. (Faster, but less safe. Good for testing."+ main = do $initHFlags "WordPass - dictionary-based password generator"- dictWords <- selectWordList flags_directory flags_wordlist+ dictWords <- (V.fromList . Set.toList) `fmap` selectWordList flags_wordlist flags_directory putStrLn $ "Read " ++ show (V.length dictWords) ++ " words from dictionaries." putStr "Estimated password strength (bits): " print $ randomPasswordStrength dictWords flags_words replicateM flags_passwords $ do - rv <- sample $ randomPassword dictWords flags_words+ let rand = randomPassword dictWords flags_words+ rv <- if flags_pseudorandom+ then sample rand+ else sampleFrom DevRandom rand Text.putStrLn rv
changelog view
@@ -1,5 +1,12 @@ -*-Changelog-*- +0.4.0.0 May 2014+ * Option to select standard Haskell random number generator or /dev/random.+ * Pre-filtering input files to get rid of symlinks to files that are+ already there, and READMEs.+ * Splitted Data.Random.{Choice|Vector} to be submitted for inclusion+ in random-fu.+ 0.3.0.0 May 2014 * CLI interface with HFlags and documentation.
wordpass.cabal view
@@ -1,8 +1,16 @@ name: wordpass-version: 0.3.0.0+version: 0.4.0.0 synopsis: Dictionary-based password generator description: This script reads dict word lists and generates word-based passwords.- Not unlike <http://xkcd.com/936/ Xkcd>. + Not unlike <http://xkcd.com/936/ Xkcd>.+ .+ Program also prints how many words have been read, and indicates estimated+ password space size in bits.+ .+ Using just four words from default English dictionary of ~50k words will+ give approximately 90 bits of entropy. Lucky speakers of languages with+ rich inflection like Polish (over 3 million words) can easily up this to+ over 110 bits of entropy. homepage: https://github.com/mjgajda/wordpass license: BSD3 license-file: LICENSE@@ -17,7 +25,7 @@ executable wordpass main-is: WordPass.hs- other-modules: Data.Random.RVar.Enum + other-modules: Data.Random.RVar.Enum, Data.Random.Vector, Data.Random.Choice other-extensions: OverlappingInstances, MultiParamTypeClasses, FlexibleInstances build-depends: base >=4.6 && <4.7, text >=1.1 && <1.2,@@ -26,6 +34,9 @@ random-source >=0.3 && <0.4, vector >=0.10 && <0.11, directory >= 1.2 && <1.4,+ unix-compat >= 0.4 && <0.5,+ deepseq >= 1.3 && <1.4,+ filepath >= 1.3 && <1.4, hflags >= 0.4 && <0.5 -- hs-source-dirs: default-language: Haskell2010