Merge branch 'master' into desymlink

1 files changed, 68 insertions, 37 deletions

diff --git a/Build/OSXMkLibs.hs b/Build/OSXMkLibs.hs
index efe0cc1dd..a3448b563 100644
--- a/Build/OSXMkLibs.hs
+++ b/Build/OSXMkLibs.hs
@@ -23,42 +23,53 @@ import Utility.Monad
 import Utility.SafeCommand
 import Utility.Path
 
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+type LibMap = M.Map FilePath String
+
 {- Recursively find and install libs, until nothing new to install is found. -}
-mklibs :: FilePath -> [FilePath] -> IO [FilePath]
-mklibs appbase libdirs = do
-	new <- catMaybes <$> installLibs appbase
-	if null new
-		then return (libdirs++new)
-		else mklibs appbase (libdirs++new)
+mklibs :: FilePath -> [FilePath] -> LibMap -> IO ()
+mklibs appbase libdirs libmap = do
+	(new, libmap') <- installLibs appbase libmap
+	unless (null new) $
+		mklibs appbase (libdirs++new) libmap'
 
 {- Returns directories into which new libs were installed. -}
-installLibs :: FilePath -> IO [Maybe FilePath]
-installLibs appbase = do
-	needlibs <- otool appbase
-	forM needlibs $ \lib -> do
-		let dest = appbase </> takeFileName lib
+installLibs :: FilePath -> LibMap -> IO ([FilePath], LibMap)
+installLibs appbase libmap = do
+	(needlibs, libmap') <- otool appbase libmap
+	libs <- forM needlibs $ \lib -> do
+		let shortlib = fromMaybe (error "internal") (M.lookup lib libmap')
+		let fulllib = dropWhile (== '/') lib
+		let dest = appbase </> fulllib
+		let symdest = appbase </> shortlib
 		ifM (doesFileExist dest)
 			( return Nothing
 			, do
-				createDirectoryIfMissing True appbase
-				putStrLn $ "installing " ++ lib
+				createDirectoryIfMissing True (parentDir dest)
+				putStrLn $ "installing " ++ lib ++ " as " ++ shortlib
 				_ <- boolSystem "cp" [File lib, File dest]
 				_ <- boolSystem "chmod" [Param "644", File dest]
+				_ <- boolSystem "ln" [Param "-s", File fulllib, File symdest]
 				return $ Just appbase
 			)
+	return (catMaybes libs, libmap')
 
 {- Returns libraries to install. -}
-otool :: FilePath -> IO [FilePath]
-otool appbase = do
+otool :: FilePath -> LibMap -> IO ([FilePath], LibMap)
+otool appbase libmap = do
 	files <- filterM doesFileExist =<< dirContentsRecursive appbase
-	l <- forM files $ \file -> do
-		libs <- filter unprocessed . parseOtool
-			<$> readProcess "otool" ["-L", file]
-		forM_ libs $ \lib -> install_name_tool file lib
-		return libs
-	return $ nub $ concat l
+	process [] files libmap
   where
 	unprocessed s = not ("@executable_path" `isInfixOf` s)
+	process c [] m = return (nub $ concat c, m)
+	process c (file:rest) m = do
+		_ <- boolSystem "chmod" [Param "755", File file]
+		libs <- filter unprocessed . parseOtool
+			<$> readProcess "otool" ["-L", file]
+		m' <- install_name_tool file libs m
+		process (libs:c) rest m'
 
 parseOtool :: String -> [FilePath]
 parseOtool = catMaybes . map parse . lines
@@ -67,27 +78,47 @@ parseOtool = catMaybes . map parse . lines
 		| "\t" `isPrefixOf` l = headMaybe $ words l
 		| otherwise = Nothing
 
-{- Adjusts binaries to use libraries in paths relative to the executable.
- -
- - Assumes all executables are installed into the same directory, and
- - the libraries will be installed in subdirectories that match their
- - absolute paths. -}
-install_name_tool :: FilePath -> FilePath -> IO ()
-install_name_tool binary lib = do
-	ok <- boolSystem "install_name_tool"
+{- Adjusts binaries to use libraries bundled with it, rather than the
+ - system libraries. -}
+install_name_tool :: FilePath -> [FilePath] -> LibMap -> IO LibMap
+install_name_tool _ [] libmap = return libmap
+install_name_tool binary libs libmap = do
+	let (libnames, libmap') = getLibNames libs libmap
+	let params = concatMap change $ zip libs libnames
+	ok <- boolSystem "install_name_tool" $ params ++ [File binary]
+	unless ok $
+		error $ "install_name_tool failed for " ++ binary
+	return libmap'
+  where
+	change (lib, libname) =
 		[ Param "-change"
 		, File lib
-		, Param $ "@executable_path" ++ (dropFileName lib)
-		, File binary
+		, Param $ "@executable_path/" ++ libname
 		]
-	unless ok $
-		hPutStrLn stderr $ "install_name_tool failed for " ++ binary
+
+getLibNames :: [FilePath] -> LibMap -> ([FilePath], LibMap)
+getLibNames libs libmap = go [] libs libmap
+  where
+	go c [] m = (reverse c, m)
+	go c (l:rest) m =
+		let (f, m') = getLibName l m
+		in go (f:c) rest m'
+
+{- Uses really short names for the library files it installs, because
+ - binaries have arbitrarily short RPATH field limits. -}
+getLibName :: FilePath -> LibMap -> (FilePath, LibMap)
+getLibName lib libmap = case M.lookup lib libmap of
+	Just n -> (n, libmap)
+	Nothing -> (nextfreename, M.insert lib nextfreename libmap)
+  where
+	names = map (\c -> [c]) ['A' .. 'Z'] ++
+		[[n, l] | n <- ['0' .. '9'], l <- ['A' .. 'Z']]
+	used = S.fromList $ M.elems libmap
+	nextfreename = fromMaybe (error "ran out of short library names!") $ 
+		headMaybe $ dropWhile (`S.member` used) names
 
 main :: IO ()
 main = getArgs >>= go
   where
 	go [] = error "specify OSXAPP_BASE"
-	go (appbase:_) = do
-		libdirs <- mklibs appbase []
-		writeFile (appbase </> "libdirs") $
-			unlines $ nub libdirs
+	go (appbase:_) = mklibs appbase [] M.empty