{- Linux library copier and binary shimmer
 -
 - Copyright 2013 Joey Hess <id@joeyh.name>
 -
 - License: BSD-2-clause
 -}

module Utility.LinuxMkLibs where

import Utility.PartialPrelude
import Utility.Directory
import Utility.Process
import Utility.Monad
import Utility.Path
import Utility.Split

import Data.Maybe
import System.FilePath
import System.Posix.Files
import Data.Char
import Control.Monad.IfElse
import Control.Applicative
import Prelude

{- Installs a library. If the library is a symlink to another file,
 - install the file it links to, and update the symlink to be relative. -}
installLib :: (FilePath -> FilePath -> IO ()) -> FilePath -> FilePath -> IO (Maybe FilePath)
installLib :: (FilePath -> FilePath -> IO ())
-> FilePath -> FilePath -> IO (Maybe FilePath)
installLib FilePath -> FilePath -> IO ()
installfile FilePath
top FilePath
lib = forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (FilePath -> IO Bool
doesFileExist FilePath
lib)
	( do
		FilePath -> FilePath -> IO ()
installfile FilePath
top FilePath
lib
		FilePath -> IO ()
checksymlink FilePath
lib
		forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
parentDir FilePath
lib
	, forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
	)
  where
	checksymlink :: FilePath -> IO ()
checksymlink FilePath
f = forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (FileStatus -> Bool
isSymbolicLink forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FileStatus
getSymbolicLinkStatus (FilePath -> FilePath -> FilePath
inTop FilePath
top FilePath
f)) forall a b. (a -> b) -> a -> b
$ do
		FilePath
l <- FilePath -> IO FilePath
readSymbolicLink (FilePath -> FilePath -> FilePath
inTop FilePath
top FilePath
f)
		let absl :: FilePath
absl = FilePath -> FilePath -> FilePath
absPathFrom (FilePath -> FilePath
parentDir FilePath
f) FilePath
l
		FilePath
target <- FilePath -> FilePath -> IO FilePath
relPathDirToFile (FilePath -> FilePath
takeDirectory FilePath
f) FilePath
absl
		FilePath -> FilePath -> IO ()
installfile FilePath
top FilePath
absl
		FilePath -> IO ()
nukeFile (FilePath
top forall a. [a] -> [a] -> [a]
++ FilePath
f)
		FilePath -> FilePath -> IO ()
createSymbolicLink FilePath
target (FilePath -> FilePath -> FilePath
inTop FilePath
top FilePath
f)
		FilePath -> IO ()
checksymlink FilePath
absl

-- Note that f is not relative, so cannot use </>
inTop :: FilePath -> FilePath -> FilePath
inTop :: FilePath -> FilePath -> FilePath
inTop FilePath
top FilePath
f = FilePath
top forall a. [a] -> [a] -> [a]
++ FilePath
f

{- 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 :: FilePath -> [FilePath]
parseLdd = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (FilePath -> Maybe FilePath
getlib forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines
  where
	getlib :: FilePath -> Maybe FilePath
getlib FilePath
l = forall a. [a] -> Maybe a
headMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. [a] -> Maybe a
lastMaybe (forall a. Eq a => [a] -> [a] -> [[a]]
split FilePath
" => " FilePath
l)

{- Get all glibc libs and other support files, including gconv files
 -
 - XXX Debian specific. -}
glibcLibs :: IO [FilePath]
glibcLibs :: IO [FilePath]
glibcLibs = FilePath -> [FilePath]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> IO FilePath
readProcess FilePath
"sh"
	[FilePath
"-c", FilePath
"dpkg -L libc6:$(dpkg --print-architecture) libgcc1:$(dpkg --print-architecture) | egrep '\\.so|gconv'"]