OsPath conversion for OSXMkLibs
This commit is contained in:
Joey Hess
parent
e8b00faea8
commit
70a2661334
1 changed files with 42 additions and 40 deletions
|
|
@ -5,10 +5,11 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Build.OSXMkLibs (mklibs) where
|
||||
|
||||
import Data.Maybe
|
||||
import System.FilePath
|
||||
import System.IO
|
||||
import Control.Monad
|
||||
import Control.Monad.IfElse
|
||||
|
|
@ -18,6 +19,7 @@ import System.Posix.Files
|
|||
import Prelude
|
||||
|
||||
import Utility.PartialPrelude
|
||||
import Utility.OsPath
|
||||
import Utility.Directory
|
||||
import Utility.SystemDirectory
|
||||
import Utility.Process
|
||||
|
|
@ -28,32 +30,33 @@ import Utility.Exception
|
|||
import Utility.Env
|
||||
import Utility.Split
|
||||
import Utility.FileSystemEncoding
|
||||
import qualified Utility.OsString as OS
|
||||
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
|
||||
type LibMap = M.Map FilePath String
|
||||
type LibMap = M.Map OsPath String
|
||||
|
||||
mklibs :: FilePath -> M.Map FilePath FilePath -> IO Bool
|
||||
mklibs :: OsPath -> M.Map OsPath OsPath -> IO Bool
|
||||
mklibs appbase installedbins = do
|
||||
mklibs' appbase installedbins [] [] M.empty
|
||||
return True
|
||||
|
||||
{- Recursively find and install libs, until nothing new to install is found. -}
|
||||
mklibs' :: FilePath -> M.Map FilePath FilePath -> [FilePath] -> [(FilePath, FilePath)] -> LibMap -> IO ()
|
||||
mklibs' :: OsPath -> M.Map OsPath OsPath -> [OsPath] -> [(OsPath, OsPath)] -> LibMap -> IO ()
|
||||
mklibs' appbase installedbins libdirs replacement_libs libmap = do
|
||||
(new, replacement_libs', libmap') <- installLibs appbase installedbins replacement_libs libmap
|
||||
unless (null new) $
|
||||
mklibs' appbase installedbins (libdirs++new) replacement_libs' libmap'
|
||||
|
||||
{- Returns directories into which new libs were installed. -}
|
||||
installLibs :: FilePath -> M.Map FilePath FilePath -> [(FilePath, FilePath)] -> LibMap -> IO ([FilePath], [(FilePath, FilePath)], LibMap)
|
||||
installLibs :: OsPath -> M.Map OsPath OsPath -> [(OsPath, OsPath)] -> LibMap -> IO ([OsPath], [(OsPath, OsPath)], LibMap)
|
||||
installLibs appbase installedbins replacement_libs libmap = do
|
||||
(needlibs, replacement_libs', libmap') <- otool appbase installedbins replacement_libs libmap
|
||||
libs <- forM needlibs $ \lib -> do
|
||||
pathlib <- findLibPath lib
|
||||
let shortlib = fromMaybe (error "internal") (M.lookup lib libmap')
|
||||
let fulllib = dropWhile (== '/') lib
|
||||
let shortlib = toOsPath $ fromMaybe (error "internal") (M.lookup lib libmap')
|
||||
let fulllib = OS.dropWhile (== unsafeFromChar '/') lib
|
||||
let dest = appbase </> fulllib
|
||||
let symdest = appbase </> shortlib
|
||||
-- This is a hack; libraries need to be in the same
|
||||
|
|
@ -61,20 +64,20 @@ installLibs appbase installedbins replacement_libs libmap = do
|
|||
-- extra and git-core directories so programs in those will
|
||||
-- find them.
|
||||
let symdestextra =
|
||||
[ appbase </> "extra" </> shortlib
|
||||
, appbase </> "git-core" </> shortlib
|
||||
[ appbase </> literalOsPath "extra" </> shortlib
|
||||
, appbase </> literalOsPath "git-core" </> shortlib
|
||||
]
|
||||
ifM (doesFileExist dest)
|
||||
( return Nothing
|
||||
, do
|
||||
createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath dest)))
|
||||
putStrLn $ "installing " ++ pathlib ++ " as " ++ shortlib
|
||||
unlessM (boolSystem "cp" [File pathlib, File dest]
|
||||
<&&> boolSystem "chmod" [Param "644", File dest]
|
||||
<&&> boolSystem "ln" [Param "-s", File fulllib, File symdest]) $
|
||||
createDirectoryIfMissing True (parentDir dest)
|
||||
putStrLn $ "installing " ++ fromOsPath pathlib ++ " as " ++ fromOsPath shortlib
|
||||
unlessM (boolSystem "cp" [File (fromOsPath pathlib), File (fromOsPath dest)]
|
||||
<&&> boolSystem "chmod" [Param "644", File (fromOsPath dest)]
|
||||
<&&> boolSystem "ln" [Param "-s", File (fromOsPath fulllib), File (fromOsPath symdest)]) $
|
||||
error "library install failed"
|
||||
forM_ symdestextra $ \d ->
|
||||
unlessM (boolSystem "ln" [Param "-s", File (".." </> fulllib), File d]) $
|
||||
unlessM (boolSystem "ln" [Param "-s", File (fromOsPath (literalOsPath ".." </> fulllib)), File (fromOsPath d)]) $
|
||||
error "library linking failed"
|
||||
return $ Just appbase
|
||||
)
|
||||
|
|
@ -86,10 +89,9 @@ installLibs appbase installedbins replacement_libs libmap = do
|
|||
- library files returned may need to be run through findLibPath
|
||||
- to find the actual libraries to install.
|
||||
-}
|
||||
otool :: FilePath -> M.Map FilePath FilePath -> [(FilePath, FilePath)] -> LibMap -> IO ([FilePath], [(FilePath, FilePath)], LibMap)
|
||||
otool :: OsPath -> M.Map OsPath OsPath -> [(OsPath, OsPath)] -> LibMap -> IO ([OsPath], [(OsPath, OsPath)], LibMap)
|
||||
otool appbase installedbins replacement_libs libmap = do
|
||||
files <- filterM doesFileExist
|
||||
=<< (map fromRawFilePath <$> dirContentsRecursive (toRawFilePath appbase))
|
||||
files <- filterM doesFileExist =<< dirContentsRecursive appbase
|
||||
process [] files replacement_libs libmap
|
||||
where
|
||||
want s =
|
||||
|
|
@ -118,21 +120,21 @@ otool appbase installedbins replacement_libs libmap = do
|
|||
)
|
||||
process c [] rls m = return (nub $ concat c, rls, m)
|
||||
process c (file:rest) rls m = do
|
||||
_ <- boolSystem "chmod" [Param "755", File file]
|
||||
_ <- boolSystem "chmod" [Param "755", File (fromOsPath file)]
|
||||
libs <- filterM lib_present
|
||||
=<< filter want . parseOtool
|
||||
<$> readProcess "otool" ["-L", file]
|
||||
<$> readProcess "otool" ["-L", fromOsPath file]
|
||||
expanded_libs <- expand_rpath installedbins libs replacement_libs file
|
||||
let rls' = nub $ rls ++ (zip libs expanded_libs)
|
||||
m' <- install_name_tool file libs expanded_libs m
|
||||
let rls' = nub $ rls ++ (zip (map toOsPath libs) expanded_libs)
|
||||
m' <- install_name_tool file (map toOsPath libs) expanded_libs m
|
||||
process (expanded_libs:c) rest rls' m'
|
||||
|
||||
findLibPath :: FilePath -> IO FilePath
|
||||
findLibPath :: OsPath -> IO OsPath
|
||||
findLibPath l = go =<< getEnv "DYLD_LIBRARY_PATH"
|
||||
where
|
||||
go Nothing = return l
|
||||
go (Just p) = fromMaybe l
|
||||
<$> firstM doesFileExist (map (</> f) (splitc ':' p))
|
||||
<$> firstM doesFileExist (map (\p' -> toOsPath p' </> f) (splitc ':' p))
|
||||
f = takeFileName l
|
||||
|
||||
{- Expands any @rpath in the list of libraries.
|
||||
|
|
@ -141,7 +143,7 @@ findLibPath l = go =<< getEnv "DYLD_LIBRARY_PATH"
|
|||
- option (so it doesn't do anything.. hopefully!) and asking the dynamic
|
||||
- linker to print expanded rpaths.
|
||||
-}
|
||||
expand_rpath :: M.Map FilePath FilePath -> [String] -> [(FilePath, FilePath)] -> FilePath -> IO [String]
|
||||
expand_rpath :: M.Map OsPath OsPath -> [String] -> [(OsPath, OsPath)] -> OsPath -> IO [OsPath]
|
||||
expand_rpath installedbins libs replacement_libs cmd
|
||||
| any ("@rpath" `isInfixOf`) libs = do
|
||||
let origcmd = case M.lookup cmd installedbins of
|
||||
|
|
@ -151,17 +153,17 @@ expand_rpath installedbins libs replacement_libs cmd
|
|||
let m = if (null s)
|
||||
then M.fromList replacement_libs
|
||||
else M.fromList $ mapMaybe parse $ lines s
|
||||
return $ map (replacem m) libs
|
||||
| otherwise = return libs
|
||||
return $ map (replacem m . toOsPath) libs
|
||||
| otherwise = return (map toOsPath libs)
|
||||
where
|
||||
probe c = "DYLD_PRINT_RPATHS=1 " ++ c ++ " --getting-rpath-dummy-option 2>&1 | grep RPATH"
|
||||
probe c = "DYLD_PRINT_RPATHS=1 " ++ fromOsPath c ++ " --getting-rpath-dummy-option 2>&1 | grep RPATH"
|
||||
parse s = case words s of
|
||||
("RPATH":"successful":"expansion":"of":old:"to:":new:[]) ->
|
||||
Just (old, new)
|
||||
Just (toOsPath old, toOsPath new)
|
||||
_ -> Nothing
|
||||
replacem m l = fromMaybe l $ M.lookup l m
|
||||
replacem m l = fromMaybe l $ M.lookup (toOsPath l) m
|
||||
|
||||
parseOtool :: String -> [FilePath]
|
||||
parseOtool :: String -> [String]
|
||||
parseOtool = catMaybes . map parse . lines
|
||||
where
|
||||
parse l
|
||||
|
|
@ -170,23 +172,23 @@ parseOtool = catMaybes . map parse . lines
|
|||
|
||||
{- Adjusts binaries to use libraries bundled with it, rather than the
|
||||
- system libraries. -}
|
||||
install_name_tool :: FilePath -> [FilePath] -> [FilePath] -> LibMap -> IO LibMap
|
||||
install_name_tool :: OsPath -> [OsPath] -> [OsPath] -> LibMap -> IO LibMap
|
||||
install_name_tool _ [] _ libmap = return libmap
|
||||
install_name_tool binary libs expanded_libs libmap = do
|
||||
let (libnames, libmap') = getLibNames expanded_libs libmap
|
||||
let params = concatMap change $ zip libs libnames
|
||||
ok <- boolSystem "install_name_tool" $ params ++ [File binary]
|
||||
ok <- boolSystem "install_name_tool" $ params ++ [File (fromOsPath binary)]
|
||||
unless ok $
|
||||
error $ "install_name_tool failed for " ++ binary
|
||||
error $ "install_name_tool failed for " ++ fromOsPath binary
|
||||
return libmap'
|
||||
where
|
||||
change (lib, libname) =
|
||||
[ Param "-change"
|
||||
, File lib
|
||||
, Param $ "@executable_path/" ++ libname
|
||||
, File (fromOsPath lib)
|
||||
, Param $ "@executable_path/" ++ fromOsPath libname
|
||||
]
|
||||
|
||||
getLibNames :: [FilePath] -> LibMap -> ([FilePath], LibMap)
|
||||
getLibNames :: [OsPath] -> LibMap -> ([OsPath], LibMap)
|
||||
getLibNames libs libmap = go [] libs libmap
|
||||
where
|
||||
go c [] m = (reverse c, m)
|
||||
|
|
@ -196,10 +198,10 @@ getLibNames libs libmap = go [] libs libmap
|
|||
|
||||
{- Uses really short names for the library files it installs, because
|
||||
- binaries have arbitrarily short RPATH field limits. -}
|
||||
getLibName :: FilePath -> LibMap -> (FilePath, LibMap)
|
||||
getLibName :: OsPath -> LibMap -> (OsPath, LibMap)
|
||||
getLibName lib libmap = case M.lookup lib libmap of
|
||||
Just n -> (n, libmap)
|
||||
Nothing -> (nextfreename, M.insert lib nextfreename libmap)
|
||||
Just n -> (toOsPath n, libmap)
|
||||
Nothing -> (toOsPath nextfreename, M.insert lib nextfreename libmap)
|
||||
where
|
||||
names = map pure ['A' .. 'Z'] ++
|
||||
[[n, l] | n <- ['0' .. '9'], l <- ['A' .. 'Z']]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue