summaryrefslogtreecommitdiff
path: root/src/Utility/LinuxMkLibs.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Utility/LinuxMkLibs.hs')
-rw-r--r--src/Utility/LinuxMkLibs.hs61
1 files changed, 61 insertions, 0 deletions
diff --git a/src/Utility/LinuxMkLibs.hs b/src/Utility/LinuxMkLibs.hs
new file mode 100644
index 00000000..1dc4e1ea
--- /dev/null
+++ b/src/Utility/LinuxMkLibs.hs
@@ -0,0 +1,61 @@
+{- Linux library copier and binary shimmer
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - License: BSD-2-clause
+ -}
+
+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 = mapMaybe (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'"]