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