propellor spin

.gitignore

@@ -2,3 +2,4 @@ dist/*
 propellor
 tags
 privdata/local
+privdata/keyring.gpg~

Makefile

@@ -11,7 +11,7 @@ build: deps dist/setup-config
 	ln -sf dist/build/propellor/propellor
 
 deps:
-	@if [ $$(whoami) = root ]; then apt-get -y install ghc cabal-install libghc-missingh-dev libghc-ansi-terminal-dev libghc-ifelse-dev libghc-unix-compat-dev libghc-hslogger-dev; fi || true
+	@if [ $$(whoami) = root ]; then apt-get -y install gpg ghc cabal-install libghc-missingh-dev libghc-ansi-terminal-dev libghc-ifelse-dev libghc-unix-compat-dev libghc-hslogger-dev; fi || true
 
 dist/setup-config: propellor.cabal
 	cabal configure

Propellor/CmdLine.hs

@@ -13,6 +13,7 @@ data CmdLine
 	| Spin HostName
 	| Boot HostName
 	| Set HostName PrivDataField
+	| AddKey String
 
 processCmdLine :: IO CmdLine
 processCmdLine = go =<< getArgs
@@ -20,6 +21,7 @@ processCmdLine = go =<< getArgs
   	go ("--help":_) = usage
   	go ("--spin":h:[]) = return $ Spin h
   	go ("--boot":h:[]) = return $ Boot h
+	go ("--add-key":k:[]) = return $ AddKey k
 	go ("--set":h:f:[]) = case readish f of
 		Just pf -> return $ Set h pf
 		Nothing -> error $ "Unknown privdata field " ++ f
@@ -39,6 +41,7 @@ usage = do
 		, "  propellor hostname"
 		, "  propellor --spin hostname"
 		, "  propellor --set hostname field"
+		, "  propellor --add-key keyid"
 		]
 	exitFailure
 
@@ -49,6 +52,7 @@ defaultMain getprops = go =<< processCmdLine
 	go (Spin host) = spin host
 	go (Boot host) = maybe (unknownhost host) boot (getprops host)
 	go (Set host field) = setPrivData host field
+	go (AddKey keyid) = addKey keyid
 
 unknownhost :: HostName -> IO a
 unknownhost h = error $ unwords
@@ -59,15 +63,24 @@ unknownhost h = error $ unwords
 spin :: HostName -> IO ()
 spin host = do
 	url <- getUrl
-	void $ boolSystem "git" [Param "commit", Param "-a", Param "-m", Param "propellor spin"]
+	void $ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
 	void $ boolSystem "git" [Param "push"]
 	privdata <- gpgDecrypt (privDataFile host)
-	withHandle StdinHandle createProcessSuccess
+	withBothHandles createProcessSuccess (proc "ssh" [user, bootstrapcmd url]) $ \(toh, fromh) -> do
-		(proc "ssh" ["root@"++host, bootstrap url]) $ \h -> do
+		status <- readish . fromMarked statusMarker <$> hGetContents fromh
-			hPutStr h $ unlines $ map (privDataMarker ++) $ lines privdata
+		case status of
-			hClose h
+			Nothing -> error "protocol error"
+			Just NeedKeyRing -> do
+				s <- readProcess "gpg" $ gpgopts ++ ["--export", "-a"]
+				hPutStr toh $ toMarked keyringMarker s
+			Just HaveKeyRing -> noop
+		hPutStr toh $ toMarked privDataMarker privdata
+		hFlush toh
+		hClose fromh
+
   where
-	bootstrap url = shellWrap $ intercalate " && "
+	user = "root@"++host
+	bootstrapcmd url = shellWrap $ intercalate " && "
 		[ intercalate " ; "
 			[ "if [ ! -d " ++ localdir ++ " ]"
 			, "then " ++ intercalate " && "
@@ -81,16 +94,78 @@ spin host = do
 		, "./propellor --boot " ++ host
 		]
 
+data BootStrapStatus = HaveKeyRing | NeedKeyRing
+	deriving (Read, Show, Eq)
+
+type Marker = String
+type Marked = String
+
+statusMarker :: Marker
+statusMarker = "STATUS"
+
+keyringMarker :: Marker
+keyringMarker = "KEYRING"
+
+privDataMarker :: String
+privDataMarker = "PRIVDATA "
+
+toMarked :: Marker -> String -> String
+toMarked marker = unlines . map (marker ++) . lines
+
+fromMarked :: Marker -> Marked -> String
+fromMarked marker = unlines . map (drop len) . filter (marker `isPrefixOf`) . lines
+  where
+	len = length marker
+
 boot :: [Property] -> IO ()
 boot props = do
-	privdata <- map (drop $ length privDataMarker ) 
+	havering <- doesFileExist keyring
-		. filter (privDataMarker `isPrefixOf`) 
+	putStrLn $ toMarked statusMarker $ show $ if havering then HaveKeyRing else NeedKeyRing
-		. lines 
+	hFlush stdout
-		<$> getContents
+	reply <- getContents
 	makePrivDataDir
-	writeFileProtected privDataLocal (unlines privdata)
+	writeFileProtected privDataLocal $ fromMarked privDataMarker reply
+	let keyringarmored = fromMarked keyringMarker reply
+	unless (null keyringarmored) $
+		withHandle StdinHandle createProcessSuccess
+			(proc "gpg" $ gpgopts ++ ["--import", "-a"]) $ \h -> do
+				hPutStr h keyringarmored
+				hFlush h
 	ensureProperties props
 
+addKey :: String -> IO ()
+addKey keyid = exitBool =<< allM id [ gpg, gitadd, gitcommit ]
+  where
+	gpg = boolSystem "sh"
+		[ Param "-c"
+		, Param $ "gpg --export " ++ keyid ++ " | gpg " ++
+			unwords (gpgopts ++ ["--import"])
+		]
+	gitadd = boolSystem "git"
+		[ Param "add"
+		, File keyring
+		]
+	gitcommit = gitCommit
+		[ File keyring
+		, Param "-m"
+		, Param "propellor addkey"
+		]
+
+{- Automatically sign the commit if there'a a keyring. -}
+gitCommit :: [CommandParam] -> IO Bool
+gitCommit ps = do
+	k <- doesFileExist keyring
+	boolSystem "git" $ catMaybes $
+		[ Just (Param "commit")
+		, if k then Just (Param "--gpg-sign") else Nothing
+		] ++ map Just ps
+
+keyring :: FilePath
+keyring = privDataDir </> "keyring.gpg"
+
+gpgopts :: [String]
+gpgopts = ["--options", "/dev/null", "--no-default-keyring", "--keyring", keyring]
+
 localdir :: FilePath
 localdir = "/usr/local/propellor"
 

Propellor/PrivData.hs

@@ -63,9 +63,6 @@ privDataFile host = privDataDir </> host ++ ".gpg"
 privDataLocal :: FilePath
 privDataLocal = privDataDir </> "local"
 
-privDataMarker :: String
-privDataMarker = "PRIVDATA "
-
 gpgDecrypt :: FilePath -> IO String
 gpgDecrypt f = ifM (doesFileExist f)
 	( readProcess "gpg" ["--decrypt", f]

README

@@ -23,6 +23,8 @@ of which classes and share which configuration. It might be nice to use
 reclass[1], but then again a host is configured using simply haskell code,
 and so it's easy to factor out things like classes of hosts as desired.
 
+## bootstrapping and private data
+
 To bootstrap propellor on a new host, use: propellor --spin $host
 This looks up the git repository's remote.origin.url (or remote.deploy.url
 if available) and logs into the host, clones the url (if not already
@@ -39,12 +41,17 @@ in such a file, use: propellor --set $host $field
 The field name will be something like 'Password "root"'; see PrivData.hs
 for available fields.
 
-It's often easiest to deploy propellor to a host by cloning a git://
+## using git://... securely
-or http:// repository. To avoid a MITM attack, propellor checks
+
-that the top commit in the git repository is gpg signed by a
+It's often easiest to deploy propellor to a host by cloning a git:// or
-trusted key, and refuses to deploy it otherwise. This is only done if
+http:// repository rather than by cloning over ssh://. To avoid a MITM
-privdata/keyring.gpg exists. To generate it, make a gpg key and
+attack, propellor checks that the top commit in the git repository is gpg
-run something like:
+signed by a trusted gpg key, and refuses to deploy it otherwise. 
+
+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
 
 The keyring.gpg can be checked into git, but to ensure that it's
 used from the beginning when bootstrapping, propellor --spin