From 71723ca09f369ccf96462cef1e0200e1615677d1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 14 Dec 2014 15:24:10 -0400 Subject: support for crypted passwords in privdata * Added CryptPassword to PrivDataField, for password hashes as produced by crypt(3). * User.hasPassword and User.hasSomePassword will now use either a CryptPassword or a Password from privdata, depending on which is set. --- src/Propellor/PrivData.hs | 39 ++++++++++++++++++++++++++++++++------- 1 file changed, 32 insertions(+), 7 deletions(-) (limited to 'src/Propellor/PrivData.hs') diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs index 06438515..b0228b46 100644 --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -53,18 +53,43 @@ withPrivData -> c -> (((PrivData -> Propellor Result) -> Propellor Result) -> Property) -> Property -withPrivData field c mkprop = addinfo $ mkprop $ \a -> - maybe missing a =<< get +withPrivData field = withPrivData' snd [field] + +-- Like withPrivData, but here any of a list of PrivDataFields can be used. +withSomePrivData + :: IsContext c + => [PrivDataField] + -> c + -> ((((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Property) + -> Property +withSomePrivData = withPrivData' id + +withPrivData' + :: IsContext c + => ((PrivDataField, PrivData) -> v) + -> [PrivDataField] + -> c + -> (((v -> Propellor Result) -> Propellor Result) -> Property) + -> Property +withPrivData' feed fieldlist c mkprop = addinfo $ mkprop $ \a -> + maybe missing (a . feed) =<< getM get fieldlist where - get = do + get field = do context <- mkHostContext hc <$> asks hostName - liftIO $ getLocalPrivData field context + maybe Nothing (\privdata -> Just (field, privdata)) + <$> liftIO (getLocalPrivData field context) missing = do Context cname <- mkHostContext hc <$> asks hostName - warningMessage $ "Missing privdata " ++ show field ++ " (for " ++ cname ++ ")" - liftIO $ putStrLn $ "Fix this by running: propellor --set '" ++ show field ++ "' '" ++ cname ++ "'" + warningMessage $ "Missing privdata " ++ intercalate " or " fieldnames ++ " (for " ++ cname ++ ")" + liftIO $ putStrLn $ "Fix this by running:" + liftIO $ forM_ fieldlist $ \f -> do + putStrLn $ " propellor --set '" ++ show f ++ "' '" ++ cname ++ "'" + putStrLn $ " < ( " ++ howtoMkPrivDataField f ++ " )" + putStrLn "" return FailedChange - addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = S.singleton (field, hc) } } + addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = fieldset } } + fieldnames = map show fieldlist + fieldset = S.fromList $ zip fieldlist (repeat hc) hc = asHostContext c addPrivDataField :: (PrivDataField, HostContext) -> Property -- cgit v1.3-2-g0d8e