Merge branch 'joeyconfig'

1 files changed, 20 insertions, 147 deletions

diff --git a/src/wrapper.hs b/src/wrapper.hs
index 289b12b5..90f14379 100644
--- a/src/wrapper.hs
+++ b/src/wrapper.hs
@@ -3,169 +3,42 @@
 -- 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.
+-- This is not the propellor main program (that's config.hs).
+-- This bootstraps ~/.propellor/config.hs, builds it if
+-- it's not already built, and runs it.
 
 module Main where
 
+import Propellor.DotDir
 import Propellor.Message
 import Propellor.Bootstrap
-import Utility.UserInfo
 import Utility.Monad
 import Utility.Process
-import Utility.SafeCommand
-import Utility.Exception
+import Utility.Process.NonConcurrent
 
-import Control.Monad
-import Control.Monad.IfElse
 import System.Directory
-import System.FilePath
 import System.Environment (getArgs)
 import System.Exit
 import System.Posix.Directory
-import System.IO
-import Control.Applicative
-import Prelude
-
-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"
+import Control.Monad.IfElse
 
 main :: IO ()
-main = withConcurrentOutput $ 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
+main = withConcurrentOutput $ go =<< getArgs
   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
-				changeWorkingDirectory propellordir
-				void $ boolSystem "git" [Param "remote", Param "rm", Param "origin"]
-			, do
-				void $ boolSystem "git" [Param "clone", Param netrepo, File propellordir]
-				changeWorkingDirectory propellordir
-				-- Rename origin to upstream and avoid
-				-- git push to that read-only repo.
-				void $ boolSystem "git" [Param "remote", Param "rename", Param "origin", Param "upstream"]
-				void $ boolSystem "git" [Param "config", Param "--unset", Param "branch.master.remote", Param "upstream"]
-			)
+	go ["--init"] = interactiveInit
+	go args = ifM (doesDirectoryExist =<< dotPropellor)
+		( do
+			checkRepoUpToDate
+			buildRunConfig args
+		, error "Seems that ~/.propellor/ does not exist. To set it up, run: propellor --init"
+		)
 
-	checkRepo = whenM (doesFileExist disthead <&&> doesFileExist (propellordir </> "propellor.cabal")) $ do
-		headrev <- takeWhile (/= '\n') <$> readFile disthead
-		changeWorkingDirectory propellordir
-		headknown <- catchMaybeIO $ 
-			withQuietOutput createProcessSuccess $
-				proc "git" ["log", headrev]
-		if (headknown == Nothing)
-			then setupupstreammaster headrev propellordir
-			else do
-				merged <- not . null <$>
-					readProcess "git" ["log", headrev ++ "..HEAD", "--ancestry-path"]
-				unless merged $
-					warnoutofdate propellordir True
-	buildruncfg = do
-		changeWorkingDirectory propellordir
+buildRunConfig :: [String] -> IO ()
+buildRunConfig args = do
+	changeWorkingDirectory =<< dotPropellor
+	unlessM (doesFileExist "propellor") $ do
 		buildPropellor Nothing
 		putStrLn ""
 		putStrLn ""
-		chain
-	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
--- 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 propellordir 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"]
-		git ["merge", newref, "-s", "recursive", "-Xtheirs", "--quiet", "-m", "merging upstream version"]
-	
-		fetchUpstreamBranch propellordir tmprepo
-		cleantmprepo
-		warnoutofdate propellordir 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 :: FilePath -> Bool -> IO ()
-warnoutofdate propellordir 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"
-		]
+	(_, _, _, pid) <- createProcessNonConcurrent (proc "./propellor" args) 
+	exitWith =<< waitForProcessNonConcurrent pid