diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,13 @@ # Version history of koji-tool +# 0.8.4 (2022-05-09) +- Install: completely rework logic using installed status and NVRA etc +- install: '--no-reinstall' replaces '--reinstall-nvrs' +- install: determine package name from child or parent task +- Install: confirm for --all and --exclude, respecting --yes +- tasks: parse taskid as arg and drop --task and --children +- Tasks: print parent Task taskid compactly and then its children + # 0.8.3 (2022-04-23) - 'latest': new cmd to list latest package build for tag - 'install': use --reinstall-nvrs to reinstall rpms for current nvr diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -21,6 +21,8 @@ ## Commands ```shellsession +$ koji-tool --version +0.8.4 $ koji-tool --help Query and track Koji tasks, and install rpms from Koji. @@ -97,12 +99,12 @@ ```shellsession $ koji-tool builds --pattern redhat-rpm-config*.fc37 --latest -redhat-rpm-config-214-1.fc37 BuildComplete -https://koji.fedoraproject.org/koji/buildinfo?buildID=1915968 -https://koji.fedoraproject.org/koji/taskinfo?taskID=82638530 -Start: Thu Feb 10 23:45:28 +08 2022 -End: Thu Feb 10 23:47:32 +08 2022 -duration: 0h 2m 4s +redhat-rpm-config-218-1.fc37 BuildComplete +https://koji.fedoraproject.org/koji/buildinfo?buildID=1963037 +https://koji.fedoraproject.org/koji/taskinfo?taskID=86677797 +Start: Thu May 5 19:02:33 +08 2022 +End: Thu May 5 19:04:26 +08 2022 +duration: 0h 1m 53s ``` ## koji-tool tasks @@ -129,8 +131,8 @@ [-m|--method METHOD] [-d|--details] [-D|--debug] [(-P|--only-package PKG) | (-N|--only-nvr PREFIX)] [-T|--tail] - [(-t|--task TASKID) | (-c|--children TASKID) | - (-b|--build BUILD) | (-p|--pattern NVRPAT) | PACKAGE] + [(-b|--build BUILD) | (-p|--pattern NVRPAT) | + PACKAGE|TASKID] Query Koji tasks (by default lists most recent buildArch tasks) Available options: @@ -152,8 +154,6 @@ -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 - -t,--task TASKID Show task - -c,--children TASKID List child tasks of parent -b,--build BUILD List child tasks of build -p,--pattern NVRPAT Build tasks of matching pattern -h,--help Show this help text @@ -170,22 +170,23 @@ ```shellsession $ koji-tool tasks --method newrepo --latest -f37-build-side-52128 newRepo TaskClosed -https://koji.fedoraproject.org/koji/taskinfo?taskID=84527460 -Start: Tue Mar 22 08:11:46 +08 2022 -End: Tue Mar 22 08:15:23 +08 2022 -duration: 0h 3m 37s +eln-build newRepo TaskClosed +https://koji.fedoraproject.org/koji/taskinfo?taskID=86821565 +Start: Mon May 9 11:53:53 +08 2022 +End: Mon May 9 11:57:13 +08 2022 +duration: 0h 3m 20s ``` List latest package build's tasks: ```shellsession $ koji-tool tasks --latest redhat-rpm-config -redhat-rpm-config-214-1.eln114.noarch TaskClosed -https://koji.fedoraproject.org/koji/taskinfo?taskID=82667980 (parent: 82667916) -Start: Fri Feb 11 15:08:30 +08 2022 -End: Fri Feb 11 15:10:09 +08 2022 -duration: 0h 1m 39s +redhat-rpm-config-218-1.eln118.noarch TaskClosed +https://koji.fedoraproject.org/koji/taskinfo?taskID=86685316 (parent: 86685296) +Start: Fri May 6 00:11:10 +08 2022 +End: Fri May 6 00:13:07 +08 2022 +duration: 0h 1m 57s +https://kojipkgs.fedoraproject.org/work/tasks/5316/86685316/build.log (13kB) ``` ## koji-tool install @@ -234,7 +235,7 @@ $ koji-tool install --help Usage: koji-tool install [-n|--dry-run] [-D|--debug] [-y|--yes] [-H|--hub HUB] [-P|--packages-url URL] [-l|--list] [-L|--latest] - [-r|--reinstall-nvrs] + [-N|--no-reinstall] [(-a|--all) | (-A|--ask) | [-p|--package SUBPKG] [-x|--exclude SUBPKG]] [-d|--disttag DISTTAG] [(-R|--nvr) | (-V|--nv)] PKG|NVR|TASKID... @@ -250,7 +251,7 @@ -P,--packages-url URL KojiFiles packages url [default: Fedora] -l,--list List builds -L,--latest Latest build - -r,--reinstall-nvrs Reinstall existing NVRs + -N,--no-reinstall Do not reinstall existing NVRs -a,--all all subpackages -A,--ask ask for each subpackge [default if not installed] -p,--package SUBPKG Subpackage (glob) to install 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.8.3 +version: 0.8.4 synopsis: Koji CLI tool for querying tasks and installing builds description: koji-tool is a CLI interface to Koji with commands to query @@ -41,6 +41,7 @@ Tasks Time User + Utils hs-source-dirs: src build-depends: base < 5, directory, @@ -54,7 +55,7 @@ pretty-simple, rpm-nvr >= 0.1.1, simple-cmd, - simple-cmd-args, + simple-cmd-args >= 0.1.7, text, time, utf8-string, diff --git a/src/DownloadDir.hs b/src/DownloadDir.hs --- a/src/DownloadDir.hs +++ b/src/DownloadDir.hs @@ -11,7 +11,7 @@ import System.FilePath -- FIXME check writeable -setDownloadDir :: Bool -> String -> IO FilePath +setDownloadDir :: Bool -> String -> IO (IO ()) setDownloadDir dryrun subdir = do home <- getHomeDirectory dlDir <- getUserDir "DOWNLOAD" @@ -35,7 +35,10 @@ createDirectoryIfMissing True dlDir setCWD dlDir let path = makeRelative home dir - return $ if isRelative path then "~" path else path + return $ + putStrLn $ + "Packages downloaded to " ++ + if isRelative path then "~" path else path where setCWD :: FilePath -> IO FilePath setCWD dir = do diff --git a/src/Install.hs b/src/Install.hs --- a/src/Install.hs +++ b/src/Install.hs @@ -15,7 +15,9 @@ import Data.Char import Data.List.Extra import Data.Maybe -import Data.RPM +import Data.RPM.NV hiding (name) +import Data.RPM.NVR +import Data.RPM.NVRA import Distribution.Koji import qualified Distribution.Koji.API as Koji import Network.HTTP.Directory (httpFileSize', httpLastModified', (+/+)) @@ -24,9 +26,11 @@ import System.FilePath import System.FilePath.Glob import System.IO +import Text.Read (readMaybe) import Common import DownloadDir +import Utils defaultPkgsURL :: String -> String defaultPkgsURL url = @@ -60,182 +64,197 @@ -- FIXME --delete after installing installCmd :: Bool -> Bool -> Yes -> Maybe String -> Maybe String -> Bool -> Bool -> Bool -> Mode -> String -> Request -> [String] -> IO () -installCmd dryrun debug yes mhuburl mpkgsurl listmode latest reinstall mode disttag request pkgbldtsks = do +installCmd dryrun debug yes mhuburl mpkgsurl listmode latest noreinstall mode disttag request pkgbldtsks = do let huburl = maybe fedoraKojiHub hubURL mhuburl pkgsurl = fromMaybe (defaultPkgsURL huburl) mpkgsurl when debug $ do putStrLn huburl putStrLn pkgsurl - -- FIXME use this location? - dlDir <- setDownloadDir dryrun "rpms" - when debug $ putStrLn dlDir + printDlDir <- setDownloadDir dryrun "rpms" + when debug printDlDir setNoBuffering - mapM (kojiRPMs huburl pkgsurl dlDir) pkgbldtsks - >>= if listmode - then mapM_ putStrLn . mconcat - else installRPMs dryrun reinstall yes . mconcat + mapM (kojiRPMs huburl pkgsurl printDlDir) pkgbldtsks + >>= installRPMs dryrun noreinstall yes . mconcat where - kojiRPMs :: String -> String -> String -> String -> IO [String] -- ([String],String) - kojiRPMs huburl pkgsurl dlDir bldtask = - if all isDigit bldtask - then kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode reinstall mode dlDir bldtask - else kojiBuildRPMs huburl pkgsurl dlDir bldtask + 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 mode printDlDir taskid + Nothing -> kojiBuildRPMs huburl pkgsurl printDlDir bldtask - kojiBuildRPMs :: String -> String -> String -> String -> IO [String] - kojiBuildRPMs huburl pkgsurl dlDir pkgbld = do - nvrs <- kojiBuildOSBuilds debug huburl listmode latest disttag request pkgbld + kojiBuildRPMs :: String -> String -> IO () -> String + -> IO [(Existence,NVRA)] + kojiBuildRPMs huburl pkgsurl printDlDir pkgbld = do + nvrs <- map readNVR <$> kojiBuildOSBuilds debug huburl listmode latest disttag request pkgbld if listmode - then if mode /= PkgsReq [] [] - then error' "modes not supported for listing build" -- FIXME - else case nvrs of - [nvr] -> ([nvr,""] ++) . map (<.> "rpm") . sort . filter (not . debugPkg) <$> kojiGetBuildRPMs huburl nvr - _ -> return nvrs + then do + if mode /= PkgsReq [] [] + then error' "modes not supported for listing build" -- FIXME + else case nvrs of + [nvr] -> do + putStrLn (showNVR nvr) + putStrLn "" + kojiGetBuildRPMs huburl nvr >>= + mapM_ putStrLn . sort . filter notDebugPkg + _ -> mapM_ (putStrLn . showNVR) nvrs + return [] else case nvrs of [] -> error' $ pkgbld ++ " not found for " ++ disttag [nvr] -> do - putStrLn $ nvr ++ "\n" - allRpms <- map (<.> "rpm") . sort . filter (not . debugPkg) <$> kojiGetBuildRPMs huburl nvr - when debug $ print allRpms - dlRpms <- decideRpms yes listmode reinstall mode (maybeNVRName nvr) allRpms - when debug $ print dlRpms + putStrLn $ showNVR nvr ++ "\n" + nvras <- sort . map readNVRA . filter notDebugPkg <$> kojiGetBuildRPMs huburl nvr + when debug $ mapM_ (putStrLn . showNVRA) nvras + dlRpms <- decideRpms yes listmode noreinstall mode (nvrName nvr) nvras + when debug $ mapM_ printInstalled dlRpms unless (dryrun || null dlRpms) $ do - downloadRpms debug (buildURL (readNVR nvr)) dlRpms + downloadRpms debug (buildURL nvr) dlRpms -- FIXME once we check file size - can skip if no downloads - putStrLn $ "Packages downloaded to " ++ dlDir + printDlDir return dlRpms _ -> error $ "multiple build founds for " ++ pkgbld ++ ": " ++ - unwords nvrs + unwords (map showNVR nvrs) where buildURL :: NVR -> String -> String buildURL (NVR n (VerRel v r)) rpm = let arch = rpmArch (readNVRA rpm) in pkgsurl +/+ n +/+ v +/+ r +/+ arch +/+ rpm - debugPkg :: String -> Bool - debugPkg p = "-debuginfo-" `isInfixOf` p || "-debugsource-" `isInfixOf` p +notDebugPkg :: String -> Bool +notDebugPkg p = + not ("-debuginfo-" `isInfixOf` p || "-debugsource-" `isInfixOf` p) kojiTaskRPMs :: Bool -> Bool -> Yes -> String -> String -> Bool -> Bool -> Mode - -> String -> String -> IO [String] -kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode reinstall mode dlDir task = do - let taskid = read task + -> IO () -> Int -> IO [(Existence,NVRA)] +kojiTaskRPMs dryrun debug yes huburl pkgsurl listmode noreinstall mode printDlDir taskid = do mtaskinfo <- Koji.getTaskInfo huburl taskid True tasks <- case mtaskinfo of Nothing -> error' "failed to get taskinfo" Just taskinfo -> do when debug $ mapM_ print taskinfo case lookupStruct "method" taskinfo :: Maybe String of - Nothing -> error' $ "no method found for " ++ task + Nothing -> error' $ "no method found for " ++ show taskid Just method -> case method of "build" -> Koji.getTaskChildren huburl taskid False "buildArch" -> return [taskinfo] _ -> error' $ "unsupport method: " ++ method sysarch <- cmd "rpm" ["--eval", "%{_arch}"] - let archtid = + let (archtid,archtask) = case find (\t -> lookupStruct "arch" t == Just sysarch) tasks of Nothing -> error' $ "no " ++ sysarch ++ " task found" Just task' -> case lookupStruct "id" task' of Nothing -> error' "task id not found" - Just tid -> tid - rpms <- getTaskRPMs archtid + Just tid -> (tid,task') + nvras <- getTaskNVRAs archtid + name <- case find ((== "src") . rpmArch) nvras of + Just src -> return $ rpmName src + Nothing -> + return $ + either id nvrName $ + kojiTaskRequestPkgNVR $ + fromMaybe archtask mtaskinfo if listmode - then decideRpms yes listmode reinstall mode Nothing rpms + then decideRpms yes listmode noreinstall mode name nvras else - if null rpms + if null nvras then do - kojiTaskRPMs dryrun debug yes huburl pkgsurl True reinstall mode dlDir task >>= mapM_ putStrLn + kojiTaskRPMs dryrun debug yes huburl pkgsurl True noreinstall mode printDlDir archtid >>= mapM_ printInstalled return [] else do - when debug $ print rpms - let srpm = - case filter (".src.rpm" `isExtensionOf`) rpms of - [src] -> src - _ -> error' "could not determine nvr from any srpm" - nvr = dropSuffix ".src.rpm" srpm - dlRpms <- decideRpms yes listmode reinstall mode (maybeNVRName nvr) $ rpms \\ [srpm] - when debug $ print dlRpms + when debug $ print $ map showNVRA nvras + dlRpms <- decideRpms yes listmode noreinstall mode name $ + filter ((/= "src") . rpmArch) nvras + when debug $ mapM_ printInstalled dlRpms unless (dryrun || null dlRpms) $ do - downloadRpms debug (taskRPMURL task) dlRpms - putStrLn $ "Packages downloaded to " ++ dlDir + downloadRpms debug (taskRPMURL archtid) dlRpms + printDlDir return dlRpms where - getTaskRPMs :: Int -> IO [String] - getTaskRPMs taskid = - sort . filter (".rpm" `isExtensionOf`) . map fst <$> - Koji.listTaskOutput huburl taskid False True False + getTaskNVRAs :: Int -> IO [NVRA] + getTaskNVRAs taskid' = + sort . map readNVRA . filter notDebugPkg . filter (".rpm" `isExtensionOf`) . map fst <$> + -- FIXME get stats to show size + Koji.listTaskOutput huburl taskid' False True False - taskRPMURL :: String -> String -> String - taskRPMURL taskid rpm = + taskRPMURL :: Int -> String -> String + taskRPMURL taskid' rpm = let lastFew = - let few = dropWhile (== '0') $ takeEnd 4 taskid in + let few = dropWhile (== '0') $ takeEnd 4 (show taskid') in if null few then "0" else few - in dropSuffix "packages" pkgsurl +/+ "work/tasks/" ++ lastFew +/+ taskid +/+ rpm + in dropSuffix "packages" pkgsurl +/+ "work/tasks/" ++ lastFew +/+ show taskid' +/+ rpm -maybeNVRName :: String -> Maybe String -maybeNVRName = fmap nvrName . maybeNVR +data Existence = NotInstalled | NVRInstalled | NVRChanged + deriving (Eq, Ord, Show) -decideRpms :: Yes -> Bool -> Bool -> Mode -> Maybe String -> [String] -> IO [String] -decideRpms yes listmode reinstall mode mbase allRpms = - case mode of - All -> return allRpms - Ask -> if listmode - then error' "cannot use --list and --ask together" - else mapMaybeM rpmPrompt allRpms - PkgsReq [] [] -> - if listmode - then - -- FIXME mark already installed packages - return allRpms - else do - rpms <- filterM (isInstalled reinstall . dropExtension) $ - filter isBinaryRpm allRpms - if null rpms && yes /= Yes - then decideRpms yes listmode reinstall Ask mbase allRpms +decideRpms :: Yes -> Bool -> Bool -> Mode -> String -> [NVRA] + -> IO [(Existence,NVRA)] +decideRpms yes listmode noreinstall mode base nvras = do + classified <- mapM installExists (filter isBinaryRpm nvras) + if listmode + then mapM_ printInstalled classified >> return [] + else + case mode of + All -> do + mapM_ printInstalled classified + ok <- prompt yes "install above" + return $ if ok then classified else [] + Ask -> mapMaybeM (rpmPrompt yes) classified + PkgsReq [] [] -> + if all ((== NotInstalled) . fst) classified && yes /= Yes + then decideRpms yes listmode noreinstall Ask base nvras else do - if yes == Yes - then return rpms - else do - mapM_ putStrLn rpms - if listmode - then return [] + let install = filter ((/= NotInstalled) . fst) classified + if yes == Yes + then return install else do - ok <- isJust <$> rpmPrompt "install all" - return $ if ok then rpms else [] - PkgsReq subpkgs exclpkgs -> - return $ selectRPMs mbase (subpkgs,exclpkgs) allRpms + mapM_ printInstalled install + ok <- prompt yes "install above" + return $ if ok then install else [] + PkgsReq subpkgs exclpkgs -> do + let install = selectRPMs base (subpkgs,exclpkgs) classified + mapM_ printInstalled install + ok <- prompt yes "install above" + return $ if ok then install else [] + where + installExists :: NVRA -> IO (Existence, NVRA) + installExists nvra = do + minstalled <- cmdMaybe "rpm" ["-q", rpmName nvra] + return + (case minstalled of + Nothing -> NotInstalled + Just installed -> + if installed == showNVRA nvra then NVRInstalled else NVRChanged, + nvra) -isInstalled :: Bool -> String -> IO Bool -isInstalled reinstall rpm = - if reinstall - then cmdBool "rpm" ["--quiet", "-q", rpm] - else do - minstalled <- cmdMaybe "rpm" ["-q", nvraName rpm] - case minstalled of - Nothing -> return False - Just installed -> return $ installed /= rpm +renderInstalled :: (Existence, NVRA) -> String +renderInstalled (exist, nvra) = showNVRA nvra ++ " (" ++ show exist ++ ")" -selectRPMs :: Maybe String -> ([String],[String]) -> [String] -> [String] -selectRPMs mbase (subpkgs,[]) rpms = +printInstalled :: (Existence, NVRA) -> IO () +printInstalled = putStrLn . renderInstalled + +selectRPMs :: String -> ([String],[String]) -> [(Existence,NVRA)] + -> [(Existence,NVRA)] +selectRPMs base (subpkgs,[]) rpms = sort . mconcat $ flip map subpkgs $ \ pkgpat -> - case filter (match (compile pkgpat) . nvraName) rpms of - [] -> case mbase of - Just base | head pkgpat /= '*' -> - selectRPMs Nothing ([base ++ '-' : pkgpat],[]) rpms - _ -> error' $ "no subpackage match for " ++ pkgpat + case filter (match (compile pkgpat) . rpmName . snd) rpms of + [] -> if head pkgpat /= '*' + then selectRPMs base ([base ++ '-' : pkgpat],[]) rpms + else error' $ "no subpackage match for " ++ pkgpat result -> result -selectRPMs mbase ([], subpkgs) rpms = +selectRPMs base ([], subpkgs) rpms = -- FIXME somehow determine unused excludes foldl' (exclude subpkgs) [] rpms where - rpmnames = map nvraName rpms + rpmnames = map (rpmName . snd) rpms - exclude :: [String] -> [String] -> String -> [String] + exclude :: [String] -> [(Existence,NVRA)] -> (Existence,NVRA) + -> [(Existence,NVRA)] exclude [] acc rpm = acc ++ [rpm] exclude (pat:pats) acc rpm = - if checkMatch (nvraName rpm) + if checkMatch (rpmName (snd rpm)) then acc else exclude pats acc rpm where @@ -245,25 +264,33 @@ in if isLiteral comppat then pat == rpmname || pat `notElem` rpmnames && - maybe False (\b -> (b ++ '-' : pat) == rpmname) mbase + (base ++ '-' : pat) == rpmname else match comppat rpmname -selectRPMs mbase (subpkgs,exclpkgs) rpms = - let needed = selectRPMs mbase (subpkgs,[]) rpms - excluded = selectRPMs mbase ([], exclpkgs) rpms +selectRPMs base (subpkgs,exclpkgs) rpms = + let needed = selectRPMs base (subpkgs,[]) rpms + excluded = selectRPMs base ([], exclpkgs) rpms in nub . sort $ needed ++ excluded -nvraName :: String -> String -nvraName = rpmName . readNVRA +prompt :: Yes -> String -> IO Bool +prompt 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 -rpmPrompt :: String -> IO (Maybe String) -rpmPrompt rpm = do - putStr $ rpm ++ " [y/n]: " - c <- getChar - putStrLn "" - case toLower c of - 'y' -> return $ Just rpm - 'n' -> return Nothing - _ -> rpmPrompt rpm +rpmPrompt :: Yes -> (Existence,NVRA) -> IO (Maybe (Existence,NVRA)) +rpmPrompt yes (exist,nvra) = do + ok <- prompt yes $ renderInstalled (exist,nvra) + return $ + if ok + then Just (exist,nvra) + else Nothing kojiBuildOSBuilds :: Bool -> String -> Bool -> Bool -> String -> Request -> String -> IO [String] @@ -316,11 +343,11 @@ case readNVR pat of NVR n _ -> (n, True) -kojiGetBuildRPMs :: String -> String -> IO [String] +kojiGetBuildRPMs :: String -> NVR -> IO [String] kojiGetBuildRPMs huburl nvr = do - mbid <- kojiGetBuildID huburl nvr + mbid <- kojiGetBuildID huburl (showNVR nvr) case mbid of - Nothing -> error $ "Build id not found for " ++ nvr + Nothing -> error $ "Build id not found for " ++ showNVR nvr Just (BuildId bid) -> do rpms <- Koji.listBuildRPMs huburl bid sysarch <- cmd "rpm" ["--eval", "%{_arch}"] @@ -330,7 +357,7 @@ forArch sysarch st = case lookupStruct "arch" st of Just arch -> arch `elem` [sysarch, "noarch"] - Nothing -> error $ "No arch found for rpm for: " ++ nvr + Nothing -> error $ "No arch found for rpm for: " ++ showNVR nvr getNVRA :: Struct -> String getNVRA st = @@ -347,24 +374,28 @@ hSetBuffering stdin NoBuffering hSetBuffering stdout NoBuffering -installRPMs :: Bool -> Bool -> Yes -> [FilePath] -> IO () +installRPMs :: Bool -> Bool -> Yes -> [(Existence,NVRA)] -> IO () installRPMs _ _ _ [] = return () -installRPMs dryrun reinstall yes rpms = do - installed <- filterM (isInstalled reinstall . dropExtension) rpms - unless (null installed) $ - if dryrun - then mapM_ putStrLn $ "would update:" : installed - else sudo_ "dnf" $ "reinstall" : installed ++ ["--assumeyes" | yes == Yes] - let rest = rpms \\ installed - unless (null rest) $ - if dryrun - then mapM_ putStrLn $ "would install:" : rest - else sudo_ "dnf" $ "localinstall" : rest ++ ["--assumeyes" | yes == Yes] +installRPMs dryrun noreinstall yes classified = do + forM_ (groupSort classified) $ \(cl,pkgs) -> + unless (null pkgs) $ + let mdnfcmd = + case cl of + NVRInstalled -> if noreinstall then Nothing else Just "reinstall" + _ -> Just "localinstall" + in whenJust mdnfcmd $ \dnfcmd -> + if dryrun + then mapM_ putStrLn $ ("would " ++ dnfcmd ++ ":") : map showRpmFile pkgs + else sudo_ "dnf" $ dnfcmd : map showRpmFile pkgs ++ ["--assumeyes" | yes == Yes] -downloadRpms :: Bool -> (String -> String) -> [String] -> IO () +showRpmFile :: NVRA -> FilePath +showRpmFile nvra = showNVRA nvra <.> "rpm" + +downloadRpms :: Bool -> (String -> String) -> [(Existence,NVRA)] -> IO () downloadRpms debug urlOf rpms = do urls <- fmap catMaybes <$> - forM rpms $ \rpm -> do + forM (map snd rpms) $ \nvra -> do + let rpm = showRpmFile nvra exists <- doesFileExist rpm let url = urlOf rpm notfile <- @@ -415,9 +446,8 @@ -- taskid <- lookupStruct "id" struct -- return $ arch ++ replicate (8 - length arch) ' ' +-+ show (taskid :: Int) +-+ method +-+ show state -isBinaryRpm :: FilePath -> Bool -isBinaryRpm file = - ".rpm" `isExtensionOf` file && not (".src.rpm" `isExtensionOf` file) +isBinaryRpm :: NVRA -> Bool +isBinaryRpm = (/= "src") . rpmArch #if !MIN_VERSION_filepath(1,4,2) isExtensionOf :: String -> FilePath -> Bool diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -4,6 +4,7 @@ module Main (main) where +import Data.Char (isDigit) import Data.List.Extra import SimpleCmd import SimpleCmdArgs @@ -69,11 +70,9 @@ <*> 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" - <*> (Task <$> optionWith auto 't' "task" "TASKID" "Show task" - <|> Parent <$> optionWith auto 'c' "children" "TASKID" "List child tasks of parent" - <|> Build <$> strOptionWith 'b' "build" "BUILD" "List child tasks of build" + <*> (Build <$> strOptionWith 'b' "build" "BUILD" "List child tasks of build" <|> Pattern <$> strOptionWith 'p' "pattern" "NVRPAT" "Build tasks of matching pattern" - <|> Package <$> strArg "PACKAGE" + <|> argumentWith (maybeReader readTaskReq) "PACKAGE|TASKID" <|> pure TaskQuery) , Subcommand "install" @@ -87,7 +86,7 @@ "KojiFiles packages url [default: Fedora]") <*> switchWith 'l' "list" "List builds" <*> switchWith 'L' "latest" "Latest build" - <*> switchWith 'r' "reinstall-nvrs" "Reinstall existing NVRs" + <*> switchWith 'N' "no-reinstall" "Do not reinstall existing NVRs" <*> modeOpt <*> disttagOpt sysdisttag <*> (flagWith' ReqNVR 'R' "nvr" "Give an N-V-R instead of package name" <|> @@ -141,3 +140,7 @@ case elemIndex (lower m) (map lower kojiBuildTypes) of Just i -> kojiBuildTypes !! i Nothing -> error' $! "unknown build type: " ++ m + + readTaskReq :: String -> Maybe TaskReq + readTaskReq cs = + Just $ if all isDigit cs then Task (read cs) else Package cs diff --git a/src/Progress.hs b/src/Progress.hs --- a/src/Progress.hs +++ b/src/Progress.hs @@ -29,14 +29,14 @@ #if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>)) #endif +import Data.RPM.NVR import Data.Text (Text) import qualified Data.Text as T - import Distribution.Koji - import SimpleCmd +import System.FilePath (()) -import System.FilePath (takeBaseName, ()) +import Utils progressCmd :: Bool -> Int -> Bool -> [TaskID] -> IO () progressCmd debug waitdelay modules tids = do @@ -103,13 +103,8 @@ ((task,_):_) -> do putStrLn "" when debug $ print task - let request = lookupStruct "request" task :: Maybe [Value] - when debug $ print request - let mnvr = case request of - Just (srpm:_) -> - takeBaseName . takeBaseName <$> getString srpm - _ -> Nothing - logMsg $ fromMaybe "" mnvr ++ " (" ++ displayID tid ++ ")" + let mnvr = kojiTaskRequestNVR task + logMsg $ maybe "" showNVR mnvr ++ " (" ++ displayID tid ++ ")" sizes <- mapM buildlogSize tasks printLogSizes waitdelay sizes let news = map (\(t,(s,_)) -> (t,s)) sizes diff --git a/src/Tasks.hs b/src/Tasks.hs --- a/src/Tasks.hs +++ b/src/Tasks.hs @@ -37,6 +37,7 @@ import Common import Time import User +import Utils data TaskReq = Task Int | Parent Int | Build String | Package String | TaskQuery | Pattern String @@ -74,7 +75,11 @@ mtask <- kojiGetTaskInfo server (TaskId taskid) whenJust mtask$ \task -> do when debug $ pPrintCompact task - whenJust (maybeTaskResult task) $ printTask True tz + whenJust (maybeTaskResult task) $ \res -> do + let hasparent = isJust $ mtaskParent res + printTask hasparent tz res + unless hasparent $ + tasksCmd (Just server) museropt limit states archs mdate mmethod details debug mfilter' tail' (Parent taskid) Build bld -> do when (isJust mdate || isJust mfilter') $ error' "cannot use --build together with timedate or filter" @@ -170,23 +175,10 @@ taskid <- lookupStruct "id" st method <- lookupStruct "method" st state <- getTaskState st - request <- lookupStruct "request" st - let package = - case (getString . head) request of - Nothing -> Left $ unwords $ map showValue $ take 2 request - Just req -> - let file = takeFileName req - in if ".src.rpm" `isSuffixOf` file - then Right $ readNVR $ removeSuffix ".src.rpm" file - else Left $ takeBaseName file + let pkgnvr = kojiTaskRequestPkgNVR st mparent' = lookupStruct "parent" st :: Maybe Int return $ - TaskResult package arch method state mparent' taskid mstart_time mend_time - where - showValue :: Value -> String - showValue (ValueString cs) = cs - showValue (ValueInt i) = show i - showValue val = show val + TaskResult pkgnvr arch method state mparent' taskid mstart_time mend_time filterResults :: [TaskResult] -> [TaskResult] filterResults ts = @@ -263,7 +255,7 @@ _taskArch :: String, _taskMethod :: String, _taskState :: TaskState, - _mtaskParent :: Maybe Int, + mtaskParent :: Maybe Int, taskId :: Int, _mtaskStartTime :: Maybe UTCTime, mtaskEndTime :: Maybe UTCTime diff --git a/src/Utils.hs b/src/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Utils.hs @@ -0,0 +1,39 @@ +module Utils ( + kojiTaskRequestNVR, + kojiTaskRequestPkgNVR, + showValue + ) +where + +import Data.RPM (dropArch) +import Data.RPM.NVR +import Data.RPM.NVRA +import Distribution.Koji +import SimpleCmd (error') +import System.FilePath (takeBaseName) + +kojiTaskRequestNVR :: Struct -> Maybe NVR +kojiTaskRequestNVR task = + case lookupStruct "request" task of + Just (srpm:_) -> + getString srpm >>= fmap dropArch . maybeNVRA + _ -> Nothing + +-- FIXME this should really be a triple +kojiTaskRequestPkgNVR :: Struct -> Either String NVR +kojiTaskRequestPkgNVR task = + case lookupStruct "request" task of + Just req@(source:_) -> + case getString source of + -- non-build task + Nothing -> Left $ unwords $ map showValue $ take 2 req + Just src -> + case maybeNVRA src of + Just nvra -> Right $ dropArch nvra + Nothing -> Left $ takeBaseName src + _ -> error' "could determine package from build request" + +showValue :: Value -> String +showValue (ValueString cs) = cs +showValue (ValueInt i) = show i +showValue val = show val diff --git a/test/tests.hs b/test/tests.hs --- a/test/tests.hs +++ b/test/tests.hs @@ -13,7 +13,7 @@ tests :: Bool -> [([String], [[String]])] tests havedist = [ - (["install", "-n"], + (["install", "-n", "-y"], [["podman", "-p", "podman"] ++ sysdist ,["-l", "coreutils"] ++ sysdist ,["-l", "-R", "rpmlint-2.2.0-1.fc36"]