From 872f702e209bcda1e14477efd12ce24a227e2a04 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Thu, 25 Jun 2009 09:32:58 +0000 Subject: Move directory stuff from base to here leaving out Windows-specific hacks --- System/Posix/Directory.hsc | 30 ++++++++++++++--- cbits/dirUtils.c | 83 ++++++++++++++++++++++++++++++++++++++++++++++ configure.ac | 1 + unix.cabal | 2 +- 4 files changed, 110 insertions(+), 6 deletions(-) create mode 100644 cbits/dirUtils.c 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 -- cgit v1.2.3