mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

OsPath conversion for OSXMkLibs

Browse source
This commit is contained in:
Joey Hess 2025-02-14 16:53:00 -04:00
parent e8b00faea8
commit 70a2661334
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 42 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

82
Build/OSXMkLibs.hs
View file

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