[project @ 2002-09-06 14:34:15 by simonmar]

Partial rewrite of the POSIX library.

The main purpose of this sweep is to remove the last dependencies of
the compiler on hslibs.  When I've committed the associated compiler
changes, only the 'base' package will be required to bootstrap the
compiler.  Additionally to build GHCi, the 'readline' and 'unix'
packages will be required.

The new POSIX library lives mostly in libraries/unix, with a few bits
required for compiler bootstrapping in libraries/base.  The 'base'
package is mostly free of hsc2hs code to make bootstrapping from HC
files easier, but the 'unix' package will use hsc2hs liberally.

The old POSIX library continues to provide more-or-less the same
interface as before, although some of the types are more correct now
(previously lots of POSIX types were just mapped to Int).  The new
interface is largely the same as the old, except that some new
functionality from the latest POSIX spec has been added (eg. symbolic
links).

So far, the new POSIX library has signal support, directory/file
operations and lots of stuff from unistd.h.  The module names are:

  System.Posix
	The main dude, exports everything

  System.Posix.Types
	All the POSIX types, using the same naming scheme as
        Foreign.C.Types, Eg. CUid, COff, etc.  Many of these types
        were previously exported by GHC.Posix.

        Additionally exports the "nicer" names used by the old POSIX
	library for compatibility (eg. ProcessID == CPid, FileMode ==
	CMode, etc.)

	All reasonable instances are derived for these types.

  System.Posix.Signals
	Signal support, contains most of which was in PosixProcPrim before.
	The RTS interface to the signal handling support has been
	rationalised slightly.

  System.Posix.Directory
 	Directory support, most were in PosixFiles before.

  System.Posix.Files
	File operations, most were in PosixFiles before.

  System.Posix.Unistd
	(for want of a better name) Miscellaneous bits that mostly come
	from the unistd.h header file.  PosixProcEnv before.

The rest of the library should pan out like so:

  System.Posix.IO
  System.Posix.Error   (maybe)
  System.Posix.Process
  System.Posix.Terminal

(I've no doubt broken Win32 support, but I'm checking the build at the moment).

4 files changed, 898 insertions, 0 deletions

