summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/DotDir.hs12
-rw-r--r--src/Propellor/Git.hs13
-rw-r--r--src/Propellor/Property/Debootstrap.hs2
-rw-r--r--src/Propellor/Property/Sbuild.hs254
-rw-r--r--src/Propellor/Property/Ssh.hs4
5 files changed, 195 insertions, 90 deletions
diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs
index c73420b0..21a9cdb7 100644
--- a/src/Propellor/DotDir.hs
+++ b/src/Propellor/DotDir.hs
@@ -401,7 +401,17 @@ setupUpstreamMaster newref = do
changeWorkingDirectory tmprepo
git ["fetch", distrepo, "--quiet"]
git ["reset", "--hard", oldref, "--quiet"]
- git ["merge", newref, "-s", "recursive", "-Xtheirs", "--quiet", "-m", "merging upstream version"]
+ v <- gitVersion
+ let mergeparams =
+ [ "merge", newref
+ , "-s", "recursive"
+ , "-Xtheirs"
+ , "--quiet"
+ , "-m", "merging upstream version"
+ ] ++ if v >= [2,9]
+ then [ "--allow-unrelated-histories" ]
+ else []
+ git mergeparams
void $ fetchUpstreamBranch tmprepo
cleantmprepo
diff --git a/src/Propellor/Git.hs b/src/Propellor/Git.hs
index c3257b31..1d81c157 100644
--- a/src/Propellor/Git.hs
+++ b/src/Propellor/Git.hs
@@ -3,7 +3,10 @@ module Propellor.Git where
import Utility.Process
import Utility.Exception
import Utility.Directory
+import Utility.Misc
+import Utility.PartialPrelude
+import Data.Maybe
import Control.Applicative
import Prelude
@@ -26,3 +29,13 @@ hasOrigin = catchDefaultIO False $ do
hasGitRepo :: IO Bool
hasGitRepo = doesFileExist ".git/HEAD"
+
+type Version = [Int]
+
+gitVersion :: IO Version
+gitVersion = extract <$> readProcess "git" ["--version"]
+ where
+ extract s = case lines s of
+ [] -> []
+ (l:_) -> mapMaybe readish $ segment (== '.') $
+ unwords $ drop 2 $ words l
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 69ac036a..c0226b7e 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -168,7 +168,7 @@ sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do
makeDevicesTarball
makeWrapperScript (localInstallDir </> subdir)
return MadeChange
- _ -> errorMessage "debootstrap tar file did not contain exactly one dirctory"
+ _ -> errorMessage "debootstrap tar file did not contain exactly one directory"
sourceRemove :: Property Linux
sourceRemove = property "debootstrap not installed from source" $ liftIO $
diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs
index 7a27473c..c3e55bbf 100644
--- a/src/Propellor/Property/Sbuild.hs
+++ b/src/Propellor/Property/Sbuild.hs
@@ -6,56 +6,72 @@ Maintainer: Sean Whitton <spwhitton@spwhitton.name>
Build and maintain schroots for use with sbuild.
+For convenience we set up several enhancements, such as ccache and
+eatmydata. This means we have to make several assumptions:
+
+1. you want to build for a Debian release strictly newer than squeeze,
+or for a Buntish release newer than or equal to trusty
+
+2. if you want to build for Debian stretch or newer, you have sbuild 0.70.0 or
+newer (there is a backport to jessie)
+
+The latter is due to the migration from GnuPG v1 to GnuPG v2.1 in
+Debian stretch, which older sbuild can't handle.
+
Suggested usage in @config.hs@:
> & Apt.installed ["piuparts", "autopkgtest"]
-> & Sbuild.builtFor (System (Debian Unstable) X86_32)
-> & Sbuild.piupartsConfFor (System (Debian Unstable) X86_32)
-> & Sbuild.updatedFor (System (Debian Unstable) X86_32) `period` Weekly 1
+> & Sbuild.builtFor (System (Debian Linux Unstable) X86_32) Sbuild.UseCcache
+> & Sbuild.piupartsConfFor (System (Debian Linux Unstable) X86_32)
+> & Sbuild.updatedFor (System (Debian Linux Unstable) X86_32) `period` Weekly 1
> & Sbuild.usableBy (User "spwhitton")
> & Sbuild.shareAptCache
> & Schroot.overlaysInTmpfs
-In @~/.sbuildrc@:
+If you are using sbuild older than 0.70.0, you also need:
+
+> & Sbuild.keypairGenerated
+
+In @~/.sbuildrc@ (sbuild 0.71.0 or newer):
> $run_piuparts = 1;
> $piuparts_opts = [
> '--schroot',
-> 'unstable-i386-piuparts',
+> '%r-%a-piuparts',
> '--fail-if-inadequate',
> '--fail-on-broken-symlinks',
> ];
>
-> $external_commands = {
-> 'post-build-commands' => [
-> [
-> 'adt-run',
-> '--changes', '%c',
-> '---',
-> 'schroot', 'unstable-i386-sbuild;',
->
-> # if adt-run's exit code is 8 then the package had no tests but
-> # this isn't a failure, so catch it
-> 'adtexit=$?;',
-> 'if', 'test', '$adtexit', '=', '8;', 'then',
-> 'exit', '0;', 'else', 'exit', '$adtexit;', 'fi'
-> ],
-> ],
-> };
-
-We use @sbuild-createchroot(1)@ to create a chroot to the specification of
-@sbuild-setup(7)@. This differs from the approach taken by picca's Sbuild.hs,
-which uses 'Propellor.Property.Debootstrap' to construct the chroot. This is
-because we don't want to run propellor inside the chroot in order to keep the
-sbuild environment as standard as possible.
+> $run_autopkgtest = 1;
+> $autopkgtest_root_args = "";
+> $autopkgtest_opts = ["--", "schroot", "%r-%a-sbuild"];
+
+We use @sbuild-createchroot(1)@ to create a chroot to the
+specification of @sbuild-setup(7)@. This avoids running propellor
+inside the chroot to set it up. While that approach is flexible, a
+propellor spin pulls in a lot of dependencies. This could defeat
+using sbuild to determine if you've included all necessary build
+dependencies in your source package control file.
+
+Nevertheless, the chroot that @sbuild-createchroot(1)@ creates might
+not meet your needs. For example, you might need to enable an apt
+cacher. In that case you can do something like this in @config.hs@:
+
+> & Sbuild.built (System (Debian Linux Unstable) X86_32) `before` mySetup
+> where
+> mySetup = Chroot.provisioned myChroot
+> myChroot = Chroot.debootstrapped
+> Debootstrap.BuilddD "/srv/chroot/unstable-i386"
+> -- the extra configuration you need:
+> & Apt.installed ["apt-transport-https"]
-}
--- If you wanted to do it with Propellor.Property.Debootstrap, note that
--- sbuild-createchroot has a --setup-only option
+-- Also see the --setup-only option of sbuild-createchroot
module Propellor.Property.Sbuild (
-- * Creating and updating sbuild schroots
SbuildSchroot(..),
+ UseCcache(..),
built,
updated,
piupartsConf,
@@ -98,32 +114,37 @@ data SbuildSchroot = SbuildSchroot Suite Architecture
instance Show SbuildSchroot where
show (SbuildSchroot suite arch) = suite ++ "-" ++ architectureToDebianArchString arch
+-- | Whether an sbuild schroot should use ccache during builds
+--
+-- ccache is generally useful but it breaks building some packages. This data
+-- types allows you to toggle it on and off for particular schroots.
+data UseCcache = UseCcache | NoCcache
+
-- | Build and configure a schroot for use with sbuild using a distribution's
-- standard mirror
--
-- This function is a convenience wrapper around 'built', allowing the user to
-- identify the schroot and distribution using the 'System' type
-builtFor :: System -> RevertableProperty DebianLike UnixLike
-builtFor sys = go <!> deleted
+builtFor :: System -> UseCcache -> RevertableProperty DebianLike UnixLike
+builtFor sys cc = go <!> deleted
where
go = property' ("sbuild schroot for " ++ show sys) $
\w -> case (schrootFromSystem sys, stdMirror sys) of
(Just s, Just u) -> ensureProperty w $
- setupRevertableProperty $ built s u
+ setupRevertableProperty $ built s u cc
_ -> errorMessage
("don't know how to debootstrap " ++ show sys)
deleted = property' ("no sbuild schroot for " ++ show sys) $
\w -> case schrootFromSystem sys of
Just s -> ensureProperty w $
- undoRevertableProperty $ built s "dummy"
+ undoRevertableProperty $ built s "dummy" cc
Nothing -> noChange
-- | Build and configure a schroot for use with sbuild
-built :: SbuildSchroot -> Apt.Url -> RevertableProperty DebianLike UnixLike
-built s@(SbuildSchroot suite arch) mirror =
- (go
- `requires` keypairGenerated
- `requires` ccachePrepared
+built :: SbuildSchroot -> Apt.Url -> UseCcache -> RevertableProperty DebianLike UnixLike
+built s@(SbuildSchroot suite arch) mirror cc =
+ ((go `before` enhancedConf)
+ `requires` ccacheMaybePrepared cc
`requires` installed
`requires` overlaysKernel)
<!> deleted
@@ -143,12 +164,11 @@ built s@(SbuildSchroot suite arch) mirror =
]
ifM (liftIO $
boolSystemEnv "sbuild-createchroot" params (Just de))
- ( ensureProperty w $
- fixConfFile s
- `before` aliasesLine
- `before` commandPrefix
+ ( ensureProperty w $ fixConfFile s
, return FailedChange
)
+ -- TODO we should kill any sessions still using the chroot
+ -- before destroying it (as suggested by sbuild-destroychroot)
deleted = check (not <$> unpopulated (schrootRoot s)) $
property ("no sbuild schroot for " ++ show s) $ do
liftIO $ removeChroot $ schrootRoot s
@@ -156,23 +176,31 @@ built s@(SbuildSchroot suite arch) mirror =
("/etc/sbuild/chroot" </> show s ++ "-sbuild")
makeChange $ nukeFile (schrootConf s)
+ enhancedConf =
+ combineProperties ("enhanced schroot conf for " ++ show s) $ props
+ & aliasesLine
+ -- enable ccache and eatmydata for speed
+ & ConfFile.containsIniSetting (schrootConf s)
+ ( show s ++ "-sbuild"
+ , "command-prefix"
+ , intercalate "," commandPrefix
+ )
+
-- if we're building a sid chroot, add useful aliases
-- In order to avoid more than one schroot getting the same aliases, we
-- only do this if the arch of the chroot equals the host arch.
aliasesLine :: Property UnixLike
- aliasesLine = property' "maybe set aliases line" $ \w -> do
- maybeOS <- getOS
- case maybeOS of
- Nothing -> return NoChange
- Just (System _ hostArch) ->
- if suite == "unstable" && hostArch == arch
- then ensureProperty w $
- schrootConf s `File.containsLine` aliases
- else return NoChange
-
- -- enable ccache and eatmydata for speed
- commandPrefix = File.containsLine (schrootConf s)
- "command-prefix=/var/cache/ccache-sbuild/sbuild-setup,eatmydata"
+ aliasesLine = property' "maybe set aliases line" $ \w ->
+ sidHostArchSchroot s >>= \isSidHostArchSchroot ->
+ if isSidHostArchSchroot
+ then ensureProperty w $
+ ConfFile.containsIniSetting
+ (schrootConf s)
+ ( show s ++ "-sbuild"
+ , "aliases"
+ , aliases
+ )
+ else return NoChange
-- If the user has indicated that this host should use
-- union-type=overlay schroots, we need to ensure that we have rebooted
@@ -198,7 +226,27 @@ built s@(SbuildSchroot suite arch) mirror =
, return False
)
- aliases = "aliases=UNRELEASED,sid,rc-buggy,experimental"
+ aliases = intercalate ","
+ [ "sid"
+ -- if the user wants to build for experimental, they would use
+ -- their sid chroot and sbuild's --extra-repository option to
+ -- enable experimental
+ , "rc-buggy"
+ , "experimental"
+ -- we assume that building for UNRELEASED means building for
+ -- unstable
+ , "UNRELEASED"
+ -- the following is for dgit compatibility:
+ , "UNRELEASED-"
+ ++ architectureToDebianArchString arch
+ ++ "-sbuild"
+ ]
+
+ commandPrefix = case cc of
+ UseCcache -> "/var/cache/ccache-sbuild/sbuild-setup":base
+ _ -> base
+ where
+ base = ["eatmydata"]
-- | Ensure that an sbuild schroot's packages and apt indexes are updated
--
@@ -216,7 +264,6 @@ updated :: SbuildSchroot -> Property DebianLike
updated s@(SbuildSchroot suite arch) =
check (doesDirectoryExist (schrootRoot s)) $ go
`describe` ("updated schroot for " ++ show s)
- `requires` keypairGenerated
`requires` installed
where
go :: Property DebianLike
@@ -258,9 +305,8 @@ fixConfFile s@(SbuildSchroot suite arch) =
-- documentation for why you might want to use this property, and sample config.
piupartsConfFor :: System -> Property DebianLike
piupartsConfFor sys = property' ("piuparts schroot conf for " ++ show sys) $
- \w -> case (schrootFromSystem sys, stdMirror sys) of
- (Just s, Just u) -> ensureProperty w $
- piupartsConf s u
+ \w -> case schrootFromSystem sys of
+ Just s -> ensureProperty w $ piupartsConf s
_ -> errorMessage
("don't know how to debootstrap " ++ show sys)
@@ -276,47 +322,58 @@ piupartsConfFor sys = property' ("piuparts schroot conf for " ++ show sys) $
-- piuparts in their @~/.sbuildrc@, which is inconvenient.
--
-- To make use of this new schroot config, you can put something like this in
--- your ~/.sbuildrc:
+-- your ~/.sbuildrc (sbuild 0.71.0 or newer):
--
-- > $run_piuparts = 1;
-- > $piuparts_opts = [
-- > '--schroot',
--- > 'unstable-i386-piuparts',
+-- > '%r-%a-piuparts',
-- > '--fail-if-inadequate',
-- > '--fail-on-broken-symlinks',
-- > ];
-piupartsConf :: SbuildSchroot -> Apt.Url -> Property DebianLike
-piupartsConf s u = go
- `requires` (setupRevertableProperty $ built s u)
- `describe` ("piuparts schroot conf for " ++ show s)
+--
+-- This property has no effect if the corresponding sbuild schroot does not
+-- exist (i.e. you also need 'Sbuild.built' or 'Sbuild.builtFor').
+piupartsConf :: SbuildSchroot -> Property DebianLike
+piupartsConf s@(SbuildSchroot _ arch) =
+ check (doesFileExist (schrootConf s)) go
+ `requires` installed
where
go :: Property DebianLike
- go = tightenTargets $
- check (not <$> doesFileExist f)
- (File.basedOn f (schrootConf s, map munge))
- `before`
- ConfFile.containsIniSetting f (sec, "profile", "piuparts")
- `before`
- ConfFile.containsIniSetting f (sec, "aliases", "")
- `before`
- ConfFile.containsIniSetting f (sec, "command-prefix", "")
- `before`
- File.dirExists dir
- `before`
- File.isSymlinkedTo (dir </> "copyfiles")
- (File.LinkTarget $ orig </> "copyfiles")
- `before`
- File.isSymlinkedTo (dir </> "nssdatabases")
- (File.LinkTarget $ orig </> "nssdatabases")
- `before`
- File.basedOn (dir </> "fstab")
- (orig </> "fstab", filter (/= aptCacheLine))
+ go = property' desc $ \w -> do
+ aliases <- aliasesLine
+ ensureProperty w $ combineProperties desc $ props
+ & check (not <$> doesFileExist f)
+ (File.basedOn f (schrootConf s, map munge))
+ & ConfFile.containsIniSetting f
+ (sec, "profile", "piuparts")
+ & ConfFile.containsIniSetting f
+ (sec, "aliases", aliases)
+ & ConfFile.containsIniSetting f
+ (sec, "command-prefix", "")
+ & File.dirExists dir
+ & File.isSymlinkedTo (dir </> "copyfiles")
+ (File.LinkTarget $ orig </> "copyfiles")
+ & File.isSymlinkedTo (dir </> "nssdatabases")
+ (File.LinkTarget $ orig </> "nssdatabases")
+ & File.basedOn (dir </> "fstab")
+ (orig </> "fstab", filter (/= aptCacheLine))
orig = "/etc/schroot/sbuild"
dir = "/etc/schroot/piuparts"
sec = show s ++ "-piuparts"
f = schrootPiupartsConf s
munge = replace "-sbuild]" "-piuparts]"
+ desc = "piuparts schroot conf for " ++ show s
+
+ -- normally the piuparts schroot conf has no aliases, but we have to add
+ -- one, for dgit compatibility, if this is the default sid chroot
+ aliasesLine = sidHostArchSchroot s >>= \isSidHostArchSchroot ->
+ return $ if isSidHostArchSchroot
+ then "UNRELEASED-"
+ ++ architectureToDebianArchString arch
+ ++ "-piuparts"
+ else ""
-- | Bind-mount /var/cache/apt/archives in all sbuild chroots so that the host
-- system and the chroot share the apt cache
@@ -340,6 +397,8 @@ usableBy :: User -> Property DebianLike
usableBy u = User.hasGroup u (Group "sbuild") `requires` installed
-- | Generate the apt keys needed by sbuild
+--
+-- You only need this if you are using sbuild older than 0.70.0.
keypairGenerated :: Property DebianLike
keypairGenerated = check (not <$> doesFileExist secKeyFile) $ go
`requires` installed
@@ -365,6 +424,8 @@ secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec"
-- > `onChange` Systemd.started "my-rngd-service"
--
-- Useful on throwaway build VMs.
+--
+-- You only need this if you are using sbuild older than 0.70.0.
keypairInsecurelyGenerated :: Property DebianLike
keypairInsecurelyGenerated = check (not <$> doesFileExist secKeyFile) go
where
@@ -390,6 +451,11 @@ keypairInsecurelyGenerated = check (not <$> doesFileExist secKeyFile) go
["kill $(cat /var/run/rngd.pid)"]
`assume` MadeChange
+ccacheMaybePrepared :: UseCcache -> Property DebianLike
+ccacheMaybePrepared cc = case cc of
+ UseCcache -> ccachePrepared
+ NoCcache -> doNothing
+
-- another script from wiki.d.o/sbuild
ccachePrepared :: Property DebianLike
ccachePrepared = propertyList "sbuild group ccache configured" $ props
@@ -449,3 +515,19 @@ schrootConf (SbuildSchroot s a) =
schrootPiupartsConf :: SbuildSchroot -> FilePath
schrootPiupartsConf (SbuildSchroot s a) =
"/etc/schroot/chroot.d" </> s ++ "-" ++ architectureToDebianArchString a ++ "-piuparts-propellor"
+
+-- Determine whether a schroot is
+--
+-- (i) Debian sid, and
+-- (ii) the same architecture as the host.
+--
+-- This is the "sid host arch schroot". It is considered the default schroot
+-- for sbuild builds, so we add useful aliases that work well with the suggested
+-- ~/.sbuildrc given in the haddock
+sidHostArchSchroot :: SbuildSchroot -> Propellor Bool
+sidHostArchSchroot (SbuildSchroot suite arch) = do
+ maybeOS <- getOS
+ case maybeOS of
+ Nothing -> return False
+ Just (System _ hostArch) ->
+ return $ suite == "unstable" && hostArch == arch
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 527ad444..bce522f6 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -356,8 +356,8 @@ knownHostLines hosts hn = keylines <$> fromHost hosts hn getHostPubKey
modKnownHost :: User -> FilePath -> Property UnixLike -> Property UnixLike
modKnownHost user f p = p
- `requires` File.ownerGroup f user (userGroup user)
- `requires` File.ownerGroup (takeDirectory f) user (userGroup user)
+ `before` File.ownerGroup f user (userGroup user)
+ `before` File.ownerGroup (takeDirectory f) user (userGroup user)
-- | Ensures that a local user's authorized_keys contains lines allowing
-- logins from a remote user on the specified Host.