[project @ 2002-09-12 16:38:21 by simonmar]

More POSIX bits... we're getting there.

4 files changed, 781 insertions, 189 deletions

diff --git a/System/Posix/Files.hsc b/System/Posix/Files.hsc
index 9dc5555..69e4924 100644
--- a/System/Posix/Files.hsc
+++ b/System/Posix/Files.hsc
@@ -48,6 +48,9 @@ module System.Posix.Files (
     -- * Hard links
     createLink, removeLink,
 
+    -- * Symbolic links
+    createSymbolicLink, readSymbolicLink,
+
     -- * Renaming files
     rename,
 
@@ -57,14 +60,8 @@ module System.Posix.Files (
     -- * Changing file timestamps
     setFileTimes, touchFile,
 
-    -- * Standard file descriptors
-    stdInput, stdOutput, stdError,
-
-    -- * Opening and closing files
-    OpenMode(..),
-    OpenFileFlags(..), defaultFileFlags,
-    openFd, createFile,
-    closeFd,
+    -- * Setting file sizes
+    setFileSize, setFdSize,
 
 {-
     -- run-time limit & POSIX feature testing
@@ -86,6 +83,7 @@ import Foreign.C
 #include <unistd.h>
 #include <utime.h>
 #include <fcntl.h>
+#include <limits.h>
 
 -- -----------------------------------------------------------------------------
 -- POSIX file modes
@@ -334,6 +332,32 @@ removeLink name =
   throwErrnoIfMinus1_ "removeLink" (c_unlink s)
 
 -- -----------------------------------------------------------------------------
+-- Symbolic Links
+
+createSymbolicLink :: FilePath -> FilePath -> IO ()
+createSymbolicLink file1 file2 =
+  withCString file1 $ \s1 ->
+  withCString file2 $ \s2 ->
+  throwErrnoIfMinus1_ "createSymbolicLink" (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.
+readSymbolicLink :: FilePath -> IO FilePath
+readSymbolicLink file =
+  allocaArray0 (#const PATH_MAX) $ \buf -> do
+    withCString file $ \s ->
+      throwErrnoIfMinus1_ "readSymbolicLink" $
+	c_readlink s buf (#const PATH_MAX)
+    peekCString buf
+
+foreign import ccall unsafe "readlink"
+  c_readlink :: CString -> CString -> CInt -> IO CInt
+
+-- -----------------------------------------------------------------------------
 -- Renaming files
 
 rename :: FilePath -> FilePath -> IO ()
@@ -385,67 +409,20 @@ touchFile name = do
    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)
+-- Setting file sizes
 
-    (creat, mode_w) = case maybe_mode of 
-			Nothing -> (0,0)
-			Just x  -> ((#const O_CREAT), x)
+setFileSize :: FilePath -> FileOffset -> IO ()
+setFileSize file off = 
+  withCString file $ \s ->
+    throwErrnoIfMinus1_ "setFileSize" (c_truncate s off)
 
-    open_mode = case how of
-		   ReadOnly  -> (#const O_RDONLY)
-		   WriteOnly -> (#const O_WRONLY)
-		   ReadWrite -> (#const O_RDWR)
+foreign import ccall unsafe "truncate"
+  c_truncate :: CString -> COff -> IO CInt
 
+setFdSize :: Fd -> FileOffset -> IO ()
+setFdSize fd off =
+  throwErrnoIfMinus1_ "setFdSize" (c_ftruncate fd off)
 
-createFile :: FilePath -> FileMode -> IO Fd
-createFile name mode
-  = openFd name WriteOnly (Just mode) defaultFileFlags{ trunc=True } 
+foreign import ccall unsafe "ftruncate"
+  c_ftruncate :: Fd -> COff -> IO CInt
 
-closeFd :: Fd -> IO ()
-closeFd (Fd fd) = throwErrnoIfMinus1_ "closeFd" (c_close fd)
diff --git a/System/Posix/IO.hsc b/System/Posix/IO.hsc
new file mode 100644
index 0000000..f324841
--- /dev/null
+++ b/System/Posix/IO.hsc
@@ -0,0 +1,327 @@
+{-# OPTIONS -fffi #-}
+-----------------------------------------------------------------------------
+-- |
+-- 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
+--
+-----------------------------------------------------------------------------
+
+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
+{-
+    fdRead, fdWrite,
+-}
+
+    -- ** 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 Control.Exception	( throw )
+
+import Foreign
+import Foreign.C
+import Data.Bits
+
+#ifdef __GLASGOW_HASKELL__
+import GHC.IOBase
+import GHC.Handle hiding (fdToHandle, openFd)
+import qualified GHC.Handle
+#endif
+
+#include <unistd.h>
+#include <fcntl.h>
+
+-- -----------------------------------------------------------------------------
+-- Pipes
+
+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 (rfd, wfd)
+
+foreign import ccall unsafe "pipe"
+  c_pipe :: Ptr Fd -> IO CInt
+
+-- -----------------------------------------------------------------------------
+-- Duplicating file descriptors
+
+dup :: Fd -> IO Fd
+dup fd = do r <- throwErrnoIfMinus1 "dup" (c_dup fd); return (Fd r)
+
+foreign import ccall unsafe "dup"
+  c_dup :: Fd -> IO CInt
+
+dupTo :: Fd -> Fd -> IO Fd
+dupTo fd1 fd2 = throwErrnoIfMinus1 "dupTp" (c_dup2 fd1 fd2)
+
+foreign import ccall unsafe "dup2"
+  c_dup2 :: Fd -> Fd -> IO Fd
+
+-- -----------------------------------------------------------------------------
+-- 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
+
+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)
+
+foreign import ccall unsafe "open"
+   c_open :: CString -> CInt -> CMode -> IO CInt
+
+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)
+
+foreign import ccall unsafe "close"
+   c_close :: CInt -> IO CInt
+
+-- -----------------------------------------------------------------------------
+-- Converting file descriptors to/from Handles
+
+#ifdef __GLASGOW_HASKELL__
+handleToFd :: Handle -> IO Fd
+handleToFd h = withHandle "handleToFd" h $ \ h_ -> do
+  -- converting a Handle into an Fd effectively means
+  -- letting go of the Handle; it is put into a closed
+  -- state as a result. 
+  let fd = haFD h_
+  flushWriteBufferOnly h_
+  unlockFile (fromIntegral fd)
+    -- setting the Handle's fd to (-1) as well as its 'type'
+    -- to closed, is enough to disable the finalizer that
+    -- eventually is run on the Handle.
+  return (h_{haFD= (-1),haType=ClosedHandle}, Fd (fromIntegral fd))
+
+fdToHandle :: Fd -> IO Handle
+fdToHandle fd = GHC.Handle.fdToHandle (fromIntegral fd)
+#endif
+
+-- -----------------------------------------------------------------------------
+-- Fd options
+
+data FdOption = AppendOnWrite
+	      | CloseOnExec
+	      | NonBlockingRead
+	      | SynchronousWrites
+
+queryFdOption :: Fd -> FdOption -> IO Bool
+queryFdOption fd opt = do
+  r <- throwErrnoIfMinus1 "queryFdOption" (c_fcntl_read fd flag)
+  return ((r .&. opt_val) /= 0)
+ where
+  flag    = case opt of
+	      CloseOnExec       -> (#const F_GETFD)
+	      other		-> (#const F_GETFL)
+
+  opt_val = case opt of
+	      CloseOnExec       -> (#const FD_CLOEXEC)
+	      AppendOnWrite     -> (#const O_APPEND)
+              NonBlockingRead   -> (#const O_NONBLOCK)
+	      SynchronousWrites -> (#const O_SYNC)
+
+foreign import ccall unsafe "fcntl"
+   c_fcntl_read  :: Fd -> CInt -> IO CInt
+
+setFdOption :: Fd -> FdOption -> Bool -> IO ()
+setFdOption fd opt val = do
+  r <- throwErrnoIfMinus1 "setFdOption" (c_fcntl_read fd flag)
+  let r' | val       = r .|. opt_val
+	 | otherwise = r .&. (complement opt_val) 
+  throwErrnoIfMinus1_ "setFdOption" (c_fcntl_write fd flag r')
+ where
+  flag    = case opt of
+	      CloseOnExec       -> (#const F_GETFD)
+	      other		-> (#const F_GETFL)
+  opt_val = case opt of
+	      CloseOnExec       -> (#const FD_CLOEXEC)
+	      AppendOnWrite     -> (#const O_APPEND)
+              NonBlockingRead   -> (#const O_NONBLOCK)
+	      SynchronousWrites -> (#const O_SYNC)
+
+foreign import ccall unsafe "fcntl"
+   c_fcntl_write :: Fd -> CInt -> CInt -> IO CInt
+
+-- -----------------------------------------------------------------------------
+-- Seeking 
+
+mode2Int :: SeekMode -> CInt
+mode2Int AbsoluteSeek = (#const SEEK_SET)
+mode2Int RelativeSeek = (#const SEEK_CUR)
+mode2Int SeekFromEnd  = (#const SEEK_END)
+
+fdSeek :: Fd -> SeekMode -> FileOffset -> IO FileOffset
+fdSeek fd mode off =
+  throwErrnoIfMinus1 "fdSeek" (c_lseek fd off (mode2Int mode))
+
+foreign import ccall unsafe "lseek"
+  c_lseek :: Fd -> COff -> CInt -> IO COff
+
+-- -----------------------------------------------------------------------------
+-- Locking
+
+data LockRequest = ReadLock
+                 | WriteLock
+                 | Unlock
+
+type FileLock = (LockRequest, SeekMode, FileOffset, FileOffset)
+
+type CFLock = ()
+
+getLock :: Fd -> FileLock -> IO (Maybe (ProcessID, FileLock))
+getLock fd lock =
+  allocaLock lock $ \p_flock -> do
+    throwErrnoIfMinus1_ "getLock" (c_fcntl_flock fd (#const F_GETLK) p_flock)
+    result <- bytes2ProcessIDAndLock p_flock
+    return (maybeResult result)
+  where
+    maybeResult (_, (Unlock, _, _, _)) = Nothing
+    maybeResult x = Just x
+
+foreign import ccall unsafe "fcntl"
+  c_fcntl_flock :: Fd -> CInt -> Ptr CFLock -> IO CInt
+
+allocaLock :: FileLock -> (Ptr CFLock -> IO a) -> IO a
+allocaLock (lockreq, mode, start, len) io = 
+  allocaBytes (#const sizeof(struct flock)) $ \p -> do
+    (#poke struct flock, l_type)   p (lockReqToInt 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
+
+lockReqToInt :: LockRequest -> CShort
+lockReqToInt ReadLock  = (#const F_RDLCK)
+lockReqToInt WriteLock = (#const F_WRLCK)
+lockReqToInt Unlock    = (#const F_UNLCK)
+
+bytes2ProcessIDAndLock :: Ptr 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 _ = throw (mkIOError illegalOperationErrorType "int2req"
+			     Nothing Nothing)
+
+  int2mode :: CShort -> SeekMode
+  int2mode (#const SEEK_SET) = AbsoluteSeek
+  int2mode (#const SEEK_CUR) = RelativeSeek
+  int2mode (#const SEEK_END) = SeekFromEnd
+  int2mode _ = throw (mkIOError illegalOperationErrorType "int2mode"
+			     Nothing Nothing)
+
+setLock :: Fd -> FileLock -> IO ()
+setLock fd lock = do
+  allocaLock lock $ \p_flock ->
+    throwErrnoIfMinus1_ "setLock" (c_fcntl_flock fd (#const F_SETLK) p_flock)
+
+waitToSetLock :: Fd -> FileLock -> IO ()
+waitToSetLock fd lock = do
+  allocaLock lock $ \p_flock ->
+    throwErrnoIfMinus1_ "waitToSetLock" 
+	(c_fcntl_flock fd (#const F_SETLKW) p_flock)
diff --git a/System/Posix/Process.hsc b/System/Posix/Process.hsc
new file mode 100644
index 0000000..dfa9e9a
--- /dev/null
+++ b/System/Posix/Process.hsc
@@ -0,0 +1,351 @@
+{-# OPTIONS -fffi #-}
+-----------------------------------------------------------------------------
+-- |
+-- 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
+--
+-----------------------------------------------------------------------------
+
+module System.Posix.Process (
+    -- * Processes
+
+    -- ** Forking and executing
+    forkProcess, executeFile,
+    
+    -- ** Exiting
+    exitImmediately,
+
+    -- ** Process environment
+    getProcessID,
+    getParentProcessID,
+    getProcessGroupID,
+
+    -- ** Process groups
+    createProcessGroup,
+    joinProcessGroup,
+    setProcessGroupID,
+
+    -- ** Sessions
+    createSession,
+
+    -- ** Process times
+    ProcessTimes(elapsedTime, systemTime, userTime,
+		 childSystemTime, childUserTime),
+    getProcessTimes,
+
+    -- ** Scheduling priority
+    nice,
+    getProcessPriority,
+    getProcessGroupPriority,
+    getUserPriority,
+    setProcessPriority,
+    setProcessGroupPriority,
+    setUserPriority,
+
+    -- ** Process status
+    ProcessStatus(..),
+    getProcessStatus,
+    getAnyProcessStatus,
+    getGroupProcessStatus,
+
+-- ToDo:
+--    getEnvVar,
+--    getEnvironment,
+ ) where
+
+#include "HsUnix.h"
+#include <sys/times.h>
+
+import Foreign
+import Foreign.C
+import System.IO
+import System.IO.Error
+import System.Exit
+import System.Posix.Types
+import System.Posix.Signals
+
+-- -----------------------------------------------------------------------------
+-- Process environment
+
+getProcessID :: IO ProcessID
+getProcessID = c_getpid
+
+foreign import ccall unsafe "getpid"
+   c_getpid :: IO CPid
+
+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
+			  })
+
+type CTms = ()
+
+foreign import ccall unsafe "times"
+  c_times :: Ptr CTms -> IO CClock
+
+-- -----------------------------------------------------------------------------
+-- Process scheduling priority
+
+nice :: Int -> IO ()
+nice prio = throwErrnoIfMinus1_ "nice" (c_nice (fromIntegral prio))
+
+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 :: IO (Maybe ProcessID)
+forkProcess = do
+  r <- throwErrnoIfMinus1 "forkProcess" c_fork
+  case r of
+     0   -> return Nothing
+     pid -> return (Just (fromIntegral pid))
+
+foreign import ccall unsafe "fork"
+  c_fork :: IO CInt
+
+
+executeFile :: FilePath			    -- Command
+            -> Bool			    -- Search PATH?
+            -> [String]			    -- Arguments
+            -> Maybe [(String, String)]	    -- Environment
+            -> IO ()
+executeFile path search args Nothing = do
+  withCString path $ \s ->
+    withMany withCString args $ \cstrs ->
+      withArray0 nullPtr cstrs $ \arr ->
+	if search then
+	  throwErrnoIfMinus1_ "executeFile" (c_execvp s arr)
+	else
+	  throwErrnoIfMinus1_ "executeFile" (c_execv s arr)
+
+executeFile path search args (Just env) = do
+  withCString path $ \s ->
+    withMany withCString args $ \cstrs ->
+      withArray0 nullPtr cstrs $ \arg_arr ->
+    let env' = map (\ (name, val) -> name ++ ('=' : val)) env in
+    withMany withCString env' $ \cenv ->
+      withArray0 nullPtr cenv $ \env_arr ->
+	if search then
+	  throwErrnoIfMinus1_ "executeFile" (c_execvpe s arg_arr env_arr)
+	else
+	  throwErrnoIfMinus1_ "executeFile" (c_execve s arg_arr env_arr)
+
+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 "execvpe"
+  c_execvpe :: CString -> Ptr CString -> Ptr CString -> IO CInt
+
+foreign import ccall unsafe "execve"
+  c_execve :: CString -> Ptr CString -> Ptr CString -> IO CInt
+
+-- -----------------------------------------------------------------------------
+-- Waiting for process termination
+
+data ProcessStatus = Exited ExitCode
+                   | Terminated Signal
+                   | Stopped Signal
+		   deriving (Eq, Ord, Show)
+
+getProcessStatus :: Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
+getProcessStatus block stopped pid =
+  alloca $ \wstatp -> do
+    pid <- throwErrnoIfMinus1 "getProcessStatus"
+		(c_waitpid pid wstatp (waitOptions block stopped))
+    case pid of
+      0  -> return Nothing
+      _  -> do ps <- decipherWaitStatus wstatp
+	       return (Just ps)
+
+foreign import ccall unsafe "waitpid"
+  c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid
+
+getGroupProcessStatus :: Bool
+                      -> Bool
+                      -> ProcessGroupID
+                      -> IO (Maybe (ProcessID, ProcessStatus))
+getGroupProcessStatus block stopped pgid =
+  alloca $ \wstatp -> do
+    pid <- throwErrnoIfMinus1 "getGroupProcessStatus"
+		(c_waitpid (-pgid) wstatp (waitOptions block stopped))
+    case pid of
+      0  -> return Nothing
+      _  -> do ps <- decipherWaitStatus wstatp
+	       return (Just (pid, ps))
+
+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
+
+decipherWaitStatus :: Ptr CInt -> IO ProcessStatus
+decipherWaitStatus wstatp = do
+  wstat <- peek wstatp
+  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
+		return (Terminated (fromIntegral termsig))
+	   else do
+		if c_WIFSTOPPED wstat /= 0
+		   then do
+			let stopsig = c_WSTOPSIG wstat
+			return (Stopped (fromIntegral stopsig))
+		   else do
+			ioError (mkIOError illegalOperationErrorType
+				   "waitStatus" Nothing Nothing)
+
+foreign import ccall unsafe "__hsunix_wifexited"
+  c_WIFEXITED :: CInt -> CInt 
+
+foreign import ccall unsafe "__hsunix_wexitstatus"
+  c_WEXITSTATUS :: CInt -> CInt
+
+foreign import ccall unsafe "__hsunix_wifsignaled"
+  c_WIFSIGNALED :: CInt -> CInt
+
+foreign import ccall unsafe "__hsunix_wtermsig"
+  c_WTERMSIG :: CInt -> CInt 
+
+foreign import ccall unsafe "__hsunix_wifstopped"
+  c_WIFSTOPPED :: CInt -> CInt
+
+foreign import ccall unsafe "__hsunix_wstopsig"
+  c_WSTOPSIG :: CInt -> CInt
+
+-- -----------------------------------------------------------------------------
+-- Exiting
+
+exitImmediately :: ExitCode -> IO ()
+exitImmediately exitcode = c_exit (exitcode2Int exitcode)
+  where
+    exitcode2Int ExitSuccess = 0
+    exitcode2Int (ExitFailure n) = fromIntegral n
+
+foreign import ccall unsafe "exit"
+  c_exit :: CInt -> IO ()
+
+-- -----------------------------------------------------------------------------
diff --git a/System/Posix/Unistd.hsc b/System/Posix/Unistd.hsc
index a7fae7e..bdcbc34 100644
--- a/System/Posix/Unistd.hsc
+++ b/System/Posix/Unistd.hsc
@@ -29,52 +29,45 @@ module System.Posix.Unistd (
     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,
 
+    SysVar(..),
+    getSysVar,
+
+    -- * Sleeping
+    sleep, usleep,
+
   {-
     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
+      confstr, 
+      lots of sysconf variables
 
-    SysVar(..),
-    getSysVar,
+    -- use Network.BSD
+    gethostid, gethostname
 
     -- should be in System.Posix.Files?
+    pathconf, fpathconf,
     queryTerminal,
     getTerminalName,
 #if !defined(cygwin32_TARGET_OS)
     getControllingTerminalName,
 #endif
 
+    -- System.Posix.Signals
+    ualarm,
+
+    -- System.Posix.Terminal
+    isatty, tcgetpgrp, tcsetpgrp, ttyname(_r),
+
+    -- System.Posix.IO
+    read, write,
+
     -- should be in System.Posix.Time?
     epochTime,
 
-    -- should be in System.Posix.Pwd?
+    -- should be in System.Posix.User?
     getEffectiveUserName,
 -}
   ) where
@@ -85,7 +78,6 @@ import System.Posix.Types
 import GHC.Posix
 
 #include <unistd.h>
-#include <sys/times.h>
 #include <sys/utsname.h>
 
 -- -----------------------------------------------------------------------------
@@ -152,77 +144,6 @@ 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 =
@@ -249,7 +170,26 @@ getSystemID = do
 		       machine    = mach
 		     })
 
-{-	
+-- -----------------------------------------------------------------------------
+-- sleeping
+
+sleep :: Int -> IO Int
+sleep 0 = return 0
+sleep secs = do r <- c_sleep (fromIntegral secs); return (fromIntegral r)
+
+foreign import ccall unsafe "sleep"
+  c_sleep :: CUInt -> IO CUInt
+
+usleep :: Int -> IO ()
+usleep 0 = return ()
+usleep usecs = throwErrnoIfMinus1_ "usleep" (c_usleep (fromIntegral usecs))
+
+foreign import ccall unsafe "usleep"
+  c_usleep :: CUInt -> IO CInt
+
+-- -----------------------------------------------------------------------------
+-- System variables
+
 data SysVar = ArgumentLimit
             | ChildLimit
             | ClockTick
@@ -258,27 +198,24 @@ data SysVar = ArgumentLimit
             | PosixVersion
             | HasSavedIDs
             | HasJobControl
+	-- ToDo: lots more
 
-getSysVar :: SysVar -> IO Limit
+getSysVar :: SysVar -> IO Integer
 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)
--}
+      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