diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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`. diff --git a/koji-install.cabal b/koji-install.cabal --- a/koji-install.cabal +++ b/koji-install.cabal @@ -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 @@ -36,6 +37,8 @@ directory, extra, filepath, + Glob, + http-directory >= 0.1.9, koji >= 0.0.2, rpm-nvr, simple-cmd, diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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 diff --git a/test/tests.hs b/test/tests.hs --- a/test/tests.hs +++ b/test/tests.hs @@ -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