2014-04-03 04:59:26 +00:00
-- | Wrapper program for propellor distribution.
--
-- Distributions should install this program into PATH.
2014-06-09 16:34:32 +00:00
-- (Cabal builds it as dist/build/propellor/propellor).
2014-04-03 04:59:26 +00:00
--
-- 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.
--
2014-08-19 18:33:43 +00:00
-- The source is cloned from /usr/src/propellor when available,
-- or is cloned from git over the network.
2014-04-03 04:59:26 +00:00
2014-05-01 13:48:33 +00:00
module Main where
2014-08-19 21:12:57 +00:00
import Propellor.Message
2014-04-03 04:59:26 +00:00
import Utility.UserInfo
import Utility.Monad
import Utility.Process
import Utility.SafeCommand
2014-08-19 19:22:42 +00:00
import Utility.Exception
2014-04-03 04:59:26 +00:00
import Control.Monad
import Control.Monad.IfElse
2014-08-19 20:44:51 +00:00
import Control.Applicative
2014-04-03 04:59:26 +00:00
import System.Directory
import System.FilePath
import System.Environment ( getArgs )
import System.Exit
import System.Posix.Directory
2014-08-19 19:22:42 +00:00
import System.IO
2014-04-03 04:59:26 +00:00
2014-08-19 19:29:32 +00:00
distdir :: FilePath
distdir = " /usr/src/propellor "
2014-08-19 19:22:42 +00:00
distrepo :: FilePath
2014-08-19 19:29:32 +00:00
distrepo = distdir </> " propellor.git "
disthead :: FilePath
disthead = distdir </> " head "
2014-04-03 04:59:26 +00:00
2014-08-19 20:40:04 +00:00
upstreambranch :: String
upstreambranch = " upstream/master "
2014-04-03 04:59:26 +00:00
-- Using the github mirror of the main propellor repo because
-- it is accessible over https for better security.
2014-08-19 18:33:43 +00:00
netrepo :: String
netrepo = " https://github.com/joeyh/propellor.git "
2014-04-03 04:59:26 +00:00
main :: IO ()
main = 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
2014-08-19 19:22:42 +00:00
ifM ( doesDirectoryExist propellordir )
( checkRepo
, makeRepo
)
2014-04-03 04:59:26 +00:00
buildruncfg
where
makeRepo = do
putStrLn $ " Setting up your propellor repo in " ++ propellordir
putStrLn " "
2014-08-19 20:40:04 +00:00
ifM ( doesFileExist distrepo <||> doesDirectoryExist distrepo )
( do
void $ boolSystem " git " [ Param " clone " , File distrepo , File propellordir ]
fetchUpstreamBranch propellordir distrepo
, void $ boolSystem " git " [ Param " clone " , Param netrepo , File propellordir ]
)
2014-08-19 19:22:42 +00:00
checkRepo = whenM ( doesFileExist disthead ) $ do
2014-08-19 20:44:51 +00:00
headrev <- takeWhile ( /= '\ n' ) <$> readFile disthead
2014-08-19 19:22:42 +00:00
changeWorkingDirectory propellordir
headknown <- catchMaybeIO $
withQuietOutput createProcessSuccess $
2014-08-19 19:23:29 +00:00
proc " git " [ " log " , headrev ]
2014-08-19 20:40:04 +00:00
when ( headknown == Nothing ) $
setupupstreammaster headrev propellordir
2014-04-03 04:59:26 +00:00
buildruncfg = do
changeWorkingDirectory propellordir
ifM ( boolSystem " make " [ Param " build " ] )
( do
putStrLn " "
putStrLn " "
chain
, error " Propellor build failed. "
)
2014-08-19 19:22:42 +00:00
chain = do
( _ , _ , _ , pid ) <- createProcess ( proc propellorbin args )
exitWith =<< waitForProcess pid
2014-08-19 20:40:04 +00:00
-- Passed the user's propellordir 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.
--
2014-08-19 21:51:34 +00:00
-- Instead, the upstream/master branch is created by taking the
2014-08-19 20:40:04 +00:00
-- 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 propellordir = do
changeWorkingDirectory propellordir
2014-08-19 21:09:11 +00:00
go =<< catchMaybeIO getoldrev
2014-08-19 20:40:04 +00:00
where
go Nothing = warnoutofdate False
go ( Just oldref ) = do
let tmprepo = " .git/propellordisttmp "
2014-08-19 21:09:11 +00:00
let cleantmprepo = void $ catchMaybeIO $ removeDirectoryRecursive tmprepo
cleantmprepo
2014-08-19 20:40:04 +00:00
git [ " clone " , " --quiet " , " . " , tmprepo ]
changeWorkingDirectory tmprepo
git [ " fetch " , distrepo , " --quiet " ]
git [ " reset " , " --hard " , oldref , " --quiet " ]
2014-08-19 21:59:15 +00:00
git [ " merge " , newref , " -s " , " recursive " , " -Xtheirs " , " --quiet " , " -m " , " merging upstream version " ]
2014-08-19 20:40:04 +00:00
fetchUpstreamBranch propellordir tmprepo
2014-08-19 21:09:11 +00:00
cleantmprepo
2014-08-19 20:40:04 +00:00
warnoutofdate True
2014-08-19 21:09:11 +00:00
getoldrev = takeWhile ( /= '\ n' )
<$> readProcess " git " [ " show-ref " , upstreambranch , " --hash " ]
2014-08-19 20:40:04 +00:00
git = run " git "
run cmd ps = unlessM ( boolSystem cmd ( map Param ps ) ) $
error $ " Failed to run " ++ cmd ++ " " ++ show ps
warnoutofdate havebranch = do
2014-08-19 21:17:01 +00:00
warningMessage ( " ** Your " ++ propellordir ++ " is out of date.. " )
2014-08-19 21:12:57 +00:00
let also s = hPutStrLn stderr ( " " ++ s )
2014-08-19 21:17:01 +00:00
also ( " A newer upstream version is available in " ++ distrepo )
2014-08-19 20:40:04 +00:00
if havebranch
2014-08-19 21:17:01 +00:00
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. " )
2014-08-19 21:17:36 +00:00
also " "
2014-08-19 20:40:04 +00:00
fetchUpstreamBranch :: FilePath -> FilePath -> IO ()
fetchUpstreamBranch propellordir repo = do
changeWorkingDirectory propellordir
void $ boolSystem " git "
[ Param " fetch "
, File repo
, Param ( " +refs/heads/master:refs/remotes/ " ++ upstreambranch )
, Param " --quiet "
]