summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Lvm.hs
blob: d513c1be71182aca1a357bf1a96ed68b61d74bcf (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
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
-- | Maintainer: Nicolas Schodet <nico@ni.fr.eu.org>
--
-- Support for LVM logical volumes.

module Propellor.Property.Lvm (
	lvFormatted,
	installed,
	Eep(..),
	VolumeGroup(..),
	LogicalVolume(..),
) where

import Propellor
import Propellor.Base
import Utility.DataUnits
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Mount as Mount
import qualified Propellor.Property.Partition as Partition

data Eep = YesReallyFormatLogicalVolume

type DataSize = String

newtype VolumeGroup = VolumeGroup String
data LogicalVolume = LogicalVolume String VolumeGroup

-- | Create or resize a logical volume, and make sure it is formatted.  When
-- reverted, remove the logical volume.
--
-- Example use:
--
-- > import qualified Propellor.Property.Lvm as Lvm
-- > import qualified Propellor.Property.Partition as Partition
-- > Lvm.lvFormatted Lvm.YesReallyFormatLogicalVolume
-- >         (Lvm.LogicalVolume "test" (Lvm.VolumeGroup "vg0")) "16m"
-- >         Partition.EXT4
--
-- If size and filesystem match, nothing is done.
--
-- Volume group must have been created already.
lvFormatted
	:: Eep
	-> LogicalVolume
	-> DataSize
	-> Partition.Fs
	-> RevertableProperty DebianLike UnixLike
lvFormatted YesReallyFormatLogicalVolume lv sz fs =
	setup <!> cleanup
  where
	setup :: Property DebianLike
	setup = property' ("formatted logical volume " ++ (vglv lv)) $ \w -> do
		es <- liftIO $ vgExtentSize vg
		case es of
			Nothing -> errorMessage $
				"can not get extent size, does volume group "
				++ vgname ++ " exist?"
			Just extentSize -> do
				case parseSize of
					Nothing -> errorMessage 
						"can not parse volume group size"
					Just size -> do
						state <- liftIO $ lvState lv
						let rsize = roundSize extentSize size
						ensureProperty w $
							setupprop rsize state

	cleanup :: Property UnixLike
	cleanup = property' ("removed logical volume " ++ (vglv lv)) $ \w -> do
		exists <- liftIO $ lvExists lv
		ensureProperty w $ if exists
			then removedprop
			else doNothing

	-- Parse size.
	parseSize :: Maybe Integer
	parseSize = readSize dataUnits sz

	-- Round size to next extent size multiple.
	roundSize :: Integer -> Integer -> Integer
	roundSize extentSize s =
		(s + extentSize - 1) `div` extentSize * extentSize

	-- Dispatch to the right props.
	setupprop :: Integer -> (Maybe LvState) -> Property DebianLike
	setupprop size Nothing = createdprop size `before` formatprop
	setupprop size (Just (LvState csize cfs))
		| size == csize && fsMatch fs cfs = doNothing
		| size == csize = formatprop
		| fsMatch fs cfs = tightenTargets $ resizedprop size True
		| otherwise = resizedprop size False `before` formatprop

	createdprop :: Integer -> Property UnixLike
	createdprop size =
		cmdProperty "lvcreate"
			(bytes size $ [ "-n", lvname, "--yes", vgname ])
			`assume` MadeChange

	resizedprop :: Integer -> Bool -> Property UnixLike
	resizedprop size rfs =
		cmdProperty "lvresize"
			(resizeFs rfs $ bytes size $ [ vglv lv ])
			`assume` MadeChange
	  where
		resizeFs True l = "-r" : l
		resizeFs False l = l

	removedprop :: Property UnixLike
	removedprop = cmdProperty "lvremove" [ "-f", vglv lv ]
		`assume` MadeChange

	formatprop :: Property DebianLike
	formatprop = Partition.formatted Partition.YesReallyFormatPartition
		fs (path lv)

	fsMatch :: Partition.Fs -> Maybe Partition.Fs -> Bool
	fsMatch a (Just b) = a == b
	fsMatch _ _ = False

	bytes size l = "-L" : ((show size) ++ "b") : l

	(LogicalVolume lvname vg@(VolumeGroup vgname)) = lv

-- | Make sure needed tools are installed.
installed :: RevertableProperty DebianLike DebianLike
installed = install <!> remove
  where
	install = Apt.installed ["lvm2"]
	remove = Apt.removed ["lvm2"]

data LvState = LvState Integer (Maybe Partition.Fs)

-- Check for logical volume existance.
lvExists :: LogicalVolume -> IO Bool
lvExists lv = doesFileExist (path lv)

-- Return Nothing if logical volume does not exists (or error), else return
-- its size and maybe file system.
lvState :: LogicalVolume -> IO (Maybe LvState)
lvState lv = do
	exists <- lvExists lv
	if not exists
		then return Nothing
		else do
			s <- readLvSize
			fs <- maybe Nothing Partition.parseFs <$> readFs
			return $ do
				size <- s
				return $ LvState size fs
  where
	readLvSize = catchDefaultIO Nothing $ readish
		<$> readProcess "lvs" [ "-o", "size", "--noheadings",
			"--nosuffix", "--units", "b", vglv lv ]
	readFs = Mount.blkidTag "TYPE" (path lv)

-- Read extent size (or Nothing on error).
vgExtentSize :: VolumeGroup -> IO (Maybe Integer)
vgExtentSize (VolumeGroup vgname) =
	catchDefaultIO Nothing $ readish
		<$> readProcess "vgs" [ "-o", "vg_extent_size",
			"--noheadings", "--nosuffix", "--units", "b", vgname ]

-- Give "vgname/lvname" for a LogicalVolume.
vglv :: LogicalVolume -> String
vglv lv =
	vgname </> lvname
  where
	(LogicalVolume lvname (VolumeGroup vgname)) = lv

-- Give device path.
path :: LogicalVolume -> FilePath
path lv = "/dev" </> (vglv lv)