Record propellor (3.0.5-1) in archive suite sid

1 files changed, 229 insertions, 0 deletions

diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
new file mode 100644
index 00000000..29175a67
--- /dev/null
+++ b/src/Propellor/Bootstrap.hs
@@ -0,0 +1,229 @@
+module Propellor.Bootstrap (
+	bootstrapPropellorCommand,
+	checkBinaryCommand,
+	installGitCommand,
+	buildPropellor,
+) where
+
+import Propellor.Base
+import Propellor.Types.Info
+import Propellor.Git.Config
+
+import System.Posix.Files
+import Data.List
+
+type ShellCommand = String
+
+-- 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 :: Maybe System -> ShellCommand
+bootstrapPropellorCommand msys = checkDepsCommand msys ++
+	"&& if ! test -x ./propellor; then "
+		++ buildCommand ++
+	"; fi;" ++ checkBinaryCommand
+
+-- Use propellor --check to detect if the local propellor binary has
+-- stopped working (eg due to library changes), and must be rebuilt.
+checkBinaryCommand :: ShellCommand
+checkBinaryCommand = "if test -x ./propellor && ! ./propellor --check; then " ++ go ++ "; fi"
+  where
+	go = intercalate " && "
+		[ "cabal clean"
+		, buildCommand
+		]
+
+buildCommand :: ShellCommand
+buildCommand = intercalate " && "
+	[ "cabal configure"
+	, "cabal build propellor-config"
+	, "ln -sf dist/build/propellor-config/propellor-config propellor"
+	]
+
+-- Run cabal configure to check if all dependencies are installed;
+-- if not, run the depsCommand.
+checkDepsCommand :: Maybe System -> ShellCommand
+checkDepsCommand sys = "if ! cabal configure >/dev/null 2>&1; then " ++ depsCommand sys ++ "; fi"
+
+-- Install build dependencies of propellor.
+--
+-- First, try to install ghc, cabal, gnupg, and all haskell libraries that
+-- propellor uses from OS packages.
+--
+-- Some packages may not be available in some versions of Debian
+-- (eg, Debian wheezy lacks async), or propellor may need a newer version.
+-- So, as a second step, cabal is used to install all dependencies.
+--
+-- Note: May succeed and leave some deps not installed.
+depsCommand :: Maybe System -> ShellCommand
+depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall]) ++ " ) || true"
+  where
+	osinstall = case msys of
+		Just (System (FreeBSD _) _) -> map pkginstall fbsddeps
+		Just (System (Debian _) _) -> useapt
+		Just (System (Buntish _) _) -> useapt
+		-- assume a debian derived system when not specified
+		Nothing -> useapt
+
+	useapt = "apt-get update" : map aptinstall debdeps
+
+	cabalinstall =
+		[ "cabal update"
+		, "cabal install --only-dependencies"
+		]
+
+	aptinstall p = "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-recommends -y install " ++ p
+	pkginstall p = "ASSUME_ALWAYS_YES=yes pkg install " ++ p
+
+	-- This is the same deps listed in debian/control.
+	debdeps =
+		[ "gnupg"
+		, "ghc"
+		, "cabal-install"
+		, "libghc-async-dev"
+		, "libghc-missingh-dev"
+		, "libghc-hslogger-dev"
+		, "libghc-unix-compat-dev"
+		, "libghc-ansi-terminal-dev"
+		, "libghc-ifelse-dev"
+		, "libghc-network-dev"
+		, "libghc-mtl-dev"
+		, "libghc-transformers-dev"
+		, "libghc-exceptions-dev"
+		, "libghc-stm-dev"
+		, "libghc-text-dev"
+		, "make"
+		]
+	fbsddeps =
+		[ "gnupg"
+		, "ghc"
+		, "hs-cabal-install"
+		, "hs-async"
+		, "hs-MissingH"
+		, "hs-hslogger"
+		, "hs-unix-compat"
+		, "hs-ansi-terminal"
+		, "hs-IfElse"
+		, "hs-network"
+		, "hs-mtl"
+		, "hs-transformers-base"
+		, "hs-exceptions"
+		, "hs-stm"
+		, "hs-text"
+		, "gmake"
+		]
+
+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"
+		]
+	-- assume a debian derived system when not specified
+	Nothing -> use apt
+  where
+	use cmds = "if ! git --version >/dev/null; then " ++ intercalate " && " cmds ++ "; fi"
+	apt = 
+		[ "apt-get update"
+		, "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-install-recommends --no-upgrade -y install git"
+		]
+
+buildPropellor :: Maybe Host -> IO ()
+buildPropellor mh = unlessM (actionMessage "Propellor build" (build msys)) $
+	errorMessage "Propellor build failed!"
+  where
+	msys = case fmap (fromInfo . hostInfo) mh of
+		Just (InfoVal sys) -> Just sys
+		_ -> Nothing
+
+-- Build propellor using cabal or stack, and symlink propellor to the
+-- built binary.
+build :: Maybe System -> IO Bool
+build msys = catchBoolIO $ do
+	bs <- getGitConfigValue "propellor.buildsystem"
+	case bs of
+		Just "stack" -> stackBuild msys
+		_ -> cabalBuild 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 -a to make build timestamp checking work.
+	unlessM (boolSystem "cp" [Param "-af", 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 (Just sys))]
+					<&&> cabal ["configure"]
+		)
+	cabal_build = cabal ["build", "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