From 380c1b0fd6c25dec3c924b82f1d721aa91a001da Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 30 Mar 2014 23:37:54 -0400 Subject: prepare for hackage --- CmdLine.hs | 107 ------------------------------------------------------------- 1 file changed, 107 deletions(-) delete mode 100644 CmdLine.hs (limited to 'CmdLine.hs') 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 -- cgit v1.2.3