propellor 0.6.0 → 0.7.0

raw patch · 22 files changed

+297/−248 lines, 22 filesnew-component:exe:propellornew-component:exe:propellor-configPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +12/−0
• Makefile +3/−3
• config-joey.hs +24/−10
• debian/changelog +12/−0
• propellor.cabal +5/−5
• src/Propellor.hs +2/−2
• src/Propellor/Attr.hs +0/−83
• src/Propellor/CmdLine.hs +4/−3
• src/Propellor/Engine.hs +1/−1
• src/Propellor/Info.hs +83/−0
• src/Propellor/Property.hs +12/−11
• src/Propellor/Property/Apt.hs +1/−1
• src/Propellor/Property/Dns.hs +13/−13
• src/Propellor/Property/Docker.hs +16/−16
• src/Propellor/Property/Hostname.hs +1/−1
• src/Propellor/Property/Obnam.hs +3/−3
• src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +13/−15
• src/Propellor/Property/SiteSpecific/JoeySites.hs +11/−0
• src/Propellor/Types.hs +15/−15
• src/Propellor/Types/Attr.hs +0/−65
• src/Propellor/Types/Info.hs +65/−0
• src/wrapper.hs +1/−1

@@ -1,3 +1,15 @@+propellor (0.7.0) unstable; urgency=medium++  * combineProperties no longer stops when a property fails; now it continues+    trying to satisfy all properties on the list before propigating the+    failure.+  * Attr is renamed to Info.+  * Renamed wrapper to propellor to make cabal installation of propellor work.+  * When git gpg signature of a fetched git branch cannot be verified,+    propellor will now continue running, but without merging in that branch.++ -- Joey Hess <joeyh@debian.org>  Fri, 13 Jun 2014 10:06:40 -0400+ propellor (0.6.0) unstable; urgency=medium    * Docker containers now propagate DNS attributes out to the host they're

@@ -7,7 +7,7 @@  build: dist/setup-config 	if ! $(CABAL) build; then $(CABAL) configure; $(CABAL) build; fi-	ln -sf dist/build/config/config propellor+	ln -sf dist/build/propellor-config/propellor-config propellor  deps: 	@if [ $$(whoami) = root ]; then apt-get --no-upgrade --no-install-recommends -y install gnupg ghc cabal-install libghc-missingh-dev libghc-ansi-terminal-dev libghc-ifelse-dev libghc-unix-compat-dev libghc-hslogger-dev libghc-network-dev libghc-quickcheck2-dev libghc-mtl-dev libghc-monadcatchio-transformers-dev; fi || true@@ -19,13 +19,13 @@  install: 	install -d $(DESTDIR)/usr/bin $(DESTDIR)/usr/src/propellor-	install -s dist/build/wrapper/wrapper $(DESTDIR)/usr/bin/propellor+	install -s dist/build/propellor/propellor $(DESTDIR)/usr/bin/propellor 	$(CABAL) sdist 	cat dist/propellor-*.tar.gz | \ 		(cd $(DESTDIR)/usr/src/propellor && tar zx --strip-components=1)  clean:-	rm -rf dist Setup tags propellor propellor-wrapper privdata/local+	rm -rf dist Setup tags propellor privdata/local 	find -name \*.o -exec rm {} \; 	find -name \*.hi -exec rm {} \; 

@@ -170,16 +170,38 @@ 		& Hostname.sane 		& Postfix.satellite 		& Apt.unattendedUpgrades+		& Ssh.hostKey SshDsa+		& Ssh.hostKey SshRsa+		& Ssh.hostKey SshEcdsa+		& Ssh.keyImported SshRsa "joey" +		-- PV-grub chaining+		-- http://notes.pault.ag/linode-pv-grub-chainning/+		-- (Adapted to use xvda1/hd0,0 instead of xvda/hd0)+		& "/boot/grub/menu.lst" `File.hasContent`+			[ "default 1" +			, "timeout 30"+			, ""+			, "title grub-xen shim"+			, "root (hd0,0)"+			, "kernel /boot/xen-shim"+			, "boot"+			]+		& "/boot/load.cf" `File.hasContent`+			[ "configfile (xen/xvda1)/boot/grub/grub.cfg" ]+		& Apt.installed ["grub-xen"]+		& flagFile (scriptProperty ["update-grub; grub-mkimage --prefix '(xen/xvda1)/boot/grub' -c /boot/load.cf -O x86_64-xen /usr/lib/grub/x86_64-xen/*.mod > /boot/xen-shim"]) "/boot/xen-shim"+ 		& alias "eubackup.kitenet.net" 		& Apt.installed ["obnam", "sshfs", "rsync"] 		& JoeySites.githubBackup+		& JoeySites.obnamRepos ["wren", "pell"]+		& Ssh.knownHost hosts "usw-s002.rsync.net" "joey"  		& alias "podcatcher.kitenet.net" 		& Apt.installed ["git-annex"] 		 		& Docker.configured-		! Docker.docked hosts "voltagex" 		& Docker.garbageCollected `period` (Weekly (Just 1))  	    --'                        __|II|      ,.@@ -231,15 +253,6 @@ 		& Docker.volume ("/home/joey/src/git-annex:" ++ gitannexdir)  	-- temp for an acquantance-	, standardContainer "voltagex" Stable "amd64"-		& Docker.publish "22022:22"-		& Docker.memory "500m"-		& Docker.cpuShares 1-		& Apt.serviceInstalledRunning "ssh"-		& Ssh.permitRootLogin True-		& Ssh.passwordAuthentication True-		& User.hasSomePassword "root"- 	] ++ monsters  -- This is my standard system setup.@@ -280,6 +293,7 @@ -- Docker images I prefer to use. dockerImage :: System -> Docker.Image dockerImage (System (Debian Unstable) arch) = "joeyh/debian-unstable-" ++ arch+dockerImage (System (Debian Testing) arch) = "joeyh/debian-unstable-" ++ arch dockerImage (System (Debian Stable) arch) = "joeyh/debian-stable-" ++ arch dockerImage _ = "debian-stable-official" -- does not currently exist! 

