diff options
author | Fraser Tweedale <frase@frase.id.au> | 2019-06-25 12:17:30 +1000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-06-27 10:45:01 -0400 |
commit | d35cec7a9c07a0fc3b40e45d64e5794c3567a523 (patch) | |
tree | fbc00c3115f4d395c8fc4db617a261089cb31b28 | |
parent | 90e0ab7d80d88463df97bc3514fc89d2ab9fcfca (diff) | |
download | haskell-d35cec7a9c07a0fc3b40e45d64e5794c3567a523.tar.gz |
getExecutablePath: get path from sysctl on FreeBSD
-rw-r--r-- | libraries/base/System/Environment/ExecutablePath.hsc | 47 |
1 files changed, 47 insertions, 0 deletions
diff --git a/libraries/base/System/Environment/ExecutablePath.hsc b/libraries/base/System/Environment/ExecutablePath.hsc index 2e213319bb..3c9d36cb88 100644 --- a/libraries/base/System/Environment/ExecutablePath.hsc +++ b/libraries/base/System/Environment/ExecutablePath.hsc @@ -32,6 +32,14 @@ import System.Posix.Internals import Foreign.C import Foreign.Marshal.Array import System.Posix.Internals +#elif defined(freebsd_HOST_OS) +import Foreign.C +import Foreign.Marshal.Alloc +import Foreign.Marshal.Array +import Foreign.Ptr +import Foreign.Storable +import System.Posix.Internals +#include <sys/sysctl.h> #elif defined(mingw32_HOST_OS) import Control.Exception import Data.List @@ -132,6 +140,45 @@ readSymbolicLink file = getExecutablePath = readSymbolicLink $ "/proc/self/exe" -------------------------------------------------------------------------------- +-- FreeBSD + +#elif defined(freebsd_HOST_OS) + +foreign import ccall unsafe "sysctl" + c_sysctl + :: Ptr CInt -- MIB + -> CUInt -- MIB size + -> Ptr CChar -- old / current value buffer + -> Ptr CSize -- old / current value buffer size + -> Ptr CChar -- new value + -> CSize -- new value size + -> IO CInt -- result + +getExecutablePath = do + withArrayLen mib $ \n mibPtr -> do + let mibLen = fromIntegral n + alloca $ \bufSizePtr -> do + status <- c_sysctl mibPtr mibLen nullPtr bufSizePtr nullPtr 0 + case status of + 0 -> do + reqBufSize <- fromIntegral <$> peek bufSizePtr + allocaBytes reqBufSize $ \buf -> do + newStatus <- c_sysctl mibPtr mibLen buf bufSizePtr nullPtr 0 + case newStatus of + 0 -> peekFilePath buf + _ -> barf + _ -> barf + where + barf = throwErrno "getExecutablePath" + mib = + [ (#const CTL_KERN) + , (#const KERN_PROC) + , (#const KERN_PROC_PATHNAME) + , -1 -- current process + ] + + +-------------------------------------------------------------------------------- -- Windows #elif defined(mingw32_HOST_OS) |