diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,19 @@ +* 0.9 (2014-07-17) +- reworked initial logic to make better use of existing spec files, + and prep source tree properly +- default to Library packaging instead of BinLib: + override with --binary which replaces --library +- prep src for version in existing spec file when building +- 'install' command now does local recursive rpmbuilding +- try "rpm -qf" and then rpmquery to resolve clib devel depends +- support SUSE packaging (thanks Jan Matějka) +- support RHEL5 packaging +- support Cabal-1.20 +- improve output for 'depends' command +- no duplicate clibs deps +- include "cblrpm" in tempdir names +- use current dir name as a last guess of package name + * 0.8.11 (2014-05-17) - build command renamed again from "rpm" to "local" (like fedpkg) - use .spec file to determine pkg-ver when no .cabal file around @@ -157,3 +173,8 @@ * 0.5.1 and earlier (2007-2008) released by Bryan O'Sullivan - should work with ghc-6.8 + + +# Local Variables: +# mode: text +# End: diff --git a/cabal-rpm.cabal b/cabal-rpm.cabal --- a/cabal-rpm.cabal +++ b/cabal-rpm.cabal @@ -1,5 +1,5 @@ Name: cabal-rpm -Version: 0.8.11 +Version: 0.9 Synopsis: RPM packaging tool for Haskell Cabal-based packages Description: This package generates RPM packages from Haskell Cabal packages. @@ -14,7 +14,7 @@ . * cblrpm builddep: yum install depends . - * cblrpm install: yum install depends and then cabal install + * cblrpm install: yum install or rpmbuild depends and package . * cblrpm depends: list hackage dependencies . @@ -27,7 +27,7 @@ Bug-reports: https://github.com/juhp/cabal-rpm/issues License: GPL-3 License-file: COPYING -Author: Bryan O'Sullivan , Jens Petersen +Author: Jens Petersen , Bryan O'Sullivan Maintainer: Jens Petersen Copyright: 2007-2008 Bryan O'Sullivan , 2012-2014 Jens Petersen @@ -43,7 +43,7 @@ Executable cblrpm Main-is: Main.hs Build-depends: base < 5, - Cabal > 1.10 && < 1.19, + Cabal > 1.10 && < 1.21, directory, filepath, old-locale, diff --git a/src/Commands/Depends.hs b/src/Commands/Depends.hs --- a/src/Commands/Depends.hs +++ b/src/Commands/Depends.hs @@ -14,33 +14,31 @@ module Commands.Depends ( depends, - missingDeps, - requires + Depends (..) ) where import Dependencies (dependencies, packageDependencies ) -import PackageUtils (missingPackages, packageName) +import PackageUtils (missingPackages, PackageData (..), packageName) import Data.List (sort) import Distribution.PackageDescription (PackageDescription (..)) -depends :: PackageDescription -> IO () -depends pkgDesc = do - let pkg = package pkgDesc - name = packageName pkg - (deps, tools, clibs, pkgcfgs, _) <- dependencies pkgDesc name - mapM_ putStrLn $ deps ++ tools ++ clibs ++ pkgcfgs - -requires :: PackageDescription -> IO () -requires pkgDesc = do - let pkg = package pkgDesc - name = packageName pkg - (deps, tools, clibs, pkgcfgs, _) <- packageDependencies pkgDesc name - mapM_ putStrLn $ sort $ deps ++ tools ++ clibs ++ pkgcfgs +data Depends = Depends | Requires | Missing -missingDeps :: PackageDescription -> IO () -missingDeps pkgDesc = do - let pkg = package pkgDesc - name = packageName pkg - missing <- missingPackages pkgDesc name - mapM_ putStrLn missing +depends :: PackageData -> Depends -> IO () +depends pkgdata action = do + let pkgDesc = packageDesc pkgdata + pkg = package pkgDesc + name = packageName pkg + case action of + Depends -> do + (deps, tools, clibs, pkgcfgs, _) <- dependencies pkgDesc name + let clibs' = map (\ lib -> "lib" ++ lib ++ ".so") clibs + let pkgcfgs' = map (++ ".pc") pkgcfgs + mapM_ putStrLn $ deps ++ tools ++ clibs' ++ pkgcfgs' + Requires -> do + (deps, tools, clibs, pkgcfgs, _) <- packageDependencies pkgDesc name + mapM_ putStrLn $ sort $ deps ++ tools ++ clibs ++ pkgcfgs + Missing -> do + missing <- missingPackages pkgDesc name + mapM_ putStrLn missing diff --git a/src/Commands/Diff.hs b/src/Commands/Diff.hs --- a/src/Commands/Diff.hs +++ b/src/Commands/Diff.hs @@ -18,28 +18,21 @@ ) where import Commands.Spec (createSpecFile) -import FileUtils (fileWithExtension, mktempdir) +import FileUtils (mktempdir) +import PackageUtils (PackageData (..)) import Setup (RpmFlags (..)) -import SysCmd ((+-+), trySystem) +import SysCmd ((+-+), shell) -import Control.Applicative ((<$>)) -import Data.Maybe (fromJust) -import Distribution.PackageDescription (PackageDescription (..)) import Distribution.Simple.Utils (die) import System.Directory (removeDirectoryRecursive) -diff :: FilePath -- ^cabal path - -> PackageDescription -- ^pkg description - -> RpmFlags -- ^rpm flags - -> IO () -diff cabalPath pkgDesc flags = do - mspcfile <- fileWithExtension "." ".spec" - case mspcfile of +diff :: PackageData -> RpmFlags -> IO () +diff pkgFiles flags = + case specFilename pkgFiles of Nothing -> die "No (unique) .spec file in directory." Just spec -> do tmpdir <- mktempdir - createSpecFile cabalPath pkgDesc flags (Just tmpdir) - speccblrpm <- fromJust <$> fileWithExtension tmpdir ".spec" - trySystem $ "diff" +-+ "-u" +-+ spec +-+ speccblrpm +-+ "| sed -e s%" ++ speccblrpm ++ "%" ++ spec ++ ".cblrpm" ++ "%" + speccblrpm <- createSpecFile pkgFiles flags (Just tmpdir) + shell $ "diff" +-+ "-u" +-+ spec +-+ speccblrpm +-+ "| sed -e s%" ++ speccblrpm ++ "%" ++ spec ++ ".cblrpm" ++ "%" removeDirectoryRecursive tmpdir diff --git a/src/Commands/Install.hs b/src/Commands/Install.hs --- a/src/Commands/Install.hs +++ b/src/Commands/Install.hs @@ -17,19 +17,40 @@ install ) where -import PackageUtils (missingPackages, packageName) -import SysCmd (runSystem, yumInstall) +import Commands.RpmBuild (rpmBuild) +import PackageUtils (missingPackages, notInstalled, PackageData (..), + packageName, removePrefix, removeSuffix, RpmStage (..)) +import Setup (RpmFlags (..)) +import SysCmd (cmd, cmd_, sudo, yumInstall, (+-+)) +import Control.Applicative ((<$>)) +import Control.Monad (when) import Distribution.PackageDescription (PackageDescription (..)) -import System.Directory (setCurrentDirectory) -import System.FilePath (takeDirectory) +--import System.Directory (getCurrentDirectory, setCurrentDirectory) +--import System.FilePath (takeDirectory) +import System.FilePath (()) -install :: FilePath -> PackageDescription -> IO () -install cabalPath pkgDesc = do - let pkg = package pkgDesc - name = packageName pkg - missing <- missingPackages pkgDesc name - yumInstall missing False - let pkgDir = takeDirectory cabalPath - setCurrentDirectory pkgDir - runSystem "cabal install" +install :: PackageData -> RpmFlags -> IO () +install pkgdata flags = do + let pkgDesc = packageDesc pkgdata + pkg = package pkgDesc + name = packageName pkg + missing <- missingPackages pkgDesc name + yumInstall missing False + stillMissing <- missingPackages pkgDesc name + putStrLn $ "Missing:" +-+ unwords stillMissing + mapM_ installMissing stillMissing +-- let pkgDir = takeDirectory cabalPath + spec <- rpmBuild pkgdata flags Binary + arch <- cmd "arch" [] + rpms <- (map (\ p -> arch p ++ ".rpm") . lines) <$> + cmd "rpmspec" ["-q", spec] + sudo "yum" $ ["-y", "localinstall"] ++ rpms + +installMissing :: String -> IO () +installMissing pkg = do + noInstall <- notInstalled pkg + when noInstall $ do + let dep = removeSuffix "-devel" $ removePrefix "ghc-" pkg + putStrLn $ "Running cblrpm install" +-+ dep + cmd_ "cblrpm" ["install", dep] diff --git a/src/Commands/RpmBuild.hs b/src/Commands/RpmBuild.hs --- a/src/Commands/RpmBuild.hs +++ b/src/Commands/RpmBuild.hs @@ -16,27 +16,25 @@ -- (at your option) any later version. module Commands.RpmBuild ( - rpmBuild, RpmStage (..) + rpmBuild, rpmBuild_ ) where import Commands.Spec (createSpecFile) -import FileUtils (fileWithExtension, getDirectoryContents_) -import PackageUtils (isScmDir, missingPackages, packageName, packageVersion) +import PackageUtils (copyTarball, isScmDir, missingPackages, + PackageData (..), packageName, packageVersion, rpmbuild, + RpmStage (..)) import Setup (RpmFlags (..)) -import SysCmd (runSystem, yumInstall, (+-+)) +import SysCmd (yumInstall, (+-+)) --import Control.Exception (bracket) -import Control.Monad (filterM, unless, when) +import Control.Monad (unless, void, when) -import Distribution.PackageDescription (PackageDescription (..), - hasExes) +import Distribution.PackageDescription (PackageDescription (..)) --import Distribution.Version (VersionRange, foldVersionRange') -import System.Directory (copyFile, doesFileExist, getCurrentDirectory) -import System.Environment (getEnv) -import System.FilePath (takeDirectory, ()) -import System.Posix.Files (setFileMode, getFileStatus, fileMode) +import System.Directory (doesFileExist) +import System.FilePath (takeDirectory) -- autoreconf :: Verbosity -> PackageDescription -> IO () -- autoreconf verbose pkgDesc = do @@ -45,84 +43,40 @@ -- c <- doesFileExist "configure" -- when (not c) $ do -- setupMessage verbose "Running autoreconf" pkgDesc --- runSystem "autoreconf" - -data RpmStage = Binary | Source | Prep | BuildDep deriving Eq +-- cmd_ "autoreconf" [] -rpmBuild :: FilePath -> PackageDescription -> RpmFlags -> RpmStage -> IO () -rpmBuild cabalPath pkgDesc flags stage = do --- let verbose = rpmVerbosity flags --- bracket (setFileCreationMask 0o022) setFileCreationMask $ \ _ -> do --- autoreconf verbose pkgDesc - mspcfile <- fileWithExtension "." ".spec" - specFile <- case mspcfile of - Just s -> return s - Nothing -> specFileName pkgDesc flags - specFileExists <- doesFileExist specFile - if specFileExists - then putStrLn $ "Using existing" +-+ specFile - else createSpecFile cabalPath pkgDesc flags Nothing - let pkg = package pkgDesc - name = packageName pkg - when (stage `elem` [Binary,BuildDep]) $ do - missing <- missingPackages pkgDesc name - yumInstall missing True +rpmBuild :: PackageData -> RpmFlags -> RpmStage -> + IO FilePath +rpmBuild pkgdata flags stage = do +-- let verbose = rpmVerbosity flags +-- bracket (setFileCreationMask 0o022) setFileCreationMask $ \ _ -> do +-- autoreconf verbose pkgDesc + let pkgDesc = packageDesc pkgdata + mspec = specFilename pkgdata + cabalPath = cabalFilename pkgdata + specFile <- maybe (createSpecFile pkgdata flags Nothing) + (\ s -> putStrLn ("Using existing" +-+ s) >> return s) + mspec + let pkg = package pkgDesc + name = packageName pkg + when (stage `elem` [Binary,BuildDep]) $ do + missing <- missingPackages pkgDesc name + yumInstall missing True - unless (stage == BuildDep) $ do - let version = packageVersion pkg - tarFile = name ++ "-" ++ version ++ ".tar.gz" - rpmCmd = case stage of - Binary -> "a" - Source -> "s" - Prep -> "p" - BuildDep -> "_" + unless (stage == BuildDep) $ do + let version = packageVersion pkg + tarFile = name ++ "-" ++ version ++ ".tar.gz" - tarFileExists <- doesFileExist tarFile - unless tarFileExists $ do - scmRepo <- isScmDir $ takeDirectory cabalPath - when scmRepo $ - error "No tarball for source repo" + tarFileExists <- doesFileExist tarFile + unless tarFileExists $ do + scmRepo <- isScmDir $ takeDirectory cabalPath + when scmRepo $ + error "No tarball for source repo" - cwd <- getCurrentDirectory - copyTarball name version False - runSystem ("rpmbuild -b" ++ rpmCmd +-+ - (if stage == Prep then "--nodeps" else "") +-+ - "--define \"_rpmdir" +-+ cwd ++ "\"" +-+ - "--define \"_srcrpmdir" +-+ cwd ++ "\"" +-+ - "--define \"_sourcedir" +-+ cwd ++ "\"" +-+ - specFile) - where - copyTarball :: String -> String -> Bool -> IO () - copyTarball n v ranFetch = do - let tarfile = n ++ "-" ++ v ++ ".tar.gz" - already <- doesFileExist tarfile - unless already $ do - home <- getEnv "HOME" - let cacheparent = home ".cabal" "packages" - tarpath = n v tarfile - remotes <- getDirectoryContents_ cacheparent - let paths = map (\ repo -> cacheparent repo tarpath) remotes - -- if more than one tarball, should maybe warn if they are different - tarballs <- filterM doesFileExist paths - if null tarballs - then if ranFetch - then error $ "No" +-+ tarfile +-+ "found" - else do - runSystem ("cabal fetch -v0 --no-dependencies" +-+ n ++ "-" ++ v) - copyTarball n v True - else do - copyFile (head tarballs) tarfile - -- cabal fetch creates tarballs with mode 0600 - stat <- getFileStatus tarfile - when (fileMode stat /= 0o100644) $ - setFileMode tarfile 0o0644 + copyTarball name version False + rpmbuild stage False Nothing specFile + return specFile -specFileName :: PackageDescription -- ^pkg description - -> RpmFlags -- ^rpm flags - -> IO FilePath -specFileName pkgDesc flags = do - let pkg = package pkgDesc - name = packageName pkg - pkgname = if isExec then name else "ghc-" ++ name - isExec = not (rpmLibrary flags) && hasExes pkgDesc - return $ pkgname ++ ".spec" +rpmBuild_ :: PackageData -> RpmFlags -> RpmStage -> IO () +rpmBuild_ pkgdata flags stage = + void (rpmBuild pkgdata flags stage) diff --git a/src/Commands/Spec.hs b/src/Commands/Spec.hs --- a/src/Commands/Spec.hs +++ b/src/Commands/Spec.hs @@ -17,17 +17,16 @@ -- (at your option) any later version. module Commands.Spec ( - createSpecFile + createSpecFile, createSpecFile_ ) where import Dependencies (packageDependencies, showDep, testsuiteDependencies) -import FileUtils (fileWithExtension) -import PackageUtils (isScmDir, notInstalled, packageName, packageVersion) +import PackageUtils (getPkgName, isScmDir, notInstalled, PackageData (..), + packageName, packageVersion) import Setup (RpmFlags (..)) import SysCmd ((+-+)) ---import Control.Exception (bracket) -import Control.Monad (filterM, when, unless) +import Control.Monad (filterM, unless, void, when) import Data.Char (toLower, toUpper) import Data.List (groupBy, isPrefixOf, isSuffixOf, sort, (\\)) import Data.Maybe (fromMaybe, maybeToList) @@ -48,18 +47,18 @@ import System.Directory (doesFileExist, getDirectoryContents) import System.IO (IOMode (..), hClose, hPutStrLn, openFile) import System.Locale (defaultTimeLocale) -import System.FilePath (dropFileName, takeBaseName, takeDirectory, ()) +import System.FilePath (dropFileName, takeDirectory, ()) import qualified Paths_cabal_rpm (version) defaultRelease :: FilePath -> UTCTime -> IO String defaultRelease cabalPath now = do - let pkgDir = takeDirectory cabalPath - scmRepo <- isScmDir pkgDir - return $ if scmRepo - then formatTime defaultTimeLocale "0.%Y%m%d" now - else "1" + let pkgDir = takeDirectory cabalPath + scmRepo <- isScmDir pkgDir + return $ if scmRepo + then formatTime defaultTimeLocale "0.%Y%m%d" now + else "1" rstrip :: (Char -> Bool) -> String -> String rstrip p = reverse . dropWhile p . reverse @@ -71,265 +70,327 @@ -- packageVersion :: PackageIdentifier -> String -- packageVersion pkg = (showVersion . pkgVersion) pkg -createSpecFile :: FilePath -- ^pkg cabal file - -> PackageDescription -- ^pkg description - -> RpmFlags -- ^rpm flags - -> Maybe FilePath -- ^optional destdir - -> IO () -createSpecFile cabalPath pkgDesc flags mdest = do - let verbose = rpmVerbosity flags - now <- getCurrentTime - defRelease <- defaultRelease cabalPath now - mspcfile <- if rpmForce flags then return Nothing - else fileWithExtension "." ".spec" - let mpkgname = fmap takeBaseName mspcfile - pkg = package pkgDesc - name = packageName pkg - pkgname = fromMaybe (if hasExec then name else "ghc-" ++ name) mpkgname - pkg_name = if pkgname == name then "%{name}" else "%{pkg_name}" - basename | isBinLib = "%{pkg_name}" - | hasExecPkg = name - | otherwise = "ghc-%{pkg_name}" - version = packageVersion pkg - release = fromMaybe defRelease (rpmRelease flags) - specFile = fromMaybe "" mdest pkgname ++ ".spec" - hasExec = hasExes pkgDesc - hasLib = hasLibs pkgDesc - isBinLib = hasLib && not (rpmLibrary flags) && pkgname == name - hasExecPkg = not (rpmLibrary flags) && (isBinLib || hasExes pkgDesc && not hasLib) - specAlreadyExists <- doesFileExist specFile - let specFilename = specFile ++ if not (rpmForce flags) && specAlreadyExists then ".cblrpm" else "" - when specAlreadyExists $ - notice verbose $ specFile +-+ "exists:" +-+ if rpmForce flags then "forcing overwrite" else "creating" +-+ specFilename - h <- openFile specFilename WriteMode - let putHdr hdr val = hPutStrLn h (hdr ++ ":" ++ padding hdr ++ val) - padding hdr = replicate (14 - length hdr) ' ' ++ " " - putNewline = hPutStrLn h "" - put = hPutStrLn h - putDef v s = put $ "%global" +-+ v +-+ s - ghcPkg = if isBinLib then "-n ghc-%{name}" else "" - ghcPkgDevel = if isBinLib then "-n ghc-%{name}-devel" else "devel" - - put "# https://fedoraproject.org/wiki/Packaging:Haskell" - putNewline +createSpecFile :: PackageData -> RpmFlags -> + Maybe FilePath -> IO FilePath +createSpecFile pkgdata flags mdest = do + let mspec = specFilename pkgdata + cabalPath = cabalFilename pkgdata + pkgDesc = packageDesc pkgdata + pkg = package pkgDesc + name = packageName pkg + verbose = rpmVerbosity flags + hasExec = hasExes pkgDesc + hasLib = hasLibs pkgDesc + 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 + | otherwise = "ghc-%{pkg_name}" + version = packageVersion pkg + release = fromMaybe defRelease (rpmRelease flags) + specFile = fromMaybe "" mdest pkgname ++ ".spec" + hasExecPkg = binlib || (hasExec && not hasLib) + -- run commands before opening file to prevent empty file on error + -- maybe shell commands should be in a monad or something + (deps, tools, clibs, pkgcfgs, selfdep) <- packageDependencies pkgDesc name + let testsuiteDeps = testsuiteDependencies pkgDesc name + missTestDeps <- filterM notInstalled testsuiteDeps - -- Some packages conflate the synopsis and description fields. Ugh. - let syn = synopsis pkgDesc - when (null syn) $ - warn verbose "this package has no synopsis." - let initialCapital (c:cs) = toUpper c:cs - initialCapital [] = [] - let syn' = if null syn - then "Haskell" +-+ name +-+ "package" - else (unwords . lines . initialCapital) syn - let summary = rstrip (== '.') syn' - when (length ("Summary : " ++ syn') > 79) $ - warn verbose "this package has a long synopsis." + 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' + h <- openFile specFile' WriteMode + let putHdr hdr val = hPutStrLn h (hdr ++ ":" ++ padding hdr ++ val) + padding hdr = replicate (14 - length hdr) ' ' ++ " " + putNewline = hPutStrLn h "" + put = hPutStrLn h + putDef v s = put $ "%global" +-+ v +-+ s + ghcPkg = if binlib then "-n ghc-%{name}" else "" + ghcPkgDevel = if binlib then "-n ghc-%{name}-devel" else "devel" - let descr = description pkgDesc - when (null descr) $ - warn verbose "this package has no description." - let descLines = (formatParagraphs . initialCapital . filterSymbols . finalPeriod) $ - if null descr then syn' else descr - finalPeriod cs = if last cs == '.' then cs else cs ++ "." - filterSymbols (c:cs) = - if c `notElem` "@\\" then c: filterSymbols cs - else case c of - '@' -> '\'': filterSymbols cs - '\\' -> head cs: filterSymbols (tail cs) - _ -> c: filterSymbols cs - filterSymbols [] = [] - when hasLib $ do - putDef "pkg_name" name - putNewline + distro <- detectDistro + if distro /= SUSE + then put "# https://fedoraproject.org/wiki/Packaging:Haskell" + else do + let year = formatTime defaultTimeLocale "%Y" now + put "#" + put $ "# spec file for package " ++ pkgname + put "#" + put $ "# Copyright (c) " ++ year ++ " SUSE LINUX Products GmbH, Nuernberg, Germany." + put "#" + put "# All modifications and additions to the file contributed by third parties" + put "# remain the property of their copyright owners, unless otherwise agreed" + put "# upon. The license for this file, and modifications and additions to the" + put "# file, is the same license as for the pristine package itself (unless the" + put "# license for the pristine package is not an Open Source License, in which" + put "# case the license is the MIT License). An \"Open Source License\" is a" + put "# license that conforms to the Open Source Definition (Version 1.9)" + put "# published by the Open Source Initiative." + putNewline + put "# Please submit bugfixes or comments via http://bugs.opensuse.org/" + put "#" + putNewline - let testsuiteDeps = testsuiteDependencies pkgDesc name - missTestDeps <- filterM notInstalled testsuiteDeps - unless (null testsuiteDeps) $ do - put $ "%bcond_" ++ (if null missTestDeps then "without" else "with") +-+ "tests" - putNewline + -- Some packages conflate the synopsis and description fields. Ugh. + let syn = synopsis pkgDesc + when (null syn) $ + warn verbose "this package has no synopsis." + let initialCapital (c:cs) = toUpper c:cs + initialCapital [] = [] + let syn' = if null syn + then "Haskell" +-+ name +-+ "package" + else (unwords . lines . initialCapital) syn + let summary = rstrip (== '.') syn' + when (length ("Summary : " ++ syn') > 79) $ + warn verbose "this package has a long synopsis." - let eCsources = concatMap (cSources . buildInfo) $ executables pkgDesc - let lCsources = concatMap (cSources . libBuildInfo) $ maybeToList $ library pkgDesc - when (null $ eCsources ++ lCsources) $ do - put "# no useful debuginfo for Haskell packages without C sources" - putDef "debug_package" "%{nil}" - putNewline + let descr = description pkgDesc + when (null descr) $ + warn verbose "this package has no description." + let descLines = (formatParagraphs . initialCapital . filterSymbols . finalPeriod) $ if null descr then syn' else descr + finalPeriod cs = if last cs == '.' then cs else cs ++ "." + filterSymbols (c:cs) = + if c `notElem` "@\\" then c: filterSymbols cs + else case c of + '@' -> '\'': filterSymbols cs + '\\' -> head cs: filterSymbols (tail cs) + _ -> c: filterSymbols cs + filterSymbols [] = [] + when hasLib $ do + putDef "pkg_name" name + putNewline - putHdr "Name" (if isBinLib then "%{pkg_name}" else basename) - putHdr "Version" version - putHdr "Release" $ release ++ "%{?dist}" - putHdr "Summary" summary + unless (null testsuiteDeps) $ do + put $ "%bcond_" ++ (if null missTestDeps then "without" else "with") +-+ "tests" putNewline - putHdr "License" $ (showLicense . 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" + + let eCsources = concatMap (cSources . buildInfo) $ executables pkgDesc + let lCsources = concatMap (cSources . libBuildInfo) $ maybeToList $ library pkgDesc + when (null $ eCsources ++ lCsources) $ do + put "# no useful debuginfo for Haskell packages without C sources" + putDef "debug_package" "%{nil}" putNewline - putHdr "BuildRequires" "ghc-Cabal-devel" - putHdr "BuildRequires" "ghc-rpm-macros" - (deps, tools, clibs, pkgcfgs, selfdep) <- packageDependencies pkgDesc name - let alldeps = sort $ deps ++ tools ++ map (++ "%{?_isa}") clibs ++ pkgcfgs - let extraTestDeps = sort $ testsuiteDeps \\ deps - unless (null $ alldeps ++ extraTestDeps) $ do - put "# Begin cabal-rpm deps:" - mapM_ (putHdr "BuildRequires") alldeps - when (any (\ d -> d `elem` map showDep ["template-haskell", "hamlet"]) deps) $ - putHdr "ExclusiveArch" "%{ghc_arches_with_ghci}" - unless (null extraTestDeps) $ do - put "%if %{with tests}" - mapM_ (putHdr "BuildRequires") extraTestDeps - put "%endif" - put "# End cabal-rpm deps" + putHdr "Name" (if binlib then "%{pkg_name}" else basename) + putHdr "Version" version + putHdr "Release" $ release ++ (if distro == SUSE then [] else "%{?dist}") + putHdr "Summary" summary + case distro of + SUSE -> putHdr "Group" (if binlib then "Development/Languages/Other" + else "System/Libraries") + RHEL5 -> putHdr "Group" (if binlib then "Development/Languages" + else "System Environment/Libraries") + _ -> 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" + case distro of + Fedora -> return () + _ -> putHdr "BuildRoot" "%{_tmppath}/%{name}-%{version}-build" + putNewline + putHdr "BuildRequires" "ghc-Cabal-devel" + putHdr "BuildRequires" "ghc-rpm-macros" - putNewline + let isa = if distro == SUSE then "" else "%{?_isa}" + let alldeps = sort $ deps ++ tools ++ map (++ isa) clibs ++ pkgcfgs + let extraTestDeps = sort $ testsuiteDeps \\ deps + unless (null $ alldeps ++ extraTestDeps) $ do + put "# Begin cabal-rpm deps:" + mapM_ (putHdr "BuildRequires") alldeps + when (any (\ d -> d `elem` map showDep ["template-haskell", "hamlet"]) deps) $ + putHdr "ExclusiveArch" "%{ghc_arches_with_ghci}" + unless (null extraTestDeps) $ do + put "%if %{with tests}" + mapM_ (putHdr "BuildRequires") extraTestDeps + put "%endif" + put "# End cabal-rpm deps" - put "%description" - mapM_ put descLines - putNewline + putNewline - let wrapGenDesc = wordwrap (79 - max 0 (length pkgname - length pkg_name)) + put "%description" + mapM_ put descLines + putNewline - when hasLib $ do - when isBinLib $ do - put $ "%package" +-+ ghcPkg - putHdr "Summary" $ "Haskell" +-+ pkg_name +-+ "library" - putNewline - put $ "%description" +-+ ghcPkg - put $ wrapGenDesc $ "This package provides the Haskell" +-+ pkg_name +-+ "shared library." - putNewline - put $ "%package" +-+ ghcPkgDevel - putHdr "Summary" $ "Haskell" +-+ pkg_name +-+ "library development files" - putHdr "Provides" $ (if isBinLib then "ghc-%{name}" else "%{name}") ++ "-static = %{version}-%{release}" - putHdr "Requires" "ghc-compiler = %{ghc_version}" - putHdr "Requires(post)" "ghc-compiler = %{ghc_version}" - putHdr "Requires(postun)" "ghc-compiler = %{ghc_version}" - putHdr "Requires" $ (if isBinLib then "ghc-%{name}" else "%{name}") ++ "%{?_isa} = %{version}-%{release}" - unless (null $ clibs ++ pkgcfgs) $ do - put "# Begin cabal-rpm deps:" - mapM_ (putHdr "Requires") $ sort $ map (++ "%{?_isa}") clibs ++ pkgcfgs - put "# End cabal-rpm deps" + let wrapGenDesc = wordwrap (79 - max 0 (length pkgname - length pkg_name)) + + when hasLib $ do + when binlib $ do + put $ "%package" +-+ ghcPkg + putHdr "Summary" $ "Haskell" +-+ pkg_name +-+ "library" + case distro of + Fedora -> return () + SUSE -> putHdr "Group" "System/Libraries" + RHEL5 -> putHdr "Group" "System Environment/Libraries" putNewline - put $ "%description" +-+ ghcPkgDevel - put $ wrapGenDesc $ "This package provides the Haskell" +-+ pkg_name +-+ "library development files." + put $ "%description" +-+ ghcPkg + put $ wrapGenDesc $ "This package provides the Haskell" +-+ pkg_name +-+ "shared library." putNewline - - put "%prep" - put $ "%setup -q" ++ (if pkgname /= name then " -n %{pkg_name}-%{version}" else "") + put $ "%package" +-+ ghcPkgDevel + putHdr "Summary" $ "Haskell" +-+ pkg_name +-+ "library development files" + case distro of + Fedora -> return () + RHEL5 -> putHdr "Group" "Development/Libraries" + SUSE -> putHdr "Group" "Development/Libraries/Other" + unless (distro == SUSE) $ + putHdr "Provides" $ (if binlib then "ghc-%{name}" else "%{name}") ++ "-static = %{version}-%{release}" + putHdr "Requires" "ghc-compiler = %{ghc_version}" + putHdr "Requires(post)" "ghc-compiler = %{ghc_version}" + putHdr "Requires(postun)" "ghc-compiler = %{ghc_version}" + putHdr "Requires" $ (if binlib then "ghc-%{name}" else "%{name}") ++ isa +-+ "= %{version}-%{release}" + unless (null $ clibs ++ pkgcfgs) $ do + put "# Begin cabal-rpm deps:" + mapM_ (putHdr "Requires") $ sort $ map (++ isa) clibs ++ pkgcfgs + put "# End cabal-rpm deps" putNewline + put $ "%description" +-+ ghcPkgDevel + put $ wrapGenDesc $ "This package provides the Haskell" +-+ pkg_name +-+ "library development files." putNewline - put "%build" - let pkgType = if hasLib then "lib" else "bin" - put $ "%ghc_" ++ pkgType ++ "_build" - putNewline + put "%prep" + put $ "%setup -q" ++ (if pkgname /= name then " -n %{pkg_name}-%{version}" else "") + putNewline + putNewline + + put "%build" + let pkgType = if hasLib then "lib" else "bin" + put $ "%ghc_" ++ pkgType ++ "_build" + putNewline + putNewline + + put "%install" + put $ "%ghc_" ++ pkgType ++ "_install" + when selfdep $ do putNewline + put "%ghc_fix_dynamic_rpath %{name}" + putNewline + putNewline - put "%install" - put $ "%ghc_" ++ pkgType ++ "_install" - when selfdep $ do - putNewline - put "%ghc_fix_dynamic_rpath %{name}" + unless (null testsuiteDeps) $ do + put "%check" + put "%if %{with tests}" + put "%cabal test" + put "%endif" putNewline putNewline - unless (null testsuiteDeps) $ do - put "%check" - put "%if %{with tests}" - put "%cabal test" - put "%endif" - putNewline - putNewline - - when hasLib $ do - let putInstallScript = do - put "%ghc_pkg_recache" - putNewline - putNewline - put $ "%post" +-+ ghcPkgDevel - putInstallScript - put $ "%postun" +-+ ghcPkgDevel - putInstallScript + when hasLib $ do + let putInstallScript = do + put "%ghc_pkg_recache" + putNewline + putNewline + put $ "%post" +-+ ghcPkgDevel + putInstallScript + put $ "%postun" +-+ ghcPkgDevel + putInstallScript - docs <- findDocs cabalPath pkgDesc + let licensefiles = +#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,20,0) + licenseFiles pkgDesc +#else + if null (licenseFile pkgDesc) then [] else [licenseFile pkgDesc] +#endif + docs <- findDocs cabalPath licensefiles - when hasExecPkg $ do - put "%files" - -- Add the license file to the main package only if it wouldn't - -- otherwise be empty. - unless (null $ licenseFile pkgDesc) $ - put $ "%doc" +-+ licenseFile pkgDesc - unless (null docs) $ - put $ "%doc" +-+ unwords docs + when hasExecPkg $ do + put "%files" + when (distro /= Fedora) $ put "%defattr(-,root,root,-)" + -- Add the license file to the main package only if it wouldn't + -- otherwise be empty. + mapM_ (\ l -> put $ "%doc" +-+ l) licensefiles + unless (null docs) $ + put $ "%doc" +-+ unwords docs - withExe pkgDesc $ \exe -> - let program = exeName exe in - put $ "%{_bindir}/" ++ (if program == name then "%{name}" else program) - unless (null (dataFiles pkgDesc)) $ - put "%{_datadir}/%{name}-%{version}" + withExe pkgDesc $ \exe -> + let program = exeName exe in + put $ "%{_bindir}/" ++ (if program == name then "%{name}" else program) + unless (null (dataFiles pkgDesc)) $ + put "%{_datadir}/%{name}-%{version}" - putNewline - putNewline + putNewline + putNewline - when hasLib $ do - let baseFiles = if isBinLib then "-f ghc-%{name}.files" else "-f %{name}.files" - develFiles = if isBinLib then "-f ghc-%{name}-devel.files" else "-f %{name}-devel.files" - put $ "%files" +-+ ghcPkg +-+ baseFiles - put $ "%doc" +-+ licenseFile pkgDesc - -- be strict for now --- unless (null (dataFiles pkgDesc) || isBinLib) $ + when hasLib $ do + let baseFiles = if binlib then "-f ghc-%{name}.files" else "-f %{name}.files" + develFiles = if binlib then "-f ghc-%{name}-devel.files" else "-f %{name}-devel.files" + put $ "%files" +-+ ghcPkg +-+ baseFiles + when (distro /= Fedora) $ put "%defattr(-,root,root,-)" + mapM_ (\ l -> put $ "%doc" +-+ l) licensefiles + -- be strict for now +-- unless (null (dataFiles pkgDesc) || binlib) $ -- put "%{_datadir}/%{pkg_name}-%{version}" - putNewline - putNewline - put $ "%files" +-+ ghcPkgDevel +-+ develFiles - unless (null docs) $ - put $ "%doc" +-+ unwords docs - when (not isBinLib && hasExec) $ - withExe pkgDesc $ \exe -> - let program = exeName exe in - put $ "%{_bindir}/" ++ (if program == name then "%{name}" else program) - putNewline - putNewline + putNewline + putNewline + put $ "%files" +-+ ghcPkgDevel +-+ develFiles + when (distro /= Fedora) $ put "%defattr(-,root,root,-)" + unless (null docs) $ + put $ "%doc" +-+ unwords docs + when (not binlib && hasExec) $ + withExe pkgDesc $ \exe -> + let program = exeName exe in + put $ "%{_bindir}/" ++ (if program == name then "%{name}" else program) + putNewline + putNewline + put "%changelog" + unless (distro == SUSE) $ do let date = formatTime defaultTimeLocale "%a %b %e %Y" now - put "%changelog" put $ "*" +-+ date +-+ "Fedora Haskell SIG - " ++ version ++ "-" ++ release put $ "- spec file generated by cabal-rpm-" ++ showVersion Paths_cabal_rpm.version - hClose h + hClose h + return specFile' -findDocs :: FilePath -> PackageDescription -> IO [FilePath] -findDocs cabalPath pkgDesc = do - contents <- getDirectoryContents $ dropFileName cabalPath - let docs = filter likely contents - return $ if null lf - then docs - else filter unlikely $ filter (/= lf) docs +createSpecFile_ :: PackageData -> RpmFlags -> + Maybe FilePath -> IO () +createSpecFile_ pkgFiles flags mdest = + void (createSpecFile pkgFiles flags mdest) + +findDocs :: FilePath -> [FilePath] -> IO [FilePath] +findDocs cabalPath licensefiles = do + contents <- getDirectoryContents $ dropFileName cabalPath + let docs = filter likely contents + return $ if null licensefiles + then docs + else filter unlikely $ filter (`notElem` licensefiles) docs where names = ["author", "copying", "doc", "example", "licence", "license", "readme", "todo"] likely name = let lowerName = map toLower name in any (`isPrefixOf` lowerName) names - lf = licenseFile pkgDesc unlikely name = not $ any (`isSuffixOf` name) ["~"] -showLicense :: License -> String -showLicense (GPL Nothing) = "GPL+" -showLicense (GPL (Just ver)) = "GPLv" ++ showVersion ver ++ "+" -showLicense (LGPL Nothing) = "LGPLv2+" -showLicense (LGPL (Just ver)) = "LGPLv" ++ [head $ showVersion ver] ++ "+" -showLicense BSD3 = "BSD" -showLicense BSD4 = "BSD" -showLicense MIT = "MIT" -showLicense PublicDomain = "Public Domain" -showLicense AllRightsReserved = "Proprietary" -showLicense OtherLicense = "Unknown" -showLicense (UnknownLicense l) = "Unknown" +-+ l -#if MIN_VERSION_Cabal(1,16,0) -showLicense (Apache Nothing) = "ASL ?" -showLicense (Apache (Just ver)) = "ASL" +-+ showVersion ver +showLicense :: Distro -> License -> String +showLicense SUSE (GPL Nothing) = "GPL-1.0+" +showLicense _ (GPL Nothing) = "GPL+" +showLicense SUSE (GPL (Just ver)) = "GPL-" ++ showVersion ver ++ "+" +showLicense _ (GPL (Just ver)) = "GPLv" ++ showVersion ver ++ "+" +showLicense SUSE (LGPL Nothing) = "LGPL-2.0+" +showLicense _ (LGPL Nothing) = "LGPLv2+" +showLicense SUSE (LGPL (Just ver)) = "LGPL-" ++ [head $ showVersion ver] ++ "+" +showLicense _ (LGPL (Just ver)) = "LGPLv" ++ [head $ showVersion ver] ++ "+" +showLicense SUSE BSD3 = "BSD-3-Clause" +showLicense _ BSD3 = "BSD" +showLicense SUSE BSD4 = "BSD-4-Clause" +showLicense _ BSD4 = "BSD" +showLicense _ MIT = "MIT" +showLicense SUSE PublicDomain = "SUSE-Public-Domain" +showLicense _ PublicDomain = "Public Domain" +showLicense SUSE AllRightsReserved = "SUSE-NonFree" +showLicense _ AllRightsReserved = "Proprietary" +showLicense _ OtherLicense = "Unknown" +showLicense _ (UnknownLicense l) = "Unknown" +-+ l +#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,16,0) +showLicense SUSE (Apache Nothing) = "Apache-2.0" +showLicense _ (Apache Nothing) = "ASL ?" +showLicense SUSE (Apache (Just ver)) = "Apache-" +-+ showVersion ver +showLicense _ (Apache (Just ver)) = "ASL" +-+ showVersion ver #endif -#if MIN_VERSION_Cabal(1,18,0) -showLicense (AGPL Nothing) = "AGPLv?" -showLicense (AGPL (Just ver)) = "AGPLv" ++ showVersion ver +#if defined(MIN_VERSION_Cabal) && MIN_VERSION_Cabal(1,18,0) +showLicense _ (AGPL Nothing) = "AGPLv?" +showLicense _ (AGPL (Just ver)) = "AGPLv" ++ showVersion ver #endif -- from http://stackoverflow.com/questions/930675/functional-paragraphs @@ -339,16 +400,30 @@ -- http://rosettacode.org/wiki/Word_wrap#Haskell wordwrap :: Int -> String -> String -wordwrap maxlen = wrap_ 0 False . words where - wrap_ _ _ [] = "\n" - wrap_ pos eos (w:ws) - -- at line start: put down the word no matter what - | pos == 0 = w ++ wrap_ (pos + lw) endp ws - | pos + lw + 1 > maxlen - 9 && eos = '\n':wrap_ 0 endp (w:ws) - | pos + lw + 1 > maxlen = '\n':wrap_ 0 endp (w:ws) - | otherwise = " " ++ w ++ wrap_ (pos + lw + 1) endp ws - where lw = length w - endp = last w == '.' +wordwrap maxlen = wrap_ 0 False . words + where + wrap_ _ _ [] = "\n" + wrap_ pos eos (w:ws) + -- at line start: put down the word no matter what + | pos == 0 = w ++ wrap_ (pos + lw) endp ws + | pos + lw + 1 > maxlen - 9 && eos = '\n':wrap_ 0 endp (w:ws) + | pos + lw + 1 > maxlen = '\n':wrap_ 0 endp (w:ws) + | otherwise = " " ++ w ++ wrap_ (pos + lw + 1) endp ws + where + lw = length w + endp = last w == '.' formatParagraphs :: String -> [String] formatParagraphs = map (wordwrap 79) . paragraphs . lines + +data Distro = Fedora | RHEL5 | SUSE deriving (Eq) + +-- for now assume Fedora if no /etc/SuSE-release +detectDistro :: IO Distro +detectDistro = do + suse <- doesFileExist "/etc/SuSE-release" + if suse then return SUSE + else do + -- RHEL5 does not have macros.dist + dist <- doesFileExist "/etc/rpm/macros.dist" + return $ if dist then Fedora else RHEL5 diff --git a/src/Dependencies.hs b/src/Dependencies.hs --- a/src/Dependencies.hs +++ b/src/Dependencies.hs @@ -17,15 +17,20 @@ dependencies, packageDependencies, showDep, testsuiteDependencies ) where -import SysCmd (tryReadProcess) +import SysCmd (cmd, optionalProgram, (+-+)) +import Control.Applicative ((<$>)) + import Data.List (delete, nub) +import Data.Maybe (catMaybes) import Distribution.Package (Dependency (..), PackageName (..)) import Distribution.PackageDescription (PackageDescription (..), allBuildInfo, BuildInfo (..), TestSuite (..)) +import System.Directory (doesDirectoryExist, doesFileExist) +import System.IO (hPutStrLn, stderr) excludedPkgs :: String -> Bool excludedPkgs = flip notElem ["Cabal", "base", "ghc-prim", "integer-gmp"] @@ -51,26 +56,50 @@ buildinfo = allBuildInfo pkgDesc tools = nub $ map depName (concatMap buildTools buildinfo) pkgcfgs = nub $ map depName $ concatMap pkgconfigDepends buildinfo + clibs = concatMap extraLibs buildinfo + return (deps, tools, nub clibs, pkgcfgs, selfdep) - clibs <- mapM repoqueryLib $ concatMap extraLibs buildinfo - return (deps, tools, clibs, pkgcfgs, selfdep) +resolveLib :: String -> IO (Maybe String) +resolveLib lib = do + lib64 <- doesDirectoryExist "/usr/lib64" + let libsuffix = if lib64 then "64" else "" + let lib_path = "/usr/lib" ++ libsuffix ++ "/lib" ++ lib ++ ".so" + libInst <- doesFileExist lib_path + if libInst + then rpmquery "rpm" lib_path + else do + haveRpqry <- optionalProgram "repoquery" + if haveRpqry + then do + putStrLn $ "Running repoquery on" +-+ "lib" ++ lib + rpmquery "repoquery" lib_path + else do + warning $ "Install yum-utils to resolve package that provides uninstalled" +-+ lib_path + return Nothing -repoqueryLib :: String -> IO String -repoqueryLib lib = do - let lib_path = "/usr/lib/lib" ++ lib ++ ".so" - out <- tryReadProcess "repoquery" ["--qf=%{name}", "-qf", lib_path] +-- use repoquery or rpm -q to query which package provides file +rpmquery :: String -> FilePath -> IO (Maybe String) +rpmquery c file = do + out <- cmd c ["-q", "--qf=%{name}", "-f", file] let pkgs = nub $ words out case pkgs of - [pkg] -> return pkg - [] -> error $ "Could not resolve package that provides lib" ++ lib_path - _ -> error $ "More than one package seems to provide lib" ++ lib_path ++ ": " ++ show pkgs + [pkg] -> return $ Just pkg + [] -> do + warning $ "Could not resolve package that provides" +-+ file + return Nothing + _ -> do + warning $ "More than one package seems to provide" +-+ file ++ ": " +-+ unwords pkgs + return Nothing +warning :: String -> IO () +warning s = hPutStrLn stderr $ "Warning:" +-+ s + packageDependencies :: PackageDescription -- ^pkg description -> String -- ^pkg name -> IO ([String], [String], [String], [String], Bool) -- ^depends, tools, c-libs, pkgcfg, selfdep packageDependencies pkgDesc self = do - (deps, tools', clibs, pkgcfgs, selfdep) <- dependencies pkgDesc self + (deps, tools', clibs', pkgcfgs, selfdep) <- dependencies pkgDesc self let excludedTools n = n `notElem` ["ghc", "hsc2hs", "perl"] mapTools "gtk2hsC2hs" = "gtk2hs-buildtools" mapTools "gtk2hsHookGenerator" = "gtk2hs-buildtools" @@ -78,7 +107,7 @@ mapTools tool = tool chrpath = ["chrpath" | selfdep] tools = filter excludedTools $ nub $ map mapTools tools' ++ chrpath - + clibs <- catMaybes <$> mapM resolveLib clibs' let showPkgCfg p = "pkgconfig(" ++ p ++ ")" return (map showDep deps, tools, clibs, map showPkgCfg pkgcfgs, selfdep) diff --git a/src/FileUtils.hs b/src/FileUtils.hs --- a/src/FileUtils.hs +++ b/src/FileUtils.hs @@ -15,12 +15,13 @@ -- (at your option) any later version. module FileUtils ( + filesWithExtension, fileWithExtension, fileWithExtension_, getDirectoryContents_, mktempdir) where -import SysCmd (tryReadProcess) +import SysCmd (cmd) import Control.Applicative ((<$>)) import Data.List (isPrefixOf) @@ -28,10 +29,14 @@ import System.Directory (getDirectoryContents) import System.FilePath (takeExtension, ()) +filesWithExtension :: FilePath -> String -> IO [FilePath] +filesWithExtension dir ext = + filter (\ f -> takeExtension f == ext) <$> getDirectoryContents dir + -- looks in current dir for a unique file with given extension fileWithExtension :: FilePath -> String -> IO (Maybe FilePath) fileWithExtension dir ext = do - files <- filter (\ f -> takeExtension f == ext) <$> getDirectoryContents dir + files <- filesWithExtension dir ext case files of [file] -> return $ Just $ dir file [] -> return Nothing @@ -43,9 +48,7 @@ isJust <$> fileWithExtension dir ext mktempdir :: IO FilePath -mktempdir = do - mktempOut <- tryReadProcess "mktemp" ["-d"] - return $ init mktempOut +mktempdir = cmd "mktemp" ["-d", "cblrpm.XXXXXXXXXX"] -- 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 @@ -16,52 +16,38 @@ module Main where -import Commands.Depends (depends, missingDeps, requires) +import Commands.Depends (depends, Depends (..)) import Commands.Diff (diff) import Commands.Install (install) -import Commands.RpmBuild (rpmBuild, RpmStage (..)) -import Commands.Spec (createSpecFile) +import Commands.RpmBuild (rpmBuild_) +import Commands.Spec (createSpecFile_) -import PackageUtils (simplePackageDescription) +import PackageUtils (prepare, PackageData (..), RpmStage (..)) import Setup (parseArgs) -import Data.Maybe (listToMaybe, fromMaybe) -import System.Directory (removeDirectoryRecursive) +import Control.Exception (bracket) +import System.Directory (removeDirectoryRecursive) import System.Environment (getArgs) main :: IO () -main = do (opts, args) <- getArgs >>= parseArgs - let (cmd:args') = args - path = fromMaybe "." $ listToMaybe args' - (cabalPath, pkgDesc, mtmp) <- simplePackageDescription path opts - case cmd of - "spec" -> createSpecFile cabalPath pkgDesc opts Nothing - "srpm" -> rpmBuild cabalPath pkgDesc opts Source - "prep" -> rpmBuild cabalPath pkgDesc opts Prep - "local" -> rpmBuild cabalPath pkgDesc opts Binary - "rpm" -> do - putStrLn "* Warning the 'rpm' command has been renamed to 'local':" - putStrLn "* this alias may be removed in a future release." - rpmBuild cabalPath pkgDesc opts Binary - "builddep" -> rpmBuild cabalPath pkgDesc opts BuildDep - "install" -> install cabalPath pkgDesc - "depends" -> depends pkgDesc - "requires" -> requires pkgDesc - "missingdeps" -> missingDeps pkgDesc - "diff" -> diff cabalPath pkgDesc opts - c -> error $ "Unknown cmd: " ++ c - maybe (return ()) removeDirectoryRecursive mtmp - - -- where - -- -- copied from Distribution.Simple.Configure configure - -- depResolver = if build - -- then not . null . PackageIndex.lookupDependency pkgs' - -- else (const True) - -- pkgs' = PackageIndex.insert internalPackage installedPackageSet - -- pid = packageId genPkgDesc - -- internalPackage = emptyInstalledPackageInfo { - -- Installed.installedPackageId = InstalledPackageId $ display $ pid, - -- Installed.sourcePackageId = pid - -- } - -- internalPackageSet = PackageIndex.fromList [internalPackage] - +main = do + (opts, cmd, mpkg) <- getArgs >>= parseArgs + bracket (prepare mpkg opts) + (maybe (return ()) removeDirectoryRecursive . workingDir) + (\pkgdata -> + case cmd of + "spec" -> createSpecFile_ pkgdata opts Nothing + "srpm" -> rpmBuild_ pkgdata opts Source + "prep" -> rpmBuild_ pkgdata opts Prep + "local" -> rpmBuild_ pkgdata opts Binary + "builddep" -> rpmBuild_ pkgdata opts BuildDep + "diff" -> diff pkgdata opts + "install" -> install pkgdata opts + "depends" -> depends pkgdata Depends + "requires" -> depends pkgdata Requires + "missingdeps" -> depends pkgdata Missing + "rpm" -> do + putStrLn "* Warning the 'rpm' command has been renamed to 'local':" + putStrLn "* this alias may be removed in a future release." + rpmBuild_ pkgdata opts Binary + c -> error $ "Unknown cmd: " ++ c) diff --git a/src/PackageUtils.hs b/src/PackageUtils.hs --- a/src/PackageUtils.hs +++ b/src/PackageUtils.hs @@ -14,32 +14,42 @@ -- (at your option) any later version. module PackageUtils ( + checkForSpecFile, + copyTarball, + getPkgName, isScmDir, missingPackages, notInstalled, + PackageData (..), packageName, packageVersion, + prepare, + removePrefix, + removeSuffix, + rpmbuild, + RpmStage (..), simplePackageDescription ) where import Dependencies (packageDependencies) -import FileUtils (fileWithExtension, fileWithExtension_, +import FileUtils (filesWithExtension, fileWithExtension, getDirectoryContents_, mktempdir) import Setup (RpmFlags (..)) -import SysCmd (runSystem, tryReadProcess, systemBool, (+-+)) +import SysCmd (cmd, cmd_, cmdSilent, systemBool, (+-+)) import Control.Applicative ((<$>)) -import Control.Monad (filterM, liftM) +import Control.Monad (filterM, liftM, unless, when) -import Data.Char (isAlphaNum) -import Data.List (isSuffixOf, stripPrefix) +import Data.Char (isDigit) +import Data.List (stripPrefix) import Data.Maybe (fromMaybe) import Data.Version (showVersion) import Distribution.Compiler (CompilerFlavor (..)) import Distribution.Package (PackageIdentifier (..), PackageName (..)) -import Distribution.PackageDescription (PackageDescription (..)) +import Distribution.PackageDescription (PackageDescription (..), + hasExes, hasLibs) import Distribution.PackageDescription.Configuration (finalizePackageDescription) import Distribution.PackageDescription.Parse (readPackageDescription) @@ -49,95 +59,121 @@ import Distribution.Simple.Utils (die, findPackageDesc) import Distribution.System (Platform (..), buildArch, buildOS) -import Distribution.Verbosity (Verbosity) -import System.Directory (doesDirectoryExist, doesFileExist, +import System.Directory (copyFile, doesDirectoryExist, doesFileExist, getCurrentDirectory, setCurrentDirectory) -import System.FilePath ((), takeExtension) - +import System.Environment (getEnv) +import System.FilePath ((), takeBaseName, takeFileName) +import System.Posix.Files (accessTime, fileMode, getFileStatus, + modificationTime, setFileMode) -- returns path to .cabal file and possibly tmpdir to be removed -findCabalFile :: Verbosity -> FilePath -> IO (FilePath, Maybe FilePath) -findCabalFile vb path = do - isdir <- doesDirectoryExist path - if isdir - then do - cblfile <- fileWithExtension_ path ".cabal" - if cblfile - then do - file <- findPackageDesc path - return (file, Nothing) - else do - spcfile <- fileWithExtension path ".spec" - maybe (die "Cannot determine package in dir.") - (cabalFromSpec vb) spcfile - else do - isfile <- doesFileExist path - if not isfile - then if isPackageId path - then tryUnpack path - else error $ path ++ ": No such file or directory" - else if takeExtension path == ".cabal" - then return (path, Nothing) - else if takeExtension path == ".spec" - then cabalFromSpec vb path - else if ".tar.gz" `isSuffixOf` path - then do - tmpdir <- mktempdir - runSystem $ "tar zxf " ++ path ++ " -C " ++ tmpdir ++ " *.cabal" - subdir <- getDirectoryContents_ tmpdir - file <- findPackageDesc $ tmpdir ++ "/" ++ head subdir - return (file, Just tmpdir) - else error $ path ++ ": file should be a .cabal, .spec or .tar.gz file." +--findCabalFile :: Verbosity -> FilePath -> IO (FilePath, Maybe FilePath) +--findCabalFile vb path = do + +stripVersion :: String -> String +stripVersion n | '-' `notElem` n = n +stripVersion nv = if hasVer then reverse mEman else nv where - isPackageId :: String -> Bool - isPackageId (c:cs) | isAlphaNum c = - all (\d -> isAlphaNum d || d `elem` "-." ) cs - isPackageId _ = False + (mRev, '-':mEman) = break (== '-') $ reverse nv + hasVer = all (\c -> isDigit c || c == '.') mRev simplePackageDescription :: FilePath -> RpmFlags - -> IO (FilePath, PackageDescription, Maybe FilePath) + -> IO PackageDescription simplePackageDescription path opts = do let verbose = rpmVerbosity opts - (cabalPath, mtmp) <- findCabalFile verbose path - genPkgDesc <- readPackageDescription verbose cabalPath + genPkgDesc <- readPackageDescription verbose path (compiler, _) <- configCompiler (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 (cabalPath, pd, mtmp) + Right (pd, _) -> return pd -cabalFromSpec :: Verbosity -> FilePath -> IO (FilePath, Maybe FilePath) -cabalFromSpec vrb spcfile = do +cabalFromSpec :: FilePath -> IO (FilePath, Maybe FilePath) +cabalFromSpec specFile = do -- no rpmspec command in RHEL 5 and 6 - namever <- removePrefix "ghc-" <$> tryReadProcess "rpm" ["-q", "--qf", "%{name}-%{version}\n", "--specfile", spcfile] - findCabalFile vrb (head $ lines namever) + namever <- removePrefix "ghc-" . head . lines <$> cmd "rpm" ["-q", "--qf", "%{name}-%{version}\n", "--specfile", specFile] + dExists <- doesDirectoryExist namever + if dExists + then do + specTime <- modificationTime <$> getFileStatus specFile + dirTime <- accessTime <$> getFileStatus namever + when (specTime > dirTime) $ do + bringTarball namever + rpmbuild Prep True Nothing specFile + cabal <- findPackageDesc namever + return (cabal, Nothing) + else do + tmpdir <- mktempdir + bringTarball namever + rpmbuild Prep True (Just tmpdir) specFile + cabal <- findPackageDesc $ tmpdir namever + return (cabal, Just tmpdir) where - removePrefix :: String -> String-> String - removePrefix pref str = - fromMaybe str (stripPrefix pref str) + bringTarball nv = do + fExists <- doesFileExist $ nv ++ ".tar.gz" + unless fExists $ + let (n, v) = nameVersion nv in + copyTarball n v False +nameVersion :: String -> (String, String) +nameVersion nv = + if '-' `notElem` nv + then error $ "nameVersion: malformed NAME-VER string" +-+ nv + else (reverse eman, reverse rev) + where + (rev, '-':eman) = break (== '-') $ reverse nv + +data RpmStage = Binary | Source | Prep | BuildDep deriving Eq + +rpmbuild :: RpmStage -> Bool -> Maybe FilePath -> FilePath -> IO () +rpmbuild mode quiet moutdir spec = do + let rpmCmd = case mode of + Binary -> "a" + Source -> "s" + Prep -> "p" + BuildDep -> "_" + cwd <- getCurrentDirectory + command "rpmbuild" $ ["-b" ++ rpmCmd] ++ + ["--nodeps" | mode == Prep] ++ + ["--define=_builddir" +-+ maybe cwd (cwd ) moutdir, + "--define=_rpmdir" +-+ cwd, + "--define=_srcrpmdir" +-+ cwd, + "--define=_sourcedir" +-+ cwd, + spec] + where + command = if quiet then cmdSilent else cmd_ + +removePrefix :: String -> String-> String +removePrefix pref str = fromMaybe str (stripPrefix pref str) + +removeSuffix :: String -> String -> String +removeSuffix suffix orig = + fromMaybe orig $ stripSuffix suffix orig + where + stripSuffix sf str = reverse <$> stripPrefix (reverse sf) (reverse str) + tryUnpack :: String -> IO (FilePath, Maybe FilePath) tryUnpack pkg = do pkgver <- if '.' `elem` pkg then return pkg else do - contains_pkg <- tryReadProcess "cabal" ["list", "--simple-output", pkg] - let pkgs = filter ((== pkg) . takeWhile (not . (== ' '))) $ lines contains_pkg + 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 isdir <- doesDirectoryExist pkgver if isdir then do - pth <-findPackageDesc pkgver + pth <- findPackageDesc pkgver return (pth, Nothing) else do cwd <- getCurrentDirectory tmpdir <- mktempdir setCurrentDirectory tmpdir - runSystem $ "cabal unpack -v0 " ++ pkgver + cmd_ "cabal" ["unpack", "-v0", pkgver] pth <- findPackageDesc pkgver setCurrentDirectory cwd return (tmpdir ++ "/" ++ pth, Just tmpdir) @@ -171,3 +207,100 @@ (deps, tools, clibs, pkgcfgs, _) <- packageDependencies pkgDesc name filterM notInstalled $ deps ++ ["ghc-Cabal-devel", "ghc-rpm-macros"] ++ tools ++ clibs ++ pkgcfgs +getPkgName :: Maybe FilePath -> PackageDescription -> Bool -> IO (String, Bool) +getPkgName (Just spec) pkgDesc binary = do + let name = packageName $ package pkgDesc + pkgname = takeBaseName spec + hasLib = hasLibs pkgDesc + return $ if name == pkgname || binary then (name, hasLib) else (pkgname, False) +getPkgName Nothing pkgDesc binary = do + let name = packageName $ package pkgDesc + hasExec = hasExes pkgDesc + hasLib = hasLibs pkgDesc + return $ if binary || hasExec && not hasLib then (name, hasLib) else ("ghc-" ++ name, False) + +checkForSpecFile :: Maybe String -> IO (Maybe FilePath) +checkForSpecFile Nothing = do + specs <- filesWithExtension "." ".spec" + case specs of + [one] -> return $ Just one + _ -> return Nothing +checkForSpecFile (Just pkg) = do + specs <- filesWithExtension "." ".spec" + case specs of + [one] | takeBaseName one `elem` ["ghc-" ++ pkg, pkg] -> return $ Just one + _ -> return Nothing + +checkForCabalFile :: String -> IO (Maybe FilePath) +checkForCabalFile pkgver = do + exists <- doesDirectoryExist pkgver + mcabal <- fileWithExtension (if exists then pkgver else ".") ".cabal" + return $ if (Just $ stripVersion pkgver) == (takeBaseName <$> mcabal) + then mcabal + else Nothing + +-- findSpecFile :: PackageDescription -> RpmFlags -> IO (FilePath, Bool) +-- findSpecFile pkgDesc flags = do +-- pkgname <- findPkgName pkgDesc flags +-- let specfile = pkgname ++ ".spec" +-- exists <- doesFileExist specfile +-- return (specfile, exists) + +copyTarball :: String -> String -> Bool -> IO () +copyTarball n v ranFetch = do + let tarfile = n ++ "-" ++ v ++ ".tar.gz" + already <- doesFileExist tarfile + unless already $ do + home <- getEnv "HOME" + let cacheparent = home ".cabal" "packages" + tarpath = n v tarfile + remotes <- getDirectoryContents_ cacheparent + let paths = map (\ repo -> cacheparent repo tarpath) remotes + -- if more than one tarball, should maybe warn if they are different + tarballs <- filterM doesFileExist paths + if null tarballs + then if ranFetch + then error $ "No" +-+ tarfile +-+ "found" + else do + cmd_ "cabal" ["fetch", "-v0", "--no-dependencies", n ++ "-" ++ v] + copyTarball n v True + else do + copyFile (head tarballs) tarfile + -- cabal fetch creates tarballs with mode 0600 + stat <- getFileStatus tarfile + when (fileMode stat /= 0o100644) $ + setFileMode tarfile 0o0644 + +data PackageData = + PackageData { specFilename :: Maybe FilePath + , cabalFilename :: FilePath + , packageDesc :: PackageDescription + , workingDir :: Maybe FilePath + } + +-- Nothing implies existing packaging in cwd +-- Something implies either new packaging or could be multiple spec files in dir +prepare :: Maybe String -> RpmFlags -> IO PackageData +prepare mpkgver flags = do + let mpkg = stripVersion <$> mpkgver + mspec <- checkForSpecFile mpkg + case mspec of + Just spec -> do + (cabal, mtmp) <- cabalFromSpec spec + pkgDesc <- simplePackageDescription cabal flags + return $ PackageData mspec cabal pkgDesc mtmp + Nothing -> + case mpkgver of + Nothing -> do + cwd <- getCurrentDirectory + prepare (Just $ takeFileName cwd) flags + Just pkgmver -> do + mcabal <- checkForCabalFile pkgmver + case mcabal of + Just cabal -> do + pkgDesc <- simplePackageDescription cabal flags + return $ PackageData Nothing cabal pkgDesc Nothing + Nothing -> do + (cabal, mtmp) <- tryUnpack pkgmver + pkgDesc <- simplePackageDescription cabal flags + return $ PackageData Nothing cabal pkgDesc mtmp diff --git a/src/Setup.hs b/src/Setup.hs --- a/src/Setup.hs +++ b/src/Setup.hs @@ -22,6 +22,7 @@ import Control.Monad (unless, when) import Data.Char (toLower) +import Data.Maybe (listToMaybe) import Data.Version (showVersion) import Distribution.PackageDescription (FlagName (..)) @@ -32,15 +33,16 @@ getOpt', usageInfo) import System.Environment (getProgName) import System.Exit (ExitCode (..), exitSuccess, exitWith) -import System.IO (Handle, hPutStr, hPutStrLn, stderr, stdout) +import System.IO (Handle, hPutStrLn, stderr, stdout) import Paths_cabal_rpm (version) +import SysCmd ((+-+)) data RpmFlags = RpmFlags { rpmConfigurationsFlags :: [(FlagName, Bool)] , rpmForce :: Bool , rpmHelp :: Bool - , rpmLibrary :: Bool + , rpmBinary :: Bool , rpmRelease :: Maybe String , rpmVerbosity :: Verbosity , rpmVersion :: Bool @@ -52,7 +54,7 @@ { rpmConfigurationsFlags = [] , rpmForce = False , rpmHelp = False - , rpmLibrary = False + , rpmBinary = False , rpmRelease = Nothing , rpmVerbosity = normal , rpmVersion = False @@ -64,8 +66,8 @@ [ Option "h?" ["help"] (NoArg (\x -> x { rpmHelp = True })) "Show this help text", - Option "l" ["library"] (NoArg (\x -> x { rpmLibrary = True })) - "Force package to be a Library ignoring executables", + Option "b" ["binary"] (NoArg (\x -> x { rpmBinary = True })) + "Force Haskell package name to be base package name", Option "f" ["flags"] (ReqArg (\flags x -> x { rpmConfigurationsFlags = rpmConfigurationsFlags x ++ flagList flags }) "FLAGS") "Set given flags in Cabal conditionals", Option "" ["force"] (NoArg (\x -> x { rpmForce = True })) @@ -85,52 +87,45 @@ tagWithValue name = (FlagName (map toLower name), True) printHelp :: Handle -> IO () - printHelp h = do - 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, or tarball.\n" - ++ "\n" - ++ "Commands:\n" - ++ " spec\t\t- generate a spec file\n" - ++ " srpm\t\t- generate a src rpm file\n" - ++ " prep\t\t- unpack source\n" - ++ " local\t\t- build rpm package locally\n" - ++ " builddep\t- install dependencies\n" - ++ " install\t- user install package\n" - ++ " depends\t- list Cabal depends\n" - ++ " requires\t- list package buildrequires\n" - ++ " missingdeps\t- list missing buildrequires\n" - ++ " diff\t\t- diff current spec file\n" + 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, or tarball.\n" + ++ "\n" + ++ "Commands:\n" + ++ " spec\t\t- generate a spec file\n" + ++ " srpm\t\t- generate a src rpm file\n" + ++ " prep\t\t- unpack source\n" + ++ " local\t\t- build rpm package locally\n" + ++ " builddep\t- install dependencies\n" + ++ " install\t- install packages recursively\n" + ++ " depends\t- list Cabal depends\n" + ++ " requires\t- list package buildrequires\n" + ++ " missingdeps\t- list missing buildrequires\n" + ++ " diff\t\t- diff current spec file\n" -- ++ " mock\t\t- mock build package\n" - ++ "\n" - ++ "Options:" - hPutStrLn h (usageInfo info options) + ++ "\n" + ++ "Options:" + hPutStrLn h (usageInfo info options) -parseArgs :: [String] -> IO (RpmFlags, [String]) +parseArgs :: [String] -> IO (RpmFlags, String, Maybe String) parseArgs args = do - let (os, args', unknown, errs) = getOpt' Permute options args - opts = foldl (flip ($)) emptyRpmFlags os - when (rpmHelp opts) $ do - printHelp stdout - exitSuccess - when (rpmVersion opts) $ do - putStrLn $ showVersion version - exitSuccess - unless (null errs) $ do - hPutStrLn stderr "Error:" - mapM_ (hPutStrLn stderr) errs - exitWith (ExitFailure 1) - unless (null unknown) $ do - hPutStr stderr "Unrecognised options: " - hPutStrLn stderr $ unwords unknown - exitWith (ExitFailure 1) - when (null args' || notElem (head args') ["builddep", "depends", "diff", "install", "missingdeps", "prep", "requires", "spec", "srpm", "local", "rpm"]) $ do - printHelp stderr - exitWith (ExitFailure 1) - when (length args' > 2) $ do - hPutStr stderr "Too many arguments: " - hPutStrLn stderr $ unwords args' - exitWith (ExitFailure 1) - return (opts, args') + let (os, args', unknown, errs) = getOpt' Permute options args + opts = foldl (flip ($)) emptyRpmFlags os + when (rpmHelp opts) $ do + printHelp stdout + exitSuccess + when (rpmVersion opts) $ do + putStrLn $ showVersion version + exitSuccess + unless (null errs) $ + 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 + printHelp stderr + exitWith (ExitFailure 1) + when (length args' > 2) $ + error $ "Too many arguments:" +-+ unwords args' + return (opts, head args', listToMaybe $ tail args') diff --git a/src/SysCmd.hs b/src/SysCmd.hs --- a/src/SysCmd.hs +++ b/src/SysCmd.hs @@ -15,60 +15,93 @@ -- (at your option) any later version. module SysCmd ( + optionalProgram, requireProgram, - runSystem, - tryReadProcess, + cmd, + cmd_, + cmdSilent, trySystem, + shell, + sudo, systemBool, yumInstall, (+-+)) where import Control.Monad (unless, void, when) -import Data.Maybe (isJust, isNothing) +import Data.Functor ((<$>)) +import Data.List ((\\)) +import Data.Maybe (fromMaybe, isJust, isNothing) import Distribution.Simple.Utils (die, warn, findProgramLocation) import Distribution.Verbosity (normal) import System.Posix.User (getEffectiveUserID) -import System.Process (readProcess, system) +import System.Process (readProcess, readProcessWithExitCode, system, rawSystem) import System.Exit (ExitCode(..)) requireProgram :: String -> IO () -requireProgram cmd = do - mavail <- findProgramLocation normal cmd - when (isNothing mavail) $ die (cmd ++ ": command not found") +requireProgram c = do + mavail <- findProgramLocation normal c + when (isNothing mavail) $ die (c ++ ": command not found") optionalProgram :: String -> IO Bool -optionalProgram cmd = do - mavail <- findProgramLocation normal cmd - when (isNothing mavail) $ warn normal (cmd ++ ": command not found") - return $ isJust mavail +optionalProgram c = do + mavail <- findProgramLocation normal c + when (isNothing mavail) $ warn normal (c ++ ": command not found") + return $ isJust mavail -runSystem :: String -> IO () -runSystem cmd = do - requireProgram $ head $ words cmd - ret <- system cmd - case ret of - ExitSuccess -> return () - ExitFailure n -> die ("\"" ++ cmd ++ "\"" +-+ "failed with status" +-+ show n) +cmd_ :: String -> [String] -> IO () +cmd_ c args = do + requireProgram c +-- putStrLn $ "cmd_:" +-+ c +-+ unwords args + ret <- rawSystem c args + case ret of + ExitSuccess -> return () + ExitFailure n -> die ("\"" ++ c +-+ unwords args ++ "\"" +-+ "failed with status" +-+ show n) -trySystem :: String -> IO () -trySystem cmd = do - requireProgram $ head $ words cmd - void $ system cmd +cmdSilent :: String -> [String] -> IO () +cmdSilent c args = do + requireProgram c +-- putStrLn $ "cmd_:" +-+ c +-+ unwords args + (ret, _, err) <- readProcessWithExitCode c args "" + case ret of + ExitSuccess -> return () + ExitFailure n -> die ("\"" ++ c +-+ unwords args ++ "\"" +-+ "failed with status" +-+ show n ++ "\n" ++ err) +shell :: String -> IO () +shell c = cmd_ "sh" ["-c", c] + +sudo :: String -> [String] -> IO () +sudo c as = do + requireProgram "sudo" + requireProgram c + putStrLn $ "sudo" +-+ c +-+ unwords as + cmd_ "sudo" (c:as) + +trySystem :: String -> [String] -> IO () +trySystem c args = do + requireProgram c + void $ rawSystem c args + systemBool :: String -> IO Bool -systemBool cmd = do - requireProgram $ head $ words cmd - ret <- system $ cmd +-+ ">/dev/null" - case ret of - ExitSuccess -> return True - ExitFailure _ -> return False +systemBool c = do + requireProgram $ head $ words c + ret <- system $ c +-+ ">/dev/null" + case ret of + ExitSuccess -> return True + ExitFailure _ -> return False -tryReadProcess :: FilePath -> [String] -> IO String -tryReadProcess cmd args = do - requireProgram cmd - readProcess cmd args [] +cmd :: FilePath -> [String] -> IO String +cmd c args = do + requireProgram c + removeTrailingNewline <$> readProcess c args "" + where + removeTrailingNewline :: String -> String + removeTrailingNewline "" = "" + removeTrailingNewline str = + if last str == '\n' + then init str + else str (+-+) :: String -> String -> String "" +-+ s = s @@ -78,20 +111,27 @@ yumInstall :: [String] -> Bool -> IO () yumInstall pkgs hard = unless (null pkgs) $ do - putStrLn "Uninstalled dependencies:" - mapM_ putStrLn pkgs - uid <- getEffectiveUserID - cmdprefix <- - if uid == 0 - then return "" + putStrLn $ "Running repoquery" +-+ unwords pkgs + repopkgs <- lines <$> readProcess "repoquery" (["--qf", "%{name}"] ++ pkgs) [] + if repopkgs /= pkgs + then + when hard $ + error $ unwords (pkgs \\ repopkgs) +-+ "not available." else do - havesudo <- optionalProgram "sudo" - return $ if havesudo then "sudo" else "" - requireProgram "yum" - let args = unwords $ map showPkg pkgs - putStrLn $ "Running:" +-+ cmdprefix +-+ "yum install" +-+ args - let exec = if hard then runSystem else trySystem - exec $ cmdprefix +-+ "yum install" +-+ args + 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" + 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 showPkg :: String -> String showPkg p = if '(' `elem` p then show p else p