From e661aad6c493e31b6bd8109ca3d5c90bec28626a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 22 May 2015 13:34:20 -0400 Subject: merge --- src/Propellor/Property/SiteSpecific/IABak.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/SiteSpecific/IABak.hs b/src/Propellor/Property/SiteSpecific/IABak.hs index fc56de85..fe2de7c8 100644 --- a/src/Propellor/Property/SiteSpecific/IABak.hs +++ b/src/Propellor/Property/SiteSpecific/IABak.hs @@ -63,12 +63,14 @@ graphiteServer = propertyList "iabak graphite server" $ props [ "[carbon]" , "pattern = ^carbon\\." , "retentions = 60:90d" - , "[iabak]" + , "[iabak-connections]" + , "pattern = ^iabak\\.shardstats\\.connections" + , "retentions = 1h:1y,3h:10y" + , "[iabak-default]" , "pattern = ^iabak\\." - , "retentions = 10m:30d,1h:1y,3h,10y" + , "retentions = 10m:30d,1h:1y,3h:10y" , "[default_1min_for_1day]" , "pattern = .*" - , "retentions = 60s:1d" ] & graphiteCSRF & cmdProperty "graphite-manage" ["syncdb", "--noinput"] `flagFile` "/etc/flagFiles/graphite-syncdb" -- cgit v1.2.3 From 56fe313887dcc5af202e0f8efcf001a8418132e5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 22 May 2015 14:50:23 -0400 Subject: propellor spin --- src/Propellor/Property/SiteSpecific/IABak.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/SiteSpecific/IABak.hs b/src/Propellor/Property/SiteSpecific/IABak.hs index fe2de7c8..85e62477 100644 --- a/src/Propellor/Property/SiteSpecific/IABak.hs +++ b/src/Propellor/Property/SiteSpecific/IABak.hs @@ -33,7 +33,7 @@ gitServer knownhosts = propertyList "iabak git server" $ props & cmdProperty "ln" ["-sf", "/usr/local/IA.BAK/pushme.cgi", "/usr/lib/cgi-bin/pushme.cgi"] & File.containsLine "/etc/sudoers" "www-data ALL=NOPASSWD:/usr/local/IA.BAK/pushed.sh" & Cron.niceJob "shardstats" (Cron.Times "*/30 * * * *") (User "root") "/" - "/usr/local/IA.BAK/shardstats-all" + "/usr/local/IA.BAK/shardmaint-fast; /usr/local/IA.BAK/shardstats-all" & Cron.niceJob "shardmaint" Cron.Daily (User "root") "/" "/usr/local/IA.BAK/shardmaint" -- cgit v1.2.3 From ff01339b8cf8bc812e9dd93519d065066ffba117 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 22 May 2015 15:49:30 -0400 Subject: propellor spin --- src/Propellor/Property/SiteSpecific/IABak.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/SiteSpecific/IABak.hs b/src/Propellor/Property/SiteSpecific/IABak.hs index 85e62477..8ed3b38f 100644 --- a/src/Propellor/Property/SiteSpecific/IABak.hs +++ b/src/Propellor/Property/SiteSpecific/IABak.hs @@ -33,9 +33,9 @@ gitServer knownhosts = propertyList "iabak git server" $ props & cmdProperty "ln" ["-sf", "/usr/local/IA.BAK/pushme.cgi", "/usr/lib/cgi-bin/pushme.cgi"] & File.containsLine "/etc/sudoers" "www-data ALL=NOPASSWD:/usr/local/IA.BAK/pushed.sh" & Cron.niceJob "shardstats" (Cron.Times "*/30 * * * *") (User "root") "/" - "/usr/local/IA.BAK/shardmaint-fast; /usr/local/IA.BAK/shardstats-all" + "/usr/local/IA.BAK/shardstats-all" & Cron.niceJob "shardmaint" Cron.Daily (User "root") "/" - "/usr/local/IA.BAK/shardmaint" + "/usr/local/IA.BAK/shardmaint-fast; /usr/local/IA.BAK/shardmaint" registrationServer :: [Host] -> Property HasInfo registrationServer knownhosts = propertyList "iabak registration server" $ props -- cgit v1.2.3 From b68b9ee16521967365bb18e4db375d27bb7859e0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 24 May 2015 16:38:18 -0400 Subject: propellor spin --- src/Propellor/Property/SiteSpecific/JoeySites.hs | 1 - 1 file changed, 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs index 36808919..89b8b46d 100644 --- a/src/Propellor/Property/SiteSpecific/JoeySites.hs +++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs @@ -30,7 +30,6 @@ scrollBox = propertyList "scroll server" $ props "libghc-bytestring-dev", "libghc-mtl-dev", "libghc-ncurses-dev", "libghc-random-dev", "libghc-monad-loops-dev", "libghc-text-dev", "libghc-ifelse-dev", "libghc-case-insensitive-dev", - "libghc-transformers-dev", "libghc-data-default-dev", "libghc-optparse-applicative-dev"] & userScriptProperty (User "scroll") [ "cd " ++ d "scroll" -- cgit v1.2.3 From 3a99c87cdfbbae4cfa31fff5e20c39bfcfdc0aae Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 24 May 2015 17:12:17 -0400 Subject: remove unnecessary use of ensureProperty --- src/Propellor/Property/Docker.hs | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index fdc312ce..3b8751f3 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -426,16 +426,14 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope retry (n-1) a _ -> return v - go img = do - liftIO $ do - clearProvisionedFlag cid - createDirectoryIfMissing True (takeDirectory $ identFile cid) - shim <- liftIO $ Shim.setup (localdir "propellor") Nothing (localdir shimdir cid) - liftIO $ writeFile (identFile cid) (show ident) - ensureProperty $ property "run" $ liftIO $ - toResult <$> runContainer img - (runps ++ ["-i", "-d", "-t"]) - [shim, "--continue", show (DockerInit (fromContainerId cid))] + go img = liftIO $ do + clearProvisionedFlag cid + createDirectoryIfMissing True (takeDirectory $ identFile cid) + shim <- Shim.setup (localdir "propellor") Nothing (localdir shimdir cid) + writeFile (identFile cid) (show ident) + toResult <$> runContainer img + (runps ++ ["-i", "-d", "-t"]) + [shim, "--continue", show (DockerInit (fromContainerId cid))] -- | Called when propellor is running inside a docker container. -- The string should be the container's ContainerId. -- cgit v1.2.3 From d38c48b97f796217f606ada43fbe13445f41417a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 26 May 2015 11:24:22 -0400 Subject: propellor spin --- config-joey.hs | 1 + src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs | 16 ++++++++++++++++ 2 files changed, 17 insertions(+) (limited to 'src') diff --git a/config-joey.hs b/config-joey.hs index c4477f01..8c44d104 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -132,6 +132,7 @@ orca = standardSystem "orca.kitenet.net" Unstable "amd64" & Systemd.persistentJournal & Docker.configured & Docker.docked (GitAnnexBuilder.standardAutoBuilderContainer dockerImage "amd64" 15 "2h") + & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainerNspawn "amd64" 15 "2h") & Docker.docked (GitAnnexBuilder.standardAutoBuilderContainer dockerImage "i386" 45 "2h") & Docker.docked (GitAnnexBuilder.armelCompanionContainer dockerImage) & Docker.docked (GitAnnexBuilder.armelAutoBuilderContainer dockerImage (Cron.Times "1 3 * * *") "5h") diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index 511fd888..6108bf1a 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -9,6 +9,8 @@ import qualified Propellor.Property.Cron as Cron import qualified Propellor.Property.Ssh as Ssh import qualified Propellor.Property.File as File import qualified Propellor.Property.Docker as Docker +import qualified Propellor.Property.Systemd as Systemd +import qualified Propellor.Property.Chroot as Chroot import Propellor.Property.Cron (Times) builduser :: UserName @@ -105,6 +107,20 @@ standardAutoBuilderContainer dockerImage arch buildminute timeout = Docker.conta & autobuilder arch (Cron.Times $ show buildminute ++ " * * * *") timeout & Docker.tweaked +standardAutoBuilderContainerNspawn :: Architecture -> Int -> TimeOut -> Systemd.Container +standardAutoBuilderContainerNspawn arch buildminute timeout = Systemd.container name bootstrap + & os myos + & Apt.stdSourcesList + & Apt.unattendedUpgrades + & User.accountFor (User builduser) + & tree arch + & buildDepsApt + & autobuilder arch (Cron.Times $ show buildminute ++ " * * * *") timeout + where + name = arch ++ "-git-annex-builder" + bootstrap = Chroot.debootstrapped myos mempty + myos = System (Debian Unstable) arch + androidAutoBuilderContainer :: (System -> Docker.Image) -> Times -> TimeOut -> Docker.Container androidAutoBuilderContainer dockerImage crontimes timeout = androidContainer dockerImage "android-git-annex-builder" (tree "android") builddir -- cgit v1.2.3 From d7ff70c7277f6a29fa608c8b1da1543c461a8bfc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 27 May 2015 12:18:42 -0400 Subject: merge changes from git-annex --- src/Utility/SafeCommand.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/src/Utility/SafeCommand.hs b/src/Utility/SafeCommand.hs index 9eaa5308..0704e69f 100644 --- a/src/Utility/SafeCommand.hs +++ b/src/Utility/SafeCommand.hs @@ -5,14 +5,17 @@ - License: BSD-2-clause -} +{-# OPTIONS_GHC -fno-warn-tabs #-} + module Utility.SafeCommand where import System.Exit import Utility.Process import Data.String.Utils -import Control.Applicative import System.FilePath import Data.Char +import Control.Applicative +import Prelude {- A type for parameters passed to a shell command. A command can - be passed either some Params (multiple parameters can be included, -- cgit v1.2.3 From 626f1af56f12be63cd78fa4910c55453c23cf5a0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 27 May 2015 12:38:45 -0400 Subject: Export CommandParam, boolSystem, safeSystem and shellEscape from Propellor.Property.Cmd, so they are available for use in constricting your own Properties when using propellor as a library. Several imports of Utility.SafeCommand now redundant. --- debian/changelog | 3 ++ src/Propellor/Bootstrap.hs | 1 - src/Propellor/CmdLine.hs | 1 - src/Propellor/Git.hs | 1 - src/Propellor/Property/Apache.hs | 1 - src/Propellor/Property/Chroot.hs | 1 - src/Propellor/Property/Cmd.hs | 20 ++++++++-- src/Propellor/Property/Cron.hs | 1 - src/Propellor/Property/Debootstrap.hs | 1 - src/Propellor/Property/Docker.hs | 1 - src/Propellor/Property/Firewall.hs | 1 - src/Propellor/Property/Git.hs | 1 - src/Propellor/Property/Mount.hs | 1 - src/Propellor/Property/OS.hs | 1 - src/Propellor/Property/Obnam.hs | 1 - src/Propellor/Property/Reboot.hs | 1 - src/Propellor/Property/Service.hs | 1 - src/Propellor/Property/SiteSpecific/GitHome.hs | 1 - src/Propellor/Property/SiteSpecific/JoeySites.hs | 1 - src/Propellor/Property/Ssh.hs | 1 - src/Propellor/Property/Systemd.hs | 1 - src/Propellor/Shim.hs | 1 - src/Propellor/Ssh.hs | 1 - src/Utility/SafeCommand.hs | 49 ++++++++++++------------ 24 files changed, 43 insertions(+), 50 deletions(-) (limited to 'src') diff --git a/debian/changelog b/debian/changelog index dc3b09de..96a9f745 100644 --- a/debian/changelog +++ b/debian/changelog @@ -4,6 +4,9 @@ propellor (2.5.0) UNRELEASED; urgency=medium more generic cmdProperty' (API change) * Add docker image related properties. Thanks, Antoine Eiche. + * Export CommandParam, boolSystem, safeSystem and shellEscape from + Propellor.Property.Cmd, so they are available for use in constricting + your own Properties when using propellor as a library. -- Joey Hess Thu, 07 May 2015 12:08:34 -0400 diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs index 51ba69a4..1cf921cf 100644 --- a/src/Propellor/Bootstrap.hs +++ b/src/Propellor/Bootstrap.hs @@ -6,7 +6,6 @@ module Propellor.Bootstrap ( ) where import Propellor -import Utility.SafeCommand import System.Posix.Files import Data.List diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 1298daf2..219fe026 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -18,7 +18,6 @@ import Propellor.Types.CmdLine import qualified Propellor.Property.Docker as Docker import qualified Propellor.Property.Chroot as Chroot import qualified Propellor.Shim as Shim -import Utility.SafeCommand usage :: Handle -> IO () usage h = hPutStrLn h $ unlines diff --git a/src/Propellor/Git.hs b/src/Propellor/Git.hs index 34bc43e2..0b9b4b35 100644 --- a/src/Propellor/Git.hs +++ b/src/Propellor/Git.hs @@ -3,7 +3,6 @@ module Propellor.Git where import Propellor import Propellor.PrivData.Paths import Propellor.Gpg -import Utility.SafeCommand import Utility.FileMode getCurrentBranch :: IO String diff --git a/src/Propellor/Property/Apache.hs b/src/Propellor/Property/Apache.hs index a7c7e690..fe81dcd8 100644 --- a/src/Propellor/Property/Apache.hs +++ b/src/Propellor/Property/Apache.hs @@ -4,7 +4,6 @@ import Propellor import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Service as Service -import Utility.SafeCommand type ConfigFile = [String] diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index e56cb6ed..ec2b6679 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -19,7 +19,6 @@ import Propellor.Property.Chroot.Util import qualified Propellor.Property.Debootstrap as Debootstrap import qualified Propellor.Property.Systemd.Core as Systemd import qualified Propellor.Shim as Shim -import Utility.SafeCommand import qualified Data.Map as M import Data.List.Utils diff --git a/src/Propellor/Property/Cmd.hs b/src/Propellor/Property/Cmd.hs index 859302c8..23f1075b 100644 --- a/src/Propellor/Property/Cmd.hs +++ b/src/Propellor/Property/Cmd.hs @@ -1,11 +1,20 @@ {-# LANGUAGE PackageImports #-} module Propellor.Property.Cmd ( + -- * Properties for running commands and scripts cmdProperty, cmdProperty', cmdPropertyEnv, + Script, scriptProperty, userScriptProperty, + -- * Lower-level interface for running commands + CommandParam(..), + boolSystem, + boolSystemEnv, + safeSystem, + safeSystemEnv, + shellEscape ) where import Control.Applicative @@ -40,15 +49,18 @@ cmdPropertyEnv cmd params env = property desc $ liftIO $ do where desc = unwords $ cmd : params --- | A property that can be satisfied by running a series of shell commands. -scriptProperty :: [String] -> Property NoInfo +-- | A series of shell commands. (Without a leading hashbang.) +type Script = [String] + +-- | A property that can be satisfied by running a script. +scriptProperty :: Script -> Property NoInfo scriptProperty script = cmdProperty "sh" ["-c", shellcmd] where shellcmd = intercalate " ; " ("set -e" : script) --- | A property that can satisfied by running a series of shell commands, +-- | A property that can satisfied by running a script -- as user (cd'd to their home directory). -userScriptProperty :: User -> [String] -> Property NoInfo +userScriptProperty :: User -> Script -> Property NoInfo userScriptProperty (User user) script = cmdProperty "su" ["--shell", "/bin/sh", "-c", shellcmd, user] where shellcmd = intercalate " ; " ("set -e" : "cd" : script) diff --git a/src/Propellor/Property/Cron.hs b/src/Propellor/Property/Cron.hs index d2feaf3c..e9bb93ac 100644 --- a/src/Propellor/Property/Cron.hs +++ b/src/Propellor/Property/Cron.hs @@ -4,7 +4,6 @@ import Propellor import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import Propellor.Bootstrap -import Utility.SafeCommand import Utility.FileMode import Data.Char diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs index 5d6a8bed..f29ae56b 100644 --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -15,7 +15,6 @@ import qualified Propellor.Property.Apt as Apt import Propellor.Property.Chroot.Util import Propellor.Property.Mount import Utility.Path -import Utility.SafeCommand import Utility.FileMode import Data.List diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 3b8751f3..fd7e37b2 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -48,7 +48,6 @@ import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Cmd as Cmd import qualified Propellor.Shim as Shim -import Utility.SafeCommand import Utility.Path import Utility.ThreadScheduler diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs index 66292c8b..ab57b122 100644 --- a/src/Propellor/Property/Firewall.hs +++ b/src/Propellor/Property/Firewall.hs @@ -18,7 +18,6 @@ import Data.Char import Data.List import Propellor -import Utility.SafeCommand import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Network as Network diff --git a/src/Propellor/Property/Git.hs b/src/Propellor/Property/Git.hs index 0fc22616..48871b40 100644 --- a/src/Propellor/Property/Git.hs +++ b/src/Propellor/Property/Git.hs @@ -4,7 +4,6 @@ import Propellor import Propellor.Property.File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Service as Service -import Utility.SafeCommand import Data.List diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs index f4d10302..a081b1e7 100644 --- a/src/Propellor/Property/Mount.hs +++ b/src/Propellor/Property/Mount.hs @@ -1,7 +1,6 @@ module Propellor.Property.Mount where import Propellor -import Utility.SafeCommand type FsType = String type Source = String diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs index 11fa6c82..5364456a 100644 --- a/src/Propellor/Property/OS.hs +++ b/src/Propellor/Property/OS.hs @@ -16,7 +16,6 @@ import qualified Propellor.Property.File as File import qualified Propellor.Property.Reboot as Reboot import Propellor.Property.Mount import Propellor.Property.Chroot.Util (stdPATH) -import Utility.SafeCommand import System.Posix.Files (rename, fileExist) import Control.Exception (throw) diff --git a/src/Propellor/Property/Obnam.hs b/src/Propellor/Property/Obnam.hs index da27e263..94b023f3 100644 --- a/src/Propellor/Property/Obnam.hs +++ b/src/Propellor/Property/Obnam.hs @@ -4,7 +4,6 @@ import Propellor import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Cron as Cron import qualified Propellor.Property.Gpg as Gpg -import Utility.SafeCommand import Data.List diff --git a/src/Propellor/Property/Reboot.hs b/src/Propellor/Property/Reboot.hs index 750968ff..d45969a8 100644 --- a/src/Propellor/Property/Reboot.hs +++ b/src/Propellor/Property/Reboot.hs @@ -1,7 +1,6 @@ module Propellor.Property.Reboot where import Propellor -import Utility.SafeCommand now :: Property NoInfo now = cmdProperty "reboot" [] diff --git a/src/Propellor/Property/Service.hs b/src/Propellor/Property/Service.hs index 8da502f7..9cc010e8 100644 --- a/src/Propellor/Property/Service.hs +++ b/src/Propellor/Property/Service.hs @@ -1,7 +1,6 @@ module Propellor.Property.Service where import Propellor -import Utility.SafeCommand type ServiceName = String diff --git a/src/Propellor/Property/SiteSpecific/GitHome.hs b/src/Propellor/Property/SiteSpecific/GitHome.hs index d6dce7c0..40f2ecd8 100644 --- a/src/Propellor/Property/SiteSpecific/GitHome.hs +++ b/src/Propellor/Property/SiteSpecific/GitHome.hs @@ -3,7 +3,6 @@ module Propellor.Property.SiteSpecific.GitHome where import Propellor import qualified Propellor.Property.Apt as Apt import Propellor.Property.User -import Utility.SafeCommand -- | Clones Joey Hess's git home directory, and runs its fixups script. installedFor :: User -> Property NoInfo diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs index 89b8b46d..f9a0e0c9 100644 --- a/src/Propellor/Property/SiteSpecific/JoeySites.hs +++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs @@ -15,7 +15,6 @@ import qualified Propellor.Property.User as User import qualified Propellor.Property.Obnam as Obnam import qualified Propellor.Property.Apache as Apache import qualified Propellor.Property.Postfix as Postfix -import Utility.SafeCommand import Utility.FileMode import Data.List diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs index 37e65728..785f2787 100644 --- a/src/Propellor/Property/Ssh.hs +++ b/src/Propellor/Property/Ssh.hs @@ -24,7 +24,6 @@ import Propellor import qualified Propellor.Property.File as File import qualified Propellor.Property.Service as Service import Propellor.Property.User -import Utility.SafeCommand import Utility.FileMode import System.PosixCompat diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 07cf81ee..78a99963 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -25,7 +25,6 @@ import qualified Propellor.Property.Chroot as Chroot import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File import Propellor.Property.Systemd.Core -import Utility.SafeCommand import Utility.FileMode import Data.List diff --git a/src/Propellor/Shim.hs b/src/Propellor/Shim.hs index 5fc1ea05..ecf9f36a 100644 --- a/src/Propellor/Shim.hs +++ b/src/Propellor/Shim.hs @@ -8,7 +8,6 @@ module Propellor.Shim (setup, cleanEnv, file) where import Propellor import Utility.LinuxMkLibs -import Utility.SafeCommand import Utility.FileMode import Utility.FileSystemEncoding diff --git a/src/Propellor/Ssh.hs b/src/Propellor/Ssh.hs index 97c3eb6d..ac9295d1 100644 --- a/src/Propellor/Ssh.hs +++ b/src/Propellor/Ssh.hs @@ -1,7 +1,6 @@ module Propellor.Ssh where import Propellor -import Utility.SafeCommand import Utility.UserInfo import System.PosixCompat diff --git a/src/Utility/SafeCommand.hs b/src/Utility/SafeCommand.hs index 0704e69f..82e35049 100644 --- a/src/Utility/SafeCommand.hs +++ b/src/Utility/SafeCommand.hs @@ -17,16 +17,15 @@ import Data.Char import Control.Applicative import Prelude -{- A type for parameters passed to a shell command. A command can - - be passed either some Params (multiple parameters can be included, - - whitespace-separated, or a single Param (for when parameters contain - - whitespace), or a File. - -} -data CommandParam = Params String | Param String | File FilePath +-- | Parameters that can be passed to a shell command. +data CommandParam + = Params String -- ^ Contains multiple parameters, separated by whitespace + | Param String -- ^ A single parameter + | File FilePath -- ^ The name of a file deriving (Eq, Show, Ord) -{- Used to pass a list of CommandParams to a function that runs - - a command and expects Strings. -} +-- | Used to pass a list of CommandParams to a function that runs +-- a command and expects Strings. -} toCommand :: [CommandParam] -> [String] toCommand = concatMap unwrap where @@ -43,9 +42,10 @@ toCommand = concatMap unwrap -- path separator on Windows. pathseps = pathSeparator:"./" -{- Run a system command, and returns True or False - - if it succeeded or failed. - -} +-- | Run a system command, and returns True or False if it succeeded or failed. +-- +-- This and other command running functions in this module log the commands +-- run at debug level, using System.Log.Logger. boolSystem :: FilePath -> [CommandParam] -> IO Bool boolSystem command params = boolSystem' command params id @@ -59,7 +59,7 @@ boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bo boolSystemEnv command params environ = boolSystem' command params $ \p -> p { env = environ } -{- Runs a system command, returning the exit status. -} +-- | Runs a system command, returning the exit status. safeSystem :: FilePath -> [CommandParam] -> IO ExitCode safeSystem command params = safeSystem' command params id @@ -74,23 +74,22 @@ safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Ex safeSystemEnv command params environ = safeSystem' command params $ \p -> p { env = environ } -{- Wraps a shell command line inside sh -c, allowing it to be run in a - - login shell that may not support POSIX shell, eg csh. -} +-- | Wraps a shell command line inside sh -c, allowing it to be run in a +-- login shell that may not support POSIX shell, eg csh. shellWrap :: String -> String shellWrap cmdline = "sh -c " ++ shellEscape cmdline -{- Escapes a filename or other parameter to be safely able to be exposed to - - the shell. - - - - This method works for POSIX shells, as well as other shells like csh. - -} +-- | Escapes a filename or other parameter to be safely able to be exposed to +-- the shell. +-- +-- This method works for POSIX shells, as well as other shells like csh. shellEscape :: String -> String shellEscape f = "'" ++ escaped ++ "'" where -- replace ' with '"'"' escaped = join "'\"'\"'" $ split "'" f -{- Unescapes a set of shellEscaped words or filenames. -} +-- | Unescapes a set of shellEscaped words or filenames. shellUnEscape :: String -> [String] shellUnEscape [] = [] shellUnEscape s = word : shellUnEscape rest @@ -107,19 +106,19 @@ shellUnEscape s = word : shellUnEscape rest | c == q = findword w cs | otherwise = inquote q (w++[c]) cs -{- For quickcheck. -} +-- | For quickcheck. prop_idempotent_shellEscape :: String -> Bool prop_idempotent_shellEscape s = [s] == (shellUnEscape . shellEscape) s prop_idempotent_shellEscape_multiword :: [String] -> Bool prop_idempotent_shellEscape_multiword s = s == (shellUnEscape . unwords . map shellEscape) s -{- Segments a list of filenames into groups that are all below the maximum - - command-line length limit. -} +-- | Segments a list of filenames into groups that are all below the maximum +-- command-line length limit. segmentXargsOrdered :: [FilePath] -> [[FilePath]] segmentXargsOrdered = reverse . map reverse . segmentXargsUnordered -{- Not preserving data is a little faster, and streams better when - - there are a great many filesnames. -} +-- | Not preserving order is a little faster, and streams better when +-- there are a great many filenames. segmentXargsUnordered :: [FilePath] -> [[FilePath]] segmentXargsUnordered l = go l [] 0 [] where -- cgit v1.2.3 From 353d3e888b437403c32fa6512d1141a6d8e0a2c2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 27 May 2015 14:55:31 -0400 Subject: merge changes from git-annex --- src/Utility/Data.hs | 2 ++ src/Utility/Directory.hs | 2 ++ src/Utility/Env.hs | 2 ++ src/Utility/Exception.hs | 1 + src/Utility/FileMode.hs | 13 +------------ src/Utility/FileSystemEncoding.hs | 1 + src/Utility/LinuxMkLibs.hs | 15 ++++++++------- src/Utility/Misc.hs | 10 ++++++---- src/Utility/Monad.hs | 2 ++ src/Utility/PartialPrelude.hs | 2 ++ src/Utility/Path.hs | 2 ++ src/Utility/PosixFiles.hs | 1 + src/Utility/Process.hs | 2 ++ src/Utility/QuickCheck.hs | 1 + src/Utility/Scheduled.hs | 3 ++- src/Utility/Tmp.hs | 1 + src/Utility/UserInfo.hs | 6 ++++-- 17 files changed, 40 insertions(+), 26 deletions(-) (limited to 'src') diff --git a/src/Utility/Data.hs b/src/Utility/Data.hs index 5ecd218f..27c0a824 100644 --- a/src/Utility/Data.hs +++ b/src/Utility/Data.hs @@ -5,6 +5,8 @@ - License: BSD-2-clause -} +{-# OPTIONS_GHC -fno-warn-tabs #-} + module Utility.Data where {- First item in the list that is not Nothing. -} diff --git a/src/Utility/Directory.hs b/src/Utility/Directory.hs index 2e037fdd..7322cd85 100644 --- a/src/Utility/Directory.hs +++ b/src/Utility/Directory.hs @@ -6,6 +6,7 @@ -} {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.Directory where @@ -18,6 +19,7 @@ import Control.Applicative import Control.Concurrent import System.IO.Unsafe (unsafeInterleaveIO) import Data.Maybe +import Prelude #ifdef mingw32_HOST_OS import qualified System.Win32 as Win32 diff --git a/src/Utility/Env.hs b/src/Utility/Env.hs index fdf06d80..c56f4ec2 100644 --- a/src/Utility/Env.hs +++ b/src/Utility/Env.hs @@ -6,6 +6,7 @@ -} {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.Env where @@ -13,6 +14,7 @@ module Utility.Env where import Utility.Exception import Control.Applicative import Data.Maybe +import Prelude import qualified System.Environment as E import qualified System.SetEnv #else diff --git a/src/Utility/Exception.hs b/src/Utility/Exception.hs index ab47ae95..9d4236c4 100644 --- a/src/Utility/Exception.hs +++ b/src/Utility/Exception.hs @@ -6,6 +6,7 @@ -} {-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.Exception ( module X, diff --git a/src/Utility/FileMode.hs b/src/Utility/FileMode.hs index 201b8451..fdf1b56b 100644 --- a/src/Utility/FileMode.hs +++ b/src/Utility/FileMode.hs @@ -22,15 +22,12 @@ import Utility.Exception {- Applies a conversion function to a file's mode. -} modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO () -modifyFileMode f convert = void $ modifyFileMode' f convert -modifyFileMode' :: FilePath -> (FileMode -> FileMode) -> IO FileMode -modifyFileMode' f convert = do +modifyFileMode f convert = do s <- getFileStatus f let old = fileMode s let new = convert old when (new /= old) $ setFileMode f new - return old {- Adds the specified FileModes to the input mode, leaving the rest - unchanged. -} @@ -41,14 +38,6 @@ addModes ms m = combineModes (m:ms) removeModes :: [FileMode] -> FileMode -> FileMode removeModes ms m = m `intersectFileModes` complement (combineModes ms) -{- Runs an action after changing a file's mode, then restores the old mode. -} -withModifiedFileMode :: FilePath -> (FileMode -> FileMode) -> IO a -> IO a -withModifiedFileMode file convert a = bracket setup cleanup go - where - setup = modifyFileMode' file convert - cleanup oldmode = modifyFileMode file (const oldmode) - go _ = a - writeModes :: [FileMode] writeModes = [ownerWriteMode, groupWriteMode, otherWriteMode] diff --git a/src/Utility/FileSystemEncoding.hs b/src/Utility/FileSystemEncoding.hs index 139b74fe..41c5972a 100644 --- a/src/Utility/FileSystemEncoding.hs +++ b/src/Utility/FileSystemEncoding.hs @@ -6,6 +6,7 @@ -} {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.FileSystemEncoding ( fileEncoding, diff --git a/src/Utility/LinuxMkLibs.hs b/src/Utility/LinuxMkLibs.hs index db64d123..fdeb7795 100644 --- a/src/Utility/LinuxMkLibs.hs +++ b/src/Utility/LinuxMkLibs.hs @@ -7,7 +7,12 @@ module Utility.LinuxMkLibs where -import Control.Applicative +import Utility.PartialPrelude +import Utility.Directory +import Utility.Process +import Utility.Monad +import Utility.Path + import Data.Maybe import System.Directory import System.FilePath @@ -15,12 +20,8 @@ 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 +import Control.Applicative +import Prelude {- 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. -} diff --git a/src/Utility/Misc.hs b/src/Utility/Misc.hs index e4eccac4..45d5a063 100644 --- a/src/Utility/Misc.hs +++ b/src/Utility/Misc.hs @@ -6,23 +6,25 @@ -} {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.Misc where +import Utility.FileSystemEncoding +import Utility.Monad + import System.IO import Control.Monad import Foreign import Data.Char import Data.List -import Control.Applicative import System.Exit #ifndef mingw32_HOST_OS import System.Posix.Process (getAnyProcessStatus) import Utility.Exception #endif - -import Utility.FileSystemEncoding -import Utility.Monad +import Control.Applicative +import Prelude {- A version of hgetContents that is not lazy. Ensures file is - all read before it gets closed. -} diff --git a/src/Utility/Monad.hs b/src/Utility/Monad.hs index 878e0da6..ac751043 100644 --- a/src/Utility/Monad.hs +++ b/src/Utility/Monad.hs @@ -5,6 +5,8 @@ - License: BSD-2-clause -} +{-# OPTIONS_GHC -fno-warn-tabs #-} + module Utility.Monad where import Data.Maybe diff --git a/src/Utility/PartialPrelude.hs b/src/Utility/PartialPrelude.hs index 6efa093f..55795563 100644 --- a/src/Utility/PartialPrelude.hs +++ b/src/Utility/PartialPrelude.hs @@ -5,6 +5,8 @@ - them being accidentially used. -} +{-# OPTIONS_GHC -fno-warn-tabs #-} + module Utility.PartialPrelude where import qualified Data.Maybe diff --git a/src/Utility/Path.hs b/src/Utility/Path.hs index 9f0737fe..8e3c2bdd 100644 --- a/src/Utility/Path.hs +++ b/src/Utility/Path.hs @@ -6,6 +6,7 @@ -} {-# LANGUAGE PackageImports, CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.Path where @@ -16,6 +17,7 @@ import Data.List import Data.Maybe import Data.Char import Control.Applicative +import Prelude #ifdef mingw32_HOST_OS import qualified System.FilePath.Posix as Posix diff --git a/src/Utility/PosixFiles.hs b/src/Utility/PosixFiles.hs index 5a94ead0..4550bebd 100644 --- a/src/Utility/PosixFiles.hs +++ b/src/Utility/PosixFiles.hs @@ -8,6 +8,7 @@ -} {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.PosixFiles ( module X, diff --git a/src/Utility/Process.hs b/src/Utility/Process.hs index cbbe8a81..9f98596b 100644 --- a/src/Utility/Process.hs +++ b/src/Utility/Process.hs @@ -7,6 +7,7 @@ -} {-# LANGUAGE CPP, Rank2Types #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.Process ( module X, @@ -54,6 +55,7 @@ import qualified System.Posix.IO import Control.Applicative #endif import Data.Maybe +import Prelude import Utility.Misc import Utility.Exception diff --git a/src/Utility/QuickCheck.hs b/src/Utility/QuickCheck.hs index 54200d3f..cd408ddc 100644 --- a/src/Utility/QuickCheck.hs +++ b/src/Utility/QuickCheck.hs @@ -19,6 +19,7 @@ import System.Posix.Types import qualified Data.Map as M import qualified Data.Set as S import Control.Applicative +import Prelude instance (Arbitrary k, Arbitrary v, Eq k, Ord k) => Arbitrary (M.Map k v) where arbitrary = M.fromList <$> arbitrary diff --git a/src/Utility/Scheduled.hs b/src/Utility/Scheduled.hs index e077a1fe..b3813323 100644 --- a/src/Utility/Scheduled.hs +++ b/src/Utility/Scheduled.hs @@ -32,7 +32,6 @@ import Utility.QuickCheck import Utility.PartialPrelude import Utility.Misc -import Control.Applicative import Data.List import Data.Time.Clock import Data.Time.LocalTime @@ -41,6 +40,8 @@ import Data.Time.Calendar.WeekDate import Data.Time.Calendar.OrdinalDate import Data.Tuple.Utils import Data.Char +import Control.Applicative +import Prelude {- Some sort of scheduled event. -} data Schedule = Schedule Recurrance ScheduledTime diff --git a/src/Utility/Tmp.hs b/src/Utility/Tmp.hs index dc559813..de970fe5 100644 --- a/src/Utility/Tmp.hs +++ b/src/Utility/Tmp.hs @@ -6,6 +6,7 @@ -} {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.Tmp where diff --git a/src/Utility/UserInfo.hs b/src/Utility/UserInfo.hs index 5bf8d5c0..7e94cafa 100644 --- a/src/Utility/UserInfo.hs +++ b/src/Utility/UserInfo.hs @@ -6,6 +6,7 @@ -} {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} module Utility.UserInfo ( myHomeDir, @@ -13,12 +14,13 @@ module Utility.UserInfo ( myUserGecos, ) where +import Utility.Env + import System.PosixCompat #ifndef mingw32_HOST_OS import Control.Applicative #endif - -import Utility.Env +import Prelude {- Current user's home directory. - -- cgit v1.2.3 From 3c2349922da39cd913e5cde473ec03dda9fe3fb6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 27 May 2015 18:27:25 -0400 Subject: propellor spin --- config-joey.hs | 2 +- src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/config-joey.hs b/config-joey.hs index 8c44d104..e61982e1 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -132,7 +132,7 @@ orca = standardSystem "orca.kitenet.net" Unstable "amd64" & Systemd.persistentJournal & Docker.configured & Docker.docked (GitAnnexBuilder.standardAutoBuilderContainer dockerImage "amd64" 15 "2h") - & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainerNspawn "amd64" 15 "2h") + ! Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainerNspawn "amd64" 15 "2h") & Docker.docked (GitAnnexBuilder.standardAutoBuilderContainer dockerImage "i386" 45 "2h") & Docker.docked (GitAnnexBuilder.armelCompanionContainer dockerImage) & Docker.docked (GitAnnexBuilder.armelAutoBuilderContainer dockerImage (Cron.Times "1 3 * * *") "5h") diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index 6108bf1a..ee0adca2 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -119,7 +119,7 @@ standardAutoBuilderContainerNspawn arch buildminute timeout = Systemd.container where name = arch ++ "-git-annex-builder" bootstrap = Chroot.debootstrapped myos mempty - myos = System (Debian Unstable) arch + myos = System (Debian Testing) arch androidAutoBuilderContainer :: (System -> Docker.Image) -> Times -> TimeOut -> Docker.Container androidAutoBuilderContainer dockerImage crontimes timeout = -- cgit v1.2.3 From 9ce43e55f8db84ac1111ad29f0c134814f805fed Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 27 May 2015 21:11:36 -0400 Subject: Improve enter-machine scripts for nspawn containers to unset most environment variables. --- config-joey.hs | 4 ++-- debian/changelog | 2 ++ src/Propellor/Property/Systemd.hs | 20 ++++++++++++-------- 3 files changed, 16 insertions(+), 10 deletions(-) (limited to 'src') diff --git a/config-joey.hs b/config-joey.hs index 013be113..e01af471 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -134,10 +134,10 @@ orca = standardSystem "orca.kitenet.net" Unstable "amd64" ! Docker.docked (GitAnnexBuilder.standardAutoBuilderContainer dockerImage "amd64" 15 "2h") ! Docker.docked (GitAnnexBuilder.standardAutoBuilderContainer dockerImage "i386" 45 "2h") ! Docker.docked (GitAnnexBuilder.androidAutoBuilderContainer dockerImage (Cron.Times "1 1 * * *") "3h") + ! Docker.docked (GitAnnexBuilder.armelCompanionContainer dockerImage) + ! Docker.docked (GitAnnexBuilder.armelAutoBuilderContainer dockerImage (Cron.Times "1 3 * * *") "5h") & Docker.garbageCollected -- `period` Daily & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainerNspawn "amd64" 15 "2h") - & Docker.docked (GitAnnexBuilder.armelCompanionContainer dockerImage) - & Docker.docked (GitAnnexBuilder.armelAutoBuilderContainer dockerImage (Cron.Times "1 3 * * *") "5h") & Apt.buildDep ["git-annex"] `period` Daily -- This is not a complete description of kite, since it's a diff --git a/debian/changelog b/debian/changelog index 96a9f745..5d70582e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -7,6 +7,8 @@ propellor (2.5.0) UNRELEASED; urgency=medium * Export CommandParam, boolSystem, safeSystem and shellEscape from Propellor.Property.Cmd, so they are available for use in constricting your own Properties when using propellor as a library. + * Improve enter-machine scripts for nspawn containers to unset most + environment variables. -- Joey Hess Thu, 07 May 2015 12:08:34 -0400 diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 78a99963..b19c08bc 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -215,15 +215,19 @@ enterScript c@(Container name _ _) = setup teardown where setup = combineProperties ("generated " ++ enterScriptFile c) [ scriptfile `File.hasContent` - [ "#!/bin/sh" + [ "#!/usr/bin/perl" , "# Generated by propellor" - , "pid=\"$(machinectl show " ++ shellEscape name ++ " -p Leader | cut -d= -f2)\" || true" - , "if [ -n \"$pid\" ]; then" - , "\tnsenter -p -u -n -i -m -t \"$pid\" \"$@\"" - , "else" - , "\techo container not running >&2" - , "\texit 1" - , "fi" + , "my $pid=`machinectl show " ++ shellEscape name ++ " -p Leader | cut -d= -f2`;" + , "chomp $pid;" + , "if (length $pid) {" + , "\tforeach my $var (keys %ENV) {" + , "\t\tdelete $var unless $var eq 'PATH' || $var eq 'TERM';" + , "\t}" + , "\texec('nsenter', '-p', '-u', '-n', '-i', '-m', '-t', $pid, @ARGV);" + , "} else {" + , "\tdie 'container not running';" + , "}" + , "exit(1);" ] , scriptfile `File.mode` combineModes (readModes ++ executeModes) ] -- cgit v1.2.3 From 0c86662b2d98f8f708bb5217e1cedf74b2fbfa04 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 27 May 2015 21:15:54 -0400 Subject: propellor spin --- src/Propellor/Property/Systemd.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index b19c08bc..c698f780 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -221,7 +221,7 @@ enterScript c@(Container name _ _) = setup teardown , "chomp $pid;" , "if (length $pid) {" , "\tforeach my $var (keys %ENV) {" - , "\t\tdelete $var unless $var eq 'PATH' || $var eq 'TERM';" + , "\t\tdelete $ENV{$var} unless $var eq 'PATH' || $var eq 'TERM';" , "\t}" , "\texec('nsenter', '-p', '-u', '-n', '-i', '-m', '-t', $pid, @ARGV);" , "} else {" -- cgit v1.2.3 From 2c2247fc2338d1543999cbbe182ea93e052c2d91 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 27 May 2015 21:24:50 -0400 Subject: propellor spin --- config-joey.hs | 14 ++------ .../Property/SiteSpecific/GitAnnexBuilder.hs | 40 +++++++--------------- 2 files changed, 15 insertions(+), 39 deletions(-) (limited to 'src') diff --git a/config-joey.hs b/config-joey.hs index 76c06bd2..50e712a0 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -75,7 +75,6 @@ darkstar = host "darkstar.kitenet.net" & Apt.buildDep ["git-annex"] `period` Daily & Docker.configured - ! Docker.docked gitAnnexAndroidDev & JoeySites.postfixClientRelay (Context "darkstar.kitenet.net") & JoeySites.dkimMilter @@ -130,9 +129,9 @@ orca = standardSystem "orca.kitenet.net" Unstable "amd64" & Apt.unattendedUpgrades & Postfix.satellite & Systemd.persistentJournal - & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainerNspawn "amd64" 15 "2h") - & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainerNspawn "i386" 15 "2h") - & Apt.buildDep ["git-annex"] `period` Daily + & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainer "amd64" 15 "2h") + & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainer "i386" 15 "2h") + & Systemd.nspawned (GitAnnexBuilder.androidAutoBuilderContainer (Cron.Times "1 1 * * *") "3h") -- This is not a complete description of kite, since it's a -- multiuser system with eg, user passwords that are not deployed @@ -402,13 +401,6 @@ oldusenetShellBox = standardStableContainer "oldusenet-shellbox" & 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" - jerryPlay :: Docker.Container jerryPlay = standardContainer "jerryplay" Unstable "amd64" & alias "jerryplay.kitenet.net" diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index ee0adca2..eb831025 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -94,22 +94,9 @@ cabalDeps = flagFile go cabalupdated go = userScriptProperty (User 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 -> Docker.Container -standardAutoBuilderContainer dockerImage arch buildminute timeout = Docker.container (arch ++ "-git-annex-builder") - (dockerImage $ System (Debian Testing) arch) - & os (System (Debian Testing) arch) - & Apt.stdSourcesList - & Apt.installed ["systemd"] - & Apt.unattendedUpgrades - & User.accountFor (User builduser) - & tree arch - & buildDepsApt - & autobuilder arch (Cron.Times $ show buildminute ++ " * * * *") timeout - & Docker.tweaked - -standardAutoBuilderContainerNspawn :: Architecture -> Int -> TimeOut -> Systemd.Container -standardAutoBuilderContainerNspawn arch buildminute timeout = Systemd.container name bootstrap - & os myos +standardAutoBuilderContainer :: Architecture -> Int -> TimeOut -> Systemd.Container +standardAutoBuilderContainer arch buildminute timeout = Systemd.container name bootstrap + & os osver & Apt.stdSourcesList & Apt.unattendedUpgrades & User.accountFor (User builduser) @@ -118,29 +105,25 @@ standardAutoBuilderContainerNspawn arch buildminute timeout = Systemd.container & autobuilder arch (Cron.Times $ show buildminute ++ " * * * *") timeout where name = arch ++ "-git-annex-builder" - bootstrap = Chroot.debootstrapped myos mempty - myos = System (Debian Testing) arch + bootstrap = Chroot.debootstrapped osver mempty + osver = System (Debian Testing) arch -androidAutoBuilderContainer :: (System -> Docker.Image) -> Times -> TimeOut -> Docker.Container -androidAutoBuilderContainer dockerImage crontimes timeout = - androidContainer dockerImage "android-git-annex-builder" (tree "android") builddir +androidAutoBuilderContainer :: Times -> TimeOut -> Systemd.Container +androidAutoBuilderContainer crontimes timeout = + androidContainer "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 :: (IsProp (Property (CInfo NoInfo i)), (Combines (Property NoInfo) (Property i))) - => (System -> Docker.Image) - -> Docker.ContainerName + => Systemd.MachineName -> Property i -> FilePath - -> Docker.Container -androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.container name - (dockerImage osver) + -> Systemd.Container +androidContainer name setupgitannexdir gitannexdir = Systemd.container name bootstrap & os osver & Apt.stdSourcesList - & Apt.installed ["systemd"] - & Docker.tweaked & User.accountFor (User builduser) & File.dirExists gitbuilderdir & File.ownerGroup homedir (User builduser) (Group builduser) @@ -159,6 +142,7 @@ androidContainer dockerImage name setupgitannexdir gitannexdir = Docker.containe [ "cd " ++ gitannexdir ++ " && ./standalone/android/install-haskell-packages" ] osver = System (Debian Testing) "i386" + bootstrap = Chroot.debootstrapped osver mempty -- armel builder has a companion container using amd64 that -- runs the build first to get TH splices. They need -- cgit v1.2.3 From 8d98d4351b33c0df716dbaf269f5b5ac9db4a39a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 28 May 2015 09:34:47 -0400 Subject: reorder --- src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index eb831025..86bf104c 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -127,9 +127,9 @@ androidContainer name setupgitannexdir gitannexdir = Systemd.container name boot & User.accountFor (User builduser) & File.dirExists gitbuilderdir & File.ownerGroup homedir (User builduser) (Group builduser) - & buildDepsApt & flagFile chrootsetup ("/chrootsetup") `requires` setupgitannexdir + & buildDepsApt & flagFile haskellpkgsinstalled ("/haskellpkgsinstalled") where -- Use git-annex's android chroot setup script, which will install -- cgit v1.2.3 From 78fecfcba47901c6c3ff5087cc091d802c5c99d2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 29 May 2015 19:18:35 -0400 Subject: propellor spin --- config-joey.hs | 24 ++++++++++++++++++---- .../Property/SiteSpecific/GitAnnexBuilder.hs | 20 +++++++++--------- 2 files changed, 30 insertions(+), 14 deletions(-) (limited to 'src') diff --git a/config-joey.hs b/config-joey.hs index 4978c8af..92a6c318 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -129,17 +129,33 @@ orca = standardSystem "orca.kitenet.net" Unstable "amd64" & Apt.unattendedUpgrades & Postfix.satellite + & Apt.serviceInstalledRunning "ntp" & Systemd.persistentJournal - & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainer "amd64" 15 "2h") - & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainer "i386" 15 "2h") - & Systemd.nspawned (GitAnnexBuilder.androidAutoBuilderContainer (Cron.Times "1 1 * * *") "3h") + + & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainer + (System (Debian Testing) "amd64") fifteenpast "2h") + & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainer + (System (Debian Testing) "i386") fifteenpast "2h") + & Systemd.nspawned (GitAnnexBuilder.androidAutoBuilderContainer + (Cron.Times "1 1 * * *") "3h") + where + fifteenpast = Cron.Times "15 * * * *" honeybee :: Host -honeybee = standardSystem "honeybee.kitenet.net" Unstable "armhf" +honeybee = standardSystem "honeybee.kitenet.net" Testing "armhf" [ "Arm git-annex build box." ] & ipv6 "2001:4830:1600:187::2" + -- No unattended upgrades as there is currently no console access. + -- (Also, system is not currently running a stock kernel, + -- although it should be able to.) & Postfix.satellite + & Apt.serviceInstalledRunning "ntp" + & Apt.serviceInstalledRunning "aiccu" + + -- Using unstable to get new enough ghc for TH on arm. + & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainer + (System (Debian Unstable) "armel") (Cron.Daily) "22h") -- This is not a complete description of kite, since it's a -- multiuser system with eg, user passwords that are not deployed diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index 86bf104c..6b73bee9 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -94,19 +94,19 @@ cabalDeps = flagFile go cabalupdated go = userScriptProperty (User builduser) ["cabal update && cabal install git-annex --only-dependencies || true"] cabalupdated = homedir ".cabal" "packages" "hackage.haskell.org" "00-index.cache" -standardAutoBuilderContainer :: Architecture -> Int -> TimeOut -> Systemd.Container -standardAutoBuilderContainer arch buildminute timeout = Systemd.container name bootstrap - & os osver - & Apt.stdSourcesList - & Apt.unattendedUpgrades - & User.accountFor (User builduser) - & tree arch - & buildDepsApt - & autobuilder arch (Cron.Times $ show buildminute ++ " * * * *") timeout +standardAutoBuilderContainer :: System -> Times -> TimeOut -> Systemd.Container +standardAutoBuilderContainer osver@(System _ arch) crontime timeout = + Systemd.container name bootstrap + & os osver + & Apt.stdSourcesList + & Apt.unattendedUpgrades + & User.accountFor (User builduser) + & tree arch + & buildDepsApt + & autobuilder arch crontime timeout where name = arch ++ "-git-annex-builder" bootstrap = Chroot.debootstrapped osver mempty - osver = System (Debian Testing) arch androidAutoBuilderContainer :: Times -> TimeOut -> Systemd.Container androidAutoBuilderContainer crontimes timeout = -- cgit v1.2.3 From b5a8c7227b15bb4c821221c6f4c3ca8fd1e1a062 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 29 May 2015 22:51:32 -0400 Subject: workaround bug --- config-joey.hs | 11 +++++++++-- src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs | 11 ++++++++--- 2 files changed, 17 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/config-joey.hs b/config-joey.hs index 92a6c318..510fd8da 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -25,6 +25,7 @@ import qualified Propellor.Property.Obnam as Obnam import qualified Propellor.Property.Gpg as Gpg import qualified Propellor.Property.Systemd as Systemd import qualified Propellor.Property.Journald as Journald +import qualified Propellor.Property.Chroot as Chroot import qualified Propellor.Property.OS as OS import qualified Propellor.Property.HostingProvider.CloudAtCost as CloudAtCost import qualified Propellor.Property.HostingProvider.Linode as Linode @@ -153,9 +154,15 @@ honeybee = standardSystem "honeybee.kitenet.net" Testing "armhf" & Apt.serviceInstalledRunning "ntp" & Apt.serviceInstalledRunning "aiccu" + -- Not using systemd-nspawn because it's broken (kernel issue?) + -- & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainer + -- osver Cron.Daily "22h") + & Chroot.provisioned + (Chroot.debootstrapped builderos mempty "/var/lib/containers/armel-git-annex-builder" + & GitAnnexBuilder.standardAutoBuilder builderos Cron.Daily "22h") + where -- Using unstable to get new enough ghc for TH on arm. - & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainer - (System (Debian Unstable) "armel") (Cron.Daily) "22h") + builderos = System (Debian Unstable) "armel" -- This is not a complete description of kite, since it's a -- multiuser system with eg, user passwords that are not deployed diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index 6b73bee9..3c638721 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -97,6 +97,14 @@ cabalDeps = flagFile go cabalupdated standardAutoBuilderContainer :: System -> Times -> TimeOut -> Systemd.Container standardAutoBuilderContainer osver@(System _ arch) crontime timeout = Systemd.container name bootstrap + & standardAutoBuilder osver crontime timeout + where + name = arch ++ "-git-annex-builder" + bootstrap = Chroot.debootstrapped osver mempty + +standardAutoBuilder :: System -> Times -> TimeOut -> Property HasInfo +standardAutoBuilder osver@(System _ arch) crontime timeout = + propertyList "git-annex-builder" $ props & os osver & Apt.stdSourcesList & Apt.unattendedUpgrades @@ -104,9 +112,6 @@ standardAutoBuilderContainer osver@(System _ arch) crontime timeout = & tree arch & buildDepsApt & autobuilder arch crontime timeout - where - name = arch ++ "-git-annex-builder" - bootstrap = Chroot.debootstrapped osver mempty androidAutoBuilderContainer :: Times -> TimeOut -> Systemd.Container androidAutoBuilderContainer crontimes timeout = -- cgit v1.2.3 From ea1598768c4c4b6b4f45148b0940641c5f9f85d2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 29 May 2015 22:52:46 -0400 Subject: Fix Postfix.satellite bug; the default relayhost was set to the domain, not to smtp.domain as documented. --- debian/changelog | 2 ++ src/Propellor/Property/Postfix.hs | 7 ++++--- 2 files changed, 6 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/debian/changelog b/debian/changelog index 5d70582e..e40f5d3a 100644 --- a/debian/changelog +++ b/debian/changelog @@ -9,6 +9,8 @@ propellor (2.5.0) UNRELEASED; urgency=medium your own Properties when using propellor as a library. * Improve enter-machine scripts for nspawn containers to unset most environment variables. + * Fix Postfix.satellite bug; the default relayhost was set to the + domain, not to smtp.domain as documented. -- Joey Hess Thu, 07 May 2015 12:08:34 -0400 diff --git a/src/Propellor/Property/Postfix.hs b/src/Propellor/Property/Postfix.hs index 073d5dc8..b51f4df1 100644 --- a/src/Propellor/Property/Postfix.hs +++ b/src/Propellor/Property/Postfix.hs @@ -22,7 +22,8 @@ reloaded :: Property NoInfo reloaded = Service.reloaded "postfix" -- | Configures postfix as a satellite system, which --- relays all mail through a relay host, which defaults to smtp.domain. +-- relays all mail through a relay host, which defaults to smtp.domain, +-- but can be changed by mainCf "relayhost" -- -- The smarthost may refuse to relay mail on to other domains, without -- futher coniguration/keys. But this should be enough to get cron job @@ -34,14 +35,14 @@ satellite = check (not <$> mainCfIsSet "relayhost") setup setup = trivial $ property "postfix satellite system" $ do hn <- asks hostName let (_, domain) = separate (== '.') hn - ensureProperties + ensureProperties [ Apt.reConfigure "postfix" [ ("postfix/main_mailer_type", "select", "Satellite system") , ("postfix/root_address", "string", "root") , ("postfix/destinations", "string", "localhost") , ("postfix/mailname", "string", hn) ] - , mainCf ("relayhost", domain) + , mainCf ("relayhost", "smtp." ++ domain) `onChange` reloaded ] -- cgit v1.2.3 From 95b6d711e7da7f13d064086b30727e00ad72ecf5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 30 May 2015 10:26:43 -0400 Subject: Mount /proc inside a chroot before provisioning it, to work around #787227 --- debian/changelog | 1 + src/Propellor/Property/Chroot.hs | 13 +++++++++++-- src/Propellor/Property/Debootstrap.hs | 4 +--- src/Propellor/Property/Mount.hs | 11 +++++++++++ 4 files changed, 24 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/debian/changelog b/debian/changelog index e40f5d3a..d18d61cf 100644 --- a/debian/changelog +++ b/debian/changelog @@ -11,6 +11,7 @@ propellor (2.5.0) UNRELEASED; urgency=medium environment variables. * Fix Postfix.satellite bug; the default relayhost was set to the domain, not to smtp.domain as documented. + * Mount /proc inside a chroot before provisioning it, to work around #787227 -- Joey Hess Thu, 07 May 2015 12:08:34 -0400 diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index ec2b6679..0e9d00d8 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -16,6 +16,7 @@ import Propellor import Propellor.Types.CmdLine import Propellor.Types.Chroot import Propellor.Property.Chroot.Util +import Propellor.Property.Mount import qualified Propellor.Property.Debootstrap as Debootstrap import qualified Propellor.Property.Systemd.Core as Systemd import qualified Propellor.Shim as Shim @@ -55,8 +56,9 @@ debootstrapped system conf location = case system of -- | Ensures that the chroot exists and is provisioned according to its -- properties. -- --- Reverting this property removes the chroot. Note that it does not ensure --- that any processes that might be running inside the chroot are stopped. +-- Reverting this property removes the chroot. Anything mounted inside it +-- is first unmounted. Note that it does not ensure that any processes +-- that might be running inside the chroot are stopped. provisioned :: Chroot -> RevertableProperty provisioned c = provisioned' (propigateChrootInfo c) c False @@ -101,6 +103,7 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c " ( pure (Shim.file me d) , Shim.setup me Nothing d ) + liftIO mountproc ifM (liftIO $ bindmount shim) ( chainprovision shim , return FailedChange @@ -117,6 +120,12 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c " ] ) + -- /proc needs to be mounted in the chroot for the linker to use + -- /proc/self/exe which is necessary for some commands to work + mountproc = unlessM (elem procloc <$> mountPointsBelow loc) $ + void $ mount "proc" "proc" procloc + procloc = loc "proc" + chainprovision shim = do parenthost <- asks hostName cmd <- liftIO $ toChain parenthost c systemdonly diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs index f29ae56b..8d974eba 100644 --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -106,9 +106,7 @@ unpopulated d = null <$> catchDefaultIO [] (dirContents d) removetarget :: FilePath -> IO () removetarget target = do - submnts <- filter (\p -> simplifyPath p /= simplifyPath target) - . filter (dirContains target) - <$> mountPoints + submnts <- mountPointsBelow target forM_ submnts umountLazy removeDirectoryRecursive target diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs index a081b1e7..ff47f4d9 100644 --- a/src/Propellor/Property/Mount.hs +++ b/src/Propellor/Property/Mount.hs @@ -1,22 +1,33 @@ module Propellor.Property.Mount where import Propellor +import Utility.Path type FsType = String type Source = String +-- | Lists all mount points of the system. mountPoints :: IO [FilePath] mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"] +-- | Finds all filesystems mounted inside the specified directory. +mountPointsBelow :: FilePath -> IO [FilePath] +mountPointsBelow target = filter (\p -> simplifyPath p /= simplifyPath target) + . filter (dirContains target) + <$> mountPoints + +-- | Filesystem type mounted at a given location. getFsType :: FilePath -> IO (Maybe FsType) getFsType mnt = catchDefaultIO Nothing $ headMaybe . lines <$> readProcess "findmnt" ["-n", mnt, "--output", "fstype"] +-- | Unmounts a device, lazily so any running processes don't block it. umountLazy :: FilePath -> IO () umountLazy mnt = unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $ errorMessage $ "failed unmounting " ++ mnt +-- | Mounts a device. mount :: FsType -> Source -> FilePath -> IO Bool mount fs src mnt = boolSystem "mount" [Param "-t", Param fs, Param src, Param mnt] -- cgit v1.2.3 From aa7dcad9ba8d14013f26f6e8554901d56ef4cb5c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 30 May 2015 11:05:34 -0400 Subject: export createProcess with debug logging from Propellor.Property.Cmd --- debian/changelog | 7 ++-- src/Propellor/Property/Cmd.hs | 5 +-- src/Utility/Process.hs | 80 +++++++++++++++++++++---------------------- 3 files changed, 47 insertions(+), 45 deletions(-) (limited to 'src') diff --git a/debian/changelog b/debian/changelog index d18d61cf..9fae861c 100644 --- a/debian/changelog +++ b/debian/changelog @@ -4,9 +4,10 @@ propellor (2.5.0) UNRELEASED; urgency=medium more generic cmdProperty' (API change) * Add docker image related properties. Thanks, Antoine Eiche. - * Export CommandParam, boolSystem, safeSystem and shellEscape from - Propellor.Property.Cmd, so they are available for use in constricting - your own Properties when using propellor as a library. + * Export CommandParam, boolSystem, safeSystem, shellEscape, and + * createProcess from Propellor.Property.Cmd, so they are available + for use in constricting your own Properties when using propellor + as a library. * Improve enter-machine scripts for nspawn containers to unset most environment variables. * Fix Postfix.satellite bug; the default relayhost was set to the diff --git a/src/Propellor/Property/Cmd.hs b/src/Propellor/Property/Cmd.hs index 23f1075b..23816a94 100644 --- a/src/Propellor/Property/Cmd.hs +++ b/src/Propellor/Property/Cmd.hs @@ -14,18 +14,19 @@ module Propellor.Property.Cmd ( boolSystemEnv, safeSystem, safeSystemEnv, - shellEscape + shellEscape, + createProcess, ) where import Control.Applicative import Data.List import "mtl" Control.Monad.Reader -import System.Process (CreateProcess) import Propellor.Types import Propellor.Property import Utility.SafeCommand import Utility.Env +import Utility.Process (createProcess, CreateProcess) -- | A property that can be satisfied by running a command. -- diff --git a/src/Utility/Process.hs b/src/Utility/Process.hs index 9f98596b..469f7659 100644 --- a/src/Utility/Process.hs +++ b/src/Utility/Process.hs @@ -1,7 +1,7 @@ {- System.Process enhancements, including additional ways of running - processes, and logging. - - - Copyright 2012 Joey Hess + - Copyright 2012-2015 Joey Hess - - License: BSD-2-clause -} @@ -65,8 +65,8 @@ type CreateProcessRunner = forall a. CreateProcess -> ((Maybe Handle, Maybe Hand data StdHandle = StdinHandle | StdoutHandle | StderrHandle deriving (Eq) -{- Normally, when reading from a process, it does not need to be fed any - - standard input. -} +-- | Normally, when reading from a process, it does not need to be fed any +-- standard input. readProcess :: FilePath -> [String] -> IO String readProcess cmd args = readProcessEnv cmd args Nothing @@ -84,9 +84,8 @@ readProcess' p = withHandle StdoutHandle createProcessSuccess p $ \h -> do hClose h return output -{- Runs an action to write to a process on its stdin, - - returns its output, and also allows specifying the environment. - -} +-- | Runs an action to write to a process on its stdin, +-- returns its output, and also allows specifying the environment. writeReadProcessEnv :: FilePath -> [String] @@ -126,8 +125,8 @@ writeReadProcessEnv cmd args environ writestdin adjusthandle = do , env = environ } -{- Waits for a ProcessHandle, and throws an IOError if the process - - did not exit successfully. -} +-- | Waits for a ProcessHandle, and throws an IOError if the process +-- did not exit successfully. forceSuccessProcess :: CreateProcess -> ProcessHandle -> IO () forceSuccessProcess p pid = do code <- waitForProcess pid @@ -135,10 +134,10 @@ forceSuccessProcess p pid = do ExitSuccess -> return () ExitFailure n -> fail $ showCmd p ++ " exited " ++ show n -{- Waits for a ProcessHandle and returns True if it exited successfully. - - Note that using this with createProcessChecked will throw away - - the Bool, and is only useful to ignore the exit code of a process, - - while still waiting for it. -} +-- | Waits for a ProcessHandle and returns True if it exited successfully. +-- Note that using this with createProcessChecked will throw away +-- the Bool, and is only useful to ignore the exit code of a process, +-- while still waiting for it. -} checkSuccessProcess :: ProcessHandle -> IO Bool checkSuccessProcess pid = do code <- waitForProcess pid @@ -149,13 +148,13 @@ ignoreFailureProcess pid = do void $ waitForProcess pid return True -{- Runs createProcess, then an action on its handles, and then - - forceSuccessProcess. -} +-- | Runs createProcess, then an action on its handles, and then +-- forceSuccessProcess. createProcessSuccess :: CreateProcessRunner createProcessSuccess p a = createProcessChecked (forceSuccessProcess p) p a -{- Runs createProcess, then an action on its handles, and then - - a checker action on its exit code, which must wait for the process. -} +-- | Runs createProcess, then an action on its handles, and then +-- a checker action on its exit code, which must wait for the process. createProcessChecked :: (ProcessHandle -> IO b) -> CreateProcessRunner createProcessChecked checker p a = do t@(_, _, _, pid) <- createProcess p @@ -163,14 +162,14 @@ createProcessChecked checker p a = do _ <- checker pid either E.throw return r -{- Leaves the process running, suitable for lazy streaming. - - Note: Zombies will result, and must be waited on. -} +-- | Leaves the process running, suitable for lazy streaming. +-- Note: Zombies will result, and must be waited on. createBackgroundProcess :: CreateProcessRunner createBackgroundProcess p a = a =<< createProcess p -{- Runs a process, optionally feeding it some input, and - - returns a transcript combining its stdout and stderr, and - - whether it succeeded or failed. -} +-- | Runs a process, optionally feeding it some input, and +-- returns a transcript combining its stdout and stderr, and +-- whether it succeeded or failed. processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool) processTranscript cmd opts input = processTranscript' cmd opts Nothing input @@ -234,9 +233,9 @@ processTranscript' cmd opts environ input = do hClose inh writeinput Nothing _ = return () -{- Runs a CreateProcessRunner, on a CreateProcess structure, that - - is adjusted to pipe only from/to a single StdHandle, and passes - - the resulting Handle to an action. -} +-- | Runs a CreateProcessRunner, on a CreateProcess structure, that +-- is adjusted to pipe only from/to a single StdHandle, and passes +-- the resulting Handle to an action. withHandle :: StdHandle -> CreateProcessRunner @@ -258,7 +257,7 @@ withHandle h creator p a = creator p' $ a . select | h == StderrHandle = (stderrHandle, base { std_err = CreatePipe }) -{- Like withHandle, but passes (stdin, stdout) handles to the action. -} +-- | Like withHandle, but passes (stdin, stdout) handles to the action. withIOHandles :: CreateProcessRunner -> CreateProcess @@ -272,7 +271,7 @@ withIOHandles creator p a = creator p' $ a . ioHandles , std_err = Inherit } -{- Like withHandle, but passes (stdout, stderr) handles to the action. -} +-- | Like withHandle, but passes (stdout, stderr) handles to the action. withOEHandles :: CreateProcessRunner -> CreateProcess @@ -286,8 +285,8 @@ withOEHandles creator p a = creator p' $ a . oeHandles , std_err = CreatePipe } -{- Forces the CreateProcessRunner to run quietly; - - both stdout and stderr are discarded. -} +-- | Forces the CreateProcessRunner to run quietly; +-- both stdout and stderr are discarded. withQuietOutput :: CreateProcessRunner -> CreateProcess @@ -299,8 +298,8 @@ withQuietOutput creator p = withFile devNull WriteMode $ \nullh -> do } creator p' $ const $ return () -{- Stdout and stderr are discarded, while the process is fed stdin - - from the handle. -} +-- | Stdout and stderr are discarded, while the process is fed stdin +-- from the handle. feedWithQuietOutput :: CreateProcessRunner -> CreateProcess @@ -321,11 +320,11 @@ devNull = "/dev/null" devNull = "NUL" #endif -{- Extract a desired handle from createProcess's tuple. - - These partial functions are safe as long as createProcess is run - - with appropriate parameters to set up the desired handle. - - Get it wrong and the runtime crash will always happen, so should be - - easily noticed. -} +-- | Extract a desired handle from createProcess's tuple. +-- These partial functions are safe as long as createProcess is run +-- with appropriate parameters to set up the desired handle. +-- Get it wrong and the runtime crash will always happen, so should be +-- easily noticed. type HandleExtractor = (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> Handle stdinHandle :: HandleExtractor stdinHandle (Just h, _, _, _) = h @@ -346,7 +345,7 @@ oeHandles _ = error "expected oeHandles" processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle processHandle (_, _, _, pid) = pid -{- Debugging trace for a CreateProcess. -} +-- | Debugging trace for a CreateProcess. debugProcess :: CreateProcess -> IO () debugProcess p = do debugM "Utility.Process" $ unwords @@ -362,15 +361,15 @@ debugProcess p = do piped Inherit = False piped _ = True -{- Shows the command that a CreateProcess will run. -} +-- | Shows the command that a CreateProcess will run. showCmd :: CreateProcess -> String showCmd = go . cmdspec where go (ShellCommand s) = s go (RawCommand c ps) = c ++ " " ++ show ps -{- Starts an interactive process. Unlike runInteractiveProcess in - - System.Process, stderr is inherited. -} +-- | Starts an interactive process. Unlike runInteractiveProcess in +-- System.Process, stderr is inherited. startInteractiveProcess :: FilePath -> [String] @@ -386,7 +385,8 @@ startInteractiveProcess cmd args environ = do (Just from, Just to, _, pid) <- createProcess p return (pid, to, from) -{- Wrapper around System.Process function that does debug logging. -} +-- | Wrapper around 'System.Process.createProcess' from System.Process, +-- that does debug logging. createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) createProcess p = do debugProcess p -- cgit v1.2.3 From 433bf00a55e1fd7402a410793ba68976a775fac7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 30 May 2015 13:58:00 -0400 Subject: --spin now works when given a short hostname that only resolves to an ipv6 address. --- debian/changelog | 2 ++ src/Propellor/CmdLine.hs | 18 ++++++++++++------ src/Propellor/Spin.hs | 23 +++++++++++++---------- 3 files changed, 27 insertions(+), 16 deletions(-) (limited to 'src') diff --git a/debian/changelog b/debian/changelog index 9fae861c..6a105804 100644 --- a/debian/changelog +++ b/debian/changelog @@ -13,6 +13,8 @@ propellor (2.5.0) UNRELEASED; urgency=medium * Fix Postfix.satellite bug; the default relayhost was set to the domain, not to smtp.domain as documented. * Mount /proc inside a chroot before provisioning it, to work around #787227 + * --spin now works when given a short hostname that only resolves to an + ipv6 address. -- Joey Hess Thu, 07 May 2015 12:08:34 -0400 diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 219fe026..d29ffbb7 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -7,7 +7,7 @@ import System.Environment (getArgs) import Data.List import System.Exit import System.PosixCompat -import qualified Network.BSD +import Network.Socket import Propellor import Propellor.Gpg @@ -165,9 +165,15 @@ updateFirst' cmdline next = ifM fetchOrigin , next ) +-- Gets the fully qualified domain name, given a string that might be +-- a short name to look up in the DNS. hostname :: String -> IO HostName -hostname s - | "." `isInfixOf` s = pure s - | otherwise = do - h <- Network.BSD.getHostByName s - return (Network.BSD.hostName h) +hostname s = go =<< catchDefaultIO [] dnslookup + where + dnslookup = getAddrInfo (Just canonname) (Just s) Nothing + canonname = defaultHints { addrFlags = [AI_CANONNAME] } + go (AddrInfo { addrCanonName = Just v } : _) = pure v + go _ + | "." `isInfixOf` s = pure s -- assume it's a fqdn + | otherwise = + error $ "cannot find host " ++ s ++ " in the DNS" diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index 986305d7..3ff1ec21 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -14,8 +14,7 @@ import System.Posix.Directory import Control.Concurrent.Async import qualified Data.ByteString as B import qualified Data.Set as S -import qualified Network.BSD as BSD -import Network.Socket (inet_ntoa) +import Network.Socket (getAddrInfo, defaultHints, AddrInfo(..), AddrInfoFlag(..), SockAddr) import Propellor import Propellor.Protocol @@ -98,17 +97,21 @@ spin target relay hst = do getSshTarget :: HostName -> Host -> IO String getSshTarget target hst | null configips = return target - | otherwise = go =<< tryIO (BSD.getHostByName target) + | otherwise = go =<< tryIO (dnslookup target) where go (Left e) = useip (show e) - go (Right hostentry) = ifM (anyM matchingconfig (BSD.hostAddresses hostentry)) - ( return target - , do - ips <- mapM inet_ntoa (BSD.hostAddresses hostentry) - useip ("DNS " ++ show ips ++ " vs configured " ++ show configips) - ) + go (Right addrinfos) = do + configaddrinfos <- catMaybes <$> mapM iptoaddr configips + if any (`elem` configaddrinfos) (map addrAddress addrinfos) + then return target + else useip ("DNS lookup did not return any of the expected addresses " ++ show configips) - matchingconfig a = flip elem configips <$> inet_ntoa a + dnslookup h = getAddrInfo (Just $ defaultHints { addrFlags = [AI_CANONNAME] }) (Just h) Nothing + + -- Convert a string containing an IP address into a SockAddr. + iptoaddr :: String -> IO (Maybe SockAddr) + iptoaddr ip = catchDefaultIO Nothing $ headMaybe . map addrAddress + <$> getAddrInfo (Just $ defaultHints { addrFlags = [AI_NUMERICHOST] }) (Just ip) Nothing useip why = case headMaybe configips of Nothing -> return target -- cgit v1.2.3 From 536d9fec70eb3343e51200915555ac651a57f3f4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 30 May 2015 14:02:25 -0400 Subject: propellor spin --- src/Propellor/Spin.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src') diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index 3ff1ec21..9685a486 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -102,6 +102,7 @@ getSshTarget target hst go (Left e) = useip (show e) go (Right addrinfos) = do configaddrinfos <- catMaybes <$> mapM iptoaddr configips + print (configips, configaddrinfos, map addrAddress addrinfos) if any (`elem` configaddrinfos) (map addrAddress addrinfos) then return target else useip ("DNS lookup did not return any of the expected addresses " ++ show configips) -- cgit v1.2.3 From 7b8b77936096e9a081494bce2756b9793d98a345 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 30 May 2015 14:03:23 -0400 Subject: revert test --- config-joey.hs | 2 +- src/Propellor/Spin.hs | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) (limited to 'src') diff --git a/config-joey.hs b/config-joey.hs index 0219c5f2..73c9687b 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -145,7 +145,7 @@ orca = standardSystem "orca.kitenet.net" Unstable "amd64" honeybee :: Host honeybee = standardSystem "honeybee.kitenet.net" Testing "armhf" [ "Arm git-annex build box." ] - & ipv6 "2001:4830:1600:187::3" + & ipv6 "2001:4830:1600:187::2" -- No unattended upgrades as there is currently no console access. -- (Also, system is not currently running a stock kernel, diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index 9685a486..3ff1ec21 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -102,7 +102,6 @@ getSshTarget target hst go (Left e) = useip (show e) go (Right addrinfos) = do configaddrinfos <- catMaybes <$> mapM iptoaddr configips - print (configips, configaddrinfos, map addrAddress addrinfos) if any (`elem` configaddrinfos) (map addrAddress addrinfos) then return target else useip ("DNS lookup did not return any of the expected addresses " ++ show configips) -- cgit v1.2.3 From 446a2e4c9a3fe27782fd6d5d3228fc83a83fe82a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 13:55:07 -0400 Subject: update --- config-joey.hs | 19 +++-- .../Property/SiteSpecific/GitAnnexBuilder.hs | 88 +++++++--------------- 2 files changed, 40 insertions(+), 67 deletions(-) (limited to 'src') diff --git a/config-joey.hs b/config-joey.hs index 73c9687b..8e4ee9dc 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -133,9 +133,11 @@ orca = standardSystem "orca.kitenet.net" Unstable "amd64" & Apt.serviceInstalledRunning "ntp" & Systemd.persistentJournal - & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainer + & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer + GitAnnexBuilder.standardAutoBuilder (System (Debian Testing) "amd64") fifteenpast "2h") - & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainer + & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer + GitAnnexBuilder.standardAutoBuilder (System (Debian Testing) "i386") fifteenpast "2h") & Systemd.nspawned (GitAnnexBuilder.androidAutoBuilderContainer (Cron.Times "1 1 * * *") "3h") @@ -151,15 +153,20 @@ honeybee = standardSystem "honeybee.kitenet.net" Testing "armhf" -- (Also, system is not currently running a stock kernel, -- although it should be able to.) & Postfix.satellite - & Apt.serviceInstalledRunning "ntp" & Apt.serviceInstalledRunning "aiccu" + & Apt.serviceInstalledRunning "swapspace" + & Apt.serviceInstalledRunning "ntp" -- Not using systemd-nspawn because it's broken (kernel issue?) - -- & Systemd.nspawned (GitAnnexBuilder.standardAutoBuilderContainer - -- osver Cron.Daily "22h") + -- & Systemd.nspawned (GitAnnexBuilder.autoBuilderContainer + -- GitAnnexBuilder.armAutoBuilder + -- builderos Cron.Daily "22h") & Chroot.provisioned (Chroot.debootstrapped builderos mempty "/var/lib/container/armel-git-annex-builder" - & GitAnnexBuilder.standardAutoBuilder builderos Cron.Daily "22h") + & "/etc/timezone" `File.hasContent` ["America/New_York"] + & GitAnnexBuilder.armAutoBuilder + builderos (Cron.Times "1 1 * * *") "12h" + ) where -- Using unstable to get new enough ghc for TH on arm. builderos = System (Debian Unstable) "armel" diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index 3c638721..d64852aa 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -6,9 +6,7 @@ import Propellor import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.User as User import qualified Propellor.Property.Cron as Cron -import qualified Propellor.Property.Ssh as Ssh import qualified Propellor.Property.File as File -import qualified Propellor.Property.Docker as Docker import qualified Propellor.Property.Systemd as Systemd import qualified Propellor.Property.Chroot as Chroot import Propellor.Property.Cron (Times) @@ -50,8 +48,6 @@ autobuilder arch crontimes timeout = combineProperties "gitannexbuilder" $ props tree :: Architecture -> Property HasInfo tree buildarch = combineProperties "gitannexbuilder tree" $ props & Apt.installed ["git"] - -- gitbuilderdir directory already exists when docker volume is used, - -- but with wrong owner. & File.dirExists gitbuilderdir & File.ownerGroup gitbuilderdir (User builduser) (Group builduser) & gitannexbuildercloned @@ -86,6 +82,13 @@ buildDepsNoHaskellLibs = Apt.installed "alex", "happy", "c2hs" ] +haskellPkgsInstalled :: String -> Property NoInfo +haskellPkgsInstalled dir = flagFile go ("/haskellpkgsinstalled") + where + go = userScriptProperty (User builduser) + [ "cd " ++ builddir ++ " && ./standalone/ " ++ dir ++ "/install-haskell-packages" + ] + -- Installs current versions of git-annex's deps from cabal, but only -- does so once. cabalDeps :: Property NoInfo @@ -94,23 +97,36 @@ cabalDeps = flagFile go cabalupdated go = userScriptProperty (User builduser) ["cabal update && cabal install git-annex --only-dependencies || true"] cabalupdated = homedir ".cabal" "packages" "hackage.haskell.org" "00-index.cache" -standardAutoBuilderContainer :: System -> Times -> TimeOut -> Systemd.Container -standardAutoBuilderContainer osver@(System _ arch) crontime timeout = +autoBuilderContainer :: (System -> Property HasInfo) -> System -> Times -> TimeOut -> Systemd.Container +autoBuilderContainer mkprop osver@(System _ arch) crontime timeout = Systemd.container name bootstrap - & standardAutoBuilder osver crontime timeout + & mkprop osver + & buildDepsApt + & autobuilder arch crontime timeout where name = arch ++ "-git-annex-builder" bootstrap = Chroot.debootstrapped osver mempty -standardAutoBuilder :: System -> Times -> TimeOut -> Property HasInfo -standardAutoBuilder osver@(System _ arch) crontime timeout = +standardAutoBuilder :: System -> Property HasInfo +standardAutoBuilder osver@(System _ arch) = propertyList "git-annex-builder" $ props & os osver & Apt.stdSourcesList & Apt.unattendedUpgrades & User.accountFor (User builduser) & tree arch - & buildDepsApt + +armAutoBuilder :: System -> Times -> TimeOut -> Property HasInfo +armAutoBuilder osver@(System _ arch) crontime timeout = + propertyList "git-annex-builder (arm)" $ props + & standardAutoBuilder osver + & buildDepsNoHaskellLibs + -- Works around ghc crash with parallel builds on arm. + & (homedir ".cabal" "config") + `File.lacksLine` "jobs: $ncpus" + -- Install patched haskell packages for portability to + -- arm NAS's using old kernel versions. + & haskellPkgsInstalled "linux" & autobuilder arch crontime timeout androidAutoBuilderContainer :: Times -> TimeOut -> Systemd.Container @@ -135,7 +151,7 @@ androidContainer name setupgitannexdir gitannexdir = Systemd.container name boot & flagFile chrootsetup ("/chrootsetup") `requires` setupgitannexdir & buildDepsApt - & flagFile haskellpkgsinstalled ("/haskellpkgsinstalled") + & haskellPkgsInstalled "android" where -- Use git-annex's android chroot setup script, which will install -- ghc-android and the NDK, all build deps, etc, in the home @@ -143,55 +159,5 @@ androidContainer name setupgitannexdir gitannexdir = Systemd.container name boot chrootsetup = scriptProperty [ "cd " ++ gitannexdir ++ " && ./standalone/android/buildchroot-inchroot" ] - haskellpkgsinstalled = userScriptProperty (User builduser) - [ "cd " ++ gitannexdir ++ " && ./standalone/android/install-haskell-packages" - ] osver = System (Debian Testing) "i386" bootstrap = Chroot.debootstrapped osver mempty - --- 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) -> Docker.Container -armelCompanionContainer dockerImage = Docker.container "armel-git-annex-builder-companion" - (dockerImage $ System (Debian Unstable) "amd64") - & os (System (Debian Testing) "amd64") - & Apt.stdSourcesList - & Apt.installed ["systemd"] - -- This volume is shared with the armel builder. - & Docker.volume gitbuilderdir - & User.accountFor (User builduser) - -- Install current versions of build deps from cabal. - & tree "armel" - & buildDepsNoHaskellLibs - & cabalDeps - -- The armel builder can ssh to this companion. - & Docker.expose "22" - & Apt.serviceInstalledRunning "ssh" - & Ssh.authorizedKeys (User builduser) (Context "armel-git-annex-builder") - & Docker.tweaked - -armelAutoBuilderContainer :: (System -> Docker.Image) -> Times -> TimeOut -> Docker.Container -armelAutoBuilderContainer dockerImage crontimes timeout = Docker.container "armel-git-annex-builder" - (dockerImage $ System (Debian Unstable) "armel") - & os (System (Debian Testing) "armel") - & Apt.stdSourcesList - & Apt.installed ["systemd"] - & Apt.installed ["openssh-client"] - & Docker.link "armel-git-annex-builder-companion" "companion" - & Docker.volumes_from "armel-git-annex-builder-companion" - & User.accountFor (User builduser) - -- TODO: automate installing haskell libs - -- (Currently have to run - -- git-annex/standalone/linux/install-haskell-packages - -- which is not fully automated.) - & buildDepsNoHaskellLibs - & autobuilder "armel" crontimes timeout - `requires` tree "armel" - & Ssh.keyImported SshRsa (User builduser) (Context "armel-git-annex-builder") - & trivial writecompanionaddress - & Docker.tweaked - where - writecompanionaddress = scriptProperty - [ "echo \"$COMPANION_PORT_22_TCP_ADDR\" > " ++ homedir "companion_address" - ] `describe` "companion_address file" -- cgit v1.2.3 From a5bb972d94b2e29f73ecfa4abab275400d0caeef Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 13:56:30 -0400 Subject: remove Params constructor Before it gets into released API... --- src/Propellor/Ssh.hs | 5 +++-- src/Utility/SafeCommand.hs | 14 ++++++-------- 2 files changed, 9 insertions(+), 10 deletions(-) (limited to 'src') diff --git a/src/Propellor/Ssh.hs b/src/Propellor/Ssh.hs index ac9295d1..3fe78f7a 100644 --- a/src/Propellor/Ssh.hs +++ b/src/Propellor/Ssh.hs @@ -22,7 +22,8 @@ sshCachingParams hn = do let ps = [ Param "-o" , Param ("ControlPath=" ++ socketfile) - , Params "-o ControlMaster=auto -o ControlPersist=yes" + , Param "-o", Param "ControlMaster=auto" + , Param "-o", Param "ControlPersist=yes" ] maybe noop (expireold ps socketfile) @@ -37,7 +38,7 @@ sshCachingParams hn = do then touchFile f else do void $ boolSystem "ssh" $ - [ Params "-O stop" ] ++ ps ++ + [ Param "-O", Param "stop" ] ++ ps ++ [ Param "localhost" ] nukeFile f tenminutes = 600 diff --git a/src/Utility/SafeCommand.hs b/src/Utility/SafeCommand.hs index 82e35049..9102b726 100644 --- a/src/Utility/SafeCommand.hs +++ b/src/Utility/SafeCommand.hs @@ -19,25 +19,23 @@ import Prelude -- | Parameters that can be passed to a shell command. data CommandParam - = Params String -- ^ Contains multiple parameters, separated by whitespace - | Param String -- ^ A single parameter + = Param String -- ^ A parameter | File FilePath -- ^ The name of a file deriving (Eq, Show, Ord) -- | Used to pass a list of CommandParams to a function that runs -- a command and expects Strings. -} toCommand :: [CommandParam] -> [String] -toCommand = concatMap unwrap +toCommand = map unwrap where - unwrap (Param s) = [s] - unwrap (Params s) = filter (not . null) (split " " s) + unwrap (Param s) = s -- Files that start with a non-alphanumeric that is not a path -- separator are modified to avoid the command interpreting them as -- options or other special constructs. unwrap (File s@(h:_)) - | isAlphaNum h || h `elem` pathseps = [s] - | otherwise = ["./" ++ s] - unwrap (File s) = [s] + | isAlphaNum h || h `elem` pathseps = s + | otherwise = "./" ++ s + unwrap (File s) = s -- '/' is explicitly included because it's an alternative -- path separator on Windows. pathseps = pathSeparator:"./" -- cgit v1.2.3 From 65357750d212ac3d8faaad0340f8259d74913810 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 14:18:36 -0400 Subject: Added publish property for systemd-spawn containers. (Needs systemd version 220.) --- debian/changelog | 2 ++ src/Propellor/Property/Systemd.hs | 46 ++++++++++++++++++++++++++++++++++++--- 2 files changed, 45 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/debian/changelog b/debian/changelog index 6a105804..9b75e118 100644 --- a/debian/changelog +++ b/debian/changelog @@ -15,6 +15,8 @@ propellor (2.5.0) UNRELEASED; urgency=medium * Mount /proc inside a chroot before provisioning it, to work around #787227 * --spin now works when given a short hostname that only resolves to an ipv6 address. + * Added publish property for systemd-spawn containers. + (Needs systemd version 220.) -- Joey Hess Thu, 07 May 2015 12:08:34 -0400 diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index c698f780..21b66cb8 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -1,22 +1,30 @@ module Propellor.Property.Systemd ( + -- * Services module Propellor.Property.Systemd.Core, ServiceName, - MachineName, started, stopped, enabled, disabled, restarted, - persistentJournal, + -- * Configuration Option, configured, - journaldConfigured, daemonReloaded, + -- * Journal + persistentJournal, + journaldConfigured, + -- * Containers + MachineName, Container, container, nspawned, + -- * Container configuration containerCfg, resolvConfed, + publish, + Proto(..), + publish' ) where import Propellor @@ -24,6 +32,7 @@ import Propellor.Types.Chroot import qualified Propellor.Property.Chroot as Chroot import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File +import Propellor.Property.Firewall (Port) import Propellor.Property.Systemd.Core import Utility.FileMode @@ -270,3 +279,34 @@ containerCfg p = RevertableProperty (mk True) (mk False) -- This property is enabled by default. Revert it to disable it. resolvConfed :: RevertableProperty resolvConfed = containerCfg "bind=/etc/resolv.conf" + +-- | Disconnect networking of the container from the host. +privateNetwork :: RevertableProperty +privateNetwork = containerCfg "private-network" + +-- | Publish a container's (tcp) port to same port on the host. +-- +-- This automatically enables privateNetwork, so all non-published ports +-- will not be accessible outside the container. +-- +-- Note that this feature was first added in systemd version 220. +publish :: Port -> RevertableProperty +publish p = publish' TCP p p + `requires` privateNetwork + +data Proto = TCP | UDP + +publish' + :: Proto + -> Port -- ^ Host port + -> Port -- ^ Container port + -> RevertableProperty +publish' proto hostport containerport = containerCfg $ "--port=" ++ + intercalate ":" + [ sproto proto + , show hostport + , show containerport + ] + where + sproto TCP = "tcp" + sproto UDP = "udp" -- cgit v1.2.3 From a7045f737efe76c7346a1ac34f10d0d8d311ff89 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 14:51:56 -0400 Subject: propellor spin --- config-joey.hs | 32 ++++++++++++++++++-------------- src/Propellor/Property/Systemd.hs | 17 ++++++++++++++++- 2 files changed, 34 insertions(+), 15 deletions(-) (limited to 'src') diff --git a/config-joey.hs b/config-joey.hs index 8fb03f01..56f1eb93 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -76,7 +76,6 @@ darkstar = host "darkstar.kitenet.net" & ipv6 "2001:4830:1600:187::2" -- sixxs tunnel & Apt.buildDep ["git-annex"] `period` Daily - & Docker.configured & JoeySites.postfixClientRelay (Context "darkstar.kitenet.net") & JoeySites.dkimMilter @@ -84,7 +83,6 @@ darkstar = host "darkstar.kitenet.net" gnu :: Host gnu = host "gnu.kitenet.net" & Apt.buildDep ["git-annex"] `period` Daily - & Docker.configured & JoeySites.postfixClientRelay (Context "gnu.kitenet.net") & JoeySites.dkimMilter @@ -256,9 +254,6 @@ kite = standardSystemUnhardened "kite.kitenet.net" Testing "amd64" , "zsh" ] - & Docker.configured - & Docker.garbageCollected `period` Daily - & alias "nntp.olduse.net" & JoeySites.oldUseNetServer hosts @@ -414,8 +409,8 @@ iabak = host "iabak.archiveteam.org" -- Simple web server, publishing the outside host's /var/www webserver :: Systemd.Container webserver = standardStableContainer "webserver" - & Docker.publish "80:80" - & Docker.volume "/var/www:/var/www" + & Systemd.publish 80 + & Systemd.bind "/var/www" & Apt.serviceInstalledRunning "apache2" webserver' :: Docker.Container @@ -449,7 +444,7 @@ oldusenetShellBox = standardStableDockerContainer "oldusenet-shellbox" & JoeySites.oldUseNetShellBox jerryPlay :: Docker.Container -jerryPlay = standardContainer "jerryplay" Unstable "amd64" +jerryPlay = standardDockerContainer "jerryplay" Unstable "amd64" & alias "jerryplay.kitenet.net" & Docker.publish "2202:22" & Docker.publish "8001:80" @@ -491,16 +486,25 @@ standardSystemUnhardened hn suite arch motd = host hn & Apt.removed ["exim4", "exim4-daemon-light", "exim4-config", "exim4-base"] `onChange` Apt.autoRemove +-- This is my standard container setup, Featuring automatic upgrades. +standardContainer :: Systemd.MachineName -> DebianSuite -> Architecture -> Systemd.Container +standardContainer name suite arch = Systemd.container name chroot + & os system + & Apt.stdSourcesList `onChange` Apt.upgrade + & Apt.unattendedUpgrades + & Apt.cacheCleaned + where + system = System (Debian suite) arch + chroot = Chroot.debootstrapped system mempty + standardStableContainer :: Systemd.MachineName -> Systemd.Container -standardStableContainer name = Systemd.container name $ - Chroot.debootstrapped (System (Debian (Stable "jessie")) "amd64") mempty +standardStableContainer name = standardContainer name (Stable "jessie") "amd64" standardStableDockerContainer :: Docker.ContainerName -> Docker.Container -standardStableDockerContainer name = standardContainer name (Stable "jessie") "amd64" +standardStableDockerContainer name = standardDockerContainer name (Stable "jessie") "amd64" --- This is my standard container setup, Featuring automatic upgrades. -standardContainer :: Docker.ContainerName -> DebianSuite -> Architecture -> Docker.Container -standardContainer name suite arch = Docker.container name (dockerImage system) +standardDockerContainer :: Docker.ContainerName -> DebianSuite -> Architecture -> Docker.Container +standardDockerContainer name suite arch = Docker.container name (dockerImage system) & os system & Apt.stdSourcesList `onChange` Apt.upgrade & Apt.unattendedUpgrades diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 21b66cb8..973314ac 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -24,7 +24,9 @@ module Propellor.Property.Systemd ( resolvConfed, publish, Proto(..), - publish' + publish', + bind, + bindRo, ) where import Propellor @@ -274,6 +276,8 @@ containerCfg p = RevertableProperty (mk True) (mk False) ('-':_) -> p _ -> "--" ++ p + + -- | Bind mounts from the host into the container. -- -- This property is enabled by default. Revert it to disable it. @@ -310,3 +314,14 @@ publish' proto hostport containerport = containerCfg $ "--port=" ++ where sproto TCP = "tcp" sproto UDP = "udp" + +-- | Bind mount a file or directory from the host into the container. +-- +-- The parameter can be a FilePath, or a colon-separated pair of +-- hostpath:containerpath. +bind :: FilePath -> RevertableProperty +bind f = containerCfg $ "--bind=" ++ f + +-- | Read-only mind mount. +bindRo :: FilePath -> RevertableProperty +bindRo f = containerCfg $ "--bind-ro=" ++ f -- cgit v1.2.3 From a50edc3d9f1fc630ba5f72aba6cfec9aca71c204 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 16:05:31 -0400 Subject: better types for systemd port publishing --- config-joey.hs | 4 +-- debian/changelog | 5 ++-- src/Propellor/Property/Systemd.hs | 59 ++++++++++++++++++++++----------------- 3 files changed, 39 insertions(+), 29 deletions(-) (limited to 'src') diff --git a/config-joey.hs b/config-joey.hs index 56f1eb93..ff06333d 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -104,8 +104,8 @@ clam = standardSystem "clam.kitenet.net" Unstable "amd64" & Docker.garbageCollected `period` Daily ! Docker.docked webserver' & File.dirExists "/var/www/html" - & File.notPresent "/var/www/html/index.html" - & "/var/www/index.html" `File.hasContent` ["hello, world"] + & File.notPresent "/var/www/index.html" + & "/var/www/html/index.html" `File.hasContent` ["hello, world"] & alias "helloworld.kitenet.net" & Docker.docked oldusenetShellBox diff --git a/debian/changelog b/debian/changelog index 9b75e118..a4c40ea5 100644 --- a/debian/changelog +++ b/debian/changelog @@ -8,15 +8,16 @@ propellor (2.5.0) UNRELEASED; urgency=medium * createProcess from Propellor.Property.Cmd, so they are available for use in constricting your own Properties when using propellor as a library. - * Improve enter-machine scripts for nspawn containers to unset most + * Improve enter-machine scripts for systemd-nspawn containers to unset most environment variables. * Fix Postfix.satellite bug; the default relayhost was set to the domain, not to smtp.domain as documented. * Mount /proc inside a chroot before provisioning it, to work around #787227 * --spin now works when given a short hostname that only resolves to an ipv6 address. - * Added publish property for systemd-spawn containers. + * Added publish and publish' properties for systemd-spawn containers. (Needs systemd version 220.) + * Added bind and bindRo properties for systemd-spawn containers. -- Joey Hess Thu, 07 May 2015 12:08:34 -0400 diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 973314ac..34e51ba9 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TypeSynonymInstances #-} + module Propellor.Property.Systemd ( -- * Services module Propellor.Property.Systemd.Core, @@ -22,9 +24,12 @@ module Propellor.Property.Systemd ( -- * Container configuration containerCfg, resolvConfed, - publish, + Publishable(..), + privateNetwork, + ForwardedPort(..), Proto(..), - publish', + PortSpec(..), + publish, bind, bindRo, ) where @@ -288,32 +293,36 @@ resolvConfed = containerCfg "bind=/etc/resolv.conf" privateNetwork :: RevertableProperty privateNetwork = containerCfg "private-network" --- | Publish a container's (tcp) port to same port on the host. --- --- This automatically enables privateNetwork, so all non-published ports --- will not be accessible outside the container. --- --- Note that this feature was first added in systemd version 220. -publish :: Port -> RevertableProperty -publish p = publish' TCP p p - `requires` privateNetwork +class Publishable a where + toPublish :: a -> String + +instance Publishable Port where + toPublish p = show p + +data ForwardedPort = ForwardedPort + { hostPort :: Port + , containerPort :: Port + } + +instance Publishable ForwardedPort where + toPublish fp = show (hostPort fp) ++ ":" ++ show (containerPort fp) data Proto = TCP | UDP -publish' - :: Proto - -> Port -- ^ Host port - -> Port -- ^ Container port - -> RevertableProperty -publish' proto hostport containerport = containerCfg $ "--port=" ++ - intercalate ":" - [ sproto proto - , show hostport - , show containerport - ] - where - sproto TCP = "tcp" - sproto UDP = "udp" +data PortSpec = PortSpec Proto ForwardedPort + +instance Publishable PortSpec where + toPublish (PortSpec TCP fp) = "tcp:" ++ toPublish fp + toPublish (PortSpec UDP fp) = "udp:" ++ toPublish fp + +-- | Publish a port from the container on the host. +-- +-- Note that this will only work if the container's network is set up +-- by other properties. +-- +-- This feature was first added in systemd version 220. +publish :: Publishable p => p -> RevertableProperty +publish p = containerCfg $ "--port=" ++ toPublish p -- | Bind mount a file or directory from the host into the container. -- -- cgit v1.2.3 From 85c3d110882f0f9d70316235221ba8b20754661f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 16:12:21 -0400 Subject: reorganize Port type for systemd can use it --- config-joey.hs | 2 +- debian/changelog | 3 +++ src/Propellor/Property/Firewall.hs | 23 ++++++++++------------- src/Propellor/Property/Systemd.hs | 9 +++------ src/Propellor/Types/OS.hs | 4 ++++ 5 files changed, 21 insertions(+), 20 deletions(-) (limited to 'src') diff --git a/config-joey.hs b/config-joey.hs index ff06333d..83eb5430 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -409,7 +409,7 @@ iabak = host "iabak.archiveteam.org" -- Simple web server, publishing the outside host's /var/www webserver :: Systemd.Container webserver = standardStableContainer "webserver" - & Systemd.publish 80 + & Systemd.publish (Port 80) & Systemd.bind "/var/www" & Apt.serviceInstalledRunning "apache2" diff --git a/debian/changelog b/debian/changelog index a4c40ea5..599143d8 100644 --- a/debian/changelog +++ b/debian/changelog @@ -18,6 +18,9 @@ propellor (2.5.0) UNRELEASED; urgency=medium * Added publish and publish' properties for systemd-spawn containers. (Needs systemd version 220.) * Added bind and bindRo properties for systemd-spawn containers. + * Firewall: Port was changed to a newtype, and the Port and PortRange + constructors of Rules were changed to DPort and DportRange, respectively. + (API change) -- Joey Hess Thu, 07 May 2015 12:08:34 -0400 diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs index ab57b122..d643b185 100644 --- a/src/Propellor/Property/Firewall.hs +++ b/src/Propellor/Property/Firewall.hs @@ -9,7 +9,6 @@ module Propellor.Property.Firewall ( Target(..), Proto(..), Rules(..), - Port, ConnectionState(..) ) where @@ -45,8 +44,8 @@ toIpTable r = map Param $ toIpTableArg :: Rules -> [String] toIpTableArg Everything = [] toIpTableArg (Proto proto) = ["-p", map toLower $ show proto] -toIpTableArg (Port port) = ["--dport", show port] -toIpTableArg (PortRange (f,t)) = ["--dport", show f ++ ":" ++ show t] +toIpTableArg (DPort port) = ["--dport", show port] +toIpTableArg (DPortRange (f,t)) = ["--dport", show f ++ ":" ++ show t] toIpTableArg (IFace iface) = ["-i", iface] toIpTableArg (Ctstate states) = ["-m", "conntrack","--ctstate", concat $ intersperse "," (map show states)] toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r' @@ -55,33 +54,31 @@ data Rule = Rule { ruleChain :: Chain , ruleTarget :: Target , ruleRules :: Rules - } deriving (Eq, Show, Read) + } deriving (Eq, Show) data Chain = INPUT | OUTPUT | FORWARD - deriving (Eq,Show,Read) + deriving (Eq, Show) data Target = ACCEPT | REJECT | DROP | LOG - deriving (Eq,Show,Read) + deriving (Eq, Show) data Proto = TCP | UDP | ICMP - deriving (Eq,Show,Read) - -type Port = Int + deriving (Eq, Show) data ConnectionState = ESTABLISHED | RELATED | NEW | INVALID - deriving (Eq,Show,Read) + deriving (Eq, Show) data Rules = Everything | Proto Proto -- ^There is actually some order dependency between proto and port so this should be a specific -- data type with proto + ports - | Port Port - | PortRange (Port,Port) + | DPort Port + | DPortRange (Port,Port) | IFace Network.Interface | Ctstate [ ConnectionState ] | Rules :- Rules -- ^Combine two rules - deriving (Eq,Show,Read) + deriving (Eq, Show) infixl 0 :- diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 34e51ba9..9e5ca432 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE TypeSynonymInstances #-} - module Propellor.Property.Systemd ( -- * Services module Propellor.Property.Systemd.Core, @@ -24,11 +22,11 @@ module Propellor.Property.Systemd ( -- * Container configuration containerCfg, resolvConfed, - Publishable(..), privateNetwork, ForwardedPort(..), Proto(..), PortSpec(..), + Publishable, publish, bind, bindRo, @@ -39,7 +37,6 @@ import Propellor.Types.Chroot import qualified Propellor.Property.Chroot as Chroot import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File -import Propellor.Property.Firewall (Port) import Propellor.Property.Systemd.Core import Utility.FileMode @@ -297,7 +294,7 @@ class Publishable a where toPublish :: a -> String instance Publishable Port where - toPublish p = show p + toPublish (Port n) = show n data ForwardedPort = ForwardedPort { hostPort :: Port @@ -305,7 +302,7 @@ data ForwardedPort = ForwardedPort } instance Publishable ForwardedPort where - toPublish fp = show (hostPort fp) ++ ":" ++ show (containerPort fp) + toPublish fp = toPublish (hostPort fp) ++ ":" ++ toPublish (containerPort fp) data Proto = TCP | UDP diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs index 58bd809a..c46d9a28 100644 --- a/src/Propellor/Types/OS.hs +++ b/src/Propellor/Types/OS.hs @@ -10,6 +10,7 @@ module Propellor.Types.OS ( User(..), Group(..), userGroup, + Port(..), ) where import Network.BSD (HostName) @@ -42,3 +43,6 @@ newtype Group = Group String -- | Makes a Group with the same name as the User. userGroup :: User -> Group userGroup (User u) = Group u + +newtype Port = Port Int + deriving (Eq, Show) -- cgit v1.2.3 From c0b9c708c93b104dfca1bff80e082e2d2b0ad0a6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 16:22:15 -0400 Subject: don't mount /proc when provisioning systemd-nspawn container While needed for chroot provisioning, it confuses system when systemd-nspawn runs it inside the container. --- src/Propellor/Property/Chroot.hs | 23 ++++++++++++----------- src/Propellor/Property/Systemd.hs | 4 ++-- 2 files changed, 14 insertions(+), 13 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 0e9d00d8..7e7d1611 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -95,7 +95,7 @@ chrootInfo (Chroot loc _ _ h) = mempty { _chrootinfo = mempty { _chroots = M.singleton loc h } } -- | Propellor is run inside the chroot to provision it. -propellChroot :: Chroot -> ([String] -> CreateProcess) -> Bool -> Property NoInfo +propellChroot :: Chroot -> ([String] -> IO CreateProcess) -> Bool -> Property NoInfo propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do let d = localdir shimdir c let me = localdir "propellor" @@ -103,7 +103,6 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c " ( pure (Shim.file me d) , Shim.setup me Nothing d ) - liftIO mountproc ifM (liftIO $ bindmount shim) ( chainprovision shim , return FailedChange @@ -119,18 +118,12 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c " , File localdir, File mntpnt ] ) - - -- /proc needs to be mounted in the chroot for the linker to use - -- /proc/self/exe which is necessary for some commands to work - mountproc = unlessM (elem procloc <$> mountPointsBelow loc) $ - void $ mount "proc" "proc" procloc - procloc = loc "proc" chainprovision shim = do parenthost <- asks hostName cmd <- liftIO $ toChain parenthost c systemdonly pe <- liftIO standardPathEnv - let p = mkproc + p <- liftIO $ mkproc [ shim , "--continue" , show cmd @@ -164,8 +157,16 @@ chain hostlist (ChrootChain hn loc systemdonly onconsole) = putStrLn $ "\n" ++ show r chain _ _ = errorMessage "bad chain command" -inChrootProcess :: Chroot -> [String] -> CreateProcess -inChrootProcess (Chroot loc _ _ _) cmd = proc "chroot" (loc:cmd) +inChrootProcess :: Chroot -> [String] -> IO CreateProcess +inChrootProcess (Chroot loc _ _ _) cmd = do + mountproc + return $ proc "chroot" (loc:cmd) + where + -- /proc needs to be mounted in the chroot for the linker to use + -- /proc/self/exe which is necessary for some commands to work + mountproc = unlessM (elem procloc <$> mountPointsBelow loc) $ + void $ mount "proc" "proc" procloc + procloc = loc "proc" provisioningLock :: FilePath -> FilePath provisioningLock containerloc = "chroot" mungeloc containerloc ++ ".lock" diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 9e5ca432..c2446b2e 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -250,8 +250,8 @@ enterScript c@(Container name _ _) = setup teardown enterScriptFile :: Container -> FilePath enterScriptFile (Container name _ _ ) = "/usr/local/bin/enter-" ++ mungename name -enterContainerProcess :: Container -> [String] -> CreateProcess -enterContainerProcess = proc . enterScriptFile +enterContainerProcess :: Container -> [String] -> IO CreateProcess +enterContainerProcess c ps = pure $ proc (enterScriptFile c) ps nspawnServiceName :: MachineName -> ServiceName nspawnServiceName name = "systemd-nspawn@" ++ name ++ ".service" -- cgit v1.2.3 From 06ebb4593acb0ae70e9413ee63df41eb250adb92 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 17:00:57 -0400 Subject: propellor spin --- debian/changelog | 2 +- src/Propellor/Property/Systemd.hs | 16 ++++++++++++++-- 2 files changed, 15 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/debian/changelog b/debian/changelog index 599143d8..c262eadf 100644 --- a/debian/changelog +++ b/debian/changelog @@ -15,7 +15,7 @@ propellor (2.5.0) UNRELEASED; urgency=medium * Mount /proc inside a chroot before provisioning it, to work around #787227 * --spin now works when given a short hostname that only resolves to an ipv6 address. - * Added publish and publish' properties for systemd-spawn containers. + * Added publish property for systemd-spawn containers, for port publishing. (Needs systemd version 220.) * Added bind and bindRo properties for systemd-spawn containers. * Firewall: Port was changed to a newtype, and the Port and PortRange diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index c2446b2e..ea8c994e 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -38,6 +38,7 @@ import qualified Propellor.Property.Chroot as Chroot import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File import Propellor.Property.Systemd.Core +import Propellor.Property.Mount import Utility.FileMode import Data.List @@ -165,8 +166,19 @@ nspawned c@(Container name (Chroot.Chroot loc system builderconf _) h) = -- Chroot provisioning is run in systemd-only mode, -- which sets up the chroot and ensures systemd and dbus are -- installed, but does not handle the other provisions. - chrootprovisioned = Chroot.provisioned' - (Chroot.propigateChrootInfo chroot) chroot True + chrootprovisioned = + (toProp provisioner `onChange` umountProc) + + (toProp (revert provisioner)) + provisioner = Chroot.provisioned' (Chroot.propigateChrootInfo chroot) chroot True + + -- The chroot's /proc is left mounted by the chroot provisioning, + -- but that will prevent systemd-nspawn from starting systemd in + -- it, so unmount. + umountProc = check (elem procloc <$> mountPointsBelow loc) $ + property (procloc ++ " unmounted") $ do + makeChange $ umountLazy procloc + procloc = loc "proc" -- Use nsenter to enter container and and run propellor to -- finish provisioning. -- cgit v1.2.3 From b4503a782bfafd5b08c51f00e4c90539cae34009 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 17:44:37 -0400 Subject: explicitly speciy params for systemd-nspawn ExecStart It was using whatever was in /lib/systemd/system/systemd-nspawn@.service, but systemd 220 added --network-veth to that, which can break existing setups. So don't do that. --- src/Propellor/Property/Systemd.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index ea8c994e..87290fc0 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -202,8 +202,14 @@ nspawnService (Container name _ _) cfg = setup teardown return $ unlines $ "# deployed by propellor" : map addparams ls addparams l - | "ExecStart=" `isPrefixOf` l = - l ++ " " ++ unwords (nspawnServiceParams cfg) + | "ExecStart=" `isPrefixOf` l = unwords $ + [ "ExecStart = /usr/bin/systemd-nspawn" + , "--quiet" + , "--keep-unit" + , "--boot" + , "--link-journal=try-guest" + , "--directory=/var/lib/container/%i" + ] ++ nspawnServiceParams cfg | otherwise = l goodservicefile = (==) @@ -290,8 +296,6 @@ containerCfg p = RevertableProperty (mk True) (mk False) ('-':_) -> p _ -> "--" ++ p - - -- | Bind mounts from the host into the container. -- -- This property is enabled by default. Revert it to disable it. -- cgit v1.2.3 From 6d36de695ce187ed08b6fe8893c5e3cda1577d96 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 17:51:20 -0400 Subject: add linkJournal property so it can be reverted to disable --- src/Propellor/Property/Systemd.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 87290fc0..83cc1eaa 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -22,6 +22,7 @@ module Propellor.Property.Systemd ( -- * Container configuration containerCfg, resolvConfed, + linkJournal, privateNetwork, ForwardedPort(..), Proto(..), @@ -136,6 +137,7 @@ container :: MachineName -> (FilePath -> Chroot.Chroot) -> Container container name mkchroot = Container name c h & os system & resolvConfed + & linkJournal where c@(Chroot.Chroot _ system _ _) = mkchroot (containerDir name) h = Host name [] mempty @@ -207,7 +209,6 @@ nspawnService (Container name _ _) cfg = setup teardown , "--quiet" , "--keep-unit" , "--boot" - , "--link-journal=try-guest" , "--directory=/var/lib/container/%i" ] ++ nspawnServiceParams cfg | otherwise = l @@ -302,6 +303,13 @@ containerCfg p = RevertableProperty (mk True) (mk False) resolvConfed :: RevertableProperty resolvConfed = containerCfg "bind=/etc/resolv.conf" +-- | Link the container's journal to the host's if possible. +-- (Only works if the host has persistent journal enabled.) +-- +-- This property is enabled by default. Revert it to disable it. +linkJournal :: RevertableProperty +linkJournal = containerCfg "link-journal=try-guest" + -- | Disconnect networking of the container from the host. privateNetwork :: RevertableProperty privateNetwork = containerCfg "private-network" -- cgit v1.2.3 From ef1307652e502882cecdccdfc1773f4cf390ad17 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 18:14:47 -0400 Subject: another try at unmounting /proc for systemd-nspawn --- src/Propellor/Property/Chroot.hs | 24 ++++++++++++++++-------- src/Propellor/Property/Systemd.hs | 24 ++++++------------------ 2 files changed, 22 insertions(+), 26 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 7e7d1611..ded108bc 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -16,10 +16,10 @@ import Propellor import Propellor.Types.CmdLine import Propellor.Types.Chroot import Propellor.Property.Chroot.Util -import Propellor.Property.Mount import qualified Propellor.Property.Debootstrap as Debootstrap import qualified Propellor.Property.Systemd.Core as Systemd import qualified Propellor.Shim as Shim +import Propellor.Property.Mount import qualified Data.Map as M import Data.List.Utils @@ -70,7 +70,7 @@ provisioned' propigator c@(Chroot loc system builderconf _) systemdonly = where go desc a = propertyList (chrootDesc c desc) [a] - setup = propellChroot c (inChrootProcess c) systemdonly + setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly `requires` toProp built built = case (system, builderconf) of @@ -95,7 +95,7 @@ chrootInfo (Chroot loc _ _ h) = mempty { _chrootinfo = mempty { _chroots = M.singleton loc h } } -- | Propellor is run inside the chroot to provision it. -propellChroot :: Chroot -> ([String] -> IO CreateProcess) -> Bool -> Property NoInfo +propellChroot :: Chroot -> ([String] -> IO (CreateProcess, IO ())) -> Bool -> Property NoInfo propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c "provisioned") $ do let d = localdir shimdir c let me = localdir "propellor" @@ -123,14 +123,16 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c " parenthost <- asks hostName cmd <- liftIO $ toChain parenthost c systemdonly pe <- liftIO standardPathEnv - p <- liftIO $ mkproc + (p, cleanup) <- liftIO $ mkproc [ shim , "--continue" , show cmd ] let p' = p { env = Just pe } - liftIO $ withHandle StdoutHandle createProcessSuccess p' + r <- liftIO $ withHandle StdoutHandle createProcessSuccess p' processChainOutput + liftIO cleanup + return r toChain :: HostName -> Chroot -> Bool -> IO CmdLine toChain parenthost (Chroot loc _ _ _) systemdonly = do @@ -157,17 +159,23 @@ chain hostlist (ChrootChain hn loc systemdonly onconsole) = putStrLn $ "\n" ++ show r chain _ _ = errorMessage "bad chain command" -inChrootProcess :: Chroot -> [String] -> IO CreateProcess -inChrootProcess (Chroot loc _ _ _) cmd = do +inChrootProcess :: Bool -> Chroot -> [String] -> IO (CreateProcess, IO ()) +inChrootProcess keepprocmounted (Chroot loc _ _ _) cmd = do mountproc - return $ proc "chroot" (loc:cmd) + return (proc "chroot" (loc:cmd), cleanup) where -- /proc needs to be mounted in the chroot for the linker to use -- /proc/self/exe which is necessary for some commands to work mountproc = unlessM (elem procloc <$> mountPointsBelow loc) $ void $ mount "proc" "proc" procloc + procloc = loc "proc" + cleanup + | keepprocmounted = noop + | otherwise = whenM (elem procloc <$> mountPointsBelow loc) $ + umountLazy procloc + provisioningLock :: FilePath -> FilePath provisioningLock containerloc = "chroot" mungeloc containerloc ++ ".lock" diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 83cc1eaa..a46fe4f8 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -39,7 +39,6 @@ import qualified Propellor.Property.Chroot as Chroot import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File import Propellor.Property.Systemd.Core -import Propellor.Property.Mount import Utility.FileMode import Data.List @@ -168,19 +167,7 @@ nspawned c@(Container name (Chroot.Chroot loc system builderconf _) h) = -- Chroot provisioning is run in systemd-only mode, -- which sets up the chroot and ensures systemd and dbus are -- installed, but does not handle the other provisions. - chrootprovisioned = - (toProp provisioner `onChange` umountProc) - - (toProp (revert provisioner)) - provisioner = Chroot.provisioned' (Chroot.propigateChrootInfo chroot) chroot True - - -- The chroot's /proc is left mounted by the chroot provisioning, - -- but that will prevent systemd-nspawn from starting systemd in - -- it, so unmount. - umountProc = check (elem procloc <$> mountPointsBelow loc) $ - property (procloc ++ " unmounted") $ do - makeChange $ umountLazy procloc - procloc = loc "proc" + chrootprovisioned = Chroot.provisioned' (Chroot.propigateChrootInfo chroot) chroot True -- Use nsenter to enter container and and run propellor to -- finish provisioning. @@ -269,8 +256,8 @@ enterScript c@(Container name _ _) = setup teardown enterScriptFile :: Container -> FilePath enterScriptFile (Container name _ _ ) = "/usr/local/bin/enter-" ++ mungename name -enterContainerProcess :: Container -> [String] -> IO CreateProcess -enterContainerProcess c ps = pure $ proc (enterScriptFile c) ps +enterContainerProcess :: Container -> [String] -> IO (CreateProcess, IO ()) +enterContainerProcess c ps = pure (proc (enterScriptFile c) ps, noop) nspawnServiceName :: MachineName -> ServiceName nspawnServiceName name = "systemd-nspawn@" ++ name ++ ".service" @@ -338,8 +325,9 @@ instance Publishable PortSpec where -- | Publish a port from the container on the host. -- --- Note that this will only work if the container's network is set up --- by other properties. +-- Note that this will only work if the container is set up to use +-- private networking. If the container does not use private networking, +-- this property is not needed. -- -- This feature was first added in systemd version 220. publish :: Publishable p => p -> RevertableProperty -- cgit v1.2.3 From 87a116d5db28322d52adcf99de5e3cbd7dc43110 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 18:33:49 -0400 Subject: use --machine needed by systemd 220 for machined to see the container as a machine --- src/Propellor/Property/Systemd.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index a46fe4f8..0015276d 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -196,7 +196,7 @@ nspawnService (Container name _ _) cfg = setup teardown , "--quiet" , "--keep-unit" , "--boot" - , "--directory=/var/lib/container/%i" + , "--machine=%i" ] ++ nspawnServiceParams cfg | otherwise = l -- cgit v1.2.3 From 802f3c968df2ea623bf24102f21b22808f52d9ee Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 18:34:15 -0400 Subject: descs --- src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index d64852aa..70075968 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -109,7 +109,7 @@ autoBuilderContainer mkprop osver@(System _ arch) crontime timeout = standardAutoBuilder :: System -> Property HasInfo standardAutoBuilder osver@(System _ arch) = - propertyList "git-annex-builder" $ props + propertyList "standard git-annex autobuilder" $ props & os osver & Apt.stdSourcesList & Apt.unattendedUpgrades @@ -118,7 +118,7 @@ standardAutoBuilder osver@(System _ arch) = armAutoBuilder :: System -> Times -> TimeOut -> Property HasInfo armAutoBuilder osver@(System _ arch) crontime timeout = - propertyList "git-annex-builder (arm)" $ props + propertyList "arm git-annex autobuilder" $ props & standardAutoBuilder osver & buildDepsNoHaskellLibs -- Works around ghc crash with parallel builds on arm. -- cgit v1.2.3 From 6241a16772649d3b918085ec4f113665fcf53459 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 22:07:05 -0400 Subject: propellor spin --- src/Propellor/Property/Systemd.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src') diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 0015276d..055c02ed 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -196,6 +196,7 @@ nspawnService (Container name _ _) cfg = setup teardown , "--quiet" , "--keep-unit" , "--boot" + , "--directory=" ++ containerDir name , "--machine=%i" ] ++ nspawnServiceParams cfg | otherwise = l -- cgit v1.2.3 From 765367dab9b61a512e07268c921f950677af4f27 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 23:16:25 -0400 Subject: add Bound --- propellor.cabal | 1 + src/Propellor/Property/Systemd.hs | 44 ++++++++++++++++++++------------------- src/Propellor/Types/Container.hs | 30 ++++++++++++++++++++++++++ 3 files changed, 54 insertions(+), 21 deletions(-) create mode 100644 src/Propellor/Types/Container.hs (limited to 'src') diff --git a/propellor.cabal b/propellor.cabal index 16dffe31..9edc1436 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -121,6 +121,7 @@ Library Propellor.Exception Propellor.Types Propellor.Types.Chroot + Propellor.Types.Container Propellor.Types.Docker Propellor.Types.Dns Propellor.Types.Empty diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 055c02ed..1d03d557 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE FlexibleInstances #-} + module Propellor.Property.Systemd ( -- * Services module Propellor.Property.Systemd.Core, @@ -24,17 +26,18 @@ module Propellor.Property.Systemd ( resolvConfed, linkJournal, privateNetwork, - ForwardedPort(..), + module Propellor.Types.Container, Proto(..), - PortSpec(..), Publishable, publish, + Bindable, bind, bindRo, ) where import Propellor import Propellor.Types.Chroot +import Propellor.Types.Container import qualified Propellor.Property.Chroot as Chroot import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File @@ -308,21 +311,14 @@ class Publishable a where instance Publishable Port where toPublish (Port n) = show n -data ForwardedPort = ForwardedPort - { hostPort :: Port - , containerPort :: Port - } - -instance Publishable ForwardedPort where - toPublish fp = toPublish (hostPort fp) ++ ":" ++ toPublish (containerPort fp) +instance Publishable (Bound Port) where + toPublish v = toPublish (hostSide v) ++ ":" ++ toPublish (containerSide v) data Proto = TCP | UDP -data PortSpec = PortSpec Proto ForwardedPort - -instance Publishable PortSpec where - toPublish (PortSpec TCP fp) = "tcp:" ++ toPublish fp - toPublish (PortSpec UDP fp) = "udp:" ++ toPublish fp +instance Publishable (Proto, Bound Port) where + toPublish (TCP, fp) = "tcp:" ++ toPublish fp + toPublish (UDP, fp) = "udp:" ++ toPublish fp -- | Publish a port from the container on the host. -- @@ -334,13 +330,19 @@ instance Publishable PortSpec where publish :: Publishable p => p -> RevertableProperty publish p = containerCfg $ "--port=" ++ toPublish p +class Bindable a where + toBind :: a -> String + +instance Bindable FilePath where + toBind f = f + +instance Bindable (Bound FilePath) where + toBind v = hostSide v ++ ":" ++ containerSide v + -- | Bind mount a file or directory from the host into the container. --- --- The parameter can be a FilePath, or a colon-separated pair of --- hostpath:containerpath. -bind :: FilePath -> RevertableProperty -bind f = containerCfg $ "--bind=" ++ f +bind :: Bindable p => p -> RevertableProperty +bind p = containerCfg $ "--bind=" ++ toBind p -- | Read-only mind mount. -bindRo :: FilePath -> RevertableProperty -bindRo f = containerCfg $ "--bind-ro=" ++ f +bindRo :: Bindable p => p -> RevertableProperty +bindRo p = containerCfg $ "--bind-ro=" ++ toBind p diff --git a/src/Propellor/Types/Container.hs b/src/Propellor/Types/Container.hs new file mode 100644 index 00000000..d21bada7 --- /dev/null +++ b/src/Propellor/Types/Container.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE TypeFamilies #-} + +module Propellor.Types.Container where + +-- | A value that can be bound between the host and a container. +-- +-- For example, a Bound Port is a Port on the container that is bound to +-- a Port on the host. +data Bound v = Bound + { hostSide :: v + , containerSide :: v + } + +-- | Create a Bound value, from two different values for the host and +-- container. +-- +-- For example, @Port 8080 -<- Port 80@ means that port 8080 on the host +-- is bound to port 80 from the container. +(-<-) :: (hostv ~ v, containerv ~ v) => hostv -> containerv -> Bound v +(-<-) hostv containerv = Bound hostv containerv + +-- | Flipped version of -<- with the container value first and host value +-- second. +(->-) :: (containerv ~ v, hostv ~ v) => hostv -> containerv -> Bound v +(->-) containerv hostv = Bound hostv containerv + +-- | Create a Bound value, that is the same on both the host and container. +same :: v -> Bound v +same v = Bound v v + -- cgit v1.2.3 From c9dc306016d22bba092412d90e1375254caffe7b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 23:41:07 -0400 Subject: more systemd improvements --- src/Propellor/Property/Systemd.hs | 54 +++++++++++++++++++++++++++++++-------- 1 file changed, 43 insertions(+), 11 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 1d03d557..e50ef9cd 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -2,14 +2,17 @@ module Propellor.Property.Systemd ( -- * Services - module Propellor.Property.Systemd.Core, ServiceName, started, stopped, enabled, disabled, + running, restarted, + networkd, + journald, -- * Configuration + installed, Option, configured, daemonReloaded, @@ -61,6 +64,9 @@ instance PropAccum Container where getProperties (Container _ _ h) = hostProperties h -- | Starts a systemd service. +-- +-- Note that this does not configure systemd to start the service on boot, +-- it only ensures that the service is currently running. started :: ServiceName -> Property NoInfo started n = trivial $ cmdProperty "systemctl" ["start", n] `describe` ("service " ++ n ++ " started") @@ -71,6 +77,9 @@ stopped n = trivial $ cmdProperty "systemctl" ["stop", n] `describe` ("service " ++ n ++ " stopped") -- | Enables a systemd service. +-- +-- This does not ensure the service is started, it only configures systemd +-- to start it on boot. enabled :: ServiceName -> Property NoInfo enabled n = trivial $ cmdProperty "systemctl" ["enable", n] `describe` ("service " ++ n ++ " enabled") @@ -80,11 +89,23 @@ disabled :: ServiceName -> Property NoInfo disabled n = trivial $ cmdProperty "systemctl" ["disable", n] `describe` ("service " ++ n ++ " disabled") +-- | Ensures that a service is both enabled and started +running :: ServiceName -> Property NoInfo +running n = trivial $ started n `requires` enabled n + -- | Restarts a systemd service. restarted :: ServiceName -> Property NoInfo restarted n = trivial $ cmdProperty "systemctl" ["restart", n] `describe` ("service " ++ n ++ " restarted") +-- | The systemd-networkd service. +networkd :: ServiceName +networkd = "systemd-networkd" + +-- | The systemd-journald service. +journald :: ServiceName +journald = "systemd-journald" + -- | Enables persistent storage of the journal. persistentJournal :: Property NoInfo persistentJournal = check (not <$> doesDirectoryExist dir) $ @@ -118,15 +139,15 @@ configured cfgfile option value = combineProperties desc | setting `isPrefixOf` l = Nothing | otherwise = Just l +-- | Causes systemd to reload its configuration files. +daemonReloaded :: Property NoInfo +daemonReloaded = trivial $ cmdProperty "systemctl" ["daemon-reload"] + -- | Configures journald, restarting it so the changes take effect. journaldConfigured :: Option -> String -> Property NoInfo journaldConfigured option value = configured "/etc/systemd/journald.conf" option value - `onChange` restarted "systemd-journald" - --- | Causes systemd to reload its configuration files. -daemonReloaded :: Property NoInfo -daemonReloaded = trivial $ cmdProperty "systemctl" ["daemon-reload"] + `onChange` restarted journald -- | Defines a container with a given machine name. -- @@ -320,13 +341,24 @@ instance Publishable (Proto, Bound Port) where toPublish (TCP, fp) = "tcp:" ++ toPublish fp toPublish (UDP, fp) = "udp:" ++ toPublish fp --- | Publish a port from the container on the host. +-- | Publish a port from the container to the host. +-- +-- This feature was first added in systemd version 220. -- --- Note that this will only work if the container is set up to use --- private networking. If the container does not use private networking, --- this property is not needed. +-- This property is only needed (and will only work) if the container +-- is configured private networking. Also, networkd should be enabled +-- both inside the container, and on the host. For example: -- --- This feature was first added in systemd version 220. +-- > foo :: Host +-- > foo = host "foo.example.com" +-- > & Systemd.running Systemd.networkd +-- > & Systemd.nspawned webserver +-- > +-- > webserver :: Systemd.container +-- > webserver = Systemd.container "webserver" (Chroot.debootstrapped (System (Debian Testing) "amd64") mempty) +-- > & Systemd.running Systemd.networkd +-- > & Systemd.publish (Port 80 ->- Port 8080) +-- > & Apt.installedRunning "apache2" publish :: Publishable p => p -> RevertableProperty publish p = containerCfg $ "--port=" ++ toPublish p -- cgit v1.2.3 From e11c68cf1e515746e3bd0256a949e182ae735f99 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 1 Jun 2015 23:57:33 -0400 Subject: Docker: volume and publish accept Bound FilePath and Bound Port, respectively. They also continue to accept Strings, for backwards compatability. --- debian/changelog | 3 +++ src/Propellor/Property/Docker.hs | 36 +++++++++++++++++++++++++++++------- 2 files changed, 32 insertions(+), 7 deletions(-) (limited to 'src') diff --git a/debian/changelog b/debian/changelog index c262eadf..f4459a2c 100644 --- a/debian/changelog +++ b/debian/changelog @@ -21,6 +21,9 @@ propellor (2.5.0) UNRELEASED; urgency=medium * Firewall: Port was changed to a newtype, and the Port and PortRange constructors of Rules were changed to DPort and DportRange, respectively. (API change) + * Docker: volume and publish accept Bound FilePath and Bound Port, + respectively. They also continue to accept Strings, for backwards + compatability. -- Joey Hess Thu, 07 May 2015 12:08:34 -0400 diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index fd7e37b2..1dcc3522 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -23,9 +23,11 @@ module Propellor.Property.Docker ( -- * Container configuration dns, hostname, + Publishable, publish, expose, user, + Mountable, volume, volumes_from, workdir, @@ -43,6 +45,7 @@ module Propellor.Property.Docker ( import Propellor hiding (init) import Propellor.Types.Docker +import Propellor.Types.Container import Propellor.Types.CmdLine import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt @@ -254,10 +257,19 @@ hostname = runProp "hostname" name :: String -> Property HasInfo name = runProp "name" +class Publishable p where + toPublish :: p -> String + +instance Publishable (Bound Port) where + toPublish p = show (hostSide p) ++ ":" ++ show (containerSide p) + +-- | string format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort +instance Publishable String where + toPublish = id + -- | Publish a container's port to the host --- (format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort) -publish :: String -> Property HasInfo -publish = runProp "publish" +publish :: Publishable p => p -> Property HasInfo +publish = runProp "publish" . toPublish -- | Expose a container's port without publishing it. expose :: String -> Property HasInfo @@ -267,11 +279,21 @@ expose = runProp "expose" user :: String -> Property HasInfo user = runProp "user" --- | Mount a volume --- Create a bind mount with: [host-dir]:[container-dir]:[rw|ro] +class Mountable p where + toMount :: p -> String + +instance Mountable (Bound FilePath) where + toMount p = hostSide p ++ ":" ++ containerSide p + +-- | string format: [host-dir]:[container-dir]:[rw|ro] +-- -- With just a directory, creates a volume in the container. -volume :: String -> Property HasInfo -volume = runProp "volume" +instance Mountable String where + toMount = id + +-- | Mount a volume +volume :: Mountable v => v -> Property HasInfo +volume = runProp "volume" . toMount -- | Mount a volume from the specified container into the current -- container. -- cgit v1.2.3 From af450d89c8c78c544ad0329501a5bbc535079a18 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 2 Jun 2015 00:14:08 -0400 Subject: fix example --- src/Propellor/Property/Systemd.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src') diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index e50ef9cd..fa40868b 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -356,6 +356,7 @@ instance Publishable (Proto, Bound Port) where -- > -- > webserver :: Systemd.container -- > webserver = Systemd.container "webserver" (Chroot.debootstrapped (System (Debian Testing) "amd64") mempty) +-- > & Systemd.privateNetwork -- > & Systemd.running Systemd.networkd -- > & Systemd.publish (Port 80 ->- Port 8080) -- > & Apt.installedRunning "apache2" -- cgit v1.2.3 From fd9d172bcd9f217b67a60ed2e694bad4f6602d32 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 2 Jun 2015 00:37:17 -0400 Subject: wording --- src/Propellor/Property/Systemd.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index fa40868b..17849980 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -346,7 +346,7 @@ instance Publishable (Proto, Bound Port) where -- This feature was first added in systemd version 220. -- -- This property is only needed (and will only work) if the container --- is configured private networking. Also, networkd should be enabled +-- is configured to use private networking. Also, networkd should be enabled -- both inside the container, and on the host. For example: -- -- > foo :: Host -- cgit v1.2.3 From e1f2d4a8f1bf6f47ec7d091d2dbeb79a0d3ece02 Mon Sep 17 00:00:00 2001 From: Antoine Eiche Date: Wed, 3 Jun 2015 17:50:12 +0200 Subject: Add Docker environment property which allows to specify environment variables to containers. --- src/Propellor/Property/Docker.hs | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'src') diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 1dcc3522..d3e60fc2 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -34,6 +34,7 @@ module Propellor.Property.Docker ( memory, cpuShares, link, + environment, ContainerAlias, restartAlways, restartOnFailure, @@ -348,6 +349,11 @@ restartOnFailure (Just n) = runProp "restart" ("on-failure:" ++ show n) restartNever :: Property HasInfo restartNever = runProp "restart" "no" +-- | Set environment variable with a tuple composed by the environment +-- variable name and its value. +environment :: (String, String) -> Property HasInfo +environment (k, v) = runProp "env" $ k ++ "=" ++ v + -- | A container is identified by its name, and the host -- on which it's deployed. data ContainerId = ContainerId -- cgit v1.2.3 From 46241b3a89e8fd612ca3af6a3dc6495df01dbfe6 Mon Sep 17 00:00:00 2001 From: Antoine Eiche Date: Mon, 15 Jun 2015 11:31:25 +0200 Subject: Replace String type synonym Docker.Image by a data type which allows to specify an image name and an optional tag. This also introduces the class ImageIdentifier which is internally used by some Docker methods. --- config-simple.hs | 2 +- src/Propellor/Property/Docker.hs | 79 ++++++++++++++++++++++++++++++++-------- 2 files changed, 64 insertions(+), 17 deletions(-) (limited to 'src') diff --git a/config-simple.hs b/config-simple.hs index 4f0fde8c..576ecc73 100644 --- a/config-simple.hs +++ b/config-simple.hs @@ -41,7 +41,7 @@ hosts = -- A generic webserver in a Docker container. webserverContainer :: Docker.Container -webserverContainer = Docker.container "webserver" "debian" +webserverContainer = Docker.container "webserver" (Docker.latestImage "debian") & os (System (Debian (Stable "jessie")) "amd64") & Apt.stdSourcesList & Docker.publish "80:80" diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index d3e60fc2..05f25c31 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -16,7 +16,8 @@ module Propellor.Property.Docker ( memoryLimited, garbageCollected, tweaked, - Image, + Image(..), + latestImage, ContainerName, Container, HasImage(..), @@ -155,8 +156,8 @@ docked ctr@(Container _ h) = imageBuilt :: HasImage c => FilePath -> c -> Property NoInfo imageBuilt directory ctr = describe built msg where - msg = "docker image " ++ image ++ " built from " ++ directory - built = Cmd.cmdProperty' dockercmd ["build", "--tag", image, "./"] workDir + msg = "docker image " ++ (imageIdentifier image) ++ " built from " ++ directory + built = Cmd.cmdProperty' dockercmd ["build", "--tag", imageIdentifier image, "./"] workDir workDir p = p { cwd = Just directory } image = getImageName ctr @@ -164,8 +165,8 @@ imageBuilt directory ctr = describe built msg imagePulled :: HasImage c => c -> Property NoInfo imagePulled ctr = describe pulled msg where - msg = "docker image " ++ image ++ " pulled" - pulled = Cmd.cmdProperty dockercmd ["pull", image] + msg = "docker image " ++ (imageIdentifier image) ++ " pulled" + pulled = Cmd.cmdProperty dockercmd ["pull", imageIdentifier image] image = getImageName ctr propigateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Property HasInfo @@ -243,8 +244,52 @@ data ContainerInfo = ContainerInfo Image [RunParam] -- | Parameters to pass to `docker run` when creating a container. type RunParam = String --- | A docker image, that can be used to run a container. -type Image = String +-- | ImageID is an image identifier to perform action on images. An +-- ImageID can be the name of an container image, a UID, etc. +-- +-- It just encapsulates a String to avoid the definition of a String +-- instance of ImageIdentifier. +newtype ImageID = ImageID String + +-- | Used to perform Docker action on an image. +-- +-- Minimal complete definition: `imageIdentifier` +class ImageIdentifier i where + -- | For internal purposes only. + toImageID :: i -> ImageID + toImageID = ImageID . imageIdentifier + -- | A string that Docker can use as an image identifier. + imageIdentifier :: i -> String + +instance ImageIdentifier ImageID where + imageIdentifier (ImageID i) = i + toImageID = id + +-- | A docker image, that can be used to run a container. The user has +-- to specify a name and can provide an optional tag. +-- See +-- for more information. +data Image = Image + { repository :: String + , tag :: Maybe String + } + deriving (Eq, Read, Show) + +-- | Defines a Docker image without any tag. This is considered by +-- Docker as the latest image of the provided repository. +latestImage :: String -> Image +latestImage repo = Image repo Nothing + +instance ImageIdentifier Image where + -- | The format of the imageIdentifier of an `Image` is: + -- repository | repository:tag + imageIdentifier i = repository i ++ (maybe "" ((++) ":") $ tag i) + +-- | The UID of an image. This UID is generated by Docker. +newtype ImageUID = ImageUID String + +instance ImageIdentifier ImageUID where + imageIdentifier (ImageUID uid) = uid -- | Set custom dns server for container. dns :: String -> Property HasInfo @@ -424,7 +469,9 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope return FailedChange restartcontainer = do - oldimage <- liftIO $ fromMaybe image <$> commitContainer cid + oldimage <- liftIO $ + fromMaybe (toImageID image) . fmap toImageID <$> + commitContainer cid void $ liftIO $ removeContainer cid go oldimage @@ -561,20 +608,20 @@ removeContainer :: ContainerId -> IO Bool removeContainer cid = catchBoolIO $ snd <$> processTranscript dockercmd ["rm", fromContainerId cid ] Nothing -removeImage :: Image -> IO Bool +removeImage :: ImageIdentifier i => i -> IO Bool removeImage image = catchBoolIO $ - snd <$> processTranscript dockercmd ["rmi", image ] Nothing + snd <$> processTranscript dockercmd ["rmi", imageIdentifier image] Nothing -runContainer :: Image -> [RunParam] -> [String] -> IO Bool +runContainer :: ImageIdentifier i => i -> [RunParam] -> [String] -> IO Bool runContainer image ps cmd = boolSystem dockercmd $ map Param $ - "run" : (ps ++ image : cmd) + "run" : (ps ++ (imageIdentifier image) : cmd) inContainerProcess :: ContainerId -> [String] -> [String] -> CreateProcess inContainerProcess cid ps cmd = proc dockercmd ("exec" : ps ++ [fromContainerId cid] ++ cmd) -commitContainer :: ContainerId -> IO (Maybe Image) +commitContainer :: ContainerId -> IO (Maybe ImageUID) commitContainer cid = catchMaybeIO $ - takeWhile (/= '\n') + ImageUID . takeWhile (/= '\n') <$> readProcess dockercmd ["commit", fromContainerId cid] data ContainerFilter = RunningContainers | AllContainers @@ -592,8 +639,8 @@ listContainers status = | otherwise = baseps baseps = ["ps", "--no-trunc"] -listImages :: IO [Image] -listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"] +listImages :: IO [ImageUID] +listImages = map ImageUID . lines <$> readProcess dockercmd ["images", "--all", "--quiet"] runProp :: String -> RunParam -> Property HasInfo runProp field val = pureInfoProperty (param) $ dockerInfo $ -- cgit v1.2.3 From cfa236a04276a9c558be939a9c4c29dc3260589a Mon Sep 17 00:00:00 2001 From: Iustin Pop Date: Sun, 28 Jun 2015 14:34:43 +0200 Subject: Fix a couple of trivial typos in Postfix docstring --- src/Propellor/Property/Postfix.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/Postfix.hs b/src/Propellor/Property/Postfix.hs index b51f4df1..64a2004d 100644 --- a/src/Propellor/Property/Postfix.hs +++ b/src/Propellor/Property/Postfix.hs @@ -26,7 +26,7 @@ reloaded = Service.reloaded "postfix" -- but can be changed by mainCf "relayhost" -- -- The smarthost may refuse to relay mail on to other domains, without --- futher coniguration/keys. But this should be enough to get cron job +-- further configuration/keys. But this should be enough to get cron job -- mail flowing to a place where it will be seen. satellite :: Property NoInfo satellite = check (not <$> mainCfIsSet "relayhost") setup -- cgit v1.2.3 From 37a5c05aba1800a8ccf9a98a0bf3abd59ef1d140 Mon Sep 17 00:00:00 2001 From: Iustin Pop Date: Sun, 28 Jun 2015 14:39:05 +0200 Subject: Further docstring improvements. --- src/Propellor/Property/Postfix.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Postfix.hs b/src/Propellor/Property/Postfix.hs index 64a2004d..b062cbac 100644 --- a/src/Propellor/Property/Postfix.hs +++ b/src/Propellor/Property/Postfix.hs @@ -23,7 +23,7 @@ reloaded = Service.reloaded "postfix" -- | Configures postfix as a satellite system, which -- relays all mail through a relay host, which defaults to smtp.domain, --- but can be changed by mainCf "relayhost" +-- but can be changed by @mainCf "relayhost"@. -- -- The smarthost may refuse to relay mail on to other domains, without -- further configuration/keys. But this should be enough to get cron job @@ -58,7 +58,7 @@ mappedFile f setup = setup f `onChange` cmdProperty "postmap" [f] -- | Run newaliases command, which should be done after changing --- . +-- @/etc/aliases@. newaliases :: Property NoInfo newaliases = trivial $ cmdProperty "newaliases" [] @@ -66,7 +66,7 @@ newaliases = trivial $ cmdProperty "newaliases" [] mainCfFile :: FilePath mainCfFile = "/etc/postfix/main.cf" --- | Sets a main.cf name=value pair. Does not reload postfix immediately. +-- | Sets a main.cf @name=value@ pair. Does not reload postfix immediately. mainCf :: (String, String) -> Property NoInfo mainCf (name, value) = check notset set `describe` ("postfix main.cf " ++ setting) @@ -75,7 +75,7 @@ mainCf (name, value) = check notset set notset = (/= Just value) <$> getMainCf name set = cmdProperty "postconf" ["-e", setting] --- | Gets a man.cf setting. +-- | Gets a main.cf setting. getMainCf :: String -> IO (Maybe String) getMainCf name = parse . lines <$> readProcess "postconf" [name] where @@ -131,9 +131,9 @@ dedupCf ls = -- | Installs saslauthd and configures it for postfix, authenticating -- against PAM. -- --- Does not configure postfix to use it; eg smtpd_sasl_auth_enable = yes +-- Does not configure postfix to use it; eg @smtpd_sasl_auth_enable = yes@ -- needs to be set to enable use. See --- https://wiki.debian.org/PostfixAndSASL +-- . saslAuthdInstalled :: Property NoInfo saslAuthdInstalled = setupdaemon `requires` Service.running "saslauthd" -- cgit v1.2.3 From fc04d0d81df909904fa655372ee005138f3b6ea7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 29 Jun 2015 16:40:01 -0400 Subject: Added --unset to delete a privdata field. --- debian/changelog | 1 + doc/usage.mdwn | 4 ++++ src/Propellor/CmdLine.hs | 2 ++ src/Propellor/PrivData.hs | 21 ++++++++++++++++----- src/Propellor/Types/CmdLine.hs | 1 + 5 files changed, 24 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/debian/changelog b/debian/changelog index 079ecf48..90deb80f 100644 --- a/debian/changelog +++ b/debian/changelog @@ -3,6 +3,7 @@ propellor (2.6.0) UNRELEASED; urgency=medium * Replace String type synonym Docker.Image by a data type which allows to specify an image name and an optional tag. (API change) Thanks, Antoine Eiche. + * Added --unset to delete a privdata field. -- Joey Hess Tue, 16 Jun 2015 14:49:12 -0400 diff --git a/doc/usage.mdwn b/doc/usage.mdwn index 4030628f..1c306aa3 100644 --- a/doc/usage.mdwn +++ b/doc/usage.mdwn @@ -71,6 +71,10 @@ and configured in haskell. Sets a field of privdata. The content is read in from stdin. +* propellor --unset field context + + Removes a value from the privdata store. + * propellor --dump field context Outputs the privdata value to stdout. diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index d29ffbb7..95a633ec 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -51,6 +51,7 @@ processCmdLine = go =<< getArgs _ -> Spin <$> mapM hostname ps <*> pure Nothing go ("--add-key":k:[]) = return $ AddKey k go ("--set":f:c:[]) = withprivfield f c Set + go ("--unset":f:c:[]) = withprivfield f c Unset go ("--dump":f:c:[]) = withprivfield f c Dump go ("--edit":f:c:[]) = withprivfield f c Edit go ("--list-fields":[]) = return ListFields @@ -94,6 +95,7 @@ defaultMain hostlist = do go _ (Continue cmdline) = go False cmdline go _ Check = return () go _ (Set field context) = setPrivData field context + go _ (Unset field context) = unsetPrivData field context go _ (Dump field context) = dumpPrivData field context go _ (Edit field context) = editPrivData field context go _ ListFields = listPrivDataFields hostlist diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs index 71aa820d..d0426e75 100644 --- a/src/Propellor/PrivData.hs +++ b/src/Propellor/PrivData.hs @@ -6,6 +6,7 @@ module Propellor.PrivData ( withSomePrivData, addPrivData, setPrivData, + unsetPrivData, dumpPrivData, editPrivData, filterPrivData, @@ -143,6 +144,11 @@ setPrivData field context = do putStrLn "Enter private data on stdin; ctrl-D when done:" setPrivDataTo field context =<< hGetContentsStrict stdin +unsetPrivData :: PrivDataField -> Context -> IO () +unsetPrivData field context = do + modifyPrivData $ M.delete (field, context) + putStrLn "Private data unset." + dumpPrivData :: PrivDataField -> Context -> IO () dumpPrivData field context = maybe (error "Requested privdata is not set.") putStrLn @@ -192,17 +198,22 @@ listPrivDataFields hosts = do setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO () setPrivDataTo field context value = do - makePrivDataDir - m <- decryptPrivData - let m' = M.insert (field, context) (chomp value) m - gpgEncrypt privDataFile (show m') + modifyPrivData set putStrLn "Private data set." - void $ boolSystem "git" [Param "add", File privDataFile] where + set = M.insert (field, context) (chomp value) chomp s | end s == "\n" = chomp (beginning s) | otherwise = s +modifyPrivData :: (PrivMap -> PrivMap) -> IO () +modifyPrivData f = do + makePrivDataDir + m <- decryptPrivData + let m' = f m + gpgEncrypt privDataFile (show m') + void $ boolSystem "git" [Param "add", File privDataFile] + decryptPrivData :: IO PrivMap decryptPrivData = fromMaybe M.empty . readish <$> gpgDecrypt privDataFile diff --git a/src/Propellor/Types/CmdLine.hs b/src/Propellor/Types/CmdLine.hs index bd0cbdfd..96949957 100644 --- a/src/Propellor/Types/CmdLine.hs +++ b/src/Propellor/Types/CmdLine.hs @@ -10,6 +10,7 @@ data CmdLine | Spin [HostName] (Maybe HostName) | SimpleRun HostName | Set PrivDataField Context + | Unset PrivDataField Context | Dump PrivDataField Context | Edit PrivDataField Context | ListFields -- cgit v1.2.3 From 4ac4855a78ce992110b4171c3deeae1c9258ec18 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 2 Jul 2015 11:14:54 -0400 Subject: propellor spin --- src/Propellor/Property/SiteSpecific/JoeySites.hs | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src') diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs index f9a0e0c9..e876f0da 100644 --- a/src/Propellor/Property/SiteSpecific/JoeySites.hs +++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs @@ -859,6 +859,8 @@ legacyWebSites = propertyList "legacy web sites" $ props , " AllowOverride None" , Apache.allowAll , "" + , "RewriteEngine On" + , "RewriteRule .* http://www.sowsearpoetry.org/ [L]" ] & alias "wortroot.kitenet.net" & alias "www.wortroot.kitenet.net" -- cgit v1.2.3 From 9bd152cfc6f4279cf7cd852bd04d7ec53808a712 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 2 Jul 2015 23:15:54 -0400 Subject: update --- src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs | 1 - 1 file changed, 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index 70075968..1609c0c1 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -150,7 +150,6 @@ androidContainer name setupgitannexdir gitannexdir = Systemd.container name boot & File.ownerGroup homedir (User builduser) (Group builduser) & flagFile chrootsetup ("/chrootsetup") `requires` setupgitannexdir - & buildDepsApt & haskellPkgsInstalled "android" where -- Use git-annex's android chroot setup script, which will install -- cgit v1.2.3 From 08ce9c766653619e8a019be5f89ce055be310527 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 3 Jul 2015 00:20:06 -0400 Subject: update --- src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index 1609c0c1..7fd56b40 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -67,7 +67,6 @@ tree buildarch = combineProperties "gitannexbuilder tree" $ props buildDepsApt :: Property HasInfo buildDepsApt = combineProperties "gitannexbuilder build deps" $ props & Apt.buildDep ["git-annex"] - & Apt.installed ["liblockfile-simple-perl"] & buildDepsNoHaskellLibs & Apt.buildDepIn builddir `describe` "git-annex source build deps installed" @@ -158,5 +157,5 @@ androidContainer name setupgitannexdir gitannexdir = Systemd.container name boot chrootsetup = scriptProperty [ "cd " ++ gitannexdir ++ " && ./standalone/android/buildchroot-inchroot" ] - osver = System (Debian Testing) "i386" + osver = System (Debian (Stable "jessie")) "i386" bootstrap = Chroot.debootstrapped osver mempty -- cgit v1.2.3 From 1d6972bb79361f81a07346f64778418da5d6c6df Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 3 Jul 2015 02:02:28 -0400 Subject: typo --- src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index 7fd56b40..7f893431 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -85,7 +85,7 @@ haskellPkgsInstalled :: String -> Property NoInfo haskellPkgsInstalled dir = flagFile go ("/haskellpkgsinstalled") where go = userScriptProperty (User builduser) - [ "cd " ++ builddir ++ " && ./standalone/ " ++ dir ++ "/install-haskell-packages" + [ "cd " ++ builddir ++ " && ./standalone/" ++ dir ++ "/install-haskell-packages" ] -- Installs current versions of git-annex's deps from cabal, but only -- cgit v1.2.3 From b462aefdb2e3c413348ce4cc13f5eedb67f22299 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 3 Jul 2015 20:32:47 +0100 Subject: Systemd.masked property This property masks, and when reverted unmasks, systemd services. This is just `systemctl mask service` and `systemctl unmask service`. It's useful for turning off a system service that you intend to run with --user. Signed-off-by: Sean Whitton --- src/Propellor/Property/Systemd.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'src') diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 17849980..718ceca6 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -7,6 +7,7 @@ module Propellor.Property.Systemd ( stopped, enabled, disabled, + masked, running, restarted, networkd, @@ -89,6 +90,15 @@ disabled :: ServiceName -> Property NoInfo disabled n = trivial $ cmdProperty "systemctl" ["disable", n] `describe` ("service " ++ n ++ " disabled") +-- | Masks a systemd service. +masked :: ServiceName -> RevertableProperty +masked n = systemdMask systemdUnmask + where + systemdMask = trivial $ cmdProperty "systemctl" ["mask", n] + `describe` ("service " ++ n ++ " masked") + systemdUnmask = trivial $ cmdProperty "systemctl" ["unmask", n] + `describe` ("service " ++ n ++ " unmasked") + -- | Ensures that a service is both enabled and started running :: ServiceName -> Property NoInfo running n = trivial $ started n `requires` enabled n -- cgit v1.2.3 From c167e6b75f8df8119c9c18de5f7f63b902642d57 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 11 Jul 2015 20:58:52 -0400 Subject: propellor spin --- src/Propellor/Property/SiteSpecific/JoeySites.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs index e876f0da..4039ad0d 100644 --- a/src/Propellor/Property/SiteSpecific/JoeySites.hs +++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs @@ -387,7 +387,7 @@ twitRss = combineProperties "twitter rss" $ props -- Work around for expired ssl cert. pumpRss :: Property NoInfo pumpRss = Cron.job "pump rss" (Cron.Times "15 * * * *") (User "joey") "/srv/web/tmp.kitenet.net/" - "wget https://pump2rss.com/feed/joeyh@identi.ca.atom -O pump.atom.new --no-check-certificate 2>/dev/null; sed 's/ & / /g' pump.atom.new > pump.atom" + "wget https://rss.io.jpope.org/feed/joeyh@identi.ca.atom -O pump.atom.new --no-check-certificate 2>/dev/null; sed 's/ & / /g' pump.atom.new > pump.atom" ircBouncer :: Property HasInfo ircBouncer = propertyList "IRC bouncer" $ props -- cgit v1.2.3 From d885624983383106f2ace96f27295aa113333710 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 13 Jul 2015 19:08:39 -0400 Subject: clarify --- src/Propellor/Property/Systemd.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs index 718ceca6..5c8a35e3 100644 --- a/src/Propellor/Property/Systemd.hs +++ b/src/Propellor/Property/Systemd.hs @@ -134,7 +134,8 @@ type Option = String -- Does not ensure that the relevant daemon notices the change immediately. -- -- This assumes that there is only one [Header] per file, which is --- currently the case. And it assumes the file already exists with +-- currently the case for files like journald.conf and system.conf. +-- And it assumes the file already exists with -- the right [Header], so new lines can just be appended to the end. configured :: FilePath -> Option -> String -> Property NoInfo configured cfgfile option value = combineProperties desc -- cgit v1.2.3 From 8d971b83ba11fc0eb521d9d15e4a2ae281bc2ef5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 20 Jul 2015 12:03:47 -0400 Subject: Ssh.permitRootLogin type changed to allow configuring WithoutPassword and ForcedCommandsOnly (API change) * Ssh.permitRootLogin type changed to allow configuring WithoutPassword and ForcedCommandsOnly (API change) * setSshdConfig type changed, and setSshdConfigBool added with old type. --- config-joey.hs | 2 +- debian/changelog | 8 ++++++++ src/Propellor/Property/Ssh.hs | 40 ++++++++++++++++++++++++++++++---------- 3 files changed, 39 insertions(+), 11 deletions(-) (limited to 'src') diff --git a/config-joey.hs b/config-joey.hs index 8b53718a..32b70c14 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -441,7 +441,7 @@ jerryPlay = standardDockerContainer "jerryplay" Unstable "amd64" & Docker.publish "8001:80" & Apt.installed ["ssh"] & User.hasSomePassword (User "root") - & Ssh.permitRootLogin True + & Ssh.permitRootLogin (Ssh.RootLogin True) kiteShellBox :: Systemd.Container kiteShellBox = standardStableContainer "kiteshellbox" diff --git a/debian/changelog b/debian/changelog index 3b20a402..6b411fa2 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,11 @@ +propellor (2.7.0) UNRELEASED; urgency=medium + + * Ssh.permitRootLogin type changed to allow configuring WithoutPassword + and ForcedCommandsOnly (API change) + * setSshdConfig type changed, and setSshdConfigBool added with old type. + + -- Joey Hess Mon, 20 Jul 2015 12:01:38 -0400 + propellor (2.6.0) unstable; urgency=medium * Replace String type synonym Docker.Image by a data type diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs index 785f2787..fca7d037 100644 --- a/src/Propellor/Property/Ssh.hs +++ b/src/Propellor/Property/Ssh.hs @@ -1,7 +1,10 @@ module Propellor.Property.Ssh ( PubKeyText, sshdConfig, + ConfigKeyword, + setSshdConfigBool, setSshdConfig, + RootLogin(..), permitRootLogin, passwordAuthentication, noPasswords, @@ -28,6 +31,7 @@ import Utility.FileMode import System.PosixCompat import qualified Data.Map as M +import Data.List type PubKeyText = String @@ -38,21 +42,37 @@ sshBool False = "no" sshdConfig :: FilePath sshdConfig = "/etc/ssh/sshd_config" -setSshdConfig :: String -> Bool -> Property NoInfo -setSshdConfig setting allowed = combineProperties "sshd config" - [ sshdConfig `File.lacksLine` (sshline $ not allowed) - , sshdConfig `File.containsLine` (sshline allowed) - ] +type ConfigKeyword = String + +setSshdConfigBool :: ConfigKeyword -> Bool -> Property NoInfo +setSshdConfigBool setting allowed = setSshdConfig setting (sshBool allowed) + +setSshdConfig :: ConfigKeyword -> String -> Property NoInfo +setSshdConfig setting val = File.fileProperty desc f sshdConfig `onChange` restarted - `describe` unwords [ "ssh config:", setting, sshBool allowed ] where - sshline v = setting ++ " " ++ sshBool v + desc = unwords [ "ssh config:", setting, val ] + cfgline = setting ++ " " ++ val + wantedline s + | s == cfgline = True + | (setting ++ " ") `isPrefixOf` s = False + | otherwise = True + f ls + | cfgline `elem` ls = filter wantedline ls + | otherwise = filter wantedline ls ++ [cfgline] + +data RootLogin + = RootLogin Bool -- ^ allow or prevent root login + | WithoutPassword -- ^ disable password authentication for root, while allowing other authentication methods + | ForcedCommandsOnly -- ^ allow root login with public-key authentication, but only if a forced command has been specified for the public key -permitRootLogin :: Bool -> Property NoInfo -permitRootLogin = setSshdConfig "PermitRootLogin" +permitRootLogin :: RootLogin -> Property NoInfo +permitRootLogin (RootLogin b) = setSshdConfigBool "PermitRootLogin" b +permitRootLogin WithoutPassword = setSshdConfig "PermitRootLogin" "without-password" +permitRootLogin ForcedCommandsOnly = setSshdConfig "PermitRootLogin" "forced-commands-only" passwordAuthentication :: Bool -> Property NoInfo -passwordAuthentication = setSshdConfig "PasswordAuthentication" +passwordAuthentication = setSshdConfigBool "PasswordAuthentication" -- | Configure ssh to not allow password logins. -- -- cgit v1.2.3 From c7bc34d256604af8d2ed6444dfa2f4ce6402b682 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 21 Jul 2015 10:47:26 -0400 Subject: fix check for already existing shim Was not checking the shim file, oops. --- src/Propellor/Shim.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/Propellor/Shim.hs b/src/Propellor/Shim.hs index ecf9f36a..7cdecefd 100644 --- a/src/Propellor/Shim.hs +++ b/src/Propellor/Shim.hs @@ -20,7 +20,7 @@ import System.Posix.Files -- Propellor may be running from an existing shim, in which case it's -- simply reused. setup :: FilePath -> Maybe FilePath -> FilePath -> IO FilePath -setup propellorbin propellorbinpath dest = checkAlreadyShimmed propellorbin $ do +setup propellorbin propellorbinpath dest = checkAlreadyShimmed shim $ do createDirectoryIfMissing True dest libs <- parseLdd <$> readProcess "ldd" [propellorbin] @@ -39,7 +39,6 @@ setup propellorbin propellorbinpath dest = checkAlreadyShimmed propellorbin $ do 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 [ shebang , "GCONV_PATH=" ++ shellEscape gconvdir @@ -49,6 +48,8 @@ setup propellorbin propellorbinpath dest = checkAlreadyShimmed propellorbin $ do ] modifyFileMode shim (addModes executeModes) return shim + where + shim = file propellorbin dest shebang :: String shebang = "#!/bin/sh" -- cgit v1.2.3 From 7ff39bb09840c27b4bd04f692dff2e4d45c83924 Mon Sep 17 00:00:00 2001 From: Antoine Eiche Date: Tue, 21 Jul 2015 11:30:40 +0200 Subject: Add operator onChangeFlagOnFail. It seems like `onChange` except that if property y fails, a flag file is generated. On next runs, if the flag file is present, property y is executed even if property x doesn't change. With `onChange`, if y fails, the property x `onChange` y returns `FailedChange`. But if this property is applied again, it returns `NoChange`. This behavior can cause trouble... --- src/Propellor/Property.hs | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) (limited to 'src') diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 1801902e..4da9acf3 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -54,6 +54,43 @@ onChange = combineWith $ \p hook -> do return $ r <> r' _ -> return r +-- | Same than `onChange` except that if property y fails, a flag file +-- is generated. On next run, if the flag file is present, property y +-- is executed even if property x doesn't change. +-- +-- With `onChange`, if y fails, the property x `onChange` y returns +-- `FailedChange`. But if this property is applied again, it returns +-- `NoChange`. This behavior can cause trouble... +-- +-- Use with caution. +onChangeFlagOnFail + :: (Combines (Property x) (Property y)) + => FilePath + -> Property x + -> Property y + -> CombinedType (Property x) (Property y) +onChangeFlagOnFail flagfile p1 p2 = + combineWith go p1 p2 + where + go s1 s2 = do + r1 <- s1 + case r1 of + MadeChange -> flagFailed s2 + _ -> ifM (liftIO $ doesFileExist flagfile) + (flagFailed s2 + , return r1) + flagFailed s = do + r <- s + liftIO $ case r of + FailedChange -> createFlagFile + _ -> removeFlagFile + return r + createFlagFile = unlessM (doesFileExist flagfile) $ do + createDirectoryIfMissing True (takeDirectory flagfile) + writeFile flagfile "" + removeFlagFile = whenM (doesFileExist flagfile) $ removeFile flagfile + + -- | Alias for @flip describe@ (==>) :: IsProp (Property i) => Desc -> Property i -> Property i (==>) = flip describe -- cgit v1.2.3 From e4ecda210bd56cc0e233c3b635ac551d6ddce543 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 21 Jul 2015 11:15:05 -0400 Subject: remove caution comment I think this was inherited from flagFile, but the reasons to use caution when using flagFile (that it makes code to satisfy a property only run once) don't apply when using onChangeFlagOnFail. --- src/Propellor/Property.hs | 2 -- 1 file changed, 2 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 4da9acf3..339cb303 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -61,8 +61,6 @@ onChange = combineWith $ \p hook -> do -- With `onChange`, if y fails, the property x `onChange` y returns -- `FailedChange`. But if this property is applied again, it returns -- `NoChange`. This behavior can cause trouble... --- --- Use with caution. onChangeFlagOnFail :: (Combines (Property x) (Property y)) => FilePath -- cgit v1.2.3 From 1ea376cf10807778e693a2109154f143fc0f8d1d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 21 Jul 2015 11:17:00 -0400 Subject: fix layout to meet style --- src/Propellor/Property.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 339cb303..0fa8f17e 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -76,7 +76,8 @@ onChangeFlagOnFail flagfile p1 p2 = MadeChange -> flagFailed s2 _ -> ifM (liftIO $ doesFileExist flagfile) (flagFailed s2 - , return r1) + , return r1 + ) flagFailed s = do r <- s liftIO $ case r of @@ -88,7 +89,6 @@ onChangeFlagOnFail flagfile p1 p2 = writeFile flagfile "" removeFlagFile = whenM (doesFileExist flagfile) $ removeFile flagfile - -- | Alias for @flip describe@ (==>) :: IsProp (Property i) => Desc -> Property i -> Property i (==>) = flip describe -- cgit v1.2.3 From 512137a4d9c05534f94e22cd5c0d6157d2d0ef2b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 21 Jul 2015 11:18:15 -0400 Subject: language --- src/Propellor/Property.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 0fa8f17e..b90d5b86 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -54,7 +54,7 @@ onChange = combineWith $ \p hook -> do return $ r <> r' _ -> return r --- | Same than `onChange` except that if property y fails, a flag file +-- | Same as `onChange` except that if property y fails, a flag file -- is generated. On next run, if the flag file is present, property y -- is executed even if property x doesn't change. -- -- cgit v1.2.3 From 26fda3f39ade088afb9fd5001c364544f29d0146 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 21 Jul 2015 11:48:30 -0400 Subject: ssh client needed for kiteshellbox --- src/Propellor/Property/SiteSpecific/JoeySites.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs index 4039ad0d..b6524f69 100644 --- a/src/Propellor/Property/SiteSpecific/JoeySites.hs +++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs @@ -405,7 +405,7 @@ ircBouncer = propertyList "IRC bouncer" $ props kiteShellBox :: Property NoInfo kiteShellBox = propertyList "kitenet.net shellinabox" - [ Apt.installed ["openssl", "shellinabox"] + [ Apt.installed ["openssl", "shellinabox", "openssh-client"] , File.hasContent "/etc/default/shellinabox" [ "# Deployed by propellor" , "SHELLINABOX_DAEMON_START=1" -- cgit v1.2.3 From f387bbcf2d7417cf9389eff92d12f28af26cce3e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 30 Jul 2015 12:01:15 -0400 Subject: Work around broken git pull option parser in git 2.5.0, which broke use of --upload-pack to send a git push when running propellor --spin. --- debian/changelog | 3 +++ src/Propellor/Spin.hs | 8 ++++++-- 2 files changed, 9 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/debian/changelog b/debian/changelog index f4fcf35c..2375dfd5 100644 --- a/debian/changelog +++ b/debian/changelog @@ -8,6 +8,9 @@ propellor (2.7.0) UNRELEASED; urgency=medium * Added onChangeFlagOnFail which is often a safer alternative to onChange. Thanks, Antoine Eiche. + * Work around broken git pull option parser in git 2.5.0, + which broke use of --upload-pack to send a git push when running + propellor --spin. -- Joey Hess Mon, 20 Jul 2015 12:01:38 -0400 diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index 3ff1ec21..61d519c3 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -147,11 +147,15 @@ update forhost = do hout <- dup stdOutput hClose stdin hClose stdout + -- Not using git pull because git 2.5.0 badly + -- broke its option parser. unlessM (boolSystem "git" (pullparams hin hout)) $ - errorMessage "git pull from client failed" + errorMessage "git fetch from client failed" + unlessM (boolSystem "git" [Param "merge", Param "FETCH_HEAD"]) $ + errorMessage "git merge from client failed" where pullparams hin hout = - [ Param "pull" + [ Param "fetch" , Param "--progress" , Param "--upload-pack" , Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout -- cgit v1.2.3 From b7a9655a695103b3ca2e4e6edfe305f9b44d9250 Mon Sep 17 00:00:00 2001 From: Félix Sipma Date: Fri, 31 Jul 2015 12:34:25 +0200 Subject: Propellor.Property.Tor: remove duplicate code Signed-off-by: Félix Sipma --- src/Propellor/Property/Tor.hs | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Tor.hs b/src/Propellor/Property/Tor.hs index 3af4a70c..f1aaeeb1 100644 --- a/src/Propellor/Property/Tor.hs +++ b/src/Propellor/Property/Tor.hs @@ -103,13 +103,8 @@ bandwidthRate' s divby = case readSize dataUnits s of Nothing -> property ("unable to parse " ++ s) noChange hiddenServiceAvailable :: HiddenServiceName -> Int -> Property NoInfo -hiddenServiceAvailable hn port = hiddenServiceHostName prop +hiddenServiceAvailable hn port = hiddenServiceHostName $ hiddenService hn port where - prop = configured - [ ("HiddenServiceDir", varLib hn) - , ("HiddenServicePort", unwords [show port, "127.0.0.1:" ++ show port]) - ] - `describe` "hidden service available" hiddenServiceHostName p = adjustPropertySatisfy p $ \satisfy -> do r <- satisfy h <- liftIO $ readFile (varLib hn "hostname") @@ -164,7 +159,7 @@ type NickName = String -- | Convert String to a valid tor NickName. saneNickname :: String -> NickName -saneNickname s +saneNickname s | null n = "unnamed" | otherwise = n where -- cgit v1.2.3