summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFraser Tweedale <frase@frase.id.au>2019-06-25 12:17:30 +1000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-06-27 10:45:01 -0400
commitd35cec7a9c07a0fc3b40e45d64e5794c3567a523 (patch)
treefbc00c3115f4d395c8fc4db617a261089cb31b28
parent90e0ab7d80d88463df97bc3514fc89d2ab9fcfca (diff)
downloadhaskell-d35cec7a9c07a0fc3b40e45d64e5794c3567a523.tar.gz
getExecutablePath: get path from sysctl on FreeBSD
-rw-r--r--libraries/base/System/Environment/ExecutablePath.hsc47
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)