fedora-repoquery 0.7 → 0.7.1
raw patch · 11 files changed
+348/−297 lines, 11 files
Files
- ChangeLog.md +8/−0
- README.md +32/−18
- fedora-repoquery.cabal +2/−2
- src/BodhiRelease.hs +21/−8
- src/List.hs +2/−2
- src/Main.hs +2/−2
- src/Query.hs +2/−2
- src/Release.hs +254/−0
- src/ShowRelease.hs +0/−244
- src/Types.hs +23/−18
- test/tests.hs +2/−1
ChangeLog.md view
@@ -1,5 +1,13 @@ # Revision history for fedora-repoquery +## 0.7.1 (2024-09-08)+- fix for branched: "frozen" state is still in development/ like "pending"+- enable updates-testing for fedora branched from Beta freeze+- help: can use -- for system repoquery+- only output "slow redirection" for debug+- refactor eitherRelease with lower case+- curl connection: timeout for Location redirect but not Last-Modified+ ## 0.7 (2024-07-18) - use curl library for HTTP instead of http-directory - rename the executable back to fedora-repoquery to avoid confusion with fedrq
README.md view
@@ -10,7 +10,7 @@ `$ fedora-repoquery rawhide firefox` ```-firefox-128.0-2.fc41.x86_64 (fedora-rawhide)+firefox-130.0-1.fc42.x86_64 (fedora-rawhide) ``` `$ fedora-repoquery 40 --requires filesystem`@@ -34,7 +34,7 @@ `$ fedora-repoquery eln kernel` ```-kernel-6.11.0-0.rc0.20240716gitd67978318827.2.eln141.x86_64 (eln-BaseOS)+kernel-6.11.0-0.rc6.20240906gitb831f83e40a2.53.eln142.x86_64 (eln-BaseOS) ``` Without a release argument, the system yum repo configuration is used:@@ -42,9 +42,21 @@ `$ fedora-repoquery pandoc` ```-pandoc-3.1.3-29.fc41.x86_64 (rawhide)+pandoc-3.1.11.1-32.fc41.x86_64 (rawhide) ```+but then currently you have to insert `--` before a query option: +`$ fedora-repoquery -- --whatrequires pandoc`++```+R-reprex-2.0.2-12.fc41.noarch (rawhide)+R-rmarkdown-2.24-5.fc41.noarch (rawhide)+pandoc-pdf-3.1.11.1-32.fc41.x86_64 (rawhide)+python3-nb2plots-0.7.2-5.fc41.noarch (rawhide)+python3-pypandoc-1.13-6.fc41.noarch (rawhide)+rstudio-common-2024.04.2+764-3.fc41.x86_64 (rawhide)+```+ Use the --time (-T) option to display repo timestamps: ``` $ fedora-repoquery -T 41 fedrq@@ -60,16 +72,18 @@ ``` 2024-04-20 02:22:34 +08 <https://mirror.freedif.org/fedora/fedora/linux/releases/40/>-2024-07-18 12:15:13 +08 <https://mirror.freedif.org/fedora/fedora/linux/updates/40/>+2024-09-07 09:37:56 +08 <https://mirror.freedif.org/fedora/fedora/linux/updates/40/> ``` One can also query multiple releases (or arch's):+ `$ fedora-repoquery 40 41 python3 | grep x86_64` ``` python3-3.12.2-2.fc40.x86_64 (f40)-python3-3.12.4-1.fc40.x86_64 (f40-updates)-python3-3.13.0~b3-2.fc41.x86_64 (fedora-rawhide)+python3-3.12.5-2.fc40.x86_64 (f40-updates)+python3-3.13.0~rc1-2.fc41.x86_64 (f41-development)+python3-3.13.0~rc1-3.fc41.x86_64 (f41-updates-testing) ``` @@ -77,7 +91,7 @@ `$ fedora-repoquery --version` ```-0.7+0.7.1 ``` `$ fedora-repoquery --help`@@ -85,15 +99,15 @@ ``` fedora-repoquery tool for querying Fedora repos for packages. -Usage: fedora-repoquery [--version] [-4|--dnf4] [(-q|--quiet) | (-v|--verbose)] - [--dynamic] [-T|--time] [-K|--koji] - [--devel-channel | --test-channel] - [(-m|--mirror URL) | (-D|--dl)] - [(-s|--source) | (-A|--all-archs) | [-a|--arch ARCH]] - [-t|--testing] [-d|--debug] - ((-z|--cache-size) | (-e|--cache-clean-empty) | - (-l|--list) | - [RELEASE]... [REPOQUERY_OPTS]... [PACKAGE]...)+Usage: fedora-repoquery [--version] [-4|--dnf4] [(-q|--quiet) | (-v|--verbose)]+ [--dynamic] [-T|--time] [-K|--koji]+ [--devel-channel | --test-channel]+ [(-m|--mirror URL) | (-D|--dl)]+ [(-s|--source) | (-A|--all-archs) | [-a|--arch ARCH]]+ [-t|--testing] [-d|--debug]+ ((-z|--cache-size) | (-e|--cache-clean-empty) |+ (-l|--list) |+ [RELEASE|--]... [REPOQUERY_OPTS]... [PACKAGE]...) where RELEASE is {fN or N (fedora), 'rawhide', epelN, epelN-next, cN (centos stream), 'eln'}, with N the release version number.@@ -125,8 +139,8 @@ The default arch is the system arch. ## Installation-fedora-repoquery can be installed from-[copr](https://copr.fedorainfracloud.org/coprs/petersen/fedora-repoquery/)+fedora-repoquery is available in Fedora and EPEL 9:+<https://src.fedoraproject.org/rpms/fedora-repoquery>. ## Building from source Use `stack install fedora-repoquery` or `cabal install fedora-repoquery`
fedora-repoquery.cabal view
@@ -1,5 +1,5 @@ name: fedora-repoquery-version: 0.7+version: 0.7.1 synopsis: Fedora release repos package query tool description: A CLI tool for repoquerying Fedora and Centos Stream release packages:@@ -40,7 +40,7 @@ Common List Query- ShowRelease+ Release Types URL hs-source-dirs: src
src/BodhiRelease.hs view
@@ -4,8 +4,9 @@ BodhiRelease (..), activeFedoraRelease, activeFedoraReleases,- pendingFedoraRelease,- rawhideFedoraRelease+ fedoraReleaseState,+ rawhideFedoraRelease,+ fedoraReleasePostBeta ) where @@ -21,7 +22,8 @@ data BodhiRelease = Release {releaseVersion :: String, -- to handle eln releaseState :: String,- releaseBranch :: String}+ releaseBranch :: String,+ releasePostBeta :: Bool} deriving Eq -- Left is oldest active version@@ -43,18 +45,29 @@ version <- lookupKey "version" obj state <- lookupKey "state" obj branch <- lookupKey "branch" obj- return $ Release version state branch+ let setting = lookupKey "setting_status" obj+ return $+ Release version state branch $+ setting == Just ("post_beta" :: String) -pendingFedoraRelease :: Natural -> IO Bool-pendingFedoraRelease n = do+fedoraReleaseState :: Natural -> IO String+fedoraReleaseState n = do eactive <- activeFedoraRelease n return $ case eactive of- Left _ -> False- Right rel -> releaseState rel == "pending"+ Left _ -> error' $ "could find F" ++ show n ++ " release (state)"+ Right rel -> releaseState rel rawhideFedoraRelease :: IO Natural rawhideFedoraRelease = do actives <- activeFedoraReleases let pending = map releaseVersion (filter (\r -> releaseState r == "pending") actives) return $ read $ maximum (L.delete "eln" pending)++fedoraReleasePostBeta :: Natural -> IO Bool+fedoraReleasePostBeta n = do+ eactive <- activeFedoraRelease n+ return $+ case eactive of+ Left _ -> error' $ "could find F" ++ show n ++ " release (setting)"+ Right rel -> releasePostBeta rel
src/List.hs view
@@ -5,11 +5,11 @@ import Data.List.Extra import SimpleCmd ((+-+)) -import ShowRelease (activeFedoraReleases, BodhiRelease(..))+import Release (activeFedoraReleases, BodhiRelease(..)) listVersionsCmd :: IO () listVersionsCmd = activeFedoraReleases >>= mapM_ printRelease . sortOn releaseState where- printRelease (Release _version state branch) =+ printRelease (Release _version state branch _postbeta) = putStrLn $ branch +-+ state
src/Main.hs view
@@ -28,7 +28,7 @@ import List (listVersionsCmd) import Paths_fedora_repoquery (version) import Query (repoqueryCmd)-import ShowRelease (showReleaseCmd, downloadServer)+import Release (showReleaseCmd, downloadServer) import Types (Channel(..), Mirror(..), Release (System), RepoSource(..), Verbosity(..), eitherRelease) @@ -61,7 +61,7 @@ <*> (flagWith' CacheSize 'z' "cache-size" "Show total dnf repo metadata cache disksize" <|> flagWith' CacheEmpties 'e' "cache-clean-empty" "Remove empty dnf caches" <|> flagWith' List 'l' "list" "List Fedora versions"- <|> Query <$> some (strArg "[RELEASE]... [REPOQUERY_OPTS]... [PACKAGE]..."))+ <|> Query <$> some (strArg "[RELEASE|--]... [REPOQUERY_OPTS]... [PACKAGE]...")) runMain :: Arch -> Bool -> Verbosity -> Bool -> Bool -> RepoSource -> [Arch] -> Bool -> Bool -> Command -> IO ()
src/Query.hs view
@@ -15,7 +15,7 @@ import Arch import Common (warning)-import ShowRelease (showRelease)+import Release (getRelease) import Types import URL (FileDir(Dir), URL, renderUrl) @@ -44,7 +44,7 @@ repoConfigs <- if release == System then return []- else showRelease debug dynredir True checkdate reposource release sysarch (Just arch) testing+ else getRelease debug dynredir True checkdate reposource release sysarch (Just arch) testing let qfAllowed = not $ any (`elem` ["-i","--info","-l","--list","-s","--source","--nvr","--nevra","--envra","--qf","--queryformat", "--changelog"] ++ pkgAttrsOptions) args -- dnf5 writes repo update output to stdout -- https://github.com/rpm-software-management/dnf5/issues/1361
+ src/Release.hs view
@@ -0,0 +1,254 @@+{-# LANGUAGE CPP, OverloadedStrings #-}++module Release (+ showReleaseCmd,+ getRelease,+ activeFedoraReleases,+ BodhiRelease(..),+ downloadServer+ )+where++import Control.Monad.Extra (forM_, unless, void, when, whenJust)+import Data.Bifunctor (first)+import qualified Data.CaseInsensitive as CI+import Data.List.Extra+import Data.Maybe (fromMaybe)+import Data.Time.Format (defaultTimeLocale, parseTimeM, rfc822DateFormat)+import Data.Time.LocalTime (utcToLocalZonedTime)+import Network.Curl (curlHead, CurlOption(..))+import SimpleCmd (error', (+-+))+import Text.Regex (mkRegex, subRegex)++import Arch+import BodhiRelease+import Common (warning)+import Types+import URL++showReleaseCmd :: Bool -> Bool -> RepoSource -> Release -> Arch -> Maybe Arch+ -> Bool -> IO ()+showReleaseCmd debug dynredir reposource release sysarch march testing =+ void $ getRelease debug dynredir False True reposource release sysarch march testing++getRelease :: Bool -> Bool -> Bool -> Bool -> RepoSource+ -> Release -> Arch -> Maybe Arch -> Bool -> IO [(String, URL)]+getRelease debug dynredir warn checkdate reposource@(RepoSource koji _chan _mirror) release sysarch march testing = do+ let arch = fromMaybe sysarch march+ (url,path) <- getURL debug dynredir reposource release arch+ let urlpath = url +//+ path+ when debug $ print $ renderUrl Dir 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+ state <- fedoraReleaseState n+ postbeta <- fedoraReleasePostBeta n+ return $+ if state `elem` ["pending","frozen"]+ then (("development", urlpath) :+ [("updates", url +//+ ["updates",show n]) | postbeta , state == "frozen"] +++ -- FIXME add way to disable or invert testing+ [("updates-testing", url +//+ ["updates","testing",show n]) | testing || state == "frozen" || postbeta]+ ,[])+ else (("releases", urlpath) :+ ("updates", url +//+ ["updates",show n]) :+ [("updates-testing", url +//+ ["updates","testing",show n]) | testing || postbeta]+ ,[])+ EPEL n -> return+ (("epel",urlpath) :+ [("epel-testing",url +//+ ["testing", show n]) | testing],+ [])+ EPELNext _n -> return ([("epelnext",urlpath)],[])+ System -> error' "showRelease: system unsupported"+ rawhide <- rawhideFedoraRelease+ let basicrepourls =+ map (repoConfigArgs reposource sysarch march rawhide release) basicrepos+ morerepourls =+ map (repoConfigArgs reposource sysarch march rawhide release) morerepos+ forM_ basicrepourls $ \(reponame,(url',path')) -> do+ let baserepo = url' +//+ path'+ when debug $ print $ renderUrl Dir baserepo+ unless (not checkdate || release == System) $ do+ let composeinfo =+ url' +//++ if koji+ then ["repo.json"]+ else+ case release of+ Centos 10 -> ["metadata","composeinfo.json"]+ Centos _ -> ["COMPOSE_ID"] -- ["metadata","composeinfo.json"]+ ELN -> ["metadata","composeinfo.json"]+ EPEL _ -> ["Everything", "state"]+ EPELNext _ -> ["Everything", "state"]+ Fedora _ -> if "updates" `isInfixOf` reponame+ then ["Everything", "state"]+ else ["COMPOSE_ID"]+ Rawhide -> ["COMPOSE_ID"]+ System -> error' "system not supported"+ let composeUrl = renderUrl File composeinfo+ when debug $ print composeUrl+ mtimestr <- curlGetHeader Nothing "Last-Modified" composeUrl+ whenJust mtimestr $ \timestr -> do+ utc <- parseTimeM False defaultTimeLocale rfc822DateFormat timestr+ date <- utcToLocalZonedTime utc+ (if warn then warning else putStrLn) $ show date +-+ "<" ++ renderUrl Dir url' ++ ">"+ return $ map (fmap (uncurry (+//+))) $ basicrepourls ++ morerepourls++getURL :: Bool -> Bool -> RepoSource -> Release -> Arch+ -> IO (URL,[String])+getURL debug dynredir 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://vault.centos.org/8-stream/", [])+ _ -> error' "old Centos is not supported"+ 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 dynredir reposource ["epel"] [show n]+ EPELNext n -> getFedoraServer debug dynredir 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 ->+ -- state values: ["disabled","pending","frozen","current","archived"]+ let pending = releaseState rel /= "current"+ rawhide = pending && releaseBranch rel == "rawhide"+ releasestr = if rawhide then "rawhide" else show n+ in getFedoraServer debug dynredir reposource fedoraTop+ [if pending then "development" else "releases", releasestr]+ Rawhide -> getFedoraServer debug dynredir reposource fedoraTop ["development", "rawhide"]+ System -> error' "getURL: system unsupported"+ where+ fedoraTop =+ -- FIXME support older archs+ if arch `elem` [PPC64LE, S390X]+ then ["fedora-secondary"]+ else ["fedora", "linux"]++repoConfigArgs :: RepoSource -> Arch -> Maybe Arch -> Natural -> Release+ -> (String,URL) -> (String,(URL,[String]))+-- non-koji+repoConfigArgs (RepoSource False _chan mirror) sysarch march rawhide 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 >= 8 then ("Everything" :) else id) [showArch arch] ++ ["tree" | arch == Source]+ 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"]+ System -> error' "repoConfigArgs: system unsupported"+ in (reponame, (url, path ++ ["/"]))+ where+ repoVersion :: String+ repoVersion =+ if release `elem` [Rawhide, Fedora 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 _rawhide 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 -> Bool -> RepoSource -> [String] -> [String]+ -> IO (URL,[String])+getFedoraServer debug dynredir (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 Dir url+ when debug $ print rurl+ redir <-+ if dynredir+ then return Nothing+ else curlGetHeader (Just 3000) "Location" rurl+ when debug $ print redir+ case redir of+ Nothing -> do+ when (debug && not dynredir) $+ warning $ "slow redirection 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"++-- FIXME check CurlCode(CurlOK) status+curlGetHeader :: Maybe Natural -> CI.CI String -> String -> IO (Maybe String)+curlGetHeader mtimeout field url = do+ (_status,headers) <- curlHead url $ maybe [] (singleton . CurlConnectTimeoutMS . fromIntegral) mtimeout+ -- tail because curl leaves space before field value+ return $ tail <$> lookup field (map (first CI.mk) headers)++#if !MIN_VERSION_base(4,15,0)+singleton :: a -> [a]+singleton x = [x]+#endif
− src/ShowRelease.hs
@@ -1,244 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module ShowRelease (- showReleaseCmd,- showRelease,- activeFedoraReleases,- BodhiRelease(..),- downloadServer- )-where--import Control.Monad.Extra (forM_, unless, void, when, whenJust)-import Data.Bifunctor (first)-import qualified Data.CaseInsensitive as CI-import Data.List.Extra-import Data.Maybe (fromMaybe)-import Data.Time.Format (defaultTimeLocale, parseTimeM, rfc822DateFormat)-import Data.Time.LocalTime (utcToLocalZonedTime)-import Network.Curl (curlHead, CurlOption(..))-import SimpleCmd (error', (+-+))-import Text.Regex (mkRegex, subRegex)--import Arch-import BodhiRelease-import Common (warning)-import Types-import URL--showReleaseCmd :: Bool -> Bool -> RepoSource -> Release -> Arch -> Maybe Arch- -> Bool -> IO ()-showReleaseCmd debug dynredir reposource release sysarch march testing =- void $ showRelease debug dynredir False True reposource release sysarch march testing--showRelease :: Bool -> Bool -> Bool -> Bool -> RepoSource- -> Release -> Arch -> Maybe Arch -> Bool -> IO [(String, URL)]-showRelease debug dynredir warn checkdate reposource@(RepoSource koji _chan _mirror) release sysarch march testing = do- let arch = fromMaybe sysarch march- (url,path) <- getURL debug dynredir reposource release arch- let urlpath = url +//+ path- when debug $ print $ renderUrl Dir 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)],[])- System -> error' "showRelease: system unsupported"- rawhide <- rawhideFedoraRelease- let basicrepourls =- map (repoConfigArgs reposource sysarch march rawhide release) basicrepos- morerepourls =- map (repoConfigArgs reposource sysarch march rawhide release) morerepos- forM_ basicrepourls $ \(reponame,(url',path')) -> do- let baserepo = url' +//+ path'- when debug $ print $ renderUrl Dir baserepo- unless (not checkdate || release == System) $ do- let composeinfo =- url' +//+- if koji- then ["repo.json"]- else- case release of- Centos 10 -> ["metadata","composeinfo.json"]- Centos _ -> ["COMPOSE_ID"] -- ["metadata","composeinfo.json"]- ELN -> ["metadata","composeinfo.json"]- EPEL _ -> ["Everything", "state"]- EPELNext _ -> ["Everything", "state"]- Fedora _ -> if "updates" `isInfixOf` reponame ||- "updates-testing" `isInfixOf` reponame- then ["Everything", "state"]- else ["COMPOSE_ID"]- Rawhide -> ["COMPOSE_ID"]- System -> error' "system not supported"- let composeUrl = renderUrl File composeinfo- when debug $ print composeUrl- mtimestr <- curlGetHeader "Last-Modified" composeUrl- whenJust mtimestr $ \timestr -> do- utc <- parseTimeM False defaultTimeLocale rfc822DateFormat timestr- date <- utcToLocalZonedTime utc- (if warn then warning else putStrLn) $ show date +-+ "<" ++ renderUrl Dir url' ++ ">"- return $ map (fmap (uncurry (+//+))) $ basicrepourls ++ morerepourls--getURL :: Bool -> Bool -> RepoSource -> Release -> Arch- -> IO (URL,[String])-getURL debug dynredir 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://vault.centos.org/8-stream/", [])- _ -> error' "old Centos is not supported"- 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 dynredir reposource ["epel"] [show n]- EPELNext n -> getFedoraServer debug dynredir 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 dynredir reposource fedoraTop- [if pending then "development" else "releases", releasestr]- Rawhide -> getFedoraServer debug dynredir reposource fedoraTop ["development", "rawhide"]- System -> error' "getURL: system unsupported"- where- fedoraTop =- -- FIXME support older archs- if arch `elem` [PPC64LE, S390X]- then ["fedora-secondary"]- else ["fedora", "linux"]--repoConfigArgs :: RepoSource -> Arch -> Maybe Arch -> Natural -> Release- -> (String,URL) -> (String,(URL,[String]))--- non-koji-repoConfigArgs (RepoSource False _chan mirror) sysarch march rawhide 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 >= 8 then ("Everything" :) else id) [showArch arch] ++ ["tree" | arch == Source]- 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"]- System -> error' "repoConfigArgs: system unsupported"- in (reponame, (url, path ++ ["/"]))- where- repoVersion :: String- repoVersion =- if release `elem` [Rawhide, Fedora 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 _rawhide 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 -> Bool -> RepoSource -> [String] -> [String]- -> IO (URL,[String])-getFedoraServer debug dynredir (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 Dir url- when debug $ print rurl- redir <-- if dynredir- then return Nothing- else curlGetHeader "location" rurl- when debug $ print redir- case redir of- Nothing -> do- unless dynredir $- warning $ "slow redirection 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"---- FIXME check CurlCode(CurlOK) status-curlGetHeader :: CI.CI String -> String -> IO (Maybe String)-curlGetHeader field url = do- (_status,headers) <- curlHead url [CurlConnectTimeoutMS 5000]- -- tail because curl leaves space before field value- return $ tail <$> lookup field (map (first CI.mk) headers)
src/Types.hs view
@@ -12,6 +12,7 @@ ) where import Data.Char (isDigit)+import Data.List.Extra (lower) import Numeric.Natural --import Distribution.Fedora.Repoquery@@ -43,28 +44,32 @@ | ELN | Rawhide | System deriving (Eq, Ord) +-- FIXME determine via EPEL or Centos elnVersion :: Natural elnVersion = 11 --- | Read a Release name, otherwise return an error message+-- FIXME error if short/release-like+-- | Read a Release name eitherRelease :: String -> Either String Release-eitherRelease "rawhide" = Right Rawhide--- FIXME add proper parsing:-eitherRelease "epel8-next" = Right $ EPELNext 8-eitherRelease "epel9-next" = Right $ EPELNext 9-eitherRelease ('e':'p':'e':'l':n) | all isDigit n = let br = EPEL (read n) in Right br-eitherRelease ('e':'l':n) | all isDigit n = let r = read n in Right (EPEL r)-eitherRelease ('c':n) | all isDigit n = let r = read n in Right (Centos r)-eitherRelease ('C':n) | all isDigit n = let r = read n in Right (Centos r)-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 $- case compare r elnVersion of- LT -> Centos r- EQ -> ELN- GT -> Fedora r-eitherRelease cs = Left cs+eitherRelease rel =+ case lower rel of+ "rawhide" -> Right Rawhide+ -- FIXME add proper parsing:+ "epel8-next" -> Right $ EPELNext 8+ "epel9-next" -> Right $ EPELNext 9+ ('e':'p':'e':'l':n@(_:_)) | all isDigit n -> let br = EPEL (read n)+ in Right br+ ('c':n@(_:_)) | all isDigit n -> let r = read n in Right (Centos r)+ "eln" -> Right ELN+ ('f':n@(_:_)) | all isDigit n -> let r = read n in Right (Fedora r)+ ns@(_:_) | all isDigit ns ->+ let r = read ns in+ Right $+ case compare r elnVersion of+ LT -> Centos r+ EQ -> ELN+ GT -> Fedora r+ _ -> Left rel instance Show Release where show Rawhide = "rawhide"
test/tests.hs view
@@ -18,7 +18,7 @@ -- copied from dl-fedora branched :: Int-branched = 40+branched = 41 current, previous, prevprev, rawhide :: String current = show branched previous = show (branched - 1)@@ -42,6 +42,7 @@ ,(["epel9"], Just "ghc") ,(["c10"], Just "bash") ,(["c9"], Just "kernel")+ ,(["rawhide", "--whatprovides"], Just "perl(Regexp::Pattern::License)") ] main :: IO ()