summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/Engine.hs1
-rw-r--r--src/Propellor/Property/Lvm.hs171
-rw-r--r--src/Propellor/Property/Partition.hs14
3 files changed, 186 insertions, 0 deletions
diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs
index f54da929..b4dc66ce 100644
--- a/src/Propellor/Engine.hs
+++ b/src/Propellor/Engine.hs
@@ -97,6 +97,7 @@ onlyProcess lockfile a = bracket lock unlock (const a)
lock = do
createDirectoryIfMissing True (takeDirectory lockfile)
l <- createFile lockfile stdFileMode
+ setFdOption l CloseOnExec True
setLock l (WriteLock, AbsoluteSeek, 0, 0)
`catchIO` const alreadyrunning
return l
diff --git a/src/Propellor/Property/Lvm.hs b/src/Propellor/Property/Lvm.hs
new file mode 100644
index 00000000..d513c1be
--- /dev/null
+++ b/src/Propellor/Property/Lvm.hs
@@ -0,0 +1,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)
diff --git a/src/Propellor/Property/Partition.hs b/src/Propellor/Property/Partition.hs
index 679675b7..27ae89ff 100644
--- a/src/Propellor/Property/Partition.hs
+++ b/src/Propellor/Property/Partition.hs
@@ -15,6 +15,20 @@ import Data.Char
data Fs = EXT2 | EXT3 | EXT4 | BTRFS | REISERFS | XFS | FAT | VFAT | NTFS | LinuxSwap
deriving (Show, Eq)
+-- | Parse commonly used names of filesystems.
+parseFs :: String -> Maybe Fs
+parseFs "ext2" = Just EXT2
+parseFs "ext3" = Just EXT3
+parseFs "ext4" = Just EXT4
+parseFs "btrfs" = Just BTRFS
+parseFs "reiserfs" = Just REISERFS
+parseFs "xfs" = Just XFS
+parseFs "fat" = Just FAT
+parseFs "vfat" = Just VFAT
+parseFs "ntfs" = Just NTFS
+parseFs "swap" = Just LinuxSwap
+parseFs _ = Nothing
+
data Eep = YesReallyFormatPartition
-- | Formats a partition.