diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,23 @@ +propellor (4.3.3) unstable; urgency=medium + + * Hosts can be configured to build propellor using stack, by adding + a property: + & bootstrapWith (Robustly Stack) + * Hosts can be configured to build propellor using cabal, but using + only packages installed from the operating system. This + will work on eg Debian: + & bootstrapWith OSOnly + * Iproved fix for bug that sometimes made --spin fail with + "fatal: Couldn't find remote ref HEAD". The previous fix didn't work + reliably. + * User: add systemGroup and use it for systemAccountFor' + Thanks, Félix Sipma. + * Export a Restic.backup' property. + Thanks, Félix Sipma. + * Updated stack config to lts-8.22. + + -- Joey Hess Thu, 13 Jul 2017 12:34:09 -0400 + propellor (4.3.2) unstable; urgency=medium * Really include Propellor.Property.FreeDesktop. @@ -479,7 +499,8 @@ a clone of propellor's git repository, or a minimal config, and will configure propellor to use a gpg key. * Stack support. "git config propellor.buildsystem stack" will make - propellor build its config using stack. + propellor build its config using stack. (This does not affect + how propellor is bootstrapped on a host by "propellor --spin host".) * When propellor is installed using stack, propellor --init will automatically set propellor.buildsystem=stack. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -41,6 +41,8 @@ 1. Get propellor installed on your development machine (ie, laptop). `cabal install propellor` or + `stack install propellor` + or `apt-get install propellor` 2. Run `propellor --init` ; this will set up a `~/.propellor/` git repository for you. diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,23 @@ +propellor (4.3.3) unstable; urgency=medium + + * Hosts can be configured to build propellor using stack, by adding + a property: + & bootstrapWith (Robustly Stack) + * Hosts can be configured to build propellor using cabal, but using + only packages installed from the operating system. This + will work on eg Debian: + & bootstrapWith OSOnly + * Iproved fix for bug that sometimes made --spin fail with + "fatal: Couldn't find remote ref HEAD". The previous fix didn't work + reliably. + * User: add systemGroup and use it for systemAccountFor' + Thanks, Félix Sipma. + * Export a Restic.backup' property. + Thanks, Félix Sipma. + * Updated stack config to lts-8.22. + + -- Joey Hess Thu, 13 Jul 2017 12:34:09 -0400 + propellor (4.3.2) unstable; urgency=medium * Really include Propellor.Property.FreeDesktop. @@ -479,7 +499,8 @@ a clone of propellor's git repository, or a minimal config, and will configure propellor to use a gpg key. * Stack support. "git config propellor.buildsystem stack" will make - propellor build its config using stack. + propellor build its config using stack. (This does not affect + how propellor is bootstrapped on a host by "propellor --spin host".) * When propellor is installed using stack, propellor --init will automatically set propellor.buildsystem=stack. diff --git a/doc/README.mdwn b/doc/README.mdwn --- a/doc/README.mdwn +++ b/doc/README.mdwn @@ -41,6 +41,8 @@ 1. Get propellor installed on your development machine (ie, laptop). `cabal install propellor` or + `stack install propellor` + or `apt-get install propellor` 2. Run `propellor --init` ; this will set up a `~/.propellor/` git repository for you. diff --git a/joeyconfig.hs b/joeyconfig.hs --- a/joeyconfig.hs +++ b/joeyconfig.hs @@ -105,7 +105,7 @@ clam = host "clam.kitenet.net" $ props & standardSystem Unstable X86_64 ["Unreliable server. Anything here may be lost at any time!" ] - & ipv4 "64.137.239.3" + & ipv4 "64.137.182.29" & CloudAtCost.decruft & Ssh.hostKeys hostContext diff --git a/propellor.cabal b/propellor.cabal --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 4.3.2 +Version: 4.3.3 Cabal-Version: >= 1.20 License: BSD2 Maintainer: Joey Hess @@ -55,7 +55,7 @@ Executable propellor-config Default-Language: Haskell98 - Main-Is: config.hs + Main-Is: propellor-config.hs GHC-Options: -threaded -Wall -fno-warn-tabs -O0 if impl(ghc >= 8.0) GHC-Options: -fno-warn-redundant-constraints diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs --- a/src/Propellor/Bootstrap.hs +++ b/src/Propellor/Bootstrap.hs @@ -1,4 +1,8 @@ module Propellor.Bootstrap ( + Bootstrapper(..), + Builder(..), + defaultBootstrapper, + getBootstrapper, bootstrapPropellorCommand, checkBinaryCommand, installGitCommand, @@ -16,71 +20,119 @@ type ShellCommand = String +-- | Different ways that Propellor's dependencies can be installed, +-- and propellor can be built. The default is `Robustly Cabal` +-- +-- `Robustly Cabal` and `Robustly Stack` use the OS's native packages +-- as much as possible to install Cabal, Stack, and propellor's build +-- dependencies. When necessary, dependencies are built from source +-- using Cabal or Stack rather than using the OS's native packages. +-- +-- `OSOnly` uses the OS's native packages of Cabal and all of propellor's +-- build dependencies. It may not work on all systems. +data Bootstrapper = Robustly Builder | OSOnly + deriving (Show) + +data Builder = Cabal | Stack + deriving (Show) + +defaultBootstrapper :: Bootstrapper +defaultBootstrapper = Robustly Cabal + +-- | Gets the Bootstrapper for the Host propellor is running on. +getBootstrapper :: Propellor Bootstrapper +getBootstrapper = go <$> askInfo + where + go NoInfoVal = defaultBootstrapper + go (InfoVal bs) = bs + +getBuilder :: Bootstrapper -> Builder +getBuilder (Robustly b) = b +getBuilder OSOnly = Cabal + -- Shell command line to ensure propellor is bootstrapped and ready to run. -- Should be run inside the propellor config dir, and will install -- all necessary build dependencies and build propellor. -bootstrapPropellorCommand :: Maybe System -> ShellCommand -bootstrapPropellorCommand msys = checkDepsCommand msys ++ +bootstrapPropellorCommand :: Bootstrapper -> Maybe System -> ShellCommand +bootstrapPropellorCommand bs msys = checkDepsCommand bs msys ++ "&& if ! test -x ./propellor; then " - ++ buildCommand ++ - "; fi;" ++ checkBinaryCommand + ++ buildCommand bs ++ + "; fi;" ++ checkBinaryCommand bs -- Use propellor --check to detect if the local propellor binary has -- stopped working (eg due to library changes), and must be rebuilt. -checkBinaryCommand :: ShellCommand -checkBinaryCommand = "if test -x ./propellor && ! ./propellor --check; then " ++ go ++ "; fi" +checkBinaryCommand :: Bootstrapper -> ShellCommand +checkBinaryCommand bs = "if test -x ./propellor && ! ./propellor --check; then " ++ go (getBuilder bs) ++ "; fi" where - go = intercalate " && " + go Cabal = intercalate " && " [ "cabal clean" - , buildCommand + , buildCommand bs ] + go Stack = intercalate " && " + [ "stack clean" + , buildCommand bs + ] -buildCommand :: ShellCommand -buildCommand = intercalate " && " - [ "cabal configure" - , "cabal build propellor-config" - , "ln -sf dist/build/propellor-config/propellor-config propellor" - ] +buildCommand :: Bootstrapper -> ShellCommand +buildCommand bs = intercalate " && " (go (getBuilder bs)) + where + go Cabal = + [ "cabal configure" + , "cabal build propellor-config" + , "ln -sf dist/build/propellor-config/propellor-config propellor" + ] + go Stack = + [ "stack build :propellor-config" + , "ln -sf $(stack path --dist-dir)/build/propellor-config/propellor-config propellor" + ] --- Run cabal configure to check if all dependencies are installed; --- if not, run the depsCommand. -checkDepsCommand :: Maybe System -> ShellCommand -checkDepsCommand sys = "if ! cabal configure >/dev/null 2>&1; then " ++ depsCommand sys ++ "; fi" +-- Check if all dependencies are installed; if not, run the depsCommand. +checkDepsCommand :: Bootstrapper -> Maybe System -> ShellCommand +checkDepsCommand bs sys = go (getBuilder bs) + where + go Cabal = "if ! cabal configure >/dev/null 2>&1; then " ++ depsCommand bs sys ++ "; fi" + go Stack = "if ! stack build --dry-run >/dev/null 2>&1; then " ++ depsCommand bs sys ++ "; fi" --- Install build dependencies of propellor. --- --- First, try to install ghc, cabal, gnupg, and all haskell libraries that --- propellor uses from OS packages. +-- Install build dependencies of propellor, using the specified +-- Bootstrapper. -- +-- When bootstrapping Robustly, first try to install the builder, +-- and all haskell libraries that propellor uses from OS packages. -- Some packages may not be available in some versions of Debian -- (eg, Debian wheezy lacks async), or propellor may need a newer version. --- So, as a second step, cabal is used to install all dependencies. +-- So, as a second step, any other dependencies are installed from source +-- using the builder. -- -- Note: May succeed and leave some deps not installed. -depsCommand :: Maybe System -> ShellCommand -depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall]) ++ " ) || true" +depsCommand :: Bootstrapper -> Maybe System -> ShellCommand +depsCommand bs msys = "( " ++ intercalate " ; " (go bs) ++ ") || true" where - osinstall = case msys of - Just (System (FreeBSD _) _) -> map pkginstall fbsddeps - Just (System (ArchLinux) _) -> map pacmaninstall archlinuxdeps - Just (System (Debian _ _) _) -> useapt - Just (System (Buntish _) _) -> useapt - -- assume a debian derived system when not specified - Nothing -> useapt - - useapt = "apt-get update" : map aptinstall debdeps - - cabalinstall = + go (Robustly Cabal) = osinstall Cabal ++ [ "cabal update" , "cabal install --only-dependencies" + ] + go (Robustly Stack) = osinstall Stack ++ + [ "stack setup" + , "stack build --only-dependencies :propellor-config" ] + go OSOnly = osinstall Cabal + osinstall builder = case msys of + Just (System (FreeBSD _) _) -> map pkginstall (fbsddeps builder) + Just (System (ArchLinux) _) -> map pacmaninstall (archlinuxdeps builder) + Just (System (Debian _ _) _) -> useapt builder + Just (System (Buntish _) _) -> useapt builder + -- assume a Debian derived system when not specified + Nothing -> useapt builder + + useapt builder = "apt-get update" : map aptinstall (debdeps builder) + aptinstall p = "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-recommends -y install " ++ p pkginstall p = "ASSUME_ALWAYS_YES=yes pkg install " ++ p pacmaninstall p = "pacman -S --noconfirm --needed " ++ p -- This is the same deps listed in debian/control. - debdeps = + debdeps Cabal = [ "gnupg" , "ghc" , "cabal-install" @@ -98,8 +150,13 @@ , "libghc-text-dev" , "libghc-hashable-dev" ] - fbsddeps = + debdeps Stack = [ "gnupg" + , "haskell-stack" + ] + + fbsddeps Cabal = + [ "gnupg" , "ghc" , "hs-cabal-install" , "hs-async" @@ -116,8 +173,13 @@ , "hs-text" , "hs-hashable" ] - archlinuxdeps = + fbsddeps Stack = [ "gnupg" + , "stack" + ] + + archlinuxdeps Cabal = + [ "gnupg" , "ghc" , "cabal-install" , "haskell-async" @@ -135,6 +197,10 @@ , "haskell-text" , "hashell-hashable" ] + archlinuxdeps Stack = + [ "gnupg" + , "stack" + ] installGitCommand :: Maybe System -> ShellCommand installGitCommand msys = case msys of @@ -155,22 +221,28 @@ , "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-install-recommends --no-upgrade -y install git" ] +-- Build propellor, and symlink the built binary to ./propellor. +-- +-- When the Host has a Buildsystem specified it is used. If none is +-- specified, look at git config propellor.buildsystem. buildPropellor :: Maybe Host -> IO () -buildPropellor mh = unlessM (actionMessage "Propellor build" (build msys)) $ +buildPropellor mh = unlessM (actionMessage "Propellor build" build) $ errorMessage "Propellor build failed!" where msys = case fmap (fromInfo . hostInfo) mh of Just (InfoVal sys) -> Just sys _ -> Nothing --- Build propellor using cabal or stack, and symlink propellor to the --- built binary. -build :: Maybe System -> IO Bool -build msys = catchBoolIO $ do - bs <- getGitConfigValue "propellor.buildsystem" - case bs of - Just "stack" -> stackBuild msys - _ -> cabalBuild msys + build = catchBoolIO $ do + case fromInfo (maybe mempty hostInfo mh) of + NoInfoVal -> do + bs <- getGitConfigValue "propellor.buildsystem" + case bs of + Just "stack" -> stackBuild msys + _ -> cabalBuild msys + InfoVal bs -> case getBuilder bs of + Cabal -> cabalBuild msys + Stack -> stackBuild msys -- For speed, only runs cabal configure when it's not been run before. -- If the build fails cabal may need to have configure re-run. @@ -203,7 +275,7 @@ , case msys of Nothing -> return False Just sys -> - boolSystem "sh" [Param "-c", Param (depsCommand (Just sys))] + boolSystem "sh" [Param "-c", Param (depsCommand (Robustly Cabal) (Just sys))] <&&> cabal ["configure"] ) cabal_build = cabal ["build", "propellor-config"] diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs --- a/src/Propellor/DotDir.hs +++ b/src/Propellor/DotDir.hs @@ -316,7 +316,7 @@ ] stackResolver :: String -stackResolver = "lts-7.16" +stackResolver = "lts-8.22" fullClone :: IO Result fullClone = do diff --git a/src/Propellor/Property/Bootstrap.hs b/src/Propellor/Property/Bootstrap.hs --- a/src/Propellor/Property/Bootstrap.hs +++ b/src/Propellor/Property/Bootstrap.hs @@ -1,12 +1,40 @@ -module Propellor.Property.Bootstrap (RepoSource(..), bootstrappedFrom, clonedFrom) where +-- | This module contains properties that configure how Propellor +-- bootstraps to run itself on a Host. +module Propellor.Property.Bootstrap ( + Bootstrapper(..), + Builder(..), + bootstrapWith, + RepoSource(..), + bootstrappedFrom, + clonedFrom +) where + import Propellor.Base import Propellor.Bootstrap +import Propellor.Types.Info import Propellor.Property.Chroot import Data.List import qualified Data.ByteString as B +-- | This property can be used to configure the `Bootstrapper` that is used +-- to bootstrap propellor on a Host. For example, if you want to use +-- stack: +-- +-- > host "example.com" $ props +-- > & bootstrapWith (Robustly Stack) +-- +-- When `bootstrappedFrom` is used in a `Chroot` or other `Container`, +-- this property can also be added to the chroot to configure it. +bootstrapWith :: Bootstrapper -> Property (HasInfo + UnixLike) +bootstrapWith b = pureInfoProperty desc (InfoVal b) + where + desc = "bootstrapped with " ++ case b of + Robustly Stack -> "stack" + Robustly Cabal -> "cabal" + OSOnly -> "OS packages only" + -- | Where a propellor repository should be bootstrapped from. data RepoSource = GitRepoUrl String @@ -17,14 +45,17 @@ -- | Bootstraps a propellor installation into -- /usr/local/propellor/ -- --- This property only does anything when used inside a chroot. --- This is particularly useful inside a chroot used to build a +-- Normally, propellor is bootstrapped by eg, using propellor --spin, +-- and so this property is not generally needed. +-- +-- This property only does anything when used inside a Chroot or other +-- Container. This is particularly useful inside a chroot used to build a -- disk image, to make the disk image have propellor installed. -- -- The git repository is cloned (or pulled to update if it already exists). -- -- All build dependencies are installed, using distribution packages --- or falling back to using cabal. +-- or falling back to using cabal or stack. bootstrappedFrom :: RepoSource -> Property Linux bootstrappedFrom reposource = check inChroot $ go `requires` clonedFrom reposource @@ -32,14 +63,15 @@ go :: Property Linux go = property "Propellor bootstrapped" $ do system <- getOS + bootstrapper <- getBootstrapper assumeChange $ exposeTrueLocaldir $ const $ runShellCommand $ buildShellCommand [ "cd " ++ localdir - , checkDepsCommand system - , buildCommand + , checkDepsCommand bootstrapper system + , buildCommand bootstrapper ] --- | Clones the propellor repeository into /usr/local/propellor/ +-- | Clones the propellor repository into /usr/local/propellor/ -- -- If the propellor repo has already been cloned, pulls to get it -- up-to-date. diff --git a/src/Propellor/Property/Cron.hs b/src/Propellor/Property/Cron.hs --- a/src/Propellor/Property/Cron.hs +++ b/src/Propellor/Property/Cron.hs @@ -80,7 +80,8 @@ -- | Installs a cron job to run propellor. runPropellor :: Times -> Property UnixLike -runPropellor times = withOS "propellor cron job" $ \w o -> +runPropellor times = withOS "propellor cron job" $ \w o -> do + bootstrapper <- getBootstrapper ensureProperty w $ niceJob "propellor" times (User "root") localdir - (bootstrapPropellorCommand o ++ "; ./propellor") + (bootstrapPropellorCommand bootstrapper o ++ "; ./propellor") diff --git a/src/Propellor/Property/Restic.hs b/src/Propellor/Property/Restic.hs --- a/src/Propellor/Property/Restic.hs +++ b/src/Propellor/Property/Restic.hs @@ -9,6 +9,7 @@ , init , restored , backup + , backup' , KeepPolicy (..) ) where @@ -138,17 +139,17 @@ -- backup job will be run at a time. Other jobs will wait their turns to -- run. backup :: FilePath -> ResticRepo -> Cron.Times -> [ResticParam] -> [KeepPolicy] -> Property (HasInfo + DebianLike) -backup dir repo crontimes extraargs kp = backup' dir repo crontimes extraargs kp +backup dir repo crontimes extraargs kp = backup' [dir] repo crontimes extraargs kp `requires` restored dir repo -- | Does a backup, but does not automatically restore. -backup' :: FilePath -> ResticRepo -> Cron.Times -> [ResticParam] -> [KeepPolicy] -> Property (HasInfo + DebianLike) -backup' dir repo crontimes extraargs kp = cronjob +backup' :: [FilePath] -> ResticRepo -> Cron.Times -> [ResticParam] -> [KeepPolicy] -> Property (HasInfo + DebianLike) +backup' dirs repo crontimes extraargs kp = cronjob `describe` desc `requires` init repo where desc = val repo ++ " restic backup" - cronjob = Cron.niceJob ("restic_backup" ++ dir) crontimes (User "root") "/" $ + cronjob = Cron.niceJob ("restic_backup" ++ intercalate "_" dirs) crontimes (User "root") "/" $ "flock " ++ shellEscape lockfile ++ " sh -c " ++ shellEscape backupcmd lockfile = "/var/lock/propellor-restic.lock" backupcmd = intercalate " && " $ @@ -162,9 +163,8 @@ , shellEscape (getPasswordFile repo) ] ++ map shellEscape extraargs ++ - [ "backup" - , shellEscape dir - ] + [ "backup" ] + ++ map shellEscape dirs pruneCommand = unwords $ [ "restic" , "-r" diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs --- a/src/Propellor/Property/User.hs +++ b/src/Propellor/Property/User.hs @@ -22,17 +22,18 @@ systemAccountFor user@(User u) = systemAccountFor' user Nothing (Just (Group u)) systemAccountFor' :: User -> Maybe FilePath -> Maybe Group -> Property DebianLike -systemAccountFor' (User u) mhome mgroup = tightenTargets $ check nouser go +systemAccountFor' (User u) mhome mgroup = case mgroup of + Nothing -> prop + Just g -> prop + `requires` systemGroup g `describe` ("system account for " ++ u) where + prop = tightenTargets $ check nouser go nouser = isNothing <$> catchMaybeIO (getUserEntryForName u) go = cmdProperty "adduser" $ - [ "--system" ] + [ "--system", "--home" ] ++ - "--home" : maybe - ["/nonexistent", "--no-create-home"] - ( \h -> [ h ] ) - mhome + maybe ["/nonexistent", "--no-create-home"] ( \h -> [h] ) mhome ++ maybe [] ( \(Group g) -> ["--ingroup", g] ) mgroup ++ @@ -42,6 +43,16 @@ , u ] +systemGroup :: Group -> Property UnixLike +systemGroup (Group g) = check nogroup go + `describe` ("system account for " ++ g) + where + nogroup = isNothing <$> catchMaybeIO (getGroupEntryForName g) + go = cmdProperty "addgroup" + [ "--system" + , g + ] + -- | Removes user home directory!! Use with caution. nuked :: User -> Eep -> Property Linux nuked user@(User u) _ = tightenTargets $ check hashomedir go @@ -111,7 +122,7 @@ hClose h lockedPassword :: User -> Property DebianLike -lockedPassword user@(User u) = tightenTargets $ +lockedPassword user@(User u) = tightenTargets $ check (not <$> isLockedPassword user) go `describe` ("locked " ++ u ++ " password") where diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs --- a/src/Propellor/Protocol.hs +++ b/src/Propellor/Protocol.hs @@ -53,11 +53,7 @@ hFlush h getMarked :: Handle -> Marker -> IO (Maybe String) -getMarked h marker = do - -- Avoid buffering anything in Handle, so that the data after - -- the marker will be available to be read from the underlying Fd. - hSetBuffering stdin NoBuffering - go =<< catchMaybeIO (hGetLine h) +getMarked h marker = go =<< catchMaybeIO (hGetLine h) where go Nothing = return Nothing go (Just l) = case fromMarked marker l of @@ -69,8 +65,8 @@ debug ["received marked", marker] return (Just v) -reqMarked :: Stage -> Marker -> (String -> IO ()) -> IO () -reqMarked stage marker a = do +req :: Stage -> Marker -> (String -> IO ()) -> IO () +req stage marker a = do debug ["requested marked", marker] sendMarked' stdout statusMarker (show stage) maybe noop a =<< getMarked stdin marker diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -93,6 +93,9 @@ sys = case fromInfo (hostInfo hst) of InfoVal o -> Just o NoInfoVal -> Nothing + bootstrapper = case fromInfo (hostInfo hst) of + NoInfoVal -> defaultBootstrapper + InfoVal bs -> bs relaying = relay == Just target viarelay = isJust relay && not relaying @@ -109,7 +112,7 @@ updatecmd = intercalate " && " [ "cd " ++ localdir - , bootstrapPropellorCommand sys + , bootstrapPropellorCommand bootstrapper sys , if viarelay then "./propellor --continue " ++ shellEscape (show (Relay target)) @@ -178,11 +181,11 @@ update :: Maybe HostName -> IO () update forhost = do whenM hasGitRepo $ - reqMarked NeedRepoUrl repoUrlMarker setRepoUrl + req NeedRepoUrl repoUrlMarker setRepoUrl makePrivDataDir createDirectoryIfMissing True (takeDirectory privfile) - reqMarked NeedPrivData privDataMarker $ + req NeedPrivData privDataMarker $ writeFileProtected privfile whenM hasGitRepo $ @@ -350,18 +353,30 @@ -- Request that it run git upload-pack, and connect that up to a git fetch -- to receive the data. gitPullFromUpdateServer :: IO () -gitPullFromUpdateServer = reqMarked NeedGitPush gitPushMarker $ \_ -> do - -- Note that this relies on data not being buffered in the stdin - -- Handle, since such buffered data would not be available in the - -- FD passed to git fetch. - hin <- dup stdInput +gitPullFromUpdateServer = req NeedGitPush gitPushMarker $ \_ -> do + -- IO involving stdin can cause data to be buffered in the Handle + -- (even when it's set NoBuffering), but we need to pass a FD to + -- git fetch containing all of stdin after the gitPushMarker, + -- including any that has been buffered. + -- + -- To do so, create a pipe, and forward stdin, including any + -- buffered part, through it. + (pread, pwrite) <- System.Posix.IO.createPipe + -- Note that there is a race between the createPipe and setting + -- CloseOnExec. Another processess forked here would inherit + -- pwrite and perhaps keep it open. However, propellor is not + -- running concurrent threads at this point, so this is ok. + setFdOption pwrite CloseOnExec True + hwrite <- fdToHandle pwrite + forwarder <- async $ stdin *>* hwrite + let hin = pread hout <- dup stdOutput - hClose stdin hClose stdout -- Not using git pull because git 2.5.0 badly -- broke its option parser. unlessM (boolSystemNonConcurrent "git" (fetchparams hin hout)) $ errorMessage "git fetch from client failed" + wait forwarder unlessM (boolSystemNonConcurrent "git" [Param "merge", Param "FETCH_HEAD"]) $ errorMessage "git merge from client failed" where diff --git a/src/config.hs b/src/config.hs deleted file mode 100644 --- a/src/config.hs +++ /dev/null @@ -1,29 +0,0 @@ --- This is the main configuration file for Propellor, and is used to build --- the propellor program. - -import Propellor -import qualified Propellor.Property.File as File -import qualified Propellor.Property.Apt as Apt -import qualified Propellor.Property.Cron as Cron -import qualified Propellor.Property.User as User - -main :: IO () -main = defaultMain hosts - --- The hosts propellor knows about. -hosts :: [Host] -hosts = - [ mybox - ] - --- An example host. -mybox :: Host -mybox = host "mybox.example.com" $ props - & osDebian Unstable X86_64 - & Apt.stdSourcesList - & Apt.unattendedUpgrades - & Apt.installed ["etckeeper"] - & Apt.installed ["ssh"] - & User.hasSomePassword (User "root") - & File.dirExists "/var/www" - & Cron.runPropellor (Cron.Times "30 * * * *") diff --git a/src/propellor-config.hs b/src/propellor-config.hs new file mode 100644 --- /dev/null +++ b/src/propellor-config.hs @@ -0,0 +1,29 @@ +-- This is the main configuration file for Propellor, and is used to build +-- the propellor program. + +import Propellor +import qualified Propellor.Property.File as File +import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.Cron as Cron +import qualified Propellor.Property.User as User + +main :: IO () +main = defaultMain hosts + +-- The hosts propellor knows about. +hosts :: [Host] +hosts = + [ mybox + ] + +-- An example host. +mybox :: Host +mybox = host "mybox.example.com" $ props + & osDebian Unstable X86_64 + & Apt.stdSourcesList + & Apt.unattendedUpgrades + & Apt.installed ["etckeeper"] + & Apt.installed ["ssh"] + & User.hasSomePassword (User "root") + & File.dirExists "/var/www" + & Cron.runPropellor (Cron.Times "30 * * * *") diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ # When updating the resolver here, also update stackResolver in Propellor.DotDir -resolver: lts-7.16 +resolver: lts-8.22 packages: - '.'