executable-path-0.0.3.1/0000755000000000000000000000000013064511215013110 5ustar0000000000000000executable-path-0.0.3.1/executable-path.cabal0000644000000000000000000000407713064511215017157 0ustar0000000000000000Name: executable-path Version: 0.0.3.1 Synopsis: Finding out the full path of the executable. Description: The documentation of "System.Environment.getProgName" says that \"However, this is hard-to-impossible to implement on some non-Unix OSes, so instead, for maximum portability, we just return the leafname of the program as invoked.\" This library tries to provide the missing path. Note: Since base 4.6.0.0, there is also a function "System.Environment.getExecutablePath". License: PublicDomain License-file: LICENSE Author: Balazs Komuves Maintainer: bkomuves (plus) hackage (at) gmail (dot) com Homepage: http://code.haskell.org/~bkomuves/ Stability: Experimental Category: System Tested-With: GHC == 6.12.3 Cabal-Version: >= 1.2 Build-Type: Simple Library Build-Depends: base >= 3 && < 5 , filepath if impl(ghc) cpp-options: -DWE_HAVE_GHC build-depends: directory Exposed-Modules: System.Environment.Executable Extensions: ForeignFunctionInterface, CPP, EmptyDataDecls Hs-Source-Dirs: . if os(darwin) Frameworks: CoreFoundation Other-Modules: System.Environment.Executable.MacOSX if os(windows) Extra-Libraries: kernel32 Other-Modules: System.Environment.Executable.Win32 if os(linux) Build-Depends: unix Other-Modules: System.Environment.Executable.Linux if os(freebsd) Build-Depends: unix, directory Other-Modules: System.Environment.Executable.FreeBSD if os(openbsd) || os(netbsd) Build-Depends: unix, directory Other-Modules: System.Environment.Executable.BSD if os(solaris) Build-Depends: unix Other-Modules: System.Environment.Executable.Solaris executable-path-0.0.3.1/LICENSE0000644000000000000000000000341013064511215014113 0ustar0000000000000000http://creativecommons.org/licenses/publicdomain/ ------------------------------------------------- Copyright-Only Dedication (based on United States law) or Public Domain Certification The person or persons who have associated work with this document (the "Dedicator" or "Certifier") hereby either (a) certifies that, to the best of his knowledge, the work of authorship identified is in the public domain of the country from which the work is published, or (b) hereby dedicates whatever copyright the dedicators holds in the work of authorship identified below (the "Work") to the public domain. A certifier, moreover, dedicates any copyright interest he may have in the associated work, and for these purposes, is described as a "dedicator" below. A certifier has taken reasonable steps to verify the copyright status of this work. Certifier recognizes that his good faith efforts may not shield him from liability if in fact the work certified is not in the public domain. Dedicator makes this dedication for the benefit of the public at large and to the detriment of the Dedicator's heirs and successors. Dedicator intends this dedication to be an overt act of relinquishment in perpetuity of all present and future rights under copyright law, whether vested or contingent, in the Work. Dedicator understands that such relinquishment of all rights includes the relinquishment of all rights to enforce (by lawsuit or otherwise) those copyrights in the Work. Dedicator recognizes that, once placed in the public domain, the Work may be freely reproduced, distributed, transmitted, used, modified, built upon, or otherwise exploited by anyone for any purpose, commercial or non-commercial, and in any way, including by methods that have not yet been invented or conceived. executable-path-0.0.3.1/Setup.lhs0000644000000000000000000000011613064511215014716 0ustar0000000000000000#! /usr/bin/env runhaskell > import Distribution.Simple > main = defaultMainexecutable-path-0.0.3.1/System/0000755000000000000000000000000013064511215014374 5ustar0000000000000000executable-path-0.0.3.1/System/Environment/0000755000000000000000000000000013064511215016700 5ustar0000000000000000executable-path-0.0.3.1/System/Environment/Executable.hs0000644000000000000000000000754613064511215021331 0ustar0000000000000000 {- | The documentation of "System.Environment.getProgName" says that \"However, this is hard-to-impossible to implement on some non-Unix OSes, so instead, for maximum portability, we just return the leafname of the program as invoked. Even then there are some differences between platforms: on Windows, for example, a program invoked as foo is probably really FOO.EXE, and that is what "getProgName" will return.\" This library tries to fix this issue. It also provides some platform-specific functions (most notably getting the path of the application bundle on OSX). Supported operating systems: * Win32 (tested on Windows 7) * Mac OS X * Linux * FreeBSD (tested on FreeBSD 6.4) * \*BSD (with procfs mounted, plus fallback for certain shells; untested) * Solaris (untested, and probably works on Solaris 10 only) -} {-# LANGUAGE CPP #-} module System.Environment.Executable ( getExecutablePath , splitExecutablePath #ifdef mingw32_HOST_OS , getModulePath #endif #ifdef darwin_HOST_OS , getApplicationBundlePath #endif #ifdef WE_HAVE_GHC , ScriptPath(..) , getScriptPath #endif ) where import Control.Monad (liftM) import System.FilePath (splitFileName) import System.Directory (canonicalizePath) import Data.Char (toLower) import Data.List (find,findIndex) #ifdef WE_HAVE_GHC import GHC.Environment #endif -------------------------------------------------------------------------------- #ifdef mingw32_HOST_OS #define SUPPORTED_OS import System.Environment.Executable.Win32 #endif #ifdef darwin_HOST_OS #define SUPPORTED_OS import System.Environment.Executable.MacOSX #endif #ifdef linux_HOST_OS #define SUPPORTED_OS import System.Environment.Executable.Linux #endif #ifdef freebsd_HOST_OS #define SUPPORTED_OS import System.Environment.Executable.FreeBSD #endif #ifdef netbsd_HOST_OS #define SUPPORTED_OS import System.Environment.Executable.BSD #endif #ifdef openbsd_HOST_OS #define SUPPORTED_OS import System.Environment.Executable.BSD #endif #ifdef solaris_HOST_OS #define SUPPORTED_OS import System.Environment.Executable.Solaris #endif -------------------------------------------------------------------------------- splitExecutablePath :: IO (FilePath,FilePath) splitExecutablePath = liftM splitFileName getExecutablePath -------------------------------------------------------------------------------- #ifndef SUPPORTED_OS {-# WARNING getExecutablePath "the host OS is not supported!" #-} getExecutablePath :: IO String getExecutablePath = error "host OS not supported" #endif -------------------------------------------------------------------------------- #ifdef WE_HAVE_GHC -- | An experimental hack which tries to figure out if the program -- was run with @runghc@ or @runhaskell@ or @ghci@, and then tries to find -- out the directory of the /source/ (or object file). -- -- GHC only. getScriptPath :: IO ScriptPath getScriptPath = do fargs <- getFullArgs exec <- getExecutablePath let (pt,fn) = splitFileName exec case fargs of [] -> return (Executable exec) _ -> case map toLower fn of #ifdef mingw32_HOST_OS "ghc.exe" -> do #else "ghc" -> do #endif case find f1 fargs of Just s -> do path <- canonicalizePath $ init (drop n1 s) return $ RunGHC path Nothing -> case findIndex f2 fargs of Just i -> return Interactive Nothing -> return (Executable exec) _ -> return (Executable exec) where f1 xs = take n1 xs == s1 s1 = ":set prog \"" n1 = length s1 f2 xs = xs == "--interactive" data ScriptPath = Executable FilePath -- ^ it was (probably) a proper compiled executable | RunGHC FilePath -- ^ it was a script run by runghc/runhaskell | Interactive -- ^ we are in GHCi deriving Show #endif -------------------------------------------------------------------------------- executable-path-0.0.3.1/System/Environment/Executable/0000755000000000000000000000000013064511215020761 5ustar0000000000000000executable-path-0.0.3.1/System/Environment/Executable/BSD.hs0000644000000000000000000000456713064511215021741 0ustar0000000000000000 -- It seems that on FreeBSD (and also other BSD systems), -- /proc is not mounted by default {- symbolic links to the executable: Linux: /proc//exe Solaris: (Solaris 10 only???) /proc//object/a.out (filename only) /proc//path/a.out (complete pathname) *BSD: /proc//exe (NetBSD >= 4.0?) /proc//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 as 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 Posix.fileExist procPid >>= \b -> if b then Posix.getSymbolicLinkStatus procPid >>= \s -> if Posix.isSymbolicLink s then liftM Just $ Posix.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) -------------------------------------------------------------------------------- executable-path-0.0.3.1/System/Environment/Executable/FreeBSD.hs0000644000000000000000000001255713064511215022541 0ustar0000000000000000 -- | This code uses @sysctl@ and @KERN_PROC_PATHNAME@, -- if we are on FreeBSD 6.0 or newer, and falls back to procfs -- on older FreeBSD-s. {-# LANGUAGE CPP, ForeignFunctionInterface #-} module System.Environment.Executable.FreeBSD ( getExecutablePath , getPID ) where import Data.Bits import Data.Word import Data.Int import Data.Char import Data.List import Control.Monad import Foreign import Foreign.C import System.Posix as Posix import System.Directory -------------------------------------------------------------------------------- #define CTL_KERN 1 #define KERN_PROC 14 #define KERN_PROC_PATHNAME 12 -- KERN_PROC_PATHNAME exists from FreeBSD 6.0 #define ENOMEM 12 #define KERN_OSTYPE 1 #define KERN_OSRELEASE 2 #define KERN_OSREV 3 -- KERN_OSREV gives back a totally random-looking -- number with a totally undocumented meaning, yeah, fuck that. #define KERN_VERSION 4 -------------------------------------------------------------------------------- -- the only data point is the string "6.4-RELEASE" -- yay for undocumented queries! -- not let's try to parse that parseOSRelease :: String -> Maybe (Int,Int) parseOSRelease text = if major /= "" && temp1 /= "" && minor /= "" && dot == '.' then Just (read major, read minor) else Nothing where (major,temp1) = span isDigit text (dot:temp2) = temp1 (minor,rest) = span isDigit temp2 getExecutablePath :: IO FilePath getExecutablePath = do {- osrev <- getKernInt KERN_OSREV ostype <- getKernString KERN_OSTYPE 256 kver <- getKernString KERN_VERSION 256 print osrev print ostype print kver -} osrel <- getKernString KERN_OSRELEASE 256 -- print osrel -- print $ parseOSRelease osrel case parseOSRelease osrel of Just (maj,_) -> if maj >= 6 then getExecutablePathSysCtl 256 else getExecutablePathProcFS Nothing -> getExecutablePathProcFS -------------------------------------------------------------------------------- -- int sysctl(int *name, u_int namelen, void *oldp, size_t *oldlenp, void *newp, size_t newlen); foreign import ccall "sys/sysctl.h sysctl" sysctl :: Ptr CInt -> CUInt -> Ptr a -> Ptr CSize -> Ptr a -> CSize -> IO CInt -- brrrrrrr... foreign import ccall "errno.h &errno" errno :: Ptr CInt getKernString :: CInt -> Int -> IO String getKernString what len = do allocaArray 2 $ \mib -> do pokeArray mib [ CTL_KERN, what ] alloca $ \buflen -> do poke buflen (fromIntegral len :: CSize) allocaBytes len $ \buf -> do sysctl mib 2 buf buflen nullPtr 0 peekCString buf getKernInt :: CInt -> IO CInt getKernInt what = do allocaArray 2 $ \mib -> do pokeArray mib [ CTL_KERN, what ] alloca $ \posrev -> do alloca $ \buflen -> do poke buflen (fromIntegral (sizeOf (undefined :: CInt)) :: CSize) sysctl mib 2 posrev buflen nullPtr 0 peek posrev getExecutablePathSysCtl :: Int -> IO FilePath getExecutablePathSysCtl size = do allocaArray 4 $ \mib -> do pokeArray mib [ CTL_KERN, KERN_PROC, KERN_PROC_PATHNAME, -1 ] -- @-1@ is current process (could be a PID) allocaBytes size $ \buf -> do alloca $ \buflen -> do poke buflen (fromIntegral size :: CSize) err <- sysctl mib 4 buf buflen nullPtr 0 case err of 0 -> peekCString buf -1 -> do errn <- peek errno case errn of ENOMEM -> getExecutablePathSysCtl (size*2) _ -> error "getExecutablePath: unknown system error" {- int mib[4]; mib[0] = CTL_KERN; mib[1] = KERN_PROC; mib[2] = KERN_PROC_PATHNAME; mib[3] = -1; char buf[1024]; size_t cb = sizeof(buf); sysctl(mib, 4, buf, &cb, NULL, 0); -} -------------------------------------------------------------------------------- -- procfs fallback for FreeBSD < 6.0 getPID :: IO Int getPID = liftM fromIntegral $ getProcessID {- getExecutablePathProcFS :: IO FilePath getExecutablePathProcFS = do pid <- getPID 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 Posix.fileExist procPid >>= \b -> if b then Posix.getSymbolicLinkStatus procPid >>= \s -> if Posix.isSymbolicLink s then liftM Just $ Posix.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) -------------------------------------------------------------------------------- executable-path-0.0.3.1/System/Environment/Executable/Linux.hs0000644000000000000000000000164313064511215022420 0ustar0000000000000000 {- symbolic links to the executable: Linux: /proc//exe Solaris: (Solaris 10 only???) /proc//object/a.out (filename only) /proc//path/a.out (complete pathname) *BSD: /proc//file -} {-# LANGUAGE ForeignFunctionInterface #-} module System.Environment.Executable.Linux ( 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.FilePath -------------------------------------------------------------------------------- getPID :: IO Int getPID = liftM fromIntegral $ getProcessID getExecutablePath :: IO FilePath getExecutablePath = do pid <- getPID fname <- readSymbolicLink $ "/proc/" ++ show pid ++ "/exe" --let (path,exename) = splitFileName fname --return path return fname -------------------------------------------------------------------------------- executable-path-0.0.3.1/System/Environment/Executable/MacOSX.hs0000644000000000000000000001040213064511215022404 0ustar0000000000000000 {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} module System.Environment.Executable.MacOSX ( getExecutablePath , getApplicationBundlePath ) where import Data.Bits import Data.Word import Data.Int import Control.Monad import Foreign import Foreign.C --import System.FilePath -------------------------------------------------------------------------------- type UInt8 = Word8 type UInt16 = Word16 type UInt32 = Word32 type UInt64 = Word64 type SInt8 = Int8 type SInt16 = Int16 type SInt32 = Int32 type SInt64 = Int64 type OSErr = SInt16 type OSStatus = SInt32 type Boolean = Bool type Float32 = Float type Float64 = Double type UniChar = Char type CFIndex = SInt32 type ItemCount = UInt32 type ByteCount = UInt32 data CFData data CFString data CFAllocator type CFDataRef = Ptr CFData type CFStringRef = Ptr CFString type CFAllocatorRef = Ptr CFAllocator -------------------------------------------------------------------------------- kCFAllocatorDefault :: CFAllocatorRef kCFAllocatorDefault = nullPtr osStatusString :: OSStatus -> String osStatusString osstatus = "OSStatus = " ++ show osstatus osStatusError :: OSStatus -> IO a osStatusError osstatus = fail $ osStatusString osstatus foreign import ccall unsafe "CFBase.h CFRelease" c_CFRelease :: Ptr a -> IO () foreign import ccall unsafe "CFString.h CFStringGetLength" c_CFStringGetLength :: CFStringRef -> IO CFIndex foreign import ccall unsafe "CFString.h CFStringGetCharactersPtr" c_CFStringGetCharactersPtr :: CFStringRef -> IO (Ptr UniChar) foreign import ccall unsafe "CFString.h CFStringGetCharacterAtIndex" c_CFStringGetCharacterAtIndex :: CFStringRef -> CFIndex -> IO UniChar foreign import ccall unsafe "CFString.h CFStringCreateWithCharacters" c_CFStringCreateWithCharacters :: CFAllocatorRef -> Ptr UniChar -> CFIndex -> IO CFStringRef -- | Manually releasing a CFString. releaseCFString :: CFStringRef -> IO () releaseCFString = c_CFRelease -- | Peeks a CFString. peekCFString :: CFStringRef -> IO String peekCFString cfstring = do n <- c_CFStringGetLength cfstring p <- c_CFStringGetCharactersPtr cfstring if p /= nullPtr then forM [0..n-1] $ \i -> peekElemOff p (fromIntegral i) else forM [0..n-1] $ \i -> c_CFStringGetCharacterAtIndex cfstring i -- | Creates a new CFString. You have to release it manually. newCFString :: String -> IO CFStringRef newCFString string = let n = length string in allocaArray n $ \p -> c_CFStringCreateWithCharacters kCFAllocatorDefault p (fromIntegral n) -- | Safe passing of a CFString to the OS (releases it afterwards). withCFString :: String -> (CFStringRef -> IO a) -> IO a withCFString string action = do cfstring <- newCFString string x <- action cfstring releaseCFString cfstring return x -------------------------------------------------------------------------------- data CFBundle type CFBundleRef = Ptr CFBundle data CFURL type CFURLRef = Ptr CFURL type OSXEnum = CInt -- ????????????? type CFURLPathStyle = OSXEnum foreign import ccall unsafe "CFBundle.h CFBundleGetMainBundle" c_CFBundleGetMainBundle :: IO CFBundleRef foreign import ccall unsafe "CFBundle.h CFBundleCopyBundleURL" c_CFBundleCopyBundleURL :: CFBundleRef -> IO CFURLRef foreign import ccall unsafe "CFBundle.h CFBundleCopyExecutableURL" c_CFBundleCopyExecutableURL :: CFBundleRef -> IO CFURLRef foreign import ccall unsafe "CFURL.h CFURLCopyFileSystemPath" c_CFURLCopyFileSystemPath :: CFURLRef -> CFURLPathStyle -> IO CFStringRef kCFURLPOSIXPathStyle = 0 :: CFURLPathStyle kCFURLHFSPathStyle = 1 :: CFURLPathStyle kCFURLWindowsPathStyle = 2 :: CFURLPathStyle -- | Mac OS X only. getApplicationBundlePath :: IO FilePath getApplicationBundlePath = do bundle <- c_CFBundleGetMainBundle url <- c_CFBundleCopyBundleURL bundle cfpath <- c_CFURLCopyFileSystemPath url kCFURLPOSIXPathStyle peekCFString cfpath getExecutablePath :: IO FilePath getExecutablePath = do bundle <- c_CFBundleGetMainBundle url <- c_CFBundleCopyExecutableURL bundle cfpath <- c_CFURLCopyFileSystemPath url kCFURLPOSIXPathStyle fname <- peekCFString cfpath -- let (path,exename) = splitFileName fname -- return path return fname -------------------------------------------------------------------------------- executable-path-0.0.3.1/System/Environment/Executable/Solaris.hs0000644000000000000000000000165213064511215022735 0ustar0000000000000000 {- symbolic links to the executable: Linux: /proc//exe Solaris: (Solaris 10 only???) /proc//object/a.out (filename only) /proc//path/a.out (complete pathname) *BSD: /proc//file -} {-# LANGUAGE ForeignFunctionInterface #-} module System.Environment.Executable.Solaris ( 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.FilePath -------------------------------------------------------------------------------- getPID :: IO Int getPID = liftM fromIntegral $ getProcessID getExecutablePath :: IO FilePath getExecutablePath = do pid <- getPID fname <- readSymbolicLink $ "/proc/" ++ show pid ++ "/path/a.out" --let (path,exename) = splitFileName fname --return path return fname -------------------------------------------------------------------------------- executable-path-0.0.3.1/System/Environment/Executable/Win32.hs0000644000000000000000000000256513064511215022227 0ustar0000000000000000 {-# LANGUAGE ForeignFunctionInterface #-} module System.Environment.Executable.Win32 ( getExecutablePath , getModulePath ) where import Data.Bits import Data.Word import Data.Int import Control.Monad import Foreign import Foreign.C import Foreign.Marshal --import System.Win32 --import System.Win32.DLL -------------------------------------------------------------------------------- foreign import stdcall unsafe "Windows.h GetModuleFileNameW" c_GetModuleFileNameW :: HMODULE -> Ptr CWchar -> Word32 -> IO Word32 type HMODULE = Ptr () getModulePath :: HMODULE -> IO FilePath getModulePath = getModulePath' 512 getModulePath' :: Word32 -> HMODULE -> IO FilePath getModulePath' size hmodule = do mpath <- allocaArray0 (fromIntegral size) $ \p -> do k <- c_GetModuleFileNameW hmodule p size case k of 0 -> error "getModulePath: unknown error" _ -> if k == size then return Nothing else liftM Just $ peekCWString p case mpath of Just path -> return path Nothing -> getModulePath' (2*size) hmodule {- -- | Returns the full path + name of the module. getModulePath :: HMODULE -> IO FilePath getModulePath hmodule = getModuleFileName hmodule -} getExecutablePath :: IO FilePath getExecutablePath = getModulePath nullPtr --------------------------------------------------------------------------------