-- |
-- Module : Build
-- Copyright : (C) 2014-2017 Jens Petersen
--
-- Maintainer : Jens Petersen <petersen@fedoraproject.org>
-- Stability : alpha
--
-- Explanation: Main entry point for building RPM packages.
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
module Main where
#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2))
#else
import Control.Applicative ((<$>))
#endif
import Control.Monad (filterM, unless, void, when)
import Data.Maybe
import Data.List (intercalate, isPrefixOf, nub)
import System.Directory (doesDirectoryExist, doesFileExist,
getCurrentDirectory, setCurrentDirectory)
import System.Environment (getArgs, getProgName)
import System.Exit (ExitCode (..), exitWith)
import System.FilePath ((</>), dropExtension)
import System.IO (hPutStrLn, stderr)
import Dists (Dist, dists, distBranch, distOverride, distTag, rpmDistTag)
import Koji (kojiBuilding, kojiCheckFHBuilt, kojiLatestPkg, kojiWaitPkg,
notInKoji, rpkg, rpkgBuild)
import RPM (buildRequires, derefSrcPkg, haskellSrcPkgs, Package,
packageManager, pkgDir, rpmInstall, rpmspec)
import Utils ((+-+), checkPkgsGit, cmd, cmd_, cmdBool, cmdMaybe, cmdlog,
git_, gitBranch, grep, removePrefix, removeSuffix, sudo)
data Command = Install | Mock | Koji | Chain | Pending | Changed | Built | Bump
deriving (Eq)
main :: IO ()
main = do
args <- getArgs
case args of
(c:d:ps) -> do
(com, dist, pkgs) <- parseArgs c d ps
cwd <- getCurrentDirectory
build cwd (mode com) dist Nothing Nothing False pkgs
_ -> help
where
mode "install" = Install
mode "mock" = Mock
mode "koji" = Koji
mode "chain" = Chain
mode "pending" = Pending
mode "changed" = Changed
mode "built" = Built
mode "bump" = Bump
mode _ = error "Unknown command"
commands :: [String]
commands = ["install", "mock" , "koji", "chain", "pending", "changed", "built",
"bump"]
help :: IO ()
help = do
progName <- getProgName
hPutStrLn stderr $ "Usage:" +-+ progName +-+ "CMD DIST PKG...\n"
++ "\n"
++ "Commands:\n"
++ " install\t- build locally and install\n"
++ " mock\t\t- build in mock\n"
++ " koji\t\t- build in Koji\n"
++ " chain\t\t- build deps recursively in Koji\n"
++ " pending\t- show planned changes\n"
++ " changed\t- show changed pkgs\n"
++ " built\t\t- show pkgs whose NVR already built\n"
++ " bump\t\t- bump release for NVRs already built\n"
exitWith (ExitFailure 1)
type Arguments = (String, Dist, [String])
parseArgs :: String -> String -> [String] -> IO Arguments
parseArgs c dist pkgs | dist `notElem` dists && not ("rhel-" `isPrefixOf` dist) = error $ "Unknown dist '" ++ dist ++ "'"
| null pkgs = error "Please specify a package."
| otherwise =
return (c, dist, map (removeSuffix "/") pkgs)
build :: FilePath -> Command -> Dist -> Maybe String -> Maybe (String, String) -> Bool -> [String] -> IO ()
build _ _ _ _ _ _ [] = return ()
build topdir mode dist msubpkg mlast waitrepo (pkg:rest) = do
setCurrentDirectory topdir
let branch = distBranch dist
unless (mode `elem` [Pending, Changed, Built]) $
putStrLn $ "\n==" +-+ pkg ++ ":" ++ branch +-+ "=="
dirExists <- doesDirectoryExist pkg
unless dirExists $ do
let anon = ["-a" | mode `notElem` [Koji, Chain]]
cmdlog (rpkg (Just dist)) $ ["clone", "-b", branch, pkg] ++ anon
wd <- pkgDir pkg branch ""
setCurrentDirectory wd
ignore <- doesFileExist ".fhbuild-ignore"
if ignore && mode `elem` [Install, Koji, Chain, Mock] then putStrLn "ignored"
else do
failing <- doesFileExist ".fhbuild-fail"
when (failing && mode /= Pending) $ do
putStrLn "skipped: found '.fhbuild-fail' file"
exitWith (ExitFailure 1)
retired <- doesFileExist "dead.package"
if retired then do
unless (mode == Pending) $
putStrLn "skipping dead.package"
build topdir mode dist Nothing Nothing False rest
else do
pkggit <- do
gd <- doesFileExist ".git/config"
if gd then checkPkgsGit
else return False
if not pkggit
then if mode `elem` [Install, Koji, Chain]
then error $ "not a Fedora pkg git dir!:" +-+ wd
else build topdir mode dist Nothing Nothing False rest
else do
when dirExists $ do
actual <- gitBranch
when (branch /= actual) $
cmd_ (rpkg (Just dist)) ["switch-branch", branch]
git_ "pull" ["-q"]
-- noupdate <- doesFileExist ".noupdate"
-- unless noupdate $
-- void $ cmdBool "cabal-rpm" ["update"]
let spec = pkg ++ ".spec"
hasSpec <- doesFileExist spec
if not hasSpec
then putStrLn $ "No" +-+ spec
else do
nvr <- cmd (rpkg (Just dist)) ["verrel"]
let verrel = removePrefix (pkg ++ "-") nvr
tag = distTag dist
case mode of
Install -> do
let req = fromMaybe pkg msubpkg
installed <- cmdMaybe "rpm" ["-q", "--qf", "%{name}-%{version}-%{release}", req]
if Just (req ++ "-" ++ verrel) == installed
then putStrLn $ nvr +-+ "already installed!\n"
else do
putStrLn $ fromMaybe "Not installed" installed +-+ "->" +-+ nvr
git_ "log" ["-1"]
putStrLn ""
missing <- nub <$> (buildRequires spec >>= filterM notInstalled)
-- FIXME sort into build order
let hmissing = filter (\ dp -> "ghc-" `isPrefixOf` dp || dp `elem` ["alex", "cabal-install", "gtk2hs-buildtools", "happy"]) missing
srcs <- nub <$> mapM (derefSrcPkg topdir dist True) hmissing
unless (null srcs) $ do
putStrLn "Missing:"
mapM_ putStrLn srcs
build topdir Install dist Nothing Nothing False srcs
setCurrentDirectory $ topdir </> wd
stillMissing <- filterM notInstalled missing
unless (null stillMissing) $ do
putStrLn $ "Installing:" +-+ intercalate ", " stillMissing
rpmInstall stillMissing
putStrLn ""
putStrLn $ "Building" +-+ nvr
-- note "fedpkg --path dir local" saves .build.log in cwd
success <- cmdBool (rpkg (Just dist)) ["local"]
if not success
then do
waitForEnter
build topdir Install dist Nothing Nothing False [pkg]
else do
opkgs <- lines <$> rpmspec ["--builtrpms"] (Just "%{name}\n") spec
rpms <- lines <$> rpmspec ["--builtrpms", "--define=dist" +-+ rpmDistTag dist] (Just "%{arch}/%{name}-%{version}-%{release}.%{arch}.rpm\n") spec
putStrLn $ nvr +-+ "built\n"
instpkgs <- lines <$> cmd "rpm" ("-qa":opkgs)
if null instpkgs
-- maybe filter out pandoc-pdf if not installed
then rpmInstall rpms
else do
pkgmgr <- packageManager
sudo pkgmgr ("--setopt=clean_requirements_on_remove=no":"remove":"-y":instpkgs)
sudo pkgmgr ("install":"-y":rpms)
putStrLn ""
putStrLn $ show (length rest) +-+ "packages left"
build topdir Install dist Nothing Nothing False rest
Mock -> do
putStrLn $ "Mock building" +-+ nvr
cmdlog (rpkg (Just dist)) ["mockbuild"]
build topdir Mock dist Nothing Nothing False rest
Koji -> do
unless (null rest) $ do
putStrLn $ show (length rest) +-+ "more packages"
putStrLn ""
latest <- kojiLatestPkg tag pkg
if Just nvr == latest
then do
putStrLn $ nvr +-+ "already built!"
kojiWaitPkg topdir tag nvr
build topdir Koji dist Nothing mlast False rest
else do
building <- kojiBuilding pkg nvr dist
if building
then do
putStrLn $ nvr +-+ "is already building"
kojiWaitPkg topdir tag nvr
build topdir Koji dist Nothing Nothing False rest
else do
case mlast of
Nothing -> return ()
Just (pkg', nvr') -> do
dep <- dependent pkg' pkg branch topdir
when dep $ do
putStrLn $ "Waiting for" +-+ nvr'
kojiWaitPkg topdir tag nvr'
showChange pkg latest nvr
putStrLn ""
git_ "push" []
rpkgBuild topdir dist nvr (if waitrepo then Just tag else Nothing)
bodhiOverride dist nvr
unless (null rest) $ do
dep <- dependent pkg (head rest) branch topdir
when dep $ do
putStrLn $ "Waiting for" +-+ nvr
kojiWaitPkg topdir tag nvr
build topdir Koji dist Nothing (if dep then Just (pkg, nvr) else Nothing) False rest
Pending -> do
latest <- kojiLatestPkg tag pkg
unless (eqNVR nvr latest) $
showNVRChange pkg latest nvr
build topdir Pending dist Nothing Nothing False rest
Changed -> do
latest <- kojiLatestPkg tag pkg
unless (eqNVR nvr latest) $
putStrLn pkg
build topdir Changed dist Nothing Nothing False rest
Built -> do
latest <- kojiLatestPkg tag pkg
when (eqNVR nvr latest) $
putStrLn pkg
build topdir Built dist Nothing Nothing False rest
Bump -> do
latest <- kojiLatestPkg tag pkg
when (eqNVR nvr latest) $ do
putStrLn pkg
cmd_ "rpmdev-bumpspec" ["-c", "rebuild", spec]
cmd_ (rpkg (Just dist)) ["commit", "-m", "bump release"]
build topdir Bump dist Nothing Nothing False rest
Chain -> do
fhbuilt <- kojiCheckFHBuilt topdir nvr
latest <- if fhbuilt
then return $ Just nvr
else kojiLatestPkg tag pkg
if Just nvr == latest
then do
putStrLn $ nvr +-+ "already built!"
unless (null rest) $ --do
--kojiWaitPkg topdir tag nvr
build topdir Chain dist Nothing Nothing False rest
else do
building <- kojiBuilding pkg nvr dist
if building
then do
putStrLn $ nvr +-+ "is already building"
kojiWaitPkg topdir tag nvr
unless (null rest) $
build topdir Chain dist Nothing Nothing False rest
else do
showChange pkg latest nvr
putStrLn ""
srcs <- buildRequires spec >>= haskellSrcPkgs topdir dist
--print srcs
hmissing <- nub <$> filterM (notInKoji branch topdir tag) srcs
putStrLn ""
unless (null hmissing) $ do
putStrLn "Missing:"
mapM_ putStrLn hmissing
build topdir Chain dist Nothing Nothing True hmissing
setCurrentDirectory $ topdir </> wd
putStrLn ""
-- note "fedpkg --path dir local" saves .build.log in cwd
git_ "push" []
putStrLn ""
rpkgBuild topdir dist nvr (if waitrepo then Just tag else Nothing)
bodhiOverride dist nvr
unless (null rest) $ do
putStrLn ""
putStrLn $ show (length rest) +-+ "packages left"
build topdir Chain dist Nothing (Just (pkg, nvr)) waitrepo rest
maybePkgVer :: String -> Maybe String -> String
maybePkgVer pkg mver = pkg ++ maybe "" ("-" ++) mver
notInstalled :: String -> IO Bool
notInstalled pkg =
not <$> cmdBool "rpm" ["--quiet", "-q", pkg]
showChange :: Package -> Maybe String -> String -> IO ()
showChange pkg mlatest nvr = do
git_ "log" ["-1"]
putStrLn ""
showNVRChange pkg mlatest nvr
showNVRChange :: Package -> Maybe String -> String -> IO ()
showNVRChange pkg Nothing nvr =
putStrLn $ pkg +-+ "new" +-+ removePrefix (pkg ++ "-") nvr
showNVRChange pkg (Just latest) nvr = do
putStrLn $ pkg ++ ":" +-+ removePrefix prefix latest
putStrLn $ replicate (length pkg - 1) ' ' ++ "->" +-+ removePrefix prefix nvr
where
prefix = pkg ++ "-"
bodhiOverride :: Dist -> String -> IO ()
bodhiOverride dist nvr =
when (distOverride dist) $
-- FIXME: improve Notes with recursive info
cmd_ "bodhi" ["overrides", "save", "--notes", "Haskell stack", nvr]
-- -- dereference meta BRs
-- whatProvides :: String -> String -> IO String
-- whatProvides relver pkg = do
-- res <- repoquery relver ["--qf", "%{name}", "--whatprovides", pkg]
-- --print res
-- when (null res) $ do
-- installed <- not <$> notInstalled pkg
-- unless installed $ putStrLn $ "Warning:" +-+ pkg +-+ "not found by repoquery"
-- return $ if null res then pkg else res
eqNVR :: String -> Maybe String -> Bool
eqNVR p1 p2 =
Just (dropExtension p1) == fmap dropExtension p2
-- "pkg = X.Y" -> ["pkg", "=", "X.Y"] -> ("pkg", Just "X.Y")
processDeps :: [String] -> (String, Maybe String)
processDeps [p, "=", v] = (p, Just v)
processDeps (p:_) = (p, Nothing)
processDeps [] = error "processDeps: empty string!"
dependent :: String -> String -> String -> FilePath -> IO Bool
dependent dep pkg branch topdir = do
pkgpath <- pkgDir pkg branch topdir
grep dep $ pkgpath </> pkg ++ ".spec"
displayLogTail :: FilePath -> IO ()
displayLogTail f = do
ls <- lines <$> readFile f
let foot = 3
disp = 12
start = length ls - (disp + foot)
mapM_ putStrLn $ take disp $ drop start ls
waitForEnter :: IO ()
waitForEnter = do
putStrLn ""
putChar '\a'
putStrLn "Press Enter after fixing"
void getLine