diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 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 +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` diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -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 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 +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 diff --git a/src/Builds.hs b/src/Builds.hs --- a/src/Builds.hs +++ b/src/Builds.hs @@ -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) diff --git a/src/Install.hs b/src/Install.hs --- a/src/Install.hs +++ b/src/Install.hs @@ -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" diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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 diff --git a/src/Progress.hs b/src/Progress.hs --- a/src/Progress.hs +++ b/src/Progress.hs @@ -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" diff --git a/src/Quick.hs b/src/Quick.hs --- a/src/Quick.hs +++ b/src/Quick.hs @@ -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 diff --git a/src/Tasks.hs b/src/Tasks.hs --- a/src/Tasks.hs +++ b/src/Tasks.hs @@ -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 diff --git a/src/Time.hs b/src/Time.hs --- a/src/Time.hs +++ b/src/Time.hs @@ -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 diff --git a/src/Utils.hs b/src/Utils.hs --- a/src/Utils.hs +++ b/src/Utils.hs @@ -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