diff --git a/Dists.hs b/Dists.hs --- a/Dists.hs +++ b/Dists.hs @@ -28,6 +28,8 @@ rawhide) where import Data.Char (isNumber) +import Data.Maybe (fromMaybe, maybe) + import Utils ((+-+)) type Dist = String @@ -38,6 +40,9 @@ rawhide :: String rawhide = "f28" +sidetag :: Maybe String +sidetag = Nothing -- Just "ghc" + hackageRelease :: String hackageRelease = "f27" @@ -68,13 +73,10 @@ distOverride d = d `notElem` [rawhide, "f28" {-, "epel7"-}] distTag :: Dist -> String -distTag d {- | d == rawhide = "f28" ++ "-ghc" -} - {- | d == "epel7" = d ++ "-ghc" -} - {- | otherwise -} = d ++ "-build" +distTag d = d ++ "-" ++ fromMaybe "build" sidetag -distTarget :: Dist -> Maybe String -distTarget d | d `elem` [rawhide, "epel7"] = Nothing -- Just $ d ++ "-ghc" - | otherwise = Nothing +distTarget :: Dist -> String +distTarget d = maybe d (\ suff -> d ++ "-" ++ suff) sidetag releaseVersion :: Dist -> String releaseVersion r | r == rawhide = "rawhide" diff --git a/Koji.hs b/Koji.hs --- a/Koji.hs +++ b/Koji.hs @@ -19,22 +19,32 @@ #else import Control.Applicative ((<$>)) #endif +import Control.Monad (unless) import Data.List (isInfixOf) +import System.Directory (doesDirectoryExist) import System.FilePath (()) import Dists (Dist) -import Utils (cmd, cmd_) +import Utils (cmd, cmd_, cmdBool) kojiLatestPkg :: Dist -> String -> IO String kojiLatestPkg dist pkg = do res <- words <$> cmd "koji" ["latest-pkg", "--quiet", dist, pkg] return $ if null res then "" else head res -kojiWaitPkg :: Dist -> String -> IO () -kojiWaitPkg dist pkg = --do - cmd_ "koji" ["wait-repo", dist, "--build=" ++ pkg] - --putStrLn "" +kojiWaitPkg :: FilePath -> Dist -> String -> IO () +kojiWaitPkg topdir dist nvr = do + let fhbuilt = topdir ".fhbuilt" + already <- kojiCheckFHBuilt topdir nvr + unless already $ do + cmd_ "koji" ["wait-repo", dist, "--build=" ++ nvr] + appendFile fhbuilt $ nvr ++ "\n" +kojiCheckFHBuilt :: FilePath -> String -> IO Bool +kojiCheckFHBuilt topdir nvr = do + let fhbuilt = topdir ".fhbuilt" + cmdBool "grep" ["-q", nvr, fhbuilt] + kojiBuilding :: String -> String -> IO Bool kojiBuilding pkg build = do tasks <- lines <$> cmd "koji" ["list-tasks", "--mine", "--quiet"] @@ -48,11 +58,17 @@ notInKoji :: String -> FilePath -> String -> String -> IO Bool notInKoji branch topdir tag pkg = do latest <- kojiLatestPkg tag pkg - local <- cmd "fedpkg" ["--path", topdir pkg branch, "verrel"] + pkgpath <- pkgDir pkg branch topdir + local <- cmd "fedpkg" ["--path", pkgpath, "verrel"] if latest == local - then kojiWaitPkg tag latest >> return False + then kojiWaitPkg topdir tag latest >> return False else return True kojiListPkgs :: Dist -> IO [String] kojiListPkgs dist = words <$> cmd "koji" ["list-pkgs", "--tag=" ++ dist] + +pkgDir :: String -> String -> FilePath -> IO FilePath +pkgDir dir branch top = do + b <- doesDirectoryExist $ top dir branch + return $ top dir if b then branch else "" diff --git a/RPM.hs b/RPM.hs --- a/RPM.hs +++ b/RPM.hs @@ -17,23 +17,21 @@ rpmInstall, rpmspec) where -import Control.Monad (unless, when) -import Data.List (elemIndices) +import Control.Monad (when) import Data.Maybe (isJust, isNothing) import System.Directory (findExecutable) +import System.FilePath (()) -- die is available in ghc-7.10 base-4.8 import System.Exit (exitFailure) import System.IO (hPutStrLn, stderr) -import Utils (cmd, cmdStdErr, singleLine, sudo) +import Dists (Dist, distTag) +import Utils (cmd, sudo) -- @since base 4.8.0.0 die :: String -> IO a die err = hPutStrLn stderr err >> exitFailure -warn :: String -> IO () -warn = hPutStrLn stderr - requireProgram :: String -> IO () requireProgram c = do mavail <- findExecutable c @@ -57,37 +55,30 @@ let (inst, arg) = if pkginstaller == "dnf" then ("dnf", "install") else ("yum", "localinstall") sudo inst $ ["-y", "--nogpgcheck", arg] ++ rpms -repoquery :: [String] -> String -> IO String -repoquery args key = do +repoquery :: String -> [String] -> IO String +repoquery relver args = do havednf <- optionalProgram "dnf" let (prog, subcmd) = if havednf then ("dnf", ["repoquery", "--quiet"]) else ("repoquery", []) - repoqWrap prog (subcmd ++ args ++ [key]) + cmd prog (subcmd ++ ["--releasever=" ++ relver] ++ args) -repoqWrap :: String -> [String] -> IO String -repoqWrap c args = do - (out, err) <- cmdStdErr c args - -- workaround noisy dnf2 repoquery --quiet - -- ignore "Last metadata expiration check" warnings - unless (null err || head (words err) == "Last") $ - warn err - return $ singleLine out +-- repoqWrap :: String -> [String] -> IO String +-- repoqWrap c args = do +-- (out, err) <- cmdStdErr c args +-- -- workaround noisy dnf2 repoquery --quiet +-- -- ignore "Last metadata expiration check" warnings +-- unless (null err || head (words err) == "Last") $ +-- warn err +-- return $ singleLine out -repoquerySrc :: String -> IO (Maybe String) -repoquerySrc key = do +repoquerySrc :: Dist -> String -> String -> IO (Maybe String) +repoquerySrc dist relver key = do havednf <- optionalProgram "dnf" - let (prog, subcmd) = if havednf then ("dnf", ["repoquery", "--quiet", "-s"]) else ("repoquery", ["--qf", "%{base_package_name}", "--whatprovides"]) - res <- repoqWrap prog (subcmd ++ [key]) - if null res then return Nothing - else return $ Just $ nvrToName res - -nvrToName :: String -> String -nvrToName nvr = - if length dashes < 2 - then error $ "malformed NVR string: '" ++ nvr ++ "'" - else take nameDash nvr - where - dashes = elemIndices '-' nvr - nameDash = last $ init dashes + let srcflag = if havednf then ["--qf=%{source_name}"] else ["--qf", "%{base_package_name}"] + res <- words <$> repoquery relver (srcflag ++ ["--repofrompath", "koji,http://kojipkgs.fedoraproject.org/repos" distTag dist "latest/x86_64/", "--whatprovides", key]) + return $ case res of + [p] -> Just p + ps | key `elem` ps -> Just key + _ -> Nothing rpmspec :: [String] -> Maybe String -> FilePath -> IO String rpmspec args mqf spec = do diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -24,6 +24,9 @@ - copr support - parallel/async building - cache passwd for bodhi +- do not downgrade versions +- --liberal (allow failures) +- reconnect to koji when disconnected (build or wait-repo) # updating - port update-pkg-ver diff --git a/Utils.hs b/Utils.hs --- a/Utils.hs +++ b/Utils.hs @@ -13,7 +13,24 @@ -- the Free Software Foundation, either version 3 of the License, or -- (at your option) any later version. -module Utils where +module Utils (checkFedoraPkgGit, + cmd, + cmd_, + cmdBool, + cmdlog, + cmdMaybe, + cmdN, + cmdSilent, + cmdStdErr, + error_, + logMsg, + maybeRemovePrefix, + removePrefix, + removeSuffix, + singleLine, + sudo, + withCurrentDirectory, + (+-+) ) where #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2)) #else @@ -26,9 +43,10 @@ import System.Process (readProcess, readProcessWithExitCode, rawSystem) #if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3)) +import System.Directory (withCurrentDirectory) #else import Control.Exception (bracket) -import System.Directory ( getCurrentDirectory, setCurrentDirectory) +import System.Directory (getCurrentDirectory, setCurrentDirectory) #endif infixr 4 +-+ @@ -78,14 +96,14 @@ -- dry-run cmdN :: String -> [String] -> IO () -cmdN c as = putStrLn $ c +-+ show as +cmdN c as = putStrLn $ c +-+ unwords as -cmdAssert :: String -> String -> [String] -> IO () -cmdAssert msg c as = do - ret <- rawSystem c as - case ret of - ExitSuccess -> return () - ExitFailure _ -> error msg +--cmdAssert :: String -> String -> [String] -> IO () +--cmdAssert msg c as = do +-- ret <- rawSystem c as +-- case ret of +-- ExitSuccess -> return () +-- ExitFailure _ -> error msg cmdlogStdIn :: String -> [String] -> String -> IO () cmdlogStdIn c as inp = do @@ -108,11 +126,19 @@ ExitSuccess -> return True ExitFailure _ -> return False +-- hide stdout +cmdSilent :: String -> [String] -> IO () +cmdSilent c args = do + (ret, _, err) <- readProcessWithExitCode c args "" + case ret of + ExitSuccess -> return () + ExitFailure n -> error $ "\"" ++ c +-+ unwords args ++ "\"" +-+ "failed with status" +-+ show n ++ "\n" ++ err + sudo :: String -> [String] -> IO () sudo c as = cmdlog "sudo" (c:as) -shell :: String -> IO String -shell c = cmd "sh" ["-c", c] +--shell :: String -> IO String +--shell c = cmd "sh" ["-c", c] removePrefix :: String -> String -> String removePrefix prefix orig = @@ -143,3 +169,7 @@ setCurrentDirectory dir action #endif + +checkFedoraPkgGit :: IO Bool +checkFedoraPkgGit = + cmdBool "grep" ["-q", "-e", "\\(pkgs\\|src\\).fedoraproject.org", ".git/config"] diff --git a/fedora-haskell-tools.cabal b/fedora-haskell-tools.cabal --- a/fedora-haskell-tools.cabal +++ b/fedora-haskell-tools.cabal @@ -1,5 +1,5 @@ Name: fedora-haskell-tools -Version: 0.4 +Version: 0.5 Synopsis: Building and managing tools for Fedora Haskell Description: Tools for building and managing Fedora Haskell packages. @@ -50,6 +50,7 @@ unix Other-modules: Dists, Koji, + RPM, Utils GHC-options: -fwarn-missing-signatures -Wall Extensions: CPP diff --git a/fhbuild.hs b/fhbuild.hs --- a/fhbuild.hs +++ b/fhbuild.hs @@ -20,7 +20,7 @@ #endif import Control.Monad (filterM, unless, when) import Data.Maybe -import Data.List (intercalate, isPrefixOf, nub, (\\)) +import Data.List (intercalate, isPrefixOf, isSuffixOf, nub, (\\)) import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory, setCurrentDirectory) @@ -29,13 +29,16 @@ import System.FilePath ((), dropExtension) import System.IO (hPutStrLn, stderr) -import Dists (Dist, dists, distBranch, distOverride, distTag, distTarget) -import Koji (kojiBuilding, kojiLatestPkg, kojiWaitPkg, notInKoji) -import RPM (packageManager, rpmInstall, repoquery, repoquerySrc, rpmspec) -import Utils ((+-+), cmd, cmd_, cmdBool, cmdMaybe, cmdlog, error_, logMsg, - removePrefix, removeSuffix, sudo) +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 deriving (Eq) +data Command = Install | Mock | Koji | Chain | Pending | Changed | Built | Bump + deriving (Eq) main :: IO () main = do @@ -53,10 +56,12 @@ 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"] +commands = ["install", "mock" , "koji", "chain", "pending", "changed", "built", + "bump"] help :: IO () help = do @@ -71,6 +76,7 @@ ++ " 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]) @@ -85,7 +91,7 @@ giveUp :: String -> IO Arguments giveUp err = do hPutStrLn stderr err - help >> return Nothing + return Nothing build :: FilePath -> Command -> Dist -> Maybe String -> Maybe (String, String) -> Bool -> [String] -> IO () build _ _ _ _ _ _ [] = return () @@ -100,73 +106,77 @@ cmdlog "fedpkg" $ ["clone", "-b", branch, pkg] ++ anon wd <- pkgDir pkg branch "" setCurrentDirectory wd - retired <- doesFileExist "dead.package" - if retired then do - unless (mode == Pending) $ - putStrLn "skipping dead.package" - build topdir mode dist Nothing Nothing False rest + ignore <- doesFileExist ".fhbuild-ignore" + if ignore && mode `elem` [Install, Koji, Chain, Mock] then putStrLn "ignored" else do - pkggit <- do - gd <- doesFileExist ".git/config" - if gd then cmdBool "grep" ["-q", "pkgs.fedoraproject.org", ".git/config"] - 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 + 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 - 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 + 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 - nvr <- cmd "fedpkg" ["verrel"] - let verrel = removePrefix (pkg ++ "-") nvr - release = tail $ dropWhile (/= '-') verrel - 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 - cmd_ "git" ["--no-pager", "log", "-1"] - putStrLn "" - putStrLn "Repoquerying deps..." - brs <- buildRequires spec - missing <- catMaybes <$> (nub <$> filterM notInstalled brs >>= mapM derefSrcPkg) - -- FIXME sort into build order - let hmissing = filter (\ dp -> "ghc-" `isPrefixOf` dp || dp `elem` ["alex", "cabal-install", "gtk2hs-buildtools", "happy"]) missing - unless (null hmissing) $ do - putStrLn "Missing:" - mapM_ putStrLn hmissing - build topdir Install dist Nothing Nothing False hmissing - setCurrentDirectory $ topdir wd - stillMissing <- filterM notInstalled missing - unless (null stillMissing) $ do - putStrLn $ "Installing:" +-+ intercalate ", " stillMissing - rpmInstall stillMissing - let logfile = ".build-" ++ verrel ++ ".log" - putStrLn "" - putStrLn $ "Building" +-+ nvr - putStrLn $ "To watch: tail -f" +-+ wd logfile - -- note "fedpkg --path dir local" saves .build.log in cwd - _out <- cmd "fedpkg" ["local"] - opkgs <- lines <$> rpmspec [] (Just "%{name}\n") spec - rpms <- lines <$> rpmspec [] (Just ("%{arch}/%{name}-%{version}-" ++ release ++ ".%{arch}.rpm\n")) spec - built <- and <$> mapM doesFileExist rpms - if built - then 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 @@ -177,115 +187,117 @@ -- sudo pkgmgr ("--setopt=clean_requirements_on_remove=no":"remove":"-y":instpkgs) sudo pkgmgr ("install":"-y":rpms) setCurrentDirectory topdir - else do - displayLogTail logfile - error_ $ "Build of " ++ nvr ++ " failed!" - 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) +-+ "packages left" - putStrLn "" - latest <- kojiLatestPkg tag pkg - if nvr == latest - then do - putStrLn $ nvr +-+ "already built!" - kojiWaitPkg tag nvr - print mlast - build topdir Koji dist Nothing mlast False rest - else do - building <- kojiBuilding pkg nvr - if building + 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 +-+ "is already building" - kojiWaitPkg tag nvr - build topdir Koji dist Nothing Nothing False rest + putStrLn $ nvr +-+ "already built!" + kojiWaitPkg topdir tag nvr + build topdir Koji dist Nothing mlast False rest else do - print mlast - case mlast of - Nothing -> return () - Just (pkg', nvr') -> do - dep <- dependent pkg' pkg branch topdir + 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 tag nvr' - showChange latest nvr - cmd_ "git" ["push"] - fedpkgBuild 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 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 - Chain -> do - latest <- kojiLatestPkg tag pkg - if nvr == latest - then do - putStrLn $ nvr +-+ "already built!" - unless (null rest) $ --do - --kojiWaitPkg tag nvr - build topdir Chain dist Nothing Nothing False rest - else do - building <- kojiBuilding pkg nvr - if building + 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 +-+ "is already building" + putStrLn $ nvr +-+ "already built!" unless (null rest) $ --do - --kojiWaitPkg tag nvr + --kojiWaitPkg topdir tag nvr build topdir Chain dist Nothing Nothing False rest else do - showChange latest nvr - putStrLn "Repoquerying deps..." - brs <- buildRequires spec - --print brs - -- 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", "ghc-Cabal-devel"]) - --print hdeps - srcs <- filter (`notElem` ["ghc"]) . catMaybes . nub <$> mapM derefSrcPkg 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 + 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 "" - -- note "fedpkg --path dir local" saves .build.log in cwd - cmd_ "git" ["push"] - putStrLn "" - fedpkgBuild dist nvr (if waitrepo then Just tag else Nothing) - bodhiOverride dist nvr - unless (null rest) $ do + 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 "" - putStrLn $ show (length rest) +-+ "packages left" - build topdir Chain dist Nothing (Just (pkg, nvr)) waitrepo rest - -pkgDir :: String -> String -> FilePath -> IO FilePath -pkgDir dir branch top = do - b <- doesDirectoryExist $ top dir branch - return $ top dir if b then branch else "" + 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 @@ -300,11 +312,14 @@ putStrLn "" putStrLn $ latest +-+ "->" +-+ nvr ++ "\n" -fedpkgBuild :: Dist -> String -> Maybe String -> IO () -fedpkgBuild dist nvr waittag = do - cmd_ "fedpkg" $ "build" : maybe [] (\ d -> "--target":[d]) (distTarget dist) +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 ()) (`kojiWaitPkg` nvr) waittag + maybe (return ()) (\ t -> kojiWaitPkg topdir t nvr) waittag bodhiOverride :: Dist -> String -> IO () bodhiOverride dist nvr = @@ -312,45 +327,43 @@ -- FIXME: improve Notes with recursive info cmd_ "bodhi" ["overrides", "save", "--notes", "Haskell stack", nvr] --- dereference meta BRs -whatProvides :: String -> IO String -whatProvides pkg = do - res <- repoquery ["--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 +-- -- 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 = - (map (head . words) . lines) <$> rpmspec ["--buildrequires"] Nothing spec >>= mapM whatProvides + -- FIXME should resolve "pkgconfig()" etc + (map (head . words) . lines) <$> rpmspec ["--buildrequires"] Nothing spec +-- >>= mapM (whatProvides relver) -derefSrcPkg :: String -> IO (Maybe String) -derefSrcPkg pkg = do - res <- repoquerySrc pkg - --putStrLn $ pkg +-+ "->" +-+ show res - case res of - -- maybe package has never been built yet - Nothing -> do - let base = removeSuffix "-devel" pkg - p <- pkgdb base - if isJust p - then return p - else pkgdb $ removePrefix "ghc-" base - Just s -> return $ Just s +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"] -pkgdb :: String -> IO (Maybe String) -pkgdb pkg = do - res <- fmap words <$> cmdMaybe "pkgdb-cli" ["list", "--nameonly", pkg] - return $ case res of - (Just ps) | pkg `elem` ps -> Just pkg - _ -> Nothing - eqNVR :: String -> String -> Bool eqNVR p1 p2 = dropExtension p1 == dropExtension p2 @@ -373,3 +386,11 @@ 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) diff --git a/fhpkg.hs b/fhpkg.hs --- a/fhpkg.hs +++ b/fhpkg.hs @@ -31,11 +31,7 @@ import Data.List (isInfixOf, isPrefixOf, nub, sort, (\\)) import System.Directory (doesDirectoryExist, doesFileExist, - setCurrentDirectory, -#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3)) - withCurrentDirectory -#endif - ) + getHomeDirectory, setCurrentDirectory) import System.Environment (getArgs, getProgName) import System.Exit (ExitCode (..), exitWith) import System.FilePath (()) @@ -44,14 +40,9 @@ import Dists (Dist, dists, distBranch, hackageRelease, releaseVersion) import Koji (kojiListPkgs) -import RPM (rpmspec) -import Utils ((+-+), cmd, cmd_, cmdBool, cmdMaybe, maybeRemovePrefix, - removePrefix, -#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3)) -#else - withCurrentDirectory -#endif - ) +import RPM (repoquery, rpmspec) +import Utils ((+-+), checkFedoraPkgGit, cmd, cmd_, cmdBool, cmdMaybe, cmdSilent, + maybeRemovePrefix, removePrefix, withCurrentDirectory) main :: IO () main = do @@ -73,14 +64,27 @@ withPackages mdist new $ repoAction_ True False mdist (return ()) "pull" -> withPackages mdist pkgs $ repoAction_ True False mdist (cmd_ "git" ["pull", "--rebase"]) + "push" -> withPackages mdist pkgs $ + repoAction_ True False mdist (cmd_ "git" ["push"]) "diff" -> withPackages mdist pkgs $ - repoAction_ True False mdist (cmd_ "git" ["--no-pager", "diff"]) + repoAction_ False False mdist (cmd_ "git" ["--no-pager", "diff"]) + "diff-origin" -> withPackages mdist pkgs $ + repoAction_ True False mdist (cmd_ "git" ["--no-pager", "diff", "origin"]) "diff-branch" -> withPackages mdist pkgs $ repoAction False True mdist compareRawhide "diff-stackage" -> withPackages mdist pkgs $ repoAction True True mdist compareStackage "verrel" -> withPackages mdist pkgs $ repoAction_ False True mdist (cmd_ "fedpkg" ["verrel"]) + "update" -> withPackages mdist pkgs $ + repoAction True True mdist updatePackage + "refresh" -> withPackages mdist pkgs $ + repoAction_ True True mdist (cmd_ "cabal-rpm" ["refresh"]) + "prep" -> withPackages mdist pkgs $ + repoAction_ True True mdist (cmd_ "fedpkg" ["prep"]) + "commit" -> withPackages mdist pkgs $ + -- need to handle passing commit message + repoAction_ True True mdist (commitChanges "") "subpkgs" -> withPackages mdist pkgs $ repoAction True True mdist (\ p -> rpmspec [] (Just "%{name}-%{version}") (p ++ ".spec") >>= putStrLn) "new" -> newPackages mdist >>= mapM_ putStrLn @@ -95,12 +99,18 @@ ("clone-new", "clone new packages"), ("count", "count number of packages"), ("diff", "git diff"), + ("diff-origin", "git diff origin"), ("diff-branch","compare branch with master"), ("diff-stackage","compare with stackage"), ("hackage", "generate Hackage distro data"), ("list", "list packages"), ("new", "new unbuilt packages"), - ("pull", "pull repos"), + ("prep", "fedpkg prep"), + ("commit", "fedpkg commit"), + ("pull", "git pull repos"), + ("push", "git push repos"), + ("update", "cabal-rpm update"), + ("refresh", "cabal-rpm refresh"), ("subpkgs", "list subpackages"), ("verrel", "show nvr of packages")] @@ -152,7 +162,7 @@ repoqueryHackageCSV mdist pkgs = do let relver = maybe "rawhide" releaseVersion mdist -- Hackage csv chokes on final newline so remove it - init . unlines . sort . map (replace "\"ghc-" "\"") . lines <$> cmd "dnf" (["repoquery", "--quiet", "--releasever=" ++ relver, "--latest-limit=1", "-q", "--qf=\"%{name}\",\"%{version}\",\"https://src.fedoraproject.org/rpms/%{name}\""] ++ pkgs) >>= putStr + init . unlines . sort . map (replace "\"ghc-" "\"") . lines <$> repoquery relver (["--disablerepo=*", "--enablerepo=fedora", "--enablerepo=updates", "--latest-limit=1", "--qf=\"%{name}\",\"%{version}\",\"https://src.fedoraproject.org/rpms/%{name}\""] ++ pkgs) >>= putStr replace :: Eq a => [a] -> [a] -> [a] -> [a] replace a b s@(x:xs) = @@ -164,11 +174,9 @@ repoqueryHaskell :: Bool -> Maybe Dist -> IO [Package] repoqueryHaskell verbose mdist = do -- fixme: should use repoquery instead: - base <- cmd "ghc-pkg" ["--simple-output", "list", "base"] - ghcver <- cmd "ghc" ["--numeric-version"] let relver = maybe "rawhide" releaseVersion mdist when verbose $ putStrLn "Getting packages from repoquery" - bin <- words <$> cmd "dnf" ["repoquery", "--quiet", "--releasever=" ++ relver, "--whatrequires", "libHS" ++ base ++ "-ghc" ++ ghcver ++ ".so()(64bit)", "--qf=%{source_name}"] + bin <- words <$> repoquery relver ["--qf=%{source_name}", "--whatrequires", "libHSbase-*-ghc*.so()(64bit)"] when (null bin) $ error "No libHSbase consumers found!" return $ sort $ nub bin @@ -188,9 +196,11 @@ putStrLn $ "\n==" +-+ pkg ++ (if branchGiven then ":" ++ branch else "") +-+ "==" -- muser <- getEnv "USER" -- let anon = "-a" + home <- getHomeDirectory + haveSSH <- doesFileExist $ home ".ssh/id_rsa" dirExists <- doesDirectoryExist pkg unless dirExists $ - cmd_ "fedpkg" $ ["clone"] ++ (if branchGiven then ["-b", branch] else ["-B"]) ++ [pkg] + cmd_ "fedpkg" $ ["clone"] ++ ["-a" | not haveSSH] ++ (if branchGiven then ["-b", branch] else ["-B"]) ++ [pkg] singleDir <- doesFileExist $ pkg ".git/config" unless singleDir $ do branchDir <- doesDirectoryExist $ pkg branch @@ -202,7 +212,7 @@ pkggit <- do gd <- doesFileExist ".git/config" if gd - then cmdBool "grep" ["-q", "pkgs.fedoraproject.org", ".git/config"] + then checkFedoraPkgGit else return False unless pkggit $ error $ "not a Fedora pkg git dir!:" +-+ wd @@ -243,12 +253,31 @@ compareRawhide :: Package -> IO () compareRawhide p = do - nvr <- rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") (p ++ ".spec") - nvr' <- withCurrentDirectory "../master" $ - rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") (p ++ ".spec") - when (removeDisttag nvr /= removeDisttag nvr') $ do + let spec = p ++ ".spec" + nvr <- removeDisttag <$> rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") spec + nvr' <- withCurrentDirectory "../master" $ do + haveSpec <- doesFileExist spec + unless haveSpec $ cmdSilent "git" ["pull"] + removeDisttag <$> rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") spec + if nvr == nvr' + then putStrLn nvr + else do putStrLn nvr putStrLn nvr' - putStrLn "" + putStrLn "" where removeDisttag = reverse . tail . dropWhile (/= '.') . reverse + +updatePackage :: Package -> IO () +updatePackage pkg = do + hckg <- cmdBool "grep" ["-q", "hackage.haskell.org/package/", pkg ++ ".spec"] + if hckg + then cmd_ "cabal-rpm" ["update"] + else putStrLn "skipping since not hackage" + +commitChanges :: String -> IO () +commitChanges msg = do + chgs <- cmd "git" ["diff"] + if null chgs + then putStrLn "no changes" + else cmd_ "fedpkg" ["commit", "-m", msg]