fbrnch 0.7.1 → 0.7.2
raw patch · 21 files changed
+296/−123 lines, 21 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +12/−0
- README.md +26/−5
- fbrnch.cabal +5/−4
- src/Bodhi.hs +4/−2
- src/Branches.hs +18/−9
- src/Bugzilla.hs +9/−0
- src/Cmd/Build.hs +9/−6
- src/Cmd/Copr.hs +1/−1
- src/Cmd/Import.hs +2/−0
- src/Cmd/Install.hs +83/−0
- src/Cmd/Local.hs +9/−42
- src/Cmd/Override.hs +8/−5
- src/Cmd/PkgReview.hs +22/−1
- src/Cmd/RequestBranch.hs +23/−18
- src/Cmd/RequestRepo.hs +10/−5
- src/Cmd/Status.hs +1/−1
- src/Cmd/Update.hs +4/−1
- src/InterleaveOutput.hs +14/−5
- src/ListReviews.hs +1/−1
- src/Main.hs +10/−7
- src/Package.hs +25/−10
CHANGELOG.md view
@@ -1,5 +1,17 @@ # Changelog +## 0.7.2 (2021-02-27)+- 'install': --recurse to install missing neighboring deps+- 'request-repo': offer to request branches too+- 'override': --dryrun+- Bodhi overrides: error if failed; use 4 days+- 'build': no longer override the last of built packages+- 'review-package': new experimental command+- 'local','install': print package name when build fails+- 'copr': abort on failure+- 'sort': only switch branch for dist-git+- bunch of other tweaks and smaller fixes+ ## 0.7.1 (2021-02-09) - fix package review urls and also run rpmlint on .spec - 'master-rename' improvements
README.md view
@@ -1,7 +1,7 @@ # fbrnch - "Fed Brunch" [](LICENSE)-[](https://github.com/juhp/fbrnch/actions)+[](https://github.com/juhp/fbrnch/actions) [](https://hackage.haskell.org/package/fbrnch) A tool to help Fedora Packagers build package branches and add new packages.@@ -17,7 +17,7 @@ like: - merging and building a package across release branches-- automatic parallel builds of sets of packages in dependency order+- automated parallel builds of sets of packages in dependency order - creating, updating and listing package reviews - requesting new repos and branches - importing new packages@@ -169,7 +169,7 @@ ``` ### Parallel building-fbrnch can automatically sort packages and build them in parallel+fbrnch can sort packages automatically and build them in parallel in Koji in dependency layers (using low-priority background builds to avoid grabbing too many Koji resources). @@ -195,15 +195,36 @@ (specifically koji, bodhi-client, fedpkg), but all queries are done directly by Web RPC for speed and control. -## Motivation and history+## Motivation, history, talks This project started off (as "fedbrnch") basically as a simple tool to build a package across branches (ie for current releases). Then bugzilla and Bodhi integration was added, and gradually more features, including some generic commands across packages which had already been done before in fedora-haskell-tools. +I have given a couple of short talks about fbranch:+- Nest with Fedora: [youtube](https://www.youtube.com/watch?v=40kTBsA674U) and [slides](https://github.com/juhp/presentations/blob/master/fedora-nest-2020-fbrnch/fbrnch-nest.md)+- Lightning talk at devconf.cz 2021: [youtube](https://www.youtube.com/watch?v=O2-6rDuPMRA&t=2s)++## Required runtime tools+fbrnch currently uses these fedora cli tools:+- fedpkg+- bodhi+- koji+- copr-cli+for pushing packages.++It also makes use of:+- curl+- rpmbuild & rpmspec+- klist+- git+- ssh & scp (for uploading package reviews)+ ## Installation-On Fedora the easiest way to install is using my [copr repo](https://copr.fedorainfracloud.org/coprs/petersen/fbrnch/).+fbrnch is packaged in Fedora: `sudo dnf install fbrnch`.++There is also a [copr repo](https://copr.fedorainfracloud.org/coprs/petersen/fbrnch/). ## Build from source 1. Install openssl-devel
fbrnch.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: fbrnch-version: 0.7.1+version: 0.7.2 synopsis: Build and create Fedora package repos and branches description: fbrnch is a convenient packaging tool for Fedora Packagers,@@ -10,7 +10,7 @@ . - merging and building a package across release branches .- - automatic parallel builds of sets of packages in dependency order+ - automated parallel builds of sets of packages in dependency order . - creating, updating and listing one's package reviews .@@ -28,7 +28,7 @@ author: Jens Petersen maintainer: petersen@fedoraproject.org copyright: 2019-2021 Jens Petersen-category: Utility+category: Distribution build-type: Simple extra-doc-files: CHANGELOG.md README.md@@ -39,7 +39,7 @@ libs/pagure-hs/LICENSE libs/pdc-hs/LICENSE tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4,- GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.3+ GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.4 source-repository head type: git@@ -59,6 +59,7 @@ Cmd.Copr Cmd.Diff Cmd.Import+ Cmd.Install Cmd.ListBranches Cmd.ListPackages Cmd.Local
src/Bodhi.hs view
@@ -35,10 +35,11 @@ either errMsg id $ parseEither (.: k) obj -- FIXME should determine 3 days for branched devel release+-- FIXME handle expired override? bodhiCreateOverride :: String -> IO () bodhiCreateOverride nvr = do putStrLn $ "Creating Bodhi Override for " ++ nvr ++ ":"- ok <- cmdBool "bodhi" ["overrides", "save", "--notes", "chain building with fbrnch", "--duration", "7", nvr]+ ok <- cmdBool "bodhi" ["overrides", "save", "--notes", "chain building with fbrnch", "--duration", "4", nvr] if ok then putStrLn $ "https://bodhi.fedoraproject.org/overrides/" ++ nvr else do@@ -48,7 +49,8 @@ putStrLn "bodhi override failed" prompt_ "Press Enter to retry" bodhiCreateOverride nvr- Just obj -> print obj+ -- FIXME prettyprint+ Just obj -> error' $ show obj data UpdateType = SecurityUpdate | BugfixUpdate | EnhancementUpdate | NewPackageUpdate
src/Branches.hs view
@@ -1,7 +1,7 @@ module Branches ( activeBranches, fedoraBranches,- fedoraBranchesNoMaster,+ fedoraBranchesNoRawhide, isFedoraBranch, isEPELBranch, localBranches,@@ -16,7 +16,9 @@ listOfBranches, gitCurrentBranch, systemBranch,- getReleaseBranch+ getReleaseBranch,+ branchVersion,+ anyBranchToRelease ) where import Common@@ -54,8 +56,8 @@ active <- getFedoraBranches activeBranches active <$> mthd -fedoraBranchesNoMaster :: IO [String] -> IO [Branch]-fedoraBranchesNoMaster mthd = do+fedoraBranchesNoRawhide :: IO [String] -> IO [Branch]+fedoraBranchesNoRawhide mthd = do active <- getFedoraBranched activeBranches active <$> mthd @@ -152,12 +154,19 @@ return $ map RelBranch (branches \\ brs) getReleaseBranch :: IO Branch-getReleaseBranch = do- mcurrent <- gitCurrentBranch- case mcurrent of- RelBranch br -> return br- _ -> systemBranch+getReleaseBranch =+ gitCurrentBranch >>= anyBranchToRelease gitCurrentBranch :: IO AnyBranch gitCurrentBranch = anyBranch <$> git "rev-parse" ["--abbrev-ref", "HEAD"]++anyBranchToRelease :: AnyBranch -> IO Branch+anyBranchToRelease (RelBranch rbr) = return rbr+anyBranchToRelease (OtherBranch _) = systemBranch++-- move to fedora-dists+branchVersion :: Branch -> String+branchVersion Rawhide = "rawhide"+branchVersion (Fedora n) = show n+branchVersion (EPEL n) = show n
src/Bugzilla.hs view
@@ -24,8 +24,10 @@ not', packageReview, assigneeIs,+ bugIdIs, reporterIs, reviewApproved,+ statusNewAssigned, statusNewPost, statusNewModified, statusOpen,@@ -231,6 +233,9 @@ data BzTokenStatus = ValidToken BugzillaSession | InvalidToken T.Text | NoToken +bugIdIs :: BugId -> SearchExpression+bugIdIs bid = BugIdField .==. bid+ reporterIs :: T.Text -> SearchExpression reporterIs = (ReporterField .==.) @@ -244,6 +249,10 @@ statusOpen :: SearchExpression statusOpen = StatusField ./=. "CLOSED"++statusNewAssigned :: SearchExpression+statusNewAssigned =+ StatusField `equalsAny` ["NEW", "ASSIGNED"] statusNewPost :: SearchExpression statusNewPost =
src/Cmd/Build.hs view
@@ -37,20 +37,23 @@ -- FIXME support --wait-build=NVR -- FIXME provide direct link to failed task/build.log -- FIXME default behaviour for build in pkg dir: all branches or current?+-- FIXME --auto-override for deps in testing buildCmd :: BuildOpts -> Maybe BranchOpts -> [String] -> IO () buildCmd opts mbrnchopts args = do let singleBrnch = if isJust (buildoptTarget opts) then ZeroOrOne else AnyNumber (brs,pkgs) <- splitBranchesPkgs True mbrnchopts True args- let morethan1 = length pkgs > 1- withPackageByBranches' (Just False) cleanGitFetchActive mbrnchopts singleBrnch (buildBranch morethan1 opts) (brs,pkgs)+ let mlastOfPkgs = if length pkgs > 1+ then Just (Package (last pkgs))+ else Nothing+ withPackageByBranches' (Just False) cleanGitFetchActive mbrnchopts singleBrnch (buildBranch mlastOfPkgs opts) (brs,pkgs) -- FIXME what if untracked files-buildBranch :: Bool -> BuildOpts -> Package -> AnyBranch -> IO ()+buildBranch :: Maybe Package -> BuildOpts -> Package -> AnyBranch -> IO () buildBranch _ _ _ (OtherBranch _) = error' "build only defined for release branches"-buildBranch morethan1 opts pkg rbr@(RelBranch br) = do+buildBranch mlastpkg opts pkg rbr@(RelBranch br) = do putPkgAnyBrnchHdr pkg rbr gitSwitchBranch rbr gitMergeOrigin rbr@@ -106,7 +109,7 @@ unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $ when (buildoptOverride opts) $ bodhiCreateOverride nvr- when morethan1 $ do+ when (isJust mlastpkg && mlastpkg /= Just pkg) $ do autoupdate <- checkAutoBodhiUpdate br when (buildoptOverride opts || autoupdate) $ kojiWaitRepo target nvr@@ -165,7 +168,7 @@ -- FIXME prompt for override note when (buildoptOverride opts) $ bodhiCreateOverride nvr- when morethan1 $+ when (isJust mlastpkg && mlastpkg /= Just pkg) $ when (buildoptOverride opts || autoupdate) $ kojiWaitRepo target nvr where
src/Cmd/Copr.hs view
@@ -144,7 +144,7 @@ let bid = last $ words $ last $ lines output ok <- cmdBool "copr" ["watch-build", bid] unless ok $- cmdN "Failed: copr" buildargs+ error' $ "Failed: copr " ++ unwords buildargs #if !MIN_VERSION_simple_cmd(0,1,4) error' :: String -> a
src/Cmd/Import.hs view
@@ -70,8 +70,10 @@ nvr <- pkgNameVerRel' Rawhide (pkg <.> "spec") prompt_ $ "Press Enter to push and build " ++ nvr gitPushSilent Nothing+ -- FIXME build more branches kojiBuildBranch "rawhide" (Package pkg) Nothing ["--fail-fast"] putBugBuild session bid nvr+ -- FIXME skip if branches already made brs <- branchingPrompt requestPkgBranches False Nothing brs (Package pkg) when (pkg /= takeFileName dir) $
+ src/Cmd/Install.hs view
@@ -0,0 +1,83 @@+module Cmd.Install (+ installCmd,+ ) where++import Branches+import Common+import Common.System+import Package++-- FIXME package countdown+-- FIXME --ignore-uninstalled subpackages+-- FIXME --check any/all of package installed+installCmd :: Bool -> Maybe ForceShort -> [BCond] -> Bool -> [String] -> IO ()+installCmd recurse mforceshort bconds reinstall = do+ when (recurse && isJust mforceshort) $+ error' "cannot use --recurse and --shortcircuit"+ withPackageByBranches Nothing Nothing Nothing True ZeroOrOne installPkg+ where+ installPkg :: Package -> AnyBranch -> IO ()+ installPkg pkg br = do+ spec <- localBranchSpecFile pkg br+ rpms <- builtRpms br spec+ -- removing arch+ let packages = map takeNVRName rpms+ installed <- filterM pkgInstalled packages+ if isJust mforceshort || null installed || reinstall+ then doInstallPkg spec rpms installed+ else putStrLn $ unwords installed ++ " already installed!\n"+ where+ doInstallPkg spec rpms installed = do+ putStrLn $ takeBaseName (head rpms) ++ "\n"+ missingdeps <- nub <$> (buildRequires spec >>= filterM notInstalled)+ unless (null missingdeps) $+ if recurse+ then do+ -- srcs <- nub <$> mapM (derefSrcPkg topdir dist True) hmissing+ rbr <- anyBranchToRelease br+ forM_ missingdeps $ \ dep -> do+ -- FIXME check not metadep with parens+ mpkgdir <- lookForPkgDir rbr ".." dep+ case mpkgdir of+ Nothing -> putStrLn $ dep ++ " not known"+ Just pkgdir -> installCmd recurse mforceshort bconds reinstall [show br, pkgdir] >> putStrLn ""+ else error' $ "missing deps:\n" ++ unlines missingdeps+ buildRPMs True mforceshort bconds rpms br spec+ putStrLn ""+ unless (mforceshort == Just ShortCircuit) $+ if reinstall then do+ let reinstalls = filter (\ f -> takeNVRName f `elem` installed) rpms+ unless (null reinstalls) $+ sudo_ "/usr/bin/dnf" $ "reinstall" : "-q" : "-y" : reinstalls+ let remaining = filterDebug $ rpms \\ reinstalls+ unless (null remaining) $+ sudo_ "/usr/bin/dnf" $ "install" : "-q" : "-y" : remaining+ else sudo_ "/usr/bin/dnf" $ "install" : "-q" : "-y" : filterDebug rpms++ lookForPkgDir :: Branch -> FilePath -> String -> IO (Maybe FilePath)+ lookForPkgDir rbr topdir p = do+ mdir <- checkForPkgDir p+ case mdir of+ Just dir -> return $ Just dir+ Nothing ->+ if '-' `elem` p then do+ -- FIXME check provides p+ mdir' <- checkForPkgDir (init (dropWhileEnd (/= '-') p))+ case mdir' of+ Just dir' -> return $ Just dir'+ Nothing -> repoquerySrc >>= checkForPkgDir+ else repoquerySrc >>= checkForPkgDir+ where+ checkForPkgDir :: FilePath -> IO (Maybe FilePath)+ checkForPkgDir p' = do+ let pdir = topdir </> p'+ exists <- doesDirectoryExist pdir+ return $ if exists+ then Just pdir+ else Nothing++ repoquerySrc = do+ putStrLn $ "Repoquerying" +-+ p+ repoquery rbr ["--qf=%{source_name}", "--whatprovides", p]++ filterDebug = filter (\p -> not (any (`isInfixOf` p) ["-debuginfo-", "-debugsource-"]))
src/Cmd/Local.hs view
@@ -1,6 +1,5 @@ module Cmd.Local ( commandCmd,- installCmd, installDepsCmd, localCmd, nvrCmd,@@ -17,44 +16,9 @@ import Branches import Common-import Common.System import Git import Package --- FIXME package countdown--- FIXME --ignore-uninstalled subpackages--- FIXME --recursive-installCmd :: Maybe ForceShort -> [BCond] -> Bool -> [String] -> IO ()-installCmd mforceshort bconds reinstall =- withPackageByBranches Nothing Nothing Nothing True ZeroOrOne installPkg- where- installPkg :: Package -> AnyBranch -> IO ()- installPkg pkg br = do- spec <- localBranchSpecFile pkg br- rpms <- builtRpms br spec- -- removing arch- let packages = map takeNVRName rpms- installed <- filterM pkgInstalled packages- if isJust mforceshort || null installed || reinstall- then doInstallPkg spec rpms installed- else putStrLn $ unwords installed ++ " already installed!\n"- where- doInstallPkg spec rpms installed = do- putStrLn $ takeBaseName (head rpms) ++ "\n"- buildRPMs True mforceshort bconds rpms br spec- putStrLn ""- unless (mforceshort == Just ShortCircuit) $- if reinstall then do- let reinstalls = filter (\ f -> takeNVRName f `elem` installed) rpms- unless (null reinstalls) $- sudo_ "/usr/bin/dnf" $ "reinstall" : "-q" : "-y" : reinstalls- let remaining = filterDebug $ rpms \\ reinstalls- unless (null remaining) $- sudo_ "/usr/bin/dnf" $ "install" : "-q" : "-y" : remaining- else sudo_ "/usr/bin/dnf" $ "install" : "-q" : "-y" : filterDebug rpms-- filterDebug = filter (\p -> not (any (`isInfixOf` p) ["-debuginfo-", "-debugsource-"]))- localCmd :: Maybe ForceShort -> [BCond] -> [String] -> IO () localCmd mforceshort bconds = withPackageByBranches Nothing Nothing Nothing True ZeroOrOne localBuildPkg@@ -95,7 +59,8 @@ packages <- dependencySortRpmOpts rpmopts $ reverse pkgs putStrLn $ unwords packages where- dummy _ br = gitSwitchBranch br+ dummy _pkg br =+ whenM isPkgGitRepo $ gitSwitchBranch br toRpmOption :: RpmWith -> [String] toRpmOption (RpmWith opt) = ["--with=" ++ opt]@@ -133,11 +98,13 @@ masterRenameCmd :: [String] -> IO () masterRenameCmd =- withPackageByBranches Nothing dirtyGit Nothing True ZeroOrOne masterRenameBranch+ withPackageByBranches (Just False) dirtyGit Nothing True ZeroOrOne masterRenameBranch where masterRenameBranch :: Package -> AnyBranch -> IO () masterRenameBranch _pkg _br = do- git_ "fetch" ["--prune"]- git_ "branch" ["-m", "master", "rawhide"]- git_ "remote" ["set-head", "origin", "rawhide"]- git_ "branch" ["-u", "origin/rawhide", "rawhide"]+ locals <- gitLines "branch" ["--format=%(refname:short)"]+ when ("rawhide" `notElem` locals) $ do+ git_ "fetch" ["--prune"]+ git_ "branch" ["--move", "master", "rawhide"]+ git_ "remote" ["set-head", "origin", "rawhide"]+ git_ "branch" ["--set-upstream-to", "origin/rawhide", "rawhide"]
src/Cmd/Override.hs view
@@ -10,8 +10,8 @@ import Koji import Package -overrideCmd :: [String] -> IO ()-overrideCmd =+overrideCmd :: Bool -> [String] -> IO ()+overrideCmd dryrun = withPackageByBranches (Just False) cleanGitFetchActive Nothing True AnyNumber overrideBranch where overrideBranch :: Package -> AnyBranch -> IO ()@@ -28,6 +28,9 @@ Nothing -> error' $ nvr ++ " is untagged" Just tags -> unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $- unlessM (checkAutoBodhiUpdate br) $ do- bodhiCreateOverride nvr- kojiWaitRepo (branchTarget br) nvr+ unlessM (checkAutoBodhiUpdate br) $+ if dryrun+ then putStrLn $ "override " ++ nvr+ else do+ bodhiCreateOverride nvr+ kojiWaitRepo (branchTarget br) nvr
src/Cmd/PkgReview.hs view
@@ -2,7 +2,8 @@ module Cmd.PkgReview ( createReview,- updateReview+ updateReview,+ reviewPackage ) where import Common@@ -121,3 +122,23 @@ -- FIXME parse # of errors/warnings void $ cmdBool "rpmlint" $ spec:srpm:rpms prompt_ $ "Press Enter to " ++ if noscratch then "upload" else "submit"++reviewPackage :: Maybe String -> IO ()+reviewPackage mpkg = do+ -- FIXME if spec file exists use it directly+ pkg <- maybe getDirectoryName return mpkg+ (bugs, _) <- if all isDigit pkg+ then bugsSession $ packageReview .&&. statusNewAssigned .&&. bugIdIs (read pkg)+ else bugsSession $ pkgReviews pkg .&&. statusNewAssigned+ case bugs of+ [bug] -> do+ putReviewBug False bug+ prompt_ "Press Enter to run fedora-review"+ -- FIXME support copr build+ -- FIXME if toolbox set REVIEW_NO_MOCKGROUP_CHECK+ cmd_ "fedora-review" ["-b", show (bugId bug)]+ [] -> do+ spec <- findSpecfile+ srpm <- generateSrpm Nothing spec+ cmd_ "fedora-review" ["-rn", srpm]+ _ -> error' $ "More than one review bug found for " ++ pkg
src/Cmd/RequestBranch.hs view
@@ -1,6 +1,7 @@ module Cmd.RequestBranch ( requestBranches,- requestPkgBranches+ requestPkgBranches,+ getRequestedBranches ) where import Common@@ -32,21 +33,7 @@ requestPkgBranches mock mbrnchopts brs pkg = do putPkgHdr pkg git_ "fetch" []- active <- getFedoraBranched- branches <- case mbrnchopts of- Nothing -> if null brs- then return $ take 2 active- else return brs- Just request -> do- let requested = case request of- AllBranches -> active- AllFedora -> filter isFedoraBranch active- AllEPEL -> filter isEPELBranch active- ExcludeBranches xbrs -> active \\ xbrs- inp <- prompt $ "Confirm branches [" ++ unwords (map show requested) ++ "]"- return $ if null inp- then requested- else map (readActiveBranch' active) $ words inp+ branches <- getRequestedBranches mbrnchopts brs newbranches <- filterExistingBranchRequests branches unless (null newbranches) $ do (bug,session) <- approvedReviewBugSession (unPackage pkg)@@ -58,14 +45,14 @@ where filterExistingBranchRequests :: [Branch] -> IO [Branch] filterExistingBranchRequests branches = do- existing <- fedoraBranchesNoMaster localBranches+ existing <- fedoraBranchesNoRawhide localBranches forM_ branches $ \ br -> when (br `elem` existing) $ putStrLn $ show br ++ " branch already exists" let brs' = branches \\ existing if null brs' then return [] else do- current <- fedoraBranchesNoMaster $ pagurePkgBranches (unPackage pkg)+ current <- fedoraBranchesNoRawhide $ pagurePkgBranches (unPackage pkg) forM_ brs' $ \ br -> when (br `elem` current) $ putStrLn $ show br ++ " remote branch already exists"@@ -87,3 +74,21 @@ putStrLn $ "Branch request already open for " ++ unPackage pkg ++ ":" ++ show br mapM_ printScmIssue pending return $ null pending++getRequestedBranches :: Maybe BranchOpts -> [Branch] -> IO [Branch]+getRequestedBranches mbrnchopts brs = do+ active <- getFedoraBranched+ case mbrnchopts of+ Nothing -> if null brs+ then return $ take 2 active+ else return brs+ Just request -> do+ let requested = case request of+ AllBranches -> active+ AllFedora -> filter isFedoraBranch active+ AllEPEL -> filter isEPELBranch active+ ExcludeBranches xbrs -> active \\ xbrs+ inp <- prompt $ "Confirm branches request [" ++ unwords (map show requested) ++ "]"+ return $ if null inp+ then requested+ else map (readActiveBranch' active) $ words inp
src/Cmd/RequestRepo.hs view
@@ -9,7 +9,9 @@ import Network.HTTP.Query ((+/+)) import SimpleCmd +import Branches import Bugzilla+import Cmd.RequestBranch (getRequestedBranches) import Krb import ListReviews import Package@@ -17,18 +19,18 @@ import Prompt -- FIXME separate pre-checked listReviews and direct pkg call, which needs checks-requestRepos :: Bool -> Bool -> [String] -> IO ()-requestRepos allstates retry ps = do+requestRepos :: Bool -> Bool -> Maybe BranchOpts -> [String] -> IO ()+requestRepos allstates retry mbrnchopts ps = do when (retry && length ps /= 1) $ error' "--retry only for a single package" pkgs <- if null ps then map reviewBugToPackage <$> listReviewsAll allstates ReviewWithoutRepoReq else return ps- mapM_ (requestRepo retry) pkgs+ mapM_ (requestRepo retry mbrnchopts) pkgs -- FIXME also accept bugid instead-requestRepo :: Bool -> String -> IO ()-requestRepo retry pkg = do+requestRepo :: Bool -> Maybe BranchOpts -> String -> IO ()+requestRepo retry mbrnchopts pkg = do putStrLn pkg (bug,session) <- approvedReviewBugSession pkg putBug bug@@ -60,6 +62,9 @@ let comment = (if null input then draft else input) ++ "\n\n" <> url commentBug session bid comment putStrLn ""+ branches <- getRequestedBranches mbrnchopts []+ forM_ branches $ \ br ->+ fedpkg "request-branch" ["--repo", pkg, show br] where existingRepoRequests :: IO [IssueTitleStatus] existingRepoRequests = do
src/Cmd/Status.hs view
@@ -50,7 +50,7 @@ putStr "HEAD " gitShortLog1 Nothing >>= putStrLn . simplifyCommitLog Just nvr -> do- -- unless (br == Master) $ do+ -- unless (br == Rawhide) $ do -- newerBr <- newerBranch br <$> getFedoraBranches -- ancestor <- gitBool "merge-base" ["--is-ancestor", "HEAD", show newerBr] -- when ancestor $ do
src/Cmd/Update.hs view
@@ -9,6 +9,7 @@ import Common import Common.System import Git+import InterleaveOutput (cmdSilent') import Krb import Package @@ -64,7 +65,9 @@ cmd_ "fedpkg" $ "new-sources" : filter (".tar." `isInfixOf`) sources shell_ $ "cat sources.fbrnch >>" +-+ "sources" removeFile "sources.fbrnch"- prepPackage pkg br+ putStr "Prepping... "+ cmdSilent' "rpmbuild" ["-bp", spec]+ putStrLn "done" cmd_ "git" ["commit", "-a", "-m", "update to " ++ newver] sourceFieldFile :: String -> FilePath
src/InterleaveOutput.hs view
@@ -1,11 +1,20 @@ {-# LANGUAGE CPP #-} -module InterleaveOutput (cmdSilent_) where--import System.Process.Typed (proc, readProcessInterleaved_)+module InterleaveOutput (cmdSilent', cmdSilentBool) where +import Data.ByteString.Lazy.UTF8 as B+import GHC.IO.Exception (ExitCode(ExitSuccess))+import System.Process.Typed (proc, readProcessInterleaved,+ readProcessInterleaved_) import Common -cmdSilent_ :: String -> [String] -> IO ()-cmdSilent_ c args =+cmdSilent' :: String -> [String] -> IO ()+cmdSilent' c args = void $ readProcessInterleaved_ $ proc c args++cmdSilentBool :: String -> [String] -> IO Bool+cmdSilentBool c args = do+ (ret, out) <- readProcessInterleaved (proc c args)+ let ok = ret == ExitSuccess+ unless ok $ putStrLn (B.toString out)+ return ok
src/ListReviews.hs view
@@ -87,4 +87,4 @@ branched pkg = not <$> notBranched pkg notBranched :: String -> IO Bool- notBranched pkg = null <$> fedoraBranchesNoMaster (pagurePkgBranches pkg)+ notBranched pkg = null <$> fedoraBranchesNoRawhide (pagurePkgBranches pkg)
src/Main.hs view
@@ -13,6 +13,7 @@ import Cmd.Copr import Cmd.Diff import Cmd.Import+import Cmd.Install import Cmd.ListBranches import Cmd.ListPackages import Cmd.Local@@ -66,7 +67,7 @@ , Subcommand "sidetags" "List user's side-tags" $ sideTagsCmd <$> many branchArg , Subcommand "override" "Tag builds into buildroot override in Koji" $- overrideCmd <$> branchesPackages+ overrideCmd <$> dryrunOpt <*> branchesPackages , Subcommand "scratch" "Scratch build package in Koji" $ scratchCmd <$> dryrunOpt <*> rebuildSrpmOpt <*> noFailFastOpt <*> optional archesOpt <*> mtargetOpt <*> branchesPackages , Subcommand "update" "Update package to newer version" $@@ -89,7 +90,7 @@ installDepsCmd <$> branchesPackages , Subcommand "install" "Build locally and install package(s)" $ -- FIXME drop --shortcircuit from install?- installCmd <$> optional forceshortOpt <*> many bcondOpt <*> switchWith 'r' "reinstall" "reinstall rpms" <*> branchesPackages+ installCmd <$> switchWith 'r' "recurse" "build and install missing deps packages" <*> optional forceshortOpt <*> many bcondOpt <*> switchWith 'r' "reinstall" "reinstall rpms" <*> branchesPackages , Subcommand "bugs" "List package bugs" $ bugsCmd <$> optional (strOptionWith 's' "summary" "KEY" "Search for bugs containing keyword") <*> many (pkgArg "PACKAGE...") , Subcommand "bump" "Bump release for package" $@@ -105,13 +106,15 @@ , Subcommand "reviews" "List package reviews" $ reviewsCmd <$> reviewShortOpt <*> reviewAllStatusOpt <*> switchWith 'T' "assigned-to" "List reviews assigned to user" <*> optional (strOptionWith 'U' "user" "USER" "Bugzilla user email") <*> reviewStatusOpt , Subcommand "request-repos" "Request dist git repo for new approved packages" $- requestRepos <$> reviewAllStatusOpt <*> switchWith 'r' "retry" "Re-request repo" <*> many (pkgArg "NEWPACKAGE...")+ requestRepos <$> reviewAllStatusOpt <*> switchWith 'r' "retry" "Re-request repo" <*> branchesOpt <*> many (pkgArg "NEWPACKAGE...") , Subcommand "import" "Import new approved created packages from bugzilla review" $ importCmd <$> many (pkgArg "NEWPACKAGE...") , Subcommand "request-branches" "Request branches for approved created packages" $ requestBranches <$> mockOpt <*> optional branchesRequestOpt <*> branchesPackages , Subcommand "find-review" "Find package review bug" $ findReview <$> pkgArg "PACKAGE"+ , Subcommand "review-package" "Run fedora-review on a package Review Request bug" $+ reviewPackage <$> optional (pkgArg "PACKAGE/BZID") -- , Subcommand "test-bz-token" "Check bugzilla login status" $ -- pure testBZlogin , Subcommand "command" "Run shell command in package dirs ($p)" $@@ -210,10 +213,10 @@ targetOpt :: Parser String targetOpt =- checkNotMaster <$> strOptionWith 't' "target" "TARGET" "Koji target"+ checkNotRawhide <$> strOptionWith 't' "target" "TARGET" "Koji target" where- checkNotMaster "master" = error' "'master' is not a valid target!"- checkNotMaster t = t+ checkNotRawhide "rawhide" = error' "'rawhide' is not a valid target!"+ checkNotRawhide t = t overrideOpt = switchWith 'o' "override" "Create a buildroot override and wait-repo" @@ -255,7 +258,7 @@ sidetagTargetOpt :: Parser SideTagTarget sidetagTargetOpt = Target <$> targetOpt <|>- flagWith' SideTag 's' "sidetag" "Use existing branch side-tag for building: create with 'fedpkg request-side-tag --base-tag'"+ flagWith' SideTag 's' "sidetag" "Use the existing branch side-tag to build or creates one for you (with 'fedpkg request-side-tag --base-tag')" packagerOpt = Owner <$> ownerOpt <|> Committer <$> usernameOpt usernameOpt = strOptionWith 'u' "username" "USERNAME" "Packages user can commit to"
src/Package.hs view
@@ -43,6 +43,7 @@ buildRequires, notInstalled, pkgInstalled,+ repoquery, systemBranch, equivNVR, takeNVRName,@@ -137,9 +138,11 @@ localBranchSpecFile :: Package -> AnyBranch -> IO FilePath localBranchSpecFile pkg br = do gitdir <- isPkgGitRepo- when gitdir $ do+ if gitdir+ then do putPkgAnyBrnchHdr pkg br gitSwitchBranch br+ else putPkgHdr pkg if gitdir then do let spec = packageSpec pkg@@ -235,12 +238,16 @@ [ "--define="++ mcr +-+ cwd | gitDir, mcr <- ["_builddir", "_rpmdir", "_srcrpmdir", "_sourcedir"]] args = rpmdirs ++ ["--define", "dist " ++ rpmDistTag dist] ++ buildopt ++ map show bconds ++ [spec]- if not quiet || shortcircuit then- cmd_ "rpmbuild" args+ ok <-+ if not quiet || shortcircuit then+ cmdBool "rpmbuild" args else do- putStr "Building locally: "- cmdSilent_ "rpmbuild" args- putStrLn "done"+ putStr $ "Building " ++ takeBaseName spec ++ " locally: "+ res <- cmdSilentBool "rpmbuild" args+ when res $ putStrLn "done"+ return res+ unless ok $+ error' $ "build failed for: " ++ takeBaseName spec installDeps :: FilePath -> IO () installDeps spec = do@@ -271,7 +278,7 @@ nvr <- pkgNameVerRel' rbr spec putStr $ "Prepping " ++ nvr ++ ": " _ -> return ()- cmdSilent_ "rpmbuild" args+ cmdSilent' "rpmbuild" args putStrLn "done" checkSourcesMatch :: FilePath -> IO ()@@ -338,6 +345,7 @@ return $ commits <= 1 newtype Package = Package {unPackage :: String}+ deriving Eq putPkgHdr :: Package -> IO () putPkgHdr pkg =@@ -469,7 +477,8 @@ Nothing -> case limitBranches of ZeroOrOne | length brs > 1 ->- error' "more than one branch given"+ -- FIXME: could be handled better (testcase: run long list of packages in wrong directory)+ error' $ "more than one branch given or packages not found: " ++ unwords (tail (map show brs)) ExactlyOne | null brs -> error' "please specify one branch" ExactlyOne | length brs > 1 ->@@ -496,9 +505,12 @@ else maybeFindSpecfile pkg <- Package <$> case mspec of- -- FIXME fails if spec file can't be parsed- Just spec -> cmd "rpmspec" ["-q", "--srpm", "--qf", "%{name}", spec]+ -- FIXME fails if spec file can't be parsed and also is *slow*+ -- cmd "rpmspec" ["-q", "--srpm", "--qf", "%{name}", spec]+ -- For now assume spec filename = package name+ Just spec -> return $ takeBaseName spec Nothing -> getDirectoryName+ unless (isNothing mspec || mspec == Just (unPackage pkg <.> "spec")) $ putStrLn "Warning: package name and spec filename differ!" haveGit <- isPkgGitRepo@@ -588,6 +600,9 @@ pkgInstalled pkg = cmdBool "rpm" ["--quiet", "-q", pkg] +repoquery :: Branch -> [String] -> IO String+repoquery br args =+ cmd "dnf" (["repoquery", "--quiet", "--releasever=" ++ branchVersion br] ++ args) -- FIXME could be more strict about dist tag (eg .fcNN only) equivNVR :: String -> String -> Bool