summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Sbuild.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property/Sbuild.hs')
-rw-r--r--src/Propellor/Property/Sbuild.hs227
1 files changed, 102 insertions, 125 deletions
diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs
index c3e55bbf..23f3b311 100644
--- a/src/Propellor/Property/Sbuild.hs
+++ b/src/Propellor/Property/Sbuild.hs
@@ -20,12 +20,10 @@ Debian stretch, which older sbuild can't handle.
Suggested usage in @config.hs@:
-> & Apt.installed ["piuparts", "autopkgtest"]
+> & Apt.installed ["piuparts", "autopkgtest", "lintian"]
> & 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
If you are using sbuild older than 0.70.0, you also need:
@@ -34,15 +32,13 @@ If you are using sbuild older than 0.70.0, you also need:
In @~/.sbuildrc@ (sbuild 0.71.0 or newer):
-> $run_piuparts = 1;
> $piuparts_opts = [
+> '--no-eatmydata',
> '--schroot',
-> '%r-%a-piuparts',
+> '%r-%a-sbuild',
> '--fail-if-inadequate',
-> '--fail-on-broken-symlinks',
> ];
>
-> $run_autopkgtest = 1;
> $autopkgtest_root_args = "";
> $autopkgtest_opts = ["--", "schroot", "%r-%a-sbuild"];
@@ -53,9 +49,9 @@ 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@:
+Nevertheless, the chroot that @sbuild-createchroot(1)@ creates might not meet
+your needs. For example, you might need to enable apt's https support. In that
+case you can do something like this in @config.hs@:
> & Sbuild.built (System (Debian Linux Unstable) X86_32) `before` mySetup
> where
@@ -74,20 +70,19 @@ module Propellor.Property.Sbuild (
UseCcache(..),
built,
updated,
- piupartsConf,
builtFor,
updatedFor,
- piupartsConfFor,
-- * Global sbuild configuration
-- blockNetwork,
installed,
keypairGenerated,
keypairInsecurelyGenerated,
- shareAptCache,
usableBy,
+ userConfig,
) where
import Propellor.Base
+import Propellor.Types.Info
import Propellor.Property.Debootstrap (extractSuite)
import Propellor.Property.Chroot.Util
import qualified Propellor.Property.Apt as Apt
@@ -98,10 +93,10 @@ import qualified Propellor.Property.File as File
import qualified Propellor.Property.Schroot as Schroot
import qualified Propellor.Property.Reboot as Reboot
import qualified Propellor.Property.User as User
-
import Utility.FileMode
+import Utility.Split
+
import Data.List
-import Data.List.Utils
type Suite = String
@@ -111,8 +106,8 @@ type Suite = String
-- the same suite and the same architecture, so neither do we
data SbuildSchroot = SbuildSchroot Suite Architecture
-instance Show SbuildSchroot where
- show (SbuildSchroot suite arch) = suite ++ "-" ++ architectureToDebianArchString arch
+instance ConfigurableValue SbuildSchroot where
+ val (SbuildSchroot suite arch) = suite ++ "-" ++ architectureToDebianArchString arch
-- | Whether an sbuild schroot should use ccache during builds
--
@@ -128,9 +123,9 @@ data UseCcache = UseCcache | NoCcache
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 $
+ go = Apt.withMirror goDesc $ \u -> property' goDesc $ \w ->
+ case schrootFromSystem sys of
+ Just s -> ensureProperty w $
setupRevertableProperty $ built s u cc
_ -> errorMessage
("don't know how to debootstrap " ++ show sys)
@@ -139,6 +134,7 @@ builtFor sys cc = go <!> deleted
Just s -> ensureProperty w $
undoRevertableProperty $ built s "dummy" cc
Nothing -> noChange
+ goDesc = "sbuild schroot for " ++ show sys
-- | Build and configure a schroot for use with sbuild
built :: SbuildSchroot -> Apt.Url -> UseCcache -> RevertableProperty DebianLike UnixLike
@@ -146,12 +142,13 @@ built s@(SbuildSchroot suite arch) mirror cc =
((go `before` enhancedConf)
`requires` ccacheMaybePrepared cc
`requires` installed
- `requires` overlaysKernel)
+ `requires` overlaysKernel
+ `requires` cleanupOldConfig)
<!> deleted
where
go :: Property DebianLike
go = check (unpopulated (schrootRoot s) <||> ispartial) $
- property' ("built sbuild schroot for " ++ show s) make
+ property' ("built sbuild schroot for " ++ val s) make
make w = do
de <- liftIO standardPathEnv
let params = Param <$>
@@ -170,22 +167,49 @@ built s@(SbuildSchroot suite arch) mirror cc =
-- 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
+ property ("no sbuild schroot for " ++ val s) $ do
liftIO $ removeChroot $ schrootRoot s
liftIO $ nukeFile
- ("/etc/sbuild/chroot" </> show s ++ "-sbuild")
+ ("/etc/sbuild/chroot" </> val s ++ "-sbuild")
makeChange $ nukeFile (schrootConf s)
enhancedConf =
- combineProperties ("enhanced schroot conf for " ++ show s) $ props
+ combineProperties ("enhanced schroot conf for " ++ val s) $ props
& aliasesLine
+ -- set up an apt proxy/cacher
+ & proxyCacher
-- enable ccache and eatmydata for speed
& ConfFile.containsIniSetting (schrootConf s)
- ( show s ++ "-sbuild"
+ ( val s ++ "-sbuild"
, "command-prefix"
, intercalate "," commandPrefix
)
+ -- set the apt proxy inside the chroot. If the host has an apt proxy
+ -- set, assume that it does some sort of caching. Otherwise, set up a
+ -- local apt-cacher-ng instance
+ --
+ -- (if we didn't assume that the apt proxy does some sort of caching,
+ -- we'd need to complicate the Apt.HostAptProxy type to indicate whether
+ -- the proxy caches, and if it doesn't, set up apt-cacher-ng as an
+ -- intermediary proxy between the chroot's apt and the Apt.HostAptProxy
+ -- proxy. This complexity is more likely to cause problems than help
+ -- anyone)
+ proxyCacher :: Property DebianLike
+ proxyCacher = property' "set schroot apt proxy" $ \w -> do
+ proxyInfo <- getProxyInfo
+ ensureProperty w $ case proxyInfo of
+ Just (Apt.HostAptProxy u) -> setChrootProxy u
+ Nothing -> (Apt.serviceInstalledRunning "apt-cacher-ng"
+ `before` setChrootProxy "http://localhost:3142")
+ where
+ getProxyInfo :: Propellor (Maybe Apt.HostAptProxy)
+ getProxyInfo = fromInfoVal <$> askInfo
+ setChrootProxy :: Apt.Url -> Property DebianLike
+ setChrootProxy u = tightenTargets $ File.hasContent
+ (schrootRoot s </> "etc/apt/apt.conf.d/20proxy")
+ [ "Acquire::HTTP::Proxy \"" ++ u ++ "\";" ]
+
-- 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.
@@ -196,7 +220,7 @@ built s@(SbuildSchroot suite arch) mirror cc =
then ensureProperty w $
ConfFile.containsIniSetting
(schrootConf s)
- ( show s ++ "-sbuild"
+ ( val s ++ "-sbuild"
, "aliases"
, aliases
)
@@ -217,6 +241,21 @@ built s@(SbuildSchroot suite arch) mirror cc =
Reboot.toKernelNewerThan "3.18"
else noChange
+ -- clean up config from earlier versions of this module
+ cleanupOldConfig :: Property UnixLike
+ cleanupOldConfig =
+ property' "old sbuild module config cleaned up" $ \w -> do
+ void $ ensureProperty w $
+ check (doesFileExist fstab)
+ (File.lacksLine fstab aptCacheLine)
+ void $ liftIO . tryIO $ removeDirectoryRecursive profile
+ void $ liftIO $ nukeFile (schrootPiupartsConf s)
+ -- assume this did nothing
+ noChange
+ where
+ fstab = "/etc/schroot/sbuild/fstab"
+ profile = "/etc/schroot/piuparts"
+
-- A failed debootstrap run will leave a debootstrap directory;
-- recover by deleting it and trying again.
ispartial = ifM (doesDirectoryExist (schrootRoot s </> "debootstrap"))
@@ -263,7 +302,7 @@ updatedFor system = property' ("updated sbuild schroot for " ++ show system) $
updated :: SbuildSchroot -> Property DebianLike
updated s@(SbuildSchroot suite arch) =
check (doesDirectoryExist (schrootRoot s)) $ go
- `describe` ("updated schroot for " ++ show s)
+ `describe` ("updated schroot for " ++ val s)
`requires` installed
where
go :: Property DebianLike
@@ -283,13 +322,13 @@ updated s@(SbuildSchroot suite arch) =
-- given suite and architecture, so we don't need the suffix to be random.
fixConfFile :: SbuildSchroot -> Property UnixLike
fixConfFile s@(SbuildSchroot suite arch) =
- property' ("schroot for " ++ show s ++ " config file fixed") $ \w -> do
+ property' ("schroot for " ++ val s ++ " config file fixed") $ \w -> do
confs <- liftIO $ dirContents dir
let old = concat $ filter (tempPrefix `isPrefixOf`) confs
liftIO $ moveFile old new
liftIO $ moveFile
- ("/etc/sbuild/chroot" </> show s ++ "-propellor")
- ("/etc/sbuild/chroot" </> show s ++ "-sbuild")
+ ("/etc/sbuild/chroot" </> val s ++ "-propellor")
+ ("/etc/sbuild/chroot" </> val s ++ "-sbuild")
ensureProperty w $
File.fileProperty "replace dummy suffix" (map munge) new
where
@@ -298,92 +337,6 @@ fixConfFile s@(SbuildSchroot suite arch) =
tempPrefix = dir </> suite ++ "-" ++ architectureToDebianArchString arch ++ "-propellor-"
munge = replace "-propellor]" "-sbuild]"
--- | Create a corresponding schroot config file for use with piuparts
---
--- This function is a convenience wrapper around 'piupartsConf', allowing the
--- user to identify the schroot using the 'System' type. See that function's
--- 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 of
- Just s -> ensureProperty w $ piupartsConf s
- _ -> errorMessage
- ("don't know how to debootstrap " ++ show sys)
-
--- | Create a corresponding schroot config file for use with piuparts
---
--- This is useful because:
---
--- - piuparts will clear out the apt cache which makes 'shareAptCache' much less
--- useful
---
--- - piuparts itself invokes eatmydata, so the command-prefix setting in our
--- regular schroot config would force the user to pass @--no-eatmydata@ to
--- piuparts in their @~/.sbuildrc@, which is inconvenient.
---
--- To make use of this new schroot config, you can put something like this in
--- your ~/.sbuildrc (sbuild 0.71.0 or newer):
---
--- > $run_piuparts = 1;
--- > $piuparts_opts = [
--- > '--schroot',
--- > '%r-%a-piuparts',
--- > '--fail-if-inadequate',
--- > '--fail-on-broken-symlinks',
--- > ];
---
--- 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 = 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
---
--- This speeds up builds by avoiding unnecessary downloads of build
--- dependencies.
-shareAptCache :: Property DebianLike
-shareAptCache = File.containsLine "/etc/schroot/sbuild/fstab" aptCacheLine
- `requires` installed
- `describe` "sbuild schroots share host apt cache"
aptCacheLine :: String
aptCacheLine = "/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0"
@@ -493,6 +446,35 @@ ccachePrepared = propertyList "sbuild group ccache configured" $ props
-- [Firewall.IPWithNumMask (IPv4 "127.0.0.1") 8])
-- `requires` installed -- sbuild group must exist
+-- | Maintain recommended ~/.sbuildrc for a user, and adds them to the
+-- sbuild group
+--
+-- You probably want a custom ~/.sbuildrc on your workstation, but
+-- this property is handy for quickly setting up build boxes.
+userConfig :: User -> Property DebianLike
+userConfig user@(User u) = go
+ `requires` usableBy user
+ `requires` Apt.installed ["piuparts", "autopkgtest", "lintian"]
+ where
+ go :: Property DebianLike
+ go = property' ("~/.sbuildrc for " ++ u) $ \w -> do
+ h <- liftIO (User.homedir user)
+ ensureProperty w $ File.hasContent (h </> ".sbuildrc")
+ [ "$run_lintian = 1;"
+ , ""
+ , "$run_piuparts = 1;"
+ , "$piuparts_opts = ["
+ , " '--no-eatmydata',"
+ , " '--schroot',"
+ , " '%r-%a-sbuild',"
+ , " '--fail-if-inadequate',"
+ , " ];"
+ , ""
+ , "$run_autopkgtest = 1;"
+ , "$autopkgtest_root_args = \"\";"
+ , "$autopkgtest_opts = [\"--\", \"schroot\", \"%r-%a-sbuild\"];"
+ ]
+
-- ==== utility functions ====
schrootFromSystem :: System -> Maybe SbuildSchroot
@@ -500,11 +482,6 @@ schrootFromSystem system@(System _ arch) =
extractSuite system
>>= \suite -> return $ SbuildSchroot suite arch
-stdMirror :: System -> Maybe Apt.Url
-stdMirror (System (Debian _ _) _) = Just "http://httpredir.debian.org/debian"
-stdMirror (System (Buntish _) _) = Just "mirror://mirrors.ubuntu.com/"
-stdMirror _ = Nothing
-
schrootRoot :: SbuildSchroot -> FilePath
schrootRoot (SbuildSchroot s a) = "/srv/chroot" </> s ++ "-" ++ architectureToDebianArchString a
@@ -527,7 +504,7 @@ schrootPiupartsConf (SbuildSchroot s a) =
sidHostArchSchroot :: SbuildSchroot -> Propellor Bool
sidHostArchSchroot (SbuildSchroot suite arch) = do
maybeOS <- getOS
- case maybeOS of
- Nothing -> return False
+ return $ case maybeOS of
+ Nothing -> False
Just (System _ hostArch) ->
- return $ suite == "unstable" && hostArch == arch
+ suite == "unstable" && hostArch == arch