summaryrefslogtreecommitdiff
path: root/git-annex-shell.hs
blob: 8783e7f60af502ab77c9bc123081fe31101a2b66 (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
{- 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 Control.Monad (when)

import qualified GitRepo as Git
import CmdLine
import Command
import Utility
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 [option ..]"

main :: IO ()
main = do
	args <- getArgs
	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