{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
-- |functions for mounting, umounting, parsing \/proc\/mounts, etc
module System.Unix.Mount
    ( umountBelow       -- FilePath -> IO [(FilePath, (String, String, ExitCode))]
    , umount            -- [String] -> IO (String, String, ExitCode)
    , isMountPoint      -- FilePath -> IO Bool

    , withMount
    , WithProcAndSys(runWithProcAndSys)
    , withProcAndSys
    , withTmp
    ) where

-- Standard GHC modules

import Control.Monad
import Data.ByteString.Lazy.Char8 (empty)
import Data.List
import System.Directory
import System.Exit
import System.IO (readFile, hPutStrLn, stderr)
import System.Posix.Files
import System.Process (readProcessWithExitCode)

import Control.Applicative (Applicative)
import Control.Exception (catch)
import Control.Monad.Catch (bracket, MonadCatch, MonadMask)
import Control.Monad.Trans (MonadTrans, lift, liftIO, MonadIO)
-- import Control.Monad.Trans.Except ({- ExceptT instances -})
import Data.ByteString.Lazy as L (ByteString, empty)
import GHC.IO.Exception (IOErrorType(OtherError))
import System.Directory (createDirectoryIfMissing)
import System.Exit (ExitCode(ExitFailure, ExitSuccess))
import System.FilePath ((</>))
import System.IO (hPutStrLn, stderr)
import System.IO.Error
import System.Process (CreateProcess, proc)
import System.Process.ListLike (readCreateProcess, showCreateProcessForUser)

-- Local Modules

-- In ghc610 readFile "/proc/mounts" hangs.  Use this instead.
-- rf path = lazyCommand ("cat '" ++ path ++ "'") empty >>= return . (\ (o, _, _) -> o) . collectOutputUnpacked

-- |'umountBelow' - unmounts all mount points below /belowPath/
-- \/proc\/mounts must be present and readable.  Because of the way
-- linux handles changeroots, we can't trust everything we see in
-- \/proc\/mounts.  However, we make the following assumptions:
--
--  (1) there is a one-to-one correspondence between the entries in
--      \/proc\/mounts and the actual mounts, and
--  (2) every mount point we might encounter is a suffix of one of
--      the mount points listed in \/proc\/mounts (because being in a
--      a chroot doesn't affect \/proc\/mounts.)
--
-- So we can search \/proc\/mounts for an entry has the mount point
-- we are looking for as a substring, then add the extra text on
-- the right to our path and try to unmount that.  Then we start
-- again since nested mounts might have been revealed.
--
-- For example, suppose we are chrooted into
-- \/home\/david\/environments\/sid and we call "umountBelow \/proc".  We
-- might see the mount point \/home\/david\/environments\/sid\/proc\/bus\/usb
-- in \/proc\/mounts, which means we need to run "umount \/proc\/bus\/usb".
--
-- See also: 'umountSucceeded'
umountBelow :: Bool     -- ^ Lazy (umount -l flag) if true
            -> FilePath -- ^ canonicalised, absolute path
            -> IO [(FilePath, (ExitCode, String, String))] -- ^ paths that we attempted to umount, and the responding output from the umount command
umountBelow :: Bool -> String -> IO [(String, (ExitCode, String, String))]
umountBelow Bool
lazy String
belowPath =
    do String
procMount <- String -> IO String
readFile String
"/proc/mounts"
       let mountPoints :: [String]
mountPoints = forall a b. (a -> b) -> [a] -> [b]
map (String -> String
unescape forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> Int -> a
!! Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) (String -> [String]
lines String
procMount)
           maybeMounts :: [String]
maybeMounts = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
belowPath) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [[a]]
tails [String]
mountPoints))
           args :: String -> [String]
args String
path = [String
"-f"] forall a. [a] -> [a] -> [a]
++ if Bool
lazy then [String
"-l"] else [] forall a. [a] -> [a] -> [a]
++ [String
path]
       [String]
needsUmount <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
isMountPoint [String]
maybeMounts
       [(String, (ExitCode, String, String))]
