diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. + + + diff --git a/fbrnch.cabal b/fbrnch.cabal --- a/fbrnch.cabal +++ b/fbrnch.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: fbrnch -version: 0.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 diff --git a/libs/bodhi-hs/src/Fedora/Bodhi.hs b/libs/bodhi-hs/src/Fedora/Bodhi.hs --- a/libs/bodhi-hs/src/Fedora/Bodhi.hs +++ b/libs/bodhi-hs/src/Fedora/Bodhi.hs @@ -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 diff --git a/libs/fedora-dists/src/Distribution/Fedora/Branch.hs b/libs/fedora-dists/src/Distribution/Fedora/Branch.hs --- a/libs/fedora-dists/src/Distribution/Fedora/Branch.hs +++ b/libs/fedora-dists/src/Distribution/Fedora/Branch.hs @@ -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) diff --git a/libs/pagure-hs/src/Fedora/Pagure.hs b/libs/pagure-hs/src/Fedora/Pagure.hs --- a/libs/pagure-hs/src/Fedora/Pagure.hs +++ b/libs/pagure-hs/src/Fedora/Pagure.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, OverloadedStrings #-} {- | Copyright: (c) 2020 Jens Petersen diff --git a/src/Bugzilla.hs b/src/Bugzilla.hs --- a/src/Bugzilla.hs +++ b/src/Bugzilla.hs @@ -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) diff --git a/src/Cmd/Build.hs b/src/Cmd/Build.hs --- a/src/Cmd/Build.hs +++ b/src/Cmd/Build.hs @@ -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 diff --git a/src/Cmd/Import.hs b/src/Cmd/Import.hs --- a/src/Cmd/Import.hs +++ b/src/Cmd/Import.hs @@ -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 diff --git a/src/Cmd/Install.hs b/src/Cmd/Install.hs --- a/src/Cmd/Install.hs +++ b/src/Cmd/Install.hs @@ -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 diff --git a/src/Cmd/ListBranches.hs b/src/Cmd/ListBranches.hs --- a/src/Cmd/ListBranches.hs +++ b/src/Cmd/ListBranches.hs @@ -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 ++ ": " diff --git a/src/Cmd/Local.hs b/src/Cmd/Local.hs --- a/src/Cmd/Local.hs +++ b/src/Cmd/Local.hs @@ -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 = diff --git a/src/Cmd/Mock.hs b/src/Cmd/Mock.hs --- a/src/Cmd/Mock.hs +++ b/src/Cmd/Mock.hs @@ -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" diff --git a/src/Cmd/Override.hs b/src/Cmd/Override.hs --- a/src/Cmd/Override.hs +++ b/src/Cmd/Override.hs @@ -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 _) = diff --git a/src/Cmd/Repoquery.hs b/src/Cmd/Repoquery.hs new file mode 100644 --- /dev/null +++ b/src/Cmd/Repoquery.hs @@ -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 diff --git a/src/Cmd/RequestBranch.hs b/src/Cmd/RequestBranch.hs --- a/src/Cmd/RequestBranch.hs +++ b/src/Cmd/RequestBranch.hs @@ -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 diff --git a/src/Cmd/RequestRepo.hs b/src/Cmd/RequestRepo.hs --- a/src/Cmd/RequestRepo.hs +++ b/src/Cmd/RequestRepo.hs @@ -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 diff --git a/src/Cmd/Reviews.hs b/src/Cmd/Reviews.hs --- a/src/Cmd/Reviews.hs +++ b/src/Cmd/Reviews.hs @@ -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 () diff --git a/src/Cmd/Scratch.hs b/src/Cmd/Scratch.hs --- a/src/Cmd/Scratch.hs +++ b/src/Cmd/Scratch.hs @@ -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 diff --git a/src/Cmd/WaitRepo.hs b/src/Cmd/WaitRepo.hs --- a/src/Cmd/WaitRepo.hs +++ b/src/Cmd/WaitRepo.hs @@ -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 diff --git a/src/InterleaveOutput.hs b/src/InterleaveOutput.hs --- a/src/InterleaveOutput.hs +++ b/src/InterleaveOutput.hs @@ -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 diff --git a/src/Krb.hs b/src/Krb.hs --- a/src/Krb.hs +++ b/src/Krb.hs @@ -15,7 +15,7 @@ else when (last krb == "(Expired)") $ do putStrLn $ unwords krb - cmd_ "kinit" [head krb] + cmd_ "fkinit" [] putStrLn "" fasIdFromKrb :: IO String diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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 diff --git a/src/Package.hs b/src/Package.hs --- a/src/Package.hs +++ b/src/Package.hs @@ -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