propellor 2.5.0 → 2.6.0

raw patch · 17 files changed

+150/−49 lines, 17 filesdep ~exceptionsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: exceptions

API changes (from Hackage documentation)

Files

• CHANGELOG +13/−0
• Makefile +9/−5
• config-joey.hs +4/−4
• config-simple.hs +1/−1
• config.hs +1/−1
• debian/changelog +13/−0
• debian/control +2/−2
• propellor.cabal +3/−3
• src/Propellor/CmdLine.hs +2/−0
• src/Propellor/PrivData.hs +16/−5
• src/Propellor/Property/Docker.hs +63/−16
• src/Propellor/Property/Postfix.hs +7/−7
• src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +2/−4
• src/Propellor/Property/SiteSpecific/JoeySites.hs +2/−0
• src/Propellor/Property/Systemd.hs +10/−0
• src/Propellor/Types/CmdLine.hs +1/−0
• src/config.hs +1/−1

@@ -1,3 +1,16 @@+propellor (2.6.0) unstable; urgency=medium++  * Replace String type synonym Docker.Image by a data type+    which allows to specify an image name and an optional tag. (API change)+    Thanks, Antoine Eiche.+  * Added --unset to delete a privdata field.+  * Version dependency on exceptions.+  * Systemd: Add masked property.+    Thanks, Sean Whitton+  * Fix make install target to work even when git is not configured.++ -- Joey Hess <id@joeyh.name>  Fri, 10 Jul 2015 22:36:29 -0400+ propellor (2.5.0) unstable; urgency=medium    * cmdProperty' renamed to cmdPropertyEnv to make way for a new,

@@ -17,11 +17,15 @@ 	cat dist/propellor-*.tar.gz | (cd dist/gittmp && tar zx --strip-components=1) 	# cabal sdist does not preserve symlinks, so copy over file 	cd dist/gittmp && for f in $$(find -type f); do rm -f $$f; cp -a ../../$$f $$f; done-	cd dist/gittmp && git init && \-		git add . \-		&& git commit -q -m "distributed version of propellor" \-		&& git bundle create $(DESTDIR)/usr/src/propellor/propellor.git master HEAD \-		&& git show-ref master --hash > $(DESTDIR)/usr/src/propellor/head+	export GIT_AUTHOR_NAME=build \+	&& export GIT_AUTHOR_EMAIL=build@buildhost \+	&& export GIT_COMMITTER_NAME=build \+	&& export GIT_COMMITTER_EMAIL=build@buildhost \+	&& cd dist/gittmp && git init \+	&& git add . \+	&& git commit -q -m "distributed version of propellor" \+	&& git bundle create $(DESTDIR)/usr/src/propellor/propellor.git master HEAD \+	&& git show-ref master --hash > $(DESTDIR)/usr/src/propellor/head 	rm -rf dist/gittmp  clean:

@@ -505,10 +505,10 @@  -- 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!+dockerImage (System (Debian Unstable) arch) = Docker.latestImage ("joeyh/debian-unstable-" ++ arch)+dockerImage (System (Debian Testing) arch) = Docker.latestImage ("joeyh/debian-unstable-" ++ arch)+dockerImage (System (Debian (Stable _)) arch) = Docker.latestImage ("joeyh/debian-stable-" ++ arch)+dockerImage _ = Docker.latestImage "debian-stable-official" -- does not currently exist!  myDnsSecondary :: Property HasInfo myDnsSecondary = propertyList "dns secondary for all my domains" $ props

@@ -41,7 +41,7 @@  -- A generic webserver in a Docker container. webserverContainer :: Docker.Container-webserverContainer = Docker.container "webserver" "debian"+webserverContainer = Docker.container "webserver" (Docker.latestImage "debian") 	& os (System (Debian (Stable "jessie")) "amd64") 	& Apt.stdSourcesList 	& Docker.publish "80:80"

