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 = Property UnixLike -> Property Linux
forall (untightened :: [MetaType]) (tightened :: [MetaType]).
(TightenTargetsAllowed untightened tightened, SingI tightened) =>
Property (MetaTypes untightened) -> Property (MetaTypes tightened)
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
$
[Char] -> [Char] -> [Char] -> MountOpts -> Property UnixLike
listed [Char]
fs [Char]
src [Char]
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` [Char] -> Property UnixLike
File.dirExists [Char]
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 ([Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem [Char]
mnt ([[Char]] -> Bool) -> IO [[Char]] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [[Char]]
mountPoints) (UncheckedProperty UnixLike -> Property UnixLike)
-> UncheckedProperty UnixLike -> Property UnixLike
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
Property UnixLike -> [Char] -> Property UnixLike
forall p. IsProp p => p -> [Char] -> p
`describe` ([Char]
mnt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" mounted by fstab")
where
l :: [Char]
l = [Char] -> [[Char]] -> [Char]
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" 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` [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 = [Char]
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Propellor Result)
-> Property Linux
forall {k} (metatypes :: k).
SingI metatypes =>
[Char]
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' [Char]
"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
[[Char]]
fstab <- IO [[Char]] -> Propellor [[Char]]
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[Char]] -> Propellor [[Char]])
-> IO [[Char]] -> Propellor [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [SwapPartition] -> ([Char] -> [Char]) -> IO [[Char]]
genFstab [[Char]]
mnts [SwapPartition]
swaps [Char] -> [Char]
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
$
[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 <- IO [[[Char]]] -> IO [[[Char]]]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[[Char]]] -> IO [[[Char]]]) -> IO [[[Char]]] -> IO [[[Char]]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> IO [[Char]]) -> [[Char]] -> IO [[[Char]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> IO [[Char]]
getcfg ([[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
sort [[Char]]
mnts)
[[[Char]]]
swapfstab <- IO [[[Char]]] -> IO [[[Char]]]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[[Char]]] -> IO [[[Char]]]) -> IO [[[Char]]] -> IO [[[Char]]]
forall a b. (a -> b) -> a -> b
$ (SwapPartition -> IO [[Char]]) -> [SwapPartition] -> IO [[[Char]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM SwapPartition -> IO [[Char]]
getswapcfg [SwapPartition]
swaps
[[Char]] -> IO [[Char]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> IO [[Char]]) -> [[Char]] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
header [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[[Char]]] -> [[Char]]
formatTable ([[Char]]
legend [[Char]] -> [[[Char]]] -> [[[Char]]]
forall a. a -> [a] -> [a]
: [[[Char]]]
fstab [[[Char]]] -> [[[Char]]] -> [[[Char]]]
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 = [IO [Char]] -> IO [[Char]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
[ [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"unable to find mount source for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
mnt)
(Maybe [Char] -> [Char]) -> IO (Maybe [Char]) -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Char] -> IO (Maybe [Char])) -> IO (Maybe [Char]))
-> [[Char] -> IO (Maybe [Char])] -> IO (Maybe [Char])
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)
[ ([Char] -> IO (Maybe [Char])) -> [Char] -> IO (Maybe [Char])
forall {t}. (t -> IO (Maybe [Char])) -> t -> IO (Maybe [Char])
uuidprefix [Char] -> IO (Maybe [Char])
getMountUUID
, ([Char] -> IO (Maybe [Char])) -> [Char] -> IO (Maybe [Char])
forall {t}. (t -> IO (Maybe [Char])) -> t -> IO (Maybe [Char])
sourceprefix [Char] -> IO (Maybe [Char])
getMountLabel
, [Char] -> IO (Maybe [Char])
getMountSource
]
, [Char] -> IO [Char]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> [Char]
mnttransform [Char]
mnt)
, [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"auto" (Maybe [Char] -> [Char]) -> IO (Maybe [Char]) -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
getFsType [Char]
mnt
, MountOpts -> [Char]
formatMountOpts (MountOpts -> [Char]) -> IO MountOpts -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO MountOpts
getFsMountOpts [Char]
mnt
, [Char] -> IO [Char]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
"0"
, [Char] -> IO [Char]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (if [Char]
mnt [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"/" then [Char]
"1" else [Char]
"2")
]
getswapcfg :: SwapPartition -> IO [[Char]]
getswapcfg (SwapPartition [Char]
s) = [IO [Char]] -> IO [[Char]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
[ [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
s (Maybe [Char] -> [Char]) -> IO (Maybe [Char]) -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Char] -> IO (Maybe [Char])) -> IO (Maybe [Char]))
-> [[Char] -> IO (Maybe [Char])] -> IO (Maybe [Char])
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)
[ ([Char] -> IO (Maybe [Char])) -> [Char] -> IO (Maybe [Char])
forall {t}. (t -> IO (Maybe [Char])) -> t -> IO (Maybe [Char])
uuidprefix [Char] -> IO (Maybe [Char])
getSourceUUID
, ([Char] -> IO (Maybe [Char])) -> [Char] -> IO (Maybe [Char])
forall {t}. (t -> IO (Maybe [Char])) -> t -> IO (Maybe [Char])
sourceprefix [Char] -> IO (Maybe [Char])
getSourceLabel
]
, [Char] -> IO [Char]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
"none"
, [Char] -> IO [Char]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
"swap"
, [Char] -> IO [Char]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MountOpts -> [Char]
formatMountOpts MountOpts
forall a. Monoid a => a
mempty)
, [Char] -> IO [Char]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
"0"
, [Char] -> IO [Char]
forall a. a -> IO a
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 = ([a] -> [a]) -> f [a] -> f [a]
forall a b. (a -> b) -> f a -> f b
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 [Char])) -> t -> IO (Maybe [Char])
uuidprefix = [Char] -> (t -> IO (Maybe [Char])) -> t -> IO (Maybe [Char])
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 = [Char] -> (t -> IO (Maybe [Char])) -> t -> IO (Maybe [Char])
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 = IO Bool -> (IO Bool, IO Bool) -> IO Bool
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM ([Char] -> IO Bool
doesFileExist [Char]
"/etc/fstab")
( [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[Char]] -> Bool) -> ([Char] -> [[Char]]) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Char] -> Bool
iscfg ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines ([Char] -> Bool) -> IO [Char] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
readFile [Char]
"/etc/fstab"
, Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
)
where
iscfg :: [Char] -> Bool
iscfg [Char]
l
| [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
l = Bool
False
| Bool
otherwise = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"#" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
l