wordpass 0.4.2.0 → 1.0.0.0
raw patch · 5 files changed
+175/−122 lines, 5 files
Files
- README.md +1/−0
- Text/WordPass.hs +137/−0
- WordPass.hs +10/−119
- changelog +3/−0
- wordpass.cabal +24/−3
README.md view
@@ -17,3 +17,4 @@ give approximately 90 bits of entropy. Lucky speakers of languages with rich inflection like Polish (over 3 million word variants) can easily up this to over 110 bits of entropy.+
+ Text/WordPass.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction #-}+-- | Main module generating passwords.+module Text.WordPass where++import Data.Ratio+import System.IO (hFlush, stdout)+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.RVar.Enum()+import Data.Random.Choice+import Data.Random.Vector+import Data.Random.Distribution.Uniform+import Data.Random.Source.IO()+import qualified Data.Vector as V+import Control.Applicative+import Control.Monad (replicateM, foldM, filterM)+import Control.DeepSeq+import System.PosixCompat++-- | Explanatory type alias for the type of wordlists during preprocessing.+type WordSet = Set.Set Text++-- | Explanatory type alias for immutable, preprocessed wordlist used by random number generator.+type WordList = V.Vector Text++-- * Reading inputs+-- | Try to resolve symbolic link chain for given filename.+resolveSymbolicLink :: FilePath -> IO FilePath+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 WordSet+readDict filename = do+ input <- Text.readFile filename+ return $! Set.fromList . map stripTails . Text.lines $! input+ where+ stripTails = head . Text.split (not . isAlpha)++-- | Find all plausible dictionaries in a given directory+dictFiles :: FilePath -> IO [FilePath]+dictFiles dir = do candidates <- preprocess `fmap` prefilter `fmap`+ getDirectoryContents dir+ resolvedCandidates <- nubSet `fmap` mapM resolveSymbolicLink candidates+ result <- filterM checkPerms resolvedCandidates+ print result+ return result+ where+ 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)+ nubSet = Set.toList . Set.fromList+ isPrefixOf :: String -> String -> Bool+ isPrefixOf "" _ = True+ isPrefixOf _ "" = False+ isPrefixOf (b:bs) (c:cs) | b == c = bs `isPrefixOf` cs+ isPrefixOf _ _ = False++-- | Read a set of dictionaries and put the together.+readDicts :: [FilePath] -> IO (Set Text)+readDicts filenames = do putStr $ "Reading " ++ show (length filenames) ++ " files"+ 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+ result `deepseq` return result++-- | Read all dictionaries from a given directory.+readDictDir :: FilePath -> IO (Set Text)+readDictDir dirname = dictFiles dirname >>= readDicts++-- | Filename for default dictionary (should be command line argument or default glob.)+defaultDictionary :: FilePath+defaultDictionary = "/usr/share/dict/british-english"++-- | Pick a random password, given a words list, and a number of words it will contain.+randomPassword :: WordList -> Int -> RVar Text+randomPassword wordlist numWords = do ws <- replicateM numWords $ randomElement wordlist+ seps <- replicateM numWords randomSeparator+ return $ Text.concat $ zipWith Text.append ws seps++-- | Estimate strength of random password with given inputs.+randomPasswordStrength :: V.Vector a -> Int -> Double+randomPasswordStrength wordlist numWords = fromIntegral numWords * logBase 2 wordStrength+ where+ wordStrength = fromIntegral $ V.length wordlist * (numSymbols + numNumericSeparators)++-- | Number of characters within alphabet.+numSymbols :: Int+numSymbols = V.length symbolChars -- 32++numNumericSeparators :: Int+numNumericSeparators = 100++-- * Random separators+-- | Randomly pick a word separator as a two-digit number, or a symbol+-- character.+randomSeparator :: RVar Text+randomSeparator = randomChoice ratio randomSymbolSeparator randomNumericSeparator+ where+ ratio = numSymbols % numNumericSeparators++-- | Two-digit number as a separator 10^2 = 6.6 bits of entropy.+randomNumericSeparator :: RVar Text+randomNumericSeparator = Text.pack <$> show <$> uniform 0 (numNumericSeparators :: Int)++-- | Conjunction of two unary predicates+(|||) :: (t -> Bool) -> (t -> Bool) -> t -> Bool+(|||) f g x = f x || g x++-- | List of symbol and punctuation characters in ASCII+-- Should be 5 bits of entropy+symbolChars :: V.Vector Char+symbolChars = V.fromList $ filter (isSymbol ||| isPunctuation) $ map toEnum [0..127]++-- | Text with random symbol character, 5 bits of entropy+randomSymbolSeparator :: RVar Text+randomSymbolSeparator = Text.singleton <$> randomElement symbolChars+
WordPass.hs view
@@ -2,127 +2,17 @@ -- | Main module generating passwords. module Main where -import Data.Ratio-import System.IO (hFlush, stdout)-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.RVar.Enum() import Data.Random.Source.DevRandom-import Data.Random.Distribution-import Data.Random.Distribution.Uniform-import Data.Random.Source.IO+import Data.Random.Source.IO() import qualified Data.Vector as V import Control.Applicative-import Control.Monad (replicateM, foldM, filterM)-import Control.DeepSeq+import Control.Monad (replicateM_) 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 WordList-readDict filename = do- input <- Text.readFile filename- 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 = do candidates <- preprocess `fmap` prefilter `fmap`- getDirectoryContents dir- resolvedCandidates <- uniquify `fmap` mapM resolveSymbolicLink candidates- result <- filterM checkPerms resolvedCandidates- print result- return result- where- 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 <- 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- result `deepseq` return result---- | Read all dictionaries from a given directory.-readDictDir dirname = dictFiles dirname >>= readDicts---- | Filename for default dictionary (should be command line argument or default glob.)-defaultDictionary :: FilePath-defaultDictionary = "/usr/share/dict/british-english"---- | 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- seps <- replicateM numWords randomSeparator- return $ Text.concat $ zipWith Text.append ws seps---- | Estimate strength of random password with given inputs.-randomPasswordStrength words numWords = fromIntegral numWords * logBase 2 wordStrength- where- 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 = randomChoice ratio randomSymbolSeparator randomNumericSeparator- where- ratio = numSymbols % numNumericSeparators---- | Two-digit number as a separator 10^2 = 6.6 bits of entropy.-randomNumericSeparator :: RVar Text-randomNumericSeparator = Text.pack <$> show <$> uniform 0 (numNumericSeparators :: Int)---- | Conjunction of two unary predicates-(|||) :: (t -> Bool) -> (t -> Bool) -> t -> Bool-(|||) f g x = f x || g x---- | List of symbol and punctuation characters in ASCII--- Should be 5 bits of entropy-symbolChars :: V.Vector Char-symbolChars = V.fromList $ filter (isSymbol ||| isPunctuation) $ map toEnum [0..127]---- | Text with random symbol character, 5 bits of entropy-randomSymbolSeparator :: RVar Text-randomSymbolSeparator = Text.singleton <$> randomElement symbolChars+import Text.WordPass -- * Command-line flags -- | Number of words per password@@ -132,7 +22,7 @@ defineFlag "p:passwords" (10 :: Int) "Number of passwords to generate." -- | Default word list directory.-defineFlag "d:directory" ("/usr/share/dict" :: FilePath) ("Default directory to search for dictionaries\n (works only if --wordlist options is NOT USED.)")+defineFlag "d:directory" ("/usr/share/dict" :: FilePath) "Default directory to search for dictionaries\n (works only if --wordlist options is NOT USED.)" -- | Pick specific wordlist. defineFlag "l:wordlist" ("" :: FilePath) "Select particular dictionary (filepath)."@@ -145,16 +35,17 @@ -- | Read wordlist given by explict filepath, or search for all wordlists in a given directory.-selectWordList :: FilePath -> FilePath -> IO WordList+selectWordList :: FilePath -> FilePath -> IO WordSet selectWordList "" dir = readDictDir dir selectWordList filename _ = readDict filename -main = do $initHFlags "WordPass - dictionary-based password generator"- dictWords <- (V.fromList . Set.toList) `fmap` selectWordList flags_wordlist flags_directory+main :: IO ()+main = do _args <- $initHFlags "WordPass - dictionary-based password generator"+ dictWords <- (V.fromList . Set.toList) <$> 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 + replicateM_ flags_passwords $ do let rand = randomPassword dictWords flags_words rv <- if flags_pseudorandom then sample rand
changelog view
@@ -1,5 +1,8 @@ -*-Changelog-*- +0.5.0.0 Oct 2014+ * Expose library interface.+ 0.4.2.0 Jul 2014 * Workaround bug in GHC 7.8 that misses last instance during Template Haskell enumeration of class instances in HFlags.
wordpass.cabal view
@@ -1,5 +1,5 @@ name: wordpass-version: 0.4.2.0+version: 1.0.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>.@@ -21,11 +21,15 @@ build-type: Simple extra-source-files: README.md changelog cabal-version: >=1.10-stability: beta+stability: stable +source-repository head+ type: git+ location: https://github.com/mgajda/wordpass.git+ executable wordpass main-is: WordPass.hs- other-modules: Data.Random.RVar.Enum, Data.Random.Vector, Data.Random.Choice+ other-modules: Data.Random.RVar.Enum, Data.Random.Vector, Data.Random.Choice, Text.WordPass other-extensions: OverlappingInstances, MultiParamTypeClasses, FlexibleInstances build-depends: base >=4.6 && <4.8, text >=1.1 && <1.2,@@ -38,6 +42,23 @@ deepseq >= 1.3 && <1.4, filepath >= 1.3 && <1.4, hflags >= 0.4 && <0.5+ ghc-options: -O3 + -- hs-source-dirs: + default-language: Haskell2010++library+ exposed-modules: Data.Random.RVar.Enum, Data.Random.Vector, Data.Random.Choice, Text.WordPass+ other-extensions: OverlappingInstances, MultiParamTypeClasses, FlexibleInstances+ build-depends: base >=4.6 && <4.8,+ text >=1.1 && <1.2,+ containers >=0.5 && <0.6,+ random-fu >=0.2 && <0.3,+ 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 ghc-options: -O3 -- hs-source-dirs: default-language: Haskell2010