Merge branch 'joeyconfig'
Conflicts: Propellor/Property/Docker.hs
This commit is contained in:
Joey Hess
commit
634cf61c79
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 $
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue