convert hacky shell linux mklibs code to haskell ; fixing symlink bug
The shell code was nasty, and buggy. New haskell code is much nicer, and it's easy to do complicated calculations to properly convert possibly absolute symlinks between libraries into relative links using it.
This commit is contained in:
Joey Hess
parent
1211b3ee2d
commit
5897fb4a86
3 changed files with 138 additions and 42 deletions
128
Build/LinuxMkLibs.hs
Normal file
128
Build/LinuxMkLibs.hs
Normal file
|
|
@ -0,0 +1,128 @@
|
|||
{- Linux library copier and binary shimmer
|
||||
-
|
||||
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Control.Applicative
|
||||
import System.Environment
|
||||
import Data.Maybe
|
||||
import System.FilePath
|
||||
import System.Directory
|
||||
import Control.Monad
|
||||
import Data.List
|
||||
import Data.List.Utils
|
||||
import System.Posix.Files
|
||||
import Data.Char
|
||||
|
||||
import Utility.PartialPrelude
|
||||
import Utility.Directory
|
||||
import Utility.Process
|
||||
import Utility.Monad
|
||||
import Utility.Path
|
||||
import Utility.FileMode
|
||||
import Utility.CopyFile
|
||||
|
||||
main :: IO ()
|
||||
main = getArgs >>= go
|
||||
where
|
||||
go [] = error "specify LINUXSTANDALONE_DIST"
|
||||
go (top:_) = mklibs top
|
||||
|
||||
mklibs :: FilePath -> IO ()
|
||||
mklibs top = do
|
||||
fs <- dirContentsRecursive top
|
||||
exes <- filterM checkExe fs
|
||||
libs <- parseLdd <$> readProcess "ldd" exes
|
||||
glibclibs <- glibcLibs
|
||||
let libs' = nub $ libs ++ glibclibs
|
||||
libdirs <- nub . catMaybes <$> mapM (installLib top) libs'
|
||||
writeFile (top </> "libdirs") (unlines libdirs)
|
||||
writeFile (top </> "linker")
|
||||
(Prelude.head $ filter ("ld-linux" `isInfixOf`) libs')
|
||||
writeFile (top </> "gconvdir")
|
||||
(Prelude.head $ filter ("/gconv/" `isInfixOf`) glibclibs)
|
||||
|
||||
mapM_ (installLinkerShim top) exes
|
||||
|
||||
installLib :: FilePath -> FilePath -> IO (Maybe FilePath)
|
||||
installLib top lib = ifM (doesFileExist lib)
|
||||
( do
|
||||
installFile top lib
|
||||
s <- getSymbolicLinkStatus lib
|
||||
when (isSymbolicLink s) $ do
|
||||
l <- readSymbolicLink (inTop top lib)
|
||||
let absl = absPathFrom (parentDir lib) l
|
||||
let target = relPathDirToFile (parentDir lib) absl
|
||||
installFile top absl
|
||||
nukeFile (top ++ lib)
|
||||
createSymbolicLink target (inTop top lib)
|
||||
return $ Just $ parentDir lib
|
||||
, return Nothing
|
||||
)
|
||||
|
||||
{- 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 -> IO ()
|
||||
installLinkerShim top exe = do
|
||||
createDirectoryIfMissing True shimdir
|
||||
renameFile exe exedest
|
||||
writeFile exe $ unlines
|
||||
[ "#!/bin/sh"
|
||||
, "exec \"$GIT_ANNEX_LINKER\" --library-path \"$GIT_ANNEX_LD_LIBRARY_PATH\" \"$GIT_ANNEX_SHIMMED/" ++ base ++ "/" ++ base ++ "\" \"$@\""
|
||||
]
|
||||
modifyFileMode exe $ addModes executeModes
|
||||
where
|
||||
base = takeFileName exe
|
||||
shimdir = top </> "shimmed" </> base
|
||||
exedest = shimdir </> base
|
||||
|
||||
installFile :: FilePath -> FilePath -> IO ()
|
||||
installFile top f = do
|
||||
createDirectoryIfMissing True destdir
|
||||
void $ copyFileExternal f destdir
|
||||
where
|
||||
-- Note: This is an absolute, not a relative, directory.
|
||||
dir = parentDir f
|
||||
destdir = inTop top dir
|
||||
|
||||
-- Note that f is not relative, so cannot use </>
|
||||
inTop :: FilePath -> FilePath -> FilePath
|
||||
inTop top f = top ++ f --
|
||||
|
||||
checkExe :: FilePath -> IO Bool
|
||||
checkExe f
|
||||
| ".so" `isSuffixOf` f = return False
|
||||
| otherwise = ifM (isExecutable . fileMode <$> getFileStatus f)
|
||||
( checkFileExe <$> readProcess "file" [f]
|
||||
, return False
|
||||
)
|
||||
|
||||
{- 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
|
||||
]
|
||||
|
||||
{- Parse ldd output, getting all the libraries that the input files
|
||||
- link to. Note that some of the libraries may not exist
|
||||
- (eg, linux-vdso.so) -}
|
||||
parseLdd :: String -> [FilePath]
|
||||
parseLdd = catMaybes . map (getlib . dropWhile isSpace) . lines
|
||||
where
|
||||
getlib l = headMaybe . words =<< lastMaybe (split " => " l)
|
||||
|
||||
{- Get all glibc libs and other support files, including gconv files
|
||||
-
|
||||
- XXX Debian specific. -}
|
||||
glibcLibs :: IO [FilePath]
|
||||
glibcLibs = lines <$> readProcess "sh"
|
||||
["-c", "dpkg -L libc6 | egrep '\\.so|gconv'"]
|
||||
50
Makefile
50
Makefile
|
|
@ -79,19 +79,21 @@ clean:
|
|||
rm -rf tmp dist git-annex $(mans) configure *.tix .hpc \
|
||||
doc/.ikiwiki html dist tags Build/SysConfig.hs build-stamp \
|
||||
Setup Build/InstallDesktopFile Build/EvilSplicer \
|
||||
Build/Standalone Build/OSXMkLibs Build/DistributionUpdate \
|
||||
Build/Standalone Build/OSXMkLibs Build/LinuxMkLibs Build/DistributionUpdate \
|
||||
git-union-merge
|
||||
find . -name \*.o -exec rm {} \;
|
||||
find . -name \*.hi -exec rm {} \;
|
||||
|
||||
Build/InstallDesktopFile: Build/InstallDesktopFile.hs
|
||||
$(GHC) --make $@
|
||||
$(GHC) --make $@ -Wall
|
||||
Build/EvilSplicer: Build/EvilSplicer.hs
|
||||
$(GHC) --make $@
|
||||
$(GHC) --make $@ -Wall
|
||||
Build/Standalone: Build/Standalone.hs Build/SysConfig.hs
|
||||
$(GHC) --make $@
|
||||
$(GHC) --make $@ -Wall
|
||||
Build/OSXMkLibs: Build/OSXMkLibs.hs
|
||||
$(GHC) --make $@
|
||||
$(GHC) --make $@ -Wall
|
||||
Build/LinuxMkLibs: Build/LinuxMkLibs.hs
|
||||
$(GHC) --make $@ -Wall
|
||||
|
||||
sdist: clean $(mans)
|
||||
./Build/make-sdist.sh
|
||||
|
|
@ -103,7 +105,7 @@ hackage: sdist
|
|||
LINUXSTANDALONE_DEST=tmp/git-annex.linux
|
||||
linuxstandalone:
|
||||
$(MAKE) git-annex linuxstandalone-nobuild
|
||||
linuxstandalone-nobuild: Build/Standalone
|
||||
linuxstandalone-nobuild: Build/Standalone Build/LinuxMkLibs
|
||||
rm -rf "$(LINUXSTANDALONE_DEST)"
|
||||
mkdir -p tmp
|
||||
cp -R standalone/linux "$(LINUXSTANDALONE_DEST)"
|
||||
|
|
@ -121,42 +123,8 @@ linuxstandalone-nobuild: Build/Standalone
|
|||
(cd "$(shell git --exec-path)" && tar c .) | (cd "$(LINUXSTANDALONE_DEST)"/git-core && tar x)
|
||||
install -d "$(LINUXSTANDALONE_DEST)/templates"
|
||||
|
||||
touch "$(LINUXSTANDALONE_DEST)/libdirs.tmp"
|
||||
for lib in $$(ldd "$(LINUXSTANDALONE_DEST)"/bin/* $$(find "$(LINUXSTANDALONE_DEST)"/git-core/ -type f) | grep -v "not a dynamic executable" | egrep '^ ' | sed 's/^\t//' | sed 's/.*=> //' | cut -d ' ' -f 1 | sort | uniq); do \
|
||||
dir=$$(dirname "$$lib"); \
|
||||
install -d "$(LINUXSTANDALONE_DEST)/$$dir"; \
|
||||
echo "$$dir" >> "$(LINUXSTANDALONE_DEST)/libdirs.tmp"; \
|
||||
cp "$$lib" "$(LINUXSTANDALONE_DEST)/$$dir"; \
|
||||
if [ -L "$lib" ]; then \
|
||||
link=$$(readlink -f "$$lib"); \
|
||||
cp "$$link" "$(LINUXSTANDALONE_DEST)/$$(dirname "$$link")"; \
|
||||
fi; \
|
||||
done
|
||||
sort "$(LINUXSTANDALONE_DEST)/libdirs.tmp" | uniq > "$(LINUXSTANDALONE_DEST)/libdirs"
|
||||
rm -f "$(LINUXSTANDALONE_DEST)/libdirs.tmp"
|
||||
|
||||
# Ensure bundle includes all glibc libs, and other support
|
||||
# files it loads.
|
||||
# XXX Debian specific.
|
||||
cd $(LINUXSTANDALONE_DEST) && dpkg -L libc6 | egrep '\.so|gconv'|tar c --files-from=- | tar x
|
||||
|
||||
find $(LINUXSTANDALONE_DEST) -type d -name gconv | head -n 1 | sed 's!$(LINUXSTANDALONE_DEST)/*!!' > $(LINUXSTANDALONE_DEST)/gconvdir
|
||||
find $(LINUXSTANDALONE_DEST) | grep ld-linux | head -n 1 | sed 's!$(LINUXSTANDALONE_DEST)/*!!' > $(LINUXSTANDALONE_DEST)/linker
|
||||
./Build/LinuxMkLibs "$(LINUXSTANDALONE_DEST)"
|
||||
|
||||
# Install linker shim for each binary. Note that each binary is put
|
||||
# in its own separate directory, to avoid eg git looking for
|
||||
# binaries in its directory rather than in PATH.
|
||||
for file in $$(find "$(LINUXSTANDALONE_DEST)" -type f | grep -v \.so); do \
|
||||
if file "$$file" | grep ELF | egrep -q 'executable|shared object' && test -x "$$file"; then \
|
||||
base=$$(basename "$$file"); \
|
||||
mkdir -p "$(LINUXSTANDALONE_DEST)/shimmed/$$base"; \
|
||||
mv "$$file" "$(LINUXSTANDALONE_DEST)/shimmed/$$base/"; \
|
||||
echo "#!/bin/sh" > "$$file"; \
|
||||
echo "exec \"\$$GIT_ANNEX_LINKER\" --library-path \"\$$GIT_ANNEX_LD_LIBRARY_PATH\" \"\$$GIT_ANNEX_SHIMMED/$$base/$$base\" \"\$$@\"" >> "$$file"; \
|
||||
chmod +x "$$file"; \
|
||||
fi; \
|
||||
done
|
||||
|
||||
$(MAKE) install-mans DESTDIR="$(LINUXSTANDALONE_DEST)"
|
||||
|
||||
cd tmp/git-annex.linux && find . -type f > git-annex.MANIFEST
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@ dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d
|
|||
{- Gets files in a directory, and then its subdirectories, recursively,
|
||||
- and lazily.
|
||||
-
|
||||
- Follows symlinks to other subdirectories.
|
||||
- Does not follow symlinks to other subdirectories.
|
||||
-
|
||||
- When the directory does not exist, no exception is thrown,
|
||||
- instead, [] is returned. -}
|
||||
|
|
|
|||
Loading…
Reference in a new issue