fbrnch 1.1.1 → 1.1.2

raw patch · 36 files changed

+704/−398 lines, 36 filesdep +unordered-containersdep ~rpmbuild-orderdep ~simple-cmd

Dependencies added: unordered-containers

Dependency ranges changed: rpmbuild-order, simple-cmd

Files

• CHANGELOG.md +35/−3
• README.md +85/−66
• fbrnch.cabal +5/−4
• src/Bodhi.hs +67/−2
• src/Branches.hs +9/−9
• src/Bugzilla.hs +1/−1
• src/Cmd/Build.hs +16/−73
• src/Cmd/Bump.hs +1/−1
• src/Cmd/Commit.hs +14/−7
• src/Cmd/Compare.hs +38/−0
• src/Cmd/Copr.hs +1/−0
• src/Cmd/Diff.hs +1/−1
• src/Cmd/Import.hs +1/−1
• src/Cmd/Install.hs +9/−7
• src/Cmd/Local.hs +5/−5
• src/Cmd/Log.hs +0/−33
• src/Cmd/Merge.hs +10/−9
• src/Cmd/Override.hs +3/−3
• src/Cmd/Parallel.hs +91/−51
• src/Cmd/PkgReview.hs +2/−2
• src/Cmd/PullPush.hs +29/−9
• src/Cmd/RequestBranch.hs +34/−4
• src/Cmd/RequestRepo.hs +1/−1
• src/Cmd/Scratch.hs +71/−39
• src/Cmd/Sort.hs +1/−1
• src/Cmd/Status.hs +1/−1
• src/Cmd/Switch.hs +1/−1
• src/Cmd/Update.hs +1/−1
• src/Cmd/WaitRepo.hs +17/−5
• src/Git.hs +40/−5
• src/InterleaveOutput.hs +1/−0
• src/Koji.hs +7/−3
• src/ListReviews.hs +1/−1
• src/Main.hs +39/−9
• src/Package.hs +65/−39
• src/Pagure.hs +1/−1

@@ -1,5 +1,40 @@ # Changelog +## 1.1.2 (2022-07-30)+- add scratch-x86_64 and scratch-aarch64 shortcut commands+- bodhiUpdate now takes multiple builds: used for parallelBranches (#30)+- build: add --allow-dirty+- commit: add all if nothing staged; remove initial "- "+- commit: default to changelog even if multiline+- compare: check branch exists and only print package if log output+- create-review: Fix for different username/fasid (@LyesSaadi, #34)+- install: abort if installation failed+- install: print already installed packages on separate lines+- kojiWaitRepo: add quiet arg for many parallel builds+- listReviewsAll: use bz api key+- merge: do not error if target branch does not exist+- parallel: create changelog for parallel package builds+- parallel: now takes same merge opts as build (#30)+- parallel: timeIO layers and parallel packages+- parallel: use branch to determine autoupdate or prompt for update edit+- pull: switch to given branch, add --no-fetch, show header when several pkgs+- rename Log to Compare and logCmd to compareCmd+- rename withPackageByBranches to withPackagesByBranches with HeaderShow & count+- request-branches: check user in access_users to avoid bad requests+- request-branches: print package for existing branch+- scratch: add --stagger to stagger archs+- scratch: only check pushed if release branch+- use rpmbuild-order-0.4.8 (needs simple-cmd-0.2.3)+- waitrepo: --allow-dirty and --no-fetch+- waitrepo: use timeIO to time the operation+- Branches getRequestedBranches: exclude existing branches+- Git gitMergeable: only check newer branch if local+- Git gitMergeable: warn if branch ahead of newer branch+- Package buildRPMs: also create build.log for silent build+- Package buildRPMs: log start of build also for verbose+- Package withPackagesByBranches: mention pkg name when spec names differs+- Parallel bodhiSidetagUpdate: revert to edit update and then delete sidetag+ ## 1.1.1 (2022-05-30) - copr: time builds - commit: fix getting log from additional changelog message@@ -9,9 +44,6 @@ - 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'

@@ -30,64 +30,6 @@  ## Usage -### Creating new packages/branches--#### Creating a new package-```-$ fbrnch create-review [my-new-package]-```-This will create (or update) an srpm, run rpmlint,-then upload it to fedorapeople, perform a scratch build,-and open a Review Request in Bugzilla (similar to fedora-create-review).--#### Update a package review-```-$ fbrnch update-review [my-new-package]-```-Similar to create-review: it uploads the updated files to fedorapeople-and posts the updated package urls to the open package review.--#### List open package reviews-To list one's open package reviews:-```-$ fbrnch reviews-```-They can be filtered by status with various options like-`--approved` or `--created`.--One can also search for the review(s) of a specific package with:-```-$ fbrnch find-review package-name-```--#### Request repos-Once a review has been approved-```-$ fbrnch request-repos-```-will request repos for approved package(s) and offer to request branches.--#### Import a new package-After the repo has been created-```-$ fbrnch import-```-will clone the repo and offer to import the srpm-directly from the latest url in the approved package review,-which can then be built directly into Koji Rawhide-and the package review is updated.--#### Request branches-If you prefer you can request branches after the repo is created-or package imported with-```-$ fbrnch request-branches-```-which will be prompt for which branches you want, unless already given.--Optionally a mock build per branch can be done first.-- ### Cloning and switching branch Clone one or more packages: ```@@ -137,6 +79,15 @@ ```  ### Commit, Merging and Building in Koji+The update command helps with updating a package after editing the spec file+to a newer version:+```+$ fbrnch update+```+which will download the new tarball and upload it, etc.++The `bump` command can be used to increase the release field for packages.+ You can commit to the current branch: ``` $ fbrnch commit@@ -157,7 +108,8 @@ then push and build it.  If the branch is also already pushed and NVR built it will be skipped.-Branch builds are pushed to Bodhi.+If the NVR is currently building it will be picked up by `fbrnch build`.+Completed branch builds can be pushed to Bodhi.  You can also build all branches: ```@@ -178,6 +130,8 @@ ``` optionally a different koji `--target` can be given. +There are arch short-cut aliases: `scratch-x86_64` and `scratch-aarch64`.+ You can sort packages by build dependency order: ``` $ fbrnch sort rawhide package1 package2 package3 package4 ...@@ -210,7 +164,7 @@  Use ```-$ fbrnch rename-master [package]+$ fbrnch rename-rawhide [package] ``` to rename an old master branch locally to rawhide. @@ -223,18 +177,81 @@ $ fbrnch parallel --sidetag rawhide pkg-x pkg-y pkg-z pkg-xy pkg-xy-z ``` generates a sidetag and builds a list of packages there-in parallel ordered by build dependencies.+in parallel ordered by build dependencies. When building for a branch+merging from newer branch will be offered unless using `--no-merge`. -Except for rawhide using a sidetag is required,-so you need to manage and select them-if using more than one per branch with `--target`.+Except for rawhide using a sidetag is required.+If you have more than one branch sidetag, you can select one using `--target`. +After parallel building you can create a Bodhi update from the sidetag.++It is also possible to build a package in parallel across branches+and push to Bodhi.++### Creating new packages/branches++#### Creating a new package+```+$ fbrnch create-review [my-new-package]+```+This will create (or update) an srpm, run rpmlint,+then upload it to fedorapeople, perform a scratch build,+and open a Review Request in Bugzilla (similar to fedora-create-review).++#### Update a package review+```+$ fbrnch update-review [my-new-package]+```+Similar to create-review: it uploads the updated files to fedorapeople+and posts the updated package urls to the open package review.++#### List open package reviews+To list one's open package reviews:+```+$ fbrnch reviews+```+They can be filtered by status with various options like+`--approved` or `--created`.++One can also search for the review(s) of a specific package with:+```+$ fbrnch find-review package-name+```++#### Request repos+Once a review has been approved+```+$ fbrnch request-repos+```+will request repos for approved package(s) and offer to request branches.++#### Import a new package+After the repo has been created+```+$ fbrnch import+```+will clone the repo and offer to import the srpm+directly from the latest url in the approved package review,+which can then be built directly into Koji Rawhide+and the package review is updated.++#### Request branches+If you prefer you can request branches after the repo is created+or package imported with+```+$ fbrnch request-branches+```+which will be prompt for which branches you want, unless already given.++Optionally a mock build per branch can be done first.++ ### Other commands-There are more commands like `copr` and `graph`.+There are a lot more commands, like eg `copr` and `graph`:  ``` $ fbrnch --version-1.1.1+1.1.2 $ fbrnch --help Fedora branch building tool @@ -260,6 +277,8 @@   override                 Tag builds into buildroot override in Koji   waitrepo                 Wait for build to appear in Koji buildroot   scratch                  Scratch build package in Koji+  scratch-aarch64          Koji aarch64 scratch build of package+  scratch-x86_64           Koji x86_64 scratch build of package   update                   Update package in dist-git to newer version   sort                     Sort packages in build dependency order   prep                     Prep sources

@@ -1,6 +1,6 @@ cabal-version:       2.0 name:                fbrnch-version:             1.1.1+version:             1.1.2 synopsis:            Fedora packager tool to build package branches description:             fbrnch (fedora branch) is a convenient packaging tool for@@ -50,6 +50,7 @@                        Cmd.Bump                        Cmd.Clone                        Cmd.Commit+                       Cmd.Compare                        Cmd.Copr                        Cmd.Diff                        Cmd.FTBFS@@ -58,7 +59,6 @@                        Cmd.ListBranches                        Cmd.ListPackages                        Cmd.Local-                       Cmd.Log                        Cmd.Merge                        Cmd.Mock                        Cmd.Override@@ -120,13 +120,14 @@                        pretty-terminal,                        process,                        -- regex-tdfa,-                       rpmbuild-order >= 0.4.5,+                       rpmbuild-order >= 0.4.8,                        rpm-nvr >= 0.1.2,-                       simple-cmd >= 0.2.0,+                       simple-cmd >= 0.2.3,                        simple-cmd-args >= 0.1.6,                        text,                        time,                        typed-process >= 0.2.4.0,+                       unordered-containers,                        utf8-string,                        unix,                        xdg-basedir

