diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Moritz Schulte (c) 2015, 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Moritz Schulte nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Tahin.cabal b/Tahin.cabal new file mode 100644 --- /dev/null +++ b/Tahin.cabal @@ -0,0 +1,41 @@ +name: Tahin +version: 0.1.2 +synopsis: Tahin Password Generator +description: Please see README.md +homepage: http://github.com/mtesseract/Tahin#readme +license: BSD3 +license-file: LICENSE +author: Moritz Schulte +maintainer: mtesseract@silverratio.net +copyright: Moritz Schulte +category: Password +build-type: Simple +cabal-version: >=1.10 + +executable tahin + hs-source-dirs: src + ghc-options: -Wall + main-is: Main.hs + default-language: Haskell2010 + build-depends: base >= 4.7 && < 5 + , base64-bytestring >= 1.0.0.1 + , bytestring >= 0.10.6.0 + , containers >= 0.5.6.2 + , cryptohash + , haskeline + , mtl >= 2.2.1 + , optparse-applicative >= 0.11.0.2 + , text >= 1.2.2.0 + other-modules: Crypto.Tahin + , Paths_Tahin + +Library + hs-source-dirs: src + ghc-options: -Wall + default-language: Haskell2010 + Exposed-modules: Crypto.Tahin + build-depends: base >= 4.7 && < 5 + , base64-bytestring >= 1.0.0.1 + , bytestring >= 0.10.6.0 + , text >= 1.2.2.0 + diff --git a/src/Crypto/Tahin.hs b/src/Crypto/Tahin.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/Tahin.hs @@ -0,0 +1,41 @@ +-- Tahin +-- Copyright (C) 2015-2016 Moritz Schulte + +{-# LANGUAGE OverloadedStrings #-} + +module Crypto.Tahin ( TahinPassword + , TahinMasterPassword + , TahinIdentifier + , TahinTransformer + , tahin ) where + +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Char8 as BS8 +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Data.Text (Text) + +-- | TahinMasterPassword is used for holding a master password. +type TahinMasterPassword = Text + +-- | TahinPassword is used for passwords generated by Tahin. +type TahinPassword = Text + +-- | A TahinIdentifier is used for holding a '(service) identifier'. +type TahinIdentifier = Text + +-- | A 'TahinTransformer' is a function mapping a +-- 'TahinMasterPassword' together with a 'TahinIdentifier' to a +-- 'TahinPassword'. +type TahinTransformer = TahinMasterPassword -> TahinIdentifier -> TahinPassword + +------------------------- +-- Main tahin function -- +------------------------- + +-- | Given a hash function and a maximum length, return a +-- 'TahinTransformer'. +tahin :: (BS8.ByteString -> BS8.ByteString) -> Int -> TahinTransformer +tahin hash len = + curry (T.take len . TE.decodeUtf8 . B64.encode . hash . TE.encodeUtf8 . intercal) + where intercal (pw, identifier) = T.intercalate " " [pw, identifier] diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,291 @@ +-- Tahin +-- Copyright (C) 2015, 2016 Moritz Schulte + +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import qualified System.Console.Haskeline as HL +import qualified Data.Map as M +import System.Exit +import Options.Applicative +import Control.Exception +import Control.Monad.Identity (runIdentity) +import Control.Monad.Reader +import qualified Data.ByteString as BS +import qualified Crypto.Hash.SHA1 as SHA1 +import qualified Crypto.Hash.SHA224 as SHA224 +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Crypto.Hash.SHA384 as SHA384 +import qualified Crypto.Hash.SHA512 as SHA512 +import qualified Crypto.Hash.Tiger as Tiger +import qualified Crypto.Hash.Whirlpool as Whirlpool +import Data.Maybe +import Data.Version +import Data.Char +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import Data.Text (Text) +import Data.Typeable +import Paths_Tahin +import Crypto.Tahin + +-- | The type of a hash function; a hash function maps a ByteString to +-- a ByteString. +type HashFunction = BS.ByteString -> BS.ByteString + +-- | A Hash object contains a name and a HashFunction. +data Hash = + Hash { hashString :: String -- ^ Name of this hashing algorithm + , hashFunction :: HashFunction -- ^ The hash function + } + +-- | A TahinEnv contains the environment we pass down using the +-- ReaderT monad transformer. +data TahinEnv = TahinEnv { tahinEnvOptions :: TahinOptions } + +-- | The name of the program. +programName :: String +programName = "Tahin" + +-- | The version of the program. +programVersion :: String +programVersion = showVersion version + +-- | Short description of the program. +programDescriptionShort :: String +programDescriptionShort = "(Simple & Stupid) Password Generator" + +-- | Short description of the program. +programDescription :: String +programDescription = "Tahin generates a password by concatenating a 'master password' \ + \with an 'identifier', transforming this string with a hash \ + \function and finally base64-encode the resulting binary string." + +-- Define Tahin exceptions + +-- | Exception type used in Tahin. +data TahinException = + TahinExceptionNone -- ^ Exception value representing no + -- exception + | TahinExceptionString String -- ^ Exception value holding an error + -- message + deriving (Show, Typeable) + +-- | A 'NokeeException' is an 'Exception'. +instance Exception TahinException + +-- | Supported hashes. +hashes :: [Hash] +hashes = [ Hash "SHA1" SHA1.hash + , Hash "SHA224" SHA224.hash + , Hash "SHA256" SHA256.hash + , Hash "SHA384" SHA384.hash + , Hash "SHA512" SHA512.hash + , Hash "TIGER" Tiger.hash + , Hash "WHIRLPOOL" Whirlpool.hash ] + +-- | Supported hashes as a map, mapping their names to the respective +-- Hash values. +hashesMap :: M.Map String Hash +hashesMap = M.fromList $ map (\ hash@(Hash name _) -> (name, hash)) hashes + +-- | The default hash function used by Nokee. +defaultHash :: String +defaultHash = "SHA256" + +-- | The default maximum length of the base64 encoded bytestring. +defaultLength :: Int +defaultLength = 20 + +-- | Master password prompt. +defaultPromptMaster1 :: Text +defaultPromptMaster1 = "Master Password" + +-- | Master password prompt (retype). +defaultPromptMaster2 :: Text +defaultPromptMaster2 = "Master Password (retype)" + +-- | Identifier prompt. +defaultPromptIdentifier :: Text +defaultPromptIdentifier = "Identifier" + +-- | Displays a prompt and tries to read a password from the +-- terminal. Returns Maybe a String wrapped in IO. +readPassword :: Text -> ReaderT TahinEnv IO (Maybe Text) +readPassword prompt = liftIO $ + HL.runInputT HL.defaultSettings $ + fmap T.pack <$> HL.getPassword (Just '*') (T.unpack (T.concat [prompt, ": "])) + +-- | Displays a prompt and tries to read a password from the +-- terminal. On failure, throw an exception. +readPassword' :: Text -> String -> ReaderT TahinEnv IO Text +readPassword' prompt errMsg = do + maybePassword <- readPassword prompt + case maybePassword of + Just password -> return password + Nothing -> throw (TahinExceptionString errMsg) + +-- | Command Dispatcher. +commandDispatcher :: ReaderT TahinEnv IO () +commandDispatcher = do + cmds <- mapReaderT (return . runIdentity) extractCommands + let cmd = case cmds of + [] -> runTahin -- Default command is run Tahin. + [c] -> c -- If exactly one command is given, execute it. + _ -> + -- Fail, if multiple commands are given. + throw (TahinExceptionString "Multiple commands specified") + cmd + + where -- | This function usees commandSpec to compute the list of + -- specified commands. + extractCommands = do + maybeCmds <- forM commandSpec + (\ (cmdTest, cmdFunc) -> do + testRes <- cmdTest + if testRes + then return $ Just cmdFunc + else return Nothing) + return $ catMaybes maybeCmds + + -- | This defines the commands supported (besides the default + -- command) along with suitable test functions, which check if + -- the respective command is given. + commandSpec = + [ (optsVersion . tahinEnvOptions <$> ask, printVersion) + , (optsListHashes . tahinEnvOptions <$> ask, listHashes) ] + + +-- | This function is just a wrapper around the function 'runTahin', adding +-- exception handling. It gets called after arguments have been +-- parsed. +main' :: TahinOptions -> IO () +main' opts = do + let tahinEnv = TahinEnv { tahinEnvOptions = opts } + catch (runReaderT commandDispatcher tahinEnv) + (\ e -> case (e :: TahinException) of + TahinExceptionString s -> do putStrLn $ "Error: " ++ s + exitFailure + TahinExceptionNone -> return ()) + +-- | Print version information to stdout. +printVersion :: ReaderT TahinEnv IO () +printVersion = liftIO $ putStrLn $ programName ++ " " ++ programVersion + +-- | Print supported hashes to stdout. +listHashes :: ReaderT TahinEnv IO () +listHashes = do + let hashNames = map fst (M.toList hashesMap) + mapM_ (liftIO . putStrLn) hashNames + +-- | Try to lookup a hashing function by its name. +lookupHash :: String -> Maybe Hash +lookupHash hashName = M.lookup hashName' hashesMap + where hashName' = toUpperCase hashName + toUpperCase = map toUpper + +-- | May throw exceptions of type TahinException +lookupHash' :: String -> Hash +lookupHash' hashName = + let maybeHash = lookupHash hashName + in fromMaybe (throw (TahinExceptionString ("Unknown hash: " ++ hashName))) + maybeHash + +-- | This function implements the main program logic. May throw +-- TahinExceptions, they will be handled in the caller. +runTahin :: ReaderT TahinEnv IO () +runTahin = do + opts <- tahinEnvOptions <$> ask + let len = optsLength opts + hashName = map Data.Char.toUpper (optsHash opts) + hash = lookupHash' hashName + + -- Force evaluation in order to trigger hash-not-found exception now + -- in case the specified hash could not be found: + _ <- liftIO $ evaluate hash + + infoMessage $ "Using hash function " ++ hashName + infoMessage $ "Length is at most " ++ show len + + passwdMaster <- retrieveMasterPassword + passwdIdentifier <- readPassword' defaultPromptIdentifier errMsgRetrieveIdentifier + + let tahinPasswd = tahin (hashFunction hash) len passwdMaster passwdIdentifier + liftIO $ TIO.putStrLn tahinPasswd + + where errMsgRetrieveMasterPasswd = "Failed to retrieve master password" + errMsgRetrieveIdentifier = "Failed to retrieve password identifier" + + verifyPasswords pw1 pw2 = + if pw1 == pw2 + then return pw1 + else throw (TahinExceptionString "Password mismatch") + + retrieveMasterPassword = do + twice <- optsTwice . tahinEnvOptions <$> ask + if twice + then retrieveMasterPasswordTwice + else retrieveMasterPasswordOnce + + retrieveMasterPasswordOnce = + readPassword' defaultPromptMaster1 errMsgRetrieveMasterPasswd + + retrieveMasterPasswordTwice = do + master1 <- readPassword' defaultPromptMaster1 errMsgRetrieveMasterPasswd + master2 <- readPassword' defaultPromptMaster2 errMsgRetrieveMasterPasswd + verifyPasswords master1 master2 + +-- | Type holding the information about parsed arguments. +data TahinOptions = TahinOptions + { optsVersion :: Bool + , optsListHashes :: Bool + , optsVerbose :: Bool + , optsHash :: String + , optsLength :: Int + , optsTwice :: Bool + } + +-- | Print an informational if verbose is activated. +infoMessage :: String -> ReaderT TahinEnv IO () +infoMessage msg = do + opts <- tahinEnvOptions <$> ask + when (optsVerbose opts) $ + liftIO $ putStrLn ("[ " ++ msg ++ " ]") + +-- | The argument parser. +tahinOptions :: Parser TahinOptions +tahinOptions = TahinOptions + <$> switch + (long "version" + <> help "Display version information") + <*> switch + (long "list-hashes" + <> help "List supported hashes") + <*> switch + (long "verbose" + <> help "Enable verbose mode") + <*> strOption + (long "hash" + <> short 'h' + <> value defaultHash + <> metavar "HASH" + <> help "Specify which hash to use") + <*> option auto + (long "length" + <> value defaultLength + <> short 'l' + <> metavar "LENGTH" + <> help "Specify maximum length of the password to generate") + <*> switch + (long "twice" + <> short 't' + <> help "Ask twice for the master password (e.g. for setting new passwords)") + +-- | Main entry point. +main :: IO () +main = execParser opts >>= main' + where opts = info (helper <*> tahinOptions) + (fullDesc + <> progDesc programDescription + <> header (programName ++ " - " ++ programDescriptionShort))