diff options
| -rw-r--r-- | Propellor/CmdLine.hs | 20 | ||||
| -rw-r--r-- | Propellor/Property/Docker.hs | 52 | ||||
| -rw-r--r-- | Propellor/Property/Docker/Shim.hs | 5 | ||||
| -rw-r--r-- | Propellor/Property/SiteSpecific/GitAnnexBuilder.hs | 33 | ||||
| -rw-r--r-- | Propellor/SimpleSh.hs | 9 | ||||
| -rw-r--r-- | config-joey.hs | 21 | ||||
| -rw-r--r-- | debian/changelog | 9 |
7 files changed, 106 insertions, 43 deletions
diff --git a/Propellor/CmdLine.hs b/Propellor/CmdLine.hs index a9c61993..5ea982c3 100644 --- a/Propellor/CmdLine.hs +++ b/Propellor/CmdLine.hs @@ -8,9 +8,12 @@ import System.Log.Formatter import System.Log.Handler (setFormatter, LogHandler) import System.Log.Handler.Simple import System.PosixCompat +import Control.Exception (bracket) +import System.Posix.IO import Propellor import qualified Propellor.Property.Docker as Docker +import qualified Propellor.Property.Docker.Shim as DockerShim import Utility.FileMode import Utility.SafeCommand @@ -53,6 +56,7 @@ processCmdLine = go =<< getArgs defaultMain :: [HostName -> Maybe [Property]] -> IO () defaultMain getprops = do + DockerShim.cleanEnv checkDebugMode cmdline <- processCmdLine debug ["command line: ", show cmdline] @@ -69,14 +73,26 @@ defaultMain getprops = do 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 [ "Unknown host: " ++ h diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs index 573b4c62..b573e641 100644 --- a/Propellor/Property/Docker.hs +++ b/Propellor/Property/Docker.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RankNTypes, BangPatterns #-} -- | Docker support for propellor -- @@ -17,6 +17,7 @@ import Utility.Path import Control.Concurrent.Async import System.Posix.Directory +import System.Posix.Process import Data.List import Data.List.Utils @@ -166,7 +167,7 @@ volume = runProp "volume" -- | Mount a volume from the specified container into the current -- container. volumes_from :: ContainerName -> Containerized Property -volumes_from cn = genProp "volumes-rom" $ \hn -> +volumes_from cn = genProp "volumes-from" $ \hn -> fromContainerId (ContainerId hn cn) -- | Work dir inside the container. @@ -241,24 +242,34 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci 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 + + 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 @@ -280,6 +291,9 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci -- | 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. @@ -305,13 +319,17 @@ chain s = case toContainerId s of 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. @@ -343,7 +361,7 @@ provisionContainer cid = containerDesc cid $ Property "provision" $ do hPutStrLn stderr s hFlush stderr go Nothing rest - Done _ -> ret lastline + Done -> ret lastline go lastline [] = ret lastline ret lastline = return $ fromMaybe FailedChange $ diff --git a/Propellor/Property/Docker/Shim.hs b/Propellor/Property/Docker/Shim.hs index 01c2b22f..c2f35d0c 100644 --- a/Propellor/Property/Docker/Shim.hs +++ b/Propellor/Property/Docker/Shim.hs @@ -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 @@ -44,6 +44,9 @@ setup propellorbin dest = do modifyFileMode shim (addModes executeModes) return shim +cleanEnv :: IO () +cleanEnv = void $ unsetEnv "GCONV_PATH" + file :: FilePath -> FilePath -> FilePath file propellorbin dest = dest </> takeFileName propellorbin diff --git a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index f4e13149..149c8e6c 100644 --- a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -9,8 +9,14 @@ import Propellor.Property.Cron (CronTimes) 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 @@ builder arch crontimes rsyncupload = combineProperties "gitannexbuilder" "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 @@ builder arch crontimes rsyncupload = combineProperties "gitannexbuilder" , makeChange $ writeFile f "no password configured" ) ] - where - homedir = fromMaybe ("/home/" ++ builduser) <$> User.homedir builduser - lacksdir d = do - h <- homedir - not <$> doesDirectoryExist (h </> d) diff --git a/Propellor/SimpleSh.hs b/Propellor/SimpleSh.hs index 0999be9a..99a6fc24 100644 --- a/Propellor/SimpleSh.hs +++ b/Propellor/SimpleSh.hs @@ -9,7 +9,6 @@ import Network.Socket 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 @@ import Utility.ThreadScheduler 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 @@ simpleSh namedpipe = do v <- readChan chan hPutStrLn h (show v) case v of - Done _ -> noop + Done -> noop _ -> runwriter writer <- async runwriter @@ -58,8 +57,10 @@ simpleSh namedpipe = do void $ concurrently (mkreader StdoutLine outh) (mkreader StderrLine errh) + + void $ tryIO $ waitForProcess pid - writeChan chan . Done =<< waitForProcess pid + writeChan chan Done wait writer diff --git a/config-joey.hs b/config-joey.hs index cf739d82..f2cc5e78 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -36,7 +36,6 @@ host hostname@"clam.kitenet.net" = standardSystem Unstable $ props & 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 @@ host hostname@"orca.kitenet.net" = standardSystem Unstable $ props & 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 @@ container _host name & 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. diff --git a/debian/changelog b/debian/changelog index f4eadd22..e2f955b0 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,12 @@ +propellor (0.2.3) UNRELEASED; 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. + + -- Joey Hess <joeyh@debian.org> Fri, 04 Apr 2014 15:58:03 -0400 + propellor (0.2.2) unstable; urgency=medium * Now supports provisioning docker containers with architecture/libraries |