From 503437b676f5c4d41ef41c6de3e3b25045bcc5d7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 1 Apr 2016 18:33:17 -0400 Subject: Improved propellor's first run experience; the wrapper program will now walk the user through setting up ~/.propellor with a choice between a clone of propellor's git repository, or a minimal config. --- src/wrapper.hs | 254 ++++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 190 insertions(+), 64 deletions(-) (limited to 'src/wrapper.hs') diff --git a/src/wrapper.hs b/src/wrapper.hs index 289b12b5..f079eb32 100644 --- a/src/wrapper.hs +++ b/src/wrapper.hs @@ -5,12 +5,8 @@ -- -- This is not the propellor main program (that's config.hs) -- --- This installs propellor's source into ~/.propellor, --- uses it to build the real propellor program (if not already built), --- and runs it. --- --- The source is cloned from /usr/src/propellor when available, --- or is cloned from git over the network. +-- This bootstraps ~/.propellor/config.hs, builds it if +-- it's not already built, and runs it. module Main where @@ -22,6 +18,7 @@ import Utility.Process import Utility.SafeCommand import Utility.Exception +import Data.Char import Control.Monad import Control.Monad.IfElse import System.Directory @@ -36,9 +33,12 @@ import Prelude distdir :: FilePath distdir = "/usr/src/propellor" +-- A distribution may include a bundle of propellor's git repository here. +-- If not, it will be pulled from the network when needed. distrepo :: FilePath distrepo = distdir "propellor.git" +-- File containing the head rev of the distrepo. disthead :: FilePath disthead = distdir "head" @@ -54,60 +54,186 @@ main :: IO () main = withConcurrentOutput $ do args <- getArgs home <- myHomeDir - let propellordir = home ".propellor" - let propellorbin = propellordir "propellor" - wrapper args propellordir propellorbin - -wrapper :: [String] -> FilePath -> FilePath -> IO () -wrapper args propellordir propellorbin = do - ifM (doesDirectoryExist propellordir) - ( checkRepo - , makeRepo + let dotpropellor = home ".propellor" + ifM (doesDirectoryExist dotpropellor) + ( do + checkRepoUpToDate dotpropellor + buildRunConfig dotpropellor args + , do + welcomeBanner + setup dotpropellor ) - buildruncfg + +buildRunConfig :: FilePath -> [String] -> IO () +buildRunConfig dotpropellor args = do + changeWorkingDirectory dotpropellor + buildPropellor Nothing + putStrLn "" + putStrLn "" + chain where - makeRepo = do - putStrLn $ "Setting up your propellor repo in " ++ propellordir - putStrLn "" - ifM (doesFileExist distrepo <||> doesDirectoryExist distrepo) - ( do - void $ boolSystem "git" [Param "clone", File distrepo, File propellordir] - fetchUpstreamBranch propellordir distrepo - changeWorkingDirectory propellordir - void $ boolSystem "git" [Param "remote", Param "rm", Param "origin"] - , do - void $ boolSystem "git" [Param "clone", Param netrepo, File propellordir] - changeWorkingDirectory propellordir - -- Rename origin to upstream and avoid - -- git push to that read-only repo. - void $ boolSystem "git" [Param "remote", Param "rename", Param "origin", Param "upstream"] - void $ boolSystem "git" [Param "config", Param "--unset", Param "branch.master.remote", Param "upstream"] - ) - - checkRepo = whenM (doesFileExist disthead <&&> doesFileExist (propellordir "propellor.cabal")) $ do - headrev <- takeWhile (/= '\n') <$> readFile disthead - changeWorkingDirectory propellordir - headknown <- catchMaybeIO $ - withQuietOutput createProcessSuccess $ - proc "git" ["log", headrev] - if (headknown == Nothing) - then setupupstreammaster headrev propellordir - else do - merged <- not . null <$> - readProcess "git" ["log", headrev ++ "..HEAD", "--ancestry-path"] - unless merged $ - warnoutofdate propellordir True - buildruncfg = do - changeWorkingDirectory propellordir - buildPropellor Nothing - putStrLn "" - putStrLn "" - chain + propellorbin = dotpropellor "propellor" chain = do (_, _, _, pid) <- createProcess (proc propellorbin args) exitWith =<< waitForProcess pid --- Passed the user's propellordir repository, makes upstream/master +welcomeBanner :: IO () +welcomeBanner = putStr $ unlines $ map prettify + [ "" + , "" + , " _ ______`| ,-.__" + , " .--------------------------- / ~___-=O`/|O`/__| (____.'" + , " - Welcome to -- ~ / | / ) _.-'-._" + , " - Propellor! -- `/-==__ _/__|/__=-| ( ~_" + , " `--------------------------- * ~ | | '--------'" + , " (o) `" + , "" + , "" + ] + where + prettify = map (replace '~' '\\') + replace x y c + | c == x = y + | otherwise = c + +prompt :: String -> [(Char, IO ())] -> IO () +prompt p cs = do + putStr (p ++ " [" ++ map fst cs ++ "] ") + hFlush stdout + r <- map toLower <$> getLine + if r == "\n" + then snd (head cs) -- default to first choice on return + else case filter (\(c, a) -> [toLower c] == r) cs of + [(_, a)] -> a + _ -> do + putStrLn "Not a valid choice, try again.. (Or ctrl-c to quit)" + prompt p cs + +section :: IO () +section = do + putStrLn "" + putStrLn "---------------------------------------------------------------------------------" + putStrLn "" + +setup :: FilePath -> IO () +setup dotpropellor = do + putStrLn "Propellor's configuration file is ~/.propellor/config.hs" + putStrLn "" + putStrLn "Lets get you started with a simple config that you can adapt" + putStrLn "to your needs. You can start with:" + putStrLn " A: A clone of propellor's git repository (most flexible)" + putStrLn " B: The bare minimum files to use propellor (most simple)" + prompt "Which would you prefer?" + [ ('A', fullClone dotpropellor), + ('B', minimalConfig dotpropellor) + ] + putStrLn "Ok, ~/.propellor/config.hs is set up!" + + section + putStrLn "Let's try building the propellor configuration, to make sure it will work..." + buildPropellor Nothing + putStrLn "Great! Propellor is set up and ready to use." + + section + putStrLn "Your next step is to edit ~/.propellor/config.hs," + putStrLn "and run propellor again to try it out." + putStrLn "" + putStrLn "For docs, see https://propellor.branchable.com/" + putStrLn "Enjoy propellor!" + +minimalConfig :: FilePath -> IO () +minimalConfig dotpropellor = do + createDirectoryIfMissing True dotpropellor + writeFile cabalfile (unlines cabalcontent) + writeFile configfile (unlines configcontent) + changeWorkingDirectory dotpropellor + void $ boolSystem "git" [Param "init"] + void $ boolSystem "git" [Param "add" , File cabalfile, File configfile] + where + cabalfile = dotpropellor "config.cabal" + configfile = dotpropellor "config.hs" + cabalcontent = + [ "-- This is a cabal file to use to build your propellor configuration." + , "" + , "Name: config" + , "Cabal-Version: >= 1.6" + , "Build-Type: Simple" + , "Version: 0" + , "" + , "Executable propellor-config" + , " Main-Is: config.hs" + , " GHC-Options: -threaded -Wall -fno-warn-tabs -O0" + , " Extensions: TypeOperators" + , " Build-Depends: propellor >= 3.0, base >= 3" + ] + configcontent = + [ "-- This is the main configuration file for Propellor, and is used to build" + , "-- the propellor program." + , "" + , "import Propellor" + , "import qualified Propellor.Property.File as File" + , "import qualified Propellor.Property.Apt as Apt" + , "import qualified Propellor.Property.Cron as Cron" + , "import qualified Propellor.Property.User as User" + , "" + , "main :: IO ()" + , "main = defaultMain hosts" + , "" + , "-- The hosts propellor knows about." + , "hosts :: [Host]" + , "hosts =" + , " [ mybox" + , " ]" + , "" + , "-- An example host." + , "mybox :: Host" + , "mybox = host \"mybox.example.com\" $ props" + , " & osDebian Unstable \"amd64\"" + , " & Apt.stdSourcesList" + , " & Apt.unattendedUpgrades" + , " & Apt.installed [\"etckeeper\"]" + , " & Apt.installed [\"ssh\"]" + , " & User.hasSomePassword (User \"root\")" + , " & File.dirExists \"/var/www\"" + , " & Cron.runPropellor (Cron.Times \"30 * * * *\")" + , "" + ] + +fullClone :: FilePath -> IO () +fullClone dotpropellor = ifM (doesFileExist distrepo <||> doesDirectoryExist distrepo) + ( do + void $ boolSystem "git" [Param "clone", File distrepo, File dotpropellor] + fetchUpstreamBranch dotpropellor distrepo + changeWorkingDirectory dotpropellor + void $ boolSystem "git" [Param "remote", Param "rm", Param "origin"] + , do + void $ boolSystem "git" [Param "clone", Param netrepo, File dotpropellor] + changeWorkingDirectory dotpropellor + -- Rename origin to upstream and avoid + -- git push to that read-only repo. + void $ boolSystem "git" [Param "remote", Param "rename", Param "origin", Param "upstream"] + void $ boolSystem "git" [Param "config", Param "--unset", Param "branch.master.remote", Param "upstream"] + ) + +checkRepoUpToDate :: FilePath -> IO () +checkRepoUpToDate dotpropellor = whenM (gitbundleavail <&&> dotpropellorpopulated) $ do + headrev <- takeWhile (/= '\n') <$> readFile disthead + changeWorkingDirectory dotpropellor + headknown <- catchMaybeIO $ + withQuietOutput createProcessSuccess $ + proc "git" ["log", headrev] + if (headknown == Nothing) + then setupUpstreamMaster headrev dotpropellor + else do + merged <- not . null <$> + readProcess "git" ["log", headrev ++ "..HEAD", "--ancestry-path"] + unless merged $ + warnoutofdate dotpropellor True + where + gitbundleavail = doesFileExist disthead + dotpropellorpopulated = doesFileExist (dotpropellor "propellor.cabal") + +-- Passed the user's dotpropellor repository, makes upstream/master -- be a usefully mergeable branch. -- -- We cannot just use origin/master, because in the case of a distrepo, @@ -122,12 +248,12 @@ wrapper args propellordir propellorbin = do -- repository, giving it a new master branch. That new branch is fetched -- into the user's repository, as if fetching from a upstream remote, -- yielding a new upstream/master branch. -setupupstreammaster :: String -> FilePath -> IO () -setupupstreammaster newref propellordir = do - changeWorkingDirectory propellordir +setupUpstreamMaster :: String -> FilePath -> IO () +setupUpstreamMaster newref dotpropellor = do + changeWorkingDirectory dotpropellor go =<< catchMaybeIO getoldrev where - go Nothing = warnoutofdate propellordir False + go Nothing = warnoutofdate dotpropellor False go (Just oldref) = do let tmprepo = ".git/propellordisttmp" let cleantmprepo = void $ catchMaybeIO $ removeDirectoryRecursive tmprepo @@ -139,9 +265,9 @@ setupupstreammaster newref propellordir = do git ["reset", "--hard", oldref, "--quiet"] git ["merge", newref, "-s", "recursive", "-Xtheirs", "--quiet", "-m", "merging upstream version"] - fetchUpstreamBranch propellordir tmprepo + fetchUpstreamBranch dotpropellor tmprepo cleantmprepo - warnoutofdate propellordir True + warnoutofdate dotpropellor True getoldrev = takeWhile (/= '\n') <$> readProcess "git" ["show-ref", upstreambranch, "--hash"] @@ -151,8 +277,8 @@ setupupstreammaster newref propellordir = do error $ "Failed to run " ++ cmd ++ " " ++ show ps warnoutofdate :: FilePath -> Bool -> IO () -warnoutofdate propellordir havebranch = do - warningMessage ("** Your " ++ propellordir ++ " is out of date..") +warnoutofdate dotpropellor havebranch = do + warningMessage ("** Your " ++ dotpropellor ++ " is out of date..") let also s = hPutStrLn stderr (" " ++ s) also ("A newer upstream version is available in " ++ distrepo) if havebranch @@ -161,8 +287,8 @@ warnoutofdate propellordir havebranch = do also "" fetchUpstreamBranch :: FilePath -> FilePath -> IO () -fetchUpstreamBranch propellordir repo = do - changeWorkingDirectory propellordir +fetchUpstreamBranch dotpropellor repo = do + changeWorkingDirectory dotpropellor void $ boolSystem "git" [ Param "fetch" , File repo -- cgit v1.2.3