koji-tool (empty) → 0.6
raw patch · 11 files changed
+1532/−0 lines, 11 filesdep +Globdep +basedep +directory
Dependencies added: Glob, base, directory, extra, filepath, format-numbers, http-common, http-directory, koji, pretty-simple, rpm-nvr, simple-cmd, simple-cmd-args, text, time, xdg-userdirs
Files
- ChangeLog.md +44/−0
- LICENSE +30/−0
- README.md +173/−0
- koji-tool.cabal +83/−0
- src/BuildlogSizes.hs +114/−0
- src/DownloadDir.hs +43/−0
- src/Install.hs +401/−0
- src/Main.hs +96/−0
- src/Progress.hs +208/−0
- src/Query.hs +309/−0
- test/tests.hs +31/−0
+ ChangeLog.md view
@@ -0,0 +1,44 @@+# Version history of koji-tool++## 0.6 (2022-01-13)+- renamed from koji-install to koji-tool, which combines koji-query and koji-progress+- subcommands are 'install', 'query', 'progress', and 'buildlog-sizes'+- 'query' now has separate before/after options: --before and --from+- 'query' now defaults to '--from 00:00' and supports days of week & today/yesterday timedates+- 'query' now limits to 10 results by default in descending order+- 'install' now uses a single curl invocation to download multiple rpms++# Release history for koji-install++## 0.5 (2021-12-27)+- --package and --exclude filters can now be combined+- --package and --exclude now also check subpackage names without base prefix++## 0.4 (2021-12-20)+- support installing/listing by koji taskid+- select subpackages with --package and --exclude, by name or globbing+- check remote files date/size with http-directory+- listing a task either lists the task's children or rpms+- use dnf reinstall for installed packages and otherwise localinstall+- more detailed debug output+- system arch no longer hardcoded to x86_64++## 0.3 (2021-12-03)+- add `--list` command to list recent builds+- fix bug in generating kojifiles url from short name+- workarounds for rpmfusion's older koji not supporting patterns+- check if %dist is defined++## 0.2.0 (2021-12-03)+- initial Hackage release+- `--hub` to select hub+- `--pkgsurl` to override kojifiles url+- override `--disttag`+- select specific build with `--nvr` or `--nv`+- `--debug` output++## 0.1.0 (2021-08-12)+- pre-release on copr+- initial options:+ --all/--ask/--base-only/--exclude-devel --dry-run+- only supports Fedora Koji
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2021, Jens Petersen++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Jens Petersen nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,173 @@+# 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.++[Koji](https://pagure.io/koji/) is the RPM package buildsystem used by+Fedora, CentOS, and some other projects.++## koji-tool query++Query Koji for tasks.++Similar to `koji list-tasks --mine --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 results by package.++### Usage++By default it lists your Fedora Koji tasks from today.++```shellsession+$ koji-tool query --help+Usage: koji-tool query [-S|--server URL] [-u|--user USER] [-l|--limit INT]+ [(-t|--task TASKID) | (-c|--children TASKID) |+ (-b|--build BUILD)] [-s|--state STATE] [-a|--arch ARCH]+ [(-B|--before TIMESTAMP) | (-F|--from TIMESTAMP)]+ [-m|--method METHOD] [-D|--debug]+ [(-p|--package PKG) | (-n|--nvr PREFIX)]+ Query Koji tasks (by default lists your tasks today)++Available options:+ -S,--server URL Koji Hub [default: Fedora]+ -u,--user USER Koji user [default: fasid]+ -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+ -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+ -F,--from TIMESTAMP Tasks completed after timedate [default: today]+ -m,--method METHOD Select tasks by method: [build,buildarch,etc]+ -D,--debug Pretty-pretty raw XML result+ -p,--package PKG Filter results to specified package+ -n,--nvr PREFIX Filter results by NVR prefix+ -h,--help Show this help text+```++Example:++```shellsession+$ koji-tool query -a aarch64 --from "last week" -s fail+```+lists your arm64 tasks that failed in the last week.++List kojira tasks from the last hour:+```shellsession+$ koji-tool query --from hour -u kojira+completed after 2022-01-13 09:14:41+0800++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+```++## koji-tool install++Download and install rpms from a Koji build or task.++By default it only downloads binaries of already-installed subpackages,+but there are options to list and select or exclude specific subpackages.++Note this command is intended for development and testing purposes+and should not be necessary/used normally on production systems,+but it can be very helpful for quickly testing an specific package build or+update.++### Usage++By default it uses Fedora Koji.++```+$ koji-tool install podman+```+will download the latest build for your Fedora version,+and try to install it.+Use `--disttag` suffix to select a different Fedora version.++```+$ koji-tool install TASKID --exclude "*-devel"+```+will install all the non-devel subpackages from the task.++One can use `--hub` to specify a different Koji hub build service.++#### Selecting subpackages++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)++`--exclude`: exclude subpackages by name or glob pattern++`--all`: install all subpackages++`--ask`: ask about each subpackage++### Help+```shellsession+$ koji-tool install --help+Usage: koji-tool install [-n|--dry-run] [-D|--debug] [-H|--hub HUB]+ [-P|--packages-url URL] [-l|--list]+ [(-a|--all) | (-A|--ask) | [-p|--package SUBPKG]+ [-x|--exclude SUBPKG]] [-d|--disttag DISTTAG]+ [(-R|--nvr) | (-V|--nv)] PKG|NVR|TASKID...+ Install rpm packages directly from a Koji build task++Available options:+ -n,--dry-run Don't actually download anything+ -D,--debug More detailed output+ -H,--hub HUB KojiHub shortname or url (HUB = fedora, stream,+ rpmfusion, or URL) [default: fedora]+ -P,--packages-url URL KojiFiles packages url [default: Fedora]+ -l,--list List builds+ -a,--all all subpackages+ -A,--ask ask for each subpackge [default if not installed]+ -p,--package SUBPKG Subpackage (glob) to install+ -x,--exclude SUBPKG Subpackage (glob) not to install+ -d,--disttag DISTTAG Use a different disttag [default: .fc35]+ -R,--nvr Give an N-V-R instead of package name+ -V,--nv Give an N-V instead of package name+ -h,--help Show this help text+```++## koji-tool progress+Shows the progress of active koji builds tasks+by checking the size of their build.log files.++This is useful for monitoring the build progress of large packages that take+a long time to complete for which some arch's may take considerably longer.++### Usage++```shellsession+$ koji-tool progress --mine+:+$ koji-tool progress 81148584 # ← Koji taskid+:+23:19:19 vim-8.2.4068-1.fc36 (81148584)+aarch64 351kB [109,133 B/min]+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.++## Installation+Builds for fedora are available in [copr](https://copr.fedorainfracloud.org/coprs/petersen/koji-tool/monitor/detailed).++## Build+`cabal-rpm builddep && cabal install` or `stack install`.++## History+The query, install, progress, buildlog-sizes were originally separate programs+and projects (koji-query, koji-install, koji-progress),+and merged together into koji-install (after 0.5) and renamed+to koji-tool. See the other original repos for their history.
+ koji-tool.cabal view
@@ -0,0 +1,83 @@+name: koji-tool+version: 0.6+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 check 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 Jens Petersen <juhpetersen@gmail.com>+category: Utility+homepage: https://github.com/juhp/koji-tool+bug-reports: https://github.com/juhp/koji-tool/issues+build-type: Simple+extra-doc-files: README.md+ ChangeLog.md+cabal-version: 1.18+tested-with: GHC== 8.4.4+ || == 8.6.5+ || == 8.8.4+ || == 8.10.7+ || == 9.0.2++source-repository head+ type: git+ location: https://github.com/juhp/koji-tool.git++executable koji-tool+ main-is: Main.hs+ other-modules: Paths_koji_tool+ BuildlogSizes+ DownloadDir+ Install+ Progress+ Query+ hs-source-dirs: src+ build-depends: base < 5,+ directory,+ extra,+ filepath,+ format-numbers,+ Glob,+ http-directory >= 0.1.9,+ koji >= 0.0.2,+ pretty-simple,+ rpm-nvr >= 0.1.1,+ simple-cmd,+ simple-cmd-args,+ text,+ time,+ xdg-userdirs+ if impl(ghc<8.4)+ build-depends: http-common < 0.8.3.4+ default-language: Haskell2010+ ghc-options: -Wall -threaded+ if impl(ghc >= 8.0)+ ghc-options: -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wredundant-constraints+ if impl(ghc >= 8.2)+ ghc-options: -fhide-source-paths+ if impl(ghc >= 8.4)+ ghc-options: -Wmissing-export-lists+ -Wpartial-fields+ if impl(ghc >= 8.10)+ ghc-options: -Wunused-packages++test-suite test+ main-is: tests.hs+ type: exitcode-stdio-1.0+ hs-source-dirs: test++ default-language: Haskell2010++ ghc-options: -Wall+ build-depends: base >= 4 && < 5+ , simple-cmd+ build-tools: koji-tool
+ src/BuildlogSizes.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++-- SPDX-License-Identifier: BSD-3-Clause++module BuildlogSizes (+ buildlogSizesCmd+ )+where++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>), (<*>))+#endif+import Control.Monad.Extra++import Data.Char (isDigit)+import Data.RPM.NVR+import Data.List (sortOn)+--import Data.Maybe+#if !MIN_VERSION_base(4,11,0)+import Data.Monoid ((<>))+#endif+import qualified Data.Text as T+import Distribution.Koji (fedoraKojiHub)+import Distribution.Koji.API --(listBuilds)++#if !MIN_VERSION_http_directory(0,1,5)+import Network.HTTP.Client (Manager)+#endif+import Network.HTTP.Directory++import Data.Text.Format.Numbers++import SimpleCmdArgs++-- FIXME split off arch suffix+buildlogSizesCmd :: String -> IO ()+buildlogSizesCmd nvrpat = do+ if all isDigit nvrpat -- check if taskid (not buildid)+ then do+ mgr <- httpManager+ buildlogSizes mgr (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+ where+ getResult :: Manager -> Struct -> IO ()+ getResult mgr bld = do+ putStrLn ""+ case lookupStruct "nvr" bld of+ Just nvr -> do+ putStrLn nvr+ nvrBuildlogSizes mgr nvr+ Nothing -> do+ let mextra = lookupStruct "extra" bld+ mtid =+ lookupStruct "task_id" bld <|>+ (mextra >>= lookupStruct "task_id")+ case mtid :: Maybe Int of+ Nothing -> error "no taskid found!"+ Just tid -> buildlogSizes mgr tid++nvrBuildlogSizes :: Manager -> String -> IO ()+nvrBuildlogSizes mgr 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+ forM_ archs $ \arch ->+ doGetBuildlogSize mgr (logsdir +/+ arch +/+ "build.log") arch++buildlogSizes :: Manager -> Int -> IO ()+buildlogSizes mgr tid = do+ children <- sortOn (\t -> lookupStruct "arch" t :: Maybe String) <$>+ getTaskChildren fedoraKojiHub tid True+ mapM_ (buildlogSize mgr) children++buildlogSize :: Manager -> Struct -> IO ()+buildlogSize mgr 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+ 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+ whenJust msize $ \ size -> do+ let kb = kiloBytes size+ putStrLn $ arch ++ replicate (16 - length arch - length kb) ' ' ++ kb++kiloBytes :: Integer -> String+kiloBytes size =+ T.unpack $ prettyI (Just ',') (fromInteger size `div` 1000) <> "kB"++#if !MIN_VERSION_http_directory(0,1,9)+infixr 5 +/++(+/+) :: String -> String -> String+"" +/+ s = s+s +/+ "" = s+s +/+ t | last s == '/' = init s +/+ t+ | head t == '/' = s +/+ tail t+s +/+ t = s ++ "/" ++ t+#endif
+ src/DownloadDir.hs view
@@ -0,0 +1,43 @@+module DownloadDir (+ setDownloadDir)+where++import Control.Monad+import SimpleCmd (error')+import System.Directory (createDirectoryIfMissing,+ doesDirectoryExist, getHomeDirectory,+ setCurrentDirectory)+import System.Environment.XDG.UserDir (getUserDir)+import System.FilePath++-- FIXME check writeable+setDownloadDir :: Bool -> String -> IO FilePath+setDownloadDir dryrun subdir = do+ home <- getHomeDirectory+ dlDir <- getUserDir "DOWNLOAD"+ dirExists <- doesDirectoryExist dlDir+ -- is this really necessary?+ unless (dryrun || dirExists) $+ when (home == dlDir) $+ error' "HOME directory does not exist!"+ let filesDir = dlDir </> subdir+ filesExists <- doesDirectoryExist filesDir+ dir <-+ if filesExists+ then setCWD filesDir+ else+ if dirExists+ then setCWD dlDir+ else do+ if dryrun+ then return dlDir+ else do+ createDirectoryIfMissing True dlDir+ setCWD dlDir+ let path = makeRelative home dir+ return $ if isRelative path then "~" </> path else path+ where+ setCWD :: FilePath -> IO FilePath+ setCWD dir = do+ setCurrentDirectory dir+ return dir
+ src/Install.hs view
@@ -0,0 +1,401 @@+{-# LANGUAGE CPP #-}++-- SPDX-License-Identifier: BSD-3-Clause++module Install (+ Mode(..),+ Request(..),+ installCmd,+ knownHubs+ )+where++import Control.Monad.Extra+import Data.Char+import Data.List.Extra+import Data.Maybe+import Data.RPM+import Distribution.Koji+import qualified Distribution.Koji.API as Koji+import Network.HTTP.Directory (httpFileSize', httpLastModified', (+/+))+import SimpleCmd+import System.Directory+import System.FilePath+import System.FilePath.Glob+import System.IO++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+ "https://koji.fedoraproject.org/kojihub" ->+ "https://kojipkgs.fedoraproject.org/packages"+ "https://kojihub.stream.centos.org/kojihub" ->+ "https://kojihub.stream.centos.org/kojifiles/packages"+ _ ->+ if "kojihub" `isSuffixOf` url+ then replace "kojihub" "kojifiles" url +/+ "packages"+ else error' $ "use --files-url to specify kojifiles url for " ++ url++data Mode = All+ | Ask+ -- distinguish except and exclude+ | PkgsReq [String] [String] -- ^ include, except/exclude+ deriving Eq++data Request = ReqName | ReqNV | ReqNVR+ deriving Eq+++-- FIXME --include devel, --exclude *+-- FIXME specify tag or task+-- FIXME support enterprise builds+-- FIXME --arch (including src)+-- FIXME --debuginfo+-- FIXME --delete after installing+installCmd :: Bool -> Bool -> Maybe String -> Maybe String -> Bool -> Mode+ -> String -> Request -> [String] -> IO ()+installCmd dryrun debug mhuburl mpkgsurl listmode mode disttag request pkgbldtsks = do+ let huburl = maybe fedoraKojiHub hubURL mhuburl+ pkgsurl = fromMaybe (defaultPkgsURL huburl) mpkgsurl+ when debug $ do+ putStrLn huburl+ putStrLn pkgsurl+ -- FIXME use this location?+ dlDir <- setDownloadDir dryrun "rpms"+ when debug $ putStrLn dlDir+ setNoBuffering+ mapM (kojiRPMs huburl pkgsurl dlDir) pkgbldtsks+ >>= if listmode+ then mapM_ putStrLn . mconcat+ else installRPMs dryrun . mconcat+ where+ kojiRPMs :: String -> String -> String -> String -> IO [String] -- ([String],String)+ kojiRPMs huburl pkgsurl dlDir bldtask =+ if all isDigit bldtask+ then kojiTaskRPMs dryrun debug huburl pkgsurl listmode mode dlDir bldtask+ else kojiBuildRPMs huburl pkgsurl dlDir bldtask++ kojiBuildRPMs :: String -> String -> String -> String -> IO [String]+ kojiBuildRPMs huburl pkgsurl dlDir pkgbld = do+ nvrs <- kojiBuildOSBuilds debug huburl listmode disttag request pkgbld+ if listmode+ then if mode /= PkgsReq [] []+ then error' "modes not supported for listing build"+ else return nvrs+ else+ case nvrs of+ [] -> error' $ pkgbld ++ " not found for " ++ disttag+ [nvr] -> do+ putStrLn $ nvr ++ "\n"+ allRpms <- map (<.> "rpm") . sort . filter (not . debugPkg) <$> kojiGetBuildRPMs huburl nvr+ when debug $ print allRpms+ dlRpms <- decideRpms listmode mode (maybeNVRName nvr) allRpms+ when debug $ print dlRpms+ unless (dryrun || null dlRpms) $ do+ downloadRpms debug (buildURL (readNVR nvr)) dlRpms+ -- FIXME once we check file size - can skip if no downloads+ putStrLn $ "Packages downloaded to " ++ dlDir+ return dlRpms+ _ -> error $ "multiple build founds for " ++ pkgbld ++ ": " +++ unwords nvrs+ where+ buildURL :: NVR -> String -> String+ buildURL (NVR n (VerRel v r)) rpm =+ let arch = rpmArch (readNVRA rpm)+ in pkgsurl +/+ n +/+ v +/+ r +/+ arch +/+ rpm++ debugPkg :: String -> Bool+ debugPkg p = "-debuginfo-" `isInfixOf` p || "-debugsource-" `isInfixOf` p++kojiTaskRPMs :: Bool -> Bool -> String -> String -> Bool -> Mode -> String+ -> String -> IO [String]+kojiTaskRPMs dryrun debug huburl pkgsurl listmode mode dlDir task = do+ let taskid = read task+ if listmode+ then do+ mtaskinfo <- Koji.getTaskInfo huburl taskid True+ case mtaskinfo of+ Just taskinfo -> do+ when debug $ mapM_ print taskinfo+ if isNothing (lookupStruct "parent" taskinfo :: Maybe Int)+ then do+ children <- Koji.getTaskChildren huburl taskid False+ return $ fromMaybe "" (showTask taskinfo) : mapMaybe showChildTask children+ else getTaskRPMs taskid >>= decideRpms listmode mode Nothing+ Nothing -> error' "failed to get taskinfo"+ else do+ rpms <- getTaskRPMs taskid+ if null rpms+ then do+ kojiTaskRPMs dryrun debug huburl pkgsurl True mode dlDir task >>= mapM_ putStrLn+ return []+ else do+ when debug $ print rpms+ let srpm =+ case filter (".src.rpm" `isExtensionOf`) rpms of+ [src] -> src+ _ -> error' "could not determine nvr from any srpm"+ nvr = dropSuffix ".src.rpm" srpm+ dlRpms <- decideRpms listmode mode (maybeNVRName nvr) $ rpms \\ [srpm]+ when debug $ print dlRpms+ unless (dryrun || null dlRpms) $ do+ downloadRpms debug (taskRPMURL task) dlRpms+ putStrLn $ "Packages downloaded to " ++ dlDir+ return dlRpms+ where+ getTaskRPMs :: Int -> IO [String]+ getTaskRPMs taskid =+ sort . filter (".rpm" `isExtensionOf`) . map fst <$>+ Koji.listTaskOutput huburl taskid False True False++ taskRPMURL :: String -> String -> String+ taskRPMURL taskid rpm =+ let lastFew =+ let few = dropWhile (== '0') $ takeEnd 4 taskid in+ if null few then "0" else few+ in dropSuffix "packages" pkgsurl +/+ "work/tasks/" ++ lastFew +/+ taskid +/+ rpm++maybeNVRName :: String -> Maybe String+maybeNVRName = fmap nvrName . maybeNVR++decideRpms :: Bool -> Mode -> Maybe String -> [String] -> IO [String]+decideRpms listmode mode mbase allRpms =+ case mode of+ All -> if listmode+ then error' "cannot use --list and --all together"+ else return allRpms+ Ask -> if listmode+ then error' "cannot use --list and --ask together"+ else mapMaybeM rpmPrompt allRpms+ PkgsReq [] [] ->+ if listmode+ then return allRpms+ else do+ rpms <- filterM (isInstalled . nvraName) $+ filter isBinaryRpm allRpms+ if null rpms+ then decideRpms listmode Ask mbase allRpms+ else return rpms+ PkgsReq subpkgs exclpkgs ->+ return $ selectRPMs mbase (subpkgs,exclpkgs) allRpms++isInstalled :: String -> IO Bool+isInstalled rpm = cmdBool "rpm" ["--quiet", "-q", rpm]++selectRPMs :: Maybe String -> ([String],[String]) -> [String] -> [String]+selectRPMs mbase (subpkgs,[]) rpms =+ sort . mconcat $+ flip map subpkgs $ \ pkgpat ->+ case filter (match (compile pkgpat) . nvraName) rpms of+ [] -> case mbase of+ Just base | head pkgpat /= '*' ->+ selectRPMs Nothing ([base ++ '-' : pkgpat],[]) rpms+ _ -> error' $ "no subpackage match for " ++ pkgpat+ result -> result+selectRPMs mbase ([], subpkgs) rpms =+ -- FIXME somehow determine unused excludes+ foldl' (exclude subpkgs) [] rpms+ where+ exclude :: [String] -> [String] -> String -> [String]+ exclude [] acc rpm = acc ++ [rpm]+ exclude (pat:pats) acc rpm =+ if checkMatch (nvraName rpm)+ then acc+ else exclude pats acc rpm+ where+ checkMatch :: String -> Bool+ checkMatch rpmname =+ let comppat = compile pat+ in if isLiteral comppat+ then pat == rpmname ||+ maybe False (\b -> (b ++ '-' : pat) == rpmname) mbase+ else match comppat rpmname+selectRPMs mbase (subpkgs,exclpkgs) rpms =+ let needed = selectRPMs mbase (subpkgs,[]) rpms+ excluded = selectRPMs mbase ([], exclpkgs) rpms+ in nub . sort $ needed ++ excluded++nvraName :: String -> String+nvraName = rpmName . readNVRA++rpmPrompt :: String -> IO (Maybe String)+rpmPrompt rpm = do+ putStr $ rpm ++ " [y/n]: "+ c <- getChar+ putStrLn ""+ case toLower c of+ 'y' -> return $ Just rpm+ 'n' -> return Nothing+ _ -> rpmPrompt rpm++kojiBuildOSBuilds :: Bool -> String -> Bool -> String -> Request -> String+ -> IO [String]+kojiBuildOSBuilds debug hub listmode disttag request pkgpat = do+ let (pkg,full) = packageOfPattern pkgpat+ oldkoji = "rpmfusion" `isInfixOf` hub+ when (oldkoji && ("*" `isInfixOf` pkgpat || request /= ReqName)) $+ error' "cannot use pattern with this kojihub"+ mpkgid <- Koji.getPackageID hub pkg+ case mpkgid of+ Nothing -> error $ "package not found: " ++ pkg+ Just pkgid -> do+ -- strictly should getAPIVersion+ let opts = (if oldkoji+ then id+ else (("pattern", ValueString (if full then pkgpat else dropSuffix "*" pkgpat ++ "*" ++ disttag ++ "*")) :))+ [("packageID", ValueInt pkgid),+ ("state", ValueInt (fromEnum BuildComplete)),+ ("queryOpts",ValueStruct+ [("limit",ValueInt $ if listmode || oldkoji then 10 else 1),+ ("order",ValueString "-build_id")])]+ when debug $ print opts+ nvrs <- mapMaybe (lookupStruct "nvr") <$> Koji.listBuilds hub opts+ if null nvrs+ then error' $ "no builds found for " ++ disttag+ else+ return $+ if oldkoji+ then case filter (disttag `isInfixOf`) nvrs of+ [] -> error' $ "no builds found for " ++ disttag+ [res] -> [res]+ rs@(r:_) ->+ if listmode then rs else [r]+ else nvrs+ where+ packageOfPattern :: String -> (String, Bool)+ packageOfPattern pat =+ case request of+ ReqName -> (dropSuffix "-" $ takeWhile (/= '*') pat, False)+ ReqNV ->+ case readNV pat of+ NV n _ -> (n, False)+ ReqNVR ->+ case readNVR pat of+ NVR n _ -> (n, True)++kojiGetBuildRPMs :: String -> String -> IO [String]+kojiGetBuildRPMs huburl nvr = do+ mbid <- kojiGetBuildID huburl nvr+ case mbid of+ Nothing -> error $ "Build id not found for " ++ nvr+ Just (BuildId bid) -> do+ rpms <- Koji.listBuildRPMs huburl bid+ sysarch <- cmd "rpm" ["--eval", "%{_arch}"]+ return $ map getNVRA $ filter (forArch sysarch) rpms+ where+ forArch :: String -> Struct -> Bool+ forArch sysarch st =+ case lookupStruct "arch" st of+ Just arch -> arch `elem` [sysarch, "noarch"]+ Nothing -> error $ "No arch found for rpm for: " ++ nvr++ getNVRA :: Struct -> String+ getNVRA st =+ case lookupStruct "nvr" st of+ Nothing -> error' "NVR not found"+ Just pnvr ->+ case lookupStruct "arch" st of+ Nothing -> error "arch not found"+ Just arch ->+ pnvr <.> arch++setNoBuffering :: IO ()+setNoBuffering = do+ hSetBuffering stdin NoBuffering+ hSetBuffering stdout NoBuffering++installRPMs :: Bool -> [FilePath] -> IO ()+installRPMs _ [] = return ()+installRPMs dryrun rpms = do+ installed <- filterM (isInstalled . dropExtension) rpms+ unless (null installed) $+ if dryrun+ then mapM_ putStrLn $ "would update:" : installed+ else sudo_ "dnf" ("reinstall" : installed)+ let rest = rpms \\ installed+ unless (null rest) $+ if dryrun+ then mapM_ putStrLn $ "would install:" : rest+ else sudo_ "dnf" ("localinstall" : rest)++downloadRpms :: Bool -> (String -> String) -> [String] -> IO ()+downloadRpms debug urlOf rpms = do+ urls <- fmap catMaybes <$>+ forM rpms $ \rpm -> do+ exists <- doesFileExist rpm+ let url = urlOf rpm+ notfile <-+ if exists+ then do+ old <- outOfDate rpm url+ when old $ removeFile rpm+ return old+ else return True+ when notfile $ putStrLn $ if debug then url else rpm+ return $ if notfile then Just url else Nothing+ unless (null urls) $ do+ mapM_ putStrLn urls+ putStrLn "downloading..."+ cmd_ "curl" $ ["--remote-time", "--fail", "-C-", "--show-error", "--remote-name-all", "--progress-bar"] ++ urls+ where+ outOfDate :: String -> String -> IO Bool+ outOfDate file url = do+ mremotetime <- httpLastModified' url+ case mremotetime of+ Just remotetime -> do+ localtime <- getModificationTime file+ if localtime < remotetime+ then return True+ else sizeOk file url+ Nothing -> sizeOk file url++ sizeOk :: String -> String -> IO Bool+ sizeOk file url = do+ remotesize <- httpFileSize' url+ localsize <- getFileSize file+ return $ remotesize /= Just localsize++showTask :: Struct -> Maybe String+showTask struct = do+ state <- getTaskState struct+ request <- lookupStruct "request" struct+ method <- lookupStruct "method" struct+ let mparent = lookupStruct "parent" struct :: Maybe Int+ showreq = takeWhileEnd (/= '/') . unwords . mapMaybe getString . take 3+ return $ showreq request +-+ method +-+ (if state == TaskClosed then "" else show state) +-+ maybe "" (\p -> "(" ++ show p ++ ")") mparent++showChildTask :: Struct -> Maybe String+showChildTask struct = do+ arch <- lookupStruct "arch" struct+ state <- getTaskState struct+ method <- lookupStruct "method" struct+ taskid <- lookupStruct "id" struct+ return $ arch ++ replicate (8 - length arch) ' ' +-+ show (taskid :: Int) +-+ method +-+ show state++isBinaryRpm :: FilePath -> Bool+isBinaryRpm file =+ ".rpm" `isExtensionOf` file && not (".src.rpm" `isExtensionOf` file)++#if !MIN_VERSION_filepath(1,4,2)+isExtensionOf :: String -> FilePath -> Bool+isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions+isExtensionOf ext = isSuffixOf ('.':ext) . takeExtensions+#endif
+ src/Main.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE CPP #-}++-- SPDX-License-Identifier: BSD-3-Clause++module Main (main) where++import Data.List.Extra+import SimpleCmd+import SimpleCmdArgs++import BuildlogSizes+import Install+import qualified Paths_koji_tool+import Progress+import Query++main :: IO ()+main = do+ sysdisttag <- do+ dist <- cmd "rpm" ["--eval", "%{dist}"]+ return $ if dist == "%{dist}" then "" else dist+ simpleCmdArgs (Just Paths_koji_tool.version)+ "Query and track Koji tasks, and install rpms from Koji."+ "see https://github.com/juhp/koji-tool#readme" $+ subcommands+ [ 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]"))+ <*> optional (strOptionWith 'P' "packages-url" "URL"+ "KojiFiles packages url [default: Fedora]")+ <*> switchWith 'l' "list" "List builds"+ <*> modeOpt+ <*> disttagOpt sysdisttag+ <*> (flagWith' ReqNVR 'R' "nvr" "Give an N-V-R instead of package name"+ <|> flagWith ReqName ReqNVR '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]")+ <*> 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"+ <|> 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" <|>+ After <$> strOptionWith 'F' "from" "TIMESTAMP" "Tasks completed after timedate [default: today]")+ <*> (fmap normalizeMethod <$> optional (strOptionWith 'm' "method" "METHOD" "Select tasks by method: [build,buildarch,etc]"))+ <*> switchWith 'D' "debug" "Pretty-pretty raw XML result"+ -- FIXME error if integer (eg mistakenly taskid)+ <*> optional (TaskPackage <$> strOptionWith 'p' "package" "PKG" "Filter results to specified package"+ <|> TaskNVR <$> strOptionWith 'n' "nvr" "PREFIX" "Filter results by NVR prefix")++ , Subcommand "progress"+ "Track running Koji tasks by buildlog size" $+ progressCmd+ <$> optionalWith auto 'i' "interval" "MINUTES" "Polling interval between updates (default 2 min)" 2+ <*> switchWith 'm' "modules" "Track module builds"+ <*> many (TaskId <$> argumentWith auto "TASKID")++ , Subcommand "buildlog-sizes" "Show buildlog sizes for nvr patterns" $+ buildlogSizesCmd <$> strArg "NVRPATTERN"+ ]+ where+ modeOpt :: Parser Mode+ modeOpt =+ flagWith' All 'a' "all" "all subpackages" <|>+ flagWith' Ask 'A' "ask" "ask for each subpackge [default if not installed]" <|>+ pkgsReqOpts++ pkgsReqOpts = PkgsReq+ <$> many (strOptionWith 'p' "package" "SUBPKG" "Subpackage (glob) to install") <*> many (strOptionWith 'x' "exclude" "SUBPKG" "Subpackage (glob) not to install")++ disttagOpt :: String -> Parser String+ disttagOpt disttag = startingDot <$> strOptionalWith 'd' "disttag" "DISTTAG" ("Use a different disttag [default: " ++ disttag ++ "]") disttag++ startingDot cs =+ case cs of+ "" -> error' "empty disttag"+ (c:_) -> if c == '.' then cs else '.' : cs++ normalizeMethod :: String -> String+ normalizeMethod m =+ case elemIndex (lower m) (map lower kojiMethods) of+ Just i -> kojiMethods !! i+ Nothing -> error' $! "unknown method: " ++ m
+ src/Progress.hs view
@@ -0,0 +1,208 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++module Progress (+ progressCmd,+ TaskID(..)+ )+where++#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))+#else+import Control.Applicative ((<$>), (<*>))+#endif+import Control.Monad++#if !MIN_VERSION_http_directory(0,1,5)+import Network.HTTP.Client (Manager)+#endif+import Network.HTTP.Directory++import Control.Concurrent (threadDelay)++import Data.Fixed+import Data.List.Extra+import Data.Maybe+#if !MIN_VERSION_base(4,11,0)+import Data.Monoid ((<>))+#endif+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Data.Text.Format.Numbers++import Distribution.Koji++import SimpleCmd++import System.FilePath (takeBaseName, (</>))++progressCmd :: Int -> Bool -> [TaskID] -> IO ()+progressCmd waitdelay modules tids = do+ when (waitdelay < 1) $ error' "minimum interval is 1 min"+ when (modules && not (null tids)) $ error' "cannot combine --modules with tasks"+ tasks <-+ if null tids+ then kojiListBuildTasks $ if modules then Just "mbs/mbs.fedoraproject.org" else Nothing+ else return tids+ when (null tasks) $ error' "no build tasks found"+ btasks <- mapM kojiTaskinfoRecursive tasks+ mgr <- httpManager+ loopBuildTasks waitdelay mgr btasks++kojiTaskinfoRecursive :: TaskID -> IO BuildTask+kojiTaskinfoRecursive tid = do+ mtaskinfo <- kojiGetTaskInfo fedoraKojiHub tid+ case mtaskinfo of+ Nothing -> error' $ "taskinfo not found for " ++ displayID tid+ Just taskinfo -> do+ parent <-+ case lookupStruct "method" taskinfo :: Maybe String of+ Nothing -> error' $ "no method found for " ++ displayID tid+ Just method ->+ case method of+ "build" -> return tid+ "buildArch" ->+ case lookupStruct "parent" taskinfo of+ Nothing -> error' $ "no parent found for " ++ displayID tid+ Just parent -> return (TaskId parent)+ _ -> error' $ "unsupport method: " ++ method+ children <- sortOn (\t -> lookupStruct "arch" t :: Maybe String) <$>+ kojiGetTaskChildren fedoraKojiHub parent True+ return (tid, zip children (repeat Nothing))++type BuildTask = (TaskID, [TaskInfoSize])++-- FIXME change to (TaskID,Struct,Size)+type TaskInfoSize = (Struct,Maybe Int)+type TaskInfoSizes = (Struct,(Maybe Int,Maybe Int))++loopBuildTasks :: Int -> Manager -> [BuildTask] -> IO ()+loopBuildTasks _ _ [] = return ()+loopBuildTasks waitdelay mgr bts = do+ curs <- filter tasksOpen <$> mapM runProgress bts+ unless (null curs) $ do+ threadDelayMinutes waitdelay+ news <- mapM updateBuildTask curs+ loopBuildTasks waitdelay mgr news+ where+ threadDelayMinutes :: Int -> IO ()+ threadDelayMinutes m =+ -- convert minutes to microseconds+ threadDelay (fromEnum (fromIntegral (m * 60) :: Micro))++ runProgress :: BuildTask -> IO BuildTask+ runProgress (tid,tasks) =+ if null tasks then do+ state <- kojiGetTaskState fedoraKojiHub tid+ if state `elem` map Just openTaskStates then do+ threadDelayMinutes waitdelay+ kojiTaskinfoRecursive tid+ else return (tid,[])+ else do+ putStrLn ""+ let request = lookupStruct "request" $ fst (head tasks) :: Maybe [Value]+ nvr = case request of+ Just (srpm:_) ->+ (takeBaseName . takeBaseName) $+ maybeVal "failed to read src rpm" getString srpm+ _ -> error "No src rpm found"+ logMsg $ nvr ++ " (" ++ displayID tid ++ ")"+ sizes <- mapM (buildlogSize mgr) tasks+ printLogSizes waitdelay sizes+ let news = map (\(t,(s,_)) -> (t,s)) sizes+ open = filter (\ (t,_) -> getTaskState t `elem` map Just openTaskStates) news+ return (tid, open)++ tasksOpen :: BuildTask -> Bool+ tasksOpen (_,ts) = not (null ts)++ updateBuildTask :: BuildTask -> IO BuildTask+ updateBuildTask (tid, ts) = do+ news <- mapM updateTask ts+ return (tid, news)++ updateTask :: TaskInfoSize -> IO TaskInfoSize+ updateTask (task,size) = do+ let tid = fromJust (readID task)+ mnew <- kojiGetTaskInfo fedoraKojiHub tid+ case mnew of+ Nothing -> error' $ "TaskInfo not found for " ++ displayID tid+ Just new -> return (new,size)++buildlogSize :: Manager -> TaskInfoSize -> IO TaskInfoSizes+buildlogSize mgr (task, old) = do+ exists <- if isJust old then return True+ else httpExists mgr buildlog+ size <- if exists then httpFileSize mgr buildlog else return Nothing+ return (task,(fromInteger <$> size,old))+ where+ tid = show $ fromJust (readID' task)+ buildlog = "https://kojipkgs.fedoraproject.org/work/tasks" </> lastFew </> tid </> "build.log"+ lastFew =+ let few = dropWhile (== '0') $ takeEnd 4 tid in+ if null few then "0" else few++data TaskOutput = TaskOut {_outArch :: Text, outSize :: Text, outSpeed :: Text, _outState :: Text, _method :: Text}++printLogSizes :: Int -> [TaskInfoSizes] -> IO ()+printLogSizes waitdelay tss =+ mapM_ (T.putStrLn . taskOutList) $ (formatSize . map logSize) tss+ where+ taskOutList :: TaskOutput -> Text+ taskOutList (TaskOut a si sp st mth) = T.unwords [a, si, sp, st, mth]++ formatSize :: [TaskOutput] -> [TaskOutput]+ formatSize ts =+ let maxsi = maximum $ 6 : map (T.length . outSize) ts+ -- "198,689"+ maxsp = maximum $ 7 : map (T.length . outSpeed) ts+ in map (justifyBytes maxsi maxsp) ts++ justifyBytes :: Int -> Int -> TaskOutput -> TaskOutput+ justifyBytes maxsi maxsp (TaskOut a si sp st mth) =+ TaskOut+ (a <> T.replicate (7 - T.length a) " ")+ (T.replicate (maxsi - T.length si) " " <> si <> "kB")+ (case sp of+ "" -> ""+ _ -> "[" <> T.replicate (maxsp - T.length sp) " " <> sp <> " B/min" <> "]")+ st+ (case mth of+ "buildArch" -> ""+ "buildSRPMFromSCM" -> "SRPM"+ _ -> mth)++ logSize :: TaskInfoSizes -> TaskOutput+ logSize (task, (size,old)) =+ let method = maybeVal "method not found" (lookupStruct "method") task :: Text+ arch = maybeVal "arch not found" (lookupStruct "arch") task :: Text+ diff = (-) <$> size <*> old+ state = maybeVal "No state found" getTaskState task+ state' = if state == TaskOpen then "" else T.pack (show state)+ in TaskOut arch (maybe "" kiloBytes size) (maybe "" speed diff) state' method+ where+ kiloBytes s = prettyI (Just ',') (s `div` 1000)++ speed :: Int -> Text+ speed s = prettyI (Just ',') (s `div` waitdelay)++kojiListBuildTasks :: Maybe String -> IO [TaskID]+kojiListBuildTasks muser = do+ user <- case muser of+ Just user -> return user+ Nothing -> do+ mfasid <- (removeSuffix "@FEDORAPROJECT.ORG" <$>) . find ("@FEDORAPROJECT.ORG" `isSuffixOf`) . words <$> cmd "klist" ["-l"]+ case mfasid of+ Just fas -> return fas+ Nothing -> error' "Could not determine FAS id from klist"+ mowner <- kojiGetUserID fedoraKojiHub user+ case mowner of+ Nothing -> error "No owner found"+ Just owner ->+ kojiListTaskIDs fedoraKojiHub+ [("method", ValueString "build"), ("owner", ValueInt (getID owner)), ("state", openTaskValues)]+ [("limit", ValueInt 10)]++maybeVal :: Show a => String -> (a -> Maybe b) -> a -> b+maybeVal err f v = fromMaybe (error (err ++ ": " ++ show v)) $ f v
+ src/Query.hs view
@@ -0,0 +1,309 @@+{-# 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 | 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'+ _ -> 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"+ 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 "after" 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 "After" (capitalize . show) mdate, ValueString date)]+ ++ commonParams+ where+ commonParams =+ [("decode", ValueBool True)]+ ++ [("state", ValueArray (map taskStateToValue states)) | notNull states]+ ++ [("arch", ValueArray (map ValueString archs)) | notNull archs]+ ++ [("method", ValueString method) | Just method <- [mmethod]]++ dateString :: Maybe BeforeAfter -> String+ dateString Nothing = "today 00:00"+ -- 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 >>= getString . head+ let package =+ let file = takeFileName request+ 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"++ 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
+ test/tests.hs view
@@ -0,0 +1,31 @@+import SimpleCmd+import System.IO++program :: [String] -> IO ()+program args =+ putStrLn "" >>+ cmdLog "koji-tool" ("install" : "-n" : args)++tests :: Bool -> [[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+ ]+ where+ sysdist = if havedist then [] else ["-d", "fc35"]++main :: IO ()+main = do+ hSetBuffering stdout NoBuffering+ havedist <- do+ dist <- cmd "rpm" ["--eval", "%{dist}"]+ return $ dist /= "%{dist}"+ let cases = tests havedist+ mapM_ program cases+ putStrLn $ show (length cases) ++ " tests run"