.travis.yml

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

cabal.project

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

hpath-directory/src/System/Posix/RawFilePath/Directory.hs

@@ -1150,8 +1150,7 @@ getDirsFiles' :: RawFilePath        -- ^ dir to read
 getDirsFiles' fp = do
   fd          <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing
   rawContents <- getDirectoryContents' fd
-  fmap catMaybes $ for rawContents $ \(_, f) -> do
+  fmap catMaybes $ for rawContents $ \(_, f) ->
-    putStrLn $ "getDirsFiles'" ++ (show f)
     if FP.isSpecialDirectoryEntry f then pure Nothing else pure $ Just f
 
 

hpath-posix/hpath-posix.cabal

@@ -34,7 +34,6 @@ library
   build-depends:         base                >= 4.8  && <5
                        , IfElse
                        , bytestring          >= 0.10
-                       , deepseq
                        , exceptions          >= 0.10
                        , hpath-filepath      >= 0.10.3
                        , safe-exceptions     >= 0.1

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

@@ -30,6 +30,8 @@ module System.Posix.RawFilePath.Directory.Traversals (
 
 -- lower-level stuff
 , readDirEnt
+, packDirStream
+, unpackDirStream
 , fdOpendir
 
 , realpath
@@ -39,7 +41,6 @@ module System.Posix.RawFilePath.Directory.Traversals (
 #if __GLASGOW_HASKELL__ < 710
 import Control.Applicative ((<$>))
 #endif
-import Control.DeepSeq
 import Control.Monad
 import System.Posix.FilePath ((</>))
 import System.Posix.Foreign
@@ -50,11 +51,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
@@ -146,6 +147,18 @@ 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"
@@ -164,14 +177,14 @@ foreign import ccall "realpath"
   c_realpath :: CString -> CString -> IO CString
 
 foreign import ccall unsafe "fdopendir"
-  c_fdopendir :: Posix.Fd -> IO (Ptr CDir)
+  c_fdopendir :: Posix.Fd -> IO (Ptr ())
 
 ----------------------------------------------------------
 -- less dodgy but still lower-level
 
 
 readDirEnt :: DirStream -> IO (DirType, RawFilePath)
-readDirEnt (DirStream dirp) =
+readDirEnt (unpackDirStream -> dirp) =
   alloca $ \ptr_dEnt  -> loop ptr_dEnt
  where
   loop ptr_dEnt = do
@@ -180,14 +193,12 @@ readDirEnt (DirStream dirp) =
     if (r == 0)
        then do
          dEnt <- peek ptr_dEnt
-         putStrLn $ "readDirEnt dEnt " ++ (show dEnt)
          if (dEnt == nullPtr)
             then return (dtUnknown,BS.empty)
             else do
-                 dName <- c_name dEnt >>= peekFilePath >>= evaluate . force
+                 dName <- c_name dEnt >>= peekFilePath
                  dType <- c_type dEnt
                  c_freeDirEnt dEnt
-                 putStrLn $ "readDirEnt" ++ (show dName)
                  return (dType, dName)
        else do
          errno <- getErrno
@@ -214,7 +225,7 @@ getDirectoryContents path =
 -- |Binding to @fdopendir(3)@.
 fdOpendir :: Posix.Fd -> IO DirStream
 fdOpendir fd =
-    DirStream <$> throwErrnoIfNull "fdOpendir" (c_fdopendir fd)
+    packDirStream <$> throwErrnoIfNull "fdOpendir" (c_fdopendir fd)
 
 
 -- |Like `getDirectoryContents` except for a file descriptor.

unix/LICENSE

@@ -1,31 +0,0 @@
-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

@@ -1,15 +0,0 @@
-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

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

unix/System/Posix.hs

@@ -1,189 +0,0 @@
-{-# 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

@@ -1,69 +0,0 @@
-{-# 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

@@ -1,127 +0,0 @@
-#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

@@ -1,164 +0,0 @@
-{-# 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

@@ -1,165 +0,0 @@
-{-# 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

@@ -1,88 +0,0 @@
-#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

@@ -1,72 +0,0 @@
-#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

@@ -1,73 +0,0 @@
-#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

@@ -1,92 +0,0 @@
-#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

@@ -1,121 +0,0 @@
-#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

@@ -1,79 +0,0 @@
-#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

@@ -1,123 +0,0 @@
-{-# 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

@@ -1,205 +0,0 @@
-{-# 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
-     list, it is inserted with the given value.  If the variable does exist,
-     the argument @overwrite@ is tested; if @overwrite@ is @False@, the variable is
-     not reset, otherwise it is reset to the given value.
--}
-
-setEnv ::
-  String {- ^ variable name  -} ->
-  String {- ^ variable value -} ->
-  Bool   {- ^ overwrite      -} ->
-  IO ()
-#ifdef HAVE_SETENV
-setEnv key value ovrwrt = do
-  withFilePath key $ \ keyP ->
-    withFilePath value $ \ valueP ->
-      throwErrnoIfMinus1_ "setenv" $
-        c_setenv keyP valueP (fromIntegral (fromEnum ovrwrt))
-
-foreign import ccall unsafe "setenv"
-   c_setenv :: CString -> CString -> CInt -> IO CInt
-#else
-setEnv key value True = putEnv (key++"="++value)
-setEnv key value False = do
-  res <- getEnv key
-  case res of
-    Just _  -> return ()
-    Nothing -> putEnv (key++"="++value)
-#endif
-
--- |The 'clearEnv' function clears the environment of all name-value pairs.
-clearEnv :: IO ()
-#if HAVE_CLEARENV
-clearEnv = void c_clearenv
-
-foreign import ccall unsafe "clearenv"
-  c_clearenv :: IO Int
-#else
--- Fallback to 'environ[0] = NULL'.
-clearEnv = do
-  c_environ <- getCEnviron
-  unless (c_environ == nullPtr) $
-    poke c_environ nullPtr
-#endif

unix/System/Posix/Env/ByteString.hsc

@@ -1,184 +0,0 @@
-{-# LANGUAGE CApiFFI #-}
-{-# LANGUAGE Trustworthy #-}
-#if __GLASGOW_HASKELL__ >= 709
-{-# OPTIONS_GHC -fno-warn-trustworthy-safe #-}
-#endif
-
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Env.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)
---
--- POSIX environment support
---
------------------------------------------------------------------------------
-
-module System.Posix.Env.ByteString (
-       -- * Environment Variables
-        getEnv
-        , getEnvDefault
-        , getEnvironmentPrim
-        , getEnvironment
-        , putEnv
-        , setEnv
-       , unsetEnv
-
-       -- * Program arguments
-       , getArgs
-) where
-
-#include "HsUnix.h"
-
-import Foreign
-import Foreign.C
-import Control.Monad    ( liftM )
-import Data.Maybe       ( fromMaybe )
-
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Char8 as BC
-import Data.ByteString (ByteString)
-
--- |'getEnv' looks up a variable in the environment.
-
-getEnv ::
-  ByteString            {- ^ variable name  -} ->
-  IO (Maybe ByteString) {- ^ variable value -}
-getEnv name = do
-  litstring <- B.useAsCString name c_getenv
-  if litstring /= nullPtr
-     then liftM Just $ B.packCString 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 ::
-  ByteString    {- ^ variable name                    -} ->
-  ByteString    {- ^ fallback value                   -} ->
-  IO ByteString {- ^ 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 [ByteString]
-getEnvironmentPrim = do
-  c_environ <- getCEnviron
-  arr <- peekArray0 nullPtr c_environ
-  mapM B.packCString 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 [(ByteString,ByteString)] {- ^ @[(key,value)]@ -}
-getEnvironment = do
-  env <- getEnvironmentPrim
-  return $ map (dropEq.(BC.break ((==) '='))) env
- where
-   dropEq (x,y)
-      | BC.head y == '=' = (x,B.tail y)
-      | otherwise       = error $ "getEnvironment: insane variable " ++ BC.unpack x
-
--- |The 'unsetEnv' function deletes all instances of the variable name
--- from the environment.
-
-unsetEnv :: ByteString {- ^ variable name -} -> IO ()
-#if HAVE_UNSETENV
-# if !UNSETENV_RETURNS_VOID
-unsetEnv name = B.useAsCString 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 = B.useAsCString 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 :: ByteString {- ^ "key=value" -} -> IO ()
-putEnv keyvalue = B.useAsCString keyvalue $ \s ->
-  throwErrnoIfMinus1_ "putenv" (c_putenv s)
-
-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
-     list, it is inserted with the given value.  If the variable does exist,
-     the argument @overwrite@ is tested; if @overwrite@ is @False@, the variable is
-     not reset, otherwise it is reset to the given value.
--}
-
-setEnv ::
-  ByteString {- ^ variable name  -} ->
-  ByteString {- ^ variable value -} ->
-  Bool       {- ^ overwrite      -} ->
-  IO ()
-#ifdef HAVE_SETENV
-setEnv key value ovrwrt = do
-  B.useAsCString key $ \ keyP ->
-    B.useAsCString value $ \ valueP ->
-      throwErrnoIfMinus1_ "setenv" $
-        c_setenv keyP valueP (fromIntegral (fromEnum ovrwrt))
-
-foreign import ccall unsafe "setenv"
-   c_setenv :: CString -> CString -> CInt -> IO CInt
-#else
-setEnv key value True = putEnv (key++"="++value)
-setEnv key value False = do
-  res <- getEnv key
-  case res of
-    Just _  -> return ()
-    Nothing -> putEnv (key++"="++value)
-#endif
-
--- | Computation 'getArgs' returns a list of the program's command
--- line arguments (not including the program name), as 'ByteString's.
---
--- Unlike 'System.Environment.getArgs', this function does no Unicode
--- decoding of the arguments; you get the exact bytes that were passed
--- to the program by the OS.  To interpret the arguments as text, some
--- Unicode decoding should be applied.
---
-getArgs :: IO [ByteString]
-getArgs =
-  alloca $ \ p_argc ->
-  alloca $ \ p_argv -> do
-   getProgArgv p_argc p_argv
-   p    <- fromIntegral `liftM` peek p_argc
-   argv <- peek p_argv
-   peekArray (p - 1) (advancePtr argv 1) >>= mapM B.packCString
-
-foreign import ccall unsafe "getProgArgv"
-  getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()

unix/System/Posix/Error.hs

@@ -1,63 +0,0 @@
-{-# LANGUAGE CPP #-}
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Error
--- 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 error support
---
------------------------------------------------------------------------------
-
-module System.Posix.Error (
-        throwErrnoPath,
-        throwErrnoPathIf,
-        throwErrnoPathIf_,
-        throwErrnoPathIfRetry,
-        throwErrnoPathIfNull,
-        throwErrnoPathIfNullRetry,
-        throwErrnoPathIfMinus1,
-        throwErrnoPathIfMinus1_,
-        throwErrnoPathIfMinus1Retry,
-        throwErrnoPathIfMinus1Retry_
-  ) where
-
-import Foreign hiding (void)
-import Foreign.C
-import Control.Monad
-
-throwErrnoPathIfMinus1Retry :: (Eq a, Num a)
-                            => String -> FilePath -> IO a -> IO a
-throwErrnoPathIfMinus1Retry loc path f =
-  throwErrnoPathIfRetry (== -1) loc path f
-
-throwErrnoPathIfMinus1Retry_ :: (Eq a, Num a)
-                             => String -> FilePath -> IO a -> IO ()
-throwErrnoPathIfMinus1Retry_ loc path f =
-  void $ throwErrnoPathIfRetry (== -1) loc path f
-
-throwErrnoPathIfNullRetry :: String -> FilePath -> IO (Ptr a) -> IO (Ptr a)
-throwErrnoPathIfNullRetry loc path f =
-  throwErrnoPathIfRetry (== nullPtr) loc path f
-
-throwErrnoPathIfRetry :: (a -> Bool) -> String -> FilePath -> IO a -> IO a
-throwErrnoPathIfRetry pr loc path f =
-  do
-    res <- f
-    if pr res
-      then do
-        err <- getErrno
-        if err == eINTR
-          then throwErrnoPathIfRetry pr loc path f
-          else throwErrnoPath loc path
-      else return res
-

unix/System/Posix/Fcntl.hsc

@@ -1,104 +0,0 @@
-{-# LANGUAGE CApiFFI #-}
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Fcntl
--- Copyright   :  (c) The University of Glasgow 2014
--- License     :  BSD-style (see the file LICENSE)
---
--- Maintainer  :  libraries@haskell.org
--- Stability   :  provisional
--- Portability :  non-portable (requires POSIX)
---
--- POSIX file control support
---
--- @since 2.7.1.0
------------------------------------------------------------------------------
-
-#include "HsUnix.h"
-
-module System.Posix.Fcntl (
-    -- * File allocation
-    Advice(..), fileAdvise,
-    fileAllocate,
-  ) where
-
-#if HAVE_POSIX_FALLOCATE || HAVE_POSIX_FADVISE
-import Foreign.C
-#endif
-import System.Posix.Types
-
-#if !HAVE_POSIX_FALLOCATE
-import System.IO.Error ( ioeSetLocation )
-import GHC.IO.Exception ( unsupportedOperation )
-#endif
-
--- -----------------------------------------------------------------------------
--- File control
-
--- | Advice parameter for 'fileAdvise' operation.
---
--- For more details, see documentation of @posix_fadvise(2)@.
---
--- @since 2.7.1.0
-data Advice
-  = AdviceNormal
-  | AdviceRandom
-  | AdviceSequential
-  | AdviceWillNeed
-  | AdviceDontNeed
-  | AdviceNoReuse
-  deriving Eq
-
--- | Performs @posix_fadvise(2)@ operation on file-descriptor.
---
--- If platform does not provide @posix_fadvise(2)@ 'fileAdvise'
--- becomes a no-op.
---
--- (use @#if HAVE_POSIX_FADVISE@ CPP guard to detect availability)
---
--- @since 2.7.1.0
-fileAdvise :: Fd -> FileOffset -> FileOffset -> Advice -> IO ()
-#if HAVE_POSIX_FADVISE
-fileAdvise fd off len adv = do
-  throwErrnoIfMinus1_ "fileAdvise" (c_posix_fadvise (fromIntegral fd) (fromIntegral off) (fromIntegral len) (packAdvice adv))
-
-foreign import capi safe "fcntl.h posix_fadvise"
-  c_posix_fadvise :: CInt -> COff -> COff -> CInt -> IO CInt
-
-packAdvice :: Advice -> CInt
-packAdvice AdviceNormal     = (#const POSIX_FADV_NORMAL)
-packAdvice AdviceRandom     = (#const POSIX_FADV_RANDOM)
-packAdvice AdviceSequential = (#const POSIX_FADV_SEQUENTIAL)
-packAdvice AdviceWillNeed   = (#const POSIX_FADV_WILLNEED)
-packAdvice AdviceDontNeed   = (#const POSIX_FADV_DONTNEED)
-packAdvice AdviceNoReuse    = (#const POSIX_FADV_NOREUSE)
-#else
-fileAdvise _ _ _ _ = return ()
-#endif
-
--- | Performs @posix_fallocate(2)@ operation on file-descriptor.
---
--- Throws 'IOError' (\"unsupported operation\") if platform does not
--- provide @posix_fallocate(2)@.
---
--- (use @#if HAVE_POSIX_FALLOCATE@ CPP guard to detect availability).
---
--- @since 2.7.1.0
-fileAllocate :: Fd -> FileOffset -> FileOffset -> IO ()
-#if HAVE_POSIX_FALLOCATE
-fileAllocate fd off len = do
-  throwErrnoIfMinus1_ "fileAllocate" (c_posix_fallocate (fromIntegral fd) (fromIntegral off) (fromIntegral len))
-
-foreign import capi safe "fcntl.h posix_fallocate"
-  c_posix_fallocate :: CInt -> COff -> COff -> IO CInt
-#else
-{-# WARNING fileAllocate
-    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_POSIX_FALLOCATE@)" #-}
-fileAllocate _ _ _ = ioError (ioeSetLocation unsupportedOperation
-                              "fileAllocate")
-#endif

unix/System/Posix/Files.hsc

@@ -1,448 +0,0 @@
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
-{-# LANGUAGE CApiFFI #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Files
--- 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)
---
--- Functions defined by the POSIX standards for manipulating and querying the
--- file system. Names of underlying POSIX functions are indicated whenever
--- possible. A more complete documentation of the POSIX functions together
--- with a more detailed description of different error conditions are usually
--- available in the system's manual pages or from
--- <http://www.unix.org/version3/online.html> (free registration required).
---
--- When a function that calls an underlying POSIX function fails, the errno
--- code is converted to an 'IOError' using 'Foreign.C.Error.errnoToIOError'.
--- For a list of which errno codes may be generated, consult the POSIX
--- documentation for the underlying function.
---
------------------------------------------------------------------------------
-
-#include "HsUnix.h"
-
-module System.Posix.Files (
-    -- * File modes
-    -- FileMode exported by System.Posix.Types
-    unionFileModes, intersectFileModes,
-    nullFileMode,
-    ownerReadMode, ownerWriteMode, ownerExecuteMode, ownerModes,
-    groupReadMode, groupWriteMode, groupExecuteMode, groupModes,
-    otherReadMode, otherWriteMode, otherExecuteMode, otherModes,
-    setUserIDMode, setGroupIDMode,
-    stdFileMode,   accessModes,
-    fileTypeModes,
-    blockSpecialMode, characterSpecialMode, namedPipeMode, regularFileMode,
-    directoryMode, symbolicLinkMode, socketMode,
-
-    -- ** Setting file modes
-    setFileMode, setFdMode, setFileCreationMask,
-
-    -- ** Checking file existence and permissions
-    fileAccess, fileExist,
-
-    -- * File status
-    FileStatus,
-    -- ** Obtaining file status
-    getFileStatus, getFdStatus, getSymbolicLinkStatus,
-    -- ** Querying file status
-    deviceID, fileID, fileMode, linkCount, fileOwner, fileGroup,
-    specialDeviceID, fileSize, accessTime, modificationTime,
-    statusChangeTime,
-    accessTimeHiRes, modificationTimeHiRes, statusChangeTimeHiRes,
-    isBlockDevice, isCharacterDevice, isNamedPipe, isRegularFile,
-    isDirectory, isSymbolicLink, isSocket,
-
-    -- * Creation
-    createNamedPipe,
-    createDevice,
-
-    -- * Hard links
-    createLink, removeLink,
-
-    -- * Symbolic links
-    createSymbolicLink, readSymbolicLink,
-
-    -- * Renaming files
-    rename,
-
-    -- * Changing file ownership
-    setOwnerAndGroup,  setFdOwnerAndGroup,
-#if HAVE_LCHOWN
-    setSymbolicLinkOwnerAndGroup,
-#endif
-
-    -- * Changing file timestamps
-    setFileTimes, setFileTimesHiRes,
-    setFdTimesHiRes, setSymbolicLinkTimesHiRes,
-    touchFile, touchFd, touchSymbolicLink,
-
-    -- * Setting file sizes
-    setFileSize, setFdSize,
-
-    -- * Find system-specific limits for a file
-    PathVar(..), getPathVar, getFdPathVar,
-  ) where
-
-
-import Foreign
-import Foreign.C
-
-import System.Posix.Types
-import System.Posix.Files.Common
-import System.Posix.Error
-import System.Posix.Internals
-
-import Data.Time.Clock.POSIX (POSIXTime)
-
--- -----------------------------------------------------------------------------
--- chmod()
-
--- | @setFileMode path mode@ changes permission of the file given by @path@
--- to @mode@. This operation may fail with 'throwErrnoPathIfMinus1_' if @path@
--- doesn't exist or if the effective user ID of the current process is not that
--- of the file's owner.
---
--- Note: calls @chmod@.
-setFileMode :: FilePath -> FileMode -> IO ()
-setFileMode name m =
-  withFilePath name $ \s -> do
-    throwErrnoPathIfMinus1_ "setFileMode" name (c_chmod s m)
-
--- -----------------------------------------------------------------------------
--- access()
-
--- | @fileAccess name read write exec@ checks if the file (or other file system
--- object) @name@ can be accessed for reading, writing and\/or executing. To
--- check a permission set the corresponding argument to 'True'.
---
--- Note: calls @access@.
-fileAccess :: FilePath -> Bool -> Bool -> Bool -> IO Bool
-fileAccess name readOK writeOK execOK = access name flags
-  where
-   flags   = read_f .|. write_f .|. exec_f
-   read_f  = if readOK  then (#const R_OK) else 0
-   write_f = if writeOK then (#const W_OK) else 0
-   exec_f  = if execOK  then (#const X_OK) else 0
-
--- | Checks for the existence of the file.
---
--- Note: calls @access@.
-fileExist :: FilePath -> IO Bool
-fileExist name =
-  withFilePath name $ \s -> do
-    r <- c_access s (#const F_OK)
-    if (r == 0)
-        then return True
-        else do err <- getErrno
-                if (err == eNOENT)
-                   then return False
-                   else throwErrnoPath "fileExist" name
-
-access :: FilePath -> CMode -> IO Bool
-access name flags =
-  withFilePath name $ \s -> do
-    r <- c_access s (fromIntegral flags)
-    if (r == 0)
-        then return True
-        else do err <- getErrno
-                if (err == eACCES || err == eROFS || err == eTXTBSY ||
-                    err == ePERM)
-                   then return False
-                   else throwErrnoPath "fileAccess" name
-
-
--- | @getFileStatus path@ calls gets the @FileStatus@ information (user ID,
--- size, access times, etc.) for the file @path@.
---
--- Note: calls @stat@.
-getFileStatus :: FilePath -> IO FileStatus
-getFileStatus path = do
-  fp <- mallocForeignPtrBytes (#const sizeof(struct stat))
-  withForeignPtr fp $ \p ->
-    withFilePath path $ \s ->
-      throwErrnoPathIfMinus1Retry_ "getFileStatus" path (c_stat s p)
-  return (FileStatus fp)
-
--- | Acts as 'getFileStatus' except when the 'FilePath' refers to a symbolic
--- link. In that case the @FileStatus@ information of the symbolic link itself
--- is returned instead of that of the file it points to.
---
--- Note: calls @lstat@.
-getSymbolicLinkStatus :: FilePath -> IO FileStatus
-getSymbolicLinkStatus path = do
-  fp <- mallocForeignPtrBytes (#const sizeof(struct stat))
-  withForeignPtr fp $ \p ->
-    withFilePath path $ \s ->
-      throwErrnoPathIfMinus1_ "getSymbolicLinkStatus" path (c_lstat s p)
-  return (FileStatus fp)
-
-foreign import capi unsafe "HsUnix.h lstat"
-  c_lstat :: CString -> Ptr CStat -> IO CInt
-
--- | @createNamedPipe fifo mode@
--- creates a new named pipe, @fifo@, with permissions based on
--- @mode@. May fail with 'throwErrnoPathIfMinus1_' if a file named @name@
--- already exists or if the effective user ID of the current process doesn't
--- have permission to create the pipe.
---
--- Note: calls @mkfifo@.
-createNamedPipe :: FilePath -> FileMode -> IO ()
-createNamedPipe name mode = do
-  withFilePath name $ \s ->
-    throwErrnoPathIfMinus1_ "createNamedPipe" name (c_mkfifo s mode)
-
--- | @createDevice path mode dev@ creates either a regular or a special file
--- depending on the value of @mode@ (and @dev@).  @mode@ will normally be either
--- 'blockSpecialMode' or 'characterSpecialMode'.  May fail with
--- 'throwErrnoPathIfMinus1_' if a file named @name@ already exists or if the
--- effective user ID of the current process doesn't have permission to create
--- the file.
---
--- Note: calls @mknod@.
-createDevice :: FilePath -> FileMode -> DeviceID -> IO ()
-createDevice path mode dev =
-  withFilePath path $ \s ->
-    throwErrnoPathIfMinus1_ "createDevice" path (c_mknod s mode dev)
-
-foreign import capi unsafe "HsUnix.h mknod"
-  c_mknod :: CString -> CMode -> CDev -> IO CInt
-
--- -----------------------------------------------------------------------------
--- Hard links
-
--- | @createLink old new@ creates a new path, @new@, linked to an existing file,
--- @old@.
---
--- Note: calls @link@.
-createLink :: FilePath -> FilePath -> IO ()
-createLink name1 name2 =
-  withFilePath name1 $ \s1 ->
-  withFilePath name2 $ \s2 ->
-  throwErrnoPathIfMinus1_ "createLink" name1 (c_link s1 s2)
-
--- | @removeLink path@ removes the link named @path@.
---
--- Note: calls @unlink@.
-removeLink :: FilePath -> IO ()
-removeLink name =
-  withFilePath name $ \s ->
-  throwErrnoPathIfMinus1_ "removeLink" name (c_unlink s)
-
--- -----------------------------------------------------------------------------
--- Symbolic Links
-
--- | @createSymbolicLink file1 file2@ creates a symbolic link named @file2@
--- which points to the file @file1@.
---
--- Symbolic links are interpreted at run-time as if the contents of the link
--- had been substituted into the path being followed to find a file or directory.
---
--- Note: calls @symlink@.
-createSymbolicLink :: FilePath -> FilePath -> IO ()
-createSymbolicLink file1 file2 =
-  withFilePath file1 $ \s1 ->
-  withFilePath file2 $ \s2 ->
-  throwErrnoPathIfMinus1_ "createSymbolicLink" file2 (c_symlink s1 s2)
-
-foreign import ccall unsafe "symlink"
-  c_symlink :: CString -> CString -> IO CInt
-
--- ToDo: should really use SYMLINK_MAX, but not everyone supports it yet,
--- and it seems that the intention is that SYMLINK_MAX is no larger than
--- PATH_MAX.
-#if !defined(PATH_MAX)
--- PATH_MAX is not defined on systems with unlimited path length.
--- Ugly.  Fix this.
-#define PATH_MAX 4096
-#endif
-
--- | Reads the @FilePath@ pointed to by the symbolic link and returns it.
---
--- Note: calls @readlink@.
-readSymbolicLink :: FilePath -> IO FilePath
-readSymbolicLink file =
-  allocaArray0 (#const PATH_MAX) $ \buf -> do
-    withFilePath file $ \s -> do
-      len <- throwErrnoPathIfMinus1 "readSymbolicLink" file $
-        c_readlink s buf (#const PATH_MAX)
-      peekFilePathLen (buf,fromIntegral len)
-
-foreign import ccall unsafe "readlink"
-  c_readlink :: CString -> CString -> CSize -> IO CInt
-
--- -----------------------------------------------------------------------------
--- Renaming files
-
--- | @rename old new@ renames a file or directory from @old@ to @new@.
---
--- Note: calls @rename@.
-rename :: FilePath -> FilePath -> IO ()
-rename name1 name2 =
-  withFilePath name1 $ \s1 ->
-  withFilePath name2 $ \s2 ->
-  throwErrnoPathIfMinus1_ "rename" name1 (c_rename s1 s2)
-
-foreign import ccall unsafe "rename"
-   c_rename :: CString -> CString -> IO CInt
-
--- -----------------------------------------------------------------------------
--- chown()
-
--- | @setOwnerAndGroup path uid gid@ changes the owner and group of @path@ to
--- @uid@ and @gid@, respectively.
---
--- If @uid@ or @gid@ is specified as -1, then that ID is not changed.
---
--- Note: calls @chown@.
-setOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()
-setOwnerAndGroup name uid gid = do
-  withFilePath name $ \s ->
-    throwErrnoPathIfMinus1_ "setOwnerAndGroup" name (c_chown s uid gid)
-
-foreign import ccall unsafe "chown"
-  c_chown :: CString -> CUid -> CGid -> IO CInt
-
-#if HAVE_LCHOWN
--- | Acts as 'setOwnerAndGroup' but does not follow symlinks (and thus
--- changes permissions on the link itself).
---
--- Note: calls @lchown@.
-setSymbolicLinkOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()
-setSymbolicLinkOwnerAndGroup name uid gid = do
-  withFilePath name $ \s ->
-    throwErrnoPathIfMinus1_ "setSymbolicLinkOwnerAndGroup" name
-        (c_lchown s uid gid)
-
-foreign import ccall unsafe "lchown"
-  c_lchown :: CString -> CUid -> CGid -> IO CInt
-#endif
-
--- -----------------------------------------------------------------------------
--- Setting file times
-
--- | @setFileTimes path atime mtime@ sets the access and modification times
--- associated with file @path@ to @atime@ and @mtime@, respectively.
---
--- Note: calls @utime@.
-setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO ()
-setFileTimes name atime mtime = do
-  withFilePath name $ \s ->
-   allocaBytes (#const sizeof(struct utimbuf)) $ \p -> do
-     (#poke struct utimbuf, actime)  p atime
-     (#poke struct utimbuf, modtime) p mtime
-     throwErrnoPathIfMinus1_ "setFileTimes" name (c_utime s p)
-
--- | Like 'setFileTimes' but timestamps can have sub-second resolution.
---
--- Note: calls @utimensat@ or @utimes@.
---
--- @since 2.7.0.0
-setFileTimesHiRes :: FilePath -> POSIXTime -> POSIXTime -> IO ()
-#ifdef HAVE_UTIMENSAT
-setFileTimesHiRes name atime mtime =
-  withFilePath name $ \s ->
-    withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
-      throwErrnoPathIfMinus1_ "setFileTimesHiRes" name $
-        c_utimensat (#const AT_FDCWD) s times 0
-#else
-setFileTimesHiRes name atime mtime =
-  withFilePath name $ \s ->
-    withArray [toCTimeVal atime, toCTimeVal mtime] $ \times ->
-      throwErrnoPathIfMinus1_ "setFileTimesHiRes" name (c_utimes s times)
-#endif
-
--- | Like 'setFileTimesHiRes' but does not follow symbolic links.
--- This operation is not supported on all platforms. On these platforms,
--- this function will raise an exception.
---
--- Note: calls @utimensat@ or @lutimes@.
---
--- @since 2.7.0.0
-setSymbolicLinkTimesHiRes :: FilePath -> POSIXTime -> POSIXTime -> IO ()
-#if HAVE_UTIMENSAT
-setSymbolicLinkTimesHiRes name atime mtime =
-  withFilePath name $ \s ->
-    withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
-      throwErrnoPathIfMinus1_ "setSymbolicLinkTimesHiRes" name $
-        c_utimensat (#const AT_FDCWD) s times (#const AT_SYMLINK_NOFOLLOW)
-#elif HAVE_LUTIMES
-setSymbolicLinkTimesHiRes name atime mtime =
-  withFilePath name $ \s ->
-    withArray [toCTimeVal atime, toCTimeVal mtime] $ \times ->
-      throwErrnoPathIfMinus1_ "setSymbolicLinkTimesHiRes" name $
-        c_lutimes s times
-#else
-setSymbolicLinkTimesHiRes =
-  error "setSymbolicLinkTimesHiRes: not available on this platform"
-#endif
-
--- | @touchFile path@ sets the access and modification times associated with
--- file @path@ to the current time.
---
--- Note: calls @utime@.
-touchFile :: FilePath -> IO ()
-touchFile name = do
-  withFilePath name $ \s ->
-   throwErrnoPathIfMinus1_ "touchFile" name (c_utime s nullPtr)
-
--- | Like 'touchFile' but does not follow symbolic links.
--- This operation is not supported on all platforms. On these platforms,
--- this function will raise an exception.
---
--- Note: calls @lutimes@.
---
--- @since 2.7.0.0
-touchSymbolicLink :: FilePath -> IO ()
-#if HAVE_LUTIMES
-touchSymbolicLink name =
-  withFilePath name $ \s ->
-    throwErrnoPathIfMinus1_ "touchSymbolicLink" name (c_lutimes s nullPtr)
-#else
-touchSymbolicLink =
-  error "touchSymbolicLink: not available on this platform"
-#endif
-
--- -----------------------------------------------------------------------------
--- Setting file sizes
-
--- | Truncates the file down to the specified length. If the file was larger
--- than the given length before this operation was performed the extra is lost.
---
--- Note: calls @truncate@.
-setFileSize :: FilePath -> FileOffset -> IO ()
-setFileSize file off =
-  withFilePath file $ \s ->
-    throwErrnoPathIfMinus1_ "setFileSize" file (c_truncate s off)
-
-foreign import capi unsafe "HsUnix.h truncate"
-  c_truncate :: CString -> COff -> IO CInt
-
--- -----------------------------------------------------------------------------
--- pathconf()/fpathconf() support
-
--- | @getPathVar var path@ obtains the dynamic value of the requested
--- configurable file limit or option associated with file or directory @path@.
--- For defined file limits, @getPathVar@ returns the associated
--- value.  For defined file options, the result of @getPathVar@
--- is undefined, but not failure.
---
--- Note: calls @pathconf@.
-getPathVar :: FilePath -> PathVar -> IO Limit
-getPathVar name v = do
-  withFilePath name $ \ nameP ->
-    throwErrnoPathIfMinus1 "getPathVar" name $
-      c_pathconf nameP (pathVarConst v)
-
-foreign import ccall unsafe "pathconf"
-  c_pathconf :: CString -> CInt -> IO CLong

unix/System/Posix/Files/ByteString.hsc

@@ -1,448 +0,0 @@
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
-{-# LANGUAGE CApiFFI #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Files.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)
---
--- Functions defined by the POSIX standards for manipulating and querying the
--- file system. Names of underlying POSIX functions are indicated whenever
--- possible. A more complete documentation of the POSIX functions together
--- with a more detailed description of different error conditions are usually
--- available in the system's manual pages or from
--- <http://www.unix.org/version3/online.html> (free registration required).
---
--- When a function that calls an underlying POSIX function fails, the errno
--- code is converted to an 'IOError' using 'Foreign.C.Error.errnoToIOError'.
--- For a list of which errno codes may be generated, consult the POSIX
--- documentation for the underlying function.
---
------------------------------------------------------------------------------
-
-#include "HsUnix.h"
-
-module System.Posix.Files.ByteString (
-    -- * File modes
-    -- FileMode exported by System.Posix.Types
-    unionFileModes, intersectFileModes,
-    nullFileMode,
-    ownerReadMode, ownerWriteMode, ownerExecuteMode, ownerModes,
-    groupReadMode, groupWriteMode, groupExecuteMode, groupModes,
-    otherReadMode, otherWriteMode, otherExecuteMode, otherModes,
-    setUserIDMode, setGroupIDMode,
-    stdFileMode,   accessModes,
-    fileTypeModes,
-    blockSpecialMode, characterSpecialMode, namedPipeMode, regularFileMode,
-    directoryMode, symbolicLinkMode, socketMode,
-
-    -- ** Setting file modes
-    setFileMode, setFdMode, setFileCreationMask,
-
-    -- ** Checking file existence and permissions
-    fileAccess, fileExist,
-
-    -- * File status
-    FileStatus,
-    -- ** Obtaining file status
-    getFileStatus, getFdStatus, getSymbolicLinkStatus,
-    -- ** Querying file status
-    deviceID, fileID, fileMode, linkCount, fileOwner, fileGroup,
-    specialDeviceID, fileSize, accessTime, modificationTime,
-    statusChangeTime,
-    accessTimeHiRes, modificationTimeHiRes, statusChangeTimeHiRes,
-    isBlockDevice, isCharacterDevice, isNamedPipe, isRegularFile,
-    isDirectory, isSymbolicLink, isSocket,
-
-    -- * Creation
-    createNamedPipe,
-    createDevice,
-
-    -- * Hard links
-    createLink, removeLink,
-
-    -- * Symbolic links
-    createSymbolicLink, readSymbolicLink,
-
-    -- * Renaming files
-    rename,
-
-    -- * Changing file ownership
-    setOwnerAndGroup,  setFdOwnerAndGroup,
-#if HAVE_LCHOWN
-    setSymbolicLinkOwnerAndGroup,
-#endif
-
-    -- * Changing file timestamps
-    setFileTimes, setFileTimesHiRes,
-    setFdTimesHiRes, setSymbolicLinkTimesHiRes,
-    touchFile, touchFd, touchSymbolicLink,
-
-    -- * Setting file sizes
-    setFileSize, setFdSize,
-
-    -- * Find system-specific limits for a file
-    PathVar(..), getPathVar, getFdPathVar,
-  ) where
-
-import System.Posix.Types
-import System.Posix.Internals hiding (withFilePath, peekFilePathLen)
-import Foreign
-import Foreign.C hiding (
-     throwErrnoPath,
-     throwErrnoPathIf,
-     throwErrnoPathIf_,
-     throwErrnoPathIfNull,
-     throwErrnoPathIfMinus1,
-     throwErrnoPathIfMinus1_ )
-
-import System.Posix.Files.Common
-import System.Posix.ByteString.FilePath
-
-import Data.Time.Clock.POSIX (POSIXTime)
-
--- -----------------------------------------------------------------------------
--- chmod()
-
--- | @setFileMode path mode@ changes permission of the file given by @path@
--- to @mode@. This operation may fail with 'throwErrnoPathIfMinus1_' if @path@
--- doesn't exist or if the effective user ID of the current process is not that
--- of the file's owner.
---
--- Note: calls @chmod@.
-setFileMode :: RawFilePath -> FileMode -> IO ()
-setFileMode name m =
-  withFilePath name $ \s -> do
-    throwErrnoPathIfMinus1_ "setFileMode" name (c_chmod s m)
-
-
--- -----------------------------------------------------------------------------
--- access()
-
--- | @fileAccess name read write exec@ checks if the file (or other file system
--- object) @name@ can be accessed for reading, writing and\/or executing. To
--- check a permission set the corresponding argument to 'True'.
---
--- Note: calls @access@.
-fileAccess :: RawFilePath -> Bool -> Bool -> Bool -> IO Bool
-fileAccess name readOK writeOK execOK = access name flags
-  where
-   flags   = read_f .|. write_f .|. exec_f
-   read_f  = if readOK  then (#const R_OK) else 0
-   write_f = if writeOK then (#const W_OK) else 0
-   exec_f  = if execOK  then (#const X_OK) else 0
-
--- | Checks for the existence of the file.
---
--- Note: calls @access@.
-fileExist :: RawFilePath -> IO Bool
-fileExist name =
-  withFilePath name $ \s -> do
-    r <- c_access s (#const F_OK)
-    if (r == 0)
-        then return True
-        else do err <- getErrno
-                if (err == eNOENT)
-                   then return False
-                   else throwErrnoPath "fileExist" name
-
-access :: RawFilePath -> CMode -> IO Bool
-access name flags =
-  withFilePath name $ \s -> do
-    r <- c_access s (fromIntegral flags)
-    if (r == 0)
-        then return True
-        else do err <- getErrno
-                if (err == eACCES || err == eROFS || err == eTXTBSY ||
-                    err == ePERM)
-                   then return False
-                   else throwErrnoPath "fileAccess" name
-
-
--- | @getFileStatus path@ calls gets the @FileStatus@ information (user ID,
--- size, access times, etc.) for the file @path@.
---
--- Note: calls @stat@.
-getFileStatus :: RawFilePath -> IO FileStatus
-getFileStatus path = do
-  fp <- mallocForeignPtrBytes (#const sizeof(struct stat))
-  withForeignPtr fp $ \p ->
-    withFilePath path $ \s ->
-      throwErrnoPathIfMinus1Retry_ "getFileStatus" path (c_stat s p)
-  return (FileStatus fp)
-
--- | Acts as 'getFileStatus' except when the 'RawFilePath' refers to a symbolic
--- link. In that case the @FileStatus@ information of the symbolic link itself
--- is returned instead of that of the file it points to.
---
--- Note: calls @lstat@.
-getSymbolicLinkStatus :: RawFilePath -> IO FileStatus
-getSymbolicLinkStatus path = do
-  fp <- mallocForeignPtrBytes (#const sizeof(struct stat))
-  withForeignPtr fp $ \p ->
-    withFilePath path $ \s ->
-      throwErrnoPathIfMinus1_ "getSymbolicLinkStatus" path (c_lstat s p)
-  return (FileStatus fp)
-
-foreign import capi unsafe "HsUnix.h lstat"
-  c_lstat :: CString -> Ptr CStat -> IO CInt
-
--- | @createNamedPipe fifo mode@
--- creates a new named pipe, @fifo@, with permissions based on
--- @mode@. May fail with 'throwErrnoPathIfMinus1_' if a file named @name@
--- already exists or if the effective user ID of the current process doesn't
--- have permission to create the pipe.
---
--- Note: calls @mkfifo@.
-createNamedPipe :: RawFilePath -> FileMode -> IO ()
-createNamedPipe name mode = do
-  withFilePath name $ \s ->
-    throwErrnoPathIfMinus1_ "createNamedPipe" name (c_mkfifo s mode)
-
--- | @createDevice path mode dev@ creates either a regular or a special file
--- depending on the value of @mode@ (and @dev@).  @mode@ will normally be either
--- 'blockSpecialMode' or 'characterSpecialMode'.  May fail with
--- 'throwErrnoPathIfMinus1_' if a file named @name@ already exists or if the
--- effective user ID of the current process doesn't have permission to create
--- the file.
---
--- Note: calls @mknod@.
-createDevice :: RawFilePath -> FileMode -> DeviceID -> IO ()
-createDevice path mode dev =
-  withFilePath path $ \s ->
-    throwErrnoPathIfMinus1_ "createDevice" path (c_mknod s mode dev)
-
-foreign import capi unsafe "HsUnix.h mknod"
-  c_mknod :: CString -> CMode -> CDev -> IO CInt
-
--- -----------------------------------------------------------------------------
--- Hard links
-
--- | @createLink old new@ creates a new path, @new@, linked to an existing file,
--- @old@.
---
--- Note: calls @link@.
-createLink :: RawFilePath -> RawFilePath -> IO ()
-createLink name1 name2 =
-  withFilePath name1 $ \s1 ->
-  withFilePath name2 $ \s2 ->
-  throwErrnoPathIfMinus1_ "createLink" name1 (c_link s1 s2)
-
--- | @removeLink path@ removes the link named @path@.
---
--- Note: calls @unlink@.
-removeLink :: RawFilePath -> IO ()
-removeLink name =
-  withFilePath name $ \s ->
-  throwErrnoPathIfMinus1_ "removeLink" name (c_unlink s)
-
--- -----------------------------------------------------------------------------
--- Symbolic Links
-
--- | @createSymbolicLink file1 file2@ creates a symbolic link named @file2@
--- which points to the file @file1@.
---
--- Symbolic links are interpreted at run-time as if the contents of the link
--- had been substituted into the path being followed to find a file or directory.
---
--- Note: calls @symlink@.
-createSymbolicLink :: RawFilePath -> RawFilePath -> IO ()
-createSymbolicLink file1 file2 =
-  withFilePath file1 $ \s1 ->
-  withFilePath file2 $ \s2 ->
-  throwErrnoPathIfMinus1_ "createSymbolicLink" file2 (c_symlink s1 s2)
-
-foreign import ccall unsafe "symlink"
-  c_symlink :: CString -> CString -> IO CInt
-
--- ToDo: should really use SYMLINK_MAX, but not everyone supports it yet,
--- and it seems that the intention is that SYMLINK_MAX is no larger than
--- PATH_MAX.
-#if !defined(PATH_MAX)
--- PATH_MAX is not defined on systems with unlimited path length.
--- Ugly.  Fix this.
-#define PATH_MAX 4096
-#endif
-
--- | Reads the @RawFilePath@ pointed to by the symbolic link and returns it.
---
--- Note: calls @readlink@.
-readSymbolicLink :: RawFilePath -> IO RawFilePath
-readSymbolicLink file =
-  allocaArray0 (#const PATH_MAX) $ \buf -> do
-    withFilePath file $ \s -> do
-      len <- throwErrnoPathIfMinus1 "readSymbolicLink" file $
-        c_readlink s buf (#const PATH_MAX)
-      peekFilePathLen (buf,fromIntegral len)
-
-foreign import ccall unsafe "readlink"
-  c_readlink :: CString -> CString -> CSize -> IO CInt
-
--- -----------------------------------------------------------------------------
--- Renaming files
-
--- | @rename old new@ renames a file or directory from @old@ to @new@.
---
--- Note: calls @rename@.
-rename :: RawFilePath -> RawFilePath -> IO ()
-rename name1 name2 =
-  withFilePath name1 $ \s1 ->
-  withFilePath name2 $ \s2 ->
-  throwErrnoPathIfMinus1_ "rename" name1 (c_rename s1 s2)
-
-foreign import ccall unsafe "rename"
-   c_rename :: CString -> CString -> IO CInt
-
--- -----------------------------------------------------------------------------
--- chown()
-
--- | @setOwnerAndGroup path uid gid@ changes the owner and group of @path@ to
--- @uid@ and @gid@, respectively.
---
--- If @uid@ or @gid@ is specified as -1, then that ID is not changed.
---
--- Note: calls @chown@.
-setOwnerAndGroup :: RawFilePath -> UserID -> GroupID -> IO ()
-setOwnerAndGroup name uid gid = do
-  withFilePath name $ \s ->
-    throwErrnoPathIfMinus1_ "setOwnerAndGroup" name (c_chown s uid gid)
-
-foreign import ccall unsafe "chown"
-  c_chown :: CString -> CUid -> CGid -> IO CInt
-
-#if HAVE_LCHOWN
--- | Acts as 'setOwnerAndGroup' but does not follow symlinks (and thus
--- changes permissions on the link itself).
---
--- Note: calls @lchown@.
-setSymbolicLinkOwnerAndGroup :: RawFilePath -> UserID -> GroupID -> IO ()
-setSymbolicLinkOwnerAndGroup name uid gid = do
-  withFilePath name $ \s ->
-    throwErrnoPathIfMinus1_ "setSymbolicLinkOwnerAndGroup" name
-        (c_lchown s uid gid)
-
-foreign import ccall unsafe "lchown"
-  c_lchown :: CString -> CUid -> CGid -> IO CInt
-#endif
-
--- -----------------------------------------------------------------------------
--- Setting file times
-
--- | @setFileTimes path atime mtime@ sets the access and modification times
--- associated with file @path@ to @atime@ and @mtime@, respectively.
---
--- Note: calls @utime@.
-setFileTimes :: RawFilePath -> EpochTime -> EpochTime -> IO ()
-setFileTimes name atime mtime = do
-  withFilePath name $ \s ->
-   allocaBytes (#const sizeof(struct utimbuf)) $ \p -> do
-     (#poke struct utimbuf, actime)  p atime
-     (#poke struct utimbuf, modtime) p mtime
-     throwErrnoPathIfMinus1_ "setFileTimes" name (c_utime s p)
-
--- | Like 'setFileTimes' but timestamps can have sub-second resolution.
---
--- Note: calls @utimensat@ or @utimes@.
-setFileTimesHiRes :: RawFilePath -> POSIXTime -> POSIXTime -> IO ()
-#ifdef HAVE_UTIMENSAT
-setFileTimesHiRes name atime mtime =
-  withFilePath name $ \s ->
-    withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
-      throwErrnoPathIfMinus1_ "setFileTimesHiRes" name $
-        c_utimensat (#const AT_FDCWD) s times 0
-#else
-setFileTimesHiRes name atime mtime =
-  withFilePath name $ \s ->
-    withArray [toCTimeVal atime, toCTimeVal mtime] $ \times ->
-      throwErrnoPathIfMinus1_ "setFileTimesHiRes" name (c_utimes s times)
-#endif
-
--- | Like 'setFileTimesHiRes' but does not follow symbolic links.
--- This operation is not supported on all platforms. On these platforms,
--- this function will raise an exception.
---
--- Note: calls @utimensat@ or @lutimes@.
-setSymbolicLinkTimesHiRes :: RawFilePath -> POSIXTime -> POSIXTime -> IO ()
-#if HAVE_UTIMENSAT
-setSymbolicLinkTimesHiRes name atime mtime =
-  withFilePath name $ \s ->
-    withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
-      throwErrnoPathIfMinus1_ "setSymbolicLinkTimesHiRes" name $
-        c_utimensat (#const AT_FDCWD) s times (#const AT_SYMLINK_NOFOLLOW)
-#elif HAVE_LUTIMES
-setSymbolicLinkTimesHiRes name atime mtime =
-  withFilePath name $ \s ->
-    withArray [toCTimeVal atime, toCTimeVal mtime] $ \times ->
-      throwErrnoPathIfMinus1_ "setSymbolicLinkTimesHiRes" name $
-        c_lutimes s times
-#else
-setSymbolicLinkTimesHiRes =
-  error "setSymbolicLinkTimesHiRes: not available on this platform"
-#endif
-
--- | @touchFile path@ sets the access and modification times associated with
--- file @path@ to the current time.
---
--- Note: calls @utime@.
-touchFile :: RawFilePath -> IO ()
-touchFile name = do
-  withFilePath name $ \s ->
-   throwErrnoPathIfMinus1_ "touchFile" name (c_utime s nullPtr)
-
--- | Like 'touchFile' but does not follow symbolic links.
--- This operation is not supported on all platforms. On these platforms,
--- this function will raise an exception.
---
--- Note: calls @lutimes@.
-touchSymbolicLink :: RawFilePath -> IO ()
-#if HAVE_LUTIMES
-touchSymbolicLink name =
-  withFilePath name $ \s ->
-    throwErrnoPathIfMinus1_ "touchSymbolicLink" name (c_lutimes s nullPtr)
-#else
-touchSymbolicLink =
-  error "touchSymbolicLink: not available on this platform"
-#endif
-
--- -----------------------------------------------------------------------------
--- Setting file sizes
-
--- | Truncates the file down to the specified length. If the file was larger
--- than the given length before this operation was performed the extra is lost.
---
--- Note: calls @truncate@.
-setFileSize :: RawFilePath -> FileOffset -> IO ()
-setFileSize file off =
-  withFilePath file $ \s ->
-    throwErrnoPathIfMinus1_ "setFileSize" file (c_truncate s off)
-
-foreign import capi unsafe "HsUnix.h truncate"
-  c_truncate :: CString -> COff -> IO CInt
-
--- -----------------------------------------------------------------------------
--- pathconf()/fpathconf() support
-
--- | @getPathVar var path@ obtains the dynamic value of the requested
--- configurable file limit or option associated with file or directory @path@.
--- For defined file limits, @getPathVar@ returns the associated
--- value.  For defined file options, the result of @getPathVar@
--- is undefined, but not failure.
---
--- Note: calls @pathconf@.
-getPathVar :: RawFilePath -> PathVar -> IO Limit
-getPathVar name v = do
-  withFilePath name $ \ nameP ->
-    throwErrnoPathIfMinus1 "getPathVar" name $
-      c_pathconf nameP (pathVarConst v)
-
-foreign import ccall unsafe "pathconf"
-  c_pathconf :: CString -> CInt -> IO CLong

unix/System/Posix/Files/Common.hsc

@@ -1,605 +0,0 @@
-{-# LANGUAGE Trustworthy #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Files.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)
---
--- Functions defined by the POSIX standards for manipulating and querying the
--- file system. Names of underlying POSIX functions are indicated whenever
--- possible. A more complete documentation of the POSIX functions together
--- with a more detailed description of different error conditions are usually
--- available in the system's manual pages or from
--- <http://www.unix.org/version3/online.html> (free registration required).
---
--- When a function that calls an underlying POSIX function fails, the errno
--- code is converted to an 'IOError' using 'Foreign.C.Error.errnoToIOError'.
--- For a list of which errno codes may be generated, consult the POSIX
--- documentation for the underlying function.
---
------------------------------------------------------------------------------
-
-#include "HsUnix.h"
-
-module System.Posix.Files.Common (
-    -- * File modes
-    -- FileMode exported by System.Posix.Types
-    unionFileModes, intersectFileModes,
-    nullFileMode,
-    ownerReadMode, ownerWriteMode, ownerExecuteMode, ownerModes,
-    groupReadMode, groupWriteMode, groupExecuteMode, groupModes,
-    otherReadMode, otherWriteMode, otherExecuteMode, otherModes,
-    setUserIDMode, setGroupIDMode,
-    stdFileMode,   accessModes,
-    fileTypeModes,
-    blockSpecialMode, characterSpecialMode, namedPipeMode, regularFileMode,
-    directoryMode, symbolicLinkMode, socketMode,
-
-    -- ** Setting file modes
-    setFdMode, setFileCreationMask,
-
-    -- * File status
-    FileStatus(..),
-    -- ** Obtaining file status
-    getFdStatus,
-    -- ** Querying file status
-    deviceID, fileID, fileMode, linkCount, fileOwner, fileGroup,
-    specialDeviceID, fileSize, accessTime, modificationTime,
-    statusChangeTime,
-    accessTimeHiRes, modificationTimeHiRes, statusChangeTimeHiRes,
-    setFdTimesHiRes, touchFd,
-    isBlockDevice, isCharacterDevice, isNamedPipe, isRegularFile,
-    isDirectory, isSymbolicLink, isSocket,
-
-    -- * Setting file sizes
-    setFdSize,
-
-    -- * Changing file ownership
-    setFdOwnerAndGroup,
-
-    -- * Find system-specific limits for a file
-    PathVar(..), getFdPathVar, pathVarConst,
-
-    -- * Low level types and functions
-#ifdef HAVE_UTIMENSAT
-    CTimeSpec(..),
-    toCTimeSpec,
-    c_utimensat,
-#endif
-    CTimeVal(..),
-    toCTimeVal,
-    c_utimes,
-#ifdef HAVE_LUTIMES
-    c_lutimes,
-#endif
-  ) where
-
-import System.Posix.Types
-import System.IO.Unsafe
-import Data.Bits
-import Data.Int
-import Data.Ratio
-import Data.Time.Clock.POSIX (POSIXTime)
-import System.Posix.Internals
-import Foreign.C
-import Foreign.ForeignPtr
-#if defined(HAVE_FUTIMES) || defined(HAVE_FUTIMENS)
-import Foreign.Marshal (withArray)
-#endif
-import Foreign.Ptr
-import Foreign.Storable
-
--- -----------------------------------------------------------------------------
--- POSIX file modes
-
--- The abstract type 'FileMode', constants and operators for
--- manipulating the file modes defined by POSIX.
-
--- | No permissions.
-nullFileMode :: FileMode
-nullFileMode = 0
-
--- | Owner has read permission.
-ownerReadMode :: FileMode
-ownerReadMode = (#const S_IRUSR)
-
--- | Owner has write permission.
-ownerWriteMode :: FileMode
-ownerWriteMode = (#const S_IWUSR)
-
--- | Owner has execute permission.
-ownerExecuteMode :: FileMode
-ownerExecuteMode = (#const S_IXUSR)
-
--- | Group has read permission.
-groupReadMode :: FileMode
-groupReadMode = (#const S_IRGRP)
-
--- | Group has write permission.
-groupWriteMode :: FileMode
-groupWriteMode = (#const S_IWGRP)
-
--- | Group has execute permission.
-groupExecuteMode :: FileMode
-groupExecuteMode = (#const S_IXGRP)
-
--- | Others have read permission.
-otherReadMode :: FileMode
-otherReadMode = (#const S_IROTH)
-
--- | Others have write permission.
-otherWriteMode :: FileMode
-otherWriteMode = (#const S_IWOTH)
-
--- | Others have execute permission.
-otherExecuteMode :: FileMode
-otherExecuteMode = (#const S_IXOTH)
-
--- | Set user ID on execution.
-setUserIDMode :: FileMode
-setUserIDMode = (#const S_ISUID)
-
--- | Set group ID on execution.
-setGroupIDMode :: FileMode
-setGroupIDMode = (#const S_ISGID)
-
--- | Owner, group and others have read and write permission.
-stdFileMode :: FileMode
-stdFileMode = ownerReadMode  .|. ownerWriteMode .|.
-              groupReadMode  .|. groupWriteMode .|.
-              otherReadMode  .|. otherWriteMode
-
--- | Owner has read, write and execute permission.
-ownerModes :: FileMode
-ownerModes = (#const S_IRWXU)
-
--- | Group has read, write and execute permission.
-groupModes :: FileMode
-groupModes = (#const S_IRWXG)
-
--- | Others have read, write and execute permission.
-otherModes :: FileMode
-otherModes = (#const S_IRWXO)
-
--- | Owner, group and others have read, write and execute permission.
-accessModes :: FileMode
-accessModes = ownerModes .|. groupModes .|. otherModes
-
--- | Combines the two file modes into one that contains modes that appear in
--- either.
-unionFileModes :: FileMode -> FileMode -> FileMode
-unionFileModes m1 m2 = m1 .|. m2
-
--- | Combines two file modes into one that only contains modes that appear in
--- both.
-intersectFileModes :: FileMode -> FileMode -> FileMode
-intersectFileModes m1 m2 = m1 .&. m2
-
-fileTypeModes :: FileMode
-fileTypeModes = (#const S_IFMT)
-
-blockSpecialMode :: FileMode
-blockSpecialMode = (#const S_IFBLK)
-
-characterSpecialMode :: FileMode
-characterSpecialMode = (#const S_IFCHR)
-
-namedPipeMode :: FileMode
-namedPipeMode = (#const S_IFIFO)
-
-regularFileMode :: FileMode
-regularFileMode = (#const S_IFREG)
-
-directoryMode :: FileMode
-directoryMode = (#const S_IFDIR)
-
-symbolicLinkMode :: FileMode
-symbolicLinkMode = (#const S_IFLNK)
-
-socketMode :: FileMode
-socketMode = (#const S_IFSOCK)
-
--- | @setFdMode fd mode@ acts like 'setFileMode' but uses a file descriptor
--- @fd@ instead of a 'FilePath'.
---
--- Note: calls @fchmod@.
-setFdMode :: Fd -> FileMode -> IO ()
-setFdMode (Fd fd) m =
-  throwErrnoIfMinus1_ "setFdMode" (c_fchmod fd m)
-
-foreign import ccall unsafe "fchmod"
-  c_fchmod :: CInt -> CMode -> IO CInt
-
--- | @setFileCreationMask mode@ sets the file mode creation mask to @mode@.
--- Modes set by this operation are subtracted from files and directories upon
--- creation. The previous file creation mask is returned.
---
--- Note: calls @umask@.
-setFileCreationMask :: FileMode -> IO FileMode
-setFileCreationMask mask = c_umask mask
-
--- -----------------------------------------------------------------------------
--- stat() support
-
--- | POSIX defines operations to get information, such as owner, permissions,
--- size and access times, about a file. This information is represented by the
--- 'FileStatus' type.
---
--- Note: see @chmod@.
-newtype FileStatus = FileStatus (ForeignPtr CStat)
-
--- | ID of the device on which this file resides.
-deviceID         :: FileStatus -> DeviceID
--- | inode number
-fileID           :: FileStatus -> FileID
--- | File mode (such as permissions).
-fileMode         :: FileStatus -> FileMode
--- | Number of hard links to this file.
-linkCount        :: FileStatus -> LinkCount
--- | ID of owner.
-fileOwner        :: FileStatus -> UserID
--- | ID of group.
-fileGroup        :: FileStatus -> GroupID
--- | Describes the device that this file represents.
-specialDeviceID  :: FileStatus -> DeviceID
--- | Size of the file in bytes. If this file is a symbolic link the size is
--- the length of the pathname it contains.
-fileSize         :: FileStatus -> FileOffset
--- | Time of last access.
-accessTime       :: FileStatus -> EpochTime
--- | Time of last access in sub-second resolution.
-accessTimeHiRes  :: FileStatus -> POSIXTime
--- | Time of last modification.
-modificationTime :: FileStatus -> EpochTime
--- | Time of last modification in sub-second resolution.
-modificationTimeHiRes :: FileStatus -> POSIXTime
--- | Time of last status change (i.e. owner, group, link count, mode, etc.).
-statusChangeTime :: FileStatus -> EpochTime
--- | Time of last status change (i.e. owner, group, link count, mode, etc.) in sub-second resolution.
-statusChangeTimeHiRes :: FileStatus -> POSIXTime
-
-deviceID (FileStatus stat) =
-  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_dev)
-fileID (FileStatus stat) =
-  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_ino)
-fileMode (FileStatus stat) =
-  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_mode)
-linkCount (FileStatus stat) =
-  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_nlink)
-fileOwner (FileStatus stat) =
-  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_uid)
-fileGroup (FileStatus stat) =
-  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_gid)
-specialDeviceID (FileStatus stat) =
-  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_rdev)
-fileSize (FileStatus stat) =
-  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_size)
-accessTime (FileStatus stat) =
-  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_atime)
-modificationTime (FileStatus stat) =
-  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_mtime)
-statusChangeTime (FileStatus stat) =
-  unsafePerformIO $ withForeignPtr stat $ (#peek struct stat, st_ctime)
-
-accessTimeHiRes (FileStatus stat) =
-  unsafePerformIO $ withForeignPtr stat $ \stat_ptr -> do
-    sec  <- (#peek struct stat, st_atime) stat_ptr :: IO EpochTime
-#ifdef HAVE_STRUCT_STAT_ST_ATIM
-    nsec <- (#peek struct stat, st_atim.tv_nsec) stat_ptr :: IO (#type long)
-    let frac = toInteger nsec % 10^(9::Int)
-#elif HAVE_STRUCT_STAT_ST_ATIMESPEC
-    nsec <- (#peek struct stat, st_atimespec.tv_nsec) stat_ptr :: IO (#type long)
-    let frac = toInteger nsec % 10^(9::Int)
-#elif HAVE_STRUCT_STAT_ST_ATIMENSEC
-    nsec <- (#peek struct stat, st_atimensec) stat_ptr :: IO (#type long)
-    let frac = toInteger nsec % 10^(9::Int)
-#elif HAVE_STRUCT_STAT_ST_ATIME_N
-    nsec <- (#peek struct stat, st_atime_n) stat_ptr :: IO (#type int)
-    let frac = toInteger nsec % 10^(9::Int)
-#elif HAVE_STRUCT_STAT_ST_UATIME
-    usec <- (#peek struct stat, st_uatime) stat_ptr :: IO (#type int)
-    let frac = toInteger usec % 10^(6::Int)
-#else
-    let frac = 0
-#endif
-    return $ fromRational $ toRational sec + frac
-
-modificationTimeHiRes (FileStatus stat) =
-  unsafePerformIO $ withForeignPtr stat $ \stat_ptr -> do
-    sec  <- (#peek struct stat, st_mtime) stat_ptr :: IO EpochTime
-#ifdef HAVE_STRUCT_STAT_ST_MTIM
-    nsec <- (#peek struct stat, st_mtim.tv_nsec) stat_ptr :: IO (#type long)
-    let frac = toInteger nsec % 10^(9::Int)
-#elif HAVE_STRUCT_STAT_ST_MTIMESPEC
-    nsec <- (#peek struct stat, st_mtimespec.tv_nsec) stat_ptr :: IO (#type long)
-    let frac = toInteger nsec % 10^(9::Int)
-#elif HAVE_STRUCT_STAT_ST_MTIMENSEC
-    nsec <- (#peek struct stat, st_mtimensec) stat_ptr :: IO (#type long)
-    let frac = toInteger nsec % 10^(9::Int)
-#elif HAVE_STRUCT_STAT_ST_MTIME_N
-    nsec <- (#peek struct stat, st_mtime_n) stat_ptr :: IO (#type int)
-    let frac = toInteger nsec % 10^(9::Int)
-#elif HAVE_STRUCT_STAT_ST_UMTIME
-    usec <- (#peek struct stat, st_umtime) stat_ptr :: IO (#type int)
-    let frac = toInteger usec % 10^(6::Int)
-#else
-    let frac = 0
-#endif
-    return $ fromRational $ toRational sec + frac
-
-statusChangeTimeHiRes (FileStatus stat) =
-  unsafePerformIO $ withForeignPtr stat $ \stat_ptr -> do
-    sec  <- (#peek struct stat, st_ctime) stat_ptr :: IO EpochTime
-#ifdef HAVE_STRUCT_STAT_ST_CTIM
-    nsec <- (#peek struct stat, st_ctim.tv_nsec) stat_ptr :: IO (#type long)
-    let frac = toInteger nsec % 10^(9::Int)
-#elif HAVE_STRUCT_STAT_ST_CTIMESPEC
-    nsec <- (#peek struct stat, st_ctimespec.tv_nsec) stat_ptr :: IO (#type long)
-    let frac = toInteger nsec % 10^(9::Int)
-#elif HAVE_STRUCT_STAT_ST_CTIMENSEC
-    nsec <- (#peek struct stat, st_ctimensec) stat_ptr :: IO (#type long)
-    let frac = toInteger nsec % 10^(9::Int)
-#elif HAVE_STRUCT_STAT_ST_CTIME_N
-    nsec <- (#peek struct stat, st_ctime_n) stat_ptr :: IO (#type int)
-    let frac = toInteger nsec % 10^(9::Int)
-#elif HAVE_STRUCT_STAT_ST_UCTIME
-    usec <- (#peek struct stat, st_uctime) stat_ptr :: IO (#type int)
-    let frac = toInteger usec % 10^(6::Int)
-#else
-    let frac = 0
-#endif
-    return $ fromRational $ toRational sec + frac
-
--- | Checks if this file is a block device.
-isBlockDevice     :: FileStatus -> Bool
--- | Checks if this file is a character device.
-isCharacterDevice :: FileStatus -> Bool
--- | Checks if this file is a named pipe device.
-isNamedPipe       :: FileStatus -> Bool
--- | Checks if this file is a regular file device.
-isRegularFile     :: FileStatus -> Bool
--- | Checks if this file is a directory device.
-isDirectory       :: FileStatus -> Bool
--- | Checks if this file is a symbolic link device.
-isSymbolicLink    :: FileStatus -> Bool
--- | Checks if this file is a socket device.
-isSocket          :: FileStatus -> Bool
-
-isBlockDevice stat =
-  (fileMode stat `intersectFileModes` fileTypeModes) == blockSpecialMode
-isCharacterDevice stat =
-  (fileMode stat `intersectFileModes` fileTypeModes) == characterSpecialMode
-isNamedPipe stat =
-  (fileMode stat `intersectFileModes` fileTypeModes) == namedPipeMode
-isRegularFile stat =
-  (fileMode stat `intersectFileModes` fileTypeModes) == regularFileMode
-isDirectory stat =
-  (fileMode stat `intersectFileModes` fileTypeModes) == directoryMode
-isSymbolicLink stat =
-  (fileMode stat `intersectFileModes` fileTypeModes) == symbolicLinkMode
-isSocket stat =
-  (fileMode stat `intersectFileModes` fileTypeModes) == socketMode
-
--- | @getFdStatus fd@ acts as 'getFileStatus' but uses a file descriptor @fd@.
---
--- Note: calls @fstat@.
-getFdStatus :: Fd -> IO FileStatus
-getFdStatus (Fd fd) = do
-  fp <- mallocForeignPtrBytes (#const sizeof(struct stat))
-  withForeignPtr fp $ \p ->
-    throwErrnoIfMinus1_ "getFdStatus" (c_fstat fd p)
-  return (FileStatus fp)
-
--- -----------------------------------------------------------------------------
--- Setting file times
-
-#if HAVE_UTIMENSAT || HAVE_FUTIMENS
-data CTimeSpec = CTimeSpec EpochTime CLong
-
-instance Storable CTimeSpec where
-    sizeOf    _ = #size struct timespec
-    alignment _ = alignment (undefined :: CInt)
-    poke p (CTimeSpec sec nsec) = do
-        (#poke struct timespec, tv_sec ) p sec
-        (#poke struct timespec, tv_nsec) p nsec
-    peek p = do
-        sec  <- #{peek struct timespec, tv_sec } p
-        nsec <- #{peek struct timespec, tv_nsec} p
-        return $ CTimeSpec sec nsec
-
-toCTimeSpec :: POSIXTime -> CTimeSpec
-toCTimeSpec t = CTimeSpec (CTime sec) (truncate $ 10^(9::Int) * frac)
-  where
-    (sec, frac) = if (frac' < 0) then (sec' - 1, frac' + 1) else (sec', frac')
-    (sec', frac') = properFraction $ toRational t
-#endif
-
-#ifdef HAVE_UTIMENSAT
-foreign import ccall unsafe "utimensat"
-    c_utimensat :: CInt -> CString -> Ptr CTimeSpec -> CInt -> IO CInt
-#endif
-
-#if HAVE_FUTIMENS
-foreign import ccall unsafe "futimens"
-    c_futimens :: CInt -> Ptr CTimeSpec -> IO CInt
-#endif
-
-data CTimeVal = CTimeVal CLong CLong
-
-instance Storable CTimeVal where
-    sizeOf    _ = #size struct timeval
-    alignment _ = alignment (undefined :: CInt)
-    poke p (CTimeVal sec usec) = do
-        (#poke struct timeval, tv_sec ) p sec
-        (#poke struct timeval, tv_usec) p usec
-    peek p = do
-        sec  <- #{peek struct timeval, tv_sec } p
-        usec <- #{peek struct timeval, tv_usec} p
-        return $ CTimeVal sec usec
-
-toCTimeVal :: POSIXTime -> CTimeVal
-toCTimeVal t = CTimeVal sec (truncate $ 10^(6::Int) * frac)
-  where
-    (sec, frac) = if (frac' < 0) then (sec' - 1, frac' + 1) else (sec', frac')
-    (sec', frac') = properFraction $ toRational t
-
-foreign import ccall unsafe "utimes"
-    c_utimes :: CString -> Ptr CTimeVal -> IO CInt
-
-#ifdef HAVE_LUTIMES
-foreign import ccall unsafe "lutimes"
-    c_lutimes :: CString -> Ptr CTimeVal -> IO CInt
-#endif
-
-#if HAVE_FUTIMES
-foreign import ccall unsafe "futimes"
-    c_futimes :: CInt -> Ptr CTimeVal -> IO CInt
-#endif
-
--- | Like 'setFileTimesHiRes' but uses a file descriptor instead of a path.
--- This operation is not supported on all platforms. On these platforms,
--- this function will raise an exception.
---
--- Note: calls @futimens@ or @futimes@.
---
--- @since 2.7.0.0
-setFdTimesHiRes :: Fd -> POSIXTime -> POSIXTime -> IO ()
-#if HAVE_FUTIMENS
-setFdTimesHiRes (Fd fd) atime mtime =
-  withArray [toCTimeSpec atime, toCTimeSpec mtime] $ \times ->
-    throwErrnoIfMinus1_ "setFdTimesHiRes" (c_futimens fd times)
-#elif HAVE_FUTIMES
-setFdTimesHiRes (Fd fd) atime mtime =
-  withArray [toCTimeVal atime, toCTimeVal mtime] $ \times ->
-    throwErrnoIfMinus1_ "setFdTimesHiRes" (c_futimes fd times)
-#else
-setFdTimesHiRes =
-  error "setSymbolicLinkTimesHiRes: not available on this platform"
-#endif
-
--- | Like 'touchFile' but uses a file descriptor instead of a path.
--- This operation is not supported on all platforms. On these platforms,
--- this function will raise an exception.
---
--- Note: calls @futimes@.
---
--- @since 2.7.0.0
-touchFd :: Fd -> IO ()
-#if HAVE_FUTIMES
-touchFd (Fd fd) =
-  throwErrnoIfMinus1_ "touchFd" (c_futimes fd nullPtr)
-#else
-touchFd =
-  error "touchFd: not available on this platform"
-#endif
-
--- -----------------------------------------------------------------------------
--- fchown()
-
--- | Acts as 'setOwnerAndGroup' but uses a file descriptor instead of a
--- 'FilePath'.
---
--- Note: calls @fchown@.
-setFdOwnerAndGroup :: Fd -> UserID -> GroupID -> IO ()
-setFdOwnerAndGroup (Fd fd) uid gid =
-  throwErrnoIfMinus1_ "setFdOwnerAndGroup" (c_fchown fd uid gid)
-
-foreign import ccall unsafe "fchown"
-  c_fchown :: CInt -> CUid -> CGid -> IO CInt
-
--- -----------------------------------------------------------------------------
--- ftruncate()
-
--- | Acts as 'setFileSize' but uses a file descriptor instead of a 'FilePath'.
---
--- Note: calls @ftruncate@.
-setFdSize :: Fd -> FileOffset -> IO ()
-setFdSize (Fd fd) off =
-  throwErrnoIfMinus1_ "setFdSize" (c_ftruncate fd off)
-
--- -----------------------------------------------------------------------------
--- pathconf()/fpathconf() support
-
-data PathVar
-  = FileSizeBits                  {- _PC_FILESIZEBITS     -}
-  | LinkLimit                     {- _PC_LINK_MAX         -}
-  | InputLineLimit                {- _PC_MAX_CANON        -}
-  | InputQueueLimit               {- _PC_MAX_INPUT        -}
-  | FileNameLimit                 {- _PC_NAME_MAX         -}
-  | PathNameLimit                 {- _PC_PATH_MAX         -}
-  | PipeBufferLimit               {- _PC_PIPE_BUF         -}
-                                  -- These are described as optional in POSIX:
-                                  {- _PC_ALLOC_SIZE_MIN     -}
-                                  {- _PC_REC_INCR_XFER_SIZE -}
-                                  {- _PC_REC_MAX_XFER_SIZE  -}
-                                  {- _PC_REC_MIN_XFER_SIZE  -}
-                                  {- _PC_REC_XFER_ALIGN     -}
-  | SymbolicLinkLimit             {- _PC_SYMLINK_MAX      -}
-  | SetOwnerAndGroupIsRestricted  {- _PC_CHOWN_RESTRICTED -}
-  | FileNamesAreNotTruncated      {- _PC_NO_TRUNC         -}
-  | VDisableChar                  {- _PC_VDISABLE         -}
-  | AsyncIOAvailable              {- _PC_ASYNC_IO         -}
-  | PrioIOAvailable               {- _PC_PRIO_IO          -}
-  | SyncIOAvailable               {- _PC_SYNC_IO          -}
-
-pathVarConst :: PathVar -> CInt
-pathVarConst v = case v of
-        LinkLimit                       -> (#const _PC_LINK_MAX)
-        InputLineLimit                  -> (#const _PC_MAX_CANON)
-        InputQueueLimit                 -> (#const _PC_MAX_INPUT)
-        FileNameLimit                   -> (#const _PC_NAME_MAX)
-        PathNameLimit                   -> (#const _PC_PATH_MAX)
-        PipeBufferLimit                 -> (#const _PC_PIPE_BUF)
-        SetOwnerAndGroupIsRestricted    -> (#const _PC_CHOWN_RESTRICTED)
-        FileNamesAreNotTruncated        -> (#const _PC_NO_TRUNC)
-        VDisableChar                    -> (#const _PC_VDISABLE)
-
-#ifdef _PC_SYNC_IO
-        SyncIOAvailable         -> (#const _PC_SYNC_IO)
-#else
-        SyncIOAvailable         -> error "_PC_SYNC_IO not available"
-#endif
-
-#ifdef _PC_ASYNC_IO
-        AsyncIOAvailable        -> (#const _PC_ASYNC_IO)
-#else
-        AsyncIOAvailable        -> error "_PC_ASYNC_IO not available"
-#endif
-
-#ifdef _PC_PRIO_IO
-        PrioIOAvailable         -> (#const _PC_PRIO_IO)
-#else
-        PrioIOAvailable         -> error "_PC_PRIO_IO not available"
-#endif
-
-#if _PC_FILESIZEBITS
-        FileSizeBits            -> (#const _PC_FILESIZEBITS)
-#else
-        FileSizeBits            -> error "_PC_FILESIZEBITS not available"
-#endif
-
-#if _PC_SYMLINK_MAX
-        SymbolicLinkLimit       -> (#const _PC_SYMLINK_MAX)
-#else
-        SymbolicLinkLimit       -> error "_PC_SYMLINK_MAX not available"
-#endif
-
--- | @getFdPathVar var fd@ obtains the dynamic value of the requested
--- configurable file limit or option associated with the file or directory
--- attached to the open channel @fd@. For defined file limits, @getFdPathVar@
--- returns the associated value.  For defined file options, the result of
--- @getFdPathVar@ is undefined, but not failure.
---
--- Note: calls @fpathconf@.
-getFdPathVar :: Fd -> PathVar -> IO Limit
-getFdPathVar (Fd fd) v =
-    throwErrnoIfMinus1 "getFdPathVar" $
-      c_fpathconf fd (pathVarConst v)
-
-foreign import ccall unsafe "fpathconf"
-  c_fpathconf :: CInt -> CInt -> IO CLong

unix/System/Posix/IO.hsc

@@ -1,92 +0,0 @@
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.IO
--- 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 IO support.  These types and functions correspond to the unix
--- functions open(2), close(2), etc.  For more portable functions
--- which are more like fopen(3) and friends from stdio.h, see
--- "System.IO".
---
------------------------------------------------------------------------------
-
-#include "HsUnix.h"
-
-module System.Posix.IO (
-    -- * Input \/ Output
-
-    -- ** Standard file descriptors
-    stdInput, stdOutput, stdError,
-
-    -- ** Opening and closing files
-    OpenMode(..),
-    OpenFileFlags(..), defaultFileFlags,
-    openFd, createFile,
-    closeFd,
-
-    -- ** Reading\/writing data
-    -- |Programmers using the 'fdRead' and 'fdWrite' API should be aware that
-    -- EAGAIN exceptions may occur for non-blocking IO!
-
-    fdRead, fdWrite,
-    fdReadBuf, fdWriteBuf,
-
-    -- ** Seeking
-    fdSeek,
-
-    -- ** File options
-    FdOption(..),
-    queryFdOption,
-    setFdOption,
-
-    -- ** Locking
-    FileLock,
-    LockRequest(..),
-    getLock,  setLock,
-    waitToSetLock,
-
-    -- ** Pipes
-    createPipe,
-
-    -- ** Duplicating file descriptors
-    dup, dupTo,
-
-    -- ** Converting file descriptors to\/from Handles
-    handleToFd,
-    fdToHandle,
-
-  ) where
-
-import System.Posix.Types
-import System.Posix.Error
-import System.Posix.IO.Common
-import System.Posix.Internals ( withFilePath )
-
--- |Open and optionally create this file.  See 'System.Posix.Files'
--- for information on how to use the 'FileMode' type.
-openFd :: FilePath
-       -> OpenMode
-       -> OpenFileFlags
-       -> IO Fd
-openFd name how flags =
-   withFilePath name $ \str ->
-     throwErrnoPathIfMinus1Retry "openFd" name $
-       open_ str how flags
-
--- |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.
-
-createFile :: FilePath -> FileMode -> IO Fd
-createFile name mode
-  = openFd name WriteOnly defaultFileFlags{ trunc=True, creat=(Just mode) }

unix/System/Posix/IO/ByteString.hsc

@@ -1,92 +0,0 @@
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.IO.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)
---
--- POSIX IO support.  These types and functions correspond to the unix
--- functions open(2), close(2), etc.  For more portable functions
--- which are more like fopen(3) and friends from stdio.h, see
--- "System.IO".
---
------------------------------------------------------------------------------
-
-#include "HsUnix.h"
-
-module System.Posix.IO.ByteString (
-    -- * Input \/ Output
-
-    -- ** Standard file descriptors
-    stdInput, stdOutput, stdError,
-
-    -- ** Opening and closing files
-    OpenMode(..),
-    OpenFileFlags(..), defaultFileFlags,
-    openFd, createFile,
-    closeFd,
-
-    -- ** Reading\/writing data
-    -- |Programmers using the 'fdRead' and 'fdWrite' API should be aware that
-    -- EAGAIN exceptions may occur for non-blocking IO!
-
-    fdRead, fdWrite,
-    fdReadBuf, fdWriteBuf,
-
-    -- ** Seeking
-    fdSeek,
-
-    -- ** File options
-    FdOption(..),
-    queryFdOption,
-    setFdOption,
-
-    -- ** Locking
-    FileLock,
-    LockRequest(..),
-    getLock,  setLock,
-    waitToSetLock,
-
-    -- ** Pipes
-    createPipe,
-
-    -- ** Duplicating file descriptors
-    dup, dupTo,
-
-    -- ** Converting file descriptors to\/from Handles
-    handleToFd,
-    fdToHandle,
-
-  ) where
-
-import System.Posix.Types
-import System.Posix.IO.Common
-
-import System.Posix.ByteString.FilePath
-
--- |Open and optionally create this file.  See 'System.Posix.Files'
--- for information on how to use the 'FileMode' type.
-openFd :: RawFilePath
-       -> OpenMode
-       -> OpenFileFlags
-       -> IO Fd
-openFd name how flags =
-   withFilePath name $ \str ->
-     throwErrnoPathIfMinus1Retry "openFd" name $
-       open_ str how flags
-
--- |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.
-
-createFile :: RawFilePath -> FileMode -> IO Fd
-createFile name mode
-  = openFd name WriteOnly defaultFileFlags{ trunc=True, creat=(Just mode) }

unix/System/Posix/IO/Common.hsc

@@ -1,443 +0,0 @@
-{-# LANGUAGE CApiFFI #-}
-{-# LANGUAGE NondecreasingIndentation #-}
-{-# LANGUAGE RecordWildCards #-}
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
-
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.IO.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)
---
------------------------------------------------------------------------------
-
-module System.Posix.IO.Common (
-    -- * Input \/ Output
-
-    -- ** Standard file descriptors
-    stdInput, stdOutput, stdError,
-
-    -- ** Opening and closing files
-    OpenMode(..),
-    OpenFileFlags(..), defaultFileFlags,
-    open_,
-    closeFd,
-
-    -- ** Reading\/writing data
-    -- |Programmers using the 'fdRead' and 'fdWrite' API should be aware that
-    -- EAGAIN exceptions may occur for non-blocking IO!
-
-    fdRead, fdWrite,
-    fdReadBuf, fdWriteBuf,
-
-    -- ** Seeking
-    fdSeek,
-
-    -- ** File options
-    FdOption(..),
-    queryFdOption,
-    setFdOption,
-
-    -- ** Locking
-    FileLock,
-    LockRequest(..),
-    getLock,  setLock,
-    waitToSetLock,
-
-    -- ** Pipes
-    createPipe,
-
-    -- ** Duplicating file descriptors
-    dup, dupTo,
-
-    -- ** Converting file descriptors to\/from Handles
-    handleToFd,
-    fdToHandle,
-
-  ) where
-
-import System.IO
-import System.IO.Error
-import System.Posix.Types
-import qualified System.Posix.Internals as Base
-
-import Foreign
-import Foreign.C
-
-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)
-
-#include "HsUnix.h"
-
--- -----------------------------------------------------------------------------
--- Pipes
--- |The 'createPipe' function creates a pair of connected file
--- descriptors. The first component is the fd to read from, the second
--- is the write end.  Although pipes may be bidirectional, this
--- behaviour is not portable and programmers should use two separate
--- pipes for this purpose.  May throw an exception if this is an
--- invalid descriptor.
-
-createPipe :: IO (Fd, Fd)
-createPipe =
-  allocaArray 2 $ \p_fd -> do
-    throwErrnoIfMinus1_ "createPipe" (c_pipe p_fd)
-    rfd <- peekElemOff p_fd 0
-    wfd <- peekElemOff p_fd 1
-    return (Fd rfd, Fd wfd)
-
-foreign import ccall unsafe "pipe"
-   c_pipe :: Ptr CInt -> IO CInt
-
--- -----------------------------------------------------------------------------
--- Duplicating file descriptors
-
--- | May throw an exception if this is an invalid descriptor.
-dup :: Fd -> IO Fd
-dup (Fd fd) = do r <- throwErrnoIfMinus1 "dup" (c_dup fd); return (Fd r)
-
--- | May throw an exception if this is an invalid descriptor.
-dupTo :: Fd -> Fd -> IO Fd
-dupTo (Fd fd1) (Fd fd2) = do
-  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
-
-stdInput, stdOutput, stdError :: Fd
-stdInput   = Fd (#const STDIN_FILENO)
-stdOutput  = Fd (#const STDOUT_FILENO)
-stdError   = Fd (#const STDERR_FILENO)
-
-data OpenMode = ReadOnly | WriteOnly | ReadWrite
-              deriving (Read, Show, Eq, Ord)
-
--- |Correspond to some of the int flags from C's fcntl.h.
-data OpenFileFlags =
- OpenFileFlags {
-    append    :: Bool,           -- ^ O_APPEND
-    exclusive :: Bool,           -- ^ O_EXCL
-                                 --
-                                 -- __NOTE__: Result is undefined if 'creat' is 'Nothing'.
-    noctty    :: Bool,           -- ^ O_NOCTTY
-    nonBlock  :: Bool,           -- ^ O_NONBLOCK
-    trunc     :: Bool,           -- ^ O_TRUNC
-    nofollow  :: Bool,           -- ^ O_NOFOLLOW
-                                 --
-                                 -- @since 2.8.0.0
-    creat     :: Maybe FileMode, -- ^ O_CREAT
-                                 --
-                                 -- @since 2.8.0.0
-    cloexec   :: Bool,           -- ^ O_CLOEXEC
-                                 --
-                                 -- @since 2.8.0.0
-    directory :: Bool,           -- ^ O_DIRECTORY
-                                 --
-                                 -- @since 2.8.0.0
-    sync      :: Bool            -- ^ O_SYNC
-                                 --
-                                 -- @since 2.8.0.0
- }
- deriving (Read, Show, Eq, Ord)
-
-
--- | Default values for the 'OpenFileFlags' type.
---
--- Each field of 'OpenFileFlags' is either 'False' or 'Nothing'
--- respectively.
-defaultFileFlags :: OpenFileFlags
-defaultFileFlags =
- OpenFileFlags {
-    append    = False,
-    exclusive = False,
-    noctty    = False,
-    nonBlock  = False,
-    trunc     = False,
-    nofollow  = False,
-    creat     = Nothing,
-    cloexec   = False,
-    directory = False,
-    sync      = False
-  }
-
-
--- |Open and optionally create this file.  See 'System.Posix.Files'
--- for information on how to use the 'FileMode' type.
-open_  :: CString
-       -> OpenMode
-       -> OpenFileFlags
-       -> IO Fd
-open_ str how (OpenFileFlags appendFlag exclusiveFlag nocttyFlag
-                                nonBlockFlag truncateFlag nofollowFlag
-                                creatFlag cloexecFlag directoryFlag
-                                syncFlag) = do
-    fd <- c_open str all_flags mode_w
-    return (Fd fd)
-  where
-    all_flags  = creat .|. flags .|. open_mode
-
-    flags =
-       (if appendFlag       then (#const O_APPEND)    else 0) .|.
-       (if exclusiveFlag    then (#const O_EXCL)      else 0) .|.
-       (if nocttyFlag       then (#const O_NOCTTY)    else 0) .|.
-       (if nonBlockFlag     then (#const O_NONBLOCK)  else 0) .|.
-       (if truncateFlag     then (#const O_TRUNC)     else 0) .|.
-       (if nofollowFlag     then (#const O_NOFOLLOW)  else 0) .|.
-       (if cloexecFlag      then (#const O_CLOEXEC)   else 0) .|.
-       (if directoryFlag    then (#const O_DIRECTORY) else 0) .|.
-       (if syncFlag         then (#const O_SYNC)      else 0)
-
-    (creat, mode_w) = case creatFlag of
-                        Nothing -> (0,0)
-                        Just x  -> ((#const O_CREAT), x)
-
-    open_mode = case how of
-                   ReadOnly  -> (#const O_RDONLY)
-                   WriteOnly -> (#const O_WRONLY)
-                   ReadWrite -> (#const O_RDWR)
-
-foreign import capi unsafe "HsUnix.h open"
-   c_open :: CString -> CInt -> CMode -> IO CInt
-
--- |Close this file descriptor.  May throw an exception if this is an
--- invalid descriptor.
-
-closeFd :: Fd -> IO ()
-closeFd (Fd fd) = throwErrnoIfMinus1_ "closeFd" (c_close fd)
--- Here we don't to retry on EINTR because according to
---  http://pubs.opengroup.org/onlinepubs/9699919799/functions/close.html
--- "with errno set to [EINTR] [...] the state of fildes is unspecified"
--- and on Linux, already the first close() removes the FD from the process's
--- FD table so closing a second time is invalid
--- (see http://man7.org/linux/man-pages/man2/close.2.html#NOTES).
-
-foreign import ccall unsafe "HsUnix.h close"
-   c_close :: CInt -> IO CInt
-
--- -----------------------------------------------------------------------------
--- Converting file descriptors to/from Handles
-
--- | Extracts the 'Fd' from a 'Handle'.  This function has the side effect
--- of closing the 'Handle' and flushing its write buffer, if necessary.
-handleToFd :: Handle -> IO Fd
-
--- | Converts an 'Fd' into a 'Handle' that can be used with the
--- standard Haskell IO library (see "System.IO").
-fdToHandle :: Fd -> IO Handle
-fdToHandle fd = FD.fdToHandle (fromIntegral fd)
-
-handleToFd h@(FileHandle _ m) = do
-  withHandle' "handleToFd" h m $ handleToFd' h
-handleToFd h@(DuplexHandle _ r w) = do
-  _ <- withHandle' "handleToFd" h r $ handleToFd' h
-  withHandle' "handleToFd" h w $ handleToFd' h
-  -- for a DuplexHandle, make sure we mark both sides as closed,
-  -- otherwise a finalizer will come along later and close the other
-  -- side. (#3914)
-
-handleToFd' :: Handle -> Handle__ -> IO (Handle__, Fd)
-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 (FD.fdFD fd))
-
-
--- -----------------------------------------------------------------------------
--- Fd options
-
-data FdOption = AppendOnWrite     -- ^O_APPEND
-              | CloseOnExec       -- ^FD_CLOEXEC
-              | NonBlockingRead   -- ^O_NONBLOCK
-              | SynchronousWrites -- ^O_SYNC
-
-fdOption2Int :: FdOption -> CInt
-fdOption2Int CloseOnExec       = (#const FD_CLOEXEC)
-fdOption2Int AppendOnWrite     = (#const O_APPEND)
-fdOption2Int NonBlockingRead   = (#const O_NONBLOCK)
-fdOption2Int SynchronousWrites = (#const O_SYNC)
-
--- | May throw an exception if this is an invalid descriptor.
-queryFdOption :: Fd -> FdOption -> IO Bool
-queryFdOption (Fd fd) opt = do
-  r <- throwErrnoIfMinus1 "queryFdOption" (Base.c_fcntl_read fd flag)
-  return ((r .&. fdOption2Int opt) /= 0)
- where
-  flag    = case opt of
-              CloseOnExec       -> (#const F_GETFD)
-              _                 -> (#const F_GETFL)
-
--- | May throw an exception if this is an invalid descriptor.
-setFdOption :: Fd -> FdOption -> Bool -> IO ()
-setFdOption (Fd fd) opt val = do
-  r <- throwErrnoIfMinus1 "setFdOption" (Base.c_fcntl_read fd getflag)
-  let r' | val       = r .|. opt_val
-         | otherwise = r .&. (complement opt_val)
-  throwErrnoIfMinus1_ "setFdOption"
-                      (Base.c_fcntl_write fd setflag (fromIntegral r'))
- where
-  (getflag,setflag)= case opt of
-              CloseOnExec       -> ((#const F_GETFD),(#const F_SETFD))
-              _                 -> ((#const F_GETFL),(#const F_SETFL))
-  opt_val = fdOption2Int opt
-
--- -----------------------------------------------------------------------------
--- Seeking
-
-mode2Int :: SeekMode -> CInt
-mode2Int AbsoluteSeek = (#const SEEK_SET)
-mode2Int RelativeSeek = (#const SEEK_CUR)
-mode2Int SeekFromEnd  = (#const SEEK_END)
-
--- | May throw an exception if this is an invalid descriptor.
-fdSeek :: Fd -> SeekMode -> FileOffset -> IO FileOffset
-fdSeek (Fd fd) mode off =
-  throwErrnoIfMinus1 "fdSeek" (Base.c_lseek fd off (mode2Int mode))
-
--- -----------------------------------------------------------------------------
--- Locking
-
-data LockRequest = ReadLock
-                 | WriteLock
-                 | Unlock
-
-type FileLock = (LockRequest, SeekMode, FileOffset, FileOffset)
-
--- | May throw an exception if this is an invalid descriptor.
-getLock :: Fd -> FileLock -> IO (Maybe (ProcessID, FileLock))
-getLock (Fd fd) lock =
-  allocaLock lock $ \p_flock -> do
-    throwErrnoIfMinus1_ "getLock" (Base.c_fcntl_lock fd (#const F_GETLK) p_flock)
-    result <- bytes2ProcessIDAndLock p_flock
-    return (maybeResult result)
-  where
-    maybeResult (_, (Unlock, _, _, _)) = Nothing
-    maybeResult x = Just x
-
-allocaLock :: FileLock -> (Ptr Base.CFLock -> IO a) -> IO a
-allocaLock (lockreq, mode, start, len) io =
-  allocaBytes (#const sizeof(struct flock)) $ \p -> do
-    (#poke struct flock, l_type)   p (lockReq2Int lockreq :: CShort)
-    (#poke struct flock, l_whence) p (fromIntegral (mode2Int mode) :: CShort)
-    (#poke struct flock, l_start)  p start
-    (#poke struct flock, l_len)    p len
-    io p
-
-lockReq2Int :: LockRequest -> CShort
-lockReq2Int ReadLock  = (#const F_RDLCK)
-lockReq2Int WriteLock = (#const F_WRLCK)
-lockReq2Int Unlock    = (#const F_UNLCK)
-
-bytes2ProcessIDAndLock :: Ptr Base.CFLock -> IO (ProcessID, FileLock)
-bytes2ProcessIDAndLock p = do
-  req   <- (#peek struct flock, l_type)   p
-  mode  <- (#peek struct flock, l_whence) p
-  start <- (#peek struct flock, l_start)  p
-  len   <- (#peek struct flock, l_len)    p
-  pid   <- (#peek struct flock, l_pid)    p
-  return (pid, (int2req req, int2mode mode, start, len))
- where
-  int2req :: CShort -> LockRequest
-  int2req (#const F_RDLCK) = ReadLock
-  int2req (#const F_WRLCK) = WriteLock
-  int2req (#const F_UNLCK) = Unlock
-  int2req _ = error $ "int2req: bad argument"
-
-  int2mode :: CShort -> SeekMode
-  int2mode (#const SEEK_SET) = AbsoluteSeek
-  int2mode (#const SEEK_CUR) = RelativeSeek
-  int2mode (#const SEEK_END) = SeekFromEnd
-  int2mode _ = error $ "int2mode: bad argument"
-
--- | May throw an exception if this is an invalid descriptor.
-setLock :: Fd -> FileLock -> IO ()
-setLock (Fd fd) lock = do
-  allocaLock lock $ \p_flock ->
-    throwErrnoIfMinus1_ "setLock" (Base.c_fcntl_lock fd (#const F_SETLK) p_flock)
-
--- | May throw an exception if this is an invalid descriptor.
-waitToSetLock :: Fd -> FileLock -> IO ()
-waitToSetLock (Fd fd) lock = do
-  allocaLock lock $ \p_flock ->
-    throwErrnoIfMinus1_ "waitToSetLock"
-        (Base.c_fcntl_lock fd (#const F_SETLKW) p_flock)
-
--- -----------------------------------------------------------------------------
--- fd{Read,Write}
-
--- | Read data from an 'Fd' and convert it to a 'String' using the locale encoding.
--- 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 nbytes = do
-    allocaBytes (fromIntegral nbytes) $ \ buf -> do
-    rc <- fdReadBuf fd buf nbytes
-    case rc of
-      0 -> ioError (ioeSetErrorString (mkIOError EOF "fdRead" Nothing Nothing) "EOF")
-      n -> do
-       s <- peekCStringLen (castPtr buf, fromIntegral n)
-       return (s, n)
-
--- | 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) nbytes
-
-foreign import ccall safe "read"
-   c_safe_read :: CInt -> Ptr CChar -> CSize -> IO CSsize
-
--- | Write a 'String' to an 'Fd' using the locale encoding.
-fdWrite :: Fd -> String -> IO ByteCount
-fdWrite fd str =
-  withCStringLen str $ \ (buf,len) ->
-    fdWriteBuf fd (castPtr buf) (fromIntegral len)
-
--- | 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) len
-
-foreign import ccall safe "write"
-   c_safe_write :: CInt -> Ptr CChar -> CSize -> IO CSsize

unix/System/Posix/Process.hsc

@@ -1,125 +0,0 @@
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Process
--- 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 process support.  See also the System.Cmd and System.Process
--- modules in the process package.
---
------------------------------------------------------------------------------
-
-module System.Posix.Process (
-    -- * Processes
-
-    -- ** Forking and executing
-    forkProcess,
-    forkProcessWithUnmask,
-    executeFile,
-
-    -- ** Exiting
-    exitImmediately,
-
-    -- ** Process environment
-    getProcessID,
-    getParentProcessID,
-
-    -- ** Process groups
-    getProcessGroupID,
-    getProcessGroupIDOf,
-    createProcessGroupFor,
-    joinProcessGroup,
-    setProcessGroupIDOf,
-
-    -- ** Sessions
-    createSession,
-
-    -- ** Process times
-    ProcessTimes(..),
-    getProcessTimes,
-
-    -- ** Scheduling priority
-    nice,
-    getProcessPriority,
-    getProcessGroupPriority,
-    getUserPriority,
-    setProcessPriority,
-    setProcessGroupPriority,
-    setUserPriority,
-
-    -- ** Process status
-    ProcessStatus(..),
-    getProcessStatus,
-    getAnyProcessStatus,
-    getGroupProcessStatus,
-
-    -- ** Deprecated
-    createProcessGroup,
-    setProcessGroupID,
-
- ) where
-
-#include "HsUnix.h"
-
-import Foreign
-import Foreign.C
-import System.Posix.Process.Internals
-import System.Posix.Process.Common
-import System.Posix.Internals ( withFilePath )
-
--- | @'executeFile' cmd args env@ calls one of the
---   @execv*@ family, depending on whether or not the current
---   PATH is to be searched for the command, and whether or not an
---   environment is provided to supersede the process's current
---   environment.  The basename (leading directory names suppressed) of
---   the command is passed to @execv*@ as @arg[0]@;
---   the argument list passed to 'executeFile' therefore
---   begins with @arg[1]@.
-executeFile :: FilePath                     -- ^ Command
-            -> Bool                         -- ^ Search PATH?
-            -> [String]                     -- ^ Arguments
-            -> Maybe [(String, String)]     -- ^ Environment
-            -> IO a
-executeFile path search args Nothing = do
-  withFilePath path $ \s ->
-    withMany withFilePath (path:args) $ \cstrs ->
-      withArray0 nullPtr cstrs $ \arr -> do
-        pPrPr_disableITimers
-        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
-  withFilePath path $ \s ->
-    withMany withFilePath (path:args) $ \cstrs ->
-      withArray0 nullPtr cstrs $ \arg_arr ->
-    let env' = map (\ (name, val) -> name ++ ('=' : val)) env in
-    withMany withFilePath env' $ \cenv ->
-      withArray0 nullPtr cenv $ \env_arr -> do
-        pPrPr_disableITimers
-        if search
-           then throwErrnoPathIfMinus1_ "executeFile" path
-                   (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
-
-foreign import ccall unsafe "execv"
-  c_execv :: CString -> Ptr CString -> IO CInt
-
-foreign import ccall unsafe "execve"
-  c_execve :: CString -> Ptr CString -> Ptr CString -> IO CInt
-

unix/System/Posix/Process/ByteString.hsc

@@ -1,136 +0,0 @@
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
-
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Process.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)
---
--- POSIX process support.  See also the System.Cmd and System.Process
--- modules in the process package.
---
------------------------------------------------------------------------------
-
-module System.Posix.Process.ByteString (
-    -- * Processes
-
-    -- ** Forking and executing
-    forkProcess,
-    forkProcessWithUnmask,
-    executeFile,
-
-    -- ** Exiting
-    exitImmediately,
-
-    -- ** Process environment
-    getProcessID,
-    getParentProcessID,
-
-    -- ** Process groups
-    getProcessGroupID,
-    getProcessGroupIDOf,
-    createProcessGroupFor,
-    joinProcessGroup,
-    setProcessGroupIDOf,
-
-    -- ** Sessions
-    createSession,
-
-    -- ** Process times
-    ProcessTimes(..),
-    getProcessTimes,
-
-    -- ** Scheduling priority
-    nice,
-    getProcessPriority,
-    getProcessGroupPriority,
-    getUserPriority,
-    setProcessPriority,
-    setProcessGroupPriority,
-    setUserPriority,
-
-    -- ** Process status
-    ProcessStatus(..),
-    getProcessStatus,
-    getAnyProcessStatus,
-    getGroupProcessStatus,
-
-    -- ** Deprecated
-    createProcessGroup,
-    setProcessGroupID,
-
- ) where
-
-#include "HsUnix.h"
-
-import Foreign
-import System.Posix.Process.Internals
-import System.Posix.Process.Common
-
-import Foreign.C hiding (
-     throwErrnoPath,
-     throwErrnoPathIf,
-     throwErrnoPathIf_,
-     throwErrnoPathIfNull,
-     throwErrnoPathIfMinus1,
-     throwErrnoPathIfMinus1_ )
-
-import Data.ByteString (ByteString)
-import qualified Data.ByteString.Char8 as BC
-
-import System.Posix.ByteString.FilePath
-
--- | @'executeFile' cmd args env@ calls one of the
---   @execv*@ family, depending on whether or not the current
---   PATH is to be searched for the command, and whether or not an
---   environment is provided to supersede the process's current
---   environment.  The basename (leading directory names suppressed) of
---   the command is passed to @execv*@ as @arg[0]@;
---   the argument list passed to 'executeFile' therefore
---   begins with @arg[1]@.
-executeFile :: RawFilePath                          -- ^ Command
-            -> Bool                         -- ^ Search PATH?
-            -> [ByteString]                 -- ^ Arguments
-            -> Maybe [(ByteString, ByteString)]     -- ^ Environment
-            -> IO a
-executeFile path search args Nothing = do
-  withFilePath path $ \s ->
-    withMany withFilePath (path:args) $ \cstrs ->
-      withArray0 nullPtr cstrs $ \arr -> do
-        pPrPr_disableITimers
-        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
-  withFilePath path $ \s ->
-    withMany withFilePath (path:args) $ \cstrs ->
-      withArray0 nullPtr cstrs $ \arg_arr ->
-    let env' = map (\ (name, val) -> name `BC.append` ('=' `BC.cons` val)) env in
-    withMany withFilePath env' $ \cenv ->
-      withArray0 nullPtr cenv $ \env_arr -> do
-        pPrPr_disableITimers
-        if search
-           then throwErrnoPathIfMinus1_ "executeFile" path
-                   (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
-
-foreign import ccall unsafe "execv"
-  c_execv :: CString -> Ptr CString -> IO CInt
-
-foreign import ccall unsafe "execve"
-  c_execve :: CString -> Ptr CString -> Ptr CString -> IO CInt

unix/System/Posix/Process/Common.hsc

@@ -1,430 +0,0 @@
-{-# LANGUAGE CApiFFI #-}
-{-# LANGUAGE InterruptibleFFI, RankNTypes #-}
-{-# LANGUAGE Trustworthy #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Process.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 process support.  See also the System.Cmd and System.Process
--- modules in the process package.
---
------------------------------------------------------------------------------
-
-module System.Posix.Process.Common (
-    -- * Processes
-
-    -- ** Forking and executing
-    forkProcess,
-    forkProcessWithUnmask,
-
-    -- ** Exiting
-    exitImmediately,
-
-    -- ** Process environment
-    getProcessID,
-    getParentProcessID,
-
-    -- ** Process groups
-    getProcessGroupID,
-    getProcessGroupIDOf,
-    createProcessGroupFor,
-    joinProcessGroup,
-    setProcessGroupIDOf,
-
-    -- ** Sessions
-    createSession,
-
-    -- ** Process times
-    ProcessTimes(..),
-    getProcessTimes,
-
-    -- ** Scheduling priority
-    nice,
-    getProcessPriority,
-    getProcessGroupPriority,
-    getUserPriority,
-    setProcessPriority,
-    setProcessGroupPriority,
-    setUserPriority,
-
-    -- ** Process status
-    ProcessStatus(..),
-    getProcessStatus,
-    getAnyProcessStatus,
-    getGroupProcessStatus,
-
-    -- ** Deprecated
-    createProcessGroup,
-    setProcessGroupID,
-
- ) where
-
-#include "HsUnix.h"
-
-import Foreign.C.Error
-import Foreign.C.Types
-import Foreign.Marshal.Alloc ( alloca, allocaBytes )
-import Foreign.Ptr ( Ptr )
-import Foreign.StablePtr ( StablePtr, newStablePtr, freeStablePtr )
-import Foreign.Storable ( Storable(..) )
-import System.Exit
-import System.Posix.Process.Internals
-import System.Posix.Types
-import Control.Monad
-
-import Control.Exception.Base ( bracket, getMaskingState, MaskingState(..) ) -- used by forkProcess
-import GHC.TopHandler   ( runIO )
-import GHC.IO ( unsafeUnmask, uninterruptibleMask_ )
-
--- -----------------------------------------------------------------------------
--- Process environment
-
--- | 'getProcessID' calls @getpid@ to obtain the 'ProcessID' for
---   the current process.
-getProcessID :: IO ProcessID
-getProcessID = c_getpid
-
-foreign import ccall unsafe "getpid"
-   c_getpid :: IO CPid
-
--- | 'getProcessID' calls @getppid@ to obtain the 'ProcessID' for
---   the parent of the current process.
-getParentProcessID :: IO ProcessID
-getParentProcessID = c_getppid
-
-foreign import ccall unsafe "getppid"
-  c_getppid :: IO CPid
-
--- | 'getProcessGroupID' calls @getpgrp@ to obtain the
---   'ProcessGroupID' for the current process.
-getProcessGroupID :: IO ProcessGroupID
-getProcessGroupID = c_getpgrp
-
-foreign import ccall unsafe "getpgrp"
-  c_getpgrp :: IO CPid
-
--- | @'getProcessGroupIDOf' pid@ calls @getpgid@ to obtain the
---   'ProcessGroupID' for process @pid@.
-getProcessGroupIDOf :: ProcessID -> IO ProcessGroupID
-getProcessGroupIDOf pid =
-  throwErrnoIfMinus1 "getProcessGroupIDOf" (c_getpgid pid)
-
-foreign import ccall unsafe "getpgid"
-  c_getpgid :: CPid -> IO CPid
-
-{-
-   To be added in the future, after the deprecation period for the
-   existing createProcessGroup has elapsed:
-
--- | 'createProcessGroup' calls @setpgid(0,0)@ to make
---   the current process a new process group leader.
-createProcessGroup :: IO ProcessGroupID
-createProcessGroup = do
-  throwErrnoIfMinus1_ "createProcessGroup" (c_setpgid 0 0)
-  pgid <- getProcessGroupID
-  return pgid
--}
-
--- | @'createProcessGroupFor' pid@ calls @setpgid@ to make
---   process @pid@ a new process group leader.
-createProcessGroupFor :: ProcessID -> IO ProcessGroupID
-createProcessGroupFor pid = do
-  throwErrnoIfMinus1_ "createProcessGroupFor" (c_setpgid pid 0)
-  return pid
-
--- | @'joinProcessGroup' pgid@ calls @setpgid@ to set the
---   'ProcessGroupID' of the current process to @pgid@.
-joinProcessGroup :: ProcessGroupID -> IO ()
-joinProcessGroup pgid =
-  throwErrnoIfMinus1_ "joinProcessGroup" (c_setpgid 0 pgid)
-
-{-
-   To be added in the future, after the deprecation period for the
-   existing setProcessGroupID has elapsed:
-
--- | @'setProcessGroupID' pgid@ calls @setpgid@ to set the
---   'ProcessGroupID' of the current process to @pgid@.
-setProcessGroupID :: ProcessGroupID -> IO ()
-setProcessGroupID pgid =
-  throwErrnoIfMinus1_ "setProcessGroupID" (c_setpgid 0 pgid)
--}
-
--- | @'setProcessGroupIDOf' pid pgid@ calls @setpgid@ to set the
---   'ProcessGroupIDOf' for process @pid@ to @pgid@.
-setProcessGroupIDOf :: ProcessID -> ProcessGroupID -> IO ()
-setProcessGroupIDOf pid pgid =
-  throwErrnoIfMinus1_ "setProcessGroupIDOf" (c_setpgid pid pgid)
-
-foreign import ccall unsafe "setpgid"
-  c_setpgid :: CPid -> CPid -> IO CInt
-
--- | 'createSession' calls @setsid@ to create a new session
---   with the current process as session leader.
-createSession :: IO ProcessGroupID
-createSession = throwErrnoIfMinus1 "createSession" c_setsid
-
-foreign import ccall unsafe "setsid"
-  c_setsid :: IO CPid
-
--- -----------------------------------------------------------------------------
--- Process times
-
--- All times in clock ticks (see getClockTick)
-
-data ProcessTimes
-  = ProcessTimes { elapsedTime     :: ClockTick
-                 , userTime        :: ClockTick
-                 , systemTime      :: ClockTick
-                 , childUserTime   :: ClockTick
-                 , childSystemTime :: ClockTick
-                 }
-
--- | 'getProcessTimes' calls @times@ to obtain time-accounting
---   information for the current process and its children.
-getProcessTimes :: IO ProcessTimes
-getProcessTimes = do
-   allocaBytes (#const sizeof(struct tms)) $ \p_tms -> do
-     elapsed <- throwErrnoIfMinus1 "getProcessTimes" (c_times p_tms)
-     ut  <- (#peek struct tms, tms_utime)  p_tms
-     st  <- (#peek struct tms, tms_stime)  p_tms
-     cut <- (#peek struct tms, tms_cutime) p_tms
-     cst <- (#peek struct tms, tms_cstime) p_tms
-     return (ProcessTimes{ elapsedTime     = elapsed,
-                           userTime        = ut,
-                           systemTime      = st,
-                           childUserTime   = cut,
-                           childSystemTime = cst
-                          })
-
-data {-# CTYPE "struct tms" #-} CTms
-
-foreign import capi unsafe "HsUnix.h times"
-  c_times :: Ptr CTms -> IO CClock
-
--- -----------------------------------------------------------------------------
--- Process scheduling priority
-
-nice :: Int -> IO ()
-nice prio = do
-  resetErrno
-  res <- c_nice (fromIntegral prio)
-  when (res == -1) $ do
-    err <- getErrno
-    when (err /= eOK) (throwErrno "nice")
-
-foreign import ccall unsafe "nice"
-  c_nice :: CInt -> IO CInt
-
-getProcessPriority      :: ProcessID      -> IO Int
-getProcessGroupPriority :: ProcessGroupID -> IO Int
-getUserPriority         :: UserID         -> IO Int
-
-getProcessPriority pid = do
-  r <- throwErrnoIfMinus1 "getProcessPriority" $
-         c_getpriority (#const PRIO_PROCESS) (fromIntegral pid)
-  return (fromIntegral r)
-
-getProcessGroupPriority pid = do
-  r <- throwErrnoIfMinus1 "getProcessPriority" $
-         c_getpriority (#const PRIO_PGRP) (fromIntegral pid)
-  return (fromIntegral r)
-
-getUserPriority uid = do
-  r <- throwErrnoIfMinus1 "getUserPriority" $
-         c_getpriority (#const PRIO_USER) (fromIntegral uid)
-  return (fromIntegral r)
-
-foreign import ccall unsafe "getpriority"
-  c_getpriority :: CInt -> CInt -> IO CInt
-
-setProcessPriority      :: ProcessID      -> Int -> IO ()
-setProcessGroupPriority :: ProcessGroupID -> Int -> IO ()
-setUserPriority         :: UserID         -> Int -> IO ()
-
-setProcessPriority pid val =
-  throwErrnoIfMinus1_ "setProcessPriority" $
-    c_setpriority (#const PRIO_PROCESS) (fromIntegral pid) (fromIntegral val)
-
-setProcessGroupPriority pid val =
-  throwErrnoIfMinus1_ "setProcessPriority" $
-    c_setpriority (#const PRIO_PGRP) (fromIntegral pid) (fromIntegral val)
-
-setUserPriority uid val =
-  throwErrnoIfMinus1_ "setUserPriority" $
-    c_setpriority (#const PRIO_USER) (fromIntegral uid) (fromIntegral val)
-
-foreign import ccall unsafe "setpriority"
-  c_setpriority :: CInt -> CInt -> CInt -> IO CInt
-
--- -----------------------------------------------------------------------------
--- Forking, execution
-
-{- | 'forkProcess' corresponds to the POSIX @fork@ system call.
-The 'IO' action passed as an argument is executed in the child process; no other
-threads will be copied to the child process.
-On success, 'forkProcess' returns the child's 'ProcessID' to the parent process;
-in case of an error, an exception is thrown.
-
-The exception masking state of the executed action is inherited
-(c.f. 'forkIO'), see also 'forkProcessWithUnmask' (/since: 2.7.0.0/).
-
-'forkProcess' comes with a giant warning: since any other running
-threads are not copied into the child process, it's easy to go wrong:
-e.g. by accessing some shared resource that was held by another thread
-in the parent.
--}
-
-forkProcess :: IO () -> IO ProcessID
-forkProcess action = do
-  -- wrap action to re-establish caller's masking state, as
-  -- 'forkProcessPrim' starts in 'MaskedInterruptible' state by
-  -- default; see also #1048
-  mstate <- getMaskingState
-  let action' = case mstate of
-          Unmasked              -> unsafeUnmask action
-          MaskedInterruptible   -> action
-          MaskedUninterruptible -> uninterruptibleMask_ action
-
-  bracket
-    (newStablePtr (runIO action'))
-    freeStablePtr
-    (\stable -> throwErrnoIfMinus1 "forkProcess" (forkProcessPrim stable))
-
-foreign import ccall "forkProcess" forkProcessPrim :: StablePtr (IO ()) -> IO CPid
-
--- | Variant of 'forkProcess' in the style of 'forkIOWithUnmask'.
---
--- @since 2.7.0.0
-forkProcessWithUnmask :: ((forall a . IO a -> IO a) -> IO ()) -> IO ProcessID
-forkProcessWithUnmask action = forkProcess (action unsafeUnmask)
-
--- -----------------------------------------------------------------------------
--- Waiting for process termination
-
--- | @'getProcessStatus' blk stopped pid@ calls @waitpid@, returning
---   @'Just' tc@, the 'ProcessStatus' for process @pid@ if it is
---   available, 'Nothing' otherwise.  If @blk@ is 'False', then
---   @WNOHANG@ is set in the options for @waitpid@, otherwise not.
---   If @stopped@ is 'True', then @WUNTRACED@ is set in the
---   options for @waitpid@, otherwise not.
-getProcessStatus :: Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
-getProcessStatus block stopped pid =
-  alloca $ \wstatp -> do
-    pid' <- throwErrnoIfMinus1Retry "getProcessStatus"
-                (c_waitpid pid wstatp (waitOptions block stopped))
-    case pid' of
-      0  -> return Nothing
-      _  -> do ps <- readWaitStatus wstatp
-               return (Just ps)
-
--- safe/interruptible, because this call might block
-foreign import ccall interruptible "waitpid"
-  c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid
-
--- | @'getGroupProcessStatus' blk stopped pgid@ calls @waitpid@,
---   returning @'Just' (pid, tc)@, the 'ProcessID' and 'ProcessStatus'
---   for any process in group @pgid@ if one is available, or 'Nothing'
---   if there are child processes but none have exited.  If there are
---   no child processes, then 'getGroupProcessStatus' raises an
---   'isDoesNotExistError' exception.
---
---   If @blk@ is 'False', then @WNOHANG@ is set in the options for
---   @waitpid@, otherwise not.  If @stopped@ is 'True', then
---   @WUNTRACED@ is set in the options for @waitpid@, otherwise not.
-getGroupProcessStatus :: Bool
-                      -> Bool
-                      -> ProcessGroupID
-                      -> IO (Maybe (ProcessID, ProcessStatus))
-getGroupProcessStatus block stopped pgid =
-  alloca $ \wstatp -> do
-    pid <- throwErrnoIfMinus1Retry "getGroupProcessStatus"
-                (c_waitpid (-pgid) wstatp (waitOptions block stopped))
-    case pid of
-      0  -> return Nothing
-      _  -> do ps <- readWaitStatus wstatp
-               return (Just (pid, ps))
-
--- | @'getAnyProcessStatus' blk stopped@ calls @waitpid@, returning
---   @'Just' (pid, tc)@, the 'ProcessID' and 'ProcessStatus' for any
---   child process if a child process has exited, or 'Nothing' if
---   there are child processes but none have exited.  If there are no
---   child processes, then 'getAnyProcessStatus' raises an
---   'isDoesNotExistError' exception.
---
---   If @blk@ is 'False', then @WNOHANG@ is set in the options for
---   @waitpid@, otherwise not.  If @stopped@ is 'True', then
---   @WUNTRACED@ is set in the options for @waitpid@, otherwise not.
-getAnyProcessStatus :: Bool -> Bool -> IO (Maybe (ProcessID, ProcessStatus))
-getAnyProcessStatus block stopped = getGroupProcessStatus block stopped 1
-
-waitOptions :: Bool -> Bool -> CInt
---             block   stopped
-waitOptions False False = (#const WNOHANG)
-waitOptions False True  = (#const (WNOHANG|WUNTRACED))
-waitOptions True  False = 0
-waitOptions True  True  = (#const WUNTRACED)
-
--- Turn a (ptr to a) wait status into a ProcessStatus
-
-readWaitStatus :: Ptr CInt -> IO ProcessStatus
-readWaitStatus wstatp = do
-  wstat <- peek wstatp
-  decipherWaitStatus wstat
-
--- -----------------------------------------------------------------------------
--- Exiting
-
--- | @'exitImmediately' status@ calls @_exit@ to terminate the process
---   with the indicated exit @status@.
---   The operation never returns. Since it does not use the Haskell exception
---   system and it cannot be caught.
---
---   Note: Prior to @unix-2.8.0.0@ the type-signature of 'exitImmediately' was
---   @ExitCode -> IO ()@.
---
--- @since 2.8.0.0
-exitImmediately :: ExitCode -> IO a
-exitImmediately status = do
-    _ <- c_exit (exitcode2Int status)
-    -- The above will exit the program, but need the following to satisfy
-    -- the type signature.
-    exitImmediately status
-  where
-    exitcode2Int ExitSuccess = 0
-    exitcode2Int (ExitFailure n) = fromIntegral n
-
-foreign import ccall unsafe "exit"
-  c_exit :: CInt -> IO ()
-
--- -----------------------------------------------------------------------------
--- Deprecated or subject to change
-
-{-# DEPRECATED createProcessGroup "This function is scheduled to be replaced by something different in the future, we therefore recommend that you do not use this version and use 'createProcessGroupFor' instead." #-} -- deprecated in 7.2
--- | @'createProcessGroup' pid@ calls @setpgid@ to make
---   process @pid@ a new process group leader.
---   This function is currently deprecated,
---   and might be changed to making the current
---   process a new process group leader in future versions.
-createProcessGroup :: ProcessID -> IO ProcessGroupID
-createProcessGroup pid = do
-  throwErrnoIfMinus1_ "createProcessGroup" (c_setpgid pid 0)
-  return pid
-
-{-# DEPRECATED setProcessGroupID "This function is scheduled to be replaced by something different in the future, we therefore recommend that you do not use this version and use 'setProcessGroupIDOf' instead." #-} -- deprecated in 7.2
--- | @'setProcessGroupID' pid pgid@ calls @setpgid@ to set the
---   'ProcessGroupID' for process @pid@ to @pgid@.
---   This function is currently deprecated,
---   and might be changed to setting the 'ProcessGroupID'
---   for the current process in future versions.
-setProcessGroupID :: ProcessID -> ProcessGroupID -> IO ()
-setProcessGroupID pid pgid =
-  throwErrnoIfMinus1_ "setProcessGroupID" (c_setpgid pid pgid)
-
--- -----------------------------------------------------------------------------

unix/System/Posix/Process/Internals.hs

@@ -1,78 +0,0 @@
-{-# LANGUAGE CApiFFI #-}
-{-# LANGUAGE Trustworthy #-}
-
-module System.Posix.Process.Internals (
-       pPrPr_disableITimers, c_execvpe,
-       decipherWaitStatus, ProcessStatus(..) ) where
-
-import Foreign
-import Foreign.C
-import System.Exit
-import System.IO.Error
-import GHC.Conc (Signal)
-
--- | The exit status of a process
-data ProcessStatus
-   = Exited ExitCode        -- ^ the process exited by calling
-                            -- @exit()@ or returning from @main@
-   | Terminated Signal Bool -- ^ the process was terminated by a
-                            -- signal, the @Bool@ is @True@ if a core
-                            -- dump was produced
-                            --
-                            -- @since 2.7.0.0
-   | Stopped Signal         -- ^ the process was stopped by a signal
-   deriving (Eq, Ord, Show)
-
--- this function disables the itimer, which would otherwise cause confusing
--- signals to be sent to the new process.
-foreign import capi unsafe "Rts.h stopTimer"
-  pPrPr_disableITimers :: IO ()
-
-foreign import ccall unsafe "__hsunix_execvpe"
-  c_execvpe :: CString -> Ptr CString -> Ptr CString -> IO CInt
-
-decipherWaitStatus :: CInt -> IO ProcessStatus
-decipherWaitStatus wstat =
-  if c_WIFEXITED wstat /= 0
-      then do
-        let exitstatus = c_WEXITSTATUS wstat
-        if exitstatus == 0
-           then return (Exited ExitSuccess)
-           else return (Exited (ExitFailure (fromIntegral exitstatus)))
-      else do
-        if c_WIFSIGNALED wstat /= 0
-           then do
-                let termsig    = c_WTERMSIG wstat
-                let coredumped = c_WCOREDUMP wstat /= 0
-                return (Terminated termsig coredumped)
-           else do
-                if c_WIFSTOPPED wstat /= 0
-                   then do
-                        let stopsig = c_WSTOPSIG wstat
-                        return (Stopped stopsig)
-                   else do
-                        ioError (mkIOError illegalOperationErrorType
-                                   "waitStatus" Nothing Nothing)
-
-
-foreign import capi unsafe "HsUnix.h WIFEXITED"
-  c_WIFEXITED :: CInt -> CInt
-
-foreign import capi unsafe "HsUnix.h WEXITSTATUS"
-  c_WEXITSTATUS :: CInt -> CInt
-
-foreign import capi unsafe "HsUnix.h WIFSIGNALED"
-  c_WIFSIGNALED :: CInt -> CInt
-
-foreign import capi unsafe "HsUnix.h WTERMSIG"
-  c_WTERMSIG :: CInt -> CInt
-
-foreign import capi unsafe "HsUnix.h WIFSTOPPED"
-  c_WIFSTOPPED :: CInt -> CInt
-
-foreign import capi unsafe "HsUnix.h WSTOPSIG"
-  c_WSTOPSIG :: CInt -> CInt
-
-foreign import capi unsafe "HsUnix.h WCOREDUMP"
-  c_WCOREDUMP :: CInt -> CInt
-

unix/System/Posix/Resource.hsc

@@ -1,166 +0,0 @@
-{-# LANGUAGE CApiFFI #-}
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Resource
--- Copyright   :  (c) The University of Glasgow 2003
--- License     :  BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer  :  libraries@haskell.org
--- Stability   :  provisional
--- Portability :  non-portable (requires POSIX)
---
--- POSIX resource support
---
------------------------------------------------------------------------------
-
-module System.Posix.Resource (
-    -- * Resource Limits
-    ResourceLimit(..), ResourceLimits(..), Resource(..),
-    getResourceLimit,
-    setResourceLimit,
-  ) where
-
-#include "HsUnix.h"
-
-import System.Posix.Types
-import Foreign
-import Foreign.C
-
--- -----------------------------------------------------------------------------
--- Resource limits
-
-data Resource
-  = ResourceCoreFileSize
-  | ResourceCPUTime
-  | ResourceDataSize
-  | ResourceFileSize
-  | ResourceOpenFiles
-  | ResourceStackSize
-#ifdef RLIMIT_AS
-  | ResourceTotalMemory
-#endif
-  deriving Eq
-
-data ResourceLimits
-  = ResourceLimits { softLimit, hardLimit :: ResourceLimit }
-  deriving Eq
-
-data ResourceLimit
-  = ResourceLimitInfinity
-  | ResourceLimitUnknown
-  | ResourceLimit Integer
-  deriving Eq
-
-data {-# CTYPE "struct rlimit" #-} RLimit
-
-foreign import capi unsafe "HsUnix.h getrlimit"
-  c_getrlimit :: CInt -> Ptr RLimit -> IO CInt
-
-foreign import capi unsafe "HsUnix.h setrlimit"
-  c_setrlimit :: CInt -> Ptr RLimit -> IO CInt
-
-getResourceLimit :: Resource -> IO ResourceLimits
-getResourceLimit res = do
-  allocaBytes (#const sizeof(struct rlimit)) $ \p_rlimit -> do
-    throwErrnoIfMinus1_ "getResourceLimit" $
-      c_getrlimit (packResource res) p_rlimit
-    soft <- (#peek struct rlimit, rlim_cur) p_rlimit
-    hard <- (#peek struct rlimit, rlim_max) p_rlimit
-    return (ResourceLimits {
-                softLimit = unpackRLimit soft,
-                hardLimit = unpackRLimit hard
-           })
-
-setResourceLimit :: Resource -> ResourceLimits -> IO ()
-setResourceLimit res ResourceLimits{softLimit=soft,hardLimit=hard} = do
-  allocaBytes (#const sizeof(struct rlimit)) $ \p_rlimit -> do
-    (#poke struct rlimit, rlim_cur) p_rlimit (packRLimit soft True)
-    (#poke struct rlimit, rlim_max) p_rlimit (packRLimit hard False)
-    throwErrnoIfMinus1_ "setResourceLimit" $
-        c_setrlimit (packResource res) p_rlimit
-    return ()
-
-packResource :: Resource -> CInt
-packResource ResourceCoreFileSize  = (#const RLIMIT_CORE)
-packResource ResourceCPUTime       = (#const RLIMIT_CPU)
-packResource ResourceDataSize      = (#const RLIMIT_DATA)
-packResource ResourceFileSize      = (#const RLIMIT_FSIZE)
-packResource ResourceOpenFiles     = (#const RLIMIT_NOFILE)
-packResource ResourceStackSize     = (#const RLIMIT_STACK)
-#ifdef RLIMIT_AS
-packResource ResourceTotalMemory   = (#const RLIMIT_AS)
-#endif
-
-unpackRLimit :: CRLim -> ResourceLimit
-unpackRLimit (#const RLIM_INFINITY)  = ResourceLimitInfinity
-unpackRLimit other
-#if defined(RLIM_SAVED_MAX)
-    | ((#const RLIM_SAVED_MAX) :: CRLim) /= (#const RLIM_INFINITY) &&
-      other == (#const RLIM_SAVED_MAX) = ResourceLimitUnknown
-#endif
-#if defined(RLIM_SAVED_CUR)
-    | ((#const RLIM_SAVED_CUR) :: CRLim) /= (#const RLIM_INFINITY) &&
-      other == (#const RLIM_SAVED_CUR) = ResourceLimitUnknown
-#endif
-    | otherwise = ResourceLimit (fromIntegral other)
-
-packRLimit :: ResourceLimit -> Bool -> CRLim
-packRLimit ResourceLimitInfinity _     = (#const RLIM_INFINITY)
-#if defined(RLIM_SAVED_CUR)
-packRLimit ResourceLimitUnknown  True  = (#const RLIM_SAVED_CUR)
-#endif
-#if defined(RLIM_SAVED_MAX)
-packRLimit ResourceLimitUnknown  False = (#const RLIM_SAVED_MAX)
-#endif
-#if ! defined(RLIM_SAVED_MAX) && !defined(RLIM_SAVED_CUR)
-packRLimit ResourceLimitUnknown  _     =
-    error
-      $ "System.Posix.Resource.packRLimit: " ++
-        "ResourceLimitUnknown but RLIM_SAVED_MAX/RLIM_SAVED_CUR not defined by platform"
-#endif
-packRLimit (ResourceLimit other) _     = fromIntegral other
-
-
--- -----------------------------------------------------------------------------
--- Test code
-
-{-
-import System.Posix
-import Control.Monad
-
-main = do
- zipWithM_ (\r n -> setResourceLimit r ResourceLimits{
-                                        hardLimit = ResourceLimit n,
-                                        softLimit = ResourceLimit n })
-        allResources [1..]
- showAll
- mapM_ (\r -> setResourceLimit r ResourceLimits{
-                                        hardLimit = ResourceLimit 1,
-                                        softLimit = ResourceLimitInfinity })
-        allResources
-   -- should fail
-
-
-showAll =
-  mapM_ (\r -> getResourceLimit r >>= (putStrLn . showRLims)) allResources
-
-allResources =
-    [ResourceCoreFileSize, ResourceCPUTime, ResourceDataSize,
-        ResourceFileSize, ResourceOpenFiles, ResourceStackSize
-#ifdef RLIMIT_AS
-        , ResourceTotalMemory
-#endif
-        ]
-
-showRLims ResourceLimits{hardLimit=h,softLimit=s}
-  = "hard: " ++ showRLim h ++ ", soft: " ++ showRLim s
-
-showRLim ResourceLimitInfinity = "infinity"
-showRLim ResourceLimitUnknown  = "unknown"
-showRLim (ResourceLimit other)  = show other
--}

unix/System/Posix/Semaphore.hsc

@@ -1,131 +0,0 @@
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Semaphore
--- Copyright   :  (c) Daniel Franke 2007
--- License     :  BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (requires POSIX)
---
--- POSIX named semaphore support.
---
------------------------------------------------------------------------------
-
-module System.Posix.Semaphore
-    (OpenSemFlags(..), Semaphore(),
-     semOpen, semUnlink, semWait, semTryWait, semThreadWait,
-     semPost, semGetValue)
-    where
-
-#include <semaphore.h>
-#include <fcntl.h>
-
-import Foreign.C
-import Foreign.ForeignPtr hiding (newForeignPtr)
-import Foreign.Concurrent
-import Foreign.Marshal
-import Foreign.Ptr
-import Foreign.Storable
-import System.Posix.Types
-import Control.Concurrent
-import Data.Bits
-
-data OpenSemFlags = OpenSemFlags { semCreate :: Bool,
-                                   -- ^ If true, create the semaphore if it
-                                   --   does not yet exist.
-                                   semExclusive :: Bool
-                                   -- ^ If true, throw an exception if the
-                                   --   semaphore already exists.
-                                 }
-
-newtype Semaphore = Semaphore (ForeignPtr ())
-
--- | Open a named semaphore with the given name, flags, mode, and initial
---   value.
-semOpen :: String -> OpenSemFlags -> FileMode -> Int -> IO Semaphore
-semOpen name flags mode value =
-    let cflags = (if semCreate flags then #{const O_CREAT} else 0) .|.
-                 (if semExclusive flags then #{const O_EXCL} else 0)
-        semOpen' cname =
-            do sem <- throwErrnoPathIfNull "semOpen" name $
-                      sem_open cname (toEnum cflags) mode (toEnum value)
-               fptr <- newForeignPtr sem (finalize sem)
-               return $ Semaphore fptr
-        finalize sem = throwErrnoPathIfMinus1_ "semOpen" name $
-                       sem_close sem in
-    withCAString name semOpen'
-
--- | Delete the semaphore with the given name.
-semUnlink :: String -> IO ()
-semUnlink name = withCAString name semUnlink'
-    where semUnlink' cname = throwErrnoPathIfMinus1_ "semUnlink" name $
-                             sem_unlink cname
-
--- | Lock the semaphore, blocking until it becomes available.  Since this
---   is done through a system call, this will block the *entire runtime*,
---   not just the current thread.  If this is not the behaviour you want,
---   use semThreadWait instead.
-semWait :: Semaphore -> IO ()
-semWait (Semaphore fptr) = withForeignPtr fptr semWait'
-    where semWait' sem = throwErrnoIfMinus1Retry_ "semWait" $
-                         sem_wait sem
-
--- | Attempt to lock the semaphore without blocking.  Immediately return
---   False if it is not available.
-semTryWait :: Semaphore -> IO Bool
-semTryWait (Semaphore fptr) = withForeignPtr fptr semTrywait'
-    where semTrywait' sem = do res <- sem_trywait sem
-                               (if res == 0 then return True
-                                else do errno <- getErrno
-                                        (if errno == eINTR
-                                         then semTrywait' sem
-                                         else if errno == eAGAIN
-                                              then return False
-                                              else throwErrno "semTrywait"))
-
--- | Poll the semaphore until it is available, then lock it.  Unlike
---   semWait, this will block only the current thread rather than the
---   entire process.
-semThreadWait :: Semaphore -> IO ()
-semThreadWait sem = do res <- semTryWait sem
-                       (if res then return ()
-                        else ( do { yield; semThreadWait sem } ))
-
--- | Unlock the semaphore.
-semPost :: Semaphore -> IO ()
-semPost (Semaphore fptr) = withForeignPtr fptr semPost'
-    where semPost' sem = throwErrnoIfMinus1Retry_ "semPost" $
-                         sem_post sem
-
--- | Return the semaphore's current value.
-semGetValue :: Semaphore -> IO Int
-semGetValue (Semaphore fptr) = withForeignPtr fptr semGetValue'
-    where semGetValue' sem = alloca (semGetValue_ sem)
-
-semGetValue_ :: Ptr () -> Ptr CInt -> IO Int
-semGetValue_ sem ptr = do throwErrnoIfMinus1Retry_ "semGetValue" $
-                            sem_getvalue sem ptr
-                          cint <- peek ptr
-                          return $ fromEnum cint
-
-foreign import ccall safe "sem_open"
-        sem_open :: CString -> CInt -> CMode -> CUInt -> IO (Ptr ())
-foreign import ccall safe "sem_close"
-        sem_close :: Ptr () -> IO CInt
-foreign import ccall safe "sem_unlink"
-        sem_unlink :: CString -> IO CInt
-
-foreign import ccall safe "sem_wait"
-        sem_wait :: Ptr () -> IO CInt
-foreign import ccall safe "sem_trywait"
-        sem_trywait :: Ptr () -> IO CInt
-foreign import ccall safe "sem_post"
-        sem_post :: Ptr () -> IO CInt
-foreign import ccall safe "sem_getvalue"
-        sem_getvalue :: Ptr () -> Ptr CInt -> IO Int

unix/System/Posix/SharedMem.hsc

@@ -1,91 +0,0 @@
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.SharedMem
--- Copyright   :  (c) Daniel Franke 2007
--- License     :  BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer  :  libraries@haskell.org
--- Stability   :  experimental
--- Portability :  non-portable (requires POSIX)
---
--- POSIX shared memory support.
---
------------------------------------------------------------------------------
-
-module System.Posix.SharedMem
-    (ShmOpenFlags(..), shmOpen, shmUnlink)
-    where
-
-#include "HsUnix.h"
-
-#include <sys/types.h>
-#include <sys/mman.h>
-#include <fcntl.h>
-
-import System.Posix.Types
-#if defined(HAVE_SHM_OPEN) || defined(HAVE_SHM_UNLINK)
-import Foreign.C
-#endif
-#ifdef HAVE_SHM_OPEN
-import Data.Bits
-#endif
-
-data ShmOpenFlags = ShmOpenFlags
-    { shmReadWrite :: Bool,
-      -- ^ If true, open the shm object read-write rather than read-only.
-      shmCreate :: Bool,
-      -- ^ If true, create the shm object if it does not exist.
-      shmExclusive :: Bool,
-      -- ^ If true, throw an exception if the shm object already exists.
-      shmTrunc :: Bool
-      -- ^ If true, wipe the contents of the shm object after opening it.
-    }
-
--- | Open a shared memory object with the given name, flags, and mode.
-shmOpen :: String -> ShmOpenFlags -> FileMode -> IO Fd
-#ifdef HAVE_SHM_OPEN
-shmOpen name flags mode =
-    do cflags0 <- return 0
-       cflags1 <- return $ cflags0 .|. (if shmReadWrite flags
-                                        then #{const O_RDWR}
-                                        else #{const O_RDONLY})
-       cflags2 <- return $ cflags1 .|. (if shmCreate flags then #{const O_CREAT}
-                                        else 0)
-       cflags3 <- return $ cflags2 .|. (if shmExclusive flags
-                                        then #{const O_EXCL}
-                                        else 0)
-       cflags4 <- return $ cflags3 .|. (if shmTrunc flags then #{const O_TRUNC}
-                                        else 0)
-       withCAString name (shmOpen' cflags4)
-    where shmOpen' cflags cname =
-              do fd <- throwErrnoIfMinus1 "shmOpen" $
-                       shm_open cname cflags mode
-                 return $ Fd fd
-#else
-shmOpen = error "System.Posix.SharedMem:shm_open: not available"
-#endif
-
--- | Delete the shared memory object with the given name.
-shmUnlink :: String -> IO ()
-#ifdef HAVE_SHM_UNLINK
-shmUnlink name = withCAString name shmUnlink'
-    where shmUnlink' cname =
-              throwErrnoIfMinus1_ "shmUnlink" $ shm_unlink cname
-#else
-shmUnlink = error "System.Posix.SharedMem:shm_unlink: not available"
-#endif
-
-#ifdef HAVE_SHM_OPEN
-foreign import ccall unsafe "shm_open"
-        shm_open :: CString -> CInt -> CMode -> IO CInt
-#endif
-
-#ifdef HAVE_SHM_UNLINK
-foreign import ccall unsafe "shm_unlink"
-        shm_unlink :: CString -> IO CInt
-#endif

unix/System/Posix/Signals.hsc

@@ -1,706 +0,0 @@
-{-# LANGUAGE CApiFFI, CPP, DeriveDataTypeable, NondecreasingIndentation #-}
-{-# OPTIONS_GHC -fno-cse #-} -- global variables
-{-# LANGUAGE Trustworthy #-}
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Signals
--- 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 signal support
---
------------------------------------------------------------------------------
-
-#include "HsUnixConfig.h"
-##include "HsUnixConfig.h"
-
-#ifdef HAVE_SIGNAL_H
-#include <signal.h>
-#endif
-
-module System.Posix.Signals (
-  -- * The Signal type
-  Signal,
-
-  -- * Specific signals
-  nullSignal,
-  internalAbort, sigABRT,
-  realTimeAlarm, sigALRM,
-  busError, sigBUS,
-  processStatusChanged, sigCHLD,
-  continueProcess, sigCONT,
-  floatingPointException, sigFPE,
-  lostConnection, sigHUP,
-  illegalInstruction, sigILL,
-  keyboardSignal, sigINT,
-  killProcess, sigKILL,
-  openEndedPipe, sigPIPE,
-  keyboardTermination, sigQUIT,
-  segmentationViolation, sigSEGV,
-  softwareStop, sigSTOP,
-  softwareTermination, sigTERM,
-  keyboardStop, sigTSTP,
-  backgroundRead, sigTTIN,
-  backgroundWrite, sigTTOU,
-  userDefinedSignal1, sigUSR1,
-  userDefinedSignal2, sigUSR2,
-#if CONST_SIGPOLL != -1
-  pollableEvent, sigPOLL,
-#endif
-  profilingTimerExpired, sigPROF,
-  badSystemCall, sigSYS,
-  breakpointTrap, sigTRAP,
-  urgentDataAvailable, sigURG,
-  virtualTimerExpired, sigVTALRM,
-  cpuTimeLimitExceeded, sigXCPU,
-  fileSizeLimitExceeded, sigXFSZ,
-
-  -- * Sending signals
-  raiseSignal,
-  signalProcess,
-  signalProcessGroup,
-
-  -- * Handling signals
-  Handler(Default,Ignore,Catch,CatchOnce,CatchInfo,CatchInfoOnce),
-  SignalInfo(..), SignalSpecificInfo(..),
-  installHandler,
-
-  -- * Signal sets
-  SignalSet,
-  emptySignalSet, fullSignalSet, reservedSignals,
-  addSignal, deleteSignal, inSignalSet,
-
-  -- * The process signal mask
-  getSignalMask, setSignalMask, blockSignals, unblockSignals,
-
-  -- * The alarm timer
-  scheduleAlarm,
-
-  -- * Waiting for signals
-  getPendingSignals,
-  awaitSignal,
-
-  -- * The @NOCLDSTOP@ flag
-  setStoppedChildFlag, queryStoppedChildFlag,
-
-  -- MISSING FUNCTIONALITY:
-  -- sigaction(), (inc. the sigaction structure + flags etc.)
-  -- the siginfo structure
-  -- sigaltstack()
-  -- sighold, sigignore, sigpause, sigrelse, sigset
-  -- siginterrupt
-  ) where
-
-import Data.Word
-import Foreign.C
-import Foreign.ForeignPtr
-import Foreign.Marshal
-import Foreign.Ptr
-import Foreign.Storable
-import System.IO.Unsafe (unsafePerformIO)
-import System.Posix.Types
-import System.Posix.Internals
-import System.Posix.Process
-import System.Posix.Process.Internals
-import Data.Dynamic
-
-##include "rts/Signals.h"
-
-import GHC.Conc hiding (Signal)
-
--- -----------------------------------------------------------------------------
--- Specific signals
-
-nullSignal :: Signal
-nullSignal = 0
-
--- | Process abort signal.
-sigABRT   :: CInt
-sigABRT   = CONST_SIGABRT
-
--- | Alarm clock.
-sigALRM   :: CInt
-sigALRM   = CONST_SIGALRM
-
--- | Access to an undefined portion of a memory object.
-sigBUS    :: CInt
-sigBUS    = CONST_SIGBUS
-
--- | Child process terminated, stopped, or continued.
-sigCHLD   :: CInt
-sigCHLD   = CONST_SIGCHLD
-
--- | Continue executing, if stopped.
-sigCONT   :: CInt
-sigCONT   = CONST_SIGCONT
-
--- | Erroneous arithmetic operation.
-sigFPE    :: CInt
-sigFPE    = CONST_SIGFPE
-
--- | Hangup.
-sigHUP    :: CInt
-sigHUP    = CONST_SIGHUP
-
--- | Illegal instruction.
-sigILL    :: CInt
-sigILL    = CONST_SIGILL
-
--- | Terminal interrupt signal.
-sigINT    :: CInt
-sigINT    = CONST_SIGINT
-
--- | Kill (cannot be caught or ignored).
-sigKILL   :: CInt
-sigKILL   = CONST_SIGKILL
-
--- | Write on a pipe with no one to read it.
-sigPIPE   :: CInt
-sigPIPE   = CONST_SIGPIPE
-
--- | Terminal quit signal.
-sigQUIT   :: CInt
-sigQUIT   = CONST_SIGQUIT
-
--- | Invalid memory reference.
-sigSEGV   :: CInt
-sigSEGV   = CONST_SIGSEGV
-
--- | Stop executing (cannot be caught or ignored).
-sigSTOP   :: CInt
-sigSTOP   = CONST_SIGSTOP
-
--- | Termination signal.
-sigTERM   :: CInt
-sigTERM   = CONST_SIGTERM
-
--- | Terminal stop signal.
-sigTSTP   :: CInt
-sigTSTP   = CONST_SIGTSTP
-
--- | Background process attempting read.
-sigTTIN   :: CInt
-sigTTIN   = CONST_SIGTTIN
-
--- | Background process attempting write.
-sigTTOU   :: CInt
-sigTTOU   = CONST_SIGTTOU
-
--- | User-defined signal 1.
-sigUSR1   :: CInt
-sigUSR1   = CONST_SIGUSR1
-
--- | User-defined signal 2.
-sigUSR2   :: CInt
-sigUSR2   = CONST_SIGUSR2
-
-#if CONST_SIGPOLL != -1
--- | Pollable event.
-sigPOLL   :: CInt
-sigPOLL   = CONST_SIGPOLL
-#endif
-
--- | Profiling timer expired.
-sigPROF   :: CInt
-sigPROF   = CONST_SIGPROF
-
--- | Bad system call.
-sigSYS    :: CInt
-sigSYS    = CONST_SIGSYS
-
--- | Trace/breakpoint trap.
-sigTRAP   :: CInt
-sigTRAP   = CONST_SIGTRAP
-
--- | High bandwidth data is available at a socket.
-sigURG    :: CInt
-sigURG    = CONST_SIGURG
-
--- | Virtual timer expired.
-sigVTALRM :: CInt
-sigVTALRM = CONST_SIGVTALRM
-
--- | CPU time limit exceeded.
-sigXCPU   :: CInt
-sigXCPU   = CONST_SIGXCPU
-
--- | File size limit exceeded.
-sigXFSZ   :: CInt
-sigXFSZ   = CONST_SIGXFSZ
-
--- | Alias for 'sigABRT'.
-internalAbort ::Signal
-internalAbort = sigABRT
-
--- | Alias for 'sigALRM'.
-realTimeAlarm :: Signal
-realTimeAlarm = sigALRM
-
--- | Alias for 'sigBUS'.
-busError :: Signal
-busError = sigBUS
-
--- | Alias for 'sigCHLD'.
-processStatusChanged :: Signal
-processStatusChanged = sigCHLD
-
--- | Alias for 'sigCONT'.
-continueProcess :: Signal
-continueProcess = sigCONT
-
--- | Alias for 'sigFPE'.
-floatingPointException :: Signal
-floatingPointException = sigFPE
-
--- | Alias for 'sigHUP'.
-lostConnection :: Signal
-lostConnection = sigHUP
-
--- | Alias for 'sigILL'.
-illegalInstruction :: Signal
-illegalInstruction = sigILL
-
--- | Alias for 'sigINT'.
-keyboardSignal :: Signal
-keyboardSignal = sigINT
-
--- | Alias for 'sigKILL'.
-killProcess :: Signal
-killProcess = sigKILL
-
--- | Alias for 'sigPIPE'.
-openEndedPipe :: Signal
-openEndedPipe = sigPIPE
-
--- | Alias for 'sigQUIT'.
-keyboardTermination :: Signal
-keyboardTermination = sigQUIT
-
--- | Alias for 'sigSEGV'.
-segmentationViolation :: Signal
-segmentationViolation = sigSEGV
-
--- | Alias for 'sigSTOP'.
-softwareStop :: Signal
-softwareStop = sigSTOP
-
--- | Alias for 'sigTERM'.
-softwareTermination :: Signal
-softwareTermination = sigTERM
-
--- | Alias for 'sigTSTP'.
-keyboardStop :: Signal
-keyboardStop = sigTSTP
-
--- | Alias for 'sigTTIN'.
-backgroundRead :: Signal
-backgroundRead = sigTTIN
-
--- | Alias for 'sigTTOU'.
-backgroundWrite :: Signal
-backgroundWrite = sigTTOU
-
--- | Alias for 'sigUSR1'.
-userDefinedSignal1 :: Signal
-userDefinedSignal1 = sigUSR1
-
--- | Alias for 'sigUSR2'.
-userDefinedSignal2 :: Signal
-userDefinedSignal2 = sigUSR2
-
-#if CONST_SIGPOLL != -1
--- | Alias for 'sigPOLL'.
-pollableEvent :: Signal
-pollableEvent = sigPOLL
-#endif
-
--- | Alias for 'sigPROF'.
-profilingTimerExpired :: Signal
-profilingTimerExpired = sigPROF
-
--- | Alias for 'sigSYS'.
-badSystemCall :: Signal
-badSystemCall = sigSYS
-
--- | Alias for 'sigTRAP'.
-breakpointTrap :: Signal
-breakpointTrap = sigTRAP
-
--- | Alias for 'sigURG'.
-urgentDataAvailable :: Signal
-urgentDataAvailable = sigURG
-
--- | Alias for 'sigVTALRM'.
-virtualTimerExpired :: Signal
-virtualTimerExpired = sigVTALRM
-
--- | Alias for 'sigXCPU'.
-cpuTimeLimitExceeded :: Signal
-cpuTimeLimitExceeded = sigXCPU
-
--- | Alias for 'sigXFSZ'.
-fileSizeLimitExceeded :: Signal
-fileSizeLimitExceeded = sigXFSZ
-
--- -----------------------------------------------------------------------------
--- Signal-related functions
-
--- | @signalProcess int pid@ calls @kill@ to signal process @pid@
---   with interrupt signal @int@.
-signalProcess :: Signal -> ProcessID -> IO ()
-signalProcess sig pid
- = throwErrnoIfMinus1_ "signalProcess" (c_kill pid sig)
-
-foreign import ccall unsafe "kill"
-  c_kill :: CPid -> CInt -> IO CInt
-
-
--- | @signalProcessGroup int pgid@ calls @kill@ to signal
---  all processes in group @pgid@ with interrupt signal @int@.
-signalProcessGroup :: Signal -> ProcessGroupID -> IO ()
-signalProcessGroup sig pgid
-  = throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg pgid sig)
-
-foreign import ccall unsafe "killpg"
-  c_killpg :: CPid -> CInt -> IO CInt
-
--- | @raiseSignal int@ calls @kill@ to signal the current process
---   with interrupt signal @int@.
-raiseSignal :: Signal -> IO ()
-raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig)
-
--- See also note in GHC's rts/RtsUtils.c
--- This is somewhat fragile because we need to keep the
--- `#if`-conditional in sync with GHC's runtime.
-#if (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(darwin_HOST_OS))
-foreign import ccall unsafe "genericRaise"
-  c_raise :: CInt -> IO CInt
-#else
-foreign import ccall unsafe "raise"
-  c_raise :: CInt -> IO CInt
-#endif
-
-
-type Signal = CInt
-
--- | The actions to perform when a signal is received.
-data Handler = Default
-             | Ignore
-             -- not yet: | Hold
-             | Catch (IO ())
-             | CatchOnce (IO ())
-             | CatchInfo (SignalInfo -> IO ())     -- ^ @since 2.7.0.0
-             | CatchInfoOnce (SignalInfo -> IO ()) -- ^ @since 2.7.0.0
-  deriving (Typeable)
-
--- | Information about a received signal (derived from @siginfo_t@).
---
--- @since 2.7.0.0
-data SignalInfo = SignalInfo {
-      siginfoSignal   :: Signal,
-      siginfoError    :: Errno,
-      siginfoSpecific :: SignalSpecificInfo
-  }
-
--- | Information specific to a particular type of signal
--- (derived from @siginfo_t@).
---
--- @since 2.7.0.0
-data SignalSpecificInfo
-  = NoSignalSpecificInfo
-  | SigChldInfo {
-      siginfoPid    :: ProcessID,
-      siginfoUid    :: UserID,
-      siginfoStatus :: ProcessStatus
-    }
-
--- | @installHandler int handler iset@ calls @sigaction@ to install an
---   interrupt handler for signal @int@.  If @handler@ is @Default@,
---   @SIG_DFL@ is installed; if @handler@ is @Ignore@, @SIG_IGN@ is
---   installed; if @handler@ is @Catch action@, a handler is installed
---   which will invoke @action@ in a new thread when (or shortly after) the
---   signal is received.
---   If @iset@ is @Just s@, then the @sa_mask@ of the @sigaction@ structure
---   is set to @s@; otherwise it is cleared.  The previously installed
---   signal handler for @int@ is returned
-installHandler :: Signal
-               -> Handler
-               -> Maybe SignalSet       -- ^ other signals to block
-               -> IO Handler            -- ^ old handler
-
-#ifdef __PARALLEL_HASKELL__
-installHandler =
-  error "installHandler: not available for Parallel Haskell"
-#else
-
-installHandler sig handler _maybe_mask = do
-  ensureIOManagerIsRunning  -- for the threaded RTS
-
-  -- if we're setting the action to DFL or IGN, we should do that *first*
-  -- if we're setting a handler,
-  --   if the previous action was handle, then setHandler is ok
-  --   if the previous action was IGN/DFL, then setHandler followed by sig_install
-  (old_action, old_handler) <-
-    case handler of
-      Ignore  -> do
-        old_action  <- stg_sig_install sig STG_SIG_IGN nullPtr
-        old_handler <- setHandler sig Nothing
-        return (old_action, old_handler)
-
-      Default -> do
-        old_action  <- stg_sig_install sig STG_SIG_DFL nullPtr
-        old_handler <- setHandler sig Nothing
-        return (old_action, old_handler)
-
-      _some_kind_of_catch -> do
-        -- I don't think it's possible to get CatchOnce right.  If
-        -- there's a signal in flight, then we might run the handler
-        -- more than once.
-        let dyn = toDyn handler
-        old_handler <- case handler of
-            Catch         action -> setHandler sig (Just (const action,dyn))
-            CatchOnce     action -> setHandler sig (Just (const action,dyn))
-            CatchInfo     action -> setHandler sig (Just (getinfo action,dyn))
-            CatchInfoOnce action -> setHandler sig (Just (getinfo action,dyn))
-#if __GLASGOW_HASKELL__ < 811
-            _                    -> error "installHandler"
-#endif
-
-        let action = case handler of
-                Catch _         -> STG_SIG_HAN
-                CatchOnce _     -> STG_SIG_RST
-                CatchInfo _     -> STG_SIG_HAN
-                CatchInfoOnce _ -> STG_SIG_RST
-#if __GLASGOW_HASKELL__ < 811
-                _               -> error "installHandler"
-#endif
-
-        old_action <- stg_sig_install sig action nullPtr
-                   -- mask is pointless, so leave it NULL
-
-        return (old_action, old_handler)
-
-  case (old_handler,old_action) of
-    (_,       STG_SIG_DFL) -> return $ Default
-    (_,       STG_SIG_IGN) -> return $ Ignore
-    (Nothing, _)           -> return $ Ignore
-    (Just (_,dyn),  _)
-        | Just h <- fromDynamic dyn  -> return h
-        | Just io <- fromDynamic dyn -> return (Catch io)
-        -- handlers put there by the base package have type IO ()
-        | otherwise                  -> return Default
-
-foreign import ccall unsafe
-  stg_sig_install
-        :: CInt                         -- sig no.
-        -> CInt                         -- action code (STG_SIG_HAN etc.)
-        -> Ptr CSigset                  -- (in, out) blocked
-        -> IO CInt                      -- (ret) old action code
-
-getinfo :: (SignalInfo -> IO ()) -> ForeignPtr Word8 -> IO ()
-getinfo handler fp_info = do
-  si <- unmarshalSigInfo fp_info
-  handler si
-
-unmarshalSigInfo :: ForeignPtr Word8 -> IO SignalInfo
-unmarshalSigInfo fp = do
-  withForeignPtr fp $ \p -> do
-    sig   <- (#peek siginfo_t, si_signo) p
-    errno <- (#peek siginfo_t, si_errno) p
-    extra <- case sig of
-                _ | sig == sigCHLD -> do
-                    pid <- (#peek siginfo_t, si_pid) p
-                    uid <- (#peek siginfo_t, si_uid) p
-                    wstat <- (#peek siginfo_t, si_status) p
-                    pstat <- decipherWaitStatus wstat
-                    return SigChldInfo { siginfoPid = pid,
-                                         siginfoUid = uid,
-                                         siginfoStatus = pstat }
-                _ | otherwise ->
-                    return NoSignalSpecificInfo
-    return
-      SignalInfo {
-        siginfoSignal = sig,
-        siginfoError  = Errno errno,
-        siginfoSpecific = extra }
-
-#endif /* !__PARALLEL_HASKELL__ */
-
--- -----------------------------------------------------------------------------
--- Alarms
-
--- | @scheduleAlarm i@ calls @alarm@ to schedule a real time
---   alarm at least @i@ seconds in the future.
-scheduleAlarm :: Int -> IO Int
-scheduleAlarm secs = do
-   r <- c_alarm (fromIntegral secs)
-   return (fromIntegral r)
-
-foreign import ccall unsafe "alarm"
-  c_alarm :: CUInt -> IO CUInt
-
--- -----------------------------------------------------------------------------
--- The NOCLDSTOP flag
-
-foreign import ccall "&nocldstop" nocldstop :: Ptr Int
-
--- | Tells the system whether or not to set the @SA_NOCLDSTOP@ flag when
--- installing new signal handlers.
-setStoppedChildFlag :: Bool -> IO Bool
-setStoppedChildFlag b = do
-    rc <- peek nocldstop
-    poke nocldstop $ fromEnum (not b)
-    return (rc == (0::Int))
-
--- | Queries the current state of the stopped child flag.
-queryStoppedChildFlag :: IO Bool
-queryStoppedChildFlag = do
-    rc <- peek nocldstop
-    return (rc == (0::Int))
-
--- -----------------------------------------------------------------------------
--- Manipulating signal sets
-
-newtype SignalSet = SignalSet (ForeignPtr CSigset)
-
-emptySignalSet :: SignalSet
-emptySignalSet = unsafePerformIO $ do
-  fp <- mallocForeignPtrBytes sizeof_sigset_t
-  throwErrnoIfMinus1_ "emptySignalSet" (withForeignPtr fp $ c_sigemptyset)
-  return (SignalSet fp)
-
-fullSignalSet :: SignalSet
-fullSignalSet = unsafePerformIO $ do
-  fp <- mallocForeignPtrBytes sizeof_sigset_t
-  throwErrnoIfMinus1_ "fullSignalSet" (withForeignPtr fp $ c_sigfillset)
-  return (SignalSet fp)
-
--- | A set of signals reserved for use by the implementation.  In GHC, this will normally
--- include either `sigVTALRM` or `sigALRM`.
-reservedSignals :: SignalSet
-reservedSignals = addSignal rtsTimerSignal emptySignalSet
-
-foreign import ccall rtsTimerSignal :: CInt
-
-infixr `addSignal`, `deleteSignal`
-addSignal :: Signal -> SignalSet -> SignalSet
-addSignal sig (SignalSet fp1) = unsafePerformIO $ do
-  fp2 <- mallocForeignPtrBytes sizeof_sigset_t
-  withForeignPtr fp1 $ \p1 ->
-    withForeignPtr fp2 $ \p2 -> do
-      copyBytes p2 p1 sizeof_sigset_t
-      throwErrnoIfMinus1_ "addSignal" (c_sigaddset p2 sig)
-  return (SignalSet fp2)
-
-deleteSignal :: Signal -> SignalSet -> SignalSet
-deleteSignal sig (SignalSet fp1) = unsafePerformIO $ do
-  fp2 <- mallocForeignPtrBytes sizeof_sigset_t
-  withForeignPtr fp1 $ \p1 ->
-    withForeignPtr fp2 $ \p2 -> do
-      copyBytes p2 p1 sizeof_sigset_t
-      throwErrnoIfMinus1_ "deleteSignal" (c_sigdelset p2 sig)
-  return (SignalSet fp2)
-
-inSignalSet :: Signal -> SignalSet -> Bool
-inSignalSet sig (SignalSet fp) = unsafePerformIO $
-  withForeignPtr fp $ \p -> do
-    r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig)
-    return (r /= 0)
-
--- | @getSignalMask@ calls @sigprocmask@ to determine the
---   set of interrupts which are currently being blocked.
-getSignalMask :: IO SignalSet
-getSignalMask = do
-  fp <- mallocForeignPtrBytes sizeof_sigset_t
-  withForeignPtr fp $ \p ->
-    throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 nullPtr p)
-  return (SignalSet fp)
-
-sigProcMask :: String -> CInt -> SignalSet -> IO ()
-sigProcMask fn how (SignalSet set) =
-  withForeignPtr set $ \p_set ->
-    throwErrnoIfMinus1_ fn (c_sigprocmask how p_set nullPtr)
-
--- | @setSignalMask mask@ calls @sigprocmask@ with
---   @SIG_SETMASK@ to block all interrupts in @mask@.
-setSignalMask :: SignalSet -> IO ()
-setSignalMask set = sigProcMask "setSignalMask" (CONST_SIG_SETMASK :: CInt) set
-
--- | @blockSignals mask@ calls @sigprocmask@ with
---   @SIG_BLOCK@ to add all interrupts in @mask@ to the
---  set of blocked interrupts.
-blockSignals :: SignalSet -> IO ()
-blockSignals set = sigProcMask "blockSignals" (CONST_SIG_BLOCK :: CInt) set
-
--- | @unblockSignals mask@ calls @sigprocmask@ with
---   @SIG_UNBLOCK@ to remove all interrupts in @mask@ from the
---   set of blocked interrupts.
-unblockSignals :: SignalSet -> IO ()
-unblockSignals set = sigProcMask "unblockSignals" (CONST_SIG_UNBLOCK :: CInt) set
-
--- | @getPendingSignals@ calls @sigpending@ to obtain
---   the set of interrupts which have been received but are currently blocked.
-getPendingSignals :: IO SignalSet
-getPendingSignals = do
-  fp <- mallocForeignPtrBytes sizeof_sigset_t
-  withForeignPtr fp $ \p ->
-   throwErrnoIfMinus1_ "getPendingSignals" (c_sigpending p)
-  return (SignalSet fp)
-
--- | @awaitSignal iset@ suspends execution until an interrupt is received.
--- If @iset@ is @Just s@, @awaitSignal@ calls @sigsuspend@, installing
--- @s@ as the new signal mask before suspending execution; otherwise, it
--- calls @sigsuspend@ with current signal mask. Note that RTS
--- scheduler signal (either 'virtualTimerExpired' or 'realTimeAlarm')
--- could cause premature termination of this call. It might be necessary to block that
--- signal before invocation of @awaitSignal@ with 'blockSignals' 'reservedSignals'.
---
--- @awaitSignal@ returns when signal was received and processed by a
--- signal handler, or if the signal could not be caught. If you have
--- installed any signal handlers with @installHandler@, it may be wise
--- to call @yield@ directly after @awaitSignal@ to ensure that the
--- signal handler runs as promptly as possible.
-awaitSignal :: Maybe SignalSet -> IO ()
-awaitSignal maybe_sigset = do
-  fp <- case maybe_sigset of
-          Nothing -> do SignalSet fp <- getSignalMask; return fp
-          Just (SignalSet fp) -> return fp
-  withForeignPtr fp $ \p -> do
-  _ <- 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
-
-#if defined(darwin_HOST_OS) && __GLASGOW_HASKELL__ < 706
--- see http://ghc.haskell.org/trac/ghc/ticket/7359#comment:3
--- To be removed when support for GHC 7.4.x is dropped
-foreign import ccall unsafe "__hscore_sigdelset"
-  c_sigdelset   :: Ptr CSigset -> CInt -> IO CInt
-
-foreign import ccall unsafe "__hscore_sigfillset"
-  c_sigfillset  :: Ptr CSigset -> IO CInt
-
-foreign import ccall unsafe "__hscore_sigismember"
-  c_sigismember :: Ptr CSigset -> CInt -> IO CInt
-#else
-foreign import capi unsafe "signal.h sigdelset"
-  c_sigdelset   :: Ptr CSigset -> CInt -> IO CInt
-
-foreign import capi unsafe "signal.h sigfillset"
-  c_sigfillset  :: Ptr CSigset -> IO CInt
-
-foreign import capi unsafe "signal.h sigismember"
-  c_sigismember :: Ptr CSigset -> CInt -> IO CInt
-#endif
-
-foreign import ccall unsafe "sigpending"
-  c_sigpending :: Ptr CSigset -> IO CInt

unix/System/Posix/Signals/Exts.hsc

@@ -1,47 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE Safe #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Signals.Exts
--- 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, includes Linuxisms/BSDisms)
---
--- non-POSIX signal support commonly available
---
------------------------------------------------------------------------------
-
-#include "HsUnixConfig.h"
-##include "HsUnixConfig.h"
-
-#ifdef HAVE_SIGNAL_H
-#include <signal.h>
-#endif
-
-module System.Posix.Signals.Exts (
-  module System.Posix.Signals
-  , sigINFO
-  , sigWINCH
-  , infoEvent
-  , windowChange
-  ) where
-
-import Foreign.C
-import System.Posix.Signals
-
-sigINFO   :: CInt
-sigINFO   = CONST_SIGINFO
-
-sigWINCH   :: CInt
-sigWINCH   = CONST_SIGWINCH
-
-
-infoEvent :: Signal
-infoEvent = sigINFO
-
-windowChange :: Signal
-windowChange = sigWINCH

unix/System/Posix/Temp.hsc

@@ -1,124 +0,0 @@
-{-# LANGUAGE CApiFFI #-}
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Temp
--- Copyright   :  (c) Volker Stolz <vs@foldr.org>
---                    Deian Stefan <deian@cs.stanford.edu>
--- License     :  BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer  :  libraries@haskell.org, vs@foldr.org, deian@cs.stanford.edu
--- Stability   :  provisional
--- Portability :  non-portable (requires POSIX)
---
--- POSIX temporary file and directory creation functions.
---
------------------------------------------------------------------------------
-
-module System.Posix.Temp (
-        mkstemp, mkstemps, mkdtemp
-    ) where
-
-#include "HsUnix.h"
-
-import Foreign.C
-import System.IO
-#if !HAVE_MKDTEMP
-import System.Posix.Directory (createDirectory)
-#endif
-import System.Posix.IO
-import System.Posix.Types
-import System.Posix.Internals (withFilePath, peekFilePath)
-
-foreign import capi unsafe "HsUnix.h mkstemp"
-  c_mkstemp :: CString -> IO CInt
-
--- | Make a unique filename and open it for reading\/writing. The returned
--- 'FilePath' is the (possibly relative) path of the created file, which is
--- padded with 6 random characters. The argument is the desired prefix of the
--- filepath of the temporary file to be created.
---
--- If you aren't using GHC or Hugs then this function simply wraps mktemp and
--- so shouldn't be considered safe.
-mkstemp :: String -> IO (FilePath, Handle)
-mkstemp template' = do
-  let template = template' ++ "XXXXXX"
-  withFilePath template $ \ ptr -> do
-    fd <- throwErrnoIfMinus1 "mkstemp" (c_mkstemp ptr)
-    name <- peekFilePath ptr
-    h <- fdToHandle (Fd fd)
-    return (name, h)
-
-#if HAVE_MKSTEMPS
-foreign import capi unsafe "HsUnix.h mkstemps"
-  c_mkstemps :: CString -> CInt -> IO CInt
-#endif
-
--- | Make a unique filename with a given prefix and suffix and open it for
--- reading\/writing. The returned 'FilePath' is the (possibly relative) path of
--- the created file, which contains  6 random characters in between the prefix
--- and suffix. The first argument is the desired prefix of the filepath of the
--- temporary file to be created. The second argument is the suffix of the
--- temporary file to be created.
---
--- If you are using as system that doesn't support the mkstemps glibc function
--- (supported in glibc > 2.11) then this function simply throws an error.
-mkstemps :: String -> String -> IO (FilePath, Handle)
-#if HAVE_MKSTEMPS
-mkstemps prefix suffix = do
-  let template = prefix ++ "XXXXXX" ++ suffix
-      lenOfsuf = (fromIntegral $ length suffix) :: CInt
-  withFilePath template $ \ ptr -> do
-    fd <- throwErrnoIfMinus1 "mkstemps" (c_mkstemps ptr lenOfsuf)
-    name <- peekFilePath ptr
-    h <- fdToHandle (Fd fd)
-    return (name, h)
-#else
-mkstemps = error "System.Posix.Temp.mkstemps: not available on this platform"
-#endif
-
-#if HAVE_MKDTEMP
-foreign import capi unsafe "HsUnix.h mkdtemp"
-  c_mkdtemp :: CString -> IO CString
-#endif
-
--- | Make a unique directory. The returned 'FilePath' is the path of the
--- created directory, which is padded with 6 random characters. The argument is
--- the desired prefix of the filepath of the temporary directory to be created.
---
--- If you are using as system that doesn't support the mkdtemp glibc function
--- (supported in glibc > 2.1.91) then this function uses mktemp and so
--- shouldn't be considered safe.
-mkdtemp :: String -> IO FilePath
-mkdtemp template' = do
-  let template = template' ++ "XXXXXX"
-#if HAVE_MKDTEMP
-  withFilePath template $ \ ptr -> do
-    _ <- throwErrnoIfNull "mkdtemp" (c_mkdtemp ptr)
-    name <- peekFilePath ptr
-    return name
-#else
-  name <- mktemp template
-  h <- createDirectory name (toEnum 0o700)
-  return name
-#endif
-
-#if !HAVE_MKDTEMP
-
-foreign import ccall unsafe "mktemp"
-  c_mktemp :: CString -> IO CString
-
--- | Make a unique file name It is required that the template have six trailing
--- \'X\'s. This function should be considered deprecated.
-{-# WARNING mktemp "This function is unsafe; use mkstemp instead" #-}
-mktemp :: String -> IO String
-mktemp template = do
-  withFilePath template $ \ ptr -> do
-    ptr <- throwErrnoIfNull "mktemp" (c_mktemp ptr)
-    peekFilePath ptr
-#endif
-

unix/System/Posix/Temp/ByteString.hsc

@@ -1,124 +0,0 @@
-{-# LANGUAGE CApiFFI #-}
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Temp.ByteString
--- Copyright   :  (c) Volker Stolz <vs@foldr.org>
---                    Deian Stefan <deian@cs.stanford.edu>
--- License     :  BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer  :  libraries@haskell.org, vs@foldr.org, deian@cs.stanford.edu
--- Stability   :  provisional
--- Portability :  non-portable (requires POSIX)
---
--- POSIX temporary file and directory creation functions.
---
------------------------------------------------------------------------------
-
-module System.Posix.Temp.ByteString (
-        mkstemp, mkstemps, mkdtemp
-    ) where
-
-#include "HsUnix.h"
-
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Char8 as BC
-
-import Foreign.C
-
-import System.IO
-import System.Posix.ByteString.FilePath
-#if !HAVE_MKDTEMP
-import System.Posix.Directory (createDirectory)
-#endif
-import System.Posix.IO
-import System.Posix.Types
-
-foreign import capi unsafe "HsUnix.h mkstemp"
-  c_mkstemp :: CString -> IO CInt
-
--- | Make a unique filename and open it for reading\/writing. The returned
--- 'RawFilePath' is the (possibly relative) path of the created file, which is
--- padded with 6 random characters. The argument is the desired prefix of the
--- filepath of the temporary file to be created.
---
--- If you aren't using GHC or Hugs then this function simply wraps mktemp and
--- so shouldn't be considered safe.
-mkstemp :: ByteString -> IO (RawFilePath, Handle)
-mkstemp template' = do
-  let template = template' `B.append` (BC.pack "XXXXXX")
-  withFilePath template $ \ ptr -> do
-    fd <- throwErrnoIfMinus1 "mkstemp" (c_mkstemp ptr)
-    name <- peekFilePath ptr
-    h <- fdToHandle (Fd fd)
-    return (name, h)
-
-#if HAVE_MKSTEMPS
-foreign import capi unsafe "HsUnix.h mkstemps"
-  c_mkstemps :: CString -> CInt -> IO CInt
-#endif
-
--- |'mkstemps' - make a unique filename with a given prefix and suffix
--- and open it for reading\/writing (only safe on GHC & Hugs).
--- The returned 'RawFilePath' is the (possibly relative) path of
--- the created file, which contains  6 random characters in between
--- the prefix and suffix.
-mkstemps :: ByteString -> ByteString -> IO (RawFilePath, Handle)
-#if HAVE_MKSTEMPS
-mkstemps prefix suffix = do
-  let template = prefix `B.append` (BC.pack "XXXXXX") `B.append` suffix
-      lenOfsuf = (fromIntegral $ B.length suffix) :: CInt
-  withFilePath template $ \ ptr -> do
-    fd <- throwErrnoIfMinus1 "mkstemps" (c_mkstemps ptr lenOfsuf)
-    name <- peekFilePath ptr
-    h <- fdToHandle (Fd fd)
-    return (name, h)
-#else
-mkstemps = error "System.Posix.Temp.mkstemps: not available on this platform"
-#endif
-
-#if HAVE_MKDTEMP
-foreign import capi unsafe "HsUnix.h mkdtemp"
-  c_mkdtemp :: CString -> IO CString
-#endif
-
--- | Make a unique directory. The returned 'RawFilePath' is the path of the
--- created directory, which is padded with 6 random characters. The argument is
--- the desired prefix of the filepath of the temporary directory to be created.
---
--- If you aren't using GHC or Hugs then this function simply wraps mktemp and
--- so shouldn't be considered safe.
-mkdtemp :: ByteString -> IO RawFilePath
-mkdtemp template' = do
-  let template = template' `B.append` (BC.pack "XXXXXX")
-#if HAVE_MKDTEMP
-  withFilePath template $ \ ptr -> do
-    _ <- throwErrnoIfNull "mkdtemp" (c_mkdtemp ptr)
-    name <- peekFilePath ptr
-    return name
-#else
-  name <- mktemp template
-  h <- createDirectory (BC.unpack name) (toEnum 0o700)
-  return name
-#endif
-
-#if !HAVE_MKDTEMP
-
-foreign import ccall unsafe "mktemp"
-  c_mktemp :: CString -> IO CString
-
--- | Make a unique file name It is required that the template have six trailing
--- \'X\'s. This function should be considered deprecated.
-{-# WARNING mktemp "This function is unsafe; use mkstemp instead" #-}
-mktemp :: ByteString -> IO RawFilePath
-mktemp template = do
-  withFilePath template $ \ ptr -> do
-    ptr <- throwErrnoIfNull "mktemp" (c_mktemp ptr)
-    peekFilePath ptr
-#endif
-

unix/System/Posix/Terminal.hsc

@@ -1,219 +0,0 @@
-{-# LANGUAGE CApiFFI #-}
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Terminal
--- 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 Terminal support
---
------------------------------------------------------------------------------
-
-module System.Posix.Terminal (
-  -- * Terminal support
-
-  -- ** Terminal attributes
-  TerminalAttributes,
-  getTerminalAttributes,
-  TerminalState(..),
-  setTerminalAttributes,
-
-  TerminalMode(..),
-  withoutMode,
-  withMode,
-  terminalMode,
-  bitsPerByte,
-  withBits,
-
-  ControlCharacter(..),
-  controlChar,
-  withCC,
-  withoutCC,
-
-  inputTime,
-  withTime,
-  minInput,
-  withMinInput,
-
-  BaudRate(..),
-  inputSpeed,
-  withInputSpeed,
-  outputSpeed,
-  withOutputSpeed,
-
-  -- ** Terminal operations
-  sendBreak,
-  drainOutput,
-  QueueSelector(..),
-  discardData,
-  FlowAction(..),
-  controlFlow,
-
-  -- ** Process groups
-  getTerminalProcessGroupID,
-  setTerminalProcessGroupID,
-
-  -- ** Testing a file descriptor
-  queryTerminal,
-  getTerminalName,
-  getControllingTerminalName,
-
-  -- ** Pseudoterminal operations
-  openPseudoTerminal,
-  getSlaveTerminalName
-  ) where
-
-#include "HsUnix.h"
-
-import Foreign
-import Foreign.C
-import System.Posix.Terminal.Common
-import System.Posix.Types
-#ifndef HAVE_OPENPTY
-import System.Posix.IO
-#endif
-
-import System.Posix.Internals (peekFilePath)
-
-#if !HAVE_CTERMID
-import System.IO.Error ( ioeSetLocation )
-import GHC.IO.Exception ( unsupportedOperation )
-#endif
-
--- | @getTerminalName fd@ calls @ttyname@ to obtain a name associated
---   with the terminal for @Fd@ @fd@. If @fd@ is associated
---   with a terminal, @getTerminalName@ returns the name of the
---   terminal.
-getTerminalName :: Fd -> IO FilePath
-getTerminalName (Fd fd) = do
-  s <- throwErrnoIfNull "getTerminalName" (c_ttyname fd)
-  peekFilePath s
-
-foreign import ccall unsafe "ttyname"
-  c_ttyname :: CInt -> IO CString
-
--- | @getControllingTerminalName@ calls @ctermid@ to obtain
---   a name associated with the controlling terminal for the process.  If a
---   controlling terminal exists,
---   @getControllingTerminalName@ returns the name of the
---   controlling terminal.
---
--- Throws 'IOError' (\"unsupported operation\") if platform does not
--- provide @ctermid(3)@ (use @#if HAVE_CTERMID@ CPP guard to
--- detect availability).
-getControllingTerminalName :: IO FilePath
-#if HAVE_CTERMID
-getControllingTerminalName = do
-  s <- throwErrnoIfNull "getControllingTerminalName" (c_ctermid nullPtr)
-  peekFilePath s
-
-foreign import capi unsafe "termios.h ctermid"
-  c_ctermid :: CString -> IO CString
-#else
-{-# WARNING getControllingTerminalName
-    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_CTERMID@)" #-}
-getControllingTerminalName = ioError (ioeSetLocation unsupportedOperation "getControllingTerminalName")
-#endif
-
--- | @getSlaveTerminalName@ calls @ptsname@ to obtain the name of the
--- slave terminal associated with a pseudoterminal pair.  The file
--- descriptor to pass in must be that of the master.
-getSlaveTerminalName :: Fd -> IO FilePath
-
-#ifdef HAVE_PTSNAME
-getSlaveTerminalName (Fd fd) = do
-  s <- throwErrnoIfNull "getSlaveTerminalName" (c_ptsname fd)
-  peekFilePath s
-
-# if __GLASGOW_HASKELL__ < 800
--- see comment in cbits/HsUnix.c
-foreign import ccall unsafe "__hsunix_ptsname"
-  c_ptsname :: CInt -> IO CString
-# else
-foreign import capi unsafe "HsUnix.h ptsname"
-  c_ptsname :: CInt -> IO CString
-# endif
-#else
-getSlaveTerminalName _ =
-    ioError (errnoToIOError "getSlaveTerminalName" eNOSYS Nothing Nothing)
-#endif
-
--- -----------------------------------------------------------------------------
--- openPseudoTerminal needs to be here because it depends on
--- getSlaveTerminalName.
-
--- | @openPseudoTerminal@ creates a pseudoterminal (pty) pair, and
--- returns the newly created pair as a (@master@, @slave@) tuple.
-openPseudoTerminal :: IO (Fd, Fd)
-
-#ifdef HAVE_OPENPTY
-openPseudoTerminal =
-  alloca $ \p_master ->
-    alloca $ \p_slave -> do
-      throwErrnoIfMinus1_ "openPty"
-          (c_openpty p_master p_slave nullPtr nullPtr nullPtr)
-      master <- peek p_master
-      slave <- peek p_slave
-      return (Fd master, Fd slave)
-
-foreign import ccall unsafe "openpty"
-  c_openpty :: Ptr CInt -> Ptr CInt -> CString -> Ptr CTermios -> Ptr a
-            -> IO CInt
-#else
-openPseudoTerminal = do
-  (Fd master) <- openFd "/dev/ptmx" ReadWrite Nothing
-                        defaultFileFlags{noctty=True}
-  throwErrnoIfMinus1_ "openPseudoTerminal" (c_grantpt master)
-  throwErrnoIfMinus1_ "openPseudoTerminal" (c_unlockpt master)
-  slaveName <- getSlaveTerminalName (Fd master)
-  slave <- openFd slaveName ReadWrite Nothing defaultFileFlags{noctty=True}
-  pushModule slave "ptem"
-  pushModule slave "ldterm"
-# ifndef __hpux
-  pushModule slave "ttcompat"
-# endif /* __hpux */
-  return (Fd master, slave)
-
--- Push a STREAMS module, for System V systems.
-pushModule :: Fd -> String -> IO ()
-pushModule (Fd fd) name =
-  withCString name $ \p_name ->
-    throwErrnoIfMinus1_ "openPseudoTerminal"
-                        (c_push_module fd p_name)
-
-foreign import ccall unsafe "__hsunix_push_module"
-  c_push_module :: CInt -> CString -> IO CInt
-
-#ifdef HAVE_PTSNAME
-# if __GLASGOW_HASKELL__ < 800
--- see comment in cbits/HsUnix.c
-foreign import ccall unsafe "__hsunix_grantpt"
-  c_grantpt :: CInt -> IO CInt
-
-foreign import ccall unsafe "__hsunix_unlockpt"
-  c_unlockpt :: CInt -> IO CInt
-# else
-foreign import capi unsafe "HsUnix.h grantpt"
-  c_grantpt :: CInt -> IO CInt
-
-foreign import capi unsafe "HsUnix.h unlockpt"
-  c_unlockpt :: CInt -> IO CInt
-# endif
-#else
-c_grantpt :: CInt -> IO CInt
-c_grantpt _ = return (fromIntegral 0)
-
-c_unlockpt :: CInt -> IO CInt
-c_unlockpt _ = return (fromIntegral 0)
-#endif /* HAVE_PTSNAME */
-#endif /* !HAVE_OPENPTY */
-

unix/System/Posix/Terminal/ByteString.hsc

@@ -1,226 +0,0 @@
-{-# LANGUAGE CApiFFI #-}
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Terminal.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)
---
--- POSIX Terminal support
---
------------------------------------------------------------------------------
-
-module System.Posix.Terminal.ByteString (
-  -- * Terminal support
-
-  -- ** Terminal attributes
-  TerminalAttributes,
-  getTerminalAttributes,
-  TerminalState(..),
-  setTerminalAttributes,
-
-  TerminalMode(..),
-  withoutMode,
-  withMode,
-  terminalMode,
-  bitsPerByte,
-  withBits,
-
-  ControlCharacter(..),
-  controlChar,
-  withCC,
-  withoutCC,
-
-  inputTime,
-  withTime,
-  minInput,
-  withMinInput,
-
-  BaudRate(..),
-  inputSpeed,
-  withInputSpeed,
-  outputSpeed,
-  withOutputSpeed,
-
-  -- ** Terminal operations
-  sendBreak,
-  drainOutput,
-  QueueSelector(..),
-  discardData,
-  FlowAction(..),
-  controlFlow,
-
-  -- ** Process groups
-  getTerminalProcessGroupID,
-  setTerminalProcessGroupID,
-
-  -- ** Testing a file descriptor
-  queryTerminal,
-  getTerminalName,
-  getControllingTerminalName,
-
-  -- ** Pseudoterminal operations
-  openPseudoTerminal,
-  getSlaveTerminalName
-  ) where
-
-#include "HsUnix.h"
-
-import Foreign
-import System.Posix.Types
-import System.Posix.Terminal.Common
-#ifndef HAVE_OPENPTY
-import System.Posix.IO.ByteString (defaultFileFlags, openFd, noctty, OpenMode(ReadWrite))
-import Data.ByteString.Char8 as B ( pack, )
-#endif
-
-import Foreign.C hiding (
-     throwErrnoPath,
-     throwErrnoPathIf,
-     throwErrnoPathIf_,
-     throwErrnoPathIfNull,
-     throwErrnoPathIfMinus1,
-     throwErrnoPathIfMinus1_ )
-
-import System.Posix.ByteString.FilePath
-
-#if !HAVE_CTERMID
-import System.IO.Error ( ioeSetLocation )
-import GHC.IO.Exception ( unsupportedOperation )
-#endif
-
--- | @getTerminalName fd@ calls @ttyname@ to obtain a name associated
---   with the terminal for @Fd@ @fd@. If @fd@ is associated
---   with a terminal, @getTerminalName@ returns the name of the
---   terminal.
-getTerminalName :: Fd -> IO RawFilePath
-getTerminalName (Fd fd) = do
-  s <- throwErrnoIfNull "getTerminalName" (c_ttyname fd)
-  peekFilePath s
-
-foreign import ccall unsafe "ttyname"
-  c_ttyname :: CInt -> IO CString
-
--- | @getControllingTerminalName@ calls @ctermid@ to obtain
---   a name associated with the controlling terminal for the process.  If a
---   controlling terminal exists,
---   @getControllingTerminalName@ returns the name of the
---   controlling terminal.
---
--- Throws 'IOError' (\"unsupported operation\") if platform does not
--- provide @ctermid(3)@ (use @#if HAVE_CTERMID@ CPP guard to
--- detect availability).
-getControllingTerminalName :: IO RawFilePath
-#if HAVE_CTERMID
-getControllingTerminalName = do
-  s <- throwErrnoIfNull "getControllingTerminalName" (c_ctermid nullPtr)
-  peekFilePath s
-
-foreign import capi unsafe "termios.h ctermid"
-  c_ctermid :: CString -> IO CString
-#else
-{-# WARNING getControllingTerminalName
-    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_CTERMID@)" #-}
-getControllingTerminalName = ioError (ioeSetLocation unsupportedOperation "getControllingTerminalName")
-#endif
-
--- | @getSlaveTerminalName@ calls @ptsname@ to obtain the name of the
--- slave terminal associated with a pseudoterminal pair.  The file
--- descriptor to pass in must be that of the master.
-getSlaveTerminalName :: Fd -> IO RawFilePath
-
-#ifdef HAVE_PTSNAME
-getSlaveTerminalName (Fd fd) = do
-  s <- throwErrnoIfNull "getSlaveTerminalName" (c_ptsname fd)
-  peekFilePath s
-
-# if __GLASGOW_HASKELL__ < 800
--- see comment in cbits/HsUnix.c
-foreign import ccall unsafe "__hsunix_ptsname"
-  c_ptsname :: CInt -> IO CString
-# else
-foreign import capi unsafe "HsUnix.h ptsname"
-  c_ptsname :: CInt -> IO CString
-# endif
-#else
-getSlaveTerminalName _ =
-    ioError (errnoToIOError "getSlaveTerminalName" eNOSYS Nothing Nothing)
-#endif
-
--- -----------------------------------------------------------------------------
--- openPseudoTerminal needs to be here because it depends on
--- getSlaveTerminalName.
-
--- | @openPseudoTerminal@ creates a pseudoterminal (pty) pair, and
--- returns the newly created pair as a (@master@, @slave@) tuple.
-openPseudoTerminal :: IO (Fd, Fd)
-
-#ifdef HAVE_OPENPTY
-openPseudoTerminal =
-  alloca $ \p_master ->
-    alloca $ \p_slave -> do
-      throwErrnoIfMinus1_ "openPty"
-          (c_openpty p_master p_slave nullPtr nullPtr nullPtr)
-      master <- peek p_master
-      slave <- peek p_slave
-      return (Fd master, Fd slave)
-
-foreign import ccall unsafe "openpty"
-  c_openpty :: Ptr CInt -> Ptr CInt -> CString -> Ptr CTermios -> Ptr a
-            -> IO CInt
-#else
-openPseudoTerminal = do
-  (Fd master) <- openFd (B.pack "/dev/ptmx") ReadWrite Nothing
-                        defaultFileFlags{noctty=True}
-  throwErrnoIfMinus1_ "openPseudoTerminal" (c_grantpt master)
-  throwErrnoIfMinus1_ "openPseudoTerminal" (c_unlockpt master)
-  slaveName <- getSlaveTerminalName (Fd master)
-  slave <- openFd slaveName ReadWrite Nothing defaultFileFlags{noctty=True}
-  pushModule slave "ptem"
-  pushModule slave "ldterm"
-# ifndef __hpux
-  pushModule slave "ttcompat"
-# endif /* __hpux */
-  return (Fd master, slave)
-
--- Push a STREAMS module, for System V systems.
-pushModule :: Fd -> String -> IO ()
-pushModule (Fd fd) name =
-  withCString name $ \p_name ->
-    throwErrnoIfMinus1_ "openPseudoTerminal"
-                        (c_push_module fd p_name)
-
-foreign import ccall unsafe "__hsunix_push_module"
-  c_push_module :: CInt -> CString -> IO CInt
-
-#if HAVE_PTSNAME
-# if __GLASGOW_HASKELL__ < 800
--- see comment in cbits/HsUnix.c
-foreign import ccall unsafe "__hsunix_grantpt"
-  c_grantpt :: CInt -> IO CInt
-
-foreign import ccall unsafe "__hsunix_unlockpt"
-  c_unlockpt :: CInt -> IO CInt
-# else
-foreign import capi unsafe "HsUnix.h grantpt"
-  c_grantpt :: CInt -> IO CInt
-
-foreign import capi unsafe "HsUnix.h unlockpt"
-  c_unlockpt :: CInt -> IO CInt
-# endif
-#else
-c_grantpt :: CInt -> IO CInt
-c_grantpt _ = return (fromIntegral (0::Int))
-
-c_unlockpt :: CInt -> IO CInt
-c_unlockpt _ = return (fromIntegral (0::Int))
-#endif /* HAVE_PTSNAME */
-#endif /* !HAVE_OPENPTY */

unix/System/Posix/Terminal/Common.hsc

@@ -1,881 +0,0 @@
-{-# LANGUAGE CApiFFI #-}
-{-# LANGUAGE Trustworthy #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Terminal.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 Terminal support
---
------------------------------------------------------------------------------
-
--- see https://android.googlesource.com/platform/bionic/+/9ae59c0/libc/bionic/pathconf.c#37
-#if !defined(_POSIX_VDISABLE) && defined(__ANDROID__)
-#define _POSIX_VDISABLE -1
-#endif
-
-
-module System.Posix.Terminal.Common (
-  -- * Terminal support
-
-  -- ** Terminal attributes
-  TerminalAttributes,
-  getTerminalAttributes,
-  TerminalState(..),
-  setTerminalAttributes,
-
-  CTermios,
-  TerminalMode(..),
-  withoutMode,
-  withMode,
-  terminalMode,
-  bitsPerByte,
-  withBits,
-
-  ControlCharacter(..),
-  controlChar,
-  withCC,
-  withoutCC,
-
-  inputTime,
-  withTime,
-  minInput,
-  withMinInput,
-
-  BaudRate(..),
-  inputSpeed,
-  withInputSpeed,
-  outputSpeed,
-  withOutputSpeed,
-
-  -- ** Terminal operations
-  sendBreak,
-  drainOutput,
-  QueueSelector(..),
-  discardData,
-  FlowAction(..),
-  controlFlow,
-
-  -- ** Process groups
-  getTerminalProcessGroupID,
-  setTerminalProcessGroupID,
-
-  -- ** Testing a file descriptor
-  queryTerminal,
-  ) where
-
-#include "HsUnix.h"
-
-import Data.Bits
-import Data.Char
-import Foreign.C.Error ( throwErrnoIfMinus1, throwErrnoIfMinus1_ )
-import Foreign.C.Types
-import Foreign.ForeignPtr ( ForeignPtr, withForeignPtr, mallocForeignPtrBytes )
-import Foreign.Marshal.Utils ( copyBytes )
-import Foreign.Ptr ( Ptr, plusPtr )
-import Foreign.Storable ( Storable(..) )
-import System.IO.Unsafe ( unsafePerformIO )
-import System.Posix.Types
-import System.Posix.Internals ( CTermios )
-
-#if !HAVE_TCDRAIN
-import System.IO.Error ( ioeSetLocation )
-import GHC.IO.Exception ( unsupportedOperation )
-#endif
-
--- -----------------------------------------------------------------------------
--- Terminal attributes
-
-newtype TerminalAttributes = TerminalAttributes (ForeignPtr CTermios)
-
-makeTerminalAttributes :: ForeignPtr CTermios -> TerminalAttributes
-makeTerminalAttributes = TerminalAttributes
-
-withTerminalAttributes :: TerminalAttributes -> (Ptr CTermios -> IO a) -> IO a
-withTerminalAttributes (TerminalAttributes termios) = withForeignPtr termios
-
-
-data TerminalMode
-        -- input flags
-   = InterruptOnBreak           -- ^ @BRKINT@ - Signal interrupt on break
-   | MapCRtoLF                  -- ^ @ICRNL@ - Map CR to NL on input
-   | IgnoreBreak                -- ^ @IGNBRK@ - Ignore break condition
-   | IgnoreCR                   -- ^ @IGNCR@ - Ignore CR
-   | IgnoreParityErrors         -- ^ @IGNPAR@ - Ignore characters with parity errors
-   | MapLFtoCR                  -- ^ @INLCR@ - Map NL to CR on input
-   | CheckParity                -- ^ @INPCK@ - Enable input parity check
-   | StripHighBit               -- ^ @ISTRIP@ - Strip character
-   | RestartOnAny               -- ^ @IXANY@ - Enable any character to restart output
-   | StartStopInput             -- ^ @IXOFF@ - Enable start/stop input control
-   | StartStopOutput            -- ^ @IXON@ - Enable start/stop output control
-   | MarkParityErrors           -- ^ @PARMRK@ - Mark parity errors
-
-        -- output flags
-   | ProcessOutput              -- ^ @OPOST@ - Post-process output
-   | MapLFtoCRLF                -- ^ @ONLCR@ - (XSI) Map NL to CR-NL on output
-                                --
-                                -- @since 2.8.0.0
-   | OutputMapCRtoLF            -- ^ @OCRNL@ - (XSI) Map CR to NL on output
-                                --
-                                -- @since 2.8.0.0
-   | NoCRAtColumnZero           -- ^ @ONOCR@ - (XSI) No CR output at column 0
-                                --
-                                -- @since 2.8.0.0
-   | ReturnMeansLF              -- ^ @ONLRET@ - (XSI) NL performs CR function
-                                --
-                                -- @since 2.8.0.0
-   | TabDelayMask0              -- ^ @TABDLY(TAB0)@ - (XSI) Select horizontal-tab delays: type 0
-                                --
-                                -- @since 2.8.0.0
-   | TabDelayMask3              -- ^ @TABDLY(TAB3)@ - (XSI) Select horizontal-tab delays: type 3
-                                --
-                                -- @since 2.8.0.0
-
-        -- control flags
-   | LocalMode                  -- ^ @CLOCAL@ - Ignore modem status lines
-   | ReadEnable                 -- ^ @CREAD@ - Enable receiver
-   | TwoStopBits                -- ^ @CSTOPB@ - Send two stop bits, else one
-   | HangupOnClose              -- ^ @HUPCL@ - Hang up on last close
-   | EnableParity               -- ^ @PARENB@ - Parity enable
-   | OddParity                  -- ^ @PARODD@ - Odd parity, else even
-
-        -- local modes
-   | EnableEcho                 -- ^ @ECHO@ - Enable echo
-   | EchoErase                  -- ^ @ECHOE@ - Echo erase character as error-correcting backspace
-   | EchoKill                   -- ^ @ECHOK@ - Echo KILL
-   | EchoLF                     -- ^ @ECHONL@ - Echo NL
-   | ProcessInput               -- ^ @ICANON@ - Canonical input (erase and kill processing)
-   | ExtendedFunctions          -- ^ @IEXTEN@ - Enable extended input character processing
-   | KeyboardInterrupts         -- ^ @ISIG@ - Enable signals
-   | NoFlushOnInterrupt         -- ^ @NOFLSH@ - Disable flush after interrupt or quit
-   | BackgroundWriteInterrupt   -- ^ @TOSTOP@ - Send @SIGTTOU@ for background output
-
-withoutMode :: TerminalAttributes -> TerminalMode -> TerminalAttributes
-withoutMode termios InterruptOnBreak = clearInputFlag (#const BRKINT) termios
-withoutMode termios MapCRtoLF = clearInputFlag (#const ICRNL) termios
-withoutMode termios IgnoreBreak = clearInputFlag (#const IGNBRK) termios
-withoutMode termios IgnoreCR = clearInputFlag (#const IGNCR) termios
-withoutMode termios IgnoreParityErrors = clearInputFlag (#const IGNPAR) termios
-withoutMode termios MapLFtoCR = clearInputFlag (#const INLCR) termios
-withoutMode termios CheckParity = clearInputFlag (#const INPCK) termios
-withoutMode termios StripHighBit = clearInputFlag (#const ISTRIP) termios
-withoutMode termios RestartOnAny = clearInputFlag (#const IXANY) termios
-withoutMode termios StartStopInput = clearInputFlag (#const IXOFF) termios
-withoutMode termios StartStopOutput = clearInputFlag (#const IXON) termios
-withoutMode termios MarkParityErrors = clearInputFlag (#const PARMRK) termios
-withoutMode termios ProcessOutput = clearOutputFlag (#const OPOST) termios
-withoutMode termios MapLFtoCRLF = clearOutputFlag (#const ONLCR) termios
-withoutMode termios OutputMapCRtoLF = clearOutputFlag (#const OCRNL) termios
-withoutMode termios NoCRAtColumnZero = clearOutputFlag (#const ONOCR) termios
-withoutMode termios ReturnMeansLF = clearOutputFlag (#const ONLRET) termios
-withoutMode termios TabDelayMask0 = clearOutputFlag (#const TAB0) termios
-withoutMode termios TabDelayMask3 = clearOutputFlag (#const TAB3) termios
-withoutMode termios LocalMode = clearControlFlag (#const CLOCAL) termios
-withoutMode termios ReadEnable = clearControlFlag (#const CREAD) termios
-withoutMode termios TwoStopBits = clearControlFlag (#const CSTOPB) termios
-withoutMode termios HangupOnClose = clearControlFlag (#const HUPCL) termios
-withoutMode termios EnableParity = clearControlFlag (#const PARENB) termios
-withoutMode termios OddParity = clearControlFlag (#const PARODD) termios
-withoutMode termios EnableEcho = clearLocalFlag (#const ECHO) termios
-withoutMode termios EchoErase = clearLocalFlag (#const ECHOE) termios
-withoutMode termios EchoKill = clearLocalFlag (#const ECHOK) termios
-withoutMode termios EchoLF = clearLocalFlag (#const ECHONL) termios
-withoutMode termios ProcessInput = clearLocalFlag (#const ICANON) termios
-withoutMode termios ExtendedFunctions = clearLocalFlag (#const IEXTEN) termios
-withoutMode termios KeyboardInterrupts = clearLocalFlag (#const ISIG) termios
-withoutMode termios NoFlushOnInterrupt = setLocalFlag (#const NOFLSH) termios
-withoutMode termios BackgroundWriteInterrupt = clearLocalFlag (#const TOSTOP) termios
-
-withMode :: TerminalAttributes -> TerminalMode -> TerminalAttributes
-withMode termios InterruptOnBreak = setInputFlag (#const BRKINT) termios
-withMode termios MapCRtoLF = setInputFlag (#const ICRNL) termios
-withMode termios IgnoreBreak = setInputFlag (#const IGNBRK) termios
-withMode termios IgnoreCR = setInputFlag (#const IGNCR) termios
-withMode termios IgnoreParityErrors = setInputFlag (#const IGNPAR) termios
-withMode termios MapLFtoCR = setInputFlag (#const INLCR) termios
-withMode termios CheckParity = setInputFlag (#const INPCK) termios
-withMode termios StripHighBit = setInputFlag (#const ISTRIP) termios
-withMode termios RestartOnAny = setInputFlag (#const IXANY) termios
-withMode termios StartStopInput = setInputFlag (#const IXOFF) termios
-withMode termios StartStopOutput = setInputFlag (#const IXON) termios
-withMode termios MarkParityErrors = setInputFlag (#const PARMRK) termios
-withMode termios ProcessOutput = setOutputFlag (#const OPOST) termios
-withMode termios MapLFtoCRLF = setOutputFlag (#const ONLCR) termios
-withMode termios OutputMapCRtoLF = setOutputFlag (#const OCRNL) termios
-withMode termios NoCRAtColumnZero = setOutputFlag (#const ONOCR) termios
-withMode termios ReturnMeansLF = setOutputFlag (#const ONLRET) termios
-withMode termios TabDelayMask0 = setOutputFlag (#const TAB0) termios
-withMode termios TabDelayMask3 = setOutputFlag (#const TAB3) termios
-withMode termios LocalMode = setControlFlag (#const CLOCAL) termios
-withMode termios ReadEnable = setControlFlag (#const CREAD) termios
-withMode termios TwoStopBits = setControlFlag (#const CSTOPB) termios
-withMode termios HangupOnClose = setControlFlag (#const HUPCL) termios
-withMode termios EnableParity = setControlFlag (#const PARENB) termios
-withMode termios OddParity = setControlFlag (#const PARODD) termios
-withMode termios EnableEcho = setLocalFlag (#const ECHO) termios
-withMode termios EchoErase = setLocalFlag (#const ECHOE) termios
-withMode termios EchoKill = setLocalFlag (#const ECHOK) termios
-withMode termios EchoLF = setLocalFlag (#const ECHONL) termios
-withMode termios ProcessInput = setLocalFlag (#const ICANON) termios
-withMode termios ExtendedFunctions = setLocalFlag (#const IEXTEN) termios
-withMode termios KeyboardInterrupts = setLocalFlag (#const ISIG) termios
-withMode termios NoFlushOnInterrupt = clearLocalFlag (#const NOFLSH) termios
-withMode termios BackgroundWriteInterrupt = setLocalFlag (#const TOSTOP) termios
-
-terminalMode :: TerminalMode -> TerminalAttributes -> Bool
-terminalMode InterruptOnBreak = testInputFlag (#const BRKINT)
-terminalMode MapCRtoLF = testInputFlag (#const ICRNL)
-terminalMode IgnoreBreak = testInputFlag (#const IGNBRK)
-terminalMode IgnoreCR = testInputFlag (#const IGNCR)
-terminalMode IgnoreParityErrors = testInputFlag (#const IGNPAR)
-terminalMode MapLFtoCR = testInputFlag (#const INLCR)
-terminalMode CheckParity = testInputFlag (#const INPCK)
-terminalMode StripHighBit = testInputFlag (#const ISTRIP)
-terminalMode RestartOnAny = testInputFlag (#const IXANY)
-terminalMode StartStopInput = testInputFlag (#const IXOFF)
-terminalMode StartStopOutput = testInputFlag (#const IXON)
-terminalMode MarkParityErrors = testInputFlag (#const PARMRK)
-terminalMode ProcessOutput = testOutputFlag (#const OPOST)
-terminalMode MapLFtoCRLF = testOutputFlag (#const ONLCR)
-terminalMode OutputMapCRtoLF = testOutputFlag (#const OCRNL)
-terminalMode NoCRAtColumnZero = testOutputFlag (#const ONOCR)
-terminalMode ReturnMeansLF = testOutputFlag (#const ONLRET)
-terminalMode TabDelayMask0 = testOutputFlag (#const TAB0)
-terminalMode TabDelayMask3 = testOutputFlag (#const TAB3)
-terminalMode LocalMode = testControlFlag (#const CLOCAL)
-terminalMode ReadEnable = testControlFlag (#const CREAD)
-terminalMode TwoStopBits = testControlFlag (#const CSTOPB)
-terminalMode HangupOnClose = testControlFlag (#const HUPCL)
-terminalMode EnableParity = testControlFlag (#const PARENB)
-terminalMode OddParity = testControlFlag (#const PARODD)
-terminalMode EnableEcho = testLocalFlag (#const ECHO)
-terminalMode EchoErase = testLocalFlag (#const ECHOE)
-terminalMode EchoKill = testLocalFlag (#const ECHOK)
-terminalMode EchoLF = testLocalFlag (#const ECHONL)
-terminalMode ProcessInput = testLocalFlag (#const ICANON)
-terminalMode ExtendedFunctions = testLocalFlag (#const IEXTEN)
-terminalMode KeyboardInterrupts = testLocalFlag (#const ISIG)
-terminalMode NoFlushOnInterrupt = not . testLocalFlag (#const NOFLSH)
-terminalMode BackgroundWriteInterrupt = testLocalFlag (#const TOSTOP)
-
-bitsPerByte :: TerminalAttributes -> Int
-bitsPerByte termios = unsafePerformIO $ do
-  withTerminalAttributes termios $ \p -> do
-    cflag <- (#peek struct termios, c_cflag) p
-    return $! (word2Bits (cflag .&. (#const CSIZE)))
-  where
-    word2Bits :: CTcflag -> Int
-    word2Bits x =
-        if x == (#const CS5) then 5
-        else if x == (#const CS6) then 6
-        else if x == (#const CS7) then 7
-        else if x == (#const CS8) then 8
-        else 0
-
-withBits :: TerminalAttributes -> Int -> TerminalAttributes
-withBits termios bits = unsafePerformIO $ do
-  withNewTermios termios $ \p -> do
-    cflag <- (#peek struct termios, c_cflag) p
-    (#poke struct termios, c_cflag) p
-       ((cflag .&. complement (#const CSIZE)) .|. mask bits)
-  where
-    mask :: Int -> CTcflag
-    mask 5 = (#const CS5)
-    mask 6 = (#const CS6)
-    mask 7 = (#const CS7)
-    mask 8 = (#const CS8)
-    mask _ = error "withBits bit value out of range [5..8]"
-
-data ControlCharacter
-  = EndOfFile           -- VEOF
-  | EndOfLine           -- VEOL
-  | Erase               -- VERASE
-  | Interrupt           -- VINTR
-  | Kill                -- VKILL
-  | Quit                -- VQUIT
-  | Start               -- VSTART
-  | Stop                -- VSTOP
-  | Suspend             -- VSUSP
-
-controlChar :: TerminalAttributes -> ControlCharacter -> Maybe Char
-controlChar termios cc = unsafePerformIO $ do
-  withTerminalAttributes termios $ \p -> do
-    let c_cc = (#ptr struct termios, c_cc) p
-    val <- peekElemOff c_cc (cc2Word cc)
-    if val == ((#const _POSIX_VDISABLE)::CCc)
-       then return Nothing
-       else return (Just (chr (fromEnum val)))
-
-withCC :: TerminalAttributes
-       -> (ControlCharacter, Char)
-       -> TerminalAttributes
-withCC termios (cc, c) = unsafePerformIO $ do
-  withNewTermios termios $ \p -> do
-    let c_cc = (#ptr struct termios, c_cc) p
-    pokeElemOff c_cc (cc2Word cc) (fromIntegral (ord c) :: CCc)
-
-withoutCC :: TerminalAttributes
-          -> ControlCharacter
-          -> TerminalAttributes
-withoutCC termios cc = unsafePerformIO $ do
-  withNewTermios termios $ \p -> do
-    let c_cc = (#ptr struct termios, c_cc) p
-    pokeElemOff c_cc (cc2Word cc) ((#const _POSIX_VDISABLE) :: CCc)
-
-inputTime :: TerminalAttributes -> Int
-inputTime termios = unsafePerformIO $ do
-  withTerminalAttributes termios $ \p -> do
-    c <- peekElemOff ((#ptr struct termios, c_cc) p) (#const VTIME)
-    return (fromEnum (c :: CCc))
-
-withTime :: TerminalAttributes -> Int -> TerminalAttributes
-withTime termios time = unsafePerformIO $ do
-  withNewTermios termios $ \p -> do
-    let c_cc = (#ptr struct termios, c_cc) p
-    pokeElemOff c_cc (#const VTIME) (fromIntegral time :: CCc)
-
-minInput :: TerminalAttributes -> Int
-minInput termios = unsafePerformIO $ do
-  withTerminalAttributes termios $ \p -> do
-    c <- peekElemOff ((#ptr struct termios, c_cc) p) (#const VMIN)
-    return (fromEnum (c :: CCc))
-
-withMinInput :: TerminalAttributes -> Int -> TerminalAttributes
-withMinInput termios count = unsafePerformIO $ do
-  withNewTermios termios $ \p -> do
-    let c_cc = (#ptr struct termios, c_cc) p
-    pokeElemOff c_cc (#const VMIN) (fromIntegral count :: CCc)
-
-data BaudRate
-  -- These are the standard rates stipulated by POSIX:
-  = B0
-  | B50
-  | B75
-  | B110
-  | B134
-  | B150
-  | B200
-  | B300
-  | B600
-  | B1200
-  | B1800
-  | B2400
-  | B4800
-  | B9600
-  | B19200
-  | B38400
-  -- These are non-standard rates that are often present on modern Unixes:
-  | B57600
-  | B115200
-  | B230400
-  | B460800
-  | B500000
-  | B576000
-  | B921600
-  | B1000000
-  | B1152000
-  | B1500000
-  | B2000000
-  | B2500000
-  | B3000000
-  | B3500000
-  | B4000000
-
-inputSpeed :: TerminalAttributes -> BaudRate
-inputSpeed termios = unsafePerformIO $ do
-  withTerminalAttributes termios $ \p -> do
-    w <- c_cfgetispeed p
-    return (word2Baud w)
-
-foreign import capi unsafe "termios.h cfgetispeed"
-  c_cfgetispeed :: Ptr CTermios -> IO CSpeed
-
-withInputSpeed :: TerminalAttributes -> BaudRate -> TerminalAttributes
-withInputSpeed termios br = unsafePerformIO $ do
-  withNewTermios termios $ \p -> c_cfsetispeed p (baud2Word br)
-
-foreign import capi unsafe "termios.h cfsetispeed"
-  c_cfsetispeed :: Ptr CTermios -> CSpeed -> IO CInt
-
-
-outputSpeed :: TerminalAttributes -> BaudRate
-outputSpeed termios = unsafePerformIO $ do
-  withTerminalAttributes termios $ \p ->  do
-    w <- c_cfgetospeed p
-    return (word2Baud w)
-
-foreign import capi unsafe "termios.h cfgetospeed"
-  c_cfgetospeed :: Ptr CTermios -> IO CSpeed
-
-withOutputSpeed :: TerminalAttributes -> BaudRate -> TerminalAttributes
-withOutputSpeed termios br = unsafePerformIO $ do
-  withNewTermios termios $ \p -> c_cfsetospeed p (baud2Word br)
-
-foreign import capi unsafe "termios.h cfsetospeed"
-  c_cfsetospeed :: Ptr CTermios -> CSpeed -> IO CInt
-
--- | @getTerminalAttributes fd@ calls @tcgetattr@ to obtain
---   the @TerminalAttributes@ associated with @Fd@ @fd@.
-getTerminalAttributes :: Fd -> IO TerminalAttributes
-getTerminalAttributes (Fd fd) = do
-  fp <- mallocForeignPtrBytes (#const sizeof(struct termios))
-  withForeignPtr fp $ \p ->
-      throwErrnoIfMinus1_ "getTerminalAttributes" (c_tcgetattr fd p)
-  return $ makeTerminalAttributes fp
-
-foreign import capi unsafe "termios.h tcgetattr"
-  c_tcgetattr :: CInt -> Ptr CTermios -> IO CInt
-
-data TerminalState
-  = Immediately
-  | WhenDrained
-  | WhenFlushed
-
--- | @setTerminalAttributes fd attr ts@ calls @tcsetattr@ to change
---   the @TerminalAttributes@ associated with @Fd@ @fd@ to
---   @attr@, when the terminal is in the state indicated by @ts@.
-setTerminalAttributes :: Fd
-                      -> TerminalAttributes
-                      -> TerminalState
-                      -> IO ()
-setTerminalAttributes (Fd fd) termios state = do
-  withTerminalAttributes termios $ \p ->
-    throwErrnoIfMinus1_ "setTerminalAttributes"
-      (c_tcsetattr fd (state2Int state) p)
-  where
-    state2Int :: TerminalState -> CInt
-    state2Int Immediately = (#const TCSANOW)
-    state2Int WhenDrained = (#const TCSADRAIN)
-    state2Int WhenFlushed = (#const TCSAFLUSH)
-
-foreign import capi unsafe "termios.h tcsetattr"
-   c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt
-
--- | @sendBreak fd duration@ calls @tcsendbreak@ to transmit a
---   continuous stream of zero-valued bits on @Fd@ @fd@ for the
---   specified implementation-dependent @duration@.
-sendBreak :: Fd -> Int -> IO ()
-sendBreak (Fd fd) duration
-  = throwErrnoIfMinus1_ "sendBreak" (c_tcsendbreak fd (fromIntegral duration))
-
-foreign import capi unsafe "termios.h tcsendbreak"
-  c_tcsendbreak :: CInt -> CInt -> IO CInt
-
--- | @drainOutput fd@ calls @tcdrain@ to block until all output
---   written to @Fd@ @fd@ has been transmitted.
---
--- Throws 'IOError' (\"unsupported operation\") if platform does not
--- provide @tcdrain(3)@ (use @#if HAVE_TCDRAIN@ CPP guard to
--- detect availability).
-drainOutput :: Fd -> IO ()
-#if HAVE_TCDRAIN
-drainOutput (Fd fd) = throwErrnoIfMinus1_ "drainOutput" (c_tcdrain fd)
-
-foreign import capi safe "termios.h tcdrain"
-  c_tcdrain :: CInt -> IO CInt
-#else
-{-# WARNING drainOutput
-    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_TCDRAIN@)" #-}
-drainOutput _ = ioError (ioeSetLocation unsupportedOperation "drainOutput")
-#endif
-
-data QueueSelector
-  = InputQueue          -- TCIFLUSH
-  | OutputQueue         -- TCOFLUSH
-  | BothQueues          -- TCIOFLUSH
-
--- | @discardData fd queues@ calls @tcflush@ to discard
---   pending input and\/or output for @Fd@ @fd@,
---   as indicated by the @QueueSelector@ @queues@.
-discardData :: Fd -> QueueSelector -> IO ()
-discardData (Fd fd) queue =
-  throwErrnoIfMinus1_ "discardData" (c_tcflush fd (queue2Int queue))
-  where
-    queue2Int :: QueueSelector -> CInt
-    queue2Int InputQueue  = (#const TCIFLUSH)
-    queue2Int OutputQueue = (#const TCOFLUSH)
-    queue2Int BothQueues  = (#const TCIOFLUSH)
-
-foreign import capi unsafe "termios.h tcflush"
-  c_tcflush :: CInt -> CInt -> IO CInt
-
-data FlowAction
-  = SuspendOutput       -- ^ TCOOFF
-  | RestartOutput       -- ^ TCOON
-  | TransmitStop        -- ^ TCIOFF
-  | TransmitStart       -- ^ TCION
-
--- | @controlFlow fd action@ calls @tcflow@ to control the
---   flow of data on @Fd@ @fd@, as indicated by
---   @action@.
-controlFlow :: Fd -> FlowAction -> IO ()
-controlFlow (Fd fd) action =
-  throwErrnoIfMinus1_ "controlFlow" (c_tcflow fd (action2Int action))
-  where
-    action2Int :: FlowAction -> CInt
-    action2Int SuspendOutput = (#const TCOOFF)
-    action2Int RestartOutput = (#const TCOON)
-    action2Int TransmitStop  = (#const TCIOFF)
-    action2Int TransmitStart = (#const TCION)
-
-foreign import capi unsafe "termios.h tcflow"
-  c_tcflow :: CInt -> CInt -> IO CInt
-
--- | @getTerminalProcessGroupID fd@ calls @tcgetpgrp@ to
---   obtain the @ProcessGroupID@ of the foreground process group
---   associated with the terminal attached to @Fd@ @fd@.
-getTerminalProcessGroupID :: Fd -> IO ProcessGroupID
-getTerminalProcessGroupID (Fd fd) = do
-  throwErrnoIfMinus1 "getTerminalProcessGroupID" (c_tcgetpgrp fd)
-
-foreign import ccall unsafe "tcgetpgrp"
-  c_tcgetpgrp :: CInt -> IO CPid
-
--- | @setTerminalProcessGroupID fd pgid@ calls @tcsetpgrp@ to
---   set the @ProcessGroupID@ of the foreground process group
---   associated with the terminal attached to @Fd@
---   @fd@ to @pgid@.
-setTerminalProcessGroupID :: Fd -> ProcessGroupID -> IO ()
-setTerminalProcessGroupID (Fd fd) pgid =
-  throwErrnoIfMinus1_ "setTerminalProcessGroupID" (c_tcsetpgrp fd pgid)
-
-foreign import ccall unsafe "tcsetpgrp"
-  c_tcsetpgrp :: CInt -> CPid -> IO CInt
-
--- -----------------------------------------------------------------------------
--- file descriptor queries
-
--- | @queryTerminal fd@ calls @isatty@ to determine whether or
---   not @Fd@ @fd@ is associated with a terminal.
-queryTerminal :: Fd -> IO Bool
-queryTerminal (Fd fd) = do
-  r <- c_isatty fd
-  return (r == 1)
-  -- ToDo: the spec says that it can set errno to EBADF if the result is zero
-
-foreign import ccall unsafe "isatty"
-  c_isatty :: CInt -> IO CInt
-
--- -----------------------------------------------------------------------------
--- Local utility functions
-
--- Convert Haskell ControlCharacter to Int
-
-cc2Word :: ControlCharacter -> Int
-cc2Word EndOfFile = (#const VEOF)
-cc2Word EndOfLine = (#const VEOL)
-cc2Word Erase     = (#const VERASE)
-cc2Word Interrupt = (#const VINTR)
-cc2Word Kill      = (#const VKILL)
-cc2Word Quit      = (#const VQUIT)
-cc2Word Suspend   = (#const VSUSP)
-cc2Word Start     = (#const VSTART)
-cc2Word Stop      = (#const VSTOP)
-
--- Convert Haskell BaudRate to unsigned integral type (Word)
-
-baud2Word :: BaudRate -> CSpeed
-baud2Word B0 = (#const B0)
-baud2Word B50 = (#const B50)
-baud2Word B75 = (#const B75)
-baud2Word B110 = (#const B110)
-baud2Word B134 = (#const B134)
-baud2Word B150 = (#const B150)
-baud2Word B200 = (#const B200)
-baud2Word B300 = (#const B300)
-baud2Word B600 = (#const B600)
-baud2Word B1200 = (#const B1200)
-baud2Word B1800 = (#const B1800)
-baud2Word B2400 = (#const B2400)
-baud2Word B4800 = (#const B4800)
-baud2Word B9600 = (#const B9600)
-baud2Word B19200 = (#const B19200)
-baud2Word B38400 = (#const B38400)
-#ifdef B57600
-baud2Word B57600 = (#const B57600)
-#else
-baud2Word B57600 = error "B57600 not available on this system"
-#endif
-#ifdef B115200
-baud2Word B115200 = (#const B115200)
-#else
-baud2Word B115200 = error "B115200 not available on this system"
-#endif
-#ifdef B230400
-baud2Word B230400 = (#const B230400)
-#else
-baud2Word B230400 = error "B230400 not available on this system"
-#endif
-#ifdef B460800
-baud2Word B460800 = (#const B460800)
-#else
-baud2Word B460800 = error "B460800 not available on this system"
-#endif
-#ifdef B500000
-baud2Word B500000 = (#const B500000)
-#else
-baud2Word B500000 = error "B500000 not available on this system"
-#endif
-#ifdef B576000
-baud2Word B576000 = (#const B576000)
-#else
-baud2Word B576000 = error "B576000 not available on this system"
-#endif
-#ifdef B921600
-baud2Word B921600 = (#const B921600)
-#else
-baud2Word B921600 = error "B921600 not available on this system"
-#endif
-#ifdef B1000000
-baud2Word B1000000 = (#const B1000000)
-#else
-baud2Word B1000000 = error "B1000000 not available on this system"
-#endif
-#ifdef B1152000
-baud2Word B1152000 = (#const B1152000)
-#else
-baud2Word B1152000 = error "B1152000 not available on this system"
-#endif
-#ifdef B1500000
-baud2Word B1500000 = (#const B1500000)
-#else
-baud2Word B1500000 = error "B1500000 not available on this system"
-#endif
-#ifdef B2000000
-baud2Word B2000000 = (#const B2000000)
-#else
-baud2Word B2000000 = error "B2000000 not available on this system"
-#endif
-#ifdef B2500000
-baud2Word B2500000 = (#const B2500000)
-#else
-baud2Word B2500000 = error "B2500000 not available on this system"
-#endif
-#ifdef B3000000
-baud2Word B3000000 = (#const B3000000)
-#else
-baud2Word B3000000 = error "B3000000 not available on this system"
-#endif
-#ifdef B3500000
-baud2Word B3500000 = (#const B3500000)
-#else
-baud2Word B3500000 = error "B3500000 not available on this system"
-#endif
-#ifdef B4000000
-baud2Word B4000000 = (#const B4000000)
-#else
-baud2Word B4000000 = error "B4000000 not available on this system"
-#endif
-
--- And convert a word back to a baud rate
--- We really need some cpp macros here.
-
-word2Baud :: CSpeed -> BaudRate
-word2Baud x = case x of
-    (#const B0) -> B0
-    (#const B50) -> B50
-    (#const B75) -> B75
-    (#const B110) -> B110
-    (#const B134) -> B134
-    (#const B150) -> B150
-    (#const B200) -> B200
-    (#const B300) -> B300
-    (#const B600) -> B600
-    (#const B1200) -> B1200
-    (#const B1800) -> B1800
-    (#const B2400) -> B2400
-    (#const B4800) -> B4800
-    (#const B9600) -> B9600
-    (#const B19200) -> B19200
-    (#const B38400) -> B38400
-#ifdef B57600
-    (#const B57600) -> B57600
-#endif
-#ifdef B115200
-    (#const B115200) -> B115200
-#endif
-#ifdef B230400
-    (#const B230400) -> B230400
-#endif
-#ifdef B460800
-    (#const B460800) -> B460800
-#endif
-#ifdef B500000
-    (#const B500000) -> B500000
-#endif
-#ifdef B576000
-    (#const B576000) -> B576000
-#endif
-#ifdef B921600
-    (#const B921600) -> B921600
-#endif
-#ifdef B1000000
-    (#const B1000000) -> B1000000
-#endif
-#ifdef B1152000
-    (#const B1152000) -> B1152000
-#endif
-#ifdef B1500000
-    (#const B1500000) -> B1500000
-#endif
-#ifdef B2000000
-    (#const B2000000) -> B2000000
-#endif
-#ifdef B2500000
-    (#const B2500000) -> B2500000
-#endif
-#ifdef B3000000
-    (#const B3000000) -> B3000000
-#endif
-#ifdef B3500000
-    (#const B3500000) -> B3500000
-#endif
-#ifdef B4000000
-    (#const B4000000) -> B4000000
-#endif
-    _                 -> error "unknown baud rate"
-
--- Clear termios i_flag
-
-clearInputFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes
-clearInputFlag flag termios = unsafePerformIO $ do
-  fp <- mallocForeignPtrBytes (#const sizeof(struct termios))
-  withForeignPtr fp $ \p1 -> do
-    withTerminalAttributes termios $ \p2 -> do
-      copyBytes p1 p2 (#const sizeof(struct termios))
-      iflag <- (#peek struct termios, c_iflag) p2
-      (#poke struct termios, c_iflag) p1 (iflag .&. complement flag)
-  return $ makeTerminalAttributes fp
-
--- Set termios i_flag
-
-setInputFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes
-setInputFlag flag termios = unsafePerformIO $ do
-  fp <- mallocForeignPtrBytes (#const sizeof(struct termios))
-  withForeignPtr fp $ \p1 -> do
-    withTerminalAttributes termios $ \p2 -> do
-      copyBytes p1 p2 (#const sizeof(struct termios))
-      iflag <- (#peek struct termios, c_iflag) p2
-      (#poke struct termios, c_iflag) p1 (iflag .|. flag)
-  return $ makeTerminalAttributes fp
-
--- Examine termios i_flag
-
-testInputFlag :: CTcflag -> TerminalAttributes -> Bool
-testInputFlag flag termios = unsafePerformIO $
-  withTerminalAttributes termios $ \p ->  do
-    iflag <- (#peek struct termios, c_iflag) p
-    return $! ((iflag .&. flag) /= 0)
-
--- Clear termios c_flag
-
-clearControlFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes
-clearControlFlag flag termios = unsafePerformIO $ do
-  fp <- mallocForeignPtrBytes (#const sizeof(struct termios))
-  withForeignPtr fp $ \p1 -> do
-    withTerminalAttributes termios $ \p2 -> do
-      copyBytes p1 p2 (#const sizeof(struct termios))
-      cflag <- (#peek struct termios, c_cflag) p2
-      (#poke struct termios, c_cflag) p1 (cflag .&. complement flag)
-  return $ makeTerminalAttributes fp
-
--- Set termios c_flag
-
-setControlFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes
-setControlFlag flag termios = unsafePerformIO $ do
-  fp <- mallocForeignPtrBytes (#const sizeof(struct termios))
-  withForeignPtr fp $ \p1 -> do
-    withTerminalAttributes termios $ \p2 -> do
-      copyBytes p1 p2 (#const sizeof(struct termios))
-      cflag <- (#peek struct termios, c_cflag) p2
-      (#poke struct termios, c_cflag) p1 (cflag .|. flag)
-  return $ makeTerminalAttributes fp
-
--- Examine termios c_flag
-
-testControlFlag :: CTcflag -> TerminalAttributes -> Bool
-testControlFlag flag termios = unsafePerformIO $
-  withTerminalAttributes termios $ \p -> do
-    cflag <- (#peek struct termios, c_cflag) p
-    return $! ((cflag .&. flag) /= 0)
-
--- Clear termios l_flag
-
-clearLocalFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes
-clearLocalFlag flag termios = unsafePerformIO $ do
-  fp <- mallocForeignPtrBytes (#const sizeof(struct termios))
-  withForeignPtr fp $ \p1 -> do
-    withTerminalAttributes termios $ \p2 -> do
-      copyBytes p1 p2 (#const sizeof(struct termios))
-      lflag <- (#peek struct termios, c_lflag) p2
-      (#poke struct termios, c_lflag) p1 (lflag .&. complement flag)
-  return $ makeTerminalAttributes fp
-
--- Set termios l_flag
-
-setLocalFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes
-setLocalFlag flag termios = unsafePerformIO $ do
-  fp <- mallocForeignPtrBytes (#const sizeof(struct termios))
-  withForeignPtr fp $ \p1 -> do
-    withTerminalAttributes termios $ \p2 -> do
-      copyBytes p1 p2 (#const sizeof(struct termios))
-      lflag <- (#peek struct termios, c_lflag) p2
-      (#poke struct termios, c_lflag) p1 (lflag .|. flag)
-  return $ makeTerminalAttributes fp
-
--- Examine termios l_flag
-
-testLocalFlag :: CTcflag -> TerminalAttributes -> Bool
-testLocalFlag flag termios = unsafePerformIO $
-  withTerminalAttributes termios $ \p ->  do
-    lflag <- (#peek struct termios, c_lflag) p
-    return $! ((lflag .&. flag) /= 0)
-
--- Clear termios o_flag
-
-clearOutputFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes
-clearOutputFlag flag termios = unsafePerformIO $ do
-  fp <- mallocForeignPtrBytes (#const sizeof(struct termios))
-  withForeignPtr fp $ \p1 -> do
-    withTerminalAttributes termios $ \p2 -> do
-      copyBytes p1 p2 (#const sizeof(struct termios))
-      oflag <- (#peek struct termios, c_oflag) p2
-      (#poke struct termios, c_oflag) p1 (oflag .&. complement flag)
-  return $ makeTerminalAttributes fp
-
--- Set termios o_flag
-
-setOutputFlag :: CTcflag -> TerminalAttributes -> TerminalAttributes
-setOutputFlag flag termios = unsafePerformIO $ do
-  fp <- mallocForeignPtrBytes (#const sizeof(struct termios))
-  withForeignPtr fp $ \p1 -> do
-    withTerminalAttributes termios $ \p2 -> do
-      copyBytes p1 p2 (#const sizeof(struct termios))
-      oflag <- (#peek struct termios, c_oflag) p2
-      (#poke struct termios, c_oflag) p1 (oflag .|. flag)
-  return $ makeTerminalAttributes fp
-
--- Examine termios o_flag
-
-testOutputFlag :: CTcflag -> TerminalAttributes -> Bool
-testOutputFlag flag termios = unsafePerformIO $
-  withTerminalAttributes termios $ \p -> do
-    oflag <- (#peek struct termios, c_oflag) p
-    return $! ((oflag .&. flag) /= 0)
-
-withNewTermios :: TerminalAttributes -> (Ptr CTermios -> IO a)
-  -> IO TerminalAttributes
-withNewTermios termios action = do
-  fp1 <- mallocForeignPtrBytes (#const sizeof(struct termios))
-  withForeignPtr fp1 $ \p1 -> do
-   withTerminalAttributes termios $ \p2 -> do
-    copyBytes p1 p2 (#const sizeof(struct termios))
-    _ <- action p1
-    return ()
-  return $ makeTerminalAttributes fp1

unix/System/Posix/Time.hs

@@ -1,41 +0,0 @@
-{-# LANGUAGE CApiFFI #-}
-{-# LANGUAGE CPP #-}
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Time
--- 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 Time support
---
------------------------------------------------------------------------------
-
-module System.Posix.Time (
-        epochTime,
-        -- ToDo: lots more from sys/time.h
-        -- how much already supported by System.Time?
-  ) where
-
-import System.Posix.Types
-import Foreign
-import Foreign.C
-
--- -----------------------------------------------------------------------------
--- epochTime
-
--- | @epochTime@ calls @time@ to obtain the number of
---   seconds that have elapsed since the epoch (Jan 01 00:00:00 GMT 1970).
-epochTime :: IO EpochTime
-epochTime = throwErrnoIfMinus1 "epochTime" (c_time nullPtr)
-
-foreign import capi unsafe "HsUnix.h time"
-  c_time :: Ptr CTime -> IO CTime

unix/System/Posix/Unistd.hsc

@@ -1,264 +0,0 @@
-{-# LANGUAGE CApiFFI #-}
-{-# LANGUAGE NondecreasingIndentation #-}
-#if __GLASGOW_HASKELL__ >= 709
-{-# LANGUAGE Safe #-}
-#else
-{-# LANGUAGE Trustworthy #-}
-#endif
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.Unistd
--- 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 miscellaneous stuff, mostly from unistd.h
---
------------------------------------------------------------------------------
-
-module System.Posix.Unistd (
-    -- * System environment
-    SystemID(..),
-    getSystemID,
-
-    SysVar(..),
-    getSysVar,
-
-    -- * Sleeping
-    sleep, usleep, nanosleep,
-
-    -- * File synchronisation
-    fileSynchronise,
-    fileSynchroniseDataOnly,
-
-  {-
-    ToDo from unistd.h:
-      confstr,
-      lots of sysconf variables
-
-    -- use Network.BSD
-    gethostid, gethostname
-
-    -- should be in System.Posix.Files?
-    pathconf, fpathconf,
-
-    -- System.Posix.Signals
-    ualarm,
-
-    -- System.Posix.IO
-    read, write,
-
-    -- should be in System.Posix.User?
-    getEffectiveUserName,
--}
-  ) where
-
-#include "HsUnix.h"
-
-import Foreign.C.Error
-import Foreign.C.String ( peekCString )
-import Foreign.C.Types
-import Foreign
-import System.Posix.Types
-import System.Posix.Internals
-
-#if !(HAVE_FSYNC && HAVE_FDATASYNC)
-import System.IO.Error ( ioeSetLocation )
-import GHC.IO.Exception ( unsupportedOperation )
-#endif
-
--- -----------------------------------------------------------------------------
--- System environment (uname())
-
-data SystemID =
-  SystemID { systemName :: String
-           , nodeName   :: String
-           , release    :: String
-           , version    :: String
-           , machine    :: String
-           }
-
-getSystemID :: IO SystemID
-getSystemID = do
-  allocaBytes (#const sizeof(struct utsname)) $ \p_sid -> do
-    throwErrnoIfMinus1_ "getSystemID" (c_uname p_sid)
-    sysN <- peekCString ((#ptr struct utsname, sysname) p_sid)
-    node <- peekCString ((#ptr struct utsname, nodename) p_sid)
-    rel  <- peekCString ((#ptr struct utsname, release) p_sid)
-    ver  <- peekCString ((#ptr struct utsname, version) p_sid)
-    mach <- peekCString ((#ptr struct utsname, machine) p_sid)
-    return (SystemID { systemName = sysN,
-                       nodeName   = node,
-                       release    = rel,
-                       version    = ver,
-                       machine    = mach
-                     })
-
-foreign import ccall unsafe "uname"
-   c_uname :: Ptr CUtsname -> IO CInt
-
--- -----------------------------------------------------------------------------
--- sleeping
-
--- | Sleep for the specified duration (in seconds).  Returns the time remaining
--- (if the sleep was interrupted by a signal, for example).
---
--- /GHC Note/: 'Control.Concurrent.threadDelay' is a better choice.  Since GHC
--- uses signals for its internal clock, a call to 'sleep' will usually be
--- interrupted immediately.  That makes 'sleep' unusable in a program compiled
--- with GHC, unless the RTS timer is disabled (with @+RTS -V0@).  Furthermore,
--- without the @-threaded@ option, 'sleep' will block all other user threads.
--- Even with the @-threaded@ option, 'sleep' requires a full OS thread to
--- itself.  'Control.Concurrent.threadDelay' has none of these shortcomings.
---
-sleep :: Int -> IO Int
-sleep 0 = return 0
-sleep secs = do r <- c_sleep (fromIntegral secs); return (fromIntegral r)
-
-{-# WARNING sleep "This function has several shortcomings (see documentation). Please consider using Control.Concurrent.threadDelay instead." #-}
-
-foreign import ccall safe "sleep"
-  c_sleep :: CUInt -> IO CUInt
-
--- | Sleep for the specified duration (in microseconds).
---
--- /GHC Note/: 'Control.Concurrent.threadDelay' is a better choice.
--- Without the @-threaded@ option, 'usleep' will block all other user
--- threads.  Even with the @-threaded@ option, 'usleep' requires a
--- full OS thread to itself.  'Control.Concurrent.threadDelay' has
--- neither of these shortcomings.
---
-usleep :: Int -> IO ()
-#ifdef HAVE_NANOSLEEP
-usleep usecs = nanosleep (fromIntegral usecs * 1000)
-#else
-usleep 0 = return ()
-#ifdef USLEEP_RETURNS_VOID
-usleep usecs = c_usleep (fromIntegral usecs)
-#else
-usleep usecs = throwErrnoIfMinus1_ "usleep" (c_usleep (fromIntegral usecs))
-#endif
-
-#ifdef USLEEP_RETURNS_VOID
-foreign import ccall safe "usleep"
-  c_usleep :: CUInt -> IO ()
-#else
-foreign import ccall safe "usleep"
-  c_usleep :: CUInt -> IO CInt
-#endif
-#endif /* HAVE_NANOSLEEP */
-
--- | Sleep for the specified duration (in nanoseconds)
---
--- /GHC Note/: the comment for 'usleep' also applies here.
-nanosleep :: Integer -> IO ()
-#ifndef HAVE_NANOSLEEP
-nanosleep = error "nanosleep: not available on this platform"
-#else
-nanosleep 0 = return ()
-nanosleep nsecs = do
-  allocaBytes (#const sizeof(struct timespec)) $ \pts1 -> do
-  allocaBytes (#const sizeof(struct timespec)) $ \pts2 -> do
-     let (tv_sec0, tv_nsec0) = nsecs `divMod` 1000000000
-     let
-       loop tv_sec tv_nsec = do
-         (#poke struct timespec, tv_sec)  pts1 tv_sec
-         (#poke struct timespec, tv_nsec) pts1 tv_nsec
-         res <- c_nanosleep pts1 pts2
-         if res == 0
-            then return ()
-            else do errno <- getErrno
-                    if errno == eINTR
-                       then do
-                           tv_sec'  <- (#peek struct timespec, tv_sec)  pts2
-                           tv_nsec' <- (#peek struct timespec, tv_nsec) pts2
-                           loop tv_sec' tv_nsec'
-                       else throwErrno "nanosleep"
-     loop (fromIntegral tv_sec0 :: CTime) (fromIntegral tv_nsec0 :: CTime)
-
-data {-# CTYPE "struct timespec" #-} CTimeSpec
-
-foreign import capi safe "HsUnix.h nanosleep"
-  c_nanosleep :: Ptr CTimeSpec -> Ptr CTimeSpec -> IO CInt
-#endif
-
--- -----------------------------------------------------------------------------
--- System variables
-
-data SysVar = ArgumentLimit
-            | ChildLimit
-            | ClockTick
-            | GroupLimit
-            | OpenFileLimit
-            | PosixVersion
-            | HasSavedIDs
-            | HasJobControl
-        -- ToDo: lots more
-
-getSysVar :: SysVar -> IO Integer
-getSysVar v =
-    case v of
-      ArgumentLimit -> sysconf (#const _SC_ARG_MAX)
-      ChildLimit    -> sysconf (#const _SC_CHILD_MAX)
-      ClockTick     -> sysconf (#const _SC_CLK_TCK)
-      GroupLimit    -> sysconf (#const _SC_NGROUPS_MAX)
-      OpenFileLimit -> sysconf (#const _SC_OPEN_MAX)
-      PosixVersion  -> sysconf (#const _SC_VERSION)
-      HasSavedIDs   -> sysconf (#const _SC_SAVED_IDS)
-      HasJobControl -> sysconf (#const _SC_JOB_CONTROL)
-
-sysconf :: CInt -> IO Integer
-sysconf n = do
-  r <- throwErrnoIfMinus1 "getSysVar" (c_sysconf n)
-  return (fromIntegral r)
-
-foreign import ccall unsafe "sysconf"
-  c_sysconf :: CInt -> IO CLong
-
--- -----------------------------------------------------------------------------
--- File synchronization
-
--- | Performs @fsync(2)@ operation on file-descriptor.
---
--- Throws 'IOError' (\"unsupported operation\") if platform does not
--- provide @fsync(2)@ (use @#if HAVE_FSYNC@ CPP guard to
--- detect availability).
---
--- @since 2.7.1.0
-fileSynchronise :: Fd -> IO ()
-#if HAVE_FSYNC
-fileSynchronise fd = do
-  throwErrnoIfMinus1_ "fileSynchronise" (c_fsync fd)
-
-foreign import capi safe "unistd.h fsync"
-  c_fsync :: Fd -> IO CInt
-#else
-{-# WARNING fileSynchronise
-    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_FSYNC@)" #-}
-fileSynchronise _ = ioError (ioeSetLocation unsupportedOperation
-                             "fileSynchronise")
-#endif
-
--- | Performs @fdatasync(2)@ operation on file-descriptor.
---
--- Throws 'IOError' (\"unsupported operation\") if platform does not
--- provide @fdatasync(2)@ (use @#if HAVE_FDATASYNC@ CPP guard to
--- detect availability).
---
--- @since 2.7.1.0
-fileSynchroniseDataOnly :: Fd -> IO ()
-#if HAVE_FDATASYNC
-fileSynchroniseDataOnly fd = do
-  throwErrnoIfMinus1_ "fileSynchroniseDataOnly" (c_fdatasync fd)
-
-foreign import capi safe "unistd.h fdatasync"
-  c_fdatasync :: Fd -> IO CInt
-#else
-{-# WARNING fileSynchroniseDataOnly
-    "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_FDATASYNC@)" #-}
-fileSynchroniseDataOnly _ = ioError (ioeSetLocation unsupportedOperation
-                                     "fileSynchroniseDataOnly")
-#endif

unix/System/Posix/User.hsc

@@ -1,474 +0,0 @@
-{-# LANGUAGE Trustworthy, CApiFFI #-}
------------------------------------------------------------------------------
--- |
--- Module      :  System.Posix.User
--- 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 user\/group support
---
------------------------------------------------------------------------------
-
-module System.Posix.User (
-    -- * User environment
-    -- ** Querying the user environment
-    getRealUserID,
-    getRealGroupID,
-    getEffectiveUserID,
-    getEffectiveGroupID,
-    getGroups,
-    getLoginName,
-    getEffectiveUserName,
-
-    -- *** The group database
-    GroupEntry(..),
-    getGroupEntryForID,
-    getGroupEntryForName,
-    getAllGroupEntries,
-
-    -- *** The user database
-    UserEntry(..),
-    getUserEntryForID,
-    getUserEntryForName,
-    getAllUserEntries,
-
-    -- ** Modifying the user environment
-    setUserID,
-    setGroupID,
-    setEffectiveUserID,
-    setEffectiveGroupID,
-    setGroups
-
-  ) where
-
-#include "HsUnix.h"
-
-import System.Posix.Types
-import System.IO.Unsafe (unsafePerformIO)
-import Foreign.C
-import Foreign.Ptr
-import Foreign.Marshal
-import Foreign.Storable
-
-#if !defined(HAVE_GETPWNAM_R) || !defined(HAVE_GETPWUID_R) || defined(HAVE_GETPWENT) || defined(HAVE_GETGRENT)
-import Control.Concurrent.MVar  ( MVar, newMVar, withMVar )
-#endif
-#ifdef HAVE_GETPWENT
-import Control.Exception
-#endif
-import Control.Monad
-import System.IO.Error
-
--- internal types
-data {-# CTYPE "struct passwd" #-} CPasswd
-data {-# CTYPE "struct group"  #-} CGroup
-
--- -----------------------------------------------------------------------------
--- user environment
-
--- | @getRealUserID@ calls @getuid@ to obtain the real @UserID@
---   associated with the current process.
-getRealUserID :: IO UserID
-getRealUserID = c_getuid
-
-foreign import ccall unsafe "getuid"
-  c_getuid :: IO CUid
-
--- | @getRealGroupID@ calls @getgid@ to obtain the real @GroupID@
---   associated with the current process.
-getRealGroupID :: IO GroupID
-getRealGroupID = c_getgid
-
-foreign import ccall unsafe "getgid"
-  c_getgid :: IO CGid
-
--- | @getEffectiveUserID@ calls @geteuid@ to obtain the effective
---   @UserID@ associated with the current process.
-getEffectiveUserID :: IO UserID
-getEffectiveUserID = c_geteuid
-
-foreign import ccall unsafe "geteuid"
-  c_geteuid :: IO CUid
-
--- | @getEffectiveGroupID@ calls @getegid@ to obtain the effective
---   @GroupID@ associated with the current process.
-getEffectiveGroupID :: IO GroupID
-getEffectiveGroupID = c_getegid
-
-foreign import ccall unsafe "getegid"
-  c_getegid :: IO CGid
-
--- | @getGroups@ calls @getgroups@ to obtain the list of
---   supplementary @GroupID@s associated with the current process.
-getGroups :: IO [GroupID]
-getGroups = do
-    ngroups <- c_getgroups 0 nullPtr
-    allocaArray (fromIntegral ngroups) $ \arr -> do
-       throwErrnoIfMinus1_ "getGroups" (c_getgroups ngroups arr)
-       groups <- peekArray (fromIntegral ngroups) arr
-       return groups
-
-foreign import ccall unsafe "getgroups"
-  c_getgroups :: CInt -> Ptr CGid -> IO CInt
-
-
--- | @setGroups@ calls @setgroups@ to set the list of
---   supplementary @GroupID@s associated with the current process.
-setGroups :: [GroupID] -> IO ()
-setGroups groups = do
-    withArrayLen groups $ \ ngroups arr ->
-       throwErrnoIfMinus1_ "setGroups" (c_setgroups (fromIntegral ngroups) arr)
-
-foreign import ccall unsafe "setgroups"
-  c_setgroups :: CInt -> Ptr CGid -> IO CInt
-
-
-
--- | @getLoginName@ calls @getlogin@ to obtain the login name
---   associated with the current process.
-getLoginName :: IO String
-getLoginName =  do
-    -- ToDo: use getlogin_r
-    str <- throwErrnoIfNull "getLoginName" c_getlogin
-    peekCAString str
-
-foreign import ccall unsafe "getlogin"
-  c_getlogin :: IO CString
-
--- | @setUserID uid@ calls @setuid@ to set the real, effective, and
---   saved set-user-id associated with the current process to @uid@.
-setUserID :: UserID -> IO ()
-setUserID uid = throwErrnoIfMinus1_ "setUserID" (c_setuid uid)
-
-foreign import ccall unsafe "setuid"
-  c_setuid :: CUid -> IO CInt
-
--- | @setEffectiveUserID uid@ calls @seteuid@ to set the effective
---   user-id associated with the current process to @uid@. This
---   does not update the real user-id or set-user-id.
-setEffectiveUserID :: UserID -> IO ()
-setEffectiveUserID uid = throwErrnoIfMinus1_ "setEffectiveUserID" (c_seteuid uid)
-
-foreign import ccall unsafe "seteuid"
-  c_seteuid :: CUid -> IO CInt
-
--- | @setGroupID gid@ calls @setgid@ to set the real, effective, and
---   saved set-group-id associated with the current process to @gid@.
-setGroupID :: GroupID -> IO ()
-setGroupID gid = throwErrnoIfMinus1_ "setGroupID" (c_setgid gid)
-
-foreign import ccall unsafe "setgid"
-  c_setgid :: CGid -> IO CInt
-
--- | @setEffectiveGroupID uid@ calls @setegid@ to set the effective
---   group-id associated with the current process to @gid@. This
---   does not update the real group-id or set-group-id.
-setEffectiveGroupID :: GroupID -> IO ()
-setEffectiveGroupID gid =
-  throwErrnoIfMinus1_ "setEffectiveGroupID" (c_setegid gid)
-
-
-foreign import ccall unsafe "setegid"
-  c_setegid :: CGid -> IO CInt
-
--- -----------------------------------------------------------------------------
--- User names
-
--- | @getEffectiveUserName@ gets the name
---   associated with the effective @UserID@ of the process.
-getEffectiveUserName :: IO String
-getEffectiveUserName = do
-    euid <- getEffectiveUserID
-    pw <- getUserEntryForID euid
-    return (userName pw)
-
--- -----------------------------------------------------------------------------
--- The group database (grp.h)
-
-data GroupEntry =
- GroupEntry {
-  groupName    :: String,       -- ^ The name of this group (gr_name)
-  groupPassword :: String,      -- ^ The password for this group (gr_passwd)
-  groupID      :: GroupID,      -- ^ The unique numeric ID for this group (gr_gid)
-  groupMembers :: [String]      -- ^ A list of zero or more usernames that are members (gr_mem)
- } deriving (Show, Read, Eq)
-
--- | @getGroupEntryForID gid@ calls @getgrgid_r@ to obtain
---   the @GroupEntry@ information associated with @GroupID@
---   @gid@. This operation may fail with 'isDoesNotExistError'
---   if no such group exists.
-getGroupEntryForID :: GroupID -> IO GroupEntry
-#ifdef HAVE_GETGRGID_R
-getGroupEntryForID gid =
-  allocaBytes (#const sizeof(struct group)) $ \pgr ->
-   doubleAllocWhileERANGE "getGroupEntryForID" "group" grBufSize unpackGroupEntry $
-     c_getgrgid_r gid pgr
-
-foreign import capi unsafe "HsUnix.h getgrgid_r"
-  c_getgrgid_r :: CGid -> Ptr CGroup -> CString
-                 -> CSize -> Ptr (Ptr CGroup) -> IO CInt
-#else
-getGroupEntryForID = error "System.Posix.User.getGroupEntryForID: not supported"
-#endif
-
--- | @getGroupEntryForName name@ calls @getgrnam_r@ to obtain
---   the @GroupEntry@ information associated with the group called
---   @name@. This operation may fail with 'isDoesNotExistError'
---   if no such group exists.
-getGroupEntryForName :: String -> IO GroupEntry
-#ifdef HAVE_GETGRNAM_R
-getGroupEntryForName name =
-  allocaBytes (#const sizeof(struct group)) $ \pgr ->
-    withCAString name $ \ pstr ->
-      doubleAllocWhileERANGE "getGroupEntryForName" "group" grBufSize unpackGroupEntry $
-        c_getgrnam_r pstr pgr
-
-foreign import capi unsafe "HsUnix.h getgrnam_r"
-  c_getgrnam_r :: CString -> Ptr CGroup -> CString
-                 -> CSize -> Ptr (Ptr CGroup) -> IO CInt
-#else
-getGroupEntryForName = error "System.Posix.User.getGroupEntryForName: not supported"
-#endif
-
--- | @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 =
-    withMVar lock $ \_ -> bracket_ c_setgrent c_endgrent $ worker []
-    where worker accum =
-              do resetErrno
-                 ppw <- throwErrnoIfNullAndError "getAllGroupEntries" $
-                        c_getgrent
-                 if ppw == nullPtr
-                     then return (reverse accum)
-                     else do thisentry <- unpackGroupEntry ppw
-                             worker (thisentry : accum)
-
-foreign import ccall unsafe "getgrent"
-  c_getgrent :: IO (Ptr CGroup)
-foreign import ccall unsafe "setgrent"
-  c_setgrent :: IO ()
-foreign import ccall unsafe "endgrent"
-  c_endgrent :: IO ()
-#else
-getAllGroupEntries = error "System.Posix.User.getAllGroupEntries: not supported"
-#endif
-
-#if defined(HAVE_GETGRGID_R) || defined(HAVE_GETGRNAM_R)
-grBufSize :: Int
-#if defined(HAVE_SYSCONF) && defined(HAVE_SC_GETGR_R_SIZE_MAX)
-grBufSize = sysconfWithDefault 1024 (#const _SC_GETGR_R_SIZE_MAX)
-#else
-grBufSize = 1024
-#endif
-#endif
-
-unpackGroupEntry :: Ptr CGroup -> IO GroupEntry
-unpackGroupEntry ptr = do
-   name    <- (#peek struct group, gr_name) ptr >>= peekCAString
-   passwd  <- (#peek struct group, gr_passwd) ptr >>= peekCAString
-   gid     <- (#peek struct group, gr_gid) ptr
-   mem     <- (#peek struct group, gr_mem) ptr
-   members <- peekArray0 nullPtr mem >>= mapM peekCAString
-   return (GroupEntry name passwd gid members)
-
--- -----------------------------------------------------------------------------
--- The user database (pwd.h)
-
-data UserEntry =
- UserEntry {
-   userName      :: String,     -- ^ Textual name of this user (pw_name)
-   userPassword  :: String,     -- ^ Password -- may be empty or fake if shadow is in use (pw_passwd)
-   userID        :: UserID,     -- ^ Numeric ID for this user (pw_uid)
-   userGroupID   :: GroupID,    -- ^ Primary group ID (pw_gid)
-   userGecos     :: String,     -- ^ Usually the real name for the user (pw_gecos)
-   homeDirectory :: String,     -- ^ Home directory (pw_dir)
-   userShell     :: String      -- ^ Default shell (pw_shell)
- } deriving (Show, Read, Eq)
-
---
--- getpwuid and getpwnam leave results in a static object. Subsequent
--- calls modify the same object, which isn't threadsafe. We attempt to
--- mitigate this issue, on platforms that don't provide the safe _r versions
---
--- Also, getpwent/setpwent require a global lock since they maintain
--- an internal file position pointer.
-#if !defined(HAVE_GETPWNAM_R) || !defined(HAVE_GETPWUID_R) || defined(HAVE_GETPWENT) || defined(HAVE_GETGRENT)
-lock :: MVar ()
-lock = unsafePerformIO $ newMVar ()
-{-# NOINLINE lock #-}
-#endif
-
--- | @getUserEntryForID gid@ calls @getpwuid_r@ to obtain
---   the @UserEntry@ information associated with @UserID@
---   @uid@. This operation may fail with 'isDoesNotExistError'
---   if no such user exists.
-getUserEntryForID :: UserID -> IO UserEntry
-#ifdef HAVE_GETPWUID_R
-getUserEntryForID uid =
-  allocaBytes (#const sizeof(struct passwd)) $ \ppw ->
-    doubleAllocWhileERANGE "getUserEntryForID" "user" pwBufSize unpackUserEntry $
-      c_getpwuid_r uid ppw
-
-foreign import capi unsafe "HsUnix.h getpwuid_r"
-  c_getpwuid_r :: CUid -> Ptr CPasswd ->
-                        CString -> CSize -> Ptr (Ptr CPasswd) -> IO CInt
-#elif HAVE_GETPWUID
-getUserEntryForID uid = do
-  withMVar lock $ \_ -> do
-    ppw <- throwErrnoIfNull "getUserEntryForID" $ c_getpwuid uid
-    unpackUserEntry ppw
-
-foreign import ccall unsafe "getpwuid"
-  c_getpwuid :: CUid -> IO (Ptr CPasswd)
-#else
-getUserEntryForID = error "System.Posix.User.getUserEntryForID: not supported"
-#endif
-
--- | @getUserEntryForName name@ calls @getpwnam_r@ to obtain
---   the @UserEntry@ information associated with the user login
---   @name@. This operation may fail with 'isDoesNotExistError'
---   if no such user exists.
-getUserEntryForName :: String -> IO UserEntry
-#if HAVE_GETPWNAM_R
-getUserEntryForName name =
-  allocaBytes (#const sizeof(struct passwd)) $ \ppw ->
-    withCAString name $ \ pstr ->
-      doubleAllocWhileERANGE "getUserEntryForName" "user" pwBufSize unpackUserEntry $
-        c_getpwnam_r pstr ppw
-
-foreign import capi unsafe "HsUnix.h getpwnam_r"
-  c_getpwnam_r :: CString -> Ptr CPasswd
-               -> CString -> CSize -> Ptr (Ptr CPasswd) -> IO CInt
-#elif HAVE_GETPWNAM
-getUserEntryForName name = do
-  withCAString name $ \ pstr -> do
-    withMVar lock $ \_ -> do
-      ppw <- throwErrnoIfNull "getUserEntryForName" $ c_getpwnam pstr
-      unpackUserEntry ppw
-
-foreign import ccall unsafe "getpwnam"
-  c_getpwnam :: CString -> IO (Ptr CPasswd)
-#else
-getUserEntryForName = error "System.Posix.User.getUserEntryForName: not supported"
-#endif
-
--- | @getAllUserEntries@ returns all user entries on the system by
---   repeatedly calling @getpwent@
-getAllUserEntries :: IO [UserEntry]
-#ifdef HAVE_GETPWENT
-getAllUserEntries =
-    withMVar lock $ \_ -> bracket_ c_setpwent c_endpwent $ worker []
-    where worker accum =
-              do resetErrno
-                 ppw <- throwErrnoIfNullAndError "getAllUserEntries" $
-                        c_getpwent
-                 if ppw == nullPtr
-                     then return (reverse accum)
-                     else do thisentry <- unpackUserEntry ppw
-                             worker (thisentry : accum)
-
-foreign import capi unsafe "HsUnix.h getpwent"
-  c_getpwent :: IO (Ptr CPasswd)
-foreign import capi unsafe "HsUnix.h setpwent"
-  c_setpwent :: IO ()
-foreign import capi unsafe "HsUnix.h endpwent"
-  c_endpwent :: IO ()
-#else
-getAllUserEntries = error "System.Posix.User.getAllUserEntries: not supported"
-#endif
-
-#if defined(HAVE_GETPWUID_R) || defined(HAVE_GETPWNAM_R)
-pwBufSize :: Int
-#if  defined(HAVE_SYSCONF) && defined(HAVE_SC_GETPW_R_SIZE_MAX)
-pwBufSize = sysconfWithDefault 1024 (#const _SC_GETPW_R_SIZE_MAX)
-#else
-pwBufSize = 1024
-#endif
-#endif
-
-#ifdef HAVE_SYSCONF
-foreign import ccall unsafe "sysconf"
-  c_sysconf :: CInt -> IO CLong
-
--- We need a default value since sysconf can fail and return -1
--- even when the parameter name is defined in unistd.h.
--- One example of this is _SC_GETPW_R_SIZE_MAX under
--- Mac OS X 10.4.9 on i386.
-sysconfWithDefault :: Int -> CInt -> Int
-sysconfWithDefault def sc =
-    unsafePerformIO $ do v <- fmap fromIntegral $ c_sysconf sc
-                         return $ if v == (-1) then def else v
-#endif
-
--- The following function is used by the getgr*_r, c_getpw*_r
--- families of functions. These functions return their result
--- in a struct that contains strings and they need a buffer
--- that they can use to store those strings. We have to be
--- careful to unpack the struct containing the result before
--- the buffer is deallocated.
-doubleAllocWhileERANGE
-  :: String
-  -> String -- entry type: "user" or "group"
-  -> Int
-  -> (Ptr r -> IO a)
-  -> (Ptr b -> CSize -> Ptr (Ptr r) -> IO CInt)
-  -> IO a
-doubleAllocWhileERANGE loc enttype initlen unpack action =
-  alloca $ go initlen
- where
-  go len res = do
-    r <- allocaBytes len $ \buf -> do
-           rc <- action buf (fromIntegral len) res
-           if rc /= 0
-             then return (Left rc)
-             else do p <- peek res
-                     when (p == nullPtr) $ notFoundErr
-                     fmap Right (unpack p)
-    case r of
-      Right x -> return x
-      Left rc | Errno rc == eRANGE ->
-        -- ERANGE means this is not an error
-        -- we just have to try again with a larger buffer
-        go (2 * len) res
-      Left rc ->
-        ioError (errnoToIOError loc (Errno rc) Nothing Nothing)
-  notFoundErr =
-    ioError $ flip ioeSetErrorString ("no such " ++ enttype)
-            $ mkIOError doesNotExistErrorType loc Nothing Nothing
-
-unpackUserEntry :: Ptr CPasswd -> IO UserEntry
-unpackUserEntry ptr = do
-   name   <- (#peek struct passwd, pw_name)   ptr >>= peekCAString
-   passwd <- (#peek struct passwd, pw_passwd) ptr >>= peekCAString
-   uid    <- (#peek struct passwd, pw_uid)    ptr
-   gid    <- (#peek struct passwd, pw_gid)    ptr
-#ifdef HAVE_NO_PASSWD_PW_GECOS
-   gecos  <- return ""  -- pw_gecos does not exist on android
-#else
-   gecos  <- (#peek struct passwd, pw_gecos)  ptr >>= peekCAString
-#endif
-   dir    <- (#peek struct passwd, pw_dir)    ptr >>= peekCAString
-   shell  <- (#peek struct passwd, pw_shell)  ptr >>= peekCAString
-   return (UserEntry name passwd uid gid gecos dir shell)
-
--- Used when a function returns NULL to indicate either an error or
--- EOF, depending on whether the global errno is nonzero.
-throwErrnoIfNullAndError :: String -> IO (Ptr a) -> IO (Ptr a)
-throwErrnoIfNullAndError loc act = do
-    rc <- act
-    errno <- getErrno
-    if rc == nullPtr && errno /= eOK
-       then throwErrno loc
-       else return rc

unix/aclocal.m4

@@ -1,49 +0,0 @@
-# FP_COMPUTE_INT(EXPRESSION, VARIABLE, INCLUDES, IF-FAILS)
-# --------------------------------------------------------
-# Assign VARIABLE the value of the compile-time EXPRESSION using INCLUDES for
-# compilation. Execute IF-FAILS when unable to determine the value. Works for
-# cross-compilation, too.
-#
-# Implementation note: We are lazy and use an internal autoconf macro, but it
-# is supported in autoconf versions 2.50 up to the actual 2.57, so there is
-# little risk.
-AC_DEFUN([FP_COMPUTE_INT],
-[_AC_COMPUTE_INT([$1], [$2], [$3], [$4])[]dnl
-])# FP_COMPUTE_INT
-
-
-# FP_CHECK_CONST(EXPRESSION, [INCLUDES = DEFAULT-INCLUDES], [VALUE-IF-FAIL = -1])
-# -------------------------------------------------------------------------------
-# Defines CONST_EXPRESSION to the value of the compile-time EXPRESSION, using
-# INCLUDES. If the value cannot be determined, use VALUE-IF-FAIL.
-AC_DEFUN([FP_CHECK_CONST],
-[AS_VAR_PUSHDEF([fp_Cache], [fp_cv_const_$1])[]dnl
-AC_CACHE_CHECK([value of $1], fp_Cache,
-[FP_COMPUTE_INT([$1], fp_check_const_result, [AC_INCLUDES_DEFAULT([$2])],
-                [fp_check_const_result=m4_default([$3], ['-1'])])
-AS_VAR_SET(fp_Cache, [$fp_check_const_result])])[]dnl
-AC_DEFINE_UNQUOTED(AS_TR_CPP([CONST_$1]), AS_VAR_GET(fp_Cache), [The value of $1.])[]dnl
-AS_VAR_POPDEF([fp_Cache])[]dnl
-])# FP_CHECK_CONST
-
-
-# FP_CHECK_CONSTS_TEMPLATE(EXPRESSION...)
-# ---------------------------------------
-# autoheader helper for FP_CHECK_CONSTS
-m4_define([FP_CHECK_CONSTS_TEMPLATE],
-[AC_FOREACH([fp_Const], [$1],
-  [AH_TEMPLATE(AS_TR_CPP(CONST_[]fp_Const),
-               [The value of ]fp_Const[.])])[]dnl
-])# FP_CHECK_CONSTS_TEMPLATE
-
-
-# FP_CHECK_CONSTS(EXPRESSION..., [INCLUDES = DEFAULT-INCLUDES], [VALUE-IF-FAIL = -1])
-# -----------------------------------------------------------------------------------
-# List version of FP_CHECK_CONST
-AC_DEFUN([FP_CHECK_CONSTS],
-[FP_CHECK_CONSTS_TEMPLATE([$1])dnl
-for fp_const_name in $1
-do
-FP_CHECK_CONST([$fp_const_name], [$2], [$3])
-done
-])# FP_CHECK_CONSTS

unix/cabal.haskell-ci

@@ -1,2 +0,0 @@
-ghc-head:      True
-unconstrained: False

unix/cabal.project

@@ -1 +0,0 @@
-packages: .

unix/cbits/HsUnix.c

@@ -1,116 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The University of Glasgow 2002
- *
- * Definitions for package `unix' which are visible in Haskell land.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "HsUnix.h"
-
-#ifdef HAVE_RTLDNEXT
-void *__hsunix_rtldNext (void) {return RTLD_NEXT;}
-#endif
-
-#ifdef HAVE_RTLDDEFAULT
-void *__hsunix_rtldDefault (void) {return RTLD_DEFAULT;}
-#endif
-
-#if HAVE_PTSNAME && (__GLASGOW_HASKELL__ < 800)
-// On Linux (and others), <stdlib.h> needs to be included while
-// `_XOPEN_SOURCE` is already defined. However, GHCs before GHC 8.0
-// didn't do that yet for CApiFFI, so we need this workaround here.
-
-char *__hsunix_ptsname(int fd)   { return ptsname(fd);  }
-int   __hsunix_grantpt(int fd)   { return grantpt(fd);  }
-int   __hsunix_unlockpt(int fd)  { return unlockpt(fd); }
-#endif
-
-// push a SVR4 STREAMS module; do nothing if STREAMS not available
-int __hsunix_push_module(int fd, const char *module)
-{
-#if defined(I_PUSH) && !defined(HAVE_DEV_PTC)
-    return ioctl(fd, I_PUSH, module);
-#else
-    return 0;
-#endif
-}
-
-/*
- * GNU glibc 2.23 and later deprecate `readdir_r` in favour of plain old
- * `readdir` which in some upcoming POSIX standard is going to required to be
- * re-entrant.
- * Eventually we want to drop `readder_r` all together, but want to be
- * compatible with older unixen which may not have a re-entrant `readdir`.
- * Solution is to make systems with *known* re-entrant `readir` use that and use
- * `readdir_r` whereever we have it and don't *know* that `readdir` is
- * re-entrant.
- */
-
-#if defined (__GLIBC__) && (__GLIBC__ >= 2) && (__GLIBC_MINOR__ >= 23)
-#define USE_READDIR_R 0
-#else
-#define USE_READDIR_R 1
-#endif
-
-/*
- * 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 && USE_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 && USE_READDIR_R
-  free(dEnt);
-#endif
-}

unix/cbits/execvpe.c

@@ -1,173 +0,0 @@
-/* -----------------------------------------------------------------------------
-   (c) The University of Glasgow 1995-2004
-
-   Our low-level exec() variant.
-
-   Note: __hsunix_execvpe() is very similiar to the function
-         execvpe(3) as provided by glibc 2.11 and later. However, if
-         execvpe(3) is available, we use that instead.
-
-   -------------------------------------------------------------------------- */
-
-#include "HsUnixConfig.h"
-
-#include <errno.h>
-#include <sys/types.h>
-#if HAVE_SYS_WAIT_H
-# include <sys/wait.h>
-#endif
-#include <unistd.h>
-#include <sys/time.h>
-#include <stdlib.h>
-#include <string.h>
-#include <errno.h>
-
-#include "execvpe.h"
-
-#if !defined(execvpe) && !HAVE_DECL_EXECVPE
-// On some archs such as AIX, the prototype may be missing
-int execvpe(const char *file, char *const argv[], char *const envp[]);
-#endif
-
-/*
- * We want the search semantics of execvp, but we want to provide our
- * own environment, like execve.  The following copyright applies to
- * this code, as it is a derivative of execvp:
- *-
- * Copyright (c) 1991 The Regents of the University of California.
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions
- * are met:
- * 1. Redistributions of source code must retain the above copyright
- *    notice, this list of conditions and the following disclaimer.
- * 2. 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.
- * 3. All advertising materials mentioning features or use of this software
- *    must display the following acknowledgement:
- *	This product includes software developed by the University of
- *	California, Berkeley and its contributors.
- * 4. Neither the 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 REGENTS AND 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 REGENTS OR 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.
- */
-
-int
-__hsunix_execvpe(const char *name, char *const argv[], char *const envp[])
-{
-#if HAVE_EXECVPE
-    return execvpe(name, argv, envp);
-#else
-    register int lp, ln;
-    register char *p;
-    int eacces=0, etxtbsy=0;
-    char *bp, *cur, *path, *buf = 0;
-
-    /* If it's an absolute or relative path name, it's easy. */
-    if (strchr(name, '/')) {
-	bp = (char *) name;
-	cur = path = buf = NULL;
-	goto retry;
-    }
-
-    /* Get the path we're searching. */
-    if (!(path = getenv("PATH"))) {
-# ifdef HAVE_CONFSTR
-        ln = confstr(_CS_PATH, NULL, 0);
-        if ((cur = path = malloc(ln + 1)) != NULL) {
-	    path[0] = ':';
-	    (void) confstr (_CS_PATH, path + 1, ln);
-	}
-# else
-        if ((cur = path = malloc(1 + 1)) != NULL) {
-	    path[0] = ':';
-	    path[1] = '\0';
-	}
-# endif
-    } else
-	cur = path = strdup(path);
-
-    if (path == NULL || (bp = buf = malloc(strlen(path)+strlen(name)+2)) == NULL)
-	goto done;
-
-    while (cur != NULL) {
-	p = cur;
-        if ((cur = strchr(cur, ':')) != NULL)
-	    *cur++ = '\0';
-
-	/*
-	 * It's a SHELL path -- double, leading and trailing colons mean the current
-	 * directory.
-	 */
-	if (!*p) {
-	    p = ".";
-	    lp = 1;
-	} else
-	    lp = strlen(p);
-	ln = strlen(name);
-
-	memcpy(buf, p, lp);
-	buf[lp] = '/';
-	memcpy(buf + lp + 1, name, ln);
-	buf[lp + ln + 1] = '\0';
-
-      retry:
-        (void) execve(bp, argv, envp);
-	switch (errno) {
-	case EACCES:
-	    eacces = 1;
-	    break;
-	case ENOTDIR:
-	case ENOENT:
-	    break;
-	case ENOEXEC:
-	    {
-		register size_t cnt;
-		register char **ap;
-
-		for (cnt = 0, ap = (char **) argv; *ap; ++ap, ++cnt)
-		    ;
-		if ((ap = malloc((cnt + 2) * sizeof(char *))) != NULL) {
-		    memcpy(ap + 2, argv + 1, cnt * sizeof(char *));
-
-		    ap[0] = "sh";
-		    ap[1] = bp;
-		    (void) execve("/bin/sh", ap, envp);
-		    free(ap);
-		}
-		goto done;
-	    }
-	case ETXTBSY:
-	    if (etxtbsy < 3)
-		(void) sleep(++etxtbsy);
-	    goto retry;
-	default:
-	    goto done;
-	}
-    }
-    if (eacces)
-	errno = EACCES;
-    else if (!errno)
-	errno = ENOENT;
-  done:
-    if (path)
-	free(path);
-    if (buf)
-	free(buf);
-    return (-1);
-#endif
-}

unix/changelog.md

@@ -1,150 +0,0 @@
-# Changelog for [`unix` package](http://hackage.haskell.org/package/unix)
-
-## 2.8.0.0 *UNRELEASED*
-
-  * Added terminal output flags to `System.Posix.Terminal.Common.TerminalMode`
-
-        IXANY, ONLCR, OCRNL, ONOCR, ONLRET, OFDEL, OFILL, NLDLY(NL0,NL1),
-        CRDLY(CR0,CR1,CR2,CR2), TABDLY(TAB0,TAB1,TAB2,TAB3) BSDLY(BS0,BS1),
-        VTDLY(VT0,VT1), FFDLY(FF0,FF1)
-
-  * Add support for `O_NOFOLLOW`, `O_CLOEXEC`, `O_DIRECTORY` and `O_SYNC`
-    (#6, #57)
-
-  * Refactor API of `openFd` removing `Maybe FileMode` argument,
-    which now must be passed as part of `OpenFileFlags`
-    (e.g. `defaultFileFlags { creat = Just mode }`)  (#58)
-
-  * Remove deprecated `execvpe(3)` legacy-emulation CPP macro
-
-  * Generalise return type of `exitImmediately` from `ExitCode -> IO ()` to
-    `∀a. ExitCode -> IO a` (#130)
-    
-  * Add `Read`, `Show`, `Eq`, and `Ord` typeclass instances to `OpenFileFlags` and `OpenMode`. (#75, #141)
-
-## 2.7.2.2  *May 2017*
-
-  * Bundled with GHC 8.2.1
-
-  * Improve Autoconf detection of `telldir`/`seekdir` and define
-    `_POSIX_VDISABLE` if missing for Android (#91,#90)
-
-  * Fix error message of `createSymbolicLink` (#84)
-
-## 2.7.2.1  *Nov 2016*
-
-  * Bundled with GHC 8.0.2
-
-  * Don't use `readdir_r` if its deprecated.
-
-  * Add argument documentation for Env modules
-
-## 2.7.2.0  *Apr 2016*
-
-  * Bundled with GHC 8.0.1
-
-  * Don't assume non-POSIX `WCOREDUMP(x)` macro exists
-
-  * Don't assume existence of `termios(3)` constants beyond `B38400`
-
-  * Don't assume existence of `ctermid(3)`/`tcdrain(3)`
-
-  * Change `drainOutput`'s `tcdrain(3)` into a `safe` FFI call
-
-  * Turn build error into compile warnings for exotic `struct stat`
-    configurations (GHC #8859)
-
-  * Improve detection of `fdatasync(2)` (GHC #11137)
-
-  * Drop support for Hugs
-
-  * Drop support for Cygwin (and Windows in general)
-
-## 2.7.1.0  *Dec 2014*
-
-  * Bundled with GHC 7.10.1
-
-  * Add support for `base-4.8.0.0`
-
-  * Tighten `SafeHaskell` bounds for GHC 7.10+
-
-  * Add haddock comments on `RTLD_NEXT` and `RTLD_DEFAULT`
-
-  * Deprecate function `haveRtldLocal`
-
-  * Fix `getGroupEntryForID/getGroupEntryForName` on Solaris. Solaris uses
-    CPP macros for required `getgrgid_r` and `getgrnam_r` functions definition
-    so the fix is to change from C ABI calling convention to C API calling
-    convention
-
-  * Fix potential type-mismatch in `telldir`/`seekdir` FFI imports
-
-  * Use CAPI FFI import for `truncate` to make sure the LFS-version is used.
-
-  * `executeFile`: Fix `ENOTDIR` error for entries with non-directory
-    components in `PATH` (and instead skip over non-directory `PATH`-elements)
-
-  * New functions in `System.Posix.Unistd`:
-     - `fileSynchronise` (aka `fsync(2)`), and
-     - `fileSynchroniseDataOnly` (aka `fdatasync(2)`)
-
-  * New module `System.Posix.Fcntl` providing
-     - `fileAdvise` (aka `posix_fadvise(2)`), and
-     - `fileAllocate` (aka `posix_fallocate(2)`)
-
-  * Fix SIGINFO and SIGWINCH definitions
-
-## 2.7.0.1  *Mar 2014*
-
-  * Bundled with GHC 7.8.1
-
-  * Handle `EROFS` and `ETXTBSY` as (non-exceptional) permission denied in
-    `fileAccess`
-
-  * Fix `getFileStatus` to retry `stat(2)` when it returns `EAGAIN`
-    (this can happen on Solaris)
-
-## 2.7.0.0  *Nov 2013*
-
-  * New `forkProcessWithUnmask` function in the style of `forkIOWithUnmask`
-
-  * Change `forkProcess` to inherit the exception masking state of its caller
-
-  * Add new `Bool` flag to `ProcessStatus(Terminated)` constructor
-    indicating whether a core dump occured
-
-  * New functions in `System.Posix.Files{,.ByteString}` for operating
-    on high resolution file timestamps:
-
-        setFdTimesHiRes :: Fd -> POSIXTime -> POSIXTime -> IO ()
-        setFileTimesHiRes :: FilePath -> POSIXTime -> POSIXTime -> IO ()
-        setSymbolicLinkTimesHiRes :: FilePath -> POSIXTime -> POSIXTime -> IO ()
-        touchFd :: Fd -> IO ()
-        touchSymbolicLink :: FilePath -> IO ()
-
-  * Export `SignalInfo(..)` and `SignalSpecificInfo(..)` as well as
-    the two `Handler` constructors `CatchInfo` and `CatchInfoOnce`
-    from `System.Posix.Signals`
-
-  * Don't export `seekDirStream` and `tellDirStream` if the underlying
-    `seekdir(3)`/`telldir(3)` system calls are not available (as on Android)
-
-  * Fix library detection of `shm*` on openSUSE (#8350)
-
-  * Minor documentation fixes/updates
-
-  * Update package to `cabal-version >= 1.10` format
-
-## 2.6.0.1  *Jan 2013*
-
-  * Bundled with GHC 7.6.2
-  * Fix memory corruption issue in `putEnv`
-  * Use `pthread_kill(3)` instead of `raise(2)` on OS X too
-
-## 2.6.0.0  *Sep 2012*
-
-  * Bundled with GHC 7.6.1
-  * New functions `mkdtemp` and `mkstemps` in `System.Posix.Temp`
-  * New functions `setEnvironment` and `cleanEnv`
-  * New functions `accessTimeHiRes`, `modificationTimeHiRes`, and
-    `statusChangeTimeHiRes` for accessing high resolution timestamps

unix/configure.ac

@@ -1,240 +0,0 @@
-AC_PREREQ([2.60])
-AC_INIT([Haskell unix package], [2.0], [libraries@haskell.org], [unix])
-
-# Safety check: Ensure that we are in the correct source directory.
-AC_CONFIG_SRCDIR([include/HsUnix.h])
-
-AC_PROG_CC
-
-dnl make extensions visible to allow feature-tests to detect them lateron
-AC_USE_SYSTEM_EXTENSIONS
-
-AC_CONFIG_HEADERS([include/HsUnixConfig.h])
-
-# Is this a Unix system?
-AC_CHECK_HEADER([dlfcn.h], [BUILD_PACKAGE_BOOL=True], [BUILD_PACKAGE_BOOL=False])
-AC_SUBST([BUILD_PACKAGE_BOOL])
-
-AC_C_CONST
-
-dnl ** Enable large file support.  NB. do this before testing the type of
-dnl    off_t, because it will affect the result of that test.
-dnl
-dnl WARNING: It's essential this check agrees with HsBaseConfig.h as otherwise
-dnl          the definitions of COff/coff_t don't line up
-AC_SYS_LARGEFILE
-
-AC_CHECK_HEADERS([dirent.h fcntl.h grp.h limits.h pwd.h signal.h string.h])
-AC_CHECK_HEADERS([sys/resource.h sys/stat.h sys/times.h sys/time.h])
-AC_CHECK_HEADERS([sys/utsname.h sys/wait.h])
-AC_CHECK_HEADERS([bsd/libutil.h libutil.h pty.h utmp.h])
-AC_CHECK_HEADERS([termios.h time.h unistd.h utime.h])
-
-AC_CHECK_FUNCS([getgrgid_r getgrnam_r getpwnam_r getpwuid_r getpwnam getpwuid])
-AC_CHECK_FUNCS([getpwent getgrent])
-AC_CHECK_FUNCS([lchown setenv sysconf unsetenv clearenv])
-AC_CHECK_FUNCS([nanosleep])
-AC_CHECK_FUNCS([ptsname])
-AC_CHECK_FUNCS([setitimer])
-AC_CHECK_FUNCS([readdir_r])
-
-dnl not available on android so check for it
-AC_CANONICAL_TARGET
-AS_CASE([$target_os],[*-android*],[],[AC_CHECK_FUNCS([telldir seekdir])])
-
-dnl When available, _NSGetEnviron() (defined in <crt_externs.h>) is
-dnl the preferred way to access environ(7)
-AC_CHECK_FUNCS([_NSGetEnviron])
-
-dnl This is e.g. available as a GNU extension in glibc 2.11+
-AC_CHECK_DECLS([execvpe])
-AC_CHECK_FUNCS([execvpe])
-
-AC_CHECK_MEMBERS([struct stat.st_atim])
-AC_CHECK_MEMBERS([struct stat.st_mtim])
-AC_CHECK_MEMBERS([struct stat.st_ctim])
-AC_CHECK_MEMBERS([struct stat.st_atimespec])
-AC_CHECK_MEMBERS([struct stat.st_mtimespec])
-AC_CHECK_MEMBERS([struct stat.st_ctimespec])
-AC_CHECK_MEMBERS([struct stat.st_atimensec])
-AC_CHECK_MEMBERS([struct stat.st_mtimensec])
-AC_CHECK_MEMBERS([struct stat.st_ctimensec])
-AC_CHECK_MEMBERS([struct stat.st_atime_n])
-AC_CHECK_MEMBERS([struct stat.st_mtime_n])
-AC_CHECK_MEMBERS([struct stat.st_ctime_n])
-AC_CHECK_MEMBERS([struct stat.st_uatime])
-AC_CHECK_MEMBERS([struct stat.st_umtime])
-AC_CHECK_MEMBERS([struct stat.st_uctime])
-
-AC_CHECK_MEMBER([struct passwd.pw_gecos], [], [AC_DEFINE([HAVE_NO_PASSWD_PW_GECOS],[],[Ignore the pw_gecos member of passwd where it does not exist])], [[#include <pwd.h>]])
-
-# Functions for changing file timestamps
-AC_CHECK_FUNCS([utimensat futimens])
-AC_CHECK_FUNCS([lutimes futimes])
-
-# Additional temp functions
-dnl androids bionic doesn't have mkstemps
-# We explicilty check for android, as the check AC_CHECK_FUNCS performs returns "yes" for mkstemps
-# when targetting android. See similar conditionals for seekdir and telldir.
-AS_CASE([$target_os],[*-android*],[AC_CHECK_FUNCS([mkdtemp])],[AC_CHECK_FUNCS([mkstemps mkdtemp])])
-
-# Functions for file synchronization and allocation control
-AC_CHECK_FUNCS([fsync])
-
-# On OSX linking against 'fdatasync' succeeds, but that doesn't pick
-# the expected the POSIX 'fdatasync' function.  So make sure that we
-# also have a function declaration in scope, in addition to being able
-# to link against 'fdatasync'.
-AC_CHECK_DECLS([fdatasync],[AC_CHECK_FUNCS([fdatasync])])
-
-
-AC_CHECK_FUNCS([posix_fadvise posix_fallocate])
-
-# Some termios(3) functions known to be missing sometimes (see also #55)
-AC_CHECK_DECLS([tcdrain],[AC_DEFINE([HAVE_TCDRAIN],[1],[Define to 1 if you have the `tcdrain' function.])],[],[AC_INCLUDES_DEFAULT
-#ifdef HAVE_TERMIOS_H
-#include <termios.h>
-#endif
-])
-
-AC_CHECK_DECLS([ctermid],[AC_DEFINE([HAVE_CTERMID],[1],[Define to 1 if you have the `ctermid' function.])],[],[AC_INCLUDES_DEFAULT
-#ifdef HAVE_TERMIOS_H
-#include <termios.h>
-#endif
-])
-
-# Avoid adding rt if absent or unneeded
-# shm_open needs -lrt on linux
-AC_SEARCH_LIBS(shm_open, rt, [AC_CHECK_FUNCS([shm_open shm_unlink])])
-AS_IF([test "x$ac_cv_search_shm_open" = x-lrt], [EXTRA_LIBS="$EXTRA_LIBS rt"])
-
-FP_CHECK_CONSTS([SIGABRT SIGALRM SIGBUS SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2 SIGPOLL SIGPROF SIGSYS SIGTRAP SIGURG SIGVTALRM SIGXCPU SIGXFSZ SIG_BLOCK SIG_SETMASK SIG_UNBLOCK SIGINFO SIGWINCH], [
-#if HAVE_SIGNAL_H
-#include <signal.h>
-#endif])
-
-AC_MSG_CHECKING([for _SC_GETGR_R_SIZE_MAX])
-AC_EGREP_CPP(we_have_that_sysconf_thing,
-[
-#include <unistd.h>
-#ifdef _SC_GETGR_R_SIZE_MAX
-we_have_that_sysconf_thing
-#endif
-],
-[AC_MSG_RESULT([yes])
-AC_DEFINE([HAVE_SC_GETGR_R_SIZE_MAX], [1], [Define to 1 if <unistd.h> defines _SC_GETGR_R_SIZE_MAX.])],
-[AC_MSG_RESULT([no])])
-
-AC_MSG_CHECKING([for _SC_GETPW_R_SIZE_MAX])
-AC_EGREP_CPP(we_have_that_sysconf_thing,
-[
-#include <unistd.h>
-#ifdef _SC_GETPW_R_SIZE_MAX
-we_have_that_sysconf_thing
-#endif
-],
-[AC_MSG_RESULT([yes])
-AC_DEFINE([HAVE_SC_GETPW_R_SIZE_MAX], [1], [Define to 1 if <unistd.h> defines _SC_GETPW_R_SIZE_MAX.])],
-[AC_MSG_RESULT([no])])
-
-dnl ---------- usleep ----------
-dnl --- stolen from guile configure ---
-
-### 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], fptools_cv_func_usleep_return_type,
-  [AC_EGREP_HEADER(changequote(<, >)<void[      ]+usleep>changequote([, ]),
-                   unistd.h,
-                   [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.])
-  ;;
-esac
-
-###  POSIX.1003.1 unsetenv returns 0 or -1 (EINVAL), but older implementations
-###  in common use return void.
-AC_CACHE_CHECK([return type of unsetenv], fptools_cv_func_unsetenv_return_type,
-  [AC_EGREP_HEADER(changequote(<, >)<void[      ]+unsetenv>changequote([, ]),
-                   stdlib.h,
-                   [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.])
-  ;;
-esac
-
-dnl On some hosts (e.g. SuSe and Ubuntu Linux) RTLD_NEXT and RTLD_DEFAULT are
-dnl not visible without setting _GNU_SOURCE, which we really don't want to.
-dnl Also see comments in System/Posix/DynamicLinker/Prim.hsc.
-AC_MSG_CHECKING(for RTLD_NEXT from dlfcn.h)
-AC_EGREP_CPP(yes,
-[
- #include <dlfcn.h>
- #ifdef RTLD_NEXT
-        yes
- #endif
-], [
-  AC_MSG_RESULT(yes)
-  AC_DEFINE([HAVE_RTLDNEXT], [1], [Define to 1 if we can see RTLD_NEXT in dlfcn.h.])
-], [
-  AC_MSG_RESULT(no)
-  ])    
-
-AC_MSG_CHECKING(for RTLD_DEFAULT from dlfcn.h)
-AC_EGREP_CPP(yes,
-[
- #include <dlfcn.h>
- #ifdef RTLD_DEFAULT
-        yes
- #endif
-], [
-  AC_MSG_RESULT(yes)
-  AC_DEFINE([HAVE_RTLDDEFAULT], [1], [Define to 1 if RTLD_DEFAULT is available.])
-], [
-  AC_MSG_RESULT(no)
-  ])    
-
-AC_CHECK_FUNCS(openpty,,
-   AC_CHECK_LIB(util,openpty,
-     [AC_DEFINE(HAVE_OPENPTY) EXTRA_LIBS="$EXTRA_LIBS util"],
-     AC_CHECK_LIB(bsd,openpty, [AC_DEFINE(HAVE_OPENPTY) EXTRA_LIBS="$EXTRA_LIBS bsd"])
-   )
-)
-
-AC_MSG_CHECKING(for /dev/ptmx)
-if test -r /dev/ptmx
-then
-  AC_MSG_RESULT(yes)
-  AC_DEFINE(HAVE_DEV_PTMX, 1,
-  [Define if we have /dev/ptmx.])
-else
-  AC_MSG_RESULT(no)
-fi
-
-AC_MSG_CHECKING(for /dev/ptc)
-if test -r /dev/ptc
-then
-  AC_MSG_RESULT(yes)
-  AC_DEFINE(HAVE_DEV_PTC, 1,
-  [Define if we have /dev/ptc.])
-else
-  AC_MSG_RESULT(no)
-fi
-
-# Avoid adding dl if absent or unneeded
-AC_SEARCH_LIBS([dlopen], [dl], [EXTRA_LIBS="$EXTRA_LIBS $ac_lib"])
-
-# -{l,}pthread goo
-AC_CANONICAL_TARGET
-
-AC_SEARCH_LIBS(sem_close, pthread,
-    [EXTRA_LIBS="$EXTRA_LIBS $ac_lib"],
-    [AC_MSG_NOTICE([Not found])])
-
-AC_SUBST([EXTRA_LIBS])
-AC_CONFIG_FILES([unix.buildinfo])
-
-AC_OUTPUT

unix/include/HsUnix.h

@@ -1,120 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The University of Glasgow 2002
- *
- * Definitions for package `unix' which are visible in Haskell land.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef HSUNIX_H
-#define HSUNIX_H
-
-#include "HsUnixConfig.h"
-#include "HsFFI.h"
-
-/* ultra-evil... */
-#undef PACKAGE_BUGREPORT
-#undef PACKAGE_NAME
-#undef PACKAGE_STRING
-#undef PACKAGE_TARNAME
-#undef PACKAGE_VERSION
-
-#include <stdlib.h>
-#include <stdio.h>
-
-#ifdef HAVE_STRING_H
-#include <string.h>
-#endif
-#ifdef HAVE_SYS_TIMES_H
-#include <sys/times.h>
-#endif
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#endif
-#ifdef HAVE_SYS_RESOURCE_H
-#include <sys/resource.h>
-#endif
-#ifdef HAVE_SYS_WAIT_H
-#include <sys/wait.h>
-#endif
-#ifdef HAVE_SYS_STAT_H
-#include <sys/stat.h>
-#endif
-#ifdef HAVE_TIME_H
-#include <time.h>
-#endif
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-#ifdef HAVE_UTIME_H
-#include <utime.h>
-#endif
-#ifdef HAVE_FCNTL_H
-#include <fcntl.h>
-#endif
-#ifdef HAVE_LIMITS_H
-#include <limits.h>
-#endif
-#ifdef HAVE_TERMIOS_H
-#include <termios.h>
-#endif
-#ifdef HAVE_SYS_UTSNAME_H
-#include <sys/utsname.h>
-#endif
-#ifdef HAVE_PWD_H
-#include <pwd.h>
-#endif
-#ifdef HAVE_GRP_H
-#include <grp.h>
-#endif
-#ifdef HAVE_DIRENT_H
-#include <dirent.h>
-#endif
-
-#if defined(HAVE_BSD_LIBUTIL_H)
-#include <bsd/libutil.h>
-#elif defined(HAVE_LIBUTIL_H)
-#include <libutil.h>
-#endif
-#ifdef HAVE_PTY_H
-#include <pty.h>
-#endif
-#ifdef HAVE_UTMP_H
-#include <utmp.h>
-#endif
-
-#include <dlfcn.h>
-
-#ifdef HAVE_SIGNAL_H
-#include <signal.h>
-#endif
-
-/* defined in rts/posix/Signals.c */
-extern HsInt nocldstop;
-
-/* defined in libc */
-extern char **environ;
-
-#ifdef HAVE_RTLDNEXT
-void *__hsunix_rtldNext (void);
-#endif
-
-#ifdef HAVE_RTLDDEFAULT
-void *__hsunix_rtldDefault (void);
-#endif
-
-/* O_SYNC doesn't exist on Mac OS X and (at least some versions of) FreeBSD,
-fall back to O_FSYNC, which should be the same */
-#ifndef O_SYNC
-# define O_SYNC O_FSYNC
-#endif
-
-// not part of POSIX, hence may not be always defined
-#ifndef WCOREDUMP
-# define WCOREDUMP(s) 0
-#endif
-
-// push a SVR4 STREAMS module; do nothing if STREAMS not available
-int __hsunix_push_module(int fd, const char *module);
-
-#endif

unix/include/execvpe.h

@@ -1,13 +0,0 @@
-/* ----------------------------------------------------------------------------
-   (c) The University of Glasgow 2004
-
-   Interface for code in cbits/execvpe.c
-   ------------------------------------------------------------------------- */
-
-#ifndef HSUNIX_EXECVPE_H
-#define HSUNIX_EXECVPE_H
-
-extern int
-__hsunix_execvpe(const char *name, char *const argv[], char *const envp[]);
-
-#endif

unix/install-sh

@@ -1,527 +0,0 @@
-#!/bin/sh
-# install - install a program, script, or datafile
-
-scriptversion=2011-11-20.07; # UTC
-
-# This originates from X11R5 (mit/util/scripts/install.sh), which was
-# later released in X11R6 (xc/config/util/install.sh) with the
-# following copyright and license.
-#
-# Copyright (C) 1994 X Consortium
-#
-# Permission is hereby granted, free of charge, to any person obtaining a copy
-# of this software and associated documentation files (the "Software"), to
-# deal in the Software without restriction, including without limitation the
-# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
-# sell copies of the Software, and to permit persons to whom the Software is
-# furnished to do so, subject to the following conditions:
-#
-# The above copyright notice and this permission notice shall be included in
-# all copies or substantial portions of the Software.
-#
-# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
-# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
-# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC-
-# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-#
-# Except as contained in this notice, the name of the X Consortium shall not
-# be used in advertising or otherwise to promote the sale, use or other deal-
-# ings in this Software without prior written authorization from the X Consor-
-# tium.
-#
-#
-# FSF changes to this file are in the public domain.
-#
-# Calling this script install-sh is preferred over install.sh, to prevent
-# 'make' implicit rules from creating a file called install from it
-# when there is no Makefile.
-#
-# This script is compatible with the BSD install script, but was written
-# from scratch.
-
-nl='
-'
-IFS=" ""	$nl"
-
-# set DOITPROG to echo to test this script
-
-# Don't use :- since 4.3BSD and earlier shells don't like it.
-doit=${DOITPROG-}
-if test -z "$doit"; then
-  doit_exec=exec
-else
-  doit_exec=$doit
-fi
-
-# Put in absolute file names if you don't have them in your path;
-# or use environment vars.
-
-chgrpprog=${CHGRPPROG-chgrp}
-chmodprog=${CHMODPROG-chmod}
-chownprog=${CHOWNPROG-chown}
-cmpprog=${CMPPROG-cmp}
-cpprog=${CPPROG-cp}
-mkdirprog=${MKDIRPROG-mkdir}
-mvprog=${MVPROG-mv}
-rmprog=${RMPROG-rm}
-stripprog=${STRIPPROG-strip}
-
-posix_glob='?'
-initialize_posix_glob='
-  test "$posix_glob" != "?" || {
-    if (set -f) 2>/dev/null; then
-      posix_glob=
-    else
-      posix_glob=:
-    fi
-  }
-'
-
-posix_mkdir=
-
-# Desired mode of installed file.
-mode=0755
-
-chgrpcmd=
-chmodcmd=$chmodprog
-chowncmd=
-mvcmd=$mvprog
-rmcmd="$rmprog -f"
-stripcmd=
-
-src=
-dst=
-dir_arg=
-dst_arg=
-
-copy_on_change=false
-no_target_directory=
-
-usage="\
-Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
-   or: $0 [OPTION]... SRCFILES... DIRECTORY
-   or: $0 [OPTION]... -t DIRECTORY SRCFILES...
-   or: $0 [OPTION]... -d DIRECTORIES...
-
-In the 1st form, copy SRCFILE to DSTFILE.
-In the 2nd and 3rd, copy all SRCFILES to DIRECTORY.
-In the 4th, create DIRECTORIES.
-
-Options:
-     --help     display this help and exit.
-     --version  display version info and exit.
-
-  -c            (ignored)
-  -C            install only if different (preserve the last data modification time)
-  -d            create directories instead of installing files.
-  -g GROUP      $chgrpprog installed files to GROUP.
-  -m MODE       $chmodprog installed files to MODE.
-  -o USER       $chownprog installed files to USER.
-  -s            $stripprog installed files.
-  -t DIRECTORY  install into DIRECTORY.
-  -T            report an error if DSTFILE is a directory.
-
-Environment variables override the default commands:
-  CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG
-  RMPROG STRIPPROG
-"
-
-while test $# -ne 0; do
-  case $1 in
-    -c) ;;
-
-    -C) copy_on_change=true;;
-
-    -d) dir_arg=true;;
-
-    -g) chgrpcmd="$chgrpprog $2"
-	shift;;
-
-    --help) echo "$usage"; exit $?;;
-
-    -m) mode=$2
-	case $mode in
-	  *' '* | *'	'* | *'
-'*	  | *'*'* | *'?'* | *'['*)
-	    echo "$0: invalid mode: $mode" >&2
-	    exit 1;;
-	esac
-	shift;;
-
-    -o) chowncmd="$chownprog $2"
-	shift;;
-
-    -s) stripcmd=$stripprog;;
-
-    -t) dst_arg=$2
-	# Protect names problematic for 'test' and other utilities.
-	case $dst_arg in
-	  -* | [=\(\)!]) dst_arg=./$dst_arg;;
-	esac
-	shift;;
-
-    -T) no_target_directory=true;;
-
-    --version) echo "$0 $scriptversion"; exit $?;;
-
-    --)	shift
-	break;;
-
-    -*)	echo "$0: invalid option: $1" >&2
-	exit 1;;
-
-    *)  break;;
-  esac
-  shift
-done
-
-if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then
-  # When -d is used, all remaining arguments are directories to create.
-  # When -t is used, the destination is already specified.
-  # Otherwise, the last argument is the destination.  Remove it from $@.
-  for arg
-  do
-    if test -n "$dst_arg"; then
-      # $@ is not empty: it contains at least $arg.
-      set fnord "$@" "$dst_arg"
-      shift # fnord
-    fi
-    shift # arg
-    dst_arg=$arg
-    # Protect names problematic for 'test' and other utilities.
-    case $dst_arg in
-      -* | [=\(\)!]) dst_arg=./$dst_arg;;
-    esac
-  done
-fi
-
-if test $# -eq 0; then
-  if test -z "$dir_arg"; then
-    echo "$0: no input file specified." >&2
-    exit 1
-  fi
-  # It's OK to call 'install-sh -d' without argument.
-  # This can happen when creating conditional directories.
-  exit 0
-fi
-
-if test -z "$dir_arg"; then
-  do_exit='(exit $ret); exit $ret'
-  trap "ret=129; $do_exit" 1
-  trap "ret=130; $do_exit" 2
-  trap "ret=141; $do_exit" 13
-  trap "ret=143; $do_exit" 15
-
-  # Set umask so as not to create temps with too-generous modes.
-  # However, 'strip' requires both read and write access to temps.
-  case $mode in
-    # Optimize common cases.
-    *644) cp_umask=133;;
-    *755) cp_umask=22;;
-
-    *[0-7])
-      if test -z "$stripcmd"; then
-	u_plus_rw=
-      else
-	u_plus_rw='% 200'
-      fi
-      cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
-    *)
-      if test -z "$stripcmd"; then
-	u_plus_rw=
-      else
-	u_plus_rw=,u+rw
-      fi
-      cp_umask=$mode$u_plus_rw;;
-  esac
-fi
-
-for src
-do
-  # Protect names problematic for 'test' and other utilities.
-  case $src in
-    -* | [=\(\)!]) src=./$src;;
-  esac
-
-  if test -n "$dir_arg"; then
-    dst=$src
-    dstdir=$dst
-    test -d "$dstdir"
-    dstdir_status=$?
-  else
-
-    # Waiting for this to be detected by the "$cpprog $src $dsttmp" command
-    # might cause directories to be created, which would be especially bad
-    # if $src (and thus $dsttmp) contains '*'.
-    if test ! -f "$src" && test ! -d "$src"; then
-      echo "$0: $src does not exist." >&2
-      exit 1
-    fi
-
-    if test -z "$dst_arg"; then
-      echo "$0: no destination specified." >&2
-      exit 1
-    fi
-    dst=$dst_arg
-
-    # If destination is a directory, append the input filename; won't work
-    # if double slashes aren't ignored.
-    if test -d "$dst"; then
-      if test -n "$no_target_directory"; then
-	echo "$0: $dst_arg: Is a directory" >&2
-	exit 1
-      fi
-      dstdir=$dst
-      dst=$dstdir/`basename "$src"`
-      dstdir_status=0
-    else
-      # Prefer dirname, but fall back on a substitute if dirname fails.
-      dstdir=`
-	(dirname "$dst") 2>/dev/null ||
-	expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
-	     X"$dst" : 'X\(//\)[^/]' \| \
-	     X"$dst" : 'X\(//\)$' \| \
-	     X"$dst" : 'X\(/\)' \| . 2>/dev/null ||
-	echo X"$dst" |
-	    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
-		   s//\1/
-		   q
-		 }
-		 /^X\(\/\/\)[^/].*/{
-		   s//\1/
-		   q
-		 }
-		 /^X\(\/\/\)$/{
-		   s//\1/
-		   q
-		 }
-		 /^X\(\/\).*/{
-		   s//\1/
-		   q
-		 }
-		 s/.*/./; q'
-      `
-
-      test -d "$dstdir"
-      dstdir_status=$?
-    fi
-  fi
-
-  obsolete_mkdir_used=false
-
-  if test $dstdir_status != 0; then
-    case $posix_mkdir in
-      '')
-	# Create intermediate dirs using mode 755 as modified by the umask.
-	# This is like FreeBSD 'install' as of 1997-10-28.
-	umask=`umask`
-	case $stripcmd.$umask in
-	  # Optimize common cases.
-	  *[2367][2367]) mkdir_umask=$umask;;
-	  .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;;
-
-	  *[0-7])
-	    mkdir_umask=`expr $umask + 22 \
-	      - $umask % 100 % 40 + $umask % 20 \
-	      - $umask % 10 % 4 + $umask % 2
-	    `;;
-	  *) mkdir_umask=$umask,go-w;;
-	esac
-
-	# With -d, create the new directory with the user-specified mode.
-	# Otherwise, rely on $mkdir_umask.
-	if test -n "$dir_arg"; then
-	  mkdir_mode=-m$mode
-	else
-	  mkdir_mode=
-	fi
-
-	posix_mkdir=false
-	case $umask in
-	  *[123567][0-7][0-7])
-	    # POSIX mkdir -p sets u+wx bits regardless of umask, which
-	    # is incompatible with FreeBSD 'install' when (umask & 300) != 0.
-	    ;;
-	  *)
-	    tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
-	    trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0
-
-	    if (umask $mkdir_umask &&
-		exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1
-	    then
-	      if test -z "$dir_arg" || {
-		   # Check for POSIX incompatibilities with -m.
-		   # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
-		   # other-writable bit of parent directory when it shouldn't.
-		   # FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
-		   ls_ld_tmpdir=`ls -ld "$tmpdir"`
-		   case $ls_ld_tmpdir in
-		     d????-?r-*) different_mode=700;;
-		     d????-?--*) different_mode=755;;
-		     *) false;;
-		   esac &&
-		   $mkdirprog -m$different_mode -p -- "$tmpdir" && {
-		     ls_ld_tmpdir_1=`ls -ld "$tmpdir"`
-		     test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
-		   }
-		 }
-	      then posix_mkdir=:
-	      fi
-	      rmdir "$tmpdir/d" "$tmpdir"
-	    else
-	      # Remove any dirs left behind by ancient mkdir implementations.
-	      rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null
-	    fi
-	    trap '' 0;;
-	esac;;
-    esac
-
-    if
-      $posix_mkdir && (
-	umask $mkdir_umask &&
-	$doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
-      )
-    then :
-    else
-
-      # The umask is ridiculous, or mkdir does not conform to POSIX,
-      # or it failed possibly due to a race condition.  Create the
-      # directory the slow way, step by step, checking for races as we go.
-
-      case $dstdir in
-	/*) prefix='/';;
-	[-=\(\)!]*) prefix='./';;
-	*)  prefix='';;
-      esac
-
-      eval "$initialize_posix_glob"
-
-      oIFS=$IFS
-      IFS=/
-      $posix_glob set -f
-      set fnord $dstdir
-      shift
-      $posix_glob set +f
-      IFS=$oIFS
-
-      prefixes=
-
-      for d
-      do
-	test X"$d" = X && continue
-
-	prefix=$prefix$d
-	if test -d "$prefix"; then
-	  prefixes=
-	else
-	  if $posix_mkdir; then
-	    (umask=$mkdir_umask &&
-	     $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
-	    # Don't fail if two instances are running concurrently.
-	    test -d "$prefix" || exit 1
-	  else
-	    case $prefix in
-	      *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;;
-	      *) qprefix=$prefix;;
-	    esac
-	    prefixes="$prefixes '$qprefix'"
-	  fi
-	fi
-	prefix=$prefix/
-      done
-
-      if test -n "$prefixes"; then
-	# Don't fail if two instances are running concurrently.
-	(umask $mkdir_umask &&
-	 eval "\$doit_exec \$mkdirprog $prefixes") ||
-	  test -d "$dstdir" || exit 1
-	obsolete_mkdir_used=true
-      fi
-    fi
-  fi
-
-  if test -n "$dir_arg"; then
-    { test -z "$chowncmd" || $doit $chowncmd "$dst"; } &&
-    { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } &&
-    { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false ||
-      test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1
-  else
-
-    # Make a couple of temp file names in the proper directory.
-    dsttmp=$dstdir/_inst.$$_
-    rmtmp=$dstdir/_rm.$$_
-
-    # Trap to clean up those temp files at exit.
-    trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
-
-    # Copy the file name to the temp name.
-    (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") &&
-
-    # and set any options; do chmod last to preserve setuid bits.
-    #
-    # If any of these fail, we abort the whole thing.  If we want to
-    # ignore errors from any of these, just make sure not to ignore
-    # errors from the above "$doit $cpprog $src $dsttmp" command.
-    #
-    { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } &&
-    { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } &&
-    { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } &&
-    { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } &&
-
-    # If -C, don't bother to copy if it wouldn't change the file.
-    if $copy_on_change &&
-       old=`LC_ALL=C ls -dlL "$dst"	2>/dev/null` &&
-       new=`LC_ALL=C ls -dlL "$dsttmp"	2>/dev/null` &&
-
-       eval "$initialize_posix_glob" &&
-       $posix_glob set -f &&
-       set X $old && old=:$2:$4:$5:$6 &&
-       set X $new && new=:$2:$4:$5:$6 &&
-       $posix_glob set +f &&
-
-       test "$old" = "$new" &&
-       $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1
-    then
-      rm -f "$dsttmp"
-    else
-      # Rename the file to the real destination.
-      $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null ||
-
-      # The rename failed, perhaps because mv can't rename something else
-      # to itself, or perhaps because mv is so ancient that it does not
-      # support -f.
-      {
-	# Now remove or move aside any old file at destination location.
-	# We try this two ways since rm can't unlink itself on some
-	# systems and the destination file might be busy for other
-	# reasons.  In this case, the final cleanup might fail but the new
-	# file should still install successfully.
-	{
-	  test ! -f "$dst" ||
-	  $doit $rmcmd -f "$dst" 2>/dev/null ||
-	  { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
-	    { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }
-	  } ||
-	  { echo "$0: cannot unlink or rename $dst" >&2
-	    (exit 1); exit 1
-	  }
-	} &&
-
-	# Now rename the file to the real destination.
-	$doit $mvcmd "$dsttmp" "$dst"
-      }
-    fi || exit 1
-
-    trap '' 0
-  fi
-done
-
-# Local variables:
-# eval: (add-hook 'write-file-hooks 'time-stamp)
-# time-stamp-start: "scriptversion="
-# time-stamp-format: "%:y-%02m-%02d.%02H"
-# time-stamp-time-zone: "UTC"
-# time-stamp-end: "; # UTC"
-# End:

unix/prologue.txt

@@ -1 +0,0 @@
-POSIX functionality.

unix/tests/.gitignore

@@ -1,42 +0,0 @@
-.hpc*/
-*.o
-*.hi
-*.comp.std*
-*.run.std*
-*.eventlog
-*.genscript
-*.exe
-*.interp.stderr
-*.interp.stdout
-
-# specific files
-/T1185
-/T3816
-/T8108
-/executeFile001
-/fdReadBuf001
-/fileStatus
-/fileStatusByteString
-/fileexist01
-/forkprocess01
-/getEnvironment01
-/getEnvironment02
-/getGroupEntryForName
-/getUserEntryForName
-/libposix/po003.out
-/libposix/posix002
-/libposix/posix003
-/libposix/posix004
-/libposix/posix005
-/libposix/posix006
-/libposix/posix009
-/libposix/posix010
-/libposix/posix014
-/processGroup001
-/processGroup002
-/queryfdoption01
-/resourceLimit
-/signals001
-/signals002
-/signals004
-/user001

unix/tests/Makefile

@@ -1,7 +0,0 @@
-# This Makefile runs the tests using GHC's testsuite framework.  It
-# assumes the package is part of a GHC build tree with the testsuite
-# installed in ../../../testsuite.
-
-TOP=../../../testsuite
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk

unix/tests/T1185.hs

@@ -1,24 +0,0 @@
-module Main where
-
-import Control.Concurrent
-import System.Posix
-import System.IO
-import System.Exit
-
-main =
-    do putStrLn "running..."
-       (stdinr, stdinw) <- createPipe
-       (stdoutr, stdoutw) <- createPipe
-       pid <- forkProcess $ do hw <- fdToHandle stdoutw
-                               hr <- fdToHandle stdinr
-                               closeFd stdinw
-                               hGetContents hr >>= hPutStr hw
-                               hClose hr
-                               hClose hw
-                               exitImmediately ExitSuccess
-       threadDelay 100000
-       closeFd stdoutw
-       closeFd stdinw
-       hr2 <- fdToHandle stdoutr
-       hGetContents hr2 >>= putStr
-       getProcessStatus True False pid >>= print

unix/tests/T1185.stdout

@@ -1,2 +0,0 @@
-running...
-Just (Exited ExitSuccess)

unix/tests/T3816.hs

@@ -1,4 +0,0 @@
-import System.Posix
-main = do
-  getAllGroupEntries >>= print . (>0) . length
-  getAllGroupEntries >>= print . (>0) . length

unix/tests/T3816.stdout

@@ -1,2 +0,0 @@
-True
-True

unix/tests/T8108.hs

@@ -1,8 +0,0 @@
-import Control.Monad
-import Control.Concurrent
-import System.Posix.User
-
-main = do
-    void $ forkIO $ forever $ getGroupEntryForID 0
-    void $ forkIO $ forever $ getGroupEntryForID 0
-    threadDelay (3*1000*1000)

unix/tests/all.T

@@ -1,74 +0,0 @@
-
-test('signals001',  normal, compile_and_run, ['-package unix -cpp'])
-test('signals002', [], compile_and_run, ['-package unix'])
-test('fileexist01', normal, compile_and_run, ['-package unix'])
-
-# test #4512
-test('forkprocess01', extra_ways(['threaded1_ls']), compile_and_run,
-     ['-package unix'])
-
-#
-# user001 may fail due to this bug in glibc:
-#   http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=466647
-#
-# Ticket #1487. The glibc implementation of getlogin, which is called by
-# getLoginName, requires that a terminal is connected to filedescriptor 0.
-# See: https://sourceware.org/git/?p=glibc.git;a=blob;f=sysdeps/unix/getlogin.c
-# Therefore we have to omit the 'ghci' way, because it relies on redirecting
-# stdin from file.
-#
-# But getLoginName also fails on GNU/Linux when using a terminal emulator
-# that doesn't write login records to /var/run/utmp. Running:
-#   $ logname
-# should print your login name. If it doesn't, the getLoginName test in user001
-# would fail, so we disabled that test.
-#
-test('user001', omit_ways(['ghci']), compile_and_run, ['-package unix'])
-test('resourceLimit', normal, compile_and_run, ['-package unix'])
-
-x86FreeBsdFail = when(platform('i386-unknown-freebsd'), expect_fail)
-
-test('queryfdoption01', [omit_ways(['ghci']), x86FreeBsdFail], compile_and_run,
-     ['-package unix'])
-test('getEnvironment01', x86FreeBsdFail, compile_and_run, ['-package unix'])
-test('getEnvironment02', x86FreeBsdFail, compile_and_run, ['-package unix'])
-test('getGroupEntryForName', [x86FreeBsdFail, exit_code(1)], compile_and_run,
-     ['-package unix'])
-test('getUserEntryForName', [x86FreeBsdFail, exit_code(1)], compile_and_run,
-     ['-package unix'])
-
-
-test('signals004', normal, compile_and_run, ['-package unix'])
-
-if ('threaded1' in config.run_ways):
-   only_threaded_ways = only_ways(['ghci','threaded1','threaded2'])
-else:
-   only_threaded_ways = skip
-
-test('fdReadBuf001', only_threaded_ways, compile_and_run, ['-package unix'])
-
-test('fileStatus',
-     extra_clean(['dir', 'regular', 'link-dir', 'link-regular']),
-     compile_and_run,
-     ['-package unix'])
-
-test('fileStatusByteString',
-     extra_clean(['dir', 'regular', 'link-dir', 'link-regular']),
-     compile_and_run,
-     ['-package unix'])
-
-
-test('T1185', normal, compile_and_run, ['-package unix'])
-
-# This test fails for me on x86/Linux with a "does not exist" error.
-# Running with strace shows it is trying to talk to winbindd (part of
-# Samba), so I think the failure has nothing to do with GHC.  Also it
-# works on a different machine that doesn't have Samba installed.
-#  --SDM 18/05/2010
-test('T3816', normal, compile_and_run, ['-package unix'])
-
-test('processGroup001', normal, compile_and_run, ['-package unix'])
-test('processGroup002', normal, compile_and_run, ['-package unix'])
-test('executeFile001', omit_ways(prof_ways + ['threaded2']), compile_and_run, ['-package unix'])
-
-test('T8108', normal, compile_and_run, ['-package unix'])

unix/tests/executeFile001.hs

@@ -1,6 +0,0 @@
-
-import System.Posix.Process
-
-main :: IO ()
-main = executeFile "echo" True ["arg1", "ar   g2"] Nothing
-

unix/tests/executeFile001.stdout

@@ -1 +0,0 @@
-arg1 ar   g2

unix/tests/fdReadBuf001.hs

@@ -1,27 +0,0 @@
-{-# LANGUAGE NoMonomorphismRestriction #-}
-import System.Posix
-import Control.Monad
-import Foreign
-import Control.Concurrent
-import Data.Char
-import System.Exit
-
-size  = 10000
-block = 512
-
-main = do
-  (rd,wr) <- createPipe
-  let bytes = take size (map (fromIntegral.ord) (cycle ['a'..'z']))
-  allocaBytes size $ \p -> do
-    pokeArray p bytes
-    forkIO $ do r <- fdWriteBuf wr p (fromIntegral size)
-                when (fromIntegral r /= size) $ error "fdWriteBuf failed"
-  allocaBytes block $ \p -> do
-    let loop text = do
-           r <- fdReadBuf rd p block
-           let (chunk,rest) = splitAt (fromIntegral r) text
-           chars <- peekArray (fromIntegral r) p
-           when (chars /= chunk) $ error $ "mismatch: expected="++show chunk++", found="++show chars
-           when (null rest) $ exitWith ExitSuccess
-           loop rest
-    loop bytes

unix/tests/fileStatus.hs

@@ -1,109 +0,0 @@
-
--- GHC trac #2969
-
-import System.Posix.Files
-import System.Posix.Directory
-import System.Posix.IO
-import Control.Exception as E
-import Control.Monad
-
-main = do
-  cleanup
-  fs <- testRegular
-  ds <- testDir
-  testSymlink fs ds
-  cleanup
-
-regular      = "regular"
-dir          = "dir"
-link_regular = "link-regular"
-link_dir     = "link-dir"
-
-testRegular = do
-  createFile regular ownerReadMode
-  (fs, _) <- getStatus regular
-  let expected = (False,False,False,True,False,False,False)
-      actual   = snd (statusElements fs)
-  when (actual /= expected) $
-    fail "unexpected file status bits for regular file"
-  return fs
-
-testDir = do
-  createDirectory dir ownerReadMode
-  (ds, _) <- getStatus dir
-  let expected = (False,False,False,False,True,False,False)
-      actual   = snd (statusElements ds)
-  when (actual /= expected) $
-    fail "unexpected file status bits for directory"
-  return ds
-
-testSymlink fs ds = do
-  createSymbolicLink regular link_regular
-  createSymbolicLink dir     link_dir
-  (fs', ls)  <- getStatus link_regular
-  (ds', lds) <- getStatus link_dir
-
-  let expected = (False,False,False,False,False,True,False)
-      actualF  = snd (statusElements ls)
-      actualD  = snd (statusElements lds)
-
-  when (actualF /= expected) $
-    fail "unexpected file status bits for symlink to regular file"
-
-  when (actualD /= expected) $
-    fail "unexpected file status bits for symlink to directory"
-
-  when (statusElements fs /= statusElements fs') $
-    fail "status for a file does not match when it's accessed via a symlink"
-
-  when (statusElements ds /= statusElements ds') $
-    fail "status for a directory does not match when it's accessed via a symlink"
-
-cleanup = do
-  ignoreIOExceptions $ removeDirectory dir
-  mapM_ (ignoreIOExceptions . removeLink)
-        [regular, link_regular, link_dir]
-
-ignoreIOExceptions io = io `E.catch`
-                        ((\_ -> return ()) :: IOException -> IO ())
-
-getStatus f = do
-  fs  <- getFileStatus f
-  ls  <- getSymbolicLinkStatus f
-
-  fd  <- openFd f ReadOnly defaultFileFlags
-  fs' <- getFdStatus fd
-
-  when (statusElements fs /= statusElements fs') $
-    fail "getFileStatus and getFdStatus give inconsistent results"
-
-  when (not (isSymbolicLink ls) && statusElements fs /= statusElements fs') $
-    fail $ "getFileStatus and getSymbolicLinkStatus give inconsistent results "
-        ++ "on a file that is not a symbolic link"
-
-  return (fs, ls)
-
--- Yay for 20-element tuples!
-statusElements fs = (,)
-  (deviceID fs
-  ,fileMode fs
-  ,linkCount fs
-  ,fileOwner fs
-  ,fileGroup fs
-  ,specialDeviceID fs
-  ,fileSize fs
-  ,accessTime fs
-  ,accessTimeHiRes fs
-  ,modificationTime fs
-  ,modificationTimeHiRes fs
-  ,statusChangeTime fs
-  ,statusChangeTimeHiRes fs
-  )
-  (isBlockDevice fs
-  ,isCharacterDevice fs
-  ,isNamedPipe fs
-  ,isRegularFile fs
-  ,isDirectory fs
-  ,isSymbolicLink fs
-  ,isSocket fs
-  )

unix/tests/fileStatusByteString.hs

@@ -1,108 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
--- GHC trac #2969
-
-import System.Posix.ByteString
-import Control.Exception as E
-import Control.Monad
-
-main = do
-  cleanup
-  fs <- testRegular
-  ds <- testDir
-  testSymlink fs ds
-  cleanup
-
-regular      = "regular2"
-dir          = "dir2"
-link_regular = "link-regular2"
-link_dir     = "link-dir2"
-
-testRegular = do
-  createFile regular ownerReadMode
-  (fs, _) <- getStatus regular
-  let expected = (False,False,False,True,False,False,False)
-      actual   = snd (statusElements fs)
-  when (actual /= expected) $
-    fail "unexpected file status bits for regular file"
-  return fs
-
-testDir = do
-  createDirectory dir ownerReadMode
-  (ds, _) <- getStatus dir
-  let expected = (False,False,False,False,True,False,False)
-      actual   = snd (statusElements ds)
-  when (actual /= expected) $
-    fail "unexpected file status bits for directory"
-  return ds
-
-testSymlink fs ds = do
-  createSymbolicLink regular link_regular
-  createSymbolicLink dir     link_dir
-  (fs', ls)  <- getStatus link_regular
-  (ds', lds) <- getStatus link_dir
-
-  let expected = (False,False,False,False,False,True,False)
-      actualF  = snd (statusElements ls)
-      actualD  = snd (statusElements lds)
-
-  when (actualF /= expected) $
-    fail "unexpected file status bits for symlink to regular file"
-
-  when (actualD /= expected) $
-    fail "unexpected file status bits for symlink to directory"
-
-  when (statusElements fs /= statusElements fs') $
-    fail "status for a file does not match when it's accessed via a symlink"
-
-  when (statusElements ds /= statusElements ds') $
-    fail "status for a directory does not match when it's accessed via a symlink"
-
-cleanup = do
-  ignoreIOExceptions $ removeDirectory dir
-  mapM_ (ignoreIOExceptions . removeLink)
-        [regular, link_regular, link_dir]
-
-ignoreIOExceptions io = io `E.catch`
-                        ((\_ -> return ()) :: IOException -> IO ())
-
-getStatus f = do
-  fs  <- getFileStatus f
-  ls  <- getSymbolicLinkStatus f
-
-  fd  <- openFd f ReadOnly defaultFileFlags
-  fs' <- getFdStatus fd
-
-  when (statusElements fs /= statusElements fs') $
-    fail "getFileStatus and getFdStatus give inconsistent results"
-
-  when (not (isSymbolicLink ls) && statusElements fs /= statusElements fs') $
-    fail $ "getFileStatus and getSymbolicLinkStatus give inconsistent results "
-        ++ "on a file that is not a symbolic link"
-
-  return (fs, ls)
-
--- Yay for 20-element tuples!
-statusElements fs = (,)
-  (deviceID fs
-  ,fileMode fs
-  ,linkCount fs
-  ,fileOwner fs
-  ,fileGroup fs
-  ,specialDeviceID fs
-  ,fileSize fs
-  ,accessTime fs
-  ,accessTimeHiRes fs
-  ,modificationTime fs
-  ,modificationTimeHiRes fs
-  ,statusChangeTime fs
-  ,statusChangeTimeHiRes fs
-  )
-  (isBlockDevice fs
-  ,isCharacterDevice fs
-  ,isNamedPipe fs
-  ,isRegularFile fs
-  ,isDirectory fs
-  ,isSymbolicLink fs
-  ,isSocket fs
-  )

unix/tests/fileexist01.hs

@@ -1,5 +0,0 @@
--- test System.Posix.fileExist
-import System.Posix
-main = do
-  fileExist "fileexist01.hs" >>= print
-  fileExist "does not exist" >>= print

unix/tests/fileexist01.stdout

@@ -1,2 +0,0 @@
-True
-False

unix/tests/forkprocess01.hs

@@ -1,9 +0,0 @@
--- Test that we can call exitFailure in a forked process, and have it
--- communicated properly to the parent.
-import System.Exit
-import System.Posix.Process
-main = do
-  p <- forkProcess $ exitWith (ExitFailure 72)
-  r <- getProcessStatus True False p
-  print r
-

unix/tests/forkprocess01.stdout

@@ -1 +0,0 @@
-Just (Exited (ExitFailure 72))

unix/tests/getEnvironment01.hs

@@ -1,8 +0,0 @@
-
--- test for trac #781 (GHCi on x86_64, cannot link to static data in
--- shared libs)
-
-import System.Posix.Env
-
-main = getEnvironment >>= (print . (0 <=) . length)
-

unix/tests/getEnvironment01.stdout

@@ -1 +0,0 @@
-True

unix/tests/getEnvironment02.hs

@@ -1,8 +0,0 @@
-
--- test for trac #781 (GHCi on x86_64, cannot link to static data in
--- shared libs)
-
-import System.Posix.Env.ByteString
-
-main = getEnvironment >>= (print . (0 <=) . length)
-

unix/tests/getEnvironment02.stdout

@@ -1 +0,0 @@
-True

unix/tests/getGroupEntryForName.hs

@@ -1,5 +0,0 @@
-
-import System.Posix.User
-
-main :: IO ()
-main = getGroupEntryForName "thisIsNotMeantToExist" >> return ()

unix/tests/getGroupEntryForName.stderr

@@ -1 +0,0 @@
-getGroupEntryForName: getGroupEntryForName: does not exist (no such group)

unix/tests/getUserEntryForName.hs

@@ -1,5 +0,0 @@
-
-import System.Posix.User
-
-main :: IO ()
-main = getUserEntryForName "thisIsNotMeantToExist" >> return ()

unix/tests/getUserEntryForName.stderr

@@ -1 +0,0 @@
-getUserEntryForName: getUserEntryForName: does not exist (no such user)

unix/tests/libposix/Makefile

@@ -1,7 +0,0 @@
-# This Makefile runs the tests using GHC's testsuite framework.  It
-# assumes the package is part of a GHC build tree with the testsuite
-# installed in ../../../testsuite.
-
-TOP=../../../../testsuite
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk

unix/tests/libposix/all.T

@@ -1,16 +0,0 @@
-test('posix002', [ reqlib('unix'), omit_ways(prof_ways), fragile_for(16550, ['threaded2']) ],
-                 compile_and_run, [''])
-
-# Skip on mingw32: assumes existence of 'pwd' and /tmp
-test('posix003', [when(opsys('mingw32'), skip), extra_clean(['po003.out'])],
-                 compile_and_run, [''])
-
-test('posix004', [ reqlib('unix') ], compile_and_run, [''])
-
-test('posix005', [reqlib('unix') ], compile_and_run, [''])
-
-test('posix006', reqlib('unix'), compile_and_run, [''])
-test('posix009', [ omit_ways(threaded_ways), reqlib('unix') ], compile_and_run, [''])
-test('posix010', reqlib('unix'), compile_and_run, [''])
-
-test('posix014', [ reqlib('unix') ], compile_and_run, [''])

unix/tests/libposix/posix002.hs

@@ -1,4 +0,0 @@
-import System.Posix.Process
-
-main =
-    executeFile "printenv" True [] (Just [("ONE","1"),("TWO","2")])

unix/tests/libposix/posix002.stdout

@@ -1,2 +0,0 @@
-ONE=1
-TWO=2

unix/tests/libposix/posix003.hs

@@ -1,17 +0,0 @@
-
-import Control.Monad
-import Data.Char
-import System.Exit
-import System.IO
-import System.Process
-
-main = do hw <- openFile "po003.out" WriteMode
-          ph <- runProcess "pwd" [] (Just "/dev") Nothing Nothing (Just hw) Nothing
-          ec <- waitForProcess ph
-          hClose hw
-          unless (ec == ExitSuccess) $ error "pwd failed"
-          hr <- openFile "po003.out" ReadMode
-          output <- hGetContents hr
-          putStrLn ("Got: " ++ show (filter (not . isSpace) output))
-          hClose hr
-

unix/tests/libposix/posix003.stdout

@@ -1 +0,0 @@
-Got: "/dev"

unix/tests/libposix/posix004.hs

@@ -1,48 +0,0 @@
-
-import System.Exit (ExitCode(..), exitWith)
-import System.Posix.Process
-import System.Posix.Signals
-
-main = do test1
-          test2
-          test3
-          test4
-          putStrLn "I'm happy."
-
-test1 = do
-    -- Force SIGFPE exceptions to not be ignored.  Under some
-    -- circumstances this test will be run with SIGFPE
-    -- ignored, see #7399
-    installHandler sigFPE Default Nothing
-    forkProcess $ raiseSignal floatingPointException
-    Just (pid, tc) <- getAnyProcessStatus True False
-    case tc of
-        Terminated sig _ | sig == floatingPointException -> return ()
-        _ -> error "unexpected termination cause"
-
-test2 = do
-    forkProcess $ exitImmediately (ExitFailure 42)
-    Just (pid, tc) <- getAnyProcessStatus True False
-    case tc of
-        Exited (ExitFailure 42) -> return ()
-        _ -> error "unexpected termination cause (2)"
-
-test3 = do
-    forkProcess $ exitImmediately ExitSuccess
-    Just (pid, tc) <- getAnyProcessStatus True False
-    case tc of
-        Exited ExitSuccess -> return ()
-        _ -> error "unexpected termination cause (3)"
-
-test4 = do
-    forkProcess $ raiseSignal softwareStop
-    Just (pid, tc) <- getAnyProcessStatus True True
-    case tc of
-        Stopped sig | sig == softwareStop -> do
-            signalProcess killProcess pid
-            Just (pid, tc) <- getAnyProcessStatus True True
-            case tc of
-                Terminated sig _ | sig == killProcess -> return ()
-                _ -> error "unexpected termination cause (5)"
-        _ -> error "unexpected termination cause (4)"
-

unix/tests/libposix/posix004.stdout

@@ -1 +0,0 @@
-I'm happy.

unix/tests/libposix/posix005.hs

@@ -1,24 +0,0 @@
-import Data.List (sort)
-import System.IO
-import System.Posix.Env
-
-printEnv :: IO ()
-printEnv = getEnvironment >>= print . sort
-
-main = do
-    hSetBuffering stdout NoBuffering
-    term <- getEnv "TERM"
-    maybe (return ()) putStrLn term
-    setEnvironment [("one","1"),("two","2")]
-    printEnv
-    setEnv "foo" "bar" True
-    printEnv
-    setEnv "foo" "baz" True
-    printEnv
-    setEnv "fu" "bar" True
-    printEnv
-    unsetEnv "foo"
-    printEnv
-    clearEnv
-    printEnv
-

unix/tests/libposix/posix005.stdout

@@ -1,7 +0,0 @@
-vt100
-[("one","1"),("two","2")]
-[("foo","bar"),("one","1"),("two","2")]
-[("foo","baz"),("one","1"),("two","2")]
-[("foo","baz"),("fu","bar"),("one","1"),("two","2")]
-[("fu","bar"),("one","1"),("two","2")]
-[]

unix/tests/libposix/posix006.hs

@@ -1,18 +0,0 @@
-
-import System.Posix.Time
-import System.Posix.Unistd
-import System.Posix.Signals
-
-main = do start <- epochTime
-          blockSignals reservedSignals -- see #4504
-          sleep 1
-          finish <- epochTime
-          let slept = finish - start
-          if slept >= 1 && slept <= 2
-              then putStrLn "OK"
-              else do putStr "Started: "
-                      print start
-                      putStr "Finished: "
-                      print finish
-                      putStr "Slept: "
-                      print slept

unix/tests/libposix/posix006.stdout

@@ -1 +0,0 @@
-OK

unix/tests/libposix/posix009.hs

@@ -1,15 +0,0 @@
-import System.Posix.Signals
-import System.Posix.Unistd
-
-main = do
-    putStrLn "Blocking real time alarms."
-    blockSignals (addSignal realTimeAlarm reservedSignals)
-    putStrLn "Scheduling an alarm in 2 seconds..."
-    scheduleAlarm 2
-    putStrLn "Sleeping 5 seconds."
-    sleep 5
-    putStrLn "Woken up"
-    ints <- getPendingSignals
-    putStrLn "Checking pending interrupts for RealTimeAlarm"
-    print (inSignalSet realTimeAlarm ints)
-

unix/tests/libposix/posix009.stdout

@@ -1,6 +0,0 @@
-Blocking real time alarms.
-Scheduling an alarm in 2 seconds...
-Sleeping 5 seconds.
-Woken up
-Checking pending interrupts for RealTimeAlarm
-True

unix/tests/libposix/posix010.hs

@@ -1,16 +0,0 @@
-import System.Posix
-
-main = do
-    root <- getUserEntryForName "root"
-    putStrLn (ue2String root)
-    root' <- getUserEntryForID (userID root)
-    putStrLn (ue2String root')
-    if homeDirectory root == homeDirectory root' &&
-       userShell     root == userShell     root'
-        then putStrLn "OK"
-        else putStrLn "Mismatch"
-
-ue2String ue = concat [name, ":", show uid, ":", show gid]
-    where name = userName ue
-          uid = userID ue
-          gid = userGroupID ue