propellor 0.2.2 → 0.2.3

raw patch · 9 files changed

+153/−52 lines, 9 files

Files

• CHANGELOG +11/−0
• Propellor/CmdLine.hs +18/−2
• Propellor/Property/Docker.hs +68/−25
• Propellor/Property/Docker/Shim.hs +4/−1
• Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +15/−18
• Propellor/SimpleSh.hs +5/−4
• config-joey.hs +20/−1
• debian/changelog +11/−0
• propellor.cabal +1/−1

@@ -1,3 +1,14 @@+propellor (0.2.3) unstable; urgency=medium++  * docker: Fix laziness bug that caused running containers to be+    unnecessarily stopped and committed.+  * Add locking so only one propellor can run at a time on a host.+  * docker: When running as effective init inside container, wait on zombies.+  * docker: Added support for configuring shared volumes and linked+    containers.++ -- Joey Hess <joeyh@debian.org>  Tue, 08 Apr 2014 02:07:37 -0400+ propellor (0.2.2) unstable; urgency=medium    * Now supports provisioning docker containers with architecture/libraries

@@ -8,9 +8,12 @@ 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 @@ -53,6 +56,7 @@  defaultMain :: [HostName -> Maybe [Property]] -> IO () defaultMain getprops = do+	DockerShim.cleanEnv 	checkDebugMode 	cmdline <- processCmdLine 	debug ["command line: ", show cmdline]@@ -69,13 +73,25 @@ 	go True cmdline = updateFirst cmdline $ go False cmdline 	go False (Spin host) = withprops host $ const $ spin host 	go False (Run host) = ifM ((==) 0 <$> getRealUserID)-		( withprops host ensureProperties+		( onlyProcess $ withprops host ensureProperties 		, go True (Spin host) 		)-	go False (Boot host) = withprops host $ boot+	go False (Boot host) = onlyProcess $ withprops host $ boot  	withprops host a = maybe (unknownhost host) a $ 		headMaybe $ catMaybes $ map (\get -> get host) getprops++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

@@ -1,4 +1,4 @@-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RankNTypes, BangPatterns #-}  -- | Docker support for propellor --@@ -17,7 +17,9 @@  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.@@ -115,7 +117,7 @@ -- container. data Container = Container Image [Containerized Property] -data Containerized a = Containerized [RunParam] a+data Containerized a = Containerized [HostName -> RunParam] a  -- | Parameters to pass to `docker run` when creating a container. type RunParam = String@@ -156,10 +158,18 @@ user :: String -> Containerized Property user = runProp "user" --- | Bind mount a volume+-- | Mount a volume+-- Create a bind mount with: [host-dir]:[container-dir]:[rw|ro]+-- With just a directory, creates a volume in the container. volume :: String -> Containerized Property volume = runProp "volume" +-- | Mount a volume from the specified container into the current+-- container.+volumes_from :: ContainerName -> Containerized Property+volumes_from cn = genProp "volumes-from" $ \hn ->+	fromContainerId (ContainerId hn cn)+ -- | Work dir inside the container.  workdir :: String -> Containerized Property workdir = runProp "workdir"@@ -169,6 +179,15 @@ memory :: String -> Containerized Property memory = runProp "memory" +-- | Link with another container on the same host.+link :: ContainerName -> ContainerAlias -> Containerized Property+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@@ -180,10 +199,10 @@ data ContainerIdent = ContainerIdent Image HostName ContainerName [RunParam] 	deriving (Read, Show, Eq) -getRunParams :: [Containerized a] -> [RunParam]-getRunParams l = concatMap get l+getRunParams :: HostName -> [Containerized a] -> [RunParam]+getRunParams hn l = concatMap get l   where-	get (Containerized ps _) = ps+	get (Containerized ps _) = map (\a -> a hn ) ps  fromContainerized :: forall a. [Containerized a] -> [a] fromContainerized l = map get l@@ -223,26 +242,36 @@ 	l <- listContainers RunningContainers 	if cid `elem` l 		then do+			-- Check if the ident has changed; if so the+			-- parameters of the container differ and it must+			-- be restarted. 			runningident <- getrunningident-			if (ident2id <$> runningident) == Just (ident2id ident)+			if runningident == Just ident 				then return NoChange 				else do 					void $ stopContainer cid-					oldimage <- fromMaybe image <$> commitContainer cid-					void $ removeContainer cid-					go oldimage-		else do-			whenM (elem cid <$> listContainers AllContainers) $ do-				void $ removeContainer cid-			go image+					restartcontainer+		else ifM (elem cid <$> listContainers AllContainers)+			( restartcontainer+			, go image+			)   where 	ident = ContainerIdent image hn cn runps -	getrunningident = catchDefaultIO Nothing $-		simpleShClient (namedPipe cid) "cat" [propellorIdent] $-			pure . headMaybe . catMaybes . map readish . catMaybes . map getStdout+	restartcontainer = do+		oldimage <- fromMaybe image <$> commitContainer cid+		void $ removeContainer cid+		go oldimage -	runps = getRunParams $ containerprops +++	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++	runps = getRunParams hn $ containerprops ++ 		-- expose propellor directory inside the container 		[ volume (localdir++":"++localdir) 		-- name the container in a predictable way so we@@ -262,6 +291,9 @@ -- | 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.@@ -287,13 +319,17 @@ 			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-			void $ ifM (inPath "bash")+		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.@@ -325,7 +361,7 @@ 			hPutStrLn stderr s 			hFlush stderr 			go Nothing rest-		Done _ -> ret lastline+		Done -> ret lastline 	go lastline [] = ret lastline  	ret lastline = return $ fromMaybe FailedChange $@@ -372,7 +408,8 @@ -- | Only lists propellor managed containers. listContainers :: ContainerFilter -> IO [ContainerId] listContainers status = -	catMaybes . map toContainerId . catMaybes . map (lastMaybe . words) . lines+	catMaybes . map toContainerId . concat . map (split ",")+		. catMaybes . map (lastMaybe . words) . lines 		<$> readProcess dockercmd ps   where 	ps@@ -384,10 +421,16 @@ listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"]  runProp :: String -> RunParam -> Containerized Property-runProp field val = -	Containerized ["--" ++ param] (Property (param) (return NoChange))+runProp field val = Containerized+	[\_ -> "--" ++ param]+	(Property (param) (return NoChange))   where 	param = field++"="++val++genProp :: String -> (HostName -> RunParam) -> Containerized Property+genProp field mkval = Containerized+	[\h -> "--" ++ field ++ "=" ++ mkval h]+	(Property field (return NoChange))  -- | The ContainerIdent of a container is written to -- /.propellor-ident inside it. This can be checked to see if

@@ -3,7 +3,7 @@ -- -- Note: This is currently Debian specific, due to glibcLibs. -module Propellor.Property.Docker.Shim (setup, file) where+module Propellor.Property.Docker.Shim (setup, cleanEnv, file) where  import Propellor import Utility.LinuxMkLibs@@ -43,6 +43,9 @@ 		] 	modifyFileMode shim (addModes executeModes) 	return shim++cleanEnv :: IO ()+cleanEnv = void $ unsetEnv "GCONV_PATH"  file :: FilePath -> FilePath -> FilePath file propellorbin dest = dest </> takeFileName propellorbin

