- 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
import Prelude
import Utility.LinuxMkLibs
+import Utility.OsPath
import Utility.Directory
import Utility.Process
import Utility.Monad
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
-- 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
-- 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
- 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
- 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" ->
- 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
)
{-# 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
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
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
-- 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
-- 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
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
import Utility.Path
import Utility.Path.AbsRel
import Utility.Split
-import Utility.FileSystemEncoding
import Utility.Env
import Utility.Exception
import Utility.OsPath
{- 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.
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/"]
projects / git-annex.git / commitdiff