summaryrefslogtreecommitdiff
path: root/src/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2014-12-07 14:57:35 -0400
committerJoey Hess2014-12-07 15:03:06 -0400
commit9ca332e48169ac19dad050a7f99e0db523d8d9c4 (patch)
treea1bbe51c18c64317a19d0dbd887fae4355a3bc50 /src/Propellor/Property
parent8c12047b6b6be67e086d60d79a95490598601a7a (diff)
Fixed privdata introspection for User.hasPassword and User.hasSomePassword
This is not a complete fix for the problem that Info doen't propigate from the called property when code does something like: do hostname <- asks hostName ensureProperty $ foo hostname Instead, I just eliminated the need to implement hasPassword that way, by making the PrivData Info use a HostContext which automatically gets the right hostname passed to it. All other uses of withPrivData don't have the problem. It's still possible for the user to run into the problem if they write something like the above, where foo is a property that uses privdata. However, all properties that take a Context now also accept a HostContext, so it's at least less likely the user needs to write that.
Diffstat (limited to 'src/Propellor/Property')
-rw-r--r--src/Propellor/Property/File.hs6
-rw-r--r--src/Propellor/Property/Ssh.hs6
-rw-r--r--src/Propellor/Property/Tor.hs2
-rw-r--r--src/Propellor/Property/User.hs28
4 files changed, 20 insertions, 22 deletions
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index bc499e07..d2296354 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 5d326b83..88a757bd 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 7a4e9158..9c63980c 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 5c8e768c..69794d84 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"