deal with box.com horrible infinite redirect behavior

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.

It seems to redirect foo to foo/ to foo/index.php to
foo/index.php/index.php ... Why a webdav endpoint would behave this way
who knows.

Deal with such problems by assuming such behavior means the file is not
present.

Can't simply disable following redirects, because the webdav endpoint could
legitimately be redirected to a new endpoint. So, when this happens
10 redirects have to be followed, before it gives up and assumes this means
the file does not exist.

This commit was supported by the NSF-funded DataLad project.

CHANGELOG

@@ -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
 

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

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