summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.gitignore1
-rw-r--r--Propellor/Config/Joey.hs (renamed from config-joeyh.hs)23
-rw-r--r--Propellor/Config/Simple.hs (renamed from config-simple.hs)0
-rw-r--r--Propellor/Message.hs18
-rw-r--r--Propellor/Property/Docker.hs38
-rw-r--r--Propellor/Property/Docker/Shim.hs58
-rw-r--r--Propellor/Property/File.hs12
-rw-r--r--Propellor/Property/Hostname.hs28
-rw-r--r--TODO2
-rw-r--r--Utility/LinuxMkLibs.hs61
l---------config.hs2
-rw-r--r--debian/changelog9
-rw-r--r--propellor.cabal8
13 files changed, 216 insertions, 44 deletions
diff --git a/.gitignore b/.gitignore
index a2bed361..e9925509 100644
--- a/.gitignore
+++ b/.gitignore
@@ -6,3 +6,4 @@ privdata/keyring.gpg~
Setup
Setup.hi
Setup.o
+docker
diff --git a/config-joeyh.hs b/Propellor/Config/Joey.hs
index cb56f4b2..530df9a3 100644
--- a/config-joeyh.hs
+++ b/Propellor/Config/Joey.hs
@@ -10,13 +10,15 @@ import qualified Propellor.Property.Cron as Cron
import qualified Propellor.Property.Sudo as Sudo
import qualified Propellor.Property.User as User
import qualified Propellor.Property.Hostname as Hostname
-import qualified Propellor.Property.Reboot as Reboot
+--import qualified Propellor.Property.Reboot as Reboot
import qualified Propellor.Property.Tor as Tor
import qualified Propellor.Property.Docker as Docker
import qualified Propellor.Property.SiteSpecific.GitHome as GitHome
import qualified Propellor.Property.SiteSpecific.GitAnnexBuilder as GitAnnexBuilder
import qualified Propellor.Property.SiteSpecific.JoeySites as JoeySites
import Data.List
+-- Only imported to make sure it continues to build.
+import qualified ConfigSimple as Simple
main :: IO ()
main = defaultMain [host, Docker.containerProperties container]
@@ -45,7 +47,7 @@ host hostname@"orca.kitenet.net" = standardSystem Unstable $ props
& Docker.configured
& Apt.buildDep ["git-annex"]
& Docker.docked container hostname "amd64-git-annex-builder"
- ! Docker.docked container hostname "i386-git-annex-builder"
+ & Docker.docked container hostname "i386-git-annex-builder"
& Docker.garbageCollected
-- My laptop
host _hostname@"darkstar.kitenet.net" = Just $ props
@@ -75,17 +77,14 @@ container _host name
| otherwise = Nothing
-- | Docker images I prefer to use.
--- Edit as suites you, or delete this function and just put the image names
--- above.
image :: System -> Docker.Image
-image (System (Debian Unstable) "amd64") = "joeyh/debian-unstable"
-image (System (Debian Unstable) "i386") = "joeyh/debian-unstable-i386"
-image _ = "debian"
+image (System (Debian Unstable) arch) = "joeyh/debian-unstable-" ++ arch
+image _ = "debian-stable-official" -- does not currently exist!
-- This is my standard system setup
standardSystem :: DebianSuite -> [Property] -> Maybe [Property]
standardSystem suite customprops = Just $
- standardprops : customprops ++ [endprops]
+ standardprops : customprops ++ endprops
where
standardprops = propertyList "standard system" $ props
& Apt.stdSourcesList suite `onChange` Apt.upgrade
@@ -104,9 +103,11 @@ standardSystem suite customprops = Just $
& Apt.installed ["vim", "screen", "less"]
& Cron.runPropellor "30 * * * *"
-- I use postfix, or no MTA.
- & Apt.removed ["exim4"] `onChange` Apt.autoRemove
- -- May reboot, so comes last.
- endprops = Apt.installed ["systemd-sysv"] `onChange` Reboot.now
+ & Apt.removed ["exim4", "exim4-daemon-light", "exim4-config", "exim4-base"]
+ `onChange` Apt.autoRemove
+ -- May reboot, so comes last
+ -- Currently not enable due to #726375
+ endprops = [] -- [Apt.installed ["systemd-sysv"] `onChange` Reboot.now]
-- Clean up a system as installed by cloudatcost.com
cleanCloudAtCost :: HostName -> Property
diff --git a/config-simple.hs b/Propellor/Config/Simple.hs
index 840bad02..840bad02 100644
--- a/config-simple.hs
+++ b/Propellor/Config/Simple.hs
diff --git a/Propellor/Message.hs b/Propellor/Message.hs
index eb3f3177..5a7d8c4b 100644
--- a/Propellor/Message.hs
+++ b/Propellor/Message.hs
@@ -15,21 +15,25 @@ actionMessage desc a = do
r <- a
+ setTitle "propellor: running"
let (msg, intensity, color) = getActionResult r
putStr $ desc ++ " ... "
- setSGR [SetColor Foreground intensity color]
- putStrLn msg
- setSGR []
- setTitle "propellor: running"
+ colorLine intensity color msg
hFlush stdout
return r
warningMessage :: String -> IO ()
-warningMessage s = do
- setSGR [SetColor Foreground Vivid Red]
- putStrLn $ "** warning: " ++ s
+warningMessage s = colorLine Vivid Red $ "** warning: " ++ s
+
+colorLine :: ColorIntensity -> Color -> String -> IO ()
+colorLine intensity color msg = do
+ setSGR [SetColor Foreground intensity color]
+ putStr msg
setSGR []
+ -- Note this comes after the color is reset, so that
+ -- the color set and reset happen in the same line.
+ putStrLn ""
hFlush stdout
errorMessage :: String -> IO a
diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index 5f819f26..888e76c6 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 (localdir </> "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 (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
@@ -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 (localdir </> "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..01c2b22f
--- /dev/null
+++ b/Propellor/Property/Docker/Shim.hs
@@ -0,0 +1,58 @@
+-- | 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 gconvdir = (dest ++) $ parentDir $
+ fromMaybe (error "cannot find gconv directory") $
+ headMaybe $ filter ("/gconv/" `isInfixOf`) glibclibs
+ let linkerparams = ["--library-path", intercalate ":" libdirs ]
+ let shim = file propellorbin dest
+ writeFile shim $ unlines
+ [ "#!/bin/sh"
+ , "GCONV_PATH=" ++ shellEscape gconvdir
+ , "export GCONV_PATH"
+ , "exec " ++ unwords (map shellEscape $ linker : linkerparams) ++
+ " " ++ shellEscape propellorbin ++ " \"$@\""
+ ]
+ modifyFileMode shim (addModes executeModes)
+ return shim
+
+file :: FilePath -> FilePath -> FilePath
+file propellorbin dest = dest </> takeFileName propellorbin
+
+installFile :: FilePath -> FilePath -> IO ()
+installFile top f = do
+ createDirectoryIfMissing True destdir
+ nukeFile dest
+ 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
diff --git a/Propellor/Property/File.hs b/Propellor/Property/File.hs
index af4f554f..80c69d9b 100644
--- a/Propellor/Property/File.hs
+++ b/Propellor/Property/File.hs
@@ -2,6 +2,8 @@ module Propellor.Property.File where
import Propellor
+import System.Posix.Files
+
type Line = String
-- | Replaces all the content of a file.
@@ -32,13 +34,19 @@ fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property
fileProperty desc a f = Property desc $ go =<< doesFileExist f
where
go True = do
- ls <- lines <$> catchDefaultIO [] (readFile f)
+ ls <- lines <$> readFile f
let ls' = a ls
if ls' == ls
then noChange
- else makeChange $ viaTmp writeFile f (unlines ls')
+ else makeChange $ viaTmp updatefile f (unlines ls')
go False = makeChange $ writeFile f (unlines $ a [])
+ -- viaTmp makes the temp file mode 600.
+ -- Replicate the original file mode before moving it into place.
+ updatefile f' content = do
+ writeFile f' content
+ getFileStatus f >>= setFileMode f' . fileMode
+
-- | Ensures a directory exists.
dirExists :: FilePath -> Property
dirExists d = check (not <$> doesDirectoryExist d) $ Property (d ++ " exists") $
diff --git a/Propellor/Property/Hostname.hs b/Propellor/Property/Hostname.hs
index 25f0e1b2..26635374 100644
--- a/Propellor/Property/Hostname.hs
+++ b/Propellor/Property/Hostname.hs
@@ -3,7 +3,29 @@ module Propellor.Property.Hostname where
import Propellor
import qualified Propellor.Property.File as File
+-- | Sets the hostname. Configures both /etc/hostname and the current
+-- hostname.
+--
+-- When provided with a FQDN, also configures /etc/hosts,
+-- with an entry for 127.0.1.1, which is standard at least on Debian
+-- to set the FDQN (127.0.0.1 is localhost).
set :: HostName -> Property
-set hostname = "/etc/hostname" `File.hasContent` [hostname]
- `onChange` cmdProperty "hostname" [hostname]
- `describe` ("hostname " ++ hostname)
+set hostname = combineProperties desc go
+ `onChange` cmdProperty "hostname" [host]
+ where
+ desc = "hostname " ++ hostname
+ (host, domain) = separate (== '.') hostname
+
+ go = catMaybes
+ [ Just $ "/etc/hostname" `File.hasContent` [host]
+ , if null domain
+ then Nothing
+ else Just $ File.fileProperty desc
+ addhostline "/etc/hosts"
+ ]
+
+ hostip = "127.0.1.1"
+ hostline = hostip ++ "\t" ++ hostname ++ " " ++ host
+
+ addhostline ls = hostline : filter (not . hashostip) ls
+ hashostip l = headMaybe (words l) == Just hostip
diff --git a/TODO b/TODO
index a90875fd..3b816ad3 100644
--- a/TODO
+++ b/TODO
@@ -12,3 +12,5 @@
says they are unchanged even when they changed and triggered a
reprovision.
* Should properties be a tree rather than a list?
+* Only make docker garbage collection run once a day or something
+ to avoid GC after a temp fail.
diff --git a/Utility/LinuxMkLibs.hs b/Utility/LinuxMkLibs.hs
new file mode 100644
index 00000000..76e6266d
--- /dev/null
+++ b/Utility/LinuxMkLibs.hs
@@ -0,0 +1,61 @@
+{- Linux library copier and binary shimmer
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.LinuxMkLibs where
+
+import Control.Applicative
+import Data.Maybe
+import System.Directory
+import Data.List.Utils
+import System.Posix.Files
+import Data.Char
+import Control.Monad.IfElse
+
+import Utility.PartialPrelude
+import Utility.Directory
+import Utility.Process
+import Utility.Monad
+import Utility.Path
+
+{- Installs a library. If the library is a symlink to another file,
+ - install the file it links to, and update the symlink to be relative. -}
+installLib :: (FilePath -> FilePath -> IO ()) -> FilePath -> FilePath -> IO (Maybe FilePath)
+installLib installfile top lib = ifM (doesFileExist lib)
+ ( do
+ installfile top lib
+ checksymlink lib
+ return $ Just $ parentDir lib
+ , return Nothing
+ )
+ where
+ checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do
+ l <- readSymbolicLink (inTop top f)
+ let absl = absPathFrom (parentDir f) l
+ let target = relPathDirToFile (parentDir f) absl
+ installfile top absl
+ nukeFile (top ++ f)
+ createSymbolicLink target (inTop top f)
+ checksymlink absl
+
+-- Note that f is not relative, so cannot use </>
+inTop :: FilePath -> FilePath -> FilePath
+inTop top f = top ++ f
+
+{- Parse ldd output, getting all the libraries that the input files
+ - link to. Note that some of the libraries may not exist
+ - (eg, linux-vdso.so) -}
+parseLdd :: String -> [FilePath]
+parseLdd = catMaybes . map (getlib . dropWhile isSpace) . lines
+ where
+ getlib l = headMaybe . words =<< lastMaybe (split " => " l)
+
+{- Get all glibc libs and other support files, including gconv files
+ -
+ - XXX Debian specific. -}
+glibcLibs :: IO [FilePath]
+glibcLibs = lines <$> readProcess "sh"
+ ["-c", "dpkg -L libc6:$(dpkg --print-architecture) libgcc1:$(dpkg --print-architecture) | egrep '\\.so|gconv'"]
diff --git a/config.hs b/config.hs
index ec313725..6cc82063 120000
--- a/config.hs
+++ b/config.hs
@@ -1 +1 @@
-config-simple.hs \ No newline at end of file
+Propellor/Config/Simple.hs \ No newline at end of file
diff --git a/debian/changelog b/debian/changelog
index 09d8492d..f4eadd22 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,12 @@
+propellor (0.2.2) unstable; urgency=medium
+
+ * Now supports provisioning docker containers with architecture/libraries
+ that do not match the host.
+ * Fixed a bug that caused file modes to be set to 600 when propellor
+ modified the file (did not affect newly created files).
+
+ -- Joey Hess <joeyh@debian.org> Fri, 04 Apr 2014 01:07:32 -0400
+
propellor (0.2.1) unstable; urgency=medium
* First release with Debian package.
diff --git a/propellor.cabal b/propellor.cabal
index b06d1071..5d601393 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -1,5 +1,5 @@
Name: propellor
-Version: 0.2.1
+Version: 0.2.2
Cabal-Version: >= 1.6
License: GPL
Maintainer: Joey Hess <joey@kitenet.net>
@@ -14,8 +14,6 @@ Extra-Source-Files:
README.md
TODO
CHANGELOG
- config-simple.hs
- config-joeyh.hs
Makefile
debian/changelog
debian/README.Debian
@@ -64,6 +62,8 @@ Library
Exposed-Modules:
Propellor
+ Propellor.Config.Simple
+ Propellor.Config.Joey
Propellor.Property
Propellor.Property.Apt
Propellor.Property.Cmd
@@ -87,6 +87,7 @@ Library
Other-Modules:
Propellor.CmdLine
Propellor.SimpleSh
+ Propellor.Property.Docker.Shim
Utility.Applicative
Utility.Data
Utility.Directory
@@ -94,6 +95,7 @@ Library
Utility.Exception
Utility.FileMode
Utility.FileSystemEncoding
+ Utility.LinuxMkLibs
Utility.Misc
Utility.Monad
Utility.Path