From 9f3630f4e0a066aaf410fb1fe5eec1ca6ba2f80c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 29 Aug 2017 14:58:38 -0400 Subject: [PATCH] initial export command Very basic operation works, but of course this is only the beginning. This commit was sponsored by Nick Daly on Patreon. --- CmdLine/GitAnnex.hs | 2 + CmdLine/Usage.hs | 2 + Command/Export.hs | 103 +++++++++++++++++++++++++++++++++++++++++++ Remote/Directory.hs | 2 +- doc/todo/export.mdwn | 13 ++++++ 5 files changed, 121 insertions(+), 1 deletion(-) create mode 100644 Command/Export.hs diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs index be5f56ba0a..1a5a13839b 100644 --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -95,6 +95,7 @@ import qualified Command.AddUrl import qualified Command.ImportFeed import qualified Command.RmUrl import qualified Command.Import +import qualified Command.Export import qualified Command.Map import qualified Command.Direct import qualified Command.Indirect @@ -141,6 +142,7 @@ cmds testoptparser testrunner = , Command.ImportFeed.cmd , Command.RmUrl.cmd , Command.Import.cmd + , Command.Export.cmd , Command.Init.cmd , Command.Describe.cmd , Command.InitRemote.cmd diff --git a/CmdLine/Usage.hs b/CmdLine/Usage.hs index c4522788fd..6dd2d053d9 100644 --- a/CmdLine/Usage.hs +++ b/CmdLine/Usage.hs @@ -94,6 +94,8 @@ paramAddress :: String paramAddress = "ADDRESS" paramItem :: String paramItem = "ITEM" +paramTreeish :: String +paramTreeish = "TREEISH" paramKeyValue :: String paramKeyValue = "K=V" paramNothing :: String diff --git a/Command/Export.hs b/Command/Export.hs new file mode 100644 index 0000000000..7de143ffb8 --- /dev/null +++ b/Command/Export.hs @@ -0,0 +1,103 @@ +{- git-annex command + - + - Copyright 2017 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Export where + +import Command +import qualified Git +import qualified Git.DiffTree +import Git.Sha +import Git.FilePath +import Types.Key +import Types.Remote +import Annex.Content +import Annex.CatFile +import Messages.Progress +import Utility.Tmp + +import qualified Data.ByteString.Lazy as L + +cmd :: Command +cmd = command "export" SectionCommon + "export content to a remote" + paramTreeish (seek <$$> optParser) + +data ExportOptions = ExportOptions + { exportTreeish :: Git.Ref + , exportRemote :: DeferredParse Remote + } + +optParser :: CmdParamsDesc -> Parser ExportOptions +optParser _ = ExportOptions + <$> (Git.Ref <$> parsetreeish) + <*> (parseRemoteOption <$> parseToOption) + where + parsetreeish = argument str + ( metavar paramTreeish + ) + +seek :: ExportOptions -> CommandSeek +seek o = do + r <- getParsed (exportRemote o) + let oldtreeish = emptyTree -- XXX temporary + (diff, cleanup) <- inRepo $ + Git.DiffTree.diffTreeRecursive oldtreeish (exportTreeish o) + seekActions $ pure $ map (start r) diff + void $ liftIO cleanup + +start :: Remote -> Git.DiffTree.DiffTreeItem -> CommandStart +start r diff + | Git.DiffTree.dstsha diff == nullSha = do + showStart "unexport" f + oldk <- either id id <$> exportKey (Git.DiffTree.srcsha diff) + next $ performUnexport r oldk loc + | otherwise = do + showStart "export" f + next $ performExport r diff loc + where + loc = ExportLocation $ toInternalGitPath $ + getTopFilePath $ Git.DiffTree.file diff + f = getTopFilePath $ Git.DiffTree.file diff + +performExport :: Remote -> Git.DiffTree.DiffTreeItem -> ExportLocation -> CommandPerform +performExport r diff loc = case storeExport r of + Nothing -> error "remote does not support exporting files" + Just storer -> next $ do + v <- exportKey (Git.DiffTree.dstsha diff) + case v of + Right k -> metered Nothing k $ \m -> + sendAnnex k + (void $ performUnexport r k loc) + (\f -> storer f k loc m) + -- Sending a non-annexed file. + Left sha1k -> metered Nothing sha1k $ \m -> + withTmpFile "export" $ \tmp h -> do + b <- catObject (Git.DiffTree.dstsha diff) + liftIO $ L.hPut h b + liftIO $ hClose h + storer tmp sha1k loc m + +performUnexport :: Remote -> Key -> ExportLocation -> CommandPerform +performUnexport r k loc = case removeExport r of + Nothing -> error "remote does not support removing exported files" + Just remover -> next $ remover k loc + +-- When the Sha points to an annexed file, get the key as Right. +-- When the Sha points to a non-annexed file, convert to a SHA1 key, +-- as Left. +exportKey :: Git.Sha -> Annex (Either Key Key) +exportKey sha = mk <$> catKey sha + where + mk (Just k) = Right k + mk Nothing = Left $ Key + { keyName = show sha + , keyVariety = SHA1Key (HasExt False) + , keySize = Nothing + , keyMtime = Nothing + , keyChunkSize = Nothing + , keyChunkNum = Nothing + } diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 342b5bc578..7f0f465128 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -235,7 +235,7 @@ exportPath d (ExportLocation loc) = d loc storeExportDirectory :: FilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool storeExportDirectory d src _k loc p = liftIO $ catchBoolIO $ do - createDirectoryIfMissing True dest + createDirectoryIfMissing True (takeDirectory dest) withMeteredFile src p (L.writeFile dest) return True where diff --git a/doc/todo/export.mdwn b/doc/todo/export.mdwn index e729b0cf17..f589e953d9 100644 --- a/doc/todo/export.mdwn +++ b/doc/todo/export.mdwn @@ -14,3 +14,16 @@ Would this be able to reuse the existing `storeKey` interface, or would there need to be a new interface in supported remotes? --[[Joey]] + +Work is in progress. Todo list: + +* Remember the previously exported tree (in git-annex branch, see design) + and use to make next export more efficient. +* Only export to remotes that were initialized to support it. +* Prevent using export remotes for key/value storage. +* When exporting, update location tracking to allow getting from exports, +* Use retrieveExport when getting from export remotes. +* Efficient handling of renames. +* Detect export conflicts (see design) +* Support export to aditional special remotes (S3 etc) +* Support export to external special remotes.