diff options
Diffstat (limited to 'libraries/base/System/Environment/ExecutablePath.hsc')
| -rw-r--r-- | libraries/base/System/Environment/ExecutablePath.hsc | 66 |
1 files changed, 64 insertions, 2 deletions
diff --git a/libraries/base/System/Environment/ExecutablePath.hsc b/libraries/base/System/Environment/ExecutablePath.hsc index 59a3d624e8..6d8eac9b83 100644 --- a/libraries/base/System/Environment/ExecutablePath.hsc +++ b/libraries/base/System/Environment/ExecutablePath.hsc @@ -16,28 +16,36 @@ -- @since 4.6.0.0 ----------------------------------------------------------------------------- -module System.Environment.ExecutablePath ( getExecutablePath ) where +module System.Environment.ExecutablePath + ( getExecutablePath + , executablePath + ) where -- The imports are purposely kept completely disjoint to prevent edits -- to one OS implementation from breaking another. #if defined(darwin_HOST_OS) +import Control.Exception (catch, throw) import Data.Word import Foreign.C import Foreign.Marshal.Alloc import Foreign.Ptr import Foreign.Storable +import System.IO.Error (isDoesNotExistError) import System.Posix.Internals #elif defined(linux_HOST_OS) +import Data.List (isSuffixOf) import Foreign.C import Foreign.Marshal.Array import System.Posix.Internals #elif defined(freebsd_HOST_OS) +import Control.Exception (catch, throw) import Foreign.C import Foreign.Marshal.Alloc import Foreign.Marshal.Array import Foreign.Ptr import Foreign.Storable +import System.IO.Error (isDoesNotExistError) import System.Posix.Internals #include <sys/types.h> #include <sys/sysctl.h> @@ -61,7 +69,9 @@ import System.Posix.Internals -- 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. +-- | 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.) @@ -70,9 +80,31 @@ import System.Posix.Internals -- 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 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.) +-- +-- @since 4.17.0.0 +executablePath :: Maybe (IO (Maybe FilePath)) + + -------------------------------------------------------------------------------- -- Mac OS X @@ -118,6 +150,12 @@ realpath path = getExecutablePath = _NSGetExecutablePath >>= realpath +-- realpath(3) fails with ENOENT file does not exist (e.g. was deleted) +executablePath = Just (fmap Just getExecutablePath `catch` f) + where + f e | isDoesNotExistError e = pure Nothing + | otherwise = throw e + -------------------------------------------------------------------------------- -- Linux @@ -140,6 +178,14 @@ readSymbolicLink file = getExecutablePath = readSymbolicLink $ "/proc/self/exe" +executablePath = Just (check <$> getExecutablePath) where + -- procfs(5): If the pathname has been unlinked, the symbolic link will + -- contain the string '(deleted)' appended to the original pathname. + -- + -- See also https://gitlab.haskell.org/ghc/ghc/-/issues/10957 + check s | "(deleted)" `isSuffixOf` s = Nothing + | otherwise = Just s + -------------------------------------------------------------------------------- -- FreeBSD @@ -178,6 +224,16 @@ getExecutablePath = do , -1 -- current process ] +executablePath = Just (fmap Just getExecutablePath `catch` f) + where + -- The sysctl fails with errno ENOENT when executable has been deleted; + -- see https://gitlab.haskell.org/ghc/ghc/-/issues/12377#note_321346. + f e | isDoesNotExistError e = pure Nothing + + -- As far as I know, ENOENT is the only kind of failure that should be + -- expected and handled. Re-throw other errors. + | otherwise = throw e + -------------------------------------------------------------------------------- -- Windows @@ -207,6 +263,10 @@ getExecutablePath = go 2048 -- plenty, PATH_MAX is 512 under Win32 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. @@ -294,6 +354,8 @@ getExecutablePath = where msg = "no OS specific implementation and program name couldn't be " ++ "found in argv" +executablePath = Nothing + -------------------------------------------------------------------------------- #endif |