From 1e2a335a69cf128682217362ef2bb35d422c05fd Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 28 Oct 2017 09:37:47 -0700 Subject: update sbuild module docs in prep. for refactoring --- src/Propellor/Property/Sbuild.hs | 55 ++++++++++++++++------------------------ 1 file changed, 22 insertions(+), 33 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 210fb20b..c0ca2d59 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -6,23 +6,24 @@ 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: +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 +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) +newer -The latter is due to the migration from GnuPG v1 to GnuPG v2.1 in -Debian stretch, which older sbuild can't handle. +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.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 @@ -30,7 +31,16 @@ If you are using sbuild older than 0.70.0, you also need: > & Sbuild.keypairGenerated -In @~/.sbuildrc@ (sbuild 0.71.0 or newer): +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', @@ -41,29 +51,8 @@ In @~/.sbuildrc@ (sbuild 0.71.0 or newer): > > $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(..), @@ -103,7 +92,7 @@ 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 +-- the same suite and the same architecture, so neither does this module data SbuildSchroot = SbuildSchroot Suite Architecture instance ConfigurableValue SbuildSchroot where -- cgit v1.2.3 From 5a182b90922464cd507218054e0071eb105472e1 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 28 Oct 2017 09:40:00 -0700 Subject: replace Sbuild.installed For most properties in this module we need more than just sbuild installed, so factor that out into a single property. Stop exporting this property as less generally useful. --- src/Propellor/Property/Sbuild.hs | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index c0ca2d59..fab4efa4 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -63,7 +63,6 @@ module Propellor.Property.Sbuild ( updatedFor, -- * Global sbuild configuration -- blockNetwork, - installed, keypairGenerated, keypairInsecurelyGenerated, usableBy, @@ -130,7 +129,7 @@ built :: SbuildSchroot -> Apt.Url -> UseCcache -> RevertableProperty DebianLike built s@(SbuildSchroot suite arch) mirror cc = ((go `before` enhancedConf) `requires` ccacheMaybePrepared cc - `requires` installed + `requires` preReqsInstalled `requires` overlaysKernel `requires` cleanupOldConfig) deleted @@ -292,7 +291,7 @@ updated :: SbuildSchroot -> Property DebianLike updated s@(SbuildSchroot suite arch) = check (doesDirectoryExist (schrootRoot s)) $ go `describe` ("updated schroot for " ++ val s) - `requires` installed + `requires` preReqsInstalled where go :: Property DebianLike go = tightenTargets $ cmdProperty @@ -330,20 +329,20 @@ fixConfFile s@(SbuildSchroot suite arch) = 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"] +-- | Ensure that sbuild and associated utilities are installed +preReqsInstalled :: Property DebianLike +preReqsInstalled = Apt.installed ["piuparts", "autopkgtest", "lintian", "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 +usableBy u = User.hasGroup u (Group "sbuild") `requires` preReqsInstalled -- | 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 + `requires` preReqsInstalled -- 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" @@ -443,7 +442,7 @@ ccachePrepared = propertyList "sbuild group ccache configured" $ props userConfig :: User -> Property DebianLike userConfig user@(User u) = go `requires` usableBy user - `requires` Apt.installed ["piuparts", "autopkgtest", "lintian"] + `requires` preReqsInstalled where go :: Property DebianLike go = property' ("~/.sbuildrc for " ++ u) $ \w -> do -- cgit v1.2.3 From 18dfecfa1e39842365b5b8d2bd99dfb6dc8bd510 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 28 Oct 2017 13:13:36 -0700 Subject: File.isSymlinkedTo now revertable --- src/Propellor/Property/File.hs | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index 3293599a..340a6d02 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -126,18 +126,30 @@ newtype LinkTarget = LinkTarget FilePath -- | Creates or atomically updates a symbolic link. -- +-- Revert to ensure the symlink is not present. +-- -- Does not overwrite regular files or directories. -isSymlinkedTo :: FilePath -> LinkTarget -> Property UnixLike -link `isSymlinkedTo` (LinkTarget target) = property desc $ - go =<< (liftIO $ tryIO $ getSymbolicLinkStatus link) +isSymlinkedTo :: FilePath -> LinkTarget -> RevertableProperty UnixLike UnixLike +link `isSymlinkedTo` (LinkTarget target) = linked notLinked where - desc = link ++ " is symlinked to " ++ target + linked = property (link ++ " is symlinked to " ++ target) $ + go =<< getLinkStatus + go (Right stat) = if isSymbolicLink stat then checkLink else nonSymlinkExists go (Left _) = makeChange $ createSymbolicLink target link + notLinked = property (link ++ "does not exist as a symlink") $ + stop =<< getLinkStatus + + stop (Right stat) = + if isSymbolicLink stat + then makeChange $ nukeFile link + else nonSymlinkExists + stop (Left _) = noChange + nonSymlinkExists = do warningMessage $ link ++ " exists and is not a symlink" return FailedChange @@ -148,6 +160,8 @@ link `isSymlinkedTo` (LinkTarget target) = property desc $ else makeChange updateLink updateLink = createSymbolicLink target `viaStableTmp` link + getLinkStatus = liftIO $ tryIO $ getSymbolicLinkStatus link + -- | Ensures that a file is a copy of another (regular) file. isCopyOf :: FilePath -> FilePath -> Property UnixLike f `isCopyOf` src = property desc $ go =<< (liftIO $ tryIO $ getFileStatus src) -- cgit v1.2.3 From 601b526ccb4d76b0e63a4f62fd76cf5ae3d37663 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 28 Oct 2017 13:20:40 -0700 Subject: wip: convert sbuild module to bypass sbuild-createchroot(1) --- src/Propellor/Property/Sbuild.hs | 287 ++++++++++++++------------------------- 1 file changed, 104 insertions(+), 183 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index fab4efa4..29931722 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -20,10 +20,10 @@ 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 +-- TODO can we use '$' here or do we require more brackets? +> & Sbuild.built Sbuild.UseCcache $ props +> & osDebian Unstable X86_32 +> & Sbuild.update `period` Weekly 1 > & Sbuild.usableBy (User "spwhitton") > & Schroot.overlaysInTmpfs @@ -31,14 +31,6 @@ 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): @@ -55,12 +47,9 @@ To take advantage of the piuparts and autopkgtest support, add to your module Propellor.Property.Sbuild ( -- * Creating and updating sbuild schroots - SbuildSchroot(..), UseCcache(..), built, - updated, - builtFor, - updatedFor, + update, -- * Global sbuild configuration -- blockNetwork, keypairGenerated, @@ -70,12 +59,15 @@ module Propellor.Property.Sbuild ( ) where import Propellor.Base +import Propellor.Types.Core 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.Chroot as Chroot import qualified Propellor.Property.ConfFile as ConfFile +import qualified Propellor.Property.Debootstrap as Debootstrap import qualified Propellor.Property.File as File -- import qualified Propellor.Property.Firewall as Firewall import qualified Propellor.Property.Schroot as Schroot @@ -86,92 +78,81 @@ 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 +-- | Build and configure a schroot for use with sbuild -- --- 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 +-- The second parameter should specify, at a minimum, the operating system for +-- the schroot. This is usually done using a property like 'osDebian' +built + :: UseCcache + -> Props metatypes + -> RevertableProperty (HasInfo + DebianLike) Linux +built cc ps = case schrootSystem ps of + Nothing -> errorMessage + "sbuild schroot does not specify suite and/or architecture" + Just s@(System _ arch) -> case Debootstrap.extractSuite s of + Nothing -> errorMessage + "sbuild schroot does not specify suite" + Just suite -> built' cc ps suite + (architectureToDebianArchString arch) 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` preReqsInstalled - `requires` overlaysKernel - `requires` cleanupOldConfig) - deleted + schrootSystem :: Props metatypes -> Maybe System + schrootSystem (Props ps) = fromInfoVal . fromInfo $ + mconcat (map getInfo ps) + +built' + :: UseCcache + -> Props metatypes + -> String + -> String + -> RevertableProperty (HasInfo + DebianLike) Linux +built' cc ps suite arch = provisioned 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 - ) + provisioned :: Property (HasInfo + DebianLike) + provisioned = combineProperties desc $ props + & cleanupOldConfig + & overlaysKernel + & preReqsInstalled + & ccacheMaybePrepared cc + & Chroot.provisioned schroot + & proxyCacher + & conf suite arch + where + desc = "built sbuild schroot for " ++ suiteArch + -- 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 - ) + deleted :: Property Linux + deleted = propertyList desc $ props + ! Chroot.provisioned schroot + ! compatSymlink + & File.notPresent schrootConf + where + desc = "no sbuild schroot for " ++ suiteArch + + conf suite arch = map pair + [ ("description", (suite ++ "/" ++ arch ++ " autobuilder")) + , ("groups", "root,sbuild") + , ("root-groups", "root,sbuild") + , ("profile", "sbuild") + , ("type", "directory") + , ("directory", schrootRoot) + -- TODO conditionalise (fold into overlayKernels prop?) + , ("union-type", "overlay") + , ("command-prefix", (intercalate "," commandPrefix)) + ] + where + pair (k, v) = ConfFile.containsIniSetting schrootConf + (suiteArch ++ "-sbuild", k, v) + + compatSymlink = File.isSymlinkedTo + ("/etc/sbuild/chroot" suiteArch ++ "-sbuild") + (File.LinkTarget schrootRoot) -- 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 @@ -195,7 +176,7 @@ built s@(SbuildSchroot suite arch) mirror cc = getProxyInfo = fromInfoVal <$> askInfo setChrootProxy :: Apt.Url -> Property DebianLike setChrootProxy u = tightenTargets $ File.hasContent - (schrootRoot s "etc/apt/apt.conf.d/20proxy") + (schrootRoot "etc/apt/apt.conf.d/20proxy") [ "Acquire::HTTP::Proxy \"" ++ u ++ "\";" ] -- if we're building a sid chroot, add useful aliases @@ -203,24 +184,20 @@ built s@(SbuildSchroot suite arch) mirror cc = -- 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 -> + sidHostArchSchroot suite arch >>= \isSidHostArchSchroot -> if isSidHostArchSchroot then ensureProperty w $ - ConfFile.containsIniSetting - (schrootConf s) - ( val s ++ "-sbuild" + ConfFile.containsIniSetting schrootConf + ( suiteArch ++ "-sbuild" , "aliases" , aliases ) else return NoChange - -- If the user has indicated that this host should use + -- 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.) + -- to a kernel supporting OverlayFS. Otherwise, executing sbuild(1) + -- will fail. overlaysKernel :: Property DebianLike overlaysKernel = property' "reboot for union-type=overlay" $ \w -> Schroot.usesOverlays >>= \usesOverlays -> @@ -237,22 +214,28 @@ built s@(SbuildSchroot suite arch) mirror cc = check (doesFileExist fstab) (File.lacksLine fstab aptCacheLine) void $ liftIO . tryIO $ removeDirectoryRecursive profile - void $ liftIO $ nukeFile (schrootPiupartsConf s) + void $ liftIO $ nukeFile schrootPiupartsConf -- 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 - ) - + schrootPiupartsConf = "/etc/schroot/chroot.d" + suiteArch ++ "-piuparts-propellor" + + -- the schroot itself + schroot = Chroot.debootstrapped Debootstrap.BuilddD + schrootRoot schrootProps + -- TODO need to prepend 'ps' to this list of props + schrootProps = props + & Apt.stdSourcesList + & Apt.installed ["eatmydata", "ccache"] + + -- static values + suiteArch = suite ++ "-" ++ arch + schrootRoot = "/srv/chroot" suiteArch + schrootConf = "/etc/schroot/chroot.d" + suiteArch ++ "-sbuild-propellor" aliases = intercalate "," [ "sid" -- if the user wants to build for experimental, they would use @@ -265,10 +248,9 @@ built s@(SbuildSchroot suite arch) mirror cc = , "UNRELEASED" -- the following is for dgit compatibility: , "UNRELEASED-" - ++ architectureToDebianArchString arch + ++ arch ++ "-sbuild" ] - commandPrefix = case cc of UseCcache -> "/var/cache/ccache-sbuild/sbuild-setup":base _ -> base @@ -277,54 +259,9 @@ built s@(SbuildSchroot suite arch) mirror cc = -- | 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` preReqsInstalled - 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]" - +-- This replaces use of sbuild-update(1). +update :: Property DebianLike +update = Apt.update `before` Apt.upgrade `before` Apt.autoRemove aptCacheLine :: String aptCacheLine = "/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0" @@ -446,8 +383,8 @@ userConfig user@(User u) = go where go :: Property DebianLike go = property' ("~/.sbuildrc for " ++ u) $ \w -> do - h <- liftIO (User.homedir user) - ensureProperty w $ File.hasContent (h ".sbuildrc") + h <- liftIO (User.homedir user) + ensureProperty w $ File.hasContent (h ".sbuildrc") [ "$run_lintian = 1;" , "" , "$run_piuparts = 1;" @@ -465,22 +402,6 @@ userConfig user@(User u) = go -- ==== 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 @@ -489,8 +410,8 @@ schrootPiupartsConf (SbuildSchroot s a) = -- 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 +sidHostArchSchroot :: String -> String -> Propellor Bool +sidHostArchSchroot suite arch = do maybeOS <- getOS return $ case maybeOS of Nothing -> False -- cgit v1.2.3 From 8c3d8b1b7ae902a75507473562ce43b5877882a9 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 11 Nov 2017 10:31:14 -0700 Subject: fix type of Firejail.jailed' --- src/Propellor/Property/Firejail.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/Firejail.hs b/src/Propellor/Property/Firejail.hs index 6e877683..aa4024a7 100644 --- a/src/Propellor/Property/Firejail.hs +++ b/src/Propellor/Property/Firejail.hs @@ -26,6 +26,6 @@ jailed ps = mconcat (map jailed' ps) `requires` installed `describe` unwords ("firejail jailed":ps) -jailed' :: String -> Property UnixLike +jailed' :: String -> RevertableProperty UnixLike UnixLike jailed' p = ("/usr/local/bin" p) `File.isSymlinkedTo` File.LinkTarget "/usr/bin/firejail" -- cgit v1.2.3 From 4d3595560faaa9551dcd11e1e19183983b14f37c Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 11 Nov 2017 11:48:24 -0700 Subject: fix type errors --- src/Propellor/Property/Sbuild.hs | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 29931722..62c911e3 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -93,11 +93,11 @@ built -> Props metatypes -> RevertableProperty (HasInfo + DebianLike) Linux built cc ps = case schrootSystem ps of - Nothing -> errorMessage - "sbuild schroot does not specify suite and/or architecture" + -- TODO should emit error and FailedChange + Nothing -> doNothing doNothing Just s@(System _ arch) -> case Debootstrap.extractSuite s of - Nothing -> errorMessage - "sbuild schroot does not specify suite" + -- TODO should emit error and FailedChange + Nothing -> doNothing doNothing Just suite -> built' cc ps suite (architectureToDebianArchString arch) where @@ -135,19 +135,18 @@ built' cc ps suite arch = provisioned deleted where desc = "no sbuild schroot for " ++ suiteArch - conf suite arch = map pair - [ ("description", (suite ++ "/" ++ arch ++ " autobuilder")) - , ("groups", "root,sbuild") - , ("root-groups", "root,sbuild") - , ("profile", "sbuild") - , ("type", "directory") - , ("directory", schrootRoot) - -- TODO conditionalise (fold into overlayKernels prop?) - , ("union-type", "overlay") - , ("command-prefix", (intercalate "," commandPrefix)) - ] + conf suite arch = propertyList "sbuild config file" $ props + & pair "description" (suite ++ "/" ++ arch ++ " autobuilder") + & pair "groups" "root,sbuild" + & pair "root-groups" "root,sbuild" + & pair "profile" "sbuild" + & pair "type" "directory" + & pair "directory" schrootRoot + -- TODO conditionalise (fold into overlayKernels prop?) + & pair "union-type" "overlay" + & pair "command-prefix" (intercalate "," commandPrefix) where - pair (k, v) = ConfFile.containsIniSetting schrootConf + pair k v = ConfFile.containsIniSetting schrootConf (suiteArch ++ "-sbuild", k, v) compatSymlink = File.isSymlinkedTo @@ -416,4 +415,5 @@ sidHostArchSchroot suite arch = do return $ case maybeOS of Nothing -> False Just (System _ hostArch) -> - suite == "unstable" && hostArch == arch + let hostArch' = architectureToDebianArchString hostArch + in suite == "unstable" && hostArch' == arch -- cgit v1.2.3 From e27641b30f7086840841e350c751410c14d789bf Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 11 Nov 2017 13:03:55 -0700 Subject: prepend user props to schroot properties --- src/Propellor/Property/Sbuild.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 62c911e3..e168d053 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -111,7 +111,7 @@ built' -> String -> String -> RevertableProperty (HasInfo + DebianLike) Linux -built' cc ps suite arch = provisioned deleted +built' cc (Props ps) suite arch = provisioned deleted where provisioned :: Property (HasInfo + DebianLike) provisioned = combineProperties desc $ props @@ -224,11 +224,10 @@ built' cc ps suite arch = provisioned deleted -- the schroot itself schroot = Chroot.debootstrapped Debootstrap.BuilddD - schrootRoot schrootProps - -- TODO need to prepend 'ps' to this list of props - schrootProps = props - & Apt.stdSourcesList - & Apt.installed ["eatmydata", "ccache"] + schrootRoot (Props schrootProps) + schrootProps = + ps ++ [toChildProperty Apt.stdSourcesList + , toChildProperty $ Apt.installed ["eatmydata", "ccache"]] -- static values suiteArch = suite ++ "-" ++ arch -- cgit v1.2.3 From 0db6a2d1d8921dfae233feca19d7935f5c1423a5 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 11 Nov 2017 13:04:20 -0700 Subject: fix name shadowing --- src/Propellor/Property/Sbuild.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index e168d053..50f5f046 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -102,8 +102,8 @@ built cc ps = case schrootSystem ps of (architectureToDebianArchString arch) where schrootSystem :: Props metatypes -> Maybe System - schrootSystem (Props ps) = fromInfoVal . fromInfo $ - mconcat (map getInfo ps) + schrootSystem (Props ps') = fromInfoVal . fromInfo $ + mconcat (map getInfo ps') built' :: UseCcache @@ -135,8 +135,8 @@ built' cc (Props ps) suite arch = provisioned deleted where desc = "no sbuild schroot for " ++ suiteArch - conf suite arch = propertyList "sbuild config file" $ props - & pair "description" (suite ++ "/" ++ arch ++ " autobuilder") + conf suite' arch' = propertyList "sbuild config file" $ props + & pair "description" (suite' ++ "/" ++ arch' ++ " autobuilder") & pair "groups" "root,sbuild" & pair "root-groups" "root,sbuild" & pair "profile" "sbuild" -- cgit v1.2.3 From 4617ec3a1d97ffbe962cea41dba220818b438421 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 11 Nov 2017 13:04:35 -0700 Subject: fix redundant imports & a redundant qualification --- src/Propellor/Property/Sbuild.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 50f5f046..2f5a1906 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -62,7 +62,6 @@ import Propellor.Base import Propellor.Types.Core 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.Chroot as Chroot @@ -74,7 +73,6 @@ 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 @@ -95,7 +93,7 @@ built built cc ps = case schrootSystem ps of -- TODO should emit error and FailedChange Nothing -> doNothing doNothing - Just s@(System _ arch) -> case Debootstrap.extractSuite s of + Just s@(System _ arch) -> case extractSuite s of -- TODO should emit error and FailedChange Nothing -> doNothing doNothing Just suite -> built' cc ps suite -- cgit v1.2.3 From ddeaa31de6b5c2eae24251f1e33b44c1d616fc9c Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 12 Nov 2017 11:27:58 -0700 Subject: fail when schroot doesn't specify suite and/or arch --- src/Propellor/Property/Sbuild.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 2f5a1906..e771e7bc 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -91,17 +91,17 @@ built -> Props metatypes -> RevertableProperty (HasInfo + DebianLike) Linux built cc ps = case schrootSystem ps of - -- TODO should emit error and FailedChange - Nothing -> doNothing doNothing + Nothing -> emitError doNothing Just s@(System _ arch) -> case extractSuite s of - -- TODO should emit error and FailedChange - Nothing -> doNothing doNothing + Nothing -> emitError doNothing Just suite -> built' cc ps suite (architectureToDebianArchString arch) where schrootSystem :: Props metatypes -> Maybe System schrootSystem (Props ps') = fromInfoVal . fromInfo $ mconcat (map getInfo ps') + emitError = impossible + "sbuild schroot does not specify suite and/or architecture" built' :: UseCcache -- cgit v1.2.3 From f5a7b6b014b0425a9143d151286dc0e9539e6f69 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 13 Nov 2017 10:42:28 -0700 Subject: emit an error when property is reverted, too Thanks Joey! --- src/Propellor/Property/Sbuild.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index e771e7bc..f96435cf 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -91,17 +91,19 @@ built -> Props metatypes -> RevertableProperty (HasInfo + DebianLike) Linux built cc ps = case schrootSystem ps of - Nothing -> emitError doNothing + Nothing -> emitError Just s@(System _ arch) -> case extractSuite s of - Nothing -> emitError doNothing + Nothing -> emitError Just suite -> built' cc ps suite (architectureToDebianArchString arch) where schrootSystem :: Props metatypes -> Maybe System schrootSystem (Props ps') = fromInfoVal . fromInfo $ mconcat (map getInfo ps') - emitError = impossible - "sbuild schroot does not specify suite and/or architecture" + + emitError :: RevertableProperty (HasInfo + DebianLike) Linux + emitError = impossible theError impossible theError + theError = "sbuild schroot does not specify suite and/or architecture" built' :: UseCcache -- cgit v1.2.3 From 6313fd5582adcec73fbf3186edebf8e31e46dbc5 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 13 Nov 2017 10:50:58 -0700 Subject: conditionalise union-type = overlay --- src/Propellor/Property/Sbuild.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index f96435cf..326d6506 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -142,12 +142,18 @@ built' cc (Props ps) suite arch = provisioned deleted & pair "profile" "sbuild" & pair "type" "directory" & pair "directory" schrootRoot - -- TODO conditionalise (fold into overlayKernels prop?) - & pair "union-type" "overlay" + & unionTypeOverlay & pair "command-prefix" (intercalate "," commandPrefix) where pair k v = ConfFile.containsIniSetting schrootConf (suiteArch ++ "-sbuild", k, v) + unionTypeOverlay :: Property DebianLike + unionTypeOverlay = property' "add union-type = overlay" $ \w -> + Schroot.usesOverlays >>= \usesOverlays -> + if usesOverlays + then ensureProperty w $ + pair "union-type" "overlay" + else noChange compatSymlink = File.isSymlinkedTo ("/etc/sbuild/chroot" suiteArch ++ "-sbuild") -- cgit v1.2.3 From 15dd3205dda4ffb389333f6d6fa84b9ad583d315 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 18 Nov 2017 10:32:42 -0700 Subject: stop automatically setting up a proxy in the sbuild chroot Instead, provide a property to let the user tell propellor to propagate the host's proxy into the chroot. This makes it easy to toggle on and off and lets the user explicitly specify how they want the chroot's proxy setup to work. --- src/Propellor/Property/Sbuild.hs | 34 ++++++++-------------------------- 1 file changed, 8 insertions(+), 26 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 326d6506..619adb23 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -21,9 +21,11 @@ stretch, which older sbuild can't handle. Suggested usage in @config.hs@: -- TODO can we use '$' here or do we require more brackets? +> & Apt.useLocalCacher > & Sbuild.built Sbuild.UseCcache $ props > & osDebian Unstable X86_32 > & Sbuild.update `period` Weekly 1 +> & Sbuild.useHostProxy > & Sbuild.usableBy (User "spwhitton") > & Schroot.overlaysInTmpfs @@ -120,7 +122,6 @@ built' cc (Props ps) suite arch = provisioned deleted & preReqsInstalled & ccacheMaybePrepared cc & Chroot.provisioned schroot - & proxyCacher & conf suite arch where desc = "built sbuild schroot for " ++ suiteArch @@ -159,31 +160,6 @@ built' cc (Props ps) suite arch = provisioned deleted ("/etc/sbuild/chroot" suiteArch ++ "-sbuild") (File.LinkTarget schrootRoot) - -- 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 "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. @@ -267,6 +243,12 @@ built' cc (Props ps) suite arch = provisioned deleted update :: Property DebianLike update = Apt.update `before` Apt.upgrade `before` Apt.autoRemove +-- | Ensure that an sbuild schroot uses the host's Apt proxy. +-- +-- This property is standardly used when the host has 'Apt.useLocalCacher'. +useHostProxy :: Property (HasInfo + DebianLike) +useHostProxy = undefined + aptCacheLine :: String aptCacheLine = "/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0" -- cgit v1.2.3 From d20fd406655e91bad12d3105f47ceee14f72f72b Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 18 Nov 2017 12:49:19 -0700 Subject: implement Sbuild.useHostProxy --- src/Propellor/Property/Sbuild.hs | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 619adb23..56abed2d 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -20,14 +20,16 @@ stretch, which older sbuild can't handle. Suggested usage in @config.hs@: +> mybox = host "mybox.example.com" $ props +> & osDebian Unstable X86_64 +> & Apt.useLocalCacher -- TODO can we use '$' here or do we require more brackets? -> & Apt.useLocalCacher -> & Sbuild.built Sbuild.UseCcache $ props -> & osDebian Unstable X86_32 -> & Sbuild.update `period` Weekly 1 -> & Sbuild.useHostProxy -> & Sbuild.usableBy (User "spwhitton") -> & Schroot.overlaysInTmpfs +> & Sbuild.built Sbuild.UseCcache $ props +> & osDebian Unstable X86_32 +> & Sbuild.update `period` Weekly 1 +> & Sbuild.useHostProxy mybox +> & Sbuild.usableBy (User "spwhitton") +> & Schroot.overlaysInTmpfs If you are using sbuild older than 0.70.0, you also need: @@ -246,8 +248,13 @@ update = Apt.update `before` Apt.upgrade `before` Apt.autoRemove -- | Ensure that an sbuild schroot uses the host's Apt proxy. -- -- This property is standardly used when the host has 'Apt.useLocalCacher'. -useHostProxy :: Property (HasInfo + DebianLike) -useHostProxy = undefined +useHostProxy :: Host -> Property (HasInfo + DebianLike) +useHostProxy host = case getProxyInfo of + Nothing -> doNothing + Just (Apt.HostAptProxy u) -> Apt.proxy u + where + getProxyInfo :: Maybe Apt.HostAptProxy + getProxyInfo = fromInfoVal . fromInfo . hostInfo $ host aptCacheLine :: String aptCacheLine = "/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0" -- cgit v1.2.3 From f5a822272f140612a4f5e01e4b5255bfd3b95dc0 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 18 Nov 2017 13:08:18 -0700 Subject: resolve TODO regarding suggested Sbuild usage --- src/Propellor/Property/Sbuild.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 56abed2d..3063ddd4 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -21,15 +21,16 @@ stretch, which older sbuild can't handle. Suggested usage in @config.hs@: > mybox = host "mybox.example.com" $ props -> & osDebian Unstable X86_64 +> & osDebian (Stable "stretch") X86_64 > & Apt.useLocalCacher --- TODO can we use '$' here or do we require more brackets? -> & Sbuild.built Sbuild.UseCcache $ props -> & osDebian Unstable X86_32 -> & Sbuild.update `period` Weekly 1 -> & Sbuild.useHostProxy mybox +> & Sbuild.built Sbuild.UseCcache unstableSchroot > & Sbuild.usableBy (User "spwhitton") > & Schroot.overlaysInTmpfs +> where +> unstableSchroot = props +> & osDebian Unstable X86_32 +> & Sbuild.update `period` Weekly (Just 1) +> & Sbuild.useHostProxy mybox If you are using sbuild older than 0.70.0, you also need: -- cgit v1.2.3 From ab68426ab1cd4331b57e02af082a7e0541efc32f Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 18 Nov 2017 13:08:32 -0700 Subject: export Sbuild.useHostProxy --- src/Propellor/Property/Sbuild.hs | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 3063ddd4..cffe2f5f 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -54,7 +54,9 @@ module Propellor.Property.Sbuild ( -- * Creating and updating sbuild schroots UseCcache(..), built, + -- * Properties for use inside sbuild schroots update, + useHostProxy, -- * Global sbuild configuration -- blockNetwork, keypairGenerated, -- cgit v1.2.3 From d80c32d3e15163d9b54902982f23cac16b4dbdd8 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 18 Nov 2017 13:08:39 -0700 Subject: fix name shadowing in Sbuild.useHostProxy --- src/Propellor/Property/Sbuild.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index cffe2f5f..048b5cf1 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -252,12 +252,12 @@ update = Apt.update `before` Apt.upgrade `before` Apt.autoRemove -- -- This property is standardly used when the host has 'Apt.useLocalCacher'. useHostProxy :: Host -> Property (HasInfo + DebianLike) -useHostProxy host = case getProxyInfo of +useHostProxy h = case getProxyInfo of Nothing -> doNothing Just (Apt.HostAptProxy u) -> Apt.proxy u where getProxyInfo :: Maybe Apt.HostAptProxy - getProxyInfo = fromInfoVal . fromInfo . hostInfo $ host + getProxyInfo = fromInfoVal . fromInfo . hostInfo $ h aptCacheLine :: String aptCacheLine = "/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0" -- cgit v1.2.3 From f5a46a14719136271e018ccd7ab94b656172b729 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 18 Nov 2017 13:08:48 -0700 Subject: propertyList -> combineProperties to reduce noise --- src/Propellor/Property/Sbuild.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 048b5cf1..d1edd5ac 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -141,7 +141,7 @@ built' cc (Props ps) suite arch = provisioned deleted where desc = "no sbuild schroot for " ++ suiteArch - conf suite' arch' = propertyList "sbuild config file" $ props + conf suite' arch' = combineProperties "sbuild config file" $ props & pair "description" (suite' ++ "/" ++ arch' ++ " autobuilder") & pair "groups" "root,sbuild" & pair "root-groups" "root,sbuild" -- cgit v1.2.3 From 38d039310e4db6ffaf5c8ca51c339421e6865eff Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 18 Nov 2017 13:08:56 -0700 Subject: insert missing call to aliasesLine --- src/Propellor/Property/Sbuild.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index d1edd5ac..df306b1c 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -149,6 +149,7 @@ built' cc (Props ps) suite arch = provisioned deleted & pair "type" "directory" & pair "directory" schrootRoot & unionTypeOverlay + & aliasesLine & pair "command-prefix" (intercalate "," commandPrefix) where pair k v = ConfFile.containsIniSetting schrootConf -- cgit v1.2.3 From 09b92db54d800ce0f94fa0ab4c657446758d5274 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Nov 2017 18:16:58 -0700 Subject: slightly improve readability of sample usage --- src/Propellor/Property/Sbuild.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index df306b1c..dffeaa22 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -23,11 +23,11 @@ Suggested usage in @config.hs@: > mybox = host "mybox.example.com" $ props > & osDebian (Stable "stretch") X86_64 > & Apt.useLocalCacher -> & Sbuild.built Sbuild.UseCcache unstableSchroot +> & sidSchrootBuilt > & Sbuild.usableBy (User "spwhitton") > & Schroot.overlaysInTmpfs > where -> unstableSchroot = props +> sidSchrootBuilt = Sbuild.built Sbuild.UseCcache $ props > & osDebian Unstable X86_32 > & Sbuild.update `period` Weekly (Just 1) > & Sbuild.useHostProxy mybox -- cgit v1.2.3 From 1aaf9c5b080058617d0204219d1c101a345dc6fb Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 19 Nov 2017 18:52:22 -0700 Subject: shorten output when destroying a schroot, too --- src/Propellor/Property/Sbuild.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index dffeaa22..f884b352 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -134,7 +134,7 @@ built' cc (Props ps) suite arch = provisioned deleted -- TODO we should kill any sessions still using the chroot -- before destroying it (as suggested by sbuild-destroychroot) deleted :: Property Linux - deleted = propertyList desc $ props + deleted = combineProperties desc $ props ! Chroot.provisioned schroot ! compatSymlink & File.notPresent schrootConf -- cgit v1.2.3 From 57b084713497bf16a59cc0769148bfad7c7cea71 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 20 Nov 2017 14:32:40 -0700 Subject: prevent Sbuilt.useHostProxy from looping by not peeking too early --- src/Propellor/Property/Apt.hs | 12 ++++++++---- src/Propellor/Property/Sbuild.hs | 13 ++++++++----- 2 files changed, 16 insertions(+), 9 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index 68ebe89e..d44b5c38 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -501,12 +501,16 @@ dpkgStatus = "/var/lib/dpkg/status" -- | Set apt's proxy proxy :: Url -> Property (HasInfo + DebianLike) -proxy u = tightenTargets $ - proxyInfo `before` proxyConfig `describe` desc +proxy u = setInfoProperty (proxy' u) (proxyInfo u) where - proxyInfo = pureInfoProperty desc (InfoVal (HostAptProxy u)) - proxyConfig = "/etc/apt/apt.conf.d/20proxy" `File.hasContent` + proxyInfo = toInfo . InfoVal . HostAptProxy + +proxy' :: Url -> Property DebianLike +proxy' u = tightenTargets $ + "/etc/apt/apt.conf.d/20proxy" `File.hasContent` [ "Acquire::HTTP::Proxy \"" ++ u ++ "\";" ] + `describe` desc + where desc = (u ++ " apt proxy selected") -- | Cause apt to proxy downloads via an apt cacher on localhost diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index f884b352..d323ee67 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -252,12 +252,15 @@ update = Apt.update `before` Apt.upgrade `before` Apt.autoRemove -- | Ensure that an sbuild schroot uses the host's Apt proxy. -- -- This property is standardly used when the host has 'Apt.useLocalCacher'. -useHostProxy :: Host -> Property (HasInfo + DebianLike) -useHostProxy h = case getProxyInfo of - Nothing -> doNothing - Just (Apt.HostAptProxy u) -> Apt.proxy u +useHostProxy :: Host -> Property DebianLike +useHostProxy h = property' "use host's apt proxy" $ \w -> + -- Note that we can't look at getProxyInfo outside the property, + -- as that would loop, but it's ok to look at it inside the + -- property. Thus the slightly strange construction here. + case getProxyInfo of + Just (Apt.HostAptProxy u) -> ensureProperty w (Apt.proxy' u) + Nothing -> noChange where - getProxyInfo :: Maybe Apt.HostAptProxy getProxyInfo = fromInfoVal . fromInfo . hostInfo $ h aptCacheLine :: String -- cgit v1.2.3 From b208bf0a8f8840443c4a69a88f5407c187bfb269 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 20 Nov 2017 14:47:35 -0700 Subject: improve haddock for File.isSymlinkedTo --- src/Propellor/Property/File.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index 340a6d02..3188879e 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -126,9 +126,9 @@ newtype LinkTarget = LinkTarget FilePath -- | Creates or atomically updates a symbolic link. -- --- Revert to ensure the symlink is not present. +-- Revert to ensure no symlink is present. -- --- Does not overwrite regular files or directories. +-- Does not overwrite or delete regular files or directories. isSymlinkedTo :: FilePath -> LinkTarget -> RevertableProperty UnixLike UnixLike link `isSymlinkedTo` (LinkTarget target) = linked notLinked where -- cgit v1.2.3