koji-tool 1.2 → 1.3
raw patch · 13 files changed
+392/−523 lines, 13 filesdep +select-rpmsdep −Globdep −simple-prompt
Dependencies added: select-rpms
Dependencies removed: Glob, simple-prompt
Files
- ChangeLog.md +21/−0
- README.md +84/−60
- TODO +10/−0
- koji-tool.cabal +6/−6
- src/BuildlogSizes.hs +13/−10
- src/Builds.hs +59/−21
- src/Common.hs +20/−2
- src/Find.hs +29/−16
- src/Install.hs +47/−319
- src/Main.hs +37/−33
- src/Progress.hs +2/−4
- src/Tasks.hs +55/−49
- src/Utils.hs +9/−3
ChangeLog.md view
@@ -1,5 +1,26 @@ # Version history of koji-tool +## 1.3 (2025-05-03)+- 'builds': add --tail+- 'builds': building state aliases: build, open, run+- 'builds': drop short option (-T) for --type: conflicts with --tail+- 'builds'/'tasks' nvr patterns now give up for rpmfusion instead of koji error+- 'install' rpm selection was refactored into new select-rpms library+- 'install': add --tagged to allow installing an entire (side)tag+- 'install': only print download dir after downloading rpms for all packages+- 'install': print url after nvr not below+- 'install': use curl --fail-early to stop on any rpm download failure+- 'progress': correct/simplify mbiggest logic/calc+- 'progress': drop --modules short option, which conflicts with --method+- add 'tagged' command, with --install option+- 'tasks': add --rootlog (and "rootlog" for find)+- 'tasks': add newline after log final url+- 'tasks': simplify duration output logic (handle current/finished together)+- 'tasks': tailLogUrl optional offset+- more correct result limit options and handling+- use more safe functions+- use select-rpms-0.2.0 for existingStrategyOption & selectRpmsOptions+ ## 1.2 (2024-07-27) - allow --unlimited results: useful for open tasks/builds - builds: also show owner
README.md view
@@ -24,7 +24,7 @@ `$ koji-tool --version` ```-1.2+1.3 ``` `$ koji-tool --help`@@ -51,8 +51,9 @@ buildlog-sizes Show buildlog sizes for nvr patterns find Simple quick common queries using words like: [my, last, fail, complete, current, build, detail,- install, tail, notail, hwinfo, x86_64, debug,- PACKAGE, USER\'s, LIMIT]+ install, tail, notail, hwinfo, rootlog, x86_64,+ debug, PACKAGE, USER\'s, LIMIT]+ tagged List builds for tag ``` ## koji-tool builds@@ -78,13 +79,13 @@ `$ koji-tool builds --help` ```-Usage: koji-tool builds [-H|--hub HUB] [(-u|--user USER) | (-M|--mine)] - [(-L|--latest) | (-U|--unlimited) | (-l|--limit INT)] - [-s|--state STATE] - [(-B|--before TIMESTAMP) | (-F|--from TIMESTAMP)] - [-T|--type TYPE] [(-d|--details) | (-t|--tasks)] - [-i|--install INSTALLOPTS] [-D|--debug] - [(-b|--build NVR/BUILDID) | (-p|--pattern NVRPAT) | +Usage: koji-tool builds [-H|--hub HUB] [(-u|--user USER) | (-M|--mine)]+ [(-L|--latest) | (-U|--unlimited) | (-l|--limit INT)]+ [-s|--state STATE]+ [(-B|--before TIMESTAMP) | (-F|--from TIMESTAMP)]+ [--type TYPE] [(-d|--details) | (-t|--tasks)]+ [-T|--tail] [-i|--install INSTALLOPTS] [-D|--debug]+ [(-b|--build NVR/BUILDID) | (-p|--pattern NVRPAT) | PACKAGE] Query Koji builds (by default lists the most recent builds)@@ -96,14 +97,15 @@ -M,--mine Your tasks (krb fasid) -L,--latest Latest build -U,--unlimited No limit on number of results- -l,--limit INT Maximum number of builds to show [default: 20]+ -l,--limit INT Maximum number of builds to show [default: 5] -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+ --type TYPE Select builds by type: all,image,maven,module,rpm,win -d,--details Show more build details -t,--tasks Show details and tasks+ -T,--tail Fetch the tail of build.log -i,--install INSTALLOPTS Install the package with 'install' options -D,--debug Pretty-print raw XML result -b,--build NVR/BUILDID Show build@@ -120,16 +122,16 @@ List latest build of a package: -`$ koji-tool builds --pattern redhat-rpm-config*.fc40 --latest`+`$ koji-tool builds --pattern redhat-rpm-config*.fc42 --latest` ```-redhat-rpm-config-288-1.fc40 BuildComplete (fweimer)-https://koji.fedoraproject.org/koji/buildinfo?buildID=2460713-https://koji.fedoraproject.org/koji/taskinfo?taskID=118524958-start: Tue Jun 4 03:07:58 +08 2024-completion: Tue Jun 4 03:12:51 +08 2024-duration: 4 min 53 sec-https://kojipkgs.fedoraproject.org/packages/redhat-rpm-config/288/1.fc40+redhat-rpm-config-342-4.fc42 BuildComplete (churchyard)+https://koji.fedoraproject.org/koji/buildinfo?buildID=2696410+https://koji.fedoraproject.org/koji/taskinfo?taskID=131402281+start: Fri Apr 11 12:30:43 CEST 2025+completion: Fri Apr 11 12:32:00 CEST 2025+duration: 1 min 17 sec+https://kojipkgs.fedoraproject.org/packages/redhat-rpm-config/342/4.fc42 ``` ## koji-tool tasks@@ -161,15 +163,16 @@ `$ koji-tool tasks --help` ```-Usage: koji-tool tasks [-H|--hub HUB] [(-u|--user USER) | (-M|--mine)] - [(-L|--latest) | (-U|--unlimited) | (-l|--limit INT)] - [-s|--state STATE] [-a|--arch ARCH] - [(-B|--before TIMESTAMP) | (-F|--from TIMESTAMP)] - [-m|--method METHOD] [-D|--debug] - [(-P|--only-package PKG) | (-N|--only-nvr PREFIX)] - [(-d|--details) | (-c|--concise)] [-T|--tail] [--hw-info]- [-g|--grep STRING] [-i|--install INSTALLOPTS] - [(-b|--build BUILD) | (-p|--pattern NVRPAT) | +Usage: koji-tool tasks [-H|--hub HUB] [(-u|--user USER) | (-M|--mine)]+ [(-L|--latest) | (-U|--unlimited) | (-l|--limit INT)]+ [-s|--state STATE] [-a|--arch ARCH]+ [(-B|--before TIMESTAMP) | (-F|--from TIMESTAMP)]+ [-m|--method METHOD] [-D|--debug]+ [(-P|--only-package PKG) | (-N|--only-nvr PREFIX)]+ [(-d|--details) | (-c|--concise)] [-T|--tail]+ [--hw-info | --rootlog] [-g|--grep STRING]+ [-i|--install INSTALLOPTS]+ [(-b|--build BUILD) | (-p|--pattern NVRPAT) | --children TASKID | --parent TASKID | PACKAGE|TASKID] Query Koji tasks (by default lists the most recent buildArch tasks)@@ -179,9 +182,9 @@ rpmfusion, or URL) [default: fedora] -u,--user USER Koji user -M,--mine Your tasks (krb fasid)- -L,--latest Latest build or task+ -L,--latest Latest build/task -U,--unlimited No limit on number of results- -l,--limit INT Maximum number of tasks to show [default: 20]+ -l,--limit INT Maximum number of build/tasks to show [default: 20] -s,--state STATE Filter tasks by state (open,close(d),cancel(ed),fail(ed),assigned,free) -a,--arch ARCH Task arch@@ -196,6 +199,7 @@ -c,--concise Compact task output -T,--tail Fetch the tail of build.log --hw-info Fetch hw_info.log+ --rootlog Fetch root.log -g,--grep STRING Filter matching log lines -i,--install INSTALLOPTS Install the package with 'install' options -b,--build BUILD List child tasks of build@@ -217,13 +221,11 @@ `$ koji-tool tasks --method newrepo --latest` ```-eln-build-side-93068 newRepo TaskClosed (kojira)-https://koji.fedoraproject.org/koji/taskinfo?taskID=121120828-create: Sat Jul 27 18:59:06 +08 2024-start: Sat Jul 27 19:00:03 +08 2024-completion: Sat Jul 27 19:03:12 +08 2024-delay: 57 sec-duration: 3 min 9 sec+ValueStruct [("id",ValueInt 106124),("name",ValueString "epel10.1-build")] ValueStruct [("opts",ValueStruct []),("__starstar",ValueBool True)] newRepo TaskOpen (kojira)+https://koji.fedoraproject.org/koji/taskinfo?taskID=133511105+create: Tue Jun 3 18:23:56 CEST 2025+start: Tue Jun 3 18:24:47 CEST 2025+current duration: 1 min 46 sec (start delay 51 sec) ``` List latest package build's tasks:@@ -231,14 +233,13 @@ `$ koji-tool tasks --latest redhat-rpm-config` ```-redhat-rpm-config-293-1.eln140.noarch TaskClosed (distrobuildsync-eln/jenkins-continuous-infra.apps.ci.centos.org)-https://koji.fedoraproject.org/koji/taskinfo?taskID=119218471 (parent: 119209735)-create: Tue Jun 18 14:40:53 +08 2024-start: Tue Jun 18 19:13:53 +08 2024-completion: Tue Jun 18 19:15:12 +08 2024-delay: 4 hours 33 min-duration: 1 min 19 sec-https://kojipkgs.fedoraproject.org/packages/redhat-rpm-config/293/1.eln140/data/logs/noarch/build.log (17kB)+redhat-rpm-config-343-6.eln148.noarch TaskClosed (distrobuildsync-eln/jenkins-continuous-infra.apps.ci.centos.org)+https://koji.fedoraproject.org/koji/taskinfo?taskID=133375186 (parent: 133374938)+create: Sat May 31 12:36:50 CEST 2025+start: Sat May 31 12:37:34 CEST 2025+completion: Sat May 31 12:38:37 CEST 2025+duration: 1 min 3 sec (start delay 44 sec)+https://kojipkgs.fedoraproject.org/work/tasks/5186/133375186/build.log (16kB) ``` It is also possible to install packages from a task using@@ -312,17 +313,18 @@ `$ koji-tool install --help` ```-Usage: koji-tool install [-n|--dry-run] [-D|--debug] [-y|--yes] [-H|--hub HUB] - [-P|--packages-url URL] [-l|--list] [-L|--latest] - [-t|--check-remote-time] - [--rpm | --rpm-ostree | --dnf5 | --dnf3] - [-a|--arch ARCH] - [(-N|--no-reinstall) | (-S|--skip-existing)] - [-b|--prefix SUBPKGPREFIX] - [--all | --ask | [-p|--package SUBPKG] - [-e|--except SUBPKG] [-x|--exclude SUBPKG] - [-i|--include SUBPKG]] [-d|--disttag DISTTAG] - [(-R|--nvr) | (-V|--nv)] PKG|NVR|TASKID...+Usage: koji-tool install [-n|--dry-run] [-D|--debug] [-y|--yes] [-H|--hub HUB]+ [-P|--packages-url URL] [-l|--list] [-L|--latest]+ [-t|--check-remote-time]+ [--rpm | --rpm-ostree | --dnf5 | --dnf3]+ [-a|--arch ARCH]+ [(-N|--no-reinstall) | (-S|--skip-existing) |+ (-O|--only-existing)] [-b|--prefix SUBPKGPREFIX]+ [--all | --ask | [-p|--package SUBPKG]+ [-e|--except SUBPKG] [-x|--exclude SUBPKG]+ [-i|--include SUBPKG]] [-d|--disttag DISTTAG]+ [--tagged | (-R|--nvr) | (-V|--nv)]+ PKG|NVR|TASKID|TAG... Install rpm packages directly from a Koji build task @@ -344,6 +346,7 @@ -N,--no-reinstall Do not reinstall existing NVRs -S,--skip-existing Ignore already installed subpackages (implies --no-reinstall)+ -O,--only-existing Only update existing installed subpackages -b,--prefix SUBPKGPREFIX Prefix to use for subpackages [default: base package] --all all subpackages [default if not installed] --ask ask for each subpackage@@ -352,8 +355,9 @@ -x,--exclude SUBPKG deselect subpackage (glob): overrides -p and -e -i,--include SUBPKG additional subpackage (glob) to install: overrides -x -d,--disttag DISTTAG Select a disttag different to system+ --tagged Give a tag instead of package name -R,--nvr Give an N-V-R instead of package name- -V,--nv Give an N-V instead of package name+ -V,--nv Give an N-V instead of (default) package name -h,--help Show this help text ``` @@ -374,8 +378,8 @@ Usage: koji-tool find [-H|--hub HUB] [PHRASE] Simple quick common queries using words like: [my, last, fail, complete,- current, build, detail, install, tail, notail, hwinfo, x86_64, debug, PACKAGE,- USER\'s, LIMIT]+ current, build, detail, install, tail, notail, hwinfo, rootlog, x86_64, debug,+ PACKAGE, USER\'s, LIMIT] Available options: -H,--hub HUB KojiHub shortname or url (HUB = fedora, stream,@@ -414,6 +418,26 @@ ``` The `buildlog-sizes` command is similar but runs once over nvr patterns.++## koji-tool tagged+Similar to `koji list-tagged` with an experimental `--install` option+allowing one to install all the builds from a sidetag.++### Help+`$ koji-tool tagged --help`++```+Usage: koji-tool tagged [-H|--hub HUB] [-i|--install] TAG++ List builds for tag++Available options:+ -H,--hub HUB KojiHub shortname or url (HUB = fedora, stream,+ rpmfusion, or URL) [default: fedora]+ -i,--install Install packages+ -h,--help Show this help text+```+ ## Installation koji-tool is packaged in Fedora
TODO view
@@ -1,3 +1,12 @@+install: use YEAR/MONTH subdirs (but how to re-use later?)++- build-times command a la buildlog-sizes++- list rpms+- download command++- query option for (nth) previous build etc+ use koji --profile ! 'tasks' lists too many tasks for package@@ -10,6 +19,7 @@ # misc - api-version command - swap '-M' (--mine) and '-m' (--method) ?+- support checkout.log # install - autodetect nvr
koji-tool.cabal view
@@ -1,5 +1,5 @@ name: koji-tool-version: 1.2+version: 1.3 synopsis: Koji CLI tool for querying tasks and installing builds description: koji-tool is a CLI interface to Koji with commands to query@@ -10,7 +10,7 @@ license-file: LICENSE author: Jens Petersen <petersen@redhat.com> maintainer: Jens Petersen <petersen@redhat.com>-copyright: 2021-2024 Jens Petersen <petersen@redhat.com>+copyright: 2021-2025 Jens Petersen <petersen@redhat.com> category: Utility homepage: https://github.com/juhp/koji-tool bug-reports: https://github.com/juhp/koji-tool/issues@@ -25,8 +25,9 @@ || == 9.0.2 || == 9.2.8 || == 9.4.8- || == 9.6.6- || == 9.8.2+ || == 9.6.7+ || == 9.8.4+ || == 9.10.2 source-repository head type: git@@ -52,16 +53,15 @@ extra, filepath, formatting >= 7,- Glob, http-conduit, http-directory >= 0.1.10, koji >= 0.0.2, pretty-simple, rpm-nvr >= 0.1.2, safe,+ select-rpms >= 0.2, simple-cmd >= 0.2.2, simple-cmd-args >= 0.1.8,- simple-prompt >=0.2, text, time >= 1.9.1, utf8-string,
src/BuildlogSizes.hs view
@@ -33,14 +33,16 @@ import SimpleCmdArgs -import Common (commonBuildQueryOptions, getBuildState, lookupArch)+import Common (commonBuildQueryOptions, getBuildState, Limit, lookupArch,+ maybeLimit, defaultBuildsLimit) import Utils (buildlogUrlfromTaskId) -- FIXME split off arch suffix -- FIXME show build duration -- FIXME allow buildid-buildlogSizesCmd :: String -> IO ()-buildlogSizesCmd nvrpat = do+-- FIXME only supports Fedora koji+buildlogSizesCmd :: Maybe Limit -> String -> IO ()+buildlogSizesCmd mlimit nvrpat = do if all isDigit nvrpat -- taskid then buildlogSizes (read nvrpat) else do -- find builds@@ -50,10 +52,11 @@ else nvrpat results <- listBuilds fedoraKojiHub [("pattern", ValueString pat),- commonBuildQueryOptions (Just 5)]+ commonBuildQueryOptions $+ maybeLimit defaultBuildsLimit mlimit] if null results then if '*' `notElem` pat- then buildlogSizesCmd $ nvrpat ++ "*"+ then buildlogSizesCmd mlimit $ nvrpat ++ "*" else putStrLn $ "no NVRs found for pattern: " ++ pat else mapM_ getResult results where@@ -117,9 +120,9 @@ #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+s +/+ t =+ case (s,t) of+ ("",_) -> t+ (_,"") -> s+ (_,_) -> dropWhileEnd (== '/') s ++ '/' : dropWhile (== '/') t #endif
src/Builds.hs view
@@ -9,7 +9,8 @@ parseBuildState', fedoraKojiHub, kojiBuildTypes,- latestCmd+ latestCmd,+ taggedCmd ) where @@ -23,6 +24,8 @@ import Data.Time.LocalTime import Distribution.Koji import Distribution.Koji.API+import Safe (headMay)+import SelectRPMs (selectDefault) import SimpleCmd import Text.Pretty.Simple @@ -33,6 +36,7 @@ import User import Utils (buildOutputURL) +-- FIXME NonEmptyString's data BuildReq = BuildBuild String | BuildPackage String | BuildQuery | BuildPattern String deriving Eq@@ -48,10 +52,10 @@ data Details = Detailed | DetailedTasks deriving Eq -buildsCmd :: Maybe String -> Maybe UserOpt -> Maybe Int -> [BuildState]- -> Maybe Tasks.BeforeAfter -> Maybe String -> Maybe Details+buildsCmd :: Maybe String -> Maybe UserOpt -> Maybe Limit -> [BuildState]+ -> Maybe Tasks.BeforeAfter -> Maybe String -> Maybe Details -> Bool -> Maybe Select -> Bool -> BuildReq -> IO ()-buildsCmd mhub museropt mlimit !states mdate mtype mdetails minstall debug buildreq = do+buildsCmd mhub museropt mlimit !states mdate mtype mdetails tail' minstall debug buildreq = do when (hub /= fedoraKojiHub && museropt == Just UserSelf) $ error' "--mine currently only works with Fedora Koji: use --user instead" tz <- getCurrentTimeZone@@ -63,9 +67,9 @@ then InfoID (read bld) else InfoString bld mbld <- getBuild hub bldinfo- whenJust (mbld >>= maybeBuildResult) $ printBuild hub tz mdetails debug minstall+ whenJust (mbld >>= maybeBuildResult) $ printBuild hub tz mdetails tail' debug minstall BuildPackage pkg -> do- when (head pkg == '-') $+ when (headMay pkg == Just '-') $ error' $ "bad combination: not a package: " ++ pkg when (isJust mdate) $ error' "cannot use --package together with timedate"@@ -75,21 +79,24 @@ Just pkgid -> do query <- setupQuery let fullquery = [("packageID", ValueInt pkgid),- commonBuildQueryOptions mlimit] ++ query+ commonBuildQueryOptions $+ maybeLimit defaultBuildsLimit mlimit]+ ++ query when debug $ print fullquery builds <- listBuilds hub fullquery when debug $ mapM_ pPrintCompact builds if isJust mdetails || length builds == 1- then mapM_ (printBuild hub tz mdetails debug minstall) $ mapMaybe maybeBuildResult builds+ then mapM_ (printBuild hub tz mdetails tail' debug minstall) $ mapMaybe maybeBuildResult builds else mapM_ putStrLn $ mapMaybe (shortBuildResult tz) builds _ -> do query <- setupQuery- let fullquery = query ++ [commonBuildQueryOptions mlimit]+ let fullquery = query ++ [commonBuildQueryOptions $+ maybeLimit defaultBuildsLimit mlimit] when debug $ print fullquery builds <- listBuilds hub fullquery when debug $ mapM_ pPrintCompact builds if isJust mdetails || length builds == 1- then mapM_ (printBuild hub tz mdetails debug minstall) $ mapMaybe maybeBuildResult builds+ then mapM_ (printBuild hub tz mdetails tail' debug minstall) $ mapMaybe maybeBuildResult builds else mapM_ putStrLn $ mapMaybe (shortBuildResult tz) builds where hub = maybe fedoraKojiHub hubURL mhub@@ -115,14 +122,21 @@ whenJust mdatestring $ \date -> putStrLn $ maybe "" show mdate +-+ date mowner <- maybeGetKojiUser hub museropt+ pat <-+ case buildreq of+ BuildPattern pat -> do+ -- FIXME remove after moving to newer koji-hs+ -- rpmfusion koji still doesn't support patterns (2024-09-20)+ when ("rpmfusion" `isInfixOf` hub) $+ error' "cannot use pattern with this kojihub"+ return [("pattern", ValueString pat)]+ _ -> return [] 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)]- _ -> []+ ++ pat dateString :: Tasks.BeforeAfter -> String -- make time refer to past not future@@ -173,9 +187,9 @@ return $ BuildResult nvr state buildid mtaskid start mend owner -printBuild :: String -> TimeZone -> Maybe Details -> Bool -> Maybe Select- -> BuildResult -> IO ()-printBuild hub tz mdetails debug minstall build = do+printBuild :: String -> TimeZone -> Maybe Details -> Bool -> Bool+ -> Maybe Select -> BuildResult -> IO ()+printBuild hub tz mdetails tail' debug minstall build = do putStrLn "" let mendtime = mbuildEndTime build time <- maybe getCurrentTime return mendtime@@ -183,12 +197,16 @@ when (buildState build == BuildComplete) $ putStrLn $ buildOutputURL hub $ buildNVR build whenJust (mbuildTaskId build) $ \taskid -> do- when (mdetails == Just DetailedTasks) $ do+ if mdetails == Just DetailedTasks+ then do putStrLn ""- Tasks.tasksCmd (Just hub) (Tasks.QueryOpts Nothing (Just 7) [] [] Nothing Nothing False Nothing) Nothing False False Nothing minstall (Tasks.ChildrenOf taskid)+ Tasks.tasksCmd (Just hub) Tasks.emptyQueryOpts Nothing tail' Tasks.BuildLog Nothing minstall (Tasks.ChildrenOf taskid)+ else+ when tail' $+ void $ cmdBool "koji" ["watch-task", show taskid] whenJust minstall $ \installopts -> do putStrLn ""- installCmd False debug No (Just hub) Nothing False False False Nothing [] Nothing Nothing installopts Nothing ReqNVR [showNVR (buildNVR build)]+ installCmd False debug No (Just hub) Nothing False False False Nothing [] Nothing Nothing installopts Nothing (Right ReqNVR) [showNVR (buildNVR build)] formatBuildResult :: String -> Bool -> TimeZone -> BuildResult -> [String] formatBuildResult hub ended tz (BuildResult nvr state buildid mtaskid start mendtime owner) =@@ -215,7 +233,10 @@ parseBuildState' :: String -> BuildState parseBuildState' s = case lower s of+ "build" -> BuildBuilding "building" -> BuildBuilding+ "open" -> BuildBuilding+ "run" -> BuildBuilding "complete" -> BuildComplete "deleted" -> BuildDeleted "fail" -> BuildFailed@@ -223,7 +244,7 @@ "cancel" -> BuildCanceled "canceled" -> BuildCanceled _ -> error' $! "unknown build state: " ++ s ++- "\nknown states are: building, complete, deleted, failed, canceled"+ "\nknown states are: build(ing), complete, deleted, fail(ed), cancel(ed)" kojiBuildTypes :: [String] kojiBuildTypes = ["all", "image", "maven", "module", "rpm", "win"]@@ -234,4 +255,21 @@ mbld <- kojiLatestBuild hub tag pkg when debug $ print mbld tz <- getCurrentTimeZone- whenJust (mbld >>= maybeBuildResult) $ printBuild hub tz (Just Detailed) debug Nothing+ whenJust (mbld >>= maybeBuildResult) $ printBuild hub tz (Just Detailed) False debug Nothing++-- FIXME select packages and rpms+taggedCmd :: Maybe String -> Bool -> String -> IO ()+taggedCmd mhub install tag = do+ let hub = maybe fedoraKojiHub hubURL mhub+ kblds <- kojiListTaggedBuilds hub install tag+-- when debug $ mapM_ print blds+-- tz <- getCurrentTimeZone+ -- forM_ (mapMaybe maybeBuildResult blds) $+ -- printBuild hub tz (Just Detailed) False debug Nothing+ mapM_ putKojiBuild kblds+ when install $+ installCmd False False No (Just hub) Nothing False False False Nothing [] Nothing Nothing selectDefault Nothing (Right ReqNVR) $ map kbNvr kblds+ where+ putKojiBuild :: KojiBuild -> IO ()+ putKojiBuild (KojiBuild _ _ owner nvr) =+ putStrLn $ nvr +-+ owner
src/Common.hs view
@@ -5,7 +5,12 @@ commonBuildQueryOptions, webUrl, getBuildState,- lookupArch+ lookupArch,+ Limit(..),+ maybeLimit,+ Natural,+ defaultBuildsLimit,+ defaultTasksLimit ) where @@ -13,6 +18,7 @@ import Data.List.Extra (dropSuffix, isPrefixOf) import Distribution.Koji (fedoraKojiHub, Value(..), Struct, BuildState, lookupStruct, readBuildState)+import Numeric.Natural (Natural) import SimpleCmd (error') -- mbox kojihub is locked@@ -34,7 +40,7 @@ commonQueryOptions :: Maybe Int -> String -> [(String, Value)] commonQueryOptions mlimit order = [("limit",ValueInt limit) | Just limit <- [mlimit]] ++- [ ("order",ValueString order)]+ [("order",ValueString order)] commonBuildQueryOptions :: Maybe Int -> (String, Value) commonBuildQueryOptions mlimit =@@ -50,3 +56,15 @@ -- see also https://pagure.io/koji/issue/4098 lookupArch :: Struct -> Maybe String lookupArch st = lookupStruct "label" st <|> lookupStruct "arch" st++data Limit =+ Nolimit | Limit Natural++maybeLimit :: Natural -> Maybe Limit -> Maybe Int+maybeLimit l Nothing = Just (fromEnum l)+maybeLimit _ (Just Nolimit) = Nothing+maybeLimit _ (Just (Limit l)) = Just (fromEnum l)++defaultBuildsLimit, defaultTasksLimit :: Natural+defaultBuildsLimit = 5+defaultTasksLimit = 20
src/Find.hs view
@@ -4,30 +4,33 @@ module Find ( findCmd,- wordsList+ wordsListHeads ) where import Data.Char ( isDigit, isAsciiLower, isAsciiUpper ) import Data.List.Extra ((\\), dropSuffix, isSuffixOf)-import Data.Maybe (listToMaybe)+import Data.Maybe (listToMaybe, mapMaybe) import Distribution.Koji- ( BuildState(BuildBuilding, BuildFailed, BuildComplete),- TaskState(TaskOpen, TaskFailed, TaskClosed) )+ (BuildState(BuildBuilding, BuildFailed, BuildComplete),+ TaskState(TaskOpen, TaskFailed, TaskClosed))+import Safe (headMay) import SimpleCmd (error', (+-+)) import qualified Builds+import Common (Limit(Limit)) import Install (Select(PkgsReq)) import qualified Tasks import User ( UserOpt(User, UserSelf) ) -data Words = Mine | Limit | Failure | Complete | Current | Build | Detail- | Install | Tail | NoTail | Hwinfo | Arch | Debug+data Words = Mine | Last | Failure | Complete | Current | Build | Detail+ | Install | Tail | NoTail | Hwinfo | Rootlog | Arch | Debug deriving (Enum,Bounded) +-- FIXME should be NonEmpty list findWords :: Words -> [String] findWords Mine = ["my","mine"]-findWords Limit = ["last","latest"]+findWords Last = ["last","latest"] findWords Failure = ["fail","failure","failed"] findWords Complete = ["complete","completed","completion", "close","closed",@@ -39,13 +42,19 @@ findWords Tail = ["tail"] findWords NoTail = ["notail"] findWords Hwinfo = ["hwinfo"]+findWords Rootlog = ["rootlog"] findWords Debug = ["debug", "dbg"] findWords Arch = ["x86_64", "aarch64", "ppc64le", "s390x", "i686", "armv7hl", "noarch"] -wordsList :: ([String] -> String) -> [String]-wordsList f =- map (f . findWords) [minBound..] ++ ["PACKAGE","USER\\'s","LIMIT"]+wordsListHeads :: [String]+wordsListHeads =+ mapMaybe (headMay . findWords) [minBound..] ++ ["PACKAGE","USER\\'s","LIMIT"] +wordsListAll :: [String]+wordsListAll =+ map (unwords . findWords) [minBound..] ++ ["PACKAGE","USER\\'s","LIMIT"]++ allWords :: [String] allWords = concatMap findWords [minBound..] @@ -55,7 +64,7 @@ -- FIXME: separate last and latest? findCmd :: Maybe String -> [String] -> IO () findCmd _ [] = error' $ "find handles these words:\n\n" ++- unlines (wordsList unwords)+ unlines wordsListAll findCmd mhub args = do let user = if hasWord Mine then Just UserSelf@@ -66,7 +75,7 @@ unwords more archs = if hasWord Arch then filter (`elem` findWords Arch) args else []- defaultlimit = Just $ if hasWord Limit then 1 else 10+ defaultlimit = Limit $ if hasWord Last then 1 else 10 failure = hasWord Failure complete = hasWord Complete current = hasWord Current@@ -75,7 +84,11 @@ install = hasWord Install tail' = hasWord Tail notail = hasWord NoTail- hwinfo = hasWord Hwinfo+ logfile = case (hasWord Hwinfo,hasWord Rootlog) of+ (True,True) -> error' "cannot combine hwinfo and rootlog"+ (True,False) -> Tasks.HWInfo+ (False,True) -> Tasks.RootLog+ (False,False) -> Tasks.BuildLog debug = hasWord Debug (limit,mpkg) = case removeUsers (args \\ allWords) of@@ -83,7 +96,7 @@ (num:pkgs) | all isDigit num && length pkgs < 2 -> let number = read num in if number < 1000- then (Just number, listToMaybe pkgs)+ then (Limit number, listToMaybe pkgs) else error' $ "is" +-+ num +-+ "an id? Use 'tasks' command for very large limits" -- FIXME allow pattern?@@ -101,12 +114,12 @@ [BuildBuilding|current] buildreq = maybe Builds.BuildQuery Builds.BuildPackage mpkg detailed = if detail then Just Builds.Detailed else Nothing- in Builds.buildsCmd mhub user limit states Nothing (Just "rpm") detailed installation debug buildreq+ in Builds.buildsCmd mhub user (Just limit) states Nothing (Just "rpm") detailed tail' installation debug buildreq else let states = [TaskFailed|failure] ++ [TaskClosed|complete] ++ [TaskOpen|current] taskreq = maybe Tasks.TaskQuery Tasks.Package mpkg- in Tasks.tasksCmd mhub (Tasks.QueryOpts user limit states archs Nothing Nothing debug Nothing) (if detail then Just Tasks.Detailed else Nothing) ((tail' || failure) && not notail) hwinfo Nothing installation taskreq+ in Tasks.tasksCmd mhub (Tasks.QueryOpts user (Just limit) states archs Nothing Nothing debug Nothing) (if detail then Just Tasks.Detailed else Nothing) ((tail' || failure) && not notail) logfile Nothing installation taskreq where hasWord :: Words -> Bool hasWord word = any (`elem` findWords word) args
src/Install.hs view
@@ -17,7 +17,6 @@ import Control.Monad.Extra import Data.Functor ((<&>)) import Data.List.Extra-import Data.Either (partitionEithers) import Data.Maybe import Data.RPM.NV hiding (name) import Data.RPM.NVR@@ -25,11 +24,12 @@ import Distribution.Koji import qualified Distribution.Koji.API as Koji import Network.HTTP.Directory (httpFileSize', httpLastModified', (+/+))+import SelectRPMs (Yes(..), PkgMgr(..), ExistingStrategy(..), Select(..),+ ExistNVRA, checkSelection, decideRPMs, installArgs,+ installRPMs, nvraToRPM, rpmsToNVRAs) import SimpleCmd-import SimplePrompt (yesNoDefault) import System.Directory import System.FilePath-import System.FilePath.Glob import System.IO import Text.Read (readMaybe) @@ -38,62 +38,9 @@ import Time import Utils -data Yes = No | Yes- deriving Eq--data Select = All- | Ask- | PkgsReq [String] [String] [String] [String] -- include, except, exclude, add- deriving Eq--installArgs :: String -> Select-installArgs cs =- case words cs of- ["-a"] -> All- ["--all"] -> All- ["-A"] -> Ask- ["--ask"] -> Ask- ws -> installPairs [] [] [] [] ws- where- installPairs :: [String] -> [String] -> [String] -> [String]- -> [String] -> Select- installPairs incl except excl add [] = PkgsReq incl except excl add- installPairs incl except excl add (w:ws)- | w `elem` ["-p","--package"] =- case ws of- [] -> error' "--install opts: --package missing value"- (w':ws') -> checkPat w' $- installPairs (w':incl) except excl add ws'- | w `elem` ["-e","--except"] =- case ws of- [] -> error' "--install opts: --except missing value"- (w':ws') -> checkPat w' $- installPairs incl (w':except) excl add ws'- | w `elem` ["-x","--exclude"] =- case ws of- [] -> error' "--install opts: --exclude missing value"- (w':ws') -> checkPat w' $- installPairs incl except (w':excl) add ws'- | w `elem` ["-i","--include"] =- case ws of- [] -> error' "--install opts: --include missing value"- (w':ws') -> checkPat w' $- installPairs incl except excl (w':add) ws'- | otherwise = error' "invalid --install opts"-- checkPat w' f =- if null w'- then error' "empty pattern!"- else f- data Request = ReqName | ReqNV | ReqNVR deriving Eq -data PkgMgr = DNF3 | DNF5 | RPM | OSTREE- deriving Eq--data ExistingStrategy = ExistingNoReinstall | ExistingSkip- -- FIXME autodetect NVR, NV, etc -- FIXME support buildid -- FIXME specify tag or task@@ -107,8 +54,8 @@ installCmd :: Bool -> Bool -> Yes -> Maybe String -> Maybe String -> Bool -> Bool -> Bool -> Maybe PkgMgr -> [String] -> Maybe ExistingStrategy -> Maybe String -> Select -> Maybe String- -> Request -> [String] -> IO ()-installCmd dryrun debug yes mhuburl mpkgsurl listmode latest checkremotetime mmgr archs mstrategy mprefix select mdisttag request pkgbldtsks = do+ -> Either () Request -> [String] -> IO ()+installCmd dryrun debug yes mhuburl mpkgsurl listmode latest checkremotetime mmgr archs mstrategy mprefix select mdisttag erequest pkgbldtsktag = do checkSelection select let huburl = maybe fedoraKojiHub hubURL mhuburl pkgsurl = fromMaybe (hubToPkgsURL huburl) mpkgsurl@@ -118,25 +65,32 @@ printDlDir <- setDownloadDir dryrun "koji-tool" when debug printDlDir setNoBuffering- buildrpms <- mapM (kojiRPMs huburl pkgsurl printDlDir) $ nubOrd pkgbldtsks+ (request,pkgbldtsks) <-+ case erequest of+ -- tagged+ Left () ->+ case pkgbldtsktag of+ [tag] -> do+ nvrs <- map kbNvr <$> kojiListTaggedBuilds huburl True tag+ return (ReqNVR,nvrs)+ _ -> error' "only one tag can be specified"+ Right req ->+ return (req,pkgbldtsktag)+ buildrpms <- mapM (kojiRPMs huburl pkgsurl request) $+ nubOrd pkgbldtsks+ printDlDir installRPMs dryrun debug mmgr yes buildrpms where- checkSelection :: Monad m => Select -> m ()- checkSelection (PkgsReq ps es xs is) =- forM_ (ps ++ es ++ xs ++ is) $ \s ->- when (null s) $ error' "empty package pattern not allowed"- checkSelection _ = return ()-- kojiRPMs :: String -> String -> IO () -> String- -> IO (FilePath, [(Existence,NVRA)])- kojiRPMs huburl pkgsurl printDlDir bldtask =+ kojiRPMs :: String -> String -> Request -> String+ -> IO (FilePath,[ExistNVRA])+ kojiRPMs huburl pkgsurl request bldtask = case readMaybe bldtask of- Just taskid -> kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode archs mstrategy mprefix select checkremotetime printDlDir taskid- Nothing -> kojiBuildRPMs huburl pkgsurl printDlDir bldtask+ Just taskid -> kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode archs mstrategy mprefix select checkremotetime taskid+ Nothing -> kojiBuildRPMs huburl pkgsurl request bldtask - kojiBuildRPMs :: String -> String -> IO () -> String- -> IO (FilePath, [(Existence,NVRA)])- kojiBuildRPMs huburl pkgsurl printDlDir pkgbld = do+ kojiBuildRPMs :: String -> String -> Request -> String+ -> IO (FilePath,[ExistNVRA])+ kojiBuildRPMs huburl pkgsurl request pkgbld = do disttag <- case mdisttag of Just dt -> return dt@@ -147,31 +101,28 @@ case nvrs of [] -> error' $ pkgbld ++ " not found for " ++ disttag [nvr] -> do- putStrLn $ showNVR nvr ++ "\n"+ putStrLn $ showNVR nvr ++ ":" bid <- kojiGetBuildID' huburl (showNVR nvr) -- FIXME should we try kojiTaskRPMs first?- nvras <- sort . map readNVRA . filter notDebugPkg <$> kojiGetBuildRPMs huburl nvr archs bid+ nvras <- rpmsToNVRAs <$> kojiGetBuildRPMs huburl nvr archs bid results <- if null nvras then do mtid <- kojiGetBuildTaskID huburl (showNVR nvr) case mtid of Just (TaskId tid) ->- kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode archs mstrategy mprefix select checkremotetime printDlDir tid+ kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode archs mstrategy mprefix select checkremotetime tid Nothing -> error' $ "task id not found for" +-+ showNVR nvr else do when debug $ mapM_ (putStrLn . showNVRA) nvras let prefix = fromMaybe (nvrName nvr) mprefix- dlRpms <- decideRpms yes listmode mstrategy select prefix nvras- when debug $ mapM_ printInstalled dlRpms+ dlRpms <- decideRPMs yes listmode mstrategy select prefix nvras let subdir = showNVR nvr unless listmode $ do unless (dryrun || null dlRpms) $ do bld <- kojiGetBuild' huburl nvr -- FIXME should be NVRA ideally downloadRpms debug checkremotetime (lookupStartEndTimes' bld) subdir (buildURL nvr) dlRpms- -- FIXME once we check file size - can skip if no downloads- printDlDir return (subdir,dlRpms) return $ if listmode@@ -190,14 +141,10 @@ let arch = rpmArch (readNVRA rpm) in pkgsurl +/+ n +/+ v +/+ r +/+ arch +/+ rpm -notDebugPkg :: String -> Bool-notDebugPkg p =- not ("-debuginfo-" `isInfixOf` p || "-debugsource-" `isInfixOf` p)- kojiTaskRPMs :: Bool -> Bool -> Yes -> String -> String -> Bool -> [String] -> Maybe ExistingStrategy -> Maybe String -> Select -> Bool- -> IO () -> Int -> IO (FilePath, [(Existence,NVRA)])-kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode archs mstrategy mprefix select checkremotetime printDlDir taskid = do+ -> Int -> IO (FilePath,[ExistNVRA])+kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode archs mstrategy mprefix select checkremotetime taskid = do mtaskinfo <- Koji.getTaskInfo huburl taskid True tasks <- case mtaskinfo of Nothing -> error' "failed to get taskinfo"@@ -213,7 +160,7 @@ when debug $ print taskinfo >> putStrLn "" return [taskinfo] _ -> error' $ "unsupport method: " ++ method- totalarchs <- getArchs archs+ totalarchs <- map kojiTaskArch <$> getArchs archs let (archtid,archtask) = case find (selectBuildArch totalarchs) tasks of Nothing -> error' $ "no task found for" +-+ unwords totalarchs@@ -234,17 +181,15 @@ return $ either id nvrName $ kojiTaskRequestNVR archtask if listmode then do- drpms <- decideRpms yes listmode mstrategy select prefix nvras- return ("",drpms)+ rpms <- decideRPMs yes listmode mstrategy select prefix nvras+ return ("",rpms) else do when debug $ print $ map showNVRA nvras- dlRpms <- decideRpms yes listmode mstrategy select prefix $- filter ((/= "src") . rpmArch) nvras- when debug $ mapM_ printInstalled dlRpms let subdir = show archtid- unless (dryrun || null dlRpms) $ do+ dlRpms <- decideRPMs yes listmode mstrategy select prefix $+ filter ((/= "src") . rpmArch) nvras+ unless (dryrun || null dlRpms) $ downloadRpms debug checkremotetime (lookupStartEndTimes' archtask) subdir (taskRPMURL archtid) dlRpms- printDlDir return (subdir,dlRpms) where selectBuildArch :: [String] -> Struct -> Bool@@ -258,7 +203,7 @@ getTaskNVRAs taskid' = -- FIXME get stats to show size Koji.listTaskOutput huburl taskid' False True False <&>- sort . map readNVRA . filter notDebugPkg . filter (".rpm" `isExtensionOf`) . map fst+ rpmsToNVRAs . filter (".rpm" `isExtensionOf`) . map fst taskRPMURL :: Int -> String -> String taskRPMURL taskid' rpm =@@ -273,148 +218,13 @@ [] -> ("noarch" :) <$> cmdLines "rpm" ["--eval", "%{_arch}"] ars -> return ars -data Existence = ExistingNVR | ChangedNVR | NotInstalled- deriving (Eq, Ord, Show)---- FIXME determine and add missing internal deps-decideRpms :: Yes -> Bool -> Maybe ExistingStrategy -> Select -> String- -> [NVRA] -> IO [(Existence,NVRA)]-decideRpms yes listmode mstrategy select prefix nvras = do- classified <- mapMaybeM installExists (filter isBinaryRpm nvras)- if listmode- then do- case select of- PkgsReq subpkgs exceptpkgs exclpkgs addpkgs ->- mapM_ printInstalled $- selectRPMs prefix (subpkgs,exceptpkgs,exclpkgs,addpkgs) classified- _ -> mapM_ printInstalled classified- return []- else- case select of- All -> promptPkgs yes classified- Ask -> mapMaybeM (rpmPrompt yes) classified- PkgsReq subpkgs exceptpkgs exclpkgs addpkgs ->- promptPkgs yes $- selectRPMs prefix (subpkgs,exceptpkgs,exclpkgs,addpkgs) classified- where- installExists :: NVRA -> IO (Maybe (Existence, NVRA))- installExists nvra = do- -- FIXME this will fail for noarch changes- -- FIXME check kernel- minstalled <- cmdMaybe "rpm" ["-q", rpmName nvra <.> rpmArch nvra]- let existence =- case minstalled of- Nothing -> NotInstalled- Just installed ->- if showNVRA nvra `elem` lines installed- then ExistingNVR- else ChangedNVR- return $- case mstrategy of- Just ExistingSkip | existence /= NotInstalled -> Nothing- Just ExistingNoReinstall | existence == ExistingNVR -> Nothing- _ -> Just (existence, nvra)--renderInstalled :: (Existence, NVRA) -> String-renderInstalled (exist, nvra) =- case exist of- ExistingNVR -> '='- ChangedNVR -> '^'- NotInstalled -> '+'- : showNVRA nvra--printInstalled :: (Existence, NVRA) -> IO ()-printInstalled = putStrLn . renderInstalled--defaultRPMs :: [(Existence,NVRA)] -> [(Existence,NVRA)]-defaultRPMs rpms =- let installed = filter ((/= NotInstalled) . fst) rpms- in if null installed- then rpms- else installed--matchingRPMs :: String -> [String] -> [(Existence,NVRA)] -> [(Existence,NVRA)]-matchingRPMs prefix subpkgs rpms =- nubSort . mconcat $- flip map (nubOrd subpkgs) $ \ pkgpat ->- case getMatches pkgpat of- [] -> if head pkgpat /= '*'- then- case getMatches (prefix ++ '-' : pkgpat) of- [] -> error' $ "no subpackage match for " ++ pkgpat- result -> result- else error' $ "no subpackage match for " ++ pkgpat- result -> result- where- getMatches :: String -> [(Existence,NVRA)]- getMatches pkgpat =- filter (match (compile pkgpat) . rpmName . snd) rpms--nonMatchingRPMs :: String -> [String] -> [(Existence,NVRA)] -> [(Existence,NVRA)]-nonMatchingRPMs _ [] _ = []-nonMatchingRPMs prefix subpkgs rpms =- -- FIXME somehow determine unused excludes- nubSort $ foldl' (exclude (nubOrd subpkgs)) [] rpms- where- rpmnames = map (rpmName . snd) rpms-- exclude :: [String] -> [(Existence,NVRA)] -> (Existence,NVRA)- -> [(Existence,NVRA)]- exclude [] acc rpm = acc ++ [rpm]- exclude (pat:pats) acc rpm =- if checkMatch (rpmName (snd 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 ||- pat `notElem` rpmnames &&- (prefix ++ '-' : pat) == rpmname- else match comppat rpmname--selectRPMs :: String- -> ([String],[String],[String],[String]) -- (subpkgs,except,exclpkgs,addpkgs)- -> [(Existence,NVRA)] -> [(Existence,NVRA)]-selectRPMs prefix (subpkgs,exceptpkgs,exclpkgs,addpkgs) rpms =- let excluded = matchingRPMs prefix exclpkgs rpms- included = matchingRPMs prefix addpkgs rpms- matching =- if null subpkgs && null exceptpkgs- then defaultRPMs rpms- else matchingRPMs prefix subpkgs rpms- nonmatching = nonMatchingRPMs prefix exceptpkgs rpms- in nubSort $ ((matching ++ nonmatching) \\ excluded) ++ included--promptPkgs :: Yes -> [(Existence,NVRA)] -> IO [(Existence,NVRA)]-promptPkgs _ [] = error' "no rpms found"-promptPkgs yes classified = do- mapM_ printInstalled classified- ok <- prompt yes "install above"- return $ if ok then classified else []--prompt :: Yes -> String -> IO Bool-prompt yes str = do- if yes == Yes- then return True- else yesNoDefault True str--rpmPrompt :: Yes -> (Existence,NVRA) -> IO (Maybe (Existence,NVRA))-rpmPrompt yes (exist,nvra) = do- ok <- prompt yes $ renderInstalled (exist,nvra)- return $- if ok- then Just (exist,nvra)- else Nothing- kojiBuildOSBuilds :: Bool -> String -> Bool -> Bool -> String -> Request -> String -> IO [String] kojiBuildOSBuilds debug hub listmode latest disttag request pkgpat = do when debug $ putStrLn pkgpat let (pkg,full) = packageOfPattern request pkgpat- -- FIXME recheck koji version+ -- FIXME remove after moving to newer koji-hs+ -- rpmfusion koji still doesn't support patterns (2024-09-20) oldkoji = "rpmfusion" `isInfixOf` hub when debug $ print (pkg,full) when debug $ putStrLn pkg@@ -488,92 +298,13 @@ hSetBuffering stdin NoBuffering hSetBuffering stdout NoBuffering -data InstallType = ReInstall | Install---- FIXME support options per build: install ibus imsettings -i plasma--- (or don't error if multiple packages)-installRPMs :: Bool -> Bool -> Maybe PkgMgr -> Yes- -> [(FilePath,[(Existence,NVRA)])] -> IO ()-installRPMs _ _ _ _ [] = return ()-installRPMs dryrun debug mmgr yes classified = do- case installTypes classified of- ([],is) -> doInstall Install is- (ris,is) -> do- doInstall ReInstall (ris ++ is) -- include any new deps- doInstall Install is -- install any non-deps- where- doInstall :: InstallType -> [(FilePath,NVRA)] -> IO ()- doInstall inst dirpkgs =- unless (null dirpkgs) $ do- mgr <-- case mmgr of- Just m -> return m- Nothing -> do- ostree <- doesDirectoryExist "/sysroot/ostree"- if ostree- then return OSTREE- else do- mdnf5 <- findExecutable "dnf5"- return $ maybe DNF3 (const DNF5) mdnf5- let pkgmgr =- case mgr of- DNF3 -> "dnf-3"- DNF5 -> "dnf5"- RPM -> "rpm"- OSTREE -> "rpm-ostree"- com =- case inst of- ReInstall -> reinstallCommand mgr- Install -> installCommand mgr- in- if dryrun- then mapM_ putStrLn $ ("would" +-+ unwords (pkgmgr : com) ++ ":") : map showRpmFile dirpkgs- else do- when debug $ mapM_ (putStrLn . showRpmFile) dirpkgs- (case mgr of- OSTREE -> cmd_- _ -> sudo_) pkgmgr $- com ++ map showRpmFile dirpkgs ++ ["--assumeyes" | yes == Yes && mgr `elem` [DNF3,DNF5]]-- installTypes :: [(FilePath,[(Existence,NVRA)])]- -> ([(FilePath,NVRA)],[(FilePath,NVRA)])- installTypes = partitionEithers . concatMap mapDir- where- mapDir :: (FilePath,[(Existence,NVRA)])- -> [Either (FilePath,NVRA) (FilePath,NVRA)]- mapDir (dir,cls) =- map (\(e,n) -> combineExist e (dir,n)) cls-- combineExist e = if e == ExistingNVR then Left else Right-- reinstallCommand :: PkgMgr -> [String]- reinstallCommand mgr =- case mgr of- DNF3 -> ["reinstall"]- DNF5 -> ["reinstall"]- RPM -> ["-Uvh","--replacepkgs"]- OSTREE -> ["install"]-- installCommand :: PkgMgr -> [String]- installCommand mgr =- case mgr of- DNF3 -> ["localinstall"]- DNF5 -> ["install"]- RPM -> ["-ivh"]- OSTREE -> ["install"]--showRpm :: NVRA -> FilePath-showRpm nvra = showNVRA nvra <.> "rpm"--showRpmFile :: (FilePath,NVRA) -> FilePath-showRpmFile (dir,nvra) = dir </> showRpm nvra- downloadRpms :: Bool -> Bool -> (UTCTime, UTCTime) -> FilePath- -> (String -> String) -> [(Existence,NVRA)] -> IO ()+ -> (String -> String) -> [ExistNVRA] -> IO () downloadRpms debug checkremotetime (taskstart,taskend) subdir urlOf rpms = do urls <- fmap catMaybes <$>- forM (map (showRpm . snd) rpms) $ \rpm -> do- let rpmfile = subdir </> rpm+ forM rpms $ \(_,nvra) -> do+ let rpm = nvraToRPM nvra+ rpmfile = subdir </> rpm exists <- doesFileExist rpmfile let url = urlOf rpm notfile <-@@ -593,7 +324,7 @@ return $ if notfile then Just url else Nothing unless (null urls) $ do putStrLn "downloading..."- cmd_ "curl" $ ["--remote-time", "--fail", "-C-", "--show-error", "--create-dirs", "--output-dir", subdir, "--remote-name-all", "--write-out", "%{filename_effective}\n"] ++ ["--progress-bar" | not debug] ++ urls+ cmd_ "curl" $ ["--remote-time", "--fail", "--fail-early", "-C-", "--show-error", "--create-dirs", "--output-dir", subdir, "--remote-name-all", "--write-out", "%{filename_effective}\n"] ++ ["--progress-bar" | not debug] ++ urls where outOfDate :: String -> String -> IO Bool outOfDate file url = do@@ -628,9 +359,6 @@ -- method <- lookupStruct "method" struct -- taskid <- lookupStruct "id" struct -- return $ arch ++ replicate (8 - length arch) ' ' +-+ show (taskid :: Int) +-+ method +-+ show state--isBinaryRpm :: NVRA -> Bool-isBinaryRpm = (/= "src") . rpmArch #if !MIN_VERSION_filepath(1,4,2) isExtensionOf :: String -> FilePath -> Bool
src/Main.hs view
@@ -6,11 +6,13 @@ import Data.Char (isDigit) import Data.List.Extra+import SelectRPMs (existingStrategyOption, selectRpmsOptions) import SimpleCmd import SimpleCmdArgs import Builds import BuildlogSizes+import Common (Limit(..), Natural, defaultBuildsLimit, defaultTasksLimit) import User import Install import qualified Paths_koji_tool@@ -29,16 +31,15 @@ buildsCmd <$> hubOpt <*> optional (userOpt False)- <*> (flagWith' (Just 1) 'L' "latest" "Latest build" <|>- flagWith' Nothing 'U' "unlimited" "No limit on number of results" <|>- Just <$> optionalWith auto 'l' "limit" "INT" "Maximum number of builds to show [default: 20]" 20)+ <*> optional (limitOpt "build" defaultBuildsLimit) <*> 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)))+ <*> (fmap normalizeBuildType <$> optional (strOptionLongWith "type" "TYPE" ("Select builds by type: " ++ intercalate "," kojiBuildTypes))) <*> optional (flagWith' Builds.Detailed 'd' "details" "Show more build details" <|> flagWith' Builds.DetailedTasks 't' "tasks" "Show details and tasks")+ <*> tailOpt <*> optional (installArgs <$> strOptionWith 'i' "install" "INSTALLOPTS" "Install the package with 'install' options") <*> switchWith 'D' "debug" "Pretty-print raw XML result" <*> (BuildBuild <$> strOptionWith 'b' "build" "NVR/BUILDID" "Show build" <|>@@ -54,12 +55,13 @@ <*> optional (flagWith' Tasks.Detailed 'd' "details" "Show more task details" <|> flagWith' Tasks.Concise 'c' "concise" "Compact task output")- -- FIXME error if integer (eg mistakenly taskid)- <*> switchWith 'T' "tail" "Fetch the tail of build.log"- <*> switchLongWith "hw-info" "Fetch hw_info.log"+ <*> tailOpt+ <*> (flagLongWith' HWInfo "hw-info" "Fetch hw_info.log" <|>+ flagLongWith BuildLog RootLog "rootlog" "Fetch root.log") <*> optional (strOptionWith 'g' "grep" "STRING" "Filter matching log lines") <*> optional (installArgs <$> strOptionWith 'i' "install" "INSTALLOPTS" "Install the package with 'install' options") <*> taskReqOpt+ , Subcommand "latest" "Query latest Koji build for tag" $ latestCmd@@ -83,30 +85,40 @@ <*> switchWith 't' "check-remote-time" "Check remote rpm timestamps" <*> optional pkgMgrOpt <*> many archOpt- <*> optional existingOpt+ <*> optional existingStrategyOption <*> optional (strOptionWith 'b' "prefix" "SUBPKGPREFIX" "Prefix to use for subpackages [default: base package]")- <*> selectOpt+ <*> selectRpmsOptions <*> optional disttagOpt- <*> (flagWith' ReqNVR 'R' "nvr" "Give an N-V-R instead of package name" <|>- flagWith ReqName ReqNV 'V' "nv" "Give an N-V instead of package name")- <*> some (strArg "PKG|NVR|TASKID...")+ <*> (flagLongWith' (Left ()) "tagged" "Give a tag instead of package name" <|>+ flagWith' (Right ReqNVR) 'R' "nvr" "Give an N-V-R instead of package name" <|>+ flagWith (Right ReqName) (Right ReqNV) 'V' "nv" "Give an N-V instead of (default) package name")+ <*> some (strArg "PKG|NVR|TASKID|TAG...") , Subcommand "progress" "Track running Koji tasks by buildlog size" $ progressCmd- <$> switchWith 'm' "modules" "Track module builds"+ <$> switchLongWith "modules" "Track module builds" <*> queryOpts True "build" <*> taskReqOpt , Subcommand "buildlog-sizes" "Show buildlog sizes for nvr patterns" $- buildlogSizesCmd <$> strArg "NVRPATTERN|PKG|TASKID"+ buildlogSizesCmd+ <$> optional (limitOpt "build" defaultBuildsLimit)+ <*> strArg "NVRPATTERN|PKG|TASKID" , Subcommand "find" ("Simple quick common queries using words like: [" ++- intercalate ", " (wordsList head) ++ "]") $+ intercalate ", " wordsListHeads ++ "]") $ findCmd <$> hubOpt <*> many (strArg "PHRASE")++ , Subcommand "tagged"+ "List builds for tag" $+ taggedCmd+ <$> hubOpt+ <*> switchWith 'i' "install" "Install packages"+ <*> strArg "TAG" ] where hubOpt = optional (strOptionWith 'H' "hub" "HUB"@@ -119,16 +131,6 @@ User <$> strOptionWith 'u' "user" "USER" "Koji user" <|> if mine then pure UserSelf else flagWith' UserSelf 'M' "mine" "Your tasks (krb fasid)" - selectOpt :: Parser Select- selectOpt =- flagLongWith' All "all" "all subpackages [default if not installed]" <|>- flagLongWith' Ask "ask" "ask for each subpackage" <|>- PkgsReq- <$> many (strOptionWith 'p' "package" "SUBPKG" "select subpackage (glob) matches")- <*> many (strOptionWith 'e' "except" "SUBPKG" "select subpackages not matching (glob)")- <*> many (strOptionWith 'x' "exclude" "SUBPKG" "deselect subpackage (glob): overrides -p and -e")- <*> many (strOptionWith 'i' "include" "SUBPKG" "additional subpackage (glob) to install: overrides -x")- disttagOpt :: Parser String disttagOpt = startingDot <$> strOptionWith 'd' "disttag" "DISTTAG"@@ -162,11 +164,6 @@ flagLongWith' DNF5 "dnf5" "Use dnf5 to install" <|> flagLongWith' DNF3 "dnf3" "Use dnf-3 to install [default dnf unless ostree]" - existingOpt :: Parser ExistingStrategy- existingOpt =- flagWith' ExistingNoReinstall 'N' "no-reinstall" "Do not reinstall existing NVRs" <|>- flagWith' ExistingSkip 'S' "skip-existing" "Ignore already installed subpackages (implies --no-reinstall)"- -- FIXME check valid arch (eg i686 not i386) archOpt = strOptionWith 'a' "arch" "ARCH" "Task arch" @@ -174,9 +171,7 @@ queryOpts mine defaultMethod = QueryOpts <$> optional (userOpt mine)- <*> (flagWith' (Just 1) 'L' "latest" "Latest build or task" <|>- flagWith' Nothing 'U' "unlimited" "No limit on number of results" <|>- Just <$> optionalWith auto 'l' "limit" "INT" "Maximum number of tasks to show [default: 20]" 20)+ <*> optional (limitOpt "build/task" defaultTasksLimit) <*> many (fmap parseTaskState' $! strOptionWith 's' "state" "STATE" "Filter tasks by state (open,close(d),cancel(ed),fail(ed),assigned,free)") <*> many archOpt <*> optional (Before <$> strOptionWith 'B' "before" "TIMESTAMP" "Tasks completed before timedate [default: now]" <|>@@ -186,6 +181,7 @@ <*> 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") + -- FIXME error if integer (eg mistakenly taskid) instead of string taskReqOpt = Build <$> strOptionWith 'b' "build" "BUILD" "List child tasks of build" <|> Pattern <$> strOptionWith 'p' "pattern" "NVRPAT" "Build tasks of matching pattern"@@ -193,3 +189,11 @@ <|> ParentOf <$> optionLongWith auto "parent" "TASKID" "Parent of task" <|> argumentWith (maybeReader readTaskReq) "PACKAGE|TASKID" <|> pure TaskQuery++ limitOpt :: String -> Natural -> Parser Limit+ limitOpt tgt dflt =+ flagWith' (Limit 1) 'L' "latest" ("Latest" +-+ tgt) <|>+ flagWith' Nolimit 'U' "unlimited" "No limit on number of results" <|>+ Limit <$> optionWith auto 'l' "limit" "INT" ("Maximum number of" +-+ tgt ++ "s to show [default:" +-+ show dflt ++ "]")++ tailOpt = switchWith 'T' "tail" "Fetch the tail of build.log"
src/Progress.hs view
@@ -198,10 +198,8 @@ printLogStatuses header tz statuses let news = map (\(task',(s,t),_) -> TaskInfoStatus task' (mkTaskStatus s t (getTaskState task'))) statuses (open,closed) = partition (\tis -> getTaskState (taskInfo tis) `elem` map Just openTaskStates) news- mlargest = if not (any (\tis -> lookupStruct "method" (taskInfo tis) /= Just ("buildSRPMFromSCM" :: String)) closed)- then Nothing- else maximumMay $ mapMaybe (\t -> taskStatus t >>= tstLog <&> logSize) closed- mbiggest = max mlargest msize+ closedbuilds = filter (\tis -> lookupStruct "method" (taskInfo tis) == Just ("buildArch" :: String)) closed+ mbiggest = maximumMay $ maybeToList msize ++ mapMaybe (\t -> taskStatus t >>= tstLog <&> logSize) closedbuilds if null open then runProgress (BuildTask tid start mend mbiggest []) else return $ BuildTask tid start mend mbiggest open
src/Tasks.hs view
@@ -7,7 +7,9 @@ TaskReq(..), BeforeAfter(..), QueryOpts(..),+ emptyQueryOpts, Details(..),+ LogFile(..), tasksCmd, getTasks, parseTaskState',@@ -17,6 +19,7 @@ ) where +import Control.Applicative ((<|>)) import Control.Monad.Extra import qualified Data.ByteString.Lazy.UTF8 as U import Data.Char (isDigit, toUpper)@@ -33,6 +36,7 @@ import Formatting hiding (now) import Network.HTTP.Directory import Network.HTTP.Simple+import Safe (headMay, lastMay) import SimpleCmd import System.FilePath import Text.Pretty.Simple@@ -74,7 +78,7 @@ data QueryOpts = QueryOpts { qmUserOpt :: Maybe UserOpt,- qLimit :: Maybe Int,+ qLimit :: Maybe Limit, qStates :: ![TaskState], qArchs :: ![String], qmDate :: Maybe BeforeAfter,@@ -82,6 +86,10 @@ qDebug :: Bool, qmFilter :: Maybe TaskFilter} +emptyQueryOpts :: QueryOpts+emptyQueryOpts =+ QueryOpts Nothing Nothing [] [] Nothing Nothing False Nothing+ data Details = Detailed | Concise deriving Eq @@ -92,9 +100,9 @@ -- FIXME --output-fields -- FIXME default to 'build' for install or try 'build' after 'buildarch'? -- FIXME `-# 2` etc to select second result-tasksCmd :: Maybe String -> QueryOpts -> Maybe Details -> Bool -> Bool+tasksCmd :: Maybe String -> QueryOpts -> Maybe Details -> Bool -> LogFile -> Maybe String -> Maybe Select -> TaskReq -> IO ()-tasksCmd mhub queryopts@QueryOpts{..} mdetails tail' hwinfo mgrep minstall taskreq = do+tasksCmd mhub queryopts@QueryOpts{..} mdetails tail' logfile mgrep minstall taskreq = do when (hub /= fedoraKojiHub && qmUserOpt == Just UserSelf) $ error' "--mine currently only works with Fedora Koji: use --user instead" tz <- getCurrentTimeZone@@ -133,21 +141,22 @@ if details == Detailed then do putStrLn ""- -- FIX for parent/build method show children (like we do with taskid)+ -- FIXME for parent/build method show children (like we do with taskid) (mapM_ putStrLn . formatTaskResult hub mtime tz) task if taskMethod task == "build" then do when (mdetails == Just Detailed) $ getTasks tz hub queryopts (ChildrenOf $ taskId task) >>=+ -- FIXME interleave newlines mapM_ (printTask details tz) . mapMaybe maybeTaskResult- else buildlogSize qDebug tz tail' hwinfo mgrep hub task+ else buildlogSize qDebug tz tail' logfile mgrep hub task else do (putStrLn . compactTaskResult hub tz) task- when (tail' || hwinfo || isJust mgrep) $- buildlogSize qDebug tz tail' hwinfo mgrep hub task+ when (tail' || logfile /= BuildLog || isJust mgrep) $+ buildlogSize qDebug tz tail' logfile mgrep hub task whenJust minstall $ \installopts -> do putStrLn ""- installCmd False qDebug No (Just hub) Nothing False False False Nothing [] Nothing Nothing installopts Nothing ReqName [show (taskId task)]+ installCmd False qDebug No (Just hub) Nothing False False False Nothing [] Nothing Nothing installopts Nothing (Right ReqName) [show (taskId task)] maybeTaskResult :: Struct -> Maybe TaskResult maybeTaskResult st = do@@ -210,7 +219,7 @@ Just (TaskId taskid) -> getTasks tz hub queryopts $ ChildrenOf taskid Nothing -> error' $ "no taskid found for build" +-+ bld Package pkg -> do- when (head pkg == '-') $+ when (headMay pkg == Just '-') $ error' $ "bad combination: not a package" +-+ pkg when (isJust qmDate || isJust qmFilter) $ -- FIXME why not?@@ -221,7 +230,8 @@ Just pkgid -> do builds <- listBuilds hub [("packageID", ValueInt pkgid),- commonBuildQueryOptions qLimit]+ commonBuildQueryOptions $+ maybeLimit defaultBuildsLimit qLimit] fmap concat <$> forM builds $ \bld -> do let mtaskid = (fmap TaskId . lookupStruct "task_id") bld@@ -240,8 +250,13 @@ Just tid -> getTasks tz hub queryopts {qLimit = Nothing} $ Task tid Pattern pat -> do let buildquery = [("pattern", ValueString pat),- commonBuildQueryOptions qLimit]+ commonBuildQueryOptions $+ maybeLimit defaultBuildsLimit qLimit] when qDebug $ print buildquery+ -- FIXME remove after moving to newer koji-hs+ -- rpmfusion koji still doesn't support patterns (2024-09-20)+ when ("rpmfusion" `isInfixOf` hub) $+ error' "cannot use pattern with this kojihub" builds <- listBuilds hub buildquery when qDebug $ print builds fmap concat <$>@@ -252,7 +267,7 @@ Nothing -> return [] _ -> do query <- setupQuery- let qopts = commonQueryOptions qLimit "-id"+ let qopts = commonQueryOptions (maybeLimit defaultTasksLimit qLimit) "-id" when qDebug $ print $ query ++ qopts listTasks hub query qopts where@@ -278,18 +293,13 @@ commonParams = [("decode", ValueBool True)] ++ [("state", ValueArray (map taskStateToValue qStates)) | notNull qStates]- ++ [("arch", ValueArray (map (ValueString . kojiArch) qArchs)) | notNull qArchs]+ ++ [("arch", ValueArray (map (ValueString . kojiTaskArch) qArchs)) | notNull qArchs] ++ [("method", ValueString method) | let method = fromMaybe defaultTaskMethod qmMethod] capitalize :: String -> String capitalize "" = "" capitalize (h:t) = toUpper h : t - kojiArch :: String -> String- kojiArch "i686" = "i386"- kojiArch "armv7hl" = "armhfp"- kojiArch a = a- dateString :: BeforeAfter -> String -- make time refer to past not future dateString beforeAfter =@@ -338,13 +348,10 @@ [formatLocalTime CompletionEvent tz end | Just end <- [mend]] #if MIN_VERSION_time(1,9,1) ++- ["delay:" +-+ renderDuration False dur | Just start <- [mstart], let dur = diffUTCTime start create]- ++- case mtime of- Just now ->- ["current duration:" +-+ renderDuration False dur | Just start <- [mstart], let dur = diffUTCTime now start]- Nothing ->- ["duration:" +-+ renderDuration False dur | Just start <- [mstart], Just end <- [mend], let dur = diffUTCTime end start]+ case mtime <|> mend of+ Just end ->+ [(if isJust mtime then "current" else "") +-+ "duration:" +-+ renderDuration False dur +-+ '(' : "start delay" +-+ renderDuration False delay ++ ")" | Just start <- [mstart], let dur = diffUTCTime end start, let delay = diffUTCTime start create]+ Nothing -> [] #endif showPackage :: Either String NVR -> String@@ -407,46 +414,45 @@ then return ma1 else mact2 -tailLogUrl :: String -> Int -> LogFile -> String-tailLogUrl hub taskid file =- webUrl hub +/+ "getfile?taskID=" ++ show taskid ++ "&name=" ++ logFile file ++ "&offset=-6000"+-- FIXME moffset not actually used yet+tailLogUrl :: String -> Int -> LogFile -> Maybe Int -> String+tailLogUrl hub taskid file moffset =+ webUrl hub +/+ "getfile?taskID=" ++ show taskid ++ "&name=" ++ logFile file ++ "&offset=" ++ maybe "-6000" show moffset logFile :: LogFile -> String logFile RootLog = "root.log" logFile BuildLog = "build.log" logFile HWInfo = "hw_info.log" -buildlogSize :: Bool -> TimeZone -> Bool -> Bool -> Maybe String -> String+buildlogSize :: Bool -> TimeZone -> Bool -> LogFile -> Maybe String -> String -> TaskResult -> IO ()-buildlogSize _debug tz tail' hwinfo mgrep hub task = do+buildlogSize debug tz tail' logfile mgrep hub task = do murl <- findOutputURL hub task+ when debug $ print murl whenJust murl $ \ url -> do let buildlog = url +/+ logFile BuildLog+ when debug $ print buildlog exists <- httpExists' buildlog if exists then do- putStr buildlog (msize,mtime) <- httpFileSizeTime' buildlog whenJust msize $ \size -> do+ putStr buildlog fprint (" (" % commas % "kB)") (size `div` 1000) when (taskState task == TaskOpen) $ whenJust mtime $ \time -> putStr $ " (" ++ compactZonedTime tz time ++ ")" putChar '\n' -- FIXME check if short build.log ends with srpm- file <-- if hwinfo- then do- putStr $ url +/+ logFile HWInfo- return HWInfo- else- -- for buildroot failure build.log could be ~3082 bytes- if size < 4000- then do- putStr $ url +/+ logFile RootLog- return RootLog- else return BuildLog- when (tail' || hwinfo || isJust mgrep) $ displayLog url file+ let file =+ if logfile == BuildLog && size < 4000+ then RootLog+ else logfile+ unless (file == BuildLog) $+ putStrLn $ url +/+ logFile file+ when (tail' || logfile /= BuildLog || isJust mgrep) $ do+ displayLog url file+ (putStrLn . compactTaskResult hub tz) task else do let rootlog = url +/+ logFile RootLog whenM (httpExists' rootlog) $@@ -456,7 +462,7 @@ displayLog url file = do let logurl = case file of- BuildLog -> tailLogUrl hub (taskId task) file+ BuildLog -> tailLogUrl hub (taskId task) file Nothing _ -> url +/+ logFile file req <- parseRequest logurl resp <- httpLBS req@@ -475,7 +481,7 @@ in map (dropPrefix "DEBUG ") $ takeEnd 30 $ filter (\l -> not (any (`isInfixOf` l) excluded)) ls- | last ls == "Child return code was: 0" = ls+ | lastMay ls == Just "Child return code was: 0" = ls | otherwise = case breakOnEnd ["Child return code was: 1"] ls of ([],ls') -> ls'@@ -485,17 +491,17 @@ Nothing -> output Just needle -> filter (match needle) ls- putStrLn $ "\n" ++ logurl+ putStrLn $ '\n' : logurl ++ "\n" where match :: String -> String -> Bool match "" _ = error' "empty grep string not allowed" match _ "" = False match ('^':needle) ls =- if last needle == '$'+ if lastMay needle == Just '$' then needle == ls else needle `isPrefixOf` ls match needle ls =- if last needle == '$'+ if lastMay needle == Just '$' then needle `isSuffixOf` ls else needle `isInfixOf` ls
src/Utils.hs view
@@ -2,6 +2,7 @@ kojiTaskRequestNVR, kojiGetBuildID', kojiGetBuild',+ kojiTaskArch, showValue, buildOutputURL, hubToPkgsURL,@@ -10,8 +11,8 @@ ) where -import Data.List.Extra (dropSuffix, isInfixOf, isPrefixOf, isSuffixOf, replace,- takeEnd, takeWhileEnd)+import Data.List.Extra (dropPrefix, dropSuffix, isInfixOf, isPrefixOf,+ isSuffixOf, replace, takeEnd, takeWhileEnd) import Data.RPM (dropArch) import Data.RPM.NVR import Data.RPM.NVRA@@ -38,7 +39,7 @@ Left $ -- fedora-ci_fc87dcd7db694cdfac703cf5af128a72_c1f53c859616fdbf40811058b60bebe2930e3271_0;forks:petersen:rpms:grub2.f38.src.rpm if "fedora-ci_" `isPrefixOf` base- then takeWhileEnd (/= ':') $ tail $ dropWhile (/= ';') base+ then takeWhileEnd (/= ':') $ dropPrefix ";" $ dropWhile (/= ';') base else base _ -> error' "could determine package from build request" @@ -94,3 +95,8 @@ lastFew = let few = dropWhile (== '0') $ takeEnd 4 taskid in if null few then "0" else few++kojiTaskArch :: String -> String+kojiTaskArch "i686" = "i386"+kojiTaskArch "armv7hl" = "armhfp"+kojiTaskArch a = a