diff options
author | Fraser Tweedale <frase@frase.id.au> | 2021-01-10 17:15:38 +1000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-07-06 13:36:46 -0400 |
commit | 4b4c5e43ab40d277f18af86db049223fdf55fa59 (patch) | |
tree | 7192f2a2837409e355cf6d40b2d28c1157978473 | |
parent | 9b1d9cbfa7a1beecc4125e35562f542b30ee4f2e (diff) | |
download | haskell-4b4c5e43ab40d277f18af86db049223fdf55fa59.tar.gz |
Implement improved "get executable path" query
System.Environment.getExecutablePath has some problems:
- Some system-specific implementations throw an exception in some
scenarios, e.g. when the executable file has been deleted
- The Linux implementation succeeds but returns an invalid FilePath
when the file has been deleted.
- The fallback implementation returns argv[0] which is not
necessarily an absolute path, and is subject to manipulation.
- The documentation does not explain any of this.
Breaking the getExecutablePath API or changing its behaviour is not
an appealing direction. So we will provide a new API.
There are two facets to the problem of querying the executable path:
1. Does the platform provide a reliable way to do it? This is
statically known.
2. If so, is there a valid answer, and what is it? This may vary,
even over the runtime of a single process.
Accordingly, the type of the new mechanism is:
Maybe (IO (Maybe FilePath))
This commit implements this mechanism, defining the query action for
FreeBSD, Linux, macOS and Windows.
Fixes: #10957
Fixes: #12377
-rw-r--r-- | libraries/base/System/Environment.hs | 1 | ||||
-rw-r--r-- | libraries/base/System/Environment/ExecutablePath.hsc | 66 | ||||
-rw-r--r-- | libraries/base/changelog.md | 3 |
3 files changed, 68 insertions, 2 deletions
diff --git a/libraries/base/System/Environment.hs b/libraries/base/System/Environment.hs index 5604ca2b03..44382acf45 100644 --- a/libraries/base/System/Environment.hs +++ b/libraries/base/System/Environment.hs @@ -19,6 +19,7 @@ module System.Environment ( getArgs, getProgName, + executablePath, getExecutablePath, getEnv, lookupEnv, 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 diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index ece5f77a75..5515227821 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -4,6 +4,9 @@ * Add explicitly bidirectional `pattern TypeRep` to `Type.Reflection`. + * Introduce `GHC.ExecutablePath.executablePath`, which is more robust than + `getExecutablePath` in cases when the executable has been deleted. + ## 4.16.0.0 *TBA* * Make it possible to promote `Natural`s and remove the separate `Nat` kind. |