diff --git a/System/Posix.hs b/System/Posix.hs
new file mode 100644
index 0000000..9d4d244
--- /dev/null
+++ b/System/Posix.hs
@@ -0,0 +1,30 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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)
+--
+-- POSIX 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.Time,
+  -- module System.Posix.Proc,
+ ) where
+
+import System.Posix.Types
+import System.Posix.Signals
+import System.Posix.Directory
+import System.Posix.Files
+import System.Posix.Unistd
diff --git a/System/Posix/Directory.hsc b/System/Posix/Directory.hsc
new file mode 100644
index 0000000..a2a2ceb
--- /dev/null
+++ b/System/Posix/Directory.hsc
@@ -0,0 +1,133 @@
+{-# OPTIONS -fffi #-}
+-----------------------------------------------------------------------------
+-- |
+-- 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)
+--
+-- POSIX directory support
+--
+-----------------------------------------------------------------------------
+
+module System.Posix.Directory (
+   -- * Creating and removing directories
+   createDirectory, removeDirectory,
+
+   -- * Reading directories
+   DirStream,
+   openDirStream,
+   readDirStream,
+   rewindDirStream,   
+   closeDirStream,
+   DirStreamOffset,
+   tellDirStream,
+   seekDirStream,
+
+   -- * The working dirctory
+   getWorkingDirectory,
+   changeWorkingDirectory,
+   changeWorkingDirectoryFd,
+  ) where
+
+import System.Posix.Types
+
+import GHC.Posix
+import System.Directory hiding (createDirectory)
+import Foreign
+import Foreign.C
+
+createDirectory :: FilePath -> FileMode -> IO ()
+createDirectory name mode =
+  withCString name $ \s -> 
+    throwErrnoIfMinus1_ "createDirectory" (c_mkdir s mode)  
+
+foreign import ccall unsafe "mkdir"
+  c_mkdir :: CString -> CMode -> IO CInt
+
+newtype DirStream = DirStream (Ptr CDir)
+
+openDirStream :: FilePath -> IO DirStream
+openDirStream name =
+  withCString name $ \s -> do
+    dirp <- throwErrnoIfNull "openDirStream" $ c_opendir s
+    return (DirStream dirp)
+
+readDirStream :: DirStream -> IO FilePath
+readDirStream (DirStream dirp) =
+  alloca $ \ptr_dEnt  -> loop ptr_dEnt
+ where
+  loop ptr_dEnt = do
+    resetErrno
+    r <- readdir dirp ptr_dEnt
+    if (r == 0)
+	 then do dEnt <- peek ptr_dEnt
+		 if (dEnt == nullPtr)
+		    then return []
+		    else do
+	 	     entry <- (d_name dEnt >>= peekCString)
+		     freeDirEnt dEnt
+		     return entry
+	 else do errno <- getErrno
+		 if (errno == eINTR) then loop ptr_dEnt else do
+		 let (Errno eo) = errno
+		 if (eo == end_of_dir)
+		    then return []
+		    else throwErrno "readDirStream"
+
+foreign import ccall unsafe "__hscore_readdir"
+  readdir  :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
+
+foreign import ccall unsafe "__hscore_free_dirent"
+  freeDirEnt  :: Ptr CDirent -> IO ()
+
+foreign import ccall unsafe "__hscore_end_of_dir"
+  end_of_dir :: CInt
+
+foreign import ccall unsafe "__hscore_d_name"
+  d_name :: Ptr CDirent -> IO CString
+
+rewindDirStream :: DirStream -> IO ()
+rewindDirStream (DirStream dirp) = c_rewinddir dirp
+
+closeDirStream :: DirStream -> IO ()
+closeDirStream (DirStream dirp) = do
+  throwErrnoIfMinus1_ "closeDirStream" (c_closedir dirp)
+
+newtype DirStreamOffset = DirStreamOffset CLong
+
+seekDirStream :: DirStream -> DirStreamOffset -> IO ()
+seekDirStream (DirStream dirp) (DirStreamOffset off) =
+  c_seekdir dirp off
+
+foreign import ccall unsafe "seekdir"
+  c_seekdir :: Ptr CDir -> CLong -> IO ()
+
+tellDirStream :: DirStream -> IO DirStreamOffset
+tellDirStream (DirStream dirp) = do
+  off <- c_telldir dirp
+  return (DirStreamOffset off)
+
+foreign import ccall unsafe "telldir"
+  c_telldir :: Ptr CDir -> IO CLong
+
+{-
+ Renamings of functionality provided via Directory interface,
+ kept around for b.wards compatibility and for having more POSIXy
+ names
+-}
+getWorkingDirectory :: IO FilePath
+getWorkingDirectory = getCurrentDirectory
+
+changeWorkingDirectory :: FilePath -> IO ()
+changeWorkingDirectory name = setCurrentDirectory name
+
+changeWorkingDirectoryFd :: Fd -> IO ()
+changeWorkingDirectoryFd (Fd fd) = 
+  throwErrnoIfMinus1_ "changeWorkingDirectoryFd" (c_fchdir fd)
+
+foreign import ccall unsafe "fchdir"
+  c_fchdir :: CInt -> IO CInt
diff --git a/System/Posix/Files.hsc b/System/Posix/Files.hsc
new file mode 100644
index 0000000..9dc5555
--- /dev/null
+++ b/System/Posix/Files.hsc
@@ -0,0 +1,451 @@
+{-# OPTIONS -fffi #-}
+-----------------------------------------------------------------------------
+-- |
+-- 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)
+--
+-- POSIX file support
+--
+-----------------------------------------------------------------------------
+
+module System.Posix.Files (
+    -- * File modes
+    FileMode,
+    unionFileModes, intersectFileModes,
+    nullFileMode,
+    ownerReadMode, ownerWriteMode, ownerExecuteMode, ownerModes,
+    groupReadMode, groupWriteMode, groupExecuteMode, groupModes,
+    otherReadMode, otherWriteMode, otherExecuteMode, otherModes,
+    setUserIDMode, setGroupIDMode,
+    stdFileMode,   accessModes,
+
+    -- ** 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,
+    isBlockDevice, isCharacterDevice, isNamedPipe, isRegularFile,
+    isDirectory, isSymbolicLink, isSocket,
+
+    -- * Creation
+    createNamedPipe, 
+    createDevice,
+
+    -- * Hard links
+    createLink, removeLink,
+
+    -- * Renaming files
+    rename,
+
+    -- * Changing file ownership
+    setOwnerAndGroup,  setFdOwnerAndGroup, setSymbolicLinkOwnerAndGroup,
+
+    -- * Changing file timestamps
+    setFileTimes, touchFile,
+
+    -- * Standard file descriptors
+    stdInput, stdOutput, stdError,
+
+    -- * Opening and closing files
+    OpenMode(..),
+    OpenFileFlags(..), defaultFileFlags,
+    openFd, createFile,
+    closeFd,
+
+{-
+    -- run-time limit & POSIX feature testing
+    PathVar(..),
+    getPathVar,
+    getFileVar
+-}
+  ) where
+
+
+import System.Posix.Types
+import System.IO.Unsafe
+import Data.Bits
+import GHC.Posix
+import Foreign
+import Foreign.C
+
+#include <sys/stat.h>
+#include <unistd.h>
+#include <utime.h>
+#include <fcntl.h>
+
+-- -----------------------------------------------------------------------------
+-- POSIX file modes
+
+-- The abstract type 'FileMode', constants and operators for
+-- manipulating the file modes defined by POSIX.
+
+nullFileMode :: FileMode
+nullFileMode = 0
+
+ownerReadMode :: FileMode
+ownerReadMode = (#const S_IRUSR)
+
+ownerWriteMode :: FileMode
+ownerWriteMode = (#const S_IWUSR)
+
+ownerExecuteMode :: FileMode
+ownerExecuteMode = (#const S_IXUSR)
+
+groupReadMode :: FileMode
+groupReadMode = (#const S_IRGRP)
+
+groupWriteMode :: FileMode
+groupWriteMode = (#const S_IWGRP)
+
+groupExecuteMode :: FileMode
+groupExecuteMode = (#const S_IXGRP)
+
+otherReadMode :: FileMode
+otherReadMode = (#const S_IROTH)
+
+otherWriteMode :: FileMode
+otherWriteMode = (#const S_IWOTH)
+
+otherExecuteMode :: FileMode
+otherExecuteMode = (#const S_IXOTH)
+
+setUserIDMode :: FileMode
+setUserIDMode = (#const S_ISUID)
+
+setGroupIDMode :: FileMode
+setGroupIDMode = (#const S_ISGID)
+
+stdFileMode :: FileMode
+stdFileMode = ownerReadMode  .|. ownerWriteMode .|. 
+	      groupReadMode  .|. groupWriteMode .|. 
+	      otherReadMode  .|. otherWriteMode
+
+ownerModes :: FileMode
+ownerModes = (#const S_IRWXU)
+
+groupModes :: FileMode
+groupModes = (#const S_IRWXG)
+
+otherModes :: FileMode
+otherModes = (#const S_IRWXO)
+
+accessModes :: FileMode
+accessModes = ownerModes .|. groupModes .|. otherModes
+
+unionFileModes :: FileMode -> FileMode -> FileMode
+unionFileModes m1 m2 = m1 .|. m2
+
+intersectFileModes :: FileMode -> FileMode -> FileMode
+intersectFileModes m1 m2 = m1 .&. m2
+
+-- Not exported:
+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)
+
+setFileMode :: FilePath -> FileMode -> IO ()
+setFileMode name m =
+  withCString name $ \s -> do
+    throwErrnoIfMinus1_ "setFileMode" (c_chmod s m)
+
+setFdMode :: Fd -> FileMode -> IO ()
+setFdMode fd m =
+  throwErrnoIfMinus1_ "setFdMode" (c_fchmod fd m)
+
+foreign import ccall unsafe "fchmod" 
+  c_fchmod :: Fd -> CMode -> IO CInt
+
+setFileCreationMask :: FileMode -> IO FileMode
+setFileCreationMask mask = c_umask mask
+
+-- -----------------------------------------------------------------------------
+-- access()
+
+fileAccess :: FilePath -> Bool -> Bool -> Bool -> IO Bool
+fileAccess name read write exec = access name flags
+  where
+   flags   = read_f .|. write_f .|. exec_f
+   read_f  = if read  then (#const R_OK) else 0
+   write_f = if write then (#const W_OK) else 0
+   exec_f  = if exec  then (#const X_OK) else 0
+
+fileExist :: FilePath -> IO Bool
+fileExist name = access name (#const F_OK)
+
+access :: FilePath -> CMode -> IO Bool
+access name flags = 
+  withCString name $ \s -> do
+    r <- c_access s flags
+    if (r == 0)
+	then return True
+	else do err <- getErrno
+	        if (err == eACCES)
+		   then return False
+		   else throwErrno "fileAccess"
+
+-- -----------------------------------------------------------------------------
+-- stat() support
+
+newtype FileStatus = FileStatus (ForeignPtr CStat)
+
+deviceID         :: FileStatus -> DeviceID
+fileID           :: FileStatus -> FileID
+fileMode         :: FileStatus -> FileMode
+linkCount        :: FileStatus -> LinkCount
+fileOwner        :: FileStatus -> UserID
+fileGroup        :: FileStatus -> GroupID
+specialDeviceID  :: FileStatus -> DeviceID
+fileSize         :: FileStatus -> FileOffset
+accessTime       :: FileStatus -> EpochTime
+modificationTime :: FileStatus -> EpochTime
+statusChangeTime :: FileStatus -> EpochTime
+
+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)
+
+isBlockDevice     :: FileStatus -> Bool
+isCharacterDevice :: FileStatus -> Bool
+isNamedPipe       :: FileStatus -> Bool
+isRegularFile     :: FileStatus -> Bool
+isDirectory       :: FileStatus -> Bool
+isSymbolicLink    :: FileStatus -> Bool
+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
+
+getFileStatus :: FilePath -> IO FileStatus
+getFileStatus path = do
+  fp <- mallocForeignPtrBytes (#const sizeof(struct stat)) 
+  withForeignPtr fp $ \p ->
+    withCString path $ \s -> 
+      throwErrnoIfMinus1_ "getFileStatus" (c_stat s p)
+  return (FileStatus fp)
+
+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)
+
+getSymbolicLinkStatus :: FilePath -> IO FileStatus
+getSymbolicLinkStatus path = do
+  fp <- mallocForeignPtrBytes (#const sizeof(struct stat)) 
+  withForeignPtr fp $ \p ->
+    withCString path $ \s -> 
+      throwErrnoIfMinus1_ "getSymbolicLinkStatus" (c_lstat s p)
+  return (FileStatus fp)
+
+foreign import ccall unsafe "lstat" 
+  c_lstat :: CString -> Ptr CStat -> IO CInt
+
+createNamedPipe :: FilePath -> FileMode -> IO ()
+createNamedPipe name mode = do
+  withCString name $ \s -> 
+    throwErrnoIfMinus1_ "createNamedPipe" (c_mkfifo s mode)
+
+createDevice :: FilePath -> FileMode -> DeviceID -> IO ()
+createDevice path mode dev =
+  withCString path $ \s ->
+    throwErrnoIfMinus1_ "createDevice" (c_mknod s mode dev)
+
+foreign import ccall unsafe "mknod" 
+  c_mknod :: CString -> CMode -> CDev -> IO CInt
+
+-- -----------------------------------------------------------------------------
+-- Hard links
+
+createLink :: FilePath -> FilePath -> IO ()
+createLink name1 name2 =
+  withCString name1 $ \s1 ->
+  withCString name2 $ \s2 ->
+  throwErrnoIfMinus1_ "createLink" (c_link s1 s2)
+
+removeLink :: FilePath -> IO ()
+removeLink name =
+  withCString name $ \s ->
+  throwErrnoIfMinus1_ "removeLink" (c_unlink s)
+
+-- -----------------------------------------------------------------------------
+-- Renaming files
+
+rename :: FilePath -> FilePath -> IO ()
+rename name1 name2 =
+  withCString name1 $ \s1 ->
+  withCString name2 $ \s2 ->
+  throwErrnoIfMinus1_ "rename" (c_rename s1 s2)
+
+-- -----------------------------------------------------------------------------
+-- chmod()
+
+setOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()
+setOwnerAndGroup name uid gid = do
+  withCString name $ \s ->
+    throwErrnoIfMinus1_ "setOwnerAndGroup" (c_chown s uid gid)
+
+foreign import ccall unsafe "chown"
+  c_chown :: CString -> CUid -> CGid -> IO CInt
+
+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
+
+setSymbolicLinkOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()
+setSymbolicLinkOwnerAndGroup name uid gid = do
+  withCString name $ \s ->
+    throwErrnoIfMinus1_ "setSymbolicLinkOwnerAndGroup" (c_lchown s uid gid)
+
+foreign import ccall unsafe "lchown"
+  c_lchown :: CString -> CUid -> CGid -> IO CInt
+
+-- -----------------------------------------------------------------------------
+-- utime()
+
+setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO ()
+setFileTimes name atime mtime = do
+  withCString name $ \s ->
+   allocaBytes (#const sizeof(struct utimbuf)) $ \p -> do
+     (#poke struct utimbuf, actime)  p atime
+     (#poke struct utimbuf, modtime) p mtime
+     throwErrnoIfMinus1_ "setFileTimes" (c_utime s p)
+
+touchFile :: FilePath -> IO ()
+touchFile name = do
+  withCString name $ \s ->
+   throwErrnoIfMinus1_ "touchFile" (c_utime s nullPtr)
+
+-- -----------------------------------------------------------------------------
+-- opening 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
+
+data OpenFileFlags =
+ OpenFileFlags {
+    append    :: Bool,
+    exclusive :: Bool,
+    noctty    :: Bool,
+    nonBlock  :: Bool,
+    trunc     :: Bool
+ }
+
+defaultFileFlags :: OpenFileFlags
+defaultFileFlags =
+ OpenFileFlags {
+    append    = False,
+    exclusive = False,
+    noctty    = False,
+    nonBlock  = False,
+    trunc     = False
+  }
+
+openFd :: FilePath
+       -> OpenMode
+       -> Maybe FileMode -- Just x => O_CREAT, Nothing => must exist
+       -> OpenFileFlags
+       -> IO Fd
+openFd name how maybe_mode (OpenFileFlags append exclusive noctty
+				nonBlock truncate) = do
+   withCString name $ \s -> do
+    fd <- throwErrnoIfMinus1 "openFd" (c_open s all_flags mode_w)
+    return (Fd fd)
+  where
+    all_flags  = creat .|. flags .|. open_mode
+
+    flags =
+       (if append    then (#const O_APPEND)   else 0) .|.
+       (if exclusive then (#const O_EXCL)     else 0) .|.
+       (if noctty    then (#const O_NOCTTY)   else 0) .|.
+       (if nonBlock  then (#const O_NONBLOCK) else 0) .|.
+       (if truncate  then (#const O_TRUNC)    else 0)
+
+    (creat, mode_w) = case maybe_mode 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)
+
+
+createFile :: FilePath -> FileMode -> IO Fd
+createFile name mode
+  = openFd name WriteOnly (Just mode) defaultFileFlags{ trunc=True } 
+
+closeFd :: Fd -> IO ()
+closeFd (Fd fd) = throwErrnoIfMinus1_ "closeFd" (c_close fd)
diff --git a/System/Posix/Unistd.hsc b/System/Posix/Unistd.hsc
new file mode 100644
index 0000000..a7fae7e
--- /dev/null
+++ b/System/Posix/Unistd.hsc
@@ -0,0 +1,284 @@
+{-# OPTIONS -fffi #-}
+-----------------------------------------------------------------------------
+-- |
+-- 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 (
+    -- * User environment
+    -- * Querying user environment
+    getRealUserID,
+    getRealGroupID,
+    getEffectiveUserID,
+    getEffectiveGroupID,
+#if !defined(cygwin32_TARGET_OS)
+    getGroups,
+#endif
+    getLoginName,
+
+    -- * Modifying the user environment
+    setUserID,
+    setGroupID,
+
+    -- * Process environment
+    -- ** Querying the process environment
+    getProcessID,
+    getParentProcessID,
+    getProcessGroupID,
+
+    -- ** Process groups
+    createProcessGroup,
+    joinProcessGroup,
+    setProcessGroupID,
+
+    -- ** Sessions
+    createSession,
+
+    -- ** Process times
+    ProcessTimes(elapsedTime, systemTime, userTime,
+		 childSystemTime, childUserTime),
+    getProcessTimes,
+	
+    -- * System environment
+    SystemID(..),
+    getSystemID,
+
+  {-
+    ToDo from unistd.h:
+      confstr
+      dup, dup2, exec*, exit,  fork, fpathconf, fsync, ftruncate,
+      gethostid, gethostname, getlogin, getopt, isatty, lockf,
+      lseek, nice, pathconf, pipe, pread, pwrite, read, readlink,
+      sleep, symlink, sysconf, tcgetpgrp, tcsetpgrp, truncate,
+      ttyname(_r), ualarm, usleep, vfork, write
+
+    SysVar(..),
+    getSysVar,
+
+    -- should be in System.Posix.Files?
+    queryTerminal,
+    getTerminalName,
+#if !defined(cygwin32_TARGET_OS)
+    getControllingTerminalName,
+#endif
+
+    -- should be in System.Posix.Time?
+    epochTime,
+
+    -- should be in System.Posix.Pwd?
+    getEffectiveUserName,
+-}
+  ) where
+
+import Foreign
+import Foreign.C
+import System.Posix.Types
+import GHC.Posix
+
+#include <unistd.h>
+#include <sys/times.h>
+#include <sys/utsname.h>
+
+-- -----------------------------------------------------------------------------
+-- user environemnt
+
+getRealUserID :: IO UserID
+getRealUserID = c_getuid
+
+foreign import ccall unsafe "getuid"
+  c_getuid :: IO CUid
+
+getRealGroupID :: IO GroupID
+getRealGroupID = c_getgid
+
+foreign import ccall unsafe "getgid"
+  c_getgid :: IO CGid
+
+getEffectiveUserID :: IO UserID
+getEffectiveUserID = c_geteuid
+
+foreign import ccall unsafe "geteuid"
+  c_geteuid :: IO CUid
+
+getEffectiveGroupID :: IO GroupID
+getEffectiveGroupID = c_getegid
+
+foreign import ccall unsafe "getegid"
+  c_getegid :: IO CGid
+
+-- getgroups() is not supported in beta18 of
+-- cygwin32
+#if !defined(cygwin32_TARGET_OS)
+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
+#endif
+
+-- ToDo: use getlogin_r
+getLoginName :: IO String
+getLoginName =  do
+    str <- throwErrnoIfNull "getLoginName" c_getlogin
+    peekCString str
+
+foreign import ccall unsafe "getlogin"
+  c_getlogin :: IO CString
+
+setUserID :: UserID -> IO ()
+setUserID uid = throwErrnoIfMinus1_ "setUserID" (c_setuid uid)
+
+foreign import ccall unsafe "setuid"
+  c_setuid :: CUid -> IO CInt
+
+setGroupID :: GroupID -> IO ()
+setGroupID gid = throwErrnoIfMinus1_ "setGroupID" (c_setgid gid)
+
+foreign import ccall unsafe "setgid"
+  c_setgid :: CGid -> IO CInt
+
+-- -----------------------------------------------------------------------------
+-- Process environment
+
+getProcessID :: IO ProcessID
+getProcessID = c_getpid
+
+getParentProcessID :: IO ProcessID
+getParentProcessID = c_getppid
+
+foreign import ccall unsafe "getppid"
+  c_getppid :: IO CPid
+
+getProcessGroupID :: IO ProcessGroupID
+getProcessGroupID = c_getpgrp
+
+foreign import ccall unsafe "getpgrp"
+  c_getpgrp :: IO CPid
+
+createProcessGroup :: ProcessID -> IO ProcessGroupID
+createProcessGroup pid = do
+  throwErrnoIfMinus1_ "createProcessGroup" (c_setpgid pid 0)
+  return pid
+
+joinProcessGroup :: ProcessGroupID -> IO ()
+joinProcessGroup pgid =
+  throwErrnoIfMinus1_ "joinProcessGroup" (c_setpgid 0 pgid)
+
+setProcessGroupID :: ProcessID -> ProcessGroupID -> IO ()
+setProcessGroupID pid pgid =
+  throwErrnoIfMinus1_ "setProcessGroupID" (c_setpgid pid pgid)
+
+foreign import ccall unsafe "setpgid"
+  c_setpgid :: CPid -> CPid -> IO CInt
+
+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 :: 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
+			  })
+
+foreign import ccall unsafe "times"
+  c_times :: Ptr CTms -> IO CClock
+
+-- -----------------------------------------------------------------------------
+-- 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
+		     })
+
+{-	
+data SysVar = ArgumentLimit
+            | ChildLimit
+            | ClockTick
+            | GroupLimit
+            | OpenFileLimit
+            | PosixVersion
+            | HasSavedIDs
+            | HasJobControl
+
+getSysVar :: SysVar -> IO Limit
+getSysVar v =
+    case v of
+      ArgumentLimit -> sysconf ``_SC_ARG_MAX''
+      ChildLimit    -> sysconf ``_SC_CHILD_MAX''
+      ClockTick	    -> sysconf ``_SC_CLK_TCK''
+      GroupLimit    -> sysconf ``_SC_NGROUPS_MAX''
+      OpenFileLimit -> sysconf ``_SC_OPEN_MAX''
+      PosixVersion  -> sysconf ``_SC_VERSION''
+      HasSavedIDs   -> sysconf ``_SC_SAVED_IDS''
+      HasJobControl -> sysconf ``_SC_JOB_CONTROL''
+--  where
+
+sysconf :: Int -> IO Limit
+sysconf n = do
+ rc <- _ccall_ sysconf n
+ if rc /= (-1::Int)
+    then return rc
+    else ioException (IOError Nothing NoSuchThing
+		          "getSysVar" 
+		          "no such system limit or option"
+			  Nothing)
+-}