summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.gitignore1
-rw-r--r--Makefile2
-rw-r--r--Propellor/CmdLine.hs97
-rw-r--r--Propellor/PrivData.hs3
-rw-r--r--README19
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