Some some
This commit is contained in:
parent
e194fdec91
commit
eea53e7113
@ -68,6 +68,7 @@ install:
|
||||
- cabal install --installdir=$HOME/.cabal/bin doctest
|
||||
|
||||
script:
|
||||
- (cd unix && autoreconf -fi)
|
||||
- cabal build --enable-tests all
|
||||
- cabal run spec
|
||||
- ./hpath/run-doctests.sh
|
||||
|
@ -3,6 +3,7 @@ packages: ./hpath
|
||||
./hpath-filepath
|
||||
./hpath-io
|
||||
./hpath-posix
|
||||
./unix
|
||||
|
||||
package hpath-io
|
||||
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
|
||||
|
@ -30,8 +30,6 @@ module System.Posix.RawFilePath.Directory.Traversals (
|
||||
|
||||
-- lower-level stuff
|
||||
, readDirEnt
|
||||
, packDirStream
|
||||
, unpackDirStream
|
||||
, fdOpendir
|
||||
|
||||
, realpath
|
||||
@ -52,11 +50,11 @@ import Control.Exception
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import System.Posix.ByteString.FilePath
|
||||
import System.Posix.Directory.ByteString as PosixBS
|
||||
import System.Posix.Directory.Common
|
||||
import System.Posix.Files.ByteString
|
||||
|
||||
import System.IO.Unsafe
|
||||
import "unix" System.Posix.IO.ByteString (closeFd)
|
||||
import Unsafe.Coerce (unsafeCoerce)
|
||||
import Foreign.C.Error
|
||||
import Foreign.C.String
|
||||
import Foreign.C.Types
|
||||
@ -148,18 +146,6 @@ actOnDirContents pathRelToTop b f =
|
||||
----------------------------------------------------------
|
||||
-- dodgy stuff
|
||||
|
||||
type CDir = ()
|
||||
type CDirent = ()
|
||||
|
||||
-- Posix doesn't export DirStream, so to re-use that type we need to use
|
||||
-- unsafeCoerce. It's just a newtype, so this is a legitimate usage.
|
||||
-- ugly trick.
|
||||
unpackDirStream :: DirStream -> Ptr CDir
|
||||
unpackDirStream = unsafeCoerce
|
||||
|
||||
packDirStream :: Ptr CDir -> DirStream
|
||||
packDirStream = unsafeCoerce
|
||||
|
||||
-- the __hscore_* functions are defined in the unix package. We can import them and let
|
||||
-- the linker figure it out.
|
||||
foreign import ccall unsafe "__hscore_readdir"
|
||||
@ -178,14 +164,14 @@ foreign import ccall "realpath"
|
||||
c_realpath :: CString -> CString -> IO CString
|
||||
|
||||
foreign import ccall unsafe "fdopendir"
|
||||
c_fdopendir :: Posix.Fd -> IO (Ptr ())
|
||||
c_fdopendir :: Posix.Fd -> IO (Ptr CDir)
|
||||
|
||||
----------------------------------------------------------
|
||||
-- less dodgy but still lower-level
|
||||
|
||||
|
||||
readDirEnt :: DirStream -> IO (DirType, RawFilePath)
|
||||
readDirEnt (unpackDirStream -> dirp) =
|
||||
readDirEnt (DirStream dirp) =
|
||||
alloca $ \ptr_dEnt -> loop ptr_dEnt
|
||||
where
|
||||
loop ptr_dEnt = do
|
||||
@ -228,7 +214,7 @@ getDirectoryContents path =
|
||||
-- |Binding to @fdopendir(3)@.
|
||||
fdOpendir :: Posix.Fd -> IO DirStream
|
||||
fdOpendir fd =
|
||||
packDirStream <$> throwErrnoIfNull "fdOpendir" (c_fdopendir fd)
|
||||
DirStream <$> throwErrnoIfNull "fdOpendir" (c_fdopendir fd)
|
||||
|
||||
|
||||
-- |Like `getDirectoryContents` except for a file descriptor.
|
||||
|
31
unix/LICENSE
Normal file
31
unix/LICENSE
Normal file
@ -0,0 +1,31 @@
|
||||
The Glasgow Haskell Compiler License
|
||||
|
||||
Copyright 2004, The University Court of the University of Glasgow.
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
- Redistributions of source code must retain the above copyright notice,
|
||||
this list of conditions and the following disclaimer.
|
||||
|
||||
- Redistributions in binary form must reproduce the above copyright notice,
|
||||
this list of conditions and the following disclaimer in the documentation
|
||||
and/or other materials provided with the distribution.
|
||||
|
||||
- Neither name of the University nor the names of its contributors may be
|
||||
used to endorse or promote products derived from this software without
|
||||
specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
|
||||
GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
||||
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
||||
FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
||||
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
|
||||
DAMAGE.
|
15
unix/README.md
Normal file
15
unix/README.md
Normal file
@ -0,0 +1,15 @@
|
||||
The `unix` Package [![Hackage](https://img.shields.io/hackage/v/unix.svg)](https://hackage.haskell.org/package/unix) [![Build Status](https://travis-ci.org/haskell/unix.svg)](https://travis-ci.org/haskell/unix)
|
||||
==================
|
||||
|
||||
See [`unix` on Hackage](http://hackage.haskell.org/package/unix) for
|
||||
more information.
|
||||
|
||||
Installing from Git
|
||||
-------------------
|
||||
|
||||
To build this package using Cabal directly from Git, you must run
|
||||
`autoreconf -i` before the usual Cabal build steps (`cabal
|
||||
{configure,build,install}`). The program `autoreconf` is part of
|
||||
[GNU autoconf](http://www.gnu.org/software/autoconf/). There is no
|
||||
need to run the `configure` script: `cabal configure` will do this for
|
||||
you.
|
6
unix/Setup.hs
Normal file
6
unix/Setup.hs
Normal file
@ -0,0 +1,6 @@
|
||||
module Main (main) where
|
||||
|
||||
import Distribution.Simple
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMainWithHooks autoconfUserHooks
|
189
unix/System/Posix.hs
Normal file
189
unix/System/Posix.hs
Normal file
@ -0,0 +1,189 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE Safe #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : System.Posix
|
||||
-- Copyright : (c) The University of Glasgow 2002
|
||||
-- License : BSD-style (see the file libraries/base/LICENSE)
|
||||
--
|
||||
-- Maintainer : libraries@haskell.org
|
||||
-- Stability : provisional
|
||||
-- Portability : non-portable (requires POSIX)
|
||||
--
|
||||
-- <http://pubs.opengroup.org/onlinepubs/9699919799/ POSIX.1-2008> support
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module System.Posix (
|
||||
module System.Posix.Types,
|
||||
module System.Posix.Signals,
|
||||
module System.Posix.Directory,
|
||||
module System.Posix.Files,
|
||||
module System.Posix.Unistd,
|
||||
module System.Posix.IO,
|
||||
module System.Posix.Env,
|
||||
module System.Posix.Process,
|
||||
module System.Posix.Temp,
|
||||
module System.Posix.Terminal,
|
||||
module System.Posix.Time,
|
||||
module System.Posix.User,
|
||||
module System.Posix.Resource,
|
||||
module System.Posix.Semaphore,
|
||||
module System.Posix.SharedMem,
|
||||
module System.Posix.DynamicLinker,
|
||||
-- XXX 'Module' type clashes with GHC
|
||||
-- module System.Posix.DynamicLinker.Module
|
||||
) where
|
||||
|
||||
import System.Posix.Types
|
||||
import System.Posix.Signals
|
||||
import System.Posix.Directory
|
||||
import System.Posix.Files
|
||||
import System.Posix.Unistd
|
||||
import System.Posix.Process
|
||||
import System.Posix.IO
|
||||
import System.Posix.Env
|
||||
import System.Posix.Temp
|
||||
import System.Posix.Terminal
|
||||
import System.Posix.Time
|
||||
import System.Posix.User
|
||||
import System.Posix.Resource
|
||||
import System.Posix.Semaphore
|
||||
import System.Posix.SharedMem
|
||||
-- XXX: bad planning, we have two constructors called "Default"
|
||||
import System.Posix.DynamicLinker hiding (Default)
|
||||
--import System.Posix.DynamicLinker.Module
|
||||
|
||||
{- TODO
|
||||
|
||||
Here we detail our support for the IEEE Std 1003.1-2001 standard. For
|
||||
each header file defined by the standard, we categorise its
|
||||
functionality as
|
||||
|
||||
- "supported"
|
||||
|
||||
Full equivalent functionality is provided by the specified Haskell
|
||||
module.
|
||||
|
||||
- "unsupported" (functionality not provided by a Haskell module)
|
||||
|
||||
The functionality is not currently provided.
|
||||
|
||||
- "to be supported"
|
||||
|
||||
Currently unsupported, but support is planned for the future.
|
||||
|
||||
Exceptions are listed where appropriate.
|
||||
|
||||
Interfaces supported
|
||||
--------------------
|
||||
|
||||
unix package:
|
||||
|
||||
dirent.h System.Posix.Directory
|
||||
dlfcn.h System.Posix.DynamicLinker
|
||||
errno.h Foreign.C.Error
|
||||
fcntl.h System.Posix.IO
|
||||
signal.h System.Posix.Signals
|
||||
sys/stat.h System.Posix.Files
|
||||
sys/times.h System.Posix.Process
|
||||
sys/types.h System.Posix.Types (with exceptions...)
|
||||
sys/utsname.h System.Posix.Unistd
|
||||
sys/wait.h System.Posix.Process
|
||||
termios.h System.Posix.Terminal (check exceptions)
|
||||
unistd.h System.Posix.*
|
||||
utime.h System.Posix.Files
|
||||
pwd.h System.Posix.User
|
||||
grp.h System.Posix.User
|
||||
stdlib.h: System.Posix.Env (getenv()/setenv()/unsetenv())
|
||||
System.Posix.Temp (mkstemp())
|
||||
sys/resource.h: System.Posix.Resource (get/setrlimit() only)
|
||||
|
||||
regex-posix package:
|
||||
|
||||
regex.h Text.Regex.Posix
|
||||
|
||||
network package:
|
||||
|
||||
arpa/inet.h
|
||||
net/if.h
|
||||
netinet/in.h
|
||||
netinet/tcp.h
|
||||
sys/socket.h
|
||||
sys/un.h
|
||||
|
||||
To be supported
|
||||
---------------
|
||||
|
||||
limits.h (pathconf()/fpathconf() already done)
|
||||
poll.h
|
||||
sys/resource.h (getrusage(): use instead of times() for getProcessTimes?)
|
||||
sys/select.h
|
||||
sys/statvfs.h (?)
|
||||
sys/time.h (but maybe not the itimer?)
|
||||
time.h (System.Posix.Time)
|
||||
stdio.h (popen only: System.Posix.IO)
|
||||
sys/mman.h
|
||||
|
||||
Unsupported interfaces
|
||||
----------------------
|
||||
|
||||
aio.h
|
||||
assert.h
|
||||
complex.h
|
||||
cpio.h
|
||||
ctype.h
|
||||
fenv.h
|
||||
float.h
|
||||
fmtmsg.h
|
||||
fnmatch.h
|
||||
ftw.h
|
||||
glob.h
|
||||
iconv.h
|
||||
inttypes.h
|
||||
iso646.h
|
||||
langinfo.h
|
||||
libgen.h
|
||||
locale.h (see System.Locale)
|
||||
math.h
|
||||
monetary.h
|
||||
mqueue.h
|
||||
ndbm.h
|
||||
netdb.h
|
||||
nl_types.h
|
||||
pthread.h
|
||||
sched.h
|
||||
search.h
|
||||
semaphore.h
|
||||
setjmp.h
|
||||
spawn.h
|
||||
stdarg.h
|
||||
stdbool.h
|
||||
stddef.h
|
||||
stdint.h
|
||||
stdio.h except: popen()
|
||||
stdlib.h except: exit(): System.Posix.Process
|
||||
free()/malloc(): Foreign.Marshal.Alloc
|
||||
getenv()/setenv(): ?? System.Environment
|
||||
rand() etc.: System.Random
|
||||
string.h
|
||||
strings.h
|
||||
stropts.h
|
||||
sys/ipc.h
|
||||
sys/msg.h
|
||||
sys/sem.h
|
||||
sys/shm.h
|
||||
sys/timeb.h
|
||||
sys/uio.h
|
||||
syslog.h
|
||||
tar.h
|
||||
tgmath.h
|
||||
trace.h
|
||||
ucontext.h
|
||||
ulimit.h
|
||||
utmpx.h
|
||||
wchar.h
|
||||
wctype.h
|
||||
wordexp.h
|
||||
|
||||
-}
|
69
unix/System/Posix/ByteString.hs
Normal file
69
unix/System/Posix/ByteString.hs
Normal file
@ -0,0 +1,69 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE Safe #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : System.Posix.ByteString
|
||||
-- Copyright : (c) The University of Glasgow 2002
|
||||
-- License : BSD-style (see the file libraries/base/LICENSE)
|
||||
--
|
||||
-- Maintainer : libraries@haskell.org
|
||||
-- Stability : provisional
|
||||
-- Portability : non-portable (requires POSIX)
|
||||
--
|
||||
-- <http://pubs.opengroup.org/onlinepubs/9699919799/ POSIX.1-2008>
|
||||
-- support with 'ByteString' file paths and environment strings.
|
||||
--
|
||||
-- This module exports exactly the same API as "System.Posix", except
|
||||
-- that all file paths and environment strings are represented by
|
||||
-- 'ByteString' instead of 'String'. The "System.Posix" API
|
||||
-- implicitly translates all file paths and environment strings using
|
||||
-- the locale encoding, whereas this version of the API does no
|
||||
-- encoding or decoding and works directly in terms of raw bytes.
|
||||
--
|
||||
-- Note that if you do need to interpret file paths or environment
|
||||
-- strings as text, then some Unicode encoding or decoding should be
|
||||
-- applied first.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module System.Posix.ByteString (
|
||||
System.Posix.ByteString.FilePath.RawFilePath,
|
||||
module System.Posix.Types,
|
||||
module System.Posix.Signals,
|
||||
module System.Posix.Directory.ByteString,
|
||||
module System.Posix.Files.ByteString,
|
||||
module System.Posix.Unistd,
|
||||
module System.Posix.IO.ByteString,
|
||||
module System.Posix.Env.ByteString,
|
||||
module System.Posix.Process.ByteString,
|
||||
module System.Posix.Temp.ByteString,
|
||||
module System.Posix.Terminal.ByteString,
|
||||
module System.Posix.Time,
|
||||
module System.Posix.User,
|
||||
module System.Posix.Resource,
|
||||
module System.Posix.Semaphore,
|
||||
module System.Posix.SharedMem,
|
||||
module System.Posix.DynamicLinker.ByteString,
|
||||
-- XXX 'Module' type clashes with GHC
|
||||
-- module System.Posix.DynamicLinker.Module.ByteString
|
||||
) where
|
||||
|
||||
import System.Posix.ByteString.FilePath
|
||||
import System.Posix.Types
|
||||
import System.Posix.Signals
|
||||
import System.Posix.Directory.ByteString
|
||||
import System.Posix.Files.ByteString
|
||||
import System.Posix.Unistd
|
||||
import System.Posix.Process.ByteString
|
||||
import System.Posix.IO.ByteString
|
||||
import System.Posix.Env.ByteString
|
||||
import System.Posix.Temp.ByteString
|
||||
import System.Posix.Terminal.ByteString
|
||||
import System.Posix.Time
|
||||
import System.Posix.User
|
||||
import System.Posix.Resource
|
||||
import System.Posix.Semaphore
|
||||
import System.Posix.SharedMem
|
||||
-- XXX: bad planning, we have two constructors called "Default"
|
||||
import System.Posix.DynamicLinker.ByteString hiding (Default)
|
||||
--import System.Posix.DynamicLinker.Module.ByteString
|
127
unix/System/Posix/ByteString/FilePath.hsc
Normal file
127
unix/System/Posix/ByteString/FilePath.hsc
Normal file
@ -0,0 +1,127 @@
|
||||
#if __GLASGOW_HASKELL__ >= 709
|
||||
{-# LANGUAGE Safe #-}
|
||||
#else
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
#endif
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : System.Posix.ByteString.FilePath
|
||||
-- Copyright : (c) The University of Glasgow 2002
|
||||
-- License : BSD-style (see the file libraries/base/LICENSE)
|
||||
--
|
||||
-- Maintainer : libraries@haskell.org
|
||||
-- Stability : provisional
|
||||
-- Portability : non-portable (requires POSIX)
|
||||
--
|
||||
-- Internal stuff: support for ByteString FilePaths
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module System.Posix.ByteString.FilePath (
|
||||
RawFilePath, withFilePath, peekFilePath, peekFilePathLen,
|
||||
throwErrnoPathIfMinus1Retry,
|
||||
throwErrnoPathIfMinus1Retry_,
|
||||
throwErrnoPathIfNullRetry,
|
||||
throwErrnoPathIfRetry,
|
||||
throwErrnoPath,
|
||||
throwErrnoPathIf,
|
||||
throwErrnoPathIf_,
|
||||
throwErrnoPathIfNull,
|
||||
throwErrnoPathIfMinus1,
|
||||
throwErrnoPathIfMinus1_
|
||||
) where
|
||||
|
||||
import Foreign hiding ( void )
|
||||
import Foreign.C hiding (
|
||||
throwErrnoPath,
|
||||
throwErrnoPathIf,
|
||||
throwErrnoPathIf_,
|
||||
throwErrnoPathIfNull,
|
||||
throwErrnoPathIfMinus1,
|
||||
throwErrnoPathIfMinus1_ )
|
||||
|
||||
import Control.Monad
|
||||
import Data.ByteString
|
||||
import Data.ByteString.Char8 as BC
|
||||
import Prelude hiding (FilePath)
|
||||
|
||||
-- | A literal POSIX file path
|
||||
type RawFilePath = ByteString
|
||||
|
||||
withFilePath :: RawFilePath -> (CString -> IO a) -> IO a
|
||||
withFilePath = useAsCString
|
||||
|
||||
peekFilePath :: CString -> IO RawFilePath
|
||||
peekFilePath = packCString
|
||||
|
||||
peekFilePathLen :: CStringLen -> IO RawFilePath
|
||||
peekFilePathLen = packCStringLen
|
||||
|
||||
|
||||
throwErrnoPathIfMinus1Retry :: (Eq a, Num a)
|
||||
=> String -> RawFilePath -> IO a -> IO a
|
||||
throwErrnoPathIfMinus1Retry loc path f = do
|
||||
throwErrnoPathIfRetry (== -1) loc path f
|
||||
|
||||
throwErrnoPathIfMinus1Retry_ :: (Eq a, Num a)
|
||||
=> String -> RawFilePath -> IO a -> IO ()
|
||||
throwErrnoPathIfMinus1Retry_ loc path f =
|
||||
void $ throwErrnoPathIfRetry (== -1) loc path f
|
||||
|
||||
throwErrnoPathIfNullRetry :: String -> RawFilePath -> IO (Ptr a) -> IO (Ptr a)
|
||||
throwErrnoPathIfNullRetry loc path f =
|
||||
throwErrnoPathIfRetry (== nullPtr) loc path f
|
||||
|
||||
throwErrnoPathIfRetry :: (a -> Bool) -> String -> RawFilePath -> IO a -> IO a
|
||||
throwErrnoPathIfRetry pr loc rpath f =
|
||||
do
|
||||
res <- f
|
||||
if pr res
|
||||
then do
|
||||
err <- getErrno
|
||||
if err == eINTR
|
||||
then throwErrnoPathIfRetry pr loc rpath f
|
||||
else throwErrnoPath loc rpath
|
||||
else return res
|
||||
|
||||
-- | as 'throwErrno', but exceptions include the given path when appropriate.
|
||||
--
|
||||
throwErrnoPath :: String -> RawFilePath -> IO a
|
||||
throwErrnoPath loc path =
|
||||
do
|
||||
errno <- getErrno
|
||||
ioError (errnoToIOError loc errno Nothing (Just (BC.unpack path)))
|
||||
|
||||
-- | as 'throwErrnoIf', but exceptions include the given path when
|
||||
-- appropriate.
|
||||
--
|
||||
throwErrnoPathIf :: (a -> Bool) -> String -> RawFilePath -> IO a -> IO a
|
||||
throwErrnoPathIf cond loc path f =
|
||||
do
|
||||
res <- f
|
||||
if cond res then throwErrnoPath loc path else return res
|
||||
|
||||
-- | as 'throwErrnoIf_', but exceptions include the given path when
|
||||
-- appropriate.
|
||||
--
|
||||
throwErrnoPathIf_ :: (a -> Bool) -> String -> RawFilePath -> IO a -> IO ()
|
||||
throwErrnoPathIf_ cond loc path f = void $ throwErrnoPathIf cond loc path f
|
||||
|
||||
-- | as 'throwErrnoIfNull', but exceptions include the given path when
|
||||
-- appropriate.
|
||||
--
|
||||
throwErrnoPathIfNull :: String -> RawFilePath -> IO (Ptr a) -> IO (Ptr a)
|
||||
throwErrnoPathIfNull = throwErrnoPathIf (== nullPtr)
|
||||
|
||||
-- | as 'throwErrnoIfMinus1', but exceptions include the given path when
|
||||
-- appropriate.
|
||||
--
|
||||
throwErrnoPathIfMinus1 :: (Eq a, Num a) => String -> RawFilePath -> IO a -> IO a
|
||||
throwErrnoPathIfMinus1 = throwErrnoPathIf (== -1)
|
||||
|
||||
-- | as 'throwErrnoIfMinus1_', but exceptions include the given path when
|
||||
-- appropriate.
|
||||
--
|
||||
throwErrnoPathIfMinus1_ :: (Eq a, Num a) => String -> RawFilePath -> IO a -> IO ()
|
||||
throwErrnoPathIfMinus1_ = throwErrnoPathIf_ (== -1)
|
164
unix/System/Posix/Directory.hsc
Normal file
164
unix/System/Posix/Directory.hsc
Normal file
@ -0,0 +1,164 @@
|
||||
{-# LANGUAGE CApiFFI #-}
|
||||
{-# LANGUAGE NondecreasingIndentation #-}
|
||||
#if __GLASGOW_HASKELL__ >= 709
|
||||
{-# LANGUAGE Safe #-}
|
||||
#else
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
#endif
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : System.Posix.Directory
|
||||
-- Copyright : (c) The University of Glasgow 2002
|
||||
-- License : BSD-style (see the file libraries/base/LICENSE)
|
||||
--
|
||||
-- Maintainer : libraries@haskell.org
|
||||
-- Stability : provisional
|
||||
-- Portability : non-portable (requires POSIX)
|
||||
--
|
||||
-- String-based POSIX directory support
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
#include "HsUnix.h"
|
||||
|
||||
-- hack copied from System.Posix.Files
|
||||
#if !defined(PATH_MAX)
|
||||
# define PATH_MAX 4096
|
||||
#endif
|
||||
|
||||
module System.Posix.Directory (
|
||||
-- * Creating and removing directories
|
||||
createDirectory, removeDirectory,
|
||||
|
||||
-- * Reading directories
|
||||
DirStream,
|
||||
openDirStream,
|
||||
readDirStream,
|
||||
rewindDirStream,
|
||||
closeDirStream,
|
||||
DirStreamOffset,
|
||||
#ifdef HAVE_TELLDIR
|
||||
tellDirStream,
|
||||
#endif
|
||||
#ifdef HAVE_SEEKDIR
|
||||
seekDirStream,
|
||||
#endif
|
||||
|
||||
-- * The working dirctory
|
||||
getWorkingDirectory,
|
||||
changeWorkingDirectory,
|
||||
changeWorkingDirectoryFd,
|
||||
) where
|
||||
|
||||
import System.IO.Error
|
||||
import System.Posix.Error
|
||||
import System.Posix.Types
|
||||
import Foreign
|
||||
import Foreign.C
|
||||
|
||||
import System.Posix.Directory.Common
|
||||
import System.Posix.Internals (withFilePath, peekFilePath)
|
||||
|
||||
-- | @createDirectory dir mode@ calls @mkdir@ to
|
||||
-- create a new directory, @dir@, with permissions based on
|
||||
-- @mode@.
|
||||
createDirectory :: FilePath -> FileMode -> IO ()
|
||||
createDirectory name mode =
|
||||
withFilePath name $ \s ->
|
||||
throwErrnoPathIfMinus1Retry_ "createDirectory" name (c_mkdir s mode)
|
||||
-- POSIX doesn't allow mkdir() to return EINTR, but it does on
|
||||
-- OS X (#5184), so we need the Retry variant here.
|
||||
|
||||
foreign import ccall unsafe "mkdir"
|
||||
c_mkdir :: CString -> CMode -> IO CInt
|
||||
|
||||
-- | @openDirStream dir@ calls @opendir@ to obtain a
|
||||
-- directory stream for @dir@.
|
||||
openDirStream :: FilePath -> IO DirStream
|
||||
openDirStream name =
|
||||
withFilePath name $ \s -> do
|
||||
dirp <- throwErrnoPathIfNullRetry "openDirStream" name $ c_opendir s
|
||||
return (DirStream dirp)
|
||||
|
||||
foreign import capi unsafe "HsUnix.h opendir"
|
||||
c_opendir :: CString -> IO (Ptr CDir)
|
||||
|
||||
-- | @readDirStream dp@ calls @readdir@ to obtain the
|
||||
-- next directory entry (@struct dirent@) for the open directory
|
||||
-- stream @dp@, and returns the @d_name@ member of that
|
||||
-- structure.
|
||||
readDirStream :: DirStream -> IO FilePath
|
||||
readDirStream (DirStream dirp) =
|
||||
alloca $ \ptr_dEnt -> loop ptr_dEnt
|
||||
where
|
||||
loop ptr_dEnt = do
|
||||
resetErrno
|
||||
r <- c_readdir dirp ptr_dEnt
|
||||
if (r == 0)
|
||||
then do dEnt <- peek ptr_dEnt
|
||||
if (dEnt == nullPtr)
|
||||
then return []
|
||||
else do
|
||||
entry <- (d_name dEnt >>= peekFilePath)
|
||||
c_freeDirEnt dEnt
|
||||
return entry
|
||||
else do errno <- getErrno
|
||||
if (errno == eINTR) then loop ptr_dEnt else do
|
||||
let (Errno eo) = errno
|
||||
if (eo == 0)
|
||||
then return []
|
||||
else throwErrno "readDirStream"
|
||||
|
||||
-- traversing directories
|
||||
foreign import ccall unsafe "__hscore_readdir"
|
||||
c_readdir :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
|
||||
|
||||
foreign import ccall unsafe "__hscore_free_dirent"
|
||||
c_freeDirEnt :: Ptr CDirent -> IO ()
|
||||
|
||||
foreign import ccall unsafe "__hscore_d_name"
|
||||
d_name :: Ptr CDirent -> IO CString
|
||||
|
||||
|
||||
-- | @getWorkingDirectory@ calls @getcwd@ to obtain the name
|
||||
-- of the current working directory.
|
||||
getWorkingDirectory :: IO FilePath
|
||||
getWorkingDirectory = go (#const PATH_MAX)
|
||||
where
|
||||
go bytes = do
|
||||
r <- allocaBytes bytes $ \buf -> do
|
||||
buf' <- c_getcwd buf (fromIntegral bytes)
|
||||
if buf' /= nullPtr
|
||||
then do s <- peekFilePath buf
|
||||
return (Just s)
|
||||
else do errno <- getErrno
|
||||
if errno == eRANGE
|
||||
-- we use Nothing to indicate that we should
|
||||
-- try again with a bigger buffer
|
||||
then return Nothing
|
||||
else throwErrno "getWorkingDirectory"
|
||||
maybe (go (2 * bytes)) return r
|
||||
|
||||
foreign import ccall unsafe "getcwd"
|
||||
c_getcwd :: Ptr CChar -> CSize -> IO (Ptr CChar)
|
||||
|
||||
-- | @changeWorkingDirectory dir@ calls @chdir@ to change
|
||||
-- the current working directory to @dir@.
|
||||
changeWorkingDirectory :: FilePath -> IO ()
|
||||
changeWorkingDirectory path =
|
||||
modifyIOError (`ioeSetFileName` path) $
|
||||
withFilePath path $ \s ->
|
||||
throwErrnoIfMinus1Retry_ "changeWorkingDirectory" (c_chdir s)
|
||||
|
||||
foreign import ccall unsafe "chdir"
|
||||
c_chdir :: CString -> IO CInt
|
||||
|
||||
removeDirectory :: FilePath -> IO ()
|
||||
removeDirectory path =
|
||||
modifyIOError (`ioeSetFileName` path) $
|
||||
withFilePath path $ \s ->
|
||||
throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
|
||||
|
||||
foreign import ccall unsafe "rmdir"
|
||||
c_rmdir :: CString -> IO CInt
|
165
unix/System/Posix/Directory/ByteString.hsc
Normal file
165
unix/System/Posix/Directory/ByteString.hsc
Normal file
@ -0,0 +1,165 @@
|
||||
{-# LANGUAGE CApiFFI #-}
|
||||
{-# LANGUAGE NondecreasingIndentation #-}
|
||||
#if __GLASGOW_HASKELL__ >= 709
|
||||
{-# LANGUAGE Safe #-}
|
||||
#else
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
#endif
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : System.Posix.Directory.ByteString
|
||||
-- Copyright : (c) The University of Glasgow 2002
|
||||
-- License : BSD-style (see the file libraries/base/LICENSE)
|
||||
--
|
||||
-- Maintainer : libraries@haskell.org
|
||||
-- Stability : provisional
|
||||
-- Portability : non-portable (requires POSIX)
|
||||
--
|
||||
-- String-based POSIX directory support
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
#include "HsUnix.h"
|
||||
|
||||
-- hack copied from System.Posix.Files
|
||||
#if !defined(PATH_MAX)
|
||||
# define PATH_MAX 4096
|
||||
#endif
|
||||
|
||||
module System.Posix.Directory.ByteString (
|
||||
-- * Creating and removing directories
|
||||
createDirectory, removeDirectory,
|
||||
|
||||
-- * Reading directories
|
||||
DirStream,
|
||||
openDirStream,
|
||||
readDirStream,
|
||||
rewindDirStream,
|
||||
closeDirStream,
|
||||
DirStreamOffset,
|
||||
#ifdef HAVE_TELLDIR
|
||||
tellDirStream,
|
||||
#endif
|
||||
#ifdef HAVE_SEEKDIR
|
||||
seekDirStream,
|
||||
#endif
|
||||
|
||||
-- * The working directory
|
||||
getWorkingDirectory,
|
||||
changeWorkingDirectory,
|
||||
changeWorkingDirectoryFd,
|
||||
) where
|
||||
|
||||
import System.IO.Error
|
||||
import System.Posix.Types
|
||||
import Foreign
|
||||
import Foreign.C
|
||||
|
||||
import Data.ByteString.Char8 as BC
|
||||
|
||||
import System.Posix.Directory.Common
|
||||
import System.Posix.ByteString.FilePath
|
||||
|
||||
-- | @createDirectory dir mode@ calls @mkdir@ to
|
||||
-- create a new directory, @dir@, with permissions based on
|
||||
-- @mode@.
|
||||
createDirectory :: RawFilePath -> FileMode -> IO ()
|
||||
createDirectory name mode =
|
||||
withFilePath name $ \s ->
|
||||
throwErrnoPathIfMinus1Retry_ "createDirectory" name (c_mkdir s mode)
|
||||
-- POSIX doesn't allow mkdir() to return EINTR, but it does on
|
||||
-- OS X (#5184), so we need the Retry variant here.
|
||||
|
||||
foreign import ccall unsafe "mkdir"
|
||||
c_mkdir :: CString -> CMode -> IO CInt
|
||||
|
||||
-- | @openDirStream dir@ calls @opendir@ to obtain a
|
||||
-- directory stream for @dir@.
|
||||
openDirStream :: RawFilePath -> IO DirStream
|
||||
openDirStream name =
|
||||
withFilePath name $ \s -> do
|
||||
dirp <- throwErrnoPathIfNullRetry "openDirStream" name $ c_opendir s
|
||||
return (DirStream dirp)
|
||||
|
||||
foreign import capi unsafe "HsUnix.h opendir"
|
||||
c_opendir :: CString -> IO (Ptr CDir)
|
||||
|
||||
-- | @readDirStream dp@ calls @readdir@ to obtain the
|
||||
-- next directory entry (@struct dirent@) for the open directory
|
||||
-- stream @dp@, and returns the @d_name@ member of that
|
||||
-- structure.
|
||||
readDirStream :: DirStream -> IO RawFilePath
|
||||
readDirStream (DirStream dirp) =
|
||||
alloca $ \ptr_dEnt -> loop ptr_dEnt
|
||||
where
|
||||
loop ptr_dEnt = do
|
||||
resetErrno
|
||||
r <- c_readdir dirp ptr_dEnt
|
||||
if (r == 0)
|
||||
then do dEnt <- peek ptr_dEnt
|
||||
if (dEnt == nullPtr)
|
||||
then return BC.empty
|
||||
else do
|
||||
entry <- (d_name dEnt >>= peekFilePath)
|
||||
c_freeDirEnt dEnt
|
||||
return entry
|
||||
else do errno <- getErrno
|
||||
if (errno == eINTR) then loop ptr_dEnt else do
|
||||
let (Errno eo) = errno
|
||||
if (eo == 0)
|
||||
then return BC.empty
|
||||
else throwErrno "readDirStream"
|
||||
|
||||
-- traversing directories
|
||||
foreign import ccall unsafe "__hscore_readdir"
|
||||
c_readdir :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
|
||||
|
||||
foreign import ccall unsafe "__hscore_free_dirent"
|
||||
c_freeDirEnt :: Ptr CDirent -> IO ()
|
||||
|
||||
foreign import ccall unsafe "__hscore_d_name"
|
||||
d_name :: Ptr CDirent -> IO CString
|
||||
|
||||
|
||||
-- | @getWorkingDirectory@ calls @getcwd@ to obtain the name
|
||||
-- of the current working directory.
|
||||
getWorkingDirectory :: IO RawFilePath
|
||||
getWorkingDirectory = go (#const PATH_MAX)
|
||||
where
|
||||
go bytes = do
|
||||
r <- allocaBytes bytes $ \buf -> do
|
||||
buf' <- c_getcwd buf (fromIntegral bytes)
|
||||
if buf' /= nullPtr
|
||||
then do s <- peekFilePath buf
|
||||
return (Just s)
|
||||
else do errno <- getErrno
|
||||
if errno == eRANGE
|
||||
-- we use Nothing to indicate that we should
|
||||
-- try again with a bigger buffer
|
||||
then return Nothing
|
||||
else throwErrno "getWorkingDirectory"
|
||||
maybe (go (2 * bytes)) return r
|
||||
|
||||
foreign import ccall unsafe "getcwd"
|
||||
c_getcwd :: Ptr CChar -> CSize -> IO (Ptr CChar)
|
||||
|
||||
-- | @changeWorkingDirectory dir@ calls @chdir@ to change
|
||||
-- the current working directory to @dir@.
|
||||
changeWorkingDirectory :: RawFilePath -> IO ()
|
||||
changeWorkingDirectory path =
|
||||
modifyIOError (`ioeSetFileName` (BC.unpack path)) $
|
||||
withFilePath path $ \s ->
|
||||
throwErrnoIfMinus1Retry_ "changeWorkingDirectory" (c_chdir s)
|
||||
|
||||
foreign import ccall unsafe "chdir"
|
||||
c_chdir :: CString -> IO CInt
|
||||
|
||||
removeDirectory :: RawFilePath -> IO ()
|
||||
removeDirectory path =
|
||||
modifyIOError (`ioeSetFileName` BC.unpack path) $
|
||||
withFilePath path $ \s ->
|
||||
throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
|
||||
|
||||
foreign import ccall unsafe "rmdir"
|
||||
c_rmdir :: CString -> IO CInt
|
88
unix/System/Posix/Directory/Common.hsc
Normal file
88
unix/System/Posix/Directory/Common.hsc
Normal file
@ -0,0 +1,88 @@
|
||||
#if __GLASGOW_HASKELL__ >= 709
|
||||
{-# LANGUAGE Safe #-}
|
||||
#else
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
#endif
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : System.Posix.Directory.Common
|
||||
-- Copyright : (c) The University of Glasgow 2002
|
||||
-- License : BSD-style (see the file libraries/base/LICENSE)
|
||||
--
|
||||
-- Maintainer : libraries@haskell.org
|
||||
-- Stability : provisional
|
||||
-- Portability : non-portable (requires POSIX)
|
||||
--
|
||||
-- POSIX directory support
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
#include "HsUnix.h"
|
||||
|
||||
module System.Posix.Directory.Common (
|
||||
DirStream(..), CDir, CDirent, DirStreamOffset(..),
|
||||
rewindDirStream,
|
||||
closeDirStream,
|
||||
#ifdef HAVE_SEEKDIR
|
||||
seekDirStream,
|
||||
#endif
|
||||
#ifdef HAVE_TELLDIR
|
||||
tellDirStream,
|
||||
#endif
|
||||
changeWorkingDirectoryFd,
|
||||
) where
|
||||
|
||||
import System.Posix.Types
|
||||
import Foreign
|
||||
import Foreign.C
|
||||
|
||||
newtype DirStream = DirStream (Ptr CDir)
|
||||
|
||||
data {-# CTYPE "DIR" #-} CDir
|
||||
data {-# CTYPE "struct dirent" #-} CDirent
|
||||
|
||||
-- | @rewindDirStream dp@ calls @rewinddir@ to reposition
|
||||
-- the directory stream @dp@ at the beginning of the directory.
|
||||
rewindDirStream :: DirStream -> IO ()
|
||||
rewindDirStream (DirStream dirp) = c_rewinddir dirp
|
||||
|
||||
foreign import ccall unsafe "rewinddir"
|
||||
c_rewinddir :: Ptr CDir -> IO ()
|
||||
|
||||
-- | @closeDirStream dp@ calls @closedir@ to close
|
||||
-- the directory stream @dp@.
|
||||
closeDirStream :: DirStream -> IO ()
|
||||
closeDirStream (DirStream dirp) = do
|
||||
throwErrnoIfMinus1Retry_ "closeDirStream" (c_closedir dirp)
|
||||
|
||||
foreign import ccall unsafe "closedir"
|
||||
c_closedir :: Ptr CDir -> IO CInt
|
||||
|
||||
newtype DirStreamOffset = DirStreamOffset COff
|
||||
|
||||
#ifdef HAVE_SEEKDIR
|
||||
seekDirStream :: DirStream -> DirStreamOffset -> IO ()
|
||||
seekDirStream (DirStream dirp) (DirStreamOffset off) =
|
||||
c_seekdir dirp (fromIntegral off) -- TODO: check for CLong/COff overflow
|
||||
|
||||
foreign import ccall unsafe "seekdir"
|
||||
c_seekdir :: Ptr CDir -> CLong -> IO ()
|
||||
#endif
|
||||
|
||||
#ifdef HAVE_TELLDIR
|
||||
tellDirStream :: DirStream -> IO DirStreamOffset
|
||||
tellDirStream (DirStream dirp) = do
|
||||
off <- c_telldir dirp
|
||||
return (DirStreamOffset (fromIntegral off)) -- TODO: check for overflow
|
||||
|
||||
foreign import ccall unsafe "telldir"
|
||||
c_telldir :: Ptr CDir -> IO CLong
|
||||
#endif
|
||||
|
||||
changeWorkingDirectoryFd :: Fd -> IO ()
|
||||
changeWorkingDirectoryFd (Fd fd) =
|
||||
throwErrnoIfMinus1Retry_ "changeWorkingDirectoryFd" (c_fchdir fd)
|
||||
|
||||
foreign import ccall unsafe "fchdir"
|
||||
c_fchdir :: CInt -> IO CInt
|
72
unix/System/Posix/DynamicLinker.hsc
Normal file
72
unix/System/Posix/DynamicLinker.hsc
Normal file
@ -0,0 +1,72 @@
|
||||
#if __GLASGOW_HASKELL__ >= 709
|
||||
{-# LANGUAGE Safe #-}
|
||||
#else
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
#endif
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : System.Posix.DynamicLinker
|
||||
-- Copyright : (c) Volker Stolz <vs@foldr.org> 2003
|
||||
-- License : BSD-style (see the file libraries/base/LICENSE)
|
||||
--
|
||||
-- Maintainer : vs@foldr.org
|
||||
-- Stability : provisional
|
||||
-- Portability : non-portable (requires POSIX)
|
||||
--
|
||||
-- Dynamic linker support through dlopen()
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module System.Posix.DynamicLinker (
|
||||
|
||||
module System.Posix.DynamicLinker.Prim,
|
||||
dlopen,
|
||||
dlsym,
|
||||
dlerror,
|
||||
dlclose,
|
||||
withDL, withDL_,
|
||||
undl,
|
||||
)
|
||||
|
||||
-- Usage:
|
||||
-- ******
|
||||
--
|
||||
-- Let's assume you want to open a local shared library \'foo\' (.\/libfoo.so)
|
||||
-- offering a function
|
||||
-- @char \* mogrify (char\*,int)@
|
||||
-- and invoke @str = mogrify("test",1)@:
|
||||
--
|
||||
--
|
||||
-- type Fun = CString -> Int -> IO CString
|
||||
-- foreign import dynamic unsafe fun__ :: FunPtr Fun -> Fun
|
||||
--
|
||||
-- withDL "libfoo.so" [RTLD_NOW] \$ \\ mod -> do
|
||||
-- funptr <- dlsym mod "mogrify"
|
||||
-- let fun = fun__ funptr
|
||||
-- withCString "test" \$ \\ str -> do
|
||||
-- strptr <- fun str 1
|
||||
-- strstr <- peekCString strptr
|
||||
-- ...
|
||||
--
|
||||
|
||||
where
|
||||
|
||||
import System.Posix.DynamicLinker.Common
|
||||
import System.Posix.DynamicLinker.Prim
|
||||
|
||||
#include "HsUnix.h"
|
||||
|
||||
import Control.Exception ( bracket )
|
||||
import Control.Monad ( liftM )
|
||||
import Foreign
|
||||
import System.Posix.Internals ( withFilePath )
|
||||
|
||||
dlopen :: FilePath -> [RTLDFlags] -> IO DL
|
||||
dlopen path flags = do
|
||||
withFilePath path $ \ p -> do
|
||||
liftM DLHandle $ throwDLErrorIf "dlopen" (== nullPtr) $ c_dlopen p (packRTLDFlags flags)
|
||||
|
||||
withDL :: FilePath -> [RTLDFlags] -> (DL -> IO a) -> IO a
|
||||
withDL file flags f = bracket (dlopen file flags) (dlclose) f
|
||||
|
||||
withDL_ :: FilePath -> [RTLDFlags] -> (DL -> IO a) -> IO ()
|
||||
withDL_ file flags f = withDL file flags f >> return ()
|
73
unix/System/Posix/DynamicLinker/ByteString.hsc
Normal file
73
unix/System/Posix/DynamicLinker/ByteString.hsc
Normal file
@ -0,0 +1,73 @@
|
||||
#if __GLASGOW_HASKELL__ >= 709
|
||||
{-# LANGUAGE Safe #-}
|
||||
#else
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
#endif
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : System.Posix.DynamicLinker.ByteString
|
||||
-- Copyright : (c) Volker Stolz <vs@foldr.org> 2003
|
||||
-- License : BSD-style (see the file libraries/base/LICENSE)
|
||||
--
|
||||
-- Maintainer : vs@foldr.org
|
||||
-- Stability : provisional
|
||||
-- Portability : non-portable (requires POSIX)
|
||||
--
|
||||
-- Dynamic linker support through dlopen()
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module System.Posix.DynamicLinker.ByteString (
|
||||
|
||||
module System.Posix.DynamicLinker.Prim,
|
||||
dlopen,
|
||||
dlsym,
|
||||
dlerror,
|
||||
dlclose,
|
||||
withDL, withDL_,
|
||||
undl,
|
||||
)
|
||||
|
||||
-- Usage:
|
||||
-- ******
|
||||
--
|
||||
-- Let's assume you want to open a local shared library \'foo\' (.\/libfoo.so)
|
||||
-- offering a function
|
||||
-- @char \* mogrify (char\*,int)@
|
||||
-- and invoke @str = mogrify("test",1)@:
|
||||
--
|
||||
--
|
||||
-- type Fun = CString -> Int -> IO CString
|
||||
-- foreign import dynamic unsafe fun__ :: FunPtr Fun -> Fun
|
||||
--
|
||||
-- withDL "libfoo.so" [RTLD_NOW] \$ \\ mod -> do
|
||||
-- funptr <- dlsym mod "mogrify"
|
||||
-- let fun = fun__ funptr
|
||||
-- withCString "test" \$ \\ str -> do
|
||||
-- strptr <- fun str 1
|
||||
-- strstr <- peekCString strptr
|
||||
-- ...
|
||||
--
|
||||
|
||||
where
|
||||
|
||||
import System.Posix.DynamicLinker.Common
|
||||
import System.Posix.DynamicLinker.Prim
|
||||
|
||||
#include "HsUnix.h"
|
||||
|
||||
import Control.Exception ( bracket )
|
||||
import Control.Monad ( liftM )
|
||||
import Foreign
|
||||
import System.Posix.ByteString.FilePath
|
||||
|
||||
dlopen :: RawFilePath -> [RTLDFlags] -> IO DL
|
||||
dlopen path flags = do
|
||||
withFilePath path $ \ p -> do
|
||||
liftM DLHandle $ throwDLErrorIf "dlopen" (== nullPtr) $ c_dlopen p (packRTLDFlags flags)
|
||||
|
||||
withDL :: RawFilePath -> [RTLDFlags] -> (DL -> IO a) -> IO a
|
||||
withDL file flags f = bracket (dlopen file flags) (dlclose) f
|
||||
|
||||
withDL_ :: RawFilePath -> [RTLDFlags] -> (DL -> IO a) -> IO ()
|
||||
withDL_ file flags f = withDL file flags f >> return ()
|
92
unix/System/Posix/DynamicLinker/Common.hsc
Normal file
92
unix/System/Posix/DynamicLinker/Common.hsc
Normal file
@ -0,0 +1,92 @@
|
||||
#if __GLASGOW_HASKELL__ >= 709
|
||||
{-# LANGUAGE Safe #-}
|
||||
#else
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
#endif
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : System.Posix.DynamicLinker.Common
|
||||
-- Copyright : (c) Volker Stolz <vs@foldr.org> 2003
|
||||
-- License : BSD-style (see the file libraries/base/LICENSE)
|
||||
--
|
||||
-- Maintainer : vs@foldr.org
|
||||
-- Stability : provisional
|
||||
-- Portability : non-portable (requires POSIX)
|
||||
--
|
||||
-- Dynamic linker support through dlopen()
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module System.Posix.DynamicLinker.Common (
|
||||
|
||||
module System.Posix.DynamicLinker.Prim,
|
||||
dlsym,
|
||||
dlerror,
|
||||
dlclose,
|
||||
undl,
|
||||
throwDLErrorIf,
|
||||
Module(..)
|
||||
)
|
||||
|
||||
-- Usage:
|
||||
-- ******
|
||||
--
|
||||
-- Let's assume you want to open a local shared library \'foo\' (.\/libfoo.so)
|
||||
-- offering a function
|
||||
-- @char \* mogrify (char\*,int)@
|
||||
-- and invoke @str = mogrify("test",1)@:
|
||||
--
|
||||
--
|
||||
-- type Fun = CString -> Int -> IO CString
|
||||
-- foreign import dynamic unsafe fun__ :: FunPtr Fun -> Fun
|
||||
--
|
||||
-- withDL "libfoo.so" [RTLD_NOW] \$ \\ mod -> do
|
||||
-- funptr <- dlsym mod "mogrify"
|
||||
-- let fun = fun__ funptr
|
||||
-- withCString "test" \$ \\ str -> do
|
||||
-- strptr <- fun str 1
|
||||
-- strstr <- peekCString strptr
|
||||
-- ...
|
||||
--
|
||||
|
||||
where
|
||||
|
||||
#include "HsUnix.h"
|
||||
|
||||
import System.Posix.DynamicLinker.Prim
|
||||
import Foreign
|
||||
import Foreign.C
|
||||
|
||||
dlclose :: DL -> IO ()
|
||||
dlclose (DLHandle h) = throwDLErrorIf_ "dlclose" (/= 0) $ c_dlclose h
|
||||
dlclose h = error $ "dlclose: invalid argument" ++ (show h)
|
||||
|
||||
dlerror :: IO String
|
||||
dlerror = c_dlerror >>= peekCString
|
||||
|
||||
-- |'dlsym' returns the address binding of the symbol described in @symbol@,
|
||||
-- as it occurs in the shared object identified by @source@.
|
||||
|
||||
dlsym :: DL -> String -> IO (FunPtr a)
|
||||
dlsym source symbol = do
|
||||
withCAString symbol $ \ s -> do
|
||||
throwDLErrorIf "dlsym" (== nullFunPtr) $ c_dlsym (packDL source) s
|
||||
|
||||
-- |'undl' obtains the raw handle. You mustn't do something like
|
||||
-- @withDL mod flags $ liftM undl >>= \ p -> use p@
|
||||
|
||||
undl :: DL -> Ptr ()
|
||||
undl = packDL
|
||||
|
||||
throwDLErrorIf :: String -> (a -> Bool) -> IO a -> IO a
|
||||
throwDLErrorIf s p f = do
|
||||
r <- f
|
||||
if (p r)
|
||||
then dlerror >>= \ err -> ioError (userError ( s ++ ": " ++ err))
|
||||
else return r
|
||||
|
||||
throwDLErrorIf_ :: String -> (a -> Bool) -> IO a -> IO ()
|
||||
throwDLErrorIf_ s p f = throwDLErrorIf s p f >> return ()
|
||||
|
||||
-- abstract handle for dynamically loaded module (EXPORTED)
|
||||
--
|
||||
newtype Module = Module (Ptr ())
|
121
unix/System/Posix/DynamicLinker/Module.hsc
Normal file
121
unix/System/Posix/DynamicLinker/Module.hsc
Normal file
@ -0,0 +1,121 @@
|
||||
#if __GLASGOW_HASKELL__ >= 709
|
||||
{-# LANGUAGE Safe #-}
|
||||
#else
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
#endif
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : System.Posix.DynamicLinker.Module
|
||||
-- Copyright : (c) Volker Stolz <vs@foldr.org> 2003
|
||||
-- License : BSD-style (see the file libraries/base/LICENSE)
|
||||
--
|
||||
-- Maintainer : vs@foldr.org
|
||||
-- Stability : provisional
|
||||
-- Portability : non-portable (requires POSIX)
|
||||
--
|
||||
-- DLOpen support, old API
|
||||
-- Derived from GModule.chs by M.Weber & M.Chakravarty which is part of c2hs
|
||||
-- I left the API more or less the same, mostly the flags are different.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module System.Posix.DynamicLinker.Module (
|
||||
|
||||
-- Usage:
|
||||
-- ******
|
||||
--
|
||||
-- Let's assume you want to open a local shared library 'foo' (./libfoo.so)
|
||||
-- offering a function
|
||||
-- char * mogrify (char*,int)
|
||||
-- and invoke str = mogrify("test",1):
|
||||
--
|
||||
-- type Fun = CString -> Int -> IO CString
|
||||
-- foreign import dynamic unsafe fun__ :: FunPtr Fun -> Fun
|
||||
--
|
||||
-- withModule (Just ".") ("libfoo.so") [RTLD_NOW] $ \ mod -> do
|
||||
-- funptr <- moduleSymbol mod "mogrify"
|
||||
-- let fun = fun__ funptr
|
||||
-- withCString "test" $ \ str -> do
|
||||
-- strptr <- fun str 1
|
||||
-- strstr <- peekCString strptr
|
||||
-- ...
|
||||
|
||||
Module
|
||||
, moduleOpen -- :: String -> ModuleFlags -> IO Module
|
||||
, moduleSymbol -- :: Source -> String -> IO (FunPtr a)
|
||||
, moduleClose -- :: Module -> IO Bool
|
||||
, moduleError -- :: IO String
|
||||
, withModule -- :: Maybe String
|
||||
-- -> String
|
||||
-- -> [ModuleFlags ]
|
||||
-- -> (Module -> IO a)
|
||||
-- -> IO a
|
||||
, withModule_ -- :: Maybe String
|
||||
-- -> String
|
||||
-- -> [ModuleFlags]
|
||||
-- -> (Module -> IO a)
|
||||
-- -> IO ()
|
||||
)
|
||||
where
|
||||
|
||||
#include "HsUnix.h"
|
||||
|
||||
import System.Posix.DynamicLinker
|
||||
import System.Posix.DynamicLinker.Common
|
||||
import Foreign.Ptr ( Ptr, nullPtr, FunPtr )
|
||||
import System.Posix.Internals ( withFilePath )
|
||||
|
||||
unModule :: Module -> (Ptr ())
|
||||
unModule (Module adr) = adr
|
||||
|
||||
-- Opens a module (EXPORTED)
|
||||
--
|
||||
|
||||
moduleOpen :: String -> [RTLDFlags] -> IO Module
|
||||
moduleOpen file flags = do
|
||||
modPtr <- withFilePath file $ \ modAddr -> c_dlopen modAddr (packRTLDFlags flags)
|
||||
if (modPtr == nullPtr)
|
||||
then moduleError >>= \ err -> ioError (userError ("dlopen: " ++ err))
|
||||
else return $ Module modPtr
|
||||
|
||||
-- Gets a symbol pointer from a module (EXPORTED)
|
||||
--
|
||||
moduleSymbol :: Module -> String -> IO (FunPtr a)
|
||||
moduleSymbol file sym = dlsym (DLHandle (unModule file)) sym
|
||||
|
||||
-- Closes a module (EXPORTED)
|
||||
--
|
||||
moduleClose :: Module -> IO ()
|
||||
moduleClose file = dlclose (DLHandle (unModule file))
|
||||
|
||||
-- Gets a string describing the last module error (EXPORTED)
|
||||
--
|
||||
moduleError :: IO String
|
||||
moduleError = dlerror
|
||||
|
||||
|
||||
-- Convenience function, cares for module open- & closing
|
||||
-- additionally returns status of `moduleClose' (EXPORTED)
|
||||
--
|
||||
withModule :: Maybe String
|
||||
-> String
|
||||
-> [RTLDFlags]
|
||||
-> (Module -> IO a)
|
||||
-> IO a
|
||||
withModule mdir file flags p = do
|
||||
let modPath = case mdir of
|
||||
Nothing -> file
|
||||
Just dir -> dir ++ if ((head (reverse dir)) == '/')
|
||||
then file
|
||||
else ('/':file)
|
||||
modu <- moduleOpen modPath flags
|
||||
result <- p modu
|
||||
moduleClose modu
|
||||
return result
|
||||
|
||||
withModule_ :: Maybe String
|
||||
-> String
|
||||
-> [RTLDFlags]
|
||||
-> (Module -> IO a)
|
||||
-> IO ()
|
||||
withModule_ dir file flags p = withModule dir file flags p >>= \ _ -> return ()
|
79
unix/System/Posix/DynamicLinker/Module/ByteString.hsc
Normal file
79
unix/System/Posix/DynamicLinker/Module/ByteString.hsc
Normal file
@ -0,0 +1,79 @@
|
||||
#if __GLASGOW_HASKELL__ >= 709
|
||||
{-# LANGUAGE Safe #-}
|
||||
#else
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
#endif
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : System.Posix.DynamicLinker.Module.ByteString
|
||||
-- Copyright : (c) Volker Stolz <vs@foldr.org> 2003
|
||||
-- License : BSD-style (see the file libraries/base/LICENSE)
|
||||
--
|
||||
-- Maintainer : vs@foldr.org
|
||||
-- Stability : provisional
|
||||
-- Portability : non-portable (requires POSIX)
|
||||
--
|
||||
-- DLOpen support, old API
|
||||
-- Derived from GModule.chs by M.Weber & M.Chakravarty which is part of c2hs
|
||||
-- I left the API more or less the same, mostly the flags are different.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module System.Posix.DynamicLinker.Module.ByteString (
|
||||
|
||||
-- Usage:
|
||||
-- ******
|
||||
--
|
||||
-- Let's assume you want to open a local shared library 'foo' (./libfoo.so)
|
||||
-- offering a function
|
||||
-- char * mogrify (char*,int)
|
||||
-- and invoke str = mogrify("test",1):
|
||||
--
|
||||
-- type Fun = CString -> Int -> IO CString
|
||||
-- foreign import dynamic unsafe fun__ :: FunPtr Fun -> Fun
|
||||
--
|
||||
-- withModule (Just ".") ("libfoo.so") [RTLD_NOW] $ \ mod -> do
|
||||
-- funptr <- moduleSymbol mod "mogrify"
|
||||
-- let fun = fun__ funptr
|
||||
-- withCString "test" $ \ str -> do
|
||||
-- strptr <- fun str 1
|
||||
-- strstr <- peekCString strptr
|
||||
-- ...
|
||||
|
||||
Module
|
||||
, moduleOpen -- :: String -> ModuleFlags -> IO Module
|
||||
, moduleSymbol -- :: Source -> String -> IO (FunPtr a)
|
||||
, moduleClose -- :: Module -> IO Bool
|
||||
, moduleError -- :: IO String
|
||||
, withModule -- :: Maybe String
|
||||
-- -> String
|
||||
-- -> [ModuleFlags ]
|
||||
-- -> (Module -> IO a)
|
||||
-- -> IO a
|
||||
, withModule_ -- :: Maybe String
|
||||
-- -> String
|
||||
-- -> [ModuleFlags]
|
||||
-- -> (Module -> IO a)
|
||||
-- -> IO ()
|
||||
)
|
||||
where
|
||||
|
||||
#include "HsUnix.h"
|
||||
|
||||
import System.Posix.DynamicLinker.Module hiding (moduleOpen)
|
||||
import System.Posix.DynamicLinker.Prim
|
||||
import System.Posix.DynamicLinker.Common
|
||||
|
||||
import Foreign
|
||||
import System.Posix.ByteString.FilePath
|
||||
|
||||
-- Opens a module (EXPORTED)
|
||||
--
|
||||
|
||||
moduleOpen :: RawFilePath -> [RTLDFlags] -> IO Module
|
||||
moduleOpen file flags = do
|
||||
modPtr <- withFilePath file $ \ modAddr -> c_dlopen modAddr (packRTLDFlags flags)
|
||||
if (modPtr == nullPtr)
|
||||
then moduleError >>= \ err -> ioError (userError ("dlopen: " ++ err))
|
||||
else return $ Module modPtr
|
123
unix/System/Posix/DynamicLinker/Prim.hsc
Normal file
123
unix/System/Posix/DynamicLinker/Prim.hsc
Normal file
@ -0,0 +1,123 @@
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
#if __GLASGOW_HASKELL__ >= 709
|
||||
{-# OPTIONS_GHC -fno-warn-trustworthy-safe #-}
|
||||
#endif
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : System.Posix.DynamicLinker.Prim
|
||||
-- Copyright : (c) Volker Stolz <vs@foldr.org> 2003
|
||||
-- License : BSD-style (see the file libraries/base/LICENSE)
|
||||
--
|
||||
-- Maintainer : vs@foldr.org
|
||||
-- Stability : provisional
|
||||
-- Portability : non-portable (requires POSIX)
|
||||
--
|
||||
-- @dlopen(3)@ and friends
|
||||
-- Derived from @GModule.chs@ by M.Weber & M.Chakravarty which is part of c2hs.
|
||||
-- I left the API more or less the same, mostly the flags are different.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module System.Posix.DynamicLinker.Prim (
|
||||
-- * low level API
|
||||
c_dlopen,
|
||||
c_dlsym,
|
||||
c_dlerror,
|
||||
c_dlclose,
|
||||
-- dlAddr, -- XXX NYI
|
||||
haveRtldNext,
|
||||
haveRtldLocal,
|
||||
packRTLDFlags,
|
||||
RTLDFlags(..),
|
||||
packDL,
|
||||
DL(..),
|
||||
)
|
||||
|
||||
where
|
||||
|
||||
#include "HsUnix.h"
|
||||
|
||||
import Data.Bits ( (.|.) )
|
||||
import Foreign.Ptr ( Ptr, FunPtr, nullPtr )
|
||||
import Foreign.C.Types
|
||||
import Foreign.C.String ( CString )
|
||||
|
||||
|
||||
-- |On some hosts (e.g. SuSe and Ubuntu Linux) @RTLD_NEXT@ (and
|
||||
-- @RTLD_DEFAULT@) are not visible without setting the macro
|
||||
-- @_GNU_SOURCE@. Since we don\'t want to define this macro, you can use
|
||||
-- the function 'haveRtldNext' to check wether the flag `Next` is
|
||||
-- available. Ideally, this will be optimized by the compiler so that it
|
||||
-- should be as efficient as an @#ifdef@.
|
||||
--
|
||||
-- If you fail to test the flag and use it although it is undefined,
|
||||
-- 'packDL' will throw an error.
|
||||
|
||||
haveRtldNext :: Bool
|
||||
|
||||
#ifdef HAVE_RTLDNEXT
|
||||
haveRtldNext = True
|
||||
foreign import ccall unsafe "__hsunix_rtldNext" rtldNext :: Ptr a
|
||||
#else /* HAVE_RTLDNEXT */
|
||||
haveRtldNext = False
|
||||
#endif /* HAVE_RTLDNEXT */
|
||||
|
||||
#ifdef HAVE_RTLDDEFAULT
|
||||
foreign import ccall unsafe "__hsunix_rtldDefault" rtldDefault :: Ptr a
|
||||
#endif /* HAVE_RTLDDEFAULT */
|
||||
|
||||
haveRtldLocal :: Bool
|
||||
haveRtldLocal = True
|
||||
{-# DEPRECATED haveRtldLocal "defaults to True" #-}
|
||||
|
||||
|
||||
-- |Flags for 'System.Posix.DynamicLinker.dlopen'.
|
||||
|
||||
data RTLDFlags
|
||||
= RTLD_LAZY
|
||||
| RTLD_NOW
|
||||
| RTLD_GLOBAL
|
||||
| RTLD_LOCAL
|
||||
deriving (Show, Read)
|
||||
|
||||
foreign import ccall unsafe "dlopen" c_dlopen :: CString -> CInt -> IO (Ptr ())
|
||||
foreign import ccall unsafe "dlsym" c_dlsym :: Ptr () -> CString -> IO (FunPtr a)
|
||||
foreign import ccall unsafe "dlerror" c_dlerror :: IO CString
|
||||
foreign import ccall unsafe "dlclose" c_dlclose :: (Ptr ()) -> IO CInt
|
||||
|
||||
packRTLDFlags :: [RTLDFlags] -> CInt
|
||||
packRTLDFlags flags = foldl (\ s f -> (packRTLDFlag f) .|. s) 0 flags
|
||||
|
||||
packRTLDFlag :: RTLDFlags -> CInt
|
||||
packRTLDFlag RTLD_LAZY = #const RTLD_LAZY
|
||||
packRTLDFlag RTLD_NOW = #const RTLD_NOW
|
||||
packRTLDFlag RTLD_GLOBAL = #const RTLD_GLOBAL
|
||||
packRTLDFlag RTLD_LOCAL = #const RTLD_LOCAL
|
||||
|
||||
|
||||
-- |Flags for 'System.Posix.DynamicLinker.dlsym'. Notice that 'Next'
|
||||
-- might not be available on your particular platform! Use
|
||||
-- 'haveRtldNext'.
|
||||
--
|
||||
-- If 'RTLD_DEFAULT' is not defined on your platform, 'packDL' 'Default'
|
||||
-- reduces to 'nullPtr'.
|
||||
|
||||
data DL = Null | Next | Default | DLHandle (Ptr ()) deriving (Show)
|
||||
|
||||
packDL :: DL -> Ptr ()
|
||||
packDL Null = nullPtr
|
||||
|
||||
#ifdef HAVE_RTLDNEXT
|
||||
packDL Next = rtldNext
|
||||
#else
|
||||
packDL Next = error "RTLD_NEXT not available"
|
||||
#endif
|
||||
|
||||
#ifdef HAVE_RTLDDEFAULT
|
||||
packDL Default = rtldDefault
|
||||
#else
|
||||
packDL Default = nullPtr
|
||||
#endif
|
||||
|
||||
packDL (DLHandle h) = h
|
205
unix/System/Posix/Env.hsc
Normal file
205
unix/System/Posix/Env.hsc
Normal file
@ -0,0 +1,205 @@
|
||||
{-# LANGUAGE CApiFFI #-}
|
||||
#if __GLASGOW_HASKELL__ >= 709
|
||||
{-# LANGUAGE Safe #-}
|
||||
#else
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
#endif
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : System.Posix.Env
|
||||
-- Copyright : (c) The University of Glasgow 2002
|
||||
-- License : BSD-style (see the file libraries/base/LICENSE)
|
||||
--
|
||||
-- Maintainer : libraries@haskell.org
|
||||
-- Stability : provisional
|
||||
-- Portability : non-portable (requires POSIX)
|
||||
--
|
||||
-- POSIX environment support
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module System.Posix.Env (
|
||||
getEnv
|
||||
, getEnvDefault
|
||||
, getEnvironmentPrim
|
||||
, getEnvironment
|
||||
, setEnvironment
|
||||
, putEnv
|
||||
, setEnv
|
||||
, unsetEnv
|
||||
, clearEnv
|
||||
) where
|
||||
|
||||
#include "HsUnix.h"
|
||||
|
||||
import Foreign.C.Error (throwErrnoIfMinus1_)
|
||||
import Foreign.C.Types
|
||||
import Foreign.C.String
|
||||
import Foreign.Marshal.Array
|
||||
import Foreign.Ptr
|
||||
import Foreign.Storable
|
||||
import Control.Monad
|
||||
import Data.Maybe (fromMaybe)
|
||||
import System.Posix.Internals
|
||||
|
||||
#if !MIN_VERSION_base(4,7,0)
|
||||
-- needed for backported local 'newFilePath' binding in 'putEnv'
|
||||
import GHC.IO.Encoding (getFileSystemEncoding)
|
||||
import qualified GHC.Foreign as GHC (newCString)
|
||||
#endif
|
||||
|
||||
-- |'getEnv' looks up a variable in the environment.
|
||||
|
||||
getEnv ::
|
||||
String {- ^ variable name -} ->
|
||||
IO (Maybe String) {- ^ variable value -}
|
||||
getEnv name = do
|
||||
litstring <- withFilePath name c_getenv
|
||||
if litstring /= nullPtr
|
||||
then liftM Just $ peekFilePath litstring
|
||||
else return Nothing
|
||||
|
||||
-- |'getEnvDefault' is a wrapper around 'getEnv' where the
|
||||
-- programmer can specify a fallback if the variable is not found
|
||||
-- in the environment.
|
||||
|
||||
getEnvDefault ::
|
||||
String {- ^ variable name -} ->
|
||||
String {- ^ fallback value -} ->
|
||||
IO String {- ^ variable value or fallback value -}
|
||||
getEnvDefault name fallback = liftM (fromMaybe fallback) (getEnv name)
|
||||
|
||||
foreign import ccall unsafe "getenv"
|
||||
c_getenv :: CString -> IO CString
|
||||
|
||||
getEnvironmentPrim :: IO [String]
|
||||
getEnvironmentPrim = do
|
||||
c_environ <- getCEnviron
|
||||
-- environ can be NULL
|
||||
if c_environ == nullPtr
|
||||
then return []
|
||||
else do
|
||||
arr <- peekArray0 nullPtr c_environ
|
||||
mapM peekFilePath arr
|
||||
|
||||
getCEnviron :: IO (Ptr CString)
|
||||
#if HAVE__NSGETENVIRON
|
||||
-- You should not access @char **environ@ directly on Darwin in a bundle/shared library.
|
||||
-- See #2458 and http://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man7/environ.7.html
|
||||
getCEnviron = nsGetEnviron >>= peek
|
||||
|
||||
foreign import ccall unsafe "_NSGetEnviron"
|
||||
nsGetEnviron :: IO (Ptr (Ptr CString))
|
||||
#else
|
||||
getCEnviron = peek c_environ_p
|
||||
foreign import ccall unsafe "&environ"
|
||||
c_environ_p :: Ptr (Ptr CString)
|
||||
#endif
|
||||
|
||||
-- |'getEnvironment' retrieves the entire environment as a
|
||||
-- list of @(key,value)@ pairs.
|
||||
|
||||
getEnvironment :: IO [(String,String)] {- ^ @[(key,value)]@ -}
|
||||
getEnvironment = do
|
||||
env <- getEnvironmentPrim
|
||||
return $ map (dropEq.(break ((==) '='))) env
|
||||
where
|
||||
dropEq (x,'=':ys) = (x,ys)
|
||||
dropEq (x,_) = error $ "getEnvironment: insane variable " ++ x
|
||||
|
||||
-- |'setEnvironment' resets the entire environment to the given list of
|
||||
-- @(key,value)@ pairs.
|
||||
|
||||
setEnvironment ::
|
||||
[(String,String)] {- ^ @[(key,value)]@ -} ->
|
||||
IO ()
|
||||
setEnvironment env = do
|
||||
clearEnv
|
||||
forM_ env $ \(key,value) ->
|
||||
setEnv key value True {-overwrite-}
|
||||
|
||||
-- |The 'unsetEnv' function deletes all instances of the variable name
|
||||
-- from the environment.
|
||||
|
||||
unsetEnv :: String {- ^ variable name -} -> IO ()
|
||||
#if HAVE_UNSETENV
|
||||
# if !UNSETENV_RETURNS_VOID
|
||||
unsetEnv name = withFilePath name $ \ s ->
|
||||
throwErrnoIfMinus1_ "unsetenv" (c_unsetenv s)
|
||||
|
||||
-- POSIX.1-2001 compliant unsetenv(3)
|
||||
foreign import capi unsafe "HsUnix.h unsetenv"
|
||||
c_unsetenv :: CString -> IO CInt
|
||||
# else
|
||||
unsetEnv name = withFilePath name c_unsetenv
|
||||
|
||||
-- pre-POSIX unsetenv(3) returning @void@
|
||||
foreign import capi unsafe "HsUnix.h unsetenv"
|
||||
c_unsetenv :: CString -> IO ()
|
||||
# endif
|
||||
#else
|
||||
unsetEnv name = putEnv (name ++ "=")
|
||||
#endif
|
||||
|
||||
-- |'putEnv' function takes an argument of the form @name=value@
|
||||
-- and is equivalent to @setEnv(key,value,True{-overwrite-})@.
|
||||
|
||||
putEnv :: String {- ^ "key=value" -} -> IO ()
|
||||
putEnv keyvalue = do s <- newFilePath keyvalue
|
||||
-- Do not free `s` after calling putenv.
|
||||
-- According to SUSv2, the string passed to putenv
|
||||
-- becomes part of the environment. #7342
|
||||
throwErrnoIfMinus1_ "putenv" (c_putenv s)
|
||||
#if !MIN_VERSION_base(4,7,0)
|
||||
where
|
||||
newFilePath :: FilePath -> IO CString
|
||||
newFilePath fp = getFileSystemEncoding >>= \enc -> GHC.newCString enc fp
|
||||
#endif
|
||||
|
||||
foreign import ccall unsafe "putenv"
|
||||
c_putenv :: CString -> IO CInt
|
||||
|
||||
{- |The 'setEnv' function inserts or resets the environment variable name in
|
||||
the current environment list. If the variable @name@ does not exist in the
|
||||