factor out library code (also used by propellor)

This commit is contained in:
Joey Hess 2014-04-03 21:25:59 -04:00
parent acda14abc9
commit 611e060385
2 changed files with 63 additions and 43 deletions

View file

@ -14,12 +14,10 @@ import System.FilePath
import System.Directory
import Control.Monad
import Data.List
import Data.List.Utils
import System.Posix.Files
import Data.Char
import Control.Monad.IfElse
import Utility.PartialPrelude
import Utility.LinuxMkLibs
import Utility.Directory
import Utility.Process
import Utility.Monad
@ -41,7 +39,7 @@ mklibs top = do
libs <- parseLdd <$> readProcess "ldd" exes
glibclibs <- glibcLibs
let libs' = nub $ libs ++ glibclibs
libdirs <- nub . catMaybes <$> mapM (installLib top) libs'
libdirs <- nub . catMaybes <$> mapM (installLib installFile top) libs'
-- Various files used by runshell to set up env vars used by the
-- linker shims.
@ -53,26 +51,6 @@ mklibs top = do
mapM_ (installLinkerShim top) exes
{- 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 (Maybe FilePath)
installLib top lib = ifM (doesFileExist lib)
( do
installFile top lib
checksymlink lib
return $ Just $ parentDir lib
, return Nothing
)
where
checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do
l <- readSymbolicLink (inTop top f)
let absl = absPathFrom (parentDir f) l
let target = relPathDirToFile (parentDir f) absl
installFile top absl
nukeFile (top ++ f)
createSymbolicLink target (inTop top f)
checksymlink absl
{- Installs a linker shim script around a binary.
-
- Note that each binary is put into its own separate directory,
@ -108,10 +86,6 @@ installFile top f = do
where
destdir = inTop top $ parentDir f
-- Note that f is not relative, so cannot use </>
inTop :: FilePath -> FilePath -> FilePath
inTop top f = top ++ f --
checkExe :: FilePath -> IO Bool
checkExe f
| ".so" `isSuffixOf` f = return False
@ -127,18 +101,3 @@ checkFileExe s = and
[ "ELF" `isInfixOf` s
, "executable" `isInfixOf` s || "shared object" `isInfixOf` s
]
{- 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 = catMaybes . map (getlib . dropWhile isSpace) . lines
where
getlib l = headMaybe . words =<< lastMaybe (split " => " l)
{- Get all glibc libs and other support files, including gconv files
-
- XXX Debian specific. -}
glibcLibs :: IO [FilePath]
glibcLibs = lines <$> readProcess "sh"
["-c", "dpkg -L libc6:$(dpkg --print-architecture) libgcc1:$(dpkg --print-architecture) | egrep '\\.so|gconv'"]

61
Utility/LinuxMkLibs.hs Normal file
View file

@ -0,0 +1,61 @@
{- Linux library copier and binary shimmer
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Utility.LinuxMkLibs where
import Control.Applicative
import Data.Maybe
import System.Directory
import Data.List.Utils
import System.Posix.Files
import Data.Char
import Control.Monad.IfElse
import Utility.PartialPrelude
import Utility.Directory
import Utility.Process
import Utility.Monad
import Utility.Path
{- 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 installfile top lib = ifM (doesFileExist lib)
( do
installfile top lib
checksymlink lib
return $ Just $ parentDir lib
, return Nothing
)
where
checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do
l <- readSymbolicLink (inTop top f)
let absl = absPathFrom (parentDir f) l
let target = relPathDirToFile (parentDir 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 top f = top ++ 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 = catMaybes . map (getlib . dropWhile isSpace) . lines
where
getlib l = headMaybe . words =<< lastMaybe (split " => " l)
{- Get all glibc libs and other support files, including gconv files
-
- XXX Debian specific. -}
glibcLibs :: IO [FilePath]
glibcLibs = lines <$> readProcess "sh"
["-c", "dpkg -L libc6:$(dpkg --print-architecture) libgcc1:$(dpkg --print-architecture) | egrep '\\.so|gconv'"]