summaryrefslogtreecommitdiff
path: root/src
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
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')
-rw-r--r--src/Propellor/Engine.hs17
-rw-r--r--src/Propellor/Property/Dns.hs2
-rw-r--r--src/Propellor/Property/SiteSpecific/Branchable.hs4
-rw-r--r--src/Propellor/Property/SiteSpecific/IABak.hs9
-rw-r--r--src/Propellor/Property/SiteSpecific/JoeySites.hs17
-rw-r--r--src/Propellor/Property/Spin.hs86
-rw-r--r--src/Propellor/Property/Ssh.hs216
-rw-r--r--src/Propellor/Types/OS.hs4
-rw-r--r--src/Propellor/Types/PrivData.hs2
9 files changed, 238 insertions, 119 deletions
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index 87fa4cd2..021ddd2c 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -7,6 +7,7 @@ module Propellor.Engine (
ensureProperty,
ensureProperties,
fromHost,
+ fromHost',
onlyProcess,
processChainOutput,
) where
@@ -76,17 +77,19 @@ ensureProperties ps = ensure ps NoChange
r <- actionMessageOn hn (propertyDesc p) (ensureProperty p)
ensure ls (r <> rs)
--- | Lifts an action into a different host.
+-- | Lifts an action into the context of a different host.
--
--- > fromHost hosts "otherhost" getPubKey
+-- > fromHost hosts "otherhost" Ssh.getHostPubKey
fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a)
fromHost l hn getter = case findHost l hn of
Nothing -> return Nothing
- Just h -> do
- (ret, _s, runlog) <- liftIO $
- runRWST (runWithHost getter) h ()
- tell runlog
- return (Just ret)
+ Just h -> Just <$> fromHost' h getter
+
+fromHost' :: Host -> Propellor a -> Propellor a
+fromHost' h getter = do
+ (ret, _s, runlog) <- liftIO $ runRWST (runWithHost getter) h ()
+ tell runlog
+ return ret
onlyProcess :: FilePath -> IO a -> IO a
onlyProcess lockfile a = bracket lock unlock (const a)
diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index 963b82f6..6646582b 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -524,7 +524,7 @@ getNamedConf = asks $ fromNamedConfMap . getInfo . hostInfo
genSSHFP :: Domain -> Host -> Propellor [(BindDomain, Record)]
genSSHFP domain h = concatMap mk . concat <$> (gen =<< get)
where
- get = fromHost [h] hostname Ssh.getPubKey
+ get = fromHost [h] hostname Ssh.getHostPubKey
gen = liftIO . mapM genSSHFP' . M.elems . fromMaybe M.empty
mk r = mapMaybe (\d -> if inDomain domain d then Just (d, r) else Nothing)
(AbsDomain hostname : cnames)
diff --git a/src/Propellor/Property/SiteSpecific/Branchable.hs b/src/Propellor/Property/SiteSpecific/Branchable.hs
index c62c1335..66b7ed11 100644
--- a/src/Propellor/Property/SiteSpecific/Branchable.hs
+++ b/src/Propellor/Property/SiteSpecific/Branchable.hs
@@ -50,7 +50,9 @@ server hosts = propertyList "branchable server" $ props
, "lru-size = 128"
]
& Gpg.keyImported (Gpg.GpgKeyId obnamkey) (User "root")
- & Ssh.keyImported SshRsa (User "root") (Context "branchable.com")
+ & Ssh.userKeys (User "root") (Context "branchable.com")
+ [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC2PqTSupwncqeffNwZQXacdEWp7L+TxllIxH7WjfRMb3U74mQxWI0lwqLVW6Fox430DvhSqF1y5rJBvTHh4i49Tc9lZ7mwAxA6jNOP6bmdfteaKKYmUw5qwtJW0vISBFu28qBO11Nq3uJ1D3Oj6N+b3mM/0D3Y3NoGgF8+2dLdi81u9+l6AQ5Jsnozi2Ni/Osx2oVGZa+IQDO6gX8VEP4OrcJFNJe8qdnvItcGwoivhjbIfzaqNNvswKgGzhYLOAS5KT8HsjvIpYHWkyQ5QUX7W/lqGSbjP+6B8C3tkvm8VLXbmaD+aSkyCaYbuoXC2BoJdS7Jh8phKMwPJmdYVepn")
+ ]
& Ssh.knownHost hosts "eubackup.kitenet.net" (User "root")
& Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")
diff --git a/src/Propellor/Property/SiteSpecific/IABak.hs b/src/Propellor/Property/SiteSpecific/IABak.hs
index 93cf0b71..fce5aefb 100644
--- a/src/Propellor/Property/SiteSpecific/IABak.hs
+++ b/src/Propellor/Property/SiteSpecific/IABak.hs
@@ -26,7 +26,7 @@ gitServer :: [Host] -> Property HasInfo
gitServer knownhosts = propertyList "iabak git server" $ props
& Git.cloned (User "root") repo "/usr/local/IA.BAK" (Just "server")
& Git.cloned (User "root") repo "/usr/local/IA.BAK/client" (Just "master")
- & Ssh.keyImported SshRsa (User "root") (Context "IA.bak.users.git")
+ & Ssh.userKeys (User "root") (Context "IA.bak.users.git") sshKeys
& Ssh.knownHost knownhosts "gitlab.com" (User "root")
& Git.cloned (User "root") userrepo "/usr/local/IA.BAK/pubkeys" (Just "master")
& Apt.serviceInstalledRunning "apache2"
@@ -45,7 +45,7 @@ gitServer knownhosts = propertyList "iabak git server" $ props
registrationServer :: [Host] -> Property HasInfo
registrationServer knownhosts = propertyList "iabak registration server" $ props
& User.accountFor (User "registrar")
- & Ssh.keyImported SshRsa (User "registrar") (Context "IA.bak.users.git")
+ & Ssh.userKeys (User "registrar") (Context "IA.bak.users.git") sshKeys
& Ssh.knownHost knownhosts "gitlab.com" (User "registrar")
& Git.cloned (User "registrar") repo "/home/registrar/IA.BAK" (Just "server")
& Git.cloned (User "registrar") userrepo "/home/registrar/users" (Just "master")
@@ -60,6 +60,11 @@ registrationServer knownhosts = propertyList "iabak registration server" $ props
where
link = "/usr/lib/cgi-bin/register.cgi"
+sshKeys :: [(SshKeyType, Ssh.PubKeyText)]
+sshKeys =
+ [ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQCoiE+CPiIQyfWnl/E9iKG3eo4QzlH30vi7xAgKolGaTu6qKy4XPtl+8MNm2Dqn9QEYRVyyOT/XH0yP5dRc6uyReT8dBy03MmLkVbj8Q+nKCz5YOMTxrY3sX6RRXU1zVGjeVd0DtC+rKRT7reoCxef42LAJTm8nCyZu/enAuso5qHqBbqulFz2YXEKfU1SEEXLawtvgGck1KmCyg+pqazeI1eHWXrojQf5isTBKfPQLWVppBkWAf5cA4wP5U1vN9dVirIdw66ds1M8vnGlkTBjxP/HLGBWGYhZHE7QXjXRsk2RIXlHN9q6GdNu8+F3HXS22mst47E4UAeRoiXSMMtF5")
+ ]
+
graphiteServer :: Property HasInfo
graphiteServer = propertyList "iabak graphite server" $ props
& Apt.serviceInstalledRunning "apache2"
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 3f3205e6..e8d8aef3 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -137,7 +137,10 @@ oldUseNetServer hosts = propertyList "olduse.net server" $ props
, "--client-name=spool"
, "--ssh-key=" ++ keyfile
] Obnam.OnlyClient
- `requires` Ssh.keyImported' (Just keyfile) SshRsa (User "root") (Context "olduse.net")
+ `requires` Ssh.userKeyAt (Just keyfile)
+ (User "root")
+ (Context "olduse.net")
+ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQD0F6L76SChMCIGmeyGhlFMUTgZ3BoTbATiOSs0A7KXQoI1LTE5ZtDzzUkrQRJVpJ640pfMR7cQZyBm8tv+kYIPp0238GrX43c1vgm0L78agDnBU7r2iNMyWIwhssK8O3ZAhp8Q4KCz1r8hP2nIiD0y1D1VWW8h4KWOS7I1XCEAjOTvFvEjTh6a9MyHrcIkv7teUUzTBRjNrsyijCFRk1+pEET54RueoOmEjQcWd/sK1tYRiMZjegRLBOus2wUWsUOvznJ2iniLONUTGAWRnEV+O7hLN6CD44osJ+wkZk8bPAumTS0zcSLckX1jpdHJicmAyeniWSd4FCqm1YE6/xDD")
`requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")
keyfile = "/root/.ssh/olduse.net.key"
@@ -183,13 +186,18 @@ mumbleServer hosts = combineProperties hn $ props
& Apt.serviceInstalledRunning "mumble-server"
& Obnam.backup "/var/lib/mumble-server" (Cron.Times "55 5 * * *")
[ "--repository=sftp://2318@usw-s002.rsync.net/~/" ++ hn ++ ".obnam"
+ , "--ssh-key=" ++ sshkey
, "--client-name=mumble"
] Obnam.OnlyClient
- `requires` Ssh.keyImported SshRsa (User "root") (Context hn)
+ `requires` Ssh.userKeyAt (Just sshkey)
+ (User "root")
+ (Context hn)
+ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDSXXSM3mM8SNu+qel9R/LkDIkjpV3bfpUtRtYv2PTNqicHP+DdoThrr0ColFCtLH+k2vQJvR2n8uMzHn53Dq2IO3TtD27+7rJSsJwAZ8oftNzuTir8IjAwX5g6JYJs+L0Ny4RB0ausd+An0k/CPMRl79zKxpZd2MBMDNXt8hyqu0vS0v1ohq5VBEVhBBvRvmNQvWOCj7PdrKQXpUBHruZOeVVEdUUXZkVc1H0t7LVfJnE+nGKyWbw2jM+7r3Rn5Semc4R1DxsfaF8lKkZyE88/5uZQ/ddomv8ptz6YZ5b+Bg6wfooWPC3RWAALjxnHaC2yN1VONAvHmT0uNn1o6v0b")
`requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")
& trivial (cmdProperty "chown" ["-R", "mumble-server:mumble-server", "/var/lib/mumble-server"])
where
hn = "mumble.debian.net"
+ sshkey = "/root/.ssh/mumble.debian.net.key"
-- git.kitenet.net and git.joeyh.name
gitServer :: [Host] -> Property HasInfo
@@ -199,7 +207,10 @@ gitServer hosts = propertyList "git.kitenet.net setup" $ props
, "--ssh-key=" ++ sshkey
, "--client-name=wren" -- historical
] Obnam.OnlyClient (Gpg.GpgKeyId "1B169BE1")
- `requires` Ssh.keyImported' (Just sshkey) SshRsa (User "root") (Context "git.kitenet.net")
+ `requires` Ssh.userKeyAt (Just sshkey)
+ (User "root")
+ (Context "git.kitenet.net")
+ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQD0F6L76SChMCIGmeyGhlFMUTgZ3BoTbATiOSs0A7KXQoI1LTE5ZtDzzUkrQRJVpJ640pfMR7cQZyBm8tv+kYIPp0238GrX43c1vgm0L78agDnBU7r2iNMyWIwhssK8O3ZAhp8Q4KCz1r8hP2nIiD0y1D1VWW8h4KWOS7I1XCEAjOTvFvEjTh6a9MyHrcIkv7teUUzTBRjNrsyijCFRk1+pEET54RueoOmEjQcWd/sK1tYRiMZjegRLBOus2wUWsUOvznJ2iniLONUTGAWRnEV+O7hLN6CD44osJ+wkZk8bPAumTS0zcSLckX1jpdHJicmAyeniWSd4FCqm1YE6/xDD")
`requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")
`requires` Ssh.authorizedKeys (User "family") (Context "git.kitenet.net")
`requires` User.accountFor (User "family")
diff --git a/src/Propellor/Property/Spin.hs b/src/Propellor/Property/Spin.hs
index 599fefd1..a08352d3 100644
--- a/src/Propellor/Property/Spin.hs
+++ b/src/Propellor/Property/Spin.hs
@@ -1,27 +1,35 @@
{-# LANGUAGE FlexibleInstances #-}
-module Propellor.Property.Spin (Spinnable(..), controller) where
+module Propellor.Property.Spin (
+ Spinnable(..),
+ controllerFor,
+ controllerKeys,
+ controlledBy,
+) where
import Propellor.Base
import Propellor.Spin (spin)
import Propellor.Types.CmdLine (ControllerChain(..))
import Propellor.Types.Info
+import qualified Propellor.Property.Ssh as Ssh
-- | A class of things that can be spinned.
class Spinnable t where
toSpin :: t -> Property NoInfo
instance Spinnable Host where
- toSpin h = property (cdesc (hostName h)) $ do
- ControllerChain cc <- getControllerChain
- if hostName h `elem` cc
- then noChange -- avoid loop
- else do
- liftIO $ spin (hostName h) Nothing (ControllerChain cc) h
- -- Don't know if the spin made a change to the
- -- remote host or not, but in any case, the
- -- local host was not changed.
- noChange
+ toSpin h = go `requires` Ssh.knownHost [h] (hostName h) (User "root")
+ where
+ go = property (cdesc (hostName h)) $ do
+ ControllerChain cc <- getControllerChain
+ if hostName h `elem` cc
+ then noChange -- avoid loop
+ else do
+ liftIO $ spin (hostName h) Nothing (ControllerChain cc) h
+ -- Don't know if the spin made a change to the
+ -- remote host or not, but in any case, the
+ -- local host was not changed.
+ noChange
-- | Each Host in the list is spinned in turn. Does not stop on spin
-- failure; does propigate overall success/failure.
@@ -36,26 +44,47 @@ instance Spinnable [Host] where
-- propellor is run on the controller host, it will in turn run
-- propellor on the controlled Hosts.
--
--- For example, if you have some webservers and some dnsservers,
+-- The controller needs to be able to ssh to the hosts it controls,
+-- and run propellor, as root. The controller is automatically configured
+-- with `Propellor.Property.Ssh.knownHost` to know the host keys of the
+-- hosts that it will ssh to. It's up to you to use `controllerKey`
+-- and `controlledBy` to set up the ssh keys that will let the controller
+-- log into the hosts it controls.
+--
+-- For example, if you have some webservers and a dnsserver,
-- and want a master that runs propellor on all of them:
--
-- > import Propellor
-- > import qualified Propellor.Property.Spin as Spin
+-- > import qualified Propellor.Property.Ssh as Ssh
-- > import qualified Propellor.Property.Cron as Cron
-- >
-- > main = defaultMain hosts
-- >
--- > hosts = master : webservers ++ dnsservers
--- >
--- > webservers = ...
+-- > hosts =
+-- > [ master
+-- > , dnsserver
+-- > ] ++ webservers
-- >
--- > dnsservers = ...
+-- > dnsserver = host "dns.example.com"
+-- > & Ssh.hostKeys hostContext [(SshEcdsa, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB3BJ2GqZiTR2LEoDXyYFgh/BduWefjdKXAsAtzS9zeI")]
+-- > & Spin.controlledBy master
+-- > & ...
-- >
+-- > webservers =
+-- > [ host "www1.example.com"
+-- > & Ssh.hostKeys hostContext [(SshEcdsa, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAICfFntnesZcYz2B2T41ay45igfckXRSh5uVffkuCQkLv")]
+-- > & Spin.controlledBy master
+-- > & ...
+-- > , ...
+-- > ]
+-- >
-- > master = host "master.example.com"
+-- > & Spin.controllerKeys [(SshEcdsa, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIFWD0Hau5FDLeNrDHKilNMKm9c68R3WD+NJOp2jPWvJV")]
+-- > -- Only update dnsserver once all webservers are successfully updated.
+-- > & Spin.controllerFor dnsserver
+-- > `requires` Spin.controllerFor webservers
-- > & Cron.runPropellor
--- > -- Only update dnsservers once all webservers are successfully updated.
--- > & Spin.controller dnsservers
--- > `requires` Spin.controller webservers
--
-- Multiple controllers can control the same hosts. However, when
-- propellor is already running on a host, a controller will fail
@@ -64,12 +93,27 @@ instance Spinnable [Host] where
--
-- Chains of controllers are supported; host A can control host B which
-- controls host C. Loops of controllers are automatically prevented.
-controller :: Spinnable h => h -> Property NoInfo
-controller = toSpin
+controllerFor :: Spinnable h => h -> Property NoInfo
+controllerFor h = toSpin h
+ `requires` Ssh.installed
+
+-- | Uses `Propellor.Property.Ssh.keysImported` to set up the ssh keys
+-- for a controller; so the corresponding private keys come from the privdata.
+controllerKeys :: [(SshKeyType, Ssh.PubKeyText)] -> Property HasInfo
+controllerKeys ks = Ssh.userKeys (User "root") hostContext ks
+ `requires` Ssh.installed
+
+-- | Use this property to let the specified controller Host ssh in
+-- and run propellor.
+controlledBy :: Host -> Property NoInfo
+controlledBy h = User "root" `Ssh.authorizedKeysFrom` (User "root", h)
+ `requires` Ssh.installed
cdesc :: String -> Desc
cdesc n = "controller for " ++ n
+-- | The current host is included on the chain, as well as any hosts that
+-- acted as controllers to get the current propellor process to run.
getControllerChain :: Propellor ControllerChain
getControllerChain = do
hn <- hostName <$> ask
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
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
index eb6b5171..b16939c7 100644
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -40,8 +40,12 @@ type Release = String
type Architecture = String
type UserName = String
+
newtype User = User UserName
+ deriving (Eq, Ord)
+
newtype Group = Group String
+ deriving (Eq, Ord)
-- | Makes a Group with the same name as the User.
userGroup :: User -> Group
diff --git a/src/Propellor/Types/PrivData.hs b/src/Propellor/Types/PrivData.hs
index 1cf22aa9..32b51c4b 100644
--- a/src/Propellor/Types/PrivData.hs
+++ b/src/Propellor/Types/PrivData.hs
@@ -12,7 +12,7 @@ import qualified Data.ByteString.Lazy as L
-- It's fine to add new constructors.
data PrivDataField
= DockerAuthentication
- | SshPubKey SshKeyType UserName
+ | SshPubKey SshKeyType UserName -- ^ Not used anymore, but retained to avoid breaking serialization of old files
| SshPrivKey SshKeyType UserName -- ^ For host key, use empty UserName
| SshAuthorizedKeys UserName
| Password UserName