Merge branch 'joeyconfig'

5 files changed, 75 insertions, 11 deletions

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 448e70d2..7b39cd24 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -92,7 +92,7 @@ defaultMain hostlist = do
 	go False (Boot hn) = onlyProcess $ withhost hn boot
 
 	withhost :: HostName -> (Host -> IO ()) -> IO ()
-	withhost hn a = maybe (unknownhost hn) a (findHost hostlist hn)
+	withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn)
 
 onlyProcess :: IO a -> IO a
 onlyProcess a = bracket lock unlock (const a)
@@ -106,11 +106,12 @@ onlyProcess a = bracket lock unlock (const a)
 	alreadyrunning = error "Propellor is already running on this host!"
 	lockfile = localdir </> ".lock"
 
-unknownhost :: HostName -> IO a
-unknownhost h = errorMessage $ unlines
+unknownhost :: HostName -> [Host] -> IO a
+unknownhost h hosts = errorMessage $ unlines
 	[ "Propellor does not know about host: " ++ h
 	, "(Perhaps you should specify the real hostname on the command line?)"
 	, "(Or, edit propellor's config.hs to configure this host)"
+	, "Known hosts: " ++ unwords (map hostName hosts)
 	]
 
 buildFirst :: CmdLine -> IO () -> IO ()
@@ -209,7 +210,8 @@ spin hn hst = do
 	bootstrapcmd = shellWrap $ intercalate " ; "
 		[ "if [ ! -d " ++ localdir ++ " ]"
 		, "then " ++ intercalate " && "
-			[ "apt-get --no-install-recommends --no-upgrade -y install git make"
+			[ "apt-get update"
+			, "apt-get --no-install-recommends --no-upgrade -y install git make"
 			, "echo " ++ toMarked statusMarker (show NeedGitClone)
 			]
 		, "else " ++ intercalate " && "
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index c6e41b45..f85ded15 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -109,20 +109,24 @@ editPrivData field context = do
 listPrivDataFields :: [Host] -> IO ()
 listPrivDataFields hosts = do
 	m <- decryptPrivData
-	putStrLn "\n"
-	let usedby = M.unionsWith (++) $ map mkhostmap hosts
-	let rows = map (mkrow usedby) (M.keys m)
-	let table = tableWithHeader header rows
-	putStr $ unlines $ formatTable table
+	showtable "Currently set data:" $
+		map mkrow (M.keys m)
+	showtable "Data that would be used if set:" $
+		map mkrow (M.keys $ M.difference wantedmap m)
   where
   	header = ["Field", "Context", "Used by"]
-	mkrow usedby k@(field, (Context context)) =
+	mkrow k@(field, (Context context)) =
 		[ shellEscape $ show field
 		, shellEscape context
 		, intercalate ", " $ sort $ fromMaybe [] $ M.lookup k usedby
 		]
 	mkhostmap host = M.fromList $ map (\k -> (k, [hostName host])) $
 		S.toList $ _privDataFields $ hostInfo host
+	usedby = M.unionsWith (++) $ map mkhostmap hosts
+	wantedmap = M.fromList $ zip (M.keys usedby) (repeat "")
+	showtable desc rows = do
+		putStrLn $ "\n" ++ desc
+		putStr $ unlines $ formatTable $ tableWithHeader header rows
 
 setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO ()
 setPrivDataTo field context value = do
diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs
new file mode 100644
index 00000000..841861f4
--- /dev/null
+++ b/src/Propellor/Property/Grub.hs
@@ -0,0 +1,39 @@
+module Propellor.Property.Grub where
+
+import Propellor
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+
+-- | Eg, hd0,0 or xen/xvda1
+type GrubDevice = String
+
+type TimeoutSecs = Int
+
+-- | Use PV-grub chaining to boot
+--
+-- Useful when the VPS's pv-grub is too old to boot a modern kernel image.
+--
+-- http://notes.pault.ag/linode-pv-grub-chainning/
+--
+-- The rootdev should be in the form "hd0", while the bootdev is in the form
+-- "xen/xvda".
+chainPVGrub :: GrubDevice -> GrubDevice -> TimeoutSecs -> Property
+chainPVGrub rootdev bootdev timeout = combineProperties desc
+	[ File.dirExists "/boot/grub"
+	, "/boot/grub/menu.lst" `File.hasContent`
+		[ "default 1" 
+		, "timeout " ++ show timeout
+		, ""
+		, "title grub-xen shim"
+		, "root (" ++ rootdev ++ ")"
+		, "kernel /boot/xen-shim"
+		, "boot"
+		]
+	, "/boot/load.cf" `File.hasContent`
+		[ "configfile (" ++ bootdev ++ ")/boot/grub/grub.cfg" ]
+	, Apt.installed ["grub-xen"]
+	, flagFile (scriptProperty ["update-grub; grub-mkimage --prefix '(" ++ bootdev ++ ")/boot/grub' -c /boot/load.cf -O x86_64-xen /usr/lib/grub/x86_64-xen/*.mod > /boot/xen-shim"]) "/boot/xen-shim"
+			`describe` "/boot-xen-shim"
+	]
+  where
+	desc = "chain PV-grub"
diff --git a/src/Propellor/Property/HostingProvider/Linode.hs b/src/Propellor/Property/HostingProvider/Linode.hs
new file mode 100644
index 00000000..34d72184
--- /dev/null
+++ b/src/Propellor/Property/HostingProvider/Linode.hs
@@ -0,0 +1,10 @@
+module Propellor.Property.HostingProvider.Linode where
+
+import Propellor
+import qualified Propellor.Property.Grub as Grub
+
+-- | Linode's pv-grub-x86_64 does not currently support booting recent
+-- Debian kernels compressed with xz. This sets up pv-grub chaing to enable
+-- it.
+chainPVGrub :: Grub.TimeoutSecs -> Property
+chainPVGrub = Grub.chainPVGrub "hd0" "xen/xvda"
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 6785ede6..5a260476 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -5,6 +5,7 @@ module Propellor.Property.Ssh (
 	hasAuthorizedKeys,
 	restartSshd,
 	randomHostKeys,
+	hostKeys,
 	hostKey,
 	keyImported,
 	knownHost,
@@ -75,7 +76,15 @@ 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 ssh host keys.
+-- | Sets all types of ssh host keys from the privdata.
+hostKeys :: Context -> Property
+hostKeys ctx = propertyList "known ssh host keys"
+	[ hostKey SshDsa ctx
+	, hostKey SshRsa ctx
+	, hostKey SshEcdsa ctx
+	]
+
+-- | Sets a single ssh host key from the privdata.
 hostKey :: SshKeyType -> Context -> Property
 hostKey keytype context = combineProperties desc
 	[ installkey (SshPubKey keytype "")  (install writeFile ".pub")