summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Ssh.hs
diff options
context:
space:
mode:
authorJoey Hess2015-10-16 19:06:29 -0400
committerJoey Hess2015-10-16 19:06:29 -0400
commit91610aee8f34bb10959bdf6a6e5b16c895c7c1c2 (patch)
tree7e493e4b3044de2ce2f3ef2f96dcc5e27d11c19b /src/Propellor/Property/Ssh.hs
parent2d58a7e8ca2699442d8452c5d3bca8ce43d9e87a (diff)
improve ssh user key properties
* Ssh.keyImported is replaced with Ssh.userKeys. (API change) The new property only gets the private key from the privdata; the public key is provided as a parameter, and so is available as Info that other properties can use. * Ssh.keyImported' is renamed to Ssh.userKeyAt, and also changed to only import the private key from the privdata. (API change) * While Ssh.keyImported and Ssh.keyImported' avoided updating existing keys, the new Ssh.userKeys and Ssh.userKeyAt properties will always update out of date key files. * Ssh.pubKey renamed to Ssh.hostPubKey. (API change) This makes eg, setting up ssh for spin controllers work better.
Diffstat (limited to 'src/Propellor/Property/Ssh.hs')
-rw-r--r--src/Propellor/Property/Ssh.hs216
1 files changed, 133 insertions, 83 deletions
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 4450dd07..cdfa36b0 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -1,7 +1,10 @@
{-# LANGUAGE DeriveDataTypeable #-}
module Propellor.Property.Ssh (
+ installed,
+ restarted,
PubKeyText,
+ -- * Daemon configuration
sshdConfig,
ConfigKeyword,
setSshdConfigBool,
@@ -10,33 +13,42 @@ module Propellor.Property.Ssh (
permitRootLogin,
passwordAuthentication,
noPasswords,
- hasAuthorizedKeys,
- authorizedKey,
- restarted,
+ listenPort,
+ -- * Host keys
randomHostKeys,
hostKeys,
hostKey,
- pubKey,
- getPubKey,
- keyImported,
- keyImported',
+ hostPubKey,
+ getHostPubKey,
+ -- * User keys and configuration
+ userKeys,
+ userKeyAt,
knownHost,
+ authorizedKeysFrom,
authorizedKeys,
- listenPort
+ authorizedKey,
+ hasAuthorizedKeys,
+ getUserPubKeys,
) where
import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Service as Service
+import qualified Propellor.Property.Apt as Apt
import Propellor.Property.User
import Propellor.Types.Info
import Utility.FileMode
import System.PosixCompat
import qualified Data.Map as M
+import qualified Data.Set as S
import Data.List
-type PubKeyText = String
+installed :: Property NoInfo
+installed = Apt.installed ["ssh"]
+
+restarted :: Property NoInfo
+restarted = Service.restarted "ssh"
sshBool :: Bool -> String
sshBool True = "yes"
@@ -95,14 +107,26 @@ dotFile f user = do
d <- dotDir user
return $ d </> f
+-- | Makes the ssh server listen on a given port, in addition to any other
+-- ports it is configured to listen on.
+--
+-- Revert to prevent it listening on a particular port.
+listenPort :: Int -> RevertableProperty
+listenPort port = enable <!> disable
+ where
+ portline = "Port " ++ show port
+ enable = sshdConfig `File.containsLine` portline
+ `describe` ("ssh listening on " ++ portline)
+ `onChange` restarted
+ disable = sshdConfig `File.lacksLine` portline
+ `describe` ("ssh not listening on " ++ portline)
+ `onChange` restarted
+
hasAuthorizedKeys :: User -> IO Bool
hasAuthorizedKeys = go <=< dotFile "authorized_keys"
where
go f = not . null <$> catchDefaultIO "" (readFile f)
-restarted :: Property NoInfo
-restarted = Service.restarted "ssh"
-
-- | Blows away existing host keys and make new ones.
-- Useful for systems installed from an image that might reuse host keys.
-- A flag file is used to only ever do this once.
@@ -118,6 +142,9 @@ randomHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
ensureProperty $ scriptProperty
[ "DPKG_MAINTSCRIPT_NAME=postinst DPKG_MAINTSCRIPT_PACKAGE=openssh-server /var/lib/dpkg/info/openssh-server.postinst configure" ]
+-- | The text of a ssh public key, for example, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB3BJ2GqZiTR2LEoDXyYFgh/BduWefjdKXAsAtzS9zeI"
+type PubKeyText = String
+
-- | Installs the specified list of ssh host keys.
--
-- The corresponding private keys come from the privdata.
@@ -146,29 +173,25 @@ hostKeys ctx l = propertyList desc $ catMaybes $
-- the private key comes from the privdata;
hostKey :: IsContext c => c -> SshKeyType -> PubKeyText -> Property HasInfo
hostKey context keytype pub = combineProperties desc
- [ pubKey keytype pub
- , toProp $ property desc $ install writeFile True (lines pub)
+ [ hostPubKey keytype pub
+ , toProp $ property desc $ install File.hasContent True (lines pub)
, withPrivData (keysrc "" (SshPrivKey keytype "")) context $ \getkey ->
property desc $ getkey $
- install writeFileProtected False . privDataLines
+ install File.hasContentProtected False . privDataLines
]
`onChange` restarted
where
desc = "ssh host key configured (" ++ fromKeyType keytype ++ ")"
install writer ispub keylines = do
let f = keyFile keytype ispub
- have <- liftIO $ catchDefaultIO "" $ readFileStrict f
- let want = keyFileContent keylines
- if have == want
- then noChange
- else makeChange $ writer f want
+ ensureProperty $ writer f (keyFileContent keylines)
keysrc ext field = PrivDataSourceFileFromCommand field ("sshkey"++ext)
("ssh-keygen -t " ++ sshKeyTypeParam keytype ++ " -f sshkey")
-- Make sure that there is a newline at the end;
-- ssh requires this for some types of private keys.
-keyFileContent :: [String] -> String
-keyFileContent keylines = unlines (keylines ++ [""])
+keyFileContent :: [String] -> [File.Line]
+keyFileContent keylines = keylines ++ [""]
keyFile :: SshKeyType -> Bool -> FilePath
keyFile keytype ispub = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ ext
@@ -178,40 +201,71 @@ keyFile keytype ispub = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++
-- | Indicates the host key that is used by a Host, but does not actually
-- configure the host to use it. Normally this does not need to be used;
-- use 'hostKey' instead.
-pubKey :: SshKeyType -> PubKeyText -> Property HasInfo
-pubKey t = pureInfoProperty "ssh pubkey known" . SshPubKeyInfo . M.singleton t
+hostPubKey :: SshKeyType -> PubKeyText -> Property HasInfo
+hostPubKey t = pureInfoProperty "ssh pubkey known" . HostKeyInfo . M.singleton t
-getPubKey :: Propellor (M.Map SshKeyType PubKeyText)
-getPubKey = fromSshPubKeyInfo <$> askInfo
+getHostPubKey :: Propellor (M.Map SshKeyType PubKeyText)
+getHostPubKey = fromHostKeyInfo <$> askInfo
-newtype SshPubKeyInfo = SshPubKeyInfo
- { fromSshPubKeyInfo :: M.Map SshKeyType PubKeyText }
+newtype HostKeyInfo = HostKeyInfo
+ { fromHostKeyInfo :: M.Map SshKeyType PubKeyText }
deriving (Eq, Ord, Typeable)
-instance IsInfo SshPubKeyInfo where
+instance IsInfo HostKeyInfo where
propigateInfo _ = False
-instance Monoid SshPubKeyInfo where
- mempty = SshPubKeyInfo M.empty
- mappend (SshPubKeyInfo old) (SshPubKeyInfo new) =
+instance Monoid HostKeyInfo where
+ mempty = HostKeyInfo M.empty
+ mappend (HostKeyInfo old) (HostKeyInfo new) =
-- new first because union prefers values from the first
-- parameter when there is a duplicate key
- SshPubKeyInfo (new `M.union` old)
+ HostKeyInfo (new `M.union` old)
+
+userPubKeys :: User -> [(SshKeyType, PubKeyText)] -> Property HasInfo
+userPubKeys u@(User n) l = pureInfoProperty ("ssh pubkey known for " ++ n) $
+ UserKeyInfo (M.singleton u (S.fromList l))
+
+getUserPubKeys :: User -> Propellor [(SshKeyType, PubKeyText)]
+getUserPubKeys u = maybe [] S.toList . M.lookup u . fromUserKeyInfo <$> askInfo
+
+newtype UserKeyInfo = UserKeyInfo
+ { fromUserKeyInfo :: M.Map User (S.Set (SshKeyType, PubKeyText)) }
+ deriving (Eq, Ord, Typeable)
--- | Sets up a user with a ssh private key and public key pair from the
--- PrivData.
+instance IsInfo UserKeyInfo where
+ propigateInfo _ = False
+
+instance Monoid UserKeyInfo where
+ mempty = UserKeyInfo M.empty
+ mappend (UserKeyInfo old) (UserKeyInfo new) =
+ UserKeyInfo (M.unionWith S.union old new)
+
+-- | Sets up a user with the specified public keys, and the corresponding
+-- private keys from the privdata.
+--
+-- The public keys are added to the Info, so other properties like
+-- `authorizedKeysFrom` can use them.
+userKeys :: IsContext c => User -> c -> [(SshKeyType, PubKeyText)] -> Property HasInfo
+userKeys user@(User name) context ks = propertyList desc $
+ userPubKeys user ks : map (userKeyAt Nothing user context) ks
+ where
+ desc = unwords
+ [ name
+ , "has ssh key"
+ , "(" ++ unwords (map (fromKeyType . fst) ks) ++ ")"
+ ]
+
+-- | Sets up a user with a ssh private key and public key pair
+-- both coming from the PrivData.
--
--- If the user already has a private/public key, it is left unchanged.
-keyImported :: IsContext c => SshKeyType -> User -> c -> Property HasInfo
-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 -> User -> c -> Property HasInfo
-keyImported' dest keytype user@(User u) context = combineProperties desc
- [ installkey (SshPubKey keytype u) (install writeFile ".pub")
- , installkey (SshPrivKey keytype u) (install writeFileProtected "")
- ]
+-- A file can be specified to write the key to somewhere other than
+-- the default locations. Allows a user to have multiple keys for
+-- different roles.
+userKeyAt :: IsContext c => Maybe FilePath -> User -> c -> (SshKeyType, PubKeyText) -> Property HasInfo
+userKeyAt dest user@(User u) context (keytype, pubkeytext) =
+ propertyList desc $ props
+ & pubkey
+ & privkey
where
desc = unwords $ catMaybes
[ Just u
@@ -219,39 +273,34 @@ keyImported' dest keytype user@(User u) context = combineProperties desc
, dest
, Just $ "(" ++ fromKeyType keytype ++ ")"
]
- installkey p a = withPrivData p context $ \getkey ->
- property desc $ getkey a
+ pubkey = property desc $ install File.hasContent ".pub" [pubkeytext]
+ privkey = withPrivData (SshPrivKey keytype u) context $ \getkey ->
+ property desc $ getkey $
+ install File.hasContentProtected "" . privDataLines
install writer ext key = do
f <- liftIO $ keyfile ext
- ifM (liftIO $ doesFileExist f)
- ( noChange
- , ensureProperties
- [ property desc $ makeChange $ do
- createDirectoryIfMissing True (takeDirectory f)
- writer f (keyFileContent (privDataLines key))
- , File.ownerGroup f user (userGroup user)
- , File.ownerGroup (takeDirectory f) user (userGroup user)
- ]
- )
+ ensureProperties
+ [ writer f (keyFileContent key)
+ , File.ownerGroup f user (userGroup user)
+ , File.ownerGroup (takeDirectory f) user (userGroup user)
+ ]
keyfile ext = case dest of
Nothing -> do
home <- homeDirectory <$> getUserEntryForName u
return $ home </> ".ssh" </> "id_" ++ fromKeyType keytype ++ ext
Just f -> return $ f ++ ext
-
-
fromKeyType :: SshKeyType -> String
fromKeyType SshRsa = "rsa"
fromKeyType SshDsa = "dsa"
fromKeyType SshEcdsa = "ecdsa"
fromKeyType SshEd25519 = "ed25519"
--- | Puts some host's ssh public key(s), as set using 'pubKey' or 'hostKey'
--- into the known_hosts file for a user.
+-- | Puts some host's ssh public key(s), as set using `hostPubKey`
+-- or `hostKey` into the known_hosts file for a user.
knownHost :: [Host] -> HostName -> User -> Property NoInfo
knownHost hosts hn user@(User u) = property desc $
- go =<< fromHost hosts hn getPubKey
+ go =<< fromHost hosts hn getHostPubKey
where
desc = u ++ " knows ssh key for " ++ hn
go (Just m) | not (M.null m) = do
@@ -264,8 +313,26 @@ knownHost hosts hn user@(User u) = property desc $
, File.ownerGroup (takeDirectory f) user (userGroup user)
]
go _ = do
- warningMessage $ "no configred pubKey for " ++ hn
+ warningMessage $ "no configured ssh host keys for " ++ hn
+ return FailedChange
+
+-- | Ensures that a local user's authorized keys contains a line allowing
+-- logins from a remote user on the specified Host.
+--
+-- The ssh keys of the remote user can be set using `keysImported`
+--
+-- Any other lines in the authorized_keys file are preserved as-is.
+authorizedKeysFrom :: User -> (User, Host) -> Property NoInfo
+localuser@(User ln) `authorizedKeysFrom` (remoteuser@(User rn), remotehost) =
+ property desc $ go =<< fromHost' remotehost (getUserPubKeys remoteuser)
+ where
+ remote = rn ++ "@" ++ hostName remotehost
+ desc = ln ++ " authorized_keys from " ++ remote
+ go [] = do
+ warningMessage $ "no configured ssh user keys for " ++ remote
return FailedChange
+ go ks = ensureProperty $ propertyList desc $
+ map (authorizedKey localuser . snd) ks
-- | Makes a user have authorized_keys from the PrivData
--
@@ -274,11 +341,9 @@ authorizedKeys :: IsContext c => User -> c -> Property HasInfo
authorizedKeys user@(User u) context = withPrivData (SshAuthorizedKeys u) context $ \get ->
property (u ++ " has authorized_keys") $ get $ \v -> do
f <- liftIO $ dotFile "authorized_keys" user
- liftIO $ do
- createDirectoryIfMissing True (takeDirectory f)
- writeFileProtected f (keyFileContent (privDataLines v))
ensureProperties
- [ File.ownerGroup f user (userGroup user)
+ [ File.hasContentProtected f (keyFileContent (privDataLines v))
+ , File.ownerGroup f user (userGroup user)
, File.ownerGroup (takeDirectory f) user (userGroup user)
]
@@ -296,18 +361,3 @@ authorizedKey user@(User u) l = property desc $ do
]
where
desc = u ++ " has autorized_keys"
-
--- | Makes the ssh server listen on a given port, in addition to any other
--- ports it is configured to listen on.
---
--- Revert to prevent it listening on a particular port.
-listenPort :: Int -> RevertableProperty
-listenPort port = enable <!> disable
- where
- portline = "Port " ++ show port
- enable = sshdConfig `File.containsLine` portline
- `describe` ("ssh listening on " ++ portline)
- `onChange` restarted
- disable = sshdConfig `File.lacksLine` portline
- `describe` ("ssh not listening on " ++ portline)
- `onChange` restarted