summaryrefslogtreecommitdiff
path: root/Propellor/CmdLine.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Propellor/CmdLine.hs')
-rw-r--r--Propellor/CmdLine.hs107
1 files changed, 107 insertions, 0 deletions
diff --git a/Propellor/CmdLine.hs b/Propellor/CmdLine.hs
new file mode 100644
index 00000000..b60b916e
--- /dev/null
+++ b/Propellor/CmdLine.hs
@@ -0,0 +1,107 @@
+module Propellor.CmdLine where
+
+import System.Environment
+import Data.List
+import System.Exit
+
+import Propellor.Common
+import Utility.FileMode
+
+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