fedora-repoquery 0.3.2 → 0.4
raw patch · 11 files changed
+467/−340 lines, 11 filesdep −text
Dependencies removed: text
Files
- ChangeLog.md +9/−0
- README.md +46/−10
- fedora-repoquery.cabal +7/−3
- src/Arch.hs +52/−0
- src/BodhiRelease.hs +55/−0
- src/List.hs +9/−25
- src/Main.hs +15/−13
- src/Query.hs +17/−234
- src/ShowRelease.hs +232/−0
- src/Types.hs +8/−48
- test/tests.hs +17/−7
ChangeLog.md view
@@ -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
README.md view
@@ -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 <https://mirror.freedif.org/fedora/fedora/linux/development/rawhide>++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.
fedora-repoquery.cabal view
@@ -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 <juhpetersen@gmail.com>@@ -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
+ src/Arch.hs view
@@ -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}"]
+ src/BodhiRelease.hs view
@@ -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"
src/List.hs view
@@ -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
src/Main.hs view
@@ -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
src/Query.hs view
@@ -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" ]
+ src/ShowRelease.hs view
@@ -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"
src/Types.hs view
@@ -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
test/tests.hs view
@@ -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")