@@ -41,7 +41,7 @@  -- A generic webserver in a Docker container. webserverContainer :: Docker.Container-webserverContainer = Docker.container "webserver" "debian"+webserverContainer = Docker.container "webserver" (Docker.latestImage "debian") 	& os (System (Debian (Stable "jessie")) "amd64") 	& Apt.stdSourcesList 	& Docker.publish "80:80"

@@ -1,3 +1,16 @@+propellor (2.6.0) unstable; urgency=medium++  * Replace String type synonym Docker.Image by a data type+    which allows to specify an image name and an optional tag. (API change)+    Thanks, Antoine Eiche.+  * Added --unset to delete a privdata field.+  * Version dependency on exceptions.+  * Systemd: Add masked property.+    Thanks, Sean Whitton+  * Fix make install target to work even when git is not configured.++ -- Joey Hess <id@joeyh.name>  Fri, 10 Jul 2015 22:36:29 -0400+ propellor (2.5.0) unstable; urgency=medium    * cmdProperty' renamed to cmdPropertyEnv to make way for a new,

@@ -16,7 +16,7 @@ 	libghc-quickcheck2-dev, 	libghc-mtl-dev, 	libghc-transformers-dev,-	libghc-exceptions-dev,+	libghc-exceptions-dev (>= 0.6), Maintainer: Gergely Nagy <algernon@madhouse-project.org> Standards-Version: 3.9.6 Vcs-Git: git://git.joeyh.name/propellor@@ -38,7 +38,7 @@ 	libghc-quickcheck2-dev, 	libghc-mtl-dev, 	libghc-transformers-dev,-	libghc-exceptions-dev,+	libghc-exceptions-dev (>= 0.6), 	git, Description: property-based host configuration management in haskell  Propellor enures that the system it's run in satisfies a list of

@@ -1,6 +1,6 @@ Name: propellor-Version: 2.5.0-Cabal-Version: >= 1.6+Version: 2.6.0+Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess <id@joeyh.name> Author: Joey Hess@@ -38,7 +38,7 @@   Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,    IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,    containers, network, async, time, QuickCheck, mtl, transformers,-   exceptions+   exceptions (>= 0.6)    if (! os(windows))     Build-Depends: unix

@@ -51,6 +51,7 @@ 		_ -> Spin <$> mapM hostname ps <*> pure Nothing 	go ("--add-key":k:[]) = return $ AddKey k 	go ("--set":f:c:[]) = withprivfield f c Set+	go ("--unset":f:c:[]) = withprivfield f c Unset 	go ("--dump":f:c:[]) = withprivfield f c Dump 	go ("--edit":f:c:[]) = withprivfield f c Edit 	go ("--list-fields":[]) = return ListFields@@ -94,6 +95,7 @@ 	go _ (Continue cmdline) = go False cmdline 	go _ Check = return () 	go _ (Set field context) = setPrivData field context+	go _ (Unset field context) = unsetPrivData field context 	go _ (Dump field context) = dumpPrivData field context 	go _ (Edit field context) = editPrivData field context 	go _ ListFields = listPrivDataFields hostlist

@@ -6,6 +6,7 @@ 	withSomePrivData, 	addPrivData, 	setPrivData,+	unsetPrivData, 	dumpPrivData, 	editPrivData, 	filterPrivData,@@ -143,6 +144,11 @@ 	putStrLn "Enter private data on stdin; ctrl-D when done:" 	setPrivDataTo field context =<< hGetContentsStrict stdin +unsetPrivData :: PrivDataField -> Context -> IO ()+unsetPrivData field context = do+	modifyPrivData $ M.delete (field, context)+	putStrLn "Private data unset."+ dumpPrivData :: PrivDataField -> Context -> IO () dumpPrivData field context = 	maybe (error "Requested privdata is not set.") putStrLn@@ -192,16 +198,21 @@  setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO () setPrivDataTo field context value = do-	makePrivDataDir-	m <- decryptPrivData-	let m' = M.insert (field, context) (chomp value) m-	gpgEncrypt privDataFile (show m')+	modifyPrivData set 	putStrLn "Private data set."-	void $ boolSystem "git" [Param "add", File privDataFile]   where+	set = M.insert (field, context) (chomp value) 	chomp s 		| end s == "\n" = chomp (beginning s) 		| otherwise = s++modifyPrivData :: (PrivMap -> PrivMap) -> IO ()+modifyPrivData f = do+	makePrivDataDir+	m <- decryptPrivData+	let m' = f m+	gpgEncrypt privDataFile (show m')+	void $ boolSystem "git" [Param "add", File privDataFile]  decryptPrivData :: IO PrivMap decryptPrivData = fromMaybe M.empty . readish <$> gpgDecrypt privDataFile

