Some some

.travis.yml

@@ -68,6 +68,7 @@ install:
  - cabal install --installdir=$HOME/.cabal/bin doctest
 
 script:
+ - (cd unix && autoreconf -fi)
  - cabal build --enable-tests all
  - cabal run spec
  - ./hpath/run-doctests.sh

cabal.project

@@ -3,6 +3,7 @@ packages: ./hpath
           ./hpath-filepath
           ./hpath-io
           ./hpath-posix
+          ./unix
 
 package hpath-io
     ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16

hpath-posix/src/System/Posix/RawFilePath/Directory/Traversals.hs

@@ -30,8 +30,6 @@ module System.Posix.RawFilePath.Directory.Traversals (
 
 -- lower-level stuff
 , readDirEnt
-, packDirStream
-, unpackDirStream
 , fdOpendir
 
 , realpath
@@ -52,11 +50,11 @@ import Control.Exception
 import qualified Data.ByteString.Char8 as BS
 import System.Posix.ByteString.FilePath
 import System.Posix.Directory.ByteString as PosixBS
+import System.Posix.Directory.Common
 import System.Posix.Files.ByteString
 
 import System.IO.Unsafe
 import "unix" System.Posix.IO.ByteString (closeFd)
-import Unsafe.Coerce (unsafeCoerce)
 import Foreign.C.Error
 import Foreign.C.String
 import Foreign.C.Types
@@ -148,18 +146,6 @@ actOnDirContents pathRelToTop b f =
 ----------------------------------------------------------
 -- dodgy stuff
 
-type CDir = ()
-type CDirent = ()
-
--- Posix doesn't export DirStream, so to re-use that type we need to use
--- unsafeCoerce.  It's just a newtype, so this is a legitimate usage.
--- ugly trick.
-unpackDirStream :: DirStream -> Ptr CDir
-unpackDirStream = unsafeCoerce
-
-packDirStream :: Ptr CDir -> DirStream
-packDirStream = unsafeCoerce
-
 -- the __hscore_* functions are defined in the unix package.  We can import them and let
 -- the linker figure it out.
 foreign import ccall unsafe "__hscore_readdir"
@@ -178,14 +164,14 @@ foreign import ccall "realpath"
   c_realpath :: CString -> CString -> IO CString
 
 foreign import ccall unsafe "fdopendir"
-  c_fdopendir :: Posix.Fd -> IO (Ptr ())
+  c_fdopendir :: Posix.Fd -> IO (Ptr CDir)
 
 ----------------------------------------------------------
 -- less dodgy but still lower-level
 
 
 readDirEnt :: DirStream -> IO (DirType, RawFilePath)
-readDirEnt (unpackDirStream -> dirp) =
+readDirEnt (DirStream dirp) =
   alloca $ \ptr_dEnt  -> loop ptr_dEnt
  where
   loop ptr_dEnt = do
@@ -228,7 +214,7 @@ getDirectoryContents path =
 -- |Binding to @fdopendir(3)@.
 fdOpendir :: Posix.Fd -> IO DirStream
 fdOpendir fd =
-    packDirStream <$> throwErrnoIfNull "fdOpendir" (c_fdopendir fd)
+    DirStream <$> throwErrnoIfNull "fdOpendir" (c_fdopendir fd)
 
 
 -- |Like `getDirectoryContents` except for a file descriptor.

unix/LICENSE

@@ -0,0 +1,31 @@
+The Glasgow Haskell Compiler License
+
+Copyright 2004, The University Court of the University of Glasgow. 
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+ 
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+ 
+- Neither name of the University nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission. 
+
+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.

unix/README.md

@@ -0,0 +1,15 @@
+The `unix` Package  [![Hackage](https://img.shields.io/hackage/v/unix.svg)](https://hackage.haskell.org/package/unix) [![Build Status](https://travis-ci.org/haskell/unix.svg)](https://travis-ci.org/haskell/unix)
+==================
+
+See [`unix` on Hackage](http://hackage.haskell.org/package/unix) for
+more information.
+
+Installing from Git
+-------------------
+
+To build this package using Cabal directly from Git, you must run
+`autoreconf -i` before the usual Cabal build steps (`cabal
+{configure,build,install}`). The program `autoreconf` is part of
+[GNU autoconf](http://www.gnu.org/software/autoconf/).  There is no
+need to run the `configure` script: `cabal configure` will do this for
+you.

unix/Setup.hs

@@ -0,0 +1,6 @@
+module Main (main) where
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMainWithHooks autoconfUserHooks

unix/System/Posix.hs

@@ -0,0 +1,189 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE Safe #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Posix
+-- Copyright   :  (c) The University of Glasgow 2002
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires POSIX)
+--
+-- <http://pubs.opengroup.org/onlinepubs/9699919799/ POSIX.1-2008> support
+--
+-----------------------------------------------------------------------------
+
+module System.Posix (
+  module System.Posix.Types,
+  module System.Posix.Signals,
+  module System.Posix.Directory,
+  module System.Posix.Files,
+  module System.Posix.Unistd,
+  module System.Posix.IO,
+  module System.Posix.Env,
+  module System.Posix.Process,
+  module System.Posix.Temp,
+  module System.Posix.Terminal,
+  module System.Posix.Time,
+  module System.Posix.User,
+  module System.Posix.Resource,
+  module System.Posix.Semaphore,
+  module System.Posix.SharedMem,
+  module System.Posix.DynamicLinker,
+-- XXX 'Module' type clashes with GHC
+--  module System.Posix.DynamicLinker.Module
+ ) where
+
+import System.Posix.Types
+import System.Posix.Signals
+import System.Posix.Directory
+import System.Posix.Files
+import System.Posix.Unistd
+import System.Posix.Process
+import System.Posix.IO
+import System.Posix.Env
+import System.Posix.Temp
+import System.Posix.Terminal
+import System.Posix.Time
+import System.Posix.User
+import System.Posix.Resource
+import System.Posix.Semaphore
+import System.Posix.SharedMem
+-- XXX: bad planning, we have two constructors called "Default"
+import System.Posix.DynamicLinker hiding (Default)
+--import System.Posix.DynamicLinker.Module
+
+{- TODO
+
+Here we detail our support for the IEEE Std 1003.1-2001 standard.  For
+each header file defined by the standard, we categorise its
+functionality as
+
+ - "supported"
+
+   Full equivalent functionality is provided by the specified Haskell
+   module.
+
+ - "unsupported" (functionality not provided by a Haskell module)
+
+   The functionality is not currently provided.
+
+ - "to be supported"
+
+   Currently unsupported, but support is planned for the future.
+
+Exceptions are listed where appropriate.
+
+Interfaces supported
+--------------------
+
+unix package:
+
+dirent.h 	System.Posix.Directory
+dlfcn.h 	System.Posix.DynamicLinker
+errno.h 	Foreign.C.Error
+fcntl.h 	System.Posix.IO
+signal.h	System.Posix.Signals
+sys/stat.h	System.Posix.Files
+sys/times.h	System.Posix.Process
+sys/types.h	System.Posix.Types (with exceptions...)
+sys/utsname.h	System.Posix.Unistd
+sys/wait.h	System.Posix.Process
+termios.h	System.Posix.Terminal (check exceptions)
+unistd.h	System.Posix.*
+utime.h		System.Posix.Files
+pwd.h		System.Posix.User
+grp.h		System.Posix.User
+stdlib.h: 	System.Posix.Env (getenv()/setenv()/unsetenv())
+		System.Posix.Temp (mkstemp())
+sys/resource.h: System.Posix.Resource (get/setrlimit() only)
+
+regex-posix package:
+
+regex.h		Text.Regex.Posix
+
+network package:
+
+arpa/inet.h
+net/if.h
+netinet/in.h
+netinet/tcp.h
+sys/socket.h
+sys/un.h
+
+To be supported
+---------------
+
+limits.h	(pathconf()/fpathconf() already done)
+poll.h
+sys/resource.h  (getrusage(): use instead of times() for getProcessTimes?)
+sys/select.h
+sys/statvfs.h	 (?)
+sys/time.h	(but maybe not the itimer?)
+time.h		(System.Posix.Time)
+stdio.h		(popen only: System.Posix.IO)
+sys/mman.h
+
+Unsupported interfaces
+----------------------
+
+aio.h
+assert.h
+complex.h
+cpio.h
+ctype.h
+fenv.h
+float.h
+fmtmsg.h
+fnmatch.h
+ftw.h
+glob.h
+iconv.h
+inttypes.h
+iso646.h
+langinfo.h
+libgen.h
+locale.h	(see System.Locale)
+math.h
+monetary.h
+mqueue.h
+ndbm.h
+netdb.h
+nl_types.h
+pthread.h
+sched.h
+search.h
+semaphore.h
+setjmp.h
+spawn.h
+stdarg.h
+stdbool.h
+stddef.h
+stdint.h
+stdio.h		except: popen()
+stdlib.h	except: exit(): System.Posix.Process
+			free()/malloc(): Foreign.Marshal.Alloc
+			getenv()/setenv(): ?? System.Environment
+			rand() etc.: System.Random
+string.h
+strings.h
+stropts.h
+sys/ipc.h
+sys/msg.h
+sys/sem.h
+sys/shm.h
+sys/timeb.h
+sys/uio.h
+syslog.h
+tar.h
+tgmath.h
+trace.h
+ucontext.h
+ulimit.h
+utmpx.h
+wchar.h
+wctype.h
+wordexp.h
+
+-}

unix/System/Posix/ByteString.hs

@@ -0,0 +1,69 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE Safe #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Posix.ByteString
+-- Copyright   :  (c) The University of Glasgow 2002
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires POSIX)
+--
+-- <http://pubs.opengroup.org/onlinepubs/9699919799/ POSIX.1-2008>
+-- support with 'ByteString' file paths and environment strings.
+--
+-- This module exports exactly the same API as "System.Posix", except
+-- that all file paths and environment strings are represented by
+-- 'ByteString' instead of 'String'.  The "System.Posix" API
+-- implicitly translates all file paths and environment strings using
+-- the locale encoding, whereas this version of the API does no
+-- encoding or decoding and works directly in terms of raw bytes.
+--
+-- Note that if you do need to interpret file paths or environment
+-- strings as text, then some Unicode encoding or decoding should be
+-- applied first.
+--
+-----------------------------------------------------------------------------
+
+module System.Posix.ByteString (
+  System.Posix.ByteString.FilePath.RawFilePath,
+  module System.Posix.Types,
+  module System.Posix.Signals,
+  module System.Posix.Directory.ByteString,
+  module System.Posix.Files.ByteString,
+  module System.Posix.Unistd,
+  module System.Posix.IO.ByteString,
+  module System.Posix.Env.ByteString,
+  module System.Posix.Process.ByteString,
+  module System.Posix.Temp.ByteString,
+  module System.Posix.Terminal.ByteString,
+  module System.Posix.Time,
+  module System.Posix.User,
+  module System.Posix.Resource,
+  module System.Posix.Semaphore,
+  module System.Posix.SharedMem,
+  module System.Posix.DynamicLinker.ByteString,
+-- XXX 'Module' type clashes with GHC
+--  module System.Posix.DynamicLinker.Module.ByteString
+ ) where
+
+import System.Posix.ByteString.FilePath
+import System.Posix.Types
+import System.Posix.Signals
+import System.Posix.Directory.ByteString
+import System.Posix.Files.ByteString
+import System.Posix.Unistd
+import System.Posix.Process.ByteString
+import System.Posix.IO.ByteString
+import System.Posix.Env.ByteString
+import System.Posix.Temp.ByteString
+import System.Posix.Terminal.ByteString
+import System.Posix.Time
+import System.Posix.User
+import System.Posix.Resource
+import System.Posix.Semaphore
+import System.Posix.SharedMem
+-- XXX: bad planning, we have two constructors called "Default"
+import System.Posix.DynamicLinker.ByteString hiding (Default)
+--import System.Posix.DynamicLinker.Module.ByteString

unix/System/Posix/ByteString/FilePath.hsc

@@ -0,0 +1,127 @@
+#if __GLASGOW_HASKELL__ >= 709
+{-# LANGUAGE Safe #-}
+#else
+{-# LANGUAGE Trustworthy #-}
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Posix.ByteString.FilePath
+-- Copyright   :  (c) The University of Glasgow 2002
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires POSIX)
+--
+-- Internal stuff: support for ByteString FilePaths
+--
+-----------------------------------------------------------------------------
+
+module System.Posix.ByteString.FilePath (
+     RawFilePath, withFilePath, peekFilePath, peekFilePathLen,
+     throwErrnoPathIfMinus1Retry,
+     throwErrnoPathIfMinus1Retry_,
+     throwErrnoPathIfNullRetry,
+     throwErrnoPathIfRetry,
+     throwErrnoPath,
+     throwErrnoPathIf,
+     throwErrnoPathIf_,
+     throwErrnoPathIfNull,
+     throwErrnoPathIfMinus1,
+     throwErrnoPathIfMinus1_
+  ) where
+
+import Foreign hiding ( void )
+import Foreign.C hiding (
+     throwErrnoPath,
+     throwErrnoPathIf,
+     throwErrnoPathIf_,
+     throwErrnoPathIfNull,
+     throwErrnoPathIfMinus1,
+     throwErrnoPathIfMinus1_ )
+
+import Control.Monad
+import Data.ByteString
+import Data.ByteString.Char8 as BC
+import Prelude hiding (FilePath)
+
+-- | A literal POSIX file path
+type RawFilePath = ByteString
+
+withFilePath :: RawFilePath -> (CString -> IO a) -> IO a
+withFilePath = useAsCString
+
+peekFilePath :: CString -> IO RawFilePath
+peekFilePath = packCString
+
+peekFilePathLen :: CStringLen -> IO RawFilePath
+peekFilePathLen = packCStringLen
+
+
+throwErrnoPathIfMinus1Retry :: (Eq a, Num a)
+                            => String -> RawFilePath -> IO a -> IO a
+throwErrnoPathIfMinus1Retry loc path f = do
+  throwErrnoPathIfRetry (== -1) loc path f
+
+throwErrnoPathIfMinus1Retry_ :: (Eq a, Num a)
+                             => String -> RawFilePath -> IO a -> IO ()
+throwErrnoPathIfMinus1Retry_ loc path f =
+  void $ throwErrnoPathIfRetry (== -1) loc path f
+
+throwErrnoPathIfNullRetry :: String -> RawFilePath -> IO (Ptr a) -> IO (Ptr a)
+throwErrnoPathIfNullRetry loc path f =
+  throwErrnoPathIfRetry (== nullPtr) loc path f
+
+throwErrnoPathIfRetry :: (a -> Bool) -> String -> RawFilePath -> IO a -> IO a
+throwErrnoPathIfRetry pr loc rpath f =
+  do
+    res <- f
+    if pr res
+      then do
+        err <- getErrno
+        if err == eINTR
+          then throwErrnoPathIfRetry pr loc rpath f
+          else throwErrnoPath loc rpath
+      else return res
+
+-- | as 'throwErrno', but exceptions include the given path when appropriate.
+--
+throwErrnoPath :: String -> RawFilePath -> IO a
+throwErrnoPath loc path =
+  do
+    errno <- getErrno
+    ioError (errnoToIOError loc errno Nothing (Just (BC.unpack path)))
+
+-- | as 'throwErrnoIf', but exceptions include the given path when
+--   appropriate.
+--
+throwErrnoPathIf :: (a -> Bool) -> String -> RawFilePath -> IO a -> IO a
+throwErrnoPathIf cond loc path f =
+  do
+    res <- f
+    if cond res then throwErrnoPath loc path else return res
+
+-- | as 'throwErrnoIf_', but exceptions include the given path when
+--   appropriate.
+--
+throwErrnoPathIf_ :: (a -> Bool) -> String -> RawFilePath -> IO a -> IO ()
+throwErrnoPathIf_ cond loc path f  = void $ throwErrnoPathIf cond loc path f
+
+-- | as 'throwErrnoIfNull', but exceptions include the given path when
+--   appropriate.
+--
+throwErrnoPathIfNull :: String -> RawFilePath -> IO (Ptr a) -> IO (Ptr a)
+throwErrnoPathIfNull  = throwErrnoPathIf (== nullPtr)
+
+-- | as 'throwErrnoIfMinus1', but exceptions include the given path when
+--   appropriate.
+--
+throwErrnoPathIfMinus1 :: (Eq a, Num a) => String -> RawFilePath -> IO a -> IO a
+throwErrnoPathIfMinus1 = throwErrnoPathIf (== -1)
+
+-- | as 'throwErrnoIfMinus1_', but exceptions include the given path when
+--   appropriate.
+--
+throwErrnoPathIfMinus1_ :: (Eq a, Num a) => String -> RawFilePath -> IO a -> IO ()
+throwErrnoPathIfMinus1_  = throwErrnoPathIf_ (== -1)

unix/System/Posix/Directory.hsc

@@ -0,0 +1,164 @@
+{-# LANGUAGE CApiFFI #-}
+{-# LANGUAGE NondecreasingIndentation #-}
+#if __GLASGOW_HASKELL__ >= 709
+{-# LANGUAGE Safe #-}
+#else
+{-# LANGUAGE Trustworthy #-}
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Posix.Directory
+-- Copyright   :  (c) The University of Glasgow 2002
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires POSIX)
+--
+-- String-based POSIX directory support
+--
+-----------------------------------------------------------------------------
+
+#include "HsUnix.h"
+
+-- hack copied from System.Posix.Files
+#if !defined(PATH_MAX)
+# define PATH_MAX 4096
+#endif
+
+module System.Posix.Directory (
+   -- * Creating and removing directories
+   createDirectory, removeDirectory,
+
+   -- * Reading directories
+   DirStream,
+   openDirStream,
+   readDirStream,
+   rewindDirStream,
+   closeDirStream,
+   DirStreamOffset,
+#ifdef HAVE_TELLDIR
+   tellDirStream,
+#endif
+#ifdef HAVE_SEEKDIR
+   seekDirStream,
+#endif
+
+   -- * The working dirctory
+   getWorkingDirectory,
+   changeWorkingDirectory,
+   changeWorkingDirectoryFd,
+  ) where
+
+import System.IO.Error
+import System.Posix.Error
+import System.Posix.Types
+import Foreign
+import Foreign.C
+
+import System.Posix.Directory.Common
+import System.Posix.Internals (withFilePath, peekFilePath)
+
+-- | @createDirectory dir mode@ calls @mkdir@ to
+--   create a new directory, @dir@, with permissions based on
+--  @mode@.
+createDirectory :: FilePath -> FileMode -> IO ()
+createDirectory name mode =
+  withFilePath name $ \s ->
+    throwErrnoPathIfMinus1Retry_ "createDirectory" name (c_mkdir s mode)
+    -- POSIX doesn't allow mkdir() to return EINTR, but it does on
+    -- OS X (#5184), so we need the Retry variant here.
+
+foreign import ccall unsafe "mkdir"
+  c_mkdir :: CString -> CMode -> IO CInt
+
+-- | @openDirStream dir@ calls @opendir@ to obtain a
+--   directory stream for @dir@.
+openDirStream :: FilePath -> IO DirStream
+openDirStream name =
+  withFilePath name $ \s -> do
+    dirp <- throwErrnoPathIfNullRetry "openDirStream" name $ c_opendir s
+    return (DirStream dirp)
+
+foreign import capi unsafe "HsUnix.h opendir"
+   c_opendir :: CString  -> IO (Ptr CDir)
+
+-- | @readDirStream dp@ calls @readdir@ to obtain the
+--   next directory entry (@struct dirent@) for the open directory
+--   stream @dp@, and returns the @d_name@ member of that
+--  structure.
+readDirStream :: DirStream -> IO FilePath
+readDirStream (DirStream dirp) =
+  alloca $ \ptr_dEnt  -> loop ptr_dEnt
+ where
+  loop ptr_dEnt = do
+    resetErrno
+    r <- c_readdir dirp ptr_dEnt
+    if (r == 0)
+         then do dEnt <- peek ptr_dEnt
+                 if (dEnt == nullPtr)
+                    then return []
+                    else do
+                     entry <- (d_name dEnt >>= peekFilePath)
+                     c_freeDirEnt dEnt
+                     return entry
+         else do errno <- getErrno
+                 if (errno == eINTR) then loop ptr_dEnt else do
+                 let (Errno eo) = errno
+                 if (eo == 0)
+                    then return []
+                    else throwErrno "readDirStream"
+
+-- traversing directories
+foreign import ccall unsafe "__hscore_readdir"
+  c_readdir  :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
+
+foreign import ccall unsafe "__hscore_free_dirent"
+  c_freeDirEnt  :: Ptr CDirent -> IO ()
+
+foreign import ccall unsafe "__hscore_d_name"
+  d_name :: Ptr CDirent -> IO CString
+
+
+-- | @getWorkingDirectory@ calls @getcwd@ to obtain the name
+--   of the current working directory.
+getWorkingDirectory :: IO FilePath
+getWorkingDirectory = go (#const PATH_MAX)
+  where
+    go bytes = do
+        r <- allocaBytes bytes $ \buf -> do
+            buf' <- c_getcwd buf (fromIntegral bytes)
+            if buf' /= nullPtr
+                then do s <- peekFilePath buf
+                        return (Just s)
+                else do errno <- getErrno
+                        if errno == eRANGE
+                            -- we use Nothing to indicate that we should
+                            -- try again with a bigger buffer
+                            then return Nothing
+                            else throwErrno "getWorkingDirectory"
+        maybe (go (2 * bytes)) return r
+
+foreign import ccall unsafe "getcwd"
+   c_getcwd   :: Ptr CChar -> CSize -> IO (Ptr CChar)
+
+-- | @changeWorkingDirectory dir@ calls @chdir@ to change
+--   the current working directory to @dir@.
+changeWorkingDirectory :: FilePath -> IO ()
+changeWorkingDirectory path =
+  modifyIOError (`ioeSetFileName` path) $
+    withFilePath path $ \s ->
+       throwErrnoIfMinus1Retry_ "changeWorkingDirectory" (c_chdir s)
+
+foreign import ccall unsafe "chdir"
+   c_chdir :: CString -> IO CInt
+
+removeDirectory :: FilePath -> IO ()
+removeDirectory path =
+  modifyIOError (`ioeSetFileName` path) $
+    withFilePath path $ \s ->
+       throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
+
+foreign import ccall unsafe "rmdir"
+   c_rmdir :: CString -> IO CInt

unix/System/Posix/Directory/ByteString.hsc

@@ -0,0 +1,165 @@
+{-# LANGUAGE CApiFFI #-}
+{-# LANGUAGE NondecreasingIndentation #-}
+#if __GLASGOW_HASKELL__ >= 709
+{-# LANGUAGE Safe #-}
+#else
+{-# LANGUAGE Trustworthy #-}
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Posix.Directory.ByteString
+-- Copyright   :  (c) The University of Glasgow 2002
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires POSIX)
+--
+-- String-based POSIX directory support
+--
+-----------------------------------------------------------------------------
+
+#include "HsUnix.h"
+
+-- hack copied from System.Posix.Files
+#if !defined(PATH_MAX)
+# define PATH_MAX 4096
+#endif
+
+module System.Posix.Directory.ByteString (
+   -- * Creating and removing directories
+   createDirectory, removeDirectory,
+
+   -- * Reading directories
+   DirStream,
+   openDirStream,
+   readDirStream,
+   rewindDirStream,
+   closeDirStream,
+   DirStreamOffset,
+#ifdef HAVE_TELLDIR
+   tellDirStream,
+#endif
+#ifdef HAVE_SEEKDIR
+   seekDirStream,
+#endif
+
+   -- * The working directory
+   getWorkingDirectory,
+   changeWorkingDirectory,
+   changeWorkingDirectoryFd,
+  ) where
+
+import System.IO.Error
+import System.Posix.Types
+import Foreign
+import Foreign.C
+
+import Data.ByteString.Char8 as BC
+
+import System.Posix.Directory.Common
+import System.Posix.ByteString.FilePath
+
+-- | @createDirectory dir mode@ calls @mkdir@ to
+--   create a new directory, @dir@, with permissions based on
+--  @mode@.
+createDirectory :: RawFilePath -> FileMode -> IO ()
+createDirectory name mode =
+  withFilePath name $ \s ->
+    throwErrnoPathIfMinus1Retry_ "createDirectory" name (c_mkdir s mode)
+    -- POSIX doesn't allow mkdir() to return EINTR, but it does on
+    -- OS X (#5184), so we need the Retry variant here.
+
+foreign import ccall unsafe "mkdir"
+  c_mkdir :: CString -> CMode -> IO CInt
+
+-- | @openDirStream dir@ calls @opendir@ to obtain a
+--   directory stream for @dir@.
+openDirStream :: RawFilePath -> IO DirStream
+openDirStream name =
+  withFilePath name $ \s -> do
+    dirp <- throwErrnoPathIfNullRetry "openDirStream" name $ c_opendir s
+    return (DirStream dirp)
+
+foreign import capi unsafe "HsUnix.h opendir"
+   c_opendir :: CString  -> IO (Ptr CDir)
+
+-- | @readDirStream dp@ calls @readdir@ to obtain the
+--   next directory entry (@struct dirent@) for the open directory
+--   stream @dp@, and returns the @d_name@ member of that
+--  structure.
+readDirStream :: DirStream -> IO RawFilePath
+readDirStream (DirStream dirp) =
+  alloca $ \ptr_dEnt  -> loop ptr_dEnt
+ where
+  loop ptr_dEnt = do
+    resetErrno
+    r <- c_readdir dirp ptr_dEnt
+    if (r == 0)
+         then do dEnt <- peek ptr_dEnt
+                 if (dEnt == nullPtr)
+                    then return BC.empty
+                    else do
+                     entry <- (d_name dEnt >>= peekFilePath)
+                     c_freeDirEnt dEnt
+                     return entry
+         else do errno <- getErrno
+                 if (errno == eINTR) then loop ptr_dEnt else do
+                 let (Errno eo) = errno
+                 if (eo == 0)
+                    then return BC.empty
+                    else throwErrno "readDirStream"
+
+-- traversing directories
+foreign import ccall unsafe "__hscore_readdir"
+  c_readdir  :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
+
+foreign import ccall unsafe "__hscore_free_dirent"
+  c_freeDirEnt  :: Ptr CDirent -> IO ()
+
+foreign import ccall unsafe "__hscore_d_name"
+  d_name :: Ptr CDirent -> IO CString
+
+
+-- | @getWorkingDirectory@ calls @getcwd@ to obtain the name
+--   of the current working directory.
+getWorkingDirectory :: IO RawFilePath
+getWorkingDirectory = go (#const PATH_MAX)
+  where
+    go bytes = do
+        r <- allocaBytes bytes $ \buf -> do
+            buf' <- c_getcwd buf (fromIntegral bytes)
+            if buf' /= nullPtr
+                then do s <- peekFilePath buf
+                        return (Just s)
+                else do errno <- getErrno
+                        if errno == eRANGE
+                            -- we use Nothing to indicate that we should
+                            -- try again with a bigger buffer
+                            then return Nothing
+                            else throwErrno "getWorkingDirectory"
+        maybe (go (2 * bytes)) return r
+
+foreign import ccall unsafe "getcwd"
+   c_getcwd   :: Ptr CChar -> CSize -> IO (Ptr CChar)
+
+-- | @changeWorkingDirectory dir@ calls @chdir@ to change
+--   the current working directory to @dir@.
+changeWorkingDirectory :: RawFilePath -> IO ()
+changeWorkingDirectory path =
+  modifyIOError (`ioeSetFileName` (BC.unpack path)) $
+    withFilePath path $ \s ->
+       throwErrnoIfMinus1Retry_ "changeWorkingDirectory" (c_chdir s)
+
+foreign import ccall unsafe "chdir"
+   c_chdir :: CString -> IO CInt
+
+removeDirectory :: RawFilePath -> IO ()
+removeDirectory path =
+  modifyIOError (`ioeSetFileName` BC.unpack path) $
+    withFilePath path $ \s ->
+       throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
+
+foreign import ccall unsafe "rmdir"
+   c_rmdir :: CString -> IO CInt

unix/System/Posix/Directory/Common.hsc

@@ -0,0 +1,88 @@
+#if __GLASGOW_HASKELL__ >= 709
+{-# LANGUAGE Safe #-}
+#else
+{-# LANGUAGE Trustworthy #-}
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Posix.Directory.Common
+-- Copyright   :  (c) The University of Glasgow 2002
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires POSIX)
+--
+-- POSIX directory support
+--
+-----------------------------------------------------------------------------
+
+#include "HsUnix.h"
+
+module System.Posix.Directory.Common (
+       DirStream(..), CDir, CDirent, DirStreamOffset(..),
+       rewindDirStream,
+       closeDirStream,
+#ifdef HAVE_SEEKDIR
+       seekDirStream,
+#endif
+#ifdef HAVE_TELLDIR
+       tellDirStream,
+#endif
+       changeWorkingDirectoryFd,
+  ) where
+
+import System.Posix.Types
+import Foreign
+import Foreign.C
+
+newtype DirStream = DirStream (Ptr CDir)
+
+data {-# CTYPE "DIR" #-} CDir
+data {-# CTYPE "struct dirent" #-} CDirent
+
+-- | @rewindDirStream dp@ calls @rewinddir@ to reposition
+--   the directory stream @dp@ at the beginning of the directory.
+rewindDirStream :: DirStream -> IO ()
+rewindDirStream (DirStream dirp) = c_rewinddir dirp
+
+foreign import ccall unsafe "rewinddir"
+   c_rewinddir :: Ptr CDir -> IO ()
+
+-- | @closeDirStream dp@ calls @closedir@ to close
+--   the directory stream @dp@.
+closeDirStream :: DirStream -> IO ()
+closeDirStream (DirStream dirp) = do
+  throwErrnoIfMinus1Retry_ "closeDirStream" (c_closedir dirp)
+
+foreign import ccall unsafe "closedir"
+   c_closedir :: Ptr CDir -> IO CInt
+
+newtype DirStreamOffset = DirStreamOffset COff
+
+#ifdef HAVE_SEEKDIR
+seekDirStream :: DirStream -> DirStreamOffset -> IO ()
+seekDirStream (DirStream dirp) (DirStreamOffset off) =
+  c_seekdir dirp (fromIntegral off) -- TODO: check for CLong/COff overflow
+
+foreign import ccall unsafe "seekdir"
+  c_seekdir :: Ptr CDir -> CLong -> IO ()
+#endif
+
+#ifdef HAVE_TELLDIR
+tellDirStream :: DirStream -> IO DirStreamOffset
+tellDirStream (DirStream dirp) = do
+  off <- c_telldir dirp
+  return (DirStreamOffset (fromIntegral off)) -- TODO: check for overflow
+
+foreign import ccall unsafe "telldir"
+  c_telldir :: Ptr CDir -> IO CLong
+#endif
+
+changeWorkingDirectoryFd :: Fd -> IO ()
+changeWorkingDirectoryFd (Fd fd) =
+  throwErrnoIfMinus1Retry_ "changeWorkingDirectoryFd" (c_fchdir fd)
+
+foreign import ccall unsafe "fchdir"
+  c_fchdir :: CInt -> IO CInt

unix/System/Posix/DynamicLinker.hsc

@@ -0,0 +1,72 @@
+#if __GLASGOW_HASKELL__ >= 709
+{-# LANGUAGE Safe #-}
+#else
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Posix.DynamicLinker
+-- 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 (
+
+    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.Internals ( withFilePath )
+
+dlopen :: FilePath -> [RTLDFlags] -> IO DL
+dlopen path flags = do
+  withFilePath path $ \ p -> do
+    liftM DLHandle $ throwDLErrorIf "dlopen" (== nullPtr) $ c_dlopen p (packRTLDFlags flags)
+
+withDL :: FilePath -> [RTLDFlags] -> (DL -> IO a) -> IO a
+withDL file flags f = bracket (dlopen file flags) (dlclose) f
+
+withDL_ :: FilePath -> [RTLDFlags] -> (DL -> IO a) -> IO ()
+withDL_ file flags f = withDL file flags f >> return ()

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

unix/System/Posix/Env.hsc

@@ -0,0 +1,205 @@
+{-# LANGUAGE CApiFFI #-}
+#if __GLASGOW_HASKELL__ >= 709
+{-# LANGUAGE Safe #-}
+#else
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Posix.Env
+-- Copyright   :  (c) The University of Glasgow 2002
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires POSIX)
+--
+-- POSIX environment support
+--
+-----------------------------------------------------------------------------
+
+module System.Posix.Env (
+      getEnv
+    , getEnvDefault
+    , getEnvironmentPrim
+    , getEnvironment
+    , setEnvironment
+    , putEnv
+    , setEnv
+    , unsetEnv
+    , clearEnv
+) where
+
+#include "HsUnix.h"
+
+import Foreign.C.Error (throwErrnoIfMinus1_)
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.Marshal.Array
+import Foreign.Ptr
+import Foreign.Storable
+import Control.Monad
+import Data.Maybe (fromMaybe)
+import System.Posix.Internals
+
+#if !MIN_VERSION_base(4,7,0)
+-- needed for backported local 'newFilePath' binding in 'putEnv'
+import GHC.IO.Encoding (getFileSystemEncoding)
+import qualified GHC.Foreign as GHC (newCString)
+#endif
+
+-- |'getEnv' looks up a variable in the environment.
+
+getEnv ::
+  String            {- ^ variable name  -} ->
+  IO (Maybe String) {- ^ variable value -}
+getEnv name = do
+  litstring <- withFilePath name c_getenv
+  if litstring /= nullPtr
+     then liftM Just $ peekFilePath litstring
+     else return Nothing
+
+-- |'getEnvDefault' is a wrapper around 'getEnv' where the
+-- programmer can specify a fallback if the variable is not found
+-- in the environment.
+
+getEnvDefault ::
+  String    {- ^ variable name                    -} ->
+  String    {- ^ fallback value                   -} ->
+  IO String {- ^ variable value or fallback value -}
+getEnvDefault name fallback = liftM (fromMaybe fallback) (getEnv name)
+
+foreign import ccall unsafe "getenv"
+   c_getenv :: CString -> IO CString
+
+getEnvironmentPrim :: IO [String]
+getEnvironmentPrim = do
+  c_environ <- getCEnviron
+  -- environ can be NULL
+  if c_environ == nullPtr
+    then return []
+    else do
+      arr <- peekArray0 nullPtr c_environ
+      mapM peekFilePath arr
+
+getCEnviron :: IO (Ptr CString)
+#if HAVE__NSGETENVIRON
+-- You should not access @char **environ@ directly on Darwin in a bundle/shared library.
+-- See #2458 and http://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man7/environ.7.html
+getCEnviron = nsGetEnviron >>= peek
+
+foreign import ccall unsafe "_NSGetEnviron"
+   nsGetEnviron :: IO (Ptr (Ptr CString))
+#else
+getCEnviron = peek c_environ_p
+foreign import ccall unsafe "&environ"
+   c_environ_p :: Ptr (Ptr CString)
+#endif
+
+-- |'getEnvironment' retrieves the entire environment as a
+-- list of @(key,value)@ pairs.
+
+getEnvironment :: IO [(String,String)] {- ^ @[(key,value)]@ -}
+getEnvironment = do
+  env <- getEnvironmentPrim
+  return $ map (dropEq.(break ((==) '='))) env
+ where
+   dropEq (x,'=':ys) = (x,ys)
+   dropEq (x,_)      = error $ "getEnvironment: insane variable " ++ x
+
+-- |'setEnvironment' resets the entire environment to the given list of
+-- @(key,value)@ pairs.
+
+setEnvironment ::
+  [(String,String)] {- ^ @[(key,value)]@ -} ->
+  IO ()
+setEnvironment env = do
+  clearEnv
+  forM_ env $ \(key,value) ->
+    setEnv key value True {-overwrite-}
+
+-- |The 'unsetEnv' function deletes all instances of the variable name
+-- from the environment.
+
+unsetEnv :: String {- ^ variable name -} -> IO ()
+#if HAVE_UNSETENV
+# if !UNSETENV_RETURNS_VOID
+unsetEnv name = withFilePath name $ \ s ->
+  throwErrnoIfMinus1_ "unsetenv" (c_unsetenv s)
+
+-- POSIX.1-2001 compliant unsetenv(3)
+foreign import capi unsafe "HsUnix.h unsetenv"
+   c_unsetenv :: CString -> IO CInt
+# else
+unsetEnv name = withFilePath name c_unsetenv
+
+-- pre-POSIX unsetenv(3) returning @void@
+foreign import capi unsafe "HsUnix.h unsetenv"
+   c_unsetenv :: CString -> IO ()
+# endif
+#else
+unsetEnv name = putEnv (name ++ "=")
+#endif
+
+-- |'putEnv' function takes an argument of the form @name=value@
+-- and is equivalent to @setEnv(key,value,True{-overwrite-})@.
+
+putEnv :: String {- ^ "key=value" -} -> IO ()
+putEnv keyvalue = do s <- newFilePath keyvalue
+                     -- Do not free `s` after calling putenv.
+                     -- According to SUSv2, the string passed to putenv
+                     -- becomes part of the environment. #7342
+                     throwErrnoIfMinus1_ "putenv" (c_putenv s)
+#if !MIN_VERSION_base(4,7,0)
+    where
+      newFilePath :: FilePath -> IO CString
+      newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp
+#endif
+
+foreign import ccall unsafe "putenv"
+   c_putenv :: CString -> IO CInt
+
+{- |The 'setEnv' function inserts or resets the environment variable name in
+     the current environment list.  If the variable @name@ does not exist in the