propellor spin

Makefile

@@ -1,10 +1,7 @@
-run: pull build
+run: build
 	./propellor
 
-devel: build tags
+dev: build tags
-
-pull:
-	git pull
 
 build: deps dist/setup-config
 	cabal build || (cabal configure; cabal build)

Propellor.hs

@@ -58,3 +58,4 @@ import Data.Either as X
 import Control.Applicative as X
 import Control.Monad as X
 import Data.Monoid as X
+import Control.Monad.IfElse as X

Propellor/CmdLine.hs

@@ -48,9 +48,9 @@ usage = do
 defaultMain :: (HostName -> Maybe [Property]) -> IO ()
 defaultMain getprops = go =<< processCmdLine
   where
-	go (Run host) = withprops host ensureProperties
+	go (Run host) = withprops host $ pullFirst . ensureProperties
-	go (Spin host) = withprops host (const $ spin host)
+	go (Spin host) = withprops host $ const $ spin host
-	go (Boot host) = withprops host boot
+	go (Boot host) = withprops host $ pullFirst . boot
 	go (Set host field) = setPrivData host field
 	go (AddKey keyid) = addKey keyid
 	withprops host a = maybe (unknownhost host) a (getprops host)
@@ -61,6 +61,36 @@ unknownhost h = error $ unwords
 	, "(perhaps you should specify the real hostname on the command line?)"
 	]
 
+pullFirst :: IO () -> IO ()
+pullFirst next = do
+	branchref <- takeWhile (/= '\n') 
+		<$> readProcess "git" ["symbolic-ref", "HEAD"]
+	let originbranch = "origin" </> takeFileName branchref
+	void $ boolSystem "git" [Param "fetch"]
+	
+	whenM (doesFileExist keyring) $ do
+		{- To verify origin/master 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 </> "trustring.gpg"
+		nukeFile $ privDataDir </> "gpg.conf"
+		when (s /= "U\n" && s/= "G\n") $
+			error $ "git branch" ++ originbranch ++ " is not signed with a trusted gpg key; refusing to deploy it!"
+	
+	void $ boolSystem "git" [Param "merge", Param originbranch]
+
+	next
+
 spin :: HostName -> IO ()
 spin host = do
 	url <- getUrl

README

@@ -30,10 +30,7 @@ and so it's easy to factor out things like classes of hosts as desired.
 
 To bootstrap propellor on a new host, use: propellor --spin $host
 
-That clones the local git repository to the remote host (securely over ssh
+That clones the git repository to the remote host. 
-and without needing any central server!), if it doesn't already have
-a clone.
-
 The repository on the remote host will have its origin set to the local git
 repository's remote.origin.url (or remote.deploy.url if available).
 This way, when propellor is run on the remote host, it can contact
@@ -62,4 +59,8 @@ This is only done when privdata/keyring.gpg exists. To set it up:
 gpg --gen-key                 # only if you don't already have a gpg key
 propellor --add-key $MYKEYID
 
+In order to be secure from the beginning propellor --spin is used
+to bootstrap propellor on a new host, it transfers the local git repositry
+to the host over ssh.
+
 [1] http://reclass.pantsfullofunix.net/

Utility/FileMode.hs

@@ -58,6 +58,12 @@ readModes = [ownerReadMode, groupReadMode, otherReadMode]
 executeModes :: [FileMode]
 executeModes = [ownerExecuteMode, groupExecuteMode, otherExecuteMode]
 
+otherGroupModes :: [FileMode]
+otherGroupModes = 
+	[ groupReadMode, otherReadMode
+	, groupWriteMode, otherWriteMode
+	]
+
 {- Removes the write bits from a file. -}
 preventWrite :: FilePath -> IO ()
 preventWrite f = modifyFileMode f $ removeModes writeModes
@@ -147,9 +153,5 @@ setSticky f = modifyFileMode f $ addModes [stickyMode]
 writeFileProtected :: FilePath -> String -> IO ()
 writeFileProtected file content = withUmask 0o0077 $
 	withFile file WriteMode $ \h -> do
-		void $ tryIO $ modifyFileMode file $
+		void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes
-			removeModes
-				[ groupReadMode, otherReadMode
-				, groupWriteMode, otherWriteMode
-				]
 		hPutStr h content