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
2014-08-19 23:03:05 +00:00
changeWorkingDirectory propellordir
void $ boolSystem " git " [ Param " remote " , Param " rm " , Param " origin " ]
2014-08-19 20:40:04 +00:00
, 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 23:22:54 +00:00
if ( headknown == Nothing )
then setupupstreammaster headrev propellordir
else do
merged <- not . null <$>
readProcess " git " [ " log " , headrev ++ " ..HEAD " , " --ancestry-path " ]
unless merged $
warnoutofdate propellordir True
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
2014-08-19 23:22:54 +00:00
go Nothing = warnoutofdate propellordir False
2014-08-19 20:40:04 +00:00
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 23:22:54 +00:00
warnoutofdate propellordir 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
2014-08-19 23:22:54 +00:00
warnoutofdate :: FilePath -> Bool -> IO ()
warnoutofdate propellordir havebranch = do
warningMessage ( " ** Your " ++ propellordir ++ " 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 " "
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 "
]