git-annex/Build/Standalone.hs
2020-11-09 12:12:25 -04:00

240 lines
7.4 KiB
Haskell

{- Makes standalone bundle.
-
- Copyright 2012-2020 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
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 qualified Data.Map as M
import Utility.SafeCommand
import Utility.Process
import Utility.Path
import Utility.Path.AbsRel
import Utility.Directory
import Utility.Env
import Utility.FileSystemEncoding
import Build.BundledPrograms
#ifdef darwin_HOST_OS
import System.IO
import Build.OSXMkLibs (mklibs)
import Build.Version
import Utility.Split
#else
import Build.LinuxMkLibs (mklibs)
import Utility.FileMode
#endif
progDir :: FilePath -> FilePath
#ifdef darwin_HOST_OS
progDir topdir = topdir
#else
progDir topdir = topdir </> "bin"
#endif
extraProgDir :: FilePath -> FilePath
extraProgDir topdir = topdir </> "extra"
installProg :: FilePath -> FilePath -> IO (FilePath, FilePath)
installProg dir prog = searchPath prog >>= go
where
go Nothing = error $ "cannot find " ++ prog ++ " in PATH"
go (Just f) = do
let dest = dir </> takeFileName f
unlessM (boolSystem "install" [File f, File dest]) $
error $ "install failed for " ++ prog
return (dest, f)
installBundledPrograms :: FilePath -> IO (M.Map FilePath FilePath)
installBundledPrograms topdir = M.fromList . concat <$> mapM go
[ (progDir topdir, preferredBundledPrograms)
, (extraProgDir topdir, extraBundledPrograms)
]
where
go (dir, progs) = do
createDirectoryIfMissing True dir
forM progs $ installProg dir
installGitLibs :: FilePath -> IO ()
installGitLibs topdir = do
-- install git-core programs; these are run by the git command
createDirectoryIfMissing True gitcoredestdir
execpath <- getgitpath "exec-path"
cfs <- dirContents execpath
forM_ cfs $ \f -> do
destf <- ((gitcoredestdir </>) . fromRawFilePath)
<$> relPathDirToFile
(toRawFilePath execpath)
(toRawFilePath f)
createDirectoryIfMissing True (takeDirectory destf)
issymlink <- isSymbolicLink <$> getSymbolicLinkStatus f
if issymlink
then do
-- many git-core files may symlink to eg
-- ../../bin/git, which is located outside
-- the git-core directory. The target of
-- such links is installed into the progDir
-- (if not already there), and the links
-- repointed to it.
--
-- Other git-core files symlink to a file
-- beside them in the directory. Those
-- links can be copied as-is.
linktarget <- readSymbolicLink f
if takeFileName linktarget == linktarget
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
rellinktarget <- relPathDirToFile
(toRawFilePath (takeDirectory destf))
(toRawFilePath linktarget')
createSymbolicLink (fromRawFilePath rellinktarget) 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 templatepath
forM_ tfs $ \f -> do
destf <- ((templatedestdir </>) . fromRawFilePath)
<$> relPathDirToFile
(toRawFilePath templatepath)
(toRawFilePath f)
createDirectoryIfMissing True (takeDirectory destf)
cp f destf
where
gitcoredestdir = topdir </> "git-core"
templatedestdir = topdir </> "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
cp :: FilePath -> FilePath -> IO ()
cp src dest = do
removeWhenExistsWith removeLink dest
unlessM (boolSystem "cp" [Param "-a", File src, File dest]) $
error "cp failed"
installMagic :: FilePath -> 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"
createDirectoryIfMissing True mdir
unlessM (boolSystem "cp" [File f, File (mdir </> "magic.mgc")]) $
error "cp failed"
#else
installMagic topdir = do
let mdir = topdir </> "magic"
createDirectoryIfMissing True mdir
unlessM (boolSystem "cp" [File "/usr/share/file/magic.mgc", File (mdir </> "magic.mgc")]) $
error "cp failed"
#endif
installLocales :: FilePath -> IO ()
#ifdef darwin_HOST_OS
installLocales _ = return ()
#else
installLocales topdir = cp "/usr/share/i18n" (topdir </> "i18n")
#endif
installSkel :: FilePath -> FilePath -> 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]) $
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]) $
error "cp failed"
#endif
installSkelRest :: FilePath -> FilePath -> 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")
(unlines (map (expandversion version) plist))
where
expandversion v l = replace "GIT_ANNEX_VERSION" v l
#else
installSkelRest topdir _basedir hwcaplibs = do
runshell <- lines <$> readFile "standalone/linux/skel/runshell"
-- GIT_ANNEX_PACKAGE_INSTALL can be set by a distributor and
-- runshell will be modified
gapi <- getEnv "GIT_ANNEX_PACKAGE_INSTALL"
writeFile (topdir </> "runshell")
(unlines (map (expandrunshell gapi) runshell))
modifyFileMode
(toRawFilePath (topdir </> "runshell"))
(addModes executeModes)
where
expandrunshell (Just gapi) l@"GIT_ANNEX_PACKAGE_INSTALL=" = l ++ gapi
-- This is an optimisation, that avoids the linker looking in
-- several directories for hwcap optimised libs, when there are
-- none.
expandrunshell _ l@"LD_HWCAP_MASK=" = l ++ if not hwcaplibs
then "0"
else ""
expandrunshell _ l = l
#endif
installGitAnnex :: FilePath -> IO ()
#ifdef darwin_HOST_OS
installGitAnnex topdir = go topdir
#else
installGitAnnex topdir = go (topdir </> "bin")
#endif
where
go bindir = do
createDirectoryIfMissing True bindir
unlessM (boolSystem "cp" [File "git-annex", File bindir]) $
error "cp failed"
unlessM (boolSystem "strip" [File (bindir </> "git-annex")]) $
error "strip failed"
createSymbolicLink "git-annex" (bindir </> "git-annex-shell")
createSymbolicLink "git-annex" (bindir </> "git-remote-tor-annex")
main :: IO ()
main = getArgs >>= go
where
go (topdir:basedir:[]) = do
installSkel topdir basedir
installGitAnnex topdir
installedbins <- installBundledPrograms topdir
installGitLibs topdir
installMagic topdir
installLocales topdir
hwcaplibs <- mklibs topdir installedbins
installSkelRest topdir basedir hwcaplibs
go _ = error "specify topdir and basedir"