120 lines
3.6 KiB
Haskell
120 lines
3.6 KiB
Haskell
{- Makes standalone bundle.
|
|
-
|
|
- Copyright 2012-2019 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Main where
|
|
|
|
import Control.Monad.IfElse
|
|
import System.Environment
|
|
import System.FilePath
|
|
import System.Posix.Files
|
|
import Control.Monad
|
|
import Build.BundledPrograms
|
|
import qualified Data.ByteString.Lazy as L
|
|
|
|
import Utility.SafeCommand
|
|
import Utility.Process
|
|
import Utility.Path
|
|
import Utility.Directory
|
|
|
|
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)
|
|
|
|
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 </>)
|
|
<$> relPathDirToFile execpath 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'
|
|
nukeFile destf
|
|
rellinktarget <- relPathDirToFile (takeDirectory destf) linktarget'
|
|
createSymbolicLink 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 </>)
|
|
<$> relPathDirToFile templatepath 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 src dest = do
|
|
nukeFile dest
|
|
unlessM (boolSystem "cp" [Param "-a", File src, File dest]) $
|
|
error "cp failed"
|
|
|
|
main :: IO ()
|
|
main = getArgs >>= go
|
|
where
|
|
go [] = error "specify topdir"
|
|
go (topdir:_) = do
|
|
installed <- forM
|
|
[ (progDir topdir, preferredBundledPrograms)
|
|
, (extraProgDir topdir, extraBundledPrograms) ] $ \(dir, progs) -> do
|
|
createDirectoryIfMissing True dir
|
|
forM progs $ installProg dir
|
|
writeFile "tmp/standalone-installed" (show (concat installed))
|
|
installGitLibs topdir
|