@@ -5,7 +5,8 @@   bodhiTestingRepo,   checkAutoBodhiUpdate,   UpdateType(..),-  UpdateSeverity(..)+  UpdateSeverity(..),+  bodhiUpdate   ) where @@ -13,16 +14,18 @@ import Data.Aeson.Key (fromText) #endif import Data.Aeson.Types (Object, (.:), parseEither)+import Data.Char (isDigit) import Fedora.Bodhi hiding (bodhiUpdate) import Text.Read import qualified Text.ParserCombinators.ReadP as R import qualified Text.ParserCombinators.ReadPrec as RP - import Branches+import Bugzilla (BugId) import Common import Common.System import qualified Common.Text as T+import Package import Prompt  checkAutoBodhiUpdate :: Branch -> IO Bool@@ -117,3 +120,65 @@   return $ case lookupKey "testing_repository" obj :: Maybe String of              Nothing -> Nothing              Just _ -> lookupKey' "testing_tag" obj++bodhiUpdate :: Bool -> (Maybe UpdateType, UpdateSeverity) -> Maybe BugId+            -> Bool -> FilePath -> [String] -> IO ()+bodhiUpdate _ _ _ _ _ [] = error' "cannot make empty update"+bodhiUpdate dryrun (mupdate,severity) mreview usechangelog spec nvrs = do+  case mupdate of+    Nothing -> return ()+    Just updateType -> do+      unless dryrun $ do+        -- use cmdLog to debug, but notes are not quoted+        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 usechangelog+                              then cleanChangelog spec+                              else+                                -- FIXME list open bugs+                                changeLogPrompt (Just "update") spec+            if trim (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 " ++ unwords nvrs ++ ":"+              -- 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 ++ nvrs)+              return True+        when updatedone $ do+          -- FIXME avoid this if we know the update URL+          case head nvrs of+            nvr -> do+              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 (mupdate,severity) mreview usechangelog spec nvrs+                [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+  where+    extractBugReferences :: String -> [String]+    extractBugReferences clog =+      case dropWhile (/= '#') clog of+        "" -> []+        rest ->+          case span isDigit (tail rest) of+            (ds,more) ->+              -- make sure is contemporary 7-digit bug+              (if length ds > 6 then (ds :) else id) $+              extractBugReferences more

@@ -220,23 +220,23 @@ branchVersion (EPEL n) = show n branchVersion (EPELNext n) = show n -getRequestedBranches :: BranchesReq -> IO [Branch]-getRequestedBranches breq = do-  active <- getFedoraBranched+getRequestedBranches :: [String] -> BranchesReq -> IO [Branch]+getRequestedBranches existing breq = do+  activenew <- filter (\b -> show b `notElem` existing) <$> getFedoraBranched   case breq of     Branches brs -> if null brs-                    then branchingPrompt active+                    then branchingPrompt activenew                     else return brs     BranchOpt request -> do       let requested = case request of-                        AllBranches -> active-                        AllFedora -> filter isFedoraBranch active-                        AllEPEL -> filter isEPELBranch active-                        ExcludeBranches xbrs -> active \\ xbrs+                        AllBranches -> activenew+                        AllFedora -> filter isFedoraBranch activenew+                        AllEPEL -> filter isEPELBranch activenew+                        ExcludeBranches xbrs -> activenew \\ xbrs       inp <- prompt $ "Confirm branches request [" ++ unwords (map show requested) ++ "]"       return $ if null inp                then requested-               else map (readActiveBranch' active) $ words inp+               else map (readActiveBranch' activenew) $ words inp   where     branchingPrompt :: [Branch] -> IO [Branch]     branchingPrompt active = do

@@ -22,7 +22,7 @@   pkgBugs,   pkgReviews,   pkgReviewsPrefix,-  listBzUsers,+  -- listBzUsers,   emailIsValid, --  testBZlogin,   -- search

@@ -2,15 +2,12 @@  module Cmd.Build (   buildCmd,-  BuildOpts(..),+  BuildOpts(..)   ) where  import Common import Common.System -import Data.Char (isDigit)-import Fedora.Bodhi hiding (bodhiUpdate)- import Bodhi import Bugzilla import Branches@@ -28,10 +25,11 @@   , buildoptOverride :: Maybe Int   , buildoptWaitrepo :: Maybe Bool   , buildoptDryrun :: Bool-  , buildSkipFetch :: Bool+  , buildoptSkipFetch :: Bool   , buildoptUpdate :: (Maybe UpdateType, UpdateSeverity)   , buildoptUseChangelog :: Bool   , buildoptByPackage :: Bool+  , buildoptAllowDirty :: Bool   }  -- FIXME check bugs before building?@@ -45,7 +43,7 @@ -- FIXME --auto-override for deps in testing -- FIXME -B fails to find new branches (fixed?) -- FIXME disallow override for autoupdate?--- FIXME count remaining packages+-- FIXME --yes buildCmd :: BuildOpts -> (BranchesReq, [String]) -> IO () buildCmd opts (breq, pkgs) = do   let singleBrnch = if isJust (buildoptTarget opts)@@ -54,15 +52,17 @@       mlastOfPkgs = if length pkgs > 1                     then Just (Package (last pkgs))                     else Nothing-      gitopts =-        if buildSkipFetch opts then cleanGitActive else cleanGitFetchActive+      gitopts+        | buildoptAllowDirty opts = dirtyGitActive+        | buildoptSkipFetch opts = cleanGitActive+        | otherwise = cleanGitFetchActive   if not (buildoptByPackage opts) && breq /= Branches [] && length pkgs > 1     then do     brs <- listOfBranches True True breq     forM_ brs $ \br ->-      withPackageByBranches (Just False) gitopts singleBrnch (buildBranch mlastOfPkgs opts) (Branches [br], pkgs)+      withPackagesByBranches HeaderMay True gitopts singleBrnch (buildBranch mlastOfPkgs opts) (Branches [br], pkgs)     else-    withPackageByBranches (Just False) gitopts singleBrnch (buildBranch mlastOfPkgs opts) (breq, pkgs)+    withPackagesByBranches HeaderMay True gitopts singleBrnch (buildBranch mlastOfPkgs opts) (breq, pkgs)  -- FIXME what if untracked files buildBranch :: Maybe Package -> BuildOpts -> Package -> AnyBranch -> IO ()@@ -129,14 +129,14 @@         unless autoupdate $ do           unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-updates-pending", show br ++ "-updates-testing", show br ++ "-updates-testing-pending"]) $ do             mbug <- bzReviewAnon-            bodhiUpdate dryrun mbug spec nvr+            bodhiUpdate dryrun (buildoptUpdate opts) mbug (buildoptUseChangelog opts) spec [nvr]           unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $             whenJust moverride $ \days ->             bodhiCreateOverride dryrun (Just days) nvr         when (isJust mlastpkg && mlastpkg /= Just pkg || mwaitrepo == Just True) $           when ((isJust moverride && mwaitrepo /= Just False) ||                 (autoupdate && mwaitrepo == Just True)) $-            kojiWaitRepo dryrun target nvr+            kojiWaitRepo dryrun True target nvr     Just BuildBuilding -> do       putStrLn $ nvr ++ " is already building"       when (isJust mpush) $@@ -184,7 +184,8 @@             unlessM (null <$> gitShortLog ("origin/" ++ show br ++ "..HEAD")) $               when (mpush == Just Nothing && not dryrun) $               error' "Unpushed changes remain"-            unlessM isGitDirClean $+            unless (buildoptAllowDirty opts) $+              unlessM isGitDirClean $               error' "local changes remain (dirty)"             -- FIXME parse build output             unless dryrun $@@ -202,69 +203,11 @@                 whenJust (fmap fst mBugSess) $                   \bid -> putStr "review bug: " >> putBugId bid                 -- FIXME diff previous changelog?-                bodhiUpdate dryrun (fmap fst mBugSess) spec nvr+                bodhiUpdate dryrun (buildoptUpdate opts) (fmap fst mBugSess) (buildoptUseChangelog opts) spec [nvr]                 -- FIXME prompt for override note                 whenJust moverride $ \days ->                   bodhiCreateOverride dryrun (Just days) nvr             when (isJust mlastpkg && mlastpkg /= Just pkg || mwaitrepo == Just True) $               when ((isJust moverride && mwaitrepo /= Just False) ||                     (autoupdate && mwaitrepo == Just True)) $-              kojiWaitRepo dryrun target nvr-  where-    bodhiUpdate :: Bool -> Maybe BugId -> FilePath -> String -> IO ()-    bodhiUpdate dryrun mreview spec nvr = do-      case buildoptUpdate opts of-        (Nothing, _) -> return ()-        (Just updateType, severity) -> do-          unless dryrun $ do-            -- use cmdLog to debug, but notes are not quoted-            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 =-      case dropWhile (/= '#') clog of-        "" -> []-        rest ->-          case span isDigit (tail rest) of-            (ds,more) ->-              -- make sure is contemporary 7-digit bug-              (if length ds > 6 then (ds :) else id) $-              extractBugReferences more+              kojiWaitRepo dryrun True target nvr

@@ -17,7 +17,7 @@ -- FIXME detect rpmautospec and add empty commit bumpPkgs :: Bool -> Maybe CommitOpt -> (BranchesReq,[String]) -> IO () bumpPkgs local mopt =-  withPackageByBranches (Just local) (if local then cleanGit else cleanGitFetchActive)+  withPackagesByBranches (boolHeader local) False (if local then cleanGit else cleanGitFetchActive)   AnyNumber bumpPkg   where     bumpPkg :: Package -> AnyBranch -> IO ()

