propellor (0.3.0) unstable; urgency=medium

  * ipv6to4: Ensure interface is brought up automatically on boot.
  * Enabling unattended upgrades now ensures that cron is installed and
    running to perform them.
  * Properties can be scheduled to only be checked after a given time period.
  * Fix bootstrapping of dependencies.
  * Fix compilation on Debian stable.
  * Include security updates in sources.list for stable and testing.
  * Use ssh connection caching, especially when bootstrapping.
  * Properties now run in a Propellor monad, which provides access to
    attributes of the host.

# imported from the archive

31 files changed, 2479 insertions, 0 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
new file mode 100644
index 00000000..5be91c4f
--- /dev/null
+++ b/Propellor/CmdLine.hs
@@ -0,0 +1,359 @@
+module Propellor.CmdLine where
+
+import System.Environment (getArgs)
+import Data.List
+import System.Exit
+import System.Log.Logger
+import System.Log.Formatter
+import System.Log.Handler (setFormatter, LogHandler)
+import System.Log.Handler.Simple
+import System.PosixCompat
+import Control.Exception (bracket)
+import System.Posix.IO
+
+import Propellor
+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
+	putStrLn $ unlines 
+		[ "Usage:"
+		, "  propellor"
+		, "  propellor hostname"
+		, "  propellor --spin hostname"
+		, "  propellor --set hostname field"
+		, "  propellor --add-key keyid"
+		]
+	exitFailure
+
+processCmdLine :: IO CmdLine
+processCmdLine = go =<< getArgs
+  where
+  	go ("--help":_) = usage
+  	go ("--spin":h:[]) = return $ Spin h
+  	go ("--boot":h:[]) = return $ Boot h
+	go ("--add-key":k:[]) = return $ AddKey k
+	go ("--set":h:f:[]) = case readish f of
+		Just pf -> return $ Set h pf
+		Nothing -> errorMessage $ "Unknown privdata field " ++ f
+	go ("--continue":s:[]) = case readish s of
+		Just cmdline -> return $ Continue cmdline
+		Nothing -> errorMessage "--continue serialization failure"
+  	go ("--chain":h:[]) = return $ Chain h
+	go ("--docker":h:[]) = return $ Docker h
+	go (h:[])
+		| "--" `isPrefixOf` h = usage
+		| otherwise = return $ Run h
+	go [] = do
+		s <- takeWhile (/= '\n') <$> readProcess "hostname" ["-f"]
+		if null s
+			then errorMessage "Cannot determine hostname! Pass it on the command line."
+			else return $ Run s
+	go _ = usage
+
+defaultMain :: [Host] -> IO ()
+defaultMain hostlist = do
+	DockerShim.cleanEnv
+	checkDebugMode
+	cmdline <- processCmdLine
+	debug ["command line: ", show cmdline]
+	go True cmdline
+  where
+	go _ (Continue cmdline) = go False cmdline
+	go _ (Set hn field) = setPrivData hn field
+	go _ (AddKey keyid) = addKey keyid
+	go _ (Chain hn) = withprops hn $ \attr ps -> do
+		r <- runPropellor attr $ ensureProperties ps
+		putStrLn $ "\n" ++ show r
+	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 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 hn) = onlyProcess $ withprops hn boot
+
+	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)
+  where
+	lock = do
+		l <- createFile lockfile stdFileMode
+		setLock l (WriteLock, AbsoluteSeek, 0, 0)
+			`catchIO` const alreadyrunning
+		return l
+	unlock = closeFd
+	alreadyrunning = error "Propellor is already running on this host!"
+	lockfile = localdir </> ".lock"
+
+unknownhost :: HostName -> IO a
+unknownhost h = 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)"
+	]
+
+buildFirst :: CmdLine -> IO () -> IO ()
+buildFirst cmdline next = do
+	oldtime <- getmtime
+	ifM (actionMessage "Propellor build" $ boolSystem "make" [Param "build"])
+		( do
+			newtime <- getmtime
+			if newtime == oldtime
+				then next
+				else void $ boolSystem "./propellor" [Param "--continue", Param (show cmdline)]
+		, errorMessage "Propellor build failed!" 
+		)
+  where
+	getmtime = catchMaybeIO $ getModificationTime "propellor"
+
+getCurrentBranch :: IO String
+getCurrentBranch = takeWhile (/= '\n') 
+	<$> readProcess "git" ["symbolic-ref", "--short", "HEAD"]
+
+updateFirst :: CmdLine -> IO () -> IO ()
+updateFirst cmdline next = do
+	branchref <- getCurrentBranch
+	let originbranch = "origin" </> branchref
+
+	void $ actionMessage "Git fetch" $ boolSystem "git" [Param "fetch"]
+	
+	whenM (doesFileExist keyring) $ do
+		{- To verify origin branch commit's signature, have to
+		 - convince gpg to use our keyring. While running git log.
+		 - Which has no way to pass options to gpg.
+		 - Argh! -}
+		let gpgconf = privDataDir </> "gpg.conf"
+		writeFile gpgconf $ unlines
+			[ " keyring " ++ keyring
+			, "no-auto-check-trustdb"
+			]
+		-- gpg is picky about perms
+		modifyFileMode privDataDir (removeModes otherGroupModes)
+		s <- readProcessEnv "git" ["log", "-n", "1", "--format=%G?", originbranch]
+			(Just [("GNUPGHOME", privDataDir)])
+		nukeFile $ privDataDir </> "trustdb.gpg"
+		nukeFile $ privDataDir </> "pubring.gpg"
+		nukeFile $ privDataDir </> "gpg.conf"
+		if s == "U\n" || s == "G\n"
+			then do
+				putStrLn $ "git branch " ++ originbranch ++ " gpg signature verified; merging"
+				hFlush stdout
+			else errorMessage $ "git branch " ++ originbranch ++ " is not signed with a trusted gpg key; refusing to deploy it!"
+	
+	oldsha <- getCurrentGitSha1 branchref
+	void $ boolSystem "git" [Param "merge", Param originbranch]
+	newsha <- getCurrentGitSha1 branchref
+
+	if oldsha == newsha
+		then next
+		else ifM (actionMessage "Propellor build" $ boolSystem "make" [Param "build"])
+			( void $ boolSystem "./propellor" [Param "--continue", Param (show cmdline)]
+			, errorMessage "Propellor build failed!" 
+			)
+
+getCurrentGitSha1 :: String -> IO String
+getCurrentGitSha1 branchref = readProcess "git" ["show-ref", "--hash", branchref]
+
+spin :: HostName -> IO ()
+spin hn = do
+	url <- getUrl
+	void $ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
+	void $ boolSystem "git" [Param "push"]
+	cacheparams <- toCommand <$> sshCachingParams hn
+	go cacheparams url =<< gpgDecrypt (privDataFile hn)
+  where
+	go cacheparams url privdata = withBothHandles createProcessSuccess (proc "ssh" $ cacheparams ++ [user, bootstrapcmd]) $ \(toh, fromh) -> do
+		let finish = do
+			senddata toh (privDataFile hn) privDataMarker privdata
+			hClose toh
+			
+			-- Display remaining output.
+			void $ tryIO $ forever $
+				showremote =<< hGetLine fromh
+			hClose fromh
+		status <- getstatus fromh `catchIO` (const $ errorMessage "protocol error (perhaps the remote propellor failed to run?)")
+		case status of
+			Ready -> finish
+			NeedGitClone -> do
+				hClose toh
+				hClose fromh
+				sendGitClone hn url
+				go cacheparams url privdata
+	
+	user = "root@"++hn
+
+	bootstrapcmd = shellWrap $ intercalate " ; "
+		[ "if [ ! -d " ++ localdir ++ " ]"
+		, "then " ++ intercalate " && "
+			[ "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 deps build; fi"
+			, "./propellor --boot " ++ hn
+			]
+		, "fi"
+		]
+
+	getstatus :: Handle -> IO BootStrapStatus
+	getstatus h = do
+		l <- hGetLine h
+		case readish =<< fromMarked statusMarker l of
+			Nothing -> do
+				showremote l
+				getstatus h
+			Just status -> return status
+	
+	showremote s = putStrLn s
+	senddata toh f marker s = void $
+		actionMessage ("Sending " ++ f ++ " (" ++ show (length s) ++ " bytes) to " ++ hn) $ do
+			sendMarked toh marker s
+			return True
+
+sendGitClone :: HostName -> String -> IO ()
+sendGitClone hn url = void $ actionMessage ("Pushing git repository to " ++ hn) $ do
+	branch <- getCurrentBranch
+	cacheparams <- sshCachingParams hn
+	withTmpFile "propellor.git" $ \tmp _ -> allM id
+		[ boolSystem "git" [Param "bundle", Param "create", File tmp, Param "HEAD"]
+		, boolSystem "scp" $ cacheparams ++ [File tmp, Param ("root@"++hn++":"++remotebundle)]
+		, boolSystem "ssh" $ cacheparams ++ [Param ("root@"++hn), Param $ unpackcmd branch]
+		]
+  where
+	remotebundle = "/usr/local/propellor.git"
+	unpackcmd branch = shellWrap $ intercalate " && "
+		[ "git clone " ++ remotebundle ++ " " ++ localdir
+		, "cd " ++ localdir
+		, "git checkout -b " ++ branch
+		, "git remote rm origin"
+		, "rm -f " ++ remotebundle
+		, "git remote add origin " ++ url
+		-- same as --set-upstream-to, except origin branch
+		-- has not been pulled yet
+		, "git config branch."++branch++".remote origin"
+		, "git config branch."++branch++".merge refs/heads/"++branch
+		]
+
+data BootStrapStatus = Ready | NeedGitClone
+	deriving (Read, Show, Eq)
+
+type Marker = String
+type Marked = String
+
+statusMarker :: Marker
+statusMarker = "STATUS"
+
+privDataMarker :: String
+privDataMarker = "PRIVDATA "
+
+toMarked :: Marker -> String -> String
+toMarked marker = intercalate "\n" . map (marker ++) . lines
+
+sendMarked :: Handle -> Marker -> String -> IO ()
+sendMarked h marker s = do
+	-- Prefix string with newline because sometimes a
+	-- incomplete line is output.
+	hPutStrLn h ("\n" ++ toMarked marker s)
+	hFlush h
+
+fromMarked :: Marker -> Marked -> Maybe String
+fromMarked marker s
+	| null matches = Nothing
+	| otherwise = Just $ intercalate "\n" $
+		map (drop len) matches
+  where
+	len = length marker
+	matches = filter (marker `isPrefixOf`) $ lines s
+
+boot :: Attr -> [Property] -> IO ()
+boot attr ps = do
+	sendMarked stdout statusMarker $ show Ready
+	reply <- hGetContentsStrict stdin
+
+	makePrivDataDir
+	maybe noop (writeFileProtected privDataLocal) $
+		fromMarked privDataMarker reply
+	mainProperties attr ps
+
+addKey :: String -> IO ()
+addKey keyid = exitBool =<< allM id [ gpg, gitadd, gitcommit ]
+  where
+	gpg = boolSystem "sh"
+		[ Param "-c"
+		, Param $ "gpg --export " ++ keyid ++ " | gpg " ++
+			unwords (gpgopts ++ ["--import"])
+		]
+	gitadd = boolSystem "git"
+		[ Param "add"
+		, File keyring
+		]
+	gitcommit = gitCommit
+		[ File keyring
+		, Param "-m"
+		, Param "propellor addkey"
+		]
+
+{- Automatically sign the commit if there'a a keyring. -}
+gitCommit :: [CommandParam] -> IO Bool
+gitCommit ps = do
+	k <- doesFileExist keyring
+	boolSystem "git" $ catMaybes $
+		[ Just (Param "commit")
+		, if k then Just (Param "--gpg-sign") else Nothing
+		] ++ map Just ps
+
+keyring :: FilePath
+keyring = privDataDir </> "keyring.gpg"
+
+gpgopts :: [String]
+gpgopts = ["--options", "/dev/null", "--no-default-keyring", "--keyring", keyring]
+
+getUrl :: IO String
+getUrl = maybe nourl return =<< getM get urls
+  where
+	urls = ["remote.deploy.url", "remote.origin.url"]
+	nourl = errorMessage $ "Cannot find deploy url in " ++ show urls
+	get u = do
+		v <- catchMaybeIO $ 
+			takeWhile (/= '\n') 
+				<$> readProcess "git" ["config", u]
+		return $ case v of
+			Just url | not (null url) -> Just url
+			_ -> Nothing
+
+checkDebugMode :: IO ()
+checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG"
+  where
+	go (Just s)
+		| s == "1" = do
+			f <- setFormatter
+				<$> streamHandler stderr DEBUG
+				<*> pure (simpleLogFormatter "[$time] $msg")
+			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
new file mode 100644
index 00000000..81d979ac
--- /dev/null
+++ b/Propellor/Engine.hs
@@ -0,0 +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 Propellor.Exception
+
+runPropellor :: Attr -> Propellor a -> IO a
+runPropellor attr a = runReaderT (runWithAttr a) attr
+
+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] -> 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
new file mode 100644
index 00000000..2e63061e
--- /dev/null
+++ b/Propellor/Message.hs
@@ -0,0 +1,51 @@
+{-# 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 :: (MonadIO m, ActionResult r) => Desc -> m r -> m r
+actionMessage desc a = do
+	liftIO $ do
+		setTitle $ "propellor: " ++ desc
+		hFlush stdout
+
+	r <- a
+
+	liftIO $ do
+		setTitle "propellor: running"
+		let (msg, intensity, color) = getActionResult r
+		putStr $ desc ++ " ... "
+		colorLine intensity color msg
+		hFlush stdout
+
+	return r
+
+warningMessage :: MonadIO m => String -> m ()
+warningMessage s = liftIO $ colorLine Vivid Red $ "** warning: " ++ s
+
+colorLine :: ColorIntensity -> Color -> String -> IO ()
+colorLine intensity color msg = do
+	setSGR [SetColor Foreground intensity color]
+	putStr msg
+	setSGR []
+	-- Note this comes after the color is reset, so that
+	-- the color set and reset happen in the same line.
+	putStrLn ""
+	hFlush stdout
+
+errorMessage :: String -> IO a
+errorMessage s = do
+	warningMessage s
+	error "Cannot continue!"
+
+-- | Causes a debug message to be displayed when PROPELLOR_DEBUG=1
+debug :: [String] -> IO ()
+debug = debugM "propellor" . unwords
diff --git a/Propellor/PrivData.hs b/Propellor/PrivData.hs
new file mode 100644
index 00000000..5adc9e94
--- /dev/null
+++ b/Propellor/PrivData.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE PackageImports #-}
+
+module Propellor.PrivData where
+
+import qualified Data.Map as M
+import Control.Applicative
+import System.FilePath
+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
+import Utility.Exception
+import Utility.Process
+import Utility.Tmp
+import Utility.SafeCommand
+import Utility.Misc
+
+withPrivData :: PrivDataField -> (String -> Propellor Result) -> Propellor Result
+withPrivData field a = maybe missing a =<< liftIO (getPrivData field)
+  where
+	missing = do
+		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
+	m <- catchDefaultIO Nothing $ readish <$> readFile privDataLocal
+	return $ maybe Nothing (M.lookup field) m
+
+setPrivData :: HostName -> PrivDataField -> IO ()
+setPrivData host field = do
+	putStrLn "Enter private data on stdin; ctrl-D when done:"
+	value <- chomp <$> hGetContentsStrict stdin
+	makePrivDataDir
+	let f = privDataFile host
+	m <- fromMaybe M.empty . readish <$> gpgDecrypt f
+	let m' = M.insert field value m
+	gpgEncrypt f (show m')
+	putStrLn "Private data set."
+	void $ boolSystem "git" [Param "add", File f]
+  where
+	chomp s
+		| end s == "\n" = chomp (beginning s)
+		| otherwise = s
+
+makePrivDataDir :: IO ()
+makePrivDataDir = createDirectoryIfMissing False privDataDir
+
+privDataDir :: FilePath
+privDataDir = "privdata"
+
+privDataFile :: HostName -> FilePath
+privDataFile host = privDataDir </> host ++ ".gpg"
+
+privDataLocal :: FilePath
+privDataLocal = privDataDir </> "local"
+
+gpgDecrypt :: FilePath -> IO String
+gpgDecrypt f = ifM (doesFileExist f)
+	( readProcess "gpg" ["--decrypt", f]
+	, return ""
+	)
+
+gpgEncrypt :: FilePath -> String -> IO ()
+gpgEncrypt f s = do
+	encrypted <- writeReadProcessEnv "gpg"
+		[ "--default-recipient-self"
+		, "--armor"
+		, "--encrypt"
+		]
+		Nothing
+		(Just $ flip hPutStr s)
+		Nothing
+	viaTmp writeFile f encrypted
diff --git a/Propellor/Property.hs b/Propellor/Property.hs
new file mode 100644
index 00000000..3a3c1cb1
--- /dev/null
+++ b/Propellor/Property.hs
@@ -0,0 +1,120 @@
+{-# 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 () -> Propellor Result
+makeChange a = liftIO a >> return MadeChange
+
+noChange :: Propellor Result
+noChange = return NoChange
+
+-- | Combines a list of properties, resulting in a single property
+-- that when run will run each property in the list in turn,
+-- 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
+
+-- | Combines a list of properties, resulting in one property that
+-- ensures each in turn, stopping on failure.
+combineProperties :: Desc -> [Property] -> Property
+combineProperties desc ps = Property desc $ go ps NoChange
+  where
+  	go [] rs = return rs
+	go (l:ls) rs = do
+		r <- ensureProperty l
+		case r of
+			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 =<< liftIO (doesFileExist flagfile)
+  where
+	go True = return NoChange
+	go False = do
+		r <- ensureProperty property
+		when (r == MadeChange) $ liftIO $ 
+			unlessM (doesFileExist flagfile) $
+				writeFile flagfile ""
+		return r
+
+--- | Whenever a change has to be made for a Property, causes a hook
+-- Property to also be run, but not otherwise.
+onChange :: Property -> Property -> Property
+property `onChange` hook = Property (propertyDesc property) $ do
+	r <- ensureProperty property
+	case r of
+		MadeChange -> do
+			r' <- ensureProperty hook
+			return $ r <> r'
+		_ -> return r
+
+(==>) :: Desc -> Property -> Property
+(==>) = flip describe
+infixl 1 ==>
+
+-- | Makes a Property only be performed when a test succeeds.
+check :: IO Bool -> Property -> Property
+check c property = Property (propertyDesc property) $ ifM (liftIO c)
+	( ensureProperty property
+	, return NoChange
+	)
+
+boolProperty :: Desc -> IO Bool -> Property
+boolProperty desc a = Property desc $ ifM (liftIO a)
+	( return MadeChange
+	, return FailedChange
+	)
+
+-- | Undoes the effect of a property.
+revert :: RevertableProperty -> RevertableProperty
+revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
+
+-- | 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)
+
+infixl 1 &
+
+-- | 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
new file mode 100644
index 00000000..4da13a2f
--- /dev/null
+++ b/Propellor/Property/Apt.hs
@@ -0,0 +1,193 @@
+module Propellor.Property.Apt where
+
+import Data.Maybe
+import Control.Applicative
+import Data.List
+import System.IO
+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
+sourcesList = "/etc/apt/sources.list"
+
+type Url = String
+type Section = String
+
+showSuite :: DebianSuite -> String
+showSuite Stable = "stable"
+showSuite Testing = "testing"
+showSuite Unstable = "unstable"
+showSuite Experimental = "experimental"
+showSuite (DebianRelease r) = r
+
+debLine :: DebianSuite -> Url -> [Section] -> Line
+debLine suite mirror sections = unwords $
+	["deb", mirror, showSuite suite] ++ sections
+
+srcLine :: Line -> Line
+srcLine l = case words l of
+	("deb":rest) -> unwords $ "deb-src" : rest
+	_ -> ""
+
+stdSections :: [Section]
+stdSections = ["main", "contrib", "non-free"]
+
+binandsrc :: String -> DebianSuite -> [Line]
+binandsrc url suite = [l, srcLine l]
+  where
+	l = debLine suite url stdSections
+
+debCdn :: DebianSuite -> [Line]
+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 ++ securityUpdates suite)
+	`describe` ("standard sources.list for " ++ show suite)
+
+setSourcesList :: [Line] -> Property
+setSourcesList ls = sourcesList `File.hasContent` ls `onChange` update
+
+runApt :: [String] -> Property
+runApt ps = cmdProperty' "apt-get" ps noninteractiveEnv
+
+noninteractiveEnv :: [(String, String)]
+noninteractiveEnv =
+		[ ("DEBIAN_FRONTEND", "noninteractive")
+		, ("APT_LISTCHANGES_FRONTEND", "none")
+		]
+
+update :: Property
+update = runApt ["update"]
+	`describe` "apt update"
+
+upgrade :: Property
+upgrade = runApt ["-y", "dist-upgrade"]
+	`describe` "apt dist-upgrade"
+
+type Package = String
+
+installed :: [Package] -> Property
+installed = installed' ["-y"]
+
+installed' :: [String] -> [Package] -> Property
+installed' params ps = robustly $ check (isInstallable ps) go
+	`describe` (unwords $ "apt installed":ps)
+  where
+	go = runApt $ params ++ ["install"] ++ ps
+
+-- | Minimal install of package, without recommends.
+installedMin :: [Package] -> Property
+installedMin = installed' ["--no-install-recommends", "-y"]
+
+removed :: [Package] -> Property
+removed ps = check (or <$> isInstalled' ps) go
+	`describe` (unwords $ "apt removed":ps)
+  where
+	go = runApt $ ["-y", "remove"] ++ ps
+
+buildDep :: [Package] -> Property
+buildDep ps = robustly go
+	`describe` (unwords $ "apt build-dep":ps)
+  where
+	go = runApt $ ["-y", "build-dep"] ++ ps
+
+-- | Installs the build deps for the source package unpacked
+-- in the specifed directory, with a dummy package also
+-- installed so that autoRemove won't remove them.
+buildDepIn :: FilePath -> Property
+buildDepIn dir = go `requires` installedMin ["devscripts", "equivs"]
+  where
+	go = cmdProperty' "sh" ["-c", "cd '" ++ dir ++ "' && mk-build-deps debian/control --install --tool 'apt-get -y --no-install-recommends' --remove"]
+			noninteractiveEnv
+
+-- | Package installation may fail becuse the archive has changed.
+-- Run an update in that case and retry.
+robustly :: Property -> Property
+robustly p = Property (propertyDesc p) $ do
+	r <- ensureProperty p
+	if r == FailedChange
+		then ensureProperty $ p `requires` update
+		else return r
+
+isInstallable :: [Package] -> IO Bool
+isInstallable ps = do
+	l <- isInstalled' ps
+	return $ any (== False) l && not (null l)
+
+isInstalled :: Package -> IO Bool
+isInstalled p = (== [True]) <$> isInstalled' [p]
+
+-- | Note that the order of the returned list will not always
+-- correspond to the order of the input list. The number of items may
+-- even vary. If apt does not know about a package at all, it will not
+-- be included in the result list.
+isInstalled' :: [Package] -> IO [Bool]
+isInstalled' ps = catMaybes . map parse . lines
+	<$> readProcess "apt-cache" ("policy":ps)
+  where
+	parse l
+		| "Installed: (none)" `isInfixOf` l = Just False
+		| "Installed: " `isInfixOf` l = Just True
+		| otherwise = Nothing
+
+autoRemove :: Property
+autoRemove = runApt ["-y", "autoremove"]
+	`describe` "apt autoremove"
+
+-- | Enables unattended upgrades. Revert to disable.
+unattendedUpgrades :: RevertableProperty
+unattendedUpgrades = RevertableProperty enable disable
+  where
+	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)
+	  where
+		v
+			| enabled = "true"
+			| otherwise = "false"
+
+-- | Preseeds debconf values and reconfigures the package so it takes
+-- effect.
+reConfigure :: Package -> [(String, String, String)] -> Property
+reConfigure package vals = reconfigure `requires` setselections
+	`describe` ("reconfigure " ++ package)
+  where
+	setselections = Property "preseed" $ makeChange $
+		withHandle StdinHandle createProcessSuccess
+			(proc "debconf-set-selections" []) $ \h -> do
+				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
new file mode 100644
index 00000000..875c1f9a
--- /dev/null
+++ b/Propellor/Property/Cmd.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE PackageImports #-}
+
+module Propellor.Property.Cmd (
+	cmdProperty,
+	cmdProperty',
+	scriptProperty,
+	userScriptProperty,
+) where
+
+import Control.Applicative
+import Data.List
+import "mtl" Control.Monad.Reader
+
+import Propellor.Types
+import Utility.Monad
+import Utility.SafeCommand
+import Utility.Env
+
+-- | A property that can be satisfied by running a command.
+--
+-- The command must exit 0 on success.
+cmdProperty :: String -> [String] -> Property
+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 $ liftIO $ do
+	env' <- addEntries env <$> getEnvironment
+	ifM (boolSystemEnv cmd (map Param params) (Just env'))
+		( return MadeChange
+		, return FailedChange
+		)
+  where
+  	desc = unwords $ cmd : params
+
+-- | A property that can be satisfied by running a series of shell commands.
+scriptProperty :: [String] -> Property
+scriptProperty script = cmdProperty "sh" ["-c", shellcmd]
+  where
+	shellcmd = intercalate " ; " ("set -e" : script)
+
+-- | A property that can satisfied by running a series of shell commands,
+-- as user (cd'd to their home directory).
+userScriptProperty :: UserName -> [String] -> Property
+userScriptProperty user script = cmdProperty "su" ["-c", shellcmd, user]
+  where
+	shellcmd = intercalate " ; " ("set -e" : "cd" : script)
diff --git a/Propellor/Property/Cron.hs b/Propellor/Property/Cron.hs
new file mode 100644
index 00000000..fa6019ea
--- /dev/null
+++ b/Propellor/Property/Cron.hs
@@ -0,0 +1,32 @@
+module Propellor.Property.Cron where
+
+import Propellor
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+
+type CronTimes = String
+
+-- | Installs a cron job, run as a specificed user, in a particular
+--directory. Note that the Desc must be unique, as it is used for the 
+--cron.d/ filename.
+job :: Desc -> CronTimes -> UserName -> FilePath -> String -> Property
+job desc times user cddir command = ("/etc/cron.d/" ++ desc) `File.hasContent`
+	[ "# Generated by propellor"
+	, ""
+	, "SHELL=/bin/sh"
+	, "PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin"
+	, ""
+	, times ++ "\t" ++ user ++ "\t" ++ "cd " ++ cddir ++ " && " ++ command
+	]
+	`requires` Apt.serviceInstalledRunning "cron"
+	`describe` ("cronned " ++ desc)
+
+-- | Installs a cron job, and runs it niced and ioniced.
+niceJob :: Desc -> CronTimes -> UserName -> FilePath -> String -> Property
+niceJob desc times user cddir command = job desc times user cddir
+	("nice ionice -c 3 " ++ command)
+	`requires` Apt.installed ["util-linux", "moreutils"]
+
+-- | Installs a cron job to run propellor.
+runPropellor :: CronTimes -> Property
+runPropellor times = niceJob "propellor" times "root" localdir "chronic make"
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
new file mode 100644
index 00000000..d2555ea5
--- /dev/null
+++ b/Propellor/Property/Docker.hs
@@ -0,0 +1,462 @@
+{-# LANGUAGE BangPatterns #-}
+
+-- | Docker support for propellor
+--
+-- The existance of a docker container is just another Property of a system,
+-- which propellor can set up. See config.hs for an example.
+
+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
+import Utility.SafeCommand
+import Utility.Path
+
+import Control.Concurrent.Async
+import System.Posix.Directory
+import System.Posix.Process
+import Data.List
+import Data.List.Utils
+
+-- | Configures docker with an authentication file, so that images can be
+-- pushed to index.docker.io.
+configured :: Property
+configured = Property "docker configured" go `requires` installed
+  where
+	go = withPrivData DockerAuthentication $ \cfg -> ensureProperty $ 
+		"/root/.dockercfg" `File.hasContent` (lines cfg)
+
+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.
+--
+-- Reverting this property ensures that the container is stopped and
+-- removed.
+docked
+	:: [Host]
+	-> ContainerName
+	-> RevertableProperty
+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) $
+				liftIO $ report <$> mapM id
+					[ removeContainer cid
+					, removeImage image
+					]
+			]
+
+findContainer
+	:: [Host]
+	-> ContainerId
+	-> ContainerName
+	-> (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
+	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
+-- that were not set up using propellor.
+--
+-- Generally, should come after the properties for the desired containers.
+garbageCollected :: Property
+garbageCollected = propertyList "docker garbage collected"
+	[ gccontainers
+	, gcimages
+	]
+  where
+	gccontainers = Property "docker containers garbage collected" $
+		liftIO $ report <$> (mapM removeContainer =<< listContainers AllContainers)
+	gcimages = Property "docker images garbage collected" $ do
+		liftIO $ report <$> (mapM removeImage =<< listImages)
+
+data Container = Container Image [RunParam]
+
+-- | Parameters to pass to `docker run` when creating a container.
+type RunParam = String
+
+-- | A docker image, that can be used to run a container.
+type Image = String
+
+-- | Set custom dns server for container.
+dns :: String -> AttrProperty
+dns = runProp "dns"
+
+-- | Set container host name.
+hostname :: String -> AttrProperty
+hostname = runProp "hostname"
+
+-- | Set name for container. (Normally done automatically.)
+name :: String -> AttrProperty
+name = runProp "name"
+
+-- | Publish a container's port to the host
+-- (format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort)
+publish :: String -> AttrProperty
+publish = runProp "publish"
+
+-- | Username or UID for container.
+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 -> AttrProperty
+volume = runProp "volume"
+
+-- | Mount a volume from the specified container into the current
+-- container.
+volumes_from :: ContainerName -> AttrProperty
+volumes_from cn = genProp "volumes-from" $ \hn ->
+	fromContainerId (ContainerId hn cn)
+
+-- | Work dir inside the container. 
+workdir :: String -> AttrProperty
+workdir = runProp "workdir"
+
+-- | Memory limit for container.
+--Format: <number><optional unit>, where unit = b, k, m or g
+memory :: String -> AttrProperty
+memory = runProp "memory"
+
+-- | Link with another container on the same host.
+link :: ContainerName -> ContainerAlias -> AttrProperty
+link linkwith alias = genProp "link" $ \hn ->
+	fromContainerId (ContainerId hn linkwith) ++ ":" ++ alias
+
+-- | A short alias for a linked container.
+-- Each container has its own alias namespace.
+type ContainerAlias = String
+
+-- | A container is identified by its name, and the host
+-- on which it's deployed.
+data ContainerId = ContainerId HostName ContainerName
+	deriving (Eq, Read, Show)
+
+-- | Two containers with the same ContainerIdent were started from
+-- the same base image (possibly a different version though), and
+-- with the same RunParams.
+data ContainerIdent = ContainerIdent Image HostName ContainerName [RunParam]
+	deriving (Read, Show, Eq)
+
+ident2id :: ContainerIdent -> ContainerId
+ident2id (ContainerIdent _ hn cn _) = ContainerId hn cn
+
+toContainerId :: String -> Maybe ContainerId
+toContainerId s
+	| myContainerSuffix `isSuffixOf` s = case separate (== '.') (desuffix s) of
+		(cn, hn)
+			| null hn || null cn -> Nothing
+			| otherwise -> Just $ ContainerId hn cn
+	| otherwise = Nothing
+  where
+	desuffix = reverse . drop len . reverse
+	len = length myContainerSuffix
+
+fromContainerId :: ContainerId -> String
+fromContainerId (ContainerId hn cn) = cn++"."++hn++myContainerSuffix
+
+containerHostName :: ContainerId -> HostName
+containerHostName (ContainerId _ cn) = cn2hn cn
+
+myContainerSuffix :: String
+myContainerSuffix = ".propellor"
+
+containerDesc :: ContainerId -> Property -> Property
+containerDesc cid p = p `describe` desc
+  where
+	desc = "[" ++ fromContainerId cid ++ "] " ++ propertyDesc p
+
+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 <- liftIO $ getrunningident
+			if runningident == Just ident
+				then noChange
+				else do
+					void $ liftIO $ stopContainer cid
+					restartcontainer
+		else ifM (liftIO $ elem cid <$> listContainers AllContainers)
+			( restartcontainer
+			, go image
+			)
+  where
+	ident = ContainerIdent image hn cn runps
+
+	restartcontainer = do
+		oldimage <- liftIO $ fromMaybe image <$> commitContainer cid
+		void $ liftIO $ removeContainer cid
+		go oldimage
+
+	getrunningident :: IO (Maybe ContainerIdent)
+	getrunningident = simpleShClient (namedPipe cid) "cat" [propellorIdent] $ \rs -> do
+		let !v = extractident rs
+		return v
+
+	extractident :: [Resp] -> Maybe ContainerIdent
+	extractident = headMaybe . catMaybes . map readish . catMaybes . map getStdout
+
+	go img = do
+		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]
+
+-- | Called when propellor is running inside a docker container.
+-- The string should be the container's ContainerId.
+--
+-- This process is effectively init inside the container.
+-- It even needs to wait on zombie processes!
+--
+-- Fork a thread to run the SimpleSh server in the background.
+-- In the foreground, run an interactive bash (or sh) shell,
+-- so that the user can interact with it when attached to the container.
+--
+-- When the system reboots, docker restarts the container, and this is run
+-- again. So, to make the necessary services get started on boot, this needs
+-- to provision the container then. However, if the container is already
+-- being provisioned by the calling propellor, it would be redundant and
+-- problimatic to also provisoon it here.
+--
+-- The solution is a flag file. If the flag file exists, then the container
+-- was already provisioned. So, it must be a reboot, and time to provision
+-- again. If the flag file doesn't exist, don't provision here.
+chain :: String -> IO ()
+chain s = case toContainerId s of
+	Nothing -> error $ "Invalid ContainerId: " ++ s
+	Just cid -> do
+		changeWorkingDirectory localdir
+		writeFile propellorIdent . show =<< readIdentFile cid
+		-- Run boot provisioning before starting simpleSh,
+		-- 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 $ containerHostName cid]) $
+				warningMessage "Boot provision failed!"
+		void $ async $ job reapzombies
+		void $ async $ job $ simpleSh $ namedPipe cid
+		job $ do
+			void $ tryIO $ ifM (inPath "bash")
+				( boolSystem "bash" [Param "-l"]
+				, boolSystem "/bin/sh" []
+				)
+			putStrLn "Container is still running. Press ^P^Q to detach."
+  where
+	job = forever . void . tryIO
+	reapzombies = void $ getAnyProcessStatus True False
+
+-- | Once a container is running, propellor can be run inside
+-- it to provision it.
+--
+-- Note that there is a race here, between the simplesh
+-- server starting up in the container, and this property
+-- being run. So, retry connections to the client for up to
+-- 1 minute.
+provisionContainer :: ContainerId -> Property
+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 $ containerHostName cid]
+
+	go lastline (v:rest) = case v of
+		StdoutLine s -> do
+			debug ["stdout: ", show s]
+			maybe noop putStrLn lastline
+			hFlush stdout
+			go (Just s) rest
+		StderrLine s -> do
+			debug ["stderr: ", show s]
+			maybe noop putStrLn lastline
+			hFlush stdout
+			hPutStrLn stderr s
+			hFlush stderr
+			go Nothing rest
+		Done -> ret lastline
+	go lastline [] = ret lastline
+
+	ret lastline = return $ fromMaybe FailedChange $
+		readish =<< lastline
+
+stopContainer :: ContainerId -> IO Bool
+stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]
+
+stoppedContainer :: ContainerId -> Property
+stoppedContainer cid = containerDesc cid $ Property desc $ 
+	ifM (liftIO $ elem cid <$> listContainers RunningContainers)
+		( liftIO cleanup `after` ensureProperty 
+			(boolProperty desc $ stopContainer cid)
+		, return NoChange
+		)
+  where
+	desc = "stopped"
+	cleanup = do
+		nukeFile $ namedPipe cid
+		nukeFile $ identFile cid
+		removeDirectoryRecursive $ shimdir cid
+		clearProvisionedFlag cid
+
+removeContainer :: ContainerId -> IO Bool
+removeContainer cid = catchBoolIO $
+	snd <$> processTranscript dockercmd ["rm", fromContainerId cid ] Nothing
+
+removeImage :: Image -> IO Bool
+removeImage image = catchBoolIO $
+	snd <$> processTranscript dockercmd ["rmi", image ] Nothing
+
+runContainer :: Image -> [RunParam] -> [String] -> IO Bool
+runContainer image ps cmd = boolSystem dockercmd $ map Param $
+	"run" : (ps ++ image : cmd)
+
+commitContainer :: ContainerId -> IO (Maybe Image)
+commitContainer cid = catchMaybeIO $
+	takeWhile (/= '\n') 
+		<$> readProcess dockercmd ["commit", fromContainerId cid]
+
+data ContainerFilter = RunningContainers | AllContainers
+	deriving (Eq)
+
+-- | Only lists propellor managed containers.
+listContainers :: ContainerFilter -> IO [ContainerId]
+listContainers status = 
+	catMaybes . map toContainerId . concat . map (split ",")
+		. catMaybes . map (lastMaybe . words) . lines
+		<$> readProcess dockercmd ps
+  where
+	ps
+		| status == AllContainers = baseps ++ ["--all"]
+		| otherwise = baseps
+	baseps = ["ps", "--no-trunc"]
+
+listImages :: IO [Image]
+listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]
+
+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) -> 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
+-- the container has the same ident later.
+propellorIdent :: FilePath
+propellorIdent = "/.propellor-ident"
+
+-- | Named pipe used for communication with the container.
+namedPipe :: ContainerId -> FilePath
+namedPipe cid = "docker" </> fromContainerId cid
+
+provisionedFlag :: ContainerId -> FilePath
+provisionedFlag cid = "docker" </> fromContainerId cid ++ ".provisioned"
+
+clearProvisionedFlag :: ContainerId -> IO ()
+clearProvisionedFlag = nukeFile . provisionedFlag
+
+setProvisionedFlag :: ContainerId -> IO ()
+setProvisionedFlag cid = do
+	createDirectoryIfMissing True (takeDirectory (provisionedFlag cid))
+	writeFile (provisionedFlag cid) "1"
+
+checkProvisionedFlag :: ContainerId -> IO Bool
+checkProvisionedFlag = doesFileExist . provisionedFlag
+
+shimdir :: ContainerId -> FilePath
+shimdir cid = "docker" </> fromContainerId cid ++ ".shim"
+
+identFile :: ContainerId -> FilePath
+identFile cid = "docker" </> fromContainerId cid ++ ".ident"
+
+readIdentFile :: ContainerId -> IO ContainerIdent
+readIdentFile cid = fromMaybe (error "bad ident in identFile")
+	. readish <$> readFile (identFile cid)
+
+dockercmd :: String
+dockercmd = "docker.io"
+
+report :: [Bool] -> Result
+report rmed
+	| or rmed = MadeChange
+	| otherwise = NoChange
+
diff --git a/Propellor/Property/Docker/Shim.hs b/Propellor/Property/Docker/Shim.hs
new file mode 100644
index 00000000..c2f35d0c
--- /dev/null
+++ b/Propellor/Property/Docker/Shim.hs
@@ -0,0 +1,61 @@
+-- | Support for running propellor, as built outside a docker container,
+-- inside the container.
+--
+-- Note: This is currently Debian specific, due to glibcLibs.
+
+module Propellor.Property.Docker.Shim (setup, cleanEnv, file) where
+
+import Propellor
+import Utility.LinuxMkLibs
+import Utility.SafeCommand
+import Utility.Path
+import Utility.FileMode
+
+import Data.List
+import System.Posix.Files
+
+-- | Sets up a shimmed version of the program, in a directory, and
+-- returns its path.
+setup :: FilePath -> FilePath -> IO FilePath
+setup propellorbin dest = do
+	createDirectoryIfMissing True dest
+
+	libs <- parseLdd <$> readProcess "ldd" [propellorbin]
+	glibclibs <- glibcLibs
+	let libs' = nub $ libs ++ glibclibs
+	libdirs <- map (dest ++) . nub . catMaybes
+		<$> mapM (installLib installFile dest) libs'
+	
+	let linker = (dest ++) $ 
+		fromMaybe (error "cannot find ld-linux linker") $
+			headMaybe $ filter ("ld-linux" `isInfixOf`) libs'
+	let gconvdir = (dest ++) $ parentDir $
+		fromMaybe (error "cannot find gconv directory") $
+			headMaybe $ filter ("/gconv/" `isInfixOf`) glibclibs
+	let linkerparams = ["--library-path", intercalate ":" libdirs ]
+	let shim = file propellorbin dest
+	writeFile shim $ unlines
+		[ "#!/bin/sh"
+		, "GCONV_PATH=" ++ shellEscape gconvdir
+		, "export GCONV_PATH"
+		, "exec " ++ unwords (map shellEscape $ linker : linkerparams) ++ 
+			" " ++ shellEscape propellorbin ++ " \"$@\""
+		]
+	modifyFileMode shim (addModes executeModes)
+	return shim
+
+cleanEnv :: IO ()
+cleanEnv = void $ unsetEnv "GCONV_PATH"
+
+file :: FilePath -> FilePath -> FilePath
+file propellorbin dest = dest </> takeFileName propellorbin
+
+installFile :: FilePath -> FilePath -> IO ()
+installFile top f = do
+	createDirectoryIfMissing True destdir
+	nukeFile dest
+	createLink f dest `catchIO` (const copy)
+  where
+	copy = void $ boolSystem "cp" [Param "-a", Param f, Param dest]
+	destdir = inTop top $ parentDir f
+	dest = inTop top f
diff --git a/Propellor/Property/File.hs b/Propellor/Property/File.hs
new file mode 100644
index 00000000..10dee75e
--- /dev/null
+++ b/Propellor/Property/File.hs
@@ -0,0 +1,70 @@
+module Propellor.Property.File where
+
+import Propellor
+
+import System.Posix.Files
+
+type Line = String
+
+-- | Replaces all the content of a file.
+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
+  where
+	go ls
+		| l `elem` ls = ls
+		| otherwise = ls++[l]
+
+-- | Ensures that a line is not present in a file.
+-- Note that the file is ensured to exist, so if it doesn't, an empty
+-- file will be written.
+lacksLine :: FilePath -> Line -> Property
+f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f
+
+-- | Removes a file. Does not remove symlinks or non-plain-files.
+notPresent :: FilePath -> Property
+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 =<< liftIO (doesFileExist f)
+  where
+	go True = do
+		ls <- liftIO $ lines <$> readFile f
+		let ls' = a ls
+		if ls' == ls
+			then noChange
+			else makeChange $ viaTmp updatefile f (unlines ls')
+	go False = makeChange $ writeFile f (unlines $ a [])
+
+	-- viaTmp makes the temp file mode 600.
+	-- Replicate the original file mode before moving it into place.
+	updatefile f' content = do
+		writeFile f' content
+		getFileStatus f >>= setFileMode f' . fileMode
+
+-- | Ensures a directory exists.
+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
new file mode 100644
index 00000000..03613ac9
--- /dev/null
+++ b/Propellor/Property/Hostname.hs
@@ -0,0 +1,34 @@
+module Propellor.Property.Hostname where
+
+import Propellor
+import qualified Propellor.Property.File as File
+
+-- | Ensures that the hostname is set to the HostAttr value.
+-- Configures both /etc/hostname and the current hostname.
+--
+-- 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).
+sane :: Property
+sane = Property ("sane hostname") (ensureProperty . setTo =<< getHostName)
+
+setTo :: HostName -> Property
+setTo hn = combineProperties desc go
+	`onChange` cmdProperty "hostname" [basehost]
+  where
+	desc = "hostname " ++ hn
+	(basehost, domain) = separate (== '.') hn
+
+	go = catMaybes
+		[ Just $ "/etc/hostname" `File.hasContent` [basehost]
+		, if null domain
+			then Nothing 
+			else Just $ File.fileProperty desc
+				addhostline "/etc/hosts"
+		]
+	
+	hostip = "127.0.1.1"
+	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
new file mode 100644
index 00000000..6009778a
--- /dev/null
+++ b/Propellor/Property/Network.hs
@@ -0,0 +1,30 @@
+module Propellor.Property.Network where
+
+import Propellor
+import Propellor.Property.File
+
+interfaces :: FilePath
+interfaces = "/etc/network/interfaces"
+
+-- | 6to4 ipv6 connection, should work anywhere
+ipv6to4 :: Property
+ipv6to4 = fileProperty "ipv6to4" go interfaces
+	`onChange` ifUp "sit0"
+  where
+	go ls
+		| all (`elem` ls) stanza = ls
+		| otherwise = ls ++ stanza
+	stanza =
+		[ "# Automatically added by propeller"
+		, "iface sit0 inet6 static"
+		, "\taddress 2002:5044:5531::1"
+		, "\tnetmask 64"
+		, "\tgateway ::192.88.99.1"
+		, "auto sit0"
+		, "# End automatically added by propeller"
+		]
+
+type Interface = String
+
+ifUp :: Interface -> Property
+ifUp iface = cmdProperty "ifup" [iface]
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/Reboot.hs b/Propellor/Property/Reboot.hs
new file mode 100644
index 00000000..25e53159
--- /dev/null
+++ b/Propellor/Property/Reboot.hs
@@ -0,0 +1,7 @@
+module Propellor.Property.Reboot where
+
+import Propellor
+
+now :: Property
+now = cmdProperty "reboot" []
+	`describe` "reboot now"
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
new file mode 100644
index 00000000..204a9ca7
--- /dev/null
+++ b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -0,0 +1,57 @@
+module Propellor.Property.SiteSpecific.GitAnnexBuilder where
+
+import Propellor
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.User as User
+import qualified Propellor.Property.Cron as Cron
+import Propellor.Property.Cron (CronTimes)
+
+builduser :: UserName
+builduser = "builder"
+
+homedir :: FilePath
+homedir = "/home/builder"
+
+gitbuilderdir :: FilePath
+gitbuilderdir = homedir </> "gitbuilder"
+
+builddir :: FilePath
+builddir = gitbuilderdir </> "build"
+
+builder :: Architecture -> CronTimes -> Bool -> Property
+builder arch crontimes rsyncupload = combineProperties "gitannexbuilder"
+	[ Apt.stdSourcesList Unstable
+	, Apt.buildDep ["git-annex"]
+	, Apt.installed ["git", "rsync", "moreutils", "ca-certificates",
+		"liblockfile-simple-perl", "cabal-install", "vim", "less"]
+	, Apt.serviceInstalledRunning "cron"
+	, User.accountFor builduser
+	, check (not <$> doesDirectoryExist gitbuilderdir) $ userScriptProperty builduser
+		[ "git clone git://git.kitenet.net/gitannexbuilder " ++ gitbuilderdir
+		, "cd " ++ gitbuilderdir
+		, "git checkout " ++ arch
+		]
+		`describe` "gitbuilder setup"
+	, check (not <$> doesDirectoryExist builddir) $ userScriptProperty builduser
+		[ "git clone git://git-annex.branchable.com/ " ++ builddir
+		]
+	, "git-annex source build deps installed" ==> Apt.buildDepIn builddir
+	, Cron.niceJob "gitannexbuilder" crontimes builduser gitbuilderdir "git pull ; ./autobuild"
+	-- The builduser account does not have a password set,
+	-- instead use the password privdata to hold the rsync server
+	-- password used to upload the built image.
+	, Property "rsync password" $ do
+		let f = homedir </> "rsyncpassword"
+		if rsyncupload 
+			then withPrivData (Password builduser) $ \p -> do
+				oldp <- liftIO $ catchDefaultIO "" $
+					readFileStrict f
+				if p /= oldp
+					then makeChange $ writeFile f p
+					else noChange
+			else do
+				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
new file mode 100644
index 00000000..1ba56b94
--- /dev/null
+++ b/Propellor/Property/SiteSpecific/GitHome.hs
@@ -0,0 +1,36 @@
+module Propellor.Property.SiteSpecific.GitHome where
+
+import Propellor
+import qualified Propellor.Property.Apt as Apt
+import Propellor.Property.User
+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 =<< liftIO (homedir user))
+		`requires` Apt.installed ["git"]
+  where
+ 	go Nothing = noChange
+	go (Just home) = do
+		let tmpdir = home </> "githome"
+		ensureProperty $ combineProperties "githome setup"
+			[ userScriptProperty user ["git clone " ++ url ++ " " ++ tmpdir]
+			, Property "moveout" $ makeChange $ void $
+				moveout tmpdir home
+			, Property "rmdir" $ makeChange $ void $
+				catchMaybeIO $ removeDirectory tmpdir
+			, userScriptProperty user ["rm -rf .aptitude/ .bashrc .profile; bin/mr checkout; bin/fixups"]
+			]
+	moveout tmpdir home = do
+		fs <- dirContents tmpdir
+		forM fs $ \f -> boolSystem "mv" [File f, File home]
+
+url :: String
+url = "git://git.kitenet.net/joey/home"
+
+hasGitDir :: UserName -> IO Bool
+hasGitDir user = go =<< homedir user
+  where
+	go Nothing = return False
+	go (Just home) = doesDirectoryExist (home </> ".git")
diff --git a/Propellor/Property/SiteSpecific/JoeySites.hs b/Propellor/Property/SiteSpecific/JoeySites.hs
new file mode 100644
index 00000000..46373170
--- /dev/null
+++ b/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -0,0 +1,23 @@
+-- | Specific configuation for Joey Hess's sites. Probably not useful to
+-- others except as an example.
+
+module Propellor.Property.SiteSpecific.JoeySites where
+
+import Propellor
+import qualified Propellor.Property.Apt as Apt
+
+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"
+		, scriptProperty
+			[ "rm -rf /root/tmp/oldusenet" -- idenpotency
+			, "git clone git://olduse.net/ /root/tmp/oldusenet/source"
+			, "cd /root/tmp/oldusenet/source/"
+			, "dpkg-buildpackage -us -uc"
+			, "dpkg -i ../oldusenet*.deb || true"
+			, "apt-get -fy install" -- dependencies
+			, "rm -rf /root/tmp/oldusenet"
+			] `describe` "olduse.net built"
+		]
diff --git a/Propellor/Property/Ssh.hs b/Propellor/Property/Ssh.hs
new file mode 100644
index 00000000..59845f8f
--- /dev/null
+++ b/Propellor/Property/Ssh.hs
@@ -0,0 +1,62 @@
+module Propellor.Property.Ssh (
+	setSshdConfig,
+	permitRootLogin,
+	passwordAuthentication,
+	hasAuthorizedKeys,
+	restartSshd,
+	uniqueHostKeys
+) where
+
+import Propellor
+import qualified Propellor.Property.File as File
+import Propellor.Property.User
+import Utility.SafeCommand
+
+sshBool :: Bool -> String
+sshBool True = "yes"
+sshBool False = "no"
+
+sshdConfig :: FilePath
+sshdConfig = "/etc/ssh/sshd_config"
+
+setSshdConfig :: String -> Bool -> Property
+setSshdConfig setting allowed = combineProperties "sshd config"
+	[ sshdConfig `File.lacksLine` (sshline $ not allowed)
+	, sshdConfig `File.containsLine` (sshline allowed)
+	]
+	`onChange` restartSshd
+	`describe` unwords [ "ssh config:", setting, sshBool allowed ]
+  where
+	sshline v = setting ++ " " ++ sshBool v
+
+permitRootLogin :: Bool -> Property
+permitRootLogin = setSshdConfig "PermitRootLogin"
+
+passwordAuthentication :: Bool -> Property
+passwordAuthentication = setSshdConfig "PasswordAuthentication"
+
+hasAuthorizedKeys :: UserName -> IO Bool
+hasAuthorizedKeys = go <=< homedir
+  where
+	go Nothing = return False
+	go (Just home) = not . null <$> catchDefaultIO ""
+		(readFile $ home </> ".ssh" </> "authorized_keys")
+
+restartSshd :: Property
+restartSshd = cmdProperty "service" ["ssh", "restart"]
+
+-- | 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.
+uniqueHostKeys :: Property
+uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
+	`onChange` restartSshd
+  where
+	prop = Property "ssh unique host keys" $ do
+		void $ liftIO $ boolSystem "sh"
+			[ Param "-c"
+			, Param "rm -f /etc/ssh/ssh_host_*"
+			]
+		ensureProperty $
+			cmdProperty "/var/lib/dpkg/info/openssh-server.postinst"
+				["configure"]
diff --git a/Propellor/Property/Sudo.hs b/Propellor/Property/Sudo.hs
new file mode 100644
index 00000000..66ceb580
--- /dev/null
+++ b/Propellor/Property/Sudo.hs
@@ -0,0 +1,32 @@
+module Propellor.Property.Sudo where
+
+import Data.List
+
+import Propellor
+import Propellor.Property.File
+import qualified Propellor.Property.Apt as Apt
+import Propellor.Property.User
+
+-- | Allows a user to sudo. If the user has a password, sudo is configured
+-- to require it. If not, NOPASSWORD is enabled for the user.
+enabledFor :: UserName -> Property
+enabledFor user = Property desc go `requires` Apt.installed ["sudo"]
+  where
+	go = do
+		locked <- liftIO $ isLockedPassword user
+		ensureProperty $
+			fileProperty desc
+				(modify locked . filter (wanted locked))
+				"/etc/sudoers"
+	desc = user ++ " is sudoer"
+	sudobaseline = user ++ " ALL=(ALL:ALL)"
+	sudoline True = sudobaseline ++ " NOPASSWD:ALL"
+	sudoline False = sudobaseline ++ " ALL"
+	wanted locked l
+		-- TOOD: Full sudoers file format parse.. 
+		| not (sudobaseline `isPrefixOf` l) = True
+		| "NOPASSWD" `isInfixOf` l = locked
+		| otherwise = True
+ 	modify locked ls
+		| sudoline locked `elem` ls = ls
+		| otherwise = ls ++ [sudoline locked]
diff --git a/Propellor/Property/Tor.hs b/Propellor/Property/Tor.hs
new file mode 100644
index 00000000..78e35c89
--- /dev/null
+++ b/Propellor/Property/Tor.hs
@@ -0,0 +1,19 @@
+module Propellor.Property.Tor where
+
+import Propellor
+import qualified Propellor.Property.File as File
+import qualified Propellor.Property.Apt as Apt
+
+isBridge :: Property
+isBridge = setup `requires` Apt.installed ["tor"]
+	`describe` "tor bridge"
+  where
+	setup = "/etc/tor/torrc" `File.hasContent`
+		[ "SocksPort 0"
+		, "ORPort 443"
+		, "BridgeRelay 1"
+		, "Exitpolicy reject *:*"
+		] `onChange` restartTor
+
+restartTor :: Property
+restartTor = cmdProperty "service" ["tor", "restart"]
diff --git a/Propellor/Property/User.hs b/Propellor/Property/User.hs
new file mode 100644
index 00000000..9d948834
--- /dev/null
+++ b/Propellor/Property/User.hs
@@ -0,0 +1,61 @@
+module Propellor.Property.User where
+
+import System.Posix
+
+import Propellor
+
+data Eep = YesReallyDeleteHome
+
+accountFor :: UserName -> Property
+accountFor user = check (isNothing <$> homedir user) $ cmdProperty "adduser"
+	[ "--disabled-password"
+	, "--gecos", ""
+	, user
+	]
+	`describe` ("account for " ++ user)
+
+-- | Removes user home directory!! Use with caution.
+nuked :: UserName -> Eep -> Property
+nuked user _ = check (isJust <$> homedir user) $ cmdProperty "userdel"
+	[ "-r"
+	, user
+	]
+	`describe` ("nuked user " ++ user)
+
+-- | Only ensures that the user has some password set. It may or may
+-- not be the password from the PrivData.
+hasSomePassword :: UserName -> Property
+hasSomePassword user = check ((/= HasPassword) <$> getPasswordStatus user) $
+	hasPassword user
+
+hasPassword :: UserName -> Property
+hasPassword user = Property (user ++ " has password") $
+	withPrivData (Password user) $ \password -> makeChange $
+		withHandle StdinHandle createProcessSuccess
+			(proc "chpasswd" []) $ \h -> do
+				hPutStrLn h $ user ++ ":" ++ password
+				hClose h
+
+lockedPassword :: UserName -> Property
+lockedPassword user = check (not <$> isLockedPassword user) $ cmdProperty "passwd"
+	[ "--lock"
+	, user
+	]
+	`describe` ("locked " ++ user ++ " password")
+
+data PasswordStatus = NoPassword | LockedPassword | HasPassword
+	deriving (Eq)
+
+getPasswordStatus :: UserName -> IO PasswordStatus
+getPasswordStatus user = parse . words <$> readProcess "passwd" ["-S", user]
+  where
+	parse (_:"L":_) = LockedPassword
+	parse (_:"NP":_) = NoPassword
+	parse (_:"P":_) = HasPassword
+	parse _ = NoPassword
+
+isLockedPassword :: UserName -> IO Bool
+isLockedPassword user = (== LockedPassword) <$> getPasswordStatus user
+
+homedir :: UserName -> IO (Maybe FilePath)
+homedir user = catchMaybeIO $ homeDirectory <$> getUserEntryForName user
diff --git a/Propellor/SimpleSh.hs b/Propellor/SimpleSh.hs
new file mode 100644
index 00000000..7e0f19ff
--- /dev/null
+++ b/Propellor/SimpleSh.hs
@@ -0,0 +1,97 @@
+-- | Simple server, using a named pipe. Client connects, sends a command,
+-- and gets back all the output from the command, in a stream.
+--
+-- This is useful for eg, docker.
+
+module Propellor.SimpleSh where
+
+import Network.Socket
+import Control.Concurrent.Chan
+import Control.Concurrent.Async
+import System.Process (std_in, std_out, std_err)
+
+import Propellor
+import Utility.FileMode
+import Utility.ThreadScheduler
+
+data Cmd = Cmd String [String]
+	deriving (Read, Show)
+
+data Resp = StdoutLine String | StderrLine String | Done
+	deriving (Read, Show)
+
+simpleSh :: FilePath -> IO ()
+simpleSh namedpipe = do
+	nukeFile namedpipe
+	let dir = takeDirectory namedpipe
+	createDirectoryIfMissing True dir
+	modifyFileMode dir (removeModes otherGroupModes)
+	s <- socket AF_UNIX Stream defaultProtocol
+	bindSocket s (SockAddrUnix namedpipe)
+	listen s 2
+	forever $ do
+		(client, _addr) <- accept s
+		h <- socketToHandle client ReadWriteMode
+		hSetBuffering h LineBuffering
+		maybe noop (run h) . readish =<< hGetLine h
+  where
+	run h (Cmd cmd params) = do
+		let p = (proc cmd params)
+                	{ std_in = Inherit
+	                , std_out = CreatePipe
+			, std_err = CreatePipe
+			}
+		(Nothing, Just outh, Just errh, pid) <- createProcess p
+		chan <- newChan
+
+		let runwriter = do
+			v <- readChan chan
+			hPutStrLn h (show v)
+			case v of
+				Done -> noop
+				_ -> runwriter
+		writer <- async runwriter
+
+		let mkreader t from = maybe noop (const $ mkreader t from) 
+			=<< catchMaybeIO (writeChan chan . t =<< hGetLine from)
+		void $ concurrently
+			(mkreader StdoutLine outh)
+			(mkreader StderrLine errh)
+		
+		void $ tryIO $ waitForProcess pid
+
+		writeChan chan Done
+
+		wait writer
+
+		hClose outh
+		hClose errh
+		hClose h
+
+simpleShClient :: FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a
+simpleShClient namedpipe cmd params handler = do
+	s <- socket AF_UNIX Stream defaultProtocol
+	connect s (SockAddrUnix namedpipe)
+	h <- socketToHandle s ReadWriteMode
+	hSetBuffering h LineBuffering
+	hPutStrLn h $ show $ Cmd cmd params
+	resps <- catMaybes . map readish . lines <$> hGetContents h
+	hClose h `after` handler resps
+
+simpleShClientRetry :: Int -> FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a
+simpleShClientRetry retries namedpipe cmd params handler = go retries
+  where
+	run = simpleShClient namedpipe cmd params handler
+	go n
+		| n < 1 = run
+		| otherwise = do
+			v <- tryIO run
+			case v of
+				Right r -> return r
+				Left _ -> do
+					threadDelaySeconds (Seconds 1)
+					go (n - 1)
+
+getStdout :: Resp -> Maybe String
+getStdout (StdoutLine s) = Just s
+getStdout _ = Nothing
diff --git a/Propellor/Types.hs b/Propellor/Types.hs
new file mode 100644
index 00000000..e6e02126
--- /dev/null
+++ b/Propellor/Types.hs
@@ -0,0 +1,170 @@
+{-# 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 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 :: 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
+	toProp :: p -> Property
+	-- | 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 }
+	toProp p = p
+	x `requires` y = Property (propertyDesc x) $ do
+		r <- propertySatisfy y
+		case r of
+			FailedChange -> return FailedChange
+			_ -> propertySatisfy x
+	getAttr _ = id
+
+instance IsProp RevertableProperty where
+	-- | Sets the description of both sides.
+	describe (RevertableProperty p1 p2) d = 
+		RevertableProperty (describe p1 d) (describe p2 ("not " ++ d))
+	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
+
+data Result = NoChange | MadeChange | FailedChange
+	deriving (Read, Show, Eq)
+
+instance Monoid Result where
+	mempty = NoChange
+
+	mappend FailedChange _ = FailedChange
+	mappend _ FailedChange = FailedChange
+	mappend MadeChange _ = MadeChange
+	mappend _ MadeChange = MadeChange
+	mappend NoChange NoChange = NoChange
+
+-- | High level descritption of a operating system.
+data System = System Distribution Architecture
+	deriving (Show)
+
+data Distribution
+	= Debian DebianSuite
+	| Ubuntu Release
+	deriving (Show)
+
+data DebianSuite = Experimental | Unstable | Testing | Stable | DebianRelease Release
+	deriving (Show, Eq)
+
+type Release = String
+
+type Architecture = String
+
+-- | Results of actions, with color.
+class ActionResult a where
+	getActionResult :: a -> (String, ColorIntensity, Color)
+
+instance ActionResult Bool where
+	getActionResult False = ("failed", Vivid, Red)
+	getActionResult True = ("done", Dull, Green)
+
+instance ActionResult Result where
+	getActionResult NoChange = ("ok", Dull, Green)
+	getActionResult MadeChange = ("done", Vivid, Green)
+	getActionResult FailedChange = ("failed", Vivid, Red)
+
+data CmdLine
+	= Run HostName
+	| Spin HostName
+	| Boot HostName
+	| Set HostName PrivDataField
+	| AddKey String
+	| Continue CmdLine
+	| Chain HostName
+	| Docker HostName
+  deriving (Read, Show, Eq)
+
+-- | Note that removing or changing field names will break the
+-- serialized privdata files, so don't do that!
+-- It's fine to add new fields.
+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