{-# LINE 1 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-} {-# LANGUAGE Safe #-} {-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : System.Environment.ExecutablePath -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable -- -- Function to retrieve the absolute filepath of the current executable. -- -- @since 4.6.0.0 ----------------------------------------------------------------------------- module System.Environment.ExecutablePath ( getExecutablePath ) where -- The imports are purposely kept completely disjoint to prevent edits -- to one OS implementation from breaking another. {-# LINE 36 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-} import Control.Exception import Data.List import Data.Word import Foreign.C import Foreign.Marshal.Array import Foreign.Ptr {-# LINE 51 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-} -- 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 base 4.11.0.0, 'getExecutablePath' resolves symlinks on Windows. -- If an executable is launched through a symlink, 'getExecutablePath' -- returns the absolute path of the original executable. -- -- @since 4.6.0.0 getExecutablePath :: IO FilePath -------------------------------------------------------------------------------- -- Mac OS X {-# LINE 138 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-} {-# LINE 142 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-} # define WINDOWS_CCONV ccall {-# LINE 146 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-} 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 -> errorWithoutStackTrace "getExecutablePath: GetModuleFileNameW returned an error" _ | ret < size -> do path <- peekCWString buf real <- getFinalPath path exists <- withCWString real c_pathFileExists if exists then return real else fail path | otherwise -> go (size * 2) -- | Returns the final path of the given path. If the given -- path is a symbolic link, the returned value is the -- path the (possibly chain of) symbolic link(s) points to. -- Otherwise, the original path is returned, even when the filepath -- is incorrect. -- -- Adapted from: -- https://msdn.microsoft.com/en-us/library/windows/desktop/aa364962.aspx getFinalPath :: FilePath -> IO FilePath getFinalPath path = withCWString path $ \s -> bracket (createFile s) c_closeHandle $ \h -> do let invalid = h == wordPtrToPtr (-1) {-# LINE 174 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-} if invalid then pure path else go h bufSize where go h sz = allocaArray (fromIntegral sz) $ \outPath -> do ret <- c_getFinalPathHandle h outPath sz (8) {-# LINE 178 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-} if ret < sz then sanitize . rejectUNCPath <$> peekCWString outPath else go h (2 * sz) sanitize s | "\\\\?\\" `isPrefixOf` s = drop 4 s | otherwise = s -- see https://ghc.haskell.org/trac/ghc/ticket/14460 rejectUNCPath s | "\\\\?\\UNC\\" `isPrefixOf` s = path | otherwise = s -- the initial size of the buffer in which we store the -- final path; if this is not enough, we try with a buffer of -- size 2^k * bufSize, for k = 1, 2, 3, ... until the buffer -- is large enough. bufSize = 1024 foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW" c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32 foreign import WINDOWS_CCONV unsafe "windows.h PathFileExistsW" c_pathFileExists :: CWString -> IO Bool foreign import WINDOWS_CCONV unsafe "windows.h CreateFileW" c_createFile :: CWString -> Word32 -> Word32 -> Ptr () -> Word32 -> Word32 -> Ptr () -> IO (Ptr ()) createFile :: CWString -> IO (Ptr ()) createFile file = c_createFile file (2147483648) {-# LINE 216 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-} (1) {-# LINE 217 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-} nullPtr (3) {-# LINE 219 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-} (128) {-# LINE 220 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-} nullPtr foreign import WINDOWS_CCONV unsafe "windows.h CloseHandle" c_closeHandle :: Ptr () -> IO Bool foreign import WINDOWS_CCONV unsafe "windows.h GetFinalPathNameByHandleW" c_getFinalPathHandle :: Ptr () -> CWString -> Word32 -> Word32 -> IO Word32 -------------------------------------------------------------------------------- -- Fallback to argv[0] {-# LINE 252 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-}