Merge branch 'joeyconfig'

Conflicts:
	privdata.joey/privdata.gpg

6 files changed, 300 insertions, 50 deletions

diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs
index f351804c..581a9bfe 100644
--- a/src/Propellor/Property/Dns.hs
+++ b/src/Propellor/Property/Dns.hs
@@ -1,6 +1,7 @@
 module Propellor.Property.Dns (
 	module Propellor.Types.Dns,
 	primary,
+	signedPrimary,
 	secondary,
 	secondaryFor,
 	mkSOA,
@@ -17,6 +18,8 @@ import Propellor.Types.Dns
 import Propellor.Property.File
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Service as Service
+import Propellor.Property.Scheduled
+import Propellor.Property.DnsSec
 import Utility.Applicative
 
 import qualified Data.Map as M
@@ -53,18 +56,20 @@ import Data.List
 primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty
 primary hosts domain soa rs = RevertableProperty setup cleanup
   where
-	setup = withwarnings (check needupdate baseprop)
-		`requires` servingZones
+	setup = setupPrimary zonefile id hosts domain soa rs
+		`onChange` Service.reloaded "bind9"
+	cleanup = cleanupPrimary zonefile domain
 		`onChange` Service.reloaded "bind9"
-	cleanup = check (doesFileExist zonefile) $
-		property ("removed dns primary for " ++ domain)
-			(makeChange $ removeZoneFile zonefile)
-			`requires` namedConfWritten
-			`onChange` Service.reloaded "bind9"
 
+	zonefile = "/etc/bind/propellor/db." ++ domain
+
+setupPrimary :: FilePath -> (FilePath -> FilePath) -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property
+setupPrimary zonefile mknamedconffile hosts domain soa rs = 
+	withwarnings (check needupdate baseprop)
+		`requires` servingZones
+  where
 	(partialzone, zonewarnings) = genZone hosts domain soa
 	zone = partialzone { zHosts = zHosts partialzone ++ rs }
-	zonefile = "/etc/bind/propellor/db." ++ domain
 	baseprop = Property ("dns primary for " ++ domain)
 		(makeChange $ writeZoneFile zone zonefile)
 		(addNamedConf conf)
@@ -74,7 +79,7 @@ primary hosts domain soa rs = RevertableProperty setup cleanup
 	conf = NamedConf
 		{ confDomain = domain
 		, confDnsServerType = Master
-		, confFile = zonefile
+		, confFile = mknamedconffile zonefile
 		, confMasters = []
 		, confAllowTransfer = nub $
 			concatMap (\h -> hostAddresses h hosts) $
@@ -97,6 +102,63 @@ primary hosts domain soa rs = RevertableProperty setup cleanup
 				    z = zone { zSOA = (zSOA zone) { sSerial = oldserial } }
 				in z /= oldzone || oldserial < sSerial (zSOA zone)
 
+
+cleanupPrimary :: FilePath -> Domain -> Property
+cleanupPrimary zonefile domain = check (doesFileExist zonefile) $
+	property ("removed dns primary for " ++ domain)
+		(makeChange $ removeZoneFile zonefile)
+		`requires` namedConfWritten
+
+-- | Primary dns server for a domain, secured with DNSSEC.
+--
+-- This is like `primary`, except the resulting zone
+-- file is signed.
+-- The Zone Signing Key (ZSK) and Key Signing Key (KSK)
+-- used in signing it are taken from the PrivData.
+--
+-- As a side effect of signing the zone, a
+-- </var/cache/bind/dsset-domain.>
+-- file will be created. This file contains the DS records
+-- which need to be communicated to your domain registrar
+-- to make DNSSEC be used for your domain. Doing so is outside
+-- the scope of propellor (currently). See for example the tutorial
+-- <https://www.digitalocean.com/community/tutorials/how-to-setup-dnssec-on-an-authoritative-bind-dns-server--2>
+--
+-- The 'Recurrance' controls how frequently the signature
+-- should be regenerated, using a new random salt, to prevent
+-- zone walking attacks. `Weekly Nothing` is a reasonable choice.
+--
+-- To transition from 'primary' to 'signedPrimary', you can revert
+-- the 'primary' property, and add this property.
+--
+-- Note that DNSSEC zone files use a serial number based on the unix epoch.
+-- This is different from the serial number used by 'primary', so if you
+-- want to later disable DNSSEC you will need to adjust the serial number
+-- passed to mkSOA to ensure it is larger.
+signedPrimary :: Recurrance -> [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty
+signedPrimary recurrance hosts domain soa rs = RevertableProperty setup cleanup
+  where
+	setup = combineProperties ("dns primary for " ++ domain ++ " (signed)")
+		[ setupPrimary zonefile signedZoneFile hosts domain soa rs'
+		, toProp (zoneSigned domain zonefile)
+		, forceZoneSigned domain zonefile `period` recurrance
+		]
+		`onChange` Service.reloaded "bind9"
+	
+	cleanup = cleanupPrimary zonefile domain
+		`onChange` toProp (revert (zoneSigned domain zonefile))
+		`onChange` Service.reloaded "bind9"
+	
+	-- Include the public keys into the zone file.
+	rs' = include PubKSK : include PubZSK : rs
+	include k = (RootDomain, INCLUDE (keyFn domain k))
+
+	-- Put DNSSEC zone files in a different directory than is used for
+	-- the regular ones. This allows 'primary' to be reverted and
+	-- 'signedPrimary' enabled, without the reverted property stomping
+	-- on the new one's settings.
+	zonefile = "/etc/bind/propellor/dnssec/db." ++ domain
+
 -- | Secondary dns server for a domain.
 --
 -- The primary server is determined by looking at the properties of other
@@ -216,6 +278,7 @@ rField (MX _ _) = "MX"
 rField (NS _) = "NS"
 rField (TXT _) = "TXT"
 rField (SRV _ _ _ _) = "SRV"
+rField (INCLUDE _) = "$INCLUDE"
 
 rValue :: Record -> String
 rValue (Address (IPv4 addr)) = addr
@@ -229,6 +292,7 @@ rValue (SRV priority weight port target) = unwords
 	, show port
 	, dValue target
 	]
+rValue (INCLUDE f) = f
 rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]
   where
 	q = '"'
@@ -294,12 +358,16 @@ genZoneFile (Zone zdomain soa rs) = unlines $
 	header = com $ "BIND zone file for " ++ zdomain ++ ". Generated by propellor, do not edit."
 
 genRecord :: Domain -> (BindDomain, Record) -> String
+genRecord _ (_, record@(INCLUDE _)) = intercalate "\t"
+		[ rField record
+		, rValue record
+		]
 genRecord zdomain (domain, record) = intercalate "\t"
-	[ domainHost zdomain domain
-	, "IN"
-	, rField record
-	, rValue record
-	]
+		[ domainHost zdomain domain
+		, "IN"
+		, rField record
+		, rValue record
+		]
 
 genSOA :: SOA -> [String]
 genSOA soa = 
diff --git a/src/Propellor/Property/DnsSec.hs b/src/Propellor/Property/DnsSec.hs
new file mode 100644
index 00000000..b7557006
--- /dev/null
+++ b/src/Propellor/Property/DnsSec.hs
@@ -0,0 +1,122 @@
+module Propellor.Property.DnsSec where
+
+import Propellor
+import qualified Propellor.Property.File as File
+
+-- | Puts the DNSSEC key files in place from PrivData.
+--
+-- signedPrimary uses this, so this property does not normally need to be
+-- used directly.
+keysInstalled :: Domain -> RevertableProperty
+keysInstalled domain = RevertableProperty setup cleanup
+  where
+	setup = propertyList "DNSSEC keys installed" $
+		map installkey keys
+
+	cleanup = propertyList "DNSSEC keys removed" $
+		map (File.notPresent . keyFn domain) keys
+
+	installkey k = writer (keysrc k) (keyFn domain k) (Context domain)
+	  where
+		writer
+			| isPublic k = File.hasPrivContentExposedFrom
+			| otherwise = File.hasPrivContentFrom
+
+	keys = [ PubZSK, PrivZSK, PubKSK, PrivKSK ]
+
+	keysrc k = PrivDataSource (DnsSec k) $ unwords
+		[ "The file with extension"
+		, keyExt k
+		, "created by running:"
+		, if isZoneSigningKey k
+			then "dnssec-keygen -a RSASHA256 -b 2048 -n ZONE " ++ domain
+			else "dnssec-keygen -f KSK -a RSASHA256 -b 4096 -n ZONE " ++ domain
+		]
+
+-- | Uses dnssec-signzone to sign a domain's zone file.
+--
+-- signedPrimary uses this, so this property does not normally need to be
+-- used directly.
+zoneSigned :: Domain -> FilePath -> RevertableProperty
+zoneSigned domain zonefile = RevertableProperty setup cleanup
+  where
+	setup = check needupdate (forceZoneSigned domain zonefile)
+		`requires` toProp (keysInstalled domain)
+	
+	cleanup = combineProperties ("removed signed zone for " ++ domain)
+		[ File.notPresent (signedZoneFile zonefile)
+		, File.notPresent dssetfile
+		, toProp (revert (keysInstalled domain))
+		]
+	
+	dssetfile = dir </> "-" ++ domain ++ "."
+	dir = takeDirectory zonefile
+
+	-- Need to update the signed zone file if the zone file or
+	-- any of the keys have a newer timestamp.
+	needupdate = do
+		v <- catchMaybeIO $ getModificationTime (signedZoneFile zonefile)
+		case v of
+			Nothing -> return True
+			Just t1 -> anyM (newerthan t1) $
+				zonefile : map (keyFn domain) [minBound..maxBound]
+
+	newerthan t1 f = do
+		t2 <- getModificationTime f
+		return (t2 >= t1)
+
+forceZoneSigned :: Domain -> FilePath -> Property
+forceZoneSigned domain zonefile = property ("zone signed for " ++ domain) $ liftIO $ do
+	salt <- take 16 <$> saltSha1
+ 	let p = proc "dnssec-signzone"
+		[ "-A"
+		, "-3", salt
+		-- The serial number needs to be increased each time the
+		-- zone is resigned, even if there are no other changes,
+		-- so that it will propigate to secondaries. So, use the
+		-- unixtime serial format.
+		, "-N", "unixtime"
+		, "-o", domain
+		, zonefile
+		-- the ordering of these key files does not matter
+		, keyFn domain PubZSK  
+		, keyFn domain PubKSK
+		]
+	-- Run in the same directory as the zonefile, so it will 
+	-- write the dsset file there.
+	(_, _, _, h) <- createProcess $ 
+		p { cwd = Just (takeDirectory zonefile) }
+	ifM (checkSuccessProcess h)
+		( return MadeChange
+		, return FailedChange
+		)
+
+saltSha1 :: IO String
+saltSha1 = readProcess "sh"
+	[ "-c"
+	, "head -c 1024 /dev/urandom | sha1sum | cut -d ' ' -f 1"
+	]
+
+-- | The file used for a given key.
+keyFn :: Domain -> DnsSecKey -> FilePath
+keyFn domain k =  "/etc/bind/propellor/dnssec" </> concat
+	[ "K" ++ domain ++ "."
+	, if isZoneSigningKey k then "ZSK" else "KSK"
+	, keyExt k
+	]
+
+-- | These are the extensions that dnssec-keygen looks for.
+keyExt :: DnsSecKey -> String
+keyExt k
+	| isPublic k = ".key"
+	| otherwise = ".private"
+
+isPublic :: DnsSecKey -> Bool
+isPublic k = k `elem` [PubZSK, PubKSK]
+
+isZoneSigningKey :: DnsSecKey -> Bool
+isZoneSigningKey k = k `elem` [PubZSK, PrivZSK]
+
+-- | dnssec-signzone makes a .signed file
+signedZoneFile :: FilePath -> FilePath
+signedZoneFile zonefile = zonefile ++ ".signed"
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 02bda2e9..eb0d8ec5 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -351,29 +351,44 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
 	-- Check if the ident has changed; if so the
 	-- parameters of the container differ and it must
 	-- be restarted.
-	checkident runningident
+	checkident (Right runningident)
 		| runningident == Just ident = noChange
 		| otherwise = do
 			void $ liftIO $ stopContainer cid
 			restartcontainer
+	checkident (Left errmsg) = do
+		warningMessage errmsg
+		return FailedChange
 
 	restartcontainer = do
 		oldimage <- liftIO $ fromMaybe image <$> commitContainer cid
 		void $ liftIO $ removeContainer cid
 		go oldimage
 
-	getrunningident = readish
-		<$> readProcess' (inContainerProcess cid [] ["cat", propellorIdent])
+	getrunningident = withTmpFile "dockerrunsane" $ \t h -> do
+		-- detect #774376 which caused docker exec to not enter
+		-- the container namespace, and be able to access files
+		-- outside
+		hClose h
+		void . checkSuccessProcess . processHandle =<<
+			createProcess (inContainerProcess cid []
+				["rm", "-f", t])
+		ifM (doesFileExist t)
+			( Right . readish <$>
+				readProcess' (inContainerProcess cid []
+					["cat", propellorIdent])
+			, return $ Left "docker exec failed to enter chroot properly (maybe an old kernel version?)"
+			)
 
