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/Debootstrap.hs | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Property/Debootstrap.hs') 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