1-- | 2-- Copyright: 2012 Joey Hess <id@joeyh.name> 3-- License: LGPL 2.1 or higher 4-- 5-- Derived from hsshellscript, originally written by 6-- Volker Wysk <hsss@volker-wysk.de> 7 8{-# LANGUAGE ForeignFunctionInterface, CPP #-} 9 10module System.MountPoints ( 11 Mntent(..), 12 getMounts, 13 getProcMounts, 14) where 15 16#include "libmounts.h" 17 18import Control.Monad 19import Control.Exception 20import Data.Maybe 21import Control.Applicative 22import Foreign 23import Foreign.C 24import Prelude 25 26-- | This is a stripped down mntent, containing only fields available 27-- everywhere. 28data Mntent = Mntent 29 { mnt_fsname :: String -- ^ what's mounted 30 , mnt_dir :: FilePath -- ^ where it's mounted 31 , mnt_type :: String -- ^ what sort of filesystem is mounted 32 } deriving (Show, Eq, Ord) 33 34-- | Get currently mounted filesystems. 35-- 36-- This uses eiher getmntent or getmntinfo, depending on the OS. 37getMounts :: IO [Mntent] 38#ifndef linux_android_HOST_OS 39getMounts = do 40 h <- c_mounts_start 41 when (h == nullPtr) $ 42 throwErrno "getMounts" 43 mntent <- getmntent h [] 44 _ <- c_mounts_end h 45 return mntent 46 where 47 getmntent h c = do 48 ptr <- c_mounts_next h 49 if ptr == nullPtr 50 then return (reverse c) 51 else do 52 mnt_fsname_str <- #{peek struct mntent, mnt_fsname} ptr >>= peekCString 53 mnt_dir_str <- #{peek struct mntent, mnt_dir} ptr >>= peekCString 54 mnt_type_str <- #{peek struct mntent, mnt_type} ptr >>= peekCString 55 let ent = Mntent 56 { mnt_fsname = mnt_fsname_str 57 , mnt_dir = mnt_dir_str 58 , mnt_type = mnt_type_str 59 } 60 getmntent h (ent:c) 61#else 62getMounts = getProcMounts 63#endif 64 65#ifndef linux_android_HOST_OS 66-- Using unsafe imports because the C functions are belived to never block. 67-- Note that getmntinfo is called with MNT_NOWAIT to avoid possibly blocking; 68-- while getmntent only accesses a file in /etc (or /proc) that should not 69-- block. 70foreign import ccall unsafe "libmounts.h mounts_start" c_mounts_start 71 :: IO (Ptr ()) 72foreign import ccall unsafe "libmounts.h mounts_next" c_mounts_next 73 :: Ptr () -> IO (Ptr ()) 74foreign import ccall unsafe "libmounts.h mounts_end" c_mounts_end 75 :: Ptr () -> IO CInt 76#endif 77 78-- | Read </proc/mounts> to get currently mounted filesystems. 79-- 80-- This works on Linux and related systems, including Android. 81 82-- Note that on Android, `getMounts` calls this function. 83getProcMounts :: IO [Mntent] 84getProcMounts = do 85 v <- try go :: IO (Either SomeException [Mntent]) 86 return (either (const []) id v) 87 where 88 go = mapMaybe (parse . words) . lines <$> readFile "/proc/mounts" 89 parse (device:mountpoint:fstype:_rest) = Just $ Mntent 90 { mnt_fsname = device 91 , mnt_dir = mountpoint 92 , mnt_type = fstype 93 } 94 parse _ = Nothing 95