koji-tool 0.8.5 → 0.8.6
raw patch · 8 files changed
+118/−37 lines, 8 files
Files
- ChangeLog.md +5/−0
- README.md +19/−3
- TODO +4/−3
- koji-tool.cabal +2/−1
- src/Install.hs +34/−29
- src/Main.hs +8/−0
- src/Quick.hs +39/−0
- src/Tasks.hs +7/−1
ChangeLog.md view
@@ -1,5 +1,10 @@ # Version history of koji-tool +# 0.8.6 (2022-05-13)+- new 'quick' command for a few limited common searchs+- install: --prefix to set subpackage prefix if different to package basename+- install: fix infinite loop when no match for subpackage glob+ # 0.8.5 (2022-05-10) - use rpm-nvr-0.1.2 for better NVR and NVRA parsing ensuring non-empty names - when parsing koji build request fields, detect git hash and fork builds
README.md view
@@ -12,7 +12,7 @@ A few illustrative examples: `koji-tool tasks --mine --latest --state fail --tail`:-shows details of your last buildArch failure and the tail of the build.log.+shows details of your last buildArch failure and the tail of the build.log (equivalently you can use `koji-tool quick my last fail`). `koji-tool install systemd`: will try to install or update to the newest rpm packages from koji. @@ -22,7 +22,7 @@ ## Commands ```shellsession $ koji-tool --version-0.8.5+0.8.6 $ koji-tool --help Query and track Koji tasks, and install rpms from Koji. @@ -42,6 +42,8 @@ install Install rpm packages directly from a Koji build task progress Track running Koji tasks by buildlog size buildlog-sizes Show buildlog sizes for nvr patterns+ quick Simple common queries using words ('my', 'last',+ 'fail', 'build') ``` ## koji-tool builds@@ -189,6 +191,17 @@ https://kojipkgs.fedoraproject.org/work/tasks/5316/86685316/build.log (13kB) ``` +## koji-tool quick+This provides shortcuts to a few select common searches++### Usage+`koji-tool quick my builds` shows your 10 most recent koji builds (equivalent to `koji-tool builds --mine`)++`koji-tool quick my last fail` shows your most recent task failure including the tail of the build.log (equivalent to `koji-tool tasks -MLT`).++`koji-tool quick last complete build` shows the latest completed koji build (equivalent to `koji-tool builds -L -s complete`).++ ## koji-tool install Download and install rpms from a Koji build or task.@@ -230,12 +243,14 @@ `--ask`: ask about each subpackage +`--prefix`: override the subpackage prefix+ ### Help ```shellsession $ 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]- [-N|--no-reinstall]+ [-N|--no-reinstall] [-b|--prefix SUBPKGPREFIX] [(-a|--all) | (-A|--ask) | [-p|--package SUBPKG] [-x|--exclude SUBPKG]] [-d|--disttag DISTTAG] [(-R|--nvr) | (-V|--nv)] PKG|NVR|TASKID...@@ -252,6 +267,7 @@ -l,--list List builds -L,--latest Latest build -N,--no-reinstall Do not reinstall existing NVRs+ -b,--prefix SUBPKGPREFIX Prefix to use for subpackages [default: base package] -a,--all all subpackages -A,--ask ask for each subpackge [default if not installed] -p,--package SUBPKG Subpackage (glob) to install
TODO view
@@ -10,6 +10,9 @@ - --exclude vs --except - tags - exclude garbage collected builds+- common special cases (with large number of subpackages)+ - eg install ghc -x '*prof' -x '*doc' -x compiler-default -x hadrian+ - or install ghc -p '*-devel' -p compiler -p ghc # Queries - TUI@@ -28,6 +31,7 @@ # buildlog-sizes/progress - combine+- cache final sizes # progress - accept task or build url@@ -48,6 +52,3 @@ - pick up user's new builds - screen mode inplace tui--# quickCmd-`quick my last build fail`
koji-tool.cabal view
@@ -1,5 +1,5 @@ name: koji-tool-version: 0.8.5+version: 0.8.6 synopsis: Koji CLI tool for querying tasks and installing builds description: koji-tool is a CLI interface to Koji with commands to query@@ -38,6 +38,7 @@ DownloadDir Install Progress+ Quick Tasks Time User
src/Install.hs view
@@ -63,8 +63,9 @@ -- FIXME --debuginfo -- FIXME --delete after installing installCmd :: Bool -> Bool -> Yes -> Maybe String -> Maybe String -> Bool- -> Bool -> Bool -> Mode -> String -> Request -> [String] -> IO ()-installCmd dryrun debug yes mhuburl mpkgsurl listmode latest noreinstall mode disttag request pkgbldtsks = do+ -> Bool -> Bool -> Maybe String -> Mode -> String -> Request+ -> [String] -> IO ()+installCmd dryrun debug yes mhuburl mpkgsurl listmode latest noreinstall mprefix mode disttag request pkgbldtsks = do let huburl = maybe fedoraKojiHub hubURL mhuburl pkgsurl = fromMaybe (defaultPkgsURL huburl) mpkgsurl when debug $ do@@ -79,7 +80,7 @@ kojiRPMs :: String -> String -> IO () -> String -> IO [(Existence,NVRA)] kojiRPMs huburl pkgsurl printDlDir bldtask = case readMaybe bldtask of- Just taskid -> kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode noreinstall mode printDlDir taskid+ Just taskid -> kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode noreinstall mprefix mode printDlDir taskid Nothing -> kojiBuildRPMs huburl pkgsurl printDlDir bldtask kojiBuildRPMs :: String -> String -> IO () -> String@@ -105,7 +106,8 @@ putStrLn $ showNVR nvr ++ "\n" nvras <- sort . map readNVRA . filter notDebugPkg <$> kojiGetBuildRPMs huburl nvr when debug $ mapM_ (putStrLn . showNVRA) nvras- dlRpms <- decideRpms yes listmode noreinstall mode (nvrName nvr) nvras+ let prefix = fromMaybe (nvrName nvr) mprefix+ dlRpms <- decideRpms yes listmode noreinstall mode prefix nvras when debug $ mapM_ printInstalled dlRpms unless (dryrun || null dlRpms) $ do downloadRpms debug (buildURL nvr) dlRpms@@ -124,9 +126,9 @@ notDebugPkg p = not ("-debuginfo-" `isInfixOf` p || "-debugsource-" `isInfixOf` p) -kojiTaskRPMs :: Bool -> Bool -> Yes -> String -> String -> Bool -> Bool -> Mode- -> IO () -> Int -> IO [(Existence,NVRA)]-kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode noreinstall mode printDlDir taskid = do+kojiTaskRPMs :: Bool -> Bool -> Yes -> String -> String -> Bool -> Bool+ -> Maybe String -> Mode -> IO () -> Int -> IO [(Existence,NVRA)]+kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode noreinstall mprefix mode printDlDir taskid = do mtaskinfo <- Koji.getTaskInfo huburl taskid True tasks <- case mtaskinfo of Nothing -> error' "failed to get taskinfo"@@ -148,23 +150,26 @@ Nothing -> error' "task id not found" Just tid -> (tid,task') nvras <- getTaskNVRAs archtid- name <- case find ((== "src") . rpmArch) nvras of- Just src -> return $ rpmName src- Nothing ->- return $- either id nvrName $- kojiTaskRequestPkgNVR $- fromMaybe archtask mtaskinfo+ prefix <- case mprefix of+ Just pref -> return pref+ Nothing ->+ case find ((== "src") . rpmArch) nvras of+ Just src -> return $ rpmName src+ Nothing ->+ return $+ either id nvrName $+ kojiTaskRequestPkgNVR $+ fromMaybe archtask mtaskinfo if listmode- then decideRpms yes listmode noreinstall mode name nvras+ then decideRpms yes listmode noreinstall mode prefix nvras else if null nvras then do- kojiTaskRPMs dryrun debug yes huburl pkgsurl True noreinstall mode printDlDir archtid >>= mapM_ printInstalled+ kojiTaskRPMs dryrun debug yes huburl pkgsurl True noreinstall mprefix mode printDlDir archtid >>= mapM_ printInstalled return [] else do when debug $ print $ map showNVRA nvras- dlRpms <- decideRpms yes listmode noreinstall mode name $+ dlRpms <- decideRpms yes listmode noreinstall mode prefix $ filter ((/= "src") . rpmArch) nvras when debug $ mapM_ printInstalled dlRpms unless (dryrun || null dlRpms) $ do@@ -190,7 +195,7 @@ decideRpms :: Yes -> Bool -> Bool -> Mode -> String -> [NVRA] -> IO [(Existence,NVRA)]-decideRpms yes listmode noreinstall mode base nvras = do+decideRpms yes listmode noreinstall mode prefix nvras = do classified <- mapM installExists (filter isBinaryRpm nvras) if listmode then mapM_ printInstalled classified >> return []@@ -203,7 +208,7 @@ Ask -> mapMaybeM (rpmPrompt yes) classified PkgsReq [] [] -> if all ((== NotInstalled) . fst) classified && yes /= Yes- then decideRpms yes listmode noreinstall Ask base nvras+ then decideRpms yes listmode noreinstall Ask prefix nvras else do let install = filter ((/= NotInstalled) . fst) classified if yes == Yes@@ -213,7 +218,7 @@ ok <- prompt yes "install above" return $ if ok then install else [] PkgsReq subpkgs exclpkgs -> do- let install = selectRPMs base (subpkgs,exclpkgs) classified+ let install = selectRPMs False prefix (subpkgs,exclpkgs) classified mapM_ printInstalled install ok <- prompt yes "install above" return $ if ok then install else []@@ -234,17 +239,17 @@ printInstalled :: (Existence, NVRA) -> IO () printInstalled = putStrLn . renderInstalled -selectRPMs :: String -> ([String],[String]) -> [(Existence,NVRA)]+selectRPMs :: Bool -> String -> ([String],[String]) -> [(Existence,NVRA)] -> [(Existence,NVRA)]-selectRPMs base (subpkgs,[]) rpms =+selectRPMs recurse prefix (subpkgs,[]) rpms = sort . mconcat $ flip map subpkgs $ \ pkgpat -> case filter (match (compile pkgpat) . rpmName . snd) rpms of- [] -> if head pkgpat /= '*'- then selectRPMs base ([base ++ '-' : pkgpat],[]) rpms+ [] -> if head pkgpat /= '*' && not recurse+ then selectRPMs True prefix ([prefix ++ '-' : pkgpat],[]) rpms else error' $ "no subpackage match for " ++ pkgpat result -> result-selectRPMs base ([], subpkgs) rpms =+selectRPMs _ prefix ([], subpkgs) rpms = -- FIXME somehow determine unused excludes foldl' (exclude subpkgs) [] rpms where@@ -264,11 +269,11 @@ in if isLiteral comppat then pat == rpmname || pat `notElem` rpmnames &&- (base ++ '-' : pat) == rpmname+ (prefix ++ '-' : pat) == rpmname else match comppat rpmname-selectRPMs base (subpkgs,exclpkgs) rpms =- let needed = selectRPMs base (subpkgs,[]) rpms- excluded = selectRPMs base ([], exclpkgs) rpms+selectRPMs recurse prefix (subpkgs,exclpkgs) rpms =+ let needed = selectRPMs recurse prefix (subpkgs,[]) rpms+ excluded = selectRPMs recurse prefix ([], exclpkgs) rpms in nub . sort $ needed ++ excluded prompt :: Yes -> String -> IO Bool
src/Main.hs view
@@ -15,6 +15,7 @@ import Install import qualified Paths_koji_tool import Progress+import Quick import Tasks main :: IO ()@@ -87,6 +88,7 @@ <*> switchWith 'l' "list" "List builds" <*> switchWith 'L' "latest" "Latest build" <*> switchWith 'N' "no-reinstall" "Do not reinstall existing NVRs"+ <*> optional (strOptionWith 'b' "prefix" "SUBPKGPREFIX" "Prefix to use for subpackages [default: base package]") <*> modeOpt <*> disttagOpt sysdisttag <*> (flagWith' ReqNVR 'R' "nvr" "Give an N-V-R instead of package name" <|>@@ -103,6 +105,12 @@ , Subcommand "buildlog-sizes" "Show buildlog sizes for nvr patterns" $ buildlogSizesCmd <$> strArg "NVRPATTERN"++ , Subcommand "quick"+ "Simple common queries using words ('my', 'last', 'fail', 'complete', 'build')" $+ quickCmd+ <$> hubOpt+ <*> some (strArg "PHRASE") ] where hubOpt = optional (strOptionWith 'H' "hub" "HUB"
+ src/Quick.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE CPP #-}++-- SPDX-License-Identifier: BSD-3-Clause++module Quick (+ quickCmd+ )+where++import Distribution.Koji+import SimpleCmd (error')++import qualified Builds+import qualified Tasks+import User++-- Package to choose build+-- FIXME: building+-- handle some extra words?+quickCmd :: Maybe String -> [String] -> IO ()+quickCmd _ [] = error' "please use words: 'my', 'last', 'fail', 'build'"+quickCmd mhub args = do+ let mine = if any (`elem` ["my","mine"]) args+ then Just UserSelf+ else Nothing+ limit = if any (`elem` ["last","latest"]) args+ then 1+ else 10+ failure = any (`elem` ["fail","failure","failed"]) args+ complete = any (`elem` ["complete","completed","close","closed",+ "finish","finished"]) args+ build = any (`elem` ["build","builds"]) args+ if build+ then+ let states = [BuildFailed|failure] ++ [BuildComplete|complete]+ in Builds.buildsCmd mhub mine limit states Nothing (Just "rpm") False False Builds.BuildQuery+ else+ let states = [TaskFailed|failure] ++ [TaskClosed|complete]+ in Tasks.tasksCmd mhub mine limit states [] Nothing Nothing False False Nothing failure Tasks.TaskQuery
src/Tasks.hs view
@@ -231,7 +231,13 @@ -- FIXME show task owner formatTaskResult :: Maybe UTCTime -> TimeZone -> TaskResult -> [String]-formatTaskResult mtime tz (TaskResult pkg arch method state mparent taskid mstart mend) =+formatTaskResult+#if MIN_VERSION_time(1,9,1)+ mtime+#else+ _mtime+#endif+ tz (TaskResult pkg arch method state mparent taskid mstart mend) = [ showPackage pkg ++ (if method == "buildArch" then '.' : arch else ' ' : method) +-+ show state , "https://koji.fedoraproject.org/koji/taskinfo?taskID=" ++ show taskid +-+ maybe "" (\p -> "(parent: " ++ show p ++ ")") mparent] ++ [formatTime defaultTimeLocale "Start: %c" (utcToZonedTime tz start) | Just start <- [mstart]] ++