bdcs 0.3.0 → 0.4.0
raw patch · 8 files changed
+187/−46 lines, 8 files
Files
- ChangeLog.md +17/−0
- bdcs.cabal +2/−1
- src/BDCS/Export.hs +24/−13
- src/BDCS/Export/Types.hs +43/−0
- src/BDCS/Export/Utils.hs +1/−10
- src/BDCS/Projects.hs +37/−0
- src/tools/export.hs +58/−17
- tests/test_export.sh +5/−5
ChangeLog.md view
@@ -1,3 +1,20 @@+## 0.4.0++* Add BDCS.Projects.getProjectsLike, which returns projects whose names match+ the % and _ SQL wildcards.+* Add BDCS.Projects.getProjectsTotal, which returns the number of projects in+ the database.+* Add the BDCS.Export.Types module, which is useful for specifying what form+ the export artifact will take.+* BDCS.Export.export and BDCS.Export.exportAndCustomize now require an+ ExportType parameter.+* Remove BDCS.Export.Utils.supportedOutputs. The supportedExportTypes and+ exportTypeText functions in BDCS.Export.Types can be used to produce the+ same result.+* The bdcs command line tool's export subcommand now requires a -t argument for+ specifying the form of the export artifact. The destination argument is now+ also given with -d, instead of just bare on the command line.+ ## 0.3.0 * Add BDCS.Groups.getGroupsLike, which returns groups whose names match the
bdcs.cabal view
@@ -1,5 +1,5 @@ name: bdcs-version: 0.3.0+version: 0.4.0 synopsis: Tools for managing a content store of software packages description: This module provides a library and various tools for managing a content store and metadata database. These store the contents of software packages that make up a@@ -64,6 +64,7 @@ BDCS.Export.Ostree, BDCS.Export.Tar, BDCS.Export.TmpFiles,+ BDCS.Export.Types, BDCS.Export.Utils, BDCS.Files, BDCS.GroupKeyValue,
src/BDCS/Export.hs view
@@ -18,14 +18,12 @@ exportAndCustomize) where -import Control.Conditional(cond) import Control.Monad.Except(MonadError, runExceptT, throwError) import Control.Monad.Logger(MonadLoggerIO, logDebugN) import Control.Monad.Trans.Resource(MonadBaseControl, MonadResource) import Data.Conduit(Consumer, (.|), runConduit, runConduitRes) import qualified Data.Conduit.List as CL import Data.ContentStore(openContentStore)-import Data.List(isSuffixOf) import qualified Data.Map.Strict as Map import qualified Data.Text as T import Database.Esqueleto(SqlPersistT)@@ -38,20 +36,33 @@ import qualified BDCS.Export.Ostree as Ostree import qualified BDCS.Export.Qcow2 as Qcow2 import qualified BDCS.Export.Tar as Tar+import BDCS.Export.Types(ExportType(..)) import BDCS.Export.Utils(runHacks, runTmpfiles) import BDCS.Files(groupIdToFilesC) import BDCS.Groups(getGroupIdC) -export :: (MonadBaseControl IO m, MonadError String m, MonadLoggerIO m, MonadResource m) => FilePath -> FilePath -> [T.Text] -> SqlPersistT m ()-export repo out_path things = exportAndCustomize repo out_path things []+export :: (MonadBaseControl IO m, MonadError String m, MonadLoggerIO m, MonadResource m) =>+ FilePath+ -> FilePath+ -> ExportType+ -> [T.Text]+ -> SqlPersistT m ()+export repo out_path ty things = exportAndCustomize repo out_path ty things [] -exportAndCustomize :: (MonadBaseControl IO m, MonadError String m, MonadLoggerIO m, MonadResource m) => FilePath -> FilePath -> [T.Text] -> [Customization] -> SqlPersistT m ()-exportAndCustomize repo out_path things custom | kernelMissing out_path things = throwError "ERROR: ostree exports need a kernel package included"- | otherwise = do- let objectSink = cond [(".tar" `isSuffixOf` out_path, CS.objectToTarEntry .| Tar.tarSink out_path),- (".qcow2" `isSuffixOf` out_path, Qcow2.qcow2Sink out_path),- (".repo" `isSuffixOf` out_path, Ostree.ostreeSink out_path),- (otherwise, directoryOutput out_path)]+exportAndCustomize :: (MonadBaseControl IO m, MonadError String m, MonadLoggerIO m, MonadResource m) =>+ FilePath+ -> FilePath+ -> ExportType+ -> [T.Text]+ -> [Customization]+ -> SqlPersistT m ()+exportAndCustomize repo out_path ty things custom | kernelMissing ty things = throwError "ERROR: ostree exports need a kernel package included"+ | otherwise = do+ let objectSink = case ty of+ ExportTar -> CS.objectToTarEntry .| Tar.tarSink out_path+ ExportQcow2 -> Qcow2.qcow2Sink out_path+ ExportOstree -> Ostree.ostreeSink out_path+ ExportDirectory -> directoryOutput out_path runExceptT (openContentStore repo) >>= \case Left e -> throwError $ show e@@ -76,5 +87,5 @@ logDebugN "Running standard hacks" runHacks path - kernelMissing :: FilePath -> [T.Text] -> Bool- kernelMissing out lst = ".repo" `isSuffixOf` out && not (any ("kernel-" `T.isPrefixOf`) lst)+ kernelMissing :: ExportType -> [T.Text] -> Bool+ kernelMissing exportTy lst = exportTy == ExportOstree && not (any ("kernel-" `T.isPrefixOf`) lst)
+ src/BDCS/Export/Types.hs view
@@ -0,0 +1,43 @@+-- |+-- Module: BDCS.Export.Types+-- Copyright: (c) 2018 Red Hat, Inc.+-- License: LGPL+--+-- Maintainer: https://github.com/weldr+-- Stability: alpha+-- Portability: portable+--+-- Types related to exporting.++{-# LANGUAGE OverloadedStrings #-}++module BDCS.Export.Types(ExportType(..),+ exportTypeText,+ exportTypeFromText,+ supportedExportTypes)+ where++import qualified Data.Text as T++data ExportType = ExportDirectory+ | ExportOstree+ | ExportQcow2+ | ExportTar+ deriving(Eq, Show)++exportTypeText :: ExportType -> T.Text+exportTypeText ExportDirectory = "directory"+exportTypeText ExportOstree = "ostree"+exportTypeText ExportQcow2 = "qcow2"+exportTypeText ExportTar = "tar"++exportTypeFromText :: T.Text -> Maybe ExportType+exportTypeFromText t = case T.toLower (T.strip t) of+ "directory" -> Just ExportDirectory+ "ostree" -> Just ExportOstree+ "qcow2" -> Just ExportQcow2+ "tar" -> Just ExportTar+ _ -> Nothing++supportedExportTypes :: [ExportType]+supportedExportTypes = [ExportDirectory, ExportOstree, ExportQcow2, ExportTar]
src/BDCS/Export/Utils.hs view
@@ -12,8 +12,7 @@ -- Miscellaneous utilities useful in exporting objects. module BDCS.Export.Utils(runHacks,- runTmpfiles,- supportedOutputs)+ runTmpfiles) where import Control.Conditional(whenM)@@ -23,7 +22,6 @@ import Control.Monad.Logger(MonadLoggerIO, logDebugN) import Data.List(intercalate) import Data.List.Split(splitOn)-import qualified Data.Text as T import System.Directory(createDirectoryIfMissing, doesFileExist, listDirectory, removePathForcibly, renameFile) import System.FilePath((</>)) import System.IO.Error(isDoesNotExistError)@@ -88,10 +86,3 @@ runTmpfiles exportPath = do configPath <- liftIO $ getDataFileName "data/tmpfiles-default.conf" setupFilesystem exportPath configPath---- | List the supported output formats.--- Note that any time a new output format file is added in BDCS/Export (and thus to--- the runCommand block in tools/export.hs), it should also be added here. There's--- not really any better way to accomplish this.-supportedOutputs :: [T.Text]-supportedOutputs = ["directory", "ostree", "qcow2", "tar"]
src/BDCS/Projects.hs view
@@ -14,18 +14,55 @@ -- License along with this library; if not, see <http://www.gnu.org/licenses/>. {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-} module BDCS.Projects(findProject, getProject,+ getProjectsLike,+ getProjectsTotal, insertProject, projects) where import Control.Monad.IO.Class(MonadIO)+import Data.Int(Int64) import qualified Data.Text as T import Database.Esqueleto import BDCS.DB++-- | Get the projects matching a name+-- Optionally limit the results with limit and offset+-- Also returns the total number of results, before offset and limit are applied+getProjectsLike :: MonadIO m => Maybe Int64 -> Maybe Int64 -> T.Text -> SqlPersistT m ([Projects], Int64)+getProjectsLike (Just ofst) (Just lmt) name = do+ results <- select $ from $ \project -> do+ where_ $ project ^. ProjectsName `like` val name+ orderBy [asc (project ^. ProjectsName)]+ offset ofst+ limit lmt+ return project+ total <- firstListResult $+ select $ from $ \project -> do+ where_ $ project ^. ProjectsName `like` val name+ return countRows+ return (map entityVal results, total)++getProjectsLike _ _ name = do+ results <- select $ from $ \project -> do+ where_ $ project ^. ProjectsName `like` val name+ orderBy [asc (project ^. ProjectsName)]+ return project+ total <- firstListResult $+ select $ from $ \project -> do+ where_ $ project ^. ProjectsName `like` val name+ return countRows+ return (map entityVal results, total)++-- | Return the total number of projects+getProjectsTotal :: MonadIO m => SqlPersistT m Int64+getProjectsTotal = firstListResult $+ select . from $ \(_ :: SqlExpr (Entity Projects)) -> return countRows projects :: MonadIO m => SqlPersistT m [Projects] projects = do
src/tools/export.hs view
@@ -1,4 +1,4 @@--- Copyright (C) 2017 Red Hat, Inc.+-- Copyright (C) 2017-2018 Red Hat, Inc. -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public@@ -14,21 +14,47 @@ -- License along with this library; if not, see <http://www.gnu.org/licenses/>. {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} import Control.Conditional(ifM) import Control.Monad.Except(runExceptT)+import Data.Maybe(fromJust, isNothing) import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import System.Console.GetOpt import System.Directory(doesFileExist, removePathForcibly) import System.Environment(getArgs) import System.Exit(exitFailure, exitSuccess) import BDCS.DB(checkAndRunSqlite) import BDCS.Export(export)+import BDCS.Export.Types(exportTypeText, exportTypeFromText, supportedExportTypes) import BDCS.Utils.Monad(concatMapM) import BDCS.Version -import Utils.GetOpt(commandLineArgs)+import Utils.GetOpt(OptClass, commandLineArgs, compilerOpts) +data ExportOpts = ExportOpts { optDest :: FilePath,+ optExportType :: T.Text }++instance OptClass ExportOpts++defaultExportOpts :: ExportOpts+defaultExportOpts = ExportOpts { optDest = "",+ optExportType = "tar" }++options :: [OptDescr (ExportOpts -> ExportOpts)]+options = [+ Option ['d'] ["dest"]+ (ReqArg (\d opts -> opts { optDest = d }) "DEST")+ "destination",+ Option ['t'] ["type"]+ (ReqArg (\t opts -> opts { optExportType = T.pack t }) "TYPE")+ "export type"+ ]+ -- | Check a list of strings to see if any of them are files -- If it is, read it and insert its contents in its place expandFileThings :: [String] -> IO [String]@@ -39,26 +65,41 @@ (lines <$> readFile thing) (return [thing]) +validExportTypes :: T.Text+validExportTypes = T.intercalate ", " (map exportTypeText supportedExportTypes)+ usage :: IO () usage = do printVersion "export"- putStrLn "Usage: export metadata.db repo dest thing [thing ...]"- putStrLn "dest can be:"- putStrLn "\t* A directory (which may or may not already exist)"- putStrLn "\t* The name of a .tar file to be created"- putStrLn "\t* The name of a .qcow2 image to be created"- putStrLn "\t* A directory ending in .repo, which will create a new ostree repo"- putStrLn "thing can be:"- putStrLn "\t* The NEVRA of an RPM, e.g. filesystem-3.2-21.el7.x86_64"- putStrLn "\t* A path to a file containing NEVRA of RPMs, 1 per line."+ putStrLn "Usage: export metadata.db repo -t [export type] -d [dest] thing [thing ...]"+ putStrLn "metadata.db - The path to an existing metadata repo"+ putStrLn "repo - The path to an existing content store"+ putStrLn $ "export type - One of the supported export types: " ++ T.unpack validExportTypes+ putStrLn "dest - The name of the export artifact to be created"+ putStrLn "thing -"+ putStrLn "\t* The NEVRA of an RPM, e.g. filesystem-3.2-21.el7.x86_64"+ putStrLn "\t* A path to a file containing NEVRA of RPMs, 1 per line." -- TODO group id? exitFailure main :: IO () main = commandLineArgs <$> getArgs >>= \case- Just (db, repo, out_path:things) -> do things' <- map T.pack <$> expandFileThings things- result <- runExceptT $ checkAndRunSqlite (T.pack db) $ export repo out_path things'- case result of- Left err -> removePathForcibly out_path >> print err >> exitFailure- Right _ -> exitSuccess- _ -> usage+ Nothing -> usage+ Just (db, repo, args) -> do+ (ExportOpts{..}, things) <- compilerOpts options defaultExportOpts args "export"+ things' <- map T.pack <$> expandFileThings things++ if | isNothing (exportTypeFromText optExportType) -> do+ TIO.putStrLn $ "Invalid export type. Valid types are: " `T.append` validExportTypes+ exitFailure+ | null optDest -> do+ putStrLn "No export destination given."+ exitFailure+ | null things' -> do+ putStrLn "Nothing to export."+ exitFailure+ | otherwise -> do+ let ty = fromJust $ exportTypeFromText optExportType+ runExceptT (checkAndRunSqlite (T.pack db) $ export repo optDest ty things') >>= \case+ Left err -> removePathForcibly optDest >> print err >> exitFailure+ Right _ -> exitSuccess
tests/test_export.sh view
@@ -99,11 +99,11 @@ rlPhaseStartTest "when executed without parameters shows usage" OUTPUT=`$BDCS export | head -n 2 | tail -n 1`- rlAssertEquals "Usage header as expected" "$OUTPUT" "Usage: export metadata.db repo dest thing [thing ...]"+ rlAssertEquals "Usage header as expected" "$OUTPUT" "Usage: export metadata.db repo -t [export type] -d [dest] thing [thing ...]" rlPhaseEnd rlPhaseStartTest "When exporting a non-existing package returns an error"- OUTPUT=`$BDCS export $METADATA_DB $CS_REPO $EXPORT_DIR filesystem-3.2-21.el7.x86_64 NON-EXISTING`+ OUTPUT=`$BDCS export $METADATA_DB $CS_REPO -d $EXPORT_DIR -t directory filesystem-3.2-21.el7.x86_64 NON-EXISTING` rlAssertNotEquals "On error exit code should not be zero" $? 0 rlAssertEquals "On error output is as expected" "$OUTPUT" '"No such group NON-EXISTING"' @@ -112,13 +112,13 @@ rlPhaseStartTest "When exporting existing package exported contents match what's inside the RPM"- rlRun "$BDCS export $METADATA_DB $CS_REPO $EXPORT_DIR filesystem-3.2-21.el7.x86_64 setup-2.8.71-7.el7.noarch yum-rhn-plugin-2.0.1-9.el7.noarch"+ rlRun "$BDCS export $METADATA_DB $CS_REPO -d $EXPORT_DIR -t directory filesystem-3.2-21.el7.x86_64 setup-2.8.71-7.el7.noarch yum-rhn-plugin-2.0.1-9.el7.noarch" compare_with_rpm $EXPORT_DIR filesystem-3.2-21.el7.x86_64.rpm setup-2.8.71-7.el7.noarch.rpm yum-rhn-plugin-2.0.1-9.el7.noarch.rpm sudo rm -rf $EXPORT_DIR rlPhaseEnd rlPhaseStartTest "When exporting existing package into .tar image untarred contents match the contents of RPM"- rlRun "$BDCS export $METADATA_DB $CS_REPO exported.tar filesystem-3.2-21.el7.x86_64 setup-2.8.71-7.el7.noarch yum-rhn-plugin-2.0.1-9.el7.noarch"+ rlRun "$BDCS export $METADATA_DB $CS_REPO -d exported.tar -t tar filesystem-3.2-21.el7.x86_64 setup-2.8.71-7.el7.noarch yum-rhn-plugin-2.0.1-9.el7.noarch" mkdir tar_contents && pushd tar_contents/ && tar xf ../exported.tar && popd compare_with_rpm tar_contents/ filesystem-3.2-21.el7.x86_64.rpm setup-2.8.71-7.el7.noarch.rpm yum-rhn-plugin-2.0.1-9.el7.noarch.rpm@@ -132,7 +132,7 @@ # in tog-pegasus-libs: # libcmpiCppImpl.so is a symlink to libcmpiCppImpl.so.1- OUTPUT=`$BDCS export $METADATA_DB $CS_REPO $EXPORT_DIR filesystem-3.2-21.el7.x86_64 setup-2.8.71-7.el7.noarch libcmpiCppImpl0-2.0.3-5.el7.x86_64 tog-pegasus-libs-2:2.14.1-5.el7.x86_64`+ OUTPUT=`$BDCS export $METADATA_DB $CS_REPO -d $EXPORT_DIR -t directory filesystem-3.2-21.el7.x86_64 setup-2.8.71-7.el7.noarch libcmpiCppImpl0-2.0.3-5.el7.x86_64 tog-pegasus-libs-2:2.14.1-5.el7.x86_64` rlAssertNotEquals "On error exit code should not be zero" $? 0 rlAssertEquals "On error output is as expected" "$OUTPUT" '"Unable to add /usr/lib64/libcmpiCppImpl.so, symlink already added at this location"'