From 7acbfea4b9471c3aae6add1b86d18bb765c678ec Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 31 Mar 2014 12:06:04 -0400 Subject: propellor spin --- .gitignore | 1 + Makefile | 2 +- Propellor/CmdLine.hs | 97 +++++++++++++++++++++++++++++++++++++++++++++------ Propellor/PrivData.hs | 3 -- README | 19 ++++++---- 5 files changed, 101 insertions(+), 21 deletions(-) diff --git a/.gitignore b/.gitignore index e6010e6f..1c4fed6f 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,4 @@ dist/* propellor tags privdata/local +privdata/keyring.gpg~ diff --git a/Makefile b/Makefile index 26f776aa..f363176a 100644 --- a/Makefile +++ b/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 diff --git a/Propellor/CmdLine.hs b/Propellor/CmdLine.hs index 6afa739c..02616954 100644 --- a/Propellor/CmdLine.hs +++ b/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 - (proc "ssh" ["root@"++host, bootstrap url]) $ \h -> do - hPutStr h $ unlines $ map (privDataMarker ++) $ lines privdata - hClose h + withBothHandles createProcessSuccess (proc "ssh" [user, bootstrapcmd url]) $ \(toh, fromh) -> do + status <- readish . fromMarked statusMarker <$> hGetContents fromh + case status of + 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 ) - . filter (privDataMarker `isPrefixOf`) - . lines - <$> getContents + havering <- doesFileExist keyring + putStrLn $ toMarked statusMarker $ show $ if havering then HaveKeyRing else NeedKeyRing + hFlush stdout + 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" diff --git a/Propellor/PrivData.hs b/Propellor/PrivData.hs index 5f0de3b0..ce52d576 100644 --- a/Propellor/PrivData.hs +++ b/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] diff --git a/README b/README index 554f153b..cc027894 100644 --- a/README +++ b/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:// -or http:// repository. To avoid a MITM attack, propellor checks -that the top commit in the git repository is gpg signed by a -trusted key, and refuses to deploy it otherwise. This is only done if -privdata/keyring.gpg exists. To generate it, make a gpg key and -run something like: +## using git://... securely + +It's often easiest to deploy propellor to a host by cloning a git:// or +http:// repository rather than by cloning over ssh://. To avoid a MITM +attack, propellor checks that the top commit in the git repository is gpg +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 -- cgit v1.2.3