diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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' diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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` diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -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 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.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 diff --git a/src/Builds.hs b/src/Builds.hs --- a/src/Builds.hs +++ b/src/Builds.hs @@ -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 diff --git a/src/DownloadDir.hs b/src/DownloadDir.hs --- a/src/DownloadDir.hs +++ b/src/DownloadDir.hs @@ -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 diff --git a/src/Install.hs b/src/Install.hs --- a/src/Install.hs +++ b/src/Install.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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]") diff --git a/src/Progress.hs b/src/Progress.hs --- a/src/Progress.hs +++ b/src/Progress.hs @@ -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 "" showNVR mnvr ++ " (" ++ displayID tid ++ ")" + duration = diffUTCTime current start + logMsg $ maybe "" 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 diff --git a/src/Quick.hs b/src/Quick.hs --- a/src/Quick.hs +++ b/src/Quick.hs @@ -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 diff --git a/src/Tasks.hs b/src/Tasks.hs --- a/src/Tasks.hs +++ b/src/Tasks.hs @@ -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 diff --git a/src/Time.hs b/src/Time.hs --- a/src/Time.hs +++ b/src/Time.hs @@ -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 = diff --git a/src/Utils.hs b/src/Utils.hs --- a/src/Utils.hs +++ b/src/Utils.hs @@ -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