fbrnch 1.6.1 → 1.6.2
raw patch · 27 files changed
+306/−187 lines, 27 filesdep +fedora-krb
Dependencies added: fedora-krb
Files
- CHANGELOG.md +21/−0
- README.md +6/−6
- fbrnch.cabal +4/−4
- src/Cmd/Autospec.hs +23/−4
- src/Cmd/Build.hs +5/−5
- src/Cmd/Clone.hs +1/−1
- src/Cmd/CreateReview.hs +1/−1
- src/Cmd/Diff.hs +8/−11
- src/Cmd/Fetch.hs +13/−7
- src/Cmd/Import.hs +1/−1
- src/Cmd/Local.hs +14/−4
- src/Cmd/Override.hs +2/−2
- src/Cmd/Parallel.hs +10/−10
- src/Cmd/RequestBranch.hs +13/−1
- src/Cmd/RequestRepo.hs +4/−2
- src/Cmd/ReviewPackage.hs +1/−1
- src/Cmd/Scratch.hs +1/−1
- src/Cmd/SideTags.hs +9/−2
- src/Cmd/Update.hs +32/−27
- src/Cmd/WaitRepo.hs +4/−7
- src/Git.hs +5/−2
- src/Koji.hs +33/−13
- src/Krb.hs +0/−43
- src/Main.hs +21/−16
- src/Package.hs +13/−6
- src/PkgReview.hs +1/−1
- src/RpmBuild.hs +60/−9
CHANGELOG.md view
@@ -1,5 +1,26 @@ # Changelog +## 1.6.2 (2025-03-05)+- 'diff': use git diff's builtin filtering+- 'fetch': add --lenient to skip non dist-git directories+- 'local': --detached-head+- 'parallel': do not waitrepo for final layer+- 'parallel': koji-tool tail of failed builds and end with task url+- 'parallel': only print "parallel layer" is more than one pkg in layer+- 'request-branches': now waits for package to be listed for branch buildtag+- 'request-branches': wait 30s before checking for package added to tag+- 'request-repos': error if no reviews found+- 'sidetags': --tagged lists tagged builds+- 'unautospec': new command to remove %autochangelog and/or %autorelease+- 'update-sources': now takes optional version, replacing 'update-version'+- 'waitrepo': use kojiWaitRepoNVR output and timing+- kojiWatchTask: print task url after failure log+- Krb module replaced by fedora-krb library: handles different FAS userid (#67)+- rename --allow-head to --detached-head+- targetMaybeSidetag: strict parameter to enforce branch tag match+- targetMaybeSidetag: warn/prompt if target does not match branch+- withPackagesByBranches: print package header earlier before fetching+ ## 1.6.1 (2024-12-17) - 'build','parallel': waitrepo now just uses "koji wait-repo --request" - 'build': now respects --waitrepo
README.md view
@@ -39,7 +39,7 @@ One can change the branch of one or more packages: ```-$ fbrnch switch f41 [package] ...+$ fbrnch switch f42 [package] ... ``` You can also git pull over packages:@@ -97,13 +97,13 @@ You can merge branches with: ```-$ fbrnch merge f40 [package]+$ fbrnch merge f41 [package] ```-which will offer to merge f41 (or up to a git hash you choose) into f40.+which will offer to merge f42 (or up to a git hash you choose) into f41. Merging can also be done together with building: ```-$ fbrnch build f41 [package]+$ fbrnch build f42 [package] ``` will ask if you want to merge newer commits from a newer branch, then push and build it.@@ -270,7 +270,7 @@ `$ fbrnch --version` ```-1.6.1+1.6.2 ``` `$ fbrnch --help`@@ -306,7 +306,6 @@ scratch-aarch64 Koji aarch64 scratch build of package scratch-x86_64 Koji x86_64 scratch build of package update-sources Download and update newer sources- update-version Update package in dist-git to newer version sort Sort packages in build dependency order (default format: chain-build) prep Prep sources@@ -344,6 +343,7 @@ graph Output dependency graph ftbfs Check FTBFS status autospec Convert package to use rpmautospec+ unautospec Unconvert rpmautospec package move-artifacts Move old rpm artifacts into rpmbuild dirs ```
fbrnch.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: fbrnch-version: 1.6.1+version: 1.6.2 synopsis: Fedora packager tool to build package branches description: fbrnch (fedora branch or "f-branch" for short) is@@ -28,14 +28,14 @@ license-file: LICENSE author: Jens Petersen <petersen@redhat.com> maintainer: Jens Petersen <petersen@fedoraproject.org>-copyright: 2019-2024 Jens Petersen+copyright: 2019-2025 Jens Petersen category: Distribution build-type: Simple extra-doc-files: CHANGELOG.md README.md tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.8,- GHC == 9.4.8, GHC == 9.6.5, GHC == 9.8.2+ GHC == 9.4.8, GHC == 9.6.6, GHC == 9.8.4, GHC == 9.10.1 source-repository head type: git@@ -93,7 +93,6 @@ Git InterleaveOutput Koji- Krb ListReviews Package Pagure@@ -120,6 +119,7 @@ either, email-validate, extra,+ fedora-krb, fedora-releases >= 0.2, filepath, http-conduit,
src/Cmd/Autospec.hs view
@@ -1,17 +1,18 @@ module Cmd.Autospec (- autospecCmd+ autospecCmd,+ unautospecCmd ) where -import Control.Monad.Extra (unlessM)+import Control.Monad.Extra (unlessM, when) import SimpleCmd (cmd, cmd_)-import System.Directory (doesFileExist)+import System.Directory (doesFileExist, removeFile) import Branches import Git import Package --- FIXME calculate baserelease+-- FIXME! calculate baserelease: calculate bumped release and count back to last version bump commit autospecCmd :: Bool -> [String] -> IO () autospecCmd force pkgs = withPackagesByBranches HeaderMay False cleanGitFetchActive ExactlyOne autospecPkg (Branches [Rawhide], pkgs)@@ -32,3 +33,21 @@ git_ "commit" ["-m", "Refresh changelog"] else putStrLn "'changelog' file already exists" else cmd_ "rpmautospec" ["convert"]++unautospecCmd :: (BranchesReq, [String]) -> IO ()+unautospecCmd =+ withPackagesByBranches HeaderMay False cleanGitFetchActive ExactlyOne unautospecPkg+ where+ unautospecPkg :: Package -> AnyBranch -> IO ()+ unautospecPkg pkg br = do+ spec <- localBranchSpecFile pkg br+ autorelease <- isAutoRelease spec+ autochange <- isAutoChangelog spec+ when autochange $ do+ changelog <- cmd "rpmautospec" ["generate-changelog", spec]+ cmd_ "sed" ["-i", "/%autochangelog/d", spec]+ appendFile spec $ "%changelog\n" ++ changelog ++ "\n"+ removeFile "changelog"+ when autorelease $ do+ release <- calculateRelease spec+ cmd_ "sed" ["-i", "s/%autorelease/" ++ release ++ "%{?dist}/", spec]
src/Cmd/Build.hs view
@@ -6,6 +6,7 @@ ) where import Distribution.Fedora.Branch (branchDestTag)+import Fedora.Krb (krbTicket) import SimplePrompt (promptEnter, yesNo) import Bodhi@@ -15,7 +16,6 @@ import Common.System import Cmd.Merge import Git-import Krb import Koji import Package import RpmBuild (checkSourcesMatch)@@ -125,7 +125,7 @@ then refPrompt unpushed $ "Press Enter to push and build" ++ (if length unpushed > 1 then "; or give ref to push" else "") ++ (if not newrepo then "; or 'no' to skip pushing" else "") else return $ Just $ commitRef unpd let msidetagTarget = buildoptSidetagTarget opts- target <- targetMaybeSidetag dryrun True br msidetagTarget+ target <- targetMaybeSidetag dryrun True True br msidetagTarget buildRun spec nvr merged mpush unpushed target msidetagTarget moverride where dryrun = buildoptDryrun opts@@ -156,10 +156,10 @@ when (isJust mlastpkg && mlastpkg /= Just pkg || mwaitrepo == Just True) $ when ((isJust moverride && mwaitrepo /= Just False) || (mwaitrepo == Just True)) $- kojiWaitRepoNVR dryrun False True target nvr+ kojiWaitRepoNVR dryrun False target nvr else when (mwaitrepo == Just True) $- kojiWaitRepoNVR dryrun False True target nvr+ kojiWaitRepoNVR dryrun False target nvr Just BuildBuilding -> do putStrLn $ showNVR nvr +-+ "is already building" when (isJust mpush) $@@ -239,4 +239,4 @@ when (isJust mlastpkg && mlastpkg /= Just pkg || mwaitrepo == Just True) $ when ((isJust moverride && mwaitrepo /= Just False) || (mwaitrepo == Just True)) $- kojiWaitRepoNVR dryrun False True target nvr+ kojiWaitRepoNVR dryrun False target nvr
src/Cmd/Clone.hs view
@@ -1,11 +1,11 @@ module Cmd.Clone (cloneCmd, CloneRequest(..)) where import Control.Monad (when)+import Fedora.Krb import Branches import Common.System import qualified Common.Text as T-import Krb import Package import Pagure
src/Cmd/CreateReview.hs view
@@ -4,6 +4,7 @@ where import Data.Char (isAscii)+import Fedora.Krb (maybeFasIdFromKrb) import SimpleCmd (cmd, error') import SimplePrompt (promptEnter) import System.Directory (doesFileExist)@@ -11,7 +12,6 @@ import Branches import Bugzilla import Common-import Krb import Package import PkgReview import RpmBuild
src/Cmd/Diff.hs view
@@ -26,6 +26,10 @@ -- | DiffRegex String | DiffNotRegex String deriving Eq +filterOpt :: DiffFilter -> [String]+filterOpt (DiffMatch m) = ["-G", m]+filterOpt (DiffNotMatch m) = ["-I", m]+ -- FIXME diff other branches without switching -- FIXME --older/--newer branch diffCmd :: Bool -> Bool -> DiffWork -> DiffFormat -> Bool -> [DiffFilter]@@ -90,8 +94,10 @@ Just wbr -> case (wbr,br) of (RelBranch rwbr, RelBranch rbr) -> ["-R" | rwbr > rbr] _ -> []- diff <- gitLines "diff" $ contxt ++ workOpts ++ revdiff ++ withBranch ++ workArgs ++ file- let diffout = (mapMaybe (filterPatterns patts) . simplifyDiff fmt) diff+ filterOpts =+ concatMap filterOpt patts+ diff <- gitLines "diff" $ contxt ++ workOpts ++ revdiff ++ withBranch ++ filterOpts ++ workArgs ++ file+ let diffout = simplifyDiff fmt diff -- FIXME: sometimes we may want to list even if diff but no diffout unless (null diffout) $ unless (ignorebumps && isTrivialRebuildCommit diffout) $@@ -106,12 +112,3 @@ -- drop "2 files changed, 113 insertions(+)" simplifyDiff DiffStats ds = if null ds then ds else init ds simplifyDiff _ ds = ds-- filterPatterns :: [DiffFilter] -> String -> Maybe String- filterPatterns [] str = Just str- filterPatterns (df:dfs) str =- if filterPattern df str then filterPatterns dfs str else Nothing-- filterPattern :: DiffFilter -> String -> Bool- filterPattern (DiffMatch patt) = (patt `isInfixOf`)- filterPattern (DiffNotMatch patt) = not . (patt `isInfixOf`)
src/Cmd/Fetch.hs view
@@ -4,18 +4,24 @@ where import Branches+import Common (when, (+-+)) import Git import Package -fetchPkgs :: [String] -> IO ()-fetchPkgs args =+fetchPkgs :: Bool -> [String] -> IO ()+fetchPkgs lenient args = withPackagesByBranches (if length args > 1 then HeaderMust else HeaderMay) False- dirtyGit+ (if lenient then Nothing else dirtyGitFetch) Zero- fetchPkg (Branches [],args)+ fetchPkgLenient+ (Branches [], args) where- fetchPkg :: Package -> AnyBranch -> IO ()- fetchPkg _pkg _br =- gitFetchSilent False+ fetchPkgLenient :: Package -> AnyBranch -> IO ()+ fetchPkgLenient pkg _br =+ when lenient $ do+ haveGit <- isPkgGitRepo+ if haveGit+ then gitFetchSilent False+ else putStrLn $ "ignoring" +-+ unPackage pkg
src/Cmd/Import.hs view
@@ -11,6 +11,7 @@ import Common.System import qualified Common.Text as T +import Fedora.Krb (krbTicket) import Network.URI import SimplePrompt (promptEnter) import SimplePrompt.Internal (runPrompt, mapInput, getPromptLine)@@ -20,7 +21,6 @@ import Cmd.RequestBranch (requestPkgBranches) import Git import Koji-import Krb import ListReviews import Package
src/Cmd/Local.hs view
@@ -26,10 +26,15 @@ import Package import RpmBuild -localCmd :: Bool -> Bool -> Maybe Natural -> Maybe ForceShort -> [BCond]- -> (BranchesReq, [String]) -> IO ()-localCmd quiet debug mjobs mforceshort bconds =- withPackagesByBranches HeaderNone False Nothing ZeroOrOne localBuildPkg+localCmd :: Bool -> Bool -> Bool -> Maybe Natural -> Maybe ForceShort+ -> [BCond] -> (BranchesReq, [String]) -> IO ()+localCmd quiet debug allowhead mjobs mforceshort bconds (breq,pkgs) =+ if allowhead+ then if breq == Branches []+ then withPackagesMaybeBranch HeaderNone False dirtyGitHEAD localBuildPkgNoBranch (Nothing, pkgs)+ else error' "--detached-head only supported without specific branch(es)"+ else+ withPackagesByBranches HeaderNone False Nothing ZeroOrOne localBuildPkg (breq,pkgs) where localBuildPkg :: Package -> AnyBranch -> IO () localBuildPkg pkg br = do@@ -40,6 +45,11 @@ -- FIXME backup BUILD tree to .prev void $ buildRPMs quiet debug True mjobs mforceshort bconds rpms br spec -- FIXME mark BUILD dir complete++ localBuildPkgNoBranch :: Package -> AnyBranch -> IO ()+ localBuildPkgNoBranch _pkg _ = do+ spec <- findSpecfile+ void $ buildRPMsNoBranch quiet debug True mjobs mforceshort bconds spec installDepsCmd :: (Maybe Branch,[String]) -> IO () installDepsCmd =
src/Cmd/Override.hs view
@@ -8,6 +8,7 @@ import Data.Aeson (Object) import Fedora.Bodhi (bodhiOverrides)+import Fedora.Krb (krbTicket) import Network.HTTP.Query import SimplePrompt (yesNo) @@ -19,7 +20,6 @@ import Cmd.WaitRepo (waitrepoCmd, WaitFetch(WaitNoFetch)) import Git import Koji-import Krb (krbTicket) import Package data OverrideMode = OverrideCreate | OverrideList | OverrideExpire@@ -34,7 +34,7 @@ putStrLn "Overriding" withPackagesByBranches HeaderMay False cleanGitFetchActive AnyNumber overrideBranch breqpkgs unless nowait $- waitrepoCmd dryrun False WaitNoFetch Nothing breqpkgs+ waitrepoCmd dryrun WaitNoFetch Nothing breqpkgs where overrideBranch :: Package -> AnyBranch -> IO () overrideBranch _ (OtherBranch _) =
src/Cmd/Parallel.hs view
@@ -13,6 +13,7 @@ import Distribution.Fedora.Branch (branchDestTag) import Distribution.RPM.Build.Order (dependencyLayersRpmOpts) import Fedora.Bodhi hiding (bodhiUpdate)+import Fedora.Krb (krbTicket) import Say import SimplePrompt (prompt, promptEnter, yesNo) import System.Console.Pretty@@ -23,7 +24,6 @@ import Branches import Cmd.Merge (mergeBranch) import Git-import Krb import Koji import Package import RpmBuild (checkSourcesMatch, distRpmOptions, getDynSourcesMacros)@@ -103,7 +103,7 @@ error' "You must use --target/--sidetag to build package layers for this branch" when (length branches > 1) $ putStrLn $ "#" +-+ showBranch rbr- target <- targetMaybeSidetag dryrun True rbr mtargetSidetag+ target <- targetMaybeSidetag dryrun True True rbr mtargetSidetag nvrclogs <- concatMapM (timeIODesc "layer" . parallelBuild target rbr) (zip [firstlayer..length allLayers] $ init $ tails layers) -- tails ends in []@@ -147,7 +147,7 @@ setupBranch :: Branch -> IO JobAsync setupBranch br = do putPkgBrnchHdr pkg br- target <- targetMaybeSidetag dryrun True br msidetagTarget+ target <- targetMaybeSidetag dryrun True True br msidetagTarget when (mmerge /= Just False) $ mergeNewerBranch pkg br job <- startBuild Nothing 0 False (length brs) target pkg br "." >>= async unless dryrun $ sleep delay@@ -172,7 +172,7 @@ putStrLn $ "\n= Building" +-+ (if singlelayer then "in parallel"- else (if null nextLayers && not singlelayer then "final" else "") +-+ "parallel layer #" ++ show layernum) +++ else (if null nextLayers && not singlelayer then "final" else "") +-+ (if nopkgs > 1 then "parallel" else "") +-+ "layer #" ++ show layernum) ++ if nopkgs > 1 then " (" ++ show nopkgs +-+ "packages):" else ":"@@ -185,11 +185,11 @@ [n] -> plural n "more package" +-+ "left in next final layer" _ -> plural (length layerspkgs) "more package layer" +-+ "left:" +-+ show layerspkgs- jobs <- zipWithM (setupBuild singlelayer) (reverse [0..(length layer - 1)]) layer+ jobs <- zipWithM (setupBuild singlelayer) (reverse [0..(nopkgs - 1)]) layer when (null jobs) $ error' "No jobs run" (failures,nvrs) <- watchJobs (length jobs == 1) (if singlelayer then Nothing else Just layernum) [] [] jobs- unless (null nvrs && layersleft > 0) $ do+ unless (null nvrs || null nextLayers) $ do putNewLn kojiWaitRepoNVRs dryrun False target $ map jobNvr nvrs putNewLn@@ -214,13 +214,12 @@ else "failed" where nopkgs = length layer- layersleft = length nextLayers setupBuild :: Bool -> Int -> String -> IO JobAsync setupBuild singlelayer n dir = do pkg <- getPackageName dir putPkgBrnchHdr pkg br- job <- startBuild (if singlelayer then Nothing else Just layernum) n (layersleft > 0) nopkgs target pkg br dir+ job <- startBuild (if singlelayer then Nothing else Just layernum) n (not $ null nextLayers) nopkgs target pkg br dir >>= async unless dryrun $ sleep delay return (unPackage pkg,job)@@ -339,11 +338,12 @@ finish <- retry 3 $ kojiWaitTask task if finish then sayString $ color Green $ showNVR nvr +-+ "build success"- -- FIXME print koji task url else do- whenJustM (findExecutable "koji-tool") $ \kojitool ->+ whenJustM (findExecutable "koji-tool") $ \kojitool -> do+ cmd_ kojitool ["builds", "--tail", "-b", showNVR nvr] -- FIXME cmdLog deprecated cmdLog kojitool $ ["tasks", "--children", displayID task, "-s", "fail"] ++ ["--tail" | nopkgs < 3]+ putTaskinfoUrl fedoraHub task error' $ color Red $ showNVR nvr +-+ "build failed" autoupdate <- checkAutoBodhiUpdate br if autoupdate then
src/Cmd/RequestBranch.hs view
@@ -5,8 +5,10 @@ requestPkgBranches ) where +import Fedora.Krb (fasIdFromKrb) import Network.HTTP.Query (lookupKey') import SimplePrompt (promptEnter)+import System.Time.Extra (sleep) import Common import Common.System@@ -15,7 +17,7 @@ import Bugzilla import Cmd.SrcDeps (srcDeps) import Git-import Krb+import Koji (fedoraHub, kojiBuildTarget') import ListReviews import Package import Pagure@@ -95,6 +97,10 @@ return u whenJust mbidsession $ \(bid,session) -> commentBug session bid $ unlines urls+ forM_ newbranches $ \ br -> do+ putStrLn $ "waiting for" +-+ unPackage pkg +-+ "to be added to" +-+ showBranch br ++ "-build"+ (buildtag,_desttag) <- kojiBuildTarget' fedoraHub (showBranch br)+ waitForPkgBuildTag pkg buildtag where -- doRequestBr :: Bool -> Branch -> IO String -- doRequestBr multibr br = do@@ -171,3 +177,9 @@ admins = lookupKey' "admin" access collabs = lookupKey' "collaborator" access in (owners ++ admins, collabs)++waitForPkgBuildTag :: Package -> String -> IO ()+waitForPkgBuildTag pkg buildtag = do+ sleep 30 -- wait first to avoid "(undefined package)"+ ok <- cmdBool "koji" ["list-pkgs", "--quiet", "--package=" ++ unPackage pkg, "--tag=" ++ buildtag]+ unless ok $ waitForPkgBuildTag pkg buildtag
src/Cmd/RequestRepo.hs view
@@ -3,6 +3,7 @@ module Cmd.RequestRepo (requestRepos) where import Control.Exception.Extra (retry)+import Fedora.Krb (fasIdFromKrb) import Network.HTTP.Directory (httpExists, httpManager) import Safe (headMay) import SimplePrompt (promptEnter, promptInitial, yesNo)@@ -14,7 +15,6 @@ import Common import Common.System (error') import qualified Common.Text as T-import Krb import ListReviews import Package import Pagure@@ -28,7 +28,9 @@ pkgs <- if null ps then map reviewBugToPackage <$> listReviewsAll allstates ReviewWithoutRepoReq else return ps- mapM_ (requestRepo mock skipcheck resubmit breq) pkgs+ if null pkgs+ then error' "No approved package reviews found"+ else mapM_ (requestRepo mock skipcheck resubmit breq) pkgs -- FIXME also accept bugid instead requestRepo :: Bool -> Bool -> Bool -> BranchesReq -> String -> IO ()
src/Cmd/ReviewPackage.hs view
@@ -113,7 +113,7 @@ -- FIXME or download rpms build <- yesNoDefault importsrpm "Build package locally" when build $- localCmd False False Nothing Nothing [] (Branches [],[])+ localCmd False False False Nothing Nothing [] (Branches [],[]) putNewLn putStrLn "# RpmLint" void $ cmdBool "rpmlint" ["."] -- FIXME $ spec:srpm:rpms
src/Cmd/Scratch.hs view
@@ -53,7 +53,7 @@ targets <- if null sidetagTargets then return [anyTarget br]- else mapM (targetMaybeSidetag dryrun True (onlyRelBranch br) . Just) sidetagTargets+ else mapM (targetMaybeSidetag dryrun False True (onlyRelBranch br) . Just) sidetagTargets forM_ targets $ \target -> do archs <- case marchopts of
src/Cmd/SideTags.hs view
@@ -3,6 +3,7 @@ SidetagMode(..)) where +import Fedora.Krb (krbTicket) import SimpleCmd (cmd_, cmdN, error') import SimplePrompt (yesNo) @@ -10,9 +11,8 @@ import Common import Git (isPkgGitRepo) import Koji-import Krb (krbTicket) -data SidetagMode = SidetagAdd | SidetagRemove+data SidetagMode = SidetagAdd | SidetagRemove | SidetagTagged deriving Eq sideTagsCmd :: Bool -> Maybe SidetagMode -> [Branch] -> IO ()@@ -35,6 +35,7 @@ krbTicket case mmode of Nothing -> mapM_ putStrLn sidetags+ Just SidetagTagged -> mapM_ taggedSideTag sidetags Just SidetagRemove -> mapM_ removeSideTag sidetags Just SidetagAdd -> do putStrLn "existing tags:"@@ -51,3 +52,9 @@ addSideTag br = whenM (yesNo $ "Create" +-+ indefinite (showBranch br) +-+ "user sidetag") $ void $ createKojiSidetag dryrun br++ -- FIXME can we get koji-hs to do this?+ taggedSideTag :: String -> IO ()+ taggedSideTag tag = do+ putStrLn $ "#" +-+ tag+ cmd_ "koji" ["list-tagged", tag]
src/Cmd/Update.hs view
@@ -1,18 +1,20 @@ module Cmd.Update- ( updateCmd,- updatePkg+ ( updateSourcesCmd,+ updateSourcesPkg ) where import Data.RPM.VerCmp+import Data.Version (parseVersion)+import Fedora.Krb (krbTicket) import SimplePrompt (promptEnter)+import Text.ParserCombinators.ReadP (readP_to_S) import Branches import Common import Common.System import Git import InterleaveOutput (cmdSilent')-import Krb import Package -- FIXME --no-prep to avoid overwriting ongoing build@@ -20,31 +22,34 @@ -- FIXME check EVR increased -- FIXME if multiple sources might need to bump release -- FIXME Haskell subpackages require release bump even with version bump-updateCmd :: Bool -> Bool -> Bool -> (Maybe Branch,[String]) -> IO ()-updateCmd onlysources force allowHEAD (mbr,args) = do- pkgGit <- isPkgGitSshRepo+updateSourcesCmd :: Bool -> Bool -> (Maybe Branch,[String]) -> IO ()+updateSourcesCmd force allowHEAD (mbr,args) = do (mver,pkgs) <-- case args of- [a] -> do- if pkgGit- then return (Just a,[])- else do- mspec <- maybeFindSpecfile- return $ if isJust mspec- then (Just a,[])- else (Nothing,[a])- _ -> return (Nothing,args)+ case args of+ [] -> return (Nothing,[])+ (h:t) -> do+ exists <- doesDirectoryExist h+ if exists || not (isVersion h)+ then return (Nothing, args)+ else do+ havespec <- isJust <$> maybeFindSpecfile+ if null t && not havespec+ then error' "not a pkg dir"+ else return (Just h, t)+ pkgGit <- isPkgGitSshRepo let mgitops = let dirty = if allowHEAD then dirtyGitHEAD else dirtyGitFetch in if pkgGit then dirty else if null pkgs then Nothing else dirty- withPackagesMaybeBranch HeaderMay False mgitops (updatePkg onlysources force allowHEAD pkgGit mver) (mbr, pkgs)+ withPackagesMaybeBranch HeaderMay False mgitops (updateSourcesPkg force allowHEAD pkgGit mver) (mbr, pkgs)+ where+ isVersion = not . null . readP_to_S parseVersion -- FIXME use tempdir or don't prep to prevent overwriting an ongoing build-updatePkg :: Bool -> Bool -> Bool -> Bool -> Maybe String -> Package- -> AnyBranch -> IO ()-updatePkg onlysources force allowHEAD distgit mver pkg br = do+updateSourcesPkg :: Bool -> Bool -> Bool -> Maybe String -> Package+ -> AnyBranch -> IO ()+updateSourcesPkg force allowHEAD distgit mver pkg br = do when (distgit && br /= RelBranch Rawhide && isRelBranch br) $ promptEnter $ "Are you sure you want to update" +-+ show br +-+ "branch?! Press Enter to continue" spec <- if allowHEAD@@ -52,16 +57,14 @@ else localBranchSpecFile pkg br -- FIXME detect uncommitted version bump, ie old committed version (curver,_) <- pkgVerRel spec- vdiff <- filter ("Version:" `isInfixOf`) . filter (not . ("@@ " `isPrefixOf`)) <$> gitLines "diff" ["-U0", "HEAD", spec]- unless (length vdiff `elem` [0,2]) $- error' $ "diff contains complex version change:\n" ++ unlines vdiff+ vdiff <- filter ("+Version:" `isPrefixOf`) . filter (not . ("@@ " `isPrefixOf`)) <$> gitLines "diff" ["-U0", "HEAD", spec]+ when (length vdiff > 1) $+ error' $ "diff contains complex multi-version changes:\n" ++ unlines vdiff case mver of Nothing -> do- when (null vdiff && not onlysources) $- error' "specify or edit version to update" putStrLn $ "current version:" +-+ curver Just nver -> do- when (length vdiff == 2) $+ when (length vdiff == 1) $ error' $ "spec version already bumped to" +-+ curver when (curver == nver) $ putStrLn $ "already new version" +-+ curver@@ -73,7 +76,8 @@ case map (last . words) vdiff of [old,new] -> Just (old,new) _ -> Nothing- unless onlysources $ do+ when (isJust mver) $+ when (isJust moldnewver) $ do let (oldver,newver) = fromMaybe (error' "complex version change") moldnewver -- FIXME take epoch into account@@ -88,6 +92,7 @@ autobump <- autoReleaseBump spec when autobump $ editSpecField "Release" "%autorelease" spec+ -- FIXME if multiple versions need to bump release else editSpecField "Release" "0%{?dist}" spec -- FIXME should be sure sources exists for distgit whenM (doesFileExist "sources") $
src/Cmd/WaitRepo.hs view
@@ -7,7 +7,6 @@ import Common.System import Branches-import Common (showNVR) import Git import Koji import Package@@ -16,9 +15,9 @@ data WaitFetch = WaitNoFetch | WaitDirty | WaitFetch -- FIXME first check/wait for build to actually exist-waitrepoCmd :: Bool -> Bool -> WaitFetch -> Maybe SideTagTarget+waitrepoCmd :: Bool -> WaitFetch -> Maybe SideTagTarget -> (BranchesReq, [String]) -> IO ()-waitrepoCmd dryrun knowntag fetch msidetagTarget = do+waitrepoCmd dryrun fetch msidetagTarget = do withPackagesByBranches HeaderMay False (case fetch of WaitFetch -> cleanGitFetchActive@@ -33,7 +32,5 @@ gitSwitchBranch rbr let spec = packageSpec pkg nvr <- pkgNameVerRel' br spec- target <- targetMaybeSidetag dryrun False br msidetagTarget- logMsg $ "Waiting for" +-+ showNVR nvr +-+ "to appear in" +-+ target- -- FIXME can we get time from koji waitrepo task?- timeIO $ kojiWaitRepoNVR dryrun True knowntag target nvr+ target <- targetMaybeSidetag dryrun True False br msidetagTarget+ kojiWaitRepoNVR dryrun False target nvr
src/Git.hs view
@@ -113,7 +113,7 @@ unless (null commits) $ do pull <- git "pull" [] unless ("Already up to date." `isPrefixOf` pull) $- putStr pull+ putStrLn pull -- FIXME maybe require local branch already here newerMergeable :: String -> Branch -> IO (Bool,[Commit],Maybe Branch)@@ -201,14 +201,17 @@ gitRepoName = dropSuffix ".git" . takeFileName <$> git "remote" ["get-url", "origin"] +-- FIXME use Verbose gitFetchSilent :: Bool -> IO () gitFetchSilent quiet = do name <- gitRepoName unless quiet $ putStr $ "git fetching" +-+ name ++ "... " (ok, out, err) <- cmdFull "git" ["fetch"] ""- unless (null out) $ putStrLn out+ unless quiet $+ unless (null out) $ putStrLn out unless ok $ error' err+ -- could keep From if no header let filtered = case lines err of [] -> [] (hd:tl) -> filter (/= "Already up to date.") $
src/Koji.hs view
@@ -19,6 +19,7 @@ kojiWaitRepoNVRs, kojiWatchTask, kojiWaitTask,+ putTaskinfoUrl, TaskID, displayID, fedoraHub,@@ -39,9 +40,10 @@ import qualified Distribution.Koji.API as Koji import Distribution.Fedora.Branch (branchRelease) import Distribution.Fedora.Release (releaseDistTag)+import Fedora.Krb (fasIdFromKrb, krbTicket) import Safe (headMay, tailSafe) import Say (sayString)-import SimplePrompt (promptEnter)+import SimplePrompt (promptEnter, yesNo) import System.Exit import System.Process.Typed import System.Timeout (timeout)@@ -51,7 +53,6 @@ import Common import Common.System import Git-import Krb import Package (fedpkg, Package, unPackage) import Pagure import Types@@ -148,13 +149,18 @@ case mst of Just TaskClosed -> return () Just TaskFailed -> do- whenJustM (findExecutable "koji-tool") $ \kojitool ->+ whenJustM (findExecutable "koji-tool") $ \kojitool -> do -- FIXME cmdLog deprecated cmdLog kojitool ["tasks", "--children", displayID task, "--tail", "-s", "fail"]+ putTaskinfoUrl fedoraHub task error' "Task failed!" Just TaskCanceled -> return () _ -> kojiWatchTask task +putTaskinfoUrl :: String -> TaskID -> IO ()+putTaskinfoUrl hub tid =+ putStrLn $ dropSuffix "hub" hub +/+ "taskinfo?taskID=" ++ show (getID tid)+ -- FIXME during network disconnection: -- Connection timed out: retrying -- Connection timed out: retrying@@ -207,6 +213,7 @@ Just res -> return res -- FIXME should be NonEmpty+-- FIXME add back knowntag? kojiWaitRepoNVRs :: Bool -> Bool -> String -> [NVR] -> IO () kojiWaitRepoNVRs _ _ _ [] = error' "no NVRs given to wait for" kojiWaitRepoNVRs dryrun quiet target nvrs = do@@ -218,10 +225,13 @@ case nvrs of [nvr] -> showNVR nvr _ -> "builds"+ -- FIXME use knowntag to quieten output: for override outputs, eg+ -- "nvr ghc-rpm-macros-2.7.5-1.fc41 is not current in tag f41-build+ -- latest build is ghc-rpm-macros-2.7.2-4.fc41" void $ timeIO $ cmd "koji" (["wait-repo", "--request", "--quiet"] ++ ["--build=" ++ showNVR nvr | nvr <- nvrs] ++ [buildtag]) -kojiWaitRepoNVR :: Bool -> Bool -> Bool -> String -> NVR -> IO ()-kojiWaitRepoNVR dryrun quiet _knowntag target nvr =+kojiWaitRepoNVR :: Bool -> Bool -> String -> NVR -> IO ()+kojiWaitRepoNVR dryrun quiet target nvr = kojiWaitRepoNVRs dryrun quiet target [nvr] kojiTagArchs :: String -> IO [String]@@ -275,17 +285,27 @@ return sidetag else error' "'fedpkg request-side-tag' failed" --- FIXME check/warn for target/branch mismatch-targetMaybeSidetag :: Bool -> Bool -> Branch -> Maybe SideTagTarget+-- FIXME offer choice of existing sidetags+targetMaybeSidetag :: Bool -> Bool -> Bool -> Branch -> Maybe SideTagTarget -> IO String-targetMaybeSidetag dryrun create br msidetagTarget =+targetMaybeSidetag dryrun strict create br msidetagTarget = case msidetagTarget of Nothing -> return $ showBranch br- -- FIXME map "rawhide" to valid target- Just (Target t) ->- if t == "rawhide"- then releaseDistTag <$> branchRelease Rawhide- else return t+ Just (Target t) -> do+ disttag <- releaseDistTag <$> branchRelease br+ if t == "rawhide" && br == Rawhide+ then return disttag+ else do+ unless (disttag `isPrefixOf` t) $ do+ let msg = "Branch" +-+ showBranch br +-+ "does not match target" +-+ t in+ if strict+ then do+ ok <- yesNo $ msg ++ "! Are you sure?"+ unless ok $ error' "aborted"+ else+ whenM isPkgGitRepo $+ warning ("Note:" +-+ msg)+ return t Just SideTag -> do tags <- kojiUserSideTags (Just br) case tags of
− src/Krb.hs
@@ -1,43 +0,0 @@-module Krb (- fasIdFromKrb,- maybeFasIdFromKrb,- krbTicket- ) where--import Common--import SimpleCmd (error', cmdBool, cmdMaybe)--krbTicket :: IO ()-krbTicket = do- krb <- klistEntryFedora- if null krb- then error' "No krb5 ticket found for FEDORAPROJECT.ORG"- else- when (last krb == "(Expired)") $ do- putStrLn $ unwords krb- fkinit- putNewLn- where- fkinit = do- ok <- cmdBool "fkinit" []- unless ok fkinit--maybeFasIdFromKrb :: IO (Maybe String)-maybeFasIdFromKrb =- fmap (dropSuffix "@FEDORAPROJECT.ORG") . find ("@FEDORAPROJECT.ORG" `isSuffixOf`) <$> klistEntryFedora--fasIdFromKrb :: IO String-fasIdFromKrb = do- mfasid <- maybeFasIdFromKrb- case mfasid of- Nothing -> error' "Could not determine fasid from klist"- Just fasid -> return fasid--klistEntryFedora :: IO [String]-klistEntryFedora = do- mres <- cmdMaybe "klist" ["-l"]- return $- maybe []- (words . fromMaybe "" . find ("@FEDORAPROJECT.ORG" `isInfixOf`) . lines)- mres
src/Main.hs view
@@ -135,7 +135,8 @@ , Subcommand "sidetags" "List user's side-tags" $ sideTagsCmd <$> dryrunOpt "Dry-run: no sidetag actions"- <*> optional (flagLongWith' SidetagAdd "create" "Create one or more sidetags" <|>+ <*> optional (flagLongWith' SidetagTagged "tagged" "List tagged builds in sidetag(s)" <|>+ flagLongWith' SidetagAdd "create" "Create one or more sidetags" <|> flagLongWith' SidetagRemove "remove" "Remove one or more sidetags") <*> many branchArg , Subcommand "override" "Tag builds into buildroot override in Koji" $@@ -148,7 +149,6 @@ , Subcommand "waitrepo" "Wait for build to appear in Koji buildroot" $ waitrepoCmd <$> dryrunOpt "Dry run: do not wait"- <*> pure False <*> waitfetchOpt <*> optional (sidetagTargetOpt Nothing) <*> branchesPackages@@ -182,16 +182,10 @@ <*> optional scratchSourceOpt <*> branchesPackages , Subcommand "update-sources" "Download and update newer sources" $- updateCmd True+ updateSourcesCmd <$> forceOpt "Download upstream sources even if they exist locally" <*> switchWith 'H' "allow-head" "For updating inside rebase"- <*> maybeBranchPackages False- , Subcommand "update-version" "Update package in dist-git to newer version" $- updateCmd- <$> switchWith 's' "sources-only" "Only update sources"- <*> forceOpt "Download upstream sources even if they exist locally"- <*> switchWith 'H' "allow-head" "For updating inside rebase"- <*> maybeBranchPackages False+ <*> maybeBranchPackages' (Just "[VERSION]") False , Subcommand "sort" "Sort packages in build dependency order (default format: chain-build)" $ sortCmd <$> sortDisplayOpt@@ -208,6 +202,7 @@ localCmd <$> quietOpt "Hide the build.log until it errors" <*> debugOpt "show the rpmbuild command"+ <*> allowHeadOpt <*> jobsOpt <*> optional forceshortOpt <*> many bcondOpt@@ -228,7 +223,7 @@ <*> diffFormatOpt <*> switchWith 'i' "ignore-bumps" "Ignore pure release bumps" <*> many diffFilterOpt- <*> optional (optionWith anyBranchM 'w' "with-branch" "BRANCH" "branch")+ <*> optional (optionWith anyBranchM 'w' "with-branch" "BRANCH" "Compare with BRANCH") <*> maybeBranchPackages False , Subcommand "compare" "Show commits between branches" $ compareCmd@@ -300,7 +295,8 @@ <*> branchesPackages , Subcommand "fetch" "Git fetch packages" $ fetchPkgs- <$> manyPackages+ <$> switchLongWith "lenient" "skip non dist-git directories"+ <*> manyPackages , Subcommand "push" "Git push packages" $ pushPkgs <$> dryrunOpt "Dry run: do not push"@@ -409,6 +405,9 @@ autospecCmd <$> forceOpt "Refresh changelog file to current" <*> manyPackages+ , Subcommand "unautospec" "Unconvert rpmautospec package" $+ unautospecCmd+ <$> branchesPackages , Subcommand "move-artifacts" "Move old rpm artifacts into rpmbuild dirs" $ moveArtifactsCmd <$> switchWith 'd' "delete" "Remove duplicate artifacts"@@ -490,11 +489,15 @@ _ -> error' $ "cannot have more than one branch:" +-+ unwords (map showBranch brs) maybeBranchPackages :: Bool -> Parser (Maybe Branch,[String])- maybeBranchPackages oneplus =+ maybeBranchPackages = maybeBranchPackages' Nothing++ maybeBranchPackages' :: Maybe String -> Bool+ -> Parser (Maybe Branch,[String])+ maybeBranchPackages' mextraarg oneplus = maybeBranchesPkgs <$> if oneplus- then some (pkgArg "[BRANCH] PKGPATH...")- else many (pkgArg "[BRANCH] [PKGPATH]...")+ then some (pkgArg $ "[BRANCH]" +-+ extraargdesc +-+ "PKGPATH...")+ else many (pkgArg $ "[BRANCH]" +-+ extraargdesc +-+ "[PKGPATH]...") where maybeBranchesPkgs :: [String] -> (Maybe Branch,[String]) maybeBranchesPkgs args =@@ -504,6 +507,8 @@ [br] -> (Just br,pkgs) _ -> error' $ "cannot have more than one branch:" +-+ unwords (map showBranch brs) + extraargdesc = fromMaybe "" mextraarg+ branchesPackages :: Parser (BranchesReq, [String]) branchesPackages = branchesPackagesDesc "BRANCH... PKGPATH..." @@ -706,7 +711,7 @@ quietOpt :: String -> Parser Bool quietOpt = switchWith 'q' "quiet" - allowHeadOpt = switchLongWith "allow-head" "allow detached HEAD"+ allowHeadOpt = switchLongWith "detached-head" "allow detached HEAD" forceOpt = switchWith 'f' "force"
src/Package.hs view
@@ -46,6 +46,7 @@ editSpecField, isAutoChangelog, isAutoRelease,+ calculateRelease, autoReleaseBump, sourceFieldFile, isArchiveFile,@@ -286,7 +287,7 @@ 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+ error' $ "Not a package git directory:" +-+ unPackage pkg mcurrentbranch <- if haveGit then@@ -299,9 +300,13 @@ else Just <$> gitCurrentBranch else return Nothing let fetch = have gitOptFetch+ brs <- listOfAnyBranches (haveGit && not (have gitOptHEAD)) (have gitOptActive) breq+ when ((header /= HeaderNone || fetch) && dir /= ".") $+ case brs of+ [br] -> when (fetch || header == HeaderMust) $ putPkgAnyBrnchHdr pkg br+ _ -> when (fetch || header /= HeaderNone) $ putPkgHdr pkg -- quiet to avoid output before header when fetch $ gitFetchSilent True- brs <- listOfAnyBranches (haveGit && not (have gitOptHEAD)) (have gitOptActive) breq case limitBranches of ZeroOrOne | length brs > 1 -> -- FIXME: could be handled better (testcase: run long list of packages in wrong directory)@@ -311,10 +316,6 @@ ExactlyOne | length brs > 1 -> error' "please only specify one branch" _ -> return ()- when ((header /= HeaderNone || fetch) && dir /= ".") $- case brs of- [br] -> when (fetch || header == HeaderMust) $ putPkgAnyBrnchHdr pkg br- _ -> when (fetch || header /= HeaderNone) $ putPkgHdr pkg when haveGit $ when (have gitOptClean) $ checkWorkingDirClean (have gitOptStash) -- FIXME!! no branch restriction@@ -392,6 +393,12 @@ ("Release:":"%autorelease":"-b":_) -> True _ -> False _ -> error' $ "multiple autorelease fields in" +-+ spec++calculateRelease :: FilePath -> IO String+calculateRelease spec = do+ -- upstream bug "--number-only" doesn't work+ calculated <- cmd "rpmautospec" ["calculate-release", spec]+ return $ dropPrefix "Calculated release number: " calculated isAutoChangelog :: FilePath -> IO Bool isAutoChangelog = grep_ "^%autochangelog"
src/PkgReview.hs view
@@ -9,12 +9,12 @@ import Common import Common.System +import Fedora.Krb (fasIdFromKrb) import Network.HTTP.Directory (httpExists, httpManager) import SimplePrompt (promptEnter, yesNoDefault) import Branches import Koji-import Krb import RpmBuild data ScratchOption = ScratchBuild | ScratchTask Int | SkipScratch
src/RpmBuild.hs view
@@ -1,6 +1,7 @@ module RpmBuild ( builtRpms, buildRPMs,+ buildRPMsNoBranch, installDeps, buildRequires, getSources,@@ -36,7 +37,7 @@ import System.Process.Typed (proc, readProcessInterleaved) import Branches-import Cmd.Update (updatePkg)+import Cmd.Update (updateSourcesPkg) import Common import Common.System import Git@@ -259,9 +260,8 @@ autorelease <- isAutoRelease spec if autorelease then do- -- upstream bug "--number-only" doesn't work- calculated <- cmd "rpmautospec" ["calculate-release", spec]- return ["--define", "_rpmautospec_release_number" +-+ dropPrefix "Calculated release number: " calculated]+ calculated <- calculateRelease spec+ return ["--define", "_rpmautospec_release_number" +-+ calculated] else return [] data ForceShort = ForceBuild | ShortCompile | ShortInstall@@ -350,11 +350,62 @@ unless ok $ error' $ showNVR nvr +-+ "failed to build" return needBuild- where- quoteArg :: String -> String- quoteArg cs =- if ' ' `elem` cs then '\'' : cs ++ "'" else cs +quoteArg :: String -> String+quoteArg cs =+ if ' ' `elem` cs then '\'' : cs ++ "'" else cs++buildRPMsNoBranch :: Bool -> Bool -> Bool -> Maybe Natural -> Maybe ForceShort+ -> [BCond] -> FilePath -> IO Bool+buildRPMsNoBranch quiet debug noclean mjobs mforceshort bconds spec = do+ installDeps True spec+ void $ getSources spec+ sourcediropt <- sourceDirCwdOpt+ let distopt = ["--define", "dist" +-+ "%{?distprefix}"]+ buildopt =+ case mforceshort of+ Just ShortCompile -> ["-bc", "--short-circuit"]+ Just ShortInstall -> ["-bi", "--short-circuit"]+ _ -> "-bb" : ["--noclean" | noclean]+ jobs =+ case mjobs of+ Nothing -> []+ Just n -> ["--define", "_smp_ncpus_max" +-+ show n]+ args = sourcediropt ++ distopt +++ buildopt ++ jobs ++ map show bconds ++ [spec]+ date <- cmd "date" ["+%T"]+ nvr <- pkgNameVerRelNodist spec+ let buildlog = ".build-" ++ (showVerRel . nvrVerRel) nvr ++ "-HEAD" <.> "log"+ whenM (doesFileExist buildlog) $ do+ let backup = buildlog <.> "prev"+ whenM (doesFileExist backup) $ do+ prevsize <- getFileSize backup+ currsize <- getFileSize buildlog+ when (prevsize > currsize) $+ copyFile backup (backup <.> "prev")+ copyFile buildlog (buildlog <.> "prev")+ putStr $ date +-+ "Building" +-+ showNVR nvr +-+ "locally... "+ ok <- do+ timeIO $+ if not quiet || isShortCircuit mforceshort+ then do+ putNewLn+ -- FIXME would like to have pipeOutErr+ let buildcmd = unwords $ "rpmbuild" : map quoteArg args ++ "|&" : "tee" : [buildlog +-+ "&& exit ${PIPESTATUS[0]}"]+ when debug $ putStrLn buildcmd+ shellBool buildcmd+ else do+ let buildcmd = unwords $ "rpmbuild" : map quoteArg args ++ [">&", buildlog]+ when debug $ putStrLn buildcmd+ res <- shellBool buildcmd+ if res+ then putStrLn "done"+ else error' "failed to build"+ return res+ unless ok $+ error' $ showNVR nvr +-+ "failed to build"+ return True+ -- FIXME print unavailable deps installDeps :: Bool -> FilePath -> IO () installDeps strict spec = do@@ -438,7 +489,7 @@ -- FIXME maybe change to yesNo promptEnter $ color Red $ unwords missing +-+ "not in sources, press Enter to fix" -- FIXME check if already fixed before proceeding- updatePkg True False False True Nothing pkg br+ updateSourcesPkg False False True Nothing pkg br git_ "status" ["--short"] ok <- yesNo "Amend commit" when ok $ git_ "commit" ["--amend"]