koji-tool 0.9 → 0.9.1
raw patch · 12 files changed
+277/−147 lines, 12 files
Files
- ChangeLog.md +9/−0
- README.md +16/−8
- TODO +4/−1
- koji-tool.cabal +1/−1
- src/Builds.hs +12/−9
- src/Install.hs +38/−40
- src/Main.hs +12/−11
- src/Progress.hs +1/−0
- src/Quick.hs +13/−3
- src/Tasks.hs +119/−71
- src/Time.hs +27/−1
- src/Utils.hs +25/−2
ChangeLog.md view
@@ -1,5 +1,14 @@ # Version history of koji-tool +## 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+ ## 0.9 (2022-05-20) - rename 'quick' command to 'find' - 'builds': compact output now appends url
README.md view
@@ -23,7 +23,7 @@ ## Commands ```shellsession $ koji-tool --version-0.9+0.9.1 $ koji-tool --help Query and track Koji tasks, and install rpms from Koji. @@ -43,8 +43,9 @@ install Install rpm packages directly from a Koji build task progress Track running Koji tasks by buildlog size buildlog-sizes Show buildlog sizes for nvr patterns- find Simple quick common queries using words- (my,last,fail,complete,current,build,detail,PACKAGE)+ find Simple quick common queries using words like: [my,+ last, fail, complete, current, build, detail,+ install, tail, notail, x86_64, PACKAGE, USER\'s] ``` ## koji-tool builds@@ -133,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]+ [-T|--tail] [-i|--install] [(-b|--build BUILD) | (-p|--pattern NVRPAT) | PACKAGE|TASKID] Query Koji tasks (by default lists most recent buildArch tasks)@@ -157,6 +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 -b,--build BUILD List child tasks of build -p,--pattern NVRPAT Build tasks of matching pattern -h,--help Show this help text@@ -214,8 +216,12 @@ current building open build builds detail details detailed+install+tail+notail+x86_64 aarch64 ppc64le s390x i686 armv7hl PACKAGE-USER's+USER\'s ``` @@ -273,7 +279,8 @@ $ koji-tool install --help Usage: koji-tool install [-n|--dry-run] [-D|--debug] [-y|--yes] [-H|--hub HUB] [-P|--packages-url URL] [-l|--list] [-L|--latest]- [-N|--no-reinstall] [-b|--prefix SUBPKGPREFIX]+ [-r|--rpm] [-N|--no-reinstall]+ [-b|--prefix SUBPKGPREFIX] [(-a|--all) | (-A|--ask) | [-p|--package SUBPKG] [-x|--exclude SUBPKG]] [-d|--disttag DISTTAG] [(-R|--nvr) | (-V|--nv)] PKG|NVR|TASKID...@@ -289,13 +296,14 @@ -P,--packages-url URL KojiFiles packages url [default: Fedora] -l,--list List builds -L,--latest Latest build+ -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] -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: .fc36]+ -d,--disttag DISTTAG Override the disttag -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@@ -326,7 +334,7 @@ The `buildlog-sizes` command is similar but runs once over nvr patterns. ## Installation-Builds for fedora are available in [copr](https://copr.fedorainfracloud.org/coprs/petersen/koji-tool/monitor/detailed).+koji-tool is packaged in Fedora 35+ ## Build `cabal-rpm builddep && cabal install || stack install`
TODO view
@@ -19,6 +19,9 @@ - --short option - --active or state filter +# find+- shell+ ## tasks - determine username for non-Fedora - build pattern@@ -44,7 +47,7 @@ - % of previous build (or finished tasks) - mbs urls? - average build times? (cache or separate tool?)-- quits during srpm builds+* quits after srpm build - show log sizes for old finished builds - display buildtimes for completed tasks
koji-tool.cabal view
@@ -1,5 +1,5 @@ name: koji-tool-version: 0.9+version: 0.9.1 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
@@ -19,7 +19,6 @@ import Data.Maybe import Data.RPM.NVR import Data.Time.Clock-import Data.Time.Format import Data.Time.LocalTime import Distribution.Koji import Distribution.Koji.API@@ -30,6 +29,7 @@ import qualified Tasks import Time import User+import Utils (buildOutputURL) data BuildReq = BuildBuild String | BuildPackage String | BuildQuery | BuildPattern String@@ -43,6 +43,8 @@ capitalize "" = "" capitalize (h:t) = toUpper h : t +-- FIXME show tail of build's build.log+-- FIXME add --install buildsCmd :: Maybe String -> Maybe UserOpt -> Int -> [BuildState] -> Maybe Tasks.BeforeAfter -> Maybe String -> Bool -> Bool -> BuildReq -> IO ()@@ -146,9 +148,9 @@ buildinfoUrl hub bid = webUrl hub ++ "/buildinfo?buildID=" ++ show bid --- FIXME+-- FIXME only 2 accessors data BuildResult =- BuildResult {_buildNVR :: NVR,+ BuildResult {buildNVR :: NVR, _buildState :: BuildState, _buildId :: Int, _mtaskId :: Maybe Int,@@ -169,27 +171,28 @@ BuildResult nvr state buildid mtaskid start_time mend_time printBuild :: String -> TimeZone -> BuildResult -> IO ()-printBuild hub tz task = do+printBuild hub tz build = do putStrLn ""- let mendtime = mbuildEndTime task+ let mendtime = mbuildEndTime build time <- maybe getCurrentTime return mendtime- (mapM_ putStrLn . formatBuildResult hub (isJust mendtime) tz) (task {mbuildEndTime = Just time})+ (mapM_ putStrLn . formatBuildResult hub (isJust mendtime) tz) (build {mbuildEndTime = Just time})+ putStrLn $ buildOutputURL hub $ buildNVR build formatBuildResult :: String -> Bool -> TimeZone -> BuildResult -> [String] formatBuildResult hub ended tz (BuildResult nvr state buildid mtaskid start mendtime) = [ showNVR nvr +-+ show state , buildinfoUrl hub buildid] ++ [Tasks.taskinfoUrl hub taskid | Just taskid <- [mtaskid]]- ++ [formatTime defaultTimeLocale "Start: %c" (utcToZonedTime tz start)]+ ++ [formatLocalTime True tz start] ++ case mendtime of Nothing -> [] Just end ->- [formatTime defaultTimeLocale "End: %c" (utcToZonedTime tz end) | ended]+ [formatLocalTime False tz end | ended] #if MIN_VERSION_time(1,9,1) ++ let dur = diffUTCTime end start- in [(if not ended then "current " else "") ++ "duration: " ++ formatTime defaultTimeLocale "%Hh %Mm %Ss" dur]+ in [(if not ended then "current " else "") ++ "duration: " ++ renderDuration False dur] #endif #if !MIN_VERSION_koji(0,0,3)
src/Install.hs view
@@ -3,7 +3,7 @@ -- SPDX-License-Identifier: BSD-3-Clause module Install (- Mode(..),+ Select(..), Request(..), installCmd, knownHubs,@@ -32,22 +32,10 @@ import DownloadDir import Utils -defaultPkgsURL :: String -> String-defaultPkgsURL url =- case dropSuffix "/" url of- "https://koji.fedoraproject.org/kojihub" ->- "https://kojipkgs.fedoraproject.org/packages"- "https://kojihub.stream.centos.org/kojihub" ->- "https://kojihub.stream.centos.org/kojifiles/packages"- _ ->- if "kojihub" `isSuffixOf` url- then replace "kojihub" "kojifiles" url +/+ "packages"- else error' $ "use --files-url to specify kojifiles url for " ++ url- data Yes = No | Yes deriving Eq -data Mode = All+data Select = All | Ask -- distinguish except and exclude | PkgsReq [String] [String] -- ^ include, except/exclude@@ -63,12 +51,13 @@ -- FIXME --debuginfo -- FIXME --delete after installing -- FIXME --dnf to install selected packages using default dnf repo instead+-- FIXME offer to download subpackage deps installCmd :: Bool -> Bool -> Yes -> Maybe String -> Maybe String -> Bool- -> Bool -> Bool -> Maybe String -> Mode -> String -> Request- -> [String] -> IO ()-installCmd dryrun debug yes mhuburl mpkgsurl listmode latest noreinstall mprefix mode disttag request pkgbldtsks = do+ -> 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 let huburl = maybe fedoraKojiHub hubURL mhuburl- pkgsurl = fromMaybe (defaultPkgsURL huburl) mpkgsurl+ pkgsurl = fromMaybe (hubToPkgsURL huburl) mpkgsurl when debug $ do putStrLn huburl putStrLn pkgsurl@@ -76,22 +65,28 @@ when debug printDlDir setNoBuffering mapM (kojiRPMs huburl pkgsurl printDlDir) pkgbldtsks- >>= installRPMs dryrun noreinstall yes . mconcat+ >>= installRPMs dryrun userpm noreinstall yes . mconcat where kojiRPMs :: String -> String -> IO () -> String -> IO [(Existence,NVRA)] kojiRPMs huburl pkgsurl printDlDir bldtask = case readMaybe bldtask of- Just taskid -> kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode noreinstall mprefix mode printDlDir taskid+ Just taskid -> kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode noreinstall mprefix select printDlDir taskid Nothing -> kojiBuildRPMs huburl pkgsurl printDlDir bldtask kojiBuildRPMs :: String -> String -> IO () -> String -> IO [(Existence,NVRA)] kojiBuildRPMs huburl pkgsurl printDlDir pkgbld = do+ disttag <-+ case mdisttag of+ Just dt -> return dt+ Nothing -> do+ dist <- cmd "rpm" ["--eval", "%{dist}"]+ return $ if dist == "%{dist}" then "" else dist nvrs <- map readNVR <$> kojiBuildOSBuilds debug huburl listmode latest disttag request pkgbld if listmode then do- if mode /= PkgsReq [] []- then error' "modes not supported for listing build" -- FIXME+ if select /= PkgsReq [] []+ then error' "selects not supported for listing build" -- FIXME else case nvrs of [nvr] -> do putStrLn (showNVR nvr)@@ -108,7 +103,7 @@ nvras <- sort . map readNVRA . filter notDebugPkg <$> kojiGetBuildRPMs huburl nvr when debug $ mapM_ (putStrLn . showNVRA) nvras let prefix = fromMaybe (nvrName nvr) mprefix- dlRpms <- decideRpms yes listmode noreinstall mode prefix nvras+ dlRpms <- decideRpms yes listmode noreinstall select prefix nvras when debug $ mapM_ printInstalled dlRpms unless (dryrun || null dlRpms) $ do downloadRpms debug (buildURL nvr) dlRpms@@ -128,8 +123,8 @@ not ("-debuginfo-" `isInfixOf` p || "-debugsource-" `isInfixOf` p) kojiTaskRPMs :: Bool -> Bool -> Yes -> String -> String -> Bool -> Bool- -> Maybe String -> Mode -> IO () -> Int -> IO [(Existence,NVRA)]-kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode noreinstall mprefix mode printDlDir taskid = do+ -> Maybe String -> Select -> IO () -> Int -> IO [(Existence,NVRA)]+kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode noreinstall mprefix select printDlDir taskid = do mtaskinfo <- Koji.getTaskInfo huburl taskid True tasks <- case mtaskinfo of Nothing -> error' "failed to get taskinfo"@@ -162,15 +157,15 @@ kojiTaskRequestPkgNVR $ fromMaybe archtask mtaskinfo if listmode- then decideRpms yes listmode noreinstall mode prefix nvras+ then decideRpms yes listmode noreinstall select prefix nvras else if null nvras then do- kojiTaskRPMs dryrun debug yes huburl pkgsurl True noreinstall mprefix mode printDlDir archtid >>= mapM_ printInstalled+ kojiTaskRPMs dryrun debug yes huburl pkgsurl True noreinstall mprefix select printDlDir archtid >>= mapM_ printInstalled return [] else do when debug $ print $ map showNVRA nvras- dlRpms <- decideRpms yes listmode noreinstall mode prefix $+ dlRpms <- decideRpms yes listmode noreinstall select prefix $ filter ((/= "src") . rpmArch) nvras when debug $ mapM_ printInstalled dlRpms unless (dryrun || null dlRpms) $ do@@ -194,14 +189,14 @@ data Existence = NotInstalled | NVRInstalled | NVRChanged deriving (Eq, Ord, Show) -decideRpms :: Yes -> Bool -> Bool -> Mode -> String -> [NVRA]+decideRpms :: Yes -> Bool -> Bool -> Select -> String -> [NVRA] -> IO [(Existence,NVRA)]-decideRpms yes listmode noreinstall mode prefix nvras = do+decideRpms yes listmode noreinstall select prefix nvras = do classified <- mapM installExists (filter isBinaryRpm nvras) if listmode then mapM_ printInstalled classified >> return [] else- case mode of+ case select of All -> do mapM_ printInstalled classified ok <- prompt yes "install above"@@ -380,19 +375,22 @@ hSetBuffering stdin NoBuffering hSetBuffering stdout NoBuffering -installRPMs :: Bool -> Bool -> Yes -> [(Existence,NVRA)] -> IO ()-installRPMs _ _ _ [] = return ()-installRPMs dryrun noreinstall yes classified = do+installRPMs :: Bool -> Bool -> Bool -> Yes -> [(Existence,NVRA)] -> IO ()+installRPMs _ _ _ _ [] = return ()+installRPMs dryrun rpm noreinstall yes classified = forM_ (groupSort classified) $ \(cl,pkgs) -> unless (null pkgs) $- let mdnfcmd =+ let pkgmgr = if rpm then "rpm" else "dnf"+ mcom = case cl of- NVRInstalled -> if noreinstall then Nothing else Just "reinstall"- _ -> Just "localinstall"- in whenJust mdnfcmd $ \dnfcmd ->+ NVRInstalled -> if noreinstall+ then Nothing+ else Just (if rpm then ["-Uvh","--replacepkgs"] else ["reinstall"])+ _ -> Just (if rpm then ["-ivh"] else ["localinstall"])+ in whenJust mcom $ \com -> if dryrun- then mapM_ putStrLn $ ("would " ++ dnfcmd ++ ":") : map showRpmFile pkgs- else sudo_ "dnf" $ dnfcmd : map showRpmFile pkgs ++ ["--assumeyes" | yes == Yes]+ then mapM_ putStrLn $ ("would" +-+ unwords (pkgmgr : com) ++ ":") : map showRpmFile pkgs+ else sudo_ pkgmgr $ com ++ map showRpmFile pkgs ++ ["--assumeyes" | yes == Yes && not rpm] showRpmFile :: NVRA -> FilePath showRpmFile nvra = showNVRA nvra <.> "rpm"
src/Main.hs view
@@ -20,9 +20,6 @@ main :: IO () main = do- sysdisttag <- do- dist <- cmd "rpm" ["--eval", "%{dist}"]- return $ if dist == "%{dist}" then "" else dist simpleCmdArgs (Just Paths_koji_tool.version) "Query and track Koji tasks, and install rpms from Koji." "see https://github.com/juhp/koji-tool#readme" $@@ -63,6 +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" <*> (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"@@ -87,10 +85,11 @@ "KojiFiles packages url [default: Fedora]") <*> switchWith 'l' "list" "List builds" <*> switchWith 'L' "latest" "Latest build"+ <*> 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]")- <*> modeOpt- <*> disttagOpt sysdisttag+ <*> selectOpt+ <*> optional disttagOpt <*> (flagWith' ReqNVR 'R' "nvr" "Give an N-V-R instead of package name" <|> flagWith ReqName ReqNV 'V' "nv" "Give an N-V instead of package name") <*> some (strArg "PKG|NVR|TASKID...")@@ -107,8 +106,8 @@ buildlogSizesCmd <$> strArg "NVRPATTERN" , Subcommand "find"- ("Simple quick common queries using words (" ++- intercalate "," (wordsList head) ++ ")") $+ ("Simple quick common queries using words like: [" +++ intercalate ", " (wordsList head) ++ "]") $ findCmd <$> hubOpt <*> switchWith 'D' "debug" "Debug output including XML results"@@ -125,14 +124,16 @@ User <$> strOptionWith 'u' "user" "USER" "Koji user" <|> flagWith' UserSelf 'M' "mine" "Your tasks (krb fasid)" - modeOpt :: Parser Mode- modeOpt =+ selectOpt :: Parser Select+ selectOpt = flagWith' All 'a' "all" "all subpackages" <|> flagWith' Ask 'A' "ask" "ask for each subpackge [default if not installed]" <|> 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+ disttagOpt :: Parser String+ disttagOpt = startingDot <$>+ strOptionWith 'd' "disttag" "DISTTAG"+ "Select a disttag different to system" startingDot cs = case cs of
src/Progress.hs view
@@ -38,6 +38,7 @@ 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"
src/Quick.hs view
@@ -18,6 +18,7 @@ import User data Words = Mine | Limit | Failure | Complete | Current | Build | Detail+ | Install | Tail | NoTail | Arch deriving (Enum,Bounded) findWords :: Words -> [String]@@ -30,10 +31,14 @@ findWords Current = ["current","building","open"] findWords Build = ["build","builds"] findWords Detail = ["detail","details","detailed"]+findWords Install = ["install"]+findWords Tail = ["tail"]+findWords NoTail = ["notail"]+findWords Arch = ["x86_64", "aarch64", "ppc64le", "s390x", "i686", "armv7hl"] wordsList :: ([String] -> String) -> [String] wordsList f =- map (f . findWords) [minBound..] ++ ["PACKAGE"] -- "USER's" hidden!+ map (f . findWords) [minBound..] ++ ["PACKAGE","USER\\'s"] allWords :: [String] allWords = concatMap findWords [minBound..]@@ -43,7 +48,7 @@ -- FIXME: mlt (or mlft) findCmd :: Maybe String -> Bool -> [String] -> IO () findCmd _ _ [] = error' $ "find handles these words:\n\n" ++- unlines (wordsList unwords ++ ["USER's"])+ unlines (wordsList unwords) findCmd mhub debug args = do let user = if hasWord Mine then Just UserSelf@@ -52,12 +57,17 @@ [users] -> Just $ User (dropSuffix "'s" users) more -> error' $ "more than one user's given: " ++ unwords more+ archs = if hasWord Arch+ then filter (`elem` findWords Arch) args else [] limit = if hasWord Limit then 1 else 10 failure = hasWord Failure complete = hasWord Complete current = hasWord Current build = hasWord Build detail = hasWord Detail+ install = hasWord Install+ tail' = hasWord Tail+ notail = hasWord NoTail mpkg = case removeUsers (args \\ allWords) of [] -> Nothing@@ -77,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 [] Nothing Nothing detail debug Nothing failure taskreq+ in Tasks.tasksCmd mhub user limit states archs Nothing Nothing detail debug Nothing ((tail' || failure) && not notail) install taskreq where hasWord :: Words -> Bool hasWord word = any (`elem` findWords word) args
src/Tasks.hs view
@@ -24,7 +24,6 @@ #endif import Data.RPM.NVR import Data.Time.Clock-import Data.Time.Format import Data.Time.LocalTime import Distribution.Koji import Distribution.Koji.API@@ -36,6 +35,7 @@ import Text.Pretty.Simple import Common+import Install import Time import User import Utils@@ -55,16 +55,25 @@ getTimedate (Before s) = s getTimedate (After s) = s -capitalize :: String -> String-capitalize "" = ""-capitalize (h:t) = toUpper h : t+data TaskResult =+ TaskResult {taskPackage :: Either String NVR,+ taskArch :: String,+ _taskMethod :: String,+ _taskState :: TaskState,+ mtaskParent :: Maybe Int,+ taskId :: Int,+ _mtaskStartTime :: Maybe UTCTime,+ mtaskEndTime :: Maybe UTCTime+ } --- FIXME short output summary+-- FIXME short output option -- --sibling+-- FIXME --tail-size option (eg more that 4000B)+-- FIXME --output-fields 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+ -> Maybe TaskFilter -> Bool -> Bool -> TaskReq -> IO ()+tasksCmd mhub museropt limit states archs mdate mmethod details debug mfilter' tail' install taskreq = do when (hub /= fedoraKojiHub && museropt == Just UserSelf) $ error' "--mine currently only works with Fedora Koji: use --user instead" tz <- getCurrentTimeZone@@ -78,8 +87,9 @@ whenJust (maybeTaskResult task) $ \res -> do let hasparent = isJust $ mtaskParent res printTask hasparent tz res- unless hasparent $- tasksCmd (Just hub) museropt limit states archs mdate mmethod details debug mfilter' tail' (Parent taskid)+ 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) Build bld -> do when (isJust mdate || isJust mfilter') $ error' "cannot use --build together with timedate or filter"@@ -87,7 +97,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' (Parent taskid)+ tasksCmd (Just hub) museropt limit states archs mdate mmethod details debug mfilter' tail' install (Parent taskid) Package pkg -> do when (head pkg == '-') $ error' $ "bad combination: not a package " ++ pkg@@ -103,7 +113,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' (Parent taskid)+ tasksCmd (Just hub) museropt 10 states archs mdate mmethod details debug mfilter' tail' install (Parent taskid) Pattern pat -> do let buildquery = [("pattern", ValueString pat), commonBuildQueryOptions limit]@@ -113,15 +123,20 @@ 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' (Parent taskid)+ tasksCmd (Just hub) museropt 10 states archs mdate mmethod details debug mfilter' tail' install (Parent taskid) _ -> do query <- setupQuery let queryopts = commonQueryOptions limit "-id" when debug $ print $ query ++ queryopts tasks <- listTasks hub query queryopts when debug $ mapM_ pPrintCompact tasks- let detailed = details || length tasks == 1+ let exact = length tasks == 1+ detailed = details || exact (mapM_ (printTask detailed tz) . filterResults . mapMaybe maybeTaskResult) tasks+ when install $+ 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]+ else error' "cannot install more than one task" where hub = maybe fedoraKojiHub hubURL mhub @@ -150,6 +165,10 @@ ++ [("arch", ValueArray (map (ValueString . kojiArch) archs)) | notNull archs] ++ [("method", ValueString method) | let method = fromMaybe "buildArch" mmethod] + capitalize :: String -> String+ capitalize "" = ""+ capitalize (h:t) = toUpper h : t+ kojiArch :: String -> String kojiArch "i686" = "i386" kojiArch "armv7hl" = "armhfp"@@ -206,8 +225,9 @@ if detailed then do putStrLn ""+ -- FIX for parent/build method show children (like we do with taskid) (mapM_ putStrLn . formatTaskResult hub mtime tz) task- buildlogSize tail' $ taskId task+ buildlogSize debug tail' hub task else (putStrLn . compactTaskResult hub tz) task @@ -231,8 +251,12 @@ Just end -> compactZonedTime tz end Nothing -> maybe "" (compactZonedTime tz) mstart in- showPackage pkg ++ (if method == "buildArch" then '.' : arch ++ replicate (8 - length arch) ' ' else ' ' : method) +-+- show state +-+ time +-+ taskinfoUrl hub taskid+ unwords $+ [showPackage pkg ++ if method == "buildArch" then '.' : arch ++ replicate (8 - length arch) ' ' else ' ' : method,+ show state,+ time] +++ ["(" ++ renderDuration True dur ++ ")" | Just start <- [mstart], Just end <- [mend], let dur = diffUTCTime end start] +++ [taskinfoUrl hub taskid] -- FIXME show task owner formatTaskResult :: String -> Maybe UTCTime -> TimeZone -> TaskResult -> [String]@@ -245,15 +269,15 @@ tz (TaskResult pkg arch method state mparent taskid mstart mend) = [ showPackage pkg ++ (if method == "buildArch" then '.' : arch else ' ' : method) +-+ show state , taskinfoUrl hub taskid +-+ maybe "" (\p -> "(parent: " ++ show p ++ ")") mparent] ++- [formatTime defaultTimeLocale "Start: %c" (utcToZonedTime tz start) | Just start <- [mstart]] ++- [formatTime defaultTimeLocale "End: %c" (utcToZonedTime tz end) | Just end <- [mend]]+ [formatLocalTime True tz start | Just start <- [mstart]] +++ [formatLocalTime False tz end | Just end <- [mend]] #if MIN_VERSION_time(1,9,1) ++ case mtime of Just now ->- ["current duration: " ++ formatTime defaultTimeLocale "%Hh %Mm %Ss" dur | Just start <- [mstart], let dur = diffUTCTime now start]+ ["current duration: " ++ renderDuration False dur | Just start <- [mstart], let dur = diffUTCTime now start] Nothing ->- ["duration: " ++ formatTime defaultTimeLocale "%Hh %Mm %Ss" 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 @@ -261,17 +285,6 @@ showPackage (Left p) = p showPackage (Right nvr) = showNVR nvr -data TaskResult =- TaskResult {taskPackage :: Either String NVR,- _taskArch :: String,- _taskMethod :: String,- _taskState :: TaskState,- mtaskParent :: Maybe Int,- taskId :: Int,- _mtaskStartTime :: Maybe UTCTime,- mtaskEndTime :: Maybe UTCTime- }- #if !MIN_VERSION_koji(0,0,3) taskStateToValue :: TaskState -> Value taskStateToValue = ValueInt . fromEnum@@ -291,41 +304,98 @@ _ -> error' $! "unknown task state: " ++ s #endif -data LastLog = WholeBuild | BuildTail | RootLog+data LogFile = BuildLog | RootLog deriving Eq -logUrl :: Int -> LastLog -> String-logUrl taskid lastlog =- if lastlog == BuildTail- then "https://koji.fedoraproject.org/koji/getfile?taskID=" ++ tid ++ "&name=build.log&offset=-4000"- else "https://kojipkgs.fedoraproject.org/work/tasks" </> lastFew </> tid </> logName <.> "log"+data OutputLocation = PackagesOutput | WorkOutput++outputUrl :: String -> TaskResult -> OutputLocation -> Maybe String+outputUrl hub task loc =+ case loc of+ WorkOutput -> Just $ taskOutputUrl task+ PackagesOutput ->+ case taskPackage task of+ Left _ -> Nothing+ Right nvr ->+ Just $ buildOutputURL hub nvr +/+ "data/logs" +/+ taskArch task++findOutputURL :: String -> TaskResult -> IO (Maybe String)+findOutputURL hub task =+ case outputUrl hub task PackagesOutput of+ Just burl -> urlExistsOr burl $+ urlExistsOr (taskOutputUrl task) $ return Nothing+ Nothing -> urlExistsOr (taskOutputUrl task) $ return Nothing where- tid = show taskid+ urlExistsOr :: String -> IO (Maybe String) -> IO (Maybe String)+ urlExistsOr url alt = do+ exists <- httpExists' url+ if exists+ then return $ Just url+ else alt +taskOutputUrl :: TaskResult -> String+taskOutputUrl task =+ "https://kojipkgs.fedoraproject.org/work/tasks" </> lastFew </> tid+ where+ tid = show (taskId task)+ lastFew = let few = dropWhile (== '0') $ takeEnd 4 tid in if null few then "0" else few - logName = if lastlog == RootLog then "root" else "build"+tailLogUrl :: String -> Int -> LogFile -> String+tailLogUrl hub taskid file =+ webUrl hub +/+ "getfile?taskID=" ++ show taskid ++ "&name=" ++ logFile file ++ "&offset=-4000" -buildlogSize :: Bool -> Int -> IO ()-buildlogSize tail' taskid = do- let buildlog = logUrl taskid WholeBuild- exists <- httpExists' buildlog- when exists $ do+logFile :: LogFile -> String+logFile RootLog = "root.log"+logFile BuildLog = "build.log"++buildlogSize :: Bool -> Bool -> String -> TaskResult -> IO ()+buildlogSize debug tail' hub task = do+ murl <- findOutputURL hub task+ whenJust murl $ \ url -> do+ let buildlog = url +/+ logFile BuildLog putStr $ buildlog ++ " " msize <- httpFileSize' buildlog whenJust msize $ \size -> do fprintLn ("(" % commas % "kB)") (size `div` 1000) -- FIXME check if short build.log ends with srpm- lastlog <-+ file <- if size < 1500 then do- putStrLn $ logUrl taskid RootLog+ putStrLn $ url +/+ logFile RootLog return RootLog- else return BuildTail- when tail' $- displayLog taskid lastlog+ else return BuildLog+ when tail' $ displayLog url file+ when debug $ putStrLn buildlog+ where+ displayLog :: String -> LogFile -> IO ()+ displayLog url file = do+ let logurl =+ case file of+ RootLog -> url +/+ logFile file+ BuildLog -> tailLogUrl hub (taskId task) file+ req <- parseRequest logurl+ resp <- httpLBS req+ let out = U.toString $ getResponseBody resp+ ls = lines out+ putStrLn ""+ if file == RootLog+ then+ let excluded = ["Executing command:", "Child return code was: 0",+ "child environment: None", "ensuring that dir exists:",+ "touching file:", "creating dir:", "kill orphans"]+ in putStr $ unlines $ map (dropPrefix "DEBUG ") $ takeEnd 30 $+ filter (\l -> not (any (`isInfixOf` l) excluded)) ls+ else+ if last ls == "Child return code was: 0"+ then putStr out+ else putStr . unlines $+ case breakOnEnd ["Child return code was: 1"] ls of+ ([],ls') -> ls'+ (ls',_) -> ls'+ putStrLn $ "\n" ++ logurl kojiMethods :: [String] kojiMethods =@@ -391,25 +461,3 @@ "tagBuild", "tagNotification", "waitrepo"])--displayLog :: Int -> LastLog -> IO ()-displayLog tid lastlog = do- req <- parseRequest $ logUrl tid lastlog- resp <- httpLBS req- let out = U.toString $ getResponseBody resp- ls = lines out- putStrLn ""- if lastlog == RootLog- then- let excluded = ["Executing command:", "Child return code was: 0",- "child environment: None", "ensuring that dir exists:",- "touching file:", "creating dir:", "kill orphans"]- in putStr $ unlines $ map (dropPrefix "DEBUG ") $ takeEnd 30 $- filter (\l -> not (any (`isInfixOf` l) excluded)) ls- else- if last ls == "Child return code was: 0"- then putStr out- else do- let err = "Child return code was: 1"- putStr $ unlines $ takeWhile (err /=) ls- putStrLn err
src/Time.hs view
@@ -1,6 +1,10 @@+{-# LANGUAGE CPP #-}+ module Time ( compactZonedTime,- lookupTime)+ lookupTime,+ formatLocalTime,+ renderDuration) where import Data.Time.Clock@@ -25,3 +29,25 @@ Nothing -> lookupStruct (prefix ++ "_time") str >>= parseTimeM False defaultTimeLocale "%Y-%m-%d %H:%M:%S%Q%EZ"++formatLocalTime :: Bool -> TimeZone -> UTCTime -> String+formatLocalTime start tz t =+ formatTime defaultTimeLocale (if start then "Start: %c" else "End: %c") $+ utcToZonedTime tz t++renderDuration :: Bool -> NominalDiffTime -> String+#if MIN_VERSION_time(1,9,0)+renderDuration short dur =+ let fmtstr+ | dur < 60 = "%s" ++ secs+ | dur < 3600 = "%m" ++ mins ++ " %S" ++ secs+ | otherwise = "%h" ++ hrs ++ " %M" ++ mins+ in formatTime defaultTimeLocale fmtstr dur+ where+ secs = if short then "s" else " sec"+ mins = if short then "m" else " min"+ hrs = if short then "h" else " hours"+#else+renderDuration short dur =+ show dur ++ if short then "" else "ec"+#endif
src/Utils.hs view
@@ -1,15 +1,18 @@ module Utils ( kojiTaskRequestNVR, kojiTaskRequestPkgNVR,- showValue+ showValue,+ buildOutputURL,+ hubToPkgsURL ) where -import Data.List (isInfixOf, isPrefixOf)+import Data.List.Extra (dropSuffix, isInfixOf, isPrefixOf, isSuffixOf, replace) import Data.RPM (dropArch) import Data.RPM.NVR import Data.RPM.NVRA import Distribution.Koji+import Network.HTTP.Directory ((+/+)) import SimpleCmd (error') import System.FilePath (takeBaseName) @@ -43,3 +46,23 @@ showValue (ValueString cs) = cs showValue (ValueInt i) = show i showValue val = show val++buildOutputURL :: String -> NVR -> String+buildOutputURL hub nvr =+ let name = nvrName nvr+ verrel = nvrVerRel nvr+ ver = vrVersion verrel+ rel = vrRelease verrel+ in hubToPkgsURL hub +/+ name +/+ ver +/+ rel++hubToPkgsURL :: String -> String+hubToPkgsURL url =+ case dropSuffix "/" url of+ "https://koji.fedoraproject.org/kojihub" ->+ "https://kojipkgs.fedoraproject.org/packages"+ "https://kojihub.stream.centos.org/kojihub" ->+ "https://kojihub.stream.centos.org/kojifiles/packages"+ _ ->+ if "kojihub" `isSuffixOf` url+ then replace "kojihub" "kojifiles" url +/+ "packages"+ else error' $ "use --files-url to specify kojifiles url for " ++ url