Ticket #7029: 0001-Add-System.Environment.getExecutablePath.patch

File 0001-Add-System.Environment.getExecutablePath.patch, 7.5 KB (added by tibbe, 3 years ago)
  • System/Environment.hs

    From 25fde19d6d13d00652f5daa3f3690b4a294665d5 Mon Sep 17 00:00:00 2001
    From: Johan Tibell <[email protected]>
    Date: Mon, 25 Jun 2012 21:31:27 -0700
    Subject: [PATCH 1/1] Add System.Environment.getExecutablePath
    
    ---
     System/Environment.hs                 |   11 ++-
     System/Environment/ExecutablePath.hsc |  171 +++++++++++++++++++++++++++++++++
     base.cabal                            |    1 +
     3 files changed, 179 insertions(+), 4 deletions(-)
     create mode 100644 System/Environment/ExecutablePath.hsc
    
    diff --git a/System/Environment.hs b/System/Environment.hs
    index 7be95ad..1f33213 100644
    a b  
    1717
    1818module System.Environment
    1919    (
    20       getArgs,       -- :: IO [String]
    21       getProgName,   -- :: IO String
    22       getEnv,        -- :: String -> IO String
    23       lookupEnv,     -- :: String -> IO (Maybe String)
     20      getArgs,            -- :: IO [String]
     21      getProgName,        -- :: IO String
     22      getExecutablePath,  -- :: IO FilePath
     23      getEnv,             -- :: String -> IO String
     24      lookupEnv,          -- :: String -> IO (Maybe String)
    2425#ifndef __NHC__
    2526      withArgs,
    2627      withProgName,
    import System 
    6162  )
    6263#endif
    6364
     65import System.Environment.ExecutablePath
     66
    6467#ifdef mingw32_HOST_OS
    6568# if defined(i386_HOST_ARCH)
    6669#  define WINDOWS_CCONV stdcall
  • new file System/Environment/ExecutablePath.hsc

    diff --git a/System/Environment/ExecutablePath.hsc b/System/Environment/ExecutablePath.hsc
    new file mode 100644
    index 0000000..4e6438d
    - +  
     1{-# LANGUAGE Safe #-}
     2{-# LANGUAGE CPP, ForeignFunctionInterface #-}
     3
     4-----------------------------------------------------------------------------
     5-- |
     6-- Module      :  System.Environment.ExecutablePath
     7-- Copyright   :  (c) The University of Glasgow 2001
     8-- License     :  BSD-style (see the file libraries/base/LICENSE)
     9--
     10-- Maintainer  :  [email protected]
     11-- Stability   :  provisional
     12-- Portability :  portable
     13--
     14-- Function to retrieve the absolute filepath of the current executable.
     15--
     16-----------------------------------------------------------------------------
     17
     18module System.Environment.ExecutablePath ( getExecutablePath ) where
     19
     20-- The imports are purposely kept completely disjoint to prevent edits
     21-- to one OS implementation from breaking another.
     22
     23#if defined(darwin_HOST_OS)
     24import Data.Word
     25import Foreign.C
     26import Foreign.Marshal.Alloc
     27import Foreign.Ptr
     28import Foreign.Storable
     29import System.Posix.Internals
     30#elif defined(linux_HOST_OS)
     31import Foreign.C
     32import Foreign.Marshal.Array
     33import System.Posix.Internals
     34#elif defined(mingw32_HOST_OS)
     35import Foreign.C
     36import Foreign.Marshal.Array
     37import Foreign.Ptr
     38import System.Posix.Internals
     39#else
     40import Foreign.C
     41import Foreign.Marshal.Alloc
     42import Foreign.Ptr
     43import Foreign.Storable
     44import System.Posix.Internals
     45#endif
     46
     47-- The exported function is defined outside any if-guard to make sure
     48-- every OS implements it with the same type.
     49
     50-- | Returns the absolute pathname of the current executable.
     51--
     52-- Note that for scripts and interactive sessions, this is the path to
     53-- the interpreter (e.g. ghci.)
     54getExecutablePath :: IO FilePath
     55
     56--------------------------------------------------------------------------------
     57-- Mac OS X
     58
     59#if defined(darwin_HOST_OS)
     60
     61type UInt32 = Word32
     62
     63foreign import ccall unsafe "mach-o/dyld.h _NSGetExecutablePath"
     64    c__NSGetExecutablePath :: CString -> Ptr UInt32 -> IO CInt
     65
     66-- | Returns the path of the main executable. The path may be a
     67-- symbolic link and not the real file.
     68--
     69-- See dyld(3)
     70_NSGetExecutablePath :: IO FilePath
     71_NSGetExecutablePath =
     72    allocaBytes 1024 $ \ buf ->  -- PATH_MAX is 1024 on OS X
     73    alloca $ \ bufsize -> do
     74        poke bufsize 1024
     75        status <- c__NSGetExecutablePath buf bufsize
     76        if status == 0
     77            then peekFilePath buf
     78            else do reqBufsize <- fromIntegral `fmap` peek bufsize
     79                    allocaBytes reqBufsize $ \ newBuf -> do
     80                        status2 <- c__NSGetExecutablePath newBuf bufsize
     81                        if status2 == 0
     82                             then peekFilePath newBuf
     83                             else error "_NSGetExecutablePath: buffer too small"
     84
     85foreign import ccall unsafe "stdlib.h realpath"
     86    c_realpath :: CString -> CString -> IO CString
     87
     88-- | Resolves all symbolic links, extra \/ characters, and references
     89-- to \/.\/ and \/..\/. Returns an absolute pathname.
     90--
     91-- See realpath(3)
     92realpath :: FilePath -> IO FilePath
     93realpath path =
     94    withFilePath path $ \ fileName ->
     95    allocaBytes 1024 $ \ resolvedName -> do
     96        _ <- throwErrnoIfNull "realpath" $ c_realpath fileName resolvedName
     97        peekFilePath resolvedName
     98
     99getExecutablePath = _NSGetExecutablePath >>= realpath
     100
     101--------------------------------------------------------------------------------
     102-- Linux
     103
     104#elif defined(linux_HOST_OS)
     105
     106foreign import ccall unsafe "readlink"
     107    c_readlink :: CString -> CString -> CSize -> IO CInt
     108
     109-- | Reads the @FilePath@ pointed to by the symbolic link and returns
     110-- it.
     111--
     112-- See readlink(2)
     113readSymbolicLink :: FilePath -> IO FilePath
     114readSymbolicLink file =
     115    allocaArray0 4096 $ \buf -> do
     116        withFilePath file $ \s -> do
     117            len <- throwErrnoPathIfMinus1 "readSymbolicLink" file $
     118                   c_readlink s buf 4096
     119            peekFilePathLen (buf,fromIntegral len)
     120
     121getExecutablePath = readSymbolicLink $ "/proc/self/exe"
     122
     123--------------------------------------------------------------------------------
     124-- Windows
     125
     126#elif defined(mingw32_HOST_OS)
     127
     128# if defined(i386_HOST_ARCH)
     129#  define WINDOWS_CCONV stdcall
     130# elif defined(x86_64_HOST_ARCH)
     131#  define WINDOWS_CCONV ccall
     132# else
     133#  error Unknown mingw32 arch
     134# endif
     135
     136foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW"
     137    c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32
     138
     139getExecutablePath = go 2048  -- plenty, PATH_MAX is 512 under Win32
     140  where
     141    go size = allocaArray (fromIntegral size) $ \ buf -> do
     142        ret <- c_GetModuleFileName nullPtr buf size
     143        case ret of
     144            0 -> error "getExecutablePath: GetModuleFileNameW returned an error"
     145            _ | ret < size -> peekFilePath buf
     146              | otherwise  -> go (size * 2)
     147
     148--------------------------------------------------------------------------------
     149-- Fallback to argv[0]
     150
     151#else
     152
     153foreign import ccall unsafe "getFullProgArgv"
     154    c_getFullProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
     155
     156getExecutablePath =
     157    alloca $ \ p_argc ->
     158    alloca $ \ p_argv -> do
     159        c_getFullProgArgv p_argc p_argv
     160        argc <- peek p_argc
     161        if argc > 0
     162            -- If argc > 0 then argv[0] is guaranteed by the standard
     163            -- to be a pointer to a null-terminated string.
     164            then peek p_argv >>= peek >>= peekFilePath
     165            else error $ "getExecutablePath: " ++ msg
     166  where msg = "no OS specific implementation and program name couldn't be " ++
     167              "found in argv"
     168
     169--------------------------------------------------------------------------------
     170
     171#endif
  • base.cabal

    diff --git a/base.cabal b/base.cabal
    index 2147744..213dd4e 100644
    a b Library { 
    216216        Control.Monad.ST.Imp
    217217        Control.Monad.ST.Lazy.Imp
    218218        Foreign.ForeignPtr.Imp
     219        System.Environment.ExecutablePath
    219220    c-sources:
    220221        cbits/PrelIOUtils.c
    221222        cbits/WCsubst.c