summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Fields.hs10
-rw-r--r--GitAnnexShell.hs6
2 files changed, 8 insertions, 8 deletions
diff --git a/Fields.hs b/Fields.hs
index 08189cbdf..38427ad05 100644
--- a/Fields.hs
+++ b/Fields.hs
@@ -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