Merge branch 'joeyconfig'

27 files changed, 719 insertions, 244 deletions

diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
new file mode 100644
index 00000000..4bc1c2c7
--- /dev/null
+++ b/Propellor/Attr.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE PackageImports #-}
+
+module Propellor.Attr where
+
+import Propellor.Types
+import Propellor.Types.Attr
+
+import "mtl" Control.Monad.Reader
+import qualified Data.Set as S
+import qualified Data.Map as M
+
+pureAttrProperty :: Desc -> (Attr -> Attr) -> AttrProperty 
+pureAttrProperty desc = AttrProperty $ Property ("has " ++ desc)
+	(return NoChange)
+
+hostname :: HostName -> AttrProperty
+hostname name = pureAttrProperty ("hostname " ++ name) $
+	\d -> d { _hostname = name }
+
+getHostName :: Propellor HostName
+getHostName = asks _hostname
+
+cname :: Domain -> AttrProperty
+cname domain = pureAttrProperty ("cname " ++ domain) (addCName domain)
+
+cnameFor :: IsProp p => Domain -> (Domain -> p) -> AttrProperty
+cnameFor domain mkp =
+	let p = mkp domain
+	in AttrProperty p (addCName domain)
+
+addCName :: HostName -> Attr -> Attr
+addCName domain d = d { _cnames = S.insert domain (_cnames d) }
+
+hostnameless :: Attr
+hostnameless = newAttr (error "hostname Attr not specified")
+
+hostAttr :: Host -> Attr
+hostAttr (Host _ mkattrs) = mkattrs hostnameless
+
+hostProperties :: Host -> [Property]
+hostProperties (Host ps _) = ps
+
+hostMap :: [Host] -> M.Map HostName Host
+hostMap l = M.fromList $ zip (map (_hostname . hostAttr) l) l 
+
+findHost :: [Host] -> HostName -> Maybe Host
+findHost l hn = M.lookup hn (hostMap l)
diff --git a/Propellor/CmdLine.hs b/Propellor/CmdLine.hs
index 5ea982c3..5be91c4f 100644
--- a/Propellor/CmdLine.hs
+++ b/Propellor/CmdLine.hs
@@ -16,6 +16,7 @@ import qualified Propellor.Property.Docker as Docker
 import qualified Propellor.Property.Docker.Shim as DockerShim
 import Utility.FileMode
 import Utility.SafeCommand
+import Utility.UserInfo
 
 usage :: IO a
 usage = do
@@ -54,8 +55,8 @@ processCmdLine = go =<< getArgs
 			else return $ Run s
 	go _ = usage
 
-defaultMain :: [HostName -> Maybe [Property]] -> IO ()
-defaultMain getprops = do
+defaultMain :: [Host] -> IO ()
+defaultMain hostlist = do
 	DockerShim.cleanEnv
 	checkDebugMode
 	cmdline <- processCmdLine
@@ -63,23 +64,26 @@ defaultMain getprops = do
 	go True cmdline
   where
 	go _ (Continue cmdline) = go False cmdline
-	go _ (Set host field) = setPrivData host field
+	go _ (Set hn field) = setPrivData hn field
 	go _ (AddKey keyid) = addKey keyid
-	go _ (Chain host) = withprops host $ \ps -> do
-		r <- ensureProperties' ps
+	go _ (Chain hn) = withprops hn $ \attr ps -> do
+		r <- runPropellor attr $ ensureProperties ps
 		putStrLn $ "\n" ++ show r
-	go _ (Docker host) = Docker.chain host
+	go _ (Docker hn) = Docker.chain hn
 	go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline
 	go True cmdline = updateFirst cmdline $ go False cmdline
