From 70a2661334db6146a04fec630463b5267f1f9e8b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 14 Feb 2025 16:53:00 -0400 Subject: [PATCH] OsPath conversion for OSXMkLibs --- Build/OSXMkLibs.hs | 82 ++++++++++++++++++++++++---------------------- 1 file changed, 42 insertions(+), 40 deletions(-) diff --git a/Build/OSXMkLibs.hs b/Build/OSXMkLibs.hs index de5f4335d9..6ca0d7d05e 100644 --- a/Build/OSXMkLibs.hs +++ b/Build/OSXMkLibs.hs @@ -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']]