results <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ String
path -> Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"umountBelow: umount " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
" " (String -> [String]
args String
path)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> IO (ExitCode, String, String)
umount (String -> [String]
args String
path) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((,) String
path)) [String]
needsUmount
       let results' :: [(String, (ExitCode, String, String))]
results' = forall a b. (a -> b) -> [a] -> [b]
map (String, (ExitCode, String, String))
-> (String, (ExitCode, String, String))
fixNotMounted [(String, (ExitCode, String, String))]
results
       forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ ((String, (ExitCode, String, String))
result, (String, (ExitCode, String, String))
result') -> Handle -> String -> IO ()
hPutStrLn Handle
stderr (forall a. Show a => a -> String
show (String, (ExitCode, String, String))
result forall a. [a] -> [a] -> [a]
++ (if (String, (ExitCode, String, String))
result forall a. Eq a => a -> a -> Bool
/= (String, (ExitCode, String, String))
result' then String
" -> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (String, (ExitCode, String, String))
result' else String
""))) (forall a b. [a] -> [b] -> [(a, b)]
zip [(String, (ExitCode, String, String))]
results [(String, (ExitCode, String, String))]
results')
       -- Did /proc/mounts change?  If so we should try again because
       -- nested mounts might have been revealed.
       String
procMount' <- String -> IO String
readFile String
"/proc/mounts"
       [(String, (ExitCode, String, String))]
results'' <- if String
procMount forall a. Eq a => a -> a -> Bool
/= String
procMount' then Bool -> String -> IO [(String, (ExitCode, String, String))]
umountBelow Bool
lazy String
belowPath else forall (m :: * -> *) a. Monad m => a -> m a
return []
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [(String, (ExitCode, String, String))]
results' forall a. [a] -> [a] -> [a]
++ [(String, (ExitCode, String, String))]
results''
    where
      fixNotMounted :: (String, (ExitCode, String, String))
-> (String, (ExitCode, String, String))
fixNotMounted (String
path, (ExitFailure Int
1, String
"", String
err)) | String
err forall a. Eq a => a -> a -> Bool
== (String
"umount: " forall a. [a] -> [a] -> [a]
++ String
path forall a. [a] -> [a] -> [a]
++ String
": not mounted\n") = (String
path, (ExitCode
ExitSuccess, String
"", String
""))
      fixNotMounted (String, (ExitCode, String, String))
x = (String, (ExitCode, String, String))
x

-- |umountSucceeded - predicated suitable for filtering results of 'umountBelow'
umountSucceeded :: (FilePath, (String, String, ExitCode)) -> Bool
umountSucceeded :: (String, (String, String, ExitCode)) -> Bool
umountSucceeded (String
_, (String
_,String
_,ExitCode
ExitSuccess)) = Bool
True
umountSucceeded (String, (String, String, ExitCode))
_ = Bool
False

-- |'unescape' - unescape function for strings in \/proc\/mounts
unescape :: String -> String
unescape :: String -> String
unescape [] = []
unescape (Char
'\\':Char
'0':Char
'4':Char
'0':String
rest) = Char
' ' forall a. a -> [a] -> [a]
: (String -> String
unescape String
rest)
unescape (Char
'\\':Char
'0':Char
'1':Char
'1':String
rest) = Char
'\t' forall a. a -> [a] -> [a]
: (String -> String
unescape String
rest)
unescape (Char
'\\':Char
'0':Char
'1':Char
'2':String
rest) = Char
'\n' forall a. a -> [a] -> [a]
: (String -> String
unescape String
rest)
unescape (Char
'\\':Char
'1':Char
'3':Char
'4':String
rest) = Char
'\\' forall a. a -> [a] -> [a]
: (String -> String
unescape String
rest)
unescape (Char
c:String
rest) = Char
c forall a. a -> [a] -> [a]
: (String -> String
unescape String
rest)

-- |'escape' - \/proc\/mount style string escaper
escape :: String -> String
escape :: String -> String
escape [] = []
escape (Char
' ':String
rest)  = (Char
'\\'forall a. a -> [a] -> [a]
:Char
'0'forall a. a -> [a] -> [a]
:Char
'4'forall a. a -> [a] -> [a]
:Char
'0'forall a. a -> [a] -> [a]
:String -> String
escape String
rest)
escape (Char
'\t':String
rest) = (Char
'\\'forall a. a -> [a] -> [a]
:Char
'0'forall a. a -> [a] -> [a]
:Char
'1'forall a. a -> [a] -> [a]
:Char
'1'forall a. a -> [a] -> [a]
:String -> String
escape String
rest)
escape (Char
'\n':String
rest) = (Char
'\\'forall a. a -> [a] -> [a]
:Char
'0'forall a. a -> [a] -> [a]
:Char
'1'forall a. a -> [a] -> [a]
:Char
'2'forall a. a -> [a] -> [a]
:String -> String
escape String
rest)
escape (Char
'\\':String
rest) = (Char
'\\'forall a. a -> [a] -> [a]
:Char
'1'forall a. a -> [a] -> [a]
:Char
'3'forall a. a -> [a] -> [a]
:Char
'4'forall a. a -> [a] -> [a]
:String -> String
escape String
rest)
escape (Char
c:String
rest)    = Char
c forall a. a -> [a] -> [a]
: (String -> String
escape String
rest)


-- |'umount' - run umount with the specified args
-- NOTE: this function uses exec, so you do /not/ need to shell-escape
-- NOTE: we don't use the umount system call because the system call
-- is not smart enough to update \/etc\/mtab
umount :: [String] -> IO (ExitCode, String, String)
umount :: [String] -> IO (ExitCode, String, String)
umount [String]
args = String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"umount" [String]
args String
""

isMountPoint :: FilePath -> IO Bool
-- This implements the functionality of mountpoint(1), deciding
-- whether a path is a mountpoint by seeing whether it is on a
-- different device from its parent.  It would fail if a file system
-- is mounted directly inside itself, but I think maybe that isn't
-- allowed.
isMountPoint :: String -> IO Bool
isMountPoint String
path =
    do
      Bool
exists <- String -> IO Bool
doesDirectoryExist (String
path forall a. [a] -> [a] -> [a]
++ String
"/.")
      Bool
parentExists <- String -> IO Bool
doesDirectoryExist (String
path forall a. [a] -> [a] -> [a]
++ String
"/..")
      case (Bool
exists, Bool
parentExists) of
        (Bool
True, Bool
True) ->
            do
              DeviceID
id <- String -> IO FileStatus
getFileStatus (String
path forall a. [a] -> [a] -> [a]
++ String
"/.") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> DeviceID
deviceID
              DeviceID
parentID <- String -> IO FileStatus
getFileStatus (String
path forall a. [a] -> [a] -> [a]
++ String
"/..") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> DeviceID
deviceID
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DeviceID
id forall a. Eq a => a -> a -> Bool
/= DeviceID
parentID
        (Bool, Bool)
_ ->
            -- It is hard to know what is going on if . or .. don't exist.
            -- Assume we are seeing some sort of mount point.
            forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

readProcess :: CreateProcess -> L.ByteString -> IO L.ByteString
readProcess :: CreateProcess -> ByteString -> IO ByteString
readProcess CreateProcess
p ByteString
input = do
  (ExitCode
code, ByteString
out, ByteString
_err) <- forall maker text result char.
(ProcessMaker maker, ProcessResult text result,
 ListLikeProcessIO text char) =>
maker -> text -> IO result
readCreateProcess CreateProcess
p ByteString
input :: IO (ExitCode, L.ByteString, L.ByteString)
  case ExitCode
code of
    ExitFailure Int
n -> forall a. IOError -> IO a
ioError (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
OtherError (CreateProcess -> String
showCreateProcessForUser CreateProcess
p forall a. [a] -> [a] -> [a]
++ String
" -> " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n) forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
    ExitCode
ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
out

-- | Do an IO task with a file system remounted using mount --bind.
-- This was written to set up a build environment.
withMount :: (MonadIO m, MonadMask m) => FilePath -> FilePath -> m a -> m a
withMount :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> String -> m a -> m a
withMount String
directory String
mountpoint m a
task =
    forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket m ByteString
pre (\ ByteString
_ -> m ByteString
post) (\ ByteString
_ -> m a
task)
    where
      mount :: CreateProcess
mount = String -> [String] -> CreateProcess
proc String
"mount" [String
"--bind", String
directory, String
mountpoint]
      umount :: CreateProcess
umount = String -> [String] -> CreateProcess
proc String
"umount" [String
mountpoint]
      umountLazy :: CreateProcess
umountLazy = String -> [String] -> CreateProcess
proc String
"umount" [String
"-l", String
mountpoint]

      pre :: m ByteString
pre = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do -- hPutStrLn stderr $ "mounting /proc at " ++ show mountpoint
                        Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
mountpoint
                        CreateProcess -> ByteString -> IO ByteString
readProcess CreateProcess
mount ByteString
L.empty

      post :: m ByteString
post = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do -- hPutStrLn stderr $ "unmounting /proc at " ++ show mountpoint
                         CreateProcess -> ByteString -> IO ByteString
readProcess CreateProcess
umount ByteString
L.empty
                           forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\ (IOError
e :: IOError) ->
                                        do Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Exception unmounting " forall a. [a] -> [a] -> [a]
++ String
mountpoint forall a. [a] -> [a] -> [a]
++ String
", trying -l: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IOError
e)
                                           CreateProcess -> ByteString -> IO ByteString
readProcess CreateProcess
umountLazy ByteString
L.empty)

