propellor spin

This commit is contained in:
Joey Hess 2014-03-31 14:06:20 -04:00
parent 44c76f760e
commit 6269b08863
Failed to extract signature
4 changed files with 37 additions and 37 deletions

View File

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

View File

@ -7,6 +7,7 @@ import System.Exit
import Propellor
import Utility.FileMode
import Utility.SafeCommand
import Utility.Base64
data CmdLine
= Run HostName
@ -67,27 +68,17 @@ spin host = do
void $ boolSystem "git" [Param "push"]
privdata <- gpgDecrypt (privDataFile host)
withBothHandles createProcessSuccess (proc "ssh" [user, bootstrapcmd url]) $ \(toh, fromh) -> do
hPutStrLn stderr "PRE-STATUS"
hFlush stderr
status <- getstatus fromh `catchIO` error "protocol error"
hPutStrLn stderr "POST-STATUS"
hFlush stderr
case status of
NeedKeyRing -> do
hPutStrLn stderr "SEND-KEYRING"
hFlush stderr
s <- readProcess "gpg" $ gpgopts ++ ["--export", "-a"]
s <- toB64 readFile keyring
hPutStrLn toh $ toMarked keyringMarker s
HaveKeyRing -> noop
hPutStrLn stderr "POST-KEYRING"
hFlush stderr
hPutStrLn toh $ toMarked privDataMarker privdata
hPutStrLn stderr "POST-PRIVDATA"
hFlush stderr
hFlush toh
hClose toh
-- Propigate remaining output.
-- Display remaining output.
void $ tryIO $ forever $
putStrLn =<< hGetLine fromh
hClose fromh
@ -140,29 +131,13 @@ boot props = do
havering <- doesFileExist keyring
putStrLn $ toMarked statusMarker $ show $ if havering then HaveKeyRing else NeedKeyRing
hFlush stdout
hPutStrLn stderr "SENT STATUS"
hFlush stderr
reply <- getContents
hPutStrLn stderr $ "GOT >>" ++ reply ++ "<<"
hFlush stderr
makePrivDataDir
hPutStrLn stderr $ "DEBUG 1"
hFlush stderr
writeFileProtected privDataLocal $ fromMarked privDataMarker reply
hPutStrLn stderr $ "DEBUG 2"
hFlush stderr
let keyringarmored = fromMarked keyringMarker reply
hPutStrLn stderr $ "DEBUG 3"
hFlush stderr
unless (null keyringarmored) $ do
hPutStrLn stderr $ "DEBUG 4"
hFlush stderr
withHandle StdinHandle createProcessSuccess
(proc "gpg" $ gpgopts ++ ["--import", "-a"]) $ \h -> do
hPutStr h keyringarmored
hFlush h
hPutStrLn stderr $ "READY"
hFlush stderr
let keyringb64 = fromMarked keyringMarker reply
case fromB64Maybe keyringb64 of
Nothing -> noop
Just s -> writeFileProtected keyring s
ensureProperties props
addKey :: String -> IO ()

24
Utility/Base64.hs Normal file
View File

@ -0,0 +1,24 @@
{- Simple Base64 access
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Utility.Base64 (toB64, fromB64Maybe, fromB64) where
import "dataenc" Codec.Binary.Base64
import Data.Bits.Utils
import Control.Applicative
import Data.Maybe
toB64 :: String -> String
toB64 = encode . s2w8
fromB64Maybe :: String -> Maybe String
fromB64Maybe s = w82s <$> decode s
fromB64 :: String -> String
fromB64 = fromMaybe bad . fromB64Maybe
where
bad = error "bad base64 encoded data"

View File

@ -25,19 +25,19 @@ Description:
Executable propellor
Main-Is: config.hs
GHC-Options: -Wall
GHC-Options: -Wall -XPackageImports
Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,
IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
containers
containers, dataenc
if (! os(windows))
Build-Depends: unix
Library
GHC-Options: -Wall
GHC-Options: -Wall -XPackageImports
Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5,
IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
containers
containers, dataenc
if (! os(windows))
Build-Depends: unix
@ -65,6 +65,7 @@ Library
Propellor.Types
Other-Modules:
Utility.Applicative
Utility.Base64
Utility.Data
Utility.Directory
Utility.Env