diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,9 +1,23 @@ # Version history of koji-tool +# 0.8 (2022-03-02) +- rename 'query' to 'tasks' +- 'tasks': new '--tail' option to fetch and display tail of build.log + (shows root.log instead if build.log is too small) +- 'tasks': extend list of methods and list them in --method help +- new 'builds' query command (replaces 'tasks' builds listing) +- only query print date when option given by user +- --debug now displays query options +- 'tasks' and 'builds' now use --hub like 'install' +- new --mine (self-user) option (instead of defaulting to mine) +- 'tasks' and 'builds' support build NVR pattern search (requires Koji 1.24+) +- 'tasks' and 'builds' have --details option otherwise output is compact + (unless there is a single result) + # 0.7 (2022-01-25) - query: new options: '--package' to search recent builds and '--latest' - query --method: now defaults to buildArch (use 'any' to include all) -- query: now defaults to "--before now" (instead of "--from today 00:00') +- query: now defaults to "--before now" (instead of "--from today 00:00") - query --arch: map i686 to i386 and armv7hl to armhfp - query: do not drop tasks without string request diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,82 +1,184 @@ # koji-tool A CLI UI to the [Koji](https://koji.fedoraproject.org/koji/) buildsystem -with commands to query tasks, install rpms, and check buildlog sizes. +with commands to query builds and tasks, install rpms, +and check buildlog sizes. [Koji](https://pagure.io/koji/) is the RPM package buildsystem used by Fedora, CentOS, and some other projects. -## koji-tool query +By default Fedora Koji is used. +A few illustrative examples: + +`koji-tool tasks --mine --latest --state fail --tail`: +shows details of your last buildArch failure and the tail of the build.log. + +`koji-tool install systemd`: will try to install or update to the newest rpm packages from koji. + +`koji-tool builds --package firefox -L -s complete`: +shows the last successful build with a url and other details. + +## Commands +```shellsession +$ koji-tool --help +Query and track Koji tasks, and install rpms from Koji. + +Usage: koji-tool [--version] COMMAND + see https://github.com/juhp/koji-tool#readme + +Available options: + -h,--help Show this help text + --version Show version + +Available commands: + builds Query Koji builds (by default lists most recent + builds) + tasks Query Koji tasks (by default lists most recent + buildArch tasks) + install Install rpm packages directly from a Koji build task + progress Track running Koji tasks by buildlog size + buildlog-sizes Show buildlog sizes for nvr patterns +``` + +## koji-tool builds + +Query 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. + +### Usage + +By default lists up to 10 Fedora Koji builds. + +```shellsession +$ 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] [-D|--debug] + [(-b|--build BUILD) | (-p|--package PKG) | NVRPATTERN] + Query Koji builds (by default lists most recent builds) + +Available options: + -H,--hub HUB KojiHub shortname or url (HUB = fedora, stream, + rpmfusion, or URL) [default: fedora] + -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] + -s,--state STATE Filter builds by state + (building,complete,deleted,fail(ed),cancel(ed) + -B,--before TIMESTAMP Builds completed before timedate [default: now] + -F,--from TIMESTAMP Builds completed after timedate + -t,--type TYPE Select builds by type: all,image,maven,module,rpm,win + -d,--details Show more details of builds + -D,--debug Pretty-print raw XML result + -b,--build BUILD Show build details + -p,--package PKG Builds of package + -h,--help Show this help text +``` + +Examples: + +```shellsession +$ koji-tool builds --from "last week" -s fail +``` +lists your builds that failed in the last week. + +List builds of a package: +```shellsession +$ koji-tool builds redhat-rpm-config*.fc37 --latest + +redhat-rpm-config-214-1.fc37 BuildComplete +https://koji.fedoraproject.org/koji/buildinfo?buildID=1915968 +https://koji.fedoraproject.org/koji/taskinfo?taskID=82638530 +Start: Thu Feb 10 23:45:28 +08 2022 +End: Thu Feb 10 23:47:32 +08 2022 +duration: 0h 2m 4s +``` + +## koji-tool tasks + Query Koji for tasks. -Somewhat like `koji list-tasks --mine --quiet --all ...`, +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. ### Usage -By default it lists your 10 most recent Fedora Koji buildArch tasks. +By default it lists 10 most recent Fedora Koji buildArch tasks. ```shellsession -$ koji-tool query --help -Usage: koji-tool query [-S|--server URL] [-u|--user USER] - [(-L|--latest) | (-l|--limit INT)] - [(-t|--task TASKID) | (-c|--children TASKID) | - (-b|--build BUILD) | (-p|--package PKG)] - [-s|--state STATE] [-a|--arch ARCH] +$ 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] + [-m|--method METHOD] [-d|--details] [-D|--debug] [(-P|--only-package PKG) | (-N|--only-nvr PREFIX)] - Query Koji tasks (by default lists your tasks today) + [-T|--tail] + [(-t|--task TASKID) | (-c|--children TASKID) | + (-b|--build BUILD) | (-p|--package PKG) | NVRPATTERN] + Query Koji tasks (by default lists most recent buildArch tasks) Available options: - -S,--server URL Koji Hub [default: Fedora] - -u,--user USER Koji user [default: fasid] + -H,--hub HUB KojiHub shortname or url (HUB = fedora, stream, + rpmfusion, or URL) [default: fedora] + -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] - -t,--task TASKID Show task - -c,--children TASKID List child tasks of parent - -b,--build BUILD List child tasks of build - -p,--package PKG Build tasks of package - -s,--state STATE Filter tasks by state (open, close(d), cancel(ed), - fail(ed), assigned, free) + -s,--state STATE Filter tasks by state + (open,close(d),cancel(ed),fail(ed),assigned,free) -a,--arch ARCH Task arch -B,--before TIMESTAMP Tasks completed before timedate [default: now] -F,--from TIMESTAMP Tasks completed after timedate - -m,--method METHOD Select tasks by method: [build,buildarch,etc] or - 'any' (default 'buildArch') + -m,--method METHOD Select tasks by method (default 'buildArch'): + all,appliance,build,buildArch,buildContainer,buildMaven,buildNotification,buildSRPMFromSCM,chainbuild,chainmaven,createAppliance,createContainer,createImage,createLiveCD,createLiveMedia,createdistrepo,createrepo,dependantTask,distRepo,image,indirectionimage,livecd,livemedia,maven,newRepo,rebuildSRPM,runroot,tagBuild,tagNotification,vmExec,waitrepo,winbuild,wrapperRPM + -d,--details Show more details of builds -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 + -T,--tail Fetch the tail of build.log + -t,--task TASKID Show task + -c,--children TASKID List child tasks of parent + -b,--build BUILD List child tasks of build + -p,--package PKG Build tasks of package -h,--help Show this help text ``` Examples: ```shellsession -$ koji-tool query -a aarch64 --from "last week" -s fail +$ koji-tool tasks -a aarch64 --from "last week" -s fail ``` lists your arm64 tasks that failed in the last week. -List kojira tasks from the last hour: +Show latest newRepo task: ```shellsession -$ koji-tool query --from hour -u kojira -completed after 2022-01-13 09:14:41+0800 +$ koji-tool tasks --method newrepo --latest -epel7-infra-mailman newRepo TaskFailed -https://koji.fedoraproject.org/koji/taskinfo?taskID=81172651 -Start: Thu Jan 13 10:12:09 2022 -End: Thu Jan 13 10:14:09 2022 -duration: 0h 2m 0s +module-perl-IO-Socket-SSL-2 newRepo TaskOpen +https://koji.fedoraproject.org/koji/taskinfo?taskID=83561635 +Start: Thu Mar 3 00:57:43 +08 2022 +current duration: 0h 0m 16s ``` -List builds: +List package build tasks: ```shellsession -$ koji-tool query --package redhat-rpm-config --limit 2 -redhat-rpm-config-212-1.eln114 (2022-01-23 12:50:46) -redhat-rpm-config-212-1.fc36 (2022-01-23 11:49:42) +$ koji-tool tasks --package redhat-rpm-config --latest + +redhat-rpm-config-214-1.eln114 noarch TaskClosed +https://koji.fedoraproject.org/koji/taskinfo?taskID=82667980 (parent: 82667916) +Start: Fri Feb 11 15:08:30 +08 2022 +End: Fri Feb 11 15:10:09 +08 2022 +duration: 0h 1m 39s ``` ## koji-tool install @@ -93,8 +195,6 @@ ### Usage -By default it uses Fedora Koji. - ``` $ koji-tool install podman ``` @@ -114,7 +214,7 @@ By default only installed subpackages are downloaded and updated, but the following options change the behavior: -`--package`: select subpackages by name or glob pattern (this doesn't work currently on multiple builds/tasks) +`--package`: select subpackages by name or glob pattern (this doesn't work currently for multiple builds/tasks) `--exclude`: exclude subpackages by name or glob pattern @@ -169,6 +269,7 @@ armhfp 133kB [ 65,244 B/min] ppc64le 493kB [141,598 B/min] TaskClosed s390x 558kB [100,481 B/min] TaskClosed +: ``` The `buildlog-sizes` command is similar but runs once over nvr patterns. diff --git a/koji-tool.cabal b/koji-tool.cabal --- a/koji-tool.cabal +++ b/koji-tool.cabal @@ -1,16 +1,16 @@ name: koji-tool -version: 0.7 +version: 0.8 synopsis: Koji CLI tool for querying tasks and installing builds description: - koji-tool is a CLI interface to Koji with commands to query tasks, - install rpms, and track buildlog sizes. + koji-tool is a CLI interface to Koji with commands to query + builds, tasks, install rpms, and track buildlog sizes. . Koji is the RPM-based buildsystem of Fedora Linux and CentOS. license: BSD3 license-file: LICENSE -author: Jens Petersen -maintainer: Jens Petersen -copyright: 2021-2022 Jens Petersen +author: Jens Petersen +maintainer: Jens Petersen +copyright: 2021-2022 Jens Petersen category: Utility homepage: https://github.com/juhp/koji-tool bug-reports: https://github.com/juhp/koji-tool/issues @@ -31,11 +31,14 @@ executable koji-tool main-is: Main.hs other-modules: Paths_koji_tool + Builds BuildlogSizes + Common DownloadDir Install Progress - Query + Tasks + User hs-source-dirs: src build-depends: base < 5, directory, @@ -43,6 +46,7 @@ filepath, format-numbers, Glob, + http-conduit, http-directory >= 0.1.9, koji >= 0.0.2, pretty-simple, @@ -51,6 +55,7 @@ simple-cmd-args, text, time, + utf8-string, xdg-userdirs if impl(ghc<8.4) build-depends: http-common < 0.8.3.4 diff --git a/src/BuildlogSizes.hs b/src/BuildlogSizes.hs --- a/src/BuildlogSizes.hs +++ b/src/BuildlogSizes.hs @@ -38,23 +38,21 @@ buildlogSizesCmd nvrpat = do if all isDigit nvrpat -- check if taskid (not buildid) then do - mgr <- httpManager - buildlogSizes mgr (read nvrpat) + buildlogSizes (read nvrpat) else do -- find builds results <- listBuilds fedoraKojiHub [("pattern", ValueString nvrpat), ("queryOpts",ValueStruct [("limit",ValueInt 5), ("order",ValueString "-build_id")])] - mgr <- httpManager - mapM_ (getResult mgr) results + mapM_ getResult results where - getResult :: Manager -> Struct -> IO () - getResult mgr bld = do + getResult :: Struct -> IO () + getResult bld = do putStrLn "" case lookupStruct "nvr" bld of Just nvr -> do putStrLn nvr - nvrBuildlogSizes mgr nvr + nvrBuildlogSizes nvr Nothing -> do let mextra = lookupStruct "extra" bld mtid = @@ -62,39 +60,39 @@ (mextra >>= lookupStruct "task_id") case mtid :: Maybe Int of Nothing -> error "no taskid found!" - Just tid -> buildlogSizes mgr tid + Just tid -> buildlogSizes tid -nvrBuildlogSizes :: Manager -> String -> IO () -nvrBuildlogSizes mgr bld = do +nvrBuildlogSizes :: String -> IO () +nvrBuildlogSizes bld = do let (NVR n (VerRel v r)) = readNVR bld logsdir = "https://kojipkgs.fedoraproject.org/packages" +/+ n +/+ v +/+ r +/+ "data/logs/" - archs <- map (T.unpack . noTrailingSlash) <$> httpDirectory mgr logsdir + archs <- map (T.unpack . noTrailingSlash) <$> httpDirectory' logsdir forM_ archs $ \arch -> - doGetBuildlogSize mgr (logsdir +/+ arch +/+ "build.log") arch + doGetBuildlogSize (logsdir +/+ arch +/+ "build.log") arch -buildlogSizes :: Manager -> Int -> IO () -buildlogSizes mgr tid = do +buildlogSizes :: Int -> IO () +buildlogSizes tid = do children <- sortOn (\t -> lookupStruct "arch" t :: Maybe String) <$> getTaskChildren fedoraKojiHub tid True - mapM_ (buildlogSize mgr) children + mapM_ buildlogSize children -buildlogSize :: Manager -> Struct -> IO () -buildlogSize mgr child = do +buildlogSize :: Struct -> IO () +buildlogSize child = do case lookupStruct "id" child :: Maybe Int of Nothing -> error "child taskid not found" Just tid -> do whenJust (lookupStruct "arch" child) $ - doGetBuildlogSize mgr buildlog + 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 -doGetBuildlogSize :: Manager -> String -> String -> IO () -doGetBuildlogSize mgr buildlog arch = do - exists <- httpExists mgr buildlog - msize <- if exists then httpFileSize mgr buildlog else return Nothing +doGetBuildlogSize :: String -> String -> IO () +doGetBuildlogSize buildlog arch = do + exists <- httpExists' buildlog + msize <- if exists then httpFileSize' buildlog else return Nothing whenJust msize $ \ size -> do let kb = kiloBytes size putStrLn $ arch ++ replicate (16 - length arch - length kb) ' ' ++ kb diff --git a/src/Builds.hs b/src/Builds.hs new file mode 100644 --- /dev/null +++ b/src/Builds.hs @@ -0,0 +1,220 @@ +{-# LANGUAGE CPP #-} + +-- SPDX-License-Identifier: BSD-3-Clause + +module Builds ( + BuildReq(..), + buildsCmd, + parseBuildState, + fedoraKojiHub, + kojiBuildTypes + ) +where + +import Control.Monad.Extra + +import Data.Char (isDigit, toUpper) +import Data.List.Extra +import Data.Maybe +#if !MIN_VERSION_base(4,11,0) +import Data.Monoid ((<>)) +#endif +import Data.RPM.NVR +import Data.Time.Clock +import Data.Time.Format +import Data.Time.LocalTime +import Distribution.Koji +import Distribution.Koji.API +import SimpleCmd +import Text.Pretty.Simple + +import Common +import qualified Tasks +import User + +data BuildReq = BuildBuild String | BuildPackage String + | BuildQuery | BuildPattern String + deriving Eq + +getTimedate :: Tasks.BeforeAfter -> String +getTimedate (Tasks.Before s) = s +getTimedate (Tasks.After s) = s + +capitalize :: String -> String +capitalize "" = "" +capitalize (h:t) = toUpper h : t + +buildsCmd :: Maybe String -> Maybe UserOpt -> Int -> [BuildState] + -> Maybe Tasks.BeforeAfter -> Maybe String -> Bool -> Bool + -> BuildReq -> IO () +buildsCmd mhub museropt limit states mdate mtype details debug buildreq = do + let server = maybe fedoraKojiHub hubURL mhub + when (server /= fedoraKojiHub && museropt == Just UserSelf) $ + error' "--mine currently only works with Fedora Koji" + tz <- getCurrentTimeZone + case buildreq of + BuildBuild bld -> do + when (isJust mdate) $ + error' "cannot use buildinfo together with timedate" + let bldinfo = if all isDigit bld + then InfoID (read bld) + else InfoString bld + mbld <- getBuild server bldinfo + whenJust (mbld >>= maybeBuildResult) $ printBuild server tz + BuildPackage pkg -> do + when (head pkg == '-') $ + error' $ "bad combination: not a package: " ++ pkg + when (isJust mdate) $ + error' "cannot use --package together with timedate" + mpkgid <- getPackageID server pkg + case mpkgid of + Nothing -> error' $ "no package id found for " ++ pkg + Just pkgid -> do + let fullquery = ("packageID", ValueInt pkgid):commonQueryOpts + when debug $ print fullquery + builds <- listBuilds server fullquery + when debug $ mapM_ pPrintCompact builds + if details || length builds == 1 + then mapM_ (printBuild server tz) $ mapMaybe maybeBuildResult builds + else mapM_ putStrLn $ mapMaybe (shortBuildResult tz) builds + _ -> do + query <- setupQuery server + let fullquery = query <> commonQueryOpts + when debug $ print fullquery + builds <- listBuilds server fullquery + when debug $ mapM_ pPrintCompact builds + if details || length builds == 1 + then mapM_ (printBuild server tz) $ mapMaybe maybeBuildResult builds + else mapM_ putStrLn $ mapMaybe (shortBuildResult tz) builds + where + shortBuildResult :: TimeZone -> Struct -> Maybe String + shortBuildResult tz bld = do + nvr <- lookupStruct "nvr" bld + state <- readBuildState <$> lookupStruct "state" bld + let date = + case readTime' <$> lookupStruct "completion_ts" bld of + Just t -> compactZonedTime tz t + Nothing -> + case readTime' <$> lookupStruct "start_ts" bld of + Just t -> compactZonedTime tz t + Nothing -> "" + return $ nvr +-+ show state +-+ date + + commonQueryOpts = + [("queryOpts", ValueStruct [("limit",ValueInt limit), + ("order",ValueString "-build_id")])] + + setupQuery server = do + mdatestring <- + case mdate of + Nothing -> return Nothing + Just date -> Just <$> cmd "date" ["+%F %T%z", "--date=" ++ dateString date] + -- FIXME better output including user + whenJust mdatestring $ \date -> + putStrLn $ maybe "" show mdate +-+ date + mowner <- maybeGetKojiUser server museropt + return $ + [("complete" ++ (capitalize . show) date, ValueString datestring) | Just date <- [mdate], Just datestring <- [mdatestring]] + ++ [("userID", ValueInt (getID owner)) | Just owner <- [mowner]] + ++ [("state", ValueArray (map buildStateToValue states)) | notNull states] + ++ [("type", ValueString typ) | Just typ <- [mtype]] + ++ case buildreq of + BuildPattern pat -> [("pattern", ValueString pat)] + _ -> [] + + dateString :: Tasks.BeforeAfter -> String + -- make time refer to past not future + dateString beforeAfter = + let timedate = getTimedate beforeAfter + in case words timedate of + [t] | t `elem` ["hour", "day", "week", "month", "year"] -> + "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" + [n,_unit] | all isDigit n -> timedate ++ " ago" + _ -> timedate + + maybeBuildResult :: Struct -> Maybe BuildResult + maybeBuildResult st = do + start_time <- readTime' <$> lookupStruct "start_ts" st + let mend_time = readTime' <$> lookupStruct "completion_ts" 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 + return $ + BuildResult nvr state buildid mtaskid start_time mend_time + + printBuild :: String -> TimeZone -> BuildResult -> IO () + printBuild server tz task = do + putStrLn "" + let mendtime = mbuildEndTime task + time <- maybe getCurrentTime return mendtime + (mapM_ putStrLn . formatBuildResult server (isJust mendtime) tz) (task {mbuildEndTime = Just time}) + + pPrintCompact = +#if MIN_VERSION_pretty_simple(4,0,0) + pPrintOpt CheckColorTty + (defaultOutputOptionsDarkBg {outputOptionsCompact = True}) +#else + pPrint +#endif + +formatBuildResult :: String -> Bool -> TimeZone -> BuildResult -> [String] +formatBuildResult server ended tz (BuildResult nvr state buildid mtaskid start mendtime) = + -- FIXME any better way? + let weburl = dropSuffix "hub" server + in + [ showNVR nvr +-+ show state + , weburl ++ "/buildinfo?buildID=" ++ show buildid] + ++ [weburl ++ "/taskinfo?taskID=" ++ show taskid | Just taskid <- [mtaskid]] + ++ [formatTime defaultTimeLocale "Start: %c" (utcToZonedTime tz start)] + ++ + case mendtime of + Nothing -> [] + Just end -> + [formatTime defaultTimeLocale "End: %c" (utcToZonedTime tz end) | ended] +#if MIN_VERSION_time(1,9,1) + ++ + let dur = diffUTCTime end start + in [(if not ended then "current " else "") ++ "duration: " ++ formatTime defaultTimeLocale "%Hh %Mm %Ss" dur] +#endif + +-- FIXME +data BuildResult = + BuildResult {_buildNVR :: NVR, + _buildState :: BuildState, + _buildId :: Int, + _mtaskId :: Maybe Int, + _buildStartTime :: UTCTime, + mbuildEndTime :: Maybe UTCTime + } + +#if !MIN_VERSION_koji(0,0,3) +buildStateToValue :: BuildState -> Value +buildStateToValue = ValueInt . fromEnum + +parseBuildState :: String -> BuildState +parseBuildState s = + case lower s of + "building" -> BuildBuilding + "complete" -> BuildComplete + "deleted" -> BuildDeleted + "fail" -> BuildFailed + "failed" -> BuildFailed + "cancel" -> BuildCanceled + "canceled" -> BuildCanceled + _ -> error' $! "unknown task state: " ++ s +#endif + +data LastLog = WholeBuild | BuildTail | RootLog + deriving Eq + +getBuildState :: Struct -> Maybe BuildState +getBuildState st = readBuildState <$> lookup "state" st + +kojiBuildTypes :: [String] +kojiBuildTypes = ["all", "image", "maven", "module", "rpm", "win"] diff --git a/src/Common.hs b/src/Common.hs new file mode 100644 --- /dev/null +++ b/src/Common.hs @@ -0,0 +1,40 @@ +module Common ( + knownHubs, + hubURL, + readTime', + compactZonedTime + ) +where + +import Data.List (isPrefixOf) +import Data.Time.Clock +import Data.Time.Clock.System +import Data.Time.Format +import Data.Time.LocalTime +import Distribution.Koji (fedoraKojiHub) +import SimpleCmd (error') + +-- mbox kojihub is locked +knownHubs :: [String] +knownHubs = ["fedora","stream","rpmfusion", "or URL"] + +hubURL :: String -> String +hubURL "fedora" = fedoraKojiHub +-- later use centosKojiHub +hubURL "stream" = "https://kojihub.stream.centos.org/kojihub" +--hubURL "mbox" = "https://koji.mbox.centos.org/kojihub" +hubURL "rpmfusion" = "https://koji.rpmfusion.org/kojihub" +hubURL "fusion" = "https://koji.rpmfusion.org/kojihub" +hubURL hub = + if "http" `isPrefixOf` hub + then hub + else error' $ "unknown hub: try " ++ show knownHubs + +readTime' :: Double -> UTCTime +readTime' = + let mkSystemTime t = MkSystemTime t 0 + in systemToUTCTime . mkSystemTime .truncate + +compactZonedTime :: TimeZone -> UTCTime -> String +compactZonedTime tz = + formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S%Z" . utcToZonedTime tz diff --git a/src/Install.hs b/src/Install.hs --- a/src/Install.hs +++ b/src/Install.hs @@ -24,24 +24,9 @@ import System.FilePath.Glob import System.IO +import Common import DownloadDir --- mbox kojihub is locked -knownHubs :: [String] -knownHubs = ["fedora","stream","rpmfusion", "or URL"] - -hubURL :: String -> String -hubURL "fedora" = fedoraKojiHub --- later use centosKojiHub -hubURL "stream" = "https://kojihub.stream.centos.org/kojihub" ---hubURL "mbox" = "https://koji.mbox.centos.org/kojihub" -hubURL "rpmfusion" = "https://koji.rpmfusion.org/kojihub" -hubURL "fusion" = "https://koji.rpmfusion.org/kojihub" -hubURL hub = - if "http" `isPrefixOf` hub - then hub - else error' $ "unknown hub: try " ++ show knownHubs - defaultPkgsURL :: String -> String defaultPkgsURL url = case dropSuffix "/" url of @@ -98,8 +83,7 @@ nvrs <- kojiBuildOSBuilds debug huburl listmode latest disttag request pkgbld if listmode then if mode /= PkgsReq [] [] - -- FIXME: - then error' "modes not supported for listing build" + then error' "modes not supported for listing build" -- FIXME else case nvrs of [nvr] -> ([nvr,""] ++) . map (<.> "rpm") . sort . filter (not . debugPkg) <$> kojiGetBuildRPMs huburl nvr _ -> return nvrs @@ -276,7 +260,7 @@ [("packageID", ValueInt pkgid), ("state", ValueInt (fromEnum BuildComplete)), ("queryOpts",ValueStruct - [("limit",ValueInt $ if listmode && not latest || oldkoji then 10 else 1), + [("limit",ValueInt $ if listmode && not latest || oldkoji then 20 else 1), ("order",ValueString "-build_id")])] when debug $ print opts nvrs <- mapMaybe (lookupStruct "nvr") <$> Koji.listBuilds hub opts diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -8,11 +8,13 @@ import SimpleCmd import SimpleCmdArgs +import Builds import BuildlogSizes +import User import Install import qualified Paths_koji_tool import Progress -import Query +import Tasks main :: IO () main = do @@ -23,15 +25,55 @@ "Query and track Koji tasks, and install rpms from Koji." "see https://github.com/juhp/koji-tool#readme" $ subcommands - [ Subcommand "install" + [ Subcommand "builds" + "Query Koji builds (by default lists most recent builds)" $ + buildsCmd + <$> hubOpt + <*> optional userOpt + <*> (flagWith' 1 'L' "latest" "Latest build" <|> + optionalWith auto 'l' "limit" "INT" "Maximum number of builds to show [default: 10]" 10) + <*> 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))) + <*> switchWith 'd' "details" "Show more details of builds" + <*> switchWith 'D' "debug" "Pretty-print raw XML result" + <*> (BuildBuild <$> strOptionWith 'b' "build" "BUILD" "Show build details" + <|> BuildPackage <$> strOptionWith 'p' "package" "PKG" "Builds of package" + <|> BuildPattern <$> strArg "NVRPATTERN" + <|> pure BuildQuery) + + , Subcommand "tasks" + "Query Koji tasks (by default lists most recent buildArch tasks)" $ + tasksCmd + <$> hubOpt + <*> optional userOpt + <*> (flagWith' 1 'L' "latest" "Latest build or task" <|> + optionalWith auto 'l' "limit" "INT" "Maximum number of tasks to show [default: 10]" 10) + <*> many (parseTaskState <$> strOptionWith 's' "state" "STATE" "Filter tasks by state (open,close(d),cancel(ed),fail(ed),assigned,free)") + <*> many (strOptionWith 'a' "arch" "ARCH" "Task arch") + <*> optional (Before <$> strOptionWith 'B' "before" "TIMESTAMP" "Tasks completed before timedate [default: now]" <|> + After <$> strOptionWith 'F' "from" "TIMESTAMP" "Tasks completed after timedate") + <*> (fmap normalizeMethod <$> optional (strOptionWith 'm' "method" "METHOD" ("Select tasks by method (default 'buildArch'): " ++ intercalate "," kojiMethods))) + <*> switchWith 'd' "details" "Show more details of builds" + <*> switchWith 'D' "debug" "Pretty-print raw XML result" + -- FIXME error if integer (eg mistakenly taskid) + <*> optional (TaskPackage <$> strOptionWith 'P' "only-package" "PKG" "Filter task results to specified package" + <|> TaskNVR <$> strOptionWith 'N' "only-nvr" "PREFIX" "Filter task results by NVR prefix") + <*> switchWith 'T' "tail" "Fetch the tail of build.log" + <*> (Task <$> optionWith auto 't' "task" "TASKID" "Show task" + <|> Parent <$> optionWith auto 'c' "children" "TASKID" "List child tasks of parent" + <|> Build <$> strOptionWith 'b' "build" "BUILD" "List child tasks of build" + <|> Package <$> strOptionWith 'p' "package" "PKG" "Build tasks of package" + <|> Pattern <$> strArg "NVRPATTERN" + <|> pure TaskQuery) + + , Subcommand "install" "Install rpm packages directly from a Koji build task" $ installCmd <$> switchWith 'n' "dry-run" "Don't actually download anything" <*> switchWith 'D' "debug" "More detailed output" - <*> optional (strOptionWith 'H' "hub" "HUB" - ("KojiHub shortname or url (HUB = " ++ - intercalate ", " knownHubs ++ - ") [default: fedora]")) + <*> hubOpt <*> optional (strOptionWith 'P' "packages-url" "URL" "KojiFiles packages url [default: Fedora]") <*> switchWith 'l' "list" "List builds" @@ -42,28 +84,6 @@ <|> flagWith ReqName ReqNV 'V' "nv" "Give an N-V instead of package name") <*> some (strArg "PKG|NVR|TASKID...") - , Subcommand "query" - "Query Koji tasks (by default lists your tasks today)" $ - queryCmd - <$> strOptionalWith 'S' "server" "URL" "Koji Hub [default: Fedora]" fedoraKojiHub - <*> optional (strOptionWith 'u' "user" "USER" "Koji user [default: fasid]") - <*> (flagWith' 1 'L' "latest" "Latest build or task" <|> - optionalWith auto 'l' "limit" "INT" "Maximum number of tasks to show [default: 10]" 10) - <*> (Task <$> optionWith auto 't' "task" "TASKID" "Show task" - <|> Parent <$> optionWith auto 'c' "children" "TASKID" "List child tasks of parent" - <|> Build <$> strOptionWith 'b' "build" "BUILD" "List child tasks of build" - <|> Package <$> strOptionWith 'p' "package" "PKG" "Build tasks of package" - <|> pure TaskQuery) - <*> many (parseTaskState <$> strOptionWith 's' "state" "STATE" "Filter tasks by state (open, close(d), cancel(ed), fail(ed), assigned, free)") - <*> many (strOptionWith 'a' "arch" "ARCH" "Task arch") - <*> optional (Before <$> strOptionWith 'B' "before" "TIMESTAMP" "Tasks completed before timedate [default: now]" <|> - After <$> strOptionWith 'F' "from" "TIMESTAMP" "Tasks completed after timedate") - <*> (normalizeMethod <$> optional (strOptionWith 'm' "method" "METHOD" "Select tasks by method: [build,buildarch,etc] or 'any' (default 'buildArch')")) - <*> switchWith 'D' "debug" "Pretty-print raw XML result" - -- FIXME error if integer (eg mistakenly taskid) - <*> optional (TaskPackage <$> strOptionWith 'P' "only-package" "PKG" "Filter task results to specified package" - <|> TaskNVR <$> strOptionWith 'N' "only-nvr" "PREFIX" "Filter task results by NVR prefix") - , Subcommand "progress" "Track running Koji tasks by buildlog size" $ progressCmd @@ -75,6 +95,16 @@ buildlogSizesCmd <$> strArg "NVRPATTERN" ] where + hubOpt = optional (strOptionWith 'H' "hub" "HUB" + ("KojiHub shortname or url (HUB = " ++ + intercalate ", " knownHubs ++ + ") [default: fedora]")) + + userOpt :: Parser UserOpt + userOpt = + User <$> strOptionWith 'u' "user" "USER" "Koji user" + <|> flagWith' UserSelf 'M' "mine" "Your tasks (krb fasid)" + modeOpt :: Parser Mode modeOpt = flagWith' All 'a' "all" "all subpackages" <|> @@ -92,10 +122,14 @@ "" -> error' "empty disttag" (c:_) -> if c == '.' then cs else '.' : cs - normalizeMethod :: Maybe String -> Maybe String - normalizeMethod Nothing = normalizeMethod (Just "buildarch") - normalizeMethod (Just "any") = Nothing - normalizeMethod (Just m) = + normalizeMethod :: String -> String + normalizeMethod m = case elemIndex (lower m) (map lower kojiMethods) of - Just i -> Just $ kojiMethods !! i + Just i -> kojiMethods !! i Nothing -> error' $! "unknown method: " ++ m + + normalizeBuildType :: String -> String + normalizeBuildType m = + case elemIndex (lower m) (map lower kojiBuildTypes) of + Just i -> kojiBuildTypes !! i + Nothing -> error' $! "unknown build type: " ++ m diff --git a/src/Progress.hs b/src/Progress.hs --- a/src/Progress.hs +++ b/src/Progress.hs @@ -47,8 +47,7 @@ else return tids when (null tasks) $ error' "no build tasks found" btasks <- mapM kojiTaskinfoRecursive tasks - mgr <- httpManager - loopBuildTasks waitdelay mgr btasks + loopBuildTasks waitdelay btasks kojiTaskinfoRecursive :: TaskID -> IO BuildTask kojiTaskinfoRecursive tid = do @@ -77,14 +76,14 @@ type TaskInfoSize = (Struct,Maybe Int) type TaskInfoSizes = (Struct,(Maybe Int,Maybe Int)) -loopBuildTasks :: Int -> Manager -> [BuildTask] -> IO () -loopBuildTasks _ _ [] = return () -loopBuildTasks waitdelay mgr bts = do +loopBuildTasks :: Int -> [BuildTask] -> IO () +loopBuildTasks _ [] = return () +loopBuildTasks waitdelay bts = do curs <- filter tasksOpen <$> mapM runProgress bts unless (null curs) $ do threadDelayMinutes waitdelay news <- mapM updateBuildTask curs - loopBuildTasks waitdelay mgr news + loopBuildTasks waitdelay news where threadDelayMinutes :: Int -> IO () threadDelayMinutes m = @@ -108,7 +107,7 @@ maybeVal "failed to read src rpm" getString srpm _ -> error "No src rpm found" logMsg $ nvr ++ " (" ++ displayID tid ++ ")" - sizes <- mapM (buildlogSize mgr) tasks + sizes <- mapM buildlogSize tasks printLogSizes waitdelay sizes let news = map (\(t,(s,_)) -> (t,s)) sizes open = filter (\ (t,_) -> getTaskState t `elem` map Just openTaskStates) news @@ -130,11 +129,11 @@ Nothing -> error' $ "TaskInfo not found for " ++ displayID tid Just new -> return (new,size) -buildlogSize :: Manager -> TaskInfoSize -> IO TaskInfoSizes -buildlogSize mgr (task, old) = do +buildlogSize :: TaskInfoSize -> IO TaskInfoSizes +buildlogSize (task, old) = do exists <- if isJust old then return True - else httpExists mgr buildlog - size <- if exists then httpFileSize mgr buildlog else return Nothing + else httpExists' buildlog + size <- if exists then httpFileSize' buildlog else return Nothing return (task,(fromInteger <$> size,old)) where tid = show $ fromJust (readID' task) diff --git a/src/Query.hs b/src/Query.hs deleted file mode 100644 --- a/src/Query.hs +++ /dev/null @@ -1,353 +0,0 @@ -{-# LANGUAGE CPP #-} - --- SPDX-License-Identifier: BSD-3-Clause - -module Query ( - TaskFilter(..), - TaskReq(..), - BeforeAfter(..), - queryCmd, - parseTaskState, - kojiMethods, - fedoraKojiHub - ) -where - -import Control.Monad.Extra - -import Data.Char (isDigit, toUpper) -import Data.List.Extra -import Data.Maybe -#if !MIN_VERSION_base(4,11,0) -import Data.Monoid ((<>)) -#endif -import Data.RPM.NVR -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Data.Text.Format.Numbers -import Data.Time.Clock -import Data.Time.Format -import Data.Time.LocalTime -import Distribution.Koji -import Distribution.Koji.API -import Network.HTTP.Directory -import SimpleCmd -import System.Directory (findExecutable) -import System.FilePath -import Text.Pretty.Simple - -data TaskReq = Task Int | Parent Int | Build String | Package String - | TaskQuery - -data TaskFilter = TaskPackage String | TaskNVR String - -data BeforeAfter = Before String | After String - -instance Show BeforeAfter where - show (Before _) = "before" - show (After _) = "after" - -getTimedate :: BeforeAfter -> String -getTimedate (Before s) = s -getTimedate (After s) = s - -capitalize :: String -> String -capitalize "" = "" -capitalize (h:t) = toUpper h : t - -queryCmd :: String -> Maybe String -> Int -> TaskReq -> [TaskState] - -> [String] -> Maybe BeforeAfter -> Maybe String -> Bool - -> Maybe TaskFilter -> IO () -queryCmd server muser limit taskreq states archs mdate mmethod debug mfilter' = do - tz <- getCurrentTimeZone - mgr <- httpManager - case taskreq of - Task taskid -> do - when (isJust muser || isJust mdate || isJust mfilter') $ - error' "cannot use --task together with --user, timedate, or filter" - mtask <- kojiGetTaskInfo server (TaskId taskid) - whenJust mtask$ \task -> do - when debug $ pPrintCompact task - whenJust (maybeTaskResult task) $ printTask mgr tz - Build bld -> do - when (isJust mdate || isJust mfilter') $ - error' "cannot use --build together with timedate or filter" - mtaskid <- if all isDigit bld - then ((fmap TaskId . lookupStruct "task_id") =<<) <$> getBuild server (InfoID (read bld)) - else kojiGetBuildTaskID server bld - whenJust mtaskid $ \(TaskId taskid) -> - queryCmd server muser limit (Parent taskid) states archs mdate mmethod debug mfilter' - Package pkg -> do - when (isJust mdate || isJust mfilter') $ - error' "cannot use --package together with timedate or filter" - mpkgid <- getPackageID server pkg - case mpkgid of - Nothing -> error' $ "no package id found for " ++ pkg - Just pkgid -> do - options <- setupQuery - blds <- listBuilds server $ - ("packageID", ValueInt pkgid):options - case blds of - [bld] -> do - case lookupStruct "task_id" bld of - Just taskid -> - queryCmd server muser 10 (Parent taskid) states archs mdate mmethod debug mfilter' - Nothing -> error' "task id not found" - _ -> do - mapM_ putStrLn $ mapMaybe buildResult blds - where - buildResult :: Struct -> Maybe String - buildResult bld = do - nvr <- lookupStruct "nvr" bld - state <- readBuildState <$> lookupStruct "state" bld - date <- lookupStruct "completion_time" bld - return $ nvr ++ - " (" ++ takeWhile (/= '.') date ++ ")" ++ - (if state == BuildComplete then "" else " " ++ show state) - _ -> do - query <- setupQuery - results <- listTasks server query - [("limit",ValueInt limit), ("order", ValueString "-id")] - when debug $ mapM_ pPrintCompact results - (mapM_ (printTask mgr tz) . filterResults . mapMaybe maybeTaskResult) results - where - setupQuery = do - case taskreq of - -- FIXME! - Task _ -> error' "unreachable task request" - Build _ -> error' "unreachable build request" - Package _ -> - return [("queryOpts",ValueStruct [("limit",ValueInt limit), - ("order",ValueString "-build_id")])] - Parent parent -> do - when (isJust muser || isJust mdate || isJust mfilter') $ - error' "cannot use --parent together with --user, timedate, or filter" - return $ - ("parent", ValueInt parent) : commonParams - TaskQuery -> do - date <- cmd "date" ["+%F %T%z", "--date=" ++ dateString mdate] - putStrLn $ "completed " ++ maybe "" (++ " ") mmethod ++ maybe "before" show mdate ++ " " ++ date - user <- - case muser of - Just user -> return user - Nothing -> do - haveKlist <- optionalProgram "klist" - if haveKlist - then do - mkls <- fmap words <$> cmdMaybe "klist" ["-l"] - case mkls of - Nothing -> error "klist failed" - Just kls -> - case find ("@FEDORAPROJECT.ORG" `isSuffixOf`) kls of - Nothing -> error' "Could not determine FAS id from klist" - Just principal -> - return $ dropSuffix "@FEDORAPROJECT.ORG" principal - else error' "Please specify koji user" - mowner <- kojiGetUserID fedoraKojiHub user - case mowner of - Nothing -> error "No owner found" - Just owner -> - return $ - [("owner", ValueInt (getID owner)), - ("complete" ++ maybe "Before" (capitalize . show) mdate, ValueString date)] - ++ commonParams - where - commonParams = - [("decode", ValueBool True)] - ++ [("state", ValueArray (map taskStateToValue states)) | notNull states] - ++ [("arch", ValueArray (map (ValueString . kojiArch) archs)) | notNull archs] - ++ [("method", ValueString method) | Just method <- [mmethod]] - - kojiArch :: String -> String - kojiArch "i686" = "i386" - kojiArch "armv7hl" = "armhfp" - kojiArch a = a - - dateString :: Maybe BeforeAfter -> String - dateString Nothing = "now" - -- make time refer to past not future - dateString (Just beforeAfter) = - let timedate = getTimedate beforeAfter - in case words timedate of - [t] | t `elem` ["hour", "day", "week", "month", "year"] -> - "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" - [n,_unit] | all isDigit n -> timedate ++ " ago" - _ -> timedate - - maybeTaskResult :: Struct -> Maybe TaskResult - maybeTaskResult st = do - arch <- lookupStruct "arch" st - start_time <- readTime' <$> lookupStruct "start_time" st - let mend_time = readTime' <$> lookupStruct "completion_time" st - taskid <- lookupStruct "id" st - method <- lookupStruct "method" st - hostid <- lookupStruct "host_id" st - state <- getTaskState st - request <- lookupStruct "request" st - let package = - case (getString . head) request of - Nothing -> Left $ unwords $ map showValue $ take 2 request - Just req -> - let file = takeFileName req - in if ".src.rpm" `isSuffixOf` file - then Right $ readNVR $ removeSuffix ".src.rpm" file - else Left $ takeBaseName file - mparent' = lookupStruct "parent" st :: Maybe Int - return $ - TaskResult package arch method hostid state mparent' taskid start_time mend_time - where - readTime' :: String -> UTCTime - readTime' = read . replace "+00:00" "Z" - - showValue :: Value -> String - showValue (ValueString cs) = cs - showValue (ValueInt i) = show i - showValue val = show val - - filterResults :: [TaskResult] -> [TaskResult] - filterResults ts = - case mfilter' of - Nothing -> ts - Just (TaskPackage pkg) -> - filter (isPackage pkg . taskPackage) ts - Just (TaskNVR nvr) -> - filter (isNVR nvr . taskPackage) ts - where - isPackage pkg (Left p) = takeBaseName p == pkg - isPackage pkg (Right (NVR n _)) = n == pkg - - isNVR _ (Left _) = False - isNVR nvr (Right nvr') = nvr `isPrefixOf` showNVR nvr' - - printTask :: Manager -> TimeZone -> TaskResult -> IO () - printTask mgr tz task = do - putStrLn "" - let mendtime = mtaskEndTime task - time <- maybe getCurrentTime return mendtime - (mapM_ putStrLn . formatTaskResult (isJust mendtime) tz) (task {mtaskEndTime = Just time}) - buildlogSize mgr (taskId task) - - pPrintCompact = -#if MIN_VERSION_pretty_simple(4,0,0) - pPrintOpt CheckColorTty - (defaultOutputOptionsDarkBg {outputOptionsCompact = True}) -#else - pPrint -#endif - -formatTaskResult :: Bool -> TimeZone -> TaskResult -> [String] -formatTaskResult ended tz (TaskResult pkg arch method _hostid state mparent taskid start mendtime) = - [ showPackage pkg +-+ (if method == "buildArch" then arch else method) +-+ show state - , "https://koji.fedoraproject.org/koji/taskinfo?taskID=" ++ show taskid +-+ maybe "" (\p -> "(parent: " ++ show p ++ ")") mparent - , formatTime defaultTimeLocale "Start: %c" (utcToLocalTime tz start) - ] - ++ - case mendtime of - Nothing -> [] - Just end -> - [formatTime defaultTimeLocale "End: %c" (utcToLocalTime tz end) | ended] -#if MIN_VERSION_time(1,9,1) - ++ - let dur = diffUTCTime end start - in [(if not ended then "current " else "") ++ "duration: " ++ formatTime defaultTimeLocale "%Hh %Mm %Ss" dur] -#endif - where - showPackage :: Either String NVR -> String - showPackage (Left p) = p - showPackage (Right nvr) = showNVR nvr - -data TaskResult = - TaskResult {taskPackage :: Either String NVR, - _taskArch :: String, - _taskMethod :: String, - _taskHostId :: Int, - _taskState :: TaskState, - _mtaskParent :: Maybe Int, - taskId :: Int, - _taskStartTime :: UTCTime, - mtaskEndTime :: Maybe UTCTime - } - -#if !MIN_VERSION_koji(0,0,3) -taskStateToValue :: TaskState -> Value -taskStateToValue = ValueInt . fromEnum - -parseTaskState :: String -> TaskState -parseTaskState s = - case lower s of - "free" -> TaskFree - "open" -> TaskOpen - "close" -> TaskClosed - "closed" -> TaskClosed - "cancel" -> TaskCanceled - "canceled" -> TaskCanceled - "assigned" -> TaskAssigned - "fail" -> TaskFailed - "failed" -> TaskFailed - _ -> error' $! "unknown task state: " ++ s -#endif - -buildlogSize :: Manager -> Int -> IO () -buildlogSize mgr taskid = do - exists <- httpExists mgr buildlog - when exists $ do - putStr $ buildlog ++ " " - msize <- httpFileSize mgr buildlog - whenJust msize $ \size -> do - putStr "(" - (T.putStr . kiloBytes) size - putStrLn ")" - -- FIXME if too small show root.log url instead - putStrLn logtail - where - tid = show taskid - - buildlog = "https://kojipkgs.fedoraproject.org/work/tasks" lastFew tid "build.log" - - lastFew = - let few = dropWhile (== '0') $ drop 4 tid in - if null few then "0" else few - - kiloBytes s = prettyI (Just ',') (fromInteger s `div` 1000) <> T.pack "kB" - - logtail = "https://koji.fedoraproject.org/koji/getfile?taskID=" ++ tid ++ "&name=build.log&offset=-4000" - -kojiMethods :: [String] -kojiMethods = - ["build", - "buildSRPMFromSCM", - "rebuildSRPM", - "buildArch", - "chainbuild", - "maven", - "buildMaven", - "chainmaven", - "wrapperRPM", - "winbuild", - "vmExec", - "waitrepo", - "tagBuild", - "newRepo", - "createrepo", - "distRepo", - "createdistrepo", - "buildNotification", - "tagNotification", - "dependantTask", - "livecd", - "createLiveCD", - "appliance", - "createAppliance", - "image", - "indirectionimage", - "createImage", - "livemedia", - "createLiveMedia"] - -optionalProgram :: String -> IO Bool -optionalProgram c = - isJust <$> findExecutable c diff --git a/src/Tasks.hs b/src/Tasks.hs new file mode 100644 --- /dev/null +++ b/src/Tasks.hs @@ -0,0 +1,417 @@ +{-# LANGUAGE CPP #-} + +-- SPDX-License-Identifier: BSD-3-Clause + +module Tasks ( + TaskFilter(..), + TaskReq(..), + BeforeAfter(..), + tasksCmd, + parseTaskState, + kojiMethods, + fedoraKojiHub + ) +where + +import Control.Monad.Extra +import qualified Data.ByteString.Lazy.UTF8 as U +import Data.Char (isDigit, toUpper) +import Data.List.Extra +import Data.Maybe +#if !MIN_VERSION_base(4,11,0) +import Data.Monoid ((<>)) +#endif +import Data.RPM.NVR +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Data.Text.Format.Numbers +import Data.Time.Clock +import Data.Time.Format +import Data.Time.LocalTime +import Distribution.Koji +import Distribution.Koji.API +import Network.HTTP.Directory +import Network.HTTP.Simple +import SimpleCmd +import System.FilePath +import Text.Pretty.Simple + +import Common +import User + +data TaskReq = Task Int | Parent Int | Build String | Package String + | TaskQuery | Pattern String + +data TaskFilter = TaskPackage String | TaskNVR String + +data BeforeAfter = Before String | After String + +instance Show BeforeAfter where + show (Before _) = "before" + show (After _) = "after" + +getTimedate :: BeforeAfter -> String +getTimedate (Before s) = s +getTimedate (After s) = s + +capitalize :: String -> String +capitalize "" = "" +capitalize (h:t) = toUpper h : t + +-- FIXME short output summary +tasksCmd :: Maybe String -> Maybe UserOpt -> Int -> [TaskState] + -> [String] -> Maybe BeforeAfter -> Maybe String -> Bool -> Bool + -> Maybe TaskFilter -> Bool -> TaskReq -> IO () +tasksCmd mhub museropt limit states archs mdate mmethod details debug mfilter' tail' taskreq = do + let server = maybe fedoraKojiHub hubURL mhub + when (server /= fedoraKojiHub && museropt == Just UserSelf) $ + error' "--mine currently only works with Fedora Koji" + tz <- getCurrentTimeZone + case taskreq of + Task taskid -> do + when (isJust museropt || isJust mdate || isJust mfilter') $ + error' "cannot use --task together with --user, timedate, or filter" + mtask <- kojiGetTaskInfo server (TaskId taskid) + whenJust mtask$ \task -> do + when debug $ pPrintCompact task + whenJust (maybeTaskResult task) $ printTask True tz + Build bld -> do + when (isJust mdate || isJust mfilter') $ + error' "cannot use --build together with timedate or filter" + mtaskid <- if all isDigit bld + then ((fmap TaskId . lookupStruct "task_id") =<<) <$> getBuild server (InfoID (read bld)) + else kojiGetBuildTaskID server bld + whenJust mtaskid $ \(TaskId taskid) -> + tasksCmd (Just server) museropt limit states archs mdate mmethod details debug mfilter' tail' (Parent taskid) + Package pkg -> do + when (head pkg == '-') $ + error' $ "bad combination: not a package " ++ pkg + when (isJust mdate || isJust mfilter') $ + error' "cannot use --package together with timedate or filter" + mpkgid <- getPackageID server pkg + case mpkgid of + Nothing -> error' $ "no package id found for " ++ pkg + Just pkgid -> do + builds <- listBuilds server $ + ("packageID", ValueInt pkgid):buildQueryOpts + forM_ builds $ \bld -> do + let mtaskid = (fmap TaskId . lookupStruct "task_id") bld + whenJust mtaskid $ \(TaskId taskid) -> + tasksCmd (Just server) museropt 10 states archs mdate mmethod details debug mfilter' tail' (Parent taskid) + Pattern pat -> do + let buildquery = ("pattern", ValueString pat):buildQueryOpts + when debug $ print buildquery + builds <- listBuilds server buildquery + when debug $ print builds + forM_ builds $ \bld -> do + let mtaskid = (fmap TaskId . lookupStruct "task_id") bld + whenJust mtaskid $ \(TaskId taskid) -> + tasksCmd (Just server) museropt 10 states archs mdate mmethod details debug mfilter' tail' (Parent taskid) + _ -> do + query <- setupQuery server + let queryopts = [("limit",ValueInt limit), ("order", ValueString "-id")] + when debug $ print $ query ++ queryopts + tasks <- listTasks server query queryopts + when debug $ mapM_ pPrintCompact tasks + let detailed = details || length tasks == 1 + (mapM_ (printTask detailed tz) . filterResults . mapMaybe maybeTaskResult) tasks + where + buildQueryOpts = + [("queryOpts",ValueStruct [("limit",ValueInt limit), + ("order",ValueString "-build_id")])] + + setupQuery server = do + case taskreq of + Parent parent -> + return $ ("parent", ValueInt parent) : commonParams + _ -> do + mdatestring <- + case mdate of + Nothing -> return Nothing + Just date -> Just <$> cmd "date" ["+%F %T%z", "--date=" ++ dateString date] + when (isNothing mmethod) $ + warning $ "buildArch tasks" ++ + if details || limit == 1 then "" else "\n" + whenJust mdatestring $ \date -> + warning $ maybe "" show mdate +-+ date + mowner <- maybeGetKojiUser server museropt + return $ + [("owner", ValueInt (getID owner)) | Just owner <- [mowner]] ++ + [("complete" ++ (capitalize . show) date, ValueString datestring) | Just date <- [mdate], Just datestring <- [mdatestring]] ++ + commonParams + where + commonParams = + [("decode", ValueBool True)] + ++ [("state", ValueArray (map taskStateToValue states)) | notNull states] + ++ [("arch", ValueArray (map (ValueString . kojiArch) archs)) | notNull archs] + ++ [("method", ValueString method) | let method = fromMaybe "buildArch" mmethod] + + kojiArch :: String -> String + kojiArch "i686" = "i386" + kojiArch "armv7hl" = "armhfp" + kojiArch a = a + + dateString :: BeforeAfter -> String + -- make time refer to past not future + dateString beforeAfter = + let timedate = getTimedate beforeAfter + in case words timedate of + [t] | t `elem` ["hour", "day", "week", "month", "year"] -> + "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" + [n,_unit] | all isDigit n -> timedate ++ " ago" + _ -> timedate + + maybeTaskResult :: Struct -> Maybe TaskResult + maybeTaskResult st = do + arch <- lookupStruct "arch" st + let mstart_time = readTime' <$> lookupStruct "start_ts" st + mend_time = readTime' <$> lookupStruct "completion_ts" st + taskid <- lookupStruct "id" st + method <- lookupStruct "method" st + state <- getTaskState st + request <- lookupStruct "request" st + let package = + case (getString . head) request of + Nothing -> Left $ unwords $ map showValue $ take 2 request + Just req -> + let file = takeFileName req + in if ".src.rpm" `isSuffixOf` file + then Right $ readNVR $ removeSuffix ".src.rpm" file + else Left $ takeBaseName file + mparent' = lookupStruct "parent" st :: Maybe Int + return $ + TaskResult package arch method state mparent' taskid mstart_time mend_time + where + showValue :: Value -> String + showValue (ValueString cs) = cs + showValue (ValueInt i) = show i + showValue val = show val + + filterResults :: [TaskResult] -> [TaskResult] + filterResults ts = + case mfilter' of + Nothing -> ts + Just (TaskPackage pkg) -> + filter (isPackage pkg . taskPackage) ts + Just (TaskNVR nvr) -> + filter (isNVR nvr . taskPackage) ts + where + isPackage pkg (Left p) = takeBaseName p == pkg + isPackage pkg (Right (NVR n _)) = n == pkg + + isNVR _ (Left _) = False + isNVR nvr (Right nvr') = nvr `isPrefixOf` showNVR nvr' + + printTask :: Bool -> TimeZone -> TaskResult -> IO () + printTask detailed tz task = do + let mendtime = mtaskEndTime task + mtime <- if isNothing mendtime + then Just <$> getCurrentTime + else return Nothing + if detailed + then do + putStrLn "" + (mapM_ putStrLn . formatTaskResult mtime tz) task + buildlogSize tail' (taskId task) + else + (putStrLn . compactTaskResult tz) task + + pPrintCompact = +#if MIN_VERSION_pretty_simple(4,0,0) + pPrintOpt CheckColorTty + (defaultOutputOptionsDarkBg {outputOptionsCompact = True}) +#else + pPrint +#endif + +compactTaskResult :: TimeZone -> TaskResult -> String +compactTaskResult tz (TaskResult pkg arch method state _mparent taskid mstart mend) = + let time = + case mend of + Just end -> compactZonedTime tz end + Nothing -> maybe "" (compactZonedTime tz) mstart + in + showPackage pkg +-+ (if method == "buildArch" then arch else method) +-+ + "(" ++ show taskid ++ ")" +-+ show state +-+ time + +-- FIXME show task owner +formatTaskResult :: Maybe UTCTime -> TimeZone -> TaskResult -> [String] +formatTaskResult mtime tz (TaskResult pkg arch method state mparent taskid mstart mend) = + [ showPackage pkg +-+ (if method == "buildArch" then arch else method) +-+ show state + , "https://koji.fedoraproject.org/koji/taskinfo?taskID=" ++ show taskid +-+ maybe "" (\p -> "(parent: " ++ show p ++ ")") mparent] ++ + [formatTime defaultTimeLocale "Start: %c" (utcToZonedTime tz start) | Just start <- [mstart]] ++ + [formatTime defaultTimeLocale "End: %c" (utcToZonedTime tz end) | Just end <- [mend]] +#if MIN_VERSION_time(1,9,1) + ++ + case mtime of + Just now -> + ["current duration: " ++ formatTime defaultTimeLocale "%Hh %Mm %Ss" dur | Just start <- [mstart], let dur = diffUTCTime now start] + Nothing -> + ["duration: " ++ formatTime defaultTimeLocale "%Hh %Mm %Ss" dur | Just start <- [mstart], Just end <- [mend], let dur = diffUTCTime end start] + +#endif + +showPackage :: Either String NVR -> String +showPackage (Left p) = p +showPackage (Right nvr) = showNVR nvr + +data TaskResult = + TaskResult {taskPackage :: Either String NVR, + _taskArch :: String, + _taskMethod :: String, + _taskState :: TaskState, + _mtaskParent :: Maybe Int, + taskId :: Int, + _mtaskStartTime :: Maybe UTCTime, + mtaskEndTime :: Maybe UTCTime + } + +#if !MIN_VERSION_koji(0,0,3) +taskStateToValue :: TaskState -> Value +taskStateToValue = ValueInt . fromEnum + +parseTaskState :: String -> TaskState +parseTaskState s = + case lower s of + "free" -> TaskFree + "open" -> TaskOpen + "close" -> TaskClosed + "closed" -> TaskClosed + "cancel" -> TaskCanceled + "canceled" -> TaskCanceled + "assigned" -> TaskAssigned + "fail" -> TaskFailed + "failed" -> TaskFailed + _ -> error' $! "unknown task state: " ++ s +#endif + +data LastLog = WholeBuild | BuildTail | RootLog + deriving Eq + +logUrl :: Int -> LastLog -> String +logUrl taskid lastlog = + if lastlog == BuildTail + then "https://koji.fedoraproject.org/koji/getfile?taskID=" ++ tid ++ "&name=build.log&offset=-4000" + else "https://kojipkgs.fedoraproject.org/work/tasks" lastFew tid logName <.> "log" + where + tid = show taskid + + lastFew = + let few = dropWhile (== '0') $ takeEnd 4 tid + in if null few then "0" else few + + logName = if lastlog == RootLog then "root" else "build" + +buildlogSize :: Bool -> Int -> IO () +buildlogSize tail' taskid = do + let buildlog = logUrl taskid WholeBuild + exists <- httpExists' buildlog + when exists $ do + putStr $ buildlog ++ " " + msize <- httpFileSize' buildlog + whenJust msize $ \size -> do + putStr "(" + (T.putStr . kiloBytes) size + putStrLn ")" + -- FIXME check if short build.log ends with srpm + lastlog <- + if size < 1500 + then do + putStrLn $ logUrl taskid RootLog + return RootLog + else return BuildTail + when tail' $ + displayLog taskid lastlog + where + kiloBytes s = prettyI (Just ',') (fromInteger s `div` 1000) <> T.pack "kB" + +kojiMethods :: [String] +kojiMethods = + nub . sort $ + -- www/kojiweb/index.py _TASKS + (["build", + "buildSRPMFromSCM", + "rebuildSRPM", + "buildArch", + "chainbuild", + "maven", + "buildMaven", + "chainmaven", + "wrapperRPM", + "winbuild", + "vmExec", + "waitrepo", + "tagBuild", + "newRepo", + "createrepo", + "distRepo", + "createdistrepo", + "buildNotification", + "tagNotification", + "dependantTask", + "livecd", + "createLiveCD", + "appliance", + "createAppliance", + "image", + "indirectionimage", + "createImage", + "livemedia", + "createLiveMedia", + "buildContainer"] + ++ + -- https://koji.fedoraproject.org/koji/tasks + ["all", + "appliance", + "build", + "buildArch", + "buildContainer", + "buildNotification", + "buildSRPMFromSCM", + "chainbuild", + "chainmaven", + "createAppliance", + "createContainer", + "createImage", + "createLiveCD", + "createLiveMedia", + "createdistrepo", + "createrepo", + "dependantTask", + "distRepo", + "image", + "indirectionimage", + "livecd", + "livemedia", + "newRepo", + "rebuildSRPM", + "runroot", + "tagBuild", + "tagNotification", + "waitrepo"]) + +displayLog :: Int -> LastLog -> IO () +displayLog tid lastlog = do + req <- parseRequest $ logUrl tid lastlog + resp <- httpLBS req + let out = U.toString $ getResponseBody resp + ls = lines out + putStrLn "" + if lastlog == RootLog + then + let excluded = ["Executing command:", "Child return code was: 0", + "child environment: None", "ensuring that dir exists:", + "touching file:", "creating dir:", "kill orphans"] + in putStr $ unlines $ map (dropPrefix "DEBUG ") $ takeEnd 30 $ + filter (\l -> not (any (`isInfixOf` l) excluded)) ls + else + if last ls == "Child return code was: 0" + then putStr out + else do + let err = "Child return code was: 1" + putStr $ unlines $ takeWhile (err /=) ls + putStrLn err diff --git a/src/User.hs b/src/User.hs new file mode 100644 --- /dev/null +++ b/src/User.hs @@ -0,0 +1,41 @@ +module User ( + UserOpt(..), + maybeGetKojiUser + ) +where + +import Control.Monad +import Data.List.Extra +import Data.Maybe +import Distribution.Koji +import System.Directory (findExecutable) +import SimpleCmd + +data UserOpt = User String | UserSelf + deriving Eq + +maybeGetKojiUser :: String -> Maybe UserOpt -> IO (Maybe UserID) +maybeGetKojiUser _server Nothing = return Nothing +maybeGetKojiUser server (Just useropt) = do + user <- + case useropt of + User user -> return user + UserSelf | server == fedoraKojiHub -> do + mKlist <- findExecutable "klist" + if isJust mKlist + then do + mkls <- fmap words <$> cmdMaybe "klist" ["-l"] + case mkls of + Nothing -> error "klist failed" + Just kls -> + case find ("@FEDORAPROJECT.ORG" `isSuffixOf`) kls of + Nothing -> error' "Could not determine FAS id from klist" + Just principal -> do + let user = dropSuffix "@FEDORAPROJECT.ORG" principal + putStrLn $ "user" +-+ user + return user + else error' "Cannot determine Koji user: kerberos klist not installed - try --user" + _ -> error' $ "Do not know how to determine Koji user for " ++ server + muserid <- kojiGetUserID server user + when (isNothing muserid) $ warning "userid not found" + return muserid diff --git a/test/tests.hs b/test/tests.hs --- a/test/tests.hs +++ b/test/tests.hs @@ -1,21 +1,37 @@ import SimpleCmd import System.IO -program :: [String] -> IO () -program args = - putStrLn "" >> - cmdLog "koji-tool" ("install" : "-n" : args) +program :: ([String], [[String]]) -> IO () +program (c, argsv) = + putStrLn ("\n# " ++ head c) >> + mapM_ run argsv + where + run args = do + putStrLn "" + cmdLog "koji-tool" (c ++ args) -tests :: Bool -> [[String]] +tests :: Bool -> [([String], [[String]])] tests havedist = - [["podman", "-p", "podman"] ++ sysdist - ,["-l", "coreutils"] ++ sysdist - ,["-l", "-R", "rpmlint-2.2.0-1.fc36"] - ,["-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"] - ,["-H", "rpmfusion", "ffmpeg", "-p", "ffmpeg", "-p", "ffmpeg-libs"] ++ sysdist - ,["-l", "-H", "rpmfusion", "ffmpeg"] ++ sysdist + [ + (["install", "-n"], + [["podman", "-p", "podman"] ++ sysdist + ,["-l", "coreutils"] ++ sysdist + ,["-l", "-R", "rpmlint-2.2.0-1.fc36"] + ,["-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"] + ,["-H", "rpmfusion", "ffmpeg", "-p", "ffmpeg", "-p", "ffmpeg-libs"] ++ sysdist + ,["-l", "-H", "rpmfusion", "ffmpeg"] ++ sysdist]) + , + (["builds"], + [["-L", "-p", "rust"] + ,["-l", "3"] + ,["-L", "rpm-ostree*.fc36"]]) + , + (["tasks"], + [["-L"] + ,["-l", "3"] + ,["-L", "-p", "rpm-ostree"]]) ] where sysdist = if havedist then [] else ["-d", "fc35"]