diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Changelog +## 0.4.1 (2021-04-19) +- expose a library in Distribution.RPM.PackageTreeDiff (@juhp) +- full correct rpm version comparison (ie handling ^ and ~) (@juhp) +- new koji://tag@koji.hub method (@TristanCacqueray) +- rst summary output format (@TristanCacqueray) + ## 0.4 (2020-03-13) - support files of lists of rpms - support commands for getting package NVRs diff --git a/Main.hs b/Main.hs deleted file mode 100644 --- a/Main.hs +++ /dev/null @@ -1,324 +0,0 @@ -{-# LANGUAGE CPP #-} - -import Control.Applicative ( -#if (defined(MIN_VERSION_simple_cmd_args) && MIN_VERSION_simple_cmd_args(0,1,3)) -#else - (<|>), -#endif -#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0)) -#else - (<$>), (<*>) -#endif - ) -import Control.Concurrent.Async (concurrently) -import Control.Monad -import Data.Char -import Data.List -import Data.Maybe -#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,11,0)) -#else -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) -import Network.HTTP.Directory -import System.Directory (doesDirectoryExist, getDirectoryContents) -import System.FilePath (()) -import System.FilePath.Glob (compile, match) - -#if (defined(MIN_VERSION_simple_cmd) && MIN_VERSION_simple_cmd(0,2,0)) -#else --- for warning -import System.IO (hPutStrLn, stderr) -#endif - -import SimpleCmd (cmd, error', -#if (defined(MIN_VERSION_simple_cmd) && MIN_VERSION_simple_cmd(0,2,0)) - warning -#endif - ) -import SimpleCmdArgs - -import Paths_pkgtreediff (version) - -data Mode = AutoSummary | NoSummary | ShowSummary | Added | Deleted | Updated - deriving Eq - -data Ignore = IgnoreNone | IgnoreRelease | IgnoreVersion - deriving Eq - -main :: IO () -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 <*> strArg "URL|DIR|FILE|CMD1" <*> strArg "URL|DIR|FILE|CMD2" - where - modeOpt :: Parser Mode - 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' ShowSummary 's' "show-summary" ("Show summary of changes (default when >" <> show summaryThreshold <> " changes)") <|> - flagWith AutoSummary NoSummary 'S' "no-summary" "Do not display summary" - - ignoreArch :: Parser Bool - ignoreArch = switchWith 'A' "ignore-arch" "Ignore arch differences" - - ignoreVR :: Parser Ignore - ignoreVR = - flagWith' IgnoreRelease 'R' "ignore-release" "Only show version changes (ignore release)" <|> - flagWith IgnoreNone IgnoreVersion 'V' "ignore-version" "Only show package changes (ignore version-release)" - - recursiveOpt :: Parser Bool - recursiveOpt = switchWith 'r' "recursive" "Recursive down into subdirectories" - - patternOpt :: Parser String - patternOpt = strOptionWith 'p' "pattern" "PKGPATTERN" "Limit packages to glob matches" - - timeoutOpt :: Parser Int - timeoutOpt = optionalWith auto 't' "timeout" "SECONDS" "Maximum seconds to wait for http response before timing out (default 30)" 30 - -summaryThreshold :: Int -summaryThreshold = 20 - -data SourceType = URL | Dir | File | Cmd - deriving Eq - -sourceType :: String -> IO SourceType -sourceType s = - if isHttp s then return URL - else do - dir <- doesDirectoryExist s - if dir then return Dir - else if ' ' `elem` s then return Cmd - else return File - where - isHttp :: String -> Bool - isHttp loc = "http:" `isPrefixOf` loc || "https:" `isPrefixOf` loc - -compareDirs :: Bool -> Ignore -> Bool -> Mode -> Maybe String -> Int -> String -> String -> IO () -compareDirs recursive ignore igArch mode mpattern timeout tree1 tree2 = do - (ps1,ps2) <- getTrees tree1 tree2 - let diff = diffPkgs ignore ps1 ps2 - mapM_ T.putStrLn . mapMaybe (showPkgDiff mode) $ diff - when (mode /= NoSummary && isDefault mode) $ - when (mode == ShowSummary || length diff > summaryThreshold) $ do - putStrLn "" - putStrLn "Summary" - let diffsum = summary diff - putStrLn $ "Updated: " <> show (updateSum diffsum) - putStrLn $ "Added: " <> show (newSum diffsum) - putStrLn $ "Deleted: " <> show (delSum diffsum) - putStrLn $ "Arch changed: " <> show (archSum diffsum) - putStrLn $ "Total packages: " <> show (length ps1) <> " -> " <> show (length ps2) - where - getTrees :: String -> String -> IO ([Package],[Package]) - getTrees t1 t2 = do - when (t1 == t2) $ warning "Comparing the same tree!" - src1 <- sourceType t1 - src2 <- sourceType t2 - mmgr <- if src1 == URL || src2 == URL - then do - let ms = responseTimeoutMicro $ timeout * 1000000 - Just <$> newManager tlsManagerSettings {managerResponseTimeout = ms} - else return Nothing - let act1 = readPackages src1 mmgr t1 - act2 = readPackages src2 mmgr t2 - if (src1,src2) == (Cmd,Cmd) - then do - ps1 <- act1 - ps2 <- act2 - return (ps1,ps2) - else concurrently act1 act2 - - readPackages source mmgr loc = do - fs <- case source of - URL -> httpPackages True (fromJust mmgr) loc - Dir -> dirPackages True loc - File -> filePackages loc - Cmd -> cmdPackages $ words loc - let ps = map ((if igArch then binToPkg else id) . readPkg) $ filter (maybe (const True) (match . compile) mpattern . T.unpack) fs - return $ sort (nub ps) - - binToPkg :: Package -> Package - binToPkg (Pkg n vr _) = Pkg n vr Nothing - - 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 - 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 - - 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 - - isDir = ("/" `T.isSuffixOf`) - - filePackages file = - filter (not . T.isPrefixOf (T.pack "gpg-pubkey-")) . T.words <$> T.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 - -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 = TxtChunk Text | IntChunk Int - deriving (Eq,Ord) - -verChunk :: Text -> VerChunk -verChunk t | T.all isDigit t = (IntChunk . read . T.unpack) t -verChunk t = TxtChunk t - -rpmVerCompare :: Text -> Text -> Ordering -rpmVerCompare v1 v2 | v1 == v2 = EQ -rpmVerCompare v1 v2 = - compare (verList v1) (verList v2) - where - verList :: Text -> [VerChunk] - verList = map verChunk . filter (T.all isAlphaNum) . T.groupBy (\ c1 c2 -> generalCategory c1 == generalCategory c2) - --- 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 - -verRel :: Package -> Text -verRel = txtVerRel . pkgVerRel - where - txtVerRel (VerRel v r) = v <> "-" <> r - -data Package = Pkg {pkgName :: Name, pkgVerRel :: VersionRelease, pkgMArch :: Maybe Arch} - deriving (Eq, Ord) - -pkgIdent :: Package -> Text -pkgIdent p = pkgName p <> appendArch p - -pkgDetails :: Package -> Text -pkgDetails p = verRel p <> appendArch p - -appendArch :: Package -> Text -appendArch p = maybe "" ("." <>) (pkgMArch p) - -showPkg :: Package -> Text -showPkg p = pkgIdent p <> " " <> verRel p - -readPkg :: Text -> Package -readPkg t = - if compnts < 3 then error' $ T.unpack $ "Malformed rpm package name: " <> t - else Pkg 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 - -data PackageDiff = PkgUpdate Package Package - | PkgAdd Package - | PkgDel Package - | PkgArch Package Package - deriving Eq - -isDefault :: Mode -> Bool -isDefault m = m `elem` [AutoSummary, NoSummary, ShowSummary] - -showPkgDiff :: Mode -> PackageDiff -> Maybe Text -showPkgDiff Added (PkgAdd p) = Just $ showPkg p -showPkgDiff Deleted (PkgDel p) = Just $ showPkg 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 $ "+ " <> showPkg p -showPkgDiff mode (PkgDel p) | isDefault mode = Just $ "- " <> showPkg 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 :: Package -> Package -> Text -showPkgUpdate p p' = - pkgIdent p <> ": " <> verRel p <> " -> " <> verRel p' - -showArchChange :: Package -> Package -> Text -showArchChange p p' = - pkgName p <> ": " <> pkgDetails p <> " -> " <> pkgDetails p' - -diffPkgs :: Ignore -> [Package] -> [Package] -> [PackageDiff] -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 - 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 - GT -> PkgAdd p2 : diffPkgs ignore (p1:ps1) ps2 - -diffPkg :: Ignore -> Package-> Package-> Maybe PackageDiff -diffPkg ignore p1 p2 | pkgIdent p1 == pkgIdent p2 = - if eqVR ignore (pkgVerRel p1) (pkgVerRel p2) - then Nothing - else Just $ PkgUpdate p1 p2 ---diffPkg ignore p1 p2 | pkgName p1 == pkgName p2 = --- diffPkg ignore True (Pkg n1 v1) (Pkg n2 v2) -diffPkg _ p1 p2 | pkgName p1 == pkgName p2 && pkgIdent p1 /= pkgIdent p2 = Just $ PkgArch p1 p2 -diffPkg _ _ _ = Nothing - -compareNames :: Package -> Package -> Ordering -compareNames p1 p2 = compare (pkgName p1) (pkgName p2) - --- infixr 4 <.> --- (<.>) :: Text -> Text -> Text --- s <.> t = s <> "." <> t - -#if (defined(MIN_VERSION_simple_cmd) && MIN_VERSION_simple_cmd(0,2,0)) -#else -warning :: String -> IO () -warning = hPutStrLn stderr -#endif - --- borrowed straight from extra:Control.Monad.Extra --- | A version of 'concatMap' that works with a monadic predicate. -concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] -{-# INLINE concatMapM #-} -concatMapM op = foldr f (return []) - where f x xs = do x' <- op x; if null x' then xs else do xs' <- xs; return $ x'++xs' - -data DiffSum = DS {updateSum, newSum, delSum, archSum :: Int} - -emptyDS :: DiffSum -emptyDS = DS 0 0 0 0 - -summary :: [PackageDiff] -> DiffSum -summary = - foldl' countDiff emptyDS - where - countDiff :: DiffSum -> PackageDiff -> DiffSum - countDiff ds pd = - case pd of - PkgUpdate {} -> ds {updateSum = updateSum ds + 1} - PkgAdd _ -> ds {newSum = newSum ds + 1} - PkgDel _ -> ds {delSum = delSum ds + 1} - PkgArch {} -> ds {archSum = archSum ds + 1} diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,28 +4,30 @@ [![GPL-3 license](https://img.shields.io/badge/license-GPL--3-blue.svg)](LICENSE) [![Stackage Lts](http://stackage.org/package/pkgtreediff/badge/lts)](http://stackage.org/lts/package/pkgtreediff) [![Stackage Nightly](http://stackage.org/package/pkgtreediff/badge/nightly)](http://stackage.org/nightly/package/pkgtreediff) -[![Build status](https://secure.travis-ci.org/juhp/pkgtreediff.svg)](https://travis-ci.org/juhp/pkgtreediff) `pkgtreediff` compares the NVRs (name-version-release) of RPM packages in OS package trees and/or installations: - An OS tree can be referenced by an url or directory containing a tree of rpm files. -- A file containing a list(s) of rpm NVRs can also be compared +- A file containing a list(s) of rpm NVRs can also be compared. - Commands can also be used to get installed RPMs, eg: - `"rpm -qa"` - `"ssh myhost rpm -qa"` - `"podman run --rm myimage rpm -qa"` +- A koji tag: koji://tag@KojiHubUrl (or koji://tag@fedora) ## Usage examples ### Containers -Compare the content of two rpm based containers (new added packages in fedora:31) +Compare the content of two rpm based containers (new added packages in fedora:34) ```bash session -$ pkgtreediff --new "podman run --rm fedora:30 rpm -qa" "podman run --rm fedora:31 rpm -qa" -libgomp.x86_64 9.2.1-1.fc31 -tss2.x86_64 1331-2.fc31 -yum.noarch 4.2.9-5.fc31 +$ 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 ``` ### Package trees @@ -33,42 +35,36 @@ Package source changes between Fedora 30 and 31 Server at GA (ignoring release bumps): ```bash session -$ pkgtreediff --ignore-release https://dl.fedoraproject.org/pub/fedora/linux/releases/{30,31}/Server/source/tree/Packages/ -- 389-ds-base.src 1.4.1.2-2.fc30 -- GConf2.src 3.2.6-25.fc30 -- GeoIP.src 1.6.12-5.fc30 -- GeoIP-GeoLite-data.src 2018.06-3.fc30 -- ImageMagick.src 6.9.10.28-1.fc30 -ModemManager.src: 1.10.0-1.fc30 -> 1.10.6-2.fc31 -NetworkManager.src: 1.16.0-1.fc30 -> 1.20.4-1.fc31 -- ORBit2.src 2.14.19-21.fc30 -- OpenEXR.src 2.2.0-16.fc30 +$ 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 : -- compface.src 1.5.2-27.fc30 -- comps-extras.src 24-5.fc30 -+ conmon.src 2.0.1-1.fc31 -container-selinux.src: 2.95-1.gite3ebc68.fc30 -> 2.117.0-1.gitbfde70a.fc31 -- container-storage-setup.src 0.11.0-5.dev.git413b408.fc30 -+ containerd.src 1.2.6-2.20190627gitd68b593.fc31 +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 : : -zchunk.src: 1.1.1-3.fc30 -> 1.1.2-3.fc31 -zd1211-firmware.src: 1.5-4.fc30 -> 1.5-5.fc31 -- zerofree.src 1.1.1-3.fc30 -- zfs-fuse.src 0.7.2.2-11.fc30 -- zile.src 2.4.14-3.fc30 -zip.src: 3.0-24.fc30 -> 3.0-25.fc31 -zlib.src: 1.2.11-15.fc30 -> 1.2.11-19.fc31 -zram.src: 0.3-1.fc30 -> 0.4-1.fc31 -zstd.src: 1.3.8-2.fc30 -> 1.4.2-1.fc31 -- zziplib.src 0.13.69-5.fc30 +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 Summary -Updated: 918 -Added: 17 -Deleted: 765 +Updated: 340 +Added: 27 +Deleted: 32 Arch changed: 0 -Total packages: 1690 -> 942 +Total packages: 937 -> 932 ``` ### Hosts @@ -81,9 +77,29 @@ Any types of sources can be compared, together with the use of flags. +### Koji + +Compare koji tags using the `koji://tag@kojihub` syntax: + +``` +pkgtreediff koji://dist-c8-updates-build@centos koji://dist-c8_1-updates-build@centos +``` + +Please avoid using koji tag to compare full releases as it is more efficient to +query URL or CMD trees. + ## Builds +pkgtreediff is packaged in Fedora. -Builds are available in +Older builds are also available in [copr](https://copr.fedorainfracloud.org/coprs/petersen/pkgtreediff/) for Fedora, EPEL, and OpenSuSE ([more details](https://copr.fedorainfracloud.org/coprs/petersen/pkgtreediff/monitor/detailed)). + +## RPM version ordering +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. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -1,9 +1,9 @@ - compare buildsys list-tagged packages... -- refactor to library - compare with installed packages (--installed?) - deb trees? - compare container images, ostrees - --ignore-disttag - massage fedora mirror urls - +- support epochs in file package list +- diff isos - "--query-format" diff --git a/pkgtreediff.cabal b/pkgtreediff.cabal --- a/pkgtreediff.cabal +++ b/pkgtreediff.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: pkgtreediff -version: 0.4 +version: 0.4.1 synopsis: Package tree diff tool description: Tool for comparing RPM packages and versions in OS dist trees or instances. homepage: https://github.com/juhp/pkgtreediff @@ -9,38 +9,52 @@ license-file: LICENSE author: Jens Petersen maintainer: juhpetersen@gmail.com -copyright: 2019-2020 Jens Petersen -category: Util +copyright: 2019-2021 Jens Petersen +category: Utility build-type: Simple extra-doc-files: README.md , CHANGELOG.md , TODO -tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, - GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3 +tested-with: GHC == 8.8.4, GHC == 8.10.4, + GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5 source-repository head type: git location: https://github.com/juhp/pkgtreediff.git executable pkgtreediff - main-is: Main.hs + main-is: src/Main.hs other-modules: Paths_pkgtreediff build-depends: async , base < 5 , directory + , extra , filepath + , koji , Glob , http-client >= 0.5.0 , http-client-tls , http-directory >= 0.1.4 && (< 0.1.6 || >= 0.1.8) + , pkgtreediff , simple-cmd >= 0.1.4 , simple-cmd-args , text if impl(ghc<8.0) build-depends: semigroups - ghc-options: -Wall + ghc-options: -Wall -threaded + default-language: Haskell2010 +library + build-depends: base < 5 + exposed-modules: Distribution.RPM.PackageTreeDiff + hs-source-dirs: src + + build-depends: base < 5 + , text + if impl(ghc<8.0) + build-depends: semigroups + + ghc-options: -Wall default-language: Haskell2010 - default-extensions: OverloadedStrings diff --git a/src/Distribution/RPM/PackageTreeDiff.hs b/src/Distribution/RPM/PackageTreeDiff.hs new file mode 100644 --- /dev/null +++ b/src/Distribution/RPM/PackageTreeDiff.hs @@ -0,0 +1,171 @@ +{-# 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(..), + diffPkgs, + diffPkg, + Ignore(..), + Mode(..), + ) where + +#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 + +-- | Mode describes the kind of summary generated by compareDirs +data Mode = AutoSummary | NoSummary | ShowSummary | Added | Deleted | Updated | RST + deriving Eq + +-- | Ignore describes how comparison is done +data Ignore = IgnoreNone -- ^ do not ignore version or release + | IgnoreRelease -- ^ ignore differences in release + | 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 + deriving Eq + +-- | Compare two lists of packages NVRs +diffPkgs :: Ignore -> [RpmPackage] -> [RpmPackage] -> [RpmPackageDiff] +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 + 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 + 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 + +compareNames :: RpmPackage -> RpmPackage -> Ordering +compareNames p1 p2 = compare (rpmName p1) (rpmName p2) diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,252 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +import Control.Applicative ( +#if !MIN_VERSION_simple_cmd_args(0,1,3) + (<|>), +#endif +#if !MIN_VERSION_base(4,8,0) + (<$>), (<*>) +#endif + ) +import Control.Concurrent.Async (concurrently) +import Control.Monad +import Control.Monad.Extra (concatMapM) +import Data.List +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 qualified Data.Text.IO as T +import Network.HTTP.Client (managerResponseTimeout, newManager, + responseTimeoutMicro) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import Network.HTTP.Directory +import SimpleCmdArgs +import System.Directory (doesDirectoryExist, getDirectoryContents) +import System.FilePath (()) +import System.FilePath.Glob (compile, match) +#if !MIN_VERSION_simple_cmd(0,2,0) +-- for warning +import System.IO (hPutStrLn, stderr) +#endif + +import SimpleCmd (cmd, error', +#if MIN_VERSION_simple_cmd(0,2,0) + warning +#endif + ) + +import qualified Distribution.Koji as Koji + +import Distribution.RPM.PackageTreeDiff +import Paths_pkgtreediff (version) + +main :: IO () +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" + where + sourceArg :: String -> Parser String + sourceArg pos = strArg ("URL|DIR|FILE|KOJITAG|CMD" <> pos) + + modeOpt :: Parser Mode + 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' 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" + + ignoreVR :: Parser Ignore + ignoreVR = + flagWith' IgnoreRelease 'R' "ignore-release" "Only show version changes (ignore release)" <|> + flagWith IgnoreNone IgnoreVersion 'V' "ignore-version" "Only show package changes (ignore version-release)" + + recursiveOpt :: Parser Bool + recursiveOpt = switchWith 'r' "recursive" "Recursive down into subdirectories" + + patternOpt :: Parser String + patternOpt = strOptionWith 'p' "pattern" "PKGPATTERN" "Limit packages to glob matches" + + timeoutOpt :: Parser Int + timeoutOpt = optionalWith auto 't' "timeout" "SECONDS" "Maximum seconds to wait for http response before timing out (default 30)" 30 + +-- | The threshold for the number of differences for compareDirs to auto-output a summary +summaryThreshold :: Int +summaryThreshold = 20 + +data SourceType = URL | Tag | Dir | File | Cmd + deriving Eq + +-- >>> kojiUrlTag "koji://tag@fedora" +-- Just ("tag", "https://koji.fedoraproject.org/kojihub") +kojiUrlTag :: String -> Maybe (String, String) +kojiUrlTag s = if not (isKojiScheme s) + then Nothing + else case elemIndex '@' s of + Just pos -> Just (drop (length kojiScheme) $ take pos s, hubUrl $ drop (pos+1) s) + Nothing -> Nothing + where + kojiScheme = "koji://" + isKojiScheme loc = kojiScheme `isPrefixOf` loc + hubUrl "fedora" = Koji.fedoraKojiHub + hubUrl "centos" = Koji.centosKojiHub + hubUrl loc = loc + +sourceType :: String -> IO SourceType +sourceType s + | isHttp s = return URL + | isKoji s = return Tag + | otherwise = do + dir <- doesDirectoryExist s + if dir then return Dir + else if ' ' `elem` s then return Cmd + else return File + where + isKoji :: String -> Bool + isKoji loc = isJust (kojiUrlTag loc) + isHttp :: String -> Bool + 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 + (ps1,ps2) <- getTrees tree1 tree2 + let diff = diffPkgs ignore ps1 ps2 + if mode /= RST + then mapM_ T.putStrLn . mapMaybe (showPkgDiff mode) $ diff + else printRST diff + when (mode /= NoSummary && isDefault mode) $ + when (mode == ShowSummary || length diff > summaryThreshold) $ do + putStrLn "" + (if mode /= RST then putStrLn else printRSTHeader) "Summary" + let diffsum = summary diff + putStrLn $ "Updated: " <> show (updateSum diffsum) + putStrLn $ "Added: " <> show (newSum diffsum) + putStrLn $ "Deleted: " <> show (delSum diffsum) + putStrLn $ "Arch changed: " <> show (archSum diffsum) + putStrLn $ "Total packages: " <> show (length ps1) <> " -> " <> show (length ps2) + where + printRSTHeader name = do + putStrLn "" + putStrLn name + putStrLn $ replicate (length name) '~' + putStrLn "" + printRSTElem = T.putStrLn . mappend "- " + printRSTDiffElem = printRSTElem . T.drop 2 + printRST diff = do + printRSTHeader "Updated" + mapM_ printRSTElem $ mapMaybe (showPkgDiff mode) [x | x@(PkgUpdate _ _) <- 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 t1 t2 = do + when (t1 == t2) $ warning "Comparing the same tree!" + src1 <- sourceType t1 + src2 <- sourceType t2 + mmgr <- if src1 == URL || src2 == URL + then do + let ms = responseTimeoutMicro $ timeout * 1000000 + Just <$> newManager tlsManagerSettings {managerResponseTimeout = ms} + else return Nothing + let act1 = readPackages src1 mmgr t1 + act2 = readPackages src2 mmgr t2 + if (src1,src2) == (Cmd,Cmd) + then do + ps1 <- act1 + ps2 <- act2 + return (ps1,ps2) + else concurrently act1 act2 + + readPackages source mmgr loc = do + fs <- case source of + URL -> httpPackages True (fromJust mmgr) loc + Tag -> kojiPackages (fromJust (kojiUrlTag loc)) + 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 + return $ sort (nub ps) + + 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 + 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 + + 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 + + isDir = ("/" `T.isSuffixOf`) + + filePackages file = + filter (not . T.isPrefixOf (T.pack "gpg-pubkey-")) . T.words <$> T.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 + + kojiPackages (tag, kojiUrl) = map (T.pack . 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' + where + rpmDetails :: RpmPackage -> Text + rpmDetails pkg = rpmPkgVerRel pkg <> appendArch pkg + +data DiffSum = DS {updateSum, newSum, delSum, archSum :: Int} + +emptyDS :: DiffSum +emptyDS = DS 0 0 0 0 + +summary :: [RpmPackageDiff] -> DiffSum +summary = + foldl' countDiff emptyDS + where + countDiff :: DiffSum -> RpmPackageDiff -> DiffSum + countDiff ds pd = + case pd of + PkgUpdate {} -> ds {updateSum = updateSum ds + 1} + PkgAdd _ -> ds {newSum = newSum ds + 1} + PkgDel _ -> ds {delSum = delSum ds + 1} + PkgArch {} -> ds {archSum = archSum ds + 1} + +#if !MIN_VERSION_simple_cmd(0,2,0) +warning :: String -> IO () +warning = hPutStrLn stderr +#endif