Merge branch 'joeyconfig'
This commit is contained in:
Joey Hess
commit
b36a75fd93
|
|
@ -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
|
||||
|
|
@ -45,6 +46,7 @@ hosts = -- (o) `
|
|||
, gnu
|
||||
, clam
|
||||
, orca
|
||||
, honeybee
|
||||
, kite
|
||||
, elephant
|
||||
, beaver
|
||||
|
|
@ -128,10 +130,39 @@ 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" 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"
|
||||
|
||||
-- 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/container/armel-git-annex-builder"
|
||||
& GitAnnexBuilder.standardAutoBuilder builderos Cron.Daily "22h")
|
||||
where
|
||||
-- Using unstable to get new enough ghc for TH on arm.
|
||||
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
|
||||
|
|
@ -310,6 +341,7 @@ beaver = host "beaver.kitenet.net"
|
|||
-- Branchable is not completely deployed with propellor yet.
|
||||
pell :: Host
|
||||
pell = host "pell.branchable.com"
|
||||
& alias "branchable.com"
|
||||
& ipv4 "66.228.46.55"
|
||||
& ipv6 "2600:3c03::f03c:91ff:fedf:c0e5"
|
||||
|
||||
|
|
|
|||
|
|
@ -4,11 +4,15 @@ 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
|
||||
domain, not to smtp.domain as documented.
|
||||
* Mount /proc inside a chroot before provisioning it, to work around #787227
|
||||
|
||||
-- Joey Hess <id@joeyh.name> Thu, 07 May 2015 12:08:34 -0400
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
--
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -41,7 +42,7 @@ satellite = check (not <$> mainCfIsSet "relayhost") setup
|
|||
, ("postfix/destinations", "string", "localhost")
|
||||
, ("postfix/mailname", "string", hn)
|
||||
]
|
||||
, mainCf ("relayhost", domain)
|
||||
, mainCf ("relayhost", "smtp." ++ domain)
|
||||
`onChange` reloaded
|
||||
]
|
||||
|
||||
|
|
|
|||
|
|
@ -94,19 +94,24 @@ 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
|
||||
& standardAutoBuilder osver crontime timeout
|
||||
where
|
||||
name = arch ++ "-git-annex-builder"
|
||||
bootstrap = Chroot.debootstrapped osver mempty
|
||||
osver = System (Debian Testing) arch
|
||||
|
||||
standardAutoBuilder :: System -> Times -> TimeOut -> Property HasInfo
|
||||
standardAutoBuilder osver@(System _ arch) crontime timeout =
|
||||
propertyList "git-annex-builder" $ props
|
||||
& os osver
|
||||
& Apt.stdSourcesList
|
||||
& Apt.unattendedUpgrades
|
||||
& User.accountFor (User builduser)
|
||||
& tree arch
|
||||
& buildDepsApt
|
||||
& autobuilder arch crontime timeout
|
||||
|
||||
androidAutoBuilderContainer :: Times -> TimeOut -> Systemd.Container
|
||||
androidAutoBuilderContainer crontimes timeout =
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
{- System.Process enhancements, including additional ways of running
|
||||
- processes, and logging.
|
||||
-
|
||||
- Copyright 2012 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2012-2015 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- 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
|
||||
|
|
|
|||
Loading…
Reference in New Issue