summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorSean Whitton2016-05-16 14:59:13 -0700
committerSean Whitton2016-05-16 14:59:13 -0700
commitf3379036df361e01b8aea50f26a628b921593d91 (patch)
tree41c01dbd5388d4d1d39dccf7d196de885147150e /src
parentadc5f3806eacc7a5e5fb409bd1e9da564d8cb5de (diff)
write some sbuild props
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Property/Sbuild.hs76
1 files changed, 72 insertions, 4 deletions
diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs
index 80687c7c..58e56239 100644
--- a/src/Propellor/Property/Sbuild.hs
+++ b/src/Propellor/Property/Sbuild.hs
@@ -35,25 +35,93 @@ sbuild environment as standardised as possible.
-}
-- If you wanted to do it with Propellor.Property.Debootstrap, note that
--- sbuild-createchroot has a relevant option: --setup-only
+-- sbuild-createchroot has a --setup-only option
+-- TODO export useful properties only
module Propellor.Property.Sbuild where
import Propellor.Base
+import Debootstrap (extractSuite)
import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.File as File
+
+import System.Directory
+
+schrootChrootD :: FilePath
+schrootChrootD = "/etc/schroot/chroot.d"
+
+-- | Build and configure a schroot for use with sbuild
+built :: System -> Property DebianLike
+built system@(System distro arch) =
+ property' ("built chroot for " ++ show system) $ liftIO $ do
+ suite <- case extractSuite system of
+ Just s -> return s
+ Nothing -> errorMessage $
+ "don't know how to debootstrap " ++ show system
+ de <- standardPathEnv
+ let params = Param <$>
+ [ "--arch=" ++ arch
+ -- We pass --chroot-suffix in order that we can find the
+ -- config file despite the random suffix that
+ -- sbuild-createchroot gives it. We'll change this back
+ -- to 'sbuild' once debootstrap has finished.
+ , "--chroot-suffix=propellor"
+ , "/srv/chroot/" ++ suite ++ "-" ++ arch
+ , stdMirror distro
+ ]
+ ifM (boolSystemEnv "sbuild-createchroot" params (Just de))
+ ( do
+ fixConfFile suite arch
+ return MadeChange
+ , return FailedChange
+ )
+
+fixConfFile :: String -> Architecture -> IO ()
+fixConfFile suite arch = do
+ confs <- dirContents schrootChrootD
+ let conf = filter (schrootChrootD
+ </> suite ++ "-" ++ arch ++ "-propellor-" `isPrefixOf`)
+ confs
+ ensureProperty $ File.fileProperty "replace dummy suffix" (map munge) conf
+ moveFile conf $
+ schrootChrootD </> suite ++ "-" ++ arch ++ "-sbuild-propellor"
+ where
+ munge = replace "-propellor]" "-sbuild]"
+
+stdMirror :: System -> Apt.Url
+stdMirror (System (Debian s) _) = "http://httpredir.debian.org/debian"
+stdMirror (System (Buntish r) _) = "TODO"
-- | Update a schroot's installed packages and apt indexes.
-updated :: System -> Architecture -> Property DebianLike
+updated :: System -> Property DebianLike
updated = undefined
-- TODO autoclean/clean only if shareAptCache property not present
-- | Bind-mount @/var/cache/apt/archives@ in all sbuild chroots so that the host
--- system and the chroot share the apt cache.
+-- system and the chroot share the apt cache
--
-- This speeds up builds by avoiding unnecessary downloads of build
-- dependencies.
shareAptCache :: Property DebianLike
-shareAptCache = undefined
+shareAptCache = File.containsLine "/etc/schroot/sbuild/fstab"
+ "/var/cache/apt/archives /var/cache/apt/archives none rw,bind 0 0"
+ `requires` installed
+-- | Ensure that sbuild is installed
installed :: Property DebianLike
installed = Apt.installed ["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
+
+-- | Generate the apt keys needed by sbuild
+keypairGenerated :: Property DebianLike
+keypairGenerated =
+ check (not <$> doesFileExist secKeyFile) $ go
+ `requires` installed
+ where
+ go :: Property DebianLike
+ go = tightenTargets $
+ cmdProperty "sbuild-update" ["--keygen"] `assume` MadeChange
+ secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec"