{-# LANGUAGE CPP, 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 System.Directory (doesFileExist, findExecutable) import System.FilePath (takeBaseName) import Text.Regex #if !MIN_VERSION_simple_cmd(0,2,0) import Common (warning) #endif 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 -- FIXME --no-redirect? repoqueryCmd :: Bool -> Verbosity -> Release -> RepoSource -> Arch -> [Arch] -> Bool -> [String] -> IO () repoqueryCmd 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 queryformat = "%{name}-%{version}-%{release}.%{arch} (%{repoid})" ++ if isJust mdnf5 then "\n" else "" -- LANG=C.utf8 rhsm <- doesFileExist "/etc/dnf/plugins/subscription-manager.conf" let cmdargs = "repoquery" : ["--quiet" | verbose /= Verbose] ++ -- https://bugzilla.redhat.com/show_bug.cgi?id=1876828 ["--disableplugin=subscription-manager" | rhsm] ++ (if qfAllowed then ["--qf", queryformat] else []) ++ -- drop modules for F39+ ["--setopt=module_platform_id=platform:" ++ show release] ++ concatMap renderRepoConfig repoConfigs ++ args let dnf = fromMaybe "/usr/bin/dnf" mdnf5 when debug $ warning $ unwords $ ('\n' : takeBaseName dnf) : map show cmdargs res <- cmdLines dnf cmdargs unless (null res) $ do 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)