From 0f410f8acdb9e0b84ae364e80e5ee63adcb2ee50 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 30 Mar 2016 15:18:39 -0400 Subject: When new dependencies are added to propellor or the propellor config, try harder to get them installed. In particular, this makes propellor --spin work when the remote host needs to get dependencies installed in order to build the updated config. Fixes http://propellor.branchable.com/todo/problem_with_spin_after_new_dependencies_added/ --- src/wrapper.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/wrapper.hs') diff --git a/src/wrapper.hs b/src/wrapper.hs index a204b60c..289b12b5 100644 --- a/src/wrapper.hs +++ b/src/wrapper.hs @@ -99,7 +99,7 @@ wrapper args propellordir propellorbin = do warnoutofdate propellordir True buildruncfg = do changeWorkingDirectory propellordir - buildPropellor + buildPropellor Nothing putStrLn "" putStrLn "" chain -- cgit v1.2.3 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. --- debian/changelog | 3 + src/wrapper.hs | 254 +++++++++++++++++++++++++++++++++++++++++-------------- 2 files changed, 193 insertions(+), 64 deletions(-) (limited to 'src/wrapper.hs') diff --git a/debian/changelog b/debian/changelog index ee3311e4..14d3f1a9 100644 --- a/debian/changelog +++ b/debian/changelog @@ -64,6 +64,9 @@ propellor (3.0.0) UNRELEASED; urgency=medium these complex new types. * Added dependency on concurrent-output; removed embedded copy. * Apt.PPA: New module, contributed by Evan Cofsky. + * 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. -- Joey Hess Wed, 30 Mar 2016 15:45:08 -0400 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 From ccfdfcab60753eb6eb6ab1c6a6ad6203b8adfdcf Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 1 Apr 2016 18:36:38 -0400 Subject: fix false positive for out of date message after initial clone from git bundle --- src/wrapper.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'src/wrapper.hs') diff --git a/src/wrapper.hs b/src/wrapper.hs index f079eb32..82251dc9 100644 --- a/src/wrapper.hs +++ b/src/wrapper.hs @@ -12,6 +12,7 @@ module Main where import Propellor.Message import Propellor.Bootstrap +import Propellor.Git import Utility.UserInfo import Utility.Monad import Utility.Process @@ -225,10 +226,12 @@ checkRepoUpToDate dotpropellor = whenM (gitbundleavail <&&> dotpropellorpopulate if (headknown == Nothing) then setupUpstreamMaster headrev dotpropellor else do - merged <- not . null <$> - readProcess "git" ["log", headrev ++ "..HEAD", "--ancestry-path"] - unless merged $ - warnoutofdate dotpropellor True + theirhead <- getCurrentGitSha1 =<< getCurrentBranchRef + when (theirhead /= headrev) $ 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") -- cgit v1.2.3 From 93b083f3a1204a7cf4452b5ebd589dd77d25dbac Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 1 Apr 2016 19:34:27 -0400 Subject: setup gpg key in initial setup process --- debian/changelog | 5 +- doc/README.mdwn | 19 ++---- doc/components.mdwn | 8 +-- doc/todo/commandline_to_setup_minimal_repo.mdwn | 2 + src/Propellor/Gpg.hs | 17 +++-- src/wrapper.hs | 88 ++++++++++++++++++++++--- 6 files changed, 104 insertions(+), 35 deletions(-) (limited to 'src/wrapper.hs') diff --git a/debian/changelog b/debian/changelog index 14d3f1a9..21c53bf8 100644 --- a/debian/changelog +++ b/debian/changelog @@ -65,8 +65,9 @@ propellor (3.0.0) UNRELEASED; urgency=medium * Added dependency on concurrent-output; removed embedded copy. * Apt.PPA: New module, contributed by Evan Cofsky. * 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. + now walk the user through setting up ~/.propellor, with a choice between + a clone of propellor's git repository, or a minimal config, and will + configure propellor to use a gpg key. -- Joey Hess Wed, 30 Mar 2016 15:45:08 -0400 diff --git a/doc/README.mdwn b/doc/README.mdwn index b17f8575..fc3c3fd1 100644 --- a/doc/README.mdwn +++ b/doc/README.mdwn @@ -44,18 +44,13 @@ see [configuration for the Haskell newbie](https://propellor.branchable.com/hask `apt-get install propellor` 2. Run `propellor` for the first time. It will set up a `~/.propellor/` git repository for you. -3. If you don't have a gpg private key already, generate one: `gpg --gen-key` -4. Run: `propellor --add-key $KEYID`, which will make propellor trust - your gpg key, and will sign your `~/.propellor` repository using it. -5. Edit `~/.propellor/config.hs`, and add a host you want to manage. +3. Edit `~/.propellor/config.hs`, and add a host you want to manage. You can start by not adding any properties, or only a few. -6. Run: `propellor --spin $HOST` -7. Now you have a simple propellor deployment, but it doesn't do - much to the host yet, besides installing propellor. - So, edit `~/.propellor/config.hs` to configure the host, add some - properties to it, and re-run step 6. - Repeat until happy and move on to the next host. :) -8. Once you have a lot of hosts, and running `propellor --spin HOST` for +4. Run: `propellor --spin $HOST` +5. Now you have a simple propellor deployment to a host. Continue editing + `~/.propellor/config.hs` to further configure the host, add more hosts + etc, and re-run `propellor --spin $HOST` after each change. +6. Once you have a lot of hosts, and running `propellor --spin HOST` for each host becomes tiresome, you can [automate that](http://propellor.branchable.com/automated_spins/). -9. Write some neat new properties and send patches! +7. Write some neat new properties and send patches! diff --git a/doc/components.mdwn b/doc/components.mdwn index 801bb6bf..5b47e106 100644 --- a/doc/components.mdwn +++ b/doc/components.mdwn @@ -28,12 +28,8 @@ then copy in `~/.propellor/src/Propellor/` and it will be used. See ## minimal .propellor repository All that really needs to be in `~/.propellor/` though, is a `config.hs` -file, and a cabal file. To use propellor this way, you can first -install propellor, and then copy the two files from the -[mininalconfig branch](http://source.propellor.branchable.com/?p=source.git;a=tree;h=refs/heads/minimalconfig;hb=refs/heads/minimalconfig), -or clone it: - - git clone git://propellor.branchable.com/ .propellor --branch minimalconfig --single-branch +file, and a cabal file. Running propellor when `~/.propellor/` doesn't exist +will ask you if you want a minimal config, and create those files. In this configuration, when propellor is deploying itself to a new host, it will automatically install the version of the propellor library diff --git a/doc/todo/commandline_to_setup_minimal_repo.mdwn b/doc/todo/commandline_to_setup_minimal_repo.mdwn index 5e82ed0f..2b41d370 100644 --- a/doc/todo/commandline_to_setup_minimal_repo.mdwn +++ b/doc/todo/commandline_to_setup_minimal_repo.mdwn @@ -3,3 +3,5 @@ parameters, like --minimal to clone the minimal config repo instead of the full one, or --stack to set up ~/.propellor to use stack. --[[Joey]] > Or, it could be an interactive setup process. --[[Joey]] + +>> Made it interactive. [[done]] --[[Joey]] diff --git a/src/Propellor/Gpg.hs b/src/Propellor/Gpg.hs index 55d89d29..4e6ceb79 100644 --- a/src/Propellor/Gpg.hs +++ b/src/Propellor/Gpg.hs @@ -32,14 +32,21 @@ getGpgBin = do -- Lists the keys in propellor's keyring. listPubKeys :: IO [KeyId] listPubKeys = do - gpgbin <- getGpgBin keyring <- privDataKeyring - parse . lines <$> readProcess gpgbin (listopts keyring) + map fst <$> listKeys ("--list-public-keys" : useKeyringOpts keyring) + +listSecretKeys :: IO [(KeyId, String)] +listSecretKeys = listKeys ["--list-secret-keys"] + +listKeys :: [String] -> IO [(KeyId, String)] +listKeys ps = do + gpgbin <- getGpgBin + parse . lines <$> readProcess gpgbin listopts where - listopts keyring = useKeyringOpts keyring ++ - ["--with-colons", "--list-public-keys"] + listopts = ps ++ ["--with-colons"] parse = mapMaybe (keyIdField . split ":") - keyIdField ("pub":_:_:_:f:_) = Just f + keyIdField (t:_:_:_:f:_:_:_:_:n:_) + | t == "pub" || t == "sec" = Just (f, n) keyIdField _ = Nothing useKeyringOpts :: FilePath -> [String] diff --git a/src/wrapper.hs b/src/wrapper.hs index 82251dc9..32e036da 100644 --- a/src/wrapper.hs +++ b/src/wrapper.hs @@ -3,8 +3,7 @@ -- Distributions should install this program into PATH. -- (Cabal builds it as dist/build/propellor/propellor). -- --- This is not the propellor main program (that's config.hs) --- +-- This is not the propellor main program (that's config.hs). -- This bootstraps ~/.propellor/config.hs, builds it if -- it's not already built, and runs it. @@ -13,13 +12,16 @@ module Main where import Propellor.Message import Propellor.Bootstrap import Propellor.Git +import Propellor.Gpg import Utility.UserInfo import Utility.Monad import Utility.Process import Utility.SafeCommand import Utility.Exception +import Utility.Path import Data.Char +import Data.List import Control.Monad import Control.Monad.IfElse import System.Directory @@ -97,14 +99,14 @@ welcomeBanner = putStr $ unlines $ map prettify | c == x = y | otherwise = c -prompt :: String -> [(Char, IO ())] -> IO () +prompt :: String -> [(String, IO ())] -> IO () prompt p cs = do - putStr (p ++ " [" ++ map fst cs ++ "] ") + putStr (p ++ " [" ++ intercalate "|" (map fst cs) ++ "] ") hFlush stdout r <- map toLower <$> getLine - if r == "\n" + if null r then snd (head cs) -- default to first choice on return - else case filter (\(c, a) -> [toLower c] == r) cs of + else case filter (\(s, _) -> map toLower s == r) cs of [(_, a)] -> a _ -> do putStrLn "Not a valid choice, try again.. (Or ctrl-c to quit)" @@ -125,23 +127,89 @@ setup dotpropellor = do 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) + [ ("A", fullClone dotpropellor) + , ("B", minimalConfig dotpropellor) ] putStrLn "Ok, ~/.propellor/config.hs is set up!" - + changeWorkingDirectory dotpropellor + 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." + putStrLn "Great! Propellor is bootstrapped." + + section + putStrLn "Propellor uses gpg to encrypt private data about the systems it manages," + putStrLn "and to sign git commits." + gpg <- getGpgBin + ifM (inPath gpg) + ( setupGpgKey dotpropellor + , do + putStrLn "You don't seem to have gpg installed, so skipping setting it up." + explainManualSetupGpgKey + ) section + putStrLn "Everything is set up ..." 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!" +explainManualSetupGpgKey :: IO () +explainManualSetupGpgKey = do + putStrLn "Propellor can still be used without gpg, but it won't be able to" + putStrLn "manage private data. You can set this up later:" + putStrLn " 1. gpg --gen-key" + putStrLn " 2. propellor --add-key (pass it the key ID generated in step 1)" + +setupGpgKey :: FilePath -> IO () +setupGpgKey dotpropellor = do + ks <- listSecretKeys + putStrLn "" + case ks of + [] -> makeGpgKey dotpropellor + [(k, _)] -> propellorAddKey dotpropellor k + _ -> do + let nks = zip ks (map show ([1..] :: [Integer])) + putStrLn "I see you have several gpg keys:" + forM_ nks $ \((k, d), n) -> + putStrLn $ " " ++ n ++ " " ++ d ++ " (keyid " ++ k ++ ")" + prompt "Which of your gpg keys should propellor use?" + (map (\((k, _), n) -> (n, propellorAddKey dotpropellor k)) nks) + +makeGpgKey :: FilePath -> IO () +makeGpgKey dotpropellor = do + putStrLn "You seem to not have any gpg secret keys." + prompt "Would you like to create one now?" + [("Y", rungpg), ("N", nope)] + where + nope = do + putStrLn "No problem." + explainManualSetupGpgKey + rungpg = do + putStrLn "Running gpg --gen-key ..." + gpg <- getGpgBin + void $ boolSystem gpg [Param "--gen-key"] + ks <- listSecretKeys + case ks of + [] -> do + putStrLn "Hmm, gpg seemed to not set up a secret key." + prompt "Want to try running gpg again?" + [("Y", rungpg), ("N", nope)] + ((k, _):_) -> propellorAddKey dotpropellor k + +propellorAddKey :: FilePath -> String -> IO () +propellorAddKey dotpropellor keyid = do + putStrLn "" + putStrLn $ "Telling propellor to use your gpg key by running: propellor --add-key " ++ keyid + unlessM (boolSystem propellorbin [Param "--add-key", Param keyid]) $ do + putStrLn "Oops, that didn't work! You can retry the same command later." + putStrLn "Continuing onward ..." + where + propellorbin = dotpropellor "propellor" + minimalConfig :: FilePath -> IO () minimalConfig dotpropellor = do createDirectoryIfMissing True dotpropellor -- cgit v1.2.3 From 1dc914a71c94e0395641565e5891a2dc33ba1b35 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 1 Apr 2016 21:20:13 -0400 Subject: separate propellor --init --- debian/changelog | 4 +- doc/README.mdwn | 2 +- propellor.cabal | 1 + src/Propellor/CmdLine.hs | 4 + src/Propellor/DotDir.hs | 348 ++++++++++++++++++++++++++++++++++++++++ src/Propellor/Types/CmdLine.hs | 1 + src/wrapper.hs | 353 ++--------------------------------------- 7 files changed, 370 insertions(+), 343 deletions(-) create mode 100644 src/Propellor/DotDir.hs (limited to 'src/wrapper.hs') diff --git a/debian/changelog b/debian/changelog index 21c53bf8..ae593902 100644 --- a/debian/changelog +++ b/debian/changelog @@ -64,8 +64,8 @@ propellor (3.0.0) UNRELEASED; urgency=medium these complex new types. * Added dependency on concurrent-output; removed embedded copy. * Apt.PPA: New module, contributed by Evan Cofsky. - * Improved propellor's first run experience; the wrapper program will - now walk the user through setting up ~/.propellor, with a choice between + * Improved propellor's first run experience; propellor --init will + walk the user through setting up ~/.propellor, with a choice between a clone of propellor's git repository, or a minimal config, and will configure propellor to use a gpg key. diff --git a/doc/README.mdwn b/doc/README.mdwn index fc3c3fd1..31d222c1 100644 --- a/doc/README.mdwn +++ b/doc/README.mdwn @@ -42,7 +42,7 @@ see [configuration for the Haskell newbie](https://propellor.branchable.com/hask `cabal install propellor` or `apt-get install propellor` -2. Run `propellor` for the first time. It will set up a `~/.propellor/` git +2. Run `propellor --init` ; this will set up a `~/.propellor/` git repository for you. 3. Edit `~/.propellor/config.hs`, and add a host you want to manage. You can start by not adding any properties, or only a few. diff --git a/propellor.cabal b/propellor.cabal index 9f74d264..d97d4096 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -151,6 +151,7 @@ Library Propellor.Info Propellor.Message Propellor.Debug + Propellor.DotDir Propellor.PrivData Propellor.Engine Propellor.EnsureProperty diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index d93a8e3a..19e49f5a 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -16,6 +16,7 @@ import Propellor.Git.VerifiedBranch import Propellor.Bootstrap import Propellor.Spin import Propellor.Types.CmdLine +import Propellor.DotDir (interactiveInit) import qualified Propellor.Property.Docker as Docker import qualified Propellor.Property.Chroot as Chroot import qualified Propellor.Shim as Shim @@ -23,6 +24,7 @@ import qualified Propellor.Shim as Shim usage :: Handle -> IO () usage h = hPutStrLn h $ unlines [ "Usage:" + , " propellor --init" , " propellor" , " propellor hostname" , " propellor --spin targethost [--via relayhost]" @@ -69,6 +71,7 @@ processCmdLine = go =<< getArgs go ("--serialized":s:[]) = serialized Serialized s go ("--continue":s:[]) = serialized Continue s go ("--gitpush":fin:fout:_) = return $ GitPush (Prelude.read fin) (Prelude.read fout) + go ("--init":_) = return Init go ("--run":h:[]) = go [h] go (h:[]) | "--" `isPrefixOf` h = usageError [h] @@ -130,6 +133,7 @@ defaultMain hostlist = withConcurrentOutput $ do fetchFirst (buildFirst (findHost hostlist hn) cr cmdline (runhost hn)) -- When continuing after a rebuild, don't want to rebuild again. go _ (Continue cmdline) = go NoRebuild cmdline + go _ Init = interactiveInit withhost :: HostName -> (Host -> IO ()) -> IO () withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn) diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs new file mode 100644 index 00000000..92c20654 --- /dev/null +++ b/src/Propellor/DotDir.hs @@ -0,0 +1,348 @@ +module Propellor.DotDir where + +import Propellor.Message +import Propellor.Bootstrap +import Propellor.Git +import Propellor.Gpg +import Utility.UserInfo +import Utility.Monad +import Utility.Process +import Utility.SafeCommand +import Utility.Exception +import Utility.Path + +import Data.Char +import Data.List +import Control.Monad +import Control.Monad.IfElse +import System.Directory +import System.FilePath +import System.Posix.Directory +import System.IO +import Control.Applicative +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" + +upstreambranch :: String +upstreambranch = "upstream/master" + +-- Using the github mirror of the main propellor repo because +-- it is accessible over https for better security. +netrepo :: String +netrepo = "https://github.com/joeyh/propellor.git" + +dotPropellor :: IO FilePath +dotPropellor = do + home <- myHomeDir + return (home ".propellor") + +interactiveInit :: IO () +interactiveInit = ifM (doesDirectoryExist =<< dotPropellor) + ( error "~/.propellor/ already exists, not doing anything" + , do + welcomeBanner + setup + ) + +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 -> [(String, IO ())] -> IO () +prompt p cs = do + putStr (p ++ " [" ++ intercalate "|" (map fst cs) ++ "] ") + hFlush stdout + r <- map toLower <$> getLine + if null r + then snd (head cs) -- default to first choice on return + else case filter (\(s, _) -> map toLower s == 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 :: IO () +setup = do + dotpropellor <- dotPropellor + 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) + , ("B", minimalConfig) + ] + putStrLn "Ok, ~/.propellor/config.hs is set up!" + changeWorkingDirectory dotpropellor + + section + putStrLn "Let's try building the propellor configuration, to make sure it will work..." + buildPropellor Nothing + putStrLn "Great! Propellor is bootstrapped." + + section + putStrLn "Propellor uses gpg to encrypt private data about the systems it manages," + putStrLn "and to sign git commits." + gpg <- getGpgBin + ifM (inPath gpg) + ( setupGpgKey + , do + putStrLn "You don't seem to have gpg installed, so skipping setting it up." + explainManualSetupGpgKey + ) + + section + putStrLn "Everything is set up ..." + 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!" + +explainManualSetupGpgKey :: IO () +explainManualSetupGpgKey = do + putStrLn "Propellor can still be used without gpg, but it won't be able to" + putStrLn "manage private data. You can set this up later:" + putStrLn " 1. gpg --gen-key" + putStrLn " 2. propellor --add-key (pass it the key ID generated in step 1)" + +setupGpgKey :: IO () +setupGpgKey = do + ks <- listSecretKeys + putStrLn "" + case ks of + [] -> makeGpgKey + [(k, _)] -> propellorAddKey k + _ -> do + let nks = zip ks (map show ([1..] :: [Integer])) + putStrLn "I see you have several gpg keys:" + forM_ nks $ \((k, d), n) -> + putStrLn $ " " ++ n ++ " " ++ d ++ " (keyid " ++ k ++ ")" + prompt "Which of your gpg keys should propellor use?" + (map (\((k, _), n) -> (n, propellorAddKey k)) nks) + +makeGpgKey :: IO () +makeGpgKey = do + putStrLn "You seem to not have any gpg secret keys." + prompt "Would you like to create one now?" + [("Y", rungpg), ("N", nope)] + where + nope = do + putStrLn "No problem." + explainManualSetupGpgKey + rungpg = do + putStrLn "Running gpg --gen-key ..." + gpg <- getGpgBin + void $ boolSystem gpg [Param "--gen-key"] + ks <- listSecretKeys + case ks of + [] -> do + putStrLn "Hmm, gpg seemed to not set up a secret key." + prompt "Want to try running gpg again?" + [("Y", rungpg), ("N", nope)] + ((k, _):_) -> propellorAddKey k + +propellorAddKey :: String -> IO () +propellorAddKey keyid = do + putStrLn "" + putStrLn $ "Telling propellor to use your gpg key by running: propellor --add-key " ++ keyid + d <- dotPropellor + unlessM (boolSystem (d "propellor") [Param "--add-key", Param keyid]) $ do + putStrLn "Oops, that didn't work! You can retry the same command later." + putStrLn "Continuing onward ..." + +minimalConfig :: IO () +minimalConfig = do + d <- dotPropellor + createDirectoryIfMissing True d + let cabalfile = d "config.cabal" + let configfile = d "config.hs" + writeFile cabalfile (unlines cabalcontent) + writeFile configfile (unlines configcontent) + changeWorkingDirectory d + void $ boolSystem "git" [Param "init"] + void $ boolSystem "git" [Param "add" , File cabalfile, File configfile] + where + 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 :: IO () +fullClone = do + d <- dotPropellor + ifM (doesFileExist distrepo <||> doesDirectoryExist distrepo) + ( do + void $ boolSystem "git" [Param "clone", File distrepo, File d] + fetchUpstreamBranch distrepo + changeWorkingDirectory d + void $ boolSystem "git" [Param "remote", Param "rm", Param "origin"] + , do + void $ boolSystem "git" [Param "clone", Param netrepo, File d] + changeWorkingDirectory d + -- 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"] + ) + +fetchUpstreamBranch :: FilePath -> IO () +fetchUpstreamBranch repo = do + changeWorkingDirectory =<< dotPropellor + void $ boolSystem "git" + [ Param "fetch" + , File repo + , Param ("+refs/heads/master:refs/remotes/" ++ upstreambranch) + , Param "--quiet" + ] + +checkRepoUpToDate :: IO () +checkRepoUpToDate = 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 + else do + theirhead <- getCurrentGitSha1 =<< getCurrentBranchRef + when (theirhead /= headrev) $ do + merged <- not . null <$> + readProcess "git" ["log", headrev ++ "..HEAD", "--ancestry-path"] + unless merged $ + warnoutofdate True + where + gitbundleavail = doesFileExist disthead + dotpropellorpopulated = do + d <- dotPropellor + doesFileExist (d "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, +-- it only contains 1 commit. So, trying to merge with it will result +-- in lots of merge conflicts, since git cannot find a common parent +-- commit. +-- +-- Instead, the upstream/master branch is created by taking the +-- upstream/master branch (which must be an old version of propellor, +-- as distributed), and diffing from it to the current origin/master, +-- and committing the result. This is done in a temporary clone of the +-- 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 -> IO () +setupUpstreamMaster newref = do + changeWorkingDirectory =<< dotPropellor + go =<< catchMaybeIO getoldrev + where + go Nothing = warnoutofdate False + go (Just oldref) = do + let tmprepo = ".git/propellordisttmp" + let cleantmprepo = void $ catchMaybeIO $ removeDirectoryRecursive tmprepo + cleantmprepo + git ["clone", "--quiet", ".", tmprepo] + + changeWorkingDirectory tmprepo + git ["fetch", distrepo, "--quiet"] + git ["reset", "--hard", oldref, "--quiet"] + git ["merge", newref, "-s", "recursive", "-Xtheirs", "--quiet", "-m", "merging upstream version"] + + fetchUpstreamBranch tmprepo + cleantmprepo + warnoutofdate True + + getoldrev = takeWhile (/= '\n') + <$> readProcess "git" ["show-ref", upstreambranch, "--hash"] + + git = run "git" + run cmd ps = unlessM (boolSystem cmd (map Param ps)) $ + error $ "Failed to run " ++ cmd ++ " " ++ show ps + +warnoutofdate :: Bool -> IO () +warnoutofdate havebranch = do + warningMessage ("** Your ~/.propellor/ is out of date..") + let also s = hPutStrLn stderr (" " ++ s) + also ("A newer upstream version is available in " ++ distrepo) + if havebranch + then also ("To merge it, run: git merge " ++ upstreambranch) + else also ("To merge it, find the most recent commit in your repository's history that corresponds to an upstream release of propellor, and set refs/remotes/" ++ upstreambranch ++ " to it. Then run propellor again.") + also "" diff --git a/src/Propellor/Types/CmdLine.hs b/src/Propellor/Types/CmdLine.hs index 558c6e8b..0773d9d9 100644 --- a/src/Propellor/Types/CmdLine.hs +++ b/src/Propellor/Types/CmdLine.hs @@ -28,4 +28,5 @@ data CmdLine | ChrootChain HostName FilePath Bool Bool | GitPush Fd Fd | Check + | Init deriving (Read, Show, Eq) diff --git a/src/wrapper.hs b/src/wrapper.hs index 32e036da..1a90fcb0 100644 --- a/src/wrapper.hs +++ b/src/wrapper.hs @@ -9,360 +9,33 @@ module Main where +import Propellor.DotDir import Propellor.Message import Propellor.Bootstrap -import Propellor.Git -import Propellor.Gpg -import Utility.UserInfo import Utility.Monad import Utility.Process -import Utility.SafeCommand -import Utility.Exception -import Utility.Path -import Data.Char -import Data.List -import Control.Monad -import Control.Monad.IfElse import System.Directory -import System.FilePath import System.Environment (getArgs) import System.Exit import System.Posix.Directory -import System.IO -import Control.Applicative -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" - -upstreambranch :: String -upstreambranch = "upstream/master" - --- Using the github mirror of the main propellor repo because --- it is accessible over https for better security. -netrepo :: String -netrepo = "https://github.com/joeyh/propellor.git" main :: IO () -main = withConcurrentOutput $ do - args <- getArgs - home <- myHomeDir - let dotpropellor = home ".propellor" - ifM (doesDirectoryExist dotpropellor) +main = withConcurrentOutput $ go =<< getArgs + where + go ["--init"] = interactiveInit + go args = ifM (doesDirectoryExist =<< dotPropellor) ( do - checkRepoUpToDate dotpropellor - buildRunConfig dotpropellor args - , do - welcomeBanner - setup dotpropellor + checkRepoUpToDate + buildRunConfig args + , error "Seems that ~/.propellor/ does not exist. To set it up, run: propellor --init" ) -buildRunConfig :: FilePath -> [String] -> IO () -buildRunConfig dotpropellor args = do - changeWorkingDirectory dotpropellor - buildPropellor Nothing - putStrLn "" - putStrLn "" - chain - where - propellorbin = dotpropellor "propellor" - chain = do - (_, _, _, pid) <- createProcess (proc propellorbin args) - exitWith =<< waitForProcess pid - -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 -> [(String, IO ())] -> IO () -prompt p cs = do - putStr (p ++ " [" ++ intercalate "|" (map fst cs) ++ "] ") - hFlush stdout - r <- map toLower <$> getLine - if null r - then snd (head cs) -- default to first choice on return - else case filter (\(s, _) -> map toLower s == 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!" - changeWorkingDirectory dotpropellor - - section - putStrLn "Let's try building the propellor configuration, to make sure it will work..." +buildRunConfig :: [String] -> IO () +buildRunConfig args = do + changeWorkingDirectory =<< dotPropellor buildPropellor Nothing - putStrLn "Great! Propellor is bootstrapped." - - section - putStrLn "Propellor uses gpg to encrypt private data about the systems it manages," - putStrLn "and to sign git commits." - gpg <- getGpgBin - ifM (inPath gpg) - ( setupGpgKey dotpropellor - , do - putStrLn "You don't seem to have gpg installed, so skipping setting it up." - explainManualSetupGpgKey - ) - - section - putStrLn "Everything is set up ..." - 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!" - -explainManualSetupGpgKey :: IO () -explainManualSetupGpgKey = do - putStrLn "Propellor can still be used without gpg, but it won't be able to" - putStrLn "manage private data. You can set this up later:" - putStrLn " 1. gpg --gen-key" - putStrLn " 2. propellor --add-key (pass it the key ID generated in step 1)" - -setupGpgKey :: FilePath -> IO () -setupGpgKey dotpropellor = do - ks <- listSecretKeys - putStrLn "" - case ks of - [] -> makeGpgKey dotpropellor - [(k, _)] -> propellorAddKey dotpropellor k - _ -> do - let nks = zip ks (map show ([1..] :: [Integer])) - putStrLn "I see you have several gpg keys:" - forM_ nks $ \((k, d), n) -> - putStrLn $ " " ++ n ++ " " ++ d ++ " (keyid " ++ k ++ ")" - prompt "Which of your gpg keys should propellor use?" - (map (\((k, _), n) -> (n, propellorAddKey dotpropellor k)) nks) - -makeGpgKey :: FilePath -> IO () -makeGpgKey dotpropellor = do - putStrLn "You seem to not have any gpg secret keys." - prompt "Would you like to create one now?" - [("Y", rungpg), ("N", nope)] - where - nope = do - putStrLn "No problem." - explainManualSetupGpgKey - rungpg = do - putStrLn "Running gpg --gen-key ..." - gpg <- getGpgBin - void $ boolSystem gpg [Param "--gen-key"] - ks <- listSecretKeys - case ks of - [] -> do - putStrLn "Hmm, gpg seemed to not set up a secret key." - prompt "Want to try running gpg again?" - [("Y", rungpg), ("N", nope)] - ((k, _):_) -> propellorAddKey dotpropellor k - -propellorAddKey :: FilePath -> String -> IO () -propellorAddKey dotpropellor keyid = do putStrLn "" - putStrLn $ "Telling propellor to use your gpg key by running: propellor --add-key " ++ keyid - unlessM (boolSystem propellorbin [Param "--add-key", Param keyid]) $ do - putStrLn "Oops, that didn't work! You can retry the same command later." - putStrLn "Continuing onward ..." - where - propellorbin = dotpropellor "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 - theirhead <- getCurrentGitSha1 =<< getCurrentBranchRef - when (theirhead /= headrev) $ 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, --- it only contains 1 commit. So, trying to merge with it will result --- in lots of merge conflicts, since git cannot find a common parent --- commit. --- --- Instead, the upstream/master branch is created by taking the --- upstream/master branch (which must be an old version of propellor, --- as distributed), and diffing from it to the current origin/master, --- and committing the result. This is done in a temporary clone of the --- 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 dotpropellor = do - changeWorkingDirectory dotpropellor - go =<< catchMaybeIO getoldrev - where - go Nothing = warnoutofdate dotpropellor False - go (Just oldref) = do - let tmprepo = ".git/propellordisttmp" - let cleantmprepo = void $ catchMaybeIO $ removeDirectoryRecursive tmprepo - cleantmprepo - git ["clone", "--quiet", ".", tmprepo] - - changeWorkingDirectory tmprepo - git ["fetch", distrepo, "--quiet"] - git ["reset", "--hard", oldref, "--quiet"] - git ["merge", newref, "-s", "recursive", "-Xtheirs", "--quiet", "-m", "merging upstream version"] - - fetchUpstreamBranch dotpropellor tmprepo - cleantmprepo - warnoutofdate dotpropellor True - - getoldrev = takeWhile (/= '\n') - <$> readProcess "git" ["show-ref", upstreambranch, "--hash"] - - git = run "git" - run cmd ps = unlessM (boolSystem cmd (map Param ps)) $ - error $ "Failed to run " ++ cmd ++ " " ++ show ps - -warnoutofdate :: FilePath -> Bool -> IO () -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 - then also ("To merge it, run: git merge " ++ upstreambranch) - else also ("To merge it, find the most recent commit in your repository's history that corresponds to an upstream release of propellor, and set refs/remotes/" ++ upstreambranch ++ " to it. Then run propellor again.") - also "" - -fetchUpstreamBranch :: FilePath -> FilePath -> IO () -fetchUpstreamBranch dotpropellor repo = do - changeWorkingDirectory dotpropellor - void $ boolSystem "git" - [ Param "fetch" - , File repo - , Param ("+refs/heads/master:refs/remotes/" ++ upstreambranch) - , Param "--quiet" - ] + (_, _, _, pid) <- createProcess (proc "./propellor" args) + exitWith =<< waitForProcess pid -- cgit v1.2.3 From 1c70d2e18917973723bf836fdc1f789532d96811 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 2 Apr 2016 01:49:01 -0400 Subject: avoid wrapper building propellor unnessessarily --- src/wrapper.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'src/wrapper.hs') diff --git a/src/wrapper.hs b/src/wrapper.hs index 1a90fcb0..c65d60d3 100644 --- a/src/wrapper.hs +++ b/src/wrapper.hs @@ -34,8 +34,9 @@ main = withConcurrentOutput $ go =<< getArgs buildRunConfig :: [String] -> IO () buildRunConfig args = do changeWorkingDirectory =<< dotPropellor - buildPropellor Nothing - putStrLn "" - putStrLn "" + unlessM (doesFileExist "propellor") $ do + buildPropellor Nothing + putStrLn "" + putStrLn "" (_, _, _, pid) <- createProcess (proc "./propellor" args) exitWith =<< waitForProcess pid -- cgit v1.2.3 From 828830eace62dba7d75b656142d83f8396fd2968 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 2 Apr 2016 01:51:01 -0400 Subject: typo --- src/wrapper.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/wrapper.hs') diff --git a/src/wrapper.hs b/src/wrapper.hs index c65d60d3..212f737d 100644 --- a/src/wrapper.hs +++ b/src/wrapper.hs @@ -19,6 +19,7 @@ import System.Directory import System.Environment (getArgs) import System.Exit import System.Posix.Directory +import Control.Monad.IfElse main :: IO () main = withConcurrentOutput $ go =<< getArgs -- cgit v1.2.3 From db2d46246c5772c12aa8cf64ea604b65d164a7b0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 2 Apr 2016 01:59:38 -0400 Subject: make sure that the wrapper runs propellor in the foreground --- src/wrapper.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'src/wrapper.hs') diff --git a/src/wrapper.hs b/src/wrapper.hs index 212f737d..90f14379 100644 --- a/src/wrapper.hs +++ b/src/wrapper.hs @@ -14,6 +14,7 @@ import Propellor.Message import Propellor.Bootstrap import Utility.Monad import Utility.Process +import Utility.Process.NonConcurrent import System.Directory import System.Environment (getArgs) @@ -39,5 +40,5 @@ buildRunConfig args = do buildPropellor Nothing putStrLn "" putStrLn "" - (_, _, _, pid) <- createProcess (proc "./propellor" args) - exitWith =<< waitForProcess pid + (_, _, _, pid) <- createProcessNonConcurrent (proc "./propellor" args) + exitWith =<< waitForProcessNonConcurrent pid -- cgit v1.2.3