@@ -9,8 +9,14 @@ builduser :: UserName builduser = "builder" +homedir :: FilePath+homedir = "/home/builder"++gitbuilderdir :: FilePath+gitbuilderdir = homedir </> "gitbuilder"+ builddir :: FilePath-builddir = "gitbuilder"+builddir = gitbuilderdir </> "build"  builder :: Architecture -> CronTimes -> Bool -> Property builder arch crontimes rsyncupload = combineProperties "gitannexbuilder"@@ -20,26 +26,22 @@ 		"liblockfile-simple-perl", "cabal-install", "vim", "less"] 	, serviceRunning "cron" `requires` Apt.installed ["cron"] 	, User.accountFor builduser-	, check (lacksdir builddir) $ userScriptProperty builduser-		[ "git clone git://git.kitenet.net/gitannexbuilder " ++ builddir-		, "cd " ++ builddir+	, check (not <$> doesDirectoryExist gitbuilderdir) $ userScriptProperty builduser+		[ "git clone git://git.kitenet.net/gitannexbuilder " ++ gitbuilderdir+		, "cd " ++ gitbuilderdir 		, "git checkout " ++ arch 		] 		`describe` "gitbuilder setup"-	, check (lacksdir $ builddir </> "build") $ userScriptProperty builduser-		[ "cd " ++ builddir-		, "git clone git://git-annex.branchable.com/ build"+	, check (not <$> doesDirectoryExist builddir) $ userScriptProperty builduser+		[ "git clone git://git-annex.branchable.com/ " ++ builddir 		]-	, Property "git-annex source build deps installed" $ do-		d <- homedir-		ensureProperty $ Apt.buildDepIn (d </> builddir </> "build")-	, Cron.niceJob "gitannexbuilder" crontimes builduser ("~/" ++ builddir) "git pull ; ./autobuild"+	, "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-		d <- homedir-		let f = d </> "rsyncpassword"+		let f = homedir </> "rsyncpassword" 		if rsyncupload  			then withPrivData (Password builduser) $ \p -> do 				oldp <- catchDefaultIO "" $ readFileStrict f@@ -52,8 +54,3 @@ 					, makeChange $ writeFile f "no password configured" 					) 	]-  where-  	homedir = fromMaybe ("/home/" ++ builduser) <$> User.homedir builduser-	lacksdir d = do-		h <- homedir-		not <$> doesDirectoryExist (h </> d)

@@ -9,7 +9,6 @@ import Control.Concurrent.Chan import Control.Concurrent.Async import System.Process (std_in, std_out, std_err)-import System.Exit  import Propellor import Utility.FileMode@@ -18,7 +17,7 @@ data Cmd = Cmd String [String] 	deriving (Read, Show) -data Resp = StdoutLine String | StderrLine String | Done ExitCode+data Resp = StdoutLine String | StderrLine String | Done 	deriving (Read, Show)  simpleSh :: FilePath -> IO ()@@ -49,7 +48,7 @@ 			v <- readChan chan 			hPutStrLn h (show v) 			case v of-				Done _ -> noop+				Done -> noop 				_ -> runwriter 		writer <- async runwriter @@ -58,8 +57,10 @@ 		void $ concurrently 			(mkreader StdoutLine outh) 			(mkreader StderrLine errh)+		+		void $ tryIO $ waitForProcess pid -		writeChan chan . Done =<< waitForProcess pid+		writeChan chan Done  		wait writer 

@@ -36,7 +36,6 @@ 	& 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@@ -46,6 +45,8 @@ 	& Apt.buildDep ["git-annex"] 	& Docker.docked container hostname "amd64-git-annex-builder" 	& Docker.docked container hostname "i386-git-annex-builder"+	& Docker.docked container hostname "armel-git-annex-builder-companion"+	& Docker.docked container hostname "armel-git-annex-builder" 	& Docker.garbageCollected -- My laptop host _hostname@"darkstar.kitenet.net" = Just $ props@@ -67,11 +68,29 @@ 			& serviceRunning "apache2" 				`requires` Apt.installed ["apache2"] 		]+	+	-- armel builder has a companion container that run amd64 and+	-- runs the build first to get TH splices. They share a home+	-- directory, and need to have the same versions of all haskell+	-- libraries installed.+	| name == "armel-git-annex-builder-companion" = Just $ Docker.containerFrom+		(image $ System (Debian Unstable) "amd64")+		[ Docker.volume GitAnnexBuilder.homedir+		]+	| name == "armel-git-annex-builder" = Just $ Docker.containerFrom+		(image $ System (Debian Unstable) "armel")+		[ Docker.link (name ++ "-companion") "companion"+		, Docker.volumes_from (name ++ "-companion")+		, Docker.inside $ props+--			& GitAnnexBuilder.builder "armel" "15 * * * *" True+		]+	 	| "-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.

@@ -1,3 +1,14 @@+propellor (0.2.3) unstable; urgency=medium++  * docker: Fix laziness bug that caused running containers to be+    unnecessarily stopped and committed.+  * Add locking so only one propellor can run at a time on a host.+  * docker: When running as effective init inside container, wait on zombies.+  * docker: Added support for configuring shared volumes and linked+    containers.++ -- Joey Hess <joeyh@debian.org>  Tue, 08 Apr 2014 02:07:37 -0400+ propellor (0.2.2) unstable; urgency=medium    * Now supports provisioning docker containers with architecture/libraries

@@ -1,5 +1,5 @@ Name: propellor-Version: 0.2.2+Version: 0.2.3 Cabal-Version: >= 1.6 License: GPL Maintainer: Joey Hess <joey@kitenet.net>