summaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
authorJoey Hess2014-04-03 21:22:37 -0400
committerJoey Hess2014-04-03 21:22:37 -0400
commit1c381c5246b2836ca0f535b9ac65eddcaa000024 (patch)
treef37aafa9b7ad997db99bcb96a1c02b54b5537b38 /Utility
parent4996f12326207bc61c025c8717dfeb17269367c2 (diff)
library shimming for docker (untested)
Diffstat (limited to 'Utility')
-rw-r--r--Utility/LinuxMkLibs.hs61
1 files changed, 61 insertions, 0 deletions
diff --git a/Utility/LinuxMkLibs.hs b/Utility/LinuxMkLibs.hs
new file mode 100644
index 00000000..76e6266d
--- /dev/null
+++ b/Utility/LinuxMkLibs.hs
@@ -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'"]