summaryrefslogtreecommitdiff
path: root/CmdLine.hs
diff options
context:
space:
mode:
authorJoey Hess2014-03-30 23:37:54 -0400
committerJoey Hess2014-03-30 23:37:54 -0400
commit380c1b0fd6c25dec3c924b82f1d721aa91a001da (patch)
tree7d5b73309b73f13ac2be3f911318fe6a126264ff /CmdLine.hs
parent02a7bf5f0e2de1d0dea71781ed0c1ae3a50e6425 (diff)
prepare for hackage
Diffstat (limited to 'CmdLine.hs')
-rw-r--r--CmdLine.hs107
1 files changed, 0 insertions, 107 deletions
diff --git a/CmdLine.hs b/CmdLine.hs
deleted file mode 100644
index c93d69ad..00000000
--- a/CmdLine.hs
+++ /dev/null
@@ -1,107 +0,0 @@
-module CmdLine where
-
-import System.Environment
-import Data.List
-import System.Exit
-
-import 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