diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +* 0.9.2 (2014-12-18) +- lots of bug fixes +- improved missingdeps output +- use https for hackage URLs (codeblock) +- no longer override %_sourcedir, %_rpmdir, and %_srcrpmdir, unless git dir +- new "update" command to update spec to latest version +- use 'rpm --eval "%{?dist}"' to determine OS type +- fix build and warnings for Cabal 1.20 +- use TMPDIR + * 0.9.1 (2014-08-26) - missingdeps now lists missing dependencies recursively and outputs Hackage package names rather than ghc-*-devel package names diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -10,7 +10,7 @@ Cabal-rpm was originally created by Bryan O'Sullivan (see README.orig) but has since been updated to work with current Cabal and Fedora Packaging -Guidelines replacing cabal2spec. It is used by Fedora and (patched) OpenSuSE. +Guidelines replacing cabal2spec. It is used by Fedora and OpenSuSE. It is licensed under the terms of the GPL version 3 (see the COPYING file). You can build from source as normal by running `cabal install` @@ -36,10 +36,6 @@ $ cblrpm spec path/to/mypkg.cabal -or tarball: - - $ cblrpm spec path/to/mypkg-version.tar.gz - or on a package source dir: $ cblrpm spec mypkg-0.1 @@ -70,4 +66,4 @@ ## Plans More features are planned and patches welcome. -See the TODO file for more details. +See the [TODO](TODO) file for more details. diff --git a/cabal-rpm.cabal b/cabal-rpm.cabal --- a/cabal-rpm.cabal +++ b/cabal-rpm.cabal @@ -1,28 +1,15 @@ Name: cabal-rpm -Version: 0.9.1 +Version: 0.9.2 Synopsis: RPM packaging tool for Haskell Cabal-based packages Description: - This package generates RPM packages from Haskell Cabal packages. - . - * cblrpm spec: create .spec file from a hackage - . - * cblrpm srpm: create source rpm package - . - * cblrpm local: build binary rpm package, installing depends with yum - . - * cblrpm prep: unpack package source - . - * cblrpm builddep: yum install depends - . - * cblrpm install: yum install or rpmbuild depends and package - . - * cblrpm depends: list hackage dependencies - . - * cblrpm requires: list package dependencies - . - * cblrpm missingdeps: recursively list missing dependencies + This package provides a RPM packaging tool for Haskell Cabal-based packages. . - * cblrpm diff: diff current spec file with newly generated one + cblrpm has commands to generate a RPM spec file and srpm for a package. + It can rpmbuild packages, yum install their dependencies, prep packages, + and install them. There are commands to list package dependencies and + missing dependencies. The diff command compares the current spec file + with a freshly generated one and the update command updates the spec file + to latest version from Hackage. Homepage: https://github.com/juhp/cabal-rpm Bug-reports: https://github.com/juhp/cabal-rpm/issues License: GPL-3 @@ -56,6 +43,7 @@ Commands.Install, Commands.RpmBuild, Commands.Spec, + Commands.Update, Dependencies, FileUtils, PackageUtils, diff --git a/man/cblrpm.1 b/man/cblrpm.1 --- a/man/cblrpm.1 +++ b/man/cblrpm.1 @@ -13,28 +13,27 @@ [\f[I]options\f[]] depends [\f[I]path\-or\-pkg\f[]] cblrpm [\f[I]options\f[]] requires [\f[I]path\-or\-pkg\f[]] cblrpm [\f[I]options\f[]] missingdeps [\f[I]path\-or\-pkg\f[]] cblrpm -[\f[I]options\f[]] diff [\f[I]path\-or\-pkg\f[]] +[\f[I]options\f[]] diff [\f[I]path\-or\-pkg\f[]] cblrpm +[\f[I]options\f[]] update [\f[I]path\-or\-pkg\f[]] .SH DESCRIPTION .PP cblrpm generates RPM packages and .spec files from Haskell Cabal package. .PP -If no \f[I]path\-or\-pkg\f[] is specified, cblrpm looks for a .cabal or -.spec file in the current directory. +If no \f[I]path\-or\-pkg\f[] is specified, cblrpm looks for a .spec or +.cabal file in the current directory. Otherwise, it will look for \f[I]path\-or\-pkg\f[]. -If the argument is a directory then it will look there for a .cabal or -.spec file. -If the argument is a path to a .cabal, .spec, or .tar.gz file then it -will use it. +If the argument is a directory then it will look there for a .spec or +.cabal file. +If the argument is a path to a .cabal file then it will use it. Otherwise if there is no \[aq]/\[aq] in the argument and it does not exist then cblrpm will try to unpack the package and use its .cabal file. cblrpm uses a temporary directory for unpackaging tarballs or packages. -.PP -cblrpm then parses the above specified .cabal file and uses it to -generate a .spec file that can be built. +cblrpm then parses the .cabal file and uses it to generate a .spec file +that can be built. .PP -If a .spec already exists, cblrpm output to .spec.cblrpm instead. +If a .spec already exists, cblrpm outputs to .spec.cblrpm instead. .SH OPTIONS .TP .B \-h, \-\-help @@ -42,9 +41,8 @@ .RS .RE .TP -.B \-l, \-\-library -Force a BinLib package with executable(s) to be considered a Lib -package. +.B \-b, \-\-binary +Force the base package name to be the Hackage package name. .RS .RE .PP @@ -60,7 +58,8 @@ file. .SH EXAMPLES .PP -Below CMD can be one of: spec, srpm, prep, local, install, and depends. +Below CMD can be one of: spec, srpm, prep, local, install, diff, +builddep, depends, requires, missingdeps, update .PP Do CMD for the package in current directory: .IP @@ -91,14 +90,6 @@ .nf \f[C] cblrpm\ CMD\ path/to/some.cabal -\f[] -.fi -.PP -Do CMD for a tarball: -.IP -.nf -\f[C] -cblrpm\ CMD\ path/to/pkg\-ver.tar.gz \f[] .fi .SH HISTORY diff --git a/man/cblrpm.1.md b/man/cblrpm.1.md --- a/man/cblrpm.1.md +++ b/man/cblrpm.1.md @@ -16,29 +16,29 @@ cblrpm [*options*] requires [*path-or-pkg*] cblrpm [*options*] missingdeps [*path-or-pkg*] cblrpm [*options*] diff [*path-or-pkg*] +cblrpm [*options*] update [*path-or-pkg*] # DESCRIPTION cblrpm generates RPM packages and .spec files from Haskell Cabal package. -If no *path-or-pkg* is specified, cblrpm looks for a .cabal or .spec file +If no *path-or-pkg* is specified, cblrpm looks for a .spec or .cabal file in the current directory. Otherwise, it will look for *path-or-pkg*. If -the argument is a directory then it will look there for a .cabal or .spec file. -If the argument is a path to a .cabal, .spec, or .tar.gz file then it will -use it. Otherwise if there is no '/' in the argument and it does not exist +the argument is a directory then it will look there for a .spec or .cabal file. +If the argument is a path to a .cabal file then it will use it. +Otherwise if there is no '/' in the argument and it does not exist then cblrpm will try to unpack the package and use its .cabal file. cblrpm uses a temporary directory for unpackaging tarballs or packages. - -cblrpm then parses the above specified .cabal file and -uses it to generate a .spec file that can be built. +cblrpm then parses the .cabal file and uses it to generate a .spec file +that can be built. -If a .spec already exists, cblrpm output to .spec.cblrpm instead. +If a .spec already exists, cblrpm outputs to .spec.cblrpm instead. # OPTIONS -h, --help : Show the help text. --l, --library -: Force a BinLib package with executable(s) to be considered a Lib package. +-b, --binary +: Force the base package name to be the Hackage package name. -f *FLAGS*, --flags=*FLAGS* : Override one or more Cabal build configuration flags. @@ -53,7 +53,9 @@ : Override the version number in the .spec file. # EXAMPLES -Below CMD can be one of: spec, srpm, prep, local, install, and depends. +Below CMD can be one of: + spec, srpm, prep, local, install, diff, builddep, depends, requires, + missingdeps, update Do CMD for the package in current directory: @@ -70,10 +72,6 @@ Do CMD on a .cabal file: cblrpm CMD path/to/some.cabal - -Do CMD for a tarball: - - cblrpm CMD path/to/pkg-ver.tar.gz # HISTORY Cabal-rpm was originally written by Bryan O'Sullivan in 2007-2008 diff --git a/src/Commands/Depends.hs b/src/Commands/Depends.hs --- a/src/Commands/Depends.hs +++ b/src/Commands/Depends.hs @@ -18,14 +18,13 @@ ) where import Dependencies (dependencies, missingPackages, packageDependencies) -import PackageUtils (PackageData (..), packageName, prepare, stripPkgDevel) +import PackageUtils (PackageData (..), prepare, stripPkgDevel) import Setup (quiet) import SysCmd (cmd, (+-+)) import Control.Applicative ((<$>)) -import Control.Monad (filterM) +import Control.Monad (filterM, unless, void) import Data.List (nub, sort, (\\)) -import Distribution.PackageDescription (PackageDescription (..)) import System.Directory (removeDirectoryRecursive) data Depends = Depends | Requires | Missing @@ -44,17 +43,17 @@ mapM_ putStrLn $ sort $ deps ++ tools ++ clibs ++ pkgcfgs Missing -> do miss <- missingPackages pkgDesc >>= filterM notAvail - let name = packageName $ package pkgDesc - putMissing name miss - final <- recurseMissing miss (map stripPkgDevel miss) - putStrLn "" - mapM_ putStrLn $ sort $ map stripPkgDevel final + let missing = map stripPkgDevel miss + mapM_ putStrLn missing + unless (null missing) $ + putStrLn "" + void $ recurseMissing miss missing recurseMissing :: [String] -> [String] -> IO [String] recurseMissing already [] = return already recurseMissing already (dep:deps) = do miss <- missingDepsPkg dep - putMissing dep miss + putMissing dep miss already let accum = nub $ miss ++ already deeper <- recurseMissing accum (miss \\ accum) let accum2 = nub $ accum ++ deeper @@ -70,6 +69,12 @@ maybe (return ()) removeDirectoryRecursive $ workingDir pkgdata missingPackages (packageDesc pkgdata) >>= filterM notAvail -putMissing :: String -> [String] -> IO () -putMissing _ [] = return () -putMissing pkg deps = putStrLn $ pkg +-+ "misses:" +-+ unwords (map stripPkgDevel deps) +putMissing :: String -> [String] -> [String] -> IO () +putMissing _ [] _ = return () +putMissing pkg deps already = putStrLn $ pkg +-+ "needs:" +-+ unwords (markAlready deps) + where + markAlready :: [String] -> [String] + markAlready [] = [] + markAlready (d:ds) = + let (op, cl) = if d `elem` already then ("(", ")") else ("", "") in + (op ++ stripPkgDevel d ++ cl) : markAlready ds diff --git a/src/Commands/Install.hs b/src/Commands/Install.hs --- a/src/Commands/Install.hs +++ b/src/Commands/Install.hs @@ -24,23 +24,23 @@ import SysCmd (cmd, cmd_, sudo, yumInstall, (+-+)) import Control.Applicative ((<$>)) -import Control.Monad (when) ---import System.Directory (getCurrentDirectory, setCurrentDirectory) ---import System.FilePath (takeDirectory) +import Control.Monad (unless, when) import System.FilePath (()) install :: PackageData -> RpmFlags -> IO () install pkgdata flags = do let pkgDesc = packageDesc pkgdata missing <- missingPackages pkgDesc - yumInstall missing False - stillMissing <- missingPackages pkgDesc - putStrLn $ "Missing:" +-+ unwords stillMissing - mapM_ installMissing stillMissing --- let pkgDir = takeDirectory cabalPath + unless (null missing) $ do + yumInstall missing False + stillMissing <- missingPackages pkgDesc + unless (null stillMissing) $ do + putStrLn $ "Missing:" +-+ unwords stillMissing + mapM_ installMissing stillMissing spec <- rpmBuild pkgdata flags Binary arch <- cmd "arch" [] - rpms <- (map (\ p -> arch p ++ ".rpm") . lines) <$> + rpmdir <- cmd "rpm" ["--eval", "%{_rpmdir}"] + rpms <- (map (\ p -> rpmdir arch p ++ ".rpm") . lines) <$> cmd "rpmspec" ["-q", spec] sudo "yum" $ ["-y", "localinstall"] ++ rpms diff --git a/src/Commands/RpmBuild.hs b/src/Commands/RpmBuild.hs --- a/src/Commands/RpmBuild.hs +++ b/src/Commands/RpmBuild.hs @@ -24,7 +24,7 @@ import PackageUtils (copyTarball, isScmDir, PackageData (..), packageName, packageVersion, rpmbuild, RpmStage (..)) import Setup (RpmFlags (..)) -import SysCmd (yumInstall, (+-+)) +import SysCmd (cmd, yumInstall, (+-+)) --import Control.Exception (bracket) import Control.Monad (unless, void, when) @@ -34,7 +34,7 @@ --import Distribution.Version (VersionRange, foldVersionRange') import System.Directory (doesFileExist) -import System.FilePath (takeDirectory) +import System.FilePath (takeDirectory, ()) -- autoreconf :: Verbosity -> PackageDescription -> IO () -- autoreconf verbose pkgDesc = do @@ -61,11 +61,12 @@ name = packageName pkg when (stage `elem` [Binary,BuildDep]) $ do missing <- missingPackages pkgDesc - yumInstall missing True + yumInstall missing (stage == Binary) unless (stage == BuildDep) $ do + srcdir <- cmd "rpm" ["--eval", "%{_sourcedir}"] let version = packageVersion pkg - tarFile = name ++ "-" ++ version ++ ".tar.gz" + tarFile = srcdir name ++ "-" ++ version ++ ".tar.gz" tarFileExists <- doesFileExist tarFile unless tarFileExists $ do @@ -73,7 +74,7 @@ when scmRepo $ error "No tarball for source repo" - copyTarball name version False + copyTarball name version False srcdir rpmbuild stage False Nothing specFile return specFile diff --git a/src/Commands/Spec.hs b/src/Commands/Spec.hs --- a/src/Commands/Spec.hs +++ b/src/Commands/Spec.hs @@ -25,7 +25,7 @@ import PackageUtils (getPkgName, isScmDir, PackageData (..), packageName, packageVersion) import Setup (RpmFlags (..)) -import SysCmd ((+-+)) +import SysCmd ((+-+), cmd) import Control.Monad (filterM, unless, void, when) import Data.Char (toLower, toUpper) @@ -49,7 +49,7 @@ import System.Directory (doesFileExist, getDirectoryContents) import System.IO (IOMode (..), hClose, hPutStrLn, openFile) import System.Locale (defaultTimeLocale) -import System.FilePath (dropFileName, takeDirectory, ()) +import System.FilePath (dropFileName, takeBaseName, takeDirectory, ()) import qualified Paths_cabal_rpm (version) @@ -65,13 +65,6 @@ rstrip :: (Char -> Bool) -> String -> String rstrip p = reverse . dropWhile p . reverse --- packageName :: PackageIdentifier -> String --- packageName pkg = name --- where PackageName name = pkgName pkg - --- packageVersion :: PackageIdentifier -> String --- packageVersion pkg = (showVersion . pkgVersion) pkg - createSpecFile :: PackageData -> RpmFlags -> Maybe FilePath -> IO FilePath createSpecFile pkgdata flags mdest = do @@ -86,7 +79,6 @@ now <- getCurrentTime defRelease <- defaultRelease cabalPath now (pkgname, binlib) <- getPkgName mspec pkgDesc (rpmBinary flags) - putStrLn pkgname let pkg_name = if pkgname == name then "%{name}" else "%{pkg_name}" basename | binlib = "%{pkg_name}" | hasExecPkg = name @@ -103,8 +95,13 @@ specAlreadyExists <- doesFileExist specFile let specFile' = specFile ++ if not (rpmForce flags) && specAlreadyExists then ".cblrpm" else "" - when specAlreadyExists $ - notice verbose $ specFile +-+ "exists:" +-+ if rpmForce flags then "forcing overwrite" else "creating" +-+ specFile' + if specAlreadyExists + then notice verbose $ specFile +-+ "exists:" +-+ if rpmForce flags then "forcing overwrite" else "creating" +-+ specFile' + else do + let realdir dir = ("cblrpm." `isPrefixOf` takeBaseName dir) + when (maybe True realdir mdest) $ + putStrLn pkgname + h <- openFile specFile' WriteMode let putHdr hdr val = hPutStrLn h (hdr ++ ":" ++ padding hdr ++ val) padding hdr = replicate (14 - length hdr) ' ' ++ " " @@ -189,8 +186,8 @@ _ -> return () putNewline putHdr "License" $ (showLicense distro . license) pkgDesc - putHdr "Url" $ "http://hackage.haskell.org/package/" ++ pkg_name - putHdr "Source0" $ "http://hackage.haskell.org/package/" ++ pkg_name ++ "-%{version}/" ++ pkg_name ++ "-%{version}.tar.gz" + putHdr "Url" $ "https://hackage.haskell.org/package/" ++ pkg_name + putHdr "Source0" $ "https://hackage.haskell.org/package/" ++ pkg_name ++ "-%{version}/" ++ pkg_name ++ "-%{version}.tar.gz" case distro of Fedora -> return () _ -> putHdr "BuildRoot" "%{_tmppath}/%{name}-%{version}-build" @@ -335,7 +332,7 @@ when (not binlib && hasExec) $ withExe pkgDesc $ \exe -> let program = exeName exe in - put $ "%{_bindir}/" ++ (if program == name then "%{name}" else program) + put $ "%{_bindir}/" ++ (if program == name then "%{pkg_name}" else program) putNewline putNewline @@ -395,6 +392,10 @@ showLicense _ (AGPL Nothing) = "AGPLv?" showLicense _ (AGPL (Just ver)) = "AGPLv" ++ showVersion ver #endif +#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,20,0) +showLicense _ BSD2 = "BSD" +showLicense _ (MPL ver) = "MPLv" ++ showVersion ver +#endif -- from http://stackoverflow.com/questions/930675/functional-paragraphs -- using split would be: map unlines . (Data.List.Split.splitWhen null) @@ -427,6 +428,6 @@ suse <- doesFileExist "/etc/SuSE-release" if suse then return SUSE else do + dist <- cmd "rpm" ["--eval", "%{?dist}"] -- RHEL5 does not have macros.dist - dist <- doesFileExist "/etc/rpm/macros.dist" - return $ if dist then Fedora else RHEL5 + return $ if null dist || dist == ".el5" then RHEL5 else Fedora diff --git a/src/Commands/Update.hs b/src/Commands/Update.hs new file mode 100644 --- /dev/null +++ b/src/Commands/Update.hs @@ -0,0 +1,65 @@ +-- | +-- Module : Commands.Update +-- Copyright : (C) 2014 Jens Petersen +-- +-- Maintainer : Jens Petersen +-- Stability : alpha +-- +-- Explanation: update spec file to a new package version + +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. + +module Commands.Update ( + update + ) where + +import Commands.Spec (createSpecFile) +import FileUtils (withTempDirectory) +import PackageUtils (PackageData (..), bringTarball, isGitDir, latestPkg, + packageName, packageVersion, prepare, removePrefix) +import Setup (RpmFlags (..)) +import SysCmd (cmd_, shell, (+-+)) + +import Control.Monad (when) +import Distribution.PackageDescription (PackageDescription (..)) +import Distribution.Simple.Utils (die) + +import System.Directory (createDirectory, getCurrentDirectory, + setCurrentDirectory) + +update :: PackageData -> RpmFlags -> IO () +update pkgdata flags = + case specFilename pkgdata of + Nothing -> die "No (unique) .spec file in directory." + Just spec -> do + withTempDirectory $ \cwd -> do + let pkg = package $ packageDesc pkgdata + name = packageName pkg + ver = packageVersion pkg + current = name ++ "-" ++ ver + curspec <- createSpecVersion current spec + latest <- latestPkg name + if current == latest + then error $ current +-+ "is latest version." + else do + newspec <- createSpecVersion latest spec + getCurrentDirectory >>= putStrLn + shell $ "diff -u1 -I \"- spec file generated by cabal-rpm\" -I \"Fedora Haskell SIG \"" +-+ curspec +-+ newspec +-+ "| patch -d" +-+ cwd +-+ "-p1" + setCurrentDirectory cwd + cmd_ "sed" ["-i", "-e s/^\\(Release: \\).*/\\10%{?dist}/", spec] + let newver = removePrefix (name ++ "-") latest + cmd_ "rpmdev-bumpspec" ["-c", "update to" +-+ newver, spec] + bringTarball latest + pkgGit <- isGitDir cwd + when pkgGit $ + cmd_ "fedpkg" ["new-sources", latest ++ ".tar.gz"] + where + createSpecVersion :: String -> String -> IO FilePath + createSpecVersion ver spec = do + pkgdata' <- prepare (Just ver) flags + let pkgdata'' = pkgdata' { specFilename = Just spec } + createDirectory ver + createSpecFile pkgdata'' flags (Just ver) diff --git a/src/Dependencies.hs b/src/Dependencies.hs --- a/src/Dependencies.hs +++ b/src/Dependencies.hs @@ -35,7 +35,8 @@ import Distribution.PackageDescription (PackageDescription (..), allBuildInfo, BuildInfo (..), - TestSuite (..)) + TestSuite (..), + hasExes) import System.Directory (doesDirectoryExist, doesFileExist) import System.IO (hPutStrLn, stderr) @@ -46,7 +47,7 @@ buildDependencies :: PackageDescription -> String -> ([String], Bool) buildDependencies pkgDesc self = let deps = nub $ map depName (buildDepends pkgDesc) in - (filter excludedPkgs (delete self deps), self `elem` deps) + (filter excludedPkgs (delete self deps), self `elem` deps && hasExes pkgDesc) depName :: Dependency -> String depName (Dependency (PackageName n) _) = n @@ -89,6 +90,7 @@ rpmqueryFile qc file = do out <- cmd qc ["-q", "--qf=%{name}", "-f", file] let pkgs = nub $ words out + -- EL5 repoquery can return "No package provides " case pkgs of [pkg] -> return $ Just pkg [] -> do @@ -126,7 +128,8 @@ missingPackages :: PackageDescription -> IO [String] missingPackages pkgDesc = do (deps, tools, clibs, pkgcfgs, _) <- packageDependencies pkgDesc - filterM notInstalled $ deps ++ ["ghc-Cabal-devel", "ghc-rpm-macros"] ++ tools ++ clibs ++ pkgcfgs + pcpkgs <- mapM derefPkg pkgcfgs + filterM notInstalled $ deps ++ ["ghc-Cabal-devel", "ghc-rpm-macros"] ++ tools ++ clibs ++ pcpkgs notInstalled :: String -> IO Bool notInstalled dep = @@ -135,3 +138,14 @@ shellQuote :: String -> String shellQuote (c:cs) = (if c `elem` "()" then (['\\', c] ++) else (c:)) (shellQuote cs) shellQuote "" = "" + +derefPkg :: String -> IO String +derefPkg req = do + res <- singleLine <$> cmd "repoquery" ["--qf", "%{name}", "--whatprovides", req] + if null res + then error $ req +-+ "provider not found by repoquery" + else return res + where + singleLine :: String -> String + singleLine "" = "" + singleLine s = (head . lines) s diff --git a/src/FileUtils.hs b/src/FileUtils.hs --- a/src/FileUtils.hs +++ b/src/FileUtils.hs @@ -19,14 +19,17 @@ fileWithExtension, fileWithExtension_, getDirectoryContents_, - mktempdir) where + mktempdir, + withTempDirectory) where import SysCmd (cmd) import Control.Applicative ((<$>)) +import Control.Exception (bracket) import Data.List (isPrefixOf) import Data.Maybe (isJust) -import System.Directory (getDirectoryContents) +import System.Directory (getCurrentDirectory, getDirectoryContents, + setCurrentDirectory, removeDirectoryRecursive) import System.FilePath (takeExtension, ()) filesWithExtension :: FilePath -> String -> IO [FilePath] @@ -48,7 +51,18 @@ isJust <$> fileWithExtension dir ext mktempdir :: IO FilePath -mktempdir = cmd "mktemp" ["-d", "cblrpm.XXXXXXXXXX"] +mktempdir = cmd "mktemp" ["-d", "--tmpdir", "cblrpm.XXXXXXXXXX"] + +withTempDirectory :: (FilePath -> IO a) -> IO a +withTempDirectory run = bracket + mktempdir + removeDirectoryRecursive + (\ tmpdir -> do + cwd <- getCurrentDirectory + setCurrentDirectory tmpdir + res <- run cwd + setCurrentDirectory cwd + return res) -- getDirectoryContents without hidden files getDirectoryContents_ :: FilePath -> IO [FilePath] diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -21,6 +21,7 @@ import Commands.Install (install) import Commands.RpmBuild (rpmBuild_) import Commands.Spec (createSpecFile_) +import Commands.Update (update) import PackageUtils (prepare, PackageData (..), RpmStage (..)) import Setup (parseArgs) @@ -46,6 +47,7 @@ "depends" -> depends pkgdata Depends "requires" -> depends pkgdata Requires "missingdeps" -> depends pkgdata Missing + "update" -> update pkgdata opts "rpm" -> do putStrLn "* Warning the 'rpm' command has been renamed to 'local':" putStrLn "* this alias may be removed in a future release." diff --git a/src/PackageUtils.hs b/src/PackageUtils.hs --- a/src/PackageUtils.hs +++ b/src/PackageUtils.hs @@ -14,14 +14,18 @@ -- (at your option) any later version. module PackageUtils ( + bringTarball, checkForSpecFile, copyTarball, getPkgName, + isGitDir, isScmDir, + latestPkg, PackageData (..), packageName, packageVersion, prepare, + removePrefix, rpmbuild, RpmStage (..), simplePackageDescription, @@ -38,7 +42,7 @@ import Data.Char (isDigit) import Data.List (stripPrefix) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isJust) import Data.Version (showVersion) import Distribution.Compiler (CompilerFlavor (..)) @@ -50,7 +54,12 @@ import Distribution.PackageDescription.Parse (readPackageDescription) import Distribution.Simple.Compiler (Compiler (..)) -import Distribution.Simple.Configure (configCompiler) +import Distribution.Simple.Configure ( +#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,18,0) + configCompilerEx) +#else + configCompiler) +#endif import Distribution.Simple.Program (defaultProgramConfiguration) import Distribution.Simple.Utils (die, findPackageDesc) @@ -79,14 +88,29 @@ simplePackageDescription path opts = do let verbose = rpmVerbosity opts genPkgDesc <- readPackageDescription verbose path - (compiler, _) <- configCompiler (Just GHC) Nothing Nothing - defaultProgramConfiguration verbose +#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,18,0) + (compiler, _, _) <- configCompilerEx +#else + (compiler, _) <- configCompiler +#endif + (Just GHC) Nothing Nothing defaultProgramConfiguration verbose case finalizePackageDescription (rpmConfigurationsFlags opts) (const True) (Platform buildArch buildOS) (compilerId compiler) [] genPkgDesc of Left e -> die $ "finalize failed: " ++ show e Right (pd, _) -> return pd +findPackageDesc' :: FilePath -> IO FilePath +#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,20,0) +findPackageDesc' pth = do + res <- findPackageDesc pth + case res of + Left err -> error err + Right cbl -> return cbl +#else +findPackageDesc' = findPackageDesc +#endif + cabalFromSpec :: FilePath -> IO (FilePath, Maybe FilePath) cabalFromSpec specFile = do -- no rpmspec command in RHEL 5 and 6 @@ -99,21 +123,26 @@ when (specTime > dirTime) $ do bringTarball namever rpmbuild Prep True Nothing specFile - cabal <- findPackageDesc namever + cabal <- findPackageDesc' namever return (cabal, Nothing) else do tmpdir <- mktempdir bringTarball namever rpmbuild Prep True (Just tmpdir) specFile - cabal <- findPackageDesc $ tmpdir namever + cabal <- findPackageDesc' $ tmpdir namever return (cabal, Just tmpdir) - where - bringTarball nv = do - fExists <- doesFileExist $ nv <.> "tar.gz" - unless fExists $ - let (n, v) = nameVersion nv in - copyTarball n v False +bringTarball :: FilePath -> IO () +bringTarball nv = do + srcdir <- do + cwd <- getCurrentDirectory + git <- isGitDir cwd + if git then return cwd else cmd "rpm" ["--eval", "%{_sourcedir}"] + fExists <- doesFileExist $ srcdir nv <.> "tar.gz" + unless fExists $ + let (n, v) = nameVersion nv in + copyTarball n v False srcdir + nameVersion :: String -> (String, String) nameVersion nv = if '-' `notElem` nv @@ -132,13 +161,17 @@ Prep -> "p" BuildDep -> "_" cwd <- getCurrentDirectory + gitDir <- isGitDir cwd + let rpmdirs_override = if gitDir + then ["--define=_rpmdir" +-+ cwd, + "--define=_srcrpmdir" +-+ cwd, + "--define=_sourcedir" +-+ cwd] + else [] command "rpmbuild" $ ["-b" ++ rpmCmd] ++ ["--nodeps" | mode == Prep] ++ - ["--define=_builddir" +-+ maybe cwd (cwd ) moutdir, - "--define=_rpmdir" +-+ cwd, - "--define=_srcrpmdir" +-+ cwd, - "--define=_sourcedir" +-+ cwd, - spec] + ["--define=_builddir" +-+ maybe cwd (cwd ) moutdir | isJust moutdir] ++ + rpmdirs_override ++ + [spec] where command = if quiet then cmdSilent else cmd_ @@ -156,27 +189,29 @@ tryUnpack :: String -> IO (FilePath, Maybe FilePath) tryUnpack pkg = do - pkgver <- if '.' `elem` pkg then return pkg - else do - contains_pkg <- lines <$> cmd "cabal" ["list", "--simple-output", pkg] - let pkgs = filter ((== pkg) . takeWhile (not . (== ' '))) contains_pkg - if null pkgs - then error $ pkg ++ " hackage not found" - else return $ map (\c -> if c == ' ' then '-' else c) $ last pkgs + pkgver <- if '.' `elem` pkg then return pkg else latestPkg pkg isdir <- doesDirectoryExist pkgver if isdir then do - pth <- findPackageDesc pkgver + pth <- findPackageDesc' pkgver return (pth, Nothing) else do cwd <- getCurrentDirectory tmpdir <- mktempdir setCurrentDirectory tmpdir cmd_ "cabal" ["unpack", "-v0", pkgver] - pth <- findPackageDesc pkgver + pth <- findPackageDesc' pkgver setCurrentDirectory cwd return (tmpdir ++ "/" ++ pth, Just tmpdir) +latestPkg :: String -> IO String +latestPkg pkg = do + contains_pkg <- lines <$> cmd "cabal" ["list", "--simple-output", pkg] + let pkgs = filter ((== pkg) . takeWhile (not . (== ' '))) contains_pkg + if null pkgs + then error $ pkg ++ " hackage not found" + else return $ map (\c -> if c == ' ' then '-' else c) $ last pkgs + packageName :: PackageIdentifier -> String packageName pkg = name where PackageName name = pkgName pkg @@ -191,8 +226,11 @@ isScmDir :: FilePath -> IO Bool isScmDir dir = - doesDirectoryExist (dir ".git") <||> doesDirectoryExist (dir "_darcs") + isGitDir dir <||> doesDirectoryExist (dir "_darcs") +isGitDir :: FilePath -> IO Bool +isGitDir dir = doesDirectoryExist (dir ".git") + getPkgName :: Maybe FilePath -> PackageDescription -> Bool -> IO (String, Bool) getPkgName (Just spec) pkgDesc binary = do let name = packageName $ package pkgDesc @@ -212,9 +250,10 @@ [one] -> return $ Just one _ -> return Nothing checkForSpecFile (Just pkg) = do - specs <- filesWithExtension "." ".spec" + let specname = pkg <.> "spec" + specs <- filter (`elem` [specname, "ghc-" ++ specname]) <$> filesWithExtension "." ".spec" case specs of - [one] | takeBaseName one `elem` ["ghc-" ++ pkg, pkg] -> return $ Just one + [one] -> return $ Just one _ -> return Nothing checkForCabalFile :: String -> IO (Maybe FilePath) @@ -237,10 +276,11 @@ -- exists <- doesFileExist specfile -- return (specfile, exists) -copyTarball :: String -> String -> Bool -> IO () -copyTarball n v ranFetch = do +copyTarball :: String -> String -> Bool -> FilePath -> IO () +copyTarball n v ranFetch dir = do let tarfile = n ++ "-" ++ v <.> "tar.gz" - already <- doesFileExist tarfile + dest = dir tarfile + already <- doesFileExist dest unless already $ do home <- getEnv "HOME" let cacheparent = home ".cabal" "packages" @@ -257,13 +297,13 @@ then error $ "No" +-+ tarfile +-+ "found" else do cmd_ "cabal" ["fetch", "-v0", "--no-dependencies", n ++ "-" ++ v] - copyTarball n v True + copyTarball n v True dir else do - copyFile (head tarballs) tarfile + copyFile (head tarballs) dest -- cabal fetch creates tarballs with mode 0600 - stat <- getFileStatus tarfile + stat <- getFileStatus dest when (fileMode stat /= 0o100644) $ - setFileMode tarfile 0o0644 + setFileMode dest 0o0644 data PackageData = PackageData { specFilename :: Maybe FilePath diff --git a/src/Setup.hs b/src/Setup.hs --- a/src/Setup.hs +++ b/src/Setup.hs @@ -66,7 +66,6 @@ quiet = emptyRpmFlags {rpmVerbosity = silent} options :: [OptDescr (RpmFlags -> RpmFlags)] - options = [ Option "h?" ["help"] (NoArg (\x -> x { rpmHelp = True })) @@ -96,7 +95,7 @@ progName <- getProgName let info = "Usage: " ++ progName ++ " [OPTION]... COMMAND [PATH|PKG|PKG-VERSION]\n" ++ "\n" - ++ "PATH can be to a .spec or .cabal file, pkg dir.\n" + ++ "PATH can be a .spec file, .cabal file, or pkg dir.\n" ++ "\n" ++ "Commands:\n" ++ " spec\t\t- generate a spec file\n" @@ -109,6 +108,7 @@ ++ " requires\t- list package buildrequires\n" ++ " missingdeps\t- list missing buildrequires\n" ++ " diff\t\t- diff current spec file\n" + ++ " update\t- update spec file package to latest version\n" -- ++ " mock\t\t- mock build package\n" ++ "\n" ++ "Options:" @@ -128,7 +128,7 @@ error $ unlines errs unless (null unknown) $ error $ "Unrecognised options:" +-+ unwords unknown - when (null args' || notElem (head args') ["builddep", "depends", "diff", "install", "missingdeps", "prep", "requires", "spec", "srpm", "local", "rpm"]) $ do + when (null args' || notElem (head args') ["builddep", "depends", "diff", "install", "missingdeps", "prep", "requires", "spec", "srpm", "local", "rpm", "update"]) $ do printHelp stderr exitWith (ExitFailure 1) when (length args' > 2) $ diff --git a/src/SysCmd.hs b/src/SysCmd.hs --- a/src/SysCmd.hs +++ b/src/SysCmd.hs @@ -28,7 +28,7 @@ yumInstall, (+-+)) where -import Control.Monad (unless, void, when) +import Control.Monad (void, when) import Data.Functor ((<$>)) import Data.List ((\\)) import Data.Maybe (fromMaybe, isJust, isNothing) @@ -120,30 +120,30 @@ s +-+ t = s ++ " " ++ t yumInstall :: [String] -> Bool -> IO () -yumInstall pkgs hard = - unless (null pkgs) $ do - putStrLn $ "Running repoquery" +-+ unwords pkgs - repopkgs <- lines <$> readProcess "repoquery" (["--qf", "%{name}"] ++ pkgs) [] - if not (null (pkgs \\ repopkgs)) - then - when hard $ - error $ unwords (pkgs \\ repopkgs) +-+ "not available." +yumInstall [] _ = return () +yumInstall pkgs hard = do + putStrLn $ "Running repoquery" +-+ unwords pkgs + repopkgs <- lines <$> readProcess "repoquery" (["--qf", "%{name}"] ++ pkgs) [] + let missing = pkgs \\ repopkgs + if not (null missing) && hard + then error $ unwords missing +-+ "not available." + else do + putStrLn "Uninstalled dependencies:" + mapM_ putStrLn pkgs + uid <- getEffectiveUserID + maybeSudo <- + if uid == 0 + then return Nothing else do - putStrLn "Uninstalled dependencies:" - mapM_ putStrLn pkgs - uid <- getEffectiveUserID - maybeSudo <- - if uid == 0 - then return Nothing - else do - havesudo <- optionalProgram "sudo" - return $ if havesudo then Just "sudo" else Nothing - requireProgram "yum" - -- FIXME: just install repopkgs? - let args = map showPkg pkgs - putStrLn $ "Running:" +-+ fromMaybe "" maybeSudo +-+ "yum install" +-+ unwords args - let exec = if hard then cmd_ else trySystem - exec (fromMaybe "yum" maybeSudo) $ maybe [] (const "yum") maybeSudo : "install" : args + havesudo <- optionalProgram "sudo" + return $ if havesudo then Just "sudo" else Nothing + requireProgram "yum" + let args = map showPkg repopkgs + putStrLn $ "Running:" +-+ fromMaybe "" maybeSudo +-+ "yum install" +-+ unwords args + let exec = if hard then cmd_ else trySystem + fedora <- cmd "rpm" ["--eval", "%fedora"] + let nogpgcheck = ["--nogpgcheck" | fedora `elem` ["21", "22"]] + exec (fromMaybe "yum" maybeSudo) $ maybe [] (const "yum") maybeSudo : "install" : args ++ nogpgcheck showPkg :: String -> String showPkg p = if '(' `elem` p then show p else p