diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -62,3 +62,7 @@ 0.5.0.3 Chris Dornan 2014-07-30 * fix key-formatting bug (gratuitious insertion of double '/'s before the version number) + +0.5.0.4 Chris Dornan 2014-08-24 + * improve diagnostics for internally used Sections.keySection + * add roateIfChanged to Sections (squashes vacuous rotations) diff --git a/examples/deploy/Deploy/Command.hs b/examples/deploy/Deploy/Command.hs --- a/examples/deploy/Deploy/Command.hs +++ b/examples/deploy/Deploy/Command.hs @@ -23,6 +23,7 @@ data Command = Create | Rotate (Maybe HostID) (Maybe SectionID) (Maybe KeyID) + | RotateSmart (Maybe HostID) (Maybe SectionID) (Maybe KeyID) | Deploy (Maybe FilePath) HostID | Sign | Verify @@ -58,7 +59,8 @@ p_command = subparser $ command "create" pi_create - <> command "rotate" pi_rotate_key + <> command "rotate" (pi_rotate_key False) + <> command "rotate-smart" (pi_rotate_key True ) <> command "deploy" pi_deploy <> command "sign" pi_sign <> command "verify" pi_verify @@ -76,15 +78,15 @@ (helper <*> (pure Create)) (progDesc "create a new keystore") -pi_rotate_key :: ParserInfo Command -pi_rotate_key = +pi_rotate_key :: Bool -> ParserInfo Command +pi_rotate_key sm = h_info (helper <*> - (Rotate + ((if sm then RotateSmart else Rotate) <$> optional p_host <*> optional p_section <*> optional p_key)) - (progDesc "rotate a key") + (progDesc $ if sm then "rotate keys, but only if they have changed" else "rotate keys") pi_deploy :: ParserInfo Command pi_deploy = diff --git a/examples/deploy/deploy.hs b/examples/deploy/deploy.hs --- a/examples/deploy/deploy.hs +++ b/examples/deploy/deploy.hs @@ -40,7 +40,8 @@ _ -> verify_ks True ic_ro case cli_command of Create -> error "main: Initialise" - Rotate mbh mbs mbk -> rotate ic $ key_prededicate mbh mbs mbk + 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 Sign -> sign_ks ic_ro Verify -> T.putStrLn "the keystore matches the signature" diff --git a/keystore.cabal b/keystore.cabal --- a/keystore.cabal +++ b/keystore.cabal @@ -1,5 +1,5 @@ Name: keystore -Version: 0.5.0.3 +Version: 0.5.0.4 Synopsis: Managing stores of secret things Homepage: http://github.com/cdornan/keystore Author: Chris Dornan diff --git a/src/Data/KeyStore/CLI.hs b/src/Data/KeyStore/CLI.hs --- a/src/Data/KeyStore/CLI.hs +++ b/src/Data/KeyStore/CLI.hs @@ -18,7 +18,7 @@ version :: String -version = "0.5.0.3" +version = "0.5.0.4" cli :: IO () cli = parseCLI >>= command Nothing diff --git a/src/Data/KeyStore/Sections.hs b/src/Data/KeyStore/Sections.hs --- a/src/Data/KeyStore/Sections.hs +++ b/src/Data/KeyStore/Sections.hs @@ -14,6 +14,7 @@ , RetrieveDg(..) , initialise , rotate + , rotateIfChanged , retrieve , signKeystore , verifyKeystore @@ -39,6 +40,7 @@ import qualified Data.HashMap.Strict as HM import qualified Data.Vector as V import qualified Data.Map as Map +import Data.API.Types import Data.Maybe import Data.List import Data.Char @@ -134,6 +136,7 @@ , kd_comment :: Comment , kd_secret :: B.ByteString } + deriving (Show,Eq) -- | One, many or all of the keys in a store may be rotated at a time. -- we use one of these to specify which keys are to be rotated. @@ -169,9 +172,20 @@ mks :: Sections h s k => KeyPredicate h s k -> IC -> s -> IO () mks = const mk_section --- | Rotate in a set of keys spwecified by the predicate. +-- | Rotate in a set of keys specified by the predicate. rotate :: Sections h s k => IC -> KeyPredicate h s k -> IO () -rotate ic kp = reformat ic' $ sequence_ [ rotate' ic mb_h s k | (mb_h,s,k)<-host_keys++non_host_keys, kp mb_h s k ] +rotate = rotate_ False + +-- | Rotate in a set of keys specified by the predicate, rotating each key only +-- if it has changed: NB the check is contingent on the secret text being +-- accessible; if the secret text is not accessible then the rotation will happen. +rotateIfChanged :: Sections h s k => IC -> KeyPredicate h s k -> IO () +rotateIfChanged = rotate_ True + +-- | Rotate in a set of keys specified by the predicate with the first argument +-- controlling whether to squash duplicate rotations +rotate_ :: Sections h s k => Bool -> IC -> KeyPredicate h s k -> IO () +rotate_ ch ic kp = reformat ic' $ sequence_ [ rotate' ch ic mb_h s k | (mb_h,s,k)<-host_keys++non_host_keys, kp mb_h s k ] where host_keys = [ (Just h ,s,k) | k<-[minBound..maxBound], Just isp<-[keyIsHostIndexed k], h<-[minBound..maxBound], isp h, let s = key_section h k ] non_host_keys = [ (Nothing,s,k) | k<-[minBound..maxBound], Nothing <-[keyIsHostIndexed k], s<-[minBound..maxBound], keyIsInSection k s ] @@ -179,7 +193,7 @@ ic' = kp_RFT kp ic -- | Retrieve the keys for a given host from the store. Note that the whole history for the given key is returned. --- Note also that the secret text may not be present if it si not accessible (depnding upon hwich section passwords +-- Note also that the secret text may not be present if it is not accessible (depnding upon hwich section passwords -- are correctly bound in the process environment). Note also that the 'Retrieve' diagnostic should not fail if a -- coherent model has been ddefined for 'Sections'. retrieve :: Sections h s k => IC -> h -> k -> IO (Retrieve [Key]) @@ -312,11 +326,11 @@ s <- keySection h k return $ key_nme mb_h s k --- a wrapper on keySection used internally in functional contezxtx +-- a wrapper on keySection used internally in functional contexts key_section :: Sections h s k => h -> k -> s key_section h k = either oops id $ keySection h k where - oops = error "key_section" + oops dg = error $ "key_section: " ++ encode h ++ ": " ++ encode k ++ ": " ++ show dg -- | Rerurn the section that a host sores a given key in, returning a -- failure diagnostic if the host does not keep such a key in the given @@ -327,17 +341,33 @@ -- | The name of the key that stores the password for a given sections. passwordName :: Sections h s k => s -> Name -passwordName s = name' $ "/pw/" ++ encode s +passwordName s = name' $ "/pw/" ++ encode s fmt :: Code a => (a->Bool) -> String fmt p = unwords [ encode h | h<-[minBound..maxBound], p h ] -rotate' :: Sections h s k => IC -> Maybe h -> s -> k -> IO () -rotate' ic mb_h s k = do - KeyData{..} <- getKeyData mb_h s k - nm <- unique_nme ic $ key_nme mb_h s k - createKey ic nm kd_comment kd_identity Nothing (Just kd_secret) +rotate' :: Sections h s k => Bool -> IC -> Maybe h -> s -> k -> IO () +rotate' ch ic mb_h s k = do + kd@KeyData{..} <- getKeyData mb_h s k + -- 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 + mbkds <- map key2KeyData <$> locateKeys ic (mks k) g_nm + case mbkds of + Just kd':_ | kd==kd' -> return False + _ -> return True + False -> + return True + when ok $ do + n_nm <- unique_nme ic g_nm + createKey ic n_nm kd_comment kd_identity Nothing $ Just kd_secret + where + g_nm = key_nme mb_h s k + mks :: k -> SECTIONS h s k + mks = const SECTIONS + lower_sections :: Sections h s k => s -> [s] lower_sections s0 = s0 : concat @@ -456,7 +486,7 @@ -------------------------------------------------------------------------------- -- --- Regormating the KeyStore Names to Allow Prefixes (#3) +-- Reformating the KeyStore Names to Allow Prefixes (#3) -- -------------------------------------------------------------------------------- @@ -659,6 +689,16 @@ False -> Nothing -------------------------------------------------------------------------------- + +key2KeyData :: Key -> Maybe KeyData +key2KeyData Key{..} = f <$> _key_clear_text + where + f (ClearText(Binary bs)) = + KeyData + { kd_identity = _key_identity + , kd_comment = _key_comment + , kd_secret = bs + } name' :: String -> Name name' = either (error.show) id . name