{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CPP #-}
module Distribution.Client.Compat.ExecutablePath ( getExecutablePath ) where
import Prelude
#if defined(darwin_HOST_OS)
import Data.Word
import Foreign.C
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
import System.Posix.Internals
#elif defined(linux_HOST_OS)
import Foreign.C
import Foreign.Marshal.Array
import System.Posix.Internals
#elif defined(mingw32_HOST_OS)
import Data.Word
import Foreign.C
import Foreign.Marshal.Array
import Foreign.Ptr
import System.Posix.Internals
#else
import Foreign.C
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
import System.Posix.Internals
#endif
getExecutablePath :: IO FilePath
#if defined(darwin_HOST_OS)
type UInt32 = Word32
foreign import ccall unsafe "mach-o/dyld.h _NSGetExecutablePath"
c__NSGetExecutablePath :: CString -> Ptr UInt32 -> IO CInt
_NSGetExecutablePath :: IO FilePath
_NSGetExecutablePath =
allocaBytes 1024 $ \ buf ->
alloca $ \ bufsize -> do
poke bufsize 1024
status <- c__NSGetExecutablePath buf bufsize
if status == 0
then peekFilePath buf
else do reqBufsize <- fromIntegral `fmap` peek bufsize
allocaBytes reqBufsize $ \ newBuf -> do
status2 <- c__NSGetExecutablePath newBuf bufsize
if status2 == 0
then peekFilePath newBuf
else error "_NSGetExecutablePath: buffer too small"
foreign import ccall unsafe "stdlib.h realpath"
c_realpath :: CString -> CString -> IO CString
realpath :: FilePath -> IO FilePath
realpath path =
withFilePath path $ \ fileName ->
allocaBytes 1024 $ \ resolvedName -> do
_ <- throwErrnoIfNull "realpath" $ c_realpath fileName resolvedName
peekFilePath resolvedName
getExecutablePath = _NSGetExecutablePath >>= realpath
#elif defined(linux_HOST_OS)
foreign import ccall unsafe "readlink"
c_readlink :: CString -> CString -> CSize -> IO CInt
readSymbolicLink :: FilePath -> IO FilePath
readSymbolicLink :: FilePath -> IO FilePath
readSymbolicLink FilePath
file =
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray0 Int
4096 forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buf -> do
forall a. FilePath -> (Ptr CChar -> IO a) -> IO a
withFilePath FilePath
file forall a b. (a -> b) -> a -> b
$ \Ptr CChar
s -> do
CInt
len <- forall a. (Eq a, Num a) => FilePath -> FilePath -> IO a -> IO a
throwErrnoPathIfMinus1 FilePath
"readSymbolicLink" FilePath
file forall a b. (a -> b) -> a -> b
$
Ptr CChar -> Ptr CChar -> CSize -> IO CInt
c_readlink Ptr CChar
s Ptr CChar
buf CSize
4096
CStringLen -> IO FilePath
peekFilePathLen (Ptr CChar
buf,forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
len)
getExecutablePath :: IO FilePath
getExecutablePath = FilePath -> IO FilePath
readSymbolicLink forall a b. (a -> b) -> a -> b
$ FilePath
"/proc/self/exe"
#elif defined(mingw32_HOST_OS)
# if defined(i386_HOST_ARCH)
# define WINDOWS_CCONV stdcall
# elif defined(x86_64_HOST_ARCH)
# define WINDOWS_CCONV ccall
# else
# error Unknown mingw32 arch
# endif
foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW"
c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32
getExecutablePath = go 2048
where
go size = allocaArray (fromIntegral size) $ \ buf -> do
ret <- c_GetModuleFileName nullPtr buf size
case ret of
0 -> error "getExecutablePath: GetModuleFileNameW returned an error"
_ | ret < size -> peekFilePath buf
| otherwise -> go (size * 2)
#else
foreign import ccall unsafe "getFullProgArgv"
c_getFullProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
getExecutablePath =
alloca $ \ p_argc ->
alloca $ \ p_argv -> do
c_getFullProgArgv p_argc p_argv
argc <- peek p_argc
if argc > 0
then peek p_argv >>= peek >>= peekFilePath
else error $ "getExecutablePath: " ++ msg
where msg = "no OS specific implementation and program name couldn't be " ++
"found in argv"
#endif