executable-path 0.0.1 → 0.0.2

raw patch · 4 files changed

+94/−13 lines, 4 filesdep +directoryPVP ok

version bump matches the API change (PVP)

Dependencies added: directory

API changes (from Hackage documentation)

Files

• System/Environment/Executable.hs +1/−1
• System/Environment/Executable/BSD.hs +45/−7
• System/Environment/Executable/FreeBSD.hs +44/−1
• executable-path.cabal +4/−4

@@ -23,7 +23,7 @@   * FreeBSD (tested on FreeBSD 6.4) - * \*BSD (untested)+ * \*BSD (with procfs mounted, plus fallback for certain shells; untested)    * Solaris (untested, and probably works on Solaris 10 only)   

@@ -1,5 +1,6 @@ --- It seems that on FreeBSD, /proc is not mounted by default+-- It seems that on FreeBSD (and also other BSD systems), +-- /proc is not mounted by default  {- symbolic links to the executable:@@ -12,7 +13,8 @@ /proc/<pid>/path/a.out (complete pathname)  *BSD:-/proc/<pid>/file+/proc/<pid>/exe (NetBSD >= 4.0?)+/proc/<pid>/file (not a symbolic link?) -}  {-# LANGUAGE ForeignFunctionInterface #-}@@ -33,6 +35,7 @@ import Foreign.C  import System.Posix+import System.Directory --import System.FilePath  --------------------------------------------------------------------------------@@ -42,11 +45,46 @@  getExecutablePath :: IO FilePath getExecutablePath = do-  pid <- getPID-  fname <- readSymbolicLink $ "/proc/" ++ show pid ++ "/file"-  --let (path,exename) = splitFileName fname-  --return path-  return fname+  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)+            --------------------------------------------------------------------------------   

@@ -23,6 +23,7 @@ import Foreign.C  import System.Posix+import System.Directory  -------------------------------------------------------------------------------- @@ -139,10 +140,52 @@ getPID :: IO Int getPID = liftM fromIntegral $ getProcessID +{- getExecutablePathProcFS :: IO FilePath getExecutablePathProcFS = do   pid <- getPID-  fname <- readSymbolicLink $ "/proc/" ++ show pid ++ "/file"+  let procPid = "/proc/" ++ show pid ++ "/file"+  fname <- readSymbolicLink procPid   return fname+-} +getExecutablePathProcFS :: IO FilePath+getExecutablePathProcFS = do+  try1 <- getExecutablePathProcFS' "file"+  case try1 of+    Just xx -> return xx+    Nothing -> do+      try2 <- getExecutablePathUnderscoreFallback+      case try2 of+        Just yy -> return yy+        Nothing -> error "getExecutablePath/FreeBSD: unable to obtain the path"+      +-- eg. @getExecutablePathProcFS "file"@+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+ --------------------------------------------------------------------------------++-- even more fallback, if for some reason procfs doesn't work+      +-- 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)  ++--------------------------------------------------------------------------------++

@@ -1,5 +1,5 @@ Name:                executable-path-Version:             0.0.1+Version:             0.0.2 Synopsis:            Finding out the full path of the executable.  Description:         The documentation of "System.Environment.getProgName" says that@@ -26,7 +26,7 @@  Library   if flag(splitBase)-    Build-Depends:       base >= 3 && < 5 , filepath+    Build-Depends:       base >= 3 && < 5 , filepath    else     Build-Depends:       base >= 2 && < 3     @@ -47,11 +47,11 @@     Other-Modules:       System.Environment.Executable.Linux        if os(freebsd) -    Build-Depends:       unix+    Build-Depends:       unix, directory     Other-Modules:       System.Environment.Executable.FreeBSD    if os(openbsd) || os(netbsd)-    Build-Depends:       unix+    Build-Depends:       unix, directory     Other-Modules:       System.Environment.Executable.BSD    if os(solaris)