From c3962dcf7db5f4692a45fe0ff9802f819a97e2d7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 19 Nov 2014 01:04:11 -0400 Subject: propellor spin --- debian/changelog | 1 + 1 file changed, 1 insertion(+) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index 1e16fe4a..d29da290 100644 --- a/debian/changelog +++ b/debian/changelog @@ -14,6 +14,7 @@ propellor (0.9.3) UNRELEASED; urgency=medium kernel when necessary. * Avoid outputting color setting sequences when not run on a terminal. * Run remote propellor --spin with a controlling terminal. + * Docker code simplified by using `docker exec`; needs docker 1.2.0. -- Joey Hess Mon, 10 Nov 2014 11:15:27 -0400 -- cgit v1.2.3 From 409e20a69e91397d69be794367ddf3fc9be4ac57 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 19 Nov 2014 01:41:50 -0400 Subject: big 1.0 --- debian/changelog | 2 +- propellor.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index d29da290..e575ddd8 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,4 +1,4 @@ -propellor (0.9.3) UNRELEASED; urgency=medium +propellor (1.0.0) UNRELEASED; urgency=medium * propellor --spin can now be used to update remote hosts, without any central git repository needed. The central git repository is diff --git a/propellor.cabal b/propellor.cabal index d8a2ec40..9a1df40b 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 0.9.3 +Version: 1.0.0 Cabal-Version: >= 1.6 License: BSD3 Maintainer: Joey Hess -- cgit v1.2.3 From dd635e9fcd46b5d311c0e8f54ce56c9fbf47ecfe Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 19 Nov 2014 01:58:35 -0400 Subject: update --- debian/changelog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index e575ddd8..05852463 100644 --- a/debian/changelog +++ b/debian/changelog @@ -9,7 +9,7 @@ propellor (1.0.0) UNRELEASED; urgency=medium * Can be used to configure tor hidden services. Thanks, Félix Sipma. * When multiple gpg keys are added, ensure that the privdata file can be decrypted by all of them. - * Convert GpgKeyId to newtype. + * API: Convert GpgKeyId to newtype. * DigitalOcean.distroKernel property now reboots into the distribution kernel when necessary. * Avoid outputting color setting sequences when not run on a terminal. -- cgit v1.2.3 From 5c34a575c835c061dc68025292e003786f60490e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 19 Nov 2014 02:02:29 -0400 Subject: flag API changes --- debian/changelog | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index 05852463..63adc6fe 100644 --- a/debian/changelog +++ b/debian/changelog @@ -9,7 +9,7 @@ propellor (1.0.0) UNRELEASED; urgency=medium * Can be used to configure tor hidden services. Thanks, Félix Sipma. * When multiple gpg keys are added, ensure that the privdata file can be decrypted by all of them. - * API: Convert GpgKeyId to newtype. + * Convert GpgKeyId to newtype. (API change) * DigitalOcean.distroKernel property now reboots into the distribution kernel when necessary. * Avoid outputting color setting sequences when not run on a terminal. @@ -33,7 +33,7 @@ propellor (0.9.1) unstable; urgency=medium * Docker: Add ability to control when containers restart. * Docker: Default to always restarting containers, so they come back - up after reboots and docker daemon upgrades. + up after reboots and docker daemon upgrades. (API change) * Fix loop when a docker host that does not exist was docked. -- Joey Hess Fri, 24 Oct 2014 09:57:31 -0400 @@ -46,7 +46,7 @@ propellor (0.9.0) unstable; urgency=medium Instead, the os property for a stable system includes the suite name to use, eg Stable "wheezy". * stdSourcesList uses the stable suite name, to avoid unwanted - immediate upgrades to the next stable release. + immediate upgrades to the next stable release. (API change) * debCdn switched from cdn.debian.net to http.debian.net, which seems to be better managed now. * Docker: Avoid committing container every time it's started up. @@ -121,7 +121,7 @@ propellor (0.7.0) unstable; urgency=medium * combineProperties no longer stops when a property fails; now it continues trying to satisfy all properties on the list before propigating the failure. - * Attr is renamed to Info. + * Attr is renamed to Info. (API change) * Renamed wrapper to propellor to make cabal installation of propellor work. * When git gpg signature of a fetched git branch cannot be verified, propellor will now continue running, but without merging in that branch. @@ -134,7 +134,7 @@ propellor (0.6.0) unstable; urgency=medium docked in. So if a docker container sets a DNS alias, every container it's docked in will automatically be added to a DNS round-robin, when propellor is used to manage DNS for the domain. - * Apt.stdSourcesList no longer needs a suite to be specified. + * Apt.stdSourcesList no longer needs a suite to be specified. (API change) * Added --dump to dump out a field of a host's privdata. Useful for editing it. * Propellor's output now includes the hostname being provisioned, or @@ -177,7 +177,7 @@ propellor (0.5.1) unstable; urgency=medium propellor (0.5.0) unstable; urgency=medium * Removed root domain records from SOA. Instead, use RootDomain - when calling Dns.primary. + when calling Dns.primary. (API change) * Dns primary and secondary properties are now revertable. * When unattendedUpgrades is enabled on an Unstable or Testing system, configure it to allow the upgrades. @@ -191,8 +191,9 @@ propellor (0.4.0) unstable; urgency=medium zone files, which is done by looking at the properties of hosts in a domain. * The `cname` property was renamed to `alias` as it does not always - generate CNAME in the DNS. + generate CNAME in the DNS. (API change) * Constructor of Property has changed (use `property` function instead). + (API change) * All Property combinators now combine together their Attr settings. So Attr settings can be made inside a propertyList, for example. * Run all cron jobs under chronic from moreutils to avoid unnecessary @@ -228,7 +229,7 @@ propellor (0.3.0) unstable; urgency=medium * Include security updates in sources.list for stable and testing. * Use ssh connection caching, especially when bootstrapping. * Properties now run in a Propellor monad, which provides access to - attributes of the host. + attributes of the host. (API change) -- Joey Hess Fri, 11 Apr 2014 01:19:05 -0400 -- cgit v1.2.3 From 4a9bbd1391b708d72a455cc00f698a80f1fd5fa5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 19 Nov 2014 19:30:51 -0400 Subject: Added support for using debootstrap from propellor. Most of the hard part was making it be able to install debootstrap from source, for use on non-debian-derived systems. --- debian/changelog | 3 +- propellor.cabal | 1 + src/Propellor/Property.hs | 4 + src/Propellor/Property/Debootstrap.hs | 218 ++++++++++++++++++++++++++++++++++ 4 files changed, 225 insertions(+), 1 deletion(-) create mode 100644 src/Propellor/Property/Debootstrap.hs (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index 63adc6fe..0f4a06af 100644 --- a/debian/changelog +++ b/debian/changelog @@ -15,8 +15,9 @@ propellor (1.0.0) UNRELEASED; urgency=medium * Avoid outputting color setting sequences when not run on a terminal. * Run remote propellor --spin with a controlling terminal. * Docker code simplified by using `docker exec`; needs docker 1.2.0. + * Added support for using debootstrap from propellor. - -- Joey Hess Mon, 10 Nov 2014 11:15:27 -0400 + -- Joey Hess Mon, 10 Nov 2014 11:15:27 -0400 propellor (0.9.2) unstable; urgency=medium diff --git a/propellor.cabal b/propellor.cabal index 9a1df40b..161e4779 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -75,6 +75,7 @@ Library Propellor.Property.Cmd Propellor.Property.Hostname Propellor.Property.Cron + Propellor.Property.Debootstrap Propellor.Property.Dns Propellor.Property.Docker Propellor.Property.File diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 9545979c..7000b2a3 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -131,6 +131,10 @@ boolProperty desc a = property desc $ ifM (liftIO a) revert :: RevertableProperty -> RevertableProperty revert (RevertableProperty p1 p2) = RevertableProperty p2 p1 +-- | Turns a revertable property into a regular property. +unrevertable :: RevertableProperty -> Property +unrevertable (RevertableProperty p1 _p2) = p1 + -- | Starts accumulating the properties of a Host. -- -- > host "example.com" diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs new file mode 100644 index 00000000..8f93fe5b --- /dev/null +++ b/src/Propellor/Property/Debootstrap.hs @@ -0,0 +1,218 @@ +module Propellor.Property.Debootstrap ( + Url, + debootstrapped, + installed, + debootstrapPath, +) where + +import Propellor +import qualified Propellor.Property.Apt as Apt +import Utility.Path +import Utility.SafeCommand +import Utility.FileMode + +import Data.List +import Data.Char +import Control.Exception +import System.Posix.Directory + +type Url = String + +-- | Builds a chroot in the given directory using debootstrap. +-- +-- The System can be any OS and architecture that debootstrap +-- and the kernel support. +debootstrapped :: FilePath -> System -> [CommandParam] -> Property +debootstrapped target system@(System _ arch) extraparams = + check (unpopulated target) prop + `requires` unrevertable installed + where + unpopulated d = null <$> catchDefaultIO [] (dirContents d) + + prop = property ("debootstrapped " ++ target) $ liftIO $ do + createDirectoryIfMissing True target + let suite = case extractSuite system of + Nothing -> error $ "don't know how to debootstrap " ++ show system + Just s -> s + let params = extraparams ++ + [ Param suite + , Param target + , Param $ "--arch=" ++ arch + ] + cmd <- fromMaybe "debootstrap" <$> debootstrapPath + ifM (boolSystem cmd params) + ( do + fixForeignDev target + return MadeChange + , return FailedChange + ) + +extractSuite :: System -> Maybe String +extractSuite (System (Debian s) _) = Just $ Apt.showSuite s +extractSuite (System (Ubuntu r) _) = Just r + +-- | Ensures debootstrap is installed. +-- +-- When necessary, falls back to installing debootstrap from source. +-- Note that installation from source is done by downloading the tarball +-- from a Debian mirror, with no cryptographic verification. +installed :: RevertableProperty +installed = RevertableProperty install remove + where + install = withOS "debootstrap installed" $ \o -> + ifM (liftIO $ isJust <$> debootstrapPath) + ( return NoChange + , ensureProperty (installon o) + ) + + installon (Just (System (Debian _) _)) = aptinstall + installon (Just (System (Ubuntu _) _)) = aptinstall + installon _ = sourceInstall + + remove = withOS "debootstrap removed" $ ensureProperty . removefrom + removefrom (Just (System (Debian _) _)) = aptremove + removefrom (Just (System (Ubuntu _) _)) = aptremove + removefrom _ = sourceRemove + + aptinstall = Apt.installed ["debootstrap"] + aptremove = Apt.removed ["debootstrap"] + +sourceInstall :: Property +sourceInstall = property "debootstrap installed from source" + (liftIO sourceInstall') + +sourceInstall' :: IO Result +sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do + let indexfile = tmpd "index.html" + unlessM (download baseurl indexfile) $ + error $ "Failed to download " ++ baseurl + urls <- reverse . sort -- highest version first + . filter ("debootstrap_" `isInfixOf`) + . filter (".tar." `isInfixOf`) + . extractUrls baseurl <$> + readFileStrictAnyEncoding indexfile + nukeFile indexfile + + tarfile <- case urls of + (tarurl:_) -> do + let f = tmpd takeFileName tarurl + unlessM (download tarurl f) $ + error $ "Failed to download " ++ tarurl + return f + _ -> error $ "Failed to find any debootstrap tarballs listed on " ++ baseurl + + createDirectoryIfMissing True localInstallDir + bracket getWorkingDirectory changeWorkingDirectory $ \_ -> do + changeWorkingDirectory localInstallDir + unlessM (boolSystem "tar" [Param "xf", File tarfile]) $ + error "Failed to extract debootstrap tar file" + nukeFile tarfile + l <- dirContents "." + case l of + (subdir:[]) -> do + changeWorkingDirectory subdir + makeDevicesTarball + makeWrapperScript (localInstallDir subdir) + return MadeChange + _ -> error "debootstrap tar file did not contain exactly one dirctory" + +sourceRemove :: Property +sourceRemove = property "debootstrap not installed from source" $ liftIO $ + ifM (doesDirectoryExist sourceInstallDir) + ( do + removeDirectoryRecursive sourceInstallDir + return MadeChange + , return NoChange + ) + +sourceInstallDir :: FilePath +sourceInstallDir = "/usr/local/propellor/debootstrap" + +wrapperScript :: FilePath +wrapperScript = sourceInstallDir "debootstrap.wrapper" + +-- | Finds debootstrap in PATH, but fall back to looking for the +-- wrapper script that is installed, outside the PATH, when debootstrap +-- is installed from source. +debootstrapPath :: IO (Maybe FilePath) +debootstrapPath = getM searchPath + [ "debootstrap" + , wrapperScript + ] + +makeWrapperScript :: FilePath -> IO () +makeWrapperScript dir = do + createDirectoryIfMissing True (takeDirectory wrapperScript) + writeFile wrapperScript $ unlines + [ "#!/bin/sh" + , "set -e" + , "DEBOOTSTRAP_DIR=" ++ dir + , "export DEBOOTSTRAP_DIR" + , dir "debootstrap" ++ " \"$@\"" + ] + modifyFileMode wrapperScript (addModes $ readModes ++ executeModes) + +-- Work around for http://bugs.debian.org/770217 +makeDevicesTarball :: IO () +makeDevicesTarball = do + -- TODO append to tarball; avoid writing to /dev + writeFile foreignDevFlag "1" + ok <- boolSystem "sh" [Param "-c", Param tarcmd] + nukeFile foreignDevFlag + unless ok $ + error "Failed to tar up /dev to generate devices.tar.gz" + where + tarcmd = "(cd / && tar cf - dev) | gzip > devices.tar.gz" + +fixForeignDev :: FilePath -> IO () +fixForeignDev target = whenM (doesFileExist (target ++ foreignDevFlag)) $ + void $ boolSystem "chroot" + [ File target + , Param "sh" + , Param "-c" + , Param $ intercalate " && " + [ "rm -rf /dev" + , "mkdir /dev" + , "cd /dev" + , "/sbin/MAKEDEV std ptmx fd consoleonly" + ] + ] + +foreignDevFlag :: FilePath +foreignDevFlag = "/dev/.propellor-foreign-dev" + +localInstallDir :: FilePath +localInstallDir = "/usr/local/debootstrap" + +-- This http server directory listing is relied on to be fairly sane, +-- which is one reason why it's using a specific server and not a +-- round-robin address. +baseurl :: Url +baseurl = "http://ftp.debian.org/debian/pool/main/d/debootstrap/" + +download :: Url -> FilePath -> IO Bool +download url dest = anyM id + [ boolSystem "curl" [Param "-o", File dest, Param url] + , boolSystem "wget" [Param "-O", File dest, Param url] + ] + +-- Pretty hackish, but I don't want to pull in a whole html parser +-- or parsec dependency just for this. +-- +-- To simplify parsing, lower case everything. This is ok because +-- the filenames are all lower-case anyway. +extractUrls :: Url -> String -> [Url] +extractUrls base = collect [] . map toLower + where + collect l [] = l + collect l ('h':'r':'e':'f':'=':r) = case r of + ('"':r') -> findend l r' + _ -> findend l r + collect l (_:cs) = collect l cs + + findend l s = + let (u, r) = break (== '"') s + u' = if "http" `isPrefixOf` u + then u + else base u + in collect (u':l) r -- cgit v1.2.3 From 41b10a956a8706724ab6503e43c8dddb5821ba9d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 19 Nov 2014 21:25:55 -0400 Subject: correct version --- debian/changelog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index 0f4a06af..83958a16 100644 --- a/debian/changelog +++ b/debian/changelog @@ -14,7 +14,7 @@ propellor (1.0.0) UNRELEASED; urgency=medium kernel when necessary. * Avoid outputting color setting sequences when not run on a terminal. * Run remote propellor --spin with a controlling terminal. - * Docker code simplified by using `docker exec`; needs docker 1.2.0. + * Docker code simplified by using `docker exec`; needs docker 1.3.1. * Added support for using debootstrap from propellor. -- Joey Hess Mon, 10 Nov 2014 11:15:27 -0400 -- cgit v1.2.3 From d49d2518979c7b985af8f00741f2a91bcd511024 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 19 Nov 2014 23:11:34 -0400 Subject: separate docker container type Docker containers are now a separate data type, cannot be included in the main host list, and are instead passed to Docker.docked. (API change) --- config-joey.hs | 111 ++++++++++----------- config-simple.hs | 19 ++-- debian/changelog | 3 + src/Propellor/Property.hs | 33 +++--- src/Propellor/Property/Docker.hs | 63 +++++------- .../Property/SiteSpecific/GitAnnexBuilder.hs | 10 +- src/Propellor/Types/Info.hs | 14 +-- 7 files changed, 117 insertions(+), 136 deletions(-) (limited to 'debian') diff --git a/config-joey.hs b/config-joey.hs index 2866e797..d6f174dc 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -45,7 +45,7 @@ hosts = -- (o) ` , kite , diatom , elephant - ] ++ containers ++ monsters + ] ++ monsters darkstar :: Host darkstar = host "darkstar.kitenet.net" @@ -53,8 +53,7 @@ darkstar = host "darkstar.kitenet.net" & Apt.buildDep ["git-annex"] `period` Daily & Docker.configured - ! Docker.docked hosts "android-git-annex" - ! Docker.docked hosts "simple-debian" + ! Docker.docked gitAnnexAndroidDev clam :: Host clam = standardSystem "clam.kitenet.net" Unstable "amd64" @@ -69,7 +68,7 @@ clam = standardSystem "clam.kitenet.net" Unstable "amd64" & Docker.configured & Docker.garbageCollected `period` Daily - & Docker.docked hosts "webserver" + & Docker.docked webserver & File.dirExists "/var/www/html" & File.notPresent "/var/www/html/index.html" & "/var/www/index.html" `File.hasContent` ["hello, world"] @@ -91,11 +90,11 @@ orca = standardSystem "orca.kitenet.net" Unstable "amd64" & Apt.unattendedUpgrades & Postfix.satellite & Docker.configured - & Docker.docked hosts "amd64-git-annex-builder" - & Docker.docked hosts "i386-git-annex-builder" - & Docker.docked hosts "android-git-annex-builder" - & Docker.docked hosts "armel-git-annex-builder-companion" - & Docker.docked hosts "armel-git-annex-builder" + & Docker.docked (GitAnnexBuilder.standardAutoBuilderContainer dockerImage "amd64" 15 "2h") + & Docker.docked (GitAnnexBuilder.standardAutoBuilderContainer dockerImage "i386" 45 "2h") + & Docker.docked (GitAnnexBuilder.armelCompanionContainer dockerImage) + & Docker.docked (GitAnnexBuilder.armelAutoBuilderContainer dockerImage "1 3 * * *" "5h") + & Docker.docked (GitAnnexBuilder.androidAutoBuilderContainer dockerImage "1 1 * * *" "3h") & Docker.garbageCollected `period` Daily & Apt.buildDep ["git-annex"] `period` Daily @@ -258,11 +257,10 @@ elephant = standardSystem "elephant.kitenet.net" Unstable "amd64" & myDnsSecondary & Docker.configured - & Docker.docked hosts "oldusenet-shellbox" - & Docker.docked hosts "openid-provider" + & Docker.docked oldusenetShellBox + & Docker.docked openidProvider `requires` Apt.serviceInstalledRunning "ntp" - & Docker.docked hosts "ancient-kitenet" - + & Docker.docked ancientKitenet & Docker.garbageCollected `period` (Weekly (Just 1)) -- For https port 443, shellinabox with ssh login to @@ -284,52 +282,43 @@ elephant = standardSystem "elephant.kitenet.net" Unstable "amd64" ----------------------- : / ----------------------- ------------------------ \____, o ,' ------------------------ ------------------------- '--,___________,' ------------------------- -containers :: [Host] -containers = - -- Simple web server, publishing the outside host's /var/www - [ standardStableContainer "webserver" - & Docker.publish "80:80" - & Docker.volume "/var/www:/var/www" - & Apt.serviceInstalledRunning "apache2" - - -- My own openid provider. Uses php, so containerized for security - -- and administrative sanity. - , standardStableContainer "openid-provider" - & alias "openid.kitenet.net" - & Docker.publish "8081:80" - & OpenId.providerFor ["joey", "liw"] - "openid.kitenet.net:8081" - - -- Exhibit: kite's 90's website. - , standardStableContainer "ancient-kitenet" - & alias "ancient.kitenet.net" - & Docker.publish "1994:80" - & Apt.serviceInstalledRunning "apache2" - & Git.cloned "root" "git://kitenet-net.branchable.com/" "/var/www" - (Just "remotes/origin/old-kitenet.net") - - , standardStableContainer "oldusenet-shellbox" - & alias "shell.olduse.net" - & Docker.publish "4200:4200" - & JoeySites.oldUseNetShellBox - - , Docker.container "simple-debian" "debian" - & "/hello" `File.containsLine` "hello" - & Docker.publish "8081:80" - - -- git-annex autobuilder containers - , GitAnnexBuilder.standardAutoBuilderContainer dockerImage "amd64" 15 "2h" - , GitAnnexBuilder.standardAutoBuilderContainer dockerImage "i386" 45 "2h" - , GitAnnexBuilder.armelCompanionContainer dockerImage - , GitAnnexBuilder.armelAutoBuilderContainer dockerImage "1 3 * * *" "5h" - , GitAnnexBuilder.androidAutoBuilderContainer dockerImage "1 1 * * *" "3h" - - -- for development of git-annex for android, using my git-annex - -- work tree - , let gitannexdir = GitAnnexBuilder.homedir "git-annex" - in GitAnnexBuilder.androidContainer dockerImage "android-git-annex" doNothing gitannexdir - & Docker.volume ("/home/joey/src/git-annex:" ++ gitannexdir) - ] +-- Simple web server, publishing the outside host's /var/www +webserver :: Docker.Container +webserver = standardStableContainer "webserver" + & Docker.publish "80:80" + & Docker.volume "/var/www:/var/www" + & Apt.serviceInstalledRunning "apache2" + +-- My own openid provider. Uses php, so containerized for security +-- and administrative sanity. +openidProvider :: Docker.Container +openidProvider = standardStableContainer "openid-provider" + & alias "openid.kitenet.net" + & Docker.publish "8081:80" + & OpenId.providerFor ["joey", "liw"] + "openid.kitenet.net:8081" + +-- Exhibit: kite's 90's website. +ancientKitenet :: Docker.Container +ancientKitenet = standardStableContainer "ancient-kitenet" + & alias "ancient.kitenet.net" + & Docker.publish "1994:80" + & Apt.serviceInstalledRunning "apache2" + & Git.cloned "root" "git://kitenet-net.branchable.com/" "/var/www" + (Just "remotes/origin/old-kitenet.net") + +oldusenetShellBox :: Docker.Container +oldusenetShellBox = standardStableContainer "oldusenet-shellbox" + & alias "shell.olduse.net" + & Docker.publish "4200:4200" + & JoeySites.oldUseNetShellBox + +-- for development of git-annex for android, using my git-annex work tree +gitAnnexAndroidDev :: Docker.Container +gitAnnexAndroidDev = GitAnnexBuilder.androidContainer dockerImage "android-git-annex" doNothing gitannexdir + & Docker.volume ("/home/joey/src/git-annex:" ++ gitannexdir) + where + gitannexdir = GitAnnexBuilder.homedir "git-annex" type Motd = [String] @@ -363,11 +352,11 @@ standardSystemUnhardened hn suite arch motd = host hn & Apt.removed ["exim4", "exim4-daemon-light", "exim4-config", "exim4-base"] `onChange` Apt.autoRemove -standardStableContainer :: Docker.ContainerName -> Host +standardStableContainer :: Docker.ContainerName -> Docker.Container standardStableContainer name = standardContainer name (Stable "wheezy") "amd64" -- This is my standard container setup, featuring automatic upgrades. -standardContainer :: Docker.ContainerName -> DebianSuite -> Architecture -> Host +standardContainer :: Docker.ContainerName -> DebianSuite -> Architecture -> Docker.Container standardContainer name suite arch = Docker.container name (dockerImage system) & os system & Apt.stdSourcesList `onChange` Apt.upgrade diff --git a/config-simple.hs b/config-simple.hs index dcdc51a3..fb02e279 100644 --- a/config-simple.hs +++ b/config-simple.hs @@ -32,18 +32,19 @@ hosts = & User.hasSomePassword "root" (Context "mybox.example.com") & Network.ipv6to4 & File.dirExists "/var/www" - & Docker.docked hosts "webserver" + & Docker.docked webserverContainer & Docker.garbageCollected `period` Daily & Cron.runPropellor "30 * * * *" - -- A generic webserver in a Docker container. - , Docker.container "webserver" "joeyh/debian-stable" - & os (System (Debian (Stable "wheezy")) "amd64") - & Apt.stdSourcesList - & Docker.publish "80:80" - & Docker.volume "/var/www:/var/www" - & Apt.serviceInstalledRunning "apache2" - -- add more hosts here... --, host "foo.example.com" = ... ] + +-- A generic webserver in a Docker container. +webserverContainer :: Docker.Container +webserverContainer = Docker.container "webserver" "joeyh/debian-stable" + & os (System (Debian (Stable "wheezy")) "amd64") + & Apt.stdSourcesList + & Docker.publish "80:80" + & Docker.volume "/var/www:/var/www" + & Apt.serviceInstalledRunning "apache2" diff --git a/debian/changelog b/debian/changelog index 83958a16..155d5124 100644 --- a/debian/changelog +++ b/debian/changelog @@ -15,6 +15,9 @@ propellor (1.0.0) UNRELEASED; urgency=medium * Avoid outputting color setting sequences when not run on a terminal. * Run remote propellor --spin with a controlling terminal. * Docker code simplified by using `docker exec`; needs docker 1.3.1. + * Docker containers are now a separate data type, cannot be included + in the main host list, and are instead passed to + Docker.docked. (API change) * Added support for using debootstrap from propellor. -- Joey Hess Mon, 10 Nov 2014 11:15:27 -0400 diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 7000b2a3..bf69ff60 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -144,27 +144,28 @@ unrevertable (RevertableProperty p1 _p2) = p1 host :: HostName -> Host host hn = Host hn [] mempty --- | Adds a property to a Host --- --- Can add Properties and RevertableProperties -(&) :: IsProp p => Host -> p -> Host -(Host hn ps is) & p = Host hn (ps ++ [toProp p]) (is <> getInfo p) - -infixl 1 & +class Hostlike h where + -- | Adds a property to a Host + -- + -- Can add Properties and RevertableProperties + (&) :: IsProp p => h -> p -> h + -- | Like (&), but adds the property as the + -- first property of the host. Normally, property + -- order should not matter, but this is useful + -- when it does. + (&^) :: IsProp p => h -> p -> h + +instance Hostlike Host where + (Host hn ps is) & p = Host hn (ps ++ [toProp p]) (is <> getInfo p) + (Host hn ps is) &^ p = Host hn ([toProp p] ++ ps) (getInfo p <> is) -- | Adds a property to the Host in reverted form. -(!) :: Host -> RevertableProperty -> Host +(!) :: Hostlike h => h -> RevertableProperty -> h h ! p = h & revert p -infixl 1 ! - --- | Like (&), but adds the property as the first property of the host. --- Normally, property order should not matter, but this is useful --- when it does. -(&^) :: IsProp p => Host -> p -> Host -(Host hn ps is) &^ p = Host hn ([toProp p] ++ ps) (getInfo p <> is) - infixl 1 &^ +infixl 1 & +infixl 1 ! -- Changes the action that is performed to satisfy a property. adjustProperty :: Property -> (Propellor Result -> Propellor Result) -> Property diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 96405108..ce9fb7d7 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -16,6 +16,7 @@ module Propellor.Property.Docker ( tweaked, Image, ContainerName, + Container, -- * Container configuration dns, hostname, @@ -71,55 +72,60 @@ configured = prop `requires` installed -- only [a-zA-Z0-9_-] are allowed type ContainerName = String --- | Starts accumulating the properties of a Docker container. +-- | A docker container. +data Container = Container Image Host + +instance Hostlike Container where + (Container i h) & p = Container i (h & p) + (Container i h) &^ p = Container i (h &^ p) + +-- | Builds a Container with a given name, image, and properties. -- -- > container "web-server" "debian" -- > & publish "80:80" -- > & Apt.installed {"apache2"] -- > & ... -container :: ContainerName -> Image -> Host -container cn image = Host hn [] info +container :: ContainerName -> Image -> Container +container cn image = Container image (Host hn [] info) where - info = dockerInfo $ mempty { _dockerImage = Val image } + info = dockerInfo mempty hn = cn2hn cn cn2hn :: ContainerName -> HostName cn2hn cn = cn ++ ".docker" --- | Ensures that a docker container is set up and running, finding --- its configuration in the passed list of hosts. +-- | Ensures that a docker container is set up and running. -- -- The container has its own Properties which are handled by running -- propellor inside the container. -- -- When the container's Properties include DNS info, such as a CNAME, --- that is propigated to the Info of the host(s) it's docked in. +-- that is propigated to the Info of the Host it's docked in. -- -- Reverting this property ensures that the container is stopped and -- removed. docked - :: [Host] - -> ContainerName + :: Container -> RevertableProperty -docked hosts cn = RevertableProperty - ((maybe id propigateInfo mhost) (go "docked" setup)) +docked ctr@(Container _ h) = RevertableProperty + (propigateInfo h (go "docked" setup)) (go "undocked" teardown) where + cn = hostName h + go desc a = property (desc ++ " " ++ cn) $ do hn <- asks hostName let cid = ContainerId hn cn - ensureProperties [findContainer mhost cid cn $ a cid] - - mhost = findHostNoAlias hosts (cn2hn cn) + ensureProperties [a cid (mkContainerInfo cid ctr)] - setup cid (Container image runparams) = + setup cid (ContainerInfo image runparams) = provisionContainer cid `requires` runningContainer cid image runparams `requires` installed - teardown cid (Container image _runparams) = + teardown cid (ContainerInfo image _runparams) = combineProperties ("undocked " ++ fromContainerId cid) [ stoppedContainer cid , property ("cleaned up " ++ fromContainerId cid) $ @@ -136,26 +142,11 @@ propigateInfo (Host _ _ containerinfo) p = dnsprops = map addDNS (S.toList $ _dns containerinfo) privprops = map addPrivDataField (S.toList $ _privDataFields containerinfo) -findContainer - :: Maybe Host - -> ContainerId - -> ContainerName - -> (Container -> Property) - -> Property -findContainer mhost cid cn mk = case mhost of - Nothing -> cantfind - Just h -> maybe cantfind mk (mkContainer cid h) - where - cantfind = containerDesc cid $ property "" $ do - liftIO $ warningMessage $ - "missing definition for docker container \"" ++ cn2hn cn - return FailedChange - -mkContainer :: ContainerId -> Host -> Maybe Container -mkContainer cid@(ContainerId hn _cn) h = Container - <$> fromVal (_dockerImage info) - <*> pure (map (\mkparam -> mkparam hn) (_dockerRunParams info)) +mkContainerInfo :: ContainerId -> Container -> ContainerInfo +mkContainerInfo cid@(ContainerId hn _cn) (Container img h) = + ContainerInfo img runparams where + runparams = map (\mkparam -> mkparam hn) (_dockerRunParams info) info = _dockerinfo $ hostInfo h' h' = h -- Restart by default so container comes up on @@ -209,7 +200,7 @@ memoryLimited = "/etc/default/grub" `File.containsLine` cfg cmdline = "cgroup_enable=memory swapaccount=1" cfg = "GRUB_CMDLINE_LINUX_DEFAULT=\""++cmdline++"\"" -data Container = Container Image [RunParam] +data ContainerInfo = ContainerInfo Image [RunParam] -- | Parameters to pass to `docker run` when creating a container. type RunParam = String diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index 901eba2e..0208dea6 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -88,7 +88,7 @@ cabalDeps = flagFile go cabalupdated go = userScriptProperty builduser ["cabal update && cabal install git-annex --only-dependencies || true"] cabalupdated = homedir ".cabal" "packages" "hackage.haskell.org" "00-index.cache" -standardAutoBuilderContainer :: (System -> Docker.Image) -> Architecture -> Int -> TimeOut -> Host +standardAutoBuilderContainer :: (System -> Docker.Image) -> Architecture -> Int -> TimeOut -> Docker.Container standardAutoBuilderContainer dockerImage arch buildminute timeout = Docker.container (arch ++ "-git-annex-builder") (dockerImage $ System (Debian Testing) arch) & os (System (Debian Testing) arch) @@ -101,14 +101,14 @@ standardAutoBuilderContainer dockerImage arch buildminute timeout = Docker.conta & autobuilder arch (show buildminute ++ " * * * *") timeout & Docker.tweaked -androidAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host +androidAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Docker.Container androidAutoBuilderContainer dockerImage crontimes timeout = androidContainer dockerImage "android-git-annex-builder" (tree "android") builddir & Apt.unattendedUpgrades & autobuilder "android" crontimes timeout -- Android is cross-built in a Debian i386 container, using the Android NDK. -androidContainer :: (System -> Docker.Image) -> Docker.ContainerName -> Property -> FilePath -> Host +androidContainer :: (System -> Docker.Image) -> Docker.ContainerName -> Property -> FilePath -> Docker.Container androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.container name (dockerImage osver) & os osver @@ -137,7 +137,7 @@ androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.containe -- armel builder has a companion container using amd64 that -- runs the build first to get TH splices. They need -- to have the same versions of all haskell libraries installed. -armelCompanionContainer :: (System -> Docker.Image) -> Host +armelCompanionContainer :: (System -> Docker.Image) -> Docker.Container armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder-companion" (dockerImage $ System (Debian Unstable) "amd64") & os (System (Debian Testing) "amd64") @@ -156,7 +156,7 @@ armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder- & Ssh.authorizedKeys builduser (Context "armel-git-annex-builder") & Docker.tweaked -armelAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Host +armelAutoBuilderContainer :: (System -> Docker.Image) -> Cron.CronTimes -> TimeOut -> Docker.Container armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "armel-git-annex-builder" (dockerImage $ System (Debian Unstable) "armel") & os (System (Debian Testing) "armel") diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs index de072aa0..6aba1f9f 100644 --- a/src/Propellor/Types/Info.hs +++ b/src/Propellor/Types/Info.hs @@ -45,26 +45,22 @@ fromVal (Val a) = Just a fromVal NoVal = Nothing data DockerInfo = DockerInfo - { _dockerImage :: Val String - , _dockerRunParams :: [HostName -> String] + { _dockerRunParams :: [HostName -> String] } instance Eq DockerInfo where x == y = and - [ _dockerImage x == _dockerImage y - , let simpl v = map (\a -> a "") (_dockerRunParams v) + [ let simpl v = map (\a -> a "") (_dockerRunParams v) in simpl x == simpl y ] instance Monoid DockerInfo where - mempty = DockerInfo mempty mempty + mempty = DockerInfo mempty mappend old new = DockerInfo - { _dockerImage = _dockerImage old <> _dockerImage new - , _dockerRunParams = _dockerRunParams old <> _dockerRunParams new + { _dockerRunParams = _dockerRunParams old <> _dockerRunParams new } instance Show DockerInfo where show a = unlines - [ "docker image " ++ show (_dockerImage a) - , "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a)) + [ "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a)) ] -- cgit v1.2.3