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