@@ -13,19 +13,24 @@ -- FIXME use branches after all? -- FIXME handle multiline changelog entries with "-m description" -- FIXME --undo last change: eg undo accidential --amend+-- FIXME for single package assume --all if no stage commitPkgs :: Maybe CommitOpt -> Bool -> Bool -> [String] -> IO ()-commitPkgs mopt firstLine notstaged args = do+commitPkgs mopt firstLine unstaged paths = do   when (isJust mopt && firstLine) $     error' "--first-line cannot be used with other commit msg options"-  if null args+  if null paths     then commitPkg "."-    else mapM_ commitPkg args+    else mapM_ commitPkg paths   where     commitPkg :: FilePath -> IO ()     commitPkg path =       withExistingDirectory path $         unlessM isGitDirClean $ do           getPackageName path >>= putPkgHdr+          addall <-+            if null paths+            then null <$> git "diff" ["--cached"]+            else return unstaged           opts <- case mopt of             Just opt -> return $               case opt of@@ -43,15 +48,17 @@                     if firstLine                     then return $ removePrefix "- " $ head msgs                     else do-                      diff <- git "diff" ["-U0", "HEAD"]+                      diff <- git "diff" ["-U0", if addall then "HEAD" else "--cached"]                       let newlogs =                             filter (\c -> ('+' : c) `elem` lines diff) clog                       case newlogs of                         [] -> putStrLn diff >> readCommitMsg-                        [msg] -> return (removePrefix "- " msg)-                        _ -> mapM_ putStrLn newlogs >> readCommitMsg+                        [msg] -> putStrLn msg >>+                                 return (removePrefix "- " msg)+                        (m:ms) -> mapM_ putStrLn newlogs >>+                                  return (unlines (removePrefix "- " m:"":ms))               return ["-m", changelog]-          git_ "commit" $ ["-a" | notstaged] ++ opts+          git_ "commit" $ ["-a" | addall] ++ opts  readCommitMsg :: IO String readCommitMsg = do

@@ -0,0 +1,38 @@+module Cmd.Compare (+  compareCmd)+where++import Branches+import Common+import Common.System+import Git+import Package++compareCmd :: Bool -> AnyBranch -> AnyBranch -> [String] -> IO ()+compareCmd long br1 br2 pkgs = do+  if null pkgs+    then do+    unlessM isPkgGitRepo $+      error' "Please specify at least one package"+    else do+    whenM isPkgGitRepo $+      error' "Cannot specify multiple packages inside a package dir"+  let packages = if null pkgs then ["."] else pkgs+  mapM_ comparePkg packages+  where+    comparePkg :: String -> IO ()+    comparePkg pkgdir =+      withExistingDirectory pkgdir $+      unlessM (doesFileExist "dead.package") $ do+      let (br1',br2') =+            case (br1, br2) of+              (RelBranch b1, RelBranch b2) | b2 < b1 -> (br2,br1)+              _ -> (br1,br2)+      localbranches <- gitLines "branch" ["--format=%(refname:short)"]+      forM_ [br1',br2'] $ \br ->+        unless (show br `elem` localbranches) $ gitSwitchBranch br+      output <- git "log" $ ["--format=reference" | not long] ++ [show br1' ++ ".." ++ show br2']+      unless (null output) $ do+        unless (null pkgs) $+          getPackageName pkgdir >>= putPkgHdr+        putStrLn output

@@ -27,6 +27,7 @@ coprServer :: String coprServer = "copr.fedorainfracloud.org" +-- FIXME handle fedora-eln -- FIXME make project optional (if same as pkg??) or configurable ? -- FIXME repo config with a setup command? -- FIXME interact with copr dist-git

@@ -29,7 +29,7 @@ diffCmd :: Bool -> DiffWork -> DiffFormat -> Bool -> Maybe DiffFilter -> Maybe AnyBranch         -> (Maybe Branch,[String]) -> IO () diffCmd speconly work fmt quiet mpatt mwbr =-  withPackagesMaybeBranch Nothing dirtyGit ZeroOrOne diffPkg+  withPackagesMaybeBranch HeaderNone False dirtyGit ZeroOrOne diffPkg   where     diffPkg :: Package -> AnyBranch -> IO ()     diffPkg pkg br = do

@@ -76,7 +76,7 @@         putBugBuild False session bid nvr         existing <- fedoraBranchesNoRawhide (localBranches False)         when (null existing) $ do-          brs <- getRequestedBranches breq+          brs <- getRequestedBranches [] breq           requestPkgBranches False mock (Branches brs) (Package pkg)       when (pkg /= takeFileName dir) $         setCurrentDirectory dir

@@ -22,9 +22,7 @@ installCmd verbose recurse mforceshort bconds reinstall (mbr, pkgs) = do   when (recurse && mforceshort == Just ShortCircuit) $     error' "cannot use --recurse and --shortcircuit"-  when (length pkgs > 3) $-    putStrLn $ show (length pkgs) ++ " packages"-  withPackagesMaybeBranch (Just (length pkgs > 1)) Nothing ZeroOrOne installPkg (mbr, pkgs)+  withPackagesMaybeBranch (boolHeader (length pkgs > 1)) True Nothing ZeroOrOne installPkg (mbr, pkgs)   where     installPkg :: Package -> AnyBranch -> IO ()     installPkg pkg br = do@@ -36,7 +34,8 @@       installed <- filterM rpmInstalled packages       if isJust mforceshort || null installed || reinstall         then doInstallPkg mforceshort spec rpms installed-        else putStrLn $ unwords (map showNVRA installed) ++ " already installed!\n"+        else putStrLn $ unlines (map showNVRA installed) +++             "\nalready installed!\n"       where         doInstallPkg mforceshort' spec rpms installed = do           putStrLn $ (showNVR . dropArch . readNVRA . takeFileName) (head rpms)@@ -66,9 +65,12 @@                 sudo_ "/usr/bin/dnf" $ "install" : "-q" : "-y" : remaining             else do               ok <- cmdBool "sudo" $ "/usr/bin/dnf" : "install" : "-q" : "-y" : filterDebug rpms-              unless (ok || wasbuilt) $ do-                prompt_ "Press Enter to rebuild package"-                doInstallPkg (Just ForceBuild) spec rpms installed+              unless ok $+                if wasbuilt+                then error' "build failed to install"+                else do+                  prompt_ "Press Enter to rebuild package"+                  doInstallPkg (Just ForceBuild) spec rpms installed          lookForPkgDir :: Branch -> FilePath -> String -> IO (Maybe FilePath)         lookForPkgDir rbr topdir p = do

@@ -23,7 +23,7 @@ localCmd :: Bool -> Maybe ForceShort -> [BCond] -> (BranchesReq, [String])          -> IO () localCmd quiet mforceshort bconds =-  withPackageByBranches Nothing Nothing ZeroOrOne localBuildPkg+  withPackagesByBranches HeaderNone False Nothing ZeroOrOne localBuildPkg   where     localBuildPkg :: Package -> AnyBranch -> IO ()     localBuildPkg pkg br = do@@ -35,7 +35,7 @@  installDepsCmd :: (Maybe Branch,[String]) -> IO () installDepsCmd =-  withPackagesMaybeBranch Nothing Nothing ZeroOrOne installDepsPkg+  withPackagesMaybeBranch HeaderNone False Nothing ZeroOrOne installDepsPkg   where     installDepsPkg :: Package -> AnyBranch -> IO ()     installDepsPkg pkg br =@@ -52,7 +52,7 @@  nvrCmd :: (BranchesReq, [String]) -> IO () nvrCmd =-  withPackageByBranches Nothing Nothing AnyNumber nvrBranch+  withPackagesByBranches HeaderNone False Nothing AnyNumber nvrBranch   where     nvrBranch :: Package -> AnyBranch -> IO ()     nvrBranch pkg br = do@@ -69,7 +69,7 @@ commandCmd :: Bool -> Bool -> Bool -> String -> (BranchesReq,[String])            -> IO () commandCmd ifoutput compact continue cs =-  withPackageByBranches (Just (not ifoutput)) Nothing AnyNumber cmdBranch+  withPackagesByBranches (boolHeader (not ifoutput)) False Nothing AnyNumber cmdBranch   where     cmdBranch :: Package -> AnyBranch -> IO ()     cmdBranch pkg br =@@ -95,7 +95,7 @@  renameMasterCmd :: [String] -> IO () renameMasterCmd pkgs =-  withPackageByBranches (Just False) dirtyGit Zero renameMasterBranch (Branches [], pkgs)+  withPackagesByBranches HeaderMay False dirtyGit Zero renameMasterBranch (Branches [], pkgs)   where   renameMasterBranch :: Package -> AnyBranch -> IO ()   renameMasterBranch _pkg _br = do

@@ -1,33 +0,0 @@-module Cmd.Log (-  logCmd)-where--import Branches-import Common-import Common.System-import Git-import Package--logCmd :: Bool -> AnyBranch -> AnyBranch -> [String] -> IO ()-logCmd long br1 br2 pkgs = do-  if null pkgs-    then do-      unlessM isPkgGitRepo $-        error' "Please specify at least one package"-    else do-      whenM isPkgGitRepo $-        error' "Cannot specify multiple packages inside a package dir"-  let packages = if null pkgs then ["."] else pkgs-  mapM_ logPkg packages-  where-    logPkg :: String -> IO ()-    logPkg pkgdir =-      withExistingDirectory pkgdir $ do-      unless (null pkgs) $-        getPackageName pkgdir >>= putPkgHdr-      let (br1',br2') =-            case (br1, br2) of-              (RelBranch b1, RelBranch b2) | b2 < b1 -> (br2,br1)-              _ -> (br1,br2)-        in-        git_ "log" $ ["--format=reference" | not long] ++ [show br1' ++ ".." ++ show br2']

