diff options
| -rw-r--r-- | CHANGELOG | 4 | ||||
| -rw-r--r-- | Remote/WebDAV.hs | 10 | ||||
| -rw-r--r-- | Utility/Url.hs | 7 |
3 files changed, 18 insertions, 3 deletions
@@ -10,6 +10,10 @@ git-annex (6.20170819) UNRELEASED; urgency=medium * init: Display an additional message when it detects a filesystem that allows writing to files whose write bit is not set. * S3: Allow removing files from IA. + * webdav: Checking if a non-existent file is present on Box.com + triggered a bug in its webdav support that generates an infinite series + of redirects. Deal with such problems by assuming such behavior means + the file is not present. -- Joey Hess <id@joeyh.name> Mon, 28 Aug 2017 12:20:59 -0400 diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 04eb35cef..12b9d40b2 100644 --- a/Remote/WebDAV.hs +++ b/Remote/WebDAV.hs @@ -32,7 +32,7 @@ import Remote.Helper.Export import qualified Remote.Helper.Chunked.Legacy as Legacy import Creds import Utility.Metered -import Utility.Url (URLString, matchStatusCodeException) +import Utility.Url (URLString, matchStatusCodeException, matchHttpExceptionContent) import Annex.UUID import Remote.WebDAV.DavLocation @@ -317,11 +317,15 @@ existsDAV l = inLocation l check `catchNonAsync` (\e -> return (Left $ show e)) -- more depth is certainly not needed to check if a -- location exists. setDepth (Just Depth1) - catchJust - (matchStatusCodeException (== notFound404)) + catchJust missinghttpstatus (getPropsM >> ispresent True) (const $ ispresent False) ispresent = return . Right + missinghttpstatus e = + matchStatusCodeException (== notFound404) e + <|> matchHttpExceptionContent toomanyredirects e + toomanyredirects (TooManyRedirects _) = True + toomanyredirects _ = False safely :: DAVT IO a -> DAVT IO (Maybe a) safely = eitherToMaybe <$$> tryNonAsync diff --git a/Utility/Url.hs b/Utility/Url.hs index e1a21af5d..e6dcd3388 100644 --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -27,6 +27,7 @@ module Utility.Url ( downloadQuiet, parseURIRelaxed, matchStatusCodeException, + matchHttpExceptionContent, ) where import Common @@ -365,3 +366,9 @@ matchStatusCodeException want e@(StatusCodeException s _ _) | otherwise = Nothing matchStatusCodeException _ _ = Nothing #endif + +matchHttpExceptionContent :: (HttpExceptionContent -> Bool) -> HttpException -> Maybe HttpException +matchHttpExceptionContent want e@(HttpExceptionRequest _ hec) + | want hec = Just e + | otherwise = Nothing +matchHttpExceptionContent _ _ = Nothing |