packages feed

propellor 0.2.1 → 0.2.2

raw patch · 22 files changed

+476/−220 lines, 22 files

Files

.gitignore view
@@ -3,3 +3,7 @@ tags privdata/local privdata/keyring.gpg~+Setup+Setup.hi+Setup.o+docker
CHANGELOG view
@@ -1,3 +1,12 @@+propellor (0.2.2) unstable; urgency=medium++  * Now supports provisioning docker containers with architecture/libraries+    that do not match the host.+  * Fixed a bug that caused file modes to be set to 600 when propellor+    modified the file (did not affect newly created files).++ -- Joey Hess <joeyh@debian.org>  Fri, 04 Apr 2014 01:07:32 -0400+ propellor (0.2.1) unstable; urgency=medium    * First release with Debian package.
Propellor/CmdLine.hs view
@@ -7,6 +7,7 @@ import System.Log.Formatter import System.Log.Handler (setFormatter, LogHandler) import System.Log.Handler.Simple+import System.PosixCompat  import Propellor import qualified Propellor.Property.Docker as Docker@@ -67,7 +68,10 @@ 	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) = withprops host $ ensureProperties+	go False (Run host) = ifM ((==) 0 <$> getRealUserID)+		( withprops host ensureProperties+		, go True (Spin host)+		) 	go False (Boot host) = withprops host $ boot  	withprops host a = maybe (unknownhost host) a $@@ -94,16 +98,19 @@   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 <- takeWhile (/= '\n') -		<$> readProcess "git" ["symbolic-ref", "HEAD"]-	let originbranch = "origin" </> takeFileName branchref+	branchref <- getCurrentBranch+	let originbranch = "origin" </> branchref  	void $ actionMessage "Git fetch" $ boolSystem "git" [Param "fetch"] 	 	whenM (doesFileExist keyring) $ do-		{- To verify origin/master commit's signature, have to+		{- 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! -}@@ -116,7 +123,8 @@ 		modifyFileMode privDataDir (removeModes otherGroupModes) 		s <- readProcessEnv "git" ["log", "-n", "1", "--format=%G?", originbranch] 			(Just [("GNUPGHOME", privDataDir)])-		nukeFile $ privDataDir </> "trustring.gpg"+		nukeFile $ privDataDir </> "trustdb.gpg"+		nukeFile $ privDataDir </> "pubring.gpg" 		nukeFile $ privDataDir </> "gpg.conf" 		if s == "U\n" || s == "G\n" 			then do@@ -195,23 +203,28 @@ 			return True  sendGitClone :: HostName -> String -> IO ()-sendGitClone host url = void $ actionMessage ("Pushing git repository to " ++ host) $-	withTmpFile "propellor.git." $ \tmp _ -> allM id+sendGitClone host url = void $ actionMessage ("Pushing git repository to " ++ host) $ do+	branch <- getCurrentBranch+	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]+		, boolSystem "ssh" [Param ("root@"++host), Param $ unpackcmd branch] 		]   where 	remotebundle = "/usr/local/propellor.git"-	unpackcmd = shellWrap $ intercalate " && "+	unpackcmd branch = shellWrap $ intercalate " && " 		[ "git clone " ++ remotebundle ++ " " ++ localdir 		, "cd " ++ localdir-		, "git checkout -b master"+		, "git checkout -b " ++ branch 		, "git remote rm origin"-		, "git remote add origin " ++ url 		, "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
Propellor/Message.hs view
@@ -15,27 +15,31 @@  	r <- a +	setTitle "propellor: running" 	let (msg, intensity, color) = getActionResult r 	putStr $ desc ++ " ... "-	setSGR [SetColor Foreground intensity color]-	putStrLn msg-	setSGR []-	setTitle "propellor: running"+	colorLine intensity color msg 	hFlush stdout  	return r  warningMessage :: String -> IO ()-warningMessage s = do-	setSGR [SetColor Foreground Vivid Red]-	putStrLn $ "** warning: " ++ s+warningMessage s = 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 "Propellor failed!"+	error "Cannot continue!"  -- | Causes a debug message to be displayed when PROPELLOR_DEBUG=1 debug :: [String] -> IO ()
Propellor/Property/Apt.hs view
@@ -46,12 +46,11 @@ kernelOrg :: DebianSuite -> [Line] kernelOrg = binandsrc "http://mirrors.kernel.org/debian" -{- | 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.- -}+-- | 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) 	`describe` ("standard sources.list for " ++ show suite)@@ -113,7 +112,7 @@ 			noninteractiveEnv  -- | Package installation may fail becuse the archive has changed.--- Run an update in that case and retry. -}+-- Run an update in that case and retry. robustly :: Property -> Property robustly p = Property (propertyDesc p) $ do 	r <- ensureProperty p
Propellor/Property/Cmd.hs view
@@ -41,7 +41,7 @@ 	shellcmd = intercalate " ; " ("set -e" : script)  -- | A property that can satisfied by running a series of shell commands,--- as user (staring in their home directory).+-- as user (cd'd to their home directory). userScriptProperty :: UserName -> [String] -> Property userScriptProperty user script = cmdProperty "su" ["-c", shellcmd, user]   where
Propellor/Property/Docker.hs view
@@ -4,13 +4,6 @@ -- -- The existance of a docker container is just another Property of a system, -- which propellor can set up. See config.hs for an example.------ Note that propellor provisions a container by running itself, inside the--- container. Currently, to avoid the overhead of building propellor--- inside the container, the binary from outside is reused inside. --- So, the libraries that propellor is linked against need to be available--- in the container with compatable versions. This can cause a problem--- if eg, mixing Debian stable and unstable.  module Propellor.Property.Docker where @@ -18,6 +11,7 @@ import Propellor.SimpleSh 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 @@ -256,15 +250,14 @@ 		, name (fromContainerId cid) 		] 	-	chaincmd = [localdir </> "propellor", "--docker", 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) 		ensureProperty $ boolProperty "run" $ runContainer img 			(runps ++ ["-i", "-d", "-t"])-			chaincmd+			[shim, "--docker", fromContainerId cid]  -- | Called when propellor is running inside a docker container. -- The string should be the container's ContainerId.@@ -290,8 +283,9 @@ 		writeFile propellorIdent . show =<< readIdentFile cid 		-- Run boot provisioning before starting simpleSh, 		-- to avoid ever provisioning twice at the same time.-		whenM (checkProvisionedFlag cid) $-			unlessM (boolSystem "./propellor" [Param "--continue", Param $ show $ Chain $ fromContainerId cid]) $+		whenM (checkProvisionedFlag cid) $ do+			let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)+			unlessM (boolSystem shim [Param "--continue", Param $ show $ Chain $ fromContainerId cid]) $ 				warningMessage "Boot provision failed!" 		void $ async $ simpleSh $ namedPipe cid 		forever $ do@@ -310,7 +304,8 @@ -- 1 minute. provisionContainer :: ContainerId -> Property provisionContainer cid = containerDesc cid $ Property "provision" $ do-	r <- simpleShClientRetry 60 (namedPipe cid) "./propellor" params (go Nothing)+	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@@ -342,11 +337,17 @@ stoppedContainer :: ContainerId -> Property stoppedContainer cid = containerDesc cid $ Property desc $  	ifM (elem cid <$> listContainers RunningContainers)-		( ensureProperty $ boolProperty desc $ stopContainer cid+		( 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 $@@ -396,10 +397,10 @@  -- | Named pipe used for communication with the container. namedPipe :: ContainerId -> FilePath-namedPipe cid = "docker/" ++ fromContainerId cid+namedPipe cid = "docker" </> fromContainerId cid  provisionedFlag :: ContainerId -> FilePath-provisionedFlag cid = "docker/" ++ fromContainerId cid ++ ".provisioned"+provisionedFlag cid = "docker" </> fromContainerId cid ++ ".provisioned"  clearProvisionedFlag :: ContainerId -> IO () clearProvisionedFlag = nukeFile . provisionedFlag@@ -412,8 +413,11 @@ 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"+identFile cid = "docker" </> fromContainerId cid ++ ".ident"  readIdentFile :: ContainerId -> IO ContainerIdent readIdentFile cid = fromMaybe (error "bad ident in identFile")
+ Propellor/Property/Docker/Shim.hs view
@@ -0,0 +1,58 @@+-- | 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, 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++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
Propellor/Property/File.hs view
@@ -2,6 +2,8 @@  import Propellor +import System.Posix.Files+ type Line = String  -- | Replaces all the content of a file.@@ -19,7 +21,7 @@  -- | 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. -}+-- file will be written. lacksLine :: FilePath -> Line -> Property f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f @@ -32,12 +34,18 @@ fileProperty desc a f = Property desc $ go =<< doesFileExist f   where 	go True = do-		ls <- lines <$> catchDefaultIO [] (readFile f)+		ls <- lines <$> readFile f 		let ls' = a ls 		if ls' == ls 			then noChange-			else makeChange $ viaTmp writeFile f (unlines ls')+			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
Propellor/Property/Hostname.hs view
@@ -3,7 +3,29 @@ import Propellor import qualified Propellor.Property.File as File +-- | Sets the hostname. Configures both /etc/hostname and the current+-- hostname.+--+-- When provided with 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 = "/etc/hostname" `File.hasContent` [hostname]-	`onChange` cmdProperty "hostname" [hostname]-	`describe` ("hostname " ++ hostname)+set hostname = combineProperties desc go+	`onChange` cmdProperty "hostname" [host]+  where+	desc = "hostname " ++ hostname+	(host, domain) = separate (== '.') hostname++	go = catMaybes+		[ Just $ "/etc/hostname" `File.hasContent` [host]+		, if null domain+			then Nothing +			else Just $ File.fileProperty desc+				addhostline "/etc/hosts"+		]+	+	hostip = "127.0.1.1"+	hostline = hostip ++ "\t" ++ hostname ++ " " ++ host++	addhostline ls = hostline : filter (not . hashostip) ls+	hashostip l = headMaybe (words l) == Just hostip
Propellor/Property/Network.hs view
@@ -23,5 +23,7 @@ 		, "# End automatically added by propeller" 		] -ifUp :: String -> Property+type Interface = String++ifUp :: Interface -> Property ifUp iface = cmdProperty "ifup" [iface]
Propellor/Property/Ssh.hs view
@@ -1,4 +1,11 @@-module Propellor.Property.Ssh where+module Propellor.Property.Ssh (+	setSshdConfig,+	permitRootLogin,+	passwordAuthentication,+	hasAuthorizedKeys,+	restartSshd,+	uniqueHostKeys+) where  import Propellor import qualified Propellor.Property.File as File@@ -38,8 +45,9 @@ restartSshd :: Property restartSshd = cmdProperty "service" ["ssh", "restart"] -{- | Blow away existing host keys and make new ones. Use a flag- - file to prevent doing this more than once. -}+-- | 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
Propellor/Property/Sudo.hs view
@@ -7,11 +7,8 @@ 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.- -- - TOOD: Full sudoers file format parse.. - -}+-- | 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@@ -26,6 +23,7 @@ 	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
README.md view
@@ -35,7 +35,7 @@      `apt-get install propellor` 2. Run propellor for the first time. It will set up a `~/.propellor/` git    repository for you.-3. In `~/.propellor/`, use git to push the repository to a central+3. `cd ~/.propellor/`; use git to push the repository to a central    server (github, or your own git server). Configure that central    server as the origin remote of the repository. 4. If you don't have a gpg private key, generate one: `gpg --gen-key`@@ -49,19 +49,19 @@    So, edit `~/.propellor/config.hs` to configure the host (maybe    start with a few simple properties), and re-run step 7.    Repeat until happy and move on to the next host. :)-9. To move beyond manually running propellor --spin against hosts-   when you change configuration, add a property to your hosts+9. To move beyond manually running `propellor --spin` against hosts+   when you change their properties, add a property to your hosts    like: `Cron.runPropellor "30 * * * *"`        Now they'll automatically update every 30 minutes, and you can    `git commit -S` and `git push` changes that affect any number of    hosts.-8. Write some neat new properties and send patches to <propellor@joeyh.name>!+10. Write some neat new properties and send patches to <propellor@joeyh.name>!  ## security  Propellor's security model is that the hosts it's used to deploy are-untrusted, and that the central git repository server is untrusted.+untrusted, and that the central git repository server is untrusted too.  The only trusted machine is the laptop where you run `propellor --spin` to connect to a remote host. And that one only because you have a ssh key@@ -71,13 +71,13 @@ repository, they have to use git:// or http:// to pull from the central git repository, rather than ssh://.  -So, to avoid a MITM attack, propellor checks that any commit it fetched+So, to avoid a MITM attack, propellor checks that any commit it fetches from origin is gpg signed by a trusted gpg key, and refuses to deploy it otherwise.  That is only done when privdata/keyring.gpg exists. To set it up: -	gpg --gen-key                 # only if you don't already have a gpg key+	gpg --gen-key             # only if you don't already have a gpg key 	propellor --add-key $MYKEYID  In order to be secure from the beginning, when `propellor --spin` is used@@ -88,9 +88,10 @@ Since the propoellor git repository is public, you can't store in cleartext private data such as passwords, ssh private keys, etc. -Instead, `propellor --spin $host` looks for a `~/.propellor/privdata/$host.gpg` file and-if found decrypts it and sends it to the remote host using ssh. This lets-a remote host know its own private data, without seeing all the rest.+Instead, `propellor --spin $host` looks for a+`~/.propellor/privdata/$host.gpg` file and if found decrypts it and sends+it to the remote host using ssh. This lets a remote host know its own+private data, without seeing all the rest.  To securely store private data, use: `propellor --set $host $field` The field name will be something like 'Password "root"'; see PrivData.hs
TODO view
@@ -12,3 +12,5 @@   says they are unchanged even when they changed and triggered a   reprovision. * Should properties be a tree rather than a list?+* Only make docker garbage collection run once a day or something+  to avoid GC after a temp fail.
+ Utility/LinuxMkLibs.hs view
@@ -0,0 +1,61 @@+{- Linux library copier and binary shimmer+ -+ - Copyright 2013 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Utility.LinuxMkLibs where++import Control.Applicative+import Data.Maybe+import System.Directory+import Data.List.Utils+import System.Posix.Files+import Data.Char+import Control.Monad.IfElse++import Utility.PartialPrelude+import Utility.Directory+import Utility.Process+import Utility.Monad+import Utility.Path++{- Installs a library. If the library is a symlink to another file,+ - install the file it links to, and update the symlink to be relative. -}+installLib :: (FilePath -> FilePath -> IO ()) -> FilePath -> FilePath -> IO (Maybe FilePath)+installLib installfile top lib = ifM (doesFileExist lib)+	( do+		installfile top lib+		checksymlink lib+		return $ Just $ parentDir lib+	, return Nothing+	)+  where+	checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do+		l <- readSymbolicLink (inTop top f)+		let absl = absPathFrom (parentDir f) l+		let target = relPathDirToFile (parentDir f) absl+		installfile top absl+		nukeFile (top ++ f)+		createSymbolicLink target (inTop top f)+		checksymlink absl++-- Note that f is not relative, so cannot use </>+inTop :: FilePath -> FilePath -> FilePath+inTop top f = top ++ f++{- Parse ldd output, getting all the libraries that the input files+ - link to. Note that some of the libraries may not exist + - (eg, linux-vdso.so) -}+parseLdd :: String -> [FilePath]+parseLdd = catMaybes . map (getlib . dropWhile isSpace) . lines+  where+	getlib l = headMaybe . words =<< lastMaybe (split " => " l)++{- Get all glibc libs and other support files, including gconv files+ -+ - XXX Debian specific. -}+glibcLibs :: IO [FilePath]+glibcLibs = lines <$> readProcess "sh"+	["-c", "dpkg -L libc6:$(dpkg --print-architecture) libgcc1:$(dpkg --print-architecture) | egrep '\\.so|gconv'"]
+ config-joey.hs view
@@ -0,0 +1,124 @@+-- |  This is the live config file used by propellor's author.++import Propellor+import Propellor.CmdLine+import qualified Propellor.Property.File as File+import qualified Propellor.Property.Apt as Apt+import qualified Propellor.Property.Network as Network+import qualified Propellor.Property.Ssh as Ssh+import qualified Propellor.Property.Cron as Cron+import qualified Propellor.Property.Sudo as Sudo+import qualified Propellor.Property.User as User+import qualified Propellor.Property.Hostname as Hostname+--import qualified Propellor.Property.Reboot as Reboot+import qualified Propellor.Property.Tor as Tor+import qualified Propellor.Property.Docker as Docker+import qualified Propellor.Property.SiteSpecific.GitHome as GitHome+import qualified Propellor.Property.SiteSpecific.GitAnnexBuilder as GitAnnexBuilder+import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites+import Data.List++main :: IO ()+main = defaultMain [host, Docker.containerProperties container]++-- | This is where the system's HostName, either as returned by uname+-- or one specified on the command line, is converted into a list of+-- Properties for that system.+--+-- Edit this to configure propellor!+host :: HostName -> Maybe [Property]+-- Clam is a tor bridge, and an olduse.net shellbox and other fun stuff.+host hostname@"clam.kitenet.net" = standardSystem Unstable $ props+	& cleanCloudAtCost hostname+	& Apt.unattendedUpgrades+	& Network.ipv6to4+	& Apt.installed ["git-annex", "mtr"]+	& Tor.isBridge+	& JoeySites.oldUseNetshellBox+	& Docker.configured+	! Docker.docked container hostname "amd64-git-annex-builder"+	& Docker.garbageCollected+-- Orca is the main git-annex build box.+host hostname@"orca.kitenet.net" = standardSystem Unstable $ props+	& Hostname.set hostname+	& Apt.unattendedUpgrades+	& Docker.configured+	& Apt.buildDep ["git-annex"]+	& Docker.docked container hostname "amd64-git-annex-builder"+	& Docker.docked container hostname "i386-git-annex-builder"+	& Docker.garbageCollected+-- My laptop+host _hostname@"darkstar.kitenet.net" = Just $ props+	& Docker.configured+	+-- add more hosts here...+--host "foo.example.com" =+host _ = Nothing++-- | This is where Docker containers are set up. A container+-- can vary by hostname where it's used, or be the same everywhere.+container :: HostName -> Docker.ContainerName -> Maybe (Docker.Container)+container _host name+	| name == "webserver" = Just $ Docker.containerFrom+		(image $ System (Debian Unstable) "amd64")+		[ Docker.publish "8080:80"+		, Docker.volume "/var/www:/var/www"+		, Docker.inside $ props+			& serviceRunning "apache2"+				`requires` Apt.installed ["apache2"]+		]+	| "-git-annex-builder" `isSuffixOf` name =+		let arch = takeWhile (/= '-') name+		in Just $ Docker.containerFrom+			(image $ System (Debian Unstable) arch)+			[ Docker.inside $ props & GitAnnexBuilder.builder arch "15 * * * *" True ]+	| otherwise = Nothing++-- | Docker images I prefer to use.+image :: System -> Docker.Image+image (System (Debian Unstable) arch) = "joeyh/debian-unstable-" ++ arch+image _ = "debian-stable-official" -- does not currently exist!++-- This is my standard system setup+standardSystem :: DebianSuite -> [Property] -> Maybe [Property]+standardSystem suite customprops = Just $+	standardprops : customprops ++ endprops+  where+	standardprops = propertyList "standard system" $ props+		& Apt.stdSourcesList suite `onChange` Apt.upgrade+		& Apt.installed ["etckeeper"]+		& Apt.installed ["ssh"]+		& GitHome.installedFor "root"+		& User.hasSomePassword "root"+		-- Harden the system, but only once root's authorized_keys+		-- is safely in place.+		& check (Ssh.hasAuthorizedKeys "root")+			(Ssh.passwordAuthentication False)+		& User.accountFor "joey"+		& User.hasSomePassword "joey"+		& Sudo.enabledFor "joey"+		& GitHome.installedFor "joey"+		& Apt.installed ["vim", "screen", "less"]+		& Cron.runPropellor "30 * * * *"+		-- I use postfix, or no MTA.+		& Apt.removed ["exim4", "exim4-daemon-light", "exim4-config", "exim4-base"]+			`onChange` Apt.autoRemove+	-- May reboot, so comes last+	-- Currently not enable due to #726375 +	endprops = [] -- [Apt.installed ["systemd-sysv"] `onChange` Reboot.now]++-- Clean up a system as installed by cloudatcost.com+cleanCloudAtCost :: HostName -> Property+cleanCloudAtCost hostname = propertyList "cloudatcost cleanup"+	[ Hostname.set hostname+	, Ssh.uniqueHostKeys+	, "worked around grub/lvm boot bug #743126" ==>+		"/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true"+		`onChange` cmdProperty "update-grub" []+		`onChange` cmdProperty "update-initramfs" ["-u"]+	, combineProperties "nuked cloudatcost cruft"+		[ File.notPresent "/etc/rc.local"+		, File.notPresent "/etc/init.d/S97-setup.sh"+		, User.nuked "user" User.YesReallyDeleteHome+		]+	]
+ config-simple.hs view
@@ -0,0 +1,53 @@+-- | This is the main configuration file for Propellor, and is used to build+-- the propellor program.++import Propellor+import Propellor.CmdLine+import qualified Propellor.Property.File as File+import qualified Propellor.Property.Apt as Apt+import qualified Propellor.Property.Network as Network+--import qualified Propellor.Property.Ssh as Ssh+import qualified Propellor.Property.Cron as Cron+--import qualified Propellor.Property.Sudo as Sudo+import qualified Propellor.Property.User as User+--import qualified Propellor.Property.Hostname as Hostname+--import qualified Propellor.Property.Reboot as Reboot+--import qualified Propellor.Property.Tor as Tor+import qualified Propellor.Property.Docker as Docker++main :: IO ()+main = defaultMain [host, Docker.containerProperties container]++-- | This is where the system's HostName, either as returned by uname+-- or one specified on the command line, is converted into a list of+-- Properties for that system.+--+-- Edit this to configure propellor!+host :: HostName -> Maybe [Property]+host hostname@"mybox.example.com" = Just $ props+	& Apt.stdSourcesList Unstable+		`onChange` Apt.upgrade+	& Apt.unattendedUpgrades+	& Apt.installed ["etckeeper"]+	& Apt.installed ["ssh"]+	& User.hasSomePassword "root"+	& Network.ipv6to4+	& File.dirExists "/var/www"+	& Docker.docked container hostname "webserver"+	& Docker.garbageCollected+	& Cron.runPropellor "30 * * * *"+-- add more hosts here...+--host "foo.example.com" =+host _ = Nothing++-- | This is where Docker containers are set up. A container+-- can vary by hostname where it's used, or be the same everywhere.+container :: HostName -> Docker.ContainerName -> Maybe (Docker.Container)+container _ "webserver" = Just $ Docker.containerFrom "joeyh/debian-unstable"+	[ Docker.publish "80:80"+	, Docker.volume "/var/www:/var/www"+	, Docker.inside $ props+		& serviceRunning "apache2"+			`requires` Apt.installed ["apache2"]+	]+container _ _ = Nothing
config.hs view
@@ -1,26 +1,19 @@ -- | This is the main configuration file for Propellor, and is used to build -- the propellor program.------ This is the live config file used by propellor's author.--- For a simpler starting point, see simple-config.hs  import Propellor import Propellor.CmdLine import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Network as Network-import qualified Propellor.Property.Ssh as Ssh+--import qualified Propellor.Property.Ssh as Ssh import qualified Propellor.Property.Cron as Cron-import qualified Propellor.Property.Sudo as Sudo+--import qualified Propellor.Property.Sudo as Sudo import qualified Propellor.Property.User as User-import qualified Propellor.Property.Hostname as Hostname-import qualified Propellor.Property.Reboot as Reboot-import qualified Propellor.Property.Tor as Tor+--import qualified Propellor.Property.Hostname as Hostname+--import qualified Propellor.Property.Reboot as Reboot+--import qualified Propellor.Property.Tor as Tor import qualified Propellor.Property.Docker as Docker-import qualified Propellor.Property.SiteSpecific.GitHome as GitHome-import qualified Propellor.Property.SiteSpecific.GitAnnexBuilder as GitAnnexBuilder-import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites-import Data.List  main :: IO () main = defaultMain [host, Docker.containerProperties container]@@ -31,32 +24,18 @@ -- -- Edit this to configure propellor! host :: HostName -> Maybe [Property]-host hostname@"clam.kitenet.net" = Just $ props-	& cleanCloudAtCost hostname-	& standardSystem Unstable+host hostname@"mybox.example.com" = Just $ props+	& Apt.stdSourcesList Unstable+		`onChange` Apt.upgrade 	& Apt.unattendedUpgrades+	& Apt.installed ["etckeeper"]+	& Apt.installed ["ssh"]+	& User.hasSomePassword "root" 	& Network.ipv6to4-	& Apt.installed ["git-annex", "mtr"]-	-- Clam is a tor bridge, and an olduse.net shellbox and other-	-- fun stuff.-	& Tor.isBridge-	& JoeySites.oldUseNetshellBox-	& Docker.configured 	& File.dirExists "/var/www"-	! Docker.docked container hostname "webserver"-	! Docker.docked container hostname "amd64-git-annex-builder"-	& Docker.garbageCollected-	-- Should come last as it reboots.-	& Apt.installed ["systemd-sysv"] `onChange` Reboot.now-host hostname@"orca.kitenet.net" = Just $ props-	& Hostname.set hostname-	& standardSystem Unstable-	& Apt.unattendedUpgrades-	& Docker.configured-	& Apt.buildDep ["git-annex"]-	& Docker.docked container hostname "amd64-git-annex-builder"-	! Docker.docked container hostname "i386-git-annex-builder"+	& Docker.docked container hostname "webserver" 	& Docker.garbageCollected+	& Cron.runPropellor "30 * * * *" -- add more hosts here... --host "foo.example.com" = host _ = Nothing@@ -64,64 +43,11 @@ -- | This is where Docker containers are set up. A container -- can vary by hostname where it's used, or be the same everywhere. container :: HostName -> Docker.ContainerName -> Maybe (Docker.Container)-container _host name-	| name == "webserver" = Just $ Docker.containerFrom-		(image $ System (Debian Unstable) "amd64")-		[ Docker.publish "8080:80"-		, Docker.volume "/var/www:/var/www"-		, Docker.inside $ props-			& serviceRunning "apache2"-				`requires` Apt.installed ["apache2"]-		]-	| "-git-annex-builder" `isSuffixOf` name =-		let arch = takeWhile (/= '-') name-		in Just $ Docker.containerFrom-			(image $ System (Debian Unstable) arch)-			[ Docker.inside $ props & GitAnnexBuilder.builder arch "15 * * * *" True ]-	| otherwise = Nothing---- | Docker images I prefer to use.--- Edit as suites you, or delete this function and just put the image names--- above.-image :: System -> Docker.Image-image (System (Debian Unstable) "amd64") = "joeyh/debian-unstable"-image (System (Debian Unstable) "i386") = "joeyh/debian-unstable-i386"-image _ = "debian"---- This is my standard system setup-standardSystem :: DebianSuite -> Property-standardSystem suite = propertyList "standard system"-	[ Apt.stdSourcesList suite `onChange` Apt.upgrade-	, Apt.installed ["etckeeper"]-	, Apt.installed ["ssh"]-	, GitHome.installedFor "root"-	, User.hasSomePassword "root"-	-- Harden the system, but only once root's authorized_keys-	-- is safely in place.-	, check (Ssh.hasAuthorizedKeys "root") $-		Ssh.passwordAuthentication False-	, User.accountFor "joey"-	, User.hasSomePassword "joey"-	, Sudo.enabledFor "joey"-	, GitHome.installedFor "joey"-	, Apt.installed ["vim", "screen", "less"]-	, Cron.runPropellor "30 * * * *"-	-- I use postfix, or no MTA.-	, Apt.removed ["exim4"] `onChange` Apt.autoRemove-	]---- Clean up a system as installed by cloudatcost.com-cleanCloudAtCost :: HostName -> Property-cleanCloudAtCost hostname = propertyList "cloudatcost cleanup"-	[ Hostname.set hostname-	, Ssh.uniqueHostKeys-	, "worked around grub/lvm boot bug #743126" ==>-		"/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true"-		`onChange` cmdProperty "update-grub" []-		`onChange` cmdProperty "update-initramfs" ["-u"]-	, combineProperties "nuked cloudatcost cruft"-		[ File.notPresent "/etc/rc.local"-		, File.notPresent "/etc/init.d/S97-setup.sh"-		, User.nuked "user" User.YesReallyDeleteHome-		]+container _ "webserver" = Just $ Docker.containerFrom "joeyh/debian-unstable"+	[ Docker.publish "80:80"+	, Docker.volume "/var/www:/var/www"+	, Docker.inside $ props+		& serviceRunning "apache2"+			`requires` Apt.installed ["apache2"] 	]+container _ _ = Nothing
debian/changelog view
@@ -1,3 +1,12 @@+propellor (0.2.2) unstable; urgency=medium++  * Now supports provisioning docker containers with architecture/libraries+    that do not match the host.+  * Fixed a bug that caused file modes to be set to 600 when propellor+    modified the file (did not affect newly created files).++ -- Joey Hess <joeyh@debian.org>  Fri, 04 Apr 2014 01:07:32 -0400+ propellor (0.2.1) unstable; urgency=medium    * First release with Debian package.
propellor.cabal view
@@ -1,5 +1,5 @@ Name: propellor-Version: 0.2.1+Version: 0.2.2 Cabal-Version: >= 1.6 License: GPL Maintainer: Joey Hess <joey@kitenet.net>@@ -14,8 +14,9 @@   README.md   TODO   CHANGELOG-  simple-config.hs   Makefile+  config-simple.hs+  config-joey.hs   debian/changelog   debian/README.Debian   debian/propellor.1@@ -79,13 +80,14 @@     Propellor.Property.SiteSpecific.GitHome     Propellor.Property.SiteSpecific.JoeySites     Propellor.Property.SiteSpecific.GitAnnexBuilder-    Propellor.CmdLine     Propellor.Message     Propellor.PrivData     Propellor.Engine-    Propellor.SimpleSh     Propellor.Types   Other-Modules:+    Propellor.CmdLine+    Propellor.SimpleSh+    Propellor.Property.Docker.Shim     Utility.Applicative     Utility.Data     Utility.Directory@@ -93,6 +95,7 @@     Utility.Exception     Utility.FileMode     Utility.FileSystemEncoding+    Utility.LinuxMkLibs     Utility.Misc     Utility.Monad     Utility.Path
− simple-config.hs
@@ -1,52 +0,0 @@--- | This is the main configuration file for Propellor, and is used to build--- the propellor program.--import Propellor-import Propellor.CmdLine-import qualified Propellor.Property.File as File-import qualified Propellor.Property.Apt as Apt-import qualified Propellor.Property.Network as Network-import qualified Propellor.Property.Ssh as Ssh-import qualified Propellor.Property.Cron as Cron-import qualified Propellor.Property.Sudo as Sudo-import qualified Propellor.Property.User as User-import qualified Propellor.Property.Hostname as Hostname-import qualified Propellor.Property.Reboot as Reboot-import qualified Propellor.Property.Docker as Docker--main :: IO ()-main = defaultMain [host, Docker.containerProperties container]---- | This is where the system's HostName, either as returned by uname--- or one specified on the command line, is converted into a list of--- Properties for that system.------ Edit this to configure propellor!-host :: HostName -> Maybe [Property]-host hostname@"mybox.example.com" = Just $ props-	& Apt.stdSourcesList Unstable-		`onChange` Apt.upgrade-	& Apt.unattendedUpgrades-	& Apt.installed ["etckeeper"]-	& Apt.installed ["ssh"]-	& User.hasSomePassword "root"-	& Network.ipv6to4-	& File.dirExists "/var/www"-	& Docker.docked container hostname "webserver"-	& Docker.garbageCollected-	& Cron.runPropellor "30 * * * *"--- add more hosts here...---host "foo.example.com" =-host _ = Nothing---- | This is where Docker containers are set up. A container--- can vary by hostname where it's used, or be the same everywhere.-container :: HostName -> Docker.ContainerName -> Maybe (Docker.Container)-container _ "webserver" = Just $ Docker.containerFrom "joeyh/debian-unstable"-	[ Docker.publish "80:80"-	, Docker.volume "/var/www:/var/www"-	, Docker.inside $ props-		& serviceRunning "apache2"-			`requires` Apt.installed ["apache2"]-	]-container _ _ = Nothing