@@ -14,19 +14,20 @@  mergeCmd :: Bool -> Maybe Branch -> (BranchesReq,[String]) -> IO () mergeCmd noprompt mfrom =-  withPackageByBranches (Just False) cleanGitFetchActive AnyNumber runMergeBranch+  withPackagesByBranches HeaderMay False cleanGitFetchActive AnyNumber runMergeBranch   where     runMergeBranch :: Package -> AnyBranch -> IO ()     runMergeBranch _ (OtherBranch _) =       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 from br-      mergeBranch False noprompt unmerged from br+    runMergeBranch _pkg (RelBranch br) = do+      exists <- gitSwitchBranch' br+      when exists $ do+        from <- maybe (getNewerBranch br) return mfrom+        when (from == br) $+          error' "cannot merge branch to itself"+        gitMergeOrigin br+        unmerged <- mergeable from br+        mergeBranch False noprompt unmerged from br  -- FIXME maybe require local branch already here mergeable :: Branch -> Branch -> IO (Bool,[String])

@@ -6,7 +6,7 @@  import Bodhi import Branches-import Cmd.WaitRepo (waitrepoCmd)+import Cmd.WaitRepo (waitrepoCmd, WaitFetch(WaitNoFetch)) import Git import Koji import Package@@ -16,9 +16,9 @@ overrideCmd dryrun mduration nowait breqpkgs = do   unless nowait $     putStrLn "Overriding"-  withPackageByBranches (Just False) cleanGitFetchActive AnyNumber overrideBranch breqpkgs+  withPackagesByBranches HeaderMay False cleanGitFetchActive AnyNumber overrideBranch breqpkgs   unless nowait $-    waitrepoCmd False dryrun Nothing breqpkgs+    waitrepoCmd dryrun WaitNoFetch Nothing breqpkgs   where     overrideBranch :: Package -> AnyBranch -> IO ()     overrideBranch _ (OtherBranch _) =

@@ -10,7 +10,7 @@  import Control.Concurrent.Async import Distribution.RPM.Build.Order (dependencyLayers)-import Fedora.Bodhi+import Fedora.Bodhi hiding (bodhiUpdate) import System.Console.Pretty import System.Time.Extra (sleep) @@ -31,7 +31,7 @@ maybeTarget _ = Nothing  -- (pkg, nvr)-type Job = (String, Async String)+type Job = (String, Async (String,String))  -- FIXME print koji url of failed process or use koji-tool -- FIXME option to build multiple packages over branches in parallel@@ -40,10 +40,10 @@ -- FIXME --single-layer to build packages at once regardless -- FIXME time builds -- FIXME copy bodhi notes from another branch update-parallelBuildCmd :: Bool -> Bool -> Int -> Maybe SideTagTarget+parallelBuildCmd :: Bool -> Maybe Bool -> Int -> Maybe SideTagTarget                  -> (Maybe UpdateType, UpdateSeverity)                  -> (BranchesReq, [String]) -> IO ()-parallelBuildCmd dryrun merge firstlayer msidetagTarget mupdate (breq, pkgs) =+parallelBuildCmd dryrun mmerge firstlayer msidetagTarget mupdate (breq, pkgs) =   do   branches <-     case pkgs of@@ -62,9 +62,9 @@   when (isJust mtarget && length branches > 1) $     error' "You can only specify target with one branch"   case pkgs of-    [] -> parallelBranches branches+    [] -> timeIO $ parallelBranches "." branches     [p] -> withExistingDirectory p $-           parallelBranches branches+           parallelBranches p branches     _ ->       forM_ branches $ \ rbr -> do       forM_ pkgs $ \p ->@@ -77,33 +77,42 @@       when (length branches > 1) $         putStrLn $ "# " ++ show rbr       target <- targetMaybeSidetag rbr-      nvrs <- concatMapM (parallelBuild target rbr)-              $ zip [firstlayer..length allLayers]-              $ init $ tails layers -- tails ends in []+      nvrclogs <- concatMapM (timeIO . 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 nvrs target notes+          let changelog = intercalate "" $ renderChangelogs nvrclogs+          putStrLn ""+          putStrLn changelog+          input <- prompt "Press Enter to use above or input update summary now; or 'no' to skip update"+          unless (trim (lower input) == "no") $+            bodhiSidetagUpdate rbr (map fst nvrclogs) target $+            if null input then changelog else input   where-    parallelBranches :: [Branch] -> IO ()-    parallelBranches brs = do+    parallelBranches :: FilePath -> [Branch] -> IO ()+    parallelBranches pkgdir brs = do       krbTicket       currentbranch <- gitCurrentBranch       putStrLn $ "= Building " ++ pluralException (length brs) "branch" "branches" ++ " in parallel:"       putStrLn $ unwords $ map show brs       jobs <- mapM setupBranch brs-      (failures,_nvrs) <- watchJobs [] [] jobs+      (failures,nvrclogs) <- watchJobs [] [] jobs       -- switch back to the original branch       when (length brs /= 1) $         gitSwitchBranch currentbranch       unless (null failures) $         error' $ "Build failures: " ++ unwords failures+      when (isNothing msidetagTarget) $ do+        pkg <- getPackageName pkgdir+        let spec = packageSpec pkg+        bodhiUpdate dryrun mupdate Nothing False spec $ map fst nvrclogs       where         -- FIXME time jobs         setupBranch :: Branch -> IO Job         setupBranch br = do           target <- targetMaybeSidetag br-          when merge $ mergeNewerBranch (show br) br+          when (mmerge /= Just False) $ mergeNewerBranch (show br) br           job <- startBuild False False target br "." >>= async           unless dryrun $ sleep 3           return (show br,job)@@ -115,10 +124,12 @@       newer <- getNewerBranch br       when (ancestor && not (null unmerged)) $         putStrLn $ "Checking " ++ desc ++ ":"-      mergeBranch True False (ancestor,unmerged) newer br+      mergeBranch True (mmerge == Just True) (ancestor,unmerged) newer br+      putStrLn ""      -- FIXME time builds or layers-    parallelBuild :: String -> Branch -> (Int,[[String]]) -> IO [String]+    parallelBuild :: String -> Branch -> (Int,[[String]])+                  -> IO [(String,String)]     parallelBuild _ _ (_,[]) = return [] -- should not reach here     parallelBuild target br (layernum, layer:nextLayers) =  do       krbTicket@@ -162,23 +173,26 @@           return (pkg,job)      -- (failures,successes)-    watchJobs :: [String] -> [String] -> [Job] -> IO ([String],[String])-    watchJobs fails nvrs [] = return (fails,nvrs)-    watchJobs fails nvrs (job:jobs) = do+    watchJobs :: [String] -> [(String,String)] -> [Job]+              -> IO ([String],[(String,String)])+    watchJobs fails results [] = return (fails,results)+    watchJobs fails results (job:jobs) = do       status <- poll (snd job)       case status of-        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 (nvr:nvrs) jobs+        Nothing -> sleep 1 >> watchJobs fails results (jobs ++ [job])+        -- (nvr,changelog)+        Just (Right result) -> do+          putStrLn $ color Yellow (fst result) ++ " job completed (" ++ show (length jobs) ++ " left in layer)"+          watchJobs fails (result:results) 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) nvrs jobs+          watchJobs (pkg : fails) results jobs      -- FIXME prefix output with package name-    startBuild :: Bool -> Bool -> String -> Branch -> String -> IO (IO String)+    startBuild :: Bool -> Bool -> String -> Branch -> String+               -> IO (IO (String,String))     startBuild morelayers background target br pkgdir =       withExistingDirectory pkgdir $ do       gitSwitchBranch (RelBranch br)@@ -195,6 +209,9 @@           gitPushSilent Nothing       nvr <- pkgNameVerRel' br spec       putStrLn $ nvr ++ " (" ++ target ++ ")"+      changelog <- unlines <$> getChangelog spec+      when (null unpushed) $+        putStrLn changelog       -- FIXME should compare git refs       -- FIXME check for target       buildstatus <- kojiBuildStatus nvr@@ -211,34 +228,42 @@               bodhiCreateOverride dryrun Nothing nvr           return $ do             when morelayers $-              kojiWaitRepo dryrun target nvr-            return nvr+              kojiWaitRepo dryrun background target nvr+            return (nvr,changelog)         Just BuildBuilding -> do           putStrLn $ nvr ++ " is already building"-          return $-            kojiGetBuildTaskID fedoraHub nvr >>=-            maybe (error' $ "Task for " ++ nvr ++ " not found")-            (kojiWaitTaskAndRepo (isNothing mlatest) nvr)+          mtask <- kojiGetBuildTaskID fedoraHub nvr+          case mtask of+            Nothing -> error' $ "Task for " ++ nvr ++ " not found"+            Just task ->+              return $ do+              kojiWaitTaskAndRepo (isNothing mlatest) nvr task+              return (nvr,changelog)         _ -> do           buildref <- git "show-ref" ["--hash", "origin/" ++ show br]           opentasks <- kojiOpenTasks pkg (Just buildref) target           case opentasks of             [task] -> do               putStrLn $ nvr ++ " task is already open"-              return $ kojiWaitTaskAndRepo (isNothing mlatest) nvr task+              return $ do+                kojiWaitTaskAndRepo (isNothing mlatest) nvr task+                return (nvr,changelog)             (_:_) -> error' $ show (length opentasks) ++ " open " ++ unPackage pkg ++ " tasks already"             [] -> do               if equivNVR nvr (fromMaybe "" mlatest)-                then return $ error' $ color Red $ nvr ++ " is already latest (modulo disttag)"+                then return $ error' $+                     color Red $ nvr ++ " is already latest (modulo disttag)"                 else do                 -- FIXME parse build output                 if dryrun-                  then return (return nvr)+                  then return $ return (nvr,"<changelog>")                   else do                   task <- kojiBuildBranchNoWait target pkg Nothing $ "--fail-fast" : ["--background" | background]-                  return $ kojiWaitTaskAndRepo (isNothing mlatest) nvr task+                  return $ do+                    kojiWaitTaskAndRepo (isNothing mlatest) nvr task+                    return (nvr,changelog)       where-        kojiWaitTaskAndRepo :: Bool -> String -> TaskID -> IO String+        kojiWaitTaskAndRepo :: Bool -> String -> TaskID -> IO ()         kojiWaitTaskAndRepo newpkg nvr task = do           finish <- kojiWaitTask task           if finish@@ -258,11 +283,17 @@               -- bodhiUpdate (fmap fst mBugSess) changelog nvr               bodhiCreateOverride dryrun Nothing nvr           when morelayers $-            kojiWaitRepo dryrun target nvr-          return nvr+            kojiWaitRepo dryrun background target nvr -    bodhiSidetagUpdate :: [String] -> String -> String -> IO ()-    bodhiSidetagUpdate nvrs sidetag notes = do+    -- FIXME map nvr to package?+    renderChangelogs :: [(String,String)] -> [String]+    renderChangelogs [] = []+    renderChangelogs ((nvr,clog):nvrclogs) =+      unlines [nvr, "", clog] : renderChangelogs nvrclogs++    -- FIXME how to catch authentication errors?+    bodhiSidetagUpdate :: Branch -> [String] -> String -> String -> IO ()+    bodhiSidetagUpdate rbr nvrs sidetag notes = do       case mupdate of         (Nothing, _) -> return ()         (Just updateType, severity) -> do@@ -273,26 +304,34 @@               putStrLn "Paste update template now:"               template <- getContents               cmdBool "bodhi" ["updates", "new", "--file", template, "--from-tag", sidetag]+              -- perhaps testing works now? (though seems there is a delay at least)             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_ "Press Enter to remove the sidetag"+          if not ok+            then bodhiSidetagUpdate rbr nvrs sidetag notes+            else+            unlessM (checkAutoBodhiUpdate rbr) $ do+            prompt_ "After editing the update, 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+              -- command, but we query it here via nvr+            -- prompt_ "Press Enter to edit update just to unlock it from sidetag"             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+                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-                    -- 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"+                  Just _updateid -> return ()+                    -- -- disconnect the update from the sidetag+                    -- -- so it can be changed after sidetag closed+                    -- -- see https://github.com/fedora-infra/bodhi/issues/4563 for the auto options+                    -- fails with: {"status": "error", "errors": [{"location": "body", "name": "from_tag", "description": "The supplied from_tag doesn't exist."}, {"location": "body", "name": "builds", "description": "ACL validation mechanism was unable to determine ACLs."}]}+                    -- cmd_ "bodhi" ["updates", "edit", updateid,+                    --               "--request", "testing"] -- was "--autokarma", "--autotime"+                    -- putStrLn "Update edited to unlock from sidetag"               _ -> error' $ "impossible happened: more than one update found for " ++ last nvrs      targetMaybeSidetag :: Branch -> IO String@@ -311,6 +350,7 @@                 putStrLn out                 let sidetag =                       init . dropWhileEnd (/= '\'') $ dropPrefix "Side tag '" out+                putStrLn $ "waiting for " ++ sidetag ++ " repo"                 cmd_ "koji" ["wait-repo", sidetag]                 return sidetag                 else error' "'fedpkg request-side-tag' failed"

