standalone tarball

Adapted the standalone tarball building code from git-annex.

1 files changed, 102 insertions, 0 deletions

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 <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
+	]