cfe4aa2 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Merge pull request #3249 from enolan/linker-scripts

cfe4aa2Niklas Larsson10 years ago

idris.cabal+2

compare with master

unifiedsplit

@@ -1035,6 +1035,7 @@ Library

1035 , annotated-wl-pprint >= 0.7 && < 0.8

1036 , ansi-terminal < 0.7

1037 , ansi-wl-pprint < 0.7

1038+ , array >= 0.4.0.1 && < 0.6

1038 , base64-bytestring < 1.1

1039 , base64-bytestring < 1.1

1039 , binary >= 0.7 && < 0.9

1040 , binary >= 0.7 && < 0.9

1040 , blaze-html >= 0.6.1.3 && < 0.9

1041 , blaze-html >= 0.6.1.3 && < 0.9

@@ -1053,6 +1054,7 @@ Library

1053 , optparse-applicative >= 0.11 && < 0.13

1054 , optparse-applicative >= 0.11 && < 0.13

1054 , parsers >= 0.9 && < 0.13

1055 , parsers >= 0.9 && < 0.13

1055 , pretty < 1.2

1056 , pretty < 1.2

1057+ , regex-tdfa >= 1.2

1056 , split < 0.3

1058 , split < 0.3

1057 , terminal-size < 0.4

1059 , terminal-size < 0.4

1058 , text >=1.2.1.0 && < 1.3

1060 , text >=1.2.1.0 && < 1.3

src/Util/DynamicLinker.hs+67−6

@@ -5,7 +5,7 @@ Copyright :

5License : BSD3

6Maintainer : The Idris Community.

7-}

8−{-# LANGUAGE ExistentialQuantification, CPP #-}

8+{-# LANGUAGE ExistentialQuantification, CPP, ScopedTypeVariables #-}

9module Util.DynamicLinker ( ForeignFun(..)

10 , DynamicLib(..)

11 , tryLoadLib

@@ -17,8 +17,13 @@ import Foreign.LibFFI

17import Foreign.Ptr (Ptr(), nullPtr, FunPtr, nullFunPtr, castPtrToFunPtr)

18import System.Directory

19#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)

20import System.Posix.DynamicLinker

24import System.Posix.DynamicLinker

21import System.FilePath.Posix ((</>))

25import System.FilePath.Posix ((</>))

26+import Text.Regex.TDFA

22#else

27#else

23import qualified Control.Exception as Exception (catch, IOException)

28import qualified Control.Exception as Exception (catch, IOException)

24import System.Win32.DLL

29import System.Win32.DLL

@@ -69,13 +74,69 @@ libFileName dirs lib = do let names = [lib, lib ++ "." ++ hostDynamicLibExt]

69 return $ maybe (lib ++ "." ++ hostDynamicLibExt) id found

74 return $ maybe (lib ++ "." ++ hostDynamicLibExt) id found

71#ifndef mingw32_HOST_OS

76#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.

72tryLoadLib :: [FilePath] -> String -> IO (Maybe DynamicLib)

85tryLoadLib :: [FilePath] -> String -> IO (Maybe DynamicLib)

86+tryLoadLib dirs lib = do

73−tryLoadLib dirs lib = do filename <- libFileName dirs lib

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

74− handle <- dlopen filename [RTLD_NOW, RTLD_GLOBAL]

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

75− if undl handle == nullPtr

116+ Just handle -> if undl handle == nullPtr

76− then return Nothing

117+ then return Nothing

77− else return . Just $ Lib lib handle

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)"

137

138+linkerScriptRegex :: Regex

139+linkerScriptRegex = makeRegex "(GROUP|INPUT) *\\( *([^ )]+)"

140

80tryLoadFn :: String -> DynamicLib -> IO (Maybe ForeignFun)

141tryLoadFn :: String -> DynamicLib -> IO (Maybe ForeignFun)

81tryLoadFn fn (Lib _ h) = do cFn <- dlsym h fn

142tryLoadFn fn (Lib _ h) = do cFn <- dlsym h fn