rpmbuild-order (empty) → 0.1
raw patch · 7 files changed
+434/−0 lines, 7 filesdep +Cabaldep +basedep +containerssetup-changed
Dependencies added: Cabal, base, containers, directory, explicit-exception, fgl, filepath, process, transformers
Files
- ChangeLog +3/−0
- LICENSE +31/−0
- README.md +32/−0
- RpmbuildOrder.hs +318/−0
- Setup.hs +2/−0
- TODO +1/−0
- rpmbuild-order.cabal +47/−0
+ ChangeLog view
@@ -0,0 +1,3 @@+* 0.1+- initial release with sort, deps and rdeps (reverse dependencies) commands+
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2010, Henning Thielemann++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * The names of contributors may not be used to endorse or promote+ products derived from this software without specific prior+ written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,32 @@+[](https://travis-ci.org/juhp/rpmbuild-order)++# rpmbuild-order++This package based on code from [cabal-sort](http://hackage.haskell.org/package/cabal-sort), sorts rpm package spec files by build order.++ $ rpmbuild-order --help+ $ rpmbuild-order sort mycore mylib myapp+ mylib+ mycore+ myapp++The arguments passed can either be directories named after the package, or spec files.++By default it outputs the package names, but it can also output+the spec filenames or directory paths for easier scripting.++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.++## Known problems+Given packages A, B, C, where C depends on B, and B depends on A,+and you call++ rpmbuild-order C.spec A.spec++then the output may be wrong if C does not have a direct dependency on A.+Even if the order is correct, B is missing in the output+and thus in this case the list of packages cannot be reliably used+for a sequence of builds.+
+ RpmbuildOrder.hs view
@@ -0,0 +1,318 @@+{-# LANGUAGE LambdaCase #-}++module Main where++import qualified Distribution.Verbosity as Verbosity+import qualified Distribution.ReadE as ReadE++import System.Console.GetOpt+ (getOpt, ArgOrder(..), OptDescr(..), ArgDescr(..), usageInfo)+import System.Exit (exitSuccess, exitFailure)+import qualified System.Environment as Env+import System.FilePath++import System.Directory (doesDirectoryExist, doesFileExist,+#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,5))+ listDirectory+#else+ getDirectoryContents+#endif+ )+import System.IO (hPutStrLn, stderr)+import System.Process (readProcess)++import Data.Graph.Inductive.Query.DFS (xdfsWith, topsort', scc, components)+import Data.Graph.Inductive.Tree (Gr)+import qualified Data.Graph.Inductive.Graph as Graph++import qualified Control.Monad.Exception.Synchronous as E+import qualified Control.Monad.Trans.Class as T++import qualified Data.Set as Set+import Control.Monad (guard, when, unless)+import Data.Maybe (catMaybes, fromMaybe, mapMaybe)+import Data.List (delete, intersperse, stripPrefix)++#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2))+#else+import Control.Applicative ((<$>))+#endif++#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,5))+#else+listDirectory :: FilePath -> IO [FilePath]+listDirectory path =+ filter f <$> getDirectoryContents path+ where f filename = filename /= "." && filename /= ".."+#endif++main :: IO ()+main =+ E.resolveT handleException $ do+ argv <- T.lift Env.getArgs+ let (opts, args, errors) = getOpt Permute options argv+ if length args < 2+ then T.lift $ help >> exitFailure+ else do+ let (com:pkgs) = args+ unless (null errors) $ E.throwT $ concat errors+ unless (com `elem` ["sort", "deps", "rdeps"]) $+ E.throwT $ "Unknown command " ++ com+ flags <-+ E.ExceptionalT $ return $+ foldr (=<<)+ (return+ Flags {optHelp = False,+ optVerbosity = Verbosity.silent,+ optFormat = package,+ optParallel = Nothing,+ optBranch = Nothing})+ opts+ if optHelp flags+ then T.lift $ help >> exitSuccess+ else runCommand flags com $ map (removeSuffix "/") pkgs+ where+ help =+ Env.getProgName >>= \programName ->+ putStrLn+ (usageInfo ("Usage: " ++ programName +++ " [OPTIONS] [sort|deps|rdeps] PKG-SPEC-OR-DIR ...") options)++handleException :: String -> IO ()+handleException msg = do+ putStrLn $ "Aborted: " ++ msg+ exitFailure++findSpec :: Maybe FilePath -> FilePath -> IO (Maybe FilePath)+findSpec mdir file =+ if takeExtension file == ".spec"+ then checkFile file+ else do+ dirp <- doesDirectoryExist file+ if dirp+ then+ let dir = maybe file (file </>) mdir+ pkg = takeBaseName file in+ checkFile $ dir </> pkg ++ ".spec"+ else return Nothing+ where+ checkFile :: FilePath -> IO (Maybe FilePath)+ checkFile f = do+ e <- doesFileExist f+ if e+ then return $ Just f+ else return Nothing++data Flags =+ Flags {+ optHelp :: Bool,+ optVerbosity :: Verbosity.Verbosity,+ optFormat :: SourcePackage -> String,+ optParallel :: Maybe String,+ optBranch :: Maybe FilePath+ }++options :: [OptDescr (Flags -> E.Exceptional String Flags)]+options =+ [+ Option ['h'] ["help"]+ (NoArg (\flags -> return $ flags{optHelp = True}))+ "Show options"+ , Option ['p'] ["parallel"]+ (OptArg+ (\mstr flags ->+ fmap (\cs -> flags{optParallel = Just cs})+ (E.Success (fromMaybe "" mstr)))+ "SEPARATOR")+ "Display independently buildable groups of packages, optionally with separator"+ , Option ['b'] ["branch"]+ (ReqArg+ (\str flags ->+ fmap (\mb -> flags{optBranch = mb})+ (E.Success (Just str)))+ "BRANCHDIR")+ "branch directory"+ , Option ['f'] ["format"]+ (ReqArg+ (\str flags ->+ fmap (\select -> flags{optFormat = select}) $+ case str of+ "package" -> E.Success package+ "spec" -> E.Success location+ "dir" -> E.Success (takeDirectory . location)+ _ ->+ E.Exception $+ "unknown info type " ++ str)+ "KIND")+ "output format: 'package' (default), 'spec', or 'dir'"+ , Option ['v'] ["verbose"]+ (ReqArg+ (\str flags ->+ fmap (\n -> flags{optVerbosity = n}) $+ E.fromEither $+ ReadE.runReadE Verbosity.flagToVerbosity str)+ "N")+ "verbosity level: 0..3"+ ]++type Package = String++data SourcePackage =+ SourcePackage {+ location :: FilePath,+ package :: Package,+ dependencies :: [Package]+ }+ deriving (Show, Eq)++type Command = String++runCommand :: Flags -> Command -> [Package] -> E.ExceptionalT String IO ()+runCommand flags "sort" pkgs = sortSpecFiles flags pkgs+runCommand flags "deps" pkgs = depsSpecFiles False flags pkgs+runCommand flags "rdeps" pkgs = depsSpecFiles True flags pkgs+runCommand _ _ _ = E.throwT "impossible happened"++createGraphNodes :: Flags -> [Package] -> [Package] ->+ E.ExceptionalT String IO (Gr SourcePackage (), [Graph.Node])+createGraphNodes flags pkgs subset = do+ unless (all (`elem` pkgs) subset) $+ E.throwT "Packages must be in the current directory"+ specPaths <- T.lift $ catMaybes <$> mapM (findSpec (optBranch flags)) (filter (/= fromMaybe "" (optParallel flags)) pkgs)+ let names = map takeBaseName specPaths+ provs <-+ T.lift $+ mapM (readProvides (optVerbosity flags)) specPaths+ let resolves = zip names provs+ deps <-+ T.lift $+ mapM (getDepsSrcResolved (optVerbosity flags) resolves) specPaths+ let spkgs = zipWith3 SourcePackage specPaths names deps+ graph = getBuildGraph spkgs+ checkForCycles graph+ let nodes = Graph.labNodes graph+ subnodes = mapMaybe (pkgNode nodes) subset+ return (graph, subnodes)+ where+ pkgNode [] _ = Nothing+ pkgNode ((i,l):ns) p = if p == package l then Just i else pkgNode ns p++sortSpecFiles :: Flags -> [Package] -> E.ExceptionalT String IO ()+sortSpecFiles flags pkgs = do+ (graph, _) <- createGraphNodes flags pkgs []+ T.lift $+ case optParallel flags of+ Just s ->+ mapM_ ((putStrLn . unwords . (if null s then id else intersperse s) . map (optFormat flags)) . topsort' . subgraph graph)+ (components graph)+ Nothing ->+ mapM_ (putStrLn . optFormat flags) $ topsort' graph+ +depsSpecFiles :: Bool -> Flags -> [Package] -> E.ExceptionalT String IO ()+depsSpecFiles rev flags pkgs = do+ allpkgs <- T.lift $ listDirectory "."+ (graph, nodes) <- createGraphNodes flags allpkgs pkgs+ let dir = if rev then Graph.suc' else Graph.pre'+ sortSpecFiles flags $ map package $ xdfsWith dir third nodes graph+ where+ third (_, _, c, _) = c++readProvides :: Verbosity.Verbosity -> FilePath -> IO [String]+readProvides verbose file = do+ when (verbose >= Verbosity.verbose) $ hPutStrLn stderr file+ pkgs <- lines <$>+ rpmspec ["--rpms", "--qf=%{name}\n", "--define", "ghc_version any"] Nothing file+ let pkg = takeBaseName file+ return $ delete pkg pkgs++getDepsSrcResolved :: Verbosity.Verbosity -> [(String,[String])] -> FilePath -> IO [String]+getDepsSrcResolved verbose provides file =+ map (resolveBase provides) <$> do+ when (verbose >= Verbosity.verbose) $ hPutStrLn stderr file+ -- ignore version bounds+ map (head . words) . lines <$>+ rpmspec ["--buildrequires", "--define", "ghc_version any"] Nothing file+ where+ resolveBase :: [(String,[String])] -> String -> String+ resolveBase provs br =+ case mapMaybe (\ (pkg,subs) -> if br `elem` subs then Just pkg else Nothing) provs of+ [] -> br+ [p] -> p+ ps -> error $ br ++ "is provided by: " ++ unwords ps++removeSuffix :: String -> String -> String+removeSuffix suffix orig =+ fromMaybe orig $ stripSuffix suffix orig+ where+ stripSuffix sf str = reverse <$> stripPrefix (reverse sf) (reverse str)++cmdStdIn :: String -> [String] -> String -> IO String+cmdStdIn c as inp = removeTrailingNewline <$> readProcess c as inp+ where+ removeTrailingNewline :: String -> String+ removeTrailingNewline "" = ""+ removeTrailingNewline str =+ if last str == '\n'+ then init str+ else str++cmd :: String -> [String] -> IO String+cmd c as = cmdStdIn c as ""++rpmspec :: [String] -> Maybe String -> FilePath -> IO String+rpmspec args mqf spec = do+ let qf = maybe [] (\ q -> ["--queryformat", q]) mqf+ cmd "rpmspec" (["-q"] ++ args ++ qf ++ [spec])++getDeps :: Gr SourcePackage () -> [(SourcePackage, [SourcePackage])]+getDeps gr =+ let c2dep :: Graph.Context SourcePackage () -> (SourcePackage, [SourcePackage])+ c2dep ctx =+ (Graph.lab' ctx,+ map (Graph.lab' . Graph.context gr) (Graph.pre gr . Graph.node' $ ctx))+ in Graph.ufold (\ctx ds -> c2dep ctx : ds) [] gr++getBuildGraph :: [SourcePackage] -> Gr SourcePackage ()+getBuildGraph srcPkgs =+ let nodes = zip [0..] srcPkgs+ nodeDict = zip (map package srcPkgs) [0..]+ edges = do+ (srcNode,srcPkg) <- nodes+ dstNode <- mapMaybe (`lookup` nodeDict) (dependencies srcPkg)+ guard (dstNode /= srcNode)+ return (dstNode, srcNode, ())+ in Graph.mkGraph nodes edges++checkForCycles ::+ Monad m =>+ Gr SourcePackage () ->+ E.ExceptionalT String m ()+checkForCycles graph =+ case getCycles graph of+ [] -> return ()+ cycles ->+ E.throwT $ unlines $+ "Cycles in dependencies:" :+ map (unwords . map location . nodeLabels graph) cycles++nodeLabels :: Gr a b -> [Graph.Node] -> [a]+nodeLabels graph =+ map (fromMaybe (error "node not found in graph") .+ Graph.lab graph)++subgraph :: Gr a b -> [Graph.Node] -> Gr a b+subgraph graph nodes =+ let nodeSet = Set.fromList nodes+ edges = do+ from <- nodes+ (to, lab) <- Graph.lsuc graph from+ guard $ Set.member from nodeSet && Set.member to nodeSet+ return (from,to,lab)+ in Graph.mkGraph (zip nodes $ nodeLabels graph nodes) edges++getCycles :: Gr a b -> [[Graph.Node]]+getCycles =+ filter (\case+ _:_:_ -> True+ _ -> False)+ . scc
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ TODO view
@@ -0,0 +1,1 @@+add leaf command
+ rpmbuild-order.cabal view
@@ -0,0 +1,47 @@+Name: rpmbuild-order+Version: 0.1+License: BSD3+License-File: LICENSE+Author: Henning Thielemann <haskell@henning-thielemann.de>+Maintainer: Jens Petersen <petersen@redhat.com>+Copyright: 2010-2018 Henning Thielemann,+ 2018 Jens Petersen <petersen@redhat.com>+Category: Distribution+Homepage: https://github.com/juhp/rpmbuild-order+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 originates 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 neighbouring directories. This is also useful to see what packages+ are affected when a low-level package changes.+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.3+Cabal-Version: >=1.6+Build-Type: Simple+Extra-source-files: README.md TODO ChangeLog++source-repository head+ type: git+ location: https://github.com/juhp/rpmbuild-order++Executable rpmbuild-order+ Build-Depends:+ base < 5,+ Cabal,+ containers,+ directory,+ explicit-exception,+ filepath,+ fgl, + process,+ transformers++ GHC-Options: -Wall+ Main-Is: RpmbuildOrder.hs+ Extensions: CPP