keystore 0.5.0.4 → 0.5.1.0
raw patch · 13 files changed
+1388/−57 lines, 13 filesdep +ansi-wl-pprintdep +processdep +setenvdep ~optparse-applicative
Dependencies added: ansi-wl-pprint, process, setenv
Dependency ranges changed: optparse-applicative
Files
- changelog +5/−0
- examples/deploy/Deploy/Command.hs +53/−19
- examples/deploy/Deploy/HostSectionKey.hs +48/−0
- examples/deploy/deploy.hs +48/−8
- keystore.cabal +22/−15
- src/Data/KeyStore.hs +3/−1
- src/Data/KeyStore/CLI.hs +2/−4
- src/Data/KeyStore/KS/Crypto.hs +13/−7
- src/Data/KeyStore/PasswordManager.hs +1019/−0
- src/Data/KeyStore/Sections.hs +5/−3
- src/Data/KeyStore/Types/PasswordStoreModel.hs +58/−0
- src/Data/KeyStore/Types/PasswordStoreSchema.hs +103/−0
- src/Data/KeyStore/Version.hs +9/−0
changelog view
@@ -66,3 +66,8 @@ 0.5.0.4 Chris Dornan <chrisd@irisconnect.co.uk> 2014-08-24 * improve diagnostics for internally used Sections.keySection * add roateIfChanged to Sections (squashes vacuous rotations)++0.5.1.0 Chris Dornan <chrisd@irisconnect.co.uk> 2014-09-08+ * fix the repo location in the cabal file+ * fix smart rotate to not rotate keys it cannot access+ * add password manager
examples/deploy/Deploy/Command.hs view
@@ -24,16 +24,18 @@ = Create | Rotate (Maybe HostID) (Maybe SectionID) (Maybe KeyID) | RotateSmart (Maybe HostID) (Maybe SectionID) (Maybe KeyID)- | Deploy (Maybe FilePath) HostID+ | Deploy Bool (Maybe FilePath) HostID+ | Client | Sign | Verify | ListHosts- | InfoKey (Maybe KeyID )- | InfoSection (Maybe SectionID)+ | InfoKey (Maybe KeyID )+ | InfoSection (Maybe SectionID) | SecretScript | PublicScript | SampleScript- | KS [String]+ | KS [String]+ | PM [String] deriving (Show) parseCLI :: IO CLI@@ -41,6 +43,7 @@ args <- getArgs case span is_flg args of (flgs,"ks":args') -> runParse (pi_cli $ p_ks args') flgs+ (flgs,"pm":args') -> runParse (pi_cli $ p_pm args') flgs _ -> runParse (pi_cli p_cli ) args pi_cli :: Parser CLI -> ParserInfo CLI@@ -52,6 +55,9 @@ p_ks :: [String] -> Parser CLI p_ks args = CLI <$> paramsParser <*> pure (KS args) +p_pm :: [String] -> Parser CLI+p_pm args = CLI <$> paramsParser <*> pure (PM args)+ p_cli :: Parser CLI p_cli = CLI <$> paramsParser <*> p_command @@ -62,6 +68,7 @@ <> command "rotate" (pi_rotate_key False) <> command "rotate-smart" (pi_rotate_key True ) <> command "deploy" pi_deploy+ <> command "client" pi_client <> command "sign" pi_sign <> command "verify" pi_verify <> command "list-hosts" pi_list_hosts@@ -69,8 +76,9 @@ <> command "info-section" pi_info_section <> command "secret-script" pi_secret_script <> command "public-script" pi_public_script- <> command "sample-script" pi_sample_script+ <> command "sample-load-script" pi_sample_script <> command "ks" pi_ks_args+ <> command "pm" pi_pm_args pi_create :: ParserInfo Command pi_create =@@ -91,10 +99,18 @@ pi_deploy :: ParserInfo Command pi_deploy = h_info- (helper <*> (Deploy <$> optional p_out <*> p_host_arg))- (progDesc $ "deploy a configuration file for s host " +++ (helper <*> (Deploy <$> p_shell_flg <*> optional p_out <*> p_host_arg))+ (progDesc $ "deploy a configuration file for a host " ++ "(here merely generating the JSON configuration file)") +pi_client :: ParserInfo Command+pi_client =+ h_info+ (helper <*> (pure Client))+ (progDesc $ "run a mock client " +++ "(here merely displays the session token)")++ pi_sign :: ParserInfo Command pi_sign = h_info@@ -122,7 +138,7 @@ pi_info_section :: ParserInfo Command pi_info_section = h_info- (helper <*> (InfoSection <$> optional p_section))+ (helper <*> (InfoSection <$> optional p_a_section)) (progDesc "get the gen on the keystore sections") pi_secret_script :: ParserInfo Command@@ -146,9 +162,21 @@ pi_ks_args :: ParserInfo Command pi_ks_args = h_info- (helper <*> (KS <$> many p_ks_arg))+ (helper <*> (KS <$> many p_arg)) (progDesc "run a ks command (see 'ks --help' for details)") +pi_pm_args :: ParserInfo Command+pi_pm_args =+ h_info+ (helper <*> (KS <$> many p_arg))+ (progDesc "run a pm command (see 'pm --help' for details)")++p_shell_flg :: Parser Bool+p_shell_flg =+ switch+ (long "shell" <>+ help "launch a shell with the deploy passwords setup in their environment variables")+ p_host_arg :: Parser HostID p_host_arg = argument decode@@ -171,26 +199,32 @@ <> reader (maybe (fail "section not recognised") return . decode) <> help "a section ID" +p_a_section :: Parser SectionID+p_a_section =+ argument decode+ $ metavar "SECTION"+ <> help "a section ID"+ p_key :: Parser KeyID p_key = nullOption- $ long "key"- <> metavar "KEY"+ $ long "key"+ <> metavar "KEY" <> reader (maybe (fail "key not recognised") return . decode)- <> help "a key ID"+ <> help "a key ID" p_out :: Parser FilePath p_out = strOption- $ long "out"- <> metavar "FILE"- <> help "output file"+ $ long "out"+ <> metavar "FILE"+ <> help "output file" -p_ks_arg :: Parser String-p_ks_arg =+p_arg :: Parser String+p_arg = argument Just- $ metavar "KS-ARG"- <> help "a ks command argument"+ $ metavar "ARG"+ <> help "a sub-command argument" h_info :: Parser a -> InfoMod a -> ParserInfo a h_info pr = info (helper <*> pr)
examples/deploy/Deploy/HostSectionKey.hs view
@@ -36,6 +36,7 @@ | S_us_deploy | S_us_staging | S_dev+ | S_session deriving (Show, Ord, Eq, Bounded, Enum) dev, staging, deploy, admin :: SectionID -> Bool@@ -106,6 +107,7 @@ S_us_deploy -> [S_us_admin ] S_us_staging -> [S_us_deploy ] S_dev -> [S_eu_staging,S_us_staging]+ S_session -> [S_dev ] key_is_host_indexed :: KeyID -> Maybe (HostID->Bool) key_is_host_indexed k =@@ -193,6 +195,7 @@ S_us_deploy -> "has access to all of the keys needed for the 'us' live server deployment" S_us_staging -> "has access to all of the keys needed for the 'us' staging server deployment" S_dev -> "contains all of the keys needed to deploy a development server"+ S_session -> "this section does not contain any keys (the section is needed for the password manager)" is_ssl :: HostID -> Bool is_ssl h =@@ -202,3 +205,48 @@ H_live_us -> True H_staging_us -> True H_dev -> False+++--+-- Password Manager Definitions+--++instance PW SectionID where++ pwName = PasswordName . T.pack . encode++ isSession sid = case sid of+ S_session -> Just extract_ssn+ _ -> Nothing++ isOneShot sid = case sid of+ S_top -> True+ S_eu_admin -> True+ S_eu_deploy -> True+ S_us_admin -> True+ S_us_deploy -> True+ _ -> False++ summarize s =+ case s of+ S_top -> "top key: accesses everything"+ S_signing -> "keystore signing key"+ S_eu_admin -> "eu admin keys"+ S_eu_deploy -> "eu deploy keys"+ S_eu_staging -> "eu staging deployment keys"+ S_us_admin -> "us admin keys"+ S_us_deploy -> "us deploy keys"+ S_us_staging -> "us staging keys"+ S_dev -> "dev deployment keys"+ S_session -> "client sessions tokens"++ describe = describe_section++extract_ssn :: PasswordText -> Either String SessionDescriptor+extract_ssn (PasswordText pwt) = Right $+ SessionDescriptor+ { _sd_name = snm+ , _sd_isOneShot = snm=="master"+ }+ where+ snm = SessionName $ T.takeWhile (/= ':') pwt
examples/deploy/deploy.hs view
@@ -9,11 +9,15 @@ import Deploy.Command import Deploy.HostSectionKey import Data.KeyStore+import Data.API.Types import Data.KeyStore as KS import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.Text as T import qualified Data.Text.IO as T import System.IO+import System.Environment+import System.Process import Control.Applicative import Control.Exception @@ -22,18 +26,38 @@ ks_fp = "deploy-keystore.json" ks_mac_fp = "deploy-keystore.hash" +pmc :: PMConfig SectionID+pmc =+ PMConfig+ { _pmc_location = "pwstore.dat"+ , _pmc_env_var = "DEPLOY_MASTER"+ , _pmc_keystore_msg = "keystore not found (use 'deploy pm setup' to set one up)"+ , _pmc_password_msg = "not logged into the password manager (use 'deploy pm login')"+ , _pmc_shell = interactive_shell+ , _pmc_hash_descr = defaultHashDescription $ Salt $ Binary "MX#0YoSCt8RcWm&E"+ , _pmc_allow_dumps = True+ , _pmc_dump_prefix = dump_pfx+ , _pmc_sample_script = Just $ defaultSampleScript (PW_ :: PW_ SectionID) dump_pfx+ }+ where+ dump_pfx = "deploy pm"+ main :: IO () main = do CLI{..} <- parseCLI let cp0 = cli_params cp = cp0 { cp_store = cp_store cp0 <|> Just ks_fp } case cli_command of- Create -> initialise cp no_keys- ListHosts -> mapM_ (putStrLn . encode) $ [minBound..maxBound :: HostID]- SampleScript -> mapM_ sample_ln [minBound..maxBound]- KS args -> KS.cli' (Just cp) args- _ ->- do ic <- instanceCtx cp+ Create -> collect pmc create_cc >> initialise cp no_keys+ ListHosts -> mapM_ (putStrLn . encode) $ [minBound..maxBound :: HostID]+ SampleScript -> mapM_ sample_ln [minBound..maxBound]+ KS args -> collect pmc deploy_cc >> KS.cli' (Just cp) args+ PM args -> passwordManager pmc args+ _ ->+ do case cli_command of+ Client -> collect pmc client_cc+ _ -> collect pmc deploy_cc+ ic <- instanceCtx cp let ic_ro = ic { ic_ctx_params = cp {cp_readonly = cp_readonly cp <|> Just True} } case cli_command of Sign -> return ()@@ -42,7 +66,9 @@ Create -> error "main: Initialise" Rotate mbh mbs mbk -> rotate ic $ key_prededicate mbh mbs mbk RotateSmart mbh mbs mbk -> rotateIfChanged ic $ key_prededicate mbh mbs mbk- Deploy mb hst -> deploy ic_ro hst >>= write mb+ Deploy False mb hst -> deploy ic_ro hst >>= write mb+ Deploy True _ _ -> interactive_shell+ Client -> lookupEnv "KEY_pw_session" >>= putStrLn . ("session-token=>" ++) . maybe "NONE" id Sign -> sign_ks ic_ro Verify -> T.putStrLn "the keystore matches the signature" ListHosts -> error "main: ListHosts"@@ -52,8 +78,14 @@ PublicScript -> publicKeySummary ic sections ks_mac_fp >>= T.putStr SampleScript -> error "main: SampleScript" KS _ -> error "main: KS"+ PM _ -> error "main: PM" verify_ks False ic_ro +create_cc, deploy_cc, client_cc :: CollectConfig SectionID+create_cc = CollectConfig True [minBound..maxBound]+deploy_cc = CollectConfig True $ filter (/=S_session) [minBound..maxBound]+client_cc = CollectConfig False [S_session]+ sign_ks :: IC -> IO () sign_ks ic = signKeystore ic sections >>= B.writeFile ks_mac_fp @@ -76,9 +108,17 @@ key_prededicate = keyPrededicate sample_ln :: SectionID -> IO ()-sample_ln s = putStrLn $ "export " ++ "KEY_pw_" ++ s_ ++ "=pw_" ++ s_ ++ ";"+sample_ln s = putStrLn $ "export " ++ v_ ++ "=secret-" ++ s_ ++ ";" where+ v_ = T.unpack $ _EnvVar $ enVar s s_ = encode s++interactive_shell :: IO ()+interactive_shell = do+ sh <- maybe "/bin/bash" id <$> lookupEnv "SHELL"+ putStrLn $ "launching password-manager shell => " ++ sh+ callProcess sh ["-i"]+ putStrLn "password-manager shell done" write :: Maybe FilePath -> LBS.ByteString -> IO () write = maybe LBS.putStrLn LBS.writeFile
keystore.cabal view
@@ -1,5 +1,5 @@ Name: keystore-Version: 0.5.0.4+Version: 0.5.1.0 Synopsis: Managing stores of secret things Homepage: http://github.com/cdornan/keystore Author: Chris Dornan@@ -88,9 +88,9 @@ * /External Crypto Operations/: keys in the keystore can be used to sign or encrypt external obejcts (provided they can be loaded into memory). .- /The Onion/+ /The Layers/ .- Perhaps apropriately, the keystore package has several layers. Most users+ The keystore package has several layers. Most users will probably need only the top "batteries-included" layer: . * @Data.KeyStore.Sections@: this provides a high-level model that allows@@ -101,6 +101,10 @@ and editing your keystores. It can also be embedded into your own deployment app. See the @deploy@ example for details. .+ * @Data.KeyStore.PasswordManager@ provides a password manager which each+ user can use to setup their own local password store for holding the+ deployment passwords and session tokens used to autheticate the server.+ . * @Data.KeyStore.IO@: this library provides general programatic access to a keystore through @IO@ primitives. See the source code for the @Sections@ for an example of this module in use.@@ -116,20 +120,13 @@ . See the bottom <https://github.com/cdornan/keystore#launch-instructions README> on GitHub home page for launch instructions for the deploy example.- .- /0.5 Migration instructions/- .- The formation of the names used in 'Data.Keystore.Sections' derived keystores- has changed to fix an issue (#3) that barred hosts, sections and key identifiers- from being prefixes of each other. See the changelog for details, especially- on how to ensure that an existing Sections-based keystore gets migrated properly. Extra-source-files: changelog Cabal-version: >= 1.14 Source-repository head type: git- location: https://github.com/iconnect/keystore+ location: https://github.com/cdornan/keystore flag hpc default: False@@ -153,16 +150,21 @@ Data.KeyStore.KS.KS Data.KeyStore.KS.Opt Data.KeyStore.KS.Packet+ Data.KeyStore.PasswordManager Data.KeyStore.Sections Data.KeyStore.Types Data.KeyStore.Types.E Data.KeyStore.Types.NameAndSafeguard+ Data.KeyStore.Types.PasswordStoreModel+ Data.KeyStore.Types.PasswordStoreSchema Data.KeyStore.Types.Schema+ Data.KeyStore.Version Build-depends: api-tools >= 0.4 , asn1-types >= 0.2.0 , asn1-encoding >= 0.8.0 ,+ ansi-wl-pprint >= 0.6.7 , crypto-pubkey >= 0.2.1 , crypto-random >= 0.0.7 , aeson >= 0.6.2 ,@@ -178,10 +180,11 @@ lens >= 3.9.2 , mtl >= 2 , old-locale >= 1.0.0.5 ,- optparse-applicative >= 0.9.0 ,+ optparse-applicative >= 0.9.0 && <0.10 , pbkdf >= 1.1.1.0 , regex-compat-tdfa >= 0.95.1 , safe >= 0.3.3 ,+ setenv >= 0.1 , text >= 0.11.3 , time >= 1.4 , unordered-containers >= 0.2.3.0 ,@@ -190,7 +193,7 @@ Default-Language: Haskell2010 GHC-Options:- -fwarn-tabs+ -Wall -fno-warn-warnings-deprecations Executable ks@@ -205,7 +208,7 @@ keystore GHC-Options:- -fwarn-tabs+ -Wall -fno-warn-warnings-deprecations Executable deploy Hs-Source-Dirs: examples/deploy@@ -220,6 +223,8 @@ Deploy.HostSectionKey Build-depends:+ api-tools >= 0.4 ,+ ansi-wl-pprint >= 0.6.7.1 , aeson >= 0.6.2 , base > 4 && < 5 , bytestring >= 0.9 ,@@ -228,9 +233,11 @@ keystore , mtl >= 2 , optparse-applicative >= 0.9.0 ,+ process >= 1.2.0.0 , raw-strings-qq >= 1.0.2 , text >= 0.11 , unordered-containers >= 0.2.3.0 + GHC-Options:- -fwarn-tabs+ -Wall -fno-warn-warnings-deprecations
src/Data/KeyStore.hs view
@@ -2,8 +2,10 @@ ( module Data.KeyStore.CLI , module Data.KeyStore.IO , module Data.KeyStore.Sections+ , module Data.KeyStore.PasswordManager ) where -import Data.KeyStore.Sections import Data.KeyStore.CLI import Data.KeyStore.IO+import Data.KeyStore.Sections+import Data.KeyStore.PasswordManager
src/Data/KeyStore/CLI.hs view
@@ -10,6 +10,7 @@ import Data.KeyStore.IO import Data.KeyStore.KS.Opt import Data.KeyStore.CLI.Command+import Data.KeyStore.Version import qualified Data.Text.IO as T import qualified Data.ByteString.Char8 as B import Control.Applicative@@ -17,9 +18,6 @@ import System.Exit -version :: String-version = "0.5.0.4"- cli :: IO () cli = parseCLI >>= command Nothing @@ -80,7 +78,7 @@ - oops = error "command: this ic should ne be used"+ oops = error "command: this ic should not be used" create :: IC -> Name
src/Data/KeyStore/KS/Crypto.hs view
@@ -5,7 +5,9 @@ {-# LANGUAGE BangPatterns #-} module Data.KeyStore.KS.Crypto- ( defaultEncryptedCopyKS+ ( sizeAesIV+ , sizeOAE+ , defaultEncryptedCopyKS , saveKS , restoreKS , mkAESKeyKS@@ -28,6 +30,7 @@ , randomAESKeyKS , randomIVKS , hashKS+ , defaultHashParams , defaultHashParamsKS , hashKS_ , generateKeysKS@@ -61,9 +64,9 @@ import Crypto.Cipher.AES -size_aes_iv, size_oae :: Octets-size_aes_iv = 16-size_oae = 256+sizeAesIV, sizeOAE :: Octets+sizeAesIV = 16+sizeOAE = 256 --@@ -193,8 +196,8 @@ decodeRSASecretData_ :: B.ByteString -> E RSASecretData decodeRSASecretData_ dat0 =- do (eky,dat1) <- slice size_oae dat0- (iv ,edat) <- slice size_aes_iv dat1+ do (eky,dat1) <- slice sizeOAE dat0+ (iv ,edat) <- slice sizeAesIV dat1 return RSASecretData { _rsd_encrypted_key = RSAEncryptedKey $ Binary eky@@ -280,7 +283,7 @@ randomAESKeyKS cip = randomBytes (keyWidth cip) (AESKey . Binary) randomIVKS :: KS IV-randomIVKS = randomBytes size_aes_iv (IV . Binary)+randomIVKS = randomBytes sizeAesIV (IV . Binary) --@@ -290,6 +293,9 @@ hashKS :: ClearText -> KS Hash hashKS ct = flip hashKS_ ct <$> defaultHashParamsKS++defaultHashParams :: HashDescription+defaultHashParams = trun defaultHashParamsKS defaultHashParamsKS :: KS HashDescription defaultHashParamsKS =
+ src/Data/KeyStore/PasswordManager.hs view
@@ -0,0 +1,1019 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Data.KeyStore.PasswordManager+ ( PMConfig(..)+ , PW(..)+ , PW_(..)+ , SessionDescriptor(..)+ , CollectConfig(..)+ , defaultCollectConfig+ , Password(..)+ , PasswordName(..)+ , PasswordText(..)+ , SessionName(..)+ , EnvVar(..)+ , passwordManager+ , defaultHashDescription+ , defaultSampleScript+ , hashMasterPassword+ , bindMasterPassword+ , setup+ , passwordValid+ , isStorePresent+ , amLoggedIn+ , isBound+ , load+ , psComment+ , collect+ , prime+ , select+ , deletePassword+ , deleteSession+ , status+ , passwords+ , sessions+ , infoPassword+ , infoPassword_+ , dump+ , collectShell+ ) where++import Data.KeyStore.Types.PasswordStoreModel+import Data.KeyStore.Types+import Data.KeyStore.KS.Crypto+import Data.KeyStore.KS.CPRNG+import Data.KeyStore.Version+import qualified Data.Aeson as A+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Base64 as B64+import qualified Data.Text as T+import qualified Data.Map as Map+import Data.Time+import Data.Monoid+import Data.API.Types+import Data.API.JSON+import Data.Maybe+import qualified Text.PrettyPrint.ANSI.Leijen as P+import Text.Printf+import qualified Control.Lens as L+import Control.Applicative+import Control.Exception+import Control.Monad+import System.Directory+import System.Environment+import System.Exit+import System.IO+import System.Locale+import qualified Options.Applicative as O+import Options.Applicative+++-- | The password manager is used for storing locally the passwords and session+-- tokens of a single user. The password used to encode the store is stored in+-- an environment variable and the passwords and tokens are stored in a file.+-- The file and and environment cariable are specified in the 'PWConfig' record.+-- (The attributes of each password and session list, including the environment+-- variables that they are communicated through, is statically specified+-- with the PW class below.)++data PMConfig p =+ PMConfig+ { _pmc_location :: FilePath -- ^ file in which to store the encrypted passords+ , _pmc_env_var :: EnvVar -- ^ the environmant variable containing the master password used to secure the store+ , _pmc_keystore_msg :: String -- ^ error message to be used on failure to locate the keystore+ , _pmc_password_msg :: String -- ^ error message to be used on failure to locate the master password+ , _pmc_shell :: IO () -- ^ for firing up an interactive shell on successful login+ , _pmc_hash_descr :: HashDescription+ -- ^ for generating has descriptions (can use 'defaultHashDescription' here)+ , _pmc_allow_dumps :: Bool -- ^ must be true to enable 'dump' commands+ , _pmc_dump_prefix :: String -- ^ the prefix string to be used in making up the commands from dump scripts+ , _pmc_sample_script :: Maybe String -- ^ the sample script+ }++-- | The PW class provides all of the information on the bounded enumeration type used to identify the passwords+class (Bounded p,Enum p,Eq p, Ord p,Show p) => PW p where+ -- | the name by which the password is known+ pwName :: p -> PasswordName+ pwName = PasswordName . T.pack . show+ -- | parse a PasswordName into a p+ parsePwName :: PasswordName -> Maybe p+ parsePwName = \pnm -> listToMaybe [ p | p<-[minBound..maxBound], pwName p == pnm ]+ -- | whether the passwords is a session and if so a function for extracting the session name from the secret password text+ isSession :: p -> Maybe (PasswordText -> Either String SessionDescriptor)+ isSession = const Nothing+ -- | whether the password is a one-shot password, needing to be primed to be used+ isOneShot :: p -> Bool+ isOneShot = const False+ -- | the environment variable where the password is expected to be found by the client/deployment scripts+ enVar :: p -> EnvVar+ enVar = EnvVar . (T.append "KEY_pw_") . _PasswordName . pwName+ -- | a brief description of the password in a few words+ summarize :: p -> String+ summarize _ = ""+ -- | a description of the password+ describe :: p -> String+ describe p = (T.unpack $ _PasswordName $ pwName p) ++ ": description to follow"++-- | we resort to phantom types when we have no other way of passing PW into a+-- function (see 'defaultSampleScript')+data PW_ p = PW_++cast_pmc :: PMConfig p -> p -> p+cast_pmc _ p = p++cast_pw :: PW_ p -> p -> p+cast_pw _ p = p++-- each session is named and may be a one-shot session+data SessionDescriptor =+ SessionDescriptor+ { _sd_name :: SessionName+ , _sd_isOneShot :: Bool+ }+ deriving (Show)++-- | the client calls 'collect' to bind the passwords into the environment+data CollectConfig p =+ CollectConfig+ { _cc_optional :: Bool -- ^ if True , collect will not report an error if the master password is missing+ , _cc_active :: [p] -- ^ the list of active passwords for this collection+ }++-- | raise an error if not logged in and collect all of the passwords+defaultCollectConfig :: PW p => CollectConfig p+defaultCollectConfig =+ CollectConfig+ { _cc_optional = True+ , _cc_active = [minBound..maxBound]+ }++-- | the password manager CLI: it just needs the config and command line+passwordManager :: PW p => PMConfig p -> [String] -> IO ()+passwordManager pmc args = do+ pmcd <- parse_command pmc args+ case pmcd of+ PMCD_version -> putStrLn version+ PMCD_setup nl mb_t -> setup pmc nl mb_t+ PMCD_login y mb_t -> login pmc y mb_t+ PMCD_load p mb_t -> load pmc p mb_t+ PMCD_comment cmt -> psComment pmc cmt+ PMCD_prime u p -> prime pmc u $ Just p+ PMCD_prime_all u -> prime pmc u Nothing+ PMCD_select mb snm -> select pmc mb snm+ PMCD_delete_password p -> deletePassword pmc p+ PMCD_delete_session mb snm -> deleteSession pmc mb snm+ PMCD_status q -> status pmc q+ PMCD_passwords b -> passwords pmc b+ PMCD_sessions a b mb -> sessions pmc a b mb+ PMCD_info s p -> infoPassword pmc s p+ PMCD_dump s -> dump pmc s+ PMCD_collect -> collectShell pmc+ PMCD_sample_script -> putStr $ maybe "" id $ _pmc_sample_script pmc++-- | a sample 'HashDescription' generator to help with setting up 'PMConfig'+defaultHashDescription :: Salt -> HashDescription+defaultHashDescription st =+ HashDescription+ { _hashd_comment = "PM master password"+ , _hashd_prf = PRF_sha512+ , _hashd_iterations = 5000+ , _hashd_width_octets = 32+ , _hashd_salt_octets = Octets $ B.length $ _Binary $ _Salt st+ , _hashd_salt = st+ }++-- | sample sample-script generator to help with setting up 'PMConfig'+defaultSampleScript :: PW p => PW_ p -> String -> String+defaultSampleScript pw_ pfx = format_dump pfx cmt (map f [minBound..maxBound]) []+ where+ f p = (,) p $ PasswordText $ "secret-" `T.append` _PasswordName (pwName $ cast_pw pw_ p)++ cmt = PasswordStoreComment $ T.pack "loaded by the sample script"++-- | hashing the master password to create the private key for securing the store+hashMasterPassword :: PW p => PMConfig p -> String -> PasswordText+hashMasterPassword PMConfig{..} pw =+ PasswordText $ T.pack $ B.unpack $+ B64.encode $ _Binary $ _HashData $ _hash_hash $+ hashKS_ _pmc_hash_descr $ ClearText $ Binary $ B.pack pw++-- | bind the master password in the environment+bindMasterPassword :: PW p => PMConfig p -> PasswordText -> IO ()+bindMasterPassword PMConfig{..} = set_env _pmc_env_var++-- | create an empty passowrd store; if the boolean flag is False then+-- an interactive shell is fired up with access to the new store;+-- if no password is specified then one is read from stdin+setup :: PW p+ => PMConfig p+ -> Bool -- ^ => don't fire up an interactive shell with access to the new store+ -> Maybe PasswordText -- ^ the master password+ -> IO ()+setup pmc no_li mb_pwt = do+ -- check there isn't a store there already+ ex <- doesFileExist _pmc_location+ when ex $ error $ "password store already exists in: " ++ _pmc_location+ -- get a password from stdin if we have not been passed one+ pwt <- maybe (get_pw pmc) return mb_pwt+ -- need creation time and comment+ now <- getCurrentTime+ let ps =+ PasswordStore+ { _ps_comment = PasswordStoreComment $ T.pack $ "Created at " ++ show now+ , _ps_map = Map.empty+ , _ps_setup = now+ }+ -- write out the new store+ save_ps pmc (mk_aek pwt) ps+ when (not no_li) $ login pmc False $ Just pwt+ where+ PMConfig{..} = pmc++-- | launch an interactive shell with access to the password store; if the bool+-- boolean flag is True then it will loop asking for the passwoord until the+-- correct password is typed (or an error ocurrs, possibly from a SIGint);+-- if no 'PasswordText' is specified then one will be read from stdin+login :: PW p => PMConfig p -> Bool -> Maybe PasswordText -> IO ()+login pmc y mb = do+ pwt <- maybe (get_pw pmc) return mb+ ok <- passwordValid pmc pwt+ case ok of+ True -> bindMasterPassword pmc pwt >> good >> _pmc_shell pmc+ False -> bad >> login pmc y Nothing+ where+ good = putStr "*** Login Successful ***\n"+ bad = bad_f "*** Password Invalid ***\n"+ bad_f = if y then putStr else error++-- | is this the correct master password?+passwordValid :: PW p => PMConfig p -> PasswordText -> IO Bool+passwordValid pmc = password_valid pmc . mk_aek++-- | is the password store there?+isStorePresent :: PW p => PMConfig p -> IO Bool+isStorePresent PMConfig{..} = doesFileExist _pmc_location++-- | are we currently logged in?+amLoggedIn :: PW p => PMConfig p -> IO Bool+amLoggedIn pmc = get_key pmc >>= password_valid pmc++-- | is the password/session bound to a value in the store?+isBound :: PW p => PMConfig p -> p -> Maybe SessionName -> IO Bool+isBound pmc p mb = enquire pmc $ \ps -> return $+ case Map.lookup (pwName p) $ _ps_map ps of+ Nothing -> False+ Just Password{..} -> maybe True (\snm->Map.member snm $ _pw_sessions) mb++-- | loads a password into the store; if this is a session password and the+-- boolean ss is True then the session will be reset to this password also;+-- if no 'PasswordText' is specified then one will be read from stdin+load :: PW p => PMConfig p -> p -> Maybe PasswordText -> IO ()+load pmc p mb = wrap pmc $ \ps -> do+ pwt <- maybe (get_pw pmc) return mb+ now <- getCurrentTime+ case isSession p of+ Nothing -> load_pwd ps+ Password+ { _pw_name = pnm+ , _pw_text = pwt+ , _pw_sessions = Map.empty+ , _pw_isOneShot = isOneShot p+ , _pw_primed = False+ , _pw_setup = now+ }+ Just ext ->+ case ext pwt of+ Left err -> ssn_error $ "failed to load session: " ++ err+ Right sd -> load_ssn now ps pwt sd+ where+ load_ssn now ps pwt SessionDescriptor{..} =+ load_pwd ps $+ L.set pw_text pwt $+ L.over pw_sessions (Map.insert _sd_name ssn) $+ L.set pw_isOneShot ios $+ pw+ where+ pw = maybe pw0 id $ Map.lookup pnm $ _ps_map ps+ pw0 =+ Password+ { _pw_name = pnm+ , _pw_text = pwt+ , _pw_sessions = Map.empty+ , _pw_isOneShot = ios+ , _pw_primed = False+ , _pw_setup = now+ }++ ssn =+ Session+ { _ssn_name = _sd_name+ , _ssn_password = pwt+ , _ssn_isOneShot = ios+ , _ssn_setup = now+ }++ ios = _sd_isOneShot++ load_pwd ps pw = return $ Just $ L.over ps_map (Map.insert pnm pw) ps++ pnm = pwName p++-- | set the comment for the password store+psComment :: PW p => PMConfig p -> PasswordStoreComment -> IO ()+psComment pmc cmt = wrap pmc $ \ps -> return $ Just $ L.set ps_comment cmt ps++-- | collect the available passwords listed in 'CollectConfig' from the store+-- and bind them in their designated environmants variables+collect :: PW p => PMConfig p -> CollectConfig p -> IO ()+collect pmc CollectConfig{..} = wrap_ pmc $ \ps -> do+ -- set up the environment+ mapM_ (clct pmc ps) _cc_active+ -- now clear down all of the primed passwords+ return $ Just $ L.over ps_map (Map.map (L.set pw_primed False)) ps+ where+ clct :: PW p => PMConfig p -> PasswordStore -> p -> IO ()+ clct _ ps p = case Map.lookup (pwName p) $ _ps_map ps of+ Just pw | is_primed pw -> set_env (enVar p) (_pw_text pw)+ _ -> return ()++ wrap_ = if _cc_optional then wrap_def else wrap++-- | prime a one-shot password so that it will be availabe on the next collection (probably for a deployment);+-- if no password is specified then they are all primed+prime :: PW p => PMConfig p -> Bool -> Maybe p -> IO ()+prime pmc u Nothing = wrap pmc $ \ps -> return $ Just $ L.over ps_map (Map.map (L.set pw_primed $ not u) ) ps+prime pmc u (Just p) = wrap pmc $ \ps -> return $ Just $ L.over ps_map (Map.adjust (L.set pw_primed $ not u) (pwName p)) ps++-- | select a different session for use+select :: PW p => PMConfig p -> Maybe p -> SessionName -> IO ()+select pmc mb snm = wrap pmc $ \ps -> f ps <$> lookup_session mb snm ps+ where+ f ps (p,pw,ssn) = Just $ L.over ps_map (Map.insert (pwName p) (upd pw ssn)) ps++ upd pw Session{..} =+ L.set pw_text _ssn_password $+ L.set pw_isOneShot _ssn_isOneShot $+ L.set pw_primed False $+ pw++-- | delete a password from the store+deletePassword :: PW p => PMConfig p -> p -> IO ()+deletePassword pmc p = wrap pmc $ \ps -> return $ Just $ L.over ps_map (Map.delete (pwName p)) ps++-- | delete a session from the store+deleteSession :: PW p => PMConfig p -> Maybe p -> SessionName -> IO ()+deleteSession pmc mb snm = wrap pmc $ \ps -> do+ trp <- lookup_session mb snm ps+ chk trp+ return $ f ps trp+ where+ chk (p,pw,ssn)+ | Just ext <- isSession p+ , Right sd <- ext $ _pw_text pw+ , _sd_name sd /= _ssn_name ssn+ = return ()+ | otherwise = error "cannot delete this session (is it selected?)"++ f ps (p,pw,_) = Just $ L.over ps_map (Map.insert (pwName p) (L.over pw_sessions (Map.delete snm) pw)) ps+++-- | print a status line; if @q@ is @True@ then don't output anything and exit+-- with fail code 1 if not logged in+status :: PW p => PMConfig p -> Bool -> IO ()+status pmc q = (if q then flip catch hdl else id) $ enquire pmc line+ where+ line ps = putStrLn $+ "Logged in [" +++ unwords sns' ++ "/" ++ unwords pps' ++ "] (" +++ (T.unpack $ _PasswordStoreComment $ _ps_comment ps) ++ ")"+ where+ sns' = sns ++ ["+" ++ show (len pmc (lookup_sessions Nothing (const True) ps) - length sns)]+ pps' = pps ++ ["+" ++ show (Map.size (_ps_map ps) - length pps)]++ sns =+ [ T.unpack $ _SessionName $ _sd_name sd+ | pw <- Map.elems $ _ps_map ps+ , let Password{..} = pw+ , Just p <- [parsePwName _pw_name]+ , Just prs <- [isSession $ cast_pmc pmc p]+ , Right sd <- [prs _pw_text]+ , is_primed pw+ ]++ pps =+ [ T.unpack $ _PasswordName $ _pw_name pw+ | pw <- Map.elems $ _ps_map ps+ , _pw_isOneShot pw && is_primed pw+ ]++ len :: PMConfig p -> [(p,Password,Session)] -> Int+ len _ = length++ hdl (_::SomeException) = exitWith $ ExitFailure 1++-- | list the passwords, one per line; if @a@ is set then all passwords will be listed,+-- otherwise just the primed passwords will be listed+passwords :: PW p => PMConfig p -> Bool -> IO ()+passwords pmc br = do+ tz <- getCurrentTimeZone+ enquire pmc $ \ps ->+ putStr $ unlines $ map (fmt tz) $ pws ps+ where+ fmt :: PW p => TimeZone -> (p,Password) -> String+ fmt tz (p,Password{..})+ | br = nm_s+ | otherwise = printf "%-12s %c %2s $%-18s %s %s" nm_s p_c sn_s ev_s su_s cmt+ where+ nm_s = T.unpack $ _PasswordName _pw_name+ p_c = if _pw_isOneShot then prime_char _pw_primed else ' '+ sn_s = case Map.size _pw_sessions of+ 0 -> ""+ n -> show n+ ev_s = T.unpack $ _EnvVar $ enVar p+ su_s = pretty_setup tz _pw_setup+ cmt = case summarize p of+ "" -> ""+ cs -> "# " ++ cs++ pws ps =+ [ (cast_pmc pmc p,pwd)+ | p <- [minBound..maxBound]+ , Just pwd <- [Map.lookup (pwName p) $ _ps_map ps]+ ]++-- | list the sessions, one per line; if @p@ is specified then all of the+-- sessions are listed for that password+sessions :: PW p+ => PMConfig p+ -> Bool -- ^ list active sessions only+ -> Bool -- ^ list only the session identifiers+ -> Maybe p -- ^ if specified, then only the sessions on this password+ -> IO ()+sessions pmc a b mb = do+ tz <- getCurrentTimeZone+ enquire pmc $ \ps ->+ let trps = case a of+ True -> [ trp | trp@(_,pw,_)<-trps_, active_session trp && is_primed pw]+ False -> trps_+ trps_ = lookup_sessions mb (const True) ps+ in+ putStr $ unlines $ map (fmt tz) trps+ where+ fmt tz trp@(_,Password{..},Session{..}) =+ case b of+ True -> printf "%s" sn_s+ False ->+ case sgl of+ True -> printf "%-16s %c %s %s" sn_s p_c su_s a_s+ False -> printf "%-12s %-16s %c %s %s" pn_s sn_s p_c su_s a_s+ where+ pn_s = T.unpack $ _PasswordName _pw_name+ sn_s = T.unpack $ _SessionName _ssn_name+ p_c = if _ssn_isOneShot then prime_char False else ' '+ su_s = pretty_setup tz _ssn_setup+ a_s = if active_session trp then "[ACTIVE]" else "" :: String++ sgl = length [ () | p<-[minBound..maxBound], isJust $ isSession $ cast_pmc pmc p ] == 1++-- | print the info, including the text descriton, for an individual passowrd+infoPassword :: PW p+ => PMConfig p+ -> Bool -- ^ True => show the password secret text+ -> p -- ^ the password to show+ -> IO ()+infoPassword pmc sh_s p = do+ doc <- infoPassword_ pmc sh_s p+ putStr $ P.displayS (P.renderPretty 0.75 120 doc) ""++-- | get the info on a password+infoPassword_ :: PW p => PMConfig p -> Bool -> p -> IO P.Doc+infoPassword_ pmc sh_s p = do+ tz <- getCurrentTimeZone+ enquire pmc $ \ps ->+ return $ maybe P.empty (mk tz) $ Map.lookup pnm $ _ps_map ps+ where+ mk tz pw@Password{..} =+ heading P.<$$> P.indent 4 (+ sssions P.<>+ primed P.<$$>+ evar P.<$$>+ loaded P.<$$>+ secret P.<>+ P.empty P.<$$>+ descr+ ) P.<$$>+ P.empty+ where+ heading = P.bold $ P.string $ T.unpack $ _PasswordName pnm+ sssions = case isSession p of+ Nothing -> P.empty+ Just xt -> (line "sessions" $ fmt_sns xt) P.<$$> P.empty+ primed = line "primed" $ if is_primed pw then "yes" else "no"+ evar = line "env var" $ T.unpack $ _EnvVar $ enVar p+ loaded = line "loaded" $ pretty_setup tz $ _pw_setup+ descr = P.string $ describe p+ secret = case sh_s of+ True -> (line "secret" $ T.unpack $ _PasswordText _pw_text) P.<$$> P.empty+ False -> P.empty++ fmt_sns xt = sn ++ " / " ++ unwords (map (T.unpack . _SessionName) $ filter fl sns)+ where+ sn = either (\s->"<<"++s++">>") (T.unpack . _SessionName . _sd_name ) ei+ fl = either (\_ _->False) (\sd sn'->_sd_name sd/=sn') ei+ ei = xt _pw_text++ sns = Map.keys _pw_sessions++ line :: String -> String -> P.Doc+ line nm vl = P.bold(P.string $ ljust 8 nm) P.<> P.string " : " P.<>+ P.hang 8 (P.string vl)++ pnm = pwName p++ ljust n s = s ++ replicate (max 0 (n-length s)) ' '++-- | dump the store in a s script that can be used to reload it+dump :: PW p => PMConfig p -> Bool -> IO ()+dump pmc inc_ssns = enquire pmc dmp >> prime pmc True Nothing+ where+ dmp ps@PasswordStore{..} = putStr $ format_dump (_pmc_dump_prefix pmc) _ps_comment al_l al_s+ where+ al_l =+ [ (p,_pw_text pw)+ | p <- [minBound..maxBound]+ , Just pw <- [Map.lookup (pwName $ cast_pmc pmc p) _ps_map]+ , isNothing $ isSession p+ , is_primed pw+ ] +++ [ (p,_ssn_password ssn)+ | inc_ssns+ , (p,_,ssn) <- lookup_sessions Nothing (const True) ps+ ]++ al_s =+ [ (p,_sd_name sd)+ | inc_ssns+ , p <- [minBound..maxBound]+ , Just pw <- [Map.lookup (pwName $ cast_pmc pmc p) _ps_map]+ , Just ext <- [isSession p]+ , Right sd <- [ext $ _pw_text pw]+ ]++-- | collect the passowrds, bthem into the environmant and launch an interacive shell+collectShell :: PW p => PMConfig p -> IO ()+collectShell pmc = collect pmc defaultCollectConfig >> _pmc_shell pmc++-- | check whether a password is primed for use+is_primed :: Password -> Bool+is_primed Password{..} = not _pw_isOneShot || _pw_primed++-- | lookup a session in a password store, possibly specifying the password it belogs to; exactly+-- one session must be found, otherwise an error is generated+lookup_session :: PW p => Maybe p -> SessionName -> PasswordStore -> IO (p,Password,Session)+lookup_session mb snm ps =+ case lookup_sessions mb (==snm) ps of+ [] -> err "session not loaded"+ [r] -> return r+ _ -> err "matches multiple sessions"+ where+ err msg = ssn_error $ "lookup_session: " ++ T.unpack(_SessionName snm) ++ ": " ++ msg++-- | lookup all of the sessions in a password store+lookup_sessions :: PW p => Maybe p -> (SessionName->Bool) -> PasswordStore -> [(p,Password,Session)]+lookup_sessions mb f ps =+ [ (p,pw,ssn)+ | p <- [minBound..maxBound]+ , maybe True (p==) mb+ , isJust $ isSession p+ , let pnm = pwName p+ , Just pw <- [Map.lookup pnm $ _ps_map ps]+ , ssn <- filter (f . _ssn_name) $ Map.elems $ _pw_sessions pw+ ]++active_session :: PW p => (p,Password,Session) -> Bool+active_session (p,Password{..},Session{..}) = not $ null+ [ ()+ | Just ext <- [isSession p]+ , Right sd <- [ext _pw_text]+ , _sd_name sd == _ssn_name+ ]++-- | read a passord from stdin and hash it+get_pw :: PW p => PMConfig p -> IO PasswordText+get_pw pmc = do+ hSetEcho stdin False+ putStr "Password: "+ hFlush stdout+ pw <- getLine+ putChar '\n'+ hSetEcho stdin True+ return $ hashMasterPassword pmc pw++-- | use a '+' to represent a primed one-shot password,'-' otherwise+prime_char :: Bool -> Char+prime_char is_p = if is_p then '+' else '-'++-- | make up a script for loading a password store+format_dump :: PW p+ => String -- ^ the prefix for each script command line+ -> PasswordStoreComment -- ^ the store comment+ -> [(p,PasswordText)] -- ^ the passwords to load+ -> [(p,SessionName)] -- ^ the sessions to select+ -> String+format_dump pfx ps_cmt al_l al_s =+ unlines $+ (printf "%s comment %s ;" pfx $ esc $ T.unpack $ _PasswordStoreComment ps_cmt) :+ [ printf "%s load %-12s %-20s %-30s ;" pfx pnm_s ptx_s $ cmt_s p+ | (p,ptx) <- al_l+ , let pnm_s = T.unpack $ _PasswordName $ pwName p+ , let ptx_s = T.unpack $ _PasswordText ptx+ ] +++ [ printf "%s select -p %s %s ;" pfx pnm_s snm_s+ | (p,snm) <- al_s+ , let pnm_s = T.unpack $ _PasswordName $ pwName p+ , let snm_s = T.unpack $ _SessionName snm+ ]+ where+ cmt_s p = case summarize p of+ "" -> ""+ s -> "# " ++ esc s++ esc s = '\'' : foldr tr "\'" s+ where+ tr '\'' t = '\\' : '\'' : t+ tr c t = c : t++wrap_def :: PW p => PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()+wrap_def pmc f = maybe (return ()) (wrap' pmc f) =<< get_key' pmc++wrap :: PW p => PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> IO ()+wrap pmc f = get_key pmc >>= wrap' pmc f++wrap' :: PW p => PMConfig p -> (PasswordStore -> IO (Maybe PasswordStore)) -> AESKey -> IO ()+wrap' pmc f aek = do+ pws <- load_ps pmc aek+ mb <- f pws+ maybe (return ()) (save_ps pmc aek) mb++enquire :: PW p => PMConfig p -> (PasswordStore -> IO a) -> IO a+enquire pmc f = do+ aek <- get_key pmc+ load_ps pmc aek >>= f++password_valid :: PW p => PMConfig p -> AESKey -> IO Bool+password_valid pmc aek = catch ld hd+ where+ ld = const True <$> load_ps pmc aek+ hd (_::SomeException) = return False++load_ps :: PW p => PMConfig p -> AESKey -> IO PasswordStore+load_ps pmc aek = do+ aed <- load_ps' pmc+ case decodeWithErrs $ BL.fromChunks [_Binary $ _ClearText $ decryptAES aek aed] of+ Right pws -> return pws+ Left ers -> error $ prettyJSONErrorPositions ers++save_ps :: PW p => PMConfig p -> AESKey -> PasswordStore -> IO ()+save_ps pmc aek pws = do+ iv <- random_bytes sizeAesIV IV+ save_ps' pmc $ encryptAES aek iv $ ClearText $ Binary $ BL.toStrict $ A.encode pws++load_ps' :: PW p => PMConfig p -> IO AESSecretData+load_ps' PMConfig{..} = flip catch hdl $ do+ (iv,ct) <- B.splitAt (_Octets sizeAesIV) <$> B.readFile _pmc_location+ return+ AESSecretData+ { _asd_iv = IV $ Binary iv+ , _asd_secret_data = SecretData $ Binary ct+ }+ where+ hdl (_::SomeException) = error _pmc_keystore_msg++random_bytes :: Octets -> (Binary->a) -> IO a+random_bytes sz f = f . Binary . fst . generateCPRNG (_Octets sz) <$> newCPRNG++save_ps' :: PW p => PMConfig p -> AESSecretData -> IO ()+save_ps' PMConfig{..} AESSecretData{..} = B.writeFile _pmc_location $ B.concat [iv_bs,ct_bs]+ where+ iv_bs = _Binary $ _IV _asd_iv+ ct_bs = _Binary $ _SecretData _asd_secret_data++get_key :: PW p => PMConfig p -> IO AESKey+get_key pmc@PMConfig{..} = get_key' pmc >>= maybe (not_logged_in_err pmc) return++not_logged_in_err :: PW p => PMConfig p -> IO a+not_logged_in_err pmc@PMConfig{..} = do+ ex <- isStorePresent pmc+ error $ if ex then _pmc_password_msg else _pmc_keystore_msg++get_key' :: PW p => PMConfig p -> IO (Maybe AESKey)+get_key' PMConfig{..} = fmap mk_aek' <$> lookupEnv var+ where+ var = T.unpack $ _EnvVar _pmc_env_var++mk_aek :: PasswordText -> AESKey+mk_aek = mk_aek' . T.unpack . _PasswordText++mk_aek' :: String -> AESKey+mk_aek' = AESKey . Binary . either err id . B64.decode . B.pack+ where+ err = error "bad format for the master password"++pretty_setup :: TimeZone -> UTCTime -> String+pretty_setup tz = formatTime defaultTimeLocale "%F %H:%M" . utcToZonedTime tz++set_env :: EnvVar -> PasswordText -> IO ()+set_env (EnvVar ev) (PasswordText pt) = setEnv (T.unpack ev) (T.unpack pt)++ssn_error :: String -> a+ssn_error msg = error $ "session manager error: " ++ msg+++--+-- The Command Line Parser+--+++data PMCommand p+ = PMCD_version+ | PMCD_setup Bool (Maybe PasswordText)+ | PMCD_login Bool (Maybe PasswordText)+ | PMCD_load p (Maybe PasswordText)+ | PMCD_comment PasswordStoreComment+ | PMCD_prime Bool p+ | PMCD_prime_all Bool+ | PMCD_select (Maybe p) SessionName+ | PMCD_delete_password p+ | PMCD_delete_session (Maybe p) SessionName+ | PMCD_status Bool+ | PMCD_passwords Bool+ | PMCD_sessions Bool Bool (Maybe p)+ | PMCD_info Bool p+ | PMCD_dump Bool+ | PMCD_collect+ | PMCD_sample_script+ deriving (Show)++parse_command :: PW p => PMConfig p -> [String] -> IO (PMCommand p)+parse_command pmc = run_parse $ command_info pmc++command_info :: PW p => PMConfig p -> ParserInfo (PMCommand p)+command_info pmc =+ O.info (helper <*> command_parser pmc)+ ( fullDesc+ <> progDesc "a simple password manager"+ <> header "pm - sub-command for managing the password store"+ <> footer "'ks COMMAND --help' to get help on each command")++command_parser :: PW p => PMConfig p -> Parser (PMCommand p)+command_parser pmc =+ subparser $ f $ g+ $ command "version" pi_version+ <> command "setup" pi_setup+ <> command "login" pi_login+ <> command "load" pi_load+ <> command "comment" pi_comment+ <> command "prime" pi_prime+ <> command "prime-all" pi_prime_all+ <> command "select" pi_select+ <> command "delete-password" pi_delete_password+ <> command "delete-session" pi_delete_session+ <> command "status" pi_status+ <> command "passwords" pi_passwords+ <> command "sessions" pi_sessions+ <> command "info" pi_info+ <> command "collect" pi_collect+ where+ s = command "sample-load-script" pi_sample_script+ d = command "dump" pi_dump++ f = case _pmc_sample_script pmc of+ Nothing -> id+ Just _ -> (<> s)++ g = case _pmc_allow_dumps pmc of+ True -> (<> d)+ False -> id++pi_version :: ParserInfo (PMCommand p)+pi_version =+ h_info+ (helper <*> pure PMCD_version)+ (progDesc "report the version of this package")++pi_setup :: ParserInfo (PMCommand p)+pi_setup =+ h_info+ (helper <*> (PMCD_setup <$> p_no_login_sw <*> optional p_password_text))+ (progDesc "setup the password store")++pi_login :: ParserInfo (PMCommand p)+pi_login =+ h_info+ (helper <*> (PMCD_login <$> p_loop_sw <*> optional p_password_text))+ (progDesc "login to the password manager")++pi_load :: PW p => ParserInfo (PMCommand p)+pi_load =+ h_info+ (helper <*> (PMCD_load <$> p_pw_id <*> optional p_password_text) <* optional p_load_comment)+ (progDesc "load a password into the store")++pi_comment :: PW p => ParserInfo (PMCommand p)+pi_comment =+ h_info+ (helper <*> (PMCD_comment <$> p_ps_comment))+ (progDesc "load a password into the store")++pi_prime :: PW p => ParserInfo (PMCommand p)+pi_prime =+ h_info+ (helper <*> (PMCD_prime <$> p_unprime_sw <*> p_pw_id))+ (progDesc "(un) prime a password for use")++pi_prime_all :: ParserInfo (PMCommand p)+pi_prime_all =+ h_info+ (helper <*> (PMCD_prime_all <$> p_unprime_sw))+ (progDesc "(un)prime all of the passwords")++pi_select :: PW p => ParserInfo (PMCommand p)+pi_select =+ h_info+ (helper <*> (PMCD_select <$> optional p_pw_id_opt <*> p_session_name))+ (progDesc "select a client session")++pi_delete_password :: PW p => ParserInfo (PMCommand p)+pi_delete_password =+ h_info+ (helper <*> (PMCD_delete_password <$> p_pw_id))+ (progDesc "select a client session")++pi_delete_session :: PW p => ParserInfo (PMCommand p)+pi_delete_session =+ h_info+ (helper <*> (PMCD_delete_session <$> optional p_pw_id_opt <*> p_session_name))+ (progDesc "delete a client session")++pi_status :: ParserInfo (PMCommand p)+pi_status =+ h_info+ (helper <*> (PMCD_status <$> p_quiet_sw))+ (progDesc "report the status of the password manager")++pi_passwords :: ParserInfo (PMCommand p)+pi_passwords =+ h_info+ (helper <*> (PMCD_passwords <$> p_brief_sw))+ (progDesc "list the passwords")++pi_sessions :: PW p => ParserInfo (PMCommand p)+pi_sessions =+ h_info+ (helper <*> (PMCD_sessions <$> p_active_sw <*> p_brief_sw <*> optional p_pw_id))+ (progDesc "list the sessions")++pi_info :: PW p => ParserInfo (PMCommand p)+pi_info =+ h_info+ (helper <*> (PMCD_info <$> p_secret_sw <*> p_pw_id))+ (progDesc "print out the info on a password, including desriptive text")++pi_dump :: PW p => ParserInfo (PMCommand p)+pi_dump =+ h_info+ (helper <*> (PMCD_dump <$> p_sessions_sw))+ (progDesc "dump the passwords on the output as a load script")++pi_collect :: PW p => ParserInfo (PMCommand p)+pi_collect =+ h_info+ (helper <*> (pure PMCD_collect))+ (progDesc "collect the passwords and launch an interacive shell")+++pi_sample_script :: ParserInfo (PMCommand p)+pi_sample_script =+ h_info+ (helper <*> (pure PMCD_sample_script))+ (progDesc "print a sample script to define keystore passwords in the environment (PM edition)")++p_no_login_sw :: Parser Bool+p_no_login_sw =+ switch+ (short 'n' <>+ long "no-login" <>+ help "do not launch an interactive shell")++p_loop_sw :: Parser Bool+p_loop_sw =+ switch+ (short 'l' <>+ long "loop" <>+ help "on failure prompt for a new password and try again")++p_quiet_sw :: Parser Bool+p_quiet_sw =+ switch+ (short 'q' <>+ long "quiet" <>+ help "don't print anything but report with error codes (0=>logged in)")++p_brief_sw :: Parser Bool+p_brief_sw =+ switch+ (short 'b' <>+ long "brief" <>+ help "list the identifiers only")++p_active_sw :: Parser Bool+p_active_sw =+ switch+ (short 'a' <>+ long "active" <>+ help "list the active sessions only")++p_unprime_sw :: Parser Bool+p_unprime_sw =+ switch+ (short 'u' <>+ long "unprime" <>+ help "clear the prime status")++p_secret_sw :: Parser Bool+p_secret_sw =+ switch+ (short 's' <>+ long "secret" <>+ help "show the secret password")++p_sessions_sw :: Parser Bool+p_sessions_sw =+ switch+ (long "sessions" <>+ help "include the sessions")++p_pw_id :: PW p => Parser p+p_pw_id =+ argument (parsePwName . PasswordName . T.pack)+ $ metavar "PASSWORD-ID"+ <> help "a password ID"++p_pw_id_opt :: PW p => Parser p+p_pw_id_opt =+ nullOption+ $ long "id"+ <> short 'p'+ <> metavar "PASSWORD-ID"+ <> reader (maybe (fail "password-id not recognised") return . parsePwName . PasswordName . T.pack)+ <> help "a password ID"++p_password_text :: Parser PasswordText+p_password_text =+ argument (Just . PasswordText . T.pack)+ $ metavar "PASSWORD-TEXT"+ <> help "the text of the password"++p_session_name :: Parser SessionName+p_session_name =+ argument (Just . SessionName . T.pack)+ $ metavar "SESSION"+ <> help "a session name"++p_load_comment :: Parser ()+p_load_comment = const () <$> optional (p_hash <* p_comment)++p_ps_comment :: Parser PasswordStoreComment+p_ps_comment = PasswordStoreComment . T.pack <$> p_comment++p_hash :: Parser ()+p_hash = argument (\s->if s=="#" then Just () else Nothing) $ metavar "#"++p_comment :: Parser String+p_comment = unwords <$> many p_word++p_word :: Parser String+p_word = argument Just $ metavar "WORD"++h_info :: Parser a -> InfoMod a -> ParserInfo a+h_info pr = O.info (helper <*> pr)++run_parse :: ParserInfo a -> [String] -> IO a+run_parse pinfo args =+ case execParserPure (prefs idm) pinfo args of+ Success a -> return a+ Failure failure -> do+ progn <- getProgName+ let (msg, exit) = execFailure failure progn+ case exit of+ ExitSuccess -> putStrLn msg+ _ -> hPutStrLn stderr msg+ exitWith exit+ CompletionInvoked compl -> do+ progn <- getProgName+ msg <- execCompletion compl progn+ putStr msg+ exitWith ExitSuccess
src/Data/KeyStore/Sections.hs view
@@ -332,7 +332,7 @@ where oops dg = error $ "key_section: " ++ encode h ++ ": " ++ encode k ++ ": " ++ show dg --- | Rerurn the section that a host sores a given key in, returning a+-- | Return the section that a host stores a given key in, returning a -- failure diagnostic if the host does not keep such a key in the given -- 'Section' model. keySection :: Sections h s k => h -> k -> Retrieve s@@ -352,10 +352,12 @@ -- iff ch then compare the new value with the old ok <- case ch of True -> do- -- if key has not changed then squash the rotation+ -- if key has not changed, or the secret text is not available+ -- then squash the rotation mbkds <- map key2KeyData <$> locateKeys ic (mks k) g_nm case mbkds of- Just kd':_ | kd==kd' -> return False+ Just kd':_ | kd==kd' -> return False -- the key has not changes+ Nothing :_ -> return False -- secret not accessible to compare _ -> return True False -> return True
+ src/Data/KeyStore/Types/PasswordStoreModel.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}++module Data.KeyStore.Types.PasswordStoreModel where++import Data.KeyStore.Types.PasswordStoreSchema+import qualified Data.Map as Map+import Data.API.Tools+import Data.API.JSON+++$(generate passwordStoreSchema)+++-- The PasswordStre and SessionMap association lists are represented internally+-- with maps.+++type PasswordMap = Map.Map PasswordName Password++inj_pwmap :: REP__PasswordMap -> ParserWithErrs PasswordMap+inj_pwmap (REP__PasswordMap as) =+ return $ Map.fromList [ (_npa_name,_npa_password) | NamePasswordAssoc{..}<-as ]++prj_pwmap :: PasswordMap -> REP__PasswordMap+prj_pwmap mp = REP__PasswordMap [ NamePasswordAssoc nme pwd | (nme,pwd)<-Map.toList mp ]+++type SessionMap = Map.Map SessionName Session++inj_snmap :: REP__SessionMap -> ParserWithErrs SessionMap+inj_snmap (REP__SessionMap as) =+ return $ Map.fromList [ (_spa_name,_spa_session) | SessionPasswordAssoc{..}<-as ]++prj_snmap :: SessionMap -> REP__SessionMap+prj_snmap mp = REP__SessionMap [ SessionPasswordAssoc snm ssn | (snm,ssn)<-Map.toList mp ]+++$(generateAPITools passwordStoreSchema+ [ enumTool+ , jsonTool+ , lensTool+ ])
+ src/Data/KeyStore/Types/PasswordStoreSchema.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Data.KeyStore.Types.PasswordStoreSchema+ ( passwordStoreSchema+ , passwordStoreChangelog+ ) where++import Data.API.Parse+import Data.API.Types+import Data.API.Changes+++passwordStoreSchema :: API+passwordStoreChangelog :: APIChangelog+(passwordStoreSchema, passwordStoreChangelog) = [apiWithChangelog|++ps :: PasswordStore+ = record+ comment :: PasswordStoreComment+ map :: PasswordMap+ setup :: utc++pm :: PasswordMap+ // the password map, represented internally with a Map+ // from PasswordName to Password+ = record+ map :: [NamePasswordAssoc]+ with inj_pwmap, prj_pwmap++npa :: NamePasswordAssoc+ = record+ name :: PasswordName+ password :: Password++pw :: Password+ // passwords may be simple, or be a collection of 'sessions',+ // one of which is selected+ = record+ name :: PasswordName+ text :: PasswordText+ sessions :: SessionMap+ isOneShot :: Bool+ primed :: boolean+ setup :: utc++smp :: SessionMap+ // collections of sessions are represented internally as a Map+ // from SessionName to PasswordText+ = record+ map :: [SessionPasswordAssoc]+ with inj_snmap, prj_snmap++spa :: SessionPasswordAssoc+ = record+ name :: SessionName+ session :: Session++ssn :: Session+ // a session just consists of a password and the stup time+ = record+ name :: SessionName+ password :: PasswordText+ isOneShot :: Bool+ setup :: utc++pwsc :: PasswordStoreComment+ // a short comment on the PasswordStore+ = basic string++pnm :: PasswordName+ // used to identify a password in the store+ = basic string++ptx :: PasswordText+ // used to contain the secret text of a Password+ = basic string++snm :: SessionName+ // used to identify the different sessions in a session password+ = basic string++changes++// Initial version+version "0.0.0.1"++|]
+ src/Data/KeyStore/Version.hs view
@@ -0,0 +1,9 @@+module Data.KeyStore.Version where++version :: String+version = show a ++ "." ++ show b ++ "." ++ show c ++ "." ++ show d+ where+ (a,b,c,d) = versionTuple++versionTuple :: (Int,Int,Int,Int)+versionTuple = (0,5,1,0)