fbrnch 1.8 → 1.8.1
raw patch · 27 files changed
+474/−136 lines, 27 filesdep +containers
Dependencies added: containers
Files
- CHANGELOG.md +31/−0
- README.md +6/−5
- fbrnch.cabal +3/−1
- src/Bodhi.hs +3/−0
- src/Cmd/Autospec.hs +1/−0
- src/Cmd/Bump.hs +4/−4
- src/Cmd/Commit.hs +3/−0
- src/Cmd/CompareTarballs.hs +5/−1
- src/Cmd/Copr.hs +4/−1
- src/Cmd/Diff.hs +1/−0
- src/Cmd/FTBFS.hs +2/−0
- src/Cmd/Install.hs +7/−1
- src/Cmd/Merge.hs +1/−1
- src/Cmd/Parallel.hs +20/−8
- src/Cmd/Pull.hs +4/−1
- src/Cmd/RequestBranch.hs +3/−1
- src/Cmd/Scratch.hs +1/−0
- src/Cmd/SrcDeps.hs +1/−0
- src/Cmd/Update.hs +28/−22
- src/Cmd/WaitRepo.hs +4/−2
- src/Cmd/WatchTask.hs +49/−0
- src/Common/System.hs +2/−1
- src/Git.hs +20/−12
- src/Koji.hs +230/−47
- src/Main.hs +11/−6
- src/Package.hs +2/−1
- src/RpmBuild.hs +28/−21
CHANGELOG.md view
@@ -1,5 +1,36 @@ # Changelog +## 1.8.1 (2026-03-20)+- new native watchtask implementation and command+- local build.log's now generated with 'script' tool instead of tee pipe++- 'compare-tarballs': include extension in file args help+- 'copr': retry coprGetBuild when watching a build+- 'install': take %_rpmdir into account+- 'local','install': rename --rebuild to --force-build+- 'parallel: for single package do full kojiWaitTask+- 'parallel: notify-send for failure or --must-push failure+- 'parallel: use reverse text to highlight problem prompts+- 'pull: use retry+- 'request-branches: include branches in comment+- 'update-sources: for "sources" diff also compare-tarballs+- 'waitrepo': rename --no-nvr to --no-package+- Koji getChildrenTasks: use maybeTimeout to avoid crash+- Koji: introduce kojiGetTaskState' for DRY+- Koji: kojiBuild output profile if uploading srpm+- Koji: retry with kojiGetTaskChildren seems to eliminate timeouts yay+- Revert "Package isArchiveFile: ".sig" files are ascii"+- RpmBuild checkSourcesMatch: improve logic for missing sources+- gitMergeOrigin: offer to rebase if remote was ahead+- kojiWaitRepo: now implemented by kojiWaitRepoNVRs+- kojiWaitRepoNVRs: check krb ticket before calling koji+- kojiWatchBuildTask loopWatch: check parent state not number of buildArchs+- kojiWatchBuildTask: track display of NVR (in Cyan)+- stack: lts-24.28 has crypton-x509-system-1.6.8+- 'watchtask': displays build hosts initially+- 'watchtask': can watch ongoing package branch build; --progress+- 'watchtask': improve formatting with arch padding and list hosts host+ ## 1.8 (2026-01-02) - 'branch-log': new command to check local and remote branches - 'branch-log': --latest finds connected branches
README.md view
@@ -39,7 +39,7 @@ One can change the branch of one or more packages: ```-$ fbrnch switch f43 [package] ...+$ fbrnch switch f44 [package] ... ``` You can also git pull over packages:@@ -97,9 +97,9 @@ You can merge branches with: ```-$ fbrnch merge f42 [package]+$ fbrnch merge f43 [package] ```-which will offer to merge f43 (or up to a git hash you choose) into f42.+which will offer to merge f44 (or a git hash you choose) into f43. Merging can also be done together with building: ```@@ -270,7 +270,7 @@ `$ fbrnch --version` ```-1.8+1.8.1 ``` `$ fbrnch --help`@@ -303,6 +303,7 @@ sidetags List user's side-tags override Tag builds into buildroot override in Koji waitrepo Wait for build to appear in Koji buildroot+ watchtask Watch a koji build task scratch Scratch build package in Koji scratch-aarch64 Koji aarch64 scratch build of package scratch-x86_64 Koji x86_64 scratch build of package@@ -463,7 +464,7 @@ See the TODO list and also the FIXME comments scattered across the source. -Authors of the code:+People who have contributed to the code: <a href="https://github.com/juhp/fbrnch/graphs/contributors"> <img src="https://contributors-img.web.app/image?repo=juhp/fbrnch" />
fbrnch.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: fbrnch-version: 1.8+version: 1.8.1 synopsis: Fedora packager tool to build package branches description: fbrnch (fedora branch or "f-branch" for short) is@@ -90,6 +90,7 @@ Cmd.Update Cmd.UpdateReview Cmd.WaitRepo+ Cmd.WatchTask Common Common.System Common.Text@@ -117,6 +118,7 @@ bugzilla-redhat >= 1.0.1, bytestring, config-ini,+ containers, copr-api >= 0.2, directory >= 1.2.3, either,
src/Bodhi.hs view
@@ -125,6 +125,7 @@ case mtemplate of Just file -> do -- FIXME use cmdLog_ to debug, but notes are not quoted+ -- FIXME does not fail cmd_ "bodhi" ["updates", "new", "--file", file, nvrs] return True Nothing -> do@@ -135,6 +136,7 @@ else case mnotes of Just NotesChangelog ->+ -- FIXME all changes since last update! cleanChangelog True spec Just (NotesText notes) -> return notes@@ -159,6 +161,7 @@ -- FIXME check for Bodhi URL to confirm update -- FIXME returns json error string if it exists: -- {"status": "error", "errors": [{"location": "body", "name": "builds", "description": "Update for ghc9.2-9.2.5-14.fc36 already exists"}]}+ -- ('Connection aborted.', RemoteDisconnected('Remote end closed connection without response')) cmd_ "bodhi" $ ["updates", "new", "--type", if isJust mreview then "newpackage" else show updateType, "--severity", show severity, "--request", "testing", "--notes", take 10000 changelog, "--autokarma", "--autotime", "--close-bugs"] ++ bugs ++ [nvrs] return True when updateDone $ do
src/Cmd/Autospec.hs view
@@ -13,6 +13,7 @@ import Package -- FIXME! calculate baserelease: calculate bumped release and count back to last version bump commit+-- FIXME add --stash autospecCmd :: Bool -> [String] -> IO () autospecCmd force pkgs = withPackagesByBranches HeaderMay False cleanGitFetchActive ExactlyOne autospecPkg (Branches [Rawhide], pkgs)
src/Cmd/Bump.hs view
@@ -19,10 +19,10 @@ -- FIXME countdown bumpCmd :: Bool -> Bool -> Maybe String -> Maybe String -> (BranchesReq,[String]) -> IO ()-bumpCmd dryrun local mcmsg mclog =- withPackagesByBranches (boolHeader local) False- (if local then cleanGit else cleanGitFetchActive)- AnyNumber (bumpPkg dryrun local mcmsg mclog)+bumpCmd dryrun strict mcmsg mclog =+ withPackagesByBranches (boolHeader (not strict)) False+ (if strict then cleanGitFetchActive else cleanGit)+ AnyNumber (bumpPkg dryrun strict mcmsg mclog) bumpPkg :: Bool -> Bool -> Maybe String -> Maybe String -> Package -> AnyBranch -> IO ()
src/Cmd/Commit.hs view
@@ -11,6 +11,8 @@ import Git import Package +-- FIXME convert long #bz to keyword rhbz# so that bodhi will update the bug+-- FIXME reject %macro's in %changelog -- FIXME reject if nvr ahead of newer branch -- FIXME use branches after all? -- FIXME handle multiline changelog entries with "-m description"@@ -60,6 +62,7 @@ -- rpmautospec generates "Uncommitted changes" then error' "set commit msg with --message" else do+ -- FIXME handle staged change to previous changelog entry clog <- lines <$> cleanChangelog True spec case clog of [] -> readCommitMsg
src/Cmd/CompareTarballs.hs view
@@ -36,7 +36,11 @@ -- FIXME cannot handle majorversion macros etc (eg lean4) case simplifyMinimalDiff ls of [s1,s2] -> diffTarballs mmaxlen (sourcesFilename s1) (sourcesFilename s2)- _ -> error' $ "could not determine changed versions in" +-+ show sourcesfile+ ss -> do+ putNewLn+ error' $+ unlines $+ ("More than one source archive changed in" +-+ show sourcesfile ++ ":") : map sourcesFilename ss ++ ["", "Run: fbrnch compare-tarballs <source1> <source2>"] else do spec <- findSpecfile diff <- git "diff" ["-U0", spec]
src/Cmd/Copr.hs view
@@ -9,6 +9,7 @@ ) where +import Control.Exception.Extra (retry) import Data.Aeson.Types (Object) #if MIN_VERSION_aeson(2,0,0) import Data.Aeson.Key@@ -114,6 +115,7 @@ | CoprNew | CoprFailures (Maybe String) +-- FIXME fbrnch: unknown release: centos-stream-9 -- FIXME take ExclusiveArch/ExcludeArch into account -- FIXME -1 for only first unbuilt chroot -- FIXME check branch@@ -176,6 +178,7 @@ -- was: localBranchSpecFile pkg (RelBranch Rawhide) spec <- findSpecfile -- pkg <- takeFileName <$> getCurrentDirectory+ -- FIXME: for HLS would prefer to generate srpm later after checking if MVR already built srpm <- if not dryrun then generateSrpmNoDist True False Nothing spec else return spec -- hack to avoid generating srpm for dryrun@@ -320,7 +323,7 @@ coprWatchBuild :: Maybe String -> Either CoprTask Int -> IO Bool coprWatchBuild mstate ebuild = do let bid = either taskBuild id ebuild- res <- coprGetBuild fedoraCopr bid+ res <- retry 2 $ coprGetBuild fedoraCopr bid case lookupKey "state" res of Just state -> if mstate == Just state
src/Cmd/Diff.hs view
@@ -32,6 +32,7 @@ -- FIXME diff other branches without switching -- FIXME --older/--newer branch+-- FIXME option/support for non-distgit diffCmd :: Bool -> Bool -> DiffWork -> DiffFormat -> Bool -> [DiffFilter] -> Maybe AnyBranch -> (Maybe Branch,[String]) -> IO () diffCmd debug speconly work fmt ignorebumps patts mwbr =
src/Cmd/FTBFS.hs view
@@ -16,6 +16,8 @@ data FTBFSBugs = FtbfsUser (Maybe String) | FtbfsSubstring String +--- * revisit 1.6.3 dropped changes *+-- FIXME take bug's Fedora version into account => check tags including newer -- FIXME option for status filter -- FIXME check arch -- FIXME ask resolution
src/Cmd/Install.hs view
@@ -20,6 +20,7 @@ import Repoquery import RpmBuild +-- FIXME allow installing old branch: "release not found for branch f37" -- FIXME --rpm to avoid dnf -- FIXME --subpackage to specify subpackage(s) to install/add -- FIXME --exclude to specify subpackage(s) not to install@@ -88,12 +89,17 @@ then return True else buildRPMs quiet False False mjobs mforceshort bconds rpms br spec unless (isShortCircuit mforceshort) $ do+ -- paths lost here let nvras = rpmsToNVRAs rpms -- FIXME: prefix = fromMaybe (nvrName nvr) mprefix decided <- decideRPMs yes False mexisting select (unPackage pkg) nvras+ rpmdir <- fromMaybe "." <$> rpmEval "%{_rpmdir}"+ unless (rpmdir == ".") $+ putStrLn $ "Changing directory to:" +-+ rpmdir -- FIXME dryrun and debug -- FIXME return Bool?- installRPMsAllowErasing False False mmgr allowerasing yes $ groupOnArch "RPMS" decided+ withCurrentDirectory rpmdir $+ installRPMsAllowErasing False False mmgr allowerasing yes $ groupOnArch "" decided lookForPkgDir :: Branch -> FilePath -> String -> IO (Maybe FilePath) lookForPkgDir rbr topdir p = do
src/Cmd/Merge.hs view
@@ -95,7 +95,7 @@ displayCommits False unmerged putNewLn unless (null unpushed) $- displayHdrCommits "Local commits" showall unpushed+ displayHdrCommits "Local commit" showall unpushed mmerge <- if noprompt && null unpushed then return Nothing
src/Cmd/Parallel.hs view
@@ -17,7 +17,7 @@ import Say import SimplePrompt (prompt, promptEnter, yesNo) import SimplePrompt.Internal (runPrompt, mapInput, getPromptLine)-import System.Console.Pretty (color, Color(..), style, Style(Bold))+import System.Console.Pretty (color, Color(..), style, Style(Bold,Reverse)) import System.Time.Extra (sleep) import Bodhi@@ -50,6 +50,7 @@ -- FIXME push update -- FIXME use more say -- FIXME --skip-bumps NUM+-- FIXME rename --must-push to --should-push? parallelBuildCmd :: Bool -> Maybe Bool -> Maybe Branch -> Int -> Maybe SideTagTarget -> Bool -> Double -> (Maybe UpdateType, UpdateSeverity)@@ -86,7 +87,7 @@ case tags of [] -> "will use new sidetag" [tag] -> "will use" +-+ tag- _ -> "Several user side-tags found for" +-+ showBranch rbr ++ ":\n" ++ unlines tags+ _ -> "User side-tags found for" +-+ showBranch rbr ++ ":\n" ++ unlines tags forM_ (filter (/= ":") pkgs) $ \p -> when (mmerge /= Just False) $ withExistingDirectory p $ do@@ -135,7 +136,7 @@ gitSwitchBranch currentbranch unless (null failures) $ do putStrLn $ "Build failures:" +-+ color Red (unwords failures)- okay <- yesNo "Do you want to continue nevertheless"+ okay <- yesNo $ style Reverse "Do you want to continue nevertheless" unless okay $ error' "Quitting" when (isNothing msidetagTarget) $ do let spec = packageSpec pkg@@ -206,7 +207,7 @@ if null nextLayers then return $ Just False -- FIXME edit next layer- else promptFailure "Do you want to [c]ontinue nevertheless or maybe fix & [r]etry? [c/N/r]"+ else promptFailure $ style Reverse "Do you want to [c]ontinue nevertheless or maybe fix & [r]etry? [c/N/r]" case reply of Just True -> do kojiWaitRepoForLayer@@ -276,9 +277,10 @@ gitSwitchBranch (RelBranch br) unlessM isGitDirClean $ do warning $ color Red "local uncommitted changes (dirty)"- promptEnter "Press Enter to continue after fixing"+ promptEnter $ style Reverse "Press Enter to continue after fixing" let spec = packageSpec pkg checkForSpecFile spec+ -- FIXME make sure branch is up-to-date (otherwise autorelease may be wrong!) nvr <- pkgNameVerRel' br spec putStrLn $ showNVR nvr +-+ "(" ++ target ++ ")" +-+ morepkgs putNewLn@@ -286,15 +288,16 @@ if null unpushed then when mustpush $ do- ok <- yesNo "Nothing to push, okay to continue"- unless ok $- error' "no commits with --must-push"+ notifySend "package without commits to push"+ -- FIXME add skip option?+ promptEnter $ style Reverse "Nothing to push! Press Enter if you want to continue" else do displayCommits False unpushed unless (null unpushed) $ do checkSourcesMatch pkg (RelBranch br) spec unlessM isGitDirClean $ error' "local changes remain (dirty)"+ -- FIXME: check for %macros in %changelog unless dryrun $ gitPush True Nothing changelog <- unlines <$> getChangelog spec@@ -362,6 +365,8 @@ -- throws error on build failure kojiWaitTaskReport :: Bool -> NVR -> TaskID -> IO () kojiWaitTaskReport newpkg nvr task = do+ when (nopkgs == 1) $+ kojiWatchTask task finish <- retry 3 $ kojiWaitTask task if finish then sayString $ color Green (showNVR nvr) +-+ "complete"@@ -372,6 +377,7 @@ cmdLog_ kojitool $ ["tasks", "--children", displayID task, "-s", "fail"] ++ [if nopkgs < 5 then "--tail" else "--details"] hub <- getKojiProfileHub putTaskinfoUrl hub task+ notifySend $ showNVR nvr +-+ "failed" error' $ color Red $ showNVR nvr +-+ "build failed" autoupdate <- checkAutoBodhiUpdate br if autoupdate then@@ -429,3 +435,9 @@ -- FIXME check no interdeps then return $ splitOn [":"] pkgs else dependencyLayersRpmOpts distopts pkgs++-- FIXME --beep option+notifySend :: String -> IO ()+notifySend msg =+ whenJustM (findExecutable "notify-send") $ \notify ->+ cmd_ notify ["--hint=string:sound-name:bell", "fbrnch:" +-+ msg]
src/Cmd/Pull.hs view
@@ -4,6 +4,8 @@ ) where +import Control.Exception.Extra (retry)+ import Branches import Common --import Common.System (error')@@ -45,6 +47,7 @@ current <- getReleaseBranchWarn unless (breq == Branches [] || RelBranch current == br) $ gitSwitchBranch br- if pullopt == Just PullRebase+ retry 2 $+ if pullopt == Just PullRebase then git_ "pull" ["origin"] else gitMergeOrigin current
src/Cmd/RequestBranch.hs view
@@ -89,6 +89,7 @@ _ -> putStrLn "branches exist" return [] else do+ -- FIXME is this enough actually? gitFetchSilent True brs' <- localBranches False forM_ branches $ \br ->@@ -128,7 +129,8 @@ putStrLn u return u whenJust mbidsession $ \(bid,session) ->- commentBug session bid $ unlines urls+ commentBug session bid $+ unlines $ zipWith (\u b -> u +-+ showBranch b) urls newbranches return newbranches where -- doRequestBr :: Bool -> Branch -> IO String
src/Cmd/Scratch.hs view
@@ -28,6 +28,7 @@ showScratchSource _ _ (Just (ScratchRef ref)) = ref showScratchSource _ _ (Just (ScratchSRPM srpm)) = srpm +-- FIXME --use-srpm -- FIXME --no-tail -- FIXME --with --without ? -- FIXME allow parallel targets
src/Cmd/SrcDeps.hs view
@@ -18,6 +18,7 @@ srcDeps rev macros (rbr,pkgs) >>= mapM_ (putStrLn . unwords) +-- FIXME --undefine srcDeps :: Bool -> [String] -> (Branch,[String]) -> IO [[String]] srcDeps rev macros (rbr,pkgs) = do when (null pkgs) $
src/Cmd/Update.hs view
@@ -58,9 +58,9 @@ then findSpecfile else localBranchSpecFile pkg br curver <- pkgVersion spec- diff <- filter (not . ("@@ " `isPrefixOf`)) <$> gitLines "diff" ["-U0", "HEAD", spec]- let vdiff = filter (\v -> any (`isPrefixOf` v) ["-Version:","+Version:"]) diff- mnewrel = find ("+Release:" `isPrefixOf`) diff+ rawdiff <- filter (not . ("@@ " `isPrefixOf`)) <$> gitLines "diff" ["-U0", "HEAD", spec]+ let vdiff = filter (\v -> any (`isPrefixOf` v) ["-Version:","+Version:"]) rawdiff+ mnewrel = find ("+Release:" `isPrefixOf`) rawdiff when (length vdiff > 2) $ error' $ "diff contains complex multi-version changes:\n" ++ unlines vdiff case mver of@@ -128,25 +128,31 @@ fedpkg_ "new-sources" archives unless (null textsources) $ git_ "add" textsources- whenJust moldnewver $ \(_old,newver) -> do- whenM (yesNoDefault False "Do you want to diff the sources") $- compareTarballsCmd Nothing Nothing Nothing- versions <- changelogVersions spec- let missing =- case versions of- [] -> True- (h:_) -> not $ (newver ++ "-") `isPrefixOf` h- when missing $ do- -- FIXME newver may contain macros!- newversion <- pkgVersion spec- cmd_ "rpmdev-bumpspec" ["-c", "Update to" +-+ newversion, spec]- newrelease <- cmd "rpmspec" ["-q", "--srpm", "--undefine=dist", "--qf", "%{release}", spec]- -- revert release if was already bumped- whenJust (extractFieldValue <$> mnewrel) $ \newrel -> do- editSpecField "Release" newrel spec- cmd_ "sed" ["-i", "s/> -" +-+ newversion ++ '-' : newrelease ++ "/> -" +-+ newversion ++ '-' : replace "%{?dist}" "" newrel ++ "/" , spec]- git_ "commit" ["-a", "-m", "Update to" +-+ newversion]- putStr "Prepping... "+ case moldnewver of+ Just (_old,newver) -> do+ whenM (yesNoDefault False "Do you want to diff the sources") $+ compareTarballsCmd Nothing Nothing Nothing+ versions <- changelogVersions spec+ let missing =+ case versions of+ [] -> True+ (h:_) -> not $ (newver ++ "-") `isPrefixOf` h+ when missing $ do+ -- FIXME newver may contain macros!+ newversion <- pkgVersion spec+ cmd_ "rpmdev-bumpspec" ["-c", "Update to" +-+ newversion, spec]+ newrelease <- cmd "rpmspec" ["-q", "--srpm", "--undefine=dist", "--qf", "%{release}", spec]+ -- revert release if was already bumped+ whenJust (extractFieldValue <$> mnewrel) $ \newrel -> do+ editSpecField "Release" newrel spec+ cmd_ "sed" ["-i", "s/> -" +-+ newversion ++ '-' : newrelease ++ "/> -" +-+ newversion ++ '-' : replace "%{?dist}" "" newrel ++ "/" , spec]+ git_ "commit" ["-a", "-m", "Update to" +-+ newversion]+ Nothing -> do+ rawsdiff <- filter (not . ("@@ " `isPrefixOf`)) <$> gitLines "diff" ["-U0", "HEAD", "sources"]+ unless (null rawsdiff) $+ whenM (yesNoDefault False "Do you want to diff the sources") $+ compareTarballsCmd Nothing Nothing Nothing+ putStr "Prepping in temp dir... " sourcediropt <- sourceDirCwdOpt withTempDir $ \tempdir -> do cwd <- getCurrentDirectory
src/Cmd/WaitRepo.hs view
@@ -14,13 +14,14 @@ data WaitFetch = WaitNoFetch | WaitDirty | WaitFetch +-- FIXME allow generic waitrepo when not package? (without --no-package) -- FIXME first check/wait for build to actually exist -- FIXME check on previous/origin commit/build waitrepoCmd :: Bool -> Bool -> WaitFetch -> Maybe SideTagTarget -> (BranchesReq, [String]) -> IO ()-waitrepoCmd dryrun noNvr fetch msidetagTarget (breq,pkgs) = do+waitrepoCmd dryrun nopkg fetch msidetagTarget (breq,pkgs) = do -- FIXME detect sidetag so not mistaken for pkg- if noNvr+ if nopkg then if null pkgs then withPackagesByBranches HeaderMay False Nothing AnyNumber waitrepoBranch (breq,["."])@@ -38,6 +39,7 @@ let spec = packageSpec pkg nvr <- pkgNameVerRel' br spec target <- targetMaybeSidetag dryrun True False br msidetagTarget+ -- FIXME first wait for Bodhi to tag build kojiWaitRepoNVR dryrun False target nvr waitrepoBranchPkg _ (OtherBranch _) = error' "waitrepo only defined for release branches"
+ src/Cmd/WatchTask.hs view
@@ -0,0 +1,49 @@+module Cmd.WatchTask (+ watchTaskCmd+ )+where++import Data.Maybe (mapMaybe)+import Data.RPM.NVR (showNVR)+import Distribution.Koji (displayID, TaskID(TaskId))+import Numeric.Natural+import Safe (headMay)+import SimpleCmd (cmd_, cmdLines, error', (+-+))++import Branches (getReleaseBranch)+-- import Common.System+import Git (isPkgGitRepo)+import Koji (getKojiProfileHub, kojiGetBuildTaskID, kojiWatchTask)+import Package (getPackageName, pkgNameVerRel', packageSpec)+-- import Types++-- FIXME support watching buildArch+watchTaskCmd :: Bool -> Maybe Natural -> IO ()+watchTaskCmd progress mtaskid = do+ taskid <-+ case mtaskid of+ Just tid -> return $ TaskId $ fromIntegral tid+ Nothing -> do+ distgit <- isPkgGitRepo+ if distgit+ then do+ pkg <- getPackageName "."+ let spec = packageSpec pkg+ br <- getReleaseBranch+ nvr <- pkgNameVerRel' br spec+ hub <- getKojiProfileHub+ mbuild <- kojiGetBuildTaskID hub (showNVR nvr)+ case mbuild of+ Nothing -> error' $ "Could not find task for" +-+ showNVR nvr+ Just tid -> return tid+ else do+ opentasks <- cmdLines "koji" ["list-tasks", "--mine", "--method=build", "--quiet"]+ case mapMaybe (headMay . words) opentasks of+ [] -> error' "you have no open tasks"+ [tid] -> return $ TaskId $ read tid+ _ -> do+ mapM_ putStrLn opentasks+ error' "Specify a build taskid"+ if progress+ then cmd_ "koji-tool" ["progress", displayID taskid]+ else kojiWatchTask taskid
src/Common/System.hs view
@@ -42,7 +42,7 @@ import System.FilePath import System.IO -import Control.Exception+import Control.Exception (bracket) import Data.Time.Clock #if !MIN_VERSION_simple_cmd(0,2,5)@@ -68,6 +68,7 @@ let fmtstr | dur < 60 = "%s sec" | dur < 3600 = "%m min %S sec"+ | dur < 7200 = "%h hour %M min" | otherwise = "%h hours %M min" in formatTime defaultTimeLocale fmtstr dur #else
src/Git.hs view
@@ -61,27 +61,28 @@ -- Just True => ancestor -- Nothing => neither ancestor -- Just False => reverse ancestor+-- returns commits ahead of origin branch gitMergeable :: Branch -> Branch -> IO (Maybe Bool,[Commit]) gitMergeable target br = do- let ref = "origin/" ++ showBranch br+ let originbr = "origin/" ++ showBranch br mancestor <- do- ancestor <- gitBool "merge-base" ["--is-ancestor", "HEAD", ref]+ ancestor <- gitBool "merge-base" ["--is-ancestor", "HEAD", originbr] if ancestor then return $ Just True else do- revancestor <- gitBool "merge-base" ["--is-ancestor", ref, "HEAD"]+ revancestor <- gitBool "merge-base" ["--is-ancestor", originbr, "HEAD"] if revancestor then return $ Just False else return Nothing- commits <- gitOneLineLog ("HEAD.." ++ ref)+ commits <- gitOneLineLog ("HEAD.." ++ originbr) when (br /= target && null commits && mancestor /= Just True) $ if mancestor == Just False then do- diff <- git "diff" [ref]+ diff <- git "diff" [originbr] unless (null diff) $ do- putStrLn $ showBranch target +-+ "is ahead of" +-+ ref +-+ "!!"+ putStrLn $ showBranch target +-+ "is ahead of" +-+ originbr +-+ "!!" promptEnter "Press Enter if you want to continue"- else putStrLn $ "current branch" +-+ "is diverged from" +-+ ref+ else putStrLn $ "current branch is diverged from" +-+ originbr return (mancestor, commits) getNewerBranch :: Package -> Branch -> IO (Maybe Branch)@@ -104,11 +105,18 @@ gitMergeOrigin :: Branch -> IO () gitMergeOrigin br = do (mancestor,commits) <- gitMergeable br br- when (mancestor == Just True) $- unless (null commits) $ do- pull <- git "pull" []- unless ("Already up to date." `isPrefixOf` pull) $- putStrLn pull+ case mancestor of+ Just ahead ->+ when ahead $+ unless (null commits) $ do+ pull <- git "pull" ["origin", showBranch br]+ unless ("Already up to date." `isPrefixOf` pull) $+ putStrLn pull+ Nothing -> do+ displayHdrCommits "Missing origin commit" True commits+ yes <- yesNo "Do you want to pull --rebase"+ when yes $+ git_ "pull" ["--rebase"] -- FIXME maybe require local branch already here mergeable :: Package -> Branch -> Maybe Branch -> IO (Maybe Bool,[Commit],Branch)
src/Koji.hs view
@@ -35,8 +35,14 @@ import Data.Char (isDigit) import qualified Data.ByteString.Lazy.Char8 as B+import Control.Concurrent (threadDelay)+import Control.Exception.Extra (retry)+import Data.Either.Extra (eitherToMaybe, isRight) import Data.Fixed (Micro)+import qualified Data.Map.Strict as M+import Data.RPM (dropArch) import Data.RPM.NVR (NVR, maybeNVR)+import Data.RPM.NVRA (maybeNVRA) import Data.Time.Clock import Data.Time.Format import Data.Time.LocalTime@@ -48,9 +54,10 @@ import Safe (headMay, tailSafe) import Say (sayString) import SimplePrompt (promptEnter, promptNonEmpty, yesNo)+import System.Console.Pretty (color, Color(Cyan)) import System.Environment (lookupEnv) import System.Exit-import System.Process.Typed+import System.Process.Typed (proc, readProcessStdout) import System.Timeout (timeout) import System.Time.Extra (sleep) @@ -139,8 +146,8 @@ then error' "no args passed to koji build" else ".src.rpm" `isSuffixOf` last args -- FIXME use tee functionality- when srpm $ putStrLn "koji srpm build: uploading..." mprofile <- getKojiProfile+ when srpm $ putStrLn $ "koji srpm build: uploading..." +-+ maybe "" ("to" +-+) mprofile -- can fail like: -- [ERROR] koji: Request error: POST::https://koji.fedoraproject.org/kojihub/ssllogin::<PreparedRequest [POST]> -- [ERROR] koji: AuthError: unable to obtain a session@@ -174,32 +181,184 @@ kojiProfileOpt Nothing = [] kojiProfileOpt (Just p) = ["--profile", p] --- FIXME filter/simplify output--- FIXME implement native watchTask+-- # Native Watch Task++threadDelaySeconds :: Int -> IO ()+threadDelaySeconds m =+ -- convert seconds to microseconds+ threadDelay (fromEnum (fromIntegral m :: Micro))++-- FIXME import from koji-hs once released+showTaskState :: TaskState -> String+showTaskState state =+ case state of+ TaskFree -> "free"+ TaskOpen -> "open"+ TaskClosed -> "closed"+ TaskCanceled -> "Canceled"+ TaskAssigned -> "assigned"+ TaskFailed -> "FAILED"++data TaskStatus a =+ TaskStatus { tsId :: Int -- FIXME should be TaskID+ , tsArch :: String -- FIXME use Arch type+ , tsHostId :: Int+ , tsMethod :: String+ , tsNVR :: Maybe NVR+ , tsState :: a}++readTaskStatus :: Struct -> Maybe (TaskStatus TaskState)+readTaskStatus st = do+ tid <- lookupStruct "id" st+ arch <- lookupStruct "arch" st+ hostid <- lookupStruct "host_id" st+ let mnvr = eitherToMaybe $ kojiTaskRequestNVRTag st+ method <- lookupStruct "method" st+ state <- readTaskState <$> lookupStruct "state" st+ return $ TaskStatus tid arch hostid method mnvr state++kojiGetTaskState' :: String -- ^ hub url+ -> TaskID+ -> IO TaskState+kojiGetTaskState' hub taskid = do+ mstate <- retry 2 $ kojiGetTaskState hub taskid+ case mstate of+ Nothing -> error' $ "No state for task" +-+ displayID taskid+ Just state -> return state++-- FIXME return failures+kojiWatchBuildTask :: String -> TimeZone -> Bool -> TaskID -> IO ()+kojiWatchBuildTask hub tz nvrdisplayed' taskid = do+ current <- getChildrenTasks+ nvrdisplayed <- maybeDisplayNVR nvrdisplayed' current+ mapM_ printHost current+ mapM_ (printTaskState showTaskState) current+ loopWatch nvrdisplayed current+ where+ getChildrenTasks =+ -- fbrnch: user error (502 Bad Gateway)+ sortOn tsId . mapMaybe readTaskStatus <$> retry 2 (kojiGetTaskChildren hub taskid True)++ pad txt suffix =+ let spaces = 8 - length txt+ in txt ++ suffix ++ replicate spaces ' '++ -- FIXME create a host cache+ printHost ts = do+ let txt =+ let method = tsMethod ts in+ if method == "buildArch"+ then tsArch ts+ else+ if "SRPM" `isInfixOf` method+ then "src"+ else method+ host <- Koji.getHost hub (Koji.InfoID $ tsHostId ts) Nothing+ whenJust (lookupStruct "name" host) $ \name ->+ sayString $ pad txt ":" +-+ name++ printTaskState render ts =+ logSay tz $ parens (show (tsId ts)) +-+ maybeMethod +-+ pad (tsArch ts) ":" +-+ render (tsState ts)+ where+ maybeMethod =+ let method = tsMethod ts+ in if method == "buildArch" then "" else method++ maybeDisplayNVR nvrdisplayed current =+ if nvrdisplayed+ then return True+ else+ case mapMaybe tsNVR current of+ [] -> return False+ (nvr:_) -> do+ putStrLn $ "Koji NVR:" +-+ color Cyan (showNVR nvr)+ return True++ loopWatch wasdisplayed previous = do+ current <- getChildrenTasks+ nvrdisplayed <- maybeDisplayNVR wasdisplayed current+ mapM_ printTaskChange $ updateStates previous current+ if any (\t -> tsState t `elem` openTaskStates) current+ then do+ threadDelaySeconds 31+ loopWatch nvrdisplayed current+ else do+ pstate <- kojiGetTaskState' hub taskid+ when (pstate `elem` openTaskStates) $ do+ threadDelaySeconds 31+ loopWatch nvrdisplayed current++ updateStates :: [TaskStatus TaskState] -> [TaskStatus TaskState] -> [TaskStatus (Maybe TaskState,TaskState)]+ updateStates previous current =+ let old = M.fromList [ (tsId task, tsState task) | task <- previous]+ addOld ts =+ let moldState = M.lookup (tsId ts) old+ in ts {tsState = (moldState, tsState ts)}+ in map addOld current++ printTaskChange ts =+ let (mold,new) = tsState ts in+ do+ when (isNothing mold) $+ printHost ts+ unless (mold == Just new) $+ let change = maybe "" (\s -> showTaskState s +-+ "->") mold +-+ showTaskState new+ in printTaskState id $ ts {tsState = change}++kojiWatchTask1 :: String -> TaskID -> IO (String, TaskState) -- method+kojiWatchTask1 hub taskid = do+ mtaskinfo <- kojiGetTaskInfo hub taskid+ case mtaskinfo of+ Nothing -> error' $ "no taskinfo for task" +-+ displayID taskid+ Just taskinfo -> do+ case kojiTaskRequestNVRTag taskinfo of+ Left pkgtag -> sayString $ color Cyan pkgtag+ Right nvr -> sayString $ showNVR nvr+ let mstate = getTaskState taskinfo+ case mstate of+ Nothing -> error' $ "No state for task" +-+ displayID taskid+ Just state -> do+ tz <- getCurrentTimeZone+ case lookupStruct "method" taskinfo of+ Nothing -> error' $ "No method for task" +-+ displayID taskid+ Just method -> do+ when (state `elem` openTaskStates) $+ logSay tz $+ parens (displayID taskid) +-+ method ++ ":" +-+ showTaskState state+ kojiDoWatchTask tz method state+ where+ kojiDoWatchTask tz method oldstate = do+ if method == "build" && oldstate /= TaskFree+ then kojiWatchBuildTask hub tz (isRight $ kojiTaskRequestNVRTag taskinfo) taskid+ else threadDelaySeconds 30+ state <- kojiGetTaskState' hub taskid+ when (state /= oldstate) $ do+ logSay tz $+ parens (displayID taskid) +-+ method ++ ":" +-+ showTaskState oldstate +-+ "->" +-+ showTaskState state+ if state `elem` openTaskStates+ then kojiDoWatchTask tz method state+ else do+ logSay tz $+ parens (displayID taskid) +-+ method ++ ":" +-+ showTaskState state+ return (method,state)++-- FIXME print target tag kojiWatchTask :: TaskID -> IO () kojiWatchTask task = do mprofile <- getKojiProfile- -- FIXME can error:- -- eg1 [ERROR] koji: HTTPError: 503 Server Error: Service Unavailable for url: https://koji.fedoraproject.org/kojihub- -- eg2 [ERROR] koji: ServerOffline: database outage: - user error (Error 1014: database outage)- -- eg3 [ERROR] koji: ReadTimeout: HTTPSConnectionPool(host='koji.fedoraproject.org', port=443): Read timed out. (read timeout=43200)- -- This might error with exit 0 occasionally so we check the taskstate always- void $ cmdBool "koji" $ kojiProfileOpt mprofile ++ ["watch-task", displayID task]+ -- (2026) seeing frequent timeouts for each build (every few minutes) hub <- getKojiProfileHub' mprofile- mst <- kojiGetTaskState hub task- case mst of- Just TaskClosed -> return ()- Just TaskFailed -> do- whenJustM (findExecutable "koji-tool") $ \kojitool -> do- cmdLog_ kojitool ["tasks", "--hub", hub, "--children", displayID task, "--tail", "-s", "fail"]- putTaskinfoUrl hub task- error' "Task failed!"- Just TaskCanceled -> return ()- _ -> kojiWatchTask task+ (method,state) <- kojiWatchTask1 hub task+ when (state == TaskFailed) $ do+ whenJustM (findExecutable "koji-tool") $ \kojitool -> do+ cmdLog_ kojitool ["tasks", "--hub", hub, "--children", displayID task, "--tail", "-s", "fail"]+ putTaskinfoUrl hub task+ (if state == TaskClosed then putStrLn else error') $+ method +-+ "task" +-+ showTaskState state putTaskinfoUrl :: String -> TaskID -> IO () putTaskinfoUrl hub tid =- putStrLn $ dropSuffix "hub" hub +/+ "taskinfo?taskID=" ++ show (getID tid)+ putStrLn $ dropSuffix "hub" hub +/+ "taskinfo?taskID=" ++ displayID tid -- FIXME during network disconnection: -- Connection timed out: retrying@@ -211,16 +370,13 @@ -- FIXME can error: -- eg1 [ERROR] koji: HTTPError: 503 Server Error: Service Unavailable for url: https://koji.fedoraproject.org/kojihub -- eg2 [ERROR] koji: ServerOffline: database outage: - user error (Error 1014: database outage)- mst <- maybeTimeout 45 $ kojiGetTaskState hub task- case mst of- Just ts ->- if ts `elem` openTaskStates- then do- sleep 20- kojiWaitTask task- else return $ ts == TaskClosed- Nothing -> do- error $ "failed to get info for koji task" +-+ displayID task+ -- was: maybeTimeout 45 $+ state <- kojiGetTaskState' hub task+ if state `elem` openTaskStates+ then do+ sleep 20+ kojiWaitTask task+ else return $ state == TaskClosed kojiSource :: Package -> String -> String kojiSource pkg ref =@@ -256,22 +412,23 @@ -- 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 hub <- getKojiProfileHub (buildtag,_desttag) <- kojiBuildTarget' hub target unless dryrun $ do- tz <- getCurrentTimeZone- unless quiet $- logSay tz $ "Waiting for" +-+ buildtag +-+ "to have" +-+- case nvrs of- [nvr] -> showNVR nvr- _ -> "builds"+ unless quiet $ do+ tz <- getCurrentTimeZone+ logSay tz $ "Waiting for" +-+ buildtag +-++ case nvrs of+ [] -> ""+ [nvr] -> "to have" +-+ showNVR nvr+ _ -> "to have builds" mprofile <- getKojiProfile -- 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" -- or "No clang18 builds in tag epel10.1-build"+ krbTicket void $ timeIO $ cmd "koji" (kojiProfileOpt mprofile ++ ["wait-repo", "--request", "--quiet"] ++ ["--build=" ++ showNVR nvr | nvr <- nvrs] ++ [buildtag]) kojiWaitRepoNVR :: Bool -> Bool -> String -> NVR -> IO ()@@ -280,15 +437,8 @@ -- FIXME display more status/age info kojiWaitRepo :: Bool -> Bool -> String -> IO ()-kojiWaitRepo dryrun quiet target = do- hub <- getKojiProfileHub- (buildtag,_desttag) <- kojiBuildTarget' hub target- tz <- getCurrentTimeZone- unless quiet $- logSay tz $ "Waiting for" +-+ buildtag- unless dryrun $ do- mprofile <- getKojiProfile- void $ timeIO $ cmd "koji" $ kojiProfileOpt mprofile ++ ["wait-repo", "--request", "--quiet", buildtag]+kojiWaitRepo dryrun quiet target =+ kojiWaitRepoNVRs dryrun quiet target [] kojiTagArchs :: String -> IO [String] kojiTagArchs tag = do@@ -402,3 +552,36 @@ if lower ans `elem` ["0", "q", "quit", "no"] then error' "aborting" else promptTags numtags txt++-- modified from koji-tool Utils+-- FIXME better to handle build and buildArch separately+-- FIXME in theory could read tagId for buildArch+kojiTaskRequestNVRTag :: Struct -> Either String NVR+kojiTaskRequestNVRTag task =+ case lookupStruct "request" task of+ Just req@(source:rest) ->+ case getString source of+ -- non-build task+ Nothing -> Left $ unwords $ map showValue $ take 2 req+ Just src ->+ case maybeNVRA src of+ Just nvra | not (".git#" `isInfixOf` src) ->+ Right $ dropArch nvra+ _ -> let base = takeBaseName src+ mtag = headMay rest >>= getString+ in+ Left $+ -- fedora-ci_fc87dcd7db694cdfac703cf5af128a72_c1f53c859616fdbf40811058b60bebe2930e3271_0;forks:petersen:rpms:grub2.f38.src.rpm+ (if "fedora-ci_" `isPrefixOf` base+ then takeWhileEnd (/= ':') $ dropPrefix ";" $ dropWhile (/= ';') base+ else base) +-+ fromMaybe "" mtag+ _ -> error' "could not determine package from build request"+ where+ showValue :: Value -> String+ showValue (ValueString cs) = cs+ showValue (ValueInt i) = show i+ showValue val = show val++parens :: String -> String+parens str =+ '(' : str ++ ")"
src/Main.hs view
@@ -55,6 +55,7 @@ import Cmd.Update import Cmd.UpdateReview import Cmd.WaitRepo+import Cmd.WatchTask import Bodhi (UpdateType(..), UpdateSeverity(..), UpdateNotes(..)) import Branches@@ -142,7 +143,7 @@ <*> mergeOpt <*> optional (optionWith branchM 'f' "from" "BRANCH" "Branch to merge from [default newer]") <*> optionalWith auto 'l' "skip-to-layer" "LAYERNO" "Skip the first N layers [default 0]" 0- <*> optional (sidetagTargetOpt $ Just "or creates one for you (with 'fedpkg request-side-tag --base-tag')")+ <*> optional (sidetagTargetOpt $ Just "or creates new one (with 'fedpkg request-side-tag --base-tag')") <*> switchLongWith "must-push" "Error if no unpushed commits" <*> optionalWith auto 'd' "delay" "SECONDS" "Sleep delay between starting builds [default 1s]" 1 <*> updateOpt@@ -164,10 +165,14 @@ , Subcommand "waitrepo" "Wait for build to appear in Koji buildroot" $ waitrepoCmd <$> dryrunOpt "Dry run: do not wait"- <*> switchLongWith "no-nvr" "Generic wait-repo without a build NVR"+ <*> switchLongWith "no-package" "Generic wait-repo without a build NVR" <*> waitfetchOpt <*> optional (sidetagTargetOpt Nothing) <*> branchesPackages+ , Subcommand "watchtask" "Watch a koji build task" $+ watchTaskCmd+ <$> switchLongWith "progress" "Use koji-tool progress"+ <*> optional (argumentWith auto "TASKID") , Subcommand "scratch" "Scratch build package in Koji" $ scratchCmd <$> dryrunOpt "Dry run: do not build"@@ -251,8 +256,8 @@ , Subcommand "compare-tarballs" "Diff source tarballs" $ compareTarballsCmd <$> optional (optionLongWith auto "max-line-length" "LENGTH" "Skip diff files longer than this [default 200]")- <*> optional (strArg "[NAME-]VERSION1")- <*> optional (strArg "[NAME-]VERSION2")+ <*> optional (strArg "[NAME-]VERSION1[.tar.gz]")+ <*> optional (strArg "[NAME-]VERSION2[.tar.gz]") , Subcommand "src-deps" "List source package dependencies" $ srcDepsCmd <$> switchWith 'r' "reverse" "Reverse dependencies"@@ -310,7 +315,7 @@ <*> optional (strOptionWith 'm' "message" "COMMITMSG" "Specify commit message") <*> optional (strOptionWith 'c' "changelog" "CLOGENTRY"- "Override changelog entry [default: rebuild]")+ "Override changelog entry [default: Rebuild]") <*> branchesPackages , Subcommand "commit" "Git commit packages" $ commitCmd@@ -655,7 +660,7 @@ updatePair ty sv = (ty,sv) forceshortOpt =- flagWith' ForceBuild 'f' "rebuild" "Rebuild even if already built" <|>+ flagWith' ForceBuild 'f' "force-build" "Rebuild even if already built" <|> flagWith' ShortCompile 'c' "short-compile" "Do rpmbuild --short-circuit -bc" <|> flagWith' ShortInstall 's' "short-install" "Do rpmbuild --short-circuit -bi"
src/Package.hs view
@@ -179,6 +179,7 @@ Nothing -> error' $ "No spec file for:" +-+ unPackage pkg else findSpecfile +-- FIXME should pass Package name (since may be dirpath) withExistingDirectory :: FilePath -> IO a -> IO a withExistingDirectory dir act = do exists <- doesDirectoryExist dir@@ -560,6 +561,7 @@ -- toPackage (Unknown p) = p -- toPackage (IsBr b) = error' $ "can't map branch to package:" +-+ show b +-- FIXME do not edit more than one Version field!! (eg ghc-hadrian) editSpecField :: String -> String -> FilePath -> IO () editSpecField field new spec = cmd_ "sed" ["-i", "-e s/^\\(" ++ field ++ ":\\s\\+\\).*/\\1" ++ new ++ "/", spec]@@ -583,7 +585,6 @@ (".crate" `isSuffixOf`), (".gpg" `isSuffixOf`), (".tgz" `isSuffixOf`)]- && not (".sig" `isSuffixOf` f) sourceDirCwdOpt :: IO [String] sourceDirCwdOpt = do
src/RpmBuild.hs view
@@ -354,9 +354,9 @@ 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+ let buildcmd = "rpmbuild" : map quoteArg args+ when debug $ putStrLn $ unwords buildcmd+ cmdBool "script" ["-c", unwords buildcmd, buildlog] else do let buildcmd = unwords $ "rpmbuild" : map quoteArg args ++ [">&", buildlog] when debug $ putStrLn buildcmd@@ -409,9 +409,9 @@ 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+ let buildcmd = "rpmbuild" : map quoteArg args+ when debug $ putStrLn $ unwords buildcmd+ cmdBool "script" ["-c", unwords buildcmd, buildlog] else do let buildcmd = unwords $ "rpmbuild" : map quoteArg args ++ [">&", buildlog] when debug $ putStrLn buildcmd@@ -492,22 +492,15 @@ checkSourcesMatch :: Package -> AnyBranch -> FilePath -> IO () checkSourcesMatch pkg br spec = do- -- "^[Ss]ource[0-9]*:"- sourcefiles <- map (takeFileName . last . words) <$> cmdLines "spectool" [spec]- sources <- do- exists <- doesFileExist "sources"- if exists- then lines <$> readFile "sources"- else return []- gitfiles <- gitLines "ls-files" ["--no-cached"]- -- FIXME warn about non-sha512 sources- let missing = filter (\src -> isNothing (find (\s -> ('(' : src ++ ")") `isInfixOf` s || (' ' : src) `isSuffixOf` s) sources) && src `notElem` gitfiles)- sourcefiles- unless (null missing) $ do+ (sources,missing) <- doCheckSources+ if null missing+ then mapM_ checkLookasideCache sources+ else do -- FIXME maybe change to yesNo promptEnter $ color Red $ unwords missing +-+ "not in" +-+ unPackage pkg +-+ "'sources', press Enter to fix"- -- FIXME check if already fixed before proceeding- updateSourcesPkg False False True Nothing pkg br+ (sources',missing') <- doCheckSources+ unless (null missing') $+ updateSourcesPkg False False True Nothing pkg br git_ "status" ["--short"] ok <- yesNo "Amend commit" when ok $ git_ "commit" ["--amend"]@@ -515,8 +508,22 @@ error' "local changes remain (dirty)" checkOnBranch checkSourcesMatch pkg br spec- mapM_ checkLookasideCache sources+ mapM_ checkLookasideCache sources' where+ doCheckSources = do+ -- "^[Ss]ource[0-9]*:"+ sourcefiles <- map (takeFileName . last . words) <$> cmdLines "spectool" [spec]+ sources <- do+ exists <- doesFileExist "sources"+ if exists+ then lines <$> readFile "sources"+ else return []+ gitfiles <- gitLines "ls-files" ["--no-cached"]+ -- FIXME warn about non-sha512 sources+ let missing = filter (\src -> isNothing (find (\s -> ('(' : src ++ ")") `isInfixOf` s || (' ' : src) `isSuffixOf` s) sources) && src `notElem` gitfiles)+ sourcefiles+ return (sources,missing)+ checkLookasideCache :: String -> IO () checkLookasideCache source = do let lookaside = "https://src.fedoraproject.org/lookaside/pkgs" +/+ unPackage pkg