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') 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