From 4e41a1bb4776d9831bd20c30eadd7950199f1a07 Mon Sep 17 00:00:00 2001 From: Chris Lumens Date: Thu, 22 Feb 2018 16:37:29 -0500 Subject: [PATCH 1/5] Add a supportedOutputs function to Utils.hs. For now, this just spits out a static list of the various output formats that can be used. It may get more clever in the future. --- src/BDCS/Export/Utils.hs | 31 +++++++++++++++++++++---------- 1 file changed, 21 insertions(+), 10 deletions(-) diff --git a/src/BDCS/Export/Utils.hs b/src/BDCS/Export/Utils.hs index 92ada99..dd6c754 100644 --- a/src/BDCS/Export/Utils.hs +++ b/src/BDCS/Export/Utils.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + -- | -- Module: BDCS.Export.Utils -- Copyright: (c) 2017 Red Hat, Inc. @@ -10,18 +12,20 @@ -- Miscellaneous utilities useful in exporting objects. module BDCS.Export.Utils(runHacks, - runTmpfiles) + runTmpfiles, + supportedOutputs) where -import Control.Conditional(whenM) -import Control.Exception(tryJust) -import Control.Monad(guard) -import Data.List(intercalate) -import Data.List.Split(splitOn) -import System.Directory(createDirectoryIfMissing, doesFileExist, listDirectory, removePathForcibly, renameFile) -import System.FilePath(()) -import System.IO.Error(isDoesNotExistError) -import System.Process(callProcess) +import Control.Conditional(whenM) +import Control.Exception(tryJust) +import Control.Monad(guard) +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) +import System.Process(callProcess) import BDCS.Export.TmpFiles(setupFilesystem) @@ -74,3 +78,10 @@ runTmpfiles :: FilePath -> IO () runTmpfiles exportPath = do configPath <- getDataFileName "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"] From 8d8c9b0fd913aa54a366f263c200e43d615e47ed Mon Sep 17 00:00:00 2001 From: Chris Lumens Date: Tue, 27 Feb 2018 10:49:50 -0500 Subject: [PATCH 2/5] In export, call expandFileThings outside of runCommand. --- src/tools/export.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/tools/export.hs b/src/tools/export.hs index 46cfa13..ab99dc5 100644 --- a/src/tools/export.hs +++ b/src/tools/export.hs @@ -78,10 +78,8 @@ needKernel = do putStrLn "ERROR: ostree exports need a kernel package included" exitFailure -runCommand :: FilePath -> FilePath -> FilePath -> [String] -> IO () -runCommand db repo out_path fileThings = do - things <- map T.pack <$> expandFileThings fileThings - +runCommand :: FilePath -> FilePath -> FilePath -> [T.Text] -> IO () +runCommand db repo out_path things = do cs <- runCsMonad (openContentStore repo) >>= \case Left e -> print e >> exitFailure Right r -> return r @@ -119,5 +117,6 @@ runCommand db repo out_path fileThings = do main :: IO () main = commandLineArgs <$> getArgs >>= \case - Just (db, repo, out_path:things) -> runCommand db repo out_path things + Just (db, repo, out_path:things) -> do things' <- map T.pack <$> expandFileThings things + runCommand db repo out_path things' _ -> usage From efa2759f623685f2063d1ac8bcf150c5adaa07f3 Mon Sep 17 00:00:00 2001 From: Chris Lumens Date: Tue, 27 Feb 2018 11:13:30 -0500 Subject: [PATCH 3/5] Make runCommand look more like a regular library function. Have it return a string on error instead of printing and exiting. Do those things from the caller. This is to get it rady to move out into the library. --- src/tools/export.hs | 64 ++++++++++++++++++++------------------------- 1 file changed, 28 insertions(+), 36 deletions(-) diff --git a/src/tools/export.hs b/src/tools/export.hs index ab99dc5..c2d97b6 100644 --- a/src/tools/export.hs +++ b/src/tools/export.hs @@ -19,7 +19,6 @@ {-# LANGUAGE RankNTypes #-} import Control.Conditional(cond, ifM) -import Control.Monad(unless, when) import Control.Monad.Except(MonadError, runExceptT) import Control.Monad.IO.Class(MonadIO, liftIO) import Data.Conduit(Consumer, (.|), runConduit, runConduitRes) @@ -41,7 +40,6 @@ import qualified BDCS.Export.Tar as Tar import BDCS.Export.Utils(runHacks, runTmpfiles) import BDCS.Files(groupIdToFilesC) import BDCS.Groups(getGroupIdC) -import BDCS.Utils.Either(whenLeft) import BDCS.Utils.Monad(concatMapM) import BDCS.Version @@ -72,37 +70,29 @@ usage = do -- TODO group id? exitFailure -needKernel :: IO () -needKernel = do - printVersion "export" - putStrLn "ERROR: ostree exports need a kernel package included" - exitFailure - -runCommand :: FilePath -> FilePath -> FilePath -> [T.Text] -> IO () -runCommand db repo out_path things = do - cs <- runCsMonad (openContentStore repo) >>= \case - Left e -> print e >> exitFailure - Right r -> return r - - when (".repo" `isSuffixOf` out_path) $ - unless (any ("kernel-" `T.isPrefixOf`) things) needKernel - - let (handler, objectSink) = cond [(".tar" `isSuffixOf` out_path, (cleanupHandler out_path, CS.objectToTarEntry .| Tar.tarSink out_path)), - (".qcow2" `isSuffixOf` out_path, (cleanupHandler out_path, Qcow2.qcow2Sink out_path)), - (".repo" `isSuffixOf` out_path, (cleanupHandler out_path, Ostree.ostreeSink out_path)), - (otherwise, (print, directoryOutput out_path))] - - result <- runExceptT $ do - -- Build the filesystem tree to export - fstree <- checkAndRunSqlite (T.pack db) $ runConduit $ CL.sourceList things - .| getGroupIdC - .| groupIdToFilesC - .| filesToTree - - -- Traverse the tree and export the file contents - runConduitRes $ fstreeSource fstree .| CS.filesToObjectsC cs .| objectSink - - whenLeft result (\e -> handler e >> exitFailure) +runCommand :: FilePath -> FilePath -> FilePath -> [T.Text] -> IO (Either String ()) +runCommand db repo out_path things | kernelMissing out_path things = return $ Left "ERROR: ostree exports need a kernel package included" + | otherwise = runCsMonad (openContentStore repo) >>= \case + Left e -> return $ Left $ show e + Right cs -> do + let (handler, objectSink) = cond [(".tar" `isSuffixOf` out_path, (removePathForcibly out_path, CS.objectToTarEntry .| Tar.tarSink out_path)), + (".qcow2" `isSuffixOf` out_path, (removePathForcibly out_path, Qcow2.qcow2Sink out_path)), + (".repo" `isSuffixOf` out_path, (removePathForcibly out_path, Ostree.ostreeSink out_path)), + (otherwise, (return (), directoryOutput out_path))] + + result <- runExceptT $ do + -- Build the filesystem tree to export + fstree <- checkAndRunSqlite (T.pack db) $ runConduit $ CL.sourceList things + .| getGroupIdC + .| groupIdToFilesC + .| filesToTree + + -- Traverse the tree and export the file contents + runConduitRes $ fstreeSource fstree .| CS.filesToObjectsC cs .| objectSink + + case result of + Left e -> handler >> return (Left e) + Right _ -> return $ Right () where directoryOutput :: (MonadError String m, MonadIO m) => FilePath -> Consumer (Files, CS.Object) m () directoryOutput path = do @@ -112,11 +102,13 @@ runCommand db repo out_path things = do Directory.directorySink path liftIO $ runHacks path - cleanupHandler :: Show a => FilePath -> a -> IO () - cleanupHandler path e = print e >> removePathForcibly path + kernelMissing :: FilePath -> [T.Text] -> Bool + kernelMissing out lst = ".repo" `isSuffixOf` out && not (any ("kernel-" `T.isPrefixOf`) lst) main :: IO () main = commandLineArgs <$> getArgs >>= \case Just (db, repo, out_path:things) -> do things' <- map T.pack <$> expandFileThings things - runCommand db repo out_path things' + runCommand db repo out_path things' >>= \case + Left e -> printVersion "export" >> putStrLn e >> exitFailure + Right _ -> return () _ -> usage From c7cf75f9b574d936d0e00689d22cc1ec80cd55ff Mon Sep 17 00:00:00 2001 From: Chris Lumens Date: Tue, 27 Feb 2018 11:48:35 -0500 Subject: [PATCH 4/5] Create a new top-level export function in the library. This is just the body of the old runCommand function from the export tool, moved out on its own and with all the imports updated. --- bdcs.cabal | 1 + src/BDCS/Export.hs | 74 +++++++++++++++++++++++++++++++++++++++++++++ src/tools/export.hs | 61 +++---------------------------------- 3 files changed, 79 insertions(+), 57 deletions(-) create mode 100644 src/BDCS/Export.hs diff --git a/bdcs.cabal b/bdcs.cabal index 14a4225..feaff7b 100644 --- a/bdcs.cabal +++ b/bdcs.cabal @@ -61,6 +61,7 @@ library BDCS.Depclose, BDCS.Depsolve, BDCS.Exceptions, + BDCS.Export, BDCS.Export.Directory, BDCS.Export.FSTree, BDCS.Export.Qcow2, diff --git a/src/BDCS/Export.hs b/src/BDCS/Export.hs new file mode 100644 index 0000000..b991912 --- /dev/null +++ b/src/BDCS/Export.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} + +-- | +-- Module: BDCS.Export +-- Copyright: (c) 2017-2018 Red Hat, Inc. +-- License: LGPL +-- +-- Maintainer: https://github.com/weldr +-- Stability: alpha +-- Portability: portable +-- +-- Top-level function for exporting objects from the BDCS. + +module BDCS.Export(export) + where + +import Control.Conditional(cond) +import Control.Monad.Except(MonadError, runExceptT) +import Control.Monad.IO.Class(MonadIO, liftIO) +import Data.Conduit(Consumer, (.|), runConduit, runConduitRes) +import Data.Conduit.List as CL +import Data.ContentStore(openContentStore, runCsMonad) +import Data.List(isSuffixOf) +import qualified Data.Text as T +import System.Directory(removePathForcibly) + +import qualified BDCS.CS as CS +import BDCS.DB(Files, checkAndRunSqlite) +import qualified BDCS.Export.Directory as Directory +import BDCS.Export.FSTree(filesToTree, fstreeSource) +import qualified BDCS.Export.Ostree as Ostree +import qualified BDCS.Export.Qcow2 as Qcow2 +import qualified BDCS.Export.Tar as Tar +import BDCS.Export.Utils(runHacks, runTmpfiles) +import BDCS.Files(groupIdToFilesC) +import BDCS.Groups(getGroupIdC) + +export :: FilePath -> FilePath -> FilePath -> [T.Text] -> IO (Either String ()) +export db repo out_path things | kernelMissing out_path things = return $ Left "ERROR: ostree exports need a kernel package included" + | otherwise = runCsMonad (openContentStore repo) >>= \case + Left e -> return $ Left $ show e + Right cs -> do + let (handler, objectSink) = cond [(".tar" `isSuffixOf` out_path, (removePathForcibly out_path, CS.objectToTarEntry .| Tar.tarSink out_path)), + (".qcow2" `isSuffixOf` out_path, (removePathForcibly out_path, Qcow2.qcow2Sink out_path)), + (".repo" `isSuffixOf` out_path, (removePathForcibly out_path, Ostree.ostreeSink out_path)), + (otherwise, (return (), directoryOutput out_path))] + + result <- runExceptT $ do + -- Build the filesystem tree to export + fstree <- checkAndRunSqlite (T.pack db) $ runConduit $ CL.sourceList things + .| getGroupIdC + .| groupIdToFilesC + .| filesToTree + + -- Traverse the tree and export the file contents + runConduitRes $ fstreeSource fstree .| CS.filesToObjectsC cs .| objectSink + + case result of + Left e -> handler >> return (Left e) + Right _ -> return $ Right () + where + directoryOutput :: (MonadError String m, MonadIO m) => FilePath -> Consumer (Files, CS.Object) m () + directoryOutput path = do + -- Apply tmpfiles.d to the directory first + liftIO $ runTmpfiles path + + Directory.directorySink path + liftIO $ runHacks path + + kernelMissing :: FilePath -> [T.Text] -> Bool + kernelMissing out lst = ".repo" `isSuffixOf` out && not (any ("kernel-" `T.isPrefixOf`) lst) diff --git a/src/tools/export.hs b/src/tools/export.hs index c2d97b6..6ce5926 100644 --- a/src/tools/export.hs +++ b/src/tools/export.hs @@ -13,33 +13,15 @@ -- You should have received a copy of the GNU Lesser General Public -- License along with this library; if not, see . -{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -import Control.Conditional(cond, ifM) -import Control.Monad.Except(MonadError, runExceptT) -import Control.Monad.IO.Class(MonadIO, liftIO) -import Data.Conduit(Consumer, (.|), runConduit, runConduitRes) -import qualified Data.Conduit.List as CL -import Data.ContentStore(openContentStore, runCsMonad) -import Data.List(isSuffixOf) +import Control.Conditional(ifM) import qualified Data.Text as T -import System.Directory(doesFileExist, removePathForcibly) +import System.Directory(doesFileExist) import System.Environment(getArgs) import System.Exit(exitFailure) -import qualified BDCS.CS as CS -import BDCS.DB(Files, checkAndRunSqlite) -import qualified BDCS.Export.Directory as Directory -import BDCS.Export.FSTree(filesToTree, fstreeSource) -import qualified BDCS.Export.Qcow2 as Qcow2 -import qualified BDCS.Export.Ostree as Ostree -import qualified BDCS.Export.Tar as Tar -import BDCS.Export.Utils(runHacks, runTmpfiles) -import BDCS.Files(groupIdToFilesC) -import BDCS.Groups(getGroupIdC) +import BDCS.Export(export) import BDCS.Utils.Monad(concatMapM) import BDCS.Version @@ -70,45 +52,10 @@ usage = do -- TODO group id? exitFailure -runCommand :: FilePath -> FilePath -> FilePath -> [T.Text] -> IO (Either String ()) -runCommand db repo out_path things | kernelMissing out_path things = return $ Left "ERROR: ostree exports need a kernel package included" - | otherwise = runCsMonad (openContentStore repo) >>= \case - Left e -> return $ Left $ show e - Right cs -> do - let (handler, objectSink) = cond [(".tar" `isSuffixOf` out_path, (removePathForcibly out_path, CS.objectToTarEntry .| Tar.tarSink out_path)), - (".qcow2" `isSuffixOf` out_path, (removePathForcibly out_path, Qcow2.qcow2Sink out_path)), - (".repo" `isSuffixOf` out_path, (removePathForcibly out_path, Ostree.ostreeSink out_path)), - (otherwise, (return (), directoryOutput out_path))] - - result <- runExceptT $ do - -- Build the filesystem tree to export - fstree <- checkAndRunSqlite (T.pack db) $ runConduit $ CL.sourceList things - .| getGroupIdC - .| groupIdToFilesC - .| filesToTree - - -- Traverse the tree and export the file contents - runConduitRes $ fstreeSource fstree .| CS.filesToObjectsC cs .| objectSink - - case result of - Left e -> handler >> return (Left e) - Right _ -> return $ Right () - where - directoryOutput :: (MonadError String m, MonadIO m) => FilePath -> Consumer (Files, CS.Object) m () - directoryOutput path = do - -- Apply tmpfiles.d to the directory first - liftIO $ runTmpfiles path - - Directory.directorySink path - liftIO $ runHacks path - - kernelMissing :: FilePath -> [T.Text] -> Bool - kernelMissing out lst = ".repo" `isSuffixOf` out && not (any ("kernel-" `T.isPrefixOf`) lst) - main :: IO () main = commandLineArgs <$> getArgs >>= \case Just (db, repo, out_path:things) -> do things' <- map T.pack <$> expandFileThings things - runCommand db repo out_path things' >>= \case + export db repo out_path things' >>= \case Left e -> printVersion "export" >> putStrLn e >> exitFailure Right _ -> return () _ -> usage From 68cebc68d10122caea374c7ae6ab64cffbdf62a4 Mon Sep 17 00:00:00 2001 From: Chris Lumens Date: Tue, 27 Feb 2018 16:29:43 -0500 Subject: [PATCH 5/5] The export function no longer takes an mddb argument. Instead it is now set up to operate from inside runSqlite, or checkAndRunSqlite, or runSqlPool (which is what bdcs-api needs). Errors are returned via throwError, and error handling cleanup has been removed. It's now expected that the caller will clean up on error. The standalone export tool was modified as needed. --- src/BDCS/Export.hs | 44 +++++++++++++++++++------------------------- src/tools/export.hs | 19 +++++++++++-------- 2 files changed, 30 insertions(+), 33 deletions(-) diff --git a/src/BDCS/Export.hs b/src/BDCS/Export.hs index b991912..b5eb075 100644 --- a/src/BDCS/Export.hs +++ b/src/BDCS/Export.hs @@ -18,17 +18,18 @@ module BDCS.Export(export) where import Control.Conditional(cond) -import Control.Monad.Except(MonadError, runExceptT) +import Control.Monad.Except(MonadError, runExceptT, throwError) import Control.Monad.IO.Class(MonadIO, liftIO) +import Control.Monad.Trans.Resource(MonadBaseControl, MonadResource) import Data.Conduit(Consumer, (.|), runConduit, runConduitRes) import Data.Conduit.List as CL -import Data.ContentStore(openContentStore, runCsMonad) +import Data.ContentStore(openContentStore) import Data.List(isSuffixOf) import qualified Data.Text as T -import System.Directory(removePathForcibly) +import Database.Esqueleto(SqlPersistT) import qualified BDCS.CS as CS -import BDCS.DB(Files, checkAndRunSqlite) +import BDCS.DB(Files) import qualified BDCS.Export.Directory as Directory import BDCS.Export.FSTree(filesToTree, fstreeSource) import qualified BDCS.Export.Ostree as Ostree @@ -38,29 +39,22 @@ import BDCS.Export.Utils(runHacks, runTmpfiles) import BDCS.Files(groupIdToFilesC) import BDCS.Groups(getGroupIdC) -export :: FilePath -> FilePath -> FilePath -> [T.Text] -> IO (Either String ()) -export db repo out_path things | kernelMissing out_path things = return $ Left "ERROR: ostree exports need a kernel package included" - | otherwise = runCsMonad (openContentStore repo) >>= \case - Left e -> return $ Left $ show e - Right cs -> do - let (handler, objectSink) = cond [(".tar" `isSuffixOf` out_path, (removePathForcibly out_path, CS.objectToTarEntry .| Tar.tarSink out_path)), - (".qcow2" `isSuffixOf` out_path, (removePathForcibly out_path, Qcow2.qcow2Sink out_path)), - (".repo" `isSuffixOf` out_path, (removePathForcibly out_path, Ostree.ostreeSink out_path)), - (otherwise, (return (), directoryOutput out_path))] +export :: (MonadBaseControl IO m, MonadError String m, MonadIO m, MonadResource m) => FilePath -> FilePath -> [T.Text] -> SqlPersistT m () +export repo out_path things | 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)] - result <- runExceptT $ do - -- Build the filesystem tree to export - fstree <- checkAndRunSqlite (T.pack db) $ runConduit $ CL.sourceList things - .| getGroupIdC - .| groupIdToFilesC - .| filesToTree - - -- Traverse the tree and export the file contents + runExceptT (openContentStore repo) >>= \case + Left e -> throwError $ show e + Right cs -> do + fstree <- runConduit $ CL.sourceList things + .| getGroupIdC + .| groupIdToFilesC + .| filesToTree runConduitRes $ fstreeSource fstree .| CS.filesToObjectsC cs .| objectSink - - case result of - Left e -> handler >> return (Left e) - Right _ -> return $ Right () where directoryOutput :: (MonadError String m, MonadIO m) => FilePath -> Consumer (Files, CS.Object) m () directoryOutput path = do diff --git a/src/tools/export.hs b/src/tools/export.hs index 6ce5926..8b8b8cd 100644 --- a/src/tools/export.hs +++ b/src/tools/export.hs @@ -16,14 +16,16 @@ {-# LANGUAGE LambdaCase #-} import Control.Conditional(ifM) +import Control.Monad.Except(runExceptT) import qualified Data.Text as T -import System.Directory(doesFileExist) +import System.Directory(doesFileExist, removePathForcibly) import System.Environment(getArgs) -import System.Exit(exitFailure) +import System.Exit(exitFailure, exitSuccess) -import BDCS.Export(export) -import BDCS.Utils.Monad(concatMapM) -import BDCS.Version +import BDCS.DB(checkAndRunSqlite) +import BDCS.Export(export) +import BDCS.Utils.Monad(concatMapM) +import BDCS.Version import Utils.GetOpt(commandLineArgs) @@ -55,7 +57,8 @@ usage = do main :: IO () main = commandLineArgs <$> getArgs >>= \case Just (db, repo, out_path:things) -> do things' <- map T.pack <$> expandFileThings things - export db repo out_path things' >>= \case - Left e -> printVersion "export" >> putStrLn e >> exitFailure - Right _ -> return () + 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