diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,12 +1,30 @@ # Version history of koji-tool +## 0.9.3 (2022-08-03) +- 'builds' for a package now use specified query options +- 'builds': add --install and --tasks options +- 'install': --exclude globs now filter --package globs +- 'install': update installed subpackages first then install any new subpkgs +- 'install': separate prompt logic for "install above" packages +- 'install': experimental support for rpm-ostree overlaying (--rpm-ostree) +- 'install': allow noarch tasks +- 'install': allow package filtering in --list mode +- 'install': --skip-existing to leave already installed subpackages untouched +- 'progress' records the largest finished build.log size +- 'progress': exclude srpm from max log sizes +- 'progress': show pkg name instead of "unknown" nvr early on +- 'progress': only use current time if task unfinished +- 'tasks': fix output url selection for scratch builds +- 'tasks': check build.log exists before getting its size +- make parsing of states strict for earlier errors +- error if koji userid not found + ## 0.9.2 (2022-06-12) -- progress: print build duration +- tasks --install now takes install options string - 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 +- progress: show duration of build and finished tasks ## 0.9.1 (2022-05-29) - 'find': add "install", "tail", "notail", and archs support 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.2 +0.9.3 $ koji-tool --help Query and track Koji tasks, and install rpms from Koji. @@ -68,7 +68,8 @@ Usage: koji-tool builds [-H|--hub HUB] [(-u|--user USER) | (-M|--mine)] [(-L|--latest) | (-l|--limit INT)] [-s|--state STATE] [(-B|--before TIMESTAMP) | (-F|--from TIMESTAMP)] - [-t|--type TYPE] [-d|--details] [-D|--debug] + [-T|--type TYPE] [(-d|--details) | (-t|--tasks)] + [-i|--install INSTALLOPTS] [-D|--debug] [(-b|--build NVR/BUILDID) | (-p|--pattern NVRPAT) | PACKAGE] Query Koji builds (by default lists most recent builds) @@ -84,8 +85,10 @@ (building,complete,deleted,fail(ed),cancel(ed) -B,--before TIMESTAMP Builds completed before timedate [default: now] -F,--from TIMESTAMP Builds completed after timedate - -t,--type TYPE Select builds by type: all,image,maven,module,rpm,win - -d,--details Show more details of builds + -T,--type TYPE Select builds by type: all,image,maven,module,rpm,win + -d,--details Show more build details + -t,--tasks Show details and tasks + -i,--install INSTALLOPTS Install the package with 'install' options -D,--debug Pretty-print raw XML result -b,--build NVR/BUILDID Show build -p,--pattern NVRPAT Builds matching glob pattern @@ -251,7 +254,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] - [-t|--check-remote-time] [-r|--rpm] [-N|--no-reinstall] + [-t|--check-remote-time] [--rpm | --rpm-ostree | --dnf] + [(-N|--no-reinstall) | (-S|--skip-existing)] [-b|--prefix SUBPKGPREFIX] [(-a|--all) | (-A|--ask) | [-p|--package SUBPKG] [-x|--exclude SUBPKG]] [-d|--disttag DISTTAG] @@ -269,8 +273,12 @@ -l,--list List builds -L,--latest Latest build -t,--check-remote-time Check remote rpm timestamps - -r,--rpm Use rpm instead of dnf + --rpm Use rpm instead of dnf + --rpm-ostree Use rpm-ostree instead of dnf + --dnf Use dnf to install [default unless ostree] -N,--no-reinstall Do not reinstall existing NVRs + -S,--skip-existing Ignore already installed subpackages (imples + --no-reinstall) -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] diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -50,8 +50,10 @@ - % of previous build (or finished tasks) - mbs urls? - average build times? (cache or separate tool?) -- show log sizes for old finished builds - pick up user's new builds - screen mode inplace tui + +- list binary packages (install does this, but not obvious) +- diff build command 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.2 +version: 0.9.3 synopsis: Koji CLI tool for querying tasks and installing builds description: koji-tool is a CLI interface to Koji with commands to query @@ -36,9 +36,9 @@ BuildlogSizes Common DownloadDir + Find Install Progress - Quick Tasks Time User @@ -55,8 +55,8 @@ koji >= 0.0.2, pretty-simple, rpm-nvr >= 0.1.2, - simple-cmd, - simple-cmd-args >= 0.1.7, + simple-cmd >= 0.2.2, + simple-cmd-args >= 0.1.8, text, time, utf8-string, diff --git a/src/BuildlogSizes.hs b/src/BuildlogSizes.hs --- a/src/BuildlogSizes.hs +++ b/src/BuildlogSizes.hs @@ -81,7 +81,7 @@ buildlogSize child = do case lookupStruct "id" child :: Maybe Int of Nothing -> error "child taskid not found" - Just tid -> do + Just tid -> whenJust (lookupStruct "arch" child) $ doGetBuildlogSize buildlog where diff --git a/src/Builds.hs b/src/Builds.hs --- a/src/Builds.hs +++ b/src/Builds.hs @@ -1,9 +1,10 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns, CPP #-} -- SPDX-License-Identifier: BSD-3-Clause module Builds ( BuildReq(..), + Details(..), buildsCmd, parseBuildState, fedoraKojiHub, @@ -26,6 +27,7 @@ import Text.Pretty.Simple import Common +import Install import qualified Tasks import Time import User @@ -43,12 +45,14 @@ capitalize "" = "" capitalize (h:t) = toUpper h : t --- FIXME show tail of build's build.log +data Details = DetailDefault | Detailed | DetailedTasks + deriving Eq + -- FIXME add --install buildsCmd :: Maybe String -> Maybe UserOpt -> Int -> [BuildState] - -> Maybe Tasks.BeforeAfter -> Maybe String -> Bool -> Bool - -> BuildReq -> IO () -buildsCmd mhub museropt limit states mdate mtype details debug buildreq = do + -> Maybe Tasks.BeforeAfter -> Maybe String -> Details + -> Maybe Tasks.Select -> Bool -> BuildReq -> IO () +buildsCmd mhub museropt limit !states mdate mtype details minstall debug buildreq = do when (hub /= fedoraKojiHub && museropt == Just UserSelf) $ error' "--mine currently only works with Fedora Koji: use --user instead" tz <- getCurrentTimeZone @@ -60,7 +64,7 @@ then InfoID (read bld) else InfoString bld mbld <- getBuild hub bldinfo - whenJust (mbld >>= maybeBuildResult) $ printBuild hub tz + whenJust (mbld >>= maybeBuildResult) $ printBuild hub tz details minstall BuildPackage pkg -> do when (head pkg == '-') $ error' $ "bad combination: not a package: " ++ pkg @@ -70,13 +74,14 @@ case mpkgid of Nothing -> error' $ "no package id found for " ++ pkg Just pkgid -> do + query <- setupQuery let fullquery = [("packageID", ValueInt pkgid), - commonBuildQueryOptions limit] + commonBuildQueryOptions limit] ++ query when debug $ print fullquery builds <- listBuilds hub fullquery when debug $ mapM_ pPrintCompact builds - if details || length builds == 1 - then mapM_ (printBuild hub tz) $ mapMaybe maybeBuildResult builds + if details /= DetailDefault || length builds == 1 + then mapM_ (printBuild hub tz details minstall) $ mapMaybe maybeBuildResult builds else mapM_ putStrLn $ mapMaybe (shortBuildResult tz) builds _ -> do query <- setupQuery @@ -84,8 +89,8 @@ when debug $ print fullquery builds <- listBuilds hub fullquery when debug $ mapM_ pPrintCompact builds - if details || length builds == 1 - then mapM_ (printBuild hub tz) $ mapMaybe maybeBuildResult builds + if details /= DetailDefault || length builds == 1 + then mapM_ (printBuild hub tz details minstall) $ mapMaybe maybeBuildResult builds else mapM_ putStrLn $ mapMaybe (shortBuildResult tz) builds where hub = maybe fedoraKojiHub hubURL mhub @@ -147,12 +152,11 @@ buildinfoUrl hub bid = webUrl hub ++ "/buildinfo?buildID=" ++ show bid --- FIXME only 2 accessors data BuildResult = BuildResult {buildNVR :: NVR, - _buildState :: BuildState, + buildState :: BuildState, _buildId :: Int, - _mtaskId :: Maybe Int, + mbuildTaskId :: Maybe Int, _buildStartTime :: UTCTime, mbuildEndTime :: Maybe UTCTime } @@ -168,13 +172,22 @@ return $ BuildResult nvr state buildid mtaskid start mend -printBuild :: String -> TimeZone -> BuildResult -> IO () -printBuild hub tz build = do +printBuild :: String -> TimeZone -> Details -> Maybe Tasks.Select + -> BuildResult -> IO () +printBuild hub tz details minstall build = do putStrLn "" let mendtime = mbuildEndTime build time <- maybe getCurrentTime return mendtime (mapM_ putStrLn . formatBuildResult hub (isJust mendtime) tz) (build {mbuildEndTime = Just time}) - putStrLn $ buildOutputURL hub $ buildNVR build + when (buildState build == BuildComplete) $ + putStrLn $ buildOutputURL hub $ buildNVR build + whenJust (mbuildTaskId build) $ \taskid -> do + when (details == DetailedTasks) $ do + putStrLn "" + Tasks.tasksCmd (Just hub) Nothing 7 [] [] Nothing Nothing False False Nothing False Nothing (Tasks.Parent taskid) + whenJust minstall $ \installopts -> do + putStrLn "" + installCmd False False No (Just hub) Nothing False False False Nothing ExistingUpdate Nothing installopts Nothing ReqName [show taskid] formatBuildResult :: String -> Bool -> TimeZone -> BuildResult -> [String] formatBuildResult hub ended tz (BuildResult nvr state buildid mtaskid start mendtime) = @@ -207,7 +220,7 @@ "failed" -> BuildFailed "cancel" -> BuildCanceled "canceled" -> BuildCanceled - _ -> error' $! "unknown task state: " ++ s + _ -> error' $! "unknown build state: " ++ s #endif getBuildState :: Struct -> Maybe BuildState @@ -222,4 +235,4 @@ mbld <- kojiLatestBuild hub tag pkg when debug $ print mbld tz <- getCurrentTimeZone - whenJust (mbld >>= maybeBuildResult) $ printBuild hub tz + whenJust (mbld >>= maybeBuildResult) $ printBuild hub tz Detailed Nothing diff --git a/src/Find.hs b/src/Find.hs new file mode 100644 --- /dev/null +++ b/src/Find.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE CPP #-} + +-- SPDX-License-Identifier: BSD-3-Clause + +module Find ( + findCmd, + wordsList + ) +where + +import Data.Char ( isDigit, isAsciiLower, isAsciiUpper ) +import Data.List.Extra ((\\), dropSuffix, isSuffixOf) +import Distribution.Koji + ( BuildState(BuildBuilding, BuildFailed, BuildComplete), + TaskState(TaskOpen, TaskFailed, TaskClosed) ) +import SimpleCmd (error') + +import qualified Builds +import qualified Tasks +import User ( UserOpt(User, UserSelf) ) + +data Words = Mine | Limit | Failure | Complete | Current | Build | Detail + | Install | Tail | NoTail | Arch + deriving (Enum,Bounded) + +findWords :: Words -> [String] +findWords Mine = ["my","mine"] +findWords Limit = ["last","latest"] +findWords Failure = ["fail","failure","failed"] +findWords Complete = ["complete","completed","completion", + "close","closed", + "finish","finished"] +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"] + +allWords :: [String] +allWords = concatMap findWords [minBound..] + +-- FIXME: arch +-- FIXME: method +-- FIXME: mlt (or mlft) +findCmd :: Maybe String -> Bool -> [String] -> IO () +findCmd _ _ [] = error' $ "find handles these words:\n\n" ++ + unlines (wordsList unwords) +findCmd mhub debug args = do + let user = if hasWord Mine + then Just UserSelf + else case filter ("'s" `isSuffixOf`) args of + [] -> Nothing + [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 + -- FIXME allow pattern? + [pkg] | all isPkgNameChar pkg -> Just pkg + other -> + error' $ + "you can only specify one package - too many unknown words: " ++ + unwords other + installation = if install then Just (Tasks.PkgsReq [] []) else Nothing + if build + then + let states = [BuildFailed|failure] ++ [BuildComplete|complete] ++ + [BuildBuilding|current] + buildreq = maybe Builds.BuildQuery Builds.BuildPackage mpkg + detailed = if detail then Builds.Detailed else Builds.DetailDefault + in Builds.buildsCmd mhub user limit states Nothing (Just "rpm") detailed installation debug buildreq + else + 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) installation taskreq + where + hasWord :: Words -> Bool + hasWord word = any (`elem` findWords word) args + + removeUsers :: [String] -> [String] + removeUsers = filter (not . ("'s" `isSuffixOf`)) + +-- [Char] generated by +-- sort . nub <$> cmd "dnf" ["repoquery", "--qf=%{name}", "*"] +-- "+-.0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz" +isPkgNameChar :: Char -> Bool +isPkgNameChar c = + isAsciiLower c || isAsciiUpper c || c `elem` "-.+_" || isDigit c diff --git a/src/Install.hs b/src/Install.hs --- a/src/Install.hs +++ b/src/Install.hs @@ -6,6 +6,8 @@ Select(..), Request(..), installCmd, + ExistingStrategy(..), + PkgMgr(..), knownHubs, Yes(..), installArgs @@ -67,19 +69,24 @@ data Request = ReqName | ReqNV | ReqNVR deriving Eq +data PkgMgr = DNF | RPM | OSTREE + deriving Eq + +data ExistingStrategy = ExistingUpdate | ExistingNoReinstall | ExistingSkip + -- FIXME --include devel, --exclude * -- FIXME specify tag or task -- FIXME support enterprise builds -- FIXME --arch (including src) -- FIXME --debuginfo -- FIXME --delete after installing --- FIXME --dnf to install selected packages using default dnf repo instead +-- FIXME way 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 -> 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 + -> Bool -> Bool -> Maybe PkgMgr -> ExistingStrategy -> Maybe String + -> Select -> Maybe String -> Request -> [String] -> IO () +installCmd dryrun debug yes mhuburl mpkgsurl listmode latest checkremotetime mmgr existingStrategy mprefix select mdisttag request pkgbldtsks = do let huburl = maybe fedoraKojiHub hubURL mhuburl pkgsurl = fromMaybe (hubToPkgsURL huburl) mpkgsurl when debug $ do @@ -89,13 +96,13 @@ when debug printDlDir setNoBuffering buildrpms <- mapM (kojiRPMs huburl pkgsurl printDlDir) pkgbldtsks - installRPMs dryrun debug useRpm noreinstall yes buildrpms + installRPMs dryrun debug mmgr existingStrategy yes buildrpms where 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 checkremotetime printDlDir taskid + Just taskid -> kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode existingStrategy mprefix select checkremotetime printDlDir taskid Nothing -> kojiBuildRPMs huburl pkgsurl printDlDir bldtask kojiBuildRPMs :: String -> String -> IO () -> String @@ -110,16 +117,19 @@ nvrs <- map readNVR <$> kojiBuildOSBuilds debug huburl listmode latest disttag request pkgbld if listmode then do - if select /= PkgsReq [] [] - then error' "selects not supported for listing build" -- FIXME - else case nvrs of - [nvr] -> do - putStrLn (showNVR nvr) - putStrLn "" - bid <- kojiGetBuildID' huburl (showNVR nvr) - kojiGetBuildRPMs huburl nvr bid >>= - mapM_ putStrLn . sort . filter notDebugPkg - _ -> mapM_ (putStrLn . showNVR) nvrs + case nvrs of + [nvr] -> do + putStrLn (showNVR nvr) + putStrLn "" + 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 + rpms <- decideRpms yes listmode existingStrategy select prefix nvras + mapM_ printInstalled rpms + -- kojiGetBuildRPMs huburl nvr bid >>= + -- mapM_ putStrLn . sort . filter notDebugPkg + _ -> mapM_ (putStrLn . showNVR) nvrs return ("",[]) else case nvrs of @@ -130,7 +140,7 @@ 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 + dlRpms <- decideRpms yes listmode existingStrategy select prefix nvras when debug $ mapM_ printInstalled dlRpms let subdir = showNVR nvr unless (dryrun || null dlRpms) $ do @@ -152,10 +162,10 @@ notDebugPkg p = not ("-debuginfo-" `isInfixOf` p || "-debugsource-" `isInfixOf` p) -kojiTaskRPMs :: Bool -> Bool -> Yes -> String -> String -> Bool -> Bool - -> Maybe String -> Select -> Bool -> IO () -> Int - -> IO (FilePath, [(Existence,NVRA)]) -kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode noreinstall mprefix select checkremotetime printDlDir taskid = do +kojiTaskRPMs :: Bool -> Bool -> Yes -> String -> String -> Bool + -> ExistingStrategy -> Maybe String -> Select -> Bool -> IO () + -> Int -> IO (FilePath, [(Existence,NVRA)]) +kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode existingStrategy mprefix select checkremotetime printDlDir taskid = do mtaskinfo <- Koji.getTaskInfo huburl taskid True tasks <- case mtaskinfo of Nothing -> error' "failed to get taskinfo" @@ -170,7 +180,7 @@ _ -> error' $ "unsupport method: " ++ method sysarch <- cmd "rpm" ["--eval", "%{_arch}"] let (archtid,archtask) = - case find (\t -> lookupStruct "arch" t == Just sysarch) tasks of + case find (\t -> let march = lookupStruct "arch" t in march `elem` [Just sysarch,Just "noarch"]) tasks of Nothing -> error' $ "no " ++ sysarch ++ " task found" Just task' -> case lookupStruct "id" task' of @@ -189,17 +199,17 @@ fromMaybe archtask mtaskinfo if listmode then do - drpms <- decideRpms yes listmode noreinstall select prefix nvras + drpms <- decideRpms yes listmode existingStrategy select prefix nvras return ("",drpms) else if null nvras then do - (_, rpms) <- kojiTaskRPMs dryrun debug yes huburl pkgsurl True noreinstall mprefix select checkremotetime printDlDir archtid + (_, rpms) <- kojiTaskRPMs dryrun debug yes huburl pkgsurl True existingStrategy mprefix select checkremotetime printDlDir archtid mapM_ printInstalled rpms return ("",[]) else do when debug $ print $ map showNVRA nvras - dlRpms <- decideRpms yes listmode noreinstall select prefix $ + dlRpms <- decideRpms yes listmode existingStrategy select prefix $ filter ((/= "src") . rpmArch) nvras when debug $ mapM_ printInstalled dlRpms let subdir = show archtid @@ -221,38 +231,38 @@ if null few then "0" else few in dropSuffix "packages" pkgsurl +/+ "work/tasks/" ++ lastFew +/+ show taskid' +/+ rpm -data Existence = NotInstalled | NVRInstalled | NVRChanged +data Existence = NVRInstalled | NVRChanged | NotInstalled deriving (Eq, Ord, Show) -decideRpms :: Yes -> Bool -> Bool -> Select -> String -> [NVRA] +-- FIXME ExistingStrategy isn't used, so output doesn't reflect it +decideRpms :: Yes -> Bool -> ExistingStrategy -> Select -> String -> [NVRA] -> IO [(Existence,NVRA)] -decideRpms yes listmode noreinstall select prefix nvras = do +decideRpms yes listmode existingStrategy select prefix nvras = do classified <- mapM installExists (filter isBinaryRpm nvras) if listmode - then mapM_ printInstalled classified >> return [] + then do + case select of + PkgsReq subpkgs exclpkgs -> do + let install = selectRPMs False prefix (subpkgs,exclpkgs) classified + mapM_ printInstalled install + _ -> mapM_ printInstalled classified + return [] else case select of All -> do - mapM_ printInstalled classified - ok <- prompt yes "install above" - return $ if ok then classified else [] + promptPkgs yes classified Ask -> mapMaybeM (rpmPrompt yes) classified PkgsReq [] [] -> if all ((== NotInstalled) . fst) classified && yes /= Yes - then decideRpms yes listmode noreinstall Ask prefix nvras + then decideRpms yes listmode existingStrategy Ask prefix nvras else do let install = filter ((/= NotInstalled) . fst) classified if yes == Yes then return install - else do - mapM_ printInstalled install - ok <- prompt yes "install above" - return $ if ok then install else [] + else promptPkgs yes install PkgsReq subpkgs exclpkgs -> do let install = selectRPMs False prefix (subpkgs,exclpkgs) classified - mapM_ printInstalled install - ok <- prompt yes "install above" - return $ if ok then install else [] + promptPkgs yes install where installExists :: NVRA -> IO (Existence, NVRA) installExists nvra = do @@ -304,25 +314,46 @@ else match comppat rpmname selectRPMs recurse prefix (subpkgs,exclpkgs) rpms = let needed = selectRPMs recurse prefix (subpkgs,[]) rpms - excluded = selectRPMs recurse prefix ([], exclpkgs) rpms - in nub . sort $ needed ++ excluded + excluded = selectRPMs recurse prefix (exclpkgs,[]) rpms + in nub . sort $ needed \\ excluded +promptPkgs :: Yes -> [(Existence,NVRA)] -> IO [(Existence,NVRA)] +promptPkgs yes classified = do + mapM_ printInstalled classified + ok <- prompt yes "install above" + return $ if ok then classified else [] + prompt :: Yes -> String -> IO Bool prompt yes str = do if yes == Yes then return True else do + putStr $ str ++ " [Y/n]: " + inp <- trim <$> getLine + case lower inp of + "" -> return True + "y" -> return True + "yes" -> return True + "n" -> return False + "no" -> return False + _ -> prompt yes str + +promptChar :: Yes -> String -> IO Bool +promptChar yes str = do + if yes == Yes + then return True + else do putStr $ str ++ " [y/n]: " c <- getChar unless (c == '\n') $ putStrLn "" case toLower c of 'y' -> return True 'n' -> return False - _ -> prompt yes str + _ -> promptChar yes str rpmPrompt :: Yes -> (Existence,NVRA) -> IO (Maybe (Existence,NVRA)) rpmPrompt yes (exist,nvra) = do - ok <- prompt yes $ renderInstalled (exist,nvra) + ok <- promptChar yes $ renderInstalled (exist,nvra) return $ if ok then Just (exist,nvra) @@ -407,25 +438,44 @@ hSetBuffering stdin NoBuffering hSetBuffering stdout NoBuffering -installRPMs :: Bool -> Bool -> Bool -> Bool -> Yes -> [(FilePath,[(Existence,NVRA)])] - -> IO () +-- FIXME ExistingStrategy should move to decideRpms +installRPMs :: Bool -> Bool -> Maybe PkgMgr -> ExistingStrategy -> Yes + -> [(FilePath,[(Existence,NVRA)])] -> IO () installRPMs _ _ _ _ _ [] = return () -installRPMs dryrun debug rpm noreinstall yes classified = +installRPMs dryrun debug mmgr existingStrategy yes classified = forM_ (groupClasses classified) $ \(cl,dirpkgs) -> - unless (null dirpkgs) $ - let pkgmgr = if rpm then "rpm" else "dnf" - mcom = - case cl of - NVRInstalled -> if noreinstall - then Nothing - else Just (if rpm then ["-Uvh","--replacepkgs"] else ["reinstall"]) - _ -> Just (if rpm then ["-ivh"] else ["localinstall"]) + unless (null dirpkgs) $ do + mgr <- + case mmgr of + Nothing -> do + mostree <- findExecutable "rpm-ostree" + return $ if isJust mostree then OSTREE else DNF + Just m -> return m + let pkgmgr = + case mgr of + DNF -> "dnf" + RPM -> "rpm" + OSTREE -> "rpm-ostree" + mcom = + case cl of + NVRInstalled -> + case existingStrategy of + ExistingUpdate -> Just (reinstallCommand mgr) + _ -> Nothing + NVRChanged -> + case existingStrategy of + ExistingSkip -> Nothing + _ -> Just (installCommand mgr) + _ -> Just (installCommand mgr) in whenJust mcom $ \com -> - if dryrun - 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] + if dryrun + then mapM_ putStrLn $ ("would" +-+ unwords (pkgmgr : com) ++ ":") : map showRpmFile dirpkgs + else do + when debug $ mapM_ (putStrLn . showRpmFile) dirpkgs + (case mgr of + OSTREE -> cmd_ + _ -> sudo_) pkgmgr $ + com ++ map showRpmFile dirpkgs ++ ["--assumeyes" | yes == Yes && mgr == DNF] where groupClasses = groupSort . concatMap mapDir @@ -434,6 +484,20 @@ -> [(Existence,(FilePath,NVRA))] mapDir (dir,cls) = map (\(e,n) -> (e,(dir,n))) cls + + reinstallCommand :: PkgMgr -> [String] + reinstallCommand mgr = + case mgr of + DNF -> ["reinstall"] + RPM -> ["-Uvh","--replacepkgs"] + OSTREE -> ["install"] + + installCommand :: PkgMgr -> [String] + installCommand mgr = + case mgr of + DNF -> ["localinstall"] + RPM -> ["-ivh"] + OSTREE -> ["install"] showRpm :: NVRA -> FilePath showRpm nvra = showNVRA nvra <.> "rpm" diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -15,7 +15,7 @@ import Install import qualified Paths_koji_tool import Progress -import Quick +import Find import Tasks main :: IO () @@ -34,8 +34,10 @@ <*> many (parseBuildState <$> strOptionWith 's' "state" "STATE" "Filter builds by state (building,complete,deleted,fail(ed),cancel(ed)") <*> optional (Before <$> strOptionWith 'B' "before" "TIMESTAMP" "Builds completed before timedate [default: now]" <|> After <$> strOptionWith 'F' "from" "TIMESTAMP" "Builds completed after timedate") - <*> (fmap normalizeBuildType <$> optional (strOptionWith 't' "type" "TYPE" ("Select builds by type: " ++ intercalate "," kojiBuildTypes))) - <*> switchWith 'd' "details" "Show more details of builds" + <*> (fmap normalizeBuildType <$> optional (strOptionWith 'T' "type" "TYPE" ("Select builds by type: " ++ intercalate "," kojiBuildTypes))) + <*> (flagWith' Detailed 'd' "details" "Show more build details" <|> + flagWith DetailDefault DetailedTasks 't' "tasks" "Show details and tasks") + <*> optional (installArgs <$> strOptionWith 'i' "install" "INSTALLOPTS" "Install the package with 'install' options") <*> switchWith 'D' "debug" "Pretty-print raw XML result" <*> (BuildBuild <$> strOptionWith 'b' "build" "NVR/BUILDID" "Show build" <|> BuildPattern <$> strOptionWith 'p' "pattern" "NVRPAT" "Builds matching glob pattern" <|> @@ -60,6 +62,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" + -- FIXME any way to pass --help to install? <*> 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" @@ -86,8 +89,8 @@ <*> 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 pkgMgrOpt + <*> existingOpt <*> optional (strOptionWith 'b' "prefix" "SUBPKGPREFIX" "Prefix to use for subpackages [default: base package]") <*> selectOpt <*> optional disttagOpt @@ -156,3 +159,14 @@ readTaskReq :: String -> Maybe TaskReq readTaskReq cs = Just $ if all isDigit cs then Task (read cs) else Package cs + + pkgMgrOpt :: Parser PkgMgr + pkgMgrOpt = + flagLongWith' RPM "rpm" "Use rpm instead of dnf" <|> + flagLongWith' OSTREE "rpm-ostree" "Use rpm-ostree instead of dnf" <|> + flagLongWith' DNF "dnf" "Use dnf to install [default unless ostree]" + + existingOpt :: Parser ExistingStrategy + existingOpt = + flagWith' ExistingNoReinstall 'N' "no-reinstall" "Do not reinstall existing NVRs" <|> + flagWith ExistingUpdate ExistingSkip 'S' "skip-existing" "Ignore already installed subpackages (imples --no-reinstall)" diff --git a/src/Progress.hs b/src/Progress.hs --- a/src/Progress.hs +++ b/src/Progress.hs @@ -52,6 +52,8 @@ btasks <- mapM kojiTaskinfoRecursive tasks loopBuildTasks debug waitdelay btasks +type BuildTask = (TaskID, UTCTime, Maybe UTCTime, Maybe Int, [TaskInfoSize]) + kojiTaskinfoRecursive :: TaskID -> IO BuildTask kojiTaskinfoRecursive tid = do mtaskinfo <- kojiGetTaskInfo fedoraKojiHub tid @@ -76,9 +78,8 @@ Nothing -> error' $ "task " ++ displayID tid ++ " has no start time" Just t -> t - return (tid, start, zip children (repeat Nothing)) - -type BuildTask = (TaskID, UTCTime, [TaskInfoSize]) + mend = lookupTime True taskinfo + return (tid, start, mend, Nothing, zip children (repeat Nothing)) -- FIXME change to (TaskID,Struct,Size) type TaskInfoSize = (Struct,Maybe Int) @@ -99,7 +100,7 @@ threadDelay (fromEnum (fromIntegral (m * 60) :: Micro)) runProgress :: BuildTask -> IO BuildTask - runProgress (tid,start,tasks) = + runProgress (tid,start,mend,msize,tasks) = case tasks of [] -> do state <- kojiGetTaskState fedoraKojiHub tid @@ -107,29 +108,36 @@ then do threadDelayMinutes waitdelay kojiTaskinfoRecursive tid - else return (tid, start, []) + else return (tid, start, Nothing, msize, []) ((task,_):_) -> do when debug $ print task - current <- getCurrentTime - let mnvr = kojiTaskRequestNVR task - duration = diffUTCTime current start - logMsg $ maybe "" showNVR mnvr ++ " (" ++ displayID tid ++ ") " ++ renderDuration True duration + let epkgnvr = kojiTaskRequestPkgNVR task + end <- maybe getCurrentTime return mend + let duration = diffUTCTime end start + logMsg $ either id showNVR epkgnvr ++ " (" ++ displayID tid ++ ")" +-+ maybe "" (\s -> show (s `div` 1000) ++ "kB,") msize +-+ 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 + (open,closed) = partition (\ (t,_) -> getTaskState t `elem` map Just openTaskStates) news + mlargest = if not (any (\(t,_) -> lookupStruct "method" t /= Just ("buildSRPMFromSCM" :: String)) closed) + then Nothing + else maximum $ map snd closed + mbiggest = case (mlargest,msize) of + (Just large, Just size) -> Just $ max large size + (Just large, Nothing) -> Just large + (Nothing,_) -> msize if null open - then runProgress (tid,start,[]) - else return (tid, start, open) + then runProgress (tid,start,mend,mbiggest,[]) + else return (tid, start, mend, mbiggest, open) tasksOpen :: BuildTask -> Bool - tasksOpen (_,_,ts) = not (null ts) + tasksOpen (_,_,_,_,ts) = not (null ts) updateBuildTask :: BuildTask -> IO BuildTask - updateBuildTask (tid,start,ts) = do + updateBuildTask (tid,start,mend,msize,ts) = do news <- mapM updateTask ts - return (tid, start, news) + return (tid, start, mend, msize, news) updateTask :: TaskInfoSize -> IO TaskInfoSize updateTask (task,size) = do diff --git a/src/Quick.hs b/src/Quick.hs deleted file mode 100644 --- a/src/Quick.hs +++ /dev/null @@ -1,103 +0,0 @@ -{-# LANGUAGE CPP #-} - --- SPDX-License-Identifier: BSD-3-Clause - -module Quick ( - findCmd, - wordsList - ) -where - -import Data.Char ( isDigit, isAsciiLower, isAsciiUpper ) -import Data.List.Extra ((\\), dropSuffix, isSuffixOf) -import Distribution.Koji -import SimpleCmd (error') - -import qualified Builds -import qualified Tasks -import User - -data Words = Mine | Limit | Failure | Complete | Current | Build | Detail - | Install | Tail | NoTail | Arch - deriving (Enum,Bounded) - -findWords :: Words -> [String] -findWords Mine = ["my","mine"] -findWords Limit = ["last","latest"] -findWords Failure = ["fail","failure","failed"] -findWords Complete = ["complete","completed","completion", - "close","closed", - "finish","finished"] -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"] - -allWords :: [String] -allWords = concatMap findWords [minBound..] - --- FIXME: arch --- FIXME: method --- FIXME: mlt (or mlft) -findCmd :: Maybe String -> Bool -> [String] -> IO () -findCmd _ _ [] = error' $ "find handles these words:\n\n" ++ - unlines (wordsList unwords) -findCmd mhub debug args = do - let user = if hasWord Mine - then Just UserSelf - else case filter ("'s" `isSuffixOf`) args of - [] -> Nothing - [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 - -- FIXME allow pattern? - [pkg] | all isPkgNameChar pkg -> Just pkg - other -> - error' $ - "you can only specify one package - too many unknown words: " ++ - unwords other - if build - then - let states = [BuildFailed|failure] ++ [BuildComplete|complete] ++ - [BuildBuilding|current] - buildreq = maybe Builds.BuildQuery Builds.BuildPackage mpkg - in Builds.buildsCmd mhub user limit states Nothing (Just "rpm") detail debug buildreq - else - 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) (if install then Just (Tasks.PkgsReq [] []) else Nothing) taskreq - where - hasWord :: Words -> Bool - hasWord word = any (`elem` findWords word) args - - removeUsers :: [String] -> [String] - removeUsers = filter (not . ("'s" `isSuffixOf`)) - --- [Char] generated by --- sort . nub <$> cmd "dnf" ["repoquery", "--qf=%{name}", "*"] --- "+-.0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz" -isPkgNameChar :: Char -> Bool -isPkgNameChar c = - isAsciiLower c || isAsciiUpper c || c `elem` "-.+_" || isDigit c diff --git a/src/Tasks.hs b/src/Tasks.hs --- a/src/Tasks.hs +++ b/src/Tasks.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, OverloadedStrings #-} +{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-} -- SPDX-License-Identifier: BSD-3-Clause @@ -71,10 +71,12 @@ -- --sibling -- FIXME --tail-size option (eg more that 4000B) -- FIXME --output-fields +-- FIXME default to 'build' for install or try 'build' after 'buildarch'? +-- FIXME parent tasks need not have limit tasksCmd :: Maybe String -> Maybe UserOpt -> Int -> [TaskState] -> [String] -> Maybe BeforeAfter -> Maybe String -> Bool -> Bool -> Maybe TaskFilter -> Bool -> Maybe Select -> TaskReq -> IO () -tasksCmd mhub museropt limit states archs mdate mmethod details debug mfilter' tail' minstall taskreq = do +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 @@ -90,7 +92,7 @@ printTask hasparent tz res if hasparent then whenJust minstall $ \installopts -> - installCmd False debug No mhub Nothing False False False False False Nothing installopts Nothing ReqName [show taskid] + installCmd False debug No mhub Nothing False False False Nothing ExistingUpdate 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') $ @@ -137,7 +139,7 @@ (mapM_ (printTask detailed tz) . filterResults . mapMaybe maybeTaskResult) tasks whenJust minstall $ \args -> if exact - then installCmd False debug No mhub Nothing False False False False False Nothing args Nothing ReqName [show (i :: Int) | i <- mapMaybe (lookupStruct "id") tasks] + then installCmd False debug No mhub Nothing False False False Nothing ExistingUpdate 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 @@ -325,8 +327,8 @@ findOutputURL :: String -> TaskResult -> IO (Maybe String) findOutputURL hub task = case outputUrl hub task PackagesOutput of - Just burl -> urlExistsOr burl $ - urlExistsOr (taskOutputUrl task) $ return Nothing + Just burl -> urlExistsOr (taskOutputUrl task) $ + urlExistsOr burl $ return Nothing Nothing -> urlExistsOr (taskOutputUrl task) $ return Nothing where urlExistsOr :: String -> IO (Maybe String) -> IO (Maybe String) @@ -355,23 +357,31 @@ logFile BuildLog = "build.log" buildlogSize :: Bool -> Bool -> String -> TaskResult -> IO () -buildlogSize debug tail' hub task = do +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 - file <- - if size < 1500 - then do - putStrLn $ url +/+ logFile RootLog - return RootLog - else return BuildLog - when tail' $ displayLog url file - when debug $ putStrLn buildlog + exists <- httpExists' buildlog + if exists + then do + putStr $ buildlog ++ " " + msize <- httpFileSize' buildlog + case msize of + Nothing -> putChar '\n' + Just size -> do + fprintLn ("(" % commas % "kB)") (size `div` 1000) + -- FIXME check if short build.log ends with srpm + file <- + if size < 1500 + then do + putStrLn $ url +/+ logFile RootLog + return RootLog + else return BuildLog + when tail' $ displayLog url file + else do + let rootlog = url +/+ logFile RootLog + whenM (httpExists' rootlog) $ + putStrLn rootlog where displayLog :: String -> LogFile -> IO () displayLog url file = do diff --git a/src/User.hs b/src/User.hs --- a/src/User.hs +++ b/src/User.hs @@ -37,5 +37,5 @@ else error' "Cannot determine Koji user: kerberos klist not installed - try --user" _ -> error' $ "Do not know how to determine Koji user for " ++ server muserid <- kojiGetUserID server user - when (isNothing muserid) $ warning "userid not found" + when (isNothing muserid) $ error' "userid not found" return muserid