@@ -16,7 +16,8 @@ 	memoryLimited, 	garbageCollected, 	tweaked,-	Image,+	Image(..),+	latestImage, 	ContainerName, 	Container, 	HasImage(..),@@ -155,8 +156,8 @@ imageBuilt :: HasImage c => FilePath -> c -> Property NoInfo imageBuilt directory ctr = describe built msg   where-	msg = "docker image " ++ image ++ " built from " ++ directory-	built = Cmd.cmdProperty' dockercmd ["build", "--tag", image, "./"] workDir+	msg = "docker image " ++ (imageIdentifier image) ++ " built from " ++ directory+	built = Cmd.cmdProperty' dockercmd ["build", "--tag", imageIdentifier image, "./"] workDir 	workDir p = p { cwd = Just directory } 	image = getImageName ctr @@ -164,8 +165,8 @@ imagePulled :: HasImage c => c -> Property NoInfo imagePulled ctr = describe pulled msg   where-	msg = "docker image " ++ image ++ " pulled"-	pulled = Cmd.cmdProperty dockercmd ["pull", image]+	msg = "docker image " ++ (imageIdentifier image) ++ " pulled"+	pulled = Cmd.cmdProperty dockercmd ["pull", imageIdentifier image] 	image = getImageName ctr  propigateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Property HasInfo@@ -243,9 +244,53 @@ -- | 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+-- | ImageID is an image identifier to perform action on images. An+-- ImageID can be the name of an container image, a UID, etc.+--+-- It just encapsulates a String to avoid the definition of a String+-- instance of ImageIdentifier.+newtype ImageID = ImageID String +-- | Used to perform Docker action on an image.+--+-- Minimal complete definition: `imageIdentifier`+class ImageIdentifier i where+	-- | For internal purposes only.+	toImageID :: i -> ImageID+	toImageID = ImageID . imageIdentifier+	-- | A string that Docker can use as an image identifier.+	imageIdentifier :: i -> String++instance ImageIdentifier ImageID where+	imageIdentifier (ImageID i) = i+	toImageID = id++-- | A docker image, that can be used to run a container. The user has+-- to specify a name and can provide an optional tag.+-- See <http://docs.docker.com/userguide/dockerimages/ Docker Image Documention>+-- for more information.+data Image = Image+	{ repository :: String+	, tag :: Maybe String+	}+	deriving (Eq, Read, Show)++-- | Defines a Docker image without any tag. This is considered by+-- Docker as the latest image of the provided repository.+latestImage :: String -> Image+latestImage repo = Image repo Nothing++instance ImageIdentifier Image where+	-- | The format of the imageIdentifier of an `Image` is:+	-- repository | repository:tag+	imageIdentifier i = repository i ++ (maybe "" ((++) ":") $ tag i)++-- | The UID of an image. This UID is generated by Docker.+newtype ImageUID = ImageUID String++instance ImageIdentifier ImageUID where+	imageIdentifier (ImageUID uid) = uid+ -- | Set custom dns server for container. dns :: String -> Property HasInfo dns = runProp "dns"@@ -424,7 +469,9 @@ 		return FailedChange  	restartcontainer = do-		oldimage <- liftIO $ fromMaybe image <$> commitContainer cid+		oldimage <- liftIO $+			fromMaybe (toImageID image) . fmap toImageID <$>+				commitContainer cid 		void $ liftIO $ removeContainer cid 		go oldimage @@ -561,20 +608,20 @@ removeContainer cid = catchBoolIO $ 	snd <$> processTranscript dockercmd ["rm", fromContainerId cid ] Nothing -removeImage :: Image -> IO Bool+removeImage :: ImageIdentifier i => i -> IO Bool removeImage image = catchBoolIO $-	snd <$> processTranscript dockercmd ["rmi", image ] Nothing+	snd <$> processTranscript dockercmd ["rmi", imageIdentifier image] Nothing -runContainer :: Image -> [RunParam] -> [String] -> IO Bool+runContainer :: ImageIdentifier i => i -> [RunParam] -> [String] -> IO Bool runContainer image ps cmd = boolSystem dockercmd $ map Param $-	"run" : (ps ++ image : cmd)+	"run" : (ps ++ (imageIdentifier image) : cmd)  inContainerProcess :: ContainerId -> [String] -> [String] -> CreateProcess inContainerProcess cid ps cmd = proc dockercmd ("exec" : ps ++ [fromContainerId cid] ++ cmd) -commitContainer :: ContainerId -> IO (Maybe Image)+commitContainer :: ContainerId -> IO (Maybe ImageUID) commitContainer cid = catchMaybeIO $-	takeWhile (/= '\n') +	ImageUID . takeWhile (/= '\n') 		<$> readProcess dockercmd ["commit", fromContainerId cid]  data ContainerFilter = RunningContainers | AllContainers@@ -592,8 +639,8 @@ 		| otherwise = baseps 	baseps = ["ps", "--no-trunc"] -listImages :: IO [Image]-listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]+listImages :: IO [ImageUID]+listImages = map ImageUID . lines <$> readProcess dockercmd ["images", "--all", "--quiet"]  runProp :: String -> RunParam -> Property HasInfo runProp field val = pureInfoProperty (param) $ dockerInfo $

