diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,15 @@ # Changelog -## 0.3 (2019-06-xx) +## 0.4 (2020-03-13) +- support files of lists of rpms +- support commands for getting package NVRs + - to run "rpm -qa" etc, locally or remotely + - note commands must be quoted and include a space to be recognized +- fix sorting of packages by rpmvercmp() style ordering (#3) + (fixes cumulative trees like CentOS for example) +- add --timeout option for http (#1) + +## 0.3 (2019-06-06) - add --pattern for href filename globbing - use http-directory-0.1.4 for httpDirectory basic filtering diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -1,13 +1,18 @@ {-# LANGUAGE CPP #-} -import Control.Applicative ((<|>) +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)) @@ -18,57 +23,86 @@ 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, listDirectory) +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 (error', {-warning-}) +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) -main :: IO () -main = - simpleCmdArgs (Just version) "Package tree comparison tool" - "pkgtreediff compares the packages in two OS trees" $ - compareDirs <$> recursiveOpt <*> ignoreVR <*> ignoreArch <*> modeOpt <*> optional patternOpt <*> strArg "URL/DIR1" <*> strArg "URL/DIR2" - data Mode = AutoSummary | NoSummary | ShowSummary | Added | Deleted | Updated deriving Eq -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" - data Ignore = IgnoreNone | IgnoreRelease | IgnoreVersion deriving Eq -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)" +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" -recursiveOpt :: Parser Bool -recursiveOpt = switchWith 'r' "recursive" "Recursive down into subdirectories" + ignoreArch :: Parser Bool + ignoreArch = switchWith 'A' "ignore-arch" "Ignore arch differences" -patternOpt :: Parser String -patternOpt = strOptionWith 'p' "pattern" "PKGPATTERN" "Limit out to package glob matches" + 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 -compareDirs :: Bool -> Ignore -> Bool -> Mode -> Maybe String -> String -> String -> IO () -compareDirs recursive ignore igArch mode mpattern tree1 tree2 = do +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 @@ -86,12 +120,28 @@ getTrees :: String -> String -> IO ([Package],[Package]) getTrees t1 t2 = do when (t1 == t2) $ warning "Comparing the same tree!" - let (isUrl1,isUrl2) = (isHttp t1, isHttp t2) - mmgr <- if isUrl1 || isUrl2 then Just <$> httpManager else return Nothing - concurrently (readPackages isUrl1 mmgr t1) (readPackages isUrl2 mmgr t2) + 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 isUrl mmgr loc = do - fs <- (if isUrl then httpPackages True (fromJust mmgr) else dirPackages True) loc + 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) @@ -106,21 +156,49 @@ 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 - fs <- sort . filter (".rpm" `isSuffixOf`) <$> listDirectory dir + -- 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 - isHttp :: String -> Bool - isHttp loc = "http:" `isPrefixOf` loc || "https:" `isPrefixOf` loc - 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' @@ -215,9 +293,11 @@ -- (<.>) :: Text -> Text -> Text -- s <.> t = s <> "." <> t --- from simple-cmd-0.2.0 +#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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,57 +6,80 @@ [![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) -## Usage example +`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 +- Commands can also be used to get installed RPMs, eg: + - `"rpm -qa"` + - `"ssh myhost rpm -qa"` + - `"podman run --rm myimage rpm -qa"` + +## Usage examples + +### Containers + +Compare the content of two rpm based containers (new added packages in fedora:31) + ```bash session -$ pkgtreediff --ignore-release https://dl.fedoraproject.org/pub/fedora/linux/releases/{29,30}/Workstation/source/tree/Packages/ - ImageMagick.src: 6.9.9.38-3.fc29 -> 6.9.10.28-1.fc30 - LibRaw.src: 0.19.0-6.fc29 -> 0.19.2-3.fc30 - ModemManager.src: 1.8.0-4.fc29 -> 1.10.0-1.fc30 - NetworkManager.src: 1.12.4-1.fc29 -> 1.16.0-1.fc30 - NetworkManager-openvpn.src: 1.8.6-1.fc29 -> 1.8.10-1.fc30 - NetworkManager-ssh.src: 1.2.7-5.fc29 -> 1.2.9-1.fc30 - PackageKit.src: 1.1.11-1.fc29 -> 1.1.12-5.fc30 - PyYAML.src: 4.2-0.1.b4.fc29 -> 5.1-1.fc30 - SDL2.src: 2.0.8-6.fc29 -> 2.0.9-3.fc30 - abrt.src: 2.11.0-1.fc29 -> 2.12.0-2.fc30 - adobe-source-han-code-jp-fonts.src: 2.000-6.fc29 -> 2.011-2.fc30 - adobe-source-han-sans-cn-fonts.src: 1.004-8.fc29 -> 2.000-2.fc30 - adobe-source-han-sans-jp-fonts.src: 1.004-4.fc29 -> 2.000-2.fc30 - adobe-source-han-sans-kr-fonts.src: 1.004-4.fc29 -> 2.000-2.fc30 - adobe-source-han-sans-tw-fonts.src: 1.004-9.fc29 -> 2.000-2.fc30 - adobe-source-serif-pro-fonts.src: 2.000-5.fc29 -> 2.010.1.010-1.fc30 - adwaita-icon-theme.src: 3.30.0-1.fc29 -> 3.32.0-1.fc30 -- aldusleaf-crimson-text-fonts.src 0.8-0.10.20130806.fc29 -- almas-mongolian-title-fonts.src 1.0-11.fc29 - alsa-lib.src: 1.1.6-3.fc29 -> 1.1.8-2.fc30 +$ 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 +``` + +### Package trees + +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 : +- 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 : - wpa_supplicant.src: 2.6-17.fc29 -> 2.7-5.fc30 - wpan-tools.src: 0.8-3.fc29 -> 0.9-2.fc30 -+ xdg-dbus-proxy.src 0.1.1-2.fc30 - xdg-desktop-portal.src: 1.0.2-1.fc29 -> 1.2.0-3.fc30 - xdg-desktop-portal-gtk.src: 1.0.2-1.fc29 -> 1.2.0-3.fc30 - xen.src: 4.11.0-7.fc29 -> 4.11.1-4.fc30 - xfsprogs.src: 4.17.0-3.fc29 -> 4.19.0-4.fc30 - xmlsec1.src: 1.2.25-5.fc29 -> 1.2.27-2.fc30 - xorg-x11-drv-ati.src: 18.0.1-2.fc29 -> 19.0.1-1.fc30 - xorg-x11-drv-libinput.src: 0.28.0-2.fc29 -> 0.28.2-1.fc30 - xorg-x11-server.src: 1.20.1-4.fc29 -> 1.20.4-3.fc30 - yelp.src: 3.30.0-1.fc29 -> 3.32.1-1.fc30 - yelp-xsl.src: 3.30.1-1.fc29 -> 3.32.1-1.fc30 -+ zchunk.src 1.1.1-3.fc30 - zenity.src: 3.30.0-1.fc29 -> 3.32.0-1.fc30 - zram.src: 0.2-1.fc29 -> 0.3-1.fc30 - zstd.src: 1.3.6-1.fc29 -> 1.3.8-2.fc30 +: +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 Summary -Updated: 484 -Added: 70 -Deleted: 53 +Updated: 918 +Added: 17 +Deleted: 765 Arch changed: 0 -Total packages: 1672 -> 1689 +Total packages: 1690 -> 942 ``` + +### Hosts + +Compare the packages on local and another host: + +``` +pkgtreediff "rpm -qa" "ssh otherhost rpm -qa" +``` + +Any types of sources can be compared, together with the use of flags. ## Builds diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -1,3 +1,9 @@ +- compare buildsys list-tagged packages... - refactor to library -- compare with installed packages +- compare with installed packages (--installed?) - deb trees? +- compare container images, ostrees +- --ignore-disttag +- massage fedora mirror urls + +- "--query-format" diff --git a/pkgtreediff.cabal b/pkgtreediff.cabal --- a/pkgtreediff.cabal +++ b/pkgtreediff.cabal @@ -1,15 +1,15 @@ cabal-version: 1.18 name: pkgtreediff -version: 0.3 +version: 0.4 synopsis: Package tree diff tool -description: Tool for comparing RPM package files in OS dist trees. +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 license: GPL-3 license-file: LICENSE author: Jens Petersen maintainer: juhpetersen@gmail.com -copyright: 2019 Jens Petersen +copyright: 2019-2020 Jens Petersen category: Util build-type: Simple extra-doc-files: README.md @@ -28,17 +28,19 @@ build-depends: async , base < 5 - , directory >= 1.2.5.0 + , directory , filepath , Glob - , http-directory >= 0.1.4 + , http-client >= 0.5.0 + , http-client-tls + , http-directory >= 0.1.4 && (< 0.1.6 || >= 0.1.8) , simple-cmd >= 0.1.4 , simple-cmd-args , text if impl(ghc<8.0) build-depends: semigroups - ghc-options: -Wall -fwarn-missing-signatures + ghc-options: -Wall default-language: Haskell2010 default-extensions: OverloadedStrings