propellor/Propellor/CmdLine.hs

module Propellor.CmdLine where

import System.Environment
import Data.List
import System.Exit

import Propellor
import Utility.FileMode
import Utility.SafeCommand

data CmdLine
	= Run HostName
	| Spin HostName
	| Boot HostName
	| Set HostName PrivDataField

processCmdLine :: IO CmdLine
processCmdLine = go =<< getArgs
  where
  	go ("--help":_) = usage
  	go ("--spin":h:[]) = return $ Spin h
  	go ("--boot":h:[]) = return $ Boot h
	go ("--set":h:f:[]) = case readish f of
		Just pf -> return $ Set h pf
		Nothing -> error $ "Unknown privdata field " ++ f
	go (h:[]) = return $ Run h
	go [] = do
		s <- takeWhile (/= '\n') <$> readProcess "hostname" ["-f"]
		if null s
			then error "Cannot determine hostname! Pass it on the command line."
			else return $ Run s
	go _ = usage
	
usage :: IO a
usage = do
	putStrLn $ unlines 
		[ "Usage:"
		, "  propellor"
		, "  propellor hostname"
		, "  propellor --spin hostname"
		, "  propellor --set hostname field"
		]
	exitFailure

defaultMain :: (HostName -> Maybe [Property]) -> IO ()
defaultMain getprops = go =<< processCmdLine
  where
	go (Run host) = maybe (unknownhost host) ensureProperties (getprops host)
	go (Spin host) = spin host
	go (Boot host) = maybe (unknownhost host) boot (getprops host)
	go (Set host field) = setPrivData host field

unknownhost :: HostName -> IO a
unknownhost h = error $ unwords
	[ "Unknown host:", h
	, "(perhaps you should specify the real hostname on the command line?)"
	]

spin :: HostName -> IO ()
spin host = do
	url <- getUrl
	void $ boolSystem "git" [Param "commit", 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
  where
	bootstrap url = shellWrap $ intercalate " && "
		[ intercalate " ; "
			[ "if [ ! -d " ++ localdir ++ " ]"
			, "then " ++ intercalate " && "
				[ "apt-get -y install git"
				, "git clone " ++ url ++ " " ++ localdir
				]
			, "fi"
			]
		, "cd " ++ localdir
		, "make pull build"
		, "./propellor --boot " ++ host
		]

boot :: [Property] -> IO ()
boot props = do
	privdata <- map (drop $ length privDataMarker ) 
		. filter (privDataMarker `isPrefixOf`) 
		. lines 
		<$> getContents
	makePrivDataDir
	writeFileProtected privDataLocal (unlines privdata)
	ensureProperties props

localdir :: FilePath
localdir = "/usr/local/propellor"

getUrl :: IO String
getUrl = fromMaybe nourl <$> getM get urls
  where
	urls = ["remote.deploy.url", "remote.origin.url"]
	nourl = error $ "Cannot find deploy url in " ++ show urls
	get u = do
		v <- catchMaybeIO $ 
			takeWhile (/= '\n') 
				<$> readProcess "git" ["config", u]
		return $ case v of
			Just url | not (null url) -> Just url
			_ -> Nothing