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

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

    From 25fde19d6d13d00652f5daa3f3690b4a294665d5 Mon Sep 17 00:00:00 2001
    From: Johan Tibell <johan.tibell@gmail.com>
    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  :  libraries@haskell.org 
     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