-- | Monad transformer to ensure that /proc and /sys are mounted
-- during a computation.
newtype WithProcAndSys m a = WithProcAndSys { forall (m :: * -> *) a. WithProcAndSys m a -> m a
runWithProcAndSys :: m a } deriving (forall a b. a -> WithProcAndSys m b -> WithProcAndSys m a
forall a b. (a -> b) -> WithProcAndSys m a -> WithProcAndSys m b
forall (m :: * -> *) a b.
Functor m =>
a -> WithProcAndSys m b -> WithProcAndSys m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithProcAndSys m a -> WithProcAndSys m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> WithProcAndSys m b -> WithProcAndSys m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> WithProcAndSys m b -> WithProcAndSys m a
fmap :: forall a b. (a -> b) -> WithProcAndSys m a -> WithProcAndSys m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithProcAndSys m a -> WithProcAndSys m b
Functor, forall a. a -> WithProcAndSys m a
forall a b.
WithProcAndSys m a -> WithProcAndSys m b -> WithProcAndSys m b
forall a b.
WithProcAndSys m a
-> (a -> WithProcAndSys m b) -> WithProcAndSys m b
forall {m :: * -> *}. Monad m => Applicative (WithProcAndSys m)
forall (m :: * -> *) a. Monad m => a -> WithProcAndSys m a
forall (m :: * -> *) a b.
Monad m =>
WithProcAndSys m a -> WithProcAndSys m b -> WithProcAndSys m b
forall (m :: * -> *) a b.
Monad m =>
WithProcAndSys m a
-> (a -> WithProcAndSys m b) -> WithProcAndSys m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> WithProcAndSys m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> WithProcAndSys m a
>> :: forall a b.
WithProcAndSys m a -> WithProcAndSys m b -> WithProcAndSys m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
WithProcAndSys m a -> WithProcAndSys m b -> WithProcAndSys m b
>>= :: forall a b.
WithProcAndSys m a
-> (a -> WithProcAndSys m b) -> WithProcAndSys m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
WithProcAndSys m a
-> (a -> WithProcAndSys m b) -> WithProcAndSys m b
Monad, forall a. a -> WithProcAndSys m a
forall a b.
WithProcAndSys m a -> WithProcAndSys m b -> WithProcAndSys m a
forall a b.
WithProcAndSys m a -> WithProcAndSys m b -> WithProcAndSys m b
forall a b.
WithProcAndSys m (a -> b)
-> WithProcAndSys m a -> WithProcAndSys m b
forall a b c.
(a -> b -> c)
-> WithProcAndSys m a -> WithProcAndSys m b -> WithProcAndSys m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (WithProcAndSys m)
forall (m :: * -> *) a. Applicative m => a -> WithProcAndSys m a
forall (m :: * -> *) a b.
Applicative m =>
WithProcAndSys m a -> WithProcAndSys m b -> WithProcAndSys m a
forall (m :: * -> *) a b.
Applicative m =>
WithProcAndSys m a -> WithProcAndSys m b -> WithProcAndSys m b
forall (m :: * -> *) a b.
Applicative m =>
WithProcAndSys m (a -> b)
-> WithProcAndSys m a -> WithProcAndSys m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithProcAndSys m a -> WithProcAndSys m b -> WithProcAndSys m c
<* :: forall a b.
WithProcAndSys m a -> WithProcAndSys m b -> WithProcAndSys m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
WithProcAndSys m a -> WithProcAndSys m b -> WithProcAndSys m a
*> :: forall a b.
WithProcAndSys m a -> WithProcAndSys m b -> WithProcAndSys m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
WithProcAndSys m a -> WithProcAndSys m b -> WithProcAndSys m b
liftA2 :: forall a b c.
(a -> b -> c)
-> WithProcAndSys m a -> WithProcAndSys m b -> WithProcAndSys m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithProcAndSys m a -> WithProcAndSys m b -> WithProcAndSys m c
<*> :: forall a b.
WithProcAndSys m (a -> b)
-> WithProcAndSys m a -> WithProcAndSys m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
WithProcAndSys m (a -> b)
-> WithProcAndSys m a -> WithProcAndSys m b
pure :: forall a. a -> WithProcAndSys m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> WithProcAndSys m a
Applicative)

