fbrnch 1.3.3 → 1.4
raw patch · 35 files changed
+734/−513 lines, 35 filesdep ~rpmbuild-order
Dependency ranges changed: rpmbuild-order
Files
- CHANGELOG.md +61/−1
- README.md +8/−8
- fbrnch.cabal +8/−7
- src/Bodhi.hs +9/−8
- src/Bugzilla.hs +4/−3
- src/Cmd/Build.hs +23/−22
- src/Cmd/Bump.hs +3/−3
- src/Cmd/Commit.hs +11/−5
- src/Cmd/Copr.hs +14/−13
- src/Cmd/FTBFS.hs +4/−4
- src/Cmd/Import.hs +15/−13
- src/Cmd/Install.hs +4/−3
- src/Cmd/Local.hs +24/−19
- src/Cmd/Merge.hs +2/−0
- src/Cmd/Mock.hs +14/−16
- src/Cmd/Override.hs +1/−1
- src/Cmd/Parallel.hs +67/−73
- src/Cmd/PkgReview.hs +21/−16
- src/Cmd/Prep.hs +1/−1
- src/Cmd/PullPush.hs +15/−9
- src/Cmd/RequestBranch.hs +22/−12
- src/Cmd/RequestRepo.hs +2/−0
- src/Cmd/Scratch.hs +17/−13
- src/Cmd/Sort.hs +3/−2
- src/Cmd/Status.hs +14/−12
- src/Cmd/Switch.hs +3/−3
- src/Cmd/Update.hs +77/−73
- src/Cmd/WaitRepo.hs +3/−2
- src/Common.hs +7/−4
- src/Git.hs +43/−25
- src/Koji.hs +30/−29
- src/ListReviews.hs +1/−0
- src/Main.hs +28/−15
- src/Package.hs +74/−45
- src/RpmBuild.hs +101/−53
CHANGELOG.md view
@@ -1,5 +1,65 @@ # Changelog +## 1.4 (2024-05-03)+- buildSrpm: filter .src.rpm filename+- checkSourcesMatch: prompt before amending and abort if still dirty+- getSources: handle no srcdir correctly when checking for sources+- pkgNameVerRel: only fedpkg verrel for autorelease if dist-git+- use rpm-nvr NVR type everywhere+- 'build': fail earlier if dirty+- 'build': replace --allow-dirty with --stash+- 'commit': don't look for unstaged local changes if --unstaged+- 'commit': don't print singleline commit msg unnecessarily+- 'commit': unquote macros from changelog diff for commit msg+- 'copr': don't use localBranchSpecFile rawhide+- 'copr','scratch': doc --exclude-arch only takes a single arch+- 'create-review': set bug url field with spec url+- 'ftbfs': include Modified bugs+- 'import': use Yes/no prompt to push+- 'install': now defaults to verbose build output with a --quiet option+- 'local','install': -c short option for --short-compile+- 'local','install': re-backup previous buildlog if bigger than current+- 'merge': add newline after unmerged commits+- 'mock': can now build from non-dist-git+- 'move-artifacts': allow dirty+- 'move-artifacts': improve arch/rpms dir logic+- 'parallel': assert git is clean before pushing+- 'parallel': don't error if no builds to push to Bodhi+- 'parallel': no longer wait for bodhi to transition to request-testing+- 'parallel': use dependencyLayersRpmOpts from rpmbuild-order-0.4.11+- 'parallel': use koji-tool tasks to get failed build.log url+- 'parallel': use pluralException to special case zero+- 'pull': --stash does git stash and pop around git pull+- 'request-branches': filter for processed pending branches+- 'request-repos': print bz url before proceeding+- 'review-package': do not assume cwd matches pkg name+- 'scratch' --allow-head detached with gitSwitchBranchVerbose+- 'sort': distRpmOptions defines %fedora/%rhel %fcN/%elN+- 'switch' --verbose++earlier changes from November:++- 'build','parallel': checkSourcesMatch now offers to 'update-sources'+- 'build': only check tags if overriding+- 'builddeps': renamed from 'install-deps'+- 'commit': if 2 lines then add second without - prefix+- 'copr': small refactor to get more precise build log url+- 'create-review': assert spec file exists+- 'import': add --existing to allow importing to an existing repo+- 'mock': make it possible to run for non-distgit dir+- 'parallel': print sidetag info early+- 'parallel': append ':' after package in bodhi notes+- 'parallel': branches should be dist-git+- 'parallel': various layer output/prompt improvements+- 'request-branches': add --reviews and change --recurse-from -r to -R+- 'create/update-review': improve buildAndUpload messages to depend on scratch+- Koji targetMaybeSidetag: newline before printing new sidetag+- RpmBuild buildRPMs: define `_rpmautospec_release_number` for autorelease+- RpmBuild buildRPMs: prepend %distprefix to disttag+- RpmBuild: fix local handling of dyn BRs+- RpmBuild: handle %autorelease locally with distOpt and autoreleaseOpt+- targetMaybeSidetag now has a create switch+ ## 1.3.3 (2023-10-19) - 'bump': add --dry-run - 'copr': track pkg name to output build results url on failure@@ -25,7 +85,7 @@ - Main: --dry-run options now better described - RpmBuild: prevent srpm creation from being interrupted (eg ctrl-c) - gitFetchSilent: use \r to hide "git fetching..."-- kojiBuild: remove "Take info: " prefix before koji task url+- kojiBuild: remove "Task info: " prefix before koji task url - kojiWatchTask: do not hardcode koji-tool path - pkgNameVerRel: use fedpkg to determine correct %autorelease (#39) - refPrompt: do not trim input for more precision
README.md view
@@ -39,7 +39,7 @@ One can change the branch of one or more packages: ```-$ fbrnch switch f39 [package] ...+$ fbrnch switch f40 [package] ... ``` You can also git pull over packages:@@ -97,13 +97,13 @@ You can merge branches with: ```-$ fbrnch merge f38 package+$ fbrnch merge f39 package ``` which will offer to merge f39 (or up to a git hash you choose) into f38. Merging can also be done together with building: ```-$ fbrnch build f38 package+$ fbrnch build f39 package ``` will ask if you want to merge newer commits from a newer branch, then push and build it.@@ -258,15 +258,15 @@ ### Other commands There are a lot more commands, like eg `copr` and `graph`: -Here is an "extreme" [example](https://github.com/fedora-haskell/haskell-language-server/blob/main/build.sh) of a script using `fbrnch copr` to do multiple staggered builds.- ## Help `$ fbrnch --version`+ ```-1.3.3+1.4 ``` `$ fbrnch --help`+ ``` Fedora branch building tool @@ -308,7 +308,7 @@ compare Show commits between branches src-deps List source package dependencies mock Local mock build- install-deps Install package build dependencies+ builddeps Install package build dependencies install Build locally and install package(s) not-installed Packages not installed locally bugs List package bugs@@ -439,7 +439,7 @@ inspired by the older fedora-haskell-tools project. I have given a couple of short talks about fbrnch:-- Nest with Fedora: [youtube](https://www.youtube.com/watch?v=40kTBsA674U) and [slides](https://github.com/juhp/presentations/blob/master/fedora-nest-2020-fbrnch/fbrnch-nest.md)+- Nest with Fedora 2020: [youtube](https://www.youtube.com/watch?v=40kTBsA674U) and [slides](https://github.com/juhp/presentations/blob/master/fedora-nest-2020-fbrnch/fbrnch-nest.md) - Lightning talk for devconf.cz 2021: [youtube](https://www.youtube.com/watch?v=O2-6rDuPMRA&t=2s) ## Contribute
fbrnch.cabal view
@@ -1,10 +1,11 @@ cabal-version: 2.0 name: fbrnch-version: 1.3.3+version: 1.4 synopsis: Fedora packager tool to build package branches description:- fbrnch (fedora branch) is a convenient packaging tool for- Fedora Packagers, with integration for Bugzilla, Koji, and Bodhi.+ fbrnch (fedora branch or "f-branch" for short) is+ a convenient packaging tool for Fedora Packagers,+ with integration for Bugzilla, Koji, and Bodhi. . Features include: .@@ -27,14 +28,14 @@ license-file: LICENSE author: Jens Petersen <petersen@redhat.com> maintainer: Jens Petersen <petersen@fedoraproject.org>-copyright: 2019-2023 Jens Petersen+copyright: 2019-2024 Jens Petersen category: Distribution build-type: Simple extra-doc-files: CHANGELOG.md README.md tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5,- GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.7,- GHC == 9.4.5+ GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.8,+ GHC == 9.4.8, GHC == 9.6.5, GHC == 9.8.2 source-repository head type: git@@ -122,7 +123,7 @@ pretty-terminal, process, -- regex-tdfa,- rpmbuild-order >= 0.4.10,+ rpmbuild-order >= 0.4.11, rpm-nvr >= 0.1.2, simple-cmd >= 0.2.3, simple-cmd-args >= 0.1.8,
src/Bodhi.hs view
@@ -16,6 +16,7 @@ #endif import Data.Aeson.Types (Object, (.:), parseEither) import Data.Char (isDigit)+import Data.RPM.NVR (NVR) import Fedora.Bodhi hiding (bodhiUpdate) import SimplePrompt (promptEnter, promptNonEmpty) import Text.Read@@ -52,15 +53,15 @@ -- FIXME should determine 3 days for branched devel release -- FIXME handle expired override?-bodhiCreateOverride :: Bool -> Maybe Int -> String -> IO ()+bodhiCreateOverride :: Bool -> Maybe Int -> NVR -> IO () bodhiCreateOverride dryrun mduration nvr = do- putStrLn $ "Creating Bodhi Override for" +-+ nvr ++ ":"+ putStrLn $ "Creating Bodhi Override for" +-+ showNVR nvr ++ ":" unless dryrun $ do- ok <- cmdBool "bodhi" ["overrides", "save", "--notes", "chain building with fbrnch", "--duration", show (fromMaybe 4 mduration), "--no-wait", nvr]+ ok <- cmdBool "bodhi" ["overrides", "save", "--notes", "chain building with fbrnch", "--duration", show (fromMaybe 4 mduration), "--no-wait", showNVR nvr] if ok- then putStrLn $ "https://bodhi.fedoraproject.org/overrides/" ++ nvr+ then putStrLn $ "https://bodhi.fedoraproject.org/overrides/" ++ showNVR nvr else do- moverride <- bodhiOverride nvr+ moverride <- bodhiOverride $ showNVR nvr case moverride of Nothing -> do putStrLn "bodhi override failed"@@ -127,7 +128,7 @@ -- push comma separated list of builds for a package to bodhi bodhiUpdate :: Bool -> (Maybe UpdateType, UpdateSeverity) -> Maybe BugId -> Bool -> FilePath -> String -> IO ()-bodhiUpdate _ _ _ _ _ [] = error' "cannot make empty update"+bodhiUpdate _ _ _ _ _ [] = putStrLn "no package to push" bodhiUpdate dryrun (mupdate,severity) mreview usechangelog spec nvrs = do case mupdate of Nothing -> return ()@@ -206,7 +207,7 @@ maybeTemplate TemplateUpdate maybeTemplate _ = return Nothing -bodhiBuildExists :: String -> IO Bool+bodhiBuildExists :: NVR -> IO Bool bodhiBuildExists nvr = do- obj <- bodhiBuild nvr+ obj <- bodhiBuild $ showNVR nvr return $ isNothing (lookupKey "status" obj :: Maybe String)
src/Bugzilla.hs view
@@ -79,6 +79,7 @@ import qualified Data.ByteString.Char8 as B import Data.ByteString.UTF8 import Data.Ini.Config+import Data.RPM.NVR (NVR) import Network.HTTP.Conduit import Network.HTTP.Query import Network.HTTP.Simple@@ -134,12 +135,12 @@ (B.pack k, fromString v) : encodeParams ps -- FIXME check original status?-putBugBuild :: Bool -> BugzillaSession -> BugId -> String -> IO ()+putBugBuild :: Bool -> BugzillaSession -> BugId -> NVR -> IO () putBugBuild dryrun session bid nvr = do unless dryrun $ void $ updateBug session bid- [("cf_fixed_in", nvr), ("status", "MODIFIED")]- putStrLn $ "bug" +-+ show bid ++ (if dryrun then " would be" else "") +-+ "moved to MODIFIED with" +-+ nvr+ [("cf_fixed_in", showNVR nvr), ("status", "MODIFIED")]+ putStrLn $ "bug" +-+ show bid ++ (if dryrun then " would be" else "") +-+ "moved to MODIFIED with" +-+ showNVR nvr brc :: T.Text brc = "bugzilla.redhat.com"
src/Cmd/Build.hs view
@@ -32,7 +32,7 @@ , buildoptUpdate :: (Maybe UpdateType, UpdateSeverity) , buildoptUseChangelog :: Bool , buildoptByPackage :: Bool- , buildoptAllowDirty :: Bool+ , buildoptStash :: Bool } -- FIXME --yes@@ -58,7 +58,7 @@ then Just (Package (last pkgs)) else Nothing gitopts- | buildoptAllowDirty opts = dirtyGitActive+ | buildoptStash opts = stashGitFetch | buildoptSkipFetch opts = cleanGitActive | otherwise = cleanGitFetchActive if not (buildoptByPackage opts) && breq /= Branches [] && length pkgs > 1@@ -70,6 +70,7 @@ withPackagesByBranches HeaderMay True gitopts singleBrnch (buildBranch mlastOfPkgs opts) (breq, pkgs) -- FIXME what if untracked files+-- FIXME --merge instead of --yes confusing buildBranch :: Maybe Package -> BuildOpts -> Package -> AnyBranch -> IO () buildBranch _ _ _ (OtherBranch _) = error' "build only defined for release branches"@@ -103,7 +104,7 @@ return False let spec = packageSpec pkg checkForSpecFile spec- checkSourcesMatch spec+ checkSourcesMatch pkg (RelBranch br) spec unpushed <- gitOneLineLog $ "origin/" ++ show br ++ "..HEAD" nvr <- pkgNameVerRel' br spec putNewLn@@ -112,7 +113,7 @@ then return Nothing else do when (not merged || br == Rawhide) $ do- putStrLn $ nvr ++ "\n"+ putStrLn $ showNVR nvr ++ "\n" putStrLn "Local commits:" displayCommits True unpushed putNewLn@@ -124,10 +125,10 @@ buildstatus <- maybeTimeout 30 $ kojiBuildStatus nvr let msidetagTarget = buildoptSidetagTarget opts mwaitrepo = buildoptWaitrepo opts- target <- targetMaybeSidetag dryrun br msidetagTarget+ target <- targetMaybeSidetag dryrun True br msidetagTarget case buildstatus of Just BuildComplete -> do- putStrLn $ nvr +-+ "is already built"+ putStrLn $ showNVR nvr +-+ "is already built" when (isJust mpush) $ error' "Please bump the spec file" when (br /= Rawhide && isNothing msidetagTarget) $ do@@ -139,20 +140,20 @@ then putStrLn "update exists" else do mbug <- bzReviewAnon- bodhiUpdate dryrun (buildoptUpdate opts) mbug (buildoptUseChangelog opts) spec nvr- tags <- maybeTimeout 30 $ kojiNVRTags nvr- unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $- whenJust moverride $ \days ->- bodhiCreateOverride dryrun (Just days) nvr+ 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 $ nvr +-+ "is already building"+ putStrLn $ showNVR nvr +-+ "is already building" when (isJust mpush) $ error' "Please bump the spec file"- whenJustM (kojiGetBuildTaskID fedoraHub nvr) kojiWatchTask+ whenJustM (kojiGetBuildTaskID fedoraHub (showNVR nvr)) kojiWatchTask -- FIXME do override _ -> do mbuildref <-@@ -162,7 +163,7 @@ opentasks <- kojiOpenTasks pkg mbuildref target case opentasks of [task] -> do- putStrLn $ nvr +-+ "task" +-+ displayID task +-+ "is already open"+ putStrLn $ showNVR nvr +-+ "task" +-+ displayID task +-+ "is already open" when (isJust mpush) $ error' "Please bump the spec file" kojiWatchTask task@@ -171,11 +172,11 @@ let tag = if target == branchTarget br then branchDestTag br else target mlatest <- kojiLatestNVR tag $ unPackage pkg- if equivNVR nvr (fromMaybe "" mlatest)- then putStrLn $ nvr +-+ "is already latest" +-+ if Just nvr /= mlatest then "(modulo disttag)" else ""+ 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 $ nvr ++ "\n"+ putStrLn $ showNVR nvr ++ "\n" firstBuild <- do mtestingRepo <- bodhiTestingRepo br case mtestingRepo of@@ -188,9 +189,12 @@ 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:" +-+ newest +-+ "still in testing?"+ 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 $@@ -199,9 +203,6 @@ unless dryrun $ do ok <- yesNo "Unpushed changes remain, continue" unless ok $ error' "aborted"- unless (buildoptAllowDirty opts) $- unlessM isGitDirClean $- error' "local changes remain (dirty)" -- FIXME parse build output unless dryrun $ kojiBuildBranch target pkg mbuildref ["--fail-fast" | not (buildoptNoFailFast opts)]@@ -218,7 +219,7 @@ whenJust (fmap fst mBugSess) $ \bid -> putStr "review bug: " >> putBugId bid -- FIXME diff previous changelog?- bodhiUpdate dryrun (buildoptUpdate opts) (fmap fst mBugSess) (buildoptUseChangelog opts) spec nvr+ 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
src/Cmd/Bump.hs view
@@ -42,11 +42,11 @@ else case br of RelBranch rbr' ->- let tag = branchDestTag rbr' in- kojiLatestNVR tag $ unPackage pkg+ let tag = branchDestTag rbr'+ in kojiLatestNVR tag $ unPackage pkg -- FIXME fallback to local? _ -> return Nothing- if equivNVR newnvr (fromMaybe "" moldnvr)+ if equivNVR newnvr moldnvr then do git_ "log" ["origin..HEAD", "--pretty=oneline"] let clmsg =
src/Cmd/Commit.hs view
@@ -29,7 +29,7 @@ unlessM isGitDirClean $ do getPackageName dir >>= putPkgHdr addall <-- if null paths+ if null paths && not unstaged then null <$> git "diff" ["--cached"] else return unstaged opts <- case mopt of@@ -44,18 +44,19 @@ clog <- lines <$> cleanChangelog spec case clog of [] -> readCommitMsg- [msg] -> putStrLn msg >> return msg+ [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 diff) clog+ filter (\c -> ('+' : c) `elem` lines (unquoteMacros diff)) clog case newlogs of [] -> putStrLn diff >> readCommitMsg- [msg] -> putStrLn msg >>- return (removePrefix "- " msg)+ [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]@@ -67,3 +68,8 @@ if tty then promptNonEmpty "\nPlease input the commit message" else error' "please input commit message in a terminal"++unquoteMacros :: String -> String+unquoteMacros [] = []+unquoteMacros ('%':'%':cs) = '%':unquoteMacros cs+unquoteMacros (c:cs) = c : unquoteMacros cs
src/Cmd/Copr.hs view
@@ -70,7 +70,7 @@ BranchOpt AllEPEL -> filter isEPELBranch <$> getFedoraBranched _ -> listOfBranches False False breq let buildroots =- reverseSort $+ -- FIXME sort archs appropriately case marchs of Nothing -> [chroot | chroot <- chroots, removeArch chroot `elem` map branchRelease branches]@@ -82,41 +82,41 @@ then error' "No valid chroots" else return buildroots - coprBuildPkg buildroots morepkgs pkg = do+ coprBuildPkg buildroots morepkgs _pkg = do -- FIXME check is pkg.spec- spec <- 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 pkg buildroots+ 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 pkg initialChroots remainingChroots+ 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 pkg initialChroots remainingChroots+ staggerBuilds srpm spec initialChroots remainingChroots BuildByRelease -> do let releaseChroots = groupBy sameRelease buildroots- staggerBuilds srpm pkg releaseChroots []+ staggerBuilds srpm spec releaseChroots [] when morepkgs putNewLn removeArch relarch = init $ dropWhileEnd (/= '-') relarch takeArch = takeWhileEnd (/= '-') - staggerBuilds srpm pkg initialChroots remainingChroots = do- mapM_ (coprBuild dryrun project srpm pkg) initialChroots+ staggerBuilds srpm spec initialChroots remainingChroots = do+ mapM_ (coprBuild dryrun project srpm spec) initialChroots unless (null remainingChroots) $- coprBuild dryrun project srpm pkg remainingChroots+ coprBuild dryrun project srpm spec remainingChroots releaseArch = takeWhileEnd (/= '-') @@ -153,9 +153,9 @@ let config = parseIniFile ini iniparser return $ either error' record config -coprBuild :: Bool -> String -> FilePath -> Package -> [String] -> IO ()+coprBuild :: Bool -> String -> FilePath -> FilePath -> [String] -> IO () coprBuild _ _ _ _ [] = error' "No chroots chosen"-coprBuild dryrun project srpm pkg buildroots = do+coprBuild dryrun project srpm spec buildroots = do let chrootargs = mconcat [["-r", bldrt] | bldrt <- buildroots] buildargs = ["build", "--nowait"] ++ chrootargs ++ [project, srpm] putNewLn@@ -173,7 +173,8 @@ let zbid = let s = show bid in (if length s < 8 then ('0' :) else id) s- error' $ "https://download.copr.fedorainfracloud.org/results" +/+ username +/+ project +/+ head buildroots +/+ zbid ++ "-" ++ unPackage pkg+ 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 idea: Maybe Seconds to increment sleep coprWatchBuild :: Int -> Maybe String -> IO Bool
src/Cmd/FTBFS.hs view
@@ -47,8 +47,8 @@ query = ftbfsFedoraBugs .&&. case mbr of- Nothing -> statusNewPost- Just br -> statusNewPost .&&. versionIs (branchVersion br)+ Nothing -> statusNewModified+ Just br -> statusNewModified .&&. versionIs (branchVersion br) ftbfsBugs :: BugzillaSession -> Bug -> IO () ftbfsBugs session bug = do@@ -80,13 +80,13 @@ mstatus <- kojiBuildStatus nvr case mstatus of Nothing -> do- putStrLn $ nvr ++ ": unknown status"+ putStrLn $ showNVR nvr ++ ": unknown nvr" putBug bug Just status -> do print status case status of BuildFailed -> do- cmdLog "koji-tool" ["tasks", "-T", "-s", "fail", "-b", nvr]+ cmdLog "koji-tool" ["tasks", "-T", "-s", "fail", "-b", showNVR nvr] putNewLn BuildComplete -> do if bugStatus bug `elem` ["NEW", "ASSIGNED", "POST"]
src/Cmd/Import.hs view
@@ -7,7 +7,7 @@ import qualified Common.Text as T import Network.URI-import SimplePrompt (promptEnter)+import SimplePrompt (promptEnter, yesNoDefault) import Branches import Bugzilla@@ -20,8 +20,8 @@ -- FIXME separate pre-checked listReviews and direct pkg call, which needs checks -- FIXME add --dryrun-importCmd :: Bool -> (BranchesReq,[String]) -> IO ()-importCmd mock (breq, ps) = do+importCmd :: Bool -> Bool -> (BranchesReq,[String]) -> IO ()+importCmd existingrepo mock (breq, ps) = do pkgs <- if null ps then map reviewBugToPackage <$> listReviews ReviewRepoCreated else return ps@@ -33,17 +33,18 @@ putPkgHdr (Package pkg) dir <- getCurrentDirectory when (pkg /= takeFileName dir) $ do- -- FIXME check git repo exists- clonePkg True UserClone Nothing pkg- putNewLn+ exists <- doesDirectoryExist pkg+ unless exists $ do+ clonePkg True UserClone Nothing pkg+ putNewLn setCurrentDirectory pkg -- FIXME: check branch is rawhide unlessM isGitRepo $ error' "Not a git repo" newrepo <- initialPkgRepo- if not newrepo+ if not newrepo && not existingrepo then putStrLn "Skipping: already imported" else do- checkWorkingDirClean+ checkWorkingDirClean False -- FIXME get session from importPkgs (bid,session) <- approvedReviewBugIdSession pkg putBugId bid@@ -73,11 +74,12 @@ fedpkg_ "import" [srpmfile] git_ "commit" ["--message", "import rhbz#" ++ show bid] nvr <- pkgNameVerRel' Rawhide (pkg <.> "spec")- promptEnter $ "Press Enter to push and build" +-+ nvr- gitPush True Nothing- -- FIXME build more branches- kojiBuildBranch "rawhide" (Package pkg) Nothing ["--fail-fast"]- putBugBuild False session bid nvr+ 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
src/Cmd/Install.hs view
@@ -23,13 +23,14 @@ -- FIXME --rpm to avoid dnf -- FIXME --force removal of existing incompatible dependent packages -- FIXME --subpackage to specify subpackage(s) to install/add+-- FIXME --exclude to specify subpackage(s) not to install -- FIXME --ignore-uninstalled subpackages -- FIXME --skip-unavailable -- 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 verbose recurse mfrom mforceshort bconds reinstall nobuild nobuilddeps allsubpkgs (mbr, pkgs) = do+installCmd quiet recurse mfrom mforceshort bconds reinstall nobuild nobuilddeps allsubpkgs (mbr, pkgs) = do when (recurse && isShortCircuit mforceshort) $ error' "cannot use --recurse and --shortcircuit" withPackagesMaybeBranch (boolHeader (recurse || length pkgs > 1)) True Nothing installPkg (mbr, pkgs)@@ -70,14 +71,14 @@ mpkgdir <- lookForPkgDir rbr ".." dep case mpkgdir of Nothing -> putStrLn $ dep +-+ "not known"- Just pkgdir -> installCmd verbose recurse mfrom mforceshort bconds reinstall nobuild nobuilddeps allsubpkgs (mbr, [pkgdir]) >> putNewLn+ Just pkgdir -> installCmd quiet recurse mfrom mforceshort bconds reinstall nobuild nobuilddeps allsubpkgs (mbr, [pkgdir]) >> putNewLn -- FIXME option to enable/disable installing missing deps -- FIXME --skip-missing-deps or prompt else installDeps True spec wasbuilt <- if nobuild then return True- else buildRPMs (not verbose) False False mforceshort' bconds rpms br spec+ else buildRPMs quiet False False mforceshort' bconds rpms br spec unless (isShortCircuit mforceshort') $ do toinstalls <- if allsubpkgs
src/Cmd/Local.hs view
@@ -69,7 +69,7 @@ OtherBranch _obr -> do sbr <- systemBranch pkgNameVerRel' sbr spec- >>= putStrLn+ >>= putStrLn . showNVR -- FIXME option to require spec file? commandCmd :: Bool -> Bool -> Bool -> String -> (BranchesReq,[String])@@ -172,6 +172,7 @@ 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)@@ -195,13 +196,14 @@ moveArtifactsCmd :: Bool -> [String] -> IO () moveArtifactsCmd remove pkgs =- withPackagesByBranches HeaderMay False dirtyGit Zero moveArtifactsPkg (Branches [], pkgs)+ withPackagesByBranches HeaderMay False Nothing Zero moveArtifactsPkg (Branches [], pkgs) where moveArtifactsPkg :: Package -> AnyBranch -> IO () moveArtifactsPkg pkg br = do cwd <- getCurrentDirectory whenJustM (rpmEval "%_rpmdir") $ \rpmdir -> unless (rpmdir == cwd) $ do+ -- FIXME hardcoding moveRPMS rpmdir "x86_64" moveRPMS rpmdir "noarch" ls <- listDirectory "."@@ -236,20 +238,23 @@ else renameDirectory tree $ builddir </> tree moveRPMS :: FilePath -> FilePath -> IO ()- moveRPMS rpmdir dir =- whenM (doesDirectoryExist dir) $- whenM (doesDirectoryExist (rpmdir </> dir)) $ do- rpms <- listDirectory dir- forM_ rpms $ \rpm -> do- let file = dir </> rpm- exists <- doesFileExist $ rpmdir </> file- if exists- then if remove- then removeFile file- else putStrLn $ "duplicate:" +-+ file- else do- createDirectoryIfMissing False rpmdir- renameFile file $ rpmdir </> file- left <- listDirectory dir- when (null left) $- removeDirectory dir+ moveRPMS rpmdir archdir =+ whenM (doesDirectoryExist archdir) $ do+ haveRpmDir <- doesDirectoryExist (rpmdir </> archdir)+ if haveRpmDir+ then do+ rpms <- listDirectory archdir+ forM_ rpms $ \rpm -> do+ let file = archdir </> rpm+ exists <- doesFileExist $ rpmdir </> file+ if exists+ then if remove+ then removeFile file+ else putStrLn $ "duplicate:" +-+ file+ else renameFile file $ rpmdir </> file+ left <- listDirectory archdir+ when (null left) $+ removeDirectory archdir+ else do+ createDirectoryIfMissing False rpmdir+ renameDirectory archdir $ rpmdir </> archdir
src/Cmd/Merge.hs view
@@ -69,6 +69,7 @@ isnewrepo <- initialPkgRepo putStrLn $ (if isnewrepo || noprompt then "Merging from" else "New commits in") +-+ show from ++ ":" displayCommits showall unmerged+ putNewLn unpushed <- gitOneLineLog $ "origin/" ++ show br ++ "..HEAD" unless (null unpushed) $ do putStrLn "Local commits:"@@ -88,6 +89,7 @@ unless (show from `elem` locals) $ git_ "fetch" ["origin", show from ++ ":" ++ show from] unless dryrun $+ -- FIXME merge from origin by default not local branch git_ "merge" ["--quiet", ref] mergeBranch dryrun build noprompt showall mpkg (False,unmerged) from br = do unless build $ whenJust mpkg $ flip putPkgBrnchHdr br
src/Cmd/Mock.hs view
@@ -26,23 +26,26 @@ mockCmd :: Bool -> Maybe NoClean -> Bool-> Maybe MockShell -> Maybe Branch -> Maybe String -> (BranchesReq, [String]) -> IO () mockCmd dryrun mnoclean network mockshell mroot march (breq, ps) = do+ pkggit <- isPkgGitRepo branches <- case breq of Branches [] ->- if null ps- then pure <$> getReleaseBranch- else pure <$> systemBranch+ pure <$>+ if null ps && pkggit+ then getReleaseBranch+ else systemBranch _ -> listOfBranches False False breq when (null branches && length ps > 1 && isNothing mroot) $ error' "Must specific branch or --root chroot" let packages = if null ps then ["."] else ps- mapM_ (mockBuildPkgs (breq == Branches []) packages) branches+ mapM_ (mockBuildPkgs pkggit (breq == Branches []) packages) branches where- mockBuildPkgs :: Bool -> [String] -> Branch -> IO ()- mockBuildPkgs noswitch pkgs br = do+ mockBuildPkgs :: Bool -> Bool -> [String] -> Branch -> IO ()+ mockBuildPkgs pkggit noswitch pkgs br = do srpms <- mapM (prepSrpm (RelBranch br)) pkgs putNewLn- rootBr <- maybe getReleaseBranch return mroot+ -- FIXME? is it better just to fail asking for target branch?+ rootBr <- maybe (if pkggit then getReleaseBranch else systemBranch) return mroot let resultdir = case srpms of [] -> error' "cannot build zero packages"@@ -78,13 +81,8 @@ withExistingDirectory pkgdir $ do pkg <- getPackageName pkgdir putPkgHdr pkg- actualBr <-- ifM- (notM isPkgGitRepo)- (return rbr)- ( if noswitch- then gitCurrentBranch- else gitSwitchBranch rbr >> return rbr- )+ whenM isPkgGitRepo $+ unless noswitch $+ gitSwitchBranch rbr spec <- findSpecfile- generateSrpm (Just actualBr) spec+ generateSrpm Nothing spec
src/Cmd/Override.hs view
@@ -44,7 +44,7 @@ let spec = packageSpec pkg checkForSpecFile spec nvr <- pkgNameVerRel' br spec- putStrLn nvr+ putStrLn $ showNVR nvr tags <- kojiNVRTags nvr unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $ unlessM (checkAutoBodhiUpdate br) $
src/Cmd/Parallel.hs view
@@ -8,11 +8,9 @@ import Common.System import Control.Concurrent.Async-import Data.Aeson (Object,Value(String))-import qualified Data.Text as T-import Distribution.RPM.Build.Order (dependencyLayers)+import Data.RPM.NVR (NVR)+import Distribution.RPM.Build.Order (dependencyLayersRpmOpts) import Fedora.Bodhi hiding (bodhiUpdate)-import qualified Fedora.Bodhi as FedoraBodhi (bodhiUpdate) import SimplePrompt (prompt, promptEnter, yesNo) import System.Console.Pretty import System.Time.Extra (sleep)@@ -25,11 +23,11 @@ import Krb import Koji import Package-import RpmBuild (checkSourcesMatch, getDynSourcesMacros)+import RpmBuild (checkSourcesMatch, distRpmOptions, getDynSourcesMacros) import Types data JobDone = Done {_jobPkg :: Package,- jobNvr :: String, -- maybe NVR?+ jobNvr :: NVR, jobBranch :: Branch, _jobClog :: String} @@ -45,6 +43,8 @@ -- FIXME time builds -- FIXME copy bodhi notes from another branch update -- 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) -> (BranchesReq, [String]) -> IO ()@@ -60,11 +60,10 @@ _ -> case breq of Branches [] -> error' "please specify a branch" Branches _ -> listOfBranches True True breq- _ -> listOfBranches False True breq+ _ -> listOfBranches True True breq when (null branches) $ error' "Please specify at least one branch"- let mtarget = maybeTarget msidetagTarget- when (isJust mtarget && length branches > 1) $+ when (isJust (maybeTarget msidetagTarget) && length branches > 1) $ error' "You can only specify target with one branch" case pkgs of [] -> getPackageName "." >>= parallelBranches branches@@ -72,22 +71,34 @@ getPackageName p >>= parallelBranches branches _ -> forM_ branches $ \rbr -> do+ mtargetSidetag <-+ if msidetagTarget == Just SideTag+ then do+ tags <- map (head . words) <$> kojiUserSideTags (Just rbr)+ case tags of+ [] -> do+ putStrLn "will use new sidetag"+ return $ Just SideTag+ [tag] -> do+ putStrLn $ "will use" +-+ tag+ return $ Just (Target tag)+ _ -> error' $ "multiple existing sidetags:" +-+ show tags+ else return msidetagTarget forM_ pkgs $ \p -> when (mmerge /= Just False) $ withExistingDirectory p $ do pkg <- getPackageName p mergeNewerBranch (Just pkg) rbr getDynSourcesMacros $ packageSpec pkg- allLayers <- dependencyLayers pkgs+ distopts <- distRpmOptions rbr+ allLayers <- dependencyLayersRpmOpts distopts pkgs let layers = drop firstlayer allLayers when (isNothing msidetagTarget && length allLayers > 1) $ unlessM (checkAutoBodhiUpdate rbr) $ error' "You must use --target/--sidetag to build package layers for this branch" when (length branches > 1) $ putStrLn $ "#" +-+ show rbr- target <- targetMaybeSidetag dryrun rbr msidetagTarget- when (msidetagTarget == Just SideTag) $- putStrLn $ "Target:" +-+ target+ target <- targetMaybeSidetag dryrun True rbr mtargetSidetag nvrclogs <- concatMapM (timeIO . parallelBuild target rbr) (zip [firstlayer..length allLayers] $ init $ tails layers) -- tails ends in []@@ -110,7 +121,7 @@ parallelBranches brs pkg = do krbTicket currentbranch <- gitCurrentBranch- putStrLn $ "= Building" +-+ pluralException (length brs) "branch" "branches" +-+ "in parallel:"+ putStrLn $ "= Building" +-+ pluralException (length brs) Nothing "branch" "branches" +-+ "in parallel:" putStrLn $ unwords $ map show brs jobs <- mapM setupBranch brs (failures,nvrclogs) <- timeIO $ watchJobs (length jobs == 1) Nothing [] [] jobs@@ -124,14 +135,14 @@ when (isNothing msidetagTarget) $ do let spec = packageSpec pkg bodhiUpdate dryrun mupdate Nothing False spec $- intercalate "," . map jobNvr $+ intercalate "," . map (showNVR . jobNvr) $ filter ((/= Rawhide) . jobBranch) nvrclogs where -- FIXME time jobs setupBranch :: Branch -> IO JobAsync setupBranch br = do putPkgBrnchHdr pkg br- target <- targetMaybeSidetag dryrun br msidetagTarget+ target <- targetMaybeSidetag dryrun True br msidetagTarget when (mmerge /= Just False) $ mergeNewerBranch Nothing br job <- startBuild Nothing 0 False (length brs) target pkg br "." >>= async unless dryrun $ sleep delay@@ -155,17 +166,13 @@ putStrLn $ "\n= Building" +-+ (if singlelayer then "in parallel"- else "parallel layer #" ++ show layernum) +++ else (if null nextLayers && not singlelayer then "final" else "") +-+ "parallel layer #" ++ show layernum) ++ if nopkgs > 1 then " (" ++ show nopkgs +-+ "packages):" else ":" putStrLn $ unwords layer -- maybe print total pending packages- if null nextLayers- then- unless singlelayer $- putStrLn "no more layers"- else+ unless (null nextLayers) $ putStrLn $ let layerspkgs = map length nextLayers in case layerspkgs of@@ -183,14 +190,17 @@ putStrLn $ "\nBuild failures" +-+ (if singlelayer then ":" else "in layer" +-+ show layernum ++ ":") +-+ unwords failures- okay <- yesNo "Do you want to continue nevertheless"+ okay <-+ if null nextLayers+ then return False+ else yesNo "Do you want to continue nevertheless" if okay then return nvrs else error' $- plural pending "pending package" ++- if pending > 0- then ":\n" ++ unwords (map unwords nextLayers)- else ""+ plural pending "pending package" +++ if pending > 0+ then ":\n" ++ unwords (map unwords nextLayers)+ else "" where nopkgs = length layer layersleft = length nextLayers@@ -216,7 +226,6 @@ unless singlejob $ when (null jobs) $ putStrLn $ "ending" +-+ maybe "" (\l -> "layer" +-+ show l) mlayer- -- else plural (length jobs) "job" +-+ "left" +-+ maybe "" (\l -> "in layer" +-+ show l) mlayer watchJobs singlejob mlayer fails (done:dones) jobs Just (Left except) -> do print except@@ -230,19 +239,23 @@ startBuild mlayer n morelayers nopkgs target pkg br dir = withExistingDirectory dir $ do gitSwitchBranch (RelBranch br)+ unlessM isGitDirClean $+ error' "local uncommitted changes (dirty)" let spec = packageSpec pkg checkForSpecFile spec nvr <- pkgNameVerRel' br spec unpushed <- gitOneLineLog $ "origin/" ++ show br ++ "..HEAD" unless (null unpushed) $ do- putStrLn $ nvr +-+ "(" ++ target ++ ")" +-++ putStrLn $ showNVR nvr +-+ "(" ++ target ++ ")" +-+ if nopkgs > 1- then pluralException n "more" "more" +-+ maybe "" (\l -> "in layer" +-+ show l) mlayer+ then pluralException n (if morelayers then Nothing else Just "last") "more" "more" +-+ maybe "" (\l -> "in layer" +-+ show l) mlayer else "" putNewLn displayCommits True unpushed unless (null unpushed) $ do- checkSourcesMatch spec+ checkSourcesMatch pkg (RelBranch br) spec+ unlessM isGitDirClean $+ error' "local changes remain (dirty)" unless dryrun $ gitPush True Nothing changelog <- unlines <$> getChangelog spec@@ -254,7 +267,7 @@ case buildstatus of Just BuildComplete -> do -- FIXME detect old stable existing build- putStrLn $ color Green nvr +-+ "is already" +-+ color Green "built"+ putStrLn $ 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"]) $@@ -265,17 +278,17 @@ kojiWaitRepo dryrun (nopkgs > 5) True target nvr return $ Done pkg nvr br changelog Just BuildBuilding -> do- putStrLn $ color Yellow nvr +-+ "is already" +-+ color Yellow "building"- mtask <- kojiGetBuildTaskID fedoraHub nvr+ putStrLn $ color Yellow (showNVR nvr) +-+ "is already" +-+ color Yellow "building"+ mtask <- kojiGetBuildTaskID fedoraHub $ showNVR nvr case mtask of- Nothing -> error' $ "Task for" +-+ nvr +-+ "not found"+ Nothing -> error' $ "Task for" +-+ showNVR nvr +-+ "not found" Just task -> return $ do kojiWaitTaskAndRepo (isNothing mlatest) nvr task return $ Done pkg nvr br changelog _ -> do when (null unpushed) $ do- putStrLn $ nvr +-+ "(" ++ target ++ ")" +-+ show n +-+ "more" +-++ putStrLn $ showNVR nvr +-+ "(" ++ target ++ ")" +-+ show n +-+ "more" +-+ maybe "" (\l -> "in layer" +-+ show l) mlayer putNewLn putStrLn changelog@@ -283,17 +296,17 @@ opentasks <- kojiOpenTasks pkg (Just buildref) target case opentasks of [task] -> do- putStrLn $ nvr +-+ "task is already open"+ putStrLn $ showNVR nvr +-+ "task is already open" return $ do kojiWaitTaskAndRepo (isNothing mlatest) nvr task return $ Done pkg nvr br changelog (_:_) -> error' $ show (length opentasks) +-+ "open" +-+ unPackage pkg +-+ "tasks already" [] -> do- if equivNVR nvr (fromMaybe "" mlatest)+ if equivNVR nvr mlatest then do -- FIXME add a retry prompt- putStrLn $ color Red $ nvr +-+ "is already latest (modulo disttag)"- return $ error' $ nvr +-+ "failed"+ putStrLn $ color Red $ showNVR nvr +-+ "is already latest (modulo disttag)"+ return $ error' $ showNVR nvr +-+ "failed" else do -- FIXME parse build output if dryrun@@ -304,13 +317,18 @@ kojiWaitTaskAndRepo (isNothing mlatest) nvr task return $ Done pkg nvr br changelog where- kojiWaitTaskAndRepo :: Bool -> String -> TaskID -> IO ()+ kojiWaitTaskAndRepo :: Bool -> NVR -> TaskID -> IO () kojiWaitTaskAndRepo newpkg nvr task = do finish <- kojiWaitTask task if finish- then putStrLn $ color Green $ nvr +-+ "build success"+ then putStrLn $ color Green $ showNVR nvr +-+ "build success" -- FIXME print koji task url- else error' $ color Red $ nvr +-+ "build failed"+ 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"]+ error' $ color Red $ showNVR nvr +-+ "build failed" autoupdate <- checkAutoBodhiUpdate br if autoupdate then when newpkg $ do@@ -330,10 +348,10 @@ renderChangelogs :: [JobDone] -> [String] renderChangelogs [] = [] renderChangelogs ((Done pkg _ _ clog):jobs) =- unlines [unPackage pkg, "", clog] : renderChangelogs jobs+ unlines [unPackage pkg ++ ":", "", clog] : renderChangelogs jobs -- FIXME how to catch authentication errors?- bodhiSidetagUpdate :: Branch -> [String] -> String -> String -> IO ()+ bodhiSidetagUpdate :: Branch -> [NVR] -> String -> String -> IO () bodhiSidetagUpdate rbr nvrs sidetag notes = do case mupdate of (Nothing, _) -> return ()@@ -351,38 +369,14 @@ else unlessM (checkAutoBodhiUpdate rbr) $ do -- FIXME get updateid from above bodhi command output- res <- bodhiUpdates [makeItem "display_user" "0", makeItem "builds" (last nvrs)]+ res <- bodhiUpdates [makeItem "display_user" "0", makeItem "builds" (showNVR (last nvrs))] case res of [] -> do putStrLn "bodhi submission failed" promptEnter "Press Enter to resubmit to Bodhi" bodhiSidetagUpdate rbr nvrs sidetag notes [update] ->- case lookupKey "updateid" update of+ case lookupKey "updateid" update :: Maybe String of Nothing -> error' "could not determine Update id"- Just updateid -> do- putStr "Waiting ~90s for sidetag update to transition to 'request testing'.."- -- FIXME countdown timer- sleep 90- bodhiUpdateTestingRequesting 1 updateid update- _ -> error' $ "impossible happened: more than one update found for" +-+ last nvrs-- bodhiUpdateTestingRequesting :: Double -> String -> Object -> IO ()- bodhiUpdateTestingRequesting retries updateid update =- if retries > 4- then error' "\nupdate still not in 'request testing' status"- else- case lookupKey "request" update of- Just (String request) ->- putStrLn $- if request == "testing"- then " done"- else "\nrequest:" +-+ T.unpack request- _ -> do- mupdate' <- FedoraBodhi.bodhiUpdate updateid- case mupdate' of- Just update' -> do- putChar '.'- sleep (retries * 10)- bodhiUpdateTestingRequesting (retries + 1) updateid update'- _ -> error' "\nfailed to get updated metadata"+ Just _updateid -> return ()+ _ -> error' $ "impossible happened: more than one update found for" +-+ showNVR (last nvrs)
src/Cmd/PkgReview.hs view
@@ -36,6 +36,8 @@ createPkgReview package _br = do let spec = packageSpec package pkg = unPackage package+ unlessM (doesFileExist spec) $+ error' $ "This does not look like a pkg dir:" +-+ spec +-+ "not found" unless (all isAscii pkg) $ putStrLn "Warning: package name is not ASCII!" putStrLn "checking for existing reviews..."@@ -56,11 +58,13 @@ postReviewReq session spec specSrpmUrls mkojiurl pkg = do summary <- cmd "rpmspec" ["-q", "--srpm", "--qf", "%{summary}", spec] description <- cmd "rpmspec" ["-q", "--srpm", "--qf", "%{description}", spec]+ url <- cmd "rpmspec" ["-q", "--srpm", "--qf", "%{url}", spec] createBug session [ ("product", "Fedora") , ("component", "Package Review") , ("version", "rawhide") , ("summary", "Review Request: " <> pkg <> " - " <> summary)+ , ("url", url) , ("description", specSrpmUrls <> "\n\nDescription:\n" <> description <> maybe "" ("\n\n\nKoji scratch build: " <>) mkojiurl)] buildAndUpload :: Maybe ScratchOption -> String -> String -> FilePath@@ -68,12 +72,13 @@ buildAndUpload mscratchOpt srpm pkg spec = do scratch <- if isNothing mscratchOpt- then yesNoDefault False "Would you like to do a koji scratch build"+ then yesNoDefault False "Would you like to do a koji scratch build before submitting" else do- return $ mscratchOpt == Just ScratchBuild- promptEnter $ "Press Enter to" +-+ if scratch- then "submit"- else "upload"+ let doscratch = mscratchOpt == Just ScratchBuild+ promptEnter $ "Press Enter to" +-+ if doscratch+ then "submit"+ else "upload"+ return doscratch mkojiurl <- case mscratchOpt of Just (ScratchTask tid) -> return $ Just ("https://koji.fedoraproject.org/koji/taskinfo?taskID=" ++ show tid) _ ->@@ -144,13 +149,16 @@ -- 'fbrnch: No spec file found' -- FIXME: option to only download/prep files reviewPackage :: Maybe String -> IO ()-reviewPackage mpkg = do- -- FIXME if spec file exists use it directly- pkg <- maybe getDirectoryName return mpkg+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 pkg- then packageReview .&&. statusNewAssigned .&&. bugIdIs (read pkg)- else pkgReviews pkg .&&. statusNewAssigned+ if all isDigit pkgbug+ then packageReview .&&. statusNewAssigned .&&. bugIdIs (read pkgbug)+ else pkgReviews pkgbug .&&. statusNewAssigned case bugs of [bug] -> do putReviewBug False bug@@ -158,8 +166,5 @@ -- FIXME support copr build -- FIXME if toolbox set REVIEW_NO_MOCKGROUP_CHECK cmd_ "fedora-review" ["-b", show (bugId bug)]- [] -> do- spec <- findSpecfile- srpm <- generateSrpm Nothing spec- cmd_ "fedora-review" ["-rn", srpm]- _ -> error' $ "More than one review bug found for" +-+ pkg+ [] -> error' $ "No package review found for" +-+ pkgbug+ _ -> error' $ "More than one review bug found for" +-+ pkgbug
src/Cmd/Prep.hs view
@@ -43,7 +43,7 @@ RelBranch rbr -> do nvr <- pkgNameVerRel' rbr spec -- newline avoids error starting on same line- putStr $ "Prepping" +-+ nvr ++ ": "+ putStr $ "Prepping" +-+ showNVR nvr ++ ": " _ -> return () timeIO $ (if verbose then cmdLog else cmdSilent') "rpmbuild" $ "-bp" : ["--nodeps" | not deps] ++ [spec]
src/Cmd/PullPush.hs view
@@ -12,26 +12,26 @@ import Package data PullOpts =- PullOpts { pullLenient :: Bool- , pullNoFetch :: Bool}+ PullLenient | PullNoFetch | PullStash+ deriving Eq -- FIXME pulling more than one branch -- FIXME print nvr after pulling or old -> new-pullPkgs :: PullOpts -> (BranchesReq, [String]) -> IO ()+pullPkgs :: Maybe PullOpts -> (BranchesReq, [String]) -> IO () pullPkgs pullopts (breq,args) = withPackagesByBranches (if length args > 1 then HeaderMust else HeaderMay) False- (if pullLenient pullopts- then Nothing- else if pullNoFetch pullopts- then cleanGit- else cleanGitFetch)+ (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 pullLenient pullopts+ if pullopts == Just PullLenient then do haveGit <- isPkgGitRepo if haveGit@@ -45,6 +45,12 @@ 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 =
src/Cmd/RequestBranch.hs view
@@ -21,19 +21,23 @@ import Pagure -- FIXME option to do koji scratch build instead of mock-requestBranchesCmd :: Bool -> Maybe Branch -> Bool -> (BranchesReq,[String]) -> IO ()-requestBranchesCmd quiet mrecursebr mock (breq, ps) = do+requestBranchesCmd :: Bool -> Bool -> Maybe Branch -> Bool+ -> (BranchesReq,[String]) -> IO ()+requestBranchesCmd quiet reviews mrecursebr mock (breq, ps) = do if null ps then do when (isJust mrecursebr) $ error' "please specify a package dir when using --recurse-deps" isPkgGit <- isPkgGitSshRepo- if isPkgGit- then- getDirectoryName >>= requestPkgBranches quiet False mock breq . Package- else do+ if reviews+ then do pkgs <- map reviewBugToPackage <$> listReviews ReviewUnbranched mapM_ (\ p -> withExistingDirectory p $ requestPkgBranches quiet (length pkgs > 1) mock breq (Package p)) pkgs+ else+ if isPkgGit+ then+ getDirectoryName >>= requestPkgBranches quiet False mock breq . Package+ else error' "not a dist-git dir: specify package(s)" else do pkgs <- case mrecursebr of@@ -120,7 +124,8 @@ when (br `elem` current) $ putStrLn $ pkgPrefix ++ show br +-+ "remote branch already exists" let newbranches = brs' \\ current- if null newbranches then return []+ if null newbranches+ then return [] else do fasid <- fasIdFromKrb -- FIXME retry on HttpExceptionRequest ... ConnectionTimeout@@ -132,14 +137,19 @@ Left err -> error' err Right recent -> filterM (notExistingRequest recent) newbranches - -- FIXME handle close_status Invalid+ -- FIXME print invalid requests? notExistingRequest :: [IssueTitleStatus] -> Branch -> IO Bool notExistingRequest requests br = do- let pending = filter ((("New Branch \"" ++ show br ++ "\" for \"rpms/" ++ unPackage pkg ++ "\"") ==) . pagureIssueTitle) requests- unless (null pending) $ do+ let processed = filter processedIssueFilter requests+ unless (null processed) $ do putStrLn $ "Branch request already exists for" +-+ unPackage pkg ++ ":" ++ show br- mapM_ printScmIssue pending- return $ null pending+ mapM_ printScmIssue processed+ return $ null processed+ where+ processedIssueFilter issue =+ pagureIssueTitle issue == ("New Branch \"" ++ show br ++ "\" for \"rpms/" ++ unPackage pkg ++ "\"")+ &&+ pagureIssueCloseStatus issue == Just "Processed" havePkgAccess :: Package -> IO Bool havePkgAccess pkg = do
src/Cmd/RequestRepo.hs view
@@ -53,6 +53,8 @@ comments <- getComments session bid mapM_ showComment comments putNewLn+ putBugId $ bugId bug+ putNewLn promptEnter "Press Enter to continue" -- FIXME check api key is still valid or open pagure ticket directly fedpkg_ "request-repo" [pkg, show bid]
src/Cmd/Scratch.hs view
@@ -8,6 +8,8 @@ ScratchSource(..) ) where +import Data.RPM.NVR (NVR)+ import Branches import Common import Common.System@@ -19,19 +21,21 @@ data ScratchSource = ScratchRef String | ScratchSRPM String -showScratchSource :: Bool -> String -> Maybe ScratchSource -> String-showScratchSource pushed nvr Nothing = nvr ++ (if pushed then "" else ".src.rpm")+showScratchSource :: Bool -> NVR -> Maybe ScratchSource -> String+showScratchSource pushed nvr Nothing =+ showNVR nvr ++ (if pushed then "" else ".src.rpm") showScratchSource _ _ (Just (ScratchRef ref)) = ref showScratchSource _ _ (Just (ScratchSRPM srpm)) = srpm +-- FIXME --no-tail -- FIXME --with --without ? -- FIXME allow parallel targets--- FIXME tail build.log for failure -- FIXME append timestamp after %release (to help identify scratch builds)-scratchCmd :: Bool -> Bool -> Bool -> Bool -> Maybe Archs+-- FIXME FIXME use option type:+scratchCmd :: Bool -> Bool -> Bool -> Bool -> Bool -> Maybe Archs -> [SideTagTarget] -> Maybe ScratchSource -> (BranchesReq, [String]) -> IO ()-scratchCmd dryrun stagger rebuildSrpm nofailfast marchopts sidetagTargets msource (breq,pkgs) =+scratchCmd dryrun stagger rebuildSrpm nofailfast allowHEAD marchopts sidetagTargets msource (breq,pkgs) = withPackagesByBranches HeaderMust False Nothing AnyNumber scratchBuild (breq,pkgs) where anyTarget (RelBranch b) = branchTarget b@@ -48,7 +52,7 @@ targets <- if null sidetagTargets then return [anyTarget br]- else mapM (targetMaybeSidetag dryrun (onlyRelBranch br) . Just) sidetagTargets+ else mapM (targetMaybeSidetag dryrun True (onlyRelBranch br) . Just) sidetagTargets forM_ targets $ \target -> do archs <- case marchopts of@@ -87,7 +91,7 @@ let kojiargs = ["--arch-override=" ++ intercalate "," archs | notNull archs] ++ ["--fail-fast" | not nofailfast && length archs /= 1] ++ ["--no-rebuild-srpm" | not rebuildSrpm] if pkggit then do- gitSwitchBranch br+ gitSwitchBranchVerbose False allowHEAD br pushed <- do case msource of Just (ScratchRef ref) ->@@ -123,15 +127,15 @@ void $ generateSrpm (Just br) spec >>= kojiScratchBuild target kojiargs -- FIXME default -X to --no-fastfail?-scratchCmdX86_64 :: Bool -> Bool -> Bool -> [SideTagTarget]+scratchCmdX86_64 :: Bool -> Bool -> Bool -> Bool -> [SideTagTarget] -> Maybe ScratchSource -> (BranchesReq, [String]) -> IO ()-scratchCmdX86_64 dryrun rebuildSrpm excludeArch =- scratchCmd dryrun False rebuildSrpm False (Just (excludeArchs excludeArch ["x86_64"]))+scratchCmdX86_64 dryrun rebuildSrpm allowHEAD excludeArch =+ scratchCmd dryrun False rebuildSrpm False allowHEAD (Just (excludeArchs excludeArch ["x86_64"])) -scratchCmdAarch64 :: Bool -> Bool -> Bool -> [SideTagTarget]+scratchCmdAarch64 :: Bool -> Bool -> Bool -> Bool -> [SideTagTarget] -> Maybe ScratchSource -> (BranchesReq, [String]) -> IO ()-scratchCmdAarch64 dryrun rebuildSrpm excludeArch =- scratchCmd dryrun False rebuildSrpm False (Just (excludeArchs excludeArch ["aarch64"]))+scratchCmdAarch64 dryrun rebuildSrpm allowHEAD excludeArch =+ scratchCmd dryrun False rebuildSrpm False allowHEAD (Just (excludeArchs excludeArch ["aarch64"])) excludeArchs :: Bool -> [String] -> Archs excludeArchs excl = if excl then ExcludedArchs else Archs
src/Cmd/Sort.hs view
@@ -16,7 +16,7 @@ import Branches import Git import Package-import RpmBuild (getDynSourcesMacros)+import RpmBuild (distRpmOptions, getDynSourcesMacros) data RpmWith = RpmWith String | RpmWithout String @@ -27,7 +27,8 @@ sortCmd _ _ (_,[]) = return () sortCmd displaymode mrpmwith (br, pkgs) = do withPackagesBranch HeaderNone False Nothing setupPkg (br, pkgs)- let rpmopts = maybe [] toRpmOption mrpmwith+ distopts <- distRpmOptions br+ let rpmopts = maybe [] toRpmOption mrpmwith ++ distopts case displaymode of -- reverse because rpmbuild-order reverses the order of independent pkgs? SortParallel ->
src/Cmd/Status.hs view
@@ -48,11 +48,13 @@ else do gitSwitchBranch rbr let spec = packageSpec pkg- ifM (notM (doesFileExist spec))- (ifM initialPkgRepo- (putStrLn $ show br ++ ": initial repo")- (putStrLn $ "missing" +-+ spec)) $- do+ 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@@ -71,14 +73,14 @@ munpushed <- gitShortLog1 $ Just $ "origin/" ++ show br ++ "..HEAD" case munpushed of Nothing -> do- mbuild <- kojiGetBuildID fedoraHub nvr+ mbuild <- kojiGetBuildID fedoraHub (showNVR nvr) case mbuild of Nothing -> do mlatest <- kojiLatestNVR (branchDestTag br) (unPackage pkg) case mlatest of- Nothing -> putStrLn $ "new" +-+ nvr+ Nothing -> putStrLn $ "new" +-+ showNVR nvr Just latest ->- putStrLn $ if equivNVR nvr latest then latest +-+ "is latest modulo disttag" else (if null latest then "new " else (head . words) latest +-+ "->\n") ++ nvr+ 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@@ -87,14 +89,14 @@ -- FIXME show pending archs building whenJust mstatus $ \ status -> -- FIXME better Show BuildStatus- putStr $ nvr +-+ "(" ++ show status ++ ")"+ putStr $ showNVR nvr +-+ "(" ++ show status ++ ")" else do -- FIXME hide testing if ga/stable- putStr $ nvr +-+ "(" ++ unwords tags ++ ")"+ putStr $ showNVR nvr +-+ "(" ++ unwords tags ++ ")" unless (isStable tags) $ do updates <- bodhiUpdates [makeItem "display_user" "0",- makeItem "builds" nvr]+ makeItem "builds" (showNVR nvr)] case updates of [] -> putStrLn "No update found" [update] -> do@@ -186,7 +188,7 @@ putCommit prefix = putStrLn . (prefix +-+) . showCommit doBump spec = do- checkWorkingDirClean+ checkWorkingDirClean False dead <- doesFileExist "dead.package" if dead then putStrLn "dead package"
src/Cmd/Switch.hs view
@@ -5,9 +5,9 @@ import Package -- FIXME noop when on branch already or drop cleanGit-switchCmd :: AnyBranch -> [String] -> IO ()-switchCmd br pkgs =+switchCmd :: Bool -> AnyBranch -> [String] -> IO ()+switchCmd verbose br pkgs = -- FIXME use withBranchByPackages ? withPackagesByBranches HeaderNone False dirtyGit Zero dummy (Branches [],pkgs) where- dummy _ _ = gitSwitchBranch br+ dummy _ _ = gitSwitchBranchVerbose verbose False br
src/Cmd/Update.hs view
@@ -1,5 +1,6 @@ module Cmd.Update- ( updateCmd+ ( updateCmd,+ updatePkg ) where @@ -39,79 +40,82 @@ in if pkgGit then dirty else if null pkgs then Nothing else dirty- withPackagesMaybeBranch HeaderMay False mgitops (updatePkg pkgGit mver) (mbr, pkgs)- where- updatePkg :: Bool -> Maybe String -> Package -> AnyBranch -> IO ()- updatePkg distgit mver pkg br = do- when (distgit && br /= RelBranch Rawhide) $- promptEnter $ "Are you sure you want to update" +-+ show br +-+ "branch?!"- spec <- if allowHEAD- then findSpecfile- else localBranchSpecFile pkg br- (curver,_) <- pkgVerRel spec- vdiff <- filter ("Version:" `isInfixOf`) . filter (not . ("@@ " `isPrefixOf`)) <$> gitLines "diff" ["-U0", "HEAD", spec]- unless (length vdiff `elem` [0,2]) $- error' $ "diff contains complex version change:\n" ++ unlines vdiff- case mver of- Nothing -> do- when (null vdiff && not onlysources) $- error' "specify or edit version to update"- putStrLn $ "current version:" +-+ curver- Just nver -> do- when (length vdiff == 2) $- error' $ "spec version already bumped to" +-+ curver- when (curver == nver) $- putStrLn $ "already new version" +-+ curver- let moldnewver =- case mver of- Just nver -> Just (curver,nver)- Nothing ->- case map (last . words) vdiff of- [old,new] -> Just (old,new)- _ -> Nothing- unless onlysources $ do- let (oldver,newver) =- fromMaybe (error' "complex version change") moldnewver- -- FIXME take epoch into account- when (rpmVerCompare oldver newver == GT) $- putStrLn $ "current" +-+ oldver +-+ "is newer!"- putStrLn $ oldver +-+ "->\n" ++ newver- when (curver /= newver) $ do- editSpecField "Version" newver spec- editSpecField "Release" "0%{?dist}" spec- -- FIXME should be sure sources exists for distgit- whenM (doesFileExist "sources") $- cmd_ "sed" ["-i", "/" ++ unPackage pkg ++ "-" ++ oldver ++ "./d", "sources"]- whenM isPkgGitSshRepo $ do- -- FIXME forM_- sources <- map sourceFieldFile <$> cmdLines "spectool" ["-S", spec]- existing <- filterM doesFileExist sources- unless (existing == sources) $ do- cmd_ "fedpkg" ["sources"]- unless force $- -- FIXME only if not all exist- cmd_ "spectool" ["-g", "-S", spec]- patches <- map sourceFieldFile <$> cmdLines "spectool" ["-P", spec]- forM_ patches $ \patch ->- unlessM (doesFileExist patch) $- cmd_ "spectool" ["-g", "-P", spec]- when force $ do- let archives = filter isArchiveFile existing- forM_ archives removeFile- cmd_ "spectool" ["-g", "-S", spec]- krbTicket- cmd_ "fedpkg" $ "new-sources" : filter isArchiveFile sources- whenJust moldnewver $ \(_old,newver) -> do- versions <- changelogVersions spec- let missing = null versions || not ((newver ++ "-") `isPrefixOf` head versions)- when missing $ do- cmd_ "rpmdev-bumpspec" ["-c", "update to" +-+ newver, spec]- git_ "commit" ["-a", "-m", "update to" +-+ newver]- putStr "Prepping... "- cmdSilent' "rpmbuild" ["-bp", "--nodeps", spec]- putStrLn "done"- -- FIXME git amend (if previous commit was update)+ withPackagesMaybeBranch HeaderMay False mgitops (updatePkg onlysources force allowHEAD pkgGit mver) (mbr, pkgs) +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"+ spec <- if allowHEAD+ then findSpecfile+ else localBranchSpecFile pkg br+ (curver,_) <- pkgVerRel spec+ vdiff <- filter ("Version:" `isInfixOf`) . filter (not . ("@@ " `isPrefixOf`)) <$> gitLines "diff" ["-U0", "HEAD", spec]+ unless (length vdiff `elem` [0,2]) $+ error' $ "diff contains complex version change:\n" ++ unlines vdiff+ case mver of+ Nothing -> do+ when (null vdiff && not onlysources) $+ error' "specify or edit version to update"+ putStrLn $ "current version:" +-+ curver+ Just nver -> do+ when (length vdiff == 2) $+ error' $ "spec version already bumped to" +-+ curver+ when (curver == nver) $+ putStrLn $ "already new version" +-+ curver+ let moldnewver =+ case mver of+ Just nver -> Just (curver,nver)+ Nothing ->+ -- FIXME confused by fresh multiversion package (eg hadrian-0.1.0.0 make new ghcX.Y to 0.1.0.0+ case map (last . words) vdiff of+ [old,new] -> Just (old,new)+ _ -> Nothing+ unless onlysources $ do+ let (oldver,newver) =+ fromMaybe (error' "complex version change") moldnewver+ -- FIXME take epoch into account+ when (rpmVerCompare oldver newver == GT) $+ putStrLn $ "current" +-+ oldver +-+ "is newer!"+ putStrLn $ oldver +-+ "->\n" ++ newver+ when (curver /= newver) $ do+ editSpecField "Version" newver spec+ -- FIXME do not touch %autorelease+ editSpecField "Release" "0%{?dist}" spec+ -- FIXME should be sure sources exists for distgit+ whenM (doesFileExist "sources") $+ cmd_ "sed" ["-i", "/" ++ unPackage pkg ++ "-" ++ oldver ++ "./d", "sources"]+ whenM isPkgGitSshRepo $ do+ -- FIXME forM_+ sources <- map sourceFieldFile <$> cmdLines "spectool" ["-S", spec]+ existing <- filterM doesFileExist sources+ unless (existing == sources) $ do+ cmd_ "fedpkg" ["sources"]+ unless force $+ -- FIXME only if not all exist+ cmd_ "spectool" ["-g", "-S", spec]+ patches <- map sourceFieldFile <$> cmdLines "spectool" ["-P", spec]+ forM_ patches $ \patch ->+ unlessM (doesFileExist patch) $+ cmd_ "spectool" ["-g", "-P", spec]+ when force $ do+ let archives = filter isArchiveFile existing+ forM_ archives removeFile+ cmd_ "spectool" ["-g", "-S", spec]+ krbTicket+ cmd_ "fedpkg" $ "new-sources" : filter isArchiveFile sources+ whenJust moldnewver $ \(_old,newver) -> do+ versions <- changelogVersions spec+ let missing = null versions || not ((newver ++ "-") `isPrefixOf` head versions)+ when missing $ do+ cmd_ "rpmdev-bumpspec" ["-c", "update to" +-+ newver, spec]+ git_ "commit" ["-a", "-m", "update to" +-+ newver]+ putStr "Prepping... "+ cmdSilent' "rpmbuild" ["-bp", "--nodeps", spec]+ putStrLn "done"+ -- FIXME git amend (if previous commit was update)+ where sourceFieldFile :: String -> FilePath sourceFieldFile field = if null field then
src/Cmd/WaitRepo.hs view
@@ -7,6 +7,7 @@ import Common.System import Branches+import Common (showNVR) import Git import Koji import Package@@ -32,6 +33,6 @@ gitSwitchBranch rbr let spec = packageSpec pkg nvr <- pkgNameVerRel' br spec- target <- targetMaybeSidetag dryrun br msidetagTarget- logMsg $ "Waiting for" +-+ nvr +-+ "to appear in" +-+ target+ target <- targetMaybeSidetag dryrun False br msidetagTarget+ logMsg $ "Waiting for" +-+ showNVR nvr +-+ "to appear in" +-+ target timeIO $ kojiWaitRepo dryrun True knowntag target nvr
src/Common.hs view
@@ -12,13 +12,15 @@ plural, pluralException, putNewLn,- reverseSort+ reverseSort,+ showNVR ) where import Control.Monad.Extra -- hiding (loop) import Data.List.Extra hiding (list, merge) import Data.Maybe import Data.Ord (comparing, Down(Down))+import Data.RPM.NVR (showNVR) #if !MIN_VERSION_base(4,11,0) import Data.Semigroup ((<>))@@ -29,10 +31,11 @@ plural :: Int -> String -> String plural i ns =- pluralException i ns (ns ++ "s")+ pluralException i Nothing ns (ns ++ "s") -pluralException :: Int -> String -> String -> String-pluralException i ns ps =+pluralException :: Int -> Maybe String -> String -> String -> String+pluralException 0 (Just z) _ _ = z+pluralException i _ ns ps = mconcat [ if i == 0 then "no" else show i,
src/Git.hs view
@@ -20,11 +20,13 @@ gitShortLog1, gitSwitchBranch, gitSwitchBranch',+ gitSwitchBranchVerbose, -- checkIsPkgGitDir, isGitRepo, isPkgGitRepo, isPkgGitSshRepo, checkWorkingDirClean,+ stashedWithFbrnch, isGitDirClean, checkIfRemoteBranchExists, CommitOpt (..),@@ -150,6 +152,7 @@ gitPush :: Bool -> Maybe String -> IO () gitPush quiet mref = do+ -- FIXME also check ref on branch checkOnBranch when quiet $ putStr "git pushing... "@@ -165,6 +168,7 @@ when quiet $ putStrLn "" putStrLn $ unwords ("git" : args) +-+ "failed with\n" ++ err yes <- yesNo "Retry git push"+ -- FIXME going to fail if ref no longer on branch when yes $ gitPush quiet mref -- FIXME use this in more places@@ -188,12 +192,18 @@ then unless quiet $ putStrLn "done" else putStrLn $ '\r' : intercalate "\n" filtered -checkWorkingDirClean :: IO ()-checkWorkingDirClean = do+stashedWithFbrnch :: String+stashedWithFbrnch = "saved by fbrnch"++checkWorkingDirClean :: Bool -> IO ()+checkWorkingDirClean stash = do clean <- isGitDirClean- unless clean $ do- dir <- getCurrentDirectory- error' $ "Working dir is not clean:" +-+ dir+ unless clean $+ if stash+ then git_ "stash" ["-m", stashedWithFbrnch]+ else do+ dir <- getCurrentDirectory+ error' $ "Working dir is not clean:" +-+ dir isGitDirClean :: IO Bool isGitDirClean =@@ -218,32 +228,37 @@ -- adapted from SimpleCmd.Git grepGitConfig' :: String -> IO Bool-grepGitConfig' key =- ifM (isGitDir ".")- (egrep_ key ".git/config") $- -- could be a worktree or absorbed submodule (#8)- ifM (not <$> doesFileExist ".git")- (return False) $ do- gitdir <- last . words <$> readFile ".git"- if "/worktrees/" `isInfixOf` gitdir- then egrep_ key (takeDirectory (takeDirectory gitdir) </> "config")- else- -- absorbed submodule: "gitdir: ../.git/modules/R-bit"- if "/modules/" `isInfixOf` gitdir then- egrep_ key $ gitdir </> "config"- else return False+grepGitConfig' key = do+ isgit <- isGitDir "."+ if isgit+ then egrep_ key ".git/config"+ else do+ -- could be a worktree or absorbed submodule (#8)+ exists <- doesFileExist ".git"+ if not exists+ then return False+ else do+ gitdir <- last . words <$> readFile ".git"+ if "/worktrees/" `isInfixOf` gitdir+ then egrep_ key (takeDirectory (takeDirectory gitdir) </> "config")+ else+ -- absorbed submodule: "gitdir: ../.git/modules/R-bit"+ if "/modules/" `isInfixOf` gitdir then+ egrep_ key $ gitdir </> "config"+ else return False -gitSwitchBranch :: AnyBranch -> IO ()-gitSwitchBranch (OtherBranch "HEAD") = do+gitSwitchBranchVerbose :: Bool -> Bool -> AnyBranch -> IO ()+gitSwitchBranchVerbose _ allowHEAD (OtherBranch "HEAD") = do dir <- getDirectoryName- error' $ dir ++ ": HEAD is not a branch"-gitSwitchBranch br = do+ (if allowHEAD then putStrLn else error') $ dir ++ ": HEAD is not a branch"+gitSwitchBranchVerbose verbose _ br = do localbranches <- gitLines "branch" ["--format=%(refname:short)"]+ let verb = ["-q" | not verbose] if show br `elem` localbranches then do current <- gitCurrentBranch when (current /= br) $- git_ "switch" ["-q", show br]+ git_ "switch" $ verb ++ [show br] else do -- check remote branch exists remotebranch <- do@@ -256,7 +271,10 @@ name <- getDirectoryName error' $ name +-+ show br +-+ "branch does not exist!" else- git_ "checkout" ["-q", "-b", show br, "--track", "origin/" ++ show br]+ git_ "checkout" $ verb ++ ["-b", show br, "--track", "origin/" ++ show br]++gitSwitchBranch :: AnyBranch -> IO ()+gitSwitchBranch = gitSwitchBranchVerbose False False -- similar to gitSwitchBranch but does not error gitSwitchBranch' :: Bool -> Branch -> IO Bool
src/Koji.hs view
@@ -30,6 +30,7 @@ import Control.Concurrent (threadDelay) import qualified Data.ByteString.Lazy.Char8 as B import Data.Fixed (Micro)+import Data.RPM.NVR (NVR, maybeNVR, nvrName) import Distribution.Koji import qualified Distribution.Koji.API as Koji import SimplePrompt (promptEnter)@@ -50,30 +51,30 @@ fedoraHub :: String fedoraHub = fedoraKojiHub -kojiNVRTags :: String -> IO [String]+kojiNVRTags :: NVR -> IO [String] kojiNVRTags nvr = do- mbldid <- kojiGetBuildID fedoraHub nvr+ mbldid <- kojiGetBuildID fedoraHub $ showNVR nvr case mbldid of- Nothing -> error' $ nvr +-+ "koji build not found"+ Nothing -> error' $ showNVR nvr +-+ "koji build not found" Just bldid -> kojiBuildTags fedoraHub (buildIDInfo bldid) -kojiBuildStatus :: String -> IO (Maybe BuildState)+kojiBuildStatus :: NVR -> IO (Maybe BuildState) kojiBuildStatus nvr =- kojiGetBuildState fedoraHub (BuildInfoNVR nvr)+ kojiGetBuildState fedoraHub (BuildInfoNVR (showNVR nvr)) -kojiLatestNVR :: String -> String -> IO (Maybe String)+kojiLatestNVR :: String -> String -> IO (Maybe NVR) kojiLatestNVR tag pkg = do mbld <- kojiLatestBuild fedoraHub tag pkg return $ case mbld of Nothing -> Nothing- Just bld -> lookupStruct "nvr" bld+ Just bld -> lookupStruct "nvr" bld >>= maybeNVR -kojiLatestNVRRepo :: String -> Int -> String -> IO (Maybe String)+kojiLatestNVRRepo :: String -> Int -> String -> IO (Maybe NVR) kojiLatestNVRRepo tag event pkg = do mbld <- kojiLatestBuildRepo fedoraHub tag event pkg return $ case mbld of Nothing -> Nothing- Just bld -> lookupStruct "nvr" bld+ Just bld -> lookupStruct "nvr" bld >>= maybeNVR kojiOpenTasks :: Package -> Maybe String -> String -> IO [TaskID] kojiOpenTasks pkg mref target = do@@ -193,29 +194,31 @@ Left task <- kojiBuildBranch' False target pkg mref args return task -kojiWaitRepo :: Bool -> Bool -> Bool -> String -> String -> IO ()+kojiWaitRepo :: Bool -> Bool -> Bool -> String -> NVR -> IO () kojiWaitRepo dryrun quiet knowntag target nvr = do Just (buildtag,desttag) <- kojiBuildTarget fedoraHub target unless dryrun $ do- mlatest <- kojiLatestNVR buildtag (nameOfNVR nvr)+ mlatest <- kojiLatestNVR buildtag (nvrName nvr) if Just nvr == mlatest then waitRepo buildtag Nothing else do- tags <- cmdLines "koji" ["list-tags", "--build=" ++ nvr]+ tags <- cmdLines "koji" ["list-tags", "--build=" ++ showNVR nvr] if knowntag then do putStrLn $ "current tags:" +-+ unwords tags waitRepo buildtag Nothing else do- mbuilt <- kojiLatestNVR desttag (nameOfNVR nvr)+ mbuilt <- kojiLatestNVR desttag (nvrName nvr) if mbuilt == Just nvr then do sleep 40+ -- FIXME need retry+ -- SSL_connect: resource vanished (Connection reset by peer) kojiWaitRepo dryrun quiet knowntag target nvr else do putStrLn $ "current tags:" +-+ unwords tags unless (buildtag `elem` tags) $ do- putStrLn $ "no" +-+ nvr +-+ "tagged" +-+ buildtag+ putStrLn $ "no" +-+ showNVR nvr +-+ "tagged" +-+ buildtag promptEnter "Press Enter to continue anyway" waitRepo buildtag Nothing where@@ -234,24 +237,17 @@ case mevent of Nothing -> error "create_event not found" Just event -> do- latest <- kojiLatestNVRRepo buildtag event (nameOfNVR nvr)+ latest <- kojiLatestNVRRepo buildtag event (nvrName nvr) if latest == Just nvr- then logMsg $ nvr +-++ then logMsg $ showNVR nvr +-+ if isNothing moldrepo then "is in" +-+ buildtag else "appeared" else do when (isNothing moldrepo && not quiet) $- logMsg $ "Waiting for" +-+ buildtag +-+ "to have" +-+ nvr+ logMsg $ "Waiting for" +-+ buildtag +-+ "to have" +-+ showNVR nvr waitRepo buildtag mrepo - -- FIXME: obsolete by using NVR- -- n-v-r -> n- nameOfNVR :: String -> String- nameOfNVR = removeSeg . removeSeg- where- removeSeg = init . dropWhileEnd (/= '-')- kojiTagArchs :: String -> IO [String] kojiTagArchs tag = do st <- Koji.getTag fedoraHub (Koji.InfoString tag) Nothing@@ -279,22 +275,27 @@ maybeTimeout (secs + 5) act Just res -> return res -targetMaybeSidetag :: Bool -> Branch -> Maybe SideTagTarget -> IO String-targetMaybeSidetag dryrun br msidetagTarget =+-- FIXME check/warn for target/branch mismatch+targetMaybeSidetag :: Bool -> Bool -> Branch -> Maybe SideTagTarget+ -> IO String+targetMaybeSidetag dryrun create br msidetagTarget = case msidetagTarget of Nothing -> return $ branchTarget br Just (Target t) -> return t Just SideTag -> do- tags <- map (head . words) <$> kojiUserSideTags (Just br)- case tags of+ sidetags <- map (head . words) <$> kojiUserSideTags (Just br)+ case sidetags of [] -> do Just (buildtag,_desttag) <- kojiBuildTarget fedoraHub (show br) out <- if dryrun then return $ "Side tag '" ++ buildtag ++ "'"- else head . lines <$> fedpkg "request-side-tag" ["--base-tag", buildtag]+ 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 putStrLn out let sidetag = init . dropWhileEnd (/= '\'') $ dropPrefix "Side tag '" out
src/ListReviews.hs view
@@ -27,6 +27,7 @@ listReviewsAll :: Bool -> ReviewStatus -> IO [Bug] listReviewsAll = listReviewsFull False Nothing Nothing +-- FIXME: --unassigned listReviewsFull :: Bool -> Maybe String -> Maybe String -> Bool -> ReviewStatus-> IO [Bug] listReviewsFull assignee muser mpat allopen status = do
src/Main.hs view
@@ -65,7 +65,8 @@ <$> cloneRequest , Subcommand "switch" "Switch branch" $ switchCmd- <$> anyBranchArg+ <$> verboseOpt "verbose output"+ <*> anyBranchArg <*> manyPackages , Subcommand "nvr" "Print name-version-release" $ nvrCmd@@ -141,6 +142,7 @@ <*> switchLongWith "stagger" "Stagger archs" <*> rebuildSrpmOpt <*> noFailFastOpt+ <*> switchLongWith "allow-head" "allow detached HEAD" <*> optional archesOpt <*> many (sidetagTargetOpt Nothing) <*> optional scratchSourceOpt@@ -149,6 +151,7 @@ scratchCmdAarch64 <$> dryrunOpt "Dry run: do not build" <*> rebuildSrpmOpt+ <*> switchLongWith "allow-head" "allow detached HEAD" <*> switchWith 'X' "exclude-arch" "Exclude aarch64" <*> many (sidetagTargetOpt Nothing) <*> optional scratchSourceOpt@@ -157,6 +160,7 @@ scratchCmdX86_64 <$> dryrunOpt "Dry run: do not build" <*> rebuildSrpmOpt+ <*> switchLongWith "allow-head" "allow detached HEAD" <*> switchWith 'X' "exclude-arch" "Exclude x86_64" <*> many (sidetagTargetOpt Nothing) <*> optional scratchSourceOpt@@ -180,12 +184,12 @@ , Subcommand "prep" "Prep sources" $ prepCmd <$> optional prepPreOpts- <*> switchWith 'v' "verbose" "show rpmbuild output"+ <*> verboseOpt "show rpmbuild output" <*> switchWith 'd' "deps" "require deps to be installed" <*> maybeBranchPackages False , Subcommand "local" "Build locally" $ localCmd- <$> switchWith 'q' "quiet" "Hide the build.log until it errors"+ <$> quietOpt "Hide the build.log until it errors" <*> switchWith 'd' "debug" "show the rpmbuild command" <*> optional forceshortOpt <*> many bcondOpt@@ -230,13 +234,14 @@ <*> optional (optionWith branchM 'r' "root" "BRANCH" "Mock config to use") <*> optional archOpt <*> branchesPackages- , Subcommand "install-deps" "Install package build dependencies" $+ -- was install-deps+ , Subcommand "builddeps" "Install package build dependencies" $ installDepsCmd <$> maybeBranchPackages False , Subcommand "install" "Build locally and install package(s)" $ -- FIXME drop --shortcircuit from install? installCmd- <$> switchWith 'v' "verbose" "verbose rpmbuild output"+ <$> quietOpt "Quiet rpmbuild output" <*> switchWith 'R' "recurse" "build and install missing deps packages" <*> optional (optionLongWith branchM "from" "BRANCH" "Merge branch first") <*> optional forceshortOpt@@ -269,7 +274,7 @@ <*> manyPackages , Subcommand "pull" "Git pull packages" $ pullPkgs- <$> pullOpts+ <$> optional pullOpts <*> branchesPackages , Subcommand "fetch" "Git fetch packages" $ fetchPkgs@@ -315,12 +320,14 @@ <*> branchesPackages , Subcommand "import" "Import new approved created packages from bugzilla review" $ importCmd- <$> mockOpt True+ <$> switchLongWith "existing" "Use an existing repo"+ <*> mockOpt True <*> branchesPackages , Subcommand "request-branches" "Request branches for approved created packages" $ requestBranchesCmd- <$> switchWith 'q' "quiet" "Quieter output"- <*> optional (optionWith branchM 'r' "recurse-from" "BRANCH" "Add neighboring dependencies from branch")+ <$> quietOpt "Quieter output"+ <*> switchWith 'r' "reviews" "Request branches for package reviews"+ <*> optional (optionWith branchM 'R' "recurse-from" "BRANCH" "Add neighboring dependencies from branch") <*> mockOpt False <*> branchesPackages , Subcommand "find-review" "Find package review bug" $@@ -510,7 +517,7 @@ <*> updateOpt <*> useChangelogOpt <*> switchWith 'p' "by-package" "Build by each package across brs"- <*> switchWith 'k' "allow-dirty" "Allow building from unclean git dir"+ <*> switchLongWith "stash" "git stash before fetching and building" where overrideOpt = optional (optionWith auto 'o' "override" "DAYS" "Create buildroot override for specified days: implies --wait-repo")@@ -528,7 +535,7 @@ noFailFastOpt = switchWith 'f' "no-fail-fast" "Do not --fail-fast" excludeArch :: Parser String- excludeArch = strOptionWith 'X' "exclude-arch" "ARCH[,ARCH].." "build without arch(s)"+ excludeArch = strOptionWith 'X' "exclude-arch" "ARCH" "build without arch" archesOpt :: Parser Archs archesOpt = Archs <$> some archOpt <|> ExcludedArchs <$> some excludeArch@@ -560,7 +567,7 @@ forceshortOpt = flagWith' ForceBuild 'f' "rebuild" "Rebuild even if already built" <|>- flagLongWith' ShortCompile "short-compile" "Do rpmbuild --short-circuit -bc" <|>+ flagWith' ShortCompile 'c' "short-compile" "Do rpmbuild --short-circuit -bc" <|> flagWith' ShortInstall 's' "short-install" "Do rpmbuild --short-circuit -bi" diffFormatOpt :: Parser DiffFormat@@ -588,9 +595,9 @@ pullOpts :: Parser PullOpts pullOpts =- PullOpts <$>- switchWith 'l' "lenient" "Ignore non-git dirs and files" <*>- switchWith 'f' "no-fetch" "Skip git fetch"+ 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" 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)" @@ -653,3 +660,9 @@ overrideModeOpt = flagWith' OverrideList 'l' "list" "List active override(s)" <|> flagWith OverrideCreate OverrideExpire 'X' "expire" "Expire override(s)"++ verboseOpt :: String -> Parser Bool+ verboseOpt = switchWith 'v' "verbose"++ quietOpt :: String -> Parser Bool+ quietOpt = switchWith 'q' "quiet"
src/Package.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ module Package ( clonePkg, CloneUser(..),@@ -33,6 +35,7 @@ dirtyGitActive, dirtyGitFetch, dirtyGitHEAD,+ stashGitFetch, Package(..), packageSpec, pkgNameVerRel,@@ -42,6 +45,8 @@ isAutoRelease ) where +import Data.RPM (NV(..), VerRel(..))+import Data.RPM.NVR (maybeNVR, NVR(..)) import Distribution.Fedora hiding (Fedora,EPEL,EPELNext) import SimpleCmd.Rpm import SimplePrompt (prompt)@@ -104,11 +109,12 @@ putStrLn "```" putStrLn notes putStrLn "```"- ifM (not <$> isTty)- (return notes) $- do- usernote <- prompt "Press Enter to use above or input notes"- return $ if null usernote then notes else usernote+ tty <- isTty+ if tty+ then do+ usernote <- prompt "Press Enter to use above or input notes"+ return $ if null usernote then notes else usernote+ else return notes -- FIXME check spec filename/%name more carefully getPackageName :: FilePath -> IO Package@@ -142,15 +148,16 @@ then do gitSwitchBranch br let spec = packageSpec pkg- ifM (doesFileExist spec)- (return spec) $- do- mspec <- maybeFindSpecfile- case mspec of- Just spc -> do- putStrLn $ "Warning: directory name differs from" +-+ spc ++ "\n"- return spc- Nothing -> error' $ "No spec file for:" +-+ unPackage pkg+ exists <- doesFileExist spec+ if exists+ then return spec+ else do+ mspec <- maybeFindSpecfile+ case mspec of+ Just spc -> do+ putStrLn $ "Warning: directory name differs from" +-+ spc ++ "\n"+ return spc+ Nothing -> error' $ "No spec file for:" +-+ unPackage pkg else findSpecfile withExistingDirectory :: FilePath -> IO a -> IO a@@ -190,18 +197,20 @@ , gitOptFetch :: Bool , gitOptActive :: Bool , gitOptHEAD :: Bool -- allow detached head/rebase state+ , gitOptStash :: Bool } -cleanGit, cleanGitActive, cleanGitFetch, cleanGitFetchActive, dirtyGit, dirtyGitActive, dirtyGitFetch, dirtyGitHEAD :: Maybe GitOpts--- clean fetch active HEAD-cleanGit = Just $ GitOpts True False False False-cleanGitActive = Just $ GitOpts True False True False-cleanGitFetch = Just $ GitOpts True True False False-cleanGitFetchActive = Just $ GitOpts True True True False-dirtyGit = Just $ GitOpts False False False False-dirtyGitActive = Just $ GitOpts False False True False-dirtyGitFetch = Just $ GitOpts False True False False-dirtyGitHEAD = Just $ GitOpts False False False True+cleanGit, cleanGitActive, cleanGitFetch, cleanGitFetchActive, dirtyGit, dirtyGitActive, dirtyGitFetch, dirtyGitHEAD, stashGitFetch :: Maybe GitOpts+-- clean fetch active HEAD stash+cleanGit = Just $ GitOpts True False False False False+cleanGitActive = Just $ GitOpts True False True False False+cleanGitFetch = Just $ GitOpts True True False False False+cleanGitFetchActive = Just $ GitOpts True True True False False+dirtyGit = Just $ GitOpts False False False False False+dirtyGitActive = Just $ GitOpts False False True False False+dirtyGitFetch = Just $ GitOpts False True False False False+dirtyGitHEAD = Just $ GitOpts False False False True False+stashGitFetch = Just $ GitOpts True True False False True data LimitBranches = AnyNumber | Zero | ZeroOrOne | ExactlyOne deriving Eq@@ -212,6 +221,7 @@ boolHeader :: Bool -> HeaderShow boolHeader b = if b then HeaderMust else HeaderMay +-- FIXME option to filter out dead.packages withPackagesByBranches :: HeaderShow -> Bool -> Maybe GitOpts@@ -283,7 +293,7 @@ [br] -> when (fetch || header == HeaderMust) $ putPkgAnyBrnchHdr pkg br _ -> when (fetch || header /= HeaderNone) $ putPkgHdr pkg when haveGit $- when (have gitOptClean) checkWorkingDirClean+ when (have gitOptClean) $ checkWorkingDirClean (have gitOptStash) when fetch $ gitFetchSilent False -- FIXME!! no branch restriction when (breq `elem` map BranchOpt [AllBranches,AllFedora,AllEPEL]) $@@ -351,15 +361,17 @@ matches <- filter ("Release:" `isPrefixOf`) <$> grep "%autorelease" spec return $ not (null matches) -pkgNameVerRel :: Branch -> FilePath -> IO (Maybe String)+-- FIXME return NVR??+pkgNameVerRel :: Branch -> FilePath -> IO (Maybe NVR) pkgNameVerRel br spec = do disttag <- rpmDistTag <$> branchDist br -- workaround dist with bootstrap hostdist <- cmd "rpm" ["--eval", "%{dist}"] -- FIXME more precise regexp with "Release:" autorelease <- isAutoRelease spec- nvrs <-- if autorelease+ nvrs <- do+ pkggit <- isPkgGitRepo+ if autorelease && pkggit then do --putStrLn "%autorelease detected" mfedpkg <- findExecutable "fedpkg"@@ -371,10 +383,10 @@ return $ case nvrs of [] -> Nothing- [nvr] -> Just (replace hostdist disttag nvr)+ [nvr] -> maybeNVR (replace hostdist disttag nvr) _ -> error' "could not determine unique nvr" -pkgNameVerRel' :: Branch -> FilePath -> IO String+pkgNameVerRel' :: Branch -> FilePath -> IO NVR pkgNameVerRel' br spec = do mnvr <- pkgNameVerRel br spec case mnvr of@@ -386,21 +398,33 @@ getBranchDist (OtherBranch _) = systemBranch >>= branchDist -- FIXME should be more strict about dist tag (eg .fcNN only)--- FIXME replace with NVR's?-equivNVR :: String -> String -> Bool-equivNVR nvr1 nvr2- | nvr1 == nvr2 = True- | length nvr1 /= length nvr2 = False- | otherwise =- -- (name-ver-rel,.dist)- let (nvr, r) = splitExtension nvr1- (nvr', r') = splitExtension nvr2- in nvr == nvr' &&- -- (dist,.more)- let (r1,r1') = splitExtension $ tail r- (r2,r2') = splitExtension $ tail r'- -- allow differing dist- in length r1 == length r2 && r1' == r2'+equivNVR :: NVR -> Maybe NVR -> Bool+equivNVR _ Nothing = False+equivNVR nvr1 (Just nvr2) =+ nvr1 == nvr2+ ||+ let (nv1,r1) = splitRelease nvr1+ (nv2,r2) = splitRelease nvr2+ in+ nv1 == nv2+ &&+ compareReleases r1 r2+ where+ compareReleases :: String -> String -> Bool+ compareReleases r1 r2 =+ r1 == r2+ ||+ case ('.' `elem` r1, '.' `elem` r2) of+ (True,True) ->+ let (r1',drs1) = span (/= '.') r1+ (r2',drs2) = span (/= '.') r2+ in+ case (take 2 r1', take 2 r2') of+ ("fc","fc") -> True+ _ -> r1' == r2' && length drs1 == length drs2+ &&+ compareReleases (tail drs1) (tail drs2)+ _ -> False -- data BrPkg = IsBr AnyBranch | Unknown String | IsPkg String -- deriving Show@@ -466,3 +490,8 @@ editSpecField :: String -> String -> FilePath -> IO () editSpecField field new spec = cmd_ "sed" ["-i", "-e s/^\\(" ++ field ++ ":\\s\\+\\).*/\\1" ++ new ++ "/", spec]++#if !MIN_VERSION_rpm_nvr(0,1,3)+splitRelease :: NVR -> (NV,String)+splitRelease (NVR n (VerRel v r)) = (NV n v, r)+#endif
src/RpmBuild.hs view
@@ -13,7 +13,8 @@ isShortCircuit, checkSourcesMatch, notInstalled,- rpmEval+ rpmEval,+ distRpmOptions ) where @@ -21,7 +22,8 @@ import Data.Char (isDigit) import Data.Either (partitionEithers) import Data.RPM-import Distribution.Fedora hiding (Fedora,EPEL,EPELNext)+import qualified Distribution.Fedora as Dist+import Distribution.Fedora (Dist) import Network.HTTP.Directory (Manager, httpExists, httpManager) import SimpleCmd.Rpm import SimplePrompt (promptEnter)@@ -30,17 +32,37 @@ import System.Posix.Files import Branches+import Cmd.Update (updatePkg) import Common import Common.System import Git import Package +distOpt :: Dist -> [String]+distOpt dist =+ ["--define", "dist" +-+ "%{?distprefix}" ++ Dist.rpmDistTag dist]++-- 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"]+ builtRpms :: AnyBranch -> FilePath -> IO [FilePath] builtRpms br spec = do dist <- getBranchDist br- -- previously was "" for pkggit rpmdir <- fromMaybe "" <$> rpmEval "%{_rpmdir}"- rpms <- rpmspec ["--builtrpms", "--define", "dist" +-+ rpmDistTag dist] (Just (rpmdir </> "%{arch}/%{name}-%{version}-%{release}.%{arch}.rpm")) spec+ autoreleaseOpt <- getAutoReleaseOptions spec+ rpms <- rpmspec (["--builtrpms", "--define", "dist" +-+ Dist.rpmDistTag dist] ++ 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@@ -149,9 +171,8 @@ act (dir </> file) file doesSourceDirFileExist :: Maybe FilePath -> FilePath -> IO Bool- doesSourceDirFileExist Nothing _ = return False- doesSourceDirFileExist (Just srcdir) file =- doesFileExist (srcdir </> file)+ doesSourceDirFileExist msrcdir file =+ doesFileExist (fromMaybe "" msrcdir </> file) generateSrpm :: Maybe AnyBranch -> FilePath -> IO FilePath generateSrpm = generateSrpm' False@@ -163,7 +184,7 @@ Nothing -> return [] Just br -> do dist <- getBranchDist br- return ["--define", "dist" +-+ rpmDistTag dist]+ return $ distOpt dist msrcrpmdir <- rpmEval "%{_srcrpmdir}" srpmfile <- cmd "rpmspec" $ ["-q", "--srpm"] ++ distopt ++ ["--qf", fromMaybe "" msrcrpmdir </> "%{name}-%{version}-%{release}.src.rpm", spec] cwd <- getCurrentDirectory@@ -186,12 +207,34 @@ return srpmfile where buildSrpm opts = do- -- prevent Ctrl-c from truncating srpm to corrupted file:+ -- 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:'- srpm <- last . words <$> uninterruptibleMask_ (cmd "rpmbuild" (opts ++ ["-bs", spec]))- putStrLn $ "Created" +-+ takeFileName srpm- return srpm+ -- 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]))+ case filter ("src.rpm" `isExtensionOf`) outs of+ [srpm] -> do+ putStrLn $ "Created" +-+ takeFileName srpm+ return srpm+ srpms -> error' $ "could not determined generated srpm filename" +-+ unwords srpms +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+ calculated <- cmd "rpmautospec" ["calculate-release", spec]+ return ["--define", "_rpmautospec_release_number" +-+ dropPrefix "Calculated release number: " calculated]+ else return []+ data ForceShort = ForceBuild | ShortCompile | ShortInstall deriving Eq @@ -201,12 +244,6 @@ Just s -> s /= ForceBuild Nothing -> False -data BCond = BuildWith String | BuildWithout String--instance Show BCond where- show (BuildWith s) = "--with=" ++ s- show (BuildWithout s) = "--without=" ++ s- -- FIXME create build.log -- Note does not check if bcond changed -- FIXME check tarball timestamp@@ -216,12 +253,14 @@ needBuild <- if isJust mforceshort then return True- else- ifM (not . and <$> mapM doesFileExist rpms)- (return True) $- do specTime <- getModificationTime spec- rpmTimes <- sort <$> mapM getModificationTime rpms- return $ specTime > head rpmTimes+ else do+ allexist <- and <$> mapM doesFileExist rpms+ if not allexist+ then return True+ else do+ specTime <- getModificationTime spec+ rpmTimes <- sort <$> mapM getModificationTime rpms+ return $ specTime > head rpmTimes if not needBuild then putStrLn "Existing rpms are newer than spec file (use --force to rebuild)" else do@@ -229,21 +268,28 @@ void $ getSources spec dist <- getBranchDist br cwd <- getCurrentDirectory+ autoreleaseOpt <- getAutoReleaseOptions spec let buildopt = case mforceshort of Just ShortCompile -> ["-bc", "--short-circuit"] Just ShortInstall -> ["-bi", "--short-circuit"] _ -> "-bb" : ["--noclean" | noclean] sourcediropt = ["--define", "_sourcedir" +-+ cwd]- args = sourcediropt ++ ["--define", "dist" +-+ rpmDistTag dist] ++- buildopt ++ map show bconds ++ [spec]+ args = sourcediropt ++ distOpt dist +++ buildopt ++ map show bconds ++ autoreleaseOpt ++ [spec] date <- cmd "date" ["+%T"] rbr <- anyBranchToRelease br nvr <- pkgNameVerRel' rbr spec- putStr $ date +-+ "Building" +-+ nvr +-+ "locally... "+ putStr $ date +-+ "Building" +-+ showNVR nvr +-+ "locally... " ok <- do- let buildlog = ".build-" ++ (showVerRel . nvrVerRel . readNVR) nvr <.> "log"- whenM (doesFileExist buildlog) $+ let buildlog = ".build-" ++ (showVerRel . nvrVerRel) nvr <.> "log"+ whenM (doesFileExist buildlog) $ do+ let backup = buildlog <.> "prev"+ whenM (doesFileExist backup) $ do+ prevsize <- getFileSize backup+ currsize <- getFileSize buildlog+ when (prevsize > currsize) $+ copyFile backup (backup <.> "prev") copyFile buildlog (buildlog <.> "prev") timeIO $ if not quiet || isShortCircuit mforceshort@@ -262,7 +308,7 @@ else cmd_ "tail" ["-n 100", buildlog] return res unless ok $- error' $ nvr +-+ "failed to build"+ error' $ showNVR nvr +-+ "failed to build" return needBuild where quoteArg :: String -> String@@ -307,19 +353,16 @@ void $ getSources spec withTempDir $ \tmpdir -> do let srpmdiropt = ["--define", "_srcrpmdir" +-+ tmpdir]- (ok, out, err) <- cmdFull "rpmbuild" (["-br", "--nodeps", spec] ++ srpmdiropt) ""- if ok- then do- -- Wrote: /current/dir/SRPMS/name-version-release.buildreqs.nosrc.rpm- case words out of- [] -> error' $ spec +-+ "could not generate source rpm for dynamic buildrequires"- ws -> do- let srpm = last ws- exists <- doesFileExist srpm- if exists- then cmdLines "rpm" ["-qp", "--requires", last ws]- else error' err- else error' err+ (_ok, out, err) <- cmdFull "rpmbuild" (["-br", "--nodeps", spec] ++ srpmdiropt) ""+ -- Wrote: /current/dir/SRPMS/name-version-release.buildreqs.nosrc.rpm+ case words out of+ [] -> error' $ spec +-+ "could not generate source rpm for dynamic buildrequires"+ ws -> do+ let srpm = last ws+ exists <- doesFileExist srpm+ if exists+ then cmdLines "rpm" ["-qp", "--requires", last ws]+ else error' err else -- FIXME should resolve meta rpmspec ["--buildrequires"] Nothing spec@@ -332,8 +375,8 @@ then Nothing else Just d -checkSourcesMatch :: FilePath -> IO ()-checkSourcesMatch spec = do+checkSourcesMatch :: Package -> AnyBranch -> FilePath -> IO ()+checkSourcesMatch pkg br spec = do -- "^[Ss]ource[0-9]*:" sourcefiles <- map (takeFileName . last . words) <$> cmdLines "spectool" [spec] sources <- lines <$> readFile "sources"@@ -342,22 +385,27 @@ src `notElem` gitfiles) sourcefiles unless (null missing) $ do- promptEnter $ color Red $ unwords missing +-+ "not in sources, please fix"+ promptEnter $ color Red $ unwords missing +-+ "not in sources, press Enter to fix"+ updatePkg True False False True Nothing pkg br+ git_ "status" ["--short"]+ promptEnter "Please Enter to amend commit and continue"+ git_ "commit" ["--amend"]+ unlessM isGitDirClean $+ error' "local changes remain (dirty)" checkOnBranch- checkSourcesMatch spec+ checkSourcesMatch pkg br spec mgr <- httpManager- let pkg = takeBaseName spec- mapM_ (checkLookasideCache mgr pkg) sources+ mapM_ (checkLookasideCache mgr) sources where- checkLookasideCache :: Manager -> String -> String -> IO ()- checkLookasideCache mgr pkg source = do+ checkLookasideCache :: Manager -> String -> IO ()+ checkLookasideCache mgr source = do let (file,url) = case words source of ("SHA512":('(':fileparen):"=":[hash]) -> let file' = dropSuffix ")" fileparen- in (file', "https://src.fedoraproject.org/lookaside/pkgs" +/+ pkg +/+ file +/+ "sha512" +/+ hash +/+ file)+ in (file', "https://src.fedoraproject.org/lookaside/pkgs" +/+ unPackage pkg +/+ file +/+ "sha512" +/+ hash +/+ file) [hash,file'] ->- (file', "https://src.fedoraproject.org/lookaside/pkgs" +/+ pkg +/+ file +/+ "md5" +/+ hash +/+ file)+ (file', "https://src.fedoraproject.org/lookaside/pkgs" +/+ unPackage pkg +/+ file +/+ "md5" +/+ hash +/+ file) _ -> error' $ "invalid/unknown source:\n" ++ source unlessM (httpExists mgr url) $ do putStrLn $ url +-+ "not found"