summaryrefslogtreecommitdiff
path: root/src/wrapper.hs
blob: 7b7486597a65c20d5628e88b3a4e4dc8c77805d7 (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
-- | Wrapper program for propellor distribution.
--
-- Distributions should install this program into PATH.
-- (Cabal builds it as dist/build/propellor/propellor).
--
-- This is not the propellor main program (that's config.hs)
--
-- This installs propellor's source into ~/.propellor,
-- uses it to build the real propellor program (if not already built),
-- and runs it.
-- 
-- The source is cloned from /usr/src/propellor when available,
-- or is cloned from git over the network.

module Main where

import Propellor.Message
import Utility.UserInfo
import Utility.Monad
import Utility.Process
import Utility.SafeCommand
import Utility.Exception

import Control.Monad
import Control.Monad.IfElse
import Control.Applicative
import System.Directory
import System.FilePath
import System.Environment (getArgs)
import System.Exit
import System.Posix.Directory
import System.IO

distdir :: FilePath
distdir = "/usr/src/propellor"

distrepo :: FilePath
distrepo = distdir </> "propellor.git"

disthead :: FilePath
disthead = distdir </> "head"

upstreambranch :: String
upstreambranch = "upstream/master"

-- Using the github mirror of the main propellor repo because
-- it is accessible over https for better security.
netrepo :: String
netrepo = "https://github.com/joeyh/propellor.git"

main :: IO ()
main = do
	args <- getArgs
	home <- myHomeDir
	let propellordir = home </> ".propellor"
	let propellorbin = propellordir </> "propellor"
	wrapper args propellordir propellorbin

wrapper :: [String] -> FilePath -> FilePath -> IO ()
wrapper args propellordir propellorbin = do
	ifM (doesDirectoryExist propellordir)
		( checkRepo 
		, makeRepo
		)
	buildruncfg
  where
	makeRepo = do
		putStrLn $ "Setting up your propellor repo in " ++ propellordir
		putStrLn ""
		ifM (doesFileExist distrepo <||> doesDirectoryExist distrepo)
			( do			
				void $ boolSystem "git" [Param "clone", File distrepo, File propellordir]
				fetchUpstreamBranch propellordir distrepo
			, void $ boolSystem "git" [Param "clone", Param netrepo, File propellordir]
			)

	checkRepo = whenM (doesFileExist disthead) $ do
		headrev <- takeWhile (/= '\n') <$> readFile disthead
		changeWorkingDirectory propellordir
		headknown <- catchMaybeIO $ 
			withQuietOutput createProcessSuccess $
				proc "git" ["log", headrev]
		when (headknown == Nothing) $
			setupupstreammaster headrev propellordir
	buildruncfg = do
		changeWorkingDirectory propellordir
		ifM (boolSystem "make" [Param "build"])
			( do
				putStrLn ""
				putStrLn ""
				chain
			, error "Propellor build failed."
			)
	chain = do
		(_, _, _, pid) <- createProcess (proc propellorbin args) 
		exitWith =<< waitForProcess pid

-- Passed the user's propellordir repository, makes upstream/master
-- be a usefully mergeable branch.
--
-- We cannot just use origin/master, because in the case of a distrepo,
-- it only contains 1 commit. So, trying to merge with it will result
-- in lots of merge conflicts, since git cannot find a common parent
-- commit.
--
-- Instead, the upstream/master branch is created by taking the previous
-- upstream/master branch (which must be an old version of propellor,
-- as distributed), and diffing from it to the current origin/master,
-- and committing the result. This is done in a temporary clone of the
-- repository, giving it a new master branch. That new branch is fetched
-- into the user's repository, as if fetching from a upstream remote,
-- yielding a new upstream/master branch.
setupupstreammaster :: String -> FilePath -> IO ()
setupupstreammaster newref propellordir = do
	changeWorkingDirectory propellordir
	go =<< catchMaybeIO getoldrev
  where
	go Nothing = warnoutofdate False
	go (Just oldref) = do
		let tmprepo = ".git/propellordisttmp"
		let cleantmprepo = void $ catchMaybeIO $ removeDirectoryRecursive tmprepo
		cleantmprepo
		git ["clone", "--quiet", ".", tmprepo]
	
		changeWorkingDirectory tmprepo
		git ["fetch", distrepo, "--quiet"]
		git ["reset", "--hard", oldref, "--quiet"]
		run "sh" ["-c", "git diff .." ++ newref ++ " | git apply --whitespace=nowarn"]
		git ["commit", "-a", "-m", "merging upstream changes", "--quiet"]
	
		fetchUpstreamBranch propellordir tmprepo
		cleantmprepo
		warnoutofdate True

	getoldrev = takeWhile (/= '\n')
		<$> readProcess "git" ["show-ref", upstreambranch, "--hash"]
	
	git = run "git"
	run cmd ps = unlessM (boolSystem cmd (map Param ps)) $
		error $ "Failed to run " ++ cmd ++ " " ++ show ps
	
	warnoutofdate havebranch = do
		warningMessage ("** Your " ++ propellordir ++ " is out of date..")
		let also s = hPutStrLn stderr ("   " ++ s)
		also ("A newer upstream version is available in " ++ distrepo)
		if havebranch
			then also ("To merge it, run: git merge " ++ upstreambranch)
			else also ("To merge it, find the most recent commit in your repository's history that corresponds to an upstream release of propellor, and set refs/remotes/" ++ upstreambranch ++ " to it. Then run propellor again.")
		also ""

fetchUpstreamBranch :: FilePath -> FilePath -> IO ()
fetchUpstreamBranch propellordir repo = do
	changeWorkingDirectory propellordir
	void $ boolSystem "git"
		[ Param "fetch"
		, File repo
		, Param ("+refs/heads/master:refs/remotes/" ++ upstreambranch)
		, Param "--quiet"
		]