-	retry :: Int -> IO (Maybe a) -> IO (Maybe a)
-	retry 0 _ = return Nothing
+	retry :: Int -> IO (Either e (Maybe a)) -> IO (Either e (Maybe a))
+	retry 0 _ = return (Right Nothing)
 	retry n a = do
 		v <- a
 		case v of
-			Just _ -> return v
-			Nothing -> do
-				threadDelaySeconds (Seconds 1)				
+			Right Nothing -> do
+				threadDelaySeconds (Seconds 1)		
 				retry (n-1) a
+			_ -> return v
 
 	go img = do
 		liftIO $ do
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index 76de68c0..032268c4 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -18,18 +18,26 @@ f `hasContent` newcontent = fileProperty ("replace " ++ f)
 -- The file's permissions are preserved if the file already existed.
 -- Otherwise, they're set to 600.
 hasPrivContent :: IsContext c => FilePath -> c -> Property
-hasPrivContent = hasPrivContent' writeFileProtected
+hasPrivContent f = hasPrivContentFrom (PrivDataSourceFile (PrivFile f) f) f
+
+-- | Like hasPrivContent, but allows specifying a source
+-- for PrivData, rather than using PrivDataSourceFile.
+hasPrivContentFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property
+hasPrivContentFrom = hasPrivContent' writeFileProtected
 
 -- | Leaves the file at its default or current mode,
 -- allowing "private" data to be read.
 --
 -- Use with caution!
 hasPrivContentExposed :: IsContext c => FilePath -> c -> Property
