koji-tool 1.1.1 → 1.2
raw patch · 14 files changed
+408/−300 lines, 14 filesdep +safe
Dependencies added: safe
Files
- ChangeLog.md +16/−0
- README.md +119/−86
- koji-tool.cabal +6/−4
- src/BuildlogSizes.hs +5/−7
- src/Builds.hs +27/−25
- src/Common.hs +16/−9
- src/Find.hs +19/−15
- src/Install.hs +9/−7
- src/Main.hs +15/−10
- src/Progress.hs +19/−21
- src/Tasks.hs +111/−87
- src/Time.hs +25/−24
- src/Utils.hs +18/−2
- test/tests.hs +3/−3
ChangeLog.md view
@@ -1,5 +1,21 @@ # Version history of koji-tool +## 1.2 (2024-07-27)+- allow --unlimited results: useful for open tasks/builds+- builds: also show owner+- find: also support noarch+- find: move --debug to debug arg+- improve detailed output handling with Maybe Details for tasks and builds+- improvements to log url logic+- install: include noarch in getArchs to include noarch rpms+- lookupArch first checks the label field then arch field+- progress: use safe maximumMay of sizes+- tasks: add --children and --parent of taskid+- tasks: add --install option+- tasks: also show create time and owner+- tasks: in addition to buildlog size also print timestamp+- tasks: ignore subtask limit for Package, ParentOf, ChildrenOf+ ## 1.1.1 (2023-10-20) - 'builds': reformat short build result to align better - 'install': detect ostree with "/sysroot/ostree" not rpm-ostree
README.md view
@@ -22,11 +22,13 @@ ## Commands `$ koji-tool --version`+ ```-1.1.1+1.2 ``` `$ koji-tool --help`+ ``` Query and track Koji tasks, and install rpms from Koji. @@ -49,33 +51,40 @@ buildlog-sizes Show buildlog sizes for nvr patterns find Simple quick common queries using words like: [my, last, fail, complete, current, build, detail,- install, tail, notail, hwinfo, x86_64, PACKAGE,- USER\'s, LIMIT]+ install, tail, notail, hwinfo, x86_64, debug,+ PACKAGE, USER\'s, LIMIT] ``` ## koji-tool builds -Query Koji for builds.+The `builds` command queries Koji for builds. Somewhat like `koji list-builds --quiet ...`, but it shows duration, and kojiweb urls.-It uses `date` to parse a specified date string-and can use an NVR glob pattern to select builds. Note results are ordered by build_id (not time) for speed. ### Usage -By default lists up to 10 Fedora Koji builds.+By default it lists up to 10 Fedora Koji builds -+this can be changed with the `--limit` or `--unlimited` options. +One can select builds also by time/date options,+which are parsed by the system `date` utility.++One can also use an NVR glob pattern to select builds.++ `$ koji-tool builds --help`+ ```-Usage: koji-tool builds [-H|--hub HUB] [(-u|--user USER) | (-M|--mine)]- [(-L|--latest) | (-l|--limit INT)] [-s|--state STATE]- [(-B|--before TIMESTAMP) | (-F|--from TIMESTAMP)]- [-T|--type TYPE] [(-d|--details) | (-t|--tasks)]- [-i|--install INSTALLOPTS] [-D|--debug]- [(-b|--build NVR/BUILDID) | (-p|--pattern NVRPAT) |+Usage: koji-tool builds [-H|--hub HUB] [(-u|--user USER) | (-M|--mine)] + [(-L|--latest) | (-U|--unlimited) | (-l|--limit INT)] + [-s|--state STATE] + [(-B|--before TIMESTAMP) | (-F|--from TIMESTAMP)] + [-T|--type TYPE] [(-d|--details) | (-t|--tasks)] + [-i|--install INSTALLOPTS] [-D|--debug] + [(-b|--build NVR/BUILDID) | (-p|--pattern NVRPAT) | PACKAGE] Query Koji builds (by default lists the most recent builds)@@ -86,7 +95,8 @@ -u,--user USER Koji user -M,--mine Your tasks (krb fasid) -L,--latest Latest build- -l,--limit INT Maximum number of builds to show [default: 10]+ -U,--unlimited No limit on number of results+ -l,--limit INT Maximum number of builds to show [default: 20] -s,--state STATE Filter builds by state (building,complete,deleted,fail(ed),cancel(ed) -B,--before TIMESTAMP Builds completed before timedate [default: now]@@ -109,43 +119,58 @@ lists your recent builds that failed. List latest build of a package:-```shellsession-$ koji-tool builds --pattern redhat-rpm-config*.fc37 --latest -redhat-rpm-config-218-1.fc37 BuildComplete-https://koji.fedoraproject.org/koji/buildinfo?buildID=1963037-https://koji.fedoraproject.org/koji/taskinfo?taskID=86677797-Start: Thu May 5 19:02:33 +08 2022-End: Thu May 5 19:04:26 +08 2022-duration: 0h 1m 53s+`$ koji-tool builds --pattern redhat-rpm-config*.fc40 --latest`+ ```+redhat-rpm-config-288-1.fc40 BuildComplete (fweimer)+https://koji.fedoraproject.org/koji/buildinfo?buildID=2460713+https://koji.fedoraproject.org/koji/taskinfo?taskID=118524958+start: Tue Jun 4 03:07:58 +08 2024+completion: Tue Jun 4 03:12:51 +08 2024+duration: 4 min 53 sec+https://kojipkgs.fedoraproject.org/packages/redhat-rpm-config/288/1.fc40+``` ## koji-tool tasks -Query Koji for tasks.+The `tasks` command queries Koji for tasks. Somewhat like `koji list-tasks --quiet --all ...`,-but it shows duration, kojiweb urls and build.log size,-and it uses `date` to parse a specified date string-and can filter task results by package or nvr prefix.+but it shows duration, kojiweb urls and optionally build.log size. Note results are ordered by task id (not time) for speed. ### Usage -By default it lists 10 most recent Fedora Koji buildArch tasks.+By default it lists 10 most recent Fedora Koji buildArch tasks,+this can be changed with the `--limit` or `--unlimited` options. +Tasks can be searched by package, task id (including parent and children),+by build or NVR pattern, also by state, method, and user.++Results can be restricted by date options,+which are parsed by the `date` utility.+The received results can be filtered too locally by package or nvr prefix.++Multiple results are listed concisely each on one line by default.+A single task result is displayed in detail over multiple lines.+These levels of detail can be controlled with+the `--details` and `--concise` options.+ `$ koji-tool tasks --help`+ ```-Usage: koji-tool tasks [-H|--hub HUB] [(-u|--user USER) | (-M|--mine)]- [(-L|--latest) | (-l|--limit INT)] [-s|--state STATE]- [-a|--arch ARCH]- [(-B|--before TIMESTAMP) | (-F|--from TIMESTAMP)]- [-m|--method METHOD] [-D|--debug]- [(-P|--only-package PKG) | (-N|--only-nvr PREFIX)]- [-d|--details] [-T|--tail] [--hw-info] [-g|--grep STRING]- [(-b|--build BUILD) | (-p|--pattern NVRPAT) |- PACKAGE|TASKID]+Usage: koji-tool tasks [-H|--hub HUB] [(-u|--user USER) | (-M|--mine)] + [(-L|--latest) | (-U|--unlimited) | (-l|--limit INT)] + [-s|--state STATE] [-a|--arch ARCH] + [(-B|--before TIMESTAMP) | (-F|--from TIMESTAMP)] + [-m|--method METHOD] [-D|--debug] + [(-P|--only-package PKG) | (-N|--only-nvr PREFIX)] + [(-d|--details) | (-c|--concise)] [-T|--tail] [--hw-info]+ [-g|--grep STRING] [-i|--install INSTALLOPTS] + [(-b|--build BUILD) | (-p|--pattern NVRPAT) | + --children TASKID | --parent TASKID | PACKAGE|TASKID] Query Koji tasks (by default lists the most recent buildArch tasks) @@ -155,7 +180,8 @@ -u,--user USER Koji user -M,--mine Your tasks (krb fasid) -L,--latest Latest build or task- -l,--limit INT Maximum number of tasks to show [default: 10]+ -U,--unlimited No limit on number of results+ -l,--limit INT Maximum number of tasks to show [default: 20] -s,--state STATE Filter tasks by state (open,close(d),cancel(ed),fail(ed),assigned,free) -a,--arch ARCH Task arch@@ -166,12 +192,16 @@ -D,--debug Pretty-print raw XML result -P,--only-package PKG Filter task results to specified package -N,--only-nvr PREFIX Filter task results by NVR prefix- -d,--details Show more details of builds+ -d,--details Show more task details+ -c,--concise Compact task output -T,--tail Fetch the tail of build.log --hw-info Fetch hw_info.log -g,--grep STRING Filter matching log lines+ -i,--install INSTALLOPTS Install the package with 'install' options -b,--build BUILD List child tasks of build -p,--pattern NVRPAT Build tasks of matching pattern+ --children TASKID Children tasks of parent+ --parent TASKID Parent of task -h,--help Show this help text ``` @@ -183,27 +213,33 @@ lists your recent arm64 tasks that failed. Show latest newRepo task:-```shellsession-$ koji-tool tasks --method newrepo --latest -eln-build newRepo TaskClosed-https://koji.fedoraproject.org/koji/taskinfo?taskID=86821565-Start: Mon May 9 11:53:53 +08 2022-End: Mon May 9 11:57:13 +08 2022-duration: 0h 3m 20s+`$ koji-tool tasks --method newrepo --latest`+ ```+eln-build-side-93068 newRepo TaskClosed (kojira)+https://koji.fedoraproject.org/koji/taskinfo?taskID=121120828+create: Sat Jul 27 18:59:06 +08 2024+start: Sat Jul 27 19:00:03 +08 2024+completion: Sat Jul 27 19:03:12 +08 2024+delay: 57 sec+duration: 3 min 9 sec+``` List latest package build's tasks:-```shellsession-$ koji-tool tasks --latest redhat-rpm-config -redhat-rpm-config-218-1.eln118.noarch TaskClosed-https://koji.fedoraproject.org/koji/taskinfo?taskID=86685316 (parent: 86685296)-Start: Fri May 6 00:11:10 +08 2022-End: Fri May 6 00:13:07 +08 2022-duration: 0h 1m 57s-https://kojipkgs.fedoraproject.org/work/tasks/5316/86685316/build.log (13kB)+`$ koji-tool tasks --latest redhat-rpm-config`+ ```+redhat-rpm-config-293-1.eln140.noarch TaskClosed (distrobuildsync-eln/jenkins-continuous-infra.apps.ci.centos.org)+https://koji.fedoraproject.org/koji/taskinfo?taskID=119218471 (parent: 119209735)+create: Tue Jun 18 14:40:53 +08 2024+start: Tue Jun 18 19:13:53 +08 2024+completion: Tue Jun 18 19:15:12 +08 2024+delay: 4 hours 33 min+duration: 1 min 19 sec+https://kojipkgs.fedoraproject.org/packages/redhat-rpm-config/293/1.eln140/data/logs/noarch/build.log (17kB)+``` It is also possible to install packages from a task using `--install "SUBPKG OPTIONS"`.@@ -217,14 +253,15 @@ ## koji-tool install -Download and install rpms from a Koji build or task.+Use the `install` command to download and install rpms+from a Koji build or task. By default it only downloads binaries of already-installed subpackages, but there are options to list and select or exclude specific subpackages. Note this command is intended for development and testing purposes and should not be necessary/used normally on production systems,-but it can be very helpful for quickly testing an specific package build or+but it can be very helpful for quickly testing a specific package build or update locally. ### Usage@@ -234,7 +271,7 @@ ``` will download the latest build for your Fedora version, and try to install it.-Use `--disttag` suffix to select a different Fedora version.+Use `--disttag` suffix to select a different OS version. ```shellsession $ koji-tool install TASKID --except "*-devel"@@ -268,21 +305,23 @@ `--prefix`: override the subpackage prefix -Subpackage selection has only been tested so far for a single build/task.+(Subpackage selection has only really been tested so far+for a single build/task.) ### Help `$ koji-tool install --help`+ ```-Usage: koji-tool install [-n|--dry-run] [-D|--debug] [-y|--yes] [-H|--hub HUB]- [-P|--packages-url URL] [-l|--list] [-L|--latest]- [-t|--check-remote-time]- [--rpm | --rpm-ostree | --dnf5 | --dnf3]- [-a|--arch ARCH]- [(-N|--no-reinstall) | (-S|--skip-existing)]- [-b|--prefix SUBPKGPREFIX]- [--all | --ask | [-p|--package SUBPKG]- [-e|--except SUBPKG] [-x|--exclude SUBPKG]- [-i|--include SUBPKG]] [-d|--disttag DISTTAG]+Usage: koji-tool install [-n|--dry-run] [-D|--debug] [-y|--yes] [-H|--hub HUB] + [-P|--packages-url URL] [-l|--list] [-L|--latest] + [-t|--check-remote-time] + [--rpm | --rpm-ostree | --dnf5 | --dnf3] + [-a|--arch ARCH] + [(-N|--no-reinstall) | (-S|--skip-existing)] + [-b|--prefix SUBPKGPREFIX] + [--all | --ask | [-p|--package SUBPKG] + [-e|--except SUBPKG] [-x|--exclude SUBPKG] + [-i|--include SUBPKG]] [-d|--disttag DISTTAG] [(-R|--nvr) | (-V|--nv)] PKG|NVR|TASKID... Install rpm packages directly from a Koji build task@@ -329,26 +368,19 @@ `koji-tool find last complete build` shows the latest completed koji build (equivalent to `koji-tool builds -L -s complete`). ### Help-```shellsession-$ koji-tool find-koji-tool: find handles these words:+`$ koji-tool find --help` -my mine-last latest-fail failure failed-complete completed completion close closed finish finished-current building open-build builds-detail details detailed-install-tail-notail-hwinfo-x86_64 aarch64 ppc64le s390x i686 armv7hl-PACKAGE-USER\'s-LIMIT+```+Usage: koji-tool find [-H|--hub HUB] [PHRASE] + Simple quick common queries using words like: [my, last, fail, complete,+ current, build, detail, install, tail, notail, hwinfo, x86_64, debug, PACKAGE,+ USER\'s, LIMIT]++Available options:+ -H,--hub HUB KojiHub shortname or url (HUB = fedora, stream,+ rpmfusion, or URL) [default: fedora]+ -h,--help Show this help text ``` ## koji-tool progress@@ -365,7 +397,8 @@ ```shellsession $ koji-tool progress :-$ koji-tool progress 93808251 # ← Koji taskid+:+$ koji-tool progress 93808251 21:39:41 webkitgtk-2.38.2-1.eln123 (93808251) 9h 32m aarch64 87,669kB (16:50:31) 3h 55m TaskClosed i386 88,120kB (16:33:14) 4h 21m TaskClosed
koji-tool.cabal view
@@ -1,5 +1,5 @@ name: koji-tool-version: 1.1.1+version: 1.2 synopsis: Koji CLI tool for querying tasks and installing builds description: koji-tool is a CLI interface to Koji with commands to query@@ -10,7 +10,7 @@ license-file: LICENSE author: Jens Petersen <petersen@redhat.com> maintainer: Jens Petersen <petersen@redhat.com>-copyright: 2021-2023 Jens Petersen <petersen@redhat.com>+copyright: 2021-2024 Jens Petersen <petersen@redhat.com> category: Utility homepage: https://github.com/juhp/koji-tool bug-reports: https://github.com/juhp/koji-tool/issues@@ -24,8 +24,9 @@ || == 8.10.7 || == 9.0.2 || == 9.2.8- || == 9.4.7- || == 9.6.3+ || == 9.4.8+ || == 9.6.6+ || == 9.8.2 source-repository head type: git@@ -57,6 +58,7 @@ koji >= 0.0.2, pretty-simple, rpm-nvr >= 0.1.2,+ safe, simple-cmd >= 0.2.2, simple-cmd-args >= 0.1.8, simple-prompt >=0.2,
src/BuildlogSizes.hs view
@@ -33,7 +33,8 @@ import SimpleCmdArgs -import Common (commonBuildQueryOptions, getBuildState)+import Common (commonBuildQueryOptions, getBuildState, lookupArch)+import Utils (buildlogUrlfromTaskId) -- FIXME split off arch suffix -- FIXME show build duration@@ -49,7 +50,7 @@ else nvrpat results <- listBuilds fedoraKojiHub [("pattern", ValueString pat),- commonBuildQueryOptions 5]+ commonBuildQueryOptions (Just 5)] if null results then if '*' `notElem` pat then buildlogSizesCmd $ nvrpat ++ "*"@@ -92,7 +93,7 @@ buildlogSizes :: Int -> IO () buildlogSizes tid = do- children <- sortOn (\t -> lookupStruct "arch" t :: Maybe String) <$>+ children <- sortOn lookupArch <$> getTaskChildren fedoraKojiHub tid True mapM_ buildlogSize children @@ -104,10 +105,7 @@ whenJust (lookupStruct "arch" child) $ doGetBuildlogSize buildlog where- buildlog = "https://kojipkgs.fedoraproject.org/work/tasks" +/+ lastFew +/+ show tid +/+ "build.log"- lastFew =- let few = dropWhile (== '0') $ drop 4 (show tid) in- if null few then "0" else few+ buildlog = buildlogUrlfromTaskId tid doGetBuildlogSize :: String -> String -> IO () doGetBuildlogSize buildlog arch = do
src/Builds.hs view
@@ -45,13 +45,13 @@ capitalize "" = "" capitalize (h:t) = toUpper h : t -data Details = DetailDefault | Detailed | DetailedTasks+data Details = Detailed | DetailedTasks deriving Eq -buildsCmd :: Maybe String -> Maybe UserOpt -> Int -> [BuildState]- -> Maybe Tasks.BeforeAfter -> Maybe String -> Details- -> Maybe Tasks.Select -> Bool -> BuildReq -> IO ()-buildsCmd mhub museropt limit !states mdate mtype details minstall debug buildreq = do+buildsCmd :: Maybe String -> Maybe UserOpt -> Maybe Int -> [BuildState]+ -> Maybe Tasks.BeforeAfter -> Maybe String -> Maybe Details+ -> Maybe Select -> Bool -> BuildReq -> IO ()+buildsCmd mhub museropt mlimit !states mdate mtype mdetails minstall debug buildreq = do when (hub /= fedoraKojiHub && museropt == Just UserSelf) $ error' "--mine currently only works with Fedora Koji: use --user instead" tz <- getCurrentTimeZone@@ -63,7 +63,7 @@ then InfoID (read bld) else InfoString bld mbld <- getBuild hub bldinfo- whenJust (mbld >>= maybeBuildResult) $ printBuild hub tz details debug minstall+ whenJust (mbld >>= maybeBuildResult) $ printBuild hub tz mdetails debug minstall BuildPackage pkg -> do when (head pkg == '-') $ error' $ "bad combination: not a package: " ++ pkg@@ -75,21 +75,21 @@ Just pkgid -> do query <- setupQuery let fullquery = [("packageID", ValueInt pkgid),- commonBuildQueryOptions limit] ++ query+ commonBuildQueryOptions mlimit] ++ query when debug $ print fullquery builds <- listBuilds hub fullquery when debug $ mapM_ pPrintCompact builds- if details /= DetailDefault || length builds == 1- then mapM_ (printBuild hub tz details debug minstall) $ mapMaybe maybeBuildResult builds+ if isJust mdetails || length builds == 1+ then mapM_ (printBuild hub tz mdetails debug minstall) $ mapMaybe maybeBuildResult builds else mapM_ putStrLn $ mapMaybe (shortBuildResult tz) builds _ -> do query <- setupQuery- let fullquery = query ++ [commonBuildQueryOptions limit]+ let fullquery = query ++ [commonBuildQueryOptions mlimit] when debug $ print fullquery builds <- listBuilds hub fullquery when debug $ mapM_ pPrintCompact builds- if details /= DetailDefault || length builds == 1- then mapM_ (printBuild hub tz details debug minstall) $ mapMaybe maybeBuildResult builds+ if isJust mdetails || length builds == 1+ then mapM_ (printBuild hub tz mdetails debug minstall) $ mapMaybe maybeBuildResult builds else mapM_ putStrLn $ mapMaybe (shortBuildResult tz) builds where hub = maybe fedoraKojiHub hubURL mhub@@ -99,7 +99,7 @@ nvr <- lookupStruct "nvr" bld state <- readBuildState <$> lookupStruct "state" bld let date =- case lookupBuildTimes bld of+ case lookupStartEndTimes bld of Nothing -> "" Just (start,mend) -> compactZonedTime tz $ fromMaybe start mend@@ -157,23 +157,25 @@ _buildId :: Int, mbuildTaskId :: Maybe Int, _buildStartTime :: UTCTime,- mbuildEndTime :: Maybe UTCTime+ mbuildEndTime :: Maybe UTCTime,+ _buildOwner :: String } maybeBuildResult :: Struct -> Maybe BuildResult maybeBuildResult st = do- (start,mend) <- lookupBuildTimes st+ (start,mend) <- lookupStartEndTimes st buildid <- lookupStruct "build_id" st -- buildContainer has no task_id let mtaskid = lookupStruct "task_id" st state <- getBuildState st nvr <- lookupStruct "nvr" st >>= maybeNVR+ owner <- lookupStruct "owner_name" st return $- BuildResult nvr state buildid mtaskid start mend+ BuildResult nvr state buildid mtaskid start mend owner -printBuild :: String -> TimeZone -> Details -> Bool -> Maybe Tasks.Select+printBuild :: String -> TimeZone -> Maybe Details -> Bool -> Maybe Select -> BuildResult -> IO ()-printBuild hub tz details debug minstall build = do+printBuild hub tz mdetails debug minstall build = do putStrLn "" let mendtime = mbuildEndTime build time <- maybe getCurrentTime return mendtime@@ -181,24 +183,24 @@ when (buildState build == BuildComplete) $ putStrLn $ buildOutputURL hub $ buildNVR build whenJust (mbuildTaskId build) $ \taskid -> do- when (details == DetailedTasks) $ do+ when (mdetails == Just DetailedTasks) $ do putStrLn ""- Tasks.tasksCmd (Just hub) (Tasks.QueryOpts Nothing 7 [] [] Nothing Nothing False Nothing) False False False Nothing (Tasks.Parent taskid)+ Tasks.tasksCmd (Just hub) (Tasks.QueryOpts Nothing (Just 7) [] [] Nothing Nothing False Nothing) Nothing False False Nothing minstall (Tasks.ChildrenOf taskid) whenJust minstall $ \installopts -> do putStrLn "" installCmd False debug No (Just hub) Nothing False False False Nothing [] Nothing Nothing installopts Nothing ReqNVR [showNVR (buildNVR build)] formatBuildResult :: String -> Bool -> TimeZone -> BuildResult -> [String]-formatBuildResult hub ended tz (BuildResult nvr state buildid mtaskid start mendtime) =- [ showNVR nvr +-+ show state+formatBuildResult hub ended tz (BuildResult nvr state buildid mtaskid start mendtime owner) =+ [ showNVR nvr +-+ show state +-+ '(' : owner ++ ")" , buildinfoUrl hub buildid] ++ [Tasks.taskinfoUrl hub taskid | Just taskid <- [mtaskid]]- ++ [formatLocalTime True tz start]+ ++ [formatLocalTime StartEvent tz start] ++ case mendtime of Nothing -> [] Just end ->- [formatLocalTime False tz end | ended]+ [formatLocalTime CompletionEvent tz end | ended] #if MIN_VERSION_time(1,9,1) ++ let dur = diffUTCTime end start@@ -232,4 +234,4 @@ mbld <- kojiLatestBuild hub tag pkg when debug $ print mbld tz <- getCurrentTimeZone- whenJust (mbld >>= maybeBuildResult) $ printBuild hub tz Detailed debug Nothing+ whenJust (mbld >>= maybeBuildResult) $ printBuild hub tz (Just Detailed) debug Nothing
src/Common.hs view
@@ -4,13 +4,15 @@ commonQueryOptions, commonBuildQueryOptions, webUrl,- getBuildState+ getBuildState,+ lookupArch ) where +import Control.Applicative ((<|>)) import Data.List.Extra (dropSuffix, isPrefixOf) import Distribution.Koji (fedoraKojiHub, Value(..), Struct, BuildState,- readBuildState)+ lookupStruct, readBuildState) import SimpleCmd (error') -- mbox kojihub is locked@@ -29,17 +31,22 @@ then hub else error' $ "unknown hub: try " ++ show knownHubs -commonQueryOptions :: Int -> String -> [(String, Value)]-commonQueryOptions limit order =- [("limit",ValueInt limit),- ("order",ValueString order)]+commonQueryOptions :: Maybe Int -> String -> [(String, Value)]+commonQueryOptions mlimit order =+ [("limit",ValueInt limit) | Just limit <- [mlimit]] +++ [ ("order",ValueString order)] -commonBuildQueryOptions :: Int -> (String, Value)-commonBuildQueryOptions limit =- ("queryOpts", ValueStruct (commonQueryOptions limit "-build_id"))+commonBuildQueryOptions :: Maybe Int -> (String, Value)+commonBuildQueryOptions mlimit =+ ("queryOpts", ValueStruct (commonQueryOptions mlimit "-build_id")) webUrl :: String -> String webUrl = dropSuffix "hub" getBuildState :: Struct -> Maybe BuildState getBuildState st = readBuildState <$> lookup "state" st++-- noarch build tasks usually have arch+-- see also https://pagure.io/koji/issue/4098+lookupArch :: Struct -> Maybe String+lookupArch st = lookupStruct "label" st <|> lookupStruct "arch" st
src/Find.hs view
@@ -10,17 +10,19 @@ import Data.Char ( isDigit, isAsciiLower, isAsciiUpper ) import Data.List.Extra ((\\), dropSuffix, isSuffixOf)+import Data.Maybe (listToMaybe) import Distribution.Koji ( BuildState(BuildBuilding, BuildFailed, BuildComplete), TaskState(TaskOpen, TaskFailed, TaskClosed) ) import SimpleCmd (error', (+-+)) import qualified Builds+import Install (Select(PkgsReq)) import qualified Tasks import User ( UserOpt(User, UserSelf) ) data Words = Mine | Limit | Failure | Complete | Current | Build | Detail- | Install | Tail | NoTail | Hwinfo | Arch+ | Install | Tail | NoTail | Hwinfo | Arch | Debug deriving (Enum,Bounded) findWords :: Words -> [String]@@ -37,7 +39,8 @@ findWords Tail = ["tail"] findWords NoTail = ["notail"] findWords Hwinfo = ["hwinfo"]-findWords Arch = ["x86_64", "aarch64", "ppc64le", "s390x", "i686", "armv7hl"]+findWords Debug = ["debug", "dbg"]+findWords Arch = ["x86_64", "aarch64", "ppc64le", "s390x", "i686", "armv7hl", "noarch"] wordsList :: ([String] -> String) -> [String] wordsList f =@@ -50,10 +53,10 @@ -- FIXME: methods -- FIXME: mlt (or mlft) -- FIXME: separate last and latest?-findCmd :: Maybe String -> Bool -> [String] -> IO ()-findCmd _ _ [] = error' $ "find handles these words:\n\n" +++findCmd :: Maybe String -> [String] -> IO ()+findCmd _ [] = error' $ "find handles these words:\n\n" ++ unlines (wordsList unwords)-findCmd mhub debug args = do+findCmd mhub args = do let user = if hasWord Mine then Just UserSelf else case filter ("'s" `isSuffixOf`) args of@@ -63,7 +66,7 @@ unwords more archs = if hasWord Arch then filter (`elem` findWords Arch) args else []- defaultlimit = if hasWord Limit then 1 else 10+ defaultlimit = Just $ if hasWord Limit then 1 else 10 failure = hasWord Failure complete = hasWord Complete current = hasWord Current@@ -73,15 +76,16 @@ tail' = hasWord Tail notail = hasWord NoTail hwinfo = hasWord Hwinfo+ debug = hasWord Debug (limit,mpkg) = case removeUsers (args \\ allWords) of [] -> (defaultlimit, Nothing)- [num] | all isDigit num && not (hasWord Limit) ->- let number = read num- in if number < 1000- then (number, Nothing)- else error' $ "is" +-+ num +-+- "an id? Use 'tasks' for very large limits"+ (num:pkgs) | all isDigit num && length pkgs < 2 ->+ let number = read num+ in if number < 1000+ then (Just number, listToMaybe pkgs)+ else error' $ "is" +-+ num +-++ "an id? Use 'tasks' command for very large limits" -- FIXME allow pattern? [pkg] | all isPkgNameChar pkg -> (defaultlimit, Just pkg) other ->@@ -89,20 +93,20 @@ "you can only specify one package - too many unknown words: " ++ unwords other installation = if install- then Just (Tasks.PkgsReq [] [] [] [])+ then Just (PkgsReq [] [] [] []) else Nothing if build then let states = [BuildFailed|failure] ++ [BuildComplete|complete] ++ [BuildBuilding|current] buildreq = maybe Builds.BuildQuery Builds.BuildPackage mpkg- detailed = if detail then Builds.Detailed else Builds.DetailDefault+ detailed = if detail then Just Builds.Detailed else Nothing in Builds.buildsCmd mhub user limit states Nothing (Just "rpm") detailed installation debug buildreq else let states = [TaskFailed|failure] ++ [TaskClosed|complete] ++ [TaskOpen|current] taskreq = maybe Tasks.TaskQuery Tasks.Package mpkg- in Tasks.tasksCmd mhub (Tasks.QueryOpts user limit states archs Nothing Nothing debug Nothing) detail ((tail' || failure) && not notail) hwinfo Nothing taskreq+ in Tasks.tasksCmd mhub (Tasks.QueryOpts user limit states archs Nothing Nothing debug Nothing) (if detail then Just Tasks.Detailed else Nothing) ((tail' || failure) && not notail) hwinfo Nothing installation taskreq where hasWord :: Words -> Bool hasWord word = any (`elem` findWords word) args
src/Install.hs view
@@ -97,7 +97,7 @@ -- FIXME autodetect NVR, NV, etc -- FIXME support buildid -- FIXME specify tag or task--- FIXME support --latest+-- FIXME support --latest (last build) -- FIXME support enterprise builds -- FIXME --debuginfo -- FIXME --delete after installing@@ -169,7 +169,7 @@ unless (dryrun || null dlRpms) $ do bld <- kojiGetBuild' huburl nvr -- FIXME should be NVRA ideally- downloadRpms debug checkremotetime (strictLookupTimes lookupBuildTimes bld) subdir (buildURL nvr) dlRpms+ downloadRpms debug checkremotetime (lookupStartEndTimes' bld) subdir (buildURL nvr) dlRpms -- FIXME once we check file size - can skip if no downloads printDlDir return (subdir,dlRpms)@@ -209,7 +209,9 @@ "build" -> do when debug $ mapM_ print taskinfo >> putStrLn "" Koji.getTaskChildren huburl taskid True- "buildArch" -> return [taskinfo]+ "buildArch" -> do+ when debug $ print taskinfo >> putStrLn ""+ return [taskinfo] _ -> error' $ "unsupport method: " ++ method totalarchs <- getArchs archs let (archtid,archtask) =@@ -241,7 +243,7 @@ when debug $ mapM_ printInstalled dlRpms let subdir = show archtid unless (dryrun || null dlRpms) $ do- downloadRpms debug checkremotetime (strictLookupTimes lookupTaskTimes archtask) subdir (taskRPMURL archtid) dlRpms+ downloadRpms debug checkremotetime (lookupStartEndTimes' archtask) subdir (taskRPMURL archtid) dlRpms printDlDir return (subdir,dlRpms) where@@ -268,7 +270,7 @@ getArchs :: [String] -> IO [String] getArchs archs = case archs of- [] -> cmdLines "rpm" ["--eval", "%{_arch}"]+ [] -> ("noarch" :) <$> cmdLines "rpm" ["--eval", "%{_arch}"] ars -> return ars data Existence = ExistingNVR | ChangedNVR | NotInstalled@@ -431,8 +433,8 @@ then id else (("pattern", ValueString (if full then pkgpat else dropSuffix "*" pkgpat ++ "*" ++ disttag ++ "*")) :)) [("packageID", ValueInt pkgid),- commonBuildQueryOptions- (if listmode && not latest || oldkoji then 20 else 1)]+ commonBuildQueryOptions $+ Just (if listmode && not latest || oldkoji then 20 else 1)] when debug $ print opts nvrs <- mapMaybe (lookupStruct "nvr") <$> Koji.listBuilds hub opts if null nvrs
src/Main.hs view
@@ -29,14 +29,16 @@ buildsCmd <$> hubOpt <*> optional (userOpt False)- <*> (flagWith' 1 'L' "latest" "Latest build" <|>- optionalWith auto 'l' "limit" "INT" "Maximum number of builds to show [default: 10]" 10)+ <*> (flagWith' (Just 1) 'L' "latest" "Latest build" <|>+ flagWith' Nothing 'U' "unlimited" "No limit on number of results" <|>+ Just <$> optionalWith auto 'l' "limit" "INT" "Maximum number of builds to show [default: 20]" 20) <*> many (parseBuildState' <$> strOptionWith 's' "state" "STATE" "Filter builds by state (building,complete,deleted,fail(ed),cancel(ed)") <*> optional (Before <$> strOptionWith 'B' "before" "TIMESTAMP" "Builds completed before timedate [default: now]" <|> After <$> strOptionWith 'F' "from" "TIMESTAMP" "Builds completed after timedate") <*> (fmap normalizeBuildType <$> optional (strOptionWith 'T' "type" "TYPE" ("Select builds by type: " ++ intercalate "," kojiBuildTypes)))- <*> (flagWith' Detailed 'd' "details" "Show more build details" <|>- flagWith DetailDefault DetailedTasks 't' "tasks" "Show details and tasks")+ <*> optional+ (flagWith' Builds.Detailed 'd' "details" "Show more build details" <|>+ flagWith' Builds.DetailedTasks 't' "tasks" "Show details and tasks") <*> optional (installArgs <$> strOptionWith 'i' "install" "INSTALLOPTS" "Install the package with 'install' options") <*> switchWith 'D' "debug" "Pretty-print raw XML result" <*> (BuildBuild <$> strOptionWith 'b' "build" "NVR/BUILDID" "Show build" <|>@@ -49,13 +51,14 @@ tasksCmd <$> hubOpt <*> queryOpts False "buildArch"- <*> switchWith 'd' "details" "Show more details of builds"+ <*> optional+ (flagWith' Tasks.Detailed 'd' "details" "Show more task details" <|>+ flagWith' Tasks.Concise 'c' "concise" "Compact task output") -- FIXME error if integer (eg mistakenly taskid) <*> switchWith 'T' "tail" "Fetch the tail of build.log" <*> switchLongWith "hw-info" "Fetch hw_info.log" <*> optional (strOptionWith 'g' "grep" "STRING" "Filter matching log lines")- -- -- FIXME any way to pass --help to install?- -- <*> optional (installArgs <$> strOptionWith 'i' "install" "INSTALLOPTS" "Install the package with 'install' options")+ <*> optional (installArgs <$> strOptionWith 'i' "install" "INSTALLOPTS" "Install the package with 'install' options") <*> taskReqOpt , Subcommand "latest" "Query latest Koji build for tag" $@@ -103,7 +106,6 @@ intercalate ", " (wordsList head) ++ "]") $ findCmd <$> hubOpt- <*> switchWith 'D' "debug" "Debug output including XML results" <*> many (strArg "PHRASE") ] where@@ -172,8 +174,9 @@ queryOpts mine defaultMethod = QueryOpts <$> optional (userOpt mine)- <*> (flagWith' 1 'L' "latest" "Latest build or task" <|>- optionalWith auto 'l' "limit" "INT" "Maximum number of tasks to show [default: 10]" 10)+ <*> (flagWith' (Just 1) 'L' "latest" "Latest build or task" <|>+ flagWith' Nothing 'U' "unlimited" "No limit on number of results" <|>+ Just <$> optionalWith auto 'l' "limit" "INT" "Maximum number of tasks to show [default: 20]" 20) <*> many (fmap parseTaskState' $! strOptionWith 's' "state" "STATE" "Filter tasks by state (open,close(d),cancel(ed),fail(ed),assigned,free)") <*> many archOpt <*> optional (Before <$> strOptionWith 'B' "before" "TIMESTAMP" "Tasks completed before timedate [default: now]" <|>@@ -186,5 +189,7 @@ taskReqOpt = Build <$> strOptionWith 'b' "build" "BUILD" "List child tasks of build" <|> Pattern <$> strOptionWith 'p' "pattern" "NVRPAT" "Build tasks of matching pattern"+ <|> ChildrenOf <$> optionLongWith auto "children" "TASKID" "Children tasks of parent"+ <|> ParentOf <$> optionLongWith auto "parent" "TASKID" "Parent of task" <|> argumentWith (maybeReader readTaskReq) "PACKAGE|TASKID" <|> pure TaskQuery
src/Progress.hs view
@@ -33,9 +33,10 @@ import Data.Text (Text) import qualified Data.Text as T import Distribution.Koji+import Safe (maximumMay) import SimpleCmd-import System.FilePath ((</>)) +import Common (lookupArch) import Tasks import Time import Utils@@ -44,7 +45,6 @@ -- FIXME if failure and no more, then stop -- FIXME catch HTTP exception for connection timeout -- FIXME pick up new user builds (if none specified)--- FIXME noarch tasks shown with build arch progressCmd :: Bool -> QueryOpts -> TaskReq -> IO () progressCmd modules queryopts@QueryOpts{..} taskreq = do tasks <- do@@ -113,9 +113,10 @@ initialBuildTask :: Struct -> IO BuildTask initialBuildTask taskinfo = do- let tid = case lookupStruct "id" taskinfo of- Just tid' -> TaskId tid'- Nothing -> error' $ "no taskid found for:" ++ show taskinfo+ let tid =+ case lookupStruct "id" taskinfo of+ Just tid' -> TaskId tid'+ Nothing -> error' $ "no taskid found for:" ++ show taskinfo parent = case lookupStruct "method" taskinfo :: Maybe String of Nothing -> error' $ "no method found for " ++ displayID tid@@ -130,7 +131,7 @@ -- https://koji.fedoraproject.org/koji/taskinfo?taskID=104446426 -- https://kojipkgs.fedoraproject.org//work/tasks/6426/104446426/ _ -> error' $ "unsupported method: " ++ method- children <- sortOn (\t -> lookupStruct "arch" t :: Maybe String) <$>+ children <- sortOn lookupArch <$> kojiGetTaskChildren fedoraKojiHub parent True let start = case lookupTime CreateEvent taskinfo of@@ -199,7 +200,7 @@ (open,closed) = partition (\tis -> getTaskState (taskInfo tis) `elem` map Just openTaskStates) news mlargest = if not (any (\tis -> lookupStruct "method" (taskInfo tis) /= Just ("buildSRPMFromSCM" :: String)) closed) then Nothing- else Just $ maximum $ mapMaybe (\t -> taskStatus t >>= tstLog <&> logSize) closed+ else maximumMay $ mapMaybe (\t -> taskStatus t >>= tstLog <&> logSize) closed mbiggest = max mlargest msize if null open then runProgress (BuildTask tid start mend mbiggest [])@@ -212,6 +213,8 @@ buildlogSize :: Bool -> Int -> TaskInfoStatus -> IO TaskInfoStatuses buildlogSize debug n (TaskInfoStatus task moldstatus) = do+ let tid = fromJust (lookupStruct "id" task)+ buildlog = buildlogUrlfromTaskId tid when debug $ putStrLn buildlog exists <- if isJust moldstatus then return True@@ -221,7 +224,7 @@ (msize,mtime) <- if exists then httpFileSizeTime' buildlog else return (Nothing,Nothing)- when debug $ print (mtime,moldstatus)+ when debug $ print (msize,mtime,moldstatus) if (mtime == fmap logTime moldlog || isNothing mtime) && n < 5 then buildlogSize debug (n+1) (TaskInfoStatus task moldstatus) else@@ -229,12 +232,6 @@ (fromInteger <$> msize, mtime), moldstatus) where- tid = show $ fromJust (readID' task)- buildlog = "https://kojipkgs.fedoraproject.org/work/tasks" </> lastFew </> tid </> "build.log"- lastFew =- let few = dropWhile (== '0') $ takeEnd 4 tid in- if null few then "0" else few- moldlog = moldstatus >>= tstLog :: Maybe LogStatus waitDelay :: IO ()@@ -271,7 +268,7 @@ threadDelay (fromEnum (fromIntegral m :: Micro)) -data TaskOutput = TaskOut {_outArch :: Text,+data TaskOutput = TaskOut {_outArch :: String, moutSize :: Maybe Int, moutSizeStep :: Maybe Int, outSizeChanged :: Bool,@@ -287,15 +284,15 @@ printLogStatuses header tz tss = let (mxsi, mxsp, taskoutputs) = (formatSize . map taskOutput) tss in- unless (null taskoutputs) $ do+ unless (null taskoutputs) $ when (any (\t -> outTimeChanged t || outSizeChanged t || outStateChanged t) taskoutputs) $ do- header- mapM_ (printTaskOut mxsi mxsp) taskoutputs- putChar '\n'+ header+ mapM_ (printTaskOut mxsi mxsp) taskoutputs+ putChar '\n' where printTaskOut :: Int64 -> Int64 -> TaskOutput -> IO () printTaskOut maxsize maxspd (TaskOut arch msize msizediff _sizechanged mtime mtimediff _timechanged state _statechanged mthd mduration) =- fprintLn (rpadded 8 ' ' stext %+ fprintLn (rpadded 8 ' ' string % lpadded (max 6 (maxsize+2)) ' ' (optioned commas) % "kB" % " " % optioned (parenthesised string % " ") %@@ -339,7 +336,7 @@ mstate = getTaskState task in let method = maybeVal "method not found" (lookupStruct "method") task :: Text- arch = maybeVal "arch not found" (lookupStruct "arch") task :: Text+ arch = maybeVal "arch not found" lookupArch task sizediff = liftM2 (-) size oldsize timediff = if time == oldtime then Nothing@@ -358,6 +355,7 @@ user <- case muser of Just user -> return user Nothing -> do+ -- FIXME test for klist mfasid <- (removeSuffix "@FEDORAPROJECT.ORG" <$>) . find ("@FEDORAPROJECT.ORG" `isSuffixOf`) . words <$> cmd "klist" ["-l"] case mfasid of Just fas -> return fas
src/Tasks.hs view
@@ -7,13 +7,13 @@ TaskReq(..), BeforeAfter(..), QueryOpts(..),+ Details(..), tasksCmd, getTasks, parseTaskState', kojiMethods, fedoraKojiHub, taskinfoUrl,- Select(PkgsReq) ) where @@ -43,7 +43,8 @@ import User import Utils -data TaskReq = Task Int | Parent Int | Build String | Package String+data TaskReq = Task Int | ChildrenOf Int | ParentOf Int+ | Build String | Package String | TaskQuery | Pattern String data TaskFilter = TaskPackage String | TaskNVR String@@ -62,16 +63,18 @@ TaskResult {taskPackage :: Either String NVR, taskArch :: String, taskMethod :: String,- _taskState :: TaskState,+ taskState :: TaskState, _mtaskParent :: Maybe Int, taskId :: Int,+ _taskCreateTime :: UTCTime, _mtaskStartTime :: Maybe UTCTime,- mtaskEndTime :: Maybe UTCTime+ mtaskEndTime :: Maybe UTCTime,+ _mtaskOwner :: Maybe String } data QueryOpts = QueryOpts { qmUserOpt :: Maybe UserOpt,- qLimit :: Int,+ qLimit :: Maybe Int, qStates :: ![TaskState], qArchs :: ![String], qmDate :: Maybe BeforeAfter,@@ -79,24 +82,30 @@ qDebug :: Bool, qmFilter :: Maybe TaskFilter} +data Details = Detailed | Concise+ deriving Eq++-- FIXME 'koji-tool tasks <taskid> -s fail -m buildarch' should not print build task -- FIXME short output option -- --sibling -- FIXME --tail-size option (eg more that 4000B) -- FIXME --output-fields -- FIXME default to 'build' for install or try 'build' after 'buildarch'?--- FIXME parent tasks need not have limit -- FIXME `-# 2` etc to select second result-tasksCmd :: Maybe String -> QueryOpts -> Bool -> Bool -> Bool -> Maybe String- -> TaskReq -> IO ()-tasksCmd mhub queryopts@QueryOpts{..} details tail' hwinfo mgrep taskreq = do+tasksCmd :: Maybe String -> QueryOpts -> Maybe Details -> Bool -> Bool+ -> Maybe String -> Maybe Select -> TaskReq -> IO ()+tasksCmd mhub queryopts@QueryOpts{..} mdetails tail' hwinfo mgrep minstall taskreq = do when (hub /= fedoraKojiHub && qmUserOpt == Just UserSelf) $ error' "--mine currently only works with Fedora Koji: use --user instead" tz <- getCurrentTimeZone tasks <- getTasks tz hub queryopts taskreq when qDebug $ mapM_ pPrintCompact tasks- let exact = length tasks == 1- detailed = details || exact- (mapM_ (printTask detailed tz) . filterResults . mapMaybe maybeTaskResult) tasks+ let details =+ case mdetails of+ Nothing ->+ if length tasks == 1 then Detailed else Concise+ Just detail -> detail+ (mapM_ (printTask details tz) . filterResults . mapMaybe maybeTaskResult) tasks where hub = maybe fedoraKojiHub hubURL mhub @@ -115,39 +124,46 @@ isNVR _ (Left _) = False isNVR nvr (Right nvr') = nvr `isPrefixOf` showNVR nvr' - printTask :: Bool -> TimeZone -> TaskResult -> IO ()- printTask detailed tz task = do+ printTask :: Details -> TimeZone -> TaskResult -> IO ()+ printTask details tz task = do let mendtime = mtaskEndTime task mtime <- if isNothing mendtime then Just <$> getCurrentTime else return Nothing- if detailed+ if details == Detailed then do putStrLn "" -- FIX for parent/build method show children (like we do with taskid) (mapM_ putStrLn . formatTaskResult hub mtime tz) task if taskMethod task == "build" then do- getTasks tz hub queryopts (Parent $ taskId task) >>=- mapM_ (printTask detailed tz) . mapMaybe maybeTaskResult- else buildlogSize qDebug tail' hwinfo mgrep hub task+ when (mdetails == Just Detailed) $+ getTasks tz hub queryopts (ChildrenOf $ taskId task) >>=+ mapM_ (printTask details tz) . mapMaybe maybeTaskResult+ else buildlogSize qDebug tz tail' hwinfo mgrep hub task else do (putStrLn . compactTaskResult hub tz) task when (tail' || hwinfo || isJust mgrep) $- buildlogSize qDebug tail' hwinfo mgrep hub task+ buildlogSize qDebug tz tail' hwinfo mgrep hub task+ whenJust minstall $ \installopts -> do+ putStrLn ""+ installCmd False qDebug No (Just hub) Nothing False False False Nothing [] Nothing Nothing installopts Nothing ReqName [show (taskId task)] maybeTaskResult :: Struct -> Maybe TaskResult maybeTaskResult st = do- arch <- lookupStruct "arch" st- let mstart_time = lookupTime CreateEvent st- mend_time = lookupTime CompletionEvent st+ arch <- lookupArch st+ let (create,mstart,mend) = lookupTaskTimes st taskid <- lookupStruct "id" st method <- lookupStruct "method" st state <- getTaskState st let pkgnvr = kojiTaskRequestNVR st mparent' = lookupStruct "parent" st :: Maybe Int+ -- FIXME filter long names like+ -- "koschei/koschei-backend01.iad2.fedoraproject.org"+ -- "bpeck/jenkins-continuous-infra.apps.ci.centos.org"+ mowner = lookupStruct "owner_name" st return $- TaskResult pkgnvr arch method state mparent' taskid mstart_time mend_time+ TaskResult pkgnvr arch method state mparent' taskid create mstart mend mowner pPrintCompact :: Struct -> IO () pPrintCompact =@@ -175,11 +191,11 @@ error' "cannot use taskid together with filter" mtask <- kojiGetTaskInfo hub (TaskId taskid) case mtask of- Nothing -> error $ "taskid not found: " ++ show taskid+ Nothing -> error $ "taskid not found:" +-+ show taskid Just task -> do when qDebug $ pPrintCompact task case maybeTaskResult task of- Nothing -> error' $ "failed to read task: " ++ show task+ Nothing -> error' $ "failed to read task:" +-+ show task -- FIXME maybe should have way to list parent or children Just _res -> return [task] Build bld -> do@@ -191,17 +207,17 @@ getBuild hub (InfoID (read bld)) else kojiGetBuildTaskID hub bld case mtaskid of- Just (TaskId taskid) -> getTasks tz hub queryopts $ Parent taskid- Nothing -> error' $ "no taskid found for build " ++ bld+ Just (TaskId taskid) -> getTasks tz hub queryopts $ ChildrenOf taskid+ Nothing -> error' $ "no taskid found for build" +-+ bld Package pkg -> do when (head pkg == '-') $- error' $ "bad combination: not a package " ++ pkg+ error' $ "bad combination: not a package" +-+ pkg when (isJust qmDate || isJust qmFilter) $ -- FIXME why not? error' "cannot use package together with timedate or filter" mpkgid <- getPackageID hub pkg case mpkgid of- Nothing -> error' $ "no package id found for " ++ pkg+ Nothing -> error' $ "no package id found for" +-+ pkg Just pkgid -> do builds <- listBuilds hub [("packageID", ValueInt pkgid),@@ -211,8 +227,17 @@ let mtaskid = (fmap TaskId . lookupStruct "task_id") bld case mtaskid of -- FIXME gives too many tasks (parent builds):- Just (TaskId taskid) -> getTasks tz hub queryopts $ Parent taskid+ Just (TaskId taskid) -> getTasks tz hub queryopts {qLimit = Nothing} $ ChildrenOf taskid Nothing -> return []+ ParentOf taskid -> do+ mtask <- kojiGetTaskInfo hub (TaskId taskid)+ case mtask of+ Nothing -> error $ "taskid not found:" +-+ show taskid+ Just task -> do+ when qDebug $ pPrintCompact task+ case lookupStruct "parent" task of+ Nothing -> error' $ "no parent of" +-+ show taskid+ Just tid -> getTasks tz hub queryopts {qLimit = Nothing} $ Task tid Pattern pat -> do let buildquery = [("pattern", ValueString pat), commonBuildQueryOptions qLimit]@@ -223,7 +248,7 @@ forM builds $ \bld -> do let mtaskid = (fmap TaskId . lookupStruct "task_id") bld case mtaskid of- Just (TaskId taskid) -> getTasks tz hub queryopts $ Parent taskid+ Just (TaskId taskid) -> getTasks tz hub (queryopts {qLimit = Nothing}) $ ChildrenOf taskid Nothing -> return [] _ -> do query <- setupQuery@@ -233,7 +258,7 @@ where setupQuery = do case req of- Parent parent ->+ ChildrenOf parent -> return $ ("parent", ValueInt parent) : commonParams _ -> do mdatestring <-@@ -271,11 +296,11 @@ let timedate = getTimedate beforeAfter in case words timedate of [t] | t `elem` ["hour", "day", "week", "month", "year"] ->- "last " ++ t+ "last" +-+ t [t] | t `elem` ["today", "yesterday"] -> t ++ " 00:00" [t] | any (lower t `isPrefixOf`) ["monday", "tuesday", "wednesday", "thursday", "friday", "saturday", "sunday"] ->- "last " ++ t ++ " 00:00"+ "last" +-+ t ++ " 00:00" [n,_unit] | all isDigit n -> timedate ++ " ago" _ -> timedate @@ -285,7 +310,7 @@ -- FIXME option to hide url (take terminal width into consideration?) compactTaskResult :: String -> TimeZone -> TaskResult -> String-compactTaskResult hub tz (TaskResult pkg arch method state _mparent taskid mstart mend) =+compactTaskResult hub tz (TaskResult pkg arch method state _mparent taskid _create mstart mend _mowner) = let time = case mend of Just end -> compactZonedTime tz end@@ -298,8 +323,6 @@ [show state, showPackage pkg ++ if method == "buildArch" then '.' : arch ++ replicate (8 - length arch) ' ' else ' ' : method] ---- FIXME show task owner formatTaskResult :: String -> Maybe UTCTime -> TimeZone -> TaskResult -> [String] formatTaskResult hub #if MIN_VERSION_time(1,9,1)@@ -307,19 +330,21 @@ #else _mtime #endif- tz (TaskResult pkg arch method state mparent taskid mstart mend) =- [ showPackage pkg ++ (if method == "buildArch" then '.' : arch else ' ' : method) +-+ show state- , taskinfoUrl hub taskid +-+ maybe "" (\p -> "(parent: " ++ show p ++ ")") mparent] ++- [formatLocalTime True tz start | Just start <- [mstart]] ++- [formatLocalTime False tz end | Just end <- [mend]]+ tz (TaskResult pkg arch method state mparent taskid create mstart mend mowner) =+ [ showPackage pkg ++ (if method == "buildArch" then '.' : arch else ' ' : method) +-+ show state +-+ maybe "" (\o -> '(' : o ++ ")") mowner+ , taskinfoUrl hub taskid +-+ maybe "" (\p -> "(parent:" +-+ show p ++ ")") mparent+ , formatLocalTime CreateEvent tz create] +++ [formatLocalTime StartEvent tz start | Just start <- [mstart]] +++ [formatLocalTime CompletionEvent tz end | Just end <- [mend]] #if MIN_VERSION_time(1,9,1)- +++ +++ ["delay:" +-+ renderDuration False dur | Just start <- [mstart], let dur = diffUTCTime start create]+ ++ case mtime of Just now ->- ["current duration: " ++ renderDuration False dur | Just start <- [mstart], let dur = diffUTCTime now start]+ ["current duration:" +-+ renderDuration False dur | Just start <- [mstart], let dur = diffUTCTime now start] Nothing ->- ["duration: " ++ renderDuration False dur | Just start <- [mstart], Just end <- [mend], let dur = diffUTCTime end start]-+ ["duration:" +-+ renderDuration False dur | Just start <- [mstart], Just end <- [mend], let dur = diffUTCTime end start] #endif showPackage :: Either String NVR -> String@@ -343,7 +368,7 @@ "assigned" -> TaskAssigned "fail" -> TaskFailed "failed" -> TaskFailed- _ -> error' $! "unknown task state: " ++ s +++ _ -> error' $! "unknown task state:" +-+ s ++ "\nknown states: free, open, closed, canceled, assigned, failed" data LogFile = BuildLog | RootLog | HWInfo@@ -354,7 +379,7 @@ outputUrl :: String -> TaskResult -> OutputLocation -> Maybe String outputUrl hub task loc = case loc of- WorkOutput -> Just $ taskOutputUrl task+ WorkOutput -> Just $ worktaskDirUrlfromTaskID $ taskId task PackagesOutput -> case taskPackage task of Left _ -> Nothing@@ -364,26 +389,23 @@ findOutputURL :: String -> TaskResult -> IO (Maybe String) findOutputURL hub task = case outputUrl hub task PackagesOutput of- Just burl -> urlExistsOr (taskOutputUrl task) $- urlExistsOr burl $ return Nothing- Nothing -> urlExistsOr (taskOutputUrl task) $ return Nothing+ Just burl -> urlMayExist (worktaskDirUrlfromTaskID $ taskId task) <||>+ urlMayExist burl+ Nothing -> urlMayExist (worktaskDirUrlfromTaskID $ taskId task) where- urlExistsOr :: String -> IO (Maybe String) -> IO (Maybe String)- urlExistsOr url alt = do+ urlMayExist :: String -> IO (Maybe String)+ urlMayExist url = do exists <- httpExists' url- if exists- then return $ Just url- else alt--taskOutputUrl :: TaskResult -> String-taskOutputUrl task =- "https://kojipkgs.fedoraproject.org/work/tasks" </> lastFew </> tid- where- tid = show (taskId task)+ return $+ if exists+ then Just url+ else Nothing - lastFew =- let few = dropWhile (== '0') $ takeEnd 4 tid- in if null few then "0" else few+ mact1 <||> mact2 = do+ ma1 <- mact1+ if isJust ma1+ then return ma1+ else mact2 tailLogUrl :: String -> Int -> LogFile -> String tailLogUrl hub taskid file =@@ -394,35 +416,37 @@ logFile BuildLog = "build.log" logFile HWInfo = "hw_info.log" -buildlogSize :: Bool -> Bool -> Bool -> Maybe String -> String -> TaskResult- -> IO ()-buildlogSize _debug tail' hwinfo mgrep hub task = do+buildlogSize :: Bool -> TimeZone -> Bool -> Bool -> Maybe String -> String+ -> TaskResult -> IO ()+buildlogSize _debug tz tail' hwinfo mgrep hub task = do murl <- findOutputURL hub task whenJust murl $ \ url -> do let buildlog = url +/+ logFile BuildLog exists <- httpExists' buildlog if exists then do- putStr $ buildlog ++ " "- msize <- httpFileSize' buildlog- case msize of- Nothing -> putChar '\n'- Just size -> do- fprintLn ("(" % commas % "kB)") (size `div` 1000)- -- FIXME check if short build.log ends with srpm- file <-- if hwinfo+ putStr buildlog+ (msize,mtime) <- httpFileSizeTime' buildlog+ whenJust msize $ \size -> do+ fprint (" (" % commas % "kB)") (size `div` 1000)+ when (taskState task == TaskOpen) $+ whenJust mtime $ \time ->+ putStr $ " (" ++ compactZonedTime tz time ++ ")"+ putChar '\n'+ -- FIXME check if short build.log ends with srpm+ file <-+ if hwinfo+ then do+ putStr $ url +/+ logFile HWInfo+ return HWInfo+ else+ -- for buildroot failure build.log could be ~3082 bytes+ if size < 4000 then do- putStrLn $ url +/+ logFile HWInfo- return HWInfo- else- -- for buildroot failure build.log could be ~3082 bytes- if size < 4000- then do- putStrLn $ url +/+ logFile RootLog- return RootLog- else return BuildLog- when (tail' || hwinfo || isJust mgrep) $ displayLog url file+ putStr $ url +/+ logFile RootLog+ return RootLog+ else return BuildLog+ when (tail' || hwinfo || isJust mgrep) $ displayLog url file else do let rootlog = url +/+ logFile RootLog whenM (httpExists' rootlog) $
src/Time.hs view
@@ -4,9 +4,9 @@ compactZonedTime, TimeEvent(..), lookupTime,- lookupBuildTimes,+ lookupStartEndTimes,+ lookupStartEndTimes', lookupTaskTimes,- strictLookupTimes, durationOfTask, formatLocalTime, renderDuration,@@ -46,39 +46,40 @@ lookupStruct (ev ++ "_time") str >>= parseTimeM False defaultTimeLocale "%Y-%m-%d %H:%M:%S%Q%EZ" -lookupTaskTimes :: Struct -> Maybe (UTCTime, Maybe UTCTime)-lookupTaskTimes str = do- start <- lookupTime CreateEvent str- let mend = lookupTime CompletionEvent str- return (start,mend)+lookupTime' :: TimeEvent -> Struct -> UTCTime+lookupTime' event str =+ case lookupTime event str of+ Nothing -> error $ "no " ++ showEvent event -- for build/task+ Just t -> t -lookupBuildTimes :: Struct -> Maybe (UTCTime, Maybe UTCTime)-lookupBuildTimes str = do+lookupTaskTimes :: Struct -> (UTCTime, Maybe UTCTime, Maybe UTCTime)+lookupTaskTimes str =+ let create = lookupTime' CreateEvent str+ mstart = lookupTime StartEvent str+ mend = lookupTime CompletionEvent str+ in (create,mstart,mend)++lookupStartEndTimes :: Struct -> Maybe (UTCTime, Maybe UTCTime)+lookupStartEndTimes str = do start <- lookupTime StartEvent str let mend = lookupTime CompletionEvent str return (start,mend) -strictLookupTimes :: (Struct -> Maybe (UTCTime, Maybe UTCTime))- -> Struct -> (UTCTime, UTCTime)-strictLookupTimes lf st =- case lf st of- Nothing -> error "no start time" -- for build/task- Just (start,mend) ->- case mend of- Nothing -> error "no end time" -- for build/task- Just end -> (start,end)+lookupStartEndTimes' :: Struct -> (UTCTime, UTCTime)+lookupStartEndTimes' st =+ (lookupTime' StartEvent st, lookupTime' CompletionEvent st) durationOfTask :: Struct -> Maybe NominalDiffTime durationOfTask str = do- (start,mend) <- lookupTaskTimes str+ let (create,_mstart,mend) = lookupTaskTimes str end <- mend- return $ diffUTCTime end start+ return $ diffUTCTime end create -formatLocalTime :: Bool -> TimeZone -> UTCTime -> String-formatLocalTime start tz t =+formatLocalTime :: TimeEvent -> TimeZone -> UTCTime -> String+formatLocalTime event tz t = -- FIXME format time with formatting formatTime defaultTimeLocale- (formatToString (rpadded 11 ' ' string % "%c") (if start then "Created:" else "Completed:")) $+ (formatToString (rpadded 12 ' ' string % "%c") (showEvent event ++ ":")) $ utcToZonedTime tz t renderDuration :: Bool -> NominalDiffTime -> String@@ -95,5 +96,5 @@ hrs = if short then "h" else " hours" #else renderDuration short dur =- show dur ++ if short then "" else "ec"+ show dur ++ if short then "" else "sec" #endif
src/Utils.hs view
@@ -4,12 +4,14 @@ kojiGetBuild', showValue, buildOutputURL,- hubToPkgsURL+ hubToPkgsURL,+ buildlogUrlfromTaskId,+ worktaskDirUrlfromTaskID ) where import Data.List.Extra (dropSuffix, isInfixOf, isPrefixOf, isSuffixOf, replace,- takeWhileEnd)+ takeEnd, takeWhileEnd) import Data.RPM (dropArch) import Data.RPM.NVR import Data.RPM.NVRA@@ -78,3 +80,17 @@ if "kojihub" `isSuffixOf` url then replace "kojihub" "kojifiles" url +/+ "packages" else error' $ "use --files-url to specify kojifiles url for " ++ url++buildlogUrlfromTaskId :: Int -> String+buildlogUrlfromTaskId tid =+ worktaskDirUrlfromTaskID tid +/+ "build.log"++worktaskDirUrlfromTaskID :: Int -> String+worktaskDirUrlfromTaskID tid =+ "https://kojipkgs.fedoraproject.org/work/tasks" +/+ lastFew +/+ taskid+ where+ taskid = show tid++ lastFew =+ let few = dropWhile (== '0') $ takeEnd 4 taskid in+ if null few then "0" else few
test/tests.hs view
@@ -16,7 +16,7 @@ (["builds"], [["-L", "rust"] ,["-l", "3"]- ,["-L", "-p", "rpm-ostree*.fc37"]])+ ,["-L", "-p", "rpm-ostree*.fc40"]]) , (["tasks"], [["-L"]@@ -32,7 +32,7 @@ (["install", "-n", "-y"], [["podman", "-p", "podman"] ++ sysdist ,["-l", "coreutils"] ++ sysdist- ,["-l", "-R", "rpmlint-2.4.0-3.fc37"]+ ,["-l", "-R", "rpmlint-2.5.0-5.fc40"] ,["-H", "https://kojihub.stream.centos.org/kojihub", "-d", "el9", "bash", "-p", "bash"] ,["-H", "stream", "-d", "el9", "kernel", "-x", "kernel-devel*", "-x", "*-debug*"] ,["-l", "-H", "stream", "-d", "el9", "grep"]@@ -49,7 +49,7 @@ ) ] where- sysdist = if havedist then [] else ["-d", "fc37"]+ sysdist = if havedist then [] else ["-d", "fc40"] main :: IO () main = do