diff options
| -rw-r--r-- | CmdLine.hs | 5 | ||||
| -rw-r--r-- | GitAnnex.hs | 2 | ||||
| -rw-r--r-- | GitAnnexShell.hs | 29 | ||||
| -rw-r--r-- | Utility/Misc.hs | 10 | ||||
| -rw-r--r-- | doc/git-annex-shell.mdwn | 8 |
5 files changed, 42 insertions, 12 deletions
diff --git a/CmdLine.hs b/CmdLine.hs index 910f228b6..edbe5e107 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -30,8 +30,8 @@ type Params = [String] type Flags = [Annex ()] {- Runs the passed command line. -} -dispatch :: Bool -> Params -> [Command] -> [Option] -> String -> IO Git.Repo -> IO () -dispatch fuzzyok allargs allcmds commonoptions header getgitrepo = do +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 @@ -40,6 +40,7 @@ dispatch fuzzyok allargs allcmds commonoptions header getgitrepo = do state <- Annex.new g (actions, state') <- Annex.run state $ do checkfuzzy + forM_ fields $ \(f, v) -> Annex.setField f v sequence_ flags prepCommand cmd params tryRun state' cmd $ [startup] ++ actions ++ [shutdown $ cmdoneshot cmd] diff --git a/GitAnnex.hs b/GitAnnex.hs index 8dba5a3a7..bf1f27bfd 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -143,4 +143,4 @@ header :: String header = "Usage: git-annex command [option ..]" run :: [String] -> IO () -run args = dispatch True args cmds options header Git.CurrentRepo.get +run args = dispatch True args cmds options [] header Git.CurrentRepo.get diff --git a/GitAnnexShell.hs b/GitAnnexShell.hs index 663303713..2a9f3c26a 100644 --- a/GitAnnexShell.hs +++ b/GitAnnexShell.hs @@ -47,7 +47,8 @@ cmds = map adddirparam $ cmds_readonly ++ cmds_notreadonly options :: [OptDescr (Annex ())] options = Option.common ++ - [ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "repository uuid" + [ Option [] ["uuid"] (ReqArg checkuuid paramUUID) "local repository uuid" + , Option [] ["remote-uuid"] (ReqArg checkuuid paramUUID) "remote repository uuid" ] where checkuuid expected = getUUID >>= check @@ -83,21 +84,31 @@ builtins = map cmdname cmds builtin :: String -> String -> [String] -> IO () builtin cmd dir params = do checkNotReadOnly cmd - dispatch False (cmd : filterparams params) cmds options header $ + let (params', fields) = partitionParams params + dispatch False (cmd : params') cmds options (parseFields fields) header $ Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath external :: [String] -> IO () external params = do checkNotLimited - unlessM (boolSystem "git-shell" $ map Param $ "-c":filterparams params) $ + unlessM (boolSystem "git-shell" $ map Param $ "-c":fst (partitionParams params)) $ error "git-shell failed" --- Drop all args after "--". --- These tend to be passed by rsync and not useful. -filterparams :: [String] -> [String] -filterparams [] = [] -filterparams ("--":_) = [] -filterparams (a:as) = a:filterparams as +{- 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. + -} +partitionParams :: [String] -> ([String], [String]) +partitionParams params + | length segments < 2 = (segments !! 0, []) + | otherwise = (segments !! 0, segments !! 1) + where + segments = segment (== "--") params + +parseFields :: [String] -> [(String, String)] +parseFields = map (separate (== '=')) failure :: IO () failure = error $ "bad parameters\n\n" ++ usage header cmds options diff --git a/Utility/Misc.hs b/Utility/Misc.hs index 3ac5ca5c0..3b359139b 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -35,3 +35,13 @@ separate c l = unbreak $ break c l {- Breaks out the first line. -} firstLine :: String-> String firstLine = takeWhile (/= '\n') + +{- Splits a list into segments that are delimited by items matching + - a predicate. (The delimiters are not included in the segments.) -} +segment :: (a -> Bool) -> [a] -> [[a]] +segment p l = map reverse $ go [] [] l + where + go c r [] = reverse $ c:r + go c r (i:is) + | p i = go [] (c:r) is + | otherwise = go (i:c) r is diff --git a/doc/git-annex-shell.mdwn b/doc/git-annex-shell.mdwn index 00c68ff3a..20a9d3d37 100644 --- a/doc/git-annex-shell.mdwn +++ b/doc/git-annex-shell.mdwn @@ -61,6 +61,14 @@ to git-annex-shell are: git-annex uses this to specify the UUID of the repository it was expecting git-annex-shell to access, as a sanity check. +* -- fields=val fields=val.. -- + + Additional fields may be specified this way, to retain compatability with + past versions of git-annex-shell (that ignore these, but would choke + on new dashed options). + + Currently used fields include remoteuuid= and associatedfile= + # HOOK After content is received or dropped from the repository by git-annex-shell, |