hpg (empty) → 0.2
raw patch · 4 files changed
+212/−0 lines, 4 filesdep +basedep +randomdep +unixsetup-changed
Dependencies added: base, random, unix
Files
- LICENSE +13/−0
- Setup.hs +2/−0
- hpg.cabal +46/−0
- src/Main.hs +151/−0
+ LICENSE view
@@ -0,0 +1,13 @@+Copyright (c) 2017 Fritjof Bornebusch++Permission to use, copy, modify, and/or distribute this software for any purpose+with or without fee is hereby granted, provided that the above copyright notice+and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS+OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER+TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF+THIS SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hpg.cabal view
@@ -0,0 +1,46 @@+-- Initial hpg.cabal generated by cabal init. For further documentation, +-- see http://haskell.org/cabal/users-guide/++name: hpg+version: 0.2+synopsis: no+description: hpg is a free ISC licensed password generator.+ It can create passwords based on the following+ characters:+ * upper case letters+ * lower case letters+ * special characters+ * numbers+ The password length is limited to 2^16 due to+ performance issues.+homepage: https://git.alokat.org/hpg+license: ISC+license-file: LICENSE+author: Fritjof Bornebusch+maintainer: fritjof@alokat.org+-- copyright: +category: System+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10+source-repository head+ type: git+ location: https://git.alokat.org/hpg/++executable hpg+ main-is: Main.hs+ ghc-options: -Wall + -fwarn-tabs + -fwarn-incomplete-record-updates+ -fwarn-monomorphism-restriction + -fwarn-unused-do-bind + -- other-modules: + -- other-extensions: + build-depends: base >=4.8 && <4.9,+ random+ -- pledge(2)+ if os(openbsd)+ build-depends: unix ++ hs-source-dirs: src+ default-language: Haskell2010
+ src/Main.hs view
@@ -0,0 +1,151 @@+{-|+ Copyright (c) 2017 Fritjof Bornebusch <fritjof@alokat.org>+ + Permission to use, copy, modify, and distribute this software for any+ purpose with or without fee is hereby granted, provided that the above+ copyright notice and this permission notice appear in all copies.+ + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES+ WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF+ MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR+ ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES+ WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN+ ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF+ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.+-}++{-# LANGUAGE CPP #-}++import System.Console.GetOpt+import System.Environment (getArgs)+import System.Exit (exitFailure, exitSuccess)+import System.IO (stdout, stderr, hFlush, hPutStr)+#ifdef openbsd_HOST_OS+import System.OpenBSD.Process (pledge)+#endif +import System.Random (randomRIO)++exit_with_message :: String -> IO ()+exit_with_message msg = do+ hPutStr stderr (msg ++ "\n")+ exitFailure++upperCaseLettersList :: [Char]+upperCaseLettersList = ['A'..'Z']++lowerCaseLettersList :: [Char]+lowerCaseLettersList = ['a'..'z']++numbersList :: [Char]+numbersList = ['0'..'9']++specialCharactersList :: [Char]+specialCharactersList = ['!'..'/'] ++ [':'..'@'] ++ ['['..'_'] ++ ['{'..'~']++data Options = Options { optUpperCaseFlag :: Bool+ ,optLowerCaseFlag :: Bool+ ,optNumbersFlag :: Bool+ ,optSpecialCharactersFlag :: Bool+ ,optLengthValue :: Int+ }++startOptions :: Options+startOptions = Options { optUpperCaseFlag = False+ , optLowerCaseFlag = False + , optNumbersFlag = False+ , optSpecialCharactersFlag = False+ , optLengthValue = 16+ }++options :: [ OptDescr (Options -> IO Options) ]+options =+ [ Option "u" []+ (NoArg+ (\opt -> return opt { optUpperCaseFlag = True }))+ "upper case letters"+ + , Option "l" []+ (NoArg+ (\opt -> return opt { optLowerCaseFlag = True }))+ "lower case letters"+ + , Option "n" []+ (NoArg+ (\opt -> return opt { optNumbersFlag = True }))+ "numbers"+ + , Option "s" [] + (NoArg+ (\opt -> return opt { optSpecialCharactersFlag = True }))+ "special signs"+ + , Option "x" []+ (ReqArg+ (\arg opt -> return opt { optLengthValue = read arg })+ "number")+ "password length"+ ]+++parse :: [String] -> IO ([Options -> IO Options], [String])+parse args =+ case getOpt RequireOrder options args of+ (actions, nonOptions,[]) -> return (actions, nonOptions)+ (_,_,errors) -> ioError (userError (concat errors ++ header)) + where header = "usage: hpg [-ulns]\n" ++ + " [-x number]"++randomList :: Int -> [Char] -> IO([Int])+randomList 0 _ = return []+randomList n list = do+ let l = length list+ r <- randomRIO (0, l-1)+ rs <- randomList (n-1) list+ return (r:rs)++create_password :: Int -> [Bool] -> IO [Char]+create_password lengthValue flags = do+ let l = create_signs [upperCaseLettersList,+ lowerCaseLettersList,+ numbersList,+ specialCharactersList] flags++ rl <- randomList lengthValue l+ return [l !! i | i <- rl]++add_signs :: [Char] -> ([Char], Bool) -> [Char] +add_signs list (l, True) = list ++ l+add_signs list (_, False) = list++create_signs :: [[Char]] -> [Bool] -> [Char]+create_signs signs [False, False, False, False] = do+ -- default values are upper case and lower case letters+ create_signs signs [True, True, False, False]++create_signs signs flags = do+ let z = zip signs flags+ foldl (\x y -> add_signs x y) [] z++main :: IO ()+main = do+#ifdef openbsd_HOST_OS+ pledge (Just "stdio") Nothing+#endif+ (actions, _nonOptions) <- getArgs >>= parse+ opts <- foldl (>>=) (return startOptions) actions+ let Options { optUpperCaseFlag = upperCase+ , optLowerCaseFlag = lowerCase+ , optNumbersFlag = numbers+ , optSpecialCharactersFlag = specialCharacters+ , optLengthValue = lengthValue } = opts++ if lengthValue > 2^(16::Int)+ then exit_with_message "password too long"+ else do+ pwd <- create_password lengthValue [upperCase,+ lowerCase,+ numbers,+ specialCharacters]+ hPutStr stdout (pwd ++ "\n")+ hFlush stdout+ exitSuccess