proxy: for all your direct mode repository munging needs

This allows bypassing the direct mode guard in a safe way to do all sorts
of things including git revert, git mv, git checkout ...

This commit was sponsored by the WikiMedia Foundation.

1 files changed, 48 insertions, 0 deletions

diff --git a/Command/Proxy.hs b/Command/Proxy.hs
new file mode 100644
index 000000000..135a76504
--- /dev/null
+++ b/Command/Proxy.hs
@@ -0,0 +1,48 @@
+{- git-annex command
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Proxy where
+
+import Common.Annex
+import Command
+import Config
+import Utility.Tmp
+import Utility.Env
+import Annex.Direct
+import qualified Git.Branch
+import qualified Git.Sha
+
+cmd :: [Command]
+cmd = [notBareRepo $
+	command "proxy" ("-- git command") seek
+		SectionCommon "safely bypass direct mode guard"]
+
+seek :: CommandSeek
+seek ("--":ps) = withWords start ps
+seek ps = withWords start ps
+
+start :: [String] -> CommandStart
+start [] = error "Did not specify command to run."
+start (c:ps) = liftIO . exitWith =<< ifM isDirect
+	( do
+		g <- gitRepo
+		withTmpDirIn (gitAnnexTmpMiscDir g) "proxy" go
+	, liftIO $ safeSystem c (map Param ps)
+	)
+  where
+	go tmp = do
+		oldref <- fromMaybe Git.Sha.emptyTree
+			<$> inRepo Git.Branch.currentSha
+		liftIO $ print oldref
+		exitcode <- liftIO $ proxy tmp
+		mergeDirectCleanup tmp oldref
+		return exitcode
+	proxy tmp = do
+		usetmp <- Just . addEntry "GIT_WORK_TREE" tmp  <$> getEnvironment
+		unlessM (boolSystemEnv "git" [Param "checkout", Param "--", Param "."] usetmp) $
+			error "Failed to set up proxy work tree."
+		safeSystemEnv c (map Param ps) usetmp