summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Ssh.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property/Ssh.hs')
-rw-r--r--src/Propellor/Property/Ssh.hs39
1 files changed, 30 insertions, 9 deletions
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 9290ea1e..f44688c1 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -12,6 +12,7 @@ module Propellor.Property.Ssh (
pubKey,
getPubKey,
keyImported,
+ keyImported',
knownHost,
authorizedKeys,
listenPort
@@ -147,13 +148,25 @@ getPubKey = asks (_sshPubKey . hostInfo)
-- | Sets up a user with a ssh private key and public key pair from the
-- PrivData.
+--
+-- If the user already has a private/public key, it is left unchanged.
keyImported :: IsContext c => SshKeyType -> UserName -> c -> Property HasInfo
-keyImported keytype user context = combineProperties desc
+keyImported = keyImported' Nothing
+
+-- | A file can be speficied to write the key to somewhere other than
+-- usual. Allows a user to have multiple keys for different roles.
+keyImported' :: IsContext c => Maybe FilePath -> SshKeyType -> UserName -> c -> Property HasInfo
+keyImported' dest keytype user context = combineProperties desc
[ installkey (SshPubKey keytype user) (install writeFile ".pub")
, installkey (SshPrivKey keytype user) (install writeFileProtected "")
]
where
- desc = user ++ " has ssh key (" ++ fromKeyType keytype ++ ")"
+ desc = unwords $ catMaybes
+ [ Just user
+ , Just "has ssh key"
+ , dest
+ , Just $ "(" ++ fromKeyType keytype ++ ")"
+ ]
installkey p a = withPrivData p context $ \getkey ->
property desc $ getkey a
install writer ext key = do
@@ -168,9 +181,11 @@ keyImported keytype user context = combineProperties desc
, File.ownerGroup (takeDirectory f) user user
]
)
- keyfile ext = do
- home <- homeDirectory <$> getUserEntryForName user
- return $ home </> ".ssh" </> "id_" ++ fromKeyType keytype ++ ext
+ keyfile ext = case dest of
+ Nothing -> do
+ home <- homeDirectory <$> getUserEntryForName user
+ return $ home </> ".ssh" </> "id_" ++ fromKeyType keytype ++ ext
+ Just f -> return $ f ++ ext
fromKeyType :: SshKeyType -> String
fromKeyType SshRsa = "rsa"
@@ -178,7 +193,7 @@ fromKeyType SshDsa = "dsa"
fromKeyType SshEcdsa = "ecdsa"
fromKeyType SshEd25519 = "ed25519"
--- | Puts some host's ssh public key(s), as set using 'pubKey',
+-- | Puts some host's ssh public key(s), as set using 'pubKey' or 'hostKey'
-- into the known_hosts file for a user.
knownHost :: [Host] -> HostName -> UserName -> Property NoInfo
knownHost hosts hn user = property desc $
@@ -192,6 +207,7 @@ knownHost hosts hn user = property desc $
, f `File.containsLines`
(map (\k -> hn ++ " " ++ k) (M.elems m))
, File.ownerGroup f user user
+ , File.ownerGroup (takeDirectory f) user user
]
go _ = do
warningMessage $ "no configred pubKey for " ++ hn
@@ -215,12 +231,17 @@ authorizedKeys user context = withPrivData (SshAuthorizedKeys user) context $ \g
-- | Ensures that a user's authorized_keys contains a line.
-- Any other lines in the file are preserved as-is.
authorizedKey :: UserName -> String -> Property NoInfo
-authorizedKey user l = property (user ++ " has autorized_keys line " ++ l) $ do
+authorizedKey user l = property desc $ do
f <- liftIO $ dotFile "authorized_keys" user
- ensureProperty $
- f `File.containsLine` l
+ ensureProperty $ combineProperties desc
+ [ f `File.containsLine` l
`requires` File.dirExists (takeDirectory f)
`onChange` File.mode f (combineModes [ownerWriteMode, ownerReadMode])
+ , File.ownerGroup f user user
+ , File.ownerGroup (takeDirectory f) user user
+ ]
+ where
+ desc = user ++ " has autorized_keys line " ++ l
-- | Makes the ssh server listen on a given port, in addition to any other
-- ports it is configured to listen on.