diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,14 @@ # Revision history for fedora-repoquery +## 0.4 (2024-05-24) +- add --dnf4 option to use dnf4 (actually /usr/bin/dnf-3) instead of dnf5 +- rawhide and oldest active releases are now determined/cached via Bodhi API +- can now query with rawhide version (eg 41 currently) +- --requires do not allow --qf +- --list now shows active fedora releases +- for centos and eln only check compose via BaseOS repo +- map version 11 to eln + ## 0.3.2 (2024-02-19) - enable centos 10 stream (still alpha) - Query: disable --qf for --provides diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,32 +1,67 @@ # fedora-repoquery -A work-in-progress wrapper for dnf repoquery, +A fedora release version wrapper of dnf repoquery, which caches repodata separately per release. ## Usage Usage examples: -- `fdrq rawhide firefox` +`$ fdrq rawhide firefox` -- `fdrq 39 --requires podman` +``` +firefox-126.0-7.fc41.x86_64 (fedora-rawhide) +``` -- `fdrq epel9 ghc` +`$ fdrq 40 --requires filesystem` -- `fdrq c9 bash` +``` +setup +``` -- `fdrq eln kernel` +`$ fdrq epel9 ghc` -etc +``` +ghc-8.10.7-116.el9.x86_64 (epel9) +``` +`$ fdrq c10 bash` + +``` +bash-5.2.26-3.el10.x86_64 (c10s-BaseOS) +``` + +`$ fdrq eln kernel` + +``` +kernel-6.10.0-0.rc0.20240523gitc760b3725e52.12.eln136.x86_64 (eln-BaseOS) +``` + +etc. + +The above output is generated with mdsh which suppresses the stderr +that includes mirror repo urls with compose timestamps, like this: +``` +$ fdrq rawhide fedrq +2024-05-23 16:41:58 +08 + +fedrq-1.1.0-1.fc41.noarch (fedora-rawhide) +``` + +Also note that dnf5 currently still outputs repo update messages to stdout +but it is a lot faster than dnf4. + +## Help `$ fdrq --version` + ``` -0.3.2 +0.4 ``` `$ fdrq --help` + ``` fedora-repoquery tool for querying Fedora repos for packages. -Usage: fdrq [--version] [(-q|--quiet) | (-v|--verbose)] [-K|--koji] +Usage: fdrq [--version] [-4|--dnf4] [(-q|--quiet) | (-v|--verbose)] [-K|--koji] [--devel-channel | --test-channel] [(-m|--mirror URL) | (-D|--dl)] [(-s|--source) | (-A|--all-archs) | [-a|--arch ARCH]] [-t|--testing] [-d|--debug] @@ -40,6 +75,7 @@ Available options: -h,--help Show this help text --version Show version + -4,--dnf4 Use dnf4 instead of dnf5 (if available) -q,--quiet Avoid output to stderr -v,--verbose Show stderr from dnf repoquery -K,--koji Use Koji buildroot @@ -67,7 +103,7 @@ Use `stack install fedora-repoquery` or `cabal install fedora-repoquery` to build the latest release. -To build from git: `stack install` or `cabal install`. +To build from git: `stack install` or `cabal install` or `cabal-rpm install`. ## Contributing fedora-repoquery is distributed under the GPL license version 3 or later. diff --git a/fedora-repoquery.cabal b/fedora-repoquery.cabal --- a/fedora-repoquery.cabal +++ b/fedora-repoquery.cabal @@ -1,8 +1,9 @@ name: fedora-repoquery -version: 0.3.2 +version: 0.4 synopsis: Fedora repoquery tool description: - CLI tool for querying the location and version of Fedora packages + A CLI tool for querying Fedora packages + including their version and repo location license: GPL-3 license-file: COPYING author: Jens Petersen @@ -22,6 +23,7 @@ || == 9.2 || == 9.4 || == 9.6 + || == 9.8 source-repository head type: git @@ -31,10 +33,13 @@ main-is: Main.hs autogen-modules: Paths_fedora_repoquery other-modules: Paths_fedora_repoquery + Arch + BodhiRelease Cache Common List Query + ShowRelease Types URL hs-source-dirs: src @@ -50,7 +55,6 @@ regex-compat, simple-cmd, simple-cmd-args, - text, time default-language: Haskell2010 diff --git a/src/Arch.hs b/src/Arch.hs new file mode 100644 --- /dev/null +++ b/src/Arch.hs @@ -0,0 +1,52 @@ +module Arch ( + Arch(..), + allArchs, + eitherArch, + showArch, + getSystemArch + ) +where + +import Data.List.Extra (lower) +import SimpleCmd (cmd, error') + +data Arch = Source + | X86_64 + | AARCH64 + | ARMV7HL + | PPC64LE + | S390X + | I386 + deriving Eq + +allArchs :: [Arch] +allArchs = [X86_64, AARCH64, PPC64LE, S390X] + +eitherArch :: String -> Either String Arch +eitherArch s = + case lower s of + "source" -> Right Source + "x86_64" -> Right X86_64 + "aarch64" -> Right AARCH64 + "armv7hl" -> Right ARMV7HL + "s390x" -> Right S390X + "ppc64le" -> Right PPC64LE + "i386" -> Right I386 + _ -> Left $ "unknown arch: " ++ s + +readArch :: String -> Arch +readArch = + either error' id . eitherArch + +showArch :: Arch -> String +showArch Source = "source" +showArch X86_64 = "x86_64" +showArch AARCH64 = "aarch64" +showArch ARMV7HL = "armv7hl" +showArch S390X = "s390x" +showArch PPC64LE = "ppc64le" +showArch I386 = "i386" + +getSystemArch :: IO Arch +getSystemArch = + readArch <$> cmd "rpm" ["--eval", "%{_arch}"] diff --git a/src/BodhiRelease.hs b/src/BodhiRelease.hs new file mode 100644 --- /dev/null +++ b/src/BodhiRelease.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE OverloadedStrings #-} + +module BodhiRelease ( + BodhiRelease (..), + activeFedoraRelease, + activeFedoraReleases, + pendingFedoraRelease + ) +where + +import Control.Monad.Extra (when) +import qualified Data.List as L +import Data.Maybe (mapMaybe) +import Fedora.Bodhi (bodhiReleases, lookupKey, makeKey) +import SimpleCmd (error') +import System.Cached.JSON (getCachedJSONQuery) + +import Types (Natural) + +data BodhiRelease = + Release {releaseVersion :: String, -- to handle eln + releaseState :: String, + releaseBranch :: String} + deriving Eq + +-- Left is oldest active version +activeFedoraRelease :: Natural -> IO (Either Natural BodhiRelease) +-- F37 not archived yet: https://pagure.io/releng/issue/12124 +activeFedoraRelease 37 = return $ Right $ Release "37" "current" "f37" +activeFedoraRelease n = do + active <- activeFedoraReleases + when (null active) $ error' "failed to find active releases with Bodhi API" + case L.find (\r -> releaseVersion r == show n) active of + Just rel -> return $ Right rel + Nothing -> + let ordered = L.sort $ map releaseVersion active + in return $ Left $ read $ head ordered + +activeFedoraReleases :: IO [BodhiRelease] +activeFedoraReleases = + L.nub . mapMaybe maybeRelease <$> getCachedJSONQuery "fedora-repoquery" "fedora-bodhi-releases-active" (bodhiReleases (makeKey "exclude_archived" "1")) 1000 + where + maybeRelease obj = do + version <- lookupKey "version" obj + state <- lookupKey "state" obj + branch <- lookupKey "branch" obj + return $ Release version state branch + +pendingFedoraRelease :: Natural -> IO Bool +pendingFedoraRelease n = do + eactive <- activeFedoraRelease n + return $ + case eactive of + Left _ -> False + Right rel -> releaseState rel == "pending" diff --git a/src/List.hs b/src/List.hs --- a/src/List.hs +++ b/src/List.hs @@ -1,31 +1,15 @@ -{-# LANGUAGE OverloadedStrings #-} - module List ( listVersionsCmd ) where -import Control.Monad -import qualified Data.Text.IO as T -import Network.HTTP.Directory ---import SimpleCmd (error') +import Data.List.Extra +import SimpleCmd ((+-+)) -import Common -import Query (getFedoraServer, fedoraTop) -import Types -import URL +import ShowRelease (activeFedoraReleases, BodhiRelease(..)) -listVersionsCmd :: Bool -> Verbosity -> RepoSource -> Arch -> IO () --- listVersionsCmd _verbose _reposource = --- error' "listing Centos Stream versions not supported" --- --showReleaseCmd mgr server (RepoCentosStream chan) arch --- listVersionsCmd _ RepoKoji = --- error' "listing Koji versions not supported" -listVersionsCmd debug verbose reposource arch = do - mgr <- httpManager - -- FIXME handle non-fedora versions (eg epel) - -- FIXME no longer releases/, but parent dir - (url,_) <- getFedoraServer debug mgr reposource (fedoraTop arch) ["releases"] - let rurl = renderUrl url - unless (verbose == Quiet) $ warning $! "<" ++ rurl ++ ">" - -- FIXME filter very old releases - httpDirectory mgr rurl >>= mapM_ (T.putStrLn . noTrailingSlash) +listVersionsCmd :: IO () +listVersionsCmd = + activeFedoraReleases >>= mapM_ printRelease . sortOn releaseState + where + printRelease (Release _version state branch) = + putStrLn $ branch +-+ state diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -17,29 +17,31 @@ #if !MIN_VERSION_simple_cmd_args(0,1,7) import Options.Applicative (eitherReader, maybeReader, ReadM) #endif -import SimpleCmd (cmd, (+-+)) +import SimpleCmd ((+-+)) import SimpleCmdArgs import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout) ---import Distribution.Fedora.Repoquery - -import Cache -import List +import Arch +import Cache (cacheSize, cleanEmptyCaches) +import List (listVersionsCmd) import Paths_fedora_repoquery (version) -import Query -import Types +import Query (repoqueryCmd) +import ShowRelease (showReleaseCmd, downloadServer) +import Types (Channel(..), Mirror(..), Release, RepoSource(..), Verbosity(..), + readRelease) data Command = Query Release [String] | CacheSize | CacheEmpties | List main :: IO () main = do hSetBuffering stdout NoBuffering - sysarch <- readArch <$> cmd "rpm" ["--eval", "%{_arch}"] + sysarch <- getSystemArch simpleCmdArgs' (Just version) "fedora-repoquery tool for querying Fedora repos for packages." ("where RELEASE is {fN or N (fedora), 'rawhide', epelN, epelN-next, cN (centos stream), 'eln'}, with N the release version number." +-+ "https://github.com/juhp/fedora-repoquery#readme") $ runMain sysarch - <$> (flagWith' Quiet 'q' "quiet" "Avoid output to stderr" <|> flagWith Normal Verbose 'v' "verbose" "Show stderr from dnf repoquery") + <$> switchWith '4' "dnf4" "Use dnf4 instead of dnf5 (if available)" + <*> (flagWith' Quiet 'q' "quiet" "Avoid output to stderr" <|> flagWith Normal Verbose 'v' "verbose" "Show stderr from dnf repoquery") <*> (RepoSource <$> switchWith 'K' "koji" "Use Koji buildroot" <*> (flagLongWith' ChanDevel "devel-channel" "Use eln development compose" <|> @@ -59,16 +61,16 @@ releaseM :: ReadM Release releaseM = maybeReader readRelease -runMain :: Arch -> Verbosity -> RepoSource -> [Arch] -> Bool -> Bool +runMain :: Arch -> Bool -> Verbosity -> RepoSource -> [Arch] -> Bool -> Bool -> Command -> IO () -runMain sysarch verbose reposource archs testing debug command = do +runMain sysarch dnf4 verbose reposource archs testing debug command = do case command of CacheSize -> cacheSize CacheEmpties -> cleanEmptyCaches - List -> listVersionsCmd debug verbose reposource sysarch + List -> listVersionsCmd Query release args -> do if null args then if null archs then showReleaseCmd debug reposource release sysarch Nothing testing else forM_ archs $ \arch -> showReleaseCmd debug reposource release sysarch (Just arch) testing - else repoqueryCmd debug verbose release reposource sysarch archs testing args + else repoqueryCmd dnf4 debug verbose release reposource sysarch archs testing args diff --git a/src/Query.hs b/src/Query.hs --- a/src/Query.hs +++ b/src/Query.hs @@ -1,48 +1,34 @@ -{-# LANGUAGE CPP, OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} module Query ( - getFedoraServer, repoqueryCmd, - showReleaseCmd, - downloadServer, - fedoraTop ) where import Control.Monad.Extra -import qualified Data.ByteString.Char8 as B import qualified Data.List.Extra as L -import Data.Maybe -#if !MIN_VERSION_base(4,11,0) -import Data.Monoid ((<>)) -#endif -import Data.Time.LocalTime (utcToLocalZonedTime) -import Fedora.Bodhi -import Network.HTTP.Directory -import SimpleCmd -import System.Cached.JSON +import Data.Maybe (isJust, fromMaybe) +import SimpleCmd (cmdLines) import System.Directory (doesFileExist, findExecutable) import System.FilePath (takeBaseName) -import Text.Regex -#if !MIN_VERSION_simple_cmd(0,2,0) +import Arch import Common (warning) -#endif +import ShowRelease (showRelease) import Types -import URL - -showReleaseCmd :: Bool -> RepoSource -> Release -> Arch -> Maybe Arch -> Bool - -> IO () -showReleaseCmd debug reposource release sysarch march testing = - void $ showRelease debug Normal False reposource release sysarch march testing +import URL (URL, renderUrl) -- FIXME --no-redirect? -repoqueryCmd :: Bool -> Verbosity -> Release -> RepoSource -> Arch +-- FIXME error if no testing repo +repoqueryCmd :: Bool -> Bool -> Verbosity -> Release -> RepoSource -> Arch -> [Arch] -> Bool -> [String] -> IO () -repoqueryCmd debug verbose release reposource sysarch archs testing args = do +repoqueryCmd dnf4 debug verbose release reposource sysarch archs testing args = do forM_ (if null archs then [sysarch] else archs) $ \arch -> do repoConfigs <- showRelease debug verbose True reposource release sysarch (Just arch) testing - let qfAllowed = not $ any (`elem` ["-i","--info","-l","--list","-s","--source","--nvr","--nevra","--envra","-qf","--queryformat", "--changelog", "--provides"]) args - mdnf5 <- findExecutable "dnf5" + let qfAllowed = not $ any (`elem` ["-i","--info","-l","--list","-s","--source","--nvr","--nevra","--envra","-qf","--queryformat", "--changelog", "--provides", "--requires"]) args + -- dnf5 writes repo update output to stdout + -- https://github.com/rpm-software-management/dnf5/issues/1361 + -- but seems to cache better + mdnf5 <- if dnf4 then return Nothing else findExecutable "dnf5" let queryformat = "%{name}-%{version}-%{release}.%{arch} (%{repoid})" ++ if isJust mdnf5 then "\n" else "" @@ -57,7 +43,8 @@ ["--setopt=module_platform_id=platform:" ++ show release] ++ concatMap renderRepoConfig repoConfigs ++ args - let dnf = fromMaybe "/usr/bin/dnf" mdnf5 + -- FIXME drop "/usr/bin/"? + let dnf = fromMaybe "/usr/bin/dnf-3" mdnf5 when debug $ warning $ unwords $ ('\n' : takeBaseName dnf) : map show cmdargs res <- cmdLines dnf cmdargs @@ -65,210 +52,6 @@ unless (verbose == Quiet) $ warning "" putStrLn $ L.intercalate "\n" res --- majorVersion :: Release -> String --- majorVersion (Fedora n) = show n --- majorVersion Rawhide = "rawhide" - -repoVersion :: Release -> String -> String -repoVersion Rawhide _ = "fedora-rawhide" -repoVersion release repo = - show release ++ - case release of - Centos _ -> '-':repo - ELN -> '-':repo - EPEL _ -> if repo == "epel-testing" then "-testing" else "" - Fedora _ | repo /= "releases" -> '-':repo - _ -> "" - -repoConfigArgs :: RepoSource -> Arch -> Maybe Arch -> Release -> (String,URL) - -> (String,(URL,[String])) --- non-koji -repoConfigArgs (RepoSource False _chan mirror) sysarch march release (repo,url) = - let arch = fromMaybe sysarch march - archsuffix = if arch == sysarch then "" else "-" ++ showArch arch - reponame = repoVersion release repo ++ archsuffix ++ - case mirror of - DownloadFpo -> "" - Mirror serv -> - '-' : takeWhile (/= '/') (subRegex (mkRegex "https?://") serv "") - DlFpo -> "-dl.fpo" - path = - case release of - Centos _ -> [repo, showArch arch] ++ (if arch == Source then ["tree"] else ["os"]) - ELN -> [repo, showArch arch] ++ (if arch == Source then ["tree"] else ["os"]) - EPEL n -> (if n >= 7 then ("Everything" :) else id) [showArch arch] - EPELNext _n -> ["Everything", showArch arch] - Fedora _ -> ["Everything", showArch arch] ++ (if arch == Source then ["tree"] else ["os" | repo `elem` ["releases","development"]]) - Rawhide -> ["Everything", showArch arch, if arch == Source then "tree" else "os"] - in (reponame, (url, path ++ ["/"])) --- koji -repoConfigArgs (RepoSource True _chan _mirror) sysarch march release (repo,url) = - let (compose,path) = - case release of - Rawhide -> (["repos", show release, "latest"],"") - _ -> (["repos", show release ++ "-build/latest"],"") - arch = fromMaybe sysarch march - reponame = repo ++ "-" ++ show release ++ "-build" ++ - if arch == sysarch then "" else "-" ++ showArch arch - in (reponame, (url +//+ compose, [path, showArch arch, ""])) --- repoConfigArgs url (RepoCentosStream chan) arch release repo = --- let (compose,path) = (["composes", channel chan, "latest-CentOS-Stream", "compose"], repo) --- reponame = repo ++ "-Centos-" ++ show release ++ "-Stream" ++ "-" ++ show chan ++ if arch == sysarch then "" else "-" ++ showArch arch --- in (reponame, (url +//+ compose, [path, showArch arch, "os/"])) - renderRepoConfig :: (String, URL) -> [String] renderRepoConfig (name, url) = - ["--repofrompath", name ++ "," ++ renderUrl url, "--repo", name] - -showRelease :: Bool -> Verbosity -> Bool -> RepoSource -> Release -> Arch - -> Maybe Arch -> Bool -> IO [(String, URL)] -showRelease debug verbose warn reposource@(RepoSource koji _chan _mirror) release sysarch march testing = do - mgr <- httpManager - let arch = fromMaybe sysarch march - (url,path) <- getURL debug mgr reposource release arch - let urlpath = url +//+ path - when debug $ putStrLn $ renderUrl urlpath - repos <- - case release of - -- RepoKoji -> ["koji-fedora"] - Centos n -> return [("BaseOS",urlpath), - ("AppStream",url), - (if n >= 9 then "CRB" else "PowerTools",url)] - ELN -> return [("BaseOS",urlpath), - ("AppStream",urlpath), - ("CRB",urlpath)] - Rawhide -> return [("development", urlpath)] - Fedora n -> do - pending <- pendingFedoraRelease n - return $ - if pending - then [("development", urlpath)] - else ("releases", urlpath) : - ("updates", url +//+ ["updates",show n]) : - [("updates-testing", url +//+ ["updates","testing",show n]) | testing] - EPEL n -> return $ - ("epel",urlpath) : - [("epel-testing",url +//+ ["testing", show n]) | testing] - EPELNext _n -> return [("epelnext",urlpath)] - forM repos $ \repourl -> do - let (reponame,(url',path')) = repoConfigArgs reposource sysarch march release repourl - baserepo = url' +//+ path' - when debug $ do - putStrLn $ renderUrl baserepo - ok <- httpExists mgr $ trailingSlash $ renderUrl baserepo - if ok - then do - unless (verbose == Quiet) $ do - mtime <- do - let composeinfo = - if koji - then url' +//+ ["repo.json"] - else - case release of - Centos 10 -> url' +//+ ["metadata","composeinfo.json"] - Centos _ -> url' +//+ ["COMPOSE_ID"] -- ["metadata","composeinfo.json"] - ELN -> url' +//+ ["metadata","composeinfo.json"] - EPEL _ -> url' +//+ ["Everything", "state"] - EPELNext _ -> url' +//+ ["Everything", "state"] - Fedora _ -> url' +//+ - if "updates" `L.isSuffixOf` reponame || - "updates-testing" `L.isSuffixOf` reponame - then ["Everything", "state"] - else ["COMPOSE_ID"] - Rawhide -> url' +//+ ["COMPOSE_ID"] - when debug $ putStrLn $ renderUrl composeinfo - exists <- httpExists mgr (renderUrl composeinfo) - if exists - then httpLastModified mgr (renderUrl composeinfo) - else return Nothing - whenJust mtime $ \utc -> do - date <- utcToLocalZonedTime utc - (if warn then warning else putStrLn) $ show date ++ " <" ++ renderUrl url' ++ ">" - return (reponame, url' +//+ path') - else - error' $ renderUrl baserepo ++ " not found" - -downloadServer :: String -downloadServer = "https://download.fedoraproject.org/pub" - -fedoraTop :: Arch -> [String] -fedoraTop arch = - -- FIXME support older archs - if arch `elem` [PPC64LE, S390X] - then ["fedora-secondary"] - else ["fedora", "linux"] - -epelTop :: [String] -epelTop = ["epel"] - -getURL :: Bool -> Manager -> RepoSource -> Release -> Arch -> IO (URL,[String]) -getURL debug mgr reposource@(RepoSource koji chan _mirror) release arch = - case release of - Centos n -> - case n of - 10 -> - let url = URL $ - if koji - then "https://odcs.stream.centos.org/stream-10" - else "https://composes.stream.centos.org/stream-10/production/latest-CentOS-Stream/compose/" - in return (url,[]) - 9 -> - let url = URL $ - if koji - then "https://odcs.stream.centos.org" - else "https://mirror.stream.centos.org/9-stream/" - in return (url,[]) - 8 -> return (URL "http://mirror.centos.org/centos/8-stream/", []) - _ -> error' "old Centos is not supported yet" - ELN -> - return (URL "https://odcs.fedoraproject.org/composes", [channel chan, "latest-Fedora-ELN", "compose"]) - EPEL n | n < 7 -> - return - (URL "https://archives.fedoraproject.org/pub/archive/epel", [show n]) - EPEL n -> getFedoraServer debug mgr reposource epelTop [show n] - EPELNext n -> getFedoraServer debug mgr reposource (epelTop ++ ["next"]) [show n] - -- FIXME hardcoded - Fedora n | n < 37 -> - return - (URL "https://archives.fedoraproject.org/pub/archive" +//+ fedoraTop arch, ["releases", show n]) - -- FIXME handle rawhide version - Fedora n -> do - pending <- pendingFedoraRelease n - getFedoraServer debug mgr reposource (fedoraTop arch) - [if pending then "development" else "releases", show n] - Rawhide -> getFedoraServer debug mgr reposource (fedoraTop arch) ["development", "rawhide"] - -pendingFedoraRelease :: Natural -> IO Bool -pendingFedoraRelease n = do - pending <- mapMaybe (lookupKey "branch") <$> getCachedJSONQuery "fedora-bodhi-releases-pending" "fedora-bodhi-releases-pending" (bodhiReleases (makeKey "state" "pending")) 1000 - return $ show (Fedora n) `elem` pending - -getFedoraServer :: Bool -> Manager -> RepoSource -> [String] -> [String] - -> IO (URL,[String]) -getFedoraServer debug mgr (RepoSource koji _ mirror) top path = - if koji - then return (URL "https://kojipkgs.fedoraproject.org",[]) - else - case mirror of - DownloadFpo -> do - let url = URL downloadServer +//+ top ++ path - rurl = renderUrl url - redir <- httpRedirect mgr rurl - case redir of - Nothing -> do - warning $ "no redirect for" +-+ rurl - return (URL downloadServer +//+ top,path) - Just actual -> do - let actual' = - case B.stripPrefix "https://ftp.yzyu.jp/" actual of - Nothing -> actual - Just rest -> "https://ftp.yz.yamagata-u.ac.jp/" <> rest - when debug $ do - warning rurl - warning $ "redirected to" +-+ show actual - when (actual /= actual') $ - warning $ "replacing" +-+ B.unpack actual - return (URL $ removeSubpath path $ B.unpack actual', path) - -- FIXME how to handle any path - Mirror serv -> return (URL serv,path) - DlFpo -> return (URL "https://dl.fedoraproject.org/pub" +//+ top, path) + ["--repofrompath=" ++ name ++ "," ++ renderUrl url, "--repo=" ++ name, "--setopt=" ++ name ++ ".metadata_expire=6h" ] diff --git a/src/ShowRelease.hs b/src/ShowRelease.hs new file mode 100644 --- /dev/null +++ b/src/ShowRelease.hs @@ -0,0 +1,232 @@ +{-# LANGUAGE OverloadedStrings #-} + +module ShowRelease ( + showReleaseCmd, + showRelease, + activeFedoraReleases, + BodhiRelease(..), + downloadServer + ) +where + +import Control.Monad.Extra (forM_, unless, void, when, whenJust) +import qualified Data.ByteString.Char8 as B +import Data.List.Extra +import Data.Maybe (fromMaybe) +import Data.Time.LocalTime (utcToLocalZonedTime) +import Network.HTTP.Directory (httpExists, httpLastModified,httpManager, + httpRedirect, Manager, trailingSlash) +import SimpleCmd (error', (+-+)) +import Text.Regex (mkRegex, subRegex) + +import Arch +import BodhiRelease +import Common (warning) +import Types +import URL + +showReleaseCmd :: Bool -> RepoSource -> Release -> Arch -> Maybe Arch -> Bool + -> IO () +showReleaseCmd debug reposource release sysarch march testing = + void $ showRelease debug Normal False reposource release sysarch march testing + +showRelease :: Bool -> Verbosity -> Bool -> RepoSource -> Release -> Arch + -> Maybe Arch -> Bool -> IO [(String, URL)] +showRelease debug verbose warn reposource@(RepoSource koji _chan _mirror) release sysarch march testing = do + mgr <- httpManager + let arch = fromMaybe sysarch march + (url,path) <- getURL debug mgr reposource release arch + let urlpath = url +//+ path + when debug $ print $ renderUrl urlpath + (basicrepos,morerepos) <- + case release of + -- RepoKoji -> ["koji-fedora"] + Centos n -> return ([("BaseOS",urlpath)], + [("AppStream",url),(if n >= 9 then "CRB" else "PowerTools",url)]) + ELN -> return ([("BaseOS",urlpath)], + [("AppStream",urlpath),("CRB",urlpath)]) + Rawhide -> return ([("development", urlpath)],[]) + Fedora n -> do + pending <- pendingFedoraRelease n + return $ + if pending + then ([("development", urlpath)],[]) + else (("releases", urlpath) : + ("updates", url +//+ ["updates",show n]) : + [("updates-testing", url +//+ ["updates","testing",show n]) | testing], + []) + EPEL n -> return + (("epel",urlpath) : + [("epel-testing",url +//+ ["testing", show n]) | testing], + []) + EPELNext _n -> return ([("epelnext",urlpath)],[]) + let basicrepourls = + map (repoConfigArgs reposource sysarch march release) basicrepos + morerepourls = + map (repoConfigArgs reposource sysarch march release) morerepos + forM_ basicrepourls $ \(reponame,(url',path')) -> do + let baserepo = url' +//+ path' + when debug $ print $ renderUrl baserepo + ok <- httpExists mgr $ trailingSlash $ renderUrl baserepo + if ok + then do + unless (verbose == Quiet) $ do + mtime <- do + let composeinfo = + if koji + then url' +//+ ["repo.json"] + else + case release of + Centos 10 -> url' +//+ ["metadata","composeinfo.json"] + Centos _ -> url' +//+ ["COMPOSE_ID"] -- ["metadata","composeinfo.json"] + ELN -> url' +//+ ["metadata","composeinfo.json"] + EPEL _ -> url' +//+ ["Everything", "state"] + EPELNext _ -> url' +//+ ["Everything", "state"] + Fedora _ -> url' +//+ + if "updates" `isSuffixOf` reponame || + "updates-testing" `isSuffixOf` reponame + then ["Everything", "state"] + else ["COMPOSE_ID"] + Rawhide -> url' +//+ ["COMPOSE_ID"] + when debug $ print $ renderUrl composeinfo + exists <- httpExists mgr (renderUrl composeinfo) + if exists + then httpLastModified mgr (renderUrl composeinfo) + else return Nothing + whenJust mtime $ \utc -> do + date <- utcToLocalZonedTime utc + (if warn then warning else putStrLn) $ show date +-+ "<" ++ renderUrl url' ++ ">" + else + error' $ renderUrl baserepo +-+ "not found" + return $ map (fmap (uncurry (+//+))) $ basicrepourls ++ morerepourls + +getURL :: Bool -> Manager -> RepoSource -> Release -> Arch -> IO (URL,[String]) +getURL debug mgr reposource@(RepoSource koji chan _mirror) release arch = + case release of + Centos n -> + case n of + 10 -> + let url = URL $ + if koji + then "https://odcs.stream.centos.org/stream-10" + else "https://composes.stream.centos.org/stream-10/production/latest-CentOS-Stream/compose/" + in return (url,[]) + 9 -> + let url = URL $ + if koji + then "https://odcs.stream.centos.org" + else "https://mirror.stream.centos.org/9-stream/" + in return (url,[]) + 8 -> return (URL "http://mirror.centos.org/centos/8-stream/", []) + _ -> error' "old Centos is not supported yet" + ELN -> + return (URL "https://odcs.fedoraproject.org/composes", [channel chan, "latest-Fedora-ELN", "compose"]) + EPEL n | n < 7 -> + return + (URL "https://archives.fedoraproject.org/pub/archive/epel", [show n]) + EPEL n -> getFedoraServer debug mgr reposource ["epel"] [show n] + EPELNext n -> getFedoraServer debug mgr reposource ["epel","next"] [show n] + Fedora n -> do + ebodhirelease <- activeFedoraRelease n + case ebodhirelease of + Left oldest -> + if n < oldest + then + return + (URL "https://archives.fedoraproject.org/pub/archive" +//+ fedoraTop, ["releases", show n]) + else error' $ "unknown fedora release:" +-+ show n + Right rel -> + let pending = releaseState rel == "pending" + rawhide = pending && releaseBranch rel == "rawhide" + releasestr = if rawhide then "rawhide" else show n + in getFedoraServer debug mgr reposource fedoraTop + [if pending then "development" else "releases", releasestr] + Rawhide -> getFedoraServer debug mgr reposource fedoraTop ["development", "rawhide"] + where + fedoraTop = + -- FIXME support older archs + if arch `elem` [PPC64LE, S390X] + then ["fedora-secondary"] + else ["fedora", "linux"] + +repoConfigArgs :: RepoSource -> Arch -> Maybe Arch -> Release -> (String,URL) + -> (String,(URL,[String])) +-- non-koji +repoConfigArgs (RepoSource False _chan mirror) sysarch march release (repo,url) = + let arch = fromMaybe sysarch march + archsuffix = if arch == sysarch then "" else "-" ++ showArch arch + reponame = repoVersion ++ archsuffix ++ + case mirror of + DownloadFpo -> "" + Mirror serv -> + '-' : takeWhile (/= '/') (subRegex (mkRegex "https?://") serv "") + DlFpo -> "-dl.fpo" + path = + case release of + Centos _ -> [repo, showArch arch] ++ (if arch == Source then ["tree"] else ["os"]) + ELN -> [repo, showArch arch] ++ (if arch == Source then ["tree"] else ["os"]) + EPEL n -> (if n >= 7 then ("Everything" :) else id) [showArch arch] + EPELNext _n -> ["Everything", showArch arch] + Fedora _ -> ["Everything", showArch arch] ++ (if arch == Source then ["tree"] else ["os" | repo `elem` ["releases","development"]]) + Rawhide -> ["Everything", showArch arch, if arch == Source then "tree" else "os"] + in (reponame, (url, path ++ ["/"])) + where + repoVersion :: String + repoVersion = + if release == Rawhide + then "fedora-rawhide" + else + show release ++ + case release of + Centos _ -> '-':repo + ELN -> '-':repo + EPEL _ -> if repo == "epel-testing" then "-testing" else "" + Fedora _ | repo /= "releases" -> '-':repo + _ -> "" +-- koji +repoConfigArgs (RepoSource True _chan _mirror) sysarch march release (repo,url) = + let (compose,path) = + case release of + Rawhide -> (["repos", show release, "latest"],"") + _ -> (["repos", show release ++ "-build/latest"],"") + arch = fromMaybe sysarch march + reponame = repo ++ "-" ++ show release ++ "-build" ++ + if arch == sysarch then "" else "-" ++ showArch arch + in (reponame, (url +//+ compose, [path, showArch arch, ""])) +-- repoConfigArgs url (RepoCentosStream chan) arch release repo = +-- let (compose,path) = (["composes", channel chan, "latest-CentOS-Stream", "compose"], repo) +-- reponame = repo ++ "-Centos-" ++ show release ++ "-Stream" ++ "-" ++ show chan ++ if arch == sysarch then "" else "-" ++ showArch arch +-- in (reponame, (url +//+ compose, [path, showArch arch, "os/"])) + +getFedoraServer :: Bool -> Manager -> RepoSource -> [String] -> [String] + -> IO (URL,[String]) +getFedoraServer debug mgr (RepoSource koji _ mirror) top path = + if koji + then return (URL "https://kojipkgs.fedoraproject.org",[]) + else + case mirror of + DownloadFpo -> do + let url = URL downloadServer +//+ top ++ path + rurl = renderUrl url + redir <- fmap B.unpack <$> httpRedirect mgr rurl + case redir of + Nothing -> do + warning $ "no redirect for" +-+ rurl + return (URL downloadServer +//+ top,path) + Just actual -> do + when debug $ do + warning rurl + warning $ "redirected to" +-+ show actual + let actualstr = + if "https://ftp.yzyu.jp/" `isPrefixOf` actual + then replace "https://" "http://" actual + else actual + when (actual /= actualstr) $ + warning $ "replacing to" +-+ actualstr + return (URL $ removeSubpath path actualstr, path) + -- FIXME how to handle any path + Mirror serv -> return (URL serv,path) + DlFpo -> return (URL "https://dl.fedoraproject.org/pub" +//+ top, path) + +downloadServer :: String +downloadServer = "https://download.fedoraproject.org/pub" diff --git a/src/Types.hs b/src/Types.hs --- a/src/Types.hs +++ b/src/Types.hs @@ -1,11 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module Types ( - Arch(..), - allArchs, - eitherArch, - readArch, - showArch, Mirror(..), Natural, RepoSource(..), @@ -17,56 +12,17 @@ ) where import Data.Char (isDigit) -import Data.List.Extra import Numeric.Natural -import SimpleCmd (error') --import Distribution.Fedora.Repoquery data Verbosity = Quiet | Normal | Verbose deriving Eq -data Arch = Source - | X86_64 - | AARCH64 - | ARMV7HL - | PPC64LE - | S390X - | I386 - deriving Eq - -allArchs :: [Arch] -allArchs = [X86_64, AARCH64, PPC64LE, S390X] - -eitherArch :: String -> Either String Arch -eitherArch s = - case lower s of - "source" -> Right Source - "x86_64" -> Right X86_64 - "aarch64" -> Right AARCH64 - "armv7hl" -> Right ARMV7HL - "s390x" -> Right S390X - "ppc64le" -> Right PPC64LE - "i386" -> Right I386 - _ -> Left $ "unknown arch: " ++ s - -readArch :: String -> Arch -readArch = - either error' id . eitherArch - -showArch :: Arch -> String -showArch Source = "source" -showArch X86_64 = "x86_64" -showArch AARCH64 = "aarch64" -showArch ARMV7HL = "armv7hl" -showArch S390X = "s390x" -showArch PPC64LE = "ppc64le" -showArch I386 = "i386" - data Mirror = DownloadFpo | DlFpo | Mirror String deriving Eq --- True for koji +-- FIXME: True for koji make into type data RepoSource = RepoSource Bool Channel Mirror deriving Eq @@ -86,8 +42,8 @@ data Release = EPEL Natural | EPELNext Natural | Centos Natural | Fedora Natural | ELN | Rawhide deriving (Eq, Ord) -newestRHEL :: Natural -newestRHEL = 10 +elnVersion :: Natural +elnVersion = 11 -- | Read a Release name, otherwise return an error message eitherRelease :: String -> Either String Release @@ -102,7 +58,11 @@ eitherRelease "eln" = Right ELN eitherRelease ('f':ns) | all isDigit ns = let r = read ns in Right (Fedora r) eitherRelease ns | all isDigit ns = let r = read ns in - Right $ (if r <= newestRHEL then Centos else Fedora) r + Right $ + case compare r elnVersion of + LT -> Centos r + EQ -> ELN + GT -> Fedora r eitherRelease cs = Left $ cs ++ " is not a known os release" -- | Read a Fedora Release name diff --git a/test/tests.hs b/test/tests.hs --- a/test/tests.hs +++ b/test/tests.hs @@ -16,17 +16,27 @@ else putStrLn out unless ok $ error' "failed" +-- copied from dl-fedora +branched :: Int +branched = 40 +current, previous, prevprev, rawhide :: String +current = show branched +previous = show (branched - 1) +prevprev = show (branched - 2) +rawhide = show (branched + 1) + tests :: [([String],Maybe String)] tests = [(["rawhide"], Nothing) - ,(["40"], Nothing) - ,(["39"], Nothing) - ,(["38"], Nothing) + ,([current], Nothing) + ,([previous], Nothing) + ,([prevprev], Nothing) ,(["rawhide"], Just "coreutils") - ,(["40"], Just "gtk4") - ,(["39"], Just "bash") - ,(["38"], Just "fontconfig") - ,(["-t", "39"], Just "podman") + ,([rawhide], Just "coreutils") + ,([current], Just "gtk4") + ,([previous], Just "bash") + ,([prevprev], Just "fontconfig") + ,(["-t", previous], Just "podman") ,(["eln"], Just "ibus") ,(["epel9"], Just "ghc") ,(["c10"], Just "bash")