instance MonadTrans WithProcAndSys where
    lift :: forall (m :: * -> *) a. Monad m => m a -> WithProcAndSys m a
lift = forall (m :: * -> *) a. m a -> WithProcAndSys m a
WithProcAndSys

instance MonadIO m => MonadIO (WithProcAndSys m) where
    liftIO :: forall a. IO a -> WithProcAndSys m a
liftIO IO a
task = forall (m :: * -> *) a. m a -> WithProcAndSys m a
WithProcAndSys (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
task)

-- | Mount /proc and /sys in the specified build root and execute a
-- task.  Typically, the task would start with a chroot into the build
-- root.  If the build root given is "/" it is assumed that the file
-- systems are already mounted, no mounting or unmounting is done.
withProcAndSys :: (MonadIO m, MonadMask m) => FilePath -> WithProcAndSys m a -> m a
withProcAndSys :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> WithProcAndSys m a -> m a
withProcAndSys String
"/" WithProcAndSys m a
task = forall (m :: * -> *) a. WithProcAndSys m a -> m a
runWithProcAndSys WithProcAndSys m a
task
withProcAndSys String
root WithProcAndSys m a
task = do
  Bool
exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
root
  case Bool
exists of
    Bool
True -> forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> String -> m a -> m a
withMount String
"/proc" (String
root String -> String -> String
</> String
"proc") forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> String -> m a -> m a
withMount String
"/sys" (String
root String -> String -> String
</> String
"sys") forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. WithProcAndSys m a -> m a
runWithProcAndSys WithProcAndSys m a
task
    Bool
False -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IOError -> IO a
ioError forall a b. (a -> b) -> a -> b
$ IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
doesNotExistErrorType String
"chroot directory does not exist" forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just String
root)

-- | Do an IO task with /tmp remounted.  This could be used
-- to share /tmp with a build root.
withTmp :: (MonadIO m, MonadMask m) => FilePath -> m a -> m a
withTmp :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> m a -> m a
withTmp String
root m a
task = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> String -> m a -> m a
withMount String
"/tmp" (String
root String -> String -> String
</> String
"tmp") m a
task