Merge remote-tracking branch 'spwhitton/apt-cacher-ng'

2 files changed, 74 insertions, 101 deletions

diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs
index 686ddb6c..5630d83a 100644
--- a/src/Propellor/Property/Apt.hs
+++ b/src/Propellor/Property/Apt.hs
@@ -20,7 +20,10 @@ import Propellor.Types.Info
 data HostMirror = HostMirror Url
 	deriving (Eq, Show, Typeable)
 
--- | Indicate host's preferred apt mirror (e.g. an apt cacher on the host's LAN)
+data HostAptProxy = HostAptProxy Url
+	deriving (Eq, Show, Typeable)
+
+-- | Indicate host's preferred apt mirror
 mirror :: Url -> Property (HasInfo + UnixLike)
 mirror u = pureInfoProperty (u ++ " apt mirror selected")
 	     (InfoVal (HostMirror u))
@@ -493,3 +496,19 @@ suitePinBlock p suite pin =
 
 dpkgStatus :: FilePath
 dpkgStatus = "/var/lib/dpkg/status"
+
+-- | Set apt's proxy
+proxy :: Url -> Property (HasInfo + DebianLike)
+proxy u = tightenTargets $
+	proxyInfo `before` proxyConfig `describe` desc
+  where
+	proxyInfo = pureInfoProperty desc (InfoVal (HostAptProxy u))
+	proxyConfig = "/etc/apt/apt.conf.d/20proxy" `File.hasContent`
+		[ "Acquire::HTTP::Proxy \"" ++ u ++ "\";" ]
+	desc = (u ++ " apt proxy selected")
+
+-- | Cause apt to proxy downloads via an apt cacher on localhost
+useLocalCacher :: Property (HasInfo + DebianLike)
+useLocalCacher = proxy "http://localhost:3142"
+	`requires` serviceInstalledRunning "apt-cacher-ng"
+	`describe` "apt uses local apt cacher"
diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs
index 460d0b16..8d1b9807 100644
--- a/src/Propellor/Property/Sbuild.hs
+++ b/src/Propellor/Property/Sbuild.hs
@@ -20,12 +20,10 @@ Debian stretch, which older sbuild can't handle.
 
 Suggested usage in @config.hs@:
 
->  & Apt.installed ["piuparts", "autopkgtest"]
+>  & Apt.installed ["piuparts", "autopkgtest", "lintian"]
 >  & Sbuild.builtFor (System (Debian Linux Unstable) X86_32) Sbuild.UseCcache
->  & Sbuild.piupartsConfFor (System (Debian Linux Unstable) X86_32)
 >  & Sbuild.updatedFor (System (Debian Linux Unstable) X86_32) `period` Weekly 1
 >  & Sbuild.usableBy (User "spwhitton")
->  & Sbuild.shareAptCache
 >  & Schroot.overlaysInTmpfs
 
 If you are using sbuild older than 0.70.0, you also need:
@@ -36,8 +34,9 @@ In @~/.sbuildrc@ (sbuild 0.71.0 or newer):
 
 >  $run_piuparts = 1;
 >  $piuparts_opts = [
+>      '--no-eatmydata',
 >      '--schroot',
->      '%r-%a-piuparts',
+>      '%r-%a-sbuild',
 >      '--fail-if-inadequate',
 >      '--fail-on-broken-symlinks',
 >      ];
@@ -53,9 +52,9 @@ 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 an apt
-cacher.  In that case you can do something like this in @config.hs@:
+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
@@ -74,20 +73,18 @@ module Propellor.Property.Sbuild (
 	UseCcache(..),
 	built,
 	updated,
-	piupartsConf,
 	builtFor,
 	updatedFor,
-	piupartsConfFor,
 	-- * Global sbuild configuration
 	-- blockNetwork,
 	installed,
 	keypairGenerated,
 	keypairInsecurelyGenerated,
-	shareAptCache,
 	usableBy,
 ) 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
@@ -147,7 +144,8 @@ built s@(SbuildSchroot suite arch) mirror cc =
 	((go `before` enhancedConf)
 	`requires` ccacheMaybePrepared cc
 	`requires` installed
-	`requires` overlaysKernel)
+	`requires` overlaysKernel
+	`requires` cleanupOldConfig)
 	<!> deleted
   where
 	go :: Property DebianLike
@@ -180,6 +178,8 @@ built s@(SbuildSchroot suite arch) mirror cc =
 	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"
@@ -187,6 +187,31 @@ built s@(SbuildSchroot suite arch) mirror cc =
 				, 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.
@@ -218,6 +243,21 @@ built s@(SbuildSchroot suite arch) mirror cc =
 				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"))