@@ -1,3 +1,15 @@+propellor (0.7.0) unstable; urgency=medium++  * combineProperties no longer stops when a property fails; now it continues+    trying to satisfy all properties on the list before propigating the+    failure.+  * Attr is renamed to Info.+  * Renamed wrapper to propellor to make cabal installation of propellor work.+  * When git gpg signature of a fetched git branch cannot be verified,+    propellor will now continue running, but without merging in that branch.++ -- Joey Hess <joeyh@debian.org>  Fri, 13 Jun 2014 10:06:40 -0400+ propellor (0.6.0) unstable; urgency=medium    * Docker containers now propagate DNS attributes out to the host they're

@@ -1,5 +1,5 @@ Name: propellor-Version: 0.6.0+Version: 0.7.0 Cabal-Version: >= 1.6 License: BSD3 Maintainer: Joey Hess <joey@kitenet.net>@@ -33,7 +33,7 @@  .  It is configured using haskell. -Executable wrapper+Executable propellor   Main-Is: wrapper.hs   GHC-Options: -Wall -threaded -O0   Hs-Source-Dirs:  src@@ -45,7 +45,7 @@   if (! os(windows))     Build-Depends: unix -Executable config+Executable propellor-config   Main-Is: config.hs   GHC-Options: -Wall -threaded -O0   Hs-Source-Dirs:  src@@ -97,7 +97,7 @@     Propellor.Property.SiteSpecific.GitHome     Propellor.Property.SiteSpecific.JoeySites     Propellor.Property.SiteSpecific.GitAnnexBuilder-    Propellor.Attr+    Propellor.Info     Propellor.Message     Propellor.PrivData     Propellor.Engine@@ -106,7 +106,7 @@     Propellor.Types.OS     Propellor.Types.Dns   Other-Modules:-    Propellor.Types.Attr+    Propellor.Types.Info     Propellor.CmdLine     Propellor.SimpleSh     Propellor.Property.Docker.Shim

@@ -33,7 +33,7 @@ 	  module Propellor.Types 	, module Propellor.Property 	, module Propellor.Property.Cmd-	, module Propellor.Attr+	, module Propellor.Info 	, module Propellor.PrivData 	, module Propellor.Engine 	, module Propellor.Exception@@ -50,7 +50,7 @@ import Propellor.PrivData import Propellor.Message import Propellor.Exception-import Propellor.Attr+import Propellor.Info  import Utility.PartialPrelude as X import Utility.Process as X

