propellor/Propellor/CmdLine.hs

109 lines
2.8 KiB
Haskell
Raw Normal View History

2014-03-31 03:37:54 +00:00
module Propellor.CmdLine where
2014-03-30 23:10:32 +00:00
import System.Environment
import Data.List
import System.Exit
2014-03-31 03:55:59 +00:00
import Propellor
2014-03-30 23:10:32 +00:00
import Utility.FileMode
2014-03-31 03:55:59 +00:00
import Utility.SafeCommand
2014-03-30 23:10:32 +00:00
data CmdLine
= Run HostName
| Spin HostName
| Boot HostName
2014-03-31 01:01:18 +00:00
| Set HostName PrivDataField
2014-03-30 23:10:32 +00:00
processCmdLine :: IO CmdLine
processCmdLine = go =<< getArgs
where
go ("--help":_) = usage
go ("--spin":h:[]) = return $ Spin h
go ("--boot":h:[]) = return $ Boot h
2014-03-31 01:01:18 +00:00
go ("--set":h:f:[]) = case readish f of
Just pf -> return $ Set h pf
2014-03-30 23:10:32 +00:00
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"
2014-03-31 01:01:18 +00:00
, " propellor --set hostname field"
2014-03-30 23:10:32 +00:00
]
exitFailure
2014-03-31 03:02:10 +00:00
defaultMain :: (HostName -> Maybe [Property]) -> IO ()
2014-03-30 23:10:32 +00:00
defaultMain getprops = go =<< processCmdLine
where
2014-03-31 03:02:10 +00:00
go (Run host) = maybe (unknownhost host) ensureProperties (getprops host)
2014-03-30 23:10:32 +00:00
go (Spin host) = spin host
2014-03-31 03:02:10 +00:00
go (Boot host) = maybe (unknownhost host) boot (getprops host)
2014-03-31 01:01:18 +00:00
go (Set host field) = setPrivData host field
2014-03-30 23:10:32 +00:00
2014-03-31 03:02:10 +00:00
unknownhost :: HostName -> IO a
unknownhost h = error $ unwords
[ "Unknown host:", h
, "(perhaps you should specify the real hostname on the command line?)"
]
2014-03-30 23:10:32 +00:00
spin :: HostName -> IO ()
spin host = do
url <- getUrl
void $ boolSystem "git" [Param "commit", Param "-a", Param "-m", Param "propellor spin"]
2014-03-30 23:19:29 +00:00
void $ boolSystem "git" [Param "push"]
privdata <- gpgDecrypt (privDataFile host)
2014-03-30 23:10:32 +00:00
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 ++ " ]"
2014-03-30 23:13:26 +00:00
, "then " ++ intercalate " && "
2014-03-30 23:10:32 +00:00
[ "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
2014-03-30 23:19:29 +00:00
makePrivDataDir
2014-03-30 23:10:32 +00:00
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