diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,12 @@ # Version history of koji-tool +# 0.8.3 (2022-04-23) +- 'latest': new cmd to list latest package build for tag +- 'install': use --reinstall-nvrs to reinstall rpms for current nvr +- 'install': now prompts before proceeding +- 'install': handle build tasks by finding buildArch +- 'install': --list now always lists rpms + # 0.8.2 (2022-03-28) - use the formatting library for rendering aligned output diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -34,6 +34,7 @@ Available commands: builds Query Koji builds (by default lists most recent builds) + latest Query latest Koji build for tag tasks Query Koji tasks (by default lists most recent buildArch tasks) install Install rpm packages directly from a Koji build task @@ -233,6 +234,7 @@ $ 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] + [-r|--reinstall-nvrs] [(-a|--all) | (-A|--ask) | [-p|--package SUBPKG] [-x|--exclude SUBPKG]] [-d|--disttag DISTTAG] [(-R|--nvr) | (-V|--nv)] PKG|NVR|TASKID... @@ -248,11 +250,12 @@ -P,--packages-url URL KojiFiles packages url [default: Fedora] -l,--list List builds -L,--latest Latest build + -r,--reinstall-nvrs Reinstall existing NVRs -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] + -d,--disttag DISTTAG Use a different disttag [default: .fc36] -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 diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -1,3 +1,7 @@ +# hubs +- hub configurations +- determine urls for logs etc by parsing html + # install - autodetect nvr - --nodeps @@ -7,28 +11,28 @@ - tags - exclude garbage collected builds -# tasks +# Queries +- TUI +- --short option +- --active or state filter + +## tasks - determine username for non-Fedora - build pattern - different hubs put builds in different locations - html output - grep buildlog -# builds -- support latest-build for tag +## builds - --show-tags -# query -- default to the last year? for speed -- --short option -- --active or state filter - # buildlog-sizes/progress - combine # progress - accept task or build url - cache and compare sizes with previous build(s) +- estimate task/build ETA - show the build duration - support builds as well as tasks diff --git a/koji-tool.cabal b/koji-tool.cabal --- a/koji-tool.cabal +++ b/koji-tool.cabal @@ -1,5 +1,5 @@ name: koji-tool -version: 0.8.2 +version: 0.8.3 synopsis: Koji CLI tool for querying tasks and installing builds description: koji-tool is a CLI interface to Koji with commands to query @@ -39,6 +39,7 @@ Install Progress Tasks + Time User hs-source-dirs: src build-depends: base < 5, diff --git a/src/Builds.hs b/src/Builds.hs --- a/src/Builds.hs +++ b/src/Builds.hs @@ -7,7 +7,8 @@ buildsCmd, parseBuildState, fedoraKojiHub, - kojiBuildTypes + kojiBuildTypes, + latestCmd ) where @@ -27,6 +28,7 @@ import Common import qualified Tasks +import Time import User data BuildReq = BuildBuild String | BuildPackage String @@ -47,7 +49,7 @@ buildsCmd mhub museropt limit states mdate mtype details debug buildreq = do let server = maybe fedoraKojiHub hubURL mhub when (server /= fedoraKojiHub && museropt == Just UserSelf) $ - error' "--mine currently only works with Fedora Koji" + error' "--mine currently only works with Fedora Koji: use --user instead" tz <- getCurrentTimeZone case buildreq of BuildBuild bld -> do @@ -90,10 +92,10 @@ nvr <- lookupStruct "nvr" bld state <- readBuildState <$> lookupStruct "state" bld let date = - case readTime' <$> lookupStruct "completion_ts" bld of + case lookupTime "completion" bld of Just t -> compactZonedTime tz t Nothing -> - case readTime' <$> lookupStruct "start_ts" bld of + case lookupTime "start" bld of Just t -> compactZonedTime tz t Nothing -> "" return $ nvr +-+ show state +-+ date @@ -130,25 +132,6 @@ [n,_unit] | all isDigit n -> timedate ++ " ago" _ -> timedate - maybeBuildResult :: Struct -> Maybe BuildResult - maybeBuildResult st = do - start_time <- readTime' <$> lookupStruct "start_ts" st - let mend_time = readTime' <$> lookupStruct "completion_ts" st - buildid <- lookupStruct "build_id" st - -- buildContainer has no task_id - let mtaskid = lookupStruct "task_id" st - state <- getBuildState st - nvr <- lookupStruct "nvr" st >>= maybeNVR - return $ - BuildResult nvr state buildid mtaskid start_time mend_time - - printBuild :: String -> TimeZone -> BuildResult -> IO () - printBuild server tz task = do - putStrLn "" - let mendtime = mbuildEndTime task - time <- maybe getCurrentTime return mendtime - (mapM_ putStrLn . formatBuildResult server (isJust mendtime) tz) (task {mbuildEndTime = Just time}) - pPrintCompact = #if MIN_VERSION_pretty_simple(4,0,0) pPrintOpt CheckColorTty @@ -157,6 +140,35 @@ pPrint #endif +-- FIXME +data BuildResult = + BuildResult {_buildNVR :: NVR, + _buildState :: BuildState, + _buildId :: Int, + _mtaskId :: Maybe Int, + _buildStartTime :: UTCTime, + mbuildEndTime :: Maybe UTCTime + } + +maybeBuildResult :: Struct -> Maybe BuildResult +maybeBuildResult st = do + start_time <- lookupTime "start" st + let mend_time = lookupTime "completion" st + buildid <- lookupStruct "build_id" st + -- buildContainer has no task_id + let mtaskid = lookupStruct "task_id" st + state <- getBuildState st + nvr <- lookupStruct "nvr" st >>= maybeNVR + return $ + BuildResult nvr state buildid mtaskid start_time mend_time + +printBuild :: String -> TimeZone -> BuildResult -> IO () +printBuild server tz task = do + putStrLn "" + let mendtime = mbuildEndTime task + time <- maybe getCurrentTime return mendtime + (mapM_ putStrLn . formatBuildResult server (isJust mendtime) tz) (task {mbuildEndTime = Just time}) + formatBuildResult :: String -> Bool -> TimeZone -> BuildResult -> [String] formatBuildResult server ended tz (BuildResult nvr state buildid mtaskid start mendtime) = -- FIXME any better way? @@ -177,16 +189,6 @@ in [(if not ended then "current " else "") ++ "duration: " ++ formatTime defaultTimeLocale "%Hh %Mm %Ss" dur] #endif --- FIXME -data BuildResult = - BuildResult {_buildNVR :: NVR, - _buildState :: BuildState, - _buildId :: Int, - _mtaskId :: Maybe Int, - _buildStartTime :: UTCTime, - mbuildEndTime :: Maybe UTCTime - } - #if !MIN_VERSION_koji(0,0,3) buildStateToValue :: BuildState -> Value buildStateToValue = ValueInt . fromEnum @@ -209,3 +211,11 @@ kojiBuildTypes :: [String] kojiBuildTypes = ["all", "image", "maven", "module", "rpm", "win"] + +latestCmd :: Maybe String -> Bool -> String -> String -> IO () +latestCmd mhub debug tag pkg = do + let server = maybe fedoraKojiHub hubURL mhub + mbld <- kojiLatestBuild server tag pkg + when debug $ print mbld + tz <- getCurrentTimeZone + whenJust (mbld >>= maybeBuildResult) $ printBuild server tz diff --git a/src/Common.hs b/src/Common.hs --- a/src/Common.hs +++ b/src/Common.hs @@ -1,18 +1,12 @@ module Common ( knownHubs, hubURL, - readTime', - compactZonedTime, commonQueryOptions, commonBuildQueryOptions ) where import Data.List (isPrefixOf) -import Data.Time.Clock -import Data.Time.Clock.System -import Data.Time.Format -import Data.Time.LocalTime import Distribution.Koji (fedoraKojiHub, Value(..)) import SimpleCmd (error') @@ -31,15 +25,6 @@ if "http" `isPrefixOf` hub then hub else error' $ "unknown hub: try " ++ show knownHubs - -readTime' :: Double -> UTCTime -readTime' = - let mkSystemTime t = MkSystemTime t 0 - in systemToUTCTime . mkSystemTime .truncate - -compactZonedTime :: TimeZone -> UTCTime -> String -compactZonedTime tz = - formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S%Z" . utcToZonedTime tz commonQueryOptions :: Int -> String -> [(String, Value)] commonQueryOptions limit order = diff --git a/src/Install.hs b/src/Install.hs --- a/src/Install.hs +++ b/src/Install.hs @@ -59,8 +59,8 @@ -- FIXME --debuginfo -- FIXME --delete after installing installCmd :: Bool -> Bool -> Yes -> Maybe String -> Maybe String -> Bool - -> Bool -> Mode -> String -> Request -> [String] -> IO () -installCmd dryrun debug yes mhuburl mpkgsurl listmode latest mode disttag request pkgbldtsks = do + -> Bool -> Bool -> Mode -> String -> Request -> [String] -> IO () +installCmd dryrun debug yes mhuburl mpkgsurl listmode latest reinstall mode disttag request pkgbldtsks = do let huburl = maybe fedoraKojiHub hubURL mhuburl pkgsurl = fromMaybe (defaultPkgsURL huburl) mpkgsurl when debug $ do @@ -73,12 +73,12 @@ mapM (kojiRPMs huburl pkgsurl dlDir) pkgbldtsks >>= if listmode then mapM_ putStrLn . mconcat - else installRPMs dryrun yes . mconcat + else installRPMs dryrun reinstall yes . mconcat where kojiRPMs :: String -> String -> String -> String -> IO [String] -- ([String],String) kojiRPMs huburl pkgsurl dlDir bldtask = if all isDigit bldtask - then kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode mode dlDir bldtask + then kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode reinstall mode dlDir bldtask else kojiBuildRPMs huburl pkgsurl dlDir bldtask kojiBuildRPMs :: String -> String -> String -> String -> IO [String] @@ -97,7 +97,7 @@ putStrLn $ nvr ++ "\n" allRpms <- map (<.> "rpm") . sort . filter (not . debugPkg) <$> kojiGetBuildRPMs huburl nvr when debug $ print allRpms - dlRpms <- decideRpms yes listmode mode (maybeNVRName nvr) allRpms + dlRpms <- decideRpms yes listmode reinstall mode (maybeNVRName nvr) allRpms when debug $ print dlRpms unless (dryrun || null dlRpms) $ do downloadRpms debug (buildURL (readNVR nvr)) dlRpms @@ -115,36 +115,46 @@ debugPkg :: String -> Bool debugPkg p = "-debuginfo-" `isInfixOf` p || "-debugsource-" `isInfixOf` p -kojiTaskRPMs :: Bool -> Bool -> Yes -> String -> String -> Bool -> Mode +kojiTaskRPMs :: Bool -> Bool -> Yes -> String -> String -> Bool -> Bool -> Mode -> String -> String -> IO [String] -kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode mode dlDir task = do +kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode reinstall mode dlDir task = do let taskid = read task + mtaskinfo <- Koji.getTaskInfo huburl taskid True + tasks <- case mtaskinfo of + Nothing -> error' "failed to get taskinfo" + Just taskinfo -> do + when debug $ mapM_ print taskinfo + case lookupStruct "method" taskinfo :: Maybe String of + Nothing -> error' $ "no method found for " ++ task + Just method -> + case method of + "build" -> Koji.getTaskChildren huburl taskid False + "buildArch" -> return [taskinfo] + _ -> error' $ "unsupport method: " ++ method + sysarch <- cmd "rpm" ["--eval", "%{_arch}"] + let archtid = + case find (\t -> lookupStruct "arch" t == Just sysarch) tasks of + Nothing -> error' $ "no " ++ sysarch ++ " task found" + Just task' -> + case lookupStruct "id" task' of + Nothing -> error' "task id not found" + Just tid -> tid + rpms <- getTaskRPMs archtid 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 yes listmode mode Nothing - Nothing -> error' "failed to get taskinfo" - else do - rpms <- getTaskRPMs taskid + then decideRpms yes listmode reinstall mode Nothing rpms + else if null rpms - then do - kojiTaskRPMs dryrun debug yes huburl pkgsurl True mode dlDir task >>= mapM_ putStrLn + then do + kojiTaskRPMs dryrun debug yes huburl pkgsurl True reinstall mode dlDir task >>= mapM_ putStrLn return [] - else do + 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 yes listmode mode (maybeNVRName nvr) $ rpms \\ [srpm] + dlRpms <- decideRpms yes listmode reinstall mode (maybeNVRName nvr) $ rpms \\ [srpm] when debug $ print dlRpms unless (dryrun || null dlRpms) $ do downloadRpms debug (taskRPMURL task) dlRpms @@ -166,29 +176,45 @@ maybeNVRName :: String -> Maybe String maybeNVRName = fmap nvrName . maybeNVR -decideRpms :: Yes -> Bool -> Mode -> Maybe String -> [String] -> IO [String] -decideRpms yes listmode mode mbase allRpms = +decideRpms :: Yes -> Bool -> Bool -> Mode -> Maybe String -> [String] -> IO [String] +decideRpms yes listmode reinstall mode mbase allRpms = case mode of - All -> if listmode - then error' "cannot use --list and --all together" - else return allRpms + All -> return allRpms Ask -> if listmode then error' "cannot use --list and --ask together" else mapMaybeM rpmPrompt allRpms PkgsReq [] [] -> if listmode - then return allRpms + then + -- FIXME mark already installed packages + return allRpms else do - rpms <- filterM (isInstalled . nvraName) $ + rpms <- filterM (isInstalled reinstall . dropExtension) $ filter isBinaryRpm allRpms if null rpms && yes /= Yes - then decideRpms yes listmode Ask mbase allRpms - else return rpms + then decideRpms yes listmode reinstall Ask mbase allRpms + else do + if yes == Yes + then return rpms + else do + mapM_ putStrLn rpms + if listmode + then return [] + else do + ok <- isJust <$> rpmPrompt "install all" + return $ if ok then rpms else [] PkgsReq subpkgs exclpkgs -> return $ selectRPMs mbase (subpkgs,exclpkgs) allRpms -isInstalled :: String -> IO Bool -isInstalled rpm = cmdBool "rpm" ["--quiet", "-q", rpm] +isInstalled :: Bool -> String -> IO Bool +isInstalled reinstall rpm = + if reinstall + then cmdBool "rpm" ["--quiet", "-q", rpm] + else do + minstalled <- cmdMaybe "rpm" ["-q", nvraName rpm] + case minstalled of + Nothing -> return False + Just installed -> return $ installed /= rpm selectRPMs :: Maybe String -> ([String],[String]) -> [String] -> [String] selectRPMs mbase (subpkgs,[]) rpms = @@ -321,10 +347,10 @@ hSetBuffering stdin NoBuffering hSetBuffering stdout NoBuffering -installRPMs :: Bool -> Yes -> [FilePath] -> IO () -installRPMs _ _ [] = return () -installRPMs dryrun yes rpms = do - installed <- filterM (isInstalled . dropExtension) rpms +installRPMs :: Bool -> Bool -> Yes -> [FilePath] -> IO () +installRPMs _ _ _ [] = return () +installRPMs dryrun reinstall yes rpms = do + installed <- filterM (isInstalled reinstall . dropExtension) rpms unless (null installed) $ if dryrun then mapM_ putStrLn $ "would update:" : installed @@ -372,22 +398,22 @@ 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 +-- 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 +-- 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 = diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -43,6 +43,14 @@ BuildPackage <$> strArg "PACKAGE" <|> pure BuildQuery) + , Subcommand "latest" + "Query latest Koji build for tag" $ + latestCmd + <$> hubOpt + <*> switchWith 'D' "debug" "Pretty-print raw XML result" + <*> strArg "TAG" + <*> strArg "PKG" + , Subcommand "tasks" "Query Koji tasks (by default lists most recent buildArch tasks)" $ tasksCmd @@ -79,6 +87,7 @@ "KojiFiles packages url [default: Fedora]") <*> switchWith 'l' "list" "List builds" <*> switchWith 'L' "latest" "Latest build" + <*> switchWith 'r' "reinstall-nvrs" "Reinstall existing NVRs" <*> modeOpt <*> disttagOpt sysdisttag <*> (flagWith' ReqNVR 'R' "nvr" "Give an N-V-R instead of package name" <|> @@ -111,10 +120,7 @@ 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") + 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 diff --git a/src/Tasks.hs b/src/Tasks.hs --- a/src/Tasks.hs +++ b/src/Tasks.hs @@ -35,6 +35,7 @@ import Text.Pretty.Simple import Common +import Time import User data TaskReq = Task Int | Parent Int | Build String | Package String @@ -57,13 +58,14 @@ capitalize (h:t) = toUpper h : t -- FIXME short output summary +-- --sibling tasksCmd :: Maybe String -> Maybe UserOpt -> Int -> [TaskState] -> [String] -> Maybe BeforeAfter -> Maybe String -> Bool -> Bool -> Maybe TaskFilter -> Bool -> TaskReq -> IO () tasksCmd mhub museropt limit states archs mdate mmethod details debug mfilter' tail' taskreq = do let server = maybe fedoraKojiHub hubURL mhub when (server /= fedoraKojiHub && museropt == Just UserSelf) $ - error' "--mine currently only works with Fedora Koji" + error' "--mine currently only works with Fedora Koji: use --user instead" tz <- getCurrentTimeZone case taskreq of Task taskid -> do @@ -163,8 +165,8 @@ maybeTaskResult :: Struct -> Maybe TaskResult maybeTaskResult st = do arch <- lookupStruct "arch" st - let mstart_time = readTime' <$> lookupStruct "start_ts" st - mend_time = readTime' <$> lookupStruct "completion_ts" st + let mstart_time = lookupTime "start" st + mend_time = lookupTime "completion" st taskid <- lookupStruct "id" st method <- lookupStruct "method" st state <- getTaskState st diff --git a/src/Time.hs b/src/Time.hs new file mode 100644 --- /dev/null +++ b/src/Time.hs @@ -0,0 +1,27 @@ +module Time ( + compactZonedTime, + lookupTime) +where + +import Data.Time.Clock +import Data.Time.Clock.System +import Data.Time.Format +import Data.Time.LocalTime +import Distribution.Koji.API (Struct, lookupStruct) + +readTime' :: Double -> UTCTime +readTime' = + let mkSystemTime t = MkSystemTime t 0 + in systemToUTCTime . mkSystemTime . truncate + +compactZonedTime :: TimeZone -> UTCTime -> String +compactZonedTime tz = + formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S%Z" . utcToZonedTime tz + +lookupTime :: String -> Struct -> Maybe UTCTime +lookupTime prefix str = do + case lookupStruct (prefix ++ "_ts") str of + Just ts -> return $ readTime' ts + Nothing -> + lookupStruct (prefix ++ "_time") str >>= + parseTimeM False defaultTimeLocale "%Y-%m-%d %H:%M:%S%Q%EZ" diff --git a/test/tests.hs b/test/tests.hs --- a/test/tests.hs +++ b/test/tests.hs @@ -32,6 +32,9 @@ [["-L"] ,["-l", "3"] ,["-L", "rpm-ostree"]]) + , + (["latest"], + [["rawhide", "ghc"]]) ] where sysdist = if havedist then [] else ["-d", "fc35"]