@@ -5,7 +5,7 @@ Copyright :
55License : BSD3
66Maintainer : The Idris Community.
77-}
8−{-# LANGUAGE ExistentialQuantification, CPP #-}
8+{-# LANGUAGE ExistentialQuantification, CPP, ScopedTypeVariables #-}
99module Util.DynamicLinker ( ForeignFun(..)
1010 , DynamicLib(..)
1111 , tryLoadLib
@@ -17,8 +17,13 @@ import Foreign.LibFFI
1717import Foreign.Ptr (Ptr(), nullPtr, FunPtr, nullFunPtr, castPtrToFunPtr)
1818import System.Directory
1919#ifndef mingw32_HOST_OS
20+import Control.Exception (try, IOException)
21+import Data.Array (Array, inRange, bounds, (!))
22+import Data.Functor ((<$>))
23+import Data.Maybe (catMaybes)
2024import System.Posix.DynamicLinker
2125import System.FilePath.Posix ((</>))
26+import Text.Regex.TDFA
2227#else
2328import qualified Control.Exception as Exception (catch, IOException)
2429import System.Win32.DLL
@@ -69,13 +74,69 @@ libFileName dirs lib = do let names = [lib, lib ++ "." ++ hostDynamicLibExt]
6974 return $ maybe (lib ++ "." ++ hostDynamicLibExt) id found
7075
7176#ifndef mingw32_HOST_OS
77+-- Load a dynamic library on POSIX systems.
78+-- In the simple case, we just find the appropriate filename and call dlopen().
79+-- In the complicated case our "foo.so" isn't actually a library. Some of the
80+-- .so files on modern Linux systems are linker scripts instead. dlopen()
81+-- doesn't know anything about those. We need to look inside the script for the
82+-- actual library path and load that. This is a horrible hack, the correct
83+-- method would be to actually parse the scripts and execute them. The approach
84+-- below is what GHC does.
7285tryLoadLib :: [FilePath] -> String -> IO (Maybe DynamicLib)
73−tryLoadLib dirs lib = do filename <- libFileName dirs lib
74− handle <- dlopen filename [RTLD_NOW, RTLD_GLOBAL]
75− if undl handle == nullPtr
76− then return Nothing
77− else return . Just $ Lib lib handle
86+tryLoadLib dirs lib = do
87+ filename <- libFileName dirs lib
88+ res :: Either IOException DL <- try $
89+ dlopen filename [RTLD_NOW, RTLD_GLOBAL]
90+ mbDL <- case res of
91+ Right handle -> return $ Just handle
92+#ifdef linux_HOST_OS
93+ Left ex ->
94+ -- dlopen failed, run a regex to see if the error message looks like it
95+ -- could be a linker script.
96+ case matchAllText invalidLibRegex (show ex) of
97+ (x:_) -> do
98+ if inRange (bounds x) 1
99+ then do
100+ -- filename above may be a relative path. Get the full path out of
101+ -- the error message.
102+ let realPath = fst $ x ! 1
103+ fileLines <- lines <$> readFile realPath
104+ -- Go down the linker script line by line looking for .so
105+ -- filenames and try each one.
106+ let matches = catMaybes $ map
107+ (getLastMatch . matchAllText linkerScriptRegex)
108+ fileLines
109+ mapMFirst (\f -> dlopen f [RTLD_NOW, RTLD_GLOBAL]) matches
110+ else return Nothing
111+ [] -> return Nothing
112+#else
113+ Left ex -> throwIO ex
114+#endif
115+ case mbDL of
116+ Just handle -> if undl handle == nullPtr
117+ then return Nothing
118+ else return . Just $ Lib lib handle
119+ Nothing -> return Nothing
120+
121+getLastMatch :: [MatchText String] -> Maybe String
122+getLastMatch [] = Nothing
123+getLastMatch (x:_) = case bounds x of
124+ (low, high) -> if low > high
125+ then Nothing
126+ else Just $ fst $ x ! high
127+
128+mapMFirst :: (a -> IO b) -> [a] -> IO (Maybe b)
129+mapMFirst f [] = return Nothing
130+mapMFirst f (a:as) = do res <- try (f a)
131+ case res of
132+ Left (ex :: IOException) -> mapMFirst f as
133+ Right res -> return $ Just res
134+
135+invalidLibRegex :: Regex
136+invalidLibRegex = makeRegex "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*(invalid ELF header|file too short)"
78137
138+linkerScriptRegex :: Regex
139+linkerScriptRegex = makeRegex "(GROUP|INPUT) *\\( *([^ )]+)"
79140
80141tryLoadFn :: String -> DynamicLib -> IO (Maybe ForeignFun)
81142tryLoadFn fn (Lib _ h) = do cFn <- dlsym h fn