summaryrefslogtreecommitdiff
path: root/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2014-04-03 21:22:37 -0400
committerJoey Hess2014-04-03 21:22:37 -0400
commit1c381c5246b2836ca0f535b9ac65eddcaa000024 (patch)
treef37aafa9b7ad997db99bcb96a1c02b54b5537b38 /Propellor/Property
parent4996f12326207bc61c025c8717dfeb17269367c2 (diff)
library shimming for docker (untested)
Diffstat (limited to 'Propellor/Property')
-rw-r--r--Propellor/Property/Docker.hs38
-rw-r--r--Propellor/Property/Docker/Shim.hs52
2 files changed, 73 insertions, 17 deletions
diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index 5f819f26..88adb06d 100644
--- a/Propellor/Property/Docker.hs
+++ b/Propellor/Property/Docker.hs
@@ -4,13 +4,6 @@
--
-- The existance of a docker container is just another Property of a system,
-- which propellor can set up. See config.hs for an example.
---
--- Note that propellor provisions a container by running itself, inside the
--- container. Currently, to avoid the overhead of building propellor
--- inside the container, the binary from outside is reused inside.
--- So, the libraries that propellor is linked against need to be available
--- in the container with compatable versions. This can cause a problem
--- if eg, mixing Debian stable and unstable.
module Propellor.Property.Docker where
@@ -18,6 +11,7 @@ import Propellor
import Propellor.SimpleSh
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Docker.Shim as Shim
import Utility.SafeCommand
import Utility.Path
@@ -256,15 +250,14 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci
, name (fromContainerId cid)
]
- chaincmd = [localdir </> "propellor", "--docker", fromContainerId cid]
-
go img = do
clearProvisionedFlag cid
createDirectoryIfMissing True (takeDirectory $ identFile cid)
+ shim <- Shim.setup "./propellor" (localdir </> shimdir cid)
writeFile (identFile cid) (show ident)
ensureProperty $ boolProperty "run" $ runContainer img
(runps ++ ["-i", "-d", "-t"])
- chaincmd
+ [shim, "--docker", fromContainerId cid]
-- | Called when propellor is running inside a docker container.
-- The string should be the container's ContainerId.
@@ -290,8 +283,9 @@ chain s = case toContainerId s of
writeFile propellorIdent . show =<< readIdentFile cid
-- Run boot provisioning before starting simpleSh,
-- to avoid ever provisioning twice at the same time.
- whenM (checkProvisionedFlag cid) $
- unlessM (boolSystem "./propellor" [Param "--continue", Param $ show $ Chain $ fromContainerId cid]) $
+ whenM (checkProvisionedFlag cid) $ do
+ let shim = Shim.file "./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
@@ -310,7 +304,8 @@ chain s = case toContainerId s of
-- 1 minute.
provisionContainer :: ContainerId -> Property
provisionContainer cid = containerDesc cid $ Property "provision" $ do
- r <- simpleShClientRetry 60 (namedPipe cid) "./propellor" params (go Nothing)
+ let shim = Shim.file "./propellor" (localdir </> shimdir cid)
+ r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing)
when (r /= FailedChange) $
setProvisionedFlag cid
return r
@@ -342,11 +337,17 @@ stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId
stoppedContainer :: ContainerId -> Property
stoppedContainer cid = containerDesc cid $ Property desc $
ifM (elem cid <$> listContainers RunningContainers)
- ( ensureProperty $ boolProperty desc $ stopContainer cid
+ ( cleanup `after` ensureProperty
+ (boolProperty desc $ stopContainer cid)
, return NoChange
)
where
desc = "stopped"
+ cleanup = do
+ nukeFile $ namedPipe cid
+ nukeFile $ identFile cid
+ removeDirectoryRecursive $ shimdir cid
+ clearProvisionedFlag cid
removeContainer :: ContainerId -> IO Bool
removeContainer cid = catchBoolIO $
@@ -396,10 +397,10 @@ propellorIdent = "/.propellor-ident"
-- | Named pipe used for communication with the container.
namedPipe :: ContainerId -> FilePath
-namedPipe cid = "docker/" ++ fromContainerId cid
+namedPipe cid = "docker" </> fromContainerId cid
provisionedFlag :: ContainerId -> FilePath
-provisionedFlag cid = "docker/" ++ fromContainerId cid ++ ".provisioned"
+provisionedFlag cid = "docker" </> fromContainerId cid ++ ".provisioned"
clearProvisionedFlag :: ContainerId -> IO ()
clearProvisionedFlag = nukeFile . provisionedFlag
@@ -412,8 +413,11 @@ setProvisionedFlag cid = do
checkProvisionedFlag :: ContainerId -> IO Bool
checkProvisionedFlag = doesFileExist . provisionedFlag
+shimdir :: ContainerId -> FilePath
+shimdir cid = "docker" </> fromContainerId cid ++ ".shim"
+
identFile :: ContainerId -> FilePath
-identFile cid = "docker/" ++ fromContainerId cid ++ ".ident"
+identFile cid = "docker" </> fromContainerId cid ++ ".ident"
readIdentFile :: ContainerId -> IO ContainerIdent
readIdentFile cid = fromMaybe (error "bad ident in identFile")
diff --git a/Propellor/Property/Docker/Shim.hs b/Propellor/Property/Docker/Shim.hs
new file mode 100644
index 00000000..0e0f55e7
--- /dev/null
+++ b/Propellor/Property/Docker/Shim.hs
@@ -0,0 +1,52 @@
+-- | Support for running propellor, as built outside a docker container,
+-- inside the container.
+--
+-- Note: This is currently Debian specific, due to glibcLibs.
+
+module Propellor.Property.Docker.Shim (setup, file) where
+
+import Propellor
+import Utility.LinuxMkLibs
+import Utility.SafeCommand
+import Utility.Path
+import Utility.FileMode
+
+import Data.List
+import System.Posix.Files
+
+-- | Sets up a shimmed version of the program, in a directory, and
+-- returns its path.
+setup :: FilePath -> FilePath -> IO FilePath
+setup propellorbin dest = do
+ createDirectoryIfMissing True dest
+
+ libs <- parseLdd <$> readProcess "ldd" [propellorbin]
+ glibclibs <- glibcLibs
+ let libs' = nub $ libs ++ glibclibs
+ libdirs <- map (dest ++) . nub . catMaybes
+ <$> mapM (installLib installFile dest) libs'
+
+ let linker = (dest ++) $
+ fromMaybe (error "cannot find ld-linux linker") $
+ headMaybe $ filter ("ld-linux" `isInfixOf`) libs'
+ let linkerparams = ["--library-path", intercalate ":" libdirs ]
+ let shim = file propellorbin dest
+ writeFile shim $ unlines
+ [ "#!/bin/sh"
+ , "exec " ++ unwords (map shellEscape $ linker : linkerparams) ++
+ " " ++ shellEscape propellorbin ++ " \"$@\""
+ ]
+ modifyFileMode shim (addModes executeModes)
+ return shim
+
+file :: FilePath -> FilePath -> FilePath
+file propellorbin dest = dest </> propellorbin
+
+installFile :: FilePath -> FilePath -> IO ()
+installFile top f = do
+ createDirectoryIfMissing True destdir
+ createLink f dest `catchIO` (const copy)
+ where
+ copy = void $ boolSystem "cp" [Param "-a", Param f, Param dest]
+ destdir = inTop top $ parentDir f
+ dest = inTop top f