diff options
author | Joey Hess <joey@kitenet.net> | 2012-07-02 01:31:10 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-07-02 01:31:10 -0400 |
commit | bea0ac0274861f639ef999b146a719f4300fbfe4 (patch) | |
tree | bd1bf0d171f83667da918850e6b653c288031d30 /GitAnnexShell.hs | |
parent | d1f49b0ad032f13adc39d963cc8ceca28215b1d5 (diff) |
record transfers for git-annex-shell
Not yet tested and places git-annex-shell is run need to be modified to
pass the new field settings.
Note that rsyncServerSend was changed to fork, rather than directly exec
rsync, because it needs to keep the transfer lock held, and clean up the
transfer log when done.
Diffstat (limited to 'GitAnnexShell.hs')
-rw-r--r-- | GitAnnexShell.hs | 18 |
1 files changed, 16 insertions, 2 deletions
diff --git a/GitAnnexShell.hs b/GitAnnexShell.hs index 2a9f3c26a..559e30235 100644 --- a/GitAnnexShell.hs +++ b/GitAnnexShell.hs @@ -9,6 +9,7 @@ module GitAnnexShell where import System.Environment import System.Console.GetOpt +import Data.Char import Common.Annex import qualified Git.Construct @@ -84,8 +85,9 @@ builtins = map cmdname cmds builtin :: String -> String -> [String] -> IO () builtin cmd dir params = do checkNotReadOnly cmd - let (params', fields) = partitionParams params - dispatch False (cmd : params') cmds options (parseFields fields) header $ + let (params', fieldparams) = partitionParams params + fields <- filterM checkField $ parseFields fieldparams + dispatch False (cmd : params') cmds options fields header $ Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath external :: [String] -> IO () @@ -110,6 +112,18 @@ partitionParams 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) -> IO Bool +checkField (field, value) + | field == "remoteuuid" = return $ + -- does it look like a UUID? + all (\c -> isAlphaNum c || c == '-') value + | field == "associatedfile" = + -- is the file located within the current directory? + dirContains <$> getCurrentDirectory <*> pure value + | otherwise = return False + failure :: IO () failure = error $ "bad parameters\n\n" ++ usage header cmds options |