module System.Unix.Mount
(umountBelow,
umount,
isMountPoint)
where
import Control.Monad
import Data.ByteString.Lazy.Char8 (empty)
import Data.List
import System.Directory
import System.Exit
import System.IO (readFile)
import System.Posix.Files
import System.Unix.Process
import System.Unix.QIO (quieter, qPutStrLn)
import System.Unix.Process
umountBelow :: Bool
-> FilePath
-> IO [(FilePath, (String, String, ExitCode))]
umountBelow lazy belowPath = quieter (\x->x9) $
do procMount <- readFile "/proc/mounts"
let mountPoints = map (unescape . (!! 1) . words) (lines procMount)
maybeMounts = filter (isPrefixOf belowPath) (concat (map tails mountPoints))
args path = ["-f"] ++ if lazy then ["-l"] else [] ++ [path]
needsUmount <- filterM isMountPoint maybeMounts
results <- mapM (\ path -> qPutStrLn ("umountBelow: umount " ++ intercalate " " (args path)) >> umount (args path) >>= return . ((,) path)) needsUmount
let results' = map fixNotMounted results
mapM_ (\ (result, result') -> qPutStrLn (show result ++ (if result /= result' then " -> " ++ show result' else ""))) (zip results results')
procMount' <- readFile "/proc/mounts"
results'' <- if procMount /= procMount' then umountBelow lazy belowPath else return []
return $ results' ++ results''
where
fixNotMounted (path, ("", err, ExitFailure 1)) | err == ("umount: " ++ path ++ ": not mounted\n") = (path, ("", "" , ExitSuccess))
fixNotMounted x = x
umountSucceeded :: (FilePath, (String, String, ExitCode)) -> Bool
umountSucceeded (_, (_,_,ExitSuccess)) = True
umountSucceeded _ = False
unescape :: String -> String
unescape [] = []
unescape ('\\':'0':'4':'0':rest) = ' ' : (unescape rest)
unescape ('\\':'0':'1':'1':rest) = '\t' : (unescape rest)
unescape ('\\':'0':'1':'2':rest) = '\n' : (unescape rest)
unescape ('\\':'1':'3':'4':rest) = '\\' : (unescape rest)
unescape (c:rest) = c : (unescape rest)
escape :: String -> String
escape [] = []
escape (' ':rest) = ('\\':'0':'4':'0':escape rest)
escape ('\t':rest) = ('\\':'0':'1':'1':escape rest)
escape ('\n':rest) = ('\\':'0':'1':'2':escape rest)
escape ('\\':rest) = ('\\':'1':'3':'4':escape rest)
escape (c:rest) = c : (escape rest)
umount :: [String] -> IO (String, String, ExitCode)
umount args = lazyProcess "umount" args Nothing Nothing empty >>= return . collectOutputUnpacked
isMountPoint :: FilePath -> IO Bool
isMountPoint path =
do
exists <- doesDirectoryExist (path ++ "/.")
parentExists <- doesDirectoryExist (path ++ "/..")
case (exists, parentExists) of
(True, True) ->
do
id <- getFileStatus (path ++ "/.") >>= return . deviceID
parentID <- getFileStatus (path ++ "/..") >>= return . deviceID
return $ id /= parentID
_ ->
return True