extacted Mounts.hsc from hsshellscript

Converted from using c2hs to using hsc2hs, just because other code
in git-annex uses hsc2hs.

Various cleanups.

This code is LGPLed, so I had to include that licence.

1 files changed, 81 insertions, 0 deletions

diff --git a/Utility/Mounts.hsc b/Utility/Mounts.hsc
new file mode 100644
index 000000000..622ac877a
--- /dev/null
+++ b/Utility/Mounts.hsc
@@ -0,0 +1,81 @@
+{- Interface to mtab (and fstab)
+ - 
+ - Derived from hsshellscript, originally written by
+ - Volker Wysk <hsss@volker-wysk.de>
+ -
+ - Licensed under the GNU LGPL version 2.1 or higher.
+ -}
+
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Utility.Mounts (
+	Mntent(..),
+	read_mtab,
+	read_fstab,
+) where
+
+import Control.Monad
+import Foreign
+import Foreign.C
+import GHC.IO hiding (finally, bracket)
+import Prelude hiding (catch)
+
+#include <stdio.h>
+#include <mntent.h>
+
+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
+	when (h == nullPtr) $
+		throwErrno "setmntent"
+	mntent <- getmntent h []
+	_ <- c_endmntent h
+	return mntent
+
+	where
+		getmntent h l = do
+			ptr <- c_getmntent h
+			if (ptr == nullPtr)
+				then return $ reverse l
+				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"
+
+foreign import ccall safe "setmntent"
+	c_setmntent :: ((Ptr CChar) -> ((Ptr CChar) -> (IO (Ptr ()))))
+
+foreign import ccall safe "endmntent"
+	c_endmntent :: ((Ptr ()) -> (IO CInt))
+
+foreign import ccall safe "getmntent"
+	c_getmntent :: ((Ptr ()) -> (IO (Ptr ())))