-	go False (Spin host) = withprops host $ const $ spin host
-	go False (Run host) = ifM ((==) 0 <$> getRealUserID)
-		( onlyProcess $ withprops host ensureProperties
-		, go True (Spin host)
+	go False (Spin hn) = withprops hn $ const . const $ spin hn
+	go False (Run hn) = ifM ((==) 0 <$> getRealUserID)
+		( onlyProcess $ withprops hn mainProperties
+		, go True (Spin hn)
 		)
-	go False (Boot host) = onlyProcess $ withprops host $ boot
+	go False (Boot hn) = onlyProcess $ withprops hn boot
 
-	withprops host a = maybe (unknownhost host) a $
-		headMaybe $ catMaybes $ map (\get -> get host) getprops
+	withprops :: HostName -> (Attr -> [Property] -> IO ()) -> IO ()
+	withprops hn a = maybe
+		(unknownhost hn)
+		(\h -> a (hostAttr h) (hostProperties h))
+		(findHost hostlist hn)
 
 onlyProcess :: IO a -> IO a
 onlyProcess a = bracket lock unlock (const a)
@@ -95,7 +99,7 @@ onlyProcess a = bracket lock unlock (const a)
 
 unknownhost :: HostName -> IO a
 unknownhost h = errorMessage $ unlines
-	[ "Unknown host: " ++ h
+	[ "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)"
 	]
@@ -163,15 +167,16 @@ getCurrentGitSha1 :: String -> IO String
 getCurrentGitSha1 branchref = readProcess "git" ["show-ref", "--hash", branchref]
 
 spin :: HostName -> IO ()
-spin host = do
+spin hn = do
 	url <- getUrl
 	void $ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
 	void $ boolSystem "git" [Param "push"]
-	go url =<< gpgDecrypt (privDataFile host)
+	cacheparams <- toCommand <$> sshCachingParams hn
+	go cacheparams url =<< gpgDecrypt (privDataFile hn)
   where
-	go url privdata = withBothHandles createProcessSuccess (proc "ssh" [user, bootstrapcmd]) $ \(toh, fromh) -> do
+	go cacheparams url privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do
 		let finish = do
-			senddata toh (privDataFile host) privDataMarker privdata
+			senddata toh (privDataFile hn) privDataMarker privdata
 			hClose toh
 			
 			-- Display remaining output.
@@ -184,21 +189,21 @@ spin host = do
 			NeedGitClone -> do
 				hClose toh
 				hClose fromh
-				sendGitClone host url
-				go url privdata
+				sendGitClone hn url
+				go cacheparams url privdata
 	
-	user = "root@"++host
+	user = "root@"++hn
 
 	bootstrapcmd = shellWrap $ intercalate " ; "
 		[ "if [ ! -d " ++ localdir ++ " ]"
 		, "then " ++ intercalate " && "
-			[ "apt-get -y install git"
+			[ "apt-get --no-install-recommends --no-upgrade -y install git make"
 			, "echo " ++ toMarked statusMarker (show NeedGitClone)
 			]
 		, "else " ++ intercalate " && "
 			[ "cd " ++ localdir
-			, "if ! test -x ./propellor; then make build; fi"
-			, "./propellor --boot " ++ host
+			, "if ! test -x ./propellor; then make deps build; fi"
+			, "./propellor --boot " ++ hn
 			]
 		, "fi"
 		]
@@ -214,19 +219,18 @@ spin host = do
 	
 	showremote s = putStrLn s
 	senddata toh f marker s = void $
-		actionMessage ("Sending " ++ f ++ " (" ++ show (length s) ++ " bytes) to " ++ host) $ do
+		actionMessage ("Sending " ++ f ++ " (" ++ show (length s) ++ " bytes) to " ++ hn) $ do
 			sendMarked toh marker s
 			return True
 
 sendGitClone :: HostName -> String -> IO ()
-sendGitClone host url = void $ actionMessage ("Pushing git repository to " ++ host) $ do
+sendGitClone hn url = void $ actionMessage ("Pushing git repository to " ++ hn) $ do
 	branch <- getCurrentBranch
+	cacheparams <- sshCachingParams hn
 	withTmpFile "propellor.git" $ \tmp _ -> allM id
-		-- TODO: ssh connection caching, or better push method
-		-- with less connections.
 		[ boolSystem "git" [Param "bundle", Param "create", File tmp, Param "HEAD"]
-		, boolSystem "scp" [File tmp, Param ("root@"++host++":"++remotebundle)]
-		, boolSystem "ssh" [Param ("root@"++host), Param $ unpackcmd branch]
+		, boolSystem "scp" $ cacheparams ++ [File tmp, Param ("root@"++hn++":"++remotebundle)]
+		, boolSystem "ssh" $ cacheparams ++ [Param ("root@"++hn), Param $ unpackcmd branch]
 		]
   where
 	remotebundle = "/usr/local/propellor.git"
@@ -274,15 +278,15 @@ fromMarked marker s
 	len = length marker
 	matches = filter (marker `isPrefixOf`) $ lines s
 
-boot :: [Property] -> IO ()
-boot ps = do
+boot :: Attr -> [Property] -> IO ()
+boot attr ps = do
 	sendMarked stdout statusMarker $ show Ready
 	reply <- hGetContentsStrict stdin
 
 	makePrivDataDir
 	maybe noop (writeFileProtected privDataLocal) $
 		fromMarked privDataMarker reply
-	ensureProperties ps
+	mainProperties attr ps
 
 addKey :: String -> IO ()
 addKey keyid = exitBool =<< allM id [ gpg, gitadd, gitcommit ]
@@ -341,3 +345,15 @@ checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG"
 			updateGlobalLogger rootLoggerName $ 
 				setLevel DEBUG .  setHandlers [f]
 	go _ = noop
+
+-- Parameters can be passed to both ssh and scp.
+sshCachingParams :: HostName -> IO [CommandParam]
+sshCachingParams hn = do
+	home <- myHomeDir
+	let cachedir = home </> ".ssh" </> "propellor"
+	createDirectoryIfMissing False cachedir
+	let socketfile = cachedir </> hn ++ ".sock"
+	return
+		[ Param "-o", Param ("ControlPath=" ++ socketfile)
+		, Params "-o ControlMaster=auto -o ControlPersist=yes"
+		]
diff --git a/Propellor/Engine.hs b/Propellor/Engine.hs
index 1ae224ca..81d979ac 100644
--- a/Propellor/Engine.hs
+++ b/Propellor/Engine.hs
@@ -1,30 +1,37 @@
+{-# LANGUAGE PackageImports #-}
+
 module Propellor.Engine where
 
 import System.Exit
 import System.IO
 import Data.Monoid
 import System.Console.ANSI
+import "mtl" Control.Monad.Reader
 
 import Propellor.Types
 import Propellor.Message
-import Utility.Exception
+import Propellor.Exception
 
-ensureProperty :: Property -> IO Result
-ensureProperty = catchDefaultIO FailedChange . propertySatisfy
+runPropellor :: Attr -> Propellor a -> IO a
+runPropellor attr a = runReaderT (runWithAttr a) attr
 
-ensureProperties :: [Property] -> IO ()
-ensureProperties ps = do
-	r <- ensureProperties' [Property "overall" $ ensureProperties' ps]
+mainProperties :: Attr -> [Property] -> IO ()
+mainProperties attr ps = do
+	r <- runPropellor attr $
+		ensureProperties [Property "overall" $ ensureProperties ps]
 	setTitle "propellor: done"
 	hFlush stdout
 	case r of
 		FailedChange -> exitWith (ExitFailure 1)
 		_ -> exitWith ExitSuccess
 
-ensureProperties' :: [Property] -> IO Result
-ensureProperties' ps = ensure ps NoChange
+ensureProperties :: [Property] -> Propellor Result
+ensureProperties ps = ensure ps NoChange
   where
 	ensure [] rs = return rs
 	ensure (l:ls) rs = do
 		r <- actionMessage (propertyDesc l) (ensureProperty l)
 		ensure ls (r <> rs)
+
+ensureProperty :: Property -> Propellor Result
+ensureProperty = catchPropellor . propertySatisfy
diff --git a/Propellor/Exception.hs b/Propellor/Exception.hs
new file mode 100644
index 00000000..bd9212a8
--- /dev/null
+++ b/Propellor/Exception.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE PackageImports #-}
+
+module Propellor.Exception where
+
+import qualified "MonadCatchIO-transformers" Control.Monad.CatchIO as M
+import Control.Exception
+import Control.Applicative
+
+import Propellor.Types
+
+-- | Catches IO exceptions and returns FailedChange.
+catchPropellor :: Propellor Result -> Propellor Result
+catchPropellor a = either (\_ -> FailedChange) id <$> tryPropellor a
+
+tryPropellor :: Propellor a -> Propellor (Either IOException a)
+tryPropellor = M.try
diff --git a/Propellor/Message.hs b/Propellor/Message.hs
index 5a7d8c4b..2e63061e 100644
--- a/Propellor/Message.hs
+++ b/Propellor/Message.hs
@@ -1,30 +1,35 @@
+{-# LANGUAGE PackageImports #-}
+
 module Propellor.Message where
 
 import System.Console.ANSI
 import System.IO
 import System.Log.Logger
+import "mtl" Control.Monad.Reader
 
 import Propellor.Types
 
 -- | Shows a message while performing an action, with a colored status
 -- display.
-actionMessage :: ActionResult r => Desc -> IO r -> IO r
+actionMessage :: (MonadIO m, ActionResult r) => Desc -> m r -> m r
 actionMessage desc a = do
-	setTitle $ "propellor: " ++ desc
-	hFlush stdout
+	liftIO $ do
+		setTitle $ "propellor: " ++ desc
+		hFlush stdout
 
 	r <- a
 
-	setTitle "propellor: running"
-	let (msg, intensity, color) = getActionResult r
-	putStr $ desc ++ " ... "
-	colorLine intensity color msg
-	hFlush stdout
+	liftIO $ do
+		setTitle "propellor: running"
+		let (msg, intensity, color) = getActionResult r
+		putStr $ desc ++ " ... "
+		colorLine intensity color msg
+		hFlush stdout
 
 	return r
 
-warningMessage :: String -> IO ()
-warningMessage s = colorLine Vivid Red $ "** warning: " ++ s
+warningMessage :: MonadIO m => String -> m ()
+warningMessage s = liftIO $ colorLine Vivid Red $ "** warning: " ++ s
 
 colorLine :: ColorIntensity -> Color -> String -> IO ()
 colorLine intensity color msg = do
diff --git a/Propellor/PrivData.hs b/Propellor/PrivData.hs
index e768ae9e..5adc9e94 100644
--- a/Propellor/PrivData.hs
+++ b/Propellor/PrivData.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PackageImports #-}
+
 module Propellor.PrivData where
 
 import qualified Data.Map as M
@@ -7,8 +9,10 @@ import System.IO
 import System.Directory
 import Data.Maybe
 import Control.Monad
+import "mtl" Control.Monad.Reader
 
 import Propellor.Types
+import Propellor.Attr
 import Propellor.Message
 import Utility.Monad
 import Utility.PartialPrelude
@@ -18,12 +22,15 @@ import Utility.Tmp
 import Utility.SafeCommand
 import Utility.Misc
 
-withPrivData :: PrivDataField -> (String -> IO Result) -> IO Result
-withPrivData field a = maybe missing a =<< getPrivData field
+withPrivData :: PrivDataField -> (String -> Propellor Result) -> Propellor Result
+withPrivData field a = maybe missing a =<< liftIO (getPrivData field)
   where
 	missing = do
-		warningMessage $ "Missing privdata " ++ show field
-		return FailedChange
+		host <- getHostName
+		liftIO $ do
+			warningMessage $ "Missing privdata " ++ show field
+			putStrLn $ "Fix this by running: propellor --set "++host++" '" ++ show field ++ "'"
+			return FailedChange
 
 getPrivData :: PrivDataField -> IO (Maybe String)
 getPrivData field = do
diff --git a/Propellor/Property.hs b/Propellor/Property.hs
index e7ec704d..3a3c1cb1 100644
--- a/Propellor/Property.hs
+++ b/Propellor/Property.hs
@@ -1,17 +1,22 @@
+{-# LANGUAGE PackageImports #-}
+
 module Propellor.Property where
 
 import System.Directory
 import Control.Monad
 import Data.Monoid
+import Control.Monad.IfElse
+import "mtl" Control.Monad.Reader
 
 import Propellor.Types
+import Propellor.Types.Attr
 import Propellor.Engine
 import Utility.Monad
 
-makeChange :: IO () -> IO Result
-makeChange a = a >> return MadeChange
+makeChange :: IO () -> Propellor Result
+makeChange a = liftIO a >> return MadeChange
 
-noChange :: IO Result
+noChange :: Propellor Result
 noChange = return NoChange
 
 -- | Combines a list of properties, resulting in a single property
@@ -19,7 +24,7 @@ noChange = return NoChange
 -- and print out the description of each as it's run. Does not stop
 -- on failure; does propigate overall success/failure.
 propertyList :: Desc -> [Property] -> Property
-propertyList desc ps = Property desc $ ensureProperties' ps
+propertyList desc ps = Property desc $ ensureProperties ps
 
 -- | Combines a list of properties, resulting in one property that
 -- ensures each in turn, stopping on failure.
@@ -33,18 +38,29 @@ combineProperties desc ps = Property desc $ go ps NoChange
 			FailedChange -> return FailedChange
 			_ -> go ls (r <> rs)
 
+-- | Combines together two properties, resulting in one property
+-- that ensures the first, and if the first succeeds, ensures the second.
+-- The property uses the description of the first property.
+before :: Property -> Property -> Property
+p1 `before` p2 = Property (propertyDesc p1) $ do
+	r <- ensureProperty p1
+	case r of
+		FailedChange -> return FailedChange
+		_ -> ensureProperty p2
+
 -- | Makes a perhaps non-idempotent Property be idempotent by using a flag
 -- file to indicate whether it has run before.
 -- Use with caution.
 flagFile :: Property -> FilePath -> Property
 flagFile property flagfile = Property (propertyDesc property) $
-	go =<< doesFileExist flagfile
+	go =<< liftIO (doesFileExist flagfile)
   where
 	go True = return NoChange
 	go False = do
 		r <- ensureProperty property
-		when (r == MadeChange) $
-			writeFile flagfile ""
+		when (r == MadeChange) $ liftIO $ 
+			unlessM (doesFileExist flagfile) $
+				writeFile flagfile ""
 		return r
 
 --- | Whenever a change has to be made for a Property, causes a hook
@@ -64,13 +80,13 @@ infixl 1 ==>
 
 -- | Makes a Property only be performed when a test succeeds.
 check :: IO Bool -> Property -> Property
-check c property = Property (propertyDesc property) $ ifM c
+check c property = Property (propertyDesc property) $ ifM (liftIO c)
 	( ensureProperty property
 	, return NoChange
 	)
 
 boolProperty :: Desc -> IO Bool -> Property
-boolProperty desc a = Property desc $ ifM a
+boolProperty desc a = Property desc $ ifM (liftIO a)
 	( return MadeChange
 	, return FailedChange
 	)
@@ -79,17 +95,26 @@ boolProperty desc a = Property desc $ ifM a
 revert :: RevertableProperty -> RevertableProperty
 revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
 
--- | Starts a list of Properties
-props :: [Property]
-props = []
+-- | Starts accumulating the properties of a Host.
+--
+-- > host "example.com"
+-- > 	& someproperty
+-- > 	! oldproperty
+-- > 	& otherproperty
+host :: HostName -> Host
+host hn = Host [] (\_ -> newAttr hn)
+
+-- | Adds a property to a Host
+-- Can add Properties, RevertableProperties, and AttrProperties
+(&) :: IsProp p => Host -> p -> Host
+(Host ps as) & p = Host (ps ++ [toProp p]) (getAttr p . as)
 
--- | Adds a property to the list.
--- Can add both Properties and RevertableProperties.
-(&) :: IsProp p => [Property] -> p -> [Property]
-ps & p = ps ++ [toProp p]
 infixl 1 &
 
--- | Adds a property to the list in reverted form.
-(!) :: [Property] -> RevertableProperty -> [Property]
-ps ! p = ps ++ [toProp $ revert p]
+-- | Adds a property to the Host in reverted form.
+(!) :: Host -> RevertableProperty -> Host
+(Host ps as) ! p = Host (ps ++ [toProp q]) (getAttr q . as)
+  where
+	q = revert p
+
 infixl 1 !
diff --git a/Propellor/Property/Apt.hs b/Propellor/Property/Apt.hs
index 8bbb1b19..4da13a2f 100644
--- a/Propellor/Property/Apt.hs
+++ b/Propellor/Property/Apt.hs
@@ -8,6 +8,7 @@ import Control.Monad
 
 import Propellor
 import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Service as Service
 import Propellor.Property.File (Line)
 
 sourcesList :: FilePath
@@ -46,13 +47,22 @@ debCdn = binandsrc "http://cdn.debian.net/debian"
 kernelOrg :: DebianSuite -> [Line]
 kernelOrg = binandsrc "http://mirrors.kernel.org/debian"
 
+-- | Only available for Stable and Testing
+securityUpdates :: DebianSuite -> [Line]
+securityUpdates suite
+	| suite == Stable || suite == Testing =
+		let l = "deb http://security.debian.org/ " ++ showSuite suite ++ "/updates " ++ unwords stdSections
+		in [l, srcLine l]
+	| otherwise = []
+
 -- | Makes sources.list have a standard content using the mirror CDN,
 -- with a particular DebianSuite.
 --
 -- Since the CDN is sometimes unreliable, also adds backup lines using
 -- kernel.org.
 stdSourcesList :: DebianSuite -> Property
-stdSourcesList suite = setSourcesList (debCdn suite ++ kernelOrg suite)
+stdSourcesList suite = setSourcesList
+	(debCdn suite ++ kernelOrg suite ++ securityUpdates suite)
 	`describe` ("standard sources.list for " ++ show suite)
 
 setSourcesList :: [Line] -> Property
@@ -147,9 +157,12 @@ autoRemove = runApt ["-y", "autoremove"]
 
 -- | Enables unattended upgrades. Revert to disable.
 unattendedUpgrades :: RevertableProperty
-unattendedUpgrades = RevertableProperty (go True) (go False)
+unattendedUpgrades = RevertableProperty enable disable
   where
-	go enabled = (if enabled then installed else removed) ["unattended-upgrades"]
+	enable = setup True `before` Service.running "cron"
+	disable = setup False
+
+	setup enabled = (if enabled then installed else removed) ["unattended-upgrades"]
 		`onChange` reConfigure "unattended-upgrades"
 			[("unattended-upgrades/enable_auto_updates" , "boolean", v)]
 		`describe` ("unattended upgrades " ++ v)
@@ -167,7 +180,14 @@ reConfigure package vals = reconfigure `requires` setselections
 	setselections = Property "preseed" $ makeChange $
 		withHandle StdinHandle createProcessSuccess
 			(proc "debconf-set-selections" []) $ \h -> do
-				forM_ vals $ \(template, tmpltype, value) ->
-					hPutStrLn h $ unwords [package, template, tmpltype, value]
+				forM_ vals $ \(tmpl, tmpltype, value) ->
+					hPutStrLn h $ unwords [package, tmpl, tmpltype, value]
 				hClose h
 	reconfigure = cmdProperty "dpkg-reconfigure" ["-fnone", package]
+
+-- | Ensures that a service is installed and running.
+--
+-- Assumes that there is a 1:1 mapping between service names and apt
+-- package names.
+serviceInstalledRunning :: Package -> Property
+serviceInstalledRunning svc = Service.running svc `requires` installed [svc]
diff --git a/Propellor/Property/Cmd.hs b/Propellor/Property/Cmd.hs
index dc5073d3..875c1f9a 100644
--- a/Propellor/Property/Cmd.hs
+++ b/Propellor/Property/Cmd.hs
@@ -1,17 +1,17 @@
+{-# LANGUAGE PackageImports #-}
+
 module Propellor.Property.Cmd (
 	cmdProperty,
 	cmdProperty',
 	scriptProperty,
 	userScriptProperty,
-	serviceRunning,
 ) where
 
-import Control.Monad
 import Control.Applicative
 import Data.List
+import "mtl" Control.Monad.Reader
 
 import Propellor.Types
-import Propellor.Engine
 import Utility.Monad
 import Utility.SafeCommand
 import Utility.Env
@@ -25,7 +25,7 @@ cmdProperty cmd params = cmdProperty' cmd params []
 -- | A property that can be satisfied by running a command,
 -- with added environment.
 cmdProperty' :: String -> [String] -> [(String, String)] -> Property
-cmdProperty' cmd params env = Property desc $ do
+cmdProperty' cmd params env = Property desc $ liftIO $ do
 	env' <- addEntries env <$> getEnvironment
 	ifM (boolSystemEnv cmd (map Param params) (Just env'))
 		( return MadeChange
@@ -46,14 +46,3 @@ userScriptProperty :: UserName -> [String] -> Property
 userScriptProperty user script = cmdProperty "su" ["-c", shellcmd, user]
   where
 	shellcmd = intercalate " ; " ("set -e" : "cd" : script)
-
--- | Ensures that a service is running.
---
--- Note that due to the general poor state of init scripts, the best
--- we can do is try to start the service, and if it fails, assume
--- this means it's already running.
-serviceRunning :: String -> Property
-serviceRunning svc = Property ("running " ++ svc) $ do
-	void $ ensureProperty $
-		scriptProperty ["service " ++ shellEscape svc ++ " start >/dev/null 2>&1 || true"]
-	return NoChange
diff --git a/Propellor/Property/Cron.hs b/Propellor/Property/Cron.hs
index 30bdb510..fa6019ea 100644
--- a/Propellor/Property/Cron.hs
+++ b/Propellor/Property/Cron.hs
@@ -18,8 +18,7 @@ job desc times user cddir command = ("/etc/cron.d/" ++ desc) `File.hasContent`
 	, ""
 	, times ++ "\t" ++ user ++ "\t" ++ "cd " ++ cddir ++ " && " ++ command
 	]
-	`requires` Apt.installed ["cron"]
-	`requires` serviceRunning "cron"
+	`requires` Apt.serviceInstalledRunning "cron"
 	`describe` ("cronned " ++ desc)
 
 -- | Installs a cron job, and runs it niced and ioniced.
diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
new file mode 100644
index 00000000..34e790d9
--- /dev/null
+++ b/Propellor/Property/Dns.hs
@@ -0,0 +1,63 @@
+module Propellor.Property.Dns where
+
+import Propellor
+import Propellor.Property.File
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Service as Service
+
+namedconf :: FilePath
+namedconf = "/etc/bind/named.conf.local"
+
+data Zone = Zone
+	{ zdomain :: Domain
+	, ztype :: Type
+	, zfile :: FilePath
+	, zmasters :: [IPAddr]
+	, zconfiglines :: [String]
+	}
+
+zoneDesc :: Zone -> String
+zoneDesc z = zdomain z ++ " (" ++ show (ztype z) ++ ")"
+
+type IPAddr = String
+
+type Domain = String
+
+data Type = Master | Secondary
+	deriving (Show, Eq)
+
+secondary :: Domain -> [IPAddr] -> Zone
+secondary domain masters = Zone
+	{ zdomain = domain
+	, ztype = Secondary
+	, zfile = "db." ++ domain
+	, zmasters = masters
+	, zconfiglines = ["allow-transfer { }"]
+	}
+
+zoneStanza :: Zone -> [Line]
+zoneStanza z =
+	[ "// automatically generated by propellor"
+	, "zone \"" ++ zdomain z ++ "\" {"
+	, cfgline "type" (if ztype z == Master then "master" else "slave")
+	, cfgline "file" ("\"" ++ zfile z ++ "\"")
+	] ++
+	(if null (zmasters z) then [] else mastersblock) ++
+	(map (\l -> "\t" ++ l ++ ";") (zconfiglines z)) ++
+	[ "};"
+	, ""
+	]
+  where
+	cfgline f v = "\t" ++ f ++ " " ++ v ++ ";"
+	mastersblock =
+		[ "\tmasters {" ] ++
+		(map (\ip -> "\t\t" ++ ip ++ ";") (zmasters z)) ++
+		[ "\t};" ]
+
+-- | Rewrites the whole named.conf.local file to serve the specificed
+-- zones.
+zones :: [Zone] -> Property
+zones zs = hasContent namedconf (concatMap zoneStanza zs)
+	`describe` ("dns server for zones: " ++ unwords (map zoneDesc zs))
+	`requires` Apt.serviceInstalledRunning "bind9"
+	`onChange` Service.reloaded "bind9"
diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index b573e641..d2555ea5 100644
--- a/Propellor/Property/Docker.hs
+++ b/Propellor/Property/Docker.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RankNTypes, BangPatterns #-}
+{-# LANGUAGE BangPatterns #-}
 
 -- | Docker support for propellor
 --
@@ -9,6 +9,7 @@ module Propellor.Property.Docker where
 
 import Propellor
 import Propellor.SimpleSh
+import Propellor.Types.Attr
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Docker.Shim as Shim
@@ -32,6 +33,25 @@ configured = Property "docker configured" go `requires` installed
 installed :: Property
 installed = Apt.installed ["docker.io"]
 
+-- | A short descriptive name for a container.
+-- Should not contain whitespace or other unusual characters,
+-- only [a-zA-Z0-9_-] are allowed
+type ContainerName = String
+
+-- | Starts accumulating the properties of a Docker container.
+--
+-- > container "web-server" "debian"
+-- >    & publish "80:80"
+-- >    & Apt.installed {"apache2"]
+-- >    & ...
+container :: ContainerName -> Image -> Host
+container cn image = Host [] (\_ -> attr)
+  where
+	attr = (newAttr (cn2hn cn)) { _dockerImage = Just image }
+
+cn2hn :: ContainerName -> HostName
+cn2hn cn = cn ++ ".docker"
+
 -- | Ensures that a docker container is set up and running. The container
 -- has its own Properties which are handled by running propellor
 -- inside the container.
@@ -39,44 +59,61 @@ installed = Apt.installed ["docker.io"]
 -- Reverting this property ensures that the container is stopped and
 -- removed.
 docked
-	:: (HostName -> ContainerName -> Maybe (Container))
-	-> HostName
+	:: [Host]
 	-> ContainerName
 	-> RevertableProperty
-docked findc hn cn = findContainer findc hn cn $
-	\(Container image containerprops) ->
-		let setup = provisionContainer cid
-				`requires`
-			runningContainer cid image containerprops
-				`requires`
-			installed
-		    teardown = combineProperties ("undocked " ++ fromContainerId cid)
-		    	[ stoppedContainer cid
+docked hosts cn = RevertableProperty (go "docked" setup) (go "undocked" teardown)
+  where
+	go desc a = Property (desc ++ " " ++ cn) $ do
+		hn <- getHostName
+  		let cid = ContainerId hn cn
+		ensureProperties [findContainer hosts cid cn $ a cid]
+
+	setup cid (Container image runparams) =
+		provisionContainer cid
+			`requires`
+		runningContainer cid image runparams
+			`requires`
+		installed
+
+	teardown cid (Container image _runparams) =
+		combineProperties ("undocked " ++ fromContainerId cid)
+			[ stoppedContainer cid
 			, Property ("cleaned up " ++ fromContainerId cid) $
-				report <$> mapM id
+				liftIO $ report <$> mapM id
 					[ removeContainer cid
 					, removeImage image
 					]
 			]
-		in RevertableProperty setup teardown
-  where
-  	cid = ContainerId hn cn
 
 findContainer
-	:: (HostName -> ContainerName -> Maybe (Container))
-	-> HostName
+	:: [Host]
+	-> ContainerId
 	-> ContainerName
-	-> (Container -> RevertableProperty)
-	-> RevertableProperty
-findContainer findc hn cn mk = case findc hn cn of
-	Nothing -> RevertableProperty cantfind cantfind
-	Just container -> mk container
+	-> (Container -> Property)
+	-> Property
+findContainer hosts cid cn mk = case findHost hosts (cn2hn cn) of
+	Nothing -> cantfind
+	Just h -> maybe cantfind mk (mkContainer cid h)
   where
-  	cid = ContainerId hn cn
-	cantfind = containerDesc (ContainerId hn cn) $ Property "" $ do
-		warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid
+	cantfind = containerDesc cid $ Property "" $ do
+		liftIO $ warningMessage $
+			"missing definition for docker container \"" ++ cn2hn cn
 		return FailedChange
 
+mkContainer :: ContainerId -> Host -> Maybe Container
+mkContainer cid@(ContainerId hn _cn) h = Container
+	<$> _dockerImage attr
+	<*> pure (map (\a -> a hn) (_dockerRunParams attr))
+  where
+	attr = hostAttr h'
+  	h' = h
+		-- expose propellor directory inside the container
+		& volume (localdir++":"++localdir)
+		-- name the container in a predictable way so we
+		-- and the user can easily find it later
+		& name (fromContainerId cid)
+
 -- | Causes *any* docker images that are not in use by running containers to
 -- be deleted. And deletes any containers that propellor has set up
 -- before that are not currently running. Does not delete any containers
@@ -90,34 +127,11 @@ garbageCollected = propertyList "docker garbage collected"
 	]
   where
 	gccontainers = Property "docker containers garbage collected" $
-		report <$> (mapM removeContainer =<< listContainers AllContainers)
+		liftIO $ report <$> (mapM removeContainer =<< listContainers AllContainers)
 	gcimages = Property "docker images garbage collected" $ do
-		report <$> (mapM removeImage =<< listImages)
-
--- | Pass to defaultMain to add docker containers.
--- You need to provide the function mapping from
--- HostName and ContainerName to the Container to use.
-containerProperties
-	:: (HostName -> ContainerName -> Maybe (Container))
-	-> (HostName -> Maybe [Property])
-containerProperties findcontainer = \h -> case toContainerId h of
-	Nothing -> Nothing
-	Just cid@(ContainerId hn cn) ->
-		case findcontainer hn cn of
-			Nothing -> Nothing
-			Just (Container _ cprops) -> 
-				Just $ map (containerDesc cid) $
-					fromContainerized cprops
+		liftIO $ report <$> (mapM removeImage =<< listImages)
 
--- | This type is used to configure a docker container.
--- It has an image, and a list of Properties, but these
--- properties are Containerized; they can specify
--- things about the container's configuration, in
--- addition to properties of the system inside the
--- container.
-data Container = Container Image [Containerized Property]
-
-data Containerized a = Containerized [HostName -> RunParam] a
+data Container = Container Image [RunParam]
 
 -- | Parameters to pass to `docker run` when creating a container.
 type RunParam = String
@@ -125,62 +139,50 @@ type RunParam = String
 -- | A docker image, that can be used to run a container.
 type Image = String
 
--- | A short descriptive name for a container.
--- Should not contain whitespace or other unusual characters,
--- only [a-zA-Z0-9_.-] are allowed
-type ContainerName = String
-
--- | Lift a Property to apply inside a container.
-inside1 :: Property -> Containerized Property
-inside1 = Containerized []
-
-inside :: [Property] -> Containerized Property
-inside = Containerized [] . combineProperties "provision"
-
 -- | Set custom dns server for container.
-dns :: String -> Containerized Property
+dns :: String -> AttrProperty
 dns = runProp "dns"
 
 -- | Set container host name.
-hostname :: String -> Containerized Property
+hostname :: String -> AttrProperty
 hostname = runProp "hostname"
 
 -- | Set name for container. (Normally done automatically.)
-name :: String -> Containerized Property
+name :: String -> AttrProperty
 name = runProp "name"
 
 -- | Publish a container's port to the host
 -- (format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort)
-publish :: String -> Containerized Property
+publish :: String -> AttrProperty
 publish = runProp "publish"
 
 -- | Username or UID for container.
-user :: String -> Containerized Property
+user :: String -> AttrProperty
 user = runProp "user"
 
 -- | Mount a volume
 -- Create a bind mount with: [host-dir]:[container-dir]:[rw|ro]
 -- With just a directory, creates a volume in the container.
-volume :: String -> Containerized Property
+volume :: String -> AttrProperty
 volume = runProp "volume"
 
 -- | Mount a volume from the specified container into the current
 -- container.
-volumes_from :: ContainerName -> Containerized Property
+volumes_from :: ContainerName -> AttrProperty
 volumes_from cn = genProp "volumes-from" $ \hn ->
 	fromContainerId (ContainerId hn cn)
 
 -- | Work dir inside the container. 
-workdir :: String -> Containerized Property
+workdir :: String -> AttrProperty
 workdir = runProp "workdir"
 
 -- | Memory limit for container.
 --Format: <number><optional unit>, where unit = b, k, m or g
-memory :: String -> Containerized Property
+memory :: String -> AttrProperty
 memory = runProp "memory"
 
 -- | Link with another container on the same host.
-link :: ContainerName -> ContainerAlias -> Containerized Property
+link :: ContainerName -> ContainerAlias -> AttrProperty
 link linkwith alias = genProp "link" $ \hn ->
 	fromContainerId (ContainerId hn linkwith) ++ ":" ++ alias
 
@@ -199,16 +201,6 @@ data ContainerId = ContainerId HostName ContainerName
 data ContainerIdent = ContainerIdent Image HostName ContainerName [RunParam]
 	deriving (Read, Show, Eq)
 
-getRunParams :: HostName -> [Containerized a] -> [RunParam]
-getRunParams hn l = concatMap get l
-  where
-	get (Containerized ps _) = map (\a -> a hn ) ps
-
-fromContainerized :: forall a. [Containerized a] -> [a]
-fromContainerized l = map get l
-  where
-	get (Containerized _ a) = a
-
 ident2id :: ContainerIdent -> ContainerId
 ident2id (ContainerIdent _ hn cn _) = ContainerId hn cn
 
@@ -226,32 +218,32 @@ toContainerId s
 fromContainerId :: ContainerId -> String
 fromContainerId (ContainerId hn cn) = cn++"."++hn++myContainerSuffix
 
+containerHostName :: ContainerId -> HostName
+containerHostName (ContainerId _ cn) = cn2hn cn
+
 myContainerSuffix :: String
 myContainerSuffix = ".propellor"
 
-containerFrom :: Image -> [Containerized Property] -> Container
-containerFrom = Container
-
 containerDesc :: ContainerId -> Property -> Property
 containerDesc cid p = p `describe` desc
   where
 	desc = "[" ++ fromContainerId cid ++ "] " ++ propertyDesc p
 
-runningContainer :: ContainerId -> Image -> [Containerized Property] -> Property
-runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc cid $ Property "running" $ do
-	l <- listContainers RunningContainers
+runningContainer :: ContainerId -> Image -> [RunParam] -> Property
+runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ Property "running" $ do
+	l <- liftIO $ listContainers RunningContainers
 	if cid `elem` l
 		then do
 			-- Check if the ident has changed; if so the
 			-- parameters of the container differ and it must
 			-- be restarted.
-			runningident <- getrunningident
+			runningident <- liftIO $ getrunningident
 			if runningident == Just ident
-				then return NoChange
+				then noChange
 				else do
-					void $ stopContainer cid
+					void $ liftIO $ stopContainer cid
 					restartcontainer
-		else ifM (elem cid <$> listContainers AllContainers)
+		else ifM (liftIO $ elem cid <$> listContainers AllContainers)
 			( restartcontainer
 			, go image
 			)
@@ -259,8 +251,8 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci
 	ident = ContainerIdent image hn cn runps
 
 	restartcontainer = do
-		oldimage <- fromMaybe image <$> commitContainer cid
-		void $ removeContainer cid
+		oldimage <- liftIO $ fromMaybe image <$> commitContainer cid
+		void $ liftIO $ removeContainer cid
 		go oldimage
 
 	getrunningident :: IO (Maybe ContainerIdent)
@@ -271,19 +263,12 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci
 	extractident :: [Resp] -> Maybe ContainerIdent
 	extractident = headMaybe . catMaybes . map readish . catMaybes . map getStdout
 
-	runps = getRunParams hn $ containerprops ++
-		-- expose propellor directory inside the container
-		[ volume (localdir++":"++localdir)
-		-- name the container in a predictable way so we
-		-- and the user can easily find it later
-		, name (fromContainerId cid)
-		]
-	
 	go img = do
-		clearProvisionedFlag cid
-		createDirectoryIfMissing True (takeDirectory $ identFile cid)
-		shim <- Shim.setup (localdir </> "propellor") (localdir </> shimdir cid)
-		writeFile (identFile cid) (show ident)
+		liftIO $ do
+			clearProvisionedFlag cid
+			createDirectoryIfMissing True (takeDirectory $ identFile cid)
+		shim <- liftIO $ Shim.setup (localdir </> "propellor") (localdir </> shimdir cid)
+		liftIO $ writeFile (identFile cid) (show ident)
 		ensureProperty $ boolProperty "run" $ runContainer img
 			(runps ++ ["-i", "-d", "-t"])
 			[shim, "--docker", fromContainerId cid]
@@ -317,7 +302,7 @@ chain s = case toContainerId s of
 		-- to avoid ever provisioning twice at the same time.
 		whenM (checkProvisionedFlag cid) $ do
 			let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
-			unlessM (boolSystem shim [Param "--continue", Param $ show $ Chain $ fromContainerId cid]) $
+			unlessM (boolSystem shim [Param "--continue", Param $ show $ Chain $ containerHostName cid]) $
 				warningMessage "Boot provision failed!"
 		void $ async $ job reapzombies
 		void $ async $ job $ simpleSh $ namedPipe cid
@@ -339,14 +324,14 @@ chain s = case toContainerId s of
 -- being run. So, retry connections to the client for up to
 -- 1 minute.
 provisionContainer :: ContainerId -> Property
-provisionContainer cid = containerDesc cid $ Property "provision" $ do
+provisionContainer cid = containerDesc cid $ Property "provision" $ liftIO $ do
 	let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
 	r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing)
 	when (r /= FailedChange) $
 		setProvisionedFlag cid 
 	return r
   where
-	params = ["--continue", show $ Chain $ fromContainerId cid]
+	params = ["--continue", show $ Chain $ containerHostName cid]
 
 	go lastline (v:rest) = case v of
 		StdoutLine s -> do
@@ -372,8 +357,8 @@ stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId
 
 stoppedContainer :: ContainerId -> Property
 stoppedContainer cid = containerDesc cid $ Property desc $ 
-	ifM (elem cid <$> listContainers RunningContainers)
-		( cleanup `after` ensureProperty 
+	ifM (liftIO $ elem cid <$> listContainers RunningContainers)
+		( liftIO cleanup `after` ensureProperty 
 			(boolProperty desc $ stopContainer cid)
 		, return NoChange
 		)
@@ -420,17 +405,18 @@ listContainers status =
 listImages :: IO [Image]
 listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
 
-runProp :: String -> RunParam -> Containerized Property
-runProp field val = Containerized
-	[\_ -> "--" ++ param]
-	(Property (param) (return NoChange))
+runProp :: String -> RunParam -> AttrProperty
+runProp field val = AttrProperty prop $ \attr ->
+	attr { _dockerRunParams = _dockerRunParams attr ++ [\_ -> "--"++param] }
   where
 	param = field++"="++val
+	prop = Property (param) (return NoChange)
 
-genProp :: String -> (HostName -> RunParam) -> Containerized Property
-genProp field mkval = Containerized
-	[\h -> "--" ++ field ++ "=" ++ mkval h]
-	(Property field (return NoChange))
+genProp :: String -> (HostName -> RunParam) -> AttrProperty
+genProp field mkval = AttrProperty prop $ \attr ->
+	attr { _dockerRunParams = _dockerRunParams attr ++ [\hn -> "--"++field++"=" ++ mkval hn] }
+  where
+	prop = Property field (return NoChange)
 
 -- | The ContainerIdent of a container is written to
 -- /.propellor-ident inside it. This can be checked to see if
diff --git a/Propellor/Property/File.hs b/Propellor/Property/File.hs
index 80c69d9b..10dee75e 100644
--- a/Propellor/Property/File.hs
+++ b/Propellor/Property/File.hs
@@ -11,6 +11,13 @@ hasContent :: FilePath -> [Line] -> Property
 f `hasContent` newcontent = fileProperty ("replace " ++ f)
 	(\_oldcontent -> newcontent) f
 
+-- | Ensures a file has contents that comes from PrivData.
+-- Note: Does not do anything with the permissions of the file to prevent
+-- it from being seen.
+hasPrivContent :: FilePath -> Property
+hasPrivContent f = Property ("privcontent " ++ f) $
+	withPrivData (PrivFile f) (\v -> ensureProperty $ f `hasContent` lines v)
+
 -- | Ensures that a line is present in a file, adding it to the end if not.
 containsLine :: FilePath -> Line -> Property
 f `containsLine` l = fileProperty (f ++ " contains:" ++ l) go f
@@ -31,10 +38,10 @@ notPresent f = check (doesFileExist f) $ Property (f ++ " not present") $
 	makeChange $ nukeFile f
 
 fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property
-fileProperty desc a f = Property desc $ go =<< doesFileExist f
+fileProperty desc a f = Property desc $ go =<< liftIO (doesFileExist f)
   where
 	go True = do
-		ls <- lines <$> readFile f
+		ls <- liftIO $ lines <$> readFile f
 		let ls' = a ls
 		if ls' == ls
 			then noChange
@@ -51,3 +58,13 @@ fileProperty desc a f = Property desc $ go =<< doesFileExist f
 dirExists :: FilePath -> Property
 dirExists d = check (not <$> doesDirectoryExist d) $ Property (d ++ " exists") $
 	makeChange $ createDirectoryIfMissing True d
+
+-- | Ensures that a file/dir has the specified owner and group.
+ownerGroup :: FilePath -> UserName -> GroupName -> Property
+ownerGroup f owner group = Property (f ++ " owner " ++ og) $ do
+	r <- ensureProperty $ cmdProperty "chown" [og, f]
+	if r == FailedChange
+		then return r
+		else noChange
+  where
+	og = owner ++ ":" ++ group
diff --git a/Propellor/Property/Git.hs b/Propellor/Property/Git.hs
new file mode 100644
index 00000000..c0494160
--- /dev/null
+++ b/Propellor/Property/Git.hs
@@ -0,0 +1,48 @@
+module Propellor.Property.Git where
+
+import Propellor
+import Propellor.Property.File
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Service as Service
+
+import Data.List
+
+-- | Exports all git repos in a directory (that user nobody can read)
+-- using git-daemon, run from inetd.
+--
+-- Note that reverting this property does not remove or stop inetd.
+daemonRunning :: FilePath -> RevertableProperty
+daemonRunning exportdir = RevertableProperty setup unsetup
+  where
+	setup = containsLine conf (mkl "tcp4")
+		`requires`
+		containsLine conf (mkl "tcp6")
+		`requires`
+		dirExists exportdir
+		`requires`
+		Apt.serviceInstalledRunning "openbsd-inetd"
+		`onChange`
+		Service.running "openbsd-inetd"
+		`describe` ("git-daemon exporting " ++ exportdir)
+	unsetup = lacksLine conf (mkl "tcp4")
+		`requires`
+		lacksLine conf (mkl "tcp6")
+		`onChange`
+		Service.reloaded "openbsd-inetd"
+
+	conf = "/etc/inetd.conf"
+
+	mkl tcpv = intercalate "\t"
+		[ "git"
+		, "stream"
+		, tcpv
+		, "nowait"
+		, "nobody"
+		, "/usr/bin/git"
+		, "git"
+		, "daemon"
+		, "--inetd"
+		, "--export-all"
+		, "--base-path=" ++ exportdir
+		, exportdir
+		]
diff --git a/Propellor/Property/Hostname.hs b/Propellor/Property/Hostname.hs
index 26635374..03613ac9 100644
--- a/Propellor/Property/Hostname.hs
+++ b/Propellor/Property/Hostname.hs
@@ -3,21 +3,24 @@ module Propellor.Property.Hostname where
 import Propellor
 import qualified Propellor.Property.File as File
 
--- | Sets the hostname. Configures both /etc/hostname and the current
--- hostname.
+-- | Ensures that the hostname is set to the HostAttr value.
+-- Configures both /etc/hostname and the current hostname.
 --
--- When provided with a FQDN, also configures /etc/hosts,
+-- When the hostname is a FQDN, also configures /etc/hosts,
 -- with an entry for 127.0.1.1, which is standard at least on Debian
 -- to set the FDQN (127.0.0.1 is localhost).
-set :: HostName -> Property
-set hostname = combineProperties desc go
-	`onChange` cmdProperty "hostname" [host]
+sane :: Property
+sane = Property ("sane hostname") (ensureProperty . setTo =<< getHostName)
+
+setTo :: HostName -> Property
+setTo hn = combineProperties desc go
+	`onChange` cmdProperty "hostname" [basehost]
   where
-	desc = "hostname " ++ hostname
-	(host, domain) = separate (== '.') hostname
+	desc = "hostname " ++ hn
+	(basehost, domain) = separate (== '.') hn
 
 	go = catMaybes
-		[ Just $ "/etc/hostname" `File.hasContent` [host]
+		[ Just $ "/etc/hostname" `File.hasContent` [basehost]
 		, if null domain
 			then Nothing 
 			else Just $ File.fileProperty desc
@@ -25,7 +28,7 @@ set hostname = combineProperties desc go
 		]
 	
 	hostip = "127.0.1.1"
-	hostline = hostip ++ "\t" ++ hostname ++ " " ++ host
+	hostline = hostip ++ "\t" ++ hn ++ " " ++ basehost
 
 	addhostline ls = hostline : filter (not . hashostip) ls
 	hashostip l = headMaybe (words l) == Just hostip
diff --git a/Propellor/Property/Network.hs b/Propellor/Property/Network.hs
index eae5828f..6009778a 100644
--- a/Propellor/Property/Network.hs
+++ b/Propellor/Property/Network.hs
@@ -20,6 +20,7 @@ ipv6to4 = fileProperty "ipv6to4" go interfaces
 		, "\taddress 2002:5044:5531::1"
 		, "\tnetmask 64"
 		, "\tgateway ::192.88.99.1"
+		, "auto sit0"
 		, "# End automatically added by propeller"
 		]
 
diff --git a/Propellor/Property/OpenId.hs b/Propellor/Property/OpenId.hs
new file mode 100644
index 00000000..c397bdb8
--- /dev/null
+++ b/Propellor/Property/OpenId.hs
@@ -0,0 +1,26 @@
+module Propellor.Property.OpenId where
+
+import Propellor
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Service as Service
+
+import Data.List
+
+providerFor :: [UserName] -> String -> Property
+providerFor users baseurl = propertyList desc $
+	[ Apt.serviceInstalledRunning "apache2"
+	, Apt.installed ["simpleid"]
+		`onChange` Service.restarted "apache2"
+	, File.fileProperty desc
+		(map setbaseurl) "/etc/simpleid/config.inc"
+	] ++ map identfile users
+  where
+	identfile u = File.hasPrivContent $ concat
+		[ "/var/lib/simpleid/identities/", u, ".identity" ]
+	url = "http://"++baseurl++"/simpleid"
+	desc = "openid provider " ++ url
+	setbaseurl l
+		| "SIMPLEID_BASE_URL" `isInfixOf` l = 
+			"define('SIMPLEID_BASE_URL', '"++url++"');"
+		| otherwise = l
diff --git a/Propellor/Property/Scheduled.hs b/Propellor/Property/Scheduled.hs
new file mode 100644
index 00000000..8341765e
--- /dev/null
+++ b/Propellor/Property/Scheduled.hs
@@ -0,0 +1,67 @@
+module Propellor.Property.Scheduled
+	( period
+	, periodParse
+	, Recurrance(..)
+	, WeekDay
+	, MonthDay
+	, YearDay
+	) where
+
+import Propellor
+import Utility.Scheduled
+
+import Data.Time.Clock
+import Data.Time.LocalTime
+import qualified Data.Map as M
+
+-- | Makes a Property only be checked every so often.
+--
+-- This uses the description of the Property to keep track of when it was
+-- last run.
+period :: Property -> Recurrance -> Property
+period prop recurrance = Property desc $ do
+	lasttime <- liftIO $ getLastChecked (propertyDesc prop)
+	nexttime <- liftIO $ fmap startTime <$> nextTime schedule lasttime
+	t <- liftIO localNow
+	if Just t >= nexttime
+		then do
+			r <- ensureProperty prop
+			liftIO $ setLastChecked t (propertyDesc prop)
+			return r
+		else noChange
+  where
+	schedule = Schedule recurrance AnyTime
+	desc = propertyDesc prop ++ " (period " ++ fromRecurrance recurrance ++ ")"
+
+-- | Like period, but parse a human-friendly string.
+periodParse :: Property -> String -> Property
+periodParse prop s = case toRecurrance s of
+	Just recurrance -> period prop recurrance
+	Nothing -> Property "periodParse" $ do
+		liftIO $ warningMessage $ "failed periodParse: " ++ s
+		noChange
+
+lastCheckedFile :: FilePath
+lastCheckedFile = localdir </> ".lastchecked"
+
+getLastChecked :: Desc -> IO (Maybe LocalTime)
+getLastChecked desc = M.lookup desc <$> readLastChecked
+
+localNow :: IO LocalTime
+localNow = do
+	now <- getCurrentTime
+	tz <- getTimeZone now
+	return $ utcToLocalTime tz now
+
+setLastChecked :: LocalTime -> Desc -> IO ()
+setLastChecked time desc = do
+	m <- readLastChecked
+	writeLastChecked (M.insert desc time m)
+
+readLastChecked :: IO (M.Map Desc LocalTime)
+readLastChecked = fromMaybe M.empty <$> catchDefaultIO Nothing go
+  where
+	go = readish <$> readFile lastCheckedFile
+
+writeLastChecked :: M.Map Desc LocalTime -> IO ()
+writeLastChecked = writeFile lastCheckedFile . show
diff --git a/Propellor/Property/Service.hs b/Propellor/Property/Service.hs
new file mode 100644
index 00000000..c6498e57
--- /dev/null
+++ b/Propellor/Property/Service.hs
@@ -0,0 +1,31 @@
+module Propellor.Property.Service where
+
+import Propellor
+import Utility.SafeCommand
+
+type ServiceName = String
+
+-- | Ensures that a service is running. Does not ensure that
+-- any package providing that service is installed. See
+-- Apt.serviceInstalledRunning
+--
+-- Note that due to the general poor state of init scripts, the best
+-- we can do is try to start the service, and if it fails, assume
+-- this means it's already running.
+running :: ServiceName -> Property
+running svc = Property ("running " ++ svc) $ do
+	void $ ensureProperty $
+		scriptProperty ["service " ++ shellEscape svc ++ " start >/dev/null 2>&1 || true"]
+	return NoChange
+
+restarted :: ServiceName -> Property
+restarted svc = Property ("restarted " ++ svc) $ do
+	void $ ensureProperty $
+		scriptProperty ["service " ++ shellEscape svc ++ " restart >/dev/null 2>&1 || true"]
+	return NoChange
+
+reloaded :: ServiceName -> Property
+reloaded svc = Property ("reloaded " ++ svc) $ do
+	void $ ensureProperty $
+		scriptProperty ["service " ++ shellEscape svc ++ " reload >/dev/null 2>&1 || true"]
+	return NoChange
diff --git a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index 149c8e6c..204a9ca7 100644
--- a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -24,7 +24,7 @@ builder arch crontimes rsyncupload = combineProperties "gitannexbuilder"
 	, Apt.buildDep ["git-annex"]
 	, Apt.installed ["git", "rsync", "moreutils", "ca-certificates",
 		"liblockfile-simple-perl", "cabal-install", "vim", "less"]
-	, serviceRunning "cron" `requires` Apt.installed ["cron"]
+	, Apt.serviceInstalledRunning "cron"
 	, User.accountFor builduser
 	, check (not <$> doesDirectoryExist gitbuilderdir) $ userScriptProperty builduser
 		[ "git clone git://git.kitenet.net/gitannexbuilder " ++ gitbuilderdir
@@ -44,12 +44,13 @@ builder arch crontimes rsyncupload = combineProperties "gitannexbuilder"
 		let f = homedir </> "rsyncpassword"
 		if rsyncupload 
 			then withPrivData (Password builduser) $ \p -> do
-				oldp <- catchDefaultIO "" $ readFileStrict f
+				oldp <- liftIO $ catchDefaultIO "" $
+					readFileStrict f
 				if p /= oldp
 					then makeChange $ writeFile f p
 					else noChange
 			else do
-				ifM (doesFileExist f)
+				ifM (liftIO $ doesFileExist f)
 					( noChange
 					, makeChange $ writeFile f "no password configured"
 					)
diff --git a/Propellor/Property/SiteSpecific/GitHome.hs b/Propellor/Property/SiteSpecific/GitHome.hs
index 38e0cb97..1ba56b94 100644
--- a/Propellor/Property/SiteSpecific/GitHome.hs
+++ b/Propellor/Property/SiteSpecific/GitHome.hs
@@ -8,8 +8,8 @@ import Utility.SafeCommand
 -- | Clones Joey Hess's git home directory, and runs its fixups script.
 installedFor :: UserName -> Property
 installedFor user = check (not <$> hasGitDir user) $ 
-	Property ("githome " ++ user) (go =<< homedir user)
-		`requires` Apt.installed ["git", "myrepos"]
+	Property ("githome " ++ user) (go =<< liftIO (homedir user))
+		`requires` Apt.installed ["git"]
   where
  	go Nothing = noChange
 	go (Just home) = do
@@ -20,7 +20,7 @@ installedFor user = check (not <$> hasGitDir user) $
 				moveout tmpdir home
 			, Property "rmdir" $ makeChange $ void $
 				catchMaybeIO $ removeDirectory tmpdir
-			, userScriptProperty user ["rm -rf .aptitude/ .bashrc .profile; mr checkout; bin/fixups"]
+			, userScriptProperty user ["rm -rf .aptitude/ .bashrc .profile; bin/mr checkout; bin/fixups"]
 			]
 	moveout tmpdir home = do
 		fs <- dirContents tmpdir
diff --git a/Propellor/Property/SiteSpecific/JoeySites.hs b/Propellor/Property/SiteSpecific/JoeySites.hs
index 029064dd..46373170 100644
--- a/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -6,8 +6,8 @@ module Propellor.Property.SiteSpecific.JoeySites where
 import Propellor
 import qualified Propellor.Property.Apt as Apt
 
-oldUseNetshellBox :: Property
-oldUseNetshellBox = check (not <$> Apt.isInstalled "oldusenet") $
+oldUseNetShellBox :: Property
+oldUseNetShellBox = check (not <$> Apt.isInstalled "oldusenet") $
 	propertyList ("olduse.net shellbox")
 		[ Apt.installed (words "build-essential devscripts debhelper git libncursesw5-dev libpcre3-dev pkg-config bison libicu-dev libidn11-dev libcanlock2-dev libuu-dev ghc libghc-strptime-dev libghc-hamlet-dev libghc-ifelse-dev libghc-hxt-dev libghc-utf8-string-dev libghc-missingh-dev libghc-sha-dev")
 			`describe` "olduse.net build deps"
diff --git a/Propellor/Property/Ssh.hs b/Propellor/Property/Ssh.hs
index 36766f56..59845f8f 100644
--- a/Propellor/Property/Ssh.hs
+++ b/Propellor/Property/Ssh.hs
@@ -53,7 +53,7 @@ uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
 	`onChange` restartSshd
   where
 	prop = Property "ssh unique host keys" $ do
-		void $ boolSystem "sh"
+		void $ liftIO $ boolSystem "sh"
 			[ Param "-c"
 			, Param "rm -f /etc/ssh/ssh_host_*"
 			]
diff --git a/Propellor/Property/Sudo.hs b/Propellor/Property/Sudo.hs
index 68b8d056..66ceb580 100644
--- a/Propellor/Property/Sudo.hs
+++ b/Propellor/Property/Sudo.hs
@@ -13,7 +13,7 @@ enabledFor :: UserName -> Property
 enabledFor user = Property desc go `requires` Apt.installed ["sudo"]
   where
 	go = do
-		locked <- isLockedPassword user
+		locked <- liftIO $ isLockedPassword user
 		ensureProperty $
 			fileProperty desc
 				(modify locked . filter (wanted locked))
diff --git a/Propellor/SimpleSh.hs b/Propellor/SimpleSh.hs
index 99a6fc24..7e0f19ff 100644
--- a/Propellor/SimpleSh.hs
+++ b/Propellor/SimpleSh.hs
@@ -27,7 +27,7 @@ simpleSh namedpipe = do
 	createDirectoryIfMissing True dir
 	modifyFileMode dir (removeModes otherGroupModes)
 	s <- socket AF_UNIX Stream defaultProtocol
-	bind s (SockAddrUnix namedpipe)
+	bindSocket s (SockAddrUnix namedpipe)
 	listen s 2
 	forever $ do
 		(client, _addr) <- accept s
diff --git a/Propellor/Types.hs b/Propellor/Types.hs
index 52c0c999..e6e02126 100644
--- a/Propellor/Types.hs
+++ b/Propellor/Types.hs
@@ -1,19 +1,74 @@
-module Propellor.Types where
+{-# LANGUAGE PackageImports #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ExistentialQuantification #-}
+
+module Propellor.Types
+	( Host(..)
+	, Attr
+	, HostName
+	, UserName
+	, GroupName
+	, Propellor(..)
+	, Property(..)
+	, RevertableProperty(..)
+	, AttrProperty(..)
+	, IsProp
+	, describe
+	, toProp
+	, getAttr
+	, requires
+	, Desc
+	, Result(..)
+	, System(..)
+	, Distribution(..)
+	, DebianSuite(..)
+	, Release
+	, Architecture
+	, ActionResult(..)
+	, CmdLine(..)
+	, PrivDataField(..)
+	) where
 
 import Data.Monoid
+import Control.Applicative
 import System.Console.ANSI
+import "mtl" Control.Monad.Reader
+import "MonadCatchIO-transformers" Control.Monad.CatchIO
+
+import Propellor.Types.Attr
+
+data Host = Host [Property] (Attr -> Attr)
 
-type HostName = String
 type UserName = String
+type GroupName = String
+
+-- | Propellor's monad provides read-only access to attributes of the
+-- system.
+newtype Propellor p = Propellor { runWithAttr :: ReaderT Attr IO p }
+	deriving
+		( Monad
+		, Functor
+		, Applicative
+		, MonadReader Attr 
+		, MonadIO
+		, MonadCatchIO
+		)
 
+-- | The core data type of Propellor, this represents a property
+-- that the system should have, and an action to ensure it has the
+-- property.
 data Property = Property
 	{ propertyDesc :: Desc
 	-- | must be idempotent; may run repeatedly
-	, propertySatisfy :: IO Result
+	, propertySatisfy :: Propellor Result
 	}
 
+-- | A property that can be reverted.
 data RevertableProperty = RevertableProperty Property Property
 
+-- | A property that affects the Attr.
+data AttrProperty = forall p. IsProp p => AttrProperty p (Attr -> Attr)
+
 class IsProp p where
 	-- | Sets description.
 	describe :: p -> Desc -> p
@@ -21,6 +76,7 @@ class IsProp p where
 	-- | Indicates that the first property can only be satisfied
 	-- once the second one is.
 	requires :: p -> Property -> p
+	getAttr :: p -> (Attr -> Attr)
 
 instance IsProp Property where
 	describe p d = p { propertyDesc = d }
@@ -30,6 +86,7 @@ instance IsProp Property where
 		case r of
 			FailedChange -> return FailedChange
 			_ -> propertySatisfy x
+	getAttr _ = id
 
 instance IsProp RevertableProperty where
 	-- | Sets the description of both sides.
@@ -38,6 +95,13 @@ instance IsProp RevertableProperty where
 	toProp (RevertableProperty p1 _) = p1
 	(RevertableProperty p1 p2) `requires` y =
 		RevertableProperty (p1 `requires` y) p2
+	getAttr _ = id
+
+instance IsProp AttrProperty where
+	describe (AttrProperty p a) d = AttrProperty (describe p d) a
+	toProp (AttrProperty p _) = toProp p
+	(AttrProperty p a) `requires` y = AttrProperty (p `requires` y) a
+	getAttr (AttrProperty _ a) = a
 
 type Desc = String
 
@@ -63,7 +127,7 @@ data Distribution
 	deriving (Show)
 
 data DebianSuite = Experimental | Unstable | Testing | Stable | DebianRelease Release
-	deriving (Show)
+	deriving (Show, Eq)
 
 type Release = String
 
@@ -100,6 +164,7 @@ data PrivDataField
 	= DockerAuthentication
 	| SshPrivKey UserName
 	| Password UserName
+	| PrivFile FilePath
 	deriving (Read, Show, Ord, Eq)
 
 
diff --git a/Propellor/Types/Attr.hs b/Propellor/Types/Attr.hs
new file mode 100644
index 00000000..c253e32b
--- /dev/null
+++ b/Propellor/Types/Attr.hs
@@ -0,0 +1,36 @@
+module Propellor.Types.Attr where
+
+import qualified Data.Set as S
+
+-- | The attributes of a host. For example, its hostname.
+data Attr = Attr
+	{ _hostname :: HostName
+	, _cnames :: S.Set Domain
+
+	, _dockerImage :: Maybe String
+	, _dockerRunParams :: [HostName -> String]
+	}
+
+instance Eq Attr where
+	x == y = and
+		[ _hostname x == _hostname y
+		, _cnames x == _cnames y
+
+		, _dockerImage x == _dockerImage y
+		, let simpl v = map (\a -> a "") (_dockerRunParams v)
+		  in simpl x == simpl y
+		]
+
+instance Show Attr where
+	show a = unlines
+		[ "hostname " ++ _hostname a
+		, "cnames " ++ show (_cnames a)
+		, "docker image " ++ show (_dockerImage a)
+		, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))
+		]
+
+newAttr :: HostName -> Attr
+newAttr hn = Attr hn S.empty Nothing []
+
+type HostName = String
+type Domain = String