Skip to content

Instantly share code, notes, and snippets.

@krisis
Last active February 27, 2018 12:44
Show Gist options
  • Save krisis/e80b8cf6aeae4f3b08a448607afd5022 to your computer and use it in GitHub Desktop.
Save krisis/e80b8cf6aeae4f3b08a448607afd5022 to your computer and use it in GitHub Desktop.
Haskell FFI for `getmntent(3)`, `setmntent(3)`
{-# LANGUAGE ForeignFunctionInterface #-}
module MountUtils where
import Control.Monad (liftM)
import Foreign.C.Types
import Foreign.C.String
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Alloc
#include "mntent.h"
#c
typedef struct mntent mntent_t;
#endc
-- FILE* is a opaque type
{#pointer *FILE as MntHandle newtype#}
data MntEnt = MntEnt
{ mntFSName :: String
, mntDir :: String
, mntType :: String
, mntOpts :: String
, mntFreq :: Integer
, mntPassNum :: Integer
} deriving Show
{#pointer *mntent_t as MntEntPtr -> MntEnt#}
instance Storable MntEnt where
sizeOf _ = {#sizeof mntent_t #}
alignment _ = 4
peek p = do
fsName <- ({#get mntent_t->mnt_fsname#} p)
fsDir <- ({#get mntent_t->mnt_dir#} p)
fsType <- ({#get mntent_t->mnt_type#} p)
fsOpts <- ({#get mntent_t->mnt_opts#} p)
fsFreq <- ({#get mntent_t->mnt_freq#} p)
fsPassNum <- ({#get mntent_t->mnt_passno#} p)
fsNameStr <- peekCString fsName
fsDirStr <- peekCString fsDir
fsTypeStr <- peekCString fsType
fsOptsStr <- peekCString fsOpts
return $ MntEnt fsNameStr fsDirStr fsTypeStr fsOptsStr (fromIntegral fsFreq) (fromIntegral fsPassNum)
poke p x = do
fsName <- newCString $ mntFSName x
fsDir <- newCString $ mntDir x
fsType <- newCString $ mntType x
fsOpts <- newCString $ mntOpts x
{#set mntent_t.mnt_fsname#} p fsName
{#set mntent_t.mnt_dir#} p fsDir
{#set mntent_t.mnt_type#} p fsType
{#set mntent_t.mnt_opts#} p fsOpts
{#set mntent_t.mnt_freq#} p (fromIntegral $ mntFreq x)
{#set mntent_t.mnt_passno#} p (fromIntegral $ mntPassNum x)
mapM_ free [fsName, fsDir, fsType, fsOpts]
{#fun unsafe setmntent as ^ {`String', `String'} -> `MntHandle'#}
getmntent :: (MntHandle) -> IO ((MntEntPtr))
getmntent h = getmntent'_ h
foreign import ccall unsafe "Sample.chs.h getmntent"
getmntent'_ :: ((MntHandle) -> (IO (C2HSImp.Ptr (MntEnt))))
@krisis
Copy link
Author

krisis commented Feb 27, 2018

To run this,

Install c2hs executable to generate Haskell bindings from C libs

stack install c2hs --> I installed it in my global package db

Command to generate Haskell binding module

c2hs --cppopts='-I/usr/include/' -l Sample.chs

Compile the generated Haskell binding module

ghc Sample.hs

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment