Skip to content

Commit f4988ad

Browse files
committed
Merge pull request #127 from VBA-tools/cURL-100-continue
Handle 100 Continue in createFromCurl
2 parents 8985029 + 6b34e75 commit f4988ad

File tree

2 files changed

+56
-27
lines changed

2 files changed

+56
-27
lines changed

specs/Specs_WebResponse.bas

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ Public Function Specs() As SpecSuite
2020
Dim ResponseHeaders As String
2121
Dim Headers As Collection
2222
Dim Cookies As Collection
23+
Dim Curl As String
2324

2425
Client.BaseUrl = HttpbinBaseUrl
2526
Client.TimeoutMs = 5000
@@ -163,7 +164,30 @@ Public Function Specs() As SpecSuite
163164
End With
164165

165166
' CreateFromHttp
167+
166168
' CreateFromCURL
169+
' --------------------------------------------- '
170+
With Specs.It("CreateFromCURL should handle 100 Continue responses")
171+
Set Client = New WebClient
172+
Set Request = New WebRequest
173+
Set Response = New WebResponse
174+
175+
Request.Format = WebFormat.PlainText
176+
Curl = "HTTP/1.1 100 Continue" & vbNewLine & _
177+
vbNewLine & _
178+
"HTTP/1.1 200 OK" & vbNewLine & _
179+
"Set-Cookie: message=Howdy!" & vbNewLine & _
180+
vbNewLine & _
181+
"Text"
182+
183+
Response.CreateFromCurl Client, Request, Curl
184+
185+
.Expect(Response.StatusCode).ToEqual WebStatusCode.Ok
186+
.Expect(Response.StatusDescription).ToEqual "OK"
187+
.Expect(Response.Cookies.Count).ToBeGT 0
188+
.Expect(WebHelpers.FindInKeyValues(Response.Cookies, "message")).ToEqual "Howdy!"
189+
.Expect(Response.Content).ToEqual "Text"
190+
End With
167191

168192
' ExtractHeaders
169193
' --------------------------------------------- '

src/WebResponse.cls

Lines changed: 32 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -316,7 +316,7 @@ End Sub
316316
Private Function web_ExtractStatusFromCurlResponse(web_CurlResponseLines() As String) As Long
317317
Dim web_StatusLineParts() As String
318318

319-
web_StatusLineParts = VBA.Split(web_CurlResponseLines(0), " ")
319+
web_StatusLineParts = VBA.Split(web_CurlResponseLines(web_FindStatusLine(web_CurlResponseLines)), " ")
320320
web_ExtractStatusFromCurlResponse = VBA.CLng(web_StatusLineParts(1))
321321
End Function
322322

@@ -325,36 +325,26 @@ Private Function web_ExtractStatusTextFromCurlResponse(web_CurlResponseLines() A
325325
Dim web_i As Long
326326
Dim web_StatusText As String
327327

328-
web_StatusLineParts = VBA.Split(web_CurlResponseLines(0), " ")
329-
For web_i = 2 To UBound(web_StatusLineParts)
330-
If web_i > 2 Then: web_StatusText = web_StatusText & " "
331-
web_StatusText = web_StatusText & web_StatusLineParts(web_i)
332-
Next web_i
333-
334-
web_ExtractStatusTextFromCurlResponse = web_StatusText
328+
web_StatusLineParts = VBA.Split(web_CurlResponseLines(web_FindStatusLine(web_CurlResponseLines)), " ", 3)
329+
web_ExtractStatusTextFromCurlResponse = web_StatusLineParts(2)
335330
End Function
336331

337332
Private Function web_ExtractHeadersFromCurlResponse(web_CurlResponseLines() As String) As String
333+
Dim web_StatusLineIndex As Long
338334
Dim web_BlankLineIndex As Long
339-
Dim web_Line As Variant
340335
Dim web_HeaderLines() As String
341336
Dim web_WriteIndex As Long
342337
Dim web_ReadIndex As Long
343338

344-
' Find blank line before body
345-
web_BlankLineIndex = 0
346-
For Each web_Line In web_CurlResponseLines
347-
If VBA.Trim(web_Line) = "" Then
348-
Exit For
349-
End If
350-
web_BlankLineIndex = web_BlankLineIndex + 1
351-
Next web_Line
339+
' Find status line and blank line before body
340+
web_StatusLineIndex = web_FindStatusLine(web_CurlResponseLines)
341+
web_BlankLineIndex = web_FindBlankLine(web_CurlResponseLines)
352342

353343
' Extract headers string
354-
ReDim web_HeaderLines(0 To web_BlankLineIndex - 2)
344+
ReDim web_HeaderLines(0 To web_BlankLineIndex - 2 - web_StatusLineIndex)
355345

356346
web_WriteIndex = 0
357-
For web_ReadIndex = 1 To web_BlankLineIndex - 1
347+
For web_ReadIndex = (web_StatusLineIndex + 1) To web_BlankLineIndex - 1
358348
web_HeaderLines(web_WriteIndex) = web_CurlResponseLines(web_ReadIndex)
359349
web_WriteIndex = web_WriteIndex + 1
360350
Next web_ReadIndex
@@ -364,19 +354,12 @@ End Function
364354

365355
Private Function web_ExtractResponseTextFromCurlResponse(web_CurlResponseLines() As String) As String
366356
Dim web_BlankLineIndex As Long
367-
Dim web_Line As Variant
368357
Dim web_BodyLines() As String
369358
Dim web_WriteIndex As Long
370359
Dim web_ReadIndex As Long
371360

372361
' Find blank line before body
373-
web_BlankLineIndex = 0
374-
For Each web_Line In web_CurlResponseLines
375-
If VBA.Trim(web_Line) = "" Then
376-
Exit For
377-
End If
378-
web_BlankLineIndex = web_BlankLineIndex + 1
379-
Next web_Line
362+
web_BlankLineIndex = web_FindBlankLine(web_CurlResponseLines)
380363

381364
' Extract body string
382365
ReDim web_BodyLines(0 To UBound(web_CurlResponseLines) - web_BlankLineIndex - 1)
@@ -390,6 +373,28 @@ Private Function web_ExtractResponseTextFromCurlResponse(web_CurlResponseLines()
390373
web_ExtractResponseTextFromCurlResponse = VBA.Join$(web_BodyLines, vbCrLf)
391374
End Function
392375

376+
Private Function web_FindStatusLine(web_CurlResponseLines() As String) As Long
377+
If VBA.Split(web_CurlResponseLines(0), " ")(1) = "100" Then
378+
' Special case for cURL: 100 Continue is included before final status code
379+
' -> ignore 100 and find final status code (next non-blank line)
380+
For web_FindStatusLine = 1 To UBound(web_CurlResponseLines)
381+
If VBA.Trim$(web_CurlResponseLines(web_FindStatusLine)) <> "" Then
382+
Exit Function
383+
End If
384+
Next web_FindStatusLine
385+
Else
386+
web_FindStatusLine = 0
387+
End If
388+
End Function
389+
390+
Private Function web_FindBlankLine(web_CurlResponseLines() As String) As Long
391+
For web_FindBlankLine = (web_FindStatusLine(web_CurlResponseLines) + 1) To UBound(web_CurlResponseLines)
392+
If VBA.Trim$(web_CurlResponseLines(web_FindBlankLine)) = "" Then
393+
Exit Function
394+
End If
395+
Next web_FindBlankLine
396+
End Function
397+
393398
Private Sub Class_Initialize()
394399
Set Headers = New Collection
395400
Set Cookies = New Collection

0 commit comments

Comments
 (0)