{-# LINE 1 "Utility/Mounts.hsc" #-} {- Interface to mtab (and fstab) {-# LINE 2 "Utility/Mounts.hsc" #-} - - Derived from hsshellscript, originally written by - Volker Wysk - - Modified to support BSD and Mac OS X by - Joey Hess - - Licensed under the GNU LGPL version 2.1 or higher. -} {-# LANGUAGE ForeignFunctionInterface #-} module Utility.Mounts ( Mntent(..), getMounts ) where import Control.Monad import Foreign import Foreign.C import GHC.IO hiding (finally, bracket) import Prelude hiding (catch) {-# LINE 26 "Utility/Mounts.hsc" #-} {- This is a stripped down mntent, containing only - fields available everywhere. -} data Mntent = Mntent { mnt_fsname :: String , mnt_dir :: String , mnt_type :: String } deriving (Read, Show, Eq, Ord) getMounts :: IO [Mntent] getMounts = do h <- c_mounts_start when (h == nullPtr) $ throwErrno "getMounts" mntent <- getmntent h [] _ <- c_mounts_end h return mntent where getmntent h c = do ptr <- c_mounts_next h if (ptr == nullPtr) then return $ reverse c else do mnt_fsname_str <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr >>= peekCString {-# LINE 51 "Utility/Mounts.hsc" #-} mnt_dir_str <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr >>= peekCString {-# LINE 52 "Utility/Mounts.hsc" #-} mnt_type_str <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr >>= peekCString {-# LINE 53 "Utility/Mounts.hsc" #-} let ent = Mntent { mnt_fsname = mnt_fsname_str , mnt_dir = mnt_dir_str , mnt_type = mnt_type_str } getmntent h (ent:c) {- Using unsafe imports because the C functions are belived to never block. - Note that getmntinfo is called with MNT_NOWAIT to avoid possibly blocking; - while getmntent only accesses a file in /etc (or /proc) that should not - block. -} foreign import ccall unsafe "libmounts.h mounts_start" c_mounts_start :: IO (Ptr ()) foreign import ccall unsafe "libmounts.h mounts_next" c_mounts_next :: Ptr () -> IO (Ptr ()) foreign import ccall unsafe "libmounts.h mounts_end" c_mounts_end :: Ptr () -> IO CInt