summaryrefslogtreecommitdiff
path: root/src/Propellor/Bootstrap.hs
blob: d772d7c77fe28b24d1de714c1ad80649cf395eab (plain)
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
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
{-# LANGUAGE DeriveDataTypeable #-}

module Propellor.Bootstrap (
	Bootstrapper(..),
	Builder(..),
	defaultBootstrapper,
	getBootstrapper,
	bootstrapPropellorCommand,
	checkBinaryCommand,
	installGitCommand,
	buildPropellor,
	checkDepsCommand,
	buildCommand,
) where

import Propellor.Base
import Propellor.Types.Info
import Propellor.Git.Config

import System.Posix.Files
import Data.List

type ShellCommand = String

-- | Different ways that Propellor's dependencies can be installed,
-- and propellor can be built. The default is `Robustly Cabal`
--
-- `Robustly Cabal` and `Robustly Stack` use the OS's native packages
-- as much as possible to install Cabal, Stack, and propellor's build
-- dependencies. When necessary, dependencies are built from source
-- using Cabal or Stack rather than using the OS's native packages.
--
-- `OSOnly` uses the OS's native packages of Cabal and all of propellor's
-- build dependencies. It may not work on all systems.
data Bootstrapper = Robustly Builder | OSOnly
	deriving (Show, Typeable)

data Builder = Cabal | Stack
	deriving (Show, Typeable)

defaultBootstrapper :: Bootstrapper
defaultBootstrapper = Robustly Cabal

-- | Gets the Bootstrapper for the Host propellor is running on.
getBootstrapper :: Propellor Bootstrapper
getBootstrapper = go <$> askInfo
  where
	go NoInfoVal = defaultBootstrapper
	go (InfoVal bs) = bs

getBuilder :: Bootstrapper -> Builder
getBuilder (Robustly b) = b
getBuilder OSOnly = Cabal

-- Shell command line to ensure propellor is bootstrapped and ready to run.
-- Should be run inside the propellor config dir, and will install
-- all necessary build dependencies and build propellor.
bootstrapPropellorCommand :: Bootstrapper -> Maybe System -> ShellCommand
bootstrapPropellorCommand bs msys = checkDepsCommand bs msys ++
	"&& if ! test -x ./propellor; then "
		++ buildCommand bs ++
	"; fi;" ++ checkBinaryCommand bs

-- Use propellor --check to detect if the local propellor binary has
-- stopped working (eg due to library changes), and must be rebuilt.
checkBinaryCommand :: Bootstrapper -> ShellCommand
checkBinaryCommand bs = "if test -x ./propellor && ! ./propellor --check; then " ++ go (getBuilder bs) ++ "; fi"
  where
	go Cabal = intercalate " && "
		[ "cabal clean"
		, buildCommand bs
		]
	go Stack = intercalate " && "
		[ "stack clean"
		, buildCommand bs
		]

buildCommand :: Bootstrapper -> ShellCommand
buildCommand bs = intercalate " && " (go (getBuilder bs))
  where
	go Cabal =
		[ "cabal configure"
		, "cabal build -j1 propellor-config"
		, "ln -sf dist/build/propellor-config/propellor-config propellor"
		]
	go Stack =
		[ "stack build :propellor-config"
		, "ln -sf $(stack path --dist-dir)/build/propellor-config/propellor-config propellor"
		]

-- Check if all dependencies are installed; if not, run the depsCommand.
checkDepsCommand :: Bootstrapper -> Maybe System -> ShellCommand
checkDepsCommand bs sys = go (getBuilder bs)
  where
	go Cabal = "if ! cabal configure >/dev/null 2>&1; then " ++ depsCommand bs sys ++ "; fi"
	go Stack = "if ! stack build --dry-run >/dev/null 2>&1; then " ++ depsCommand bs sys ++ "; fi"

data Dep = Dep String | OldDep String

-- Install build dependencies of propellor, using the specified
-- Bootstrapper.
--
-- When bootstrapping Robustly, first try to install the builder, 
-- and all haskell libraries that propellor uses from OS packages.
-- Some packages may not be available in some versions of the OS,
-- or propellor may need a newer version. So, as a second step, 
-- ny other dependencies are installed from source using the builder.
--
-- Note: May succeed and leave some deps not installed.
depsCommand :: Bootstrapper -> Maybe System -> ShellCommand
depsCommand bs msys = "( " ++ intercalate " ; " (go bs) ++ ") || true"
  where
	go (Robustly Cabal) = osinstall Cabal ++
		[ "cabal update"
		, "cabal install --only-dependencies"
		]	
	go (Robustly Stack) = osinstall Stack ++ 
		[ "stack setup"
		, "stack build --only-dependencies :propellor-config"
		]
	go OSOnly = osinstall Cabal

	osinstall builder = case msys of
		Just (System (FreeBSD _) _) -> map pkginstall (fbsddeps builder)
		Just (System (ArchLinux) _) -> map pacmaninstall (archlinuxdeps builder)
		Just (System (Debian _ _) _) -> useapt builder
		Just (System (Buntish _) _) -> useapt builder
		-- assume a Debian derived system when not specified
		Nothing -> useapt builder

	useapt builder = "apt-get update" : map aptinstall (debdeps builder)

	aptinstall (Dep p) = "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-recommends -y install " ++ p
	aptinstall (OldDep p) = "if LANG=C apt-cache policy " ++ p ++ "| grep -q Candidate:; then " ++ aptinstall (Dep p) ++ "; fi"
	pkginstall p = "ASSUME_ALWAYS_YES=yes pkg install " ++ p
	pacmaninstall p = "pacman -S --noconfirm --needed " ++ p

	debdeps Cabal =
		[ Dep "gnupg"
		-- Below are the same deps listed in debian/control.
		, Dep "ghc"
		, Dep "cabal-install"
		, Dep "libghc-async-dev"
		, Dep "libghc-split-dev"
		, Dep "libghc-hslogger-dev"
		, Dep "libghc-unix-compat-dev"
		, Dep "libghc-ansi-terminal-dev"
		, Dep "libghc-ifelse-dev"
		, Dep "libghc-network-dev"
		, Dep "libghc-mtl-dev"
		, Dep "libghc-transformers-dev"
		, Dep "libghc-exceptions-dev"
		, Dep "libghc-text-dev"
		, Dep "libghc-hashable-dev"
		-- Deps that are only needed on old systems.
		, OldDep "libghc-stm-dev"
		]
	debdeps Stack =
		[ Dep "gnupg"
		, Dep "haskell-stack"
		]

	fbsddeps Cabal =
		[ "gnupg"
		, "ghc"
		, "hs-cabal-install"
		, "hs-async"
		, "hs-split"
		, "hs-hslogger"
		, "hs-unix-compat"
		, "hs-ansi-terminal"
		, "hs-IfElse"
		, "hs-network"
		, "hs-mtl"
		, "hs-transformers-base"
		, "hs-exceptions"
		, "hs-stm"
		, "hs-text"
		, "hs-hashable"
		]
	fbsddeps Stack =
		[ "gnupg"
		, "stack"
		]

	archlinuxdeps Cabal =
		[ "gnupg"
		, "ghc"
		, "cabal-install"
		, "haskell-async"
		, "haskell-split"
		, "haskell-hslogger"
		, "haskell-unix-compat"
		, "haskell-ansi-terminal"
		, "haskell-hackage-security"
		, "haskell-ifelse"
		, "haskell-network"
		, "haskell-mtl"
		, "haskell-transformers-base"
		, "haskell-exceptions"
		, "haskell-stm"
		, "haskell-text"
		, "haskell-hashable"
		, "haskell-type-errors"
		]
	archlinuxdeps Stack = 
		[ "gnupg"
		, "stack"
		]

installGitCommand :: Maybe System -> ShellCommand
installGitCommand msys = case msys of
	(Just (System (Debian _ _) _)) -> use apt
	(Just (System (Buntish _) _)) -> use apt
	(Just (System (FreeBSD _) _)) -> use
		[ "ASSUME_ALWAYS_YES=yes pkg update"
		, "ASSUME_ALWAYS_YES=yes pkg install git"
		]
	(Just (System (ArchLinux) _)) -> use
		[ "pacman -S --noconfirm --needed git"]
	-- assume a debian derived system when not specified
	Nothing -> use apt
  where
	use cmds = "if ! git --version >/dev/null 2>&1; then " ++ intercalate " && " cmds ++ "; fi"
	apt =
		[ "apt-get update"
		, "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-install-recommends --no-upgrade -y install git"
		]

-- Build propellor, and symlink the built binary to ./propellor.
--
-- When the Host has a Buildsystem specified it is used. If none is
-- specified, look at git config propellor.buildsystem.
buildPropellor :: Maybe Host -> IO ()
buildPropellor mh = unlessM (actionMessage "Propellor build" build) $
	errorMessage "Propellor build failed!"
  where
	msys = case fmap (fromInfo . hostInfo) mh of
		Just (InfoVal sys) -> Just sys
		_ -> Nothing

	build = catchBoolIO $ do
		case fromInfo (maybe mempty hostInfo mh) of
			NoInfoVal -> do			
				bs <- getGitConfigValue "propellor.buildsystem"
				case bs of
					Just "stack" -> stackBuild msys
					_ -> cabalBuild msys
			InfoVal bs -> case getBuilder bs of
				Cabal -> cabalBuild msys
				Stack -> stackBuild msys

-- For speed, only runs cabal configure when it's not been run before.
-- If the build fails cabal may need to have configure re-run.
--
-- If the cabal configure fails, and a System is provided, installs
-- dependencies and retries.
cabalBuild :: Maybe System -> IO Bool
cabalBuild msys = do
	make "dist/setup-config" ["propellor.cabal"] cabal_configure
	unlessM cabal_build $
		unlessM (cabal_configure <&&> cabal_build) $
			error "cabal build failed"
	-- For safety against eg power loss in the middle of the build,
	-- make a copy of the binary, and move it into place atomically.
	-- This ensures that the propellor symlink only ever points at
	-- a binary that is fully built. Also, avoid ever removing
	-- or breaking the symlink.
	--
	-- Need cp -pfRL to make build timestamp checking work.
	unlessM (boolSystem "cp" [Param "-pfRL", Param cabalbuiltbin, Param (tmpfor safetycopy)]) $
		error "cp of binary failed"
	rename (tmpfor safetycopy) safetycopy
	symlinkPropellorBin safetycopy
	return True
  where
	cabalbuiltbin = "dist/build/propellor-config/propellor-config"
	safetycopy = cabalbuiltbin ++ ".built"
	cabal_configure = ifM (cabal ["configure"])
		( return True
		, case msys of
			Nothing -> return False
			Just sys ->
				boolSystem "sh" [Param "-c", Param (depsCommand (Robustly Cabal) (Just sys))]
					<&&> cabal ["configure"]
		)
	-- The -j1 is to only run one job at a time -- in some situations,
	-- eg in qemu, ghc does not run reliably in parallel.
	cabal_build = cabal ["build", "-j1", "propellor-config"]

stackBuild :: Maybe System -> IO Bool
stackBuild _msys = do
	createDirectoryIfMissing True builddest
	ifM (stack buildparams)
		( do
			symlinkPropellorBin (builddest </> "propellor-config")
			return True
		, return False
		)
  where
 	builddest = ".built"
	buildparams =
		[ "--local-bin-path", builddest
		, "build"
		, ":propellor-config" -- only build config program
		, "--copy-bins"
		]

-- Atomic symlink creation/update.
symlinkPropellorBin :: FilePath -> IO ()
symlinkPropellorBin bin = do
	createSymbolicLink bin (tmpfor dest)
	rename (tmpfor dest) dest
  where
	dest = "propellor"

tmpfor :: FilePath -> FilePath
tmpfor f = f ++ ".propellortmp"

make :: FilePath -> [FilePath] -> IO Bool -> IO ()
make dest srcs builder = do
	dt <- getmtime dest
	st <- mapM getmtime srcs
	when (dt == Nothing || any (> dt) st) $
		unlessM builder $
			error $ "failed to make " ++ dest
  where
	getmtime = catchMaybeIO . getModificationTime

cabal :: [String] -> IO Bool
cabal = boolSystem "cabal" . map Param

stack :: [String] -> IO Bool
stack = boolSystem "stack" . map Param