{-# 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
#if !defined(javascript_HOST_ARCH)
  , executablePath
#endif
  ) where

#if defined(javascript_HOST_ARCH)

getExecutablePath :: IO FilePath
getExecutablePath = return "a.jsexe"

#else

-- The imports are purposely kept completely disjoint to prevent edits

-- to one OS implementation from breaking another.



{-# LINE 62 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-}
import Control.Exception
import Data.List (isPrefixOf)
import Data.Word
import Foreign.C
import Foreign.Marshal.Array
import Foreign.Ptr
import GHC.Windows



{-# LINE 78 "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,

-- or @argv[0]@ if the operating system does not provide a reliable

-- way query 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.

--

-- If the executable has been deleted, behaviour is ill-defined and

-- varies by operating system.  See 'executablePath' for a more

-- reliable way to query the current executable.

--

-- @since 4.6.0.0

getExecutablePath :: IO FilePath

-- | Get an action to query the absolute pathname of the current executable.

--

-- If the operating system provides a reliable way to determine the current

-- executable, return the query action, otherwise return @Nothing@.  The action

-- is defined on FreeBSD, Linux, MacOS, NetBSD, and Windows.

--

-- Even where the query action is defined, there may be situations where no

-- result is available, e.g. if the executable file was deleted while the

-- program is running.  Therefore the result of the query action is a @Maybe

-- FilePath@.

--

-- Note that for scripts and interactive sessions, the result is the path to

-- the interpreter (e.g. ghci.)

--

-- Note also that while most operating systems return @Nothing@ if the

-- executable file was deleted/unlinked, some (including NetBSD) return the

-- original path.

--

-- @since 4.17.0.0

executablePath :: Maybe (IO (Maybe FilePath))


--------------------------------------------------------------------------------

-- Mac OS X



{-# LINE 264 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-}


{-# LINE 268 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-}
#  define WINDOWS_CCONV ccall

{-# LINE 272 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-}

getExecutablePath :: IO FilePath
getExecutablePath = Word32 -> IO FilePath
go Word32
2048  -- plenty, PATH_MAX is 512 under Win32

  where
    go :: Word32 -> IO FilePath
go Word32
size = Int -> (Ptr CWchar -> IO FilePath) -> IO FilePath
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size) ((Ptr CWchar -> IO FilePath) -> IO FilePath)
-> (Ptr CWchar -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \ Ptr CWchar
buf -> do
        Word32
ret <- Ptr () -> Ptr CWchar -> Word32 -> IO Word32
c_GetModuleFileName Ptr ()
forall a. Ptr a
nullPtr Ptr CWchar
buf Word32
size
        case Word32
ret of
            Word32
0 -> FilePath -> IO FilePath
forall a. FilePath -> a
errorWithoutStackTrace FilePath
"getExecutablePath: GetModuleFileNameW returned an error"
            Word32
_ | Word32
ret Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
size -> do
                  FilePath
path <- Ptr CWchar -> IO FilePath
peekCWString Ptr CWchar
buf
                  FilePath
real <- FilePath -> IO FilePath
getFinalPath FilePath
path
                  Bool
exists <- FilePath -> (Ptr CWchar -> IO Bool) -> IO Bool
forall a. FilePath -> (Ptr CWchar -> IO a) -> IO a
withCWString FilePath
real Ptr CWchar -> IO Bool
c_pathFileExists
                  if Bool
exists
                    then FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
real
                    else FilePath -> IO FilePath
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
path
              | Bool
otherwise  -> Word32 -> IO FilePath
go (Word32
size Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
2)

-- Windows prevents deletion of executable file while program is running.

-- Therefore return @Just@ of the result.

executablePath :: Maybe (IO (Maybe FilePath))
executablePath = IO (Maybe FilePath) -> Maybe (IO (Maybe FilePath))
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> IO FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getExecutablePath)

-- | 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 :: FilePath -> IO FilePath
getFinalPath FilePath
path = FilePath -> (Ptr CWchar -> IO FilePath) -> IO FilePath
forall a. FilePath -> (Ptr CWchar -> IO a) -> IO a
withCWString FilePath
path ((Ptr CWchar -> IO FilePath) -> IO FilePath)
-> (Ptr CWchar -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \Ptr CWchar
s ->
  IO (Ptr ())
-> (Ptr () -> IO Bool) -> (Ptr () -> IO FilePath) -> IO FilePath
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Ptr CWchar -> IO (Ptr ())
createFile Ptr CWchar
s) Ptr () -> IO Bool
c_closeHandle ((Ptr () -> IO FilePath) -> IO FilePath)
-> (Ptr () -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \Ptr ()
h -> do
    let invalid :: Bool
invalid = Ptr ()
h Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
iNVALID_HANDLE_VALUE
    if Bool
invalid then FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
path else Ptr () -> Word32 -> IO FilePath
go Ptr ()
h Word32
bufSize

  where go :: Ptr () -> Word32 -> IO FilePath
go Ptr ()
h Word32
sz = Int -> (Ptr CWchar -> IO FilePath) -> IO FilePath
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sz) ((Ptr CWchar -> IO FilePath) -> IO FilePath)
-> (Ptr CWchar -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \Ptr CWchar
outPath -> do
          Word32
ret <- Ptr () -> Ptr CWchar -> Word32 -> Word32 -> IO Word32
c_getFinalPathHandle Ptr ()
h Ptr CWchar
outPath Word32
sz (Word32
8)
{-# LINE 308 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-}
          if Word32
ret Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
sz
            then FilePath -> FilePath
sanitize (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
rejectUNCPath (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CWchar -> IO FilePath
peekCWString Ptr CWchar
outPath
            else Ptr () -> Word32 -> IO FilePath
go Ptr ()
h (Word32
2 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
sz)

        sanitize :: FilePath -> FilePath
sanitize FilePath
s
          | FilePath
"\\\\?\\" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
s = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
4 FilePath
s
          | Bool
otherwise                = FilePath
s

        -- see https://gitlab.haskell.org/ghc/ghc/issues/14460

        rejectUNCPath :: FilePath -> FilePath
rejectUNCPath FilePath
s
          | FilePath
"\\\\?\\UNC\\" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
s = FilePath
path
          | Bool
otherwise                     = FilePath
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 :: Word32
bufSize = Word32
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 :: Ptr CWchar -> IO (Ptr ())
createFile Ptr CWchar
file =
  Ptr CWchar
-> Word32
-> Word32
-> Ptr ()
-> Word32
-> Word32
-> Ptr ()
-> IO (Ptr ())
c_createFile Ptr CWchar
file (Word32
2147483648)
{-# LINE 346 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-}
                    (Word32
1)
{-# LINE 347 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-}
                    Ptr ()
forall a. Ptr a
nullPtr
                    (Word32
3)
{-# LINE 349 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-}
                    (Word32
128)
{-# LINE 350 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-}
                    Ptr ()
forall a. Ptr a
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 384 "libraries\\base\\System\\Environment\\ExecutablePath.hsc" #-}

#endif