{-# OPTIONS_HADDOCK prune #-} {-# LANGUAGE TypeFamilies #-} {-| Maintainer: Sean Whitton 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", "lintian"] > & Sbuild.builtFor (System (Debian Linux Unstable) X86_32) Sbuild.UseCcache > & Sbuild.updatedFor (System (Debian Linux Unstable) X86_32) `period` Weekly 1 > & Sbuild.usableBy (User "spwhitton") > & Schroot.overlaysInTmpfs If you are using sbuild older than 0.70.0, you also need: > & Sbuild.keypairGenerated In @~/.sbuildrc@ (sbuild 0.71.0 or newer): > $piuparts_opts = [ > '--no-eatmydata', > '--schroot', > '%r-%a-sbuild', > '--fail-if-inadequate', > ]; > > $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 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 > mySetup = Chroot.provisioned myChroot > myChroot = Chroot.debootstrapped > Debootstrap.BuilddD "/srv/chroot/unstable-i386" > -- the extra configuration you need: > & Apt.installed ["apt-transport-https"] -} -- Also see the --setup-only option of sbuild-createchroot module Propellor.Property.Sbuild ( -- * Creating and updating sbuild schroots SbuildSchroot(..), UseCcache(..), built, updated, builtFor, updatedFor, -- * Global sbuild configuration -- blockNetwork, installed, keypairGenerated, keypairInsecurelyGenerated, 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 import qualified Propellor.Property.Ccache as Ccache import qualified Propellor.Property.ConfFile as ConfFile import qualified Propellor.Property.File as File -- import qualified Propellor.Property.Firewall as Firewall 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 type Suite = String -- | An sbuild schroot, such as would be listed by @schroot -l@ -- -- Parts of the sbuild toolchain cannot distinguish between schroots with both -- the same suite and the same architecture, so neither do we data SbuildSchroot = SbuildSchroot Suite Architecture instance ConfigurableValue SbuildSchroot where val (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 -> UseCcache -> RevertableProperty DebianLike UnixLike builtFor sys cc = go deleted where 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) deleted = property' ("no sbuild schroot for " ++ show sys) $ \w -> case schrootFromSystem sys of 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 built s@(SbuildSchroot suite arch) mirror cc = ((go `before` enhancedConf) `requires` ccacheMaybePrepared cc `requires` installed `requires` overlaysKernel `requires` cleanupOldConfig) deleted where go :: Property DebianLike go = check (unpopulated (schrootRoot s) <||> ispartial) $ property' ("built sbuild schroot for " ++ val s) make make w = do de <- liftIO standardPathEnv let params = Param <$> [ "--arch=" ++ architectureToDebianArchString arch , "--chroot-suffix=-propellor" , "--include=eatmydata,ccache" , suite , schrootRoot s , mirror ] ifM (liftIO $ boolSystemEnv "sbuild-createchroot" params (Just de)) ( 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 " ++ val s) $ do liftIO $ removeChroot $ schrootRoot s liftIO $ nukeFile ("/etc/sbuild/chroot" val s ++ "-sbuild") makeChange $ nukeFile (schrootConf s) enhancedConf = 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) ( 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. aliasesLine :: Property UnixLike aliasesLine = property' "maybe set aliases line" $ \w -> sidHostArchSchroot s >>= \isSidHostArchSchroot -> if isSidHostArchSchroot then ensureProperty w $ ConfFile.containsIniSetting (schrootConf s) ( val 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 -- to a kernel supporting OverlayFS before we execute -- sbuild-setupchroot(1). Otherwise, sbuild-setupchroot(1) will fail to -- add the union-type=overlay line to the schroot config. -- (We could just add that line ourselves, but then sbuild wouldn't work -- for the user, so we might as well do the reboot for them.) overlaysKernel :: Property DebianLike overlaysKernel = property' "reboot for union-type=overlay" $ \w -> Schroot.usesOverlays >>= \usesOverlays -> if usesOverlays then ensureProperty w $ 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")) ( do removeChroot $ schrootRoot s return True , return False ) 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 -- -- This function is a convenience wrapper around 'updated', allowing the user to -- identify the schroot using the 'System' type updatedFor :: System -> Property DebianLike updatedFor system = property' ("updated sbuild schroot for " ++ show system) $ \w -> case schrootFromSystem system of Just s -> ensureProperty w $ updated s Nothing -> errorMessage ("don't know how to debootstrap " ++ show system) -- | Ensure that an sbuild schroot's packages and apt indexes are updated updated :: SbuildSchroot -> Property DebianLike updated s@(SbuildSchroot suite arch) = check (doesDirectoryExist (schrootRoot s)) $ go `describe` ("updated schroot for " ++ val s) `requires` installed where go :: Property DebianLike go = tightenTargets $ cmdProperty "sbuild-update" ["-udr", suite ++ "-" ++ architectureToDebianArchString arch] `assume` MadeChange -- Find the conf file that sbuild-createchroot(1) made when we passed it -- --chroot-suffix=propellor, and edit and rename such that it is as if we -- passed --chroot-suffix=sbuild (the default). Replace the random suffix with -- 'propellor'. -- -- We had to pass --chroot-suffix=propellor in order that we can find a unique -- config file for the schroot we just built, despite the random suffix. -- -- The properties in this module only permit the creation of one chroot for a -- 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 " ++ 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" val s ++ "-propellor") ("/etc/sbuild/chroot" val s ++ "-sbuild") ensureProperty w $ File.fileProperty "replace dummy suffix" (map munge) new where new = schrootConf s dir = takeDirectory new tempPrefix = dir suite ++ "-" ++ architectureToDebianArchString arch ++ "-propellor-" munge = replace "-propellor]" "-sbuild]" aptCacheLine :: String aptCacheLine = "/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0" -- | Ensure that sbuild is installed installed :: Property DebianLike installed = Apt.installed ["sbuild"] -- | Add an user to the sbuild group in order to use sbuild 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 -- Work around Debian bug #792100 which is present in Jessie. -- Since this is a harmless mkdir, don't actually check the OS `requires` File.dirExists "/root/.gnupg" where go :: Property DebianLike go = tightenTargets $ cmdProperty "sbuild-update" ["--keygen"] `assume` MadeChange secKeyFile :: FilePath secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec" -- | Generate the apt keys needed by sbuild using a low-quality source of -- randomness -- -- Note that any running rngd will be killed; if you are using rngd, you should -- arrange for it to be restarted after this property has been ensured. E.g. -- -- > & Sbuild.keypairInsecurelyGenerated -- > `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 go :: Property DebianLike go = combineProperties "sbuild keyring insecurely generated" $ props & Apt.installed ["rng-tools"] -- If this dir does not exist the sbuild key generation command -- will fail; the user might have deleted it to work around -- #831462 & File.dirExists "/var/lib/sbuild/apt-keys" -- If there is already an rngd process running we have to kill -- it, as it might not be feeding to /dev/urandom. We can't -- kill by pid file because that is not guaranteed to be the -- default (/var/run/rngd.pid), so we killall & userScriptProperty (User "root") [ "start-stop-daemon -q -K -R 10 -o -n rngd" , "rngd -r /dev/urandom" ] `assume` MadeChange & keypairGenerated -- Kill off the rngd process we spawned & userScriptProperty (User "root") ["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 -- We only set a limit on the cache if it doesn't already exist, so the -- user can override our default limit & check (not <$> doesDirectoryExist "/var/cache/ccache-sbuild") (Ccache.hasLimits "/var/cache/ccache-sbuild" (Ccache.MaxSize "2G")) `before` Ccache.hasCache (Group "sbuild") Ccache.NoLimit & "/etc/schroot/sbuild/fstab" `File.containsLine` "/var/cache/ccache-sbuild /var/cache/ccache-sbuild none rw,bind 0 0" `describe` "ccache mounted in sbuild schroots" & "/var/cache/ccache-sbuild/sbuild-setup" `File.hasContent` [ "#!/bin/sh" , "" , "export CCACHE_DIR=/var/cache/ccache-sbuild" , "export CCACHE_UMASK=002" , "export CCACHE_COMPRESS=1" , "unset CCACHE_HARDLINK" , "export PATH=\"/usr/lib/ccache:$PATH\"" , "" , "exec \"$@\"" ] & File.mode "/var/cache/ccache-sbuild/sbuild-setup" (combineModes (readModes ++ executeModes)) -- This doesn't seem to work with the current version of sbuild -- -- | Block network access during builds -- -- -- -- This is a hack from until #802850 and -- -- #802849 are resolved. -- blockNetwork :: Property Linux -- blockNetwork = Firewall.rule Firewall.OUTPUT Firewall.Filter Firewall.DROP -- (Firewall.GroupOwner (Group "sbuild") -- <> Firewall.NotDestination -- [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 schrootFromSystem system@(System _ arch) = extractSuite system >>= \suite -> return $ SbuildSchroot suite arch schrootRoot :: SbuildSchroot -> FilePath schrootRoot (SbuildSchroot s a) = "/srv/chroot" s ++ "-" ++ architectureToDebianArchString a schrootConf :: SbuildSchroot -> FilePath schrootConf (SbuildSchroot s a) = "/etc/schroot/chroot.d" s ++ "-" ++ architectureToDebianArchString a ++ "-sbuild-propellor" 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 return $ case maybeOS of Nothing -> False Just (System _ hostArch) -> suite == "unstable" && hostArch == arch