Merge pull request #159 from VBA-tools/follow-redirects

Follow redirects

Author: timhall

specs/Specs_WebClient.bas

@@ -88,6 +88,22 @@ Public Function Specs() As SpecSuite
         Client.Insecure = False
     End With
 
+    ' FollowRedirects
+    ' --------------------------------------------- '
+    With Specs.It(" should FollowRedirects")
+        Set Request = New WebRequest
+        Request.Resource = "redirect/5"
+        Request.Format = WebFormat.PlainText
+        
+        Client.FollowRedirects = True
+        Set Response = Client.Execute(Request)
+        .Expect(Response.StatusCode).ToEqual WebStatusCode.Ok
+        
+        Client.FollowRedirects = False
+        Set Response = Client.Execute(Request)
+        .Expect(Response.StatusCode).ToEqual 302
+    End With
+    
     ' ============================================= '
     ' Public Methods
     ' ============================================= '
@@ -242,18 +258,6 @@ Public Function Specs() As SpecSuite
 
     ' SetProxy
 
-    ' GetRedirectLocation
-    ' --------------------------------------------- '
-    With Specs.It("should GetRedirectLocation of Request")
-        Set Request = New WebRequest
-        Request.Resource = "redirect/1"
-        
-        Dim RedirectLocation As String
-        RedirectLocation = Client.GetRedirectLocation(Request)
-        
-        .Expect(RedirectLocation).ToEqual "/get"
-    End With
-    
     ' GetFullUrl
     ' --------------------------------------------- '
     With Specs.It("should GetFullUrl of Request")

src/WebClient.cls

@@ -183,6 +183,15 @@ Public EnableAutoProxy As Boolean
 ''
 Public Insecure As Boolean
 
+''
+' Follow redirects (301, 302, 307) using Location header
+'
+' @property FollowRedirects
+' @type Boolean
+' @default True
+''
+Public FollowRedirects As Boolean
+
 ''
 ' Proxy server to pass requests through (except for those that match `ProxyBypassList`).
 '
@@ -449,26 +458,6 @@ Public Sub SetProxy(ProxyServer As String, _
     Me.ProxyBypassList = BypassList
 End Sub
 
-''
-' If the given Request is a redirect (301, 302, or 307),
-' then get value of the "Location" header
-'
-' @param {WebRequest} Request
-' @return {String}
-''
-Public Function GetRedirectLocation(Request As WebRequest) As String
-    Dim RedirectRequest As WebRequest
-    Set RedirectRequest = Request.Clone
-    RedirectRequest.Method = WebMethod.HttpHead
-    
-    Dim Response As WebResponse
-    Set Response = Me.Execute(RedirectRequest)
-    
-    If Response.StatusCode = 301 Or Response.StatusCode = 302 Or Response.StatusCode = 307 Then
-        GetRedirectLocation = WebHelpers.FindInKeyValues(Response.Headers, "Location")
-    End If
-End Function
-
 ''
 ' Get full url by joining given `WebRequest.FormattedResource` and `BaseUrl`.
 '
@@ -535,24 +524,23 @@ Public Function PrepareHttpRequest(Request As WebRequest, Optional Async As Bool
         '   Invalid common name (CN), 0x1000
         '   Invalid date or certificate expired, 0x2000
         '   = 0x3300 = 13056
-        ' - Enable redirects
         ' - Enable https-to-http redirects
         web_Http.Option(web_WinHttpRequestOption.web_WinHttpRequestOption_EnableCertificateRevocationCheck) = False
         web_Http.Option(web_WinHttpRequestOption.web_WinHttpRequestOption_SslErrorIgnoreFlags) = 13056
-        web_Http.Option(web_WinHttpRequestOption.web_WinHttpRequestOption_EnableRedirects) = True
         web_Http.Option(web_WinHttpRequestOption.web_WinHttpRequestOption_EnableHttpsToHttpRedirects) = True
     Else
         ' By default:
         ' - Enable certificate revocation check (especially useful after HeartBleed)
         ' - Ignore no SLL erros
-        ' - Disable redirects (matches cURL behavior)
         ' - Disable https-to-http redirects
         web_Http.Option(web_WinHttpRequestOption.web_WinHttpRequestOption_EnableCertificateRevocationCheck) = True
         web_Http.Option(web_WinHttpRequestOption.web_WinHttpRequestOption_SslErrorIgnoreFlags) = 0
-        web_Http.Option(web_WinHttpRequestOption.web_WinHttpRequestOption_EnableRedirects) = False
         web_Http.Option(web_WinHttpRequestOption.web_WinHttpRequestOption_EnableHttpsToHttpRedirects) = False
     End If
 
+    ' Setup redirects
+    web_Http.Option(web_WinHttpRequestOption.web_WinHttpRequestOption_EnableRedirects) = Me.FollowRedirects
+    
     ' Set headers on http request (after open)
     For Each web_KeyValue In Request.Headers
         web_Http.SetRequestHeader web_KeyValue("Key"), web_KeyValue("Value")
@@ -623,6 +611,11 @@ Public Function PrepareCurlRequest(Request As WebRequest) As String
         web_Curl = web_Curl & " --insecure"
     End If
 
+    ' Setup redirects
+    If Me.FollowRedirects Then
+        web_Curl = web_Curl & " --location"
+    End If
+    
     ' Set headers and cookies
     For Each web_KeyValue In Request.Headers
         web_Curl = web_Curl & " -H '" & web_KeyValue("Key") & ": " & web_KeyValue("Value") & "'"
@@ -734,4 +727,5 @@ Private Sub Class_Initialize()
     Me.TimeoutMs = web_DefaultTimeoutMs
     Me.EnableAutoProxy = False
     Me.Insecure = False
+    Me.FollowRedirects = True
 End Sub