OsPath conversion of linuxstandalone builder
Sponsored-by: Joshua Antonishen
This commit is contained in:
parent
2ff716be30
commit
c85d5a0dc8
3 changed files with 128 additions and 130 deletions
|
@ -5,10 +5,11 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Build.LinuxMkLibs (mklibs) where
|
||||
|
||||
import Data.Maybe
|
||||
import System.FilePath
|
||||
import Control.Monad
|
||||
import Data.List
|
||||
import System.Posix.Files
|
||||
|
@ -18,6 +19,7 @@ import qualified System.Info
|
|||
import Prelude
|
||||
|
||||
import Utility.LinuxMkLibs
|
||||
import Utility.OsPath
|
||||
import Utility.Directory
|
||||
import Utility.Process
|
||||
import Utility.Monad
|
||||
|
@ -25,18 +27,18 @@ import Utility.Path
|
|||
import Utility.Path.AbsRel
|
||||
import Utility.FileMode
|
||||
import Utility.CopyFile
|
||||
import Utility.FileSystemEncoding
|
||||
import Utility.SystemDirectory
|
||||
import qualified Utility.OsString as OS
|
||||
|
||||
mklibs :: FilePath -> a -> IO Bool
|
||||
mklibs :: OsPath -> a -> IO Bool
|
||||
mklibs top _installedbins = do
|
||||
fs <- dirContentsRecursive (toRawFilePath top)
|
||||
exes <- filterM checkExe (map fromRawFilePath fs)
|
||||
fs <- dirContentsRecursive top
|
||||
exes <- filterM checkExe fs
|
||||
libs <- runLdd exes
|
||||
|
||||
glibclibs <- glibcLibs
|
||||
let libs' = nub $ libs ++ glibclibs
|
||||
let (linkers, otherlibs) = partition ("ld-linux" `isInfixOf`) libs'
|
||||
let (linkers, otherlibs) = partition (literalOsPath "ld-linux" `OS.isInfixOf`) libs'
|
||||
libdirs <- nub . catMaybes <$> mapM (installLib installFile top) otherlibs
|
||||
libdirs' <- consolidateUsrLib top libdirs
|
||||
|
||||
|
@ -45,8 +47,10 @@ mklibs top _installedbins = do
|
|||
|
||||
-- Various files used by runshell to set up env vars used by the
|
||||
-- linker shims.
|
||||
writeFile (top </> "libdirs") (unlines libdirs')
|
||||
writeFile (top </> "gconvdir") (fromRawFilePath $ parentDir $ toRawFilePath $ Prelude.head gconvlibs)
|
||||
writeFile (fromOsPath (top </> literalOsPath "libdirs"))
|
||||
(unlines (map fromOsPath libdirs'))
|
||||
writeFile (fromOsPath (top </> literalOsPath "gconvdir"))
|
||||
(fromOsPath (parentDir $ Prelude.head gconvlibs))
|
||||
|
||||
mapM_ (installLib installFile top) linkers
|
||||
let linker = Prelude.head linkers
|
||||
|
@ -60,9 +64,9 @@ mklibs top _installedbins = do
|
|||
-- fails, a minor optimisation will not happen, but there will be
|
||||
-- no bad results.
|
||||
hwcaplibdir d = not $ or
|
||||
[ "lib" == takeFileName d
|
||||
[ literalOsPath "lib" == takeFileName d
|
||||
-- eg, "lib/x86_64-linux-gnu"
|
||||
, "-linux-" `isInfixOf` takeFileName d
|
||||
, literalOsPath "-linux-" `OS.isInfixOf` takeFileName d
|
||||
]
|
||||
|
||||
{- If there are two libdirs that are the same except one is in
|
||||
|
@ -71,17 +75,17 @@ mklibs top _installedbins = do
|
|||
- needs to look in, and so reduces the number of failed stats
|
||||
- and improves startup time.
|
||||
-}
|
||||
consolidateUsrLib :: FilePath -> [FilePath] -> IO [FilePath]
|
||||
consolidateUsrLib :: OsPath -> [OsPath] -> IO [OsPath]
|
||||
consolidateUsrLib top libdirs = go [] libdirs
|
||||
where
|
||||
go c [] = return c
|
||||
go c (x:rest) = case filter (\d -> ("/usr" ++ d) == x) libdirs of
|
||||
go c (x:rest) = case filter (\d -> (literalOsPath "/usr" <> d) == x) libdirs of
|
||||
(d:_) -> do
|
||||
fs <- getDirectoryContents (inTop top x)
|
||||
forM_ fs $ \f -> do
|
||||
let src = inTop top (x </> f)
|
||||
let dst = inTop top (d </> f)
|
||||
unless (dirCruft (toRawFilePath f)) $
|
||||
unless (f `elem` dirCruft) $
|
||||
unlessM (doesDirectoryExist src) $
|
||||
renameFile src dst
|
||||
symlinkHwCapDirs top d
|
||||
|
@ -96,17 +100,17 @@ consolidateUsrLib top libdirs = go [] libdirs
|
|||
- to the libdir. This way, the linker will find a library the first place
|
||||
- it happens to look for it.
|
||||
-}
|
||||
symlinkHwCapDirs :: FilePath -> FilePath -> IO ()
|
||||
symlinkHwCapDirs :: OsPath -> OsPath -> IO ()
|
||||
symlinkHwCapDirs top libdir = forM_ hwcapdirs $ \d ->
|
||||
unlessM (doesDirectoryExist (top ++ libdir </> d)) $ do
|
||||
createDirectoryIfMissing True (top ++ libdir </> takeDirectory d)
|
||||
unlessM (doesDirectoryExist (top <> libdir </> d)) $ do
|
||||
createDirectoryIfMissing True (top <> libdir </> takeDirectory d)
|
||||
link <- relPathDirToFile
|
||||
(toRawFilePath (top ++ takeDirectory (libdir </> d)))
|
||||
(toRawFilePath (top ++ libdir))
|
||||
let link' = case fromRawFilePath link of
|
||||
(top <> takeDirectory (libdir </> d))
|
||||
(top <> libdir)
|
||||
let link' = case fromOsPath link of
|
||||
"" -> "."
|
||||
l -> l
|
||||
createSymbolicLink link' (top ++ libdir </> d)
|
||||
createSymbolicLink link' (fromOsPath (top <> libdir </> d))
|
||||
where
|
||||
hwcapdirs = case System.Info.arch of
|
||||
"x86_64" ->
|
||||
|
@ -145,50 +149,48 @@ symlinkHwCapDirs top libdir = forM_ hwcapdirs $ \d ->
|
|||
- The linker is symlinked to a file with the same basename as the binary,
|
||||
- since that looks better in ps than "ld-linux.so".
|
||||
-}
|
||||
installLinkerShim :: FilePath -> FilePath -> FilePath -> IO ()
|
||||
installLinkerShim :: OsPath -> OsPath -> OsPath -> IO ()
|
||||
installLinkerShim top linker exe = do
|
||||
createDirectoryIfMissing True (top </> shimdir)
|
||||
createDirectoryIfMissing True (top </> exedir)
|
||||
ifM (isSymbolicLink <$> getSymbolicLinkStatus exe)
|
||||
ifM (isSymbolicLink <$> getSymbolicLinkStatus (fromOsPath exe))
|
||||
( do
|
||||
sl <- readSymbolicLink exe
|
||||
removeWhenExistsWith removeLink exe
|
||||
removeWhenExistsWith removeLink exedest
|
||||
sl <- toOsPath <$> readSymbolicLink (fromOsPath exe)
|
||||
removeWhenExistsWith removeFile exe
|
||||
removeWhenExistsWith removeFile exedest
|
||||
-- Assume that for a symlink, the destination
|
||||
-- will also be shimmed.
|
||||
let sl' = ".." </> takeFileName sl </> takeFileName sl
|
||||
createSymbolicLink sl' exedest
|
||||
let sl' = literalOsPath ".." </> takeFileName sl </> takeFileName sl
|
||||
createSymbolicLink (fromOsPath sl') (fromOsPath exedest)
|
||||
, renameFile exe exedest
|
||||
)
|
||||
link <- relPathDirToFile
|
||||
(toRawFilePath (top </> exedir))
|
||||
(toRawFilePath (top ++ linker))
|
||||
link <- relPathDirToFile (top </> exedir) (top <> linker)
|
||||
unlessM (doesFileExist (top </> exelink)) $
|
||||
createSymbolicLink (fromRawFilePath link) (top </> exelink)
|
||||
writeFile exe $ unlines
|
||||
createSymbolicLink (fromOsPath link) (fromOsPath (top </> exelink))
|
||||
writeFile (fromOsPath exe) $ unlines
|
||||
[ "#!/bin/sh"
|
||||
, "exec \"$GIT_ANNEX_DIR/" ++ exelink ++ "\" --library-path \"$GIT_ANNEX_LD_LIBRARY_PATH\" \"$GIT_ANNEX_DIR/shimmed/" ++ base ++ "/" ++ base ++ "\" \"$@\""
|
||||
, "exec \"$GIT_ANNEX_DIR/" ++ fromOsPath exelink ++ "\" --library-path \"$GIT_ANNEX_LD_LIBRARY_PATH\" \"$GIT_ANNEX_DIR/shimmed/" ++ fromOsPath base ++ "/" ++ fromOsPath base ++ "\" \"$@\""
|
||||
]
|
||||
modifyFileMode (toRawFilePath exe) $ addModes executeModes
|
||||
modifyFileMode exe $ addModes executeModes
|
||||
where
|
||||
base = takeFileName exe
|
||||
shimdir = "shimmed" </> base
|
||||
exedir = "exe"
|
||||
shimdir = literalOsPath "shimmed" </> base
|
||||
exedir = literalOsPath "exe"
|
||||
exedest = top </> shimdir </> base
|
||||
exelink = exedir </> base
|
||||
|
||||
installFile :: FilePath -> FilePath -> IO ()
|
||||
installFile :: OsPath -> OsPath -> IO ()
|
||||
installFile top f = do
|
||||
createDirectoryIfMissing True destdir
|
||||
void $ copyFileExternal CopyTimeStamps f destdir
|
||||
where
|
||||
destdir = inTop top $ fromRawFilePath $ parentDir $ toRawFilePath f
|
||||
destdir = inTop top $ parentDir f
|
||||
|
||||
checkExe :: FilePath -> IO Bool
|
||||
checkExe :: OsPath -> IO Bool
|
||||
checkExe f
|
||||
| ".so" `isSuffixOf` f = return False
|
||||
| otherwise = ifM (isExecutable . fileMode <$> getFileStatus f)
|
||||
( checkFileExe <$> readProcess "file" ["-L", f]
|
||||
| literalOsPath ".so" `OS.isSuffixOf` f = return False
|
||||
| otherwise = ifM (isExecutable . fileMode <$> getFileStatus (fromOsPath f))
|
||||
( checkFileExe <$> readProcess "file" ["-L", fromOsPath f]
|
||||
, return False
|
||||
)
|
||||
|
||||
|
|
|
@ -7,12 +7,12 @@
|
|||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import System.Environment (getArgs)
|
||||
import Control.Monad.IfElse
|
||||
import System.FilePath
|
||||
import System.Posix.Files
|
||||
import Control.Monad
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
|
@ -20,11 +20,11 @@ import qualified Data.Map as M
|
|||
|
||||
import Utility.SafeCommand
|
||||
import Utility.Process
|
||||
import Utility.OsPath
|
||||
import Utility.Path
|
||||
import Utility.Path.AbsRel
|
||||
import Utility.Directory
|
||||
import Utility.Env
|
||||
import Utility.FileSystemEncoding
|
||||
import Utility.SystemDirectory
|
||||
import Build.BundledPrograms
|
||||
#ifdef darwin_HOST_OS
|
||||
|
@ -37,48 +37,46 @@ import Build.LinuxMkLibs (mklibs)
|
|||
import Utility.FileMode
|
||||
#endif
|
||||
|
||||
progDir :: FilePath -> FilePath
|
||||
progDir :: OsPath -> OsPath
|
||||
#ifdef darwin_HOST_OS
|
||||
progDir topdir = topdir
|
||||
#else
|
||||
progDir topdir = topdir </> "bin"
|
||||
progDir topdir = topdir </> literalOsPath "bin"
|
||||
#endif
|
||||
|
||||
extraProgDir :: FilePath -> FilePath
|
||||
extraProgDir :: OsPath -> OsPath
|
||||
extraProgDir topdir = topdir </> "extra"
|
||||
|
||||
installProg :: FilePath -> FilePath -> IO (FilePath, FilePath)
|
||||
installProg dir prog = searchPath prog >>= go
|
||||
installProg :: OsPath -> OsPath -> IO (OsPath, OsPath)
|
||||
installProg dir prog = searchPath (fromOsPath prog) >>= go
|
||||
where
|
||||
go Nothing = error $ "cannot find " ++ prog ++ " in PATH"
|
||||
go Nothing = error $ "cannot find " ++ fromOsPath prog ++ " in PATH"
|
||||
go (Just f) = do
|
||||
let dest = dir </> takeFileName f
|
||||
unlessM (boolSystem "install" [File f, File dest]) $
|
||||
error $ "install failed for " ++ prog
|
||||
unlessM (boolSystem "install" [File (fromOsPath f), File (fromOsPath dest)]) $
|
||||
error $ "install failed for " ++ fromOsPath prog
|
||||
return (dest, f)
|
||||
|
||||
installBundledPrograms :: FilePath -> IO (M.Map FilePath FilePath)
|
||||
installBundledPrograms :: OsPath -> IO (M.Map OsPath OsPath)
|
||||
installBundledPrograms topdir = M.fromList . concat <$> mapM go
|
||||
[ (progDir topdir, preferredBundledPrograms)
|
||||
, (extraProgDir topdir, extraBundledPrograms)
|
||||
[ (progDir topdir, map toOsPath preferredBundledPrograms)
|
||||
, (extraProgDir topdir, map toOsPath extraBundledPrograms)
|
||||
]
|
||||
where
|
||||
go (dir, progs) = do
|
||||
createDirectoryIfMissing True dir
|
||||
forM progs $ installProg dir
|
||||
|
||||
installGitLibs :: FilePath -> IO ()
|
||||
installGitLibs :: OsPath -> IO ()
|
||||
installGitLibs topdir = do
|
||||
-- install git-core programs; these are run by the git command
|
||||
createDirectoryIfMissing True gitcoredestdir
|
||||
execpath <- getgitpath "exec-path"
|
||||
cfs <- dirContents (toRawFilePath execpath)
|
||||
cfs <- dirContents execpath
|
||||
forM_ cfs $ \f -> do
|
||||
let f' = fromRawFilePath f
|
||||
destf <- ((gitcoredestdir </>) . fromRawFilePath)
|
||||
<$> relPathDirToFile
|
||||
(toRawFilePath execpath)
|
||||
f
|
||||
let f' = fromOsPath f
|
||||
destf <- (gitcoredestdir </>)
|
||||
<$> relPathDirToFile execpath f
|
||||
createDirectoryIfMissing True (takeDirectory destf)
|
||||
issymlink <- isSymbolicLink <$> getSymbolicLinkStatus f'
|
||||
if issymlink
|
||||
|
@ -93,99 +91,98 @@ installGitLibs topdir = do
|
|||
-- Other git-core files symlink to a file
|
||||
-- beside them in the directory. Those
|
||||
-- links can be copied as-is.
|
||||
linktarget <- readSymbolicLink f'
|
||||
linktarget <- toOsPath <$> readSymbolicLink f'
|
||||
if takeFileName linktarget == linktarget
|
||||
then cp f' destf
|
||||
then cp f destf
|
||||
else do
|
||||
let linktarget' = progDir topdir </> takeFileName linktarget
|
||||
unlessM (doesFileExist linktarget') $ do
|
||||
createDirectoryIfMissing True (takeDirectory linktarget')
|
||||
L.readFile f' >>= L.writeFile linktarget'
|
||||
removeWhenExistsWith removeLink destf
|
||||
L.readFile f' >>= L.writeFile (fromOsPath linktarget')
|
||||
removeWhenExistsWith removeFile destf
|
||||
rellinktarget <- relPathDirToFile
|
||||
(toRawFilePath (takeDirectory destf))
|
||||
(toRawFilePath linktarget')
|
||||
createSymbolicLink (fromRawFilePath rellinktarget) destf
|
||||
else cp f' destf
|
||||
(takeDirectory destf)
|
||||
(linktarget')
|
||||
createSymbolicLink (fromOsPath rellinktarget) (fromOsPath destf)
|
||||
else cp f destf
|
||||
|
||||
-- install git's template files
|
||||
-- git does not have an option to get the path of these,
|
||||
-- but they're architecture independent files, so are located
|
||||
-- next to the --man-path, in eg /usr/share/git-core
|
||||
manpath <- getgitpath "man-path"
|
||||
let templatepath = manpath </> ".." </> "git-core" </> "templates"
|
||||
tfs <- dirContents (toRawFilePath templatepath)
|
||||
let templatepath = manpath </> literalOsPath ".." </> literalOsPath "git-core" </> literalOsPath "templates"
|
||||
tfs <- dirContents templatepath
|
||||
forM_ tfs $ \f -> do
|
||||
destf <- ((templatedestdir </>) . fromRawFilePath)
|
||||
<$> relPathDirToFile
|
||||
(toRawFilePath templatepath)
|
||||
f
|
||||
destf <- (templatedestdir </>)
|
||||
<$> relPathDirToFile templatepath f
|
||||
createDirectoryIfMissing True (takeDirectory destf)
|
||||
cp (fromRawFilePath f) destf
|
||||
cp f destf
|
||||
where
|
||||
gitcoredestdir = topdir </> "git-core"
|
||||
templatedestdir = topdir </> "templates"
|
||||
gitcoredestdir = topdir </> literalOsPath "git-core"
|
||||
templatedestdir = topdir </> literalOsPath "templates"
|
||||
|
||||
getgitpath v = do
|
||||
let opt = "--" ++ v
|
||||
ls <- lines <$> readProcess "git" [opt]
|
||||
case ls of
|
||||
[] -> error $ "git " ++ opt ++ "did not output a location"
|
||||
(p:_) -> return p
|
||||
(p:_) -> return (toOsPath p)
|
||||
|
||||
cp :: FilePath -> FilePath -> IO ()
|
||||
cp :: OsPath -> OsPath -> IO ()
|
||||
cp src dest = do
|
||||
removeWhenExistsWith removeLink dest
|
||||
unlessM (boolSystem "cp" [Param "-a", File src, File dest]) $
|
||||
removeWhenExistsWith removeFile dest
|
||||
unlessM (boolSystem "cp" [Param "-a", File (fromOsPath src), File (fromOsPath dest)]) $
|
||||
error "cp failed"
|
||||
|
||||
installMagic :: FilePath -> IO ()
|
||||
installMagic :: OsPath -> IO ()
|
||||
#ifdef darwin_HOST_OS
|
||||
installMagic topdir = getEnv "OSX_MAGIC_FILE" >>= \case
|
||||
Nothing -> hPutStrLn stderr "OSX_MAGIC_FILE not set; not including it"
|
||||
Just f -> do
|
||||
let mdir = topdir </> "magic"
|
||||
let mdir = topdir </> literalOsPath "magic"
|
||||
createDirectoryIfMissing True mdir
|
||||
unlessM (boolSystem "cp" [File f, File (mdir </> "magic.mgc")]) $
|
||||
unlessM (boolSystem "cp" [File f, File (fromOsPath (mdir </> literalOsPath "magic.mgc"))]) $
|
||||
error "cp failed"
|
||||
#else
|
||||
installMagic topdir = do
|
||||
let mdir = topdir </> "magic"
|
||||
let mdir = topdir </> literalOsPath "magic"
|
||||
createDirectoryIfMissing True mdir
|
||||
unlessM (boolSystem "cp" [File "/usr/share/file/magic.mgc", File (mdir </> "magic.mgc")]) $
|
||||
unlessM (boolSystem "cp" [File "/usr/share/file/magic.mgc", File (fromOsPath (mdir </> literalOsPath "magic.mgc"))]) $
|
||||
error "cp failed"
|
||||
#endif
|
||||
|
||||
installLocales :: FilePath -> IO ()
|
||||
installLocales :: OsPath -> IO ()
|
||||
#ifdef darwin_HOST_OS
|
||||
installLocales _ = return ()
|
||||
#else
|
||||
installLocales topdir = cp "/usr/share/i18n" (topdir </> "i18n")
|
||||
installLocales topdir =
|
||||
cp (literalOsPath "/usr/share/i18n") (topdir </> "i18n")
|
||||
#endif
|
||||
|
||||
installSkel :: FilePath -> FilePath -> IO ()
|
||||
installSkel :: OsPath -> OsPath -> IO ()
|
||||
#ifdef darwin_HOST_OS
|
||||
installSkel _topdir basedir = do
|
||||
whenM (doesDirectoryExist basedir) $
|
||||
removeDirectoryRecursive basedir
|
||||
createDirectoryIfMissing True (takeDirectory basedir)
|
||||
unlessM (boolSystem "cp" [Param "-R", File "standalone/osx/git-annex.app", File basedir]) $
|
||||
unlessM (boolSystem "cp" [Param "-R", File "standalone/osx/git-annex.app", File (fromOsPath basedir)]) $
|
||||
error "cp failed"
|
||||
#else
|
||||
installSkel topdir _basedir = do
|
||||
whenM (doesDirectoryExist topdir) $
|
||||
removeDirectoryRecursive topdir
|
||||
createDirectoryIfMissing True (takeDirectory topdir)
|
||||
unlessM (boolSystem "cp" [Param "-R", File "standalone/linux/skel", File topdir]) $
|
||||
unlessM (boolSystem "cp" [Param "-R", File "standalone/linux/skel", File (fromOsPath topdir)]) $
|
||||
error "cp failed"
|
||||
#endif
|
||||
|
||||
installSkelRest :: FilePath -> FilePath -> Bool -> IO ()
|
||||
installSkelRest :: OsPath -> OsPath -> Bool -> IO ()
|
||||
#ifdef darwin_HOST_OS
|
||||
installSkelRest _topdir basedir _hwcaplibs = do
|
||||
plist <- lines <$> readFile "standalone/osx/Info.plist.template"
|
||||
version <- getVersion
|
||||
writeFile (basedir </> "Contents" </> "Info.plist")
|
||||
writeFile (fromOsPath (basedir </> literalOsPath "Contents" </> literalOsPath "Info.plist"))
|
||||
(unlines (map (expandversion version) plist))
|
||||
where
|
||||
expandversion v l = replace "GIT_ANNEX_VERSION" v l
|
||||
|
@ -195,10 +192,10 @@ installSkelRest topdir _basedir hwcaplibs = do
|
|||
-- GIT_ANNEX_PACKAGE_INSTALL can be set by a distributor and
|
||||
-- runshell will be modified
|
||||
gapi <- getEnv "GIT_ANNEX_PACKAGE_INSTALL"
|
||||
writeFile (topdir </> "runshell")
|
||||
writeFile (fromOsPath (topdir </> literalOsPath "runshell"))
|
||||
(unlines (map (expandrunshell gapi) runshell))
|
||||
modifyFileMode
|
||||
(toRawFilePath (topdir </> "runshell"))
|
||||
(topdir </> literalOsPath "runshell")
|
||||
(addModes executeModes)
|
||||
where
|
||||
expandrunshell (Just gapi) l@"GIT_ANNEX_PACKAGE_INSTALL=" = l ++ gapi
|
||||
|
@ -211,25 +208,25 @@ installSkelRest topdir _basedir hwcaplibs = do
|
|||
expandrunshell _ l = l
|
||||
#endif
|
||||
|
||||
installGitAnnex :: FilePath -> IO ()
|
||||
installGitAnnex :: OsPath -> IO ()
|
||||
#ifdef darwin_HOST_OS
|
||||
installGitAnnex topdir = go topdir
|
||||
#else
|
||||
installGitAnnex topdir = go (topdir </> "bin")
|
||||
installGitAnnex topdir = go (topdir </> literalOsPath "bin")
|
||||
#endif
|
||||
where
|
||||
go bindir = do
|
||||
createDirectoryIfMissing True bindir
|
||||
unlessM (boolSystem "cp" [File "git-annex", File bindir]) $
|
||||
unlessM (boolSystem "cp" [File "git-annex", File (fromOsPath bindir)]) $
|
||||
error "cp failed"
|
||||
unlessM (boolSystem "strip" [File (bindir </> "git-annex")]) $
|
||||
unlessM (boolSystem "strip" [File (fromOsPath (bindir </> literalOsPath "git-annex"))]) $
|
||||
error "strip failed"
|
||||
createSymbolicLink "git-annex" (bindir </> "git-annex-shell")
|
||||
createSymbolicLink "git-annex" (bindir </> "git-remote-tor-annex")
|
||||
createSymbolicLink "git-annex" (bindir </> "git-remote-annex")
|
||||
createSymbolicLink "git-annex" (fromOsPath (bindir </> literalOsPath "git-annex-shell"))
|
||||
createSymbolicLink "git-annex" (fromOsPath (bindir </> literalOsPath "git-remote-tor-annex"))
|
||||
createSymbolicLink "git-annex" (fromOsPath (bindir </> literalOsPath "git-remote-annex"))
|
||||
|
||||
main :: IO ()
|
||||
main = getArgs >>= go
|
||||
main = getArgs >>= go . map toOsPath
|
||||
where
|
||||
go (topdir:basedir:[]) = do
|
||||
installSkel topdir basedir
|
||||
|
|
|
@ -24,7 +24,6 @@ import Utility.Monad
|
|||
import Utility.Path
|
||||
import Utility.Path.AbsRel
|
||||
import Utility.Split
|
||||
import Utility.FileSystemEncoding
|
||||
import Utility.Env
|
||||
import Utility.Exception
|
||||
import Utility.OsPath
|
||||
|
@ -39,42 +38,42 @@ 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 installfile top lib = ifM (doesFileExist (toOsPath lib))
|
||||
installLib :: (OsPath -> OsPath -> IO ()) -> OsPath -> OsPath -> IO (Maybe OsPath)
|
||||
installLib installfile top lib = ifM (doesFileExist lib)
|
||||
( do
|
||||
installfile top lib
|
||||
checksymlink lib
|
||||
return $ Just $ fromOsPath $ parentDir $ toOsPath 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 (toOsPath f))
|
||||
(toOsPath l)
|
||||
target <- relPathDirToFile (takeDirectory (toOsPath f)) absl
|
||||
installfile top (fromOsPath absl)
|
||||
removeWhenExistsWith removeLink (toRawFilePath (top ++ f))
|
||||
createSymbolicLink (fromOsPath target) (inTop top f)
|
||||
checksymlink (fromOsPath absl)
|
||||
checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (fromOsPath (inTop top f))) $ do
|
||||
l <- readSymbolicLink (fromOsPath (inTop top f))
|
||||
let absl = absPathFrom (parentDir f) (toOsPath l)
|
||||
target <- relPathDirToFile (takeDirectory f) absl
|
||||
installfile top absl
|
||||
removeWhenExistsWith removeFile (inTop top f)
|
||||
createSymbolicLink (fromOsPath target) (fromOsPath (inTop top f))
|
||||
checksymlink absl
|
||||
|
||||
-- Note that f is not relative, so cannot use </>
|
||||
inTop :: FilePath -> FilePath -> RawFilePath
|
||||
inTop top f = toRawFilePath $ top ++ f
|
||||
inTop :: OsPath -> OsPath -> OsPath
|
||||
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
|
||||
parseLdd :: String -> [OsPath]
|
||||
parseLdd = map toOsPath
|
||||
. mapMaybe (getlib . dropWhile isSpace)
|
||||
. lines
|
||||
where
|
||||
getlib l = headMaybe . words =<< lastMaybe (split " => " l)
|
||||
|
||||
runLdd :: [String] -> IO [FilePath]
|
||||
runLdd :: [OsPath] -> IO [OsPath]
|
||||
runLdd exes = concat <$> mapM go exes
|
||||
where
|
||||
go exe = tryNonAsync (readProcess "ldd" [exe]) >>= \case
|
||||
go exe = tryNonAsync (readProcess "ldd" [fromOsPath exe]) >>= \case
|
||||
Right o -> return (parseLdd o)
|
||||
-- ldd for some reason segfaults when run in an arm64
|
||||
-- chroot on an amd64 host, on a binary produced by ghc.
|
||||
|
@ -82,21 +81,21 @@ runLdd exes = concat <$> mapM go exes
|
|||
Left _e -> do
|
||||
environ <- getEnvironment
|
||||
let environ' =("LD_TRACE_LOADED_OBJECTS","1"):environ
|
||||
parseLdd <$> readProcessEnv exe [] (Just environ')
|
||||
parseLdd <$> readProcessEnv (fromOsPath exe) [] (Just environ')
|
||||
|
||||
{- Get all glibc libs, and also libgcc_s
|
||||
-
|
||||
- XXX Debian specific. -}
|
||||
glibcLibs :: IO [FilePath]
|
||||
glibcLibs :: IO [OsPath]
|
||||
glibcLibs = do
|
||||
ls <- lines <$> readProcess "sh"
|
||||
["-c", "dpkg -L libc6:$(dpkg --print-architecture) | egrep '\\.so' | grep -v /gconv/ | grep -v ld.so.conf | grep -v sotruss-lib"]
|
||||
ls2 <- lines <$> readProcess "sh"
|
||||
["-c", "(dpkg -L libgcc-s1:$(dpkg --print-architecture 2>/dev/null) || dpkg -L libgcc1:$(dpkg --print-architecture)) | egrep '\\.so'"]
|
||||
return (ls++ls2)
|
||||
return (map toOsPath (ls++ls2))
|
||||
|
||||
{- Get gblibc's gconv libs, which are handled specially.. -}
|
||||
gconvLibs :: IO [FilePath]
|
||||
gconvLibs = lines <$> readProcess "sh"
|
||||
gconvLibs :: IO [OsPath]
|
||||
gconvLibs = map toOsPath . lines <$> readProcess "sh"
|
||||
["-c", "dpkg -L libc6:$(dpkg --print-architecture) | grep /gconv/"]
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue