bc21502b9a
Added a cheap way to query the size of a queue. runQueueAt is not the default yet only because there may be some code that expects to be able to queue some suff, do something else, and run the whole queue at the end. 10240 is an arbitrary size for the queue. If we assume annexed filenames are between 10 and 255 characters long, then the queue will build up between 100kb and 2550kb long commands. The max command line length on linux is somewhere above 20k, so this is a fairly good balance -- the queue will buffer only a few megabytes of stuff and a minimal number of commands will be run by xargs. Also, insert queue items strictly, this should save memory.
108 lines
3.1 KiB
Haskell
108 lines
3.1 KiB
Haskell
{- git-annex command line parsing and dispatch
|
|
-
|
|
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module CmdLine (
|
|
dispatch,
|
|
usage,
|
|
shutdown
|
|
) where
|
|
|
|
import System.IO.Error (try)
|
|
import System.Console.GetOpt
|
|
import Control.Monad.State (liftIO)
|
|
import Control.Monad (when, unless)
|
|
|
|
import qualified Annex
|
|
import qualified GitRepo as Git
|
|
import qualified GitQueue
|
|
import Types
|
|
import Command
|
|
import BackendList
|
|
import Upgrade
|
|
import Options
|
|
import Messages
|
|
import UUID
|
|
|
|
{- Runs the passed command line. -}
|
|
dispatch :: Git.Repo -> [String] -> [Command] -> [Option] -> String -> IO ()
|
|
dispatch gitrepo args cmds options header = do
|
|
setupConsole
|
|
state <- Annex.new gitrepo allBackends
|
|
(actions, state') <- Annex.run state $ parseCmd args header cmds options
|
|
tryRun state' $ [startup, upgrade] ++ actions ++ [shutdown]
|
|
|
|
{- Parses command line, stores configure flags, and returns a
|
|
- list of actions to be run in the Annex monad. -}
|
|
parseCmd :: [String] -> String -> [Command] -> [Option] -> Annex [Annex Bool]
|
|
parseCmd argv header cmds options = do
|
|
(flags, params) <- liftIO $ getopt
|
|
when (null params) $ error $ "missing command" ++ usagemsg
|
|
case lookupCmd (head params) of
|
|
[] -> error $ "unknown command" ++ usagemsg
|
|
[command] -> do
|
|
_ <- sequence flags
|
|
prepCmd command (drop 1 params)
|
|
_ -> error "internal error: multiple matching commands"
|
|
where
|
|
getopt = case getOpt Permute options argv of
|
|
(flags, params, []) ->
|
|
return (flags, params)
|
|
(_, _, errs) ->
|
|
ioError (userError (concat errs ++ usagemsg))
|
|
lookupCmd cmd = filter (\c -> cmd == cmdname c) cmds
|
|
usagemsg = "\n\n" ++ usage header cmds options
|
|
|
|
{- Usage message with lists of commands and options. -}
|
|
usage :: String -> [Command] -> [Option] -> String
|
|
usage header cmds options =
|
|
usageInfo (header ++ "\n\nOptions:") options ++
|
|
"\nCommands:\n" ++ cmddescs
|
|
where
|
|
cmddescs = unlines $ map (indent . showcmd) cmds
|
|
showcmd c =
|
|
cmdname c ++
|
|
pad (longest cmdname + 1) (cmdname c) ++
|
|
cmdparams c ++
|
|
pad (longest cmdparams + 2) (cmdparams c) ++
|
|
cmddesc c
|
|
pad n s = replicate (n - length s) ' '
|
|
longest f = foldl max 0 $ map (length . f) cmds
|
|
|
|
{- Runs a list of Annex actions. Catches IO errors and continues
|
|
- (but explicitly thrown errors terminate the whole command).
|
|
-}
|
|
tryRun :: Annex.AnnexState -> [Annex Bool] -> IO ()
|
|
tryRun state actions = tryRun' state 0 actions
|
|
tryRun' :: Annex.AnnexState -> Integer -> [Annex Bool] -> IO ()
|
|
tryRun' state errnum (a:as) = do
|
|
result <- try $ Annex.run state a
|
|
case result of
|
|
Left err -> do
|
|
Annex.eval state $ showErr err
|
|
tryRun' state (errnum + 1) as
|
|
Right (True,state') -> tryRun' state' errnum as
|
|
Right (False,state') -> tryRun' state' (errnum + 1) as
|
|
tryRun' _ errnum [] = do
|
|
when (errnum > 0) $ error $ show errnum ++ " failed"
|
|
|
|
{- Actions to perform each time ran. -}
|
|
startup :: Annex Bool
|
|
startup = do
|
|
prepUUID
|
|
return True
|
|
|
|
{- Cleanup actions. -}
|
|
shutdown :: Annex Bool
|
|
shutdown = do
|
|
q <- Annex.getState Annex.repoqueue
|
|
unless (0 == GitQueue.size q) $ do
|
|
showSideAction "Recording state in git..."
|
|
Annex.queueRun
|
|
|
|
liftIO $ Git.reap
|
|
|
|
return True
|