packages feed

unix 2.3.2.0 → 2.4.0.0

raw patch · 18 files changed

+534/−134 lines, 18 filesdep ~base

Dependency ranges changed: base

Files

System/Posix/Directory.hsc view
@@ -37,8 +37,6 @@ 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 @@     dirp <- throwErrnoPathIfNull "openDirStream" name $ c_opendir s     return (DirStream dirp) +foreign import ccall unsafe "__hsunix_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,32 +74,51 @@  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
System/Posix/IO.hsc view
@@ -1,5 +1,6 @@ {-# LANGUAGE ForeignFunctionInterface #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -XRecordWildCards #-} ----------------------------------------------------------------------------- -- | -- Module      :  System.Posix.IO@@ -34,6 +35,7 @@     -- EAGAIN exceptions may occur for non-blocking IO!      fdRead, fdWrite,+    fdReadBuf, fdWriteBuf,      -- ** Seeking     fdSeek,@@ -65,17 +67,27 @@ import System.IO.Error import System.Posix.Types import System.Posix.Error-import System.Posix.Internals+import qualified System.Posix.Internals as Base  import Foreign import Foreign.C import Data.Bits  #ifdef __GLASGOW_HASKELL__+#if __GLASGOW_HASKELL__ >= 611+import GHC.IO.Handle+import GHC.IO.Handle.Internals+import GHC.IO.Handle.Types+import qualified GHC.IO.FD as FD+import qualified GHC.IO.Handle.FD as FD+import GHC.IO.Exception+import Data.Typeable (cast)+#else import GHC.IOBase import GHC.Handle hiding (fdToHandle) import qualified GHC.Handle #endif+#endif  #ifdef __HUGS__ import Hugs.Prelude (IOException(..), IOErrorType(..))@@ -101,6 +113,9 @@     wfd <- peekElemOff p_fd 1     return (Fd rfd, Fd wfd) +foreign import ccall unsafe "pipe"+   c_pipe :: Ptr CInt -> IO CInt+ -- ----------------------------------------------------------------------------- -- Duplicating file descriptors @@ -114,6 +129,12 @@   r <- throwErrnoIfMinus1 "dupTo" (c_dup2 fd1 fd2)   return (Fd r) +foreign import ccall unsafe "dup"+   c_dup :: CInt -> IO CInt++foreign import ccall unsafe "dup2"+   c_dup2 :: CInt -> CInt -> IO CInt+ -- ----------------------------------------------------------------------------- -- Opening and closing files @@ -179,6 +200,9 @@ 		   WriteOnly -> (#const O_WRONLY) 		   ReadWrite -> (#const O_RDWR) +foreign import ccall unsafe "__hscore_open"+   c_open :: CString -> CInt -> CMode -> IO CInt+ -- |Create and open this file in WriteOnly mode.  A special case of -- 'openFd'.  See 'System.Posix.Files' for information on how to use -- the 'FileMode' type.@@ -193,6 +217,9 @@ closeFd :: Fd -> IO () closeFd (Fd fd) = throwErrnoIfMinus1_ "closeFd" (c_close fd) +foreign import ccall unsafe "HsBase.h close"+   c_close :: CInt -> IO CInt+ -- ----------------------------------------------------------------------------- -- Converting file descriptors to/from Handles @@ -210,6 +237,24 @@ fdToHandle :: Fd -> IO Handle  #ifdef __GLASGOW_HASKELL__+#if __GLASGOW_HASKELL__ >= 611+handleToFd h = withHandle "handleToFd" h $ \ h_@Handle__{haType=_,..} -> do+  case cast haDevice of+    Nothing -> ioError (ioeSetErrorString (mkIOError IllegalOperation+                                           "handleToFd" (Just h) Nothing) +                        "handle is not a file descriptor")+    Just fd -> do+     -- converting a Handle into an Fd effectively means+     -- letting go of the Handle; it is put into a closed+     -- state as a result. +     flushWriteBuffer h_+     FD.release fd+     return (Handle__{haType=ClosedHandle,..}, Fd (fromIntegral (FD.fdFD fd)))++fdToHandle fd = FD.fdToHandle (fromIntegral fd)++#else+ handleToFd h = withHandle "handleToFd" h $ \ h_ -> do   -- converting a Handle into an Fd effectively means   -- letting go of the Handle; it is put into a closed@@ -224,6 +269,7 @@  fdToHandle fd = GHC.Handle.fdToHandle (fromIntegral fd) #endif+#endif  #ifdef __HUGS__ handleToFd h = do@@ -273,6 +319,12 @@ 	      _    		-> ((#const F_GETFL),(#const F_SETFL))   opt_val = fdOption2Int opt +foreign import ccall unsafe "HsBase.h fcntl_read"+   c_fcntl_read  :: CInt -> CInt -> IO CInt++foreign import ccall unsafe "HsBase.h fcntl_write"+   c_fcntl_write :: CInt -> CInt -> CLong -> IO CInt+ -- ----------------------------------------------------------------------------- -- Seeking  @@ -284,7 +336,7 @@ -- | May throw an exception if this is an invalid descriptor. fdSeek :: Fd -> SeekMode -> FileOffset -> IO FileOffset fdSeek (Fd fd) mode off =-  throwErrnoIfMinus1 "fdSeek" (c_lseek fd off (mode2Int mode))+  throwErrnoIfMinus1 "fdSeek" (Base.c_lseek fd off (mode2Int mode))  -- ----------------------------------------------------------------------------- -- Locking@@ -306,6 +358,11 @@     maybeResult (_, (Unlock, _, _, _)) = Nothing     maybeResult x = Just x +type CFLock     = ()++foreign import ccall unsafe "HsBase.h fcntl_lock"+   c_fcntl_lock  :: CInt -> CInt -> Ptr CFLock -> IO CInt+ allocaLock :: FileLock -> (Ptr CFLock -> IO a) -> IO a allocaLock (lockreq, mode, start, len) io =    allocaBytes (#const sizeof(struct flock)) $ \p -> do@@ -357,22 +414,55 @@ -- ----------------------------------------------------------------------------- -- fd{Read,Write} --- | May throw an exception if this is an invalid descriptor.+-- | Read data from an 'Fd' and convert it to a 'String'.  Throws an+-- exception if this is an invalid descriptor, or EOF has been+-- reached. fdRead :: Fd        -> ByteCount -- ^How many bytes to read        -> IO (String, ByteCount) -- ^The bytes read, how many bytes were read. fdRead _fd 0 = return ("", 0)-fdRead (Fd fd) nbytes = do-    allocaBytes (fromIntegral nbytes) $ \ bytes -> do-    rc    <-  throwErrnoIfMinus1Retry "fdRead" (c_read fd bytes nbytes)+fdRead fd nbytes = do+    allocaBytes (fromIntegral nbytes) $ \ buf -> do+    rc <- fdReadBuf fd buf nbytes     case fromIntegral rc of-      0 -> ioError (IOError Nothing EOF "fdRead" "EOF" Nothing)+      0 -> ioError (ioeSetErrorString (mkIOError EOF "fdRead" Nothing Nothing) "EOF")       n -> do-       s <- peekCStringLen (bytes, fromIntegral n)+       s <- peekCStringLen (castPtr buf, fromIntegral n)        return (s, n) --- | May throw an exception if this is an invalid descriptor.+-- | Read data from an 'Fd' into memory.  This is exactly equivalent+-- to the POSIX @read@ function.+fdReadBuf :: Fd+          -> Ptr Word8 -- ^ Memory in which to put the data+          -> ByteCount -- ^ Maximum number of bytes to read+          -> IO ByteCount -- ^ Number of bytes read (zero for EOF)+fdReadBuf _fd _buf 0 = return 0+fdReadBuf fd buf nbytes = +  fmap fromIntegral $+    throwErrnoIfMinus1Retry "fdReadBuf" $ +      c_safe_read (fromIntegral fd) (castPtr buf) (fromIntegral nbytes)++foreign import ccall safe "read"+   c_safe_read :: CInt -> Ptr CChar -> CSize -> IO CSsize++-- | Write a 'String' to an 'Fd' (no character conversion is done,+-- the least-significant 8 bits of each character are written). fdWrite :: Fd -> String -> IO ByteCount-fdWrite (Fd fd) str = withCStringLen str $ \ (strPtr,len) -> do-    rc <- throwErrnoIfMinus1Retry "fdWrite" (c_write fd strPtr (fromIntegral len))+fdWrite fd str = +  withCStringLen str $ \ (buf,len) -> do+    rc <- fdWriteBuf fd (castPtr buf) (fromIntegral len)     return (fromIntegral rc)++-- | Write data from memory to an 'Fd'.  This is exactly equivalent+-- to the POSIX @write@ function.+fdWriteBuf :: Fd+           -> Ptr Word8    -- ^ Memory containing the data to write+           -> ByteCount    -- ^ Maximum number of bytes to write+           -> IO ByteCount -- ^ Number of bytes written+fdWriteBuf fd buf len =+  fmap fromIntegral $+    throwErrnoIfMinus1Retry "fdWriteBuf" $ +      c_safe_write (fromIntegral fd) (castPtr buf) (fromIntegral len)++foreign import ccall safe "write" +   c_safe_write :: CInt -> Ptr CChar -> CSize -> IO CSsize
System/Posix/Process.hsc view
@@ -71,9 +71,7 @@ import Foreign.Ptr ( Ptr, nullPtr ) import Foreign.StablePtr ( StablePtr, newStablePtr, freeStablePtr ) import Foreign.Storable ( Storable(..) )-import System.IO import System.Exit-import System.Posix.Error import System.Posix.Process.Internals import System.Posix.Types import Control.Monad@@ -175,7 +173,7 @@  type CTms = () -foreign import ccall unsafe "times"+foreign import ccall unsafe "__hsunix_times"   c_times :: Ptr CTms -> IO CClock  -- -----------------------------------------------------------------------------@@ -276,7 +274,7 @@             -> Bool			    -- ^ Search PATH?             -> [String]			    -- ^ Arguments             -> Maybe [(String, String)]	    -- ^ Environment-            -> IO ()+            -> IO a executeFile path search args Nothing = do   withCString path $ \s ->     withMany withCString (path:args) $ \cstrs ->@@ -285,6 +283,7 @@ 	if search  	   then throwErrnoPathIfMinus1_ "executeFile" path (c_execvp s arr) 	   else throwErrnoPathIfMinus1_ "executeFile" path (c_execv s arr)+        return undefined -- never reached  executeFile path search args (Just env) = do   withCString path $ \s ->@@ -299,6 +298,7 @@ 		   (c_execvpe s arg_arr env_arr) 	   else throwErrnoPathIfMinus1_ "executeFile" path 		   (c_execve s arg_arr env_arr)+        return undefined -- never reached  foreign import ccall unsafe "execvp"   c_execvp :: CString -> Ptr CString -> IO CInt
System/Posix/Process/Internals.hs view
@@ -9,8 +9,6 @@ import System.IO.Error import GHC.Conc (Signal) --- we had to move this into GHC.Conc in GHC to avoid recursive dependencies.--- it can be moved back when the signal handling stuff in base is moved out. data ProcessStatus = Exited ExitCode                    | Terminated Signal                    | Stopped Signal
System/Posix/Semaphore.hsc view
@@ -24,12 +24,12 @@ #include <fcntl.h>  import Foreign.C-import Foreign.ForeignPtr+import Foreign.ForeignPtr hiding (newForeignPtr)+import Foreign.Concurrent import Foreign.Marshal import Foreign.Ptr import Foreign.Storable import System.Posix.Types-import System.Posix.Error import Control.Concurrent import Data.Bits @@ -52,11 +52,10 @@         semOpen' cname =             do sem <- throwErrnoPathIfNull "semOpen" name $                        sem_open cname (toEnum cflags) mode (toEnum value)-               finalizer <- mkCallback (finalize sem)-               fptr <- newForeignPtr finalizer sem+               fptr <- newForeignPtr sem (finalize sem)                return $ Semaphore fptr-        finalize sem _ = throwErrnoPathIfMinus1_ "semOpen" name $-                         sem_close sem in+        finalize sem = throwErrnoPathIfMinus1_ "semOpen" name $+                       sem_close sem in     withCAString name semOpen'  -- | Delete the semaphore with the given name.@@ -112,9 +111,6 @@                           cint <- peek ptr                           return $ fromEnum cint -foreign import ccall safe "wrapper"-        mkCallback :: (Ptr () -> IO ()) -> IO (FunPtr (Ptr () -> IO ()))-         foreign import ccall safe "sem_open"         sem_open :: CString -> CInt -> CMode -> CUInt -> IO (Ptr ()) foreign import ccall safe "sem_close"
System/Posix/Signals.hsc view
@@ -103,14 +103,17 @@ import Foreign.C import System.Posix.Types import System.Posix.Internals-import System.Posix.Process.Internals import System.Posix.Process-import Control.Monad+import System.Posix.Process.Internals import Data.Dynamic  #ifdef __GLASGOW_HASKELL__+#if __GLASGOW_HASKELL__ >= 611+##include "rts/Signals.h"+#else ##include "Signals.h"-import GHC.IOBase+#endif+ import GHC.Conc hiding (Signal) #endif @@ -571,10 +574,12 @@     	  Nothing -> do SignalSet fp <- getSignalMask; return fp     	  Just (SignalSet fp) -> return fp   withForeignPtr fp $ \p -> do-  c_sigsuspend p+  _ <- c_sigsuspend p   return ()   -- ignore the return value; according to the docs it can only ever be   -- (-1) with errno set to EINTR.+  -- XXX My manpage says it can also return EFAULT. And why is ignoring+  -- EINTR the right thing to do?   foreign import ccall unsafe "sigsuspend"   c_sigsuspend :: Ptr CSigset -> IO CInt
System/Posix/Terminal.hsc view
@@ -801,5 +801,6 @@   withForeignPtr fp1 $ \p1 -> do    withTerminalAttributes termios $ \p2 -> do     copyBytes p1 p2 (#const sizeof(struct termios))-    action p1+    _ <- action p1+    return ()   return $ makeTerminalAttributes fp1
System/Posix/Time.hsc view
@@ -33,5 +33,5 @@ epochTime :: IO EpochTime epochTime = throwErrnoIfMinus1 "epochTime" (c_time nullPtr) -foreign import ccall unsafe "time"+foreign import ccall unsafe "__hsunix_time"   c_time :: Ptr CTime -> IO CTime
System/Posix/Unistd.hsc view
@@ -158,7 +158,7 @@  data CTimeSpec -foreign import ccall safe "nanosleep" +foreign import ccall safe "__hsunix_nanosleep"    c_nanosleep :: Ptr CTimeSpec -> Ptr CTimeSpec -> IO CInt #endif
System/Posix/User.hsc view
@@ -167,13 +167,13 @@ #ifdef HAVE_GETGRGID_R getGroupEntryForID gid = do   allocaBytes (#const sizeof(struct group)) $ \pgr ->-    allocaBytes grBufSize $ \pbuf ->-      alloca $ \ ppgr -> do-        throwErrorIfNonZero_ "getGroupEntryForID" $-	     c_getgrgid_r gid pgr pbuf (fromIntegral grBufSize) ppgr-	throwErrnoIfNull "getGroupEntryForID" $-	     peekElemOff ppgr 0-	unpackGroupEntry pgr+    alloca $ \ ppgr -> do+      throwErrorIfNonZero_ "getGroupEntryForID" $+	   doubleAllocWhile isERANGE grBufSize $ \s b ->+	     c_getgrgid_r gid pgr b (fromIntegral s) ppgr+      _ <- throwErrnoIfNull "getGroupEntryForID" $+	   peekElemOff ppgr 0+      unpackGroupEntry pgr   foreign import ccall unsafe "getgrgid_r"@@ -190,19 +190,19 @@ #ifdef HAVE_GETGRNAM_R getGroupEntryForName name = do   allocaBytes (#const sizeof(struct group)) $ \pgr ->-    allocaBytes grBufSize $ \pbuf ->-      alloca $ \ ppgr ->-        withCString name $ \ pstr -> do-          throwErrorIfNonZero_ "getGroupEntryForName" $-            c_getgrnam_r pstr pgr pbuf (fromIntegral grBufSize) ppgr-          r <- peekElemOff ppgr 0-          when (r == nullPtr) $-            ioError $ flip ioeSetErrorString "no group name"-                    $ mkIOError doesNotExistErrorType-                                "getGroupEntryForName"-                                Nothing-                                (Just name)-          unpackGroupEntry pgr+    alloca $ \ ppgr ->+      withCString name $ \ pstr -> do+	throwErrorIfNonZero_ "getGroupEntryForName" $+	  doubleAllocWhile isERANGE grBufSize $ \s b ->+	    c_getgrnam_r pstr pgr b (fromIntegral s) ppgr+	r <- peekElemOff ppgr 0+	when (r == nullPtr) $+	  ioError $ flip ioeSetErrorString "no group name"+		  $ mkIOError doesNotExistErrorType+			      "getGroupEntryForName"+			      Nothing+			      (Just name)+	unpackGroupEntry pgr  foreign import ccall unsafe "getgrnam_r"   c_getgrnam_r :: CString -> Ptr CGroup -> CString@@ -213,6 +213,12 @@  -- | @getAllGroupEntries@ returns all group entries on the system by --   repeatedly calling @getgrent@++--+-- getAllGroupEntries may fail with isDoesNotExistError on Linux due to+-- this bug in glibc:+--   http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=466647+-- getAllGroupEntries :: IO [GroupEntry] #ifdef HAVE_GETGRENT getAllGroupEntries =@@ -235,9 +241,9 @@ #if defined(HAVE_GETGRGID_R) || defined(HAVE_GETGRNAM_R) grBufSize :: Int #if defined(HAVE_SYSCONF) && defined(HAVE_SC_GETGR_R_SIZE_MAX)-grBufSize = sysconfWithDefault 2048 (#const _SC_GETGR_R_SIZE_MAX)+grBufSize = sysconfWithDefault 1024 (#const _SC_GETGR_R_SIZE_MAX) #else-grBufSize = 2048	-- just assume some value (1024 is too small on OpenBSD)+grBufSize = 1024 #endif #endif @@ -284,15 +290,15 @@ #ifdef HAVE_GETPWUID_R getUserEntryForID uid = do   allocaBytes (#const sizeof(struct passwd)) $ \ppw ->-    allocaBytes pwBufSize $ \pbuf ->-      alloca $ \ pppw -> do-        throwErrorIfNonZero_ "getUserEntryForID" $-	     c_getpwuid_r uid ppw pbuf (fromIntegral pwBufSize) pppw-	throwErrnoIfNull "getUserEntryForID" $-	     peekElemOff pppw 0-	unpackUserEntry ppw+    alloca $ \ pppw -> do+      throwErrorIfNonZero_ "getUserEntryForID" $+	   doubleAllocWhile isERANGE pwBufSize $ \s b ->+	     c_getpwuid_r uid ppw b (fromIntegral s) pppw+      _ <- throwErrnoIfNull "getUserEntryForID" $+	   peekElemOff pppw 0+      unpackUserEntry ppw -foreign import ccall unsafe "getpwuid_r"+foreign import ccall unsafe "__hsunix_getpwuid_r"   c_getpwuid_r :: CUid -> Ptr CPasswd ->  			CString -> CSize -> Ptr (Ptr CPasswd) -> IO CInt #elif HAVE_GETPWUID@@ -314,21 +320,21 @@ #if HAVE_GETPWNAM_R getUserEntryForName name = do   allocaBytes (#const sizeof(struct passwd)) $ \ppw ->-    allocaBytes pwBufSize $ \pbuf ->-      alloca $ \ pppw ->-        withCString name $ \ pstr -> do-          throwErrorIfNonZero_ "getUserEntryForName" $-            c_getpwnam_r pstr ppw pbuf (fromIntegral pwBufSize) pppw-          r <- peekElemOff pppw 0-          when (r == nullPtr) $-            ioError $ flip ioeSetErrorString "no user name"-                    $ mkIOError doesNotExistErrorType-                                "getUserEntryForName"-                                Nothing-                                (Just name)-          unpackUserEntry ppw+    alloca $ \ pppw ->+      withCString name $ \ pstr -> do+	throwErrorIfNonZero_ "getUserEntryForName" $+	  doubleAllocWhile isERANGE pwBufSize $ \s b ->+	    c_getpwnam_r pstr ppw b (fromIntegral s) pppw+	r <- peekElemOff pppw 0+	when (r == nullPtr) $+	  ioError $ flip ioeSetErrorString "no user name"+		  $ mkIOError doesNotExistErrorType+			      "getUserEntryForName"+			      Nothing+			      (Just name)+	unpackUserEntry ppw -foreign import ccall unsafe "getpwnam_r"+foreign import ccall unsafe "__hsunix_getpwnam_r"   c_getpwnam_r :: CString -> Ptr CPasswd                -> CString -> CSize -> Ptr (Ptr CPasswd) -> IO CInt #elif HAVE_GETPWNAM@@ -359,7 +365,7 @@                      else do thisentry <- unpackUserEntry ppw                              worker (thisentry : accum) -foreign import ccall unsafe "getpwent"+foreign import ccall unsafe "__hsunix_getpwent"   c_getpwent :: IO (Ptr CPasswd) foreign import ccall unsafe "setpwent"   c_setpwent :: IO ()@@ -391,6 +397,14 @@     unsafePerformIO $ do v <- fmap fromIntegral $ c_sysconf sc                          return $ if v == (-1) then def else v #endif++isERANGE :: Integral a => a -> Bool+isERANGE = (== eRANGE) . Errno . fromIntegral++doubleAllocWhile :: (a -> Bool) -> Int -> (Int -> Ptr b -> IO a) -> IO a+doubleAllocWhile p s m = do+  r <- allocaBytes s (m s)+  if p r then doubleAllocWhile p (2 * s) m else return r  unpackUserEntry :: Ptr CPasswd -> IO UserEntry unpackUserEntry ptr = do
cbits/HsUnix.c view
@@ -42,6 +42,58 @@     return mknod(pathname,mode,dev); } +#ifdef HAVE_GETPWENT+// getpwent is a macro on some platforms, so we need a wrapper:+struct passwd *__hsunix_getpwent(void)+{+    return getpwent();+}+#endif++#if HAVE_GETPWNAM_R+// getpwnam_r is a macro on some platforms, so we need a wrapper:+int __hsunix_getpwnam_r(const char *name, struct passwd *pw, char *buffer,+                        size_t buflen, struct passwd **result)+{+    return getpwnam_r(name, pw, buffer, buflen, result);+}+#endif++#ifdef HAVE_GETPWUID_R+// getpwuid_r is a macro on some platforms, so we need a wrapper:+int __hsunix_getpwuid_r(uid_t uid, struct passwd *pw, char *buffer,+                        size_t buflen, struct passwd **result)+{+    return getpwuid_r(uid, pw, buffer, buflen, result);+}+#endif++#ifdef HAVE_NANOSLEEP+// nanosleep is a macro on some platforms, so we need a wrapper:+int __hsunix_nanosleep(const struct timespec *rqtp, struct timespec *rmtp)+{+    return nanosleep(rqtp, rmtp);+}+#endif++// opendir is a macro on some platforms, so we need a wrapper:+DIR *__hsunix_opendir(const char *filename)+{+    return opendir(filename);+}++// time is a macro on some platforms, so we need a wrapper:+time_t __hsunix_time(time_t *tloc)+{+    return time(tloc);+}++// times is a macro on some platforms, so we need a wrapper:+clock_t __hsunix_times(struct tms *tp)+{+    return times(tp);+}+ #ifdef HAVE_PTSNAME // I cannot figure out how to make the definitions of the following // functions visible in <stdlib.h> on Linux.  But these definitions
+ cbits/dirUtils.c view
@@ -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+}
configure view
@@ -5185,6 +5185,100 @@ done  +for ac_func in readdir_r+do+as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`+{ echo "$as_me:$LINENO: checking for $ac_func" >&5+echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6; }+if { as_var=$as_ac_var; eval "test \"\${$as_var+set}\" = set"; }; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */+/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.+   For example, HP-UX 11i <limits.h> declares gettimeofday.  */+#define $ac_func innocuous_$ac_func++/* System header to define __stub macros and hopefully few prototypes,+    which can conflict with char $ac_func (); below.+    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since+    <limits.h> exists even on freestanding compilers.  */++#ifdef __STDC__+# include <limits.h>+#else+# include <assert.h>+#endif++#undef $ac_func++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char $ac_func ();+/* The GNU C library defines this for functions which it implements+    to always fail with ENOSYS.  Some functions are actually named+    something starting with __ and the normal name is an alias.  */+#if defined __stub_$ac_func || defined __stub___$ac_func+choke me+#endif++int+main ()+{+return $ac_func ();+  ;+  return 0;+}+_ACEOF+rm -f conftest.$ac_objext conftest$ac_exeext+if { (ac_try="$ac_link"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5+  (eval "$ac_link") 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext &&+       $as_test_x conftest$ac_exeext; then+  eval "$as_ac_var=yes"+else+  echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	eval "$as_ac_var=no"+fi++rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \+      conftest$ac_exeext conftest.$ac_ext+fi+ac_res=`eval echo '${'$as_ac_var'}'`+	       { echo "$as_me:$LINENO: result: $ac_res" >&5+echo "${ECHO_T}$ac_res" >&6; }+if test `eval echo '${'$as_ac_var'}'` = yes; then+  cat >>confdefs.h <<_ACEOF+#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1+_ACEOF++fi+done++ # Avoid adding rt if absent or unneeded { echo "$as_me:$LINENO: checking for shm_open in -lrt" >&5 echo $ECHO_N "checking for shm_open in -lrt... $ECHO_C" >&6; }@@ -5801,7 +5895,7 @@ ### we'd like to return it; otherwise, we'll fake it. { echo "$as_me:$LINENO: checking return type of usleep" >&5 echo $ECHO_N "checking return type of usleep... $ECHO_C" >&6; }-if test "${cv_func_usleep_return_type+set}" = set; then+if test "${fptools_cv_func_usleep_return_type+set}" = set; then   echo $ECHO_N "(cached) $ECHO_C" >&6 else   cat >conftest.$ac_ext <<_ACEOF@@ -5815,16 +5909,16 @@ _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |   $EGREP "void[      ]+usleep" >/dev/null 2>&1; then-  cv_func_usleep_return_type=void+  fptools_cv_func_usleep_return_type=void else-  cv_func_usleep_return_type=int+  fptools_cv_func_usleep_return_type=int fi rm -f conftest*  fi-{ echo "$as_me:$LINENO: result: $cv_func_usleep_return_type" >&5-echo "${ECHO_T}$cv_func_usleep_return_type" >&6; }-case "$cv_func_usleep_return_type" in+{ echo "$as_me:$LINENO: result: $fptools_cv_func_usleep_return_type" >&5+echo "${ECHO_T}$fptools_cv_func_usleep_return_type" >&6; }+case "$fptools_cv_func_usleep_return_type" in   "void" )  cat >>confdefs.h <<\_ACEOF@@ -5838,7 +5932,7 @@ ###  in common use return void. { echo "$as_me:$LINENO: checking return type of unsetenv" >&5 echo $ECHO_N "checking return type of unsetenv... $ECHO_C" >&6; }-if test "${cv_func_unsetenv_return_type+set}" = set; then+if test "${fptools_cv_func_unsetenv_return_type+set}" = set; then   echo $ECHO_N "(cached) $ECHO_C" >&6 else   cat >conftest.$ac_ext <<_ACEOF@@ -5852,16 +5946,16 @@ _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |   $EGREP "void[      ]+unsetenv" >/dev/null 2>&1; then-  cv_func_unsetenv_return_type=void+  fptools_cv_func_unsetenv_return_type=void else-  cv_func_unsetenv_return_type=int+  fptools_cv_func_unsetenv_return_type=int fi rm -f conftest*  fi-{ echo "$as_me:$LINENO: result: $cv_func_unsetenv_return_type" >&5-echo "${ECHO_T}$cv_func_unsetenv_return_type" >&6; }-case "$cv_func_unsetenv_return_type" in+{ echo "$as_me:$LINENO: result: $fptools_cv_func_unsetenv_return_type" >&5+echo "${ECHO_T}$fptools_cv_func_unsetenv_return_type" >&6; }+case "$fptools_cv_func_unsetenv_return_type" in   "void" )  cat >>confdefs.h <<\_ACEOF
configure.ac view
@@ -27,6 +27,7 @@ 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"])@@ -69,12 +70,12 @@  ### On some systems usleep has no return value.  If it does have one, ### we'd like to return it; otherwise, we'll fake it.-AC_CACHE_CHECK([return type of usleep], cv_func_usleep_return_type,+AC_CACHE_CHECK([return type of usleep], fptools_cv_func_usleep_return_type,   [AC_EGREP_HEADER(changequote(<, >)<void[      ]+usleep>changequote([, ]),                    /usr/include/unistd.h,-                   [cv_func_usleep_return_type=void],-                   [cv_func_usleep_return_type=int])])-case "$cv_func_usleep_return_type" in+                   [fptools_cv_func_usleep_return_type=void],+                   [fptools_cv_func_usleep_return_type=int])])+case "$fptools_cv_func_usleep_return_type" in   "void" )     AC_DEFINE([USLEEP_RETURNS_VOID], [1], [Define if the system headers declare usleep to return void.])   ;;@@ -82,12 +83,12 @@  ###  POSIX.1003.1 unsetenv returns 0 or -1 (EINVAL), but older implementations ###  in common use return void.-AC_CACHE_CHECK([return type of unsetenv], cv_func_unsetenv_return_type,+AC_CACHE_CHECK([return type of unsetenv], fptools_cv_func_unsetenv_return_type,   [AC_EGREP_HEADER(changequote(<, >)<void[      ]+unsetenv>changequote([, ]),                    /usr/include/stdlib.h,-                   [cv_func_unsetenv_return_type=void],-                   [cv_func_unsetenv_return_type=int])])-case "$cv_func_unsetenv_return_type" in+                   [fptools_cv_func_unsetenv_return_type=void],+                   [fptools_cv_func_unsetenv_return_type=int])])+case "$fptools_cv_func_unsetenv_return_type" in   "void" )     AC_DEFINE([UNSETENV_RETURNS_VOID], [1], [Define if stdlib.h declares unsetenv to return void.])   ;;
include/HsUnix.h view
@@ -127,6 +127,37 @@ // lstat is a macro on some platforms, so we need a wrapper: int __hsunix_mknod(const char *pathname, mode_t mode, dev_t dev); +#ifdef HAVE_GETPWENT+// getpwent is a macro on some platforms, so we need a wrapper:+struct passwd *__hsunix_getpwent(void);+#endif++#if HAVE_GETPWNAM_R+// getpwnam_r is a macro on some platforms, so we need a wrapper:+int __hsunix_getpwnam_r(const char *, struct passwd *, char *, size_t,+                        struct passwd **);+#endif++#ifdef HAVE_GETPWUID_R+// getpwuid_r is a macro on some platforms, so we need a wrapper:+int __hsunix_getpwuid_r(uid_t, struct passwd *, char *, size_t,+                        struct passwd **);+#endif++#ifdef HAVE_NANOSLEEP+// nanosleep is a macro on some platforms, so we need a wrapper:+int __hsunix_nanosleep(const struct timespec *, struct timespec *);+#endif++// opendir is a macro on some platforms, so we need a wrapper:+DIR *__hsunix_opendir(const char *);++// time is a macro on some platforms, so we need a wrapper:+time_t __hsunix_time(time_t *);++// times is a macro on some platforms, so we need a wrapper:+clock_t __hsunix_times(struct tms *);+ #ifdef HAVE_PTSNAME // I cannot figure out how to make the definitions of the following // functions visible in <stdlib.h> on Linux.  But these definitions
include/HsUnixConfig.h view
@@ -163,6 +163,9 @@ /* Define to 1 if you have the <pwd.h> header file. */ #define HAVE_PWD_H 1 +/* Define to 1 if you have the `readdir_r' function. */+#define HAVE_READDIR_R 1+ /* Define to 1 if RTLD_DEFAULT is available. */ /* #undef HAVE_RTLDDEFAULT */
include/HsUnixConfig.h.in view
@@ -162,6 +162,9 @@ /* Define to 1 if you have the <pwd.h> header file. */ #undef HAVE_PWD_H +/* Define to 1 if you have the `readdir_r' function. */+#undef HAVE_READDIR_R+ /* Define to 1 if RTLD_DEFAULT is available. */ #undef HAVE_RTLDDEFAULT
unix.cabal view
@@ -1,8 +1,9 @@ name:		unix-version:	2.3.2.0+version:	2.4.0.0 license:	BSD3 license-file:	LICENSE maintainer:	libraries@haskell.org+bug-reports: http://hackage.haskell.org/trac/ghc/newticket?component=libraries/unix synopsis:	POSIX functionality category:       System description:@@ -12,29 +13,6 @@ 	IEEE Std. 1003.1). 	. 	The package is not supported under Windows (except under Cygwin).-build-type: Configure-exposed-modules:-		System.Posix-		System.Posix.DynamicLinker.Module-		System.Posix.DynamicLinker.Prim-		System.Posix.Directory-		System.Posix.DynamicLinker-		System.Posix.Env-		System.Posix.Error-		System.Posix.Files-		System.Posix.IO-		System.Posix.Process-		System.Posix.Process.Internals-		System.Posix.Resource-		System.Posix.Temp-		System.Posix.Terminal-		System.Posix.Time-		System.Posix.Unistd-		System.Posix.User-        System.Posix.Signals-		System.Posix.Signals.Exts-                System.Posix.Semaphore-                System.Posix.SharedMem extra-source-files:         config.guess config.sub install-sh 		configure.ac configure@@ -43,10 +21,41 @@ extra-tmp-files: 		config.log config.status autom4te.cache 		unix.buildinfo include/HsUnixConfig.h-build-depends:	base-extensions:	CPP, ForeignFunctionInterface, EmptyDataDecls-include-dirs: 	include-includes:       HsUnix.h execvpe.h-install-includes:-		HsUnix.h HsUnixConfig.h execvpe.h-c-sources:	cbits/HsUnix.c cbits/execvpe.c+build-type: Configure+Cabal-Version: >= 1.6++Library+    exposed-modules:+        System.Posix+        System.Posix.DynamicLinker.Module+        System.Posix.DynamicLinker.Prim+        System.Posix.Directory+        System.Posix.DynamicLinker+        System.Posix.Env+        System.Posix.Error+        System.Posix.Files+        System.Posix.IO+        System.Posix.Process+        System.Posix.Process.Internals+        System.Posix.Resource+        System.Posix.Temp+        System.Posix.Terminal+        System.Posix.Time+        System.Posix.Unistd+        System.Posix.User+        System.Posix.Signals+        System.Posix.Signals.Exts+        System.Posix.Semaphore+        System.Posix.SharedMem+    build-depends:	base >= 4.1 && < 4.3+    extensions:	CPP, ForeignFunctionInterface, EmptyDataDecls+    include-dirs: 	include+    includes:       HsUnix.h execvpe.h+    install-includes:+        HsUnix.h HsUnixConfig.h execvpe.h+    c-sources:	cbits/HsUnix.c cbits/execvpe.c cbits/dirUtils.c++source-repository head+    type:     darcs+    location: http://darcs.haskell.org/packages/unix/+