packages feed

propellor 3.0.4 → 3.0.5

raw patch · 11 files changed

+606/−2 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Propellor.Property.Chroot: Chroot :: FilePath -> b -> Host -> Chroot
- Propellor.Types: instance forall (k :: BOX) (k1 :: BOX) (x :: [k]) (x' :: [k1]) (y :: [k]) (y' :: [k1]). (Propellor.Types.MetaTypes.CheckCombinable x y ~ 'Propellor.Types.MetaTypes.CanCombine, Propellor.Types.MetaTypes.CheckCombinable x' y' ~ 'Propellor.Types.MetaTypes.CanCombine, Propellor.Types.Singletons.SingI (Propellor.Types.MetaTypes.Combine x y), Propellor.Types.Singletons.SingI (Propellor.Types.MetaTypes.Combine x' y')) => Propellor.Types.Combines (Propellor.Types.RevertableProperty (Propellor.Types.MetaTypes.MetaTypes x) (Propellor.Types.MetaTypes.MetaTypes x')) (Propellor.Types.RevertableProperty (Propellor.Types.MetaTypes.MetaTypes y) (Propellor.Types.MetaTypes.MetaTypes y'))
- Propellor.Types: instance forall (k :: BOX) (k1 :: BOX) (x :: [k]) (x' :: k1) (y :: [k]). (Propellor.Types.MetaTypes.CheckCombinable x y ~ 'Propellor.Types.MetaTypes.CanCombine, Propellor.Types.Singletons.SingI (Propellor.Types.MetaTypes.Combine x y)) => Propellor.Types.Combines (Propellor.Types.RevertableProperty (Propellor.Types.MetaTypes.MetaTypes x) (Propellor.Types.MetaTypes.MetaTypes x')) (Propellor.Types.Property (Propellor.Types.MetaTypes.MetaTypes y))
- Propellor.Types: instance forall (k :: BOX) (k1 :: BOX) (x :: [k]) (y :: [k]) (y' :: k1). (Propellor.Types.MetaTypes.CheckCombinable x y ~ 'Propellor.Types.MetaTypes.CanCombine, Propellor.Types.Singletons.SingI (Propellor.Types.MetaTypes.Combine x y)) => Propellor.Types.Combines (Propellor.Types.Property (Propellor.Types.MetaTypes.MetaTypes x)) (Propellor.Types.RevertableProperty (Propellor.Types.MetaTypes.MetaTypes y) (Propellor.Types.MetaTypes.MetaTypes y'))
- Propellor.Types: instance forall (k :: BOX) (x :: [k]) (y :: [k]). (Propellor.Types.MetaTypes.CheckCombinable x y ~ 'Propellor.Types.MetaTypes.CanCombine, Propellor.Types.Singletons.SingI (Propellor.Types.MetaTypes.Combine x y)) => Propellor.Types.Combines (Propellor.Types.Property (Propellor.Types.MetaTypes.MetaTypes x)) (Propellor.Types.Property (Propellor.Types.MetaTypes.MetaTypes y))
- Propellor.Types.Singletons: instance forall (k :: BOX) (x :: k) (xs :: [k]). (Propellor.Types.Singletons.SingI x, Propellor.Types.Singletons.SingI xs) => Propellor.Types.Singletons.SingI (x : xs)
+ Propellor: infixl 1 !
+ Propellor.PropAccum: infixl 1 !
+ Propellor.Property: infixl 1 ==>
+ Propellor.Property.Ccache: (:+) :: Limit -> Limit -> Limit
+ Propellor.Property.Ccache: MaxFiles :: Integer -> Limit
+ Propellor.Property.Ccache: MaxSize :: DataSize -> Limit
+ Propellor.Property.Ccache: NoLimit :: Limit
+ Propellor.Property.Ccache: data Limit
+ Propellor.Property.Ccache: hasCache :: Group -> Limit -> RevertableProperty DebianLike UnixLike
+ Propellor.Property.Ccache: hasLimits :: FilePath -> Limit -> Property DebianLike
+ Propellor.Property.Ccache: instance GHC.Base.Monoid Propellor.Property.Ccache.Limit
+ Propellor.Property.Ccache: type DataSize = String
+ Propellor.Property.Chroot: [Chroot] :: ChrootBootstrapper b => FilePath -> b -> Host -> Chroot
+ Propellor.Property.Debootstrap: extractSuite :: System -> Maybe String
+ Propellor.Property.Firewall: GroupOwner :: Group -> Rules
+ Propellor.Property.Firewall: NotDestination :: [IPWithMask] -> Rules
+ Propellor.Property.Sbuild: SbuildSchroot :: Suite -> Architecture -> SbuildSchroot
+ Propellor.Property.Sbuild: built :: SbuildSchroot -> Url -> RevertableProperty DebianLike UnixLike
+ Propellor.Property.Sbuild: builtFor :: System -> RevertableProperty DebianLike UnixLike
+ Propellor.Property.Sbuild: data SbuildSchroot
+ Propellor.Property.Sbuild: installed :: Property DebianLike
+ Propellor.Property.Sbuild: instance GHC.Show.Show Propellor.Property.Sbuild.SbuildSchroot
+ Propellor.Property.Sbuild: keypairGenerated :: Property DebianLike
+ Propellor.Property.Sbuild: piupartsConf :: SbuildSchroot -> Url -> Property DebianLike
+ Propellor.Property.Sbuild: piupartsConfFor :: System -> Property DebianLike
+ Propellor.Property.Sbuild: shareAptCache :: Property DebianLike
+ Propellor.Property.Sbuild: updated :: SbuildSchroot -> Property DebianLike
+ Propellor.Property.Sbuild: updatedFor :: System -> Property DebianLike
+ Propellor.Property.Sbuild: usableBy :: User -> Property DebianLike
+ Propellor.Property.Schroot: installed :: Property DebianLike
+ Propellor.Property.Schroot: overlaysInTmpfs :: Property DebianLike
+ Propellor.Property.Systemd: killUserProcesses :: RevertableProperty Linux Linux
+ Propellor.Property.Systemd: logind :: ServiceName
+ Propellor.Property.Systemd: logindConfigured :: Option -> String -> Property Linux
+ Propellor.Types: instance forall a (x :: [a]) (y :: [a]). (Propellor.Types.MetaTypes.CheckCombinable x y ~ 'Propellor.Types.MetaTypes.CanCombine, Propellor.Types.Singletons.SingI (Propellor.Types.MetaTypes.Combine x y)) => Propellor.Types.Combines (Propellor.Types.Property (Propellor.Types.MetaTypes.MetaTypes x)) (Propellor.Types.Property (Propellor.Types.MetaTypes.MetaTypes y))
+ Propellor.Types: instance forall a a1 (x :: [a]) (y :: [a]) (x' :: [a1]) (y' :: [a1]). (Propellor.Types.MetaTypes.CheckCombinable x y ~ 'Propellor.Types.MetaTypes.CanCombine, Propellor.Types.MetaTypes.CheckCombinable x' y' ~ 'Propellor.Types.MetaTypes.CanCombine, Propellor.Types.Singletons.SingI (Propellor.Types.MetaTypes.Combine x y), Propellor.Types.Singletons.SingI (Propellor.Types.MetaTypes.Combine x' y')) => Propellor.Types.Combines (Propellor.Types.RevertableProperty (Propellor.Types.MetaTypes.MetaTypes x) (Propellor.Types.MetaTypes.MetaTypes x')) (Propellor.Types.RevertableProperty (Propellor.Types.MetaTypes.MetaTypes y) (Propellor.Types.MetaTypes.MetaTypes y'))
+ Propellor.Types: instance forall a k (x :: [a]) (y :: [a]) (x' :: k). (Propellor.Types.MetaTypes.CheckCombinable x y ~ 'Propellor.Types.MetaTypes.CanCombine, Propellor.Types.Singletons.SingI (Propellor.Types.MetaTypes.Combine x y)) => Propellor.Types.Combines (Propellor.Types.RevertableProperty (Propellor.Types.MetaTypes.MetaTypes x) (Propellor.Types.MetaTypes.MetaTypes x')) (Propellor.Types.Property (Propellor.Types.MetaTypes.MetaTypes y))
+ Propellor.Types: instance forall a k (x :: [a]) (y :: [a]) (y' :: k). (Propellor.Types.MetaTypes.CheckCombinable x y ~ 'Propellor.Types.MetaTypes.CanCombine, Propellor.Types.Singletons.SingI (Propellor.Types.MetaTypes.Combine x y)) => Propellor.Types.Combines (Propellor.Types.Property (Propellor.Types.MetaTypes.MetaTypes x)) (Propellor.Types.RevertableProperty (Propellor.Types.MetaTypes.MetaTypes y) (Propellor.Types.MetaTypes.MetaTypes y'))
+ Propellor.Types.Singletons: instance forall a (x :: a) (xs :: [a]). (Propellor.Types.Singletons.SingI x, Propellor.Types.Singletons.SingI xs) => Propellor.Types.Singletons.SingI (x : xs)
+ Propellor.Types.Singletons: type family DemoteRep kparam :: *;
+ Propellor.Types.Singletons: }
+ Propellor.Utilities: [child_group] :: CreateProcess -> Maybe GroupID
+ Propellor.Utilities: [child_user] :: CreateProcess -> Maybe UserID
+ Propellor.Utilities: [create_new_console] :: CreateProcess -> Bool
+ Propellor.Utilities: [detach_console] :: CreateProcess -> Bool
+ Propellor.Utilities: [new_session] :: CreateProcess -> Bool
+ Propellor.Utilities: infixr 2 <||>
+ Propellor.Utilities: infixr 3 <&&>
- Propellor.Types.Info: class Typeable (a :: k)
+ Propellor.Types.Info: class Typeable k (a :: k)
- Propellor.Types.Singletons: class (kparam ~ KProxy) => SingKind (kparam :: KProxy k) where type family DemoteRep kparam :: *
+ Propellor.Types.Singletons: class (kparam ~ KProxy) => SingKind (kparam :: KProxy k) where type DemoteRep kparam :: * where {
- Propellor.Utilities: CreateProcess :: CmdSpec -> Maybe FilePath -> Maybe [(String, String)] -> StdStream -> StdStream -> StdStream -> Bool -> Bool -> Bool -> CreateProcess
+ Propellor.Utilities: CreateProcess :: CmdSpec -> Maybe FilePath -> Maybe [(String, String)] -> StdStream -> StdStream -> StdStream -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Maybe GroupID -> Maybe UserID -> CreateProcess

Files

CHANGELOG view
@@ -1,3 +1,14 @@+propellor (3.0.5) unstable; urgency=medium++  * Modules added for Sbuild and Ccache.+    Thanks, Sean Whitton+  * Systemd: Added killUserProcesses property, which can be reverted+    to return systemd to its default behavior before version 230 started+    killing processes like screen sessions.+  * Systemd: Added logindConfigured property.++ -- Joey Hess <id@joeyh.name>  Mon, 06 Jun 2016 17:13:21 -0400+ propellor (3.0.4) unstable; urgency=medium    * Run letsencrypt with --noninteractive.
debian/changelog view
@@ -1,3 +1,14 @@+propellor (3.0.5) unstable; urgency=medium++  * Modules added for Sbuild and Ccache.+    Thanks, Sean Whitton+  * Systemd: Added killUserProcesses property, which can be reverted+    to return systemd to its default behavior before version 230 started+    killing processes like screen sessions.+  * Systemd: Added logindConfigured property.++ -- Joey Hess <id@joeyh.name>  Mon, 06 Jun 2016 17:13:21 -0400+ propellor (3.0.4) unstable; urgency=medium    * Run letsencrypt with --noninteractive.
joeyconfig.hs view
@@ -564,6 +564,9 @@ 	-- I use postfix, or no MTA. 	& Apt.removed ["exim4", "exim4-daemon-light", "exim4-config", "exim4-base"] 		`onChange` Apt.autoRemove+	-- At least until system integration catches up, revert+	-- systemd 230's behavior of enabling this property by default.+	! Systemd.killUserProcesses  -- This is my standard container setup, Featuring automatic upgrades. standardContainer :: DebianSuite -> Property (HasInfo + Debian)
propellor.cabal view
@@ -1,5 +1,5 @@ Name: propellor-Version: 3.0.4+Version: 3.0.5 Cabal-Version: >= 1.8 License: BSD2 Maintainer: Joey Hess <id@joeyh.name>@@ -82,6 +82,7 @@     Propellor.Property.Apt.PPA     Propellor.Property.Attic     Propellor.Property.Borg+    Propellor.Property.Ccache     Propellor.Property.Cmd     Propellor.Property.Concurrent     Propellor.Property.Conductor@@ -127,7 +128,9 @@     Propellor.Property.Prosody     Propellor.Property.Reboot     Propellor.Property.Rsync+    Propellor.Property.Sbuild     Propellor.Property.Scheduled+    Propellor.Property.Schroot     Propellor.Property.Service     Propellor.Property.Ssh     Propellor.Property.Sudo
src/Propellor/EnsureProperty.hs view
@@ -24,7 +24,7 @@ -- Use `property'` to get the `OuterMetaTypesWithness`. For example: -- -- > foo = Property Debian--- > foo = property' $ \w -> do+-- > foo = property' "my property" $ \w -> do -- > 	ensureProperty w (aptInstall "foo") -- -- The type checker will prevent using ensureProperty with a property
+ src/Propellor/Property/Ccache.hs view
@@ -0,0 +1,110 @@+-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>++module Propellor.Property.Ccache (+	hasCache,+	hasLimits,+	Limit(..),+	DataSize,+) where++import Propellor.Base+import qualified Propellor.Property.File as File+import qualified Propellor.Property.Apt as Apt++import Utility.FileMode+import Utility.DataUnits+import System.Posix.Files++-- | Limits on the size of a ccache+data Limit+	-- | The maximum size of the cache, as a string such as "4G"+	= MaxSize DataSize+	-- | The maximum number of files in the cache+	| MaxFiles Integer+	-- | A cache with no limit specified+	| NoLimit+	| Limit :+ Limit++instance Monoid Limit where+	mempty  = NoLimit+	mappend = (:+)++-- | A string that will be parsed to get a data size.+--+-- Examples: "100 megabytes" or "0.5tb"+type DataSize = String++maxSizeParam :: DataSize -> Maybe String+maxSizeParam s = readSize dataUnits s+	>>= \sz -> Just $ "--max-size=" ++ ccacheSizeUnits sz++-- Generates size units as used in ccache.conf.  The smallest unit we can+-- specify in a ccache config files is a kilobyte+ccacheSizeUnits :: Integer -> String+ccacheSizeUnits sz = filter (/= ' ') (roughSize cfgfileunits True sz)+  where+	cfgfileunits :: [Unit]+	cfgfileunits =+	        [ Unit (p 4) "Ti" "terabyte"+		, Unit (p 3) "Gi" "gigabyte"+		, Unit (p 2) "Mi" "megabyte"+		, Unit (p 1) "Ki" "kilobyte"+		]+	p :: Integer -> Integer+	p n = 1024^n++-- | Set limits on a given ccache+hasLimits :: FilePath -> Limit -> Property DebianLike+path `hasLimits` limit = go `requires` installed+  where+	go+		| null params' = doNothing+		-- We invoke ccache itself to set the limits, so that it can+		-- handle replacing old limits in the config file, duplicates+		-- etc.+		| null errors =+			cmdPropertyEnv "ccache" params' [("CCACHE_DIR", path)]+			`changesFileContent` (path </> "ccache.conf")+		| otherwise = property "couldn't parse ccache limits" $+			sequence_ (errorMessage <$> errors)+			>> return FailedChange++	params = limitToParams limit+	(errors, params') = partitionEithers params++limitToParams :: Limit -> [Either String String]+limitToParams NoLimit = []+limitToParams (MaxSize s) = case maxSizeParam s of+	Just param -> [Right param]+	Nothing -> [Left $ "unable to parse data size " ++ s]+limitToParams (MaxFiles f) = [Right $ "--max-files=" ++ show f]+limitToParams (l1 :+ l2) = limitToParams l1 <> limitToParams l2++-- | Configures a ccache in /var/cache for a group+--+-- If you say+--+-- > & (Group "foo") `Ccache.hasGroupCache`+-- > 	(Ccache.MaxSize "4G" <> Ccache.MaxFiles 10000)+--+-- you instruct propellor to create a ccache in /var/cache/ccache-foo owned and+-- writeable by the foo group, with a maximum cache size of 4GB or 10000 files.+hasCache :: Group -> Limit -> RevertableProperty DebianLike UnixLike+group@(Group g) `hasCache` limit = (make `requires` installed) <!> delete+  where+	make = propertyList ("ccache for " ++ g ++ " group exists") $ props+			& File.dirExists path+			& File.ownerGroup path (User "root") group+			& File.mode path (combineModes $+				readModes ++ executeModes+				++ [ownerWriteMode, groupWriteMode])+			& hasLimits path limit++	delete = check (doesDirectoryExist path) $+		cmdProperty "rm" ["-r", path] `assume` MadeChange+		`describe` ("ccache for " ++ g ++ " does not exist")++	path = "/var/cache/ccache-" ++ g++installed :: Property DebianLike+installed = Apt.installed ["ccache"]
src/Propellor/Property/Debootstrap.hs view
@@ -3,6 +3,7 @@ 	DebootstrapConfig(..), 	built, 	built',+	extractSuite, 	installed, 	sourceInstall, 	programPath,
src/Propellor/Property/Firewall.hs view
@@ -79,6 +79,12 @@ 	, intercalate "," (map show c) 	] toIpTableArg TCPSyn = ["--syn"]+toIpTableArg (GroupOwner (Group g)) =+	[ "-m"+	, "owner"+	, "--gid-owner"+	, g+	] toIpTableArg (Source ipwm) = 	[ "-s" 	, intercalate "," (map fromIPWithMask ipwm)@@ -87,6 +93,11 @@ 	[ "-d" 	, intercalate "," (map fromIPWithMask ipwm) 	]+toIpTableArg (NotDestination ipwm) =+	[ "!"+	, "-d"+	, intercalate "," (map fromIPWithMask ipwm)+	] toIpTableArg (NatDestination ip mport) = 	[ "--to-destination" 	, fromIPAddr ip ++ maybe "" (\p -> ":" ++ fromPort p) mport@@ -179,8 +190,10 @@ 	| RateLimit Frequency 	| TCPFlags TCPFlagMask TCPFlagComp 	| TCPSyn+	| GroupOwner Group 	| Source [ IPWithMask ] 	| Destination [ IPWithMask ]+	| NotDestination [ IPWithMask ] 	| NatDestination IPAddr (Maybe Port) 	| Rules :- Rules   -- ^Combine two rules 	deriving (Eq, Show)
+ src/Propellor/Property/Sbuild.hs view
@@ -0,0 +1,383 @@+{-# OPTIONS_HADDOCK prune #-}+{-# LANGUAGE TypeFamilies #-}++{-|+Maintainer: Sean Whitton <spwhitton@spwhitton.name>++Build and maintain schroots for use with sbuild.++Suggested usage in @config.hs@:++>  & Apt.installed ["piuparts"]+>  & Sbuild.builtFor (System (Debian Unstable) "i386")+>  & Sbuild.piupartsConfFor (System (Debian Unstable) "i386")+>  & Sbuild.updatedFor (System (Debian Unstable) "i386") `period` Weekly 1+>  & Sbuild.usableBy (User "spwhitton")+>  & Sbuild.shareAptCache+>  & Schroot.overlaysInTmpfs++In @~/.sbuildrc@:++>  $run_piuparts = 1;+>  $piuparts_opts = [+>      '--schroot',+>      'unstable-i386-piuparts',+>      '--fail-if-inadequate',+>      '--fail-on-broken-symlinks',+>      ];+>+>  $external_commands = {+>    'post-build-commands' => [+>      [+>        'adt-run',+>        '--changes', '%c',+>        '---',+>        'schroot', 'unstable-i386-sbuild;',+>+>        # if adt-run's exit code is 8 then the package had no tests but+>        # this isn't a failure, so catch it+>        'adtexit=$?;',+>        'if', 'test', '$adtexit', '=', '8;', 'then',+>        'exit', '0;', 'else', 'exit', '$adtexit;', 'fi'+>      ],+>    ],+>  };++We use @sbuild-createchroot(1)@ to create a chroot to the specification of+@sbuild-setup(7)@.  This differs from the approach taken by picca's Sbuild.hs,+which uses 'Propellor.Property.Debootstrap' to construct the chroot.  This is+because we don't want to run propellor inside the chroot in order to keep the+sbuild environment as standard as possible.+-}++-- If you wanted to do it with Propellor.Property.Debootstrap, note that+-- sbuild-createchroot has a --setup-only option++module Propellor.Property.Sbuild (+	-- * Creating and updating sbuild schroots+	SbuildSchroot(..),+	builtFor,+	built,+	updated,+	updatedFor,+	piupartsConfFor,+	piupartsConf,+	-- * Global sbuild configuration+	-- blockNetwork,+	installed,+	keypairGenerated,+	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.Firewall as Firewall+import qualified Propellor.Property.User as User++import Utility.FileMode+import Data.List+import Data.List.Utils++type Suite = String++-- | An sbuild schroot, such as would be listed by @schroot -l@+--+-- Parts of the sbuild toolchain cannot distinguish between schroots with both+-- the same suite and the same architecture, so neither do we+data SbuildSchroot = SbuildSchroot Suite Architecture++instance Show SbuildSchroot where+	show (SbuildSchroot suite arch) = suite ++ "-" ++ arch++-- | Build and configure a schroot for use with sbuild using a distribution's+-- standard mirror+--+-- This function is a convenience wrapper around 'Sbuild.builtFor', allowing the+-- user to identify the schroot and distribution using the 'System' type+builtFor :: System -> RevertableProperty DebianLike UnixLike+builtFor sys = 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+			_ -> 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"+			Nothing -> noChange++-- | Build and configure a schroot for use with sbuild+built :: SbuildSchroot -> Apt.Url -> RevertableProperty DebianLike UnixLike+built s@(SbuildSchroot suite arch) mirror =+	(go+	`requires` keypairGenerated+	`requires` ccachePrepared+	`requires` installed)+	<!> deleted+  where+	go :: Property DebianLike+	go = check (unpopulated (schrootRoot s) <||> ispartial) $+		property' ("built sbuild schroot for " ++ show s) make+	make w = do+		de <- liftIO standardPathEnv+		let params = Param <$>+			[ "--arch=" ++ arch+			, "--chroot-suffix=-propellor"+			, "--include=eatmydata,ccache"+			, suite+			, schrootRoot s+			, mirror+			]+		ifM (liftIO $+			boolSystemEnv "sbuild-createchroot" params (Just de))+			( ensureProperty w $+				fixConfFile s+				`before` aliasesLine+				`before` commandPrefix+			, return FailedChange+			)+	deleted = check (not <$> unpopulated (schrootRoot s)) $+		property ("no sbuild schroot for " ++ show s) $ do+			liftIO $ removeChroot $ schrootRoot s+			liftIO $ nukeFile+				("/etc/sbuild/chroot" </> show s ++ "-sbuild")+			makeChange $ nukeFile (schrootConf s)++	-- if we're building a sid chroot, add useful aliases+	aliasesLine :: Property UnixLike+	aliasesLine = if suite == "unstable"+		then File.containsLine (schrootConf s)+			"aliases=UNRELEASED,sid,rc-buggy,experimental"+		else doNothing+	-- enable ccache and eatmydata for speed+	commandPrefix = File.containsLine (schrootConf s)+		"command-prefix=/var/cache/ccache-sbuild/sbuild-setup,eatmydata"++	-- A failed debootstrap run will leave a debootstrap directory;+	-- recover by deleting it and trying again.+	ispartial = ifM (doesDirectoryExist (schrootRoot s </> "debootstrap"))+		( do+			removeChroot $ schrootRoot s+			return True+		, return False+		)++-- | Ensure that an sbuild schroot's packages and apt indexes are updated+--+-- This function is a convenience wrapper around 'Sbuild.updated', allowing the+-- user to identify the schroot using the 'System' type+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)++-- | Ensure that an sbuild schroot's packages and apt indexes are updated+updated :: SbuildSchroot -> Property DebianLike+updated s@(SbuildSchroot suite arch) =+	check (doesDirectoryExist (schrootRoot s)) $ go+	`describe` ("updated schroot for " ++ show s)+	`requires` keypairGenerated+	`requires` installed+  where+	go :: Property DebianLike+	go = tightenTargets $ cmdProperty+		"sbuild-update" ["-udr", suite ++ "-" ++ arch]+		`assume` MadeChange++-- Find the conf file that sbuild-createchroot(1) made when we passed it+-- --chroot-suffix=propellor, and edit and rename such that it is as if we+-- passed --chroot-suffix=sbuild (the default).  Replace the random suffix with+-- 'propellor'.+--+-- We had to pass --chroot-suffix=propellor in order that we can find a unique+-- config file for the schroot we just built, despite the random suffix.+--+-- The properties in this module only permit the creation of one chroot for a+-- given suite and architecture, so we don't need the suffix to be random.+fixConfFile :: SbuildSchroot -> Property UnixLike+fixConfFile s@(SbuildSchroot suite arch) =+	property' ("schroot for " ++ show 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" </> show s ++ "-propellor")+			("/etc/sbuild/chroot" </> show s ++ "-sbuild")+		ensureProperty w $+			File.fileProperty "replace dummy suffix" (map munge) new+  where+	new = schrootConf s+	dir = takeDirectory new+	tempPrefix = dir </> suite ++ "-" ++ arch ++ "-propellor-"+	munge = replace "-propellor]" "-sbuild]"++-- | Create a corresponding schroot config file for use with piuparts+--+-- This function is a convenience wrapper around 'Sbuild.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, stdMirror sys) of+			(Just s, Just u)  -> ensureProperty w $+				piupartsConf s u+			_ -> 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 'Sbuild.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:+--+--  >  $run_piuparts = 1;+--  >  $piuparts_opts = [+--  >      '--schroot',+--  >      'unstable-i386-piuparts',+--  >      '--fail-if-inadequate',+--  >      '--fail-on-broken-symlinks',+--  >      ];+piupartsConf :: SbuildSchroot -> Apt.Url -> Property DebianLike+piupartsConf s u = go+	`requires` (setupRevertableProperty $ built s u)+	`describe` ("piuparts schroot conf for " ++ show s)+  where+	go :: Property DebianLike+	go = tightenTargets $+		check (not <$> doesFileExist f)+			(File.basedOn f (schrootConf s, map munge))+		`before`+		ConfFile.containsIniSetting f (sec, "profile", "piuparts")+		`before`+		ConfFile.containsIniSetting f (sec, "aliases", "")+		`before`+		ConfFile.containsIniSetting f (sec, "command-prefix", "")+		`before`+		File.dirExists dir+		`before`+		File.isSymlinkedTo (dir </> "copyfiles")+			(File.LinkTarget $ orig </> "copyfiles")+		`before`+		File.isSymlinkedTo (dir </> "nssdatabases")+			(File.LinkTarget $ orig </> "nssdatabases")+		`before`+		File.basedOn (dir </> "fstab")+			(orig </> "fstab", filter (/= aptCacheLine))++	orig = "/etc/schroot/sbuild"+	dir = "/etc/schroot/piuparts"+	sec = show s ++ "-piuparts"+	f = schrootPiupartsConf s+	munge = replace "-sbuild]" "-piuparts]"++-- | 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"++-- | 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"++-- another script from wiki.d.o/sbuild+ccachePrepared :: Property DebianLike+ccachePrepared = propertyList "sbuild group ccache configured" $ props+	-- We only set a limit on the cache if it doesn't already exist, so the+	-- user can override our default limit+	& 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))++-- This doesn't seem to work with the current version of sbuild+-- -- | Block network access during builds+-- --+-- -- This is a hack from <https://wiki.debian.org/sbuild> until #802850 and+-- -- #802849 are resolved.+-- blockNetwork :: Property Linux+-- blockNetwork = Firewall.rule Firewall.OUTPUT Firewall.Filter Firewall.DROP+-- 	(Firewall.GroupOwner (Group "sbuild")+-- 	<> Firewall.NotDestination+-- 		[Firewall.IPWithNumMask (IPv4 "127.0.0.1") 8])+-- 	`requires` installed 	-- sbuild group must exist++-- ==== utility functions ====++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://httpredir.debian.org/debian"+stdMirror (System (Buntish _) _) = Just "mirror://mirrors.ubuntu.com/"+stdMirror _ = Nothing++schrootRoot :: SbuildSchroot -> FilePath+schrootRoot (SbuildSchroot s a) = "/srv/chroot" </> s ++ "-" ++ a++schrootConf :: SbuildSchroot -> FilePath+schrootConf (SbuildSchroot s a) =+	"/etc/schroot/chroot.d" </> s ++ "-" ++ a ++ "-sbuild-propellor"++schrootPiupartsConf :: SbuildSchroot -> FilePath+schrootPiupartsConf (SbuildSchroot s a) =+	"/etc/schroot/chroot.d" </> s ++ "-" ++ a ++ "-piuparts-propellor"
+ src/Propellor/Property/Schroot.hs view
@@ -0,0 +1,42 @@+-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>++module Propellor.Property.Schroot where++import Propellor.Base+import qualified Propellor.Property.File as File+import qualified Propellor.Property.Apt as Apt++import Utility.FileMode++-- | Configure schroot such that all schroots with @union-type=overlay@ in their+-- configuration will run their overlays in a tmpfs.+--+-- Shell script from <https://wiki.debian.org/sbuild>.+overlaysInTmpfs :: Property DebianLike+overlaysInTmpfs = go `requires` installed+  where+	f = "/etc/schroot/setup.d/04tmpfs"+	go :: Property UnixLike+	go = f `File.hasContent`+		[ "#!/bin/sh"+		, ""+		, "set -e"+		, ""+		, ". \"$SETUP_DATA_DIR/common-data\""+		, ". \"$SETUP_DATA_DIR/common-functions\""+		, ". \"$SETUP_DATA_DIR/common-config\""+		, ""+		, ""+		, "if [ $STAGE = \"setup-start\" ]; then"+		, "  mount -t tmpfs overlay /var/lib/schroot/union/overlay"+		, "elif [ $STAGE = \"setup-recover\" ]; then"+		, "  mount -t tmpfs overlay /var/lib/schroot/union/overlay"+		, "elif [ $STAGE = \"setup-stop\" ]; then"+		, "  umount -f /var/lib/schroot/union/overlay"+		, "fi"+		]+		`onChange` (f `File.mode` (combineModes (readModes ++ executeModes)))+		`describe` "schroot overlays in tmpfs"++installed :: Property DebianLike+installed = Apt.installed ["schroot"]
src/Propellor/Property/Systemd.hs view
@@ -12,6 +12,7 @@ 	restarted, 	networkd, 	journald,+	logind, 	-- * Configuration 	installed, 	Option,@@ -20,6 +21,9 @@ 	-- * Journal 	persistentJournal, 	journaldConfigured,+	-- * Logind+	logindConfigured,+	killUserProcesses, 	-- * Containers and machined 	machined, 	MachineName,@@ -127,6 +131,10 @@ journald :: ServiceName journald = "systemd-journald" +-- | The systemd-logind service.+logind :: ServiceName+logind = "systemd-logind"+ -- | Enables persistent storage of the journal. persistentJournal :: Property DebianLike persistentJournal = check (not <$> doesDirectoryExist dir) $@@ -171,6 +179,25 @@ journaldConfigured option value = 	configured "/etc/systemd/journald.conf" option value 		`onChange` restarted journald++-- | Configures logind, restarting it so the changes take effect.+logindConfigured :: Option -> String -> Property Linux+logindConfigured option value =+	configured "/etc/systemd/logind.conf" option value+		`onChange` restarted logind++-- | Configures whether leftover processes started from the+-- user's login session are killed after the user logs out.+--+-- The default configuration varies depending on the version of systemd.+--+-- Revert the property to ensure that screen sessions etc keep running:+--+-- >	! killUserProcesses+killUserProcesses :: RevertableProperty Linux Linux+killUserProcesses = set "yes" <!> set "no"+  where+	set = logindConfigured "KillUserProcesses"  -- | Ensures machined and machinectl are installed machined :: Property Linux