summaryrefslogtreecommitdiff
path: root/git-annex-shell.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-10-15 19:06:35 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-10-15 19:06:35 -0400
commit52c8244219dd90102818282b8b09186f2ce93a0f (patch)
treefe20f5fa19965bbfdbc9c7d2015038ca3e3f34f7 /git-annex-shell.hs
parent1480d71adb1d6acf2cc8863064902244a31f099b (diff)
git-annex-shell: GIT_ANNEX_SHELL_READONLY and GIT_ANNEX_SHELL_LIMITED environment variables can be set to limit what commands can be run.
This could be used by eg, gitolite.
Diffstat (limited to 'git-annex-shell.hs')
-rw-r--r--git-annex-shell.hs42
1 files changed, 34 insertions, 8 deletions
diff --git a/git-annex-shell.hs b/git-annex-shell.hs
index 72e130ff0..41cb72d7e 100644
--- a/git-annex-shell.hs
+++ b/git-annex-shell.hs
@@ -21,21 +21,29 @@ import qualified Command.DropKey
import qualified Command.RecvKey
import qualified Command.SendKey
-cmds :: [Command]
-cmds = map adddirparam $ concat
+cmds_readonly :: [Command]
+cmds_readonly = concat
[ Command.ConfigList.command
, Command.InAnnex.command
- , Command.DropKey.command
- , Command.RecvKey.command
, Command.SendKey.command
]
+
+cmds_notreadonly :: [Command]
+cmds_notreadonly = concat
+ [ Command.RecvKey.command
+ , Command.DropKey.command
+ ]
+
+cmds :: [Command]
+cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
where
adddirparam c = c { cmdparams = "DIRECTORY " ++ cmdparams c }
options :: [OptDescr (Annex ())]
-options = uuid : commonOptions
+options = commonOptions ++
+ [ Option [] ["uuid"] (ReqArg check paramUUID) "repository uuid"
+ ]
where
- uuid = Option [] ["uuid"] (ReqArg check paramUUID) "repository uuid"
check expected = do
u <- getUUID
when (u /= expected) $ error $
@@ -67,12 +75,14 @@ builtins :: [String]
builtins = map cmdname cmds
builtin :: String -> String -> [String] -> IO ()
-builtin cmd dir params =
+builtin cmd dir params = do
+ checkNotReadOnly cmd
Git.repoAbsPath dir >>= Git.repoFromAbsPath >>=
dispatch (cmd : filterparams params) cmds options header
external :: [String] -> IO ()
-external params =
+external params = do
+ checkNotLimited
unlessM (boolSystem "git-shell" $ map Param $ "-c":filterparams params) $
error "git-shell failed"
@@ -85,3 +95,19 @@ filterparams (a:as) = a:filterparams as
failure :: IO ()
failure = error $ "bad parameters\n\n" ++ usage header cmds options
+
+checkNotLimited :: IO ()
+checkNotLimited = checkEnv "GIT_ANNEX_SHELL_LIMITED"
+
+checkNotReadOnly :: String -> IO ()
+checkNotReadOnly cmd
+ | cmd `elem` map cmdname cmds_readonly = return ()
+ | otherwise = checkEnv "GIT_ANNEX_SHELL_READONLY"
+
+checkEnv :: String -> IO ()
+checkEnv var = catch check (const $ return ())
+ where
+ check = do
+ val <- getEnv var
+ when (not $ null val) $
+ error $ "Action blocked by " ++ var