git-annex-shell mostly done now, only needs 2 more subcommands

CmdLine.hs

@@ -8,9 +8,7 @@
 module CmdLine (
 	dispatch,
 	parseCmd,
-	Option,
+	usage,
-	storeOptBool,
-	storeOptString,
 ) where
 
 import System.Console.GetOpt
@@ -27,9 +25,8 @@ import Upgrade
 import Options
 
 {- Runs the passed command line. -}
-dispatch :: [String] -> [Command] -> [Option] -> String -> IO ()
+dispatch :: Git.Repo -> [String] -> [Command] -> [Option] -> String -> IO ()
-dispatch args cmds options header = do
+dispatch gitrepo args cmds options header = do
-	gitrepo <- Git.repoFromCwd
 	state <- Annex.new gitrepo allBackends
 	(actions, state') <- Annex.run state $ parseCmd args header cmds options
 	tryRun state' $ [startup, upgrade] ++ actions

Command/ConfigList.hs

@@ -0,0 +1,27 @@
+{- git-annex command
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.ConfigList where
+
+import Control.Monad.State (liftIO)
+
+import Annex
+import Command
+import qualified GitRepo as Git
+
+command :: [Command]
+command = [Command "configlist" paramNothing seek
+		"outputs relevant git configuration"]
+
+seek :: [CommandSeek]
+seek = [withNothing start]
+
+start :: CommandStartNothing
+start = do
+	g <- Annex.gitRepo
+	liftIO $ Git.run g ["config", "--list"]
+	return Nothing

Command/InAnnex.hs

@@ -0,0 +1,32 @@
+{- git-annex command
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.InAnnex where
+
+import Control.Monad.State (liftIO)
+import System.Exit
+
+import Command
+import Types
+import Core
+import qualified Backend
+
+command :: [Command]
+command = [Command "inannex" (paramRepeating paramKey) seek
+		"checks if keys are present in the annex"]
+
+seek :: [CommandSeek]
+seek = [withKeys start]
+
+start :: CommandStartString
+start keyname = do
+	backends <- Backend.list
+	let key = genKey (head backends) keyname
+	present <- inAnnex key
+	if present
+		then return Nothing
+		else liftIO $ exitFailure

doc/git-annex-shell.mdwn

@@ -4,43 +4,37 @@ git-annex-shell - Restricted login shell for git-annex only SSH access
 
 # SYNOPSIS
 
-git-annex-shell -c command [params ...]
+git-annex-shell [-c] command [params ...]
 
 # DESCRIPTION
 
-git-annex-shell is a restricted shell, similar to git-shell, which 
+git-annex-shell is a restricted shell, similar to git-shell, which
-can be used as a login shell for SSH accounts you want to restrict.
+can be used as a login shell for SSH accounts.
 
 # COMMANDS
 
-* git-annex fromkey file
+* configlist directory
 
-  This can be used to maually set up a file to link to a specified key
+  This outputs the git configuration, in the same form as
-  in the key-value backend. How you determine an existing key in the backend
+  `git config --list`
-  varies. For the URL backend, the key is just a URL to the content.
 
-  Example:
+* inannex directory [key ...]
 
-	git annex fromkey --backend=URL --key=http://www.archive.org/somefile somefile
+  This checks if all specified keys are present in the annex, 
+  and exits zero if so.
 
-* git-annex dropkey [key ...]
+* dropkey directory [key ...]
 
-  This drops the annexed data for the specified
+  This drops the annexed data for the specified keys.
-  keys from this repository.
 
-  This can be used to drop content for arbitrary keys, which do not need
+* recvkey directory key
-  to have a file in the git repository pointing at them.
 
-  A backend will typically need to be specified with --backend. If none
+  This runs rsync in server mode to receive the content of a key,
-  is specified, the first configured backend is used.
+  and stores the content in the annex.
 
-* git-annex setkey file
+* sendkey directory key
 
-  This sets the annxed data for a key to the content of
+  This runs rsync in server mode to transfer out the content of a key.
-  the specified file, and then removes the file.
-
-  A backend will typically need to be specified with --backend. If none
-  is specified, the first configured backend is used.
 
 Any other command is passed through to git-shell.
 

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
+cmds = map adddirparam $ concat
-	[ Command.FromKey.command
+	[ Command.ConfigList.command
+	, Command.InAnnex.command
 	, Command.DropKey.command
-	, Command.SetKey.command
+--	, Command.RecvKey.command
+--	, Command.SendKey.command
 	]
-
+	where
-options :: [Option]
+		adddirparam c = c { cmdparams = "DIRECTORY " ++ cmdparams c }
-options = [ Option ['c'] ["command"] (NoArg (storeOptBool "command" True))
-		"ignored for compatability with git-shell"
-	  ] ++ commonOptions
 
 header :: String
-header = "Usage:\n" ++
+header = "Usage: git-annex-shell [-c] command [option ..]"
-	"\tgit-annex-shell -c git-annex command [option ..]\n" ++
-	"\tgit-annex-shell -c shellcommand argument"
 
 main :: IO ()
 main = do
 	args <- getArgs
-	-- dispatch git-annex commands to builtin versions,
+	main' args
-	-- and pass everything else to git-shell
+
-	case args of
+main' :: [String] -> IO ()
-		("git-annex":as) -> builtin as
+main' [] = failure
-		[] -> builtin []
+-- skip leading -c options, passed by eg, ssh
-		_ -> external args
+main' ("-c":p) = main' p
-	where
+-- Since git-annex explicitly runs git-annex-shell, we will be passed 
-		builtin l = dispatch l cmds options header
+-- a redundant "git-annex-shell" parameter when we're the user's login shell.
-		external l = do
+main' ("git-annex-shell":p) = main' p
-			ret <- boolSystem "git-shell" l
+-- a command can be either a builtin or something to pass to git-shell
-			when (not ret) $
+main' c@(cmd:dir:params)
-				error "git-shell failed"
+	| 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

git-annex.hs

@@ -7,6 +7,7 @@
 
 import System.Environment
 
+import qualified GitRepo as Git
 import CmdLine
 import Command
 import Options
@@ -58,7 +59,11 @@ cmds = concat
 	, Command.Find.command
 	]
 
+header :: String
+header = "Usage: git-annex command [option ..]"
+
 main :: IO ()
 main = do
 	args <- getArgs
-	dispatch args cmds commonOptions "Usage: git-annex command [option ..]"
+	gitrepo <- Git.repoFromCwd
+	dispatch gitrepo args cmds commonOptions header