diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,46 @@ # Changelog +## 1.3 (2023-04-08) +- new 'autospec' command converts packages to use rpmautospec +- new 'move-artifacts' command moves rpmbuild artifacts into dirs (--delete) +- new 'srpm-spec' command shows or diffs srpm specfiles +- new 'unpushed' command shows unpushed commits; and --latest option +- new 'bzusers' command searches users in bugzilla +- 'build': check for Bodhi update before koji tags +- 'build': do not repeat header when merging +- 'build': improve logic and prompt for unpushed check +- 'bump': add --changelog override and handle %autorelease +- 'copr': intersperse newlines between packages +- 'diff': --debug option to print package header +- 'diff': handle missing and non-release branches +- 'install': add --ignore-builddeps (for existing built rpms) +- 'install': ignore dead.package's +- 'install': show dnf commands with sudoLog and cmdN sudo +- 'merge': --no-fetch option +- 'mock': add --arch option +- 'mock': new --shell-only option which skips build +- 'override': default to ./ when no pkg path given +- 'parallel': if single layer, don't output layer # +- 'parallel': improve sidetag update transition messages, now waits 90s +- 'parallel': output tweaks for more packages/layers and existing nvr +- 'parallel': prompt whether to continue after failure +- 'parallel': reverse the package order for update changelog +- 'parallel': be quieter when many parallel packages +- 'push': --no-fetch option and also print header +- 'push': allow specifying a ref +- 'rename-rawhide': now pulls to get latest +- 'scratch': add --srpm option to build existing srpm +- 'status': add pkg/branch prefix before latest log +- Bugzilla: update checkRepoCreatedComment for fedora-admin automation +- Copr branchRelease: do not error for EPELNext! +- buildRPMs: backup the build.log file to build.log.prev +- buildRPMs: print NVR instead of package name +- changeLogPrompt: no trailing newline after showing changelog +- gitPush replaces gitPushSilent +- kojiWaitRepo: knowntag assurance parameter for build and parallel +- kojiWatchTask: use koji-tool to get build.log tail on failure +- use simple-prompt + ## 1.2.1 (2022-11-23) - 'install': if dnf install fails, include command in error message - 'override': check for kerberos ticket diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -39,7 +39,7 @@ One can change the branch of one or more packages: ``` -$ fbrnch switch f37 [package] ... +$ fbrnch switch f38 [package] ... ``` You can also git pull over packages: @@ -97,13 +97,13 @@ You can merge branches with: ``` -$ fbrnch merge f36 package +$ fbrnch merge f37 package ``` -which will offer to merge f37 (or up to a git hash you choose) into f36. +which will offer to merge f38 (or up to a git hash you choose) into f37. Merging can also be done together with building: ``` -$ fbrnch build f37 package +$ fbrnch build f38 package ``` will ask if you want to merge newer commits from a newer branch, then push and build it. @@ -255,13 +255,16 @@ ### Other commands There are a lot more commands, like eg `copr` and `graph`: +Here is an "extreme" [example](https://github.com/fedora-haskell/haskell-language-server/blob/main/build.sh) of a script using `fbrnch copr` to do multiple staggered builds. + ``` $ fbrnch --version -1.2.1 +1.3 $ fbrnch --help Fedora branch building tool Usage: fbrnch [--version] COMMAND + A tool to help with updating and building package branches https://github.com/juhp/fbrnch#readme @@ -275,6 +278,7 @@ nvr Print name-version-release status Status package/branch status merge Merge from newer branch + unpushed Show unpushed commits build Build package(s) in Koji list List packages in pagure list-local List packages in branch @@ -291,6 +295,7 @@ prep Prep sources local Build locally srpm Build srpm + srpm-spec Show the spec file in an srpm diff Diff local changes compare Show commits between branches src-deps List source package dependencies @@ -305,6 +310,7 @@ fetch Git fetch packages push Git push packages owner List package owner(s) + bzusers Search bugzilla users create-review Create a Package Review request update-review Update a Package Review review-package Run fedora-review on a package Review Request bug @@ -320,6 +326,8 @@ count Count number of living packages graph Output dependency graph ftbfs Check FTBFS status + autospec Convert package to use rpmautospec + move-artifacts Move old rpm artifacts into rpmbuild dirs ``` ## Installation 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: 1.2.1 +version: 1.3 synopsis: Fedora packager tool to build package branches description: fbrnch (fedora branch) is a convenient packaging tool for @@ -27,13 +27,14 @@ license-file: LICENSE author: Jens Petersen maintainer: Jens Petersen -copyright: 2019-2022 Jens Petersen +copyright: 2019-2023 Jens Petersen category: Distribution build-type: Simple extra-doc-files: CHANGELOG.md README.md tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, - GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.5 + GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.7, + GHC == 9.4.4 source-repository head type: git @@ -91,7 +92,6 @@ Pagure Patch Paths_fbrnch - Prompt Repoquery RpmBuild Types @@ -127,6 +127,7 @@ rpm-nvr >= 0.1.2, simple-cmd >= 0.2.3, simple-cmd-args >= 0.1.8, + simple-prompt, text, time, typed-process >= 0.2.4.0, diff --git a/src/Bodhi.hs b/src/Bodhi.hs --- a/src/Bodhi.hs +++ b/src/Bodhi.hs @@ -6,7 +6,8 @@ checkAutoBodhiUpdate, UpdateType(..), UpdateSeverity(..), - bodhiUpdate + bodhiUpdate, + bodhiBuildExists ) where @@ -16,6 +17,7 @@ import Data.Aeson.Types (Object, (.:), parseEither) import Data.Char (isDigit) import Fedora.Bodhi hiding (bodhiUpdate) +import SimplePrompt import Text.Read import qualified Text.ParserCombinators.ReadP as R import qualified Text.ParserCombinators.ReadPrec as RP @@ -26,7 +28,6 @@ import Common.System import qualified Common.Text as T import Package -import Prompt checkAutoBodhiUpdate :: Branch -> IO Bool checkAutoBodhiUpdate Rawhide = return True @@ -201,3 +202,8 @@ putStrLn ("no such file: " ++ file) maybeTemplate TemplateUpdate maybeTemplate _ = return Nothing + +bodhiBuildExists :: String -> IO Bool +bodhiBuildExists nvr = do + obj <- bodhiBuild nvr + return $ isNothing (lookupKey "status" obj :: Maybe String) diff --git a/src/Branches.hs b/src/Branches.hs --- a/src/Branches.hs +++ b/src/Branches.hs @@ -35,10 +35,10 @@ import Data.Tuple import Distribution.Fedora.Branch import SimpleCmd.Git -import System.Info (arch) +import SimplePrompt +import qualified System.Info (arch) import Pagure -import Prompt data AnyBranch = RelBranch Branch | OtherBranch String deriving Eq @@ -104,13 +104,15 @@ where include p e = e ++ ": " ++ p -mockRoot :: Branch -> String -mockRoot br = do - case br of - Rawhide -> "fedora-rawhide-" ++ arch - Fedora n -> "fedora-" ++ show n ++ "-" ++ arch - EPEL n -> "epel-" ++ show n ++ "-" ++ arch - EPELNext n -> "centos-stream+epel-next-" ++ show n ++ "-" ++ arch +mockRoot :: Branch -> Maybe String -> String +mockRoot br march = + let arch = fromMaybe System.Info.arch march + in + case br of + Rawhide -> "fedora-rawhide-" ++ arch + Fedora n -> "fedora-" ++ show n ++ "-" ++ arch + EPEL n -> "epel-" ++ show n ++ "-" ++ arch + EPELNext n -> "centos-stream+epel-next-" ++ show n ++ "-" ++ arch ------ diff --git a/src/Bugzilla.hs b/src/Bugzilla.hs --- a/src/Bugzilla.hs +++ b/src/Bugzilla.hs @@ -66,13 +66,14 @@ putBugURLStatus, -- request newBzRequest, - makeTextItem + makeTextItem, + searchUsers ) where import Common import Common.System import qualified Common.Text as T -import Prompt +import SimplePrompt import Data.Aeson.Types (Array, Object) import qualified Data.ByteString.Char8 as B @@ -399,10 +400,11 @@ mapM_ (T.putStrLn . (" " <>)) $ dropDuplicates . removeLeadingNewline . T.lines $ commentText cmt putNewLn +-- FIXME check for Fedora Admin user for bugzilla script actions checkRepoCreatedComment :: BugzillaSession -> BugId -> IO Bool checkRepoCreatedComment session bid = checkForComment session bid - "(fedscm-admin): The Pagure repository was created at" + "The Pagure repository was created at https://src.fedoraproject.org/" checkForComment :: BugzillaSession -> BugId -> T.Text -> IO Bool checkForComment session bid text = do diff --git a/src/Cmd/Bugs.hs b/src/Cmd/Bugs.hs --- a/src/Cmd/Bugs.hs +++ b/src/Cmd/Bugs.hs @@ -1,6 +1,14 @@ -module Cmd.Bugs (bugsCmd) where +{-# LANGUAGE OverloadedStrings, RecordWildCards #-} +module Cmd.Bugs + (bugsCmd, + bzusersCmd) +where + import Bugzilla +import Common +import Common.System (error') +import qualified Common.Text as T import Package bugsCmd :: Maybe String -> [String] -> IO () @@ -20,3 +28,16 @@ Just key -> statusOpen .&&. summaryContains key bugs <- bugsAnon $ pkgBugs (unPackage pkg) .&&. query mapM_ putBugVer $ sortBugsByProduct bugs + +bzusersCmd :: String -> IO () +bzusersCmd name = do + if length (trim name) < 3 + then error' "use more than 2 characters" + else do + session <- bzApiKeySession + users <- searchUsers session (T.pack name) + mapM_ printUser users + where + printUser :: User -> IO () + printUser User{..} = + T.putStrLn $ userRealName <> " " <> "<" <> userName <> ">" diff --git a/src/Cmd/Build.hs b/src/Cmd/Build.hs --- a/src/Cmd/Build.hs +++ b/src/Cmd/Build.hs @@ -16,7 +16,7 @@ import Krb import Koji import Package -import Prompt +import SimplePrompt import RpmBuild (checkSourcesMatch) import Types @@ -86,14 +86,14 @@ Just False -> return False Just True -> do whenJust mnewer $ \newer -> - mergeBranch (buildoptDryrun opts) True True False (Just pkg) (ancestor,unmerged) newer br + mergeBranch (buildoptDryrun opts) True True False Nothing (ancestor,unmerged) newer br return True Nothing -> if ancestor && (newrepo || tty) then do whenJust mnewer $ \newer -> - mergeBranch (buildoptDryrun opts) True False True (Just pkg) (ancestor,unmerged) newer br - return True + mergeBranch (buildoptDryrun opts) True False True Nothing (ancestor,unmerged) newer br + return $ isJust mnewer else do unless (br == Rawhide) $ whenJust mnewer $ \newer -> @@ -116,8 +116,7 @@ putNewLn -- see mergeBranch for: unmerged == 1 (774b5890) if tty && (not merged || (newrepo && ancestor && length unmerged == 1)) - then do - refPrompt unpushed $ "Press Enter to push and build" ++ (if length unpushed > 1 then "; or give ref to push" else "") ++ (if not newrepo then "; or 'no' to skip pushing" else "") + then refPrompt unpushed $ "Press Enter to push and build" ++ (if length unpushed > 1 then "; or give ref to push" else "") ++ (if not newrepo then "; or 'no' to skip pushing" else "") else return $ Just $ commitRef $ head unpushed let dryrun = buildoptDryrun opts buildstatus <- maybeTimeout 30 $ kojiBuildStatus nvr @@ -130,20 +129,23 @@ when (isJust mpush) $ error' "Please bump the spec file" when (br /= Rawhide && isNothing msidetagTarget) $ do - tags <- maybeTimeout 30 $ kojiNVRTags nvr + updateExists <- maybeTimeout 30 $ bodhiBuildExists nvr autoupdate <- checkAutoBodhiUpdate br -- FIXME update referenced bugs for autoupdate branch unless autoupdate $ do - unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-updates-pending", show br ++ "-updates-testing", show br ++ "-updates-testing-pending"]) $ do + if updateExists + then putStrLn "update exists" + else do mbug <- bzReviewAnon bodhiUpdate dryrun (buildoptUpdate opts) mbug (buildoptUseChangelog opts) spec nvr + tags <- maybeTimeout 30 $ kojiNVRTags nvr unless (any (`elem` tags) [show br, show br ++ "-updates", show br ++ "-override"]) $ whenJust moverride $ \days -> bodhiCreateOverride dryrun (Just days) nvr when (isJust mlastpkg && mlastpkg /= Just pkg || mwaitrepo == Just True) $ when ((isJust moverride && mwaitrepo /= Just False) || (autoupdate && mwaitrepo == Just True)) $ - kojiWaitRepo dryrun True target nvr + kojiWaitRepo dryrun True True target nvr Just BuildBuilding -> do putStrLn $ nvr ++ " is already building" when (isJust mpush) $ @@ -189,10 +191,11 @@ unless dryrun krbTicket whenJust mpush $ \ref -> unless dryrun $ - gitPushSilent $ Just $ ref ++ ":" ++ show br + gitPush False $ Just $ ref ++ ":" ++ show br unlessM (null <$> gitOneLineLog ("origin/" ++ show br ++ "..HEAD")) $ - when (isJust mpush && not dryrun) $ - error' "Unpushed changes remain" + unless dryrun $ do + ok <- yesno Nothing "Unpushed changes remain, continue" + unless ok $ error' "aborted" unless (buildoptAllowDirty opts) $ unlessM isGitDirClean $ error' "local changes remain (dirty)" @@ -219,4 +222,4 @@ when (isJust mlastpkg && mlastpkg /= Just pkg || mwaitrepo == Just True) $ when ((isJust moverride && mwaitrepo /= Just False) || (autoupdate && mwaitrepo == Just True)) $ - kojiWaitRepo dryrun True target nvr + kojiWaitRepo dryrun True True target nvr diff --git a/src/Cmd/Bump.hs b/src/Cmd/Bump.hs --- a/src/Cmd/Bump.hs +++ b/src/Cmd/Bump.hs @@ -15,8 +15,8 @@ -- FIXME --force -- FIXME --target -- FIXME detect rpmautospec and add empty commit -bumpPkgs :: Bool -> Maybe CommitOpt -> (BranchesReq,[String]) -> IO () -bumpPkgs local mopt = +bumpPkgs :: Bool -> Maybe CommitOpt -> Maybe String -> (BranchesReq,[String]) -> IO () +bumpPkgs local mopt mclog = withPackagesByBranches (boolHeader local) False (if local then cleanGit else cleanGitFetchActive) AnyNumber bumpPkg where @@ -49,19 +49,23 @@ then do git_ "log" ["origin..HEAD", "--pretty=oneline"] let clmsg = - case mopt of - Just (CommitMsg msg) -> msg - _ -> "rebuild" - -- FIXME check for rpmautospec first - cmd_ "rpmdev-bumpspec" ["-c", clmsg, spec] + case mclog of + Just clog -> clog + Nothing -> + case mopt of + Just (CommitMsg msg) -> msg + _ -> "rebuild" + autorelease <- grep_ " %autorelease" spec + unless autorelease $ + cmd_ "rpmdev-bumpspec" ["-c", clmsg, spec] let copts = case mopt of - Nothing -> ["-m", "bump release"] + Nothing -> ["-m", if autorelease then "rebuild" else "bump release"] Just opt -> case opt of CommitMsg msg -> ["-m", msg] -- FIXME reject amend if already pushed CommitAmend -> ["--amend", "--no-edit"] -- FIXME quiet commit? - git_ "commit" $ "-a" : copts + git_ "commit" $ "-a" : (if autorelease then ("--allow-empty" :) else id) copts else putStrLn "already bumped" diff --git a/src/Cmd/Commit.hs b/src/Cmd/Commit.hs --- a/src/Cmd/Commit.hs +++ b/src/Cmd/Commit.hs @@ -7,7 +7,7 @@ import Common.System import Git import Package -import Prompt +import SimplePrompt -- FIXME reject if nvr ahead of newer branch -- FIXME use branches after all? @@ -23,10 +23,10 @@ else mapM_ commitPkg paths where commitPkg :: FilePath -> IO () - commitPkg path = - withExistingDirectory path $ + commitPkg dir = + withExistingDirectory dir $ unlessM isGitDirClean $ do - getPackageName path >>= putPkgHdr + getPackageName dir >>= putPkgHdr addall <- if null paths then null <$> git "diff" ["--cached"] diff --git a/src/Cmd/Copr.hs b/src/Cmd/Copr.hs --- a/src/Cmd/Copr.hs +++ b/src/Cmd/Copr.hs @@ -45,9 +45,9 @@ then mapM_ putStrLn chroots else if null pkgs then - getPackageName "." >>= coprBuildPkg chroots + getPackageName "." >>= coprBuildPkg chroots False else - mapM_ (\ p -> withExistingDirectory p $ coprBuildPkg chroots (Package p)) pkgs + mapM_ (\(n,p) -> withExistingDirectory p $ coprBuildPkg chroots (n>0) (Package p)) $ zip (reverse [0,length pkgs - 1]) pkgs where coprGetChroots = do username <- getUsername @@ -76,7 +76,7 @@ then error' "No valid chroots" else return buildroots - coprBuildPkg buildroots pkg = do + coprBuildPkg buildroots morepkgs pkg = do -- FIXME check is pkg.spec spec <- localBranchSpecFile pkg (RelBranch Rawhide) -- pkg <- takeFileName <$> getCurrentDirectory @@ -103,6 +103,7 @@ let initialChroots = groupBy sameRelease buildroots remainingChroots = buildroots \\ concat initialChroots staggerBuilds srpm initialChroots remainingChroots + when morepkgs putNewLn removeArch relarch = init $ dropWhileEnd (/= '-') relarch takeArch = takeWhileEnd (/= '-') @@ -124,7 +125,7 @@ branchRelease Rawhide = "fedora-rawhide" branchRelease (Fedora n) = "fedora-" ++ show n branchRelease (EPEL n) = "epel-" ++ show n -branchRelease (EPELNext n) = error' $ show (EPELNext n) ++ " is unsupported" +branchRelease (EPELNext n) = "epel-" ++ show n ++ "-next" --data Chroot = Chroot Release Arch diff --git a/src/Cmd/Diff.hs b/src/Cmd/Diff.hs --- a/src/Cmd/Diff.hs +++ b/src/Cmd/Diff.hs @@ -28,63 +28,75 @@ -- FIXME diff other branches without switching -- FIXME --older/--newer branch -diffCmd :: Bool -> DiffWork -> DiffFormat -> Bool -> Maybe DiffFilter +diffCmd :: Bool -> Bool -> DiffWork -> DiffFormat -> Bool -> Maybe DiffFilter -> Maybe AnyBranch -> (Maybe Branch,[String]) -> IO () -diffCmd speconly work fmt ignorebumps mpatt mwbr = - withPackagesMaybeBranch HeaderNone False dirtyGit diffPkg +diffCmd debug speconly work fmt ignorebumps mpatt mwbr = + withPackagesMaybeBranch (if debug then HeaderMust else HeaderNone) False dirtyGit diffPkg where diffPkg :: Package -> AnyBranch -> IO () diffPkg pkg br = do - gitSwitchBranch br - speconlyNone <- - if speconly - then notM $ doesFileExist $ packageSpec pkg - else return False - if speconlyNone - then do - dead <- doesFileExist "dead.package" - unless dead $ putStrLn $ "no " ++ packageSpec pkg - else do - let contxt = case fmt of - DiffContext n -> ["--unified=" ++ show n] - DiffMinimal -> ["--unified=0"] - DiffStatus -> ["--name-status"] - -- FIXME hide "files changed" and "insertions" summary - DiffStats -> ["--compact-summary"] - _ -> [] - (workOpts,workArgs) = - case work of - DiffWorkAll -> ([],["HEAD" | isNothing mwbr]) - DiffWorkUnstage -> ([],[]) - DiffWorkStaged -> (["--cached"],[]) - file = [packageSpec pkg | speconly] - withBranch <- - case mwbr of - Nothing -> return [] - Just wbr -> - let brn = show wbr in - if '/' `elem` brn - then return [brn] - else do - localbrs <- gitLines "branch" ["--format=%(refname:short)"] - if brn `elem` localbrs - then return [brn] - else return ["origin/" ++ brn] - let revdiff = case mwbr of - Nothing -> [] - Just wbr -> case (wbr,br) of - (RelBranch rwbr, RelBranch rbr) -> ["-R" | rwbr > rbr] - _ -> [] - diff <- gitLines "diff" $ contxt ++ workOpts ++ revdiff ++ withBranch ++ workArgs ++ file - let diffout = (maybe id filterPattern mpatt . simplifyDiff fmt) diff - -- FIXME: sometimes we may want to list even if diff but no diffout - unless (null diffout) $ - unless (ignorebumps && isTrivialRebuildCommit diffout) $ - if fmt == DiffQuiet - then putStrLn $ unPackage pkg + ok <- + case br of + OtherBranch _ -> gitSwitchBranch br >> return True + RelBranch rbr -> gitSwitchBranch' False rbr + when ok $ do + speconlyNone <- + if speconly + then notM $ doesFileExist $ packageSpec pkg + else return False + if speconlyNone + then do + dead <- doesFileExist "dead.package" + unless dead $ putStrLn $ "no " ++ packageSpec pkg else do - putPkgAnyBrnchHdr pkg br - mapM_ putStrLn diffout + let contxt = case fmt of + DiffContext n -> ["--unified=" ++ show n] + DiffMinimal -> ["--unified=0"] + DiffStatus -> ["--name-status"] + -- FIXME hide "files changed" and "insertions" summary + DiffStats -> ["--compact-summary"] + _ -> [] + (workOpts,workArgs) = + case work of + DiffWorkAll -> ([],["HEAD" | isNothing mwbr]) + DiffWorkUnstage -> ([],[]) + DiffWorkStaged -> (["--cached"],[]) + file = [packageSpec pkg | speconly] + mwithBranch <- + case mwbr of + Nothing -> return $ Just [] + Just wbr -> + let brn = show wbr in + if '/' `elem` brn + then return $ Just [brn] + else do + localbrs <- gitLines "branch" ["--format=%(refname:short)"] + if brn `elem` localbrs + then return $ Just [brn] + else do + wbexists <- checkIfRemoteBranchExists wbr + if wbexists + then return $ Just ["origin/" ++ brn] + else do + putStrLn $ "no" +-+ show wbr +-+ "for" +-+ unPackage pkg + return Nothing + whenJust mwithBranch $ \withBranch -> do + let revdiff = + case mwbr of + Nothing -> [] + Just wbr -> case (wbr,br) of + (RelBranch rwbr, RelBranch rbr) -> ["-R" | rwbr > rbr] + _ -> [] + diff <- gitLines "diff" $ contxt ++ workOpts ++ revdiff ++ withBranch ++ workArgs ++ file + let diffout = (maybe id filterPattern mpatt . simplifyDiff fmt) diff + -- FIXME: sometimes we may want to list even if diff but no diffout + unless (null diffout) $ + unless (ignorebumps && isTrivialRebuildCommit diffout) $ + if fmt == DiffQuiet + then putStrLn $ unPackage pkg + else do + putPkgAnyBrnchHdr pkg br + mapM_ putStrLn diffout where simplifyDiff :: DiffFormat -> [String] -> [String] simplifyDiff DiffMinimal ds = simplifyMinimalDiff ds diff --git a/src/Cmd/Import.hs b/src/Cmd/Import.hs --- a/src/Cmd/Import.hs +++ b/src/Cmd/Import.hs @@ -16,7 +16,7 @@ import Krb import ListReviews import Package -import Prompt +import SimplePrompt -- FIXME separate pre-checked listReviews and direct pkg call, which needs checks -- FIXME add --dryrun @@ -70,7 +70,7 @@ git_ "commit" ["--message", "import #" ++ show bid] nvr <- pkgNameVerRel' Rawhide (pkg <.> "spec") prompt_ $ "Press Enter to push and build " ++ nvr - gitPushSilent Nothing + gitPush True Nothing -- FIXME build more branches kojiBuildBranch "rawhide" (Package pkg) Nothing ["--fail-fast"] putBugBuild False session bid nvr diff --git a/src/Cmd/Install.hs b/src/Cmd/Install.hs --- a/src/Cmd/Install.hs +++ b/src/Cmd/Install.hs @@ -1,9 +1,15 @@ +{-# LANGUAGE CPP #-} + module Cmd.Install ( installCmd, notInstalledCmd ) where import Data.RPM +#if !MIN_VERSION_simple_cmd(0,2,7) +import System.Posix.User (getEffectiveUserID) +#endif +import SimplePrompt import Branches import Cmd.Merge @@ -11,10 +17,11 @@ import Common.System import Git import Package -import Prompt import Repoquery import RpmBuild +-- FIXME --nobuild +-- FIXME --rpm to avoid dnf -- FIXME --force removal of existing incompatible dependent packages -- FIXME --subpackage to specify subpackage(s) to install/add -- FIXME --ignore-uninstalled subpackages @@ -22,8 +29,8 @@ -- FIXME --check any/all of package installed -- FIXME add --debug or respect --verbose for dnf commands installCmd :: Bool -> Bool -> Maybe Branch -> Maybe ForceShort -> [BCond] - -> Bool -> Bool -> (Maybe Branch,[String]) -> IO () -installCmd verbose recurse mfrom mforceshort bconds reinstall allsubpkgs (mbr, pkgs) = do + -> Bool -> Bool -> Bool -> (Maybe Branch,[String]) -> IO () +installCmd verbose recurse mfrom mforceshort bconds reinstall nobuilddeps allsubpkgs (mbr, pkgs) = do when (recurse && isShortCircuit mforceshort) $ error' "cannot use --recurse and --shortcircuit" withPackagesMaybeBranch (boolHeader (recurse || length pkgs > 1)) True Nothing installPkg (mbr, pkgs) @@ -31,37 +38,42 @@ installPkg :: Package -> AnyBranch -> IO () installPkg pkg br = do whenJust mbr $ gitSwitchBranch . RelBranch - spec <- - if isNothing mfrom - then localBranchSpecFile pkg br + dead <- doesFileExist "dead.package" + if dead + then putStrLn "dead package" else do - mergeCmd False True Nothing False mfrom (Branches [onlyRelBranch br], ["."]) - localBranchSpecFile pkg br - rpms <- builtRpms br spec - -- removing arch - let nvras = map readNVRA rpms - already <- filterM nvraInstalled nvras - if isJust mforceshort || null already || reinstall - then doInstallPkg mforceshort spec rpms already - else putStrLn $ unlines (map showNVRA already) ++ - "\nalready installed!\n" + spec <- + if isNothing mfrom + then localBranchSpecFile pkg br + else do + mergeCmd False False True Nothing False mfrom (Branches [onlyRelBranch br], ["."]) + localBranchSpecFile pkg br + rpms <- builtRpms br spec + -- removing arch + let nvras = map readNVRA rpms + already <- filterM nvraInstalled nvras + if isJust mforceshort || null already || reinstall + then doInstallPkg mforceshort spec rpms already + else putStrLn $ unlines (map showNVRA already) ++ + "\nalready installed!\n" where doInstallPkg mforceshort' spec rpms already = do putStrLn $ (showNVR . dropArch . readNVRA) (head rpms) - missingdeps <- nub <$> (buildRequires spec >>= filterM notInstalled) - unless (null missingdeps) $ - if recurse - then do - -- srcs <- nub <$> mapM (derefSrcPkg topdir dist True) hmissing - rbr <- anyBranchToRelease br - forM_ missingdeps $ \ dep -> do - -- FIXME check not metadep with parens - mpkgdir <- lookForPkgDir rbr ".." dep - case mpkgdir of - Nothing -> putStrLn $ dep ++ " not known" - Just pkgdir -> installCmd verbose recurse mfrom mforceshort bconds reinstall allsubpkgs (mbr, [pkgdir]) >> putNewLn - -- FIXME option to enable/disable installing missing deps - else installDeps True spec + unless nobuilddeps $ do + missingdeps <- nub <$> (buildRequires spec >>= filterM notInstalled) + unless (null missingdeps) $ + if recurse + then do + -- srcs <- nub <$> mapM (derefSrcPkg topdir dist True) hmissing + rbr <- anyBranchToRelease br + forM_ missingdeps $ \ dep -> do + -- FIXME check not metadep with parens + mpkgdir <- lookForPkgDir rbr ".." dep + case mpkgdir of + Nothing -> putStrLn $ dep ++ " not known" + Just pkgdir -> installCmd verbose recurse mfrom mforceshort bconds reinstall nobuilddeps allsubpkgs (mbr, [pkgdir]) >> putNewLn + -- FIXME option to enable/disable installing missing deps + else installDeps True spec wasbuilt <- buildRPMs (not verbose) False False mforceshort' bconds rpms br spec unless (isShortCircuit mforceshort') $ do toinstalls <- @@ -75,12 +87,13 @@ let reinstalls = filter (\ f -> readNVRA f `elem` already) toinstalls unless (null reinstalls) $ - sudo_ "/usr/bin/dnf" $ "reinstall" : "-q" : "-y" : reinstalls + sudoLog "/usr/bin/dnf" $ "reinstall" : "-q" : "-y" : reinstalls let remaining = filterDebug $ toinstalls \\ reinstalls unless (null remaining) $ - sudo_ "/usr/bin/dnf" $ "install" : "-q" : "-y" : remaining + sudoLog "/usr/bin/dnf" $ "install" : "-q" : "-y" : remaining else do let command = "/usr/bin/dnf" : "install" : "-q" : "-y" : filterDebug toinstalls + cmdN "sudo" command ok <- cmdBool "sudo" command unless ok $ if wasbuilt @@ -144,3 +157,21 @@ pkgInstalled :: String -> IO Bool pkgInstalled pkg = cmdBool "rpm" ["--quiet", "-q", pkg] + +#if !MIN_VERSION_simple_cmd(0,2,7) +sudoLog :: String -- ^ command + -> [String] -- ^ arguments + -> IO () +sudoLog = sudoInternal cmdLog + where + sudoInternal :: (String -> [String] -> IO a) -> String -> [String] -> IO a + sudoInternal exc c args = do + uid <- getEffectiveUserID + sd <- if uid == 0 + then return Nothing + else findExecutable "sudo" + let noSudo = isNothing sd + when (uid /= 0 && noSudo) $ + warning "'sudo' not found" + exc (fromMaybe c sd) (if noSudo then args else c:args) +#endif diff --git a/src/Cmd/Local.hs b/src/Cmd/Local.hs --- a/src/Cmd/Local.hs +++ b/src/Cmd/Local.hs @@ -1,18 +1,23 @@ module Cmd.Local ( + autospecCmd, commandCmd, countCmd, installDepsCmd, localCmd, + moveArtifactsCmd, nvrCmd, + renameMasterCmd, srpmCmd, - renameMasterCmd + srpmSpecCmd ) where import qualified Data.ByteString.Lazy.Char8 as B +import Data.Char (isDigit) import System.Environment import qualified System.Process as P import qualified System.Process.Typed as TP import System.Exit +import System.IO.Extra (withTempDir) import Branches import Common @@ -112,6 +117,7 @@ git_ "branch" ["--move", "master", "rawhide"] git_ "remote" ["set-head", "origin", "rawhide"] git_ "branch" ["--set-upstream-to", "origin/rawhide", "rawhide"] + git_ "pull" [] countCmd :: (Maybe Branch,[String]) -> IO () countCmd (mbr,pkgs) = @@ -130,3 +136,120 @@ exists <- doesFileExist spec return $ n + if exists then 1 else 0 Nothing -> return n + +srpmSpecCmd :: Bool -> [FilePath] -> IO () +srpmSpecCmd diff srpms = + if diff then + case srpms of + [] -> error' "impossible happened: no srpms given" + [srpm] -> do + withTempDir $ \tempdir -> do + spec <- getSrpmSpecfile False srpm tempdir + cmd_ "diff" ["-u", tempdir spec, spec] + [srpm1, srpm2] -> + withTempDir $ \tempdir -> do + spec1 <- getSrpmSpecfile True srpm1 tempdir + spec2 <- getSrpmSpecfile True srpm2 tempdir + withCurrentDirectory tempdir $ + void $ cmdBool "diff" ["-u", spec1, spec2] + _ -> error' "too many srpm files" + else + forM_ srpms $ \srpm -> + pipe_ ("rpm2cpio", [srpm]) ("cpio",["--extract", "--quiet", "--to-stdout", "*.spec"]) + where + getSrpmSpecfile :: Bool -> FilePath -> FilePath -> IO FilePath + getSrpmSpecfile sub srpm tempdir = do + exists <- doesFileExist srpm + if exists + then do + let subdir = if sub then takeBaseName srpm else "" + dir = tempdir subdir + ok <- pipeBool ("rpm2cpio", [srpm]) ("cpio", ["--extract", "--quiet", "--make-directories", "-D", dir , "--preserve-modification-time", "*.spec"]) + if ok + then do + spec <- head <$> listDirectory dir + return $ subdir spec + else error' "failed to extract spec file" + else error' $ "no such file:" +-+ srpm + +autospecCmd :: Bool -> [String] -> IO () +autospecCmd force pkgs = + withPackagesByBranches HeaderMay False cleanGitFetchActive ExactlyOne autospecPkg (Branches [Rawhide], pkgs) + where + autospecPkg :: Package -> AnyBranch -> IO () + autospecPkg _pkg br = do + gitSwitchBranch br + let changelogfile = "changelog" + exists <- doesFileExist changelogfile + if exists + then + if force + then do + cmd "rpmautospec" ["generate-changelog"] >>= + writeFile changelogfile + unlessM (null <$> git "status" ["--porcelain", "--untracked=no"]) $ do + git_ "add" [changelogfile] + git_ "commit" ["-m", "refresh changelog"] + else putStrLn "'changelog' file already exists" + else cmd_ "rpmautospec" ["convert"] + +moveArtifactsCmd :: Bool -> [String] -> IO () +moveArtifactsCmd remove pkgs = + withPackagesByBranches HeaderMay False dirtyGit Zero moveArtifactsPkg (Branches [], pkgs) + where + moveArtifactsPkg :: Package -> AnyBranch -> IO () + moveArtifactsPkg pkg br = do + cwd <- getCurrentDirectory + whenJustM (rpmEval "%_rpmdir") $ \rpmdir -> + unless (rpmdir == cwd) $ do + moveRPMS rpmdir "x86_64" + moveRPMS rpmdir "noarch" + ls <- listDirectory "." + whenJustM (rpmEval "%_srcrpmdir") $ \srcrpmdir -> + unless (srcrpmdir == cwd) $ do + let srpms = filter ("src.rpm" `isExtensionOf`) ls + forM_ srpms $ \srpm -> do + exists <- doesFileExist $ srcrpmdir srpm + if exists + then if remove + then removeFile srpm + else putStrLn $ "duplicate:" +-+ srpm + else do + createDirectoryIfMissing False srcrpmdir + renameFile srpm $ srcrpmdir srpm + whenJustM (rpmEval "%_builddir") $ \builddir -> + unless (builddir == cwd) $ do + dirs <- filterM doesDirectoryExist ls + spec <- localBranchSpecFile pkg br + srcs <- map (takeWhile (not . isDigit) . takeBaseName) <$> cmdLines "spectool" ["-S", spec] + let srctrees = + if null srcs + then [] + else filter (head srcs `isPrefixOf`) dirs + createDirectoryIfMissing False builddir + forM_ srctrees $ \tree -> do + exists <- doesDirectoryExist $ builddir tree + if exists + then if remove + then removeDirectoryRecursive tree + else putStrLn $ "duplicate:" +-+ tree + else renameDirectory tree $ builddir tree + + moveRPMS :: FilePath -> FilePath -> IO () + moveRPMS rpmdir dir = + whenM (doesDirectoryExist dir) $ + whenM (doesDirectoryExist (rpmdir dir)) $ do + rpms <- listDirectory dir + forM_ rpms $ \rpm -> do + let file = dir rpm + exists <- doesFileExist $ rpmdir file + if exists + then if remove + then removeFile file + else putStrLn $ "duplicate:" +-+ file + else do + createDirectoryIfMissing False rpmdir + renameFile file $ rpmdir file + left <- listDirectory dir + when (null left) $ + removeDirectory dir diff --git a/src/Cmd/Merge.hs b/src/Cmd/Merge.hs --- a/src/Cmd/Merge.hs +++ b/src/Cmd/Merge.hs @@ -14,10 +14,10 @@ import Package import Patch -mergeCmd :: Bool -> Bool -> Maybe Natural -> Bool -> Maybe Branch +mergeCmd :: Bool -> Bool -> Bool -> Maybe Natural -> Bool -> Maybe Branch -> (BranchesReq,[String]) -> IO () -mergeCmd dryrun noprompt mnotrivial showall mfrom = - withPackagesByBranches HeaderMay False cleanGitFetchActive AnyNumber runMergeBranch +mergeCmd dryrun nofetch noprompt mnotrivial showall mfrom = + withPackagesByBranches HeaderMay False (if nofetch then cleanGitActive else cleanGitFetchActive) AnyNumber runMergeBranch where runMergeBranch :: Package -> AnyBranch -> IO () runMergeBranch _ (OtherBranch _) = @@ -35,7 +35,7 @@ gitMergeOrigin br (ancestor,unmerged) <- mergeable from br unmerged' <- filterOutTrivial mnotrivial unmerged - mergeBranch dryrun False noprompt showall (Just pkg) (ancestor,unmerged') from br + mergeBranch dryrun False noprompt showall (if nofetch then Just pkg else Nothing) (ancestor,unmerged') from br where filterOutTrivial :: Maybe Natural -> [Commit] -> IO [Commit] filterOutTrivial Nothing cs = return cs @@ -88,7 +88,7 @@ unless dryrun $ git_ "merge" ["--quiet", ref] mergeBranch dryrun build noprompt showall mpkg (False,unmerged) from br = do - whenJust mpkg $ flip putPkgBrnchHdr br + unless build $ whenJust mpkg $ flip putPkgBrnchHdr br putStrLn $ show from ++ " branch is not directly mergeable:" displayCommits False unmerged putNewLn diff --git a/src/Cmd/Mock.hs b/src/Cmd/Mock.hs --- a/src/Cmd/Mock.hs +++ b/src/Cmd/Mock.hs @@ -1,6 +1,7 @@ module Cmd.Mock ( mockCmd, - NoClean(..) + NoClean(..), + MockShell(..) ) where @@ -16,12 +17,15 @@ data NoClean = NoCleanBefore | NoCleanAfter | NoCleanAll | MockShortCircuit deriving Eq +data MockShell = ShellOnly | BuildShell + deriving Eq + -- FIXME add repo/copr for build -- FIXME handle non-release branches (on-branch works) -- FIXME option for --shell without rebuild -mockCmd :: Bool -> Maybe NoClean -> Bool -> Bool -> Maybe Branch - -> (BranchesReq, [String]) -> IO () -mockCmd dryrun mnoclean network mockshell mroot (breq, ps) = do +mockCmd :: Bool -> Maybe NoClean -> Bool-> Maybe MockShell -> Maybe Branch + -> Maybe String -> (BranchesReq, [String]) -> IO () +mockCmd dryrun mnoclean network mockshell mroot march (breq, ps) = do branches <- case breq of Branches [] -> @@ -53,16 +57,20 @@ Just NoCleanAfter -> ["--no-cleanup-after"] Just NoCleanAll -> ["--no-clean", "--no-cleanup-after"] Just MockShortCircuit -> ["--short-circuit", "install"] - mockopts_common c = [c, "--root", mockRoot rootBr] ++ noclean ++ ["--enable-network" | network] + mockopts_common c = [c, "--root", mockRoot rootBr march] ++ noclean ++ ["--enable-network" | network] mockbuild_opts = mockopts_common command ++ ["--config-opts=cleanup_on_failure=False" | mnoclean `elem` [Nothing, Just NoCleanBefore]] ++ resultdir ++ srpms mockshell_opts = mockopts_common "--shell" ++ ["--no-clean" | "--no-clean" `notElem` noclean] if dryrun then do - cmdN "mock" mockbuild_opts - when mockshell $ cmdN "mock" mockshell_opts + unless (mockshell == Just ShellOnly) $ + cmdN "mock" mockbuild_opts + when (isJust mockshell) $ cmdN "mock" mockshell_opts else do - ok <- cmdBool "mock" mockbuild_opts - when mockshell $ cmd_ "mock" mockshell_opts + ok <- + if mockshell == Just ShellOnly + then return True + else cmdBool "mock" mockbuild_opts + when (isJust mockshell) $ cmd_ "mock" mockshell_opts unless ok $ error' "mockbuild failed" where prepSrpm :: AnyBranch -> FilePath -> IO FilePath diff --git a/src/Cmd/Override.hs b/src/Cmd/Override.hs --- a/src/Cmd/Override.hs +++ b/src/Cmd/Override.hs @@ -20,7 +20,7 @@ import Koji import Krb (krbTicket) import Package -import Prompt (yesno) +import SimplePrompt (yesno) data OverrideMode = OverrideCreate | OverrideList | OverrideExpire deriving Eq @@ -34,7 +34,7 @@ putStrLn "Overriding" withPackagesByBranches HeaderMay False cleanGitFetchActive AnyNumber overrideBranch breqpkgs unless nowait $ - waitrepoCmd dryrun WaitNoFetch Nothing breqpkgs + waitrepoCmd dryrun False WaitNoFetch Nothing breqpkgs where overrideBranch :: Package -> AnyBranch -> IO () overrideBranch _ (OtherBranch _) = @@ -69,13 +69,13 @@ Just _expired -> return () Nothing -> do whenJust (lookupKey "nvr" override) $ \nvr -> do - ok <- yesno $ "Expire override" +-+ nvr + ok <- yesno Nothing $ "Expire override" +-+ nvr when ok $ cmd_ "bodhi" ["overrides", "edit", "--expire", nvr] withPackages :: [FilePath] -> (Package -> IO ()) -> IO () withPackages pkgs act = - forM_ pkgs $ \pkgdir -> + forM_ (if null pkgs then ["."] else pkgs) $ \pkgdir -> withExistingDirectory pkgdir $ getPackageName "." >>= act diff --git a/src/Cmd/Parallel.hs b/src/Cmd/Parallel.hs --- a/src/Cmd/Parallel.hs +++ b/src/Cmd/Parallel.hs @@ -25,13 +25,13 @@ import Koji import Package import RpmBuild (checkSourcesMatch) -import Prompt +import SimplePrompt import Types -data JobDone = JobDone {jobNvr :: String, - jobBranch :: Branch, - _jobClog :: String - } +data JobDone = Done {jobNvr :: String, + jobBranch :: Branch, + _jobClog :: String} + type JobAsync = (String, Async JobDone) -- FIXME offer to untag overrides afterwards @@ -91,7 +91,7 @@ unless (isNothing msidetagTarget) $ -- FIXME check for an existing sidetag update when (target /= branchTarget rbr) $ do - let changelog = intercalate "" $ renderChangelogs nvrclogs + let changelog = intercalate "" $ renderChangelogs $ reverse nvrclogs putNewLn putStrLn changelog input <- prompt "Press Enter to use above or input update summary now; or 'no' to skip update" @@ -106,12 +106,14 @@ putStrLn $ "= Building " ++ pluralException (length brs) "branch" "branches" ++ " in parallel:" putStrLn $ unwords $ map show brs jobs <- mapM setupBranch brs - (failures,nvrclogs) <- timeIO $ watchJobs Nothing [] [] jobs + (failures,nvrclogs) <- timeIO $ watchJobs (length jobs == 1) Nothing [] [] jobs -- switch back to the original branch when (length brs /= 1) $ gitSwitchBranch currentbranch - unless (null failures) $ - error' $ "Build failures: " ++ unwords failures + unless (null failures) $ do + putStrLn $ "Build failures:" +-+ unwords failures + okay <- yesno Nothing "Do you want to continue nevertheless" + unless okay $ error' "Quitting" when (isNothing msidetagTarget) $ do let spec = packageSpec pkg bodhiUpdate dryrun mupdate Nothing False spec $ @@ -124,7 +126,7 @@ putPkgBrnchHdr pkg br target <- targetMaybeSidetag dryrun br msidetagTarget when (mmerge /= Just False) $ mergeNewerBranch Nothing br - job <- startBuild Nothing 0 False False target pkg br "." >>= async + job <- startBuild Nothing 0 False (length brs) target pkg br "." >>= async unless dryrun $ sleep 3 return (show br,job) @@ -142,71 +144,78 @@ parallelBuild _ _ (_,[]) = return [] -- should not reach here parallelBuild target br (layernum, layer:nextLayers) = do krbTicket - putStrLn $ "\n= Building parallel layer #" ++ show layernum ++ + let singlelayer = layernum == 0 && null nextLayers + putStrLn $ "\n= Building" +-+ + (if singlelayer + then "in parallel" + else "parallel layer #" ++ show layernum) ++ if nopkgs > 1 then " (" ++ show nopkgs +-+ "packages):" else ":" putStrLn $ unwords layer -- maybe print total pending packages unless (null nextLayers) $ - putStrLn $ plural layersleft "more layer" ++ " left with " ++ + putStrLn $ let layerspkgs = map length nextLayers in case layerspkgs of - [l] -> plural l "package" - _ -> show layerspkgs +-+ "packages" - jobs <- zipWithM setupBuild (reverse [0..(length layer - 1)]) layer + [n] -> plural n "more package" +-+ "left in next final layer" + _ -> "more package layers left:" +-+ show layerspkgs + jobs <- zipWithM (setupBuild singlelayer) (reverse [0..(length layer - 1)]) layer when (null jobs) $ error' "No jobs run" - (failures,nvrs) <- watchJobs (Just layernum) [] [] jobs - -- FIXME prompt to continue? + (failures,nvrs) <- watchJobs (length jobs == 1) (if singlelayer then Nothing else Just layernum) [] [] jobs if null failures then return nvrs else do let pending = sum $ map length nextLayers - error' $ "Build failures in layer" +-+ show layernum ++ ": " ++ - unwords failures ++ "\n\n" ++ + putStrLn $ "\nBuild failures" +-+ + (if singlelayer then ":" else "in layer" +-+ show layernum ++ ":") + +-+ unwords failures + okay <- yesno Nothing "Do you want to continue nevertheless" + if okay + then return nvrs + else error' $ plural pending "pending package" ++ if pending > 0 - then - ":\n" ++ unwords (map unwords nextLayers) + then ":\n" ++ unwords (map unwords nextLayers) else "" where nopkgs = length layer layersleft = length nextLayers - setupBuild :: Int -> String -> IO JobAsync - setupBuild n dir = do + setupBuild :: Bool -> Int -> String -> IO JobAsync + setupBuild singlelayer n dir = do pkg <- getPackageName dir putPkgBrnchHdr pkg br - job <- startBuild (Just layernum) n (layersleft > 0) (nopkgs > 5) target pkg br dir + job <- startBuild (if singlelayer then Nothing else Just layernum) n (layersleft > 0) nopkgs target pkg br dir >>= async unless dryrun $ sleep 4 return (unPackage pkg,job) - watchJobs :: Maybe Int -> [String] -> [JobDone] -> [JobAsync] + watchJobs :: Bool -> Maybe Int -> [String] -> [JobDone] -> [JobAsync] -> IO ([String],[JobDone]) -- (failures,successes) - watchJobs _ fails results [] = return (fails,results) - watchJobs mlayer fails results (job:jobs) = do + watchJobs _ _ fails dones [] = return (fails,dones) + watchJobs singlejob mlayer fails dones (job:jobs) = do status <- poll (snd job) case status of - Nothing -> sleep 1 >> watchJobs mlayer fails results (jobs ++ [job]) + Nothing -> sleep 1 >> watchJobs singlejob mlayer fails dones (jobs ++ [job]) -- (nvr,changelog) - Just (Right result) -> do - putStrLn $ - if null jobs - then "ending layer" +-+ maybe "" show mlayer - else plural (length jobs) "job" +-+ "left" +-+ maybe "" (\l -> "in layer" +-+ show l) mlayer - watchJobs mlayer fails (result:results) jobs + Just (Right done) -> do + unless singlejob $ + when (null jobs) $ + putStrLn $ "ending" +-+ maybe "" (\l -> "layer" +-+ show l) mlayer + -- else plural (length jobs) "job" +-+ "left" +-+ maybe "" (\l -> "in layer" +-+ show l) mlayer + watchJobs singlejob mlayer fails (done:dones) jobs Just (Left except) -> do print except let pkg = fst job - putStrLn $ "** " ++ color Magenta pkg +-+ "job" +-+ color Magenta "failed" ++ " ** (" ++ plural (length jobs) "job" +-+ "left" +-+ maybe "" (\l -> "in layer" +-+ show l) mlayer ++ ")" - watchJobs mlayer (pkg : fails) results jobs + putStrLn $ "** " ++ color Magenta pkg +-+ "job" +-+ color Magenta "failed" ++ " **" +-+ if singlejob then "" else "(" ++ plural (length jobs) "job" +-+ "left" +-+ maybe "" (\l -> "in layer" +-+ show l) mlayer ++ ")" + watchJobs singlejob mlayer (pkg : fails) dones jobs -- FIXME prefix output with package name - startBuild :: Maybe Int -> Int -> Bool -> Bool -> String -> Package + startBuild :: Maybe Int -> Int -> Bool -> Int -> String -> Package -> Branch -> String -> IO (IO JobDone) - startBuild mlayer n morelayers background target pkg br dir = + startBuild mlayer n morelayers nopkgs target pkg br dir = withExistingDirectory dir $ do gitSwitchBranch (RelBranch br) let spec = packageSpec pkg @@ -214,14 +223,16 @@ nvr <- pkgNameVerRel' br spec unpushed <- gitOneLineLog $ "origin/" ++ show br ++ "..HEAD" unless (null unpushed) $ do - putStrLn $ nvr ++ " (" ++ target ++ ")" +-+ show n +-+ "more" +-+ - maybe "" (\l -> "in layer" +-+ show l) mlayer + putStrLn $ nvr +-+ "(" ++ target ++ ")" +-+ + if nopkgs > 1 + then pluralException n "more" "more" +-+ maybe "" (\l -> "in layer" +-+ show l) mlayer + else "" putNewLn displayCommits True unpushed unless (null unpushed) $ do checkSourcesMatch spec unless dryrun $ - gitPushSilent Nothing + gitPush True Nothing changelog <- unlines <$> getChangelog spec -- FIXME should compare git refs -- FIXME check for target @@ -239,8 +250,8 @@ bodhiCreateOverride dryrun Nothing nvr return $ do when morelayers $ - kojiWaitRepo dryrun background target nvr - return $ JobDone nvr br changelog + kojiWaitRepo dryrun (nopkgs > 5) True target nvr + return $ Done nvr br changelog Just BuildBuilding -> do putStrLn $ color Yellow nvr +-+ "is already" +-+ color Yellow "building" mtask <- kojiGetBuildTaskID fedoraHub nvr @@ -249,7 +260,7 @@ Just task -> return $ do kojiWaitTaskAndRepo (isNothing mlatest) nvr task - return $ JobDone nvr br changelog + return $ Done nvr br changelog _ -> do when (null unpushed) $ do putStrLn $ nvr ++ " (" ++ target ++ ")" +-+ show n +-+ "more" +-+ @@ -263,21 +274,23 @@ putStrLn $ nvr ++ " task is already open" return $ do kojiWaitTaskAndRepo (isNothing mlatest) nvr task - return $ JobDone nvr br changelog + return $ Done nvr br changelog (_:_) -> error' $ show (length opentasks) ++ " open " ++ unPackage pkg ++ " tasks already" [] -> do if equivNVR nvr (fromMaybe "" mlatest) - then return $ error' $ - color Red $ nvr ++ " is already latest (modulo disttag)" + then do + -- FIXME add a retry prompt + putStrLn $ color Red $ nvr ++ " is already latest (modulo disttag)" + return $ error' $ nvr +-+ "failed" else do -- FIXME parse build output if dryrun - then return $ return $ JobDone nvr br "" + then return $ return $ Done nvr br "" else do - task <- kojiBuildBranchNoWait target pkg Nothing $ "--fail-fast" : ["--background" | background] + task <- kojiBuildBranchNoWait target pkg Nothing $ "--fail-fast" : ["--background" | nopkgs > 5] return $ do kojiWaitTaskAndRepo (isNothing mlatest) nvr task - return $ JobDone nvr br changelog + return $ Done nvr br changelog where kojiWaitTaskAndRepo :: Bool -> String -> TaskID -> IO () kojiWaitTaskAndRepo newpkg nvr task = do @@ -299,12 +312,12 @@ -- bodhiUpdate (fmap fst mBugSess) changelog nvr bodhiCreateOverride dryrun Nothing nvr when morelayers $ - kojiWaitRepo dryrun background target nvr + kojiWaitRepo dryrun (nopkgs > 5) True target nvr -- FIXME map nvr to package? renderChangelogs :: [JobDone] -> [String] renderChangelogs [] = [] - renderChangelogs ((JobDone nvr _ clog):jobs) = + renderChangelogs ((Done nvr _ clog):jobs) = unlines [nvr, "", clog] : renderChangelogs jobs -- FIXME how to catch authentication errors? @@ -336,8 +349,9 @@ case lookupKey "updateid" update of Nothing -> error' "could not determine Update id" Just updateid -> do - putStr "Waiting for sidetag update to transition to 'request testing'" - sleep 80 + putStr "Waiting ~90s for sidetag update to transition to 'request testing'.." + -- FIXME countdown timer + sleep 90 bodhiUpdateTestingRequesting 1 updateid update _ -> error' $ "impossible happened: more than one update found for " ++ last nvrs @@ -348,7 +362,10 @@ else case lookupKey "request" update of Just (String request) -> - putStrLn $ "\nrequest:" +-+ T.unpack request + putStrLn $ + if request == "testing" + then " done" + else "\nrequest:" +-+ T.unpack request _ -> do mupdate' <- FedoraBodhi.bodhiUpdate updateid case mupdate' of diff --git a/src/Cmd/PkgReview.hs b/src/Cmd/PkgReview.hs --- a/src/Cmd/PkgReview.hs +++ b/src/Cmd/PkgReview.hs @@ -19,7 +19,7 @@ import Koji import Krb import Package -import Prompt +import SimplePrompt import RpmBuild data ScratchOption = ScratchBuild | ScratchTask Int | SkipScratch @@ -122,7 +122,7 @@ if mock then do -- FIXME check that mock is installed let resultsdir = "results_" ++ pkg - cmd_ "mock" ["--root", mockRoot Rawhide, "--resultdir=" ++ resultsdir, srpm] + cmd_ "mock" ["--root", mockRoot Rawhide Nothing, "--resultdir=" ++ resultsdir, srpm] map (resultsdir ) . filter ((== ".rpm") . takeExtension) <$> listDirectory resultsdir else builtRpms (RelBranch Rawhide) spec >>= filterM doesFileExist diff --git a/src/Cmd/PullPush.hs b/src/Cmd/PullPush.hs --- a/src/Cmd/PullPush.hs +++ b/src/Cmd/PullPush.hs @@ -7,6 +7,7 @@ import Branches import Common +import Common.System (error') import Git import Package @@ -58,11 +59,15 @@ fetchPkg _pkg _br = gitFetchSilent False -pushPkgs :: (BranchesReq, [String]) -> IO () -pushPkgs = - withPackagesByBranches HeaderMay False cleanGitFetch AnyNumber pushPkg +pushPkgs :: Bool -> Bool -> Maybe String -> (BranchesReq, [String]) -> IO () +pushPkgs dryrun nofetch mref (breq, pkgs) = do + when (isJust mref && length pkgs > 1) $ + error' "can only specify ref for single package" + withPackagesByBranches HeaderMust False (if nofetch then cleanGit else cleanGitFetch) AnyNumber pushPkg (breq, pkgs) where pushPkg :: Package -> AnyBranch -> IO () pushPkg _pkg _br = do whenJustM (gitShortLog1 Nothing) $ putStrLn . showCommit - gitPushSilent Nothing + if dryrun + then checkOnBranch + else gitPush False mref diff --git a/src/Cmd/RequestBranch.hs b/src/Cmd/RequestBranch.hs --- a/src/Cmd/RequestBranch.hs +++ b/src/Cmd/RequestBranch.hs @@ -18,7 +18,7 @@ import ListReviews import Package import Pagure -import Prompt (prompt_) +import SimplePrompt (prompt_) -- FIXME option to do koji scratch build instead of mock requestBranchesCmd :: Bool -> Maybe Branch -> Bool -> (BranchesReq,[String]) -> IO () @@ -72,7 +72,7 @@ unless (null newbranches) $ do mbidsession <- bzReviewSession urls <- forM newbranches $ \ br -> do - when mock $ fedpkg_ "mockbuild" ["--root", mockRoot br] + when mock $ fedpkg_ "mockbuild" ["--root", mockRoot br Nothing] when (length branches' > 1) $ putStr $ show br ++ " " -- 1. Can timeout like this: -- Could not execute request_branch: HTTPSConnectionPool(host='pagure.io', port=443): Read timed out. (read timeout=60) diff --git a/src/Cmd/RequestRepo.hs b/src/Cmd/RequestRepo.hs --- a/src/Cmd/RequestRepo.hs +++ b/src/Cmd/RequestRepo.hs @@ -14,7 +14,7 @@ import ListReviews import Package import Pagure -import Prompt +import SimplePrompt -- FIXME separate pre-checked listReviews and direct pkg call, which needs checks requestRepos :: Bool -> Bool -> Bool -> (BranchesReq, [String]) -> IO () @@ -68,7 +68,7 @@ putNewLn branches <- getRequestedBranches [] breq forM_ branches $ \ br -> do - when mock $ fedpkg_ "mockbuild" ["--root", mockRoot br] + when mock $ fedpkg_ "mockbuild" ["--root", mockRoot br Nothing] putStr (show br ++ " ") fedpkg_ "request-branch" ["--repo", pkg, show br] putNewLn diff --git a/src/Cmd/Scratch.hs b/src/Cmd/Scratch.hs --- a/src/Cmd/Scratch.hs +++ b/src/Cmd/Scratch.hs @@ -5,6 +5,7 @@ scratchCmdAarch64, scratchCmdX86_64, Archs(..), + ScratchSource(..) ) where import Branches @@ -16,13 +17,21 @@ import RpmBuild (generateSrpm) import Types (Archs(..),SideTagTarget) +data ScratchSource = ScratchRef String | ScratchSRPM String + +showScratchSource :: Bool -> String -> Maybe ScratchSource -> String +showScratchSource pushed nvr Nothing = nvr ++ (if pushed then "" else ".src.rpm") +showScratchSource _ _ (Just (ScratchRef ref)) = ref +showScratchSource _ _ (Just (ScratchSRPM srpm)) = srpm + +-- FIXME --with --without ? -- FIXME allow parallel targets -- FIXME tail build.log for failure -- FIXME append timestamp after %release (to help identify scratch builds) scratchCmd :: Bool -> Bool -> Bool -> Bool -> Maybe Archs - -> [SideTagTarget] -> Maybe String -> (BranchesReq, [String]) + -> [SideTagTarget] -> Maybe ScratchSource -> (BranchesReq, [String]) -> IO () -scratchCmd dryrun stagger rebuildSrpm nofailfast marchopts sidetagTargets mref (breq,pkgs) = +scratchCmd dryrun stagger rebuildSrpm nofailfast marchopts sidetagTargets msource (breq,pkgs) = withPackagesByBranches HeaderMust False Nothing AnyNumber scratchBuild (breq,pkgs) where anyTarget (RelBranch b) = branchTarget b @@ -30,8 +39,8 @@ scratchBuild :: Package -> AnyBranch -> IO () scratchBuild pkg br = do - when (isJust mref && length pkgs > 1) $ - error' "--ref is not supported for multiple packages" + when (isJust msource && length pkgs > 1) $ + error' "source override is not supported for multiple packages" pkggit <- isPkgGitRepo when (not pkggit && breq == Branches [] && null sidetagTargets) $ error' "please specify a branch or target for non dist-git" @@ -75,12 +84,13 @@ then do gitSwitchBranch br pushed <- do - case mref of - Just ref -> + case msource of + Just (ScratchRef ref) -> if length ref < 6 then error' $ "please use a longer ref: " ++ ref -- FIXME print commit log else return True + Just (ScratchSRPM _) -> return False Nothing -> do clean <- isGitDirClean if clean && isRelBranch br @@ -89,11 +99,17 @@ else return False rbr <- anyBranchToRelease br nvr <- pkgNameVerRel' rbr spec - putStrLn $ target ++ " scratch build of " ++ fromMaybe nvr mref ++ (if pushed then "" else ".src.rpm") - unless dryrun $ do - if pushed - then kojiBuildBranch target pkg mref $ "--scratch" : kojiargs - else srpmBuild kojiargs + putStrLn $ target ++ " scratch build of " ++ showScratchSource pushed nvr msource + unless dryrun $ + case msource of + Just (ScratchSRPM srpm) -> + void $ kojiScratchBuild target kojiargs srpm + Nothing -> + if pushed + then kojiBuildBranch target pkg Nothing $ "--scratch" : kojiargs + else srpmBuild kojiargs + Just (ScratchRef ref) -> + kojiBuildBranch target pkg (Just ref) $ "--scratch" : kojiargs else srpmBuild kojiargs where srpmBuild :: [String] -> IO () @@ -102,12 +118,12 @@ -- FIXME default -X to --no-fastfail? scratchCmdX86_64 :: Bool -> Bool -> Bool -> [SideTagTarget] - -> Maybe String -> (BranchesReq, [String]) -> IO () + -> Maybe ScratchSource -> (BranchesReq, [String]) -> IO () scratchCmdX86_64 dryrun rebuildSrpm excludeArch = scratchCmd dryrun False rebuildSrpm False (Just (excludeArchs excludeArch ["x86_64"])) scratchCmdAarch64 :: Bool -> Bool -> Bool -> [SideTagTarget] - -> Maybe String -> (BranchesReq, [String]) -> IO () + -> Maybe ScratchSource -> (BranchesReq, [String]) -> IO () scratchCmdAarch64 dryrun rebuildSrpm excludeArch = scratchCmd dryrun False rebuildSrpm False (Just (excludeArchs excludeArch ["aarch64"])) diff --git a/src/Cmd/SideTags.hs b/src/Cmd/SideTags.hs --- a/src/Cmd/SideTags.hs +++ b/src/Cmd/SideTags.hs @@ -6,7 +6,7 @@ import Common import Koji import Krb (krbTicket) -import Prompt (yesno) +import SimplePrompt (yesno) sideTagsCmd :: Bool -> [Branch] -> IO () sideTagsCmd remove brs = do @@ -19,5 +19,5 @@ where removeSideTag :: String -> IO () removeSideTag tag = - whenM (yesno $ "Remove " ++ tag) $ + whenM (yesno Nothing $ "Remove " ++ tag) $ cmd_ "fedpkg" ["remove-side-tag", tag] diff --git a/src/Cmd/Status.hs b/src/Cmd/Status.hs --- a/src/Cmd/Status.hs +++ b/src/Cmd/Status.hs @@ -1,7 +1,11 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -module Cmd.Status (statusCmd) where +module Cmd.Status ( + statusCmd, + unpushedCmd + ) +where import Common import Common.System @@ -24,98 +28,151 @@ -- FIXME silence fetching of new branches? (for --reviews etc) statusCmd :: Bool -> Bool -> (BranchesReq,[String]) -> IO () statusCmd nofetch reviews (breq, pkgs) = do - reviewpkgs <- if reviews then - map reviewBugToPackage <$> listReviewsAll True ReviewRepoCreated + reviewpkgs <- + if reviews + then map reviewBugToPackage <$> listReviewsAll True ReviewRepoCreated else return [] -- FIXME dirty not okay for multiple branches? withPackagesByBranches HeaderMay False (if nofetch then dirtyGit else dirtyGitFetch) AnyNumber statusBranch (breq, pkgs ++ reviewpkgs) - --- FIXME note dirty when local changes -statusBranch :: Package -> AnyBranch -> IO () -statusBranch _ (OtherBranch _) = - error' "status currently only defined for release branches" -statusBranch pkg rbr@(RelBranch br) = do - brExists <- checkIfRemoteBranchExists rbr - if not brExists - then do - name <- getDirectoryName - putStrLn $ name ++ " has no branch " ++ show br - else do - gitSwitchBranch rbr - let spec = packageSpec pkg - ifM (notM (doesFileExist spec)) - (ifM initialPkgRepo - (putStrLn $ show br ++ ": initial repo") - (putStrLn $ "missing " ++ spec)) $ - do - mnvr <- pkgNameVerRel br spec - case mnvr of - Nothing -> do - putStrLn "undefined NVR!\n" - putStr "HEAD " - whenJustM (gitShortLog1 Nothing) $ putStrLn . showCommit - Just nvr -> do - -- unless (br == Rawhide) $ do - -- newerBr <- newerBranch br <$> getFedoraBranches - -- ancestor <- gitBool "merge-base" ["--is-ancestor", "HEAD", show newerBr] - -- when ancestor $ do - -- unmerged <- gitOneLineLog $ "HEAD..origin/" ++ show newerBr - -- unless (null unmerged) $ do - -- putStrLn $ "Newer commits in " ++ show newerBr ++ ":" - -- mapM_ putStrLn unmerged - unpushed <- gitShortLog1 $ Just $ "origin/" ++ show br ++ "..HEAD" - if null unpushed - then do - mbuild <- kojiGetBuildID fedoraHub nvr - case mbuild of - Nothing -> do - mlatest <- kojiLatestNVR (branchDestTag br) (unPackage pkg) - case mlatest of - Nothing -> putStrLn $ "new " ++ nvr - Just latest -> - putStrLn $ if equivNVR nvr latest then latest ++ " is latest modulo disttag" else (if null latest then "new " else (head . words) latest ++ " ->\n") ++ nvr - Just buildid -> do - tags <- kojiBuildTags fedoraHub (buildIDInfo buildid) - if null tags then do - mstatus <- kojiBuildStatus nvr - -- FIXME show pending archs building - whenJust mstatus $ \ status -> - -- FIXME better Show BuildStatus - putStr $ nvr ++ " (" ++ show status ++ ")" - else do - -- FIXME hide testing if ga/stable - putStr $ nvr ++ " (" ++ unwords tags ++ ")" - unless (isStable tags) $ do - updates <- bodhiUpdates - [makeItem "display_user" "0", - makeItem "builds" nvr] - case updates of - [] -> putStrLn "No update found" - [update] -> do - -- FIXME could show minus time left using stable_days? - let msince = lookupKey "date_testing" update :: Maybe LocalTime - case msince of - Nothing -> return () - Just date -> do - let since = localTimeToUTC utc date - current <- getCurrentTime - let diff = diffUTCTime current since - putAge diff - _ -> putStrLn "More than one update found!" - putNewLn - else whenJust unpushed $ putStrLn . ((show br ++ ": ") ++) . showCommit where - isStable :: [String] -> Bool - isStable = not . all ("-testing" `isSuffixOf`) + -- FIXME note dirty when local changes + statusBranch :: Package -> AnyBranch -> IO () + statusBranch _ (OtherBranch _) = + error' "status currently only defined for release branches" + statusBranch pkg rbr@(RelBranch br) = do + brExists <- checkIfRemoteBranchExists rbr + if not brExists + then do + name <- getDirectoryName + putStrLn $ name ++ " has no branch " ++ show br + else do + gitSwitchBranch rbr + let spec = packageSpec pkg + ifM (notM (doesFileExist spec)) + (ifM initialPkgRepo + (putStrLn $ show br ++ ": initial repo") + (putStrLn $ "missing " ++ spec)) $ + do + mnvr <- pkgNameVerRel br spec + case mnvr of + Nothing -> do + putStrLn "undefined NVR!\n" + putStr "HEAD " + whenJustM (gitShortLog1 Nothing) $ putStrLn . showCommit + Just nvr -> do + -- unless (br == Rawhide) $ do + -- newerBr <- newerBranch br <$> getFedoraBranches + -- ancestor <- gitBool "merge-base" ["--is-ancestor", "HEAD", show newerBr] + -- when ancestor $ do + -- unmerged <- gitOneLineLog $ "HEAD..origin/" ++ show newerBr + -- unless (null unmerged) $ do + -- putStrLn $ "Newer commits in " ++ show newerBr ++ ":" + -- mapM_ putStrLn unmerged + munpushed <- gitShortLog1 $ Just $ "origin/" ++ show br ++ "..HEAD" + case munpushed of + Nothing -> do + mbuild <- kojiGetBuildID fedoraHub nvr + case mbuild of + Nothing -> do + mlatest <- kojiLatestNVR (branchDestTag br) (unPackage pkg) + case mlatest of + Nothing -> putStrLn $ "new " ++ nvr + Just latest -> + putStrLn $ if equivNVR nvr latest then latest ++ " is latest modulo disttag" else (if null latest then "new " else (head . words) latest ++ " ->\n") ++ nvr + Just buildid -> do + tags <- kojiBuildTags fedoraHub (buildIDInfo buildid) + if null tags + then do + mstatus <- kojiBuildStatus nvr + -- FIXME show pending archs building + whenJust mstatus $ \ status -> + -- FIXME better Show BuildStatus + putStr $ nvr ++ " (" ++ show status ++ ")" + else do + -- FIXME hide testing if ga/stable + putStr $ nvr ++ " (" ++ unwords tags ++ ")" + unless (isStable tags) $ do + updates <- bodhiUpdates + [makeItem "display_user" "0", + makeItem "builds" nvr] + case updates of + [] -> putStrLn "No update found" + [update] -> do + -- FIXME could show minus time left using stable_days? + let msince = lookupKey "date_testing" update :: Maybe LocalTime + case msince of + Nothing -> return () + Just date -> do + let since = localTimeToUTC utc date + current <- getCurrentTime + let diff = diffUTCTime current since + putAge diff + _ -> putStrLn "More than one update found!" + putNewLn + Just unpushed -> + let prefix = + let pref = + (if length pkgs > 1 then unPackage pkg else "") +-+ + case breq of + Branches brs | length brs <= 1 -> "" + _ -> show br + in if null pref then "" else pref ++ ":" + in putStrLn $ prefix +-+ showCommit unpushed + where + isStable :: [String] -> Bool + isStable = not . all ("-testing" `isSuffixOf`) - putAge :: NominalDiffTime -> IO () - putAge diff = do - -- FIXME time-1.10 has formatTime of NominalDiffTime - let (days,nomRest) = diff `divMod'` nominalDay :: (Int,NominalDiffTime) - nominalHour = 3600 :: NominalDiffTime - hours = nomRest `div'` nominalHour :: Int - putStr $ " " ++ plural days "day" +-+ plural hours "hour" + putAge :: NominalDiffTime -> IO () + putAge diff = do + -- FIXME time-1.10 has formatTime of NominalDiffTime + let (days,nomRest) = diff `divMod'` nominalDay :: (Int,NominalDiffTime) + nominalHour = 3600 :: NominalDiffTime + hours = nomRest `div'` nominalHour :: Int + putStr $ " " ++ plural days "day" +-+ plural hours "hour" #if !MIN_VERSION_time(1,8,0) - nominalDay = 3600 * 24 :: NominalDiffTime + nominalDay = 3600 * 24 :: NominalDiffTime #endif + + +unpushedCmd :: Bool -> (BranchesReq,[String]) -> IO () +unpushedCmd latest (breq, pkgs) = + -- FIXME dirty not okay for multiple branches? + withPackagesByBranches (if latest then HeaderMay else HeaderMust) False dirtyGit AnyNumber unpushedBranch (breq, pkgs) + where + -- FIXME note dirty when local changes + unpushedBranch :: Package -> AnyBranch -> IO () + unpushedBranch _ (OtherBranch _) = + error' "status currently only defined for release branches" + unpushedBranch pkg rbr@(RelBranch br) = do + brExists <- checkIfRemoteBranchExists rbr + if not brExists + then do + name <- getDirectoryName + putStrLn $ name ++ " has no branch " ++ show br + else do + gitSwitchBranch rbr + let spec = packageSpec pkg + prefix = + let pref = + (if length pkgs > 1 then unPackage pkg else "") +-+ + case breq of + Branches brs | length brs <= 1 -> "" + _ -> show br + in if null pref then "" else pref ++ ":" + ifM (notM (doesFileExist spec)) + (ifM initialPkgRepo + (putStrLn $ prefix +-+ "initial repo") + (unlessM (doesFileExist "dead.package") $ + putStrLn $ "missing " ++ spec)) $ + do + whenM (isNothing <$> pkgNameVerRel br spec) $ do + putStrLn "undefined NVR!\n" + putStr "HEAD " + unpushed <- gitShortLogN (if latest then Just 1 else Nothing) $ + Just $ "origin/" ++ show br ++ "..HEAD" + if latest + then whenJust (listToMaybe unpushed) $ putCommit prefix + else mapM_ (putCommit prefix) unpushed + + putCommit prefix = putStrLn . (prefix +-+) . showCommit diff --git a/src/Cmd/Update.hs b/src/Cmd/Update.hs --- a/src/Cmd/Update.hs +++ b/src/Cmd/Update.hs @@ -10,9 +10,9 @@ import InterleaveOutput (cmdSilent') import Krb import Package -import Prompt (prompt_) import Data.RPM.VerCmp +import SimplePrompt (prompt_) -- FIXME don't bump release if already bumped -- FIXME check EVR increased @@ -138,10 +138,6 @@ case ws of [f,v] -> (f,v) _ -> error $ "inconsistent field: " ++ xs - -editSpecField :: String -> String -> FilePath -> IO () -editSpecField field new spec = - cmd_ "sed" ["-i", "-e s/^\\(" ++ field ++ ":\\s\\+\\).*/\\1" ++ new ++ "/", spec] changelogVersions :: FilePath -> IO [String] changelogVersions spec = do diff --git a/src/Cmd/WaitRepo.hs b/src/Cmd/WaitRepo.hs --- a/src/Cmd/WaitRepo.hs +++ b/src/Cmd/WaitRepo.hs @@ -15,9 +15,9 @@ data WaitFetch = WaitNoFetch | WaitDirty | WaitFetch -- FIXME first check/wait for build to actually exist -waitrepoCmd :: Bool -> WaitFetch -> Maybe SideTagTarget +waitrepoCmd :: Bool -> Bool -> WaitFetch -> Maybe SideTagTarget -> (BranchesReq, [String]) -> IO () -waitrepoCmd dryrun fetch msidetagTarget = do +waitrepoCmd dryrun knowntag fetch msidetagTarget = do withPackagesByBranches HeaderMay False (case fetch of WaitFetch -> cleanGitFetchActive @@ -33,6 +33,5 @@ let spec = packageSpec pkg nvr <- pkgNameVerRel' br spec target <- targetMaybeSidetag dryrun br msidetagTarget - logMsg $ "waiting for " ++ nvr ++ " to appear in " ++ target - timeIO $ - kojiWaitRepo dryrun True target nvr + logMsg $ "Waiting for " ++ nvr ++ " to appear in " ++ target + timeIO $ kojiWaitRepo dryrun True knowntag target nvr diff --git a/src/Git.hs b/src/Git.hs --- a/src/Git.hs +++ b/src/Git.hs @@ -10,7 +10,7 @@ getNewerBranch, newerMergeable, gitFetchSilent, - gitPushSilent, + gitPush, gitRepoName, Commit(commitRef,commitLog), showCommit, @@ -35,11 +35,11 @@ import Data.Char (isSpace) import SimpleCmd.Git +import SimplePrompt import Branches import Common import Common.System -import Prompt #if !MIN_VERSION_simple_cmd(0,2,2) -- | 'gitBool c args' runs git command and return result @@ -125,9 +125,9 @@ gitOneLineLog range = map mkCommit <$> gitLines "log" ["--pretty=format:%H (%s, %cs)", range] -gitShortLogN :: Int -> Maybe String -> IO [Commit] -gitShortLogN num mrange = - map mkCommit <$> gitLines "log" (["--max-count=" ++ show num, "--pretty=reference"] ++ maybeToList mrange) +gitShortLogN :: Maybe Int -> Maybe String -> IO [Commit] +gitShortLogN mnum mrange = + map mkCommit <$> gitLines "log" (["--max-count=" ++ show num | num <- maybeToList mnum] ++ "--pretty=reference": maybeToList mrange) gitShortLog1 :: Maybe String -> IO (Maybe Commit) gitShortLog1 mrange = do @@ -148,12 +148,24 @@ (plogcs,datep) -> Commit hash (init $ tail $ trim plogcs) (init datep) -gitPushSilent :: Maybe String -> IO () -gitPushSilent mref = do +gitPush :: Bool -> Maybe String -> IO () +gitPush quiet mref = do checkOnBranch - putStr "git pushing... " - out <- cmdQuiet "git" $ ["push", "--quiet", "origin"] ++ maybeToList mref - putStrLn $ if null out then "done" else "\n" ++ out + when quiet $ + putStr "git pushing... " + -- Can error like this: + -- kex_exchange_identification: Connection closed by remote host + -- Connection closed by 38.145.60.17 port 22 + -- fatal: Could not read from remote repository. + let args = ["push"] ++ ["--quiet" | quiet] ++ ["origin"] ++ maybeToList mref + (ok, _out, err) <- cmdFull "git" args "" + if ok + then putStrLn $ if quiet then "done" else last (lines err) + else do + when quiet $ putStrLn "" + putStrLn $ unwords ("git" : args) +-+ "failed with\n" ++ err + yes <- yesno Nothing "Retry git push" + when yes $ gitPush quiet mref -- FIXME use this in more places gitRepoName :: IO String diff --git a/src/Koji.hs b/src/Koji.hs --- a/src/Koji.hs +++ b/src/Koji.hs @@ -32,6 +32,7 @@ import Data.Fixed (Micro) import Distribution.Koji import qualified Distribution.Koji.API as Koji +import SimplePrompt import System.Exit import System.Process.Typed import System.Timeout (timeout) @@ -44,7 +45,6 @@ import Krb import Package (fedpkg, Package, unPackage) import Pagure -import Prompt import Types fedoraHub :: String @@ -112,7 +112,8 @@ -- init to drop final newline unless (B.null out) $ logMsg $ (B.unpack . B.init . B.unlines . tail . B.lines) out - if ret == ExitSuccess then do + if ret == ExitSuccess + then do let kojiurl = B.unpack $ last $ B.words out task = (TaskId . read) $ takeWhileEnd isDigit kojiurl when wait $ do @@ -141,7 +142,11 @@ mst <- kojiGetTaskState fedoraHub task case mst of Just TaskClosed -> return () - Just TaskFailed -> error' "Task failed!" + Just TaskFailed -> do + let kojitool = "/usr/bin/koji-tool" + whenM (doesFileExist kojitool) $ + cmd_ kojitool ["tasks", displayID task, "--tail", "-s", "fail"] + error' "Task failed!" Just TaskCanceled -> return () _ -> kojiWatchTask task @@ -188,11 +193,31 @@ Left task <- kojiBuildBranch' False target pkg mref args return task -kojiWaitRepo :: Bool -> Bool -> String -> String -> IO () -kojiWaitRepo dryrun quiet target nvr = do - Just (buildtag,_desttag) <- kojiBuildTarget fedoraHub target - unless dryrun $ - waitRepo buildtag Nothing +kojiWaitRepo :: Bool -> Bool -> Bool -> String -> String -> IO () +kojiWaitRepo dryrun quiet knowntag target nvr = do + Just (buildtag,desttag) <- kojiBuildTarget fedoraHub target + unless dryrun $ do + mlatest <- kojiLatestNVR buildtag (nameOfNVR nvr) + if Just nvr == mlatest + then waitRepo buildtag Nothing + else do + tags <- cmdLines "koji" ["list-tags", "--build=" ++ nvr] + if knowntag + then do + putStrLn $ "current tags:" +-+ unwords tags + waitRepo buildtag Nothing + else do + mbuilt <- kojiLatestNVR desttag (nameOfNVR nvr) + if mbuilt == Just nvr + then do + sleep 40 + kojiWaitRepo dryrun quiet knowntag target nvr + else do + putStrLn $ "current tags:" +-+ unwords tags + unless (buildtag `elem` tags) $ do + putStrLn $ "no" +-+ nvr +-+ "tagged" +-+ buildtag + prompt_ "Press Enter to continue anyway" + waitRepo buildtag Nothing where waitRepo :: String -> Maybe Struct -> IO () waitRepo buildtag moldrepo = do @@ -273,7 +298,7 @@ putStrLn out let sidetag = init . dropWhileEnd (/= '\'') $ dropPrefix "Side tag '" out - logMsg $ "waiting for " ++ sidetag ++ " repo" + logMsg $ "Waiting for " ++ sidetag ++ " repo" unless dryrun $ cmd_ "koji" ["wait-repo", sidetag] return sidetag diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -78,11 +78,16 @@ , Subcommand "merge" "Merge from newer branch" $ mergeCmd <$> dryrunOpt + <*> switchLongWith "no-fetch" "Skip git fetch" <*> nopromptOpt <*> optional (optionWith auto 's' "skip-bumps" "NUM" "Max num of rebuild commits to ignore [default 0]") <*> switchWith 'a' "show-all" "List all commits [default first 20]" <*> optional (optionWith branchM 'f' "from" "BRANCH" "Branch to merge from [default newer]") <*> branchesPackages + , Subcommand "unpushed" "Show unpushed commits" $ + unpushedCmd + <$> switchWith 'l' "latest" "Only show latest unpushed commit" + <*> branchesPackages , Subcommand "build" "Build package(s) in Koji" $ buildCmd <$> buildOpts @@ -124,6 +129,7 @@ , Subcommand "waitrepo" "Wait for build to appear in Koji buildroot" $ waitrepoCmd <$> dryrunOpt + <*> pure False <*> waitfetchOpt <*> optional (sidetagTargetOpt Nothing) <*> branchesPackages @@ -135,7 +141,7 @@ <*> noFailFastOpt <*> optional archesOpt <*> many (sidetagTargetOpt Nothing) - <*> optional (strOptionWith 'r' "ref" "COMMITHASH" "git commit to build") + <*> optional scratchSourceOpt <*> branchesPackages , Subcommand "scratch-aarch64" "Koji aarch64 scratch build of package" $ scratchCmdAarch64 @@ -143,7 +149,7 @@ <*> rebuildSrpmOpt <*> switchWith 'X' "exclude-arch" "Exclude aarch64" <*> many (sidetagTargetOpt Nothing) - <*> optional (strOptionWith 'r' "ref" "COMMITHASH" "git commit to build") + <*> optional scratchSourceOpt <*> branchesPackages , Subcommand "scratch-x86_64" "Koji x86_64 scratch build of package" $ scratchCmdX86_64 @@ -151,7 +157,7 @@ <*> rebuildSrpmOpt <*> switchWith 'X' "exclude-arch" "Exclude x86_64" <*> many (sidetagTargetOpt Nothing) - <*> optional (strOptionWith 'r' "ref" "COMMITHASH" "git commit to build") + <*> optional scratchSourceOpt <*> branchesPackages , Subcommand "update-version" "Update package in dist-git to newer version" $ updateCmd @@ -180,9 +186,14 @@ srpmCmd <$> switchWith 'f' "force" "regenerate even if spec older than existing srpm" <*> maybeBranchPackages False + , Subcommand "srpm-spec" "Show the spec file in an srpm" $ + srpmSpecCmd + <$> switchWith 'd' "diff" "Compare with current spec file" + <*> some (strArg "SRPM") , Subcommand "diff" "Diff local changes" $ diffCmd - <$> switchWith 'o' "spec-only" "Only diff spec file" + <$> switchWith 'd' "debug" "use package headers" + <*> switchWith 'o' "spec-only" "Only diff spec file" <*> diffWorkOpt <*> diffFormatOpt <*> switchWith 'i' "ignore-bumps" "Ignore pure release bumps" @@ -204,9 +215,11 @@ mockCmd <$> switchWith 'n' "dry-run" "Do not build (but creates srpm)" <*> optional nocleanOpt - <*> switchWith 'w' "network" "Use network during build" - <*> switchWith 's' "shell" "Enter chroot shell after building" + <*> switchWith 'N' "network" "Use network during build" + <*> optional (flagLongWith' ShellOnly "shell-only" "Skip mock build" <|> + flagWith' BuildShell 's' "shell" "Enter chroot shell after building") <*> optional (optionWith branchM 'r' "root" "BRANCH" "Mock config to use") + <*> optional archOpt <*> branchesPackages , Subcommand "install-deps" "Install package build dependencies" $ installDepsCmd @@ -220,6 +233,7 @@ <*> optional forceshortOpt <*> many bcondOpt <*> switchWith 'r' "reinstall" "reinstall rpms" + <*> switchWith 'B' "ignore-builddeps" "do not install builddeps" <*> switchWith 'a' "all-subpackages" "install all subpackages (default if none currently installed)" <*> maybeBranchPackages False , Subcommand "not-installed" "Packages not installed locally" $ @@ -233,6 +247,8 @@ bumpPkgs <$> switchWith 'l' "local" "Use local origin rather than checking latest koji" <*> optional commitOpts + <*> optional (strOptionWith 'c' "changelog" "CLOGENTRY" + "Override changelog entry [default: rebuild]") <*> branchesPackages , Subcommand "commit" "Git commit packages" $ commitPkgs @@ -249,10 +265,16 @@ <$> manyPackages , Subcommand "push" "Git push packages" $ pushPkgs - <$> branchesPackages + <$> dryrunOpt + <*> switchLongWith "no-fetch" "Skip git fetch" + <*> optional (strOptionWith 'r' "ref" "COMMITHASH" "git commit to push") + <*> branchesPackages , Subcommand "owner" "List package owner(s)" $ ownerCmd <$> manyPackages + , Subcommand "bzusers" "Search bugzilla users" $ + bzusersCmd + <$> strArg "NAME" , Subcommand "create-review" "Create a Package Review request" $ createReview <$> scratchOpt @@ -333,6 +355,14 @@ <|> FtbfsSubstring <$> strOptionWith 's' "substring" "STRING" "Component substring") <*> maybeBranchPackages False + , Subcommand "autospec" "Convert package to use rpmautospec" $ + autospecCmd + <$> switchWith 'f' "force" "Refresh changelog file to current" + <*> manyPackages + , Subcommand "move-artifacts" "Move old rpm artifacts into rpmbuild dirs" $ + moveArtifactsCmd + <$> switchWith 'd' "delete" "Remove duplicate artifacts" + <*> manyPackages ] where cloneRequest :: Parser CloneRequest @@ -449,7 +479,7 @@ mockOpt brs = switchWith 'm' "mock" $ "Do mock build to test" ++ if brs then " branches" else "" archOpt :: Parser String - archOpt = strOptionWith 'a' "arch" "ARCH[,ARCH].." "build for arch(s)" + archOpt = strOptionWith 'a' "arch" "ARCH" "build for arch(s)" rebuildSrpmOpt = switchWith 'S' "rebuild-srpm" "rebuild srpm in Koji" @@ -581,6 +611,11 @@ scratchOpt = ScratchTask <$> optionWith auto 's' "scratch-build" "TASKID" "Existing scratch build taskid" <|> flagWith ScratchBuild SkipScratch 'S' "no-scratch" "Skip scratch build" + + scratchSourceOpt :: Parser ScratchSource + scratchSourceOpt = + ScratchSRPM <$> strOptionLongWith "srpm" "SRPM" "SRPM to use" <|> + ScratchRef <$> strOptionWith 'r' "ref" "COMMITHASH" "git commit to build" nocleanOpt :: Parser NoClean nocleanOpt = diff --git a/src/Package.hs b/src/Package.hs --- a/src/Package.hs +++ b/src/Package.hs @@ -39,18 +39,19 @@ packageSpec, pkgNameVerRel, pkgNameVerRel', - equivNVR + equivNVR, + editSpecField ) where import Distribution.Fedora hiding (Fedora,EPEL,EPELNext) import SimpleCmd.Rpm +import SimplePrompt import Branches import Common import Common.System import Git import Krb -import Prompt fedpkg :: String -> [String] -> IO String fedpkg c args = @@ -70,7 +71,7 @@ clog <- cleanChangelog spec putNewLn putStrLn "```" - putStrLn clog + putStr clog putStrLn "```" -- FIXME is this actually useful? tty <- isTty @@ -161,7 +162,7 @@ -- newly created Fedora repos/branches have just one README commit initialPkgRepo :: IO Bool initialPkgRepo = do - commits <- length <$> gitShortLogN 2 Nothing + commits <- length <$> gitShortLogN (Just 2) Nothing return $ commits <= 1 newtype Package = Package {unPackage :: String} @@ -455,3 +456,7 @@ -- toPackage (IsPkg p) = p -- toPackage (Unknown p) = p -- toPackage (IsBr b) = error' $ "can't map branch to package: " ++ show b + +editSpecField :: String -> String -> FilePath -> IO () +editSpecField field new spec = + cmd_ "sed" ["-i", "-e s/^\\(" ++ field ++ ":\\s\\+\\).*/\\1" ++ new ++ "/", spec] diff --git a/src/Prompt.hs b/src/Prompt.hs deleted file mode 100644 --- a/src/Prompt.hs +++ /dev/null @@ -1,50 +0,0 @@ -module Prompt ( - prompt, - prompt_, - yesno - ) where - -import Data.Char (isPrint) - -import Common -import Common.System - --- import System.Console.Haskeline -import System.IO - --- FIXME promptNonEmpty -prompt :: String -> IO String -prompt s = do - -- -- doesn't work in emacs-vterm :( - -- runInputT defaultSettings loop - -- where - -- loop :: InputT IO String - -- loop = do - -- minput <- getInputLine $ s ++ ": " - -- case minput of - -- Nothing -> return "" - -- Just input -> return input - putStr $ s ++ ": " - tty <- openFile "/dev/tty" ReadMode - inp <- hGetLine tty - if all isPrint inp - then return inp - else do - warning $ - "input rejected because of unprintable character(s): '" ++ - show inp ++ "'" - prompt s - -prompt_ :: String -> IO () -prompt_ = void <$> prompt - --- from dnf-repo Sudo.hs -yesno :: String -> IO Bool -yesno desc = do - inp <- prompt $ desc ++ "? [y/n]" - case lower inp of - "y" -> return True - "yes" -> return True - "n" -> return False - "no" -> return False - _ -> yesno desc diff --git a/src/RpmBuild.hs b/src/RpmBuild.hs --- a/src/RpmBuild.hs +++ b/src/RpmBuild.hs @@ -12,6 +12,7 @@ isShortCircuit, checkSourcesMatch, notInstalled, + rpmEval ) where @@ -21,6 +22,7 @@ import Distribution.Fedora hiding (Fedora,EPEL,EPELNext) import Network.HTTP.Directory (Manager, httpExists, httpManager) import SimpleCmd.Rpm +import SimplePrompt (prompt_) import System.Console.Pretty import System.IO.Extra (withTempDir) import System.Posix.Files @@ -30,7 +32,6 @@ import Common.System import Git import Package -import Prompt (prompt_) builtRpms :: AnyBranch -> FilePath -> IO [FilePath] builtRpms br spec = do @@ -233,11 +234,13 @@ args = sourcediropt ++ ["--define", "dist " ++ rpmDistTag dist] ++ buildopt ++ map show bconds ++ [spec] date <- cmd "date" ["+%T"] - putStr $ date ++ " Building " ++ takeBaseName spec ++ " locally... " + rbr <- anyBranchToRelease br + nvr <- pkgNameVerRel' rbr spec + putStr $ date ++ " Building " ++ nvr ++ " locally... " ok <- do - rbr <- anyBranchToRelease br - nvr <- pkgNameVerRel' rbr spec let buildlog = ".build-" ++ (showVerRel . nvrVerRel . readNVR) nvr <.> "log" + whenM (doesFileExist buildlog) $ + copyFile buildlog (buildlog <.> "prev") timeIO $ if not quiet || isShortCircuit mforceshort then do @@ -255,7 +258,7 @@ else cmd_ "tail" ["-n 100", buildlog] return res unless ok $ - error' $ takeBaseName spec ++ " failed to build" + error' $ nvr ++ " failed to build" return needBuild where quoteArg :: String -> String