blob: 3b4f7f5055e628cf53a849df688b5a3d0bf60683 (
plain)
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
|
{- Linux library copier and binary shimmer
-
- Copyright 2013 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Main where
import System.Process
import System.Directory hiding (isSymbolicLink)
import System.Environment
import Data.Maybe
import System.FilePath
import Control.Monad
import Data.List
import System.Posix.Files
import Control.Applicative
import Prelude
import Utility.LinuxMkLibs
main :: IO ()
main = getArgs >>= go
where
go [] = error "specify LINUXSTANDALONE_DIST"
go (top:_) = mklibs top
mklibs :: FilePath -> IO ()
mklibs top = do
fs <- lines <$> readProcess "find" [top, "-type", "f"] ""
exes <- filterM checkExe fs
libs <- parseLdd <$> readProcess "ldd" exes ""
glibclibs <- glibcLibs
let libs' = nub $ libs ++ glibclibs
libdirs <- nub . catMaybes <$> mapM (installLib installFile top) libs'
-- Various files used by runshell to set up env vars used by the
-- linker shims.
writeFile (top </> "libdirs") (unlines libdirs)
writeFile (top </> "gconvdir")
(takeDirectory $ Prelude.head $ filter ("/gconv/" `isInfixOf`) glibclibs)
let linker = Prelude.head $ filter ("ld-linux" `isInfixOf`) libs'
mapM_ (installLinkerShim top linker) exes
{- Installs a linker shim script around a binary.
-
- Note that each binary is put into its own separate directory,
- to avoid eg git looking for binaries in its directory rather
- than in PATH.
-}
installLinkerShim :: FilePath -> FilePath -> FilePath -> IO ()
installLinkerShim top linker exe = do
createDirectoryIfMissing True (top </> shimdir)
createDirectoryIfMissing True (top </> exedir)
islink <- isSymbolicLink <$> getSymbolicLinkStatus exe
if islink
then do
sl <- readSymbolicLink exe
removeFile exe
removeFile exedest
-- Assume that for a symlink, the destination
-- will also be shimmed.
let sl' = ".." </> takeFileName sl </> takeFileName sl
createSymbolicLink sl' exedest
else renameFile exe exedest
writeFile exe $ unlines
[ "#!/bin/sh"
, "exec \"$DEBUG_ME_DIR/" ++ linker ++ "\" --library-path \"$DEBUG_ME_LD_LIBRARY_PATH\" \"$DEBUG_ME_DIR/shimmed/" ++ base ++ "/" ++ base ++ "\" \"$@\""
]
setFileMode exe $ ownerExecuteMode
`unionFileModes` groupExecuteMode
`unionFileModes` otherExecuteMode
`unionFileModes` ownerReadMode
`unionFileModes` groupReadMode
`unionFileModes` otherReadMode
where
base = takeFileName exe
shimdir = "shimmed" </> base
exedir = "exe"
exedest = top </> shimdir </> base
installFile :: FilePath -> FilePath -> IO ()
installFile top f = do
createDirectoryIfMissing True destdir
callProcess "cp" [f, destdir]
where
destdir = inTop top $ takeDirectory f
checkExe :: FilePath -> IO Bool
checkExe f
| ".so" `isSuffixOf` f = return False
| otherwise = checkFileExe <$> readProcess "file" ["-L", f] ""
{- Check that file(1) thinks it's a Linux ELF executable, or possibly
- a shared library (a few executables like ssh appear as shared libraries). -}
checkFileExe :: String -> Bool
checkFileExe s = and
[ "ELF" `isInfixOf` s
, "executable" `isInfixOf` s || "shared object" `isInfixOf` s
]
|
