diff options
author | guilhem <guilhem@fripost.org> | 2013-03-29 01:34:07 +0100 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-03-30 18:49:43 -0400 |
commit | 27ab9830f16642b03ee97e7257d8973573a6d919 (patch) | |
tree | 9ff6abb1d871c73fee38d40d7a61c58a7ff1e109 /GitAnnexShell.hs | |
parent | 53bec08da77705b1a50585e741854453322573a9 (diff) |
Make git-annex-shell call the command with its (safe) options.
Diffstat (limited to 'GitAnnexShell.hs')
-rw-r--r-- | GitAnnexShell.hs | 29 |
1 files changed, 18 insertions, 11 deletions
diff --git a/GitAnnexShell.hs b/GitAnnexShell.hs index 2661d52e8..d641c6c3f 100644 --- a/GitAnnexShell.hs +++ b/GitAnnexShell.hs @@ -15,6 +15,7 @@ import qualified Git.Construct import CmdLine import Command import Annex.UUID +import Annex (setField) import qualified Option import Fields import Utility.UserInfo @@ -86,32 +87,38 @@ builtin :: String -> String -> [String] -> IO () builtin cmd dir params = do checkNotReadOnly cmd checkDirectory $ Just dir - let (params', fieldparams) = partitionParams params - let fields = filter checkField $ parseFields fieldparams - dispatch False (cmd : params') cmds options fields header $ + let (params', fieldparams, opts) = partitionParams params + fields = filter checkField $ parseFields fieldparams + cmds' = map (newcmd $ intercalate " " opts) cmds + dispatch False (cmd : params') cmds' options fields header $ Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath + where + newseek opts seek k = setField "RsyncOptions" opts >> seek k + newcmd opts c = c { cmdseek = map (newseek 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":fst (partitionParams params)) $ + unlessM (boolSystem "git-shell" $ map Param $ "-c":params') $ error "git-shell failed" -{- Parameters between two -- markers are field settings, in the form: +{- 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 ignored, these tend to be passed by - - rsync and not be useful. + - Parameters after the last -- are the command itself and its arguments e.g., + - rsync --bandwidth=100. -} -partitionParams :: [String] -> ([String], [String]) +partitionParams :: [String] -> ([String], [String], [String]) partitionParams ps = case segment (== "--") ps of - params:fieldparams:_ -> (params, fieldparams) - [params] -> (params, []) - _ -> ([], []) + params:fieldparams:rest -> ( params, fieldparams, intercalate ["--"] rest ) + [params] -> (params, [], []) + _ -> ([], [], []) parseFields :: [String] -> [(String, String)] parseFields = map (separate (== '=')) |