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-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
|
|
|
|
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:22:42 +00:00
|
|
|
distrepo :: FilePath
|
|
|
|
distrepo = "/usr/src/propellor/propellor.git"
|
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 19:22:42 +00:00
|
|
|
distexists <- doesFileExist distrepo <||> doesDirectoryExist distrepo
|
|
|
|
let repo = if distexists then distrepo else netrepo
|
2014-08-19 19:06:06 +00:00
|
|
|
void $ boolSystem "git" [Param "clone", File repo, File propellordir]
|
2014-08-19 19:22:42 +00:00
|
|
|
|
|
|
|
disthead = propellordir </> "head"
|
|
|
|
|
|
|
|
checkRepo = whenM (doesFileExist disthead) $ do
|
2014-08-19 19:23:29 +00:00
|
|
|
headrev <- 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 19:22:42 +00:00
|
|
|
when (headknown == Nothing)
|
|
|
|
warnoutofdate
|
|
|
|
warnoutofdate = do
|
|
|
|
let n = hPutStrLn stderr
|
|
|
|
n ("** Your " ++ propellordir ++ " is out of date..")
|
|
|
|
n (" A newer upstream version is available in " ++ distrepo)
|
|
|
|
n (" To merge it, run eg: git pull origin master")
|
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
|
|
|
|
|