    {- 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 = IO Bool
    -> (IO (Maybe FilePath), IO (Maybe FilePath))
    -> IO (Maybe FilePath)
    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
    		Maybe FilePath -> IO (Maybe FilePath)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe FilePath -> IO (Maybe FilePath))
    -> Maybe FilePath -> IO (Maybe FilePath)
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath
    parentDir FilePath
    lib
    	, Maybe FilePath -> IO (Maybe FilePath)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe FilePath
    forall a. Maybe a
    Nothing
    	)
      where
    	checksymlink :: FilePath -> IO ()
    checksymlink FilePath
    f = IO Bool -> IO () -> IO ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM (FileStatus -> Bool
    isSymbolicLink (FileStatus -> Bool) -> IO FileStatus -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FilePath -> IO FileStatus
    getSymbolicLinkStatus (FilePath -> FilePath -> FilePath
    inTop FilePath
    top FilePath
    f)) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
    		l <- FilePath -> IO FilePath
    readSymbolicLink (FilePath -> FilePath -> FilePath
    inTop FilePath
    top FilePath
    f)
    		let absl = FilePath -> FilePath -> FilePath
    absPathFrom (FilePath -> FilePath
    parentDir FilePath
    f) FilePath
    l
    		target <- relPathDirToFile (takeDirectory f) absl
    		installfile top absl
    		nukeFile (top ++ f)
    		createSymbolicLink target (inTop top f)
    		checksymlink 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 FilePath -> FilePath -> FilePath
    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 = (FilePath -> Maybe FilePath) -> [FilePath] -> [FilePath]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (FilePath -> Maybe FilePath
    getlib (FilePath -> Maybe FilePath)
    -> (FilePath -> FilePath) -> FilePath -> Maybe FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> FilePath -> FilePath
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace) ([FilePath] -> [FilePath])
    -> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> [FilePath]
    lines
      where
    	getlib :: FilePath -> Maybe FilePath
    getlib FilePath
    l = [FilePath] -> Maybe FilePath
    forall a. [a] -> Maybe a
    headMaybe ([FilePath] -> Maybe FilePath)
    -> (FilePath -> [FilePath]) -> FilePath -> Maybe FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> [FilePath]
    words (FilePath -> Maybe FilePath) -> Maybe FilePath -> Maybe FilePath
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [FilePath] -> Maybe FilePath
    forall a. [a] -> Maybe a
    lastMaybe (FilePath -> FilePath -> [FilePath]
    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 (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
    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'"]