1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CPP #-}
-- Copied verbatim from base-4.6.0.0. We can't simply import
-- System.Environment.getExecutablePath because we need compatibility with older
-- GHCs.
module Distribution.Client.Compat.ExecutablePath ( getExecutablePath ) where
-- The imports are purposely kept completely disjoint to prevent edits
-- to one OS implementation from breaking another.
#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
-- GHC 7.0.* compatibility. 'System.Posix.Internals' in base-4.3.* doesn't
-- provide 'peekFilePath' and 'peekFilePathLen'.
#if !MIN_VERSION_base(4,4,0)
#ifdef mingw32_HOST_OS
peekFilePath :: CWString -> IO FilePath
peekFilePath = peekCWString
#else
peekFilePath :: CString -> IO FilePath
peekFilePath = peekCString
peekFilePathLen :: CStringLen -> IO FilePath
peekFilePathLen = peekCStringLen
#endif
#endif
-- The exported function is defined outside any if-guard to make sure
-- every OS implements it with the same type.
-- | Returns the absolute pathname of the current executable.
--
-- Note that for scripts and interactive sessions, this is the path to
-- the interpreter (e.g. ghci.)
--
-- /Since: 4.6.0.0/
getExecutablePath :: IO FilePath
--------------------------------------------------------------------------------
-- Mac OS X
#if defined(darwin_HOST_OS)
type UInt32 = Word32
foreign import ccall unsafe "mach-o/dyld.h _NSGetExecutablePath"
c__NSGetExecutablePath :: CString -> Ptr UInt32 -> IO CInt
-- | Returns the path of the main executable. The path may be a
-- symbolic link and not the real file.
--
-- See dyld(3)
_NSGetExecutablePath :: IO FilePath
_NSGetExecutablePath =
allocaBytes 1024 $ \ buf -> -- PATH_MAX is 1024 on OS X
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
-- | Resolves all symbolic links, extra \/ characters, and references
-- to \/.\/ and \/..\/. Returns an absolute pathname.
--
-- See realpath(3)
realpath :: FilePath -> IO FilePath
realpath path =
withFilePath path $ \ fileName ->
allocaBytes 1024 $ \ resolvedName -> do
_ <- throwErrnoIfNull "realpath" $ c_realpath fileName resolvedName
peekFilePath resolvedName
getExecutablePath = _NSGetExecutablePath >>= realpath
--------------------------------------------------------------------------------
-- Linux
#elif defined(linux_HOST_OS)
foreign import ccall unsafe "readlink"
c_readlink :: CString -> CString -> CSize -> IO CInt
-- | Reads the @FilePath@ pointed to by the symbolic link and returns
-- it.
--
-- See readlink(2)
readSymbolicLink :: FilePath -> IO FilePath
readSymbolicLink file =
allocaArray0 4096 $ \buf -> do
withFilePath file $ \s -> do
len <- throwErrnoPathIfMinus1 "readSymbolicLink" file $
c_readlink s buf 4096
peekFilePathLen (buf,fromIntegral len)
getExecutablePath = readSymbolicLink $ "/proc/self/exe"
--------------------------------------------------------------------------------
-- Windows
#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 -- plenty, PATH_MAX is 512 under Win32
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)
--------------------------------------------------------------------------------
-- Fallback to argv[0]
#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
-- If argc > 0 then argv[0] is guaranteed by the standard
-- to be a pointer to a null-terminated string.
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
|