@@ -23,10 +23,10 @@  -- | Configures postfix as a satellite system, which  -- relays all mail through a relay host, which defaults to smtp.domain,--- but can be changed by mainCf "relayhost"+-- but can be changed by @mainCf "relayhost"@. -- -- The smarthost may refuse to relay mail on to other domains, without--- futher coniguration/keys. But this should be enough to get cron job+-- further configuration/keys. But this should be enough to get cron job -- mail flowing to a place where it will be seen. satellite :: Property NoInfo satellite = check (not <$> mainCfIsSet "relayhost") setup@@ -58,7 +58,7 @@ 	`onChange` cmdProperty "postmap" [f]  -- | Run newaliases command, which should be done after changing--- </etc/aliases>.+-- @/etc/aliases@. newaliases :: Property NoInfo newaliases = trivial $ cmdProperty "newaliases" [] @@ -66,7 +66,7 @@ mainCfFile :: FilePath mainCfFile = "/etc/postfix/main.cf" --- | Sets a main.cf name=value pair. Does not reload postfix immediately.+-- | Sets a main.cf @name=value@ pair. Does not reload postfix immediately. mainCf :: (String, String) -> Property NoInfo mainCf (name, value) = check notset set 		`describe` ("postfix main.cf " ++ setting)@@ -75,7 +75,7 @@ 	notset = (/= Just value) <$> getMainCf name 	set = cmdProperty "postconf" ["-e", setting] --- | Gets a man.cf setting.+-- | Gets a main.cf setting. getMainCf :: String -> IO (Maybe String) getMainCf name = parse . lines <$> readProcess "postconf" [name]   where@@ -131,9 +131,9 @@ -- | Installs saslauthd and configures it for postfix, authenticating -- against PAM. ----- Does not configure postfix to use it; eg smtpd_sasl_auth_enable = yes+-- Does not configure postfix to use it; eg @smtpd_sasl_auth_enable = yes@ -- needs to be set to enable use. See--- https://wiki.debian.org/PostfixAndSASL+-- <https://wiki.debian.org/PostfixAndSASL>. saslAuthdInstalled :: Property NoInfo saslAuthdInstalled = setupdaemon 	`requires` Service.running "saslauthd"

