propellor/src/wrapper.hs

96 lines
2.6 KiB
Haskell
Raw Normal View History

-- | 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).
--
-- 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.
module Main where
import Utility.UserInfo
import Utility.Monad
import Utility.Process
import Utility.SafeCommand
import Utility.Exception
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
2014-08-19 19:29:32 +00:00
distdir :: FilePath
distdir = "/usr/src/propellor"
distrepo :: FilePath
2014-08-19 19:29:32 +00:00
distrepo = distdir </> "propellor.git"
disthead :: FilePath
disthead = distdir </> "head"
-- 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 = 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
)
buildruncfg
where
makeRepo = do
putStrLn $ "Setting up your propellor repo in " ++ propellordir
putStrLn ""
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]
checkRepo = whenM (doesFileExist disthead) $ do
2014-08-19 19:23:29 +00:00
headrev <- readFile disthead
changeWorkingDirectory propellordir
headknown <- catchMaybeIO $
withQuietOutput createProcessSuccess $
2014-08-19 19:23:29 +00:00
proc "git" ["log", headrev]
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-08-19 19:29:32 +00:00
n ""
buildruncfg = do
changeWorkingDirectory propellordir
ifM (boolSystem "make" [Param "build"])
( do
putStrLn ""
putStrLn ""
chain
, error "Propellor build failed."
)
chain = do
(_, _, _, pid) <- createProcess (proc propellorbin args)
exitWith =<< waitForProcess pid