blob: d03b0910ea59fe2393ea5826b55343ae3feeb826 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
{- git-annex-shell main program
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
import System.Environment
import Annex.Common
import qualified Git
import CmdLine
import Command
import Options
import qualified Command.ConfigList
import qualified Command.InAnnex
import qualified Command.DropKey
import qualified Command.RecvKey
import qualified Command.SendKey
cmds :: [Command]
cmds = map adddirparam $ concat
[ Command.ConfigList.command
, Command.InAnnex.command
, Command.DropKey.command
, Command.RecvKey.command
, Command.SendKey.command
]
where
adddirparam c = c { cmdparams = "DIRECTORY " ++ cmdparams c }
header :: String
header = "Usage: git-annex-shell [-c] command [parameters ...] [option ..]"
main :: IO ()
main = main' =<< getArgs
main' :: [String] -> IO ()
main' [] = failure
-- skip leading -c options, passed by eg, ssh
main' ("-c":p) = main' p
-- a command can be either a builtin or something to pass to git-shell
main' c@(cmd:dir:params)
| cmd `elem` builtins = builtin cmd dir params
| otherwise = external c
main' c@(cmd:_)
-- Handle the case of being the user's login shell. It will be passed
-- a single string containing all the real parameters.
| "git-annex-shell " `isPrefixOf` cmd = main' $ drop 1 $ shellUnEscape cmd
| cmd `elem` builtins = failure
| otherwise = external c
builtins :: [String]
builtins = map cmdname cmds
builtin :: String -> String -> [String] -> IO ()
builtin cmd dir params =
Git.repoAbsPath dir >>= Git.repoFromAbsPath >>=
dispatch (cmd : filterparams params) cmds commonOptions header
external :: [String] -> IO ()
external params =
unlessM (boolSystem "git-shell" $ map Param $ "-c":filterparams params) $
error "git-shell failed"
-- Drop all args after "--".
-- These tend to be passed by rsync and not useful.
filterparams :: [String] -> [String]
filterparams [] = []
filterparams ("--":_) = []
filterparams (a:as) = a:filterparams as
failure :: IO ()
failure = error $ "bad parameters\n\n" ++ usage header cmds commonOptions
|
