From 3632a07142dca7422c3343e98de33f2abec629aa Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 11 Nov 2019 15:44:12 -0400 Subject: Changed the ChrootBootstrapper type class's buildchroot method to take a Info parameter, instead of Maybe System. The System can be extracted from the Info; this also allows the chroot's Info to be introspected for eg, the apt mirror. (API change) --- src/Propellor/Property/Chroot.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'src/Propellor/Property/Chroot.hs') diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 48d96dcf..5be39bd6 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -60,7 +60,11 @@ class ChrootBootstrapper b where -- | Do initial bootstrapping of an operating system in a chroot. -- If the operating System is not supported, return -- Left error message. - buildchroot :: b -> Maybe System -> FilePath -> Either String (Property Linux) + buildchroot + :: b + -> Info -- ^ info of the Properties of the chroot + -> FilePath -- ^ where to bootstrap the chroot + -> Either String (Property Linux) -- | Use this to bootstrap a chroot by extracting a tarball. -- @@ -91,7 +95,7 @@ extractTarball target src = check (isUnpopulated target) $ data Debootstrapped = Debootstrapped Debootstrap.DebootstrapConfig instance ChrootBootstrapper Debootstrapped where - buildchroot (Debootstrapped cf) system loc = case system of + buildchroot (Debootstrapped cf) info loc = case system of (Just s@(System (Debian _ _) _)) -> Right $ debootstrap s (Just s@(System (Buntish _) _)) -> Right $ debootstrap s (Just (System ArchLinux _)) -> Left "Arch Linux not supported by debootstrap." @@ -99,6 +103,7 @@ instance ChrootBootstrapper Debootstrapped where Nothing -> Left "Cannot debootstrap; OS not specified" where debootstrap s = Debootstrap.built loc s cf + system = fromInfoVal (fromInfo info) -- | Defines a Chroot at the given location, built with debootstrap. -- @@ -143,7 +148,7 @@ provisioned' c@(Chroot loc bootstrapper infopropigator _) systemdonly caps = setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly caps `requires` built - built = case buildchroot bootstrapper (chrootSystem c) loc of + built = case buildchroot bootstrapper (containerInfo c) loc of Right p -> p Left e -> cantbuild e -- cgit v1.2.3 From 0ce27912fb2371590e6a1c44f76f51f408d9b79f Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 12 Nov 2019 14:55:42 -0700 Subject: Chroot.debootstrapped: respect chroot's Apt.proxy and Apt.mirror Closes: https://propellor.branchable.com/todo/Debootstrap_module_should_respect_a_configured_Apt.proxy/ Signed-off-by: Sean Whitton --- src/Propellor/Property/Chroot.hs | 26 +++++++++++++++++++++++++- src/Propellor/Property/Debootstrap.hs | 22 ++++++++++++++++++++-- 2 files changed, 45 insertions(+), 3 deletions(-) (limited to 'src/Propellor/Property/Chroot.hs') diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 5be39bd6..ddb7f884 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -26,6 +26,7 @@ import Propellor.Types.Container import Propellor.Types.Info import Propellor.Types.Core import Propellor.Property.Chroot.Util +import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Debootstrap as Debootstrap import qualified Propellor.Property.Systemd.Core as Systemd import qualified Propellor.Property.File as File @@ -102,8 +103,22 @@ instance ChrootBootstrapper Debootstrapped where (Just (System (FreeBSD _) _)) -> Left "FreeBSD not supported by debootstrap." Nothing -> Left "Cannot debootstrap; OS not specified" where - debootstrap s = Debootstrap.built loc s cf + debootstrap s = Debootstrap.built loc s + (cf <> proxyConf <> mirrorConf) system = fromInfoVal (fromInfo info) + -- If the chroot has a configured apt proxy and/or mirror, pass + -- these on to debootstrap. Note that Debootstrap.built does + -- not get passed the Chroot, so the info inspection has to + -- happen here, not there + proxyConf = case (fromInfoVal . fromInfo) info of + Just (Apt.HostAptProxy u) -> + Debootstrap.DebootstrapProxy u + Nothing -> mempty + mirrorConf = case (fromInfoVal . fromInfo) info of + Just (Apt.HostMirror u) -> + Debootstrap.DebootstrapMirror u + Nothing -> mempty + -- | Defines a Chroot at the given location, built with debootstrap. -- @@ -111,6 +126,11 @@ instance ChrootBootstrapper Debootstrapped where -- add a property such as `osDebian` to specify the operating system -- to bootstrap. -- +-- If @conf@ does not include a 'DebootstrapProxy' entry, and the Chroot has a +-- defined 'Apt.proxy', then the Chroot's apt proxy will be used by debootstrap +-- in creating the Chroot, too. Similarly if the @conf@ does not include a +-- 'DebootstrapMirror' and the Chroot has a defined 'Apt.mirror'. +-- -- > debootstrapped Debootstrap.BuildD "/srv/chroot/ghc-dev" $ props -- > & osDebian Unstable X86_64 -- > & Apt.installed ["ghc", "haskell-platform"] @@ -120,6 +140,10 @@ debootstrapped conf = bootstrapped (Debootstrapped conf) -- | Defines a Chroot at the given location, bootstrapped with the -- specified ChrootBootstrapper. +-- +-- Like 'Chroot.debootstrapped', if the ChrootBootstrapper is Debootstrap, this +-- property respects the Chroot's configured Apt.proxy and Apt.mirror, if either +-- exists. bootstrapped :: ChrootBootstrapper b => b -> FilePath -> Props metatypes -> Chroot bootstrapped bootstrapper location ps = c where diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs index 6336e775..adf0879b 100644 --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -32,6 +32,8 @@ data DebootstrapConfig | BuilddD | DebootstrapParam String | UseEmulation + | DebootstrapProxy Url + | DebootstrapMirror Url | DebootstrapConfig :+ DebootstrapConfig deriving (Show) @@ -48,6 +50,8 @@ toParams MinBase = [Param "--variant=minbase"] toParams BuilddD = [Param "--variant=buildd"] toParams (DebootstrapParam p) = [Param p] toParams UseEmulation = [] +toParams (DebootstrapProxy _) = [] +toParams (DebootstrapMirror _) = [] toParams (c1 :+ c2) = toParams c1 <> toParams c2 useEmulation :: DebootstrapConfig -> Bool @@ -55,6 +59,16 @@ useEmulation UseEmulation = True useEmulation (a :+ b) = useEmulation a || useEmulation b useEmulation _ = False +debootstrapProxy :: DebootstrapConfig -> Maybe Url +debootstrapProxy (DebootstrapProxy u) = Just u +debootstrapProxy (a :+ b) = debootstrapProxy a <|> debootstrapProxy b +debootstrapProxy _ = Nothing + +debootstrapMirror :: DebootstrapConfig -> Maybe Url +debootstrapMirror (DebootstrapMirror u) = Just u +debootstrapMirror (a :+ b) = debootstrapMirror a <|> debootstrapMirror b +debootstrapMirror _ = Nothing + -- | Builds a chroot in the given directory using debootstrap. -- -- The System can be any OS and architecture that debootstrap @@ -99,11 +113,15 @@ built' installprop target system@(System _ arch) config = [ Param $ "--arch=" ++ architectureToDebianArchString arch , Param suite , Param target - ] + ] ++ case debootstrapMirror config of + Just u -> [Param u] + Nothing -> [] cmd <- if useEmulation config then pure "qemu-debootstrap" else fromMaybe "debootstrap" <$> programPath - de <- standardPathEnv + de <- case debootstrapProxy config of + Just u -> addEntry "http_proxy" u <$> standardPathEnv + Nothing -> standardPathEnv ifM (boolSystemEnv cmd params (Just de)) ( return MadeChange , return FailedChange -- cgit v1.2.3 From e7e94a8f57dd6a54213cbc1365928110e95f8947 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 12 Nov 2019 14:55:43 -0700 Subject: move Sbuild.useHostProxy -> Chroot.useHostProxy Now that the apt proxy is respected by Chroot.debootstrapped, users will probably want to apply useHostProxy to more chroots than just sbuild schroots. Unfortunately, we can't have a corresponding Chroot.useHostMirror property, because the only sensible way to set the chroot's apt mirror is to use the Apt.mirror pure info property, but we can't ensure properties with info. Suggested-by: Joey Hess Signed-off-by: Sean Whitton --- src/Propellor/Property/Chroot.hs | 16 ++++++++++++++++ src/Propellor/Property/Sbuild.hs | 17 +---------------- 2 files changed, 17 insertions(+), 16 deletions(-) (limited to 'src/Propellor/Property/Chroot.hs') diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index ddb7f884..971fd8ba 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -10,6 +10,7 @@ module Propellor.Property.Chroot ( Debootstrapped(..), ChrootTarball(..), exposeTrueLocaldir, + useHostProxy, -- * Internal use provisioned', propagateChrootInfo, @@ -333,3 +334,18 @@ propagateHostChrootInfo :: Host -> InfoPropagator propagateHostChrootInfo h c pinfo p = propagateContainer (hostName h) c pinfo $ p `setInfoProperty` chrootInfo c + +-- | Ensure that a chroot uses the host's Apt proxy. +-- +-- This property is often used for 'Sbuild.built' chroots, when the host has +-- 'Apt.useLocalCacher'. +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 = fromInfoVal . fromInfo . hostInfo $ h diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 1562f80e..3242014d 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -31,7 +31,7 @@ Suggested usage in @config.hs@: > & osDebian Unstable X86_32 > & Sbuild.osDebianStandard > & Sbuild.update `period` Weekly (Just 1) -> & Sbuild.useHostProxy mybox +> & Chroot.useHostProxy mybox If you are using sbuild older than 0.70.0, you also need: @@ -65,7 +65,6 @@ module Propellor.Property.Sbuild ( built, -- * Properties for use inside sbuild schroots update, - useHostProxy, osDebianStandard, -- * Global sbuild configuration -- blockNetwork, @@ -268,20 +267,6 @@ osDebianStandard = propertyList "standard Debian sbuild properties" $ props 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 typically used when the host has 'Apt.useLocalCacher'. -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 = 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 a7b4aa3dee30b51713ca0a952ab3289a33842074 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Nov 2019 10:25:29 -0400 Subject: minor style tweak I'm not fond of the foo . bar $ v construct, not entirely sure why. --- src/Propellor/Property/Chroot.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property/Chroot.hs') diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 971fd8ba..1a2fd6c8 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -344,8 +344,8 @@ 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 + case getProxyInfo h of Just (Apt.HostAptProxy u) -> ensureProperty w (Apt.proxy' u) Nothing -> noChange where - getProxyInfo = fromInfoVal . fromInfo . hostInfo $ h + getProxyInfo = fromInfoVal . fromInfo . hostInfo -- cgit v1.2.3 From 64cea570e4e82edec6016cbcb1463b3891b094e3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Nov 2019 10:29:38 -0400 Subject: remove horizontal alignment --- src/Propellor/Property/Chroot.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) (limited to 'src/Propellor/Property/Chroot.hs') diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 1a2fd6c8..df5307e4 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -114,12 +114,11 @@ instance ChrootBootstrapper Debootstrapped where proxyConf = case (fromInfoVal . fromInfo) info of Just (Apt.HostAptProxy u) -> Debootstrap.DebootstrapProxy u - Nothing -> mempty + Nothing -> mempty mirrorConf = case (fromInfoVal . fromInfo) info of - Just (Apt.HostMirror u) -> + Just (Apt.HostMirror u) -> Debootstrap.DebootstrapMirror u - Nothing -> mempty - + Nothing -> mempty -- | Defines a Chroot at the given location, built with debootstrap. -- -- cgit v1.2.3 From 89daa9b2e904e3fc6a95b05b792aa9b3d7fca76a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 13 Nov 2019 10:41:03 -0400 Subject: improve haddocks particularly, remove @conf@ reference as that variable name is not visible in the haddock docs unless source is viewed. Also tightened up the language and linkified more, and fixed a typo in the name of Debootstrapped. --- src/Propellor/Property/Chroot.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'src/Propellor/Property/Chroot.hs') diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index df5307e4..13511902 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -126,10 +126,10 @@ instance ChrootBootstrapper Debootstrapped where -- add a property such as `osDebian` to specify the operating system -- to bootstrap. -- --- If @conf@ does not include a 'DebootstrapProxy' entry, and the Chroot has a --- defined 'Apt.proxy', then the Chroot's apt proxy will be used by debootstrap --- in creating the Chroot, too. Similarly if the @conf@ does not include a --- 'DebootstrapMirror' and the Chroot has a defined 'Apt.mirror'. +-- If the 'Debootstrap.DebootstrapConfig' does not include a +-- 'Debootstrap.DebootstrapMirror', +-- any 'Apt.mirror' property of the chroot will configure debootstrap. +-- Same for 'Debootstrap.DebootstrapProxy' and 'Apt.proxy'. -- -- > debootstrapped Debootstrap.BuildD "/srv/chroot/ghc-dev" $ props -- > & osDebian Unstable X86_64 @@ -141,9 +141,9 @@ debootstrapped conf = bootstrapped (Debootstrapped conf) -- | Defines a Chroot at the given location, bootstrapped with the -- specified ChrootBootstrapper. -- --- Like 'Chroot.debootstrapped', if the ChrootBootstrapper is Debootstrap, this --- property respects the Chroot's configured Apt.proxy and Apt.mirror, if either --- exists. +-- Like 'Chroot.debootstrapped', if the 'ChrootBootstrapper' is +-- 'Debootstrapped', this property respects the Chroot's +-- 'Apt.proxy' and 'Apt.mirror' properties. bootstrapped :: ChrootBootstrapper b => b -> FilePath -> Props metatypes -> Chroot bootstrapped bootstrapper location ps = c where -- cgit v1.2.3