summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Ccache.hs
blob: ebc21b88d565cd73d75f71b8b31af43c890a768d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
-- | 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
import qualified Data.Semigroup as Sem

-- | 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 Sem.Semigroup Limit where
	(<>) = (:+)

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" $
			errorMessage $ unlines errors

	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=" ++ val 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
					, setGroupIDMode
					]) `onChange` fixSetgidBit
				-- here, we use onChange to catch upgrades from
				-- 3.0.5 where the setGroupIDMode line was not
				-- present
			& hasLimits path limit

	delete = check (doesDirectoryExist path) $
		cmdProperty "rm" ["-r", path] `assume` MadeChange
		`describe` ("ccache for " ++ g ++ " does not exist")

	-- Here we deal with a bug in Propellor 3.0.5.  If the ccache was
	-- created with that version, it will not have the setgid bit set.  That
	-- means its subdirectories won't have inherited the setgid bit, and
	-- then the files in those directories won't be owned by group sbuild.
	-- This breaks ccache.
	fixSetgidBit :: Property UnixLike
	fixSetgidBit =
		(cmdProperty "find"
			[ path
			, "-type", "d"
			, "-exec", "chmod", "g+s"
			, "{}", "+"
			] `assume` MadeChange)
		`before`
		(cmdProperty "chown"
			[ "-R"
			, "root:" ++ g
			, path
			] `assume` MadeChange)

	path = "/var/cache/ccache-" ++ g

installed :: Property DebianLike
installed = Apt.installed ["ccache"]