From 21e51564dd50f1c956d89a49d1622a70d6216205 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 5 Nov 2012 11:29:12 -0400
Subject: git-annex-shell: GIT_ANNEX_SHELL_DIRECTORY can be set to limit it to
 operating on a specified directory.

---
 GitAnnexShell.hs         | 29 ++++++++++++++++++++++++-----
 debian/changelog         |  2 ++
 doc/git-annex-shell.mdwn |  5 +++++
 3 files changed, 31 insertions(+), 5 deletions(-)

diff --git a/GitAnnexShell.hs b/GitAnnexShell.hs
index dc15a6ce8..ba312c7d1 100644
--- a/GitAnnexShell.hs
+++ b/GitAnnexShell.hs
@@ -1,13 +1,13 @@
 {- git-annex-shell main program
  -
- - Copyright 2010 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
 module GitAnnexShell where
 
-import System.Environment
+import System.Posix.Env
 import System.Console.GetOpt
 
 import Common.Annex
@@ -86,6 +86,7 @@ builtins = map cmdname cmds
 builtin :: String -> String -> [String] -> IO ()
 builtin cmd dir params = do
 	checkNotReadOnly cmd
+	checkDirectory $ Just dir
 	let (params', fieldparams) = partitionParams params
 	let fields = filter checkField $ parseFields fieldparams
 	dispatch False (cmd : params') cmds options fields header $
@@ -93,6 +94,9 @@ builtin cmd dir params = do
 
 external :: [String] -> IO ()
 external params = do
+	{- Normal git-shell commands all have the directory as their last
+	 - parameter. -}
+	checkDirectory $ lastMaybe params
 	checkNotLimited
 	unlessM (boolSystem "git-shell" $ map Param $ "-c":fst (partitionParams params)) $
 		error "git-shell failed"
@@ -131,7 +135,22 @@ checkNotReadOnly cmd
 	| cmd `elem` map cmdname cmds_readonly = noop
 	| otherwise = checkEnv "GIT_ANNEX_SHELL_READONLY"
 
+checkDirectory :: Maybe FilePath -> IO ()
+checkDirectory mdir = do
+	v <- getEnv "GIT_ANNEX_SHELL_DIRECTORY"
+	case (v, mdir) of
+		(Nothing, _) -> noop
+		(Just d, Nothing) -> req d
+		(Just d, Just dir)
+			|  d `equalFilePath` dir -> noop
+			| otherwise -> req d
+	where
+		req d = error $ "Only allowed to access " ++ d
+
 checkEnv :: String -> IO ()
-checkEnv var =
-	whenM (not . null <$> catchDefaultIO "" (getEnv var)) $
-		error $ "Action blocked by " ++ var
+checkEnv var = do
+	v <- getEnv var
+	case v of
+		Nothing -> noop
+		Just "" -> noop
+		Just _ -> error $ "Action blocked by " ++ var
diff --git a/debian/changelog b/debian/changelog
index d62601037..b0fdd3a39 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -40,6 +40,8 @@ git-annex (3.20121018) UNRELEASED; urgency=low
   * webapp: Generate better git remote names.
   * webapp: Ensure that rsync special remotes are enabled using the same
     name they were originally created using.
+  * git-annex-shell: GIT_ANNEX_SHELL_DIRECTORY can be set to limit it
+    to operating on a specified directory.
 
  -- Joey Hess <joeyh@debian.org>  Wed, 17 Oct 2012 14:24:10 -0400
 
diff --git a/doc/git-annex-shell.mdwn b/doc/git-annex-shell.mdwn
index e6ebe4287..5fbc6de53 100644
--- a/doc/git-annex-shell.mdwn
+++ b/doc/git-annex-shell.mdwn
@@ -95,6 +95,11 @@ changed.
 
   If set, disallows running git-shell to handle unknown commands.
 
+* GIT_ANNEX_SHELL_DIRECTORY
+
+  If set, git-annex-shell will refuse to run commands that do not operate
+  on the specified directory.
+
 # SEE ALSO
 
 [[git-annex]](1)
-- 
cgit v1.2.3