diff --git a/System/Posix/Directory/PosixPath.hsc b/System/Posix/Directory/PosixPath.hsc
new file mode 100644
index 0000000000000000000000000000000000000000..5da1bee7121c0f7b96ae18e659748d4a515e8627
--- /dev/null
+++ b/System/Posix/Directory/PosixPath.hsc
@@ -0,0 +1,166 @@
+{-# LANGUAGE CApiFFI #-}
+{-# LANGUAGE NondecreasingIndentation #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : System.Posix.Directory.PosixPath
+-- 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)
+--
+-- PosixPath 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.PosixPath (
+ -- * 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 System.OsPath.Types
+import GHC.IO.Encoding.UTF8 ( mkUTF8 )
+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
+import System.OsPath.Posix
+import System.Posix.Directory hiding (createDirectory, openDirStream, readDirStream, getWorkingDirectory, changeWorkingDirectory, removeDirectory)
+import qualified System.Posix.Directory.Common as Common
+import System.Posix.PosixPath.FilePath
+
+-- | @createDirectory dir mode@ calls @mkdir@ to
+-- create a new directory, @dir@, with permissions based on
+-- @mode@.
+createDirectory :: PosixPath -> 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 :: PosixPath -> IO DirStream
+openDirStream name =
+ withFilePath name $ \s -> do
+ dirp <- throwErrnoPathIfNullRetry "openDirStream" name $ c_opendir s
+ return (Common.DirStream dirp)
+
+foreign import capi unsafe "HsUnix.h opendir"
+ c_opendir :: CString -> IO (Ptr Common.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 PosixPath
+readDirStream (Common.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 mempty
+ 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 mempty
+ else throwErrno "readDirStream"
+
+-- traversing directories
+foreign import ccall unsafe "__hscore_readdir"
+ c_readdir :: Ptr Common.CDir -> Ptr (Ptr Common.CDirent) -> IO CInt
+
+foreign import ccall unsafe "__hscore_free_dirent"
+ c_freeDirEnt :: Ptr Common.CDirent -> IO ()
+
+foreign import ccall unsafe "__hscore_d_name"
+ d_name :: Ptr Common.CDirent -> IO CString
+
+
+-- | @getWorkingDirectory@ calls @getcwd@ to obtain the name
+-- of the current working directory.
+getWorkingDirectory :: IO PosixPath
+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 :: PosixPath -> IO ()
+changeWorkingDirectory path =
+ modifyIOError (`ioeSetFileName` (_toStr path)) $
+ withFilePath path $ \s ->
+ throwErrnoIfMinus1Retry_ "changeWorkingDirectory" (c_chdir s)
+
+foreign import ccall unsafe "chdir"
+ c_chdir :: CString -> IO CInt
+
+removeDirectory :: PosixPath -> IO ()
+removeDirectory path =
+ modifyIOError (`ioeSetFileName` _toStr path) $
+ withFilePath path $ \s ->
+ throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
+
+foreign import ccall unsafe "rmdir"
+ c_rmdir :: CString -> IO CInt
+
+_toStr :: PosixPath -> String
+_toStr fp = either (error . show) id $ decodeWith (mkUTF8 TransliterateCodingFailure) fp
+
diff --git a/System/Posix/Env/PosixString.hsc b/System/Posix/Env/PosixString.hsc
new file mode 100644
index 0000000000000000000000000000000000000000..224c53f6a99c1a47cfe67daa917cada5e46a27ec
--- /dev/null
+++ b/System/Posix/Env/PosixString.hsc
@@ -0,0 +1,206 @@
+{-# LANGUAGE CApiFFI #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : System.Posix.Env.PosixString
+-- 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.PosixString (
+ -- * Environment Variables
+ getEnv
+ , getEnvDefault
+ , getEnvironmentPrim
+ , getEnvironment
+ , setEnvironment
+ , putEnv
+ , setEnv
+ , unsetEnv
+ , clearEnv
+
+ -- * Program arguments
+ , getArgs
+) where
+
+#include "HsUnix.h"
+
+import Control.Monad
+import Foreign
+import Foreign.C
+import Data.Maybe ( fromMaybe )
+
+import GHC.IO.Encoding.UTF8 ( mkUTF8 )
+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
+import System.Posix.Env ( clearEnv )
+import System.OsPath.Posix
+import System.OsString.Internal.Types
+import qualified System.OsPath.Data.ByteString.Short as B
+import Data.ByteString.Short.Internal ( copyToPtr )
+
+-- |'getEnv' looks up a variable in the environment.
+
+getEnv ::
+ PosixString {- ^ variable name -} ->
+ IO (Maybe PosixString) {- ^ variable value -}
+getEnv (PS name) = do
+ litstring <- B.useAsCString name c_getenv
+ if litstring /= nullPtr
+ then (Just . PS) <$> B.packCString litstring
+ else return Nothing
+
+-- |'getEnvDefault' is a wrapper around 'getEnv' where the
+-- programmer can specify a fallback as the second argument, which will be
+-- used if the variable is not found in the environment.
+
+getEnvDefault ::
+ PosixString {- ^ variable name -} ->
+ PosixString {- ^ fallback value -} ->
+ IO PosixString {- ^ variable value or fallback value -}
+getEnvDefault name fallback = fromMaybe fallback <$> getEnv name
+
+foreign import ccall unsafe "getenv"
+ c_getenv :: CString -> IO CString
+
+getEnvironmentPrim :: IO [PosixString]
+getEnvironmentPrim = do
+ c_environ <- getCEnviron
+ arr <- peekArray0 nullPtr c_environ
+ mapM (fmap PS . 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 [(PosixString,PosixString)] {- ^ @[(key,value)]@ -}
+getEnvironment = do
+ env <- getEnvironmentPrim
+ return $ map (dropEq . (B.break ((==) _equal)) . getPosixString) env
+ where
+ dropEq (x,y)
+ | B.head y == _equal = (PS x, PS (B.tail y))
+ | otherwise = error $ "getEnvironment: insane variable " ++ _toStr x
+
+-- |'setEnvironment' resets the entire environment to the given list of
+-- @(key,value)@ pairs.
+setEnvironment ::
+ [(PosixString,PosixString)] {- ^ @[(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 :: PosixString {- ^ variable name -} -> IO ()
+#if HAVE_UNSETENV
+# if !UNSETENV_RETURNS_VOID
+unsetEnv (PS 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 <> PosixString (B.pack "="))
+#endif
+
+-- |'putEnv' function takes an argument of the form @name=value@
+-- and is equivalent to @setEnv(key,value,True{-overwrite-})@.
+putEnv :: PosixString {- ^ "key=value" -} -> IO ()
+putEnv (PS sbs) = do
+ buf <- mallocBytes (l+1)
+ copyToPtr sbs 0 buf (fromIntegral l)
+ pokeByteOff buf l (0::Word8)
+ throwErrnoIfMinus1_ "putenv" (c_putenv buf)
+ where l = B.length sbs
+
+
+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 ::
+ PosixString {- ^ variable name -} ->
+ PosixString {- ^ variable value -} ->
+ Bool {- ^ overwrite -} ->
+ IO ()
+#ifdef HAVE_SETENV
+setEnv (PS key) (PS 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 'PosixString'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 [PosixString]
+getArgs =
+ alloca $ \ p_argc ->
+ alloca $ \ p_argv -> do
+ getProgArgv p_argc p_argv
+ p <- fromIntegral <$> peek p_argc
+ argv <- peek p_argv
+ peekArray (p - 1) (advancePtr argv 1) >>= mapM (fmap PS . B.packCString)
+
+foreign import ccall unsafe "getProgArgv"
+ getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
+
+_equal :: Word8
+_equal = 0x3d
+
+_toStr :: B.ShortByteString -> String
+_toStr = either (error . show) id . decodeWith (mkUTF8 TransliterateCodingFailure) . PosixString
diff --git a/System/Posix/Files/PosixString.hsc b/System/Posix/Files/PosixString.hsc
new file mode 100644
index 0000000000000000000000000000000000000000..92bd16a102c3356c8628c2092641d2cad7c74663
--- /dev/null
+++ b/System/Posix/Files/PosixString.hsc
@@ -0,0 +1,453 @@
+{-# LANGUAGE CApiFFI #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : System.Posix.Files.PosixString
+-- 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.PosixString (
+ -- * 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,
+ 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 qualified System.Posix.Files.Common as Common
+import Foreign
+import Foreign.C hiding (
+ throwErrnoPath,
+ throwErrnoPathIf,
+ throwErrnoPathIf_,
+ throwErrnoPathIfNull,
+ throwErrnoPathIfMinus1,
+ throwErrnoPathIfMinus1_ )
+
+import System.OsPath.Types
+import System.Posix.Files hiding (getFileStatus, getSymbolicLinkStatus, createNamedPipe, createDevice, createLink, removeLink, createSymbolicLink, readSymbolicLink, rename, setOwnerAndGroup, setSymbolicLinkOwnerAndGroup, setFileTimes, setSymbolicLinkTimesHiRes, touchFile, touchSymbolicLink, setFileSize, getPathVar, setFileMode, fileAccess, fileExist, setFdTimesHiRes, setFileTimesHiRes)
+import System.Posix.PosixPath.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 :: PosixPath -> 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 :: PosixPath -> 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 :: PosixPath -> 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 :: PosixPath -> 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 :: PosixPath -> 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 (Common.FileStatus fp)
+
+-- | Acts as 'getFileStatus' except when the 'PosixPath' 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 :: PosixPath -> 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 (Common.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 :: PosixPath -> 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 :: PosixPath -> 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 :: PosixPath -> PosixPath -> IO ()
+createLink name1 name2 =
+ withFilePath name1 $ \s1 ->
+ withFilePath name2 $ \s2 ->
+ throwErrnoTwoPathsIfMinus1_ "createLink" name1 name2 (c_link s1 s2)
+
+-- | @removeLink path@ removes the link named @path@.
+--
+-- Note: calls @unlink@.
+removeLink :: PosixPath -> 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 :: PosixPath -> PosixPath -> IO ()
+createSymbolicLink name1 name2 =
+ withFilePath name1 $ \s1 ->
+ withFilePath name2 $ \s2 ->
+ throwErrnoTwoPathsIfMinus1_ "createSymbolicLink" name1 name2 (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 @PosixPath@ pointed to by the symbolic link and returns it.
+--
+-- Note: calls @readlink@.
+readSymbolicLink :: PosixPath -> IO PosixPath
+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 :: PosixPath -> PosixPath -> IO ()
+rename name1 name2 =
+ withFilePath name1 $ \s1 ->
+ withFilePath name2 $ \s2 ->
+ throwErrnoTwoPathsIfMinus1_ "rename" name1 name2 (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 :: PosixPath -> 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 :: PosixPath -> 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 :: PosixPath -> 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@. Support for high resolution timestamps
+-- is filesystem dependent with the following limitations:
+--
+-- - HFS+ volumes on OS X truncate the sub-second part of the timestamp.
+--
+setFileTimesHiRes :: PosixPath -> POSIXTime -> POSIXTime -> IO ()
+#ifdef HAVE_UTIMENSAT
+setFileTimesHiRes name atime mtime =
+ withFilePath name $ \s ->
+ withArray [Common.toCTimeSpec atime, Common.toCTimeSpec mtime] $ \times ->
+ throwErrnoPathIfMinus1_ "setFileTimesHiRes" name $
+ Common.c_utimensat (#const AT_FDCWD) s times 0
+#else
+setFileTimesHiRes name atime mtime =
+ withFilePath name $ \s ->
+ withArray [Common.toCTimeVal atime, Common.toCTimeVal mtime] $ \times ->
+ throwErrnoPathIfMinus1_ "setFileTimesHiRes" name (Common.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@. Support for high resolution timestamps
+-- is filesystem dependent with the following limitations:
+--
+-- - HFS+ volumes on OS X truncate the sub-second part of the timestamp.
+--
+setSymbolicLinkTimesHiRes :: PosixPath -> POSIXTime -> POSIXTime -> IO ()
+#if HAVE_UTIMENSAT
+setSymbolicLinkTimesHiRes name atime mtime =
+ withFilePath name $ \s ->
+ withArray [Common.toCTimeSpec atime, Common.toCTimeSpec mtime] $ \times ->
+ throwErrnoPathIfMinus1_ "setSymbolicLinkTimesHiRes" name $
+ Common.c_utimensat (#const AT_FDCWD) s times (#const AT_SYMLINK_NOFOLLOW)
+#elif HAVE_LUTIMES
+setSymbolicLinkTimesHiRes name atime mtime =
+ withFilePath name $ \s ->
+ withArray [Common.toCTimeVal atime, Common.toCTimeVal mtime] $ \times ->
+ throwErrnoPathIfMinus1_ "setSymbolicLinkTimesHiRes" name $
+ Common.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 :: PosixPath -> 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 :: PosixPath -> IO ()
+#if HAVE_LUTIMES
+touchSymbolicLink name =
+ withFilePath name $ \s ->
+ throwErrnoPathIfMinus1_ "touchSymbolicLink" name (Common.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 :: PosixPath -> 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 :: PosixPath -> PathVar -> IO Limit
+getPathVar name v = do
+ withFilePath name $ \ nameP ->
+ throwErrnoPathIfMinus1 "getPathVar" name $
+ c_pathconf nameP (Common.pathVarConst v)
+
+foreign import ccall unsafe "pathconf"
+ c_pathconf :: CString -> CInt -> IO CLong
diff --git a/System/Posix/IO/PosixString.hsc b/System/Posix/IO/PosixString.hsc
new file mode 100644
index 0000000000000000000000000000000000000000..d6d6b009594b16f233e433fbb29979f1c662b325
--- /dev/null
+++ b/System/Posix/IO/PosixString.hsc
@@ -0,0 +1,116 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : System.Posix.IO.PosixString
+-- 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.PosixString (
+ -- * Input \/ Output
+
+ -- ** Standard file descriptors
+ stdInput, stdOutput, stdError,
+
+ -- ** Opening and closing files
+ OpenMode(..),
+ OpenFileFlags(..), defaultFileFlags,
+ openFd, openFdAt, createFile, createFileAt,
+ 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.IO.ByteString ( fdRead, fdWrite )
+import System.OsPath.Types
+
+import System.Posix.PosixPath.FilePath
+
+
+
+-- |Open and optionally create this file. See 'System.Posix.Files'
+-- for information on how to use the 'FileMode' type.
+openFd :: PosixPath
+ -> OpenMode
+ -> OpenFileFlags
+ -> IO Fd
+openFd = openFdAt Nothing
+
+-- | Open a file relative to an optional directory file descriptor.
+--
+-- Directory file descriptors can be used to avoid some race conditions when
+-- navigating changing directory trees, or to retain access to a portion of the
+-- directory tree that would otherwise become inaccessible after dropping
+-- privileges.
+openFdAt :: Maybe Fd -- ^ Optional directory file descriptor
+ -> PosixPath -- ^ Pathname to open
+ -> OpenMode -- ^ Read-only, read-write or write-only
+ -> OpenFileFlags -- ^ Append, exclusive, truncate, etc.
+ -> IO Fd
+openFdAt fdMay name how flags =
+ withFilePath name $ \str ->
+ throwErrnoPathIfMinus1Retry "openFdAt" name $
+ openat_ fdMay 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 :: PosixPath -> FileMode -> IO Fd
+createFile = createFileAt Nothing
+
+-- | Create and open a file for write-only, with default flags,
+-- relative an optional directory file-descriptor.
+--
+-- Directory file descriptors can be used to avoid some race conditions when
+-- navigating changing directory trees, or to retain access to a portion of the
+-- directory tree that would otherwise become inaccessible after dropping
+-- privileges.
+createFileAt :: Maybe Fd -- ^ Optional directory file descriptor
+ -> PosixPath -- ^ Pathname to create
+ -> FileMode -- ^ File permission bits (before umask)
+ -> IO Fd
+createFileAt fdMay name mode
+ = openFdAt fdMay name WriteOnly defaultFileFlags{ trunc=True, creat=(Just mode) }
diff --git a/System/Posix/PosixPath/FilePath.hsc b/System/Posix/PosixPath/FilePath.hsc
new file mode 100644
index 0000000000000000000000000000000000000000..0ce2c7ea37efb322e4511af6470a6fbe3c183d3d
--- /dev/null
+++ b/System/Posix/PosixPath/FilePath.hsc
@@ -0,0 +1,140 @@
+{-# LANGUAGE CPP #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : System.Posix.PosixPath.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.PosixPath.FilePath (
+ withFilePath, peekFilePath, peekFilePathLen,
+ throwErrnoPathIfMinus1Retry,
+ throwErrnoPathIfMinus1Retry_,
+ throwErrnoPathIfNullRetry,
+ throwErrnoPathIfRetry,
+ throwErrnoPath,
+ throwErrnoPathIf,
+ throwErrnoPathIf_,
+ throwErrnoPathIfNull,
+ throwErrnoPathIfMinus1,
+ throwErrnoPathIfMinus1_,
+ throwErrnoTwoPathsIfMinus1_
+ ) where
+
+import Foreign hiding ( void )
+import Foreign.C hiding (
+ throwErrnoPath,
+ throwErrnoPathIf,
+ throwErrnoPathIf_,
+ throwErrnoPathIfNull,
+ throwErrnoPathIfMinus1,
+ throwErrnoPathIfMinus1_ )
+
+import System.OsPath.Types
+import Control.Monad
+import GHC.IO.Encoding.UTF8 ( mkUTF8 )
+import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
+import System.OsPath.Posix
+import System.OsPath.Data.ByteString.Short
+import Prelude hiding (FilePath)
+import System.OsString.Internal.Types (PosixString(..))
+#if !MIN_VERSION_base(4, 11, 0)
+import Data.Monoid ((<>))
+#endif
+
+
+withFilePath :: PosixPath -> (CString -> IO a) -> IO a
+withFilePath = useAsCString . getPosixString
+
+peekFilePath :: CString -> IO PosixPath
+peekFilePath = fmap PosixString . packCString
+
+peekFilePathLen :: CStringLen -> IO PosixPath
+peekFilePathLen = fmap PosixString . packCStringLen
+
+
+throwErrnoPathIfMinus1Retry :: (Eq a, Num a)
+ => String -> PosixPath -> IO a -> IO a
+throwErrnoPathIfMinus1Retry loc path f = do
+ throwErrnoPathIfRetry (== -1) loc path f
+
+throwErrnoPathIfMinus1Retry_ :: (Eq a, Num a)
+ => String -> PosixPath -> IO a -> IO ()
+throwErrnoPathIfMinus1Retry_ loc path f =
+ void $ throwErrnoPathIfRetry (== -1) loc path f
+
+throwErrnoPathIfNullRetry :: String -> PosixPath -> IO (Ptr a) -> IO (Ptr a)
+throwErrnoPathIfNullRetry loc path f =
+ throwErrnoPathIfRetry (== nullPtr) loc path f
+
+throwErrnoPathIfRetry :: (a -> Bool) -> String -> PosixPath -> 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 -> PosixPath -> IO a
+throwErrnoPath loc path =
+ do
+ errno <- getErrno
+ ioError (errnoToIOError loc errno Nothing (Just (_toStr path)))
+
+-- | as 'throwErrnoIf', but exceptions include the given path when
+-- appropriate.
+--
+throwErrnoPathIf :: (a -> Bool) -> String -> PosixPath -> 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 -> PosixPath -> 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 -> PosixPath -> 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 -> PosixPath -> IO a -> IO a
+throwErrnoPathIfMinus1 = throwErrnoPathIf (== -1)
+
+-- | as 'throwErrnoIfMinus1_', but exceptions include the given path when
+-- appropriate.
+--
+throwErrnoPathIfMinus1_ :: (Eq a, Num a) => String -> PosixPath -> IO a -> IO ()
+throwErrnoPathIfMinus1_ = throwErrnoPathIf_ (== -1)
+
+-- | as 'throwErrnoTwoPathsIfMinus1_', but exceptions include two paths when appropriate.
+--
+throwErrnoTwoPathsIfMinus1_ :: (Eq a, Num a) => String -> PosixPath -> PosixPath -> IO a -> IO ()
+throwErrnoTwoPathsIfMinus1_ loc path1 path2 =
+ throwErrnoIfMinus1_ (loc <> " '" <> _toStr path1 <> "' to '" <> _toStr path2 <> "'")
+
+
+_toStr :: PosixPath -> String
+_toStr fp = either (error . show) id $ decodeWith (mkUTF8 TransliterateCodingFailure) fp
+
diff --git a/System/Posix/PosixString.hs b/System/Posix/PosixString.hs
new file mode 100644
index 0000000000000000000000000000000000000000..c558ac2a9e1cc99be31323a330410c60e883cdb6
--- /dev/null
+++ b/System/Posix/PosixString.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE CPP #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : System.Posix.PosixString
+-- 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.PosixString (
+ System.OsString.Posix.PosixString,
+ System.OsPath.Posix.PosixPath,
+ module System.Posix.Types,
+ module System.Posix.Signals,
+ module System.Posix.Directory.PosixPath,
+ module System.Posix.Files.PosixString,
+ module System.Posix.Unistd,
+ module System.Posix.IO.PosixString,
+ module System.Posix.Env.PosixString,
+ module System.Posix.Process.PosixString,
+ module System.Posix.Temp.PosixString,
+ -- 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.OsPath.Posix
+import System.OsString.Posix
+import System.Posix.Types
+import System.Posix.Signals
+import System.Posix.Directory.PosixPath
+import System.Posix.Files.PosixString
+import System.Posix.Unistd
+import System.Posix.Process.PosixString
+import System.Posix.IO.PosixString
+import System.Posix.Env.PosixString
+import System.Posix.Temp.PosixString
+-- 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
diff --git a/System/Posix/Process/Common.hsc b/System/Posix/Process/Common.hsc
index 9b787d97c4848c2b9c255e83288f37b7aed5cbb9..1a502eb8a7a263ec20b1f8bc7686ef50928b5a23 100644
--- a/System/Posix/Process/Common.hsc
+++ b/System/Posix/Process/Common.hsc
@@ -82,9 +82,10 @@ import Control.Monad
import Control.Exception.Base ( bracket, getMaskingState, MaskingState(..) ) -- used by forkProcess
import GHC.TopHandler ( runIO )
-import GHC.IO ( unsafeUnmask, uninterruptibleMask_, unsafePerformIO )
-#if !defined(HAVE_GETPID)
+#if defined(HAVE_GETPID)
+import GHC.IO ( unsafeUnmask, uninterruptibleMask_ )
+#else
import System.IO.Error ( ioeSetLocation )
import GHC.IO.Exception ( unsupportedOperation )
#endif
diff --git a/System/Posix/Process/PosixString.hsc b/System/Posix/Process/PosixString.hsc
new file mode 100644
index 0000000000000000000000000000000000000000..7994bff0e079f95a4634785f9dee842b73709b52
--- /dev/null
+++ b/System/Posix/Process/PosixString.hsc
@@ -0,0 +1,134 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : System.Posix.Process.PosixString
+-- 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.PosixString (
+ -- * 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 (ProcessTimes(..), setProcessGroupID, createProcessGroup, getGroupProcessStatus, getAnyProcessStatus, getProcessStatus, setUserPriority, setProcessGroupPriority, setProcessPriority, getUserPriority, getProcessGroupPriority, getProcessPriority, nice, getProcessTimes, createSession, setProcessGroupIDOf, joinProcessGroup, createProcessGroupFor, getProcessGroupIDOf, getProcessGroupID, getParentProcessID, getProcessID, exitImmediately, forkProcessWithUnmask, forkProcess)
+
+import Foreign.C hiding (
+ throwErrnoPath,
+ throwErrnoPathIf,
+ throwErrnoPathIf_,
+ throwErrnoPathIfNull,
+ throwErrnoPathIfMinus1,
+ throwErrnoPathIfMinus1_ )
+
+import System.OsPath.Types
+import System.OsString.Internal.Types (PosixString(..))
+import qualified System.OsPath.Data.ByteString.Short as BC
+
+import System.Posix.PosixPath.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 :: PosixPath -- ^ Command
+ -> Bool -- ^ Search PATH?
+ -> [PosixString] -- ^ Arguments
+ -> Maybe [(PosixString, PosixString)] -- ^ 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 (\ (PosixString name, PosixString val) -> PosixString $ name `BC.append` (_equal `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
+
+_equal :: Word8
+_equal = 0x3d
diff --git a/System/Posix/Signals.hsc b/System/Posix/Signals.hsc
index 4a31ccd917b635c919f085c4f4a451b230fb4592..b068d41b07d2b1828aaff160889649080406858a 100644
--- a/System/Posix/Signals.hsc
+++ b/System/Posix/Signals.hsc
@@ -101,6 +101,10 @@ import Foreign.ForeignPtr
import Foreign.Marshal
import Foreign.Ptr
import Foreign.Storable
+#if !defined(HAVE_SIGNAL_H)
+import System.IO.Error ( ioeSetLocation )
+import GHC.IO.Exception ( unsupportedOperation )
+#endif
import System.IO.Unsafe (unsafePerformIO)
import System.Posix.Types
import System.Posix.Internals
@@ -114,8 +118,6 @@ import GHC.Conc hiding (Signal)
#if !defined(HAVE_SIGNAL_H)
import Control.Exception ( throw )
-import System.IO.Error ( ioeSetLocation )
-import GHC.IO.Exception ( unsupportedOperation )
#endif
-- -----------------------------------------------------------------------------
diff --git a/System/Posix/Temp/PosixString.hsc b/System/Posix/Temp/PosixString.hsc
new file mode 100644
index 0000000000000000000000000000000000000000..bdab8d0ca940d0c6469fb75bc1518646b045204e
--- /dev/null
+++ b/System/Posix/Temp/PosixString.hsc
@@ -0,0 +1,123 @@
+{-# LANGUAGE CApiFFI #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : System.Posix.Temp.PosixString
+-- 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.PosixString (
+ mkstemp, mkstemps, mkdtemp
+ ) where
+
+#include "HsUnix.h"
+
+import qualified System.OsPath.Data.ByteString.Short as BC
+import Data.Word
+
+import Foreign.C
+
+import System.OsPath.Types
+import System.IO
+import System.Posix.PosixPath.FilePath
+import System.OsString.Internal.Types (PosixString(..))
+#if !HAVE_MKDTEMP
+import System.Posix.Directory.PosixPath (createDirectory)
+#endif
+import System.Posix.IO.PosixString
+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
+-- 'PosixPath' 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 :: PosixString -> IO (PosixPath, Handle)
+mkstemp (PosixString template') = do
+ let template = PosixString $ template' `BC.append` (BC.pack [_X,_X,_X,_X,_X,_X])
+ 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 'PosixPath' is the (possibly relative) path of
+-- the created file, which contains 6 random characters in between
+-- the prefix and suffix.
+mkstemps :: PosixString -> PosixString -> IO (PosixPath, Handle)
+#if HAVE_MKSTEMPS
+mkstemps (PosixString prefix) (PosixString suffix) = do
+ let template = PosixString $ prefix `BC.append` (BC.pack [_X,_X,_X,_X,_X,_X]) `BC.append` suffix
+ lenOfsuf = (fromIntegral $ BC.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 'PosixPath' 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 :: PosixString -> IO PosixPath
+mkdtemp (PosixString template') = do
+ let template = PosixString $ template' `BC.append` (BC.pack [_X,_X,_X,_X,_X,_X])
+#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 :: PosixString -> IO PosixPath
+mktemp template = do
+ withFilePath template $ \ ptr -> do
+ ptr <- throwErrnoIfNull "mktemp" (c_mktemp ptr)
+ peekFilePath ptr
+#endif
+
+_X :: Word8
+_X = 0x58
+
diff --git a/System/Posix/Terminal/PosixString.hsc b/System/Posix/Terminal/PosixString.hsc
new file mode 100644
index 0000000000000000000000000000000000000000..a62f2bb6fbf717cfe0bc12367a4fe6720455eb48
--- /dev/null
+++ b/System/Posix/Terminal/PosixString.hsc
@@ -0,0 +1,211 @@
+{-# LANGUAGE CApiFFI #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : System.Posix.Terminal.PosixString
+-- 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.PosixString (
+ -- * 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 qualified System.OsPath.Data.ByteString.Short as SBS
+import System.Posix.IO.ByteString (defaultFileFlags, openFd, noctty, OpenMode(ReadWrite))
+import Data.ByteString.Char8 as B ( pack, )
+import qualified System.OsPath.Data.ByteString.Short as BC
+import System.OsString.Internal.Types (PosixString(..))
+#endif
+
+import Foreign.C hiding (
+ throwErrnoPath,
+ throwErrnoPathIf,
+ throwErrnoPathIf_,
+ throwErrnoPathIfNull,
+ throwErrnoPathIfMinus1,
+ throwErrnoPathIfMinus1_ )
+
+import System.OsPath.Types
+import System.Posix.PosixPath.FilePath
+
+#if !(HAVE_CTERMID && defined(HAVE_TERMIOS_H))
+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 PosixPath
+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 PosixPath
+#if HAVE_CTERMID && defined(HAVE_TERMIOS_H)
+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 PosixPath
+
+#ifdef HAVE_PTSNAME
+getSlaveTerminalName (Fd fd) = do
+ s <- throwErrnoIfNull "getSlaveTerminalName" (c_ptsname fd)
+ peekFilePath s
+
+foreign import capi unsafe "HsUnix.h ptsname"
+ c_ptsname :: CInt -> IO CString
+#else
+{-# WARNING getSlaveTerminalName "getSlaveTerminalName: not available on this platform" #-}
+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
+ defaultFileFlags{noctty=True}
+ throwErrnoIfMinus1_ "openPseudoTerminal" (c_grantpt master)
+ throwErrnoIfMinus1_ "openPseudoTerminal" (c_unlockpt master)
+ slaveName <- getSlaveTerminalName (Fd master)
+ slave <- openFd (SBS.fromShort . getPosixString $ slaveName) ReadWrite 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
+foreign import capi unsafe "HsUnix.h grantpt"
+ c_grantpt :: CInt -> IO CInt
+
+foreign import capi unsafe "HsUnix.h unlockpt"
+ c_unlockpt :: CInt -> IO CInt
+#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 */
diff --git a/cabal.project b/cabal.project
index 586737c7e0d2ca9205e6f633461b748c522f905b..50c6c320c9fe0a151f3d7ac33be1bd9ef7c02b09 100644
--- a/cabal.project
+++ b/cabal.project
@@ -1,4 +1,5 @@
packages: .
+
tests: True
constraints:
diff --git a/cabal.project.wasm32-wasi b/cabal.project.wasm32-wasi
index f6e34e22367835400bd89226da89da8a217299f9..87a3e351fa0652afb4e540e5ba07788ecabc9319 100644
--- a/cabal.project.wasm32-wasi
+++ b/cabal.project.wasm32-wasi
@@ -5,4 +5,4 @@ package unix
write-ghc-environment-files: always
-allow-newer: all:base
+allow-newer: all:base, all:filepath
diff --git a/unix.cabal b/unix.cabal
index 081e49f54c311cc74d2271452a9035685c1265c7..a297c5d56ecbc95f0842ce708093829a893c1744 100644
--- a/unix.cabal
+++ b/unix.cabal
@@ -70,11 +70,13 @@ library
build-depends:
base >= 4.10 && < 4.17,
bytestring >= 0.9.2 && < 0.12,
+ filepath >= 1.4.100.0,
time >= 1.2 && < 1.13
exposed-modules:
System.Posix
System.Posix.ByteString
+ System.Posix.PosixString
System.Posix.Error
System.Posix.Resource
@@ -87,11 +89,13 @@ library
System.Posix.SharedMem
System.Posix.ByteString.FilePath
+ System.Posix.PosixPath.FilePath
System.Posix.Directory
System.Posix.Directory.Internals
System.Posix.Directory.Fd
System.Posix.Directory.ByteString
+ System.Posix.Directory.PosixPath
System.Posix.DynamicLinker.Module
System.Posix.DynamicLinker.Module.ByteString
@@ -101,24 +105,30 @@ library
System.Posix.Files
System.Posix.Files.ByteString
+ System.Posix.Files.PosixString
System.Posix.IO
System.Posix.IO.ByteString
+ System.Posix.IO.PosixString
System.Posix.Env
System.Posix.Env.ByteString
+ System.Posix.Env.PosixString
System.Posix.Fcntl
System.Posix.Process
System.Posix.Process.Internals
System.Posix.Process.ByteString
+ System.Posix.Process.PosixString
System.Posix.Temp
System.Posix.Temp.ByteString
+ System.Posix.Temp.PosixString
System.Posix.Terminal
System.Posix.Terminal.ByteString
+ System.Posix.Terminal.PosixString
other-modules:
System.Posix.Directory.Common