fbrnch 1.6 → 1.6.1
raw patch · 16 files changed
+118/−111 lines, 16 files
Files
- CHANGELOG.md +8/−1
- README.md +1/−1
- fbrnch.cabal +1/−1
- src/Cmd/Build.hs +5/−5
- src/Cmd/Install.hs +7/−7
- src/Cmd/Local.hs +3/−3
- src/Cmd/Merge.hs +0/−1
- src/Cmd/Parallel.hs +11/−12
- src/Cmd/ReviewPackage.hs +2/−2
- src/Cmd/Scratch.hs +2/−2
- src/Cmd/WaitRepo.hs +1/−1
- src/Common.hs +7/−0
- src/Common/System.hs +24/−3
- src/Koji.hs +34/−68
- src/Main.hs +4/−0
- src/RpmBuild.hs +8/−4
CHANGELOG.md view
@@ -1,5 +1,12 @@ # Changelog +## 1.6.1 (2024-12-17)+- 'build','parallel': waitrepo now just uses "koji wait-repo --request"+- 'build': now respects --waitrepo+- 'local','install': new --jobs option for _smp_ncpus_max+- waitrepo is timed+- Koji targetMaybeSidetag: print sidetags if more than one+ ## 1.6 (2024-12-13) * update to fedora-releases-0.2.0 (showBranch and branchDestTag) * kojiWaitRepo: now uses request-repo to trigger newrepo@@ -8,7 +15,7 @@ * 'copr' refactoring and fix existingChrootBuilds to prevent rebuilds - 'create-review': --force to create a new "duplicate" review (#53) * 'create-review': include FAS id if can be determined (#42)-* 'import': prompt whether to build or only push+* 'import': prompt whether to build or only push (#47) - 'install': add --existing-only, --skip-existing, --no-reinstall options from select-rpms-0.2 (ported from koji-tool --install) - 'parallel': koji-tool tail of failed build.log if < 3 packages in layer * 'request-repo': now offers to import the new repo immediately
README.md view
@@ -270,7 +270,7 @@ `$ fbrnch --version` ```-1.6+1.6.1 ``` `$ fbrnch --help`
fbrnch.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: fbrnch-version: 1.6+version: 1.6.1 synopsis: Fedora packager tool to build package branches description: fbrnch (fedora branch or "f-branch" for short) is
src/Cmd/Build.hs view
@@ -155,11 +155,11 @@ bodhiCreateOverride dryrun (Just days) nvr when (isJust mlastpkg && mlastpkg /= Just pkg || mwaitrepo == Just True) $ when ((isJust moverride && mwaitrepo /= Just False) ||- (autoupdate && mwaitrepo == Just True)) $- kojiWaitRepo dryrun False True target nvr+ (mwaitrepo == Just True)) $+ kojiWaitRepoNVR dryrun False True target nvr else when (mwaitrepo == Just True) $- kojiWaitRepo dryrun False True target nvr+ kojiWaitRepoNVR dryrun False True target nvr Just BuildBuilding -> do putStrLn $ showNVR nvr +-+ "is already building" when (isJust mpush) $@@ -238,5 +238,5 @@ bodhiCreateOverride dryrun (Just days) nvr when (isJust mlastpkg && mlastpkg /= Just pkg || mwaitrepo == Just True) $ when ((isJust moverride && mwaitrepo /= Just False) ||- (autoupdate && mwaitrepo == Just True)) $- kojiWaitRepo dryrun False True target nvr+ (mwaitrepo == Just True)) $+ kojiWaitRepoNVR dryrun False True target nvr
src/Cmd/Install.hs view
@@ -29,11 +29,11 @@ -- FIXME add --debug or respect --verbose for dnf commands -- FIXME handle subpackage renames (eg ghc-rpm-macros-no-prof to ghc-rpm-macros-quick) -- FIXME allow building an srpm--- FIXME ExistingStrategy option-installCmd :: Bool -> Bool -> Maybe Branch -> Maybe ForceShort -> [BCond]- -> Bool -> Bool -> Bool -> Select -> Maybe ExistingStrategy- -> (Maybe Branch,[String]) -> IO ()-installCmd quiet recurse mfrom mforceshort bconds reinstall nobuild nobuilddeps select mexisting (mbr, pkgs) = do+installCmd :: Bool -> Bool -> Maybe Branch -> Maybe Natural+ -> Maybe ForceShort -> [BCond] -> Bool -> Bool -> Bool -> Select+ -> Maybe ExistingStrategy -> (Maybe Branch,[String])+ -> IO ()+installCmd quiet recurse mfrom mjobs mforceshort bconds reinstall nobuild nobuilddeps select mexisting (mbr, pkgs) = do when (recurse && isShortCircuit mforceshort) $ error' "cannot use --recurse and --shortcircuit" withPackagesMaybeBranch (boolHeader (recurse || length pkgs > 1)) True Nothing installPkg (mbr, pkgs)@@ -76,7 +76,7 @@ mpkgdir <- lookForPkgDir rbr ".." dep case mpkgdir of Nothing -> putStrLn $ dep +-+ "not known"- Just pkgdir -> installCmd quiet recurse mfrom mforceshort bconds reinstall nobuild nobuilddeps select mexisting (mbr, [pkgdir]) >> putNewLn+ Just pkgdir -> installCmd quiet recurse mfrom mjobs mforceshort bconds reinstall nobuild nobuilddeps select mexisting (mbr, [pkgdir]) >> putNewLn -- FIXME option to enable/disable installing missing deps -- FIXME --skip-missing-deps or prompt else installDeps True spec@@ -84,7 +84,7 @@ _wasbuilt <- if nobuild then return True- else buildRPMs quiet False False mforceshort' bconds rpms br spec+ else buildRPMs quiet False False mjobs mforceshort' bconds rpms br spec unless (isShortCircuit mforceshort') $ do let nvras = rpmsToNVRAs rpms -- FIXME: prefix = fromMaybe (nvrName nvr) mprefix
src/Cmd/Local.hs view
@@ -26,9 +26,9 @@ import Package import RpmBuild -localCmd :: Bool -> Bool -> Maybe ForceShort -> [BCond]+localCmd :: Bool -> Bool -> Maybe Natural -> Maybe ForceShort -> [BCond] -> (BranchesReq, [String]) -> IO ()-localCmd quiet debug mforceshort bconds =+localCmd quiet debug mjobs mforceshort bconds = withPackagesByBranches HeaderNone False Nothing ZeroOrOne localBuildPkg where localBuildPkg :: Package -> AnyBranch -> IO ()@@ -38,7 +38,7 @@ then return [] else builtRpms br spec -- FIXME backup BUILD tree to .prev- void $ buildRPMs quiet debug True mforceshort bconds rpms br spec+ void $ buildRPMs quiet debug True mjobs mforceshort bconds rpms br spec -- FIXME mark BUILD dir complete installDepsCmd :: (Maybe Branch,[String]) -> IO ()
src/Cmd/Merge.hs view
@@ -4,7 +4,6 @@ getNewerBranch) where -import Numeric.Natural (Natural) import Safe (tailSafe) import Common
src/Cmd/Parallel.hs view
@@ -104,7 +104,7 @@ when (length branches > 1) $ putStrLn $ "#" +-+ showBranch rbr target <- targetMaybeSidetag dryrun True rbr mtargetSidetag- nvrclogs <- concatMapM (timeIO . parallelBuild target rbr)+ nvrclogs <- concatMapM (timeIODesc "layer" . parallelBuild target rbr) (zip [firstlayer..length allLayers] $ init $ tails layers) -- tails ends in [] unless (isNothing (fst mupdate)) $@@ -189,6 +189,10 @@ 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+ putNewLn+ kojiWaitRepoNVRs dryrun False target $ map jobNvr nvrs+ putNewLn if null failures then return nvrs else do@@ -288,10 +292,7 @@ unless (any (`elem` tags) [showBranch br, showBranch br ++ "-updates", showBranch br ++ "-override"]) $ unlessM (checkAutoBodhiUpdate br) $ bodhiCreateOverride dryrun Nothing nvr- return $ do- when morelayers $- kojiWaitRepo dryrun (nopkgs > 5) True target nvr- return $ Done pkg nvr br changelog+ return $ return $ Done pkg nvr br changelog Just BuildBuilding -> do sayString $ color Yellow (showNVR nvr) +-+ "is already" +-+ color Yellow "building" mtask <- kojiGetBuildTaskID fedoraHub $ showNVR nvr@@ -299,7 +300,7 @@ Nothing -> error' $ "Task for" +-+ showNVR nvr +-+ "not found" Just task -> return $ do- kojiWaitTaskAndRepo (isNothing mlatest) nvr task+ kojiWaitTaskReport (isNothing mlatest) nvr task return $ Done pkg nvr br changelog _ -> do when (null unpushed) $ do@@ -313,7 +314,7 @@ [task] -> do putStrLn $ showNVR nvr +-+ "task is already open" return $ do- kojiWaitTaskAndRepo (isNothing mlatest) nvr task+ kojiWaitTaskReport (isNothing mlatest) nvr task return $ Done pkg nvr br changelog (_:_) -> error' $ show (length opentasks) +-+ "open" +-+ unPackage pkg +-+ "tasks already" [] -> do@@ -329,12 +330,12 @@ else do task <- kojiBuildBranchNoWait target pkg Nothing $ "--fail-fast" : ["--background" | nopkgs > 5] return $ do- kojiWaitTaskAndRepo (isNothing mlatest) nvr task+ kojiWaitTaskReport (isNothing mlatest) nvr task return $ Done pkg nvr br changelog where -- throws error on build failure- kojiWaitTaskAndRepo :: Bool -> NVR -> TaskID -> IO ()- kojiWaitTaskAndRepo newpkg nvr task = do+ kojiWaitTaskReport :: Bool -> NVR -> TaskID -> IO ()+ kojiWaitTaskReport newpkg nvr task = do finish <- retry 3 $ kojiWaitTask task if finish then sayString $ color Green $ showNVR nvr +-+ "build success"@@ -356,8 +357,6 @@ -- changelog <- changeLogPrompt False spec -- bodhiUpdate (fmap fst mBugSess) changelog nvr bodhiCreateOverride dryrun Nothing nvr- when morelayers $- kojiWaitRepo dryrun (nopkgs > 5) True target nvr -- FIXME map nvr to package? renderChangelogs :: [JobDone] -> [String]
src/Cmd/ReviewPackage.hs view
@@ -113,13 +113,13 @@ -- FIXME or download rpms build <- yesNoDefault importsrpm "Build package locally" when build $- localCmd False False Nothing [] (Branches [],[])+ localCmd False False Nothing Nothing [] (Branches [],[]) putNewLn putStrLn "# RpmLint" void $ cmdBool "rpmlint" ["."] -- FIXME $ spec:srpm:rpms spec <- maybe findSpecfile return mspec whenM (yesNoDefault importsrpm "Install packages locally") $ do- installCmd False False Nothing Nothing [] False True True selectDefault Nothing (Nothing,[])+ installCmd False False Nothing Nothing Nothing [] False True True selectDefault Nothing (Nothing,[]) rpms <- cmdLines "rpmspec" ["-q", "--rpms", "--qf", "%{name}\n", spec] whenM (yesNoDefault importsrpm "Rpmlint installed packages") $ do (_ok, out, err) <- cmdFull "rpmlint" ("-i" : rpms) ""
src/Cmd/Scratch.hs view
@@ -62,7 +62,7 @@ case archopts of Archs as -> return as ExcludedArchs as -> do- Just (buildtag,_desttag) <- kojiBuildTarget fedoraHub target+ (buildtag,_desttag) <- kojiBuildTarget' fedoraHub target tagArchs <- kojiTagArchs buildtag excludedarchs <- do excluded <- map words . filter ("ExcludeArch:" `isPrefixOf`) <$> cmdLines "rpmspec" ["-P", spec]@@ -76,7 +76,7 @@ archlist <- if null archs then do- Just (buildtag,_desttag) <- kojiBuildTarget fedoraHub target+ (buildtag,_desttag) <- kojiBuildTarget' fedoraHub target tagArchs <- kojiTagArchs buildtag -- prioritize preferred archs return $ nub $ priorityArchs ++ tagArchs
src/Cmd/WaitRepo.hs view
@@ -36,4 +36,4 @@ 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 $ kojiWaitRepo dryrun True knowntag target nvr+ timeIO $ kojiWaitRepoNVR dryrun True knowntag target nvr
src/Common.hs view
@@ -4,6 +4,7 @@ module Control.Monad.Extra, module Data.List.Extra, module Data.Maybe,+ Natural, #if !MIN_VERSION_base(4,11,0) (<>), #endif@@ -11,6 +12,7 @@ (+-+), indefinite, plural,+ pluralOnly, pluralException, singularVerb, putNewLn,@@ -33,7 +35,12 @@ #endif import Network.HTTP.Query ((+/+))+import Numeric.Natural (Natural) import SimpleCmd ((+-+))++pluralOnly :: [a] -> String -> String+pluralOnly xs ns =+ ns ++ if length xs > 1 then "s" else "" plural :: Int -> String -> String plural i ns =
src/Common/System.hs view
@@ -16,11 +16,15 @@ #if !MIN_VERSION_simple_cmd(0,2,5) timeIO, #endif+ timeIODesc ) where #if !MIN_VERSION_filepath(1,4,2) import Data.List #endif+#if MIN_VERSION_time(1,9,0)+import Data.Time.Format (formatTime, defaultTimeLocale)+#endif import Safe import SimpleCmd hiding ( #if !MIN_VERSION_simple_cmd(0,2,8)@@ -38,19 +42,36 @@ import System.FilePath import System.IO -#if !MIN_VERSION_simple_cmd(0,2,5) import Control.Exception import Data.Time.Clock +#if !MIN_VERSION_simple_cmd(0,2,5) timeIO :: IO a -> IO a-timeIO action = do+timeIO = timeIOHelper "took"+#endif++timeIODesc :: String -> IO a -> IO a+timeIODesc thing = timeIOHelper (thing +-+ "took")++timeIOHelper :: String -> IO a -> IO a+timeIOHelper msg action = do bracket getCurrentTime (\start -> do end <- getCurrentTime let duration = diffUTCTime end start- putStrLn $ "took" +-+ show duration)+ putStrLn $ msg +-+ renderDuration duration) (const action)+ where+#if MIN_VERSION_time(1,9,0)+ renderDuration dur =+ let fmtstr+ | dur < 60 = "%s sec"+ | dur < 3600 = "%m min %S sec"+ | otherwise = "%h hours %M min"+ in formatTime defaultTimeLocale fmtstr dur+#else+ renderDuration = show #endif isTty :: IO Bool
src/Koji.hs view
@@ -13,9 +13,10 @@ kojiBuildBranch, kojiBuildBranchNoWait, kojiSource,- kojiBuildTarget,+ kojiBuildTarget', kojiTagArchs,- kojiWaitRepo,+ kojiWaitRepoNVR,+ kojiWaitRepoNVRs, kojiWatchTask, kojiWaitTask, TaskID,@@ -28,10 +29,9 @@ import Data.Char (isDigit) -import Control.Concurrent (threadDelay) import qualified Data.ByteString.Lazy.Char8 as B import Data.Fixed (Micro)-import Data.RPM.NVR (NVR, maybeNVR, nvrName)+import Data.RPM.NVR (NVR, maybeNVR) import Data.Time.Clock import Data.Time.Format import Data.Time.LocalTime@@ -77,12 +77,6 @@ Nothing -> Nothing Just bld -> lookupStruct "nvr" bld >>= maybeNVR -kojiLatestNVRRepo :: String -> Int -> String -> IO (Maybe NVR)-kojiLatestNVRRepo tag event pkg = do- mbld <- kojiLatestBuildRepo fedoraHub tag event pkg- return $ case mbld of- Nothing -> Nothing- Just bld -> lookupStruct "nvr" bld >>= maybeNVR kojiOpenTasks :: Package -> Maybe String -> String -> IO [TaskID] kojiOpenTasks pkg mref target = do@@ -161,7 +155,7 @@ Just TaskCanceled -> return () _ -> kojiWatchTask task --- FIXME at 4am+-- FIXME during network disconnection: -- Connection timed out: retrying -- Connection timed out: retrying -- Network.Socket.connect: <socket: 11>: does not exist (No route to host)@@ -202,62 +196,34 @@ Left task <- kojiBuildBranch' False target pkg mref args return task -kojiWaitRepo :: Bool -> Bool -> Bool -> String -> NVR -> IO ()-kojiWaitRepo dryrun quiet knowntag target nvr = do- Just (buildtag,desttag) <- kojiBuildTarget fedoraHub target+-- remove once in koji-hs+kojiBuildTarget' :: String -- ^ hubUrl+ -> String -- ^ target+ -> IO (String, String) -- ^ (build-tag,dest-tag)+kojiBuildTarget' hub target = do+ mres <- kojiBuildTarget hub target+ case mres of+ Nothing -> error' $ "failed to get BuildTarget for" +-+ target+ Just res -> return res++-- FIXME should be NonEmpty+kojiWaitRepoNVRs :: Bool -> Bool -> String -> [NVR] -> IO ()+kojiWaitRepoNVRs _ _ _ [] = error' "no NVRs given to wait for"+kojiWaitRepoNVRs dryrun quiet target nvrs = do+ (buildtag,_desttag) <- kojiBuildTarget' fedoraHub target unless dryrun $ do- mlatest <- kojiLatestNVR buildtag (nvrName nvr)- if Just nvr == mlatest- then waitRepo buildtag Nothing- else do- tags <- cmdLines "koji" ["list-tags", "--build=" ++ showNVR nvr]- if knowntag- then do- putStrLn $ "current tags:" +-+ unwords tags- waitRepo buildtag Nothing- else do- mbuilt <- kojiLatestNVR desttag (nvrName nvr)- if mbuilt == Just nvr- then do- sleep 40- -- FIXME need retry- -- SSL_connect: resource vanished (Connection reset by peer)- kojiWaitRepo dryrun quiet knowntag target nvr- else do- putStrLn $ "current tags:" +-+ unwords tags- unless (buildtag `elem` tags) $ do- putStrLn $ "no" +-+ showNVR nvr +-+ "tagged" +-+ buildtag- promptEnter "Press Enter to continue anyway"- waitRepo buildtag Nothing- where- waitRepo :: String -> Maybe Struct -> IO ()- waitRepo buildtag moldrepo = do- when (isJust moldrepo) $- threadDelay (fromEnum (50 :: Micro)) -- 50s- mrepo <- kojiGetRepo fedoraHub buildtag Nothing Nothing- case mrepo of- Nothing -> error' $ "failed to find koji repo for" +-+ buildtag- Just repo ->- if moldrepo == mrepo- then waitRepo buildtag mrepo- else do- let mevent = lookupStruct "create_event" repo- case mevent of- Nothing -> error "create_event not found"- Just event -> do- latest <- kojiLatestNVRRepo buildtag event (nvrName nvr)- tz <- getCurrentTimeZone- if latest == Just nvr- then logSay tz $ showNVR nvr +-+- if isNothing moldrepo- then "is in" +-+ buildtag- else "appeared"- else do- when (isNothing moldrepo && not quiet) $- logSay tz $ "Waiting for" +-+ buildtag +-+ "to have" +-+ showNVR nvr- cmdSilent "koji" ["request-repo", "--nowait", "--quiet", buildtag]- waitRepo buildtag mrepo+ tz <- getCurrentTimeZone+ unless quiet $+ logSay tz $ "Waiting for" +-+ buildtag +-+ "to have" +-++ case nvrs of+ [nvr] -> showNVR nvr+ _ -> "builds"+ 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 =+ kojiWaitRepoNVRs dryrun quiet target [nvr]+ kojiTagArchs :: String -> IO [String] kojiTagArchs tag = do st <- Koji.getTag fedoraHub (Koji.InfoString tag) Nothing@@ -274,7 +240,7 @@ mtags <- kojiBuildTarget fedoraHub (showBranch br) case mtags of Nothing -> return []- Just (buildtag,_desttag) -> do+ Just (buildtag,_desttag) -> kojiListSideTags fedoraKojiHub (Just buildtag) (Just user) maybeTimeout :: Micro -> IO a -> IO a@@ -288,7 +254,7 @@ createKojiSidetag :: Bool -> Branch -> IO String createKojiSidetag dryrun br = do- Just (buildtag,_desttag) <- kojiBuildTarget fedoraHub (showBranch br)+ (buildtag,_desttag) <- kojiBuildTarget' fedoraHub (showBranch br) out <- if dryrun then return $ "Side tag '" ++ buildtag ++ "'"@@ -328,7 +294,7 @@ then createKojiSidetag dryrun br else error' "incorrect side-tag create request" [tag] -> return tag- _ -> error' $ "More than one user side-tag found for" +-+ showBranch br+ sidetags -> error' $ show (length sidetags) +-+ "user side-tags found for" +-+ showBranch br ++ ":\n" +-+ unwords sidetags logSay :: TimeZone -> String -> IO () logSay tz str = do
src/Main.hs view
@@ -208,6 +208,7 @@ localCmd <$> quietOpt "Hide the build.log until it errors" <*> debugOpt "show the rpmbuild command"+ <*> jobsOpt <*> optional forceshortOpt <*> many bcondOpt <*> branchesPackages@@ -261,6 +262,7 @@ <$> quietOpt "Quiet rpmbuild output" <*> switchWith 'R' "recurse" "build and install missing deps packages" <*> optional (optionLongWith branchM "from" "BRANCH" "Merge branch first")+ <*> jobsOpt <*> optional forceshortOpt <*> many bcondOpt <*> switchWith 'r' "reinstall" "reinstall rpms"@@ -707,3 +709,5 @@ allowHeadOpt = switchLongWith "allow-head" "allow detached HEAD" forceOpt = switchWith 'f' "force"++ jobsOpt = optional (optionWith auto 'j' "jobs" "NUM" "Max processes in rpmbuild")
src/RpmBuild.hs view
@@ -277,9 +277,9 @@ -- Note does not check if bcond changed -- FIXME check tarball timestamp -- FIXME handle prep (-bp) too?-buildRPMs :: Bool -> Bool -> Bool -> Maybe ForceShort -> [BCond] -> [FilePath]- -> AnyBranch -> FilePath -> IO Bool-buildRPMs quiet debug noclean mforceshort bconds rpms br spec = do+buildRPMs :: Bool -> Bool -> Bool -> Maybe Natural -> Maybe ForceShort+ -> [BCond] -> [FilePath] -> AnyBranch -> FilePath -> IO Bool+buildRPMs quiet debug noclean mjobs mforceshort bconds rpms br spec = do needBuild <- if isJust mforceshort then return True@@ -306,8 +306,12 @@ 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 ++ map show bconds ++ autoreleaseOpt ++ [spec]+ buildopt ++ jobs ++ map show bconds ++ autoreleaseOpt ++ [spec] date <- cmd "date" ["+%T"] rbr <- anyBranchToRelease br nvr <- do