summaryrefslogtreecommitdiff
path: root/git-annex-shell.hs
diff options
context:
space:
mode:
Diffstat (limited to 'git-annex-shell.hs')
-rw-r--r--git-annex-shell.hs72
1 files changed, 46 insertions, 26 deletions
diff --git a/git-annex-shell.hs b/git-annex-shell.hs
index 7adb5e790..492d18446 100644
--- a/git-annex-shell.hs
+++ b/git-annex-shell.hs
@@ -5,48 +5,68 @@
- Licensed under the GNU GPL version 3 or higher.
-}
-import System.Console.GetOpt
import System.Environment
import Control.Monad (when)
+import qualified GitRepo as Git
import CmdLine
import Command
import Utility
import Options
-import qualified Command.FromKey
+import qualified Command.ConfigList
+import qualified Command.InAnnex
import qualified Command.DropKey
-import qualified Command.SetKey
+--import qualified Command.RecvKey
+--import qualified Command.SendKey
cmds :: [Command]
-cmds = concat
- [ Command.FromKey.command
+cmds = map adddirparam $ concat
+ [ Command.ConfigList.command
+ , Command.InAnnex.command
, Command.DropKey.command
- , Command.SetKey.command
+-- , Command.RecvKey.command
+-- , Command.SendKey.command
]
-
-options :: [Option]
-options = [ Option ['c'] ["command"] (NoArg (storeOptBool "command" True))
- "ignored for compatability with git-shell"
- ] ++ commonOptions
+ where
+ adddirparam c = c { cmdparams = "DIRECTORY " ++ cmdparams c }
header :: String
-header = "Usage:\n" ++
- "\tgit-annex-shell -c git-annex command [option ..]\n" ++
- "\tgit-annex-shell -c shellcommand argument"
+header = "Usage: git-annex-shell [-c] command [option ..]"
main :: IO ()
main = do
args <- getArgs
- -- dispatch git-annex commands to builtin versions,
- -- and pass everything else to git-shell
- case args of
- ("git-annex":as) -> builtin as
- [] -> builtin []
- _ -> external args
- where
- builtin l = dispatch l cmds options header
- external l = do
- ret <- boolSystem "git-shell" l
- when (not ret) $
- error "git-shell failed"
+ main' args
+
+main' :: [String] -> IO ()
+main' [] = failure
+-- skip leading -c options, passed by eg, ssh
+main' ("-c":p) = main' p
+-- Since git-annex explicitly runs git-annex-shell, we will be passed
+-- a redundant "git-annex-shell" parameter when we're the user's login shell.
+main' ("git-annex-shell":p) = main' p
+-- a command can be either a builtin or something to pass to git-shell
+main' c@(cmd:dir:params)
+ | elem cmd builtins = builtin cmd dir params
+ | otherwise = external c
+main' c@(cmd:_)
+ | elem cmd builtins = failure
+ | otherwise = external c
+
+builtins :: [String]
+builtins = map cmdname cmds
+
+builtin :: String -> String -> [String] -> IO ()
+builtin cmd dir params = do
+ let gitrepo = Git.repoFromPath dir
+ dispatch gitrepo (cmd:params) cmds commonOptions header
+
+external :: [String] -> IO ()
+external l = do
+ ret <- boolSystem "git-shell" ("-c":l)
+ when (not ret) $
+ error "git-shell failed"
+
+failure :: IO ()
+failure = error $ "bad parameters\n\n" ++ usage header cmds commonOptions