module Propellor.Property.Fstab (
FsType,
Source,
MountPoint,
MountOpts(..),
module Propellor.Property.Fstab,
) where
import Propellor.Base
import qualified Propellor.Property.File as File
import Propellor.Property.Mount
import Data.Char
import Data.List
import Utility.Table
mounted :: FsType -> Source -> MountPoint -> MountOpts -> Property Linux
mounted :: [Char] -> [Char] -> [Char] -> MountOpts -> Property Linux
mounted [Char]
fs [Char]
src [Char]
mnt MountOpts
opts = forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$
[Char] -> [Char] -> [Char] -> MountOpts -> Property UnixLike
listed [Char]
fs [Char]
src [Char]
mnt MountOpts
opts
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property UnixLike
mountnow
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Char] -> Property UnixLike
File.dirExists [Char]
mnt
where
mountnow :: Property UnixLike
mountnow = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem [Char]
mnt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [[Char]]
mountPoints) forall a b. (a -> b) -> a -> b
$
[Char] -> [[Char]] -> UncheckedProperty UnixLike
cmdProperty [Char]
"mount" [[Char]
mnt]
listed :: FsType -> Source -> MountPoint -> MountOpts -> Property UnixLike
listed :: [Char] -> [Char] -> [Char] -> MountOpts -> Property UnixLike
listed [Char]
fs [Char]
src [Char]
mnt MountOpts
opts = [Char]
"/etc/fstab" [Char] -> [Char] -> Property UnixLike
`File.containsLine` [Char]
l
forall p. IsProp p => p -> [Char] -> p
`describe` ([Char]
mnt forall a. [a] -> [a] -> [a]
++ [Char]
" mounted by fstab")
where
l :: [Char]
l = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\t" [[Char]
src, [Char]
mnt, [Char]
fs, MountOpts -> [Char]
formatMountOpts MountOpts
opts, [Char]
dump, [Char]
passno]
dump :: [Char]
dump = [Char]
"0"
passno :: [Char]
passno = [Char]
"2"
swap :: Source -> Property Linux
swap :: [Char] -> Property Linux
swap [Char]
src = [Char] -> [Char] -> [Char] -> MountOpts -> Property UnixLike
listed [Char]
"swap" [Char]
src [Char]
"none" forall a. Monoid a => a
mempty
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` [Char] -> RevertableProperty Linux Linux
swapOn [Char]
src
newtype SwapPartition = SwapPartition FilePath
fstabbed :: [MountPoint] -> [SwapPartition] -> Property Linux
fstabbed :: [[Char]] -> [SwapPartition] -> Property Linux
fstabbed [[Char]]
mnts [SwapPartition]
swaps = forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' [Char]
"fstabbed" forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
o -> do
[[Char]]
fstab <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [[Char]] -> [SwapPartition] -> ([Char] -> [Char]) -> IO [[Char]]
genFstab [[Char]]
mnts [SwapPartition]
swaps forall a. a -> a
id
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
o forall a b. (a -> b) -> a -> b
$
[Char]
"/etc/fstab" [Char] -> [[Char]] -> Property UnixLike
`File.hasContent` [[Char]]
fstab
genFstab :: [MountPoint] -> [SwapPartition] -> (MountPoint -> MountPoint) -> IO [String]
genFstab :: [[Char]] -> [SwapPartition] -> ([Char] -> [Char]) -> IO [[Char]]
genFstab [[Char]]
mnts [SwapPartition]
swaps [Char] -> [Char]
mnttransform = do
[[[Char]]]
fstab <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> IO [[Char]]
getcfg (forall a. Ord a => [a] -> [a]
sort [[Char]]
mnts)
[[[Char]]]
swapfstab <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SwapPartition -> IO [[Char]]
getswapcfg [SwapPartition]
swaps
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [[Char]]
header forall a. [a] -> [a] -> [a]
++ [[[Char]]] -> [[Char]]
formatTable ([[Char]]
legend forall a. a -> [a] -> [a]
: [[[Char]]]
fstab forall a. [a] -> [a] -> [a]
++ [[[Char]]]
swapfstab)
where
header :: [[Char]]
header =
[ [Char]
"# /etc/fstab: static file system information. See fstab(5)"
, [Char]
"# "
]
legend :: [[Char]]
legend = [[Char]
"# <file system>", [Char]
"<mount point>", [Char]
"<type>", [Char]
"<options>", [Char]
"<dump>", [Char]
"<pass>"]
getcfg :: [Char] -> IO [[Char]]
getcfg [Char]
mnt = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"unable to find mount source for " forall a. [a] -> [a] -> [a]
++ [Char]
mnt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
getM (\[Char] -> IO (Maybe [Char])
a -> [Char] -> IO (Maybe [Char])
a [Char]
mnt)
[ forall {t}. (t -> IO (Maybe [Char])) -> t -> IO (Maybe [Char])
uuidprefix [Char] -> IO (Maybe [Char])
getMountUUID
, forall {t}. (t -> IO (Maybe [Char])) -> t -> IO (Maybe [Char])
sourceprefix [Char] -> IO (Maybe [Char])
getMountLabel
, [Char] -> IO (Maybe [Char])
getMountSource
]
, forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> [Char]
mnttransform [Char]
mnt)
, forall a. a -> Maybe a -> a
fromMaybe [Char]
"auto" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
getFsType [Char]
mnt
, MountOpts -> [Char]
formatMountOpts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO MountOpts
getFsMountOpts [Char]
mnt
, forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
"0"
, forall (f :: * -> *) a. Applicative f => a -> f a
pure (if [Char]
mnt forall a. Eq a => a -> a -> Bool
== [Char]
"/" then [Char]
"1" else [Char]
"2")
]
getswapcfg :: SwapPartition -> IO [[Char]]
getswapcfg (SwapPartition [Char]
s) = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall a. a -> Maybe a -> a
fromMaybe [Char]
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
getM (\[Char] -> IO (Maybe [Char])
a -> [Char] -> IO (Maybe [Char])
a [Char]
s)
[ forall {t}. (t -> IO (Maybe [Char])) -> t -> IO (Maybe [Char])
uuidprefix [Char] -> IO (Maybe [Char])
getSourceUUID
, forall {t}. (t -> IO (Maybe [Char])) -> t -> IO (Maybe [Char])
sourceprefix [Char] -> IO (Maybe [Char])
getSourceLabel
]
, forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
"none"
, forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
"swap"
, forall (f :: * -> *) a. Applicative f => a -> f a
pure (MountOpts -> [Char]
formatMountOpts forall a. Monoid a => a
mempty)
, forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
"0"
, forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
"0"
]
prefix :: [a] -> (t -> f (f [a])) -> t -> f (f [a])
prefix [a]
s t -> f (f [a])
getter t
m = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a]
s forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> f (f [a])
getter t
m
uuidprefix :: (t -> IO (Maybe [Char])) -> t -> IO (Maybe [Char])
uuidprefix = forall {f :: * -> *} {f :: * -> *} {a} {t}.
(Functor f, Functor f) =>
[a] -> (t -> f (f [a])) -> t -> f (f [a])
prefix [Char]
"UUID="
sourceprefix :: (t -> IO (Maybe [Char])) -> t -> IO (Maybe [Char])
sourceprefix = forall {f :: * -> *} {f :: * -> *} {a} {t}.
(Functor f, Functor f) =>
[a] -> (t -> f (f [a])) -> t -> f (f [a])
prefix [Char]
"LABEL="
noFstab :: IO Bool
noFstab :: IO Bool
noFstab = forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM ([Char] -> IO Bool
doesFileExist [Char]
"/etc/fstab")
( forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
iscfg forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
readFile [Char]
"/etc/fstab"
, forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
)
where
iscfg :: [Char] -> Bool
iscfg [Char]
l
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
l = Bool
False
| Bool
otherwise = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ [Char]
"#" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
l