Some some

unix/System/Posix/DynamicLinker/ByteString.hsc

@@ -0,0 +1,73 @@
+#if __GLASGOW_HASKELL__ >= 709
+{-# LANGUAGE Safe #-}
+#else
+{-# LANGUAGE Trustworthy #-}
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Posix.DynamicLinker.ByteString
+-- Copyright   :  (c) Volker Stolz <vs@foldr.org> 2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  vs@foldr.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires POSIX)
+--
+-- Dynamic linker support through dlopen()
+-----------------------------------------------------------------------------
+
+module System.Posix.DynamicLinker.ByteString (
+
+    module System.Posix.DynamicLinker.Prim,
+    dlopen,
+    dlsym,
+    dlerror,
+    dlclose,
+    withDL, withDL_,
+    undl,
+    )
+
+--  Usage:
+--  ******
+--
+--  Let's assume you want to open a local shared library \'foo\' (.\/libfoo.so)
+--  offering a function
+--    @char \* mogrify (char\*,int)@
+--  and invoke @str = mogrify("test",1)@:
+--
+--
+--  type Fun = CString -> Int -> IO CString
+--  foreign import dynamic unsafe fun__ :: FunPtr Fun -> Fun
+--
+--  withDL "libfoo.so" [RTLD_NOW] \$ \\ mod -> do
+--     funptr <- dlsym mod "mogrify"
+--     let fun = fun__ funptr
+--     withCString "test" \$ \\ str -> do
+--       strptr <- fun str 1
+--       strstr <- peekCString strptr
+--       ...
+--
+
+where
+
+import System.Posix.DynamicLinker.Common
+import System.Posix.DynamicLinker.Prim
+
+#include "HsUnix.h"
+
+import Control.Exception        ( bracket )
+import Control.Monad    ( liftM )
+import Foreign
+import System.Posix.ByteString.FilePath
+
+dlopen :: RawFilePath -> [RTLDFlags] -> IO DL
+dlopen path flags = do
+  withFilePath path $ \ p -> do
+    liftM DLHandle $ throwDLErrorIf "dlopen" (== nullPtr) $ c_dlopen p (packRTLDFlags flags)
+
+withDL :: RawFilePath -> [RTLDFlags] -> (DL -> IO a) -> IO a
+withDL file flags f = bracket (dlopen file flags) (dlclose) f
+
+withDL_ :: RawFilePath -> [RTLDFlags] -> (DL -> IO a) -> IO ()
+withDL_ file flags f = withDL file flags f >> return ()

unix/System/Posix/DynamicLinker/Common.hsc

@@ -0,0 +1,92 @@
+#if __GLASGOW_HASKELL__ >= 709
+{-# LANGUAGE Safe #-}
+#else
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Posix.DynamicLinker.Common
+-- Copyright   :  (c) Volker Stolz <vs@foldr.org> 2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  vs@foldr.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires POSIX)
+--
+-- Dynamic linker support through dlopen()
+-----------------------------------------------------------------------------
+
+module System.Posix.DynamicLinker.Common (
+
+    module System.Posix.DynamicLinker.Prim,
+    dlsym,
+    dlerror,
+    dlclose,
+    undl,
+    throwDLErrorIf,
+    Module(..)
+    )
+
+--  Usage:
+--  ******
+--
+--  Let's assume you want to open a local shared library \'foo\' (.\/libfoo.so)
+--  offering a function
+--    @char \* mogrify (char\*,int)@
+--  and invoke @str = mogrify("test",1)@:
+--
+--
+--  type Fun = CString -> Int -> IO CString
+--  foreign import dynamic unsafe fun__ :: FunPtr Fun -> Fun
+--
+--  withDL "libfoo.so" [RTLD_NOW] \$ \\ mod -> do
+--     funptr <- dlsym mod "mogrify"
+--     let fun = fun__ funptr
+--     withCString "test" \$ \\ str -> do
+--       strptr <- fun str 1
+--       strstr <- peekCString strptr
+--       ...
+--
+
+where
+
+#include "HsUnix.h"
+
+import System.Posix.DynamicLinker.Prim
+import Foreign
+import Foreign.C
+
+dlclose :: DL -> IO ()
+dlclose (DLHandle h) = throwDLErrorIf_ "dlclose" (/= 0) $ c_dlclose h
+dlclose h = error $ "dlclose: invalid argument" ++ (show h)
+
+dlerror :: IO String
+dlerror = c_dlerror >>= peekCString
+
+-- |'dlsym' returns the address binding of the symbol described in @symbol@,
+-- as it occurs in the shared object identified by @source@.
+
+dlsym :: DL -> String -> IO (FunPtr a)
+dlsym source symbol = do
+  withCAString symbol $ \ s -> do
+    throwDLErrorIf "dlsym" (== nullFunPtr) $ c_dlsym (packDL source) s
+
+-- |'undl' obtains the raw handle. You mustn't do something like
+-- @withDL mod flags $ liftM undl >>= \ p -> use p@
+
+undl :: DL -> Ptr ()
+undl = packDL
+
+throwDLErrorIf :: String -> (a -> Bool) -> IO a -> IO a
+throwDLErrorIf s p f = do
+  r <- f
+  if (p r)
+    then dlerror >>= \ err -> ioError (userError ( s ++ ": " ++ err))
+    else return r
+
+throwDLErrorIf_ :: String -> (a -> Bool) -> IO a -> IO ()
+throwDLErrorIf_ s p f = throwDLErrorIf s p f >> return ()
+
+-- abstract handle for dynamically loaded module (EXPORTED)
+--
+newtype Module = Module (Ptr ())

unix/System/Posix/DynamicLinker/Module.hsc

@@ -0,0 +1,121 @@
+#if __GLASGOW_HASKELL__ >= 709
+{-# LANGUAGE Safe #-}
+#else
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Posix.DynamicLinker.Module
+-- Copyright   :  (c) Volker Stolz <vs@foldr.org> 2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  vs@foldr.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires POSIX)
+--
+-- DLOpen support, old API
+--  Derived from GModule.chs by M.Weber & M.Chakravarty which is part of c2hs
+--  I left the API more or less the same, mostly the flags are different.
+--
+-----------------------------------------------------------------------------
+
+module System.Posix.DynamicLinker.Module (
+
+--  Usage:
+--  ******
+--
+--  Let's assume you want to open a local shared library 'foo' (./libfoo.so)
+--  offering a function
+--    char * mogrify (char*,int)
+--  and invoke str = mogrify("test",1):
+--
+--  type Fun = CString -> Int -> IO CString
+--  foreign import dynamic unsafe fun__ :: FunPtr Fun -> Fun
+--
+--  withModule (Just ".") ("libfoo.so") [RTLD_NOW] $ \ mod -> do
+--     funptr <- moduleSymbol mod "mogrify"
+--     let fun = fun__ funptr
+--     withCString "test" $ \ str -> do
+--       strptr <- fun str 1
+--       strstr <- peekCString strptr
+--       ...
+
+      Module
+    , moduleOpen             -- :: String -> ModuleFlags -> IO Module
+    , moduleSymbol           -- :: Source -> String -> IO (FunPtr a)
+    , moduleClose            -- :: Module -> IO Bool
+    , moduleError            -- :: IO String
+    , withModule             -- :: Maybe String
+                             -- -> String
+                             -- -> [ModuleFlags ]
+                             -- -> (Module -> IO a)
+                             -- -> IO a
+    , withModule_            -- :: Maybe String
+                             -- -> String
+                             -- -> [ModuleFlags]
+                             -- -> (Module -> IO a)
+                             -- -> IO ()
+    )
+where
+
+#include "HsUnix.h"
+
+import System.Posix.DynamicLinker
+import System.Posix.DynamicLinker.Common
+import Foreign.Ptr      ( Ptr, nullPtr, FunPtr )
+import System.Posix.Internals ( withFilePath )
+
+unModule              :: Module -> (Ptr ())
+unModule (Module adr)  = adr
+
+-- Opens a module (EXPORTED)
+--
+
+moduleOpen :: String -> [RTLDFlags] -> IO Module
+moduleOpen file flags = do
+  modPtr <- withFilePath file $ \ modAddr -> c_dlopen modAddr (packRTLDFlags flags)
+  if (modPtr == nullPtr)
+      then moduleError >>= \ err -> ioError (userError ("dlopen: " ++ err))
+      else return $ Module modPtr
+
+-- Gets a symbol pointer from a module (EXPORTED)
+--
+moduleSymbol :: Module -> String -> IO (FunPtr a)
+moduleSymbol file sym = dlsym (DLHandle (unModule file)) sym
+
+-- Closes a module (EXPORTED)
+--
+moduleClose     :: Module -> IO ()
+moduleClose file  = dlclose (DLHandle (unModule file))
+
+-- Gets a string describing the last module error (EXPORTED)
+--
+moduleError :: IO String
+moduleError  = dlerror
+
+
+-- Convenience function, cares for module open- & closing
+-- additionally returns status of `moduleClose' (EXPORTED)
+--
+withModule :: Maybe String
+           -> String
+           -> [RTLDFlags]
+           -> (Module -> IO a)
+           -> IO a
+withModule mdir file flags p = do
+  let modPath = case mdir of
+                  Nothing -> file
+                  Just dir  -> dir ++ if ((head (reverse dir)) == '/')
+                                       then file
+                                       else ('/':file)
+  modu <- moduleOpen modPath flags
+  result <- p modu
+  moduleClose modu
+  return result
+
+withModule_ :: Maybe String
+            -> String
+            -> [RTLDFlags]
+            -> (Module -> IO a)
+            -> IO ()
+withModule_ dir file flags p = withModule dir file flags p >>= \ _ -> return ()

unix/System/Posix/DynamicLinker/Module/ByteString.hsc

@@ -0,0 +1,79 @@
+#if __GLASGOW_HASKELL__ >= 709
+{-# LANGUAGE Safe #-}
+#else
+{-# LANGUAGE Trustworthy #-}
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Posix.DynamicLinker.Module.ByteString
+-- Copyright   :  (c) Volker Stolz <vs@foldr.org> 2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  vs@foldr.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires POSIX)
+--
+-- DLOpen support, old API
+--  Derived from GModule.chs by M.Weber & M.Chakravarty which is part of c2hs
+--  I left the API more or less the same, mostly the flags are different.
+--
+-----------------------------------------------------------------------------
+
+module System.Posix.DynamicLinker.Module.ByteString (
+
+--  Usage:
+--  ******
+--
+--  Let's assume you want to open a local shared library 'foo' (./libfoo.so)
+--  offering a function
+--    char * mogrify (char*,int)
+--  and invoke str = mogrify("test",1):
+--
+--  type Fun = CString -> Int -> IO CString
+--  foreign import dynamic unsafe fun__ :: FunPtr Fun -> Fun
+--
+--  withModule (Just ".") ("libfoo.so") [RTLD_NOW] $ \ mod -> do
+--     funptr <- moduleSymbol mod "mogrify"
+--     let fun = fun__ funptr
+--     withCString "test" $ \ str -> do
+--       strptr <- fun str 1
+--       strstr <- peekCString strptr
+--       ...
+
+      Module
+    , moduleOpen             -- :: String -> ModuleFlags -> IO Module
+    , moduleSymbol           -- :: Source -> String -> IO (FunPtr a)
+    , moduleClose            -- :: Module -> IO Bool
+    , moduleError            -- :: IO String
+    , withModule             -- :: Maybe String
+                             -- -> String
+                             -- -> [ModuleFlags ]
+                             -- -> (Module -> IO a)
+                             -- -> IO a
+    , withModule_            -- :: Maybe String
+                             -- -> String
+                             -- -> [ModuleFlags]
+                             -- -> (Module -> IO a)
+                             -- -> IO ()
+    )
+where
+
+#include "HsUnix.h"
+
+import System.Posix.DynamicLinker.Module hiding (moduleOpen)
+import System.Posix.DynamicLinker.Prim
+import System.Posix.DynamicLinker.Common
+
+import Foreign
+import System.Posix.ByteString.FilePath
+
+-- Opens a module (EXPORTED)
+--
+
+moduleOpen :: RawFilePath -> [RTLDFlags] -> IO Module
+moduleOpen file flags = do
+  modPtr <- withFilePath file $ \ modAddr -> c_dlopen modAddr (packRTLDFlags flags)
+  if (modPtr == nullPtr)
+      then moduleError >>= \ err -> ioError (userError ("dlopen: " ++ err))
+      else return $ Module modPtr

unix/System/Posix/DynamicLinker/Prim.hsc

@@ -0,0 +1,123 @@
+{-# LANGUAGE Trustworthy #-}
+#if __GLASGOW_HASKELL__ >= 709
+{-# OPTIONS_GHC -fno-warn-trustworthy-safe #-}
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Posix.DynamicLinker.Prim
+-- Copyright   :  (c) Volker Stolz <vs@foldr.org> 2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  vs@foldr.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires POSIX)
+--
+-- @dlopen(3)@ and friends
+--  Derived from @GModule.chs@ by M.Weber & M.Chakravarty which is part of c2hs.
+--  I left the API more or less the same, mostly the flags are different.
+--
+-----------------------------------------------------------------------------
+
+module System.Posix.DynamicLinker.Prim (
+  -- * low level API
+  c_dlopen,
+  c_dlsym,
+  c_dlerror,
+  c_dlclose,
+  -- dlAddr, -- XXX NYI
+  haveRtldNext,
+  haveRtldLocal,
+  packRTLDFlags,
+  RTLDFlags(..),
+  packDL,
+  DL(..),
+ )
+
+where
+
+#include "HsUnix.h"
+
+import Data.Bits        ( (.|.) )
+import Foreign.Ptr      ( Ptr, FunPtr, nullPtr )
+import Foreign.C.Types
+import Foreign.C.String ( CString )
+
+
+-- |On some hosts (e.g. SuSe and Ubuntu Linux) @RTLD_NEXT@ (and
+-- @RTLD_DEFAULT@) are not visible without setting the macro
+-- @_GNU_SOURCE@. Since we don\'t want to define this macro, you can use
+-- the function 'haveRtldNext' to check wether the flag `Next` is
+-- available. Ideally, this will be optimized by the compiler so that it
+-- should be as efficient as an @#ifdef@.
+--
+-- If you fail to test the flag and use it although it is undefined,
+-- 'packDL' will throw an error.
+
+haveRtldNext :: Bool
+
+#ifdef HAVE_RTLDNEXT
+haveRtldNext = True
+foreign import ccall unsafe "__hsunix_rtldNext" rtldNext :: Ptr a
+#else  /* HAVE_RTLDNEXT */
+haveRtldNext = False
+#endif /* HAVE_RTLDNEXT */
+
+#ifdef HAVE_RTLDDEFAULT
+foreign import ccall unsafe "__hsunix_rtldDefault" rtldDefault :: Ptr a
+#endif /* HAVE_RTLDDEFAULT */
+
+haveRtldLocal :: Bool
+haveRtldLocal = True
+{-# DEPRECATED haveRtldLocal "defaults to True" #-}
+
+
+-- |Flags for 'System.Posix.DynamicLinker.dlopen'.
+
+data RTLDFlags
+  = RTLD_LAZY
+  | RTLD_NOW
+  | RTLD_GLOBAL
+  | RTLD_LOCAL
+    deriving (Show, Read)
+
+foreign import ccall unsafe "dlopen" c_dlopen :: CString -> CInt -> IO (Ptr ())
+foreign import ccall unsafe "dlsym"  c_dlsym  :: Ptr () -> CString -> IO (FunPtr a)
+foreign import ccall unsafe "dlerror" c_dlerror :: IO CString
+foreign import ccall unsafe "dlclose" c_dlclose :: (Ptr ()) -> IO CInt
+
+packRTLDFlags :: [RTLDFlags] -> CInt
+packRTLDFlags flags = foldl (\ s f -> (packRTLDFlag f) .|. s) 0 flags
+
+packRTLDFlag :: RTLDFlags -> CInt
+packRTLDFlag RTLD_LAZY = #const RTLD_LAZY
+packRTLDFlag RTLD_NOW = #const RTLD_NOW
+packRTLDFlag RTLD_GLOBAL = #const RTLD_GLOBAL
+packRTLDFlag RTLD_LOCAL = #const RTLD_LOCAL
+
+
+-- |Flags for 'System.Posix.DynamicLinker.dlsym'. Notice that 'Next'
+-- might not be available on your particular platform! Use
+-- 'haveRtldNext'.
+--
+-- If 'RTLD_DEFAULT' is not defined on your platform, 'packDL' 'Default'
+-- reduces to 'nullPtr'.
+
+data DL = Null | Next | Default | DLHandle (Ptr ()) deriving (Show)
+
+packDL :: DL -> Ptr ()
+packDL Null = nullPtr
+
+#ifdef HAVE_RTLDNEXT
+packDL Next = rtldNext
+#else
+packDL Next = error "RTLD_NEXT not available"
+#endif
+
+#ifdef HAVE_RTLDDEFAULT
+packDL Default = rtldDefault
+#else
+packDL Default = nullPtr
+#endif
+
+packDL (DLHandle h) = h