{-# LINE 1 "System/Linux/Mount.hsc" #-}
--------------------------------------------------------------------------------
{-# LINE 2 "System/Linux/Mount.hsc" #-}
-- |
-- Module      :  $Header$
-- Copyright   :  © 2013-2014 Nicola Squartini
-- License     :  BSD3
--
-- Maintainer  :  Nicola Squartini <tensor5@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- @linux-mount@ provides bindings to the Linux
-- @<http://man7.org/linux/man-pages/man2/mount.2.html mount()>@ and
-- @<http://man7.org/linux/man-pages/man2/umount.2.html umount()>@ syscalls. All
-- functions below may fail with @'System.IO.Error.isPermissionError'@ if the
-- user does not have the required privileges.
--
--------------------------------------------------------------------------------

module System.Linux.Mount
    ( -- * Mount a filesystem
      mount
    , remount

    -- ** Mount flags
    , MountFlag(..)
    , DriverData
    , noData

    -- * Bind a filesystem
    , bind, rBind
    , rebind

    -- * Change propagation flags

    -- | These functions change the propagation flag of an already mounted
    -- filesystem, as explained in
    -- <https://www.kernel.org/doc/Documentation/filesystems/sharedsubtree.txt>.
    -- They all take the mount point as argument.
    , makeShared, makeRShared
    , makeSlave, makeRSlave
    , makePrivate, makeRPrivate
    , makeUnbindable, makeRUnbindable

    -- * Move a filesystem
    , move

    -- * Unmount a filesystem
    , umount
    , umountWith

    -- ** Unmount flags
    , UmountFlag(..)
    , SymLink(..)

    ) where


{-# LINE 58 "System/Linux/Mount.hsc" #-}

import           Data.Bits       ((.|.))
import           Data.ByteString (ByteString, empty, useAsCString)
import qualified Data.ByteString as B
import           Foreign.C       (CInt (..), CString, CUInt, CULong (..),
                                  throwErrnoIfMinus1_, withCString)
import           Foreign.Ptr     (Ptr, castPtr, nullPtr)

-- | Mount a filesystem (call to
-- @<http://man7.org/linux/man-pages/man2/mount.2.html mount()>@).
mount :: String      -- ^ Device file
      -> FilePath    -- ^ Mount point
      -> String      -- ^ Filesystem type
      -> [MountFlag] -- ^ List of mount options
      -> DriverData  -- ^ Driver specific options
      -> IO ()
mount dev dir typ xs byt =
    throwErrnoIfMinus1_ "mount" $
    withCStringOrNull dev $ \cdev ->
        withCString dir $ \cdir ->
            withCString typ $ \ctyp ->
                useAsCStringOrNull byt $ \cdat->
                                   c_mount cdev
                                           cdir
                                           ctyp
                                           (combineBitMasks xs)
                                           (castPtr cdat)

withCStringOrNull :: String -> (CString -> IO a) -> IO a
withCStringOrNull []  f = f nullPtr
withCStringOrNull str f = withCString str f

useAsCStringOrNull :: ByteString -> (CString -> IO a) -> IO a
useAsCStringOrNull str f | B.null str = f nullPtr
useAsCStringOrNull str f              = useAsCString str f

-- | Alter flags of a mounted filesystem (call to
-- @<http://man7.org/linux/man-pages/man2/mount.2.html mount()>@ with
-- @MS_REMOUNT@).
remount :: FilePath    -- ^ Mount point
        -> [MountFlag] -- ^ List of mount options
        -> DriverData  -- ^ Driver specific options
        -> IO ()
remount dir xs byt =
    throwErrnoIfMinus1_ "mount" $
    withCString dir $ \cdir ->
        useAsCStringOrNull byt $ \cdat->
                           c_mount nullPtr
                                   cdir
                                   nullPtr
                                   (combineBitMasks xs .|. 32)
{-# LINE 109 "System/Linux/Mount.hsc" #-}
                                   (castPtr cdat)

-- | Mount an already mounted filesystem under a new directory (call to
-- @<http://man7.org/linux/man-pages/man2/mount.2.html mount()>@ with
-- @MS_BIND@).
bind :: FilePath  -- ^ Source mount point
     -> FilePath  -- ^ Target mount point
     -> IO ()
bind = mountSrcDest 4096
{-# LINE 118 "System/Linux/Mount.hsc" #-}

-- | Mount an already mounted filesystem and all its submounts under a new
-- directory (call to
-- @<http://man7.org/linux/man-pages/man2/mount.2.html mount()>@ with @MS_BIND@
-- and @MS_REC@).
rBind :: FilePath  -- ^ Source mount point
      -> FilePath  -- ^ Target mount point
      -> IO ()
rBind = mountSrcDest (4096 .|. 16384)
{-# LINE 127 "System/Linux/Mount.hsc" #-}

-- | Atomically move a mounted filesystem to another mount point (call to
-- @<http://man7.org/linux/man-pages/man2/mount.2.html mount()>@ with
-- @MS_MOVE@).
move :: FilePath  -- ^ Old mount point
     -> FilePath  -- ^ New mount point
     -> IO ()
move = mountSrcDest 8192
{-# LINE 135 "System/Linux/Mount.hsc" #-}

mountSrcDest :: CUInt -> FilePath -> FilePath -> IO ()
mountSrcDest flag src dest =
    throwErrnoIfMinus1_ "mount" $
    withCString src $ \csrc ->
        withCString dest $ \cdest ->
            c_mount csrc cdest nullPtr (fromIntegral flag) nullPtr

-- | Alter flags of a bound filesystem (call to
-- @<http://man7.org/linux/man-pages/man2/mount.2.html mount()>@ with
-- @MS_REMOUNT@ and @MS_BIND@).
rebind :: FilePath     -- ^ Mount point
       -> [MountFlag]  -- ^ List of mount options
       -> IO ()
rebind dir flags =
    make (32 .|. 4096
{-# LINE 151 "System/Linux/Mount.hsc" #-}
          .|. fromIntegral (combineBitMasks flags)) dir

-- | Set the @MS_SHARED@ propagation flag on a mounted filesystem.
makeShared :: FilePath -> IO ()
makeShared = make 1048576
{-# LINE 156 "System/Linux/Mount.hsc" #-}

-- | Set the @MS_SHARED@ propagation flag on a mounted filesystem and
-- recursively on all submounts.
makeRShared :: FilePath -> IO ()
makeRShared = make (1048576 .|. 16384)
{-# LINE 161 "System/Linux/Mount.hsc" #-}

-- | Set the @MS_SLAVE@ propagation flag on a mounted filesystem.
makeSlave :: FilePath -> IO ()
makeSlave = make 524288
{-# LINE 165 "System/Linux/Mount.hsc" #-}

-- | Set the @MS_SLAVE@ propagation flag on a mounted filesystem recursively on
-- all submounts.
makeRSlave :: FilePath -> IO ()
makeRSlave = make (524288 .|. 16384)
{-# LINE 170 "System/Linux/Mount.hsc" #-}

-- | Set the @MS_PRIVATE@ propagation flag on a mounted filesystem.
makePrivate :: FilePath -> IO ()
makePrivate = make 262144
{-# LINE 174 "System/Linux/Mount.hsc" #-}

-- | Set the @MS_PRIVATE@ propagation flag on a mounted filesystem and
-- recursively on all submounts.
makeRPrivate :: FilePath -> IO ()
makeRPrivate = make (262144 .|. 16384)
{-# LINE 179 "System/Linux/Mount.hsc" #-}

-- | Set the @MS_UNBINDABLE@ propagation flag on a mounted filesystem.
makeUnbindable :: FilePath -> IO ()
makeUnbindable = make 131072
{-# LINE 183 "System/Linux/Mount.hsc" #-}

-- | Set the @MS_UNBINDABLE@ propagation flag on a mounted filesystem and
-- recursively on all submounts.
makeRUnbindable :: FilePath -> IO ()
makeRUnbindable = make (131072 .|. 16384)
{-# LINE 188 "System/Linux/Mount.hsc" #-}

make :: CUInt -> FilePath -> IO ()
make flag dir =
    throwErrnoIfMinus1_ "mount" $
    withCString dir $ \cdir ->
        c_mount nullPtr cdir nullPtr (fromIntegral flag) nullPtr

foreign import ccall unsafe "mount"
  c_mount :: CString -> CString -> CString -> CULong -> Ptr a -> IO CInt

-- | Unmount a filesystem (call to
-- @<http://man7.org/linux/man-pages/man2/umount.2.html umount()>@).
umount :: FilePath -- ^ Mount point
       -> IO ()
umount str = throwErrnoIfMinus1_ "umount" (withCString str c_umount)

foreign import ccall unsafe "umount"
  c_umount :: CString -> IO CInt

-- | Unmount a filesystem using specific unmount options (call to
-- @<http://man7.org/linux/man-pages/man2/umount.2.html umount2()>@).  See
-- @'UmountFlag'@ for details.
umountWith :: UmountFlag -- ^ Unmount option
           -> SymLink    -- ^ @'Follow'@ or @'NoFollow'@ symbolic links
           -> FilePath   -- ^ Mount point
           -> IO ()
umountWith flag sym str =
    throwErrnoIfMinus1_ "umountWith" $
    withCString str $ \cstr ->
        c_umount2 cstr (fromUmountFlag flag .|. fromSymLink sym)

foreign import ccall unsafe "umount2"
  c_umount2 :: CString -> CInt -> IO CInt

-- | A filesystem independent option to be used when mounting a filesystem.
data MountFlag = ReadOnly     -- ^ Mount read-only (@MS_RDONLY@).
               | NoSUID       -- ^ Ignore suid and sgid bits (@MS_NOSUID@).
               | NoDev        -- ^ Disallow access to device special files
                              -- (@MS_NODEV@).
               | NoExec       -- ^ Disallow program execution (@MS_NOEXEC@).
               | Synchronous  -- ^ Writes are synced at once (@MS_SYNCHRONOUS@).
               | MandLock     -- ^ Allow mandatory locks on a filesystem
                              -- (@MS_MANDLOCK@).
               | DirSync      -- ^ Directory modifications are synchronous
                              -- (@MS_DIRSYNC@).
               | NoATime      -- ^ Do not update access times (@MS_NOATIME@).
               | NoDirATime   -- ^ Do not update directory access times
                              -- (@MS_NODIRATIME@).
               | Silent       -- ^ Silent mount (@MS_SILENT@).
               | PosixACL     -- ^ VFS does not apply the umask (@MS_POSIXACL@).
               | RelATime     -- ^ Update atime relative to mtime/ctime
                              -- (@MS_RELATIME@).
               | IVersion     -- ^ Update inode I_version field
                              -- (@MS_I_VERSION@).
               | StrictATime  -- ^ Always perform atime updates
                              -- (@MS_STRICTATIME@).
                 deriving (Eq, Read, Show)

fromMountFlag :: MountFlag -> CUInt
fromMountFlag ReadOnly    = 1
{-# LINE 248 "System/Linux/Mount.hsc" #-}
fromMountFlag NoSUID      = 2
{-# LINE 249 "System/Linux/Mount.hsc" #-}
fromMountFlag NoDev       = 4
{-# LINE 250 "System/Linux/Mount.hsc" #-}
fromMountFlag NoExec      = 8
{-# LINE 251 "System/Linux/Mount.hsc" #-}
fromMountFlag Synchronous = 16
{-# LINE 252 "System/Linux/Mount.hsc" #-}
fromMountFlag MandLock    = 64
{-# LINE 253 "System/Linux/Mount.hsc" #-}
fromMountFlag DirSync     = 128
{-# LINE 254 "System/Linux/Mount.hsc" #-}
fromMountFlag NoATime     = 1024
{-# LINE 255 "System/Linux/Mount.hsc" #-}
fromMountFlag NoDirATime  = 2048
{-# LINE 256 "System/Linux/Mount.hsc" #-}
fromMountFlag Silent      = 32768
{-# LINE 257 "System/Linux/Mount.hsc" #-}
fromMountFlag PosixACL    = 65536
{-# LINE 258 "System/Linux/Mount.hsc" #-}
fromMountFlag RelATime    = 2097152
{-# LINE 259 "System/Linux/Mount.hsc" #-}
fromMountFlag IVersion    = 8388608
{-# LINE 260 "System/Linux/Mount.hsc" #-}
fromMountFlag StrictATime = 16777216
{-# LINE 261 "System/Linux/Mount.hsc" #-}

-- | Filesystem dependent options to be used when mounting a filesystem; the
-- content of @'DriverData'@ is passed directly to the filesystem driver.
type DriverData = ByteString

-- | Empty @'DriverData'@.
noData :: DriverData
noData = empty

combineBitMasks :: [MountFlag] -> CULong
combineBitMasks = fromIntegral . foldl (.|.) 0 . map fromMountFlag

-- | A filesystem independent option to be used when unmounting a filesystem.
data UmountFlag = Plain  -- ^ Plain unmount, behaves like @'umount'@.
                | Force  -- ^ Force  unmount  even  if busy.
                | Detach -- ^ Perform a lazy unmount: make the mount point
                         -- unavailable for new accesses, and actually perform
                         -- the unmount when the mount point ceases to be busy.
                | Expire -- ^ Mark the mount point as expired. If a mount point
                         -- is not currently in use, then an initial call to
                         -- @'umountWith'@ with this flag fails with the error
                         -- @'Foreign.C.Error.eAGAIN'@, but marks the mount
                         -- point as expired. The mount point remains expired as
                         -- long as it isn't accessed by any process. A second
                         -- @'umountWith'@ call specifying @'Expire'@ unmounts
                         -- an expired mount point.
                  deriving (Eq, Read, Show)

fromUmountFlag :: UmountFlag -> CInt
fromUmountFlag Plain  = 0
fromUmountFlag Force  = 1
{-# LINE 292 "System/Linux/Mount.hsc" #-}
fromUmountFlag Detach = 2
{-# LINE 293 "System/Linux/Mount.hsc" #-}
fromUmountFlag Expire = 4
{-# LINE 294 "System/Linux/Mount.hsc" #-}

-- | Whether to follow symbolic links on umount.
data SymLink = Follow
             | NoFollow
               deriving (Eq, Read, Show)

fromSymLink :: SymLink -> CInt
fromSymLink Follow   = 0
fromSymLink NoFollow = 8
{-# LINE 303 "System/Linux/Mount.hsc" #-}