Move directory stuff from base to here

leaving out Windows-specific hacks

4 files changed, 110 insertions, 6 deletions

diff --git a/System/Posix/Directory.hsc b/System/Posix/Directory.hsc
index 45c34b2..35fe291 100644
--- a/System/Posix/Directory.hsc
+++ b/System/Posix/Directory.hsc
@@ -37,8 +37,6 @@ module System.Posix.Directory (
 import System.IO.Error
 import System.Posix.Error
 import System.Posix.Types
-import System.Posix.Internals
---import System.Directory hiding (createDirectory)
 import Foreign
 import Foreign.C
 
@@ -63,6 +61,9 @@ openDirStream name =
     dirp <- throwErrnoPathIfNull "openDirStream" name $ c_opendir s
     return (DirStream dirp)
 
+foreign import ccall unsafe "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
@@ -73,33 +74,52 @@ readDirStream (DirStream dirp) =
  where
   loop ptr_dEnt = do
     resetErrno
-    r <- readdir dirp ptr_dEnt
+    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 >>= peekCString)
-		     freeDirEnt dEnt
+		     c_freeDirEnt dEnt
 		     return entry
 	 else do errno <- getErrno
 		 if (errno == eINTR) then loop ptr_dEnt else do
 		 let (Errno eo) = errno
-		 if (eo == end_of_dir)
+		 if (eo == 0)
 		    then return []
 		    else throwErrno "readDirStream"
 
+type CDir       = ()
+type CDirent    = ()
+
+-- 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
+
 -- | @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
   throwErrnoIfMinus1_ "closeDirStream" (c_closedir dirp)
 
+foreign import ccall unsafe "closedir"
+   c_closedir :: Ptr CDir -> IO CInt
+
 newtype DirStreamOffset = DirStreamOffset COff
 
 seekDirStream :: DirStream -> DirStreamOffset -> IO ()
diff --git a/cbits/dirUtils.c b/cbits/dirUtils.c
new file mode 100644
index 0000000..6fc0830
--- /dev/null
+++ b/cbits/dirUtils.c
@@ -0,0 +1,83 @@
+/* 
+ * (c) The University of Glasgow 2002
+ *
+ * Directory Runtime Support
+ */
+
+/* needed only for solaris2_HOST_OS */
+#ifdef __GLASGOW_HASKELL__
+#include "ghcconfig.h"
+#endif
+
+// The following is required on Solaris to force the POSIX versions of
+// the various _r functions instead of the Solaris versions.
+#ifdef solaris2_HOST_OS
+#define _POSIX_PTHREAD_SEMANTICS
+#endif
+
+#include "HsUnix.h"
+
+/*
+ * read an entry from the directory stream; opt for the
+ * re-entrant friendly way of doing this, if available.
+ */
+int
+__hscore_readdir( DIR *dirPtr, struct dirent **pDirEnt )
+{
+#if HAVE_READDIR_R
+  struct dirent* p;
+  int res;
+  static unsigned int nm_max = (unsigned int)-1;
+  
+  if (pDirEnt == NULL) {
+    return -1;
+  }
+  if (nm_max == (unsigned int)-1) {
+#ifdef NAME_MAX
+    nm_max = NAME_MAX + 1;
+#else
+    nm_max = pathconf(".", _PC_NAME_MAX);
+    if (nm_max == -1) { nm_max = 255; }
+    nm_max++;
+#endif
+  }
+  p = (struct dirent*)malloc(sizeof(struct dirent) + nm_max);
+  if (p == NULL) return -1;
+  res = readdir_r(dirPtr, p, pDirEnt);
+  if (res != 0) {
+      *pDirEnt = NULL;
+      free(p);
+  }
+  else if (*pDirEnt == NULL) {
+    // end of stream
+    free(p);
+  }
+  return res;
+#else
+
+  if (pDirEnt == NULL) {
+    return -1;
+  }
+
+  *pDirEnt = readdir(dirPtr);
+  if (*pDirEnt == NULL) {
+    return -1;
+  } else {
+    return 0;
+  }  
+#endif
+}
+
+char *
+__hscore_d_name( struct dirent* d )
+{
+  return (d->d_name);
+}
+
+void
+__hscore_free_dirent(struct dirent *dEnt)
+{
+#if HAVE_READDIR_R
+  free(dEnt);
+#endif
+}
diff --git a/configure.ac b/configure.ac
index 4ce0a0c..f2e1c39 100644
--- a/configure.ac
+++ b/configure.ac
@@ -27,6 +27,7 @@ AC_CHECK_FUNCS([lchown setenv sysconf unsetenv])
 AC_CHECK_FUNCS([nanosleep])
 AC_CHECK_FUNCS([ptsname])
 AC_CHECK_FUNCS([setitimer])
+AC_CHECK_FUNCS([readdir_r])
 
 # Avoid adding rt if absent or unneeded
 AC_CHECK_LIB(rt, shm_open, [EXTRA_LIBS="$EXTRA_LIBS rt" CFLAGS="$CFLAGS -lrt"])
diff --git a/unix.cabal b/unix.cabal
index 870a054..52ce756 100644
--- a/unix.cabal
+++ b/unix.cabal
@@ -53,7 +53,7 @@ Library
     includes:       HsUnix.h execvpe.h
     install-includes:
         HsUnix.h HsUnixConfig.h execvpe.h
-    c-sources:	cbits/HsUnix.c cbits/execvpe.c
+    c-sources:	cbits/HsUnix.c cbits/execvpe.c cbits/dirUtils.c
 
 source-repository head
     type:     darcs