bdcs 0.2.1 → 0.2.2
raw patch · 10 files changed
+312/−59 lines, 10 filesdep ~codec-rpmdep ~content-storedep ~exceptions
Dependency ranges changed: codec-rpm, content-store, exceptions, monad-logger
Files
- ChangeLog.md +11/−0
- bdcs.cabal +11/−14
- src/BDCS/CS.hs +12/−6
- src/BDCS/Export.hs +16/−6
- src/BDCS/Export/Customize.hs +65/−0
- src/BDCS/Export/FSTree.hs +50/−28
- src/BDCS/Export/Ostree.hs +2/−2
- src/BDCS/Export/Utils.hs +2/−2
- src/tests/BDCS/Export/FSTreeSpec.hs +142/−0
- tests/test_export.sh +1/−1
ChangeLog.md view
@@ -1,3 +1,14 @@+## 0.2.2++* Add BDCS.CS.fileToObjectC, which, when used as part of a conduit, fetches+ the data for a single file from a ContentStore.+* Add BDCS.Export.Customize, which provides types and functions for modifying+ the data exported from a ContentStore.+* Add BDCS.Export.exportAndCustomize, which includes Customization data in an+ export.+* Include schema.sql in the data-files.+* Bug fixes related to FSTree and symlinks.+ ## 0.2.1 * Add BDCS.Export.export, which is the bulk of the "bdcs export" command
bdcs.cabal view
@@ -1,5 +1,5 @@ name: bdcs-version: 0.2.1+version: 0.2.2 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@@ -10,16 +10,13 @@ category: Distribution author: Chris Lumens maintainer: clumens@redhat.com-license: LGPL+license: LGPL-2.1 license-file: LICENSE build-type: Custom cabal-version: >= 1.10 -data-dir: data-data-files: sysusers-default.conf,- tmpfiles-default.conf,- tmpfiles-ostree.conf,- nsswitch-altfiles.conf+data-files: schema.sql,+ data/*.conf extra-source-files: ChangeLog.md, Dockerfile,@@ -30,7 +27,6 @@ Makefile, queries, README.md- schema.sql, src/tests/*.hs, src/tests/BDCS/*.hs, src/tests/BDCS/Export/*.hs,@@ -61,6 +57,7 @@ BDCS.Depsolve, BDCS.Exceptions, BDCS.Export,+ BDCS.Export.Customize, BDCS.Export.Directory, BDCS.Export.FSTree, BDCS.Export.Qcow2,@@ -119,18 +116,18 @@ build-depends: aeson >= 1.0.0.0 && < 1.3.0.0, base >= 4.9 && < 5.0, bytestring >= 0.10 && < 0.11,- codec-rpm >= 0.2.0 && < 0.3,+ codec-rpm >= 0.2.1 && < 0.3, cond >= 0.4.1.1 && < 0.5.0.0, conduit >= 1.2.8 && < 1.3, conduit-combinators >= 1.1.0 && < 1.2, conduit-extra >= 1.1.0 && < 1.3, containers >= 0.5.7.1 && < 0.6,- content-store >= 0.2.0 && < 0.3.0,+ content-store >= 0.2.1 && < 0.3.0, cpio-conduit >= 0.7.0 && < 0.8.0, cryptonite >= 0.22 && < 0.30, directory >= 1.3.0.0 && < 1.4.0.0, esqueleto >= 2.5.3 && < 2.6.0,- exceptions >= 0.8.0 && < 0.9.0,+ exceptions >= 0.8.0 && < 0.11.0, filepath >= 1.4.1.1 && < 1.5.0.0, gi-gio >= 2.0.14 && < 2.1.0, gi-glib >= 2.0.14 && < 2.1.0,@@ -140,7 +137,7 @@ listsafe >= 0.1.0.1 && < 0.2.0, memory >= 0.14.3 && < 0.15.0, monad-control >= 1.0.1.0 && < 1.1.0.0,- monad-logger >= 0.3.20.2 && < 0.4.0,+ monad-logger >= 0.3.20.2 && < 0.3.28.2, mtl >= 2.2.1 && < 2.3, network-uri >= 2.6.0 && < 2.7.0, parsec >= 3.1.10 && < 3.2.0,@@ -369,7 +366,7 @@ aeson >= 1.0.0.0 && < 1.3.0.0, base >= 4.8 && < 5.0, bytestring >= 0.10 && < 0.11,- codec-rpm >= 0.2.0 && < 0.3,+ codec-rpm >= 0.2.1 && < 0.3, cond >= 0.4.1.1 && < 0.5.0.0, conduit >= 1.2.8 && < 1.3, conduit-combinators >= 1.1.0 && < 1.2,@@ -380,7 +377,7 @@ gi-gio >= 2.0.14 && < 2.1.0, gi-glib >= 2.0.14 && < 2.1.0, listsafe >= 0.1.0.1 && < 0.2.0,- monad-logger >= 0.3.20.2 && < 0.4.0,+ monad-logger >= 0.3.20.2 && < 0.3.28.2, mtl >= 2.2.1 && < 2.3, parsec >= 3.1.10 && < 3.2.0, parsec-numbers >= 0.1.0 && < 0.2.0,
src/BDCS/CS.hs view
@@ -18,6 +18,7 @@ -- Conduit-based interface between BDCS and its underlying content store. module BDCS.CS(Object(..),+ fileToObjectC, filesToObjectsC, objectToTarEntry) where@@ -44,12 +45,10 @@ -- by a 'Files' record so its metadata can be tracked | FileObject BS.ByteString -- ^ A file object with its contents --- | Read 'Files' records from a 'Conduit', find the object in the content store, and return the--- matching 'Object' if found. An error is thrown if the object does not exist, or if there is--- any other error interacting with the content store. In addition, the 'Files' object is also--- returned as part of the result tuple so its metadata can be used by downstream consumers.-filesToObjectsC :: (MonadError String m, MonadIO m) => ContentStore -> Conduit Files m (Files, Object)-filesToObjectsC repo = awaitForever $ \f@Files{..} ->+-- | For a given 'Files' record, find the object in the content store, and return the corresponding object.+-- This is a version of 'filesToObjectsC' suitable as an argument for 'awaitForever'.+fileToObjectC :: (MonadError String m, MonadIO m) => ContentStore -> Files -> Conduit Files m (Files, Object)+fileToObjectC repo f@Files{..} = let isRegular = fromIntegral filesMode `intersectFileModes` fileTypeModes == regularFileMode in case (isRegular, filesCs_object) of -- Not a regular file@@ -61,6 +60,13 @@ liftIO (runCsMonad $ fetchByteString repo digest) >>= \case Left e -> throwError (show e) Right obj -> yield (f, FileObject obj)++-- | Read 'Files' records from a 'Conduit', find the object in the content store, and return the+-- matching 'Object' if found. An error is thrown if the object does not exist, or if there is+-- any other error interacting with the content store. In addition, the 'Files' object is also+-- returned as part of the result tuple so its metadata can be used by downstream consumers.+filesToObjectsC :: (MonadError String m, MonadIO m) => ContentStore -> Conduit Files m (Files, Object)+filesToObjectsC repo = awaitForever (fileToObjectC repo) -- | Read tuples from a 'Conduit' and convert each into a 'Codec.Archive.Tar.Entry' suitable for -- streaming into an archive. Metadata such as permissions and ownerships will be set correctly.
src/BDCS/Export.hs view
@@ -14,7 +14,8 @@ -- -- Top-level function for exporting objects from the BDCS. -module BDCS.Export(export)+module BDCS.Export(export,+ exportAndCustomize) where import Control.Conditional(cond)@@ -22,15 +23,17 @@ 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 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) import qualified BDCS.CS as CS import BDCS.DB(Files) import qualified BDCS.Export.Directory as Directory+import BDCS.Export.Customize(Customization, filesToObjectsC, runCustomizations) import BDCS.Export.FSTree(filesToTree, fstreeSource) import qualified BDCS.Export.Ostree as Ostree import qualified BDCS.Export.Qcow2 as Qcow2@@ -39,9 +42,12 @@ import BDCS.Files(groupIdToFilesC) import BDCS.Groups(getGroupIdC) -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+export :: (MonadBaseControl IO m, MonadError String m, MonadResource m) => FilePath -> FilePath -> [T.Text] -> SqlPersistT m ()+export repo out_path things = exportAndCustomize repo out_path things []++exportAndCustomize :: (MonadBaseControl IO m, MonadError String 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),@@ -54,7 +60,11 @@ .| getGroupIdC .| groupIdToFilesC .| filesToTree- runConduitRes $ fstreeSource fstree .| CS.filesToObjectsC cs .| objectSink++ let overlay = Map.empty+ (overlay', fstree') <- runCustomizations overlay cs fstree custom++ runConduitRes $ fstreeSource fstree' .| filesToObjectsC overlay' cs .| objectSink where directoryOutput :: (MonadError String m, MonadIO m) => FilePath -> Consumer (Files, CS.Object) m () directoryOutput path = do
+ src/BDCS/Export/Customize.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards #-}++module BDCS.Export.Customize(CSOverlay,+ Customization(..),+ addToOverlay,+ filesToObjectsC,+ runCustomizations)+ where++import Control.Monad(foldM)+import Control.Monad.Except(MonadError)+import Control.Monad.IO.Class(MonadIO)+import Crypto.Hash(Digest, hash)+import Crypto.Hash.Algorithms(Blake2b_256)+import Data.ByteArray(convert)+import qualified Data.ByteString as BS+import Data.Conduit(Conduit, awaitForever, yield)+import Data.ContentStore(ContentStore)+import qualified Data.Map.Strict as Map++import BDCS.CS(Object(..), fileToObjectC)+import BDCS.DB(Files(..))+import BDCS.Export.FSTree(FSTree, addFileToTree)++type CSOverlay = Map.Map BS.ByteString Object++-- Just one type of customization for now, more to come later+{-# ANN module "HLint: ignore Use newtype instead of data" #-}+data Customization = WriteFile Files (Maybe BS.ByteString)+ deriving (Eq, Show)++-- Not everything looks good as an operator, hlint+{-# ANN filesToObjectsC "HLint: ignore Use section" #-}+filesToObjectsC :: (MonadError String m, MonadIO m) => CSOverlay -> ContentStore -> Conduit Files m (Files, Object)+filesToObjectsC overlay repo = awaitForever $ \f@Files{..} ->+ case maybe Nothing (flip Map.lookup overlay) filesCs_object of+ Nothing -> fileToObjectC repo f+ Just obj -> yield (f, obj)++addToOverlay :: MonadError String m => CSOverlay -> FSTree -> Files -> Maybe BS.ByteString -> m (CSOverlay, FSTree)+addToOverlay overlay tree file content = do+ -- If the file has content, create a hash of it and add the content to the overlay.+ -- The digest type doesn't need to match the content store, it just needs to be something we can+ -- use as a hash key.+ let (newFile, newOverlay) = case content of+ Nothing-> (file{filesCs_object = Nothing}, overlay)+ Just c -> let digest = makeDigest c+ in (file{filesCs_object = Just digest}, Map.insert digest (FileObject c) overlay)++ -- Add the metadata to the FSTree+ newTree <- addFileToTree True tree newFile++ return (newOverlay, newTree)+ where+ makeDigest :: BS.ByteString -> BS.ByteString+ makeDigest input =+ let digest = hash input :: Digest Blake2b_256+ in convert digest++runCustomizations :: (MonadError String m, MonadIO m) => CSOverlay -> ContentStore -> FSTree -> [Customization] -> m (CSOverlay, FSTree)+runCustomizations overlay _repo tree customizations = foldM runCustomization (overlay, tree) customizations+ where+ runCustomization :: MonadError String m => (CSOverlay, FSTree) -> Customization -> m (CSOverlay, FSTree)+ runCustomization (o, t) (WriteFile file content) = addToOverlay o t file content
src/BDCS/Export/FSTree.hs view
@@ -19,6 +19,7 @@ module BDCS.Export.FSTree(FSEntry, FSTree,+ addFileToTree, filesToTree, fstreeSource) where@@ -26,7 +27,7 @@ import Control.Conditional(whenM) import Control.Monad(foldM) import Control.Monad.Except(MonadError, throwError)-import Control.Monad.State(StateT, evalStateT, get, modify, withStateT)+import Control.Monad.State(StateT, evalStateT, get, withStateT) import Data.Conduit(Sink, Source, yield) import qualified Data.Conduit.List as CL import Data.List.Safe(init, last)@@ -61,10 +62,16 @@ -- Create an empty tree. This tree starts one level above "/" rootTree = Node{rootLabel=("", Nothing), subForest=[]} in- CL.foldM addFileToTree rootTree+ CL.foldM (addFileToTree False) rootTree -addFileToTree :: MonadError String m => FSTree -> Files -> m FSTree-addFileToTree root object = do+-- | Add a 'Files' object to a 'FSTree'. Will optionally replace existing paths, or throw an error.+-- This function cannot replace a directory with a regular file, or vice versa.+addFileToTree :: MonadError String m =>+ Bool -- ^ Whether to replace the file if the path already exists+ -> FSTree -- ^ The original tree+ -> Files -- ^ The file to add+ -> m FSTree+addFileToTree replace root object = do let rootZipper = (root, []) let pathComponents = splitDirectories $ T.unpack $ filesPath object @@ -76,7 +83,7 @@ -- Wrap the new file in a tree node and add it to the directory let newEntry = Node (lastComponent, Just object) []- getTree <$> evalStateT (addEntryToTree dirZipper newEntry) 0+ getTree <$> addEntryToTree dirZipper newEntry where -- Given a directory path, split into components, return a new zipper focused on this path -- If the directory or any parent directories do not exist, create placeholders for them@@ -136,7 +143,7 @@ findDirectory startZipper pathComponents - addEntryToTree :: MonadError String m => FSZipper -> FSTree -> StateT Int m FSZipper+ addEntryToTree :: MonadError String m => FSZipper -> FSTree -> m FSZipper addEntryToTree zipper newEntry = do -- At this point, we have a directory to stick the new entry into, and the first thing to do is see -- if the directory already contains an entry with the same name. If it does:@@ -152,8 +159,6 @@ -- - The existing entry is a directory: -- * are we adding a placeholder? Add the new placeholder's children to the existing directory. -- * otherwise, conflict- -- - The existing entry is a symlink:- -- * Resolve the symlink target, add the new entry as a child of the target -- -- The scenarios that involve adding new placeholders may seem a little odd, but they can arise -- when moving things around due to replacing placeholder directories with symlinks.@@ -187,44 +192,61 @@ -- The context for relative links is the directory, so one level above the new symlink (Placeholder, Symlink s) -> do let newZipper = (newEntry, crumbs)- targetZipper <- withStateT (+1) $ resolveSymlink (goUp newZipper) s+ targetZipper <- evalStateT (resolveSymlink (goUp newZipper) s) 0 addChildren targetZipper self + -- Attempting to replace a placeholder directory with a regular file, that's an error (Placeholder, _) -> throwError $ "Unable to add " ++ T.unpack (filesPath object) ++ ", directory added at path" + -- existing directory, new placeholder. Leave the directory, but take the placeholder's children (Directory _, Placeholder) -> addChildren existing newEntry - -- Allow this if the same Files object is being added twice- (Directory d1, Directory d2) -> if compareDirs d1 d2 then addChildren existing newEntry- else throwError $ "Unable to add " ++ T.unpack (filesPath object) ++- ", file already added at this location"+ -- Replacing a directory with a directory, only valid if the Files objects are the same+ -- or if "replace" is true.+ (Directory d1, Directory d2) -> if | compareDirs d1 d2 -> addChildren existing newEntry+ | replace -> addChildren (newEntry, crumbs) self+ | otherwise -> throwError $ "Unable to add " +++ T.unpack (filesPath object) +++ ", directory already added at this location" (Directory _, _) -> throwError $ "Unable to to add " ++ T.unpack (filesPath object) ++- ", file already added at this location"+ ", directory already added at this location" - -- Follow the symlink, and repeat addEntryToTree with the symlink target as the new directory- -- to add into.- (Symlink s, _) -> do- -- Check and increment the link count- whenM ((>= maxSymlinks) <$> get) $- throwError $ "Too many levels of symbolic links while resolving " ++ T.unpack (filesPath object)- modify (+1)+ -- Allow a symlink to be added twice if it's the same symlink+ (Symlink s1, Symlink s2) -> if compareLinks s1 s2 then return existing+ else throwError $ "Unable to add " ++ T.unpack (filesPath object) +++ ", symlink already added at this location" - targetZipper <- resolveSymlink zipper s- addEntryToTree targetZipper newEntry+ -- Follow the symlink, and move the placeholder's children to the destination directory+ (Symlink s, Placeholder) -> do+ targetZipper <- evalStateT (resolveSymlink zipper s) 0+ addChildren targetZipper newEntry - -- Otherwise, we have two non-directory, non-placeholder files, see if they match- _ -> if self == newEntry then return existing- else throwError $ "Unable to add " ++ T.unpack (filesPath object) ++- ", file already added at this location"+ -- Replacing a file with a directory, no good+ (Other _, Directory _) -> throwError $ "Unable to add " ++ T.unpack (filesPath object) +++ ", file already added at this location"+ (Other _, Placeholder) -> throwError $ "Unable to add " ++ T.unpack (filesPath object) +++ ", file already added at this location" - addChildren :: MonadError String m => FSZipper -> FSTree -> StateT Int m FSZipper+ -- Otherwise, we have two non-directory, non-placeholder files, see if they match,+ -- or if we should explicitly replace.+ _ -> if | self == newEntry -> return existing+ | replace -> return (newEntry, crumbs)+ | otherwise -> throwError $ "Unable to add " +++ T.unpack (filesPath object) +++ ", file already added at this location"++ addChildren :: MonadError String m => FSZipper -> FSTree -> m FSZipper addChildren dirZipper newEntry = foldM (\z e -> goUp <$> addEntryToTree z e) dirZipper (subForest newEntry) -- Compare files, ignoring size and mtime, because the data for these is basically made up compareDirs :: Files -> Files -> Bool compareDirs f1 f2 = f1{filesMtime=0, filesSize=0} == f2{filesMtime=0, filesSize=0}++ -- For symlinks, the only parts that count are the path and the target+ compareLinks :: Files -> Files -> Bool+ compareLinks f1 f2 = (filesPath f1 == filesPath f2) && (filesTarget f1 == filesTarget f2) -- Walk a tree and emit the Files entries in order, modifying the paths as we go -- to match the final, symlink-resolved results
src/BDCS/Export/Ostree.hs view
@@ -85,7 +85,7 @@ installKernelInitrd tmpDir -- Replace /etc/nsswitch.conf with the altfiles version- getDataFileName "nsswitch-altfiles.conf" >>= readFile >>= writeFile (tmpDir </> "etc" </> "nsswitch.conf")+ getDataFileName "data/nsswitch-altfiles.conf" >>= readFile >>= writeFile (tmpDir </> "etc" </> "nsswitch.conf") -- Remove the fstab stub removeFile $ tmpDir </> "etc" </> "fstab"@@ -101,7 +101,7 @@ -- Add more tmpfiles entries let tmpfilesDir = tmpDir </> "usr" </> "lib" </> "tmpfiles.d"- getDataFileName "tmpfiles-ostree.conf" >>= readFile >>= writeFile (tmpfilesDir </> "weldr-ostree.conf")+ getDataFileName "data/tmpfiles-ostree.conf" >>= readFile >>= writeFile (tmpfilesDir </> "weldr-ostree.conf") -- Replace a bunch of top-level directories with symlinks replaceDirs tmpDir
src/BDCS/Export/Utils.hs view
@@ -52,7 +52,7 @@ -- Install a sysusers.d config file, and run systemd-sysusers to implement it let sysusersDir = exportPath </> "usr" </> "lib" </> "sysusers.d" createDirectoryIfMissing True sysusersDir- getDataFileName "sysusers-default.conf" >>= readFile >>= writeFile (sysusersDir </> "weldr.conf")+ getDataFileName "data/sysusers-default.conf" >>= readFile >>= writeFile (sysusersDir </> "weldr.conf") callProcess "systemd-sysusers" ["--root", exportPath] -- Run depmod on any kernel modules that might be present@@ -76,7 +76,7 @@ -- it is not generally useful and should be avoided. runTmpfiles :: FilePath -> IO () runTmpfiles exportPath = do- configPath <- getDataFileName "tmpfiles-default.conf"+ configPath <- getDataFileName "data/tmpfiles-default.conf" setupFilesystem exportPath configPath -- | List the supported output formats.
src/tests/BDCS/Export/FSTreeSpec.hs view
@@ -121,6 +121,50 @@ ]) ) + it "Symlinks moving placeholders to symlinks" $+ let dir_a = directoryTemplate{filesPath="/a/b/c"}+ dir_b = directoryTemplate{filesPath="/x/b"}+ link_d = symlinkTemplate{filesPath="/d", filesTarget = Just "/x"}+ link_a = symlinkTemplate{filesPath="/a", filesTarget = Just "/d"}+ in addFiles [dir_a, dir_b, link_d, link_a] >>= (`shouldBe` Right (+ Node ("", Nothing) [+ Node ("/", Nothing) [+ Node ("a", Just link_a) [],+ Node ("x", Nothing) [+ Node ("b", Just dir_b) [+ Node ("c", Just dir_a) []+ ]+ ],+ Node ("d", Just link_d) []+ ]+ ])+ )++ it "Symlinks moving placeholders to replace symlinks" $+ let dir_a = directoryTemplate{filesPath="/a/b/c"}+ link_b = symlinkTemplate{filesPath="/x/b", filesTarget = Just "/e"}+ link_a = symlinkTemplate{filesPath="/a", filesTarget = Just "/x"}+ in addFiles [dir_a, link_b, link_a] >>= (`shouldBe` Right (+ Node ("", Nothing) [+ Node ("/", Nothing) [+ Node ("a", Just link_a) [],+ Node ("x", Nothing) [+ Node ("b", Just link_b) []+ ],+ Node ("e", Nothing) [+ Node ("c", Just dir_a) []+ ]+ ]+ ])+ )++ it "Symlinks moving placeholders to replace symlinks, but with another symlink in the way" $+ let dir_a = directoryTemplate{filesPath="/a/b/c"}+ link_b = symlinkTemplate{filesPath="/x/b", filesTarget = Just "/e"}+ link_e = symlinkTemplate{filesPath="/e/c", filesTarget = Just "/y"}+ link_a = symlinkTemplate{filesPath="/a", filesTarget = Just "/x"}+ in addFiles [dir_a, link_b, link_e, link_a] >>= (`shouldSatisfy` isLeft)+ it "Symlink loop" $ let link_a = symlinkTemplate{filesPath="/a", filesTarget=Just "b"} link_b = symlinkTemplate{filesPath="/b", filesTarget=Just "a"}@@ -163,10 +207,108 @@ let link = symlinkTemplate{filesPath="/a", filesTarget=Just "."} file = regularTemplate{filesPath="/a"} in addFiles [link, file] >>= (`shouldSatisfy` isLeft)++ it "Adding a file twice" $+ let file = regularTemplate{filesPath="/a"}+ in addFiles [file, file] >>= (`shouldBe` Right (+ Node ("", Nothing) [+ Node ("/", Nothing) [+ Node ("a", Just file) []+ ]+ ])+ )++ it "Adding a symlink twice" $+ let symlink = symlinkTemplate{filesPath="/a", filesTarget=Just "regular"}+ in addFiles [symlink, symlink] >>= (`shouldBe` Right (+ Node ("", Nothing) [+ Node ("/", Nothing) [+ Node ("a", Just symlink) []+ ]+ ])+ )++ it "addFileToTree, replace file with self, replace=False" $+ runExceptT (addFileToTree False existingFileTree existingFile) >>= (`shouldBe` Right existingFileTree)++ it "addFileToTre, replace file with self, replace=True" $+ runExceptT (addFileToTree True existingFileTree existingFile) >>= (`shouldBe` Right existingFileTree)++ it "addFileToTree, replace file with directory, replace=False" $+ runExceptT (addFileToTree False existingFileTree existingDir) >>= (`shouldSatisfy` isLeft)++ it "addFileToTree, replace file with directory, replace=True" $+ runExceptT (addFileToTree True existingFileTree existingDir) >>= (`shouldSatisfy` isLeft)++ it "addFileToTree, replace file with a different file, replace=False" $+ runExceptT (addFileToTree False existingFileTree newFile) >>= (`shouldSatisfy` isLeft)++ it "addFileToTree, replace file with a different file, replace=True" $+ runExceptT (addFileToTree True existingFileTree newFile) >>= (`shouldBe` Right (+ Node ("", Nothing) [+ Node ("/", Nothing) [+ Node ("existing", Just newFile) []+ ]+ ])+ )++ it "addFileToTree, replace directory with self, replace=False" $+ runExceptT (addFileToTree False existingDirTree existingDir) >>= (`shouldBe` Right existingDirTree)++ it "addFileToTree, replace directory with self, replace=True" $+ runExceptT (addFileToTree True existingDirTree existingDir) >>= (`shouldBe` Right existingDirTree)++ it "addFileToTree, replace directory with file, replace=False" $+ runExceptT (addFileToTree False existingDirTree existingFile) >>= (`shouldSatisfy` isLeft)++ it "addFileToTree, replace directory with file, replace=True" $+ runExceptT (addFileToTree True existingDirTree existingFile) >>= (`shouldSatisfy` isLeft)++ it "addFileToTree, replace directory with different directory, replace=False" $+ runExceptT (addFileToTree False existingDirTree newDir) >>= (`shouldSatisfy` isLeft)++ it "addFileToTree, replace directory with different directory, replace=True" $+ runExceptT (addFileToTree True existingDirTree newDir) >>= (`shouldBe` Right (+ Node ("", Nothing) [+ Node ("/", Nothing) [+ Node ("existing", Just newDir) [+ Node ("file", Just regularTemplate{filesPath="/existing/file"}) []+ ]+ ]+ ])+ ) where -- Add a list of files and return the tree addFiles :: Monad m => [Files] -> m (Either String FSTree) addFiles files = runExceptT $ runConduit $ CL.sourceList files .| filesToTree++ existingDir :: Files+ existingDir = directoryTemplate{filesPath="/existing"}++ newDir :: Files+ newDir = existingDir{filesMode = fromIntegral $ directoryMode .|. 0o700}++ existingDirTree :: FSTree+ existingDirTree = Node ("", Nothing) [+ Node ("/", Nothing) [+ Node ("existing", Just existingDir) [+ Node ("file", Just regularTemplate{filesPath="/existing/file"}) []+ ]+ ]+ ]++ existingFile :: Files+ existingFile = regularTemplate{filesPath="/existing", filesCs_object=Just "abcd"}++ newFile :: Files+ newFile = existingFile{filesCs_object=Just "defg"}++ existingFileTree :: FSTree+ existingFileTree = Node ("", Nothing) [+ Node ("/", Nothing) [+ Node ("existing", Just existingFile) []+ ]+ ] -- Just fill in the paths regularTemplate :: Files
tests/test_export.sh view
@@ -134,7 +134,7 @@ # 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` rlAssertNotEquals "On error exit code should not be zero" $? 0- rlAssertEquals "On error output is as expected" "$OUTPUT" '"Unable to resolve path /usr/lib64/libcmpiCppImpl.so, non-directory object exists at /usr/lib64/libcmpiCppImpl.so.0.0.0"'+ rlAssertEquals "On error output is as expected" "$OUTPUT" '"Unable to add /usr/lib64/libcmpiCppImpl.so, symlink already added at this location"' sudo rm -rf $EXPORT_DIR rlPhaseEnd