diff --git a/debian/changelog b/debian/changelog index a2b357a..9d1fc0e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -30,6 +30,7 @@ propellor (1.1.0) UNRELEASED; urgency=medium * Run apt-cache policy with LANG=C so it works on other locales. * endAction can be used to register an action to run once propellor has successfully run on a host. + * Fixed privdata introspection for User.hasPassword and User.hasSomePassword -- Joey Hess Sat, 22 Nov 2014 00:12:35 -0400 diff --git a/src/Propellor.hs b/src/Propellor.hs index 6e31e27..0e34e98 100644 --- a/src/Propellor.hs +++ b/src/Propellor.hs @@ -36,6 +36,7 @@ module Propellor ( , module Propellor.Host , module Propellor.Info , module Propellor.PrivData + , module Propellor.Types.PrivData , module Propellor.Engine , module Propellor.Exception , module Propellor.Message @@ -49,6 +50,7 @@ import Propellor.Property import Propellor.Engine import Propellor.Property.Cmd import Propellor.PrivData +import Propellor.Types.PrivData import Propellor.Message import Propellor.Exception import Propellor.Info diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs index c5f489e..0643851 100644 --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -15,6 +15,7 @@ import qualified Data.Map as M import qualified Data.Set as S import Propellor.Types +import Propellor.Types.PrivData import Propellor.Message import Propellor.Info import Propellor.Gpg @@ -30,7 +31,7 @@ import Utility.Env import Utility.Table -- | Allows a Property to access the value of a specific PrivDataField, --- for use in a specific Context. +-- for use in a specific Context or HostContext. -- -- Example use: -- @@ -47,20 +48,26 @@ import Utility.Table -- being used, which is necessary to ensure that the privdata is sent to -- the remote host by propellor. withPrivData - :: PrivDataField - -> Context + :: IsContext c + => PrivDataField + -> c -> (((PrivData -> Propellor Result) -> Propellor Result) -> Property) -> Property -withPrivData field context@(Context cname) mkprop = addinfo $ mkprop $ \a -> - maybe missing a =<< liftIO (getLocalPrivData field context) +withPrivData field c mkprop = addinfo $ mkprop $ \a -> + maybe missing a =<< get where - missing = liftIO $ do + get = do + context <- mkHostContext hc <$> asks hostName + liftIO $ getLocalPrivData field context + missing = do + Context cname <- mkHostContext hc <$> asks hostName warningMessage $ "Missing privdata " ++ show field ++ " (for " ++ cname ++ ")" - putStrLn $ "Fix this by running: propellor --set '" ++ show field ++ "' '" ++ cname ++ "'" + liftIO $ putStrLn $ "Fix this by running: propellor --set '" ++ show field ++ "' '" ++ cname ++ "'" return FailedChange - addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = S.singleton (field, context) } } + addinfo p = p { propertyInfo = propertyInfo p <> mempty { _privDataFields = S.singleton (field, hc) } } + hc = asHostContext c -addPrivDataField :: (PrivDataField, Context) -> Property +addPrivDataField :: (PrivDataField, HostContext) -> Property addPrivDataField v = pureInfoProperty (show v) $ mempty { _privDataFields = S.singleton v } @@ -78,7 +85,8 @@ type PrivMap = M.Map (PrivDataField, Context) PrivData filterPrivData :: Host -> PrivMap -> PrivMap filterPrivData host = M.filterWithKey (\k _v -> S.member k used) where - used = _privDataFields $ hostInfo host + used = S.map (\(f, c) -> (f, mkHostContext c (hostName host))) $ + _privDataFields $ hostInfo host getPrivData :: PrivDataField -> Context -> PrivMap -> Maybe PrivData getPrivData field context = M.lookup (field, context) @@ -119,7 +127,7 @@ listPrivDataFields hosts = do , shellEscape context , intercalate ", " $ sort $ fromMaybe [] $ M.lookup k usedby ] - mkhostmap host = M.fromList $ map (\k -> (k, [hostName host])) $ + mkhostmap host = M.fromList $ map (\(f, c) -> ((f, mkHostContext c (hostName host)), [hostName host])) $ S.toList $ _privDataFields $ hostInfo host usedby = M.unionsWith (++) $ map mkhostmap hosts wantedmap = M.fromList $ zip (M.keys usedby) (repeat "") diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index bc499e0..d229635 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -17,17 +17,17 @@ f `hasContent` newcontent = fileProperty ("replace " ++ f) -- -- The file's permissions are preserved if the file already existed. -- Otherwise, they're set to 600. -hasPrivContent :: FilePath -> Context -> Property +hasPrivContent :: IsContext c => FilePath -> c -> Property hasPrivContent = hasPrivContent' writeFileProtected -- | Leaves the file at its default or current mode, -- allowing "private" data to be read. -- -- Use with caution! -hasPrivContentExposed :: FilePath -> Context -> Property +hasPrivContentExposed :: IsContext c => FilePath -> c -> Property hasPrivContentExposed = hasPrivContent' writeFile -hasPrivContent' :: (String -> FilePath -> IO ()) -> FilePath -> Context -> Property +hasPrivContent' :: IsContext c => (String -> FilePath -> IO ()) -> FilePath -> c -> Property hasPrivContent' writer f context = withPrivData (PrivFile f) context $ \getcontent -> property desc $ getcontent $ \privcontent -> diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs index 5d326b8..88a757b 100644 --- a/src/Propellor/Property/Ssh.hs +++ b/src/Propellor/Property/Ssh.hs @@ -88,7 +88,7 @@ hostKeys ctx = propertyList "known ssh host keys" ] -- | Sets a single ssh host key from the privdata. -hostKey :: SshKeyType -> Context -> Property +hostKey :: IsContext c => SshKeyType -> c -> Property hostKey keytype context = combineProperties desc [ installkey (SshPubKey keytype "") (install writeFile ".pub") , installkey (SshPrivKey keytype "") (install writeFileProtected "") @@ -107,7 +107,7 @@ hostKey keytype context = combineProperties desc -- | Sets up a user with a ssh private key and public key pair from the -- PrivData. -keyImported :: SshKeyType -> UserName -> Context -> Property +keyImported :: IsContext c => SshKeyType -> UserName -> c -> Property keyImported keytype user context = combineProperties desc [ installkey (SshPubKey keytype user) (install writeFile ".pub") , installkey (SshPrivKey keytype user) (install writeFileProtected "") @@ -158,7 +158,7 @@ knownHost hosts hn user = property desc $ -- | Makes a user have authorized_keys from the PrivData -- -- This removes any other lines from the file. -authorizedKeys :: UserName -> Context -> Property +authorizedKeys :: IsContext c => UserName -> c -> Property authorizedKeys user context = withPrivData (SshAuthorizedKeys user) context $ \get -> property (user ++ " has authorized_keys") $ get $ \v -> do f <- liftIO $ dotFile "authorized_keys" user diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs index 7a4e915..9c63980 100644 --- a/src/Propellor/Property/Tor.hs +++ b/src/Propellor/Property/Tor.hs @@ -44,7 +44,7 @@ hiddenService hn port = mainConfig `File.containsLines` `describe` unwords ["hidden service available:", hn, show port] `onChange` restarted -hiddenServiceData :: HiddenServiceName -> Context -> Property +hiddenServiceData :: IsContext c => HiddenServiceName -> c -> Property hiddenServiceData hn context = combineProperties desc [ installonion "hostname" , installonion "private_key" diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs index 5c8e768..69794d8 100644 --- a/src/Propellor/Property/User.hs +++ b/src/Propellor/Property/User.hs @@ -25,34 +25,32 @@ nuked user _ = check (isJust <$> catchMaybeIO (homedir user)) $ cmdProperty "use -- | Only ensures that the user has some password set. It may or may -- not be the password from the PrivData. hasSomePassword :: UserName -> Property -hasSomePassword user = property (user ++ "has password") $ do - hostname <- asks hostName - ensureProperty $ hasSomePassword' user (Context hostname) +hasSomePassword user = hasSomePassword' user hostContext -- | While hasSomePassword uses the name of the host as context, -- this allows specifying a different context. This is useful when -- you want to use the same password on multiple hosts, for example. -hasSomePassword' :: UserName -> Context -> Property +hasSomePassword' :: IsContext c => UserName -> c -> Property hasSomePassword' user context = check ((/= HasPassword) <$> getPasswordStatus user) $ hasPassword' user context -- | Ensures that a user's password is set to the password from the PrivData. -- (Will change any existing password.) hasPassword :: UserName -> Property -hasPassword user = property (user ++ "has password") $ do - hostname <- asks hostName - ensureProperty $ hasPassword' user (Context hostname) +hasPassword user = hasPassword' user hostContext -hasPassword' :: UserName -> Context -> Property +hasPassword' :: IsContext c => UserName -> c -> Property hasPassword' user context = go `requires` shadowConfig True where - go = withPrivData (Password user) context $ \getpassword -> - property (user ++ " has password") $ - getpassword $ \password -> makeChange $ - withHandle StdinHandle createProcessSuccess - (proc "chpasswd" []) $ \h -> do - hPutStrLn h $ user ++ ":" ++ password - hClose h + go = withPrivData (Password user) context $ + property (user ++ " has password") . setPassword user + +setPassword :: UserName -> ((PrivData -> Propellor Result) -> Propellor Result) -> Propellor Result +setPassword user getpassword = getpassword $ \password -> makeChange $ + withHandle StdinHandle createProcessSuccess + (proc "chpasswd" []) $ \h -> do + hPutStrLn h $ user ++ ":" ++ password + hClose h lockedPassword :: UserName -> Property lockedPassword user = check (not <$> isLockedPassword user) $ cmdProperty "passwd" diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index f349a29..e00a457 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -165,7 +165,7 @@ data CmdLine -- | Information about a host. data Info = Info { _os :: Val System - , _privDataFields :: S.Set (PrivDataField, Context) + , _privDataFields :: S.Set (PrivDataField, HostContext) , _sshPubKey :: Val String , _aliases :: S.Set HostName , _dns :: S.Set Dns.Record diff --git a/src/Propellor/Types/PrivData.hs b/src/Propellor/Types/PrivData.hs index 16d6cdb..a18e7ce 100644 --- a/src/Propellor/Types/PrivData.hs +++ b/src/Propellor/Types/PrivData.hs @@ -15,7 +15,7 @@ data PrivDataField | GpgKey deriving (Read, Show, Ord, Eq) --- | Context in which a PrivDataField is used. +-- | A context in which a PrivDataField is used. -- -- Often this will be a domain name. For example, -- Context "www.example.com" could be used for the SSL cert @@ -24,10 +24,39 @@ data PrivDataField newtype Context = Context String deriving (Read, Show, Ord, Eq) +-- | A context that varies depending on the HostName where it's used. +newtype HostContext = HostContext { mkHostContext :: HostName -> Context } + +instance Show HostContext where + show hc = show $ mkHostContext hc "" + +instance Ord HostContext where + a <= b = show a <= show b + +instance Eq HostContext where + a == b = show a == show b + +-- | Class of things that can be used as a Context. +class IsContext c where + asContext :: HostName -> c -> Context + asHostContext :: c -> HostContext + +instance IsContext HostContext where + asContext = flip mkHostContext + asHostContext = id + +instance IsContext Context where + asContext _ c = c + asHostContext = HostContext . const + -- | Use when a PrivDataField is not dependent on any paricular context. anyContext :: Context anyContext = Context "any" +-- | Makes a HostContext that consists just of the hostname. +hostContext :: HostContext +hostContext = HostContext Context + type PrivData = String data SshKeyType = SshRsa | SshDsa | SshEcdsa | SshEd25519