initial export command

Very basic operation works, but of course this is only the beginning.

This commit was sponsored by Nick Daly on Patreon.

5 files changed, 121 insertions, 1 deletions

diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs
index be5f56ba0..1a5a13839 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 c4522788f..6dd2d053d 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 000000000..7de143ffb
--- /dev/null
+++ b/Command/Export.hs
@@ -0,0 +1,103 @@
+{- git-annex command
+ -
+ - Copyright 2017 Joey Hess <id@joeyh.name>
+ -
+ - 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 342b5bc57..7f0f46512 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 e729b0cf1..f589e953d 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.