summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
authorJoey Hess2015-01-04 16:54:43 -0400
committerJoey Hess2015-01-04 16:54:43 -0400
commit0af7629c988dbce4b1074e6c760b8c2967411483 (patch)
treebe2e7b65c9bd6be1923ef3260863d36010dc7ed6 /src/Propellor
parenta2bb647827ee7eea0c038fdd40d1bd65c0d7a2c8 (diff)
propellor spin
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/Property/Ssh.hs77
1 files changed, 48 insertions, 29 deletions
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 8642d990..571adfd5 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -6,9 +6,9 @@ module Propellor.Property.Ssh (
authorizedKey,
restarted,
randomHostKeys,
- pubKey,
hostKeys,
hostKey,
+ pubKey,
keyImported,
knownHost,
authorizedKeys,
@@ -25,6 +25,8 @@ import Utility.FileMode
import System.PosixCompat
import qualified Data.Map as M
+type PubKeyText = String
+
sshBool :: Bool -> String
sshBool True = "yes"
sshBool False = "no"
@@ -81,41 +83,43 @@ 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" ]
--- | When a host has a well-known public host key, this can be used
--- to indicate what the key is. It does not cause the key to be installed.
-pubKey :: SshKeyType -> String -> Property
-pubKey t k = pureInfoProperty ("ssh pubkey known") $
- mempty { _sshPubKey = M.singleton t k }
-
-getPubKey :: Propellor (M.Map SshKeyType String)
-getPubKey = asks (_sshPubKey . hostInfo)
-
--- | Installs all available types of ssh host keys.
-hostKeys :: IsContext c => c -> Property
-hostKeys ctx = propertyList "known ssh host keys" $
- map (flip hostKey ctx) [minBound..maxBound]
+-- | Installs the specified list of ssh host keys.
+--
+-- The corresponding private keys come from the privdata.
+--
+-- Any host keysthat are not in the list are removed from the host.
+hostKeys :: IsContext c => c -> [(SshKeyType, PubKeyText)] -> Property
+hostKeys ctx l = propertyList desc $ catMaybes $
+ map (\(t, pub) -> Just $ hostKey ctx t pub) l ++ [cleanup]
+ where
+ desc = "ssh host keys configured " ++ typelist (map fst l)
+ typelist tl = "(" ++ unwords (map fromKeyType tl) ++ ")"
+ alltypes = [minBound..maxBound]
+ staletypes = filter (`notElem` alltypes) (map fst l)
+ removestale b = map (File.notPresent . flip keyFile b) staletypes
+ cleanup
+ | null staletypes = Nothing
+ | otherwise = Just $ property ("stale keys removed " ++ typelist staletypes) $
+ ensureProperty $
+ combineProperties desc (removestale True ++ removestale False)
+ `onChange` restarted
-- | Installs a single ssh host key of a particular type.
--
--- The private key comes from the privdata;
--- the public key is set using 'pubKey'.
-hostKey :: IsContext c => SshKeyType -> c -> Property
-hostKey keytype context = combineProperties desc
- [ property desc $ do
- v <- M.lookup keytype <$> getPubKey
- case v of
- Just k -> install writeFile ".pub" k
- Nothing -> do
- warningMessage $ "Missing ssh pubKey " ++ show keytype
- return FailedChange
+-- The public key is provided to this function;
+-- the private key comes from the privdata;
+hostKey :: IsContext c => c -> SshKeyType -> PubKeyText -> Property
+hostKey context keytype pub = combineProperties desc
+ [ pubKey keytype pub
+ , property desc $ install writeFile True pub
, withPrivData (keysrc "" (SshPrivKey keytype "")) context $ \getkey ->
- property desc $ getkey $ install writeFileProtected ""
+ property desc $ getkey $ install writeFileProtected False
]
`onChange` restarted
where
- desc = "known ssh host key (" ++ fromKeyType keytype ++ ")"
- install writer ext key = do
- let f = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ ext
+ desc = "ssh host key configured (" ++ fromKeyType keytype ++ ")"
+ install writer ispub key = do
+ let f = keyFile keytype ispub
s <- liftIO $ readFileStrict f
if s == key
then noChange
@@ -123,6 +127,21 @@ hostKey keytype context = combineProperties desc
keysrc ext field = PrivDataSourceFileFromCommand field ("sshkey"++ext)
("ssh-keygen -t " ++ sshKeyTypeParam keytype ++ " -f sshkey")
+keyFile :: SshKeyType -> Bool -> FilePath
+keyFile keytype ispub = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ ext
+ where
+ ext = if ispub then ".pub" else ""
+
+-- | 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
+pubKey t k = pureInfoProperty ("ssh pubkey known") $
+ mempty { _sshPubKey = M.singleton t k }
+
+getPubKey :: Propellor (M.Map SshKeyType String)
+getPubKey = asks (_sshPubKey . hostInfo)
+
-- | Sets up a user with a ssh private key and public key pair from the
-- PrivData.
keyImported :: IsContext c => SshKeyType -> UserName -> c -> Property