-hasPrivContentExposed = hasPrivContent' writeFile
+hasPrivContentExposed f = hasPrivContentExposedFrom (PrivDataSourceFile (PrivFile f) f) f
+
+hasPrivContentExposedFrom :: (IsContext c, IsPrivDataSource s) => s -> FilePath -> c -> Property
+hasPrivContentExposedFrom = hasPrivContent' writeFile
 
-hasPrivContent' :: IsContext c => (String -> FilePath -> IO ()) -> FilePath -> c -> Property
-hasPrivContent' writer f context = 
-	withPrivData (PrivDataSourceFile (PrivFile f) f) context $ \getcontent -> 
+hasPrivContent' :: (IsContext c, IsPrivDataSource s) => (String -> FilePath -> IO ()) -> s -> FilePath -> c -> Property
+hasPrivContent' writer source f context = 
+	withPrivData source context $ \getcontent -> 
 		property desc $ getcontent $ \privcontent -> 
 			ensureProperty $ fileProperty' writer desc
 				(\_oldcontent -> lines privcontent) f
diff --git a/src/Propellor/Property/HostingProvider/CloudAtCost.hs b/src/Propellor/Property/HostingProvider/CloudAtCost.hs
index 003bd3c5..f45a4aa8 100644
--- a/src/Propellor/Property/HostingProvider/CloudAtCost.hs
+++ b/src/Propellor/Property/HostingProvider/CloudAtCost.hs
@@ -10,7 +10,6 @@ import qualified Propellor.Property.User as User
 decruft :: Property
 decruft = propertyList "cloudatcost cleanup"
 	[ Hostname.sane
-	, Ssh.randomHostKeys
 	, "worked around grub/lvm boot bug #743126" ==>
 		"/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true"
 		`onChange` cmdProperty "update-grub" []
@@ -18,6 +17,7 @@ decruft = propertyList "cloudatcost cleanup"
 	, combineProperties "nuked cloudatcost cruft"
 		[ File.notPresent "/etc/rc.local"
 		, File.notPresent "/etc/init.d/S97-setup.sh"
+		, File.notPresent "/zang-debian.sh"
 		, User.nuked "user" User.YesReallyDeleteHome
 		]
 	]
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 695b67cb..b6ed476e 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -8,6 +8,7 @@ module Propellor.Property.Ssh (
 	randomHostKeys,
 	hostKeys,
 	hostKey,
+	pubKey,
 	keyImported,
 	knownHost,
 	authorizedKeys,
@@ -22,6 +23,9 @@ import Utility.SafeCommand
 import Utility.FileMode
 
 import System.PosixCompat
+import qualified Data.Map as M
+
+type PubKeyText = String
 
 sshBool :: Bool -> String
 sshBool True = "yes"
@@ -79,27 +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" ]
 
--- | Sets all types of ssh host keys from the privdata.
-hostKeys :: IsContext c => c -> Property
-hostKeys ctx = propertyList "known ssh host keys"
-	[ hostKey SshDsa ctx
-	, hostKey SshRsa ctx
-	, hostKey SshEcdsa ctx
-	]
+-- | 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 = let have = map fst l in filter (`notElem` have) alltypes
+	removestale b = map (File.notPresent . flip keyFile b) staletypes
+	cleanup
+		| null staletypes || null l = Nothing
+		| otherwise = Just $ property ("any other ssh host keys removed " ++ typelist staletypes) $
+			ensureProperty $
+				combineProperties desc (removestale True ++ removestale False)
+				`onChange` restarted
 
--- | Sets a single ssh host key from the privdata.
-hostKey :: IsContext c => SshKeyType -> c -> Property
-hostKey keytype context = combineProperties desc
-	[ installkey (keysrc ".pub" (SshPubKey keytype ""))  (install writeFile ".pub")
-	, installkey (keysrc "" (SshPrivKey keytype "")) (install writeFileProtected "")
+-- | Installs a single ssh host key of a particular type.
+--
+-- 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 False
 	]
 	`onChange` restarted
   where
-	desc = "known ssh host key (" ++ fromKeyType keytype ++ ")"
-	installkey p a = withPrivData p context $ \getkey ->
-		property desc $ getkey a
-	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
@@ -107,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
@@ -140,21 +175,23 @@ fromKeyType SshDsa = "dsa"
 fromKeyType SshEcdsa = "ecdsa"
 fromKeyType SshEd25519 = "ed25519"
 
--- | Puts some host's ssh public key into the known_hosts file for a user.
+-- | Puts some host's ssh public key(s), as set using 'pubKey',
+-- into the known_hosts file for a user.
 knownHost :: [Host] -> HostName -> UserName -> Property
 knownHost hosts hn user = property desc $
-	go =<< fromHost hosts hn getSshPubKey
+	go =<< fromHost hosts hn getPubKey
   where
 	desc = user ++ " knows ssh key for " ++ hn
-	go (Just (Just k)) = do
+	go (Just m) | not (M.null m) = do
 		f <- liftIO $ dotFile "known_hosts" user
 		ensureProperty $ combineProperties desc
 			[ File.dirExists (takeDirectory f)
-			, f `File.containsLine` (hn ++ " " ++ k)
+			, f `File.containsLines`
+				(map (\k -> hn ++ " " ++ k) (M.elems m))
 			, File.ownerGroup f user user
 			]
 	go _ = do
-		warningMessage $ "no configred sshPubKey for " ++ hn
+		warningMessage $ "no configred pubKey for " ++ hn
 		return FailedChange
 
 -- | Makes a user have authorized_keys from the PrivData