koji-tool 0.8.3 → 0.8.4
raw patch · 10 files changed
+276/−204 lines, 10 filesdep ~rpm-nvrdep ~simple-cmd-args
Dependency ranges changed: rpm-nvr, simple-cmd-args
Files
- ChangeLog.md +8/−0
- README.md +23/−22
- koji-tool.cabal +3/−2
- src/DownloadDir.hs +5/−2
- src/Install.hs +175/−145
- src/Main.hs +8/−5
- src/Progress.hs +5/−10
- src/Tasks.hs +9/−17
- src/Utils.hs +39/−0
- test/tests.hs +1/−1
ChangeLog.md view
@@ -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
README.md view
@@ -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
koji-tool.cabal view
@@ -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,
src/DownloadDir.hs view
@@ -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
src/Install.hs view
@@ -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
src/Main.hs view
@@ -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
src/Progress.hs view
@@ -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 "<unknown>" mnvr ++ " (" ++ displayID tid ++ ")"+ let mnvr = kojiTaskRequestNVR task+ logMsg $ maybe "<unknown>" showNVR mnvr ++ " (" ++ displayID tid ++ ")" sizes <- mapM buildlogSize tasks printLogSizes waitdelay sizes let news = map (\(t,(s,_)) -> (t,s)) sizes
src/Tasks.hs view
@@ -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
+ src/Utils.hs view
@@ -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
test/tests.hs view
@@ -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"]