diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/fbrnch.cabal b/fbrnch.cabal --- a/fbrnch.cabal +++ b/fbrnch.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: fbrnch -version: 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, diff --git a/src/Bodhi.hs b/src/Bodhi.hs --- a/src/Bodhi.hs +++ b/src/Bodhi.hs @@ -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 diff --git a/src/Branches.hs b/src/Branches.hs --- a/src/Branches.hs +++ b/src/Branches.hs @@ -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 diff --git a/src/Bugzilla.hs b/src/Bugzilla.hs --- a/src/Bugzilla.hs +++ b/src/Bugzilla.hs @@ -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 diff --git a/src/Cmd/Build.hs b/src/Cmd/Build.hs --- a/src/Cmd/Build.hs +++ b/src/Cmd/Build.hs @@ -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 diff --git a/src/Cmd/Bump.hs b/src/Cmd/Bump.hs --- a/src/Cmd/Bump.hs +++ b/src/Cmd/Bump.hs @@ -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 diff --git a/src/Cmd/Clone.hs b/src/Cmd/Clone.hs --- a/src/Cmd/Clone.hs +++ b/src/Cmd/Clone.hs @@ -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 "" diff --git a/src/Cmd/Import.hs b/src/Cmd/Import.hs --- a/src/Cmd/Import.hs +++ b/src/Cmd/Import.hs @@ -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 diff --git a/src/Cmd/Install.hs b/src/Cmd/Install.hs --- a/src/Cmd/Install.hs +++ b/src/Cmd/Install.hs @@ -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 diff --git a/src/Cmd/Local.hs b/src/Cmd/Local.hs --- a/src/Cmd/Local.hs +++ b/src/Cmd/Local.hs @@ -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"] diff --git a/src/Cmd/Merge.hs b/src/Cmd/Merge.hs --- a/src/Cmd/Merge.hs +++ b/src/Cmd/Merge.hs @@ -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] diff --git a/src/Cmd/Override.hs b/src/Cmd/Override.hs --- a/src/Cmd/Override.hs +++ b/src/Cmd/Override.hs @@ -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 diff --git a/src/Cmd/Parallel.hs b/src/Cmd/Parallel.hs --- a/src/Cmd/Parallel.hs +++ b/src/Cmd/Parallel.hs @@ -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 diff --git a/src/Cmd/PkgReview.hs b/src/Cmd/PkgReview.hs --- a/src/Cmd/PkgReview.hs +++ b/src/Cmd/PkgReview.hs @@ -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 diff --git a/src/Cmd/RequestRepo.hs b/src/Cmd/RequestRepo.hs --- a/src/Cmd/RequestRepo.hs +++ b/src/Cmd/RequestRepo.hs @@ -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 diff --git a/src/Cmd/Scratch.hs b/src/Cmd/Scratch.hs --- a/src/Cmd/Scratch.hs +++ b/src/Cmd/Scratch.hs @@ -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 diff --git a/src/Cmd/Status.hs b/src/Cmd/Status.hs --- a/src/Cmd/Status.hs +++ b/src/Cmd/Status.hs @@ -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`) diff --git a/src/Git.hs b/src/Git.hs --- a/src/Git.hs +++ b/src/Git.hs @@ -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 diff --git a/src/Koji.hs b/src/Koji.hs --- a/src/Koji.hs +++ b/src/Koji.hs @@ -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:: + -- [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 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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)" diff --git a/src/Package.hs b/src/Package.hs --- a/src/Package.hs +++ b/src/Package.hs @@ -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 diff --git a/src/Prompt.hs b/src/Prompt.hs --- a/src/Prompt.hs +++ b/src/Prompt.hs @@ -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