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