packages feed

koji-tool 0.9.1 → 0.9.2

raw patch · 13 files changed

+311/−172 lines, 13 files

Files

ChangeLog.md view
@@ -1,13 +1,21 @@ # Version history of koji-tool +## 0.9.2 (2022-06-12)+- progress: print build duration+- install: place rpms in a nvr subdirectory+- progress: show duration of build and finished tasks+- install: when downloading check if local files' timestamp within build time+- progress: no longer quit after srpm build+- tasks --install now takes install options string+ ## 0.9.1 (2022-05-29) - 'find': add "install", "tail", "notail", and archs support - 'install': --rpm option to install directly with rpm instead of dnf - 'tasks': add --install option - 'tasks': major rework of the log file handling-- 'tasks --tail': fix output when still running-- 'tasks': compact task output shows duration-- 'builds': now outputs packages/ archive url+- 'tasks --tail': fix output when task still running+- 'tasks': compact output shows duration+- 'builds': now outputs packages archive url  ## 0.9 (2022-05-20) - rename 'quick' command to 'find'
README.md view
@@ -23,7 +23,7 @@ ## Commands ```shellsession $ koji-tool --version-0.9.1+0.9.2 $ koji-tool --help Query and track Koji tasks, and install rpms from Koji. @@ -134,7 +134,7 @@                        [(-B|--before TIMESTAMP) | (-F|--from TIMESTAMP)]                        [-m|--method METHOD] [-d|--details] [-D|--debug]                        [(-P|--only-package PKG) | (-N|--only-nvr PREFIX)]-                       [-T|--tail] [-i|--install]+                       [-T|--tail] [-i|--install INSTALLOPTS]                        [(-b|--build BUILD) | (-p|--pattern NVRPAT) |                          PACKAGE|TASKID]   Query Koji tasks (by default lists most recent buildArch tasks)@@ -158,7 +158,7 @@   -P,--only-package PKG    Filter task results to specified package   -N,--only-nvr PREFIX     Filter task results by NVR prefix   -T,--tail                Fetch the tail of build.log-  -i,--install             install the package+  -i,--install INSTALLOPTS Install the package with 'install' options   -b,--build BUILD         List child tasks of build   -p,--pattern NVRPAT      Build tasks of matching pattern   -h,--help                Show this help text@@ -194,36 +194,8 @@ https://kojipkgs.fedoraproject.org/work/tasks/5316/86685316/build.log (13kB) ``` -## koji-tool find-This provides shortcuts to a few select common searches--### Usage-`koji-tool find my builds` shows your 10 most recent koji builds (equivalent to `koji-tool builds --mine`)--`koji-tool find my last fail` shows your most recent task failure including the tail of the build.log (equivalent to `koji-tool tasks -MLT -s fail`).--`koji-tool find last complete build` shows the latest completed koji build (equivalent to `koji-tool builds -L -s complete`).--### Help-```shellsession-$ koji-tool find-koji-tool: find handles these words:--my mine-last latest-fail failure failed-complete completed completion close closed finish finished-current building open-build builds-detail details detailed-install-tail-notail-x86_64 aarch64 ppc64le s390x i686 armv7hl-PACKAGE-USER\'s--```+It is also possible to install packages from a task using `--install "..."`.+See the install command documentation below for more details.  ## koji-tool install @@ -235,7 +207,7 @@ Note this command is intended for development and testing purposes and should not be necessary/used normally on production systems, but it can be very helpful for quickly testing an specific package build or-update.+update locally.  ### Usage @@ -279,7 +251,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|--rpm] [-N|--no-reinstall]+                         [-t|--check-remote-time] [-r|--rpm] [-N|--no-reinstall]                          [-b|--prefix SUBPKGPREFIX]                          [(-a|--all) | (-A|--ask) | [-p|--package SUBPKG]                            [-x|--exclude SUBPKG]] [-d|--disttag DISTTAG]@@ -296,6 +268,7 @@   -P,--packages-url URL    KojiFiles packages url [default: Fedora]   -l,--list                List builds   -L,--latest              Latest build+  -t,--check-remote-time   Check remote rpm timestamps   -r,--rpm                 Use rpm instead of dnf   -N,--no-reinstall        Do not reinstall existing NVRs   -b,--prefix SUBPKGPREFIX Prefix to use for subpackages [default: base package]@@ -303,12 +276,43 @@   -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     Override the disttag+  -d,--disttag DISTTAG     Select a disttag different to system   -R,--nvr                 Give an N-V-R instead of package name   -V,--nv                  Give an N-V instead of package name   -h,--help                Show this help text ``` +## koji-tool find+This provides shortcuts to a few select common searches++### Usage+`koji-tool find my builds` shows your 10 most recent koji builds (equivalent to `koji-tool builds --mine`)++`koji-tool find my last fail` shows your most recent task failure including the tail of the build.log (equivalent to `koji-tool tasks -MLT -s fail`).++`koji-tool find last complete build` shows the latest completed koji build (equivalent to `koji-tool builds -L -s complete`).++### Help+```shellsession+$ koji-tool find+koji-tool: find handles these words:++my mine+last latest+fail failure failed+complete completed completion close closed finish finished+current building open+build builds+detail details detailed+install+tail+notail+x86_64 aarch64 ppc64le s390x i686 armv7hl+PACKAGE+USER\'s++```+ ## koji-tool progress Shows the progress of active koji builds tasks by checking the size of their build.log files.@@ -334,7 +338,7 @@ The `buildlog-sizes` command is similar but runs once over nvr patterns.  ## Installation-koji-tool is packaged in Fedora 35++koji-tool is packaged in Fedora  ## Build `cabal-rpm builddep && cabal install || stack install`
TODO view
@@ -2,6 +2,9 @@ - hub configurations - determine urls for logs etc by parsing html +# misc+- api-version command+ # install - autodetect nvr - --nodeps@@ -47,10 +50,7 @@ - % of previous build (or finished tasks) - mbs urls? - average build times? (cache or separate tool?)-* quits after srpm build - show log sizes for old finished builds--- display buildtimes for completed tasks  - pick up user's new builds
koji-tool.cabal view
@@ -1,5 +1,5 @@ name:                koji-tool-version:             0.9.1+version:             0.9.2 synopsis:            Koji CLI tool for querying tasks and installing builds description:         koji-tool is a CLI interface to Koji with commands to query
src/Builds.hs view
@@ -95,12 +95,10 @@       nvr <- lookupStruct "nvr" bld       state <- readBuildState <$> lookupStruct "state" bld       let date =-            case lookupTime "completion" bld of-              Just t -> compactZonedTime tz t-              Nothing ->-                case lookupTime "start" bld of-                  Just t -> compactZonedTime tz t-                  Nothing -> ""+            case lookupTimes bld of+              Nothing -> ""+              Just (start,mend) ->+                compactZonedTime tz $ fromMaybe start mend           mbid = lookupStruct "build_id" bld       return $ nvr +-+ show state +-+ date +-+ maybe "" (buildinfoUrl hub) mbid @@ -139,7 +137,8 @@     pPrintCompact = #if MIN_VERSION_pretty_simple(4,0,0)       pPrintOpt CheckColorTty-      (defaultOutputOptionsDarkBg {outputOptionsCompact = True})+      (defaultOutputOptionsDarkBg {outputOptionsCompact = True,+                                   outputOptionsCompactParens = True}) #else       pPrint #endif@@ -160,15 +159,14 @@  maybeBuildResult :: Struct -> Maybe BuildResult maybeBuildResult st = do-  start_time <- lookupTime "start" st-  let mend_time = lookupTime "completion" st+  (start,mend) <- lookupTimes 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+    BuildResult nvr state buildid mtaskid start mend  printBuild :: String -> TimeZone -> BuildResult -> IO () printBuild hub tz build = do
src/DownloadDir.hs view
@@ -38,7 +38,7 @@   return $     putStrLn $     "Packages downloaded to " ++-    if isRelative path then "~" </> path else path+    (if isRelative path then "~" </> path else path) </> subdir   where     setCWD :: FilePath -> IO FilePath     setCWD dir = do
src/Install.hs view
@@ -7,7 +7,8 @@   Request(..),   installCmd,   knownHubs,-  Yes(..)+  Yes(..),+  installArgs   ) where @@ -30,17 +31,39 @@  import Common import DownloadDir+import Time import Utils  data Yes = No | Yes   deriving Eq  data Select = All-          | Ask-          -- distinguish except and exclude-          | PkgsReq [String] [String] -- ^ include, except/exclude+            | Ask+            | PkgsReq [String] [String] -- ^ include, except/exclude   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] -> Select+    installPairs pa xa [] = PkgsReq pa xa+    installPairs pa xa (w:ws)+      | w `elem` ["-p","--package"] =+          case ws of+            [] -> error' "--install-opts --package missing value"+            (w':ws') -> installPairs (w':pa) xa ws'+      | w `elem` ["-x","--exclude"] =+          case ws of+            [] -> error' "--install-opts --exclude missing value"+            (w':ws') -> installPairs pa (w':xa) ws'+      | otherwise = error' "invalid --install-opts"+ data Request = ReqName | ReqNV | ReqNVR   deriving Eq @@ -52,10 +75,11 @@ -- FIXME --delete after installing -- FIXME --dnf to install selected packages using default dnf repo instead -- FIXME offer to download subpackage deps+-- FIXME is --check-remote-time really needed? installCmd :: Bool -> Bool -> Yes -> Maybe String -> Maybe String -> Bool-           -> Bool -> Bool -> Bool -> Maybe String -> Select -> Maybe String-           -> Request -> [String] -> IO ()-installCmd dryrun debug yes mhuburl mpkgsurl listmode latest userpm noreinstall mprefix select mdisttag request pkgbldtsks = do+           -> Bool -> Bool -> Bool -> Bool -> Maybe String -> Select+           -> Maybe String -> Request -> [String] -> IO ()+installCmd dryrun debug yes mhuburl mpkgsurl listmode latest checkremotetime useRpm noreinstall mprefix select mdisttag request pkgbldtsks = do   let huburl = maybe fedoraKojiHub hubURL mhuburl       pkgsurl = fromMaybe (hubToPkgsURL huburl) mpkgsurl   when debug $ do@@ -64,17 +88,18 @@   printDlDir <- setDownloadDir dryrun "rpms"   when debug printDlDir   setNoBuffering-  mapM (kojiRPMs huburl pkgsurl printDlDir) pkgbldtsks-    >>= installRPMs dryrun userpm noreinstall yes . mconcat+  buildrpms <- mapM (kojiRPMs huburl pkgsurl printDlDir) pkgbldtsks+  installRPMs dryrun debug useRpm noreinstall yes buildrpms   where-    kojiRPMs :: String -> String -> IO () -> String -> IO [(Existence,NVRA)]+    kojiRPMs :: String -> String -> IO () -> String+             -> IO (FilePath, [(Existence,NVRA)])     kojiRPMs huburl pkgsurl printDlDir bldtask =       case readMaybe bldtask of-        Just taskid -> kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode noreinstall mprefix select printDlDir taskid+        Just taskid -> kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode noreinstall mprefix select checkremotetime printDlDir taskid         Nothing -> kojiBuildRPMs huburl pkgsurl printDlDir bldtask      kojiBuildRPMs :: String -> String -> IO () -> String-                  -> IO [(Existence,NVRA)]+                  -> IO (FilePath, [(Existence,NVRA)])     kojiBuildRPMs huburl pkgsurl printDlDir pkgbld = do       disttag <-         case mdisttag of@@ -91,25 +116,30 @@                  [nvr] -> do                    putStrLn (showNVR nvr)                    putStrLn ""-                   kojiGetBuildRPMs huburl nvr >>=+                   bid <- kojiGetBuildID' huburl (showNVR nvr)+                   kojiGetBuildRPMs huburl nvr bid >>=                      mapM_ putStrLn . sort . filter notDebugPkg                  _ -> mapM_ (putStrLn . showNVR) nvrs-        return []+        return ("",[])         else         case nvrs of           [] -> error' $ pkgbld ++ " not found for " ++ disttag           [nvr] -> do             putStrLn $ showNVR nvr ++ "\n"-            nvras <- sort . map readNVRA . filter notDebugPkg <$> kojiGetBuildRPMs huburl nvr+            bid <- kojiGetBuildID' huburl (showNVR nvr)+            nvras <- sort . map readNVRA . filter notDebugPkg <$> kojiGetBuildRPMs huburl nvr bid             when debug $ mapM_ (putStrLn . showNVRA) nvras             let prefix = fromMaybe (nvrName nvr) mprefix             dlRpms <- decideRpms yes listmode noreinstall select prefix nvras             when debug $ mapM_ printInstalled dlRpms+            let subdir = showNVR nvr             unless (dryrun || null dlRpms) $ do-              downloadRpms debug (buildURL nvr) dlRpms+              bld <- kojiGetBuild' huburl nvr+              -- FIXME should be NVRA ideally+              downloadRpms debug checkremotetime (lookupTimes' bld) subdir (buildURL nvr) dlRpms               -- FIXME once we check file size - can skip if no downloads               printDlDir-            return dlRpms+            return (subdir,dlRpms)           _ -> error $ "multiple build founds for " ++ pkgbld ++ ": " ++                unwords (map showNVR nvrs)         where@@ -123,8 +153,9 @@   not ("-debuginfo-" `isInfixOf` p || "-debugsource-" `isInfixOf` p)  kojiTaskRPMs :: Bool -> Bool -> Yes -> String -> String -> Bool -> Bool-             -> Maybe String -> Select -> IO () -> Int -> IO [(Existence,NVRA)]-kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode noreinstall mprefix select printDlDir taskid = do+             -> Maybe String -> Select -> Bool -> IO () -> Int+             -> IO (FilePath, [(Existence,NVRA)])+kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode noreinstall mprefix select checkremotetime printDlDir taskid = do   mtaskinfo <- Koji.getTaskInfo huburl taskid True   tasks <- case mtaskinfo of             Nothing -> error' "failed to get taskinfo"@@ -157,21 +188,25 @@                     kojiTaskRequestPkgNVR $                     fromMaybe archtask mtaskinfo   if listmode-    then decideRpms yes listmode noreinstall select prefix nvras+    then do+    drpms <- decideRpms yes listmode noreinstall select prefix nvras+    return ("",drpms)     else     if null nvras     then do-      kojiTaskRPMs dryrun debug yes huburl pkgsurl True noreinstall mprefix select printDlDir archtid >>= mapM_ printInstalled-      return []+      (_, rpms) <- kojiTaskRPMs dryrun debug yes huburl pkgsurl True noreinstall mprefix select checkremotetime printDlDir archtid+      mapM_ printInstalled rpms+      return ("",[])     else do       when debug $ print $ map showNVRA nvras       dlRpms <- decideRpms yes listmode noreinstall select prefix $                 filter ((/= "src") . rpmArch) nvras       when debug $ mapM_ printInstalled dlRpms+      let subdir = show archtid       unless (dryrun || null dlRpms) $ do-        downloadRpms debug (taskRPMURL archtid) dlRpms+        downloadRpms debug checkremotetime (lookupTimes' archtask) subdir (taskRPMURL archtid) dlRpms         printDlDir-      return dlRpms+      return (subdir,dlRpms)   where     getTaskNVRAs :: Int -> IO [NVRA]     getTaskNVRAs taskid' =@@ -298,6 +333,7 @@ kojiBuildOSBuilds debug hub listmode latest disttag request pkgpat = do   when debug $ putStrLn pkgpat   let (pkg,full) = packageOfPattern request pkgpat+      -- FIXME recheck koji version       oldkoji = "rpmfusion" `isInfixOf` hub   when debug $ print (pkg,full)   when debug $ putStrLn pkg@@ -344,42 +380,39 @@       case readNVR pat of         NVR n _ -> (n, True) -kojiGetBuildRPMs :: String -> NVR -> IO [String]-kojiGetBuildRPMs huburl nvr = do-  mbid <- kojiGetBuildID huburl (showNVR nvr)-  case mbid of-    Nothing -> error $ "Build id not found for " ++ showNVR nvr-    Just (BuildId bid) -> do-      rpms <- Koji.listBuildRPMs huburl bid-      sysarch <- cmd "rpm" ["--eval", "%{_arch}"]-      return $ map getNVRA $ filter (forArch sysarch) rpms-   where-     forArch :: String -> Struct -> Bool-     forArch sysarch st =-       case lookupStruct "arch" st of-         Just arch -> arch `elem` [sysarch, "noarch"]-         Nothing -> error $ "No arch found for rpm for: " ++ showNVR nvr+kojiGetBuildRPMs :: String -> NVR -> BuildID -> IO [String]+kojiGetBuildRPMs huburl nvr (BuildId bid) = do+  rpms <- Koji.listBuildRPMs huburl bid+  sysarch <- cmd "rpm" ["--eval", "%{_arch}"]+  return $ map getNVRA $ filter (forArch sysarch) rpms+  where+    forArch :: String -> Struct -> Bool+    forArch sysarch st =+      case lookupStruct "arch" st of+        Just arch -> arch `elem` [sysarch, "noarch"]+        Nothing -> error $ "No arch found for rpm for: " ++ showNVR nvr -     getNVRA :: Struct -> String-     getNVRA st =-       case lookupStruct "nvr" st of-         Nothing -> error' "NVR not found"-         Just pnvr ->-           case lookupStruct "arch" st of-             Nothing -> error "arch not found"-             Just arch ->-               pnvr <.> arch+    getNVRA :: Struct -> String+    getNVRA st =+      case lookupStruct "nvr" st of+        Nothing -> error' "NVR not found"+        Just pnvr ->+          case lookupStruct "arch" st of+            Nothing -> error "arch not found"+            Just arch ->+              pnvr <.> arch  setNoBuffering :: IO () setNoBuffering = do   hSetBuffering stdin NoBuffering   hSetBuffering stdout NoBuffering -installRPMs :: Bool -> Bool -> Bool -> Yes -> [(Existence,NVRA)] -> IO ()-installRPMs _ _ _ _ [] = return ()-installRPMs dryrun rpm noreinstall yes classified =-  forM_ (groupSort classified) $ \(cl,pkgs) ->-    unless (null pkgs) $+installRPMs :: Bool -> Bool -> Bool -> Bool -> Yes -> [(FilePath,[(Existence,NVRA)])]+            -> IO ()+installRPMs _ _ _ _ _ [] = return ()+installRPMs dryrun debug rpm noreinstall yes classified =+  forM_ (groupClasses classified) $ \(cl,dirpkgs) ->+    unless (null dirpkgs) $     let pkgmgr = if rpm then "rpm" else "dnf"         mcom =           case cl of@@ -389,32 +422,51 @@             _ -> Just (if rpm then ["-ivh"] else ["localinstall"])     in whenJust mcom $ \com ->       if dryrun-      then mapM_ putStrLn $ ("would" +-+ unwords (pkgmgr : com) ++ ":") : map showRpmFile pkgs-      else sudo_ pkgmgr $ com ++ map showRpmFile pkgs ++ ["--assumeyes" | yes == Yes && not rpm]+      then mapM_ putStrLn $ ("would" +-+ unwords (pkgmgr : com) ++ ":") : map showRpmFile dirpkgs+      else do+        when debug $ mapM_ (putStrLn . showRpmFile) dirpkgs+        sudo_ pkgmgr $ com ++ map showRpmFile dirpkgs ++ ["--assumeyes" | yes == Yes && not rpm]+  where+    groupClasses =+      groupSort . concatMap mapDir+      where+        mapDir :: (FilePath,[(Existence,NVRA)])+               -> [(Existence,(FilePath,NVRA))]+        mapDir (dir,cls) =+          map (\(e,n) -> (e,(dir,n))) cls -showRpmFile :: NVRA -> FilePath-showRpmFile nvra = showNVRA nvra <.> "rpm"+showRpm :: NVRA -> FilePath+showRpm nvra = showNVRA nvra <.> "rpm" -downloadRpms :: Bool -> (String -> String) -> [(Existence,NVRA)] -> IO ()-downloadRpms debug urlOf rpms = do+showRpmFile :: (FilePath,NVRA) -> FilePath+showRpmFile (dir,nvra) = dir </> showRpm nvra++downloadRpms :: Bool -> Bool -> (UTCTime, UTCTime) -> FilePath+             -> (String -> String) -> [(Existence,NVRA)] -> IO ()+downloadRpms debug checkremotetime (taskstart,taskend) subdir urlOf rpms = do   urls <- fmap catMaybes <$>-    forM (map snd rpms) $ \nvra -> do-    let rpm = showRpmFile nvra-    exists <- doesFileExist rpm+    forM (map (showRpm . snd) rpms) $ \rpm -> do+    let rpmfile = subdir </> rpm+    exists <- doesFileExist rpmfile     let url = urlOf rpm     notfile <-       if exists       then do-        old <- outOfDate rpm url-        when old $ removeFile rpm-        return old+        if checkremotetime+          then do+          old <- outOfDate rpmfile url+          when old $ removeFile rpmfile+          return old+          else do+          localtime <- getModificationTime rpmfile+          return $ localtime < taskstart || localtime > taskend       else return True-    when notfile $ putStrLn $ if debug then url else rpm+    -- FIXME is this still useful?+    when (notfile && debug) $ putStrLn url     return $ if notfile then Just url else Nothing   unless (null urls) $ do-    mapM_ putStrLn urls     putStrLn "downloading..."-    cmd_ "curl" $ ["--remote-time", "--fail", "-C-", "--show-error", "--remote-name-all", "--progress-bar"] ++ urls+    cmd_ "curl" $ ["--remote-time", "--fail", "-C-", "--show-error", "--create-dirs", "--output-dir", subdir, "--remote-name-all", "--progress-bar", "--write-out", "%{filename_effective}\n"] ++ urls   where     outOfDate :: String -> String -> IO Bool     outOfDate file url = do
src/Main.hs view
@@ -60,7 +60,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")       <*> switchWith 'T' "tail" "Fetch the tail of build.log"-      <*> switchWith 'i' "install" "install the package"+      <*> optional (installArgs <$> strOptionWith 'i' "install" "INSTALLOPTS" "Install the package with 'install' options")       <*> (Build <$> strOptionWith 'b' "build" "BUILD" "List child tasks of build"            <|> Pattern <$> strOptionWith 'p' "pattern" "NVRPAT" "Build tasks of matching pattern"            <|> argumentWith (maybeReader readTaskReq) "PACKAGE|TASKID"@@ -85,6 +85,7 @@                     "KojiFiles packages url [default: Fedora]")       <*> switchWith 'l' "list" "List builds"       <*> switchWith 'L' "latest" "Latest build"+      <*> switchWith 't' "check-remote-time" "Check remote rpm timestamps"       <*> switchWith 'r' "rpm" "Use rpm instead of dnf"       <*> switchWith 'N' "no-reinstall" "Do not reinstall existing NVRs"       <*> optional (strOptionWith 'b' "prefix" "SUBPKGPREFIX" "Prefix to use for subpackages [default: base package]")
src/Progress.hs view
@@ -11,7 +11,7 @@ #else import Control.Applicative ((<$>), (<*>)) #endif-import Control.Monad+import Control.Monad.Extra (unless, when)  import Formatting @@ -29,6 +29,7 @@ #if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>)) #endif+import Data.Time (diffUTCTime, getCurrentTime, NominalDiffTime) import Data.RPM.NVR import Data.Text (Text) import qualified Data.Text as T@@ -36,9 +37,9 @@ import SimpleCmd import System.FilePath ((</>)) +import Time import Utils --- FIXME quits after srpmbuild progressCmd :: Bool -> Int -> Bool -> [TaskID] -> IO () progressCmd debug waitdelay modules tids = do   when (waitdelay < 1) $ error' "minimum interval is 1 min"@@ -57,22 +58,27 @@   case mtaskinfo of     Nothing -> error' $ "taskinfo not found for " ++ displayID tid     Just taskinfo -> do-      parent <--        case lookupStruct "method" taskinfo :: Maybe String of-          Nothing -> error' $ "no method found for " ++ displayID tid-          Just method ->-            case method of-              "build" -> return tid-              "buildArch" ->-                case lookupStruct "parent" taskinfo of-                  Nothing -> error' $ "no parent found for " ++ displayID tid-                  Just parent -> return (TaskId parent)-              _ -> error' $ "unsupport method: " ++ method+      let parent =+            case lookupStruct "method" taskinfo :: Maybe String of+              Nothing -> error' $ "no method found for " ++ displayID tid+              Just method ->+                case method of+                  "build" -> tid+                  "buildArch" ->+                    case lookupStruct "parent" taskinfo of+                      Nothing -> error' $ "no parent found for " ++ displayID tid+                      Just par -> TaskId par+                  _ -> error' $ "unsupported method: " ++ method       children <- sortOn (\t -> lookupStruct "arch" t :: Maybe String) <$>                           kojiGetTaskChildren fedoraKojiHub parent True-      return (tid, zip children (repeat Nothing))+      let start =+            case lookupTime False taskinfo of+              Nothing ->+                error' $ "task " ++ displayID tid ++ " has no start time"+              Just t -> t+      return (tid, start, zip children (repeat Nothing)) -type BuildTask = (TaskID, [TaskInfoSize])+type BuildTask = (TaskID, UTCTime, [TaskInfoSize])  -- FIXME change to (TaskID,Struct,Size) type TaskInfoSize = (Struct,Maybe Int)@@ -93,32 +99,37 @@       threadDelay (fromEnum (fromIntegral (m * 60) :: Micro))      runProgress :: BuildTask -> IO BuildTask-    runProgress (tid,tasks) =+    runProgress (tid,start,tasks) =       case tasks of         [] -> do           state <- kojiGetTaskState fedoraKojiHub tid-          if state `elem` map Just openTaskStates then do+          if state `elem` map Just openTaskStates+            then do             threadDelayMinutes waitdelay             kojiTaskinfoRecursive tid-            else return (tid,[])+            else return (tid, start, [])         ((task,_):_) -> do-          putStrLn ""           when debug $ print task+          current <- getCurrentTime           let mnvr = kojiTaskRequestNVR task-          logMsg $ maybe "<unknown>" showNVR mnvr ++ " (" ++ displayID tid ++ ")"+              duration = diffUTCTime current start+          logMsg $ maybe "<unknown>" showNVR mnvr ++ " (" ++ displayID tid ++ ") " ++ renderDuration True duration           sizes <- mapM buildlogSize tasks           printLogSizes waitdelay sizes+          putStrLn ""           let news = map (\(t,(s,_)) -> (t,s)) sizes               open = filter (\ (t,_) -> getTaskState t `elem` map Just openTaskStates) news-          return (tid, open)+          if null open+            then runProgress (tid,start,[])+            else return (tid, start, open)      tasksOpen :: BuildTask -> Bool-    tasksOpen (_,ts) = not (null ts)+    tasksOpen (_,_,ts) = not (null ts)      updateBuildTask :: BuildTask -> IO BuildTask-    updateBuildTask (tid, ts) = do+    updateBuildTask (tid,start,ts) = do       news <- mapM updateTask ts-      return (tid, news)+      return (tid, start, news)      updateTask :: TaskInfoSize -> IO TaskInfoSize     updateTask (task,size) = do@@ -141,7 +152,12 @@       let few = dropWhile (== '0') $ takeEnd 4 tid in         if null few then "0" else few -data TaskOutput = TaskOut {_outArch :: Text, moutSize :: Maybe Int, moutSpeed :: Maybe Int, _outState :: Text, _method :: Text}+data TaskOutput = TaskOut {_outArch :: Text,+                           moutSize :: Maybe Int,+                           moutSpeed :: Maybe Int,+                           _outState :: Text,+                           _method :: Text,+                           _mduration :: Maybe NominalDiffTime}  printLogSizes :: Int -> [TaskInfoSizes] -> IO () printLogSizes waitdelay tss =@@ -149,8 +165,18 @@   in mapM_ (printTaskOut mxsi mxsp) taskoutputs   where     printTaskOut :: Int64 -> Int64 -> TaskOutput -> IO ()-    printTaskOut mxsi mxsp (TaskOut a msi msp st mth) =-      fprintLn (rpadded 8 ' ' stext % lpadded mxsi ' ' (optioned commas) % "kB" % " " % optioned ("[" % lpadded mxsp ' ' commas % " B/min]") % " " % stext % " " % stext) a ((`div` 1000) <$> msi) ((`div` waitdelay) <$> msp) st (abridgeMethod mth)+    printTaskOut mxsi mxsp (TaskOut a msi msp st mth mdur) =+      fprintLn (rpadded 8 ' ' stext %+                lpadded mxsi ' ' (optioned commas) % "kB" % " " %+                optioned ("[" % lpadded mxsp ' ' commas % " B/min]") % " " %+                stext % " " %+                optioned string % " " % stext)+      a+      ((`div` 1000) <$> msi)+      ((`div` waitdelay) <$> msp)+      st+      (renderDuration True <$> mdur)+      (abridgeMethod mth)      formatSize :: [TaskOutput] -> (Int64, Int64,[TaskOutput])     formatSize ts =@@ -174,8 +200,11 @@           arch = maybeVal "arch not found" (lookupStruct "arch") task :: Text           diff = (-) <$> size <*> old           state = maybeVal "No state found" getTaskState task-          state' = if state == TaskOpen then "" else T.pack (show state)-        in TaskOut arch size diff state' method+          state' =+            if state == TaskOpen+            then ""+            else T.pack $ show state+        in TaskOut arch size diff state' method (durationOfTask task)  kojiListBuildTasks :: Maybe String -> IO [TaskID] kojiListBuildTasks muser = do
src/Quick.hs view
@@ -87,7 +87,7 @@     let states = [TaskFailed|failure] ++ [TaskClosed|complete] ++                  [TaskOpen|current]         taskreq = maybe Tasks.TaskQuery Tasks.Package mpkg-    in Tasks.tasksCmd mhub user limit states archs Nothing Nothing detail debug Nothing ((tail' || failure) && not notail) install taskreq+    in Tasks.tasksCmd mhub user limit states archs Nothing Nothing detail debug Nothing ((tail' || failure) && not notail) (if install then Just (Tasks.PkgsReq [] []) else Nothing) taskreq   where     hasWord :: Words -> Bool     hasWord word = any (`elem` findWords word) args
src/Tasks.hs view
@@ -10,7 +10,8 @@   parseTaskState,   kojiMethods,   fedoraKojiHub,-  taskinfoUrl+  taskinfoUrl,+  Select(PkgsReq)   ) where @@ -72,8 +73,8 @@ -- FIXME --output-fields tasksCmd :: Maybe String -> Maybe UserOpt -> Int -> [TaskState]          -> [String] -> Maybe BeforeAfter -> Maybe String -> Bool -> Bool-         -> Maybe TaskFilter -> Bool -> Bool -> TaskReq -> IO ()-tasksCmd mhub museropt limit states archs mdate mmethod details debug mfilter' tail' install taskreq = do+         -> Maybe TaskFilter -> Bool -> Maybe Select -> TaskReq -> IO ()+tasksCmd mhub museropt limit states archs mdate mmethod details debug mfilter' tail' minstall taskreq = do   when (hub /= fedoraKojiHub && museropt == Just UserSelf) $     error' "--mine currently only works with Fedora Koji: use --user instead"   tz <- getCurrentTimeZone@@ -88,8 +89,9 @@           let hasparent = isJust $ mtaskParent res           printTask hasparent tz res           if hasparent-            then when install $ installCmd False debug No mhub Nothing False False False False Nothing (PkgsReq [] []) Nothing ReqName [show taskid]-            else tasksCmd (Just hub) museropt limit states archs mdate mmethod details debug mfilter' tail' install (Parent taskid)+            then whenJust minstall $ \installopts ->+            installCmd False debug No mhub Nothing False False False False False Nothing installopts Nothing ReqName [show taskid]+            else tasksCmd (Just hub) museropt limit states archs mdate mmethod details debug mfilter' tail' minstall (Parent taskid)     Build bld -> do       when (isJust mdate || isJust mfilter') $         error' "cannot use --build together with timedate or filter"@@ -97,7 +99,7 @@                 then ((fmap TaskId . lookupStruct "task_id") =<<) <$> getBuild hub (InfoID (read bld))                 else kojiGetBuildTaskID hub bld       whenJust mtaskid $ \(TaskId taskid) ->-        tasksCmd (Just hub) museropt limit states archs mdate mmethod details debug mfilter' tail' install (Parent taskid)+        tasksCmd (Just hub) museropt limit states archs mdate mmethod details debug mfilter' tail' minstall (Parent taskid)     Package pkg -> do       when (head pkg == '-') $         error' $ "bad combination: not a package " ++ pkg@@ -113,7 +115,7 @@           forM_ builds $ \bld -> do             let mtaskid = (fmap TaskId . lookupStruct "task_id") bld             whenJust mtaskid $ \(TaskId taskid) ->-              tasksCmd (Just hub) museropt 10 states archs mdate mmethod details debug mfilter' tail' install (Parent taskid)+              tasksCmd (Just hub) museropt 10 states archs mdate mmethod details debug mfilter' tail' minstall (Parent taskid)     Pattern pat -> do       let buildquery = [("pattern", ValueString pat),                         commonBuildQueryOptions limit]@@ -123,7 +125,7 @@       forM_ builds $ \bld -> do         let mtaskid = (fmap TaskId . lookupStruct "task_id") bld         whenJust mtaskid $ \(TaskId taskid) ->-          tasksCmd (Just hub) museropt 10 states archs mdate mmethod details debug mfilter' tail' install (Parent taskid)+          tasksCmd (Just hub) museropt 10 states archs mdate mmethod details debug mfilter' tail' minstall (Parent taskid)     _ -> do       query <- setupQuery       let queryopts = commonQueryOptions limit "-id"@@ -133,9 +135,9 @@       let exact = length tasks == 1           detailed = details || exact       (mapM_ (printTask detailed tz) . filterResults . mapMaybe maybeTaskResult) tasks-      when install $+      whenJust minstall $ \args ->         if exact-        then installCmd False debug No mhub Nothing False False False False Nothing (PkgsReq [] []) Nothing ReqName [show (i :: Int) | i <- mapMaybe (lookupStruct "id") tasks]+        then installCmd False debug No mhub Nothing False False False False False Nothing args Nothing ReqName [show (i :: Int) | i <- mapMaybe (lookupStruct "id") tasks]         else error' "cannot install more than one task"   where     hub = maybe fedoraKojiHub hubURL mhub@@ -191,8 +193,8 @@     maybeTaskResult :: Struct -> Maybe TaskResult     maybeTaskResult st = do       arch <- lookupStruct "arch" st-      let mstart_time = lookupTime "start" st-          mend_time = lookupTime "completion" st+      let mstart_time = lookupTime False st+          mend_time = lookupTime True st       taskid <- lookupStruct "id" st       method <- lookupStruct "method" st       state <- getTaskState st@@ -234,7 +236,8 @@     pPrintCompact = #if MIN_VERSION_pretty_simple(4,0,0)       pPrintOpt CheckColorTty-      (defaultOutputOptionsDarkBg {outputOptionsCompact = True})+      (defaultOutputOptionsDarkBg {outputOptionsCompact = True,+                                   outputOptionsCompactParens = True}) #else       pPrint #endif@@ -275,9 +278,9 @@       ++     case mtime of       Just now ->-        ["current duration: " ++ renderDuration False dur | Just start <- [mstart],  let dur = diffUTCTime now start]+        ["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]+        ["duration: " ++ renderDuration False dur | Just start <- [mstart], Just end <- [mend], let dur = diffUTCTime end start]  #endif
src/Time.hs view
@@ -3,8 +3,12 @@ module Time (   compactZonedTime,   lookupTime,+  lookupTimes,+  lookupTimes',+  durationOfTask,   formatLocalTime,-  renderDuration)+  renderDuration,+  UTCTime) where  import Data.Time.Clock@@ -22,13 +26,36 @@ compactZonedTime tz =   formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S%Z" . utcToZonedTime tz -lookupTime :: String -> Struct -> Maybe UTCTime-lookupTime prefix str = do+lookupTime :: Bool -> Struct -> Maybe UTCTime+lookupTime completion 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"+  where+    prefix = if completion then "completion" else "start"++lookupTimes :: Struct -> Maybe (UTCTime, Maybe UTCTime)+lookupTimes str = do+  start <- lookupTime False str+  let mend = lookupTime True str+  return (start,mend)++lookupTimes' :: Struct -> (UTCTime, UTCTime)+lookupTimes' str =+  case lookupTimes str of+    Nothing -> error "no start time for task"+    Just (start,mend) ->+      case mend of+        Nothing -> error "no end time for task"+        Just end -> (start,end)++durationOfTask :: Struct -> Maybe NominalDiffTime+durationOfTask str = do+  (start,mend) <- lookupTimes str+  end <- mend+  return $ diffUTCTime end start  formatLocalTime :: Bool -> TimeZone -> UTCTime -> String formatLocalTime start tz t =
src/Utils.hs view
@@ -1,6 +1,8 @@ module Utils (   kojiTaskRequestNVR,   kojiTaskRequestPkgNVR,+  kojiGetBuildID',+  kojiGetBuild',   showValue,   buildOutputURL,   hubToPkgsURL@@ -12,6 +14,7 @@ import Data.RPM.NVR import Data.RPM.NVRA import Distribution.Koji+import qualified Distribution.Koji.API as Koji import Network.HTTP.Directory ((+/+)) import SimpleCmd (error') import System.FilePath (takeBaseName)@@ -41,6 +44,20 @@                    then tail $ dropWhile (/= ';') base                    else base     _ -> error' "could determine package from build request"++kojiGetBuildID' :: String -> String -> IO BuildID+kojiGetBuildID' hub nvr = do+  mbid <- kojiGetBuildID hub nvr+  case mbid of+    Nothing -> error' $ "build id not found for " ++ nvr+    Just bid -> return bid++kojiGetBuild' :: String -> NVR -> IO Koji.Struct+kojiGetBuild' hub nvr = do+  mbld <- Koji.getBuild hub (Koji.InfoString (showNVR nvr))+  case mbld of+    Nothing -> error' $ "build not found for " ++ showNVR nvr+    Just bld -> return bld  showValue :: Value -> String showValue (ValueString cs) = cs