-- |
-- 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, when)
import Data.Maybe
import Data.List (intercalate, isPrefixOf, isSuffixOf, 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, distTarget,
releaseVersion)
import Koji (kojiBuilding, kojiCheckFHBuilt, kojiLatestPkg, kojiWaitPkg,
notInKoji, pkgDir)
import RPM (packageManager, rpmInstall, repoquerySrc, rpmspec)
import Utils ((+-+), checkFedoraPkgGit, cmd, cmd_, cmdBool, cmdMaybe, cmdlog,
logMsg, removePrefix, removeSuffix, sudo)
data Command = Install | Mock | Koji | Chain | Pending | Changed | Built | Bump
deriving (Eq)
main :: IO ()
main = do
margs <- getArgs >>= parseArgs
case margs of
Nothing -> return ()
Just (com, dist, pkgs) -> do
cwd <- getCurrentDirectory
build cwd (mode com) dist Nothing Nothing False pkgs
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 = Maybe (String, Dist, [String])
parseArgs :: [String] -> IO Arguments
parseArgs (c:dist:pkgs) | dist `notElem` dists = giveUp $ "Unknown dist '" ++ dist ++ "'"
| null pkgs = giveUp "Please specify a package."
| otherwise =
return $ Just (c, dist, map (removeSuffix "/") pkgs)
parseArgs _ = help >> return Nothing
giveUp :: String -> IO Arguments
giveUp err = do
hPutStrLn stderr err
return Nothing
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 "fedpkg" $ ["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 checkFedoraPkgGit
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_ "fedpkg" ["switch-branch", branch]
cmd_ "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 "fedpkg" ["verrel"]
let verrel = removePrefix (pkg ++ "-") nvr
release = tail $ dropWhile (/= '-') verrel
tag = distTag dist
relver = releaseVersion 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
cmd_ "git" ["--no-pager", "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 relver) 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 "fedpkg" ["local"]
unless success
fhbuildFail
opkgs <- lines <$> rpmspec ["--builtrpms"] (Just "%{name}\n") spec
rpms <- lines <$> rpmspec ["--builtrpms"] (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)
setCurrentDirectory topdir
build topdir Install dist Nothing Nothing False rest
Mock -> do
putStrLn $ "Mock building" +-+ nvr
cmdlog "fedpkg" ["mockbuild"]
build topdir Mock dist Nothing Nothing False rest
Koji -> do
putStrLn "'koji' mode is deprecated, please use 'chain'"
unless (null rest) $ do
putStrLn $ show (length rest) +-+ "more packages"
putStrLn ""
latest <- kojiLatestPkg tag pkg
if 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
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 latest nvr
cmd_ "git" ["push"]
fedpkgBuild 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) $
putStrLn $ 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_ "fedpkg" ["commit", "-m", "bump release"]
build topdir Bump dist Nothing Nothing False rest
Chain -> do
fhbuilt <- kojiCheckFHBuilt topdir nvr
latest <- if fhbuilt
then return nvr
else kojiLatestPkg tag pkg
if 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
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 latest nvr
brs <- buildRequires spec
--print brs
ghcLibs <- do
ghcDir <- pkgDir "ghc" branch topdir
filter isHaskellDevelPkg . words <$> rpmspec [] (Just "%{name}\n") (ghcDir </> "ghc.spec")
-- FIXME sort into build order
let hdeps = filter (\ dp -> "ghc-" `isPrefixOf` dp || dp `elem` ["alex", "cabal-install", "gtk2hs-buildtools", "happy"]) (brs \\ (["ghc-rpm-macros", "ghc-rpm-macros-extra"] ++ ghcLibs))
--print hdeps
srcs <- filter (`notElem` ["ghc"]) . nub <$> mapM (derefSrcPkg topdir dist relver) hdeps
--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
cmd_ "git" ["push"]
putStrLn ""
fedpkgBuild 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 :: String -> String -> IO ()
showChange latest nvr = do
cmd_ "git" ["--no-pager", "log", "-1"]
putStrLn ""
putStrLn $ latest +-+ "->" +-+ nvr ++ "\n"
fedpkgBuild :: FilePath -> Dist -> String -> Maybe String -> IO ()
fedpkgBuild topdir dist nvr waittag = do
giturl <- cmd "fedpkg" ["giturl"]
success <- cmdBool "koji" ["build", "--fail-fast", distTarget dist, giturl]
unless success
fhbuildFail
logMsg $ nvr +-+ "built"
maybe (return ()) (\ t -> kojiWaitPkg topdir t nvr) waittag
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
buildRequires :: FilePath -> IO [String]
buildRequires spec =
-- FIXME should resolve "pkgconfig()" etc
(map (head . words) . lines) <$> rpmspec ["--buildrequires"] Nothing spec
-- >>= mapM (whatProvides relver)
derefSrcPkg :: FilePath -> Dist -> String -> String -> IO String
derefSrcPkg topdir dist relver pkg =
if isHaskellDevelPkg pkg
then
do let base = removeSuffix "-devel" pkg
dirExists <- doesDirectoryExist $ topdir </> base
if dirExists then return base else derefSrcPkg topdir dist relver base
else
do putStrLn $ "Repoquerying" +-+ pkg
res <- repoquerySrc dist relver pkg
putStrLn $ pkg +-+ "->" +-+ show res
case res of
Nothing ->
do putStrLn $ "Unknown package" +-+ removeSuffix "-devel" pkg
fhbuildFail
Just s -> return s
gitBranch :: IO String
gitBranch =
(removePrefix "* " . head . filter (isPrefixOf "* ") . lines) <$> cmd "git" ["branch"]
eqNVR :: String -> String -> Bool
eqNVR p1 p2 =
dropExtension p1 == 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
cmdBool "grep" ["-q", 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
fhbuildFail :: IO a
fhbuildFail = --do
--cmdlog "touch" [".fhbuild-fail"]
exitWith (ExitFailure 1)
isHaskellDevelPkg :: String -> Bool
isHaskellDevelPkg pkg = "ghc-" `isPrefixOf` pkg && ("-devel" `isSuffixOf` pkg)