@@ -27,7 +27,7 @@ -- FIXME add --dependent pkgreview createReview :: ScratchOption -> Bool -> [FilePath] -> IO () createReview scratchOpt mock pkgs =-  withPackageByBranches (Just True) Nothing Zero createPkgReview (Branches [], pkgs)+  withPackagesByBranches HeaderMust False Nothing Zero createPkgReview (Branches [], pkgs)   where     createPkgReview :: Package -> AnyBranch -> IO ()     createPkgReview package _br = do@@ -98,7 +98,7 @@   let sshhost = "fedorapeople.org"       sshpath = "public_html/reviews/" ++ pkg   cmd_ "ssh" [fasid ++ "@" ++ sshhost, "mkdir", "-p", sshpath]-  cmd_ "scp" [spec, srpm, sshhost ++ ":" ++ sshpath]+  cmd_ "scp" [spec, srpm, fasid ++ "@" ++ sshhost ++ ":" ++ sshpath]   getCheckedFileUrls $ "https://" <> fasid <> ".fedorapeople.org" +/+ removePrefix "public_html/" sshpath   where     getCheckedFileUrls :: String -> IO String

@@ -1,18 +1,35 @@-module Cmd.PullPush (pullPkgs, pushPkgs) where+module Cmd.PullPush (+  pullPkgs,+  PullOpts(..),+  pushPkgs)+where  import Branches+import Common import Git import Package +data PullOpts =+  PullOpts { pullLenient :: Bool+           , pullNoFetch :: Bool}+ -- FIXME pulling more than one branch -- FIXME print nvr after pulling or old -> new-pullPkgs :: Bool -> (BranchesReq, [String]) -> IO ()-pullPkgs lenient =-  withPackageByBranches (Just False) (if lenient then Nothing else cleanGitFetch) AnyNumber pullPkg+pullPkgs :: 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)+  AnyNumber pullPkg (breq,args)   where     pullPkg :: Package -> AnyBranch -> IO ()-    pullPkg pkg _br =-      if lenient+    pullPkg pkg br =+      if pullLenient pullopts       then do         haveGit <- isPkgGitRepo         if haveGit@@ -21,12 +38,15 @@       else doPullPkg       where         doPullPkg :: IO ()-        doPullPkg =-          getReleaseBranchWarn >>= gitMergeOrigin+        doPullPkg = do+          current <- getReleaseBranchWarn+          unless (breq == Branches [] || RelBranch current == br) $+            gitSwitchBranch br+          gitMergeOrigin current  pushPkgs :: (BranchesReq, [String]) -> IO () pushPkgs =-  withPackageByBranches (Just False) cleanGitFetch AnyNumber pushPkg+  withPackagesByBranches HeaderMay False cleanGitFetch AnyNumber pushPkg   where     pushPkg :: Package -> AnyBranch -> IO ()     pushPkg _pkg _br = do

@@ -1,8 +1,18 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+ module Cmd.RequestBranch (   requestBranches,   requestPkgBranches   ) where +#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap as M+#else+import qualified Data.HashMap.Lazy as M+import Data.Text (Text)+#endif+import Network.HTTP.Query (lookupKey')+ import Common import Common.System @@ -33,17 +43,28 @@  requestPkgBranches :: Bool -> Bool -> BranchesReq -> Package -> IO () requestPkgBranches multiple mock breq pkg = do+  -- check have access+  fasid <- fasIdFromKrb+  epkginfo <- pagureProjectInfo srcfpo ("rpms" </> unPackage pkg)+  case epkginfo of+    Left err -> error' err+    Right pkginfo ->+      -- FIXME exclude unprivileged roles+      unless (fasid `elem` concat+              (lookupKeyElems "access_users" pkginfo)) $+      error' $ fasid ++ " does not have access to " ++ unPackage pkg   when (breq == Branches []) $     putPkgHdr pkg   git_ "fetch" []-  branches <- getRequestedBranches breq+  brs <- localBranches False+  branches <- getRequestedBranches brs breq   newbranches <- filterExistingBranchRequests branches   unless (null newbranches) $ do     mbidsession <- bzReviewSession     urls <- forM newbranches $ \ br -> do       when mock $ fedpkg_ "mockbuild" ["--root", mockRoot br]       when multiple $ putStr (unPackage pkg ++ " ")-      when (length newbranches > 1) $ putStr (show br)+      when (length branches > 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@@ -53,12 +74,21 @@     whenJust mbidsession $ \(bid,session) ->       commentBug session bid $ unlines urls   where+    lookupKeyElems k o =+      lookupKey' k o ::+#if MIN_VERSION_aeson(2,0,0)+        M.KeyMap [String]+#else+        M.HashMap Text [String]+#endif+     filterExistingBranchRequests :: [Branch] -> IO [Branch]     filterExistingBranchRequests branches = do       existing <- fedoraBranchesNoRawhide (localBranches True)+      let pkgPrefix = if multiple then unPackage pkg ++ ": " else ""       forM_ branches $ \ br ->         when (br `elem` existing) $-        putStrLn $ show br ++ " branch already exists"+        putStrLn $ pkgPrefix ++ show br ++ " branch already exists"       let brs' = branches \\ existing       if null brs'         then return []@@ -66,7 +96,7 @@         current <- fedoraBranchesNoRawhide $ pagurePkgBranches (unPackage pkg)         forM_ brs' $ \ br ->           when (br `elem` current) $-          putStrLn $ show br ++ " remote branch already exists"+          putStrLn $ pkgPrefix ++ show br ++ " remote branch already exists"         let newbranches = brs' \\ current         if null newbranches then return []           else do

@@ -66,7 +66,7 @@         let comment = (if null input then draft else input) ++ "\n\n" <> url         commentBug session bid comment         putStrLn ""-        branches <- getRequestedBranches breq+        branches <- getRequestedBranches [] breq         forM_ branches $ \ br -> do           when mock $ fedpkg_ "mockbuild" ["--root", mockRoot br]           putStr (show br ++ " ")

