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 fs :: FsType
fs src :: FsType
src mnt :: FsType
mnt opts :: 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 "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 fs :: FsType
fs src :: FsType
src mnt :: FsType
mnt opts :: MountOpts
opts = "/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]
++ " mounted by fstab")
where
l :: FsType
l = FsType -> [FsType] -> FsType
forall a. [a] -> [[a]] -> [a]
intercalate "\t" [FsType
src, FsType
mnt, FsType
fs, MountOpts -> FsType
formatMountOpts MountOpts
opts, FsType
dump, FsType
passno]
dump :: FsType
dump = "0"
passno :: FsType
passno = "2"
swap :: Source -> Property Linux
swap :: FsType -> Property Linux
swap src :: FsType
src = FsType
-> FsType
-> FsType
-> MountOpts
-> Property
(MetaTypes
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
listed "swap" FsType
src "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 mnts :: [FsType]
mnts swaps :: [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' "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
$ \o :: 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
$
"/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 mnts :: [FsType]
mnts swaps :: [SwapPartition]
swaps mnttransform :: 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 =
[ "# /etc/fstab: static file system information. See fstab(5)"
, "# "
]
legend :: [FsType]
legend = ["# <file system>", "<mount point>", "<type>", "<options>", "<dump>", "<pass>"]
getcfg :: FsType -> IO [FsType]
getcfg mnt :: 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
$ "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 (\a :: 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 "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 "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
== "/" then "1" else "2")
]
getswapcfg :: SwapPartition -> IO [FsType]
getswapcfg (SwapPartition s :: 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 (\a :: 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 "none"
, FsType -> IO FsType
forall (f :: * -> *) a. Applicative f => a -> f a
pure "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 "0"
, FsType -> IO FsType
forall (f :: * -> *) a. Applicative f => a -> f a
pure "0"
]
prefix :: [a] -> (t -> f (f [a])) -> t -> f (f [a])
prefix s :: [a]
s getter :: t -> f (f [a])
getter m :: 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 "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 "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 "/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 "/etc/fstab"
, Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
)
where
iscfg :: FsType -> Bool
iscfg l :: 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 -> 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