@@ -67,7 +67,6 @@ buildDepsApt :: Property HasInfo buildDepsApt = combineProperties "gitannexbuilder build deps" $ props 	& Apt.buildDep ["git-annex"]-	& Apt.installed ["liblockfile-simple-perl"] 	& buildDepsNoHaskellLibs 	& Apt.buildDepIn builddir 		`describe` "git-annex source build deps installed"@@ -86,7 +85,7 @@ haskellPkgsInstalled dir = flagFile go ("/haskellpkgsinstalled")   where 	go = userScriptProperty (User builduser)-		[ "cd " ++ builddir ++ " && ./standalone/ " ++ dir ++ "/install-haskell-packages"+		[ "cd " ++ builddir ++ " && ./standalone/" ++ dir ++ "/install-haskell-packages" 		]  -- Installs current versions of git-annex's deps from cabal, but only@@ -150,7 +149,6 @@ 	& File.ownerGroup homedir (User builduser) (Group builduser) 	& flagFile chrootsetup ("/chrootsetup") 		`requires` setupgitannexdir-	& buildDepsApt 	& haskellPkgsInstalled "android"   where 	-- Use git-annex's android chroot setup script, which will install@@ -159,5 +157,5 @@ 	chrootsetup = scriptProperty 		[ "cd " ++ gitannexdir ++ " && ./standalone/android/buildchroot-inchroot" 		]-	osver = System (Debian Testing) "i386"+	osver = System (Debian (Stable "jessie")) "i386" 	bootstrap = Chroot.debootstrapped osver mempty

@@ -859,6 +859,8 @@ 		, "  AllowOverride None" 		, Apache.allowAll 		, "</Directory>"+		, "RewriteEngine On"+		, "RewriteRule .* http://www.sowsearpoetry.org/ [L]" 		] 	& alias "wortroot.kitenet.net" 	& alias "www.wortroot.kitenet.net"

@@ -7,6 +7,7 @@ 	stopped, 	enabled, 	disabled,+	masked, 	running, 	restarted, 	networkd,@@ -88,6 +89,15 @@ disabled :: ServiceName -> Property NoInfo disabled n = trivial $ cmdProperty "systemctl" ["disable", n] 	`describe` ("service " ++ n ++ " disabled")++-- | Masks a systemd service.+masked :: ServiceName -> RevertableProperty+masked n = systemdMask <!> systemdUnmask+  where+	systemdMask   = trivial $ cmdProperty "systemctl" ["mask", n]+	                `describe` ("service " ++ n ++ " masked")+	systemdUnmask = trivial $ cmdProperty "systemctl" ["unmask", n]+	                `describe` ("service " ++ n ++ " unmasked")  -- | Ensures that a service is both enabled and started running :: ServiceName -> Property NoInfo

@@ -10,6 +10,7 @@ 	| Spin [HostName] (Maybe HostName) 	| SimpleRun HostName 	| Set PrivDataField Context+	| Unset PrivDataField Context 	| Dump PrivDataField Context 	| Edit PrivDataField Context 	| ListFields

@@ -41,7 +41,7 @@  -- A generic webserver in a Docker container. webserverContainer :: Docker.Container-webserverContainer = Docker.container "webserver" "debian"+webserverContainer = Docker.container "webserver" (Docker.latestImage "debian") 	& os (System (Debian (Stable "jessie")) "amd64") 	& Apt.stdSourcesList 	& Docker.publish "80:80"