@@ -2,6 +2,8 @@  module Cmd.Scratch (   scratchCmd,+  scratchCmdAarch64,+  scratchCmdX86_64,   Archs(..),   ) where @@ -13,15 +15,17 @@ 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+scratchCmd :: Bool -> Bool -> Bool -> Bool -> Maybe Archs -> Maybe String            -> Maybe String -> (BranchesReq, [String]) -> IO ()-scratchCmd dryrun rebuildSrpm nofailfast marchopts mtarget mref (breq,pkgs) =-  withPackageByBranches (Just True) Nothing AnyNumber scratchBuild (breq,pkgs)+scratchCmd dryrun stagger rebuildSrpm nofailfast marchopts mtarget mref (breq,pkgs) =+  withPackagesByBranches HeaderMust False Nothing AnyNumber scratchBuild (breq,pkgs)   where+    anyTarget (RelBranch b) = branchTarget b+    anyTarget _ = "rawhide"+     scratchBuild :: Package -> AnyBranch -> IO ()     scratchBuild pkg br = do       when (isJust mref && length pkgs > 1) $@@ -32,42 +36,70 @@       spec <- localBranchSpecFile pkg br       let target = fromMaybe (anyTarget br) mtarget       putStrLn $ "Target: " ++ target-      archs <- case marchopts of-        Nothing -> return []-        Just archopts -> case archopts of-          Archs as -> return as-          ExcludedArchs as -> do+      archs <-+        case marchopts of+          Nothing -> return []+          Just archopts ->+            case archopts of+              Archs as -> return as+              ExcludedArchs as -> do+                Just (buildtag,_desttag) <- kojiBuildTarget fedoraHub target+                tagArchs <- kojiTagArchs buildtag+                return $ tagArchs \\ as+      if stagger+        then do+        archlist <-+          if null archs+          then do             Just (buildtag,_desttag) <- kojiBuildTarget fedoraHub target             tagArchs <- kojiTagArchs buildtag-            return $ tagArchs \\ as-      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-        pushed <- do-          case mref of-            Just ref ->-              if length ref < 6-              then error' $ "please use a longer ref: " ++ ref-              -- FIXME print commit log-              else return True-            Nothing -> do-              clean <- isGitDirClean-              if clean then-                null <$> gitShortLog ("origin/" ++ show br ++ "..HEAD")-                else return False-        rbr <- anyBranchToRelease br-        nvr <- pkgNameVerRel' rbr spec-        putStrLn $ target ++ " scratch build of " ++ fromMaybe nvr mref ++ (if pushed then "" else ".src.rpm")-        unless dryrun $ do-          if pushed-            then kojiBuildBranch target pkg mref $ "--scratch" : kojiargs-            else srpmBuild target kojiargs spec-        else srpmBuild target kojiargs spec+            -- prioritize preferred archs+            return $ nub $ priorityArchs ++ tagArchs+          else return $ nub $ filter (`elem` archs) priorityArchs ++ archs+        forM_ archlist $ \arch -> do+          putStrLn $ arch ++ " scratch build"+          doScratchBuild pkggit spec target [arch]+        else doScratchBuild pkggit spec target archs       where-        srpmBuild :: FilePath -> [String] -> String -> IO ()-        srpmBuild target kojiargs spec =-          void $ generateSrpm (Just br) spec >>= kojiScratchBuild target kojiargs+        priorityArchs = ["x86_64", "aarch64", "ppc64le"] -        anyTarget (RelBranch b) = branchTarget b-        anyTarget _ = "rawhide"+        doScratchBuild pkggit spec target archs = do+          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+            pushed <- do+              case mref of+                Just ref ->+                  if length ref < 6+                  then error' $ "please use a longer ref: " ++ ref+                  -- FIXME print commit log+                  else return True+                Nothing -> do+                  clean <- isGitDirClean+                  if clean && isRelBranch br+                    then+                    null <$> gitShortLog ("origin/" ++ show br ++ "..HEAD")+                    else return False+            rbr <- anyBranchToRelease br+            nvr <- pkgNameVerRel' rbr spec+            putStrLn $ target ++ " scratch build of " ++ fromMaybe nvr mref ++ (if pushed then "" else ".src.rpm")+            unless dryrun $ do+              if pushed+                then kojiBuildBranch target pkg mref $ "--scratch" : kojiargs+                else srpmBuild kojiargs+            else srpmBuild kojiargs+          where+            srpmBuild :: [String] -> IO ()+            srpmBuild kojiargs =+              void $ generateSrpm (Just br) spec >>= kojiScratchBuild target kojiargs++scratchCmdX86_64 :: Bool -> Bool -> Maybe String -> Maybe String+                 -> (BranchesReq, [String]) -> IO ()+scratchCmdX86_64 dryrun rebuildSrpm =+  scratchCmd dryrun False rebuildSrpm False (Just (Archs ["x86_64"]))++scratchCmdAarch64 :: Bool -> Bool -> Maybe String -> Maybe String+                  -> (BranchesReq, [String]) -> IO ()+scratchCmdAarch64 dryrun rebuildSrpm =+  scratchCmd dryrun False rebuildSrpm False (Just (Archs ["aarch64"]))

