1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
{- OSX library copier
-
- Copyright 2012-2022 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Build.OSXMkLibs (mklibs) where
import Data.Maybe
import System.FilePath
import System.IO
import Control.Monad
import Control.Monad.IfElse
import Data.List
import Control.Applicative
import System.Posix.Files
import Prelude
import Utility.PartialPrelude
import Utility.Directory
import Utility.Process
import Utility.Monad
import Utility.SafeCommand
import Utility.Path
import Utility.Exception
import Utility.Env
import Utility.Split
import Utility.FileSystemEncoding
import qualified Data.Map as M
import qualified Data.Set as S
type LibMap = M.Map FilePath String
mklibs :: FilePath -> M.Map FilePath FilePath -> 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' 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 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 dest = appbase </> fulllib
let symdest = appbase </> shortlib
-- This is a hack; libraries need to be in the same
-- directory as the program, so also link them into the
-- extra and git-core directories so programs in those will
-- find them.
let symdestextra =
[ appbase </> "extra" </> shortlib
, appbase </> "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]) $
error "library install failed"
forM_ symdestextra $ \d ->
unlessM (boolSystem "ln" [Param "-s", File (".." </> fulllib), File d]) $
error "library linking failed"
return $ Just appbase
)
return (catMaybes libs, replacement_libs', libmap')
{- Returns libraries to install.
-
- Note that otool -L ignores DYLD_LIBRARY_PATH, so the
- 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 appbase installedbins replacement_libs libmap = do
files <- filterM doesFileExist =<< dirContentsRecursive appbase
process [] files replacement_libs libmap
where
want s =
-- This seems to be about finding libraries next
-- to executables or something. May need further resolving
-- to find real path to library, but for now, skip it.
not ("@executable_path" `isInfixOf` s)
&& not ("@loader_path" `isInfixOf` s)
-- OSX framekworks such as Cocoa are too tightly tied to
-- a specific OSX version, so don't bundle.
&& not (".framework" `isInfixOf` s)
-- libSystem.B is tightly tied to frameworks.
&& not ("libSystem.B" `isInfixOf` s)
-- ImageIO.framework uses libPng which is built against a
-- specific version of libz; other versions lack the
-- _inflateValidate symbol. So, avoid bundling libz unless
-- this incompatability is resolved.
&& not ("libz." `isInfixOf` s)
lib_present s
| "@rpath" `isInfixOf` s = return True
| otherwise = ifM (isJust <$> catchMaybeIO (getSymbolicLinkStatus s))
( return True
, do
hPutStrLn stderr $ "note: skipping library that is not present on disk: " ++ s
return False
)
process c [] rls m = return (nub $ concat c, rls, m)
process c (file:rest) rls m = do
_ <- boolSystem "chmod" [Param "755", File file]
libs <- filterM lib_present
=<< filter want . parseOtool
<$> readProcess "otool" ["-L", 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
process (expanded_libs:c) rest rls' m'
findLibPath :: FilePath -> IO FilePath
findLibPath l = go =<< getEnv "DYLD_LIBRARY_PATH"
where
go Nothing = return l
go (Just p) = fromMaybe l
<$> firstM doesFileExist (map (</> f) (splitc ':' p))
f = takeFileName l
{- Expands any @rpath in the list of libraries.
-
- This is done by the nasty method of running the command with a dummy
- 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 installedbins libs replacement_libs cmd
| any ("@rpath" `isInfixOf`) libs = do
let origcmd = case M.lookup cmd installedbins of
Nothing -> cmd
Just cmd' -> cmd'
s <- catchDefaultIO "" $ readProcess "sh" ["-c", probe origcmd]
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
where
probe c = "DYLD_PRINT_RPATHS=1 " ++ 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)
_ -> Nothing
replacem m l = fromMaybe l $ M.lookup l m
parseOtool :: String -> [FilePath]
parseOtool = catMaybes . map parse . lines
where
parse l
| "\t" `isPrefixOf` l = headMaybe $ words l
| otherwise = Nothing
{- 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 _ [] _ 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]
unless ok $
error $ "install_name_tool failed for " ++ binary
return libmap'
where
change (lib, libname) =
[ Param "-change"
, File lib
, Param $ "@executable_path/" ++ libname
]
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 pure ['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
|
