reorganize some files and imports

6 files changed, 850 insertions, 0 deletions

diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs
new file mode 100644
index 000000000..b25082963
--- /dev/null
+++ b/CmdLine/GitAnnex.hs
@@ -0,0 +1,182 @@
+{- git-annex main program
+ -
+ - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP, OverloadedStrings #-}
+
+module CmdLine.GitAnnex where
+
+import qualified Git.CurrentRepo
+import CmdLine
+import Command
+
+import qualified Command.Add
+import qualified Command.Unannex
+import qualified Command.Drop
+import qualified Command.Move
+import qualified Command.Copy
+import qualified Command.Get
+import qualified Command.LookupKey
+import qualified Command.ExamineKey
+import qualified Command.FromKey
+import qualified Command.DropKey
+import qualified Command.TransferKey
+import qualified Command.TransferKeys
+import qualified Command.ReKey
+import qualified Command.Reinject
+import qualified Command.Fix
+import qualified Command.Init
+import qualified Command.Describe
+import qualified Command.InitRemote
+import qualified Command.EnableRemote
+import qualified Command.Fsck
+import qualified Command.Repair
+import qualified Command.Unused
+import qualified Command.DropUnused
+import qualified Command.AddUnused
+import qualified Command.Unlock
+import qualified Command.Lock
+import qualified Command.PreCommit
+import qualified Command.Find
+import qualified Command.Whereis
+import qualified Command.List
+import qualified Command.Log
+import qualified Command.Merge
+import qualified Command.Info
+import qualified Command.Status
+import qualified Command.Migrate
+import qualified Command.Uninit
+import qualified Command.NumCopies
+import qualified Command.Trust
+import qualified Command.Untrust
+import qualified Command.Semitrust
+import qualified Command.Dead
+import qualified Command.Group
+import qualified Command.Wanted
+import qualified Command.Schedule
+import qualified Command.Ungroup
+import qualified Command.Vicfg
+import qualified Command.Sync
+import qualified Command.Mirror
+import qualified Command.AddUrl
+#ifdef WITH_FEED
+import qualified Command.ImportFeed
+#endif
+import qualified Command.RmUrl
+import qualified Command.Import
+import qualified Command.Map
+import qualified Command.Direct
+import qualified Command.Indirect
+import qualified Command.Upgrade
+import qualified Command.Forget
+import qualified Command.Version
+import qualified Command.Help
+#ifdef WITH_ASSISTANT
+import qualified Command.Watch
+import qualified Command.Assistant
+#ifdef WITH_WEBAPP
+import qualified Command.WebApp
+#endif
+#ifdef WITH_XMPP
+import qualified Command.XMPPGit
+#endif
+#endif
+import qualified Command.Test
+#ifdef WITH_TESTSUITE
+import qualified Command.FuzzTest
+#endif
+#ifdef WITH_EKG
+import System.Remote.Monitoring
+#endif
+
+cmds :: [Command]
+cmds = concat
+	[ Command.Add.def
+	, Command.Get.def
+	, Command.Drop.def
+	, Command.Move.def
+	, Command.Copy.def
+	, Command.Unlock.def
+	, Command.Lock.def
+	, Command.Sync.def
+	, Command.Mirror.def
+	, Command.AddUrl.def
+#ifdef WITH_FEED
+	, Command.ImportFeed.def
+#endif
+	, Command.RmUrl.def
+	, Command.Import.def
+	, Command.Init.def
+	, Command.Describe.def
+	, Command.InitRemote.def
+	, Command.EnableRemote.def
+	, Command.Reinject.def
+	, Command.Unannex.def
+	, Command.Uninit.def
+	, Command.PreCommit.def
+	, Command.NumCopies.def
+	, Command.Trust.def
+	, Command.Untrust.def
+	, Command.Semitrust.def
+	, Command.Dead.def
+	, Command.Group.def
+	, Command.Wanted.def
+	, Command.Schedule.def
+	, Command.Ungroup.def
+	, Command.Vicfg.def
+	, Command.LookupKey.def
+	, Command.ExamineKey.def
+	, Command.FromKey.def
+	, Command.DropKey.def
+	, Command.TransferKey.def
+	, Command.TransferKeys.def
+	, Command.ReKey.def
+	, Command.Fix.def
+	, Command.Fsck.def
+	, Command.Repair.def
+	, Command.Unused.def
+	, Command.DropUnused.def
+	, Command.AddUnused.def
+	, Command.Find.def
+	, Command.Whereis.def
+	, Command.List.def
+	, Command.Log.def
+	, Command.Merge.def
+	, Command.Info.def
+	, Command.Status.def
+	, Command.Migrate.def
+	, Command.Map.def
+	, Command.Direct.def
+	, Command.Indirect.def
+	, Command.Upgrade.def
+	, Command.Forget.def
+	, Command.Version.def
+	, Command.Help.def
+#ifdef WITH_ASSISTANT
+	, Command.Watch.def
+	, Command.Assistant.def
+#ifdef WITH_WEBAPP
+	, Command.WebApp.def
+#endif
+#ifdef WITH_XMPP
+	, Command.XMPPGit.def
+#endif
+#endif
+	, Command.Test.def
+#ifdef WITH_TESTSUITE
+	, Command.FuzzTest.def
+#endif
+	]
+
+header :: String
+header = "git-annex command [option ...]"
+
+run :: [String] -> IO ()
+run args = do
+#ifdef WITH_EKG
+	_ <- forkServer "localhost" 4242
+#endif
+	dispatch True args cmds gitAnnexOptions [] header Git.CurrentRepo.get
diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs
new file mode 100644
index 000000000..fcf5deaf0
--- /dev/null
+++ b/CmdLine/GitAnnex/Options.hs
@@ -0,0 +1,99 @@
+{- git-annex options
+ -
+ - Copyright 2010, 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module CmdLine.GitAnnex.Options where
+
+import System.Console.GetOpt
+
+import Common.Annex
+import qualified Git.Config
+import Git.Types
+import Types.TrustLevel
+import Types.NumCopies
+import Types.Messages
+import qualified Annex
+import qualified Remote
+import qualified Limit
+import qualified Limit.Wanted
+import CmdLine.Option
+import CmdLine.Usage
+
+gitAnnexOptions :: [Option]
+gitAnnexOptions = commonOptions ++
+	[ Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)
+		"override default number of copies"
+	, Option [] ["trust"] (trustArg Trusted)
+		"override trust setting"
+	, Option [] ["semitrust"] (trustArg SemiTrusted)
+		"override trust setting back to default"
+	, Option [] ["untrust"] (trustArg UnTrusted)
+		"override trust setting to untrusted"
+	, Option ['c'] ["config"] (ReqArg setgitconfig "NAME=VALUE")
+		"override git configuration setting"
+	, Option ['x'] ["exclude"] (ReqArg Limit.addExclude paramGlob)
+		"skip files matching the glob pattern"
+	, Option ['I'] ["include"] (ReqArg Limit.addInclude paramGlob)
+		"limit to files matching the glob pattern"
+	, Option ['i'] ["in"] (ReqArg Limit.addIn paramRemote)
+		"match files present in a remote"
+	, Option ['C'] ["copies"] (ReqArg Limit.addCopies paramNumber)
+		"skip files with fewer copies"
+	, Option [] ["lackingcopies"] (ReqArg (Limit.addLackingCopies False) paramNumber)
+		"match files that need more copies"
+	, Option [] ["approxlackingcopies"] (ReqArg (Limit.addLackingCopies True) paramNumber)
+		"match files that need more copies (faster)"
+	, Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName)
+		"match files using a key-value backend"
+	, Option [] ["inallgroup"] (ReqArg Limit.addInAllGroup paramGroup)
+		"match files present in all remotes in a group"
+	, Option [] ["largerthan"] (ReqArg Limit.addLargerThan paramSize)
+		"match files larger than a size"
+	, Option [] ["smallerthan"] (ReqArg Limit.addSmallerThan paramSize)
+		"match files smaller than a size"
+	, Option [] ["want-get"] (NoArg Limit.Wanted.addWantGet)
+		"match files the repository wants to get"
+	, Option [] ["want-drop"] (NoArg Limit.Wanted.addWantDrop)
+		"match files the repository wants to drop"
+	, Option ['T'] ["time-limit"] (ReqArg Limit.addTimeLimit paramTime)
+		"stop after the specified amount of time"
+	, Option [] ["user-agent"] (ReqArg setuseragent paramName)
+		"override default User-Agent"
+	, Option [] ["trust-glacier"] (NoArg (Annex.setFlag "trustglacier"))
+		"Trust Amazon Glacier inventory"
+	] ++ matcherOptions
+  where
+	trustArg t = ReqArg (Remote.forceTrust t) paramRemote
+	setnumcopies v = maybe noop
+		(\n -> Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ NumCopies n })
+		(readish v)
+	setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v }
+	setgitconfig v = inRepo (Git.Config.store v)
+		>>= pure . (\r -> r { gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param v] })
+		>>= Annex.changeGitRepo
+
+keyOptions :: [Option]
+keyOptions = 
+	[ Option ['A'] ["all"] (NoArg (Annex.setFlag "all"))
+		"operate on all versions of all files"
+	, Option ['U'] ["unused"] (NoArg (Annex.setFlag "unused"))
+		"operate on files found by last run of git-annex unused"
+	, Option [] ["key"] (ReqArg (Annex.setField "key") paramKey)
+		"operate on specified key"
+	]
+
+fromOption :: Option
+fromOption = fieldOption ['f'] "from" paramRemote "source remote"
+
+toOption :: Option
+toOption = fieldOption ['t'] "to" paramRemote "destination remote"
+
+fromToOptions :: [Option]
+fromToOptions = [fromOption, toOption]
+
+jsonOption :: Option
+jsonOption = Option ['j'] ["json"] (NoArg (Annex.setOutput JSONOutput))
+	"enable JSON output"
diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs
new file mode 100644
index 000000000..c7b5bd1c9
--- /dev/null
+++ b/CmdLine/GitAnnexShell.hs
@@ -0,0 +1,199 @@
+{- git-annex-shell main program
+ -
+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module CmdLine.GitAnnexShell where
+
+import System.Environment
+import System.Console.GetOpt
+
+import Common.Annex
+import qualified Git.Construct
+import CmdLine
+import Command
+import Annex.UUID
+import Annex (setField)
+import Fields
+import Utility.UserInfo
+import Remote.GCrypt (getGCryptUUID)
+import qualified Annex
+import Init
+
+import qualified Command.ConfigList
+import qualified Command.InAnnex
+import qualified Command.DropKey
+import qualified Command.RecvKey
+import qualified Command.SendKey
+import qualified Command.TransferInfo
+import qualified Command.Commit
+import qualified Command.GCryptSetup
+
+cmds_readonly :: [Command]
+cmds_readonly = concat
+	[ gitAnnexShellCheck Command.ConfigList.def
+	, gitAnnexShellCheck Command.InAnnex.def
+	, gitAnnexShellCheck Command.SendKey.def
+	, gitAnnexShellCheck Command.TransferInfo.def
+	]
+
+cmds_notreadonly :: [Command]
+cmds_notreadonly = concat
+	[ gitAnnexShellCheck Command.RecvKey.def
+	, gitAnnexShellCheck Command.DropKey.def
+	, gitAnnexShellCheck Command.Commit.def
+	, Command.GCryptSetup.def
+	]
+
+cmds :: [Command]
+cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly
+  where
+	adddirparam c = c { cmdparamdesc = "DIRECTORY " ++ cmdparamdesc c }
+
+options :: [OptDescr (Annex ())]
+options = commonOptions ++
+	[ Option [] ["uuid"] (ReqArg checkUUID paramUUID) "local repository uuid"
+	]
+  where
+	checkUUID expected = getUUID >>= check
+	  where
+		check u | u == toUUID expected = noop
+		check NoUUID = checkGCryptUUID expected
+		check u = unexpectedUUID expected u
+	checkGCryptUUID expected = check =<< getGCryptUUID True =<< gitRepo
+	  where
+	  	check (Just u) | u == toUUID expected = noop
+		check Nothing = unexpected expected "uninitialized repository"
+		check (Just u) = unexpectedUUID expected u
+	unexpectedUUID expected u = unexpected expected $ "UUID " ++ fromUUID u
+	unexpected expected s = error $
+		"expected repository UUID " ++ expected ++ " but found " ++ s
+
+header :: String
+header = "git-annex-shell [-c] command [parameters ...] [option ...]"
+
+run :: [String] -> IO ()
+run [] = failure
+-- skip leading -c options, passed by eg, ssh
+run ("-c":p) = run p
+-- a command can be either a builtin or something to pass to git-shell
+run c@(cmd:dir:params)
+	| cmd `elem` builtins = builtin cmd dir params
+	| otherwise = external c
+run 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 = run $ 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 = do
+	checkNotReadOnly cmd
+	checkDirectory $ Just dir
+	let (params', fieldparams, opts) = partitionParams params
+	    fields = filter checkField $ parseFields fieldparams
+	    cmds' = map (newcmd $ unwords opts) cmds
+	dispatch False (cmd : params') cmds' options fields header $
+		Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath
+  where
+	addrsyncopts opts seek k = setField "RsyncOptions" opts >> seek k
+	newcmd opts c = c { cmdseek = addrsyncopts opts (cmdseek c) }
+
+external :: [String] -> IO ()
+external params = do
+	{- Normal git-shell commands all have the directory as their last
+	 - parameter. -}
+	let lastparam = lastMaybe =<< shellUnEscape <$> lastMaybe params
+	    (params', _, _) = partitionParams params
+	checkDirectory lastparam
+	checkNotLimited
+	unlessM (boolSystem "git-shell" $ map Param $ "-c":params') $
+		error "git-shell failed"
+
+{- Split the input list into 3 groups separated with a double dash --.
+ - Parameters between two -- markers are field settings, in the form:
+ - field=value field=value
+ -
+ - Parameters after the last -- are the command itself and its arguments e.g.,
+ - rsync --bandwidth=100.
+ -}
+partitionParams :: [String] -> ([String], [String], [String])
+partitionParams ps = case segment (== "--") ps of
+	params:fieldparams:rest -> ( params, fieldparams, intercalate ["--"] rest )
+	[params] -> (params, [], [])
+	_ -> ([], [], [])
+
+parseFields :: [String] -> [(String, String)]
+parseFields = map (separate (== '='))
+
+{- Only allow known fields to be set, ignore others.
+ - Make sure that field values make sense. -}
+checkField :: (String, String) -> Bool
+checkField (field, value)
+	| field == fieldName remoteUUID = fieldCheck remoteUUID value
+	| field == fieldName associatedFile = fieldCheck associatedFile value
+	| field == fieldName direct = fieldCheck direct value
+	| otherwise = False
+
+failure :: IO ()
+failure = error $ "bad parameters\n\n" ++ usage header cmds
+
+checkNotLimited :: IO ()
+checkNotLimited = checkEnv "GIT_ANNEX_SHELL_LIMITED"
+
+checkNotReadOnly :: String -> IO ()
+checkNotReadOnly cmd
+	| cmd `elem` map cmdname cmds_readonly = noop
+	| otherwise = checkEnv "GIT_ANNEX_SHELL_READONLY"
+
+checkDirectory :: Maybe FilePath -> IO ()
+checkDirectory mdir = do
+	v <- catchMaybeIO $ getEnv "GIT_ANNEX_SHELL_DIRECTORY"
+	case (v, mdir) of
+		(Nothing, _) -> noop
+		(Just d, Nothing) -> req d Nothing
+		(Just d, Just dir)
+			|  d `equalFilePath` dir -> noop
+			| otherwise -> do
+				home <- myHomeDir
+				d' <- canondir home d
+				dir' <- canondir home dir
+				if d' `equalFilePath` dir'
+					then noop
+					else req d' (Just dir')
+  where
+	req d mdir' = error $ unwords 
+		[ "Only allowed to access"
+		, d
+		, maybe "and could not determine directory from command line" ("not " ++) mdir'
+		]
+
+	{- A directory may start with ~/ or in some cases, even /~/,
+	 - or could just be relative to home, or of course could
+	 - be absolute. -}
+	canondir home d
+		| "~/" `isPrefixOf` d = return d
+		| "/~/" `isPrefixOf` d = return $ drop 1 d
+		| otherwise = relHome $ absPathFrom home d
+
+checkEnv :: String -> IO ()
+checkEnv var = do
+	v <- catchMaybeIO $ getEnv var
+	case v of
+		Nothing -> noop
+		Just "" -> noop
+		Just _ -> error $ "Action blocked by " ++ var
+
+{- Modifies a Command to check that it is run in either a git-annex
+ - repository, or a repository with a gcrypt-id set. -}
+gitAnnexShellCheck :: [Command] -> [Command]
+gitAnnexShellCheck = map $ addCheck okforshell . dontCheck repoExists
+  where
+	okforshell = unlessM (isInitialized <||> isJust . gcryptId <$> Annex.getGitConfig) $
+		error "Not a git-annex or gcrypt repository."
diff --git a/CmdLine/Option.hs b/CmdLine/Option.hs
new file mode 100644
index 000000000..915b06849
--- /dev/null
+++ b/CmdLine/Option.hs
@@ -0,0 +1,77 @@
+{- common command-line options
+ -
+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module CmdLine.Option (
+	commonOptions,
+	matcherOptions,
+	flagOption,
+	fieldOption,
+	optionName,
+	ArgDescr(..),
+	OptDescr(..),
+) where
+
+import System.Console.GetOpt
+
+import Common.Annex
+import qualified Annex
+import Types.Messages
+import Limit
+import CmdLine.Usage
+
+commonOptions :: [Option]
+commonOptions =
+	[ Option [] ["force"] (NoArg (setforce True))
+		"allow actions that may lose annexed data"
+	, Option ['F'] ["fast"] (NoArg (setfast True))
+		"avoid slow operations"
+	, Option ['a'] ["auto"] (NoArg (setauto True))
+		"automatic mode"
+	, Option ['q'] ["quiet"] (NoArg (Annex.setOutput QuietOutput))
+		"avoid verbose output"
+	, Option ['v'] ["verbose"] (NoArg (Annex.setOutput NormalOutput))
+		"allow verbose output (default)"
+	, Option ['d'] ["debug"] (NoArg setdebug)
+		"show debug messages"
+	, Option [] ["no-debug"] (NoArg unsetdebug)
+		"don't show debug messages"
+	, Option ['b'] ["backend"] (ReqArg setforcebackend paramName)
+		"specify key-value backend to use"
+	]
+  where
+	setforce v = Annex.changeState $ \s -> s { Annex.force = v }
+	setfast v = Annex.changeState $ \s -> s { Annex.fast = v }
+	setauto v = Annex.changeState $ \s -> s { Annex.auto = v }
+	setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
+	setdebug = Annex.changeGitConfig $ \c -> c { annexDebug = True }
+	unsetdebug = Annex.changeGitConfig $ \c -> c { annexDebug = False }
+
+matcherOptions :: [Option]
+matcherOptions =
+	[ longopt "not" "negate next option"
+	, longopt "and" "both previous and next option must match"
+	, longopt "or" "either previous or next option must match"
+	, shortopt "(" "open group of options"
+	, shortopt ")" "close group of options"
+	]
+  where
+	longopt o = Option [] [o] $ NoArg $ addToken o
+	shortopt o = Option o [] $ NoArg $ addToken o
+
+{- An option that sets a flag. -}
+flagOption :: String -> String -> String -> Option
+flagOption short opt description = 
+	Option short [opt] (NoArg (Annex.setFlag opt)) description
+
+{- An option that sets a field. -}
+fieldOption :: String -> String -> String -> String -> Option
+fieldOption short opt paramdesc description = 
+	Option short [opt] (ReqArg (Annex.setField opt) paramdesc) description
+
+{- The flag or field name used for an option. -}
+optionName :: Option -> String
+optionName (Option _ o _ _) = Prelude.head o
diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs
new file mode 100644
index 000000000..d6d7fbc8b
--- /dev/null
+++ b/CmdLine/Seek.hs
@@ -0,0 +1,182 @@
+{- git-annex command seeking
+ - 
+ - These functions find appropriate files or other things based on
+ - the values a user passes to a command, and prepare actions operating
+ - on them.
+ -
+ - Copyright 2010-2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module CmdLine.Seek where
+
+import System.PosixCompat.Files
+
+import Common.Annex
+import Types.Command
+import Types.Key
+import Types.FileMatcher
+import qualified Annex
+import qualified Git
+import qualified Git.Command
+import qualified Git.LsFiles as LsFiles
+import qualified Limit
+import CmdLine.Option
+import Logs.Location
+import Logs.Unused
+import Annex.CatFile
+import RunCommand
+
+withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
+withFilesInGit a params = seekActions $ prepFiltered a $
+	seekHelper LsFiles.inRepo params
+
+withFilesNotInGit :: (FilePath -> CommandStart) -> CommandSeek
+withFilesNotInGit a params = do
+	{- dotfiles are not acted on unless explicitly listed -}
+	files <- filter (not . dotfile) <$>
+		seekunless (null ps && not (null params)) ps
+	dotfiles <- seekunless (null dotps) dotps
+	seekActions $ prepFiltered a $
+		return $ concat $ segmentPaths params (files++dotfiles)
+  where
+	(dotps, ps) = partition dotfile params
+	seekunless True _ = return []
+	seekunless _ l = do
+		force <- Annex.getState Annex.force
+		g <- gitRepo
+		liftIO $ Git.Command.leaveZombie <$> LsFiles.notInRepo force l g
+
+withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CommandSeek
+withPathContents a params = seekActions $ 
+	map a . concat <$> liftIO (mapM get params)
+  where
+	get p = ifM (isDirectory <$> getFileStatus p)
+		( map (\f -> (f, makeRelative (parentDir p) f))
+			<$> dirContentsRecursiveSkipping (".git" `isSuffixOf`) True p
+		, return [(p, takeFileName p)]
+		)
+
+withWords :: ([String] -> CommandStart) -> CommandSeek
+withWords a params = seekActions $ return [a params]
+
+withStrings :: (String -> CommandStart) -> CommandSeek
+withStrings a params = seekActions $ return $ map a params
+
+withPairs :: ((String, String) -> CommandStart) -> CommandSeek
+withPairs a params = seekActions $ return $ map a $ pairs [] params
+  where
+	pairs c [] = reverse c
+	pairs c (x:y:xs) = pairs ((x,y):c) xs
+	pairs _ _ = error "expected pairs"
+
+withFilesToBeCommitted :: (String -> CommandStart) -> CommandSeek
+withFilesToBeCommitted a params = seekActions $ prepFiltered a $
+	seekHelper LsFiles.stagedNotDeleted params
+
+withFilesUnlocked :: (FilePath -> CommandStart) -> CommandSeek
+withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged
+
+withFilesUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CommandSeek
+withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
+
+{- Unlocked files have changed type from a symlink to a regular file.
+ -
+ - Furthermore, unlocked files used to be a git-annex symlink,
+ - not some other sort of symlink.
+ -}
+withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CommandSeek
+withFilesUnlocked' typechanged a params = seekActions $
+	prepFiltered a unlockedfiles
+  where
+  	check f = liftIO (notSymlink f) <&&> 
+		(isJust <$> catKeyFile f <||> isJust <$> catKeyFileHEAD f)
+	unlockedfiles = filterM check =<< seekHelper typechanged params
+
+{- Finds files that may be modified. -}
+withFilesMaybeModified :: (FilePath -> CommandStart) -> CommandSeek
+withFilesMaybeModified a params = seekActions $
+	prepFiltered a $ seekHelper LsFiles.modified params
+
+withKeys :: (Key -> CommandStart) -> CommandSeek
+withKeys a params = seekActions $ return $ map (a . parse) params
+  where
+	parse p = fromMaybe (error "bad key") $ file2key p
+
+{- Gets the value of a field options, which is fed into
+ - a conversion function.
+ -}
+getOptionField :: Option -> (Maybe String -> Annex a) -> Annex a
+getOptionField option converter = converter <=< Annex.getField $ optionName option
+
+getOptionFlag :: Option -> Annex Bool
+getOptionFlag option = Annex.getFlag (optionName option)
+
+withNothing :: CommandStart -> CommandSeek
+withNothing a [] = seekActions $ return [a]
+withNothing _ _ = error "This command takes no parameters."
+
+{- If --all is specified, or in a bare repo, runs an action on all
+ - known keys.
+ -
+ - If --unused is specified, runs an action on all keys found by
+ - the last git annex unused scan.
+ -
+ - If --key is specified, operates only on that key.
+ -
+ - Otherwise, fall back to a regular CommandSeek action on
+ - whatever params were passed. -}
+withKeyOptions :: (Key -> CommandStart) -> CommandSeek -> CommandSeek
+withKeyOptions keyop fallbackop params = do
+	bare <- fromRepo Git.repoIsLocalBare
+	allkeys <- Annex.getFlag "all"
+	unused <- Annex.getFlag "unused"
+	specifickey <- Annex.getField "key"
+	auto <- Annex.getState Annex.auto
+	when (auto && bare) $
+		error "Cannot use --auto in a bare repository"
+	case	(allkeys, unused, null params, specifickey) of
+		(False  , False , True       , Nothing)
+			| bare -> go auto loggedKeys
+			| otherwise -> fallbackop params
+		(False  , False , _          , Nothing) -> fallbackop params
+		(True   , False , True       , Nothing) -> go auto loggedKeys
+		(False  , True  , True       , Nothing) -> go auto unusedKeys'
+		(False  , False , True       , Just ks) -> case file2key ks of
+			Nothing -> error "Invalid key"
+			Just k -> go auto $ return [k]
+		_ -> error "Can only specify one of file names, --all, --unused, or --key"
+  where
+  	go True _ = error "Cannot use --auto with --all or --unused or --key"
+	go False a = do
+		matcher <- Limit.getMatcher
+		seekActions $ map (process matcher) <$> a
+	process matcher k = ifM (matcher $ MatchingKey k)
+		( keyop k , return Nothing)
+
+prepFiltered :: (FilePath -> CommandStart) -> Annex [FilePath] -> Annex [CommandStart]
+prepFiltered a fs = do
+	matcher <- Limit.getMatcher
+	map (process matcher) <$> fs
+  where
+	process matcher f = ifM (matcher $ MatchingFile $ FileInfo f f)
+		( a f , return Nothing )
+
+seekActions :: Annex [CommandStart] -> Annex ()
+seekActions gen = do
+	as <- gen
+	mapM_ commandAction as
+
+seekHelper :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> [FilePath] -> Annex [FilePath]
+seekHelper a params = do
+	ll <- inRepo $ \g ->
+		runSegmentPaths (\fs -> Git.Command.leaveZombie <$> a fs g) params
+	{- Show warnings only for files/directories that do not exist. -}
+	forM_ (map fst $ filter (null . snd) $ zip params ll) $ \p ->
+		unlessM (isJust <$> liftIO (catchMaybeIO $ getSymbolicLinkStatus p)) $
+			fileNotFound p
+	return $ concat ll
+
+notSymlink :: FilePath -> IO Bool
+notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f
diff --git a/CmdLine/Usage.hs b/CmdLine/Usage.hs
new file mode 100644
index 000000000..64b512144
--- /dev/null
+++ b/CmdLine/Usage.hs
@@ -0,0 +1,111 @@
+{- git-annex usage messages
+ -
+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module CmdLine.Usage where
+
+import Common.Annex
+
+import Types.Command
+
+import System.Console.GetOpt
+
+usageMessage :: String -> String
+usageMessage s = "Usage: " ++ s
+
+{- Usage message with lists of commands by section. -}
+usage :: String -> [Command] -> String
+usage header cmds = unlines $ usageMessage header : concatMap go [minBound..]
+  where
+	go section
+		| null cs = []
+		| otherwise =
+			[ ""
+			, descSection section ++ ":"
+			, ""
+			] ++ map cmdline cs
+	  where
+		cs = filter (\c -> cmdsection c == section) scmds
+	cmdline c = concat
+		[ cmdname c
+		, namepad (cmdname c)
+		, cmdparamdesc c
+		, descpad (cmdparamdesc c)
+		, cmddesc c
+		]
+	pad n s = replicate (n - length s) ' '
+	namepad = pad $ longest cmdname + 1
+	descpad = pad $ longest cmdparamdesc + 2
+	longest f = foldl max 0 $ map (length . f) cmds
+	scmds = sort cmds
+
+{- Usage message for a single command. -}
+commandUsage :: Command -> String
+commandUsage cmd = unlines
+	[ usageInfo header (cmdoptions cmd)
+	, "To see additional options common to all commands, run: git annex help options"
+	]
+  where
+	header = usageMessage $ unwords
+		[ "git-annex"
+		, cmdname cmd
+		, cmdparamdesc cmd
+		, "[option ...]"
+		]
+
+{- Descriptions of params used in usage messages. -}
+paramPaths :: String
+paramPaths = paramOptional $ paramRepeating paramPath -- most often used
+paramPath :: String
+paramPath = "PATH"
+paramKey :: String
+paramKey = "KEY"
+paramDesc :: String
+paramDesc = "DESC"
+paramUrl :: String
+paramUrl = "URL"
+paramNumber :: String
+paramNumber = "NUMBER"
+paramNumRange :: String
+paramNumRange = "NUM|RANGE"
+paramRemote :: String
+paramRemote = "REMOTE"
+paramGlob :: String
+paramGlob = "GLOB"
+paramName :: String
+paramName = "NAME"
+paramValue :: String
+paramValue = "VALUE"
+paramUUID :: String
+paramUUID = "UUID"
+paramType :: String
+paramType = "TYPE"
+paramDate :: String
+paramDate = "DATE"
+paramTime :: String
+paramTime = "TIME"
+paramFormat :: String
+paramFormat = "FORMAT"
+paramFile :: String
+paramFile = "FILE"
+paramGroup :: String
+paramGroup = "GROUP"
+paramExpression :: String
+paramExpression = "EXPR"
+paramSize :: String
+paramSize = "SIZE"
+paramAddress :: String
+paramAddress = "ADDRESS"
+paramKeyValue :: String
+paramKeyValue = "K=V"
+paramNothing :: String
+paramNothing = ""
+paramRepeating :: String -> String
+paramRepeating s = s ++ " ..."
+paramOptional :: String -> String
+paramOptional s = "[" ++ s ++ "]"
+paramPair :: String -> String -> String
+paramPair a b = a ++ " " ++ b