{-# 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 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@: > & Sbuild.builtFor (System (Debian Linux Unstable) X86_32) > Sbuild.UseCcache mempty > & 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 If you need propellor to ensure extra properties within the sbuild chroot, you can replace @mempty@ in the above. For example, > & Sbuild.builtFor (System (Debian Linux Unstable) X86_32) > Sbuild.UseCcache $ props > -- the extra configuration you need: > & Apt.installed ["apt-transport-https"] To take advantage of the piuparts and autopkgtest support, add to your @~/.sbuildrc@ (assumes 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"]; -} 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 does this module 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 (isUnpopulated (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 <$> isUnpopulated (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