fbrnch 0.9 → 0.9.1
raw patch · 24 files changed
+462/−265 lines, 24 filesdep +rpm-nvrdep −fbrnchdep ~base
Dependencies added: rpm-nvr
Dependencies removed: fbrnch
Dependency ranges changed: base
Files
- CHANGELOG.md +25/−0
- README.md +10/−8
- fbrnch.cabal +16/−55
- libs/bodhi-hs/src/Fedora/Bodhi.hs +3/−1
- libs/fedora-dists/src/Distribution/Fedora/Branch.hs +1/−1
- libs/pagure-hs/src/Fedora/Pagure.hs +1/−1
- src/Bugzilla.hs +4/−0
- src/Cmd/Build.hs +4/−1
- src/Cmd/Import.hs +1/−1
- src/Cmd/Install.hs +30/−21
- src/Cmd/ListBranches.hs +1/−1
- src/Cmd/Local.hs +55/−18
- src/Cmd/Mock.hs +5/−3
- src/Cmd/Override.hs +1/−1
- src/Cmd/Repoquery.hs +19/−0
- src/Cmd/RequestBranch.hs +12/−8
- src/Cmd/RequestRepo.hs +1/−0
- src/Cmd/Reviews.hs +1/−1
- src/Cmd/Scratch.hs +20/−10
- src/Cmd/WaitRepo.hs +13/−12
- src/InterleaveOutput.hs +5/−4
- src/Krb.hs +1/−1
- src/Main.hs +164/−43
- src/Package.hs +69/−74
CHANGELOG.md view
@@ -1,5 +1,30 @@ # Changelog +## 0.9.1 (2021-07-29)+- 'prep': cleaner output+- 'reviews': pre-sort by bug id+- 'scratch': --ref to specify a commit other than HEAD to build+- 'scratch': correct --no-fast-fail to --no-fail-fast+- 'build': --no-fast-fail now works+- 'install': header if multiple pkgs and reinstall if force+- 'install': better output and show number of packages+- 'install': dnf builddep for missing (non-local) deps+- 'install': add --verbose to show buildlog+- 'command': --continue/-k (rename -k/--compact to -1)+- 'command': --compact outputs package name on same line+- 'command': also continue through errors for --if-output+- 'command': ignore dead.package's completely+- 'diff': fix help string for --stats+- 'request-repos': newline between packages+- 'request-branches': print package and/or branch, when multiple+- 'branches': use readBranch to avoid error for fc6+- buildRPMs: pipe to tee for build.log+- Package: getSources now checks for and downloads patches too+- Package: buildRPMs timestamp for build+- Package: installDeps simplify output and use --quiet+- Package: improve output messages for prep and rpm build failures+- Package: getSources check if fedpkg available when pulling sources+ ## 0.9 (2021-05-30) - 'override' --duration and run waitrepo after all overrides - new 'waitrepo' command
README.md view
@@ -287,18 +287,20 @@ It also makes use of: - curl - rpmbuild & rpmspec-- klist+- klist and fkinit - git - ssh & scp (for uploading package reviews) -## Contributing-Bug reports, feedback, and fixes are welcome.+## Contribute+Bug reports, feedback, and pull requests welcome. +Do report any unsupported or unintuitive workflow steps.+ See the TODO list and also the FIXME comments scattered across the source.-Please ask before embarking on large changes.+Please open an issue before embarking on large changes. -## Usual disclaimer-fbrnch comes without an warranty.-It is still actively being developed.+Committers so far: -Please report any unsupported or unintuitive parts of workflows.+<a href="https://github.com/juhp/fbrnch/graphs/contributors">+ <img src="https://contributors-img.web.app/image?repo=juhp/fbrnch" />+</a>
fbrnch.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: fbrnch-version: 0.9+version: 0.9.1 synopsis: Build and create Fedora package repos and branches description: fbrnch is a convenient packaging tool for Fedora Packagers,@@ -20,7 +20,7 @@ . - progressive copr builds .- - and many more commands.+ and many more commands. homepage: https://github.com/juhp/fbrnch bug-reports: https://github.com/juhp/fbrnch/issues license: GPL-2@@ -69,6 +69,7 @@ Cmd.Parallel Cmd.PkgReview Cmd.Pull+ Cmd.Repoquery Cmd.RequestBranch Cmd.RequestRepo Cmd.Reviews@@ -101,18 +102,24 @@ Distribution.Fedora.ReadProducts -- pdc Fedora.PDC+ -- bodhi+ Fedora.Bodhi+ -- pagure+ Fedora.Pagure hs-source-dirs: src libs/copr-hs/src libs/fedora-dists/src libs/pdc-hs/src+ libs/bodhi-hs/src+ libs/pagure-hs/src default-language: Haskell2010 build-depends: aeson, async, -- pretty-terminal needs 4.9: base >= 4.9 && < 5,- bodhi-internal,+ -- bodhi, bugzilla-redhat >= 0.3, bytestring, config-ini,@@ -128,10 +135,11 @@ koji, network-uri, optparse-applicative,- pagure-internal,+ -- pagure, pretty-terminal, process, rpmbuild-order >= 0.4.5,+ rpm-nvr, simple-cmd >= 0.2.0, simple-cmd-args >= 0.1.6, text,@@ -140,7 +148,10 @@ utf8-string, xdg-basedir, -- for copr:- unordered-containers+ unordered-containers,+ -- for bodhi and pagure:+ lens,+ lens-aeson if impl(ghc<8.0) build-depends: semigroups@@ -160,53 +171,3 @@ -Wpartial-fields if impl(ghc >= 8.10) ghc-options: -Wunused-packages---library bodhi-internal- build-depends: aeson,- base >= 4 && < 5,- http-query,- text,- time,- lens,- lens-aeson- default-language: Haskell2010- default-extensions: OverloadedStrings- hs-source-dirs: libs/bodhi-hs/src- exposed-modules: Fedora.Bodhi- ghc-options: -Wall- if impl(ghc >= 8.0)- ghc-options: -Wcompat- -Widentities- -Wincomplete-uni-patterns- -Wincomplete-record-updates- -Wredundant-constraints- if impl(ghc >= 8.2)- ghc-options: -fhide-source-paths- if impl(ghc >= 8.4)- ghc-options: -Wmissing-export-lists- -Wpartial-fields--library pagure-internal- build-depends: aeson,- base >= 4 && < 5,- http-query,- text,- lens,- lens-aeson- default-language: Haskell2010- default-extensions: OverloadedStrings- hs-source-dirs: libs/pagure-hs/src- exposed-modules: Fedora.Pagure- ghc-options: -Wall- if impl(ghc >= 8.0)- ghc-options: -Wcompat- -Widentities- -Wincomplete-uni-patterns- -Wincomplete-record-updates- -Wredundant-constraints- if impl(ghc >= 8.2)- ghc-options: -fhide-source-paths- if impl(ghc >= 8.4)- ghc-options: -Wmissing-export-lists- -Wpartial-fields
libs/bodhi-hs/src/Fedora/Bodhi.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, OverloadedStrings #-} {- | Copyright: (c) 2020 Jens Petersen@@ -142,6 +142,8 @@ -- -- https://bodhi.fedoraproject.org/docs/server_api/rest/releases.html#service-1 bodhiReleases :: Query -> IO [Object]+-- FIXME handle errors:+-- fromList [("status",String "error"),("errors",Array [Object (fromList [("location",String "body"),("name",String "name"),("description",String "No such release")])])] bodhiReleases params = do res <- queryBodhi params "releases/" return $ res ^.. key "releases" . values . _Object
libs/fedora-dists/src/Distribution/Fedora/Branch.hs view
@@ -74,7 +74,7 @@ readBranch' :: String -> Branch readBranch' bs = case eitherBranch bs of- Left e -> error' $ "unknown Fedora branch: " ++ e+ Left e -> error' $! "unknown Fedora branch: " ++ e Right br -> br -- | Read a Branch name (one of the list of active branches)
libs/pagure-hs/src/Fedora/Pagure.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, OverloadedStrings #-} {- | Copyright: (c) 2020 Jens Petersen
src/Bugzilla.hs view
@@ -45,6 +45,7 @@ getComments, -- reviewBugToPackage,+ sortBugsByID, sortBugsByProduct, sortBugsByStatus, -- output@@ -328,6 +329,9 @@ readIniConfig inifile iniparser fn = do ini <- T.readFile inifile return $ either error fn $ parseIniFile ini iniparser++sortBugsByID :: [Bug] -> [Bug]+sortBugsByID = sortOn bugId sortBugsByStatus :: [Bug] -> [Bug] sortBugsByStatus = sortOn (bugStatusEnum . bugStatus)
src/Cmd/Build.hs view
@@ -35,9 +35,12 @@ -- FIXME vertical vs horizontal builds (ie by package or branch) -- FIXME --rpmlint (only run for rawhide?) -- FIXME support --wait-build=NVR+-- FIXME build from ref -- FIXME provide direct link to failed task/build.log -- FIXME --auto-override for deps in testing -- FIXME -B fails to find new branches+-- FIXME --no-wait+-- FIXME --ignore-dirty?? buildCmd :: BuildOpts -> (BranchesReq, [String]) -> IO () buildCmd opts (breq, pkgs) = do let singleBrnch = if isJust (buildoptTarget opts)@@ -156,7 +159,7 @@ error' "local changes remain (dirty)" -- FIXME parse build output unless dryrun $- kojiBuildBranch target pkg mbuildref ["--fail-fast"]+ kojiBuildBranch target pkg mbuildref ["--fail-fast" | not (buildoptNoFailFast opts)] mBugSess <- if firstBuild then do
src/Cmd/Import.hs view
@@ -77,7 +77,7 @@ existing <- fedoraBranchesNoRawhide (localBranches False) when (null existing) $ do brs <- getRequestedBranches breq- requestPkgBranches mock (Branches brs) (Package pkg)+ requestPkgBranches False mock (Branches brs) (Package pkg) when (pkg /= takeFileName dir) $ setCurrentDirectory dir where
src/Cmd/Install.hs view
@@ -3,22 +3,27 @@ notInstalledCmd ) where +import Data.RPM+ import Branches import Common import Common.System import Git import Package+import Prompt -- FIXME package countdown -- FIXME --ignore-uninstalled subpackages -- FIXME --skip-unavailable -- FIXME --check any/all of package installed-installCmd :: Bool -> Maybe ForceShort -> [BCond] -> Bool+installCmd :: Bool -> Bool -> Maybe ForceShort -> [BCond] -> Bool -> (Maybe Branch,[String]) -> IO ()-installCmd recurse mforceshort bconds reinstall (mbr, pkgs) = do+installCmd verbose recurse mforceshort bconds reinstall (mbr, pkgs) = do when (recurse && mforceshort == Just ShortCircuit) $ error' "cannot use --recurse and --shortcircuit"- withPackagesMaybeBranch Nothing Nothing ZeroOrOne installPkg (mbr, pkgs)+ when (length pkgs > 3) $+ putStrLn $ show (length pkgs) ++ " packages"+ withPackagesMaybeBranch (Just (length pkgs > 1)) Nothing ZeroOrOne installPkg (mbr, pkgs) where installPkg :: Package -> AnyBranch -> IO () installPkg pkg br = do@@ -26,14 +31,14 @@ spec <- localBranchSpecFile pkg br rpms <- builtRpms br spec -- removing arch- let packages = map takeNVRName rpms- installed <- filterM pkgInstalled packages+ let packages = map (readNVRA . takeFileName) rpms+ installed <- filterM rpmInstalled packages if isJust mforceshort || null installed || reinstall- then doInstallPkg spec rpms installed- else putStrLn $ unwords installed ++ " already installed!\n"+ then doInstallPkg mforceshort spec rpms installed+ else putStrLn $ unwords (map showNVRA installed) ++ " already installed!\n" where- doInstallPkg spec rpms installed = do- putStrLn $ takeBaseName (head rpms) ++ "\n"+ doInstallPkg mforceshort' spec rpms installed = do+ putStrLn $ (showNVR . dropArch . readNVRA . takeFileName) (head rpms) missingdeps <- nub <$> (buildRequires spec >>= filterM notInstalled) unless (null missingdeps) $ if recurse@@ -45,20 +50,24 @@ mpkgdir <- lookForPkgDir rbr ".." dep case mpkgdir of Nothing -> putStrLn $ dep ++ " not known"- Just pkgdir -> installCmd recurse mforceshort bconds reinstall (mbr, [pkgdir]) >> putStrLn ""- -- FIXME option to install missing deps- else error' $ "missing deps:\n" ++ unlines missingdeps- buildRPMs True mforceshort bconds rpms br spec- putStrLn ""- unless (mforceshort == Just ShortCircuit) $- if reinstall then do- let reinstalls = filter (\ f -> takeNVRName f `elem` installed) rpms+ Just pkgdir -> installCmd verbose recurse mforceshort bconds reinstall (mbr, [pkgdir]) >> putStrLn ""+ -- FIXME option to enable/disable installing missing deps+ else installDeps True spec+ wasbuilt <- buildRPMs (not verbose) mforceshort' bconds rpms br spec+ unless (mforceshort' == Just ShortCircuit) $+ if reinstall || mforceshort' == Just ForceBuild+ then do+ let reinstalls = filter (\ f -> (readNVRA . takeFileName) f `elem` installed) rpms unless (null reinstalls) $ sudo_ "/usr/bin/dnf" $ "reinstall" : "-q" : "-y" : reinstalls let remaining = filterDebug $ rpms \\ reinstalls unless (null remaining) $ sudo_ "/usr/bin/dnf" $ "install" : "-q" : "-y" : remaining- else sudo_ "/usr/bin/dnf" $ "install" : "-q" : "-y" : filterDebug rpms+ else do+ ok <- cmdBool "sudo" $ "/usr/bin/dnf" : "install" : "-q" : "-y" : filterDebug rpms+ unless (ok || wasbuilt) $ do+ prompt_ "Press Enter to rebuild package"+ doInstallPkg (Just ForceBuild) spec rpms installed lookForPkgDir :: Branch -> FilePath -> String -> IO (Maybe FilePath) lookForPkgDir rbr topdir p = do@@ -98,10 +107,10 @@ unless dead $ do spec <- findSpecfile rpms <- builtRpms br spec- let packages = map takeBaseName rpms- installed <- filterM pkgInstalled packages+ let packages = map (readNVRA . takeFileName) rpms+ installed <- filterM rpmInstalled packages when (null installed) $ do- let pkgnames = map nameOfNVR packages+ let pkgnames = map rpmName packages older <- filterM pkgInstalled pkgnames if null older then putStrLn $ unPackage pkg
src/Cmd/ListBranches.hs view
@@ -82,7 +82,7 @@ putStrLn $ (unwords . map show) result else do branches <- listOfBranches True False breq- let havebrs = filter (`elem` branches) $ map readBranch' brs+ let havebrs = filter (`elem` branches) $ mapMaybe readBranch brs result = if missing then branches \\ havebrs else havebrs unless (null result) $ do putStr $ unPackage pkg ++ ": "
src/Cmd/Local.hs view
@@ -12,13 +12,16 @@ import System.Environment import qualified System.Process as P import qualified System.Process.Typed as TP+import System.Exit import Branches import Common import Common.System import Git+import InterleaveOutput (cmdSilent') import Package +-- FIXME generate build.log files localCmd :: Maybe ForceShort -> [BCond] -> (BranchesReq, [String]) -> IO () localCmd mforceshort bconds = withPackageByBranches Nothing Nothing ZeroOrOne localBuildPkg@@ -29,7 +32,7 @@ rpms <- if isJust mforceshort then return [] else builtRpms br spec- buildRPMs False mforceshort bconds rpms br spec+ void $ buildRPMs False mforceshort bconds rpms br spec installDepsCmd :: (Maybe Branch,[String]) -> IO () installDepsCmd =@@ -50,8 +53,36 @@ -- FIXME option to clone package prepCmd :: (Maybe Branch,[String]) -> IO ()-prepCmd =- withPackagesMaybeBranch Nothing Nothing ZeroOrOne prepPackage+prepCmd (breq,pkgs) =+ withPackagesMaybeBranch Nothing Nothing ZeroOrOne prepPackage (breq,pkgs)+ where+ prepPackage :: Package -> AnyBranch -> IO ()+ prepPackage pkg br = do+ dead <- doesFileExist "dead.package"+ if dead+ then do+ when (length pkgs > 1)$+ putStr $ unPackage pkg ++ ": "+ putStrLn "dead.package"+ else do+ spec <- localBranchSpecFile pkg br+ unlessM (doesFileExist spec) $+ error' $ spec ++ " not found"+ cwd <- getCurrentDirectory+ void $ getSources spec+ gitDir <- isGitRepo+ let rpmdirs =+ [ "--define="++ mcr +-+ cwd | gitDir,+ mcr <- ["_builddir", "_sourcedir"]]+ args = rpmdirs ++ ["-bp", spec]+ case br of+ RelBranch rbr -> do+ nvr <- pkgNameVerRel' rbr spec+ -- newline avoids error starting on same line+ putStr $ "Prepping " ++ nvr ++ ": "+ _ -> return ()+ cmdSilent' "rpmbuild" args+ putStrLn "done" nvrCmd :: (BranchesReq, [String]) -> IO () nvrCmd =@@ -69,26 +100,32 @@ >>= putStrLn -- FIXME option to require spec file?-commandCmd :: Bool -> String -> (BranchesReq,[String]) -> IO ()-commandCmd ifoutput cs =+commandCmd :: Bool -> Bool -> Bool -> String -> (BranchesReq,[String])+ -> IO ()+commandCmd ifoutput compact continue cs = withPackageByBranches (Just (not ifoutput)) Nothing AnyNumber cmdBranch where cmdBranch :: Package -> AnyBranch -> IO () cmdBranch pkg br =- ifM (doesFileExist "dead.package")- (putStrLn "dead.package") $ do+ unlessM (doesFileExist "dead.package") $ do curEnv <- getEnvironment- if ifoutput then do- out <- TP.readProcessInterleaved_ $- TP.setEnv (("p",unPackage pkg):curEnv) $- TP.shell cs- unless (B.null out) $ do- putPkgAnyBrnchHdr pkg br- B.putStr out- else do- let p = (P.shell cs) { P.env = Just (("p",unPackage pkg):curEnv) }- (_,_,_,h) <- P.createProcess p- void $ P.waitForProcess h+ ret <-+ if ifoutput then do+ (ret,out) <- TP.readProcessInterleaved $+ TP.setEnv (("p",unPackage pkg):curEnv) $+ TP.shell cs+ unless (B.null out) $ do+ if compact+ then putStr $ unPackage pkg ++ ": "+ else putPkgAnyBrnchHdr pkg br+ B.putStr out+ return ret+ else do+ let p = (P.shell cs) { P.env = Just (("p",unPackage pkg):curEnv) }+ (_,_,_,h) <- P.createProcess p+ P.waitForProcess h+ unless (continue || ret == ExitSuccess)+ exitFailure renameMasterCmd :: [String] -> IO () renameMasterCmd pkgs =
src/Cmd/Mock.hs view
@@ -3,6 +3,8 @@ ) where +import Data.RPM+ import Branches import Common import Common.System@@ -31,10 +33,10 @@ putStrLn "" rootBr <- maybe getReleaseBranch return mroot let resultdir =- case pkgs of+ case srpms of [] -> error' "cannot build zero packages"- [_] ->- let verrel = joinPath $ takeEnd 2 $ splitOn "-" $ takeNVRName (head srpms)+ [srpm] ->+ let verrel = showPkgVerRel . readNVRA $ srpm in ["--resultdir=results" </> verrel] _ -> [] let command = if length pkgs > 1 then "--chain" else "--rebuild"
src/Cmd/Override.hs view
@@ -19,7 +19,7 @@ withPackageByBranches (Just False) cleanGitFetchActive AnyNumber overrideBranch breqpkgs unless nowait $ do putStrLn "Waiting"- waitrepoCmd dryrun breqpkgs+ waitrepoCmd dryrun Nothing breqpkgs where overrideBranch :: Package -> AnyBranch -> IO () overrideBranch _ (OtherBranch _) =
+ src/Cmd/Repoquery.hs view
@@ -0,0 +1,19 @@+module Cmd.Repoquery+ (repoqueryCmd)+where++import Branches+import Common.System+import Package++repoqueryCmd :: (BranchesReq, [String]) -> IO ()+repoqueryCmd (breq, pkgs) = do+ query <- if null pkgs+ then pure <$> getDirectoryName+ else return pkgs+ brs <- listOfBranches True False breq+ mapM_ (repoquery_ query) brs+ where+ repoquery_ :: [String] -> Branch -> IO ()+ repoquery_ query br =+ repoquery br query >>= putStrLn
src/Cmd/RequestBranch.hs view
@@ -17,16 +17,18 @@ -- FIXME option to do koji scratch build instead of mock requestBranches :: Bool -> (BranchesReq,[String]) -> IO () requestBranches mock (breq, ps) = do- if null ps then- ifM isPkgGitSshRepo- (getDirectoryName >>= requestPkgBranches mock breq . Package) $- do pkgs <- map reviewBugToPackage <$> listReviews ReviewUnbranched- mapM_ (\ p -> withExistingDirectory p $ requestPkgBranches mock breq (Package p)) pkgs+ if null ps then do+ isPkgGit <- isPkgGitSshRepo+ if isPkgGit+ then getDirectoryName >>= requestPkgBranches False mock breq . Package+ else do+ pkgs <- map reviewBugToPackage <$> listReviews ReviewUnbranched+ mapM_ (\ p -> withExistingDirectory p $ requestPkgBranches (length pkgs > 1) mock breq (Package p)) pkgs else- mapM_ (\ p -> withExistingDirectory p $ requestPkgBranches mock breq (Package p)) ps+ mapM_ (\ p -> withExistingDirectory p $ requestPkgBranches (length ps > 1) mock breq (Package p)) ps -requestPkgBranches :: Bool -> BranchesReq -> Package -> IO ()-requestPkgBranches mock breq pkg = do+requestPkgBranches :: Bool -> Bool -> BranchesReq -> Package -> IO ()+requestPkgBranches multiple mock breq pkg = do when (breq == Branches []) $ putPkgHdr pkg git_ "fetch" []@@ -36,6 +38,8 @@ (mbid,session) <- bzReviewSession urls <- forM newbranches $ \ br -> do when mock $ fedpkg_ "mockbuild" ["--root", mockConfig br]+ when multiple $ putStr (unPackage pkg ++ " ")+ when (length newbranches > 1) $ putStr (show br ++ " ") fedpkg "request-branch" [show br] case mbid of Just bid -> commentBug session bid
src/Cmd/RequestRepo.hs view
@@ -71,6 +71,7 @@ when mock $ fedpkg_ "mockbuild" ["--root", mockConfig br] putStr (show br ++ " ") fedpkg_ "request-branch" ["--repo", pkg, show br]+ putStrLn "" where existingRepoRequests :: IO [IssueTitleStatus] existingRepoRequests = do
src/Cmd/Reviews.hs view
@@ -12,7 +12,7 @@ reviewsCmd :: Bool -> Bool -> Bool -> Maybe String -> ReviewStatus -> IO () reviewsCmd short allstates assignee muser status = do listReviewsFull assignee muser allstates status >>=- mapM_ (putReviewBug short) . sortBugsByStatus+ mapM_ (putReviewBug short) . sortBugsByStatus . sortBugsByID when short $ putStrLn "" findReview :: String -> IO ()
src/Cmd/Scratch.hs view
@@ -7,6 +7,7 @@ import Branches import Common+import Common.System import Git import Koji import Package@@ -17,12 +18,14 @@ -- FIXME build from a specific git ref -- FIXME print message about uploading srpm scratchCmd :: Bool -> Bool -> Bool -> Maybe Archs -> Maybe String- -> (BranchesReq, [String]) -> IO ()-scratchCmd dryrun rebuildSrpm nofailfast marchopts mtarget =- withPackageByBranches (Just False) Nothing AnyNumber scratchBuild+ -> Maybe String -> (BranchesReq, [String]) -> IO ()+scratchCmd dryrun rebuildSrpm nofailfast marchopts mtarget mref (breq,pkgs) =+ withPackageByBranches (Just False) Nothing AnyNumber scratchBuild (breq,pkgs) where scratchBuild :: Package -> AnyBranch -> IO () scratchBuild pkg br = do+ when (isJust mref && length pkgs > 1) $+ error' "--ref is not supported for multiple packages" spec <- localBranchSpecFile pkg br let target = fromMaybe (anyTarget br) mtarget archs <- case marchopts of@@ -33,22 +36,29 @@ Just (buildtag,_desttag) <- kojiBuildTarget fedoraHub target tagArchs <- kojiTagArchs buildtag return $ tagArchs \\ as- let kojiargs = ["--arch-override=" ++ intercalate "," archs | notNull archs] ++ ["--fail-fast" | not nofailfast] ++ ["--no-rebuild-srpm" | not rebuildSrpm]+ let kojiargs = ["--arch-override=" ++ intercalate "," archs | notNull archs] ++ ["--fail-fast" | not nofailfast && length archs /= 1] ++ ["--no-rebuild-srpm" | not rebuildSrpm] pkggit <- isPkgGitRepo if pkggit then do gitSwitchBranch br pushed <- do- clean <- isGitDirClean- if clean then- null <$> gitShortLog ("origin/" ++ show br ++ "..HEAD")- else return False+ case mref of+ Just ref ->+ if length ref < 6+ then error' $ "please use a longer ref: " ++ ref+ -- FIXME print commit log+ else return True+ Nothing -> do+ clean <- isGitDirClean+ if clean then+ null <$> gitShortLog ("origin/" ++ show br ++ "..HEAD")+ else return False rbr <- anyBranchToRelease br nvr <- pkgNameVerRel' rbr spec- putStrLn $ "koji scratch build of " ++ nvr ++ (if pushed then "" else ".src.rpm") ++ " for " ++ target+ putStrLn $ "koji scratch build of " ++ fromMaybe nvr mref ++ (if pushed then "" else ".src.rpm") ++ " for " ++ target unless dryrun $ do if pushed- then kojiBuildBranch target pkg Nothing $ "--scratch" : kojiargs+ then kojiBuildBranch target pkg mref $ "--scratch" : kojiargs else srpmBuild target kojiargs spec else srpmBuild target kojiargs spec where
src/Cmd/WaitRepo.hs view
@@ -2,21 +2,22 @@ where import Common.System+import Data.Maybe import Branches import Git import Koji import Package -waitrepoCmd :: Bool -> (BranchesReq, [String]) -> IO ()-waitrepoCmd dryrun = do- withPackageByBranches (Just False) cleanGitFetchActive AnyNumber (waitrepoBranch dryrun)--waitrepoBranch :: Bool -> Package -> AnyBranch -> IO ()-waitrepoBranch _ _ (OtherBranch _) =- error' "waitrepo only defined for release branches"-waitrepoBranch dryrun pkg rbr@(RelBranch br) = do- gitSwitchBranch rbr- let spec = packageSpec pkg- nvr <- pkgNameVerRel' br spec- kojiWaitRepo dryrun (branchTarget br) nvr+waitrepoCmd :: Bool -> Maybe String -> (BranchesReq, [String]) -> IO ()+waitrepoCmd dryrun mtarget = do+ withPackageByBranches (Just False) cleanGitFetchActive AnyNumber waitrepoBranch+ where+ waitrepoBranch :: Package -> AnyBranch -> IO ()+ waitrepoBranch _ (OtherBranch _) =+ error' "waitrepo only defined for release branches"+ waitrepoBranch pkg rbr@(RelBranch br) = do+ gitSwitchBranch rbr+ let spec = packageSpec pkg+ nvr <- pkgNameVerRel' br spec+ kojiWaitRepo dryrun (fromMaybe (branchTarget br) mtarget) nvr
src/InterleaveOutput.hs view
@@ -4,17 +4,18 @@ import Data.ByteString.Lazy.UTF8 as B import GHC.IO.Exception (ExitCode(ExitSuccess))-import System.Process.Typed (proc, readProcessInterleaved,- readProcessInterleaved_)+import System.Process.Typed (proc, readProcessInterleaved) import Common cmdSilent' :: String -> [String] -> IO () cmdSilent' c args =- void $ readProcessInterleaved_ $ proc c args+ void $ cmdSilentBool c args cmdSilentBool :: String -> [String] -> IO Bool cmdSilentBool c args = do (ret, out) <- readProcessInterleaved (proc c args) let ok = ret == ExitSuccess- unless ok $ putStrLn (B.toString out)+ unless ok $ do+ putStrLn ""+ putStrLn (B.toString out) return ok
src/Krb.hs view
@@ -15,7 +15,7 @@ else when (last krb == "(Expired)") $ do putStrLn $ unwords krb- cmd_ "kinit" [head krb]+ cmd_ "fkinit" [] putStrLn "" fasIdFromKrb :: IO String
src/Main.hs view
@@ -1,7 +1,11 @@+{-# LANGUAGE CPP #-}+ module Main (main) where import Distribution.Fedora.Branch+#if !MIN_VERSION_simple_cmd_args(0,1,7) import Options.Applicative (maybeReader, ReadM)+#endif import SimpleCmdArgs -- commands@@ -24,6 +28,7 @@ import Cmd.Parallel import Cmd.PkgReview import Cmd.Pull+--import Cmd.Repoquery import Cmd.RequestBranch import Cmd.RequestRepo import Cmd.Reviews@@ -49,88 +54,204 @@ "This tool helps with updating and building package branches" $ subcommands [ Subcommand "clone" "clone packages" $- cloneCmd <$> optional branchOpt <*> cloneRequest+ cloneCmd+ <$> optional branchOpt+ <*> cloneRequest , Subcommand "switch" "Switch branch" $- switchCmd <$> anyBranchArg <*> manyPackages+ switchCmd+ <$> anyBranchArg+ <*> manyPackages , Subcommand "nvr" "Print name-version-release" $- nvrCmd <$> branchesPackages+ nvrCmd+ <$> branchesPackages , Subcommand "status" "Status package/branch status" $- statusCmd <$> switchWith 'n' "no-fetch" "Do not git fetch to save time" <*> switchWith 'r' "reviews" "Status of reviewed packages" <*> branchesPackages+ statusCmd+ <$> switchWith 'n' "no-fetch" "Do not git fetch to save time"+ <*> switchWith 'r' "reviews" "Status of reviewed packages"+ <*> branchesPackages , Subcommand "merge" "Merge from newer branch" $- mergeCmd <$> nopromptOpt <*> branchesPackages+ mergeCmd+ <$> nopromptOpt+ <*> branchesPackages , Subcommand "build" "Build package(s) in Koji" $- buildCmd <$> buildOpts <*> branchesPackages+ buildCmd+ <$> buildOpts+ <*> branchesPackages , Subcommand "list" "List packages in pagure" $- listCmd <$> switchWith 'c' "count" "Print number of packages" <*> optional packagerOpt <*> many (pkgArg "PKGPAT...")+ listCmd+ <$> switchWith 'c' "count" "Print number of packages"+ <*> optional packagerOpt+ <*> many (pkgArg "PKGPAT...") , Subcommand "branches" "List package branches" $- branchesCmd <$> switchWith 'd' "skip-dead" "Skip if dead.package exists" <*> switchWith 'a' "all" "List all branches" <*> switchWith 'm' "missing" "Show missing branches" <*> branchesModeOpt <*> branchesPackages+ branchesCmd+ <$> switchWith 'd' "skip-dead" "Skip if dead.package exists"+ <*> switchWith 'a' "all" "List all branches"+ <*> switchWith 'm' "missing" "Show missing branches"+ <*> branchesModeOpt+ <*> branchesPackages , Subcommand "parallel" "Parallel build packages in Koji" $- parallelBuildCmd <$> dryrunOpt <*> optional sidetagTargetOpt <*> updatetypeOpt <*> branchesPackages+ parallelBuildCmd+ <$> dryrunOpt+ <*> optional sidetagTargetOpt+ <*> updatetypeOpt+ <*> branchesPackages , Subcommand "sidetags" "List user's side-tags" $- sideTagsCmd <$> many branchArg+ sideTagsCmd+ <$> many branchArg , Subcommand "override" "Tag builds into buildroot override in Koji" $- overrideCmd <$> dryrunOpt <*> optional (optionWith auto 'd' "duration" "DAYS" "Number of days until expiry [default 4]") <*> switchWith 'w' "no-wait" "Skip waitrepo step" <*> branchesPackages+ overrideCmd+ <$> dryrunOpt+ <*> optional (optionWith auto 'd' "duration" "DAYS" "Number of days until expiry [default 4]")+ <*> switchWith 'w' "no-wait" "Skip waitrepo step"+ <*> branchesPackages , Subcommand "waitrepo" "Wait for build to appear in Koji buildroot" $- waitrepoCmd <$> dryrunOpt <*> branchesPackages+ waitrepoCmd+ <$> dryrunOpt+ <*> mtargetOpt+ <*> branchesPackages , Subcommand "scratch" "Scratch build package in Koji" $- scratchCmd <$> dryrunOpt <*> rebuildSrpmOpt <*> noFailFastOpt <*> optional archesOpt <*> mtargetOpt <*> branchesPackages+ scratchCmd+ <$> dryrunOpt+ <*> rebuildSrpmOpt+ <*> noFailFastOpt+ <*> optional archesOpt+ <*> mtargetOpt+ <*> optional (strOptionWith 'r' "ref" "COMMITHASH" "git commit to build")+ <*> branchesPackages , Subcommand "update" "Update package in dist-git to newer version" $- updateCmd <$> maybeBranchPackages False+ updateCmd+ <$> maybeBranchPackages False , Subcommand "sort" "Sort packages in build dependency order" $- sortCmd <$> optional rpmWithOpt <*> maybeBranchPackages True+ sortCmd+ <$> optional rpmWithOpt+ <*> maybeBranchPackages True , Subcommand "prep" "Prep sources" $- prepCmd <$> maybeBranchPackages False+ prepCmd+ <$> maybeBranchPackages False , Subcommand "local" "Build locally" $- localCmd <$> optional forceshortOpt <*> many bcondOpt <*> branchesPackages+ localCmd+ <$> optional forceshortOpt+ <*> many bcondOpt+ <*> branchesPackages , Subcommand "srpm" "Build srpm" $- srpmCmd <$> switchWith 'f' "force" "regenerate even if spec older than existing srpm" <*> maybeBranchPackages False+ srpmCmd+ <$> switchWith 'f' "force" "regenerate even if spec older than existing srpm"+ <*> maybeBranchPackages False , Subcommand "diff" "Diff local changes" $- diffCmd <$> diffSpecOnly <*> diffWorkOpt <*> diffFormatOpt <*> diffBranchOpt <*> maybeBranchPackages False+ diffCmd+ <$> diffSpecOnly+ <*> diffWorkOpt+ <*> diffFormatOpt+ <*> diffBranchOpt+ <*> maybeBranchPackages False , Subcommand "log" "Show commits between branches" $- logCmd <$> switchWith 'l' "long" "show full commit log" <*> anyBranchArg <*> anyBranchArg <*> manyPackages+ logCmd+ <$> switchWith 'l' "long" "show full commit log"+ <*> anyBranchArg+ <*> anyBranchArg+ <*> manyPackages , Subcommand "mock" "Local mock build" $- mockCmd <$> switchWith 'd' "dry-run" "Do not build (but creates srpm)" <*> switchWith 'n' "no-clean" "Do not clean chroot before building a package" <*> switchWith 'w' "network" "Use network during build" <*> switchWith 'N' "no-clean-after" "Don't clean chroot after building a package" <*> optional (optionWith branchM 'r' "root" "BRANCH" "Mock config to use") <*> branchesPackages+ mockCmd+ <$> switchWith 'd' "dry-run" "Do not build (but creates srpm)"+ <*> switchWith 'n' "no-clean" "Do not clean chroot before building a package"+ <*> switchWith 'w' "network" "Use network during build"+ <*> switchWith 'N' "no-clean-after" "Don't clean chroot after building a package"+ <*> optional (optionWith branchM 'r' "root" "BRANCH" "Mock config to use")+ <*> branchesPackages , Subcommand "install-deps" "Install package build dependencies" $- installDepsCmd <$> maybeBranchPackages False+ installDepsCmd+ <$> maybeBranchPackages False , Subcommand "install" "Build locally and install package(s)" $ -- FIXME drop --shortcircuit from install?- installCmd <$> switchWith 'R' "recurse" "build and install missing deps packages" <*> optional forceshortOpt <*> many bcondOpt <*> switchWith 'r' "reinstall" "reinstall rpms" <*> maybeBranchPackages False+ installCmd+ <$> switchWith 'v' "verbose" "verbose rpmbuild output"+ <*> switchWith 'R' "recurse" "build and install missing deps packages"+ <*> optional forceshortOpt+ <*> many bcondOpt+ <*> switchWith 'r' "reinstall" "reinstall rpms"+ <*> maybeBranchPackages False , Subcommand "not-installed" "Packages not installed locally" $- notInstalledCmd <$> maybeBranchPackages False+ notInstalledCmd+ <$> maybeBranchPackages False , Subcommand "bugs" "List package bugs" $- bugsCmd <$> optional (strOptionWith 's' "summary" "KEY" "Search for bugs containing keyword") <*> manyPackages+ bugsCmd+ <$> optional (strOptionWith 's' "summary" "KEY" "Search for bugs containing keyword")+ <*> manyPackages , Subcommand "bump" "Bump release for package" $- bumpPkgs <$> optional commitOpts <*> branchesPackages+ bumpPkgs+ <$> optional commitOpts+ <*> branchesPackages , Subcommand "commit" "Git commit packages" $- commitPkgs <$> optional commitOpts <*> manyPackages+ commitPkgs+ <$> optional commitOpts+ <*> manyPackages , Subcommand "pull" "Git pull packages" $- pullPkgs <$> branchesPackages+ pullPkgs+ <$> branchesPackages , Subcommand "create-review" "Create a Package Review request" $- createReview <$> scratchOpt <*> mockOpt False <*> manyPackages+ createReview+ <$> scratchOpt+ <*> mockOpt False+ <*> manyPackages , Subcommand "update-review" "Update a Package Review" $- updateReview <$> scratchOpt <*> mockOpt False <*> optional (strArg "SPECFILE")+ updateReview+ <$> scratchOpt+ <*> mockOpt False+ <*> optional (strArg "SPECFILE")+ , Subcommand "review-package" "Run fedora-review on a package Review Request bug" $+ reviewPackage+ <$> optional (pkgArg "PACKAGE/BZID") , Subcommand "reviews" "List package reviews" $- reviewsCmd <$> reviewShortOpt <*> reviewAllStatusOpt <*> switchWith 'T' "assigned-to" "List reviews assigned to user" <*> optional (strOptionWith 'U' "user" "USER" "Bugzilla user email") <*> reviewStatusOpt+ reviewsCmd+ <$> reviewShortOpt+ <*> reviewAllStatusOpt+ <*> switchWith 'T' "assigned-to" "List reviews assigned to user"+ <*> optional (strOptionWith 'U' "user" "USER" "Bugzilla user email")+ <*> reviewStatusOpt , Subcommand "request-repos" "Request dist git repo for new approved packages" $- requestRepos <$> mockOpt True <*> reviewAllStatusOpt <*> switchWith 'r' "retry" "Re-request repo" <*> branchesPackages+ requestRepos+ <$> mockOpt True+ <*> reviewAllStatusOpt+ <*> switchWith 'r' "retry" "Re-request repo"+ <*> branchesPackages , Subcommand "import" "Import new approved created packages from bugzilla review" $- importCmd <$> mockOpt True <*> branchesPackages+ importCmd+ <$> mockOpt True+ <*> branchesPackages , Subcommand "request-branches" "Request branches for approved created packages" $- requestBranches <$> mockOpt False <*> branchesPackages+ requestBranches+ <$> mockOpt False+ <*> branchesPackages , Subcommand "find-review" "Find package review bug" $- findReview <$> pkgArg "PACKAGE"- , Subcommand "review-package" "Run fedora-review on a package Review Request bug" $- reviewPackage <$> optional (pkgArg "PACKAGE/BZID")+ findReview+ <$> pkgArg "PACKAGE" -- , Subcommand "test-bz-token" "Check bugzilla login status" $ -- pure testBZlogin , Subcommand "command" "Run shell command in package dirs ($p)" $- commandCmd <$> switchWith 'o' "if-output" "only print if output" <*> commandOpt <*> branchesPackages+ commandCmd+ <$> switchWith 'o' "if-output" "only print if output"+ <*> switchWith '1' "compact" "print package on same line as output"+ <*> switchWith 'k' "continue" "keep going after an error"+ <*> commandOpt+ <*> branchesPackages , Subcommand "copr" "Build package(s) in Fedora Copr" $- coprCmd <$> dryrunOpt <*> switchWith 'l' "list-chroots" "Show project chroots" <*> buildByOpt <*> many archOpt <*> pkgArg "PROJECT" <*> branchesPackages+ coprCmd+ <$> dryrunOpt+ <*> switchWith 'l' "list-chroots" "Show project chroots"+ <*> buildByOpt+ <*> many archOpt+ <*> pkgArg "PROJECT"+ <*> branchesPackages , Subcommand "rename-master" "Rename local master branch to rawhide" $- renameMasterCmd <$> manyPackages+ renameMasterCmd+ <$> manyPackages , Subcommand "graph" "Output dependency graph" $- graphCmd <$> switchWith 'o' "output" "Output graph in gv/dot format" <*> optional rpmWithOpt <*> maybeBranchPackages True+ graphCmd+ <$> switchWith 'o' "output" "Output graph in gv/dot format"+ <*> optional rpmWithOpt <*> maybeBranchPackages True+ -- , Subcommand "repoquery" "Repoquery branches (put repoquery options after '--')" $+ -- repoqueryCmd+ -- <$> branchesPackages ] where cloneRequest :: Parser CloneRequest@@ -242,7 +363,7 @@ mergeOpt = optional (flagWith' True 'm' "merge" "Merge without prompt" <|> flagWith' False 'M' "no-merge" "No merging") - noFailFastOpt = switchWith 'f' "no-fast-fail" "Do not --fast-fail"+ noFailFastOpt = switchWith 'f' "no-fail-fast" "Do not --fail-fast" excludeArch :: Parser String excludeArch = strOptionWith 'X' "exclude-arch" "ARCH[,ARCH].." "build without arch(s)"@@ -274,7 +395,7 @@ diffFormatOpt = DiffContext <$> optionWith auto 'u' "unified" "CONTEXT" "Lines of context" <|> flagWith' DiffMinimal 'm' "minimal" "Minimize diff noise" <|>- flagWith' DiffStats 's' "stats" "Minimize diff noise" <|>+ flagWith' DiffStats 's' "stats" "Only show diff stats" <|> flagWith DiffDefault DiffQuiet 'q' "quiet" "Just output package name" diffSpecOnly :: Parser Bool
src/Package.hs view
@@ -19,7 +19,6 @@ ForceShort(..), buildRPMs, installDeps,- prepPackage, checkSourcesMatch, getSources, putPkgHdr,@@ -45,16 +44,18 @@ buildRequires, notInstalled, pkgInstalled,+ rpmInstalled, repoquery,- systemBranch, equivNVR,- takeNVRName, nameOfNVR ) where import Common import Common.System +import Data.Char (isDigit)+import Data.Either (partitionEithers)+import Data.RPM import Distribution.Fedora import SimpleCmd.Rpm import System.Console.Pretty@@ -131,7 +132,7 @@ -- looks in dir for a unique file with given extension fileWithExtension :: String -> IO (Maybe FilePath) fileWithExtension ext = do- files <- filter ((== ext) . takeExtension) <$> listDirectory "."+ files <- filter (ext `isExtensionOf`) <$> listDirectory "." case files of [] -> return Nothing [spec] -> return $ Just spec@@ -219,7 +220,7 @@ -- Note does not check if bcond changed -- FIXME check tarball timestamp buildRPMs :: Bool -> Maybe ForceShort -> [BCond] -> [FilePath] -> AnyBranch- -> FilePath -> IO ()+ -> FilePath -> IO Bool buildRPMs quiet mforceshort bconds rpms br spec = do needBuild <- if isJust mforceshort@@ -245,49 +246,28 @@ mcr <- ["_builddir", "_rpmdir", "_srcrpmdir", "_sourcedir"]] args = rpmdirs ++ ["--define", "dist " ++ rpmDistTag dist] ++ buildopt ++ map show bconds ++ [spec] ok <-- if not quiet || shortcircuit then- cmdBool "rpmbuild" args+ if not quiet || shortcircuit+ then do+ rbr <- anyBranchToRelease br+ nvr <- pkgNameVerRel' rbr spec+ pipeBool ("rpmbuild", args) ("tee", [".build-" ++ showNVRVerRel (readNVR nvr) <.> "log"]) else do- putStr $ "Building " ++ takeBaseName spec ++ " locally: "- res <- cmdSilentBool "rpmbuild" args- when res $ putStrLn "done"- return res+ date <- cmd "date" ["+%T"]+ putStr $ date ++ " Building " ++ takeBaseName spec ++ " locally... "+ res <- cmdSilentBool "rpmbuild" args+ when res $ putStrLn "done"+ return res unless ok $- error' $ "build failed for: " ++ takeBaseName spec+ error' $ takeBaseName spec ++ " failed to build"+ return needBuild -- FIXME print unavailable deps installDeps :: Bool -> FilePath -> IO () installDeps strict spec = do missingdeps <- nub <$> (buildRequires spec >>= filterM notInstalled) unless (null missingdeps) $ do- putStrLn $ "Need: " ++ unwords missingdeps- putStr "Running dnf builddep... "- -- FIXME less silent- cmdSilent "/usr/bin/sudo" $ "/usr/bin/dnf":"builddep": ["--skip-unavailable" | not strict] ++ ["--assumeyes", spec]- putStrLn "done"--prepPackage :: Package -> AnyBranch -> IO ()-prepPackage pkg br =- ifM (doesFileExist "dead.package")- (putStrLn "dead.package") $- do- spec <- localBranchSpecFile pkg br- unlessM (doesFileExist spec) $- error' $ spec ++ " not found"- cwd <- getCurrentDirectory- void $ getSources spec- gitDir <- isGitRepo- let rpmdirs =- [ "--define="++ mcr +-+ cwd | gitDir,- mcr <- ["_builddir", "_sourcedir"]]- args = rpmdirs ++ ["-bp", spec]- case br of- RelBranch rbr -> do- nvr <- pkgNameVerRel' rbr spec- putStr $ "Prepping " ++ nvr ++ ": "- _ -> return ()- cmdSilent' "rpmbuild" args- putStrLn "done"+ putStrLn $ "Running dnf builddep " ++ unwords missingdeps+ cmd_ "/usr/bin/sudo" $ "/usr/bin/dnf":"--quiet":"builddep": ["--skip-unavailable" | not strict] ++ ["--assumeyes", spec] checkSourcesMatch :: FilePath -> IO () checkSourcesMatch spec = do@@ -302,38 +282,47 @@ getSources :: FilePath -> IO [FilePath] getSources spec = do- gitDir <- isGitRepo- srcdir <- getSourceDir gitDir- srcs <- mapMaybe sourceFieldFile <$> cmdLines "spectool" ["-S", spec]- unless gitDir $- unlessM (doesDirectoryExist srcdir) $- createDirectoryIfMissing True srcdir- forM_ srcs $ \ src ->- unlessM (doesFileExist (srcdir </> src)) $ do- uploaded <-- if gitDir then do- have_sources <- doesFileExist "sources"- if have_sources then- grep_ src "sources"- else return False+ gitDir <- isGitRepo+ srcdir <- getSourceDir gitDir+ (srcs,patches) <- partitionEithers . map sourceFieldFile+ <$> cmdLines "spectool" ["-a", spec]+ unless gitDir $+ unlessM (doesDirectoryExist srcdir) $+ createDirectoryIfMissing True srcdir+ forM_ srcs $ \ src ->+ unlessM (doesFileExist (srcdir </> src)) $ do+ uploaded <-+ if gitDir then do+ have_sources <- doesFileExist "sources"+ if have_sources then+ grep_ src "sources" else return False- if uploaded- then cmd_ "fedpkg" ["sources"]- else do- cmd_ "spectool" ["-g", "-S", "-C", srcdir, spec]- unlessM (doesFileExist (srcdir </> src)) $- error' $ "download failed: " ++ src- return srcs+ else return False+ mfedpkg <- findExecutable "fedpkg"+ if uploaded && isJust mfedpkg+ then cmd_ "fedpkg" ["sources"]+ else do+ cmd_ "spectool" ["-g", "-S", "-C", srcdir, spec]+ unlessM (doesFileExist (srcdir </> src)) $+ error' $ "download failed: " ++ src+ forM_ patches $ \patch ->+ unlessM (doesFileExist (srcdir </> patch)) $ do+ cmd_ "spectool" ["-g", "-P", "-C", srcdir, spec]+ unlessM (doesFileExist (srcdir </> patch)) $+ error' $ "missing patch: " ++ patch+ return $ srcs ++ patches where- sourceFieldFile :: String -> Maybe FilePath+ sourceFieldFile :: String -> Either FilePath FilePath sourceFieldFile field =- case words field of- [f,v] ->- -- workaround rpmdevtools 9.3 (spectool -S lists patches)- if "source" `isPrefixOf` lower f- then Just $ takeFileName v- else Nothing- _ -> error $ "bad source field!: " ++ field+ case word1 field of+ (f,v) ->+ -- rpmdevtools 9.3 (spectool always lists --all)+ -- "Source0:" or "Patch1:"+ (case lower (dropWhileEnd isDigit (init f)) of+ "source" -> Right+ "patch" -> Left+ _ -> error' $! "illegal field: " ++ f)+ $ takeFileName v getSourceDir :: Bool -> IO FilePath getSourceDir gitDir =@@ -471,7 +460,9 @@ -- have :: (GitOpts -> Bool) -> Bool -- have opt = maybe False opt mgitopts + -- FIXME rename to withPackages*+-- FIXME countdown packages withPackageByBranches :: Maybe Bool -> Maybe GitOpts -> LimitBranches@@ -621,6 +612,10 @@ notInstalled pkg = not <$> cmdBool "rpm" ["--quiet", "-q", "--whatprovides", pkg] +rpmInstalled :: NVRA -> IO Bool+rpmInstalled rpm =+ cmdBool "rpm" ["--quiet", "-q", showNVRA rpm]+ pkgInstalled :: String -> IO Bool pkgInstalled pkg = cmdBool "rpm" ["--quiet", "-q", pkg]@@ -645,11 +640,7 @@ -- allow differing dist in length r1 == length r2 && r1' == r2' --- FIXME?--- n-v-r.src.rpm -> n-v-r-takeNVRName :: FilePath -> String-takeNVRName = takeBaseName . takeBaseName-+-- FIXME: obsolete by using NVR -- n-v-r -> n nameOfNVR :: String -> String nameOfNVR = removeSeg . removeSeg@@ -661,3 +652,7 @@ isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions isExtensionOf ext = isSuffixOf ('.':ext) . takeExtensions #endif++-- FIXME: drop when rpm-nvr has nvrVerRel+showNVRVerRel :: NVR -> String+showNVRVerRel (NVR _n vr) = showVerRel vr