1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
-- It seems that on FreeBSD (and also other BSD systems),
-- /proc is not mounted by default
{-
symbolic links to the executable:
Linux:
/proc/<pid>/exe
Solaris: (Solaris 10 only???)
/proc/<pid>/object/a.out (filename only)
/proc/<pid>/path/a.out (complete pathname)
*BSD:
/proc/<pid>/exe (NetBSD >= 4.0?)
/proc/<pid>/file (not a symbolic link?)
-}
{-# LANGUAGE ForeignFunctionInterface #-}
module System.Environment.Executable.BSD
( getExecutablePath
, getPID
)
where
import Data.Bits
import Data.Word
import Data.Int
import Control.Monad
import Foreign
import Foreign.C
import System.Posix
import System.Directory
--import System.FilePath
--------------------------------------------------------------------------------
getPID :: IO Int
getPID = liftM fromIntegral $ getProcessID
getExecutablePath :: IO FilePath
getExecutablePath = do
try1 <- getExecutablePathProcFS
case try1 of
Just path -> return path
Nothing -> do
try2 <- getExecutablePathUnderscoreFallback
case try2 of
Just path -> return path
Nothing -> error "getExecutablePath/BSD: unable to obtain the path"
-- Tries procfs. However, procfs is not always mounted on BSD systems... :(
getExecutablePathProcFS :: IO (Maybe FilePath)
getExecutablePathProcFS = do
-- since NetBSD 4.0, allegedly there is a symbolic link
-- "/proc/PID/exe", at least when procfs is mounted at all...
try1 <- getExecutablePathProcFS' "exe"
case try1 of
Just _ -> return try1
Nothing -> getExecutablePathProcFS' "file"
-- eg. @getExecutablePathProcFS "exe"@
getExecutablePathProcFS' :: FilePath -> IO (Maybe FilePath)
getExecutablePathProcFS' symlink = do
pid <- getPID
let procPid = "/proc/" ++ show pid ++ "/" ++ symlink
fileExist procPid >>= \b -> if b
then getSymbolicLinkStatus procPid >>= \s -> if isSymbolicLink s
then liftM Just $ readSymbolicLink procPid
else return Nothing
else return Nothing
-- this is an unreliable fallback trying to
-- get the environment variable named "_".
getExecutablePathUnderscoreFallback :: IO (Maybe FilePath)
getExecutablePathUnderscoreFallback = do
mp <- getEnv "_"
case mp of
Nothing -> return mp
Just p -> do
q <- canonicalizePath p
return (Just q)
--------------------------------------------------------------------------------
|
