{-# LINE 1 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\ExecutablePath.hsc" #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP #-}

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

-- |

-- Module      :  GHC.Internal.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 base-4.6.0.0

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


module GHC.Internal.System.Environment.ExecutablePath
  ( getExecutablePath
  , executablePath
  ) where

#if defined(javascript_HOST_ARCH)

import GHC.Internal.Base
import GHC.Internal.IO (FilePath)

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

executablePath :: Maybe (IO (Maybe FilePath))
executablePath = Nothing

#else

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

-- to one OS implementation from breaking another.


import GHC.Internal.Base
import GHC.Internal.IO (FilePath)
import GHC.Internal.Real

{-# LINE 86 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\ExecutablePath.hsc" #-}
import GHC.Internal.Control.Exception
import GHC.Internal.Control.Monad.Fail
import GHC.Internal.Data.Functor
import GHC.Internal.Data.List (isPrefixOf, drop)
import GHC.Internal.Word
import GHC.Internal.Foreign.C.String
import GHC.Internal.Foreign.Marshal.Array
import GHC.Internal.Foreign.Ptr
import GHC.Internal.Num
import GHC.Internal.Windows



{-# LINE 107 "libraries\\ghc-internal\\src\\GHC\\Internal\\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 base-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, Solaris, 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 base-4.17.0.0

executablePath :: Maybe (IO (Maybe FilePath))


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

-- Mac OS X



{-# LINE 306 "libraries\\ghc-internal\\src\\GHC\\Internal\\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)

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

-- Therefore return @Just@ of the result.

executablePath = Just (Just <$> 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 path = withCWString path $ \s ->
  bracket (createFile s) c_closeHandle $ \h -> do
    let invalid = h == iNVALID_HANDLE_VALUE
    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 342 "libraries\\ghc-internal\\src\\GHC\\Internal\\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://gitlab.haskell.org/ghc/ghc/issues/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 ccall unsafe "windows.h GetModuleFileNameW"
    c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32

foreign import ccall unsafe "windows.h PathFileExistsW"
    c_pathFileExists :: CWString -> IO Bool

foreign import ccall 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 380 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\ExecutablePath.hsc" #-}
                    (1)
{-# LINE 381 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\ExecutablePath.hsc" #-}
                    nullPtr
                    (3)
{-# LINE 383 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\ExecutablePath.hsc" #-}
                    (128)
{-# LINE 384 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\ExecutablePath.hsc" #-}
                    nullPtr

foreign import ccall unsafe "windows.h CloseHandle"
  c_closeHandle  :: Ptr () -> IO Bool

foreign import ccall unsafe "windows.h GetFinalPathNameByHandleW"
  c_getFinalPathHandle :: Ptr () -> CWString -> Word32 -> Word32 -> IO Word32

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

-- Fallback to argv[0]



{-# LINE 418 "libraries\\ghc-internal\\src\\GHC\\Internal\\System\\Environment\\ExecutablePath.hsc" #-}

#endif