@@ -1,83 +0,0 @@-{-# 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-import Data.Maybe-import Data.Monoid-import Control.Applicative--pureAttrProperty :: Desc -> Attr -> Property -pureAttrProperty desc = Property ("has " ++ desc) (return NoChange)--askAttr :: (Attr -> Val a) -> Propellor (Maybe a)-askAttr f = asks (fromVal . f . hostAttr)--os :: System -> Property-os system = pureAttrProperty ("Operating " ++ show system) $-	mempty { _os = Val system }--getOS :: Propellor (Maybe System)-getOS = askAttr _os---- | Indidate that a host has an A record in the DNS.------ TODO check at run time if the host really has this address.--- (Can't change the host's address, but as a sanity check.)-ipv4 :: String -> Property-ipv4 = addDNS . Address . IPv4---- | Indidate that a host has an AAAA record in the DNS.-ipv6 :: String -> Property-ipv6 = addDNS . Address . IPv6---- | Indicates another name for the host in the DNS.------ When the host's ipv4/ipv6 addresses are known, the alias is set up--- to use their address, rather than using a CNAME. This avoids various--- problems with CNAMEs, and also means that when multiple hosts have the--- same alias, a DNS round-robin is automatically set up.-alias :: Domain -> Property-alias = addDNS . CNAME . AbsDomain--addDNS :: Record -> Property-addDNS r = pureAttrProperty (rdesc r) $-	mempty { _dns = S.singleton r }-  where-	rdesc (CNAME d) = unwords ["alias", ddesc d]-	rdesc (Address (IPv4 addr)) = unwords ["ipv4", addr]-	rdesc (Address (IPv6 addr)) = unwords ["ipv6", addr]-	rdesc (MX n d) = unwords ["MX", show n, ddesc d]-	rdesc (NS d) = unwords ["NS", ddesc d]-	rdesc (TXT s) = unwords ["TXT", s]-	rdesc (SRV x y z d) = unwords ["SRV", show x, show y, show z, ddesc d]--	ddesc (AbsDomain domain) = domain-	ddesc (RelDomain domain) = domain-	ddesc RootDomain = "@"--sshPubKey :: String -> Property-sshPubKey k = pureAttrProperty ("ssh pubkey known") $-	mempty { _sshPubKey = Val k }--getSshPubKey :: Propellor (Maybe String)-getSshPubKey = askAttr _sshPubKey--hostMap :: [Host] -> M.Map HostName Host-hostMap l = M.fromList $ zip (map hostName l) l --findHost :: [Host] -> HostName -> Maybe Host-findHost l hn = M.lookup hn (hostMap l)--getAddresses :: Attr -> [IPAddr]-getAddresses = mapMaybe getIPAddr . S.toList . _dns--hostAddresses :: HostName -> [Host] -> [IPAddr]-hostAddresses hn hosts = case hostAttr <$> findHost hosts hn of-	Nothing -> []-	Just attr -> mapMaybe getIPAddr $ S.toList $ _dns attr

@@ -132,6 +132,8 @@  	void $ actionMessage "Git fetch" $ boolSystem "git" [Param "fetch"] 	+	oldsha <- getCurrentGitSha1 branchref+	 	whenM (doesFileExist keyring) $ do 		{- To verify origin branch commit's signature, have to 		 - convince gpg to use our keyring. While running git log.@@ -153,10 +155,9 @@ 			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!"+				void $ boolSystem "git" [Param "merge", Param originbranch]+			else warningMessage $ "git branch " ++ originbranch ++ " is not signed with a trusted gpg key; refusing to deploy it! (Running with previous configuration instead.)" 	-	oldsha <- getCurrentGitSha1 branchref-	void $ boolSystem "git" [Param "merge", Param originbranch] 	newsha <- getCurrentGitSha1 branchref  	if oldsha == newsha

@@ -12,7 +12,7 @@ import Propellor.Types import Propellor.Message import Propellor.Exception-import Propellor.Attr+import Propellor.Info  runPropellor :: Host -> Propellor a -> IO a runPropellor host a = runReaderT (runWithHost a) host

@@ -0,0 +1,83 @@+{-# LANGUAGE PackageImports #-}++module Propellor.Info where++import Propellor.Types+import Propellor.Types.Info++import "mtl" Control.Monad.Reader+import qualified Data.Set as S+import qualified Data.Map as M+import Data.Maybe+import Data.Monoid+import Control.Applicative++pureInfoProperty :: Desc -> Info -> Property +pureInfoProperty desc = Property ("has " ++ desc) (return NoChange)++askInfo :: (Info -> Val a) -> Propellor (Maybe a)+askInfo f = asks (fromVal . f . hostInfo)++os :: System -> Property+os system = pureInfoProperty ("Operating " ++ show system) $+	mempty { _os = Val system }++getOS :: Propellor (Maybe System)+getOS = askInfo _os++-- | Indidate that a host has an A record in the DNS.+--+-- TODO check at run time if the host really has this address.+-- (Can't change the host's address, but as a sanity check.)+ipv4 :: String -> Property+ipv4 = addDNS . Address . IPv4++-- | Indidate that a host has an AAAA record in the DNS.+ipv6 :: String -> Property+ipv6 = addDNS . Address . IPv6++-- | Indicates another name for the host in the DNS.+--+-- When the host's ipv4/ipv6 addresses are known, the alias is set up+-- to use their address, rather than using a CNAME. This avoids various+-- problems with CNAMEs, and also means that when multiple hosts have the+-- same alias, a DNS round-robin is automatically set up.+alias :: Domain -> Property+alias = addDNS . CNAME . AbsDomain++addDNS :: Record -> Property+addDNS r = pureInfoProperty (rdesc r) $+	mempty { _dns = S.singleton r }+  where+	rdesc (CNAME d) = unwords ["alias", ddesc d]+	rdesc (Address (IPv4 addr)) = unwords ["ipv4", addr]+	rdesc (Address (IPv6 addr)) = unwords ["ipv6", addr]+	rdesc (MX n d) = unwords ["MX", show n, ddesc d]+	rdesc (NS d) = unwords ["NS", ddesc d]+	rdesc (TXT s) = unwords ["TXT", s]+	rdesc (SRV x y z d) = unwords ["SRV", show x, show y, show z, ddesc d]++	ddesc (AbsDomain domain) = domain+	ddesc (RelDomain domain) = domain+	ddesc RootDomain = "@"++sshPubKey :: String -> Property+sshPubKey k = pureInfoProperty ("ssh pubkey known") $+	mempty { _sshPubKey = Val k }++getSshPubKey :: Propellor (Maybe String)+getSshPubKey = askInfo _sshPubKey++hostMap :: [Host] -> M.Map HostName Host+hostMap l = M.fromList $ zip (map hostName l) l ++findHost :: [Host] -> HostName -> Maybe Host+findHost l hn = M.lookup hn (hostMap l)++getAddresses :: Info -> [IPAddr]+getAddresses = mapMaybe getIPAddr . S.toList . _dns++hostAddresses :: HostName -> [Host] -> [IPAddr]+hostAddresses hn hosts = case hostInfo <$> findHost hosts hn of+	Nothing -> []+	Just info -> mapMaybe getIPAddr $ S.toList $ _dns info

@@ -9,7 +9,7 @@ import "mtl" Control.Monad.Reader  import Propellor.Types-import Propellor.Attr+import Propellor.Info import Propellor.Engine import Utility.Monad import System.FilePath@@ -23,12 +23,13 @@ -- 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) (combineAttrs ps)+propertyList desc ps = Property desc (ensureProperties ps) (combineInfos ps)  -- | Combines a list of properties, resulting in one property that--- ensures each in turn, stopping on failure.+-- ensures each in turn. Does not stop on failure; does propigate+-- overall success/failure. combineProperties :: Desc -> [Property] -> Property-combineProperties desc ps = Property desc (go ps NoChange) (combineAttrs ps)+combineProperties desc ps = Property desc (go ps NoChange) (combineInfos ps)   where   	go [] rs = return rs 	go (l:ls) rs = do@@ -67,7 +68,7 @@ --- | 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-p `onChange` hook = Property (propertyDesc p) satisfy (combineAttr p hook)+p `onChange` hook = Property (propertyDesc p) satisfy (combineInfo p hook)   where 	satisfy = do 		r <- ensureProperty p@@ -134,7 +135,7 @@ -- -- Can add Properties and RevertableProperties (&) :: IsProp p => Host -> p -> Host-(Host hn ps as) & p = Host hn (ps ++ [toProp p]) (as <> getAttr p)+(Host hn ps as) & p = Host hn (ps ++ [toProp p]) (as <> getInfo p)  infixl 1 & @@ -148,12 +149,12 @@ adjustProperty :: Property -> (Propellor Result -> Propellor Result) -> Property adjustProperty p f = p { propertySatisfy = f (propertySatisfy p) } --- Combines the Attr of two properties.-combineAttr :: (IsProp p, IsProp q) => p -> q -> Attr-combineAttr p q = getAttr p <> getAttr q+-- Combines the Info of two properties.+combineInfo :: (IsProp p, IsProp q) => p -> q -> Info+combineInfo p q = getInfo p <> getInfo q -combineAttrs :: IsProp p => [p] -> Attr-combineAttrs = mconcat . map getAttr+combineInfos :: IsProp p => [p] -> Info+combineInfos = mconcat . map getInfo  makeChange :: IO () -> Propellor Result makeChange a = liftIO a >> return MadeChange

@@ -265,5 +265,5 @@ -- | Cleans apt's cache of downloaded packages to avoid using up disk -- space. cacheCleaned :: Property-cacheCleaned = cmdProperty "apt-get" ["clean"]+cacheCleaned = trivial $ cmdProperty "apt-get" ["clean"] 	`describe` "apt cache cleaned" 

@@ -15,7 +15,7 @@ import Propellor import Propellor.Types.Dns import Propellor.Property.File-import Propellor.Types.Attr+import Propellor.Types.Info import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Service as Service import Utility.Applicative@@ -113,7 +113,7 @@ secondaryFor :: [HostName] -> [Host] -> Domain -> RevertableProperty secondaryFor masters hosts domain = RevertableProperty setup cleanup   where-	setup = pureAttrProperty desc (addNamedConf conf)+	setup = pureInfoProperty desc (addNamedConf conf) 		`requires` servingZones 	cleanup = namedConfWritten @@ -131,7 +131,7 @@ otherServers wantedtype hosts domain = 	M.keys $ M.filter wanted $ hostMap hosts   where-	wanted h = case M.lookup domain (fromNamedConfMap $ _namedconf $ hostAttr h) of+	wanted h = case M.lookup domain (fromNamedConfMap $ _namedconf $ hostInfo h) of 		Nothing -> False 		Just conf -> confDnsServerType conf == wantedtype 			&& confDomain conf == domain@@ -346,7 +346,7 @@ 	inzdomain = M.elems $ M.filterWithKey (\hn _ -> inDomain zdomain $ AbsDomain $ hn) m 	 	-- Each host with a hostname located in the zdomain-	-- should have 1 or more IPAddrs in its Attr.+	-- should have 1 or more IPAddrs in its Info. 	-- 	-- If a host lacks any IPAddr, it's probably a misconfiguration, 	-- so warn.@@ -355,9 +355,9 @@ 		| null l = [Left $ "no IP address defined for host " ++ hostName h] 		| otherwise = map Right l 	  where-		attr = hostAttr h+		info = hostInfo h 		l = zip (repeat $ AbsDomain $ hostName h)-			(map Address $ getAddresses attr)+			(map Address $ getAddresses info)  	-- Any host, whether its hostname is in the zdomain or not, 	-- may have cnames which are in the zdomain. The cname may even be@@ -373,10 +373,10 @@ 	-- So we can just use the IPAddrs. 	addcnames :: Host -> [Either WarningMessage (BindDomain, Record)] 	addcnames h = concatMap gen $ filter (inDomain zdomain) $-		mapMaybe getCNAME $ S.toList (_dns attr)+		mapMaybe getCNAME $ S.toList (_dns info) 	  where-		attr = hostAttr h-		gen c = case getAddresses attr of+		info = hostInfo h+		gen c = case getAddresses info of 			[] -> [ret (CNAME c)] 			l -> map (ret . Address) l 		  where@@ -386,9 +386,9 @@ 	hostrecords :: Host -> [Either WarningMessage (BindDomain, Record)] 	hostrecords h = map Right l 	  where-		attr = hostAttr h+		info = hostInfo h 		l = zip (repeat $ AbsDomain $ hostName h)-			(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (_dns attr))+			(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (_dns info))  	-- Simplifies the list of hosts. Remove duplicate entries. 	-- Also, filter out any CHAMES where the same domain has an@@ -417,10 +417,10 @@   where 	dotbase = '.':base -addNamedConf :: NamedConf -> Attr+addNamedConf :: NamedConf -> Info addNamedConf conf = mempty { _namedconf = NamedConfMap (M.singleton domain conf) }   where        domain = confDomain conf  getNamedConf :: Propellor (M.Map Domain NamedConf)-getNamedConf = asks $ fromNamedConfMap . _namedconf . hostAttr+getNamedConf = asks $ fromNamedConfMap . _namedconf . hostInfo

@@ -35,7 +35,7 @@  import Propellor import Propellor.SimpleSh-import Propellor.Types.Attr+import Propellor.Types.Info import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Docker.Shim as Shim@@ -72,9 +72,9 @@ -- >    & Apt.installed {"apache2"] -- >    & ... container :: ContainerName -> Image -> Host-container cn image = Host hn [] attr+container cn image = Host hn [] info   where-	attr = dockerAttr $ mempty { _dockerImage = Val image }+	info = dockerInfo $ mempty { _dockerImage = Val image } 	hn = cn2hn cn  cn2hn :: ContainerName -> HostName@@ -86,8 +86,8 @@ -- The container has its own Properties which are handled by running -- propellor inside the container. ----- Additionally, the container can have DNS attributes, such as a CNAME.--- These become attributes of the host(s) it's docked in.+-- Additionally, the container can have DNS info, such as a CNAME.+-- These become info of the host(s) it's docked in. -- -- Reverting this property ensures that the container is stopped and -- removed.@@ -96,7 +96,7 @@ 	-> ContainerName 	-> RevertableProperty docked hosts cn = RevertableProperty-	((maybe id exposeDnsAttrs mhost) (go "docked" setup))+	((maybe id exposeDnsInfos mhost) (go "docked" setup)) 	(go "undocked" teardown)   where 	go desc a = property (desc ++ " " ++ cn) $ do@@ -123,9 +123,9 @@ 					] 			] -exposeDnsAttrs :: Host -> Property -> Property-exposeDnsAttrs (Host _ _ containerattr) p = combineProperties (propertyDesc p) $-	p : map addDNS (S.toList $ _dns containerattr)+exposeDnsInfos :: Host -> Property -> Property+exposeDnsInfos (Host _ _ containerinfo) p = combineProperties (propertyDesc p) $+	p : map addDNS (S.toList $ _dns containerinfo)  findContainer 	:: Maybe Host@@ -144,10 +144,10 @@  mkContainer :: ContainerId -> Host -> Maybe Container mkContainer cid@(ContainerId hn _cn) h = Container-	<$> fromVal (_dockerImage attr)-	<*> pure (map (\a -> a hn) (_dockerRunParams attr))+	<$> fromVal (_dockerImage info)+	<*> pure (map (\a -> a hn) (_dockerRunParams info))   where-	attr = _dockerattr $ hostAttr h'+	info = _dockerinfo $ hostInfo h'   	h' = h 		-- expose propellor directory inside the container 		& volume (localdir++":"++localdir)@@ -469,17 +469,17 @@ listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]  runProp :: String -> RunParam -> Property-runProp field val = pureAttrProperty (param) $ dockerAttr $+runProp field val = pureInfoProperty (param) $ dockerInfo $ 	mempty { _dockerRunParams = [\_ -> "--"++param] }   where 	param = field++"="++val  genProp :: String -> (HostName -> RunParam) -> Property-genProp field mkval = pureAttrProperty field $ dockerAttr $+genProp field mkval = pureInfoProperty field $ dockerInfo $ 	mempty { _dockerRunParams = [\hn -> "--"++field++"=" ++ mkval hn] } -dockerAttr :: DockerAttr -> Attr-dockerAttr a = mempty { _dockerattr = a }+dockerInfo :: DockerInfo -> Info+dockerInfo i = mempty { _dockerinfo = i }  -- | The ContainerIdent of a container is written to -- /.propellor-ident inside it. This can be checked to see if

