diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,12 @@ # Changelog +## 0.5.0 (2021-11-03) +- use rpm-nvr library for NVRA type (API changes) and rpmVerCompare + to order ver-rel's +- add --downgraded filter +- add --subdir +- remove --ignore-arch + ## 0.4.1 (2021-04-19) - expose a library in Distribution.RPM.PackageTreeDiff (@juhp) - full correct rpm version comparison (ie handling ^ and ~) (@juhp) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -19,52 +19,62 @@ ### Containers -Compare the content of two rpm based containers (new added packages in fedora:34) +Compare the content of two rpm based containers versions, +filtering for new added packages: -```bash session -$ pkgtreediff --new "podman run --rm fedora:33 rpm -qa" "podman run --rm fedora:34 rpm -qa" -dejavu-sans-fonts.noarch 2.37-16.fc34 -fonts-filesystem.noarch 2.0.5-5.fc34 -langpacks-core-en_GB.noarch 3.0-12.fc34 -langpacks-core-font-en.noarch 3.0-12.fc34 -langpacks-en_GB.noarch 3.0-12.fc34 +```shellsession +$ pkgtreediff --new "podman run --rm fedora:34 rpm -qa" "podman run --rm fedora:35 rpm -qa" +libfsverity-1.4-4.fc35.x86_64 +mpdecimal-2.5.1-2.fc35.x86_64 ``` ### Package trees -Package source changes between Fedora 30 and 31 Server at GA (ignoring release bumps): +Package source changes between Fedora 33 and 34 Server at GA (ignoring release bumps): -```bash session -$ pkgtreediff --ignore-release https://dl.fedoraproject.org/pub/fedora/linux/releases/{32,33}/Server/source/tree/Packages/ -ModemManager.src: 1.12.8-1.fc32 -> 1.14.2-1.fc33 -NetworkManager.src: 1.22.10-1.fc32 -> 1.26.2-2.fc33 -PackageKit.src: 1.1.13-2.fc32 -> 1.2.1-1.fc33 -abrt.src: 2.14.0-2.fc32 -> 2.14.4-6.fc33 -adwaita-icon-theme.src: 3.36.0-1.fc32 -> 3.38.0-1.fc33 -alsa-lib.src: 1.2.2-2.fc32 -> 1.2.3.2-5.fc33 -alsa-sof-firmware.src: 1.4.2-4.fc32 -> 1.5-2.fc33 -anaconda.src: 32.24.7-1.fc32 -> 33.25.4-1.fc33 +```shellsession +$ pkgtreediff --ignore-release https://dl.fedoraproject.org/pub/fedora/linux/releases/{33,34}/Server/source/tree/Packages/ +ModemManager.src: 1.14.2-1.fc33 -> 1.14.10-2.fc34 +NetworkManager.src: 1.26.2-2.fc33 -> 1.30.2-1.fc34 +PackageKit.src: 1.2.1-1.fc33 -> 1.2.3-1.fc34 +abrt.src: 2.14.4-6.fc33 -> 2.14.5-2.fc34 : -gobject-introspection.src: 1.64.1-1.fc32 -> 1.66.1-1.fc33 -+ google-carlito-fonts.src 1.103-0.15.20130920.fc33 -- google-crosextra-caladea-fonts.src 1.002-0.14.20130214.fc32 -- google-crosextra-carlito-fonts.src 1.103-0.12.20130920.fc32 -gpgme.src: 1.13.1-6.fc32 -> 1.14.0-2.fc33 +bash.src: 5.0.17-2.fc33 -> 5.1.0-2.fc34 +bash-completion.src: 2.8-9.fc33 -> 2.11-2.fc34 +- bcache-tools-1.0.8-19.fc33.src +bcm283x-firmware.src: 20201008-2.63b1922.fc33 -> 20210407-1.8c7c524.fc34 +bind.src: 9.11.23-1.fc33 -> 9.16.11-5.fc34 +binutils.src: 2.35-10.fc33 -> 2.35.1-41.fc34 : +cockpit.src: 229-1.fc33 -> 241-1.fc34 +colord.src: 1.4.4-5.fc33 -> 1.4.5-2.fc34 ++ compsize-1.5-1.fc34.src +conmon.src: 2.0.21-3.fc33 -> 2.0.27-1.fc34 +container-selinux.src: 2.145.0-1.fc33 -> 2.158.0-1.gite78ac4f.fc34 +containernetworking-plugins.src: 0.8.7-1.fc33 -> 0.9.1-4.fc34 ++ containers-common-1-13.fc34.src +- copy-jdk-configs-3.7-7.fc33.src +- createrepo_c-0.15.11-4.fc33.src ++ criu-3.15-3.fc34.src +crun.src: 0.15-5.fc33 -> 0.18-5.fc34 : -xkeyboard-config.src: 2.29-1.fc32 -> 2.30-3.fc33 -xxhash.src: 0.7.3-1.fc32 -> 0.8.0-1.fc33 -yelp.src: 3.36.0-1.fc32 -> 3.38.1-1.fc33 -yelp-xsl.src: 3.36.0-1.fc32 -> 3.38.1-1.fc33 -- zram.src 0.4-1.fc32 -zstd.src: 1.4.4-2.fc32 -> 1.4.5-5.fc33 +: +vim.src: 8.2.1770-1.fc33 -> 8.2.2637-1.fc34 ++ vulkan-loader-1.2.162.0-2.fc34.src +wayland.src: 1.18.0-2.fc33 -> 1.19.0-1.fc34 +webkit2gtk3.src: 2.30.1-1.fc33 -> 2.32.0-2.fc34 +wget.src: 1.20.3-8.fc33 -> 1.21.1-2.fc34 +: +zchunk.src: 1.1.5-3.fc33 -> 1.1.9-2.fc34 +zstd.src: 1.4.5-5.fc33 -> 1.4.9-1.fc34 Summary -Updated: 340 -Added: 27 -Deleted: 32 +Updated: 330 +Downgraded: 0 +Added: 63 +Deleted: 98 Arch changed: 0 -Total packages: 937 -> 932 +Total packages: 932 -> 897 ``` ### Hosts @@ -97,9 +107,10 @@ ([more details](https://copr.fedorainfracloud.org/coprs/petersen/pkgtreediff/monitor/detailed)). ## RPM version ordering +pkgtreediff use the [rpm-nvr](https://hackage.haskell.org/package/rpm-nvr) +library implementation of the `rpmvercmp()` algorithm, +though it has not been verified to behave identically. + RPM version ordering is somewhat involved . -For example "1.2.1^rc1" < "1.2.1" (similarly for tilde). - -pkgtreediff tries to implement the rpmvercmp() algorithm, -but it has not been verified to behave identically. +For example "1.2.1~rc1" < "1.2.1" (greater for ^). diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -1,3 +1,5 @@ +- keep subdir prefices + - compare buildsys list-tagged packages... - compare with installed packages (--installed?) - deb trees? @@ -7,3 +9,4 @@ - support epochs in file package list - diff isos - "--query-format" +- testsuite!! diff --git a/pkgtreediff.cabal b/pkgtreediff.cabal --- a/pkgtreediff.cabal +++ b/pkgtreediff.cabal @@ -1,7 +1,7 @@ cabal-version: 1.18 name: pkgtreediff -version: 0.4.1 -synopsis: Package tree diff tool +version: 0.5.0 +synopsis: RPM package tree diff tool description: Tool for comparing RPM packages and versions in OS dist trees or instances. homepage: https://github.com/juhp/pkgtreediff bug-reports: https://github.com/juhp/pkgtreediff/issues @@ -15,7 +15,7 @@ extra-doc-files: README.md , CHANGELOG.md , TODO -tested-with: GHC == 8.8.4, GHC == 8.10.4, +tested-with: GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.1 GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5 source-repository head @@ -37,11 +37,14 @@ , http-client-tls , http-directory >= 0.1.4 && (< 0.1.6 || >= 0.1.8) , pkgtreediff + , rpm-nvr , simple-cmd >= 0.1.4 , simple-cmd-args , text if impl(ghc<8.0) build-depends: semigroups + if impl(ghc<8.4) + build-depends: http-common < 0.8.3.4 ghc-options: -Wall -threaded default-language: Haskell2010 @@ -52,9 +55,22 @@ hs-source-dirs: src build-depends: base < 5 - , text + , rpm-nvr >= 0.1.1 if impl(ghc<8.0) build-depends: semigroups - ghc-options: -Wall default-language: Haskell2010 + ghc-options: -Wall + if impl(ghc >= 8.0) + ghc-options: -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -Wredundant-constraints + if impl(ghc >= 8.2) + ghc-options: -fhide-source-paths + if impl(ghc >= 8.4) + ghc-options: -Wmissing-export-lists + -Wpartial-fields + if impl(ghc >= 8.10) + ghc-options: -Wunused-packages diff --git a/src/Distribution/RPM/PackageTreeDiff.hs b/src/Distribution/RPM/PackageTreeDiff.hs --- a/src/Distribution/RPM/PackageTreeDiff.hs +++ b/src/Distribution/RPM/PackageTreeDiff.hs @@ -1,18 +1,11 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -- | A library for pkgtreediff for comparing trees of rpm packages module Distribution.RPM.PackageTreeDiff - (RpmPackage(..), - readRpmPkg, - showRpmPkg, - rpmPkgIdent, - appendArch, - dropRpmArch, - rpmPkgVerRel, - RpmPackageDiff(..), + (NVRA(..), + readNVRA, + RPMPkgDiff(..), diffPkgs, - diffPkg, Ignore(..), Mode(..), ) where @@ -20,16 +13,19 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif -import Data.Char -import Data.Maybe -#if !MIN_VERSION_base(4,11,0) -import Data.Semigroup ((<>)) -#endif -import Data.Text (Text) -import qualified Data.Text as T +import Data.RPM.VerRel +import Data.RPM.NVRA +import Data.RPM.VerCmp (rpmVerCompare) -- | Mode describes the kind of summary generated by compareDirs -data Mode = AutoSummary | NoSummary | ShowSummary | Added | Deleted | Updated | RST +data Mode = AutoSummary + | NoSummary + | ShowSummary + | Added + | Deleted + | Updated + | Downgraded + | RST deriving Eq -- | Ignore describes how comparison is done @@ -38,134 +34,39 @@ | IgnoreVersion -- ^ ignore differences in version deriving Eq -type Name = Text -type Arch = Text - -data VersionRelease = VerRel Text Text - deriving Eq - -instance Ord VersionRelease where - compare (VerRel v1 r1) (VerRel v2 r2) = - case rpmVerCompare v1 v2 of - EQ -> rpmVerCompare r1 r2 - o -> o - -data VerChunk = TildeChunk Int | CaretChunk Int | TxtChunk Text | IntChunk Int - deriving (Eq,Ord,Show) - -data RpmCharCategory = RpmTilde | RpmCaret | RpmOther | RpmLatin | RpmDigit - deriving Eq - -verChunk :: Text -> VerChunk -verChunk t | T.all isDigit t = (IntChunk . read . T.unpack) t -verChunk t | T.all (== '~') t = (TildeChunk . T.length) t -verChunk t | T.all (== '^') t = (CaretChunk . T.length) t -verChunk t = TxtChunk t - -rpmVerCompare :: Text -> Text -> Ordering -rpmVerCompare v1 v2 | v1 == v2 = EQ -rpmVerCompare v1 v2 = - compareChunks (verList v1) (verList v2) - where - compareChunks [] [] = EQ - compareChunks (c:cs) (c':cs') | c == c' = compareChunks cs cs' - compareChunks ((TildeChunk n):_) ((TildeChunk n'):_) = compare n' n - compareChunks ((CaretChunk n):_) ((CaretChunk n'):_) = compare n' n - compareChunks ((TildeChunk _):_) _ = LT - compareChunks _ ((TildeChunk _):_) = GT - compareChunks ((CaretChunk _):_) _ = LT - compareChunks _ ((CaretChunk _):_) = GT - compareChunks _ [] = GT - compareChunks [] _ = LT - compareChunks (c:_) (c':_) = compare c c' - -verList :: Text -> [VerChunk] -verList = map verChunk . filter (T.all (/= '.')) . T.groupBy (\ c1 c2 -> rpmCategory c1 == rpmCategory c2) - -latinChars :: [Char] -latinChars = ['A'..'Z'] ++ ['a'..'z'] - -rpmCategory :: Char -> RpmCharCategory -rpmCategory c | isDigit c = RpmDigit -rpmCategory c | c `elem` latinChars = RpmLatin -rpmCategory '~' = RpmTilde -rpmCategory '^' = RpmCaret -rpmCategory _ = RpmOther - --- eqVR True ignore release -eqVR :: Ignore -> VersionRelease -> VersionRelease -> Bool -eqVR IgnoreNone vr vr' = vr == vr' -eqVR IgnoreRelease (VerRel v _) (VerRel v' _) = v == v' -eqVR IgnoreVersion _ _ = True - --- | Text for the version-release of an RpmPackage -rpmPkgVerRel :: RpmPackage -> Text -rpmPkgVerRel = txtVerRel . rpmVerRel - where - txtVerRel (VerRel v r) = v <> T.singleton '-' <> r - --- | RPM package with name, version-release, and maybe architecture -data RpmPackage = RpmPkg {rpmName :: Name, rpmVerRel :: VersionRelease, rpmMArch :: Maybe Arch} - deriving (Eq, Ord) - --- | Text identifier for an RPM package identified by name and arch -rpmPkgIdent :: RpmPackage -> Text -rpmPkgIdent p = rpmName p <> appendArch p - --- | Helper to add an arch suffix -appendArch :: RpmPackage -> Text -appendArch p = maybe "" ("." <>) (rpmMArch p) - --- | drop arch from RpmPackage -dropRpmArch :: RpmPackage -> RpmPackage -dropRpmArch (RpmPkg n vr _) = RpmPkg n vr Nothing - --- | Render an RpmPackage -showRpmPkg :: RpmPackage -> Text -showRpmPkg p = rpmPkgIdent p <> T.pack " " <> rpmPkgVerRel p - --- | Parse an RpmPackage -readRpmPkg :: Text -> RpmPackage -readRpmPkg t = - if compnts < 3 then error $ "Malformed rpm package name: " ++ T.unpack t - else RpmPkg name (VerRel ver rel) (Just arch) - where - compnts = length pieces - (nvr',arch) = T.breakOnEnd "." $ fromMaybe t $ T.stripSuffix ".rpm" t - pieces = reverse $ T.splitOn "-" $ T.dropEnd 1 nvr' - (rel:ver:emaN) = pieces - name = T.intercalate "-" $ reverse emaN - --- | RpmPackageDiff type encodes how a particular rpm package differs between trees -data RpmPackageDiff = PkgUpdate RpmPackage RpmPackage - | PkgAdd RpmPackage - | PkgDel RpmPackage - | PkgArch RpmPackage RpmPackage +-- | RPMPkgDiff type encodes how a particular rpm package differs between trees +data RPMPkgDiff = PkgUpdate NVRA NVRA + | PkgDowngrade NVRA NVRA + | PkgAdd NVRA + | PkgDel NVRA + | PkgArch NVRA NVRA deriving Eq --- | Compare two lists of packages NVRs -diffPkgs :: Ignore -> [RpmPackage] -> [RpmPackage] -> [RpmPackageDiff] +-- | Compare two lists of packages NVRAs +diffPkgs :: Ignore -> [NVRA] -> [NVRA] -> [RPMPkgDiff] diffPkgs _ [] [] = [] diffPkgs ignore (p:ps) [] = PkgDel p : diffPkgs ignore ps [] diffPkgs ignore [] (p:ps) = PkgAdd p : diffPkgs ignore [] ps diffPkgs ignore (p1:ps1) (p2:ps2) = - case compareNames p1 p2 of + case compare (rpmName p1) (rpmName p2) of LT -> PkgDel p1 : diffPkgs ignore ps1 (p2:ps2) - EQ -> let diff = diffPkg ignore p1 p2 - diffs = diffPkgs ignore ps1 ps2 - in if isJust diff then fromJust diff : diffs else diffs + EQ -> case diffPkg of + Just diff -> (diff :) + Nothing -> id + $ diffPkgs ignore ps1 ps2 GT -> PkgAdd p2 : diffPkgs ignore (p1:ps1) ps2 - --- | Compare two rpms of a package -diffPkg :: Ignore -> RpmPackage-> RpmPackage-> Maybe RpmPackageDiff -diffPkg ignore p1 p2 | rpmPkgIdent p1 == rpmPkgIdent p2 = - if eqVR ignore (rpmVerRel p1) (rpmVerRel p2) - then Nothing - else Just $ PkgUpdate p1 p2 ---diffPkg ignore p1 p2 | rpmName p1 == rpmName p2 = --- diffPkg ignore True (RpmPkg n1 v1) (RpmPkg n2 v2) -diffPkg _ p1 p2 | rpmName p1 == rpmName p2 && rpmPkgIdent p1 /= rpmPkgIdent p2 = Just $ PkgArch p1 p2 -diffPkg _ _ _ = Nothing + where + diffPkg :: Maybe RPMPkgDiff + diffPkg = + if rpmArch p1 == rpmArch p2 + then case cmpVR ignore (rpmVerRel p1) (rpmVerRel p2) of + LT -> Just $ PkgUpdate p1 p2 + EQ -> Nothing + GT -> Just $ PkgDowngrade p1 p2 + else Just $ PkgArch p1 p2 -compareNames :: RpmPackage -> RpmPackage -> Ordering -compareNames p1 p2 = compare (rpmName p1) (rpmName p2) +-- cmpVR True ignore release +cmpVR :: Ignore -> VerRel -> VerRel -> Ordering +cmpVR IgnoreNone vr vr' = compare vr vr' +cmpVR IgnoreRelease (VerRel v _) (VerRel v' _) = rpmVerCompare v v' +cmpVR IgnoreVersion _ _ = EQ diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -14,12 +14,11 @@ import Control.Monad.Extra (concatMapM) import Data.List import Data.Maybe +import Data.RPM.NVRA #if !MIN_VERSION_base(4,11,0) import Data.Semigroup ((<>)) #endif -import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Text.IO as T import Network.HTTP.Client (managerResponseTimeout, newManager, responseTimeoutMicro) import Network.HTTP.Client.TLS (tlsManagerSettings) @@ -48,7 +47,7 @@ main = simpleCmdArgs (Just version) "Package tree comparison tool" "pkgtreediff compares the packages in two OS trees or instances" $ - compareDirs <$> recursiveOpt <*> ignoreVR <*> ignoreArch <*> modeOpt <*> optional patternOpt <*> timeoutOpt <*> sourceArg "1" <*> sourceArg "2" + compareDirs <$> recursiveOpt <*> optional subdirOpt <*> ignoreVR <*> modeOpt <*> optional patternOpt <*> timeoutOpt <*> sourceArg "1" <*> sourceArg "2" where sourceArg :: String -> Parser String sourceArg pos = strArg ("URL|DIR|FILE|KOJITAG|CMD" <> pos) @@ -57,13 +56,14 @@ modeOpt = flagWith' Added 'N' "new" "Show only added packages" <|> flagWith' Deleted 'D' "deleted" "Show only removed packages" <|> - flagWith' Updated 'U' "updated" "Show only updated packages" <|> + flagWith' Updated 'U' "updated" "Show only upgraded packages" <|> + flagWith' Downgraded 'u' "downgraded" "Show only downgraded packages" <|> flagWith' ShowSummary 's' "show-summary" ("Show summary of changes (default when >" <> show summaryThreshold <> " changes)") <|> flagWith' RST 'R' "rst" "Print summary in ReSTructured Text format" <|> flagWith AutoSummary NoSummary 'S' "no-summary" "Do not display summary" - ignoreArch :: Parser Bool - ignoreArch = switchWith 'A' "ignore-arch" "Ignore arch differences" + -- ignoreArch :: Parser Bool + -- ignoreArch = switchWith 'A' "ignore-arch" "Ignore arch differences" ignoreVR :: Parser Ignore ignoreVR = @@ -73,6 +73,9 @@ recursiveOpt :: Parser Bool recursiveOpt = switchWith 'r' "recursive" "Recursive down into subdirectories" + subdirOpt :: Parser String + subdirOpt = strOptionWith 'd' "subdir" "SUBDIR" "Select specific subdir (eg x86_64 or source)" + patternOpt :: Parser String patternOpt = strOptionWith 'p' "pattern" "PKGPATTERN" "Limit packages to glob matches" @@ -117,12 +120,12 @@ isHttp loc = "http:" `isPrefixOf` loc || "https:" `isPrefixOf` loc -- | Frontend for the pkgtreediff tool -compareDirs :: Bool -> Ignore -> Bool -> Mode -> Maybe String -> Int -> String -> String -> IO () -compareDirs recursive ignore igArch mode mpattern timeout tree1 tree2 = do +compareDirs :: Bool -> Maybe String -> Ignore -> Mode -> Maybe String -> Int -> String -> String -> IO () +compareDirs recursive msubdir ignore mode mpattern timeout tree1 tree2 = do (ps1,ps2) <- getTrees tree1 tree2 let diff = diffPkgs ignore ps1 ps2 if mode /= RST - then mapM_ T.putStrLn . mapMaybe (showPkgDiff mode) $ diff + then mapM_ putStrLn . mapMaybe (showPkgDiff mode) $ diff else printRST diff when (mode /= NoSummary && isDefault mode) $ when (mode == ShowSummary || length diff > summaryThreshold) $ do @@ -130,6 +133,7 @@ (if mode /= RST then putStrLn else printRSTHeader) "Summary" let diffsum = summary diff putStrLn $ "Updated: " <> show (updateSum diffsum) + putStrLn $ "Downgraded: " <> show (downgradeSum diffsum) putStrLn $ "Added: " <> show (newSum diffsum) putStrLn $ "Deleted: " <> show (delSum diffsum) putStrLn $ "Arch changed: " <> show (archSum diffsum) @@ -140,16 +144,19 @@ putStrLn name putStrLn $ replicate (length name) '~' putStrLn "" - printRSTElem = T.putStrLn . mappend "- " - printRSTDiffElem = printRSTElem . T.drop 2 + printRSTElem = putStrLn . mappend "- " + printRSTDiffElem = printRSTElem . drop 2 printRST diff = do printRSTHeader "Updated" mapM_ printRSTElem $ mapMaybe (showPkgDiff mode) [x | x@(PkgUpdate _ _) <- diff] + printRSTHeader "Downgraded" + mapM_ printRSTElem $ mapMaybe (showPkgDiff mode) [x | x@(PkgDowngrade _ _) <- diff] printRSTHeader "Added" mapM_ printRSTDiffElem $ mapMaybe (showPkgDiff mode) [x | x@(PkgAdd _) <- diff] printRSTHeader "Removed" mapM_ printRSTDiffElem $ mapMaybe (showPkgDiff mode) [x | x@(PkgDel _) <- diff] - getTrees :: String -> String -> IO ([RpmPackage],[RpmPackage]) + + getTrees :: String -> String -> IO ([NVRA],[NVRA]) getTrees t1 t2 = do when (t1 == t2) $ warning "Comparing the same tree!" src1 <- sourceType t1 @@ -168,6 +175,7 @@ return (ps1,ps2) else concurrently act1 act2 + readPackages :: SourceType -> Maybe Manager -> String -> IO [NVRA] readPackages source mmgr loc = do fs <- case source of URL -> httpPackages True (fromJust mmgr) loc @@ -175,73 +183,87 @@ Dir -> dirPackages True loc File -> filePackages loc Cmd -> cmdPackages $ words loc - let ps = map ((if igArch then dropRpmArch else id) . readRpmPkg) $ filter (maybe (const True) (match . compile) mpattern . T.unpack) fs + let ps = map readNVRA $ filter (maybe (const True) (match . compile) mpattern) fs return $ sort (nub ps) + httpPackages :: Bool -> Manager -> String -> IO [String] httpPackages recurse mgr url = do exists <- httpExists mgr url fs <- if exists - then filter (\ f -> "/" `T.isSuffixOf` f || ".rpm" `T.isSuffixOf` f) <$> httpDirectory mgr url + then map T.unpack . filter (\ f -> "/" `T.isSuffixOf` f || ".rpm" `T.isSuffixOf` f) <$> httpDirectory mgr url else error' $ "Could not get " <> url - if (recurse || recursive) && all isDir fs then concatMapM (httpPackages False mgr) (map ((url ) . T.unpack) fs) else return $ filter (not . isDir) fs + if (recurse || recursive) && all isDir fs then concatMapM (httpPackages False mgr) (map (url ) (filterSubdir fs)) else return $ filter (not . isDir) fs + filterSubdir :: [String] -> [String] + filterSubdir fs = + case msubdir of + Just subdir | (subdir <> "/") `elem` fs -> [subdir] + _ -> fs + dirPackages recurse dir = do -- can replace with listDirectory after dropping ghc7 -- should really filter out ".rpm" though not common fs <- sort . filter (".rpm" `isSuffixOf`) <$> getDirectoryContents dir alldirs <- mapM doesDirectoryExist fs - if (recurse || recursive) && and alldirs then concatMapM (dirPackages False) (map (dir ) fs) else return $ filter (not . isDir) $ map T.pack fs + if (recurse || recursive) && and alldirs then concatMapM (dirPackages False) (map (dir ) (filterSubdir fs)) else return $ filter (not . isDir) fs - isDir = ("/" `T.isSuffixOf`) + isDir = ("/" `isSuffixOf`) filePackages file = - filter (not . T.isPrefixOf (T.pack "gpg-pubkey-")) . T.words <$> T.readFile file + filter (not . isPrefixOf "gpg-pubkey-") . words <$> readFile file cmdPackages [] = error' "No command prefix given" cmdPackages (c:args) = -- use words since container seems to append '\r' - filter (not . T.isPrefixOf (T.pack "gpg-pubkey-")) . T.words . T.pack <$> cmd c args + filter (not . isPrefixOf "gpg-pubkey-") . words <$> cmd c args - kojiPackages (tag, kojiUrl) = map (T.pack . Koji.kbNvr) <$> Koji.kojiListTaggedBuilds kojiUrl True tag + kojiPackages (tag, kojiUrl) = map Koji.kbNvr <$> Koji.kojiListTaggedBuilds kojiUrl True tag isDefault :: Mode -> Bool isDefault m = m `elem` [AutoSummary, NoSummary, ShowSummary, RST] -showPkgDiff :: Mode -> RpmPackageDiff -> Maybe Text -showPkgDiff Added (PkgAdd p) = Just $ showRpmPkg p -showPkgDiff Deleted (PkgDel p) = Just $ showRpmPkg p -showPkgDiff Updated (PkgUpdate p1 p2) = Just $ showPkgUpdate p1 p2 -showPkgDiff Updated (PkgArch p1 p2) = Just $ showArchChange p1 p2 -showPkgDiff mode (PkgAdd p) | isDefault mode = Just $ "+ " <> showRpmPkg p -showPkgDiff mode (PkgDel p) | isDefault mode = Just $ "- " <> showRpmPkg p -showPkgDiff mode (PkgUpdate p1 p2) | isDefault mode = Just $ showPkgUpdate p1 p2 -showPkgDiff mode (PkgArch p1 p2) | isDefault mode = Just $ "! " <> showArchChange p1 p2 -showPkgDiff _ _ = Nothing - -showPkgUpdate :: RpmPackage -> RpmPackage -> Text -showPkgUpdate p p' = - rpmPkgIdent p <> ": " <> rpmPkgVerRel p <> " -> " <> rpmPkgVerRel p' - -showArchChange :: RpmPackage -> RpmPackage -> Text -showArchChange p p' = - rpmName p <> ": " <> rpmDetails p <> " -> " <> rpmDetails p' +showPkgDiff :: Mode -> RPMPkgDiff -> Maybe String +showPkgDiff mode diff = + case (mode,diff) of + (Added, PkgAdd p) -> Just $ showNVRA p + (Deleted, PkgDel p) -> Just $ showNVRA p + (Updated, PkgUpdate p1 p2) -> Just $ showPkgChange p1 p2 + (Updated, PkgArch p1 p2) -> Just $ showArchChange p1 p2 + (Downgraded, PkgDowngrade p1 p2) -> Just $ showPkgChange p1 p2 + _ -> if isDefault mode + then case diff of + PkgAdd p -> Just $ "+ " <> showNVRA p + PkgDel p -> Just $ "- " <> showNVRA p + PkgUpdate p1 p2 -> Just $ showPkgChange p1 p2 + PkgDowngrade p1 p2 -> Just $ "~ " <> showPkgChange p1 p2 + PkgArch p1 p2 -> Just $ "! " <> showArchChange p1 p2 + else Nothing where - rpmDetails :: RpmPackage -> Text - rpmDetails pkg = rpmPkgVerRel pkg <> appendArch pkg + showPkgChange :: NVRA -> NVRA -> String + showPkgChange p p' = + showPkgIdent p <> ": " <> showPkgVerRel p <> " -> " <> showPkgVerRel p' -data DiffSum = DS {updateSum, newSum, delSum, archSum :: Int} + showArchChange :: NVRA -> NVRA -> String + showArchChange p p' = + rpmName p <> ": " <> rpmDetails p <> " -> " <> rpmDetails p' + where + rpmDetails :: NVRA -> String + rpmDetails pkg = showPkgVerRel pkg <> "." <> rpmArch pkg +data DiffSum = DS {updateSum, downgradeSum, newSum, delSum, archSum :: Int} + emptyDS :: DiffSum -emptyDS = DS 0 0 0 0 +emptyDS = DS 0 0 0 0 0 -summary :: [RpmPackageDiff] -> DiffSum +summary :: [RPMPkgDiff] -> DiffSum summary = foldl' countDiff emptyDS where - countDiff :: DiffSum -> RpmPackageDiff -> DiffSum + countDiff :: DiffSum -> RPMPkgDiff -> DiffSum countDiff ds pd = case pd of PkgUpdate {} -> ds {updateSum = updateSum ds + 1} + PkgDowngrade {} -> ds {downgradeSum = downgradeSum ds + 1} PkgAdd _ -> ds {newSum = newSum ds + 1} PkgDel _ -> ds {delSum = delSum ds + 1} PkgArch {} -> ds {archSum = archSum ds + 1}