fbrnch 1.1 → 1.1.1
raw patch · 19 files changed
+294/−148 lines, 19 filesdep ~fedora-distsdep ~rpm-nvr
Dependency ranges changed: fedora-dists, rpm-nvr
Files
- CHANGELOG.md +25/−2
- README.md +39/−8
- fbrnch.cabal +4/−4
- src/Bodhi.hs +2/−0
- src/Branches.hs +2/−0
- src/Cmd/Build.hs +53/−38
- src/Cmd/Commit.hs +2/−2
- src/Cmd/Copr.hs +2/−1
- src/Cmd/Merge.hs +24/−36
- src/Cmd/Parallel.hs +68/−25
- src/Cmd/RequestBranch.hs +4/−3
- src/Cmd/Scratch.hs +3/−0
- src/Cmd/Status.hs +1/−2
- src/Cmd/Update.hs +0/−3
- src/Common.hs +1/−1
- src/Git.hs +26/−1
- src/InterleaveOutput.hs +4/−2
- src/Main.hs +12/−7
- src/Package.hs +22/−13
CHANGELOG.md view
@@ -1,7 +1,30 @@ # Changelog -## next-- 'repoquery': new experimental command+## 1.1.1 (2022-05-30)+- copr: time builds+- commit: fix getting log from additional changelog message+- merge: --from to specify which branch to merge+- Package getSources: only check 'sources' if dist-git+- Package getSources: install compression tool if missing+- Package buildRPMs: use shellBool to send stderr also to tee+- request-branches: print out url per branch+- require rpm-nvr 0.1.2 for better NVR name validation+- initial support for epel-next (#29)+- Package builtRpms: no longer assume in cwd for dist-git+- build: now possible to skip pushing an update at prompt with 'no'+- initial support for epel-next (#29)+- Package builtRpms: no longer assume in cwd for dist-git+- build: now possible to skip pushing an update at prompt with 'no'+- main help: add readme url+- build: add --skip-fetch option+- Git isPkgGitRepo: fix handling of forks (#33)+- InterleaveOutput: fix cmdSilent' to error on failure+- parallel: add --merge (#30)+- fix -s/-S ambigious for build and parallel+- parallel: unlock update after sidetag removal+- parallel: waitrepo for sidetag before starting to build+- parallel: get buildtag from koji to determine basetag for sidetag+- parallel: allow branch options like --all-fedora/--all-epel ## 1.1 (2022-04-30) - parallel: show target as early as possible
README.md view
@@ -4,7 +4,7 @@ [](https://github.com/juhp/fbrnch/actions) [](https://hackage.haskell.org/package/fbrnch) -A tool to help Fedora Packagers build package branches and add new packages.+A tool to help Fedora Packagers build package branches. Fedora developers use a lot of time building packages across releases and workflow for adding new packages, etc.@@ -19,10 +19,11 @@ - merging and building a package across release branches - automated parallel builds of sets of packages in dependency order+- easy scratch and mock builds+- progressive copr builds - creating, updating and listing package reviews - requesting new repos and branches - importing new packages and updating packages-- progressive copr builds - rename master branches to rawhide and more.@@ -233,12 +234,13 @@ ``` $ fbrnch --version-1.1+1.1.1 $ fbrnch --help Fedora branch building tool Usage: fbrnch [--version] COMMAND- This tool helps with updating and building package branches+ A tool to help with updating and building package branches+ https://github.com/juhp/fbrnch#readme Available options: -h,--help Show this help text@@ -328,6 +330,35 @@ - ssh & scp (for uploading package reviews) - bugzilla API key +## rpmbuild configuration+You may want to set `~/.rpmmacros` to use particular directories,+since unlike fedpkg, fbrnch follows the macros set in `~/.rpmmacros`.++By default rpmbuild uses `~/rpmbuild/`.++Two common alternative configurations might be either:++1) use the package directory for everything (like fedpkg does):+```+%__pwd %(echo $PWD)+%_builddir %__pwd+%_rpmdir %__pwd+%_sourcedir %__pwd+%_specdir %__pwd+%_srcrpmdir %__pwd+```+These are easy to find, but do create a lot of clutter.++2) Lately I just set _topdir to pwd+```+%__pwd %(echo $PWD)+%_topdir %__pwd+%_sourcedir %__pwd+%_specdir %__pwd+```+With this rpmbuild creates a bunch of dirs in each package dir+(like the ones in ~/rpmbuild/), which can hide srpms and build trees, etc.+ ## Bugzilla API key fbrnch can share the API of the python-bugzilla CLI tool, placed either in `~/.config/python-bugzilla/bugzillarc` or `~/.bugzillarc`:@@ -349,7 +380,7 @@ - so python clients are used for "writing" (specifically koji, bodhi-client, fedpkg), but all queries are done directly by Web APIs for speed and control.-- https checkouts are currently assumed to an anonymous git checkouts+- https checkouts are currently treated as anonymous git checkouts ## Motivation, history, talks This project started off (as "fedbrnch") basically as a simple tool to@@ -363,14 +394,14 @@ - Lightning talk at devconf.cz 2021: [youtube](https://www.youtube.com/watch?v=O2-6rDuPMRA&t=2s) ## Contribute-Bug reports, feedback, and pull requests welcome.+Bug reports, feedback, and pull requests are all highly appreciated. Please report any unsupported or unintuitive workflow steps. See the TODO list and also the FIXME comments scattered across the source.-Do open an issue before embarking on large changes.+Do open an issue before embarking on larger changes. -People who have committed:+Authors of the code: <a href="https://github.com/juhp/fbrnch/graphs/contributors"> <img src="https://contributors-img.web.app/image?repo=juhp/fbrnch" />
fbrnch.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.0 name: fbrnch-version: 1.1-synopsis: Build and create Fedora package repos and branches+version: 1.1.1+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.@@ -106,7 +106,7 @@ directory >= 1.2.3, email-validate, extra,- fedora-dists >= 2.0,+ fedora-dists >= 2.1.1, filepath, -- haskeline, http-conduit,@@ -121,7 +121,7 @@ process, -- regex-tdfa, rpmbuild-order >= 0.4.5,- rpm-nvr >= 0.1.1,+ rpm-nvr >= 0.1.2, simple-cmd >= 0.2.0, simple-cmd-args >= 0.1.6, text,
src/Bodhi.hs view
@@ -29,6 +29,8 @@ checkAutoBodhiUpdate Rawhide = return True -- epel7 returns 'create_automatic_updates: null' ! checkAutoBodhiUpdate (EPEL 7) = return False+-- not sure how to best handle next+checkAutoBodhiUpdate (EPELNext _) = return False checkAutoBodhiUpdate br = lookupKey'' "create_automatic_updates" <$> bodhiRelease (show br) where
src/Branches.hs view
@@ -110,6 +110,7 @@ Rawhide -> "fedora-rawhide-" ++ arch Fedora n -> "fedora-" ++ show n ++ "-" ++ arch EPEL n -> "epel-" ++ show n ++ "-" ++ arch+ EPELNext n -> "centos-stream+epel-next-" ++ show n ++ "-" ++ arch ------ @@ -217,6 +218,7 @@ branchVersion Rawhide = "rawhide" branchVersion (Fedora n) = show n branchVersion (EPEL n) = show n+branchVersion (EPELNext n) = show n getRequestedBranches :: BranchesReq -> IO [Branch] getRequestedBranches breq = do
src/Cmd/Build.hs view
@@ -28,6 +28,7 @@ , buildoptOverride :: Maybe Int , buildoptWaitrepo :: Maybe Bool , buildoptDryrun :: Bool+ , buildSkipFetch :: Bool , buildoptUpdate :: (Maybe UpdateType, UpdateSeverity) , buildoptUseChangelog :: Bool , buildoptByPackage :: Bool@@ -40,7 +41,7 @@ -- FIXME --rpmlint (default for rawhide?) -- FIXME support --wait-build=NVR -- FIXME build from ref--- FIXME provide direct link to failed task/build.log+-- FIXME tail of failed build.log -- FIXME --auto-override for deps in testing -- FIXME -B fails to find new branches (fixed?) -- FIXME disallow override for autoupdate?@@ -50,16 +51,18 @@ let singleBrnch = if isJust (buildoptTarget opts) then ZeroOrOne else AnyNumber- let mlastOfPkgs = if length pkgs > 1+ mlastOfPkgs = if length pkgs > 1 then Just (Package (last pkgs)) else Nothing+ gitopts =+ if buildSkipFetch opts then cleanGitActive else cleanGitFetchActive if not (buildoptByPackage opts) && breq /= Branches [] && length pkgs > 1 then do brs <- listOfBranches True True breq forM_ brs $ \br ->- withPackageByBranches (Just False) cleanGitFetchActive singleBrnch (buildBranch mlastOfPkgs opts) (Branches [br], pkgs)+ withPackageByBranches (Just False) gitopts singleBrnch (buildBranch mlastOfPkgs opts) (Branches [br], pkgs) else- withPackageByBranches (Just False) cleanGitFetchActive singleBrnch (buildBranch mlastOfPkgs opts) (breq, pkgs)+ withPackageByBranches (Just False) gitopts singleBrnch (buildBranch mlastOfPkgs opts) (breq, pkgs) -- FIXME what if untracked files buildBranch :: Maybe Package -> BuildOpts -> Package -> AnyBranch -> IO ()@@ -73,15 +76,19 @@ gitMergeOrigin br newrepo <- initialPkgRepo tty <- isTty- (ancestor,unmerged) <- mergeable br+ (ancestor,unmerged) <- newerMergeable br -- FIXME if already built or failed, also offer merge merged <- case buildoptMerge opts of Just False -> return False- Just True -> mergeBranch True True (ancestor,unmerged) br >> return True+ Just True -> do+ newer <- getNewerBranch br+ mergeBranch True True (ancestor,unmerged) newer br >> return True Nothing -> if ancestor && (newrepo || tty)- then mergeBranch True False (ancestor,unmerged) br >> return True+ then do+ newer <- getNewerBranch br+ mergeBranch True False (ancestor,unmerged) newer br >> return True else do unless (br == Rawhide) $ putStrLn "newer branch is not ancestor"@@ -211,37 +218,45 @@ (Just updateType, severity) -> do unless dryrun $ do -- use cmdLog to debug, but notes are not quoted- if updateType == TemplateUpdate- then cmd_ "fedpkg" ["update"]- else do- -- FIXME also query for open existing bugs- changelog <- if isJust mreview- then getSummaryURL spec- else if buildoptUseChangelog opts- then cleanChangelog spec- else- -- FIXME list open bugs- changeLogPrompt (Just "update") spec- let cbugs = extractBugReferences changelog- bugs = let bids = [show rev | Just rev <- [mreview]] ++ cbugs in- if null bids then [] else ["--bugs", intercalate "," bids]- when (isJust mreview &&- updateType `elem` [SecurityUpdate,BugfixUpdate]) $- warning "overriding update type with 'newpackage'"- putStrLn $ "Creating Bodhi Update for " ++ nvr ++ ":"- -- FIXME check for Bodhi URL to confirm update- cmd_ "bodhi" (["updates", "new", "--type", if isJust mreview then "newpackage" else show updateType, "--severity", show severity, "--request", "testing", "--notes", changelog, "--autokarma", "--autotime", "--close-bugs"] ++ bugs ++ [nvr])- -- FIXME avoid this if we know the update URL- updatequery <- bodhiUpdates [makeItem "display_user" "0", makeItem "builds" nvr]- case updatequery of- [] -> do- putStrLn "bodhi submission failed"- prompt_ "Press Enter to resubmit to Bodhi"- bodhiUpdate dryrun mreview spec nvr- [update] -> case lookupKey "url" update of- Nothing -> error' "Update created but no url"- Just uri -> putStrLn uri- _ -> error' $ "impossible happened: more than one update found for " ++ nvr+ updatedone <-+ if updateType == TemplateUpdate+ then do+ cmd_ "fedpkg" ["update"]+ return True+ else do+ -- FIXME also query for open existing bugs+ changelog <- if isJust mreview+ then getSummaryURL spec+ else if buildoptUseChangelog opts+ then cleanChangelog spec+ else+ -- FIXME list open bugs+ changeLogPrompt (Just "update") spec+ if lower changelog == "no"+ then return False+ else do+ let cbugs = extractBugReferences changelog+ bugs = let bids = [show rev | Just rev <- [mreview]] ++ cbugs in+ if null bids then [] else ["--bugs", intercalate "," bids]+ when (isJust mreview &&+ updateType `elem` [SecurityUpdate,BugfixUpdate]) $+ warning "overriding update type with 'newpackage'"+ putStrLn $ "Creating Bodhi Update for " ++ nvr ++ ":"+ -- FIXME check for Bodhi URL to confirm update+ cmd_ "bodhi" (["updates", "new", "--type", if isJust mreview then "newpackage" else show updateType, "--severity", show severity, "--request", "testing", "--notes", changelog, "--autokarma", "--autotime", "--close-bugs"] ++ bugs ++ [nvr])+ return True+ when updatedone $ do+ -- FIXME avoid this if we know the update URL+ updatequery <- bodhiUpdates [makeItem "display_user" "0", makeItem "builds" nvr]+ case updatequery of+ [] -> do+ putStrLn "bodhi submission failed"+ prompt_ "Press Enter to resubmit to Bodhi"+ bodhiUpdate dryrun mreview spec nvr+ [update] -> case lookupKey "url" update of+ Nothing -> error' "Update created but no url"+ Just uri -> putStrLn uri+ _ -> error' $ "impossible happened: more than one update found for " ++ nvr extractBugReferences :: String -> [String] extractBugReferences clog =
src/Cmd/Commit.hs view
@@ -45,10 +45,10 @@ else do diff <- git "diff" ["-U0", "HEAD"] let newlogs =- filter (\c -> ("+- " ++ c) `elem` lines diff) clog+ filter (\c -> ('+' : c) `elem` lines diff) clog case newlogs of [] -> putStrLn diff >> readCommitMsg- [msg] -> putStrLn msg >> return (removePrefix "- " msg)+ [msg] -> return (removePrefix "- " msg) _ -> mapM_ putStrLn newlogs >> readCommitMsg return ["-m", changelog] git_ "commit" $ ["-a" | notstaged] ++ opts
src/Cmd/Copr.hs view
@@ -122,6 +122,7 @@ branchRelease Rawhide = "fedora-rawhide" branchRelease (Fedora n) = "fedora-" ++ show n branchRelease (EPEL n) = "epel-" ++ show n+branchRelease (EPELNext n) = error' $ show (EPELNext n) ++ " is unsupported" --data Chroot = Chroot Release Arch @@ -157,7 +158,7 @@ output <- cmd "copr" buildargs putStrLn output let bid = read $ last $ words $ last $ lines output- ok <- coprWatchBuild bid Nothing+ ok <- timeIO $ coprWatchBuild bid Nothing unless ok $ error' $ "Failed: copr " ++ unwords buildargs
src/Cmd/Merge.hs view
@@ -1,7 +1,7 @@ module Cmd.Merge ( mergeCmd,- mergeable,- mergeBranch)+ mergeBranch,+ getNewerBranch) where import Common@@ -12,9 +12,8 @@ import Package import Prompt --- add BranchOpts?-mergeCmd :: Bool -> (BranchesReq,[String]) -> IO ()-mergeCmd noprompt =+mergeCmd :: Bool -> Maybe Branch -> (BranchesReq,[String]) -> IO ()+mergeCmd noprompt mfrom = withPackageByBranches (Just False) cleanGitFetchActive AnyNumber runMergeBranch where runMergeBranch :: Package -> AnyBranch -> IO ()@@ -22,39 +21,29 @@ error' "merge only defined for release branches" runMergeBranch _pkg rbr@(RelBranch br) = do gitSwitchBranch rbr+ from <- maybe (getNewerBranch br) return mfrom+ when (from == br) $+ error' "cannot merge branch to itself" gitMergeOrigin br- unmerged <- mergeable br- mergeBranch False noprompt unmerged br--getNewerBranch :: Branch -> IO Branch-getNewerBranch Rawhide = return Rawhide-getNewerBranch br = do- branches <- fedoraBranches (localBranches False)- let newer = newerBranch br branches- return $ if newer > br then newer- -- FIXME this can be dropped with next fedora-dists- else case elemIndex br branches of- Just i -> branches !! (i - 1)- Nothing -> error' $ show br ++ ": branch not found"+ unmerged <- mergeable from br+ mergeBranch False noprompt unmerged from br -- FIXME maybe require local branch already here-mergeable :: Branch -> IO (Bool,[String])-mergeable Rawhide = return (False,[])-mergeable br = do- newer <- getNewerBranch br+mergeable :: Branch -> Branch -> IO (Bool,[String])+mergeable _ Rawhide = return (False,[])+mergeable from _ = do locals <- localBranches True- gitMergeable (show newer `notElem` locals) newer+ gitMergeable (show from `notElem` locals) from -- FIXME return merged ref mergeBranch :: Bool -> Bool -> (Bool,[String]) -- (ancestor,unmerged)- -> Branch -> IO ()-mergeBranch _ _ _ Rawhide = return ()-mergeBranch _ _ (_,[]) _ = return ()-mergeBranch build noprompt (True, unmerged) br = do- newerBr <- getNewerBranch br+ -> Branch -> Branch -> IO ()+mergeBranch _ _ _ _ Rawhide = return ()+mergeBranch _ _ (_,[]) _ _ = return ()+mergeBranch build noprompt (True, unmerged) from br = do isnewrepo <- initialPkgRepo unless (null unmerged) $ do- putStrLn $ (if isnewrepo || noprompt then "Merging from" else "New commits in") ++ " " ++ show newerBr ++ ":"+ putStrLn $ (if isnewrepo || noprompt then "Merging from" else "New commits in") ++ " " ++ show from ++ ":" mapM_ putStrLn unmerged unpushed <- gitShortLog $ "origin/" ++ show br ++ "..HEAD" unless (null unpushed) $ do@@ -64,7 +53,7 @@ mmerge <- if isnewrepo && length unmerged == 1 || noprompt then return $ Just Nothing- else refPrompt unmerged $ "Press Enter to merge " ++ show newerBr +++ else refPrompt unmerged $ "Press Enter to merge " ++ show from ++ (if build then " and build" else "") ++ (if length unmerged > 1 then "; or give a ref to merge" else "") ++ "; or 'no' to skip merge"@@ -72,15 +61,14 @@ gitSwitchBranch (RelBranch br) whenJust mmerge $ \ mhash -> do let ref = case mhash of- Nothing -> show newerBr+ Nothing -> show from Just hash -> hash locals <- localBranches True- unless (show newerBr `elem` locals) $- git_ "fetch" ["origin", show newerBr ++ ":" ++ show newerBr]+ unless (show from `elem` locals) $+ git_ "fetch" ["origin", show from ++ ":" ++ show from] git_ "merge" ["--quiet", ref]-mergeBranch build noprompt (False,unmerged) br = do- newer <- getNewerBranch br- putStrLn $ show newer ++ " branch is not directly mergeable:"+mergeBranch build noprompt (False,unmerged) from br = do+ putStrLn $ show from ++ " branch is not directly mergeable:" mapM_ putStrLn unmerged putStrLn "" unpushed <- gitShortLog $ "origin/" ++ show br ++ "..HEAD"
src/Cmd/Parallel.hs view
@@ -10,12 +10,14 @@ import Control.Concurrent.Async import Distribution.RPM.Build.Order (dependencyLayers)+import Fedora.Bodhi import System.Console.Pretty import System.Time.Extra (sleep) import Bodhi import Bugzilla import Branches+import Cmd.Merge (mergeBranch) import Git import Krb import Koji@@ -37,10 +39,12 @@ -- FIXME check sources as early as possible -- FIXME --single-layer to build packages at once regardless -- FIXME time builds-parallelBuildCmd :: Bool -> Int -> Maybe SideTagTarget+-- FIXME copy bodhi notes from another branch update+parallelBuildCmd :: Bool -> Bool -> Int -> Maybe SideTagTarget -> (Maybe UpdateType, UpdateSeverity) -> (BranchesReq, [String]) -> IO ()-parallelBuildCmd dryrun firstlayer msidetagTarget mupdate (breq, pkgs) = do+parallelBuildCmd dryrun merge firstlayer msidetagTarget mupdate (breq, pkgs) =+ do branches <- case pkgs of [] -> do@@ -51,7 +55,7 @@ _ -> case breq of Branches [] -> error' "please specify a branch" Branches _ -> listOfBranches True True breq- _ -> error' "parallel does not support branch options for multiple packages: please give an explicit list of branches instead"+ _ -> listOfBranches False True breq when (null branches) $ error' "Please specify at least one branch" let mtarget = maybeTarget msidetagTarget@@ -63,6 +67,8 @@ parallelBranches branches _ -> forM_ branches $ \ rbr -> do+ forM_ pkgs $ \p ->+ withExistingDirectory p $ mergeNewerBranch p rbr allLayers <- dependencyLayers pkgs let layers = drop firstlayer allLayers when (isNothing msidetagTarget && length allLayers > 1) $@@ -71,13 +77,13 @@ when (length branches > 1) $ putStrLn $ "# " ++ show rbr target <- targetMaybeSidetag rbr- mapM_ (parallelBuild target rbr)- $ zip [firstlayer..length allLayers]- $ init $ tails layers -- tails ends in []+ nvrs <- concatMapM (parallelBuild target rbr)+ $ zip [firstlayer..length allLayers]+ $ init $ tails layers -- tails ends in [] unless (isNothing msidetagTarget || dryrun) $ do when (target /= branchTarget rbr) $ do notes <- prompt $ "Enter notes to submit Bodhi update for " ++ target- bodhiSidetagUpdate target notes+ bodhiSidetagUpdate nvrs target notes where parallelBranches :: [Branch] -> IO () parallelBranches brs = do@@ -86,22 +92,34 @@ putStrLn $ "= Building " ++ pluralException (length brs) "branch" "branches" ++ " in parallel:" putStrLn $ unwords $ map show brs jobs <- mapM setupBranch brs- failures <- watchJobs [] jobs+ (failures,_nvrs) <- watchJobs [] [] jobs -- switch back to the original branch when (length brs /= 1) $ gitSwitchBranch currentbranch unless (null failures) $ error' $ "Build failures: " ++ unwords failures where+ -- FIXME time jobs setupBranch :: Branch -> IO Job setupBranch br = do target <- targetMaybeSidetag br+ when merge $ mergeNewerBranch (show br) br job <- startBuild False False target br "." >>= async unless dryrun $ sleep 3 return (show br,job) - parallelBuild :: String -> Branch -> (Int,[[String]]) -> IO ()- parallelBuild _ _ (_,[]) = return () -- should not reach here+ mergeNewerBranch :: String -> Branch -> IO ()+ mergeNewerBranch desc br = do+ gitSwitchBranch (RelBranch br)+ (ancestor,unmerged) <- newerMergeable br+ newer <- getNewerBranch br+ when (ancestor && not (null unmerged)) $+ putStrLn $ "Checking " ++ desc ++ ":"+ mergeBranch True False (ancestor,unmerged) newer br++ -- FIXME time builds or layers+ parallelBuild :: String -> Branch -> (Int,[[String]]) -> IO [String]+ parallelBuild _ _ (_,[]) = return [] -- should not reach here parallelBuild target br (layernum, layer:nextLayers) = do krbTicket putStrLn $ "\n= Building parallel layer #" ++ show layernum ++@@ -117,9 +135,13 @@ [l] -> plural l "package" _ -> show layerspkgs ++ " packages" jobs <- mapM setupBuild layer- failures <- watchJobs [] jobs+ when (null jobs) $+ error' "No jobs run"+ (failures,nvrs) <- watchJobs [] [] jobs -- FIXME prompt to continue?- unless (null failures) $ do+ if null failures+ then return nvrs+ else do let pending = sum $ map length nextLayers error' $ "Build failures in layer " ++ show layernum ++ ": " ++ unwords failures ++ "\n\n" ++@@ -128,8 +150,6 @@ then ":\n" ++ unwords (map unwords nextLayers) else ""- when (null jobs) $- error' "No jobs run" where nopkgs = length layer layersleft = length nextLayers@@ -141,20 +161,21 @@ unless dryrun $ sleep 3 return (pkg,job) - watchJobs :: [String] -> [Job] -> IO [String]- watchJobs fails [] = return fails- watchJobs fails (job:jobs) = do+ -- (failures,successes)+ watchJobs :: [String] -> [String] -> [Job] -> IO ([String],[String])+ watchJobs fails nvrs [] = return (fails,nvrs)+ watchJobs fails nvrs (job:jobs) = do status <- poll (snd job) case status of- Nothing -> sleep 1 >> watchJobs fails (jobs ++ [job])+ Nothing -> sleep 1 >> watchJobs fails nvrs (jobs ++ [job]) Just (Right nvr) -> do putStrLn $ color Yellow nvr ++ " job completed (" ++ show (length jobs) ++ " left in layer)"- watchJobs fails jobs+ watchJobs fails (nvr:nvrs) jobs Just (Left except) -> do print except let pkg = fst job putStrLn $ "** " ++ color Magenta pkg ++ " job " ++ color Magenta "failed" ++ " ** (" ++ show (length jobs) ++ " left in layer)"- watchJobs (pkg : fails) jobs+ watchJobs (pkg : fails) nvrs jobs -- FIXME prefix output with package name startBuild :: Bool -> Bool -> String -> Branch -> String -> IO (IO String)@@ -181,6 +202,7 @@ mlatest <- kojiLatestNVR tag $ unPackage pkg case buildstatus of Just BuildComplete -> do+ -- FIXME detect old stable existing build putStrLn $ color Green nvr ++ " is " ++ color Green "already built" when (br /= Rawhide && morelayers && target == branchTarget br) $ do tags <- kojiNVRTags nvr@@ -239,8 +261,8 @@ kojiWaitRepo dryrun target nvr return nvr - bodhiSidetagUpdate :: String -> String -> IO ()- bodhiSidetagUpdate sidetag notes = do+ bodhiSidetagUpdate :: [String] -> String -> String -> IO ()+ bodhiSidetagUpdate nvrs sidetag notes = do case mupdate of (Nothing, _) -> return () (Just updateType, severity) -> do@@ -253,8 +275,25 @@ cmdBool "bodhi" ["updates", "new", "--file", template, "--from-tag", sidetag] else cmdBool "bodhi" ["updates", "new", "--type", show updateType , "--severity", show severity, "--request", "testing", "--notes", if null notes then "to be written" else notes, "--autokarma", "--autotime", "--close-bugs", "--from-tag", sidetag] when ok $ do- prompt_ "After editing update, press Enter to remove sidetag"+ prompt_ "Press Enter to remove the sidetag" fedpkg_ "remove-side-tag" [sidetag]+ -- arguably we already received the Updateid from the above bodhi+ -- command, but we query it here via nvr+ res <- bodhiUpdates [makeItem "display_user" "0", makeItem "builds" (last nvrs)]+ case res of+ [] -> do+ putStrLn "bodhi submission failed"+ prompt_ "Press Enter to resubmit to Bodhi"+ bodhiSidetagUpdate nvrs sidetag notes+ [update] ->+ case lookupKey "updateid" update of+ Nothing -> error' "could not determine Update id"+ Just updateid -> do+ -- disconnect the update from the sidetag+ -- so it can be changed after sidetag closed+ cmd_ "bodhi" ["updates", "edit", updateid]+ putStrLn "Update edited to unlock from sidetag"+ _ -> error' $ "impossible happened: more than one update found for " ++ last nvrs targetMaybeSidetag :: Branch -> IO String targetMaybeSidetag br =@@ -265,11 +304,15 @@ tags <- map (head . words) <$> kojiUserSideTags (Just br) case tags of [] -> do- out <- head . lines <$> fedpkg "request-side-tag" ["--base-tag", show br ++ "-build"]+ Just (buildtag,_desttag) <- kojiBuildTarget fedoraHub (show br)+ out <- head . lines <$> fedpkg "request-side-tag" ["--base-tag", buildtag] if "Side tag '" `isPrefixOf` out then do putStrLn out- return $ init . dropWhileEnd (/= '\'') $ dropPrefix "Side tag '" out+ let sidetag =+ init . dropWhileEnd (/= '\'') $ dropPrefix "Side tag '" out+ cmd_ "koji" ["wait-repo", sidetag]+ return sidetag else error' "'fedpkg request-side-tag' failed" [tag] -> return tag _ -> error' $ "More than one user side-tag found for " ++ show br
src/Cmd/RequestBranch.hs view
@@ -43,12 +43,13 @@ urls <- forM newbranches $ \ br -> do when mock $ fedpkg_ "mockbuild" ["--root", mockRoot br] when multiple $ putStr (unPackage pkg ++ " ")- when (length newbranches > 1) $ print br+ when (length newbranches > 1) $ putStr (show br) -- Can timeout like this: -- Could not execute request_branch: HTTPSConnectionPool(host='pagure.io', port=443): Read timed out. (read timeout=60) -- fbrnch: readCreateProcess: fedpkg "request-branch" "epel9" (exit 1): failed- fedpkg "request-branch" [show br]- putStrLn $ unlines urls+ u <- fedpkg "request-branch" [show br]+ putStrLn $ ' ' : u+ return u whenJust mbidsession $ \(bid,session) -> commentBug session bid $ unlines urls where
src/Cmd/Scratch.hs view
@@ -13,7 +13,10 @@ import Package import Types (Archs(..)) +-- FIXME --stagger archs -- FIXME allow multiple --target's (parallel too)+-- FIXME tail build.log for failure+-- FIXME append timestamp after %release (to help identify scratch builds) scratchCmd :: Bool -> Bool -> Bool -> Maybe Archs -> Maybe String -> Maybe String -> (BranchesReq, [String]) -> IO () scratchCmd dryrun rebuildSrpm nofailfast marchopts mtarget mref (breq,pkgs) =
src/Cmd/Status.hs view
@@ -115,7 +115,6 @@ hours = nomRest `div'` nominalHour :: Int putStr $ " " ++ plural days "day" +-+ plural hours "hour" -#if MIN_VERSION_time(1,8,0)-#else+#if !MIN_VERSION_time(1,8,0) nominalDay = 3600 * 24 :: NominalDiffTime #endif
src/Cmd/Update.hs view
@@ -97,10 +97,7 @@ forM_ archives removeFile cmd_ "spectool" ["-g", "-S", spec] krbTicket- copyFile "sources" "sources.fbrnch" cmd_ "fedpkg" $ "new-sources" : filter isArchiveFile sources- --shell_ $ "cat sources.fbrnch >>" +-+ "sources"- removeFile "sources.fbrnch" putStr "Prepping... " cmdSilent' "rpmbuild" ["-bp", spec] putStrLn "done"
src/Common.hs view
@@ -13,7 +13,7 @@ ) where import Control.Monad.Extra -- hiding (loop)-import Data.List.Extra+import Data.List.Extra hiding (merge) import Data.Maybe #if !MIN_VERSION_base(4,11,0)
src/Git.hs view
@@ -7,6 +7,8 @@ gitLines, gitMergeable, gitMergeOrigin,+ getNewerBranch,+ newerMergeable, gitFetchSilent, gitPushSilent, gitRepoName,@@ -48,6 +50,18 @@ commits <- gitShortLog ("HEAD.." ++ ref) return (ancestor, commits) +getNewerBranch :: Branch -> IO Branch+getNewerBranch Rawhide = return Rawhide+getNewerBranch br = do+ branches <- fedoraBranches (localBranches False)+ let newer = newerBranch br branches+ return $+ if newer > br then newer+ -- FIXME? this can be dropped with next fedora-dists+ else case elemIndex br branches of+ Just i -> branches !! (i - 1)+ Nothing -> error' $ show br ++ ": branch not found"+ gitMergeOrigin :: Branch -> IO () gitMergeOrigin br = do (ancestor,commits) <- gitMergeable True br@@ -58,6 +72,16 @@ putStr rebase else git_ "rebase" [] +-- FIXME maybe require local branch already here+newerMergeable :: Branch -> IO (Bool,[String])+newerMergeable br =+ if br == Rawhide+ then return (False,[])+ else do+ newer <- getNewerBranch br+ locals <- localBranches True+ gitMergeable (show newer `notElem` locals) newer+ gitShortLog :: String -> IO [String] gitShortLog range = map simplifyCommitLog <$> gitLines "log" ["--pretty=reference", range]@@ -138,7 +162,8 @@ isPkgGitRepo :: IO Bool isPkgGitRepo = grepGitConfig' "\\(https://\\|@\\)\\(pkgs\\|src\\)\\." &&^- (not <$> grepGitConfig' "/forks/")+ (not . ("/forks/" `isInfixOf`) <$>+ git "config" ["--get", "remote.origin.url"]) isPkgGitSshRepo :: IO Bool isPkgGitSshRepo = grepGitConfig' "@\\(pkgs\\|src\\)\\."
src/InterleaveOutput.hs view
@@ -4,10 +4,12 @@ import GHC.IO.Exception (ExitCode(ExitSuccess)) import System.Process.Typed (proc, readProcessInterleaved) import Common+import Common.System cmdSilent' :: String -> [String] -> IO ()-cmdSilent' c args =- void $ cmdSilentBool c args+cmdSilent' c args = do+ ok <- cmdSilentBool c args+ unless ok $ error' $ unwords (c:args) ++ ": failed" cmdSilentBool :: String -> [String] -> IO Bool cmdSilentBool c args = do
src/Main.hs view
@@ -54,7 +54,7 @@ main = do setNoBuffering simpleCmdArgs (Just version) "Fedora branch building tool"- "This tool helps with updating and building package branches" $+ "A tool to help with updating and building package branches https://github.com/juhp/fbrnch#readme" $ subcommands [ Subcommand "clone" "clone packages" $ cloneCmd@@ -74,6 +74,7 @@ , Subcommand "merge" "Merge from newer branch" $ mergeCmd <$> nopromptOpt+ <*> optional (optionWith branchM 'f' "from" "BRANCH" "Branch to merge from [default newer]") <*> branchesPackages , Subcommand "build" "Build package(s) in Koji" $ buildCmd@@ -94,9 +95,10 @@ , Subcommand "parallel" "Parallel build packages in Koji" $ parallelBuildCmd <$> dryrunOpt+ <*> switchWith 'm' "merge" "Merge newer branch without prompt" <*> optionalWith auto 'l' "skip-to-layer" "LAYERNO" "Skip the first N layers [default 0]" 0 <*> optional sidetagTargetOpt- <*> updateOpt+ <*> updateOpt 'S' <*> branchesPackages , Subcommand "sidetags" "List user's side-tags" $ sideTagsCmd@@ -400,7 +402,8 @@ <*> overrideOpt <*> waitrepoOpt <*> dryrunOpt- <*> updateOpt+ <*> skipFetchOpt+ <*> updateOpt 's' <*> useChangelogOpt <*> switchWith 'p' "by-package" "Build by each package across brs" where@@ -441,15 +444,17 @@ dryrunOpt = switchWith 'n' "dry-run" "Do not write (push, build, post, override)" - updateOpt :: Parser (Maybe UpdateType, UpdateSeverity)- updateOpt = updatePair <$> updatetypeOpt <*> updateSeverityOpt+ skipFetchOpt = switchWith 'S' "skip-fetch" "Do not git fetch"++ updateOpt :: Char -> Parser (Maybe UpdateType, UpdateSeverity)+ updateOpt s = updatePair <$> updatetypeOpt <*> updateSeverityOpt where updatetypeOpt = flagWith' Nothing 'U' "no-update" "Do not generate a Bodhi update" <|> Just <$> optionalWith auto 'u' "update-type" "TYPE" "security, bugfix, enhancement (default), newpackage, or template" EnhancementUpdate updateSeverityOpt =- optionalWith auto 's' "severity" "SEVERITY" "low, medium, high, urgent, (default: unspecified)" SeverityUnspecified+ optionalWith auto s "severity" "SEVERITY" "low, medium, high, urgent, (default: unspecified)" SeverityUnspecified updatePair :: Maybe UpdateType -> UpdateSeverity -> (Maybe UpdateType, UpdateSeverity)@@ -459,7 +464,7 @@ error' "cannot have --severity with --no-update" updatePair (Just TemplateUpdate) sev | sev /= SeverityUnspecified = error' "Template update cannot have --severity"- updatePair t s = (t,s)+ updatePair ty sv = (ty,sv) forceshortOpt = flagWith' ForceBuild 'f' "rebuild" "Rebuild even if already built" <|>
src/Package.hs view
@@ -56,7 +56,7 @@ import Data.Char (isDigit) import Data.Either (partitionEithers) import Data.RPM-import Distribution.Fedora hiding (Fedora,EPEL)+import Distribution.Fedora hiding (Fedora,EPEL,EPELNext) import Network.HTTP.Directory (Manager, httpExists, httpManager) import SimpleCmd.Rpm import System.Console.Pretty@@ -95,7 +95,7 @@ if not tty then return clog else do- userlog <- prompt $ "Press Enter to use above or input " ++ fromMaybe "change" mcontext ++ " summary now"+ userlog <- prompt $ "Press Enter to use above or input " ++ fromMaybe "change" mcontext ++ " summary now" ++ if isJust mcontext then "; or 'no' to skip update" else "" return $ if null userlog then clog else userlog changelogVersions :: FilePath -> IO [String]@@ -259,7 +259,8 @@ then do rbr <- anyBranchToRelease br nvr <- pkgNameVerRel' rbr spec- timeIO $ pipeBool ("rpmbuild", args) ("tee", [".build-" ++ showNVRVerRel (readNVR nvr) <.> "log"])+ -- FIXME would like to have pipeOutErr+ timeIO $ shellBool $ unwords $ "rpmbuild" : map quoteArg args ++ "|&" : "tee" : [".build-" ++ showNVRVerRel (readNVR nvr) <.> "log"] else do date <- cmd "date" ["+%T"] putStr $ date ++ " Building " ++ takeBaseName spec ++ " locally... "@@ -269,6 +270,10 @@ unless ok $ error' $ takeBaseName spec ++ " failed to build" return needBuild+ where+ quoteArg :: String -> String+ quoteArg cs =+ if ' ' `elem` cs then '\'' : cs ++ "'" else cs -- FIXME print unavailable deps installDeps :: Bool -> FilePath -> IO ()@@ -339,13 +344,13 @@ Just srcdir -> do canon <- canonicalizePath srcdir if canon == cwd- then return Nothing- else do+ then return Nothing+ else do dir <- doesDirectoryExist srcdir if dir then return msourcedir else return Nothing- gitDir <- isGitRepo+ isPkgGit <- isPkgGitRepo (patches,srcs) <- partitionEithers . map sourceFieldFile <$> cmdLines "spectool" ["-a", spec] forM_ srcs $ \ src -> do@@ -356,7 +361,7 @@ then maybeSourceDir createLink msrcdir src else do uploaded <-- if gitDir then do+ if isPkgGit then do have_sources <- doesFileExist "sources" if have_sources then grep_ src "sources"@@ -407,7 +412,12 @@ ".zstd" -> Just "zstd" _ -> Nothing of- Just prog -> cmdBool prog ["-t", file]+ Just prog -> do+ have <- findExecutable prog+ when (isNothing have) $ do+ putStrLn $ "Running 'dnf install' " ++ prog+ cmd_ "/usr/bin/sudo" $ "/usr/bin/dnf":"install": ["--assumeyes", prog]+ cmdBool prog ["-t", file] Nothing -> return True maybeSourceDir :: (FilePath -> FilePath -> IO ())@@ -686,11 +696,8 @@ builtRpms :: AnyBranch -> FilePath -> IO [FilePath] builtRpms br spec = do dist <- getBranchDist br- rpmdir <- do- pkggit <- isPkgGitRepo- if pkggit- then return ""- else fromMaybe "" <$> rpmEval "%{_rpmdir}"+ -- previously was "" for pkggit+ rpmdir <- fromMaybe "" <$> rpmEval "%{_rpmdir}" rpms <- rpmspec ["--builtrpms", "--define", "dist " ++ rpmDistTag dist] (Just (rpmdir </> "%{arch}/%{name}-%{version}-%{release}.%{arch}.rpm")) spec if null rpms then error' $ spec ++ " does not seem to create any rpms"@@ -748,6 +755,8 @@ "--enablerepo=updates", "--releasever=" ++ branchVersion br] EPEL _ -> ["--disablerepo=*", "--enablerepo=epel",+ "--releasever=" ++ branchVersion br]+ EPELNext _ -> ["--disablerepo=*", "--enablerepo=epel-next", "--releasever=" ++ branchVersion br] cmd "dnf" (["repoquery", "--quiet"] ++ brOpts ++ args)