diff options
| -rw-r--r-- | Makefile | 11 | ||||
| -rw-r--r-- | System/Posix.hs | 30 | ||||
| -rw-r--r-- | System/Posix/Directory.hsc | 133 | ||||
| -rw-r--r-- | System/Posix/Files.hsc | 451 | ||||
| -rw-r--r-- | System/Posix/Unistd.hsc | 284 | ||||
| -rw-r--r-- | unix.conf.in | 24 |
6 files changed, 933 insertions, 0 deletions
diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..19a956f --- /dev/null +++ b/Makefile @@ -0,0 +1,11 @@ +TOP=.. +include $(TOP)/mk/boilerplate.mk + +ALL_DIRS = System System/Posix +PACKAGE = unix +PACKAGE_DEPS = base + +SRC_HADDOCK_OPTS += -t "Haskell Core Libraries (unix package)" \ + -p prologue.txt + +include $(TOP)/mk/target.mk 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) +-} diff --git a/unix.conf.in b/unix.conf.in new file mode 100644 index 0000000..7b4c851 --- /dev/null +++ b/unix.conf.in @@ -0,0 +1,24 @@ +#include "config.h" + +Package { + name = "unix", +#ifdef INSTALLING + import_dirs = [ "$libdir/imports/unix" ], +#else + import_dirs = [ "$libdir/libraries/unix" ], +#endif + source_dirs = [], +#ifdef INSTALLING + library_dirs = [ "$libdir" ], +#else + library_dirs = [ "$libdir/libraries/unix" ], +#endif + hs_libraries = [ "HSunix" ], + extra_libraries = [], + include_dirs = [], + c_includes = [], + package_deps = [ "base" ], + extra_ghc_opts = [], + extra_cc_opts = [], + extra_ld_opts = [] +} |