From 2f5315b3c32fbd23ebce05da80712183dc259b7c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 5 May 2017 14:27:39 -0400 Subject: standalone tarball Adapted the standalone tarball building code from git-annex. --- Build/LinuxMkLibs.hs | 102 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 102 insertions(+) create mode 100644 Build/LinuxMkLibs.hs (limited to 'Build') diff --git a/Build/LinuxMkLibs.hs b/Build/LinuxMkLibs.hs new file mode 100644 index 0000000..3b4f7f5 --- /dev/null +++ b/Build/LinuxMkLibs.hs @@ -0,0 +1,102 @@ +{- Linux library copier and binary shimmer + - + - Copyright 2013 Joey Hess + - + - 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 + ] -- cgit v1.2.3