diff options
| -rw-r--r-- | Fields.hs | 10 | ||||
| -rw-r--r-- | GitAnnexShell.hs | 6 |
2 files changed, 8 insertions, 8 deletions
@@ -15,18 +15,18 @@ import Data.Char {- A field, stored in Annex state, with a value sanity checker. -} data Field = Field { fieldName :: String - , fieldCheck :: String -> IO Bool + , fieldCheck :: String -> Bool } remoteUUID :: Field remoteUUID = Field "remoteuuid" $ -- does it look like a UUID? - return . all (\c -> isAlphaNum c || c == '-') + all (\c -> isAlphaNum c || c == '-') associatedFile :: Field -associatedFile = Field "associatedfile" $ \value -> - -- is the file located within the current directory? - dirContains <$> getCurrentDirectory <*> pure value +associatedFile = Field "associatedfile" $ \f -> + -- is the file a safe relative filename? + not (isAbsolute f) && not ("../" `isPrefixOf` f) getField :: Field -> Annex (Maybe String) getField = Annex.getField . fieldName diff --git a/GitAnnexShell.hs b/GitAnnexShell.hs index 497e4cf8f..15be51180 100644 --- a/GitAnnexShell.hs +++ b/GitAnnexShell.hs @@ -85,7 +85,7 @@ builtin :: String -> String -> [String] -> IO () builtin cmd dir params = do checkNotReadOnly cmd let (params', fieldparams) = partitionParams params - fields <- filterM checkField $ parseFields fieldparams + let fields = filter checkField $ parseFields fieldparams dispatch False (cmd : params') cmds options fields header $ Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath @@ -113,11 +113,11 @@ 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 :: (String, String) -> Bool checkField (field, value) | field == fieldName remoteUUID = fieldCheck remoteUUID value | field == fieldName associatedFile = fieldCheck associatedFile value - | otherwise = return False + | otherwise = False failure :: IO () failure = error $ "bad parameters\n\n" ++ usage header cmds options |