koji-tool 0.7 → 0.8
raw patch · 13 files changed
+1013/−497 lines, 13 filesdep +http-conduitdep +utf8-string
Dependencies added: http-conduit, utf8-string
Files
- ChangeLog.md +15/−1
- README.md +139/−38
- koji-tool.cabal +12/−7
- src/BuildlogSizes.hs +20/−22
- src/Builds.hs +220/−0
- src/Common.hs +40/−0
- src/Install.hs +3/−19
- src/Main.hs +67/−33
- src/Progress.hs +10/−11
- src/Query.hs +0/−353
- src/Tasks.hs +417/−0
- src/User.hs +41/−0
- test/tests.hs +29/−13
ChangeLog.md view
@@ -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
README.md view
@@ -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.
koji-tool.cabal view
@@ -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 <juhpetersen@gmail.com>-maintainer: Jens Petersen <juhpetersen@gmail.com>-copyright: 2021-2022 Jens Petersen <juhpetersen@gmail.com>+author: Jens Petersen <petersen@redhat.com>+maintainer: Jens Petersen <petersen@redhat.com>+copyright: 2021-2022 Jens Petersen <petersen@redhat.com> 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
src/BuildlogSizes.hs view
@@ -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
+ src/Builds.hs view
@@ -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"]
+ src/Common.hs view
@@ -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
src/Install.hs view
@@ -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
src/Main.hs view
@@ -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
src/Progress.hs view
@@ -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)
− src/Query.hs
@@ -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
+ src/Tasks.hs view
@@ -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
+ src/User.hs view
@@ -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
test/tests.hs view
@@ -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"]