Commit 59fdb0f5 authored by Fraser Tweedale's avatar Fraser Tweedale Committed by Ben Gamari

getExecutablePath: get path from sysctl on FreeBSD

(cherry picked from commit d35cec7a)
parent 406a1383
......@@ -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
......@@ -131,6 +139,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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment