koji-install 0.3 → 0.4
raw patch · 5 files changed
+264/−107 lines, 5 filesdep +Globdep +http-directory
Dependencies added: Glob, http-directory
Files
- ChangeLog.md +10/−0
- README.md +17/−14
- koji-install.cabal +6/−3
- src/Main.hs +226/−86
- test/tests.hs +5/−4
ChangeLog.md view
@@ -1,9 +1,19 @@ # Release history for koji-install +## 0.4 (2021-12-20)+- support installing/listing by koji taskid+- select subpackages with --package and --exclude, by name or globbing+- check remote files date/size with http-directory+- listing a task either lists the task's children or rpms+- use dnf reinstall for installed packages and otherwise localinstall+- more detailed debug output+- system arch no longer hardcoded to x86_64+ ## 0.3 (2021-12-03) - add `--list` command to list recent builds - fix bug in generating kojifiles url from short name - workarounds for rpmfusion's older koji not supporting patterns+- check if %dist is defined ## 0.2.0 (2021-12-03) - initial Hackage release
README.md view
@@ -1,8 +1,9 @@ # koji-install -A CLI tool to download and install rpms from a Koji build.+A CLI tool to download and install rpms from a Koji build or task. -Koji is a package buildsystem used by Fedora, Centos, and some other projects.+[Koji](https://pagure.io/koji/) is a RPM package buildsystem used by+Fedora, Centos, and some other projects. ## Usage @@ -20,13 +21,13 @@ By default only installed subpackages are downloaded and updated, but the following options change the behavior: -`--all`: install all subpackages+`--package`: select subpackages by name or glob pattern (this doesn't work currently on multiple builds/tasks) -`--ask`: ask about each subpackage+`--exclude`: exclude subpackages by name or glob pattern -`--base-only`: only install the base package+`--all`: install all subpackages -`--exclude-devel`: skip devel subpackages+`--ask`: ask about each subpackage ### Help ```shellsession@@ -34,10 +35,10 @@ Download and install latest package build from Koji tag. Usage: koji-install [--version] [-n|--dry-run] [-D|--debug] [-H|--hub HUB]- [-P|--packages-url URL]- [(-l|--list) | (-a|--all) | (-A|--ask) | (-b|--base-only) |- (-D|--exclude-devel)] [-d|--disttag DISTTAG]- [(-R|--nvr) | (-V|--nv)] PACKAGE+ [-P|--packages-url URL] [-l|--list]+ [(-a|--all) | (-A|--ask) | (-p|--package SUBPKG) |+ (-x|--exclude SUBPKG)] [-d|--disttag DISTTAG]+ [(-R|--nvr) | (-V|--nv)] PACKAGE|TASKID... HUB = fedora, stream, rpmfusion, or URL Available options:@@ -46,17 +47,19 @@ -n,--dry-run Don't actually download anything -D,--debug More detailed output -H,--hub HUB KojiHub shortname or url [default: fedora]- -P,--packages-url URL KojiFiles packages url [default: fedora]+ -P,--packages-url URL KojiFiles packages url [default: Fedora] -l,--list List builds -a,--all all subpackages- -A,--ask ask for each subpackge- -b,--base-only only base package- -D,--exclude-devel Skip devel packages+ -A,--ask ask for each subpackge [default if not installed]+ -p,--package SUBPKG Subpackage (glob) to install+ -x,--exclude SUBPKG Subpackage (glob) not to install -d,--disttag DISTTAG Use a different disttag [default: .fc35] -R,--nvr Give an N-V-R instead of package name -V,--nv Give an N-V instead of package name ``` ## Installation+Builds for fedora are available in [copr](https://copr.fedorainfracloud.org/coprs/petersen/koji-tools/monitor/detailed). +## Build `cabal-rpm builddep && cabal install` or `stack install`.
koji-install.cabal view
@@ -1,10 +1,11 @@ name: koji-install-version: 0.3+version: 0.4 synopsis: CLI tool for installing rpms directly from Fedora Koji description:- koji-install can install the latest koji build of a package locally.+ koji-install can install a koji build/task of a package locally. By default it only downloads newer binaries of already-installed- subpackages, but there are options to override that.+ subpackages, but there are options to list and select other packages.+ Koji is the RPM-based buildsystem of Fedora Linux and Centos. license: BSD3 license-file: LICENSE author: Jens Petersen <juhpetersen@gmail.com>@@ -36,6 +37,8 @@ directory, extra, filepath,+ Glob,+ http-directory >= 0.1.9, koji >= 0.0.2, rpm-nvr, simple-cmd,
src/Main.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- SPDX-License-Identifier: BSD-3-Clause module Main (main) where@@ -9,20 +11,21 @@ import Data.RPM import Distribution.Koji import qualified Distribution.Koji.API as Koji+import Network.HTTP.Directory (httpFileSize', httpLastModified', (+/+)) import SimpleCmd import SimpleCmdArgs import System.Directory-import System.FilePath ((<.>))+import System.FilePath+import System.FilePath.Glob import System.IO import DownloadDir import Paths_koji_install (version) --- FIXME use subtype for listing vs installation-data Mode = List | InstMode InstallMode+data Mode = Update | All | Ask | PkgsReq SubPackages deriving Eq -data InstallMode = Update | All | Ask | Base | NoDevel+data SubPackages = Subpkgs [String] | ExclPkgs [String] deriving Eq data Request = ReqName | ReqNV | ReqNVR@@ -49,22 +52,21 @@ <*> optional (strOptionWith 'H' "hub" "HUB" "KojiHub shortname or url [default: fedora]") <*> optional (strOptionWith 'P' "packages-url" "URL"- "KojiFiles packages url [default: fedora]")+ "KojiFiles packages url [default: Fedora]")+ <*> switchWith 'l' "list" "List builds" <*> modeOpt <*> disttagOpt sysdisttag <*> (flagWith' ReqNVR 'R' "nvr" "Give an N-V-R instead of package name" <|> flagWith ReqName ReqNVR 'V' "nv" "Give an N-V instead of package name")- <*> some (strArg "PACKAGE")+ <*> some (strArg "PACKAGE|TASKID...") where modeOpt :: Parser Mode modeOpt =- flagWith' List 'l' "list" "List builds" <|>- InstMode <$>- (flagWith' All 'a' "all" "all subpackages" <|>- flagWith' Ask 'A' "ask" "ask for each subpackge" <|>- flagWith' Base 'b' "base-only" "only base package" <|>- flagWith' NoDevel 'D' "exclude-devel" "Skip devel packages" <|>- pure Update)+ flagWith' All 'a' "all" "all subpackages" <|>+ flagWith' Ask 'A' "ask" "ask for each subpackge [default if not installed]" <|>+ PkgsReq <$> (Subpkgs <$> some (strOptionWith 'p' "package" "SUBPKG" "Subpackage (glob) to install") <|>+ ExclPkgs <$> some (strOptionWith 'x' "exclude" "SUBPKG" "Subpackage (glob) not to install")) <|>+ pure Update disttagOpt :: String -> Parser String disttagOpt disttag = startingDot <$> strOptionalWith 'd' "disttag" "DISTTAG" ("Use a different disttag [default: " ++ disttag ++ "]") disttag@@ -99,78 +101,154 @@ "https://kojihub.stream.centos.org/kojifiles/packages" _ -> if "kojihub" `isSuffixOf` url- then replace "kojihub" "kojifiles" url+ then replace "kojihub" "kojifiles" url +/+ "packages" else error' $ "use --files-url to specify kojifiles url for " ++ url -program :: Bool -> Bool -> Maybe String -> Maybe String -> Mode+program :: Bool -> Bool -> Maybe String -> Maybe String -> Bool -> Mode -> String -> Request -> [String] -> IO ()-program dryrun debug mhuburl mpkgsurl mode disttag request pkgs = do+program dryrun debug mhuburl mpkgsurl listmode mode disttag request pkgs = do let huburl = maybe fedoraKojiHub hubURL mhuburl pkgsurl = fromMaybe (defaultPkgsURL huburl) mpkgsurl when debug $ do putStrLn huburl putStrLn pkgsurl- -- FIXME use this?+ -- FIXME use this location? dlDir <- setDownloadDir dryrun "rpms" when debug $ putStrLn dlDir setNoBuffering- mapM (kojiLatestRPMs huburl pkgsurl dlDir) pkgs- >>= case mode of- List -> mapM_ putStrLn . mconcat- _ -> installRPMs dryrun . mconcat+ mapM (kojiRPMs huburl pkgsurl dlDir) pkgs+ >>= if listmode+ then mapM_ putStrLn . mconcat+ else installRPMs dryrun . mconcat where- kojiLatestRPMs :: String -> String -> String -> String -> IO [String]- kojiLatestRPMs huburl pkgsurl dlDir pkg = do- nvrs <- kojiLatestOSBuilds debug huburl (mode == List) disttag request pkg- case mode of- List -> return nvrs- InstMode instmode ->- case nvrs of- [] -> error' $ "latest " ++ pkg ++ " not found for " ++ disttag- [nvr] -> do- putStrLn $ nvr ++ "\n"- allRpms <- map (<.> "rpm") . sort . filter (not . debugPkg) <$> kojiGetBuildRPMs huburl nvr- dlRpms <- decideRpms instmode allRpms- unless (dryrun || null dlRpms) $ do- mapM_ (downloadRpm pkgsurl (readNVR nvr)) dlRpms- -- FIXME once we check file size - can skip if no downloads- putStrLn $ "Packages downloaded to " ++ dlDir- return dlRpms- _ -> error $ "multiple latest build founds for " ++ pkg ++ ": " ++- unwords nvrs- where- decideRpms :: InstallMode -> [String] -> IO [String]- decideRpms mode' allRpms =- case mode' of- All -> return allRpms- Ask -> mapMaybeM rpmPrompt allRpms- Base -> return $ pure $ minimumOn length $ filter (pkg `isPrefixOf`) allRpms- Update -> do- rpms <- filterM (isInstalled . rpmName . readNVRA) allRpms- if null rpms- then decideRpms Ask allRpms- else return rpms- NoDevel -> return $ filter (not . ("-devel-" `isInfixOf`)) allRpms-- 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+ kojiRPMs :: String -> String -> String -> String -> IO [String]+ kojiRPMs huburl pkgsurl dlDir pkg =+ if all isDigit pkg+ then kojiTaskRPMs dryrun debug huburl pkgsurl listmode mode dlDir pkg+ else kojiBuildRPMs huburl pkgsurl dlDir pkg - isInstalled :: String -> IO Bool- isInstalled rpm = cmdBool "rpm" ["--quiet", "-q", rpm]+ kojiBuildRPMs :: String -> String -> String -> String -> IO [String]+ kojiBuildRPMs huburl pkgsurl dlDir pkg = do+ nvrs <- kojiBuildOSBuilds debug huburl listmode disttag request pkg+ if listmode+ then if mode /= Update+ then error' "modes not supported for listing build"+ else return nvrs+ else+ case nvrs of+ [] -> error' $ pkg ++ " 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 listmode mode (Just pkg) allRpms+ when debug $ print dlRpms+ unless (dryrun || null dlRpms) $ do+ mapM_ (downloadBuildRpm debug pkgsurl (readNVR nvr)) dlRpms+ -- FIXME once we check file size - can skip if no downloads+ putStrLn $ "Packages downloaded to " ++ dlDir+ return dlRpms+ _ -> error $ "multiple build founds for " ++ pkg ++ ": " +++ unwords nvrs debugPkg :: String -> Bool debugPkg p = "-debuginfo-" `isInfixOf` p || "-debugsource-" `isInfixOf` p -kojiLatestOSBuilds :: Bool -> String -> Bool -> String -> Request -> String+kojiTaskRPMs :: Bool -> Bool -> String -> String -> Bool -> Mode -> String+ -> String -> IO [String]+kojiTaskRPMs dryrun debug huburl pkgsurl listmode mode dlDir task = do+ let taskid = read task+ if listmode+ then do+ mtaskinfo <- Koji.getTaskInfo huburl taskid True+ case mtaskinfo of+ Just taskinfo -> do+ when debug $ mapM_ print taskinfo+ if isNothing (lookupStruct "parent" taskinfo :: Maybe Int)+ then do+ children <- Koji.getTaskChildren huburl taskid False+ return $ fromMaybe "" (showTask taskinfo) : mapMaybe showChildTask children+ else getTaskRPMs taskid >>= decideRpms listmode mode Nothing+ Nothing -> error' "failed to get taskinfo"+ else do+ rpms <- getTaskRPMs taskid+ if null rpms+ then do+ kojiTaskRPMs dryrun debug huburl pkgsurl True mode dlDir task >>= mapM_ putStrLn+ return []+ else do+ when debug $ print rpms+ dlRpms <- decideRpms listmode mode Nothing rpms+ when debug $ print dlRpms+ unless (dryrun || null dlRpms) $ do+ mapM_ (downloadTaskRpm debug pkgsurl task) dlRpms+ putStrLn $ "Packages downloaded to " ++ dlDir+ return dlRpms+ where+ getTaskRPMs :: Int -> IO [String]+ getTaskRPMs taskid =+ sort . filter isBinaryRpm . map fst <$>+ Koji.listTaskOutput huburl taskid False True False++decideRpms :: Bool -> Mode -> Maybe String -> [String] -> IO [String]+decideRpms listmode mode mpkg allRpms =+ case mode of+ All -> if listmode+ then error' "cannot use --list and --all together"+ else return allRpms+ Ask -> if listmode+ then error' "cannot use --list and --ask together"+ else mapMaybeM rpmPrompt allRpms+ Update ->+ if listmode+ then return allRpms+ else do+ rpms <- filterM (isInstalled . rpmName . readNVRA) allRpms+ if null rpms+ then decideRpms listmode Ask mpkg allRpms+ else return rpms+ PkgsReq pkgsreq ->+ return $ selectRPMs pkgsreq allRpms++isInstalled :: String -> IO Bool+isInstalled rpm = cmdBool "rpm" ["--quiet", "-q", rpm]++selectRPMs :: SubPackages -> [String] -> [String]+selectRPMs pkgsreq allRpms =+ case pkgsreq of+ Subpkgs subpkgs ->+ sort . mconcat $+ flip map subpkgs $ \ pkgpat ->+ case filter (match (compile pkgpat) . nvraName) allRpms of+ [] -> error' $ "no subpackage match for " ++ pkgpat+ result -> result+ ExclPkgs subpkgs ->+ -- FIXME somehow determine unused excludes+ foldl' (exclude subpkgs) [] allRpms+ where+ nvraName :: String -> String+ nvraName = rpmName . readNVRA++ exclude :: [String] -> [String] -> String -> [String]+ exclude [] acc pkg = acc ++ [pkg]+ exclude (p:ps) acc pkg =+ if match (compile p) (nvraName pkg)+ then acc+ else exclude ps acc pkg++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++kojiBuildOSBuilds :: Bool -> String -> Bool -> String -> Request -> String -> IO [String]-kojiLatestOSBuilds debug hub listmode disttag request pkgpat = do+kojiBuildOSBuilds debug hub listmode disttag request pkgpat = do let (pkg,full) = packageOfPattern pkgpat oldkoji = "rpmfusion" `isInfixOf` hub when (oldkoji && ("*" `isInfixOf` pkgpat || request /= ReqName)) $@@ -220,7 +298,8 @@ Nothing -> error $ "Build id not found for " ++ nvr Just (BuildId bid) -> do rpms <- Koji.listBuildRPMs huburl bid- return $ map getNVRA $ filter (forArch "x86_64") rpms+ sysarch <- cmd "rpm" ["--eval", "%{_arch}"]+ return $ map getNVRA $ filter (forArch sysarch) rpms where forArch :: String -> Struct -> Bool forArch sysarch st =@@ -245,24 +324,85 @@ installRPMs :: Bool -> [FilePath] -> IO () installRPMs _ [] = return ()-installRPMs dryrun pkgs =- unless dryrun $- sudo_ "dnf" ("install" : map ("./" ++) pkgs)+installRPMs dryrun pkgs = do+ installed <- filterM (isInstalled . rpmName . readNVRA) pkgs+ unless (null installed) $+ if dryrun+ then mapM_ putStrLn $ "would update:" : installed+ else sudo_ "dnf" ("reinstall" : installed)+ let rest = pkgs \\ installed+ unless (null rest) $+ if dryrun+ then mapM_ putStrLn $ "would install:" : rest+ else sudo_ "dnf" ("localinstall" : rest) +downloadBuildRpm :: Bool -> String -> NVR -> String -> IO ()+downloadBuildRpm debug pkgsurl (NVR n (VerRel v r)) rpm = do+ let arch = rpmArch (readNVRA rpm)+ url = pkgsurl +/+ n +/+ v +/+ r +/+ arch +/+ rpm+ downloadRPM debug url++downloadTaskRpm :: Bool -> String -> String -> String -> IO ()+downloadTaskRpm debug pkgsurl taskid rpm = do+ let url = dropSuffix "packages" pkgsurl +/+ "work/tasks/" ++ lastFew +/+ taskid +/+ rpm+ downloadRPM debug url+ where+ lastFew =+ let few = dropWhile (== '0') $ takeEnd 4 taskid in+ if null few then "0" else few+ -- FIXME check file size-downloadRpm :: String -> NVR -> String -> IO ()-downloadRpm pkgsurl (NVR n (VerRel v r)) rpm = do- unlessM (doesFileExist rpm) $ do- let arch = rpmArch (readNVRA rpm)- url = pkgsurl +/+ n +/+ v +/+ r +/+ arch +/+ rpm- putStrLn $ "Downloading " ++ rpm- cmd_ "curl" ["--fail", "--silent", "-C-", "--show-error", "--remote-name", url]+-- FIXME check timestamp+downloadRPM :: Bool -> String -> IO ()+downloadRPM debug url = do+ let rpm = takeFileName url+ exists <- doesFileExist rpm+ notfile <-+ if exists+ then do+ old <- outOfDate rpm+ when old $ removeFile rpm+ return old+ else return True+ when notfile $ do+ putStrLn $ "Downloading " ++ if debug then url else rpm+ cmd_ "curl" ["--remote-time", "--fail", "--silent", "-C-", "--show-error", "--remote-name", url]+ where+ outOfDate :: String -> IO Bool+ outOfDate file = do+ mremotetime <- httpLastModified' url+ case mremotetime of+ Just remotetime -> do+ localtime <- getModificationTime file+ return $ localtime < remotetime+ Nothing -> do+ remotesize <- httpFileSize' url+ localsize <- getFileSize file+ return $ remotesize /= Just localsize --- from next http-directory or http-query-infixr 5 +/+-(+/+) :: String -> String -> String-"" +/+ s = s-s +/+ "" = s-s +/+ t | last s == '/' = init s +/+ t- | head t == '/' = s +/+ tail t-s +/+ t = s ++ "/" ++ t+showTask :: Struct -> Maybe String+showTask struct = do+ state <- getTaskState struct+ request <- lookupStruct "request" struct+ method <- lookupStruct "method" struct+ let mparent = lookupStruct "parent" struct :: Maybe Int+ showreq = takeWhileEnd (/= '/') . unwords . mapMaybe getString . take 3+ return $ showreq request +-+ method +-+ (if state == TaskClosed then "" else show state) +-+ maybe "" (\p -> "(" ++ show p ++ ")") mparent++showChildTask :: Struct -> Maybe String+showChildTask struct = do+ arch <- lookupStruct "arch" struct+ state <- getTaskState struct+ method <- lookupStruct "method" struct+ 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)++#if !MIN_VERSION_filepath(1,4,2)+isExtensionOf :: String -> FilePath -> Bool+isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions+isExtensionOf ext = isSuffixOf ('.':ext) . takeExtensions+#endif
test/tests.hs view
@@ -8,12 +8,13 @@ tests :: Bool -> [[String]] tests havedist =- [["-b", "podman"] ++ sysdist+ [["podman", "-p", "podman"] ++ sysdist ,["-l", "coreutils"] ++ sysdist- ,["-b", "-H", "https://kojihub.stream.centos.org/kojihub", "-d", "el9", "bash"]- ,["-b", "-H", "stream", "-d", "el9", "kernel"]+ ,["-l", "79802560", "-p", "rpmlint"]+ ,["-H", "https://kojihub.stream.centos.org/kojihub", "-d", "el9", "bash", "-p", "bash"]+ ,["-H", "stream", "-d", "el9", "kernel", "-x", "kernel-devel*", "-x", "*-debug*"] ,["-l", "-H", "stream", "-d", "el9", "grep"]- ,["-b", "-H", "rpmfusion", "ffmpeg"] ++ sysdist+ ,["-H", "rpmfusion", "ffmpeg", "-p", "ffmpeg", "-p", "ffmpeg-libs"] ++ sysdist ,["-l", "-H", "rpmfusion", "ffmpeg"] ++ sysdist ] where