From 45592b442b02c41993c9c62eb7f06bcb1267c117 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 18:39:10 -0400
Subject: factor out git repo module

---
 src/Propellor/Git.hs | 41 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 41 insertions(+)
 create mode 100644 src/Propellor/Git.hs

(limited to 'src/Propellor/Git.hs')

diff --git a/src/Propellor/Git.hs b/src/Propellor/Git.hs
new file mode 100644
index 00000000..0de82f8a
--- /dev/null
+++ b/src/Propellor/Git.hs
@@ -0,0 +1,41 @@
+module Propellor.Git where
+
+import Propellor
+import Utility.SafeCommand
+
+getCurrentBranch :: IO String
+getCurrentBranch = takeWhile (/= '\n') 
+	<$> readProcess "git" ["symbolic-ref", "--short", "HEAD"]
+
+getCurrentGitSha1 :: String -> IO String
+getCurrentGitSha1 branchref = readProcess "git" ["show-ref", "--hash", branchref]
+
+setRepoUrl :: String -> IO ()
+setRepoUrl "" = return ()
+setRepoUrl url = do
+	subcmd <- ifM hasOrigin (pure "set-url", pure "add")
+	void $ boolSystem "git" [Param "remote", Param subcmd, Param "origin", Param url]
+	-- same as --set-upstream-to, except origin branch
+	-- may not have been pulled yet
+	branch <- getCurrentBranch
+	let branchval s = "branch." ++ branch ++ "." ++ s
+	void $ boolSystem "git" [Param "config", Param (branchval "remote"), Param "origin"]
+	void $ boolSystem "git" [Param "config", Param (branchval "merge"), Param $ "refs/heads/"++branch]
+
+getRepoUrl :: IO (Maybe String)
+getRepoUrl = getM get urls
+  where
+	urls = ["remote.deploy.url", "remote.origin.url"]
+	get u = do
+		v <- catchMaybeIO $ 
+			takeWhile (/= '\n') 
+				<$> readProcess "git" ["config", u]
+		return $ case v of
+			Just url | not (null url) -> Just url
+			_ -> Nothing
+
+hasOrigin :: IO Bool
+hasOrigin = do
+	rs <- lines <$> readProcess "git" ["remote"]
+	return $ "origin" `elem` rs
+
-- 
cgit v1.3-2-g0d8e


From 8b6531ea43e43bd979ad9b8125fc21c6602dea38 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 18 Nov 2014 19:43:53 -0400
Subject: reorg

---
 src/Propellor/CmdLine.hs | 25 +++++--------------------
 src/Propellor/Git.hs     | 23 +++++++++++++++++++++++
 2 files changed, 28 insertions(+), 20 deletions(-)

(limited to 'src/Propellor/Git.hs')

diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 6c3920ce..c85906d9 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -148,29 +148,14 @@ updateFirst' cmdline next = do
 	
 	oldsha <- getCurrentGitSha1 branchref
 	
-	whenM (doesFileExist keyring) $ do
-		{- To verify origin branch commit's signature, have to
-		 - convince gpg to use our keyring. While running git log.
-		 - Which has no way to pass options to gpg.
-		 - Argh! -}
-		let gpgconf = privDataDir </> "gpg.conf"
-		writeFile gpgconf $ unlines
-			[ " keyring " ++ keyring
-			, "no-auto-check-trustdb"
-			]
-		-- gpg is picky about perms
-		modifyFileMode privDataDir (removeModes otherGroupModes)
-		s <- readProcessEnv "git" ["log", "-n", "1", "--format=%G?", originbranch]
-			(Just [("GNUPGHOME", privDataDir)])
-		nukeFile $ privDataDir </> "trustdb.gpg"
-		nukeFile $ privDataDir </> "pubring.gpg"
-		nukeFile $ privDataDir </> "gpg.conf"
-		if s == "U\n" || s == "G\n"
-			then do
+	whenM (doesFileExist keyring) $
+		ifM (verifyOriginBranch originbranch)
+			( do
 				putStrLn $ "git branch " ++ originbranch ++ " gpg signature verified; merging"
 				hFlush stdout
 				void $ boolSystem "git" [Param "merge", Param originbranch]
-			else warningMessage $ "git branch " ++ originbranch ++ " is not signed with a trusted gpg key; refusing to deploy it! (Running with previous configuration instead.)"
+			, warningMessage $ "git branch " ++ originbranch ++ " is not signed with a trusted gpg key; refusing to deploy it! (Running with previous configuration instead.)"
+			)
 	
 	newsha <- getCurrentGitSha1 branchref
 
diff --git a/src/Propellor/Git.hs b/src/Propellor/Git.hs
index 0de82f8a..51ed3df2 100644
--- a/src/Propellor/Git.hs
+++ b/src/Propellor/Git.hs
@@ -1,7 +1,10 @@
 module Propellor.Git where
 
 import Propellor
+import Propellor.PrivData.Paths
+import Propellor.Gpg
 import Utility.SafeCommand
+import Utility.FileMode
 
 getCurrentBranch :: IO String
 getCurrentBranch = takeWhile (/= '\n') 
@@ -39,3 +42,23 @@ hasOrigin = do
 	rs <- lines <$> readProcess "git" ["remote"]
 	return $ "origin" `elem` rs
 
+{- To verify origin branch commit's signature, have to convince gpg
+ - to use our keyring.
+ - While running git log. Which has no way to pass options to gpg.
+ - Argh!
+ -}
+verifyOriginBranch :: String -> IO Bool
+verifyOriginBranch originbranch = do
+	let gpgconf = privDataDir </> "gpg.conf"
+	writeFile gpgconf $ unlines
+		[ " keyring " ++ keyring
+		, "no-auto-check-trustdb"
+		]
+	-- gpg is picky about perms
+	modifyFileMode privDataDir (removeModes otherGroupModes)
+	s <- readProcessEnv "git" ["log", "-n", "1", "--format=%G?", originbranch]
+		(Just [("GNUPGHOME", privDataDir)])
+	nukeFile $ privDataDir </> "trustdb.gpg"
+	nukeFile $ privDataDir </> "pubring.gpg"
+	nukeFile $ privDataDir </> "gpg.conf"
+	return (s == "U\n" || s == "G\n")
-- 
cgit v1.3-2-g0d8e