diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,61 @@ # Changelog +## 1.5 (2024-08-17) +* fedora-releases (using bodhi) replaces fedora-dists (pdc): explicit imports +- 'bugs': also include product in prefix +- 'bump': fix handling of autorelease +- 'clone': --group allows cloning all of group's packages (#46) +- 'clone': print no of repos +- 'command' --if-output: drop trailing newline +- 'commit': add --dryrun +- 'commit': require --message for %autochangelog +- 'compare': no longer reorders branches, checks their existence +- 'copr --new': create a new copr project +* 'copr': no longer rebuilds nvr's unless --force +* 'copr': does not resubmit existing successful or in-progress nvr's +- 'copr': add --monitor +- 'copr': fix bug where only first two source packages got built +- 'copr': sort chroots by arch; distless srpm +- 'diff' can now take multiple filters +- 'ftbfs': use --details with koji-tool +- 'import': if no branches requested, skip requestPkgBranches +* 'install': use select-rpms library refactored from koji-tool +- 'list': check number of results and prompt if >1000 unless --force +* 'parallel': support chain-build args with colon interspersed layers +- 'parallel': retry kojiWaitTask +- 'parallel': --must-push to enforce commit bumps +- 'parallel': koji-tool use --children to get failed buildArch +- 'parallel': only do parallelBranches build if more than 1 branch +* 'parallel': better concurrent output with say library +* 'prep','update': use cwd for %_sourcedir +- 'prep': --allow-head +- 'pull': add --rebase +- 'push': print log relative to origin +- 'repoquery': add testing repos (not yet using fedora-repoquery) +- 'request-repo': retry listing existing scm requests +- 'request-repos': add --skip-request-check and rename --retry to --resubmit +* 'review-package --interactive': new lighter review mode without mock +* 'reviews': new --assignee, --submitted and --submitter options +* 'sort': default to chain-build output +- 'sort': skip getDynSourcesMacros for dead.package +- 'status': add --latest-commit +- 'unpush --bump': now uses 'bump' code +- 'unpushed': add --check-nvr and do not print every "dead package" +* 'update': git add patches +- 'update-review': end with bug url +- '--dryrun' is now an alias for '--dry-run' +- Package pkgNameVerRelDist: use fedpkg verrel if autorelease +- RpmBuild: checkSourcesMatch yesNo prompt for git amend +- fix stack build of HsOpenSSL with gcc14 -Wno-incompatible-pointer-types +- fix systemBranch to determine rawhide correctly via distBranch +- generateSrpmNoDist: also warn if generated srpm is different to prediction +- generateSrpmNoDist: fallback to fedpkg for autospec +- kojiWatchTask: use koji-tool tasks --children to get failed task +- module refactorings from Local, PkgReview, PullPush, Status +- more consistent prompt handling of 'commit'/'update'/'review' messages +- require rpmbuild-order 0.4.12 to order rust crates and rubygems +- withPackagesByBranches: git fetch earlier to get new branches + ## 1.4 (2024-05-03) - buildSrpm: filter .src.rpm filename - checkSourcesMatch: prompt before amending and abort if still dirty diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ Fedora developers use a lot of time building packages across releases and workflow for adding new packages, etc. fbrnch was made to help (semi-)automate common workflows to save time -and effort, and avoid common some mistakes. +and effort, and avoid some common mistakes. fbrnch is distributed under the GPL license version 2 or later. @@ -39,7 +39,7 @@ One can change the branch of one or more packages: ``` -$ fbrnch switch f40 [package] ... +$ fbrnch switch f41 [package] ... ``` You can also git pull over packages: @@ -97,13 +97,13 @@ You can merge branches with: ``` -$ fbrnch merge f39 package +$ fbrnch merge f40 package ``` -which will offer to merge f39 (or up to a git hash you choose) into f38. +which will offer to merge f41 (or up to a git hash you choose) into f40. Merging can also be done together with building: ``` -$ fbrnch build f39 package +$ fbrnch build f41 package ``` will ask if you want to merge newer commits from a newer branch, then push and build it. @@ -181,6 +181,10 @@ builds a list of packages in a sidetag (generating it if no sidetags exist) in parallel ordered by build dependencies. +For a long list of packages, it is generally better to +`fbrnch sort` them first and then use the generated chain-build style +output as arguments to `fbrnch parallel`. + When building for a branch, merging from the next newer branch will be offered unless using `--no-merge` (then you may prefer to run `fbrnch merge ...` first instead). @@ -190,7 +194,8 @@ you can select one using `--target`. They can be listed with `fbrnch sidetags`. -After parallel building you can create a Bodhi update from the sidetag. +After parallel building completes, +you can create a Bodhi update from the sidetag. It is also possible to build a package in parallel across branches and push them to Bodhi. @@ -220,13 +225,16 @@ $ fbrnch reviews ``` They can be filtered by status with various options like -`--approved` or `--created` (or another bugzilla `--user`). +`--approved` or `--created` (or another bugzilla `--submitter`), etc. One can also search for the review(s) of a specific package with: ``` $ fbrnch find-review package-name ``` +Package reviews can be performed with `fbrnch review-package`. +It also has a lightweight `--interactive` mode for streamlined reviews. + #### Request repos Once a review has been approved ``` @@ -262,7 +270,7 @@ `$ fbrnch --version` ``` -1.4 +1.5 ``` `$ fbrnch --help` @@ -299,7 +307,8 @@ scratch-x86_64 Koji x86_64 scratch build of package update-sources Download and update newer sources update-version Update package in dist-git to newer version - sort Sort packages in build dependency order + sort Sort packages in build dependency order (default + format: chain-build) prep Prep sources local Build locally srpm Build srpm @@ -443,7 +452,7 @@ - Lightning talk for devconf.cz 2021: [youtube](https://www.youtube.com/watch?v=O2-6rDuPMRA&t=2s) ## Contribute -Bug reports, feedback, and pull requests are all highly appreciated. +Bug reports, feedback, and pull requests are all much appreciated. Do report any unsupported or inconsistent workflow steps. diff --git a/fbrnch.cabal b/fbrnch.cabal --- a/fbrnch.cabal +++ b/fbrnch.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: fbrnch -version: 1.4 +version: 1.5 synopsis: Fedora packager tool to build package branches description: fbrnch (fedora branch or "f-branch" for short) is @@ -47,6 +47,7 @@ other-modules: Bodhi Branches Bugzilla + Cmd.Autospec Cmd.Bugs Cmd.Build Cmd.Bump @@ -55,6 +56,7 @@ Cmd.Compare Cmd.Copr Cmd.Diff + Cmd.Fetch Cmd.FTBFS Cmd.Import Cmd.Install @@ -68,10 +70,12 @@ Cmd.Parallel Cmd.PkgReview Cmd.Prep - Cmd.PullPush + Cmd.Pull + Cmd.Push --Cmd.Repoquery Cmd.RequestBranch Cmd.RequestRepo + Cmd.ReviewPackage Cmd.Reviews Cmd.Scratch Cmd.SideTags @@ -79,6 +83,7 @@ Cmd.SrcDeps Cmd.Status Cmd.Switch + Cmd.Unpushed Cmd.Update Cmd.WaitRepo Common @@ -108,26 +113,29 @@ bugzilla-redhat >= 1.0.1, bytestring, config-ini, - copr-api, + copr-api >= 0.2, directory >= 1.2.3, + either, email-validate, extra, - fedora-dists >= 2.1.1, + fedora-releases, filepath, http-conduit, http-directory >= 0.1.5, http-query, koji, network-uri, - pagure >= 0.1, + pagure >= 0.2.1, pretty-terminal, process, -- regex-tdfa, - rpmbuild-order >= 0.4.11, + rpmbuild-order >= 0.4.12, rpm-nvr >= 0.1.2, + say, + select-rpms, simple-cmd >= 0.2.3, simple-cmd-args >= 0.1.8, - simple-prompt >= 0.2, + simple-prompt >= 0.2.3, text, time, typed-process >= 0.2.4.0, @@ -139,6 +147,8 @@ build-depends: semigroups if impl(ghc<8.4) build-depends: http-common < 0.8.3.4 + if impl(ghc<9) + build-depends: unordered-containers ghc-options: -threaded -Wall diff --git a/src/Bodhi.hs b/src/Bodhi.hs --- a/src/Bodhi.hs +++ b/src/Bodhi.hs @@ -29,6 +29,7 @@ import Common.System import qualified Common.Text as T import Package +import Types (ChangeType(ChangeBodhi)) checkAutoBodhiUpdate :: Branch -> IO Bool checkAutoBodhiUpdate Rawhide = return True @@ -147,10 +148,10 @@ then getSummaryURL spec else if usechangelog - then cleanChangelog spec + then cleanChangelog True spec else -- FIXME list open bugs - changeLogPrompt True spec + changeLogPrompt ChangeBodhi spec if trim (lower changelog) `elem` ["no","n"] then return False else do diff --git a/src/Branches.hs b/src/Branches.hs --- a/src/Branches.hs +++ b/src/Branches.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Branches ( activeBranches, fedoraBranches, @@ -7,12 +9,11 @@ localBranches, pagurePkgBranches, mockRoot, - module Distribution.Fedora.Branch, + Branch(..), AnyBranch(..), anyBranch, isRelBranch, onlyRelBranch, - partitionBranches, BranchOpts(..), listOfBranches, listOfAnyBranches, @@ -29,16 +30,17 @@ gitLines ) where -import Common -import Common.System - -import Data.Either -import Data.Tuple -import Distribution.Fedora.Branch +import Data.Either (partitionEithers) +import Distribution.Fedora.Branch (Branch(..), eitherBranch, getFedoraBranched, + getFedoraBranches, getLatestFedoraBranch, + readActiveBranch, eitherActiveBranch, + readBranch) import SimpleCmd.Git import SimplePrompt (promptEnter, promptInitial) import qualified System.Info (arch) +import Common +import Common.System import Pagure data AnyBranch = RelBranch Branch | OtherBranch String @@ -58,10 +60,6 @@ show (RelBranch br) = show br show (OtherBranch obr) = obr -partitionBranches :: [String] -> ([Branch],[String]) -partitionBranches args = - swap . partitionEithers $ map eitherBranch args - activeBranches :: [Branch] -> [String] -> [Branch] activeBranches active = -- newest branch first @@ -126,8 +124,19 @@ onlyRelBranch (OtherBranch br) = error' $ "Non-release branch not allowed:" +-+ br systemBranch :: IO Branch -systemBranch = - readBranch' . init . removePrefix "PLATFORM_ID=\"platform:" <$> cmd "grep" ["PLATFORM_ID=", "/etc/os-release"] +systemBranch = do + platform <- init . removePrefix "PLATFORM_ID=\"platform:" <$> cmd "grep" ["PLATFORM_ID=", "/etc/os-release"] + if platform == "eln" + then return Rawhide + else + case readBranch platform of + Just br -> do + branched <- getLatestFedoraBranch + return $ + if br > branched + then Rawhide + else br + Nothing -> error' $ "could not determine system branch from platform" +-+ platform listOfBranches :: Bool -> Bool -> BranchesReq -> IO [Branch] listOfBranches distgit _active (BranchOpt AllBranches) = @@ -209,7 +218,6 @@ gitCurrentBranchWarn else return br - checkOnBranch :: IO () checkOnBranch = void gitCurrentBranch @@ -237,8 +245,7 @@ AllFedora -> filter isFedoraBranch activenew AllEPEL -> filter isEPELBranch activenew ExcludeBranches xbrs -> activenew \\ xbrs - inp <- promptInitial "Confirm branches to request" $ unwords (map show requested) - return $ map (readActiveBranch' activenew) $ words inp + confirmBranches activenew requested where branchingPrompt :: [Branch] -> IO [Branch] branchingPrompt active = do @@ -248,6 +255,17 @@ in if all isRelBranch abrs then return $ map onlyRelBranch abrs else branchingPrompt active + + confirmBranches :: [Branch] -> [Branch] -> IO [Branch] + confirmBranches activenew requested = do + inp <- promptInitial "Confirm branches to request" $ unwords (map show requested) + let (errs,oks) = partitionEithers $ + map (eitherActiveBranch activenew) $ words inp + if null errs + then return oks + else do + putStrLn $ "unknown branches:" +-+ unwords errs + confirmBranches activenew requested data BranchesReq = BranchOpt BranchOpts | Branches [Branch] diff --git a/src/Bugzilla.hs b/src/Bugzilla.hs --- a/src/Bugzilla.hs +++ b/src/Bugzilla.hs @@ -428,10 +428,10 @@ putBugVer :: Bug -> IO () putBugVer bug = do - T.putStr $ "[" <> prodVersion <> "] " + T.putStr $ "[" <> pref <> "] " putBug bug where - prodVersion = T.unwords (bugVersion bug) + pref = T.unwords (bugProduct bug : bugVersion bug) putBugId :: BugId -> IO () putBugId bid = diff --git a/src/Cmd/Autospec.hs b/src/Cmd/Autospec.hs new file mode 100644 --- /dev/null +++ b/src/Cmd/Autospec.hs @@ -0,0 +1,34 @@ +module Cmd.Autospec ( + autospecCmd + ) +where + +import Control.Monad.Extra (unlessM) +import SimpleCmd (cmd, cmd_) +import System.Directory (doesFileExist) + +import Branches +import Git +import Package + +-- FIXME calculate baserelease +autospecCmd :: Bool -> [String] -> IO () +autospecCmd force pkgs = + withPackagesByBranches HeaderMay False cleanGitFetchActive ExactlyOne autospecPkg (Branches [Rawhide], pkgs) + where + autospecPkg :: Package -> AnyBranch -> IO () + autospecPkg _pkg br = do + gitSwitchBranch br + let changelogfile = "changelog" + exists <- doesFileExist changelogfile + if exists + then + if force + then do + cmd "rpmautospec" ["generate-changelog"] >>= + writeFile changelogfile + unlessM (null <$> git "status" ["--porcelain", "--untracked=no"]) $ do + git_ "add" [changelogfile] + git_ "commit" ["-m", "refresh changelog"] + else putStrLn "'changelog' file already exists" + else cmd_ "rpmautospec" ["convert"] diff --git a/src/Cmd/Build.hs b/src/Cmd/Build.hs --- a/src/Cmd/Build.hs +++ b/src/Cmd/Build.hs @@ -5,14 +5,14 @@ BuildOpts(..) ) where +import Distribution.Fedora.Branch (branchDestTag, branchTarget) import SimplePrompt (promptEnter, yesNo) -import Common -import Common.System - import Bodhi import Bugzilla import Branches +import Common +import Common.System import Cmd.Merge import Git import Krb @@ -121,109 +121,113 @@ if tty && (not merged || (newrepo && ancestor && length unmerged == 1)) then refPrompt unpushed $ "Press Enter to push and build" ++ (if length unpushed > 1 then "; or give ref to push" else "") ++ (if not newrepo then "; or 'no' to skip pushing" else "") else return $ Just $ commitRef $ head unpushed - let dryrun = buildoptDryrun opts - buildstatus <- maybeTimeout 30 $ kojiBuildStatus nvr let msidetagTarget = buildoptSidetagTarget opts - mwaitrepo = buildoptWaitrepo opts target <- targetMaybeSidetag dryrun True br msidetagTarget - case buildstatus of - Just BuildComplete -> do - putStrLn $ showNVR nvr +-+ "is already built" - when (isJust mpush) $ - error' "Please bump the spec file" - when (br /= Rawhide && isNothing msidetagTarget) $ do - updateExists <- maybeTimeout 30 $ bodhiBuildExists nvr - autoupdate <- checkAutoBodhiUpdate br - -- FIXME update referenced bugs for autoupdate branch - unless autoupdate $ do - if updateExists - then putStrLn "update exists" - else do - mbug <- bzReviewAnon - bodhiUpdate dryrun (buildoptUpdate opts) mbug (buildoptUseChangelog opts) spec $ showNVR nvr - whenJust moverride $ \days -> do - tags <- maybeTimeout 30 $ kojiNVRTags nvr - unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $ - bodhiCreateOverride dryrun (Just days) nvr - when (isJust mlastpkg && mlastpkg /= Just pkg || mwaitrepo == Just True) $ - when ((isJust moverride && mwaitrepo /= Just False) || - (autoupdate && mwaitrepo == Just True)) $ - kojiWaitRepo dryrun True True target nvr - Just BuildBuilding -> do - putStrLn $ showNVR nvr +-+ "is already building" - when (isJust mpush) $ - error' "Please bump the spec file" - whenJustM (kojiGetBuildTaskID fedoraHub (showNVR nvr)) kojiWatchTask - -- FIXME do override - _ -> do - mbuildref <- - case mpush of - Nothing -> Just <$> git "show-ref" ["--hash", "origin/" ++ show br] - _ -> return mpush - opentasks <- kojiOpenTasks pkg mbuildref target - case opentasks of - [task] -> do - putStrLn $ showNVR nvr +-+ "task" +-+ displayID task +-+ "is already open" + buildRun spec nvr merged mpush unpushed target msidetagTarget moverride + where + dryrun = buildoptDryrun opts + + buildRun spec nvr merged mpush unpushed target msidetagTarget moverride = do + let mwaitrepo = buildoptWaitrepo opts + buildstatus <- maybeTimeout 30 $ kojiBuildStatus nvr + case buildstatus of + Just BuildComplete -> do + putStrLn $ showNVR nvr +-+ "is built" when (isJust mpush) $ error' "Please bump the spec file" - kojiWatchTask task - (_:_) -> error' $ show (length opentasks) +-+ "open" +-+ unPackage pkg +-+ "tasks already!" - [] -> do - let tag = - if target == branchTarget br then branchDestTag br else target - mlatest <- kojiLatestNVR tag $ unPackage pkg - if equivNVR nvr mlatest - then putStrLn $ showNVR nvr +-+ "is already latest" +-+ if Just nvr /= mlatest then "(modulo disttag)" else "" - else do - when (null unpushed || merged && br /= Rawhide) $ do - putStrLn $ showNVR nvr ++ "\n" - firstBuild <- do - mtestingRepo <- bodhiTestingRepo br - case mtestingRepo of - Nothing -> return $ isNothing mlatest - Just testing -> do - mnewest <- kojiLatestNVR testing $ unPackage pkg - case mnewest of - Nothing -> return $ isNothing mlatest - Just newest -> do - newestTags <- kojiNVRTags newest - unless (any (`elem` newestTags) [show br, show br ++ "-updates", show br ++ "-updates-pending"]) $ do - -- FIXME print how many days left - putStrLn $ "Warning:" +-+ showNVR newest +-+ "still in testing?" - promptEnter "Press Enter to continue" - return False - unless (buildoptStash opts) $ - unlessM isGitDirClean $ - error' "local changes remain (dirty)" - unless dryrun krbTicket - whenJust mpush $ \ref -> - unless dryrun $ - gitPush False $ Just $ ref ++ ":" ++ show br - unlessM (null <$> gitOneLineLog ("origin/" ++ show br ++ "..HEAD")) $ - unless dryrun $ do - ok <- yesNo "Unpushed changes remain, continue" - unless ok $ error' "aborted" - -- FIXME parse build output - unless dryrun $ - kojiBuildBranch target pkg mbuildref ["--fail-fast" | not (buildoptNoFailFast opts)] - mBugSess <- - if firstBuild && isJust (fst (buildoptUpdate opts)) - then bzReviewSession - else return Nothing + when (br /= Rawhide && isNothing msidetagTarget) $ do + updateExists <- maybeTimeout 30 $ bodhiBuildExists nvr autoupdate <- checkAutoBodhiUpdate br - if autoupdate - then whenJust mBugSess $ - \ (bid,session) -> putBugBuild dryrun session bid nvr - else do - when (isNothing msidetagTarget) $ do - whenJust (fmap fst mBugSess) $ - \bid -> putStr "review bug: " >> putBugId bid - -- FIXME diff previous changelog? - bodhiUpdate dryrun (buildoptUpdate opts) (fmap fst mBugSess) (buildoptUseChangelog opts) spec $ showNVR nvr - -- FIXME prompt for override note - whenJust moverride $ \days -> + -- FIXME update referenced bugs for autoupdate branch + unless autoupdate $ do + if updateExists + then putStrLn "update exists" + else do + mbug <- bzReviewAnon + bodhiUpdate dryrun (buildoptUpdate opts) mbug (buildoptUseChangelog opts) spec $ showNVR nvr + whenJust moverride $ \days -> do + tags <- maybeTimeout 30 $ kojiNVRTags nvr + unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $ bodhiCreateOverride dryrun (Just days) nvr when (isJust mlastpkg && mlastpkg /= Just pkg || mwaitrepo == Just True) $ when ((isJust moverride && mwaitrepo /= Just False) || (autoupdate && mwaitrepo == Just True)) $ - kojiWaitRepo dryrun True True target nvr + kojiWaitRepo dryrun True True target nvr + Just BuildBuilding -> do + putStrLn $ showNVR nvr +-+ "is already building" + when (isJust mpush) $ + error' "Please bump the spec file" + whenJustM (kojiGetBuildTaskID fedoraHub (showNVR nvr)) kojiWatchTask + buildRun spec nvr merged mpush unpushed target msidetagTarget moverride + _ -> do + mbuildref <- + case mpush of + Nothing -> Just <$> git "show-ref" ["--hash", "origin/" ++ show br] + _ -> return mpush + opentasks <- kojiOpenTasks pkg mbuildref target + case opentasks of + [task] -> do + putStrLn $ showNVR nvr +-+ "task" +-+ displayID task +-+ "is already open" + when (isJust mpush) $ + error' "Please bump the spec file" + kojiWatchTask task + (_:_) -> error' $ show (length opentasks) +-+ "open" +-+ unPackage pkg +-+ "tasks already!" + [] -> do + let tag = + if target == branchTarget br then branchDestTag br else target + mlatest <- kojiLatestNVR tag $ unPackage pkg + if equivNVR nvr mlatest + then putStrLn $ showNVR nvr +-+ "is already latest" +-+ if Just nvr /= mlatest then "(modulo disttag)" else "" + else do + when (null unpushed || merged && br /= Rawhide) $ do + putStrLn $ showNVR nvr ++ "\n" + firstBuild <- do + mtestingRepo <- bodhiTestingRepo br + case mtestingRepo of + Nothing -> return $ isNothing mlatest + Just testing -> do + mnewest <- kojiLatestNVR testing $ unPackage pkg + case mnewest of + Nothing -> return $ isNothing mlatest + Just newest -> do + newestTags <- kojiNVRTags newest + unless (any (`elem` newestTags) [show br, show br ++ "-updates", show br ++ "-updates-pending"]) $ do + -- FIXME print how many days left + putStrLn $ "Warning:" +-+ showNVR newest +-+ "still in testing?" + promptEnter "Press Enter to continue" + return False + unless (buildoptStash opts) $ + unlessM isGitDirClean $ + error' "local changes remain (dirty)" + unless dryrun krbTicket + whenJust mpush $ \ref -> + unless dryrun $ + gitPush False $ Just $ ref ++ ":" ++ show br + unlessM (null <$> gitOneLineLog ("origin/" ++ show br ++ "..HEAD")) $ + unless dryrun $ do + ok <- yesNo "Unpushed changes remain, continue" + unless ok $ error' "aborted" + -- FIXME parse build output + unless dryrun $ + kojiBuildBranch target pkg mbuildref ["--fail-fast" | not (buildoptNoFailFast opts)] + mBugSess <- + if firstBuild && isJust (fst (buildoptUpdate opts)) + then bzReviewSession + else return Nothing + autoupdate <- checkAutoBodhiUpdate br + if autoupdate + then whenJust mBugSess $ + \ (bid,session) -> putBugBuild dryrun session bid nvr + else do + when (isNothing msidetagTarget) $ do + whenJust (fmap fst mBugSess) $ + \bid -> putStr "review bug: " >> putBugId bid + -- FIXME diff previous changelog? + bodhiUpdate dryrun (buildoptUpdate opts) (fmap fst mBugSess) (buildoptUseChangelog opts) spec $ showNVR nvr + -- FIXME prompt for override note + whenJust moverride $ \days -> + bodhiCreateOverride dryrun (Just days) nvr + when (isJust mlastpkg && mlastpkg /= Just pkg || mwaitrepo == Just True) $ + when ((isJust moverride && mwaitrepo /= Just False) || + (autoupdate && mwaitrepo == Just True)) $ + kojiWaitRepo dryrun True True target nvr diff --git a/src/Cmd/Bump.hs b/src/Cmd/Bump.hs --- a/src/Cmd/Bump.hs +++ b/src/Cmd/Bump.hs @@ -1,8 +1,12 @@ module Cmd.Bump - ( bumpPkgs, + ( bumpCmd, + bumpPkg ) where +import Distribution.Fedora.Branch (branchDestTag) +import System.IO.Extra + import Branches import Common import Common.System @@ -10,65 +14,94 @@ import Koji import Package -import System.IO.Extra - -- FIXME --force -- FIXME --target -bumpPkgs :: Bool -> Bool -> Maybe CommitOpt -> Maybe String +bumpCmd :: Bool -> Bool -> Maybe String -> Maybe String -> (BranchesReq,[String]) -> IO () -bumpPkgs dryrun local mopt mclog = +bumpCmd dryrun local mcmsg mclog = withPackagesByBranches (boolHeader local) False (if local then cleanGit else cleanGitFetchActive) - AnyNumber bumpPkg - where - bumpPkg :: Package -> AnyBranch -> IO () - bumpPkg pkg br = do - dead <- doesFileExist "dead.package" - if dead - then putStrLn "dead package" + AnyNumber (bumpPkg dryrun local mcmsg mclog) + +bumpPkg :: Bool -> Bool -> Maybe String -> Maybe String + -> Package -> AnyBranch -> IO () +bumpPkg dryrun local mcmsg mclog pkg br = do + dead <- doesFileExist "dead.package" + if dead + then putStrLn "dead package" + else do + spec <- localBranchSpecFile pkg br + unpushed <- gitOneLineLog $ "origin/" ++ show br ++ "..HEAD" + displayCommits True unpushed + autorelease <- isAutoRelease spec + if autorelease + then + if not (null unpushed) + then putStrLn $ "autorelease: unpushed" +-+ + case length unpushed of + 1 -> "commit" + n -> show n +-+ "commits" + else + if dryrun + then putStrLn "autorelease: bump with commit" else do - spec <- localBranchSpecFile pkg br - rbr <- - case br of - RelBranch rbr -> return rbr - OtherBranch _ -> systemBranch - newnvr <- pkgNameVerRel' rbr spec - moldnvr <- - if local - then - withTempFile $ \tempfile -> do - git "show" ["origin:" ++ spec] >>= writeFile tempfile - pkgNameVerRel rbr tempfile - else - case br of - RelBranch rbr' -> - let tag = branchDestTag rbr' - in kojiLatestNVR tag $ unPackage pkg - -- FIXME fallback to local? - _ -> return Nothing - if equivNVR newnvr moldnvr - then do - git_ "log" ["origin..HEAD", "--pretty=oneline"] - let clmsg = - case mclog of - Just clog -> clog - Nothing -> - case mopt of - Just (CommitMsg msg) -> msg - _ -> "rebuild" - autorelease <- isAutoRelease spec - unless (autorelease || dryrun) $ - cmd_ "rpmdev-bumpspec" ["-c", clmsg, spec] let copts = - case mopt of - Nothing -> ["-m", if autorelease then "rebuild" else "bump release"] - Just opt -> - case opt of - CommitMsg msg -> ["-m", msg] - -- FIXME reject amend if already pushed - CommitAmend -> ["--amend", "--no-edit"] - -- FIXME quiet commit? - if dryrun - then putStrLn "would be bumped with commit" - else git_ "commit" $ "-a" : (if autorelease then ("--allow-empty" :) else id) copts - else putStrLn "already bumped" + "-m" : + case mcmsg of + Just msg -> [msg] + Nothing -> + case mclog of + Just cl -> [cl] + Nothing -> ["bump release"] + git_ "commit" $ "-a" : "--allow-empty" : copts + else do + rbr <- + case br of + RelBranch rbr -> return rbr + OtherBranch _ -> systemBranch + newnvr <- pkgNameVerRel' rbr spec + moldnvr <- + if local + then do + withTempDir $ \tempdir -> do + git "show" ["origin:" ++ spec] >>= + writeFile (tempdir spec) + withCurrentDirectory tempdir $ do + oldautorel <- isAutoRelease (tempdir spec) + if not oldautorel + then pkgNameVerRel rbr spec + else do + -- FIXME check version unchanged before cloning + clonePkg True AnonClone (Just rbr) $ unPackage pkg + withCurrentDirectory (unPackage pkg) $ + pkgNameVerRel rbr spec + else + case br of + RelBranch rbr' -> + let tag = branchDestTag rbr' + in kojiLatestNVR tag $ unPackage pkg + -- FIXME fallback to local? + _ -> return Nothing + whenJust moldnvr $ \o -> putStrLn $ showNVR o +-+ "->" + putStrLn $ showNVR newnvr + if equivNVR newnvr moldnvr + then do + git_ "log" ["origin..HEAD", "--pretty=oneline"] + let clog = + case mclog of + Just cl -> cl + Nothing -> + case mcmsg of + Just msg -> msg + _ -> "rebuild" + unless (autorelease || dryrun) $ + cmd_ "rpmdev-bumpspec" ["-c", clog, spec] + let copts = + case mcmsg of + Nothing -> ["-m", "bump release"] + Just msg -> ["-m", msg] + -- FIXME quiet commit? + if dryrun + then putStrLn "would be bumped with commit" + else git_ "commit" $ "-a" : (if autorelease then ("--allow-empty" :) else id) copts + else putStrLn "already bumped" diff --git a/src/Cmd/Clone.hs b/src/Cmd/Clone.hs --- a/src/Cmd/Clone.hs +++ b/src/Cmd/Clone.hs @@ -1,27 +1,33 @@ module Cmd.Clone (cloneCmd, CloneRequest(..)) where -import Common.System -import qualified Common.Text as T +import Control.Monad (when) import Branches +import Common.System +import qualified Common.Text as T import Krb import Package import Pagure -data CloneRequest = CloneUser (Maybe String) - | ClonePkgs (Maybe Branch, [String]) +data CloneRequest = CloneGroup String + | CloneUser (Maybe String) + | ClonePkgs [String] -- FIXME allow pagure repo wildcard -- FIXME (detect commit rights or a ssh key?) -cloneCmd :: CloneRequest -> IO () -cloneCmd request = do - (mbr,pkgs) <- case request of +cloneCmd :: Maybe Branch -> CloneRequest -> IO () +cloneCmd mbr request = do + pkgs <- case request of CloneUser mid -> do userid <- maybe fasIdFromKrb return mid - ps <- map (takeFileName . T.unpack) <$> pagureUserRepos srcfpo userid - return (Nothing, ps) + map (takeFileName . T.unpack) <$> pagureUserRepos srcfpo userid -- FIXME detect/prevent "path/dir" - ClonePkgs mbps -> return mbps + ClonePkgs ps -> return ps + CloneGroup grp -> do + map (takeFileName . T.unpack) <$> pagureGroupRepos srcfpo False grp mfas <- maybeFasIdFromKrb + let no = length pkgs + when (no > 1) $ + putStrLn $ "cloning" +-+ show no +-+ "pkg repos" let auth = maybe AnonClone (const UserClone) mfas mapM_ (clonePkg False auth mbr) pkgs diff --git a/src/Cmd/Commit.hs b/src/Cmd/Commit.hs --- a/src/Cmd/Commit.hs +++ b/src/Cmd/Commit.hs @@ -1,5 +1,5 @@ module Cmd.Commit - ( commitPkgs, + ( commitCmd, ) where @@ -14,9 +14,9 @@ -- FIXME use branches after all? -- FIXME handle multiline changelog entries with "-m description" -- FIXME --undo last change: eg undo accidential --amend --- FIXME for single package assume --all if no stage -commitPkgs :: Maybe CommitOpt -> Bool -> Bool -> [String] -> IO () -commitPkgs mopt firstLine unstaged paths = do +-- FIXME --empty +commitCmd :: Bool -> Maybe CommitOpt -> Bool -> Bool -> [String] -> IO () +commitCmd dryrun mopt firstLine unstaged paths = do when (isJust mopt && firstLine) $ error' "--first-line cannot be used with other commit msg options" if null paths @@ -41,26 +41,33 @@ Nothing -> do changelog <- do spec <- findSpecfile - clog <- lines <$> cleanChangelog spec - case clog of - [] -> readCommitMsg - [msg] -> return msg - msgs -> - if firstLine - then return $ removePrefix "- " $ head msgs - else do - diff <- git "diff" ["-U0", if addall then "HEAD" else "--cached"] - let newlogs = - filter (\c -> ('+' : c) `elem` lines (unquoteMacros diff)) clog - case newlogs of - [] -> putStrLn diff >> readCommitMsg - [msg] -> return (removePrefix "- " msg) - [m,m'] -> mapM_ putStrLn newlogs >> - return (unlines $ map (removePrefix "- ") [m,"",m']) - (m:ms) -> mapM_ putStrLn newlogs >> - return (unlines (removePrefix "- " m:"":ms)) + autochangelog <- grep_ "^%autochangelog" spec + if autochangelog + -- rpmautospec generates "Uncommitted changes" + then error' "set commit msg with --message" + else do + clog <- lines <$> cleanChangelog True spec + case clog of + [] -> readCommitMsg + [msg] -> return msg + msgs -> + if firstLine + then return $ removePrefix "- " $ head msgs + else do + diff <- git "diff" ["-U0", if addall then "HEAD" else "--cached"] + let newlogs = + filter (\c -> ('+' : c) `elem` lines (unquoteMacros diff)) clog + case newlogs of + [] -> putStrLn diff >> readCommitMsg + [msg] -> return (removePrefix "- " msg) + [m,m'] -> mapM_ putStrLn newlogs >> + return (unlines $ map (removePrefix "- ") [m,"",m']) + (m:ms) -> mapM_ putStrLn newlogs >> + return (unlines (removePrefix "- " m:"":ms)) return ["-m", changelog] - git_ "commit" $ ["-a" | addall] ++ opts + if dryrun + then cmdN "git" $ ["-a" | addall] ++ opts + else git_ "commit" $ ["--dry-run" | dryrun] ++ ["-a" | addall] ++ opts readCommitMsg :: IO String readCommitMsg = do diff --git a/src/Cmd/Compare.hs b/src/Cmd/Compare.hs --- a/src/Cmd/Compare.hs +++ b/src/Cmd/Compare.hs @@ -8,6 +8,7 @@ import Git import Package +-- FIXME warn if older branch ahead compareCmd :: Bool -> Maybe String -> AnyBranch -> AnyBranch -> [String] -> IO () compareCmd long mignore br1 br2 pkgs = do if null pkgs @@ -24,21 +25,28 @@ comparePkg pkgdir = withExistingDirectory pkgdir $ unlessM (doesFileExist "dead.package") $ do - let (br1',br2') = - case (br1, br2) of - (RelBranch b1, RelBranch b2) | b2 < b1 -> (br2,br1) - _ -> (br1,br2) - localbranches <- gitLines "branch" ["--format=%(refname:short)"] - forM_ [br1',br2'] $ \br -> - unless (show br `elem` localbranches) $ gitSwitchBranch br - output <- ignoredLines <$> gitLines "log" (["--format=reference" | not long] ++ [show br1' ++ ".." ++ show br2']) - unless (null output) $ do - unless (null pkgs) $ - getPackageName pkgdir >>= putPkgHdr - mapM_ putStrLn output + localbranches <- localBranches True + oldcurrent <- gitCurrentBranch + have1 <- haveBranch localbranches br1 + have2 <- haveBranch localbranches br2 + newcurrent <- gitCurrentBranch + when (newcurrent /= oldcurrent) $ + gitSwitchBranch oldcurrent + when (have1 && have2) $ do + output <- ignoredLines <$> gitLines "log" (["--format=reference" | not long] ++ [show br1 ++ ".." ++ show br2]) + unless (null output) $ do + unless (null pkgs) $ + getPackageName pkgdir >>= putPkgHdr + mapM_ putStrLn output ignoredLines :: [String] -> [String] ignoredLines = case mignore of Nothing -> id Just ignore -> filter (not . (ignore `isInfixOf`)) + + haveBranch :: [String] -> AnyBranch -> IO Bool + haveBranch locals br = + if show br `elem` locals + then return True + else gitSwitchBranch' True $ onlyRelBranch br diff --git a/src/Cmd/Copr.hs b/src/Cmd/Copr.hs --- a/src/Cmd/Copr.hs +++ b/src/Cmd/Copr.hs @@ -1,70 +1,141 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Cmd.Copr ( BuildBy(..), - coprCmd + coprCmd, + CoprMode(..) ) where +import Data.Aeson.Types (Object) +#if MIN_VERSION_aeson(2,0,0) +import Data.Aeson.Key +import qualified Data.Aeson.KeyMap as M +#else +import qualified Data.HashMap.Strict as M +#endif +import Data.Char (isDigit) +import Data.Either.Combinators (whenLeft) import Data.Ini.Config +import Data.RPM.NVR (nvrVerRel) +import Data.RPM.VerRel (showVerRel) +import Data.Tuple.Extra (first) +import Distribution.Fedora.Branch (getFedoraBranches, getFedoraBranched) import Network.HTTP.Query (lookupKey, lookupKey') import System.Environment.XDG.BaseDir (getUserConfigDir) import System.Time.Extra (sleep) import Web.Fedora.Copr (coprChroots, fedoraCopr) -import Web.Fedora.Copr.API (coprGetBuild) +import Web.Fedora.Copr.API (coprGetBuild, coprGetBuildList, coprMonitorProject) import Branches import Common import Common.System import qualified Common.Text as T import Package -import RpmBuild (generateSrpm) +import RpmBuild (generateSrpmNoDist) import Types (Archs(..)) -data BuildBy = SingleBuild | ValidateByRelease | ValidateByArch | BuildByRelease - deriving (Eq) +data BuildBy = SingleBuild + | ValidateByRelease + | ValidateByArch + | BuildByRelease + deriving Eq coprServer :: String coprServer = "copr.fedorainfracloud.org" +data Chroot = Chroot { chrootBranch :: Branch + , chrootArch :: Arch } + deriving Eq + +releaseToBranch :: String -> Branch +releaseToBranch release + | "fedora-" `isPrefixOf` release = + case dropPrefix "fedora-" release of + "rawhide" -> Rawhide + n | all isDigit n -> Fedora (read n) + | otherwise -> error' $ "unknown fedora release:" +-+ release + | "epel-" `isPrefixOf` release = + let next = "-next" `isSuffixOf` release + in case dropSuffix "-next" (dropPrefix "epel-" release) of + n | all isDigit n -> (if next then EPELNext else EPEL) $ read n + | otherwise -> error' $ "unknown epel release:" +-+ release + | otherwise = error' $ "unknown release:" +-+ release + +branchToRelease :: Branch -> String +branchToRelease Rawhide = "fedora-rawhide" +branchToRelease (Fedora n) = "fedora-" ++ show n +branchToRelease (EPEL n) = "epel-" ++ show n +branchToRelease (EPELNext n) = "epel-" ++ show n ++ "-next" + +readChroot :: String -> Chroot +readChroot ch = + case stripInfixEnd "-" ch of + Nothing -> error' $ "invalid chroot:" +-+ ch + Just (b,a) -> Chroot (releaseToBranch b) (readArch a) + +showChroot :: Chroot -> String +showChroot (Chroot br ar) = branchToRelease br ++ '-' : showArch ar + +data Arch = X86_64 | I686 | AARCH64 | PPC64LE | S390X + deriving (Eq, Enum) + +allCoprArchs :: [Arch] +allCoprArchs = [X86_64 ..] + +readArch :: String -> Arch +readArch "x86_64" = X86_64 +readArch "i686" = I686 +readArch "aarch64" = AARCH64 +readArch "ppc64le" = PPC64LE +readArch "s390x" = S390X +readArch a = error' $ "unknown arch:" +-+ a + +showArch :: Arch -> String +showArch X86_64 = "x86_64" +showArch I686 = "i686" +showArch AARCH64 = "aarch64" +showArch PPC64LE = "ppc64le" +showArch S390X = "s390x" + +data CoprMode = ListChroots | CoprMonitor | CoprBuild | CoprNew + +-- FIXME take ExclusiveArch/ExcludeArch into account +-- FIXME -1 for only first unbuilt chroot +-- FIXME check branch -- FIXME handle fedora-eln -- FIXME make project optional (if same as pkg??) or configurable ? -- FIXME repo config with a setup command? -- FIXME interact with copr dist-git -- FIXME parallel copr builds --- FIXME --exclude-arch --- FIXME skip existing builds --- FIXME distless srpm -- FIXME time builds? -coprCmd :: Bool -> Bool -> BuildBy -> Maybe Archs -> String +coprCmd :: Bool -> CoprMode -> Bool -> BuildBy -> Maybe Archs -> String -> (BranchesReq,[String]) -> IO () -coprCmd dryrun listchroots buildBy marchs project (breq, pkgs) = do - chroots <- coprGetChroots - if listchroots - then mapM_ putStrLn chroots - else - if null pkgs then do - pkg <- do - dirpkg <- getPackageName "." - exists <- doesFileExist $ packageSpec dirpkg - if exists - then return dirpkg - else Package . takeBaseName <$> findSpecfile - coprBuildPkg chroots False pkg - else - mapM_ (\(n,p) -> withExistingDirectory p $ coprBuildPkg chroots (n>0) (Package p)) $ zip (reverse [0,length pkgs - 1]) pkgs +coprCmd dryrun mode force buildBy marchs project (breq, pkgs) = do + user <- getUsername + case mode of + ListChroots -> coprGetChroots user >>= mapM_ (putStrLn . showChroot) + CoprMonitor -> coprMonitorPackages user project >>= mapM_ printPkgRes + CoprNew -> coprNewProject dryrun project marchs breq pkgs + CoprBuild -> do + chroots <- coprGetChroots user + if null pkgs + then coprBuildPkg user chroots False + else + mapM_ (\(n,p) -> withExistingDirectory p $ coprBuildPkg user chroots (n>0)) $ zip (reverse [0..length pkgs - 1]) pkgs where - coprGetChroots = do - username <- getUsername - chroots <- map T.unpack <$> coprChroots coprServer username project + coprGetChroots :: String -> IO [Chroot] + coprGetChroots user = do + chroots <- map (readChroot . T.unpack) <$> coprChroots coprServer user project when (null chroots) $ - error' $ "No chroots found for" +-+ username ++ "/" ++ project + error' $ "No chroots found for" +-+ user ++ "/" ++ project branches <- case breq of Branches brs -> if null brs - then return $ (map (releaseBranch . T.pack) . nub . map removeArch) chroots + then return $ (nub . map chrootBranch) chroots else listOfBranches False False breq BranchOpt AllFedora -> filter isFedoraBranch <$> getFedoraBranches BranchOpt AllEPEL -> filter isEPELBranch <$> getFedoraBranched @@ -73,64 +144,62 @@ -- FIXME sort archs appropriately case marchs of Nothing -> - [chroot | chroot <- chroots, removeArch chroot `elem` map branchRelease branches] + [chroot | arch <- sortArchs allCoprArchs, br <- branches, let chroot = Chroot br arch, chroot `elem` chroots] + -- FIXME warn about missing arch chroots Just (Archs archs) -> - [chroot | arch <- archs, br <- branches, let chroot = branchRelease br ++ "-" ++ arch, chroot `elem` chroots] + [chroot | arch <- sortArchs (map readArch archs), br <- branches, let chroot = Chroot br arch, chroot `elem` chroots] + -- FIXME warn about missing arch chroots Just (ExcludedArchs exarchs) -> - [chroot | chroot <- chroots, takeArch chroot `notElem` exarchs, removeArch chroot `elem` map branchRelease branches] + [chroot | arch <- sortArchs allCoprArchs, arch `notElem` map readArch exarchs, br <- branches, let chroot = Chroot br arch, chroot `elem` chroots] if null buildroots then error' "No valid chroots" else return buildroots - coprBuildPkg buildroots morepkgs _pkg = do + coprBuildPkg :: String -> [Chroot] -> Bool -> IO () + coprBuildPkg user buildroots morepkgs = do -- FIXME check is pkg.spec + -- was: localBranchSpecFile pkg (RelBranch Rawhide) spec <- findSpecfile -- pkg <- takeFileName <$> getCurrentDirectory - -- hack to avoid generating srpm for dryrun srpm <- if not dryrun - then generateSrpm Nothing spec -- FIXME: let distopt = ["--undefine", "dist"] - else return spec - case buildBy of - SingleBuild -> coprBuild dryrun project srpm spec buildroots - -- FIXME or default to secondary parallel to previous primary - ValidateByRelease -> do - let initialChroots = - let primaryArch = releaseArch $ head buildroots - in map pure $ filter (isArch primaryArch) buildroots - remainingChroots = buildroots \\ concat initialChroots - staggerBuilds srpm spec initialChroots remainingChroots - ValidateByArch -> do - let initialChroots = - let newestRelease = removeArch $ head buildroots - in map pure $ filter (newestRelease `isPrefixOf`) buildroots - remainingChroots = buildroots \\ concat initialChroots - staggerBuilds srpm spec initialChroots remainingChroots - BuildByRelease -> do - let releaseChroots = groupBy sameRelease buildroots - staggerBuilds srpm spec releaseChroots [] + then generateSrpmNoDist True False Nothing spec + else return spec -- hack to avoid generating srpm for dryrun + verrel <- showVerRel . nvrVerRel <$> pkgNameVerRelNodist spec + actualpkg <- cmd "rpmspec" ["-q", "--srpm", "--qf", "%{name}", spec] + builtChroots <- existingChrootBuilds user project (Package actualpkg) verrel buildroots + let finalChroots = buildroots \\ if force then [] else map taskChroot builtChroots + if null finalChroots + then putStrLn $ actualpkg ++ '-' : verrel +-+ "built" + else + case buildBy of + SingleBuild -> coprBuild dryrun user project srpm spec finalChroots + -- FIXME or default to secondary parallel to previous primary + ValidateByRelease -> do + let initialChroots = + let primaryArch = chrootArch $ head finalChroots + in map pure $ filter (isArch primaryArch) finalChroots + remainingChroots = finalChroots \\ concat initialChroots + staggerBuilds srpm spec initialChroots remainingChroots + ValidateByArch -> do + let initialChroots = + let newestRelease = chrootBranch $ head finalChroots + in map pure $ filter ((== newestRelease) . chrootBranch) finalChroots + remainingChroots = finalChroots \\ concat initialChroots + staggerBuilds srpm spec initialChroots remainingChroots + BuildByRelease -> do + let releaseChroots = groupBy sameRelease finalChroots + staggerBuilds srpm spec releaseChroots [] when morepkgs putNewLn - - removeArch relarch = init $ dropWhileEnd (/= '-') relarch - takeArch = takeWhileEnd (/= '-') - - staggerBuilds srpm spec initialChroots remainingChroots = do - mapM_ (coprBuild dryrun project srpm spec) initialChroots - unless (null remainingChroots) $ - coprBuild dryrun project srpm spec remainingChroots - - releaseArch = takeWhileEnd (/= '-') - - isArch arch release = releaseArch release == arch - - sameRelease r1 r2 = removeArch r1 == removeArch r2 + where + staggerBuilds :: FilePath -> FilePath -> [[Chroot]] -> [Chroot] -> IO () + staggerBuilds srpm spec initialChroots remainingChroots = do + mapM_ (coprBuild dryrun user project srpm spec) initialChroots + unless (null remainingChroots) $ + coprBuild dryrun user project srpm spec remainingChroots -branchRelease :: Branch -> String -branchRelease Rawhide = "fedora-rawhide" -branchRelease (Fedora n) = "fedora-" ++ show n -branchRelease (EPEL n) = "epel-" ++ show n -branchRelease (EPELNext n) = "epel-" ++ show n ++ "-next" + isArch arch release = chrootArch release == arch ---data Chroot = Chroot Release Arch + sameRelease r1 r2 = chrootBranch r1 == chrootBranch r2 getUsername :: IO String getUsername = do @@ -153,55 +222,174 @@ let config = parseIniFile ini iniparser return $ either error' record config -coprBuild :: Bool -> String -> FilePath -> FilePath -> [String] -> IO () -coprBuild _ _ _ _ [] = error' "No chroots chosen" -coprBuild dryrun project srpm spec buildroots = do - let chrootargs = mconcat [["-r", bldrt] | bldrt <- buildroots] +-- from copr/frontend/coprs_frontend/coprs/logic/builds_logic.py +-- FIXME after adding to copr-api +coprProcessingStates :: [String] +coprProcessingStates = + ["running", "pending", "starting", "importing", "waiting"] + +-- coprEndedStates :: [String] +-- coprEndedStates = +-- ["canceled", "failed", "skipped", "succeeded"] + +-- FIXME restrict to requested chroots? +existingChrootBuilds :: String -> String -> Package -> String -> [Chroot] + -> IO [CoprTask] +existingChrootBuilds user project actualpkg verrel chroots = do + monitorPkgs <- coprMonitorPackages user project + let pkgmonitor = fromMaybe [] $ lookup actualpkg monitorPkgs + let buildingChroots = + filterTasks verrel (`elem` coprProcessingStates) pkgmonitor + if null buildingChroots + then return $ filterTasks verrel (`notElem` ["failed","skipped"]) pkgmonitor + else do + mapM_ printCoprTask buildingChroots + putNewLn + forM_ buildingChroots $ \building -> + when (taskChroot building `elem` chroots) $ + -- FIXME check failure + void $ coprWatchBuild Nothing $ Left building + return buildingChroots + +filterTasks :: String -> (String -> Bool) -> [CoprTask] -> [CoprTask] +filterTasks verrel statustest = + filter (\CoprTask{..} -> taskVerRel == verrel && statustest taskStatus) + +coprBuild :: Bool -> String -> String -> FilePath -> FilePath -> [Chroot] -> IO () +coprBuild _ _ _ _ _ [] = error' "No chroots chosen" +coprBuild dryrun user project srpm spec buildroots = do + let chrootargs = mconcat [["-r", showChroot bldrt] | bldrt <- buildroots] buildargs = ["build", "--nowait"] ++ chrootargs ++ [project, srpm] putNewLn - putStrLn $ unwords buildroots + putStrLn $ unwords $ map showChroot buildroots unless dryrun $ do output <- cmd "copr" buildargs putStrLn output let bid = read $ last $ words $ last $ lines output - ok <- timeIO $ coprWatchBuild bid Nothing + ok <- timeIO $ coprWatchBuild Nothing $ Right bid unless ok $ do putStrLn $ "Failed: copr" +-+ unwords buildargs -- FIXME determine which chroot(s) failed - username <- getUsername -- eg 06482247 let zbid = let s = show bid in (if length s < 8 then ('0' :) else id) s actualpkg <- cmd "rpmspec" ["-q", "--srpm", "--qf", "%{name}", spec] - error' $ "https://download.copr.fedorainfracloud.org/results" +/+ username +/+ project +/+ head buildroots +/+ zbid ++ "-" ++ actualpkg +/+ "builder-live.log.gz" + -- FIXME which chroot? + -- FIXME print buildlog size + error' $ "https://download.copr.fedorainfracloud.org/results" +/+ user +/+ project +/+ showChroot (head buildroots) +/+ zbid ++ "-" ++ actualpkg +/+ "builder-live.log.gz" --- FIXME idea: Maybe Seconds to increment sleep -coprWatchBuild :: Int -> Maybe String -> IO Bool -coprWatchBuild bid mstate = do +-- FIXME idea: Maybe Seconds to increment FIXME +-- sleep should have all chroots in pending CoprTask build +coprWatchBuild :: Maybe String -> Either CoprTask Int -> IO Bool +coprWatchBuild mstate ebuild = do + let bid = either taskBuild id ebuild res <- coprGetBuild fedoraCopr bid case lookupKey "state" res of Just state -> if mstate == Just state - then sleep 20 >> coprWatchBuild bid mstate + then sleep 20 >> coprWatchBuild mstate (Right bid) else do - logMsg $ "Build" +-+ show bid +-+ state + whenLeft ebuild $ \t -> putStrLn $ "#" +-+ showChroot (taskChroot t) + logMsg $ "Build" +-+ show bid +-+ state +-+ either taskVerRel (const "") ebuild case state of "succeeded" -> return True "skipped" -> return True "canceled" -> return False "failed" -> return False - _ -> sleep 1 >> coprWatchBuild bid (Just state) + _ -> sleep 1 >> coprWatchBuild (Just state) (Right bid) Nothing -> do let err = lookupKey' "error" res logMsg $ "Error:" +-+ err return False --- #if !MIN_VERSION_simple_cmd(0,1,4) --- error' :: String -> a --- #if MIN_VERSION_base(4,9,0) --- error' = errorWithoutStackTrace --- #else --- error' = error --- #endif --- #endif +archPriorities :: [(Arch,Int)] +archPriorities = [(X86_64,1), (AARCH64,2)] + +sortArchs :: [Arch] -> [Arch] +sortArchs = sortBy priority + where + priority a1 a2 = + let mp1 = lookup a1 archPriorities + mp2 = lookup a2 archPriorities + in + case (mp1,mp2) of + (Just p1,Just p2) -> + compare p1 p2 + (Just _, Nothing) -> LT + (Nothing, Just _) -> GT + (Nothing,Nothing) -> EQ + +type CoprPackage = (Package,[CoprTask]) + +data CoprTask = CoprTask {taskChroot :: Chroot, + taskBuild :: Int, + taskStatus :: String, + taskVerRel :: String + } + +-- FIXME wait for None package to appear +coprMonitorPackages :: String -> String -> IO [CoprPackage] +coprMonitorPackages user proj = do + builds <- coprGetBuildList fedoraCopr user proj [] + mapM_ coprWaitPackage (lookupKey' "items" builds :: [Object]) + mapMaybe pkgResults . lookupKey' "packages" <$> + coprMonitorProject fedoraCopr user proj [] + where + pkgResults :: Object -> Maybe CoprPackage + pkgResults obj = do + name <- lookupKey "name" obj + chroots <- map (first toText) . M.toList <$> lookupKey "chroots" obj + return (Package name, mapMaybe chrootResult chroots) +#if !MIN_VERSION_aeson(2,0,0) + where toText = id +#endif + + chrootResult :: (T.Text,Object) -> Maybe CoprTask + chrootResult (chroot, obj) = do + state <- lookupKey "state" obj + version <- lookupKey "pkg_version" obj + build <- lookupKey "build_id" obj + return $ CoprTask (readChroot (T.unpack chroot)) build state version + +printPkgRes :: (Package, [CoprTask]) -> IO () +printPkgRes (pkg,chroots) = do + putStrLn $ "# " <> unPackage pkg + mapM_ printCoprTask chroots + putNewLn + +printCoprTask :: CoprTask -> IO () +printCoprTask (CoprTask chr build status version) = + putStrLn $ showChroot chr +-+ show build ++ ":" +-+ status +-+ version + +coprWaitPackage :: Object -> IO () +coprWaitPackage build = do + case buildResult of + Nothing -> error' "unknown source_package" + Just (_, "failed", _) -> return () + Just (_, _, Just _pkg) -> return () + Just (bid, _, Nothing) -> do + sleep 5 + print bid + coprGetBuild fedoraCopr bid >>= coprWaitPackage + where + buildResult = do + bid <- lookupKey "id" build + source <- lookupKey "source_package" build + state <- lookupKey "state" build + let mname = lookupKey "name" source + return (bid :: Int, state :: String, mname :: Maybe String) + +coprNewProject :: Bool -> String -> Maybe Archs -> BranchesReq -> [String] + -> IO () +coprNewProject dryrun project marchs breq pkgs = do + branches <- listOfBranches False False breq + let archs = + case marchs of + Nothing -> [X86_64] + Just (Archs as) -> map readArch as + Just (ExcludedArchs eas) -> allCoprArchs \\ map readArch eas + let chroots = [ Chroot b a | b <- branches, a <- archs] + (if dryrun then cmdN else cmd_) "copr" $ "create" : concatMap (\ch -> ["--chroot", showChroot ch]) chroots ++ [project] + unless (null pkgs) $ + coprCmd False CoprBuild False ValidateByRelease Nothing project (breq, pkgs) diff --git a/src/Cmd/Diff.hs b/src/Cmd/Diff.hs --- a/src/Cmd/Diff.hs +++ b/src/Cmd/Diff.hs @@ -28,9 +28,9 @@ -- FIXME diff other branches without switching -- FIXME --older/--newer branch -diffCmd :: Bool -> Bool -> DiffWork -> DiffFormat -> Bool -> Maybe DiffFilter +diffCmd :: Bool -> Bool -> DiffWork -> DiffFormat -> Bool -> [DiffFilter] -> Maybe AnyBranch -> (Maybe Branch,[String]) -> IO () -diffCmd debug speconly work fmt ignorebumps mpatt mwbr = +diffCmd debug speconly work fmt ignorebumps patts mwbr = withPackagesMaybeBranch (if debug then HeaderMust else HeaderNone) False dirtyGit diffPkg where diffPkg :: Package -> AnyBranch -> IO () @@ -91,7 +91,7 @@ (RelBranch rwbr, RelBranch rbr) -> ["-R" | rwbr > rbr] _ -> [] diff <- gitLines "diff" $ contxt ++ workOpts ++ revdiff ++ withBranch ++ workArgs ++ file - let diffout = (maybe id filterPattern mpatt . simplifyDiff fmt) diff + let diffout = (mapMaybe (filterPatterns patts) . simplifyDiff fmt) diff -- FIXME: sometimes we may want to list even if diff but no diffout unless (null diffout) $ unless (ignorebumps && isTrivialRebuildCommit diffout) $ @@ -107,7 +107,11 @@ simplifyDiff DiffStats ds = if null ds then ds else init ds simplifyDiff _ ds = ds - filterPattern :: DiffFilter -> [String] -> [String] - filterPattern (DiffMatch patt) = filter (patt `isInfixOf`) - filterPattern (DiffNotMatch patt) = filter (not . (patt `isInfixOf`)) - -- void $ runProcess $ setStderr nullStream $ proc "grep" [pat, file] + filterPatterns :: [DiffFilter] -> String -> Maybe String + filterPatterns [] str = Just str + filterPatterns (df:dfs) str = + if filterPattern df str then filterPatterns dfs str else Nothing + + filterPattern :: DiffFilter -> String -> Bool + filterPattern (DiffMatch patt) = (patt `isInfixOf`) + filterPattern (DiffNotMatch patt) = not . (patt `isInfixOf`) diff --git a/src/Cmd/FTBFS.hs b/src/Cmd/FTBFS.hs --- a/src/Cmd/FTBFS.hs +++ b/src/Cmd/FTBFS.hs @@ -86,7 +86,7 @@ print status case status of BuildFailed -> do - cmdLog "koji-tool" ["tasks", "-T", "-s", "fail", "-b", showNVR nvr] + cmdLog "koji-tool" ["tasks", "--details", "-T", "-s", "fail", "-b", showNVR nvr] putNewLn BuildComplete -> do if bugStatus bug `elem` ["NEW", "ASSIGNED", "POST"] diff --git a/src/Cmd/Fetch.hs b/src/Cmd/Fetch.hs new file mode 100644 --- /dev/null +++ b/src/Cmd/Fetch.hs @@ -0,0 +1,21 @@ +module Cmd.Fetch ( + fetchPkgs + ) +where + +import Branches +import Git +import Package + +fetchPkgs :: [String] -> IO () +fetchPkgs args = + withPackagesByBranches + (if length args > 1 then HeaderMust else HeaderMay) + False + dirtyGit + Zero + fetchPkg (Branches [],args) + where + fetchPkg :: Package -> AnyBranch -> IO () + fetchPkg _pkg _br = + gitFetchSilent False diff --git a/src/Cmd/Import.hs b/src/Cmd/Import.hs --- a/src/Cmd/Import.hs +++ b/src/Cmd/Import.hs @@ -1,6 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} -module Cmd.Import (importCmd) where +module Cmd.Import ( + importCmd, + downloadReviewSRPM, + upstreamDir + ) +where import Common import Common.System @@ -48,52 +53,95 @@ -- FIXME get session from importPkgs (bid,session) <- approvedReviewBugIdSession pkg putBugId bid - putNewLn - comments <- getComments session bid - mapM_ showComment comments - putNewLn - putStr "Review bug: " - putBugId bid - putNewLn - promptEnter "Press Enter to continue" - let srpms = map (T.replace "/reviews//" "/reviews/") $ concatMap findSRPMs comments - mapM_ T.putStrLn srpms - case (filter (".src.rpm" `isSuffixOf`) . words . T.unpack . last) srpms of - [] -> error' "no srpm filename found" - srcrpms -> - case filter (isURI . maybeEncodeURI) srcrpms of - [] -> error "no valid srpm urls found" - [srpmurl] -> do - let srpmfile = takeFileName srpmurl - -- FIXME if havesrpm then print local filename - promptEnter $ "Press Enter to import" +-+ srpmfile - havesrpm <- doesFileExist srpmfile - unless havesrpm $ - cmd_ "curl" ["--silent", "--show-error", "--remote-name", srpmurl] - krbTicket - fedpkg_ "import" [srpmfile] - git_ "commit" ["--message", "import rhbz#" ++ show bid] - nvr <- pkgNameVerRel' Rawhide (pkg <.> "spec") - ok <- yesNoDefault True $ "Press Enter to push and build" +-+ showNVR nvr - when ok $ do - gitPush True Nothing - -- FIXME build more branches - kojiBuildBranch "rawhide" (Package pkg) Nothing ["--fail-fast"] - putBugBuild False session bid nvr - existing <- fedoraBranchesNoRawhide (localBranches False) - when (null existing) $ do - brs <- getRequestedBranches [] breq - requestPkgBranches False False mock (Branches brs) (Package pkg) - srpmurls -> error' $ "multiple srpm urls:" +-+ unwords srpmurls + srpmfile <- downloadReviewSRPM False True pkg bid session + promptEnter $ "Press Enter to import" +-+ srpmfile + krbTicket + fedpkg_ "import" [srpmfile] + git_ "commit" ["--message", "import rhbz#" ++ show bid] + nvr <- pkgNameVerRel' Rawhide (pkg <.> "spec") + ok <- yesNoDefault True $ "Press Enter to push and build" +-+ showNVR nvr + when ok $ do + gitPush True Nothing + -- FIXME build more branches + kojiBuildBranch "rawhide" (Package pkg) Nothing ["--fail-fast"] + putBugBuild False session bid nvr + existing <- fedoraBranchesNoRawhide (localBranches False) + when (null existing) $ do + brs <- getRequestedBranches [] breq + unless (null brs) $ + requestPkgBranches False False mock (Branches brs) (Package pkg) when (pkg /= takeFileName dir) $ setCurrentDirectory dir - where - findSRPMs :: Comment -> [T.Text] - findSRPMs = - filter (\ l -> "https://" `T.isInfixOf` l && any (`T.isPrefixOf` T.toLower l) ["srpm url:", "srpm:", "new srpm:", "updated srpm:"] && ".src.rpm" `T.isSuffixOf` l) . T.lines . commentText +downloadReviewSRPM :: Bool -> Bool -> String -> Int -> BugzillaSession + -> IO FilePath +downloadReviewSRPM getspec prompt pkg bid session = do + putNewLn + comments <- getComments session bid + mapM_ showComment comments + putNewLn + putStr "Review bug: " + putBugId bid + putNewLn + when prompt $ + promptEnter "Press Enter to continue" + when getspec $ + downloadSpec comments + let srpms = map (T.replace "/reviews//" "/reviews/") $ concatMap findSRPMs comments + mapM_ T.putStrLn srpms + unless (null srpms) putNewLn + downloadSRPM (last srpms) + where + findSRPMs :: Comment -> [T.Text] + findSRPMs = + filter (\ l -> "https://" `T.isInfixOf` l && any (`T.isPrefixOf` T.toLower l) ["srpm url:", "srpm:", "new srpm:", "updated srpm:"] && ".src.rpm" `T.isSuffixOf` l) . T.lines . commentText - maybeEncodeURI cs = - if '%' `elem` cs - then cs - else escapeURIString isUnescapedInURI cs + findSpecs :: Comment -> [T.Text] + findSpecs = + filter (\ l -> "https://" `T.isInfixOf` l && any (`T.isPrefixOf` T.toLower l) ["spec url:", "spec:", "new spec:", "updated spec:"] && T.pack (pkg <.> "spec") `T.isSuffixOf` l) . T.lines . commentText + + maybeEncodeURI cs = + if '%' `elem` cs + then cs + else escapeURIString isUnescapedInURI cs + + downloadSRPM :: T.Text -> IO FilePath + downloadSRPM srpm = do + case (filter (".src.rpm" `isSuffixOf`) . words . T.unpack) srpm of + [] -> error' "no srpm filename found" + srcrpms -> + case filter (isURI . maybeEncodeURI) srcrpms of + [] -> error "no valid srpm urls found" + [srpmurl] -> do + let srpmfile = takeFileName srpmurl + -- FIXME if havesrpm then print local filename + havesrpm <- doesFileExist srpmfile + if havesrpm + then putStrLn $ srpmfile +-+ "already exists" + else + -- was "--silent" + cmd_ "curl" ["--show-error", "--remote-name", srpmurl] + return srpmfile + srpmurls -> error' $ "multiple srpm urls:" +-+ unwords srpmurls + + downloadSpec :: [Comment] -> IO () + downloadSpec comments = do + let specs = map (T.replace "/reviews//" "/reviews/") $ concatMap findSpecs comments + mapM_ T.putStrLn specs + unless (null specs) putNewLn + case (filter ((pkg <.> "spec") `isSuffixOf`) . words . T.unpack . last) specs of + [] -> error' "no spec filename found" + specfiles -> + case filter (isURI . maybeEncodeURI) specfiles of + [] -> error "no valid spec urls found" + [specurl] -> do + let specfile = upstreamDir takeFileName specurl + havespec <- doesFileExist specfile + if havespec + then putStrLn $ specfile +-+ "already exists" + else + cmd_ "curl" ["--silent", "--show-error", "--create-dirs", "--output", specfile, specurl] + specurls -> error' $ "multiple spec urls:" +-+ unwords specurls + +upstreamDir :: FilePath +upstreamDir = "UPSTREAM" diff --git a/src/Cmd/Install.hs b/src/Cmd/Install.hs --- a/src/Cmd/Install.hs +++ b/src/Cmd/Install.hs @@ -2,14 +2,12 @@ module Cmd.Install ( installCmd, - notInstalledCmd + notInstalledCmd, + Select(..) ) where import Data.RPM -#if !MIN_VERSION_simple_cmd(0,2,7) -import System.Posix.User (getEffectiveUserID) -#endif -import SimplePrompt (promptEnter) +import SelectRPMs import Branches import Cmd.Merge @@ -29,8 +27,9 @@ -- FIXME --check any/all of package installed -- FIXME add --debug or respect --verbose for dnf commands installCmd :: Bool -> Bool -> Maybe Branch -> Maybe ForceShort -> [BCond] - -> Bool -> Bool -> Bool -> Bool -> (Maybe Branch,[String]) -> IO () -installCmd quiet recurse mfrom mforceshort bconds reinstall nobuild nobuilddeps allsubpkgs (mbr, pkgs) = do + -> Bool -> Bool -> Bool -> Select -> (Maybe Branch,[String]) + -> IO () +installCmd quiet recurse mfrom mforceshort bconds reinstall nobuild nobuilddeps select (mbr, pkgs) = do when (recurse && isShortCircuit mforceshort) $ error' "cannot use --recurse and --shortcircuit" withPackagesMaybeBranch (boolHeader (recurse || length pkgs > 1)) True Nothing installPkg (mbr, pkgs) @@ -49,15 +48,16 @@ mergeCmd False False True Nothing False mfrom (Branches [onlyRelBranch br], ["."]) localBranchSpecFile pkg br rpms <- builtRpms br spec - -- removing arch let nvras = map readNVRA rpms + -- FIXME can this be removed now? already <- filterM nvraInstalled nvras if isJust mforceshort || null already || reinstall - then doInstallPkg mforceshort spec rpms already + then doInstallPkg mforceshort spec rpms else putStrLn $ unlines (map showNVRA already) ++ "\nalready installed!\n" where - doInstallPkg mforceshort' spec rpms already = do + doInstallPkg mforceshort' spec rpms = do + -- FIXME show source NVR (eg not pandoc-common) putStrLn $ (showNVR . dropArch . readNVRA) (head rpms) unless (nobuilddeps || nobuild) $ do missingdeps <- nub <$> (buildRequires spec >>= filterM notInstalled) @@ -71,40 +71,22 @@ mpkgdir <- lookForPkgDir rbr ".." dep case mpkgdir of Nothing -> putStrLn $ dep +-+ "not known" - Just pkgdir -> installCmd quiet recurse mfrom mforceshort bconds reinstall nobuild nobuilddeps allsubpkgs (mbr, [pkgdir]) >> putNewLn + Just pkgdir -> installCmd quiet recurse mfrom mforceshort bconds reinstall nobuild nobuilddeps select (mbr, [pkgdir]) >> putNewLn -- FIXME option to enable/disable installing missing deps -- FIXME --skip-missing-deps or prompt else installDeps True spec - wasbuilt <- + -- FIXME unused + _wasbuilt <- if nobuild then return True else buildRPMs quiet False False mforceshort' bconds rpms br spec unless (isShortCircuit mforceshort') $ do - toinstalls <- - if allsubpkgs - then return rpms - else do - ps <- filterM (pkgInstalled . rpmName . readNVRA) rpms - return $ if null ps then rpms else ps - if reinstall || mforceshort' == Just ForceBuild - then do - let reinstalls = - filter (\ f -> readNVRA f `elem` already) toinstalls - unless (null reinstalls) $ - sudoLog "/usr/bin/dnf" $ "reinstall" : "-q" : "-y" : reinstalls - let remaining = filterDebug $ toinstalls \\ reinstalls - unless (null remaining) $ - sudoLog "/usr/bin/dnf" $ "install" : "-q" : "-y" : remaining - else do - let command = "/usr/bin/dnf" : "install" : "-q" : "-y" : filterDebug toinstalls - cmdN "sudo" command - ok <- cmdBool "sudo" command - unless ok $ - if wasbuilt - then error' $ "error from:" +-+ unwords command - else do - promptEnter "Press Enter to rebuild package" - doInstallPkg (Just ForceBuild) spec rpms already + let nvras = rpmsToNVRAs rpms + -- FIXME: prefix = fromMaybe (nvrName nvr) mprefix + decided <- decideRPMs No False Nothing select (unPackage pkg) nvras + -- FIXME dryrun and debug + -- FIXME return Bool? + installRPMs False False Nothing No $ groupOnArch "RPMS" decided lookForPkgDir :: Branch -> FilePath -> String -> IO (Maybe FilePath) lookForPkgDir rbr topdir p = do @@ -133,8 +115,6 @@ sysbr <- systemBranch repoquery sysbr rbr ["--qf=%{source_name}", "--whatprovides", p] - filterDebug = filter (\p -> not (any (`isInfixOf` p) ["-debuginfo-", "-debugsource-"])) - notInstalledCmd :: (Maybe Branch,[String]) -> IO () notInstalledCmd = withPackagesMaybeBranchNoHeadergit notInstalledPkg @@ -161,21 +141,3 @@ pkgInstalled :: String -> IO Bool pkgInstalled pkg = cmdBool "rpm" ["--quiet", "-q", pkg] - -#if !MIN_VERSION_simple_cmd(0,2,7) -sudoLog :: String -- ^ command - -> [String] -- ^ arguments - -> IO () -sudoLog = sudoInternal cmdLog - where - sudoInternal :: (String -> [String] -> IO a) -> String -> [String] -> IO a - sudoInternal exc c args = do - uid <- getEffectiveUserID - sd <- if uid == 0 - then return Nothing - else findExecutable "sudo" - let noSudo = isNothing sd - when (uid /= 0 && noSudo) $ - warning "'sudo' not found" - exc (fromMaybe c sd) (if noSudo then args else c:args) -#endif diff --git a/src/Cmd/ListBranches.hs b/src/Cmd/ListBranches.hs --- a/src/Cmd/ListBranches.hs +++ b/src/Cmd/ListBranches.hs @@ -4,10 +4,11 @@ ) where -import Common -import Common.System +import Distribution.Fedora.Branch (getFedoraBranches, readBranch) import Branches +import Common +import Common.System import Git import Package @@ -76,7 +77,10 @@ if breq == Branches [] then do -- FIXME better to filter inactive instead active <- getFedoraBranches - let result = if missing then active \\ mapMaybe readBranch brs else activeBranches active brs + let result = + if missing + then active \\ mapMaybe readBranch brs + else activeBranches active brs putStr $ unPackage pkg ++ ": " putStrLn $ (unwords . map show) result else do diff --git a/src/Cmd/ListPackages.hs b/src/Cmd/ListPackages.hs --- a/src/Cmd/ListPackages.hs +++ b/src/Cmd/ListPackages.hs @@ -9,6 +9,7 @@ import Data.Aeson import Fedora.Pagure +import SimplePrompt (yesNoDefault) import Branches import Common @@ -20,20 +21,31 @@ data Packager = Owner String | Committer String --- FIXME remote/pagures branch and --remote or --no-remote -listCmd :: Bool -> Maybe Packager -> [String] -> IO () -listCmd count mpackager pkgs = do - unless (count || isJust mpackager || not (null pkgs)) $ +-- FIXME remote/pagure branch and --remote or --no-remote +listCmd :: Bool -> Bool -> Maybe Packager -> [String] -> IO () +listCmd force count mpackager pkgs = do + unless (force || count || isJust mpackager || not (null pkgs)) $ error' "Please give a package pattern, --count, or --owner/--username" if null pkgs then listPackage Nothing else mapM_ (listPackage . Just) pkgs where + -- FIXME add default --max-pages? listPackage :: Maybe String -> IO () listPackage mpattern = do let path = "projects" params = makeKey "short" "1" ++ fork ++ packager ++ makeKey "namespace" "rpms" ++ maybeKey "pattern" mpattern - pages <- queryPaged srcfpo count path params ("pagination", "page") - mapM_ printPage pages + mnum <- queryPagureCount srcfpo path params "pagination" + whenJust mnum $ \num -> + if count + then print num + else do + ok <- + if num > 1000 && not force + then yesNoDefault False $ show num +-+ "results, continue" + else return True + when ok $ do + pages <- queryPagureCountPaged srcfpo False path params ("pagination", "page") + mapM_ printPage pages where packager = case mpackager of @@ -48,17 +60,6 @@ let projects = lookupKey' "projects" result :: [Object] in mapM_ (T.putStrLn . lookupKey' "name") projects - --- FIXME limit max number of pages (10?) or --pages -queryPaged :: String -> Bool -> String -> Query -> (String,String) -> IO [Object] -queryPaged server count path params (pagination,paging) = - if count - then do - mnum <- queryPagureCount server path params pagination - print $ fromMaybe (error' "pages not found") mnum - return [] - else - queryPagurePaged server path params (pagination,paging) -- FIXME add --count listLocalCmd :: (Maybe Branch, [String]) -> IO () diff --git a/src/Cmd/Local.hs b/src/Cmd/Local.hs --- a/src/Cmd/Local.hs +++ b/src/Cmd/Local.hs @@ -1,5 +1,4 @@ module Cmd.Local ( - autospecCmd, commandCmd, countCmd, installDepsCmd, @@ -13,7 +12,7 @@ import qualified Data.ByteString.Lazy.Char8 as B import Data.Char (isDigit) -import System.Environment +import System.Environment (getEnvironment) import qualified System.Process as P import qualified System.Process.Typed as TP import System.Exit @@ -86,11 +85,11 @@ (ret,out) <- TP.readProcessInterleaved $ TP.setEnv (("p",unPackage pkg):curEnv) $ TP.shell cs - unless (B.null out) $ do + whenJust (B.unsnoc out) $ \(bs,l) -> do if compact then putStr $ unPackage pkg ++ ": " else putPkgAnyBrnchHdr pkg br - B.putStr out + B.putStrLn $ if l == '\n' then bs else out return ret else do let p = (P.shell cs) { P.env = Just (("p",unPackage pkg):curEnv) } @@ -171,28 +170,6 @@ return $ subdir spec else error' "failed to extract spec file" else error' $ "no such file:" +-+ srpm - --- FIXME calculate baserelease -autospecCmd :: Bool -> [String] -> IO () -autospecCmd force pkgs = - withPackagesByBranches HeaderMay False cleanGitFetchActive ExactlyOne autospecPkg (Branches [Rawhide], pkgs) - where - autospecPkg :: Package -> AnyBranch -> IO () - autospecPkg _pkg br = do - gitSwitchBranch br - let changelogfile = "changelog" - exists <- doesFileExist changelogfile - if exists - then - if force - then do - cmd "rpmautospec" ["generate-changelog"] >>= - writeFile changelogfile - unlessM (null <$> git "status" ["--porcelain", "--untracked=no"]) $ do - git_ "add" [changelogfile] - git_ "commit" ["-m", "refresh changelog"] - else putStrLn "'changelog' file already exists" - else cmd_ "rpmautospec" ["convert"] moveArtifactsCmd :: Bool -> [String] -> IO () moveArtifactsCmd remove pkgs = diff --git a/src/Cmd/Parallel.hs b/src/Cmd/Parallel.hs --- a/src/Cmd/Parallel.hs +++ b/src/Cmd/Parallel.hs @@ -8,9 +8,12 @@ import Common.System import Control.Concurrent.Async +import Control.Exception.Extra (retry) import Data.RPM.NVR (NVR) +import Distribution.Fedora.Branch (branchDestTag, branchTarget) import Distribution.RPM.Build.Order (dependencyLayersRpmOpts) import Fedora.Bodhi hiding (bodhiUpdate) +import Say import SimplePrompt (prompt, promptEnter, yesNo) import System.Console.Pretty import System.Time.Extra (sleep) @@ -35,7 +38,6 @@ -- FIXME offer to untag overrides afterwards -- FIXME merge --from --- FIXME print koji url of failed process or use koji-tool -- FIXME option to build multiple packages over branches in parallel -- FIXME use --wait-build=NVR -- FIXME check sources as early as possible @@ -45,10 +47,11 @@ -- FIXME support non-sidetag update for parallel packages -- FIXME print layers if few packages? -- FIXME push update -parallelBuildCmd :: Bool -> Maybe Bool -> Int -> Maybe SideTagTarget -> Double - -> (Maybe UpdateType, UpdateSeverity) +-- FIXME use more say +parallelBuildCmd :: Bool -> Maybe Bool -> Int -> Maybe SideTagTarget -> Bool + -> Double -> (Maybe UpdateType, UpdateSeverity) -> (BranchesReq, [String]) -> IO () -parallelBuildCmd dryrun mmerge firstlayer msidetagTarget delay mupdate (breq, pkgs) = +parallelBuildCmd dryrun mmerge firstlayer msidetagTarget mustpush delay mupdate (breq, pkgs) = do branches <- case pkgs of @@ -67,8 +70,9 @@ error' "You can only specify target with one branch" case pkgs of [] -> getPackageName "." >>= parallelBranches branches - [p] -> withExistingDirectory p $ - getPackageName p >>= parallelBranches branches + [p] | length branches > 1 -> + withExistingDirectory p $ + getPackageName p >>= parallelBranches branches _ -> forM_ branches $ \rbr -> do mtargetSidetag <- @@ -84,14 +88,14 @@ return $ Just (Target tag) _ -> error' $ "multiple existing sidetags:" +-+ show tags else return msidetagTarget - forM_ pkgs $ \p -> + forM_ (filter (/= ":") pkgs) $ \p -> when (mmerge /= Just False) $ withExistingDirectory p $ do pkg <- getPackageName p mergeNewerBranch (Just pkg) rbr getDynSourcesMacros $ packageSpec pkg distopts <- distRpmOptions rbr - allLayers <- dependencyLayersRpmOpts distopts pkgs + allLayers <- getLayers distopts pkgs let layers = drop firstlayer allLayers when (isNothing msidetagTarget && length allLayers > 1) $ unlessM (checkAutoBodhiUpdate rbr) $ @@ -230,7 +234,7 @@ Just (Left except) -> do print except let pkg = fst job - putStrLn $ "**" +-+ color Magenta pkg +-+ "job" +-+ color Magenta "failed" +-+ "**" +-+ if singlejob then "" else "(" ++ plural (length jobs) "job" +-+ "left" +-+ maybe "" (\l -> "in layer" +-+ show l) mlayer ++ ")" + sayString $ "**" +-+ color Magenta pkg +-+ "job" +-+ color Magenta "failed" +-+ "**" +-+ if singlejob then "" else "(" ++ plural (length jobs) "job" +-+ "left" +-+ maybe "" (\l -> "in layer" +-+ show l) mlayer ++ ")" watchJobs singlejob mlayer (pkg : fails) dones jobs -- FIXME prefix output with package name @@ -245,7 +249,13 @@ checkForSpecFile spec nvr <- pkgNameVerRel' br spec unpushed <- gitOneLineLog $ "origin/" ++ show br ++ "..HEAD" - unless (null unpushed) $ do + if null unpushed + then + when mustpush $ do + ok <- yesNo "Nothing to push, okay to continue" + unless ok $ + error' "no commits with --must-push" + else do putStrLn $ showNVR nvr +-+ "(" ++ target ++ ")" +-+ if nopkgs > 1 then pluralException n (if morelayers then Nothing else Just "last") "more" "more" +-+ maybe "" (\l -> "in layer" +-+ show l) mlayer @@ -267,7 +277,7 @@ case buildstatus of Just BuildComplete -> do -- FIXME detect old stable existing build - putStrLn $ color Green (showNVR nvr) +-+ "is already" +-+ color Green "built" + sayString $ color Green (showNVR nvr) +-+ "is already" +-+ color Green "built" when (br /= Rawhide && morelayers && target == branchTarget br) $ do tags <- kojiNVRTags nvr unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $ @@ -278,7 +288,7 @@ kojiWaitRepo dryrun (nopkgs > 5) True target nvr return $ Done pkg nvr br changelog Just BuildBuilding -> do - putStrLn $ color Yellow (showNVR nvr) +-+ "is already" +-+ color Yellow "building" + sayString $ color Yellow (showNVR nvr) +-+ "is already" +-+ color Yellow "building" mtask <- kojiGetBuildTaskID fedoraHub $ showNVR nvr case mtask of Nothing -> error' $ "Task for" +-+ showNVR nvr +-+ "not found" @@ -317,17 +327,17 @@ kojiWaitTaskAndRepo (isNothing mlatest) nvr task return $ Done pkg nvr br changelog where + -- throws error on build failure kojiWaitTaskAndRepo :: Bool -> NVR -> TaskID -> IO () kojiWaitTaskAndRepo newpkg nvr task = do - finish <- kojiWaitTask task + finish <- retry 3 $ kojiWaitTask task if finish - then putStrLn $ color Green $ showNVR nvr +-+ "build success" + then sayString $ color Green $ showNVR nvr +-+ "build success" -- FIXME print koji task url else do whenJustM (findExecutable "koji-tool") $ \kojitool -> -- FIXME cmdLog deprecated - -- FIXME use --children (koji-tool-1.1.2) - cmdLog kojitool ["tasks", displayID task, "-s", "fail"] + cmdLog kojitool ["tasks", "--children", displayID task, "-s", "fail"] error' $ color Red $ showNVR nvr +-+ "build failed" autoupdate <- checkAutoBodhiUpdate br if autoupdate then @@ -380,3 +390,10 @@ Nothing -> error' "could not determine Update id" Just _updateid -> return () _ -> error' $ "impossible happened: more than one update found for" +-+ showNVR (last nvrs) + +getLayers :: [String] -> [String] -> IO [[String]] +getLayers distopts pkgs = + if ":" `elem` pkgs + -- FIXME check no interdeps + then return $ splitOn [":"] pkgs + else dependencyLayersRpmOpts distopts pkgs diff --git a/src/Cmd/PkgReview.hs b/src/Cmd/PkgReview.hs --- a/src/Cmd/PkgReview.hs +++ b/src/Cmd/PkgReview.hs @@ -3,8 +3,7 @@ module Cmd.PkgReview ( createReview, updateReview, - ScratchOption(..), - reviewPackage + ScratchOption(..) ) where import Common @@ -21,6 +20,7 @@ import Krb import Package import RpmBuild +import Types (ChangeType(ChangeReview)) data ScratchOption = ScratchBuild | ScratchTask Int | SkipScratch deriving Eq @@ -100,9 +100,9 @@ error' "This NVR was already posted on the review bug: please bump" mockRpmLint mock pkg spec srpm (mkojiurl,specSrpmUrls) <- buildAndUpload mscratchOpt srpm pkg spec - changelog <- changeLogPrompt False spec + changelog <- changeLogPrompt ChangeReview spec commentBug session bid (specSrpmUrls <> (if null changelog then "" else "\n\n" <> changelog) <> maybe "" ("\n\nKoji scratch build: " <>) mkojiurl) - -- putStrLn "Review bug updated" + putBugId bid where checkLocalFile :: FilePath -> IO FilePath checkLocalFile f = @@ -144,27 +144,3 @@ builtRpms (RelBranch Rawhide) spec >>= filterM doesFileExist -- FIXME parse # of errors/warnings void $ cmdBool "rpmlint" $ spec:srpm:rpms - --- FIXME does not work with pkg dir/spec: --- 'fbrnch: No spec file found' --- FIXME: option to only download/prep files -reviewPackage :: Maybe String -> IO () -reviewPackage Nothing = do - -- FIXME catch no spec file - spec <- findSpecfile - srpm <- generateSrpm Nothing spec - cmd_ "fedora-review" ["-rn", srpm] -reviewPackage (Just pkgbug) = do - bugs <- bugsAnon $ - if all isDigit pkgbug - then packageReview .&&. statusNewAssigned .&&. bugIdIs (read pkgbug) - else pkgReviews pkgbug .&&. statusNewAssigned - case bugs of - [bug] -> do - putReviewBug False bug - promptEnter "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)] - [] -> error' $ "No package review found for" +-+ pkgbug - _ -> error' $ "More than one review bug found for" +-+ pkgbug diff --git a/src/Cmd/Prep.hs b/src/Cmd/Prep.hs --- a/src/Cmd/Prep.hs +++ b/src/Cmd/Prep.hs @@ -16,11 +16,12 @@ deriving Eq -- FIXME prompt for cloning -prepCmd :: Maybe PrepPre -> Bool -> Bool -> (Maybe Branch,[String]) -> IO () -prepCmd mpre verbose deps (mbr,pkgs) = do +prepCmd :: Maybe PrepPre -> Bool -> Bool -> Bool -> (Maybe Branch,[String]) + -> IO () +prepCmd mpre verbose deps allowhead (mbr,pkgs) = do when (mpre == Just PrepClone) $ - cloneCmd (ClonePkgs (mbr, pkgs)) - withPackagesMaybeBranchNoHeadergit prepPackage (mbr,pkgs) + cloneCmd mbr (ClonePkgs pkgs) + withPackagesMaybeBranch HeaderNone False (if allowhead then dirtyGitHEAD else Nothing) prepPackage (mbr,pkgs) where prepPackage :: Package -> AnyBranch -> IO () prepPackage pkg br = do @@ -33,7 +34,7 @@ putStr $ unPackage pkg ++ ": " putStrLn "dead.package" else do - spec <- localBranchSpecFile pkg br + spec <- if allowhead then findSpecfile else localBranchSpecFile pkg br unlessM (doesFileExist spec) $ error' $ spec +-+ "not found" getSourcesMacros spec @@ -45,6 +46,11 @@ -- newline avoids error starting on same line putStr $ "Prepping" +-+ showNVR nvr ++ ": " _ -> return () + sourcediropt <- do + distgit <- isGitRepo + if distgit + then sourceDirCwdOpt + else return [] timeIO $ - (if verbose then cmdLog else cmdSilent') "rpmbuild" $ "-bp" : ["--nodeps" | not deps] ++ [spec] + (if verbose then cmdLog else cmdSilent') "rpmbuild" $ "-bp" : ["--nodeps" | not deps] ++ sourcediropt ++ [spec] putStrLn "done" diff --git a/src/Cmd/Pull.hs b/src/Cmd/Pull.hs new file mode 100644 --- /dev/null +++ b/src/Cmd/Pull.hs @@ -0,0 +1,56 @@ +module Cmd.Pull ( + pullPkgs, + PullOpt(..) + ) +where + +import Branches +import Common +--import Common.System (error') +import Git +import Package + +data PullOpt = + PullLenient | PullNoFetch | PullStash | PullRebase + deriving Eq + +-- FIXME pulling more than one branch +-- FIXME print nvr after pulling or old -> new +pullPkgs :: Maybe PullOpt -> (BranchesReq, [String]) -> IO () +pullPkgs pullopt (breq,args) = + withPackagesByBranches + (if length args > 1 then HeaderMust else HeaderMay) + False + (case pullopt of + Just PullLenient -> Nothing + Just PullRebase -> Nothing -- FIXME + Just PullNoFetch -> cleanGit + Just PullStash -> stashGitFetch + Nothing -> cleanGitFetch) + AnyNumber pullPkg (breq,args) + where + pullPkg :: Package -> AnyBranch -> IO () + pullPkg pkg br = + if pullopt == Just PullLenient + then do + haveGit <- isPkgGitRepo + if haveGit + then gitFetchSilent True + else putStrLn $ "ignoring" +-+ unPackage pkg + else doPullPkg + where + -- FIXME using rebase for branched may be risky + doPullPkg :: IO () + doPullPkg = do + current <- getReleaseBranchWarn + unless (breq == Branches [] || RelBranch current == br) $ + gitSwitchBranch br + if pullopt == Just PullRebase + then git_ "pull" ["origin"] + else gitMergeOrigin current + when (pullopt == Just PullStash) $ do + stashes <- git "stash" ["list"] + case line1 stashes of + (s0,_) | stashedWithFbrnch `isSuffixOf` s0 -> + git_ "stash" ["pop", "--quiet"] + _ -> return () diff --git a/src/Cmd/PullPush.hs b/src/Cmd/PullPush.hs deleted file mode 100644 --- a/src/Cmd/PullPush.hs +++ /dev/null @@ -1,79 +0,0 @@ -module Cmd.PullPush ( - pullPkgs, - PullOpts(..), - fetchPkgs, - pushPkgs) -where - -import Branches -import Common -import Common.System (error') -import Git -import Package - -data PullOpts = - PullLenient | PullNoFetch | PullStash - deriving Eq - --- FIXME pulling more than one branch --- FIXME print nvr after pulling or old -> new -pullPkgs :: Maybe PullOpts -> (BranchesReq, [String]) -> IO () -pullPkgs pullopts (breq,args) = - withPackagesByBranches - (if length args > 1 then HeaderMust else HeaderMay) - False - (case pullopts of - Just PullLenient -> Nothing - Just PullNoFetch -> cleanGit - Just PullStash -> stashGitFetch - Nothing -> cleanGitFetch) - AnyNumber pullPkg (breq,args) - where - pullPkg :: Package -> AnyBranch -> IO () - pullPkg pkg br = - if pullopts == Just PullLenient - then do - haveGit <- isPkgGitRepo - if haveGit - then doPullPkg - else putStrLn $ "ignoring" +-+ unPackage pkg - else doPullPkg - where - doPullPkg :: IO () - doPullPkg = do - current <- getReleaseBranchWarn - unless (breq == Branches [] || RelBranch current == br) $ - gitSwitchBranch br - gitMergeOrigin current - when (pullopts == Just PullStash) $ do - stashes <- git "stash" ["list"] - case line1 stashes of - (s0,_) | stashedWithFbrnch `isSuffixOf` s0 -> - git_ "stash" ["pop", "--quiet"] - _ -> return () - -fetchPkgs :: [String] -> IO () -fetchPkgs args = - withPackagesByBranches - (if length args > 1 then HeaderMust else HeaderMay) - False - dirtyGit - Zero - fetchPkg (Branches [],args) - where - fetchPkg :: Package -> AnyBranch -> IO () - fetchPkg _pkg _br = - gitFetchSilent False - -pushPkgs :: Bool -> Bool -> Maybe String -> (BranchesReq, [String]) -> IO () -pushPkgs dryrun nofetch mref (breq, pkgs) = do - when (isJust mref && length pkgs > 1) $ - error' "can only specify ref for single package" - withPackagesByBranches HeaderMust False (if nofetch then cleanGit else cleanGitFetch) AnyNumber pushPkg (breq, pkgs) - where - pushPkg :: Package -> AnyBranch -> IO () - pushPkg _pkg _br = do - whenJustM (gitShortLog1 Nothing) $ putStrLn . showCommit - if dryrun - then checkOnBranch - else gitPush False mref diff --git a/src/Cmd/Push.hs b/src/Cmd/Push.hs new file mode 100644 --- /dev/null +++ b/src/Cmd/Push.hs @@ -0,0 +1,25 @@ +module Cmd.Push ( + pushPkgs + ) +where + +import Control.Monad.Extra (when, whenJustM) +import Data.Maybe (isJust) +import SimpleCmd (error') + +import Branches +import Git +import Package + +pushPkgs :: Bool -> Bool -> Maybe String -> (BranchesReq, [String]) -> IO () +pushPkgs dryrun nofetch mref (breq, pkgs) = do + when (isJust mref && length pkgs > 1) $ + error' "can only specify ref for single package" + withPackagesByBranches HeaderMust False (if nofetch then cleanGit else cleanGitFetch) AnyNumber pushPkg (breq, pkgs) + where + pushPkg :: Package -> AnyBranch -> IO () + pushPkg _pkg br = do + whenJustM (gitShortLog1 $ Just $ "origin/" ++ show br ++ "..HEAD") $ putStrLn . showCommit + if dryrun + then checkOnBranch + else gitPush False mref diff --git a/src/Cmd/RequestRepo.hs b/src/Cmd/RequestRepo.hs --- a/src/Cmd/RequestRepo.hs +++ b/src/Cmd/RequestRepo.hs @@ -2,33 +2,34 @@ module Cmd.RequestRepo (requestRepos) where -import Common -import qualified Common.Text as T - +import Control.Exception.Extra (retry) import Network.HTTP.Directory (httpExists, httpManager) import SimpleCmd import SimplePrompt (promptEnter, promptInitial) import Branches import Bugzilla +import Common +import qualified Common.Text as T import Krb import ListReviews import Package import Pagure -- FIXME separate pre-checked listReviews and direct pkg call, which needs checks -requestRepos :: Bool -> Bool -> Bool -> (BranchesReq, [String]) -> IO () -requestRepos mock allstates retry (breq, ps) = do - when (retry && length ps /= 1) $ - error' "--retry only for a single package" +requestRepos :: Bool -> Bool -> Bool -> Bool -> (BranchesReq, [String]) + -> IO () +requestRepos mock allstates skipcheck resubmit (breq, ps) = do + when (resubmit && length ps /= 1) $ + error' "can only --resubmit for a single package" pkgs <- if null ps then map reviewBugToPackage <$> listReviewsAll allstates ReviewWithoutRepoReq else return ps - mapM_ (requestRepo mock retry breq) pkgs + mapM_ (requestRepo mock skipcheck resubmit breq) pkgs -- FIXME also accept bugid instead -requestRepo :: Bool -> Bool -> BranchesReq -> String -> IO () -requestRepo mock retry breq pkg = do +requestRepo :: Bool -> Bool -> Bool -> BranchesReq -> String -> IO () +requestRepo mock skipcheck resubmit breq pkg = do putStrLn pkg (bug,session) <- approvedReviewBugSession pkg putBug bug @@ -40,14 +41,16 @@ if created then putStrLn "scm repo was already created" else do - requests <- existingRepoRequests + requests <- + if skipcheck then return [] else existingRepoRequests unless (null requests) $ do putStrLn "Request exists:" mapM_ printScmIssue requests - -- don't retry if succeeded - when (retry && pagureIssueCloseStatus (head requests) == Just "Processed") $ + -- don't resubmit if succeeded + -- FIXME head + when (resubmit && pagureIssueCloseStatus (head requests) == Just "Processed") $ error' "The last repo request was already successfully Processed" - when (null requests || retry) $ do + when (null requests || resubmit) $ do checkNoPagureRepo putNewLn comments <- getComments session bid @@ -77,6 +80,7 @@ existingRepoRequests = do fasid <- fasIdFromKrb erecent <- + retry 2 $ pagureListProjectIssueTitlesStatus pagureio "releng/fedora-scm-requests" [makeItem "author" fasid, makeItem "status" "all", diff --git a/src/Cmd/ReviewPackage.hs b/src/Cmd/ReviewPackage.hs new file mode 100644 --- /dev/null +++ b/src/Cmd/ReviewPackage.hs @@ -0,0 +1,127 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Cmd.ReviewPackage ( + reviewPackage + ) where + +import Common +import Common.System + +import Data.Char +import SelectRPMs (selectDefault) +import SimplePrompt (promptEnter, yesNoDefault) + +import Branches +import Bugzilla +import Cmd.Import (downloadReviewSRPM, upstreamDir) +import Cmd.Install (installCmd) +import Cmd.Local (localCmd) +import Git (isGitRepo, git_, gitBool) +import Package +import RpmBuild + +-- FIXME does not work with pkg dir/spec: 'fbrnch: No spec file found' +-- FIXME --user to download all user's review requests +reviewPackage :: Bool -> Maybe String -> IO () +reviewPackage _ Nothing = do + -- FIXME catch no spec file + spec <- findSpecfile + srpm <- generateSrpm Nothing spec + cmd_ "fedora-review" ["-rn", srpm] +reviewPackage interactive (Just pkgbug) = do + let epkgbid = + if all isDigit pkgbug + then Right $ read pkgbug + else Left pkgbug + (bugs,session) <- bugsSession $ + case epkgbid of + Right bid -> packageReview .&&. statusNewAssigned .&&. bugIdIs bid + Left pkg -> pkgReviews pkg .&&. statusNewAssigned + case bugs of + [bug] -> do + putReviewBug False bug + let bid = bugId bug + pkg = reviewBugToPackage bug + if interactive + then reviewPackageInteractive bid pkg session bug + else do + promptEnter "Press Enter to run fedora-review" + -- FIXME support copr build + -- FIXME if toolbox set REVIEW_NO_MOCKGROUP_CHECK + cmd_ "fedora-review" ["-b", show bid] + [] -> error' $ "No package review found for" +-+ pkgbug + _ -> error' $ "More than one review bug found for" +-+ pkgbug + +reviewPackageInteractive :: Int -> String -> BugzillaSession -> Bug -> IO () +reviewPackageInteractive bid pkg session bug = do + let dir = show bid ++ '-' : pkg + -- FIXME check if current directory + exists <- doesDirectoryExist dir + unless exists $ + createDirectory dir + setCurrentDirectory dir + srpm <- downloadReviewSRPM True False pkg bid session + importsrpm <- + if exists + then do + putStrLn $ "in" +-+ dir ":\n" + cmd_ "ls" ["-F"] + putNewLn + -- FIXME default to no if nvr unchanged? + yesNoDefault True "Press Enter to install/prep srpm" + else return True + let spec = pkg <.> "spec" + when importsrpm $ do + isgit <- isGitRepo + unless isgit $ git_ "init" [] + -- FIXME override %_sourcedir so it doesn't put elsewhere? + sourcediropt <- sourceDirCwdOpt + cmd_ "rpm" $ ["-ivh", srpm] ++ sourcediropt + git_ "add" [spec] + allsrcs <- map sourceFieldFile <$> cmdLines "spectool" [spec] + forM_ allsrcs $ \src -> + unless (isArchiveFile src) $ + git_ "add" [src] + putStrLn $ "# Diff with" +-+ upstreamDir + cmd_ "diff" ["-u", spec, upstreamDir spec] + withCurrentDirectory upstreamDir $ + void $ getSources spec + diff <- lines <$> cmdIgnoreErr "diff" ["--brief", ".", upstreamDir] "" + let filterdiff = filter (\d -> not (any (`isSuffixOf` d) ["SPEC","SRPMS","RPMS","BUILD","BUILDROOT","src.rpm",".log", ".git", upstreamDir])) diff + if null filterdiff + then putStrLn $ "no difference with" +-+ upstreamDir ++ "/" + else mapM_ putStrLn filterdiff + unlessM (gitBool "diff" ["--quiet", "--cached"]) $ + git_ "commit" ["-m", srpm] + putStrLn "# Build" + -- FIXME or download rpms + build <- yesNoDefault importsrpm "Build package locally" + when build $ + localCmd False False Nothing [] (Branches [],[]) + putStrLn "# RpmLint" + void $ cmdBool "rpmlint" ["."] -- FIXME $ spec:srpm:rpms + whenM (yesNoDefault importsrpm "Install packages locally") $ do + installCmd False False Nothing Nothing [] False True True selectDefault (Nothing,[]) + rpms <- cmdLines "rpmspec" ["-q", "--rpms", "--qf", "%{name}\n", spec] + whenM (yesNoDefault importsrpm "Rpmlint installed packages") $ do + (_ok, out, err) <- cmdFull "rpmlint" ("-i" : rpms) "" + let rpmlintout = "rpmlint.output" + writeFile rpmlintout out + let nolines = length $ lines out + if nolines > 20 + then do + cmd_ "tail" [rpmlintout] + putStrLn $ show nolines +-+ "lines saved to" +-+ rpmlintout + else putStrLn out + unless (null err) $ warning $ "rpmlint stderr:\n" ++ err + putNewLn + putStrLn "# Licensing" + -- FIXME use build subdir + -- FIXME filter out files not in tarball or prep + cmdLines "licensecheck" ["-r", "BUILD"] >>= + -- handle "FILEPATH: *No copyright* UNKNOWN [generated file]" + mapM_ putStrLn . filter (not . (" UNKNOWN" `isInfixOf`)) + cmd_ "rpmspec" ["-q", "--srpm", "--qf", "Spec license: %{license}\n", spec] + putNewLn + putReviewBug False bug + putStrLn $ "Review dir is" +-+ dir diff --git a/src/Cmd/Reviews.hs b/src/Cmd/Reviews.hs --- a/src/Cmd/Reviews.hs +++ b/src/Cmd/Reviews.hs @@ -9,10 +9,12 @@ -- FIXME add --state or --new, --modified, etc -- FIXME display time of last update -reviewsCmd :: Bool -> Bool -> Bool -> Maybe String -> Maybe String - -> ReviewStatus -> IO () -reviewsCmd short allstates assignee muser mpat status = do - listReviewsFull assignee muser mpat allstates status >>= +reviewsCmd :: Bool -> Bool -> Maybe (Maybe String) -> Maybe (Maybe String) + -> Maybe String -> ReviewStatus -> IO () +reviewsCmd short allstates Nothing Nothing Nothing status = + reviewsCmd short allstates Nothing (Just Nothing) Nothing status +reviewsCmd short allstates mmassignee mmreporter mpat status = do + listReviewsFull mmassignee mmreporter mpat allstates status >>= mapM_ (putReviewBug short) . sortBugsByStatus . sortBugsByID when short putNewLn diff --git a/src/Cmd/Scratch.hs b/src/Cmd/Scratch.hs --- a/src/Cmd/Scratch.hs +++ b/src/Cmd/Scratch.hs @@ -9,6 +9,7 @@ ) where import Data.RPM.NVR (NVR) +import Distribution.Fedora.Branch (branchTarget) import Branches import Common diff --git a/src/Cmd/Sort.hs b/src/Cmd/Sort.hs --- a/src/Cmd/Sort.hs +++ b/src/Cmd/Sort.hs @@ -12,6 +12,7 @@ import Distribution.RPM.Build.Order (dependencySortRpmOpts, dependencySortParallel, dependencyLayers) +import System.Directory (doesFileExist) import Branches import Git @@ -45,7 +46,8 @@ setupPkg :: Package -> AnyBranch -> IO () setupPkg pkg br = do whenM isPkgGitRepo $ gitSwitchBranch br - getDynSourcesMacros $ packageSpec pkg + unlessM (doesFileExist "dead.package") $ + getDynSourcesMacros $ packageSpec pkg toRpmOption :: RpmWith -> [String] toRpmOption (RpmWith opt) = ["--with=" ++ opt] diff --git a/src/Cmd/Status.hs b/src/Cmd/Status.hs --- a/src/Cmd/Status.hs +++ b/src/Cmd/Status.hs @@ -2,8 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} module Cmd.Status ( - statusCmd, - unpushedCmd + statusCmd ) where @@ -13,6 +12,7 @@ import Data.Fixed import Data.Time.Clock import Data.Time.LocalTime +import Distribution.Fedora.Branch (branchDestTag) import Fedora.Bodhi import Bugzilla @@ -26,8 +26,8 @@ -- FIXME --pending -- FIXME handle not cloned (remote only) -- FIXME silence fetching of new branches? (for --reviews etc) -statusCmd :: Bool -> Bool -> (BranchesReq,[String]) -> IO () -statusCmd nofetch reviews (breq, pkgs) = do +statusCmd :: Bool -> Bool -> Bool -> (BranchesReq,[String]) -> IO () +statusCmd nofetch reviews latestcommit (breq, pkgs) = do reviewpkgs <- if reviews then map reviewBugToPackage <$> listReviewsAll True ReviewRepoCreated @@ -39,87 +39,92 @@ statusBranch :: Package -> AnyBranch -> IO () statusBranch _ (OtherBranch _) = error' "status currently only defined for release branches" - statusBranch pkg rbr@(RelBranch br) = do - brExists <- checkIfRemoteBranchExists rbr - if not brExists - then do - name <- getDirectoryName - putStrLn $ name +-+ "has no branch" +-+ show br - else do - gitSwitchBranch rbr - let spec = packageSpec pkg - exists <- doesFileExist spec - if not exists - then - ifM initialPkgRepo - (putStrLn $ show br ++ ": initial repo") - (putStrLn $ "missing" +-+ spec) + statusBranch pkg rbr@(RelBranch br) = + if latestcommit + then do + putStr $ unPackage pkg ++ ": " + whenJustM (gitShortLog1 Nothing) $ putStrLn . showCommit + else do + brExists <- checkIfRemoteBranchExists rbr + if not brExists + then do + name <- getDirectoryName + putStrLn $ name +-+ "has no branch" +-+ show br else do - mnvr <- pkgNameVerRel br spec - case mnvr of - Nothing -> do - putStrLn "undefined NVR!\n" - putStr "HEAD " - whenJustM (gitShortLog1 Nothing) $ putStrLn . showCommit - Just nvr -> do - -- unless (br == Rawhide) $ do - -- newerBr <- newerBranch br <$> getFedoraBranches - -- ancestor <- gitBool "merge-base" ["--is-ancestor", "HEAD", show newerBr] - -- when ancestor $ do - -- unmerged <- gitOneLineLog $ "HEAD..origin/" ++ show newerBr - -- unless (null unmerged) $ do - -- putStrLn $ "Newer commits in" +-+ show newerBr ++ ":" - -- mapM_ putStrLn unmerged - munpushed <- gitShortLog1 $ Just $ "origin/" ++ show br ++ "..HEAD" - case munpushed of - Nothing -> do - mbuild <- kojiGetBuildID fedoraHub (showNVR nvr) - case mbuild of - Nothing -> do - mlatest <- kojiLatestNVR (branchDestTag br) (unPackage pkg) - case mlatest of - Nothing -> putStrLn $ "new" +-+ showNVR nvr - Just latest -> - putStrLn $ if equivNVR nvr mlatest then showNVR latest +-+ "is latest modulo disttag" else showNVR latest +-+ "->\n" ++ showNVR nvr - Just buildid -> do - tags <- kojiBuildTags fedoraHub (buildIDInfo buildid) - if null tags - then do - mstatus <- kojiBuildStatus nvr - -- FIXME show pending archs building - whenJust mstatus $ \ status -> - -- FIXME better Show BuildStatus - putStr $ showNVR nvr +-+ "(" ++ show status ++ ")" - else do - -- FIXME hide testing if ga/stable - putStr $ showNVR nvr +-+ "(" ++ unwords tags ++ ")" - unless (isStable tags) $ do - updates <- bodhiUpdates - [makeItem "display_user" "0", - makeItem "builds" (showNVR nvr)] - case updates of - [] -> putStrLn "No update found" - [update] -> do - -- FIXME could show minus time left using stable_days? - let msince = lookupKey "date_testing" update :: Maybe LocalTime - case msince of - Nothing -> return () - Just date -> do - let since = localTimeToUTC utc date - current <- getCurrentTime - let diff = diffUTCTime current since - putAge diff - _ -> putStrLn "More than one update found!" - putNewLn - Just unpushed -> - let prefix = - let pref = - (if length pkgs > 1 then unPackage pkg else "") +-+ - case breq of - Branches brs | length brs <= 1 -> "" - _ -> show br - in if null pref then "" else pref ++ ":" - in putStrLn $ prefix +-+ showCommit unpushed + gitSwitchBranch rbr + let spec = packageSpec pkg + exists <- doesFileExist spec + if not exists + then + ifM initialPkgRepo + (putStrLn $ show br ++ ": initial repo") + (putStrLn $ "missing" +-+ spec) + else do + mnvr <- pkgNameVerRel br spec + case mnvr of + Nothing -> do + putStrLn "undefined NVR!\n" + putStr "HEAD " + whenJustM (gitShortLog1 Nothing) $ putStrLn . showCommit + Just nvr -> do + -- unless (br == Rawhide) $ do + -- newerBr <- newerBranch br <$> getFedoraBranches + -- ancestor <- gitBool "merge-base" ["--is-ancestor", "HEAD", show newerBr] + -- when ancestor $ do + -- unmerged <- gitOneLineLog $ "HEAD..origin/" ++ show newerBr + -- unless (null unmerged) $ do + -- putStrLn $ "Newer commits in" +-+ show newerBr ++ ":" + -- mapM_ putStrLn unmerged + munpushed <- gitShortLog1 $ Just $ "origin/" ++ show br ++ "..HEAD" + case munpushed of + Nothing -> do + mbuild <- kojiGetBuildID fedoraHub (showNVR nvr) + case mbuild of + Nothing -> do + mlatest <- kojiLatestNVR (branchDestTag br) (unPackage pkg) + case mlatest of + Nothing -> putStrLn $ "new" +-+ showNVR nvr + Just latest -> + putStrLn $ if equivNVR nvr mlatest then showNVR latest +-+ "is latest modulo disttag" else showNVR latest +-+ "->\n" ++ showNVR nvr + Just buildid -> do + tags <- kojiBuildTags fedoraHub (buildIDInfo buildid) + if null tags + then do + mstatus <- kojiBuildStatus nvr + -- FIXME show pending archs building + whenJust mstatus $ \ status -> + -- FIXME better Show BuildStatus + putStr $ showNVR nvr +-+ "(" ++ show status ++ ")" + else do + -- FIXME hide testing if ga/stable + putStr $ showNVR nvr +-+ "(" ++ unwords tags ++ ")" + unless (isStable tags) $ do + updates <- bodhiUpdates + [makeItem "display_user" "0", + makeItem "builds" (showNVR nvr)] + case updates of + [] -> putStrLn "No update found" + [update] -> do + -- FIXME could show minus time left using stable_days? + let msince = lookupKey "date_testing" update :: Maybe LocalTime + case msince of + Nothing -> return () + Just date -> do + let since = localTimeToUTC utc date + current <- getCurrentTime + let diff = diffUTCTime current since + putAge diff + _ -> putStrLn "More than one update found!" + putNewLn + Just unpushed -> + let prefix = + let pref = + (if length pkgs > 1 then unPackage pkg else "") +-+ + case breq of + Branches brs | length brs <= 1 -> "" + _ -> show br + in if null pref then "" else pref ++ ":" + in putStrLn $ prefix +-+ showCommit unpushed where isStable :: [String] -> Bool isStable = not . all ("-testing" `isSuffixOf`) @@ -135,66 +140,3 @@ #if !MIN_VERSION_time(1,8,0) nominalDay = 3600 * 24 :: NominalDiffTime #endif - - -unpushedCmd :: Bool -> Bool -> (BranchesReq,[String]) -> IO () -unpushedCmd latest bump (breq, pkgs) = - -- FIXME dirty not okay for multiple branches? - withPackagesByBranches (if latest then HeaderMay else HeaderMust) False dirtyGit AnyNumber unpushedBranch (breq, pkgs) - where - -- FIXME note dirty when local changes - unpushedBranch :: Package -> AnyBranch -> IO () - unpushedBranch _ (OtherBranch _) = - error' "status currently only defined for release branches" - unpushedBranch pkg rbr@(RelBranch br) = do - brExists <- checkIfRemoteBranchExists rbr - if not brExists - then do - name <- getDirectoryName - putStrLn $ name +-+ "has no branch" +-+ show br - else do - gitSwitchBranch rbr - let spec = packageSpec pkg - prefix = - let pref = - (if length pkgs > 1 && latest - then unPackage pkg else "") +-+ - case breq of - Branches brs | length brs <= 1 -> "" - _ -> show br - in if null pref then "" else pref ++ ":" - haveSpec <- doesFileExist spec - if not haveSpec - then - ifM initialPkgRepo - (putStrLn $ prefix +-+ "initial repo") $ - ifM (doesFileExist "dead.package") - (putStrLn $ prefix +-+ "dead package") $ - putStrLn $ prefix +-+ "missing" +-+ spec - else do - whenM (isNothing <$> pkgNameVerRel br spec) $ do - putStrLn "undefined NVR!\n" - putStr "HEAD " - unpushed <- gitShortLogN (if latest then Just 1 else Nothing) $ - Just $ "origin/" ++ show br ++ "..HEAD" - if null unpushed - then - when bump $ doBump spec - else - if latest - then whenJust (listToMaybe unpushed) $ putCommit prefix - else mapM_ (putCommit prefix) unpushed - - putCommit prefix = putStrLn . (prefix +-+) . showCommit - - doBump spec = do - checkWorkingDirClean False - dead <- doesFileExist "dead.package" - if dead - then putStrLn "dead package" - else do - putStrLn "bumping" - autorelease <- isAutoRelease spec - unless autorelease $ - cmd_ "rpmdev-bumpspec" ["-c", "rebuild", spec] - git_ "commit" $ "-a" : (if autorelease then ("--allow-empty" :) else id) ["-m", "bump release"] diff --git a/src/Cmd/Unpushed.hs b/src/Cmd/Unpushed.hs new file mode 100644 --- /dev/null +++ b/src/Cmd/Unpushed.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +module Cmd.Unpushed ( + unpushedCmd + ) +where + + +import Branches +import Cmd.Bump (bumpPkg) +import Common +import Common.System +import Git +import Package + +unpushedCmd :: Bool -> Bool -> Bool -> (BranchesReq,[String]) -> IO () +unpushedCmd checknvr latest bump (breq, pkgs) = + -- FIXME dirty not okay for multiple branches? + withPackagesByBranches (if latest then HeaderMay else HeaderMust) False dirtyGit AnyNumber unpushedBranch (breq, pkgs) + where + -- FIXME note dirty when local changes + unpushedBranch :: Package -> AnyBranch -> IO () + unpushedBranch _ (OtherBranch _) = + error' "status currently only defined for release branches" + unpushedBranch pkg rbr@(RelBranch br) = do + brExists <- checkIfRemoteBranchExists rbr + if not brExists + then do + name <- getDirectoryName + putStrLn $ name +-+ "has no branch" +-+ show br + else do + gitSwitchBranch rbr + let spec = packageSpec pkg + prefix = + let pref = + (if length pkgs > 1 && latest + then unPackage pkg else "") +-+ + case breq of + Branches brs | length brs <= 1 -> "" + _ -> show br + in if null pref then "" else pref ++ ":" + haveSpec <- doesFileExist spec + if not haveSpec + then + ifM initialPkgRepo + (putStrLn $ prefix +-+ "initial repo") $ + unlessM (doesFileExist "dead.package") $ + putStrLn $ prefix +-+ "missing" +-+ spec + else do + when (checknvr || length pkgs < 10) $ + whenM (isNothing <$> pkgNameVerRel br spec) $ do + putStrLn "undefined NVR!\n" + putStr "HEAD " + unpushed <- gitShortLogN (if latest then Just 1 else Nothing) $ + Just $ "origin/" ++ show br ++ "..HEAD" + if null unpushed + then + when bump $ bumpPkg False False Nothing Nothing pkg rbr + else + if latest + then whenJust (listToMaybe unpushed) $ putCommit prefix + else mapM_ (putCommit prefix) unpushed + + putCommit prefix = putStrLn . (prefix +-+) . showCommit diff --git a/src/Cmd/Update.hs b/src/Cmd/Update.hs --- a/src/Cmd/Update.hs +++ b/src/Cmd/Update.hs @@ -4,6 +4,9 @@ ) where +import Data.RPM.VerCmp +import SimplePrompt (promptEnter) + import Branches import Common import Common.System @@ -12,9 +15,6 @@ import Krb import Package -import Data.RPM.VerCmp -import SimplePrompt (promptEnter) - -- FIXME if autorelease, drop -b baserelease -- FIXME --no-prep to avoid overwriting ongoing build -- FIXME don't bump release if already bumped @@ -42,8 +42,9 @@ else if null pkgs then Nothing else dirty withPackagesMaybeBranch HeaderMay False mgitops (updatePkg onlysources force allowHEAD pkgGit mver) (mbr, pkgs) -updatePkg :: Bool -> Bool -> Bool -> Bool -> Maybe String -> Package -> AnyBranch - -> IO () +-- FIXME use tempdir or don't prep to prevent overwriting an ongoing build +updatePkg :: Bool -> Bool -> Bool -> Bool -> Maybe String -> Package + -> AnyBranch -> IO () updatePkg onlysources force allowHEAD distgit mver pkg br = do when (distgit && br /= RelBranch Rawhide && isRelBranch br) $ promptEnter $ "Are you sure you want to update" +-+ show br +-+ "branch?! Press Enter to continue" @@ -96,9 +97,10 @@ -- FIXME only if not all exist cmd_ "spectool" ["-g", "-S", spec] patches <- map sourceFieldFile <$> cmdLines "spectool" ["-P", spec] - forM_ patches $ \patch -> + forM_ patches $ \patch -> do unlessM (doesFileExist patch) $ - cmd_ "spectool" ["-g", "-P", spec] + cmd_ "spectool" ["-g", "-P", spec] + git_ "add" [patch] when force $ do let archives = filter isArchiveFile existing forM_ archives removeFile @@ -112,24 +114,10 @@ cmd_ "rpmdev-bumpspec" ["-c", "update to" +-+ newver, spec] git_ "commit" ["-a", "-m", "update to" +-+ newver] putStr "Prepping... " - cmdSilent' "rpmbuild" ["-bp", "--nodeps", spec] + sourcediropt <- sourceDirCwdOpt + cmdSilent' "rpmbuild" $ "-bp" : sourcediropt ++ ["--nodeps", spec] putStrLn "done" -- FIXME git amend (if previous commit was update) - where - sourceFieldFile :: String -> FilePath - sourceFieldFile field = - if null field then - -- should be impossible - error "empty source field!" - else (takeFileName . last . words) field - - -- FIXME handle .tgz? - isArchiveFile :: FilePath -> Bool - isArchiveFile f = - any ($ f) [(".tar." `isInfixOf`), - (".zip" `isSuffixOf`), - (".gpg" `isSuffixOf`), - (".tgz" `isSuffixOf`)] pkgVerRel :: FilePath -> IO (String,String) pkgVerRel spec = do diff --git a/src/Git.hs b/src/Git.hs --- a/src/Git.hs +++ b/src/Git.hs @@ -36,6 +36,7 @@ ) where import Data.Char (isSpace) +import Distribution.Fedora.Branch (newerBranch) import SimpleCmd.Git import SimplePrompt @@ -165,7 +166,7 @@ if ok then putStrLn $ if quiet then "done" else last (lines err) else do - when quiet $ putStrLn "" + when quiet putNewLn putStrLn $ unwords ("git" : args) +-+ "failed with\n" ++ err yes <- yesNo "Retry git push" -- FIXME going to fail if ref no longer on branch diff --git a/src/Koji.hs b/src/Koji.hs --- a/src/Koji.hs +++ b/src/Koji.hs @@ -31,8 +31,13 @@ import qualified Data.ByteString.Lazy.Char8 as B import Data.Fixed (Micro) import Data.RPM.NVR (NVR, maybeNVR, nvrName) +import Data.Time.Clock +import Data.Time.Format +import Data.Time.LocalTime +import Distribution.Fedora.Branch (branchTarget) import Distribution.Koji import qualified Distribution.Koji.API as Koji +import Say (sayString) import SimplePrompt (promptEnter) import System.Exit import System.Process.Typed @@ -146,7 +151,7 @@ Just TaskFailed -> do whenJustM (findExecutable "koji-tool") $ \kojitool -> -- FIXME cmdLog deprecated - cmdLog kojitool ["tasks", displayID task, "--tail", "-s", "fail"] + cmdLog kojitool ["tasks", "--children", displayID task, "--tail", "-s", "fail"] error' "Task failed!" Just TaskCanceled -> return () _ -> kojiWatchTask task @@ -165,8 +170,6 @@ Just ts -> if ts `elem` openTaskStates then do - -- this makes parallel too noisy - --putChar '.' sleep 20 kojiWaitTask task else return $ ts == TaskClosed @@ -238,14 +241,15 @@ Nothing -> error "create_event not found" Just event -> do latest <- kojiLatestNVRRepo buildtag event (nvrName nvr) + tz <- getCurrentTimeZone if latest == Just nvr - then logMsg $ showNVR nvr +-+ + then logSay tz $ showNVR nvr +-+ if isNothing moldrepo then "is in" +-+ buildtag else "appeared" else do when (isNothing moldrepo && not quiet) $ - logMsg $ "Waiting for" +-+ buildtag +-+ "to have" +-+ showNVR nvr + logSay tz $ "Waiting for" +-+ buildtag +-+ "to have" +-+ showNVR nvr waitRepo buildtag mrepo kojiTagArchs :: String -> IO [String] @@ -290,9 +294,10 @@ out <- if dryrun then return $ "Side tag '" ++ buildtag ++ "'" - else if create - then head . lines <$> fedpkg "request-side-tag" ["--base-tag", buildtag] - else error' "incorrect side-tag create request" + else + if create + then head . lines <$> fedpkg "request-side-tag" ["--base-tag", buildtag] + else error' "incorrect side-tag create request" if "Side tag '" `isPrefixOf` out then do putNewLn @@ -306,3 +311,8 @@ else error' "'fedpkg request-side-tag' failed" [tag] -> return tag _ -> error' $ "More than one user side-tag found for" +-+ show br + +logSay :: TimeZone -> String -> IO () +logSay tz str = do + now <- utcToLocalTime tz <$> getCurrentTime + sayString $ formatTime defaultTimeLocale "%T" now +-+ str diff --git a/src/ListReviews.hs b/src/ListReviews.hs --- a/src/ListReviews.hs +++ b/src/ListReviews.hs @@ -7,6 +7,8 @@ listReviewsFull ) where +import SimpleCmd (error') + import Common import Branches @@ -25,15 +27,28 @@ listReviews = listReviewsAll False listReviewsAll :: Bool -> ReviewStatus -> IO [Bug] -listReviewsAll = listReviewsFull False Nothing Nothing +listReviewsAll = listReviewsFull Nothing (Just Nothing) Nothing -- FIXME: --unassigned -listReviewsFull :: Bool -> Maybe String -> Maybe String -> Bool - -> ReviewStatus-> IO [Bug] -listReviewsFull assignee muser mpat allopen status = do +listReviewsFull :: Maybe (Maybe String) -> Maybe (Maybe String) + -> Maybe String -> Bool -> ReviewStatus -> IO [Bug] +listReviewsFull Nothing Nothing Nothing _ _ = + error' "please specify either report, assignee, or package name pattern" +listReviewsFull mmassignee mmreporter mpat allopen status = do session <- bzApiKeySession - accountid <- getBzAccountId session muser - let reviews = (if assignee then assigneeIs else reporterIs) accountid .&&. maybe packageReview pkgReviewsPrefix mpat + massignedto <- + case mmassignee of + Nothing -> return Nothing + Just massignee -> + Just <$> getBzAccountId session massignee + mreporter <- + case mmreporter of + Nothing -> return Nothing + Just mreporter -> + Just <$> getBzAccountId session mreporter + let reviews = maybe id (\a -> (assigneeIs a .&&.)) massignedto $ + maybe id (\r -> (reporterIs r .&&.)) mreporter $ + maybe packageReview pkgReviewsPrefix mpat open = if allopen then statusOpen else case status of diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -3,13 +3,15 @@ module Main (main) where import Data.Maybe (fromMaybe) -import Distribution.Fedora.Branch +import Distribution.Fedora.Branch (partitionBranches, readBranch) #if !MIN_VERSION_simple_cmd_args(0,1,7) import Options.Applicative (maybeReader, ReadM) #endif +import SelectRPMs (selectRpmsOption) import SimpleCmdArgs -- commands +import Cmd.Autospec import Cmd.Bugs import Cmd.Build import Cmd.Bump @@ -18,6 +20,7 @@ import Cmd.Compare import Cmd.Copr import Cmd.Diff +import Cmd.Fetch import Cmd.FTBFS import Cmd.Import import Cmd.Install @@ -31,10 +34,12 @@ import Cmd.Parallel import Cmd.PkgReview import Cmd.Prep -import Cmd.PullPush +import Cmd.Pull +import Cmd.Push --import Cmd.Repoquery import Cmd.RequestBranch import Cmd.RequestRepo +import Cmd.ReviewPackage import Cmd.Reviews import Cmd.Scratch import Cmd.SideTags @@ -42,6 +47,7 @@ import Cmd.SrcDeps import Cmd.Status import Cmd.Switch +import Cmd.Unpushed import Cmd.Update import Cmd.WaitRepo @@ -62,7 +68,8 @@ subcommands [ Subcommand "clone" "Clone packages" $ cloneCmd - <$> cloneRequest + <$> optional (optionWith branchM 'b' "branch" "BRANCH" "branch") + <*> cloneRequest , Subcommand "switch" "Switch branch" $ switchCmd <$> verboseOpt "verbose output" @@ -75,6 +82,7 @@ statusCmd <$> switchWith 'n' "no-fetch" "Do not git fetch to save time" <*> switchWith 'r' "reviews" "Status of reviewed packages" + <*> switchWith 'l' "latest-commit" "Show the last commit" <*> branchesPackages , Subcommand "merge" "Merge from newer branch" $ mergeCmd @@ -87,7 +95,8 @@ <*> branchesPackages , Subcommand "unpushed" "Show unpushed commits" $ unpushedCmd - <$> switchWith 'l' "latest" "Only show latest unpushed commit" + <$> switchWith 'c' "check-nvr" "Check NVR defined [default for < 10 pkgs]" + <*> switchWith 'l' "latest" "Only show latest unpushed commit" <*> switchWith 'b' "bump" "Bump release (and commit) if no local commits" <*> branchesPackages , Subcommand "build" "Build package(s) in Koji" $ @@ -96,7 +105,8 @@ <*> branchesPackages , Subcommand "list" "List packages in pagure" $ listCmd - <$> switchWith 'c' "count" "Print number of packages" + <$> forceOpt "Do not prompt if large number of results" + <*> switchWith 'c' "count" "Print number of packages" <*> optional packagerOpt <*> many (pkgArg "PKGPAT...") , Subcommand "list-local" "List packages in branch" $ @@ -115,9 +125,10 @@ <*> mergeOpt <*> optionalWith auto 'l' "skip-to-layer" "LAYERNO" "Skip the first N layers [default 0]" 0 <*> optional (sidetagTargetOpt $ Just "or creates one for you (with 'fedpkg request-side-tag --base-tag')") + <*> switchLongWith "must-push" "Error if no unpushed commits" <*> optionalWith auto 'd' "delay" "SECONDS" "Sleep delay between starting builds [default 4.0]" 4 <*> updateOpt - <*> branchesPackages + <*> branchesPackagesDesc "BRANCH... PKG1... [:] PKG2..." , Subcommand "sidetags" "List user's side-tags" $ sideTagsCmd <$> switchLongWith "remove" "Remove one or more sidetags" @@ -142,7 +153,7 @@ <*> switchLongWith "stagger" "Stagger archs" <*> rebuildSrpmOpt <*> noFailFastOpt - <*> switchLongWith "allow-head" "allow detached HEAD" + <*> allowHeadOpt <*> optional archesOpt <*> many (sidetagTargetOpt Nothing) <*> optional scratchSourceOpt @@ -151,7 +162,7 @@ scratchCmdAarch64 <$> dryrunOpt "Dry run: do not build" <*> rebuildSrpmOpt - <*> switchLongWith "allow-head" "allow detached HEAD" + <*> allowHeadOpt <*> switchWith 'X' "exclude-arch" "Exclude aarch64" <*> many (sidetagTargetOpt Nothing) <*> optional scratchSourceOpt @@ -160,23 +171,23 @@ scratchCmdX86_64 <$> dryrunOpt "Dry run: do not build" <*> rebuildSrpmOpt - <*> switchLongWith "allow-head" "allow detached HEAD" + <*> allowHeadOpt <*> switchWith 'X' "exclude-arch" "Exclude x86_64" <*> many (sidetagTargetOpt Nothing) <*> optional scratchSourceOpt <*> branchesPackages , Subcommand "update-sources" "Download and update newer sources" $ updateCmd True - <$> switchWith 'f' "force" "Download upstream sources even if they exist locally" + <$> forceOpt "Download upstream sources even if they exist locally" <*> switchWith 'H' "allow-head" "For updating inside rebase" <*> maybeBranchPackages False , Subcommand "update-version" "Update package in dist-git to newer version" $ updateCmd <$> switchWith 's' "sources-only" "Only update sources" - <*> switchWith 'f' "force" "Download upstream sources even if they exist locally" + <*> forceOpt "Download upstream sources even if they exist locally" <*> switchWith 'H' "allow-head" "For updating inside rebase" <*> maybeBranchPackages False - , Subcommand "sort" "Sort packages in build dependency order" $ + , Subcommand "sort" "Sort packages in build dependency order (default format: chain-build)" $ sortCmd <$> sortDisplayOpt <*> optional rpmWithOpt @@ -186,17 +197,18 @@ <$> optional prepPreOpts <*> verboseOpt "show rpmbuild output" <*> switchWith 'd' "deps" "require deps to be installed" + <*> allowHeadOpt <*> maybeBranchPackages False , Subcommand "local" "Build locally" $ localCmd <$> quietOpt "Hide the build.log until it errors" - <*> switchWith 'd' "debug" "show the rpmbuild command" + <*> debugOpt "show the rpmbuild command" <*> optional forceshortOpt <*> many bcondOpt <*> branchesPackages , Subcommand "srpm" "Build srpm" $ srpmCmd - <$> switchWith 'f' "force" "regenerate even if spec older than existing srpm" + <$> forceOpt "regenerate even if spec older than existing srpm" <*> maybeBranchPackages False , Subcommand "srpm-spec" "Show the spec file in an srpm" $ srpmSpecCmd @@ -204,12 +216,12 @@ <*> some (strArg "SRPM") , Subcommand "diff" "Diff local changes" $ diffCmd - <$> switchWith 'd' "debug" "use package headers" + <$> debugOpt "use package headers" <*> switchWith 'o' "spec-only" "Only diff spec file" <*> diffWorkOpt <*> diffFormatOpt <*> switchWith 'i' "ignore-bumps" "Ignore pure release bumps" - <*> optional diffFilterOpt + <*> many diffFilterOpt <*> optional (optionWith anyBranchM 'w' "with-branch" "BRANCH" "branch") <*> maybeBranchPackages False , Subcommand "compare" "Show commits between branches" $ @@ -249,7 +261,7 @@ <*> switchWith 'r' "reinstall" "reinstall rpms" <*> switchLongWith "no-build" "do not (re-)build (install built rpms)" <*> switchLongWith "ignore-builddeps" "do not install builddeps" - <*> switchWith 'a' "all-subpackages" "install all subpackages (default if none currently installed)" + <*> selectRpmsOption <*> maybeBranchPackages False , Subcommand "not-installed" "Packages not installed locally" $ notInstalledCmd @@ -259,16 +271,18 @@ <$> optional (strOptionWith 's' "summary" "KEY" "Search for bugs containing keyword") <*> manyPackages , Subcommand "bump" "Bump release for package" $ - bumpPkgs + bumpCmd <$> dryrunOpt "Dry run: do not bump" <*> switchWith 'l' "local" "Use local origin rather than checking latest koji" - <*> optional commitOpts + <*> optional (strOptionWith 'm' "message" "COMMITMSG" + "Specify commit message") <*> optional (strOptionWith 'c' "changelog" "CLOGENTRY" "Override changelog entry [default: rebuild]") <*> branchesPackages , Subcommand "commit" "Git commit packages" $ - commitPkgs - <$> optional commitOpts + commitCmd + <$> dryrunOpt "Dry run: do not commit" + <*> optional commitOpts <*> switchWith '1' "first-line" "use first line of changelog" <*> switchWith 'a' "unstaged" "include unstaged changes" <*> manyPackages @@ -303,20 +317,26 @@ <*> optional (strArg "SPECFILE") , Subcommand "review-package" "Run fedora-review on a package Review Request bug" $ reviewPackage - <$> optional (pkgArg "PACKAGE/BZID") + <$> switchWith 'i' "interactive" "Download and check package review without fedora-review mock build" + <*> optional (pkgArg "PACKAGE/BZID") , 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") + <*> optional + (flagLongWith' Nothing "assigned" "Package reviewer" <|> + Just <$> strOptionLongWith "assignee" "BZUSER" "Package review submitter") + <*> optional + (flagLongWith' Nothing "submitted" "Submitted reviews [default if no assignee specified]" <|> + Just <$> strOptionWith 's' "submitter" "BZUSER" "Package review submitter") <*> optional (strOptionWith 'p' "pattern" "PKGPREFIX" "Package pattern prefix") <*> reviewStatusOpt , Subcommand "request-repos" "Request dist git repo for new approved packages" $ requestRepos <$> mockOpt True <*> reviewAllStatusOpt - <*> switchWith 'r' "retry" "Re-request repo" + <*> switchWith 's' "skip-request-check" "Skip check for existing fedora-scm-requests issue" + <*> switchWith 'r' "resubmit" "Re-request repo" <*> branchesPackages , Subcommand "import" "Import new approved created packages from bugzilla review" $ importCmd @@ -345,7 +365,10 @@ , Subcommand "copr" "Build package(s) in Fedora Copr" $ coprCmd <$> dryrunOpt "Dry run: do not build" - <*> switchWith 'l' "list-chroots" "Show project chroots" + <*> (flagWith' ListChroots 'l' "list-chroots" "Show project chroots" <|> + flagLongWith' CoprNew "new" "Create new copr repo" <|> + flagWith CoprBuild CoprMonitor 'm' "monitor" "Show project chroots") + <*> forceOpt "build even if existing n-v-r" <*> buildByOpt <*> optional archesOpt <*> pkgArg "PROJECT" @@ -375,7 +398,7 @@ <*> maybeBranchPackages False , Subcommand "autospec" "Convert package to use rpmautospec" $ autospecCmd - <$> switchWith 'f' "force" "Refresh changelog file to current" + <$> forceOpt "Refresh changelog file to current" <*> manyPackages , Subcommand "move-artifacts" "Move old rpm artifacts into rpmbuild dirs" $ moveArtifactsCmd @@ -387,10 +410,11 @@ cloneRequest = flagWith' (CloneUser Nothing) 'M' "mine" "Your packages" <|> CloneUser . Just <$> strOptionWith 'u' "user" "USER" "Packages of FAS user" <|> - ClonePkgs <$> maybeBranchPackages True + CloneGroup <$> strOptionWith 'g' "group" "GROUP" "Packages of package group" <|> + ClonePkgs <$> somePackages reviewShortOpt :: Parser Bool - reviewShortOpt = switchWith 's' "short" "Only output the package name" + reviewShortOpt = switchLongWith "short" "Only output the package name" reviewAllStatusOpt :: Parser Bool reviewAllStatusOpt = switchWith 'A' "all-status" "include all open states" @@ -426,8 +450,8 @@ manyPackages :: Parser [String] manyPackages = many (pkgArg "PKGPATH...") - -- somePackages :: Parser [String] - -- somePackages = some (pkgArg "PKGPATH...") + somePackages :: Parser [String] + somePackages = some (pkgArg "PKG...") branchesOpt :: Parser (Maybe BranchOpts) branchesOpt = @@ -471,10 +495,13 @@ [br] -> (Just br,pkgs) _ -> error' $ "cannot have more than one branch:" +-+ unwords (map show brs) - -- FIXME split later to prevent branches after packages branchesPackages :: Parser (BranchesReq, [String]) - branchesPackages = - branchesReqPkgs <$> branchesOpt <*> many (pkgArg "BRANCH... PKGPATH...") + branchesPackages = branchesPackagesDesc "BRANCH... PKGPATH..." + + -- FIXME split later to prevent branches after packages + branchesPackagesDesc :: String -> Parser (BranchesReq, [String]) + branchesPackagesDesc desc = + branchesReqPkgs <$> branchesOpt <*> many (pkgArg desc) where branchesReqPkgs :: Maybe BranchOpts -> [String] -> (BranchesReq, [String]) branchesReqPkgs mbrnchopts args = @@ -540,9 +567,11 @@ archesOpt :: Parser Archs archesOpt = Archs <$> some archOpt <|> ExcludedArchs <$> some excludeArch - -- FIXME allow "dryrun" - dryrunOpt = switchWith 'n' "dry-run" + dryrunOpt desc = switchWith 'n' "dry-run" desc <|> + switchLongWith "dryrun" "alias for --dry-run" + debugOpt = switchWith 'd' "debug" + skipFetchOpt = switchWith 'S' "skip-fetch" "Do not git fetch" updateOpt :: Parser (Maybe UpdateType, UpdateSeverity) @@ -593,22 +622,19 @@ strOptionWith 'm' "message" "COMMITMSG" "commit message" <|> flagWith' CommitAmend 'A' "amend" "Amend commit" - pullOpts :: Parser PullOpts + pullOpts :: Parser PullOpt pullOpts = flagWith' PullLenient 'l' "lenient" "Ignore non-git dirs and files" <|> flagWith' PullNoFetch 'f' "no-fetch" "Skip git fetch" <|> - flagWith' PullStash 's' "stash" "Stash local changes" + flagWith' PullStash 's' "stash" "Stash local changes" <|> + flagWith' PullRebase 'r' "rebase" "Git pull instead of fetch" buildByOpt = flagWith' SingleBuild 'S' "single" "Non-progressive normal single build" <|> flagWith' BuildByRelease 'R' "by-release" "Builds by release" <|> flagWith ValidateByRelease ValidateByArch 'A' "by-arch" "Build across latest release archs first (default is across releases for primary arch)" commandOpt = strOptionWith 'c' "cmd" "SHELLCOMMAND" "Shell command to run in $p" targetOpt :: Parser String - targetOpt = - checkNotRawhide <$> strOptionWith 't' "target" "TARGET" "Koji target" - where - checkNotRawhide "rawhide" = error' "'rawhide' is not a valid target!" - checkNotRawhide t = t + targetOpt = strOptionWith 't' "target" "TARGET" "Koji target" sidetagTargetOpt :: Maybe String -> Parser SideTagTarget sidetagTargetOpt mdesc = @@ -647,8 +673,8 @@ sortDisplayOpt :: Parser SortDisplay sortDisplayOpt = flagWith' SortParallel 'p' "parallel" "Group dependent packages on separate lines" - <|> flagWith' SortChain 'c' "chain" "chain-build output" - <|> flagWith SortPlain SortLayers 'l' "layers" "output parallel layers" + <|> flagWith' SortLayers 'l' "layers" "output parallel layers" + <|> flagWith SortChain SortPlain 's' "separated" "Dependent grouping separated by empty lines" -- for waitrepo waitfetchOpt :: Parser WaitFetch @@ -666,3 +692,7 @@ quietOpt :: String -> Parser Bool quietOpt = switchWith 'q' "quiet" + + allowHeadOpt = switchLongWith "allow-head" "allow detached HEAD" + + forceOpt = switchWith 'f' "force" diff --git a/src/Package.hs b/src/Package.hs --- a/src/Package.hs +++ b/src/Package.hs @@ -9,7 +9,7 @@ getChangelog, cleanChangelog, changeLogPrompt, - getBranchDist, + releaseSystemBranch, getPackageName, getSummaryURL, findSpecfile, @@ -40,22 +40,28 @@ packageSpec, pkgNameVerRel, pkgNameVerRel', + pkgNameVerRelNodist, equivNVR, editSpecField, - isAutoRelease + isAutoChangelog, + isAutoRelease, + sourceFieldFile, + isArchiveFile, + sourceDirCwdOpt ) where import Data.RPM (NV(..), VerRel(..)) import Data.RPM.NVR (maybeNVR, NVR(..)) -import Distribution.Fedora hiding (Fedora,EPEL,EPELNext) +import Distribution.Fedora.Branch import SimpleCmd.Rpm -import SimplePrompt (prompt) +import SimplePrompt (prompt, promptInitial) import Branches import Common import Common.System import Git import Krb +import Types (ChangeType(..)) fedpkg :: String -> [String] -> IO String fedpkg c args = @@ -71,36 +77,46 @@ unless have $ error' $ spec +-+ "not found" -- FIXME allow editor to be used -changeLogPrompt :: Bool -> FilePath -> IO String -changeLogPrompt isupdate spec = do - clog <- cleanChangelog spec +changeLogPrompt :: ChangeType -> FilePath -> IO String +changeLogPrompt change spec = do + clog <- cleanChangelog (change /= ChangeReview) spec putNewLn putStrLn "```" - putStr clog + putStrLn clog putStrLn "```" -- FIXME is this actually useful? tty <- isTty if not tty then return clog else do - userlog <- prompt $ "Press Enter to use above or input" +-+ (if isupdate then "update" else "change") +-+ "summary now" ++ if isupdate then "; or 'no' to skip update" else "" + -- FIXME ask what to do: edit/skip/append? + userlog <- promptInitial + ("Describe" +-+ + case change of + ChangeBodhi -> "update" + ChangeCommit -> "commit" + ChangeReview -> "change" + +-+ "summary now" + ++ (if change == ChangeBodhi then "; or 'no' to skip update" else "") + ++ ":\n") + clog return $ if null userlog then clog else userlog getChangelog :: FilePath -> IO [String] getChangelog spec = do - autochangelog <- grep_ "^%autochangelog" spec + autochangelog <- isAutoChangelog spec if autochangelog then takeWhile (not . null) . drop 1 <$> cmdLines "rpmautospec" ["generate-changelog", spec] else cmdLines "rpmspec" ["-q", "--srpm", "--qf", "%{changelogtext}", spec] -cleanChangelog :: FilePath -> IO String -cleanChangelog spec = do +cleanChangelog :: Bool -> FilePath -> IO String +cleanChangelog nobullet spec = do ls <- getChangelog spec return $ case filter ("- " `isPrefixOf`) ls of - [l] -> removePrefix "- " l ++ "\n" - _ -> unlines ls + [l] | nobullet -> removePrefix "- " l + _ -> intercalate "\n" ls getSummaryURL :: FilePath -> IO String getSummaryURL spec = do @@ -259,7 +275,8 @@ -- For now assume spec filename = package name Just spec -> return $ takeBaseName spec Nothing -> getDirectoryName - when (count && length pkgs >= 2) $ + when (count && length pkgs >= 2) $ do + putNewLn putStrLn $ plural n "package" +-+ "left" unless (isNothing mspec || mspec == Just (unPackage pkg <.> "spec")) $ putStrLn $ "Warning: package name (" ++ unPackage pkg ++ ") differs from spec filename!" @@ -277,6 +294,9 @@ else return $ Just cur else Just <$> gitCurrentBranch else return Nothing + let fetch = have gitOptFetch + -- quiet to avoid output before header + when fetch $ gitFetchSilent True brs <- listOfAnyBranches (haveGit && not (have gitOptHEAD)) (have gitOptActive) breq case limitBranches of ZeroOrOne | length brs > 1 -> @@ -287,14 +307,12 @@ ExactlyOne | length brs > 1 -> error' "please only specify one branch" _ -> return () - let fetch = have gitOptFetch when ((header /= HeaderNone || fetch) && dir /= ".") $ case brs of [br] -> when (fetch || header == HeaderMust) $ putPkgAnyBrnchHdr pkg br _ -> when (fetch || header /= HeaderNone) $ putPkgHdr pkg when haveGit $ when (have gitOptClean) $ checkWorkingDirClean (have gitOptStash) - when fetch $ gitFetchSilent False -- FIXME!! no branch restriction when (breq `elem` map BranchOpt [AllBranches,AllFedora,AllEPEL]) $ putStrLn $ "Branches:" +-+ unwords (map show brs) ++ "\n" @@ -361,23 +379,38 @@ matches <- filter ("Release:" `isPrefixOf`) <$> grep "%autorelease" spec return $ not (null matches) --- FIXME return NVR?? +isAutoChangelog :: FilePath -> IO Bool +isAutoChangelog = grep_ "^%autochangelog" + pkgNameVerRel :: Branch -> FilePath -> IO (Maybe NVR) -pkgNameVerRel br spec = do - disttag <- rpmDistTag <$> branchDist br +pkgNameVerRel = pkgNameVerRelDist . Just + +pkgNameVerRelDist :: Maybe Branch -> FilePath -> IO (Maybe NVR) +pkgNameVerRelDist Nothing spec = do + nvrs <- rpmspec ["--srpm", "--undefine=dist"] (Just "%{name}-%{version}-%{release}") spec + return $ + case nvrs of + [] -> Nothing + [nvr] -> maybeNVR nvr + _ -> error' "could not determine unique nvr" +pkgNameVerRelDist (Just br) spec = do + disttag <- branchDistTag br -- workaround dist with bootstrap hostdist <- cmd "rpm" ["--eval", "%{dist}"] -- FIXME more precise regexp with "Release:" autorelease <- isAutoRelease spec nvrs <- do - pkggit <- isPkgGitRepo - if autorelease && pkggit - then do - --putStrLn "%autorelease detected" - mfedpkg <- findExecutable "fedpkg" - when (isNothing mfedpkg) $ - error' "requires fedpkg.." - cmdLines "fedpkg" ["verrel"] + if autorelease + then do + pkggit <- isPkgGitRepo + if pkggit + then do + mfedpkg <- findExecutable "fedpkg" + when (isNothing mfedpkg) $ + error' "requires fedpkg.." + cmdLines "fedpkg" ["verrel"] + else + error' "cannot determine NVR accurately for autorelease outside dist-git" else rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") spec seq disttag $ return $ @@ -393,10 +426,17 @@ Nothing -> error' $ "rpmspec failed to parse" +-+ spec Just nvr -> return nvr -getBranchDist :: AnyBranch -> IO Dist -getBranchDist (RelBranch br) = branchDist br -getBranchDist (OtherBranch _) = systemBranch >>= branchDist +pkgNameVerRelNodist :: FilePath -> IO NVR +pkgNameVerRelNodist spec = do + mnvr <- pkgNameVerRelDist Nothing spec + case mnvr of + Nothing -> error' $ "rpmspec failed to parse" +-+ spec + Just nvr -> return nvr +releaseSystemBranch :: AnyBranch -> IO Branch +releaseSystemBranch (RelBranch br) = return br +releaseSystemBranch (OtherBranch _) = systemBranch + -- FIXME should be more strict about dist tag (eg .fcNN only) equivNVR :: NVR -> Maybe NVR -> Bool equivNVR _ Nothing = False @@ -495,3 +535,22 @@ splitRelease :: NVR -> (NV,String) splitRelease (NVR n (VerRel v r)) = (NV n v, r) #endif + +sourceFieldFile :: String -> FilePath +sourceFieldFile field = + if null field then + -- should be impossible + error "empty source field!" + else (takeFileName . last . words) field + +isArchiveFile :: FilePath -> Bool +isArchiveFile f = + any ($ f) [(".tar." `isInfixOf`), + (".zip" `isSuffixOf`), + (".gpg" `isSuffixOf`), + (".tgz" `isSuffixOf`)] + +sourceDirCwdOpt :: IO [String] +sourceDirCwdOpt = do + cwd <- getCurrentDirectory + return ["--define", "_sourcedir" +-+ cwd] diff --git a/src/Pagure.hs b/src/Pagure.hs --- a/src/Pagure.hs +++ b/src/Pagure.hs @@ -1,6 +1,7 @@ module Pagure ( srcfpo, pagureio, + pagureGroupRepos, pagureListGitBranches, pagureListProjectIssueTitlesStatus, IssueTitleStatus(..), diff --git a/src/Repoquery.hs b/src/Repoquery.hs --- a/src/Repoquery.hs +++ b/src/Repoquery.hs @@ -9,6 +9,8 @@ import Bodhi (bodhiTestingRepo) import Branches +-- FIXME use fedora-repoquery library +-- FIXME default to package repoquery :: Branch -> Branch -> [String] -> IO String repoquery sysbr br args = do mtesting <- bodhiTestingRepo br @@ -19,10 +21,12 @@ case br of Rawhide -> ["--disablerepo=*", "--enablerepo=rawhide"] Fedora _ -> ["--disablerepo=*", "--enablerepo=fedora"] ++ - ["--enablerepo=updates"| isJust mtesting] ++ + ["--enablerepo=updates-testing" | isJust mtesting] ++ ["--releasever=" ++ branchVersion br] - EPEL _ -> ["--disablerepo=*", "--enablerepo=epel", - "--releasever=" ++ branchVersion br] - EPELNext _ -> ["--disablerepo=*", "--enablerepo=epel-next", - "--releasever=" ++ branchVersion br] + EPEL _ -> ["--disablerepo=*", "--enablerepo=epel"] ++ + ["--enablerepo=epel-testing" | isJust mtesting] ++ + ["--releasever=" ++ branchVersion br] + EPELNext _ -> ["--disablerepo=*", "--enablerepo=epel-next"] ++ + ["--enablerepo=epel-next-testing" | isJust mtesting] ++ + ["--releasever=" ++ branchVersion br] cmd "dnf" (["repoquery", "--quiet"] ++ brOpts ++ args) diff --git a/src/RpmBuild.hs b/src/RpmBuild.hs --- a/src/RpmBuild.hs +++ b/src/RpmBuild.hs @@ -8,6 +8,7 @@ getDynSourcesMacros, generateSrpm, generateSrpm', + generateSrpmNoDist, BCond(..), ForceShort(..), isShortCircuit, @@ -22,11 +23,11 @@ import Data.Char (isDigit) import Data.Either (partitionEithers) import Data.RPM -import qualified Distribution.Fedora as Dist -import Distribution.Fedora (Dist) +import Distribution.Fedora.Branch (branchDistTag, branchRelease) +import Distribution.Fedora.Release (Release(releaseVersion)) import Network.HTTP.Directory (Manager, httpExists, httpManager) import SimpleCmd.Rpm -import SimplePrompt (promptEnter) +import SimplePrompt (promptEnter, yesNo) import System.Console.Pretty import System.IO.Extra (withTempDir) import System.Posix.Files @@ -38,31 +39,36 @@ import Git import Package -distOpt :: Dist -> [String] -distOpt dist = - ["--define", "dist" +-+ "%{?distprefix}" ++ Dist.rpmDistTag dist] +distOpt :: Branch -> IO [String] +distOpt br = do + disttag <- branchDistTag br + return ["--define", "dist" +-+ "%{?distprefix}" ++ disttag] +distOptAny :: AnyBranch -> IO [String] +distOptAny b = + releaseSystemBranch b >>= distOpt + -- FIXME hardcoding distRpmOptions :: Branch -> IO [String] distRpmOptions br = - map ("--define=" ++) <$> - case br of - Rawhide -> do - dist <- Dist.getRawhideDist - let ver = case dist of - Dist.Fedora n -> show n - _ -> error' $ "impossible rawhide version:" +-+ show dist - return ["fedora" +-+ ver, "fc" ++ ver +-+ "1"] - Fedora n -> return ["fedora" +-+ show n, "fc" ++ show n +-+ "1"] - EPEL n -> return ["rhel" +-+ show n, "el" ++ show n +-+ "1"] - EPELNext n -> return ["rhel" +-+ show n, "el" ++ show n +-+ "1"] + map ("--define=" ++) <$> do + release <- branchRelease br + return $ + case br of + Rawhide -> + let ver = releaseVersion release + in ["fedora" +-+ ver, "fc" ++ ver +-+ "1"] + Fedora n -> + ["fedora" +-+ show n, "fc" ++ show n +-+ "1"] + EPEL n -> ["rhel" +-+ show n, "el" ++ show n +-+ "1"] + EPELNext n -> ["rhel" +-+ show n, "el" ++ show n +-+ "1"] builtRpms :: AnyBranch -> FilePath -> IO [FilePath] builtRpms br spec = do - dist <- getBranchDist br + distopt <- distOptAny br rpmdir <- fromMaybe "" <$> rpmEval "%{_rpmdir}" autoreleaseOpt <- getAutoReleaseOptions spec - rpms <- rpmspec (["--builtrpms", "--define", "dist" +-+ Dist.rpmDistTag dist] ++ autoreleaseOpt) (Just (rpmdir "%{arch}/%{name}-%{version}-%{release}.%{arch}.rpm")) spec + rpms <- rpmspec ("--builtrpms" : distopt ++ autoreleaseOpt) (Just (rpmdir "%{arch}/%{name}-%{version}-%{release}.%{arch}.rpm")) spec if null rpms then error' $ spec +-+ "does not seem to create any rpms" else return rpms @@ -95,7 +101,7 @@ then return msourcedir else return Nothing isPkgGit <- isPkgGitRepo - (patches,srcs) <- partitionEithers . map sourceFieldFile + (patches,srcs) <- partitionEithers . map sourcePatchFile <$> cmdLines "spectool" ["-a", spec] forM_ srcs $ \ src -> do exists <- doesFileExist src &&^ checkCompression src @@ -132,8 +138,8 @@ error' $ "missing patch:" +-+ patch return $ srcs ++ patches where - sourceFieldFile :: String -> Either FilePath FilePath - sourceFieldFile field = + sourcePatchFile :: String -> Either FilePath FilePath + sourcePatchFile field = case word1 field of (f,v) -> -- rpmdevtools 9.3 (spectool always lists --all) @@ -178,59 +184,75 @@ generateSrpm = generateSrpm' False generateSrpm' :: Bool -> Maybe AnyBranch -> FilePath -> IO FilePath -generateSrpm' force mbr spec = do +generateSrpm' = generateSrpmNoDist False + +generateSrpmNoDist :: Bool -> Bool -> Maybe AnyBranch -> FilePath -> IO FilePath +generateSrpmNoDist nodist force mbr spec = do srcs <- getSources spec - distopt <- case mbr of - Nothing -> return [] - Just br -> do - dist <- getBranchDist br - return $ distOpt dist + distopt <- + if nodist + then return ["--define", "dist %{nil}"] + else + case mbr of + Nothing -> return [] + Just br -> do + rbr <- releaseSystemBranch br + distOpt rbr msrcrpmdir <- rpmEval "%{_srcrpmdir}" - srpmfile <- cmd "rpmspec" $ ["-q", "--srpm"] ++ distopt ++ ["--qf", fromMaybe "" msrcrpmdir "%{name}-%{version}-%{release}.src.rpm", spec] - cwd <- getCurrentDirectory - let sourcediropt = ["--define", "_sourcedir" +-+ cwd] - opts = distopt ++ sourcediropt + autoreleaseOpt <- getAutoReleaseOptions spec + srpmfile <- cmd "rpmspec" $ ["-q", "--srpm"] ++ distopt ++ autoreleaseOpt ++ ["--qf", fromMaybe "" msrcrpmdir "%{name}-%{version}-%{release}.src.rpm", spec] + sourcediropt <- sourceDirCwdOpt + let srcrpmdiropt = maybe [] (\dir -> ["--define", "_srcrpmdir" +-+ dir]) + msrcrpmdir + opts = distopt ++ sourcediropt ++ srcrpmdiropt if force then - buildSrpm opts + buildSrpm srpmfile opts else do exists <- doesFileExist srpmfile if not exists - then buildSrpm opts + then buildSrpm srpmfile opts else do srpmTime <- getModificationTime srpmfile fileTimes <- mapM getModificationTime (spec:srcs) if any (srpmTime <) fileTimes - then buildSrpm opts + then buildSrpm srpmfile opts else do -- pretty print with ~/ putStrLn $ srpmfile +-+ "is up to date" return srpmfile where - buildSrpm opts = do - -- 1. prevent Ctrl-c from truncating srpm to corrupted file: - -- 'Error: Downloaded rpm http://kojipkgs-cache01.s390.fedoraproject.org/work/cli-build/1691493908.5614614.AzJmareV/ghc9.4-9.4.6-22.fc39.src.rpm is corrupted:' - -- 2. can end with stdout "RPM build warnings:" etc - -- https://github.com/rpm-software-management/rpm/issues/2494 - outs <- words <$> uninterruptibleMask_ (cmd "rpmbuild" (opts ++ ["-bs", spec])) + buildSrpm predicted opts = do + autospec <- isRpmAutospec spec + outs <- + -- prevent Ctrl-c from truncating srpm to corrupted file + fmap words . uninterruptibleMask_ $ + if autospec + then cmd "fedpkg" $ "srpm" : opts + else cmd "rpmbuild" (opts ++ ["-bs", spec]) case filter ("src.rpm" `isExtensionOf`) outs of [srpm] -> do putStrLn $ "Created" +-+ takeFileName srpm + unless (predicted == srpm) $ + warning $ "different to predicted NVR:" +-+ predicted return srpm srpms -> error' $ "could not determined generated srpm filename" +-+ unwords srpms +isRpmAutospec :: FilePath -> IO Bool +isRpmAutospec spec = do + isAutoChangelog spec ||^ isAutoRelease spec + data BCond = BuildWith String | BuildWithout String instance Show BCond where show (BuildWith s) = "--with=" ++ s show (BuildWithout s) = "--without=" ++ s - getAutoReleaseOptions :: FilePath -> IO [String] getAutoReleaseOptions spec = do autorelease <- isAutoRelease spec if autorelease then do - -- FIXME upstream bug "--number-only" doesn't work + -- upstream bug "--number-only" doesn't work calculated <- cmd "rpmautospec" ["calculate-release", spec] return ["--define", "_rpmautospec_release_number" +-+ dropPrefix "Calculated release number: " calculated] else return [] @@ -266,16 +288,15 @@ else do installDeps True spec void $ getSources spec - dist <- getBranchDist br - cwd <- getCurrentDirectory + distopt <- distOptAny br autoreleaseOpt <- getAutoReleaseOptions spec + sourcediropt <- sourceDirCwdOpt let buildopt = case mforceshort of Just ShortCompile -> ["-bc", "--short-circuit"] Just ShortInstall -> ["-bi", "--short-circuit"] _ -> "-bb" : ["--noclean" | noclean] - sourcediropt = ["--define", "_sourcedir" +-+ cwd] - args = sourcediropt ++ distOpt dist ++ + args = sourcediropt ++ distopt ++ buildopt ++ map show bconds ++ autoreleaseOpt ++ [spec] date <- cmd "date" ["+%T"] rbr <- anyBranchToRelease br @@ -385,11 +406,13 @@ src `notElem` gitfiles) sourcefiles unless (null missing) $ do + -- FIXME maybe change to yesNo promptEnter $ color Red $ unwords missing +-+ "not in sources, press Enter to fix" + -- FIXME check if already fixed before proceeding updatePkg True False False True Nothing pkg br git_ "status" ["--short"] - promptEnter "Please Enter to amend commit and continue" - git_ "commit" ["--amend"] + ok <- yesNo "Amend commit" + when ok $ git_ "commit" ["--amend"] unlessM isGitDirClean $ error' "local changes remain (dirty)" checkOnBranch diff --git a/src/Types.hs b/src/Types.hs --- a/src/Types.hs +++ b/src/Types.hs @@ -1,7 +1,8 @@ module Types ( Archs(..), SideTagTarget(..), - maybeTarget + maybeTarget, + ChangeType(..) ) where @@ -13,3 +14,6 @@ maybeTarget :: Maybe SideTagTarget -> Maybe String maybeTarget (Just (Target t)) = Just t maybeTarget _ = Nothing + +data ChangeType = ChangeBodhi | ChangeCommit | ChangeReview + deriving Eq