diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,10 @@ +# 0.4.4 (2021-05-16) +- add 'render' command to display graph graphically with graphviz + with an option to output dot format +- fix subcycle algorithm: now lists correct shortest path subcycles +- improve cycles output (#2) +- library Graph: add printGraph, renderGraph, createGraph'''' + # 0.4.3.2 (2021-02-03) - intercalate newlines between cycles - only list subcycles with over 2 packages diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,20 +4,30 @@ # rpmbuild-order -This package originally based on code from [cabal-sort](http://hackage.haskell.org/package/cabal-sort), sorts rpm package spec files by build order. +This is a tool to sort RPM source packages in build dependency order. +This code is originally derived from +[cabal-sort](http://hackage.haskell.org/package/cabal-sort) +by Henning Thielemann. +## Usage + $ rpmbuild-order --help + : $ rpmbuild-order sort mycore mylib myapp mylib mycore myapp -The arguments passed can either be directories containing the package, or spec files. +The arguments passed can either be directories containing the package +or spec files. If the dependency graph has cycles then an error will be output with -a list of cycles and any subcycles. +a list of cycles and any shortest path subcycles. Using the rpmbuild-order `deps` and `rdeps` commands the ordered dependencies and reverse dependencies of a package can be obtained -from the current set of checked out package sources. +within the current set of checked out package sources. + +The `render` command displays a graph of package dependencies +using graphviz and X11 or optionally instead prints the dot format to stdout. ## Library As of version 0.4, a library is also provided. diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -1,11 +1,6 @@ - try topograph - - use Set? - * warn about uninstalled (specific?) macros packages - - handle duplicate packages? - - (r)deps: optimize using actual deps - - option to somehow display subpackage deps for cycles diff --git a/rpmbuild-order.cabal b/rpmbuild-order.cabal --- a/rpmbuild-order.cabal +++ b/rpmbuild-order.cabal @@ -1,9 +1,9 @@ Name: rpmbuild-order -Version: 0.4.3.2 +Version: 0.4.4 License: BSD3 License-File: LICENSE -Author: Henning Thielemann , - Jens Petersen +Author: Jens Petersen , + Henning Thielemann Maintainer: Jens Petersen Copyright: 2010-2018 Henning Thielemann, 2018-2021 Jens Petersen @@ -12,21 +12,21 @@ Bug-reports: https://github.com/juhp/rpmbuild-order/issues Synopsis: Order RPM packages by dependencies Description: - The rpmbuild-order tool orders RPM packages by dependencies, so that they can - be built in the correct order. It does this by reading RPM package spec files - and then topologically sorts them according to their dependencies. - The code evolved from cabal-sort by Henning Thielemann. - It can also output the ordered dependencies or reverse depends - for one or more packages, provided all the packages are checked out - in neighboring directories. This is also useful to see what packages - are affected when a low-level package changes. It also has support - for setting RPM options for bcond etc, which can affect dependencies. + The rpmbuild-order tool sorts source RPM packages by build dependencies, + so that they can be built in a correct order. It does this by reading RPM + package spec files and then topologically sorts them according to their + build dependencies. The code evolved from cabal-sort by Henning Thielemann. + It can also order the dependencies or reverse depends of one or more packages + among the packages checked out in neighboring directories (which can be + useful to see what packages are affected when a low-level package changes). + It also has support for setting RPM options for bcond etc, + which can affect dependencies. It can also output dependency graphs. Since version 0.4, a library API is also provided. Tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, - GHC == 8.10.2 + GHC == 8.10.4, GHC == 9.0.1 Cabal-Version: 1.18 Build-Type: Simple Extra-doc-files: README.md TODO ChangeLog.md @@ -48,7 +48,6 @@ optparse-applicative, rpmbuild-order, simple-cmd-args - Main-Is: src/Main.hs Other-modules: Paths_rpmbuild_order GHC-Options: -Wall @@ -74,7 +73,8 @@ directory, extra >= 1.6.4, filepath, - fgl, + fgl >= 5.5.4, + graphviz, process HS-Source-Dirs: src GHC-Options: -Wall @@ -106,3 +106,4 @@ , rpmbuild-order , simple-cmd , unix + build-tools: rpmbuild-order diff --git a/src/Distribution/RPM/Build/Graph.hs b/src/Distribution/RPM/Build/Graph.hs --- a/src/Distribution/RPM/Build/Graph.hs +++ b/src/Distribution/RPM/Build/Graph.hs @@ -18,13 +18,16 @@ createGraph', createGraph'', createGraph''', + createGraph'''', dependencyNodes, subgraph', packageLayers, lowestLayer, lowestLayer', packageLeaves, - separatePackages + separatePackages, + printGraph, + renderGraph ) where import qualified Data.CaseInsensitive as CI @@ -36,9 +39,10 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif -import Control.Monad (guard, when, unless) +import Control.Monad (forM_, guard, when, unless) import Data.Maybe (catMaybes, fromMaybe, mapMaybe) -import Data.List.Extra (dropSuffix, find, intercalate, nubOrdOn, sort, sortOn) +import Data.List.Extra (dropSuffix, find, intercalate, nub, nubOrdOn, sort, sortOn) +import Data.GraphViz import System.Directory (doesDirectoryExist, doesFileExist, #if MIN_VERSION_directory(1,2,5) listDirectory @@ -146,13 +150,30 @@ -> Maybe FilePath -- ^ look for spec file in a subdirectory -> [FilePath] -- ^ package paths (directories or spec filepaths) -> IO PackageGraph -- ^ dependency graph labelled by package paths -createGraph''' ignoredBRs rpmopts verbose lenient rev mdir paths = do +createGraph''' = createGraph'''' True + +-- | Create a directed dependency graph for a set of packages +-- +-- Like createGraph''' but can disable check for cycles +-- +-- @since 0.4.4 +createGraph'''' :: Bool -- ^ check for cycles + -> [String] -- ^ ignored BuildRequires + -> [String] -- ^ rpmspec options + -> Bool -- ^ verbose + -> Bool -- ^ lenient (skip rpmspec failures) + -> Bool -- ^ reverse dependency graph + -> Maybe FilePath -- ^ look for spec file in a subdirectory + -> [FilePath] -- ^ package paths (directories or spec filepaths) + -> IO PackageGraph -- ^ dependency graph labelled by package paths +createGraph'''' checkcycles ignoredBRs rpmopts verbose lenient rev mdir paths = do metadata <- catMaybes <$> mapM readSpecMetadata paths let realpkgs = map fst3 metadata deps = mapMaybe (getDepsSrcResolved metadata) realpkgs spkgs = zipWith SourcePackage realpkgs deps graph = getBuildGraph spkgs - checkForCycles graph + when checkcycles $ + checkForCycles graph return graph where readSpecMetadata :: FilePath -> IO (Maybe (FilePath,[String],[String])) @@ -191,10 +212,11 @@ case specs of [spec] -> return $ Just spec _ -> if lenient then return Nothing - else error $ if null specs - then "No spec file found in " ++ path - else "More than one .spec file found in " ++ dir - else error $ "No spec file found for " ++ path + else errorWithoutStackTrace $ + if null specs + then "No spec file found in " ++ path + else "More than one .spec file found in " ++ dir + else errorWithoutStackTrace $ "No spec file found for " ++ path where checkFile :: Bool -> FilePath -> IO (Maybe FilePath) checkFile may f = do @@ -203,7 +225,7 @@ then return $ Just f else return $ if may then Nothing - else error $ f ++ " not found" + else errorWithoutStackTrace $ f ++ " not found" filesWithExtension :: FilePath -> String -> IO [FilePath] filesWithExtension dir ext = @@ -242,33 +264,32 @@ return $ if rev then (dstNode, srcNode, ()) else (srcNode, dstNode, ()) - in G.mkGraph (map (fmap packagePath) nodes) edges + in G.mkGraph (map (fmap packagePath) nodes) $ nub edges - checkForCycles :: Monad m => PackageGraph -> m () - checkForCycles graph = - unless (null cycles) $ - error $ unlines $ - "Cycles in dependencies:" : - intercalate [""] (map (renderCycles . subcycles) cycles) + checkForCycles :: PackageGraph -> IO () + checkForCycles graph = do + let cycles = filter ((>= 2) . length) (scc graph) + unless (null cycles) $ do + let plural = if length cycles > 1 then "s" else "" + errorWithoutStackTrace $ unlines $ + ("ordering not possible due to build dependency cycle" ++ plural ++ ":\n") : intercalate [""] (map (renderCycles . subcycles) cycles) where - cycles :: [[G.Node]] - cycles = - (filter ((>= 2) . length) . scc) graph - -- shortest subcycle subcycles :: [G.Node] -> ([FilePath],[[FilePath]]) subcycles [] = error "cyclic graph with no nodes!" - subcycles cycle'@(n:ns) = - let sg = G.emap (const (1 :: Int)) $ G.subgraph cycle' graph - shorter = nubOrdOn sort $ sortOn length $ filter ((\l -> l < length ns && l > 2) . length) $ catMaybes $ mapAdjacent (\ i j-> sp j i sg) (cycle' ++ [n]) + subcycles cycle' = + let shorter = nubOrdOn sort $ sortOn length $ filter ((< length cycle') . length) $ mapMaybe findSp $ G.labEdges sg in (nodeLabels graph cycle', map (nodeLabels sg) shorter) + where + sg = G.emap (const (1 :: Int)) $ G.subgraph cycle' graph - mapAdjacent :: (a -> a -> b) -> [a] -> [b] - mapAdjacent f xs = zipWith f xs (tail xs) + findSp (i,j,_) | G.hasEdge sg (i,j) = sp j i sg + | G.hasEdge sg (j,i) = sp i j sg + | otherwise = Nothing renderCycles :: ([FilePath],[[FilePath]]) -> [String] renderCycles (c,sc) = - unwords c : if null sc then [] else "Subcycles: " : map unwords sc + unwords c : if null sc then [] else "\nShortest path subcycles: " : map unwords sc getDepsSrcResolved :: [(FilePath,[String],[String])] -> FilePath -> Maybe [FilePath] getDepsSrcResolved metadata pkg = @@ -279,7 +300,7 @@ case mapMaybe (\ (p,provs,_) -> if br `elem` provs then Just p else Nothing) metadata of [] -> br [p] -> p - ps -> error $ pkg ++ ": " ++ br ++ " is provided by: " ++ unwords ps + ps -> errorWithoutStackTrace $ pkg ++ ": " ++ br ++ " is provided by: " ++ unwords ps thd (_,_,c) = c @@ -333,3 +354,23 @@ separatePackages :: PackageGraph -> [FilePath] separatePackages graph = map snd $ G.labNodes $ G.nfilter ((==0) . G.deg graph) graph + +-- | Return graphviz dot format of graph +printGraph :: PackageGraph -> IO () +printGraph g = do + putStrLn "digraph {" + forM_ (G.labNodes g) $ \ (n,l) -> do + putStr $ show l + putStrLn $ renderDeps $ map show $ mapMaybe (G.lab g . fst) $ G.lsuc g n + putStrLn "}" + where + renderDeps :: [String] -> String + renderDeps [] = "" + renderDeps [d] = " -> " ++ d + renderDeps ds = " -> {" ++ unwords ds ++ "}" + +-- | Render graph with graphviz X11 preview +renderGraph :: PackageGraph -> IO () +renderGraph graph = + let g = G.emap (const ("" :: String)) graph + in runGraphvizCanvas' (setDirectedness graphToDot quickParams g) Xlib diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,5 +1,7 @@ {-# LANGUAGE CPP #-} +module Main (main) where + import Control.Applicative ( #if !MIN_VERSION_simple_cmd_args(0,1,3) (<|>), @@ -51,6 +53,8 @@ leavesPackages <$> rpmOpts <*> verboseOpt <*> lenientOpt <*> subdirOpt <*> pkgArgs , Subcommand "roots" "List lowest root packages" $ rootPackages <$> rpmOpts <*> verboseOpt <*> lenientOpt <*> subdirOpt <*> pkgArgs + , Subcommand "render" "Show graph with graphviz" $ + renderPkgGraph <$> switchWith 'o' "output" "Print graph in dot format" <*> rpmOpts <*> verboseOpt <*> lenientOpt <*> subdirOpt <*> pkgArgs ] where verboseOpt = switchWith 'v' "verbose" "Verbose output for debugging" @@ -73,7 +77,7 @@ depsPackages :: Bool -> [String] -> Bool-> [String] -> [String] -> Bool -> Bool -> Maybe FilePath -> [FilePath] -> IO () depsPackages rev rpmopts verbose excludedPkgs ignoredBRs lenient parallel mdir pkgs = do unlessM (and <$> mapM doesDirectoryExist pkgs) $ - error "Please use package directory paths" + errorWithoutStackTrace "Please use package directory paths" listDirectory "." >>= -- filter out dotfiles createGraph''' ignoredBRs rpmopts verbose lenient (not rev) mdir . filter ((/= '.') . head) . filter (`notElem` excludedPkgs) >>= @@ -115,3 +119,9 @@ rootPackages rpmopts verbose lenient mdir pkgs = do graph <- createGraph'' rpmopts verbose lenient True mdir pkgs mapM_ putStrLn $ lowestLayer graph + +renderPkgGraph :: Bool -> [String] -> Bool -> Bool -> Maybe FilePath + -> [FilePath] -> IO () +renderPkgGraph dot rpmopts verbose lenient mdir pkgs = + createGraph'''' False [] rpmopts verbose lenient True mdir pkgs >>= + if dot then printGraph else renderGraph diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,18 +1,23 @@ import Test.Hspec import Control.Monad.Extra +import Data.Version.Extra --import Distribution.RPM.Build.Graph import Distribution.RPM.Build.Order import SimpleCmd import System.Posix.Files main :: IO () -main = setupSymlinks >> hspec spec +main = do + setupSymlinks + -- rpmspec < 4.15 does not support "--with" + rpmver <- readVersion . last . words <$> cmd "rpmspec" ["--version"] + hspec (spec rpmver) pkg :: FilePath -> FilePath pkg = ("test/pkgs/" ++) -spec :: Spec -spec = do +spec :: Version -> Spec +spec rpmver = do describe "sorting" $ do it "sort A B" $ dependencySort [pkg "A", pkg "B"] >>= @@ -50,7 +55,8 @@ dependencySort [pkg "A", pkg "B/", pkg "D1.0"] >>= (`shouldBe` [pkg "B/", pkg "D1.0", pkg "A"]) - it "circular A B C boot" $ + when (rpmver > makeVersion [4,15]) $ + it "circular A B C boot" $ dependencySortRpmOpts ["--with=boot"] [pkg "A", pkg "B", pkg "C"] >>= (`shouldBe` [pkg "C", pkg "B", pkg "A"]) @@ -64,7 +70,6 @@ leafPackages [pkg "A", pkg "B", pkg "D1.0"] >>= (`shouldBe` [pkg "A", pkg "D1.0"]) - -- NB hack: this requires it to be "cabal install"'ed already describe "rpmbuild-order" $ do it "sort A B" $ cmd "rpmbuild-order" ["sort", pkg "A", pkg "B"] >>=