packages feed

koji-tool 0.8.2 → 0.8.3

raw patch · 11 files changed

+193/−119 lines, 11 files

Files

ChangeLog.md view
@@ -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
README.md view
@@ -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
TODO view
@@ -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
koji-tool.cabal view
@@ -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,
src/Builds.hs view
@@ -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
src/Common.hs view
@@ -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 =
src/Install.hs view
@@ -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 =
src/Main.hs view
@@ -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
src/Tasks.hs view
@@ -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
+ src/Time.hs view
@@ -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"
test/tests.hs view
@@ -32,6 +32,9 @@      [["-L"]      ,["-l", "3"]      ,["-L", "rpm-ostree"]])+  ,+    (["latest"],+     [["rawhide", "ghc"]])   ]   where     sysdist = if havedist then [] else ["-d", "fc35"]