From 1c381c5246b2836ca0f535b9ac65eddcaa000024 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Apr 2014 21:22:37 -0400 Subject: library shimming for docker (untested) --- Propellor/Property/Docker.hs | 38 +++++++++++++----------- Propellor/Property/Docker/Shim.hs | 52 +++++++++++++++++++++++++++++++++ Utility/LinuxMkLibs.hs | 61 +++++++++++++++++++++++++++++++++++++++ propellor.cabal | 2 ++ 4 files changed, 136 insertions(+), 17 deletions(-) create mode 100644 Propellor/Property/Docker/Shim.hs create mode 100644 Utility/LinuxMkLibs.hs 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 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 + - + - 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/propellor.cabal b/propellor.cabal index b06d1071..c85a3e77 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -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 -- cgit v1.2.3 -- cgit v1.2.3 From 8868b4401057bb6152f628cacff261f9353335cd Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Apr 2014 23:13:05 -0400 Subject: propellor spin --- config-joeyh.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/config-joeyh.hs b/config-joeyh.hs index cb56f4b2..aa0669c7 100644 --- a/config-joeyh.hs +++ b/config-joeyh.hs @@ -85,7 +85,7 @@ image _ = "debian" -- 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 +104,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 -- cgit v1.2.3 From 5499b2a612d9379fc8a3ed3ea2e70165e0bdefad Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Apr 2014 23:16:34 -0400 Subject: propellor spin --- Propellor/Property/Docker/Shim.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/Propellor/Property/Docker/Shim.hs b/Propellor/Property/Docker/Shim.hs index 0e0f55e7..402f1c12 100644 --- a/Propellor/Property/Docker/Shim.hs +++ b/Propellor/Property/Docker/Shim.hs @@ -45,6 +45,7 @@ file propellorbin dest = dest 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] -- cgit v1.2.3 From b254cbbab194c948b270cc6456fc6020ed0c0f49 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Apr 2014 23:30:23 -0400 Subject: propellor spin --- Propellor/Property/Docker.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs index 88adb06d..888e76c6 100644 --- a/Propellor/Property/Docker.hs +++ b/Propellor/Property/Docker.hs @@ -253,7 +253,7 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci go img = do clearProvisionedFlag cid createDirectoryIfMissing True (takeDirectory $ identFile cid) - shim <- Shim.setup "./propellor" (localdir shimdir cid) + shim <- Shim.setup (localdir "propellor") (localdir shimdir cid) writeFile (identFile cid) (show ident) ensureProperty $ boolProperty "run" $ runContainer img (runps ++ ["-i", "-d", "-t"]) @@ -284,7 +284,7 @@ chain s = case toContainerId s of -- Run boot provisioning before starting simpleSh, -- to avoid ever provisioning twice at the same time. whenM (checkProvisionedFlag cid) $ do - let shim = Shim.file "./propellor" (localdir shimdir cid) + 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 @@ -304,7 +304,7 @@ chain s = case toContainerId s of -- 1 minute. provisionContainer :: ContainerId -> Property provisionContainer cid = containerDesc cid $ Property "provision" $ do - let shim = Shim.file "./propellor" (localdir shimdir cid) + let shim = Shim.file (localdir "propellor") (localdir shimdir cid) r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing) when (r /= FailedChange) $ setProvisionedFlag cid -- cgit v1.2.3 From ff49cf562c3761993a22ea6fe6904325a1e53d33 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Apr 2014 23:32:00 -0400 Subject: propellor spin --- Propellor/Property/Hostname.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Propellor/Property/Hostname.hs b/Propellor/Property/Hostname.hs index 25f0e1b2..f5aa5da7 100644 --- a/Propellor/Property/Hostname.hs +++ b/Propellor/Property/Hostname.hs @@ -3,6 +3,9 @@ module Propellor.Property.Hostname where import Propellor import qualified Propellor.Property.File as File +-- | Sets the hostname. Should be provided with a FQDN, and will configure +-- both /etc/hostname (with the base hostname) and /etc/hosts (with the +-- full hostname). Also sets the current hostname. set :: HostName -> Property set hostname = "/etc/hostname" `File.hasContent` [hostname] `onChange` cmdProperty "hostname" [hostname] -- cgit v1.2.3 From fbc57d684509180f518c84469c45e2d85bb20708 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Apr 2014 23:35:36 -0400 Subject: propellor spin --- Propellor/Property/Docker/Shim.hs | 2 +- Propellor/Property/Hostname.hs | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/Propellor/Property/Docker/Shim.hs b/Propellor/Property/Docker/Shim.hs index 402f1c12..a210e162 100644 --- a/Propellor/Property/Docker/Shim.hs +++ b/Propellor/Property/Docker/Shim.hs @@ -40,7 +40,7 @@ setup propellorbin dest = do return shim file :: FilePath -> FilePath -> FilePath -file propellorbin dest = dest propellorbin +file propellorbin dest = dest takeFileName propellorbin installFile :: FilePath -> FilePath -> IO () installFile top f = do diff --git a/Propellor/Property/Hostname.hs b/Propellor/Property/Hostname.hs index f5aa5da7..a2e3c7c6 100644 --- a/Propellor/Property/Hostname.hs +++ b/Propellor/Property/Hostname.hs @@ -10,3 +10,5 @@ set :: HostName -> Property set hostname = "/etc/hostname" `File.hasContent` [hostname] `onChange` cmdProperty "hostname" [hostname] `describe` ("hostname " ++ hostname) + where + (host, domain) = separate (== '.') hostname -- cgit v1.2.3 From 7932c5abec925bfd0240b62290e00977141419e7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Apr 2014 23:57:36 -0400 Subject: propellor spin --- Propellor/Property/Hostname.hs | 30 ++++++++++++++++++++++++------ config-joeyh.hs | 2 +- 2 files changed, 25 insertions(+), 7 deletions(-) diff --git a/Propellor/Property/Hostname.hs b/Propellor/Property/Hostname.hs index a2e3c7c6..44a3b111 100644 --- a/Propellor/Property/Hostname.hs +++ b/Propellor/Property/Hostname.hs @@ -3,12 +3,30 @@ module Propellor.Property.Hostname where import Propellor import qualified Propellor.Property.File as File --- | Sets the hostname. Should be provided with a FQDN, and will configure --- both /etc/hostname (with the base hostname) and /etc/hosts (with the --- full hostname). Also sets the current hostname. +-- | 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 = propertyList desc go + `onChange` cmdProperty "hostname" [host] + `describe` desc 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/config-joeyh.hs b/config-joeyh.hs index aa0669c7..6f8b75c2 100644 --- a/config-joeyh.hs +++ b/config-joeyh.hs @@ -10,7 +10,7 @@ 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 -- cgit v1.2.3 From d19171ed53884c0422b27ccc6aac4960c96ccc7d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Apr 2014 23:59:32 -0400 Subject: propellor spin --- Propellor/Property/Hostname.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/Propellor/Property/Hostname.hs b/Propellor/Property/Hostname.hs index 44a3b111..f710df70 100644 --- a/Propellor/Property/Hostname.hs +++ b/Propellor/Property/Hostname.hs @@ -12,7 +12,6 @@ import qualified Propellor.Property.File as File set :: HostName -> Property set hostname = propertyList desc go `onChange` cmdProperty "hostname" [host] - `describe` desc where desc = "hostname " ++ hostname (host, domain) = separate (== '.') hostname -- cgit v1.2.3 From cf3fc9b8e9a9e93c6784f78e0ba48f518d3003f7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 4 Apr 2014 00:08:30 -0400 Subject: fix file mode bug --- Propellor/Property/File.hs | 12 ++++++++++-- debian/changelog | 9 +++++++++ 2 files changed, 19 insertions(+), 2 deletions(-) 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/debian/changelog b/debian/changelog index 09d8492d..a126e8fb 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,12 @@ +propellor (0.2.2) UNRELEASED; urgency=medium + + * Now supports provisioning docker containers with architecture/libraries + that do not match the outside host. + * Fixed a bug that caused file modes to be set to 600 when propellor + modified the file. + + -- Joey Hess Fri, 04 Apr 2014 00:06:26 -0400 + propellor (0.2.1) unstable; urgency=medium * First release with Debian package. -- cgit v1.2.3 -- cgit v1.2.3 From 3aff9915532ae7256deb982e9c8d05e174249a32 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 4 Apr 2014 00:11:24 -0400 Subject: propellor spin --- Propellor/Property/Hostname.hs | 2 +- config-joeyh.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Propellor/Property/Hostname.hs b/Propellor/Property/Hostname.hs index f710df70..26635374 100644 --- a/Propellor/Property/Hostname.hs +++ b/Propellor/Property/Hostname.hs @@ -10,7 +10,7 @@ import qualified Propellor.Property.File as File -- 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 = propertyList desc go +set hostname = combineProperties desc go `onChange` cmdProperty "hostname" [host] where desc = "hostname " ++ hostname diff --git a/config-joeyh.hs b/config-joeyh.hs index 6f8b75c2..e4a9dcac 100644 --- a/config-joeyh.hs +++ b/config-joeyh.hs @@ -45,7 +45,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 -- cgit v1.2.3 From dd08ae61dbbf01e9ed8a69549b14892057a375bb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 4 Apr 2014 00:18:51 -0400 Subject: propellor spin --- .gitignore | 1 + Propellor/Message.hs | 18 +++++++++++------- 2 files changed, 12 insertions(+), 7 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/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 -- cgit v1.2.3 From ba8a259f24e15c1e1005bed628ceed8e374e963a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 4 Apr 2014 00:29:19 -0400 Subject: propellor spin --- Propellor/Property/Docker/Shim.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/Propellor/Property/Docker/Shim.hs b/Propellor/Property/Docker/Shim.hs index a210e162..7d4f56f6 100644 --- a/Propellor/Property/Docker/Shim.hs +++ b/Propellor/Property/Docker/Shim.hs @@ -29,10 +29,15 @@ setup propellorbin dest = do 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" + , "set GCONV_PATH=" ++ shellEscape gconvdir + , "export GCONV_PATH" , "exec " ++ unwords (map shellEscape $ linker : linkerparams) ++ " " ++ shellEscape propellorbin ++ " \"$@\"" ] -- cgit v1.2.3 From eb8dcfd99513131f95e067d0480164684793b1e9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 4 Apr 2014 00:44:29 -0400 Subject: propellor spin --- Propellor/Property/Docker/Shim.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Propellor/Property/Docker/Shim.hs b/Propellor/Property/Docker/Shim.hs index 7d4f56f6..01c2b22f 100644 --- a/Propellor/Property/Docker/Shim.hs +++ b/Propellor/Property/Docker/Shim.hs @@ -36,7 +36,7 @@ setup propellorbin dest = do let shim = file propellorbin dest writeFile shim $ unlines [ "#!/bin/sh" - , "set GCONV_PATH=" ++ shellEscape gconvdir + , "GCONV_PATH=" ++ shellEscape gconvdir , "export GCONV_PATH" , "exec " ++ unwords (map shellEscape $ linker : linkerparams) ++ " " ++ shellEscape propellorbin ++ " \"$@\"" -- cgit v1.2.3 From ccc82907124ccd2ad4951c2c4946ae20af007530 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 4 Apr 2014 01:12:09 -0400 Subject: update --- Propellor/Config/Joey.hs | 126 ++++++++++++++++++++++++++++++++++++++++++++ Propellor/Config/Simple.hs | 52 +++++++++++++++++++ TODO | 2 + config-joeyh.hs | 127 --------------------------------------------- config-simple.hs | 52 ------------------- config.hs | 2 +- debian/changelog | 8 +-- propellor.cabal | 6 +-- 8 files changed, 188 insertions(+), 187 deletions(-) create mode 100644 Propellor/Config/Joey.hs create mode 100644 Propellor/Config/Simple.hs delete mode 100644 config-joeyh.hs delete mode 100644 config-simple.hs diff --git a/Propellor/Config/Joey.hs b/Propellor/Config/Joey.hs new file mode 100644 index 00000000..530df9a3 --- /dev/null +++ b/Propellor/Config/Joey.hs @@ -0,0 +1,126 @@ +-- | This is the live config file used by propellor's author. + +import Propellor +import Propellor.CmdLine +import qualified Propellor.Property.File as File +import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.Network as Network +import qualified Propellor.Property.Ssh as Ssh +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.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] + +-- | This is where the system's HostName, either as returned by uname +-- or one specified on the command line, is converted into a list of +-- Properties for that system. +-- +-- Edit this to configure propellor! +host :: HostName -> Maybe [Property] +-- Clam is a tor bridge, and an olduse.net shellbox and other fun stuff. +host hostname@"clam.kitenet.net" = standardSystem Unstable $ props + & cleanCloudAtCost hostname + & Apt.unattendedUpgrades + & Network.ipv6to4 + & Apt.installed ["git-annex", "mtr"] + & 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 + & Hostname.set hostname + & Apt.unattendedUpgrades + & Docker.configured + & Apt.buildDep ["git-annex"] + & Docker.docked container hostname "amd64-git-annex-builder" + & Docker.docked container hostname "i386-git-annex-builder" + & Docker.garbageCollected +-- My laptop +host _hostname@"darkstar.kitenet.net" = Just $ props + & Docker.configured + +-- add more hosts here... +--host "foo.example.com" = +host _ = Nothing + +-- | This is where Docker containers are set up. A container +-- can vary by hostname where it's used, or be the same everywhere. +container :: HostName -> Docker.ContainerName -> Maybe (Docker.Container) +container _host name + | name == "webserver" = Just $ Docker.containerFrom + (image $ System (Debian Unstable) "amd64") + [ Docker.publish "8080:80" + , Docker.volume "/var/www:/var/www" + , Docker.inside $ props + & serviceRunning "apache2" + `requires` Apt.installed ["apache2"] + ] + | "-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. +image :: System -> Docker.Image +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 + where + standardprops = propertyList "standard system" $ props + & Apt.stdSourcesList suite `onChange` Apt.upgrade + & Apt.installed ["etckeeper"] + & Apt.installed ["ssh"] + & GitHome.installedFor "root" + & User.hasSomePassword "root" + -- Harden the system, but only once root's authorized_keys + -- is safely in place. + & check (Ssh.hasAuthorizedKeys "root") + (Ssh.passwordAuthentication False) + & User.accountFor "joey" + & User.hasSomePassword "joey" + & Sudo.enabledFor "joey" + & GitHome.installedFor "joey" + & Apt.installed ["vim", "screen", "less"] + & Cron.runPropellor "30 * * * *" + -- I use postfix, or no MTA. + & 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 +cleanCloudAtCost hostname = propertyList "cloudatcost cleanup" + [ Hostname.set hostname + , Ssh.uniqueHostKeys + , "worked around grub/lvm boot bug #743126" ==> + "/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true" + `onChange` cmdProperty "update-grub" [] + `onChange` cmdProperty "update-initramfs" ["-u"] + , combineProperties "nuked cloudatcost cruft" + [ File.notPresent "/etc/rc.local" + , File.notPresent "/etc/init.d/S97-setup.sh" + , User.nuked "user" User.YesReallyDeleteHome + ] + ] diff --git a/Propellor/Config/Simple.hs b/Propellor/Config/Simple.hs new file mode 100644 index 00000000..840bad02 --- /dev/null +++ b/Propellor/Config/Simple.hs @@ -0,0 +1,52 @@ +-- | This is the main configuration file for Propellor, and is used to build +-- the propellor program. + +import Propellor +import Propellor.CmdLine +import qualified Propellor.Property.File as File +import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.Network as Network +import qualified Propellor.Property.Ssh as Ssh +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.Docker as Docker + +main :: IO () +main = defaultMain [host, Docker.containerProperties container] + +-- | This is where the system's HostName, either as returned by uname +-- or one specified on the command line, is converted into a list of +-- Properties for that system. +-- +-- Edit this to configure propellor! +host :: HostName -> Maybe [Property] +host hostname@"mybox.example.com" = Just $ props + & Apt.stdSourcesList Unstable + `onChange` Apt.upgrade + & Apt.unattendedUpgrades + & Apt.installed ["etckeeper"] + & Apt.installed ["ssh"] + & User.hasSomePassword "root" + & Network.ipv6to4 + & File.dirExists "/var/www" + & Docker.docked container hostname "webserver" + & Docker.garbageCollected + & Cron.runPropellor "30 * * * *" +-- add more hosts here... +--host "foo.example.com" = +host _ = Nothing + +-- | This is where Docker containers are set up. A container +-- can vary by hostname where it's used, or be the same everywhere. +container :: HostName -> Docker.ContainerName -> Maybe (Docker.Container) +container _ "webserver" = Just $ Docker.containerFrom "joeyh/debian-unstable" + [ Docker.publish "80:80" + , Docker.volume "/var/www:/var/www" + , Docker.inside $ props + & serviceRunning "apache2" + `requires` Apt.installed ["apache2"] + ] +container _ _ = Nothing 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/config-joeyh.hs b/config-joeyh.hs deleted file mode 100644 index e4a9dcac..00000000 --- a/config-joeyh.hs +++ /dev/null @@ -1,127 +0,0 @@ --- | This is the live config file used by propellor's author. - -import Propellor -import Propellor.CmdLine -import qualified Propellor.Property.File as File -import qualified Propellor.Property.Apt as Apt -import qualified Propellor.Property.Network as Network -import qualified Propellor.Property.Ssh as Ssh -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.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 - -main :: IO () -main = defaultMain [host, Docker.containerProperties container] - --- | This is where the system's HostName, either as returned by uname --- or one specified on the command line, is converted into a list of --- Properties for that system. --- --- Edit this to configure propellor! -host :: HostName -> Maybe [Property] --- Clam is a tor bridge, and an olduse.net shellbox and other fun stuff. -host hostname@"clam.kitenet.net" = standardSystem Unstable $ props - & cleanCloudAtCost hostname - & Apt.unattendedUpgrades - & Network.ipv6to4 - & Apt.installed ["git-annex", "mtr"] - & 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 - & Hostname.set hostname - & Apt.unattendedUpgrades - & Docker.configured - & Apt.buildDep ["git-annex"] - & Docker.docked container hostname "amd64-git-annex-builder" - & Docker.docked container hostname "i386-git-annex-builder" - & Docker.garbageCollected --- My laptop -host _hostname@"darkstar.kitenet.net" = Just $ props - & Docker.configured - --- add more hosts here... ---host "foo.example.com" = -host _ = Nothing - --- | This is where Docker containers are set up. A container --- can vary by hostname where it's used, or be the same everywhere. -container :: HostName -> Docker.ContainerName -> Maybe (Docker.Container) -container _host name - | name == "webserver" = Just $ Docker.containerFrom - (image $ System (Debian Unstable) "amd64") - [ Docker.publish "8080:80" - , Docker.volume "/var/www:/var/www" - , Docker.inside $ props - & serviceRunning "apache2" - `requires` Apt.installed ["apache2"] - ] - | "-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. --- 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" - --- This is my standard system setup -standardSystem :: DebianSuite -> [Property] -> Maybe [Property] -standardSystem suite customprops = Just $ - standardprops : customprops ++ endprops - where - standardprops = propertyList "standard system" $ props - & Apt.stdSourcesList suite `onChange` Apt.upgrade - & Apt.installed ["etckeeper"] - & Apt.installed ["ssh"] - & GitHome.installedFor "root" - & User.hasSomePassword "root" - -- Harden the system, but only once root's authorized_keys - -- is safely in place. - & check (Ssh.hasAuthorizedKeys "root") - (Ssh.passwordAuthentication False) - & User.accountFor "joey" - & User.hasSomePassword "joey" - & Sudo.enabledFor "joey" - & GitHome.installedFor "joey" - & Apt.installed ["vim", "screen", "less"] - & Cron.runPropellor "30 * * * *" - -- I use postfix, or no MTA. - & 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 -cleanCloudAtCost hostname = propertyList "cloudatcost cleanup" - [ Hostname.set hostname - , Ssh.uniqueHostKeys - , "worked around grub/lvm boot bug #743126" ==> - "/etc/default/grub" `File.containsLine` "GRUB_DISABLE_LINUX_UUID=true" - `onChange` cmdProperty "update-grub" [] - `onChange` cmdProperty "update-initramfs" ["-u"] - , combineProperties "nuked cloudatcost cruft" - [ File.notPresent "/etc/rc.local" - , File.notPresent "/etc/init.d/S97-setup.sh" - , User.nuked "user" User.YesReallyDeleteHome - ] - ] diff --git a/config-simple.hs b/config-simple.hs deleted file mode 100644 index 840bad02..00000000 --- a/config-simple.hs +++ /dev/null @@ -1,52 +0,0 @@ --- | This is the main configuration file for Propellor, and is used to build --- the propellor program. - -import Propellor -import Propellor.CmdLine -import qualified Propellor.Property.File as File -import qualified Propellor.Property.Apt as Apt -import qualified Propellor.Property.Network as Network -import qualified Propellor.Property.Ssh as Ssh -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.Docker as Docker - -main :: IO () -main = defaultMain [host, Docker.containerProperties container] - --- | This is where the system's HostName, either as returned by uname --- or one specified on the command line, is converted into a list of --- Properties for that system. --- --- Edit this to configure propellor! -host :: HostName -> Maybe [Property] -host hostname@"mybox.example.com" = Just $ props - & Apt.stdSourcesList Unstable - `onChange` Apt.upgrade - & Apt.unattendedUpgrades - & Apt.installed ["etckeeper"] - & Apt.installed ["ssh"] - & User.hasSomePassword "root" - & Network.ipv6to4 - & File.dirExists "/var/www" - & Docker.docked container hostname "webserver" - & Docker.garbageCollected - & Cron.runPropellor "30 * * * *" --- add more hosts here... ---host "foo.example.com" = -host _ = Nothing - --- | This is where Docker containers are set up. A container --- can vary by hostname where it's used, or be the same everywhere. -container :: HostName -> Docker.ContainerName -> Maybe (Docker.Container) -container _ "webserver" = Just $ Docker.containerFrom "joeyh/debian-unstable" - [ Docker.publish "80:80" - , Docker.volume "/var/www:/var/www" - , Docker.inside $ props - & serviceRunning "apache2" - `requires` Apt.installed ["apache2"] - ] -container _ _ = Nothing diff --git a/config.hs b/config.hs index 65a95f2c..3d5a087a 120000 --- a/config.hs +++ b/config.hs @@ -1 +1 @@ -config-joeyh.hs \ No newline at end of file +Propellor/Config/Joey.hs \ No newline at end of file diff --git a/debian/changelog b/debian/changelog index a126e8fb..f4eadd22 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,11 +1,11 @@ -propellor (0.2.2) UNRELEASED; urgency=medium +propellor (0.2.2) unstable; urgency=medium * Now supports provisioning docker containers with architecture/libraries - that do not match the outside host. + that do not match the host. * Fixed a bug that caused file modes to be set to 600 when propellor - modified the file. + modified the file (did not affect newly created files). - -- Joey Hess Fri, 04 Apr 2014 00:06:26 -0400 + -- Joey Hess Fri, 04 Apr 2014 01:07:32 -0400 propellor (0.2.1) unstable; urgency=medium diff --git a/propellor.cabal b/propellor.cabal index c85a3e77..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 @@ -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 -- cgit v1.2.3