@@ -51,5 +51,5 @@ graphCmd dot mrpmwith (mbr, pkgs) = do   withPackagesMaybeBranchNoHeadergit ZeroOrOne noop (mbr, pkgs)   let rpmopts = maybe [] toRpmOption mrpmwith-  createGraph'''' False [] rpmopts False False True Nothing pkgs >>=+  createGraph4 False [] rpmopts False False True Nothing pkgs >>=     if dot then printGraph else renderGraph

@@ -28,7 +28,7 @@     map reviewBugToPackage <$> listReviewsAll True ReviewRepoCreated     else return []   -- FIXME dirty not okay for multiple branches?-  withPackageByBranches (Just False) (if nofetch then dirtyGit else dirtyGitFetch) AnyNumber statusBranch (breq, pkgs ++ reviewpkgs)+  withPackagesByBranches HeaderMay False (if nofetch then dirtyGit else dirtyGitFetch) AnyNumber statusBranch (breq, pkgs ++ reviewpkgs)  -- FIXME note dirty when local changes statusBranch :: Package -> AnyBranch -> IO ()

@@ -8,6 +8,6 @@ switchCmd :: AnyBranch -> [String] -> IO () switchCmd br pkgs =   -- FIXME use withBranchByPackages ?-  withPackageByBranches Nothing dirtyGit Zero dummy (Branches [],pkgs)+  withPackagesByBranches HeaderNone False dirtyGit Zero dummy (Branches [],pkgs)   where     dummy _ _ = gitSwitchBranch br

@@ -35,7 +35,7 @@         in if pkgGit            then dirty            else if null pkgs then Nothing else dirty-  withPackagesMaybeBranch (Just False) mgitops ZeroOrOne (updatePkg mver) (mbr, pkgs)+  withPackagesMaybeBranch HeaderMay False mgitops ZeroOrOne (updatePkg mver) (mbr, pkgs)   where     updatePkg :: Maybe String -> Package -> AnyBranch -> IO ()     updatePkg mver pkg br = do

@@ -1,4 +1,7 @@-module Cmd.WaitRepo (waitrepoCmd)+module Cmd.WaitRepo (+  waitrepoCmd,+  WaitFetch(..)+  ) where  import Common.System@@ -9,10 +12,18 @@ import Koji import Package +data WaitFetch = WaitNoFetch | WaitDirty | WaitFetch+ -- FIXME first check/wait for build to actually exist-waitrepoCmd :: Bool -> Bool -> Maybe String -> (BranchesReq, [String]) -> IO ()-waitrepoCmd fetch dryrun mtarget = do-  withPackageByBranches (Just False) (if fetch then cleanGitFetchActive else cleanGitActive) AnyNumber waitrepoBranch+waitrepoCmd :: Bool -> WaitFetch -> Maybe String -> (BranchesReq, [String])+            -> IO ()+waitrepoCmd dryrun fetch mtarget = do+  withPackagesByBranches HeaderMay False+    (case fetch of+       WaitFetch -> cleanGitFetchActive+       WaitNoFetch -> cleanGitActive+       WaitDirty -> dirtyGitActive)+    AnyNumber waitrepoBranch   where     waitrepoBranch :: Package -> AnyBranch -> IO ()     waitrepoBranch _ (OtherBranch _) =@@ -21,4 +32,5 @@       gitSwitchBranch rbr       let spec = packageSpec pkg       nvr <- pkgNameVerRel' br spec-      kojiWaitRepo dryrun (fromMaybe (branchTarget br) mtarget) nvr+      timeIO $+        kojiWaitRepo dryrun True (fromMaybe (branchTarget br) mtarget) nvr

@@ -16,6 +16,7 @@   gitShortLogN,   gitShortLog1,   gitSwitchBranch,+  gitSwitchBranch', --  checkIsPkgGitDir,   isGitRepo,   isPkgGitRepo,@@ -27,12 +28,12 @@   module SimpleCmd.Git   ) where -import Common-import Common.System- import SimpleCmd.Git  import Branches+import Common+import Common.System+import Prompt  #if !MIN_VERSION_simple_cmd(0,2,2) -- | 'gitBool c args' runs git command and return result@@ -48,6 +49,12 @@   let ref = (if origin then "origin/" else "") ++ show br   ancestor <- gitBool "merge-base" ["--is-ancestor", "HEAD", ref]   commits <- gitShortLog ("HEAD.." ++ ref)+  -- warn if branch is ahead+  when (not origin && null commits && not ancestor) $ do+    rcommits <- gitShortLog (ref ++ "..HEAD")+    unless (null rcommits) $ do+      putStrLn $ "current branch is ahead of newer " ++ show br ++ " !!"+      prompt_ "Press Enter if you want to continue"   return (ancestor, commits)  getNewerBranch :: Branch -> IO Branch@@ -117,7 +124,7 @@   checkOnBranch   putStr "git pushing... "   out <- cmdQuiet "git" $ ["push", "--quiet", "origin"] ++ maybeToList mref-  putStrLn $ if null out then "done\n" else "\n" ++ out+  putStrLn $ if null out then "done" else "\n" ++ out  -- FIXME use this in more places gitRepoName :: IO String@@ -194,7 +201,8 @@   error' $ dir ++ ": HEAD is not a branch" gitSwitchBranch br = do   localbranches <- gitLines "branch" ["--format=%(refname:short)"]-  if show br `elem` localbranches then do+  if show br `elem` localbranches+    then do     current <- gitCurrentBranch     when (current /= br) $       git_ "switch" ["-q", show br]@@ -211,6 +219,33 @@       error' $ name ++ " " ++ show br ++ " branch does not exist!"       else       git_ "checkout" ["-q", "-b", show br, "--track", "origin/" ++ show br]++-- similar to gitSwitchBranch but does not error+gitSwitchBranch' :: Branch -> IO Bool+gitSwitchBranch' br = do+  localbranches <- gitLines "branch" ["--format=%(refname:short)"]+  if show br `elem` localbranches+    then do+    current <- gitCurrentBranch+    when (current /= RelBranch br) $+      git_ "switch" ["-q", show br]+    return True+    else do+    -- check remote branch exists+    remotebranch <- do+      exists <- checkIfRemoteBranchExists (RelBranch br)+      if exists+        then return True+        -- FIXME this is redundant if we already fetched (eg for merge cmd)+        else gitFetchSilent >> checkIfRemoteBranchExists (RelBranch br)+    if not remotebranch+      then do+      name <- getDirectoryName+      warning $ name ++ " " ++ show br ++ " branch does not exist!"+      return False+      else do+      git_ "checkout" ["-q", "-b", show br, "--track", "origin/" ++ show br]+      return True  checkIfRemoteBranchExists :: AnyBranch -> IO Bool checkIfRemoteBranchExists br =

@@ -11,6 +11,7 @@   ok <- cmdSilentBool c args   unless ok $ error' $ unwords (c:args) ++ ": failed" +-- currently unused cmdSilentBool :: String -> [String] -> IO Bool cmdSilentBool c args = do   (ret, out) <- readProcessInterleaved (proc c args)

@@ -142,6 +142,10 @@     Just TaskCanceled -> return ()     _ -> kojiWatchTask task +-- FIXME at 4am+-- Connection timed out: retrying+-- Connection timed out: retrying+-- Network.Socket.connect: <socket: 11>: does not exist (No route to host) kojiWaitTask :: TaskID -> IO Bool kojiWaitTask task = do   -- FIXME can error:@@ -181,8 +185,8 @@   Left task <- kojiBuildBranch' False target pkg mref args   return task -kojiWaitRepo :: Bool -> String -> String -> IO ()-kojiWaitRepo dryrun target nvr = do+kojiWaitRepo :: Bool -> Bool -> String -> String -> IO ()+kojiWaitRepo dryrun quiet target nvr = do   Just (buildtag,_desttag) <- kojiBuildTarget fedoraHub target   unless dryrun $     waitRepo buildtag Nothing@@ -209,7 +213,7 @@                        then " is in " ++ buildtag                        else " appeared"                   else do-                  when (isNothing moldrepo) $+                  when (isNothing moldrepo && not quiet) $                     logMsg $ "Waiting for " ++ buildtag ++ " to have " ++ nvr                   waitRepo buildtag mrepo 

@@ -30,7 +30,7 @@ listReviewsFull :: Bool -> Maybe String -> Maybe String -> Bool                 -> ReviewStatus-> IO [Bug] listReviewsFull assignee muser mpat allopen status = do-  let session = bzAnonSession+  session <- bzApiKeySession   accountid <- getBzAccountId session muser   let reviews = (if assignee then assigneeIs else reporterIs) accountid .&&. maybe packageReview pkgReviewsPrefix mpat       open = if allopen

@@ -14,6 +14,7 @@ import Cmd.Bump import Cmd.Clone import Cmd.Commit+import Cmd.Compare import Cmd.Copr import Cmd.Diff import Cmd.FTBFS@@ -22,7 +23,6 @@ import Cmd.ListBranches import Cmd.ListPackages import Cmd.Local-import Cmd.Log import Cmd.Merge import Cmd.Mock import Cmd.Override@@ -56,7 +56,7 @@   simpleCmdArgs (Just version) "Fedora branch building tool"     "A tool to help with updating and building package branches https://github.com/juhp/fbrnch#readme" $     subcommands-    [ Subcommand "clone" "clone packages" $+    [ Subcommand "clone" "Clone packages" $       cloneCmd       <$> cloneRequest     , Subcommand "switch" "Switch branch" $@@ -95,7 +95,7 @@     , Subcommand "parallel" "Parallel build packages in Koji" $       parallelBuildCmd       <$> dryrunOpt-      <*> switchWith 'm' "merge" "Merge newer branch without prompt"+      <*> mergeOpt       <*> optionalWith auto 'l' "skip-to-layer" "LAYERNO" "Skip the first N layers [default 0]" 0       <*> optional sidetagTargetOpt       <*> updateOpt 'S'@@ -110,19 +110,35 @@       <*> switchWith 'w' "no-wait" "Skip waitrepo step"       <*> branchesPackages     , Subcommand "waitrepo" "Wait for build to appear in Koji buildroot" $-      waitrepoCmd True+      waitrepoCmd       <$> dryrunOpt+      <*> waitfetchOpt       <*> mtargetOpt       <*> branchesPackages     , Subcommand "scratch" "Scratch build package in Koji" $       scratchCmd       <$> dryrunOpt+      <*> switchWith 'S' "stagger" "Stagger archs"       <*> rebuildSrpmOpt       <*> noFailFastOpt       <*> optional archesOpt       <*> mtargetOpt       <*> optional (strOptionWith 'r' "ref" "COMMITHASH" "git commit to build")       <*> branchesPackages+    , Subcommand "scratch-aarch64" "Koji aarch64 scratch build of package" $+      scratchCmdAarch64+      <$> dryrunOpt+      <*> rebuildSrpmOpt+      <*> mtargetOpt+      <*> optional (strOptionWith 'r' "ref" "COMMITHASH" "git commit to build")+      <*> branchesPackages+    , Subcommand "scratch-x86_64" "Koji x86_64 scratch build of package" $+      scratchCmdX86_64+      <$> dryrunOpt+      <*> rebuildSrpmOpt+      <*> mtargetOpt+      <*> optional (strOptionWith 'r' "ref" "COMMITHASH" "git commit to build")+      <*> branchesPackages     , Subcommand "update" "Update package in dist-git to newer version" $       updateCmd       <$> switchWith 's' "sources-only" "Only update sources"@@ -159,7 +175,7 @@       <*> optional (optionWith anyBranchM 'w' "with-branch" "BRANCH" "branch")       <*> maybeBranchPackages False     , Subcommand "compare" "Show commits between branches" $-      logCmd+      compareCmd       <$> switchWith 'l' "long" "show full commit log"       <*> anyBranchArg       <*> anyBranchArg@@ -204,7 +220,7 @@       <*> manyPackages     , Subcommand "pull" "Git pull packages" $       pullPkgs-      <$> switchWith 'l' "lenient" "Ignore non-git dirs and files"+      <$> pullOpts       <*> branchesPackages     , Subcommand "push" "Git push packages" $       pushPkgs@@ -394,6 +410,10 @@      rebuildSrpmOpt = switchWith 's' "rebuild-srpm" "rebuild srpm in Koji" +    mergeOpt =+      optional (flagWith' True 'm' "merge" "Merge without prompt" <|>+                flagWith' False 'M' "no-merge" "No merging")+     buildOpts =       BuildOpts       <$> mergeOpt@@ -406,10 +426,8 @@       <*> updateOpt 's'       <*> useChangelogOpt       <*> switchWith 'p' "by-package" "Build by each package across brs"+      <*> switchWith 'k' "allow-dirty" "Allow building from unclean git dir"       where-        mergeOpt =-          optional (flagWith' True 'm' "merge" "Merge without prompt" <|>-                    flagWith' False 'M' "no-merge" "No merging")         overrideOpt =           optional (optionWith auto 'o' "override" "DAYS" "Create buildroot override for specified days: implies --wait-repo")         waitrepoOpt =@@ -492,6 +510,12 @@       strOptionWith 'm' "message" "COMMITMSG" "commit message" <|>       flagWith' CommitAmend 'A' "amend" "Amend commit" +    pullOpts :: Parser PullOpts+    pullOpts =+      PullOpts <$>+      switchWith 'l' "lenient" "Ignore non-git dirs and files" <*>+      switchWith 'f' "no-fetch" "Skip git fetch"+     buildByOpt = flagWith' SingleBuild 'S' "single" "Non-progressive normal single build" <|> flagWith' BuildByRelease 'R' "by-release" "Builds by release" <|> flagWith ValidateByRelease ValidateByArch 'A' "by-arch" "Build across latest release archs first (default is across releases for primary arch)"      commandOpt = strOptionWith 'c' "cmd" "SHELLCOMMAND" "Shell command to run in $p"@@ -527,3 +551,9 @@       flagWith' SortParallel 'p' "parallel" "Group dependent packages on separate lines"       <|> flagWith' SortChain 'c' "chain" "chain-build output"       <|> flagWith SortPlain SortLayers 'l' "layers" "output parallel layers"++    -- for waitrepo+    waitfetchOpt :: Parser WaitFetch+    waitfetchOpt =+      flagWith' WaitDirty 'k' "allow-dirty" "Allow unclean git repo" <|>+      flagWith WaitFetch WaitNoFetch 'F' "no-fetch" "Skip git fetch"

@@ -7,6 +7,7 @@   fedpkg,   fedpkg_,   checkForSpecFile,+  getChangelog,   cleanChangelog,   changelogVersions,   changeLogPrompt,@@ -29,15 +30,18 @@   putPkgAnyBrnchHdr,   withExistingDirectory,   initialPkgRepo,-  withPackageByBranches,+  withPackagesByBranches,   withPackagesMaybeBranch,   withPackagesMaybeBranchNoHeadergit,+  HeaderShow(..),+  boolHeader,   LimitBranches(..),   cleanGit,   cleanGitActive,   cleanGitFetch,   cleanGitFetchActive,   dirtyGit,+  dirtyGitActive,   dirtyGitFetch,   dirtyGitHEAD,   Package(..),@@ -60,13 +64,13 @@ import Network.HTTP.Directory (Manager, httpExists, httpManager) import SimpleCmd.Rpm import System.Console.Pretty+import System.IO.Extra (withTempDir) import System.Posix.Files  import Branches import Common import Common.System import Git-import InterleaveOutput import Krb import Prompt @@ -103,14 +107,17 @@   ns <- cmdLines "rpmspec" ["-q", "--srpm", "--qf", "%{changelogname}", spec]   return $ map (removePrefix "- " . dropWhile (/= '-')) ns -cleanChangelog :: FilePath -> IO String-cleanChangelog spec = do+getChangelog :: FilePath -> IO [String]+getChangelog spec = do   autochangelog <- grep_ "^%autochangelog" spec-  ls <--    if autochangelog+  if autochangelog     then takeWhile (not . null) . drop 1 <$>          cmdLines "rpmautospec" ["generate-changelog", spec]     else cmdLines "rpmspec" ["-q", "--srpm", "--qf", "%{changelogtext}", spec]++cleanChangelog :: FilePath -> IO String+cleanChangelog spec = do+  ls <- getChangelog spec   return $ case filter ("- " `isPrefixOf`) ls of              [l] -> removePrefix "- " l              _ -> unlines ls@@ -254,18 +261,24 @@         sourcediropt = ["--define", "_sourcedir " ++ cwd]         args = sourcediropt ++ ["--define", "dist " ++ rpmDistTag dist] ++                buildopt ++ map show bconds ++ [spec]+    date <- cmd "date" ["+%T"]+    putStr $ date ++ " Building " ++ takeBaseName spec ++ " locally... "     ok <-+      timeIO $       if not quiet || shortcircuit       then do         rbr <- anyBranchToRelease br         nvr <- pkgNameVerRel' rbr spec         -- FIXME would like to have pipeOutErr-        timeIO $ shellBool $ unwords $ "rpmbuild" : map quoteArg args ++ "|&" : "tee" : [".build-" ++ showNVRVerRel (readNVR nvr) <.> "log"]+        shellBool $ unwords $ "rpmbuild" : map quoteArg args ++ "|&" : "tee" : [".build-" ++ showNVRVerRel (readNVR nvr) <.> "log"]       else do-        date <- cmd "date" ["+%T"]-        putStr $ date ++ " Building " ++ takeBaseName spec ++ " locally... "-        res <- timeIO $ cmdSilentBool "rpmbuild" args-        when res $ putStrLn "done"+        rbr <- anyBranchToRelease br+        nvr <- pkgNameVerRel' rbr spec+        let buildlog = ".build-" ++ showNVRVerRel (readNVR nvr) <.> "log"+        res <- shellBool $ unwords $ "rpmbuild" : map quoteArg args ++ [">&", buildlog]+        if res+          then putStrLn "done"+          else cmd_ "tail" ["-n 100", buildlog]         return res     unless ok $       error' $ takeBaseName spec ++ " failed to build"@@ -531,42 +544,48 @@   , gitOptHEAD :: Bool -- allow detached head/rebase state   } -cleanGit, cleanGitActive, cleanGitFetch, cleanGitFetchActive, dirtyGit, dirtyGitFetch, dirtyGitHEAD :: Maybe GitOpts+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  data LimitBranches = AnyNumber | Zero | ZeroOrOne | ExactlyOne   deriving Eq --- FIXME rename to withPackages*--- FIXME countdown packages-withPackageByBranches :: Maybe Bool-                      -> Maybe GitOpts-                      -> LimitBranches-                      -> (Package -> AnyBranch -> IO ())-                      -> (BranchesReq,[String])-                      -> IO ()-withPackageByBranches mheader mgitopts limitBranches action (breq,pkgs) =+data HeaderShow = HeaderNone | HeaderMay | HeaderMust+  deriving Eq++boolHeader :: Bool -> HeaderShow+boolHeader b = if b then HeaderMust else HeaderMay++withPackagesByBranches :: HeaderShow+                       -> Bool+                       -> Maybe GitOpts+                       -> LimitBranches+                       -> (Package -> AnyBranch -> IO ())+                       -> (BranchesReq,[String])+                       -> IO ()+withPackagesByBranches header count mgitopts limitBranches action (breq,pkgs) =   if null pkgs-    then-    withPackageDir "."+    then withPackageDir (0, ".")     else do-    when (length pkgs > 1 && breq == Branches []) $+    let numpkgs = length pkgs+    when (numpkgs > 1 && breq == Branches []) $       case limitBranches of         Zero -> return ()         ZeroOrOne -> warning "Better to specify an explicit branch for multiple packages"         _ -> error' "At least one branch must be specified when there are multiple packages"-    mapM_ withPackageDir pkgs+    mapM_ withPackageDir $ zip [numpkgs,(numpkgs-1)..1] pkgs   where     -- FIXME support arbitrary (module) branches-    withPackageDir :: FilePath -> IO ()-    withPackageDir path = do+    withPackageDir :: (Int,FilePath) -> IO ()+    withPackageDir (n, path) = do       let dir =             if ".spec" `isExtensionOf` path             then takeDirectory path@@ -582,8 +601,10 @@                  -- For now assume spec filename = package name                  Just spec -> return $ takeBaseName spec                  Nothing -> getDirectoryName+        when (count && length pkgs >= 2) $+          putStrLn $ plural n "package" +-+ "left"         unless (isNothing mspec || mspec == Just (unPackage pkg <.> "spec")) $-          putStrLn  "Warning: package name and spec filename differ!"+          putStrLn $ "Warning: package name (" ++ unPackage pkg ++ ") differs from spec filename!"         haveGit <- isPkgGitRepo         when (isJust mgitopts && not haveGit) $           error' $ "Not a pkg git dir: " ++ unPackage pkg@@ -609,10 +630,10 @@             error' "please only specify one branch"           _ -> return ()         let fetch = have gitOptFetch-        when ((isJust mheader || fetch) && dir /= ".") $+        when ((header /= HeaderNone || fetch) && dir /= ".") $           case brs of-            [br] -> when (fetch || mheader == Just True) $ putPkgAnyBrnchHdr pkg br-            _ -> when (fetch || isJust mheader) $ putPkgHdr pkg+            [br] -> when (fetch || header == HeaderMust) $ putPkgAnyBrnchHdr pkg br+            _ -> when (fetch || header /= HeaderNone) $ putPkgHdr pkg         when haveGit $           when (have gitOptClean) checkWorkingDirClean         when fetch gitFetchSilent@@ -621,7 +642,7 @@           putStrLn $ "Branches: " ++ unwords (map show brs) ++ "\n"         -- FIXME add newline at end?         let action' p b = do-              when (isJust mheader && length brs > 1) $ putPkgAnyBrnchHdr p b+              when (header /= HeaderNone && length brs > 1) $ putPkgAnyBrnchHdr p b               action p b         mapM_ (action' pkg) brs         when (length brs /= 1) $@@ -630,21 +651,22 @@     have :: (GitOpts -> Bool) -> Bool     have opt = maybe False opt mgitopts -withPackagesMaybeBranch :: Maybe Bool+withPackagesMaybeBranch :: HeaderShow+                        -> Bool                         -> Maybe GitOpts                         -> LimitBranches                         -> (Package -> AnyBranch -> IO ())                         -> (Maybe Branch,[String])                         -> IO ()-withPackagesMaybeBranch mheader mgitopts limitBranches action (mbr, pkgs) =-  withPackageByBranches mheader mgitopts limitBranches action (Branches (maybeToList mbr),pkgs)+withPackagesMaybeBranch header count mgitopts limitBranches action (mbr, pkgs) =+  withPackagesByBranches header count mgitopts limitBranches action (Branches (maybeToList mbr),pkgs)  withPackagesMaybeBranchNoHeadergit :: LimitBranches                                        -> (Package -> AnyBranch -> IO ())                                        -> (Maybe Branch,[String])                                        -> IO () withPackagesMaybeBranchNoHeadergit =-  withPackagesMaybeBranch Nothing Nothing+  withPackagesMaybeBranch HeaderNone False Nothing  data CloneUser = AnonClone | UserClone @@ -716,9 +738,13 @@     if dynbr     then do       installMissingMacros spec-      out <- cmdIgnoreErr "rpmbuild" ["-br", "--nodeps", spec] ""-      -- Wrote: /current/dir/SRPMS/name-version-release.buildreqs.nosrc.rpm-      cmdLines "rpm" ["-qp", "--requires", last (words out)]+      withTempDir $ \tmpdir -> do+        let srpmdiropt = ["--define", "_srcrpmdir" ++ tmpdir]+        out <- cmdIgnoreErr "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 -> cmdLines "rpm" ["-qp", "--requires", last ws]     else       -- FIXME should resolve meta       rpmspec ["--buildrequires"] Nothing spec

@@ -1,10 +1,10 @@ module Pagure (   srcfpo,   pagureio,-  pagureProjectInfo,   pagureListGitBranches,   pagureListProjectIssueTitlesStatus,   IssueTitleStatus(..),+  pagureProjectInfo,   pagureUserRepos,   makeItem,   printScmIssue