diff options
author | Joey Hess <joey@kitenet.net> | 2012-07-19 20:38:58 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-07-19 20:38:58 -0400 |
commit | 107a7b9388077a2b7fe9ce107da3a4a5fa396e2e (patch) | |
tree | 687326521de2b4da5b38ef9d3facae9f5aa63ab2 /Utility/Mounts.hsc | |
parent | d5051ec088a443d0fbc0979d0421e62c60ec13f8 (diff) |
try to make Utility.Mounts portable
This is an unholy mashup, but it just might work. It works on Linux,
that's all I've tested. :)
Diffstat (limited to 'Utility/Mounts.hsc')
-rw-r--r-- | Utility/Mounts.hsc | 58 |
1 files changed, 22 insertions, 36 deletions
diff --git a/Utility/Mounts.hsc b/Utility/Mounts.hsc index 622ac877a..6bcb03f2c 100644 --- a/Utility/Mounts.hsc +++ b/Utility/Mounts.hsc @@ -2,6 +2,9 @@ - - Derived from hsshellscript, originally written by - Volker Wysk <hsss@volker-wysk.de> + - + - Modified to support BSD and Mac OS X by + - Joey Hess <joey@kitenet.net> - - Licensed under the GNU LGPL version 2.1 or higher. -} @@ -10,8 +13,7 @@ module Utility.Mounts ( Mntent(..), - read_mtab, - read_fstab, + getMounts ) where import Control.Monad @@ -20,62 +22,46 @@ import Foreign.C import GHC.IO hiding (finally, bracket) import Prelude hiding (catch) -#include <stdio.h> -#include <mntent.h> +#include "libmounts.h" +{- This is a stripped down mntent, containing only + - fields available everywhere. -} data Mntent = Mntent { mnt_fsname :: String , mnt_dir :: String , mnt_type :: String - , mnt_opts :: String - , mnt_freq :: Int - , mnt_passno :: Int } deriving (Read, Show, Eq) -read_mounts :: String -> IO [Mntent] -read_mounts path = do - h <- withCString path $ \cpath -> - withCString "r" $ \r -> - c_setmntent cpath r +getMounts :: IO [Mntent] +getMounts = do + h <- c_mounts_start when (h == nullPtr) $ - throwErrno "setmntent" + throwErrno "getMounts" mntent <- getmntent h [] - _ <- c_endmntent h + _ <- c_mounts_end h return mntent where - getmntent h l = do - ptr <- c_getmntent h + getmntent h c = do + ptr <- c_mounts_next h if (ptr == nullPtr) - then return $ reverse l + then return $ reverse c else do mnt_fsname_str <- #{peek struct mntent, mnt_fsname} ptr >>= peekCString mnt_dir_str <- #{peek struct mntent, mnt_dir} ptr >>= peekCString mnt_type_str <- #{peek struct mntent, mnt_type} ptr >>= peekCString - mnt_opts_str <- #{peek struct mntent, mnt_opts} ptr >>= peekCString - mnt_freq_int <- #{peek struct mntent, mnt_freq} ptr - mnt_passno_int <- #{peek struct mntent, mnt_passno} ptr let ent = Mntent { mnt_fsname = mnt_fsname_str , mnt_dir = mnt_dir_str , mnt_type = mnt_type_str - , mnt_opts = mnt_opts_str - , mnt_freq = mnt_freq_int - , mnt_passno = mnt_passno_int } - getmntent h (ent:l) - -read_mtab :: IO [Mntent] -read_mtab = read_mounts "/etc/mtab" - -read_fstab :: IO [Mntent] -read_fstab = read_mounts "/etc/fstab" + getmntent h (ent:c) -foreign import ccall safe "setmntent" - c_setmntent :: ((Ptr CChar) -> ((Ptr CChar) -> (IO (Ptr ())))) +foreign import ccall unsafe "libmounts.h mounts_start" c_mounts_start + :: IO (Ptr ()) -foreign import ccall safe "endmntent" - c_endmntent :: ((Ptr ()) -> (IO CInt)) +foreign import ccall unsafe "libmounts.h mounts_next" c_mounts_next + :: Ptr () -> IO (Ptr ()) -foreign import ccall safe "getmntent" - c_getmntent :: ((Ptr ()) -> (IO (Ptr ()))) +foreign import ccall unsafe "libmounts.h mounts_end" c_mounts_end + :: Ptr () -> IO CInt |