diff options
Diffstat (limited to 'git-annex-shell.hs')
| -rw-r--r-- | git-annex-shell.hs | 72 |
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 |