summaryrefslogtreecommitdiff
path: root/src/wrapper.hs
diff options
context:
space:
mode:
authorJoey Hess2016-04-01 18:33:17 -0400
committerJoey Hess2016-04-01 18:33:17 -0400
commit503437b676f5c4d41ef41c6de3e3b25045bcc5d7 (patch)
treeed5daf192aebef75d89b8ea2c6be36f66f14b968 /src/wrapper.hs
parent351c06951753e38ddb238d9dca01f29ddef33eeb (diff)
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.
Diffstat (limited to 'src/wrapper.hs')
-rw-r--r--src/wrapper.hs254
1 files changed, 190 insertions, 64 deletions
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