@@ -299,92 +339,6 @@ fixConfFile s@(SbuildSchroot suite arch) =
 	tempPrefix = dir </> suite ++ "-" ++ architectureToDebianArchString arch ++ "-propellor-"
 	munge = replace "-propellor]" "-sbuild]"
 
--- | Create a corresponding schroot config file for use with piuparts
---
--- This function is a convenience wrapper around 'piupartsConf', allowing the
--- user to identify the schroot using the 'System' type.  See that function's
--- documentation for why you might want to use this property, and sample config.
-piupartsConfFor :: System -> Property DebianLike
-piupartsConfFor sys = property' ("piuparts schroot conf for " ++ show sys) $
-	\w -> case schrootFromSystem sys of
-			Just s -> ensureProperty w $ piupartsConf s
-			_ -> errorMessage
-				("don't know how to debootstrap " ++ show sys)
-
--- | Create a corresponding schroot config file for use with piuparts
---
--- This is useful because:
---
--- - piuparts will clear out the apt cache which makes 'shareAptCache' much less
---   useful
---
--- - piuparts itself invokes eatmydata, so the command-prefix setting in our
---   regular schroot config would force the user to pass @--no-eatmydata@ to
---   piuparts in their @~/.sbuildrc@, which is inconvenient.
---
--- To make use of this new schroot config, you can put something like this in
--- your ~/.sbuildrc (sbuild 0.71.0 or newer):
---
---  >  $run_piuparts = 1;
---  >  $piuparts_opts = [
---  >      '--schroot',
---  >      '%r-%a-piuparts',
---  >      '--fail-if-inadequate',
---  >      '--fail-on-broken-symlinks',
---  >      ];
---
--- This property has no effect if the corresponding sbuild schroot does not
--- exist (i.e. you also need 'Sbuild.built' or 'Sbuild.builtFor').
-piupartsConf :: SbuildSchroot -> Property DebianLike
-piupartsConf s@(SbuildSchroot _ arch) =
-	check (doesFileExist (schrootConf s)) go
-	`requires` installed
-  where
-	go :: Property DebianLike
-	go = property' desc $ \w -> do
-		aliases <- aliasesLine
-		ensureProperty w $ combineProperties desc $ props
-			& check (not <$> doesFileExist f)
-				(File.basedOn f (schrootConf s, map munge))
-			& ConfFile.containsIniSetting f
-				(sec, "profile", "piuparts")
-			& ConfFile.containsIniSetting f
-				(sec, "aliases", aliases)
-			& ConfFile.containsIniSetting f
-				(sec, "command-prefix", "")
-			& File.dirExists dir
-			& File.isSymlinkedTo (dir </> "copyfiles")
-				(File.LinkTarget $ orig </> "copyfiles")
-			& File.isSymlinkedTo (dir </> "nssdatabases")
-				(File.LinkTarget $ orig </> "nssdatabases")
-			& File.basedOn (dir </> "fstab")
-				(orig </> "fstab", filter (/= aptCacheLine))
-
-	orig = "/etc/schroot/sbuild"
-	dir = "/etc/schroot/piuparts"
-	sec = val s ++ "-piuparts"
-	f = schrootPiupartsConf s
-	munge = replace "-sbuild]" "-piuparts]"
-	desc = "piuparts schroot conf for " ++ val s
-
-	-- normally the piuparts schroot conf has no aliases, but we have to add
-	-- one, for dgit compatibility, if this is the default sid chroot
-	aliasesLine = sidHostArchSchroot s >>= \isSidHostArchSchroot ->
-			return $ if isSidHostArchSchroot
-			then "UNRELEASED-"
-				++ architectureToDebianArchString arch
-				++ "-piuparts"
-			else ""
-
--- | Bind-mount /var/cache/apt/archives in all sbuild chroots so that the host
--- system and the chroot share the apt cache
---
--- This speeds up builds by avoiding unnecessary downloads of build
--- dependencies.
-shareAptCache :: Property DebianLike
-shareAptCache = File.containsLine "/etc/schroot/sbuild/fstab" aptCacheLine
-	`requires` installed
-	`describe` "sbuild schroots share host apt cache"
 
 aptCacheLine :: String
 aptCacheLine = "/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0"
@@ -523,7 +477,7 @@ schrootPiupartsConf (SbuildSchroot s a) =
 sidHostArchSchroot :: SbuildSchroot -> Propellor Bool
 sidHostArchSchroot (SbuildSchroot suite arch) = do
 	maybeOS <- getOS
-	case maybeOS of
-		Nothing -> return False
+	return $ case maybeOS of
+		Nothing -> False
 		Just (System _ hostArch) ->
-			return $ suite == "unstable" && hostArch == arch
+			suite == "unstable" && hostArch == arch