module Propellor.Property.Sbuild (
SbuildSchroot(..),
UseCcache(..),
built,
updated,
piupartsConf,
builtFor,
updatedFor,
piupartsConfFor,
installed,
keypairGenerated,
keypairInsecurelyGenerated,
shareAptCache,
usableBy,
) where
import Propellor.Base
import Propellor.Property.Debootstrap (extractSuite)
import Propellor.Property.Chroot.Util
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Ccache as Ccache
import qualified Propellor.Property.ConfFile as ConfFile
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Schroot as Schroot
import qualified Propellor.Property.Reboot as Reboot
import qualified Propellor.Property.User as User
import Utility.FileMode
import Data.List
import Data.List.Utils
type Suite = String
data SbuildSchroot = SbuildSchroot Suite Architecture
instance ConfigurableValue SbuildSchroot where
val (SbuildSchroot suite arch) = suite ++ "-" ++ architectureToDebianArchString arch
data UseCcache = UseCcache | NoCcache
builtFor :: System -> UseCcache -> RevertableProperty DebianLike UnixLike
builtFor sys cc = go <!> deleted
where
go = property' ("sbuild schroot for " ++ show sys) $
\w -> case (schrootFromSystem sys, stdMirror sys) of
(Just s, Just u) -> ensureProperty w $
setupRevertableProperty $ built s u cc
_ -> errorMessage
("don't know how to debootstrap " ++ show sys)
deleted = property' ("no sbuild schroot for " ++ show sys) $
\w -> case schrootFromSystem sys of
Just s -> ensureProperty w $
undoRevertableProperty $ built s "dummy" cc
Nothing -> noChange
built :: SbuildSchroot -> Apt.Url -> UseCcache -> RevertableProperty DebianLike UnixLike
built s@(SbuildSchroot suite arch) mirror cc =
((go `before` enhancedConf)
`requires` ccacheMaybePrepared cc
`requires` installed
`requires` overlaysKernel)
<!> deleted
where
go :: Property DebianLike
go = check (unpopulated (schrootRoot s) <||> ispartial) $
property' ("built sbuild schroot for " ++ val s) make
make w = do
de <- liftIO standardPathEnv
let params = Param <$>
[ "--arch=" ++ architectureToDebianArchString arch
, "--chroot-suffix=-propellor"
, "--include=eatmydata,ccache"
, suite
, schrootRoot s
, mirror
]
ifM (liftIO $
boolSystemEnv "sbuild-createchroot" params (Just de))
( ensureProperty w $ fixConfFile s
, return FailedChange
)
deleted = check (not <$> unpopulated (schrootRoot s)) $
property ("no sbuild schroot for " ++ val s) $ do
liftIO $ removeChroot $ schrootRoot s
liftIO $ nukeFile
("/etc/sbuild/chroot" </> val s ++ "-sbuild")
makeChange $ nukeFile (schrootConf s)
enhancedConf =
combineProperties ("enhanced schroot conf for " ++ val s) $ props
& aliasesLine
& ConfFile.containsIniSetting (schrootConf s)
( val s ++ "-sbuild"
, "command-prefix"
, intercalate "," commandPrefix
)
aliasesLine :: Property UnixLike
aliasesLine = property' "maybe set aliases line" $ \w ->
sidHostArchSchroot s >>= \isSidHostArchSchroot ->
if isSidHostArchSchroot
then ensureProperty w $
ConfFile.containsIniSetting
(schrootConf s)
( val s ++ "-sbuild"
, "aliases"
, aliases
)
else return NoChange
overlaysKernel :: Property DebianLike
overlaysKernel = property' "reboot for union-type=overlay" $ \w ->
Schroot.usesOverlays >>= \usesOverlays ->
if usesOverlays
then ensureProperty w $
Reboot.toKernelNewerThan "3.18"
else noChange
ispartial = ifM (doesDirectoryExist (schrootRoot s </> "debootstrap"))
( do
removeChroot $ schrootRoot s
return True
, return False
)
aliases = intercalate ","
[ "sid"
, "rc-buggy"
, "experimental"
, "UNRELEASED"
, "UNRELEASED-"
++ architectureToDebianArchString arch
++ "-sbuild"
]
commandPrefix = case cc of
UseCcache -> "/var/cache/ccache-sbuild/sbuild-setup":base
_ -> base
where
base = ["eatmydata"]
updatedFor :: System -> Property DebianLike
updatedFor system = property' ("updated sbuild schroot for " ++ show system) $
\w -> case schrootFromSystem system of
Just s -> ensureProperty w $ updated s
Nothing -> errorMessage
("don't know how to debootstrap " ++ show system)
updated :: SbuildSchroot -> Property DebianLike
updated s@(SbuildSchroot suite arch) =
check (doesDirectoryExist (schrootRoot s)) $ go
`describe` ("updated schroot for " ++ val s)
`requires` installed
where
go :: Property DebianLike
go = tightenTargets $ cmdProperty
"sbuild-update" ["-udr", suite ++ "-" ++ architectureToDebianArchString arch]
`assume` MadeChange
fixConfFile :: SbuildSchroot -> Property UnixLike
fixConfFile s@(SbuildSchroot suite arch) =
property' ("schroot for " ++ val s ++ " config file fixed") $ \w -> do
confs <- liftIO $ dirContents dir
let old = concat $ filter (tempPrefix `isPrefixOf`) confs
liftIO $ moveFile old new
liftIO $ moveFile
("/etc/sbuild/chroot" </> val s ++ "-propellor")
("/etc/sbuild/chroot" </> val s ++ "-sbuild")
ensureProperty w $
File.fileProperty "replace dummy suffix" (map munge) new
where
new = schrootConf s
dir = takeDirectory new
tempPrefix = dir </> suite ++ "-" ++ architectureToDebianArchString arch ++ "-propellor-"
munge = replace "-propellor]" "-sbuild]"
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)
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
aliasesLine = sidHostArchSchroot s >>= \isSidHostArchSchroot ->
return $ if isSidHostArchSchroot
then "UNRELEASED-"
++ architectureToDebianArchString arch
++ "-piuparts"
else ""
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"
installed :: Property DebianLike
installed = Apt.installed ["sbuild"]
usableBy :: User -> Property DebianLike
usableBy u = User.hasGroup u (Group "sbuild") `requires` installed
keypairGenerated :: Property DebianLike
keypairGenerated = check (not <$> doesFileExist secKeyFile) $ go
`requires` installed
`requires` File.dirExists "/root/.gnupg"
where
go :: Property DebianLike
go = tightenTargets $
cmdProperty "sbuild-update" ["--keygen"]
`assume` MadeChange
secKeyFile :: FilePath
secKeyFile = "/var/lib/sbuild/apt-keys/sbuild-key.sec"
keypairInsecurelyGenerated :: Property DebianLike
keypairInsecurelyGenerated = check (not <$> doesFileExist secKeyFile) go
where
go :: Property DebianLike
go = combineProperties "sbuild keyring insecurely generated" $ props
& Apt.installed ["rng-tools"]
& File.dirExists "/var/lib/sbuild/apt-keys"
& userScriptProperty (User "root")
[ "start-stop-daemon -q -K -R 10 -o -n rngd"
, "rngd -r /dev/urandom"
]
`assume` MadeChange
& keypairGenerated
& userScriptProperty (User "root")
["kill $(cat /var/run/rngd.pid)"]
`assume` MadeChange
ccacheMaybePrepared :: UseCcache -> Property DebianLike
ccacheMaybePrepared cc = case cc of
UseCcache -> ccachePrepared
NoCcache -> doNothing
ccachePrepared :: Property DebianLike
ccachePrepared = propertyList "sbuild group ccache configured" $ props
& check (not <$> doesDirectoryExist "/var/cache/ccache-sbuild")
(Ccache.hasLimits "/var/cache/ccache-sbuild" (Ccache.MaxSize "2G"))
`before` Ccache.hasCache (Group "sbuild") Ccache.NoLimit
& "/etc/schroot/sbuild/fstab" `File.containsLine`
"/var/cache/ccache-sbuild /var/cache/ccache-sbuild none rw,bind 0 0"
`describe` "ccache mounted in sbuild schroots"
& "/var/cache/ccache-sbuild/sbuild-setup" `File.hasContent`
[ "#!/bin/sh"
, ""
, "export CCACHE_DIR=/var/cache/ccache-sbuild"
, "export CCACHE_UMASK=002"
, "export CCACHE_COMPRESS=1"
, "unset CCACHE_HARDLINK"
, "export PATH=\"/usr/lib/ccache:$PATH\""
, ""
, "exec \"$@\""
]
& File.mode "/var/cache/ccache-sbuild/sbuild-setup"
(combineModes (readModes ++ executeModes))
schrootFromSystem :: System -> Maybe SbuildSchroot
schrootFromSystem system@(System _ arch) =
extractSuite system
>>= \suite -> return $ SbuildSchroot suite arch
stdMirror :: System -> Maybe Apt.Url
stdMirror (System (Debian _ _) _) = Just "http://deb.debian.org/debian"
stdMirror (System (Buntish _) _) = Just "mirror://mirrors.ubuntu.com/"
stdMirror _ = Nothing
schrootRoot :: SbuildSchroot -> FilePath
schrootRoot (SbuildSchroot s a) = "/srv/chroot" </> s ++ "-" ++ architectureToDebianArchString a
schrootConf :: SbuildSchroot -> FilePath
schrootConf (SbuildSchroot s a) =
"/etc/schroot/chroot.d" </> s ++ "-" ++ architectureToDebianArchString a ++ "-sbuild-propellor"
schrootPiupartsConf :: SbuildSchroot -> FilePath
schrootPiupartsConf (SbuildSchroot s a) =
"/etc/schroot/chroot.d" </> s ++ "-" ++ architectureToDebianArchString a ++ "-piuparts-propellor"
sidHostArchSchroot :: SbuildSchroot -> Propellor Bool
sidHostArchSchroot (SbuildSchroot suite arch) = do
maybeOS <- getOS
case maybeOS of
Nothing -> return False
Just (System _ hostArch) ->
return $ suite == "unstable" && hostArch == arch