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

-- | Ensures that </etc/fstab> contains a line mounting the specified
-- `Source` on the specified `MountPoint`, and that it's currently mounted.
--
-- For example:
--
-- > mounted "auto" "/dev/sdb1" "/srv" mempty
--
-- Note that if anything else is already mounted at the `MountPoint`, it
-- will be left as-is by this property.
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
	-- This use of mountPoints, which is linux-only, is why this
	-- property currently only supports linux.
	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]

-- | Ensures that </etc/fstab> contains a line mounting the specified
-- `Source` on the specified `MountPoint`. Does not ensure that it's
-- currently `mounted`.
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"

-- | Ensures that </etc/fstab> contains a line enabling the specified
-- `Source` to be used as swap space, and that it's enabled.
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

-- | Replaces </etc/fstab> with a file that should cause the currently
-- mounted partitions to be re-mounted the same way on boot.
--
-- For each specified MountPoint, the UUID of each partition
-- (or if there is no UUID, its label), its filesystem type,
-- and its mount options are all automatically probed.
--
-- The SwapPartitions are also included in the generated fstab.
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="

-- | Checks if </etc/fstab> is not configured. 
-- This is the case if it doesn't exist, or
-- consists entirely of blank lines or comments.
--
-- So, if you want to only replace the fstab once, and then never touch it
-- again, allowing local modifications:
--
-- > check noFstab (fstabbed mnts [])
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