@@ -3,7 +3,7 @@ import Propellor import qualified Propellor.Property.File as File --- | Ensures that the hostname is set to the HostAttr value.+-- | Ensures that the hostname is set to the HostInfo value. -- Configures /etc/hostname and the current hostname. -- -- A FQDN also configures /etc/hosts, with an entry for 127.0.1.1, which is

@@ -105,12 +105,12 @@ latestVersion :: Property latestVersion = withOS "obnam latest version" $ \o -> case o of 	(Just (System (Debian suite) _)) | isStable suite -> ensureProperty $-		Apt.setSourcesListD (sources suite) "obnam"+		Apt.setSourcesListD stablesources "obnam" 			`requires` toProp (Apt.trustsKey key) 	_ -> noChange   where-	sources suite = -		[ "deb http://code.liw.fi/debian " ++ Apt.showSuite suite ++ " main"+	stablesources = +		[ "deb http://code.liw.fi/debian " ++ Apt.showSuite stableRelease ++ " main" 		] 	-- gpg key used by the code.liw.fi repository. 	key = Apt.AptKey "obnam" $ unlines

@@ -69,22 +69,17 @@ buildDepsApt :: Property buildDepsApt = combineProperties "gitannexbuilder build deps" 	[ Apt.buildDep ["git-annex"]-	, buildDepsFewHaskellLibs+	, buildDepsNoHaskellLibs 	, "git-annex source build deps installed" ==> Apt.buildDepIn builddir 	] -buildDepsFewHaskellLibs :: Property-buildDepsFewHaskellLibs = combineProperties "gitannexbuilder build deps"-	[ buildDepsNoHaskellLibs-	-- these haskell libs depend on C libs and don't use TH-	, Apt.installed ["libghc-dbus-dev", "libghc-fdo-notify-dev", "libghc-network-protocol-xmpp-dev"]-	]- buildDepsNoHaskellLibs :: Property buildDepsNoHaskellLibs = Apt.installed 	["git", "rsync", "moreutils", "ca-certificates", 	"debhelper", "ghc", "curl", "openssh-client", "git-remote-gcrypt", 	"liblockfile-simple-perl", "cabal-install", "vim", "less",+	-- needed by haskell libs+	"libxml2-dev", "libidn11-dev", "libgsasl7-dev", "libgnutls-dev", 	"alex", "happy", "c2hs" 	] @@ -98,14 +93,15 @@  standardAutoBuilderContainer :: (System -> Docker.Image) -> Architecture -> Int -> TimeOut -> Host standardAutoBuilderContainer dockerImage arch buildminute timeout = Docker.container (arch ++ "-git-annex-builder")-	(dockerImage $ System (Debian Unstable) arch)-	& os (System (Debian Unstable) arch)+	(dockerImage $ System (Debian Testing) arch)+	& os (System (Debian Testing) arch) 	& Apt.stdSourcesList 	& Apt.installed ["systemd"] 	& Apt.unattendedUpgrades+	& User.accountFor builduser+	& tree arch 	& buildDepsApt 	& autobuilder (show buildminute ++ " * * * *") timeout True-		`requires` tree arch  androidAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host androidAutoBuilderContainer dockerImage crontimes timeout =@@ -144,15 +140,16 @@ armelCompanionContainer :: (System -> Docker.Image) -> Host armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder-companion" 	(dockerImage $ System (Debian Unstable) "amd64")-	& os (System (Debian Unstable) "amd64")+	& os (System (Debian Testing) "amd64") 	& Apt.stdSourcesList 	& Apt.installed ["systemd"] 	& Apt.unattendedUpgrades 	-- This volume is shared with the armel builder. 	& Docker.volume gitbuilderdir+	& User.accountFor builduser 	-- Install current versions of build deps from cabal. 	& tree "armel"-	& buildDepsFewHaskellLibs+	& buildDepsNoHaskellLibs 	& cabalDeps 	-- The armel builder can ssh to this companion. 	& Docker.expose "22"@@ -162,18 +159,19 @@ armelAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "armel-git-annex-builder" 	(dockerImage $ System (Debian Unstable) "armel")-	& os (System (Debian Unstable) "armel")+	& os (System (Debian Testing) "armel") 	& Apt.stdSourcesList 	& Apt.unattendedUpgrades 	& Apt.installed ["systemd"] 	& Apt.installed ["openssh-client"] 	& Docker.link "armel-git-annex-builder-companion" "companion" 	& Docker.volumes_from "armel-git-annex-builder-companion"+	& User.accountFor builduser 	-- TODO: automate installing haskell libs 	-- (Currently have to run 	-- git-annex/standalone/linux/install-haskell-packages 	-- which is not fully automated.)-	& buildDepsFewHaskellLibs+	& buildDepsNoHaskellLibs 	& autobuilder crontimes timeout True 		`requires` tree "armel" 	& Ssh.keyImported SshRsa builduser

@@ -338,3 +338,14 @@ 	  in File.hasPrivContent f 		`onChange` File.ownerGroup f "joey" "joey" 	]++obnamRepos :: [String] -> Property+obnamRepos rs = propertyList ("obnam repos for " ++ unwords rs)+	(mkbase : map mkrepo rs)+  where+  	mkbase = mkdir "/home/joey/lib/backup"+		`requires` mkdir "/home/joey/lib"+	mkrepo r = mkdir ("/home/joey/lib/backup/" ++ r ++ ".obnam")+	mkdir d = File.dirExists d+		`before` File.ownerGroup d "joey" "joey"+

@@ -3,8 +3,8 @@  module Propellor.Types 	( Host(..)-	, Attr-	, getAttr+	, Info+	, getInfo 	, Propellor(..) 	, Property(..) 	, RevertableProperty(..)@@ -29,21 +29,21 @@ import "mtl" Control.Monad.Reader import "MonadCatchIO-transformers" Control.Monad.CatchIO -import Propellor.Types.Attr+import Propellor.Types.Info import Propellor.Types.OS import Propellor.Types.Dns  -- | Everything Propellor knows about a system: Its hostname,--- properties and attributes.+-- properties and other info. data Host = Host 	{ hostName :: HostName 	, hostProperties :: [Property]-	, hostAttr :: Attr+	, hostInfo :: Info 	} 	deriving (Show) --- | Propellor's monad provides read-only access to the host it's running--- on, including its attributes.+-- | Propellor's monad provides read-only access to info about the host+-- it's running on. newtype Propellor p = Propellor { runWithHost :: ReaderT Host IO p } 	deriving 		( Monad@@ -61,8 +61,8 @@ 	{ propertyDesc :: Desc 	, propertySatisfy :: Propellor Result 	-- ^ must be idempotent; may run repeatedly-	, propertyAttr :: Attr-	-- ^ a property can set an attribute of the host that has the property.+	, propertyInfo :: Info+	-- ^ a property can add info to the host. 	}  instance Show Property where@@ -78,15 +78,15 @@ 	-- | Indicates that the first property can only be satisfied 	-- once the second one is. 	requires :: p -> Property -> p-	getAttr :: p -> Attr+	getInfo :: p -> Info  instance IsProp Property where 	describe p d = p { propertyDesc = d } 	toProp p = p-	getAttr = propertyAttr-	x `requires` y = Property (propertyDesc x) satisfy attr+	getInfo = propertyInfo+	x `requires` y = Property (propertyDesc x) satisfy info 	  where-	  	attr = getAttr y <> getAttr x+	  	info = getInfo y <> getInfo x 		satisfy = do 			r <- propertySatisfy y 			case r of@@ -101,8 +101,8 @@ 	toProp (RevertableProperty p1 _) = p1 	(RevertableProperty p1 p2) `requires` y = 		RevertableProperty (p1 `requires` y) p2-	-- | Return the Attr of the currently active side.-	getAttr (RevertableProperty p1 _p2) = getAttr p1+	-- | Return the Info of the currently active side.+	getInfo (RevertableProperty p1 _p2) = getInfo p1  type Desc = String 

@@ -1,65 +0,0 @@-module Propellor.Types.Attr where--import Propellor.Types.OS-import qualified Propellor.Types.Dns as Dns--import qualified Data.Set as S-import Data.Monoid---- | The attributes of a host.-data Attr = Attr-	{ _os :: Val System-	, _sshPubKey :: Val String-	, _dns :: S.Set Dns.Record-	, _namedconf :: Dns.NamedConfMap-	, _dockerattr :: DockerAttr-	}-	deriving (Eq, Show)--instance Monoid Attr where-	mempty = Attr mempty mempty mempty mempty mempty-	mappend old new = Attr-		{ _os = _os old <> _os new-		, _sshPubKey = _sshPubKey old <> _sshPubKey new-		, _dns = _dns old <> _dns new-		, _namedconf = _namedconf old <> _namedconf new-		, _dockerattr = _dockerattr old <> _dockerattr new-		}--data Val a = Val a | NoVal-	deriving (Eq, Show)--instance Monoid (Val a) where-	mempty = NoVal-	mappend old new = case new of-		NoVal -> old-		_ -> new--fromVal :: Val a -> Maybe a-fromVal (Val a) = Just a-fromVal NoVal = Nothing--data DockerAttr = DockerAttr-	{ _dockerImage :: Val String-	, _dockerRunParams :: [HostName -> String]-	}--instance Eq DockerAttr where-	x == y = and-		[ _dockerImage x == _dockerImage y-		, let simpl v = map (\a -> a "") (_dockerRunParams v)-		  in simpl x == simpl y-		]--instance Monoid DockerAttr where-	mempty = DockerAttr mempty mempty-	mappend old new = DockerAttr-		{ _dockerImage = _dockerImage old <> _dockerImage new-		, _dockerRunParams = _dockerRunParams old <> _dockerRunParams new-		}--instance Show DockerAttr where-	show a = unlines-		[ "docker image " ++ show (_dockerImage a)-		, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))-		]

@@ -0,0 +1,65 @@+module Propellor.Types.Info where++import Propellor.Types.OS+import qualified Propellor.Types.Dns as Dns++import qualified Data.Set as S+import Data.Monoid++-- | Information about a host.+data Info = Info+	{ _os :: Val System+	, _sshPubKey :: Val String+	, _dns :: S.Set Dns.Record+	, _namedconf :: Dns.NamedConfMap+	, _dockerinfo :: DockerInfo+	}+	deriving (Eq, Show)++instance Monoid Info where+	mempty = Info mempty mempty mempty mempty mempty+	mappend old new = Info+		{ _os = _os old <> _os new+		, _sshPubKey = _sshPubKey old <> _sshPubKey new+		, _dns = _dns old <> _dns new+		, _namedconf = _namedconf old <> _namedconf new+		, _dockerinfo = _dockerinfo old <> _dockerinfo new+		}++data Val a = Val a | NoVal+	deriving (Eq, Show)++instance Monoid (Val a) where+	mempty = NoVal+	mappend old new = case new of+		NoVal -> old+		_ -> new++fromVal :: Val a -> Maybe a+fromVal (Val a) = Just a+fromVal NoVal = Nothing++data DockerInfo = DockerInfo+	{ _dockerImage :: Val String+	, _dockerRunParams :: [HostName -> String]+	}++instance Eq DockerInfo where+	x == y = and+		[ _dockerImage x == _dockerImage y+		, let simpl v = map (\a -> a "") (_dockerRunParams v)+		  in simpl x == simpl y+		]++instance Monoid DockerInfo where+	mempty = DockerInfo mempty mempty+	mappend old new = DockerInfo+		{ _dockerImage = _dockerImage old <> _dockerImage new+		, _dockerRunParams = _dockerRunParams old <> _dockerRunParams new+		}++instance Show DockerInfo where+	show a = unlines+		[ "docker image " ++ show (_dockerImage a)+		, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a))+		]

@@ -1,7 +1,7 @@ -- | Wrapper program for propellor distribution. -- -- Distributions should install this program into PATH.--- (Cabal builds it as dist/build/propellor.+-- (Cabal builds it as dist/build/propellor/propellor). -- -- This is not the propellor main program (that's config.hs) --