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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
{- git-annex command line parsing and dispatch
-
- Copyright 2010-2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module CmdLine (
dispatch,
usage,
shutdown
) where
import qualified Control.Exception as E
import qualified Data.Map as M
import Control.Exception (throw)
import System.Console.GetOpt
#ifndef mingw32_HOST_OS
import System.Posix.Signals
#endif
import Common.Annex
import qualified Annex
import qualified Annex.Queue
import qualified Git
import qualified Git.AutoCorrect
import Annex.Content
import Annex.Ssh
import Annex.Environment
import Command
import Types.Messages
type Params = [String]
type Flags = [Annex ()]
{- Runs the passed command line. -}
dispatch :: Bool -> Params -> [Command] -> [Option] -> [(String, String)] -> String -> IO Git.Repo -> IO ()
dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
setupConsole
r <- E.try getgitrepo :: IO (Either E.SomeException Git.Repo)
case r of
Left e -> fromMaybe (throw e) (cmdnorepo cmd)
Right g -> do
state <- Annex.new g
(actions, state') <- Annex.run state $ do
checkEnvironment
checkfuzzy
forM_ fields $ uncurry Annex.setField
when (cmdnomessages cmd) $
Annex.setOutput QuietOutput
sequence_ flags
whenM (annexDebug <$> Annex.getGitConfig) $
liftIO enableDebugOutput
prepCommand cmd params
tryRun state' cmd $ [startup] ++ actions ++ [shutdown $ cmdnocommit cmd]
where
err msg = msg ++ "\n\n" ++ usage header allcmds
cmd = Prelude.head cmds
(fuzzy, cmds, name, args) = findCmd fuzzyok allargs allcmds err
(flags, params) = getOptCmd args cmd commonoptions
checkfuzzy = when fuzzy $
inRepo $ Git.AutoCorrect.prepare name cmdname cmds
{- Parses command line params far enough to find the Command to run, and
- returns the remaining params.
- Does fuzzy matching if necessary, which may result in multiple Commands. -}
findCmd :: Bool -> Params -> [Command] -> (String -> String) -> (Bool, [Command], String, Params)
findCmd fuzzyok argv cmds err
| isNothing name = error $ err "missing command"
| not (null exactcmds) = (False, exactcmds, fromJust name, args)
| fuzzyok && not (null inexactcmds) = (True, inexactcmds, fromJust name, args)
| otherwise = error $ err $ "unknown command " ++ fromJust name
where
(name, args) = findname argv []
findname [] c = (Nothing, reverse c)
findname (a:as) c
| "-" `isPrefixOf` a = findname as (a:c)
| otherwise = (Just a, reverse c ++ as)
exactcmds = filter (\c -> name == Just (cmdname c)) cmds
inexactcmds = case name of
Nothing -> []
Just n -> Git.AutoCorrect.fuzzymatches n cmdname cmds
{- Parses command line options, and returns actions to run to configure flags
- and the remaining parameters for the command. -}
getOptCmd :: Params -> Command -> [Option] -> (Flags, Params)
getOptCmd argv cmd commonoptions = check $
getOpt Permute (commonoptions ++ cmdoptions cmd) argv
where
check (flags, rest, []) = (flags, rest)
check (_, _, errs) = error $ unlines
[ concat errs
, commandUsage cmd
]
{- Runs a list of Annex actions. Catches IO errors and continues
- (but explicitly thrown errors terminate the whole command).
-}
tryRun :: Annex.AnnexState -> Command -> [CommandCleanup] -> IO ()
tryRun = tryRun' 0
tryRun' :: Integer -> Annex.AnnexState -> Command -> [CommandCleanup] -> IO ()
tryRun' errnum _ cmd []
| errnum > 0 = error $ cmdname cmd ++ ": " ++ show errnum ++ " failed"
| otherwise = noop
tryRun' errnum state cmd (a:as) = do
r <- run
handle $! r
where
run = tryIO $ Annex.run state $ do
Annex.Queue.flushWhenFull
a
handle (Left err) = showerr err >> cont False state
handle (Right (success, state')) = cont success state'
cont success s = do
let errnum' = if success then errnum else errnum + 1
(tryRun' $! errnum') s cmd as
showerr err = Annex.eval state $ do
showErr err
showEndFail
{- Actions to perform each time ran. -}
startup :: Annex Bool
startup = liftIO $ do
#ifndef mingw32_HOST_OS
void $ installHandler sigINT Default Nothing
#endif
return True
{- Cleanup actions. -}
shutdown :: Bool -> Annex Bool
shutdown nocommit = do
saveState nocommit
sequence_ =<< M.elems <$> Annex.getState Annex.cleanup
liftIO reapZombies -- zombies from long-running git processes
sshCleanup -- ssh connection caching
return True
|
