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 +11/−0
- debian/changelog +11/−0
- joeyconfig.hs +3/−0
- propellor.cabal +4/−1
- src/Propellor/EnsureProperty.hs +1/−1
- src/Propellor/Property/Ccache.hs +110/−0
- src/Propellor/Property/Debootstrap.hs +1/−0
- src/Propellor/Property/Firewall.hs +13/−0
- src/Propellor/Property/Sbuild.hs +383/−0
- src/Propellor/Property/Schroot.hs +42/−0
- src/Propellor/Property/Systemd.hs +27/−0
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