fbrnch 0.7.2 → 0.7.3
raw patch · 23 files changed
+355/−239 lines, 23 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +19/−0
- fbrnch.cabal +1/−1
- src/Bodhi.hs +9/−0
- src/Branches.hs +14/−1
- src/Bugzilla.hs +1/−2
- src/Cmd/Build.hs +38/−28
- src/Cmd/Bump.hs +1/−1
- src/Cmd/Clone.hs +0/−2
- src/Cmd/Import.hs +59/−69
- src/Cmd/Install.hs +20/−0
- src/Cmd/Local.hs +30/−18
- src/Cmd/Merge.hs +27/−15
- src/Cmd/Override.hs +8/−11
- src/Cmd/Parallel.hs +7/−10
- src/Cmd/PkgReview.hs +2/−2
- src/Cmd/RequestRepo.hs +9/−6
- src/Cmd/Scratch.hs +3/−4
- src/Cmd/Status.hs +3/−3
- src/Git.hs +10/−9
- src/Koji.hs +25/−16
- src/Main.hs +12/−10
- src/Package.hs +40/−24
- src/Prompt.hs +17/−7
CHANGELOG.md view
@@ -1,5 +1,24 @@ # Changelog +## 0.7.3 (2021-03-23)+- 'scratch': don't get sources for pushed git build+- changes/improvements to package header output+- 'merge','build': show/query diverging newer commits+- 'merge': add --no-prompt option+- Build: refine the "still in testing" logic to check testing repo with prompt+- Koji: offer to resubmit build on error+- 'request-repos' now prompts for branching and+ 'import' skips offering branching if they exist+- 'import': add --mock option for checking branches (#18)+- add 'not-installed' command: lists packages not installed locally at all+- Bugzilla: don't bother reprinting comment after posting it+- 'rename-master': renamed from 'master-rename'+- 'srpm': add --force option+- `local --force` (or --short): ignore existing built rpms+- 'command': option to hide package header if no output+- 'create-review': fix error for non-existent dir+- 'parallel': don't sleep 5s for dryrun+ ## 0.7.2 (2021-02-27) - 'install': --recurse to install missing neighboring deps - 'request-repo': offer to request branches too
fbrnch.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: fbrnch-version: 0.7.2+version: 0.7.3 synopsis: Build and create Fedora package repos and branches description: fbrnch is a convenient packaging tool for Fedora Packagers,
src/Bodhi.hs view
@@ -2,6 +2,7 @@ module Bodhi ( bodhiCreateOverride,+ bodhiTestingRepo, checkAutoBodhiUpdate, UpdateType(..) )@@ -70,3 +71,11 @@ "enhancement" -> RP.lift (R.string s) >> return EnhancementUpdate "newpackage" -> RP.lift (R.string s) >> return NewPackageUpdate _ -> error' "unknown bodhi update type" >> RP.pfail++bodhiTestingRepo :: Branch -> IO (Maybe String)+bodhiTestingRepo Rawhide = return Nothing+bodhiTestingRepo br = do+ obj <- bodhiRelease (show br)+ return $ case lookupKey "testing_repository" obj :: Maybe String of+ Nothing -> Nothing+ Just _ -> lookupKey' "testing_tag" obj
src/Branches.hs view
@@ -18,7 +18,8 @@ systemBranch, getReleaseBranch, branchVersion,- anyBranchToRelease+ anyBranchToRelease,+ branchingPrompt ) where import Common@@ -28,6 +29,7 @@ import SimpleCmd.Git import Pagure+import Prompt data AnyBranch = RelBranch Branch | OtherBranch String deriving Eq@@ -170,3 +172,14 @@ branchVersion Rawhide = "rawhide" branchVersion (Fedora n) = show n branchVersion (EPEL n) = show n++branchingPrompt :: IO [Branch]+branchingPrompt = do+ inp <- prompt "Enter required branches [default: latest 2]"+ if null inp+ then return []+ else+ let brs = map anyBranch $ words inp+ in if all isRelBranch brs+ then return $ map onlyRelBranch brs+ else branchingPrompt
src/Bugzilla.hs view
@@ -101,8 +101,7 @@ Nothing -> print res Just msg -> T.putStrLn msg error' $ "failed to update bug " ++ show bid- putStrLn "Comment added:"- putStrLn comment+ putStrLn "Comment added" updateBug :: BugzillaSession -> BugId -> [(String,String)] -> IO () updateBug session bid params = do
src/Cmd/Build.hs view
@@ -54,17 +54,16 @@ buildBranch _ _ _ (OtherBranch _) = error' "build only defined for release branches" buildBranch mlastpkg opts pkg rbr@(RelBranch br) = do- putPkgAnyBrnchHdr pkg rbr gitSwitchBranch rbr gitMergeOrigin rbr newrepo <- initialPkgRepo tty <- isTty- unmerged <- mergeable br+ (ancestor,unmerged) <- mergeable br -- FIXME if already built or failed, also offer merge merged <-- if notNull unmerged && (buildoptNoPrompt opts || newrepo || tty)- then mergeBranch True (buildoptNoPrompt opts) unmerged br >> return True- else return False+ if buildoptNoPrompt opts || newrepo || tty+ then mergeBranch True (buildoptNoPrompt opts) (ancestor,unmerged) br >> return True+ else return False let spec = packageSpec pkg checkForSpecFile spec checkSourcesMatch spec@@ -75,12 +74,12 @@ when (not merged || br == Rawhide) $ unless (null unpushed) $ do putStrLn "Local commits:"- mapM_ (putStrLn . simplifyCommitLog) unpushed+ mapM_ putStrLn unpushed mpush <- if null unpushed then return Nothing else -- see mergeBranch for: unmerged == 1 (774b5890)- if tty && (not merged || (newrepo && length unmerged == 1))+ if tty && (not merged || (newrepo && ancestor && length unmerged == 1)) then refPrompt unpushed $ "Press Enter to push and build" ++ (if length unpushed > 1 then "; or give a ref to push" else "") ++ (if not newrepo then "; or 'no' to skip pushing" else "") else return $ Just Nothing let dryrun = buildoptDryrun opts@@ -93,26 +92,23 @@ when (isJust mpush) $ error' "Please bump the spec file" when (br /= Rawhide && isNothing mtarget) $ do- mtags <- kojiNVRTags nvr- case mtags of- Nothing -> error' $ nvr ++ " is untagged"- Just tags ->- unless dryrun $- unlessM (checkAutoBodhiUpdate br) $ do- unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-updates-pending", show br ++ "-updates-testing", show br ++ "-updates-testing-pending"]) $ do- mBugSess <- do- (mbid, session) <- bzReviewSession- return $ case mbid of- Just bid -> Just (bid,session)- Nothing -> Nothing- bodhiUpdate (fmap fst mBugSess) spec nvr- unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $- when (buildoptOverride opts) $- bodhiCreateOverride nvr- when (isJust mlastpkg && mlastpkg /= Just pkg) $ do- autoupdate <- checkAutoBodhiUpdate br- when (buildoptOverride opts || autoupdate) $- kojiWaitRepo target nvr+ tags <- kojiNVRTags nvr+ unless dryrun $+ unlessM (checkAutoBodhiUpdate br) $ do+ unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-updates-pending", show br ++ "-updates-testing", show br ++ "-updates-testing-pending"]) $ do+ mBugSess <- do+ (mbid, session) <- bzReviewSession+ return $ case mbid of+ Just bid -> Just (bid,session)+ Nothing -> Nothing+ bodhiUpdate (fmap fst mBugSess) spec nvr+ unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $+ when (buildoptOverride opts) $+ bodhiCreateOverride nvr+ when (isJust mlastpkg && mlastpkg /= Just pkg) $ do+ autoupdate <- checkAutoBodhiUpdate br+ when (buildoptOverride opts || autoupdate) $+ kojiWaitRepo target nvr Just BuildBuilding -> do putStrLn $ nvr ++ " is already building" when (isJust mpush) $@@ -137,6 +133,20 @@ if equivNVR nvr (fromMaybe "" mlatest) then error' $ nvr ++ " is already latest" ++ if Just nvr /= mlatest then " (modulo disttag)" else "" else do+ firstBuild <- do+ mtestingRepo <- bodhiTestingRepo br+ case mtestingRepo of+ Nothing -> return $ isNothing mlatest+ Just testing -> do+ mnewest <- kojiLatestNVR testing $ unPackage pkg+ case mnewest of+ Nothing -> return $ isNothing mlatest+ Just newest -> do+ newestTags <- kojiNVRTags newest+ unless (any (`elem` newestTags) [show br, show br ++ "-updates", show br ++ "-updates-pending"]) $ do+ putStrLn $ "Warning: " ++ newest ++ " still in testing?"+ prompt_ "Press Enter to continue"+ return False unless dryrun krbTicket whenJust mpush $ \ mref -> unless dryrun $@@ -150,7 +160,7 @@ unless dryrun $ do kojiBuildBranch target pkg mbuildref ["--fail-fast"] mBugSess <-- if isNothing mlatest+ if firstBuild then do (mbid, session) <- bzReviewSession return $ case mbid of
src/Cmd/Bump.hs view
@@ -12,7 +12,7 @@ bumpPkgs :: Maybe CommitOpt -> Maybe BranchOpts -> [String] -> IO () bumpPkgs mopt mbrnchopts =- withPackageByBranches (Just True) cleanGitFetchActive mbrnchopts True AnyNumber bumpPkg+ withPackageByBranches (Just False) cleanGitFetchActive mbrnchopts True AnyNumber bumpPkg where bumpPkg :: Package -> AnyBranch -> IO () bumpPkg pkg br = do
src/Cmd/Clone.hs view
@@ -20,6 +20,4 @@ map (takeFileName . T.unpack) <$> pagureUserRepos srcfpo userid -- FIXME detect/prevent "path/dir" ClonePkgs ps -> return ps- putStr "Cloning: " mapM_ (clonePkg False mbr) pkgs- putStrLn ""
src/Cmd/Import.hs view
@@ -19,77 +19,67 @@ import Prompt -- FIXME separate pre-checked listReviews and direct pkg call, which needs checks-importCmd :: [String] -> IO ()-importCmd ps = do+importCmd :: Bool -> [String] -> IO ()+importCmd mock ps = do pkgs <- if null ps then map reviewBugToPackage <$> listReviews ReviewRepoCreated else return ps mapM_ importPkg pkgs---- FIXME check not in a different git dir-importPkg :: String -> IO ()-importPkg pkg = do- putPkgHdr (Package pkg)- dir <- getCurrentDirectory- when (pkg /= takeFileName dir) $ do- -- FIXME check git repo exists- clonePkg True Nothing pkg- putStrLn ""- setCurrentDirectory pkg- -- FIXME: check branch is master- unlessM isGitRepo $ error' "Not a git repo"- newrepo <- initialPkgRepo- if not newrepo- then putStrLn "Skipping: already imported"- else do- checkWorkingDirClean- -- FIXME get session from importPkgs- (bid,session) <- approvedReviewBugIdSession pkg- comments <- getComments session bid- putBugId bid- putStrLn ""- mapM_ showComment comments- putStrLn ""- putStr "Review bug: "- putBugId bid- putStrLn ""- prompt_ "Press Enter to continue"- let srpms = map (T.replace "/reviews//" "/reviews/") $ concatMap findSRPMs comments- when (null srpms) $ error "No srpm urls found!"- mapM_ T.putStrLn srpms- let srpm = (head . filter isURI . filter (".src.rpm" `isSuffixOf`) . words . T.unpack . last) srpms- let srpmfile = takeFileName srpm- -- FIXME if havesrpm then print local filename- prompt_ $ "Press Enter to import " ++ srpmfile- havesrpm <- doesFileExist srpmfile- unless havesrpm $- cmd_ "curl" ["--silent", "--show-error", "--remote-name", srpm]- krbTicket- fedpkg_ "import" [srpmfile]- git_ "commit" ["--message", "import #" ++ show bid]- nvr <- pkgNameVerRel' Rawhide (pkg <.> "spec")- prompt_ $ "Press Enter to push and build " ++ nvr- gitPushSilent Nothing- -- FIXME build more branches- kojiBuildBranch "rawhide" (Package pkg) Nothing ["--fail-fast"]- putBugBuild session bid nvr- -- FIXME skip if branches already made- brs <- branchingPrompt- requestPkgBranches False Nothing brs (Package pkg)- when (pkg /= takeFileName dir) $- setCurrentDirectory dir where- findSRPMs :: Comment -> [T.Text]- findSRPMs =- filter (\ l -> "https://" `T.isInfixOf` l && any (`T.isPrefixOf` T.toLower l) ["srpm url:", "srpm:", "new srpm:", "updated srpm:"] && ".src.rpm" `T.isSuffixOf` l) . T.lines . commentText-- branchingPrompt :: IO [Branch]- branchingPrompt = do- inp <- prompt "Enter required branches [default: latest 2]"- if null inp- then return []- else- let brs = map anyBranch $ words inp- in if all isRelBranch brs- then return $ map onlyRelBranch brs- else branchingPrompt+ -- FIXME check not in a different git dir+ importPkg :: String -> IO ()+ importPkg pkg = do+ putPkgHdr (Package pkg)+ dir <- getCurrentDirectory+ when (pkg /= takeFileName dir) $ do+ -- FIXME check git repo exists+ clonePkg True Nothing pkg+ putStrLn ""+ setCurrentDirectory pkg+ -- FIXME: check branch is master+ unlessM isGitRepo $ error' "Not a git repo"+ newrepo <- initialPkgRepo+ if not newrepo+ then putStrLn "Skipping: already imported"+ else do+ checkWorkingDirClean+ -- FIXME get session from importPkgs+ (bid,session) <- approvedReviewBugIdSession pkg+ comments <- getComments session bid+ putBugId bid+ putStrLn ""+ mapM_ showComment comments+ putStrLn ""+ putStr "Review bug: "+ putBugId bid+ putStrLn ""+ prompt_ "Press Enter to continue"+ let srpms = map (T.replace "/reviews//" "/reviews/") $ concatMap findSRPMs comments+ when (null srpms) $ error "No srpm urls found!"+ mapM_ T.putStrLn srpms+ let srpm = (head . filter isURI . filter (".src.rpm" `isSuffixOf`) . words . T.unpack . last) srpms+ let srpmfile = takeFileName srpm+ -- FIXME if havesrpm then print local filename+ prompt_ $ "Press Enter to import " ++ srpmfile+ havesrpm <- doesFileExist srpmfile+ unless havesrpm $+ cmd_ "curl" ["--silent", "--show-error", "--remote-name", srpm]+ krbTicket+ fedpkg_ "import" [srpmfile]+ git_ "commit" ["--message", "import #" ++ show bid]+ nvr <- pkgNameVerRel' Rawhide (pkg <.> "spec")+ prompt_ $ "Press Enter to push and build " ++ nvr+ gitPushSilent Nothing+ -- FIXME build more branches+ kojiBuildBranch "rawhide" (Package pkg) Nothing ["--fail-fast"]+ putBugBuild session bid nvr+ existing <- fedoraBranchesNoRawhide localBranches+ when (null existing) $ do+ brs <- branchingPrompt+ requestPkgBranches mock Nothing brs (Package pkg)+ when (pkg /= takeFileName dir) $+ setCurrentDirectory dir+ where+ findSRPMs :: Comment -> [T.Text]+ findSRPMs =+ filter (\ l -> "https://" `T.isInfixOf` l && any (`T.isPrefixOf` T.toLower l) ["srpm url:", "srpm:", "new srpm:", "updated srpm:"] && ".src.rpm" `T.isSuffixOf` l) . T.lines . commentText
src/Cmd/Install.hs view
@@ -1,5 +1,6 @@ module Cmd.Install ( installCmd,+ notInstalledCmd ) where import Branches@@ -81,3 +82,22 @@ repoquery rbr ["--qf=%{source_name}", "--whatprovides", p] filterDebug = filter (\p -> not (any (`isInfixOf` p) ["-debuginfo-", "-debugsource-"]))++notInstalledCmd :: [String] -> IO ()+notInstalledCmd =+ withPackageByBranches Nothing Nothing Nothing True ZeroOrOne notInstalledPkg+ where+ notInstalledPkg :: Package -> AnyBranch -> IO ()+ notInstalledPkg pkg br = do+ dead <- doesFileExist "dead.package"+ unless dead $ do+ spec <- findSpecfile+ rpms <- builtRpms br spec+ let packages = map takeBaseName rpms+ installed <- filterM pkgInstalled packages+ when (null installed) $ do+ let pkgnames = map nameOfNVR packages+ older <- filterM pkgInstalled pkgnames+ if null older+ then putStrLn $ unPackage pkg+ else putStrLn $ " " ++ unPackage pkg
src/Cmd/Local.hs view
@@ -7,12 +7,14 @@ sortCmd, RpmWith(..), srpmCmd,- masterRenameCmd+ renameMasterCmd ) where +import qualified Data.ByteString.Lazy.Char8 as B import Distribution.RPM.Build.Order (dependencySortRpmOpts)-import qualified System.Process as P import System.Environment+import qualified System.Process as P+import qualified System.Process.Typed as TP import Branches import Common@@ -26,7 +28,9 @@ localBuildPkg :: Package -> AnyBranch -> IO () localBuildPkg pkg br = do spec <- localBranchSpecFile pkg br- rpms <- builtRpms br spec+ rpms <- if isJust mforceshort+ then return []+ else builtRpms br spec buildRPMs False mforceshort bconds rpms br spec -- FIXME single branch@@ -39,14 +43,14 @@ localBranchSpecFile pkg br >>= installDeps -- FIXME single branch-srpmCmd :: [String] -> IO ()-srpmCmd =+srpmCmd :: Bool -> [String] -> IO ()+srpmCmd force = withPackageByBranches Nothing Nothing Nothing True ZeroOrOne srpmBuildPkg where srpmBuildPkg :: Package -> AnyBranch -> IO () srpmBuildPkg pkg br = do spec <- localBranchSpecFile pkg br- void $ generateSrpm (Just br) spec+ void $ generateSrpm' force (Just br) spec data RpmWith = RpmWith String | RpmWithout String @@ -85,23 +89,31 @@ pkgNameVerRel' sbr spec >>= putStrLn -commandCmd :: String -> Maybe BranchOpts -> [String] -> IO ()-commandCmd cs mbrnchopts =- withPackageByBranches (Just True) Nothing mbrnchopts True AnyNumber cmdBranch+commandCmd :: Bool -> String -> Maybe BranchOpts -> [String] -> IO ()+commandCmd ifoutput cs mbrnchopts =+ withPackageByBranches (Just (not ifoutput)) Nothing mbrnchopts True AnyNumber cmdBranch where cmdBranch :: Package -> AnyBranch -> IO ()- cmdBranch pkg _br = do+ cmdBranch pkg br = do curEnv <- getEnvironment- let p = (P.shell cs) { P.env = Just (("p",unPackage pkg):curEnv) }- (_,_,_,h) <- P.createProcess p- void $ P.waitForProcess h+ if ifoutput then do+ out <- TP.readProcessInterleaved_ $+ TP.setEnv (("p",unPackage pkg):curEnv) $+ TP.shell cs+ unless (B.null out) $ do+ putPkgAnyBrnchHdr pkg br+ B.putStrLn out+ else do+ let p = (P.shell cs) { P.env = Just (("p",unPackage pkg):curEnv) }+ (_,_,_,h) <- P.createProcess p+ void $ P.waitForProcess h -masterRenameCmd :: [String] -> IO ()-masterRenameCmd =- withPackageByBranches (Just False) dirtyGit Nothing True ZeroOrOne masterRenameBranch+renameMasterCmd :: [String] -> IO ()+renameMasterCmd =+ withPackageByBranches (Just False) dirtyGit Nothing True ZeroOrOne renameMasterBranch where- masterRenameBranch :: Package -> AnyBranch -> IO ()- masterRenameBranch _pkg _br = do+ renameMasterBranch :: Package -> AnyBranch -> IO ()+ renameMasterBranch _pkg _br = do locals <- gitLines "branch" ["--format=%(refname:short)"] when ("rawhide" `notElem` locals) $ do git_ "fetch" ["--prune"]
src/Cmd/Merge.hs view
@@ -8,21 +8,19 @@ import Package import Prompt --- FIXME add --no-prompt -- add BranchOpts?-mergeCmd :: [String] -> IO ()-mergeCmd =+mergeCmd :: Bool -> [String] -> IO ()+mergeCmd noprompt = withPackageByBranches (Just False) cleanGitFetchActive Nothing True AnyNumber runMergeBranch where runMergeBranch :: Package -> AnyBranch -> IO () runMergeBranch _ (OtherBranch _) = error' "merge only defined for release branches"- runMergeBranch pkg rbr@(RelBranch br) = do- putPkgBrnchHdr pkg br+ runMergeBranch _pkg rbr@(RelBranch br) = do gitSwitchBranch rbr gitMergeOrigin rbr unmerged <- mergeable br- mergeBranch False False unmerged br+ mergeBranch False noprompt unmerged br getNewerBranch :: Branch -> IO Branch getNewerBranch Rawhide = return Rawhide@@ -37,28 +35,28 @@ -- FIXME newer branch might not exist (eg epel8): -- restrict to local branches-mergeable :: Branch -> IO [String]+mergeable :: Branch -> IO (Bool,[String]) mergeable br = do newerBr <- getNewerBranch br gitMergeable $ show newerBr -- FIXME return merged ref-mergeBranch :: Bool -> Bool -> [String] -> Branch -> IO ()+mergeBranch :: Bool -> Bool -> (Bool,[String]) -> Branch -> IO () mergeBranch _ _ _ Rawhide = return ()-mergeBranch _ _ [] _ = return ()-mergeBranch build noprompt unmerged br = do+mergeBranch _ _ (True,[]) _ = return ()+mergeBranch build noprompt (True, unmerged) br = do newerBr <- getNewerBranch br- newrepo <- initialPkgRepo+ isnewrepo <- initialPkgRepo unless (null unmerged) $ do- putStrLn $ (if newrepo || noprompt then "Merging from" else "New commits in") ++ " " ++ show newerBr ++ ":"- mapM_ (putStrLn . simplifyCommitLog) unmerged+ putStrLn $ (if isnewrepo || noprompt then "Merging from" else "New commits in") ++ " " ++ show newerBr ++ ":"+ mapM_ putStrLn unmerged unpushed <- gitShortLog $ "origin/" ++ show br ++ "..HEAD" unless (null unpushed) $ do putStrLn "Local commits:"- mapM_ (putStrLn . simplifyCommitLog) unpushed+ mapM_ putStrLn unpushed -- FIXME avoid Mass_Rebuild bumps mmerge <-- if newrepo && length unmerged == 1 || noprompt then return $ Just Nothing+ if isnewrepo && length unmerged == 1 || noprompt then return $ Just Nothing else refPrompt unmerged $ "Press Enter to merge " ++ show newerBr ++ (if build then " and build" else "") ++ (if length unmerged > 1 then "; or give a ref to merge" else "") ++ "; or 'no' to skip merge" -- ensure still on same branch! gitSwitchBranch (RelBranch br)@@ -67,3 +65,17 @@ Nothing -> show newerBr Just hash -> hash git_ "merge" ["--quiet", ref]+mergeBranch build noprompt (False,unmerged) br = do+ putStrLn "Branch is not directly mergeable:"+ mapM_ putStrLn unmerged+ unpushed <- gitShortLog $ "origin/" ++ show br ++ "..HEAD"+ unless (null unpushed) $ do+ putStrLn "Local commits:"+ mapM_ putStrLn unpushed+ mmerge <-+ if noprompt then return Nothing+ else conflictPrompt unmerged $ "Press Enter to skip merge" ++ (if build then " and build" else "") ++ "; or give a ref to attempt merge"+ -- ensure still on same branch!+ gitSwitchBranch (RelBranch br)+ whenJust mmerge $ \ ref ->+ git_ "merge" [ref]
src/Cmd/Override.hs view
@@ -23,14 +23,11 @@ let spec = packageSpec pkg nvr <- pkgNameVerRel' br spec putStrLn nvr- mtags <- kojiNVRTags nvr- case mtags of- Nothing -> error' $ nvr ++ " is untagged"- Just tags ->- unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $- unlessM (checkAutoBodhiUpdate br) $- if dryrun- then putStrLn $ "override " ++ nvr- else do- bodhiCreateOverride nvr- kojiWaitRepo (branchTarget br) nvr+ tags <- kojiNVRTags nvr+ unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $+ unlessM (checkAutoBodhiUpdate br) $+ if dryrun+ then putStrLn $ "override " ++ nvr+ else do+ bodhiCreateOverride nvr+ kojiWaitRepo (branchTarget br) nvr
src/Cmd/Parallel.hs view
@@ -86,7 +86,7 @@ setupBranch :: Branch -> IO Job setupBranch br = do job <- startBuild False br "." >>= async- sleep 5+ unless dryrun $ sleep 5 return (show br,job) parallelBuild :: Branch -> [String] -> IO String@@ -108,7 +108,7 @@ setupBuild :: String -> IO Job setupBuild pkg = do job <- startBuild (nopkgs > 5) br pkg >>= async- sleep 5+ unless dryrun $ sleep 5 return (pkg,job) watchJobs :: Maybe String -> [String] -> [Job] -> IO ([String],Maybe String)@@ -136,7 +136,7 @@ putPkgBrnchHdr pkg br unpushed <- gitShortLog $ "origin/" ++ show br ++ "..HEAD" unless (null unpushed) $- mapM_ (putStrLn . simplifyCommitLog) unpushed+ mapM_ putStrLn unpushed let spec = packageSpec pkg checkForSpecFile spec unless (null unpushed) $ do@@ -167,13 +167,10 @@ Just BuildComplete -> do putStrLn $ nvr ++ " is " ++ color Green "already built" when (br /= Rawhide && target == branchTarget br) $ do- mtags <- kojiNVRTags nvr- case mtags of- Nothing -> error' $ nvr ++ " is untagged"- Just tags ->- unless (dryrun || any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $- unlessM (checkAutoBodhiUpdate br) $- bodhiCreateOverride nvr+ tags <- kojiNVRTags nvr+ unless (dryrun || any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $+ unlessM (checkAutoBodhiUpdate br) $+ bodhiCreateOverride nvr return $ do unless dryrun $ kojiWaitRepo target nvr
src/Cmd/PkgReview.hs view
@@ -23,8 +23,8 @@ -- FIXME add --dependent pkgreview -- FIXME reference existing/previous scratch build createReview :: Bool -> Bool -> [FilePath] -> IO ()-createReview noscratch mock pkgs =- withPackageByBranches (Just True) Nothing Nothing True AnyNumber createPkgReview ("master":pkgs)+createReview noscratch mock =+ withPackageByBranches (Just True) Nothing Nothing True Zero createPkgReview where createPkgReview :: Package -> AnyBranch -> IO () createPkgReview package _br = do
src/Cmd/RequestRepo.hs view
@@ -45,10 +45,11 @@ -- show comments? requests <- existingRepoRequests unless (null requests) $ do- putStrLn "Request exists:"- mapM_ printScmIssue requests- when (retry && pagureIssueCloseStatus (head requests) == Just "Processed") $- error' "The last repo request was already successfully Processed"+ putStrLn "Request exists:"+ mapM_ printScmIssue requests+ -- don't retry if succeeded+ when (retry && pagureIssueCloseStatus (head requests) == Just "Processed") $+ error' "The last repo request was already successfully Processed" when (null requests || retry) $ do checkNoPagureRepo url <- fedpkg "request-repo" [pkg, show bid]@@ -62,9 +63,11 @@ let comment = (if null input then draft else input) ++ "\n\n" <> url commentBug session bid comment putStrLn ""- branches <- getRequestedBranches mbrnchopts []+ brs <- branchingPrompt+ branches <- getRequestedBranches mbrnchopts brs forM_ branches $ \ br ->- fedpkg "request-branch" ["--repo", pkg, show br]+ putStr (show br ++ " ") >>+ fedpkg_ "request-branch" ["--repo", pkg, show br] where existingRepoRequests :: IO [IssueTitleStatus] existingRepoRequests = do
src/Cmd/Scratch.hs view
@@ -13,7 +13,7 @@ data Archs = Archs [String] | ExcludedArchs [String] --- FIXME default to rawhide/master?+-- FIXME default to rawhide/main? -- FIXME build from a specific git ref -- FIXME print message about uploading srpm scratchCmd :: Bool -> Bool -> Bool -> Maybe Archs -> Maybe String -> [String]@@ -45,9 +45,8 @@ else return False putStrLn $ "koji scratch " ++ (if pushed then "" else "srpm ") ++ "build for " ++ target unless dryrun $ do- if pushed then do- void $ getSources spec- kojiBuildBranch target pkg Nothing $ "--scratch" : kojiargs+ if pushed+ then kojiBuildBranch target pkg Nothing $ "--scratch" : kojiargs else srpmBuild target kojiargs spec else srpmBuild target kojiargs spec where
src/Cmd/Status.hs view
@@ -48,7 +48,7 @@ Nothing -> do putStrLn "undefined NVR!\n" putStr "HEAD "- gitShortLog1 Nothing >>= putStrLn . simplifyCommitLog+ gitShortLog1 Nothing >>= putStrLn Just nvr -> do -- unless (br == Rawhide) $ do -- newerBr <- newerBranch br <$> getFedoraBranches@@ -57,7 +57,7 @@ -- unmerged <- gitShortLog $ "HEAD.." ++ show newerBr -- unless (null unmerged) $ do -- putStrLn $ "Newer commits in " ++ show newerBr ++ ":"- -- mapM_ (putStrLn . simplifyCommitLog) unmerged+ -- mapM_ putStrLn unmerged unpushed <- gitShortLog1 $ Just $ "origin/" ++ show br ++ "..HEAD" if null unpushed then do mbuild <- kojiGetBuildID fedoraHub nvr@@ -97,7 +97,7 @@ putAge diff _ -> putStrLn "More than one update found!" putStrLn ""- else putStrLn $ show br ++ ": " ++ simplifyCommitLog unpushed+ else putStrLn $ show br ++ ": " ++ unpushed where isStable :: [String] -> Bool isStable = not . all ("-testing" `isSuffixOf`)
src/Git.hs view
@@ -13,7 +13,6 @@ gitShortLogN, gitShortLog1, gitSwitchBranch,- simplifyCommitLog, -- checkIsPkgGitDir, isGitRepo, isPkgGitRepo,@@ -39,31 +38,33 @@ cmdBool "git" (c:args) #endif -gitMergeable :: String -> IO [String]+gitMergeable :: String -> IO (Bool,[String]) gitMergeable ref = do ancestor <- gitBool "merge-base" ["--is-ancestor", "HEAD", ref]- if ancestor then gitShortLog $ "HEAD.." ++ ref- else return []+ commits <- gitShortLog ("HEAD.." ++ ref)+ return (ancestor, commits) gitMergeOrigin :: AnyBranch -> IO () gitMergeOrigin br = do- commits <- gitMergeable $ "origin" </> show br- unless (null commits) $ do+ (ancestor,commits) <- gitMergeable $ "origin" </> show br+ if ancestor then+ unless (null commits) $ do rebase <- git "rebase" [] unless ("Already up to date." `isPrefixOf` rebase) $ putStr rebase+ else git_ "rebase" [] gitShortLog :: String -> IO [String] gitShortLog range =- gitLines "log" ["--pretty=reference", range]+ map simplifyCommitLog <$> gitLines "log" ["--pretty=reference", range] gitShortLogN :: Int -> Maybe String -> IO [String] gitShortLogN num mrange =- gitLines "log" (["--max-count=" ++ show num, "--pretty=reference"] ++ maybeToList mrange)+ map simplifyCommitLog <$> gitLines "log" (["--max-count=" ++ show num, "--pretty=reference"] ++ maybeToList mrange) gitShortLog1 :: Maybe String -> IO String gitShortLog1 mrange =- git "log" (["--max-count=1", "--pretty=reference"] ++ maybeToList mrange)+ simplifyCommitLog <$> git "log" (["--max-count=1", "--pretty=reference"] ++ maybeToList mrange) -- FIXME currently no-op with --format=reference simplifyCommitLog :: String -> String
src/Koji.hs view
@@ -26,8 +26,11 @@ import Data.Char (isDigit) import Control.Concurrent (threadDelay)+import qualified Data.ByteString.Lazy.Char8 as B import Fedora.Koji import qualified Fedora.Koji.Internal as Koji+import System.Exit+import System.Process.Typed import Branches import Common@@ -36,16 +39,17 @@ import Krb import Package import Pagure+import Prompt fedoraHub :: String fedoraHub = fedoraKojiHub -kojiNVRTags :: String -> IO (Maybe [String])+kojiNVRTags :: String -> IO [String] kojiNVRTags nvr = do mbldid <- kojiGetBuildID fedoraHub nvr case mbldid of- Nothing -> return Nothing- Just bldid -> Just <$> kojiBuildTags fedoraHub (buildIDInfo bldid)+ Nothing -> error' $ nvr ++ " koji build not found"+ Just bldid -> kojiBuildTags fedoraHub (buildIDInfo bldid) kojiBuildStatus :: String -> IO (Maybe BuildState) kojiBuildStatus nvr =@@ -83,9 +87,7 @@ type KojiBuildTask = Either TaskID String --- FIXME can fail like:--- [ERROR] koji: AuthError: unable to obtain a session--- readCreateProcess: koji "build" "--nowait" "f33-build-side-25385" "--fail-fast" "--background" ... (exit 1): failed+-- FIXME setTermTitle nvr kojiBuild' :: Bool -> String -> [String] -> IO KojiBuildTask kojiBuild' wait target args = do krbTicket@@ -95,18 +97,25 @@ else ".src.rpm" `isSuffixOf` last args -- FIXME use tee functionality when srpm $ putStrLn "koji srpm build uploading..."- -- FIXME setTermTitle nvr- out <- cmd "koji" $ ["build", "--nowait", target] ++ args- putStrLn $ if srpm+ -- can fail like:+ -- [ERROR] koji: Request error: POST::https://koji.fedoraproject.org/kojihub/ssllogin::<PreparedRequest [POST]>+ -- [ERROR] koji: AuthError: unable to obtain a session+ -- readCreateProcess: koji "build" "--nowait" "f33-build-side-25385" "--fail-fast" "--background" ... (exit 1): failed+ (ret,out) <- readProcessStdout $ proc "koji" $ ["build", "--nowait", target] ++ args+ B.putStrLn $ if srpm -- drop uploading line until doing tee- then (unlines . tail . lines) out+ then (B.unlines . tail . B.lines) out else out- let kojiurl = last $ words out- task = (TaskId . read) $ takeWhileEnd isDigit kojiurl- when wait $ do- kojiWatchTask task- cmd_ "date" []- return $ if wait then Right kojiurl else Left task+ if ret == ExitSuccess then do+ let kojiurl = B.unpack $ last $ B.words out+ task = (TaskId . read) $ takeWhileEnd isDigit kojiurl+ when wait $ do+ kojiWatchTask task+ cmd_ "date" []+ return $ if wait then Right kojiurl else Left task+ else do+ prompt_ "Press Enter to resubmit Koji build"+ kojiBuild' wait target args -- kojiBuild :: String -> [String] -> IO String -- kojiBuild target args = do
src/Main.hs view
@@ -55,7 +55,7 @@ , Subcommand "status" "Status package/branch status" $ statusCmd <$> switchWith 'n' "no-fetch" "Do not git fetch to save time" <*> switchWith 'r' "reviews" "Status of reviewed packages" <*> branchesOpt <*> branchesPackages , Subcommand "merge" "Merge from newer branch" $- mergeCmd <$> branchesPackages+ mergeCmd <$> nopromptOpt <*> branchesPackages , Subcommand "build" "Build package(s) in Koji" $ buildCmd <$> buildOpts <*> branchesOpt <*> branchesPackages , Subcommand "list" "List packages in pagure" $@@ -79,7 +79,7 @@ , Subcommand "local" "Build locally" $ localCmd <$> optional forceshortOpt <*> many bcondOpt <*> branchesPackages , Subcommand "srpm" "Build srpm" $- srpmCmd <$> branchesPackages+ srpmCmd <$> switchWith 'f' "force" "regenerate even if spec older than existing srpm" <*> branchesPackages , Subcommand "diff" "Diff local changes" $ diffCmd <$> diffSpecOnly <*> diffWorkOpt <*> diffFormatOpt <*> diffBranchOpt <*> branchesPackages , Subcommand "log" "Show commits between branches" $@@ -91,6 +91,8 @@ , Subcommand "install" "Build locally and install package(s)" $ -- FIXME drop --shortcircuit from install? installCmd <$> switchWith 'r' "recurse" "build and install missing deps packages" <*> optional forceshortOpt <*> many bcondOpt <*> switchWith 'r' "reinstall" "reinstall rpms" <*> branchesPackages+ , Subcommand "not-installed" "Packages not installed locally" $+ notInstalledCmd <$> branchesPackages , Subcommand "bugs" "List package bugs" $ bugsCmd <$> optional (strOptionWith 's' "summary" "KEY" "Search for bugs containing keyword") <*> many (pkgArg "PACKAGE...") , Subcommand "bump" "Bump release for package" $@@ -100,17 +102,17 @@ , Subcommand "pull" "Git pull packages" $ pullPkgs <$> branchesPackages , Subcommand "create-review" "Create a Package Review request" $- createReview <$> noScratchBuild <*> mockOpt <*> many (pkgArg "PACKAGE...")+ createReview <$> noScratchBuild <*> mockOpt False <*> many (pkgArg "PACKAGE...") , Subcommand "update-review" "Update a Package Review" $- updateReview <$> noScratchBuild <*> mockOpt <*> optional (strArg "SPECFILE")+ updateReview <$> noScratchBuild <*> mockOpt False <*> optional (strArg "SPECFILE") , Subcommand "reviews" "List package reviews" $ reviewsCmd <$> reviewShortOpt <*> reviewAllStatusOpt <*> switchWith 'T' "assigned-to" "List reviews assigned to user" <*> optional (strOptionWith 'U' "user" "USER" "Bugzilla user email") <*> reviewStatusOpt , Subcommand "request-repos" "Request dist git repo for new approved packages" $ requestRepos <$> reviewAllStatusOpt <*> switchWith 'r' "retry" "Re-request repo" <*> branchesOpt <*> many (pkgArg "NEWPACKAGE...") , Subcommand "import" "Import new approved created packages from bugzilla review" $- importCmd <$> many (pkgArg "NEWPACKAGE...")+ importCmd <$> mockOpt True <*> many (pkgArg "NEWPACKAGE...") , Subcommand "request-branches" "Request branches for approved created packages" $- requestBranches <$> mockOpt <*> optional branchesRequestOpt <*> branchesPackages+ requestBranches <$> mockOpt False <*> optional branchesRequestOpt <*> branchesPackages , Subcommand "find-review" "Find package review bug" $ findReview <$> pkgArg "PACKAGE" , Subcommand "review-package" "Run fedora-review on a package Review Request bug" $@@ -118,11 +120,11 @@ -- , Subcommand "test-bz-token" "Check bugzilla login status" $ -- pure testBZlogin , Subcommand "command" "Run shell command in package dirs ($p)" $- commandCmd <$> commandOpt <*> branchesOpt <*> branchesPackages+ commandCmd <$> switchWith 'o' "if-output" "only print if output" <*> commandOpt <*> branchesOpt <*> branchesPackages , Subcommand "copr" "Build package(s) in Fedora Copr" $ coprCmd <$> dryrunOpt <*> buildByOpt <*> many archOpt <*> pkgArg "PROJECT" <*> branchesOpt <*> branchesPackages- , Subcommand "master-rename" "Rename local master branch to rawhide" $- masterRenameCmd <$> many (pkgArg "[PACKAGE]...")+ , Subcommand "rename-master" "Rename local master branch to rawhide" $+ renameMasterCmd <$> many (pkgArg "[PACKAGE]...") ] where cloneRequest :: Parser CloneRequest@@ -187,7 +189,7 @@ RpmWith <$> strOptionWith 'w' "with" "BCOND" "rpmspec --with option" <|> RpmWithout <$> strOptionWith 'W' "without" "BCOND" "rpmspec --without option" - mockOpt = switchWith 'm' "mock" "Do mock build to test"+ mockOpt brs = switchWith 'm' "mock" $ "Do mock build to test" ++ if brs then " branches" else "" archOpt :: Parser String archOpt = strOptionWith 'a' "arch" "ARCH[,ARCH].." "build for arch(s)"
src/Package.hs view
@@ -14,6 +14,7 @@ findSpecfile, localBranchSpecFile, generateSrpm,+ generateSrpm', BCond(..), ForceShort(..), buildRPMs,@@ -140,11 +141,7 @@ gitdir <- isPkgGitRepo if gitdir then do- putPkgAnyBrnchHdr pkg br gitSwitchBranch br- else putPkgHdr pkg- if gitdir- then do let spec = packageSpec pkg ifM (doesFileExist spec) (return spec) $@@ -163,7 +160,10 @@ return $ if null res || res == s then Nothing else Just res generateSrpm :: Maybe AnyBranch -> FilePath -> IO FilePath-generateSrpm mbr spec = do+generateSrpm = generateSrpm' False++generateSrpm' :: Bool -> Maybe AnyBranch -> FilePath -> IO FilePath+generateSrpm' force mbr spec = do getSources spec distopt <- case mbr of Nothing -> return []@@ -184,17 +184,22 @@ rpmEval "%{_sourcedir}" >>= maybe (error' "%_sourcedir undefined!") return let sourcediropt = if null sourcedir then [] else ["--define", "_sourcedir " ++ sourcedir]- ifM (notM $ doesFileExist srpm)- (buildSrpm (distopt ++ srpmdiropt ++ sourcediropt)) $- do- specTime <- getModificationTime spec- srpmTime <- getModificationTime srpm- if srpmTime > specTime- then do- -- pretty print with ~/- putStrLn $ srpm ++ " is up to date"- return srpm- else buildSrpm (distopt ++ srpmdiropt ++ sourcediropt)+ if force then+ buildSrpm (distopt ++ srpmdiropt ++ sourcediropt)+ else do+ exists <- doesFileExist srpm+ if not exists+ then buildSrpm (distopt ++ srpmdiropt ++ sourcediropt)+ else do+ -- FIXME also compare source tarball timestamps+ specTime <- getModificationTime spec+ srpmTime <- getModificationTime srpm+ if srpmTime > specTime+ then do+ -- pretty print with ~/+ putStrLn $ srpm ++ " is up to date"+ return srpm+ else buildSrpm (distopt ++ srpmdiropt ++ sourcediropt) where buildSrpm opts = do srpm <- last . words <$> cmd "rpmbuild" (opts ++ ["-bs", spec])@@ -212,6 +217,7 @@ -- FIXME create build.log -- Note does not check if bcond changed+-- FIXME check tarball timestamp buildRPMs :: Bool -> Maybe ForceShort -> [BCond] -> [FilePath] -> AnyBranch -> FilePath -> IO () buildRPMs quiet mforceshort bconds rpms br spec = do@@ -438,7 +444,7 @@ dirtyGit = Just $ GitOpts False False False dirtyGitFetch = Just $ GitOpts False True False -data LimitBranches = AnyNumber | ZeroOrOne | ExactlyOne+data LimitBranches = AnyNumber | Zero | ZeroOrOne | ExactlyOne deriving Eq -- do package over branches@@ -476,6 +482,8 @@ error' "cannot specify branches and branch option together" Nothing -> case limitBranches of+ Zero | not (null brs) ->+ error' $ "package not found: " ++ unwords (map show brs) ZeroOrOne | length brs > 1 -> -- FIXME: could be handled better (testcase: run long list of packages in wrong directory) error' $ "more than one branch given or packages not found: " ++ unwords (tail (map show brs))@@ -510,7 +518,6 @@ -- For now assume spec filename = package name Just spec -> return $ takeBaseName spec Nothing -> getDirectoryName- unless (isNothing mspec || mspec == Just (unPackage pkg <.> "spec")) $ putStrLn "Warning: package name and spec filename differ!" haveGit <- isPkgGitRepo@@ -519,15 +526,21 @@ mcurrentbranch <- if haveGit then Just <$> gitCurrentBranch else return Nothing let fetch = have gitOptFetch- when ((mheader == Just True || isJust mheader && max (length brs) (length pkgs) > 1 || fetch) && dir /= ".") $- putPkgHdr pkg+ when ((isJust mheader || fetch) && dir /= ".") $+ case brs of+ [br] -> when (fetch || mheader == Just True) $ putPkgAnyBrnchHdr pkg br+ _ -> when (fetch || isJust mheader) $ putPkgHdr pkg when haveGit $ when (have gitOptClean) checkWorkingDirClean- when fetch gitFetchSilent+ when fetch $ gitFetchSilent >> putStrLn "" branches <- listOfBranches haveGit (have gitOptActive) mbrnchopts brs when (mbrnchopts == Just AllBranches) $ putStrLn $ "Branches: " ++ unwords (map show branches) ++ "\n"- mapM_ (action pkg) branches+ -- FIXME add newline at end?+ let action' p b = do+ when (isJust mheader && length brs > 1) $ putPkgAnyBrnchHdr p b+ action p b+ mapM_ (action' pkg) branches when (length branches /= 1) $ whenJust mcurrentbranch gitSwitchBranch @@ -556,9 +569,12 @@ Nothing -> [] Just br -> ["--branch", show br] fasid <- fasIdFromKrb- unless quiet $- putStr $ pkg ++ " "+ putStr $+ if quiet+ then "cloning..."+ else "Cloning: " ++ pkg git_ "clone" $ ["--quiet"] ++ mbranch ++ ["ssh://" ++ fasid ++ "@pkgs.fedoraproject.org/rpms/" ++ pkg]+ putStrLn "" pkgNameVerRel :: Branch -> FilePath -> IO (Maybe String) pkgNameVerRel br spec = do
src/Prompt.hs view
@@ -1,7 +1,8 @@ module Prompt ( prompt, prompt_,- refPrompt+ refPrompt,+ conflictPrompt ) where import Common@@ -23,9 +24,18 @@ refPrompt :: [String] -> String -> IO (Maybe (Maybe String)) refPrompt commits txt = do let commitrefs = tail $ map (head . words) commits- inp <- prompt txt- if null inp then return (Just Nothing) else- if map toLower inp == "no" then return Nothing- else case find (inp `isPrefixOf`) commitrefs of- Just ref -> return $ Just (Just ref)- Nothing -> refPrompt commits txt+ ref <- prompt txt+ if null ref then return (Just Nothing) else+ if map toLower ref == "no" then return Nothing+ else if ref `elem` commitrefs+ then return $ Just (Just ref)+ else refPrompt commits txt++conflictPrompt :: [String] -> String -> IO (Maybe String)+conflictPrompt commits txt = do+ let commitrefs = tail $ map (head . words) commits+ ref <- prompt txt+ if null ref then return Nothing+ else if ref `elem` commitrefs+ then return $ Just ref+ else conflictPrompt commits txt