mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

OsPath conversion of linuxstandalone builder

Browse source 
Sponsored-by: Joshua Antonishen
This commit is contained in:
Joey Hess 2025-02-11 12:12:27 -04:00
parent 2ff716be30
commit c85d5a0dc8
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 128 additions and 130 deletions
Download patch file Download diff file Expand all files Collapse all files

86
Build/LinuxMkLibs.hs
View file

@ -5,10 +5,11 @@
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
{-# LANGUAGE OverloadedStrings #-}
module Build.LinuxMkLibs (mklibs) where module Build.LinuxMkLibs (mklibs) where
import Data.Maybe import Data.Maybe
import System.FilePath
import Control.Monad import Control.Monad
import Data.List import Data.List
import System.Posix.Files import System.Posix.Files
@ -18,6 +19,7 @@ import qualified System.Info
import Prelude import Prelude
import Utility.LinuxMkLibs import Utility.LinuxMkLibs
import Utility.OsPath
import Utility.Directory import Utility.Directory
import Utility.Process import Utility.Process
import Utility.Monad import Utility.Monad
@ -25,18 +27,18 @@ import Utility.Path
import Utility.Path.AbsRel import Utility.Path.AbsRel
import Utility.FileMode import Utility.FileMode
import Utility.CopyFile import Utility.CopyFile
import Utility.FileSystemEncoding
import Utility.SystemDirectory import Utility.SystemDirectory
import qualified Utility.OsString as OS
mklibs :: FilePath -> a -> IO Bool mklibs :: OsPath -> a -> IO Bool
mklibs top _installedbins = do mklibs top _installedbins = do
fs <- dirContentsRecursive (toRawFilePath top) fs <- dirContentsRecursive top
exes <- filterM checkExe (map fromRawFilePath fs) exes <- filterM checkExe fs
libs <- runLdd exes libs <- runLdd exes
glibclibs <- glibcLibs glibclibs <- glibcLibs
let libs' = nub $ libs ++ 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 <- nub . catMaybes <$> mapM (installLib installFile top) otherlibs
libdirs' <- consolidateUsrLib top libdirs 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 -- Various files used by runshell to set up env vars used by the
-- linker shims. -- linker shims.
writeFile (top </> "libdirs") (unlines libdirs') writeFile (fromOsPath (top </> literalOsPath "libdirs"))
writeFile (top </> "gconvdir") (fromRawFilePath $ parentDir $ toRawFilePath $ Prelude.head gconvlibs) (unlines (map fromOsPath libdirs'))
writeFile (fromOsPath (top </> literalOsPath "gconvdir"))
(fromOsPath (parentDir $ Prelude.head gconvlibs))
mapM_ (installLib installFile top) linkers mapM_ (installLib installFile top) linkers
let linker = Prelude.head 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 -- fails, a minor optimisation will not happen, but there will be
-- no bad results. -- no bad results.
hwcaplibdir d = not $ or hwcaplibdir d = not $ or
[ "lib" == takeFileName d [ literalOsPath "lib" == takeFileName d
-- eg, "lib/x86_64-linux-gnu" -- 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 {- 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 - needs to look in, and so reduces the number of failed stats
- and improves startup time. - and improves startup time.
-} -}
consolidateUsrLib :: FilePath -> [FilePath] -> IO [FilePath] consolidateUsrLib :: OsPath -> [OsPath] -> IO [OsPath]
consolidateUsrLib top libdirs = go [] libdirs consolidateUsrLib top libdirs = go [] libdirs
where where
go c [] = return c 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 (d:_) -> do
fs <- getDirectoryContents (inTop top x) fs <- getDirectoryContents (inTop top x)
forM_ fs $ \f -> do forM_ fs $ \f -> do
let src = inTop top (x </> f) let src = inTop top (x </> f)
let dst = inTop top (d </> f) let dst = inTop top (d </> f)
unless (dirCruft (toRawFilePath f)) $ unless (f `elem` dirCruft) $
unlessM (doesDirectoryExist src) $ unlessM (doesDirectoryExist src) $
renameFile src dst renameFile src dst
symlinkHwCapDirs top d 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 - to the libdir. This way, the linker will find a library the first place
- it happens to look for it. - it happens to look for it.
-} -}
symlinkHwCapDirs :: FilePath -> FilePath -> IO () symlinkHwCapDirs :: OsPath -> OsPath -> IO ()
symlinkHwCapDirs top libdir = forM_ hwcapdirs $ \d -> symlinkHwCapDirs top libdir = forM_ hwcapdirs $ \d ->
unlessM (doesDirectoryExist (top ++ libdir </> d)) $ do unlessM (doesDirectoryExist (top <> libdir </> d)) $ do
createDirectoryIfMissing True (top ++ libdir </> takeDirectory d) createDirectoryIfMissing True (top <> libdir </> takeDirectory d)
link <- relPathDirToFile link <- relPathDirToFile
(toRawFilePath (top ++ takeDirectory (libdir </> d))) (top <> takeDirectory (libdir </> d))
(toRawFilePath (top ++ libdir)) (top <> libdir)
let link' = case fromRawFilePath link of let link' = case fromOsPath link of
"" -> "." "" -> "."
l -> l l -> l
createSymbolicLink link' (top ++ libdir </> d) createSymbolicLink link' (fromOsPath (top <> libdir </> d))
where where
hwcapdirs = case System.Info.arch of hwcapdirs = case System.Info.arch of
"x86_64" -> "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, - The linker is symlinked to a file with the same basename as the binary,
- since that looks better in ps than "ld-linux.so". - 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 installLinkerShim top linker exe = do
createDirectoryIfMissing True (top </> shimdir) createDirectoryIfMissing True (top </> shimdir)
createDirectoryIfMissing True (top </> exedir) createDirectoryIfMissing True (top </> exedir)
ifM (isSymbolicLink <$> getSymbolicLinkStatus exe) ifM (isSymbolicLink <$> getSymbolicLinkStatus (fromOsPath exe))
( do ( do
sl <- readSymbolicLink exe sl <- toOsPath <$> readSymbolicLink (fromOsPath exe)
removeWhenExistsWith removeLink exe removeWhenExistsWith removeFile exe
removeWhenExistsWith removeLink exedest removeWhenExistsWith removeFile exedest
-- Assume that for a symlink, the destination -- Assume that for a symlink, the destination
-- will also be shimmed. -- will also be shimmed.
let sl' = ".." </> takeFileName sl </> takeFileName sl let sl' = literalOsPath ".." </> takeFileName sl </> takeFileName sl
createSymbolicLink sl' exedest createSymbolicLink (fromOsPath sl') (fromOsPath exedest)
, renameFile exe exedest , renameFile exe exedest
) )
link <- relPathDirToFile link <- relPathDirToFile (top </> exedir) (top <> linker)
(toRawFilePath (top </> exedir))
(toRawFilePath (top ++ linker))
unlessM (doesFileExist (top </> exelink)) $ unlessM (doesFileExist (top </> exelink)) $
createSymbolicLink (fromRawFilePath link) (top </> exelink) createSymbolicLink (fromOsPath link) (fromOsPath (top </> exelink))
writeFile exe $ unlines writeFile (fromOsPath exe) $ unlines
[ "#!/bin/sh" [ "#!/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 where
base = takeFileName exe base = takeFileName exe
shimdir = "shimmed" </> base shimdir = literalOsPath "shimmed" </> base
exedir = "exe" exedir = literalOsPath "exe"
exedest = top </> shimdir </> base exedest = top </> shimdir </> base
exelink = exedir </> base exelink = exedir </> base
installFile :: FilePath -> FilePath -> IO () installFile :: OsPath -> OsPath -> IO ()
installFile top f = do installFile top f = do
createDirectoryIfMissing True destdir createDirectoryIfMissing True destdir
void $ copyFileExternal CopyTimeStamps f destdir void $ copyFileExternal CopyTimeStamps f destdir
where where
destdir = inTop top $ fromRawFilePath $ parentDir $ toRawFilePath f destdir = inTop top $ parentDir f
checkExe :: FilePath -> IO Bool checkExe :: OsPath -> IO Bool
checkExe f checkExe f
| ".so" `isSuffixOf` f = return False | literalOsPath ".so" `OS.isSuffixOf` f = return False
| otherwise = ifM (isExecutable . fileMode <$> getFileStatus f) | otherwise = ifM (isExecutable . fileMode <$> getFileStatus (fromOsPath f))
( checkFileExe <$> readProcess "file" ["-L", f] ( checkFileExe <$> readProcess "file" ["-L", fromOsPath f]
, return False , return False
) )

123
Build/Standalone.hs
View file

@ -7,12 +7,12 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where module Main where
import System.Environment (getArgs) import System.Environment (getArgs)
import Control.Monad.IfElse import Control.Monad.IfElse
import System.FilePath
import System.Posix.Files import System.Posix.Files
import Control.Monad import Control.Monad
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
@ -20,11 +20,11 @@ import qualified Data.Map as M
import Utility.SafeCommand import Utility.SafeCommand
import Utility.Process import Utility.Process
import Utility.OsPath
import Utility.Path import Utility.Path
import Utility.Path.AbsRel import Utility.Path.AbsRel
import Utility.Directory import Utility.Directory
import Utility.Env import Utility.Env
import Utility.FileSystemEncoding
import Utility.SystemDirectory import Utility.SystemDirectory
import Build.BundledPrograms import Build.BundledPrograms
#ifdef darwin_HOST_OS #ifdef darwin_HOST_OS
@ -37,48 +37,46 @@ import Build.LinuxMkLibs (mklibs)
import Utility.FileMode import Utility.FileMode
#endif #endif
progDir :: FilePath -> FilePath progDir :: OsPath -> OsPath
#ifdef darwin_HOST_OS #ifdef darwin_HOST_OS
progDir topdir = topdir progDir topdir = topdir
#else #else
progDir topdir = topdir </> "bin" progDir topdir = topdir </> literalOsPath "bin"
#endif #endif
extraProgDir :: FilePath -> FilePath extraProgDir :: OsPath -> OsPath
extraProgDir topdir = topdir </> "extra" extraProgDir topdir = topdir </> "extra"
installProg :: FilePath -> FilePath -> IO (FilePath, FilePath) installProg :: OsPath -> OsPath -> IO (OsPath, OsPath)
installProg dir prog = searchPath prog >>= go installProg dir prog = searchPath (fromOsPath prog) >>= go
where where
go Nothing = error $ "cannot find " ++ prog ++ " in PATH" go Nothing = error $ "cannot find " ++ fromOsPath prog ++ " in PATH"
go (Just f) = do go (Just f) = do
let dest = dir </> takeFileName f let dest = dir </> takeFileName f
unlessM (boolSystem "install" [File f, File dest]) $ unlessM (boolSystem "install" [File (fromOsPath f), File (fromOsPath dest)]) $
error $ "install failed for " ++ prog error $ "install failed for " ++ fromOsPath prog
return (dest, f) return (dest, f)
installBundledPrograms :: FilePath -> IO (M.Map FilePath FilePath) installBundledPrograms :: OsPath -> IO (M.Map OsPath OsPath)
installBundledPrograms topdir = M.fromList . concat <$> mapM go installBundledPrograms topdir = M.fromList . concat <$> mapM go
[ (progDir topdir, preferredBundledPrograms) [ (progDir topdir, map toOsPath preferredBundledPrograms)
, (extraProgDir topdir, extraBundledPrograms) , (extraProgDir topdir, map toOsPath extraBundledPrograms)
] ]
where where
go (dir, progs) = do go (dir, progs) = do
createDirectoryIfMissing True dir createDirectoryIfMissing True dir
forM progs $ installProg dir forM progs $ installProg dir
installGitLibs :: FilePath -> IO () installGitLibs :: OsPath -> IO ()
installGitLibs topdir = do installGitLibs topdir = do
-- install git-core programs; these are run by the git command -- install git-core programs; these are run by the git command
createDirectoryIfMissing True gitcoredestdir createDirectoryIfMissing True gitcoredestdir
execpath <- getgitpath "exec-path" execpath <- getgitpath "exec-path"
cfs <- dirContents (toRawFilePath execpath) cfs <- dirContents execpath
forM_ cfs $ \f -> do forM_ cfs $ \f -> do
let f' = fromRawFilePath f let f' = fromOsPath f
destf <- ((gitcoredestdir </>) . fromRawFilePath) destf <- (gitcoredestdir </>)
<$> relPathDirToFile <$> relPathDirToFile execpath f
(toRawFilePath execpath)
f
createDirectoryIfMissing True (takeDirectory destf) createDirectoryIfMissing True (takeDirectory destf)
issymlink <- isSymbolicLink <$> getSymbolicLinkStatus f' issymlink <- isSymbolicLink <$> getSymbolicLinkStatus f'
if issymlink if issymlink
@ -93,99 +91,98 @@ installGitLibs topdir = do
-- Other git-core files symlink to a file -- Other git-core files symlink to a file
-- beside them in the directory. Those -- beside them in the directory. Those
-- links can be copied as-is. -- links can be copied as-is.
linktarget <- readSymbolicLink f' linktarget <- toOsPath <$> readSymbolicLink f'
if takeFileName linktarget == linktarget if takeFileName linktarget == linktarget
then cp f' destf then cp f destf
else do else do
let linktarget' = progDir topdir </> takeFileName linktarget let linktarget' = progDir topdir </> takeFileName linktarget
unlessM (doesFileExist linktarget') $ do unlessM (doesFileExist linktarget') $ do
createDirectoryIfMissing True (takeDirectory linktarget') createDirectoryIfMissing True (takeDirectory linktarget')
L.readFile f' >>= L.writeFile linktarget' L.readFile f' >>= L.writeFile (fromOsPath linktarget')
removeWhenExistsWith removeLink destf removeWhenExistsWith removeFile destf
rellinktarget <- relPathDirToFile rellinktarget <- relPathDirToFile
(toRawFilePath (takeDirectory destf)) (takeDirectory destf)
(toRawFilePath linktarget') (linktarget')
createSymbolicLink (fromRawFilePath rellinktarget) destf createSymbolicLink (fromOsPath rellinktarget) (fromOsPath destf)
else cp f' destf else cp f destf
-- install git's template files -- install git's template files
-- git does not have an option to get the path of these, -- git does not have an option to get the path of these,
-- but they're architecture independent files, so are located -- but they're architecture independent files, so are located
-- next to the --man-path, in eg /usr/share/git-core -- next to the --man-path, in eg /usr/share/git-core
manpath <- getgitpath "man-path" manpath <- getgitpath "man-path"
let templatepath = manpath </> ".." </> "git-core" </> "templates" let templatepath = manpath </> literalOsPath ".." </> literalOsPath "git-core" </> literalOsPath "templates"
tfs <- dirContents (toRawFilePath templatepath) tfs <- dirContents templatepath
forM_ tfs $ \f -> do forM_ tfs $ \f -> do
destf <- ((templatedestdir </>) . fromRawFilePath) destf <- (templatedestdir </>)
<$> relPathDirToFile <$> relPathDirToFile templatepath f
(toRawFilePath templatepath)
f
createDirectoryIfMissing True (takeDirectory destf) createDirectoryIfMissing True (takeDirectory destf)
cp (fromRawFilePath f) destf cp f destf
where where
gitcoredestdir = topdir </> "git-core" gitcoredestdir = topdir </> literalOsPath "git-core"
templatedestdir = topdir </> "templates" templatedestdir = topdir </> literalOsPath "templates"
getgitpath v = do getgitpath v = do
let opt = "--" ++ v let opt = "--" ++ v
ls <- lines <$> readProcess "git" [opt] ls <- lines <$> readProcess "git" [opt]
case ls of case ls of
[] -> error $ "git " ++ opt ++ "did not output a location" [] -> 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 cp src dest = do
removeWhenExistsWith removeLink dest removeWhenExistsWith removeFile dest
unlessM (boolSystem "cp" [Param "-a", File src, File dest]) $ unlessM (boolSystem "cp" [Param "-a", File (fromOsPath src), File (fromOsPath dest)]) $
error "cp failed" error "cp failed"
installMagic :: FilePath -> IO () installMagic :: OsPath -> IO ()
#ifdef darwin_HOST_OS #ifdef darwin_HOST_OS
installMagic topdir = getEnv "OSX_MAGIC_FILE" >>= \case installMagic topdir = getEnv "OSX_MAGIC_FILE" >>= \case
Nothing -> hPutStrLn stderr "OSX_MAGIC_FILE not set; not including it" Nothing -> hPutStrLn stderr "OSX_MAGIC_FILE not set; not including it"
Just f -> do Just f -> do
let mdir = topdir </> "magic" let mdir = topdir </> literalOsPath "magic"
createDirectoryIfMissing True mdir 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" error "cp failed"
#else #else
installMagic topdir = do installMagic topdir = do
let mdir = topdir </> "magic" let mdir = topdir </> literalOsPath "magic"
createDirectoryIfMissing True mdir 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" error "cp failed"
#endif #endif
installLocales :: FilePath -> IO () installLocales :: OsPath -> IO ()
#ifdef darwin_HOST_OS #ifdef darwin_HOST_OS
installLocales _ = return () installLocales _ = return ()
#else #else
installLocales topdir = cp "/usr/share/i18n" (topdir </> "i18n") installLocales topdir =
cp (literalOsPath "/usr/share/i18n") (topdir </> "i18n")
#endif #endif
installSkel :: FilePath -> FilePath -> IO () installSkel :: OsPath -> OsPath -> IO ()
#ifdef darwin_HOST_OS #ifdef darwin_HOST_OS
installSkel _topdir basedir = do installSkel _topdir basedir = do
whenM (doesDirectoryExist basedir) $ whenM (doesDirectoryExist basedir) $
removeDirectoryRecursive basedir removeDirectoryRecursive basedir
createDirectoryIfMissing True (takeDirectory 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" error "cp failed"
#else #else
installSkel topdir _basedir = do installSkel topdir _basedir = do
whenM (doesDirectoryExist topdir) $ whenM (doesDirectoryExist topdir) $
removeDirectoryRecursive topdir removeDirectoryRecursive topdir
createDirectoryIfMissing True (takeDirectory 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" error "cp failed"
#endif #endif
installSkelRest :: FilePath -> FilePath -> Bool -> IO () installSkelRest :: OsPath -> OsPath -> Bool -> IO ()
#ifdef darwin_HOST_OS #ifdef darwin_HOST_OS
installSkelRest _topdir basedir _hwcaplibs = do installSkelRest _topdir basedir _hwcaplibs = do
plist <- lines <$> readFile "standalone/osx/Info.plist.template" plist <- lines <$> readFile "standalone/osx/Info.plist.template"
version <- getVersion version <- getVersion
writeFile (basedir </> "Contents" </> "Info.plist") writeFile (fromOsPath (basedir </> literalOsPath "Contents" </> literalOsPath "Info.plist"))
(unlines (map (expandversion version) plist)) (unlines (map (expandversion version) plist))
where where
expandversion v l = replace "GIT_ANNEX_VERSION" v l 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 -- GIT_ANNEX_PACKAGE_INSTALL can be set by a distributor and
-- runshell will be modified -- runshell will be modified
gapi <- getEnv "GIT_ANNEX_PACKAGE_INSTALL" gapi <- getEnv "GIT_ANNEX_PACKAGE_INSTALL"
writeFile (topdir </> "runshell") writeFile (fromOsPath (topdir </> literalOsPath "runshell"))
(unlines (map (expandrunshell gapi) runshell)) (unlines (map (expandrunshell gapi) runshell))
modifyFileMode modifyFileMode
(toRawFilePath (topdir </> "runshell")) (topdir </> literalOsPath "runshell")
(addModes executeModes) (addModes executeModes)
where where
expandrunshell (Just gapi) l@"GIT_ANNEX_PACKAGE_INSTALL=" = l ++ gapi expandrunshell (Just gapi) l@"GIT_ANNEX_PACKAGE_INSTALL=" = l ++ gapi
@ -211,25 +208,25 @@ installSkelRest topdir _basedir hwcaplibs = do
expandrunshell _ l = l expandrunshell _ l = l
#endif #endif
installGitAnnex :: FilePath -> IO () installGitAnnex :: OsPath -> IO ()
#ifdef darwin_HOST_OS #ifdef darwin_HOST_OS
installGitAnnex topdir = go topdir installGitAnnex topdir = go topdir
#else #else
installGitAnnex topdir = go (topdir </> "bin") installGitAnnex topdir = go (topdir </> literalOsPath "bin")
#endif #endif
where where
go bindir = do go bindir = do
createDirectoryIfMissing True bindir createDirectoryIfMissing True bindir
unlessM (boolSystem "cp" [File "git-annex", File bindir]) $ unlessM (boolSystem "cp" [File "git-annex", File (fromOsPath bindir)]) $
error "cp failed" error "cp failed"
unlessM (boolSystem "strip" [File (bindir </> "git-annex")]) $ unlessM (boolSystem "strip" [File (fromOsPath (bindir </> literalOsPath "git-annex"))]) $
error "strip failed" error "strip failed"
createSymbolicLink "git-annex" (bindir </> "git-annex-shell") createSymbolicLink "git-annex" (fromOsPath (bindir </> literalOsPath "git-annex-shell"))
createSymbolicLink "git-annex" (bindir </> "git-remote-tor-annex") createSymbolicLink "git-annex" (fromOsPath (bindir </> literalOsPath "git-remote-tor-annex"))
createSymbolicLink "git-annex" (bindir </> "git-remote-annex") createSymbolicLink "git-annex" (fromOsPath (bindir </> literalOsPath "git-remote-annex"))
main :: IO () main :: IO ()
main = getArgs >>= go main = getArgs >>= go . map toOsPath
where where
go (topdir:basedir:[]) = do go (topdir:basedir:[]) = do
installSkel topdir basedir installSkel topdir basedir

49
Utility/LinuxMkLibs.hs
View file

@ -24,7 +24,6 @@ import Utility.Monad
import Utility.Path import Utility.Path
import Utility.Path.AbsRel import Utility.Path.AbsRel
import Utility.Split import Utility.Split
import Utility.FileSystemEncoding
import Utility.Env import Utility.Env
import Utility.Exception import Utility.Exception
import Utility.OsPath import Utility.OsPath
@ -39,42 +38,42 @@ import Prelude
{- Installs a library. If the library is a symlink to another file, {- 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. -} - install the file it links to, and update the symlink to be relative. -}
installLib :: (FilePath -> FilePath -> IO ()) -> FilePath -> FilePath -> IO (Maybe FilePath) installLib :: (OsPath -> OsPath -> IO ()) -> OsPath -> OsPath -> IO (Maybe OsPath)
installLib installfile top lib = ifM (doesFileExist (toOsPath lib)) installLib installfile top lib = ifM (doesFileExist lib)
( do ( do
installfile top lib installfile top lib
checksymlink lib checksymlink lib
return $ Just $ fromOsPath $ parentDir $ toOsPath lib return $ Just $ parentDir lib
, return Nothing , return Nothing
) )
where where
checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (fromOsPath (inTop top f))) $ do
l <- readSymbolicLink (inTop top f) l <- readSymbolicLink (fromOsPath (inTop top f))
let absl = absPathFrom let absl = absPathFrom (parentDir f) (toOsPath l)
(parentDir (toOsPath f)) target <- relPathDirToFile (takeDirectory f) absl
(toOsPath l) installfile top absl
target <- relPathDirToFile (takeDirectory (toOsPath f)) absl removeWhenExistsWith removeFile (inTop top f)
installfile top (fromOsPath absl) createSymbolicLink (fromOsPath target) (fromOsPath (inTop top f))
removeWhenExistsWith removeLink (toRawFilePath (top ++ f)) checksymlink absl
createSymbolicLink (fromOsPath target) (inTop top f)
checksymlink (fromOsPath absl)
-- Note that f is not relative, so cannot use </> -- Note that f is not relative, so cannot use </>
inTop :: FilePath -> FilePath -> RawFilePath inTop :: OsPath -> OsPath -> OsPath
inTop top f = toRawFilePath $ top ++ f inTop top f = top <> f
{- Parse ldd output, getting all the libraries that the input files {- Parse ldd output, getting all the libraries that the input files
- link to. Note that some of the libraries may not exist - link to. Note that some of the libraries may not exist
- (eg, linux-vdso.so) -} - (eg, linux-vdso.so) -}
parseLdd :: String -> [FilePath] parseLdd :: String -> [OsPath]
parseLdd = mapMaybe (getlib . dropWhile isSpace) . lines parseLdd = map toOsPath
. mapMaybe (getlib . dropWhile isSpace)
. lines
where where
getlib l = headMaybe . words =<< lastMaybe (split " => " l) getlib l = headMaybe . words =<< lastMaybe (split " => " l)
runLdd :: [String] -> IO [FilePath] runLdd :: [OsPath] -> IO [OsPath]
runLdd exes = concat <$> mapM go exes runLdd exes = concat <$> mapM go exes
where where
go exe = tryNonAsync (readProcess "ldd" [exe]) >>= \case go exe = tryNonAsync (readProcess "ldd" [fromOsPath exe]) >>= \case
Right o -> return (parseLdd o) Right o -> return (parseLdd o)
-- ldd for some reason segfaults when run in an arm64 -- ldd for some reason segfaults when run in an arm64
-- chroot on an amd64 host, on a binary produced by ghc. -- chroot on an amd64 host, on a binary produced by ghc.
@ -82,21 +81,21 @@ runLdd exes = concat <$> mapM go exes
Left _e -> do Left _e -> do
environ <- getEnvironment environ <- getEnvironment
let environ' =("LD_TRACE_LOADED_OBJECTS","1"):environ 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 {- Get all glibc libs, and also libgcc_s
- -
- XXX Debian specific. -} - XXX Debian specific. -}
glibcLibs :: IO [FilePath] glibcLibs :: IO [OsPath]
glibcLibs = do glibcLibs = do
ls <- lines <$> readProcess "sh" 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"] ["-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" ls2 <- lines <$> readProcess "sh"
["-c", "(dpkg -L libgcc-s1:$(dpkg --print-architecture 2>/dev/null) || dpkg -L libgcc1:$(dpkg --print-architecture)) | egrep '\\.so'"] ["-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.. -} {- Get gblibc's gconv libs, which are handled specially.. -}
gconvLibs :: IO [FilePath] gconvLibs :: IO [OsPath]
gconvLibs = lines <$> readProcess "sh" gconvLibs = map toOsPath . lines <$> readProcess "sh"
["-c", "dpkg -L libc6:$(dpkg --print-architecture) | grep /gconv/"] ["-c", "dpkg -L libc6:$(dpkg --print-architecture) | grep /gconv/"]