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 +++ 1 file changed, 3 insertions(+) (limited to 'debian') 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 -- 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 'debian') 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 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 'debian') 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 'debian') 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 'debian') 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 'debian') 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 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 'debian') 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 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 'debian') 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 'debian') 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 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 'debian') 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 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 'debian') 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 87494a6099d28b5587f951ffc565dbf961b37438 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 4 Jun 2015 12:17:01 -0400 Subject: changelog --- debian/changelog | 2 ++ 1 file changed, 2 insertions(+) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index f4459a2c..6f8d6b73 100644 --- a/debian/changelog +++ b/debian/changelog @@ -24,6 +24,8 @@ propellor (2.5.0) UNRELEASED; urgency=medium * Docker: volume and publish accept Bound FilePath and Bound Port, respectively. They also continue to accept Strings, for backwards compatability. + * Docker: Added environment property. + Thanks Antoine Eiche. -- Joey Hess Thu, 07 May 2015 12:08:34 -0400 -- cgit v1.2.3 From 9415bfb4adb61dedfc1301ff0bc7310cec40455a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 9 Jun 2015 17:09:00 -0400 Subject: prep release --- debian/changelog | 4 ++-- propellor.cabal | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index 6f8d6b73..2441f4ab 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,4 +1,4 @@ -propellor (2.5.0) UNRELEASED; urgency=medium +propellor (2.5.0) unstable; urgency=medium * cmdProperty' renamed to cmdPropertyEnv to make way for a new, more generic cmdProperty' (API change) @@ -27,7 +27,7 @@ propellor (2.5.0) UNRELEASED; urgency=medium * Docker: Added environment property. Thanks Antoine Eiche. - -- Joey Hess Thu, 07 May 2015 12:08:34 -0400 + -- Joey Hess Tue, 09 Jun 2015 17:08:43 -0400 propellor (2.4.0) unstable; urgency=medium diff --git a/propellor.cabal b/propellor.cabal index 9edc1436..d09e7590 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 2.4.0 +Version: 2.5.0 Cabal-Version: >= 1.6 License: BSD3 Maintainer: Joey Hess -- cgit v1.2.3 From b5de5703a49e59db010518b89effdeba3b91a664 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 9 Jun 2015 17:12:54 -0400 Subject: speling --- debian/changelog | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index 2441f4ab..6e641881 100644 --- a/debian/changelog +++ b/debian/changelog @@ -23,7 +23,7 @@ propellor (2.5.0) unstable; urgency=medium (API change) * Docker: volume and publish accept Bound FilePath and Bound Port, respectively. They also continue to accept Strings, for backwards - compatability. + compatibility. * Docker: Added environment property. Thanks Antoine Eiche. -- cgit v1.2.3 From 948f855c63d6f2da09ce3689d1b610b343501f73 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 16 Jun 2015 14:52:50 -0400 Subject: update for Docker.Image changes --- config-joey.hs | 8 ++++---- debian/changelog | 8 ++++++++ 2 files changed, 12 insertions(+), 4 deletions(-) (limited to 'debian') diff --git a/config-joey.hs b/config-joey.hs index 93a44764..8b53718a 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -505,10 +505,10 @@ standardDockerContainer name suite arch = Docker.container name (dockerImage sys -- Docker images I prefer to use. dockerImage :: System -> Docker.Image -dockerImage (System (Debian Unstable) arch) = Docker.Image ("joeyh/debian-unstable-" ++ arch) Nothing -dockerImage (System (Debian Testing) arch) = Docker.Image ("joeyh/debian-unstable-" ++ arch) Nothing -dockerImage (System (Debian (Stable _)) arch) = Docker.Image ("joeyh/debian-stable-" ++ arch) Nothing -dockerImage _ = Docker.Image "debian-stable-official" Nothing -- does not currently exist! +dockerImage (System (Debian Unstable) arch) = Docker.latestImage ("joeyh/debian-unstable-" ++ arch) +dockerImage (System (Debian Testing) arch) = Docker.latestImage ("joeyh/debian-unstable-" ++ arch) +dockerImage (System (Debian (Stable _)) arch) = Docker.latestImage ("joeyh/debian-stable-" ++ arch) +dockerImage _ = Docker.latestImage "debian-stable-official" -- does not currently exist! myDnsSecondary :: Property HasInfo myDnsSecondary = propertyList "dns secondary for all my domains" $ props diff --git a/debian/changelog b/debian/changelog index 6e641881..079ecf48 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,11 @@ +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. + + -- Joey Hess Tue, 16 Jun 2015 14:49:12 -0400 + propellor (2.5.0) unstable; urgency=medium * cmdProperty' renamed to cmdPropertyEnv to make way for a new, -- 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 'debian') 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 7cd4c0054fc11e142a7e72e94b108638fed6e747 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 30 Jun 2015 16:49:52 -0400 Subject: Version dependency on exceptions. --- debian/changelog | 1 + debian/control | 4 ++-- propellor.cabal | 2 +- 3 files changed, 4 insertions(+), 3 deletions(-) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index 90deb80f..94b3a50d 100644 --- a/debian/changelog +++ b/debian/changelog @@ -4,6 +4,7 @@ propellor (2.6.0) UNRELEASED; urgency=medium which allows to specify an image name and an optional tag. (API change) Thanks, Antoine Eiche. * Added --unset to delete a privdata field. + * Version dependency on exceptions. -- Joey Hess Tue, 16 Jun 2015 14:49:12 -0400 diff --git a/debian/control b/debian/control index 2bebd6f3..51107783 100644 --- a/debian/control +++ b/debian/control @@ -16,7 +16,7 @@ Build-Depends: libghc-quickcheck2-dev, libghc-mtl-dev, libghc-transformers-dev, - libghc-exceptions-dev, + libghc-exceptions-dev (>= 0.6), Maintainer: Gergely Nagy Standards-Version: 3.9.6 Vcs-Git: git://git.joeyh.name/propellor @@ -38,7 +38,7 @@ Depends: ${misc:Depends}, ${shlibs:Depends}, libghc-quickcheck2-dev, libghc-mtl-dev, libghc-transformers-dev, - libghc-exceptions-dev, + libghc-exceptions-dev (>= 0.6), git, Description: property-based host configuration management in haskell Propellor enures that the system it's run in satisfies a list of diff --git a/propellor.cabal b/propellor.cabal index d09e7590..ad9f4530 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -38,7 +38,7 @@ Executable propellor Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, containers, network, async, time, QuickCheck, mtl, transformers, - exceptions + exceptions (>= 0.6) if (! os(windows)) Build-Depends: unix -- cgit v1.2.3 From 71265a2d6f8ba2071504c45c938a65c0f3cc1546 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 5 Jul 2015 15:52:21 -0400 Subject: changelog --- debian/changelog | 2 ++ 1 file changed, 2 insertions(+) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index 94b3a50d..8d502870 100644 --- a/debian/changelog +++ b/debian/changelog @@ -5,6 +5,8 @@ propellor (2.6.0) UNRELEASED; urgency=medium Thanks, Antoine Eiche. * Added --unset to delete a privdata field. * Version dependency on exceptions. + * Systemd: Add masked property. + Thanks, Sean Whitton -- Joey Hess Tue, 16 Jun 2015 14:49:12 -0400 -- cgit v1.2.3 From 7593e76c966a8b3990efa76e6dfe3ac21a8bcaed Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 10 Jul 2015 22:31:48 -0400 Subject: Fix make install target to work even when git is not configured. --- Makefile | 6 +++++- debian/changelog | 1 + 2 files changed, 6 insertions(+), 1 deletion(-) (limited to 'debian') diff --git a/Makefile b/Makefile index 2cf15b98..5b63b1ff 100644 --- a/Makefile +++ b/Makefile @@ -17,8 +17,12 @@ install: cat dist/propellor-*.tar.gz | (cd dist/gittmp && tar zx --strip-components=1) # cabal sdist does not preserve symlinks, so copy over file cd dist/gittmp && for f in $$(find -type f); do rm -f $$f; cp -a ../../$$f $$f; done + export GIT_AUTHOR_NAME=build && \ + export GIT_AUTHOR_EMAIL=build@buildhost && \ + export GIT_COMMITTER_NAME=build && \ + export GIT_COMMITTER_EMAIL=build@buildhost && \ cd dist/gittmp && git init && \ - git add . \ + && git add . \ && git commit -q -m "distributed version of propellor" \ && git bundle create $(DESTDIR)/usr/src/propellor/propellor.git master HEAD \ && git show-ref master --hash > $(DESTDIR)/usr/src/propellor/head diff --git a/debian/changelog b/debian/changelog index 8d502870..4cb94403 100644 --- a/debian/changelog +++ b/debian/changelog @@ -7,6 +7,7 @@ propellor (2.6.0) UNRELEASED; urgency=medium * Version dependency on exceptions. * Systemd: Add masked property. Thanks, Sean Whitton + * Fix make install target to work even when git is not configured. -- Joey Hess Tue, 16 Jun 2015 14:49:12 -0400 -- cgit v1.2.3 From 8946b47db61d4debebe3a64637b4dbaa1d2c39f6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 10 Jul 2015 22:36:59 -0400 Subject: prep release --- debian/changelog | 4 ++-- propellor.cabal | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index 4cb94403..3b20a402 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,4 +1,4 @@ -propellor (2.6.0) UNRELEASED; urgency=medium +propellor (2.6.0) unstable; 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) @@ -9,7 +9,7 @@ propellor (2.6.0) UNRELEASED; urgency=medium Thanks, Sean Whitton * Fix make install target to work even when git is not configured. - -- Joey Hess Tue, 16 Jun 2015 14:49:12 -0400 + -- Joey Hess Fri, 10 Jul 2015 22:36:29 -0400 propellor (2.5.0) unstable; urgency=medium diff --git a/propellor.cabal b/propellor.cabal index ad9f4530..1c6664b2 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 2.5.0 +Version: 2.6.0 Cabal-Version: >= 1.6 License: BSD3 Maintainer: Joey Hess -- 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 'debian') 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 2932c2b420a3d059be0faecc2113f19f1171af4d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 21 Jul 2015 11:00:02 -0400 Subject: changelog --- debian/changelog | 2 ++ 1 file changed, 2 insertions(+) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index 6b411fa2..055035bc 100644 --- a/debian/changelog +++ b/debian/changelog @@ -3,6 +3,8 @@ 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. + * Fix a bug in shim generation code for docker and chroots, that + sometimes prevented deployment of docker containers. -- Joey Hess Mon, 20 Jul 2015 12:01:38 -0400 -- cgit v1.2.3 From b90f6131e0972e321be327d3134b6d7c51154f61 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 21 Jul 2015 11:18:42 -0400 Subject: changelog --- debian/changelog | 3 +++ 1 file changed, 3 insertions(+) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index 055035bc..f4fcf35c 100644 --- a/debian/changelog +++ b/debian/changelog @@ -5,6 +5,9 @@ propellor (2.7.0) UNRELEASED; urgency=medium * setSshdConfig type changed, and setSshdConfigBool added with old type. * Fix a bug in shim generation code for docker and chroots, that sometimes prevented deployment of docker containers. + * Added onChangeFlagOnFail which is often a safer alternative to + onChange. + Thanks, Antoine Eiche. -- Joey Hess Mon, 20 Jul 2015 12:01:38 -0400 -- 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 'debian') 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 6fe4b0cd9174aad50987a41784f2e63cf8f1ddd1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 30 Jul 2015 12:05:49 -0400 Subject: prep release --- debian/changelog | 4 ++-- propellor.cabal | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'debian') diff --git a/debian/changelog b/debian/changelog index 2375dfd5..2decb1f0 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,4 +1,4 @@ -propellor (2.7.0) UNRELEASED; urgency=medium +propellor (2.7.0) unstable; urgency=medium * Ssh.permitRootLogin type changed to allow configuring WithoutPassword and ForcedCommandsOnly (API change) @@ -12,7 +12,7 @@ propellor (2.7.0) UNRELEASED; urgency=medium 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 + -- Joey Hess Thu, 30 Jul 2015 12:05:46 -0400 propellor (2.6.0) unstable; urgency=medium diff --git a/propellor.cabal b/propellor.cabal index b60379e8..01c867c8 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 2.6.0 +Version: 2.7.0 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess -- cgit v1.2.3