executable-path 0.0 → 0.0.1
raw patch · 4 files changed
+160/−5 lines, 4 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- System/Environment/Executable.hs +3/−1
- System/Environment/Executable/BSD.hs +1/−0
- System/Environment/Executable/FreeBSD.hs +148/−0
- executable-path.cabal +8/−4
System/Environment/Executable.hs view
@@ -21,6 +21,8 @@ * Linux + * FreeBSD (tested on FreeBSD 6.4)+ * \*BSD (untested) * Solaris (untested, and probably works on Solaris 10 only) @@ -66,7 +68,7 @@ #ifdef freebsd_HOST_OS #define SUPPORTED_OS-import System.Environment.Executable.BSD+import System.Environment.Executable.FreeBSD #endif #ifdef netbsd_HOST_OS
System/Environment/Executable/BSD.hs view
@@ -1,4 +1,5 @@ +-- It seems that on FreeBSD, /proc is not mounted by default {- symbolic links to the executable:
+ System/Environment/Executable/FreeBSD.hs view
@@ -0,0 +1,148 @@++-- | 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++--------------------------------------------------------------------------------++#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+ fname <- readSymbolicLink $ "/proc/" ++ show pid ++ "/file"+ return fname++--------------------------------------------------------------------------------
executable-path.cabal view
@@ -1,5 +1,5 @@ Name: executable-path-Version: 0.0+Version: 0.0.1 Synopsis: Finding out the full path of the executable. Description: The documentation of "System.Environment.getProgName" says that@@ -26,9 +26,9 @@ Library if flag(splitBase)- Build-Depends: base >=3, filepath+ Build-Depends: base >= 3 && < 5 , filepath else- Build-Depends: base < 3+ Build-Depends: base >= 2 && < 3 Exposed-Modules: System.Environment.Executable Extensions: ForeignFunctionInterface, CPP, EmptyDataDecls@@ -46,7 +46,11 @@ Build-Depends: unix Other-Modules: System.Environment.Executable.Linux - if os(freebsd) || os(openbsd) || os(netbsd)+ if os(freebsd) + Build-Depends: unix+ Other-Modules: System.Environment.Executable.FreeBSD++ if os(openbsd) || os(netbsd) Build-Depends: unix Other-Modules: System.Environment.Executable.BSD