diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,18 @@ # changelog +## 0.1.3.0 + +- checks Ultramarine-Linux/packages too: `-d`/`--distro ultramarine` reads + `ultramarine/`, the `um43` branches and the `um43` repos with `.um43` + dist tags. without `--distro`, oglyad picks whichever distro's package + directory the checkout has +- repos are found through tetsudou's metalinks, like dnf, instead of + `repos.fyralabs.com` directly. a mirror whose repomd.xml doesn't match the + metalink's checksums is skipped +- `--repo` takes `{repo}` and `{release}` placeholders, so one url can + cover every release and subrepo. it can be a metalink or a base url +- json and markdown reports name the distro + ## 0.1.2.0 - checks every maintained release by default (today f43, f44, f45 and diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -12,6 +12,7 @@ oglyad -m ../packages -r 44 -r rawhide # just these releases oglyad -m ../packages -r rawhide --worktree # your local edits, against rawhide oglyad -m ../packages --only drift --format json +oglyad -m ../um-packages # Ultramarine-Linux/packages works too ``` from a checkout, `cabal run oglyad -- ` and `cabal test`. it needs @@ -35,9 +36,37 @@ picks a remote other than `origin`. `--worktree` reads specs from the checkout as it is, local edits included, -and needs exactly one `--release`. `--repo` points one release at a -different Terra repo. +and needs exactly one `--release`. +## distros and repos + +oglyad checks any anda monorepo it knows the layout of. `-d`/`--distro` +picks one, and by default it's whichever one's package directory the +checkout has: + +| distro | monorepo | packages in | branches | repos | dist | +| ------------- | -------------------------- | -------------- | ------------------- | --------------------------- | --------------------- | +| `terra` | terrapkg/packages | `anda/` | `f43`, `frawhide` | `terra43`, `terra43-extras` | `.fc43`, `.fcrawhide` | +| `ultramarine` | Ultramarine-Linux/packages | `ultramarine/` | `um43`, `umrawhide` | `um43` | `.um43`, `.umrawhide` | + +builds are looked up through the same metalink dnf uses, +`https://tetsudou.fyralabs.com/metalink?repo={repo}&arch=x86_64`. oglyad +tries its mirrors by preference and takes the first repomd.xml whose sha256 +the metalink lists, so a mirror that hasn't synced yet is skipped. + +`--repo` swaps that url for another one. `{repo}` becomes the repo's name +(`terra43`, or `terra43-extras` for a subrepo) and `{release}` the release's +(`43`, `rawhide`). a url with `metalink` in it is read as a metalink, and +anything else as a base url with `repodata/` under it: + +```sh +oglyad -m ../packages --repo 'https://repos.fyralabs.com/{repo}' # skip the metalink +oglyad -m ../packages -r 44 --repo https://mirror.example/terra44 # one release's repo +``` + +a url with neither placeholder only names one release's repo, so it needs +exactly one `--release`. subrepos get `-extras` and so on added to its end. + findings from several releases are merged. one that comes up in only some of them is tagged, like `anki [f44, f45]: ...`, and messages that only differ by dist tag are merged with `%{dist}` in its place: @@ -49,9 +78,9 @@ summaries) or `json`. the json is a versioned envelope: ```json -{"schema": 2, "oglyad": "0.1.0.0", "generated": "...", +{"schema": 2, "oglyad": "0.1.0.0", "generated": "...", "distro": "terra", "releases": [{"release": "43", "label": "f43", "ref": "origin/f43", - "commit": "...", "terra_repo": "https://repos.fyralabs.com/terra43"}], + "commit": "...", "terra_repo": "https://tetsudou.fyralabs.com/metalink?repo=terra43&arch=x86_64"}], "upstream": true, "summary": {"error": 0, "warn": 0, "info": 0, "ignored": 0}, "findings": [{"check": "...", "package": "...", "path": "...", "severity": "...", @@ -61,13 +90,14 @@ `schema` changes on any breaking change to the json. schema 2 replaced `monorepo_head` and `terra_repo` with `releases`, and added `releases` to -findings. `ref` is `null` with `--worktree`. +findings. `ref` is `null` with `--worktree`. `distro` was added later, and +`terra_repo` keeps its name for whichever distro's repo was checked. | exit | meaning | | ---- | ---------------------------------------------------------------------------------- | | 0 | ran, nothing at or above `--fail-on` (default `error`, or `warn`, `info`, `never`) | | 1 | ran, and found something at or above `--fail-on` | -| 2 | couldn't run: bad flags, unreadable ignore file, not a monorepo | +| 2 | couldn't run: bad flags, unreadable ignore file, not a monorepo oglyad knows | ## ignoring known findings diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -5,11 +5,10 @@ module Main (main) where import Control.Exception (SomeException, try) -import Control.Monad (forM, unless, when) +import Control.Monad (filterM, forM, unless, when) import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as LBS import Data.List (nub) -import Data.Maybe (isJust) import Data.Text (Text) import Data.Text qualified as T import Data.Time (UTCTime, getCurrentTime) @@ -38,8 +37,10 @@ exitUsage = ExitFailure 2 data Opts = Opts - { -- | token, cores, run start, spec ref, release - optConfig :: Maybe Text -> Int -> UTCTime -> Maybe Text -> Release -> Config, + { -- | token, cores, run start, spec ref, distro, release + optConfig :: Maybe Text -> Int -> UTCTime -> Maybe Text -> Distro -> Release -> Config, + -- | Nothing means tell from the checkout + optDistro :: Maybe Distro, optReleases :: [ReleaseArg], optRemote :: Text, optWorktree :: Bool, @@ -56,10 +57,11 @@ optsP :: Parser Opts optsP = do optConfig <- configP + optDistro <- optional (option (eitherReader lookupDistro) (long "distro" <> short 'd' <> metavar "NAME" <> help ("which monorepo -m is: " <> distroNames <> ". default: whichever one's package directory (anda/, ultramarine/) the checkout has"))) optReleases <- many (option (eitherReader parseReleaseArg) (long "release" <> short 'r' <> metavar "RELEASE" <> help "release to check: 43, f43 or rawhide. repeatable. default: every release Fedora's Bodhi hasn't archived")) - optRemote <- strOption (long "remote" <> metavar "NAME" <> value "origin" <> showDefault <> help "git remote whose release branches (f43, frawhide, ...) hold each release's specs. nothing is fetched, run git fetch yourself") + optRemote <- strOption (long "remote" <> metavar "NAME" <> value "origin" <> showDefault <> help "git remote whose release branches (f43, frawhide, um43, ...) hold each release's specs. nothing is fetched, run git fetch yourself") optWorktree <- switch (long "worktree" <> help "read specs from the checkout as it is, local edits included, instead of the release branch. needs exactly one --release") - optRepo <- optional (strOption (long "repo" <> metavar "URL" <> help "Terra repo base url (default: https://repos.fyralabs.com/terraN). needs exactly one --release")) + optRepo <- optional (strOption (long "repo" <> metavar "URL" <> help ("metalink or base url of the repo to check builds against. {repo} becomes the repo's name (terra43, terra43-extras) and {release} the release's (43, rawhide). a url with neither names one release's repo, so it needs exactly one --release. default: " <> T.unpack defaultRepoUrl))) optOnly <- many (option (eitherReader parseCheckName) (long "only" <> metavar "CHECK" <> help ("run only this check, repeatable. one of: " <> names))) optFormat <- option (eitherReader format) (long "format" <> short 'f' <> metavar "FORMAT" <> help "text (default), json, or markdown") @@ -74,6 +76,7 @@ pure Opts {..} where names = T.unpack (T.intercalate ", " checkNames) + distroNames = T.unpack (T.intercalate ", " (map distroName distros)) format = \case "text" -> Right Text "json" -> Right Json @@ -86,22 +89,24 @@ "never" -> Right Nothing other -> Left ("unknown level " <> show other <> ", expected error, warn, info or never") -configP :: Parser (Maybe Text -> Int -> UTCTime -> Maybe Text -> Release -> Config) +configP :: Parser (Maybe Text -> Int -> UTCTime -> Maybe Text -> Distro -> Release -> Config) configP = do - cfgMonorepo <- strOption (long "monorepo" <> short 'm' <> metavar "DIR" <> value "." <> showDefault <> help "checkout of terrapkg/packages") + cfgMonorepo <- strOption (long "monorepo" <> short 'm' <> metavar "DIR" <> value "." <> showDefault <> help "checkout of terrapkg/packages, or Ultramarine-Linux/packages with --distro ultramarine") fedora <- switch (long "fedora" <> help "also check for overlap with Fedora's release and updates repos (downloads ~60MB per release)") extraFedora <- many (strOption (long "fedora-repo" <> metavar "URL" <> help "extra repo base url to check for overlap, repeatable")) staleDays <- option auto (long "stale-days" <> metavar "N" <> value (180 :: Int) <> showDefault <> help "builds older than this count as stale") cfgUpstream <- switch (long "upstream" <> short 'u' <> help "query upstream APIs for version drift") cacheHours <- option auto (long "cache-hours" <> metavar "N" <> value (6 :: Int) <> showDefault <> help "reuse upstream answers younger than this, 0 to always refetch") jobs <- optional (option auto (long "jobs" <> short 'j' <> metavar "N" <> help "parallel jobs (default: number of cores)")) - pure $ \cfgGitHubToken cores cfgRunStart cfgSpecRef rel -> + pure $ \cfgGitHubToken cores cfgRunStart cfgSpecRef distro rel -> Config - { cfgTerraRepo = terraRepoFor rel, + { cfgRoot = distroRoot distro, + cfgRepoName = repoName distro rel, + cfgRepoUrl = repoUrlFor defaultRepoUrl rel, cfgFedoraRepos = (if fedora then fedoraReposFor rel else []) <> extraFedora, cfgRelease = relVersion rel, - cfgDist = releaseDist rel, - cfgBranch = releaseBranch rel, + cfgDist = releaseDist distro rel, + cfgBranch = releaseBranch distro rel, cfgStaleAfter = fromIntegral (staleDays * 86400), cfgCacheFor = fromIntegral (cacheHours * 3600), cfgConcurrency = maybe cores id jobs, @@ -151,7 +156,7 @@ let pinfo = info (optsP <**> helper <**> simpleVersioner ("oglyad " <> T.unpack oglyadVersion)) - (fullDesc <> progDesc "repository metadata and health checker for Terra") + (fullDesc <> progDesc "repository metadata and health checker for Terra and other anda monorepos") case execParserPure defaultPrefs pinfo args of Failure f -> case renderFailure f prog of -- --help and --version are output, not errors, so they go to stdout @@ -160,6 +165,22 @@ (msg, _) -> hPutStrLn stderr msg >> exitWith exitUsage other -> handleParseResult other +-- | the distro asked for, or the one whose package directory the checkout +-- has. a checkout with none, or with more than one, has to say +pickDistro :: FilePath -> Maybe Distro -> IO Distro +pickDistro mono asked = do + found <- filterM (doesDirectoryExist . (mono ) . distroRoot) distros + case asked of + Just d + | d `elem` found -> pure d + | otherwise -> usageError (mono <> " doesn't look like a " <> T.unpack (distroName d) <> " checkout (no " <> distroRoot d <> "/ directory). point -m at one") + Nothing -> case found of + [d] -> pure d + [] -> usageError (mono <> " doesn't look like an anda monorepo (no " <> roots <> " directory). point -m at a checkout of terrapkg/packages or another, see --distro") + _ -> usageError (mono <> " has more than one package directory (" <> T.unpack (T.intercalate ", " (map distroName found)) <> "), so pick one with --distro") + where + roots = T.unpack (T.intercalate "/, " (map (T.pack . distroRoot) distros)) <> "/" + usageError :: String -> IO a usageError msg = hPutStrLn stderr ("oglyad: " <> msg) >> exitWith exitUsage @@ -180,18 +201,17 @@ Right bytes -> either (\e -> usageError (path <> ": " <> e)) pure (parseIgnoreFile checkNames bytes) when (optWorktree && length optReleases /= 1) $ usageError "--worktree checks the working tree against one release, so it needs exactly one --release" - when (isJust optRepo && length optReleases /= 1) $ - usageError "--repo names one Terra repo, so it needs exactly one --release" + when (maybe False (\url -> not (any (`T.isInfixOf` url) ["{repo}", "{release}"])) optRepo && length optReleases /= 1) $ + usageError "--repo without {repo} or {release} in it names one repo, so it needs exactly one --release" token <- githubToken cores <- getNumProcessors start <- getCurrentTime - let specRef rel = if optWorktree then Nothing else Just (optRemote <> "/" <> releaseBranch rel) + let mono = cfgMonorepo (optConfig token cores start Nothing terra (Release "rawhide" 0)) + distro <- pickDistro mono optDistro + let specRef rel = if optWorktree then Nothing else Just (optRemote <> "/" <> releaseBranch distro rel) mkCfg rel = - let c = optConfig token cores start (specRef rel) rel - in maybe c (\url -> c {cfgTerraRepo = url}) optRepo - hasAnda <- doesDirectoryExist (cfgMonorepo (mkCfg (Release "rawhide" 0)) "anda") - unless hasAnda $ - usageError (cfgMonorepo (mkCfg (Release "rawhide" 0)) <> " doesn't look like a terrapkg/packages checkout (no anda/ directory). point -m at one") + let c = optConfig token cores start (specRef rel) distro rel + in maybe c (\url -> c {cfgRepoUrl = repoUrlFor url rel}) optRepo releases <- resolveReleases mkCfg optReleases let ran = if null optOnly then checkNames else optOnly @@ -203,14 +223,14 @@ applied | optNoIgnores = Applied findings [] [] [] | otherwise = applyIgnores checkNames ran ignores (snapIgnoreLabels snap) findings - relInfo = ReleaseInfo (relName rel) (releaseLabel rel) (cfgSpecRef cfg) (snapHead snap) (cfgTerraRepo cfg) + relInfo = ReleaseInfo (relName rel) (releaseLabel rel) (cfgSpecRef cfg) (snapHead snap) (repoUrl cfg Nothing) pure (rel, relInfo, applied) -- extracted trees for commits nothing checks anymore are just disk space unless optWorktree $ pruneTrees [c | (_, ReleaseInfo {riCommit = Just c}, _) <- perRelease] now <- getCurrentTime - let merged f = mergeFindings [(rel, f a) | (rel, _, a) <- perRelease] + let merged f = mergeFindings distro [(rel, f a) | (rel, _, a) <- perRelease] -- an ignore entry is only unused if no release needed it unused = [f | f <- merged apUnused, length (fReleases f) == length releases] report = @@ -218,6 +238,7 @@ { rVersion = oglyadVersion, rGenerated = now, rReleases = [ri | (_, ri, _) <- perRelease], + rDistro = distroName distro, rUpstream = any (\(rel, _, _) -> cfgUpstream (mkCfg rel)) perRelease, rFindings = merged apKept <> merged apProblems <> unused, rIgnored = merged apIgnored diff --git a/oglyad.cabal b/oglyad.cabal --- a/oglyad.cabal +++ b/oglyad.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: oglyad -version: 0.1.2.0 +version: 0.1.3.1 synopsis: repository metadata and health checker for Terra description: oglyad checks a terrapkg/packages checkout against Terra's published diff --git a/src/Oglyad/Collect.hs b/src/Oglyad/Collect.hs --- a/src/Oglyad/Collect.hs +++ b/src/Oglyad/Collect.hs @@ -44,12 +44,10 @@ let (root, logRef, hd, treeErrs) = case tree of Right (r, l, h) -> (Just r, l, h, []) Left err -> (Nothing, "HEAD", Nothing, [collectErr (maybe "monorepo" id cfgSpecRef) err]) - (dirErrs, dirs) <- partitionEithers <$> liftIO (maybe (pure []) findPackageDirs root) + (dirErrs, dirs) <- partitionEithers <$> liftIO (maybe (pure []) (`findPackageDirs` cfgRoot) root) -- the main repo, every subrepo some package asked for, and Fedora - let terraRepos = - (Nothing, cfgTerraRepo) - : [(Just s, cfgTerraRepo <> "-" <> s) | s <- nub (mapMaybe pdSubrepo dirs)] + let terraRepos = [(s, repoUrl cfg s) | s <- Nothing : nub (map Just (mapMaybe pdSubrepo dirs))] env <- ask ((specErrs, pkgs0), (terra, fedora)) <- liftIO $ @@ -111,7 +109,7 @@ (commits, (macros, cache)) <- liftIO $ concurrently - (commitTimes cfgMonorepo logRef hd cfgDist (map pdPath dirs)) + (commitTimes cfgMonorepo cfgRoot logRef hd cfgDist (map pdPath dirs)) ((,) <$> macroFingerprint <*> (fromMaybe Map.empty <$> loadJson cacheFile)) keyed <- forConcurrentlyN cfgConcurrency dirs $ \d -> liftIO $ do key <- specFingerprint macros cfgDist root (pdPath d) @@ -150,14 +148,14 @@ -- | last commit per package dir, reused as long as the commit hasn't moved. -- uncommitted changes can't change any "last commit", so the commit is the -- whole key. one cache file per dist, since each release reads its own branch -commitTimes :: FilePath -> Text -> Maybe Text -> Text -> [FilePath] -> IO (Map FilePath UTCTime) -commitTimes mono ref hd dist dirs = do +commitTimes :: FilePath -> FilePath -> Text -> Maybe Text -> Text -> [FilePath] -> IO (Map FilePath UTCTime) +commitTimes mono pkgRoot ref hd dist dirs = do let file = "commits" <> T.unpack dist <> ".json" cached <- loadJson file case (hd, cached) of (Just h, Just (h', m)) | h == h', all (`Map.member` m) dirs -> pure m _ -> do - m <- lastCommits mono ref dirs + m <- lastCommits mono pkgRoot ref dirs mapM_ (\h -> saveJson file (h, m)) hd pure m diff --git a/src/Oglyad/Release.hs b/src/Oglyad/Release.hs --- a/src/Oglyad/Release.hs +++ b/src/Oglyad/Release.hs @@ -1,13 +1,21 @@ --- | which Fedora/Terra releases to check, and everything that follows from --- one: the Terra repo, the %{dist} tag, the terrapkg/packages branch and the --- Fedora repos. also merges findings from several releases into one report +-- | which Fedora releases to check, and everything that follows from one and +-- the distro being checked: the repo, the %{dist} tag, the monorepo branch +-- and the Fedora repos. also merges findings from several releases into one +-- report module Oglyad.Release - ( Release (..), + ( Distro (..), + terra, + ultramarine, + distros, + lookupDistro, + Release (..), isRawhide, releaseLabel, releaseDist, releaseBranch, - terraRepoFor, + repoName, + defaultRepoUrl, + repoUrlFor, fedoraReposFor, parseReleaseArg, ReleaseArg (..), @@ -30,6 +38,40 @@ import Oglyad.Types (Finding (..)) import Text.Read (readMaybe) +-- | an anda monorepo oglyad knows how to check, and how it spells things per +-- release +data Distro = Distro + { -- | what --distro takes, e.g. "terra" + distroName :: Text, + -- | the directory under the monorepo root holding every package, e.g. + -- "anda" for terrapkg/packages + distroRoot :: FilePath, + -- | the repo's name, with the release name appended: terra for terra43 + distroRepo :: Text, + -- | release branch prefix, f for f43 + distroBranch :: Text, + -- | %{dist} prefix, .fc for .fc43 + distroDist :: Text + } + deriving stock (Eq, Show) + +-- | terrapkg/packages +terra :: Distro +terra = Distro "terra" "anda" "terra" "f" ".fc" + +-- | Ultramarine-Linux/packages. builds land in um43, umrawhide, with +-- .um43 and .umrawhide dist tags +ultramarine :: Distro +ultramarine = Distro "ultramarine" "ultramarine" "um" "um" ".um" + +distros :: [Distro] +distros = [terra, ultramarine] + +lookupDistro :: String -> Either String Distro +lookupDistro raw = case [d | d <- distros, distroName d == T.pack raw] of + d : _ -> Right d + [] -> Left ("unknown distro " <> show raw <> ", expected one of: " <> T.unpack (T.intercalate ", " (map distroName distros))) + -- | a Fedora release Terra builds for. rawhide keeps its number too, since -- %fedora still needs one when evaluating specs data Release = Release @@ -43,23 +85,35 @@ isRawhide :: Release -> Bool isRawhide r = relName r == "rawhide" --- | how releases are spelled in output: f43, rawhide. matches the --- terrapkg/packages branch names minus rawhide's "f" +-- | how releases are spelled in output: f43, rawhide. the same for every +-- distro, since they're all built on Fedora's releases releaseLabel :: Release -> Text releaseLabel r = if isRawhide r then "rawhide" else "f" <> relName r -- | rawhide builds use .fcrawhide, not .fc46. terrapkg/packages' bootstrap --- workflow rewrites macros.dist to do it -releaseDist :: Release -> Text -releaseDist r = ".fc" <> relName r +-- workflow rewrites macros.dist to do it, and Ultramarine does the same +releaseDist :: Distro -> Release -> Text +releaseDist d r = distroDist d <> relName r --- | the terrapkg/packages branch for a release: f43, frawhide -releaseBranch :: Release -> Text -releaseBranch r = "f" <> relName r +-- | the monorepo branch for a release: f43, frawhide, um43 +releaseBranch :: Distro -> Release -> Text +releaseBranch d r = distroBranch d <> relName r -terraRepoFor :: Release -> Text -terraRepoFor r = "https://repos.fyralabs.com/terra" <> relName r +-- | the distro's repo for a release, e.g. terra43 or umrawhide. subrepos +-- add a suffix: terra43-extras +repoName :: Distro -> Release -> Text +repoName d r = distroRepo d <> relName r +-- | where Fyra Labs' repos are, the same metalink dnf uses. {repo} becomes +-- a 'repoName', with any subrepo suffix +defaultRepoUrl :: Text +defaultRepoUrl = "https://tetsudou.fyralabs.com/metalink?repo={repo}&arch=x86_64" + +-- | a repo url template for one release, with {release} filled in and +-- {repo} left for 'Oglyad.Types.repoUrl' +repoUrlFor :: Text -> Release -> Text +repoUrlFor url r = T.replace "{release}" (relName r) url + -- | Fedora's own repos, for the overlap check. rawhide has no updates repo fedoraReposFor :: Release -> [Text] fedoraReposFor r @@ -118,15 +172,15 @@ -- "the same way" ignores the dist tag, so build-lag's -- "spec is at 1.2-1.fc43" and "spec is at 1.2-1.fc44" merge into -- "spec is at 1.2-1%{dist}" -mergeFindings :: [(Release, [Finding])] -> [Finding] -mergeFindings perRelease = +mergeFindings :: Distro -> [(Release, [Finding])] -> [Finding] +mergeFindings distro perRelease = [ merged k f (r : map snd rest) | k <- nubOrd (map fst tagged), Just ((f, r) : rest) <- [Map.lookup k grouped] ] where tagged = [(keyOf r f, (f, relName r)) | (r, fs) <- perRelease, f <- fs] - keyOf r f = (fCheck f, fPackage f, fPath f, fSeverity f, T.replace (releaseDist r) "%{dist}" (fMessage f)) + keyOf r f = (fCheck f, fPackage f, fPath f, fSeverity f, T.replace (releaseDist distro r) "%{dist}" (fMessage f)) -- members stay in the order the releases were given grouped = Map.fromListWith (flip (<>)) [(k, [x]) | (k, x) <- tagged] merged (_, _, _, _, generic) f rels = case nub rels of diff --git a/src/Oglyad/Report.hs b/src/Oglyad/Report.hs --- a/src/Oglyad/Report.hs +++ b/src/Oglyad/Report.hs @@ -32,6 +32,8 @@ rGenerated :: UTCTime, -- | every release this run checked, in order rReleases :: [ReleaseInfo], + -- | "terra", "ultramarine" + rDistro :: Text, rUpstream :: Bool, rFindings :: [Finding], rIgnored :: [Finding] @@ -46,7 +48,7 @@ -- | the git ref the specs came from, Nothing for the working tree riRef :: Maybe Text, riCommit :: Maybe Text, - riTerraRepo :: Text + riRepo :: Text } render :: Format -> Severity -> Report -> LBS.ByteString @@ -90,13 +92,15 @@ [ "schema" .= (2 :: Int), "oglyad" .= rVersion, "generated" .= rGenerated, + "distro" .= rDistro, "releases" .= [ object [ "release" .= riName, "label" .= riLabel, "ref" .= riRef, "commit" .= riCommit, - "terra_repo" .= riTerraRepo + -- named for Terra, but it's whichever distro's repo was checked + "terra_repo" .= riRepo ] | ReleaseInfo {..} <- rReleases ], @@ -130,7 +134,7 @@ renderMarkdown :: Severity -> Report -> Text renderMarkdown minSev r@Report {..} = T.unlines $ - [ "# oglyad report", + [ "# oglyad report: " <> rDistro, "", T.intercalate " · " diff --git a/src/Oglyad/Source/Monorepo.hs b/src/Oglyad/Source/Monorepo.hs --- a/src/Oglyad/Source/Monorepo.hs +++ b/src/Oglyad/Source/Monorepo.hs @@ -1,4 +1,4 @@ --- | reads a local checkout of terrapkg/packages +-- | reads a local checkout of terrapkg/packages, or another anda monorepo module Oglyad.Source.Monorepo ( PkgDir (..), SpecInfo (..), @@ -70,11 +70,12 @@ deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON) --- | walk anda/ and return every project directory. a directory that can't be --- read comes back as a Left with the reason, instead of ending the walk. --- symlinked directories aren't followed, so a link loop can't hang the walk -findPackageDirs :: FilePath -> IO [Either (FilePath, Text) PkgDir] -findPackageDirs root = go "anda" +-- | walk the package dir (anda/ in terrapkg/packages) and return every +-- project directory. a directory that can't be read comes back as a Left +-- with the reason, instead of ending the walk. symlinked directories aren't +-- followed, so a link loop can't hang the walk +findPackageDirs :: FilePath -> FilePath -> IO [Either (FilePath, Text) PkgDir] +findPackageDirs root pkgRoot = go pkgRoot where go rel = do let abs' = root rel @@ -197,11 +198,11 @@ -- ~25s of cpu. one pass listing every changed file per commit takes ~0.5s, -- and since git lists newest commits first, the first time we see a path -- under a dir is that dir's last commit -lastCommits :: FilePath -> Text -> [FilePath] -> IO (Map FilePath UTCTime) -lastCommits root ref dirs = do +lastCommits :: FilePath -> FilePath -> Text -> [FilePath] -> IO (Map FilePath UTCTime) +lastCommits root pkgRoot ref dirs = do out <- run "git" $ - ["-C", root, "-c", "core.quotePath=false", "log", "--format=@%ct", "--name-only", "--no-renames", T.unpack ref, "--", "anda"] + ["-C", root, "-c", "core.quotePath=false", "log", "--format=@%ct", "--name-only", "--no-renames", T.unpack ref, "--", pkgRoot] -- not a git checkout (or no git at all) just means no commit times pure (either (const Map.empty) (go Nothing Map.empty . T.lines) out) where diff --git a/src/Oglyad/Source/Repodata.hs b/src/Oglyad/Source/Repodata.hs --- a/src/Oglyad/Source/Repodata.hs +++ b/src/Oglyad/Source/Repodata.hs @@ -1,8 +1,10 @@ --- | reads published dnf repodata: repomd.xml → primary.xml.{zst,gz,xz} → packages +-- | reads published dnf repodata: metalink → repomd.xml → +-- primary.xml.{zst,gz,xz} → packages module Oglyad.Source.Repodata ( RpmEntry (..), fetchRepo, decompressAndParse, + parseMetalink, parseRepomd, parsePrimary, srpmName, @@ -15,14 +17,19 @@ import Control.Exception (SomeException, try) import Control.Monad ((<$!>), (>=>)) import Control.Monad.Reader (liftIO) +import Crypto.Hash.SHA256 qualified as SHA256 import Data.Bifunctor (first) +import Data.ByteString.Base16 qualified as B16 import Data.ByteString.Lazy qualified as LBS import Data.Char (isAlphaNum) +import Data.List (sortOn) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Maybe (mapMaybe) +import Data.Ord (Down (..)) import Data.Text (Text) import Data.Text qualified as T +import Data.Text.Encoding qualified as TE import Data.Text.Read qualified as TR import Data.Time (UTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) @@ -37,7 +44,7 @@ import System.IO (Handle) import System.Process.Typed (byteStringInput, createPipe, getStdout, nullStream, proc, setEnv, setStderr, setStdin, setStdout, waitExitCode, withProcessTerm) import Text.XML (Name (..), def, parseLBS) -import Text.XML.Cursor (attribute, attributeIs, element, fromDocument, ($//), (&/)) +import Text.XML.Cursor (attribute, attributeIs, content, element, fromDocument, ($/), ($//), (&/)) import Text.XML.Stream.Parse (parseBytes) -- | one binary (or source) rpm from primary.xml @@ -53,16 +60,17 @@ } deriving stock (Eq, Show) --- | builds per source package for a repo, reusing the last parse when the --- repo hasn't changed. repomd.xml is tiny, and the primary.xml href in it --- embeds a checksum, so an unchanged href means unchanged contents +-- | builds per source package for a repo, given its metalink or base url, +-- reusing the last parse when the repo hasn't changed. repomd.xml is tiny, +-- and the primary.xml href in it embeds a checksum, so an unchanged href +-- means unchanged contents fetchRepo :: Text -> App (Either String (Map Text RepoBuild)) -fetchRepo base = do - let file = "repodata-" <> T.unpack (T.map (\c -> if isAlphaNum c then c else '_') base) <> ".json" - repomd <- httpGetE (base <> "/repodata/repomd.xml") - case first httpErr repomd >>= parseRepomd of +fetchRepo url = do + located <- fetchRepomd url + case located >>= \(base, repomd) -> (base,) <$> parseRepomd repomd of Left err -> pure (Left err) - Right href -> + Right (base, href) -> do + let file = "repodata-" <> T.unpack (T.map (\c -> if isAlphaNum c then c else '_') base) <> ".json" liftIO (loadJson file) >>= \case Just (cachedHref, builds) | cachedHref == href -> pure (Right builds) _ -> do @@ -73,6 +81,48 @@ Left _ -> pure () pure r +-- | a repo's repomd.xml, and the base url it came from. a url with +-- "metalink" in it is read like dnf reads one: try its mirrors by +-- preference, and take the first repomd.xml whose sha256 the metalink +-- lists, so a mirror that hasn't synced yet is skipped +fetchRepomd :: Text -> App (Either String (Text, LBS.ByteString)) +fetchRepomd url + | "metalink" `T.isInfixOf` url = + httpGetE url >>= \r -> case first httpErr r >>= parseMetalink of + Left err -> pure (Left ("can't read metalink " <> T.unpack url <> ": " <> err)) + Right (_, []) -> pure (Left ("metalink " <> T.unpack url <> " lists no mirrors")) + Right (hashes, mirrors) -> tryMirrors hashes ("no mirror in " <> T.unpack url) mirrors + | otherwise = fmap (url,) . first httpErr <$> httpGetE (url <> "/repodata/repomd.xml") + where + tryMirrors _ lastErr [] = pure (Left lastErr) + tryMirrors hashes _ (m : rest) = case T.stripSuffix "/repodata/repomd.xml" m of + Nothing -> tryMirrors hashes ("metalink mirror " <> T.unpack m <> " isn't a repomd.xml") rest + Just base -> + httpGetE m >>= \case + Left e -> tryMirrors hashes (httpErr e) rest + Right body + | null hashes || sha256 body `elem` hashes -> pure (Right (base, body)) + | otherwise -> tryMirrors hashes (T.unpack m <> " doesn't match the metalink's checksum, is the mirror behind?") rest + sha256 = TE.decodeUtf8 . B16.encode . SHA256.hashlazy + +-- | the sha256 hashes a metalink accepts for repomd.xml (the current one and +-- any alternates, which are recent ones mirrors may still serve), and its +-- mirrors' repomd.xml urls, most preferred first +parseMetalink :: LBS.ByteString -> Either String ([Text], [Text]) +parseMetalink bs = do + doc <- first show (parseLBS def bs) + let cur = fromDocument doc + hashes = cur $// (element (metalinkNs "hash") >=> attributeIs "type" "sha256") &/ content + urls = + [ (pref, T.strip u) + | el <- cur $// element (metalinkNs "url"), + let pref = case attribute "preference" el of + p : _ | Right (n, "") <- TR.decimal p -> n + _ -> 0 :: Int, + u <- [T.concat (el $/ content)] + ] + Right (map T.strip hashes, map snd (sortOn (Down . fst) urls)) + -- | fetch and parse the primary.xml at a href from repomd.xml fetchPrimaryAt :: Text -> Text -> App (Either String [RpmEntry]) fetchPrimaryAt base href = do @@ -115,10 +165,11 @@ (ExitSuccess, _) -> parsed pure (either (\e -> Left (cmd <> ": " <> show (e :: SomeException))) id r) -repoNs, commonNs, rpmNs :: Text -> Name +repoNs, commonNs, rpmNs, metalinkNs :: Text -> Name repoNs n = Name n (Just "http://linux.duke.edu/metadata/repo") Nothing commonNs n = Name n (Just "http://linux.duke.edu/metadata/common") Nothing rpmNs n = Name n (Just "http://linux.duke.edu/metadata/rpm") Nothing +metalinkNs n = Name n (Just "http://www.metalinker.org/") Nothing -- | find the location of primary.xml in repomd.xml. -- this uses the xml-conduit Cursor api, which builds the whole document in diff --git a/src/Oglyad/Types.hs b/src/Oglyad/Types.hs --- a/src/Oglyad/Types.hs +++ b/src/Oglyad/Types.hs @@ -9,6 +9,7 @@ finding, Snapshot (..), Config (..), + repoUrl, Check, ) where @@ -151,21 +152,27 @@ } data Config = Config - { -- | local checkout of terrapkg/packages + { -- | local checkout of terrapkg/packages, or another anda monorepo cfgMonorepo :: FilePath, + -- | the directory in it holding every package, e.g. anda + cfgRoot :: FilePath, -- | git ref to read specs from, e.g. origin/f43. Nothing reads the -- working tree of cfgMonorepo as it is cfgSpecRef :: Maybe Text, - -- | the terrapkg/packages branch name, f43 or frawhide. update.rhai + -- | the monorepo branch name, f43 or frawhide. update.rhai -- scripts see it as labels.branch cfgBranch :: Text, - -- | e.g. https://repos.fyralabs.com/terra44 - cfgTerraRepo :: Text, + -- | the main repo's name, e.g. terra44 + cfgRepoName :: Text, + -- | where it is: a metalink or a base url, with {repo} where the repo + -- name goes. without {repo} it's the main repo's url, and subrepos add + -- -extras to the end of it + cfgRepoUrl :: Text, -- | repo base urls to check for overlap cfgFedoraRepos :: [Text], -- | Fedora/Terra release number, e.g. 44. rawhide has one too cfgRelease :: Int, - -- | %{dist} used when evaluating specs, e.g. .fc44 or .fcrawhide + -- | %{dist} used when evaluating specs, e.g. .fc44, .fcrawhide or .um44 cfgDist :: Text, cfgStaleAfter :: NominalDiffTime, -- | whether to hit upstream APIs at all @@ -181,6 +188,14 @@ cfgGitHubToken :: Maybe Text } deriving stock (Show) + +-- | the url of the main repo, or of a subrepo like extras +repoUrl :: Config -> Maybe Text -> Text +repoUrl Config {..} sub + | "{repo}" `T.isInfixOf` cfgRepoUrl = T.replace "{repo}" (cfgRepoName <> suffix) cfgRepoUrl + | otherwise = cfgRepoUrl <> suffix + where + suffix = maybe "" ("-" <>) sub -- | everything a check is allowed to look at, already collected. -- checks never do IO, which is what keeps them trivially testable diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -25,7 +25,7 @@ import Oglyad.Report (ReleaseInfo (..), Report (..), renderJson, renderMarkdown, renderText) import Oglyad.Source.Anda (scriptErrors, stripAnsi) import Oglyad.Source.Monorepo (PkgDir (..), checkoutRef, findPackageDirs, hclString, lastCommits, macroFingerprint, specFingerprint, versionMacros) -import Oglyad.Source.Repodata (RpmEntry (..), decompressAndParse, fetchRepo, latestBySource, parsePrimary, srpmName) +import Oglyad.Source.Repodata (RpmEntry (..), decompressAndParse, fetchRepo, latestBySource, parseMetalink, parsePrimary, srpmName) import Oglyad.Source.Rhai (parseUpdateRhai, parseUpdateRhaiWith) import Oglyad.Source.RhaiEval (Simulated (..), simulateVersion) import Oglyad.Source.Upstream (isSemver) @@ -435,7 +435,7 @@ createDirectoryIfMissing True (root "anda/a") writeFile (root "anda/a/anda.hcl") "project pkg {}" createDirectoryLink ".." (root "anda/a/loop") - dirs <- findPackageDirs root + dirs <- findPackageDirs root "anda" map (fmap pdPath) dirs `shouldBe` [Right "anda/a"] _ <- specFingerprint "m" ".fc44" root "anda/a" pure () @@ -449,7 +449,7 @@ pkgDir "n" "nightly" pkgDir "q" "quaterdaily" pkgDir "w" "weekly" - dirs <- findPackageDirs root + dirs <- findPackageDirs root "anda" [(pdPath d, pdNightly d) | Right d <- dirs] `shouldBe` [("anda/n", True), ("anda/q", True), ("anda/w", False)] describe "parseCheckName" $ do @@ -465,7 +465,15 @@ -- port 9 (discard) on loopback: refused immediately, no network needed r <- runApp (snapConfig snapshot) (fetchRepo "http://127.0.0.1:9/repo") r `shouldSatisfy` either (const True) (const False) + it "turns an unreachable metalink into a Left too" $ do + r <- runApp (snapConfig snapshot) (fetchRepo "http://127.0.0.1:9/metalink?repo=terra44") + r `shouldSatisfy` either (const True) (const False) + describe "metalinks" + $ it "reads checksums, alternates included, and mirrors by preference" + $ parseMetalink metalinkFixture + `shouldBe` Right (["aaa", "bbb"], ["https://fast.example/terra44/repodata/repomd.xml", "https://repos.fyralabs.com/terra44/repodata/repomd.xml"]) + describe "macroFingerprint" $ it "changes when ~/.rpmmacros changes" $ withSystemTempDirectory "oglyad-home" $ \home -> @@ -481,9 +489,19 @@ `shouldBe` [Right (NumberedArg 43), Right (NumberedArg 44), Right RawhideArg, Right RawhideArg, Left "unknown release \"el10\", expected a number like 43, f43, or rawhide", Left "unknown release \"\", expected a number like 43, f43, or rawhide"] it "spells rawhide's dist, branch and repos the way Terra does" $ do let raw = Release "rawhide" 46 - (releaseDist raw, releaseBranch raw, terraRepoFor raw, releaseLabel raw) `shouldBe` (".fcrawhide", "frawhide", "https://repos.fyralabs.com/terrarawhide", "rawhide") + (releaseDist terra raw, releaseBranch terra raw, repoName terra raw, releaseLabel raw) `shouldBe` (".fcrawhide", "frawhide", "terrarawhide", "rawhide") fedoraReposFor raw `shouldBe` ["https://dl.fedoraproject.org/pub/fedora/linux/development/rawhide/Everything/x86_64/os"] length (fedoraReposFor (Release "43" 43)) `shouldBe` 2 + it "spells releases the way Ultramarine does" $ do + let r44 = Release "44" 44 + (releaseDist ultramarine r44, releaseBranch ultramarine r44, repoName ultramarine r44) `shouldBe` (".um44", "um44", "um44") + lookupDistro "ultramarine" `shouldBe` Right ultramarine + lookupDistro "umbrella" `shouldSatisfy` either (const True) (const False) + it "fills in repo url templates, subrepos included" $ do + let cfg url = (snapConfig snapshot) {cfgRepoName = "terra44", cfgRepoUrl = repoUrlFor url (Release "44" 44)} + repoUrl (cfg defaultRepoUrl) (Just "extras") `shouldBe` "https://tetsudou.fyralabs.com/metalink?repo=terra44-extras&arch=x86_64" + repoUrl (cfg "https://example.com/um{release}/x86_64") Nothing `shouldBe` "https://example.com/um44/x86_64" + repoUrl (cfg "https://example.com/terra44") (Just "extras") `shouldBe` "https://example.com/terra44-extras" it "takes Fedora releases from Bodhi, rawhide last" $ parseBodhiReleases bodhiFixture `shouldBe` Right [Release "43" 43, Release "44" 44, Release "45" 45, Release "rawhide" 46] it "complains when Bodhi lists nothing useful" $ @@ -495,13 +513,16 @@ lag dist = Finding "build-lag" "zed" (Just "anda/zed") Error ("never published (spec is at 1.2-1" <> dist <> ")") [] drift = Finding "drift" "zed" (Just "anda/zed") Warn "upstream has 1.3, spec is at 1.2" [] it "merges findings that only differ by dist" $ - mergeFindings [(r43, [lag ".fc43"]), (r44, [lag ".fc44"])] + mergeFindings terra [(r43, [lag ".fc43"]), (r44, [lag ".fc44"])] `shouldBe` [(lag "%{dist}") {fReleases = ["43", "44"]}] + it "merges by the distro's own dist" $ + mergeFindings ultramarine [(r43, [lag ".um43"]), (r44, [lag ".um44"])] + `shouldBe` [(lag "%{dist}") {fReleases = ["43", "44"]}] it "keeps the real message for a single release" $ - mergeFindings [(r43, [drift]), (r44, [lag ".fc44"])] + mergeFindings terra [(r43, [drift]), (r44, [lag ".fc44"])] `shouldBe` [drift {fReleases = ["43"]}, (lag ".fc44") {fReleases = ["44"]}] it "tags findings with only the releases that have them" $ - map fReleases (mergeFindings [(r43, [drift]), (r44, [drift, lag ".fc44"])]) `shouldBe` [["43", "44"], ["44"]] + map fReleases (mergeFindings terra [(r43, [drift]), (r44, [drift, lag ".fc44"])]) `shouldBe` [["43", "44"], ["44"]] describe "release tags in reports" $ do let infos = [ReleaseInfo n ("f" <> n) Nothing Nothing "" | n <- ["43", "44"]] @@ -557,7 +578,7 @@ git [] ["init", "-q"] commitAt "2026-01-02T03:04:05Z" "anda/a" commitAt "2026-02-03T04:05:06+08:00" "anda/b" - m <- lastCommits repo "HEAD" ["anda/a", "anda/b"] + m <- lastCommits repo "anda" "HEAD" ["anda/a", "anda/b"] Map.lookup "anda/a" m `shouldBe` Just (UTCTime (fromGregorian 2026 1 2) (3 * 3600 + 4 * 60 + 5)) Map.lookup "anda/b" m `shouldBe` Just (UTCTime (fromGregorian 2026 2 2) (20 * 3600 + 5 * 60 + 6)) @@ -628,9 +649,11 @@ snapConfig = Config { cfgMonorepo = ".", + cfgRoot = "anda", cfgSpecRef = Nothing, cfgBranch = "f44", - cfgTerraRepo = "", + cfgRepoName = "terra44", + cfgRepoUrl = defaultRepoUrl, cfgFedoraRepos = [], cfgRelease = 44, cfgDist = ".fc44", @@ -645,6 +668,17 @@ snapIgnoreLabels = Map.empty } +-- | trimmed from tetsudou's answer for terra44, with a second mirror +metalinkFixture :: LBS8.ByteString +metalinkFixture = + "\ + \xaaa\ + \bbb\ + \\ + \https://repos.fyralabs.com/terra44/repodata/repomd.xml\ + \https://fast.example/terra44/repodata/repomd.xml\ + \" + bodhiFixture :: LBS8.ByteString bodhiFixture = "{\"releases\": [\ @@ -662,6 +696,7 @@ { rVersion = "0", rGenerated = now, rReleases = [ReleaseInfo "44" "f44" (Just "origin/f44") (Just "abc") "https://repos.fyralabs.com/terra44"], + rDistro = "terra", rUpstream = False, rFindings = fs, rIgnored = []