diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,13 +1,14 @@ 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. +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. +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. + diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,25 +1,57 @@ -hpg -=== +HPG(1) - General Commands Manual -The hpg utility creates passwords of different sizes, between 1 and 2^16. -Please note that a length of < 8 is not very secure and should be avoided. -That is why the default value is 16 if the command is called without any -options. The default entropy contains [a-zA-Z0-9]. +# NAME --l Use lower case. +**hpg** - simple password generator --n Use numbers. +# SYNOPSIS --s Use symbols. +**hpg** +\[**-lnsu**] +\[**-x** *length*] --u Use upper case. +# DESCRIPTION --x Use another length, as the default one. +The +**hpg** +utility creates passwords of different sizes, between 1 and 2^16 signs. Please note that a +lenght of <8 is not very secure and should be avoided. That is why the default value is 16 +if the command is called without any options. The default entropy contains \[a-zA-Z0-9]. -EXAMPLES --------- +**-l** +> Use lower case. + +**-n** + +> Use numbers. + +**-s** + +> Use symbols. + +**-u** + +> Use upper case. + +**-x** + +> Use another length, as the default one. + +# EXIT STATUS + +The **hpg** utility exits 0 on success, and >0 if an error occurs. + +# EXAMPLES + Create a new random password: - + $ hpg -lnsu -x 32 +# COPYRIGHT + +Copyright © 2017 Fritjof Bornebusch +This is free software; see the file COPYING for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +OpenBSD 6.1 - March 21, 2017 diff --git a/hpg.cabal b/hpg.cabal --- a/hpg.cabal +++ b/hpg.cabal @@ -1,39 +1,47 @@ -- Initial hpg.cabal generated by cabal init. For further documentation, -- see http://haskell.org/cabal/users-guide/ -name: hpg -version: 0.4 -synopsis: no -description: the haskell password generator. -homepage: https://git.alokat.org/hpg -license: ISC -license-file: LICENSE -author: Fritjof Bornebusch -maintainer: fritjof@alokat.org --- copyright: -category: System -build-type: Simple +name: hpg +version: 0.5 +synopsis: password generator +description: the haskell password generator. +homepage: https://darcs.alokat.org/hpg +license: ISC +license-file: LICENSE +author: Fritjof Bornebusch +maintainer: fritjof@alokat.org +category: System +stability: Experimental +build-type: Simple +cabal-version: >=1.16 + extra-source-files: - README.md -cabal-version: >=1.10 + README.md + source-repository head - type: git - location: https://git.alokat.org/hpg/ + type: darcs + location: https://darcs.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) +flag warn-as-error + description: treat warnings as errors + default: False + manual: True + +executable hpg + main-is: hpg.hs + + -- use OpenBSDs pledge(2) if available if os(openbsd) - build-depends: unix + build-depends: unix >= 2.7.0.0 && < 2.8 - hs-source-dirs: src - default-language: Haskell2010 + build-depends: base >= 4.8 && < 4.10, + random >= 1.0.1.1 && < 1.2 + + hs-source-dirs: . + default-language: Haskell2010 + + if flag(warn-as-error) + ghc-options: -Werror + + ghc-options: -Wall + -fwarn-tabs diff --git a/hpg.hs b/hpg.hs new file mode 100644 --- /dev/null +++ b/hpg.hs @@ -0,0 +1,150 @@ +{-| + Copyright (c) 2017 Fritjof Bornebusch + + 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, True, 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 diff --git a/src/Main.hs b/src/Main.hs deleted file mode 100644 --- a/src/Main.hs +++ /dev/null @@ -1,151 +0,0 @@ -{-| - Copyright (c) 2017 Fritjof Bornebusch - - 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, True, 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