File: Standalone.hs

package info (click to toggle)
git-annex 8.20210223-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 68,764 kB
  • sloc: haskell: 70,359; javascript: 9,103; sh: 1,304; makefile: 212; perl: 136; ansic: 44
file content (240 lines) | stat: -rw-r--r-- 7,581 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
{- 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"